Сложность позиционирования компонентов карты. - PullRequest
0 голосов
/ 09 апреля 2019

Я действительно изо всех сил пытался расположить компоненты моего heatmap.2 вывода.

Я нашел этот старый ответ , объясняющий, как работает позиционирование элемента из @IanSudbery, который казался действительно ясным иЯ думал, что это дало мне понимание, в котором я нуждаюсь, но я все еще чего-то не понимаю.

Я понимаю, что все элементы по существу помещены в решетку окон, но они не ведут себя так, как яПонимаю.

Вот мой код и текущий вывод (в самом низу находится бит интереса, который упорядочивает элементы фигуры):

for(i in 1:length(ConditionsAbbr)) {

# creates its own colour palette 
    my_palette <- colorRampPalette(c("snow", "yellow", "darkorange", "red"))(n = 399)

  # (optional) defines the colour breaks manually for a "skewed" colour transition
    col_breaks = c(seq(0,0.09,length=100),    #white 'snow'
                 seq(0.1,0.19,length=100), # for yellow
                 seq(0.2,0.29,length=100), # for orange 'darkorange'
                 seq(0.3,1,length=100))    # for red

  # creates a 5 x 5 inch image
  png(paste(SourceDir, "Heatmap_", ConditionsAbbr[i], "XYZ.png"),    # create PNG for the heat map        
      width = 5*600,        # 5 x 600 pixels
      height = 5*600,
      res = 300,            # 300 pixels per inch
      pointsize = 8)        # smaller font size

  heatmap.2(ConditionsMtx[[ConditionsAbbr[i]]],
            cellnote = ConditionsMtx[[ConditionsAbbr[i]]],  # same data set for cell labels
            main =  paste(ConditionsAbbr[i], "XYZ"), # heat map title
            notecol="black",      # change font color of cell labels to black
            density.info="none",  # turns off density plot inside color legend
            trace="none",         # turns off trace lines inside the heat map
            margins =c(12,9),     # widens margins around plot
            col=my_palette,       # use on color palette defined earlier
            breaks=col_breaks,    # enable color transition at specified limits
            dendrogram="none",     # No dendogram
            srtCol = 0 ,        #correct angle of label numbers
            asp = 1 ,         #this overrides layout methinks and for some reason makes it square
            adjCol = c(NA, -35) ,
            adjRow = c(53, NA) ,
            keysize =  1.2 ,
            Colv = FALSE ,      #turn off column clustering
            Rowv =  FALSE ,    # turn off row clustering
            key.xlab = paste("Correlation") ,
            lmat = rbind( c(0, 3), c(2,1), c(0,4) ), 
            lhei = c(0.9, 4, 0.5) )

  dev.off()               # close the PNG device


}

Это дает: enter image description here

Как видите, ключ находится справа от матрицы, между матрицей, заголовком вверху и ключом внизу огромное количество пробелов, и даже если заголовок и матрицав центре PNG?

Я думаю про себя: «Хорошо, я просто создам 3x3, который легко понять и редактировать», например,

        |        |
        |        |  (3)
        |        |      
--------------------------
        |  (1)   |
   (2)  | Matrix |  
        |        | 
--------------------------   
        |  (4)   |
        |  Key   |
        |        | 

И тогда я могу избавиться от белого пространства, так что это большевот так.

        |        |(3)      
    ------------------
        |  (1)   |
     (2)| Matrix |  
        |        | 
    ------------------   
        |(4) Key |

Я делаю это, используя:

lmat = rbind( c(0, 0, 3), c(2, 1, 0), c(0, 4, 0) ), 
            lhei = c(0.9, 4, 0.5) ,
            lwid = c(1, 4, 1))

Вот как это выглядит: enter image description here

Как здоровотак как моя матрица находится в центре, мой ключ все еще выровнен по правому краю матрицы, а мой заголовок - Шелковый путь на восток?Не говоря уже о всех лишних пробелах?

Как мне заставить их совмещаться и перемещаться вместе, чтобы компоненты фигуры плотно прилегали друг к другу?

РЕДАКТИРОВАТЬ: уменьшение моих полей помогло уменьшитьпробелы, но они все еще чрезмерны.

Ответы [ 2 ]

2 голосов
/ 09 апреля 2019

Я не знаю, открыты ли вы для решений, не основанных на heatmap.2. По моему мнению, ggplot предлагает большую гибкость, и с небольшой настройкой вы можете воспроизвести тепловую карту, аналогичную той, которую вы показываете довольно комфортно, при этом максимально увеличивая заговор "недвижимости" и избегая чрезмерных пробелов.

Я рад удалить это сообщение, если вы ищете только heatmap.2 решения.

Кроме того, решение ggplot2 может выглядеть так:

Во-первых, давайте сгенерируем пример данных

set.seed(2018)
df <- as_tibble(matrix(runif(7*10), ncol = 10), .name_repair = ~seq(1:10))

Перед построением графика нам нужно изменить df с широкого на длинный

library(tidyverse)
df <- df %>%
    rowid_to_column("row") %>% 
    gather(col, Correlation, -row) %>%
    mutate(col = as.integer(col))

Затем на сюжет

 ggplot(df, aes(row, col, fill = Correlation)) +
    geom_tile() +
    scale_fill_gradientn(colours = my_palette) +     # Use your custom colour palette
    theme_void() +                                   # Minimal theme
    labs(title = "Main title") +
    geom_text(aes(label = sprintf("%2.1f", Correlation)), size = 2) +
    theme(
        plot.title = element_text(hjust = 1),        # Right-aligned text
        legend.position="bottom") +                  # Legend at the bottom
    guides(fill = guide_colourbar(
        title.position = "bottom",                   # Legend title below bar
        barwidth = 25,                               # Extend bar length
        title.hjust = 0.5))

enter image description here


Пример с несколькими тепловыми картами в сетке с помощью facet_wrap

Прежде всего, давайте сгенерируем более сложные данные.

set.seed(2018)
df <- replicate(
    4,
    as_tibble(matrix(runif(7*10), ncol = 10), .name_repair = ~seq(1:10)), simplify = F) %>%
    setNames(., paste("data", 1:4, sep = "")) %>%
    map(~ .x %>% rowid_to_column("row") %>%
        gather(col, Correlation, -row) %>%
        mutate(col = as.integer(col))) %>%
    bind_rows(.id = "data")

Тогда график идентичен тому, что мы делали раньше, плюс дополнительный оператор facet_wrap(~data, ncol = 2)

ggplot(df, aes(row, col, fill = Correlation)) +
    geom_tile() +
    scale_fill_gradientn(colours = my_palette) +     # Use your custom colour palette
    theme_void() +                                   # Minimal theme
    labs(title = "Main title") +
    geom_text(aes(label = sprintf("%2.1f", Correlation)), size = 2) +
    facet_wrap(~ data, ncol = 2) + 
    theme(
        plot.title = element_text(hjust = 1),        # Right-aligned text
        legend.position="bottom") +                  # Legend at the bottom
    guides(fill = guide_colourbar(
        title.position = "bottom",                   # Legend title below bar
        barwidth = 25,                               # Extend bar length
        title.hjust = 0.5))

enter image description here


Одно окончательное обновление

Я подумал, что было бы весело / интересно посмотреть, как далеко мы сможем добраться до сложной тепловой карты, аналогичной той, на которую вы ссылаетесь из статьи .

Пример данных включается в конце, так как это занимает немного места.

Сначала мы строим три различных ggplot2 объекта графика, которые показывают основную тепловую карту (gg3), дополнительную меньшую тепловую карту с отсутствующими значениями (gg2) и столбец, обозначающий групповые метки для каждой строки (gg1 ).

gg3 <- ggplot(df.cor, aes(col, row, fill = Correlation)) +
    geom_tile() +
    scale_fill_distiller(palette = "RdYlBu") +
    theme_void() +
    labs(title = "Main title") +
    geom_text(aes(label = sprintf("%2.1f", Correlation)), size = 2) +
    scale_y_discrete(position = "right") +
    theme(
        plot.title = element_text(hjust = 1),
        legend.position="bottom",
        axis.text.y = element_text(color = "black", size = 10)) +
    guides(fill = guide_colourbar(
        title.position = "bottom",
        barwidth = 10,
        title.hjust = 0.5))

gg2 <- ggplot(df.flag, aes(col, row, fill = Correlation)) +
    geom_tile(colour = "grey") +
    scale_fill_distiller(palette = "RdYlBu", guide = F, na.value = "white") +
    theme_void() +
    scale_x_discrete(position = "top") +
    theme(
        axis.text.x = element_text(color = "black", size = 10, angle = 90, hjust = 1, vjust = 0.5))


gg1 <- ggplot(df.bar, aes(1, row, fill = grp)) +
    geom_tile() +
    scale_fill_manual(values = c("grp1" = "orange", "grp2" = "green")) +
    theme_void() +
    theme(legend.position = "left")

Теперь мы можем использовать egg::ggarrange, чтобы расположить все три графика так, чтобы диапазоны оси y были выровнены.

library(egg)
ggarrange(gg1, gg2, gg3, ncol = 3, widths = c(0.1, 1, 3))

enter image description here


Пример данных

library(tidyverse)
set.seed(2018)
nrow <- 7
ncol <- 20
df.cor <- matrix(runif(nrow * ncol, min = -1, max = 1), nrow = nrow) %>%
    as_tibble(.name_repair = ~seq(1:ncol)) %>%
    rowid_to_column("row") %>%
    gather(col, Correlation, -row) %>%
    mutate(
        row = factor(
            paste("row", row, sep = ""),
            levels = paste("row", 1:nrow, sep = "")),
        col = factor(
            paste("col", col, sep = ""),
            levels = paste("col", 1:ncol, sep = "")))

nrow <- 7
ncol <- 10
df.flag <- matrix(runif(nrow * ncol, min = -1, max = 1), nrow = nrow) %>%
    as_tibble(.name_repair = ~seq(1:ncol)) %>%
    rowid_to_column("row") %>%
    gather(col, Correlation, -row) %>%
    mutate(
        row = factor(
            paste("row", row, sep = ""),
            levels = paste("row", 1:nrow, sep = "")),
        col = factor(
            paste("col", col, sep = ""),
            levels = paste("col", 1:ncol, sep = ""))) %>%
    mutate(Correlation = ifelse(abs(Correlation) < 0.5, NA, Correlation))


df.bar <- data.frame(
    row = 1:nrow,
    grp = paste("grp", c(rep(1, nrow - 3), rep(2, 3)), sep = "")) %>%
    mutate(
        row = factor(
            paste("row", row, sep = ""),
            levels = paste("row", 1:nrow, sep = "")))
0 голосов
/ 09 апреля 2019

Вот последние изменения, которые я сделал, чтобы получить свои результаты, однако, я бы порекомендовал воспользоваться советом Морица Эверса, если вы не слишком вкладываетесь в heatmap.2.Не забывайте об изменениях, которые я внес в размеры изображения.

# creates my own colour palette
    my_palette <- colorRampPalette(c("snow", "yellow", "darkorange", "red"))(n = 399)

  # (optional) defines the colour breaks manually for a "skewed" colour transition
    col_breaks = c(seq(0,0.09,length=100),    #white 'snow'
                 seq(0.1,0.19,length=100), # for yellow
                 seq(0.2,0.29,length=100), # for orange 'darkorange'
                 seq(0.3,1,length=100))    # for red

  # creates an image
  png(paste(SourceDir, "Heatmap_XYZ.png" )

  # create PNG for the heat map        
      width = 5*580,        # 5 x 580 pixels
      height = 5*420,       # 5 x 420 pixels
      res = 300,            # 300 pixels per inch
      pointsize =11)        # smaller font size

  heatmap.2(ConditionsMtx[[ConditionsAbbr[i]]],
            cellnote = ConditionsMtx[[ConditionsAbbr[i]]],  # same data set for cell labels
            main =  "XYZ", # heat map title
            notecol="black",      # change font color of cell labels to black
            density.info="none",  # turns off density plot inside color legend
            trace="none",         # turns off trace lines inside the heat map
            margins=c(0,0),     # widens margins around plot
            col=my_palette,       # use on color palette defined earlier
            breaks=col_breaks,    # enable color transition at specified limits
            dendrogram="none",     # only draw a row dendrogram
            srtCol = 0 ,        #correct angle of label numbers
            asp = 1 ,         #this overrides layout methinks and for some reason makes it square
            adjCol = c(NA, -38.3) , #shift column labels
            adjRow = c(77.5, NA) , #shift row labels
            keysize =  2 ,  #alter key size
            Colv = FALSE ,      #turn off column clustering
            Rowv =  FALSE ,    # turn off row clustering
            key.xlab = paste("Correlation") , #add label to key 
            cexRow = (1.8) , # alter row label font size
            cexCol = (1.8) , # alter column label font size
            notecex = (1.5) , # Alter cell font size
            lmat = rbind( c(0, 3, 0), c(2, 1, 0), c(0, 4, 0) ) , 
            lhei = c(0.43, 2.6, 0.6) , # Alter dimensions of display array cell heighs
            lwid = c(0.6, 4, 0.6) , # Alter dimensions of display array cell widths
            key.par=list(mar=c(4.5,0, 1.8,0) ) ) #tweak specific key paramters

  dev.off()

Вот вывод, который я буду продолжать улучшать до тех пор, пока все интервалы и размеры шрифта не будут соответствовать моим эстетическим предпочтениям.Я бы сказал вам точно, что я сделал, но я не уверен на 100%, честно говоря, все это ощущается так, как будто его держат вместе со старой резинкой и шпагатом, но, как говорится, не пинайте лошадь в подарок.

Output with improved spacing

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...