updates from LabKey branch

R/intraarm_fit.R

@@ -12,6 +12,7 @@ intraarm_fit <- function(transformed_data, tested_time, input,resp){
 
   bkg_inter_mat <- model.matrix(data = stats::na.omit(transformed_data), ~ -1 + stim:bkg)[, -1, drop=FALSE]
   colnames(bkg_inter_mat) <- gsub(":", "_", colnames(bkg_inter_mat), fixed = TRUE)
+  colnames(bkg_inter_mat) <- gsub(" ","",colnames(bkg_inter_mat), fixed = TRUE)
   transformed_data <- cbind.data.frame(stats::na.omit(transformed_data), bkg_inter_mat)
   myformul <- as.formula(paste0("response ~ -1 + stim", "+", paste(colnames(bkg_inter_mat), collapse = " + ")))
 

R/make_nice_pvals.R

@@ -1,8 +1,14 @@
 make_nice_pvals <- function(res_2plot, data_df, auxvar = "arm"){
+
   data_df$stim <- as.factor(as.numeric(data_df$stim))
   pval_2plot <- res_2plot
   naux <- nlevels(data_df[, auxvar])
   nstim <- nlevels(data_df$stim)
+
+  if(!is.numeric(data_df$response)){
+    data_df$response <- as.numeric(data_df$response)
+  }
+
   pval_2plot$y.position <- as.vector(by(data_df$response, INDICES = data_df$stim, FUN = max, na.rm=TRUE)) +
     0.05*max(data_df$response, na.rm = TRUE)
   pval_2plot$group1 <- 1:nlevels(data_df$stim) - (naux-1)*0.4/naux

R/mod_modelfit.R

@@ -82,6 +82,15 @@ mod_modelfit_server <- function(input, output, session, datas,parent,origin){
             responses_res[[response]]$res_error <- NULL
             responses_res[[response]]$postprocess_res <- interarm_postprocessres(data_df, fit_res)
 
+            if(parent$plot == "boxplot"){
+              boxplot_print[[response]] <- boxplot_VICI(data_df, responses_res[[response]]$postprocess_res$pval_2plot,
+                                                        response_name = response, input = parent)
+            }
+            if(parent$plot == "histogram"){
+              boxplot_print[[response]] <- histogram_VICI(data_df, responses_res[[response]]$postprocess_res$pval_2plot,
+                                                          response_name = response, input = parent)
+            }
+
             boxplot_print[[response]] <- boxplot_VICI(data_df, responses_res[[response]]$postprocess_res$pval_2plot,
                                                       response_name = response, input = parent)
 
@@ -118,6 +127,14 @@ mod_modelfit_server <- function(input, output, session, datas,parent,origin){
                                                 "... Perhaps the Arm to analyzed was not specified"))
           }else{
             for(i in ncol(transformed_data):3){
+
+              if(!is.numeric(transformed_data[, 3])){
+                transformed_data[, 3] <- as.numeric(transformed_data[, 3])
+              }
+              if(!is.numeric(transformed_data[, i])){
+                transformed_data[, i] <- as.numeric(transformed_data[, i])
+              }
+
               transformed_data[, i] <- (transformed_data[, i] - transformed_data[, 3])
             }
 
@@ -145,12 +162,22 @@ mod_modelfit_server <- function(input, output, session, datas,parent,origin){
             if(!prod(sapply(fit_res, function(x){inherits(x$mgls, "try-error")}))){
               responses_res[[response]]$res_error <- NULL
               responses_res[[response]]$postprocess_res <- intraarm_postprocessres(data_df, fit_res)
-              boxplot_print[[response]] <- boxplot_VICI(data_df, responses_res[[response]]$postprocess_res$pval_2plot,
-                                                        response_name = response,
-                                                        input = parent,
-                                                        inter = FALSE,
-                                                        baseline = parent$selectRefTimeIntra)
-
+
+              if(parent$plot == "boxplot"){
+                boxplot_print[[response]] <- boxplot_VICI(data_df, responses_res[[response]]$postprocess_res$pval_2plot,
+                                                          response_name = response,
+                                                          input = parent,
+                                                          inter = FALSE,
+                                                          baseline = parent$selectRefTimeIntra)
+              }
+              if(parent$plot == "histogram"){
+                boxplot_print[[response]] <- histogram_VICI(data_df, responses_res[[response]]$postprocess_res$pval_2plot,
+                                                            response_name = response,
+                                                            input = parent,
+                                                            inter = FALSE,
+                                                            baseline = parent$selectRefTimeIntra)
+              }
+
               responses_res[[response]]$res_tab <- do.call(rbind, lapply(fit_res, "[[", "res_tab"))
               heatmap_data2plot[[response]] <- responses_res[[response]]$postprocess_res$res_2plot
               for(l in 1:length(heatmap_data2plot[[response]])){

R/run_app.R

@@ -1,5 +1,7 @@
 #' Launch VICI Shiny App
 #'
+#'@param host Default is "127.0.0.1", see \link[shiny]{runApp} for details.
+#'@param port Default is 3838, see \link[shiny]{runApp} for details.
 #'@param ... additional arguments to be passed to the \link[shiny]{runApp} function.
 #'
 #'@examples
@@ -9,7 +11,7 @@
 #'
 #' @export
 #' @importFrom shiny runApp
-run_app <- function(...) {
-  shiny::runApp(system.file("app", package = "vici"),port=3838 ,host="0.0.0.0",...)
+run_app <- function(host="127.0.0.1", port=3838, ...) {
+  shiny::runApp(system.file("app", package = "vici"), port=port, host=host, ...)
 }