inst/app/tools/app/report_rmd.R

In radiant-rstats/radiant.data: Data Menu for Radiant: Business Analytics using R and Shiny

################################################################
# Create dynamic reports using Radiant and the shinyAce editor
################################################################
rmd_switch <- c(
  "Switch tab" = "switch",
  "Don't switch tab" = "no_switch"
)
rmd_generate <- c(
  "Auto paste" = "auto",
  "Manual paste" = "manual"
)
rmd_save_type <- c("Notebook", "HTML", "PDF", "Word", "Powerpoint", "Rmd")
rmd_set <- c("To Rmd", "auto", "manual")
rmd_set_rstudio <- c("To Rmd", "To R")

if (rstudioapi::isAvailable()) {
  rmd_generate <- c(
    "Auto paste" = "auto",
    "Manual paste" = "manual",
    "To Rstudio (Rmd)" = "To Rmd",
    "Use Report > R" = "Use R"
  )
} else if (!isTRUE(rmarkdown::pandoc_available())) {
  rmd_save_type <- c("HTML", "Rmd")
}

## can still save report, code, and data without permission to run code
if (!isTRUE(getOption("radiant.report"))) {
  rmd_save_type <- "Rmd"
}

if (Sys.getenv("R_ZIPCMD") != "") {
  rmd_save_type <- c(rmd_save_type, "Rmd + Data (zip)")
}

rmd_view_options <- c(
  "Dual view" = "dual",
  "Preview only" = "pr_only",
  "Editor only" = "ed_only"
)

rmd_example <- "## Sample report

This is an example of the type of report you can write in Radiant.

* You can create
* bullet lists

1. And numbered
2. lists

Note: Markdown is used to format the report. Go to [commonmark.org](http://commonmark.org/help/) for an interactive tutorial.

### Math

You can even include math if you want:

$$
\\begin{aligned}
  y_t &= \\alpha + \\beta x_t + \\epsilon_{yt}, \\\\
  z_t &= 3 \\times 9 + y_t + \\epsilon_{zt}.
\\end{aligned}
$$

To show the output, press the `Knit report (Rmd)` button.

### Tables

To generate a table that will display properly in both PDF and HTML you can use a layout similar to the example below:

Year  |  Outcome  |  Prior probability
:---- | --------: | :----------------------:
2013  | Win       |  0.30
2014  | Loss      |  0.25
2015  | Win       |  0.20

Note that the columns are left-aligned, right-aligned, and centered using a `:`. Alternatively you can create a `tibble` with the information to be put in the table and use the `kable` function from the `knitr` package to generate the desired output. See example below:

```{r}
tbl <- tibble::tibble(
  Year = c(2013L, 2014L, 2015L),
  Outcome = c(\"Win\", \"Loss\", \"Win\"),
  `Prior probability` = c(0.30, 0.25, 0.20)
)

knitr::kable(tbl, align = \"ccc\")
```

To align the columns, use `l` for left, `r` for right, and `c` for center. In the example above each column is centered. For additional information about formatting tables see
https://www.rforge.net/doc/packages/knitr/kable.html

It is also possible to generate interactive tables using the DT package. In Radiant you can use the `dtab` function to display a data.frame as a nicely formatted table:

```{r}
dtab(tbl) %>% render()
```

### Documenting analysis results in Radiant

The report feature in Radiant should be used in conjunction with the <i title='Report results' class='fa fa-edit'></i> icons shown at the bottom of the side bar on (almost) all pages. When that icon is clicked the command used to create the output is copied into the editor in the _Report > Rmd_ tab. By default Radiant will paste the code generated for the analysis you just completed at the bottom of the report (i.e., `Auto paste`). However, you can turn off that feature by selecting `Manual paste` from the dropown. With manual paste on, the code is put in the clipboard when you click a report icon and you can paste it where you want in the _Report > Rmd_ editor window.

By clicking the `Knit report (Rmd)` button or pressing CTRL-enter (CMD-enter on Mac), the output from the analysis will be (re)created. You can add text, bullets, headers, etc. around the code chunks to describe and explain the results using <a href='https://rmarkdown.rstudio.com/authoring_pandoc_markdown.html' target='_blank'>markdown</a>. You can also select part of the report you want to render.

Below is some code generated by Radiant to produce a scatterplot / heatmap of the price of diamonds versus carats. The colors in the plot reflect the clarity of the diamond.

```{r fig.width = 7, fig.height = 5, dpi = 96}
visualize(
  diamonds,
  xvar = \"carat\",
  yvar = \"price\",
  type = \"scatter\",
  nrobs = 1000,
  color = \"clarity\",
  labs = list(title = \"Diamond prices\", x = \"Carats\", y = \"Price ($)\"),
  custom = FALSE
)
```

> **Put your own code here or delete this sample report and create your own**

"

## allow running code through button or keyboard shortcut
report_rmd <- reactiveValues(report = 0, knit_button = 0, clear = 0)

output$ui_rmd_generate <- renderUI({
  isolate({
    init <- ifelse(state_init("r_generate", "Use Rmd") != "Use Rmd", "Use R", "auto")
  })
  selectInput(
    inputId = "rmd_generate",
    label = NULL,
    choices = rmd_generate,
    selected = state_init("rmd_generate", init),
    multiple = FALSE,
    selectize = FALSE,
    width = "140px"
  )
})

output$ui_rmd_view <- renderUI({
  req(input$rmd_generate)
  selectInput(
    "rmd_view",
    label = NULL, choices = rmd_view_options,
    selected = state_init("rmd_view", "dual"),
    multiple = FALSE, selectize = FALSE, width = "120px"
  )
})

observeEvent(input$rmd_generate, {
  if (isTRUE(input$rmd_generate == "To Rmd")) {
    updateSelectInput(session, "rmd_switch", selected = "no_switch")
    updateSelectInput(session, "rmd_view", selected = "pr_only")
    report_rmd$clear <- 1

    no_rmd <- function() {
      ## popup to suggest user create an .Rmd file
      showModal(
        modalDialog(
          title = "Radiant to Rmd (Rstudio)",
          span(
            "Radiant is set to use an rmarkdown document in Rstudio
            ('To Rstudio (Rmd)'). However, the active document in
            Rstudio does not seem to be of type .Rmd. Please open an
            existing .Rmd file or create a new one in Rstudio. The
            file must be saved to disk before it can be accessed. If
            you want to use the editor in Radiant instead, change
            'To Rstudio (Rmd)' to 'Auto paste' or 'Manual paste'."
          ),
          footer = modalButton("OK"),
          size = "m",
          easyClose = TRUE
        )
      )
    }

    ## get info from rstudio editor
    cnt <- rstudio_context(type = "rmd")
    if (is.empty(cnt$path) || cnt$ext != "rmd") {
      rmd <- r_state$radiant_rmd_name
      if (!is.empty(rmd)) {
        if (file.exists(rmd)) {
          ## useful if you are not using an Rstudio project
          rstudioapi::navigateToFile(rmd)
        } else {
          pdir <- getOption("radiant.project_dir", default = radiant.data::find_home())
          path <- file.path(pdir, rmd)
          if (file.exists(path)) {
            rstudioapi::navigateToFile(path)
          } else {
            no_rmd()
          }
        }
      } else {
        no_rmd()
      }
    }
  } else if (state_init("rmd_generate", "auto") == "Use R") {
    if (state_init("r_generate", "auto") == "Use Rmd") {
      updateSelectInput(session, "r_generate", selected = "auto")
    }
  } else {
    updateSelectInput(session, "r_generate", selected = "Use Rmd")
    updateSelectInput(session, "rmd_switch", selected = "switch")
    updateSelectInput(session, "rmd_view", selected = "dual")
  }
})

output$ui_rmd_switch <- renderUI({
  req(input$rmd_generate)
  selectInput(
    inputId = "rmd_switch", label = NULL,
    choices = rmd_switch,
    selected = state_init("rmd_switch", "switch"),
    multiple = FALSE, selectize = FALSE,
    width = "140px"
  )
})

output$ui_rmd_save_type <- renderUI({
  selectInput(
    inputId = "rmd_save_type", label = NULL,
    choices = rmd_save_type,
    selected = state_init("rmd_save_type", rmd_save_type[1]),
    multiple = FALSE, selectize = FALSE,
    width = "140px"
  )
})

conditional_save_report <- function(id) {
  if (isTRUE(getOption("radiant.report"))) {
    download_button(id, "Save report", class = "btn-primary")
  } else {
    invisible()
  }
}

conditional_read_files <- function(id) {
  if (getOption("radiant.shinyFiles", FALSE)) {
    download_button(id, "Read files", class = "btn-primary")
  } else {
    invisible()
  }
}

output$ui_rmd_load <- renderUI({
  file_upload_button(
    "rmd_load",
    accept = c(".Rmd", ".rmd", ".md", ".html"),
    buttonLabel = "Load report",
    title = "Load report",
    class = "btn-default"
  )
})

if (getOption("radiant.shinyFiles", FALSE)) {
  output$ui_rmd_read_files <- renderUI({
    shinyFiles::shinyFilesButton(
      "rmd_read_files", "Read files", "Generate code to read selected file",
      multiple = FALSE, icon = icon("book", verify_fa = FALSE), class = "btn-primary"
    )
  })
  sf_rmd_read_files <- shinyFiles::shinyFileChoose(
    input = input,
    id = "rmd_read_files",
    session = session,
    roots = sf_volumes
  )
}

radiant_auto_complete <- reactive({
  req(input$dataset)
  comps <- list(r_info[["datasetlist"]], as.vector(varnames()))
  names(comps) <- c("{datasets}", paste0("{", input$dataset, "}"))
  comps
})

output$report_rmd <- renderUI({
  tagList(
    with(
      tags,
      table(
        td(
          help_modal(
            "Report > Rmd", "rmd_help",
            inclMD(file.path(getOption("radiant.path.data"), "app/tools/help/report_rmd.md")),
            lic = "by-sa"
          )
        ),
        td(HTML("&nbsp;&nbsp;")),
        td(
          actionButton(
            "rmd_knit", " Knit report (Rmd)",
            icon = icon("play", verify_fa = FALSE),
            class = "btn-success"
          ),
          class = "top_small"
        ),
        td(uiOutput("ui_rmd_generate"), class = "top_small"),
        td(uiOutput("ui_rmd_view"), class = "top_small"),
        td(uiOutput("ui_rmd_switch"), class = "top_small"),
        td(uiOutput("ui_rmd_save_type"), class = "top_small"),
        td(conditional_save_report("rmd_save"), class = "top_small"),
        td(uiOutput("ui_rmd_load"), class = "top_small"),
        td(conditional_read_files("rmd_read_files"), class = "top_small"),
        td(actionButton("rmd_clear", "Clear output", icon = icon("trash", verify_fa = FALSE), class = "btn-danger"), class = "top_small")
      )
    ),
    shinyAce::aceEditor(
      "rmd_edit",
      selectionId = "selection",
      mode = "markdown",
      theme = getOption("radiant.ace_theme", default = "tomorrow"),
      wordWrap = TRUE,
      debounce = 0,
      height = "auto",
      value = state_init("rmd_edit", rmd_example) %>% fix_smart(),
      placeholder = "Type text for your report using markdown to format it\n(http://commonmark.org/help/). Add R-code to include\nyour analysis results in the report as well. Click the ?\nicon on the top left of your screen for more information",
      vimKeyBinding = getOption("radiant.ace_vim.keys", default = FALSE),
      code_hotkeys = list("r", list(hotkey = list(win = "CTRL-ENTER|SHIFT-ENTER", mac = "CMD-ENTER|SHIFT-ENTER"))),
      tabSize = getOption("radiant.ace_tabSize", 2),
      useSoftTabs = getOption("radiant.ace_useSoftTabs", TRUE),
      showInvisibles = getOption("radiant.ace_showInvisibles", FALSE),
      autoComplete = getOption("radiant.ace_autoComplete", "enable"),
      # autoCompleters = c("static", "text", "rlang"),
      autoCompleters = c("static", "rlang"),
      autoCompleteList = isolate(radiant_auto_complete())
    ),
    htmlOutput("rmd_knitted"),
    getdeps()
  )
})

# radiant_rmd_annotater <- shinyAce::aceAnnotate("rmd_edit")
radiant_rmd_tooltip <- shinyAce::aceTooltip("rmd_edit")
radiant_rmd_ac <- shinyAce::aceAutocomplete("rmd_edit")

## auto completion of available R functions, datasets, and variables
observe({
  ## don't need to run until report generated
  req(report_rmd$report > 1)
  shinyAce::updateAceEditor(
    session, "rmd_edit",
    # autoCompleters = c("static", "text", "rlang"),
    autoCompleters = c("static", "rlang"),
    autoCompleteList = radiant_auto_complete()
  )
})

observeEvent(input$rmd_knit, {
  ## hack to allow processing current line
  report_rmd$knit_button <- 1
})

observeEvent(input$rmd_clear, {
  ## hack to allow clearing output
  ## see https://groups.google.com/d/msg/shiny-discuss/PiU6PzQ_iSc/NsJkSDDCmlwJ
  report_rmd$clear <- 1
})

observe({
  input$rmd_edit_hotkey
  if (!is.null(input$rmd_knit)) {
    isolate({
      report_rmd$report <- report_rmd$report + 1
      report_rmd$clear <- 0
    })
  }
})

output$rmd_view <- renderUI({
  req(input$rmd_generate, input$rmd_view)
  if (input$rmd_view == "ed_only") {
    tags$head(tags$style(
      HTML("#rmd_edit {right: 0; left: 0;} #rmd_knitted {left: 200%; right: -100%;}")
    ))
  } else if (input$rmd_view == "pr_only") {
    tags$head(tags$style(
      HTML("#rmd_edit {right: 200%; left: -100%;} #rmd_knitted {left: 0; right: 0;}")
    ))
  } else {
    tags$head(tags$style(
      HTML("#rmd_edit {right: 50%; left: 0;} #rmd_knitted {left: 50%; right: 0;}")
    ))
  }
})

rmd_knitted <- eventReactive(report_rmd$report != 1, {
  if (!isTRUE(getOption("radiant.report"))) {
    HTML("<h2>Report was not evaluated. If you have sudo access to the server set options(radiant.report = TRUE) in .Rprofile for the shiny user </h2>")
  } else {
    report <- ""
    report_type <- "full report"
    if (isTRUE(input$rmd_generate == "To Rmd")) {
      cnt <- rstudio_context(type = "rmd")
      if (is.empty(cnt$path) || is.empty(cnt$ext, "r")) {
        ## popup to suggest user create an .Rmd file
        showModal(
          modalDialog(
            title = "Report Rstudio (Rmd)",
            span(
              "Report is set to use an rmarkdown document in Rstudio
              ('To Rstudio (Rmd)'). Please check that you have an .Rmd file
              open in Rstudio and that the file has been saved to disk.
              If you want to use the editor in Radiant instead, change
              'To Rstudio (Rmd)' to 'Auto paste' or 'Manual paste'."
            ),
            footer = modalButton("OK"),
            size = "m",
            easyClose = TRUE
          )
        )
        report_type <- "nothing"
        report <- ""
      } else {
        if (cnt$path != cnt$rpath) {
          r_state$radiant_rmd_name <<- cnt$rpath
        } else {
          r_state$radiant_rmd_name <<- cnt$path
        }

        report_type <- "Rmarkdown file in Rstudio"
        report <- cnt$content
      }
    } else if (!is.empty(input$rmd_edit)) {
      if (!is.empty(input$rmd_edit_selection, "")) {
        report <- input$rmd_edit_selection
        report_type <- "report selection"
      } else if (!is.empty(input$rmd_edit_hotkey$line, "") && report_rmd$knit_button == 0) {
        report <- input$rmd_edit_hotkey$line
        report_type <- "report selection"
      } else {
        report <- input$rmd_edit
        ## hack to allow processing current line
        report_rmd$knit_button <- 0
      }
    }

    withProgress(message = glue("Knitting {report_type}"), value = 1, {
      knit_it(report, type = "rmd")
    })
  }
})

output$rmd_knitted <- renderUI({
  req(report_rmd$report != 1 && report_rmd$clear == 0)
  rmd_knitted()
})

report_save_filename_rmd <- function() {
  report_save_filename(type = "rmd", full.name = FALSE)
}

download_handler(
  id = "rmd_save",
  label = "Save report",
  fun = function(x, type = "rmd") report_save_content(x, type),
  fn = function() report_save_filename_rmd() %>% sans_ext(),
  type = function() {
    report_save_filename_rmd() %>%
      {
        if (grepl("nb\\.html", .)) "nb.html" else tools::file_ext(.)
      }
  },
  caption = "Save report",
  btn = "button",
  class = "btn-primary"
)

observeEvent(input$rmd_load, {
  ## loading report from disk
  if (getOption("radiant.shinyFiles", FALSE)) {
    if (is.integer(input$rmd_load)) {
      return()
    }
    inFile <- shinyFiles::parseFilePaths(sf_volumes, input$rmd_load)
    if (nrow(inFile) == 0) {
      return()
    }
    path <- inFile$datapath
    pp <- parse_path(path, pdir = getOption("radiant.project_dir", radiant.data::find_home()), chr = "", mess = FALSE)
  } else {
    inFile <- input$rmd_load
    path <- inFile$datapath
    pp <- list(
      path = path,
      filename = inFile$name,
      fext = tools::file_ext(inFile$name)
    )
  }

  if (!inherits(path, "try-error") && !is.empty(path)) {
    if (pp$fext == "html") {
      ## based on https://rmarkdown.rstudio.com/r_notebook_format.html
      rmd <- try(rmarkdown::parse_html_notebook(pp$path), silent = TRUE)
      if (!inherits(rmd, "try-error")) {
        rmd <- paste0(rmd$rmd, collapse = "\n")
        r_state$radiant_rmd_name <<- sub("(\\.nb\\.html|\\.html)", ".Rmd", pp$path)
      } else {
        rmd <- "#### The selected html file could not be parsed and does not contain rmarkdown content"
      }
    } else {
      rmd <- paste0(readLines(pp$path), collapse = "\n")
      if (getOption("radiant.shinyFiles", FALSE)) {
        r_state$radiant_rmd_name <<- pp$path
      } else {
        r_state$radiant_rmd_name <<- pp$filename
      }
    }

    rmd <- sub("^---\n(.*?)\n---\n*", "", rmd)
    r_state$rmd_edit <- radiant.data::fix_smart(rmd)

    ## update editor and remove yaml header if present
    shinyAce::updateAceEditor(session, "rmd_edit",
      value = r_state$rmd_edit
    )
  }
})

observeEvent(input$rmd_read_files, {
  if (is.integer(input$rmd_read_files)) {
    return()
  }
  path <- shinyFiles::parseFilePaths(sf_volumes, input$rmd_read_files)
  if (inherits(path, "try-error") || is.empty(path$datapath)) {
    return()
  }
  ldir <- getOption("radiant.launch_dir", default = radiant.data::find_home())
  pdir <- getOption("radiant.project_dir", default = ldir)

  cmd <- read_files(path$datapath, pdir = pdir, type = "rmd", clipboard = FALSE, radiant = TRUE)
  if (!is.empty(cmd)) {
    update_report_fun(cmd, type = "rmd", rfiles = TRUE)
  }
})

observeEvent(input$rmd_edit, {
  r_state$rmd_edit <<- fix_smart(input$rmd_edit)
})