Related
I looked for answers in other Qs, couldn't find this Q (or Answer).
Using ggplot2 to generate the two plots individually.
Then using plot_grid function from the cowplot package to combine them.
They two data have exactly the same number of common dates.
Thus the x-axis is same time, I want the two graph's grey box to start from the same vertical spot,
so that they are time aligned. Presently, due to ylabs of different size, they don't start from same vertical line. Here is a pictorial description:
This could be achieved via the patchwork package:
library(ggplot2)
library(patchwork)
p1 <- ggplot(mtcars, aes(hp, mpg)) +
geom_point()
p2 <- ggplot(mtcars, aes(hp, mpg * 1000)) +
geom_point()
p1 / p2
If you want a solution that only uses plot_grid, you could do the following (admittedly hackier than the patchwork package):
myPlot1 <- ggplot()
myPlot2 <- ggplot()
#get a ggplot that is the axis only
myYAxis1 <- get_y_axis(myPlot1)
myYAxis2 <- get_y_axis(myPlot2)
#remove all y axis stuff from the plots themselves
myPlot1 <- myPlot1 + theme(axis.text.y = element_blank(), axis.title.y = element_blank(), axis.ticks.y = element_blank())
myPlot2 <- myPlot2 + theme(axis.text.y = element_blank(), axis.title.y = element_blank(), axis.ticks.y = element_blank())
#reassemble plots
ratioAxisToPlot = .1 #determine what fraction of the arranged plot you want to be axis and what fraction you want to be plot)
plot1Reassembled <- plot_grid(myYAxis1, myPlot1, rel_widths = c(ratioAxisToPlot, 1), ncol=2)
plot2Reassembled <- plot_grid(myYAxis2, myPlot2, rel_widths = c(ratioAxisToPlot, 1), ncol=2)
#put it all together
finalPlot <- plot_grid(plot1Reassembled, plot2Reassembled, nrow=2)
After looking at various post and asking questions here i have been able to make a multi faceted pie chart. But i am facing a problem in tidying up the pie chart. Here are the things i am having troubles with:
How do i remove the facet labels from each row and only have one facet label on the top or bottom and left or right? How do i control how the facet label looks?
I have tried using facet_grid instead of facet_wrap and that removes the label from each row but still the labels are inside a box. I would like to remove the box which i donot seem to be able to do.
Centering the labels so that the values for each fraction of the pie is inside that pie-slice.
Some of my piechart have 8 to 10 values and they are not always inside there fraction. First i used geom_text_repel but that only helped me to repel the text. It didnt place the text inside each fraction. I also looked at this thread. I tried that by creating a new dataframe which has a position values and using that pos inside geom_text like so d<-c %>% group_by(Parameter)%>% mutate(pos= ave(Values, Zones, FUN = function(x) cumsum(x) - 0.5 * x)) and using the same code to make pie chart for d dataframe but it didnt quite work.
Grouping the values under certain level into one single "other" groups so the number of slices would be less
It would be ideal for me to be able to group the values with less than 1 % into one single group and call it "others" so that the number of slices are less. So far i have to completely ignore those values by c<-c[c$Values>1,] and using this newly created data frame.
Any suggestions/help regarding these issues would be helpful.
Following is the reproducible example of my current pie chart:
library(RColorBrewer)
library(ggrepel)
library(ggplot2)
library(tidyverse)
my_pal <- colorRampPalette(brewer.pal(9, "Set1"))
#### create new matrix ############
new_mat<-matrix(, nrow=40, ncol = 4)
colnames(new_mat)<-c("Zones", "ssoilcmb", "Erosion_t", "area..sq.m.")
for ( i in 1:nrow(new_mat)){
new_mat[i,4]<-as.numeric(sample(0:20, 1))
new_mat[i,3]<-as.numeric(sample(0:20, 1))
a<-sample(c("S2","S3","S4","S5","S1"),1)
b<-sample(c("Deep","Moderate","Shallow"),1)
new_mat[i,1]<-sample(c("High Precip","Moderate Precip","Low Precip"),1)
new_mat[i,2]<-paste0(a,"_",b)
}
m_dt<-as.data.frame(new_mat)
m_dt$Erosion_t<-as.numeric(m_dt$Erosion_t)
m_dt$area..sq.m.<-as.numeric(m_dt$area..sq.m.)
#### calculate parea
m_dt<- m_dt %>%
group_by(Zones)%>%
mutate(per_er=signif((`Erosion_t`/sum(`Erosion_t`))*100,3), per_area=signif((`area..sq.m.`/sum(`area..sq.m.`))*100,3))
## Rearranging data:
a<-data.frame(m_dt$Zones,m_dt$ssoilcmb, m_dt$per_er)
b<-data.frame(m_dt$Zones,m_dt$ssoilcmb, m_dt$per_area)
c<-data.frame(Zones=m_dt$Zones,ssoilcmb=m_dt$ssoilcmb,
Parameter=c(rep("Erosion",40),rep("Area",40)),
Values=c(m_dt$per_er,m_dt$per_area))
### New Plot ###
ggplot(c, aes(x="", y=Values, fill=ssoilcmb)) +
geom_bar(stat="identity", width=1, position = position_fill())+
coord_polar("y", start=0) +
facet_wrap(Zones~Parameter, nrow = 3) +
geom_text_repel(aes(label = paste0(Values, "%")), position = position_fill(vjust = 0.5))+
scale_fill_manual(values=my_pal(15)) +
labs(x = NULL, y = NULL, fill = NULL, title = "Erosions")+
theme_classic() + theme(axis.line = element_blank(),
axis.text = element_blank(),
axis.ticks = element_blank(),
plot.title = element_text(hjust = 0.5, color = "#666666"))
If you're open to alternatives, maybe a facet_wrapped barplot will suit your needs, e.g.
library(RColorBrewer)
library(ggrepel)
library(tidyverse)
my_pal <- colorRampPalette(brewer.pal(9, "Set1"))
#### create new matrix ############
new_mat<-matrix(nrow=40, ncol = 4)
colnames(new_mat)<-c("Zones", "ssoilcmb", "Erosion_t", "area..sq.m.")
for ( i in 1:nrow(new_mat)){
new_mat[i,4]<-as.numeric(sample(0:20, 1))
new_mat[i,3]<-as.numeric(sample(0:20, 1))
a<-sample(c("S2","S3","S4","S5","S1"),1)
b<-sample(c("Deep","Moderate","Shallow"),1)
new_mat[i,1]<-sample(c("High Precip","Moderate Precip","Low Precip"),1)
new_mat[i,2]<-paste0(a,"_",b)
}
m_dt<-as.data.frame(new_mat)
m_dt$Erosion_t<-as.numeric(m_dt$Erosion_t)
m_dt$area..sq.m.<-as.numeric(m_dt$area..sq.m.)
#### calculate parea
m_dt<- m_dt %>%
group_by(Zones)%>%
mutate(per_er=signif((`Erosion_t`/sum(`Erosion_t`))*100,3),
per_area=signif((`area..sq.m.`/sum(`area..sq.m.`))*100,3))
## Rearranging data:
a<-data.frame(m_dt$Zones,m_dt$ssoilcmb, m_dt$per_er)
b<-data.frame(m_dt$Zones,m_dt$ssoilcmb, m_dt$per_area)
c<-data.frame(Zones=m_dt$Zones,ssoilcmb=m_dt$ssoilcmb,
Parameter=c(rep("Erosion",40),rep("Area",40)),
Values=c(m_dt$per_er,m_dt$per_area))
### New Plot ###
c$Zones <- factor(c$Zones,levels(c$Zones)[c(2,3,1)])
ggplot(c, aes(x=ssoilcmb, y=Values, fill=ssoilcmb)) +
geom_col()+
facet_wrap(Zones~Parameter, nrow = 3) +
scale_fill_manual(values=my_pal(15)) +
labs(x = NULL, fill = NULL, title = "Erosions")+
theme_minimal() + theme(axis.line = element_blank(),
axis.ticks = element_blank(),
axis.text.x = element_text(angle = 90,
hjust = 1,
vjust = 0.5),
plot.title = element_text(hjust = 0.5,
color = "#666666"))
How can I easily create a plot where the text is not overlapping?
Also How could I create a plot where I just label the first few points? Like the image below, I want to always label the bottom left hand part of the plot
xx<-c(2.25,5.5,5,9.5,7.75,14,24.5,20.75,28,25.5,11.25,17.75,11.75,20.5,23.5,5,10.5,5.5,11,12.5,15,26.75,15.25,24.25,27.75,10.25,22,11.25,18,22.5)
yy<-c(2.75,10.5,9.25,13.5,12,20,24.75,22,29,26.75,13,16.75,13.5,21,23,5.75,7.75,6.75,10.5,6.25,13.5,24.75,14,25.5,26.75,9.5,16.25,10.5,14.5,15)
nm_plot<-c("lastrem_0.5_NN","lastrem_0.25_NN","pt_0.5_NN","pt_0.25_NN","lastrem_NN","lastrem_0.5_area","lastrem_0.25_area","pt_0.5_area","pt_0.25_area","lastrem_area","lastrem_0.5_100","lastrem_100","lastrem_0.25_100","pt_0.5_100","pt_0.25_100","lastrem_0.5_100area","lastrem_100area","lastrem_0.25_100area","pt_0.5_100area","pt_0.25_100area","lastrem_0.5_200","lastrem_200","lastrem_0.25_200","pt_0.5_200","pt_0.25_200","lastrem_0.5_200area","lastrem_200area","lastrem_0.25_200area","pt_0.5_200area","pt_0.25_200area")
direct.label(xyplot(yy~xx,groups=nm_plot,col="Black",
main=textGrob("7Q10",gp=gpar(fontsize=20,fontface="bold")),xlab="",ylab="",
scales=list(tck=c(1,0),cex=1.5),xlim=c(0,35),ylim=c(0,35)),list("last.bumpup",cex=1.5))
How can I create the plot below in R
Found a simple solution using ggplot2 and ggrepel.
xx<-c(2.25,5.5,5,9.5,7.75,14,24.5,20.75,28,25.5,11.25,17.75,11.75,20.5,23.5,5,10.5,5.5,11,12.5,15,26.75,15.25,24.25,27.75,10.25,22,11.25,18,22.5)
yy<-c(2.75,10.5,9.25,13.5,12,20,24.75,22,29,26.75,13,16.75,13.5,21,23,5.75,7.75,6.75,10.5,6.25,13.5,24.75,14,25.5,26.75,9.5,16.25,10.5,14.5,15)
nm_plot<-c("lastrem_0.5_NN","lastrem_0.25_NN","pt_0.5_NN","pt_0.25_NN","lastrem_NN","lastrem_0.5_area","lastrem_0.25_area","pt_0.5_area","pt_0.25_area","lastrem_area","lastrem_0.5_100","lastrem_100","lastrem_0.25_100","pt_0.5_100","pt_0.25_100","lastrem_0.5_100area","lastrem_100area","lastrem_0.25_100area","pt_0.5_100area","pt_0.25_100area","lastrem_0.5_200","lastrem_200","lastrem_0.25_200","pt_0.5_200","pt_0.25_200","lastrem_0.5_200area","lastrem_200area","lastrem_0.25_200area","pt_0.5_200area","pt_0.25_200area")
library(ggrepel)
library(ggplot2)
pp<-data.frame(xx,yy)
row.names(pp)<-nm_plot
plot1<-ggplot(pp) +
geom_point(aes(xx, yy), color = 'red') +
geom_text_repel(aes(xx, yy, label = rownames(pp))) +
theme_classic(base_size = 16)+theme_bw()+theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank())+
theme(axis.title.x = element_blank())+theme(axis.title.y = element_blank())+
scale_y_continuous(breaks=seq(0,30,5))+scale_x_continuous(breaks=seq(0,30,5))+
ggtitle("7Q10")+theme(plot.title = element_text(lineheight=.8, face="bold"))
Is there a way to have the value of the fill (the label) become the fill itself? For instance, in a stacked bar plot, I have
require(ggplot2)
big_votes_movies = movies[movies$votes > 100000,]
p = ggplot(big_votes_movies, aes(x=rating, y=votes, fill=year)) + geom_bar(stat="identity")
Can the values of 1997 and whatnot be the fill itself? A motif plot, if you will? An example of a motif plot is:
If this is possible, can I also plot these values on polar coordinates, so the fill would become the value?
p + coord_polar(theta="y")
There is a way to do it, but it's a little ugly.
When I first looked at it, I wondered if it could be done using geom_text, but although it gave a representation, it didn't really fit the motif structure. This was a first attempt:
require(ggplot2)
big_votes_movies = movies[movies$votes > 100000,]
p <- ggplot(big_votes_movies, aes(x=rating, y=votes, label=year))
p + geom_text(size=12, aes(colour=factor(year), alpha=0.3)) + geom_jitter(alpha=0) +
scale_x_continuous(limits=c(8, 9.5)) + scale_y_continuous(limits=c(90000,170000))
So then I realised you had to actually render the images within the grid/ggplot framework. You can do it, but you need to have physical images for each year (I created rudimentary images using ggplot, just to use only one tool, but maybe Photoshop would be better!) and then make your own grobs which you can add as custom annotations. You then need to make your own histogram bins and plot using apply. See below (it could be prettied up fairly easily). Sadly only works with cartesian co-ords :(
require(ggplot2)
require(png)
require(plyr)
require(grid)
years<-data.frame(year=unique(big_votes_movies$year))
palette(rainbow(nrow(years)))
years$col<-palette() # manually set some different colors
# create a function to write the "year" images
writeYear<-function(year,col){
png(filename=paste(year,".png",sep=""),width=550,height=300,bg="transparent")
im<-qplot(1,1,xlab=NULL,ylab=NULL) +
theme(axis.text.x = element_blank(),axis.text.y = element_blank()) +
theme(panel.background = element_rect(fill = "transparent",colour = NA), plot.background = element_rect(fill = "transparent",colour = NA), panel.grid.minor = element_line(colour = "white")) +
geom_text(label=year, size=80, color=col)
print(im)
dev.off()
}
#call the function to create the placeholder images
apply(years,1,FUN=function(x)writeYear(x["year"],x["col"]))
# then roll up the data
summarydata<-big_votes_movies[,c("year","rating","votes")]
# make own bins (a cheat)
summarydata$rating<-cut(summarydata$rating,breaks=c(0,8,8.5,9,Inf),labels=c(0,8,8.5,9))
aggdata <- ddply(summarydata, c("year", "rating"), summarise, votes = sum(votes) )
aggdata<-aggdata[order(aggdata$rating),]
aggdata<-ddply(aggdata,.(rating),transform,ymax=cumsum(votes),ymin=c(0,cumsum(votes))[1:length(votes)])
aggdata$imgname<-apply(aggdata,1,FUN=function(x)paste(x["year"],".png",sep=""))
#work out the upper limit on the y axis
ymax<-max(aggdata$ymax)
#plot the basic chart
z<-qplot(x=10,y=10,geom="blank") + scale_x_continuous(limits=c(8,9.5)) + scale_y_continuous(limits=c(0,ymax))
#make a function to create the grobs and call the annotation_custom function
callgraph<-function(df){
tiles<-apply(df,1,FUN=function(x)return(annotation_custom(rasterGrob(image=readPNG(x["imgname"]),
x=0,y=0,height=1,width=1,just=c("left","bottom")),
xmin=as.numeric(x["rating"]),xmax=as.numeric(x["rating"])+0.5,ymin=as.numeric(x["ymin"]),ym ax=as.numeric(x["ymax"]))))
return(tiles)
}
# then add the annotations to the plot
z+callgraph(aggdata)
and here's the plot with photoshopped images. I just save them over the generated imaages, and ran the second half of the script so as not to regenerate them.
OK - and then because it was bothering me, I decided to install extrafont and build the prettier graph using just R:
and here's the code:
require(ggplot2)
require(png)
require(plyr)
require(grid)
require(extrafont)
#font_import(pattern="Show") RUN THIS ONCE ONLY
#load the fonts
loadfonts(device="win")
#create a subset of data with big votes
big_votes_movies = movies[movies$votes > 100000,]
#create a custom palette and append to a table of the unique years (labels)
years<-data.frame(year=unique(big_votes_movies$year))
palette(rainbow(nrow(years)))
years$col<-palette()
#function to create the labels as png files
writeYear<-function(year,col){
png(filename=paste(year,".png",sep=""),width=440,height=190,bg="transparent")
im<-qplot(1,1,xlab=NULL,ylab=NULL,geom="blank") +
geom_text(label=year,size=70, family="Showcard Gothic", color=col,alpha=0.8) +
theme(axis.text.x = element_blank(),axis.text.y = element_blank()) +
theme(panel.background = element_rect(fill = "transparent",colour = NA),
plot.background = element_rect(fill = "transparent",colour = NA),
panel.grid.minor = element_line(colour = "transparent"),
panel.grid.major = element_line(colour = "transparent"),
axis.ticks=element_blank())
print(im)
dev.off()
}
#call the function to create the placeholder images
apply(years,1,FUN=function(x)writeYear(x["year"],x["col"]))
#summarize the data, and create bins manually
summarydata<-big_votes_movies[,c("year","rating","votes")]
summarydata$rating<-cut(summarydata$rating,breaks=c(0,8,8.5,9,Inf),labels=c(0,8,8.5,9))
aggdata <- ddply(summarydata, c("year", "rating"), summarise, votes = sum(votes) )
aggdata<-aggdata[order(aggdata$rating),]
aggdata<-ddply(aggdata,.(rating),transform,ymax=cumsum(votes),ymin=c(0,cumsum(votes))[1:length(votes)])
#identify the image placeholders
aggdata$imgname<-apply(aggdata,1,FUN=function(x)paste(x["year"],".png",sep=""))
ymax<-max(aggdata$ymax)
#do the basic plot
z<-qplot(x=10,y=10,geom="blank",xlab="Rating",ylab="Votes \n",main="Big Movie Votes \n") +
theme_bw() +
theme(panel.grid.major = element_line(colour = "transparent"),
text = element_text(family="Kalinga", size=20,face="bold")
) +
scale_x_continuous(limits=c(8,9.5)) +
scale_y_continuous(limits=c(0,ymax))
#creat a function to create the grobs and return annotation_custom() calls
callgraph<-function(df){
tiles<-apply(df,1,FUN=function(x)return(annotation_custom(rasterGrob(image=readPNG(x["imgname"]),
x=0,y=0,height=1,width=1,just=c("left","bottom")),
xmin=as.numeric(x["rating"]),xmax=as.numeric(x["rating"])+0.5,ymin=as.numeric(x["ymin"]),ymax=as.numeric(x["ymax"]))))
return(tiles)
}
#add the tiles to the base chart
z+callgraph(aggdata)
I am trying to use R ggplot2 package to make a boxplot.
However I can only get legend like this. Is there anyway I can change those legend key to just a solid square, instead of using those small box with central line?
The code I used is:
print(ggplot(mydata,aes(x=factor(sp),fill=factor(CommunityType),y=Abundance*100))+geom_boxplot(show_guide=FALSE)
+theme(axis.text = element_text(colour = "black",size=10))
+scale_y_continuous(" RA (%) ")+scale_x_discrete(limits=taxalist[1:5]," ")
+scale_fill_manual(name = "MY type", values = mycol[1:nmc])
+theme_bw() + guides(fill=guide_legend(title=NULL))+theme(legend.position=c(1,1),legend.justification=c(1,1))
+theme(legend.key = element_blank(),legend.key.size = unit(1.5, "lines"))
+theme( panel.grid.major = element_blank(), panel.grid.minor = element_blank(), panel.background = element_blank()) )
Sorry I cannot image here to describe my question.
Here's the legend shown as simple squares, using a variant of a hack that I have seen Winston Change use here. (I am using the diamonds dataset.)
The idea is to plot geom_points (whose legend you can control, and to suppress the boxplot's legend altogether)
library(ggplot2)
p <- ggplot() + geom_point(data=diamonds, aes(x=cut, y=mean(depth), color=clarity), shape=15, size=5)
p <- p + guides(color=guide_legend(title=NULL))
p <- p + theme(legend.key = element_blank())
p <- p + geom_boxplot(data=diamonds,aes(x=cut,fill=factor(clarity),y=depth)) + guides(fill=FALSE)
p
Also check out Hadley's Legend-Attributes page on github