Rewrite server functionality to use knit expand. Also for full model …

…with a basis in .Rmd (not .R).

.gitignore

@@ -34,9 +34,4 @@ vignettes/*.RData
 inst/shiny/rsconnect
 
 # inst/shiny/www/..
-inst/shiny/www/report_full.Rmd
-inst/shiny/www/report_full.html
-inst/shiny/www/report_full_purl.R
-inst/shiny/www/report_meta.Rmd
-inst/shiny/www/report_meta.html
-inst/shiny/www/report_meta_purl.R
+inst/shiny/www/report_expanded*

inst/shiny/global.R

@@ -1,46 +1,10 @@
-# Function for overwriting the param key of the report YAML
-overwrite_params <- function(file, params) {
-  # Load file into memory
-  .r <- readLines(file)
-  params_lines_start <- which(.r == "#' params:") # Assumes a line on its own
-  params_lines_end <- max(which(.r == "#' ---")) # Assumes 'params:' block is the last element
-
-  #Create YAML
-  tmpfile <- tempfile() # Temp file to hold dput output
-  params_yaml <- character()
-
-  for (i in seq_along(params)) {
-    dput(params[[i]], tmpfile)
-    params_yaml <-
-      c(params_yaml,
-        sprintf("#'   %s: !r %s", names(params)[i],
-                paste0(readLines(tmpfile), collapse = "")))
-  }
-
-  # Insert into character vector
-  new_file <- c(.r[seq_len(params_lines_start - 1)],
-                params_yaml,
-                .r[params_lines_end:length(.r)])
-
-  writeLines(text = new_file, con = file)
+# Function for dput'ting objects into a character string
+cput <- function(x) {
+  f <- tempfile()
+  dput(x, file = f)
+  return(readLines(f))
 }
 
-# Testing function
-# params <- list(file = "../../../data/freshVsFrozen.csv",
-#                header = TRUE, sep = ";",
-#                quote = "\"",
-#                model_cols = c("PreVsPost.Fresh.pval", "PreVsPost.Frozen.pval"),
-#                meta_large_vals = FALSE,
-#                init_par = c(pie1 = 0.7, mu = 1, sigma = 1, rho = 0.5),
-#                meta_method = "NM",
-#                meta_max_ite = 50L,
-#                meta_positive_rho = TRUE,
-#                meta_IDR_thres_type = "IDR",
-#                meta_IDR_thres = 0.05,
-#                theta = GMCM::rtheta())
-# overwrite_params(file = "inst/shiny/www/CopyOfreport_meta.R", params)
-
-
 # Function for plotting meta results
 meta_plot <- function(fit, # A fitted object data
                       idr, # Output from get.IDR

inst/shiny/run-reports.R

@@ -2,14 +2,19 @@ library("knitr")
 library("rmarkdown")
 library("GMCM")
 
-# GENERAL GMCM ----
-report_path <- "inst/shiny/www/report_full.Rmd"
+# dput object to character string
+cput <- function(x) {
+  f <- tempfile()
+  dput(x, file = f)
+  return(readLines(f))
+}
+
 
 # SPECIAL GMCM ----
 report_path <- "inst/shiny/www/report_meta.Rmd"
 
 # Parameters to expand
-params <- list(input_file = "../../../data/u133VsExon.csv",
+params <- list(data_file = "../../../data/u133VsExon.csv",
                header = TRUE,
                sep = ";",
                quote = '\"',
@@ -22,20 +27,17 @@ params <- list(input_file = "../../../data/u133VsExon.csv",
                meta_IDR_thres_type = "IDR",
                meta_IDR_thres = 1e-04)
 
-# dput object to character string
-cput <- function(x) {
-  f <- tempfile()
-  dput(x, file = f)
-  return(readLines(f))
-}
-
 
 expand_args <- c(list(file = report_path), params)
 report_expanded <- do.call(knitr::knit_expand, expand_args)
 report_expanded_path <- gsub("/report_", "/report_expanded_", report_path)
 
 cat(report_expanded, file = report_expanded_path)
 
+# We can also purl
+knitr::purl(report_expanded_path, output = gsub(".Rmd$", ".R", report_expanded_path),
+            documentation = 0)
+
 # Render the expanded document
 rmarkdown::render(
   input = report_expanded_path,
@@ -44,8 +46,40 @@ rmarkdown::render(
   envir = new.env(parent = globalenv())
 )
 
-# We can also purl
+
+
+
+# GENERAL GMCM ----
+report_path <- "inst/shiny/www/report_full.Rmd"
+
+# Parameters to expand
+params <- list(data_file = "../../../data/u133VsExon.csv",
+               header = TRUE,
+               sep = ";",
+               quote = '\"',
+               model_cols = c("u133", "exon"),
+               theta = GMCM::rtheta(m = 2, d = 2),
+               fit_method = "NM",
+               max_ite = 50,
+               full_class_type = "thres_prob",
+               full_thres_prob = 0.9)
+
+expand_args <- c(list(file = report_path), params)
+report_expanded <- do.call(knitr::knit_expand, expand_args)
+report_expanded_path <- gsub("/report_", "/report_expanded_", report_path)
+
+cat(report_expanded, file = report_expanded_path)
+
+# We can purl
 knitr::purl(report_expanded_path, output = gsub(".Rmd$", ".R", report_expanded_path),
             documentation = 0)
 
+# Render the expanded document
+rmarkdown::render(
+  input = report_expanded_path,
+  output_options = list(self_contained = TRUE),
+  params = params,
+  envir = new.env(parent = globalenv())
+)
+
 

inst/shiny/server.R

@@ -966,68 +966,80 @@ shinyServer(function(input, output, session) {
   # Output reports --------
   # https://shiny.rstudio.com/articles/generating-reports.html
 
+  full_expand_rmd <- reactive({
+    # Copy the report file to a temporary directory before processing it, in
+    # case we don't have write permissions to the current working dir (which
+    # can happen when deployed).
+    temp_file <- file.path(tempdir(),  "report_full.Rmd")
+    file.copy("www/report_full.Rmd", temp_file, overwrite = TRUE)
+    message("Copied 'www/report_full.Rmd' into ", temp_file)
+
+
+    # Set up parameters to pass to Rmd document
+    params <- list(data_file = input$in_file$datapath,
+                   header = input$header,
+                   sep = input$sep,
+                   quote = input$quote,
+                   model_cols = input$model_cols,
+                   theta = as.theta(full_start_theta()),
+                   fit_method = input$full_method,
+                   max_ite = input$full_max_ite,
+                   full_class_type = input$full_class_type,
+                   full_thres_prob = input$full_thres_prob)
+
+    # Expand the args in params
+    knit_expand_args <- c(list(file = temp_file), params)
+    report_expanded <- do.call(knitr::knit_expand, knit_expand_args)
+    message(temp_file, " expanded with parameters.")
+
+    # Write the R file and path to it
+    temp_file_out <- gsub("report_", "report_expanded_", temp_file)
+    cat(report_expanded, file = temp_file_out)
+    message("Expanded .Rmd written to ", temp_file_out)
+
+    return(temp_file_out)
+
+  })
+
   output$full_dl_r <- downloadHandler(
     filename = "report_full.R",
     content = function(file) {
-      file.copy("www/report_full.R", file, overwrite = TRUE)
+      expanded_rmd <- full_expand_rmd()
+      outfile <- gsub(".Rmd$", ".R", expanded_rmd)
+      message("purl ", expanded_rmd, " to ", outfile)
+      knitr::purl(expanded_rmd,
+                  output = outfile,
+                  documentation = 0)
+
+      file.copy(outfile, file, overwrite = TRUE)
     }
   )
 
   output$full_dl_rmd <- downloadHandler(
     filename = "report_full.Rmd",
     content = function(file) {
-      temp_file <- file.path(tempdir(), "report_full.R")
-      file.copy("www/report_full.R", temp_file, overwrite = TRUE)
-      out <- spin(hair = temp_file,
-                  knit = FALSE,
-                  format = "Rmd")
-      writeLines(text = readLines(out), con = file)
+      file.copy(full_expand_rmd(), file, overwrite = TRUE)
     }
   )
 
   output$full_dl_html <- downloadHandler(
     filename = "report_full.html",
     content = function(file) {
-      # Copy the report file to a temporary directory before processing it, in
-      # case we don't have write permissions to the current working dir (which
-      # can happen when deployed).
-      temp_file <- file.path(tempdir(), "report_full.R")
-      file.copy("www/report_full.R", temp_file, overwrite = TRUE)
-
-      # Set up parameters to pass to Rmd document
-      params <- list(file = input$in_file$datapath,
-                     header = input$header,
-                     sep = input$sep,
-                     quote = input$quote,
-                     model_cols = input$model_cols,
-                     theta = as.theta(full_start_theta()),
-                     fit_method = input$full_method,
-                     max_ite = input$full_max_ite,
-                     full_class_type = input$full_class_type,
-                     full_thres_prob = input$full_thres_prob)
-      print(str(params))
-
-      # Spin and knit the document, passing in the `params` list, and eval it in a
-      # child of the global environment (this isolates the code in the document
-      # from the code in this app).
+      # Render the expanded Rmd document
       rmarkdown::render(
-        input = temp_file,
+        input = full_expand_rmd(),
         output_file = file,
         output_options = list(self_contained = TRUE),
-        params = params,
         envir = new.env(parent = globalenv())
       )
+      message("Expanded .Rmd rendered.")
     }
   )
 
 
 
 
 
-
-
-
-
   # __SPECIAL GMCM ________________________________________________________ ----
 
   # Initalise reactive values ----
@@ -1292,61 +1304,78 @@ shinyServer(function(input, output, session) {
   # Output reports --------
   # https://shiny.rstudio.com/articles/generating-reports.html
 
+
+  meta_expand_rmd <- reactive({
+    # Copy the report file to a temporary directory before processing it, in
+    # case we don't have write permissions to the current working dir (which
+    # can happen when deployed).
+
+    temp_file <- file.path(tempdir(),  "report_meta.Rmd")
+    file.copy("www/report_meta.Rmd", temp_file, overwrite = TRUE)
+    message("Copied 'www/report_meta.Rmd' into ", temp_file)
+
+    # Set up parameters to pass to Rmd document
+    params <- list(data_file = input$in_file$datapath,
+                   header = input$header,
+                   sep = input$sep,
+                   quote = input$quote,
+                   model_cols = input$model_cols,
+                   meta_large_vals = input$meta_large_vals,
+                   init_par = c(pie1  = input$par1,
+                                mu    = input$par2,
+                                sigma = input$par3,
+                                rho   = input$par4),
+                   meta_method = input$meta_method,
+                   meta_max_ite = input$meta_max_ite,
+                   meta_positive_rho = input$meta_positive_rho,
+                   meta_IDR_thres_type = input$meta_IDR_thres_type,
+                   meta_IDR_thres = input$meta_IDR_thres)
+
+    # Expand the args in params
+    knit_expand_args <- c(list(file = temp_file), params)
+    report_expanded <- do.call(knitr::knit_expand, knit_expand_args)
+    message(temp_file, " expanded with parameters.")
+
+    # Write the R file and path to it
+    temp_file_out <- gsub("report_", "report_expanded_", temp_file)
+    cat(report_expanded, file = temp_file_out)
+    message("Expanded .Rmd written to ", temp_file_out)
+
+    return(temp_file_out)
+  })
+
   output$meta_dl_r <- downloadHandler(
     filename = "report_meta.R",
     content = function(file) {
-      file.copy("www/report_meta.R", file, overwrite = TRUE)
+      expanded_rmd <- meta_expand_rmd()
+      outfile <- gsub(".Rmd$", ".R", expanded_rmd)
+      message("purl ", expanded_rmd, " to ", outfile)
+      knitr::purl(expanded_rmd,
+                  output = outfile,
+                  documentation = 0)
+
+      file.copy(outfile, file, overwrite = TRUE)
     }
   )
 
   output$meta_dl_rmd <- downloadHandler(
     filename = "report_meta.Rmd",
     content = function(file) {
-      temp_file <- file.path(tempdir(), "report_meta.R")
-      file.copy("www/report_meta.R", temp_file, overwrite = TRUE)
-      out <- spin(hair = temp_file,
-                  knit = FALSE,
-                  format = "Rmd")
-      writeLines(text = readLines(out), con = file)
+      file.copy(meta_expand_rmd(), file, overwrite = TRUE)
     }
   )
 
   output$meta_dl_html <- downloadHandler(
     filename = "report_meta.html",
     content = function(file) {
-      # Copy the report file to a temporary directory before processing it, in
-      # case we don't have write permissions to the current working dir (which
-      # can happen when deployed).
-      temp_file <- file.path(tempdir(), "report_meta.R")
-      file.copy("www/report_meta.R", temp_file, overwrite = TRUE)
-
-      # Set up parameters to pass to Rmd document
-      params <- list(file = input$in_file$datapath,
-                     header = input$header,
-                     sep = input$sep,
-                     quote = input$quote,
-                     model_cols = input$model_cols,
-                     meta_large_vals = input$meta_large_vals,
-                     init_par = c(pie1  = input$par1,
-                                  mu    = input$par2,
-                                  sigma = input$par3,
-                                  rho   = input$par4),
-                     meta_method = input$meta_method,
-                     meta_max_ite = input$meta_max_ite,
-                     meta_positive_rho = input$meta_positive_rho,
-                     meta_IDR_thres_type = input$meta_IDR_thres_type,
-                     meta_IDR_thres = input$meta_IDR_thres)
-
-      # Spin and knit the document, passing in the `params` list, and eval it in a
-      # child of the global environment (this isolates the code in the document
-      # from the code in this app).
+      # Render the expanded Rmd document
       rmarkdown::render(
-        input = temp_file,
+        input = meta_expand_rmd(),
         output_file = file,
         output_options = list(self_contained = TRUE),
-        params = params,
         envir = new.env(parent = globalenv())
       )
+      message("Expanded .Rmd rendered.")
     }
   )