├── inst └── eagles-fws │ ├── Rplots.pdf │ ├── app_data.RData │ ├── data │ ├── app_data.RData │ ├── surfaces.rdata │ ├── cost_surfaces_95.rdata │ └── ABT_REA_costs.csv │ ├── www │ ├── 01_DOW_LOGO_COLOR_300-01.png │ ├── custom_styles.css │ └── dashboard.css │ ├── custom.css │ ├── exposure.R │ ├── fatality.R │ ├── bayesian.R │ ├── helper_fxns.R │ ├── eaglesFWS_flex.Rmd │ ├── R │ └── helper_fxns.R │ ├── cost_dashboard.Rmd │ ├── eaglesFWS_priors.Rmd │ └── eaglesFWS_playground.Rmd ├── NAMESPACE ├── .Rbuildignore ├── data ├── high_high.rds ├── simData.rds ├── zeroSim.rds ├── simResults.rds ├── zeroSim_95.rds ├── simResults_95.rds ├── cost_surfaces_95.rdata └── ABT_REA_costs.csv ├── .gitignore ├── vignettes ├── priors18.rds ├── data │ ├── scale.rda │ ├── Bay_2016.rds │ ├── data18.RData │ ├── newdata.RData │ ├── zerosim.rds │ └── Eagles_simulation.rds ├── www │ ├── DOW_logo_small.png │ └── HTMLAnalysis_custom.css ├── _site.yml ├── custom.css ├── eBird.R ├── disccuss.R └── R │ └── helper_fxns.R ├── DESCRIPTION ├── eaglesFWS.Rproj ├── server.R ├── R ├── hello.R ├── MDP.R ├── eBird.R ├── POMDP.R ├── fitdist.R ├── VOI.R ├── helper_fxns.R └── analysisv2.R ├── global.R └── ui.R /inst/eagles-fws/Rplots.pdf: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | exportPattern("^[[:alpha:]]+") 2 | -------------------------------------------------------------------------------- /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | -------------------------------------------------------------------------------- /data/high_high.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mjevans26/eaglesFWS/master/data/high_high.rds -------------------------------------------------------------------------------- /data/simData.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mjevans26/eaglesFWS/master/data/simData.rds -------------------------------------------------------------------------------- /data/zeroSim.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mjevans26/eaglesFWS/master/data/zeroSim.rds -------------------------------------------------------------------------------- /data/simResults.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mjevans26/eaglesFWS/master/data/simResults.rds -------------------------------------------------------------------------------- /data/zeroSim_95.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mjevans26/eaglesFWS/master/data/zeroSim_95.rds -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | .Ruserdata 5 | data/ 6 | data-raw/ 7 | 8 | 9 | -------------------------------------------------------------------------------- /data/simResults_95.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mjevans26/eaglesFWS/master/data/simResults_95.rds -------------------------------------------------------------------------------- /vignettes/priors18.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mjevans26/eaglesFWS/master/vignettes/priors18.rds -------------------------------------------------------------------------------- /vignettes/data/scale.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mjevans26/eaglesFWS/master/vignettes/data/scale.rda -------------------------------------------------------------------------------- /data/cost_surfaces_95.rdata: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mjevans26/eaglesFWS/master/data/cost_surfaces_95.rdata -------------------------------------------------------------------------------- /vignettes/data/Bay_2016.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mjevans26/eaglesFWS/master/vignettes/data/Bay_2016.rds -------------------------------------------------------------------------------- /vignettes/data/data18.RData: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mjevans26/eaglesFWS/master/vignettes/data/data18.RData -------------------------------------------------------------------------------- /vignettes/data/newdata.RData: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mjevans26/eaglesFWS/master/vignettes/data/newdata.RData -------------------------------------------------------------------------------- /vignettes/data/zerosim.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mjevans26/eaglesFWS/master/vignettes/data/zerosim.rds -------------------------------------------------------------------------------- /inst/eagles-fws/app_data.RData: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mjevans26/eaglesFWS/master/inst/eagles-fws/app_data.RData -------------------------------------------------------------------------------- /vignettes/www/DOW_logo_small.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mjevans26/eaglesFWS/master/vignettes/www/DOW_logo_small.png -------------------------------------------------------------------------------- /inst/eagles-fws/data/app_data.RData: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mjevans26/eaglesFWS/master/inst/eagles-fws/data/app_data.RData -------------------------------------------------------------------------------- /inst/eagles-fws/data/surfaces.rdata: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mjevans26/eaglesFWS/master/inst/eagles-fws/data/surfaces.rdata -------------------------------------------------------------------------------- /vignettes/data/Eagles_simulation.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mjevans26/eaglesFWS/master/vignettes/data/Eagles_simulation.rds -------------------------------------------------------------------------------- /inst/eagles-fws/data/cost_surfaces_95.rdata: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mjevans26/eaglesFWS/master/inst/eagles-fws/data/cost_surfaces_95.rdata -------------------------------------------------------------------------------- /inst/eagles-fws/www/01_DOW_LOGO_COLOR_300-01.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mjevans26/eaglesFWS/master/inst/eagles-fws/www/01_DOW_LOGO_COLOR_300-01.png -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: eaglesFWS 2 | Type: Package 3 | Title: What the Package Does (Title Case) 4 | Version: 0.1.0 5 | Author: Who wrote it 6 | Maintainer: Who to complain to 7 | Description: More about what it does (maybe more than one line) 8 | License: What license is it under? 9 | LazyData: TRUE -------------------------------------------------------------------------------- /vignettes/_site.yml: -------------------------------------------------------------------------------- 1 | name: "eaglesFWS" 2 | theme: yeti 3 | navbar: 4 | title: "FWS Eagle Mortality" 5 | type: inverse 6 | left: 7 | - text: CCI-dev 8 | href: https://cci-dev.org 9 | - icon: fa-question-circle fa-lg 10 | href: mailto:esa@defenders.org 11 | right: 12 | - icon: fa-github fa-lg 13 | href: https://github.com/mjevans26/eaglesFWS 14 | - text: Defenders 15 | href: http://www.defenders.org 16 | -------------------------------------------------------------------------------- /eaglesFWS.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: pdfLaTeX 14 | 15 | AutoAppendNewline: Yes 16 | StripTrailingWhitespace: Yes 17 | 18 | BuildType: Package 19 | PackageUseDevtools: Yes 20 | PackageInstallArgs: --no-multiarch --with-keep.source 21 | -------------------------------------------------------------------------------- /server.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | 3 | source("exposure.R") 4 | source("fatality.R") 5 | source("helper_fxns.R") 6 | 7 | shinyServer(function(input,output, session){ 8 | exposure(input, output, session) 9 | fatality(input, output, session) 10 | 11 | output$defenders <- renderImage({ 12 | width <- session$clientData$output_defenders_width 13 | if (width > 100) { 14 | width <- 100 15 | } 16 | list(src = "01_DOW_LOGO_COLOR_300-01.png", 17 | contentType = "image/png", 18 | alt = "Defenders of Wildlife", br(), "Endangered Species Program", 19 | width=width) 20 | }, deleteFile=FALSE) 21 | 22 | output$yesterday <- renderText({ 23 | paste0(as.character(format(Sys.Date()-1, "%m/%d/%Y")), ".") 24 | }) 25 | }) 26 | -------------------------------------------------------------------------------- /R/hello.R: -------------------------------------------------------------------------------- 1 | # Hello, world! 2 | # 3 | # This is an example function named 'hello' 4 | # which prints 'Hello, world!'. 5 | # 6 | # You can learn more about package authoring with RStudio at: 7 | # 8 | # http://r-pkgs.had.co.nz/ 9 | # 10 | # Some useful keyboard shortcuts for package authoring: 11 | # 12 | # Build and Reload Package: 'Ctrl + Shift + B' 13 | # Check Package: 'Ctrl + Shift + E' 14 | # Test Package: 'Ctrl + Shift + T' 15 | 16 | hello <- function() { 17 | print("Hello, world!") 18 | } 19 | 20 | 21 | gamma_plot <- function(obs){ 22 | curve(dgamma(x, shape = mean(Bay16$flight_time), 23 | rate = mean(Bay16$effort)),0,1) 24 | curve(dgamma(x, shape = mean(Bay16$flight_time)+Bay16$flight_time[obs], 25 | rate = mean(Bay16$effort)+Bay16$effort[obs]),0,1, add = TRUE, lty = 2) 26 | abline( v = Bay16$flight_time[obs]/Bay16$effort[obs]) 27 | 28 | } 29 | 30 | library(plotly) 31 | -------------------------------------------------------------------------------- /data/ABT_REA_costs.csv: -------------------------------------------------------------------------------- 1 | Duration,Rate,Cost,M,L,H 2 | 10,Low,Low,37500,35800,38800 3 | 10,Low,High,93900,89600,97200 4 | 10,Median,Low,26500,25300,27400 5 | 10,Median,High,66300,63200,68600 6 | 10,High,Low,20500,19500,21200 7 | 10,High,High,51200,48900,5300 8 | 20,Low,Low,21500,20500,22300 9 | 20,Low,High,53800,51400,55700 10 | 20,Median,Low,15200,14500,15700 11 | 20,Median,High,38000,36300,39300 12 | 20,High,Low,11700,11200,12100 13 | 20,High,High,29400,28000,30400 14 | 30,Low,Low,16300,15600,16900 15 | 30,Low,High,40900,39000,42300 16 | 30,Median,Low,11500,11000,11900 17 | 30,Median,High,28800,27500,29900 18 | 30,High,Low,8900,8500,9200 19 | 30,High,High,22300,21300,23100 20 | 40,Low,Low,13800,13200,14300 21 | 40,Low,High,34700,33100,35900 22 | 40,Median,Low,9800,9300,10100 23 | 40,Median,High,24400,23300,25300 24 | 40,High,Low,7500,7200,7800 25 | 40,High,High,18900,18000,19600 26 | 50,Low,Low,12500,11900,12900 27 | 50,Low,High,31100,29700,32200 28 | 50,Median,Low,8800,8400,9100 29 | 50,Median,High,22000,21000,22700 30 | 50,High,Low,6800,6500,7000 31 | 50,High,High,17000,16200,17600 32 | -------------------------------------------------------------------------------- /inst/eagles-fws/data/ABT_REA_costs.csv: -------------------------------------------------------------------------------- 1 | Duration,Rate,Cost,M,L,H 2 | 10,Low,Low,37500,35800,38800 3 | 10,Low,High,93900,89600,97200 4 | 10,Median,Low,26500,25300,27400 5 | 10,Median,High,66300,63200,68600 6 | 10,High,Low,20500,19500,21200 7 | 10,High,High,51200,48900,5300 8 | 20,Low,Low,21500,20500,22300 9 | 20,Low,High,53800,51400,55700 10 | 20,Median,Low,15200,14500,15700 11 | 20,Median,High,38000,36300,39300 12 | 20,High,Low,11700,11200,12100 13 | 20,High,High,29400,28000,30400 14 | 30,Low,Low,16300,15600,16900 15 | 30,Low,High,40900,39000,42300 16 | 30,Median,Low,11500,11000,11900 17 | 30,Median,High,28800,27500,29900 18 | 30,High,Low,8900,8500,9200 19 | 30,High,High,22300,21300,23100 20 | 40,Low,Low,13800,13200,14300 21 | 40,Low,High,34700,33100,35900 22 | 40,Median,Low,9800,9300,10100 23 | 40,Median,High,24400,23300,25300 24 | 40,High,Low,7500,7200,7800 25 | 40,High,High,18900,18000,19600 26 | 50,Low,Low,12500,11900,12900 27 | 50,Low,High,31100,29700,32200 28 | 50,Median,Low,8800,8400,9100 29 | 50,Median,High,22000,21000,22700 30 | 50,High,Low,6800,6500,7000 31 | 50,High,High,17000,16200,17600 32 | -------------------------------------------------------------------------------- /inst/eagles-fws/custom.css: -------------------------------------------------------------------------------- 1 | p { 2 | color: #000; 3 | font-size: 1.1em; 4 | font-family: "Open Sans"; 5 | font-weight: 300; 6 | padding-left: 10px; 7 | } 8 | 9 | a { 10 | color: #1A237E; 11 | font-weight: 600; 12 | } 13 | 14 | a:visited { 15 | color: #5C6BC0; 16 | font-weight: 500; 17 | } 18 | 19 | .selectize-input { 20 | border-radius: 2px !important; 21 | } 22 | 23 | .navbar-inverse .navbar-nav>li>a:hover, 24 | .navbar-inverse .navbar-nav>li>a:focus { 25 | background-color: #616161; 26 | color: #ffffff; 27 | } 28 | 29 | .navbar-brand { 30 | font-size: 1.5em; 31 | font-weight: 800; 32 | } 33 | 34 | .navbar-author { 35 | font-size: 0.7em; 36 | font-weight: 600; 37 | } 38 | 39 | /*This is the navbar...*/ 40 | .container-fluid { 41 | background-color: #000; 42 | color: #f2f2f2; 43 | } 44 | 45 | .section.sidebar { 46 | background-color: #f2f2f2; 47 | border: 0 solid transparent; 48 | } 49 | 50 | .shiny-input-panel { 51 | background-color: #f2f2f2; 52 | border: 0 solid transparent; 53 | margin-top: 0; 54 | margin-bottom: 0; 55 | padding: 1px 8px; 56 | } 57 | 58 | .help-block { 59 | padding-left: 10px; 60 | } 61 | 62 | .chart-title { 63 | border-top: 0 solid #f2f2f2; 64 | border-bottom: 2px solid #f2f2f2; 65 | border-top-right-radius: 3px; 66 | border-top-left-radius: 3px; 67 | font-size: 1.1em; 68 | } 69 | 70 | .chart-wrapper .chart-notes { 71 | background-color: #fff; 72 | border-top: 1px solid #f2f2f2; 73 | border-bottom: 0 solid #f2f2f2; 74 | border-bottom-right-radius: 2px; 75 | border-bottom-left-radius: 2px; 76 | color: #212121; 77 | } 78 | -------------------------------------------------------------------------------- /inst/eagles-fws/www/custom_styles.css: -------------------------------------------------------------------------------- 1 | /*Some custom css to modify the standard Shiny values. */ 2 | 3 | .modal-dialog { 4 | width: 50%; 5 | } 6 | 7 | .container { 8 | height: 100px; 9 | width: inherit; 10 | padding-right: 0px; 11 | padding-left: 10px; 12 | margin-right: auto; 13 | margin-left: auto; 14 | } 15 | .container>.navbar-header{ 16 | margin-right: 0px; 17 | margin-left: 0px; 18 | } 19 | .navbar-header{ 20 | float: right; 21 | } 22 | 23 | .navbar-default .navbar-brand{ 24 | color: #ffffff; 25 | } 26 | .navbar-default .navbar-nav>li>a{ 27 | color: #ffffff !important; 28 | } 29 | 30 | .navbar-default .navbar-nav>.active>a{ 31 | color: #555 !important; 32 | } 33 | 34 | .navbar-default { 35 | background-color: #0A4783 !important; 36 | } 37 | 38 | .box.box-warning { 39 | border-top-color: #f39c12; 40 | } 41 | 42 | .box.box-primary { 43 | border-top-color: #0A4783; 44 | } 45 | .box.box-solid.box-primary { 46 | border: 1px solid #0A4783; 47 | } 48 | 49 | .box.box-solid.box-primary > .box-header { 50 | color: #ffffff; 51 | background-color: #0A4783; 52 | } 53 | .box.box-solid.box-primary > .box-header a, 54 | .box.box-solid.box-primary > .box-header .btn { 55 | color: #ffffff; 56 | } 57 | 58 | .btn-primary { 59 | background-color: #0A4783; 60 | border-color: #367fa9; 61 | } 62 | 63 | .bg-orange { 64 | background-color: #440154 !important; 65 | } 66 | 67 | .bg-red { 68 | background-color: #FDE725 !important; 69 | color: #000000 !important; 70 | } 71 | 72 | .bg-yellow{ 73 | background-color: #35B779 !important; 74 | } 75 | 76 | .bg-green{ 77 | background-color: #31688E !important; 78 | } 79 | 80 | .bg-blue { 81 | background-color: #0A4783 !important; 82 | } 83 | 84 | .content-wrapper{ 85 | background-color: white; 86 | } 87 | 88 | div.outer { 89 | position: fixed; 90 | background-color: white; 91 | top: 41px; 92 | left: 0; 93 | right: 0; 94 | bottom: 0; 95 | overflow: hidden; 96 | padding: 0; 97 | } 98 | 99 | -------------------------------------------------------------------------------- /vignettes/custom.css: -------------------------------------------------------------------------------- 1 | p, li { 2 | font-size: larger; 3 | font-family: "Open Sans"; 4 | font-weight: 300; 5 | } 6 | 7 | h1 { 8 | font-size: 36px; 9 | font-family: "Garamond"; 10 | font-weight: 700; 11 | margin-top: 0 !important; 12 | } 13 | 14 | h2 { 15 | background-color: #1a1a1a; 16 | border-radius: 3px; 17 | color: #fff; 18 | font-size: 30px; 19 | font-family: "Garamond"; 20 | font-weight: 600; 21 | padding: 5px; 22 | } 23 | 24 | h3 { 25 | background-color: #d9d9d9; 26 | border-radius: 3px; 27 | font-size: 24px; 28 | font-family: "Garamond"; 29 | font-weight: 500; 30 | padding: 5px !important; 31 | margin-top: 0 !important; 32 | } 33 | 34 | code { 35 | font-size: larger; 36 | font-family: "Source Code Pro"; 37 | } 38 | 39 | .row { 40 | padding-top: 20px; 41 | } 42 | 43 | .tocify { 44 | border-radius: 2px; 45 | font-size: large; 46 | font-family: "Garamond"; 47 | font-weight: 500; 48 | } 49 | 50 | .list-group-item.active, 51 | .list-group-item.active:focus, 52 | .list-group-item.active:hover { 53 | background-color: #0E3670; 54 | border-color: #0E3670; 55 | } 56 | 57 | .header-panel { 58 | background-color: #2d2d86; 59 | height: 144px; 60 | position: relative; 61 | z-index: 2; 62 | } 63 | 64 | .header-panel div { 65 | position: static; 66 | height: 100%; 67 | } 68 | 69 | .header-panel h1 { 70 | color: #FFF; 71 | /*font-size: 20px;*/ 72 | /*font-weight: 400;*/ 73 | position: absolute; 74 | bottom: 10px; 75 | padding-left: 35px; 76 | } 77 | 78 | .pages > div { 79 | padding: 0 5px; 80 | padding-top: 64px; 81 | margin: 0; 82 | } 83 | 84 | img.image-thumb { 85 | width: 400px; 86 | } 87 | 88 | a { 89 | color: #2d2d86; 90 | font-weight: 600; 91 | } 92 | 93 | .note { 94 | font-size: small; 95 | } 96 | 97 | .return { 98 | font-weight: bold; 99 | } 100 | 101 | .title { 102 | font-family: "Open Sans"; 103 | font-size: 28pt; 104 | font-weight: 800; 105 | padding-top: 20px; 106 | } 107 | 108 | .caption { 109 | font-style: italic; 110 | padding-bottom: 20px; 111 | padding-top: 10px; 112 | } 113 | 114 | .figure-caption { 115 | padding-bottom: 20px; 116 | } 117 | 118 | .tocify-item .list-group-item:not(:active) { 119 | background-color: #ffcc00; 120 | } 121 | -------------------------------------------------------------------------------- /inst/eagles-fws/exposure.R: -------------------------------------------------------------------------------- 1 | exposure <- function(input, output, session) { 2 | cur_min <- reactive({Bay16$FLIGHT_MIN[Bay16$SITE == input$sites]}) 3 | cur_effort <- reactive({Bay16$EFFORT[Bay16$SITE == input$sites]}) 4 | cur_scale <- reactive({Bay16$SCALE[Bay16$SITE == input$sites]}) 5 | 6 | a <- reactive({mean(Bay16$FLIGHT_MIN) + cur_min()}) 7 | 8 | b <- reactive({mean(Bay16$EFFORT) + cur_effort()}) 9 | 10 | act <- reactive({cur_min()/cur_effort()}) 11 | 12 | observeEvent(input$update,{ 13 | act <- isolate({act()}) 14 | obs <- isolate({curve(dgamma(x, shape = a(), rate = b()), 15 | from = quantile(rgamma(1000, shape = a(), rate = b()) , probs = 0), 16 | to = quantile(rgamma(1000, shape = a(), rate = b()) , probs = 1)) 17 | }) 18 | 19 | output$exposure <- renderPlotly({ 20 | plot_ly()%>% 21 | add_trace(x = ~c(act, act), y = ~c(0,max(c(prior$y,obs$y))), 22 | type = "scatter", mode = "lines", 23 | name = "Observed", line = list(color = vir_col(3)[2]), 24 | text = ~paste("Observed Activity
at site = ", 25 | round(act,2), 26 | sep = ""), 27 | hoverinfo = "text")%>% 28 | add_trace(x = ~prior$x, y = prior$y, 29 | type = "scatter", mode = "lines", fill = "tozeroy", 30 | name = "Prior", line = list(color = vir_col(3)[1]), 31 | text = ~paste("Prior Activity
estimate = ", 32 | round(prior$x, 2), 33 | "
is ", 34 | round(prior$y, 2), 35 | sep = ""), 36 | hoverinfo = "text")%>% 37 | add_trace(x = ~obs$x, y = ~obs$y, 38 | type = "scatter", mode = "lines", fill = "tozeroy", 39 | name = "Combined", line = list(color = vir_col(3)[3]), 40 | text = ~paste("Combined Activity
estimate = ", 41 | round(obs$x, 2), 42 | "
is ", 43 | round(obs$y, 2), 44 | sep = ""), 45 | hoverinfo = "text")%>% 46 | layout(#title = "Eagle Exposure", 47 | xaxis = list(title = "Eagle Activity (min/km3*hr)", 48 | range = c(0,3)), 49 | yaxis = list(title = "Probability Density")) 50 | }) 51 | 52 | }) 53 | } 54 | -------------------------------------------------------------------------------- /inst/eagles-fws/fatality.R: -------------------------------------------------------------------------------- 1 | fatality <- function(input, output, session) { 2 | cur_dat <- reactive({ 3 | if(input$sites == ""){Bay16} 4 | else{ 5 | Bay16[Bay16$SITE == input$sites, ] 6 | } 7 | }) 8 | cur_min <- reactive({cur_dat()$FLIGHT_MIN}) 9 | cur_effort <- reactive({cur_dat()$EFFORT}) 10 | cur_scale <- reactive({cur_dat()$SCALE}) 11 | 12 | a <- reactive({mean(Bay16$FLIGHT_MIN) + cur_min()}) 13 | 14 | b <- reactive({mean(Bay16$EFFORT) + cur_effort()}) 15 | 16 | act <- reactive({cur_min()/cur_effort()}) 17 | 18 | observeEvent(input$calculate,{ 19 | if(input$sites != ""){ 20 | out <- isolate({prediction(10000, a(), b())}) 21 | fatality <- isolate({density(out$fatality*cur_scale())}) 22 | q80 <- isolate({quantile(out$fatality, c(0.1, 0.9))}) 23 | 24 | out2 <- isolate({prediction(10000, a()-mean(Bay16$FLIGHT_MIN), b()-mean(Bay16$EFFORT))}) 25 | fatality2 <- isolate({density(out2$fatality*cur_scale())}) 26 | q82 <- isolate({quantile(out2$fatality, c(0.1, 0.9))}) 27 | 28 | output$fatal <- renderPlotly({ 29 | plot_ly()%>% 30 | add_trace(x = ~fatality$x, y = ~fatality$y, type = "scatter", mode = "lines", 31 | fill = "tozeroy", 32 | name = "Incl. Prior Exposure", line = list(color = vir_col(3)[3]), 33 | text = ~paste("Predicted fatalities
incorporating prior = ", 34 | round(fatality$x, 2), 35 | sep = ""), 36 | hoverinfo = "text")%>% 37 | add_trace(x = ~fatality2$x, y = ~fatality2$y, type = "scatter", mode = "lines", 38 | fill = "tozeroy", 39 | line = list(color = vir_col(3)[2]), name = "Using Site Survey Only", 40 | text = ~paste("Predicted fatalities
from site survey = ", 41 | round(fatality2$x, 2), 42 | sep = ""), 43 | hoverinfo = "text")%>% 44 | #add_trace(x = ~c(q80[[1]], q80[[1]], q80[[2]], q80[[2]]), y = ~c(max(fatality2$y/fatality2$n), 0, 0, max(fatality2$y/fatality2$n)), type = "scatter", mode = "lines")%>% 45 | layout(##title = "Predicted Annual Eagle Fatalities", 46 | xaxis = list(title = "Fatalities per Year", 47 | range = c(0,20)), 48 | yaxis = list(title = "Probability Density"), 49 | legend = list(x = 0.7, 50 | y = 1)) 51 | }) 52 | } 53 | }) 54 | 55 | } 56 | -------------------------------------------------------------------------------- /R/MDP.R: -------------------------------------------------------------------------------- 1 | library(dplyr) 2 | library(reshape2) 3 | library(MDPtoolbox) 4 | 5 | # FWS eagle activity (min/hr*km3) prior distribution is Gamma(0.968, 0.552) 6 | expose <- list('shape' = 0.968, 'rate' = 0.552) 7 | # FWS collision probability distribution is Beta(2.31, 396.69) 8 | collide <- list('shape1' = 2.31, 'shape2' = 396.69) 9 | 10 | meanCollision <- collide$shape1/collide$shape2 11 | 12 | # Collision rate (fatalities/min) and eagle activity (min/hr*km3) are multiplied by an expansion factor 13 | # determined by the size of a wind facility (hr*km3) to produce a final eagle fatality estimate 14 | expFac <- 3650*(0.1)*(0.05^2)*pi 15 | nturb <- 200 16 | size <- nturb * expFac 17 | mitigation <- filter(cost_table, Duration == 30, Rate == "Median", Cost == 'High')$M * size 18 | 19 | ## S: possible states of the system: 20 | # one approach is that states represent our possible beliefs or true activity rates (?) 21 | S<- seq(0.5, 3, 0.5) 22 | # len <- length(S) 23 | 24 | # another approach is states represent possible combos of true eagle activity rate and beliefs 25 | s <- expand.grid(truth = S, belief = S)%>% 26 | mutate(state = paste(truth, belief, sep = "_")) 27 | len <- nrow(s) 28 | 29 | ## R: SxSx2 array 30 | # difference between the current state discrepancy between believed and true number of eagles 31 | # and the discrepancy of any other state. We assume a facility with 100 turbines 32 | transitions <- expand.grid(state1 = s$state, state2 = s$state)%>% 33 | left_join(s, by = c('state1' = 'state'))%>% 34 | left_join(s, by = c('state2' = 'state'))%>% 35 | mutate(value = -abs((truth.x - belief.x)*meanCollision*mitigation) - -abs((truth.y - belief.y)*meanCollision*mitigation)) 36 | values <- acast(transitions, state1 ~ state2, value.var = 'value') 37 | 38 | R <- array(c(values, rep(survey_costs$Low*10, len^2)), dim = c(len, len, 2)) 39 | dimnames(R)[[3]]<-c('mitigate', 'survey') 40 | 41 | ## P: probability transition array 42 | # probability of going from state S to state S(t+1) for each action 43 | 44 | # probability of transitioning if we mitigate is 0. therefore identity matrix 45 | # TODO: if state incorporates our strength of belief (i.e. survey efffort) then this is no longer identity 46 | Pm <- diag(nrow = len, ncol = len) 47 | 48 | # probability of transitioning from S to S(t+1) after surveying for x hours... 49 | 50 | # S x S matrix holding probabilities of observing each state given each possible state is true 51 | Ps <- mutate(transitions, prob = dpois(belief.y *10, truth.x*10))%>% 52 | mutate(prob = ifelse(truth.x == truth.y, prob, 0))%>% 53 | acast(state1 ~ state2, value.var = 'prob') 54 | 55 | P <- array(c(Pm, Ps), dim = c(len, len, 2)) 56 | dimnames(P)[[3]]<-c('mitigate', 'survey') 57 | 58 | analysis <- mdp_value_iteration(P, R, discount = 0.9, max_iter = 1000, epsilon = 0.02) 59 | -------------------------------------------------------------------------------- /R/eBird.R: -------------------------------------------------------------------------------- 1 | library(ebirdst) 2 | library(raster) 3 | library(rvest) 4 | library(sp) 5 | library(viridis) 6 | 7 | # 1. Get coordinates for wind farms that might be in Bay et al. (2016) 8 | url <- 'https://www.windpowerengineering.com/wind-project-map/' 9 | page <- read_html(url) 10 | tab <- html_node(page, 'table') 11 | links <- html_nodes(tab, 'a')%>% 12 | html_attr('href') 13 | 14 | #' return the latitude and longitude from a wind project's page 15 | #' @description this function is mean to be applied the link(s) for individual wind 16 | #' projects provided by www.windengineering.com 17 | #' @param link string url 18 | get_lat_lon <- function(link){ 19 | page <- read_html(link)%>% 20 | html_node('body')%>% 21 | html_text() 22 | 23 | lat <- str_extract(page, 'latitude: [0-9]*.[0-9]*') 24 | lon <- str_extract(page, 'longitude: -[0-9]*.[0-9]*') 25 | return(c(lat, lon)) 26 | } 27 | 28 | test <- sapply(links, get_lat_lon, USE.NAMES = FALSE) 29 | 30 | dat$Lat <- str_remove(test[1,], 'latitude: ') 31 | dat$Long <- str_remove(test[2,], 'longitude: ') 32 | 33 | dat <- mutate(Lat = str_extract(dat$Lat, '[0-9]*.[0-9]*'), 34 | Long = str_extract(dat$Long, '-[0-9]*.[0-9]*')) 35 | 36 | # read in data from Bay et al. (2016) on site effort and eagle activity 37 | bay_2016 <- readRDS(file = 'vignettes/data/Bay_2016.rds') 38 | bay_2016 <- bay_2016%>% 39 | mutate(State = str_split_fixed(SITE, ',', n = 2)[,2], 40 | Site = str_split_fixed(SITE, ',', n = 2)[,1])%>% 41 | # add latitude and longitude from scraped web data 42 | left_join(dat[,c(1,6:7)], by = c('Site' = 'Name')) 43 | 44 | # need to add some lat, lon data manually 45 | bay_2016[bay_2016$Site == 'Vantage', 22:23] <- c(46.954, -120.186) 46 | bay_2016[bay_2016$Site == 'Vansycle', 22:23] <- c(45.897, -118.579) 47 | bay_2016[bay_2016$Site == 'Klondike', 22:23] <- c(45.584, -120.553) 48 | bay_2016[bay_2016$Site == 'Kittitas Valley', 22:23] <- c(47.154, -120.679) 49 | bay_2016[bay_2016$Site == 'Hopkins Ridge', 22:23] <- c(46.432, -117.818) 50 | 51 | bay_2016[bay_2016$Site =='Alta Oak Creek Mojave (Alta I)', 22:23]<- c(35.036, -118.365) 52 | bay_2016[bay_2016$Site =='Alta Oak Creek Mojave (Alta II–V)', 22:23]<- c(35.01, -118.269) 53 | bay_2016[bay_2016$Site =='Campbell Hills', 22:23]<- c(43.02, -105.992) 54 | bay_2016[bay_2016$Site =='Diablo Winds', 22:23]<- c(37.711, -121.64) 55 | bay_2016[bay_2016$Site =='Foote Creek Rim (Phases II and III)', 22:23]<- c(41.647, -106.197) 56 | bay_2016[bay_2016$Site =='Dry Lake I', 22:23]<- c(34.646, -110.29) 57 | bay_2016[bay_2016$Site =='Elkhorn', 22:23]<- c(45.05, -117.804) 58 | bay_2016[bay_2016$Site =='Foote Creek Rim (Phase I)', 22:23]<- c(41.647, -106.197) 59 | bay_2016[bay_2016$Site =='Windy Flats', 22:23]<- c(45.766, -120.652) 60 | 61 | # 2. Read eBird raster data 62 | golden_rast <- ebirdst_download('golden eagle') 63 | -------------------------------------------------------------------------------- /vignettes/eBird.R: -------------------------------------------------------------------------------- 1 | library(ebirdst) 2 | library(raster) 3 | library(rvest) 4 | library(sp) 5 | library(viridis) 6 | 7 | # 1. Get coordinates for wind farms that might be in Bay et al. (2016) 8 | url <- 'https://www.windpowerengineering.com/wind-project-map/' 9 | page <- read_html(url) 10 | tab <- html_node(page, 'table') 11 | links <- html_nodes(tab, 'a')%>% 12 | html_attr('href') 13 | 14 | #' return the latitude and longitude from a wind project's page 15 | #' @description this function is mean to be applied the link(s) for individual wind 16 | #' projects provided by www.windengineering.com 17 | #' @param link string url 18 | get_lat_lon <- function(link){ 19 | page <- read_html(link)%>% 20 | html_node('body')%>% 21 | html_text() 22 | 23 | lat <- str_extract(page, 'latitude: [0-9]*.[0-9]*') 24 | lon <- str_extract(page, 'longitude: -[0-9]*.[0-9]*') 25 | return(c(lat, lon)) 26 | } 27 | 28 | test <- sapply(links, get_lat_lon, USE.NAMES = FALSE) 29 | 30 | dat$Lat <- str_remove(test[1,], 'latitude: ') 31 | dat$Long <- str_remove(test[2,], 'longitude: ') 32 | 33 | dat <- mutate(Lat = str_extract(dat$Lat, '[0-9]*.[0-9]*'), 34 | Long = str_extract(dat$Long, '-[0-9]*.[0-9]*')) 35 | 36 | # read in data from Bay et al. (2016) on site effort and eagle activity 37 | bay_2016 <- readRDS(file = 'vignettes/data/Bay_2016.rds') 38 | bay_2016 <- bay_2016%>% 39 | mutate(State = str_split_fixed(SITE, ',', n = 2)[,2], 40 | Site = str_split_fixed(SITE, ',', n = 2)[,1])%>% 41 | # add latitude and longitude from scraped web data 42 | left_join(dat[,c(1,6:7)], by = c('Site' = 'Name')) 43 | 44 | # need to add some lat, lon data manually 45 | bay_2016[bay_2016$Site == 'Vantage', 22:23] <- c(46.954, -120.186) 46 | bay_2016[bay_2016$Site == 'Vansycle', 22:23] <- c(45.897, -118.579) 47 | bay_2016[bay_2016$Site == 'Klondike', 22:23] <- c(45.584, -120.553) 48 | bay_2016[bay_2016$Site == 'Kittitas Valley', 22:23] <- c(47.154, -120.679) 49 | bay_2016[bay_2016$Site == 'Hopkins Ridge', 22:23] <- c(46.432, -117.818) 50 | 51 | bay_2016[bay_2016$Site =='Alta Oak Creek Mojave (Alta I)', 22:23]<- c(35.036, -118.365) 52 | bay_2016[bay_2016$Site =='Alta Oak Creek Mojave (Alta II–V)', 22:23]<- c(35.01, -118.269) 53 | bay_2016[bay_2016$Site =='Campbell Hills', 22:23]<- c(43.02, -105.992) 54 | bay_2016[bay_2016$Site =='Diablo Winds', 22:23]<- c(37.711, -121.64) 55 | bay_2016[bay_2016$Site =='Foote Creek Rim (Phases II and III)', 22:23]<- c(41.647, -106.197) 56 | bay_2016[bay_2016$Site =='Dry Lake I', 22:23]<- c(34.646, -110.29) 57 | bay_2016[bay_2016$Site =='Elkhorn', 22:23]<- c(45.05, -117.804) 58 | bay_2016[bay_2016$Site =='Foote Creek Rim (Phase I)', 22:23]<- c(41.647, -106.197) 59 | bay_2016[bay_2016$Site =='Windy Flats', 22:23]<- c(45.766, -120.652) 60 | 61 | # 2. Read eBird raster data 62 | golden_rast <- ebirdst_download('golden eagle') 63 | -------------------------------------------------------------------------------- /global.R: -------------------------------------------------------------------------------- 1 | library(dplyr) 2 | library(plotly) 3 | library(shiny) 4 | library(shinydashboard) 5 | plot(Bay16$RISK_HA, (fatality/(Bay16$FLIGHT_MIN/Bay16$EFFORT))/mean(rbeta(1000, 9.38, 3224.51))) 6 | 7 | test <- glm(data = Bay16, (COLLISIONS/(FLIGHT_MIN/EFFORT))/0.002895415~RISK_HA + r2) 8 | #Bay16 <- read.csv("C:/Users/mevans/repos/eaglesFWS/BayData.csv", header = TRUE) 9 | 10 | #Bay16$OBS_MIN <- as.character(Bay16$OBS_MIN)%>% 11 | # gsub(",","",.)%>% 12 | # as.numeric() 13 | #Bay16$FLIGHT_MIN <- as.character(Bay16$FLIGHT_MIN)%>% 14 | # gsub(",","",.)%>% 15 | # as.numeric() 16 | 17 | #Bay16$EFFORT <- (Bay16$HECTARES*0.01)*(Bay16$OBS_MIN/60) 18 | Bay16$SCALE <- (0.02112*Bay16$RISK_HA*Bay16$DIAMETER*Bay16$PERIOD + 0.3503) 19 | 20 | load("app_data.RData") 21 | Bay16$EFFORT <- (Bay16$HECTARES*0.01*0.2)*(Bay16$OBS_MIN/60) 22 | 23 | prior <- curve(dgamma(x, shape = sum(Bay16$FLIGHT_MIN), rate = sum(Bay16$EFFORT)), 24 | from = 0.5, 25 | to = 2) 26 | 27 | 28 | #obs <- rgamma(10000,shape = mean(Bay16$FLIGHT_MIN), rate = mean(Bay16$EFFORT))%>% 29 | # density() 30 | 31 | #collision <- data.frame(y = dbeta(seq(0,0.01,0.0001), shape1 = 9.38, shape2 = 3224.51), 32 | # x = seq(0, 0.01, 0.0001)) 33 | 34 | collision <- curve(dbeta(x, shape1 = 9.38, shape2 = 3224.51), from = 0, to = 0.01) 35 | 36 | act <- sum(Bay16$FLIGHT_MIN)/sum(Bay16$EFFORT) 37 | #gamma_plot <- function(obs){ 38 | # curve(dgamma(x, shape = mean(Bay16$flight_time), 39 | # rate = mean(Bay16$effort)),0,1) 40 | # curve(dgamma(x, shape = mean(Bay16$flight_time)+Bay16$flight_time[obs], 41 | # rate = mean(Bay16$effort)+Bay16$effort[obs]),0,1, add = TRUE, lty = 2) 42 | # abline( v = Bay16$flight_time[obs]/Bay16$effort[obs]) 43 | #} 44 | 45 | prediction <- function(iters, alpha, beta){ 46 | out <- data.frame(collision = rep(NA,iters), expose = rep(NA, iters), fatality = rep(NA, iters)) 47 | for(n in 1:iters){ 48 | c <- rbeta(1, shape1 = 9.38, shape2 = 3224.51) 49 | e <- rgamma(1, shape = alpha, rate = beta) 50 | f <- c*e 51 | out[n,] <- c(c,e,f) 52 | } 53 | return(out) 54 | } 55 | 56 | parallel_predict <- function(iters, alpha, beta){ 57 | out <- data.frame(collision = rep(NA, iters), expose = rep(NA, iters), fatality = rep(NA, iters)) 58 | foreach(n = 1:iters, .combine = m)%dopar%{ 59 | c <- rbeat(1, shape1 = 9.38, shape2 = 3224.51) 60 | e <- rgamma(1, shape = alpha, rate = beta) 61 | f <- c*e 62 | return() 63 | } 64 | 65 | } 66 | 67 | #prediction <- function(iters, alpha, beta){ 68 | #out <- data.frame(collision = rep(NA,iters), expose = rep(NA, iters), fatality = rep(NA, iters)) 69 | #for(n in 1:iters){ 70 | # c <- rbeta(1, shape1 = 9.38, shape2 = 3224.51) 71 | # e <- rgamma(1, shape = alpha, rate = beta) 72 | # f <- c*e 73 | # out[n,] <- c(c,e,f) 74 | #} 75 | #return(out) 76 | #} 77 | 78 | -------------------------------------------------------------------------------- /vignettes/www/HTMLAnalysis_custom.css: -------------------------------------------------------------------------------- 1 | p, li { 2 | font-size: larger; 3 | font-family: sans-serif; 4 | font-weight: 300; 5 | } 6 | 7 | p { 8 | margin-bottom: 30px; 9 | } 10 | 11 | a { 12 | color: #ffffff !important; 13 | } 14 | 15 | 16 | h1 { 17 | font-size: 36px; 18 | font-family: sans-serif; 19 | font-weight: 700; 20 | margin-top: 0 !important; 21 | } 22 | 23 | h2 { 24 | background-color: #1a1a1a; 25 | border-radius: 3px; 26 | color: #fff; 27 | font-size: 30px; 28 | font-family: "Garamond"; 29 | font-weight: 600; 30 | padding: 5px; 31 | } 32 | 33 | .section h2 { 34 | padding-top: 5px !important; 35 | margin-top: -5px !important; 36 | } 37 | 38 | h3 { 39 | background-color: #d9d9d9; 40 | border-radius: 3px; 41 | font-size: 24px; 42 | font-family: sans-serif; 43 | font-weight: 500; 44 | padding: 5px !important; 45 | margin-top: 0 !important; 46 | } 47 | 48 | code { 49 | font-size: larger; 50 | font-family: "Source Code Pro"; 51 | } 52 | 53 | .navbar-inverse { 54 | box-shadow: 0 2px 4px -1px rgba(0,0,0,0.25); 55 | } 56 | 57 | .navbar-inverse .navbar-nav>li>a:hover, 58 | .navbar-inverse .navbar-nav>li>a:focus { 59 | background-color: #616161; 60 | color: #ffffff; 61 | } 62 | 63 | .navbar { 64 | background-color: #003B87; 65 | box-shadow: 0 2px 4px -1px rgba(0,0,0,0.25); 66 | } 67 | 68 | 69 | .row { 70 | padding-top: 20px; 71 | } 72 | 73 | .tocify { 74 | border-radius: 2px; 75 | font-size: large; 76 | font-family: "Garamond"; 77 | font-weight: 500; 78 | } 79 | 80 | .list-group-item.active, 81 | .list-group-item.active:focus, 82 | .list-group-item.active:hover { 83 | background-color: #003B87; 84 | border-color: #003B87; 85 | } 86 | 87 | .header-panel { 88 | background-color: #2d2d86; 89 | height: 144px; 90 | position: relative; 91 | z-index: 2; 92 | } 93 | 94 | .header-panel div { 95 | position: static; 96 | height: 100%; 97 | } 98 | 99 | .header-panel h1 { 100 | color: #FFF; 101 | /*font-size: 20px;*/ 102 | /*font-weight: 400;*/ 103 | position: absolute; 104 | bottom: 10px; 105 | padding-left: 35px; 106 | } 107 | 108 | .pages > div { 109 | padding: 0 5px; 110 | padding-top: 64px; 111 | margin: 0; 112 | } 113 | 114 | img.image-thumb { 115 | width: 400px; 116 | } 117 | 118 | a { 119 | color: #2d2d86; 120 | font-weight: 600; 121 | } 122 | 123 | .note { 124 | font-size: small; 125 | } 126 | 127 | .return { 128 | font-weight: bold; 129 | } 130 | 131 | .title { 132 | font-family: "Open Sans"; 133 | font-size: 28pt; 134 | font-weight: 800; 135 | padding-top: 20px; 136 | } 137 | 138 | .caption { 139 | font-style: italic; 140 | padding-bottom: 20px; 141 | padding-top: 10px; 142 | } 143 | 144 | .figure-caption { 145 | padding-bottom: 20px; 146 | } 147 | 148 | .tocify-item .list-group-item:not(:active) { 149 | background-color: #ffcc00; 150 | } 151 | 152 | .datatables .html-widget .html-widget-static-bound { 153 | width: 100% !important; 154 | height: auto; 155 | } 156 | 157 | table { 158 | width: 100% !important; 159 | height: auto; 160 | } 161 | 162 | .footnotes { 163 | font-size: 12px; 164 | } 165 | 166 | .abstract{ 167 | background-color: rgba(0, 104, 255, 0.1); 168 | font-family: Helvetica, arial, sans-serif; 169 | padding-right: 10px; 170 | padding-left: 10px; 171 | } 172 | 173 | @media screen and (-webkit-min-device-pixel-ratio:0) 174 | and (min-resolution:.001dpcm) { 175 | .main-container { 176 | padding-top: 55px; 177 | } 178 | } 179 | -------------------------------------------------------------------------------- /inst/eagles-fws/www/dashboard.css: -------------------------------------------------------------------------------- 1 | p { 2 | color: #000; 3 | font-size: 1.1em; 4 | font-family: sans-serif; 5 | font-weight: 300; 6 | padding-left: 10px; 7 | } 8 | 9 | a { 10 | color: #1A237E; 11 | font-weight: 600; 12 | } 13 | 14 | a:visited { 15 | color: #5C6BC0; 16 | font-weight: 500; 17 | } 18 | 19 | .selectize-input { 20 | border-radius: 2px !important; 21 | } 22 | 23 | .navbar { 24 | box-shadow: 0 2px 4px -1px rgba(0,0,0,0.25); 25 | } 26 | 27 | .navbar-inverse .navbar-nav>li>a:hover, 28 | .navbar-inverse .navbar-nav>li>a:focus { 29 | background-color: #616161; 30 | color: #ffffff; 31 | } 32 | 33 | .navbar-brand { 34 | font-size: 1.5em; 35 | font-weight: 800; 36 | } 37 | 38 | .navbar-author { 39 | font-size: 0.7em; 40 | font-weight: 600; 41 | } 42 | 43 | /*This is the navbar...*/ 44 | .container-fluid { 45 | background-color: #003B87; 46 | color: #f2f2f2; 47 | } 48 | 49 | .section.sidebar { 50 | background-color: #f2f2f2; 51 | border: 0 solid transparent; 52 | } 53 | 54 | .shiny-input-panel { 55 | background-color: #f2f2f2; 56 | border: 0 solid transparent; 57 | margin-top: 0; 58 | margin-bottom: 0; 59 | padding: 1px 8px; 60 | } 61 | 62 | .help-block { 63 | padding-left: 10px; 64 | } 65 | 66 | .chart-title { 67 | border-top: 0 solid #f2f2f2; 68 | border-bottom: 2px solid #f2f2f2; 69 | border-top-right-radius: 3px; 70 | border-top-left-radius: 3px; 71 | font-size: 1.1em; 72 | } 73 | 74 | .chart-wrapper .chart-notes { 75 | background-color: #fff; 76 | border-top: 1px solid #f2f2f2; 77 | border-bottom: 0 solid #f2f2f2; 78 | border-bottom-right-radius: 2px; 79 | border-bottom-left-radius: 2px; 80 | color: #212121; 81 | } 82 | 83 | .chart-title { 84 | background-color: #003B87; 85 | color: #ffffff; 86 | } 87 | 88 | #section-col-1, #section-col-2 { 89 | background-color: white; 90 | border: lightgray solid 1px; 91 | border-radius: 3px; 92 | margin-right: 5px; 93 | margin-bottom: 10px; 94 | padding: 10px 2px 2px 10px; 95 | } 96 | 97 | /* ---------------------------- 98 | .info-box { 99 | background-color: white; 100 | border: 1px solid lightgray; 101 | border-radius: 3px; 102 | margin-right: 10%; 103 | padding: 15px 20px; 104 | } 105 | 106 | .info-box-content > .info-box-text { 107 | font-size: 1.5rem; 108 | font-weight: 500; 109 | } 110 | 111 | .info-box-content > .info-box-number { 112 | font-size: 4rem; 113 | font-weight: 800; 114 | vertical-align: middle; 115 | } 116 | 117 | .shiny-html-output .shiny-bound-output { 118 | width: 25%; 119 | } 120 | -------------------------- */ 121 | 122 | .value-output, 123 | .caption > .shiny-text-output .shiny-bound-output { 124 | font-family: sans-serif !important; 125 | } 126 | 127 | .bg-danger { 128 | background-color: #EA8439; 129 | } 130 | 131 | .bg-info { 132 | background-color: #8E4E8A; 133 | } 134 | 135 | .bg-success { 136 | background-color: #387C2B; 137 | } 138 | 139 | #downloadSensData, #downloadDiscData { 140 | margin-bottom: 20px; 141 | width: 250px; 142 | } 143 | 144 | /* section-specific tuning */ 145 | 146 | #section-species > * > #section-main { 147 | display: none !important; 148 | } 149 | 150 | #section-row-1, #section-row-3 { 151 | margin-bottom: 20px; 152 | } 153 | 154 | #section-row-1b, #section-row-0a, #section-row-2b { 155 | flex: none !important; 156 | } 157 | 158 | #section-row-1b > h1 { 159 | margin-top: 0; 160 | } 161 | 162 | #section-col-2-1 { 163 | padding: 20px; 164 | } 165 | 166 | .btn-default { 167 | border-radius: 5px !important; 168 | } 169 | 170 | /* .dashboard-page-wrapper { 171 | -webkit-padding-before: 55px; 172 | } 173 | 174 | @media screen and (-webkit-min-device-pixel-ratio:0) 175 | and (min-resolution:.001dpcm) { 176 | .dashboard-page-wrapper { 177 | padding-top: 55px; 178 | } 179 | } */ 180 | -------------------------------------------------------------------------------- /ui.R: -------------------------------------------------------------------------------- 1 | # 2 | # This is the user-interface definition of a Shiny web application. You can 3 | # run the application by clicking 'Run App' above. 4 | # 5 | # Find out more about building applications with Shiny here: 6 | # 7 | # http://shiny.rstudio.com/ 8 | # 9 | 10 | library(shiny) 11 | header <- dashboardHeader(disable = TRUE) 12 | 13 | sidebar <- dashboardSidebar(disable = TRUE) 14 | 15 | body <- dashboardBody( 16 | tags$head( 17 | tags$link(rel = "stylesheet", type = "text/css", href = "custom_styles.css")), 18 | 19 | navbarPage(div(column(4,tags$a(href = "http://www.defenders.org", tags$img(src = "01_DOW_LOGO_COLOR_300-01.png", height = "80px"))), column(8, h4("Defenders of Widlife", br(), "Center for Conservation Innovation"))), 20 | tabPanel(h4("FWS Eagle Take Estimator"),id = "summary", 21 | fluidPage( 22 | fluidRow( 23 | column(2,br()), 24 | column(8, 25 | h4("Fish and Wildlife Services uses a Bayesian model to estimate the number of eagles likely to be killed by proposed wind projects. 26 | This approach combines prior information about eagle collision rates and exposure across wind farms, with 27 | observed estimates of eagle activity at proposed sites to estimate the likely number of fatalities.",br(), 28 | "Fatalities = Collision Rate * Exposure * Project Size")), 29 | column(2, br()) 30 | ), 31 | fluidRow( 32 | column(4, 33 | h2("Collision Rate"), 34 | h4("Prior distributions represent the current knowledge about a system or parameter. Priors are expressed as 35 | a statistical distribution, indicating the possible values and relative certainty a variable may take. FWS 36 | has used the observed collision rates at wind energy sites to create a prior distribution for this part of the fatality equation.")), 37 | column(8, 38 | plotlyOutput("prior"),br()) 39 | ), 40 | fluidRow( 41 | column(4, 42 | h2("In Action"), 43 | h4("Select one of the wind sites below and click 'Update Distributions' to see how eagle survey information at a given location 44 | is integrated with prior information about eagle exposure and collision rates to produce an estimate of fatality"), 45 | selectInput("sites", "Choose a Site", choices = c("", levels(Bay16$SITE)), selected = NULL), 46 | h4("Alternatively, enter your own survey information",br(), "(Note: the site selector must be empty)"), 47 | numericInput("time", label = "Eagle flight time (min)", value = mean(Bay16$FLIGHT_MIN), min = 0), 48 | numericInput("effort", label = "Survey Effort (km2*hr)", value = mean(Bay16$EFFORT), min = 0), 49 | actionButton("update", "Update Distributions") 50 | ), 51 | column(8, plotlyOutput("exposure"), br()) 52 | ), 53 | fluidRow( 54 | column(4, 55 | h2("Estimating Eagle Fatality"), 56 | h4("Click the 'Calculate Fatalities' button to see the predicted fatalities for the currently selected site, 57 | or survey information. Of particular interest is how the estimated values generated using prior information 58 | on exposure rates (purple), compare to estimates produced when only a given site's survey is considered."), 59 | actionButton("calculate", "Calculate Fatalities") 60 | ), 61 | column(8, plotlyOutput("fatal")) 62 | ) 63 | )), fluid=TRUE 64 | ), 65 | br(), 66 | fluidRow(column(2), 67 | column(4, div(HTML(' 68 | Creative Commons License 69 |
70 | This work 71 | by Defenders of Wildlife 72 | is licensed under a Creative Commons Attribution-NonCommercial-ShareAlike 4.0 International License. 73 |
'), 74 | style = "text-align: center")), 75 | column(1), 76 | column(2, div(HTML('
Email questions or comments to esa@defenders.org '), style = "text-align: center")) 77 | ) 78 | ) 79 | 80 | dashboardPage(header, sidebar, body, skin = "blue") 81 | 82 | -------------------------------------------------------------------------------- /inst/eagles-fws/bayesian.R: -------------------------------------------------------------------------------- 1 | exposure <- function(input, output, session) { 2 | cur_min <- reactive({Bay16$FLIGHT_MIN[Bay16$SITE == input$sites]}) 3 | cur_effort <- reactive({Bay16$EFFORT[Bay16$SITE == input$sites]}) 4 | cur_scale <- reactive({Bay16$SCALE[Bay16$SITE == input$sites]}) 5 | a <- reactive({sum(Bay16$FLIGHT_MIN)+cur_min()}) 6 | 7 | b <- reactive({sum(Bay16$EFFORT)+ cur_effort()}) 8 | 9 | act <- reactive({cur_min()/cur_effort()}) 10 | 11 | observeEvent(input$update,{ 12 | act <- isolate({act()}) 13 | obs <- isolate({density(rgamma(10000, shape = a(), rate = b()))}) 14 | 15 | output$exposure <- renderPlotly({ 16 | plot_ly()%>% 17 | add_trace(x = ~prior$x, y = prior$y, 18 | type = "scatter", mode = "lines", fill = "tozeroy", 19 | name = "Prior", line = list(color = "orange"), 20 | text = ~paste("Prior probability of Exposure = ", 21 | round(prior$x, 2), 22 | "
is ", 23 | round(prior$y, 2), 24 | sep = ""), 25 | hoverinfo = "text")%>% 26 | add_trace(x = ~c(act, act), y = ~c(0,max(c(prior$y,obs$y))), 27 | type = "scatter", mode = "lines", 28 | name = "Observed", line = list(color = "green"), 29 | text = ~paste("Observed Exposure = ", 30 | round(act,2), 31 | sep = ""), 32 | hoverinfo = "text")%>% 33 | add_trace(x = ~obs$x, y = ~obs$y, 34 | type = "scatter", mode = "lines", fill = "tozeroy", 35 | name = "Posterior", line = list(color = "blue"), 36 | text = ~paste("Posterior probability of Exposure = ", 37 | round(obs$x, 2), 38 | "
is ", 39 | round(obs$y, 2), 40 | sep = ""), 41 | hoverinfo = "text")%>% 42 | layout(title = "Eagle Exposure", 43 | xaxis = list(title = "Exposure (min/km3*hr)", 44 | range = c(0,3)), 45 | yaxis = list(title = "Probability")) 46 | }) 47 | 48 | }) 49 | 50 | observeEvent(input$calculate,{ 51 | out <- isolate({prediction(10000, a(), b())}) 52 | fatality <- isolate({density(out$fatality*cur_scale())}) 53 | q80 <- isolate({quantile(out$fatality, c(0.1, 0.9))}) 54 | out2 <- isolate({prediction(10000, a()-mean(Bay16$FLIGHT_MIN), b()-mean(Bay16$EFFORT))}) 55 | fatality2 <- isolate({density(out2$fatality*cur_scale())}) 56 | q82 <- isolate({quantile(out2$fatality, c(0.1, 0.9))}) 57 | 58 | output$fatal <- renderPlotly({ 59 | plot_ly()%>% 60 | add_trace(x = ~fatality$x, y = ~fatality$y, type = "scatter", mode = "lines", fill = "tozeroy", 61 | name = "Using Exposure Prior", line = list(color = "purple"), 62 | text = ~paste("Posterior probability of
", 63 | round(fatality$x, 2), 64 | " fatalities is ", 65 | round(fatality$y/fatality$n, 2),sep = ""), 66 | hoverinfo = "text")%>% 67 | add_trace(x = ~fatality2$x, y = ~fatality2$y, type = "scatter", mode = "lines", fill = "tozeroy", 68 | line = list(color = "green"), name = "Using Site Survey Only", 69 | text = ~paste("Posterior probability of
", 70 | round(fatality2$x, 2), 71 | " fatalities is ", 72 | round(fatality2$y, 2), 73 | sep = ""), 74 | hoverinfo = "text")%>% 75 | #add_trace(x = ~c(q80[[1]], q80[[1]], q80[[2]], q80[[2]]), y = ~c(max(fatality2$y/fatality2$n), 0, 0, max(fatality2$y/fatality2$n)), type = "scatter", mode = "lines")%>% 76 | layout(title = "Predicted Annual Eagle Fatalities", 77 | xaxis = list(title = "Fatalities per Year", 78 | range = c(0,10)), 79 | yaxis = list(title = "Probability")) 80 | }) 81 | }) 82 | 83 | output$prior <- renderPlotly({ 84 | plot_ly()%>% 85 | add_trace(x = ~collision$x, y = ~collision$y/collision$n, type = "scatter", mode = "lines", 86 | fill = "tozeroy", name = "Prior", line = list(color = "red"), 87 | text = ~paste("Prior probability of Collision Rate = ", 88 | round(collision$x, 3), 89 | "
is ", 90 | round(collision$y/collision$n, 3), 91 | sep = ""), 92 | hoverinfo = "text")%>% 93 | layout(title = "Prior Collision Rates", 94 | xaxis = list(title = "Collision Rate (per Exposure)"), 95 | yaxis = list(title = "Probability")) 96 | }) 97 | } 98 | -------------------------------------------------------------------------------- /vignettes/disccuss.R: -------------------------------------------------------------------------------- 1 | 2 | # Conclusions 3 | 4 | ### Primary Takeaways 5 | 6 | The use of prior distributions of exposure probability can strongly affect the predicted eagle take at wind energy facilities. Among 26 wind farms, the average difference between 80^th^ percentiles of Bayesian versus site-specific estimates of eagle fatalities was `r round(mean(abs((Bay_16$U_F - Bay_16$U))), 2)` eagles per year (max = `r round(max((Bay_16$U_F - Bay_16$U)), 2)`, s.d. = `r round(sd((Bay_16$U_F - Bay_16$U)), 2)`). Across our range of simulated values for eagle activity rates and survey effort, site-specific and Bayesian fatality estimates differed by as much as `r round(max(abs(sim$U_F - sim$U))*mean(Bay_16$SCALE), 2)` eagles per year. 7 | 8 | The discrepancy between site-specific and Bayesian estimates of predicted fatality increases as the eagle activity observed at a site is more extreme. Controlling for the effect of survey effort, the discrepancy between estimates increases by `r round(src_discrep$SRC[2,1]*sd(rgamma(5000, mean(Bay16$FLIGHT_MIN), mean(Bay16$EFFORT)))/sd(sim$eagle_rate)*sd(sim$U_F - sim$U)*mean(Bay16$SCALE)*-1, 2)` eagles for every standard deviation an observed level of eagle activity falls from the prior mean. 9 | 10 | Survey effort can also change the magnitude of this effect. At the minimum survey effort required by FWS, the difference between site-specific and Bayesian fatality estimates ranged from `r round(min((sim$U_F - sim$U)*mean(Bay_16$SCALE)), 2)` to `r round(max((sim$U_F - sim$U)*mean(Bay_16$SCALE)), 2)` eagles per year. For a site with minimum eagle exposure rates (0.01 min/hrxkm^3^), adding an additional survey hour per month, or survey plot, to the FWS minimum will decrease discrepancy by `r round(((sim$U_F[1] - sim$U[1])-(sim$U_F[2] - sim$U[2])) * mean(Bay16$SCALE), 2)` predicted annual fatalities, on average. 11 | 12 | ### Recommendations 13 | The relationship between deviation of observed exposure rates from the mean of the prior and estimate discrepancy suggest thresholds for trigger points at which FWS may want to consider a different approach to permitting and mitigation, or require additional survey effort. These thresholds should be based on the standardized distance initially observed eagle activity rates at a site are from the mean of the prior distribution. 14 | 15 | Increasing minimum survey effort - either number of plots, or number of hours - will reduce the influence of general priors, increasing confidence in the posterior estimates. This will benefit both wind developers, who can be less skeptical that mitigation requirements are being artificially inflated, and FWS, which can be more confident that Bayesian priors are not underpredicting fatality rates at sites with high eagle activity. 16 | 17 | The addition of covariates to the prior distribution of exposure probabilities may also help alleviate the effect of priors on predictions at sites with extreme observed eagle activity. Rather than integrating site specific values with prior information from all wind projects, they could be integrated with distributions from sites sharing similar characteristics. 18 | 19 | ### Discussion 20 | 21 | An advantage of Bayesian modeling is to moderate the effect of random outlier observations. However, this also means that where surveys accurately detect extreme observed eagle activity, this site-specific information can be effectively washed out. Thus, an important question is when do extreme eagle activity levels observed during surveys accurately reflect site-specific eagle exposure, rather than representing random anomallies. At two of four sites where Bayesian estimates were lower than site-specific estimates, the observed fataility estimate fell outside of the bayesian 80th percentile using priors, but was covered by the 80th percentile of the site-specific estimate. These sites reported 2 of the top 3 eagle exposure rates, and illustrate instances where site-specific information should carry more weight. In both cases, survey effort was in the lower 25% of all sites. 22 | Permits are re-evaluated every 5 years. Thus, the mean observed discrepancy of `r round(mean(abs((Bay_16$UQ_F - Bay_16$UQ))), 0)` fatalities per year could equate to the unexpected take of an additional `r round(mean(abs((Bay_16$UQ_F - Bay_16$UQ)))*5, 0)` eagles before models are updated. FWS advises that if permitted eagle take exceeds 1% of the estimated population size of either species within the LAP area, additional take is a concern. If take exceeds 5% of the estimated population size within the LAP area, additional take is considered inadvisable. Cummulative authorized take must not exceed 5% of local populations. Underestimating eagle take by a few individuals per year over a 5 year permit, could approach these thresholds. The inverse is not ideal from the perspective of regulated entities, as wind developers could pay mitigation costs for an unwarranted 5 additional incidental takes. 23 | 24 | It should be noted that our Bayesian fatality estimates were generated by integrating observed measures of eagle flight time and survey effort with prior defined by the mean of these values across survey sites. Survey effort is used to adjust the rate parameter of the gamma distribution used to define the eagle exposure prior. Thus, increased survey effort leads to a narrower posterior distribution, and smaller 80% CI. In practice, this makes sense, as we have greater confidence that the results of more intensive surveys are reflective of consistent patterns, rather than conditions during a limited number of instances. 25 | -------------------------------------------------------------------------------- /R/POMDP.R: -------------------------------------------------------------------------------- 1 | source('R/helper_fxns.R') 2 | # define probabilities of each state, for us 3 | prob.pres <- rep(c(0.1, 0.5), each = 10) 4 | prob.abs <- 1-prob.pres 5 | 6 | # costs of monitoring (survey) and protection (mitigation) 7 | #mon.cost <- 2 8 | #prot.cost <- 1 9 | 10 | # decision consequences - benefits of actions given possible states 11 | conseq.table <- data.frame('present' = c(1,0), 'absent' = c(0,0)) 12 | rownames(conseq.table) <- c('protect', 'dont protect') 13 | 14 | # the benefit of surveying another hour or mitigating, given potential underlying eagle rates 15 | valueTable <- data.frame('survey' = 0, 16 | 'mitigate' = 1) 17 | 18 | 19 | # expected value of best action under uncertainty 20 | #EQUATION 1 - EXPECTED VALUE OF ACTION "MITIGATE" 21 | ex.val.protect <- prob.pres*conseq.table['protect', 'present']+prob.abs*conseq.table["protect", 'absent'] 22 | # ex.val.protect <- sum(eagleRates*valueTable[1,'mitigate']) 23 | #EQUATION 1 - EXPECTED VALUE OF ACTION "DON'T PROTECT" FOR ALL PARCELS 24 | ex.val.dont<-prob.pres*conseq.table["dont protect","present"]+prob.abs*conseq.table["dont protect","absent"] 25 | # ex.val.dont <- sum(eagleRates*valueTable[1, 'survey']) 26 | 27 | # this is single expected value per action (columns) 28 | ex.val.all.uncert<-cbind(ex.val.protect,ex.val.dont) 29 | 30 | # this is single maximum expected value 31 | ex.val.dec.uncert<-apply(ex.val.all.uncert,1,max) 32 | 33 | ######expected value of best action under certainty 34 | 35 | ex.val.all.cert<-cbind(ex.val.protect,ex.val.dont) 36 | 37 | # sum of all 38 | ex.val.dec.cert<-rowSums(ex.val.all.cert) 39 | #EQUATION 3 - expected value decisions under certainty for all patches (sums best action for all possibilities)- note here it's same as uncertainty 40 | #this is because only the action "protect" can have a positive consequence - the others have zero (so you would do the same thing under certainty or uncertainty) 41 | #so expected value of perfect info in initial scenario would be zero if only considered one patch 42 | #see below for expected value of perfect info, one patch (actual calculation) 43 | ################################################### 44 | 45 | 46 | ################################################### 47 | ######expected value best action after monitoring 48 | 49 | #### 50 | #monitoring accuracy table (confusion matrix) 51 | 52 | mon.acc<-data.frame(c(0.8,0.2),c(0,1)) 53 | #mon.acc<-data.frame(c(0.7,0.3),c(0,1)) #an alternate 54 | rownames(mon.acc)<-c("found","not found") 55 | colnames(mon.acc)<-c("present","absent") #this creates a confusiong matrix of probability found, not found when it's present or absent 56 | #### 57 | 58 | 59 | #updated priors 60 | # P(s|y) = P(y|s)*P(s)/P(y) 61 | #probability present if found (true pos) 62 | p.pres.if.found<-mon.acc["found","present"]*prob.pres/((mon.acc["found","present"]*prob.pres)+(mon.acc["found","absent"]*prob.abs)) 63 | #probability absent if found (false pos) 64 | p.abs.if.found<-1-p.pres.if.found #alternate: mon.acc["found","absent"]*prob.pres/((mon.acc["found","present"]*prob.pres)+(mon.acc["found","absent"]*prob.abs)) 65 | 66 | p.pres.if.notfound<- mon.acc["not found","present"]*prob.pres/((mon.acc["not found","present"]*prob.pres)+(mon.acc["not found","absent"]*prob.abs)) #probability present if NOT found (false neg) 67 | p.abs.if.notfound<- 1-p.pres.if.notfound 68 | 69 | 70 | ex.val.protect.found<-p.pres.if.found*conseq.table["protect","present"]+p.abs.if.found*conseq.table["protect","absent"] 71 | ex.val.dont.found<-p.pres.if.found*conseq.table["don't protect","present"]+p.abs.if.found*conseq.table["don't protect","absent"] 72 | 73 | ex.val.found<-cbind(ex.val.protect.found,ex.val.dont.found) 74 | 75 | ex.val.protect.notfound<-p.pres.if.notfound*conseq.table["protect","present"]+p.abs.if.notfound*conseq.table["protect","absent"] 76 | ex.val.dont.notfound<-p.pres.if.notfound*conseq.table["don't protect","present"]+p.abs.if.notfound*conseq.table["don't protect","absent"] 77 | 78 | ex.val.notfound<-cbind(ex.val.protect.notfound,ex.val.dont.notfound) 79 | 80 | ### 81 | #outcome after survey 82 | 83 | #prob of survey results 84 | # sum of probability of outcomes across all possible states 85 | prob.found<-(mon.acc["found","present"]*prob.pres)+(mon.acc["found","absent"]*prob.abs) #probability you find the species in each patch 86 | prob.not.found<- 1-prob.found #alternate: (mon.acc["not found","present"]*prob.pres)+(mon.acc["not found","absent"]*prob.abs) 87 | 88 | 89 | optimal.outcome.found<-apply(ex.val.found, 1, max) #optimal outcomes if it's found 90 | optimal.outcome.notfound<-apply(ex.val.notfound, 1, max) #optimal outcomes if it's NOT found 91 | 92 | expected.val.dec.after.mon<- optimal.outcome.found*prob.found + optimal.outcome.notfound*prob.not.found #EQUATION 5 - expected value of decisions after monitoring 93 | ################################################### 94 | 95 | 96 | ################################################### 97 | #expected values of perfect info and monitoring info - one patch only 98 | exp.val.perfect.info<- ex.val.dec.cert - ex.val.dec.uncert #EQUATION 4 - expected value perfect information if you were dealing with patches individually (or you had budget to protect all) 99 | exp.val.mon.info<- expected.val.dec.after.mon - ex.val.dec.uncert #EQUATION 6 - expected value monitoring information if you were dealing with patches individually (or you had budget to protect all) 100 | ################################################### 101 | 102 | ################################################### 103 | #summarized individual values among all patches 104 | 105 | summarized.indiv.values<-as.data.frame(cbind(prob.pres,ex.val.found,ex.val.notfound,prob.found,prob.not.found,optimal.outcome.found,optimal.outcome.notfound,expected.val.dec.after.mon)) ## 106 | ################################################### 107 | 108 | 109 | ################################################### 110 | #aggregated values 111 | summ.agg<-aggregate(summarized.indiv.values, list(summarized.indiv.values$prob.pres), FUN = "mean") 112 | ################################################### 113 | -------------------------------------------------------------------------------- /inst/eagles-fws/helper_fxns.R: -------------------------------------------------------------------------------- 1 | ##NOTE 2 | ## for Gamma dist a = (u/sd)2, b = (u/sd2) 3 | ## FWS priors are mean eagle min/hr*km2 for exposure 4 | ## birds / min 5 | 6 | #' convert number of turbines to project 'size' 7 | #' 8 | #' this function assumes 200m tall turbines with 80m rotors 9 | #' 10 | #' @param n number of turbines 11 | #' @return size (km3) 12 | turbines_to_size <- function(n){ 13 | size = n*3650*(0.2)*(0.08^2)*pi 14 | return(size) 15 | } 16 | 17 | #' Calculate cost for eagle mitigation 18 | #' 19 | #' @param cost per pole cost 20 | #' @param duration retrofit longevity 21 | #' @param adult boolean indication of adult or juvenille eagle 22 | #' @param electrocution assumed per/pole electrocution rate 23 | #' @return estimated cost (numeric) 24 | retrofit_cost <- function(cost, duration = 20, adult = TRUE, electrocution){ 25 | age <- ifelse(isTRUE(adult), 10, 2) 26 | future_yrs <- 30 - age 27 | n_poles <- future_yrs/0.0051*duration 28 | total <- n_poles*cost 29 | return(total) 30 | } 31 | 32 | prediction <- function(iters, aExp, bExp, aCPr, bCPr){ 33 | out <- data.frame(collision = rep(NA,iters), 34 | expose = rep(NA, iters), 35 | fatality = rep(NA, iters) 36 | ) 37 | for(n in 1:iters){ 38 | out[n,] <- simFatal(BMin=-1, Fatal=-1, SmpHrKm, ExpFac, aPriExp=1, 39 | bPriExp=1,aPriCPr=1, bPriCPr=1) 40 | #c <- rbeta(1, shape1 = 9.28, shape2 = 3224.51) 41 | #e <- rgamma(1, shape = alpha, rate = beta) 42 | #f <- c*e 43 | #out[n,] <- c(c,e,f) 44 | } 45 | return(out) 46 | } 47 | 48 | vir_col <- function(n){ 49 | return (substr(viridis(n),1,7)) 50 | } 51 | 52 | #' 53 | #' @param BMin observed number of bird minutes 54 | #' @param Fatal annual avian fatalities on an operational wind facility 55 | #' @param SmpHrKm total time and area surveyed for bird minutes 56 | #' @param ExpFac expansion factor 57 | #' @param aPriExp alpha parameter for the prior on lambda 58 | #' @param bPriExp beta parameter for the prior on lambda 59 | #' @param aPriCPr alpha parameter for the prior on C 60 | #' @param bPriCPr beta parameter for the prior on C 61 | #' 62 | #' The default of a negative value for BMin or Fatal indicates that no data were collected for those model inputs 63 | #' 64 | #' @require rv 65 | #' @return data frame with random draws for collision rate, exposure and predicted fatalities 66 | #' for each iteration 67 | simFatal <- function(BMin=-1, Fatal=-1, SmpHrKm, ExpFac = 1, aPriExp=1, 68 | bPriExp=1,aPriCPr=1, bPriCPr=1, iters){ 69 | out <- data.frame(collision = rep(NA,iters), 70 | expose = rep(NA, iters), 71 | fatality = rep(NA, iters) 72 | ) 73 | 74 | 75 | # Update the exposure prior 76 | if(BMin>=0){ 77 | aPostExp <- aPriExp + BMin 78 | bPostExp <- bPriExp + SmpHrKm 79 | }else{ 80 | aPostExp <- aPriExp 81 | bPostExp <- bPriExp} 82 | # Update the collisions prior 83 | if(Fatal>=0){ 84 | aPostCPr <- aPriCPr + Fatal 85 | bPostCPr <- ((rvmean(Exp) * ExpFac) - Fatal) + bPriCPr 86 | }else{ 87 | aPostCPr <- aPriCPr 88 | bPostCPr <- bPriCPr} 89 | 90 | for(i in 1:iters){ 91 | Exp <- rgamma(n=1, aPostExp, bPostExp) 92 | CPr <- rbeta(n=1, aPostCPr, bPostCPr) 93 | Fatalities <- ExpFac * Exp * CPr 94 | out[i,] <- c(CPr, Exp, Fatalities) 95 | } 96 | 97 | #attr(Fatalities,"Exp") <- c(Mean=rvmean(Exp), SD=rvsd(Exp)) 98 | #attr(Fatalities,"CPr") <- c(Mean=rvmean(CPr), SD=rvsd(CPr)) 99 | return(out) 100 | } 101 | 102 | 103 | #' calculate mean and 80% CI estimates from a predicted fatality distribution 104 | #' 105 | #' This function is hardwired to use updated golden eagle priors 106 | #' 107 | #' @param niters number of iterations 108 | #' @param a observed eagle minutes 109 | #' @param b survey effort (hr*km3) 110 | #' @return named vector with mean and 80th percentile estimates calcualted with 111 | #' and without eagle exposure priors 112 | #' 113 | estimates <- function(niters, a, b){ 114 | out <- simFatal(BMin = a, 115 | Fatal = -1, 116 | SmpHrKm = b, 117 | ExpFac = mean(Bay16$SCALE), 118 | aPriExp = 11.81641, 119 | bPriExp = 9.7656250, 120 | aPriCPr = 1.638029, 121 | bPriCPr = 290.0193, 122 | iters = 10000) 123 | fatality <- mean(out$fatality) 124 | q80 <- quantile(out$fatality, c(0.8)) 125 | out2 <- simFatal(BMin = a, 126 | Fatal = -1, 127 | SmpHrKm = b, 128 | ExpFac = mean(Bay16$SCALE), 129 | aPriExp = 0, 130 | bPriExp = 0, 131 | aPriCPr = 1.638029, 132 | bPriCPr = 290.0193, 133 | iters = 10000) 134 | fatality2 <- mean(out2$fatality) 135 | q82 <- quantile(out2$fatality, 0.8) 136 | return (c("MN_F" = fatality, "U_F" = q80, "MN" = fatality2, "U" = q82)) 137 | } 138 | 139 | #' Calculate total mitigation and monitoring costs 140 | #' 141 | #' @description This function calculates the...the first argument is effort because this is what will be optimized over 142 | #' @param effort survey effort (hrs*km3). Will be optimized when used with optimize() 143 | #' @param data data frame with columns 'a', 'size' 'mcost' and 'acost.' These columns must containe 144 | #' contain eagle activity rate, project size, per eagle mitigation cost, and hourly survey cost respectively 145 | #' 146 | #' @return total cost of mitigation and monitoring (numeric) 147 | cost_fxn <- function(effort, data){ 148 | with(data, { 149 | activity <- a*effort 150 | #activity <- 1 151 | #size <- 10 152 | aExp <- 11.81641 153 | bExp <- 9.765626 154 | aCPr <- 1.638 155 | bCPr <- 290.0193 156 | #Read in effort values (hrs*km3) 157 | #Do we need to use rv here? 158 | EXP <- rvgamma(1, aExp + activity, bExp + effort) 159 | COL <- rvbeta(1, aCPr, bCPr) 160 | Fatal <- EXP * COL * size 161 | M <- rvquantile(Fatal, 0.8) * mrate#38000 162 | S <- effort * srate#167 163 | total_cost <- M+S 164 | return(total_cost) 165 | }) 166 | } 167 | 168 | #' Calculate mitigation, monitoring, and total costs 169 | #' 170 | #' @param effort survey effort (hr*km3) 171 | #' @param a eagle activity rate (eagle min/hr) 172 | #' @param size project size in number of turbines 173 | #' @param mcost cost of mitigation for 1 eagle take 174 | #' @param scost hourly cost of pre-construction monitoring 175 | #' 176 | #' @return data.frame with eagles('E'), total ('T'), mitigation ('M'), survey ('S') costs 177 | cost <- function(effort, a, size, mrate, srate){ 178 | activity <- a*effort 179 | #activity <- 1 180 | #size <- 10 181 | aExp <- 11.81641 182 | bExp <- 9.765626 183 | aCPr <- 1.638 184 | bCPr <- 290.0193 185 | #Read in effort values (hrs*km3) 186 | EXP <- rvgamma(1, aExp + activity, bExp + effort) 187 | COL <- rvbeta(1, aCPr, bCPr) 188 | Fatal <- EXP * COL * size 189 | E <- rvquantile(Fatal, 0.8) 190 | M <- E * mrate#38000 191 | S <- effort * srate#167 192 | total_cost <- M+S 193 | 194 | return(list('T' = total_cost[1,], 'M' = M[1,], 'S' = S, 'E' = E)) 195 | #if (return == 'T'){ 196 | # return(total_cost[1,]) 197 | #}else if (return == "M"){ 198 | # return(M[1,]) 199 | #}else if (return == "S"){ 200 | # return(S) 201 | #} 202 | } 203 | 204 | #' Generate total, mitigation, and survey costs over a range of efforts 205 | #' @return data frame wih columns x, T, M, S 206 | cost_curve <- function(effort, erate, size, mrate, srate){ 207 | output <- cost(effort, erate, size, mrate, srate) 208 | return(data.frame(T = output['T'], M = output['M'], S = output['S'], E = output['E'])) 209 | } 210 | 211 | 212 | #' Find effort that equates to minimum cost 213 | #' 214 | #' @description identifies the amount of effort that minimized the total costs associated with 215 | #' mitigation and monitoring for a given eagle activity rate, project size, and assumed 216 | #' per eagle mitigation costs and hourly survey costs. 217 | #' @param 218 | optim_fxn <- function(erate, size, mrate, srate){ 219 | opt <-optimize(cost_fxn, interval = c(0, 500), data = data.frame(a = erate, size = size, mrate = mrate, srate = srate), tol = 0.00000001) 220 | return(data.frame(effort = opt$minimum, cost = opt$objective)) 221 | } 222 | 223 | #Alternatively we use 'curve' and 'cost' to generate points, fit a line, 224 | # then find minimum 225 | min_cost <- function(erate, size, mrate, srate){ 226 | crv <- curve(cost(x, erate, size, mrate, srate)$T, 227 | from = 0, to = 500) 228 | 229 | lo <- loess(crv$y ~ crv$x, span = 0.2) 230 | smoothed <- predict(lo, x = crv$x) 231 | 232 | min_effort <- crv$x[smoothed == min(smoothed)] 233 | 234 | return(data.frame(cost = min(smoothed), effort = min_effort)) 235 | } 236 | -------------------------------------------------------------------------------- /R/fitdist.R: -------------------------------------------------------------------------------- 1 | library(fitdistrplus) 2 | test <- data.frame() 3 | subset <- high_high[high_high$size == min(high_high$size),] 4 | 5 | # TODO: use TryCatch on fitdist functions 6 | optim_fitdist <- function(effort, size, erate){ 7 | fatalities <- simFatal(SmpHrKm = effort, 8 | ExpFac = size, 9 | aPriExp = expose$shape + (erate*effort), 10 | bPriExp = expose$rate + effort, 11 | aPriCPr = collide$shape, 12 | bPriCPr = collide$rate, 13 | iters = 2000) 14 | # out <- quantile(fatalities$fatality, 0.8) 15 | # scale the fatalities between 0 and 1 16 | scaled <- (fatalities$fatality - min(fatalities$fatality) + 0.00001)/(max(fatalities$fatality) - min(fatalities$fatality) + 0.00002) 17 | # find the best distribution fitting the posterior 18 | aics <- c('weibull' = 5000, 'gamma' = 5000, 'beta' = 5000) 19 | try({ 20 | weib_dist <- fitdist(scaled, 'weibull') 21 | aics[1] <- weib_dist$aic 22 | }) 23 | try({ 24 | gamma_dist <- fitdist(scaled, 'gamma') 25 | aics[2] <- gamma_dist$aic 26 | }) 27 | try({ 28 | beta_dist <- fitdist(scaled, 'beta') 29 | aics[3] <- beta_dist$aic 30 | }) 31 | 32 | minaic <- names(aics)[aics == min(aics)] 33 | stat <- switch(minaic, 34 | 'weibull' = qweibull(0.8, weib_dist$estimate[1], weib_dist$estimate[2]), 35 | 'beta' = qbeta(0.8, beta_dist$estimate[1], beta_dist$estimate[2]), 36 | 'gamma' = qgamma(0.8, gamma_dist$estimate[1], gamma_dist$estimate[2])) 37 | out <- stat*(max(fatalities$fatality) - min(fatalities$fatality)) + min(fatalities$fatality) 38 | return(out) 39 | } 40 | 41 | wrapper <- function(erate, size, mrate, srate){ 42 | effort <- seq(0,500,5) 43 | vector <- vapply(effort, function(x){return(optim_fitdist(x, size, erate))}, FUN.VALUE = double(1)) 44 | cost <- (mrate*vector) + (srate*effort) 45 | maxEagle <- max(vector) 46 | minEagle <- min(vector) 47 | maxEffort <- min(effort[vector >= maxEagle-0.1]) 48 | minEffort <- min(effort[vector <= minEagle+0.1]) 49 | return(data.frame(maxEagle = maxEagle, 50 | minEagle = minEagle, 51 | maxEagleEffort = maxEffort, 52 | minEagleEffort = minEffort, 53 | minCost = min(cost), 54 | maxCost = max(cost), 55 | minCostEffort = effort[cost == min(cost)], 56 | maxCostEffort = effort[cost == max(cost)])) 57 | } 58 | 59 | # This analysis was run in a COlab notebook to free up memory. 60 | # Because of stochasticity at high eagle rates, we ran scenarios with erate >1.7 x3 61 | high_high <- mutate(test_values, retro_cost[retro_cost$Cost == 'High', 'M'], srate = survey_costs$High) 62 | high_high <- high_high <- read.csv(file = 'data/output500.csv', header = TRUE, stringsAsFactors = FALSE)%>% 63 | bind_rows(read.csv(file = 'data/output3.csv', header = TRUE, stringsAsFactors = FALSE))%>% 64 | bind_rows(read.csv(file = 'data/output1500.csv', header = TRUE, stringsAsFactors = FALSE)) 65 | 66 | high_high <- mutate(high_high, 67 | maxEagleMitigation = mrate*maxEagle, 68 | maxEagleSurvey = maxEagleEffort *srate, 69 | maxEagleCost = maxEagleMitigation + maxEagleSurvey) 70 | 71 | # identify scenarios for which a) min cost is less than max eagle and b) cost of surveying 72 | # to minimum is greater than mitigating for 1.75 73 | high_high <- mutate(high_high, 74 | surveyCostDiff = ((minCostEffort -maxEagleEffort)*srate), 75 | indicator = ifelse(minCost > maxEagleMitigation, 2, ifelse(surveyCostDiff > 0, 1, 0))) 76 | 77 | plot_ly( 78 | data = high_high, 79 | type = 'scatter', 80 | mode = 'markers', 81 | x = ~erate, 82 | y = ~ maxEagleEffort - minCostEffort, 83 | color = ~ size 84 | ) 85 | 86 | fig4a <- plot_ly( 87 | type = 'heatmap', 88 | # z = acast(mutate(high_high, diff = ifelse(minCostEffort == 0, maxEagleMitigation - (minEagle*mrate), (maxEagleMitigation - (minEagle*mrate))*-1)), erate~size, value.var = 'diff'), 89 | z = acast(mutate(high_high, diff = (minCostEffort*srate)- maxEagleSurvey), erate~size, value.var = 'diff'), 90 | # z = acast(mutate(high_high, diff = ifelse(minCostEffort == 0, maxEagleCost - minCost, (maxEagleCost - minCost)*-1)), erate~size, value.var = "diff"), 91 | y = seq(0,2,0.05), 92 | x = seq(20,500,20), 93 | # zmin = -400000, zmax = 400000, 94 | zmin = -500000, zmax = 500000, 95 | colors = colorRamp(c('black', 'white')) 96 | # autocontour = F, 97 | # contours = list( 98 | # end = 0, 99 | # start = 0, 100 | # size = 1), 101 | # line = list(smoothing = 0.5, color = 'white', width = 2), 102 | # showlegend = FALSE 103 | )%>% 104 | colorbar(title = 'Cost
difference
(USD)', 105 | titlefont = list(family = 'serif', color = 'black', size = 14), 106 | tickfont = list(family = 'serif', color = 'black', size = 12), 107 | tick0 = -400000, 108 | dtick = 200000)%>% 109 | layout( 110 | yaxis = append(list(title = 'Eagle activity rate (min/hr*km3)'), ax), 111 | xaxis = append(list(title = 'Project size (# turbines)'), ax) 112 | ) 113 | 114 | fig4b <- plot_ly( 115 | type = 'heatmap', 116 | z = acast(mutate(high_high, diff = ifelse(minCostEffort == 0, maxEagle-minEagle, (maxEagle - minEagle)*-1)), erate~size, value.var = "diff"), 117 | y = seq(0,2,0.05), 118 | x = seq(20,500,20), 119 | zmin = -15, zmax = 15, 120 | colors = colorRamp(c('black', 'white')) 121 | # autocontour = F, 122 | # contours = list( 123 | # end = 1, 124 | # start = -1, 125 | # size = 1), 126 | # line = list(smoothing = 1, color = 'white', width = 2), 127 | # showlegend = FALSE 128 | )%>% 129 | # add_trace(type = 'contour', 130 | # y = seq(0,2,0.05), 131 | # x = seq(20,500,20), 132 | # z = acast(high_high, erate~size, value.var = 'indicator'), 133 | # autocontour = F, 134 | # contours = list( 135 | # end = 2, 136 | # start = 0, 137 | # size = 1 138 | # ), 139 | # line = list( 140 | # smoothing = 0.5,color = 'white', 141 | # width = 2), 142 | # colorscale = list(list(0, '#00FFFFFF'), list(0.5,'#00FFFFFF'), list(1,'#00FFFFFF')), 143 | # showscale = FALSE, 144 | # showlegend = FALSE)%>% 145 | colorbar(title = 'Eagles', 146 | titlefont = list(family = 'serif', color = 'black', size = 14), 147 | tickfont = list(family = 'serif', color = 'black', size = 12), 148 | tick0 = -15, 149 | dtick = 5)%>% 150 | layout( 151 | yaxis = append(list(title = 'Eagle activity rate (min/hr*km3)'), ax), 152 | xaxis = append(list(title = 'Project size (# turbines)'), ax) 153 | ) 154 | 155 | test <- simFatal(SmpHrKm = 500, ExpFac = 100*expFac, aPriExp = expose$shape + (2.5*500), bPriExp = expose$rate + 500, aPriCPr = collide$shape, bPriCPr = expose$rate, iters = 1000) 156 | scaled <- (test$fatality - min(test$fatality) + 0.00001)/(max(test$fatality) - min(test$fatality) + 0.00002) 157 | descdist(scaled, discrete = FALSE) 158 | beta_dist <- fitdist(scaled, 'beta') 159 | weib_dist <- fitdist(scaled, 'weibull') 160 | gamma_dist <- fitdist(scaled, 'gamma') 161 | plot(weib_dist) 162 | 163 | cost <- function(effort, erate, size, mrate, srate){ 164 | activity <- erate*effort 165 | #activity <- 1 166 | #size <- 10 167 | aExp <- expose$shape 168 | bExp <- expose$rate 169 | aCPr <- collide$shape 170 | bCPr <- collide$rate 171 | #Read in effort values (hrs*km3) 172 | EXP <- rvgamma(1, aExp + activity, bExp + effort) 173 | COL <- rvbeta(1, aCPr, bCPr) 174 | Fatal <- EXP * COL * size 175 | weib_dist <- fitdist(sims(Fatal)[,1], 'weibull') 176 | # the quantile of simulated fatalities is subject to a lot of noise, so use a distribution 177 | # E <- rvquantile(Fatal, 0.8) 178 | E <- qweibull(0.8, shape = weib_dist$estimate[1], scale = weib_dist$estimate[2]) 179 | M <- E * mrate#38000 180 | S <- effort * srate#167 181 | total_cost <- M+S 182 | 183 | return(list('T' = total_cost, 'M' = M, 'S' = S, 'E' = E)) 184 | #if (return == 'T'){ 185 | # return(total_cost[1,]) 186 | #}else if (return == "M"){ 187 | # return(M[1,]) 188 | #}else if (return == "S"){ 189 | # return(S) 190 | #} 191 | } 192 | 193 | cost_fxn <- function(effort, data){ 194 | with(data, { 195 | costs <- cost(effort, erate, size, mrate, srate) 196 | return(costs$T) 197 | }) 198 | } 199 | 200 | eagle_fxn <- function(effort, data){ 201 | with(data, { 202 | costs <- cost(effort, erate, size, mrate, srate) 203 | return(costs$E) 204 | }) 205 | } 206 | 207 | optim_fxn <- function(erate, size, mrate, srate){ 208 | dat <- data.frame(erate = erate, size = size, mrate = mrate, srate = srate) 209 | eagles <- optimize(eagle_fxn, 210 | interval = c(0,200), 211 | data = dat, 212 | maximum = TRUE) 213 | costs <- optimize(cost_fxn, 214 | interval = c(0,200), 215 | data = dat, 216 | maximum = FALSE) 217 | return(data.frame(minEffort = costs$minimum, 218 | minCost = costs$objective, 219 | maxEffort = eagles$maximum, 220 | maxEagles = eagles$objective)) 221 | } 222 | 223 | -------------------------------------------------------------------------------- /inst/eagles-fws/eaglesFWS_flex.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "FWS Eagle Mortality Model" 3 | author: "Michael Evans, Defenders of Wildlife" 4 | output: 5 | flexdashboard::flex_dashboard: 6 | css: custom.css 7 | social: menu 8 | df_print: paged 9 | navbar: 10 | - {title: "CCI", align: left, href: "https://cci-dev.org"} 11 | - {title: "Defenders", align: left, href: "http://www.defenders.org"} 12 | - {title: "", icon: "fa-question-circle fa-lg", align: right, href: "mailto:esa@defenders.org?subject=Five-year reviews app"} 13 | - {title: "", icon: "fa-github fa-lg", align: right, href: "https://github.com/Defenders-ESC/"} 14 | runtime: shiny 15 | --- 16 | 17 | ```{r setup, include=FALSE} 18 | knitr::opts_chunk$set(echo = FALSE) 19 | 20 | library(dplyr) 21 | library(DT) 22 | library(flexdashboard) 23 | library(ggplot2) 24 | library(plotly) 25 | library(shiny) 26 | library(viridis) 27 | 28 | load("app_data.RData") 29 | source("helper_fxns.R") 30 | #source("exposure.R") 31 | #source("fatality.R") 32 | 33 | prior <- curve(dgamma(x, shape = 11.81641, 34 | rate = 9.765625), 35 | from = 0.5, 36 | to = 3) 37 | 38 | collision <- curve(dbeta(x, shape1 = 1.638029, shape2 = 290.0193), 39 | from = 0, 40 | to = 0.04) 41 | 42 | act <- mean(Bay16$FLIGHT_MIN)/mean(Bay16$EFFORT) 43 | 44 | scale <- glm(data = Bay16, (COLLISIONS/(FLIGHT_MIN/EFFORT))/0.002895415 ~ RISK_HA + I(RISK_HA^2)) 45 | ``` 46 | 47 | Inputs {.sidebar} 48 | ----------------------------------------------------------------------- 49 | The [U.S. Fish and Wildlife Service](https://www.fws.gov/) 50 | uses a Bayesian model to estimate the number of eagles likely to be killed by proposed wind projects. 51 | This approach combines prior information about eagle collision and activity rates across existing wind farms, with surveys of eagle activity at proposed sites to estimate the likely number of fatalities. 52 | 53 | This dashboard allows you to explore how priors interact with survey data to produce predicted eagle fatalities at a set of wind energy sites. 54 | 55 | ```{r selector, echo = FALSE} 56 | selectInput("sites", 57 | "Choose a Site", 58 | choices = c("", levels(Bay16$SITE)), 59 | selected = "Combine Hills, Oregon") 60 | 61 | cur_min <- reactive({Bay16$FLIGHT_MIN[Bay16$SITE == input$sites]}) 62 | 63 | cur_effort <- reactive({Bay16$EFFORT[Bay16$SITE == input$sites]}) 64 | 65 | cur_scale <- reactive({Bay16$SCALE[Bay16$SITE == input$sites]}) 66 | 67 | a <- reactive({11.81641 + cur_min()}) 68 | b <- reactive({9.765625 + cur_effort()}) 69 | ``` 70 | 71 | 72 | ```{r update, echo = FALSE} 73 | actionButton("update", "Update Distributions") 74 | ``` 75 | 76 | `r hr()` 77 | 78 | ```{r calculate, echo = FALSE} 79 | actionButton("calculate", "Calculate Fatalities") 80 | 81 | ``` 82 | 83 | `r hr()` 84 | 85 | ```{r note, echo = FALSE} 86 | helpText("Note: Calcuating predicted fatality distributions takes time. Please allow several seconds for the graph to load.") 87 | ``` 88 | 89 | Column {data-width = 500} 90 | -------------------------------------------------------------------------- 91 | 92 | ### Prior Probabilities of Eagle Collision Rates 93 | 94 | ```{r collisions, echo = FALSE} 95 | renderPlotly({ 96 | plot_ly()%>% 97 | add_trace(x = ~collision$x, y = ~collision$y, type = "scatter", mode = "lines", 98 | fill = "tozeroy", name = "Prior", line = list(color = "grey"), 99 | text = ~paste("Prior probability of Collision Rate = ", 100 | round(collision$x, 3), 101 | "
is ", 102 | round(collision$y, 3), 103 | sep = ""), 104 | hoverinfo = "text")%>% 105 | layout(#title = "Prior Collision Rates", 106 | xaxis = list(title = "Collision Rate (per Exposure)", 107 | range = 0, 0.01), 108 | yaxis = list(title = "Probability Density")) 109 | }) 110 | 111 | #ggplot(Bay16, aes(x = EFFORT, y = OBS_MIN))+ 112 | # geom_point() 113 | #renderPlotly({ 114 | #ggplotly() 115 | #}) 116 | ``` 117 | 118 | ### Eagle Activity (_Click 'Update Distributions'_) 119 | 120 | ```{r exposures, echo = FALSE} 121 | observeEvent(input$update, { 122 | act <- isolate({cur_min()/cur_effort()}) 123 | obs <- isolate({density(rgamma(10000, 124 | shape = a(), 125 | rate = b() 126 | ) 127 | ) 128 | }) 129 | 130 | output$exposure <- renderPlotly({ 131 | plot_ly()%>% 132 | add_trace(x = ~c(act, act), y = ~c(0,max(c(prior$y,obs$y))), 133 | type = "scatter", mode = "lines", 134 | name = "Observed", line = list(color = vir_col(3)[2]), 135 | text = ~paste("Observed Activity
at site = ", 136 | round(act,2), 137 | sep = ""), 138 | hoverinfo = "text")%>% 139 | add_trace(x = prior$x, y = prior$y, 140 | type = "scatter", mode = "lines", fill = "tozeroy", 141 | name = "Prior", line = list(color = vir_col(3)[1]), 142 | text = ~paste("Prior Activity
estimate = ", 143 | round(prior$x, 2), 144 | sep = ""), 145 | hoverinfo = "text")%>% 146 | add_trace(x = ~obs$x, y = ~obs$y, 147 | type = "scatter", mode = "lines", fill = "tozeroy", 148 | name = "Combined", line = list(color = vir_col(3)[3]), 149 | text = ~paste("Combined Activity
estimate = ", 150 | round(obs$x, 2), 151 | sep = ""), 152 | hoverinfo = "text")%>% 153 | layout(#title = "Eagle Exposure", 154 | xaxis = list(title = "Eagle Activity (min/km3*hr)", 155 | range = c(0,3)), 156 | yaxis = list(title = "Probability Density")) 157 | }) 158 | 159 | }) 160 | 161 | plotlyOutput("exposure") 162 | ``` 163 | 164 | > Activity is the number of minutes eagles are observed flying within survey areas, per hour. 165 | 166 | ### Predicted Fatalities (_Click 'Predict Fatalities'_) 167 | 168 | ```{r fatalities, echo = FALSE} 169 | observeEvent(input$calculate,{ 170 | if(input$sites != ""){ 171 | out <- isolate({prediction(10000, a(), b())}) 172 | fatality <- isolate({density(out$fatality*cur_scale())}) 173 | q80 <- isolate({quantile(out$fatality, c(0.1, 0.9))}) 174 | 175 | out2 <- isolate({prediction(10000, a()-mean(Bay16$FLIGHT_MIN), 176 | b()-mean(Bay16$EFFORT))}) 177 | fatality2 <- isolate({density(out2$fatality*cur_scale())}) 178 | q82 <- isolate({quantile(out2$fatality, c(0.1, 0.9))}) 179 | 180 | output$fatality <- renderPlotly({ 181 | plot_ly()%>% 182 | add_trace(x = ~fatality$x, y = ~fatality$y, type = "scatter", mode = "lines", 183 | fill = "tozeroy", 184 | name = "Incl. Prior Exposure", line = list(color = vir_col(3)[3]), 185 | text = ~paste("Predicted fatalities
incorporating prior = ", 186 | round(fatality$x, 2), 187 | sep = ""), 188 | hoverinfo = "text")%>% 189 | add_trace(x = ~fatality2$x, y = ~fatality2$y, type = "scatter", 190 | mode = "lines", 191 | fill = "tozeroy", 192 | line = list(color = vir_col(3)[2]), 193 | name = "Using Site Survey Only", 194 | text = ~paste("Predicted fatalities
from site survey = ", 195 | round(fatality2$x, 2), 196 | sep = ""), 197 | hoverinfo = "text")%>% 198 | layout(##title = "Predicted Annual Eagle Fatalities", 199 | xaxis = list(title = "Fatalities per Year", 200 | range = c(0,20)), 201 | yaxis = list(title = "Probability Density"), 202 | legend = list(x = 0.7, 203 | y = 1)) 204 | }) 205 | } 206 | }) 207 | plotlyOutput('fatality') 208 | ``` 209 | 210 | Column {data-width=500} 211 | ------------------------------------------------------------------------- 212 | 213 | ### Survey Data 214 | 215 | ```{r datatable, echo = FALSE} 216 | tab <- select(Bay16, 217 | SITE, TURBINES, 218 | EFFORT, FLIGHT_MIN) 219 | DT::renderDataTable({ 220 | dt <- DT::datatable(tab, 221 | fillContainer = TRUE, 222 | selection = list(mode = 'single', 223 | selected = which(Bay16$SITE == input$sites), 224 | target = 'row'), 225 | colnames = c("Site", "Turbines", "Survey Effort (hr*km3)", 226 | "Eagle Obs (min)"), 227 | options = list(rownames = FALSE, 228 | pageLength = nrow(tab), 229 | dom = 'tip' 230 | ) 231 | )%>% 232 | formatRound("EFFORT", 2) 233 | }) 234 | ``` 235 | 236 | > Data taken from Appendix S1 in [Bay et al. (2016). The Journal of Wildlife Management 80(6): 1000-1010](http://onlinelibrary.wiley.com/doi/10.1002/jwmg.21086/full). 237 | -------------------------------------------------------------------------------- /inst/eagles-fws/R/helper_fxns.R: -------------------------------------------------------------------------------- 1 | ##NOTE 2 | ## for Gamma dist a = (u/sd)2, b = (u/sd2) 3 | ## FWS priors are mean eagle min/hr*km2 for exposure 4 | ## birds / min 5 | 6 | 7 | 8 | # CRM priors taken from New et al (2018) https://www.fws.gov/migratorybirds/pdf/management/crmpriorsreport2018.pdf 9 | baldExposure <- list('shape' = 0.077, 'rate' = 0.024) 10 | baldCollision <- list('shape' = 1.61, 'rate' = 228.2) 11 | goldExposure <- list('shape' = 0.287, 'rate' = 0.237) 12 | goldCollision <- list('shape' = 1.29, 'rate' = 227.6) 13 | 14 | # CRM priors provided by E. Bjerre 4/10/20 15 | expose <- list('shape' = 0.968, 'rate' = 0.552) 16 | collide <- list('shape' = 2.31, 'rate' = 396.69) 17 | 18 | #Site expansion factor assuming 200m tall turbines w/80m rotors operating 10hrs/day 19 | expFac <- 3650*(0.2)*(0.08^2)*pi 20 | #' convert number of turbines to project 'size' 21 | #' 22 | #' this function assumes 200m tall turbines with 80m rotors 23 | #' 24 | #' @param n number of turbines 25 | #' @return size (km3) 26 | turbines_to_size <- function(n){ 27 | size = n*3650*(0.2)*(0.08^2)*pi 28 | return(size) 29 | } 30 | 31 | #' Calculate cost for eagle mitigation 32 | #' 33 | #' @param cost per pole cost 34 | #' @param duration retrofit longevity 35 | #' @param adult boolean indication of adult or juvenille eagle 36 | #' @param electrocution assumed per/pole electrocution rate 37 | #' @return estimated cost (numeric) 38 | retrofit_cost <- function(cost, duration = 20, adult = TRUE, electrocution){ 39 | age <- ifelse(isTRUE(adult), 10, 2) 40 | future_yrs <- 30 - age 41 | n_poles <- future_yrs/0.0051*duration 42 | total <- n_poles*cost 43 | return(total) 44 | } 45 | 46 | 47 | vir_col <- function(n){ 48 | return (substr(viridis(n),1,7)) 49 | } 50 | 51 | #' 52 | #' @param BMin observed number of bird minutes 53 | #' @param Fatal annual avian fatalities on an operational wind facility 54 | #' @param SmpHrKm total time and area surveyed for bird minutes 55 | #' @param ExpFac expansion factor 56 | #' @param aPriExp alpha parameter for the prior on lambda 57 | #' @param bPriExp beta parameter for the prior on lambda 58 | #' @param aPriCPr alpha parameter for the prior on C 59 | #' @param bPriCPr beta parameter for the prior on C 60 | #' 61 | #' The default of a negative value for BMin or Fatal indicates that no data were collected for those model inputs 62 | #' 63 | #' @require rv 64 | #' @return data frame with random draws for collision rate, exposure and predicted fatalities 65 | #' for each iteration 66 | simFatal <- function(BMin=-1, Fatal=-1, SmpHrKm, ExpFac = 1, aPriExp=1, 67 | bPriExp=1,aPriCPr=1, bPriCPr=1, iters){ 68 | out <- data.frame(collision = rep(NA,iters), 69 | expose = rep(NA, iters), 70 | fatality = rep(NA, iters) 71 | ) 72 | 73 | 74 | # Update the exposure prior 75 | if(BMin>=0){ 76 | aPostExp <- aPriExp + BMin 77 | bPostExp <- bPriExp + SmpHrKm 78 | }else{ 79 | aPostExp <- aPriExp 80 | bPostExp <- bPriExp} 81 | # Update the collisions prior 82 | if(Fatal>=0){ 83 | aPostCPr <- aPriCPr + Fatal 84 | bPostCPr <- ((rvmean(Exp) * ExpFac) - Fatal) + bPriCPr 85 | }else{ 86 | aPostCPr <- aPriCPr 87 | bPostCPr <- bPriCPr} 88 | 89 | for(i in 1:iters){ 90 | Exp <- rgamma(n=1, aPostExp, bPostExp) 91 | CPr <- rbeta(n=1, aPostCPr, bPostCPr) 92 | Fatalities <- ExpFac * Exp * CPr 93 | out[i,] <- c(CPr, Exp, Fatalities) 94 | } 95 | 96 | #attr(Fatalities,"Exp") <- c(Mean=rvmean(Exp), SD=rvsd(Exp)) 97 | #attr(Fatalities,"CPr") <- c(Mean=rvmean(CPr), SD=rvsd(CPr)) 98 | return(out) 99 | } 100 | 101 | prediction <- function(iters, aExp, bExp, aCPr, bCPr){ 102 | out <- data.frame(collision = rep(NA,iters), 103 | expose = rep(NA, iters), 104 | fatality = rep(NA, iters) 105 | ) 106 | for(n in 1:iters){ 107 | out[n,] <- simFatal(BMin=-1, Fatal=-1, SmpHrKm, ExpFac, aPriExp=1, 108 | bPriExp=1,aPriCPr=1, bPriCPr=1) 109 | #c <- rbeta(1, shape1 = 9.28, shape2 = 3224.51) 110 | #e <- rgamma(1, shape = alpha, rate = beta) 111 | #f <- c*e 112 | #out[n,] <- c(c,e,f) 113 | } 114 | return(out) 115 | } 116 | 117 | 118 | #' calculate mean and 80% CI estimates from a predicted fatality distribution 119 | #' 120 | #' This function is hardwired to use updated golden eagle priors 121 | #' 122 | #' @param niters number of iterations 123 | #' @param a observed eagle minutes 124 | #' @param b survey effort (hr*km3) 125 | #' @return named vector with mean and 80th percentile estimates calcualted with 126 | #' and without eagle exposure priors 127 | #' 128 | estimates <- function(niters, a, b, nturbines){ 129 | out <- simFatal(BMin = a, 130 | Fatal = -1, 131 | SmpHrKm = b, 132 | ExpFac = turbines_to_size(nturbines), 133 | aPriExp = expose$shape, 134 | bPriExp = expose$rate, 135 | aPriCPr = collide$shape, 136 | bPriCPr = collide$rate, 137 | iters = niters) 138 | fatality <- mean(out$fatality) 139 | q80 <- quantile(out$fatality, c(0.8)) 140 | out2 <- simFatal(BMin = a, 141 | Fatal = -1, 142 | SmpHrKm = b, 143 | ExpFac = turbines_to_size(nturbines), 144 | aPriExp = 0, 145 | bPriExp = 0, 146 | aPriCPr = collide$shape, 147 | bPriCPr = collide$rate, 148 | iters = niters) 149 | fatality2 <- mean(out2$fatality) 150 | q82 <- quantile(out2$fatality, 0.8) 151 | return (c("MN_F" = fatality, "U_F" = q80, "MN" = fatality2, "U" = q82)) 152 | } 153 | 154 | #' Calculate total mitigation and monitoring costs 155 | #' 156 | #' @description This function calculates the...the first argument is effort because this is what will be optimized over 157 | #' @param effort survey effort (hrs*km3). Will be optimized when used with optimize() 158 | #' @param data data frame with columns 'a', 'size' 'mcost' and 'acost.' These columns must containe 159 | #' contain eagle activity rate, project size, per eagle mitigation cost, and hourly survey cost respectively 160 | #' 161 | #' @return total cost of mitigation and monitoring (numeric) 162 | cost_fxn <- function(effort, data){ 163 | with(data, { 164 | activity <- a*effort 165 | #activity <- 1 166 | #size <- 10 167 | aExp <- goldExposure$shape 168 | bExp <- goldExposure$rate 169 | aCPr <- goldCollision$shape 170 | bCPr <- goldCollision$rate 171 | #Read in effort values (hrs*km3) 172 | #Do we need to use rv here? 173 | EXP <- rvgamma(1, aExp + activity, bExp + effort) 174 | COL <- rvbeta(1, aCPr, bCPr) 175 | Fatal <- EXP * COL * size 176 | M <- rvquantile(Fatal, 0.8) * mrate#38000 177 | S <- effort * srate#167 178 | total_cost <- M+S 179 | return(total_cost) 180 | }) 181 | } 182 | 183 | #' Calculate mitigation, monitoring, and total costs 184 | #' 185 | #' @param effort survey effort (hr*km3) 186 | #' @param a eagle activity rate (eagle min/hr) 187 | #' @param size project size in number of turbines 188 | #' @param mcost cost of mitigation for 1 eagle take 189 | #' @param scost hourly cost of pre-construction monitoring 190 | #' 191 | #' @return data.frame with eagles('E'), total ('T'), mitigation ('M'), survey ('S') costs 192 | cost <- function(effort, a, size, mrate, srate){ 193 | activity <- a*effort 194 | #activity <- 1 195 | #size <- 10 196 | aExp <- expose$shape 197 | bExp <- expose$rate 198 | aCPr <- collide$shape 199 | bCPr <- collide$rate 200 | #Read in effort values (hrs*km3) 201 | EXP <- rvgamma(1, aExp + activity, bExp + effort) 202 | COL <- rvbeta(1, aCPr, bCPr) 203 | Fatal <- EXP * COL * size 204 | E <- rvquantile(Fatal, 0.8) 205 | M <- E * mrate#38000 206 | S <- effort * srate#167 207 | total_cost <- M+S 208 | 209 | return(list('T' = total_cost[1,], 'M' = M[1,], 'S' = S, 'E' = E)) 210 | #if (return == 'T'){ 211 | # return(total_cost[1,]) 212 | #}else if (return == "M"){ 213 | # return(M[1,]) 214 | #}else if (return == "S"){ 215 | # return(S) 216 | #} 217 | } 218 | 219 | #' Generate total, mitigation, and survey costs over a range of efforts 220 | #' @return data frame wih columns x, T, M, S 221 | cost_curve <- function(effort, erate, size, mrate, srate){ 222 | output <- cost(effort, erate, size, mrate, srate) 223 | return(data.frame(T = output['T'], M = output['M'], S = output['S'], E = output['E'])) 224 | } 225 | 226 | 227 | #' Find effort that equates to minimum cost 228 | #' 229 | #' @description identifies the amount of effort that minimized the total costs associated with 230 | #' mitigation and monitoring for a given eagle activity rate, project size, and assumed 231 | #' per eagle mitigation costs and hourly survey costs. 232 | #' @param 233 | optim_fxn <- function(erate, size, mrate, srate){ 234 | opt <-optimize(cost_fxn, interval = c(0, 500), data = data.frame(a = erate, size = size, mrate = mrate, srate = srate), tol = 0.00000001) 235 | return(data.frame(effort = opt$minimum, cost = opt$objective)) 236 | } 237 | 238 | #Alternatively we use 'curve' and 'cost' to generate points, fit a line, 239 | # then find minimum 240 | min_cost <- function(erate, size, mrate, srate){ 241 | crv <- curve(cost(x, erate, size, mrate, srate)$T, 242 | from = 0, to = 500) 243 | 244 | lo <- loess(crv$y ~ crv$x, span = 0.2) 245 | smoothed <- predict(lo, x = crv$x) 246 | 247 | min_effort <- crv$x[smoothed == min(smoothed)] 248 | 249 | return(data.frame(cost = min(smoothed), effort = min_effort)) 250 | } 251 | 252 | #' Equation defining relationship between effort and discrepancy 253 | #' 254 | #' @param erate inherent rate of eagle activity 255 | #' @param a shape parameter from exposure prior 256 | #' @param b rate parameter from exposure prior 257 | #' @param w effort 258 | #' @return numeric value 259 | effort_discrepancy_slope <- function(erate, a, b, w){ 260 | (erate*b - a)/(b+w) 261 | } 262 | -------------------------------------------------------------------------------- /vignettes/R/helper_fxns.R: -------------------------------------------------------------------------------- 1 | ##NOTE 2 | ## for Gamma dist a = (u/sd)2, b = (u/sd2) 3 | ## FWS priors are mean eagle min/hr*km2 for exposure 4 | ## birds / min 5 | 6 | 7 | 8 | # CRM priors taken from New et al (2018) https://www.fws.gov/migratorybirds/pdf/management/crmpriorsreport2018.pdf 9 | baldExposure <- list('shape' = 0.077, 'rate' = 0.024) 10 | baldCollision <- list('shape' = 1.61, 'rate' = 228.2) 11 | goldExposure <- list('shape' = 0.287, 'rate' = 0.237) 12 | goldCollision <- list('shape' = 1.29, 'rate' = 227.6) 13 | 14 | # CRM priors provided by E. Bjerre 4/10/20 15 | expose <- list('shape' = 0.968, 'rate' = 0.552) 16 | collide <- list('shape' = 2.31, 'rate' = 396.69) 17 | 18 | #Site expansion factor assuming 200m tall turbines w/80m rotors operating 10hrs/day 19 | expFac <- 3650*(0.2)*(0.08^2)*pi 20 | #' convert number of turbines to project 'size' 21 | #' 22 | #' this function assumes 200m tall turbines with 80m rotors 23 | #' 24 | #' @param n number of turbines 25 | #' @return size (km3) 26 | turbines_to_size <- function(n){ 27 | size = n*3650*(0.2)*(0.08^2)*pi 28 | return(size) 29 | } 30 | 31 | #' Calculate cost for eagle mitigation 32 | #' 33 | #' @param cost per pole cost 34 | #' @param duration retrofit longevity 35 | #' @param adult boolean indication of adult or juvenille eagle 36 | #' @param electrocution assumed per/pole electrocution rate 37 | #' @return estimated cost (numeric) 38 | retrofit_cost <- function(cost, duration = 20, adult = TRUE, electrocution){ 39 | age <- ifelse(isTRUE(adult), 10, 2) 40 | future_yrs <- 30 - age 41 | n_poles <- future_yrs/0.0051*duration 42 | total <- n_poles*cost 43 | return(total) 44 | } 45 | 46 | 47 | vir_col <- function(n){ 48 | return (substr(viridis(n),1,7)) 49 | } 50 | 51 | #' 52 | #' @param BMin observed number of bird minutes 53 | #' @param Fatal annual avian fatalities on an operational wind facility 54 | #' @param SmpHrKm total time and area surveyed for bird minutes 55 | #' @param ExpFac expansion factor 56 | #' @param aPriExp alpha parameter for the prior on lambda 57 | #' @param bPriExp beta parameter for the prior on lambda 58 | #' @param aPriCPr alpha parameter for the prior on C 59 | #' @param bPriCPr beta parameter for the prior on C 60 | #' 61 | #' The default of a negative value for BMin or Fatal indicates that no data were collected for those model inputs 62 | #' 63 | #' @require rv 64 | #' @return data frame with random draws for collision rate, exposure and predicted fatalities 65 | #' for each iteration 66 | simFatal <- function(BMin=-1, Fatal=-1, SmpHrKm, ExpFac = 1, aPriExp=1, 67 | bPriExp=1,aPriCPr=1, bPriCPr=1, iters){ 68 | out <- data.frame(collision = rep(NA,iters), 69 | expose = rep(NA, iters), 70 | fatality = rep(NA, iters) 71 | ) 72 | 73 | 74 | # Update the exposure prior 75 | if(BMin>=0){ 76 | aPostExp <- aPriExp + BMin 77 | bPostExp <- bPriExp + SmpHrKm 78 | }else{ 79 | aPostExp <- aPriExp 80 | bPostExp <- bPriExp} 81 | # Update the collisions prior 82 | if(Fatal>=0){ 83 | aPostCPr <- aPriCPr + Fatal 84 | bPostCPr <- ((rvmean(Exp) * ExpFac) - Fatal) + bPriCPr 85 | }else{ 86 | aPostCPr <- aPriCPr 87 | bPostCPr <- bPriCPr} 88 | 89 | for(i in 1:iters){ 90 | Exp <- rgamma(n=1, aPostExp, bPostExp) 91 | CPr <- rbeta(n=1, aPostCPr, bPostCPr) 92 | Fatalities <- ExpFac * Exp * CPr 93 | out[i,] <- c(CPr, Exp, Fatalities) 94 | } 95 | 96 | #attr(Fatalities,"Exp") <- c(Mean=rvmean(Exp), SD=rvsd(Exp)) 97 | #attr(Fatalities,"CPr") <- c(Mean=rvmean(CPr), SD=rvsd(CPr)) 98 | return(out) 99 | } 100 | 101 | prediction <- function(iters, aExp, bExp, aCPr, bCPr){ 102 | out <- data.frame(collision = rep(NA,iters), 103 | expose = rep(NA, iters), 104 | fatality = rep(NA, iters) 105 | ) 106 | for(n in 1:iters){ 107 | out[n,] <- simFatal(BMin=-1, Fatal=-1, SmpHrKm, ExpFac, aPriExp=1, 108 | bPriExp=1,aPriCPr=1, bPriCPr=1) 109 | #c <- rbeta(1, shape1 = 9.28, shape2 = 3224.51) 110 | #e <- rgamma(1, shape = alpha, rate = beta) 111 | #f <- c*e 112 | #out[n,] <- c(c,e,f) 113 | } 114 | return(out) 115 | } 116 | 117 | 118 | #' calculate mean and 80% CI estimates from a predicted fatality distribution 119 | #' 120 | #' This function is hardwired to use updated golden eagle priors 121 | #' 122 | #' @param niters number of iterations 123 | #' @param a observed eagle minutes 124 | #' @param b survey effort (hr*km3) 125 | #' @return named vector with mean and 80th percentile estimates calcualted with 126 | #' and without eagle exposure priors 127 | #' 128 | estimates <- function(niters, a, b, nturbines){ 129 | out <- simFatal(BMin = a, 130 | Fatal = -1, 131 | SmpHrKm = b, 132 | ExpFac = turbines_to_size(nturbines), 133 | aPriExp = goldExposure$shape, 134 | bPriExp = goldExposure$rate, 135 | aPriCPr = goldCollision$shape, 136 | bPriCPr = goldCollision$rate, 137 | iters = niters) 138 | fatality <- mean(out$fatality) 139 | q80 <- quantile(out$fatality, c(0.8)) 140 | out2 <- simFatal(BMin = a, 141 | Fatal = -1, 142 | SmpHrKm = b, 143 | ExpFac = turbines_to_size(nturbines), 144 | aPriExp = 0, 145 | bPriExp = 0, 146 | aPriCPr = goldCollision$shape, 147 | bPriCPr = goldCollision$rate, 148 | iters = niters) 149 | fatality2 <- mean(out2$fatality) 150 | q82 <- quantile(out2$fatality, 0.8) 151 | return (c("MN_F" = fatality, "U_F" = q80, "MN" = fatality2, "U" = q82)) 152 | } 153 | 154 | #' Calculate total mitigation and monitoring costs 155 | #' 156 | #' @description This function calculates the...the first argument is effort because this is what will be optimized over 157 | #' @param effort survey effort (hrs*km3). Will be optimized when used with optimize() 158 | #' @param data data frame with columns 'a', 'size' 'mcost' and 'acost.' These columns must containe 159 | #' contain eagle activity rate, project size, per eagle mitigation cost, and hourly survey cost respectively 160 | #' 161 | #' @return total cost of mitigation and monitoring (numeric) 162 | cost_fxn <- function(effort, data){ 163 | with(data, { 164 | activity <- a*effort 165 | #activity <- 1 166 | #size <- 10 167 | aExp <- goldExposure$shape 168 | bExp <- goldExposure$rate 169 | aCPr <- goldCollision$shape 170 | bCPr <- goldCollision$rate 171 | #Read in effort values (hrs*km3) 172 | #Do we need to use rv here? 173 | EXP <- rvgamma(1, aExp + activity, bExp + effort) 174 | COL <- rvbeta(1, aCPr, bCPr) 175 | Fatal <- EXP * COL * size 176 | M <- rvquantile(Fatal, 0.8) * mrate#38000 177 | S <- effort * srate#167 178 | total_cost <- M+S 179 | return(total_cost) 180 | }) 181 | } 182 | 183 | #' Calculate mitigation, monitoring, and total costs 184 | #' 185 | #' @param effort survey effort (hr*km3) 186 | #' @param a eagle activity rate (eagle min/hr) 187 | #' @param size project size in number of turbines 188 | #' @param mcost cost of mitigation for 1 eagle take 189 | #' @param scost hourly cost of pre-construction monitoring 190 | #' 191 | #' @return data.frame with eagles('E'), total ('T'), mitigation ('M'), survey ('S') costs 192 | cost <- function(effort, a, size, mrate, srate){ 193 | activity <- a*effort 194 | #activity <- 1 195 | #size <- 10 196 | aExp <- goldExposure$shape 197 | bExp <- goldExposure$rate 198 | aCPr <- goldCollision$shape 199 | bCPr <- goldCollision$rate 200 | #Read in effort values (hrs*km3) 201 | EXP <- rvgamma(1, aExp + activity, bExp + effort) 202 | COL <- rvbeta(1, aCPr, bCPr) 203 | Fatal <- EXP * COL * size 204 | E <- rvquantile(Fatal, 0.8) 205 | M <- E * mrate#38000 206 | S <- effort * srate#167 207 | total_cost <- M+S 208 | 209 | return(list('T' = total_cost[1,], 'M' = M[1,], 'S' = S, 'E' = E)) 210 | #if (return == 'T'){ 211 | # return(total_cost[1,]) 212 | #}else if (return == "M"){ 213 | # return(M[1,]) 214 | #}else if (return == "S"){ 215 | # return(S) 216 | #} 217 | } 218 | 219 | #' Generate total, mitigation, and survey costs over a range of efforts 220 | #' @return data frame wih columns x, T, M, S 221 | cost_curve <- function(effort, erate, size, mrate, srate){ 222 | output <- cost(effort, erate, size, mrate, srate) 223 | return(data.frame(T = output['T'], M = output['M'], S = output['S'], E = output['E'])) 224 | } 225 | 226 | 227 | #' Find effort that equates to minimum cost 228 | #' 229 | #' @description identifies the amount of effort that minimized the total costs associated with 230 | #' mitigation and monitoring for a given eagle activity rate, project size, and assumed 231 | #' per eagle mitigation costs and hourly survey costs. 232 | #' @param 233 | optim_fxn <- function(erate, size, mrate, srate){ 234 | opt <-optimize(cost_fxn, interval = c(0, 500), data = data.frame(a = erate, size = size, mrate = mrate, srate = srate), tol = 0.00000001) 235 | return(data.frame(effort = opt$minimum, cost = opt$objective)) 236 | } 237 | 238 | #Alternatively we use 'curve' and 'cost' to generate points, fit a line, 239 | # then find minimum 240 | min_cost <- function(erate, size, mrate, srate){ 241 | crv <- curve(cost(x, erate, size, mrate, srate)$T, 242 | from = 0, to = 500) 243 | 244 | lo <- loess(crv$y ~ crv$x, span = 0.2) 245 | smoothed <- predict(lo, x = crv$x) 246 | 247 | min_effort <- crv$x[smoothed == min(smoothed)] 248 | 249 | return(data.frame(cost = min(smoothed), effort = min_effort)) 250 | } 251 | 252 | #' Equation defining relationship between effort and discrepancy 253 | #' 254 | #' @param erate inherent rate of eagle activity 255 | #' @param a shape parameter from exposure prior 256 | #' @param b rate parameter from exposure prior 257 | #' @param w effort 258 | #' @return numeric value 259 | effort_discrepancy_slope <- function(erate, a, b, w){ 260 | (erate*b - a)/(b+w) 261 | } 262 | -------------------------------------------------------------------------------- /R/VOI.R: -------------------------------------------------------------------------------- 1 | library(dplyr) 2 | library(reshape2) 3 | source(file='R/helper_fxns.R') 4 | 5 | ## Calculation of expected values of surveying vs. mitigating for eagles under the US Fish & Wildlife 6 | ## collision risk model used to predict eagle fatalities at proposed wind energy facilities. 7 | ## Based on Bennet et al. (2018). 8 | 9 | ## STEP 1: SETUP 10 | # define possible eagle activity states - a discretized approximation 11 | S <- seq(0.1, 3, 0.1) 12 | len <- length(S) 13 | 14 | # define mitigation rates for a hypothetical project 15 | cost_table <- read.csv(file = 'data/ABT_REA_costs.csv', header = TRUE) 16 | nturb <- 200 17 | size <- nturb * expFac 18 | mitigation <- filter(cost_table, Duration == 30, Rate == "Median", Cost == 'High')$M * size 19 | #Estimated survey cost data from West Ecosystems Inc. 20 | survey_costs <- list('annual_low_ppt' = 2000, 'annual_high_ppt' = 5000, 21 | "Low" = 2000/12, 'High' = 5000/12, 22 | 'annual_low_pMW' = 300, 'annual_high_pMW' = 600) 23 | # probability of each state is based on the eagle activity prior ~gamma(0.968, 0.552) 24 | pS <- dgamma(S, expose$shape, expose$rate) 25 | 26 | # The other component predicting eagle fatalities is the probability of collision with 27 | # wind turbines, given exposure. This is a fixed distribution 28 | # For simplicity, we'll use the mean of the collision prior to predict fatalties 29 | # TODO: calculate 80th percentile? 30 | meanCollision <- collide$shape/(collide$shape + collide$rate) 31 | 32 | # our current belief of eagle activity is the mean of the prior distribution to start 33 | curBelief <- expose$shape/expose$rate 34 | # our confidence in this belief is represented by the variance of the distribution 35 | confidence <- expose$shape/(expose$rate^2) 36 | 37 | # STEP 2: DEFINE VALUES MATRIX 38 | # SxSx2 array of action values. cells are abs[discrepancy between mitigation cost of true eagle rate and 39 | # cost of current belief] 40 | # true states are rows, beliefs are columns 41 | # TODO: currently using the mean of the collision prior. could/should update to represent 80th? 42 | values <- expand.grid(truth = S, belief = S)%>% 43 | mutate(value = -abs((belief - truth)*meanCollision*mitigation))%>% 44 | acast(truth ~ belief) 45 | 46 | values <- array(c(values, rep(-survey_costs$Low*10, length(S)^2)), dim = c(len, len, 2)) 47 | dimnames(values)[[3]]<-c('mitigate', 'survey') 48 | 49 | # STEP 3: EXPECTED VALUES UNDER UNCERTAINTY 50 | 51 | # sum of value of current belief relative to true state * probability of states 52 | valUncertainMitigate <- sum(pS * -abs((curBelief - S)*meanCollision*mitigation)) 53 | valUncertainSurvey <- -survey_costs$Low*10*len 54 | valUncertain <- max(valUncertainMitigate, valUncertainSurvey) 55 | 56 | ## STEP 4: EXPECTED VALUE UNDER CERTAINAY 57 | 58 | # value of each action given current belief relative to each state 59 | valCertainMitigate <- -abs((curBelief - S)*meanCollision*mitigation) 60 | valCertainSurvey <- -survey_costs$Low*10 61 | 62 | # optimal action for each state 63 | maxValsCertain <- data.frame('mitigate' = valCertainMitigate, 'survey' = valCertainSurvey)%>% 64 | apply(1, max) 65 | 66 | # sum of optimal action * probabilty of each state 67 | valCertain <- sum(pS * maxValsCertain) 68 | 69 | 70 | # STEP 5: EXPECTED VALUE AFTER MONTORING 71 | # P(s|y) = P(y|s)*P(s)/P(y) 72 | # we calculate P(s|y) by directly updating the posterior distribution based on a set amount of survey effort 73 | # and possible survey outcomes as in New et al. (2015) 74 | 75 | # P(y) probability of observing y eagles is Poisson with rate s 76 | # is this the joint distribution of observing a given number of eagles and a given true state? 77 | # 78 | # TODO: test alternative we make these prob of greater, less, equal curbelief +/- 0.2 with ppois 79 | pObs <- expand.grid(truth = S, observed = S)%>% 80 | mutate(value = dpois(observed*10, truth*10)*dgamma(truth, expose$shape, expose$rate))%>% 81 | acast(truth~observed)%>% 82 | colSums() 83 | 84 | #or is this the predictive posterior (negative binomial)? Posterior predictive is the probability of 85 | # new observations, given hyperparameters and data, integrating over possible states (poisson rates) 86 | pObs <- dnbinom(S*10, mu = expose$shape + (curBelief*10), size = 1/(1+expose$rate+10)) 87 | 88 | # P(s|y) - we can estimate directly due to conjugativity 89 | # we assume we monitor for 10 hours 90 | # creates an S x S matrix, rows are S, columns are Y 91 | pSY <- sapply(S, function(x){dgamma(S, expose$shape + x*10, expose$rate + 10)}) 92 | 93 | # expected values for each management action after surveying 94 | # these will be the value of an action given true state * probability of that state after a result y 95 | expValsMitigate <- colSums(pSY * values[,,'mitigate']) 96 | expValsSurvey <- colSums(pSY * values[,,'survey']) 97 | 98 | expVals <- data.frame('mitigate' = expValsMitigate, 'survey' = expValsSurvey) 99 | rownames(expVals) <- S 100 | 101 | # value of optimal actions for each survey outcome 102 | maxVals <- apply(expVals, 1, max) 103 | 104 | # sum of maximum expected value for each survey outcom * probability of outcomes 105 | valPostMonitor <- sum(maxVals*pObs) 106 | 107 | valPerfect <- valCertain - valUncertain 108 | voi <- valPostMonitor - valUncertain 109 | 110 | #' calculate the value of monitoring information 111 | #' 112 | #' this function assumes turbines operate 365 days/year for 10hr/day 113 | #' 114 | #' @param S vector of possible eagle activity rates 115 | #' @param shape shape parameter of gamma exposure distribution 116 | #' @param rate rate parameter of gamma exposure distribution 117 | #' @return size (hr*km3) 118 | calc_voi <- function(S, shape, rate){ 119 | 120 | pS <- dgamma(S, shape, rate) 121 | 122 | # The other component predicting eagle fatalities is the probability of collision with 123 | # wind turbines, given exposure. This is a fixed distribution 124 | # For simplicity, we'll use the mean of the collision prior to predict fatalties 125 | meanCollision <- 2.31/(2.31 + 396.69) 126 | 127 | # our current belief of eagle activity is the mean of the prior distribution to start 128 | curBelief <- shape/rate 129 | # our confidence in this belief is represented by the variance of the distribution 130 | confidence <- shape/rate^2 131 | 132 | # STEP 2: DEFINE VALUES MATRIX 133 | # SxSx2 array of action values. cells are abs[discrepancy between mitigation cost of true eagle rate and 134 | # cost of current belief] 135 | # true states are rows, beliefs are columns 136 | # TODO: currently using the mean of the collision prior. could/should update to represent 80th? 137 | values <- expand.grid(truth = S, belief = S)%>% 138 | mutate(value = -abs((belief - truth)*meanCollision*mitigation))%>% 139 | acast(truth ~ belief) 140 | 141 | values <- array(c(values, rep(-survey_costs$Low*10, length(S)^2)), dim = c(len, len, 2)) 142 | dimnames(values)[[3]]<-c('mitigate', 'survey') 143 | 144 | # STEP 3: EXPECTED VALUES UNDER UNCERTAINTY 145 | 146 | # sum of value of current belief relative to true state * probability of states 147 | valUncertainMitigate <- sum(pS * -abs((curBelief - S)*meanCollision*mitigation)) 148 | valUncertainSurvey <- -survey_costs$Low*10*len 149 | valUncertain <- max(valUncertainMitigate, valUncertainSurvey) 150 | 151 | ## STEP 4: EXPECTED VALUE UNDER CERTAINAY 152 | 153 | # value of each action given current belief relative to each state 154 | valCertainMitigate <- -abs((curBelief - S)*meanCollision*mitigation) 155 | valCertainSurvey <- -survey_costs$Low*10 156 | 157 | # optimal action for each state 158 | maxValsCertain <- data.frame('mitigate' = valCertainMitigate, 'survey' = valCertainSurvey)%>% 159 | apply(1, max) 160 | 161 | # sum of optimal action * probabilty of each state 162 | valCertain <- sum(pS * maxValsCertain) 163 | 164 | 165 | # STEP 5: EXPECTED VALUE AFTER MONTORING 166 | # P(s|y) = P(y|s)*P(s)/P(y) 167 | # we calculate P(s|y) by directly updating the posterior distribution based on a set amount of survey effort 168 | # and possible survey outcomes as in New et al. (2015) 169 | 170 | # P(y) probability of observing y eagles is Poisson with rate s 171 | # pObs <- expand.grid(truth = S, observed = S)%>% 172 | # mutate(value = dpois(observed*10, truth*10)*dgamma(truth, expose$shape, expose$rate))%>% 173 | # acast(truth~observed)%>% 174 | # colSums() 175 | 176 | # or is this the predictive posterior (negative binomial)? Posterior predictive is the probability of 177 | # new observations, given hyperparameters and data, integrating over possible states (poisson rates) 178 | pObs <- dnbinom(S*10, mu = shape + (curBelief*10), size = 1/(1+rate+10)) 179 | 180 | # P(s|y) - we can estimate directly due to conjugativity 181 | # we assume we monitor for 10 hours 182 | # creates an S x S matrix, rows are S, columns are Y 183 | pSY <- sapply(S, function(x){dgamma(S, shape + x*10, rate + 10)}) 184 | 185 | # expected values for each management action after surveying 186 | # these will be the value of an action given true state * probability of that state after a result y 187 | expValsMitigate <- colSums(pSY * values[,,'mitigate']) 188 | expValsSurvey <- colSums(pSY * values[,,'survey']) 189 | 190 | expVals <- data.frame('mitigate' = expValsMitigate, 'survey' = expValsSurvey) 191 | rownames(expVals) <- S 192 | 193 | # value of optimal actions for each survey outcome 194 | maxVals <- apply(expVals, 1, max) 195 | 196 | # sum of maximum expected value for each survey outcom * probability of outcomes 197 | valPostMonitor <- sum(maxVals*pObs) 198 | 199 | valPerfect <- valCertain - valUncertain 200 | voi <- valPostMonitor - valUncertain 201 | return(list('voi' = voi, 'perfect' = valPerfect)) 202 | } 203 | 204 | niters = 1000 205 | hypothetical <- data.frame(erate = rep(NA, niters), 206 | voi = rep(NA, niters), 207 | perfect = rep(NA, niters), 208 | shape = rep(NA, niters), 209 | rate = rep(NA, niters)) 210 | S <- seq(0.1, 3, 0.1) 211 | shape <- expose$shape 212 | rate <- expose$rate 213 | erate <- 3 214 | for(i in 1:niters){ 215 | outcome <- calc_voi(S, shape, rate) 216 | if(outcome$voi > 0) 217 | newObs <- rpois(1, erate*10) 218 | aprime <- shape+newObs 219 | bprime <- rate + 4.02 220 | shape <- aprime 221 | rate <- bprime 222 | hypothetical[i,] <- c(erate, outcome$voi, outcome$perfect, shape, rate) 223 | } 224 | -------------------------------------------------------------------------------- /inst/eagles-fws/cost_dashboard.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Eagle Permitting Costs" 3 | author: "Michael Evans" 4 | date: "January 23, 2020" 5 | output: 6 | flexdashboard::flex_dashboard: 7 | #vertical_layout: scroll 8 | orientation: rows 9 | css: www/dashboard.css 10 | social: menu 11 | df_print: paged 12 | navbar: 13 | - {title: "", icon: "fa-question-circle fa-lg", align: right, href: "mailto:esa@defenders.org?subject=Bayesian eagles"} 14 | - {title: "", icon: "fa-github fa-lg", align: right, href: "https://github.com/mjevans26/eaglesFWS"} 15 | - {title: "CCI", align: right, href: "https://cci-dev.org"} 16 | runtime: shiny 17 | --- 18 | 19 | ```{r setup, include=FALSE} 20 | knitr::opts_chunk$set(echo = TRUE) 21 | 22 | library(plyr) 23 | library(dplyr) 24 | library(plotly) 25 | library(reshape2) 26 | library(rv) 27 | library(stringr) 28 | library(shiny) 29 | library(shinydashboard) 30 | library(tidyr) 31 | library(viridis) 32 | 33 | source("R/helper_fxns.R") 34 | load("data/cost_surfaces_95.rdata") 35 | #Read in table of total mitigation costs per eagle from ABT report for different durations & cost estimates 36 | cost_table <- read.csv(file = 'data/ABT_REA_costs.csv', header = TRUE) 37 | 38 | # Create different combinations of eagle rates and project sizes. 39 | # For testing purposes, assume all turbines are 200m tall w/80m blades 40 | test_values <- expand.grid(erate = seq(0,3,0.05), size = seq(20, 500, 20)*expFac) 41 | 42 | #test-values <- mutate(test_values, mrate = 15200, srate = 167) 43 | effort_df <- data.frame(effort = seq(0, 500, 1)) 44 | 45 | # define annotation for FWS minimum survey effort 46 | a <- list( 47 | x = 10, 48 | y = 10, 49 | text = 'FWS minimum', 50 | font = list(color = 'black', size = 12), 51 | xref = "x", 52 | yref = "y", 53 | xanchor = 'left', 54 | showarrow = TRUE, 55 | arrowhead = 7, 56 | ax = 20, 57 | ay = -40 58 | ) 59 | 60 | plot_curves <- function(erate, nturb, mcost, scost){ 61 | size <- nturb*expFac 62 | output <- plyr::mdply(effort_df, cost_curve, erate, size, mcost, scost) 63 | min_effort <- output$effort[output$T == min(output$T)] 64 | plot_ly(data = output, type = 'scatter', mode = 'lines')%>% 65 | add_trace( 66 | x = ~effort, y = ~T, 67 | #line = list(color = cols[(i-1)%/%6], width = ((i-1)%%6 +1)), 68 | line = list(color = 'orange'), 69 | showlegend = TRUE, 70 | name = 'Total' 71 | )%>% 72 | add_trace( 73 | x = ~effort, y = ~M, 74 | #line = list(color = cols[(i-1)%/%6], width = ((i-1)%%6 +1), dash = 'dash'), 75 | line = list(color = 'grey', dash = 'dash'), 76 | showlegend = TRUE, 77 | name = "Mitigation" 78 | )%>% 79 | add_trace( 80 | x = ~effort, y = ~S, 81 | #line = list(color = cols[(i-1)%/%6], width = ((i-1)%%6 +1), dash = 'dot'), 82 | line = list(color = 'blue', dash = 'dot'), 83 | showlegend = TRUE, 84 | name = 'Survey' 85 | )%>% 86 | add_trace( 87 | x = c(min_effort, min_effort), y = c(0, max(output$T)), 88 | line = list(color = 'black', width = 1), 89 | name = paste('Min cost effort (', min_effort, ' hrs)', sep = "") 90 | )%>% 91 | layout( 92 | xaxis = list(title = 'Survey effort (hr*km3)'), 93 | yaxis = list(title = 'Cost ($)'), 94 | annotations = a, 95 | legend = list(x = 0.2, y = 1)#, 96 | #title = paste('Costs at a site with', round(nturb, 0), 'turbines &', erate, 'eagle min/hr') 97 | ) 98 | } 99 | 100 | #Estimated survey cost data from West Ecosystems Inc. 101 | survey_costs <- list('annual_low_ppt' = 2000, 'annual_high_ppt' = 5000, 102 | "Low" = 2000/12, 'High' = 5000/12, 103 | 'annual_low_pMW' = 300, 'annual_high_pMW' = 600) 104 | 105 | #Estimated powerpole retrofit costs and eagle electrocution rates (eagles/pole*yr) from Adt report 106 | retro_costs <- list('Low' = 1040, 'High' = 2590) 107 | electro_rates <- list('Low' = 0.0036, 'Median' = 0.0051, 'High' = 0.0066) 108 | durations <- c(10, 20, 30, 40, 50) 109 | 110 | #' Create a plotly heatmap of minimum cost survey efforts 111 | #' @param df matrix storing minimum cost efforts for eagle rate x project size combos 112 | #' @return plotly heatmap 113 | plot_surface <- function(df){ 114 | plot_ly(type = 'heatmap', z = acast(df, erate~size, value.var = "effort"), 115 | y = seq(0,2,0.05), x = seq(20,500,20), 116 | zmin = 0, zmax = 50, 117 | colorbar = list(title = 'Survey
Effort
(hr*km3)') 118 | )%>% 119 | layout( 120 | yaxis = list(title = 'Eagle Activity Rate (min/hr*km3)', 121 | titlefont = list(color = 'black', size = 14), 122 | tickfont = list(color = 'black', size = 12)), 123 | xaxis = list(title = 'Project Size (# Turbines)', 124 | titlefont = list(color = 'black', size = 14), 125 | tickfont = list(color = 'black', size = 12)) 126 | ) 127 | } 128 | 129 | select_scost <- selectInput('scost', 'Survey cost per hour', 130 | list('Low ($167)' = 'Low', 131 | 'High ($417)' = 'High'), selected = 'Low ($167/hr)') 132 | 133 | select_mcost <- selectInput('mcost', 'Mitigation cost per retrofit', 134 | list('Low ($1,040)' = 'Low', 135 | 'High ($2,590)' = 'High')) 136 | 137 | slide_erate <- sliderInput('erate', 'Eagle activity (min/hr)', 138 | min = 0, max = 3, value = 0.1, step = 0.05) 139 | 140 | slide_size <- sliderInput('size', 'Number of turbines', 141 | min = 20, max = 500, value = 100, step = 10) 142 | 143 | expand <- actionButton("show", "Click for details of the permitting process") 144 | 145 | output$surfacePlot <- renderPlotly({ 146 | selection <- paste(input$mcost, input$scost, sep = "_") 147 | df <- switch(selection, 148 | Low_Low = low_low, 149 | Low_High = low_high, 150 | High_Low = high_low, 151 | High_High = high_high) 152 | plot_surface(df) 153 | }) 154 | 155 | output$curvePlot <- renderPlotly({ 156 | mcost <- filter(cost_table, Cost == input$mcost, Duration == 30, Rate == "Median")%>% 157 | select(M) 158 | scost <- survey_costs[input$scost][[1]] 159 | erate <- input$erate 160 | size <- input$size 161 | plot_curves(erate, size, mcost, scost) 162 | }) 163 | 164 | modal <- modalDialog( 165 | title = "Predicting Eagle Mortality at Wind Energy Sites", 166 | fluidRow( 167 | renderImage({ 168 | list( 169 | src = 'www/turbines.jpg', 170 | contentType = 'image/jpg', 171 | width = 300, 172 | height = 300, 173 | alt = 'Eagle flying near wind turbines' 174 | ) 175 | }), 176 | p("The Bald and Golden Eagle Protection Act (BAGEPA) requires wind energy projects to obtain an incidental take permit for any bald or golden eagles that might be killed as a result of the project's operation. The ", tags$a(href = "https://www.fws.gov/", "U.S. Fish and Wildlife Service")," uses a Bayesian model to estimate how many eagles will be killed at a proposed project. The model combines eagle activity and collision rate data from existing wind farms with eagle activity data collected during surveys at the proposed site. To receive a permit, developers must mitigate for the incidental take of the predicted number of eagles."), 177 | br(), 178 | p("Mitigation often involves buying retrofits for power transmission lines that prevent eagles from being electrocuted, and greater predicted take requires more mitigation. Simultaneously, more survey effort produces eagle fataliy estimates that more closely reflect eagle activity levels at the proposed site (rather than existing sites). Therefore, the total cost of mitigation is related to four factors:"), 179 | tags$ol( 180 | tags$li("Mitigation cost^: cost of powerpole retrofits to offset 1 eagle"), 181 | tags$li("Survey cost: costs of eagle surveys"), 182 | tags$li("Eagle activity: level of eagle activity at the project site"), 183 | tags$li("Project size*: number of turbines to be built.") 184 | ), 185 | p("This app allows users to explore the relationship between these four factors under different scenarios to estimate costs associated with eagle surveying and mitigation for a given project."), 186 | p("^Mitigation costs assume eagles are electrocuted at a rate of 0.0051 birds per pole per year, and that powerpole retrofits last for 20 years.", 187 | style = 'font-size:10px; font-style:italic;'), 188 | p("*The project size parameter used to estimate eagle mortality is a product of turbine size, operating time, and number of turbines. For simplicity, we assume 200 m tall turbines with 80 m blades operating for 10 hr per day.", 189 | style = 'font-size:10px; font-style:italic;') 190 | ), 191 | easyClose = TRUE, 192 | size = 'l', 193 | footer = NULL 194 | ) 195 | 196 | observeEvent(input$show, 197 | {showModal(modal)}) 198 | 199 | ``` 200 | 201 | Intro {.sidebar data-width=400} 202 | --- 203 | 204 | ### Eagles & Wind Energy 205 | 206 | ```{r intro, echo = FALSE} 207 | #fluidPage( 208 | #fluidRow( 209 | p("The Bald and Golden Eagle Protection Act requires wind energy developers to survey and mitigate for eagles predicted to be killed at a proposed project.") 210 | br() 211 | div(expand, style = 'text-align: center;') 212 | br() 213 | p("This app lets a user explore how survey and mitigation costs change based on user-defined scenarios.") 214 | # ) 215 | #) 216 | ``` 217 | 218 | ### Parameters 219 | 220 | ```{r selectors, echo = FALSE} 221 | #fluidPage( 222 | fluidRow( 223 | br(), 224 | column(1), 225 | column(10, 226 | select_mcost, 227 | select_scost, 228 | slide_erate, 229 | slide_size), 230 | column(1) 231 | ) 232 | #) 233 | ``` 234 | 235 | Row 236 | ------ 237 | 238 | ### Costs vs. Survey Effort 239 | 240 | ```{r curves, echo = FALSE} 241 | fillCol(flex = c(1, NA), 242 | plotlyOutput('curvePlot'), 243 | p(em("Costs associated with eagle surveying and mitigation as a function of survey effort. Greater survey effort generates predictions for eagle take that more closely reflect eagle activity at a given site. For sites with < 1.1 eagle min/hr, additional survey effort lowers mitigation costs. These curves are affected by changes in all four input parameters."), 244 | style = 'font-size:14px; margin: 10px 0px 0px 10px;') 245 | ) 246 | ``` 247 | 248 | ### Optimal Survey Effort 249 | 250 | ```{r surfaces, echo = FALSE} 251 | fillCol(flex = c(1, NA), 252 | plotlyOutput('surfacePlot', height = '100%'), 253 | p(em("Survey effort that will lead to minimum costs associated with eagle permitting. These values are shown for a range of possible eagle activity levels and project sizes for a given set of estimated survey and mitigation costs. The figure will change in response to different survey and mitigation cost estimates."), 254 | style = 'font-size:14px; margin: 10px 0px 0px 10px;' 255 | ) 256 | ) 257 | ``` 258 | -------------------------------------------------------------------------------- /R/helper_fxns.R: -------------------------------------------------------------------------------- 1 | ##NOTE 2 | ## for Gamma dist a = (u/sd)2, b = (u/sd2) 3 | ## FWS priors are mean eagle min/hr*km2 for exposure 4 | ## birds / min 5 | 6 | 7 | 8 | # CRM priors taken from New et al (2018) https://www.fws.gov/migratorybirds/pdf/management/crmpriorsreport2018.pdf 9 | baldExposure <- list('shape' = 0.077, 'rate' = 0.024) 10 | baldCollision <- list('shape' = 1.61, 'rate' = 228.2) 11 | goldExposure <- list('shape' = 0.287, 'rate' = 0.237) 12 | goldCollision <- list('shape' = 1.29, 'rate' = 227.6) 13 | 14 | # # CRM priors provided by E. Bjerre 4/10/20 15 | # expose <- list('shape' = 0.968, 'rate' = 0.552) 16 | # collide <- list('shape' = 2.31, 'rate' = 396.69) 17 | 18 | # CRM priors updated in New et al. 2018 19 | expose <- list('shape' = 0.287, 'rate' = 0.237) 20 | collide <- list('shape' = 1.29, 'rate' = 227.6) 21 | 22 | #Site expansion factor assuming 100m tall turbines w/50m rotors operating 10hrs/day 23 | # Turbine specs: http://www.aweo.org/windmodels.html 24 | #expFac <- 3650*(0.2)*(0.08^2)*pi 25 | expFac <- 3650*(0.1)*(0.05^2)*pi 26 | #' convert number of turbines to project 'size' 27 | #' 28 | #' this function assumes turbines operate 365 days/year for 10hr/day 29 | #' 30 | #' @param n number of turbines 31 | #' @param h turbine tower height (m) 32 | #' @param r turbine rotor radius (m) 33 | #' @return size (hr*km3) 34 | turbines_to_size <- function(n, h, r){ 35 | # convert lengths to km 36 | h <- h/1000 37 | r <- r/1000 38 | size = n*3650*(h)*(r^2)*pi 39 | #size = n*3650*(0.2)*(0.08^2)*pi 40 | return(size) 41 | } 42 | 43 | #' Calculate cost for eagle mitigation 44 | #' 45 | #' @param cost per pole cost 46 | #' @param duration retrofit longevity 47 | #' @param adult boolean indication of adult or juvenille eagle 48 | #' @param electrocution assumed per/pole electrocution rate 49 | #' @return estimated cost (numeric) 50 | retrofit_cost <- function(cost, duration = 20, adult = TRUE, electrocution){ 51 | age <- ifelse(isTRUE(adult), 10, 2) 52 | future_yrs <- 30 - age 53 | n_poles <- future_yrs/0.0051*duration 54 | total <- n_poles*cost 55 | return(total) 56 | } 57 | 58 | 59 | vir_col <- function(n){ 60 | return (substr(viridis(n),1,7)) 61 | } 62 | 63 | #' estimate fatalities from the collision risk model 64 | #' @param BMin observed number of bird minutes 65 | #' @param Fatal annual avian fatalities on an operational wind facility 66 | #' @param SmpHrKm total time and area surveyed for bird minutes 67 | #' @param ExpFac expansion factor 68 | #' @param aPriExp alpha parameter for the prior on lambda 69 | #' @param bPriExp beta parameter for the prior on lambda 70 | #' @param aPriCPr alpha parameter for the prior on C 71 | #' @param bPriCPr beta parameter for the prior on C 72 | #' 73 | #' The default of a negative value for BMin or Fatal indicates that no data were collected for those model inputs 74 | #' 75 | #' @require rv 76 | #' @return data frame with random draws for collision rate, exposure and predicted fatalities 77 | #' for each iteration 78 | simFatal <- function(BMin=-1, Fatal=-1, SmpHrKm, ExpFac = 1, aPriExp=1, 79 | bPriExp=1,aPriCPr=1, bPriCPr=1, iters){ 80 | out <- data.frame(collision = rep(NA,iters), 81 | expose = rep(NA, iters), 82 | fatality = rep(NA, iters) 83 | ) 84 | 85 | 86 | # Update the exposure prior 87 | if(BMin>=0){ 88 | aPostExp <- aPriExp + BMin 89 | bPostExp <- bPriExp + SmpHrKm 90 | }else{ 91 | aPostExp <- aPriExp 92 | bPostExp <- bPriExp} 93 | # Update the collisions prior 94 | if(Fatal>=0){ 95 | aPostCPr <- aPriCPr + Fatal 96 | bPostCPr <- ((rvmean(Exp) * ExpFac) - Fatal) + bPriCPr 97 | }else{ 98 | aPostCPr <- aPriCPr 99 | bPostCPr <- bPriCPr} 100 | 101 | for(i in 1:iters){ 102 | Exp <- rgamma(n=1, aPostExp, bPostExp) 103 | CPr <- rbeta(n=1, aPostCPr, bPostCPr) 104 | Fatalities <- ExpFac * Exp * CPr 105 | out[i,] <- c(CPr, Exp, Fatalities) 106 | } 107 | 108 | #attr(Fatalities,"Exp") <- c(Mean=rvmean(Exp), SD=rvsd(Exp)) 109 | #attr(Fatalities,"CPr") <- c(Mean=rvmean(CPr), SD=rvsd(CPr)) 110 | return(out) 111 | } 112 | 113 | prediction <- function(iters, aExp, bExp, aCPr, bCPr){ 114 | out <- data.frame(collision = rep(NA,iters), 115 | expose = rep(NA, iters), 116 | fatality = rep(NA, iters) 117 | ) 118 | for(n in 1:iters){ 119 | out[n,] <- simFatal(BMin=-1, Fatal=-1, SmpHrKm, ExpFac, aPriExp=1, 120 | bPriExp=1,aPriCPr=1, bPriCPr=1) 121 | #c <- rbeta(1, shape1 = 9.28, shape2 = 3224.51) 122 | #e <- rgamma(1, shape = alpha, rate = beta) 123 | #f <- c*e 124 | #out[n,] <- c(c,e,f) 125 | } 126 | return(out) 127 | } 128 | 129 | 130 | #' calculate mean and 80% CI estimates from a predicted fatality distribution 131 | #' 132 | #' This function is hardwired to use updated golden eagle priors 133 | #' 134 | #' @param niters number of iterations 135 | #' @param a observed eagle minutes 136 | #' @param b survey effort (hr*km3) 137 | #' @return named vector with mean and 80th percentile estimates calcualted with 138 | #' and without eagle exposure priors 139 | #' 140 | estimates <- function(niters, a, b, nturbines){ 141 | out <- simFatal(BMin = a, 142 | Fatal = -1, 143 | SmpHrKm = b, 144 | ExpFac = turbines_to_size(nturbines, 100, 50), 145 | aPriExp = expose$shape, 146 | bPriExp = expose$rate, 147 | aPriCPr = collide$shape, 148 | bPriCPr = collide$rate, 149 | iters = niters) 150 | fatality <- mean(out$fatality) 151 | q80 <- quantile(out$fatality, c(0.8)) 152 | out2 <- simFatal(BMin = a, 153 | Fatal = -1, 154 | SmpHrKm = b, 155 | ExpFac = turbines_to_size(nturbines, 100, 50), 156 | aPriExp = 0, 157 | bPriExp = 0, 158 | aPriCPr = collide$shape, 159 | bPriCPr = collide$rate, 160 | iters = niters) 161 | fatality2 <- mean(out2$fatality) 162 | q82 <- quantile(out2$fatality, 0.8) 163 | return (c("CRM_mean" = fatality, "CRM_80" = q80, "Survey_mean" = fatality2, "Survey_80" = q82)) 164 | } 165 | 166 | #' Calculate total mitigation and monitoring costs 167 | #' 168 | #' @description This function calculates the...the first argument is effort because this is what will be optimized over 169 | #' @param effort survey effort (hrs*km3). Will be optimized when used with optimize() 170 | #' @param data data frame with columns 'erate', 'size' 'mcost' and 'acost.' These columns must containe 171 | #' contain eagle activity rate, project size, per eagle mitigation cost, and hourly survey cost respectively 172 | #' 173 | #' @return total cost of mitigation and monitoring (numeric) 174 | cost_fxn <- function(effort, data){ 175 | with(data, { 176 | activity <- erate*effort 177 | #Do we need to use rv here? 178 | EXP <- rvgamma(1, expose$shape + activity, expose$rate + effort) 179 | COL <- rvbeta(1, collide$shape, collide$rate) 180 | Fatal <- EXP * COL * size 181 | E <- rvquantile(Fatal, 0.8) 182 | M <- E* mrate#38000 183 | S <- effort * srate#167 184 | Total <- M+S 185 | return(Total) 186 | }) 187 | } 188 | 189 | #' Calculate mitigation, monitoring, and total costs 190 | #' 191 | #' @param effort survey effort (hr*km3) 192 | #' @param erate eagle activity rate (eagle min/hr) 193 | #' @param size project size in number of turbines 194 | #' @param mcost cost of mitigation for 1 eagle take 195 | #' @param scost hourly cost of pre-construction monitoring 196 | #' 197 | #' @return data.frame with eagles('E'), total ('T'), mitigation ('M'), survey ('S') costs 198 | cost <- function(effort, erate, size, mrate, srate){ 199 | activity <- erate*effort 200 | #activity <- 1 201 | #size <- 10 202 | aExp <- expose$shape 203 | bExp <- expose$rate 204 | aCPr <- collide$shape 205 | bCPr <- collide$rate 206 | #Read in effort values (hrs*km3) 207 | EXP <- rvgamma(1, aExp + activity, bExp + effort) 208 | COL <- rvbeta(1, aCPr, bCPr) 209 | Fatal <- EXP * COL * size 210 | E <- rvquantile(Fatal, 0.8) 211 | M <- E * mrate#38000 212 | S <- effort * srate#167 213 | total_cost <- M+S 214 | 215 | return(list('T' = total_cost[1,], 'M' = M[1,], 'S' = S, 'E' = E[1,])) 216 | #if (return == 'T'){ 217 | # return(total_cost[1,]) 218 | #}else if (return == "M"){ 219 | # return(M[1,]) 220 | #}else if (return == "S"){ 221 | # return(S) 222 | #} 223 | } 224 | 225 | #' Generate total, mitigation, and survey costs over a range of efforts 226 | #' @return data frame wih columns x, T, M, S 227 | cost_curve <- function(effort, erate, size, mrate, srate){ 228 | output <- cost(effort, erate, size, mrate, srate) 229 | return(data.frame(T = output['T'], M = output['M'], S = output['S'], E = output['E'])) 230 | } 231 | 232 | 233 | #' Find effort that equates to minimum cost 234 | #' 235 | #' @description identifies the amount of effort that minimized the total costs associated with 236 | #' mitigation and monitoring for a given eagle activity rate, project size, and assumed 237 | #' per eagle mitigation costs and hourly survey costs. 238 | #' @param 239 | optim_fxn <- function(erate, size, mrate, srate){ 240 | opt <-optimize(cost_fxn, interval = c(0, 500), data = data.frame(erate = erate, size = size, mrate = mrate, srate = srate), tol = 0.00000001) 241 | return(data.frame(effort = opt$minimum, cost = opt$objective)) 242 | } 243 | 244 | #Alternatively we use 'curve' and 'cost' to generate points, fit a line, 245 | # then find minimum 246 | min_cost <- function(erate, size, mrate, srate){ 247 | crv <- curve(cost(x, erate, size, mrate, srate)$T, 248 | from = 0, to = 500) 249 | 250 | # lo <- loess(crv$y ~ crv$x, span = 0.2) 251 | # smoothed <- predict(lo, x = crv$x) 252 | # 253 | # min_effort <- crv$x[smoothed == min(smoothed)] 254 | # 255 | # return(data.frame(cost = min(smoothed), effort = min_effort)) 256 | # 257 | min_cost <- min(crv$y) 258 | min_effort <- crv$x[crv$y == min_cost] 259 | return(data.frame(cost = min_cost, effort = min_effort)) 260 | } 261 | 262 | #' Function calculating maximum eagles and minimum costs 263 | #' 264 | #'This assumes the mean of the gamma distribution is used 265 | #' @param erate inherent rate of eagle activity (min/hr*km3) 266 | #' @param size size of facility accounting for operation time (hr*km3) 267 | #' @param mrate per eagle cost of mitigation 268 | #' @param srate per hour cost of surveying 269 | #' @return data.frame 270 | max_eagle <- function(erate, size, mrate, srate){ 271 | # calculate the crm exposure curve 272 | exposure <- curve(qgamma(0.8, expose$shape + (erate*x), expose$rate + x), 273 | from = 0, to = 100) 274 | # define multiplier for determining mitigation costs 275 | constant <- 0.01*size*mrate 276 | # create survey cost vs. effort curve 277 | survey <- curve(srate*x, from = 0, to = 100) 278 | # create total cost curve by combining exposure * contant + survey 279 | costs <- (exposure$y*constant) + survey$y 280 | # find minimum cost 281 | minCost <- min(costs) 282 | # match the index of the minimum cost value to corresponding survey effort 283 | minEffort <- survey$x[match(minCost, costs)] 284 | # find the maximum exposure 285 | # could be a) equal to the 'true' erate, with inifite surveying 286 | maxExposure <- qgamma(0.8, expose$shape + (erate*10000), expose$rate + 10000) 287 | # or b) equal to the estimated exposure at the services minimum 288 | # maxExposure <- qgamma(0.8, expose$shape + (erate*9.65), expose$rate + 9.65) 289 | # identify effort resulting in max exposure 290 | maxEffort <- exposure$x[exposure$y==maxExposure] 291 | # get costs associated with levels of effort producing maximum eagles and minimum costs 292 | minCosts <- cost(minEffort, erate, size, mrate, srate) 293 | maxCosts <- cost(maxEffort, erate, size, mrate, srate) 294 | return(data.frame(minCost = minCosts$T, 295 | minEffort = minEffort, 296 | minEagles = minCosts$E, 297 | minSurvey = minCosts$S, 298 | minMitigation = minCosts$M, 299 | maxCost = maxCosts$T, 300 | maxEffort = maxEffort, 301 | maxSurvey = maxCosts$S, 302 | maxMitigation = maxCosts$M, 303 | maxEagles = maxCosts$E)) 304 | } 305 | max_eagle <- function(erate, size, mrate, srate){ 306 | crv <- curve(cost(x, erate, size, mrate, srate)$E, 307 | from = 0, to = 100) 308 | stableEagle <- mean(crv$y[80:100]) - 0.1 309 | maxEffort <- min(crv$x[which(crv$y >= stableEagle)]) 310 | costs <- cost(maxEffort, erate, size, mrate, srate) 311 | # opt <-optimize(cost_fxn, interval = c(-1, 500), data = data.frame(erate = erate, size = size, mrate = mrate, srate = srate), maximum = TRUE) 312 | # return(data.frame(eagles = opt$objective, effort = opt$maximum)) 313 | return(data.frame(maxEffort = maxEffort, 314 | maxEagles = costs$E, 315 | maxSurvey = costs$S, 316 | maxMitigation = costs$M, 317 | maxCost = costs$T)) 318 | } 319 | 320 | #' Equation defining relationship between effort and discrepancy 321 | #' 322 | #'This assumes the mean of the gamma distribution is used 323 | #' @param erate inherent rate of eagle activity 324 | #' @param a shape parameter from exposure prior 325 | #' @param b rate parameter from exposure prior 326 | #' @param w effort 327 | #' @return numeric value 328 | effort_discrepancy_slope <- function(erate, a, b, w, n){ 329 | #turbines_to_size(n)*collide$shape/(collide$shape + collide$rate)*(a-(erate*b))/(b+w) 330 | expFac*n/100*(a-(erate*b))/(b+w) 331 | } 332 | 333 | #' w = 2ca - 2crb - b 334 | effort_needed <- function(nturbines, eagle_rate, threshold){ 335 | constant <- 1/threshold*expFac*nturbines/100 336 | (constant * expose$shape) - (constant*eagle_rate*expose$rate) - expose$rate 337 | } 338 | 339 | difffxn <- function(nturbines, obs_min, effort){ 340 | crm <- qgamma(0.8, expose$shape + obs_min, expose$rate + effort) 341 | siteonly <- qgamma(0.8, obs_min, effort) 342 | diff <- (crm - siteonly)*expFac*100*qbeta(0.8, collide$shape, collide$rate) 343 | return(diff) 344 | } 345 | 346 | testfxn <- function(erate, effort){ 347 | crm <- qgamma(0.8, expose$shape + (erate * effort), expose$rate + effort) 348 | site <- qgamma(0.8, erate*effort, effort) 349 | return(list('CRM' = crm, 'SITE' = site, 'DIFF' = crm-site)) 350 | } 351 | -------------------------------------------------------------------------------- /inst/eagles-fws/eaglesFWS_priors.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "FWS Eagle Mortality Model" 3 | author: "Center for Conservation Innovation" 4 | output: 5 | flexdashboard::flex_dashboard: 6 | css: www/dashboard.css 7 | social: menu 8 | df_print: paged 9 | navbar: 10 | - {title: "CCI", align: left, href: "https://cci-dev.org"} 11 | - {title: "Defenders", align: left, href: "http://www.defenders.org"} 12 | - {title: "", icon: "fa-question-circle fa-lg", align: right, href: "mailto:esa@defenders.org?subject=Five-year reviews app"} 13 | - {title: "", icon: "fa-github fa-lg", align: right, href: "https://github.com/Defenders-ESC/"} 14 | runtime: shiny 15 | --- 16 | 17 | ```{r setup, include=FALSE} 18 | knitr::opts_chunk$set(echo = FALSE) 19 | 20 | library(dplyr) 21 | library(DT) 22 | library(flexdashboard) 23 | library(googlesheets) 24 | library(ggplot2) 25 | library(plotly) 26 | library(shiny) 27 | library(viridis) 28 | 29 | load("data/app_data.RData") 30 | source("R/helper_fxns.R") 31 | #source("exposure.R") 32 | #source("fatality.R") 33 | 34 | prior <- curve(dgamma(x, shape = expose$shape, 35 | rate = 2.76),#expose$rate), 36 | from = 0.01, 37 | to = 6) 38 | 39 | priorb <- curve(dgamma(x, shape = expose$shape, 40 | rate = expose$rate), 41 | from = 0, 42 | to = 10) 43 | 44 | collision <- curve(dbeta(x, shape1 = collide$shape, shape2 = collide$rate), 45 | from = 0, 46 | to = 0.04) 47 | 48 | collisionb <- curve(dbeta(x, shape1 = collide$shape, shape2 = collide$rate), 49 | from = 0, 50 | to = 0.04) 51 | 52 | act <- mean(Bay16$FLIGHT_MIN)/mean(Bay16$EFFORT) 53 | 54 | tab <- select(Bay16, 55 | SITE, TURBINES, 56 | EFFORT, FLIGHT_MIN) 57 | 58 | dt <- DT::datatable(tab, 59 | fillContainer = TRUE, 60 | selection = list(mode = 'single', 61 | target = 'row'), 62 | colnames = c("Site", "Turbines", "Survey Effort (hr*km3)", 63 | "Eagle Obs (min)"), 64 | options = list(rownames = FALSE, 65 | pageLength = nrow(tab), 66 | dom = 'tip' 67 | ) 68 | )%>% 69 | formatRound("EFFORT", 2) 70 | 71 | # Create model dialog 72 | introModal <- modalDialog( 73 | title = h2("Bayesian Eagle Mortality Prediction"), 74 | p("The ", tags$a(href = "https://www.fws.gov/", "U.S. Fish and Wildlife Service")," uses a Bayesian model to estimate the number of bald and golden eagles likely to be killed by proposed wind projects. 75 | This approach combines surveys of eagle activity at proposed sites with prior information about eagle collision and activity rates across existing wind farms to estimate the likely number of fatalities."), 76 | br(), 77 | p("This dashboard allows you to explore how priors interact with survey data to produce predicted eagle fatalities at a set of wind energy sites. Eagle fatalities are predicted using four pieces of information obtained prior to construction:"), 78 | tags$ol( 79 | tags$li("Project Specs: the number and size of turbines."), 80 | tags$li("Survey Area: the size of the area surveyed for eagles."), 81 | tags$li("Survey Hours: time spent conducting eagle surveys."), 82 | tags$li("Flight Time: the total time eagles were observed flying within survey areas") 83 | ), 84 | easyClose = TRUE 85 | ) 86 | 87 | # create a button to show the modal 88 | expand <- actionButton("show", "Click for Details") 89 | observeEvent(input$show, 90 | {showModal(introModal)}) 91 | 92 | # define inputs 93 | selectTurbines <- numericInput('n', 94 | 'Number of Turbines', 95 | value = 100, 96 | min = 0, 97 | max = 1000, 98 | width = '100%') 99 | 100 | selectHours <- numericInput('t', 101 | 'Hours of Operation', 102 | value = 10, 103 | min = 8, 104 | max = 14, 105 | width = '100%') 106 | selectHeight <- numericInput('h', 107 | 'Turbine Height (m)', 108 | value = 200, 109 | min = 50, 110 | max = 300, 111 | width = '100%') 112 | 113 | selectRadius <- numericInput('r', 114 | 'Rotor Radius (m)', 115 | value = 30, 116 | min = 20, 117 | max = 100, 118 | width = '100%') 119 | 120 | plotSlider <- sliderInput("area", 121 | "Survey plots (#)", 122 | min = 0, 123 | max = 20, 124 | value = 1, 125 | step = 1) 126 | 127 | timeSlider <- sliderInput("hrs", 128 | "Survey Hours per plot", 129 | min = 0, 130 | max = 48, 131 | value = 1, 132 | step = 0.5) 133 | 134 | flightMin <- numericInput("min", 135 | "Flight Time (min)", 136 | value = 7, 137 | min = 0) 138 | 139 | # reactive functions using inputs to define model parameters 140 | cur_min <- reactive({input$min}) 141 | 142 | cur_effort <- reactive({input$hrs * (input$area) * 0.402}) 143 | 144 | cur_scale <- reactive({(input$t*365) * input$n * input$h/1000 * ((input$r/1000)^2) * pi}) 145 | 146 | a <- reactive({expose$shape + cur_min()}) 147 | b <- reactive({expose$rate + cur_effort()}) 148 | 149 | exposurePlot <- function(min, hours, area){ 150 | b <- hours*area 151 | post <- curve(dgamma(x, min + expose$shape, b+expose$rate), 152 | from = 0.01, to = 6) 153 | obs <- min/b 154 | plot_ly()%>% 155 | add_trace(name = 'Prior', 156 | x = prior$x, y = prior$y, 157 | type = "scatter", mode = "lines", fill = "tozeroy", 158 | line = list(color = vir_col(3)[1]), 159 | fillcolor = vir_col(3)[1], 160 | text = ~paste("Prior Activity
estimate = ", 161 | round(prior$x, 2), 162 | sep = ""), 163 | hoverinfo = "text")%>% 164 | add_trace(name = "Survey + prior", 165 | x = ~post$x, y = ~post$y, 166 | type = "scatter", mode = "lines", fill = "tozeroy", 167 | line = list(color = vir_col(3)[3]), 168 | fillcolor = vir_col(3)[3], 169 | text = ~paste("Combined Activity
estimate = ", 170 | round(post$x, 2), 171 | sep = ""), 172 | hoverinfo = "text")%>% 173 | add_trace(name = 'Observed', 174 | x = ~c(obs, obs), y = ~c(0,1.5),#max(c(prior$y,post$y))), 175 | type = "scatter", mode = "lines", 176 | line = list(color = 'black'), 177 | text = ~paste("Observed Activity
at site = ", 178 | round(act,2), 179 | sep = ""), 180 | hoverinfo = "text")%>% 181 | layout(#title = "Eagle Exposure", 182 | xaxis = list(title = "Eagle Activity (min/km3*hr)", 183 | range = c(0,6)), 184 | yaxis = list(title = "Probability Density"), 185 | legend = list(x = 0.7, 186 | y = 1)) 187 | } 188 | 189 | output$exposure <- renderPlotly({exposurePlot(input$min, input$hrs, input$area)}) 190 | ``` 191 | 192 | Inputs {.sidebar data-width=400} 193 | ==================== 194 | 195 | ### About 196 | 197 | This dashboard demonstrates the behavior of the Collision Risk Model used to predict eagle fatalities at proposed wind energy facilities. Click below for more details. 198 | 199 | ```{r expand, echo = FALSE} 200 | expand 201 | ``` 202 | 203 | ### Parameters 204 | 205 | Project specs: 206 | 207 | ```{r selector, echo = FALSE} 208 | column(6, selectTurbines, selectHours) 209 | 210 | column(6, selectHeight, selectRadius) 211 | ``` 212 | 213 | Survey area (FWS minimum = 1 plot ~ 201 ha) 214 | 215 | ```{r echo = FALSE} 216 | plotSlider 217 | ``` 218 | 219 | Survey time (FWS minimum = 24 hrs) 220 | 221 | ```{r echo = FALSE} 222 | timeSlider 223 | ``` 224 | 225 | Observed eagle flight time 226 | 227 | ```{r echo = FALSE} 228 | flightMin 229 | ``` 230 | 231 | `r hr()` 232 | 233 | ```{r calculate, echo = FALSE} 234 | actionButton("calculate", "Calculate Fatalities") 235 | helpText("Note: Calcuating predicted fatality distributions takes time. Please allow several seconds for the graph to load.") 236 | ``` 237 | 238 | `r hr()` 239 | === 240 | 241 | Column 242 | -------------------------------------------------------------------------- 243 | 244 | ### Eagle Activity 245 | 246 | ```{r exposures, echo = FALSE} 247 | # observeEvent(input$update, { 248 | # obs <- isolate({cur_min()/cur_effort()}) 249 | # post <- isolate({curve(dgamma(x, shape = a(), rate = b()), from = 0, to = 6)}) 250 | # 251 | # output$exposure <- renderPlotly({ 252 | # plot_ly()%>% 253 | # add_trace(name = 'Prior', 254 | # x = prior$x, y = prior$y, 255 | # type = "scatter", mode = "lines", fill = "tozeroy", 256 | # line = list(color = vir_col(3)[1]), 257 | # fillcolor = vir_col(3)[1], 258 | # text = ~paste("Prior Activity
estimate = ", 259 | # round(prior$x, 2), 260 | # sep = ""), 261 | # hoverinfo = "text")%>% 262 | # add_trace(name = "Survey + prior", 263 | # x = ~post$x, y = ~post$y, 264 | # type = "scatter", mode = "lines", fill = "tozeroy", 265 | # line = list(color = vir_col(3)[3]), 266 | # fillcolor = vir_col(3)[3], 267 | # text = ~paste("Combined Activity
estimate = ", 268 | # round(post$x, 2), 269 | # sep = ""), 270 | # hoverinfo = "text")%>% 271 | # add_trace(name = 'Observed', 272 | # x = ~c(obs, obs), y = ~c(0,1.5),#max(c(prior$y,post$y))), 273 | # type = "scatter", mode = "lines", 274 | # line = list(color = 'black'), 275 | # text = ~paste("Observed Activity
at site = ", 276 | # round(act,2), 277 | # sep = ""), 278 | # hoverinfo = "text")%>% 279 | # layout(#title = "Eagle Exposure", 280 | # xaxis = list(title = "Eagle Activity (min/km3*hr)", 281 | # range = c(0,6)), 282 | # yaxis = list(title = "Probability Density"), 283 | # legend = list(x = 0.7, 284 | # y = 1)) 285 | # }) 286 | # 287 | # }) 288 | 289 | plotlyOutput("exposure") 290 | ``` 291 | 292 | > Activity is the number of minutes eagles are observed flying within survey areas, per hour. 293 | 294 | ### Predicted Fatalities (_Click 'Predict Fatalities'_) 295 | 296 | ```{r fatalitiesb, echo = FALSE} 297 | observeEvent(input$calculate,{ 298 | #if(input$sites != ""){ 299 | outb <- isolate({simFatal(iters = 10000, BMin = cur_min(), SmpHrKm = cur_effort(), 300 | aPriExp=expose$shape, bPriExp=expose$rate, 301 | aPriCPr=collide$shape, bPriCPr=collide$rate)}) 302 | fatalityb <- isolate({density(outb$fatality*cur_scale())}) 303 | q80b <- isolate({quantile(outb$fatality*cur_scale(), 0.8)}) 304 | 305 | out2b <- isolate({simFatal(iters = 10000, BMin = cur_min(), SmpHrKm = cur_effort(), 306 | aPriExp = 0, bPriExp = 0, 307 | aPriCPr = collide$shape, bPriCPr = collide$rate)}) 308 | fatality2b <- isolate({density(out2b$fatality*cur_scale())}) 309 | q82b <- isolate({quantile(out2b$fatality*cur_scale(), c(0.8))}) 310 | 311 | output$fatalityb <- renderPlotly({ 312 | plot_ly()%>% 313 | add_trace(name = "Survey + prior", 314 | x = ~fatalityb$x, y = ~fatalityb$y, 315 | type = "scatter", mode = "lines", 316 | fill = "tozeroy", 317 | fillcolor = vir_col(3)[3], 318 | line = list(color = vir_col(3)[3]), 319 | text = ~paste("Probability of ", 320 | round(fatalityb$x, 2), 321 | " fatalities
using prior = ", 322 | round(fatalityb$y, 2), 323 | sep = ""), 324 | hoverinfo = "text")%>% 325 | add_trace(name = "80th Percentile", 326 | x = ~c(q80b, q80b), y = ~ c(0, max(fatalityb$y)), 327 | mode = 'lines', type = 'scatter', 328 | line = list(color = vir_col(3)[3]), 329 | text = ~paste('Annual FWS estimate
survey + prior =', 330 | round(q80b, 2)), 331 | hoverinfo = 'text' 332 | )%>% 333 | add_trace(name = "Survey only", 334 | x = ~fatality2b$x, y = ~fatality2b$y, 335 | type = "scatter", 336 | mode = "lines", 337 | fill = "tozeroy", 338 | line = list(color = vir_col(3)[2]), 339 | text = ~paste("Probability of ", 340 | round(fatality2b$x, 2), 341 | " fatalities
using survey data = ", 342 | round(fatality2b$y, 2), 343 | sep = ""), 344 | hoverinfo = "text")%>% 345 | add_trace(name = "80th Percentile", 346 | x = ~c(q82b, q82b), y = ~ c(0, max(fatality2b$y)), 347 | mode = 'lines', type = 'scatter', 348 | line = list(color = vir_col(3)[2]), 349 | text = ~paste('Annual FWS estimate
survey only =', 350 | round(q80b, 2)), 351 | hoverinfo = 'text' 352 | )%>% 353 | layout(##title = "Predicted Annual Eagle Fatalities", 354 | xaxis = list(title = "Fatalities per Year"), 355 | yaxis = list(title = "Probability Density"), 356 | legend = list(x = 0.7, 357 | y = 1)) 358 | }) 359 | output$textb <-renderText({ 360 | paste("For the proposed project observing ", input$min, "minutes of bald eagle flight time during ", input$hrs, " survey hours covering ", input$area, "(ha), the predicted take requiring mitigation is ", round(q80b, 1), " bald eagles using the update priors.") 361 | }) 362 | #} 363 | }) 364 | plotlyOutput('fatalityb') 365 | ``` 366 | -------------------------------------------------------------------------------- /inst/eagles-fws/eaglesFWS_playground.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "FWS Eagle Mortality Model" 3 | author: "Michael Evans, Defenders of Wildlife" 4 | output: 5 | flexdashboard::flex_dashboard: 6 | css: custom.css 7 | social: menu 8 | df_print: paged 9 | navbar: 10 | - {title: "CCI", align: left, href: "https://cci-dev.org"} 11 | - {title: "Defenders", align: left, href: "http://www.defenders.org"} 12 | - {title: "", icon: "fa-question-circle fa-lg", align: right, href: "mailto:esa@defenders.org?subject=Five-year reviews app"} 13 | - {title: "", icon: "fa-github fa-lg", align: right, href: "https://github.com/Defenders-ESC/"} 14 | runtime: shiny 15 | --- 16 | 17 | ```{r setup, include=FALSE} 18 | knitr::opts_chunk$set(echo = FALSE) 19 | 20 | library(dplyr) 21 | library(DT) 22 | library(flexdashboard) 23 | library(googlesheets) 24 | library(ggplot2) 25 | library(plotly) 26 | library(shiny) 27 | library(viridis) 28 | 29 | load("app_data.RData") 30 | source("helper_fxns.R") 31 | #source("exposure.R") 32 | #source("fatality.R") 33 | 34 | prior <- curve(dgamma(x, shape = 11.81641, 35 | rate = 9.765625), 36 | from = 0.5, 37 | to = 3) 38 | 39 | priorb <- curve(dgamma(x, shape = 1.52522, 40 | rate = 0.4781255), 41 | from = 0, 42 | to = 10) 43 | 44 | collision <- curve(dbeta(x, shape1 = 1.638029, shape2 = 290.0193), 45 | from = 0, 46 | to = 0.04) 47 | 48 | collisionb <- curve(dbeta(x, shape1 = 2.573610, shape2 = 366.3502), 49 | from = 0, 50 | to = 0.04) 51 | 52 | act <- mean(Bay16$FLIGHT_MIN)/mean(Bay16$EFFORT) 53 | 54 | scale <- glm(data = Bay16, (COLLISIONS/(FLIGHT_MIN/EFFORT))/0.002895415 ~ RISK_HA + I(RISK_HA^2)) 55 | 56 | tab <- select(Bay16, 57 | SITE, TURBINES, 58 | EFFORT, FLIGHT_MIN) 59 | 60 | dt <- DT::datatable(tab, 61 | fillContainer = TRUE, 62 | selection = list(mode = 'single', 63 | target = 'row'), 64 | colnames = c("Site", "Turbines", "Survey Effort (hr*km3)", 65 | "Eagle Obs (min)"), 66 | options = list(rownames = FALSE, 67 | pageLength = nrow(tab), 68 | dom = 'tip' 69 | ) 70 | )%>% 71 | formatRound("EFFORT", 2) 72 | ``` 73 | 74 | Inputs {.sidebar} 75 | ==================== 76 | Enter the proposed project specs: 77 | 78 | ```{r selector, echo = FALSE} 79 | column(6, 80 | numericInput('n', 'Number of Turbines', 81 | value = 100, 82 | min = 0, 83 | max = 1000, 84 | width = '100%'), 85 | numericInput('t', 'Hours of Operation', 86 | value = 10, 87 | min = 8, 88 | max = 14, 89 | width = '100%') 90 | ) 91 | column(6, 92 | numericInput('h', 'Turbine Height (m)', 93 | value = 200, 94 | min = 100, 95 | max = 300, 96 | width = '100%'), 97 | numericInput('r', 'Rotor Radius (m)', 98 | value = 30, 99 | min = 20, 100 | max = 100, 101 | width = '100%') 102 | ) 103 | #numericInput('size', 104 | # "Project Area (ha)", 105 | # value = round(mean(Bay16$RISK_HA), 0), 106 | # min = 0, 107 | # max = 500, 108 | # step = 1 109 | # ) 110 | ``` 111 | 112 | Area surveyed for eagles. FWS requres at least one cylindrical plot of 800m radius (201 ha) by 200m height. 113 | 114 | ```{r echo = FALSE} 115 | sliderInput("area", 116 | "Survey Area (ha)", 117 | min = 0, 118 | max = 2010, 119 | value = 201, 120 | step = 201) 121 | ``` 122 | 123 | Time spent surveying. FWS requires at least 12 hrs per year, for two years. 124 | 125 | ```{r echo = FALSE} 126 | sliderInput("hrs", 127 | "Survey Hours", 128 | min = 0, 129 | max = 240, 130 | value = 24, 131 | step = 12) 132 | ``` 133 | 134 | Enter the amount of time eagles were observed flying within survey cylinders. 135 | 136 | ```{r echo = FALSE} 137 | numericInput("min", 138 | "Flight Time (min)", 139 | value = 7, 140 | min = 0) 141 | 142 | 143 | 144 | #cur_min <- reactive({Bay16$FLIGHT_MIN[Bay16$SITE == input$sites]}) 145 | cur_min <- reactive({input$min}) 146 | #cur_effort <- reactive({Bay16$EFFORT[Bay16$SITE == input$sites]}) 147 | cur_effort <- reactive({input$hrs * (input$area * 0.01) * 0.2}) 148 | #cur_scale <- reactive({Bay16$SCALE[Bay16$SITE == input$sites]}) 149 | cur_scale <- reactive({(input$t*365) * input$n * input$h/1000 * ((input$r/1000)^2) * pi}) 150 | #cur_scale <- reactive({-362.57580 + (input$size*33.38994) + ((input$size^2)*-0.03774)}) 151 | a <- reactive({11.81641 + cur_min()}) 152 | b <- reactive({9.7656250 + cur_effort()}) 153 | ab <- reactive({1.52522 + cur_min()}) 154 | bb <- reactive({0.4781255 + cur_min()}) 155 | ``` 156 | 157 | 158 | ```{r update, echo = FALSE} 159 | actionButton("update", "Update Distributions") 160 | ``` 161 | 162 | `r hr()` 163 | 164 | ```{r calculate, echo = FALSE} 165 | actionButton("calculate", "Calculate Fatalities") 166 | 167 | ``` 168 | 169 | `r hr()` 170 | 171 | ```{r note, echo = FALSE} 172 | helpText("Note: Calcuating predicted fatality distributions takes time. Please allow several seconds for the graph to load.") 173 | ``` 174 | 175 | #Golden Eagles 176 | 177 | Column {data-width = 500} 178 | -------------------------------------------------------------------------- 179 | 180 | ### Prior Probabilities of Eagle Collision Rates 181 | 182 | ```{r collisions, echo = FALSE} 183 | 184 | modalDialog( 185 | title = h2("Bayesian Eagle Mortality Prediction"), 186 | p("The ", tags$a(href = "https://www.fws.gov/", "U.S. Fish and Wildlife Service")," uses a Bayesian model to estimate the number of bald and golden eagles likely to be killed by proposed wind projects. 187 | This approach combines surveys of eagle activity at proposed sites with prior information about eagle collision and activity rates across existing wind farms to estimate the likely number of fatalities."), 188 | br(), 189 | p("This dashboard allows you to explore how priors interact with survey data to produce predicted eagle fatalities at a set of wind energy sites. Eagle fatalities are predicted using four pieces of information obtained prior to construction:"), 190 | tags$ol( 191 | tags$li("Project Specs: the number and size of turbines."), 192 | tags$li("Survey Area: the size of the area surveyed for eagles."), 193 | tags$li("Survey Hours: time spent conducting eagle surveys."), 194 | tags$li("Flight Time: the total time eagles were observed flying within survey areas") 195 | ), 196 | p("The tabs at the top of the page allow you to switch between golden and bald eagle estimates."), 197 | easyClose = TRUE 198 | ) 199 | 200 | renderPlotly({ 201 | plot_ly()%>% 202 | add_trace(x = ~collision$x, y = ~collision$y, type = "scatter", mode = "lines", 203 | fill = "tozeroy", name = "Prior", line = list(color = "grey"), 204 | text = ~paste("Prior probability of Collision Rate = ", 205 | round(collision$x, 3), 206 | "
is ", 207 | round(collision$y, 3), 208 | sep = ""), 209 | hoverinfo = "text")%>% 210 | layout(#title = "Prior Collision Rates", 211 | xaxis = list(title = "Collision Rate (per Exposure)", 212 | range = 0, 0.01), 213 | yaxis = list(title = "Probability Density")) 214 | }) 215 | 216 | #ggplot(Bay16, aes(x = EFFORT, y = OBS_MIN))+ 217 | # geom_point() 218 | #renderPlotly({ 219 | #ggplotly() 220 | #}) 221 | ``` 222 | 223 | ### Eagle Activity (_Click 'Update Distributions'_) 224 | 225 | ```{r exposures, echo = FALSE} 226 | observeEvent(input$update, { 227 | act <- isolate({cur_min()/cur_effort()}) 228 | obs <- isolate({density(rgamma(10000, 229 | shape = a(), 230 | rate = b() 231 | ) 232 | ) 233 | }) 234 | 235 | output$exposure <- renderPlotly({ 236 | plot_ly()%>% 237 | add_trace(x = ~c(act, act), y = ~c(0,max(c(prior$y,obs$y))), 238 | type = "scatter", mode = "lines", 239 | name = "Observed", line = list(color = vir_col(3)[2]), 240 | text = ~paste("Observed Activity
at site = ", 241 | round(act,2), 242 | sep = ""), 243 | hoverinfo = "text")%>% 244 | add_trace(x = prior$x, y = prior$y, 245 | type = "scatter", mode = "lines", fill = "tozeroy", 246 | name = "Prior", line = list(color = vir_col(3)[1]), 247 | text = ~paste("Prior Activity
estimate = ", 248 | round(prior$x, 2), 249 | sep = ""), 250 | hoverinfo = "text")%>% 251 | add_trace(x = ~obs$x, y = ~obs$y, 252 | type = "scatter", mode = "lines", fill = "tozeroy", 253 | name = "Combined", line = list(color = vir_col(3)[3]), 254 | text = ~paste("Combined Activity
estimate = ", 255 | round(obs$x, 2), 256 | sep = ""), 257 | hoverinfo = "text")%>% 258 | layout(#title = "Eagle Exposure", 259 | xaxis = list(title = "Eagle Activity (min/km3*hr)", 260 | range = c(0,10)), 261 | yaxis = list(title = "Probability Density"), 262 | legend = list(x = 0.7, 263 | y = 1)) 264 | }) 265 | 266 | }) 267 | 268 | plotlyOutput("exposure") 269 | ``` 270 | 271 | > Activity is the number of minutes eagles are observed flying within survey areas, per hour. 272 | 273 | ### Predicted Fatalities (_Click 'Predict Fatalities'_) 274 | 275 | ```{r fatalities, echo = FALSE} 276 | observeEvent(input$calculate,{ 277 | #if(input$sites != ""){ 278 | out <- isolate({simFatal(iters = 10000, BMin = cur_min(), SmpHrKm = cur_effort(), 279 | aPriExp=11.81641, bPriExp=9.7656250, 280 | aPriCPr=1.638029, bPriCPr=290.0193)}) 281 | fatality <- isolate({density(out$fatality*cur_scale())}) 282 | q80 <- isolate({quantile(out$fatality*cur_scale(), 0.8)}) 283 | 284 | out2 <- isolate({simFatal(iters = 10000, BMin = cur_min(), SmpHrKm = cur_effort(), 285 | aPriExp = 0, bPriExp = 0, 286 | aPriCPr = 1.638029, bPriCPr = 290.0193)}) 287 | fatality2 <- isolate({density(out2$fatality*cur_scale())}) 288 | q82 <- isolate({quantile(out2$fatality*cur_scale(), c(0.8))}) 289 | 290 | output$fatality <- renderPlotly({ 291 | plot_ly()%>% 292 | add_trace(x = ~fatality$x, y = ~fatality$y, type = "scatter", mode = "lines", 293 | fill = "tozeroy", 294 | name = "Incl. Prior Exposure", line = list(color = vir_col(3)[3]), 295 | text = ~paste("Predicted fatalities
incorporating prior = ", 296 | round(fatality$x, 2), 297 | sep = ""), 298 | hoverinfo = "text")%>% 299 | add_trace(x = ~c(q80, q80), y = ~ c(0, max(fatality$y)), 300 | mode = 'lines', type = 'scatter', 301 | line = list(color = vir_col(3)[3]), 302 | name = "80th Percentile")%>% 303 | add_trace(x = ~fatality2$x, y = ~fatality2$y, type = "scatter", 304 | mode = "lines", 305 | fill = "tozeroy", 306 | line = list(color = vir_col(3)[2]), 307 | name = "Using Site Survey Only", 308 | text = ~paste("Predicted fatalities
from site survey = ", 309 | round(fatality2$x, 2), 310 | sep = ""), 311 | hoverinfo = "text")%>% 312 | add_trace(x = ~c(q82, q82), y = ~ c(0, max(fatality2$y)), 313 | mode = 'lines', type = 'scatter', 314 | line = list(color = vir_col(3)[2]), 315 | name = "80th Percentile")%>% 316 | layout(##title = "Predicted Annual Eagle Fatalities", 317 | xaxis = list(title = "Fatalities per Year"), 318 | yaxis = list(title = "Probability Density"), 319 | legend = list(x = 0.7, 320 | y = 1)) 321 | }) 322 | output$text <-renderText({ 323 | paste("For the proposed project observing ", input$min, "minutes of eagle flight time during ", input$hrs, " survey hours covering ", input$area, "(ha), the predicted take requiring mitigation is ", round(q80, 1), " golden eagles using the update priors.") 324 | }) 325 | #} 326 | }) 327 | plotlyOutput('fatality') 328 | ``` 329 | 330 | Column {data-width=500} 331 | ------------------------------------------------------------------------- 332 | 333 | ### FWS Survey Data {data-height=700} 334 | 335 | ```{r datatable, echo = FALSE} 336 | DT::renderDataTable({dt}) 337 | ``` 338 | 339 | ### Results {data-height=300} 340 | 341 | ```{r output, echo = FALSE} 342 | span(textOutput('text'), style='color:blue; font-size:18px') 343 | ``` 344 | 345 | > Data taken from Appendix S1 in [Bay et al. (2016). The Journal of Wildlife Management 80(6): 1000-1010](http://onlinelibrary.wiley.com/doi/10.1002/jwmg.21086/full). 346 | 347 | # Bald Eagles 348 | 349 | Column {data-width = 500} 350 | -------------------------------------------------------------------------- 351 | 352 | ### Prior Probabilities of Eagle Collision Rates 353 | 354 | ```{r collisionsb, echo = FALSE} 355 | 356 | renderPlotly({ 357 | plot_ly()%>% 358 | add_trace(x = ~collisionb$x, y = ~collisionb$y, type = "scatter", mode = "lines", 359 | fill = "tozeroy", name = "Prior", line = list(color = "grey"), 360 | text = ~paste("Prior probability of Collision Rate = ", 361 | round(collisionb$x, 3), 362 | "
is ", 363 | round(collisionb$y, 3), 364 | sep = ""), 365 | hoverinfo = "text")%>% 366 | layout(#title = "Prior Collision Rates", 367 | xaxis = list(title = "Collision Rate (per Exposure)", 368 | range = 0, 0.01), 369 | yaxis = list(title = "Probability Density")) 370 | }) 371 | 372 | #ggplot(Bay16, aes(x = EFFORT, y = OBS_MIN))+ 373 | # geom_point() 374 | #renderPlotly({ 375 | #ggplotly() 376 | #}) 377 | ``` 378 | 379 | ### Eagle Activity (_Click 'Update Distributions'_) 380 | 381 | ```{r exposuresb, echo = FALSE} 382 | observeEvent(input$update, { 383 | act <- isolate({cur_min()/cur_effort()}) 384 | obs <- isolate({density(rgamma(10000, 385 | shape = ab(), 386 | rate = bb() 387 | ) 388 | ) 389 | }) 390 | 391 | output$exposureb <- renderPlotly({ 392 | plot_ly()%>% 393 | add_trace(x = ~c(act, act), y = ~c(0,max(c(priorb$y,obs$y))), 394 | type = "scatter", mode = "lines", 395 | name = "Observed", line = list(color = vir_col(3)[2]), 396 | text = ~paste("Observed Activity
at site = ", 397 | round(act,2), 398 | sep = ""), 399 | hoverinfo = "text")%>% 400 | add_trace(x = priorb$x, y = priorb$y, 401 | type = "scatter", mode = "lines", fill = "tozeroy", 402 | name = "Prior", line = list(color = vir_col(3)[1]), 403 | text = ~paste("Prior Activity
estimate = ", 404 | round(priorb$x, 2), 405 | sep = ""), 406 | hoverinfo = "text")%>% 407 | add_trace(x = ~obs$x, y = ~obs$y, 408 | type = "scatter", mode = "lines", fill = "tozeroy", 409 | name = "Combined", line = list(color = vir_col(3)[3]), 410 | text = ~paste("Combined Activity
estimate = ", 411 | round(obs$x, 2), 412 | sep = ""), 413 | hoverinfo = "text")%>% 414 | layout(#title = "Eagle Exposure", 415 | xaxis = list(title = "Eagle Activity (min/km3*hr)", 416 | range = c(0,10)), 417 | yaxis = list(title = "Probability Density"), 418 | legend = list(x = 0.7, 419 | y = 1)) 420 | }) 421 | 422 | }) 423 | 424 | plotlyOutput("exposureb") 425 | ``` 426 | 427 | > Activity is the number of minutes eagles are observed flying within survey areas, per hour. 428 | 429 | ### Predicted Fatalities (_Click 'Predict Fatalities'_) 430 | 431 | ```{r fatalitiesb, echo = FALSE} 432 | observeEvent(input$calculate,{ 433 | #if(input$sites != ""){ 434 | outb <- isolate({simFatal(iters = 10000, BMin = cur_min(), SmpHrKm = cur_effort(), 435 | aPriExp=1.52522, bPriExp=0.4781255, 436 | aPriCPr=2.573610, bPriCPr=366.3502)}) 437 | fatalityb <- isolate({density(outb$fatality*cur_scale())}) 438 | q80b <- isolate({quantile(outb$fatality*cur_scale(), 0.8)}) 439 | 440 | out2b <- isolate({simFatal(iters = 10000, BMin = cur_min(), SmpHrKm = cur_effort(), 441 | aPriExp = 0, bPriExp = 0, 442 | aPriCPr = 2.573610, bPriCPr = 366.3502)}) 443 | fatality2b <- isolate({density(out2b$fatality*cur_scale())}) 444 | q82b <- isolate({quantile(out2b$fatality*cur_scale(), c(0.8))}) 445 | 446 | output$fatalityb <- renderPlotly({ 447 | plot_ly()%>% 448 | add_trace(x = ~fatalityb$x, y = ~fatalityb$y, type = "scatter", mode = "lines", 449 | fill = "tozeroy", 450 | name = "Incl. Prior Exposure", line = list(color = vir_col(3)[3]), 451 | text = ~paste("Predicted fatalities
incorporating prior = ", 452 | round(fatalityb$x, 2), 453 | sep = ""), 454 | hoverinfo = "text")%>% 455 | add_trace(x = ~c(q80b, q80b), y = ~ c(0, max(fatalityb$y)), 456 | mode = 'lines', type = 'scatter', 457 | line = list(color = vir_col(3)[3]), 458 | name = "80th Percentile")%>% 459 | add_trace(x = ~fatality2b$x, y = ~fatality2b$y, type = "scatter", 460 | mode = "lines", 461 | fill = "tozeroy", 462 | line = list(color = vir_col(3)[2]), 463 | name = "Using Site Survey Only", 464 | text = ~paste("Predicted fatalities
from site survey = ", 465 | round(fatality2b$x, 2), 466 | sep = ""), 467 | hoverinfo = "text")%>% 468 | add_trace(x = ~c(q82b, q82b), y = ~ c(0, max(fatality2b$y)), 469 | mode = 'lines', type = 'scatter', 470 | line = list(color = vir_col(3)[2]), 471 | name = "80th Percentile")%>% 472 | layout(##title = "Predicted Annual Eagle Fatalities", 473 | xaxis = list(title = "Fatalities per Year"), 474 | yaxis = list(title = "Probability Density"), 475 | legend = list(x = 0.7, 476 | y = 1)) 477 | }) 478 | output$textb <-renderText({ 479 | paste("For the proposed project observing ", input$min, "minutes of bald eagle flight time during ", input$hrs, " survey hours covering ", input$area, "(ha), the predicted take requiring mitigation is ", round(q80b, 1), " bald eagles using the update priors.") 480 | }) 481 | #} 482 | }) 483 | plotlyOutput('fatalityb') 484 | ``` 485 | 486 | Column {data-width=500} 487 | ------------------------------------------------------------------------- 488 | 489 | ### FWS Survey Data {data-height=700} 490 | 491 | ```{r datatableb, echo = FALSE} 492 | DT::renderDataTable({dt}) 493 | ``` 494 | 495 | ### Results {data-height=300} 496 | 497 | ```{r outputb, echo = FALSE} 498 | span(textOutput('textb'), style='color:blue; font-size:18px') 499 | ``` 500 | 501 | > Data taken from Appendix S1 in [Bay et al. (2016). The Journal of Wildlife Management 80(6): 1000-1010](http://onlinelibrary.wiley.com/doi/10.1002/jwmg.21086/full). 502 | -------------------------------------------------------------------------------- /R/analysisv2.R: -------------------------------------------------------------------------------- 1 | library(Deriv) 2 | library(plyr) 3 | library(dplyr) 4 | library(plotly) 5 | library(reshape2) 6 | library(stringr) 7 | library(tidyr) 8 | library(rv) 9 | library(viridis) 10 | 11 | # load helper functions 12 | source("R/helper_fxns.R") 13 | 14 | # SIMULATION DATA 15 | # create a range of underlying eagle activity rates (min/hr*km3) 16 | erate <- seq(0, 3, 0.1) 17 | 18 | # Survey time in hours - 24 to 240 hours 19 | time <- seq(0, 240, 24) 20 | 21 | #Survey area in km3 - 1 to five plots 22 | area <- seq(0.402, 2.01, 0.402) 23 | 24 | # Create dataframe including all combinations of survey time, area, and eagle activity 25 | df <- expand.grid(TIME = time, AREA = area, erate = erate)%>% 26 | # Effort is time(hrs)*area(km3) 27 | mutate(b = TIME*AREA)%>% 28 | # Calculate observed eagle activity in min 29 | mutate(a = b*erate) 30 | 31 | # create supplemental dataframe to illustrate behavior at low efforts 32 | suppDf <- expand.grid(TIME = seq(0, 24, 2), AREA = area, erate = erate)%>% 33 | mutate(b = TIME*AREA)%>% 34 | mutate(a = b*erate) 35 | 36 | df <- bind_rows(df, suppDf)%>% 37 | mutate(index = paste(a, b, sep = "_"))%>% 38 | filter(!duplicated(index)) 39 | 40 | 41 | rm(suppDf) 42 | # save our simulated scenarios 43 | saveRDS(df, file = 'data/simData.rds') 44 | 45 | # Predict fatalities with and without using priors for simulated scenarios 46 | sim <- plyr::mdply(df[,c(5, 4)], estimates, niters = 10000, nturbines = 200)%>% 47 | # add erate, TIME, AREA columns 48 | bind_cols(df[, 1:3]) 49 | 50 | colnames(sim) <- c("a", "b", "CRM_mean", "CRM_80", 'Survey_mean', "Survey_80", 'time', 'area', 'erate') 51 | 52 | # save outputs 53 | saveRDS(sim, file = 'data/simResults_5May21.rds') 54 | 55 | # Evaluate cases where there are zero eagles observed 56 | zeroest <- function(iters, Effort, ExpFac){ 57 | out <- simFatal(BMin = 0, 58 | Fatal = -1, 59 | SmpHrKm = Effort, 60 | ExpFac = ExpFac, 61 | aPriExp = expose$shape, 62 | bPriExp = expose$rate, 63 | aPriCPr = collide$shape, 64 | bPriCPr = collide$rate, 65 | iters = iters) 66 | fatality <- mean(out$fatality) 67 | q80 <- quantile(out$fatality, c(0.8)) 68 | return (c("CRM_mean" = fatality, "CRM_80" = q80)) 69 | } 70 | 71 | # Create a simulated dataset of varying efforts at different project sizes 72 | zerodf <- expand.grid(Time = time, Area = area, nTurb = seq(50, 400, 50))%>% 73 | mutate(Effort = Time * Area, ExpFac = turbines_to_size(nTurb, 100, 50)) 74 | 75 | # Predict fatalities using priors assuming no eagles are observed 76 | zerosim <- plyr::mdply(zerodf[, 4:5], zeroest, iters = 10000) 77 | colnames(zerosim)[4] <- "CRM_80" 78 | # zerosim$ExpFac <- zerodf$ExpFac 79 | # save zerosim data 80 | saveRDS(zerosim, file = 'data/zeroSim_5May21.rds') 81 | 82 | #COST BENEFIT ANALYSIS 83 | # Create a simulation dataset of project sizes and true eagle activity rates 84 | # For testing purposes, assume all turbines are 100m tall w/50m blades 85 | test_values <- expand.grid(erate = seq(0,3,0.05), 86 | size = turbines_to_size(seq(20, 500, 20), 100, 50)) 87 | 88 | #Read in table of total mitigation costs per eagle from ABT report for different durations & cost estimates 89 | cost_table <- read.csv(file = 'data/ABT_REA_costs.csv', header = TRUE) 90 | 91 | # create dataframe of levels of effort 92 | effort_df <- data.frame(effort = seq(0, 200, 2)) 93 | 94 | # create a subset of scenarios for generating a lattice plot of cost/effort curves 95 | sub_test <- filter(test_values, erate %in% c(0, 0.5, 1.0, 1.5, 2.0, 2.5), 96 | size %in% turbines_to_size(c(20, 40, 100, 200, 400), 100, 50)) 97 | 98 | #Estimated survey cost data from West Ecosystems Inc. 99 | survey_costs <- list('annual_low_ppt' = 2000, 'annual_high_ppt' = 5000, 100 | "Low" = 2000/12, 'High' = 5000/12, 101 | 'annual_low_pMW' = 300, 'annual_high_pMW' = 600) 102 | 103 | #From Adt report 104 | retro_costs <- list('Low_ppole' = 1040, 'High_ppole' = 2590) 105 | electro_rates <- list('Low' = 0.0036, 'Median' = 0.0051, 'High' = 0.0066) 106 | 107 | durations <- c(10, 20, 30, 40, 50) 108 | 109 | retro_cost <- filter(cost_table, Duration == 30, Rate == 'Median') 110 | 111 | low_low <- mutate(test_values, mrate = retro_cost[retro_cost$Cost == 'Low', 'M'], srate = survey_costs$Low)%>% 112 | plyr::mdply(high_high[, 1:4], wrapper) 113 | low_high <- mutate(test_values, mrate = retro_cost[retro_cost$Cost == 'Low', 'M'], srate = survey_costs$High)%>% 114 | plyr::mdply(high_high[, 1:4], wrapper) 115 | high_low <- mutate(test_values, mrate = retro_cost[retro_cost$Cost == 'High', 'M'], srate = survey_costs$Low)%>% 116 | plyr::mdply(high_high[, 1:4], wrapper) 117 | high_high <- mutate(test_values, mrate = retro_cost[retro_cost$Cost == 'High', 'M'], srate = survey_costs$High)%>% 118 | plyr::mdply(high_high[, 1:4], wrapper) 119 | 120 | # PLOTS 121 | # load our output datsets 122 | sim <- readRDS(file = 'data/simResults_5May21.rds') 123 | zerosim <- readRDS(file = 'data/zeroSim_5May21.rds') 124 | high_high <- read.csv(file = 'data/high_high5May21.csv', header = TRUE, stringsAsFactors = FALSE)%>% 125 | mutate(maxEagleMitigation = mrate*maxEagle, 126 | maxEagleSurvey = maxEagleEffort *srate, 127 | maxEagleCost = maxEagleMitigation + maxEagleSurvey) 128 | # axis format 129 | tickfont = list(family = 'serif', color = 'black', size = 14) 130 | ax <- list( 131 | titlefont = list(family = 'serif', color = 'black', size = 18), 132 | tickfont = list(family = 'serif', color = 'black', size = 14), 133 | zerolinewidth = 2, 134 | zerolinecolor = 'black', 135 | showgrid = FALSE 136 | ) 137 | 138 | # colorbar format 139 | leg <- list( 140 | font = list(family = 'serif', color = 'black', size = 14) 141 | ) 142 | 143 | # define annotation for FWS minimum survey effort 144 | a <- list( 145 | x = 10, 146 | y = 0, 147 | text = 'FWS minimum', 148 | font = list(family = 'serif', color = 'black', size = 12), 149 | xref = "x", 150 | yref = "y", 151 | xanchor = 'left', 152 | showarrow = TRUE, 153 | arrowhead = 0, 154 | ay = -60 155 | ) 156 | 157 | #Scatter plot estimates with priors vs. without priors for simulated data. Color by eagle rate, size by effort. 1:1 Line for comparison 158 | fig1a <- plot_ly(filter(sim, b > 0, b < 100))%>% 159 | add_trace(y = ~CRM_80, x = ~Survey_80, size = ~b, 160 | type = "scatter", mode = "markers", 161 | marker = list(line = list(color = "black"), 162 | sizemode = "diameter" 163 | ), 164 | sizes = c(5,15), color = ~ erate, 165 | name = "Survey effort", 166 | text = ~paste("Effort =", round(b, 3), "hr*km3", "
Eagles =", erate), 167 | hoverinfo = "text")%>% 168 | add_trace(x = ~c(0, max(CRM_80)), y = ~c(0, max(CRM_80)), 169 | type = "scatter", mode = "lines", name = "1:1 Line")%>% 170 | colorbar(x = 0.8, y = 0.6, title = 'Eagle exposure
(min/hr*km3)', 171 | titlefont = list(family = 'serif', color = 'black', size = 16), 172 | tickfont = tickfont)%>% 173 | #add_trace(x = ~c(0.002, 0.006), y = ~c(0.004, 0.004), type = "scatter", mode = "lines", name = "Mean")%>% 174 | layout(hovermode = "closest", font = list(color = "black"), 175 | yaxis = append(list(title = 'Fatalities estimated with priors'), ax), 176 | xaxis = append(list(title = 'Fatalities estimated without priors'), ax), 177 | legend = list(x = 0.10, y = 0.95, bordercolor = "black", borderwidth = 1, 178 | font = list(family = 'serif', size = 16, color = 'black'), 179 | showgridlines = FALSE)) 180 | 181 | #scatter plot |Standard deviance| between priors and site-specific estimates as a function of eagle activity. Color by effort 182 | fig1b <- plot_ly(filter(sim, b >0, b %% 9.648 == 0))%>% 183 | add_trace(x = ~erate, y = ~(CRM_80-Survey_80)/Survey_80, 184 | type = "scatter", mode = "markers", 185 | color = ~ b, 186 | marker = list(colorbar = list(title = "Survey Effort
(hr*km3)") 187 | ), 188 | text = ~paste("Effort =", round(b, 3), "hr*km3
Eagles =", a, "(min)
Deviance = ", (CRM_80-Survey_80)/Survey_80), 189 | hoverinfo = 'text')%>% 190 | colorbar(x = 0.8, y = 0.8, 191 | title = 'Survey effort
(hr*km3)', 192 | titlefont = list(family = 'serif', color = 'black', size = 16))%>% 193 | layout(hovermode = 'closest', 194 | font = list(color = 'black'), 195 | xaxis = append(list(title = "Eagle activity rate (min/hr*km3)"), ax), 196 | yaxis = append(list(title = "Standardized deviance"), ax) 197 | ) 198 | 199 | #Plot deviance between estimates using priors and site-specific estimate as a function of survey effort from simulated data. Color by eagle rate 200 | fig2a <- plot_ly(filter(sim, erate%%0.2 == 0))%>% 201 | add_trace(x = ~b, y = ~(CRM_80-Survey_80), type = "scatter", mode = "markers", 202 | color = ~ erate, 203 | marker = list(colorbar = list(title = "Eagle Obs
(min)")), 204 | text = ~paste("Effort =", round(b, 3), "hr*km3", "
Eagles =", erate, "
Delta =", round(CRM_80 - Survey_80, 2)), 205 | hoverinfo = 'text')%>% 206 | colorbar(title = 'Eagle exposure
(min/hr*km3)', 207 | x = 0.5, xanchor = 'left', y = 0.6, yanchor = 'bottom', 208 | titlefont = list(family = 'serif', size = 14, color = 'black'), 209 | tickfont = tickfont, 210 | len = 0.4)%>% 211 | layout(hovermode = 'closest', 212 | annotations = a, 213 | font = list(color = 'black'), 214 | xaxis = append(list(title = "Survey effort (hr*km3)"), ax), 215 | yaxis = append(list(title = "Difference in estimated fatalities (# eagles)", range = c(-2,2)), ax) 216 | ) 217 | 218 | 219 | #PLOT FOR ZERO OBSERVED EAGLES 220 | fig2b <- plot_ly(data = zerosim, type = 'scatter', mode = 'markers')%>% 221 | add_trace( 222 | x = ~Effort, y = ~CRM_80, 223 | color = ~ExpFac/expFac, 224 | showlegend = FALSE, 225 | #marker = list(colorbar = list(x = 0.7, y = 1, title = "Project
Size (ha)")), 226 | hoverinfo = 'text', 227 | text = ~paste("Effort:", Effort, "hr*km3", "
Project Size:", ExpFac/expFac, "turbines", "
Fatalities:", round(CRM_80, 1), "eagles"))%>% 228 | add_trace( 229 | x = ~Effort, y = ~CRM_80, 230 | color = ~ExpFac/expFac, 231 | xaxis = 'x2', 232 | yaxis = 'y2', 233 | showlegend = FALSE 234 | )%>% 235 | colorbar(x = 0.8, y = 1, title = 'Project size
(# turbines)
', 236 | titlefont = list(family = 'serif', size = 14, color = 'black'), 237 | tickfont = tickfont)%>% 238 | layout(legend = list(x = 0.7, y = 1), 239 | annotations = append(a, list(ax = 20)), 240 | xaxis = append(list(title = "Effort (hr*km3)"), ax), 241 | yaxis = append(list(title = "Estimated eagle fatalities"), ax), 242 | xaxis2 = append(list(range = c(0,100), domain = c(0.2, 0.9), anchor = 'y2'), ax), 243 | yaxis2 = append(list(range = c(0, 0.5), domain = c(0.4, 0.7), anchor = 'x2'), ax)) 244 | 245 | #' Create line plots showing cost vs. effort curves 246 | #' @param erate true eagle activity rate (min/hr*km3) 247 | #' @param nturb number of turbines at hypothetical project 248 | #' @param mcost assumed per-retrofit mitigation cost 249 | #' @param scost assumed per-hour survey cost 250 | #' @return plotly line plot 251 | #' @example 252 | #' plot_curves(2, 200, retro_costs$High, survey_costs$High) 253 | plot_curves <- function(erate, nturb, mcost, scost){ 254 | size <- nturb*expFac 255 | mitigation <- size*(erate*qbeta(0.8, collide$shape, collide$rate)) 256 | output <- plyr::mdply(effort_df, cost_curve, erate, size, mcost, scost) 257 | min_effort <- output$effort[output$T == min(output$T)] 258 | plot_ly(data = output, type = 'scatter', mode = 'lines')%>% 259 | add_trace( 260 | x = ~effort, y = ~T, 261 | #line = list(color = cols[(i-1)%/%6], width = ((i-1)%%6 +1)), 262 | line = list(color = 'orange'), 263 | showlegend = TRUE, 264 | name = 'Total' 265 | )%>% 266 | add_trace( 267 | x = ~effort, y = ~M, 268 | #line = list(color = cols[(i-1)%/%6], width = ((i-1)%%6 +1), dash = 'dash'), 269 | line = list(color = 'grey', dash = 'dash'), 270 | showlegend = TRUE, 271 | name = "Mitigation" 272 | )%>% 273 | add_trace( 274 | x = ~effort, y = ~S, 275 | #line = list(color = cols[(i-1)%/%6], width = ((i-1)%%6 +1), dash = 'dot'), 276 | line = list(color = 'blue', dash = 'dot'), 277 | showlegend = TRUE, 278 | name = 'Survey' 279 | )%>% 280 | add_trace( 281 | x = c(min_effort, min_effort), y = c(0, max(output$T)), 282 | line = list(color = 'black', width = 1), 283 | name = paste('Min cost effort (', min_effort, ' hrs)', sep = "") 284 | )%>% 285 | add_trace( 286 | x = ~effort, y = ~ -abs((mitigation*mcost) - M), 287 | name = '$/eagle', 288 | yaxis = 'y2' 289 | )%>% 290 | layout( 291 | xaxis = list(title = 'Survey effort (hr*km3)'), 292 | yaxis = list(title = 'Cost ($)'), 293 | #annotations = a, 294 | legend = list(x = 0.2, y = 1), 295 | yaxis2 = list(overlaying = 'y', side = 'right') 296 | ) 297 | } 298 | 299 | # Lattice of example curves showing effort/cost relationships at a variety of scenarios 300 | multiplot <- function(i){ 301 | retro_cost <- filter(cost_table, Duration == 30, Rate == 'Median', Cost == 'High')$M 302 | x <- seq(0, 100, 1) 303 | cst <- curve(cost(x, sub_test$erate[i], sub_test$size[i], retro_cost, survey_costs$Low)[['T']], 304 | from = 0, to = 100) 305 | mon <- curve(cost(x, sub_test$erate[i], sub_test$size[i], retro_cost, survey_costs$Low)[['M']], 306 | from = 0, to = 100) 307 | surv <- curve(cost(x, sub_test$erate[i], sub_test$size[i], retro_cost, survey_costs$Low)[['S']], 308 | from = 0, to = 100) 309 | cols <- viridis(5) 310 | plot_ly(type = 'scatter', mode = 'lines')%>% 311 | add_trace( 312 | x = cst$x, y = cst$y, 313 | #line = list(color = cols[(i-1)%/%6], width = ((i-1)%%6 +1)), 314 | line = list(color = 'orange'), 315 | showlegend = FALSE, 316 | name = 'Total' 317 | )%>% 318 | add_trace( 319 | x = mon$x, y = mon$y, 320 | #line = list(color = cols[(i-1)%/%6], width = ((i-1)%%6 +1), dash = 'dash'), 321 | line = list(color = 'grey', dash = 'dash'), 322 | showlegend = FALSE, 323 | name = "Mitigation" 324 | )%>% 325 | add_trace( 326 | x = surv$x, y = surv$y, 327 | #line = list(color = cols[(i-1)%/%6], width = ((i-1)%%6 +1), dash = 'dot'), 328 | line = list(color = 'blue', dash = 'dot'), 329 | showlegend = FALSE, 330 | name = 'Survey' 331 | )#%>% 332 | # add_trace( 333 | # x = c(10, 10), y = c(0, max(cst$y)), 334 | # line = list(color = 'black', width = 1), 335 | # showlegend = FALSE 336 | # ) 337 | } 338 | 339 | fig3 <- subplot(lapply(1:nrow(sub_test), multiplot), 340 | nrows = 5, shareY = TRUE, 341 | titleY = TRUE, shareX =TRUE,titleX= TRUE)%>% 342 | layout(yaxis = append(list(title = '', type = 'log', range = c(0, 6)), ax), 343 | yaxis2 = append(list(title = '', type = 'log', range = c(0, 6)),ax), 344 | yaxis3 = append(list(title = 'Cost ($)', type = 'log', range = c(0, 6)), ax), 345 | yaxis4 = append(list(title = '', type = 'log', range = c(0, 6)),ax), 346 | yaxis5 = append(list(title = '', type = 'log', range = c(0, 6)),ax), 347 | xaxis = append(list(title = ''),ax), 348 | xaxis2 = append(list(title = ''),ax), 349 | xaxis3 = append(list(title = 'Survey effort (hr*km3)'), ax), 350 | xaxis4 = append(list(title = ''),ax), 351 | xaxis5 = append(list(title = ''),ax), 352 | xaxis6 = append(list(title = ''),ax)) 353 | 354 | # fig 4a - difference in mitigation between min and max eagle estimates 355 | fig4a <- plot_ly( 356 | type = 'heatmap', 357 | z = acast(mutate(high_high, diff = ifelse(minCostEffort == 0, maxEagleMitigation - (minEagle*mrate), (maxEagleMitigation - (minEagle*mrate))*-1)), erate~size, value.var = 'diff'), 358 | # z = acast(mutate(high_high, diff = (minCostEffort*srate)- maxEagleSurvey), erate~size, value.var = 'diff'), 359 | # z = acast(mutate(high_high, diff = ifelse(minCostEffort == 0, maxEagleCost - minCost, (maxEagleCost - minCost)*-1)), erate~size, value.var = "diff"), 360 | y = seq(0,2,0.05), 361 | x = seq(20,500,20), 362 | # zmin = -400000, zmax = 400000, 363 | zmin = -250000, zmax = 1000000, 364 | colors = colorRamp(c('black', 'white')))%>% 365 | add_trace(type = 'contour', 366 | y = seq(0,2,0.05), 367 | x = seq(20,500,20), 368 | # z = acast(mutate(high_high, diff = ifelse(minCostEffort == 0, maxEagle-minEagle, (maxEagle - minEagle)*-1)), erate~size, value.var = "diff"), 369 | zmin = -250000, 370 | zmax = 1000000, 371 | autocontour = F, 372 | contours = list( 373 | end = 750000, 374 | start = -250000, 375 | size = 250000, 376 | # showlabels = TRUE, 377 | coloring = 'none', 378 | labelfont = list(family = 'serif', color = 'white', size = 12) 379 | ), 380 | line = list( 381 | smoothing = 1,color = 'white', 382 | width = 2), 383 | #colorscale = list(list(0, '#FFFFFF00'), list(0.5,'#FFFFFF00'), list(1,'#FFFFFF00')), 384 | showscale = FALSE, 385 | showlegend = FALSE)%>% 386 | colorbar(title = 'Mitigation
cost ($)', 387 | titlefont = list(family = 'serif', color = 'black', size = 14), 388 | tickfont = list(family = 'serif', color = 'black', size = 12), 389 | tick0 = -250000, 390 | dtick = 250000)%>% 391 | layout( 392 | yaxis = append(list(title = 'Eagle exposure (min/hr*km3)'), ax), 393 | xaxis = append(list(title = 'Facility size (# turbines)'), ax) 394 | ) 395 | 396 | # fig 4b - difference in survey costs between min and max eagles 397 | fig4b <- plot_ly( 398 | type = 'heatmap', 399 | # z = acast(mutate(high_high, diff = ifelse(minCostEffort == 0, maxEagleMitigation - (minEagle*mrate), (maxEagleMitigation - (minEagle*mrate))*-1)), erate~size, value.var = 'diff'), 400 | z = acast(mutate(high_high, diff = (minCostEffort*srate)-maxEagleSurvey), erate~size, value.var = 'diff'), 401 | # z = acast(mutate(high_high, diff = ifelse(minCostEffort == 0, maxEagleCost - minCost, (maxEagleCost - minCost)*-1)), erate~size, value.var = "diff"), 402 | y = seq(0,2,0.05), 403 | x = seq(20,500,20), 404 | # zmin = -400000, zmax = 400000, 405 | zmin = -250000, zmax = 1000000, 406 | colors = colorRamp(c('black', 'white')))%>% 407 | add_trace(type = 'contour', 408 | y = seq(0,2,0.05), 409 | x = seq(20,500,20), 410 | # z = acast(mutate(high_high, diff = ifelse(minCostEffort == 0, maxEagle-minEagle, (maxEagle - minEagle)*-1)), erate~size, value.var = "diff"), 411 | zmin = -250000, 412 | zmax = 1000000, 413 | autocontour = F, 414 | contours = list( 415 | end = 1000000, 416 | start = -1000000, 417 | size = 1000000, 418 | # showlabels = TRUE, 419 | coloring = 'none', 420 | labelfont = list(family = 'serif', color = 'white', size = 12) 421 | ), 422 | line = list( 423 | smoothing = 1,color = 'white', 424 | width = 2), 425 | #colorscale = list(list(0, '#FFFFFF00'), list(0.5,'#FFFFFF00'), list(1,'#FFFFFF00')), 426 | showscale = FALSE, 427 | showlegend = FALSE)%>% 428 | colorbar(title = 'Survey
cost ($)', 429 | titlefont = list(family = 'serif', color = 'black', size = 14), 430 | tickfont = list(family = 'serif', color = 'black', size = 12), 431 | tick0 = -250000, 432 | dtick = 250000)%>% 433 | layout( 434 | yaxis = append(list(title = 'Eagle exposure (min/hr*km3)'), ax), 435 | xaxis = append(list(title = 'Facility size (# turbines)'), ax) 436 | ) 437 | 438 | # fig 4c - difference in total costs between min and max eagles 439 | fig4c <- plot_ly( 440 | type = 'heatmap', 441 | # z = acast(mutate(high_high, diff = ifelse(minCostEffort == 0, maxEagleMitigation - (minEagle*mrate), (maxEagleMitigation - (minEagle*mrate))*-1)), erate~size, value.var = 'diff'), 442 | # z = acast(mutate(high_high, diff = maxEagleSurvey-(minCostEffort*srate)), erate~size, value.var = 'diff'), 443 | z = acast(mutate(high_high, diff = ifelse(minCostEffort == 0, maxEagleCost - minCost, (maxEagleCost - minCost)*-1)), erate~size, value.var = "diff"), 444 | y = seq(0,2,0.05), 445 | x = seq(20,500,20), 446 | zmin = -250000, zmax = 1000000, 447 | colors = colorRamp(c('black', 'white')))%>% 448 | add_trace(type = 'contour', 449 | y = seq(0,2,0.05), 450 | x = seq(20,500,20), 451 | # z = acast(mutate(high_high, diff = ifelse(minCostEffort == 0, maxEagle-minEagle, (maxEagle - minEagle)*-1)), erate~size, value.var = "diff"), 452 | zmin = -250000, 453 | zmax = 1000000, 454 | autocontour = F, 455 | contours = list( 456 | end = 750000, 457 | start = -250000, 458 | size = 250000, 459 | # showlabels = TRUE, 460 | coloring = 'none', 461 | labelfont = list(family = 'serif', color = 'white', size = 12) 462 | ), 463 | line = list( 464 | smoothing = 1,color = 'white', 465 | width = 2), 466 | #colorscale = list(list(0, '#FFFFFF00'), list(0.5,'#FFFFFF00'), list(1,'#FFFFFF00')), 467 | showscale = FALSE, 468 | showlegend = FALSE)%>% 469 | colorbar(title = 'Total
cost ($)', 470 | titlefont = list(family = 'serif', color = 'black', size = 14), 471 | tickfont = list(family = 'serif', color = 'black', size = 12), 472 | tick0 = -250000, 473 | dtick = 250000)%>% 474 | layout( 475 | yaxis = append(list(title = 'Eagle exposure (min/hr*km3)'), ax), 476 | xaxis = append(list(title = 'Facility size (# turbines)'), ax) 477 | ) 478 | # Fig. 4d - difference between min max eagles 479 | fig4d <- plot_ly( 480 | type = 'heatmap', 481 | z = acast(mutate(high_high, diff = ifelse(minCostEffort == 0, maxEagle-minEagle, (maxEagle - minEagle)*-1)), erate~size, value.var = "diff"), 482 | y = seq(0,2,0.05), 483 | x = seq(20,500,20), 484 | zmin = -10, zmax = 25, 485 | colors = colorRamp(c('black', 'white')))%>% 486 | add_trace(type = 'contour', 487 | y = seq(0,2,0.05), 488 | x = seq(20,500,20), 489 | z = acast(mutate(high_high, diff = ifelse(minCostEffort == 0, maxEagle-minEagle, (maxEagle - minEagle)*-1)), erate~size, value.var = "diff"), 490 | zmin = -10, 491 | zmax = 25, 492 | autocontour = F, 493 | contours = list( 494 | end = 15, 495 | start = -5, 496 | size = 5, 497 | # showlabels = TRUE, 498 | coloring = 'none', 499 | labelfont = list(family = 'serif', color = 'white', size = 14) 500 | ), 501 | line = list( 502 | smoothing = 1,color = 'white', 503 | width = 2), 504 | # colorscale = list(list(0, '#FFFFFF00'), list(0.5,'#FFFFFF00'), list(1,'#FFFFFF00')), 505 | showscale = FALSE, 506 | showlegend = FALSE)%>% 507 | colorbar(title = 'Eagle
fatalities', 508 | titlefont = list(family = 'serif', color = 'black', size = 14), 509 | tickfont = list(family = 'serif', color = 'black', size = 12), 510 | tick0 = -10, 511 | dtick = 5)%>% 512 | layout( 513 | yaxis = append(list(title = 'Eagle exposure (min/hr*km3)'), ax), 514 | xaxis = append(list(title = 'Facility size (# turbines)'), ax) 515 | ) 516 | 517 | # add orca command line utility to R environmental path 518 | Sys.setenv("PATH" = paste(Sys.getenv("PATH"), "C:\\Users\\mevans\\AppData\\Local\\Programs\\orca", sep = .Platform$path.sep)) 519 | 520 | # Write figures to file for manuscript 521 | orca(fig1a, file = 'Fig1.png', format = tools::file_ext('png'), scale = 10) 522 | orca(fig1b, file = 'Fig1b.png', format = tools::file_ext('png'), scale = 20) 523 | orca(fig2a, file = 'Fig2a.png', format = tools::file_ext('png'), scale = 10, height = 500, width = 1000) 524 | orca(fig2b, file = 'Fig2b.png', format = tools::file_ext('png'), scale = 10, height = 500, width = 1000) 525 | orca(fig3, file = 'Fig3.png', format = tools::file_ext('png'), scale = 10) 526 | orca(fig4a, file = 'Fig4a.png', format = tools::file_ext('png'), scale = 10) 527 | orca(fig4b, file = 'Fig4b.png', format = tools::file_ext('png'), scale = 10) 528 | orca(fig4c, file = 'Fig4c.png', format = tools::file_ext('png'), scale = 10) 529 | orca(fig4d, file = 'Fig4d.png', format = tools::file_ext('png'), scale = 10) 530 | --------------------------------------------------------------------------------