将文本背景设置为 ggplot 轴文本
set Text-background to ggplot axis-text
我有一个 ggplot 图形，它有一个长文本作为 Y 轴。
我正在尝试找到一种方法来设置 Y 轴的背景颜色，使用两种不同的颜色 "zebra-theme" 就像这个
但是 element_text() 中似乎没有针对此的 ggplot 功能。
有人可以帮助我吗？
谢谢
特洛帕夏
破解主题系统可能是可行的，但这可能不是一个好主意。
library(grid)
element_custom <- function(...) {
structure(list(...), class = c("element_custom", "element_blank"))
}
element_grob.element_custom <- function(element, label, x, y, ...) {
tg <- textGrob(label, y=y, gp=gpar(col=element$colour))
padding <- unit(1,"line")
rg <- rectGrob(y=y,width=grobWidth(tg)+padding, height=unit(1,"line")+padding,
gp=gpar(fill = element$fill, col=NA, alpha=0.1))
gTree(children=gList(rg, tg), width=grobWidth(tg) + padding, cl="custom_axis")
}
widthDetails.custom_axis <- function(x) x$width + unit(2,"mm") # fudge
qplot(1:3,1:3) +
theme(axis.text.y = element_custom(colour = 1:2, fill=1:2))
感谢 baptiste 的回答和解决方案。
我想我可能找到了另一种使用 gtable 和网格的好方法：
data <- structure(list(item = c("Lorem ipsum dolor sit amet, consectetuer adipiscing elit.",
"Integer vitae libero ac risus egestas placerat.", "Fusce lobortis lorem at ipsum semper sagittis.",
"Donec quis dui at dolor tempor interdum.", "Vivamus molestie gravida turpis.",
"Nunc dignissim risus id metus.", "Praesent placerat risus quis eros.",
"Vestibulum commodo felis quis tortor."), VG = c(5, 6, 5, 3,
3, 5, 5, 5), MA = c(5.7, 5.9, 5.7, 5.7, 3.7, 5.7, 5.7, 5.7),
KO = c(3.3, 4.3, 3.7, 2.3, 3.3, 3.3, 3.3, 3.3), KU = c(5.8,
3.8, 2.8, 2.8, 3.8, 5.8, 5.8, 5.8), SE = c(6, 4, 4, 3.5,
3, 6, 6, 6), itemnummber = 1:8, prio = c("", "2X", "", "",
"4X", "1X", "", "")), .Names = c("item", "VG", "MA", "KO",
"KU", "SE", "itemnummber", "prio"), row.names = c(NA, -8L), spec =
structure(list(cols = structure(list(item = structure(list(), class = c("collector_character","collector")), VG = structure(list(), class = c("collector_double",
"collector")), MA = structure(list(), class = c("collector_double",
"collector")), KO = structure(list(), class = c("collector_double",
"collector")), KU = structure(list(), class = c("collector_double",
"collector")), SE = structure(list(), class = c("collector_number",
"collector"))), .Names = c("item", "VG", "MA", "KO", "KU",
"SE")), default = structure(list(), class = c("collector_guess",
"collector"))), .Names = c("cols", "default"), class = "col_spec"), class =
c("tbl_df",
"tbl", "data.frame"))
library(tidyr)
data_long <- gather(data, perspective, value, VG:SE, factor_key=TRUE)
library(ggplot2)
library(stringr)
library(grid)
library(gridExtra)
library(gtable)
scale.text <- c("not satisfied", "little satisfied", "satisfied", "50%
ok", "more than 50%", "sehr satisfied", " 100% satisfied")
diagram <- ggplot(data_long, aes(value, item, colour = perspective, fill =
perspective, group = perspective)) +
geom_point(size= 5,stroke = 0.1) +
scale_y_discrete(labels = function(x) str_wrap(x, width = 60)) +
scale_x_continuous(breaks = c(1:7), labels = scale.text, limits=c(1,
7),sec.axis = sec_axis(~ ., breaks = c(1:7), labels = c(1:7))) +
theme_minimal(base_size = 5) +
theme(
panel.grid.minor.x = element_blank(),
panel.grid.major.x =element_line(linetype="dotted",colour = "#b4c2cb",
size = 0.2),
legend.position="top",
plot.title = element_blank(),
axis.title.x = element_blank(),
axis.title.y = element_blank(),
legend.title = element_blank(),
axis.text.y = element_blank(),
axis.text.x=element_text(color = "black", size=8, angle=60, vjust=.8,
hjust=0.8),
axis.text.x.top = element_text(color = "black", size=8, angle=0,
vjust=.5, hjust=0.5)
)
# ITEMS
tt3 <- ttheme_minimal(
core=list(bg_params = list(fill = c("#DDDDDD", "#FFFFFF"), col=NA),
fg_params=list(fontface=3)),
base_size = 9,
colhead=list(fg_params=list(col="navyblue", fontface=1)),
rowhead=list(fg_params=list(col="orange", fontface=1)))
items <- tableGrob(str_wrap(data$item, width = 80),cols = " ", theme=tt3)
items$widths <- unit(rep(1, 1), "npc")
#items$heights <- unit(rep(1/nrow(data), nrow(data)), "null")
items$heights <- unit(c(0.03, rep(1/nrow(data) , nrow(data))), "npc")
# stats
stats <- tableGrob(data[,2:4], rows=NULL, theme=tt3)
stats$widths <- unit(rep(1/3,3), "npc")
stats$heights <- unit(c(0.03, rep(1/nrow(data) , nrow(data))), "npc")
separators <- replicate(ncol(stats), segmentsGrob(x1 = unit(0, "npc"),
gp=gpar(lty=4, col = "#8c8c8c")), simplify=FALSE)
stats <- gtable_add_grob(stats, grobs = separators,t = 1, b = nrow(stats), l = seq_len(ncol(stats)))
# itemnummber
itemnummber <- tableGrob(data$itemnummber,cols = "Nr.", rows=NULL,
theme=tt3)
itemnummber$widths <- unit(rep(1, 1), "npc")
itemnummber$heights <- unit(c(0.03, rep(1/nrow(data) , nrow(data))),"npc")
prioritaeten <- tableGrob(data$prio,cols = "Prio.", theme=tt3)
prioritaeten$widths <- unit(rep(1, 1), "npc")
#items$heights <- unit(rep(1/nrow(data), nrow(data)), "null")
prioritaeten$heights <- unit(c(0.03, rep(1/nrow(data) , nrow(data))),"npc")
separators <- replicate(ncol(prioritaeten),
segmentsGrob(x1 = unit(0, "npc"), gp=gpar(lty=4, col="#8c8c8c")),simplify=FALSE)
prioritaeten <- gtable_add_grob(prioritaeten, grobs = separators,
t = 1, b = nrow(prioritaeten), l = seq_len(ncol(prioritaeten)))
new.grob <- ggplotGrob(diagram)
new.grob <- gtable_add_cols(new.grob, unit(1, "cm"), pos = 0)
new.grob <- gtable_add_cols(new.grob, unit(12, "cm"), pos = 0)
new.grob <- gtable_add_cols(new.grob, unit(1, "cm"), pos = 0)
new.grob <- gtable_add_cols(new.grob, unit(2.5, "cm"), pos = -1)
new.grob <- gtable_add_grob(new.grob, itemnummber, t=8, l=1, b=8, r=1, name="itemnummber")
new.grob <- gtable_add_grob(new.grob, items, t=8, l=2, b=8, r=2, name="items")
new.grob <- gtable_add_grob(new.grob, prioritaeten, t=8, l=3, b=8, r=3, name="prioritaeten")
new.grob <- gtable_add_grob(new.grob, stats, t=8, l=11, b=8, r=11, name="stats")
separators <- replicate(ncol(new.grob),
segmentsGrob(x1 = unit(0, "npc"), gp=gpar(lty=4, col = "#8c8c8c")),
simplify=FALSE)
new.grob <- gtable_add_grob(new.grob, grobs = separators, t = 8, b = 8, l = 4)
grid.newpage()
grid.draw(new.grob)
但现在我的问题是如何为具有相同高度的绘图图形制作相同的背景 - gtable？
喜欢这个例子：
谢谢，
您可以将 table grobs 添加到 gtable,
library(gtable)
library(grid)
library(ggplot2)
tg <- tableGrob(iris[1:5,1:3], rows = NULL, cols=NULL)
tg$heights <- unit(rep(1,nrow(tg)), "null")
p <- qplot(1:5,1:5) + ggtitle("Title", subtitle = "another line") + theme_grey(12) +
scale_y_continuous(expand=c(0,0.5))
g <- ggplotGrob(p)
g <- gtable::gtable_add_cols(g, widths = sum(tg$widths), pos = 0)
g <- gtable::gtable_add_cols(g, widths = sum(tg$widths), pos = -1)
g <- gtable::gtable_add_grob(g, list(tg, tg), t = 6, l=c(1,ncol(g)), r=c(1, ncol(g)))
grid.newpage()
grid.draw(g)
我有一个 ggplot 图形，它有一个长文本作为 Y 轴。
我正在尝试找到一种方法来设置 Y 轴的背景颜色，使用两种不同的颜色 "zebra-theme" 就像这个
但是 element_text() 中似乎没有针对此的 ggplot 功能。
有人可以帮助我吗？
谢谢
特洛帕夏
破解主题系统可能是可行的，但这可能不是一个好主意。
library(grid)
element_custom <- function(...) {
structure(list(...), class = c("element_custom", "element_blank"))
}
element_grob.element_custom <- function(element, label, x, y, ...) {
tg <- textGrob(label, y=y, gp=gpar(col=element$colour))
padding <- unit(1,"line")
rg <- rectGrob(y=y,width=grobWidth(tg)+padding, height=unit(1,"line")+padding,
gp=gpar(fill = element$fill, col=NA, alpha=0.1))
gTree(children=gList(rg, tg), width=grobWidth(tg) + padding, cl="custom_axis")
}
widthDetails.custom_axis <- function(x) x$width + unit(2,"mm") # fudge
qplot(1:3,1:3) +
theme(axis.text.y = element_custom(colour = 1:2, fill=1:2))
感谢 baptiste 的回答和解决方案。
我想我可能找到了另一种使用 gtable 和网格的好方法：
data <- structure(list(item = c("Lorem ipsum dolor sit amet, consectetuer adipiscing elit.",
"Integer vitae libero ac risus egestas placerat.", "Fusce lobortis lorem at ipsum semper sagittis.",
"Donec quis dui at dolor tempor interdum.", "Vivamus molestie gravida turpis.",
"Nunc dignissim risus id metus.", "Praesent placerat risus quis eros.",
"Vestibulum commodo felis quis tortor."), VG = c(5, 6, 5, 3,
3, 5, 5, 5), MA = c(5.7, 5.9, 5.7, 5.7, 3.7, 5.7, 5.7, 5.7),
KO = c(3.3, 4.3, 3.7, 2.3, 3.3, 3.3, 3.3, 3.3), KU = c(5.8,
3.8, 2.8, 2.8, 3.8, 5.8, 5.8, 5.8), SE = c(6, 4, 4, 3.5,
3, 6, 6, 6), itemnummber = 1:8, prio = c("", "2X", "", "",
"4X", "1X", "", "")), .Names = c("item", "VG", "MA", "KO",
"KU", "SE", "itemnummber", "prio"), row.names = c(NA, -8L), spec =
structure(list(cols = structure(list(item = structure(list(), class = c("collector_character","collector")), VG = structure(list(), class = c("collector_double",
"collector")), MA = structure(list(), class = c("collector_double",
"collector")), KO = structure(list(), class = c("collector_double",
"collector")), KU = structure(list(), class = c("collector_double",
"collector")), SE = structure(list(), class = c("collector_number",
"collector"))), .Names = c("item", "VG", "MA", "KO", "KU",
"SE")), default = structure(list(), class = c("collector_guess",
"collector"))), .Names = c("cols", "default"), class = "col_spec"), class =
c("tbl_df",
"tbl", "data.frame"))
library(tidyr)
data_long <- gather(data, perspective, value, VG:SE, factor_key=TRUE)
library(ggplot2)
library(stringr)
library(grid)
library(gridExtra)
library(gtable)
scale.text <- c("not satisfied", "little satisfied", "satisfied", "50%
ok", "more than 50%", "sehr satisfied", " 100% satisfied")
diagram <- ggplot(data_long, aes(value, item, colour = perspective, fill =
perspective, group = perspective)) +
geom_point(size= 5,stroke = 0.1) +
scale_y_discrete(labels = function(x) str_wrap(x, width = 60)) +
scale_x_continuous(breaks = c(1:7), labels = scale.text, limits=c(1,
7),sec.axis = sec_axis(~ ., breaks = c(1:7), labels = c(1:7))) +
theme_minimal(base_size = 5) +
theme(
panel.grid.minor.x = element_blank(),
panel.grid.major.x =element_line(linetype="dotted",colour = "#b4c2cb",
size = 0.2),
legend.position="top",
plot.title = element_blank(),
axis.title.x = element_blank(),
axis.title.y = element_blank(),
legend.title = element_blank(),
axis.text.y = element_blank(),
axis.text.x=element_text(color = "black", size=8, angle=60, vjust=.8,
hjust=0.8),
axis.text.x.top = element_text(color = "black", size=8, angle=0,
vjust=.5, hjust=0.5)
)
# ITEMS
tt3 <- ttheme_minimal(
core=list(bg_params = list(fill = c("#DDDDDD", "#FFFFFF"), col=NA),
fg_params=list(fontface=3)),
base_size = 9,
colhead=list(fg_params=list(col="navyblue", fontface=1)),
rowhead=list(fg_params=list(col="orange", fontface=1)))
items <- tableGrob(str_wrap(data$item, width = 80),cols = " ", theme=tt3)
items$widths <- unit(rep(1, 1), "npc")
#items$heights <- unit(rep(1/nrow(data), nrow(data)), "null")
items$heights <- unit(c(0.03, rep(1/nrow(data) , nrow(data))), "npc")
# stats
stats <- tableGrob(data[,2:4], rows=NULL, theme=tt3)
stats$widths <- unit(rep(1/3,3), "npc")
stats$heights <- unit(c(0.03, rep(1/nrow(data) , nrow(data))), "npc")
separators <- replicate(ncol(stats), segmentsGrob(x1 = unit(0, "npc"),
gp=gpar(lty=4, col = "#8c8c8c")), simplify=FALSE)
stats <- gtable_add_grob(stats, grobs = separators,t = 1, b = nrow(stats), l = seq_len(ncol(stats)))
# itemnummber
itemnummber <- tableGrob(data$itemnummber,cols = "Nr.", rows=NULL,
theme=tt3)
itemnummber$widths <- unit(rep(1, 1), "npc")
itemnummber$heights <- unit(c(0.03, rep(1/nrow(data) , nrow(data))),"npc")
prioritaeten <- tableGrob(data$prio,cols = "Prio.", theme=tt3)
prioritaeten$widths <- unit(rep(1, 1), "npc")
#items$heights <- unit(rep(1/nrow(data), nrow(data)), "null")
prioritaeten$heights <- unit(c(0.03, rep(1/nrow(data) , nrow(data))),"npc")
separators <- replicate(ncol(prioritaeten),
segmentsGrob(x1 = unit(0, "npc"), gp=gpar(lty=4, col="#8c8c8c")),simplify=FALSE)
prioritaeten <- gtable_add_grob(prioritaeten, grobs = separators,
t = 1, b = nrow(prioritaeten), l = seq_len(ncol(prioritaeten)))
new.grob <- ggplotGrob(diagram)
new.grob <- gtable_add_cols(new.grob, unit(1, "cm"), pos = 0)
new.grob <- gtable_add_cols(new.grob, unit(12, "cm"), pos = 0)
new.grob <- gtable_add_cols(new.grob, unit(1, "cm"), pos = 0)
new.grob <- gtable_add_cols(new.grob, unit(2.5, "cm"), pos = -1)
new.grob <- gtable_add_grob(new.grob, itemnummber, t=8, l=1, b=8, r=1, name="itemnummber")
new.grob <- gtable_add_grob(new.grob, items, t=8, l=2, b=8, r=2, name="items")
new.grob <- gtable_add_grob(new.grob, prioritaeten, t=8, l=3, b=8, r=3, name="prioritaeten")
new.grob <- gtable_add_grob(new.grob, stats, t=8, l=11, b=8, r=11, name="stats")
separators <- replicate(ncol(new.grob),
segmentsGrob(x1 = unit(0, "npc"), gp=gpar(lty=4, col = "#8c8c8c")),
simplify=FALSE)
new.grob <- gtable_add_grob(new.grob, grobs = separators, t = 8, b = 8, l = 4)
grid.newpage()
grid.draw(new.grob)
但现在我的问题是如何为具有相同高度的绘图图形制作相同的背景 - gtable？
喜欢这个例子：
谢谢，
您可以将 table grobs 添加到 gtable,
library(gtable)
library(grid)
library(ggplot2)
tg <- tableGrob(iris[1:5,1:3], rows = NULL, cols=NULL)
tg$heights <- unit(rep(1,nrow(tg)), "null")
p <- qplot(1:5,1:5) + ggtitle("Title", subtitle = "another line") + theme_grey(12) +
scale_y_continuous(expand=c(0,0.5))
g <- ggplotGrob(p)
g <- gtable::gtable_add_cols(g, widths = sum(tg$widths), pos = 0)
g <- gtable::gtable_add_cols(g, widths = sum(tg$widths), pos = -1)
g <- gtable::gtable_add_grob(g, list(tg, tg), t = 6, l=c(1,ncol(g)), r=c(1, ncol(g)))
grid.newpage()
grid.draw(g)