Reputation: 15
using this code want to transform the plot
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 [-]")
Upvotes: 0
Views: 118
Reputation: 22044
I think this is close to what you're looking for:
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="")
EDIT:
Updated to include legend in each plot. Basically requires making 4 different plots and putting them together.
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)
EDIT 2: How to autmoate
To automate the construction of the graphs, you could write a function that makes the graph from the data, like below. The function takes the original raw data, the site to be graphed, the value of the blade (as the blade_val
argument), the value of the wtg
variable used to subset the data (as wtg_val
) and then left_lab
and right_lab
as arguments for whether the y-axis labels on the left and/or right should be printed.
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)
}
Next, you could find the values of the blades to plot
blades <- ab %>%
filter(site == "BUCHHAINER_HEIDE" & wtg == 83363) %>%
select(blade) %>%
distinct %>%
pull
Then, you could initialize a list that will hold the graphs:
glist <- list()
Next, loop over all of the values in blades
, each time making a new graph and storing it in the list.
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)))
}
We add the nrow
argument to the list to make sure the graphs are plotted in a single row.
glist[["nrow"]] <- 1
Finally, we call grid.arrange()
on the glist
list and that should produce the graph that adapts to the different numbers of blades per site.
do.call(gridExtra::grid.arrange, glist)
Upvotes: 3