-
Notifications
You must be signed in to change notification settings - Fork 0
/
server.R
executable file
·118 lines (88 loc) · 4.94 KB
/
server.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
shinyServer(
function(input, output, session){
# Thin MCMC
dthin <- reactive( thin(d, input$mcmc) )
# Simulate covariates
covs <- reactive( simcov(input$popname, forecastyear=input$forecastyear, nsim=input$nsim,
hist.bkt=input$hist.bkt, extent=input$extent,
cut=list(templag=input$cut.temp, hflowlag=input$cut.hflow, ndvi=input$cut.ndvi, bkt=c(0,1)),
const=list(bkt=input$const.bkt, reintro=c(rep(input$add1, input$add1t), rep(input$add2, input$add2t)), templag=NA, hflowlag=NA, ndvi=NA)) )
# Simulate population
simN <- reactive( simpop(input$popname, covs=covs(), forecastyear=input$forecastyear,
demsto=input$demsto, ci=input$ci,
model=dthin()) )
# Stats from simulations for plots
sim <- reactive( simstat(input$popname, simN=simN(), forecastyear=input$forecastyear, ci=input$ci) )
# Plot population
output$simPlot <- renderPlot( plotpop(input$popname, sim()) )
# Plot covariates
output$covPlot <- renderPlot( plotcov(input$popname, forecastyear=input$forecastyear, covs=covs(), sim=sim(), ci=input$ci) )
# Plot effects
output$effectPlot <- renderPlot( ploteffect(input$popname, covs=covs(), sim=sim(),
forecastyear=input$forecastyear, ci=input$ci,
model=dthin()) )
# Plot detection
output$detectPlot <- renderPlot( plotdet(input$popname, model=dthin(), ci=input$ci) )
# Map
output$map <- renderLeaflet(map())
observeEvent(input$popname, proxy(input$popname))
observeEvent(input$map_shape_click$id, {
if(input$map_shape_click$id %in% allpopnames) updateSelectInput(session, 'popname', selected=input$map_shape_click$id)
})
# Raw data
output$dataTable <- renderTable( rawdata(input$popname), striped=T, digits=0, na="", align='c' )
# Batch
output$batchTable <- renderTable({
input$batchButton
isolate(simbatch(primepop=input$popname, pops=input$batchnames, forecastyear=input$forecastyear, nsim=input$nsim, nmcmc=input$mcmc,
add1=input$add1, add1t=input$add1t, add2=input$add2, add2t=input$add2t,
hist.bkt=input$hist.bkt, extent=input$extent,
cut=list(templag=input$cut.temp, hflowlag=input$cut.hflow, ndvi=input$cut.ndvi, bkt=c(0,1)),
const=list(bkt=input$const.bkt, reintro=c(rep(input$add1, input$add1t), rep(input$add2, input$add2t)), templag=NA, hflowlag=NA, ndvi=NA),
demsto=NA, ci=input$ci, model=dthin()))
},striped=T, digits=3, na="", align='c')
observeEvent(input$batchGMU, {
if(!input$batchGMU==""){
updateSelectizeInput(session, 'batchState', selected="")
updateSelectInput(session, 'batchnames', selected=metapop[metapop$GMU==input$batchGMU, 'PopulationName'])
updateSelectizeInput(session, 'batchGMU', selected="")
}
})
observeEvent(input$batchState, {
if(!input$batchState==""){
updateSelectizeInput(session, 'batchGMU', selected="")
updateSelectInput(session, 'batchnames', selected=metapop[metapop$US_State==input$batchState, 'PopulationName'])
updateSelectizeInput(session, 'batchState', selected="")
}
})
observeEvent(input$batchRemoveNoData, {
updateSelectInput(session, 'batchnames', selected=input$batchnames[input$batchnames %in% streams.lahontan$PopulationName])
})
observeEvent(input$batchRemovewData, {
updateSelectInput(session, 'batchnames', selected=input$batchnames[!input$batchnames %in% streams.lahontan$PopulationName])
})
observeEvent(input$batchClear, {
updateSelectInput(session, 'batchnames', selected="")
})
# Reset button
observe( resetButton(session, input$reset, input$popname, dthin()) )
# Dynamic default values
observeEvent(input$popname, {
updateSliderInput(session, 'const.bkt', value=bkt.dat[input$popname, as.character(lastyear)]*scale.factors[scale.factors$cov=='bkt','sd'])
if(input$popname %in% recnames) {
subpopnames <- metapop[metapop$MetaPop_Name==metapop[input$popname, 'MetaPop_Name'], 'PopulationName']
subpopnames <- subpopnames[!grepl('Reconnect', subpopnames) & !is.na(subpopnames)]
subpopnums <- which(popnames %in% subpopnames)
} else {subpopnums <- c()}
if(input$popname %in% popnames){
updateSliderInput(session, 'demsto', value=median(dthin()[,paste('sigmaR[',which(popnames==input$popname),']',sep='')]))
}
else if(input$popname %in% recnames & length(subpopnums)>0) {
sigmaR <- apply(as.matrix(dthin()[,paste('sigmaR[',subpopnums,']',sep='')]), 1, mean)
updateSliderInput(session, 'demsto', value=median(sigmaR))
}
else {
updateSliderInput(session, 'demsto', value=median(dthin()[,'musig']))
}
})
})