From d44ea0b598caddc936a884323d77fa955f03c854 Mon Sep 17 00:00:00 2001 From: bioguo Date: Wed, 27 Feb 2019 10:51:46 -0600 Subject: [PATCH 1/6] fix issue when df_pw is a vector --- R/perform_anova.R | 3 +++ 1 file changed, 3 insertions(+) diff --git a/R/perform_anova.R b/R/perform_anova.R index e376709..3cb7b19 100644 --- a/R/perform_anova.R +++ b/R/perform_anova.R @@ -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") } From 0242f438878805aefa910cf921fb9a4f4f078255 Mon Sep 17 00:00:00 2001 From: bioguo Date: Wed, 27 Feb 2019 11:01:42 -0600 Subject: [PATCH 2/6] fix issue when grouping_column is not a factor --- R/plot_anova_diversity.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/plot_anova_diversity.R b/R/plot_anova_diversity.R index f011027..a7a0078 100644 --- a/R/plot_anova_diversity.R +++ b/R/plot_anova_diversity.R @@ -40,7 +40,7 @@ plot_anova_diversity <- function(physeq, method, grouping_column,pValueCutoff=0. #=add grouping information to alpha diversity measures df<-data.frame(div.df,(meta_table[,grouping_column])[as.character(div.df$sample),]) - + df[,grouping_column]<-as.factor(df[,grouping_column]) #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 From 3573c81cf687e42daa7abdd3179b39f719d7582b Mon Sep 17 00:00:00 2001 From: bioguo Date: Sat, 30 Mar 2019 18:51:02 -0500 Subject: [PATCH 3/6] Update plot_anova_diversity.R --- R/plot_anova_diversity.R | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) diff --git a/R/plot_anova_diversity.R b/R/plot_anova_diversity.R index a7a0078..63e56fb 100644 --- a/R/plot_anova_diversity.R +++ b/R/plot_anova_diversity.R @@ -26,7 +26,7 @@ #' @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)){ @@ -44,12 +44,19 @@ plot_anova_diversity <- function(physeq, method, grouping_column,pValueCutoff=0. #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 - + if(is.null(color)){ + color=grouping_column + } #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<-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_jitter(position = position_jitter(height = 0, width=0)) + }else{ + 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+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") From 0a32e793aac38e749ff0810033c22d71b4e53d00 Mon Sep 17 00:00:00 2001 From: bioguo Date: Fri, 2 Aug 2019 13:21:42 -0500 Subject: [PATCH 4/6] Update plot_anova_diversity.R --- R/plot_anova_diversity.R | 83 ++++++++++++++++++++++++---------------- 1 file changed, 49 insertions(+), 34 deletions(-) diff --git a/R/plot_anova_diversity.R b/R/plot_anova_diversity.R index 63e56fb..26c6324 100644 --- a/R/plot_anova_diversity.R +++ b/R/plot_anova_diversity.R @@ -26,45 +26,60 @@ #' @export plot_anova_diversity #' -plot_anova_diversity <- function(physeq, method, grouping_column,color=NULL,pValueCutoff=0.05,fontsize.x=10,fontsize.y=10,fill=NULL) +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),]) - df[,grouping_column]<-as.factor(df[,grouping_column]) - #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 - if(is.null(color)){ - color=grouping_column - } - #Draw the boxplots - 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_jitter(position = position_jitter(height = 0, width=0)) - }else{ - 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,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") - - #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) From bfd98519df92974fdd92fedcb76959e2d1b1f632 Mon Sep 17 00:00:00 2001 From: bioguo Date: Fri, 2 Aug 2019 13:22:23 -0500 Subject: [PATCH 5/6] Create biplot.R --- R/biplot.R | 35 +++++++++++++++++++++++++++++++++++ 1 file changed, 35 insertions(+) create mode 100644 R/biplot.R diff --git a/R/biplot.R b/R/biplot.R new file mode 100644 index 0000000..c8a66ca --- /dev/null +++ b/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 +} From bc22d84c9ab414371fd908eee438f1ba5742899a Mon Sep 17 00:00:00 2001 From: bioguo Date: Wed, 23 Sep 2020 09:00:48 -0400 Subject: [PATCH 6/6] Update DESCRIPTION --- DESCRIPTION | 2 ++ 1 file changed, 2 insertions(+) diff --git a/DESCRIPTION b/DESCRIPTION index 205750c..ac05905 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -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