r - 我想把这个情节改成这个
问题描述
使用此代码想要转换情节
ggplot(melteddata,aes(x=date, y=value, fill=variable)) +
geom_col(width=0.3,position = position_nudge(x=-0.2))+theme(legend.position="top")+ggtitle("wtg83363")+
geom_col(melteddata2,mapping = aes(x=date,y=value,fill=variable),width=0.3,position = position_nudge(x=+0.2))+theme(legend.position="top")+scale_fill_manual(values=pal)+facet_wrap(~blade, scales="free_x", nrow=1)+labs(x="UT Scan Date", y="Wedge Delamination Count [-]")
解决方案
我认为这与您正在寻找的内容很接近：
library(dplyr)
library(reshape2)
data=ab%>%filter(site=="BUCHHAINER_HEIDE")
data2 = data[data$wtg==83363,]
melteddata2 = melt(data2, measure.vars = c("bushingdam", "bushing_all_critical"))
melteddata=melt(data2,measure.vars=c("wedgedam_e"))
melteddata3=melt(data2,measure.vars=c("wedgedam_i"))
melteddata2a <- melteddata2 %>%
filter(variable == "bushingdam")
melteddata2b <- melteddata2 %>%
filter(variable == "bushing_all_critical")
melteddata <- melteddata %>%
mutate(blade = factor(blade, levels=c("927", "928", "925", "922")))
h1 <- max(c(melteddata$value, melteddata3$value))
h2 <- max(melteddata2$value)
rat <- h1/h2
melteddata2 <- melteddata2 %>%
mutate(plot_value = value*rat)
melteddata3 <- melteddata3 %>%
mutate(plot_text = ifelse(value == 0, "", value))
pal <- RColorBrewer::brewer.pal(4, "Dark2")
ggplot(melteddata,aes(x=date, y=value, fill=variable)) +
geom_bar(stat='identity',
position = position_nudge(x=-0.2),
width=.15)+
geom_bar(melteddata2,
mapping = aes(x=date,y=plot_value,fill=variable),
stat="identity",
position = position_nudge(x=+0.2),
width=.15)+
geom_bar(melteddata3,
mapping = aes(x=date,y=value,fill=variable),
stat="identity",
width=.15)+
scale_fill_manual(values=pal, labels=c("Bushing", "Critical Bushing", "Wedge E", "Wedge I")) +
facet_wrap(~melteddata$blade, scales="free_x", nrow=1) +
theme(legend.position="top",
axis.text.x = element_text(angle=30, hjust=1))+
scale_y_continuous(sec.axis = sec_axis(trans = function(x)x/rat,
breaks=c(200, 400, 600, 800),
name="Bushing Delamination Count [-]")) +
ggtitle("wtg83363") +
geom_text(data=melteddata3, aes(x=date, y=value, label=plot_text),
position=position_nudge(y=7),
size=3, col=pal[4]) +
geom_text(data=melteddata, aes(x=date, y=value, label=value),
position=position_nudge(y=7, x=-.2),
size=3, col=pal[3]) +
geom_text(data=melteddata2a, aes(x=date, y=value*rat, label=value),
position=position_nudge(y=7, x=.2),
size=3, col=pal[2]) +
geom_text(data=melteddata2b, aes(x=date, y=value*rat, label=value),
position=position_nudge(y=7, x=.2),
size=3, col=pal[1]) +
labs(x="UT Scan Date", y="Wedge Delamination Count [-]", fill="")
编辑：
更新为在每个图中包含图例。基本上需要制作 4 个不同的地块并将它们放在一起。
library(dplyr)
library(reshape2)
data=ab%>%filter(site=="BUCHHAINER_HEIDE")
data2 = data[data$wtg==83363,]
melteddata2 = melt(data2, measure.vars = c("bushingdam", "bushing_all_critical"))
melteddata=melt(data2,measure.vars=c("wedgedam_e"))
melteddata3=melt(data2,measure.vars=c("wedgedam_i"))
melteddata2a <- melteddata2 %>%
filter(variable == "bushingdam")
melteddata2b <- melteddata2 %>%
filter(variable == "bushing_all_critical")
melteddata <- melteddata %>%
mutate(blade = factor(blade, levels=c("927", "928", "925", "922")))
h1 <- max(c(melteddata$value, melteddata3$value))
h2 <- max(melteddata2$value)
rat <- h1/h2
melteddata2 <- melteddata2 %>%
mutate(plot_value = value*rat)
melteddata3 <- melteddata3 %>%
mutate(plot_text = ifelse(value == 0, "", value))
pal <- RColorBrewer::brewer.pal(4, "Dark2")
m_927 <- melteddata %>% filter(blade == "927")
m2_927 <- melteddata2 %>% filter(blade == "927")
m2a_927 <- melteddata2a %>% filter(blade == "927")
m2b_927 <- melteddata2b %>% filter(blade == "927")
m3_927 <- melteddata3 %>% filter(blade == "927")
g927 <- ggplot(m_927, aes(x=date, y=value, fill=variable)) +
geom_bar(stat='identity',
position = position_nudge(x=-0.2),
width=.15)+
geom_bar(m2_927,
mapping = aes(x=date,y=plot_value,fill=variable),
stat="identity",
position = position_nudge(x=+0.2),
width=.15)+
geom_bar(m3_927,
mapping = aes(x=date,y=value,fill=variable),
stat="identity",
width=.15)+
scale_fill_manual(values=pal,
labels=c("Bushing", "Critical Bushing", "Wedge E", "Wedge I")) +
facet_wrap(~blade, scales="free_x", nrow=1) +
theme(legend.background = element_blank(),
legend.position=c(.5, .95),
legend.key.size = unit(0.35, "cm"),
legend.text = element_text(size=7.5),
axis.text.x = element_text(angle=30, hjust=1))+
scale_y_continuous(sec.axis = sec_axis(trans = function(x)x/rat,
breaks=c(200, 400, 600, 800),
name="")) +
expand_limits(y=c(0,475)) +
geom_text(data=m3_927, aes(x=date, y=value, label=plot_text),
position=position_nudge(y=7),
size=3, col=pal[4]) +
geom_text(data=m_927, aes(x=date, y=value, label=value),
position=position_nudge(y=7, x=-.2),
size=3, col=pal[3]) +
geom_text(data=m2a_927, aes(x=date, y=value*rat, label=value),
position=position_nudge(y=7, x=.2),
size=3, col=pal[2]) +
geom_text(data=m2a_927, aes(x=date, y=value*rat, label=value),
position=position_nudge(y=7, x=.2),
size=3, col=pal[1]) +
guides(fill=guide_legend(ncol=2)) +
labs(x="UT Scan Date", y="Wedge Delamination Count [-]", fill="")
m_928 <- melteddata %>% filter(blade == "928")
m2_928 <- melteddata2 %>% filter(blade == "928")
m2a_928 <- melteddata2a %>% filter(blade == "928")
m2b_928 <- melteddata2b %>% filter(blade == "928")
m3_928 <- melteddata3 %>% filter(blade == "928")
g928 <- ggplot(m_928, aes(x=date, y=value, fill=variable)) +
geom_bar(stat='identity',
position = position_nudge(x=-0.2),
width=.15)+
geom_bar(m2_928,
mapping = aes(x=date,y=plot_value,fill=variable),
stat="identity",
position = position_nudge(x=+0.2),
width=.15)+
geom_bar(m3_928,
mapping = aes(x=date,y=value,fill=variable),
stat="identity",
width=.15)+
scale_fill_manual(values=pal,
labels=c("Bushing", "Critical Bushing", "Wedge E", "Wedge I")) +
facet_wrap(~blade, scales="free_x", nrow=1) +
theme(legend.background = element_blank(),
legend.position=c(.5, .95),
legend.key.size = unit(0.35, "cm"),
legend.text = element_text(size=7.5),
axis.text.x = element_text(angle=30, hjust=1))+
scale_y_continuous(sec.axis = sec_axis(trans = function(x)x/rat,
breaks=c(200, 400, 600, 800),
name="")) +
expand_limits(y=c(0,475)) +
geom_text(data=m3_928, aes(x=date, y=value, label=plot_text),
position=position_nudge(y=7),
size=3, col=pal[4]) +
geom_text(data=m_928, aes(x=date, y=value, label=value),
position=position_nudge(y=7, x=-.2),
size=3, col=pal[3]) +
geom_text(data=m2a_928, aes(x=date, y=value*rat, label=value),
position=position_nudge(y=7, x=.2),
size=3, col=pal[2]) +
geom_text(data=m2a_928, aes(x=date, y=value*rat, label=value),
position=position_nudge(y=7, x=.2),
size=3, col=pal[1]) +
guides(fill=guide_legend(ncol=2)) +
labs(x="UT Scan Date", y="", fill="")
m_925 <- melteddata %>% filter(blade == "925")
m2_925 <- melteddata2 %>% filter(blade == "925")
m2a_925 <- melteddata2a %>% filter(blade == "925")
m2b_925 <- melteddata2b %>% filter(blade == "925")
m3_925 <- melteddata3 %>% filter(blade == "925")
g925 <- ggplot(m_925, aes(x=date, y=value, fill=variable)) +
geom_bar(stat='identity',
position = position_nudge(x=-0.2),
width=.15)+
geom_bar(m2_925,
mapping = aes(x=date,y=plot_value,fill=variable),
stat="identity",
position = position_nudge(x=+0.2),
width=.15)+
geom_bar(m3_925,
mapping = aes(x=date,y=value,fill=variable),
stat="identity",
width=.15)+
scale_fill_manual(values=pal,
labels=c("Bushing", "Critical Bushing", "Wedge E", "Wedge I")) +
facet_wrap(~blade, scales="free_x", nrow=1) +
theme(legend.background = element_blank(),
legend.position=c(.5, .95),
legend.key.size = unit(0.35, "cm"),
legend.text = element_text(size=7.5),
axis.text.x = element_text(angle=30, hjust=1))+
scale_y_continuous(sec.axis = sec_axis(trans = function(x)x/rat,
breaks=c(200, 400, 600, 800),
name="")) +
expand_limits(y=c(0,475)) +
geom_text(data=m3_925, aes(x=date, y=value, label=plot_text),
position=position_nudge(y=7),
size=3, col=pal[4]) +
geom_text(data=m_925, aes(x=date, y=value, label=value),
position=position_nudge(y=7, x=-.2),
size=3, col=pal[3]) +
geom_text(data=m2a_925, aes(x=date, y=value*rat, label=value),
position=position_nudge(y=7, x=.2),
size=3, col=pal[2]) +
geom_text(data=m2a_925, aes(x=date, y=value*rat, label=value),
position=position_nudge(y=7, x=.2),
size=3, col=pal[1]) +
guides(fill=guide_legend(ncol=2)) +
labs(x="UT Scan Date", y="", fill="")
m_922 <- melteddata %>% filter(blade == "922")
m2_922 <- melteddata2 %>% filter(blade == "922")
m2a_922 <- melteddata2a %>% filter(blade == "922")
m2b_922 <- melteddata2b %>% filter(blade == "922")
m3_922 <- melteddata3 %>% filter(blade == "922")
g922 <- ggplot(m_922, aes(x=date, y=value, fill=variable)) +
geom_bar(stat='identity',
position = position_nudge(x=-0.2),
width=.15)+
geom_bar(m2_922,
mapping = aes(x=date,y=plot_value,fill=variable),
stat="identity",
position = position_nudge(x=+0.2),
width=.15)+
geom_bar(m3_922,
mapping = aes(x=date,y=value,fill=variable),
stat="identity",
width=.15)+
scale_fill_manual(values=pal,
labels=c("Bushing", "Critical Bushing", "Wedge E", "Wedge I")) +
facet_wrap(~blade, scales="free_x", nrow=1) +
theme(legend.background = element_blank(),
legend.position=c(.5, .95),
legend.key.size = unit(0.35, "cm"),
legend.text = element_text(size=7.5),
axis.text.x = element_text(angle=30, hjust=1))+
scale_y_continuous(sec.axis = sec_axis(trans = function(x)x/rat,
breaks=c(200, 400, 600, 800),
name="Bushing Delamination Count [-]")) +
expand_limits(y=c(0,475)) +
geom_text(data=m3_922, aes(x=date, y=value, label=plot_text),
position=position_nudge(y=7),
size=3, col=pal[4]) +
geom_text(data=m_922, aes(x=date, y=value, label=value),
position=position_nudge(y=7, x=-.2),
size=3, col=pal[3]) +
geom_text(data=m2a_922, aes(x=date, y=value*rat, label=value),
position=position_nudge(y=7, x=.2),
size=3, col=pal[2]) +
geom_text(data=m2a_922, aes(x=date, y=value*rat, label=value),
position=position_nudge(y=7, x=.2),
size=3, col=pal[1]) +
guides(fill=guide_legend(ncol=2)) +
labs(x="UT Scan Date", y="", fill="")
gridExtra::grid.arrange(g927, g928, g925, g922, nrow=1)
编辑 2：如何自动化
要自动构建图表，您可以编写一个从数据生成图表的函数，如下所示。该函数将原始原始数据、要绘制的站点、刀片的值（作为blade_val参数）、wtg用于子集数据的变量的值（作为wtg_val）以及left_labyright_lab轴标签是否作为参数在左侧和/或右侧应打印。
make_graph <- function(data, site, blade_val, wtg_val=83363, left_lab=TRUE, right_lab=TRUE){
ll <- ifelse(left_lab, "Wedge Delimation Count [-]", "")
rl <- ifelse(right_lab, "Bushing Delamination Count [-]", "")
require(dplyr)
require(reshape2)
data=data%>%filter(site==site)
data2 = data[data$wtg==wtg_val,]
melteddata2 = melt(data2, measure.vars = c("bushingdam", "bushing_all_critical"))
melteddata=melt(data2,measure.vars=c("wedgedam_e"))
melteddata3=melt(data2,measure.vars=c("wedgedam_i"))
melteddata2a <- melteddata2 %>%
filter(variable == "bushingdam")
melteddata2b <- melteddata2 %>%
filter(variable == "bushing_all_critical")
melteddata <- melteddata %>%
mutate(blade = factor(blade, levels=c("927", "928", "925", "922")))
h1 <- max(c(melteddata$value, melteddata3$value))
h2 <- max(melteddata2$value)
rat <- h1/h2
melteddata2 <- melteddata2 %>%
mutate(plot_value = value*rat)
melteddata3 <- melteddata3 %>%
mutate(plot_text = ifelse(value == 0, "", value))
pal <- RColorBrewer::brewer.pal(4, "Dark2")
m <- melteddata %>% filter(blade == blade_val)
m2 <- melteddata2 %>% filter(blade == blade_val)
m2a <- melteddata2a %>% filter(blade == blade_val)
m2b <- melteddata2b %>% filter(blade == blade_val)
m3 <- melteddata3 %>% filter(blade == blade_val)
g <- ggplot(m, aes(x=date, y=value, fill=variable)) +
geom_bar(stat='identity',
position = position_nudge(x=-0.2),
width=.15)+
geom_bar(m2,
mapping = aes(x=date,y=plot_value,fill=variable),
stat="identity",
position = position_nudge(x=+0.2),
width=.15)+
geom_bar(m3,
mapping = aes(x=date,y=value,fill=variable),
stat="identity",
width=.15)+
scale_fill_manual(values=pal,
labels=c("Bushing", "Critical Bushing", "Wedge E", "Wedge I")) +
facet_wrap(~blade, scales="free_x", nrow=1) +
theme(legend.background = element_blank(),
legend.position=c(.5, .95),
legend.key.size = unit(0.35, "cm"),
legend.text = element_text(size=7.5),
axis.text.x = element_text(angle=30, hjust=1))+
scale_y_continuous(sec.axis = sec_axis(trans = function(x)x/rat,
breaks=c(200, 400, 600, 800),
name=rl)) +
expand_limits(y=c(0,475)) +
geom_text(data=m3, aes(x=date, y=value, label=plot_text),
position=position_nudge(y=7),
size=3, col=pal[4]) +
geom_text(data=m, aes(x=date, y=value, label=value),
position=position_nudge(y=7, x=-.2),
size=3, col=pal[3]) +
geom_text(data=m2a, aes(x=date, y=value*rat, label=value),
position=position_nudge(y=7, x=.2),
size=3, col=pal[2]) +
geom_text(data=m2b, aes(x=date, y=value*rat, label=value),
position=position_nudge(y=7, x=.2),
size=3, col=pal[1]) +
guides(fill=guide_legend(ncol=2)) +
labs(x="UT Scan Date", y=ll, fill="")
return(g)
}
接下来，您可以找到要绘制的刀片的值
blades <- ab %>%
filter(site == "BUCHHAINER_HEIDE" & wtg == 83363) %>%
select(blade) %>%
distinct %>%
pull
然后，您可以初始化一个包含图表的列表：
glist <- list()
接下来，遍历 中的所有值blades，每次创建一个新图形并将其存储在列表中。
for(i in 1:length(blades)){
glist[[i]] <- make_graph(ab,
site="BUCHHAINER_HEIDE",
blade_val=blades[i],
wtg_val=83363,
left_lab = (i == 1),
right_lab = (i == length(blades)))
}
我们将nrow参数添加到列表中以确保图形绘制在单行中。
glist[["nrow"]] <- 1
最后，我们调用列表，这应该会生成适应每个站点不同数量的刀片的图表grid.arrange()。glist
do.call(gridExtra::grid.arrange, glist)
推荐阅读
- plot - Mathematica 11.3 输出 pdf 绘图的字体粗细
- php - 运行 composer install 命令时出错
- javascript - Nightwatch.js 功能未“关闭”
- java - 无法从 selenium java 中的烤消息中获取文本
- android - Flutter WebView 与代理
- mysql - 通过从以前的记录中复制数据来插入缺失的记录
- excel - Excel 在特定列中运行缓慢
- python - Virtualenv Wrapper 正在虚拟环境中安装两个 python 版本
- firebase - 如何在安全规则中检测 Firestore 文档中是否存在字段
- elasticsearch - 字段名称中带有通配符的 Elasticsearch 范围查询