extended docu for formula editor

Dockerfile

@@ -1,4 +1,4 @@
-FROM rocker/shiny:4.3.1
+FROM rocker/shiny:4.4.2
 
 RUN apt-get update && apt-get install -y \
     --no-install-recommends \
@@ -17,14 +17,10 @@ ENV SHINY_LOG_STDERR=1
 
 RUN install2.r --error --skipinstalled \
     shiny \
-    shinydashboard \
-    shinyWidgets \
     shinyjs \
-    forecast \
     jsonlite \
     ggplot2 \
     htmltools \
-    plotly \
     drc \
     DT \
     httr \
@@ -33,7 +29,6 @@ RUN install2.r --error --skipinstalled \
     readxl \
     openxlsx \
     purrr \
-    pheatmap \
     png \
     RColorBrewer \
     remotes \
@@ -43,12 +38,12 @@ RUN install2.r --error --skipinstalled \
     ggpmisc \
     jose \
     R6 \
-    patchwork \
     cowplot \
+    equatiomatic \
     quarto
-    
+
 USER shiny
-COPY ./app/ ./myapp
+COPY ./bs/R ./myapp
 RUN mkdir /home/shiny/results
 
 COPY ./MTT/ /home/MTT
@@ -58,7 +53,7 @@ RUN bash -c "cd /home/MTT; R CMD INSTALL ."
 RUN bash -c "cd /home/comeln; R CMD INSTALL ."
 
 EXPOSE 4001
-COPY ./app/ /srv/shiny-server/
+COPY ./bs/R /srv/shiny-server/
 COPY ./run.sh .
 
 ENV SHINY_LOG_STDERR=1

bs/.development/Formulas.qmd

@@ -21,16 +21,17 @@ show <- function(formula, data) {
   model_table <- kable(broom::tidy(model), format = "html", table.attr = "style='display: inline-block; vertical-align: top;'")
   html_output <- tags$table(
     tags$tr(
-      tags$td(HTML(data_table)),
-      tags$td(HTML(formula_table)),
-      tags$td(HTML(model_table))
+      tags$td(data_table),
+      tags$td(formula_table),
+      tags$td(model_table)
     )
   )
   html_output
 }
 
 show_model <- function(f, data) {
   model_latex <- extract_eq(lm(f, data = data), wrap = TRUE)
+  print(model_latex)
   model <- data.frame(Model = model_latex)
   knitr::kable(model)
 }
@@ -54,7 +55,8 @@ m$term <- terms[m$term]
 names(m)[names(m) == "estimate"] <- "ßs"
 names(m)[names(m) == "std.error"] <- "Standard error of ßs"
 names(m)[names(m) == "statistic"] <- "t-statistic = ßs / Standard error of ßs"
-knitr::kable(m)
+table <- knitr::kable(m, format = "html", table.attr = "style='display: inline-block; vertical-align: top;'")
+tags$table(tags$td(table))
 ```
 
 ##  Adding multiple predictors with +
@@ -82,7 +84,9 @@ m$term <- terms[m$term]
 names(m)[names(m) == "estimate"] <- "ßs"
 names(m)[names(m) == "std.error"] <- "Standard error of ßs"
 names(m)[names(m) == "statistic"] <- "t-statistic = ßs / Standard error of ßs"
-knitr::kable(m)
+table <- knitr::kable(m, format = "html", table.attr = "style='display: inline-block; vertical-align: top;'")
+tags$table(tags$td(table))
+
 ```
 ##  Model with main effects and interaction using *
 
@@ -108,7 +112,8 @@ m$term <- terms[m$term]
 names(m)[names(m) == "estimate"] <- "ßs"
 names(m)[names(m) == "std.error"] <- "Standard error of ßs"
 names(m)[names(m) == "statistic"] <- "t-statistic = ßs / Standard error of ßs"
-knitr::kable(m)
+table <- knitr::kable(m, format = "html", table.attr = "style='display: inline-block; vertical-align: top;'")
+tags$table(tags$td(table))
 ```
 - This includes the main effects of fertilizer and water as well as their interaction.
 - An interaction means that the effect of one predictor depends on the level of another predictor.
@@ -124,6 +129,17 @@ data <- data.frame(
 )
 f <-formula(yield ~ fertilizer + water + fertilizer : water, data = data)
 show_model(f, data)
+formula <- f
+model <- lm(formula, data = data)
+f <- data.frame(Formula = deparse(formula))
+formula_table <- kable(data.frame(Formula = f), format = "html", table.attr = "style='display: inline-block; vertical-align: top;'")
+html_output <- tags$table(
+  tags$tr(
+    tags$td(formula_table),
+  )
+)
+html_output
+
 ```
 - see in the section before the model is the same it is only another way to express it
 
@@ -152,7 +168,8 @@ m$term <- terms[m$term]
 names(m)[names(m) == "estimate"] <- "ßs"
 names(m)[names(m) == "std.error"] <- "Standard error of ßs"
 names(m)[names(m) == "statistic"] <- "t-statistic = ßs / Standard error of ßs"
-knitr::kable(m)
+table <- knitr::kable(m, format = "html", table.attr = "style='display: inline-block; vertical-align: top;'")
+tags$table(tags$td(table))
 ```
 - school represents the primary grouping factor
 - class is nested within school, modeling different classes within each school

bs/R/MainApp.R

@@ -212,7 +212,8 @@ server <- function(input, output, session) {
       title = "Defining the formula",
       includeHTML("www/formula.html"),
       easyClose = TRUE,
-      footer = NULL
+      footer = NULL,
+      size = "l"
     ))
   })
 

bs/R/app.R

@@ -1,4 +1,7 @@
 source("MainApp.R")
 
+# TODO: define getenv as command line argument
 Sys.setenv(RUN_MODE = "BROWSER") # SERVER
+# Sys.setenv(RUN_MODE = "SERVER")
+options(shiny.autoreload = TRUE)
 shinyApp(ui, server)

bs/R/loadLibraries.R

@@ -18,6 +18,7 @@ library(shinyjs)
 library(equatiomatic)
 # TODO: add missing libraries to the Dockerfile
 
-if (Sys.getenv("RUN_MODE") == "SERVER") {
-  library(COMELN)
-}
+library(COMELN)
+library(httr)
+library(jose)
+library(openssl)