Draw vegan graph on ggplot - r

I am fairly new to vegan and ggplot, I have drawn a species diversity plot in vegan. Ggplot has better graph so I was wondering if these codes could be modified to ggplot code.
Any help would be greatly appreciated. I am using bray in vegan.
library(vegan)
library(mass)
data <- read.table("data.txt", header = T)
attach(data)
rownames(data) <- c("TCI1", "TCI2", "TCI3", "TCII1", "TCII2", "TCII3", "TCIII1", "TCIII2", "TCIII3", "TCIV1", "TCIV2", "TCIV3",
"NCI1", "NCI2", "NCI3", "NCII1", "NCII2", "NCII3", "NCIII1", "NCIII2", "NCIII3", "NCIV1", "NCIV2", "NCIV3","TFI1", "TFI2", "TFI3", "TFII1", "TFII2", "TFII3", "TFIII1", "TFIII2", "TFIII3", "TFIV1", "TFIV2", "TFIV3",
"NFI1", "NFI2", "NFI3", "NFII1", "NFII2", "NFII3", "NFIII1", "NFIII2", "NFIII3", "NFIV1", "NFIV2", "NFIV3")
bcdist <- vegdist(data, "bray")
bcmds <- isoMDS(bcdist, k = 2)
plot(bcmds$points, type = "n", xlab = "", ylab = "")
text(bcmds$points, dimnames(data)[[1]])

You can indeed create a plot that looks like the imgur image. First I created some made-up data for your weeds. Then I called ggplot2 and put the weed names at the points, but made the points transparent.
x <- seq(from = -1, to = 1, .025)
df <- data.frame(valuesX = sample(x, size = 48, replace = TRUE),
valuesY = sample(x, size = 48, replace = TRUE),
seeds = c("TCI1", "TCI2", "TCI3", "TCII1", "TCII2", "TCII3", "TCIII1", "TCIII2", "TCIII3", "TCIV1", "TCIV2", "TCIV3",
"NCI1", "NCI2", "NCI3", "NCII1", "NCII2", "NCII3", "NCIII1", "NCIII2", "NCIII3", "NCIV1", "NCIV2", "NCIV3","TFI1", "TFI2", "TFI3", "TFII1", "TFII2", "TFII3", "TFIII1", "TFIII2", "TFIII3", "TFIV1", "TFIV2", "TFIV3",
"NFI1", "NFI2", "NFI3", "NFII1", "NFII2", "NFII3", "NFIII1", "NFIII2", "NFIII3", "NFIV1", "NFIV2", "NFIV3")
)
ggplot(df, aes(x = valuesX, y = valuesY)) +
geom_point(colour = "transparent") +
geom_text(data = df, aes(label = seeds), hjust = 1.5) +
theme_bw() +
labs(x = "Your axis label", y = "", title = "Weed Distribution") +
theme(axis.ticks= element_blank()) +
theme(plot.title = element_text(face = "bold", size = 12))
You can adjust all the elements of the plot as you see fit.

Related

Annotation label won't show when passed as a grob in annotation_custom in r (also trying to put it at the bottom right corner)

I am trying to automatically put a custom annotation in the bottom right corner of a plot no matter the actual axes range.
I have tried to do so with annotate from ggplot2 but it just didn't work.
I am trying to work with annotation_custom from the grid package instead.
My code is long so I won't post all of it here, but rather the main problematic lines imo:
EDIT: I am adding a small dataframe for reproducibility
df <- data.frame(col.a = c(1:5), col.b = c(23.3,5.2,61.0,9.0,3.25))
# correlation calculation
cor.result = df %>% cor.test(col.a, col.b,
method = "spearman",
na.action=na.omit,
exact = FALSE)
corr.label <- sprintf("r = %.3f\np = %g\n%s", cor.result$estimate,
cor.result$p.value, "spearman")
The result is something like:
"r = -0.853\np = 0.003\nspearman"
Then I create a plot:
ttl = "Scatter Plot" # The title and subtitles are different in my code.
sub.ttl = "sample id: patient zero"
p <- df %>% ggplot(aes(x = col.a, y = col.b) +
geom_smooth(color = "steelblue3", method = lm, formula = y ~ x) +
geom_abline(aes(intercept=0, slope=1), color = 'grey45') +
geom_point(color = "steelblue4", alpha = 0.5, size = 3) +
labs(x = "HUMANnN2", y = "HUMAnN3",
title = ttl,
subtitle = sub.ttl) +
theme(text = element_text(size = 12),
plot.title = element_text(hjust = 0.5, size = 16),
plot.subtitle = element_text(hjust = 0.5, size = 14))
And try to add an annotation:
grob <- grobTree(textGrob(label = corr.label, x = 0.8, y = 0.3))
p <- p + annotation_custom(grob)
The result is as follows:
I did manage to add an annotation at the upper left corner with:
p <- p + annotation_custom(corr.label)
Which gives:
Yes, it has to be at the bottom right corner.
The annotation does show up when I switch corr.label with just a string of "hello". My guess is that grob doesn't pass newline characters accordingly.

stat_function not transitioning over transition_states

I'm trying to write my own Central Limit Theorem demonstration using ggplot2 and am unable to get my stat_function to display a changing normal distribution.
below is my code, I want the normal distribution in stat_function to transition through different states; specifically, I'm hoping for it to change the standard deviation to correspond with each value in dataset. Any help would be greatly appreciated.
#library defs
library(gganimate)
library(ggplot2)
library(transformr)
#initialization for distribution, rolls, and vectors
k = 2
meanr = 1/k
sdr = 1/k
br = sdr/10
rolls <- 200
avg <- 1
dataset <- 1
s <- 1
#loop through to create vectors of sample statistics from 200 samples of size i
#avg is sample average, s is standard deviations of sample means, and dataset is the indexes to run the transition states
for (i in c(1:40)){
for (j in 1:rolls){
avg <- c(avg,mean(rexp(i,k)))
}
dataset <- c(dataset, rep(i,rolls))
s <- c(s,rep(sdr/sqrt(i),rolls))
}
#remove initialized vector information as it was only created to start loops
avg <- avg[-1]
rn <- rn[-1]
dataset <- dataset[-1]
s <- s[-1]
#dataframe
a <- data.frame(avgf=avg, rnf = rn,datasetf = dataset,sf = s)
#plot histogram, density function, and normal distribution
ggplot(a,aes(x=avg,y=s))+
geom_histogram(aes(y = ..density..), binwidth = br,fill='beige',col='black')+
geom_line(aes(y = ..density..,colour = 'Empirical'),lwd=2, stat = 'density') +
stat_function(fun = dnorm, aes(colour = 'Normal', y = s),lwd=2,args=list(mean=meanr,sd = mean(s)))+
scale_y_continuous(labels = scales::percent_format()) +
scale_color_discrete(name = "Densities", labels = c("Empirical", "Normal"))+
labs(x = 'Sample Average',title = 'Sample Size: {closest_state}')+
transition_states(dataset,4,4)+ view_follow(fixed_x = TRUE)
I think it's difficult to use stat_function here because the dnorm function that you are passing includes a grouped variable (mean(s)). There is no way to indicate that you wish to group s by the dataset column, and the transition_states function doesn't filter the whole data frame. You could use transition_filter to filter the whole data frame, but this would be laborious.
It's not much work to just add a dnorm to your input data frame and plot it as a line, particularly since the rest of your code can be simplified substantially. Here's a fully reproducible example:
library(gganimate)
library(ggplot2)
library(transformr)
k <- 2
meanr <- sdr <- 1/k
br <- sdr/10
rolls <- 200
a <- do.call(rbind, lapply(1:40, function(i){
data.frame(avg = replicate(rolls, mean(rexp(i, k))),
dataset = rep(i, rolls),
x = seq(0, 2, length.out = rolls),
s = dnorm(seq(0, 2, length.out = rolls),
meanr, sdr/sqrt(i))) }))
ggplot(a, aes(x = avg, group = dataset)) +
geom_histogram(aes(y = ..density..), fill = 'beige',
colour = "black", binwidth = br) +
geom_line(aes(y = ..density.., colour = 'Empirical'),
lwd = 2, stat = 'density', alpha = 0.5) +
geom_line(aes(x = x, y = s, colour = "Normal"), size = 2, alpha = 0.5) +
scale_y_continuous(labels = scales::percent_format()) +
coord_cartesian(xlim = c(0, 2)) +
scale_color_discrete(name = "Densities", labels = c("Empirical", "Normal")) +
labs(x = 'Sample Average', title = 'Sample Size: {closest_state}') +
transition_states(dataset, 4, 4) +
view_follow(fixed_x = TRUE, fixed_y = TRUE)

How to get ggplot2 geom_contour to replicate base graphics contour

I am using a copula to look at the probability of occurrence of events based on duration and magnitude of the events. I can create contours for recurrence intervals with observed and simulated data in base R graphics, but I can't figure out how to reproduce in ggplot2. Why not just produce the graphs in base graphics and move on you may be wondering? Because I'm including the graphs in a short summary report and want to have consistency with numerous other graphs in the report. Below is some example code. I know that using the location, scale, and shape for the GEV distribution to create random deviates to get the same distribution from is not ideal, but it is the best way I could think of to create a somewhat reproducible example, despite the poor correlation at the end. In base R, the contours are generated from a matrix of simulated data. Is this possible in ggplot2?
library(evd)
library(copula)
dur <- rgev(500, 2.854659, 2.170122, -0.007829)
mag <- rgev(500, 0.02482, 0.01996, 0.04603)
fDurGev <- fgev(dur)
fMagGev <- fgev(mag)
durVec <- dgev(dur, fDurGev[[1]][1], fDurGev[[1]][2], fDurGev[[1]][3])
magVec <- dgev(mag, fMagGev[[1]][1], fMagGev[[1]][2], fMagGev[[1]][3])
durMagMat <- as.matrix(cbind(duration = durVec, magnitude = magVec))
theta <- coef(fitCopula(claytonCopula(dim = 2), durMagMat, method = "itau"))
clayCop <- claytonCopula(theta, dim = 2)
fCopDurMag <- pCopula(durMagMat, clayCop)
copPts <- data.frame(duration = dur, magnitude = mag, copNEP = fCopDurMag,
copEP = (1 - fCopDurMag), copRI = (1 / fCopDurMag))
fSim <- seq(0.05, 0.99998, length.out = 1000)
quaDur <- qgev(fSim, fDurGev[[1]][1], fDurGev[[1]][2], fDurGev[[1]][3])
quaMag <- qgev(fSim, fMagGev[[1]][1], fMagGev[[1]][2], fMagGev[[1]][3])
expDurMagMat <- cbind(expand.grid(fSim, fSim)$Var1, expand.grid(fSim,
fSim)$Var2)
simPred <- pCopula(expDurMagMat, clayCop)
simPredMat <- matrix(simPred, 1000, 1000)
simDF <- data.frame(simDur = quaDur, simMag = quaMag, simPredMat)
rndPred <- data.frame(rCopula(5000, clayCop))
rndPred$rndDur <- qgev(rndPred[,1], fDurGev[[1]][1], fDurGev[[1]][2],
fDurGev[[1]][3])
rndPred$rndMag <- qgev(rndPred[,2], fMagGev[[1]][1], fMagGev[[1]][2],
fMagGev[[1]][3])
RI <- c(1.25, 2 ,5, 10, 20, 50, 100, 200, 500)
NEP <- 1 - (1 / RI)
plot(rndPred$rndDur, rndPred$rndMag, col = "light grey", cex = 0.5, xlab =
"Duration (time)", ylab = "Magnitude (x)")
points(copPts[,1], copPts[,2], col = "red", cex = 0.5)
contour(simDF$simDur, simDF$simMag, simPredMat, levels = NEP, labels = RI,
xaxs = 'i', yaxs = 'i', labcex = 0.6, lwd = 1, col = "black", add =
TRUE, method = "flattest", vfont = c("sans serif", "plain"))
And now for my attempt to recreate in ggplot2 (which fails to draw contours).
library(dplyr)
simDF <- data.frame(dur = expDurMagMat[, 1], mag = expDurMagMat[, 2], NEP = simPred)
simDF <- simDF %>%
dplyr::mutate(quaDur = qgev(NEP, fDurGev[[1]][1], fDurGev[[1]][2], fDurGev[[1]][3])) %>%
dplyr::mutate(quaMag = qgev(NEP, fMagGev[[1]][1], fMagGev[[1]][2], fMagGev[[1]][3]))
library(ggplot2)
ggplot(data = rndPred, aes(x = rndDur, y = rndMag)) +
geom_point(color = "light grey", alpha = 0.5) +
labs(x = "Duration (time)", y = "Magnitude (x)") +
geom_point(data = copPts, aes(x = duration, y = magnitude),
color = "red") +
geom_contour(data = simDF, aes(x = quaDur, y = quaMag, z = NEP),
inherit.aes = FALSE, breaks = NEP) +
theme_classic()
Thank you to anyone who can help.

How can I add annotation in ggplotly animation?

I am creating animated plotly graph for my assignment in r, where I am comparing several models with various number of observations. I would like to add annotation showing what is the RMSE of the current model - this means I would like to have text that changes together with slider. Is there any easy way how to do that?
Here is my dataset stored on GitHub. There already is created variable with RMSE: data
The base ggplot graphic is as follows:
library(tidyverse)
library(plotly)
p <- ggplot(values_predictions, aes(x = x)) +
geom_line(aes(y = preds_BLR, frame = n, colour = "BLR")) +
geom_line(aes(y = preds_RLS, frame = n, colour = "RLS")) +
geom_point(aes(x = x, y = target, frame = n, colour = "target"), alpha = 0.3) +
geom_line(aes(x = x, y = sin(2 * pi * x), colour = "sin(2*pi*x)"), alpha = 0.3) +
ggtitle("Comparison of performance) +
labs(y = "predictions and targets", colour = "colours")
This is converted to plotly, and I have added an animation to the Plotly graph:
plot <- ggplotly(p) %>%
animation_opts(easing = "linear",redraw = FALSE)
plot
Thanks!
You can add annotations to a ggplot graph using the annotate function: http://ggplot2.tidyverse.org/reference/annotate.html
df <- data.frame(x = rnorm(100, mean = 10), y = rnorm(100, mean = 10))
# Build model
fit <- lm(x ~ y, data = df)
# function finds RMSE
RMSE <- function(error) { sqrt(mean(error^2)) }
library(ggplot2)
ggplot(df, aes(x, y)) +
geom_point() +
annotate("text", x = Inf, y = Inf, hjust = 1.1, vjust = 2,
label = paste("RMSE", RMSE(fit$residuals)) )
There seems to be a bit of a problem converting between ggplot and plotly. However this workaround here shows a workaround which can be used:
ggplotly(plot) %>%
layout(annotations = list(x = 12, y = 13, text = paste("RMSE",
RMSE(fit$residuals)), showarrow = F))
Here's an example of adding data dependent text using the built in iris dataset with correlation as text to ggplotly.
library(plotly)
library(ggplot2)
library(dplyr)
mydata = iris %>% rename(variable1=Sepal.Length, variable2= Sepal.Width)
shift_right = 0.1 # number from 0-1 where higher = more right
shift_down = 0.02 # number from 0-1 where higher = more down
p = ggplot(mydata, aes(variable1,variable2))+
annotate(geom = "text",
label = paste0("Cor = ",as.character(round(cor.test(mydata$variable1,mydata$variable2)$estimate,2))),
x = min(mydata$variable1)+abs(shift_right*(min(mydata$variable1)-max(mydata$variable1))),
y = max(mydata$variable2)-abs(shift_down*(min(mydata$variable2)-max(mydata$variable2))), size=4)+
geom_point()
ggplotly(p) %>% style(hoverinfo = "none", traces = 1) # remove hover on text

combine barplot and grid.table

# I am trying to combine a horizontal beside barplot with the table
# with the values in it.
# E.g. original table, including sample_ids
df = data.frame(
sample_id=c("s01","s02","s03","s04","s05","s06","s07","s08","s09","s10"),
one=runif(10,0,10),
two=runif(10,0,10),
three=runif(10,0,10),
four=runif(10,0,10)
)
# I created a mydata that I then do barplot as matrix
mydata = data.frame(
one=df$one,
two=df$two,
three=df$three,
four=df$four
)
# Plotted, using rainbow colouring, with a legend in the top right
barplot(as.matrix(mydata),horiz=TRUE,beside=TRUE,col=rainbow(length(df$sample_id)), legend=paste(df$sample_id), args.legend = list(x = "topright", bty = "n"),xlim=c(0,20))
# Now I would like the grid.table to be on the bottom right, ideally with the same order and colouring as the legend
library(gridExtra)
grid.table(df)
# Any ideas?
# EDIT: also tried addtable2plot from plotrix, with no much success
bp = barplot(as.matrix(mydata),horiz=TRUE,beside=TRUE,col=rainbow(length(df$sample_id)), legend=paste(df$sample_id), args.legend = list(x = "topright", bty = "n"),xlim=c(0,20))
library(plotrix)
addtable2plot(bp, y=0, df,cex=0.3)
The other option would be to turn the barplot into a ggplot geom_bar, but I struggled to do it for more than 2 columns.
Here's one way to do it using addtable2plot of plotrix package. It allows you to use the legend positions such as "bottomright"
df = data.frame(
sample_id=c("s01","s02","s03","s04","s05","s06","s07","s08","s09","s10"),
one=runif(10,0,10),
two=runif(10,0,10),
three=runif(10,0,10),
four=runif(10,0,10)
)
mydata = data.frame(
one=df$one,
two=df$two,
three=df$three,
four=df$four
)
library(plotrix)
dev.off()
windows(width = 8, height = 6)
df$one = round(df$one,2)
df$two = round(df$two,2)
df$three = round(df$three,2)
df$four = round(df$four,2)
barplot(as.matrix(mydata),horiz=TRUE,beside=TRUE,col=rainbow(length(df$sample_id)),
legend=paste(df$sample_id),
args.legend = list(x = "topright", bty = "n", cex = 1),
xlim=c(0,20))
addtable2plot("bottomright",table = df, cex = .9, bty = "o",
bg = c("white","grey"), vlines = TRUE, xpad = .25)
If you want to make the barplot in ggplot2, you need to reshape your data into long format. Based on your example data, the following code:
library(ggplot2)
library(gridExtra)
library(reshape2)
bp <- ggplot(melt(df, id.vars = 1),
aes(x = variable, y = value, fill = sample_id)) +
geom_bar(stat = 'identity', position = 'dodge') +
scale_fill_manual(values = rainbow(10)) +
labs(x = NULL, y = NULL) +
coord_flip() +
theme_minimal(base_size = 14)
gt <- tableGrob(df, rows = NULL, theme = ttheme_minimal())
grid.arrange(bp, gt, ncol = 2, widths = c(2.5,2))
which gives the following result:

Resources