In mjevans26/eaglesFWS:
knitr::opts_chunk$set(echo = FALSE)
library(dplyr)
library(DT)
library(flexdashboard)
library(googlesheets)
library(ggplot2)
library(plotly)
library(shiny)
library(viridis)
load("data/app_data.RData")
source("R/helper_fxns.R")
#source("exposure.R")
#source("fatality.R")
prior <- curve(dgamma(x, shape = expose$shape,
rate = 2.76),#expose$rate),
from = 0.01,
to = 6)
priorb <- curve(dgamma(x, shape = expose$shape,
rate = expose$rate),
from = 0,
to = 10)
collision <- curve(dbeta(x, shape1 = collide$shape, shape2 = collide$rate),
from = 0,
to = 0.04)
collisionb <- curve(dbeta(x, shape1 = collide$shape, shape2 = collide$rate),
from = 0,
to = 0.04)
act <- mean(Bay16$FLIGHT_MIN)/mean(Bay16$EFFORT)
tab <- select(Bay16,
SITE, TURBINES,
EFFORT, FLIGHT_MIN)
dt <- DT::datatable(tab,
fillContainer = TRUE,
selection = list(mode = 'single',
target = 'row'),
colnames = c("Site", "Turbines", "Survey Effort (hr*km3)",
"Eagle Obs (min)"),
options = list(rownames = FALSE,
pageLength = nrow(tab),
dom = 'tip'
)
)%>%
formatRound("EFFORT", 2)
# Create model dialog
introModal <- modalDialog(
title = h2("Bayesian Eagle Mortality Prediction"),
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.
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."),
br(),
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:"),
tags$ol(
tags$li("Project Specs: the number and size of turbines."),
tags$li("Survey Area: the size of the area surveyed for eagles."),
tags$li("Survey Hours: time spent conducting eagle surveys."),
tags$li("Flight Time: the total time eagles were observed flying within survey areas")
),
easyClose = TRUE
)
# create a button to show the modal
expand <- actionButton("show", "Click for Details")
observeEvent(input$show,
{showModal(introModal)})
# define inputs
selectTurbines <- numericInput('n',
'Number of Turbines',
value = 100,
min = 0,
max = 1000,
width = '100%')
selectHours <- numericInput('t',
'Hours of Operation',
value = 10,
min = 8,
max = 14,
width = '100%')
selectHeight <- numericInput('h',
'Turbine Height (m)',
value = 200,
min = 50,
max = 300,
width = '100%')
selectRadius <- numericInput('r',
'Rotor Radius (m)',
value = 30,
min = 20,
max = 100,
width = '100%')
plotSlider <- sliderInput("area",
"Survey plots (#)",
min = 0,
max = 20,
value = 1,
step = 1)
timeSlider <- sliderInput("hrs",
"Survey Hours per plot",
min = 0,
max = 48,
value = 1,
step = 0.5)
flightMin <- numericInput("min",
"Flight Time (min)",
value = 7,
min = 0)
# reactive functions using inputs to define model parameters
cur_min <- reactive({input$min})
cur_effort <- reactive({input$hrs * (input$area) * 0.402})
cur_scale <- reactive({(input$t*365) * input$n * input$h/1000 * ((input$r/1000)^2) * pi})
a <- reactive({expose$shape + cur_min()})
b <- reactive({expose$rate + cur_effort()})
exposurePlot <- function(min, hours, area){
b <- hours*area
post <- curve(dgamma(x, min + expose$shape, b+expose$rate),
from = 0.01, to = 6)
obs <- min/b
plot_ly()%>%
add_trace(name = 'Prior',
x = prior$x, y = prior$y,
type = "scatter", mode = "lines", fill = "tozeroy",
line = list(color = vir_col(3)[1]),
fillcolor = vir_col(3)[1],
text = ~paste("Prior Activity<br>estimate = ",
round(prior$x, 2),
sep = ""),
hoverinfo = "text")%>%
add_trace(name = "Survey + prior",
x = ~post$x, y = ~post$y,
type = "scatter", mode = "lines", fill = "tozeroy",
line = list(color = vir_col(3)[3]),
fillcolor = vir_col(3)[3],
text = ~paste("Combined Activity<br>estimate = ",
round(post$x, 2),
sep = ""),
hoverinfo = "text")%>%
add_trace(name = 'Observed',
x = ~c(obs, obs), y = ~c(0,1.5),#max(c(prior$y,post$y))),
type = "scatter", mode = "lines",
line = list(color = 'black'),
text = ~paste("Observed Activity<br>at site = ",
round(act,2),
sep = ""),
hoverinfo = "text")%>%
layout(#title = "Eagle Exposure",
xaxis = list(title = "Eagle Activity (min/km<sup>3</sup>*hr)",
range = c(0,6)),
yaxis = list(title = "Probability Density"),
legend = list(x = 0.7,
y = 1))
}
output$exposure <- renderPlotly({exposurePlot(input$min, input$hrs, input$area)})
Inputs {.sidebar data-width=400}
About
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.
expand
Parameters
Project specs:
column(6, selectTurbines, selectHours)
column(6, selectHeight, selectRadius)
Survey area (FWS minimum = 1 plot ~ 201 ha)
plotSlider
Survey time (FWS minimum = 24 hrs)
timeSlider
Observed eagle flight time
flightMin
r hr()
actionButton("calculate", "Calculate Fatalities")
helpText("Note: Calcuating predicted fatality distributions takes time. Please allow several seconds for the graph to load.")
r hr()
Column
Eagle Activity
# observeEvent(input$update, {
# obs <- isolate({cur_min()/cur_effort()})
# post <- isolate({curve(dgamma(x, shape = a(), rate = b()), from = 0, to = 6)})
#
# output$exposure <- renderPlotly({
# plot_ly()%>%
# add_trace(name = 'Prior',
# x = prior$x, y = prior$y,
# type = "scatter", mode = "lines", fill = "tozeroy",
# line = list(color = vir_col(3)[1]),
# fillcolor = vir_col(3)[1],
# text = ~paste("Prior Activity<br>estimate = ",
# round(prior$x, 2),
# sep = ""),
# hoverinfo = "text")%>%
# add_trace(name = "Survey + prior",
# x = ~post$x, y = ~post$y,
# type = "scatter", mode = "lines", fill = "tozeroy",
# line = list(color = vir_col(3)[3]),
# fillcolor = vir_col(3)[3],
# text = ~paste("Combined Activity<br>estimate = ",
# round(post$x, 2),
# sep = ""),
# hoverinfo = "text")%>%
# add_trace(name = 'Observed',
# x = ~c(obs, obs), y = ~c(0,1.5),#max(c(prior$y,post$y))),
# type = "scatter", mode = "lines",
# line = list(color = 'black'),
# text = ~paste("Observed Activity<br>at site = ",
# round(act,2),
# sep = ""),
# hoverinfo = "text")%>%
# layout(#title = "Eagle Exposure",
# xaxis = list(title = "Eagle Activity (min/km<sup>3</sup>*hr)",
# range = c(0,6)),
# yaxis = list(title = "Probability Density"),
# legend = list(x = 0.7,
# y = 1))
# })
#
# })
plotlyOutput("exposure")
Activity is the number of minutes eagles are observed flying within survey areas, per hour.
Predicted Fatalities (Click 'Predict Fatalities')
observeEvent(input$calculate,{
#if(input$sites != ""){
outb <- isolate({simFatal(iters = 10000, BMin = cur_min(), SmpHrKm = cur_effort(),
aPriExp=expose$shape, bPriExp=expose$rate,
aPriCPr=collide$shape, bPriCPr=collide$rate)})
fatalityb <- isolate({density(outb$fatality*cur_scale())})
q80b <- isolate({quantile(outb$fatality*cur_scale(), 0.8)})
out2b <- isolate({simFatal(iters = 10000, BMin = cur_min(), SmpHrKm = cur_effort(),
aPriExp = 0, bPriExp = 0,
aPriCPr = collide$shape, bPriCPr = collide$rate)})
fatality2b <- isolate({density(out2b$fatality*cur_scale())})
q82b <- isolate({quantile(out2b$fatality*cur_scale(), c(0.8))})
output$fatalityb <- renderPlotly({
plot_ly()%>%
add_trace(name = "Survey + prior",
x = ~fatalityb$x, y = ~fatalityb$y,
type = "scatter", mode = "lines",
fill = "tozeroy",
fillcolor = vir_col(3)[3],
line = list(color = vir_col(3)[3]),
text = ~paste("Probability of ",
round(fatalityb$x, 2),
" fatalities<br>using prior = ",
round(fatalityb$y, 2),
sep = ""),
hoverinfo = "text")%>%
add_trace(name = "80th Percentile",
x = ~c(q80b, q80b), y = ~ c(0, max(fatalityb$y)),
mode = 'lines', type = 'scatter',
line = list(color = vir_col(3)[3]),
text = ~paste('Annual FWS estimate<br>survey + prior =',
round(q80b, 2)),
hoverinfo = 'text'
)%>%
add_trace(name = "Survey only",
x = ~fatality2b$x, y = ~fatality2b$y,
type = "scatter",
mode = "lines",
fill = "tozeroy",
line = list(color = vir_col(3)[2]),
text = ~paste("Probability of ",
round(fatality2b$x, 2),
" fatalities<br>using survey data = ",
round(fatality2b$y, 2),
sep = ""),
hoverinfo = "text")%>%
add_trace(name = "80th Percentile",
x = ~c(q82b, q82b), y = ~ c(0, max(fatality2b$y)),
mode = 'lines', type = 'scatter',
line = list(color = vir_col(3)[2]),
text = ~paste('Annual FWS estimate<br>survey only =',
round(q80b, 2)),
hoverinfo = 'text'
)%>%
layout(##title = "Predicted Annual Eagle Fatalities",
xaxis = list(title = "Fatalities per Year"),
yaxis = list(title = "Probability Density"),
legend = list(x = 0.7,
y = 1))
})
output$textb <-renderText({
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.")
})
#}
})
plotlyOutput('fatalityb')
mjevans26/eaglesFWS documentation built on Dec. 29, 2021, 1:35 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
knitr::opts_chunk$set(echo = FALSE) library(dplyr) library(DT) library(flexdashboard) library(googlesheets) library(ggplot2) library(plotly) library(shiny) library(viridis) load("data/app_data.RData") source("R/helper_fxns.R") #source("exposure.R") #source("fatality.R") prior <- curve(dgamma(x, shape = expose$shape, rate = 2.76),#expose$rate), from = 0.01, to = 6) priorb <- curve(dgamma(x, shape = expose$shape, rate = expose$rate), from = 0, to = 10) collision <- curve(dbeta(x, shape1 = collide$shape, shape2 = collide$rate), from = 0, to = 0.04) collisionb <- curve(dbeta(x, shape1 = collide$shape, shape2 = collide$rate), from = 0, to = 0.04) act <- mean(Bay16$FLIGHT_MIN)/mean(Bay16$EFFORT) tab <- select(Bay16, SITE, TURBINES, EFFORT, FLIGHT_MIN) dt <- DT::datatable(tab, fillContainer = TRUE, selection = list(mode = 'single', target = 'row'), colnames = c("Site", "Turbines", "Survey Effort (hr*km3)", "Eagle Obs (min)"), options = list(rownames = FALSE, pageLength = nrow(tab), dom = 'tip' ) )%>% formatRound("EFFORT", 2) # Create model dialog introModal <- modalDialog( title = h2("Bayesian Eagle Mortality Prediction"), 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. 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."), br(), 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:"), tags$ol( tags$li("Project Specs: the number and size of turbines."), tags$li("Survey Area: the size of the area surveyed for eagles."), tags$li("Survey Hours: time spent conducting eagle surveys."), tags$li("Flight Time: the total time eagles were observed flying within survey areas") ), easyClose = TRUE ) # create a button to show the modal expand <- actionButton("show", "Click for Details") observeEvent(input$show, {showModal(introModal)}) # define inputs selectTurbines <- numericInput('n', 'Number of Turbines', value = 100, min = 0, max = 1000, width = '100%') selectHours <- numericInput('t', 'Hours of Operation', value = 10, min = 8, max = 14, width = '100%') selectHeight <- numericInput('h', 'Turbine Height (m)', value = 200, min = 50, max = 300, width = '100%') selectRadius <- numericInput('r', 'Rotor Radius (m)', value = 30, min = 20, max = 100, width = '100%') plotSlider <- sliderInput("area", "Survey plots (#)", min = 0, max = 20, value = 1, step = 1) timeSlider <- sliderInput("hrs", "Survey Hours per plot", min = 0, max = 48, value = 1, step = 0.5) flightMin <- numericInput("min", "Flight Time (min)", value = 7, min = 0) # reactive functions using inputs to define model parameters cur_min <- reactive({input$min}) cur_effort <- reactive({input$hrs * (input$area) * 0.402}) cur_scale <- reactive({(input$t*365) * input$n * input$h/1000 * ((input$r/1000)^2) * pi}) a <- reactive({expose$shape + cur_min()}) b <- reactive({expose$rate + cur_effort()}) exposurePlot <- function(min, hours, area){ b <- hours*area post <- curve(dgamma(x, min + expose$shape, b+expose$rate), from = 0.01, to = 6) obs <- min/b plot_ly()%>% add_trace(name = 'Prior', x = prior$x, y = prior$y, type = "scatter", mode = "lines", fill = "tozeroy", line = list(color = vir_col(3)[1]), fillcolor = vir_col(3)[1], text = ~paste("Prior Activity<br>estimate = ", round(prior$x, 2), sep = ""), hoverinfo = "text")%>% add_trace(name = "Survey + prior", x = ~post$x, y = ~post$y, type = "scatter", mode = "lines", fill = "tozeroy", line = list(color = vir_col(3)[3]), fillcolor = vir_col(3)[3], text = ~paste("Combined Activity<br>estimate = ", round(post$x, 2), sep = ""), hoverinfo = "text")%>% add_trace(name = 'Observed', x = ~c(obs, obs), y = ~c(0,1.5),#max(c(prior$y,post$y))), type = "scatter", mode = "lines", line = list(color = 'black'), text = ~paste("Observed Activity<br>at site = ", round(act,2), sep = ""), hoverinfo = "text")%>% layout(#title = "Eagle Exposure", xaxis = list(title = "Eagle Activity (min/km<sup>3</sup>*hr)", range = c(0,6)), yaxis = list(title = "Probability Density"), legend = list(x = 0.7, y = 1)) } output$exposure <- renderPlotly({exposurePlot(input$min, input$hrs, input$area)})
Inputs {.sidebar data-width=400}
About
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.
expand
Parameters
Project specs:
column(6, selectTurbines, selectHours) column(6, selectHeight, selectRadius)
Survey area (FWS minimum = 1 plot ~ 201 ha)
plotSlider
Survey time (FWS minimum = 24 hrs)
timeSlider
Observed eagle flight time
flightMin
r hr()
actionButton("calculate", "Calculate Fatalities") helpText("Note: Calcuating predicted fatality distributions takes time. Please allow several seconds for the graph to load.")
r hr()
Column
Eagle Activity
# observeEvent(input$update, { # obs <- isolate({cur_min()/cur_effort()}) # post <- isolate({curve(dgamma(x, shape = a(), rate = b()), from = 0, to = 6)}) # # output$exposure <- renderPlotly({ # plot_ly()%>% # add_trace(name = 'Prior', # x = prior$x, y = prior$y, # type = "scatter", mode = "lines", fill = "tozeroy", # line = list(color = vir_col(3)[1]), # fillcolor = vir_col(3)[1], # text = ~paste("Prior Activity<br>estimate = ", # round(prior$x, 2), # sep = ""), # hoverinfo = "text")%>% # add_trace(name = "Survey + prior", # x = ~post$x, y = ~post$y, # type = "scatter", mode = "lines", fill = "tozeroy", # line = list(color = vir_col(3)[3]), # fillcolor = vir_col(3)[3], # text = ~paste("Combined Activity<br>estimate = ", # round(post$x, 2), # sep = ""), # hoverinfo = "text")%>% # add_trace(name = 'Observed', # x = ~c(obs, obs), y = ~c(0,1.5),#max(c(prior$y,post$y))), # type = "scatter", mode = "lines", # line = list(color = 'black'), # text = ~paste("Observed Activity<br>at site = ", # round(act,2), # sep = ""), # hoverinfo = "text")%>% # layout(#title = "Eagle Exposure", # xaxis = list(title = "Eagle Activity (min/km<sup>3</sup>*hr)", # range = c(0,6)), # yaxis = list(title = "Probability Density"), # legend = list(x = 0.7, # y = 1)) # }) # # }) plotlyOutput("exposure")
Activity is the number of minutes eagles are observed flying within survey areas, per hour.
Predicted Fatalities (Click 'Predict Fatalities')
observeEvent(input$calculate,{ #if(input$sites != ""){ outb <- isolate({simFatal(iters = 10000, BMin = cur_min(), SmpHrKm = cur_effort(), aPriExp=expose$shape, bPriExp=expose$rate, aPriCPr=collide$shape, bPriCPr=collide$rate)}) fatalityb <- isolate({density(outb$fatality*cur_scale())}) q80b <- isolate({quantile(outb$fatality*cur_scale(), 0.8)}) out2b <- isolate({simFatal(iters = 10000, BMin = cur_min(), SmpHrKm = cur_effort(), aPriExp = 0, bPriExp = 0, aPriCPr = collide$shape, bPriCPr = collide$rate)}) fatality2b <- isolate({density(out2b$fatality*cur_scale())}) q82b <- isolate({quantile(out2b$fatality*cur_scale(), c(0.8))}) output$fatalityb <- renderPlotly({ plot_ly()%>% add_trace(name = "Survey + prior", x = ~fatalityb$x, y = ~fatalityb$y, type = "scatter", mode = "lines", fill = "tozeroy", fillcolor = vir_col(3)[3], line = list(color = vir_col(3)[3]), text = ~paste("Probability of ", round(fatalityb$x, 2), " fatalities<br>using prior = ", round(fatalityb$y, 2), sep = ""), hoverinfo = "text")%>% add_trace(name = "80th Percentile", x = ~c(q80b, q80b), y = ~ c(0, max(fatalityb$y)), mode = 'lines', type = 'scatter', line = list(color = vir_col(3)[3]), text = ~paste('Annual FWS estimate<br>survey + prior =', round(q80b, 2)), hoverinfo = 'text' )%>% add_trace(name = "Survey only", x = ~fatality2b$x, y = ~fatality2b$y, type = "scatter", mode = "lines", fill = "tozeroy", line = list(color = vir_col(3)[2]), text = ~paste("Probability of ", round(fatality2b$x, 2), " fatalities<br>using survey data = ", round(fatality2b$y, 2), sep = ""), hoverinfo = "text")%>% add_trace(name = "80th Percentile", x = ~c(q82b, q82b), y = ~ c(0, max(fatality2b$y)), mode = 'lines', type = 'scatter', line = list(color = vir_col(3)[2]), text = ~paste('Annual FWS estimate<br>survey only =', round(q80b, 2)), hoverinfo = 'text' )%>% layout(##title = "Predicted Annual Eagle Fatalities", xaxis = list(title = "Fatalities per Year"), yaxis = list(title = "Probability Density"), legend = list(x = 0.7, y = 1)) }) output$textb <-renderText({ 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.") }) #} }) plotlyOutput('fatalityb')
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.