lexibel wenn fehlende Werte

dev/app.R

@@ -218,6 +218,8 @@ server <- function(input, output, session) {
             "Uploaded data",
             tableOutput("XLdata")
           ),
+          
+          ###### 4pl output ----
           tabPanel(
             "4pl-Analysis",
             tags$style(HTML("pre { color: black; background-color: #FFE1FF;
@@ -265,6 +267,7 @@ server <- function(input, output, session) {
               )
             )
           ),
+          ##### linear output ----
           tabPanel(
             "linear Analysis",
             sidebarLayout(
@@ -324,10 +327,13 @@ server <- function(input, output, session) {
               )
             )
           ),
+          ##### ROUT output ----
           tabPanel("robust outlier testing",
-                   sliderInput("Qslider", "adjust Q-value in %",min=0.1, max = 20, value = 1, step=0.1),
+                   downloadButton("downloadROUTReport", label = "Download ROUT report", class = "butt"),
+                   sliderInput("Qslider", "adjust Q-value in %",min=0.1, max = 10, 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",
@@ -816,7 +822,7 @@ server <- function(input, output, session) {
           ##### ROUT outlier testing ----
     #browser()
           if(!is.null(input$Qslider)) {
-            all_lROUT <- all_l
+            all_lROUT <- all_l[complete.cases(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,]
@@ -847,12 +853,42 @@ server <- function(input, output, session) {
               })
             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)
             })
+            
+            
+            all_l_rout2 <- all_l_rout[,-c(4:6)]
+            ro_newROUT <- reshape(all_l_rout2, direction="wide", idvar = "log_dose", timevar="sample", varying = as.vector(unique(all_l_rout2$sample)))
+            REP$ro_newROUT <- ro_newROUT
+            
+            REP$ROUTplot <- ROUTplot
+            
+            ANOVA_ROUT <- ANOVA4plUnresfunc(ro_new = ro_newROUT)
+            REP$ANOVA_ROUT <- ANOVA_ROUT
+            
+            Limite <- list(
+              as.numeric(input$lEACdiffla), as.numeric(input$uEACdiffla),
+              as.numeric(input$lEACratiola), as.numeric(input$uEACratiola),
+              as.numeric(input$lEACratioSlope), as.numeric(input$uEACratioSlope),
+              as.numeric(input$lEACratioua), as.numeric(input$uEACratioua),
+              as.numeric(input$lowerPot), as.numeric(input$upperPot),
+              as.numeric(input$lEACratioAdiff), as.numeric(input$uEACratioAdiff)
+            )
+            
+            tabROUT <- tests_FUNC(ro_newROUT, Limite, PureErrFlag = PureErrFlag)
+       #browser()     
+            tabROUT[1, 6:7] <- c("-", "-")
+            
+            #tabROUT2 <- tabROUT[SelTests, ]
+            #Dat$tests_FUNC <- tabROUT
+            REP$testsTabROUT <- tabROUT
+            
             }          
 
   
@@ -1842,17 +1878,18 @@ server <- function(input, output, session) {
       slopeTe[i, ] <- lm3Te$coefficients
     }
 
-    indS <- which(abs(slopeSt[, 2]) == max(abs(slopeSt[, 2])))
-    indT <- which(abs(slopeTe[, 2]) == max(abs(slopeTe[, 2])))
+    indS <- which(abs(slopeSt[, 2]) == max(abs(slopeSt[, 2]), na.rm=T))
+    indT <- which(abs(slopeTe[, 2]) == max(abs(slopeTe[, 2]), na.rm = T))
 
     # pl_ <- slopeSt[indS,1]+slopeSt[indS,2]*log_conc
     # pl_T <- slopeTe[indT,1]+slopeTe[indT,2]*log_conc
     # pl_df <- data.frame(lnC=log_conc, plotS=pl_, plotT=pl_T)
-
+#browser()
     all_l <- melt(data.frame(tab), id.vars = "log_dose", variable.name = "replname", value.name = "readout")
     isRef <- rep(c(1, 0), 1, each = nrow(all_l) / 2)
     isSample <- rep(c(0, 1), 1, each = nrow(all_l) / 2)
     all_l2 <- cbind(all_l, isRef, isSample)
+    all_l2 <- all_l2[complete.cases(all_l2),]
     all_l2S <- all_l2[all_l2$isRef == 1, ]
     all_l2T <- all_l2[all_l2$isRef == 0, ]
     all_mS <- all_l2S[order(all_l2S$log_dose, decreasing = TRUE), ]
@@ -2889,6 +2926,31 @@ server <- function(input, output, session) {
     }
   )
     
+    #### Download ROUT report ----
+    output$downloadROUTReport <- downloadHandler(
+      filename = paste0("Report_ROUT_Evaluation.pdf"),
+      content = function(file) {
+        tpdr <- tempdir()
+        tempReport <- file.path(tpdr, "BioassayReportROUT.Rmd")
+        file.copy("BioassayReportROUT.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 Meta 4PL report----