Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

fix issue when df_pw is a vector #29

Open
wants to merge 6 commits into
base: master
Choose a base branch
from
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Jump to
Jump to file
Failed to load files.
Diff view
Diff view
2 changes: 2 additions & 0 deletions DESCRIPTION
Expand Up @@ -18,6 +18,8 @@ Imports: igraph (>= 1.1.2),
reshape2 (>= 1.4.2),
gtable (>= 0.2.0),
ggplot2 (>= 2.2.1),
impute,
adespatial,
gridExtra (>= 2.2.1)
Suggests: R.rsp
VignetteBuilder: R.rsp
Expand Down
35 changes: 35 additions & 0 deletions R/biplot.R
@@ -0,0 +1,35 @@
biplot<-function(phy,color=NULL,shape=NULL,top=10,pointsize=5,alpha=0.7,taxa="Phylum",ellipse=FALSE,biplot=TRUE,show=TRUE){
###c("edgernorm", "varstab", "randomsubsample", "proportion", "relative", "log-relative", "scale")
#plog<-normalise_data(phy,norm.method = "relative")
plog=transform_sample_counts(phy,function(x)x/sum(x))
#plog=transform_sample_counts(phy,function(x)log(x+1))
pord<- ordinate(plog, method = "MDS", distance = "bray")
p<-plot_ordination(plog, pord, color = color,type="samples",shape=shape) +geom_point(size=pointsize,alpha=alpha,aes_string(shape=shape))+theme_light(base_size = 15)+
scale_color_brewer(type="qual", palette="Set1")
p1<-plot_ordination(plog, pord,type="taxa",shape=taxa) +geom_point(size=pointsize,alpha=alpha,aes_string(shape=shape))+theme_light(base_size = 15)+
scale_color_brewer(type="qual", palette="Set2")
pp<-p1$data
ll=gsub('.*;','',gsub(';NA','',apply(pp[3:ncol(pp)],1,function(x)paste(x,collapse =";"))))
if(show==FALSE){
lx=rownames(pp)
}else{
lx<-paste(rownames(pp),ll,sep="\n")
}
pp$labels=lx
pp$dist=p1$data[,1]^2+p1$data[,2]^2
pp=pp[order(pp$dist,decreasing = T),]
pp=pp[1:top,]
arrowhead = arrow(length = unit(0.02, "npc"))
p2<-p+geom_segment(aes(xend=1.3*Axis.1,yend=1.3*Axis.2,x=0,y=0),size=0.5,color="darkgray",arrow=arrowhead,data=pp)+
geom_text_repel(aes(x=1.3*Axis.1,y=1.3*Axis.2,label=labels),color="black",data=pp,show.legend = FALSE)+scale_color_brewer(type="qual", palette="Set1")
if(ellipse==TRUE){
p2<-p2+stat_ellipse()
}
if(biplot==FALSE){
p3<-p
}else{
p3<-p2
}
p3$layers<-p3$layers[-1]
p3
}
3 changes: 3 additions & 0 deletions R/perform_anova.R
Expand Up @@ -70,6 +70,9 @@ perform_anova <- function(df,meta_table,grouping_column,pValueCutoff){
}
}
if(!is.null(df_pw)){
if(is.null(dim(df_pw)[1])){
df_pw<-rbind(df_pw)
}
df_pw<-data.frame(row.names=NULL,df_pw)
names(df_pw)<-c("measure","from","to","y","p")
}
Expand Down
76 changes: 49 additions & 27 deletions R/plot_anova_diversity.R
Expand Up @@ -26,38 +26,60 @@
#' @export plot_anova_diversity
#'

plot_anova_diversity <- function(physeq, method, grouping_column,pValueCutoff=0.05)
plot_anova_diversity<-function (physeq, method, grouping_column, color = NULL, pValueCutoff = 0.05,
fontsize.x = 10, fontsize.y = 10, fill = NULL)
{
#enforce orientation
if(taxa_are_rows(physeq)){
if (taxa_are_rows(physeq)) {
physeq <- t(physeq)
}
abund_table <- otu_table(physeq)
meta_table <- sample_data(physeq)

#get diversity measure using selected methods
div.df <- alpha_div(physeq,method)

#=add grouping information to alpha diversity measures
df<-data.frame(div.df,(meta_table[,grouping_column])[as.character(div.df$sample),])

#perform anova of diversity measure between groups
anova_res <- perform_anova(df,meta_table,grouping_column,pValueCutoff)
df_pw <- anova_res$df_pw #get pairwise p-values

#Draw the boxplots
p<-ggplot(aes_string(x=grouping_column,y="value",color=grouping_column),data=df)
p<-p+geom_boxplot()+geom_jitter(position = position_jitter(height = 0, width=0))
p<-p+theme_bw()
p<-p+theme(axis.text.x = element_text(angle = 90, hjust = 1))
p<-p+facet_wrap(~measure,scales="free_y",nrow=1)+ylab("Observed Values")+xlab("Samples")
p<-p+theme(strip.background = element_rect(fill = "white"))+xlab("Groups")

#This loop will generate the lines and signficances
if(!is.null(df_pw)){ #this only happens when we have significant pairwise anova results
for(i in 1:dim(df_pw)[1]){
p<-p+geom_path(inherit.aes=F,aes(x,y),data = data.frame(x = c(which(levels(df[,grouping_column])==as.character(df_pw[i,"from"])),which(levels(df[,grouping_column])==as.character(df_pw[i,"to"]))), y = c(as.numeric(as.character(df_pw[i,"y"])),as.numeric(as.character(df_pw[i,"y"]))), measure=c(as.character(df_pw[i,"measure"]),as.character(df_pw[i,"measure"]))), color="black",lineend = "butt",arrow = arrow(angle = 90, ends = "both", length = unit(0.1, "inches")))
p<-p+geom_text(inherit.aes=F,aes(x=x,y=y,label=label),data=data.frame(x=(which(levels(df[,grouping_column])==as.character(df_pw[i,"from"]))+which(levels(df[,grouping_column])==as.character(df_pw[i,"to"])))/2,y=as.numeric(as.character(df_pw[i,"y"])),measure=as.character(df_pw[i,"measure"]),label=as.character(cut(as.numeric(as.character(df_pw[i,"p"])),breaks=c(-Inf, 0.001, 0.01, 0.05, Inf),label=c("***", "**", "*", "")))))
div.df <- alpha_div(physeq, method)
df <- data.frame(div.df, (meta_table[, grouping_column])[as.character(div.df$sample),
])
df[, grouping_column] <- as.factor(df[, grouping_column])
anova_res <- perform_anova(df, meta_table, grouping_column,
pValueCutoff)
df_pw <- anova_res$df_pw
if (is.null(color)) {
color = grouping_column
}
p <- ggplot(aes_string(x = grouping_column, y = "value",
color = color), data = df)
if (!is.null(fill)) {
p <- p + geom_boxplot(aes_string(fill = fill)) + geom_point(aes_string(shape=fill))
}
else {
p <- p + geom_boxplot() + geom_point(aes_string(shape=color))
}
p <- p + theme_bw()
p <- p + theme(axis.text.x = element_text(angle = 90, hjust = 1,
size = fontsize.x))
p <- p + theme(axis.text.y = element_text(size = fontsize.y))
p <- p + facet_wrap(~measure, scales = "free_y", nrow = 1) +
ylab("Observed Values") + xlab("Samples")
p <- p + theme(strip.background = element_rect(fill = "white")) +
xlab("Groups")
if (!is.null(df_pw)) {
for (i in 1:dim(df_pw)[1]) {
p <- p + geom_path(inherit.aes = F, aes(x, y), data = data.frame(x = c(which(levels(df[,
grouping_column]) == as.character(df_pw[i, "from"])),
which(levels(df[, grouping_column]) == as.character(df_pw[i,
"to"]))), y = c(as.numeric(as.character(df_pw[i,
"y"])), as.numeric(as.character(df_pw[i, "y"]))),
measure = c(as.character(df_pw[i, "measure"]),
as.character(df_pw[i, "measure"]))), color = "black",
lineend = "butt", arrow = arrow(angle = 90, ends = "both",
length = unit(0.1, "inches")))
p <- p + geom_text(inherit.aes = F, aes(x = x, y = y,
label = label), data = data.frame(x = (which(levels(df[,
grouping_column]) == as.character(df_pw[i, "from"])) +
which(levels(df[, grouping_column]) == as.character(df_pw[i,
"to"])))/2, y = as.numeric(as.character(df_pw[i,
"y"])), measure = as.character(df_pw[i, "measure"]),
label = as.character(cut(as.numeric(as.character(df_pw[i,
"p"])), breaks = c(-Inf, 0.001, 0.01, 0.05,
Inf), label = c("***", "**", "*", "")))))
}
}
return(p)
Expand Down