results are now displayed as list with remove buttons

Direct_Test_App.R

@@ -0,0 +1,32 @@
+library(shiny)
+library(DT)
+library(bslib)
+library(broom)
+library(ggplot2)
+library(base64enc)
+library(shinyjs)
+library(mgcv)
+library(RColorBrewer)
+library(tidyr)
+library(purrr)
+library(agricolae)
+library(drc)
+library(cowplot)
+library(MASS)
+library(Matrix)
+library(shinyjs)
+library(equatiomatic)
+library(openxlsx)
+library(car)
+library(cowplot)
+library(COMELN)
+library(httr)
+library(jose)
+library(openssl)
+Sys.setenv(RUN_MODE = "BROWSER")
+setwd("bs/R")
+files <- list.files(".")
+lapply(files, source)
+app <- app()
+shiny::shinyApp(app$ui, app$server)
+

bs/.development/remove_buttons.R

@@ -0,0 +1,55 @@
+library(shiny)
+
+ui <- fluidPage(
+  titlePanel("Dynamic List with Remove Buttons"),
+  sidebarLayout(
+    sidebarPanel(
+      numericInput("num_input", "Enter a number:", value = 0),
+      actionButton("add_btn", "Add to List")
+    ),
+    mainPanel(
+      uiOutput("dynamic_list")
+    )
+  )
+)
+
+server <- function(input, output, session) {
+  listValues <- reactiveVal(list())
+  observeEvent(input$add_btn, {
+    current_list <- listValues()
+    new_item_name <- paste0("item_", length(current_list) + 1)
+    current_list[[new_item_name]] <- input$num_input
+    listValues(current_list)
+  })
+
+  # Dynamically render the list UI
+  output$dynamic_list <- renderUI({
+    current_list <- listValues()
+    if (length(current_list) == 0) {
+      return("No items in the list.")
+    }
+    # Create UI elements for each item in the list
+    tagList(lapply(names(current_list), function(name) {
+      div(
+        style = "margin-bottom: 10px;",
+        span(paste(name, ":", current_list[[name]]), style = "margin-right: 10px;"),
+        actionButton(name, "Remove", class = "btn-danger btn-sm")
+      )
+    }))
+  })
+
+  # Observe and handle remove buttons dynamically
+  observe({
+    current_list <- listValues()
+    lapply(names(current_list), function(name) {
+      observeEvent(input[[name]], {
+        current_list <- listValues()
+        current_list[[name]] <- NULL  # Remove the item
+        listValues(current_list)
+      }, ignoreInit = TRUE)
+    })
+  })
+}
+
+shinyApp(ui, server)
+

bs/DESCRIPTION

@@ -29,7 +29,6 @@ Imports:
   equatiomatic,
   openxlsx,
   car,
-  cowplot,
   COMELN,
   httr,
   jose,

bs/R/DoseResponse.R

@@ -28,17 +28,6 @@ DoseResponseSidebarUI <- function(id) {
 
 DoseResponseUI <- function(id) {
   fluidRow(
-    tags$head(
-      tags$script(src = "https://cdnjs.cloudflare.com/ajax/libs/jszip/3.7.1/jszip.min.js"),
-      tags$script(src = "https://cdnjs.cloudflare.com/ajax/libs/FileSaver.js/2.0.5/FileSaver.min.js"),
-      tags$script(src = "https://cdnjs.cloudflare.com/ajax/libs/html2canvas/0.4.1/html2canvas.min.js"),
-      tags$script(src = "download.js")
-    ),
-    h4(strong("Results of test:")),
-    actionButton(NS(id, "dr_save"), "Add output to result-file"),
-    actionButton(NS(id, "download_dr"), "Save results"),
-    textInput(NS(id, "user_filename"), "Set filename", value = ""),
-    checkboxGroupInput(NS(id, "TableSaved"), "Saved results to file", NULL),
     tabsetPanel(
       id = NS(id, "results_tabs"),
       tabPanel(
@@ -58,8 +47,7 @@ DoseResponseUI <- function(id) {
         actionButton(NS(id, "previousPage"), "Previous plot"),
         actionButton(NS(id, "nextPage"), "Next plot")
       )
-    ),
-    verbatimTextOutput(NS(id, "dr_error"))
+    )
   )
 }
 
@@ -218,7 +206,6 @@ DoseResponseServer <- function(id, data, listResults) {
     })
 
     drFct <- function() {
-      output$dr_error <- renderText(NULL)
       req(is.data.frame(data$df))
       df <- data$df
       req(input$substanceNames)
@@ -270,11 +257,15 @@ DoseResponseServer <- function(id, data, listResults) {
       })
       if (inherits(e, "try-error")) {
         err <- conditionMessage(attr(e, "condition"))
-        output$dr_error <- renderText(err)
+        print_noti(FALSE, err)
       } else {
         listResults$curr_data <- new("doseResponse", df = resDF, p = resPlot)
         listResults$curr_name <- paste("Test Nr", length(listResults$all_names) + 1, "Conducted dose response analysis")
         output$dr_result <- renderTable(resDF, digits = 6)
+
+        listResults$counter <- listResults$counter + 1
+        new_result_name <- paste0("DoseResponseNr", listResults$counter)
+        listResults$all_data[[new_result_name]] <- new("doseResponse", df = resDF, p = resPlot)
       }
     }
 
@@ -357,45 +348,6 @@ DoseResponseServer <- function(id, data, listResults) {
       }
     })
 
-    # Download results
-    observeEvent(input$dr_save, {
-      if (is.null(listResults$curr_name)) {
-        return(NULL)
-      }
-      if (!(listResults$curr_name %in% unlist(listResults$all_names))) {
-        listResults$all_data[[length(listResults$all_data) + 1]] <- listResults$curr_data
-        listResults$all_names[[length(listResults$all_names) + 1]] <- listResults$curr_name
-      }
-      updateCheckboxGroupInput(session, "TableSaved",
-        choices = listResults$all_names
-      )
-    })
-
-    observeEvent(input$download_dr, {
-      print_noti(is_valid_filename(input$user_filename), "Defined filename is not valid")
-      lr <- unlist(listResults$all_names)
-      indices <- sapply(input$TableSaved, function(x) {
-        which(x == lr)
-      })
-      req(length(indices) >= 1)
-      l <- listResults$all_data[indices]
-      if (Sys.getenv("RUN_MODE") == "SERVER") {
-        print_noti(check_filename_for_server(input$user_filename), "Defined filename does not have xlsx as extension")
-        excelFile <- createExcelFile(l)
-        upload(session, excelFile, new_name = input$user_filename)
-      } else {
-        print_noti(check_filename_for_serverless(input$user_filename), "Defined filename does not have zip as extension")
-        jsString <- createJSString(l)
-        session$sendCustomMessage(
-          type = "downloadZip",
-          list(
-            numberOfResults = length(jsString),
-            FileContent = jsString,
-            Filename = input$user_filename
-          )
-        )
-      }
-    })
   })
 
   return(listResults)

bs/R/MainApp.R

@@ -3,6 +3,11 @@ app <- function() {
   ui <- fluidPage(
     useShinyjs(),
     includeScript(system.file("www/download.js", package = "bs")),
+    tags$head(
+      tags$script(src = "https://cdnjs.cloudflare.com/ajax/libs/jszip/3.7.1/jszip.min.js"),
+      tags$script(src = "https://cdnjs.cloudflare.com/ajax/libs/FileSaver.js/2.0.5/FileSaver.min.js"),
+      tags$script(src = "https://cdnjs.cloudflare.com/ajax/libs/html2canvas/0.4.1/html2canvas.min.js")
+    ),
     sidebarLayout(
       sidebarPanel(
         div(
@@ -124,7 +129,8 @@ app <- function() {
             DoseResponseUI("DOSERESPONSE")
           ),
           id = "conditionedPanels"
-        )
+        ),
+        uiOutput("Results")
       )
     )
   )
@@ -135,6 +141,12 @@ app <- function() {
       backup_df = NULL, filter_col = NULL, filter_group = NULL
     )
 
+    listResults <- reactiveValues(
+      curr_data = NULL, curr_name = NULL,
+      all_data = list(), all_names = list(),
+      counter = 0
+    )
+
     # docu data
     observeEvent(input[["data_docu"]], {
       showModal(modalDialog(
@@ -303,10 +315,6 @@ app <- function() {
       )
     })
 
-    listResults <- reactiveValues(
-      curr_data = NULL, curr_name = NULL,
-      all_data = list(), all_names = list()
-    )
     OperationEditorServer("OP", dataSet, listResults)
     corrServer("CORR", dataSet, listResults)
     visServer("VIS", dataSet, listResults)
@@ -315,6 +323,123 @@ app <- function() {
     DoseResponseServer("DOSERESPONSE", dataSet, listResults)
     FormulaEditorServer("FO", dataSet)
     SplitByGroupServer("SG", dataSet)
+
+    # Render results list
+    output$Results <- renderUI({
+      if(input$conditionedPanels == "DataWrangling" || input$conditionedPanels == "Dose Response analysis") return()
+      res <- listResults$all_data |> rev()
+      if (length(res) == 0) return()
+      res_ui_list <- lapply(names(res), function(name) {
+        temp <- res[[name]]
+        if (is.vector(temp)) {
+          div(
+            class = "var-box-output",
+            div(
+              class = "var-box-name",
+              name
+            ),
+            verbatimTextOutput(paste0("res_", name)),
+            actionButton(paste0("remove_res_", name), "Remove", class = "btn-danger")
+          )
+        } else if (is.data.frame(temp)) {
+          div(
+            class = "var-box-output",
+            div(
+              class = "var-box-name",
+              name
+            ),
+            DTOutput(paste0("res_", name)),
+            actionButton(paste0("remove_res_", name), "Remove", class = "btn-danger")
+          )
+        } else if (inherits(temp, "plot")) {
+          div(
+            class = "var-box-output",
+            div(
+              class = "var-box-name",
+              name
+            ),
+            plotOutput(paste0("res_", name), width = "100%", height = "800px"),
+            actionButton(paste0("remove_res_", name), "Remove", class = "btn-danger")
+          )
+        } else {
+          div(
+            class = "var-box-output",
+            div(
+              class = "var-box-name",
+              name
+            ),
+            verbatimTextOutput(paste0("res_", name)),
+            actionButton(paste0("remove_res_", name), "Remove", class = "btn-danger")
+          )
+        }
+      })
+      download_stuff <- div(
+        br(),
+        h4("Results"),
+        actionButton("download", "Save and exit"),
+        textInput("user_filename", "Set filename", value = "")
+      )
+
+      do.call(tagList, list(download_stuff, res_ui_list))
+    })
+
+    # Show results
+    observe({
+      res <- listResults$all_data
+      res_ui_list <- lapply(names(res), function(name) {
+        observeEvent(res[[name]], {
+          temp <- res[[name]]
+          if (is.vector(temp)) {
+            output[[paste0("res_", name)]] <- renderPrint(temp)
+          } else if (is.data.frame(temp)) {
+            output[[paste0("res_", name)]] <- renderDT(temp)
+          } else if (inherits(temp, "plot")) {
+            output[[paste0("res_", name)]] <- renderPlot(temp@p)
+          } else if (inherits(temp, "doseResponse")) {
+            message <- "Dose Response Analysis. Too large to display."
+            output[[paste0("res_", name)]] <- renderPrint(message)
+          } else {
+            output[[paste0("res_", name)]] <- renderPrint(temp)
+          }
+        })
+      })
+      do.call(tagList, res_ui_list)
+    })
+
+    # Observe remove buttons
+    observe({
+      current_list <- listResults$all_data
+      lapply(names(current_list), function(name) {
+        observeEvent(input[[paste0("remove_res_", name)]], {
+          current_list <- listResults$all_data
+          current_list[[name]] <- NULL
+          listResults$all_data <- current_list
+        }, ignoreInit = TRUE)
+      })
+    })
+
+    observeEvent(input$download, {
+      print_noti(is_valid_filename(input$user_filename), "Defined filename is not valid")
+      print_noti(length(listResults$all_data) > 0, "No results to save")
+      l <- listResults$all_data
+      if (Sys.getenv("RUN_MODE") == "SERVER") {
+        print_noti(check_filename_for_server(input$user_filename), "Defined filename does not have xlsx as extension")
+        excelFile <- createExcelFile(l)
+        upload(session, excelFile, new_name = input$user_filename)
+      } else {
+        print_noti(check_filename_for_serverless(input$user_filename), "Defined filename does not have zip as extension")
+        jsString <- createJSString(l)
+        session$sendCustomMessage(
+          type = "downloadZip",
+          list(
+            numberOfResults = length(jsString),
+            FileContent = jsString,
+            Filename = input$user_filename
+          )
+        )
+      }
+    })
+
   }
 
   return(list(ui = ui, server = server))