retrieve metadata

NAMESPACE

@@ -2,10 +2,11 @@
 
 export(run_app)
 import(arcpga.data)
+import(dplyr)
 import(shiny)
+importFrom(DT,datatable)
 importFrom(datamods,filter_data_server)
 importFrom(datamods,filter_data_ui)
-importFrom(dplyr,"%>%")
 importFrom(dplyr,inner_join)
 importFrom(golem,activate_js)
 importFrom(golem,add_resource_path)

R/app_server.R

@@ -4,7 +4,9 @@
 #'     DO NOT REMOVE.
 #' @noRd
 app_server <- function(input, output, session) {
-  r_global <- reactiveValues()
+  r_global <- reactiveValues(triggered=0)
+  
+  
 
 
   mod_info_tab_server("insert_info_tab")
@@ -15,6 +17,17 @@ app_server <- function(input, output, session) {
 
   mod_dataset_filter_server("insert_filt", r_global)
   
+  mod_visualise_table_server("initialized_table", r_global)
+  
+  
+  observeEvent(input$showSidebar, {
+    shinyjs::toggle(id = "side-panel-2")
+    shinyjs::toggleClass("main-1", "col-sm-6")
+    shinyjs::toggleClass("main-1", "col-sm-9")
+  })
+  
+
+  
   observeEvent(input$reset_input, {
     shinyjs::reset("side-panel-2")
   })

R/app_ui.R

@@ -51,26 +51,39 @@ app_ui <- function(request) {
         tags$a("ARCPGA", href = ".", id = "big-heading", class = "my-3 h3"),
         selected = "Parcourir les donnees", position = "fixed-top",
         tabPanel(
+          
           "Parcourir les donnees",
           sidebarPanel(
             width = 3,
             id = "side-panel-1",
             
-            mod_dataset_choice_ui("initialisation")
+            mod_dataset_choice_ui("initialisation"),
+            div(
+              style = "display: inline-block;vertical-align:top; width: 50ppx;",
+              actionButton("showSidebar", "Montrer/Cacher le filtre")
+            )
           ),
+          
           sidebarPanel(
-            ## sidebarpanel2----
             width = 3,
             id = "side-panel-2",
-            # filter_data_ui("filtering"),
-            # mod_integrated_filters_ui("own_filters"),
             mod_dataset_filter_ui("insert_filt"),
             div(
               align = "center",
               actionBttn("reset_input", label = NULL, style = "material-circle", icon = icon("refresh"))
             )
-          )
+          ), 
+          mainPanel(
+            # style = "display: none;",
+            width = 6,
+            id = "main-1",
+            mod_visualise_table_ui("initialized_table") )
         ),
+        tabPanel(
+          "Parcourir les bases de genes"
+          
+          
+          ),
         tabPanel(
           "Telecharger les fichiers",
           includeHTML(file.path(app_sys(), "Integration_xlsx.html"))

R/fct_find_the_integrated.R

@@ -33,3 +33,21 @@ find_the_integrated <- function(dataset, tailleDonnee, batch, espece, tabletype,
   # Remove white spaces using gsub
   gsub(" ", "", name)
 }
+
+#' find_metadata_file
+#'
+#' @description A fct function
+#' 
+#' @return The return value, if any, from executing the function.
+#' @param dataset input$dataset
+#' @param tailleDonnee input$tailleDonnee
+#'
+#' @noRd
+find_metadata_file <- function(dataset, tailleDonnee){
+  if (tailleDonnee == "all") {
+    paste0(dataset, ".Metadata") } else{
+      paste0(dataset, ".patient.Metadata")
+    }
+}
+
+

R/mod_dataset_choice.R

@@ -11,7 +11,7 @@
 #'
 mod_dataset_choice_ui <- function(id) {
   ns <- NS(id)
-  fluidPage(
+  tagList(
     radioGroupButtons(
       inputId = ns("data_source"),
       label = "",
@@ -35,7 +35,7 @@ mod_dataset_choice_ui <- function(id) {
 }
 
 #' dataset_choice Server Functions
-#' @importFrom dplyr %>%
+#' @import dplyr
 #' @noRd
 mod_dataset_choice_server <- function(id, r_global) {
   moduleServer(id, function(input, output, session) {
@@ -161,9 +161,22 @@ mod_dataset_choice_server <- function(id, r_global) {
       )
     })
 
+    
+    nameReactive_metadata <- reactive({
+      req(input$dataset, input$Tabletype)
+      
+      
+      find_metadata_file(
+        input$dataset,
+        input$TailleDonnee
+      )
+    })
+    
+    
 
     nametab <- debounce(nameReactive, 500)
-
+    namemetatab <- debounce(nameReactive_metadata, 500)
+    
     # Use the debounced reactive expression where needed
     output$rendertext <- renderText({
       nametab()
@@ -210,27 +223,79 @@ mod_dataset_choice_server <- function(id, r_global) {
           return(NULL) # Return NULL if there is an error
         }
       )
+      
 
 
       ref <- intersect(colnames(newTab), colnames(GeneIDS))
 
       newTab 
-       # %>% {
-       #    if (input$Tabletype == "topTable") { # add TMM to TopTable
-       #      merge(., Add_TMM_to_TopTable())
-       #    } else {
-       #     .
-       #    }
-       #  }
-    })
 
+    })
+    
+    metadatatab <- eventReactive(input$launch_the_data, {
+      tab_name <- namemetatab()
+      
+      newTab <- tryCatch(
+        {
+          get(tab_name, envir = .GlobalEnv)
+        },
+        error = function(e) {
+          message(paste("Error: Object", tab_name, "does not exist in .GlobalEnv"))
+          return(NULL) # Return NULL if there is an error
+        }
+      )
+      
+      if (is.null(newTab)) return(NULL)
+     
+      
+      newTab <- newTab %>%
+        filter({
+          if (input$TailleDonnee != "all") {
+            Batch == input$batch & Patient == input$TailleDonnee
+          } else {
+            Batch %in% c(2, 3)
+          }
+        })
+      
+      # Step 2: Remove row names
+      rownames(newTab) <- NULL
+      
+      # Step 3: Set 'ID' column as row names and remove 'ID' column
+      rownames(newTab) <- newTab$ID
+      newTab <- newTab %>% select(-ID)
+      
+      # Step 4: Filter based on 'Tabletype' and 'subSelectTMMchoice'
+      newTab %>%
+        filter({
+          if (input$Tabletype == "topTable") {
+            rownames(newTab) %in% grep(paste(SubSelection[[input$whichIsCompare]], collapse = "|"), rownames(newTab), value = TRUE)
+          } else if (!is.null(input$subSelectTMMchoice)) {
+            rownames(newTab) %in% grep(paste(unlist(SubSelection[c(input$subSelectTMMchoice)]), collapse = "|"), rownames(newTab), value = TRUE)
+          } else {
+            TRUE
+          }
+        })
+      
+      
+      
+    })
+    
+    # observeEvent(input$launch_the_data, {
+    #   shinyjs::showElement(id = "main-1")
+    # })
+    
+    
     observe({
       r_global$loaded_table <- thistab()
     })
     
+    observe({
+      r_global$loaded_metatable <- metadatatab()
+    })
+    
     
-    # observe({
-    #   print(thistab())
-    # })
+    observe({
+      print(metadatatab())
+    })
   })
 }

R/mod_dataset_filter.R

@@ -29,30 +29,32 @@ mod_dataset_filter_server <- function(id, r_global) {
       intersect(colnames(r_global$loaded_table), colnames(GeneIDS))
     })
 
-    filtered_loaded <- reactive({
-      if (!is.null(r_global$integrated_filter)) {
-        return(merge(r_global$loaded_table, r_global$integrated_filter[, ref(), drop = FALSE], by = ref(), sort = FALSE) |> unique())
-      } else {
-        return(r_global$loaded_table)
-      }
-    })
-
-
-
-    observe({
-      req(r_global$loaded_table)
-      res_filter <- filter_data_server(
-        id = "filtering",
-        data = filtered_loaded,
-        widget_num = "range",
-        widget_char = "picker"
-      )
-    })
+    # filtered_loaded <- reactive({
+    #   if (!is.null(r_global$integrated_filter)) {
+    #     return(merge(r_global$loaded_table, r_global$integrated_filter[, ref(), drop = FALSE], by = ref(), sort = FALSE) |> unique())
+    #   } else {
+    #     return(r_global$loaded_table)
+    #   }
+    # })
 
+    r_global$res_filter <- filter_data_server(
+      id = "filtering",
+      data =  reactive({
+          if (!is.null(r_global$integrated_filter)) {
+            return(merge(r_global$loaded_table, r_global$integrated_filter[, ref(), drop = FALSE], by = ref(), sort = FALSE) |> unique())
+          } else {
+            return(r_global$loaded_table)
+          }
+        }),
+      widget_num = "range",
+      widget_char = "picker"
+    )
+    
 
-    observe({
-      print(r_global$loaded_table)
-    })
+ 
+    # observe({
+    #   print(r_global$res_filter$filtered())
+    # })
   })
 }
 

R/mod_visualise_table.R

+#' visualise_table UI Function
+#'
+#' @description A shiny Module.
+#'
+#' @param id,input,output,session Internal parameters for {shiny}.
+#'
+#' @noRd 
+#'
+#' @importFrom shiny NS tagList 
+mod_visualise_table_ui <- function(id){
+  ns <- NS(id)
+  tagList(
+    DT::dataTableOutput(ns("dataset_to_explore"))
+  )
+}
+    
+#' visualise_table Server Functions
+#' @importFrom DT datatable
+#' @noRd 
+mod_visualise_table_server <- function(id, r_global){
+  moduleServer( id, function(input, output, session){
+    ns <- session$ns
+ 
+    
+    output$dataset_to_explore <- DT::renderDataTable(server = TRUE, {
+      req(r_global$res_filter)
+
+      datatable(r_global$res_filter$filtered(),
+                rownames = FALSE,
+                class = "cell-border stripe",
+                filter = "top",
+               # caption = nametab(),
+               extensions = c("ColReorder"),
+               selection = "none",
+               options = list(
+                 select = FALSE,
+                 scrollX = TRUE,
+                 dom = "Blfrtip",
+                 columnDefs = list(list(className = "dt-center", targets = "_all")),
+                 colReorder = TRUE
+               )
+      )
+    })
+    
+    
+  })
+}
+    
+## To be copied in the UI
+# mod_visualise_table_ui("visualise_table_1")
+    
+## To be copied in the server
+# mod_visualise_table_server("visualise_table_1")

dev/02_dev.R

@@ -26,6 +26,7 @@ golem::add_module(name = "footer", with_test = FALSE)
 golem::add_module(name = "dataset_choice", with_test = FALSE)
 golem::add_module(name = "integrated_filters", with_test = FALSE)
 golem::add_module(name = "dataset_filter", with_test = FALSE)
+golem::add_module(name = "visualise_table", with_test = FALSE)
 
 ## Add helper functions ----
 ## Creates fct_* and utils_*

inst/app/www/custom.css

@@ -33,3 +33,13 @@ body {
 .fa-power-off {
   margin-right: 5px;
 }
+
+#side-panel-1, #side-panel-2 {
+  min-height: 20px;
+  padding: 20px;
+  margin-bottom: 20px;
+  background-color: #ffffff;
+  border: 1px solid #dddddd;
+  border-radius: 8px;
+  box-shadow: 0 4px 6px rgba(0, 0, 0, 0.1);
+}

inst/app/www/custom.sass

@@ -29,4 +29,13 @@ body
           
           
 .fa-power-off 
-    margin-right: 5px
\ No newline at end of file
+    margin-right: 5px
+
+#side-panel-1, #side-panel-2
+  min-height: 20px
+  padding: 20px
+  margin-bottom: 20px
+  background-color: #ffffff
+  border: 1px solid #dddddd
+  border-radius: 8px
+  box-shadow: 0 4px 6px rgba(0, 0, 0, 0.1)
\ No newline at end of file