Related
I am trying to adapt the approach from (ggplot2 multiple sub groups of a bar chart) but something is not as it should be.
The code is:
library(grid)
MethodA= rep(c("ARIMA"), 6)
MethodB=rep(c("LSTM"), 6)
MethodC = rep(c("ARIMA-LSTM"),6)
MethodD=rep(c("SSA"),6)
Method=c(MethodA, MethodB, MethodC, MethodD)
Measure = rep(c("RMSE", "RMSE", "MAE", "MAE", "MAPE", "MAPE"), 4)
trtest=rep(c("train", "test"), 12)
Value=sample(x = 4000:7000, size = 24, replace = TRUE)
df2 <- data.frame(Method, Measure, trtest, Value)
dodge <- position_dodge(width = 0.9)
g1 <- ggplot(data = df, aes(x = interaction(Variety, Trt), y = yield, fill = factor(geno))) +
geom_bar(stat = "identity", position = position_dodge()) +
#geom_errorbar(aes(ymax = yield + SE, ymin = yield - SE), position = dodge, width = 0.2) +
coord_cartesian(ylim = c(0, 7500)) +
annotate("text", x = 1:6, y = - 10,
label = rep(c("Variety 1", "Variety 2", "Variety 3"), 2)) +
annotate("text", c(1.5, 3.5), y = - 20, label = c("Irrigated", "Dry")) +
theme_classic() +
theme(plot.margin = unit(c(1, 1, 4, 1), "lines"),
axis.title.x = element_blank(),
axis.text.x = element_blank())
# remove clipping of x axis labels
g2 <- ggplot_gtable(ggplot_build(g1))
g2$layout$clip[g2$layout$name == "panel"] <- "off"
grid.draw(g2)
The problem is aslo in a sequence that interaction function generates - the sequences are not by the order - ARIMA - RMSE, MAE, MAPE, then LSTM - RMSE, MAE, MAPE ...
I would appreciate for any help.
Best,
Nikola
Instead of using interaction, it might be a lot clearer if you use facets.
Note that your example is not reproducible (your sample data has different variable names from the ones you use in your plotting code, so I had to guess which you meant to substitute):
ggplot(data = df2, aes(x = Measure, y = Value, fill = trtest)) +
geom_bar(stat = "identity", position = position_dodge()) +
coord_cartesian(ylim = c(0, 7500)) +
facet_grid(.~Method, switch = 'x') +
theme_classic() +
theme(strip.placement = 'outside',
strip.background = element_blank(),
strip.text = element_text(face = 'bold', size = 16),
panel.spacing.x = unit(0, 'mm'),
panel.border = element_rect(fill = NA, color = 'gray'))
So, I have the two dataframes that produces two ggplots with the same facet that I want to combine
The first dataframe produces the following ggplot
Dataframe1
library(ggh4x)
library(ggnomics)
library(ggplot2)
library(data.table)
#dataframe
drug <- c("DrugA","DrugB1","DrugB2","DrugB3","DrugC1","DrugC2","DrugC3","DrugC4")
PR <- c(18,430,156,0,60,66,113,250)
GR <- c(16,425,154,0,56,64,111,248)
PS <- c(28,530,256,3,70,76,213,350)
GS <- c(26,525,254,5,66,74,211,348)
group<-c("n=88","n=1910","n=820","n=8","n=252","n=280","n=648","n=1186")
class<-c("Class A","Class B","Class B","Class B","Class C","Class C","Class C","Class C")
df <-data.frame(drug,group, class,PR,GR,PS,GS)
#make wide to long df
df.long <- melt(setDT(df), id.vars = c("drug","group","class"), variable.name = "type")
#Order of variables
df.long$type <- factor(df.long$type, levels=c("PR","GR","PS","GS"))
df.long$class <- factor(df.long$class, levels= c("Class B", "Class A", "Class C"))
df.long$group <- factor(df.long$group, levels= c("n=1910","n=820","n=8","n=88","n=252","n=280","n=648","n=1186"))
df.long$drug <- factor(df.long$drug, levels= c("DrugB1","DrugB2","DrugB3","DrugA","DrugC1","DrugC2","DrugC3","DrugC4"))
Ggplot for dataframe 1
ggplot(df.long, aes(fill = type, x = drug, y = value)) +
geom_bar(aes(fill = type), stat = "identity", position = "dodge", colour="white") +
geom_text(aes(label = value), position = position_dodge(width = 1.2), vjust = -0.5)+
scale_fill_manual(values = c("#fa9fb5","#dd1c77","#bcbddc","756bb1")) +
scale_y_continuous(expand = c(0, 0), limits = c(0, 600)) +
theme(title = element_text(size = 18),
legend.text = element_text(size = 12),
axis.text.x = element_text(size = 9),
axis.text.y =element_text(size = 15),
plot.title = element_text(hjust = 0.5)) +
ggh4x::facet_nested(.~class + group, scales = "free_x", space= "free_x")
This is the 2nd dataframe
#dataframe 2
drug <- c("DrugA","DrugB1","DrugB2","DrugB3","DrugC1","DrugC2","DrugC3","DrugC4")
Sens <- c(0.99,0.97,NA,0.88,0.92,0.97,0.98,0.99)
Spec <- c(1,0.99,1,0.99,0.99,0.99,0.99,1)
class<-c("Class A","Class B","Class B","Class B","Class C","Class C","Class C","Class C")
df2 <-data.frame(drug,class,Sens,Spec)
#wide to long df2
df2.long <- melt(setDT(df2), id.vars = c("drug","class"), variable.name = "type")
#additional variables
df2.long$UpperCI <- c(0.99,0.99,NA,0.98,0.98,0.99,0.99,0.99,1,1,1,1,1,1,1,1)
df2.long$LowerCI <- c(0.97,0.98,NA,0.61,0.83,0.88,0.93,0.97,0.99,0.99,0.99,0.99,0.98,0.99,0.99,0.99)
#order of variables
df2.long$class <- factor(df2.long$class, levels= c("Class B", "Class A", "Class C"))
Ggplot for dataframe 2
ggplot(df2.long, aes(x=drug, y=value, group=type, color=type)) +
geom_line() +
geom_point()+
geom_errorbar(aes(ymin=LowerCI, ymax=UpperCI), width=.2,
position=position_dodge(0.05)) +
scale_y_continuous(labels=scales::percent)+
labs(x="drug", y = "Percentage")+
theme_classic() +
scale_color_manual(values=c('#999999','#E69F00')) +
theme(legend.text=element_text(size=12),
axis.text.x=element_text(size=9),
axis.text.y =element_text(size=15),
panel.background = element_rect(fill = "whitesmoke"))+
facet_wrap(facets = vars(class),scales = "free_x")
So I am trying to combine the two plots under the one facet (the one from dataframe 1), and so far I have done the following
ggplot(df.long)+
aes(x=drug, y=value,fill = type)+
geom_bar(, stat = "identity", position = "dodge", colour="white") +
geom_text(aes(label=value), position=position_dodge(width=0.9), vjust=-0.5, size=2) +
scale_fill_manual(breaks=c("PR","GR","PS","GS"),
values=c("#dd1c77","#756bb1","#fa9fb5","#e7e1ef","black","black")) +
scale_y_continuous(expand = c(0, 0), limits = c(0, 1100),sec.axis=sec_axis(~./10, labels = function(b) { paste0(b, "%")},name="Percentage")) + #remove space between x axis labels and bottom of chart
theme(legend.text=element_text(size=12),
legend.position = 'bottom',
axis.text.x=element_text(size=9),
axis.text.y =element_text(size=15),
panel.background = element_rect(fill = "whitesmoke"), #color of plot background
panel.border = element_blank(), #remove border panels of each facet
strip.background = element_rect(colour = NA)) + #remove border of strip
labs(y = "Number of isolates", fill = "")+
geom_errorbar(data=df2.long,aes(x=drug, y=value*1000,ymin=LowerCI*1000, ymax=UpperCI*1000,color=type), width=.2,
position=position_dodge(0.05))+
geom_point(data=df2.long,aes(x=drug,y=value*1000,color=type),show.legend = F)+
geom_line(data=df2.long, aes(x=drug, y=value*1000, group=type, color=type)) +
scale_color_manual(values=c('#999999','#E69F00'))
but I'm stuck on adding the facet from the plot1. I hope anyone can help :)
For this specific case, I don't think the nested facets are the appropriate solution as the n = ... seems metadata of the x-axis group instead of a subcategory of the classes.
Here is how you could plot the data with facet_grid() instead:
ggplot(df.long, aes(drug, value, fill = type)) +
geom_col(position = "dodge") +
geom_text(aes(label = value),
position = position_dodge(0.9),
vjust = -0.5, size = 2) +
geom_errorbar(data = df2.long,
aes(y = value * 1000, color = type,
ymin = LowerCI * 1000, ymax = UpperCI * 1000),
position = position_dodge(0.05), width = 0.2) +
geom_point(data = df2.long,
aes(y = value * 1000, color = type),
show.legend = FALSE) +
geom_line(data = df2.long,
aes(y = value * 1000, group = type, color = type)) +
scale_fill_manual(breaks = c("PR", "GR", "PS", "GS"),
values=c("#dd1c77","#756bb1","#fa9fb5","#e7e1ef","black","black")) +
scale_color_manual(values=c('#999999','#E69F00')) +
scale_y_continuous(expand = c(0, 0), limits = c(0, 1100),
sec.axis = sec_axis(~ ./10,
labels = function(b) {
paste0(b, "%")
}, name = "Percentage")) +
scale_x_discrete(
labels = levels(interaction(df.long$drug, df.long$group, sep = "\n"))
) +
facet_grid(~ class, scales = "free_x", space = "free_x") +
theme(legend.text=element_text(size=12),
legend.position = 'bottom',
axis.text.x=element_text(size=9),
axis.text.y =element_text(size=15),
panel.background = element_rect(fill = "whitesmoke"), #color of plot background
panel.border = element_blank(), #remove border panels of each facet
strip.background = element_rect(colour = NA))
If you insist on including the n = ... labels, perhaps a better way is to add these as text somehwere, i.e. adding the following:
stat_summary(fun = sum,
aes(group = drug, y = stage(value, after_stat = -50),
label = after_stat(paste0("n = ", y))),
geom = "text") +
And setting the y-axis limits to c(-100, 1000) for example.
I am having trouble adding R2 annotations to a faceted plot, where my R2 values are sometimes <0.01 (yes, it's not a good regression). I would like the 2 of R2 to be superscript.
I have tried several options but seem to be stymied by the < symbol in my values
eg, using the iris data set, I first set up a new data frame with my R2 values previously calculated. The x & y positions are also set up as these are different for every facet (not essential for the iris dataset, but it is for mine)
SEr2s <- data.frame(Species = c("virginica", "setosa", "versicolor" ),
xpos = c(5,7,7), ypos = c(4.2, 2, 4.2),
lab = c("<0.01","0.08", "0.05"))
Then I run my plot:
XYPlot<-ggplot(data = iris, aes(x=Sepal.Length)) +
geom_point(aes(y = Sepal.Width), colour="grey40")+
geom_smooth(aes(y = Sepal.Width), col="grey40", lwd=0.5, method="lm", se=FALSE) +
geom_text(data = SEr2s, size=3, vjust=0, hjust=0,
aes(x = xpos, y = ypos,
label = paste("r^2==",lab)), parse = TRUE)+
theme_bw() +
theme(strip.background = element_blank(), strip.placement = "outside",
panel.grid.minor = element_blank(), legend.position = "right") +
facet_wrap(~Species)
I get this error:
Error in parse(text = text[[i]]) : :1:7: unexpected '<'
1: r^2== <
^
Is there a way to change my code or my labelling dataframe so that it doesn't try to evaluate these symbols?
You can avoid plotmath if you're using the ggtext package instead, which can handle basic HTML/markdown as input.
library(ggplot2)
library(ggtext)
SEr2s <- data.frame(Species = c("virginica", "setosa", "versicolor" ),
xpos = c(5,7,7), ypos = c(4.2, 2, 4.2),
lab = c("<0.01","0.08", "0.05"))
ggplot(data = iris, aes(x=Sepal.Length)) +
geom_point(aes(y = Sepal.Width), colour="grey40")+
geom_smooth(aes(y = Sepal.Width), col="grey40", lwd=0.5, method="lm", se=FALSE) +
geom_richtext(
data = SEr2s, size=3, vjust=0, hjust=0,
aes(x = xpos, y = ypos, label = paste0("r<sup>2</sup> = ", lab))
) +
theme_bw() +
theme(
strip.background = element_blank(), strip.placement = "outside",
panel.grid.minor = element_blank(), legend.position = "right") +
facet_wrap(~Species)
#> `geom_smooth()` using formula 'y ~ x'
Created on 2019-12-02 by the reprex package (v0.3.0)
I think that the easier solution is to define the subscript in your data.frame (SEr2s):
SEr2s <- data.frame(Species = c("virginica", "setosa", "versicolor" ),
xpos = c(5,7,7), ypos = c(4.2, 2, 4.2),
lab = c("atop(R^2<0.01)","atop(R^2==0.08)", "atop(R^2==0.05)"))
Then, you can call ggplot without just with label=lab:
ggplot(data = iris, aes(x=Sepal.Length)) +
geom_point(aes(y = Sepal.Width), colour="grey40")+
geom_smooth(aes(y = Sepal.Width), col="grey40", lwd=0.5, method="lm", se=FALSE) +
geom_text(data = SEr2s, size=3, vjust=0, hjust=0,
aes(x = xpos, y = ypos,
label = lab), parse = TRUE)+
theme_bw() +
theme(strip.background = element_blank(), strip.placement = "outside",
panel.grid.minor = element_blank(), legend.position = "right") +
facet_wrap(~Species)
I think this gives you the plot you want:
https://ibb.co/vwbvqp2
I have an input file file1.txt:
V1 V2 Score
rs4939134 SIFT 1
rs4939134 Polyphen2 0
rs4939134 MutationAssessor -1.75
rs151252290 SIFT 0.101
rs151252290 Polyphen2 0.128
rs151252290 MutationAssessor 1.735
rs12364724 SIFT 0
rs12364724 Polyphen2 0.926
rs12364724 MutationAssessor 1.75
rs34448143 SIFT 0.005
rs34448143 Polyphen2 0.194
rs34448143 MutationAssessor 0.205
rs115694714 SIFT 0.007
rs115694714 Polyphen2 1
rs115694714 MutationAssessor 0.895
And this is my R code to plot this table as a heatmap:
library(ggplot2)
mydata <- read.table("file7.txt", header = FALSE, sep = "\t")
names(mydata) <- c("V1", "V2", "Score")
ggplot(data = mydata, aes(x = V1, y = V2, fill = Score)) +
geom_tile() +
geom_text(aes(V1, V2, label = Score), color = "black", size = 3) +
scale_fill_continuous(type = "viridis", limits = c(-5.76, 5.37)) +
labs(x = "pic1", y = "") +
theme_bw()
theme(panel.border = element_rect(colour = "black"),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
axis.line = element_line(colour = "black"),
axis.text = element_text(size = 4))
And this the plot I got:
what I need is for each row (each type in V2) I need to put a legend that represented, so at the end there will be 3 legends, each represent (one for SIFT, second for Polyphen and the third for MutationAssessor) with different range that I can specify.
for example: SIFT from (0,1)
and Polyphen from (0,1)
and MutationAssessor from (-6,6)
I tried different thing of previous asked questions but nothing work with me.
I appreciate any help.
You can loop over three given variables and plot different plots for each of them. In the end you have to combine them.
Create dataset with wanted limits:
myLimits <- list(
list("SIFT", 0, 1),
list("Polyphen2", 0, 1),
list("MutationAssessor", -6, 6)
)
Function to plot heatmap only for one variable at a time:
plotHeat <- function(type, MIN, MAX) {
library(ggplot2)
p <- ggplot(subset(mydata, V2 == type),
aes(V1, V2, fill = Score, label = Score)) +
geom_tile() +
geom_text(color = "black", size = 3) +
scale_fill_continuous(type = "viridis", limits = c(MIN, MAX)) +
labs(x = "SNP",
y = NULL,
fill = type) +
theme_bw()
# Output x-axis only for the last plot
if (type != myLimits[[length(myLimits)]][[1]]) {
p <- p + theme(axis.text.x = element_blank(),
axis.title.x = element_blank(),
axis.line.x = element_blank(),
axis.ticks.x = element_blank())
}
return(p)
}
Plot and combine plots using egg package:
res <- lapply(myLimits, function(x) {plotHeat(x[[1]], x[[2]], x[[3]])})
egg::ggarrange(plots = res)
This is maybe related to this.
xs <- split(mydata, f = mydata$V2)
p1 <- ggplot(data = xs$MutationAssessor, aes(x = V1, y = 0, fill = Score)) +
geom_tile() +
geom_text(aes(label = Score), color = "black", size = 3) +
scale_fill_continuous(type = "viridis", limits = c(-5.76, 5.37)) +
labs(x = "pic1", y = "") +
facet_grid(V2 ~ .) +
theme_bw() +
theme(panel.border = element_rect(colour = "black"),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
axis.line = element_line(colour = "black"),
axis.text = element_text(size = 4))
p2 <- p1 %+% xs$Polyphen2
p3 <- p1 %+% xs$SIFT
library(gridExtra)
grid.arrange(p1, p2, p3)
And the result is:
EDIT:
In case you want different range for facets but you want values to be comparable (e.g. value around 5 should be yellow in all plots), there is a possible solution
First discretize your fill variable
mydata$colour <- cut(mydata$Score,
quantile(mydata$Score, c(0, 0.25, 0.5, 0.75, 1)),
include.lowest = T)
Then create plots:
xs <- split(mydata, f = mydata$V2)
p1 <- ggplot(data = xs$MutationAssessor, aes(x = V1, y = 0, fill = colour)) +
geom_tile() +
geom_text(aes(label = Score), color = "black", size = 3) +
labs(x = "pic1", y = "") +
facet_grid(V2 ~ .) +
theme_bw() +
theme(panel.border = element_rect(colour = "black"),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
axis.line = element_line(colour = "black"),
axis.text = element_text(size = 4))
p2 <- p1 %+% xs$Polyphen2
p3 <- p1 %+% xs$SIFT
And finally change palette:
mypalette <- c("#FFFFCC", "#A1DAB4", "#41B6C4", "#2C7FB8", "#253494")
names(mypalette) <- levels(mydata$colour)
p1 <- p1 + scale_fill_manual(values = mypalette[levels(xs$MutationAssessor$colour)])
p2 <- p2 + scale_fill_manual(values = mypalette[levels(xs$Polyphen2$colour)])
p3 <- p3 + scale_fill_manual(values = mypalette[levels(xs$SIFT$colour)])
And the result is:
grid.arrange(p1, p2, p3)
I'm trying to plot a stacked bar graph in R using ggplot. I also want to include percentage in each piece of bars for that piece. I tried to follow the posts 1, 2, 3 but the values are not exactly in their respective blocks. My data is a file in dropbox.
My code is as follows:
f<-read.table("Input.txt", sep="\t", header=TRUE)
ggplot(data=f, aes(x=Form, y=Percentage, fill=Position)) +
geom_bar(stat="identity", colour="black") +
geom_text(position="stack", aes(x=Form, y=Percentage, ymax=Percentage, label=Percentage, hjust=0.5)) +
facet_grid(Sample_name ~ Sample_type, scales="free", space="free") +
opts(title = "Input_profile",
axis.text.x = theme_text(angle = 90, hjust = 1, size = 8, colour = "grey50"),
plot.title = theme_text(face="bold", size=11),
axis.title.x = theme_text(face="bold", size=9),
axis.title.y = theme_text(face="bold", size=9, angle=90),
panel.grid.major = theme_blank(),
panel.grid.minor = theme_blank()) +
scale_fill_hue(c=45, l=80)
ggsave("Output.pdf")
The output is-
Any help is greatly appreciated.
Thank you for your help and time!
I think you're using an older version of ggplot2. Because with your code modified for ggplot2 v 0.9.3, I get this:
p <- ggplot(data = df, aes(x = Form, y = Percentage, fill = Position))
p <- p + geom_bar(stat = "identity", colour = "black")
p <- p + geom_text(position = "stack", aes(x = Form, y = Percentage, ymax = Percentage, label = Percentage, hjust = 0.5))
p <- p + facet_grid(Sample_name ~ Sample_type, scales="free", space="free")
p <- p + theme(plot.title = element_text("Input_profile"),
axis.text.x = element_text(angle = 90, hjust = 1, size = 8, colour = "grey50"),
plot.title = element_text(face="bold", size=11),
axis.title.x = element_text(face="bold", size=9),
axis.title.y = element_text(face="bold", size=9, angle=90),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank())
p <- p + scale_fill_hue(c=45, l=80)
p
You see that the text objects are normally placed properly. There are places where the bars are just too short so that the numbers overlap. You can also play with the size parameter.
To rectify that, you could do something like this to add up the numbers by yourself.
df <- ddply(df, .(Form, Sample_type, Sample_name), transform,
cum.perc = Reduce('+', list(Percentage/2,cumsum(c(0,head(Percentage,-1))))))
p <- ggplot(data = df, aes(x = Form, y = Percentage, fill = Position))
p <- p + geom_bar(stat = "identity", colour = "black")
p <- p + geom_text(aes(x = Form, y = cum.perc, ymax = cum.perc, label = Percentage, hjust = 0.5), size=2.7)
p <- p + facet_grid(Sample_name ~ Sample_type, scales="free", space="free")
p <- p + theme(plot.title = element_text("Input_profile"),
axis.text.x = element_text(angle = 90, hjust = 1, size = 8, colour = "grey50"),
plot.title = element_text(face="bold", size=11),
axis.title.x = element_text(face="bold", size=9),
axis.title.y = element_text(face="bold", size=9, angle=90),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank())
p <- p + scale_fill_hue(c=45, l=80)
p
This gives:
Here a solution using barchart from lattice.
library(latticeExtra)
barchart(Percentage~Form|Sample_type*Sample_name,data=dat,
groups =Position,stack=T,
panel=function(...){
panel.barchart(...)
ll <- list(...)
keep <- !is.na(ll$groups[ll$subscripts])
x <- as.numeric(ll$x[keep])
y <- as.numeric(ll$y[keep])
groups <- as.numeric(factor(ll$groups)[ll$subscripts[keep]])
for (i in unique(x)) {
ok <- x == i
ord <- sort.list(groups[ok])
pos <- y[ok][ord] > 0
nok <- sum(pos, na.rm = TRUE)
h <- y[ok][ord][pos]
panel.text(x = rep(i, nok),y = cumsum(h)-0.5*h,
label = h,cex=1.5)
}
},
auto.key = list(columns = 5),
par.settings = ggplot2like(n = 5),
lattice.options = ggplot2like.opts())