addresses #101, #121, #122, #123

R/accessors.R

@@ -11,8 +11,6 @@
 #' @param .pretty A binary argument whether `code()` should prettify the output using the tidyverse style guide. defaults to TRUE.
 #'
 #' @importFrom dplyr select
-#' @importFrom styler style_text
-#' @importFrom styler create_style_guide
 #' @importFrom rlang expr
 #' @importFrom tibble as_tibble
 #' @importFrom tidyselect everything

R/engine_multiverse.R

@@ -5,6 +5,7 @@
 #' @importFrom formatR tidy_source
 #' @importFrom purrr map_chr
 #' @importFrom rlang is_condition
+#' @importFrom rlang is_true
 #' 
 multiverse_engine <- function(options) {
   if(is.null(options$inside)) stop("A multiverse object should be specified with", 
@@ -86,47 +87,66 @@ multiverse_default_block_exec <- function(.code, options, knit = FALSE) {
     .multiverse = options$inside
     # execute_multiverse(.multiverse)
 
-    # when knitting we are not performing any traditional evaluation
-    # hence we can not evaluate the code chunk using default evaluation
-    # changing this to TRUE would execute the default universe and show 
-    # the relevant output
-    # What we want is to create a `div` for each universe
-    # options$eval = TRUE
-    # options$class.source = "multiverse"
-
-    options$eval = FALSE
     options$engine = "R"
     options$comment = ""
     options$dev = 'png'
+    options$echo = TRUE
+    options$tidy = 'styler'
+    multiverse_options = options
 
     eng_r = knit_engines$get("R")
 
+    # preserves the original declaration of the multiverse code block
+    # i.e. with the branch syntax which specifies alternative analyses
+    multiverse_options$eval = FALSE
+    multiverse_options$class.source = "multiverse-spec"
+    multiverse_options$class.output = "multiverse-spec"
+
     if (getOption("multiverse_code_blocks", 1) == "asis") {
       return(eng_r(options))
-    }
-
-    # if (options$eval != FALSE) {
-    options_list <- lapply(1:size(.multiverse), function(x) {
-      temp_options <- options
-      temp_options$code = tidy_source(text = map_chr(
-        tail(head(deparse(expand(.multiverse)[[".code"]][[x]][[options$label]]), -1), -1),
-        ~ gsub(pattern = " ", replacement = "", x = .)
-      ))$text.tidy
-
-      # assuming default is the first universe,
-      # conditional should be change to use the default universe argument
-      if (x == 1) {
-          temp_options$class.source = paste0("multiverse universe-", x, " default")
-          temp_options$class.output = paste0("multiverse universe-", x, " default")
+    } else {
+      options_list <- lapply(1:size(.multiverse), function(x) {
+        temp_options <- options
+        temp_options$code = tidy_source(text = map_chr(
+          tail(head(deparse(expand(.multiverse)[[".code"]][[x]][[options$label]]), -1), -1),
+          ~ gsub(pattern = " ", replacement = "", x = .)
+        ))$text.tidy
+
+        temp_options$label = paste0(temp_options$label, "-universe-", x) 
+
+        .assignment = expand(M)[[".parameter_assignment"]][[x]]
+        class_name = paste(names(.assignment), .assignment, sep="---", collapse=" ")
+
+        # assuming default is the first universe,
+        # conditional should be change to use the default universe argument
+        if (x == 1) {
+            temp_options$class.source = paste0("multiverse universe-", x, " ", class_name, " default")
+            temp_options$class.output = paste0("multiverse universe-", x, " ", class_name, " default")
+        } else {
+            temp_options$class.source = paste0("multiverse universe-", x, " ", class_name, "")
+            temp_options$class.output = paste0("multiverse universe-", x, " ", class_name, "")
+        }
+
+        temp_options
+      })
+
+
+      # when knitting we are not performing any traditional evaluation
+      # hence we can not evaluate the code chunk using default evaluation
+      # changing this to TRUE would execute the default universe and show 
+      # the relevant output
+      # What we want is to create a `div` for each universe
+      # if knitting as multiverse, need to execute all code chunks
+      if (is_true(options$knit_as_emar)) {
+        # evaluate the code in all code chunks and show output
+        options$eval = TRUE
+        env_list = expand(.multiverse)[[".results"]]
+        unlist(mapply(eng_r, options_list, env_list))
       } else {
-          temp_options$class.source = paste0("multiverse universe-", x, "")
-          temp_options$class.output = paste0("multiverse universe-", x, "")
+        options$eval = FALSE
+        eng_r(multiverse_options)
       }
-
-      temp_options
-    })
-    unlist(lapply(options_list, eng_r))
-    # }
+    }
   } else {
     # when in interactive mode, execute the default analysis in the knitr global environment
 
@@ -151,3 +171,5 @@ multiverse_default_block_exec <- function(.code, options, knit = FALSE) {
 }
 
 knitr::knit_engines$set(multiverse = multiverse_engine)
+
+

R/export_json.R

@@ -15,7 +15,36 @@ globalVariables(c(".max", ".min", "cdf.x", "cdf.y", "limits", "universe"))
 #' `distribution` for each coefficient
 #' @param filename filename on disk (as a character string)
 #' 
-#' @return a data frame or a JSON file
+#' @return a JSON file or (if a filepath is not specified) a dataframe for the results file and a list for the code file
+#' @format ## `results` JSON file schema
+#' It consists of a list of objects (where each object corresponds to one analysis in the multiverse). 
+#' Within this object, the results attribute contains a(nother) list of objects corresponding to each outcome variable. 
+#' For e.g., here we have four coefficients (see the results of the regression model), and thus the results attribute will contain four objects. 
+#' Each object has the following attributes:
+#' - `term`: name of the outcome variable
+#' - `estimate`: mean / median point estimate i.e., $\mathbb{E}(\mu)$ for any parameter $\mu$.
+#' - `std.error`: standard error for the point estimate i.e., $\sqrt{\text{var}(\mu)}$
+#' - `cdf.x`: a list of quantiles
+#' - `cdf.y`: a list of cumulative probability density estimates corresponding to the quantiles
+#' 
+#' In addition, it also contains the following attributes, but these are not currently used by Milliways:
+#' - `statistic`
+#' - `p.value`
+#' - `conf.low`
+#' - `conf.high`
+#' 
+#' 
+#' @format ## `code` JSON file schema
+#' It consists of two attributes: `code` and `parameters`. 
+#' `code` is a list of strings consisting of the R and multiverse syntax used to implement the analysis. For readability, we
+#' use [styler] to break up the declared code.
+#' `parameters` is an object listing the parameter names and the corresponding options for each of the parameters declared in the analysis.
+#' 
+#' @format ## `data` JSON file schema
+#' It consists of a list of objects, each with two attributes: `field` and `values`. 
+#' `field` is the name of a column corresponding to a variable in the dataset. 
+#' `values` are a list of values for that variable in the dataset.
+#' 
 #' 
 #' @examples
 #' \donttest{
@@ -48,7 +77,7 @@ globalVariables(c(".max", ".min", "cdf.x", "cdf.y", "limits", "universe"))
 #' multiverse::expand(M) %>%
 #'   extract_variables(res) %>%
 #'   unnest(res) %>%
-#'   export_2_json(term, estimate, std.error) 
+#'   export_results_json(term, estimate, std.error) 
 #' } 
 #' 
 #'
@@ -62,6 +91,7 @@ globalVariables(c(".max", ".min", "cdf.x", "cdf.y", "limits", "universe"))
 #' @importFrom dplyr group_by
 #' @importFrom dplyr rename
 #' @importFrom tidyr unnest_wider
+#' @importFrom readr guess_parser
 #' @importFrom stats quantile
 #' @importFrom distributional cdf
 #' @importFrom distributional dist_normal
@@ -71,7 +101,7 @@ globalVariables(c(".max", ".min", "cdf.x", "cdf.y", "limits", "universe"))
 #'
 #' @rdname export_json
 #' @export
-export_2_json = function (x, term, mean, sd, dist, filename) {
+export_results_json = function (x, term, mean, sd, dist, filename) {
   term = enquo(term)
 
   if (missing(dist) & !missing(mean) & !missing(sd)){
@@ -82,7 +112,7 @@ export_2_json = function (x, term, mean, sd, dist, filename) {
 
     # change to distributional vectors
     .res_df = mutate(x, dist = dist_normal(!!.mu, !!.sd))
-
+    
   } else if (!missing(dist) & missing(mean) & missing(sd)) {
     # we have a distributional object
     dist = enquo(dist)
@@ -93,12 +123,12 @@ export_2_json = function (x, term, mean, sd, dist, filename) {
     stop("No complete and/or distinct argument set provided")
   }
 
-  export_dist_2_json(.res_df, !!term, !!dist, filename)
+  export_results_dist_json(.res_df, !!term, !!dist, filename)
 }
 
 #' @rdname export_json
 #' @export
-export_dist_2_json = function(x, term, dist, filename) {
+export_results_dist_json = function(x, term, dist, filename) {
   dist = enquo(dist)
   term = enquo(term)
 
@@ -113,14 +143,14 @@ export_dist_2_json = function(x, term, dist, filename) {
         cdf.x = map2(.min, .max, ~ seq(.x, .y, length.out = 101)),
         cdf.y = map2(!!dist, cdf.x, ~ unlist(cdf(.x, .y)))
       ), 
-      - !!dist, -.min, -.max
+      -.min, -.max
     )
 
   .res_df = nest(.res_df,  results = c(term:cdf.y))
 
   if (!missing(filename)) {
     write_json(
-      .res_df, 
+      select(.res_df, -!!dist), 
       filename, 
       pretty = TRUE
     )
@@ -204,4 +234,23 @@ extract_parameters = function(.expr) {
       }
     }
   }
+}
+
+
+#' @rdname export_json
+#' @export
+export_data_json <- function(x, filename) {
+  result = summarise_all(x, ~ list(as.character(.)))  |> 
+    pivot_longer(cols = everything(), names_to = "field", values_to = "values")  |> 
+    mutate(field_type = map_chr(values, guess_parser))
+
+  if (!missing(filename)) {
+    write_json(
+      result,
+      filename,
+      pretty = TRUE
+    )
+  } else {
+    return(result)
+  }
 }

R/knit_as_emar.R

@@ -10,17 +10,22 @@
 #'
 #' @importFrom htmltools tags
 #' @importFrom htmltools tagList
+#' @importFrom htmltools includeCSS
+#' @importFrom knitr opts_chunk
 #' 
 #' @name knit_as_emar
 #' @export
 knit_as_emar <- function() {
-  htmltools::tagList(
-    htmltools::tags$script(src = "https://code.jquery.com/jquery-3.6.0.min.js"),
-    htmltools::tags$script(src = system.file("js/Tangle.js", package="multiverse")),
-    htmltools::tags$script(src = system.file("js/TangleKit/mootools.js", package="multiverse")),
-    htmltools::tags$script(src = system.file("js/TangleKit/sprintf.js", package="multiverse")),
-    htmltools::tags$script(src = system.file("js/TangleKit/BVTouchable.js", package="multiverse")),
-    htmltools::tags$script(src = system.file("js/TangleKit/TangleKit.js", package="multiverse")),
-    htmltools::tags$script(src = system.file("js/custom.js", package="multiverse"))
+  opts_chunk$set(knit_as_emar = TRUE)
+
+  tagList(
+    tags$link(rel = "stylesheet", type = "text/css", href = system.file("css/styles.css", package="multiverse")),
+    tags$script(src = "https://code.jquery.com/jquery-3.6.0.min.js"),
+    tags$script(src = system.file("js/Tangle.js", package="multiverse")),
+    tags$script(src = system.file("js/TangleKit/mootools.js", package="multiverse")),
+    tags$script(src = system.file("js/TangleKit/sprintf.js", package="multiverse")),
+    tags$script(src = system.file("js/TangleKit/BVTouchable.js", package="multiverse")),
+    tags$script(src = system.file("js/TangleKit/TangleKit.js", package="multiverse")),
+    tags$script(src = system.file("js/custom.js", package="multiverse"))
   )
 }

R/multiverse-package.R

@@ -1,6 +1,6 @@
 #' 'Explorable Multiverse' Data Analysis and Reports in R
-#'
-#' @docType package
+"_PACKAGE"
+
 #' @name multiverse-package
 #'
 #' @description

R/utils.R

@@ -1,7 +1,5 @@
 #' @importFrom dplyr lead
 #' @importFrom dplyr lag
-#' @importFrom styler create_style_guide
-#' @importFrom styler style_text
 #' @importFrom rlang expr_text
 
 setClassUnion("listORnumeric", c("list", "numeric"))