ggplot熱圖漸變的顏色爲不同類別的

Question

我試圖從ggplot2 heatmaps: using different gradients for categories

適應樣例但是，我要繪製的值是離散的（我認爲）。我已經將我的值（在存儲過程中）標準化爲介於0和1之間的百分比值。如果percent_value爲0，那麼我將顯示爲白色。如果百分比值是1，那麼我想顯示全色。顏色從白色漸變到完整。每個類別都有自己的顏色。

這裏是我的代碼...

library(RColorBrewer) 
rm(list=ls()) 
yval <- c("51140/1234.5985/16:25:17" ,"51140/1234.5985/16:25:17" ,"51140/1234.5985/16:25:17" ,"51141/1234.5985/16:25:17" ,"51146/1234.5985/16:25:17" ,"51146/1234.5985/16:25:17" ,"51146/1234.5985/16:25:17" ,"51147/1234.5985/16:25:17" ,"51147/1234.5985/16:25:17" ,"51147/1234.5985/16:25:17" ,"51149/1234.5985/16:25:17" ,"51150/1234.5985/16:25:17" ,"51150/1234.5985/16:25:17" ,"51150/1234.5985/16:25:17" ,"51153/1234.5985/16:25:17" ,"51153/1234.5985/16:25:17" ,"51153/1234.5985/16:25:17") 
cat <- c("cat1" ,"cat1" ,"cat1" ,"cat2" ,"cat1" ,"cat1" ,"cat1" ,"cat1" ,"cat1" ,"cat1" ,"cat2" ,"cat1" ,"cat1" ,"cat1" ,"cat1" ,"cat1" ,"cat1") 
xval <- c("cat1.ant" ,"cat1.output3" ,"cat1.input5" ,"cat2.cat2_active_state" ,"cat1.input5" ,"cat1.output3" ,"cat1.ant" ,"cat1.ant" ,"cat1.output3" ,"cat1.input5" ,"cat2.cat2_active_state" ,"cat1.input5" ,"cat1.ant" ,"cat1.output3" ,"cat1.output3" ,"cat1.ant" ,"cat1.input5") 
value <- c(0.75 ,1 ,1 ,0.1 ,1 ,1 ,0.75 ,0 ,1 ,1 ,1 ,1 ,0.75 ,1 ,1 ,0.75 ,1) 
dat <- data.frame(xval, yval, cat, value) 

n <- length(unique(dat$cat)) 
qual_col_pals = brewer.pal.info[brewer.pal.info$category == 'qual',] 
col_vector = unlist(mapply(brewer.pal, qual_col_pals$maxcolors, rownames(qual_col_pals))) 
sample_colours <- sample(col_vector, n) 

# 2 categories. I've hard-coded the gradient ends in this example. 
# I've tried translating the value up the number line to separate the categories into different colour bands. 
gradientends <- c(0, 1, 2, 3) 

interleave <- function(v1,v2) 
{ 
    ord1 <- 2*(1:length(v1))-1 
    ord2 <- 2*(1:length(v2)) 
    c(v1,v2)[order(c(ord1,ord2))] 
} 
colorends <- interleave(rep("white",n),sample_colours) 

ggplot(dat, aes(x = xval, y = factor(yval))) + 
    geom_tile(aes(fill = value), colour = "grey80") + 
    geom_text(aes(label = value)) + 
    scale_fill_gradientn(colours = colorends) + #, values = gradientends) + 
    theme(axis.ticks = element_blank(), 
     axis.text.x = element_text(angle = 330, hjust = 0)) 

我已經嘗試了各種方法，它在我看來，scale_fill_gradient可能不是解決這個的好方法。看起來，比例函數是動態地「調整」值，因爲根據我繪製的值，我得到的熱圖看起來是否正確。

有沒有辦法繞過它，或者有更好的方法？

利亞姆

Answer 1

我已經找到了如何讓我的例子工作。事實證明，我得到的gradientends錯了，我應該做了scale_fill_gradientn(colours = colorends, values = rescale(gradientends))重新調整。說實話，我不太確定這裏發生了什麼！假設gradientends的重新調整的方式與scale_fill_填充的比例值相同，因此所有內容都正確排列，不會溢出到相鄰的顏色塊中。

這裏是工作代碼。按照SO指南的建議，我已將數據放在dmat（）ofrmat中。我在geom_text（幫助調試）中包含了value和rescaloffset值。我還添加了另一個類別，使其複雜化一點。

rm(list=ls()) 
library(RColorBrewer) 

dat <- structure(list(xval = structure(c(5L, 3L, 2L, 4L, 2L, 3L, 1L, 
1L, 3L, 2L, 4L, 2L, 1L, 3L, 3L, 1L, 2L), .Label = c("cat1.ant", 
"cat1.input5", "cat1.output3", "cat2.cat2_active_state", "cat3.ant" 
), class = "factor"), yval = structure(c(1L, 1L, 1L, 2L, 3L, 
3L, 3L, 4L, 4L, 4L, 5L, 6L, 6L, 6L, 7L, 7L, 7L), .Label = c("51140/1234.5985/16:25:17", 
"51141/1234.5985/16:25:17", "51146/1234.5985/16:25:17", "51147/1234.5985/16:25:17", 
"51149/1234.5985/16:25:17", "51150/1234.5985/16:25:17", "51153/1234.5985/16:25:17" 
), class = "factor"), cat = structure(c(3L, 1L, 1L, 2L, 1L, 1L, 
1L, 1L, 1L, 1L, 2L, 1L, 1L, 1L, 1L, 1L, 1L), .Label = c("cat1", 
"cat2", "cat3"), class = "factor"), value = c(0.75, 1, 1, 0.1, 
1, 1, 0.75, 0, 1, 1, 1, 1, 0.75, 1, 1, 0.75, 1), rescaleoffset = c(200.75, 
1, 1, 100.1, 1, 1, 0.75, 0, 1, 1, 101, 1, 0.75, 1, 1, 0.75, 1 
)), .Names = c("xval", "yval", "cat", "value", "rescaleoffset" 
), row.names = c(NA, -17L), class = "data.frame") 

n <- length(unique(dat$cat)) 
qual_col_pals = brewer.pal.info[brewer.pal.info$category == 'qual',] 
col_vector = unlist(mapply(brewer.pal, qual_col_pals$maxcolors, rownames(qual_col_pals))) 
sample_colours <- sample(col_vector, n) 

dat$rescaleoffset <- dat$value + 100*(as.numeric(dat$cat)-1) 

scalerange <- range(dat$value) 
gradientends <- scalerange + rep(c(0,100,200), each=2) 
colorends <- c("white", "red", "white", "green", "white", "blue") 

ggplot(dat, aes(xval, yval)) + 
    geom_tile(aes(fill = rescaleoffset), colour = "white") + 
    geom_text(aes(label = paste(format(round(value, 5), nsmall = 5), format(round(rescaleoffset, 5), nsmall = 5), sep='\n'))) + 
    scale_fill_gradientn(colours = colorends, values = rescale(gradientends)) + 
    scale_x_discrete("", expand = c(0, 0)) + 
    scale_y_discrete("", expand = c(0, 0)) + 
    theme_grey(base_size = 9) + 
    theme(axis.ticks = element_blank(), 
     axis.text.x = element_text(angle = 330, hjust = 0))+ 
    theme(legend.background = element_rect(fill="gray90", size=30, linetype="dotted")) 

雖然這些值是數字並且看起來是連續的，但它們實際上表示離散的分類值。總的來說，我對此感到滿意，而且正是我所期待的，儘管在格式化和參數化方面需要一些工作。

編輯：現在我真的很困惑。這裏有一組類似的數據，但並不像我預期的那樣繪圖。我期望BCU1類型是暗紫色（不是白色），因爲它的值爲1.0。有些東西我對縮放並不瞭解。誰能幫忙？

dat <- structure(list(heatmap_row_display = structure(c(2L, 6L, 5L, 
8L, 4L, 3L, 7L, 9L, 1L, 3L, 7L, 9L, 4L, 1L, 4L, 1L, 3L, 7L, 9L 
), .Label = c("051140/1084.8158/16:25:17", "051141/1084.8466/16:25:17", 
"051146/1084.8803/16:25:17", "051147/1084.8876/16:25:17", "051148/1084.8965/16:25:17", 
"051149/1084.9465/16:25:17", "051150/1084.9525/16:25:17", "051152/1084.9965/16:25:17", 
"051153/1085.0193/16:25:17"), class = "factor"), msg_no = c(51141L, 
51149L, 51148L, 51152L, 51147L, 51146L, 51150L, 51153L, 51140L, 
51146L, 51150L, 51153L, 51147L, 51140L, 51147L, 51140L, 51146L, 
51150L, 51153L), relative_time_ms = c(1084.8466, 1084.9465, 1084.8965, 
1084.9965, 1084.8876, 1084.8803, 1084.9525, 1085.0193, 1084.8158, 
1084.8803, 1084.9525, 1085.0193, 1084.8876, 1084.8158, 1084.8876, 
1084.8158, 1084.8803, 1084.9525, 1085.0193), pcan_rx_datetime_adjusted = structure(c(1487089517, 
1487089517, 1487089517, 1487089517, 1487089517, 1487089517, 1487089517, 
1487089517, 1487089517, 1487089517, 1487089517, 1487089517, 1487089517, 
1487089517, 1487089517, 1487089517, 1487089517, 1487089517, 1487089517 
), class = c("POSIXct", "POSIXt"), tzone = ""), block_name = structure(c(1L, 
1L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 
3L, 3L), .Label = c("BCU1", "BCU2", "IDC1_status"), class = "factor"), 
    pcan_attribute = structure(c(1L, 1L, 2L, 2L, 3L, 3L, 3L, 
    3L, 3L, 4L, 4L, 4L, 4L, 4L, 5L, 5L, 5L, 5L, 5L), .Label = c("BCU1.BCU1_active_state", 
    "BCU2.BCU2_active_state", "IDC1_status.IDC1_ant", "IDC1_status.IDC1_input5", 
    "IDC1_status.IDC1_output3"), class = "factor"), data_value_as_string = c(1L, 
    1L, 1L, 1L, 0L, 3L, 3L, 3L, 3L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 1L, 1L), data_value = c(1L, 1L, 1L, 1L, 0L, 3L, 3L, 3L, 
    3L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L), value = c(1, 
    1, 1, 1, 0, 0.75, 0.75, 0.75, 0.75, 1, 1, 1, 1, 1, 1, 1, 
    1, 1, 1), colour = structure(c(2L, 2L, 1L, 1L, 3L, 3L, 3L, 
    3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L), .Label = c("cyan", 
    "darkviolet", "deeppink"), class = "factor"), rescaleoffset = c(1, 
    1, 101, 101, 200, 200.75, 200.75, 200.75, 200.75, 201, 201, 
    201, 201, 201, 201, 201, 201, 201, 201)), .Names = c("heatmap_row_display", 
"msg_no", "relative_time_ms", "pcan_rx_datetime_adjusted", "block_name", 
"pcan_attribute", "data_value_as_string", "data_value", "value", 
"colour", "rescaleoffset"), row.names = c(NA, 19L), class = "data.frame") 

n <- length(unique(dat$block_name)) 
# Do it this way to avoid reordering the colours in the data frame 
sample_colours <- levels(factor(dat$colour, levels=unique(dat$colour))) 

# Rescale all the values into categories of 100 
dat$rescaleoffset <- dat$value + 100*(as.numeric(dat$block_name)-1) 

scalerange <- range(dat$value) 
# Mark the end of each gradient for each category block. 
gradientends <- scalerange + rep(seq(0, (n - 1) * 100, by = 100), each=2) 

# Interleave two vectors, used to interleave "white" with each of the category colours. 
# "white" is used to colour the values on lowest end of each category's gradient range. 
interleave <- function(v1,v2) 
{ 
    ord1 <- 2*(1:length(v1))-1 
    ord2 <- 2*(1:length(v2)) 
    c(v1,v2)[order(c(ord1,ord2))] 
} 
colorends <- interleave(rep("white",n),sample_colours) 

p <- ggplot(dat, aes(pcan_attribute, heatmap_row_display)) + 
    geom_tile(aes(fill = rescaleoffset), colour = "white") + 
    geom_text(aes(label = paste(format(round(value, 1), nsmall = 1), sep='\n')), size=rel(2.0)) + 
    scale_fill_gradientn(colours = colorends, values = rescale(gradientends)) + 
    scale_x_discrete("", expand = c(0, 0)) + 
    scale_y_discrete("", expand = c(0, 0)) + 
    theme_grey(base_size = 9) + 
    theme(axis.ticks = element_blank(), 
     axis.text.x = element_text(angle = 330, hjust = 0))+ 
    theme(legend.background = element_rect(fill="gray90", size=30, linetype="dotted")) 

print(p)