ROUT outlier testing added

dev/app.R

@@ -31,7 +31,7 @@ library(scales)
 library(tolerance)
 
 source("../R/Global.R")
-
+source("ROUT.R")
 
 #### ui ----
 
@@ -177,7 +177,6 @@ server <- function(input, output, session) {
               ),
               uiOutput(outputId = "sheetName"),
               "For data format in the EXCEL file see Data template",
-              "If no data are uploaded, the settings to the right are used for calculations.",
               tags$head(tags$style(HTML("label {font-size:80%;margin-bottom: 3px;margin-top: 3px;}"))),
               div(checkboxInput("PureErr", "Should pure error be used for calculation of CIs?", FALSE),
                 style = "font-size: 24px !important;color: #C2173F"
@@ -300,7 +299,7 @@ server <- function(input, output, session) {
                     )
                   ),
                   tabPanel(
-                    "Tests and ANOVAA",
+                    "Tests and ANOVA",
                     column(
                       12,
                       h3("Tests for linear PLA:"),
@@ -325,6 +324,16 @@ server <- function(input, output, session) {
               )
             )
           ),
+          tabPanel("robust outlier testing",
+                   sliderInput("Qslider", "adjust Q-value in %",min=0.1, max = 20, value = 1, step=0.1),
+                   plotOutput("OutlierPlot"),
+                   tableOutput("OutlierDF"),
+          "GUIDANCE: The procedure of Motulsky & Brown allows for robust outlier testing.",
+          "Adjust the slider to mark the suspected outliers. Mostly, a Q-value of 2% is sufficient.",
+          "If the general variability of the data is high, many datapoints will be flagged, also ones that are not deemed to be outliers",
+          "An indicator for high variability is, when the Q-value needs to be increased above 5%, to flag suspected outliers.",
+          "Then, please re-consider, if the suspected outlier is not 'just' normal variability."
+          ),
           tabPanel(
             "parameter estimates",
             htmlOutput("PureErrWParEst"),
@@ -729,7 +738,7 @@ server <- function(input, output, session) {
     reset(id = "") # from shinyjs package
   })
 
-#### input optim XL file ----
+#### input Wizard XL file ----
   observe({
     if (!is.null(input$MiFile)) {
       MinFile <- input$MiFile
@@ -804,7 +813,50 @@ server <- function(input, output, session) {
           # all_l$readout[all_l$readout < 0] <- 0.01
           REP$all_l <- all_l
 
-          #### XLSX eval ----
+          ##### ROUT outlier testing ----
+    #browser()
+          if(!is.null(input$Qslider)) {
+            all_lROUT <- all_l
+            colnames(all_lROUT) <- c("log_dose","sample","y","isRef","isSample","conc")
+            res <- rout_4pl_potency(all_lROUT, Q=input$Qslider/100)
+            OUTs_ <- all_lROUT[res$outliers,]
+            
+            all_l_rout <- all_lROUT[res$kept,]
+            # all_l_rout$log_dose <- log(all_l_rout$Conc)
+            # colnames(all_l_rout) <- c("log_dose","sample","y","isRef","isSample","conc")
+            if (all_l_rout$conc[1]>all_l_rout$conc[6]) {
+              if (all_l_rout$y[1]>all_l_rout$y[6]) SLOPE <- 1 else SLOPE<- -1
+            } else {
+              if (all_l_rout$y[1]>all_l_rout$y[6]) SLOPE <- -1 else SLOPE<- 1
+            }
+
+            startlist <- list(a = min(all_l_rout$y), b = SLOPE, d = max(all_l_rout$y), cs = mean(log(all_l_rout$conc)), r = 0)
+            
+            mr <- tryCatch(
+              {
+                gsl_nls(
+                  fn = y ~ a + (d - a) / (1 + exp(b * ((cs - r * isSample) - log_dose))),
+                  data = all_l_rout,
+                  start = startlist, # race=T,
+                  control = gsl_nls_control(xtol = 1e-6, ftol = 1e-6, gtol = 1e-6)
+                )
+              },
+              warning = function(e) {
+                mr <<- "In nlsModel singular gradient matrix"
+                
+              })
+            PAR <- summary(mr)$coefficients[,1]
+            ROUTplot <- outsPlot_FUN(all_l_rout, OUTs_, TS=all_l_rout$sample[13], PROC="ROUT",PROBE=input$sheet,Q=input$Qslider/100,par=PAR)
+            output$OutlierDF <- renderTable({
+             OUTs_
+            })
+            output$OutlierPlot <- renderPlot({
+              print(ROUTplot)
+            })
+            }          
+
+  
+          ##### XLSX eval ----
           #if (CORro < 0) SLOPE <- -1 else SLOPE <- 1
           FITs <- Fitting_FUNC(XLdat2, TransFlag = FALSE, nameWS="")