size of element in heatmap

R/mod_Heatmaps.R

@@ -28,7 +28,7 @@ mod_Heatmaps_ui <- function(id) {
       ),
       column(width = 6, awesomeCheckbox(ns("clustc"), i18n("Column clustering"), value = TRUE)),
       column(width = 6, awesomeCheckbox(ns("clustr"), i18n("Row clustering"), value = TRUE)),
-      mod_add_ggplot_label_ui(ns("annot_complex_heatmap")),
+      mod_add_ggplot_label_ui(ns("annot_complex_heatmap"),init=list("title"=24,"labs"=13.2,"ax"=12,"cand"=10)),
       uiOutput(ns('Brewer_palette_choice'))
     ), # closes sidebarPanel
     mainPanel(
@@ -151,12 +151,23 @@ mod_Heatmaps_server <- function(id, r_global) {
       req(Heat_table())
 
 
-      # Determine the name based on the condition
-      heatmap_name <- if (plot_annot$add_title()) {
+      heat_name <- if (plot_annot$add_title()) {
         paste(plot_annot$title(), "\n", sep = "")
       } else {
         NULL
       }
+      
+      col_name <- if (plot_annot$label_axes()) {
+        paste(plot_annot$lab_x(), "\n", sep = "")
+      } else {
+        NULL
+      }
+      
+      row_name <-  if (plot_annot$label_axes()) {
+        paste(plot_annot$lab_y(), "\n", sep = "")
+      } else {
+        NULL
+      }
 
 
       if (!is.null(Column_Heat())) {
@@ -171,8 +182,8 @@ mod_Heatmaps_server <- function(id, r_global) {
               }
             )
           )
-        # column_desc(t(row_heatmap))
-        column_desc(row_heatmap)
+
+                column_desc(row_heatmap)
 
 
         row_ <- HeatmapAnnotation(
@@ -192,6 +203,9 @@ mod_Heatmaps_server <- function(id, r_global) {
       heatmap <- ComplexHeatmap::Heatmap(
         Heat_table(),
         cluster_columns = input$clustc,
+        row_title = row_name,
+        row_title_gp = grid::gpar(fontsize = plot_annot$fnt_sz_labs()),
+        column_title_gp = grid::gpar(fontsize = plot_annot$fnt_sz_labs()), 
         cluster_rows = input$clustr,
         top_annotation = row_,
         rect_gp = grid::gpar(col = "white"),
@@ -199,6 +213,11 @@ mod_Heatmaps_server <- function(id, r_global) {
                        "none" = "TMM",
                        "row" =  i18n("Row Scaled Expression"),
                        "column" =  i18n("Column Scaled Expression")),
+        heatmap_legend_param = list(
+          title_gp = grid::gpar(fontsize = plot_annot$fnt_sz_cand(), fontface = "bold"),
+          legend_direction = "horizontal"
+          # ,labels_gp =grid::gpar(fontsize = plot_annot$fnt_sz_cand())
+        ),
         col = colorRamp2(
           seq(
             stats::quantile( Heat_table(), probs = c(0.025)),
@@ -208,25 +227,22 @@ mod_Heatmaps_server <- function(id, r_global) {
           ),
           colorRampPalette(rev(brewer.pal(11, input$selected_heat_color)))(n)
         ),
-        column_title = heatmap_name, # Set the main title above the columns
-        column_names_gp = grid::gpar(fontsize = 12), # Adjust column names graphical parameters
-        # row_names_gp = gpar(fontsize = 12),     # Adjust row names graphical parameters
-        # column_title_gp = gpar(fontsize = 14),  # Adjust column title graphical parameters
-        # row_title_gp = gpar(fontsize = 14),     # Adjust row title graphical parameters
-        column_title_side = "top" # ,  # Position the column title at the top
-        # row_title_side = "left"     # Position the row title at the left
+        column_title = col_name, 
+        column_names_gp = grid::gpar(fontsize = plot_annot$fnt_sz_ax()), 
+        row_names_gp = grid::gpar(fontsize = plot_annot$fnt_sz_ax()),
+        column_title_side = "top" 
       )
 
-# 
-#       Grey, Red, Blue, Black
-#       Grey, Blue, Green, Black
-#       Grey, Cyan, Purple, Black 
-
       # Draw the combined heatmap and annotations
       showing_plot <- ComplexHeatmap::draw(
         heatmap, #+ row_anno + column_anno,
+        column_title= heat_name,
+        column_title_gp=grid::gpar(fontsize=plot_annot$fnt_sz_title()),
         show_heatmap_legend = plot_annot$add_legend(),
-        show_annotation_legend = plot_annot$add_legend()
+        show_annotation_legend = plot_annot$add_legend(),
+        heatmap_legend_side = "bottom"
+        
+        
       )
 
       # print(column_desc()[,column_order(showing_plot),drop=FALSE])
@@ -234,27 +250,7 @@ mod_Heatmaps_server <- function(id, r_global) {
       heatmap_object(showing_plot)
     })
 
-    ######### DEFINE DOWNLOAD BUTTONS ###########
-
-    # output$downloadHeat <- downloadHandler(
-    #   filename <- function() {
-    #     paste("Heat_table", Sys.time(), ".csv", sep = "")
-    #   },
-    #   content <- function(file) {
-    #     r_o <- row_order(heatmap_object())
-    #     c_o <- column_order(heatmap_object())
-    #
-    #     t_heat <- Heat_table()[r_o,c_o,drop=FALSE]
-    #     if(!is.null(column_desc())){
-    #               row_heat <- column_desc()[,c_o,drop=FALSE]
-    #
-    #     }else{
-    #       row_heat <-NULL
-    #     }
-    #
-    #     write.csv(rbind(row_heat,t_heat),file)
-    #   }
-    # )
+
     output$downloadHeat <- downloadHandler(
       filename = function() {
         paste("Heat_table", Sys.time(), ".gct", sep = "")

R/mod_add_ggplot_label.R

@@ -3,12 +3,12 @@
 #' @description A shiny Module.
 #'
 #' @param id,input,output,session Internal parameters for {shiny}.
-#'
+#' @param init list of initiated values 
 #' @noRd
 #'
 #' @importFrom shiny NS tagList
 #' @importFrom datamods i18n
-mod_add_ggplot_label_ui <- function(id) {
+mod_add_ggplot_label_ui <- function(id , init=list("title"=24,"labs"=24,"ax"=18,"cand"=6)) {
   ns <- NS(id)
   tagList(
     h4(i18n("Labels")),
@@ -38,10 +38,10 @@ mod_add_ggplot_label_ui <- function(id) {
     ),
     conditionalPanel(
       condition = "input.adj_fnt_sz == true", ns = ns,
-      numericInput(ns("fnt_sz_title"), i18n("Plot title:"), value = 24),
-      numericInput(ns("fnt_sz_labs"), i18n("Axis titles:"), value = 24),
-      numericInput(ns("fnt_sz_ax"), i18n("Axis labels:"), value = 18),
-      numericInput(ns("fnt_sz_cand"), i18n("Labels of hits:"), value = 6)
+      numericInput(ns("fnt_sz_title"), i18n("Plot title:"), value = init$title),
+      numericInput(ns("fnt_sz_labs"), i18n("Axis titles:"), value = init$labs),
+      numericInput(ns("fnt_sz_ax"), i18n("Axis labels:"), value = init$ax),
+      numericInput(ns("fnt_sz_cand"), i18n("Labels of hits:"), value = init$cand)
     ),
     awesomeCheckbox(
       inputId = ns("add_legend"),