├── CITATION.cff ├── NEWS.md ├── LICENSE ├── README.md ├── ui.R └── server.R /CITATION.cff: -------------------------------------------------------------------------------- 1 | cff-version: 1.1.0 2 | message: "To cite this Shiny app, please use the following." 3 | authors: 4 | - family-names: Petry 5 | given-names: William K. 6 | orcid: https://orcid.org/0000-0002-5230-5987 7 | - family-names: Lepori 8 | given-names: Vasco J. 9 | orcid: https://orcid.org/0000-0002-5086-5171 10 | title: StructuralCoexistence 11 | version: v0.2 12 | date-released: 2022-12-12 13 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # v.0.2 2 | 12 December 2022 3 | ### New features 4 | - 4-species scenarios for weak interactions and quasi-neutrality (#7) 5 | 6 | ### Other changes 7 | - minor re-wording and reformatting of UI side panel 8 | 9 | ### Bug fixes 10 | - fixed disappearance of species interaction network thanks to Gaurav Kandlikar (#8, #10) 11 | 12 | # v.0.1 - Initial release 13 | 26 September 2022 14 | ### New features 15 | - 3-species communities 16 | - interaction network 17 | - coexistence metrics 18 | - unit simplex projection of structural niche and fitness differences 19 | - 3-dimensional "cone" visualization of structural niche and fitness differences 20 | - predefined scenarios 21 | - quasi-neutrality 22 | - rock-paper-scissors 23 | - weak interspecific interactions 24 | - 4-species communities (thanks to @vlepori) 25 | - interaction network 26 | - coexistence metrics 27 | - unit simplex projection of structural niche and fitness differences 28 | 29 | ### Other changes 30 | [n/a] 31 | 32 | ### Bug fixes 33 | - fixed incorrect transformation for the structural niche difference $\Omega$ thanks to Rodrigo Granjel (#5) 34 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2017-2019 William Petry and Vasco Lepori 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # StructuralCoexistence 2 | 3 | [![DOI](https://zenodo.org/badge/103034930.svg)](https://zenodo.org/badge/latestdoi/103034930) 4 | 5 | This is a Shiny app that allows the user to interactively explore the structural approach to coexistence framework described by Saavedra et al. (2017). For the app, I have simply extracted analysis and plotting code from a [Dryad repository](https://doi.org/10.5061/dryad.v9f5s) that accompanies the paper, making modifications for interactivity. Vasco Lepori made the 3D plots and extended the app to 4-species communities. 6 | 7 | To use the app, clone this repo locally or try it out online at: https://ecodynamics.shinyapps.io/StructuralCoexistence/ 8 | 9 | Any errors are most likely mine—please submit an Issue or contact me directly if you find one. 10 | 11 | ### Citations: 12 | This app has been archived in Zenodo and has a citable DOI: 13 | 14 | - Petry, W. and V. Lepori. (2022), wpetry/StructuralCoexistence: Initial release (v0.1). Zenodo. [https://doi.org/10.5281/zenodo.7114127](https://doi.org/10.5281/zenodo.7114127) 15 | 16 | We also request that you cite the original paper that inspired our app: 17 | 18 | - Saavedra, S., Rohr, R. P., Bascompte, J., Godoy, O., Kraft, N. J. B. and Levine, J. M. (2017), A structural approach for understanding multispecies coexistence. Ecol Monogr, 87: 470–486. [doi:10.1002/ecm.1263](http://dx.doi.org/10.1002/ecm.1263) 19 | -------------------------------------------------------------------------------- /ui.R: -------------------------------------------------------------------------------- 1 | #################################################- 2 | ## USER INTERFACE 3 | #################################################- 4 | ## Preliminaries ---- 5 | #################################################- 6 | library(shiny) 7 | library(shinyMatrix) 8 | library(rgl) 9 | library(scales) 10 | #################################################- 11 | ## Define UI ---- 12 | #################################################- 13 | shinyUI( 14 | fluidPage( 15 | # Application title 16 | titlePanel( 17 | h1("How is diversity maintained in multispecies communities?", h2("A structural approach to coexistence")) 18 | ), 19 | # HTML tags 20 | tags$head( 21 | tags$style(HTML("hr {border-top: 1px solid #000000;}")) 22 | ), 23 | # User inputs 24 | sidebarLayout( 25 | sidebarPanel( 26 | p("Coexistence theory has largely focused on 2-species communities, but this neglects the role of indirect interactions that are found only in larger systems. Saavedra et al. (doi:10.1002/ecm.1263) offers an approach to quantifying diversity in these systems using the mathematics of structural stability borrowed from engineering. Use the controls below to explore how competitor fitness & interactions govern diversity."), 27 | hr(), 28 | h4("Number of Species:"), 29 | radioButtons("spp", label = NULL, 30 | choices = c('3', '4'), 31 | selected = '3'), 32 | hr(), 33 | h4("Species intrinsic growth rates:"), 34 | conditionalPanel( 35 | condition = "input.spp == '3'", 36 | 37 | numericInput("r1", "r1", 1, min = 0, max = 1, 38 | step = 0.1), 39 | numericInput("r2", "r2", 0.6, min = 0, max = 1, 40 | step = 0.1), 41 | numericInput("r3", "r3", 0.7, min = 0, max = 1, 42 | step = 0.1), 43 | h4("Interaction coefficients:"), 44 | shinyMatrix::matrixInput(inputId = "alphamat", 45 | value = matrix(c(1, 0.4, 0.3, 46 | 0.5, 1, 0.6, 47 | 0.05, 0.5, 1), 48 | nrow = 3, 49 | dimnames = list(c("α(1,_)", "α(2,_)", "α(3,_)"), c("α(_,1)", "α(_,2)", "α(_,3)")), 50 | byrow = TRUE), 51 | class = "numeric", 52 | rows = list(names = TRUE, 53 | editableNames = FALSE), 54 | cols = list(names = TRUE, 55 | editableNames = FALSE)), 56 | hr(), 57 | conditionalPanel(condition = "input.spp == '3'", 58 | h4("Scenarios:"), 59 | actionButton("neutral3", 60 | "Quasi-neutrality"), 61 | actionButton("intransient3", 62 | "Rock-paper-scissors"), 63 | actionButton("weakintra3", 64 | "Weak inter-specific interactions") 65 | ), 66 | hr(), 67 | h4("Display options:"), 68 | checkboxInput("draw_network", "Species interaction network", value = TRUE), 69 | checkboxInput("draw_table", "Coexistence metric table", value = TRUE), 70 | radioButtons("cone_opt", "Plot cone", 71 | choices = c("none", "static", "interactive"), 72 | selected = "none") 73 | ), 74 | conditionalPanel( 75 | condition = "input.spp == '4'", 76 | numericInput("rr1", "r1", 1, min = 0, max = 1, step = 0.1), 77 | numericInput("rr2", "r2", 1, min = 0, max = 1, step = 0.1), 78 | numericInput("rr3", "r3", 0.5, min = 0, max = 1, step = 0.1), 79 | numericInput("rr4", "r4", 0.5, min = 0, max = 1, step = 0.1), 80 | h4("Interaction coefficients:"), 81 | shinyMatrix::matrixInput(inputId = "alphamat4", 82 | value = matrix(c(1, 0.4, 0.3, 0.1, 83 | 0.5, 1, 0.6, 0.1, 84 | 0.05, 0.5, 1, 0.5, 85 | 0.1, 0.2, 0.2, 1), 86 | nrow = 4, 87 | dimnames = list(c("α(1,_)", "α(2,_)", "α(3,_)", "α(4,_)"), 88 | c("α(_,1)", "α(_,2)", "α(_,3)", "α(_,4)")), 89 | byrow = TRUE), 90 | class = "numeric", 91 | rows = list(names = TRUE, 92 | editableNames = FALSE), 93 | cols = list(names = TRUE, 94 | editableNames = FALSE)), 95 | hr(), 96 | conditionalPanel(condition = "input.spp == '4'", 97 | h4("Scenarios:"), 98 | actionButton("neutral4", 99 | "Quasi-neutrality"), 100 | actionButton("weakintra4", 101 | "Weak inter-specific interactions") 102 | ), 103 | hr(), 104 | h4("Display options:"), 105 | checkboxInput("draw_network4sp", "Species interaction network", value = TRUE), 106 | checkboxInput("draw_table4sp", "Coexistence metric table", value = TRUE) 107 | ) 108 | ), 109 | 110 | # Outputs 111 | mainPanel( 112 | # 3 species 113 | fluidRow( 114 | conditionalPanel("input.spp == '3' & input.draw_network", 115 | column(width = 7, 116 | plotOutput("network_3sp") 117 | ) 118 | ), 119 | conditionalPanel("input.spp == '3' & input.draw_table", 120 | column(width = 5, 121 | h5("Coexistence metrics"), 122 | tableOutput("stats") 123 | ) 124 | )), 125 | conditionalPanel("input.spp == '3'", 126 | fluidRow( 127 | plotOutput("proj") 128 | ) 129 | ), 130 | conditionalPanel("input.spp == '3' & input.cone_opt == 'static'", 131 | fluidRow( 132 | plotOutput("cone") 133 | ) 134 | ), 135 | conditionalPanel("input.spp == '3' & input.cone_opt == 'interactive'", 136 | fluidRow( 137 | rglwidgetOutput("cone3d") 138 | ) 139 | ), 140 | # 4 species 141 | fluidRow( 142 | conditionalPanel("input.spp == '4' & input.draw_network4sp", 143 | column(width = 7, 144 | plotOutput("network_4sp") 145 | ) 146 | ), 147 | conditionalPanel("input.spp == '4' & input.draw_table4sp", 148 | column(width = 5, 149 | h5("Coexistence metrics"), 150 | tableOutput("stats4sp") 151 | ) 152 | )), 153 | conditionalPanel("input.spp == '4'", 154 | fluidRow( 155 | rglwidgetOutput("proj4sp") 156 | ) 157 | ) 158 | ) 159 | ) 160 | ) 161 | ) 162 | -------------------------------------------------------------------------------- /server.R: -------------------------------------------------------------------------------- 1 | #################################################- 2 | ## SERVER 3 | #################################################- 4 | ## Preliminaries ---- 5 | #################################################- 6 | library(shiny) 7 | library(rgl) 8 | library(scatterplot3d) 9 | library(pracma) 10 | library(mvtnorm) 11 | library(igraph) 12 | #################################################- 13 | ## Functions: calculate metrics ---- 14 | ## Structural coexistence calculation & plotting code 15 | ## from Saavedra et al. 2017 Ecol Mono 16 | ## http://dx.doi.org/10.1002/ecm.1263 17 | #################################################- 18 | # Omega ==== 19 | # structural niche difference (output on a log scale) 20 | Omega <- function(alpha){ 21 | n <- nrow(alpha) 22 | Sigma <- solve(t(alpha) %*% alpha) 23 | d <- pmvnorm(lower = rep(0, n), upper = rep(Inf, n), 24 | mean = rep(0, n), sigma = Sigma) 25 | out <- log10(d[1]) + n * log10(2) 26 | return(out) 27 | } 28 | 29 | # r_centroid ==== 30 | # vector defining the centroid of the feasibility domain 31 | r_centroid <- function(alpha){ 32 | n <- nrow(alpha) 33 | D <- diag(1 / sqrt(diag(t(alpha) %*% alpha))) 34 | alpha_n <- alpha %*% D 35 | r_c <- rowSums(alpha_n) /n 36 | r_c <- unname(t(t(r_c))) 37 | return(r_c) 38 | } 39 | 40 | # theta ==== 41 | # structural fitness difference (in degree) 42 | theta <- function(alpha, r){ 43 | r_c <- r_centroid(alpha) 44 | out <- acos(round(sum(r_c*r) / (sqrt(sum(r^2)) * sqrt(sum(r_c^2))), 15)) * 180 / pi # add rounding step to overcome floating point errors 45 | return(out) 46 | } 47 | 48 | # test_feasibility ==== 49 | # test if a system (alpha and r) is feasible (output 1 = feasible, 0 = not feasible) 50 | test_feasibility <- function(alpha, r){ 51 | out <- prod(solve(alpha, r) > 0) 52 | return(out) 53 | } 54 | 55 | # test_feasibility_pairs ==== 56 | # test which pairs in a system (alpha and r) are feasible (output 1 = feasible, 0 = not feasible) 57 | test_feasibility_pairs <- function(alpha, r){ 58 | n <- length(r) 59 | c <- combn(n, 2) 60 | nc <- dim(c)[2] 61 | f <- rep(NA, nc) 62 | for (i in 1:nc){ 63 | f[i] <- prod(solve(alpha[c[, i], c[, i]], r[c[, i]]) > 0) 64 | } 65 | out <- list(pairs = c, feasibility = f) 66 | return(out) 67 | } 68 | 69 | # compute_overlap ==== 70 | # compute the feasiblity domain, the feasibility domain of all pairs, and their overlap (Nrand = number of randomization) 71 | compute_overlap <- function(alpha, Nrand){ 72 | n <- dim(alpha)[1] 73 | counter_f <- 0 74 | counter_overlap <- 0 75 | counter_all <- 0 76 | for (i in 1:Nrand){ 77 | r_rand <- abs(rnorm(n)) 78 | r_rand <- r_rand / sqrt(sum(r_rand^2)) 79 | f1 <- test_feasibility(alpha, r_rand) 80 | f2 <- test_feasibility_pairs(alpha, r_rand)$feasibility 81 | counter_f <- counter_f + f1 82 | counter_all <- counter_all + prod(f2) 83 | counter_overlap <- counter_overlap + f1*prod(f2) 84 | } 85 | Omega <- counter_f / Nrand 86 | Omega_all <- counter_all / Nrand 87 | overlap <- counter_overlap / Nrand 88 | out <- list(Omega = Omega, Omega_all = Omega_all, 89 | overlap = overlap) 90 | return(out) 91 | } 92 | 93 | #################################################- 94 | ## Functions: make plots ---- 95 | #################################################- 96 | # mk_graph_3sp ==== 97 | # make interaction network plot 98 | mk_graph_3sp <- function(alphamat, rs){ 99 | alphamat <- unname(alphamat) 100 | g <- igraph::graph_from_adjacency_matrix(alphamat > 0) 101 | E(g)$weight <- as.numeric(alphamat) 102 | widths <- E(g)$weight * 5 103 | #widths[widths > 1] <- sqrt(widths) 104 | plot(g, 105 | main = "Species interaction network", 106 | margin = c(0, -0.15, -0.3, -0.15), 107 | xlim = c(-1.25, 1.25), ylim = c(-1.25, 1.25), 108 | vertex.label.cex = 2.5, 109 | vertex.label.color = "black", 110 | vertex.size = 50 * rs, 111 | vertex.color = "grey80", 112 | vertex.frame.color = "transparent", 113 | edge.curved = TRUE, 114 | edge.width = widths, 115 | edge.arrow.size = 3, 116 | edge.arrow.mode = c(0, 2, 2, 117 | 2, 0, 2, 118 | 2, 2, 0), 119 | edge.color = "black", 120 | edge.loop.angle = 0.75, 121 | layout = matrix(c(4, 0, 0, 0, 2, sqrt(3)/2), ncol = 2, 122 | byrow = TRUE)) 123 | } 124 | 125 | # mk_graph_4sp ==== 126 | # make interaction network plot 127 | mk_graph_4sp <- function(alphamat, rs){ 128 | alphamat <- unname(alphamat) 129 | g <- igraph::graph_from_adjacency_matrix(alphamat > 0) 130 | E(g)$weight <- as.numeric(alphamat) 131 | widths <- E(g)$weight * 5 132 | #widths[widths > 1] <- sqrt(widths) 133 | plot(g, 134 | main = "Species interaction network", 135 | margin = c(0, -0.15, -0.3, -0.15), 136 | xlim = c(-1.25, 1.25), ylim = c(-1.25, 1.25), 137 | vertex.label.cex = 2.5, 138 | vertex.label.color = "black", 139 | vertex.size = 50 * rs, 140 | vertex.color = "grey80", 141 | vertex.frame.color = "transparent", 142 | edge.curved = TRUE, 143 | edge.width = widths, 144 | edge.arrow.size = 3, 145 | edge.arrow.mode = c(0, 2, 2, 2, 146 | 2, 0, 2, 2, 147 | 2, 2, 0, 2, 148 | 2, 2, 2, 0), 149 | edge.color = "black", 150 | edge.loop.angle = 0.5, 151 | layout = matrix(c(4, 0, 152 | 0, 0, 153 | 0, 4, 154 | 4, 4), ncol = 2, 155 | byrow = TRUE)) 156 | } 157 | 158 | # cone_3sp ==== 159 | # (helper) make static feasibility cone plot for 3 species 160 | cone_3sp <- function(alpha){ 161 | par(mar = c(0, 0, 0, 0)) 162 | D <- diag(1 / sqrt(diag(t(alpha) %*% alpha))) 163 | alpha_n <- alpha %*% D 164 | v1 <- alpha_n[, 1] 165 | v2 <- alpha_n[, 2] 166 | v3 <- alpha_n[, 3] 167 | vc <- (v1 + v2 + v3) 168 | vc <- vc / sqrt(sum(vc^2)) 169 | lambda = c(0, 1.2) 170 | X <- v1[1] * lambda 171 | Y <- v1[2] * lambda 172 | Z <- v1[3] * lambda 173 | s3d <- scatterplot3d(X, -Y, Z, xlim = c(0, 1.4), 174 | ylim = c(0, -1.4), zlim = c(0, 1.4), 175 | type = 'l', box = FALSE, angle = 30, 176 | axis = FALSE, grid = FALSE, asp = 1) 177 | s3d$points3d(c(0, 0), c(0, 0), c(0, 1.4), type = 'l', 178 | col = "black", lwd = 2) 179 | s3d$points3d(c(0, 0), c(0, -1.4), c(0, 0), type = 'l', 180 | col = "black", lwd = 2) 181 | s3d$points3d(c(0, 1.4), c(0, 0), c(0, 0), type = 'l', 182 | col = "black", lwd = 2) 183 | pp <- s3d$xyz.convert(0.62,0,0) 184 | text(x = pp$x,y = pp$y, labels = "Intrinsic growth rate sp1", 185 | adj = c(0, 1.5), cex = 1) 186 | pp <- s3d$xyz.convert(0, -1.4, 0) 187 | text(x = pp$x,y = pp$y, labels = "Intrinsic growth rate sp2", 188 | adj = c(0, 1.5), cex = 1, srt = 31) 189 | pp <- s3d$xyz.convert(0, 0, 0.75) 190 | text(x = pp$x,y = pp$y, labels = "Intrinsic growth rate sp3", 191 | adj = c(0, 1.5), cex = 1, srt = 90) 192 | lambda = c(0, 1.2) 193 | X <- v1[1] * lambda 194 | Y <- v1[2] * lambda 195 | Z <- v1[3] * lambda 196 | s3d$points3d(X, -Y, Z, type = 'l', col = "mediumseagreen", 197 | lwd = 4) 198 | X2 <- v2[1] * lambda 199 | Y2 <- v2[2] * lambda 200 | Z2 <- v2[3] * lambda 201 | s3d$points3d(X2, -Y2, Z2, type = 'l', col = "mediumseagreen", 202 | lwd = 4) 203 | X3 <- v3[1] * lambda 204 | Y3 <- v3[2] * lambda 205 | Z3 <- v3[3] * lambda 206 | s3d$points3d(X3, -Y3, Z3, type = 'l', col = "mediumseagreen", 207 | lwd = 4) 208 | X4 <- vc[1] * lambda 209 | Y4 <- vc[2] * lambda 210 | Z4 <- vc[3] * lambda 211 | s3d$points3d(X4, -Y4, Z4, type = 'l', col = "blue4", lwd = 4) 212 | lambda <- c(1.2, 10) 213 | X <- v1[1] * lambda 214 | Y <- v1[2] * lambda 215 | Z <- v1[3] * lambda 216 | s3d$points3d(X, -Y, Z, type = 'l', col = "mediumseagreen", 217 | lwd = 4, lty = 2) 218 | X2 <- v2[1] * lambda 219 | Y2 <- v2[2] * lambda 220 | Z2 <- v2[3] * lambda 221 | s3d$points3d(X2, -Y2, Z2, type = 'l', col = "mediumseagreen", 222 | lwd = 4, lty = 2) 223 | X3 <- v3[1] * lambda 224 | Y3 <- v3[2] * lambda 225 | Z3 <- v3[3] * lambda 226 | s3d$points3d(X3, -Y3, Z3, type = 'l', col = "mediumseagreen", 227 | lwd = 4, lty = 2) 228 | X4 <- vc[1] * lambda 229 | Y4 <- vc[2] * lambda 230 | Z4 <- vc[3] * lambda 231 | s3d$points3d(X4, -Y4, Z4, type = 'l', col = "blue4", lwd = 4, 232 | lty = 2) 233 | a <- seq(0, 1, by = 0.01) 234 | b <- sqrt(1-a^2) 235 | c <- rep(0, length(a)) 236 | s3d$points3d(a*1.2, -b*1.2, c*1.2, type = 'l', col = "grey50", 237 | lwd = 2) 238 | s3d$points3d(c*1.2, -a*1.2, b*1.2, type = 'l', col = "grey50", 239 | lwd = 2) 240 | s3d$points3d(b*1.2, -c*1.2, a*1.2, type = 'l', col = "grey50", 241 | lwd = 2) 242 | mu <- seq(0, 1, by = 0.01) 243 | w1 <- t(t(v1)) %*% t(mu) + t(t(v2)) %*% t(1-mu) 244 | w1 <- w1 %*% diag(1/sqrt(colSums(w1^2))) 245 | w2 <- t(t(v2)) %*% t(mu) + t(t(v3)) %*% t(1-mu) 246 | w2 <- w2 %*% diag(1/sqrt(colSums(w2^2))) 247 | w3 <- t(t(v3)) %*% t(mu) + t(t(v1)) %*% t(1-mu) 248 | w3 <- w3 %*% diag(1/sqrt(colSums(w3^2))) 249 | wp1 <- s3d$xyz.convert(w1[1, ]*1.2, -w1[2, ]*1.2, w1[3, ]*1.2) 250 | wp2 <- s3d$xyz.convert(w2[1, ]*1.2, -w2[2, ]*1.2, w2[3, ]*1.2) 251 | wp3 <- s3d$xyz.convert(w3[1, ]*1.2, -w3[2, ]*1.2, w3[3, ]*1.2) 252 | XXX <- c(wp1$x, wp2$x, wp3$x) 253 | YYY <- c(wp1$y, wp2$y, wp3$y) 254 | color <- col2rgb("mediumseagreen") 255 | polygon(XXX, YYY, 256 | col = rgb(color[1, 1], color[2, 1], color[3, 1], 90, 257 | maxColorValue = 255), border = FALSE) 258 | s3d$points3d(w1[1, ]*1.2, -w1[2, ]*1.2, w1[3, ]*1.2, 259 | type = 'l', col = "mediumseagreen", lwd = 4) 260 | s3d$points3d(w2[1, ]*1.2, -w2[2, ]*1.2, w2[3, ]*1.2, 261 | type = 'l', col = "mediumseagreen", lwd = 4) 262 | s3d$points3d(w3[1, ]*1.2, -w3[2, ]*1.2, w3[3, ]*1.2, 263 | type = 'l', col = "mediumseagreen", lwd = 4) 264 | } 265 | 266 | # projection_3sp_with_pairwise ==== 267 | # plot static projection for 3 specie community 268 | projection_3sp_with_pairwise <- function(alpha, r){ 269 | par(mar = c(0, 0, 0, 0)) 270 | D <- diag(1 / sqrt(diag(t(alpha) %*% alpha))) 271 | alpha_n <- alpha %*% D 272 | v1 <- alpha_n[, 1] 273 | v2 <- alpha_n[, 2] 274 | v3 <- alpha_n[, 3] 275 | vc <- (v1 + v2 + v3) 276 | vc <- vc / sqrt(sum(vc^2)) 277 | v1 <- v1 / sum(v1) 278 | v2 <- v2 / sum(v2) 279 | v3 <- v3 / sum(v3) 280 | vc <- vc / sum(vc) 281 | Xf <- sqrt(2) 282 | Yf <- sqrt(6) / 2 283 | XX <- c(-Xf / 2, Xf / 2, 0, -Xf / 2) 284 | YY <- c(0, 0, Yf, 0) 285 | plot(-XX, YY, axes = FALSE, xlab = '', ylab = '', 286 | xlim = c(-Xf/2-0.05, Xf/2+0.05), 287 | ylim = c(0-0.05, Yf+0.05), 288 | col = "grey50", type = "l", lwd = 2, asp = 1) 289 | v1P <- v1 290 | v1P[3] <- 0 291 | v1P <- v1P / sum(v1P) 292 | v2P <- v2 293 | v2P[3] <- 0 294 | v2P <- v2P / sum(v2P) 295 | vcP <- v1P/sqrt(sum(v1P^2)) + v2P/sqrt(sum(v2P^2)) 296 | vcP[3] <- 0 297 | vcP <- vcP / sum(vcP) 298 | v1C <- c((0.5-0.5*v1P[3]-v1P[1])*Xf, v1P[3]*Yf) 299 | v2C <- c((0.5-0.5*v2P[3]-v2P[1])*Xf, v2P[3]*Yf) 300 | vcC <- c((0.5-0.5*vcP[3]-vcP[1])*Xf, vcP[3]*Yf) 301 | lines(-c(v1C[1], v2C[1]), c(v1C[2], v2C[2]), 302 | col = "mediumseagreen", lwd = 1) 303 | lines(-c(v1C[1], XX[3]), c(v1C[2], YY[3]), 304 | col = "mediumseagreen", lty = 2, lwd = 1) 305 | lines(-c(v2C[1], XX[3]), c(v2C[2], YY[3]), 306 | col = "mediumseagreen", lty = 2, lwd = 1) 307 | color <- col2rgb("mediumseagreen") 308 | polygon(-c(v1C[1], v2C[1], XX[3], v1C[1]), 309 | c(v1C[2], v2C[2], YY[3], v1C[2]), 310 | col = rgb(color[1, 1], color[2, 1], color[3, 1], 311 | 30, maxColorValue = 255), border = FALSE) 312 | points(-c(v1C[1], v2C[1]), c(v1C[2], v2C[2]), 313 | col = "dodgerblue", pch = 16, cex = 1.5) 314 | v1P <- v1 315 | v1P[2] <- 0 316 | v1P <- v1P / sum(v1P) 317 | v3P <- v3 318 | v3P[2] <- 0 319 | v3P <- v3P / sum(v3P) 320 | vcP <- v1P/sqrt(sum(v1P^2)) + v3P/sqrt(sum(v3P^2)) 321 | vcP[2] <- 0 322 | vcP <- vcP / sum(vcP) 323 | v1C <- c((0.5-0.5*v1P[3]-v1P[1])*Xf, v1P[3]*Yf) 324 | v3C <- c((0.5-0.5*v3P[3]-v3P[1])*Xf, v3P[3]*Yf) 325 | vcC <- c((0.5-0.5*vcP[3]-vcP[1])*Xf, vcP[3]*Yf) 326 | lines(-c(v1C[1], v3C[1]), c(v1C[2], v3C[2]), 327 | col = "mediumseagreen", lwd = 1) 328 | lines(-c(v1C[1], XX[2]), c(v1C[2], YY[2]), 329 | col = "mediumseagreen", lty = 2, lwd = 1) 330 | lines(-c(v3C[1], XX[2]), c(v3C[2], YY[2]), 331 | col = "mediumseagreen", lty = 2, lwd = 1) 332 | polygon(-c(v1C[1], v3C[1], XX[2], v1C[1]), 333 | c(v1C[2], v3C[2], YY[2], v1C[2]), 334 | col = rgb(color[1, 1], color[2, 1], color[3, 1], 335 | 30, maxColorValue = 255), border = FALSE) 336 | points(-c(v1C[1], v3C[1]), c(v1C[2], v3C[2]), 337 | col = "dodgerblue", pch = 16, cex = 1.5) 338 | # points(-vcC[1], vcC[2], col = "blue4", pch = 16, cex = 1.5) 339 | v2P <- v2 340 | v2P[1] <- 0 341 | v2P <- v2P / sum(v2P) 342 | v3P <- v3 343 | v3P[1] <- 0 344 | v3P <- v3P / sum(v3P) 345 | vcP <- v2P/sqrt(sum(v2P^2)) + v3P/sqrt(sum(v3P^2)) 346 | vcP[1] <- 0 347 | vcP <- vcP / sum(vcP) 348 | v2C <- c((0.5-0.5*v2P[3]-v2P[1])*Xf, v2P[3]*Yf) 349 | v3C <- c((0.5-0.5*v3P[3]-v3P[1])*Xf, v3P[3]*Yf) 350 | vcC <- c((0.5-0.5*vcP[3]-vcP[1])*Xf, vcP[3]*Yf) 351 | lines(-c(v2C[1], v3C[1]), c(v2C[2], v3C[2]), 352 | col = "mediumseagreen", lwd = 1) 353 | lines(-c(v2C[1], XX[1]), c(v2C[2], YY[1]), 354 | col = "mediumseagreen", lty = 2, lwd = 1) 355 | lines(-c(v3C[1], XX[1]), c(v3C[2], YY[1]), 356 | col = "mediumseagreen", lty = 2, lwd = 1) 357 | polygon(-c(v2C[1], v3C[1], XX[1], v2C[1]), 358 | c(v2C[2], v3C[2], YY[1], v2C[2]), 359 | col = rgb(color[1, 1], color[2, 1], color[3, 1], 360 | 30, maxColorValue = 255), border = FALSE) 361 | points(-c(v2C[1], v3C[1]), c(v2C[2], v3C[2]), 362 | col = "dodgerblue", pch = 16, cex = 1.5) 363 | v1C <- c((0.5-0.5*v1[3]-v1[1])*Xf, v1[3]*Yf) 364 | v2C <- c((0.5-0.5*v2[3]-v2[1])*Xf, v2[3]*Yf) 365 | v3C <- c((0.5-0.5*v3[3]-v3[1])*Xf, v3[3]*Yf) 366 | vcC <- c((0.5-0.5*vc[3]-vc[1])*Xf, vc[3]*Yf) 367 | color <- col2rgb("green4") 368 | polygon(-c(v1C[1], v2C[1], v3C[1]), c(v1C[2], v2C[2], v3C[2]), 369 | col = rgb(color[1, 1], color[2, 1], color[3, 1], 370 | 90, maxColorValue = 255), border = FALSE) 371 | points(-c(v1C[1], v2C[1], v3C[1], v1C[1]), 372 | c(v1C[2], v2C[2], v3C[2], v1C[2]), col = "green4", 373 | type = 'l', cex = 1.5, lwd = 2) 374 | points(-c(v1C[1], v2C[1], v3C[1]), c(v1C[2], v2C[2], v3C[2]), 375 | col = "blue4", pch = 16, cex = 1.5) 376 | points(-vcC[1], vcC[2], col = "blue4", pch = 4, cex = 1.5) # plot centroid of D_F 377 | rX <- Xf*(0.5-0.5*((2*r[2]+r[3]) / (r[1]+r[2]+r[3]))) 378 | rY <- Yf*(r[3] / (r[1]+r[2]+r[3])) 379 | points(rX, rY, col = "black", pch = 21, lwd = 4, cex = 3) 380 | text(-XX, YY, labels = c("sp1", "sp2", "sp3"), cex = 1.7, 381 | pos = c(1, 1, 3)) 382 | } 383 | 384 | # plot_cone_3D ==== 385 | # plot interactive (rgl) cone for 3 species community 386 | plot_cone_3D <- function(alpha, r = c(0, 0, 0), 387 | sp_name = paste0("sp", 1:3)){ 388 | D <- diag(1 / sqrt(diag(t(alpha) %*% alpha))) 389 | alpha_n <- alpha %*% D 390 | v1 <- alpha_n[, 1] 391 | v2 <- alpha_n[, 2] 392 | v3 <- alpha_n[, 3] 393 | vc <- (v1 + v2 + v3) 394 | vc <- vc / sqrt(sum(vc^2)) 395 | lambda <- c(0, 1.2) 396 | X <- v1[1] * lambda 397 | Y <- v1[2] * lambda 398 | Z <- v1[3] * lambda 399 | Sp1 <- v1[1] * lambda 400 | Sp2 <- v1[2] * lambda 401 | Sp3 <- v1[3] * lambda 402 | X2 <- v2[1] * lambda 403 | Y2 <- v2[2] * lambda 404 | Z2 <- v2[3] * lambda 405 | X3 <- v3[1] * lambda 406 | Y3 <- v3[2] * lambda 407 | Z3 <- v3[3] * lambda 408 | X4 <- vc[1] * lambda 409 | Y4 <- vc[2] * lambda 410 | Z4 <- vc[3] * lambda 411 | # feasibility domain 412 | rgl::plot3d(Sp1, -Sp2, Sp3, col = "mediumseagreen", 413 | xlab = "", ylab = "", zlab = "", 414 | type = 'l', lwd = 2.5, box = FALSE, axes = FALSE) 415 | rgl::lines3d(X2, -Y2, Z2, col = "mediumseagreen", lwd = 2.5) 416 | rgl::lines3d(X3, -Y3, Z3, col = "mediumseagreen", lwd = 2.5) 417 | rgl::lines3d(X4, -Y4, Z4, col = "orange", lwd = 2.5) 418 | lambda <- c(1.2, 2) 419 | X <- v1[1] * lambda 420 | Y <- v1[2] * lambda 421 | Z <- v1[3] * lambda 422 | X2 <- v2[1] * lambda 423 | Y2 <- v2[2] * lambda 424 | Z2 <- v2[3] * lambda 425 | X3 <- v3[1] * lambda 426 | Y3 <- v3[2] * lambda 427 | Z3 <- v3[3] * lambda 428 | X4 <- vc[1] * lambda 429 | Y4 <- vc[2] * lambda 430 | Z4 <- vc[3] * lambda 431 | rgl::lines3d(X,-Y,Z, col = "mediumseagreen", lwd = 1) 432 | rgl::lines3d(X2,-Y2,Z2, col = "mediumseagreen", lwd = 1) 433 | rgl::lines3d(X3,-Y3,Z3, col = "mediumseagreen", lwd = 1) 434 | rgl::lines3d(X4,-Y4,Z4, col = "orange", lwd = 1) 435 | #axes 436 | rgl::lines3d(c(0, 1.4), c(0, 0), c(0, 0), col = "black", lwd = 1) 437 | rgl::lines3d(c(0, 0), c(0, -1.4), c(0, 0), col = "black", lwd = 1) 438 | rgl::lines3d(c(0, 0), c(0, 0), c(0, 1.4), col = "black", lwd = 1) 439 | #arcs 440 | a <- seq(0, 1, by = 0.01) 441 | b <- sqrt(1-a^2) 442 | c <- rep(0, length(a)) 443 | rgl::lines3d(a*1.2, -b*1.2, c*1.2, col = "grey", lwd = 2.5) 444 | rgl::lines3d(c*1.2, -a*1.2, b*1.2, col = "grey", lwd = 2.5) 445 | rgl::lines3d(b*1.2, -c*1.2, a*1.2, col = "grey", lwd = 2.5) 446 | mu <- seq(0, 1, by = 0.01) 447 | w1 <- t(t(v1)) %*% t(mu) + t(t(v2)) %*% t(1-mu) 448 | w1 <- w1 %*% diag(1 / sqrt(colSums(w1^2))) 449 | w2 <- t(t(v2)) %*% t(mu) + t(t(v3)) %*% t(1-mu) 450 | w2 <- w2 %*% diag(1 / sqrt(colSums(w2^2))) 451 | w3 <- t(t(v3)) %*% t(mu) + t(t(v1)) %*% t(1-mu) 452 | w3 <- w3 %*% diag(1 / sqrt(colSums(w3^2))) 453 | rgl::lines3d(w1[1, ]*1.2, -w1[2, ]*1.2, w1[3, ]*1.2, 454 | col = "mediumseagreen", lwd = 2) 455 | rgl::lines3d(w2[1, ]*1.2, -w2[2, ]*1.2, w2[3, ]*1.2, 456 | col = "mediumseagreen", lwd = 2) 457 | rgl::lines3d(w3[1, ]*1.2, -w3[2, ]*1.2, w3[3, ]*1.2, 458 | col = "mediumseagreen", lwd = 2) 459 | # surface of the conical hull (yet to implement in rgl) 460 | # wp1 <- s3d$xyz.convert(w1[1, ]*1.2, -w1[2, ]*1.2, w1[3, ]*1.2) 461 | # wp2 <- s3d$xyz.convert(w2[1, ]*1.2, -w2[2, ]*1.2, w2[3, ]*1.2) 462 | # wp3 <- s3d$xyz.convert(w3[1, ]*1.2, -w3[2, ]*1.2, w3[3, ]*1.2) 463 | # XXX <- c(wp1$x, wp2$x, wp3$x) 464 | # YYY <- c(wp1$y, wp2$y, wp3$y) 465 | # color <- col2rgb("mediumseagreen") 466 | # polygon(XXX, YYY, col = rgb(color[1, 1], color[2, 1], color[3, 1], 467 | # 90, maxColorValue = 255), border = FALSE) 468 | # vector of growth rates 469 | rs <- 1.2*r / sqrt(r[1]^2+r[2]^2+r[3]^2) 470 | rgl::lines3d(c(0, rs[1]), c(0, -rs[2]), c(0, rs[3]), col = "red", 471 | lwd = 2) 472 | rs2 <- 1.8*r / sqrt(r[1]^2+r[2]^2+r[3]^2) 473 | rgl::lines3d(c(0, rs2[1]), c(0, -rs2[2]), c(0, rs2[3]), col = "red", 474 | lwd = 0.8) 475 | rgl::text3d(1.5, 0, 0, text = sp_name[1], col = "black", lwd = 0.8) 476 | rgl::text3d(0, -1.5, 0, text = sp_name[2], col = "black", lwd = 0.8) 477 | rgl::text3d(0, 0, 1.5, text = sp_name[3], col = "black", lwd = 0.8) 478 | rgl::aspect3d("iso") 479 | } 480 | 481 | # projection_4sp_3D ==== 482 | # 4 species representation projected on the 3-simplex 483 | projection_4sp_3D <- function(alpha, r, sp_name = paste0("sp", 1:4)){ 484 | D <- diag(1 / sqrt(diag(t(alpha) %*% alpha))) 485 | alpha_n <- alpha %*% D 486 | v1 <- alpha_n[,1] 487 | v2 <- alpha_n[,2] 488 | v3 <- alpha_n[,3] 489 | v4 <- alpha_n[,4] 490 | vc <- (v1 + v2 + v3 + v4) 491 | vc <- vc / sqrt(sum(vc^2)) 492 | vr <- r / sqrt(sum(r^2)) 493 | v1 <- v1 / sum(v1) 494 | v2 <- v2 / sum(v2) 495 | v3 <- v3 / sum(v3) 496 | v4 <- v4 / sum(v4) 497 | vc <- vc / sum(vc) 498 | vr <- vr / sum(vr) 499 | t1 <- c(1, 0, 0, 0) 500 | t2 <- c(0, 1, 0, 0) 501 | t3 <- c(0, 0, 1, 0) 502 | t4 <- c(0, 0, 0, 1) 503 | e1 <- c(1, 0, 0, 0) 504 | e2 <- c(0, 1, 0, 0) 505 | e3 <- c(0, 0, 1, 0) 506 | e4 <- c(0, 0, 0, 1) 507 | w2 <- t(t(e2-e1)) 508 | w3 <- t(t(e3-e1)) 509 | w4 <- t(t(e4-e1)) 510 | A <- pracma::gramSchmidt(cbind(w2, w3, w4)) 511 | TT <- A$R 512 | v1 <- v1[-1] 513 | v2 <- v2[-1] 514 | v3 <- v3[-1] 515 | v4 <- v4[-1] 516 | vc <- vc[-1] 517 | vr <- vr[-1] 518 | t1 <- t1[-1] 519 | t2 <- t2[-1] 520 | t3 <- t3[-1] 521 | t4 <- t4[-1] 522 | v1 <- as.vector(TT %*% v1) 523 | v2 <- as.vector(TT %*% v2) 524 | v3 <- as.vector(TT %*% v3) 525 | v4 <- as.vector(TT %*% v4) 526 | vc <- as.vector(TT %*% vc) 527 | vr <- as.vector(TT %*% vr) 528 | t1 <- as.vector(TT %*% t1) 529 | t2 <- as.vector(TT %*% t2) 530 | t3 <- as.vector(TT %*% t3) 531 | t4 <- as.vector(TT %*% t4) 532 | e1 <- c(0, 0, 0) 533 | e2 <- c(1, 0, 0) 534 | e3 <- c(0, 1, 0) 535 | e4 <- c(0, 0, 1) 536 | e1 <- as.vector(TT %*% e1) 537 | e2 <- as.vector(TT %*% e2) 538 | e3 <- as.vector(TT %*% e3) 539 | e4 <- as.vector(TT %*% e4) 540 | X <- c(e1[1], e2[1]) 541 | Y <- c(e1[2], e2[2]) 542 | Z <- c(e1[3], e2[3]) 543 | rgl::plot3d(X, Y, Z, col = "grey", 544 | xlab = "", ylab = "", zlab = "", type = 'l', lwd = 2, 545 | box = FALSE, axes = FALSE) 546 | X <- c(e1[1], e3[1]) 547 | Y <- c(e1[2], e3[2]) 548 | Z <- c(e1[3], e3[3]) 549 | rgl::lines3d(X, Y, Z, col = "grey", lwd = 2) 550 | X <- c(e1[1], e4[1]) 551 | Y <- c(e1[2], e4[2]) 552 | Z <- c(e1[3], e4[3]) 553 | rgl::lines3d(X, Y, Z, col = "grey", lwd = 2) 554 | X <- c(e2[1], e3[1]) 555 | Y <- c(e2[2], e3[2]) 556 | Z <- c(e2[3], e3[3]) 557 | rgl::lines3d(X, Y, Z, col = "grey", lwd = 2) 558 | X <- c(e2[1], e4[1]) 559 | Y <- c(e2[2], e4[2]) 560 | Z <- c(e2[3], e4[3]) 561 | rgl::lines3d(X, Y, Z, col = "grey", lwd = 2) 562 | X <- c(e3[1], e4[1]) 563 | Y <- c(e3[2], e4[2]) 564 | Z <- c(e3[3], e4[3]) 565 | rgl::lines3d(X, Y, Z, col = "grey", lwd = 2) 566 | X <- c(v1[1], v2[1]) 567 | Y <- c(v1[2], v2[2]) 568 | Z <- c(v1[3], v2[3]) 569 | rgl::lines3d(X, Y, Z, col = "darkgreen", lwd = 2) 570 | X <- c(v1[1], v3[1]) 571 | Y <- c(v1[2], v3[2]) 572 | Z <- c(v1[3], v3[3]) 573 | rgl::lines3d(X, Y, Z, col = "darkgreen", lwd = 2) 574 | X <- c(v1[1], v4[1]) 575 | Y <- c(v1[2], v4[2]) 576 | Z <- c(v1[3], v4[3]) 577 | rgl::lines3d(X, Y, Z, col = "darkgreen", lwd = 2) 578 | X <- c(v2[1], v3[1]) 579 | Y <- c(v2[2], v3[2]) 580 | Z <- c(v2[3], v3[3]) 581 | rgl::lines3d(X, Y, Z, col = "darkgreen", lwd = 2) 582 | X <- c(v2[1], v4[1]) 583 | Y <- c(v2[2], v4[2]) 584 | Z <- c(v2[3], v4[3]) 585 | rgl::lines3d(X, Y, Z, col = "darkgreen", lwd = 2) 586 | X <- c(v3[1], v4[1]) 587 | Y <- c(v3[2], v4[2]) 588 | Z <- c(v3[3], v4[3]) 589 | rgl::lines3d(X, Y, Z, col = "darkgreen", lwd = 2) 590 | X <- v1[1] 591 | Y <- v1[2] 592 | Z <- v1[3] 593 | rgl::points3d(X, Y, Z, col = "darkgreen", size = 8) 594 | X <- v2[1] 595 | Y <- v2[2] 596 | Z <- v2[3] 597 | rgl::points3d(X, Y, Z, col = "darkgreen", size = 8) 598 | X <- v3[1] 599 | Y <- v3[2] 600 | Z <- v3[3] 601 | rgl::points3d(X, Y, Z, col = "darkgreen", size = 8) 602 | X <- v4[1] 603 | Y <- v4[2] 604 | Z <- v4[3] 605 | rgl::points3d(X, Y, Z, col = "darkgreen", size = 8) 606 | X <- vc[1] 607 | Y <- vc[2] 608 | Z <- vc[3] 609 | rgl::points3d(X, Y, Z, col = "darkorange", size = 10) 610 | X <- vr[1] 611 | Y <- vr[2] 612 | Z <- vr[3] 613 | rgl::points3d(X, Y, Z, col = "darkred", size = 10) 614 | rgl::triangles3d(c(v1[1], v2[1], v3[1]), 615 | c(v1[2], v2[2], v3[2]), 616 | c(v1[3], v2[3], v3[3]), 617 | alpha = 0.2, col = "darkgreen") 618 | rgl::triangles3d(c(v1[1], v2[1], v4[1]), 619 | c(v1[2], v2[2], v4[2]), 620 | c(v1[3], v2[3], v4[3]), 621 | alpha = 0.2, col = "darkgreen") 622 | rgl::triangles3d(c(v1[1], v3[1], v4[1]), 623 | c(v1[2], v3[2], v4[2]), 624 | c(v1[3], v3[3], v4[3]), 625 | alpha = 0.2, col = "darkgreen") 626 | rgl::triangles3d(c(v3[1], v2[1], v4[1]), 627 | c(v3[2], v2[2], v4[2]), 628 | c(v3[3], v2[3], v4[3]), 629 | alpha = 0.2, col = "darkgreen") 630 | X <- t1[1]-.07 # offset species labels position 631 | Y <- t1[2]-.07 632 | Z <- t1[3] 633 | rgl::text3d(X, Y, Z, text = sp_name[1]) 634 | X <- t2[1]+.07 635 | Y <- t2[2]-.07 636 | Z <- t2[3] 637 | rgl::text3d(X, Y, Z, text = sp_name[2]) 638 | X <- t3[1] 639 | Y <- t3[2]+.1 640 | Z <- t3[3] 641 | rgl::text3d(X, Y, Z, text = sp_name[3]) 642 | X <- t4[1] 643 | Y <- t4[2] 644 | Z <- t4[3]+.1 645 | rgl::text3d(X, Y, Z, text = sp_name[4]) 646 | rgl::aspect3d("iso") 647 | } 648 | 649 | # test_feasibility_trips ==== 650 | # test feasibility of species triplets 651 | test_feasibility_trips <- function(alpha, r) { 652 | out <- c() 653 | v <- 1:4 654 | for (i in v) { 655 | if (test_feasibility(alpha[-i, -i], r[-i])) { 656 | out <- paste(out, paste(v[!v == i], collapse = " + "), sep = ", ") 657 | } 658 | } 659 | return(substr(out, 3, nchar(out))) 660 | } 661 | 662 | #################################################- 663 | # Shiny server logic ---- 664 | #################################################- 665 | # This section takes inputs from the ui and displays the desired 666 | # information using the code from Saavedra et al. above 667 | shinyServer(function(input, output, session) { 668 | # Apply pre-set scenarios 669 | # 3sp: toggle to near-neutral scenario #### 670 | observeEvent(input$neutral3, { 671 | updateMatrixInput(session = session, 672 | inputId = "alphamat", 673 | value = matrix(c(1, 0.999, 0.999, 674 | 0.998, 1, 0.999, 675 | 0.999, 0.999, 1), 676 | nrow = 3, 677 | dimnames = list(c("α(1,_)", "α(2,_)", "α(3,_)"), c("α(_,1)", "α(_,2)", "α(_,3)")), 678 | byrow = TRUE)) 679 | updateNumericInput(session, "r1", value = 1) 680 | updateNumericInput(session, "r2", value = 1) 681 | updateNumericInput(session, "r3", value = 1) 682 | }) 683 | # 3sp: toggle to intransient (rock-paper-scissors) scenario #### 684 | observeEvent(input$intransient3, { 685 | updateMatrixInput(session = session, 686 | inputId = "alphamat", 687 | value = matrix(c(0.5, 0.05, 1.5, 688 | 1.5, 0.5, 0.05, 689 | 0.05, 1.5, 0.5), 690 | nrow = 3, 691 | dimnames = list(c("α(1,_)", "α(2,_)", "α(3,_)"), c("α(_,1)", "α(_,2)", "α(_,3)")), 692 | byrow = TRUE)) 693 | updateNumericInput(session, "r1", value = 1) 694 | updateNumericInput(session, "r2", value = 0.6) 695 | updateNumericInput(session, "r3", value = 0.9) 696 | }) 697 | # 3sp: toggle to weak intraspecific interactions scenario #### 698 | observeEvent(input$weakintra3, { 699 | updateMatrixInput(session = session, 700 | inputId = "alphamat", 701 | value = matrix(c(1, 0.05, 0.05, 702 | 0.05, 1, 0.05, 703 | 0.05, 0.05, 1), 704 | nrow = 3, 705 | dimnames = list(c("α(1,_)", "α(2,_)", "α(3,_)"), c("α(_,1)", "α(_,2)", "α(_,3)")), 706 | byrow = TRUE)) 707 | updateNumericInput(session, "r1", value = 1) 708 | updateNumericInput(session, "r2", value = 0.15) 709 | updateNumericInput(session, "r3", value = 0.15) 710 | }) 711 | # 4sp: toggle to near-neutral scenario #### 712 | observeEvent(input$neutral4, { 713 | updateMatrixInput(session = session, 714 | inputId = "alphamat4", 715 | value = matrix(c(1, 0.999, 0.999, 0.999, 716 | 0.998, 1, 0.999, 0.999, 717 | 0.999, 0.999, 1, 0.999, 718 | 0.999, 0.999, 0.999, 1), 719 | nrow = 4, 720 | dimnames = list(c("α(1,_)", "α(2,_)", "α(3,_)", "α(4,_)"), 721 | c("α(_,1)", "α(_,2)", "α(_,3)", "α(_,4)")), 722 | byrow = TRUE)) 723 | updateNumericInput(session, "rr1", value = 1) 724 | updateNumericInput(session, "rr2", value = 1) 725 | updateNumericInput(session, "rr3", value = 1) 726 | updateNumericInput(session, "rr4", value = 1) 727 | }) 728 | # 4sp: toggle to weak intraspecific interactions scenario #### 729 | observeEvent(input$weakintra4, { 730 | updateMatrixInput(session = session, 731 | inputId = "alphamat4", 732 | value = matrix(c(1, 0.05, 0.05, 0.05, 733 | 0.05, 1, 0.05, 0.05, 734 | 0.05, 0.05, 1, 0.05, 735 | 0.05, 0.05, 0.05, 1), 736 | nrow = 4, 737 | dimnames = list(c("α(1,_)", "α(2,_)", "α(3,_)", "α(4,_)"), 738 | c("α(_,1)", "α(_,2)", "α(_,3)", "α(_,4)")), 739 | byrow = TRUE)) 740 | updateNumericInput(session, "rr1", value = 1) 741 | updateNumericInput(session, "rr2", value = 0.15) 742 | updateNumericInput(session, "rr3", value = 0.15) 743 | updateNumericInput(session, "rr4", value = 0.15) 744 | }) 745 | # render table with coexistence metrics -- 3 species #### 746 | output$stats <- renderTable({ 747 | r <- c(input$r1, input$r2, input$r3) 748 | feas_pairs <- test_feasibility_pairs(input$alphamat, r) 749 | feas_txt <- ifelse(sum(feas_pairs$feasibility) == 0L, 750 | "none", 751 | ifelse(sum(feas_pairs$feasibility) == 1L, 752 | paste(feas_pairs$pairs[, which(feas_pairs$feasibility == 1L)], 753 | collapse = " + "), 754 | paste(apply(feas_pairs$pairs[, which(feas_pairs$feasibility == 1L)], 755 | MARGIN = 2, FUN = paste, 756 | collapse = " + "), 757 | collapse = ", "))) 758 | data.frame(Metric = c("Structural niche difference (Ω)", 759 | "Structural fitness difference (θ)", 760 | HTML("Centroid of feasibility domain (rc)"), 761 | "Feasible triplet?", 762 | paste0("Feasible pairs (", 763 | ifelse(feas_txt == "none", 764 | 0, 765 | (nchar(feas_txt)+2)/7), 766 | "/3)")), 767 | Value = c(paste0(round(10^(Omega(alpha=input$alphamat)), 768 | 3), "㏛"), 769 | paste0(round(theta(input$alphamat, r), 3), "°"), 770 | paste(round(r_centroid(input$alphamat), 3), 771 | collapse = ", "), 772 | ifelse(test_feasibility(input$alphamat, r) == 1L, 773 | "yes", "no"), 774 | feas_txt))}, 775 | sanitize.text.function = function(x) x) 776 | # render table with coexistence metrics -- 4 species #### 777 | output$stats4sp <- renderTable({ 778 | rr <- c(input$rr1, input$rr2, input$rr3, input$rr4) 779 | feas_pairs <- test_feasibility_pairs(input$alphamat4, rr) 780 | feas_trips <- test_feasibility_trips(input$alphamat4, rr) 781 | feas_txt <- ifelse(sum(feas_pairs$feasibility) == 0L, 782 | "none", 783 | ifelse(sum(feas_pairs$feasibility) == 1L, 784 | paste(feas_pairs$pairs[, which(feas_pairs$feasibility == 1L)], 785 | collapse = " + "), 786 | paste(apply(feas_pairs$pairs[, which(feas_pairs$feasibility == 1L)], 787 | MARGIN = 2, FUN = paste, 788 | collapse = " + "), 789 | collapse = ", "))) 790 | data.frame(Metric = c("Structural niche difference (Ω)", 791 | "Structural fitness difference (θ)", 792 | HTML("Centroid of feasibility domain (rc)"), 793 | "Feasible quadruplet?", 794 | paste0("Feasible triplets (", 795 | (nchar(feas_trips)+2)/11, 796 | "/4)"), 797 | paste0("Feasible pairs (", 798 | (nchar(feas_txt)+2)/7, 799 | "/6)")), 800 | Value = c(paste0(round(10^(Omega(alpha = input$alphamat4)), 801 | 3), "㏛"), 802 | paste0(round(theta(input$alphamat4, rr), 3), 803 | "°"), 804 | paste(round(r_centroid(input$alphamat4), 3), 805 | collapse = ", "), 806 | ifelse(test_feasibility(input$alphamat4, rr) == 1L, 807 | "yes", "no"), 808 | feas_trips, 809 | feas_txt))}, 810 | sanitize.text.function = function(x) x) 811 | # render network plot -- 3 species #### 812 | output$network_3sp <- renderPlot({ 813 | mk_graph_3sp(input$alphamat, 814 | rs = c(input$r1, input$r2, input$r3)) 815 | }) 816 | # render network plot -- 4 species #### 817 | output$network_4sp <- renderPlot({ 818 | mk_graph_4sp(input$alphamat4, 819 | rs = c(input$rr1, input$rr2, input$rr3, input$rr4)) 820 | }) 821 | # render static 3D cone #### 822 | output$cone <- renderPlot({ 823 | cone_3sp(input$alphamat) 824 | }) 825 | # render 3 species plot #### 826 | output$proj <- renderPlot({ 827 | projection_3sp_with_pairwise(input$alphamat, 828 | r = c(input$r1, input$r2, input$r3)) 829 | }) 830 | # render interactive cone -- 3 species #### 831 | output$cone3d <- rgl::renderRglwidget({ 832 | rgl::open3d(useNULL = TRUE) 833 | plot_cone_3D(input$alphamat, r = c(input$r1, input$r2, input$r3)) 834 | rgl::rglwidget() 835 | }) 836 | # render interactive cone -- 4 species #### 837 | output$proj4sp <- rgl::renderRglwidget({ 838 | rgl::open3d(useNULL = TRUE) 839 | projection_4sp_3D(input$alphamat4, r = c(input$rr1, input$rr2, 840 | input$rr3, input$rr4)) 841 | rgl::rglwidget() 842 | }) 843 | }) 844 | --------------------------------------------------------------------------------