4PL report update

app.R

@@ -776,7 +776,7 @@ server <- function(input, output, session) {
           REP$PLAausw <- PLAAusw
           REP$PLBend <- PLAAusw2
           
-          #### Koeffizienten-Extraktion ----
+          #### Parameter extraktion ----
           logcoeffs_R <- SRlog$coefficients[, 1] # logpot$coefficients
           names(logcoeffs_R) <- c("lower A", "Hill's slope",  "upper A", "EC50 REF","EC50 DIFF")
           
@@ -818,9 +818,13 @@ server <- function(input, output, session) {
           if (exists("Ind")) {
             Dat$dilution <- XLdat[,Ind]
           } else Dat$dilution <- exp(XLdat[,logI])
-          # --- Plot-Ausgabe ---
+          
+  ##### Plot XL 4PL  ----
           output$XLplot <- renderPlot({
-            plot_f(XLdat2, TransFlag=F)
+            XLplot4pl <- plot_f(XLdat2, TransFlag=F)
+            REP$XLplot4pl <- XLplot4pl
+            
+            XLplot4pl
           })
           
           REP$XLdat2 <- XLdat2
@@ -1140,9 +1144,10 @@ server <- function(input, output, session) {
     tab <- tests_FUNC(Dat$EXCEL, Limite, PureErrFlag = PureErrFlag)
     
     tab[1,6:7] <- c("-","-")
-    Dat$tests_FUNC <- tab
-    REP$testsTab <- tab
+    
     tab2 <- tab[SelTests,]
+    Dat$tests_FUNC <- tab2
+    REP$testsTab <- tab2
     
     dat <- datatable(tab2,options = list(
       paging=TRUE,
@@ -1158,26 +1163,26 @@ server <- function(input, output, session) {
   }) # observe
   
   #### plot CIs XL----
-  observe({
-    tab <- Dat$tests_FUNC
-    if (is.null(tab)) return(NULL)
-    
-    tab2 <- tab[-c(1,2,3,6),]
-    tab2[,3:7] <- apply(tab2[,3:7],2,as.numeric)
-    tab2[4:5,3:7] <- tab2[4:5,3:7]/100
-    
-    p_CIs <- ggplot(tab2,aes(x=test,y=estimate, color=test,group=test)) +
-      geom_point() +
-      geom_errorbar(aes(ymin=lower_CI, ymax=upper_CI), width=0.4) +
-      geom_crossbar(aes(ymin=lower_limit, ymax=upper_limit), size=0.8) + 
-      coord_flip() + 
-      theme_bw() +
-      theme(legend.position = "none",text = element_text(size=20))
-    
-    output$CIplot <- renderPlot({ p_CIs}, height=200)
-    
-    REP$CIplot <- p_CIs
-  })
+  # observe({
+  #   tab <- Dat$tests_FUNC
+  #   if (is.null(tab)) return(NULL)
+  #   
+  #   tab2 <- tab[-c(1,2,3,6),]
+  #   tab2[,3:ncol(tab2)] <- apply(tab2[,3:ncol(tab2)],2,as.numeric)
+  #   tab2[4:5,3:7] <- tab2[4:5,3:7]/100
+  #   
+  #   p_CIs <- ggplot(tab2,aes(x=test,y=estimate, color=test,group=test)) +
+  #     geom_point() +
+  #     geom_errorbar(aes(ymin=lower_CI, ymax=upper_CI), width=0.4) +
+  #     geom_crossbar(aes(ymin=lower_limit, ymax=upper_limit), size=0.8) + 
+  #     coord_flip() + 
+  #     theme_bw() +
+  #     theme(legend.position = "none",text = element_text(size=20))
+  #   
+  #   output$CIplot <- renderPlot({ p_CIs}, height=200)
+  #   
+  #   REP$CIplot <- p_CIs
+  # })
   
   #### simulated data tab Meta ----
   output$simdat <- DT::renderDataTable({
@@ -1643,7 +1648,7 @@ server <- function(input, output, session) {
                 as.numeric(input$lEACratioSlope), as.numeric(input$uEACratioSlope), 
                 as.numeric(input$lEACratioua), as.numeric(input$uEACratioua), 
                 as.numeric(input$lowerPot), as.numeric(input$upperPot))
-    
+    REP$Lim <- Lim
     
     pottab4_ <- data.frame(pottab4)
     pottab4_$potency <- round(as.numeric(pottab4[,2])*100,1)
@@ -1667,6 +1672,8 @@ server <- function(input, output, session) {
     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")
     
+    REP$pottab4plXL <- pottab4_[1:2,]
+    
     output$pottab4plXL <- DT::renderDataTable({
       dat <- datatable(pottab4_[1:2,],
                        options=list(digits=3,