Skip to content
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

Jump to bottom

Esthaetics #4

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

Esthaetics #4

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
ed4d562
Click for mother points + Text boxes for SAD parameters sigma and n.m…
AlbanSagouis Oct 11, 2019
5dc6424
Switching to a grid like structure of simulation preparation
AlbanSagouis Oct 11, 2019
1083553
More dynamic rendering following method choice
AlbanSagouis Oct 17, 2019
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
235 changes: 203 additions & 32 deletions server.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -11,6 +11,7 @@ library(shiny)
# library(devtools)
# install_github('MoBiodiv/mobsim') # downloads the latest version of the package
library(mobsim, lib.loc="./Library")
library(ggplot2)

# Define server logic for slider examples
shinyServer(function(input, output, session) {
Expand All @@ -20,45 +21,215 @@ shinyServer(function(input, output, session) {
# }

# update range for species richness, an observed species has minimum one individual
observe({
updateSliderInput(session, "S", min=5, max=input$N, value=5, step=5)
})
observe({
updateSliderInput(session, "S", min=5, max=input$N, value=5, step=5)
})
# update the number of species in the drop down species list.
observe({
updateSelectInput(session, "species_ID", "Pick species ID", paste("species", 1:input$S, sep="_"))
})

values <- reactiveValues()
values$DT <- data.frame(x = numeric(),
y = numeric(),
species_ID = factor())

output$select_sad_type <- renderUI({
if (!input$method_type %in% c("random_mother_points","click_for_mother_points")) {
return()
} else {
selectizeInput("sad_type", "SAD Type", choices=c("lognormal"="lnorm","geometric"="geom","Fisher's log-series"="ls"))
}
})


output$ui <- renderUI({
if (is.null(input$sad_type))
return()
switch(input$sad_type,
"lnorm"=sliderInput("coef", label="CV(abundance), i.e. standard deviation of abundances divided by the mean abundance",value=1, min=0, max=5, step=0.1, ticks=F),
"geom"=sliderInput("coef",label="Probability of success in each trial. 0 < prob <= 1",value=0.5,min=0,max=1,step=0.1, ticks=F),
"ls"=textInput("coef",label="Fisher's alpha parameter",value=1)
)
})

output$CVslider <- renderUI({
if (!input$method_type %in% c("random_mother_points","click_for_mother_points") | is.null(input$sad_type))
return()
switch(input$sad_type,
"lnorm"=sliderInput("coef", label="CV(abundance), i.e. standard deviation of abundances divided by the mean abundance",value=1, min=0, max=5, step=0.1, ticks=F),
"geom"=sliderInput("coef",label="Probability of success in each trial. 0 < prob <= 1",value=0.5,min=0,max=1,step=0.1, ticks=F),
"ls"=textInput("coef",label="Fisher's alpha parameter",value=1)
)
})

output$text_spat_agg <- renderUI({
if (!input$method_type %in% c("random_mother_points","click_for_mother_points")) {
return()
} else {
textInput(inputId="spatagg", label="Spatial Aggregation (mean distance from mother points)", value = 0.1)
}
})


output$spatdist <- renderUI({
if (input$method_type != "random_mother_points") {
return()
} else {
selectizeInput(inputId="spatdist", "Cluster parameter", choices = c("Number of mother points"="n.mother", "Number of clusters"="n.cluster"))
}
})

output$spatcoef <- renderUI({
if (input$method_type != "random_mother_points") {
return()
} else {
textInput(inputId="spatcoef",label="Integer values separated by commas", value="1")
}
})



output$species_ID_input <- renderUI({
if (input$method_type != "click_for_mother_points") {
return()
} else {
selectInput("species_ID", "Pick species ID", paste("species", 1:input$S, sep="_"))
}
})

output$on_plot_selection <- renderPlot({
if (is.null(input$method_type)) {
return()
} else {
if(input$method_type=="click_for_mother_points") {
color_vector <- rainbow(input$S)
par(mex=0.7, mar=c(3,3,1,1))
plot(x=values$DT$x, y=values$DT$y, col=color_vector[values$DT$species_ID], xlim=c(0,1), ylim=c(0,1), xlab="", ylab="", las=1, asp=1, pch=20)
abline(h=c(0,1), v=c(0,1), lty=2)
}
}
})


output$rem_point_button <- renderUI({
if (input$method_type != "click_for_mother_points") {
return()
} else {
actionButton("rem_point", "Remove Last Point")
}
})

output$rem_all_points_button <- renderUI({
if (input$method_type != "click_for_mother_points") {
return()
} else {
actionButton("rem_all_points", "Remove All Points")
}
})


output$info <- renderUI({
if (input$method_type != "click_for_mother_points") {
return()
} else {
verbatimTextOutput("info", placeholder=F)
}
})


output$community <- renderUI({
if (input$method_type != "uploading_community_data") {
return()
} else {
fileInput(inputId="sim.com", label="Choose rData community File", multiple = FALSE,
accept = "", width = NULL,
buttonLabel = "Browse...", placeholder = "No file selected") # c("text/csv", "text/comma-separated-values,text/plain", ".csv")
}
})



observeEvent(input$plot_click, { # The data.frame could be a matrix with already existing data: "no clustering" to allow users not to cluster some species.
add_row = data.frame(x = input$plot_click$x,
y = input$plot_click$y,
species_ID = factor(input$species_ID, levels = paste("species", 1:input$S, sep="_")))
values$DT = rbind(values$DT, add_row)
})


observeEvent(input$rem_all_points, {
rem_row = values$DT[-(1:nrow(values$DT)), ]
values$DT = rem_row
})

observeEvent(input$rem_point, {
rem_row = values$DT[-nrow(values$DT), ]
values$DT = rem_row
})

## point coordinates
output$info <- renderText({
xy_str <- function(e) {
if(is.null(e)) return("NULL\n")
paste0("x=", round(e$x, 1), " y=", round(e$y, 1), "\n")
}
xy_range_str <- function(e) {
if(is.null(e)) return("NULL\n")
paste0("xmin=", round(e$xmin, 1), " xmax=", round(e$xmax, 1),
" ymin=", round(e$ymin, 1), " ymax=", round(e$ymax, 1))
}
paste0(
"click: ", xy_str(input$plot_click),
"brush: ", xy_range_str(input$plot_brush)
)
})

## plot theme

output$InteractivePlot <- renderPlot({
input$Restart

isolate({
set.seed(229376)

n.mother <- ifelse(input$spatdist=="n.mother", as.numeric(input$spatcoef), NA)
n.cluster <- ifelse(input$spatdist=="n.cluster", as.numeric(input$spatcoef), NA)

sim.com <- switch(input$sad_type,
"lnorm"=sim_thomas_community(s_pool = input$S, n_sim = input$N,
sigma=input$spatagg, mother_points=n.mother, cluster_points=n.cluster,
sad_type = input$sad_type, sad_coef=list(cv_abund=input$coef),
fix_s_sim = T),
"geom"=sim_thomas_community(s_pool = input$S, n_sim = input$N, sigma=input$spatagg, mother_points=n.mother, cluster_points=n.cluster, sad_type = input$sad_type,
sad_coef=list(prob=input$coef),
fix_s_sim = T),
"ls"=sim_thomas_community(s_pool = input$S, n_sim = input$N, sigma=input$spatagg, mother_points=n.mother, cluster_points=n.cluster,
sad_type = input$sad_type,
sad_coef=list(N=input$N,alpha=as.numeric(input$coef)),
fix_s_sim = T)

)

set.seed(229376)

if(input$method_type != "uploading_community_data") {

spatagg_num <- as.numeric(unlist(strsplit(trimws(input$spatagg), ",")))
spatcoef_num <- as.numeric(unlist(strsplit(trimws(input$spatcoef), ",")))

if(input$spatdist=="n.mother") n.mother <- spatcoef_num else n.mother <- NA
if(input$spatdist=="n.cluster") n.cluster <- spatcoef_num else n.cluster <- NA

simulation_parameters <- switch(input$method_type,
"random_mother_points"=list(mother_points=n.mother,
cluster_points=n.cluster,
xmother=NA,
ymother=NA),
"click_for_mother_points"=list(mother_points=NA,
cluster_points=NA,
xmother=tapply(values$DT$x, values$DT$species_ID, list),
ymother=tapply(values$DT$y, values$DT$species_ID, list))
)

# if(input$method_type == "click_for_mother_points") { # if the user does not set any point for some species: no clustering
# species_list <- paste("species", 1:input$S, sep="_")
# missing_species <- species_list[!species_list %in% values$DT$species_ID]
# if(length(missing_species) > 0) {
# xmother[missing_species] <- "no_clustering"
# ymother[missing_species] <- "no_clustering"
# }
# xmother[is.na(xmother)] <- "no clustering"
# ymother[is.na(ymother)] <- "no clustering"
# }

sim.com <- switch(input$sad_type,
"lnorm"=sim_thomas_community(s_pool = input$S, n_sim = input$N,
sigma=spatagg_num, mother_points=simulation_parameters$mother_points, cluster_points=simulation_parameters$cluster_points, xmother=simulation_parameters$xmother, ymother=simulation_parameters$ymother,
sad_type = input$sad_type, sad_coef=list(cv_abund=input$coef),
fix_s_sim = T),
"geom"=sim_thomas_community(s_pool = input$S, n_sim = input$N,
sigma=spatagg_num, mother_points=simulation_parameters$mother_points, cluster_points=simulation_parameters$cluster_points, xmother=simulation_parameters$xmother, ymother=simulation_parameters$ymother,
sad_type = input$sad_type, sad_coef=list(prob=input$coef),
fix_s_sim = T),
"ls"=sim_thomas_community(s_pool = input$S, n_sim = input$N,
sad_type = input$sad_type, sad_coef=list(N=input$N,alpha=as.numeric(input$coef)),
sigma=spatagg_num, mother_points=simulation_parameters$mother_points, cluster_points=simulation_parameters$cluster_points, xmother=simulation_parameters$xmother, ymother=simulation_parameters$ymother,
fix_s_sim = T)
)
}

layout(matrix(c(1,2,3,
4,5,6), byrow = T, nrow = 2, ncol = 3),
heights = c(1,1), widths=c(1,1,1))
Expand Down
107 changes: 66 additions & 41 deletions ui.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -13,47 +13,72 @@ library(mobsim)

# Define UI for slider demo application

fluidPage(
titlePanel("Visualization of biodiversity pattern"),

sidebarLayout(

sidebarPanel(

# Slider inputs
sliderInput("N", "Number of individuals",
min=10, max=5000, value=1000, step=50, ticks=F),

sliderInput("S", "Species Richness",
min=10, max=500, value=50, step=10, ticks=F),

selectizeInput("sad_type", "SAD Type", choices=c("lognormal"="lnorm","geometric"="geom","Fisher's log-series"="ls")),
#,
# options = list(placeholder = 'Please select an option below',onInitialize = I('function() { this.setValue(""); }')),
navbarPage("Visualization of biodiversity pattern",
tabPanel("Plot",

# This outputs the dynamic UI component
uiOutput("ui"),
fluidPage(
fluidRow(
column(width=4,
# Slider inputs
sliderInput("N", "Number of individuals",
min=10, max=5000, value=500, step=50, ticks=F),

sliderInput("S", "Species Richness",
min=5, max=500, value=5, step=5, ticks=F),

selectizeInput("method_type", label="Method", choices=c("Random mother points"="random_mother_points", "Click for mother points"="click_for_mother_points", "User community file"="uploading_community_data"), selected="Random mother points", multiple=FALSE)

sliderInput("spatagg", "Spatial Aggregation (mean distance from mother points)",
min = 0, max = 2, value = 0.1, step= 0.01, ticks=F),

selectizeInput("spatdist", "Cluster parameter", choices = c("Number of mother points"="n.mother", "Number of clusters"="n.cluster")),

textInput("spatcoef",""),

# Action button
actionButton(inputId="Restart",label="Restart Simulation")#,

# Check box
# checkboxInput('keep', 'Keep last simulation', FALSE)
),

mainPanel(
tabsetPanel(
tabPanel("Introduction", includeMarkdown("introduction.md")),
tabPanel("Plot", plotOutput("InteractivePlot", height="600px",width="750px"))
)
)
)

),
column(width=4,
uiOutput("select_sad_type"),
# This outputs the dynamic UI (user input) component (CV(abundance))
uiOutput("CVslider"),

#sliderInput("spatagg", "Spatial Aggregation (mean distance from mother points)", min = 0, max = 2, value = 0.1, step= 0.01, ticks=F),
uiOutput("text_spat_agg"),

uiOutput("spatdist"),
uiOutput("spatcoef"),

uiOutput("community")
),

column(width=4,
uiOutput("species_ID_input"),
plotOutput("on_plot_selection",
click = "plot_click",
brush = "plot_brush"
),

uiOutput("rem_point_button"),
uiOutput("rem_all_points_button"),

# tableOutput("table"),
uiOutput("info")
)
)
),


fluidRow(
column(width=6, offset=5,
# Action button
actionButton(inputId="Restart",label="Restart Simulation")#,

# Check box
# checkboxInput('keep', 'Keep last simulation', FALSE)
),
column(width=1)
),

fluidRow(
column(width=8, offset=3,
plotOutput("InteractivePlot", height="600px",width="750px")
),
column(width=1)
)
),

tabPanel("Introduction", includeMarkdown("introduction.md"))
# another tabPanel "Saved simulation" with the previous sim?
)