-
Notifications
You must be signed in to change notification settings - Fork 0
/
app.R
3029 lines (2499 loc) · 171 KB
/
app.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
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
# Leslie matrix projection R Shiny app
# Corey Bradshaw
# Flinders University
## remove everything
rm(list = ls())
# load libraries
library(shiny)
library(shinybusy)
library(ggplot2)
library(tsoutliers)
## call functions
source(file.path("./functions/", "createLmatrix.R"), local=T)
source(file.path("./functions/", "maxLambda.R"), local=T)
source(file.path("./functions/", "maxR.R"), local=T)
source(file.path("./functions/", "Gval.R"), local=T)
source(file.path("./functions/", "Rval.R"), local=T)
source(file.path("./functions/", "StableStageDist.R"), local=T)
source(file.path("./functions/", "projLmatrix.R"), local=T)
source(file.path("./functions/", "projStochMatrix.R"), local=T)
source(file.path("./functions/", "projStochPulse.R"), local=T)
source(file.path("./functions/", "projStochPress.R"), local=T)
source(file.path("./functions/", "StochMVP.R"), local=T)
source(file.path("./functions/", "LogPowFunc.R"), local=T)
source(file.path("./functions/", "predictNLS.R"), local=T)
source(file.path("./functions/", "estBetaParams.R"), local=T)
source(file.path("./functions/", "setBackgroundColor.R"), local=T)
ui <- fluidPage(
# title of app
titlePanel("Leslie-matrix projection of a population"),
tags$style("@import url(https://use.fontawesome.com/releases/v5.7.2/css/all.css);"),
setBackgroundColor(
color = "#7fda5d",
gradient = c("linear"),
direction = c("bottom")
),
wellPanel(style = "background: #d7f9da",
tags$img(height = 150, src = "LmatrixLifeCycleGraph.png", style="float:right"),
tags$p(style="font-family:Avenir", tags$i(class="fab fa-r-project", title="R Project"),"Shiny App by", tags$a(href="https://globalecologyflinders.com/people/#CJAB", "Corey Bradshaw "),
tags$a(href = "mailto:[email protected]","(",tags$i(class="far fa-envelope"),"e-mail"),";",
tags$a(href = "https://github.com/cjabradshaw", tags$i(class="fab fa-github",title="Github"),"Github)")),
tags$h4(style="font-family:Avenir", "Preamble"),
tags$p(style="font-family:Avenir", "This app projects a user-defined Leslie (age-classified) matrix to examine population changes through time. This fully
customisable app includes a density-feedback function on survival relative to desired initial population size and carrying capacity,
stochastic projections with user-defined variance for survival, a generationally scaled catastrophe function, a single 'pulse' disturbance
function, and a 'press' disturbance function with a user-defined time application."),
tags$p(style="font-family:Avenir", "A detailed instructions",tags$i(class="fas fa-directions"), "tab (tab I) is included for guidance, but a brief sequence description is included below.
User-defined settings in each tab are carried over to subsequent tabs."),
tags$ol(type="A", tags$li(tags$p(style="font-family:Avenir",tags$strong("SET-UP"),tags$i(class="fas fa-pencil-ruler"),": set matrix dimensions (longevity), age",tags$em("x"),"-specific survival
(",tags$em("s", tags$sub("x")),") and fertility (",tags$em("f",tags$sub("x")), ") probabilities,
offspring sex ratio, % variance around survival/fertility probabilities, and whether lifespan is abrupt or diffuse.")),
tags$li(tags$p(style="font-family:Avenir",tags$strong("MATRIX PROPERTIES"),tags$i(class="fas fa-table"),": shows Leslie matrix according to settings in tab A (or for a previously defined matrix that you can upload),
as well as the dominant eigen value",tags$em("λ"), "instantaneous rate of population change", tags$em("r"),"generation length",
tags$em("G"), ", and reproduction number R0 (number of ♀ offspring/adult ♀).")),
tags$li(tags$p(style="font-family:Avenir",tags$strong("DENSITY FEEDBACK"),tags$i(class="fas fa-exchange-alt"),": set initial population size and carrying capacity", tags$em("K"),
", as well as the three coefficients (", tags$em("a"),",",tags$em("b"),",",tags$em("c"),") from a logistic power function to define the relationship between a survival modifier",
tags$em("S"),tags$sub("mod"),"and population size.")),
tags$img(height = 100, src = "Amatrix.png", style="float:right"),
tags$li(tags$p(style="font-family:Avenir",tags$strong("PROJECT"),tags$i(class="fas fa-chart-line"),": deterministic projection of the population, setting the number of years
(or generations) to project the population, initial population size, and whether to invoke the density-feedback function
set in the previous tab.")),
tags$li(tags$p(style="font-family:Avenir",tags$strong("STOCHASTIC"),tags$i(class="fas fa-bolt"),": stochastic projection of the population based on previous settings
(including the % variances set in the first tab); the user can set the number of iterations to repeat the stochastic
resampling, the quasi-extinction threshold (population size below which it is considered functionally extinct), and whether to
invoke a generationally scaled catatastrophic mortality probability (the magnitude and variance of which can be set by the user).")),
tags$li(tags$p(style="font-family:Avenir",tags$strong("SINGLE PULSE"),tags$i(class="fas fa-level-down-alt"),": a single 'pulse' disturbance, where the user can set the disturbance
to be either a proportion of the total population that is removed, or a fixed number of individuals removed, at the time (year)
the user wishes to invoke the pulse.")),
tags$img(height = 100, src = "GEL Logo Kaurna transparent.png", style="float:right"),
tags$li(tags$p(style="font-family:Avenir",tags$strong("PRESS"),tags$i(class="fas fa-compress-arrows-alt"),": a press disturbance, where the user can set the disturbance
to be either a proportion of the total population that is removed, or a fixed number of individuals removed, during the interval
over which the user wishes to invoke the press.")),
tags$li(tags$p(style="font-family:Avenir",tags$strong("MVP"),tags$i(class="fas fa-search-minus"),": calculate the minimum viable population
size according to the parameters set in previous tabs."))
),
tags$p(style="font-family:Avenir", "This", tags$i(class="fab fa-github"), "Github ",
tags$a(href = "https://github.com/cjabradshaw/LeslieMatrixShiny", "repository"),
"provides all the 'under-the-bonnet'",tags$i(class="fab fa-r-project"),"code for the app."),
),
tabsetPanel(id="tabs",
tabPanel(value="tab1", title=tags$strong("A. SET-UP", tags$i(class="fas fa-pencil-ruler")),
wellPanel(style = "background: #d7f9da",
tags$h3(style="font-family:Avenir", tags$i(class="fas fa-pencil-ruler"), "set base parameters for matrix set-up"),
fluidRow(
column(2,
selectInput("agemax", label=tags$p("1. ",tags$i(class='fas fa-hourglass-end'), "max age (years,",tags$em("X"),")"),
choices = seq(1,150,1), selected=(5))),
column(2,
numericInput(inputId = "survmax", label=tags$p("2. ", tags$i(class='fas fa-heart'), "adult", tags$em("s"),tags$sub("max")),
value=0.9, min=0, max=1, step=0.01)),
column(2,
numericInput(inputId = "fertmax", label=tags$p("3. ",tags$i(class='fas fa-egg'), "max offspring/♀"), value=(2))),
column(2,
numericInput(inputId = "primiparity", label=tags$p("4. ",tags$i(class='fas fa-venus'), "age 1st breeding",tags$em("α")), value=(1))),
column(2,
sliderInput(inputId = "sexratio", label=tags$p("5. ",tags$i(class='fas fa-venus-mars'), "offspring sex ratio (% ♀)"),
min=0, max=100, value=(50), round=F, ticks=F, step=1)),
column(2,
radioButtons("longevAbr", label=tags$p("6. ",tags$i(class='fas fa-skull-crossbones'), "abrupt end to lifespan?"), inline=T,
choiceNames = list((icon("fas fa-thumbs-down")), (icon("fas fa-thumbs-up"))), choiceValues = list("no","abrupt")))
) # end fluidRow
), # end wellPanel
mainPanel(
fluidRow(
column(3,
actionButton("SFfill", label=tags$p(style="font-family:Avenir", "set",tags$em("S"),"/",tags$em("F"),"vectors"),
icon=shiny::icon("fas fa-list-ol"))),
tags$br()
),
fluidRow(
tags$br(),
column(3,
wellPanel(style = "background: #d7f9da",
tags$p(style="font-family:Avenir", tags$strong("7.",tags$i(class='fas fa-heart'), "set", tags$em("s"),
tags$sub(tags$em("x")))),uiOutput("Ssliders"))),
column(3,
wellPanel(style = "background: #d7f9da",
tags$p(style="font-family:Avenir", tags$strong("8.",tags$i(class='fas fa-wave-square'), "set SD(",tags$em("s"),
tags$sub(tags$em("x"))),") (%)"),uiOutput("SSDsliders"))),
column(3,
wellPanel(style = "background: #d7f9da",
tags$p(style="font-family:Avenir", tags$strong("9.",tags$i(class='fas fa-egg'), "set", tags$em("f"),
tags$sub(tags$em("x")))),uiOutput("Fsliders"))),
column(3,
wellPanel(style = "background: #d7f9da",
tags$p(style="font-family:Avenir", tags$strong("10.",tags$i(class='fas fa-wave-square'), "set SD(",tags$em("f"),
tags$sub(tags$em("x"))),") (%)"),uiOutput("FSDsliders"))))
) # close mainPanel
), # end tab 1
tabPanel(value="tab2", title=tags$strong("B. MATRIX PROPERTIES",tags$i(class="fas fa-table")),
sidebarLayout(
sidebarPanel(style = "background: #d7f9da",
tags$h3(tags$p(style="font-family:Avenir",tags$i(class="fas fa-table"), "matrix properties")),
textOutput("maxlambda"),
textOutput("Rmax"),
textOutput("RV"),
textOutput("gen"),
tags$br(),
tags$h3(tags$p(style="font-family:Avenir", "stable age distribution")),
plotOutput("SSDplot")
), # end sidebarPanel
mainPanel(
wellPanel(style = "background: #d7f9da",
fluidRow(
column(3,
actionButton("makeMatrix", label="generate/update matrix",icon=shiny::icon("fas fa-calculator"))),
column(1,
tags$p(style="font-family:Avenir","or")),
column(3,
fileInput("uploadMatrix", label=tags$p(tags$i(class='fas fa-upload'),"upload existing matrix"),
multiple=F, buttonLabel="choose file", placeholder="no file selected")),
column(1,
tags$p(style="font-family:Avenir","and")),
column(3,
fileInput("uploadSDs", label=tags$p(tags$i(class='fas fa-upload'),"upload S & F SDs"),
multiple=F, buttonLabel="choose file", placeholder="no file selected")),
),
tags$h3(tags$p(style="font-family:Avenir", "Leslie matrix:")),
add_busy_spinner(spin="fading-circle", color="#17ca3a", timeout=500, position="bottom-right", height = 250, width = 250),
tableOutput("matrix"),
tags$h3(tags$p(style="font-family:Avenir", "survival & fertility standard deviations (%):")),
tableOutput("SFSDs"),
fluidRow(
column(3,
downloadButton('downloadMat', 'download matrix',icon = shiny::icon("download"))),
column(3,
downloadButton('downloadSDs', 'download S & F SDs',icon = shiny::icon("download")))),
), # end wellPanel
) # close mainPanel
) # end sidebar Layout
), # end tab2
tabPanel(value="tab3", title=tags$strong("C. DENSITY FEEDBACK",tags$i(class="fas fa-exchange-alt")),
sidebarLayout(
sidebarPanel(style = "background: #d7f9da",
tags$h3(tags$p(style="font-family:Avenir",tags$i(class="fas fa-exchange-alt"), "density feedback")),
numericInput(inputId = "N1", label=tags$p("1.", tags$i(class='fas fa-play'), "initial", tags$em("N"), "(♀+♂)"), value=1000),
numericInput(inputId = "carCap", label=tags$p("2.",tags$i(class='fas fa-mountain'), "carrying capacity (♀+♂)", tags$em("K")), value=2000),
sliderInput(inputId = "DFa", label=tags$p("3.",tags$i(class='fab fa-modx'), tags$em("a")),
min=0.0, max=2, step=0.01, value=1),
sliderInput(inputId = "DFb", label=tags$p("4.",tags$i(class='fab fa-modx'), tags$em("b")),
min=0, max=30000, value=1000),
sliderInput(inputId = "DFc", label=tags$p("5.",tags$i(class='fab fa-modx'), tags$em("c")),
min=0, max=20, step=0.1, value=8)
), # end sidebarPanel
mainPanel(
wellPanel(style = "background: #d7f9da",
actionButton("DFcalc", label="calculate density-feedback function",icon=shiny::icon("fas fa-exchange-alt")),
tags$hr(),
add_busy_spinner(spin="fading-circle", color="#17ca3a", timeout=500, position="bottom-right", height = 250, width = 250),
plotOutput("DDrelPlot"),
tags$h3(tags$p(style="font-family:Avenir", "updated",tags$em("r"),"at",tags$em("K"))),
textOutput("RmaxK"),
), # end wellPanel
) # close mainPanel
) # end sidebar Layout
), # end tab3
tabPanel(value="tab4", title=tags$strong("D. PROJECT",tags$i(class="fas fa-chart-line")),
sidebarLayout(
sidebarPanel(style = "background: #d7f9da",
tags$h3(tags$p(style="font-family:Avenir", tags$i(class="fas fa-chart-line"),"projection parameters")),
radioButtons("yrsOrGen", label=tags$p("1.",tags$i(class='fas fa-user-clock'), "project years or generations?"), inline=T,
choiceNames = list(icon("fas fa-calendar-alt"), icon("fas fa-seedling")),
choiceValues = list("years","gens")),
tags$hr(),
conditionalPanel(
condition = "input.yrsOrGen == 'years'",
numericInput(inputId = "yrsFutureProj", label=tags$p("2.",tags$i(class='fas fa-calendar-alt'), "years to project into the future"), value=(10)),
),
conditionalPanel(
condition = "input.yrsOrGen == 'gens'",
numericInput(inputId = "gensFutureProj", label=tags$p("2.",tags$i(class='fas fa-seedling'), "generations to project into the future"), value=(40)),
),
numericInput(inputId = "Nstart", label=tags$p("3.",tags$i(class='fas fa-braille'), "initial", tags$em("N"), "(♀+♂)"), value=(1000)),
tags$hr(),
radioButtons("DFinvoke", label=tags$p("4.",tags$i(class='fas fa-exchange-alt'), "invoke density feedback?"), inline=T,
choiceNames = list((icon("fas fa-thumbs-down")), (icon("fas fa-thumbs-up"))), choiceValues = list("no","yes")),
tags$br(),
actionButton("projectMatrix", label="project deterministic population",icon=shiny::icon("fas fa-chart-line"))
), # end sidebarPanel
mainPanel(
wellPanel(style = "background: #d7f9da",
add_busy_spinner(spin="fading-circle", color="#17ca3a", timeout=500, position="bottom-right", height = 250, width = 250),
plotOutput("detProjPlot"),
tags$br(),
downloadButton('downloadDetN', 'download projection',icon = shiny::icon("download"))
), # end wellPanel
) # close mainPanel
) # end sidebar Layout
), # end tab4
tabPanel(value="tab5", title=tags$strong("E. STOCHASTIC",tags$i(class="fas fa-bolt")),
sidebarLayout(
sidebarPanel(style = "background: #d7f9da",
tags$h3(tags$p(style="font-family:Avenir",tags$i(class="fas fa-bolt"), "stochastic projection")),
radioButtons("iter", label=tags$p("1.",tags$i(class='fas fa-dice'), "number of iterations"), inline=T,
choiceNames = list("100","1000","10000","100000"), choiceValues = list(100,1000,10000,10000)),
numericInput(inputId = "Qthresh", label=tags$p("2.",tags$i(class='fas fa-skull'), "quasi-extinction threshold (min ♀+♂)"), value=(100)),
radioButtons("CatInvoke", label=tags$p("3.",tags$i(class='fas fa-poo-storm'), "invoke catastrophes?"), inline=T,
choiceNames = list((icon("fas fa-thumbs-down")), (icon("fas fa-thumbs-up"))), choiceValues = list("no","yes")),
conditionalPanel(
condition = "input.CatInvoke == 'yes'",
sliderInput(inputId = "catMag", label=tags$p("4.",tags$i(class='fas fa-arrows-alt-v'), "catastrophe magnitude"),
min=0, max=100, value=(50), round=F, ticks=F, step=1),
sliderInput(inputId = "catMagSD", label=tags$p("5.",tags$i(class='fas fa-wave-square'), "catastrophe magnitude",
tags$em("σ"),"%"), min=0, max=50, value=(10), round=F, ticks=F, step=1)
),
tags$hr(),
tags$br(),
actionButton("projectStoch", label="project/update",icon=shiny::icon("fas fa-bolt"))
), # end sidebarPanel
mainPanel(
wellPanel(style = "background: #d7f9da",
tags$h3(tags$p(style="font-family:Avenir", "a. population size")),
#add_busy_gif(src = "expand.gif", timeout=500, position='full-page', height = 150, width = 150), # add busy gif
add_busy_spinner(spin="fading-circle", color="#17ca3a", timeout=500, position="bottom-right", height = 250, width = 250),
plotOutput("projectStochPlot"),
tags$br(),
downloadButton('downloadStochN', 'download projection',icon = shiny::icon("download")),
tags$hr(),
textOutput("PrExt"),
textOutput("minPop"),
textOutput("rMn"),
), # end wellPanel
wellPanel(style = "background: #d7f9da",
tags$h3(tags$p(style="font-family:Avenir", "b. population rate of change (r)")),
plotOutput("plotRplot")
) # end wellPanel
) # close mainPanel
) # end sidebar Layout
), # end tab5
tabPanel(value="tab6", title=tags$strong("F. SINGLE PULSE",tags$i(class="fas fa-level-down-alt")),
sidebarLayout(
sidebarPanel(style = "background: #d7f9da",
tags$h3(tags$p(style="font-family:Avenir", tags$i(class="fas fa-level-down-alt"),"pulse disturbance")),
radioButtons("percOrFix", label=tags$p("1.",tags$i(class='fas fa-user-cog'), "percentage or fixed?"), inline=T,
choiceNames = list(icon("fas fa-percentage"), icon("fas fa-screwdriver")),
choiceValues = list("perc","fix")),
tags$hr(),
conditionalPanel(
condition = "input.percOrFix == 'perc'",
sliderInput(inputId = "percPulse", label=tags$p("2. select offtake", tags$i(class='fas fa-percentage')),
min=1, max=100, value=50, round=F, ticks=F, step=1)
),
conditionalPanel(
condition = "input.percOrFix == 'fix'",
numericInput(inputId = "fixPulse", label=tags$p("2.",tags$i(class='fas fa-screwdriver'),"select # individuals for offtake"), value=500)
),
radioButtons("setOrRand", label=tags$p("3.",tags$i(class='fas fa-user-clock'), "random or set timing of single pulse disturbance?"), inline=T,
choiceNames = list(tags$p(style="font-family:Avenir","random",icon("fas fa-random")),
tags$p(style="font-family:Avenir","set", icon("fas fa-wrench"))),
choiceValues = list("random","set")),
conditionalPanel(
condition = "input.setOrRand == 'set'",
numericInput(inputId = "setOnePulse", label=tags$p("4.",tags$i(class='fas fa-wrench'),"select year of single pulse"), value=5)
),
tags$hr(),
tags$br(),
actionButton("projectPulse", label="project/update",icon=shiny::icon("fas fa-level-down-alt"))
), # end sidebarPanel
mainPanel(
wellPanel(style = "background: #d7f9da",
tags$h3(tags$p(style="font-family:Avenir", "population size")),
add_busy_spinner(spin="fading-circle", color="#17ca3a", timeout=500, position="bottom-right", height = 250, width = 250),
plotOutput("projectPulsePlot"),
tags$br(),
downloadButton('downloadPulseN', 'download projection',icon = shiny::icon("download")),
tags$hr(),
textOutput("PrExtPulse"),
textOutput("minPopPulse"),
textOutput("rMnPulse")
), # end wellPanel
) # close mainPanel
) # end sidebar Layout
), # end tab6
tabPanel(value="tab7", title=tags$strong("G. PRESS",tags$i(class="fas fa-compress-arrows-alt")),
sidebarLayout(
sidebarPanel(style = "background: #d7f9da",
tags$h3(tags$p(style="font-family:Avenir",tags$i(class="fas fa-compress-arrows-alt"), "press disturbance")),
radioButtons("percOrFixPress", label=tags$p("1.",tags$i(class='fas fa-user-cog'), "percentage or fixed?"), inline=T,
choiceNames = list(icon("fas fa-percentage"), icon("fas fa-screwdriver")),
choiceValues = list("percPress","fixPress")),
tags$hr(),
conditionalPanel(
condition = "input.percOrFixPress == 'percPress'",
sliderInput(inputId = "percentPress", label=tags$p("2. select offtake", tags$i(class='fas fa-percentage'),"per year"),
min=1, max=100, value=50, round=F, ticks=F, step=1)
),
conditionalPanel(
condition = "input.percOrFixPress == 'fixPress'",
numericInput(inputId = "fixedPress", label=tags$p("2.",tags$i(class='fas fa-screwdriver'),"select # individuals (♀+♂) for offtake per year"), value=500)
),
radioButtons("fullOrSubsetPress", label=tags$p("3.",tags$i(class='fas fa-chart-pie'), "full or subset timing of press disturbance?"), inline=T,
choiceNames = list(tags$p(style="font-family:Avenir","full",icon("far fa-circle")),
tags$p(style="font-family:Avenir","subset", icon("fas fa-pizza-slice"))),
choiceValues = list("fullInt","subsetInt")),
conditionalPanel(
condition = "input.fullOrSubsetPress == 'subsetInt'",
sliderInput(inputId = "setSubsetPress", label=tags$p("4.",tags$i(class='fas fa-pizza-slice'),"select % period of
projection interval to which press is applied"), value=c(20,90),
min=1, max=100, step=1, ticks=F, round=F)
),
tags$hr(),
tags$br(),
actionButton("projectPress", label="project/update",icon=shiny::icon("fas fa-compress-arrows-alt"))
), # end sidebarPanel
mainPanel(
wellPanel(style = "background: #d7f9da",
tags$h3(tags$p(style="font-family:Avenir", "population size")),
add_busy_spinner(spin="fading-circle", color="#17ca3a", timeout=500, position="bottom-right", height = 250, width = 250),
plotOutput("projectPressPlot"),
tags$br(),
downloadButton('downloadPressN', 'download projection',icon = shiny::icon("download")),
tags$hr(),
textOutput("PrExtPress"),
textOutput("minPopPress"),
textOutput("rMnPress")
), # end wellPanel
) # close mainPanel
) # end sidebar Layout
), # end tab7
tabPanel(value="tab8", title=tags$strong("H. MVP",tags$i(class="fas fa-search-minus")),
sidebarLayout(
sidebarPanel(style = "background: #d7f9da",
tags$h3(tags$p(style="font-family:Avenir",tags$i(class="fas fa-search-minus"), "minimum viable population size",
tags$em("N"),tags$sub("MVP"))),
radioButtons("genOrYrs", label=tags$p("1.",tags$i(class='fas fa-user-clock'), "project generations or years?"), inline=T,
choiceNames = list(icon("fas fa-seedling"), icon("fas fa-calendar-alt")),
choiceValues = list("gen","yr")),
tags$hr(),
conditionalPanel(
condition = "input.genOrYrs == 'gen'",
numericInput(inputId = "genProj", label=tags$p("2.",tags$i(class='fas fa-seedling'), "generations to project into the future"), value=(40)),
),
conditionalPanel(
condition = "input.genOrYrs == 'yr'",
numericInput(inputId = "yrProj", label=tags$p("2.",tags$i(class='fas fa-calendar-alt'), "years to project into the future"), value=(100)),
),
sliderInput(inputId = "persistPr", label=tags$p("3.",tags$i(class='fas fa-dice-six'),"select persistence probability"),
value=0.99, min=0.800, max=0.999, step=0.001, ticks=F, round=F),
numericInput(inputId = "iterMVP", label=tags$p("4.",tags$i(class='fas fa-dice'), "MVP iterations"), value=(100)),
numericInput(inputId = "Nhigh", label=tags$p("5.",tags$i(class='fas fa-angle-double-up'), "upper initial", tags$em("N"), "(♀+♂)"), value=(1000)),
numericInput(inputId = "Nlo", label=tags$p("6.",tags$i(class='fas fa-angle-double-down'), "lower initial", tags$em("N"), "(♀+♂)"), value=(10)),
numericInput(inputId = "Nstep", label=tags$p("7.",tags$i(class='fas fa-walking'), "step size", tags$em("N")), value=(10)),
), # end sidebarPanel
mainPanel(
wellPanel(style = "background: #d7f9da",
actionButton("calcMVP", label=tags$p("calculate",tags$em("N"),tags$sub("MVP")),icon=shiny::icon("fas fa-search-minus")),
tags$h3(tags$p(style="font-family:Avenir", "change in persistence probability")),
add_busy_spinner(spin="fading-circle", color="#17ca3a", timeout=500, position="top-right", height = 250, width = 250),
plotOutput("MVPPlot"),
tags$hr(),
textOutput("MVPest"),
textOutput("MVPstepChange"),
textOutput("MVPasymptote")
), # end wellPanel
) # close mainPanel
) # end sidebar Layout
), # end tab8
tabPanel(value="tab9", title=tags$strong("I. INSTRUCTIONS",tags$i(class="fas fa-directions")), style = "background: #d7f9da",
wellPanel(style = "background: #d7f9da",
tags$h3(style="font-family:Avenir",tags$i(class="fas fa-directions"),"Detailed instructions and notes"),
tags$a(href="https://flinders.edu.au/", tags$img(height = 100, src = "F_V_CMYK.png", style="float:right",title="Flinders University")),
tags$h4(style="font-family:Avenir",tags$em("Preamble")),
tags$p(style="font-family:Avenir", "I designed this app for ecologists who might be daunted by the prospect of coding
their own Leslie matrix models, not to mention the mathematics underlying them. There is no need to become a
modeller to use this app, but a reasonable grounding in the basic components is a good idea all the same."),
tags$p(style="font-family:Avenir","My secondary intention is that once you are able to customise the app to your purposes, you might feel more
capable of designing your own code from scratch (relying heavily on the functions I have provided on",
tags$i(class="fab fa-github"), tags$a(href="https://github.com/cjabradshaw/LeslieMatrixShiny","Github"),"). For the more adventurous, I can recommend the following sources to find
out more:"),
tags$ul(tags$li(tags$p(style="font-family:Avenir", tags$i(class="fas fa-book"),"Hal Caswell's 2006 (second edition) book", tags$a(href="https://global.oup.com/academic/product/matrix-population-models-9780878931217?cc=au&lang=en&#", tags$em("Matrix Population Models:
Construction, Analysis, and Interpretation")), "(view", tags$a(href="https://www.whoi.edu/cms/files/mpm2e_tableofcontents_116984.pdf",
"table of contents)"))),
tags$li(tags$p(style="font-family:Avenir",tags$i(class="fab fa-github"), "Kevin Shoemaker's", tags$a(href="https://kevintshoemaker.github.io/NRES-470/LECTURE7.html",
tags$em("R Matrix Population Models")), "course on Github")),
tags$li(tags$p(style="font-family:Avenir",tags$i(class="fas fa-database"), "The", tags$a(href="https://compadredb.wordpress.com/2015/10/05/introducing-the-comadre-animal-matrix-database/",
tags$em("COMADRE")), "(animal) and",tags$a(href="https://compadredb.wordpress.com/", tags$em("COMPADRE")), "(plant) matrix databases")),
), # end ul
tags$br(),
tags$h4(style="font-family:Avenir",tags$em("What is a Leslie matrix?")),
tags$a(href="https://epicaustralia.org.au/", tags$img(height = 150, src = "CABAHlogo.png",
style="float:right", title="ARC Centre of Excellence for Australian Biodiversity and Heritage")),
tags$p(style="font-family:Avenir","A 'Leslie' matrix (named after Patrick H. Leslie of Oxford in 1945) is used to 'project'
an age-classified population. All matrices used in population biology are what we call 'transition' matrices,
because you set the probability of transitioning from one cell to another. In the special case of Leslie matrices,
the transitions are pegged to movement between discrete age classes, so there can only be one direction (i.e., an
individual transitions from age", tags$em("x"), "to", tags$em("x"), "+ 1, but can never return to age", tags$em("x"),
"). You therefore need to set the transition probabilities related to the aging process (age-specific survival),
and to the production of new individuals (age-specific fertility). Defining these two vectors from birth to
maximum age (i.e., the species' longevity) are the essential components of the Leslie matrix. Note that this app
cannot be used for species with more complex life-history transitions where regression is possible, as is the
case in many stage-classified life cycles. As for the timing of the discrete age classes, I generally assume this will
be equivalent to 'years' (i.e., one breeding event to another). While this assumption can be relaxed in that you can
set the intervals to a shorter/longer duration, all plots are expressed in terms of 'years' (number of projection units)."),
tags$br(),
tags$h4(style="font-family:Avenir",tags$em("Instructions for using this app")),
tags$p(style="font-family:Avenir","I have set up this app so that the settings in each tab are carried over to subsequent
tabs, meaning that changes in a specific tab's settings will be reactively inherited by others farther down the
chain. I recommend that you follow the order prescribed below before getting fancy and jumping around between tabs.
Another important consideration is that while for many parameters the values are set according to both sexes, the
projections themselves only consider the female element of the population. All relevant parameters are halved automatically
to estimate the total number of females per category assuming a 50:50 adult sex ratio. The graphs produced always
show only the female component of the population. Finally, you have the capacity to save and subsequently upload
all parameters set within the matrix and the survival/fertility standard deviations (see tab B)."),
tags$hr(),
tags$ol(type = "A", tags$li(tags$p(style="font-family:Avenir", tags$strong("SET-UP"), tags$i(class="fas fa-pencil-ruler")),
tags$ol(tags$li(tags$p(style="font-family:Avenir","You first need to define how long your species will live — this is the
maximum age. The matrix will have the same number of dimensions vertically and horizontally defined as maximum
age + 1, because we start the process off at birth (age 0).")),
tags$li(tags$p(style="font-family:Avenir","Next you can set the highest survival probability among all age classes.
While this is not absolutely necessary, it assists with constructing the change in survival probabilities with
age (see item A7 below).")),
tags$li(tags$p(style="font-family:Avenir","Set the maximum number of total offspring (i.e., both daughters and
sons) in the most fertile age class. Again, this is not absolutely necessary at this stage, but it helps defining
the age-specific fertility vector later (see item A9 below).")),
tags$li(tags$p(style="font-family:Avenir","Set the age of first breeding (primiparity, or α). While you can make
adjustments to the fertility vector in item A9, setting this now makes things easier later.")),
tags$li(tags$p(style="font-family:Avenir","Sometimes the sex ratio at birth is skewed to one gender or another,
although these are usually special cases (e.g., temperature-dependent sex determination in some reptiles, or
biased maternal investment in one sex following variation in resource availability). For most species, there is usually an
average of a 50:50 sex ratio at birth.")),
tags$li(tags$p(style="font-family:Avenir","This item can be a bit tricky to understand (or measure in real
populations). An 'abrupt' end to an organism's lifespan can occur, such as the catastrophic mortality experienced
by dasyurid marsupials (including devils, quolls, and antechinus) at the end of life, or in truly semelparous
species. In many other species, some rare individuals can exceed life expectancy by chance alone. The general
rule of thumb is that if too many individuals are showing up in the 'final' age class, your longevity estimate
might be too low, or your final-age survival probability might be too high (you can view the stable age structure in tab B).")),
tags$li(tags$p(style="font-family:Avenir","Once you have set the six previous parameters, click the 'set",tags$em("S"),"/",
tags$em("F"), "vectors' button to set up the survival and fertility vectors, and their respective standard deviations (%SD;
more on these below in items A8 and A10). The number of slider bars that appear in items A7-10 is set as maximum age (item A1)
+ 1. You can then adjust each age-specific survival probability up to maximum longevity.")),
tags$li(tags$p(style="font-family:Avenir","Here you can set the standard deviation of survival (set as a
percentage of that age's survival probability) for all ages. These parameters are only invoked in the stochastic projections
(tabs E—G), but if you intend to make stochastic projections, it is a good idea to set these up here.")),
tags$li(tags$p(style="font-family:Avenir","Just like you set the age-specific survival probabilities in item A7, here you
can set the age-specific fertilities (total number of daughters and sons produced per mother).")),
tags$li(tags$p(style="font-family:Avenir","As for item A8, here you can set the %SD for age-specific fertilities
for use in the stochastic projections in tabs E—G.")),
) # end numbered ol
), # end A lis
tags$hr(),
tags$li(tags$p(style="font-family:Avenir", tags$strong("MATRIX PROPERTIES"), tags$i(class="fas fa-table")),
tags$p(style="font-family:Avenir", "Once you are happy with the parameters set in tab A, click on
tab B, and then click the 'generate/update matrix' button in the main panel (alternatively, you can upload a previously
saved matrix and the associated standard deviations for survival/fertility). This action will calculate the matrix
and display it in the main panel. If you instead choose to upload a previous matrix file (and survival/fertility standard
deviations file) — these can be saved using the 'download' buttons at the very bottom of the main panel — you will
be able to view the uploaded matrix and standard deviations in the main panel. Either option results in the
calculation of some basic properties of the matrix displayed in the side panel:"),
tags$ol(type="i",tags$li(tags$p(style="font-family:Avenir","This is the dominant eigen value (",tags$em("λ"),") of
the matrix, which essentially means it is the matrix's capacity to produce either an increasing (",tags$em("λ"),
"> 1), stable (",tags$em("λ"), "= 1), or declining (",tags$em("λ"), "< 1) population. For example, if",tags$em("λ"),
"= 1.1, then a population can be expected to grow from one time interval to the next by 1.1×.")),
tags$li(tags$p(style="font-family:Avenir","Parameter",tags$em("r"), "is simply the natural logarithm of",tags$em("λ"),
", which equates to the instantaneous rate of population increase. When",tags$em("r"),"> 0, the population grows,
when",tags$em("r"),"= 0, the population is stable, and when",tags$em("r"),"< 0, the population declines.")),
tags$li(tags$p(style="font-family:Avenir","Net reproductive rate",tags$em("R"),tags$sub("0"), "is the mean number of
offspring by which a newborn individual will be replaced by the end of its life (i.e., rate of population increase
from one generation to the next).")),
tags$li(tags$p(style="font-family:Avenir","Generation time", tags$em("G"), "is the mean time required for the population
to increase by a factor of",tags$em("R"),tags$sub("0"),".")),
) # end numbered ol
), # end B li
tags$hr(),
tags$li(tags$p(style="font-family:Avenir", tags$strong("DENSITY FEEDBACK"), tags$i(class="fas fa-exchange-alt")),
tags$p(style="font-family:Avenir", "Without some sort of restriction on growth, any population with",
tags$em("r"), "> 0 will increase exponentially forever. Clearly this is impossible, so some upper limit must be
imposed. There are many ways to do this, with the most basic being a simple cap on the total allowable population
size. Imposing such a cap is mathematically simple, but biologically unrealistic (like all the individuals in a box
suddenly running out of room, with every additional individual dying instantaneously). In reality, populations are more
complex, so some sort of feedback mechanism typically slows at least one of the demographic rates. While
biologically more realistic, measuring where density feedback actually operates can be challenging. For this reason,
I have chosen to implement a middle-of-the-road solution by calculating a compensatory feedback modifier (",
tags$em("S"),tags$sub("mod"), ") that reduces the survival vector as the population approaches carrying
capacity", tags$em("K"),". The function in question is a basic, 3-parameter logistic-power relationship of the
form:", tags$em("S"),tags$sub("mod"),"=",tags$em("a"),"/(1+(",tags$em("N"),"/",tags$em("b"),")",tags$sup("c"),")",
", where",tags$em("N"),"= total population size at any given time. The five parameters to set below should be adjusted
such that the function produces",tags$em("S"),tags$sub("mod"),"declining from 1 to some value < 1, such that the
value of", tags$em("r"),"at", tags$em("K"),"≈ 1."),
tags$ol(tags$li(tags$p(style="font-family:Avenir","Set the initial population size. Note that this parameter is
specific to the density-feedback tab; you will have the opportunity to provide the 'real' start population for
the projections in subsequent tabs.")),
tags$li(tags$p(style="font-family:Avenir","Set the long-term average environmental carrying capacity", tags$em("K"),
". As the population approaches this value, survival will decline according to",tags$em("S"),tags$sub("mod"),", meaning
that the population rate of change will also slow.")),
tags$li(tags$p(style="font-family:Avenir","The", tags$em("a"), "parameter of the logistic-power function adjusts
the initial value of",tags$em("S"),tags$sub("mod"), ". Generally this should remain at or near 1.")),
tags$li(tags$p(style="font-family:Avenir","The", tags$em("b"), "parameter of the logistic-power function changes
how quickly",tags$em("S"),tags$sub("mod"), "approaches",tags$em("K"),".")),
tags$li(tags$p(style="font-family:Avenir","The", tags$em("c"), "parameter of the logistic-power function the shape
of the relationship between",tags$em("S"),tags$sub("mod"), "and",tags$em("K"),".")),
) # end numbered ol
), # end C li
tags$hr(),
tags$li(tags$p(style="font-family:Avenir", tags$strong("PROJECT"), tags$i(class="fas fa-chart-line")),
tags$p(style="font-family:Avenir", "This is finally where you get to view some of the fruits of your parameter-setting
labour. This process takes the deterministic matrix from tabs A—B, and projects an initial population forward either taking
density feedback into account (relationship from tab C) or not."),
tags$ol(tags$li(tags$p(style="font-family:Avenir","Your first choice is to set how far into the future your
projection will run according to either years or generations. If you choose 'generations', then the projection window inherits the
deterministic value of", tags$em("G"), "from tab B")),
tags$li(tags$p(style="font-family:Avenir","Choose the value in years or generations accordingly.")),
tags$li(tags$p(style="font-family:Avenir","Next, choose your initial population size (both females and males). As mentioned
above, this can be different from the initial value set in tab C, but it should be comparable so that the density-feedback
relationship remains meaningful to the population range projected here.")),
tags$li(tags$p(style="font-family:Avenir","Decide whether to invoke the density-feedback relationship established in tab C.")),
), # end numbered ol
tags$p(style="font-family:Avenir","Next, click the 'project deterministic population' button to view the projection graph
in the main panel. You can then adjust the parameters to move", tags$em("r"), "at",tags$em("K"), "to ~ 0 (note that you need to
reclick the 'project deterministic population' button to update the", tags$em("r"), "at",tags$em("K"), "value, even if the graph
updates automatically).")
), # end D li
tags$hr(),
tags$li(tags$p(style="font-family:Avenir", tags$strong("STOCHASTIC"), tags$i(class="fas fa-bolt")),
tags$p(style="font-family:Avenir", "Up to here the neat, deterministic projection of your population belies the uncertainty
in such mathematical wizardry. A stochastic projection incorporates reasonable uncertainty in both the parameters used to
construct the matrix, as well as random, unforeseen 'catastrophic' die-offs caused by a variety of natural disturbances. The
app allows you to incorporate this uncertainty by resampling your base survival and fertility vectors, using a",tags$em("β"),"distribution
for the former and a Gaussian distribution for the latter. This is where the % standard deviations for each age-specific survival
probability and fertility set in tab A come into play. There are three (or five, if you choose to invoke catastrophes)
parameters to set in this tab:"),
tags$ol(tags$li(tags$p(style="font-family:Avenir","The number of iterations to resample the demographic values. The more iterations
you chooose, the better your confidence intervals will be estimated at the expense of longer computation time. I advise starting
with the lowest number of iterations first to check out how the model behaves, and then increasing this later once you are happy with
set-up.")),
tags$li(tags$p(style="font-family:Avenir","Set what is known as the 'quasi'-extinction threshold. Because small populations tend
to be susceptible to extinction for reasons that are typically different from those that caused them to become small in the
first place, we generally invoke a threshold >> 1 below which we deem the population to be 'functionally' extinct (i.e., high
chance of going extinct anyway).", tags$a(href="http://doi.org/10.1016/j.biocon.2013.12.036", "Theory and data"), "suggest that this can be as high has 100 individuals, but you can adjust
the threshold according to your own views. Note that all subsequent estimates of extinction probability Pr(ext) are base on this
threshold.")),
tags$li(tags$p(style="font-family:Avenir","Among vertebrates, there is", tags$a(href="http://doi.org/10.1017/S1367943003003147",
"good evidence"), "to suggest that 'catastrophic' die-offs tend to happen with a predictable probability per generation. In this case,
I've used the mean value of 0.14 per generation. Choose whether you want to invoke this type of event occurring in the subsequent
stochastic projections.")),
tags$li(tags$p(style="font-family:Avenir","If you choose to invoke the catastrophe function, you will have the option of defining
what a 'catastrophic' die-off means in terms of average magnitude of increased mortality. This defaults to 50% mortality, which is the
definition used in the",tags$a(href="http://doi.org/10.1017/S1367943003003147", "aforementioned paper"),
" (note that this is",tags$em("β"),"-resampled per iteration according to the standard deviation % set below).")),
tags$li(tags$p(style="font-family:Avenir","Set the standard deviation % for resampling the catastrophic die-off magnitude set in
the previous slider.")),
), # end numbered ol
tags$p(style="font-family:Avenir","Next, click the 'project/update' button to view the graphs projecting population size",
tags$em("N"), "(main panel graph a) and the instantaneous rate of population increase", tags$em("r"), " (main panel graph b).
Both these graphs show the 95% confidence intervals of the temporal trend in grey. There are also three emergent values
provided by the simulation shown below panel figure a (note that you need to reclick the 'project/update' button to
update the following values even if the graph updates automatically):"),
tags$ol(type="i",tags$li(tags$p(style="font-family:Avenir","Pr(Ext) is the probability of extinction (i.e., number of iterations where
the total population size fell below the quasi-extinction threshold).")),
tags$li(tags$p(style="font-family:Avenir","min N is minimum population size achieved during the projection window averaged across all
iterations. The 95% confidence interval (range) of this value is also provied.")),
tags$li(tags$p(style="font-family:Avenir","mean r is the mean population rate of increase from one time step to the next throughout the
projection interval, averaged (+ 95% confidence interval range).")),
), # end numbered ol
), # end E li
tags$hr(),
tags$li(tags$p(style="font-family:Avenir", tags$strong("SINGLE PULSE"), tags$i(class="fas fa-level-down-alt")),
tags$p(style="font-family:Avenir", "A 'pulse' disturbance is an acute perturbation that happens abruptly. I implemented this
function to test the effect of one-off disturbance events like a harvest or known catastrophe (in addition or independent of the
'normal' probability of a generic catastrophes implemented in the previous tab). You have the choice to set a specific timing
for the pulse disturbance, or let it happen at any time randomly during the projection window (and differently in every
stochastic iteration). You can also choose to set the perturbation as a percentage of the current population size, or as a
fixed number of individuals (spread across the entire age range according to the stable age distribution from panel B):"),
tags$ol(tags$li(tags$p(style="font-family:Avenir","First set the disturbance pulse as either a percentage of the current population,
or as a fixed number of indiviuals.")),
tags$li(tags$p(style="font-family:Avenir","Set either the percentage or fixed value of the disturbance pulse.")),
tags$li(tags$p(style="font-family:Avenir","Allow the disturbance pulse to happen randomly, or at a set time in during the projection
window.")),
tags$li(tags$p(style="font-family:Avenir","If you set the timing, when should this disturbance pulse occur?")),
), # end numbered ol
tags$p(style="font-family:Avenir","Next, click the 'project/update' button to view the graph projecting population size",
tags$em("N"), "(main panel graph). The graph includes the 95% confidence intervals of the temporal trend in grey. There are
also three emergent values provided by the simulation shown below the main figure panel (note that you need to reclick the 'project/update' button to
update the following values even if the graph updates automatically):"),
tags$ol(type="i",tags$li(tags$p(style="font-family:Avenir","Pr(Ext) is the probability of extinction (i.e., number of iterations where
the total population size fell below the quasi-extinction threshold).")),
tags$li(tags$p(style="font-family:Avenir","min N is minimum population size achieved during the projection window averaged across all
iterations. The 95% confidence interval (range) of this value is also provied.")),
tags$li(tags$p(style="font-family:Avenir","mean r is the mean population rate of increase from one time step to the next throughout the
projection interval, averaged (+ 95% confidence interval range).")),
), # end numbered ol
), # end F li
tags$hr(),
tags$li(tags$p(style="font-family:Avenir", tags$strong("PRESS"), tags$i(class="fas fa-compress-arrows-alt")),
tags$p(style="font-family:Avenir", "A 'press' disturbance is a perturbation that happens over a longer time frame
than a pulse disturbance. I implemented this function to test the effect of a sustained disturbance event like an annual
harvest (in addition or independent of the 'normal' probability of a generic catastrophes implemented in tab E). You have
the choice to set a specific interval for the press disturbance, or let it happen throughout the entire projection
window. You can also choose to set the perturbation as a percentage of the current population size, or as a
fixed number of individuals (spread across the entire age range according to the stable age distribution from panel B):"),
tags$ol(tags$li(tags$p(style="font-family:Avenir","First set the disturbance press as either a percentage of the current population,
or as a fixed number of indiviuals.")),
tags$li(tags$p(style="font-family:Avenir","Set either the percentage or fixed value of the disturbance press.")),
tags$li(tags$p(style="font-family:Avenir","Allow the disturbance press to occur over the entire projection window,
or only during a set interval (percentage) of the projection window.")),
tags$li(tags$p(style="font-family:Avenir","If you set the interval, between what percentages of the window should the press
disturbance occur?")),
), # end numbered ol
tags$p(style="font-family:Avenir","Next, click the 'project/update' button to view the graph projecting population size",
tags$em("N"), "(main panel graph). The graph includes the 95% confidence intervals of the temporal trend in grey. There are
also three emergent values provided by the simulation shown below the main figure panelå (note that you need to reclick the 'project/update' button to
update the following values even if the graph updates automatically):"),
tags$ol(type="i",tags$li(tags$p(style="font-family:Avenir","Pr(Ext) is the probability of extinction (i.e., number of iterations where
the total population size fell below the quasi-extinction threshold).")),
tags$li(tags$p(style="font-family:Avenir","min N is minimum population size achieved during the projection window averaged across all
iterations. The 95% confidence interval (range) of this value is also provied.")),
tags$li(tags$p(style="font-family:Avenir","mean r is the mean population rate of increase from one time step to the next throughout the
projection interval, averaged (+ 95% confidence interval range).")),
), # end numbered ol
), # end G li
tags$hr(),
tags$li(tags$p(style="font-family:Avenir", tags$strong("MVP"), tags$i(class="fas fa-search-minus")),
tags$p(style="font-family:Avenir", "A minimum viable population (MVP) is a population of size", tags$em("N"),
"at time 0 that has a specified probabiliy of persisting time",tags$em("t"),"into the future. Clearly, the value of",
tags$em("N"),tags$sub("MVP"),"therefore depends not only on the demographic parameters of the population in question,
it also depends on the choice of",tags$em("persistence probability"),"as well as the time to project the population
into the future. These latter parameters can be somewhat arbitrary choices, but convention generally defaults to a 99%
probability of persisting",tags$a(href="https://onlinelibrary.wiley.com/doi/full/10.1111/j.1461-0248.2006.00883.x", "40 generations"),
"40 generations (preferred) or 100 years",tags$a(href="https://portals.iucn.org/library/node/10315","(IUCN Red List definition)"),
". Any compensatory feedback imposed on the projections also complicates the issue insofar as the user assumes a constant,
long-term carrying capacity to which the population generally returns after a perturbation. Nonetheless, it is a useful concept
fully stochastic demographic projections of populations demonstrate generally that estimates of", tags$em("N"),tags$sub("MVP"),"tend
to align with the",tags$a(href="http://dx.doi.org/10.1016/j.biocon.2013.12.036", "'100/1000 rule'"),"(formerly known as the '50/500' rule) derived from genetic and evolutionary
considerations. For the calculation of MVP, the process invokes the characteristics defined in earlier tabs; however, the user can set
the following parameters in addition:"),
tags$ol(tags$li(tags$p(style="font-family:Avenir","Set whether to project for number of generations or years.")),
tags$li(tags$p(style="font-family:Avenir","Depending on the previous choice, set number of generations (default = 40) or
number of years (default = 100).")),
tags$li(tags$p(style="font-family:Avenir","Select the persistence probability (default = 0.99)")),
tags$li(tags$p(style="font-family:Avenir","Set the number of iterations for each initial population-size
run. Note that large values will slow down the calculation considerably, so I recommend
starting with low values first before settling on the desired parameters.")),
tags$li(tags$p(style="font-family:Avenir","Set the largest initial population size from which progressively
smaller values will be assessed.")),
tags$li(tags$p(style="font-family:Avenir","Set the minimum initial population size to test.")),
tags$li(tags$p(style="font-family:Avenir","Set the population step size that will be used to define the intervals
tested between the maximum and minimum inital population sizes set above. Note that a higher number
of intervals will slow down the calculation.")),
), # end numbered ol
tags$p(style="font-family:Avenir","Next, click the ' calculate", tags$em("N"),tags$sub("MVP"),"' button to begin the
calculation. Once complete, a graph will appear showing the relationship between initial population size
and persistence probability over the projection window set above. Below the graph, three outputs will appear:"),
tags$ol(type="i",tags$li(tags$p(style="font-family:Avenir","Provided the simulations had at least one initial population
size that resulted in the persistence probability being achieved or exceeded, the minimum viable population size (number
of female individuals) will be displayed here.")),
tags$li(tags$p(style="font-family:Avenir","A 'breakpoint' is displayed showing the first precipitous reduction in
persistence probability as initial population size declines.")),
tags$a(href="https://github.com/cjabradshaw/LeslieMatrixShiny/blob/main/LICENSE", tags$img(height = 50, src = "GNU GPL3.png", style="float:right", title="GNU General Public Licence v3.0")),
tags$li(tags$p(style="font-family:Avenir","I have also included a logistic power function of the form:
Pr(Persistence) =", tags$em("a"), "/ (1 + (", tags$em("N"), "/", tags$em("b"),")",
tags$sup(tags$em("c")), "), where parameters", tags$em("a, b, c"), "are constants calculated
using a non-linear optimisation function, and", tags$em("N"), "is the number of initial adult
females in the population.", "This logistic function (given as one of the outputs) provides
an 'asymptotic' estimate of minimum viable population size, with a corresponding confidence
interval derived from a multinomial resampling procedure (light red-shaded region in the
corresponding graph). Note that if the parameters are not chosen carefully, this function
cannot be fit and the asymptotic MVP size will not be displayed."))
), # end numbered ol
), # end H li
), # end upper-case letters ol
) # end wellPanel
) # end tab9
) # end tabset
) # close fluidPage
server <- function(input, output, session) {
observeEvent(input$SFfill, {
if(input$tabs == "tab1"){
output$Ssliders <- renderUI({
ageclasses <- as.integer(input$agemax) + 1
lapply(1:ageclasses, function(i) {
sliderInput(inputId = paste0("S", (i-1)), label = paste("age", (i-1)),
min = 0, max = 1, value=ifelse((i-1) == 0, 0.5*input$survmax, input$survmax), round=F, ticks=F, step = 0.01)
})
})
output$SSDsliders <- renderUI({
ageclasses <- as.integer(input$agemax) + 1
lapply(1:ageclasses, function(i) {
sliderInput(inputId = paste0("SSD", (i-1)), label = paste("age", (i-1)),
min = 0, max = 100, value=10, round=F, ticks=F, step = 1)
})
})
output$Fsliders <- renderUI({
ageclasses <- as.integer(input$agemax) + 1
lapply(1:ageclasses, function(i) {
sliderInput(inputId = paste0("F", (i-1)), label = paste("age", (i-1)),
min = 0, max = input$fertmax, value= ifelse((i-1) < input$primiparity, 0, ifelse((i-1) == input$primiparity, 0.5*input$fertmax, input$fertmax)), round=F, ticks=F, step = 0.1)
})
})
output$FSDsliders <- renderUI({
ageclasses <- as.integer(input$agemax) + 1
lapply(1:ageclasses, function(i) {
sliderInput(inputId = paste0("FSD", (i-1)), label = paste("age", (i-1)),
min = 0, max = 100, value=10, round=F, ticks=F, step = 1)
})
})
} # end tab1 if
})
observeEvent(input$makeMatrix, {
if(input$tabs == "tab2"){
inputsRctv <- reactiveValues()
observe({
inputsRctv$am <- as.numeric(input$agemax)
inputsRctv$sr <- as.numeric(input$sexratio)
})
Srctv <- reactive({
ageclasses <- as.integer(input$agemax) + 1
Svec <<- as.numeric(unlist(lapply(1:ageclasses, function(i) {
input[[paste0("S", (i-1))]]
})))
}) # end Srctv
Frctv <- reactive({
ageclasses <- as.integer(input$agemax) + 1
Fvec <<- as.numeric(unlist(lapply(1:ageclasses, function(i) {
input[[paste0("F", (i-1))]]
})))
}) # end Frctv
DemRdat <<- isolate({
dat <- data.frame(Srctv(), Frctv())
})
observe({
output$matrix <- renderTable(bordered=T,colnames=F,striped=T, {
Dmat <<- createLmatrix(age.max=inputsRctv$am, Svec=DemRdat[,1], Fvec=(inputsRctv$sr/100) * DemRdat[,2],
finalStage=as.character(input$longevAbr)) # deterministic matrix
})
}) # end observe
output$downloadMat <- downloadHandler(
filename = function() {
paste("matrixOut", "csv", sep = ".")
},
content = function(file) {
sep <- ","
write.table(Dmat, file, sep=sep, row.names = F, col.names = F)
}
)
S_SDrctv <- reactive({
ageclasses <- as.integer(input$agemax) + 1
S_SDvec <<- as.numeric(unlist(lapply(1:ageclasses, function(i) {
input[[paste0("SSD", (i-1))]]
})))
}) # end Srctv
F_SDrctv <- reactive({
ageclasses <- as.integer(input$agemax) + 1
F_SDvec <<- as.numeric(unlist(lapply(1:ageclasses, function(i) {
input[[paste0("FSD", (i-1))]]
})))
}) # end Frctv
DemRSDdat <<- isolate({
SDdat <- data.frame(S_SDrctv(), F_SDrctv())
})
observe({
output$SFSDs <- renderTable(bordered=T,rownames=F,colnames=F,striped=T, {
SDdat
})
})
output$downloadSDs <- downloadHandler(
filename = function() {
paste("SFsd", "csv", sep = ".")
},
content = function(file2) {
sep <- ","
write.table(DemRSDdat, file2, sep=sep, row.names = F, col.names = F)
}
)
observe({
output$maxlambda <- renderText( {
maxl <<- maxLambda(Dmat)
paste("i. max λ = ", round(maxl, 4), "(λ < 1 → N↓; λ > 1 → N↑)")
})
}) # end observe
observe({
output$Rmax <- renderText( {
maxr <<- maxR(Dmat)
paste("ii. max r = ", round(maxr, 4), "(r < 0 → N↓; r > 0 → N↑)")
})
}) # end observe
observe({
output$gen <- renderText( {
G <<- Gval(Dmat, inputsRctv$am+1)
paste("iii. G = ", round(G, 4), "years")
})
}) # end observe
observe({
output$RV <- renderText( {
R <<- Rval(Dmat, inputsRctv$am+1)
paste("iv. R0 = ", round(R, 4), "(lifetime ♀ offspring/♀)")
})
}) # end observe
observe({
output$SSDplot <- renderPlot( {
ssdDat <<- data.frame(0:(dim(Dmat)[1]-1), round(StableStageDist(Dmat), 3))
colnames(ssdDat) <- c("age","relProp")
Ctheme = theme(
axis.title.x = element_text(size = 16),
axis.text.x = element_text(size = 14),
axis.title.y = element_text(size = 16),
axis.text.y = element_text(size = 14))
ggplot(ssdDat, aes(x=age, y=relProp)) +
geom_point() +
geom_path() +
labs(x="age (years)", y="relative proportion in population") +
Ctheme
})
}) # end observe
} # end tab 2 if
}) # end Events
observeEvent(input$uploadMatrix, {
if(input$tabs == "tab2"){
observe({
output$matrix <- renderTable(bordered=T,rownames=F,colnames=F,striped=T, {
file_to_read = input$uploadMatrix
if(is.null(file_to_read)){
return()
}
read.table(file_to_read$datapath, sep=",", header=F)
}) # end output table1
Dmat2 <<- eventReactive(input$uploadMatrix, {
as.matrix(read.table(input$uploadMatrix$datapath, sep=",", header = F))
})
})
observe({
output$SFSDs <- renderTable(bordered=T,rownames=F,colnames=F,striped=T, {
file_to_read = input$uploadSDs
if(is.null(file_to_read)){
return()
}
read.table(file_to_read$datapath, sep=",", header=F)
}) # end output table2
SFSD <<- eventReactive(input$uploadSDs, {
(read.table(input$uploadSDs$datapath, sep=",", header = F))
})
})
observe({
output$maxlambda <- renderText( {
maxl <<- maxLambda(Dmat2())