r - 使用带有 geom_raster 的 annotation_raster 的彩色栅格的位置不精确

Question

使用 geom_raster 生成背景后，许多使用 annotation_raster 创建的评估者被附加在背景上。但是，新栅格的位置并不总是正确的——尽管 annotation_raster 的位置代码是正确的，但某些栅格并未正确位于其理想或目标位置。

经过一些测试，调整 PlotMargin 和栅格在背景网格中的位置会使栅格倾斜。

我希望使光栅的位置正确。

以下是光栅倾斜的 3 个示例：
位于背景中间网格的 光栅

PlotMargin (0,0,0.2,0):  

http://i.imgur.com/aS7OC.png

光栅位于背景的上下网格中

PlotMargin (0,0,0.2,0):  

http://i.imgur.com/FJdOw.png
栅格位于背景的上下网格中

PlotMargin (0.2,0,0.2,0): 
http://i.imgur.com/uFX0G.png

.csv 数据：

https://www.dropbox.com/s/ik3q8ppo5qgahx1/CubicLateralRootLengthDensityPlantLayerOrder_4Layer.csv

示例代码：

library(ggplot2)
library(grid)
require("gridExtra")
require("reshape")

setwd("F:\\Code\\R\\viRoot_R\\RLD")

###### png("RLD_Lateral_10cm_LayerAndOrder_rasterUpAndBottom_200.png",height=1300,width=1840, res = 200)
png("RLD_Lateral_10cm_LayerAndOrder_rasterUpAndBottom_100.png",height=650,width=920, res = 100)


dataLateralAll = read.csv("CubicLateralRootLengthDensityPlantLayerOrder_4Layer.csv", header = TRUE) 


dataLateralAll$LinkLengthSumCM = ifelse(dataLateralAll$Layer < 4 | dataLateralAll$Layer > 8 , 0, dataLateralAll$LinkLengthSumCM)
# write.csv(dataLateralAll, "dataLateralAll.csv", row.names=FALSE)

subDataLayerAll = data.frame(dataLateralAll[c('YCenter', 'ZCenter','XCenter','Layer','LinkLengthSumCM')])
mSubDataLayerAll = melt(subDataLayerAll, measure.var = 'LinkLengthSumCM')
castMSubDataLayerAll = cast(mSubDataLayerAll, YCenter + ZCenter + XCenter ~ variable, sum )

df <- expand.grid(x = seq(-40,40,10), y =seq(-30,30,10) )
df <- data.frame(df, YCenter = castMSubDataLayerAll$YCenter)
#df$YCenter <- factor(df$YCenter, levels = seq(-2.5,-37.5,-5))

df2 <- df

df2$Length = castMSubDataLayerAll$LinkLengthSumCM / 1000
# write.csv(df2, "dataNewSum.csv", row.names=FALSE)

df2$YCenter <- as.character(df2$YCenter)
df2$YCenter[df2$YCenter == "-5"] <- "0 - 10 cm"
df2$YCenter[df2$YCenter == "-15"] <- "10 - 20 cm"
df2$YCenter[df2$YCenter == "-25"] <- "20 - 30 cm"
df2$YCenter[df2$YCenter == "-35"] <- "30 - 40 cm"

df2$YCenter <- as.factor(df2$YCenter)
# To change plot order of facet wrap,
# change the order of varible levels with factor()
df2$YCenter <- factor(df2$YCenter, levels = c("0 - 10 cm","10 - 20 cm","20 - 30 cm","30 - 40 cm"))

# temp = annotation_raster(colorOrder, 5,15, 11.66, 15) + annotation_raster(colorType, 5,15, 5, 8.33)

p1 <- ggplot(subset(df2, YCenter == "0 - 10 cm"), aes(x, y)) + geom_raster(aes(fill = Length)) + facet_wrap(~YCenter) +
  coord_fixed(ratio = 1) + xlab(NULL) + ylab(NULL) + 
  ylim(-35,35) + xlim(-45, 45) + 
  scale_fill_continuous(name = expression( paste ("RLD \n(cm ", cm^-3, ")"  )), limits=c(0.0001, 13),trans = "log", low = "white", high = "blue", breaks=c(0.0001,0.001,0.01,0.1,1,12),labels=c("0.0001","0.001","0.01","0.1","1","12"), na.value = "white") + 
  scale_x_continuous(breaks = seq(-45, 45, by = 10), expand=c(0.03, 0.03)) + scale_y_continuous(breaks = seq(-35, 35, by = 10), expand=c(0.03, 0.03)) +
  theme(plot.margin = unit(c(0,0,0.2,0.2), "lines") ) + theme(panel.margin = unit(0, "lines") ) + theme(legend.margin = unit(0, "cm")) + 
  ######   theme(plot.margin = unit(c(0,0,0.2,0), "lines") ) + theme(panel.margin = unit(0, "lines") ) + theme(legend.margin = unit(0, "cm")) + 
  theme(axis.title.x=element_text(size=15), axis.title.y=element_text(size=15), axis.text.x=element_text(size=13, colour = "white"), axis.text.y=element_text(size=13) ) +
  theme(legend.title = element_text(size = 13), legend.text = element_text(size=11),  legend.key.height=unit(1.2, "cm")  ) +
  theme(strip.text.x = element_text(size = 13), strip.background=element_rect(fill="white"))+
  theme(panel.background=element_rect(colour="white") )
#   theme(panel.grid.minor = element_line(colour = NULL, linetype = NULL, size = NULL), panel.grid.major = element_line(colour = NULL, linetype = NULL, size = NULL)) + 
#   theme(panel.grid.minor = element_blank(), panel.grid.major = element_blank(), panel.grid.minor.x = element_blank(), panel.grid.minor.y = element_blank(),panel.grid.major.x = element_blank(), panel.grid.major.y = element_blank()) + 
#   
# + theme(legend.position="none")


p2 <- ggplot(subset(df2, YCenter == "10 - 20 cm"), aes(x, y)) + geom_raster(aes(fill = Length)) + facet_wrap(~YCenter) +
  coord_fixed(ratio = 1) + xlab(NULL) + ylab(NULL) + 
  ylim(-45,45) + xlim(-45, 45) + 
  scale_fill_continuous(name = expression( paste ("RLD \n(cm ", cm^-3, ")"  )), limits=c(0.0001, 13),trans = "log", low = "white", high = "blue", breaks=c(0.0001,0.001,0.01,0.1,1,12),labels=c("0.0001","0.001","0.01","0.1","1","12"), na.value = "white") + 
  scale_x_continuous(breaks = seq(-45, 45, by = 10), expand=c(0.03, 0.03)) + scale_y_continuous(breaks = seq(-35, 35, by = 10), expand=c(0.03, 0.03)) +
  theme(plot.margin = unit(c(0,0.2,0.2,0), "lines") ) + theme(panel.margin = unit(0, "lines")) + theme(legend.margin = unit(0, "cm")) + 
  ######   theme(plot.margin = unit(c(0,0,0.2,0), "lines") ) + theme(panel.margin = unit(0, "lines")) + theme(legend.margin = unit(0, "cm")) + 
  theme(axis.title.x=element_text(size=15), axis.title.y=element_text(size=15), axis.text.x=element_text(size=13, colour = "white"), axis.text.y=element_text(size=13, colour = "white"), legend.title = element_text(size = 13), legend.text = element_text(size=11),  legend.key.height=unit(1, "cm")  ) +
  theme(strip.text.x = element_text(size = 13), strip.background=element_rect(fill="white")) 
#   annotate("point", x = -15, y = 0, size = 7, colour = "deeppink")+ annotate("point", x = 15, y = 0, size = 7, colour = "deeppink")
# + theme(legend.position="none")

p3 <- ggplot(subset(df2, YCenter == "20 - 30 cm"), aes(x, y)) + geom_raster(aes(fill = Length)) + facet_wrap(~YCenter) +
  coord_fixed(ratio = 1) + xlab(NULL) + ylab(NULL) + 
  ylim(-45,45) + xlim(-45, 45) + 
  scale_fill_continuous(name = expression( paste ("RLD \n(cm ", cm^-3, ")"  )), limits=c(0.0001, 13),trans = "log", low = "white", high = "blue", breaks=c(0.0001,0.001,0.01,0.1,1,12),labels=c("0.0001","0.001","0.01","0.1","1","12"), na.value = "white") + 
  scale_x_continuous(breaks = seq(-45, 45, by = 10), expand=c(0.03, 0.03)) + scale_y_continuous(breaks = seq(-35, 35, by = 10), expand=c(0.03, 0.03)) +
  theme(plot.margin = unit(c(0,0,0.2,0.2), "lines") ) + theme(panel.margin = unit(0, "lines")) + theme(legend.margin = unit(0, "cm")) + 
  ######   theme(plot.margin = unit(c(0,0,0.2,0), "lines") ) + theme(panel.margin = unit(0, "lines")) + theme(legend.margin = unit(0, "cm")) + 
  theme(axis.title.x=element_text(size=15), axis.title.y=element_text(size=15), axis.text.x=element_text(size=13), axis.text.y=element_text(size=13), legend.title = element_text(size = 13), legend.text = element_text(size=11),  legend.key.height=unit(1, "cm")  ) +
  theme(strip.text.x = element_text(size = 13), strip.background=element_rect(fill="white"))+ 
  annotate("point", x = -15, y = 0, size = 2, colour = "deeppink")+ annotate("point", x = 15, y = 0, size = 2, colour = "deeppink")
# + theme(legend.position="none")

p4 <- ggplot(subset(df2, YCenter == "30 - 40 cm"), aes(x, y)) + geom_raster(aes(fill = Length)) + facet_wrap(~YCenter) +
  coord_fixed(ratio = 1) + xlab(NULL) + ylab(NULL) + 
  ylim(-45,45) + xlim(-45, 45) + 
  scale_fill_continuous(name = expression( paste ("RLD \n(cm ", cm^-3, ")"  )), limits=c(0.0001, 13),trans = "log", low = "white", high = "blue", breaks=c(0.0001,0.001,0.01,0.1,1,12),labels=c("0.0001","0.001","0.01","0.1","1","12"), na.value = "white") + 
  scale_x_continuous(breaks = seq(-45, 45, by = 10), expand=c(0.03, 0.03)) + scale_y_continuous(breaks = seq(-35, 35, by = 10), expand=c(0.03, 0.03)) +
  theme(plot.margin = unit(c(0,0.2,0.2,0), "lines") ) + theme(panel.margin = unit(0, "lines")) + theme(legend.margin = unit(0, "cm")) + 
  ######   theme(plot.margin = unit(c(0,0,0.2,0), "lines") ) + theme(panel.margin = unit(0, "lines")) + theme(legend.margin = unit(0, "cm")) + 
  theme(axis.title.x=element_text(size=15), axis.title.y=element_text(size=15), axis.text.x=element_text(size=13), axis.text.y=element_text(size=13, colour = "white"), legend.title = element_text(size = 13), legend.text = element_text(size=11),  legend.key.height=unit(1, "cm")  ) +
  theme(strip.text.x = element_text(size = 13, colour = "black"), strip.background=element_rect(fill="white") ) + 
  annotate("point", x = -15, y = 0, size = 2, colour = "deeppink")+ annotate("point", x = 15, y = 0, size = 2, colour = "deeppink")



dataLateralLayerOrder = read.csv("CubicLateralRootLengthDensityPlantLayerOrder_4Layer.csv", header = TRUE) 
colnames(dataLateralLayerOrder)[9] = "Len"

# Layer;
subDataLayer = data.frame(dataLateralLayerOrder[c('YCenter', 'ZCenter','XCenter','Layer','Len')])
mSubDataLayer = melt(subDataLayer, measure.var = 'Len')
castMSubDataLayer = cast(mSubDataLayer, YCenter + ZCenter + XCenter ~ Layer + variable, sum )
# write.csv(castMSubDataLayer, "dataLayer.csv", row.names=FALSE)

# Order;
# subDataLayerOrder = dataLateralLayerOrder[!(dataLateralLayerOrder$Layer == 1 & dataLateralLayerOrder$Layer == 100 ), ]

# subDataLayerOrder = subset(dataLateralLayerOrder, Layer >=4 & Layer <100 & Layer ==0 )
subDataLayerOrder = subset(dataLateralLayerOrder, Layer == 0 | Layer == 4 | Layer == 5 | Layer == 6  | Layer == 7  | Layer == 8 )
subDataOrder = data.frame(subDataLayerOrder[c('YCenter', 'ZCenter','XCenter','OrderRank','Len')])
mSubDataOrder = melt(subDataOrder, measure.var = 'Len')
castMSubDataOrder = cast(mSubDataOrder, YCenter + ZCenter + XCenter ~ OrderRank + variable, sum )
# write.csv(castMSubDataOrder, "dataOrder.csv", row.names=FALSE)

# write.csv(dataLateralLayerOrder, "dataLateralLayerOrder.csv", row.names=FALSE)

sumRowOrder = apply(castMSubDataOrder[5: length(castMSubDataOrder)], 1, sum)
sweptOrder = round(sweep(castMSubDataOrder[5: length(castMSubDataOrder)], 1, sumRowOrder, "/"), 3) * 1000
sweptXYZOrder = data.frame(castMSubDataOrder[1:3], sweptOrder)
sweptXYZOrderNoNaN = na.omit(sweptXYZOrder)
sweptXYZOrderNoNaN5 = subset(sweptXYZOrderNoNaN, YCenter == -5)
sweptXYZOrderNoNaN15 = subset(sweptXYZOrderNoNaN, YCenter == -15)


### the background of the band is white;
# for(i in 1:nrow(sweptXYZOrderNoNaN5)) {
#   row <- sweptXYZOrderNoNaN5[i,]
#   xMinBackground = row[[3]] - 5
#   xMaxBackground = row[[3]] + 5
#   yMinBackground = row[[2]] - 1.5
#   yMaxBackground = row[[2]] + 1.5
#   colorBackground = matrix(c(rep("white",10)), nrow = 1)
#   p1 = p1 + annotation_raster(colorBackground, xMinBackground,xMaxBackground, yMinBackground, yMaxBackground)
# }
# 
# for(i in 1:nrow(sweptXYZOrderNoNaN15)) {
#   row <- sweptXYZOrderNoNaN15[i,]
#   xMinBackground = row[[3]] - 5.5
#   xMaxBackground = row[[3]] + 5.5
#   yMinBackground = row[[2]] - 1.5
#   yMaxBackground = row[[2]] + 1.5
#   colorBackground = matrix(c(rep("white",10)), nrow = 1)
#   p2 = p2 + annotation_raster(colorBackground, xMinBackground,xMaxBackground, yMinBackground, yMaxBackground)
# }


##########################################################
for(i in 1:nrow(sweptXYZOrderNoNaN5)) {
  row <- sweptXYZOrderNoNaN5[i,]
  xMin = row[[3]] - 5
  xMax = row[[3]] + 5
  yMin = row[[2]] - 5 
  yMax = row[[2]] - 3.5
#   colorOrder = matrix(c(rep("#FF0000FF",row[[4]]), rep("#FF9900FF",row[[5]]), rep("papayawhip",row[[6]]),rep("hotpink",row[[7]])), nrow = 1)
  colorOrder = matrix(c(rep("#FF0000FF",row[[4]]), rep("#FF9900FF",row[[5]]), rep("black",row[[6]]),rep("chartreuse",row[[7]])), nrow = 1)
  p1 = p1 + annotation_raster(colorOrder, xMin,xMax, yMin, yMax)
}
for(i in 1:nrow(sweptXYZOrderNoNaN15)) {
  row <- sweptXYZOrderNoNaN15[i,]
  xMin = row[[3]] - 5
  xMax = row[[3]] + 5
  yMin = row[[2]] - 5 
  yMax = row[[2]] - 3.5
#   colorOrder = matrix(c(rep("#FF0000FF",row[[4]]), rep("#FF9900FF",row[[5]]), rep("papayawhip",row[[6]]),rep("hotpink",row[[7]])), nrow = 1)
  colorOrder = matrix(c(rep("#FF0000FF",row[[4]]), rep("#FF9900FF",row[[5]]), rep("black",row[[6]]),rep("chartreuse",row[[7]])), nrow = 1)
  p2 = p2 + annotation_raster(colorOrder, xMin,xMax, yMin, yMax)
}

sumRowLayer = apply(castMSubDataLayer[8: 12], 1, sum)
sweptLayer = round(sweep(castMSubDataLayer[8: 12], 1, sumRowLayer, "/"), 3) * 1000
sweptXYZLayer = data.frame(castMSubDataLayer[1:3], sweptLayer)
sweptXYZLayerNoNaN = na.omit(sweptXYZLayer)
sweptXYZLayerNoNaN5 = subset(sweptXYZLayerNoNaN, YCenter == -5)
sweptXYZLayerNoNaN15 = subset(sweptXYZLayerNoNaN, YCenter == -15)

for(i in 1:nrow(sweptXYZLayerNoNaN5)) {
  row <- sweptXYZLayerNoNaN5[i,]
  xMin = row[[3]] - 5
  xMax = row[[3]] + 5
  yMin = row[[2]] + 3.5
  yMax = row[[2]] + 5
  #cadetblue1 cyan turquoise1 lightcyan

#   colorType = matrix(c(rep("grey0",row[[4]]), rep("paleturquoise",row[[5]]), rep("darkgreen",row[[6]]),rep("green2",row[[7]]), rep("yellow",row[[8]])), nrow = 1)
  colorType = matrix(c(rep("blue",row[[4]]), rep("turquoise1",row[[5]]), rep("darkgreen",row[[6]]),rep("green2",row[[7]]), rep("darkmagenta",row[[8]])), nrow = 1)
  p1 = p1 + annotation_raster(colorType, xMin,xMax, yMin, yMax)
}

for(i in 1:nrow(sweptXYZLayerNoNaN15)) {
  row <- sweptXYZLayerNoNaN15[i,]
  xMin = row[[3]] - 5
  xMax = row[[3]] + 5
  yMin = row[[2]] + 3.5
  yMax = row[[2]] + 5
#   colorType = matrix(c(rep("grey0",row[[4]]), rep("paleturquoise",row[[5]]), rep("darkgreen",row[[6]]),rep("green2",row[[7]]), rep("yellow",row[[8]])), nrow = 1)
  colorType = matrix(c(rep("blue",row[[4]]), rep("turquoise1",row[[5]]), rep("darkgreen",row[[6]]),rep("green2",row[[7]]), rep("darkmagenta",row[[8]])), nrow = 1)
  p2 = p2 + annotation_raster(colorType, xMin,xMax, yMin, yMax)
}


p1 + annotate("point", x = -15, y = 0, size = 2, colour = "deeppink") + annotate("point", x = 15, y = 0, size = 2, colour = "deeppink")
p2 + annotate("point", x = -15, y = 0, size = 2, colour = "deeppink") + annotate("point", x = 15, y = 0, size = 2, colour = "deeppink")



tmp <- ggplot_gtable(ggplot_build(p1)) 
leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box") 
legend <- tmp$grobs[[leg]] 

#grid.arrange(arrangeGrob(p1, p2, p3, p4, nrow = 2))

grid.arrange(arrangeGrob(p1 + theme(legend.position="none"), p2 + theme(legend.position="none"), p3 + theme(legend.position="none"), p4 + theme(legend.position="none"), 
                         left = textGrob("Perpendicular to the row (cm)", x = unit(0.5, "npc"), y = unit(0.5, "npc"), rot = 90, gp=gpar(font=2)), sub = textGrob("Parallel to the row (cm)", x = unit(0.5, "npc"), y = unit(0.7, "npc"), gp=gpar(font=2))), 
             Legend = legend,  
             widths=c(7/8, 1/8), 
             nrow=1
)

dev.off()