Last active
December 17, 2021 02:41
-
-
Save TonyLadson/fffaee298888267b214065451884952b to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| # | |
| # This is a Shiny web application. You can run the application by clicking | |
| # the 'Run App' button above. | |
| # | |
| # Find out more about building applications with Shiny here: | |
| # | |
| # http://shiny.rstudio.com/ | |
| # | |
| library(shiny) | |
| library(stringr) | |
| # Functions --------------------------------------------------------------- | |
| # Load parameters | |
| region_names <- | |
| c("East Coast North", "Semi-arid Inland QLD", "Tasmania", "SW WA", | |
| "Central NSW", "SE Coast", "Southern Semi-arid", "Southern Temperate", | |
| "Northern Coastal", "Inland Arid") | |
| params <- | |
| structure(list(`East Coast North` = c(0.327, 0.241, 0.448, 0.36, 0.00096, 0.48, -0.21, 0.012, -0.0013), | |
| `Semi-arid Inland QLD` = c(0.159, 0.283, 0.25, 0.308, 7.3e-07, 1, 0.039, 0, 0), | |
| Tasmania = c(0.0605, 0.347, 0.2, 0.283, 0.00076, 0.347, 0.0877, 0.012, -0.00033), | |
| `SW WA` = c(0.183, 0.259, 0.271, 0.33, 3.845e-06, 0.41, 0.55, 0.00817, -0.00045), | |
| `Central NSW` = c(0.265, 0.241, 0.505, 0.321, 0.00056, 0.414, -0.021, 0.015, -0.00033), | |
| `SE Coast` = c(0.06, 0.361, 0, 0.317, 8.11e-05, 0.651, 0, 0, 0), | |
| `Southern Semi-arid` = c(0.254, 0.247, 0.403, 0.351, 0.0013, 0.302, 0.058, 0, 0), | |
| `Southern Temperate` = c(0.158, 0.276, 0.372, 0.315, 0.000141, 0.41, 0.15, 0.01, -0.0027), | |
| `Northern Coastal` = c(0.326, 0.223, 0.442, 0.323, 0.0013, 0.58, -0.374, 0.013, -0.0015), | |
| `Inland Arid` = c(0.297, 0.234, 0.449, 0.344, 0.00142, 0.216, 0.129, 0, 0)), | |
| class = "data.frame", row.names = c("a", "b", "c", "d", "e", "f", "g", "h", "i")) | |
| ARF_long <- function(area, duration, aep, region, params) { | |
| # Area in km-squre | |
| # Duration in minutes | |
| # aep as a fracion e.g. 0.01 | |
| # region must be one of the 10 valid regions | |
| # params is a data frame of parameters a,...,i for all regions | |
| # Check the region is valid | |
| all.regions <- names(params) | |
| all.regions.txt <- str_c(all.regions, collapse = ', ') | |
| if(!(region %in% all.regions)) stop (str_c('Invalid region. You input "', region, '". Valid regions are ', all.regions.txt)) | |
| # For the select region, assignment the parameters to a,...,i | |
| for(i in 1:9) { | |
| assign(letters[i], params[ ,region][i]) | |
| } | |
| min(1, (1 - a*(area^b - c*log10(duration)) * duration ^-d + | |
| e*area^f*duration^g * (0.3 + log10(aep)) + | |
| h*10^(i*area*duration/1440) * (0.3 + log10(aep)))) | |
| } | |
| ARF_short <- function(area, duration, aep) { | |
| a <- 0.287 | |
| b <- 0.265 | |
| c <- 0.439 | |
| d <- 0.36 | |
| e <- 0.00226 | |
| f <- 0.226 | |
| g <- 0.125 | |
| h <- 0.0141 | |
| i <- -0.021 | |
| j <- 0.213 | |
| min(1, (1 - a*(area^b - c*log10(duration)) * duration^(-d) + | |
| e*area^f*duration^g * (0.3 + log10(aep)) + | |
| h * area^j * 10^(i* (1/1440) * (duration - 180)^2) * (0.3 + log10(aep)))) | |
| } | |
| ARF <- function(area, duration, aep, region = NULL, params = NULL) { | |
| # We only need a region and parameters if duration is greater than 12 hours so | |
| # these arguements are optional | |
| # Define the functions we may need | |
| # Checking inputs | |
| if(is.na(area)) return('Area must be between zero and 30,000 km-squared') | |
| if(is.na(aep)) return('AEP must be between 0.5% and 50%') | |
| if(is.na(duration)) return('Duration must be positive and less than 10080 min (7 days)') | |
| if(area < 0 | area > 30000) return('Area must be between zero and 30,000 km-squared') | |
| if(aep > 0.5 | aep < 0.0005) return('AEP must be between 0.05% and 50%') | |
| if(duration > 7*24*60 | duration < 0) return('Duration must be positive and less than 10080 min (7 days)') | |
| if(duration <= 720 & area > 1000) | |
| return(str_c("Generalized equations are not applicable for short durations when catchment areas exceed 1000 km-squared. ", | |
| "If area > 1000, duration must be greater than 12 hours (720 mins)")) | |
| # | |
| if(area <= 1) return(1) | |
| if(duration >= 1440){ | |
| if(area >= 10){ | |
| return(ARF_long(area, duration, aep, region, params)) | |
| # This was from Scott Podgers spreadsheet but isn't in ARR2019 | |
| # return(max(ARF_long(area, duration, aep, region, params), ARF_short(area, duration = 720, aep))) | |
| } | |
| # area < 10 | |
| # interpolate based on area between the long duration ARF for 10 km-square | |
| # and an ARF of 1 | |
| ARF.long.10 <- ARF_long(10, duration, aep, region, params) | |
| ARF = 1 - 0.6614*(1-ARF.long.10)*(area^0.4 - 1) | |
| #ARF.long.10 - (ARF.long.10 - 1)*(10 - area)/10 previous interpolation formula | |
| return(ARF) | |
| } | |
| if(duration <= 720){ | |
| if(area >= 10){ | |
| if(area > 1000) stop('Generalised equations are not applicable for short duration events on areas > 1000 km-squared.') | |
| return(max(0,ARF_short(area, duration, aep))) # Sometimes, short duration events on large catchments produce values less than zero, here I set them to zero. | |
| } | |
| # area < 10 and duration less than 12 hours | |
| # interpolate based on area between the short duration ARF for 10 km-square | |
| # and an ARF of 1 | |
| ARF.short.10 <- ARF_short(10, duration, aep) | |
| ARF = 1 - 0.6614*(1-ARF.short.10)*(area^0.4 - 1) | |
| #ARF.short.10 - (ARF.short.10 - 1)*(10 - area)/10 old interpolation formula | |
| return(ARF) | |
| } | |
| # duration between 720 and 1440 i.e. between 12 hours and 24 hours | |
| if(area > 1 & area < 10){ | |
| # 1. Calculate long duration ARF for 10 km-squared and 24 hours duration | |
| ARF.long.24 <- ARF_long(10, 1440, aep, region, params) | |
| # 2. Calculate short duration ARF for 10 km-squared and 12 hours (720 min) | |
| ARF.short.12 <- ARF_short(10, 720, aep) | |
| # 3. Interpolate ARF for 10 km-squared and selected duration | |
| ARF.interp.10 <- ARF.short.12 + (ARF.long.24 - ARF.short.12)*(duration - 720)/720 | |
| #4. Interpolate ARF for catchment area and selected duration | |
| ARF <- 1 - 0.6614*(1-ARF.interp.10)*(area^0.4 - 1) | |
| return(ARF) | |
| } | |
| if(area >= 10){ | |
| # 1 Calculate long duration ARF for 24 hours and selected area, duration and AEP | |
| ARF.long.24 <- ARF_long(area, 1440, aep, region, params) | |
| # 2. Calculate short duration ARF for 12 hours and selected duration and AEP | |
| ARF.short.12 <- ARF_short(area, 720, aep) | |
| # 3. Interpolate for the selected duration and AEP | |
| ARF <- ARF.short.12 + (ARF.long.24 - ARF.short.12)*(duration - 720)/720 | |
| return(ARF) | |
| } | |
| # We should never fall through to here | |
| stop('Error in ARF calculations') | |
| } | |
| # UI ---------------------------------------------------------------------- | |
| # Define UI for application that draws a histogram | |
| # Define UI for dataset viewer application | |
| ui <- fluidPage( | |
| # Application title | |
| titlePanel("ARR2019 ARF Calculator"), | |
| # Sidebar with controls to select a dataset and specify the | |
| # number of observations to view | |
| sidebarLayout( | |
| sidebarPanel( | |
| selectInput("region", "Choose a region:", | |
| choices = c("East Coast North", | |
| "Semi-arid Inland QLD", | |
| "Tasmania", | |
| "SW WA", | |
| "Central NSW", | |
| "SE Coast", | |
| "Southern Semi-arid", | |
| "Southern Temperate", | |
| "Northern Coastal" | |
| )), | |
| numericInput(inputId = "area", | |
| label = "Area km-squared (between 1 and 30,000):", | |
| min=0, | |
| max=30000, | |
| value=100), | |
| numericInput(inputId = "duration", | |
| label = "Duration (min) (between 1 and 10080 (7 days)):", | |
| min=0, | |
| max=10080, | |
| value=1440, | |
| step = 1), | |
| numericInput(inputId = "aep", | |
| label = "Annual Exceedance Probability (%) (between 0.5% and 50%):", | |
| min=0.5, | |
| max=50, | |
| value=1 ) | |
| ), | |
| # Show a summary of the dataset and an HTML table with the | |
| # requested number of observations | |
| mainPanel( | |
| img(src = "ARFregions.png", height = 480, width = 640), | |
| tableOutput("values"), | |
| #tableOutput("parameters"), | |
| h3('The ARF is:'), | |
| wellPanel( | |
| textOutput({ 'results' }) | |
| ), | |
| HTML('<a href="https://tonyladson.wordpress.com/2020/04/05/arr2019-areal-reduction-factors/" target="_blank">About</a>') | |
| ) | |
| ) | |
| ) | |
| # server ------------------------------------------------------------------ | |
| server <- function(input, output) { | |
| # Return input data | |
| InputValues <- reactive({ | |
| # Compose data frame | |
| data.frame( | |
| Name = c("Region", | |
| "Area (km-squared)", | |
| "Duration (min)", | |
| "Duration (hours)", | |
| "Annual Exceedance Probability"), | |
| Value = as.character(c(input$region, | |
| input$area, | |
| input$duration, | |
| format(input$duration/60, digits = 4), | |
| input$aep/100)), | |
| stringsAsFactors=FALSE) | |
| }) | |
| # Return the parameter values | |
| ParameterValues <- reactive({ | |
| Value = data.frame(Parameter = letters[1:9], Value = params[ ,input$region]) | |
| }) | |
| # Return the ARF | |
| ARFValues <- reactive({ | |
| Value = ARF(input$area, input$duration, input$aep/100, input$region, params) | |
| }) | |
| # | |
| # Show the values using an HTML table | |
| output$values <- renderTable({ | |
| InputValues() | |
| }) | |
| output$parameters <- renderTable({ | |
| ParameterValues() | |
| }) | |
| output$results = renderText({ | |
| format(ARFValues(), digits = 3) | |
| }) | |
| #output$value = renderPrint({ round(ARFValues(), digits =3) }) | |
| } | |
| # Run the application | |
| shinyApp(ui = ui, server = server) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment