build fate bias DEGs

jiang-junyao · Dec 26, 2023 · f321dcb · f321dcb
1 parent b0ae91f
commit f321dcb
Show file tree

Hide file tree

Showing 3 changed files with 77 additions and 4 deletions.
diff --git a/scLT/README.md b/scLT/README.md
@@ -8,4 +8,4 @@
 - [x] Build Contact page
 - [x] add three buttons in search page (species,barcode type,Techonology) to search dataset
 - [x] Build online tool (fate_mapping,cell_type_fate_similartiy, and clone_fate_bias functions in FateMapper package)
-- [ ] replace the lineage tree in the result page with fate bias DEGs/DRBs
+- [x] replace the lineage tree in the result page with fate bias DEGs/DRBs
diff --git a/scLT/server.R b/scLT/server.R
@@ -326,6 +326,72 @@ server <- function(input, output,session = session) {
             lengthChange = FALSE)
     )
 
+
+
+
+
+
+    output$DEGs <- renderUI({
+        s = input$coretable_rows_selected
+        if (length(s)) {
+            Select_dataset =  coretable[s,]$Dataset
+        }else{
+            Select_dataset = 'Biddy_2018_Nature'
+        }
+        #dir = 'clone_fate_bias_deg/Biddy_2018_Nature_deg/celltype__fate_use.rds'
+        dir = paste0('clone_fate_bias_deg/',Select_dataset,'_deg')
+        fate_rds_file = list.files(dir,pattern = 'fate_use.rds',full.names = T)
+        fate_rds <- readRDS(fate_rds_file)
+
+       selectInput(inputId = 'ct',
+                   label = 'Choose Cell type',
+                   choices = unique(names(fate_rds)),
+                   selected = unique(names(fate_rds))[1],
+                   width = '200px')
+
+
+    })
+
+    output$fate <- renderUI({
+        s = input$coretable_rows_selected
+        if (length(s)) {
+            Select_dataset =  coretable[s,]$Dataset
+        }else{
+            Select_dataset = 'Biddy_2018_Nature'
+        }
+        #dir = 'clone_fate_bias_deg/Biddy_2018_Nature_deg/celltype__fate_use.rds'
+        dir = paste0('clone_fate_bias_deg/',Select_dataset,'_deg')
+        fate_rds_file = list.files(dir,pattern = 'fate_use.rds',full.names = T)
+        fate_rds <- readRDS(fate_rds_file)
+        selectInput(inputId = 'fate_choose',
+                    label = 'Choose fate',
+                    choices = unique(fate_rds[[input$ct]]$fate_use),
+                    selected = unique(fate_rds[[input$ct]]$fate_use)[1],
+                    width = '600px')
+
+    })
+
+    output$fate_bias_DEGs_plot <- renderImage({
+        s = input$coretable_rows_selected
+        if (length(s)) {
+            Select_dataset =  coretable[s,]$Dataset
+        }else{
+            Select_dataset = 'Biddy_2018_Nature'
+        }
+        dir = paste0('clone_fate_bias_deg/',Select_dataset,'_deg')
+        fate_rds_file = list.files(dir,pattern = 'fate_use.rds',full.names = T)
+        fate_rds <- readRDS(fate_rds_file)
+
+        png_loc <- list.files(dir,pattern = paste0(input$ct,'_',input$fate_choose,'.png'),full.names = T)
+        list(
+            src = png_loc[1],
+            contentType = "image/png",
+            width = 800
+        )
+    }, deleteFile = FALSE)
+
+
+
     #Online tools-----
     upload_metadata <- reactive({
       req(input$upload_metadata)

diff --git a/scLT/ui.R b/scLT/ui.R
@@ -136,7 +136,16 @@ ui <-
                                    )
                           ),
                           nav_panel("Fate bias DEG/DBR",
-                                   div(imageOutput("lineage_tree_plot"),style = "margin-left: auto; margin-right: auto;")
+                                   div(
+                                       fluidRow(
+                                           column(6,uiOutput("DEGs")),
+                                           column(6,uiOutput("fate"))
+                                       ),
+                                       imageOutput('fate_bias_DEGs_plot')
+
+                                       )
+
+
                           )
 
                       )
@@ -150,8 +159,6 @@ ui <-
     navbarMenu(title = "Online tools",
               icon = icon('cloud'),
               tabPanel("Tools 1",
-
-
                     layout_column_wrap(
                        width = 1/2,
                        card(