Merge pull request #308 from lishensuo/develop23

details adjustment

inst/shinyapp/App.R

@@ -86,6 +86,7 @@ pacman::p_load(
   shinythemes,
   shinyhelper,
   shinycssloaders,
+  shinydashboard,
   survival,
   survminer,
   ezcox,

inst/shinyapp/modules/ccle/modules-ccle-comp-m2o.R

@@ -226,7 +226,8 @@ server.modules_ccle_comp_m2o = function(input, output, session) {
 	output$comp_stat_tb.ui = renderUI({
 		output$comp_stat_tb = renderDataTable({
 			# comp_stat()
-			comp_stat_ = comp_stat()
+			comp_stat_ = comp_stat() %>%
+				dplyr::rename("Batch identifiers"="id")
 			comp_stat_$p.value = format(comp_stat_$p.value, scientific=T, digits = 3)
 			dt = datatable(comp_stat_,
 				# class = "nowrap row-border",

inst/shinyapp/modules/ccle/modules-ccle-comp-o2o.R

@@ -287,6 +287,8 @@ server.modules_ccle_comp_o2o = function(input, output, session) {
 			  theme(text = element_text(size=isolate(input$axis_size)),
 			        plot.title = element_text(size=isolate(input$title_size), hjust = 0.5),
 			        plot.subtitle = element_text(size = 12))
+			pval = formatC(extract_stats(p)$subtitle_data$p.value, digits = 3, format = 'e')
+			p$labels$subtitle = bquote(paste(italic(p) == .(pval)))
 			return(p)
 		}
 	})

inst/shinyapp/modules/ccle/modules-ccle-cor-m2o.R

@@ -217,7 +217,8 @@ server.modules_ccle_cor_m2o = function(input, output, session) {
 
 	output$cor_stat_tb.ui = renderUI({
 		output$cor_stat_tb = renderDataTable({
-			cor_stat_ = cor_stat()
+			cor_stat_ = cor_stat() %>%
+				dplyr::rename("Batch identifiers"="id.x")
 			cor_stat_$p.value = format(cor_stat_$p.value, scientific=T, digits = 3)
 			dt = datatable(cor_stat_,
 				# class = "nowrap row-border",

inst/shinyapp/modules/ccle/modules-ccle-cor-o2o.R

@@ -276,6 +276,10 @@ server.modules_ccle_cor_o2o = function(input, output, session) {
 		) + 
 			theme(text = element_text(size=isolate(input$axis_size)),
 				  plot.title = element_text(size=isolate(input$title_size), hjust = 0.5))
+		pval = formatC(extract_stats(p)$subtitle_data$p.value, digits = 3, format = 'e')
+		r = round(extract_stats(p)$subtitle_data$estimate,3)
+		p$labels$subtitle = bquote(paste(widehat(italic(r))[.(input$cor_method)] == .(r), ', ' ,italic(p) == .(pval)))
+
 		return(p)
 	})
 	output$cor_plot_sct = renderPlot({cor_plot_sct()})

inst/shinyapp/modules/modules-z-help-id.R

@@ -1,61 +1,78 @@
 ui.modules_id_reference = function(id) {
 	ns = NS(id)
 	fluidPage(
-		h2("Ⅰ Molecular profile(TCGA)") %>%
-			helper(type = "inline", size = "m", fade = TRUE, title="Tip:" , 
-				content = "The Chromosomal coordinates is based on GENCODE V23(hg38)"),
-		tabsetPanel(
-			tabPanel("Gene", dataTableOutput(ns("dt_1_1_gene"))),
-			tabPanel("Protein", dataTableOutput(ns("dt_1_2_pro"))),
-			tabPanel("Mutation", dataTableOutput(ns("dt_1_3_mut"))),
-			tabPanel("CNV", dataTableOutput(ns("dt_1_4_cn"))),
-			tabPanel("Transcript", dataTableOutput(ns("dt_1_5_trans"))),
-			tabPanel("Methylation(450K)", dataTableOutput(ns("dt_1_6_450"))),
-			tabPanel("Methylation(27K)", dataTableOutput(ns("dt_1_7_27k"))),
-			tabPanel("miRNA", dataTableOutput(ns("dt_1_8_mi"))),
-		),
-		h2("Ⅰ Molecular profile(PCAWG)") %>%
-			helper(type = "inline", size = "m", fade = TRUE, title="Tip:" , 
-				content = "The Chromosomal coordinates is based on GENCODE 19(hg19)"),
-		tabsetPanel(
-			tabPanel("Gene", dataTableOutput(ns("dt_5_1_gene"))),
-			tabPanel("Promoter", dataTableOutput(ns("dt_5_2_pro"))),
-			tabPanel("Fusion", dataTableOutput(ns("dt_5_3_fu"))),
-			tabPanel("miRNA", dataTableOutput(ns("dt_5_4_mi"))),
-			tabPanel("APOBEC", dataTableOutput(ns("dt_5_5_apo")))
-		),
-		h2("Ⅰ Molecular profile(CCLE)") %>%
-			helper(type = "inline", size = "m", fade = TRUE, title="Tip:" , 
-				content = "The Chromosomal coordinates is based on GENCODE 19(hg19)"),
-		tabsetPanel(
-			tabPanel("Gene", dataTableOutput(ns("dt_6_1_gene"))),
-			tabPanel("Protein", dataTableOutput(ns("dt_6_2_pro"))),
-			tabPanel("CNV", dataTableOutput(ns("dt_6_3_cn"))),
-			tabPanel("Mutation", dataTableOutput(ns("dt_6_4_mu")))
-		),
-		h2("Ⅱ Tumor index"),
-		tabsetPanel(
-			tabPanel("Purity", dataTableOutput(ns("dt_2_1_purity"))),
-			tabPanel("Stemness", dataTableOutput(ns("dt_2_2_stemness"))),
-			tabPanel("TMB", dataTableOutput(ns("dt_2_3_tmb"))),
-			tabPanel("MSI", dataTableOutput(ns("dt_2_4_msi"))),
-			tabPanel("Genome instability", dataTableOutput(ns("dt_2_5_instability"))),
-		),
-		h2("Ⅲ Immune Infiltration"),
-		tabsetPanel(
-			tabPanel("CIBERSORT", dataTableOutput(ns("dt_3_1_ciber"))),
-			tabPanel("CIBERSORT-ABS", dataTableOutput(ns("dt_3_2_ciberABS"))),
-			tabPanel("EPIC", dataTableOutput(ns("dt_3_3_epic"))),
-			tabPanel("MCPCOUNTER", dataTableOutput(ns("dt_3_4_mcp"))),
-			tabPanel("QUANTISEQ", dataTableOutput(ns("dt_3_5_quan"))),
-			tabPanel("TIMER", dataTableOutput(ns("dt_3_6_timer"))),
-			tabPanel("XCELL", dataTableOutput(ns("dt_3_7_xcell"))),
-		),
-		h2("Ⅳ Pathway activity"),
-		tabsetPanel(
-			tabPanel("HALLMARK", dataTableOutput(ns("dt_4_1_hm"))),
-			tabPanel("KEGG", dataTableOutput(ns("dt_4_2_kegg"))),
-			tabPanel("IOBR", dataTableOutput(ns("dt_4_3_iobr")))
+		navlistPanel(
+			"Omics molecule identifiers",
+			tabPanel(
+				"1. TCGA Molecular profile",
+				tabsetPanel(
+					tabPanel("Gene", dataTableOutput(ns("dt_1_1_gene"))),
+					tabPanel("Protein", dataTableOutput(ns("dt_1_2_pro"))),
+					tabPanel("Mutation", dataTableOutput(ns("dt_1_3_mut"))),
+					tabPanel("CNV", dataTableOutput(ns("dt_1_4_cn"))),
+					tabPanel("Transcript", dataTableOutput(ns("dt_1_5_trans"))),
+					tabPanel("Methylation(450K)", dataTableOutput(ns("dt_1_6_450"))),
+					tabPanel("Methylation(27K)", dataTableOutput(ns("dt_1_7_27k"))),
+					tabPanel("miRNA", dataTableOutput(ns("dt_1_8_mi")))
+				)  %>%
+					helper(type = "inline", size = "m", fade = TRUE, title="Tip:" , 
+						content = "The Chromosomal coordinates is based on GENCODE V23(hg38)"),
+			),
+			tabPanel(
+				"2. PCAWG Molecular profile",
+				tabsetPanel(
+					tabPanel("Gene", dataTableOutput(ns("dt_5_1_gene"))),
+					tabPanel("Promoter", dataTableOutput(ns("dt_5_2_pro"))),
+					tabPanel("Fusion", dataTableOutput(ns("dt_5_3_fu"))),
+					tabPanel("miRNA", dataTableOutput(ns("dt_5_4_mi"))),
+					tabPanel("APOBEC", dataTableOutput(ns("dt_5_5_apo")))
+				)  %>%
+					helper(type = "inline", size = "m", fade = TRUE, title="Tip:" , 
+						content = "The Chromosomal coordinates is based on GENCODE 19(hg19)"),
+			),
+			tabPanel(
+				"3. CCLE Molecular profile",
+				tabsetPanel(
+					tabPanel("Gene", dataTableOutput(ns("dt_6_1_gene"))),
+					tabPanel("Protein", dataTableOutput(ns("dt_6_2_pro"))),
+					tabPanel("CNV", dataTableOutput(ns("dt_6_3_cn"))),
+					tabPanel("Mutation", dataTableOutput(ns("dt_6_4_mu")))
+				)  %>%
+					helper(type = "inline", size = "m", fade = TRUE, title="Tip:" , 
+						content = "The Chromosomal coordinates is based on GENCODE 19(hg19)"),
+			),
+			"Other non-omics identifiers",
+			tabPanel(
+				"4. Tumor index",
+				tabsetPanel(
+					tabPanel("Purity", dataTableOutput(ns("dt_2_1_purity"))),
+					tabPanel("Stemness", dataTableOutput(ns("dt_2_2_stemness"))),
+					tabPanel("TMB", dataTableOutput(ns("dt_2_3_tmb"))),
+					tabPanel("MSI", dataTableOutput(ns("dt_2_4_msi"))),
+					tabPanel("Genome instability", dataTableOutput(ns("dt_2_5_instability"))),
+				)
+			),
+			tabPanel(
+				"5. Immune Infiltration",
+				tabsetPanel(
+					tabPanel("CIBERSORT", dataTableOutput(ns("dt_3_1_ciber"))),
+					tabPanel("CIBERSORT-ABS", dataTableOutput(ns("dt_3_2_ciberABS"))),
+					tabPanel("EPIC", dataTableOutput(ns("dt_3_3_epic"))),
+					tabPanel("MCPCOUNTER", dataTableOutput(ns("dt_3_4_mcp"))),
+					tabPanel("QUANTISEQ", dataTableOutput(ns("dt_3_5_quan"))),
+					tabPanel("TIMER", dataTableOutput(ns("dt_3_6_timer"))),
+					tabPanel("XCELL", dataTableOutput(ns("dt_3_7_xcell"))),
+				)
+			),
+			tabPanel(
+				"6. Pathway activity",
+				tabsetPanel(
+					tabPanel("HALLMARK", dataTableOutput(ns("dt_4_1_hm"))),
+					tabPanel("KEGG", dataTableOutput(ns("dt_4_2_kegg"))),
+					tabPanel("IOBR", dataTableOutput(ns("dt_4_3_iobr")))
+				)
+			),
+			widths = c(3, 8)
 		)
 	)
 }

inst/shinyapp/modules/pcawg/modules-pcawg-comp-m2o.R

@@ -248,7 +248,8 @@ server.modules_pcawg_comp_m2o = function(input, output, session) {
 	output$comp_stat_tb.ui = renderUI({
 		output$comp_stat_tb = renderDataTable({
 			# comp_stat()
-			comp_stat_ = comp_stat()
+			comp_stat_ = comp_stat() %>%
+				dplyr::rename("Batch identifiers"="id")
 			comp_stat_$p.value = format(comp_stat_$p.value, scientific=T, digits = 3)
 			dt = datatable(comp_stat_,
 				# class = "nowrap row-border",

inst/shinyapp/modules/pcawg/modules-pcawg-comp-o2m.R

@@ -305,7 +305,9 @@ server.modules_pcawg_comp_o2m = function(input, output, session) {
 			  return(extract_stats(p)$subtitle_data)
 			}) %>% do.call(rbind, .) %>% 
 			dplyr::select(!expression) %>% 
-			dplyr::mutate(cancer = valid_cancer_choose, .before=1)
+			dplyr::mutate(cancer = valid_cancer_choose, .before=1) %>% 
+			dplyr::arrange(desc(cancer)) %>%
+			dplyr::mutate(cancer = factor(cancer, levels = unique(cancer)))
 			stat_comp
 		})
 	})
@@ -321,7 +323,9 @@ server.modules_pcawg_comp_o2m = function(input, output, session) {
 				"Please inspect whether to set groups or download variable data in S2 or S3 step."),
 		)
 		merge_data_line_sub = merge_data_line() %>%
-			dplyr::filter(cancer %in% unique(merge_data_line()$cancer))
+			dplyr::filter(cancer %in% unique(merge_data_line()$cancer)) %>%
+			dplyr::arrange(desc(cancer)) %>%
+			dplyr::mutate(cancer = factor(cancer, levels = unique(cancer)))
 
 		p1 = ggplot(merge_data_line_sub) + 
 		  stat_summary(aes(x=cancer, y=value, color=group),

inst/shinyapp/modules/pcawg/modules-pcawg-comp-o2o.R

@@ -310,6 +310,8 @@ server.modules_pcawg_comp_o2o = function(input, output, session) {
 			  theme(text = element_text(size=isolate(input$axis_size)),
 			        plot.title = element_text(size=isolate(input$title_size), hjust = 0.5),
 			        plot.subtitle = element_text(size = 12))
+			pval = formatC(extract_stats(p)$subtitle_data$p.value, digits = 3, format = 'e')
+			p$labels$subtitle = bquote(paste(italic(p) == .(pval)))
 			return(p)
 		}
 	})

inst/shinyapp/modules/pcawg/modules-pcawg-cor-m2o.R

@@ -239,7 +239,8 @@ server.modules_pcawg_cor_m2o = function(input, output, session) {
 
 	output$cor_stat_tb.ui = renderUI({
 		output$cor_stat_tb = renderDataTable({
-			cor_stat_ = cor_stat()
+			cor_stat_ = cor_stat() %>%
+				dplyr::rename("Batch identifiers"="id.x")
 			cor_stat_$p.value = format(cor_stat_$p.value, scientific=T, digits = 3)
 			dt = datatable(cor_stat_,
 				# class = "nowrap row-border",

inst/shinyapp/modules/pcawg/modules-pcawg-cor-o2o.R

@@ -294,6 +294,10 @@ server.modules_pcawg_cor_o2o = function(input, output, session) {
 		) + 
 			theme(text = element_text(size=isolate(input$axis_size)),
 				  plot.title = element_text(size=isolate(input$title_size), hjust = 0.5))
+		pval = formatC(extract_stats(p)$subtitle_data$p.value, digits = 3, format = 'e')
+		r = round(extract_stats(p)$subtitle_data$estimate,3)
+		p$labels$subtitle = bquote(paste(widehat(italic(r))[.(input$cor_method)] == .(r), ', ' ,italic(p) == .(pval)))
+
 		return(p)
 	})
 	output$cor_plot_sct = renderPlot({cor_plot_sct()})

inst/shinyapp/modules/pcawg/modules-pcawg-sur-m2o.R

@@ -419,7 +419,8 @@ server.modules_pcawg_sur_m2o = function(input, output, session) {
 
 	output$sur_stat_tb.ui = renderUI({
 		output$sur_stat_tb = renderDataTable({
-			sur_stat_ = sur_stat()
+			sur_stat_ = sur_stat() %>%
+				dplyr::rename("Batch identifiers"="id")
 			sur_stat_$p.value = format(sur_stat_$p.value, scientific=T, digits = 3)
 
 			dt = datatable(sur_stat_,
@@ -453,7 +454,7 @@ server.modules_pcawg_sur_m2o = function(input, output, session) {
 	)
 	output$sur_batch_res = downloadHandler(
 		filename = function(){
-			paste0("Batch_comparison_result_",format(Sys.time(), "%Y-%m-%d_%H-%M-%S"), ".csv")
+			paste0("Batch_survival_result_",format(Sys.time(), "%Y-%m-%d_%H-%M-%S"), ".csv")
 		},
 		content = function(file){
 			sur_stat_ = sur_stat()

inst/shinyapp/modules/tcga/modules-pancan-comp-m2o.R

@@ -255,7 +255,8 @@ server.modules_pancan_comp_m2o = function(input, output, session) {
 	output$comp_stat_tb.ui = renderUI({
 		output$comp_stat_tb = renderDataTable({
 			# comp_stat()
-			comp_stat_ = comp_stat()
+			comp_stat_ = comp_stat() %>%
+				dplyr::rename("Batch identifiers"="id")
 			comp_stat_$p.value = format(comp_stat_$p.value, scientific=T, digits = 3)
 			dt = datatable(comp_stat_,
 				# class = "nowrap row-border",

inst/shinyapp/modules/tcga/modules-pancan-comp-o2m.R

@@ -302,7 +302,9 @@ server.modules_pancan_comp_o2m = function(input, output, session) {
 			  return(extract_stats(p)$subtitle_data)
 			}) %>% do.call(rbind, .) %>% 
 			dplyr::select(!expression) %>% 
-			dplyr::mutate(cancer = valid_cancer_choose, .before=1)
+			dplyr::mutate(cancer = valid_cancer_choose, .before=1) %>% 
+			dplyr::arrange(desc(cancer)) %>%
+			dplyr::mutate(cancer = factor(cancer, levels = unique(cancer)))
 			stat_comp
 		})
 	})
@@ -320,7 +322,9 @@ server.modules_pancan_comp_o2m = function(input, output, session) {
 				"Please inspect whether to set groups or download variable data in S2 or S3 step."),
 		)
 		merge_data_line_sub = merge_data_line() %>%
-			dplyr::filter(cancer %in% unique(comp_data_line()$cancer))
+			dplyr::filter(cancer %in% as.character(unique(comp_data_line()$cancer))) %>%
+			dplyr::arrange(desc(cancer)) %>%
+			dplyr::mutate(cancer = factor(cancer, levels = unique(cancer)))
 
 		p1 = ggplot(merge_data_line_sub) + 
 		  stat_summary(aes(x=cancer, y=value, color=group),

inst/shinyapp/modules/tcga/modules-pancan-comp-o2o.R

@@ -317,6 +317,9 @@ server.modules_pancan_comp_o2o = function(input, output, session) {
 			  theme(text = element_text(size=isolate(input$axis_size)),
 			        plot.title = element_text(size=isolate(input$title_size), hjust = 0.5),
 			        plot.subtitle = element_text(size = 12))
+			pval = formatC(extract_stats(p)$subtitle_data$p.value, digits = 3, format = 'e')
+			p$labels$subtitle = bquote(italic(p) == .(pval))
+
 			return(p)
 		}
 	})

inst/shinyapp/modules/tcga/modules-pancan-cor-m2o.R

@@ -231,7 +231,8 @@ server.modules_pancan_cor_m2o = function(input, output, session) {
 
 	output$cor_stat_tb.ui = renderUI({
 		output$cor_stat_tb = renderDataTable({
-			cor_stat_ = cor_stat()
+			cor_stat_ = cor_stat() %>%
+				dplyr::rename("Batch identifiers"="id.x")
 			cor_stat_$p.value = format(cor_stat_$p.value, scientific=T, digits = 3)
 			dt = datatable(cor_stat_,
 				# class = "nowrap row-border",

inst/shinyapp/modules/tcga/modules-pancan-cor-o2o.R

@@ -304,6 +304,11 @@ server.modules_pancan_cor_o2o = function(input, output, session) {
 		) + 
 			theme(text = element_text(size=isolate(input$axis_size)),
 				  plot.title = element_text(size=isolate(input$title_size), hjust = 0.5))
+
+		pval = formatC(extract_stats(p)$subtitle_data$p.value, digits = 3, format = 'e')
+		r = round(extract_stats(p)$subtitle_data$estimate,3)
+		p$labels$subtitle = bquote(paste(widehat(italic(r))[.(input$cor_method)] == .(r), ', ' ,italic(p) == .(pval)))
+
 		return(p)
 	})
 	output$cor_plot_sct = renderPlot({cor_plot_sct()})

inst/shinyapp/modules/tcga/modules-pancan-sur-m2o.R

@@ -429,7 +429,8 @@ server.modules_pancan_sur_m2o = function(input, output, session) {
 
 	output$sur_stat_tb.ui = renderUI({
 		output$sur_stat_tb = renderDataTable({
-			sur_stat_ = sur_stat()
+			sur_stat_ = sur_stat() %>%
+				dplyr::rename("Batch identifiers"="id")
 			sur_stat_$p.value = format(sur_stat_$p.value, scientific=T, digits = 3)
 
 			dt = datatable(sur_stat_,
@@ -463,7 +464,7 @@ server.modules_pancan_sur_m2o = function(input, output, session) {
 	)
 	output$sur_batch_res = downloadHandler(
 		filename = function(){
-			paste0("Batch_comparison_result_",format(Sys.time(), "%Y-%m-%d_%H-%M-%S"), ".csv")
+			paste0("Batch_survival_result_",format(Sys.time(), "%Y-%m-%d_%H-%M-%S"), ".csv")
 		},
 		content = function(file){
 			sur_stat_ = sur_stat()

inst/shinyapp/modules/tcga/modules-pancan-sur-o2m.R

@@ -328,7 +328,11 @@ server.modules_pancan_sur_o2m = function(input, output, session) {
 		  	)
 		} else if(input$sur_method=="Univariate Cox regression") {
 		  	fluidRow(
-		  		column(4,colourpicker::colourInput(ns("multi_cox_color"), "Color:", "grey")),
+		  		# column(4,colourpicker::colourInput(ns("multi_cox_color"), "Color:", "grey")),
+		  		column(5,colourpicker::colourInput(ns("cox_h_g1_color"), "Color(HR>1):", "#d53e4f")),
+		  		column(5,colourpicker::colourInput(ns("cox_h_l1_color"), "Color(HR<1):", "#3288bd")),
+
+
 		  		# column(4, numericInput(ns("multi_cox_line"), "Add line(P):", 0.05)),
 		  		# column(4, selectInput(ns("multi_cox_label"),"Add text:",
 		  		# 	choices = c("HR value", "Signif.(symbol)", "Signif.(value)"),selected = "HR value"))	
@@ -465,8 +469,10 @@ server.modules_pancan_sur_o2m = function(input, output, session) {
 			    dplyr::mutate(Cancer = x, .before = 1)
 			}) %>% do.call(rbind, .)
 			fill_cols = c(input$multi_cox_color)
-			names(fill_cols) = c(
-				paste0("Group",levels(sur_res_multi$sur_dat$Group)[2]))
+			fill_cols = c(input$cox_h_g1_color, input$cox_h_l1_color)
+			names(fill_cols) = c("HR>1","HR<1")
+			# names(fill_cols) = c(
+			# 	paste0("Group",levels(sur_res_multi$sur_dat$Group)[2]))
 			p1 = sur_res %>%
 			  dplyr::rename(`p.value`=`Pr(>|z|)`, `HR` = `exp(coef)`) %>% 
 			  dplyr::select(Cancer, Group, HR, p.value) %>% 
@@ -482,11 +488,12 @@ server.modules_pancan_sur_o2m = function(input, output, session) {
 			  dplyr::mutate(pval_log = -log10(p.value)) %>% 
 			  dplyr::mutate(pval_log = ifelse(pval_log<10,pval_log, 10)) %>% 
 			  dplyr::mutate(Direct = ifelse(HR>1,"HR>1","HR<1")) %>% 
-			  ggplot(aes(x = Cancer, y = pval_log, fill = Group)) + 
+			  ggplot(aes(x = Cancer, y = pval_log, fill = Direct)) + 
 			  geom_col(position="dodge") + 
 			  scale_fill_manual(values = fill_cols) + 
 			  xlab(NULL) + ylab(isolate(input$x_name_2)) +
 			  ggtitle(label = isolate(input$title_name_2)) +
+			  guides(fill = guide_legend(title = paste0("Group:",levels(sur_res_multi$sur_dat$Group)[2]))) +
 			  geom_hline(yintercept = -log10(input$multi_cox_line), color = "red") +
 			  coord_flip() +
 			  theme_minimal() +