add_col_labels and add_row_labels distorting labels

[ropensci]

add_col_labels and add_row_labels distorting labels

[AliciaSchep]

Hi @alpreyes, I don't know the cause but I can see that something looks awry. Is there a minimal example of the code used that you can share? I realize you might not be able to share the code/data for the example above, but if there is a basic/simplified version that shows the same error that would be really helpful for figuring out what might be going wrong

[alpreyes]

Hi Alicia, thank you for your reply. here is example code for the first screenshot (labeled Euclidian Distance Heatmap)

`output$heatmap_clus <- renderIheatmap({
closeAlert(session, "geneAlert")
tbl.tab2 <- getTab1()
matrix_clus <- tbl.tab2[,c(1,7:ncol(tbl.tab2))] ### trying this out

#replace above command with this based on select input
if(input$select_clus == "-no selection-") return(NULL) ##commenting it out still has filtered hm show automatically
#if(is.null(input$tbl.tab2_rows_selected)) {return(NULL)} ##necessary???

##BT549 disapears from list of cell lines???
##how to make this heatmap show by default/automatically
##doesn't work with raw counts
if(input$select_clus == "All genes")
{
  #dend.clus <- hclust(dist(t(matrix_clus))) ##try not creating it as an object
  
  heatmap_clus <- main_heatmap(as.matrix(dist(t(matrix_clus)))) %>%
    add_col_labels(ticktext = colnames(matrix_clus[,-1])) %>%
    add_row_labels(ticktext = colnames(matrix_clus[,-1])) %>%
    add_col_dendro(hclust(dist(t(matrix_clus[,-1]))), reorder = TRUE) %>%
    add_row_dendro(hclust(dist(t(matrix_clus[,-1]))), reorder = TRUE, side = "right")
} else { # selected genes
  selected_rows <- input$tbl.tab1_rows_selected
  if(length(selected_rows) < 1) {
    createAlert(session, "genemessage2", "geneAlert", title = "Missing data", style =  "danger",
                content = paste0("Please select genes in Data expression tab"),
                append = FALSE)
    return(NULL)
  }
  inFile <- input$input_gene_list_tab1
  if (!is.null(inFile)) {
    geneList <- read_lines(inFile$datapath)
    selected_rows <- unique(c(selected_rows,which(matrix_clus[,1] %in% geneList)))
  }    
  
  #if(is.null(input$tbl.tab2_rows_selected)) {return(NULL)} ##might need to take this out (but its in tiagos code???)
  #dend.clus <- hclust(dist(t(matrix_clus))) ##try not creating it as an object ##dont need the object?
  heatmap_clus <- main_heatmap(as.matrix(dist(t(matrix_clus[selected_rows,-1])))) %>% ##partially working,
    add_col_labels(ticktext = colnames(matrix_clus[,-1])) %>%
    add_row_labels(ticktext = colnames(matrix_clus[,-1])) %>% ##works when not using add dendro, but calculates dist wrong?
    add_col_dendro(hclust(dist(t(matrix_clus[selected_rows,-1]))), reorder = TRUE) %>% ##add_dendro not working...save for later, try taking out t(matrix[]), but put back in later if it doesnt work
    add_row_dendro(hclust(dist(t(matrix_clus[selected_rows,-1]))), reorder = TRUE, side = "right") ##try taking out t(matrix[]), but put back in later if it doesnt work
}
heatmap_clus

})`

[alpreyes]

Here is the example code for the second screenshot (labeled Expression Heatmap)

`output$heatmap_expr <- renderIheatmap({ ###### heatmap is under construction too...raw counts doesnt work...need to get saving obj code to work

#if(is.null(input$tbl.tab1_rows_selected)) {return(NULL)} ##necessary???
if(length(input$tbl.tab1_rows_selected) < 2) return(NULL)

tbl.tab1 <- getTab1()
# Columns 1 to 6: Genename  Geneid Chr   Start   End Strand  
geneNames <- tbl.tab1 %>% slice(input$tbl.tab1_rows_selected) %>% pull("Symbol")
matrix_expr <- tbl.tab1 %>% slice(input$tbl.tab1_rows_selected) %>% select(7:ncol(tbl.tab1)) 
##may need to change order of cell lines from default alphabetic to histotype specific???...do that with dendro???
heatmap_expr <- main_heatmap(as.matrix(matrix_expr)) %>%
  add_col_labels(ticktext = colnames(matrix_expr)) %>%
  add_row_labels(ticktext = geneNames) %>% ##trying to add dendro
  add_col_dendro(hclust(dist(t(as.matrix(matrix_expr))))) ##may have to take out -1 to avoid losing 1st data col

if(nrow(matrix_expr) > 1) ##currently still trying to cluster genes selected
{
  heatmap_expr <- heatmap_expr %>% add_row_dendro(hclust(dist((matrix_expr))), reorder = TRUE, side = "right")
} ##taking out t() works but still has to be there...see DESeq2 workflow
print(heatmap_expr)  ## currently rlog visualization takes too long

})`

[AliciaSchep]

Hi @alpreyes, Thanks for sharing the code snippets.

For plot 2-- looking at this one more closely now, it seems like all the rows and columns are there, but that the row names are just really scrunched up. Or am I missing some other flaw? This could be addressed by either giving the plot more vertical room in the app, or by reducing the size of the text:

add_row_labels(ticktext = geneNames, font = list(size = 8))

For plot 1, I can more clearly see that there are issues beyond label crowding. I made a matrix of random data and then tried to recreate the part of your code that makes the heatmap:

tmpmat <- matrix(rnorm(120), nrow = 10)
matrix_clus <- cbind(data.frame(geneName = letters[seq_len(nrow(tmpmat))]), tmpmat)
selected_rows <- c(1,5,9,2)
main_heatmap(as.matrix(dist(t(matrix_clus[selected_rows,-1])))) %>% 
    add_col_labels(ticktext = colnames(matrix_clus[,-1])) %>%
    add_row_labels(ticktext = colnames(matrix_clus[,-1])) %>%
    add_col_dendro(hclust(dist(t(matrix_clus[selected_rows,-1]))), reorder = TRUE) %>% 
    add_row_dendro(hclust(dist(t(matrix_clus[selected_rows,-1]))), reorder = TRUE, side = "right")

And it seemed to make the heatmap I would expect with no mis-alignment issues. Can you
(1) Try that code above and report if it has any mis-alignment issues? Is the format of matrix_clus in the above example similar to the gene expression table?
(2) Share what version of iheatmapr you are using? packageVersion(iheatmapr)

[alpreyes]

Hi @AliciaSchep

this problem with row labels was resolved in the app i'm building however i'm now having similar problems when trying to generate heatmaps in a regular R script. It is a similar issue where all labels seem to be there but they are overlapping. Adjusting the font does not seem to fix the problem and I haven't figured out what plotly options to use to adjust the dimensions of the heatmap. Here is a screen shot of an example heatmap with the label problem.

and here is the code used to generate the it

heatmap_expr <- main_heatmap(as.matrix(vst_all_cols_DEA_genes[,-c(1:8)]), name = "Expression", colors = custom_pal_blues) %>% add_col_labels(ticktext = colnames(vst_all_cols_DEA_genes[,-c(1:8)])) %>% add_row_labels(ticktext = vst_all_cols_DEA_genes$Genename, font = list(size = 6)) %>% add_col_dendro(hclust(dist(t(as.matrix(vst_all_cols_DEA_genes[,-c(1:8)])))), reorder = TRUE) %>% add_row_dendro(hclust(dist(t(as.matrix(vst_all_cols_DEA_genes[,-c(1:8)])))), reorder = TRUE, side = "right")

any insight on how to fix the problem would be greatly appreciated. Thank you!

[AliciaSchep]

Is vst_all_cols_DEA_genes$Genename a factor or a character vector?

[alpreyes]

it is a character vector

> class(vst_all_cols_DEA_genes$Genename) [1] "character"

and just in case this might help

> package.version("iheatmapr") [1] "0.4.3"