Displaying R plots in a 1x4 grid, using a shared y-axis - r

I am trying to display some graphs in a 1x4 grid, but I would like all the graphs to have the same x and y axes.
time maxhgs.sleep_LIPA maxhgs.sed_LIPA maxhgs.stand_LIPA maxhgs.MVPA_LIPA maxhgs.LIPA_MVPA
1 5 0.08289621 0.03241295 0.1129983 0.112998341 -0.01928050
2 10 0.16289049 0.06139545 0.2236818 -0.006728721 -0.04950022
3 15 0.24025861 0.08721203 0.3323473 -0.047756360 -0.08927656
4 20 0.31524160 0.11009218 0.4392581 -0.144261526 -0.13791276
5 25 0.38805152 0.13023596 0.5446498 -0.424789999 -0.19517306
6 30 0.41660977 0.13756729 0.5864293 -0.934884300 -0.26117695
This is the data I am working with.
library(ggplot2)
library(egg)
maxhgs.a <- ggplot(maxhgs.df, aes(time, maxhgs.sleep_LIPA)) + geom_point()+geom_line()
maxhgs.a <- maxhgs.a + scale_x_continuous(name = "Time Reallocated", breaks = seq(5,30, by=5)) +
scale_y_continuous(name = "Change in maxhgs", breaks = seq(0,1, by=0.1))+
ggtitle("Sleep to LIPA")
maxhgs.b <- ggplot(maxhgs.df, aes(time, maxhgs.sed_LIPA)) + geom_point()+geom_line()
maxhgs.b <- maxhgs.b + scale_x_continuous(name = "Time Reallocated", breaks = seq(5,30, by=5)) +
scale_y_continuous(name = "Change in maxhgs", breaks = seq(0,1, by=0.1))+
ggtitle("Sedentary to LIPA")
maxhgs.c <- ggplot(maxhgs.df, aes(time, maxhgs.stand_LIPA)) + geom_point()+geom_line()
maxhgs.c <- maxhgs.c + scale_x_continuous(name = "Time Reallocated", breaks = seq(5,30, by=5)) +
scale_y_continuous(name = "Change in maxhgs", breaks = seq(0,1, by=0.1))+
ggtitle("Standing to LIPA")
maxhgs.d <- ggplot(maxhgs.df, aes(time, maxhgs.MVPA_LIPA)) + geom_point()+geom_line()
maxhgs.d <- maxhgs.d + scale_x_continuous(name = "Time Reallocated", breaks = seq(5,30, by=5)) +
scale_y_continuous(name = "Change in maxhgs", breaks = seq(0.5,-1, by=-0.1))+
ggtitle("MVPA to LIPA")
ggarrange(maxhgs.a,
maxhgs.b +
theme(axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
axis.title.y = element_blank() ),
maxhgs.c +
theme(axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
axis.title.y = element_blank() ),
maxhgs.d +
theme(axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
axis.title.y = element_blank() ),
nrow = 1)
This is what I have attempted so far. This actually "works" in that all the graphs have the same y-axis, but the y-axis doesn't actually reflect what should be on the graphs. As you can see in the graph, the y-axis goes from 0.1 to 0.4, but the maxhgs.d graph should extend from 0.1 to -0.9.
Any advice or suggestions would be greatly appreciated!

You can make this much easier by reshaping your data and using faceting. That way, you only need to define a single plot. This requires you to pivot_longer and change the factor levels to the names you want for each facet, but once this is done, the plot itself is straightforward:
library(ggplot2)
library(dplyr)
# Define the label names for the facets first
labs <- c("LIPA to MVPA", "MVPA to LIPA", "Sedentary to LIPA",
"Sleep to LIPA", "Standing to LIPA")
gg <- maxhgs.df %>%
tidyr::pivot_longer(cols = -1) %>%
mutate(plot = factor(`levels<-`(factor(name), labs), labs[c(4, 3, 5, 2, 1)])) %>%
ggplot(aes(x = time, y = value)) +
geom_line() +
geom_point() +
scale_x_continuous(name = "Time Reallocated") +
scale_y_continuous(name = "Change in maxhgs") +
theme(strip.background = element_blank(),
strip.text = element_text(size = 13))
Now we can either choose to plot with fixed y axes:
gg + facet_grid(.~plot, scale = "fixed")
or with flexible y axes:
gg + facet_wrap(.~plot, scale = "free_y", ncol = 5)
Created on 2020-08-04 by the reprex package (v0.3.0)

Related

Table below x axis in ggplot

Hello everyone I was trying to add some text below the x axis in ggplot2 and I was able to do so using geom_textand with help of coord_cartesian but I couldn't make it reproducible as this need to run in a loop. I thought that adding the values I want with the row names (First, Second) in a table would fix it, does anybody have experience in that. below is the workaround I did. Thank you very much in advance.
## Data
Grade <- 1 : 20
Case <- rep(paste('case' , 1:5,sep = ''),4)
Number <- paste('n', 1:20 , sep = '')
Class <- c(rep('Class1',5) , rep('Class2',5) , rep('Class3',5) , rep('Class4',5))
se <- 0.2
df <- data.frame(Grade,Case ,Number, Class , se)
## plot
ggplot(df, aes(x= factor(Case , levels = c('case1','case2' , 'case3' , 'case4','case5')) , y=Grade ,
fill= Grade)) +
geom_bar(position="dodge", stat="identity",
colour="black",
size=.4) +
geom_errorbar(aes(ymin=Grade +se, ymax=Grade +se),
size=.3,
width=.2,
position=position_dodge(.9))+
geom_linerange(aes(ymin = Grade , ymax = Grade +se),position=position_dodge(.9))+
geom_text(aes(label=Number , y = Grade + se + 1),data=df, position=position_dodge(0.9), size= 4) +
ggtitle('Place a table below x axis')+
facet_grid(~Class) +
xlab('') +
ylab('Case Num') +
theme_gray()+
theme(plot.margin = unit(c(1,1,1,6), "lines"),
axis.text.x = element_text(size = 15)) +
scale_x_discrete(labels = paste(1:5 , '\n' , 10:15, sep = '')) +
geom_text(data = df[df$Class == 'Class1',],x = -1 , y = -3,
label= 'First\nSecond' , size = 4)+
coord_cartesian(clip = "off" , xlim = c(1, 5) )
EDIT:
Sorry for the confusion,although the solution suggested by #stefan is pretty much convenient but the main purpose is to have something like this:
considering that the proposed table will contain external characters, not taken from the data frame at all (if possible!).
As an alternative approach to tackle this problem I simply set up the table as a second ggplot which I glue together with the major ggplot using patchwork.
## Data
Grade <- 1 : 20
Case <- rep(paste('case' , 1:5,sep = ''),4)
Number <- paste('n', 1:20 , sep = '')
Class <- c(rep('Class1',5) , rep('Class2',5) , rep('Class3',5) , rep('Class4',5))
se <- 0.2
df <- data.frame(Grade,Case ,Number, Class , se)
library(patchwork)
library(ggplot2)
library(tidyr)
library(dplyr)
## plot
p1 <- ggplot(df, aes(x= factor(Case , levels = c('case1','case2' , 'case3' , 'case4','case5')) , y=Grade ,
fill= Grade)) +
geom_bar(position="dodge", stat="identity",
colour="black",
size=.4) +
geom_errorbar(aes(ymin=Grade +se, ymax=Grade +se),
size=.3,
width=.2,
position=position_dodge(.9))+
geom_linerange(aes(ymin = Grade , ymax = Grade +se),position=position_dodge(.9))+
geom_text(aes(label=Number , y = Grade + se + 1),data=df, position=position_dodge(0.9), size= 4) +
ggtitle('Place a table below x axis')+
facet_grid(~Class) +
xlab(NULL) +
ylab('Case Num') +
theme_gray()+
theme(axis.text.x = element_blank())
p2 <- df %>%
mutate(First = as.integer(stringr::str_extract(Case, "\\d")),
Second = First + 9,
Third = Second + 9) %>%
pivot_longer(c(First, Second, Third), names_to = "layer", values_to = "label") %>%
ggplot(aes(x = Case)) +
geom_text(aes(y = factor(layer, c("Third", "Second", "First")), label = label)) +
labs(y = "", x = NULL) +
theme_minimal() +
theme(axis.line = element_blank(), axis.ticks = element_blank(), axis.text.x = element_blank(),
panel.grid = element_blank(), strip.text = element_blank()) +
facet_grid(~Class)
p1 / p2 + plot_layout(heights = c(8, 1))
Created on 2020-05-23 by the reprex package (v0.3.0)
EDIT: Tweak to get a more table like output by adding a geom_tile and removing the spacing between facets as well as setting expansion of x-axis to zero:
p2 <- df %>%
select(Case, Class) %>%
mutate(First = letters[1:nrow(.)],
Second = LETTERS[1:nrow(.)],
Third = as.character(1:nrow(.))) %>%
pivot_longer(c(First, Second, Third), names_to = "layer", values_to = "label") %>%
ggplot(aes(x = Case, y = factor(layer, c("Third", "Second", "First")))) +
# Add Table Style
geom_tile(fill = "blue", alpha = .4, color = "black") +
geom_text(aes(label = label)) +
# Remove expansion of axsis
scale_x_discrete(expand = expansion(mult = c(0, 0))) +
labs(y = "", x = NULL) +
theme_minimal() +
theme(axis.line = element_blank(), axis.ticks = element_blank(), axis.text.x = element_blank(),
panel.grid = element_blank(), strip.text = element_blank(), panel.spacing.x = unit(0, "mm")) +
facet_grid(~Class)
p1 / p2 + plot_layout(heights = c(8, 1))
Created on 2020-05-24 by the reprex package (v0.3.0)
If I understand your requirement correctly, (as in my comment above), this may help you. You just need to name your graph and add the labels in loop and render outside the loop.
...
theme(plot.margin = unit(c(1,1,1,6), "lines"),
axis.text.x = element_text(size = 15)) +
scale_x_discrete(labels = paste(1:5 , '\n' , 10:15, sep = '')) +
coord_cartesian(clip = "off" , xlim = c(1, 5) )
label = NULL
ordinal <- c('first','second','third','fourth','fifth','sixth','seventh','eighth','ninth','tenth')
for (i in 1:5) {
label <- paste(label, '\n', ordinal[i])
}
g1 <- g1 + geom_text(data = df[df$Class == 'Class1',],x = -1 , y = -3,
label= label , size = 4)
g1
This is what I get as a result:

How to use scale_x_date properly

I am a new user in R and I hope you can help me.
setwd("C:/Users/USER/Desktop/Jorge")
agua <- read_excel("agua.xlsx")
pbi <- read_excel("PBIagro.xlsx")
str(agua);
names(agua)[2] <- "Variación";
agua[,1] <- as.Date(agua$Trimestre)
lagpbi <- lag(pbi$PBIAgropecuario, k=1)
pbi[,3]<- lagpbi; pbi <- pbi[-c(1),];
names(pbi)[3] <- "PBIlag"
growth <- ((pbi$PBIAgropecuario-pbi$PBIlag)/pbi$PBIlag)*100
Anual_growth <- data.frame(growth); Anual_growth[,2] <- pbi$Año; names(Anual_growth)[2] <- "Año"
# Plot
Agro <- ggplot(Anual_growth, aes(x=Año, y=growth)) +
geom_line(color="steelblue") +
geom_point() +
geom_text(aes(label = round(Anual_growth$growth, 1)),
vjust = "inward", hjust = "inward", size=2.5, show.legend = FALSE) +
xlab("") +
theme_ipsum() +
theme(axis.text.x=element_text(angle=60, hjust=1)) +
ylim(-9.9,13.4) +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
axis.line.x = element_blank(), plot.margin = unit(c(1,1,0.5,1),"cm"),
axis.line.y = element_blank(), axis.text.x=element_text(face = "bold", size=8,
angle=1,hjust=0.95,vjust=0.2),
axis.text.y = element_blank(), axis.title.y=element_blank())+
scale_x_continuous("Año", labels = as.character(Anual_growth$Año), breaks = Anual_growth$Año)
print(Agro)
The problem is that it shows all the years, but I only want pair years (in X-axis) or years with step equal to 2.
I hope you can really help me.
Thank you.
Notice that the X-axis variable is a numeric string.
You can add something like
scale_x_date(date_breaks = "2 years", date_labels = "%Y") to your ggplot.
This is how it looks with my data, since you haven't posted yours. I am plotting a type date on x axis.
1.
ggplot(mydata) +
aes(x = date, y = number, color = somevar) +
geom_line()
ggplot(mydata) +
aes(x = date, y = number, color = somevar) +
geom_line() +
scale_x_date(date_breaks = "1 year", date_labels = "%Y")
3.
ggplot(mydata) +
aes(x = date, y = number, color = somevar) +
geom_line() +
scale_x_date(date_breaks = "2 years", date_labels = "%Y")
If you want pair years and because your x-axis variable is numeric, you can specify in scale_x_continous that breaks argument should take only even numbers.
Here how you can do it using this small example:
year = 1998:2020
value = rnorm(23,mean = 3)
df = data.frame(year,value)
library(ggplot2)
ggplot(df, aes(x = year, y = value))+
geom_point()+
geom_line()+
scale_x_continuous(breaks = year[year %%2 ==0])
Reciprocally, if you want odd years, you just have to specify scale_x_continuous(breaks = year[year %%2 != 0])
So, in your code, you should write:
scale_x_continuous(breaks = Anual_growth$Año[Anual_growth$Año %%2 ==0])
Does it answer your question ?

How to add axis text in this negative and positive bars differently using ggplot2?

I've drawed bar graph with negative and positive bars which is familiar to the research. However, my code seems extremely inconvenient and verbose usinggraphics::plot() and graphics::text() as showed below. Try as I may, I could find the solution using element_text to fulfill in ggplot2. Please help or try to give some ideas how to achieve this in ggplot2.Thanks in advance.
# my data
df <- data.frame(genus=c("Prevotella","Streptococcus","YRC22","Phascolarctobacterium","SMB53","Epulopiscium",
"CF231","Anaerovibrio","Paludibacter","Parabacteroides","Desulfovibrio","Sutterella",
"Roseburia","Others__0_5_","Akkermansia","Bifidobacterium","Campylobacter","Fibrobacter",
"Coprobacillus","Bulleidia","f_02d06","Dorea","Blautia","Enterococcus","Eubacterium",
"p_75_a5","Clostridium","Coprococcus","Oscillospira","Escherichia","Lactobacillus"),
class=c(rep("groupA",18),rep("groupB",13)),
value=c(4.497311,4.082377,3.578472,3.567310,3.410453,3.390026,
3.363542,3.354532,3.335634,3.284165,3.280838,3.218053,
3.071454,3.026663,3.021749,3.004152,2.917656,2.811455,
-2.997631,-3.074314,-3.117659,-3.151276,-3.170631,-3.194323,
-3.225207,-3.274281,-3.299712,-3.299875,-3.689051,-3.692055,
-4.733154)
)
# bar graph
tiff(file="lefse.tiff",width=2000,height=2000,res=400)
par(mar=c(5,2,1,1))
barplot(df[,3],horiz=T,xlim=c(-6,6),xlab="LDA score (log 10)",
col=c(rep("forestgreen",length(which(df[,2]=="groupA"))),
rep("goldenrod",length(which(df[,2]=="groupB")))))
axis(1,at=seq(-6,6,by=1))
# add text
text(0.85,36.7,label=df[,1][31],cex=0.6);text(0.75,35.4,label=df[,1][30],cex=0.6)
text(0.75,34.1,label=df[,1][29],cex=0.6);text(0.85,33.0,label=df[,1][28],cex=0.6)
text(0.75,31.8,label=df[,1][27],cex=0.6);text(0.6,30.6,label=df[,1][26],cex=0.6)
text(0.8,29.5,label=df[,1][25],cex=0.6);text(0.85,28.3,label=df[,1][24],cex=0.6)
text(0.45,27.1,label=df[,1][23],cex=0.6);text(0.4,25.9,label=df[,1][22],cex=0.6)
text(0.55,24.7,label=df[,1][21],cex=0.6);text(0.55,23.5,label=df[,1][20],cex=0.6)
text(0.85,22.3,label=df[,1][19],cex=0.6);text(-0.75,21.1,label=df[,1][18],cex=0.6)
text(-1,19.9,label=df[,1][17],cex=0.6);text(-1,18.8,label=df[,1][16],cex=0.6)
text(-0.85,17.6,label=df[,1][15],cex=0.6);text(-0.85,16.3,label=df[,1][14],cex=0.6)
text(-0.7,15.1,label=df[,1][13],cex=0.6);text(-0.65,13.9,label=df[,1][12],cex=0.6)
text(-0.85,12.7,label=df[,1][11],cex=0.6);text(-1.05,11.5,label=df[,1][10],cex=0.6)
text(-0.85,10.3,label=df[,1][9],cex=0.6);text(-0.85,9.1,label=df[,1][8],cex=0.6)
text(-0.47,7.9,label=df[,1][7],cex=0.6);text(-0.85,6.7,label=df[,1][6],cex=0.6)
text(-0.49,5.5,label=df[,1][5],cex=0.6);text(-1.44,4.3,label=df[,1][4],cex=0.6)
text(-0.49,3.1,label=df[,1][3],cex=0.6);text(-0.93,1.9,label=df[,1][2],cex=0.6)
text(-0.69,0.7,label=df[,1][1],cex=0.6)
# add lines
segments(0,-1,0,40,lty=3,col="grey")
segments(2,-1,2,40,lty=3,col="grey")
segments(4,-1,4,40,lty=3,col="grey")
segments(6,-1,6,40,lty=3,col="grey")
segments(4,-1,4,40,lty=3,col="grey")
segments(-2,-1,-2,40,lty=3,col="grey")
segments(-4,-1,-4,40,lty=3,col="grey")
segments(-6,-1,-6,40,lty=3,col="grey")
legend("topleft",bty="n",cex=0.65,inset=c(0.01,-0.02),ncol=2,
legend=c("groupA","groupB"),
col=c("forestgreen", "goldenrod"),pch=c(15,15))
dev.off()
Here's a solution using dplyr to create some extra columns for the label position and the justification, and then theming the plot to match reasonably closely what you originally had:
library("dplyr")
library("ggplot2")
df <- df %>%
mutate(
genus = factor(genus, levels = genus[order(value, decreasing = TRUE)]),
label_y = ifelse(value < 0, 0.2, -0.2),
label_hjust = ifelse(value < 0, 0, 1)
)
my_plot <- ggplot(df, aes(x = genus, y = value, fill = class)) +
geom_bar(stat = "identity", col = "black") +
geom_text(aes(y = label_y, label = genus, hjust = label_hjust)) +
coord_flip() +
scale_fill_manual(values = c(groupA = "forestgreen", groupB = "goldenrod")) +
theme_minimal() +
theme(axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
axis.title.y = element_blank(),
legend.position = "top",
legend.justification = 0.05,
legend.title = element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.minor.y = element_blank(),
panel.grid.major.x = element_line(colour = "grey80", linetype = "dashed"),
panel.grid.minor.x = element_blank()) +
scale_y_continuous(expression(log[10](italic("LDA score"))),
breaks = -6:6, limits = c(-6, 6))
print(my_plot)
ggsave("lefse.tiff", width = 5, height = 5, dpi = 400, my_plot)
I would try this:
library(ggplot2)
# change the factor levels so it will be displayed in correct order
df$genus <- factor(df$genus, levels = as.character(df$genus))
ggplot(df, aes(x = genus, y = value)) +
geom_bar(aes(fill = class), stat = 'identity') + # color by class
coord_flip() + # horizontal bars
geom_text(aes(y = 0, label = genus, hjust = as.numeric(value > 0))) + # label text based on value
theme(axis.text.y = element_blank())
In the above, hjust will change the direction of the text relative to its y position (flipped to x now), which is similar to pos parameter in base R plot. So you code could also be simplified with a vector for pos argument to text function.
Two options:
library(ggplot2)
# my data
df <- data.frame(genus=c("Prevotella","Streptococcus","YRC22","Phascolarctobacterium","SMB53","Epulopiscium",
"CF231","Anaerovibrio","Paludibacter","Parabacteroides","Desulfovibrio","Sutterella",
"Roseburia","Others__0_5_","Akkermansia","Bifidobacterium","Campylobacter","Fibrobacter",
"Coprobacillus","Bulleidia","f_02d06","Dorea","Blautia","Enterococcus","Eubacterium",
"p_75_a5","Clostridium","Coprococcus","Oscillospira","Escherichia","Lactobacillus"),
class=c(rep("groupA",18),rep("groupB",13)),
value=c(4.497311,4.082377,3.578472,3.567310,3.410453,3.390026,
3.363542,3.354532,3.335634,3.284165,3.280838,3.218053,
3.071454,3.026663,3.021749,3.004152,2.917656,2.811455,
-2.997631,-3.074314,-3.117659,-3.151276,-3.170631,-3.194323,
-3.225207,-3.274281,-3.299712,-3.299875,-3.689051,-3.692055,
-4.733154)
)
ggplot(df, aes(reorder(genus, -value), value, fill = class)) +
geom_bar(stat = "identity") +
coord_flip() +
geom_text(aes(label = genus,
y = ifelse(value < 1, 1.5, -1.5)), size = 2.5) +
theme(axis.title.y=element_blank(),
axis.text.y=element_blank(),
axis.ticks.y=element_blank())
Or this:
library(ggplot2)
# my data
df <- data.frame(genus=c("Prevotella","Streptococcus","YRC22","Phascolarctobacterium","SMB53","Epulopiscium",
"CF231","Anaerovibrio","Paludibacter","Parabacteroides","Desulfovibrio","Sutterella",
"Roseburia","Others__0_5_","Akkermansia","Bifidobacterium","Campylobacter","Fibrobacter",
"Coprobacillus","Bulleidia","f_02d06","Dorea","Blautia","Enterococcus","Eubacterium",
"p_75_a5","Clostridium","Coprococcus","Oscillospira","Escherichia","Lactobacillus"),
class=c(rep("groupA",18),rep("groupB",13)),
value=c(4.497311,4.082377,3.578472,3.567310,3.410453,3.390026,
3.363542,3.354532,3.335634,3.284165,3.280838,3.218053,
3.071454,3.026663,3.021749,3.004152,2.917656,2.811455,
-2.997631,-3.074314,-3.117659,-3.151276,-3.170631,-3.194323,
-3.225207,-3.274281,-3.299712,-3.299875,-3.689051,-3.692055,
-4.733154)
)
ggplot(df, aes(reorder(genus, -value), value, fill = class)) +
geom_bar(stat = "identity") +
coord_flip() +
xlab("genus")

legend not showing, grid doesn't become finer

I have the following code. How can I make the grid much finer scale? Also not sure why the legend is not showing? Like I want to have 4 o 8 squares between 75 and 100.
#Select the colors from http://colorbrewer2.org/#type=sequential&scheme=RdPu&n=9
if( !is.element("ggplot2", installed.packages()[,1]) )
install.packages("ggplot2")
if( !is.element("grid", installed.packages()[,1]) )
install.packages("grid")
if( !is.element("plyr", installed.packages()[,1]) )
install.packages("plyr")
if( !is.element("data.table", installed.packages()[,1]) )
install.packages("data.table")
if( !is.element("igraph", installed.packages()[,1]) )
install.packages("igraph")
if( !is.element("ggthemes", installed.packages()[,1]) )
install.packages("ggthemes")
library(ggplot2)
library(grid)
library(plyr)
library(data.table)
library(igraph)
library(ggthemes)
#setwd(dir = "/home/sathya/Documents/coreset/rplots/fig/svm")
svmdata <- fread("ionosphere-smooth-ls-optim.dat")
#svmdata <- read.table("ionosphere-smooth-ls-optim.dat", header=TRUE)
svmdata <- rename(svmdata, c("# k"="k"))
svmdata <- head(svmdata, 100)
svmdata_ls <- fread("ionosphere-ls-optim.dat")
svmdata_ls <- head(svmdata_ls,100)
svmdata_ls <- rename(svmdata_ls, c("# k"="k"))
y_max <- max(max(svmdata$gap), max(svmdata_ls$gap))
base <- ggplot(data=svmdata_ls,aes(x=k, y=gap, group=2)) +
geom_line(colour="#dd3497", size=1.5) + #geom_point(size=4, shape=21) +
geom_line(data=svmdata,aes(x=k, y=gap, group=1 ), colour="#54278f", size=1.5) +
#ggtitle("svmdata_ls gap and svmdata gap vs k") +
geom_smooth(alpha=.2, size=1) +
geom_abline(colour = "grey50", size = 2) +
xlim(0, max(svmdata$k)) +
ylim(0, y_max) +
scale_colour_manual("",
breaks = c("svmdata_ls", "svmdata"),
values = c("#dd3497", "#54278f"))
labelled <- base +
labs(
x = "K",
y = "Gap",
colour = "Cylinders",
title = "svmdata_ls gap and svmdata gap vs k"
)
labelled
styled <- labelled +
theme_bw() +
theme(
plot.title = element_text(face = "bold", size = 25, colour = "purple"),
axis.title=element_text(size= 20, face= "bold", colour="blue"),
legend.background = element_rect(fill = "white", size = 4, colour = "white"),
legend.justification = c(0, 1),
legend.key = element_rect(fill = "yellow"),
#legend.position = "bottom",
legend.position = c(0, 1),
axis.ticks = element_line(colour = "grey70", size = 0.25),
panel.grid.major = element_line(colour = "grey70", size = 0.5),
panel.grid.minor = element_line(colour= "grey70", size=0.5)
)
styled
Data: http://pastebin.com/0wb6S4m8 and http://pastebin.com/L4sdEyYZ
These are just the basics; I didn't bother with all the special colours etc..
to get a legend, combine your data into one long data frame and use aes(colour=grp), where grp is a variable that identifies the group.
to get finer-spaced tick marks, use scale_x_continuous() with breaks or minor_breaks set.
Get data:
rr <- function(x) plyr::rename(as.data.frame(data.table::fread(x)),
c("# k"="k"))
svmdata <- rr("ionosphere-smooth-ls-optim.dat")
svmdata_ls <- rr("ionosphere-ls-optim.dat")
Combine data into a single labeled data frame:
get_vars <- function(d) d[c("k","gap")]
svmcomb <- plyr::ldply(list(svmdata=svmdata,svmdata_ls=svmdata_ls),
get_vars)
Plot:
library(ggplot2)
ggplot(svmcomb,aes(k,gap,colour=.id))+
geom_line()+
scale_x_continuous(minor_breaks=seq(0,100,by=2.5))
Typically with ggplot you would approach this type of thing more like this:
svmdata$grp <- "svmdata"
svmdata_ls$grp <- "svmdata_ls"
dat <- rbind(svmdata,svmdata_ls)
base <- ggplot(data=dat,aes(x=k, y=gap, colour = grp,group=grp)) +
geom_line(size=1.5) + #geom_point(size=4, shape=21) +
geom_line(size=1.5) +
#ggtitle("svmdata_ls gap and svmdata gap vs k") +
geom_smooth(alpha=.2, size=1) +
geom_abline(colour = "grey50", size = 2) +
xlim(0, max(svmdata$k)) +
ylim(0, y_max) +
scale_colour_manual("",
breaks = c("svmdata_ls", "svmdata"),
values = c("#dd3497", "#54278f"))

Plot multiple matrices in facets with different x-y axis

I collected the data from a set of online forums and wanted to plot, using ggplot and facets (one facet per forum), the matrix that represent how many times user A replied to user B.
Here is the code to load a toy example:
library(ggplot2)
library(dplyr)
df.edges <- data.frame(from = c('forum1_user1', 'forum1_user1',
'forum1_user2', 'forum1_user2',
'forum2_user1', 'forum2_user1',
'forum2_user2', 'forum2_user2',
'forum3_user1', 'forum3_user1',
'forum3_user2', 'forum3_user2'),
to = c('forum1_user1', 'forum1_user2',
'forum1_user1', 'forum1_user2',
'forum2_user1', 'forum2_user2',
'forum2_user1', 'forum2_user2',
'forum3_user1', 'forum3_user2',
'forum3_user1', 'forum3_user2'),
weight = 1:12,
timestamp = 1:12,
subforum = c('forum1', 'forum1', 'forum1', 'forum1',
'forum2', 'forum2', 'forum2', 'forum2',
'forum3', 'forum3', 'forum3', 'forum3'))
I try this:
# Sort for later use in scale_discrete
df.edges <- df.edges %>% arrange(timestamp)
gg <- ggplot(df.edges, aes(x = from, y = to, fill = weight)) +
geom_raster() + coord_fixed() +
facet_grid(. ~subforum, scales='fixed') +
scale_x_discrete("from", aes(limits = from))+
scale_y_discrete("to", aes(limits = from)) +
theme_bw() +
theme(axis.line = element_blank(),
axis.text.x = element_text(angle = 90, hjust=1, size=8),
axis.text.y = element_text(hjust=1, size=10),
axis.ticks = element_blank(),
strip.background = element_rect(fill = 'white'),
aspect.ratio = 1) +
ggtitle("Matrix of interactions") + xlab('from') + ylab('to')
print(gg)
which gives this:
And if I set the facet scale scale='free':
However, I want each facet to show only those users belonging to that forum. The matrices should be completely filled with 4 cells in each one.
Any idea?
You could create a separate plot for each level of subforum and then lay them out together using grid.arrange:
library(gridExtra)
library(grid)
First, create the separate plots and store in a list. We add scale_fill_continuous(limits=range(df.edges$weight)) to ensure a consistent fill gradient across the three plots:
pl = lapply(split(df.edges, df.edges$subforum), function(df) {
ggplot(df, aes(x = from, y = to, fill = weight)) +
geom_raster() + coord_fixed() +
facet_grid(. ~subforum, scales='fixed') +
scale_x_discrete("from", aes(limits = from))+
scale_y_discrete("to", aes(limits = from)) +
scale_fill_continuous(limits=range(df.edges$weight)) +
theme_bw() +
theme(axis.line = element_blank(),
axis.text.x = element_text(angle = 90, hjust=1, size=8),
axis.text.y = element_text(hjust=1, size=10),
axis.ticks = element_blank(),
strip.background = element_rect(fill = 'white'),
aspect.ratio = 1) +
xlab('from') + ylab('to')
})
Extract the legend, as we want only one legend, rather than a separate legend for each plot:
# Function to extract legend
#https://github.com/hadley/ggplot2/wiki/Share-a-legend-between-two-ggplot2-graphs
g_legend<-function(a.gplot){
tmp <- ggplot_gtable(ggplot_build(a.gplot))
leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box")
legend <- tmp$grobs[[leg]]
return(legend) }
# Extract legend as a grob
leg = g_legend(pl[[1]])
Arrange the plots with legend and title:
grid.arrange(
textGrob("Matrix of Interactions"),
arrangeGrob(
arrangeGrob(grobs=lapply(pl, function(x) x + guides(fill=FALSE)), ncol=3),
leg, ncol=2, widths=c(10,1)
),
heights=c(1,20)
)

Resources