## ----include = FALSE---------------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ## ----install------------------------------------------------------------------ # install.packages("ecoregime") # devtools::install_github(repo = "MSPinillos/ecoregime", dependencies = T, build_vignettes = T) ## ----setup-------------------------------------------------------------------- library(ecoregime) ## ----citation----------------------------------------------------------------- citation("ecoregime") ## ----data--------------------------------------------------------------------- # ID of the sampling units and observations ID_sampling <- LETTERS[1:10] ID_obs <- 1:3 # Define initial species abundances set.seed(123) initial <- data.frame(sampling_units = ID_sampling, sp1 = round(runif(10), 2), sp2 = round(runif(10), 2)) # Define the parameters for the Lotka-Volterra model parms <- c(r1 = 1, r2 = 0.1, a11 = 0.02, a21 = 0.03, a22 = 0.02, a12 = 0.01) # We can use primer and deSolve to run the simulations library(primer) simulated_abun <- lapply(1:nrow(initial), function(isampling){ # Initial abundance in the sampling unit i initialN <- c(initial$sp1[isampling], initial$sp2[isampling]) # Simulate community dynamics simulated_abun <- data.frame(ode(y = initialN, times = ID_obs, func = lvcomp2, parms = parms)) # Add the names of the sampling units simulated_abun$sampling_unit <- ID_sampling[isampling] # Calculate relative abundances simulated_abun$sp1 <- simulated_abun$X1/rowSums(simulated_abun[, 2:3]) simulated_abun$sp2 <- simulated_abun$X2/rowSums(simulated_abun[, 2:3]) return(simulated_abun[, c("sampling_unit", "time", "sp1", "sp2")]) }) # Compile species abundances of all sampling units in the same data frame abundance <- do.call(rbind, simulated_abun) ## ----abundance---------------------------------------------------------------- head(abundance) ## ----state_dissim------------------------------------------------------------- # Generate a matrix containing dissimilarities between states state_dissim <- vegan::vegdist(abundance[, c("sp1", "sp2")], method = "bray") as.matrix(state_dissim)[1:6, 1:6] ## ----state_mds, fig = TRUE, fig.height = 5, fig.width = 5, fig.align = "center"---- # Multidimensional scaling state_mds <- smacof::smacofSym(state_dissim, ndim = 2) state_mds <- data.frame(state_mds$conf) # Define different colors for each trajectory traj.colors <- RColorBrewer::brewer.pal(10, "Paired") # Plot the distribution of the states in the state space plot(state_mds$D1, state_mds$D2, col = rep(traj.colors, each = 3), # use different colors for each sampling unit pch = rep(ID_sampling, each = 3), # use different symbols for each sampling unit xlab = "Axis 1", ylab = "Axis 2", main = "State space") ## ----traj_state_mds, fig = TRUE, fig.height = 5, fig.width = 5, fig.align = "center"---- ## -->> This code shows you the process step by step. You could directly use ## -->> ecotraj::trajectoryPlot() # Plot the distribution of the states in the state space plot(state_mds$D1, state_mds$D2, col = rep(traj.colors, each = 3), # use different colors for each sampling unit pch = rep(ID_sampling, each = 3), # use different symbols for each sampling unit xlab = "Axis 1", ylab = "Axis 2", main = "State space") # Link trajectory states in chronological order for (isampling in seq(1, 30, 3)) { # From observation 1 to observation 2 shape::Arrows(state_mds[isampling, 1], state_mds[isampling, 2], state_mds[isampling + 1, 1], state_mds[isampling + 1, 2], col = traj.colors[1+(isampling-1)/3], arr.adj = 1) # From observation 2 to observation 3 shape::Arrows(state_mds[isampling + 1, 1], state_mds[isampling + 1, 2], state_mds[isampling + 2, 1], state_mds[isampling + 2, 2], col = traj.colors[1+(isampling-1)/3], arr.adj = 1) } ## ----traj_dissim, fig = TRUE, fig.height = 5, fig.width = 5, fig.align = "center"---- # Generate a matrix containing dissimilarities between trajectories traj_dissim <- ecotraj::trajectoryDistances( ecotraj::defineTrajectories(state_dissim, sites = rep(ID_sampling, each = 3), surveys = rep(ID_obs, 10)), distance.type = "DSPD" ) as.matrix(traj_dissim)[1:6, 1:6] ## ----traj_mds, fig = TRUE, fig.height = 5, fig.width = 5, fig.align = "center"---- # Multidimensional scaling traj_mds <- smacof::smacofSym(traj_dissim, ndim = 2) traj_mds <- data.frame(traj_mds$conf) # Plot the distribution of the trajectories in the trajectory space plot(traj_mds$D1, traj_mds$D2, col = traj.colors, # use different colors for each sampling unit pch = ID_sampling, # use different symbols for each sampling unit xlab = "Axis 1", ylab = "Axis 2", main = "Trajectory space") ## ----sp_variation, fig = TRUE, fig.height = 5, fig.width = 5, fig.align = "center"---- # Plot species abundances over time plot(abundance$time, abundance$sp1, type = "n", ylim = c(-0.01, 1), xlab = "Observation", ylab = "Species abundance", main = "Temporal variation in species composition") for (i in seq_along(ID_sampling)) { points(abundance[which(abundance$sampling_unit == ID_sampling[i]), ]$time, abundance[which(abundance$sampling_unit == ID_sampling[i]), ]$sp1, col = traj.colors[i], pch = ID_sampling[i]) lines(abundance[which(abundance$sampling_unit == ID_sampling[i]), ]$time, abundance[which(abundance$sampling_unit == ID_sampling[i]), ]$sp1, col = "black", pch = ID_sampling[i]) points(abundance[which(abundance$sampling_unit == ID_sampling[i]), ]$time, abundance[which(abundance$sampling_unit == ID_sampling[i]), ]$sp2, col = traj.colors[i], pch = ID_sampling[i]) lines(abundance[which(abundance$sampling_unit == ID_sampling[i]), ]$time, abundance[which(abundance$sampling_unit == ID_sampling[i]), ]$sp2, col = "red", pch = ID_sampling[i], lty = 2) } legend("bottomleft", legend = c("sp1", "sp2"), col = 1:2, lty = 1:2, bg = "white") ## ----------------------------------------------------------------------------- # Correlation of the first axis of the state space with the abundance of sp1 cor(state_mds$D1, abundance$sp1) # Correlation of the first axis of the state space with the abundance of sp2 cor(state_mds$D1, abundance$sp2) ## ----RETRA-EDR---------------------------------------------------------------- # Use set.seed to obtain reproducible results of the segment space in RETRA-EDR set.seed(123) # Apply RETRA-EDR repr_traj <- retra_edr(d = state_dissim, trajectories = rep(ID_sampling, each = 3), states = rep(ID_obs, 10), minSegs = 2) ## ----retra_summary------------------------------------------------------------ summary(repr_traj) ## ----retra_segments----------------------------------------------------------- lapply(repr_traj, "[[", "Segments") ## ----plot_retra, fig = TRUE, fig.height = 5, fig.width = 5, fig.align = "center"---- # Plot the representative trajectories of an EDR plot(repr_traj, # <-- This is a RETRA object returned by retra_edr() # data to generate the state space d = state_mds, trajectories = rep(ID_sampling, each = 3), states = rep(ID_obs, 10), # use the colors previously used for individual trajectories. # (make them more transparent to highlight representative trajectories) traj.colors = alpha(traj.colors, 0.3), # display representative trajectories in blue RT.colors = "blue", # select T2 to be displayed with a different color (black) select_RT = "T2", sel.color = "black", # Identify artificial links using dashed lines (default) and a different color (red) link.lty = 2, link.color = "red", # We can use other arguments in plot() main = "Representative trajectories") # Add a legend legend("bottomright", c("T1", "T2", "Link"), col = c("blue", "black", "red"), lty = c(1, 1, 2)) ## ----define_retra_df---------------------------------------------------------- # Generate a data frame indicating the states forming the new trajectories new_traj_df <- data.frame( # name of the new trajectories (as many times as the number of states) RT = c(rep("T1.1", 4), rep("T2.1", 5), rep("T1.2", 2)), # name of the trajectories (sampling units) RT_traj = c(rep("B", 2), rep("I", 2), # for the first trajectory (T1.1) rep("C", 3), rep("I", 2), # for the second trajectory (T2.1) rep("E", 2)), # for the third trajectory (T1.2) # states in each sampling unit RT_states = c(1:2, 2:3, # for the first trajectory (T1.1) 1:3, 2:3, # for the second trajectory (T2.1) 2:3), # for the third trajectory (T1.2) # representative trajectories obtained in retra_edr() RT_retra = c(rep("T1", 4), rep("T2", 5), rep("T1", 2)) # The last segment belong to both (T1, T2), choose one ) new_traj_df ## ----define_retra_ls---------------------------------------------------------- # List including the sequence of segments for each new trajectory new_traj_ls <- list( # First part of T1 excluding the last segment repr_traj$T1$Segments[1:(length(repr_traj$T1$Segments) - 1)], # First part of T2 excluding the last segment repr_traj$T2$Segments[1:(length(repr_traj$T2$Segments) - 1)], # Last segment of T1 and T2: segment composed of states 2 and 3 of the sampling unit E ("E[2-3]") "E[2-3]" ) new_traj_ls ## ----define_retra------------------------------------------------------------- # Define representative trajectories using a data frame new_repr_traj <- define_retra(data = new_traj_df, # Information of the state space d = state_dissim, trajectories = rep(ID_sampling, each = 3), states = rep(ID_obs, 10), # RETRA object returned by retra_edr() retra = repr_traj) # Define representative trajectories using a list with sequences of segments new_repr_traj_ls <- define_retra(data = new_traj_ls, # Information of the state space d = state_dissim, trajectories = rep(ID_sampling, each = 3), states = rep(ID_obs, 10), # RETRA object returned by retra_edr() retra = repr_traj) if (all.equal(new_repr_traj, new_repr_traj_ls)) { print("Yes, both are equal!") } ## ----plot_newretra, fig = TRUE, fig.height = 5, fig.width = 5, fig.align = "center"---- plot(new_repr_traj, # <-- This is the RETRA object returned by define_retra() # data to generate the state space d = state_mds, trajectories = rep(ID_sampling, each = 3), states = rep(ID_obs, 10), # display individual trajectories in light blue traj.colors = "lightblue", # display representative trajectories in dark blue RT.colors = "darkblue", # select T1.2 to be displayed in a different color (red) select_RT = "T1.2", sel.color = "red", # Identify artificial links using dashed lines (default), but use the same # color than the representative trajectories (default) link.lty = 2, link.color = NULL, # We can use other arguments in plot() main = "Defined representative trajectories") # Add a legend legend("bottomright", c("T1.1, T2.1", "T1.2", "Link"), col = c("darkblue", "red", "darkblue"), lty = c(1, 1, 2)) ## ----sp_diversity------------------------------------------------------------- # Set an ID in the abundance matrix abundance$ID <- paste0(abundance$sampling_unit, abundance$time) # Calculate the Shannon index in all trajectory states abundance$Shannon <- vegan::diversity(abundance[, c("sp1", "sp2")], index = "shannon") # Identify the states forming both representative trajectories traj_states <- lapply(repr_traj, function(iRT){ segments <- iRT$Segments seg_components <- strsplit(gsub("\\]", "", gsub("\\[", "-", segments)), "-") traj_states <- vapply(seg_components, function(iseg){ c(paste0(iseg[1], iseg[2]), paste0(iseg[1], iseg[3])) }, character(2)) traj_states <- unique(as.character(traj_states)) traj_states <- data.frame(ID = traj_states, RT_states = 1:length(traj_states)) }) # Associate the states of the representative trajectories with their corresponding # value of the Shannnon index RT_diversity <- lapply(traj_states, function(iRT){ data <- merge(iRT, abundance, by = "ID", all.x = T) data <- data[order(data$RT_states), ] }) RT_diversity$T2 ## ----plot_sp_diversity, fig = TRUE, fig.height = 5, fig.width = 5, fig.align = "center"---- # Plot the variation of species diversity in T1 plot(x = RT_diversity$T1$RT_states + 1, y = RT_diversity$T1$Shannon, type = "l", col = "blue", xlim = c(1, 7), ylim = c(0, 0.7), xlab = "RT state", ylab = "Shannon index", main = "Variation of species diversity") # Add the variation of species diversity in T2 lines(x = RT_diversity$T2$RT_states, y = RT_diversity$T2$Shannon, col = "black") # Add a legend legend("topright", c("T1", "T2"), col = c("blue", "black"), lty = 1) ## ----dDis_data---------------------------------------------------------------- # Change the trajectory identifier and the number of the state abundance_T2 <- RT_diversity$T2 abundance_T2$sampling_unit <- "T2" abundance_T2$time <- abundance_T2$RT_states # Add representative trajectories' data to the abundance matrix abundance_T2 <- rbind(abundance, abundance_T2[, names(abundance)]) # Calculate state dissimilarities including the representative trajectory state_dissim_T2 <- vegan::vegdist(abundance_T2[, c("sp1", "sp2")], method = "bray") ## ----dDis_T2------------------------------------------------------------------ # Compute dDis taking T2 as reference dDis_T2 <- dDis(d = state_dissim_T2, d.type = "dStates", trajectories = abundance_T2$sampling_unit, states = abundance_T2$time, reference = "T2") dDis_T2 ## ----dDis_I_F----------------------------------------------------------------- # dDis: reference C dDis_I <- dDis(d = traj_dissim, d.type = "dTraj", trajectories = ID_sampling, reference = "I") # dDis: reference F dDis_F <- dDis(d = traj_dissim, d.type = "dTraj", trajectories = ID_sampling, reference = "F") dDis_I dDis_F ## ----dDis_w------------------------------------------------------------------- # Define w values initial_sp2 <- abundance[which(abundance$time == 1), ]$sp2 # Identify the index of the reference trajectories ind_I <- which(ID_sampling == "I") ind_F <- which(ID_sampling == "F") # Compute dDis with weighted trajectories: # Considering I as reference dDis_I_w <- dDis(d = traj_dissim, d.type = "dTraj", trajectories = ID_sampling, reference = "I", w.type = "precomputed", w.values = initial_sp2[-ind_I]) # Considering F as reference dDis_F_w <- dDis(d = traj_dissim, d.type = "dTraj", trajectories = ID_sampling, reference = "F", w.type = "precomputed", w.values = initial_sp2[-ind_F]) dDis_I_w dDis_F_w ## ----dBD---------------------------------------------------------------------- # Calculate dBD dBD(d = state_dissim, d.type = "dStates", trajectories = rep(ID_sampling, each = 3), states = rep(ID_obs, 10)) ## ----dEve--------------------------------------------------------------------- # Calculate dEve dEve(d = traj_dissim, d.type = "dTraj", trajectories = ID_sampling) ## ----dEvew-------------------------------------------------------------------- # Calculate dEve weighting trajectories by the initial abundance of sp2 dEve(d = traj_dissim, d.type = "dTraj", trajectories = ID_sampling, w.type = "precomputed", w.values = initial_sp2) ## ----data2-------------------------------------------------------------------- # ID of the sampling units for EDR2 ID_sampling2 <- paste0("inv_", LETTERS[1:10]) # Define initial species abundances for sp3 set.seed(321) initial$sp3 <- round(runif(10, 0, 0.5), 2) # Define the parameters for the Lotka-Volterra model parms2 <- c(r1 = 1, r2 = 0.1, a11 = 0.02, a21 = 0.03, a22 = 0.02, a12 = 0.01, r3 = 1.5, a33 = 0.02, a31 = 0.01, a32 = 0.01, a13 = 0.1, a23 = 0.1) # We can use primer to run the simulations simulated_abun2 <- lapply(1:nrow(initial), function(isampling){ # Initial abundance in the sampling unit i initialN <- c(initial$sp1[isampling], initial$sp2[isampling], initial$sp3[isampling]) # Simulate community dynamics simulated_abun <- data.frame(ode(y = initialN, times = ID_obs, func = lvcomp3, parms = parms2)) # Add the names of the sampling units simulated_abun$sampling_unit <- ID_sampling2[isampling] # Calculate relative abundances simulated_abun$sp1 <- simulated_abun$X1/rowSums(simulated_abun[, c("X1", "X2", "X3")]) simulated_abun$sp2 <- simulated_abun$X2/rowSums(simulated_abun[, c("X1", "X2", "X3")]) simulated_abun$sp3 <- simulated_abun$X3/rowSums(simulated_abun[, c("X1", "X2", "X3")]) return(simulated_abun[, c("sampling_unit", "time", "sp1", "sp2", "sp3")]) }) # Compile species abundances of all sampling units in the same data frame abundance2 <- do.call(rbind, simulated_abun2) ## ----data3-------------------------------------------------------------------- # ID of the sampling units for EDR3 ID_sampling3 <- LETTERS[11:20] # Define initial species abundances set.seed(3) initial3 <- data.frame(sampling_units = ID_sampling3, sp4 = round(runif(10), 2)) # Define the parameters for the Lotka-Volterra model parms3 <- c(r1 = 1, r2 = 0.1, a11 = 0.2, a21 = 0.1, a22 = 0.02, a12 = 0.01) # We can use primer to run the simulations simulated_abun3 <- lapply(1:nrow(initial), function(isampling){ # Initial abundance in the sampling unit i initialN <- c(initial3$sp4[isampling], initial$sp2[isampling]) # Simulate community dynamics simulated_abun <- data.frame(ode(y = initialN, times = ID_obs, func = lvcomp2, parms = parms3)) # Add the names of the sampling units simulated_abun$sampling_unit <- ID_sampling3[isampling] # Calculate relative abundances simulated_abun$sp4 <- simulated_abun$X1/rowSums(simulated_abun[, c("X1", "X2")]) simulated_abun$sp2 <- simulated_abun$X2/rowSums(simulated_abun[, c("X1", "X2")]) return(simulated_abun[, c("sampling_unit", "time", "sp4", "sp2")]) }) # Compile species abundances of all sampling units in the same data frame abundance3 <- do.call(rbind, simulated_abun3) ## ----traj_dissim_allEDR------------------------------------------------------- # Bind all abundance matrices abundance_allEDR <- data.table::rbindlist(list(abundance, abundance2, abundance3), fill = T) abundance_allEDR[is.na(abundance_allEDR)] <- 0 # Calculate state dissimilarities including states in the three EDRs state_dissim_allEDR <- vegan::vegdist(abundance_allEDR[, paste0("sp", 1:4)], method = "bray") # Calculate trajectory dissimilarities including trajectories in the three EDRs traj_dissim_allEDR <- ecotraj::trajectoryDistances( ecotraj::defineTrajectories(state_dissim_allEDR, sites = abundance_allEDR$sampling_unit, surveys = abundance_allEDR$time)) ## ----state_mds_allEDR, fig = TRUE, fig.height = 5, fig.width = 5, fig.align = "center"---- # Multidimensional scaling st_mds_all <- smacof::smacofSym(state_dissim_allEDR, ndim = nrow(as.matrix(state_dissim_allEDR))-1) st_mds_all <- data.frame(st_mds_all$conf) # Plot ecological trajectories in the state space state.colorsEDRs <- rep(RColorBrewer::brewer.pal(3, "Set1"), each = 30) # Set an empty plot plot(st_mds_all$D1, st_mds_all$D2, type = "n", xlab = "Axis 1", ylab = "Axis 2", main = "EDRs in the state space") # Add arrows for (isampling in seq(1, 90, 3)) { # From observation 1 to observation 2 shape::Arrows(st_mds_all[isampling, 1], st_mds_all[isampling, 2], st_mds_all[isampling + 1, 1], st_mds_all[isampling + 1, 2], col = state.colorsEDRs[isampling], arr.adj = 1) # From observation 2 to observation 3 shape::Arrows(st_mds_all[isampling + 1, 1], st_mds_all[isampling + 1, 2], st_mds_all[isampling + 2, 1], st_mds_all[isampling + 2, 2], col = state.colorsEDRs[isampling], arr.adj = 1) } # Add a legend legend("bottomleft", paste0("EDR", 1:3), col = unique(state.colorsEDRs), lty = 1) ## ----EDR_dissim--------------------------------------------------------------- # Compute the dissimilarities between EDRs EDR_dissim <- dist_edr(d = traj_dissim_allEDR, d.type = "dTraj", edr = rep(c("EDR1", "EDR2", "EDR3"), each = 10), metric = "dDR") round(EDR_dissim, 2)