我正在尝试修改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可能不是解决此问题的好方法。似乎缩放功能是&#34;调整&#34;因为取决于我正在绘制的值,我会得到正确或不正确的热图。
这种方法有没有解决方法,或者有更好的方法?
利安
答案 0 :(得分:0)
我已经想出如何让我的例子工作。事实证明我得到了梯度错误,我应该在scale_fill_gradientn(colours = colorends, values = rescale(gradientends))
进行重新缩放。说实话,我不太清楚这里发生了什么!假设gradientends
正在以scale_fill_
填充缩放的rescaleoffset
值的相同方式重新调整value
,因此所有内容都正确排列,没有溢出到相邻颜色块中。
这是工作代码。我已按照SO指南中的建议将数据放入dput()ofrmat中。我在rescaloffset
中包含了geom_text
和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"))
值(这有助于调试)。我还添加了另一个类别来使其复杂化。
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)
尽管这些值是数字且看起来是连续的,但它们实际上代表了离散的分类值。总的来说,我很满意这一点,正是我正在寻找的,尽管在格式化和参数化方面还需要一些工作。
编辑:现在我真的很困惑。这是一组类似的数据,但它没有按照我的预期进行绘图。我希望BCU1 catgory是紫色(不是白色),因为它的值为1.0。有一些我不理解缩放的东西。有人可以帮忙吗?System.arrayCopy()