flipbookr building blocks

# flipbookr building blocks
## what lies beneath
### Gina Reynolds, December 2019

---

```r
library(flipbookr)
library(tidyverse)
```

```
## ── Attaching packages ─────────────────────────────────────────────────────────────────────────────── tidyverse 1.3.0 ──
```

```
## ✓ ggplot2 3.3.0     ✓ purrr   0.3.3
## ✓ tibble  3.0.0     ✓ dplyr   0.8.5
## ✓ tidyr   1.0.2     ✓ stringr 1.4.0
## ✓ readr   1.3.1     ✓ forcats 0.5.0
```

```
## Warning: package 'tibble' was built under R version 3.6.2
```

```
## ── Conflicts ────────────────────────────────────────────────────────────────────────────────── tidyverse_conflicts() ──
## x dplyr::filter() masks stats::filter()
## x dplyr::lag()    masks stats::lag()
```

```r
knitr::opts_chunk$set(fig.width = 6, message = F, warning = F, comment = "", cache = F)
```

```r
xaringanthemer::mono_accent(
  code_highlight_color = "rgba(255, 211, 0, .35)",
  base_color = "#03418A")
```

```
[1] "xaringan-themer.css"
```

---

We'll use the tidyverse packages to create a pipeline, and flipbookr to walk through the steps in this pipeline.

```r
library(tidyverse)
library(flipbookr)
```

The input code to be "flipbookified" is below:

```r
cars %>%  #BREAK          
  ggplot() +  
  aes(x = speed) + 
  aes(color = speed) + #BREAK2
  geom_rug() #BREAK
```

---

Let's first look at the result of using flipbookr to bring this code.

---

```r
*cars
```
]
 
.right-panel-cars_plot-auto[

```
   speed dist
1      4    2
2      4   10
3      7    4
4      7   22
5      8   16
6      9   10
7     10   18
8     10   26
9     10   34
10    11   17
11    11   28
12    12   14
13    12   20
14    12   24
15    12   28
16    13   26
17    13   34
18    13   34
19    13   46
20    14   26
21    14   36
22    14   60
23    14   80
24    15   20
25    15   26
26    15   54
27    16   32
28    16   40
29    17   32
30    17   40
31    17   50
32    18   42
33    18   56
34    18   76
35    18   84
36    19   36
37    19   46
38    19   68
39    20   32
40    20   48
41    20   52
42    20   56
43    20   64
44    22   66
45    23   54
46    24   70
47    24   92
48    24   93
49    24  120
50    25   85
```
]

---
class: split-40
count: false

```r
cars %>%  
* ggplot()
```
]
 
.right-panel-cars_plot-auto[
![](flipbookr_building_blocks_files/figure-html/cars_plot_auto_2_output-1.png)
]

---
class: split-40
count: false

```r
cars %>%  
  ggplot() +  
* aes(x = speed)
```
]
 
.right-panel-cars_plot-auto[
![](flipbookr_building_blocks_files/figure-html/cars_plot_auto_3_output-1.png)
]

---
class: split-40
count: false

```r
cars %>%  
  ggplot() +  
  aes(x = speed) +  
* aes(color = speed)
```
]
 
.right-panel-cars_plot-auto[
![](flipbookr_building_blocks_files/figure-html/cars_plot_auto_4_output-1.png)
]

---
class: split-40
count: false

```r
cars %>%  
  ggplot() +  
  aes(x = speed) +  
  aes(color = speed) +  
* geom_rug()
```
]
 
.right-panel-cars_plot-auto[
![](flipbookr_building_blocks_files/figure-html/cars_plot_auto_5_output-1.png)
]

---

# Move to automate

## 1. *Automatically* parsing a block of input code

## 2. *Automatically* reconstructing code into partial builds

## 3. *Automatically* delivered on a presentation platform (here Xaringan)

---

Now, lets look at some of the functions working in the background.

---
class: middle center inverse

# Step 1
## Parse block of input code

---

```r
*library(flipbookr)
```
]
 
.middle-panel-the_code_parsing-auto[

```
function (package, help, pos = 2, lib.loc = NULL, character.only = FALSE, 
    logical.return = FALSE, warn.conflicts, quietly = FALSE, 
    verbose = getOption("verbose"), mask.ok, exclude, include.only, 
    attach.required = missing(include.only)) 
{
    conf.ctrl <- getOption("conflicts.policy")
    if (is.character(conf.ctrl)) 
        conf.ctrl <- switch(conf.ctrl, strict = list(error = TRUE, 
            warn = FALSE), depends.ok = list(error = TRUE, generics.ok = TRUE, 
            can.mask = c("base", "methods", "utils", "grDevices", 
                "graphics", "stats"), depends.ok = TRUE), warning(gettextf("unknown conflict policy: %s", 
            sQuote(conf.ctrl)), call. = FALSE, domain = NA))
    if (!is.list(conf.ctrl)) 
        conf.ctrl <- NULL
    stopOnConflict <- isTRUE(conf.ctrl$error)
    if (missing(warn.conflicts)) 
        warn.conflicts <- if (isFALSE(conf.ctrl$warn)) 
            FALSE
        else TRUE
    if ((!missing(include.only)) && (!missing(exclude))) 
        stop(gettext("only one of 'include.only' and 'exclude' can be used"), 
            call. = FALSE, domain = NA)
    testRversion <- function(pkgInfo, pkgname, pkgpath) {
        if (is.null(built <- pkgInfo$Built)) 
            stop(gettextf("package %s has not been installed properly\n", 
                sQuote(pkgname)), call. = FALSE, domain = NA)
        R_version_built_under <- as.numeric_version(built$R)
        if (R_version_built_under < "3.0.0") 
            stop(gettextf("package %s was built before R 3.0.0: please re-install it", 
                sQuote(pkgname)), call. = FALSE, domain = NA)
        current <- getRversion()
        if (length(Rdeps <- pkgInfo$Rdepends2)) {
            for (dep in Rdeps) if (length(dep) > 1L) {
                target <- dep$version
                res <- if (is.character(target)) {
                  do.call(dep$op, list(as.numeric(R.version[["svn rev"]]), 
                    as.numeric(sub("^r", "", dep$version))))
                }
                else {
                  do.call(dep$op, list(current, as.numeric_version(target)))
                }
                if (!res) 
                  stop(gettextf("This is R %s, package %s needs %s %s", 
                    current, sQuote(pkgname), dep$op, target), 
                    call. = FALSE, domain = NA)
            }
        }
        if (R_version_built_under > current) 
            warning(gettextf("package %s was built under R version %s", 
                sQuote(pkgname), as.character(built$R)), call. = FALSE, 
                domain = NA)
        platform <- built$Platform
        r_arch <- .Platform$r_arch
        if (.Platform$OS.type == "unix") {
        }
        else {
            if (nzchar(platform) && !grepl("mingw", platform)) 
                stop(gettextf("package %s was built for %s", 
                  sQuote(pkgname), platform), call. = FALSE, 
                  domain = NA)
        }
        if (nzchar(r_arch) && file.exists(file.path(pkgpath, 
            "libs")) && !file.exists(file.path(pkgpath, "libs", 
            r_arch))) 
            stop(gettextf("package %s is not installed for 'arch = %s'", 
                sQuote(pkgname), r_arch), call. = FALSE, domain = NA)
    }
    checkNoGenerics <- function(env, pkg) {
        nenv <- env
        ns <- .getNamespace(as.name(pkg))
        if (!is.null(ns)) 
            nenv <- asNamespace(ns)
        if (exists(".noGenerics", envir = nenv, inherits = FALSE)) 
            TRUE
        else {
            !any(startsWith(names(env), ".__T"))
        }
    }
    checkConflicts <- function(package, pkgname, pkgpath, nogenerics, 
        env) {
        dont.mind <- c("last.dump", "last.warning", ".Last.value", 
            ".Random.seed", ".Last.lib", ".onDetach", ".packageName", 
            ".noGenerics", ".required", ".no_S3_generics", ".Depends", 
            ".requireCachedGenerics")
        sp <- search()
        lib.pos <- which(sp == pkgname)
        ob <- names(as.environment(lib.pos))
        if (!nogenerics) {
            these <- ob[startsWith(ob, ".__T__")]
            gen <- gsub(".__T__(.*):([^:]+)", "\\1", these)
            from <- gsub(".__T__(.*):([^:]+)", "\\2", these)
            gen <- gen[from != package]
            ob <- ob[!(ob %in% gen)]
        }
        ipos <- seq_along(sp)[-c(lib.pos, match(c("Autoloads", 
            "CheckExEnv"), sp, 0L))]
        cpos <- NULL
        conflicts <- vector("list", 0)
        for (i in ipos) {
            obj.same <- match(names(as.environment(i)), ob, nomatch = 0L)
            if (any(obj.same > 0)) {
                same <- ob[obj.same]
                same <- same[!(same %in% dont.mind)]
                Classobjs <- which(startsWith(same, ".__"))
                if (length(Classobjs)) 
                  same <- same[-Classobjs]
                same.isFn <- function(where) vapply(same, exists, 
                  NA, where = where, mode = "function", inherits = FALSE)
                same <- same[same.isFn(i) == same.isFn(lib.pos)]
                not.Ident <- function(ch, TRAFO = identity, ...) vapply(ch, 
                  function(.) !identical(TRAFO(get(., i)), TRAFO(get(., 
                    lib.pos)), ...), NA)
                if (length(same)) 
                  same <- same[not.Ident(same)]
                if (length(same) && identical(sp[i], "package:base")) 
                  same <- same[not.Ident(same, ignore.environment = TRUE)]
                if (length(same)) {
                  conflicts[[sp[i]]] <- same
                  cpos[sp[i]] <- i
                }
            }
        }
        if (length(conflicts)) {
            if (stopOnConflict) {
                emsg <- ""
                pkg <- names(conflicts)
                notOK <- vector("list", 0)
                for (i in seq_along(conflicts)) {
                  pkgname <- sub("^package:", "", pkg[i])
                  if (pkgname %in% canMaskEnv$canMask) 
                    next
                  same <- conflicts[[i]]
                  if (is.list(mask.ok)) 
                    myMaskOK <- mask.ok[[pkgname]]
                  else myMaskOK <- mask.ok
                  if (isTRUE(myMaskOK)) 
                    same <- NULL
                  else if (is.character(myMaskOK)) 
                    same <- setdiff(same, myMaskOK)
                  if (length(same)) {
                    notOK[[pkg[i]]] <- same
                    msg <- .maskedMsg(sort(same), pkg = sQuote(pkg[i]), 
                      by = cpos[i] < lib.pos)
                    emsg <- paste(emsg, msg, sep = "\n")
                  }
                }
                if (length(notOK)) {
                  msg <- gettextf("Conflicts attaching package %s:\n%s", 
                    sQuote(package), emsg)
                  stop(errorCondition(msg, package = package, 
                    conflicts = conflicts, class = "packageConflictError"))
                }
            }
            if (warn.conflicts) {
                packageStartupMessage(gettextf("\nAttaching package: %s\n", 
                  sQuote(package)), domain = NA)
                pkg <- names(conflicts)
                for (i in seq_along(conflicts)) {
                  msg <- .maskedMsg(sort(conflicts[[i]]), pkg = sQuote(pkg[i]), 
                    by = cpos[i] < lib.pos)
                  packageStartupMessage(msg, domain = NA)
                }
            }
        }
    }
    if (verbose && quietly) 
        message("'verbose' and 'quietly' are both true; being verbose then ..")
    if (!missing(package)) {
        if (is.null(lib.loc)) 
            lib.loc <- .libPaths()
        lib.loc <- lib.loc[dir.exists(lib.loc)]
        if (!character.only) 
            package <- as.character(substitute(package))
        if (length(package) != 1L) 
            stop("'package' must be of length 1")
        if (is.na(package) || (package == "")) 
            stop("invalid package name")
        pkgname <- paste0("package:", package)
        newpackage <- is.na(match(pkgname, search()))
        if (newpackage) {
            pkgpath <- find.package(package, lib.loc, quiet = TRUE, 
                verbose = verbose)
            if (length(pkgpath) == 0L) {
                if (length(lib.loc) && !logical.return) 
                  stop(packageNotFoundError(package, lib.loc, 
                    sys.call()))
                txt <- if (length(lib.loc)) 
                  gettextf("there is no package called %s", sQuote(package))
                else gettext("no library trees found in 'lib.loc'")
                if (logical.return) {
                  warning(txt, domain = NA)
                  return(FALSE)
                }
                else stop(txt, domain = NA)
            }
            which.lib.loc <- normalizePath(dirname(pkgpath), 
                "/", TRUE)
            pfile <- system.file("Meta", "package.rds", package = package, 
                lib.loc = which.lib.loc)
            if (!nzchar(pfile)) 
                stop(gettextf("%s is not a valid installed package", 
                  sQuote(package)), domain = NA)
            pkgInfo <- readRDS(pfile)
            testRversion(pkgInfo, package, pkgpath)
            if (is.character(pos)) {
                npos <- match(pos, search())
                if (is.na(npos)) {
                  warning(gettextf("%s not found on search path, using pos = 2", 
                    sQuote(pos)), domain = NA)
                  pos <- 2
                }
                else pos <- npos
            }
            deps <- unique(names(pkgInfo$Depends))
            depsOK <- isTRUE(conf.ctrl$depends.ok)
            if (depsOK) {
                canMaskEnv <- dynGet("__library_can_mask__", 
                  NULL)
                if (is.null(canMaskEnv)) {
                  canMaskEnv <- new.env()
                  canMaskEnv$canMask <- union("base", conf.ctrl$can.mask)
                  "__library_can_mask__" <- canMaskEnv
                }
                canMaskEnv$canMask <- unique(c(package, deps, 
                  canMaskEnv$canMask))
            }
            else canMaskEnv <- NULL
            if (attach.required) 
                .getRequiredPackages2(pkgInfo, quietly = quietly)
            cr <- conflictRules(package)
            if (missing(mask.ok)) 
                mask.ok <- cr$mask.ok
            if (missing(exclude)) 
                exclude <- cr$exclude
            if (packageHasNamespace(package, which.lib.loc)) {
                if (isNamespaceLoaded(package)) {
                  newversion <- as.numeric_version(pkgInfo$DESCRIPTION["Version"])
                  oldversion <- as.numeric_version(getNamespaceVersion(package))
                  if (newversion != oldversion) {
                    tryCatch(unloadNamespace(package), error = function(e) {
                      P <- if (!is.null(cc <- conditionCall(e))) 
                        paste("Error in", deparse(cc)[1L], ": ")
                      else "Error : "
                      stop(gettextf("Package %s version %s cannot be unloaded:\n %s", 
                        sQuote(package), oldversion, paste0(P, 
                          conditionMessage(e), "\n")), domain = NA)
                    })
                  }
                }
                tt <- tryCatch({
                  attr(package, "LibPath") <- which.lib.loc
                  ns <- loadNamespace(package, lib.loc)
                  env <- attachNamespace(ns, pos = pos, deps, 
                    exclude, include.only)
                }, error = function(e) {
                  P <- if (!is.null(cc <- conditionCall(e))) 
                    paste(" in", deparse(cc)[1L])
                  else ""
                  msg <- gettextf("package or namespace load failed for %s%s:\n %s", 
                    sQuote(package), P, conditionMessage(e))
                  if (logical.return) 
                    message(paste("Error:", msg), domain = NA)
                  else stop(msg, call. = FALSE, domain = NA)
                })
                if (logical.return && is.null(tt)) 
                  return(FALSE)
                attr(package, "LibPath") <- NULL
                {
                  on.exit(detach(pos = pos))
                  nogenerics <- !.isMethodsDispatchOn() || checkNoGenerics(env, 
                    package)
                  if (isFALSE(conf.ctrl$generics.ok) || (stopOnConflict && 
                    !isTRUE(conf.ctrl$generics.ok))) 
                    nogenerics <- TRUE
                  if (stopOnConflict || (warn.conflicts && !exists(".conflicts.OK", 
                    envir = env, inherits = FALSE))) 
                    checkConflicts(package, pkgname, pkgpath, 
                      nogenerics, ns)
                  on.exit()
                  if (logical.return) 
                    return(TRUE)
                  else return(invisible(.packages()))
                }
            }
            else stop(gettextf("package %s does not have a namespace and should be re-installed", 
                sQuote(package)), domain = NA)
        }
        if (verbose && !newpackage) 
            warning(gettextf("package %s already present in search()", 
                sQuote(package)), domain = NA)
    }
    else if (!missing(help)) {
        if (!character.only) 
            help <- as.character(substitute(help))
        pkgName <- help[1L]
        pkgPath <- find.package(pkgName, lib.loc, verbose = verbose)
        docFiles <- c(file.path(pkgPath, "Meta", "package.rds"), 
            file.path(pkgPath, "INDEX"))
        if (file.exists(vignetteIndexRDS <- file.path(pkgPath, 
            "Meta", "vignette.rds"))) 
            docFiles <- c(docFiles, vignetteIndexRDS)
        pkgInfo <- vector("list", 3L)
        readDocFile <- function(f) {
            if (basename(f) %in% "package.rds") {
                txt <- readRDS(f)$DESCRIPTION
                if ("Encoding" %in% names(txt)) {
                  to <- if (Sys.getlocale("LC_CTYPE") == "C") 
                    "ASCII//TRANSLIT"
                  else ""
                  tmp <- try(iconv(txt, from = txt["Encoding"], 
                    to = to))
                  if (!inherits(tmp, "try-error")) 
                    txt <- tmp
                  else warning("'DESCRIPTION' has an 'Encoding' field and re-encoding is not possible", 
                    call. = FALSE)
                }
                nm <- paste0(names(txt), ":")
                formatDL(nm, txt, indent = max(nchar(nm, "w")) + 
                  3L)
            }
            else if (basename(f) %in% "vignette.rds") {
                txt <- readRDS(f)
                if (is.data.frame(txt) && nrow(txt)) 
                  cbind(basename(gsub("\\.[[:alpha:]]+$", "", 
                    txt$File)), paste(txt$Title, paste0(rep.int("(source", 
                    NROW(txt)), ifelse(nzchar(txt$PDF), ", pdf", 
                    ""), ")")))
                else NULL
            }
            else readLines(f)
        }
        for (i in which(file.exists(docFiles))) pkgInfo[[i]] <- readDocFile(docFiles[i])
        y <- list(name = pkgName, path = pkgPath, info = pkgInfo)
        class(y) <- "packageInfo"
        return(y)
    }
    else {
        if (is.null(lib.loc)) 
            lib.loc <- .libPaths()
        db <- matrix(character(), nrow = 0L, ncol = 3L)
        nopkgs <- character()
        for (lib in lib.loc) {
            a <- .packages(all.available = TRUE, lib.loc = lib)
            for (i in sort(a)) {
                file <- system.file("Meta", "package.rds", package = i, 
                  lib.loc = lib)
                title <- if (nzchar(file)) {
                  txt <- readRDS(file)
                  if (is.list(txt)) 
                    txt <- txt$DESCRIPTION
                  if ("Encoding" %in% names(txt)) {
                    to <- if (Sys.getlocale("LC_CTYPE") == "C") 
                      "ASCII//TRANSLIT"
                    else ""
                    tmp <- try(iconv(txt, txt["Encoding"], to, 
                      "?"))
                    if (!inherits(tmp, "try-error")) 
                      txt <- tmp
                    else warning("'DESCRIPTION' has an 'Encoding' field and re-encoding is not possible", 
                      call. = FALSE)
                  }
                  txt["Title"]
                }
                else NA
                if (is.na(title)) 
                  title <- " ** No title available ** "
                db <- rbind(db, cbind(i, lib, title))
            }
            if (length(a) == 0L) 
                nopkgs <- c(nopkgs, lib)
        }
        dimnames(db) <- list(NULL, c("Package", "LibPath", "Title"))
        if (length(nopkgs) && !missing(lib.loc)) {
            pkglist <- paste(sQuote(nopkgs), collapse = ", ")
            msg <- sprintf(ngettext(length(nopkgs), "library %s contains no packages", 
                "libraries %s contain no packages"), pkglist)
            warning(msg, domain = NA)
        }
        y <- list(header = NULL, results = db, footer = NULL)
        class(y) <- "libraryIQR"
        return(y)
    }
    if (logical.return) 
        TRUE
    else invisible(.packages())
}
<bytecode: 0x7ff4a11607c0>
<environment: namespace:base>
```
]
 
.right-panel-the_code_parsing-auto[

]

---
class: split-40
count: false

```r
library(flipbookr)

*create_code()
```
]
 
.middle-panel-the_code_parsing-auto[

```
function () 
{
    "cars %>%             # the data  #BREAK\n  filter(speed > 4) %>%  # subset\n  ggplot() +              # pipe to ggplot\n  aes(x = speed) +\n  aes(y = dist) +\n  # Describing what follows\n  geom_point(alpha = .3) + #BREAK\n  geom_point(alpha = 1) + #BREAK2\n  geom_jitter(alpha = .5) + #BREAK3\n  aes(color =\n  speed > 14\n  ) %+%\n  cars ->\n  my_plot  #BREAK\n\n\n  1 + 1 #BREAK"
}
<bytecode: 0x7ff4a91b99d8>
<environment: namespace:flipbookr>
```
]
 
.right-panel-the_code_parsing-auto[

```
[1] "cars %>%             # the data  #BREAK\n  filter(speed > 4) %>%  # subset\n  ggplot() +              # pipe to ggplot\n  aes(x = speed) +\n  aes(y = dist) +\n  # Describing what follows\n  geom_point(alpha = .3) + #BREAK\n  geom_point(alpha = 1) + #BREAK2\n  geom_jitter(alpha = .5) + #BREAK3\n  aes(color =\n  speed > 14\n  ) %+%\n  cars ->\n  my_plot  #BREAK\n\n\n  1 + 1 #BREAK"
```
]

---
class: split-40
count: false

```r
library(flipbookr)

create_code() %>%  
* code_as_table()
```
]
 
.middle-panel-the_code_parsing-auto[

```
function (code) 
{
    code %>% stringr::str_split(pattern = "\n") %>% .[[1]] %>% 
        tibble::tibble(raw_code = .) %>% dplyr::mutate(line = 1:dplyr::n())
}
<bytecode: 0x7ff4a5a48f20>
<environment: namespace:flipbookr>
```
]
 
.right-panel-the_code_parsing-auto[

```
# A tibble: 17 x 2
   raw_code                                      line
   <chr>                                        <int>
 1 "cars %>%             # the data  #BREAK"        1
 2 "  filter(speed > 4) %>%  # subset"              2
 3 "  ggplot() +              # pipe to ggplot"     3
 4 "  aes(x = speed) +"                             4
 5 "  aes(y = dist) +"                              5
 6 "  # Describing what follows"                    6
 7 "  geom_point(alpha = .3) + #BREAK"              7
 8 "  geom_point(alpha = 1) + #BREAK2"              8
 9 "  geom_jitter(alpha = .5) + #BREAK3"            9
10 "  aes(color ="                                 10
11 "  speed > 14"                                  11
12 "  ) %+%"                                       12
13 "  cars ->"                                     13
14 "  my_plot  #BREAK"                             14
15 ""                                              15
16 ""                                              16
17 "  1 + 1 #BREAK"                                17
```
]

---
class: split-40
count: false

```r
library(flipbookr)

create_code() %>%  
  code_as_table() %>%  
* code_as_table_process_break_messages()
```
]
 
.middle-panel-the_code_parsing-auto[

```
function (code_as_table) 
{
    code_as_table %>% dplyr::mutate(raw_code = stringr::str_remove(raw_code, 
        "\\s+$")) %>% dplyr::mutate(non_seq = stringr::str_extract(raw_code, 
        "#BREAK-?\\d+")) %>% dplyr::mutate(non_seq = stringr::str_extract(non_seq, 
        "-?\\d+")) %>% dplyr::mutate(non_seq = as.numeric(non_seq)) %>% 
        dplyr::mutate(non_seq = tidyr::replace_na(non_seq, 1)) %>% 
        dplyr::mutate(user = stringr::str_detect(raw_code, "#BREAK$")) %>% 
        dplyr::mutate(rotate = stringr::str_detect(raw_code, 
            "#ROTATE$"))
}
<bytecode: 0x7ff4a5b24040>
<environment: namespace:flipbookr>
```
]
 
.right-panel-the_code_parsing-auto[

```
# A tibble: 17 x 5
   raw_code                                      line non_seq user  rotate
   <chr>                                        <int>   <dbl> <lgl> <lgl> 
 1 "cars %>%             # the data  #BREAK"        1       1 TRUE  FALSE 
 2 "  filter(speed > 4) %>%  # subset"              2       1 FALSE FALSE 
 3 "  ggplot() +              # pipe to ggplot"     3       1 FALSE FALSE 
 4 "  aes(x = speed) +"                             4       1 FALSE FALSE 
 5 "  aes(y = dist) +"                              5       1 FALSE FALSE 
 6 "  # Describing what follows"                    6       1 FALSE FALSE 
 7 "  geom_point(alpha = .3) + #BREAK"              7       1 TRUE  FALSE 
 8 "  geom_point(alpha = 1) + #BREAK2"              8       2 FALSE FALSE 
 9 "  geom_jitter(alpha = .5) + #BREAK3"            9       3 FALSE FALSE 
10 "  aes(color ="                                 10       1 FALSE FALSE 
11 "  speed > 14"                                  11       1 FALSE FALSE 
12 "  ) %+%"                                       12       1 FALSE FALSE 
13 "  cars ->"                                     13       1 FALSE FALSE 
14 "  my_plot  #BREAK"                             14       1 TRUE  FALSE 
15 ""                                              15       1 FALSE FALSE 
16 ""                                              16       1 FALSE FALSE 
17 "  1 + 1 #BREAK"                                17       1 TRUE  FALSE 
```
]

---
class: split-40
count: false

```r
library(flipbookr)

create_code() %>%  
  code_as_table() %>%  
  code_as_table_process_break_messages() ->  
*hide_away
```
]
 
.middle-panel-the_code_parsing-auto[

]
 
.right-panel-the_code_parsing-auto[

]

---
class: split-40
count: false

```r
library(flipbookr)

create_code() %>%  
  code_as_table() %>%  
  code_as_table_process_break_messages() ->  
hide_away

*create_code()
```
]
 
.middle-panel-the_code_parsing-auto[

---
class: split-40
count: false

```r
library(flipbookr)

create_code() %>%  
  code_as_table() %>%  
  code_as_table_process_break_messages() ->  
hide_away

create_code() %>%  
* r_code_base_parse()
```
]
 
.middle-panel-the_code_parsing-auto[

```
function (code) 
{
    sf <- srcfile(code)
    try(parse(text = code, srcfile = sf))
    utils::getParseData(sf)
}
<bytecode: 0x7ff4a55a17b8>
<environment: namespace:flipbookr>
```
]
 
.right-panel-the_code_parsing-auto[

```
    line1 col1 line2 col2  id parent                token terminal
137     1    1    14    9 137      0                 expr    FALSE
131     1    1    13    6 131    137                 expr    FALSE
105     1    1     9   25 105    131                 expr    FALSE
90      1    1     8   23  90    105                 expr    FALSE
75      1    1     7   24  75     90                 expr    FALSE
59      1    1     5   15  59     75                 expr    FALSE
45      1    1     4   16  45     59                 expr    FALSE
30      1    1     3   10  30     45                 expr    FALSE
20      1    1     2   19  20     30                 expr    FALSE
1       1    1     1    4   1      3               SYMBOL     TRUE
3       1    1     1    4   3     20                 expr    FALSE
2       1    6     1    8   2     20              SPECIAL     TRUE
4       1   22     1   39   4     20              COMMENT     TRUE
18      2    3     2   19  18     20                 expr    FALSE
6       2    3     2    8   6      8 SYMBOL_FUNCTION_CALL     TRUE
8       2    3     2    8   8     18                 expr    FALSE
7       2    9     2    9   7     18                  '('     TRUE
15      2   10     2   18  15     18                 expr    FALSE
9       2   10     2   14   9     11               SYMBOL     TRUE
11      2   10     2   14  11     15                 expr    FALSE
10      2   16     2   16  10     15                   GT     TRUE
12      2   18     2   18  12     13            NUM_CONST     TRUE
13      2   18     2   18  13     15                 expr    FALSE
14      2   19     2   19  14     18                  ')'     TRUE
19      2   21     2   23  19     30              SPECIAL     TRUE
21      2   26     2   33  21     30              COMMENT     TRUE
28      3    3     3   10  28     30                 expr    FALSE
23      3    3     3    8  23     25 SYMBOL_FUNCTION_CALL     TRUE
25      3    3     3    8  25     28                 expr    FALSE
24      3    9     3    9  24     28                  '('     TRUE
26      3   10     3   10  26     28                  ')'     TRUE
29      3   12     3   12  29     45                  '+'     TRUE
31      3   27     3   42  31     45              COMMENT     TRUE
43      4    3     4   16  43     45                 expr    FALSE
33      4    3     4    5  33     35 SYMBOL_FUNCTION_CALL     TRUE
35      4    3     4    5  35     43                 expr    FALSE
34      4    6     4    6  34     43                  '('     TRUE
36      4    7     4    7  36     43           SYMBOL_SUB     TRUE
37      4    9     4    9  37     43               EQ_SUB     TRUE
38      4   11     4   15  38     40               SYMBOL     TRUE
40      4   11     4   15  40     43                 expr    FALSE
39      4   16     4   16  39     43                  ')'     TRUE
44      4   18     4   18  44     59                  '+'     TRUE
57      5    3     5   15  57     59                 expr    FALSE
47      5    3     5    5  47     49 SYMBOL_FUNCTION_CALL     TRUE
49      5    3     5    5  49     57                 expr    FALSE
48      5    6     5    6  48     57                  '('     TRUE
50      5    7     5    7  50     57           SYMBOL_SUB     TRUE
51      5    9     5    9  51     57               EQ_SUB     TRUE
52      5   11     5   14  52     54               SYMBOL     TRUE
54      5   11     5   14  54     57                 expr    FALSE
53      5   15     5   15  53     57                  ')'     TRUE
58      5   17     5   17  58     75                  '+'     TRUE
61      6    3     6   27  61     75              COMMENT     TRUE
73      7    3     7   24  73     75                 expr    FALSE
63      7    3     7   12  63     65 SYMBOL_FUNCTION_CALL     TRUE
65      7    3     7   12  65     73                 expr    FALSE
64      7   13     7   13  64     73                  '('     TRUE
66      7   14     7   18  66     73           SYMBOL_SUB     TRUE
67      7   20     7   20  67     73               EQ_SUB     TRUE
68      7   22     7   23  68     69            NUM_CONST     TRUE
69      7   22     7   23  69     73                 expr    FALSE
70      7   24     7   24  70     73                  ')'     TRUE
74      7   26     7   26  74     90                  '+'     TRUE
76      7   28     7   33  76     90              COMMENT     TRUE
88      8    3     8   23  88     90                 expr    FALSE
78      8    3     8   12  78     80 SYMBOL_FUNCTION_CALL     TRUE
80      8    3     8   12  80     88                 expr    FALSE
79      8   13     8   13  79     88                  '('     TRUE
81      8   14     8   18  81     88           SYMBOL_SUB     TRUE
82      8   20     8   20  82     88               EQ_SUB     TRUE
83      8   22     8   22  83     84            NUM_CONST     TRUE
84      8   22     8   22  84     88                 expr    FALSE
85      8   23     8   23  85     88                  ')'     TRUE
89      8   25     8   25  89    105                  '+'     TRUE
91      8   27     8   33  91    105              COMMENT     TRUE
103     9    3     9   25 103    105                 expr    FALSE
93      9    3     9   13  93     95 SYMBOL_FUNCTION_CALL     TRUE
95      9    3     9   13  95    103                 expr    FALSE
94      9   14     9   14  94    103                  '('     TRUE
96      9   15     9   19  96    103           SYMBOL_SUB     TRUE
97      9   21     9   21  97    103               EQ_SUB     TRUE
98      9   23     9   24  98     99            NUM_CONST     TRUE
99      9   23     9   24  99    103                 expr    FALSE
100     9   25     9   25 100    103                  ')'     TRUE
104     9   27     9   27 104    131                  '+'     TRUE
106     9   29     9   35 106    131              COMMENT     TRUE
130    10    3    13    6 130    131                 expr    FALSE
124    10    3    12    3 124    130                 expr    FALSE
108    10    3    10    5 108    110 SYMBOL_FUNCTION_CALL     TRUE
110    10    3    10    5 110    124                 expr    FALSE
109    10    6    10    6 109    124                  '('     TRUE
111    10    7    10   11 111    124           SYMBOL_SUB     TRUE
112    10   13    10   13 112    124               EQ_SUB     TRUE
121    11    3    11   12 121    124                 expr    FALSE
114    11    3    11    7 114    116               SYMBOL     TRUE
116    11    3    11    7 116    121                 expr    FALSE
115    11    9    11    9 115    121                   GT     TRUE
117    11   11    11   12 117    118            NUM_CONST     TRUE
118    11   11    11   12 118    121                 expr    FALSE
120    12    3    12    3 120    124                  ')'     TRUE
125    12    5    12    7 125    130              SPECIAL     TRUE
127    13    3    13    6 127    129               SYMBOL     TRUE
129    13    3    13    6 129    130                 expr    FALSE
128    13    8    13    9 128    137         RIGHT_ASSIGN     TRUE
133    14    3    14    9 133    136               SYMBOL     TRUE
136    14    3    14    9 136    137                 expr    FALSE
134    14   12    14   17 134   -137              COMMENT     TRUE
151    17    3    17    7 151      0                 expr    FALSE
144    17    3    17    3 144    145            NUM_CONST     TRUE
145    17    3    17    3 145    151                 expr    FALSE
146    17    5    17    5 146    151                  '+'     TRUE
147    17    7    17    7 147    148            NUM_CONST     TRUE
148    17    7    17    7 148    151                 expr    FALSE
149    17    9    17   14 149   -151              COMMENT     TRUE
                         text
137                          
131                          
105                          
90                           
75                           
59                           
45                           
30                           
20                           
1                        cars
3                            
2                         %>%
4          # the data  #BREAK
18                           
6                      filter
8                            
7                           (
15                           
9                       speed
11                           
10                          >
12                          4
13                           
14                          )
19                        %>%
21                   # subset
28                           
23                     ggplot
25                           
24                          (
26                          )
29                          +
31           # pipe to ggplot
43                           
33                        aes
35                           
34                          (
36                          x
37                          =
38                      speed
40                           
39                          )
44                          +
57                           
47                        aes
49                           
48                          (
50                          y
51                          =
52                       dist
54                           
53                          )
58                          +
61  # Describing what follows
73                           
63                 geom_point
65                           
64                          (
66                      alpha
67                          =
68                         .3
69                           
70                          )
74                          +
76                     #BREAK
88                           
78                 geom_point
80                           
79                          (
81                      alpha
82                          =
83                          1
84                           
85                          )
89                          +
91                    #BREAK2
103                          
93                geom_jitter
95                           
94                          (
96                      alpha
97                          =
98                         .5
99                           
100                         )
104                         +
106                   #BREAK3
130                          
124                          
108                       aes
110                          
109                         (
111                     color
112                         =
121                          
114                     speed
116                          
115                         >
117                        14
118                          
120                         )
125                       %+%
127                      cars
129                          
128                        ->
133                   my_plot
136                          
134                    #BREAK
151                          
144                         1
145                          
146                         +
147                         1
148                          
149                    #BREAK
```
]

---
class: split-40
count: false

```r
library(flipbookr)

create_code() %>%  
  code_as_table() %>%  
  code_as_table_process_break_messages() ->  
hide_away

create_code() %>%  
  r_code_base_parse() %>%  
* r_base_parsed_count_parentheses()
```
]
 
.middle-panel-the_code_parsing-auto[

```
function (base_parsed) 
{
    num_lines <- max(base_parsed$line1)
    all_lines <- tibble::tibble(line = 1:num_lines)
    base_parsed %>% dplyr::rename(line = line1) %>% dplyr::mutate(open_par = text == 
        "(") %>% dplyr::mutate(closed_par = text == ")") %>% 
        dplyr::mutate(open_curly = text == "{") %>% dplyr::mutate(closed_curly = text == 
        "}") %>% dplyr::mutate(open_square = text == "[") %>% 
        dplyr::mutate(open_square = ifelse(text == "[[", 2, open_square)) %>% 
        dplyr::mutate(closed_square = text == "]") %>% dplyr::group_by(line) %>% 
        dplyr::summarise(full_line = paste0(text, collapse = ""), 
            comment = stringr::str_trim(paste0(ifelse(token == 
                "COMMENT", text, ""), collapse = " ")), num_open_par = sum(open_par), 
            num_closed_par = sum(closed_par), num_open_curly = sum(open_curly), 
            num_closed_curly = sum(closed_curly), num_open_square = sum(open_square), 
            num_closed_square = sum(closed_square)) %>% dplyr::full_join(all_lines) %>% 
        dplyr::arrange(line) %>% dplyr::mutate(full_line = tidyr::replace_na(full_line, 
        ""), comment = tidyr::replace_na(comment, ""), num_open_par = tidyr::replace_na(num_open_par, 
        0), num_closed_par = tidyr::replace_na(num_closed_par, 
        0), num_open_curly = tidyr::replace_na(num_open_curly, 
        0), num_closed_curly = tidyr::replace_na(num_closed_curly, 
        0), num_open_square = tidyr::replace_na(num_open_square, 
        0), num_closed_square = tidyr::replace_na(num_closed_square, 
        0)) %>% dplyr::mutate(balanced_paren = (cumsum(num_open_par) - 
        cumsum(num_closed_par)) == 0) %>% dplyr::mutate(balanced_curly = (cumsum(num_open_curly) - 
        cumsum(num_closed_curly)) == 0) %>% dplyr::mutate(balanced_square = (cumsum(num_open_square) - 
        cumsum(num_closed_square)) == 0) %>% dplyr::mutate(all_parentheses_balanced = balanced_paren & 
        balanced_curly & balanced_square) %>% dplyr::select(line, 
        full_line, comment, all_parentheses_balanced)
}
<bytecode: 0x7ff4a5610bb0>
<environment: namespace:flipbookr>
```
]
 
.right-panel-the_code_parsing-auto[

```
# A tibble: 17 x 4
    line full_line                  comment                all_parentheses_bala…
   <int> <chr>                      <chr>                  <lgl>                
 1     1 "cars%>%# the data  #BREA… "# the data  #BREAK"   TRUE                 
 2     2 "filter(speed>4)%>%# subs… "# subset"             TRUE                 
 3     3 "ggplot()+# pipe to ggplo… "# pipe to ggplot"     TRUE                 
 4     4 "aes(x=speed)+"            ""                     TRUE                 
 5     5 "aes(y=dist)+"             ""                     TRUE                 
 6     6 "# Describing what follow… "# Describing what fo… TRUE                 
 7     7 "geom_point(alpha=.3)+#BR… "#BREAK"               TRUE                 
 8     8 "geom_point(alpha=1)+#BRE… "#BREAK2"              TRUE                 
 9     9 "geom_jitter(alpha=.5)+#B… "#BREAK3"              TRUE                 
10    10 "aes(color="               ""                     FALSE                
11    11 "speed>14"                 ""                     FALSE                
12    12 ")%+%"                     ""                     TRUE                 
13    13 "cars->"                   ""                     TRUE                 
14    14 "my_plot#BREAK"            "#BREAK"               TRUE                 
15    15 ""                         ""                     TRUE                 
16    16 ""                         ""                     TRUE                 
17    17 "1+1#BREAK"                "#BREAK"               TRUE                 
```
]

---
class: split-40
count: false

```r
library(flipbookr)

create_code() %>%  
  code_as_table() %>%  
  code_as_table_process_break_messages() ->  
hide_away

create_code() %>%  
  r_code_base_parse() %>%  
  r_base_parsed_count_parentheses() ->  
*hide_again
```
]
 
.middle-panel-the_code_parsing-auto[

]
 
.right-panel-the_code_parsing-auto[

]

---
class: split-40
count: false

```r
library(flipbookr)

create_code() %>%  
  code_as_table() %>%  
  code_as_table_process_break_messages() ->  
hide_away

create_code() %>%  
  r_code_base_parse() %>%  
  r_base_parsed_count_parentheses() ->  
hide_again

*create_code()
```
]
 
.middle-panel-the_code_parsing-auto[

---
class: split-40
count: false

```r
library(flipbookr)

create_code() %>%  
  code_as_table() %>%  
  code_as_table_process_break_messages() ->  
hide_away

create_code() %>%  
  r_code_base_parse() %>%  
  r_base_parsed_count_parentheses() ->  
hide_again

create_code() %>%  
* r_code_full_parse()
```
]
 
.middle-panel-the_code_parsing-auto[

```
function (code = code) 
{
    arithmetic <- "\\+$|-$|\\/$|\\*$|\\^$|%%$|%\\/%$"
    matrix <- "%\\*%$|%o%$"
    ggplot_change_data <- "%\\+%$"
    the_magrittr <- "%>%$|%\\$%$"
    right_assign <- "->$"
    combine_booleans <- "\\|$|\\&$"
    connectors <- paste(arithmetic, matrix, ggplot_change_data, 
        the_magrittr, right_assign, combine_booleans, sep = "|")
    raw_code_table <- code_simple_parse(code = code)
    parsed_code_table <- code %>% r_code_base_parse() %>% r_base_parsed_count_parentheses()
    raw_code_table %>% dplyr::full_join(parsed_code_table) %>% 
        dplyr::mutate(comment = tidyr::replace_na(comment, "XXXXXXXXX")) %>% 
        dplyr::mutate(comment = stringr::str_replace(comment, 
            "^$", "XXXXXXXXX")) %>% dplyr::mutate(code = stringr::str_remove(raw_code, 
        comment)) %>% dplyr::mutate(connector = stringr::str_extract(stringr::str_trim(code), 
        connectors)) %>% dplyr::mutate(connector = tidyr::replace_na(connector, 
        "")) %>% dplyr::mutate(comment = stringr::str_remove(comment, 
        "#BREAK\\d?")) %>% dplyr::mutate(comment = stringr::str_remove(comment, 
        "#ROTATE")) %>% dplyr::mutate(comment = stringr::str_remove(comment, 
        "XXXXXXXXX")) %>% dplyr::mutate(code = stringr::str_remove(stringi::stri_trim_right(code), 
        connectors)) %>% dplyr::mutate(auto = all_parentheses_balanced & 
        code != "") %>% dplyr::select(line, raw_code, code, connector, 
        comment, auto, user, non_seq, rotate)
}
<bytecode: 0x7ff4a5a31268>
<environment: namespace:flipbookr>
```
]
 
.right-panel-the_code_parsing-auto[

```
# A tibble: 17 x 9
    line raw_code       code     connector comment    auto  user  non_seq rotate
   <int> <chr>          <chr>    <chr>     <chr>      <lgl> <lgl>   <dbl> <lgl> 
 1     1 "cars %>%    … "cars "  "%>%"     "# the da… TRUE  TRUE        1 FALSE 
 2     2 "  filter(spe… "  filt… "%>%"     "# subset" TRUE  FALSE       1 FALSE 
 3     3 "  ggplot() +… "  ggpl… "+"       "# pipe t… TRUE  FALSE       1 FALSE 
 4     4 "  aes(x = sp… "  aes(… "+"       ""         TRUE  FALSE       1 FALSE 
 5     5 "  aes(y = di… "  aes(… "+"       ""         TRUE  FALSE       1 FALSE 
 6     6 "  # Describi… ""       ""        "# Descri… FALSE FALSE       1 FALSE 
 7     7 "  geom_point… "  geom… "+"       ""         TRUE  TRUE        1 FALSE 
 8     8 "  geom_point… "  geom… "+"       ""         TRUE  FALSE       2 FALSE 
 9     9 "  geom_jitte… "  geom… "+"       ""         TRUE  FALSE       3 FALSE 
10    10 "  aes(color … "  aes(… ""        ""         FALSE FALSE       1 FALSE 
11    11 "  speed > 14" "  spee… ""        ""         FALSE FALSE       1 FALSE 
12    12 "  ) %+%"      "  ) "   "%+%"     ""         TRUE  FALSE       1 FALSE 
13    13 "  cars ->"    "  cars… "->"      ""         TRUE  FALSE       1 FALSE 
14    14 "  my_plot  #… "  my_p… ""        ""         TRUE  TRUE        1 FALSE 
15    15 ""             ""       ""        ""         FALSE FALSE       1 FALSE 
16    16 ""             ""       ""        ""         FALSE FALSE       1 FALSE 
17    17 "  1 + 1 #BRE… "  1 + … ""        ""         TRUE  TRUE        1 FALSE 
```
]

---
class: split-40
count: false

```r
library(flipbookr)

create_code() %>%  
  code_as_table() %>%  
  code_as_table_process_break_messages() ->  
hide_away

create_code() %>%  
  r_code_base_parse() %>%  
  r_base_parsed_count_parentheses() ->  
hide_again

create_code() %>%  
  r_code_full_parse() ->  
*hide_more
```
]
 
.middle-panel-the_code_parsing-auto[

]
 
.right-panel-the_code_parsing-auto[

]

---
class: middle center inverse

# Step 2
## Reconstruct code into partial builds

---

## First calculate which lines need to be shown and highlighted in each frame of the mini flipbook.

A list is returned where each frame corresponds to the element in the list.

Within the list numbers of the lines of code for each frame is returned.

This is dependent on what the user has set for the break_type.

Appropriate highlighting is calculated based on what appears in previous frame and what is new in current frame.

---

```r
*create_code()
```
]
 
.middle-panel-the_code_highlight-auto[

---
class: split-40
count: false

```r
create_code() %>%  
* code_parse()
```
]
 
.middle-panel-the_code_highlight-auto[

```
function (code = create_code(), lang = "r") 
{
    if (lang == "r") {
        r_code_full_parse(code = code) %>% dplyr::mutate(func = stringr::str_extract(code, 
            "\\w+\\(")) %>% dplyr::mutate(func = stringr::str_remove(func, 
            "\\("))
    }
    else if (lang == "python") {
        python_code_full_parse(code = code)
    }
    else if (lang == "stata") {
        NULL
    }
}
<bytecode: 0x7ff4a5a1ef20>
<environment: namespace:flipbookr>
```
]
 
.right-panel-the_code_highlight-auto[

```
# A tibble: 17 x 10
    line raw_code    code    connector comment  auto  user  non_seq rotate func 
   <int> <chr>       <chr>   <chr>     <chr>    <lgl> <lgl>   <dbl> <lgl>  <chr>
 1     1 "cars %>% … "cars " "%>%"     "# the … TRUE  TRUE        1 FALSE  <NA> 
 2     2 "  filter(… "  fil… "%>%"     "# subs… TRUE  FALSE       1 FALSE  filt…
 3     3 "  ggplot(… "  ggp… "+"       "# pipe… TRUE  FALSE       1 FALSE  ggpl…
 4     4 "  aes(x =… "  aes… "+"       ""       TRUE  FALSE       1 FALSE  aes  
 5     5 "  aes(y =… "  aes… "+"       ""       TRUE  FALSE       1 FALSE  aes  
 6     6 "  # Descr… ""      ""        "# Desc… FALSE FALSE       1 FALSE  <NA> 
 7     7 "  geom_po… "  geo… "+"       ""       TRUE  TRUE        1 FALSE  geom…
 8     8 "  geom_po… "  geo… "+"       ""       TRUE  FALSE       2 FALSE  geom…
 9     9 "  geom_ji… "  geo… "+"       ""       TRUE  FALSE       3 FALSE  geom…
10    10 "  aes(col… "  aes… ""        ""       FALSE FALSE       1 FALSE  aes  
11    11 "  speed >… "  spe… ""        ""       FALSE FALSE       1 FALSE  <NA> 
12    12 "  ) %+%"   "  ) "  "%+%"     ""       TRUE  FALSE       1 FALSE  <NA> 
13    13 "  cars ->" "  car… "->"      ""       TRUE  FALSE       1 FALSE  <NA> 
14    14 "  my_plot… "  my_… ""        ""       TRUE  TRUE        1 FALSE  <NA> 
15    15 ""          ""      ""        ""       FALSE FALSE       1 FALSE  <NA> 
16    16 ""          ""      ""        ""       FALSE FALSE       1 FALSE  <NA> 
17    17 "  1 + 1 #… "  1 +… ""        ""       TRUE  TRUE        1 FALSE  <NA> 
```
]

---
class: split-40
count: false

```r
create_code() %>%  
  code_parse() %>%  
* parsed_calc_show()
```
]
 
.middle-panel-the_code_highlight-auto[

```
function (parsed, break_type = "auto") 
{
    if (break_type == "auto") {
        code_order <- cumsum(parsed$auto) + 1 - parsed$auto
        num_panes <- max(code_order)
    }
    else if (break_type == "user") {
        code_order <- cumsum(parsed$user) + 1 - parsed$user
        num_panes <- max(code_order)
    }
    else if (break_type == "non_seq") {
        code_order <- parsed$non_seq
        num_panes <- max(abs(code_order))
    }
    else if (is.numeric(break_type)) {
        code_order <- rep(1, nrow(parsed))
        num_panes <- break_type
    }
    else if (break_type == "rotate") {
        num_panes <- sum(parsed$rotate)
    }
    which_show <- list()
    if (break_type == "rotate") {
        for (i in 1:num_panes) {
            which_show[[i]] <- sort(c(which(!parsed$rotate), 
                which(parsed$rotate)[i]))
        }
    }
    else {
        for (i in 1:num_panes) {
            which_show[[i]] <- which(code_order <= i)
        }
    }
    which_show
}
<bytecode: 0x7ff4a3b47400>
<environment: namespace:flipbookr>
```
]
 
.right-panel-the_code_highlight-auto[

```
[[1]]
[1] 1

[[2]]
[1] 1 2

[[3]]
[1] 1 2 3

[[4]]
[1] 1 2 3 4

[[5]]
[1] 1 2 3 4 5

[[6]]
[1] 1 2 3 4 5 6 7

[[7]]
[1] 1 2 3 4 5 6 7 8

[[8]]
[1] 1 2 3 4 5 6 7 8 9

[[9]]
 [1]  1  2  3  4  5  6  7  8  9 10 11 12

[[10]]
 [1]  1  2  3  4  5  6  7  8  9 10 11 12 13

[[11]]
 [1]  1  2  3  4  5  6  7  8  9 10 11 12 13 14

[[12]]
 [1]  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17
```
]

---
class: split-40
count: false

```r
create_code() %>%  
  code_parse() %>%  
  parsed_calc_show() %>%  
* shown_lines_calc_highlight()
```
]
 
.middle-panel-the_code_highlight-auto[

```
function (which_show = list(c(1, 2), c(1, 2, 3, 4)), break_type = "auto") 
{
    which_highlight <- list()
    if (break_type == "user" | break_type == "auto") {
        which_highlight[[1]] <- which_show[[1]]
    }
    if (break_type == "non_seq" | break_type == "rotate") {
        which_highlight[[1]] <- as.integer(c())
    }
    if (break_type %in% c("user", "auto", "non_seq", "rotate")) {
        for (i in 2:length(which_show)) {
            which_highlight[[i]] <- which_show[[i]][!(which_show[[i]] %in% 
                which_show[[i - 1]])]
        }
    }
    if (is.numeric(break_type)) {
        for (i in 1:length(which_show)) {
            which_highlight[[i]] <- as.integer(c())
        }
    }
    which_highlight
}
<bytecode: 0x7ff4a5200e08>
<environment: namespace:flipbookr>
```
]
 
.right-panel-the_code_highlight-auto[

```
[[1]]
[1] 1

[[2]]
[1] 2

[[3]]
[1] 3

[[4]]
[1] 4

[[5]]
[1] 5

[[6]]
[1] 6 7

[[7]]
[1] 8

[[8]]
[1] 9

[[9]]
[1] 10 11 12

[[10]]
[1] 13

[[11]]
[1] 14

[[12]]
[1] 15 16 17
```
]

---
class: split-40
count: false

```r
create_code() %>%  
  code_parse() %>%  
  parsed_calc_show() %>%  
  shown_lines_calc_highlight() ->  
*hiding
```
]
 
.middle-panel-the_code_highlight-auto[

]
 
.right-panel-the_code_highlight-auto[

]

---

## Based on the calculation, return partial code builds for each frame of the flipbook.

We create a list of strings of the partial builds, which can be saved as an object `code_seq`.

---

```r
create_code() %>%  
  code_parse() %>%  
  parsed_return_partial_code()  
```
]
 
.middle-panel-return_partial_and_sequence-rotate[

]
 
.right-panel-return_partial_and_sequence-rotate[

```
[1] "cars %>%  # the data  "            "  filter(speed > 4) %>%  # subset"
[3] "  ggplot()   # pipe to ggplot#<<" 
```
]

---
class: split-40
count: false

```r
create_code() %>%  
  code_parse() %>%  
* parsed_left_assign_return_partial_code()
```
]
 
.middle-panel-return_partial_and_sequence-rotate[

```
function (parsed, which_show_frame = 1:3, which_highlight_frame = 3) 
{
    the_reveal <- parsed_return_partial_code(parsed, which_show_frame, 
        which_highlight_frame)
    object_to_track <- the_reveal[1] %>% stringr::str_extract(".+\\<-|.+\\=") %>% 
        stringr::str_remove("<-|=") %>% stringr::str_trim()
    c(the_reveal, " ", object_to_track)
}
<bytecode: 0x7ff4a552d390>
<environment: namespace:flipbookr>
```
]
 
.right-panel-return_partial_and_sequence-rotate[

```
[1] "cars %>%  # the data  "            "  filter(speed > 4) %>%  # subset"
[3] "  ggplot()   # pipe to ggplot#<<"  " "                                
[5] NA                                 
```
]

---
class: split-40
count: false

```r
create_code() %>%  
  code_parse() %>%  
* parsed_return_partial_code_sequence()
```
]
 
.middle-panel-return_partial_and_sequence-rotate[

```
function (parsed, break_type = "auto", which_show = parsed_calc_show(parsed = parsed, 
    break_type = break_type), which_highlight = shown_lines_calc_highlight(which_show = which_show, 
    break_type = break_type), left_assign = F) 
{
    partial_code_frames <- list()
    for (i in 1:length(which_show)) {
        if (left_assign == F) {
            partial_code_frames[[i]] <- parsed_return_partial_code(parsed, 
                which_show_frame = which_show[[i]], which_highlight_frame = which_highlight[[i]])
        }
        else {
            partial_code_frames[[i]] <- parsed_left_assign_return_partial_code(parsed, 
                which_show_frame = which_show[[i]], which_highlight_frame = which_highlight[[i]])
        }
    }
    partial_code_frames
}
<bytecode: 0x7ff4a50e6238>
<environment: namespace:flipbookr>
```
]
 
.right-panel-return_partial_and_sequence-rotate[

```
[[1]]
[1] "cars   # the data  #<<"

[[2]]
[1] "cars %>%  # the data  "            "  filter(speed > 4)   # subset#<<"

[[3]]
[1] "cars %>%  # the data  "            "  filter(speed > 4) %>%  # subset"
[3] "  ggplot()   # pipe to ggplot#<<"

[[4]]
[1] "cars %>%  # the data  "            "  filter(speed > 4) %>%  # subset"
[3] "  ggplot() +  # pipe to ggplot"    "  aes(x = speed)   #<<"

[[5]]
[1] "cars %>%  # the data  "            "  filter(speed > 4) %>%  # subset"
[3] "  ggplot() +  # pipe to ggplot"    "  aes(x = speed) +  "             
[5] "  aes(y = dist)   #<<"

[[6]]
[1] "cars %>%  # the data  "            "  filter(speed > 4) %>%  # subset"
[3] "  ggplot() +  # pipe to ggplot"    "  aes(x = speed) +  "             
[5] "  aes(y = dist) +  "               "# Describing what follows"        
[7] "  geom_point(alpha = .3)   #<<"

[[7]]
[1] "cars %>%  # the data  "            "  filter(speed > 4) %>%  # subset"
[3] "  ggplot() +  # pipe to ggplot"    "  aes(x = speed) +  "             
[5] "  aes(y = dist) +  "               "# Describing what follows"        
[7] "  geom_point(alpha = .3) +  "      "  geom_point(alpha = 1)   #<<"

[[8]]
[1] "cars %>%  # the data  "            "  filter(speed > 4) %>%  # subset"
[3] "  ggplot() +  # pipe to ggplot"    "  aes(x = speed) +  "             
[5] "  aes(y = dist) +  "               "# Describing what follows"        
[7] "  geom_point(alpha = .3) +  "      "  geom_point(alpha = 1) +  "      
[9] "  geom_jitter(alpha = .5)   #<<"

[[9]]
 [1] "cars %>%  # the data  "            "  filter(speed > 4) %>%  # subset"
 [3] "  ggplot() +  # pipe to ggplot"    "  aes(x = speed) +  "             
 [5] "  aes(y = dist) +  "               "# Describing what follows"        
 [7] "  geom_point(alpha = .3) +  "      "  geom_point(alpha = 1) +  "      
 [9] "  geom_jitter(alpha = .5) +  "     "  aes(color =  #<<"               
[11] "  speed > 14  #<<"                 "  )   #<<"

[[10]]
 [1] "cars %>%  # the data  "            "  filter(speed > 4) %>%  # subset"
 [3] "  ggplot() +  # pipe to ggplot"    "  aes(x = speed) +  "             
 [5] "  aes(y = dist) +  "               "# Describing what follows"        
 [7] "  geom_point(alpha = .3) +  "      "  geom_point(alpha = 1) +  "      
 [9] "  geom_jitter(alpha = .5) +  "     "  aes(color =  "                  
[11] "  speed > 14  "                    "  ) %+%  "                        
[13] "  cars   #<<"

[[11]]
 [1] "cars %>%  # the data  "            "  filter(speed > 4) %>%  # subset"
 [3] "  ggplot() +  # pipe to ggplot"    "  aes(x = speed) +  "             
 [5] "  aes(y = dist) +  "               "# Describing what follows"        
 [7] "  geom_point(alpha = .3) +  "      "  geom_point(alpha = 1) +  "      
 [9] "  geom_jitter(alpha = .5) +  "     "  aes(color =  "                  
[11] "  speed > 14  "                    "  ) %+%  "                        
[13] "  cars ->  "                       "  my_plot  #<<"

[[12]]
 [1] "cars %>%  # the data  "            "  filter(speed > 4) %>%  # subset"
 [3] "  ggplot() +  # pipe to ggplot"    "  aes(x = speed) +  "             
 [5] "  aes(y = dist) +  "               "# Describing what follows"        
 [7] "  geom_point(alpha = .3) +  "      "  geom_point(alpha = 1) +  "      
 [9] "  geom_jitter(alpha = .5) +  "     "  aes(color =  "                  
[11] "  speed > 14  "                    "  ) %+%  "                        
[13] "  cars ->  "                       "  my_plot  "                      
[15] ""                                  ""                                 
[17] "  1 + 1  #<<"                     
```
]

---
class: split-40
count: false

```r
create_code() %>%  
  code_parse() %>%  
* parsed_return_recent_function()
```
]
 
.middle-panel-return_partial_and_sequence-rotate[

```
function (parsed, which_highlight_frame = 3) 
{
    parsed %>% dplyr::filter(line %in% which_highlight_frame) %>% 
        dplyr::pull(func)
}
<bytecode: 0x7ff4a5008820>
<environment: namespace:flipbookr>
```
]
 
.right-panel-return_partial_and_sequence-rotate[

```
[1] "ggplot"
```
]

---
class: split-40
count: false

```r
create_code() %>%  
  code_parse() %>%  
* parsed_return_recent_function_sequence()
```
]
 
.middle-panel-return_partial_and_sequence-rotate[

```
function (parsed, break_type = "auto", which_show = parsed_calc_show(parsed = parsed, 
    break_type = break_type), which_highlight = shown_lines_calc_highlight(which_show = which_show, 
    break_type = break_type), left_assign = F) 
{
    partial_recent_functions <- list()
    for (i in 1:length(which_show)) {
        if (left_assign == F) {
            partial_recent_functions[[i]] <- parsed_return_recent_function(parsed, 
                which_highlight_frame = which_highlight[[i]]) %>% 
                .[!is.na(.)]
        }
        else {
            partial_recent_functions[[i]] <- parsed_return_recent_function(parsed, 
                which_highlight_frame = which_highlight[[i]]) %>% 
                .[!is.na(.)]
        }
    }
    partial_recent_functions
}
<bytecode: 0x7ff4a25c1660>
<environment: namespace:flipbookr>
```
]
 
.right-panel-return_partial_and_sequence-rotate[

```
[[1]]
character(0)

[[2]]
[1] "filter"

[[3]]
[1] "ggplot"

[[4]]
[1] "aes"

[[5]]
[1] "aes"

[[6]]
[1] "geom_point"

[[7]]
[1] "geom_point"

[[8]]
[1] "geom_jitter"

[[9]]
[1] "aes"

[[10]]
character(0)

[[11]]
character(0)

[[12]]
character(0)
```
]

---
class: middle center inverse

# Step 3 
## Deliver to a presentation platform (here Xaringan)

---

## We have generic code chunk templates ...

---

```r
return_partial_chunks_template_code()  
```
]
 
.middle-panel-returns-rotate[

]
 
.right-panel-returns-rotate[

```
[1] "```{<<<lang>>> <<<chunk_name>>>_<<<break_type>>>_<<<breaks>>>_code, eval = FALSE, echo = TRUE, code = code_seq[[<<<breaks>>>]]}\n```"
```
]

---
class: split-40
count: false

```r
*return_partial_chunks_template_output()
```
]
 
.middle-panel-returns-rotate[

```
function () 
{
    "```{<<<lang>>> <<<chunk_name>>>_<<<break_type>>>_<<<breaks>>>_output, eval = TRUE, echo = FALSE, code = code_seq[[<<<breaks>>>]]}\n```"
}
<bytecode: 0x7ff4a46874e8>
<environment: namespace:flipbookr>
```
]
 
.right-panel-returns-rotate[

```
[1] "```{<<<lang>>> <<<chunk_name>>>_<<<break_type>>>_<<<breaks>>>_output, eval = TRUE, echo = FALSE, code = code_seq[[<<<breaks>>>]]}\n```"
```
]

---
class: split-40
count: false

```r
*return_partial_chunks_template_function()
```
]
 
.middle-panel-returns-rotate[

```
function () 
{
    "```{<<<lang>>> <<<chunk_name>>>_<<<break_type>>>_<<<breaks>>>_function, eval = TRUE, echo = FALSE, code = func_seq[[<<<breaks>>>]]}\n```"
}
<bytecode: 0x7ff4a4686f38>
<environment: namespace:flipbookr>
```
]
 
.right-panel-returns-rotate[

```
[1] "```{<<<lang>>> <<<chunk_name>>>_<<<break_type>>>_<<<breaks>>>_function, eval = TRUE, echo = FALSE, code = func_seq[[<<<breaks>>>]]}\n```"
```
]

---
class: split-40
count: false

```r
*return_markdown(text = "my. short. text.", sep = "\\.")
```
]
 
.middle-panel-returns-rotate[

```
function (text, sep = "|") 
{
    text %>% stringr::str_split(pattern = sep)
}
<bytecode: 0x7ff4a7593bc8>
<environment: namespace:flipbookr>
```
]
 
.right-panel-returns-rotate[

```
[[1]]
[1] "my"     " short" " text"  ""      
```
]

---

## ... which are used to create chunks of code and output displayed side-by-side

```r
chunk_expand(chunk_name = "cars_plot")
```

````
class: split-40
count: false

.left-panel-cars_plot-auto[
```{r cars_plot_auto_1_code, eval = FALSE, echo = TRUE, code = code_seq[[1]]}
```
]
 
.right-panel-cars_plot-auto[
```{r cars_plot_auto_1_output, eval = TRUE, echo = FALSE, code = code_seq[[1]]}
```
]

---
class: split-40
count: false

.left-panel-cars_plot-auto[
```{r cars_plot_auto_2_code, eval = FALSE, echo = TRUE, code = code_seq[[2]]}
```
]
 
.right-panel-cars_plot-auto[
```{r cars_plot_auto_2_output, eval = TRUE, echo = FALSE, code = code_seq[[2]]}
```
]

---

## ... or a series of slides that *just* display output or *just* display code

```r
chunk_expand(num_breaks = 2, display_type = "code")
```

````
count: false

```{r example_auto_1_code, eval = FALSE, echo = TRUE, code = code_seq[[1]]}
```

---
count: false

```{r example_auto_2_code, eval = FALSE, echo = TRUE, code = code_seq[[2]]}
```

```r
chunk_expand(num_breaks = 2, display_type = "output")
```

````
count: false

```{r example_auto_1_output, eval = TRUE, echo = FALSE, code = code_seq[[1]]}
```

---
count: false

```{r example_auto_2_output, eval = TRUE, echo = FALSE, code = code_seq[[2]]}
```

---

# The reveal asks for the chunks we've created to be evaluated, by using the knitr::knit() function.

We've applied it above.  Let's just look at the function itself.

---

```r
define_css()  
```
]
 
.middle-panel-last-rotate[

]
 
.right-panel-last-rotate[
<style>
.left-panel-example-auto {
  color: #777;
  width: 38%;
  height: 92%;
  float: left;
  font-size: 80%
}
.right-panel-example-auto {
  width: 60%;
  float: right;
  padding-left: 1%;
  font-size: 80%
}
.middle-panel-example-auto {
  width: 32%;
  float: left;
  padding-left: 1%;
  font-size: 80%
}
</style>
]

---
class: split-40
count: false

```r
*chunk_expand()
```
]
 
.middle-panel-last-rotate[

```
function (chunk_name = "example", break_type = "auto", display_type = "both", 
    num_breaks = 2, split = 40, title = "", md = NULL, func = NULL, 
    lang = "r", custom = F, width_left = "38%", width_right = "60%", 
    width_middle = "32%", font_size_code = "80%") 
{
    breaks <- 1:num_breaks
    code <- return_partial_chunks_template_code()
    output <- return_partial_chunks_template_output()
    md <- "`r md[<<<breaks>>>]`"
    func <- return_partial_chunks_template_function()
    if (display_type[1] == "both") {
        left <- code
        right <- output
    }
    else if (length(display_type) == 1) {
        left <- get(display_type)
    }
    else if (length(display_type) == 2) {
        left <- get(display_type[1])
        right <- get(display_type[2])
    }
    else if (length(display_type) == 3) {
        left <- get(display_type[1])
        middle <- get(display_type[2])
        right <- get(display_type[3])
    }
    if (length(display_type) == 3) {
        partial_knit_steps <- glue::glue("class: split-<<<split>>>", 
            "count: false", " ", title, ".left-panel-<<<chunk_name>>>-<<<break_type>>>[", 
            left, "]", " ", ".middle-panel-<<<chunk_name>>>-<<<break_type>>>[", 
            middle, "]", " ", ".right-panel-<<<chunk_name>>>-<<<break_type>>>[", 
            right, "]", " ", .open = "<<<", .close = ">>>", .sep = "\n")
    }
    else if (length(display_type) == 2 | display_type[1] == "both") {
        partial_knit_steps <- glue::glue("class: split-<<<split>>>", 
            "count: false", " ", title, ".left-panel-<<<chunk_name>>>-<<<break_type>>>[", 
            left, "]", " ", ".right-panel-<<<chunk_name>>>-<<<break_type>>>[", 
            right, "]", " ", .open = "<<<", .close = ">>>", .sep = "\n")
    }
    else if (length(display_type) == 1) {
        partial_knit_steps <- glue::glue("count: false", title, 
            left, .open = "<<<", .close = ">>>", .sep = "\n")
    }
    the_defined_css <- define_css(chunk_name = chunk_name, break_type = break_type, 
        width_left = width_left, width_middle = width_middle, 
        width_right = width_right, font_size_code = font_size_code)
    slide_code <- glue::glue_collapse(partial_knit_steps, sep = "\n\n---\n")
    glue::glue("{slide_code}\n\n{the_defined_css}\n\n", .trim = FALSE)
}
<bytecode: 0x7ff4a467d3d0>
<environment: namespace:flipbookr>
```
]
 
.right-panel-last-rotate[

````
class: split-40
count: false

.left-panel-example-auto[
```{r example_auto_1_code, eval = FALSE, echo = TRUE, code = code_seq[[1]]}
```
]
 
.right-panel-example-auto[
```{r example_auto_1_output, eval = TRUE, echo = FALSE, code = code_seq[[1]]}
```
]

---
class: split-40
count: false

.left-panel-example-auto[
```{r example_auto_2_code, eval = FALSE, echo = TRUE, code = code_seq[[2]]}
```
]
 
.right-panel-example-auto[
```{r example_auto_2_output, eval = TRUE, echo = FALSE, code = code_seq[[2]]}
```
]

---
class: split-40
count: false

```r
*chunk_reveal
```
]
 
.middle-panel-last-rotate[

]
 
.right-panel-last-rotate[

```
function (chunk_name = NULL, break_type = "auto", left_assign = F, 
    lang = "r", code_seq = NULL, func_seq = NULL, num_breaks = NULL, 
    display_type = "both", split = 40, title = "", md = NULL, 
    width_left = "38%", width_middle = "32%", width_right = "60%", 
    font_size_code = "80%") 
{
    if (!is.null(chunk_name)) {
        code_seq <- chunk_name_return_code_sequence(chunk_name, 
            break_type, left_assign, lang)
        func_seq <- chunk_name_return_function_sequence(chunk_name, 
            break_type, left_assign, lang)
        num_breaks <- length(code_seq)
    }
    text <- chunk_expand(chunk_name = chunk_name, break_type = break_type, 
        num_breaks = num_breaks, display_type = display_type, 
        split = split, title = title, lang = lang, md = md, func = func, 
        width_left = width_left, width_middle = width_middle, 
        width_right = width_right, font_size_code = font_size_code)
    paste(knitr::knit(text = text), collapse = "\n")
}
<bytecode: 0x7ff4a5a05a48>
<environment: namespace:flipbookr>
```
]

---

# Go to code [**here**](https://github.com/EvaMaeRey/flipbookr/blob/master/R/base_parse_reveal_xaringan.R)

https://github.com/EvaMaeRey/flipbookr/blob/master/R/base_parse_reveal_xaringan.R