rport updates, new logo, app.r logic updated, 4pl XL made nicer

dev/app.R

@@ -35,7 +35,7 @@ ui <- dashboardPage(
   dashboardHeader(title = "Plateflow"),
   dashboardSidebar(
     sidebarMenu(
-      img(src = "logo.png", width = 230),
+      img(src = "logov2.png", width = 230),
       menuItem("Home", tabName = "home", icon = icon("home")),
       menuItem("Data template",
         tabName = "template", icon = icon("table"),
@@ -44,11 +44,11 @@ ui <- dashboardPage(
       # menuItem("User Manual /Validation", tabName = "manual", icon=icon("book"), # tabName here and in dashboard body need to be identical
       #          menuSubItem(icon = NULL, tags$li(a("Document",  target="self",href="UserManual.pdf")))
       # ),
-      menuItem("EXCEL upload", tabName = "Dataupload", icon = icon("magnet", lib = "glyphicon")),
-      menuItem("4PL simulation", tabName = "fourPL", icon = icon("chart-line", lib = "font-awesome")),
+      menuItem("INSPECT your data", tabName = "Dataupload", icon = icon("magnet", lib = "glyphicon")),
+      menuItem("EXPLORE 4PL and linear reg", tabName = "fourPL", icon = icon("chart-line", lib = "font-awesome")),
       # menuItem("XLSX diagnostics", tabName="XLdiagn", icon=icon("chart-bar", lib="font-awesome")),
       # menuItem("Linear regression + report", tabName="pla", icon=icon("pencil", lib="glyphicon")),
-      menuItem("Wizard", tabName = "wizard", icon = icon("chart-column", lib = "font-awesome")) # ,
+      menuItem("OPTIMIZE with wizard", tabName = "wizard", icon = icon("chart-column", lib = "font-awesome")) # ,
       # menuItem("Documentation", tabName="documentation", icon=icon("chart-area", lib="font-awesome"))
     ),
     tags$footer(
@@ -94,34 +94,30 @@ server <- function(input, output, session) {
   environment(pot4plFUNC) <- environment()
   environment(tests_FUNC) <- environment()
 
-  #### renderUIs ----
+  #### renderUIs Home ----
   output$homePage <- renderUI({
     navbarPage(
       "Home",
       tabPanel(
-        "Limit setting",
+        "Introduction",
         tags$style(HTML("pre { color: black; background-color: #7FAEFF55;
                                              font-family: 'Helvetica Neue', Helvetica, Arial, sans-serif;font-size: 12px;} ")),
-        tags$img(src = "logo.png", class = "adv_logo"),
-        h4("Introduction to the bioassay software"),
+        h4("Introduction to the plateflow software"),
         # tags$mark("linear regression"), br(),
-        column(3,
-            style = "background: #7FAEFF88",
-            numericInput("lEACratiola", "lower EAC ratio of LAs", 0.005, step = 0.001),
-            numericInput("uEACratiola", "upper EAC for ratio of LAs", 100, step = 1),
-            numericInput("lEACratioSlope", "lower EAC for ratio of slopes", 0.55, step = 0.01),
-            numericInput("uEACratioSlope", "upper EAC for ratio of slopes", 1.84, step = 0.1),
-            numericInput("lEACratioua", "lower EAC for ratio of UAs", 0.75, step = 0.1),
-            numericInput("uEACratioua", "upper EAC for ratio of UAs", 1.33, step = 0.1)),
-          column(3, style = "background: #7FAEFF88",
-            numericInput("lowerPot", "lower EAC for potency", 75, step = 1),
-            numericInput("upperPot", "upper EAC for potency", 133, step = 1),
-            numericInput("lEACratioAdiff", "lower EAC of ratio of asymptote differences", 0.75, step = 0.01),
-            numericInput("uEACratioAdiff", "upper EAC of ratio of asymptote differences", 1.33, step = 0.01),
-            numericInput("lEACdiffla", "lower EAC for diff. of LA", -0.175, step = 0.001),
-            numericInput("uEACdiffla", "upper EAC for diff. of LA", 0.189, step = 0.001)
-          
-        )
+      column(6,
+             "INSPECT your plate reader data: This is the right place if you want to visualize your data in the context of a 4 PL fit or a linear regression fit. ",
+             "Bring your data in a readable format and start inspecting.",br(),
+        "Example of EXCEL/csv/numbers file:",br(),
+        
+        tags$img(src = "ExampleXL.png", class = "adv_logo", width = "100%"),
+        "It needs to contain 1 column with the  dilution concentrations (first or last column) and at least 2 columns of reference  and test sample readouts, respectively.",
+        "The reference readout columns have to be before the test sample readout columns. The column names for reference and test are free to set, but different for all columns.",
+        "The column name of the dilution concentrations can be as follows: concentration, dose, log_concentration, log_dose (first letter can be capital)",
+        "It is assumed, that the concentrations are in anti-log or in natural log mode.",
+      ),
+      column(6,
+             
+             )
       ),
       tabPanel(
         "Documentation",
@@ -140,7 +136,7 @@ server <- function(input, output, session) {
   ##### UI XL ----
   output$Dataupload <- renderUI({
     navbarPage(
-      title = "Information",
+      title = "",
       tabPanel(
         title = "Real data",
         tabsetPanel(
@@ -167,12 +163,13 @@ server <- function(input, output, session) {
             column(
               4,
               h4("Suitability tests for 4-parametric logistic regression"),
+              "(potency CI test is set per default)",
               checkboxGroupInput("selectedSSTs", "Which suitability tests to be used?",
                 choices = c(
                   "F-test on Regr." = "1",
                   "EQ-test on lower asymptote difference" = "2",
                   "EQ-test on ratio of lower asymptote" = "3", "EQ-test on ratio of Hill slopes" = "4",
-                  "EQ-test on ratio of upper asymptote" = "5", "F-test on non-linearity" = "6",
+                  "EQ-test on ratio of upper asymptote" = "5", "F-test on Lack-of-Fit" = "6",
                   "EQ-test on ratio of asymptote differences" = "7"
                 ),
                 selected = c("1", "4", "5", "6", "7")
@@ -189,12 +186,24 @@ server <- function(input, output, session) {
                 selected = c("1", "2", "3", "4", "5", "6", "7", "8")
               )
             ),
-            column(
-              4,
-              h4("Example of EXCEL file "),
-              h4("with column of dilutions and at least 2 columns of reference and the same amount of columns with test sample readouts."),
-              tags$img(src = "ExampleXL.png", class = "adv_logo", width = "100%"),
-              plotOutput("plotSing", width = "400px", height = "300px")
+            
+              column(2,
+                     style = "background: #7FAEFF88",
+                     numericInput("lEACratiola", "lower EAC ratio of LAs", 0.005, step = 0.001),
+                     numericInput("uEACratiola", "upper EAC for ratio of LAs", 100, step = 1),
+                     numericInput("lEACratioSlope", "lower EAC for ratio of slopes", 0.55, step = 0.01),
+                     numericInput("uEACratioSlope", "upper EAC for ratio of slopes", 1.84, step = 0.1),
+                     numericInput("lEACratioua", "lower EAC for ratio of UAs", 0.75, step = 0.1),
+                     numericInput("uEACratioua", "upper EAC for ratio of UAs", 1.33, step = 0.1)),
+              column(2, style = "background: #7FAEFF88",
+                     numericInput("lowerPot", "lower EAC for potency", 75, step = 1),
+                     numericInput("upperPot", "upper EAC for potency", 133, step = 1),
+                     numericInput("lEACratioAdiff", "lower EAC of ratio of asymptote differences", 0.75, step = 0.01),
+                     numericInput("uEACratioAdiff", "upper EAC of ratio of asymptote differences", 1.33, step = 0.01),
+                     numericInput("lEACdiffla", "lower EAC for diff. of LA", -0.175, step = 0.001),
+                     numericInput("uEACdiffla", "upper EAC for diff. of LA", 0.189, step = 0.001)
+                     
+              
             )
           ),
           tabPanel(
@@ -217,7 +226,8 @@ server <- function(input, output, session) {
                   tableOutput("AIC"),
                   h5("First row: restricted model; 2nd row: unrestricted model"),
                   h5("Smaller values of AIC indicate better fit to the data"),
-                  tableOutput("VarDiagn")
+                  box(title = "Useful information", status = "info", solidHeader = T, width = 12, "", collapsible = T,
+                  tableOutput("VarDiagn"))
                 ),
                 column(
                   8,
@@ -225,10 +235,13 @@ server <- function(input, output, session) {
                   htmlOutput("No4PLFitText"),
                   
                   DTOutput("pottab4plXL"),
-                  plotOutput("diagnplot"),
-                  DTOutput("EQtests"),
+                  box(title = "Residuals and QQ-plot", status = "info", solidHeader = T, width = 12, "", collapsible = T,
+                  plotOutput("diagnplot")),
+                  box(title = "Assay Suitability Tests", status = "info", solidHeader = T, width = 12, "", collapsible = T,
+                  DTOutput("EQtests")),
                   DTOutput("pottab4plTransXL"),
-                  tableOutput("ANOVAXLS")
+                  box(title = "ANOVA", status = "info", solidHeader = T, width = 12, "", collapsible = T,
+                  tableOutput("ANOVAXLS"))
                 )
               )
             )
@@ -447,9 +460,9 @@ server <- function(input, output, session) {
                     DTOutput("pottab4pl"),
                     "Footnote: test performed on relative CIs.",
                     DTOutput("EQtests4pl"), # SSTs
-                    h5("*...The estimate for F-test on regression and on non-linearity is the p-value"),
+                    h5("*...The estimate for F-test on regression and on Lack-of-Fit is the p-value"),
                     h5("F-test on regression passes if F-value > F-crit and thus p < 0.05"),
-                    h5("F-test on non-linearity passes if F-value < F-crit and thus p > 0.05"),
+                    h5("F-test on Lack-of-Fit passes if F-value < F-crit and thus p > 0.05"),
                     h5("Test results outcome: 0 ... test passed (for EQ tests: CI within limits);
                                            1 ... test failed (for EQ tests CI not within limits);
                                            -1 ... calculations unbound/denominator too close to 0"),
@@ -769,37 +782,27 @@ server <- function(input, output, session) {
               })
               output$No4PLFitText <- renderText(warning_textNo4PLFit())
 
-              output$relpotTestTab <- renderTable({
-                NULL
-              })
-              output$relpotTestPlot <- renderPlot({
-                NULL
-              })
+              output$relpotTestTab <- renderTable({ NULL })
+              output$relpotTestPlot <- renderPlot({ NULL })
 
-              output$AIC <- renderTable({
-                NULL
-              })
-              output$VarDiagn <- renderTable({
-                NULL
-              })
+              output$AIC <- renderTable({ NULL })
+              output$VarDiagn <- renderTable({ NULL })
 
-              output$pottab4plXL <- renderDT({
-                NULL
-              })
-              output$diagnplot <- renderPlot({
-                NULL
-              })
-              output$EQtests <- renderDT({
-                NULL
-              })
+              output$pottab4plXL <- renderDT({ NULL })
+              output$diagnplot <- renderPlot({ NULL })
+              output$EQtests <- renderDT({  NULL })
               #
-              output$pottab4plTransXL <- renderDT({
-                NULL
-              })
-              output$ANOVAXLS <- renderTable({
-                NULL
-              })
-              # )
+              output$pottab4plTransXL <- renderDT({ NULL })
+              output$ANOVAXLS <- renderTable({ NULL })
+ 
+               output$coeffs_r <- renderTable({ NULL})
+  
+               output$bends_r2 <- renderTable({ NULL })
+          output$coeffs_unr <- renderTable({ NULL })
+          output$logcoeffs_r <- renderTable({ NULL })
+          output$bends_unr2 <- renderTable({ NULL })
+          output$logcoeffs_unr <- renderTable({ NULL })
+ 
 
               return(NULL)
             }
@@ -828,7 +831,7 @@ server <- function(input, output, session) {
           BPsMR_MU <- data.frame(
             points = c(
               "lower bendpoint REF", "upper bendpoint REF", "lower bendpoint TEST", "upper bendpoint TEST",
-              "lower asymp. point REF", "upper asymp. point REFr", "lower asymp. point TEST", "upper asymp. point TEST",
+              "lower asymp. point REF", "upper asymp. point REF", "lower asymp. point TEST", "upper asymp. point TEST",
               "bendREF_lower_unrestr", "bendREF_upper_unrestr", "bendTESTE_lower_unrestr", "bendTEST_upper_unrestr"
             ),
             estimates = c(
@@ -2017,24 +2020,24 @@ server <- function(input, output, session) {
     pottab4_$relative_upperCL <- round(pottab4_[, 7] / pottab4_[, 5] * 100, 2)
 
     if (as.numeric(pottab4_$relative_lowerCL[1]) > Lim[[9]] & as.numeric(pottab4_$relative_upperCL[1]) < Lim[[10]]) {
-      test_potCI <- 0
+      test_potCI <- "passed"
     } else {
-      test_potCI <- 1
+      test_potCI <- "failed"
     }
     if (as.numeric(pottab4_$relative_lowerCL[2]) > Lim[[9]] & as.numeric(pottab4_$relative_upperCL[2]) < Lim[[10]]) {
-      test_potUCI <- 0
+      test_potUCI <- ""
     } else {
-      test_potUCI <- 1
+      test_potUCI <- ""
     }
     if (as.numeric(pottab4_$relative_lowerCL[3]) > Lim[[9]] & as.numeric(pottab4_$relative_upperCL[3]) < Lim[[10]]) {
-      test_potCI_t <- 0
+      test_potCI_t <- ""
     } else {
-      test_potCI_t <- 1
+      test_potCI_t <- ""
     }
     if (as.numeric(pottab4_$relative_lowerCL[4]) > Lim[[9]] & as.numeric(pottab4_$relative_upperCL[4]) < Lim[[10]]) {
-      test_potUCI_t <- 0
+      test_potUCI_t <- ""
     } else {
-      test_potUCI_t <- 1
+      test_potUCI_t <- ""
     }
     pottab4_ <- cbind(pottab4_[, -(2:4)], data.frame(tests = c(test_potCI, test_potUCI, test_potCI_t, test_potUCI_t)))
     colnames(pottab4_) <- c("model", "potency", "lower95%CI", "upper95%CI", "relative_lower95%CI", "relative_upper95%CI", "test_result")
@@ -2049,21 +2052,18 @@ server <- function(input, output, session) {
           paging = T, dom = "t"
         )
       ) %>% formatStyle("test_result", target = "row", backgroundColor = styleEqual(
-        c(0, 1),
+        c("passed", "failed"),
         c("#B5C74055", "#F9545455")
       ))
     })
     output$pottab4plTransXL <- DT::renderDataTable({
-      dat <- datatable(pottab4_[3:4, ],
+      dat <- datatable(pottab4_[3:4, -ncol(pottab4_)],
         rownames = F,
         options = list(
           digits = 3,
           paging = T, dom = "t"
         )
-      ) %>% formatStyle("test_result", target = "row", backgroundColor = styleEqual(
-        c(0, 1),
-        c("#B5C74055", "#F9545455")
-      ))
+      ) 
     })
   })
 
@@ -2607,30 +2607,36 @@ server <- function(input, output, session) {
 
   #### download XL 4PL report----
 
-  output$downloadXLReport <- downloadHandler(
-    filename = paste0("Report_4PLEvaluation", Dat$RepIdentifier, ".pdf"),
-    content = function(file) {
-      tpdr <- tempdir()
-      tempReport <- file.path(tpdr, "Doc_BioassayReport.Rmd")
-      file.copy("Doc_BioassayReport.Rmd", tempReport, overwrite = T)
-
-      tempReportc <- file.path(tpdr, "logo.png")
-      file.copy("logo.png", tempReportc, overwrite = T)
-
-      rmarkdown::render(tempReport,
-        output_file = file,
-        params = list(
-          FileName = Dat$FileName,
-          author = Dat$Author,
-          NoP = Dat$NoP,
-          Assay = Dat$Assay,
-          REP = REP,
-          coeffs = Dat$coeffs_UN
-        ),
-        envir = new.env(parent = globalenv())
-      )
+  observe({ 
+    if (is.null(Dat$FITsFlag)) return(NULL)
+    if (!Dat$FITsFlag) {
+  browser()  
+    output$downloadXLReport <- downloadHandler(
+      filename = paste0("Report_4PLEvaluation", Dat$RepIdentifier, ".pdf"),
+      content = function(file) {
+        tpdr <- tempdir()
+        tempReport <- file.path(tpdr, "Doc_BioassayReport.Rmd")
+        file.copy("Doc_BioassayReport.Rmd", tempReport, overwrite = T)
+  
+        tempReportc <- file.path(tpdr, "logov2.png")
+        file.copy("logov2.png", tempReportc, overwrite = T)
+  
+        rmarkdown::render(tempReport,
+          output_file = file,
+          params = list(
+            FileName = Dat$FileName,
+            author = Dat$Author,
+            NoP = Dat$NoP,
+            Assay = Dat$Assay,
+            REP = REP,
+            coeffs = Dat$coeffs_UN
+          ),
+          envir = new.env(parent = globalenv())
+        )
+      }
+    )
     }
-  )
+  })
 
   #### download XL Lin report----
 
@@ -2641,8 +2647,8 @@ server <- function(input, output, session) {
       tempReport <- file.path(tpdr, "Doc_BioassayLinReport.Rmd")
       file.copy("Doc_BioassayLinReport.Rmd", tempReport, overwrite = T)
 
-      tempReportc <- file.path(tpdr, "logo.png")
-      file.copy("logo.png", tempReportc, overwrite = T)
+      tempReportc <- file.path(tpdr, "logov2.png")
+      file.copy("logov2.png", tempReportc, overwrite = T)
 
       rmarkdown::render(tempReport,
         output_file = file,