R/iNZcodeWidget.R

iNZcodeWidget <- setRefClass(
    "iNZcodeWidget",
    fields = list(
        GUI = "ANY",
        history = "list",      ## each list is a vector of commands
        keep.last = "logical", ## if FALSE, the last element of history is replaced on update
        packages = "character",
        disabled = "logical"
    ),
    methods = list(
        initialize = function(gui) {
            initFields(GUI = gui, keep.last = TRUE,
                       packages = c("iNZightPlots", "magrittr"), disabled = FALSE)
            history <<- list()
        },
        add = function(x, keep = TRUE, tidy = FALSE) {
            x <- gsub("^SEP$", sep(), x)
            #if (tidy && requireNamespace("formatR", quietly = TRUE))
            #    x <- capture.output(formatR::tidy_source(text = x, width.cutoff = 60))
            if (!keep.last) history <<- history[-length(history)]
            history <<- c(history, list(c("", x)))
            keep.last <<- keep
            ## append any new packages ...?
            if (any(grepl("::", x))) {
                sapply(x[grepl("::", x)], function(y) {
                    m <- regexpr("[a-zA-Z0-9]+::", y)
                    pkg <- substr(y, m, m + attr(m, "match.length") - 2)
                    if (!pkg %in% packages) packages <<- c(packages, pkg)
                })
            }
            if (any(grepl("library\\([a-zA-Z0-9]+\\)", x))) {
                sapply(x[grepl("library\\([a-zA-Z0-9]+\\)", x)], function(y) {
                    m <- regexpr("library\\([a-zA-Z0-9]+\\)", y)
                    pkg <- gsub(".*library\\(|\\).*", "", substr(y, m, m + attr(m, "match.length")))
                    if (!pkg %in% packages) packages <<- c(packages, pkg)
                })
            }
            invisible(NULL)
        },
        get = function() {
            code <- do.call(c,
                lapply(history, function(x) {
                    return(x)
                    y <- try({
                        iNZightTools::tidy_all_code(
                            paste(x, collapse = "\n"),
                            width = 80,
                            indent = 4
                        )
                    }, silent = TRUE)
                    if (inherits(y, "try-error")) x else c(y, "")
                })
            )
            return(c(header(), code))
        },
        update = function() {
            if (disabled) return()
            ## look at the data - has it got code? update the history with the code!
            code <- GUI$getActiveDoc()$getCode()
            if (!is.null(code)) {
                if (length(code) == 1 && code == "") return()
                dname <- attr(GUI$getActiveData(), "name", exact = TRUE)
                if (is.null(dname) || dname == "")
                  dname <- sprintf("data%s", ifelse(GUI$activeDoc == 1, "", GUI$activeDoc))
                dname <- iNZightTools:::create_varname(dname)
                if (!any(grepl(".dataset", code))) {
                  code <- c(sprintf("%s <- ", dname), code)
                  add(code, keep = TRUE, tidy = TRUE)
                } else {
                  code <- gsub("\ +", " ", # one or more spaces with just one space!
                    paste(gsub(".dataset", dname, code, fixed = TRUE), collapse = ""))
                  code <- gsub(" %>% ", " %>% \n    ", code)
                  ## replace data %>% foo() with data %<>% foo()
                  ## before the first one, add a comment explaining what %<>% does
                  asgnpipe <- paste(dname, "%<>% ")
                  # if (!any(sapply(history, function(x) any(grepl('%<>%', x)))))
                  #   asgnpipe <- paste(collapse = "\n",
                  #     c("## The `%<>%` operator pipes and assigns, and is the equivalent of",
                  #       "## data <- data %>% function(...), which is the equivalent of",
                  #       "## data <- function(data, ...)", "", asgnpipe))
                  code <- gsub(paste0(dname, " %>% \n    "), asgnpipe, code)
                  add(code, keep = TRUE)
                }
            } else {
                add("## NOTE:  missing code")
            }
        },
        header = function() {
            c("# iNZight Code History",
              "",
              sprintf("## This script was automatically generated by iNZight v%s", packageVersion("iNZight")),
              "",
              "## BETA WARNING: we're still working on making this as accurate",
              "##               as possible, so please ... ",
              "##  - expect 'gaps' in the generated code (i.e., missing actions), and",
              "##  - LET US KNOW if you think something's missing",
              "##    (if you can give a minimal step-by-step to reproduce the problem, ",
              "##     that would be incredibly useful!)",
              "##    email: [email protected]",
              "",
              sep(),
              "",
              "## This script assumes you have various iNZight packages installed.",
              "## Uncomment the following lines if you don't:",
              "",
              sprintf("# install.packages(c('%s'), ", paste(packages, collapse = "',\n#                    '")),
              "#     repos = c('https://r.docker.stat.auckland.ac.nz',",
              "#               'https://cran.rstudio.com'))",
              "",
              sep(),
              "",
              "library(magrittr)  # enabled the pipe (%>%) operator",
              "")
        },
        sep = function(width = 80) {
            paste("##", paste(rep("-", width - 6), collapse = ""), "##")
        },
        enable = function() disabled <<- FALSE,
        disable = function() disabled <<- TRUE
    )
)
iNZightVIT/iNZight documentation built on Nov. 13, 2019, 7:08 a.m.