Skip to content

fix issue when df_pw is a vector #29

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.

Sign up for GitHub

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

Open
guokai8 wants to merge 6 commits into
base: master
Choose a base branch
from
Open

fix issue when df_pw is a vector #29

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
6 commits
Select commit Hold shift + click to select a range
d44ea0b
fix issue when df_pw is a vector
guokai8 Feb 27, 2019
0242f43
fix issue when grouping_column is not a factor
guokai8 Feb 27, 2019
3573c81
Update plot_anova_diversity.R
guokai8 Mar 30, 2019
0a32e79
Update plot_anova_diversity.R
guokai8 Aug 2, 2019
bfd9851
Create biplot.R
guokai8 Aug 2, 2019
bc22d84
Update DESCRIPTION
guokai8 Sep 23, 2020
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 2 additions & 0 deletions DESCRIPTION
View file
Open in desktop
Original file line number Diff line number Diff line change
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
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -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
View file
Open in desktop
Original file line number Diff line number Diff line change
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
View file
Open in desktop
Original file line number Diff line number Diff line change
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