Explaining the Shiny App (Oil & Gas Coding Series)

In Oil & Gas Coding with R (Part 2) I created an app to do a quick decline curve analysis. Given @fraclost decided to go much more in-depth in Oil & Gas Coding with Python (Part 2) on the Dash app, I figured I can explain the Shiny app in more detail. I will also make it a little fancier.

As we progress through this series, I will continually add on to this app.


Packages

There are a few packages we need to get started.

  1. Shiny – an open source R package that provides an elegant and powerful web framework for building web applications using R.
  2. shinyWidgets – This package offers custom widgets and other components to enhance your Shiny applications.
  3. shinyjs – lets you perform common useful JavaScript operations in Shiny apps that will greatly improve your apps.
  4. aRpsDCA – Decline Curve Calculations in R
  5. highcharter – Interactive Visualisations with highcharts library.
  6. dplyr, readr, and lubridate from the tidyverse.
#The other packages should already be installed
install.packages(c('shiny', 'shinyWidgets', 'shinyjs'))

Data

I also want to load in my Antero production from Oil & Gas Coding with R (Part 1).

library(shiny)
library(aRpsDCA)
library(highcharter)
library(shinyjs)
library(shinyWidgets)
library(dplyr)
library(readr)
library(lubridate)

#Remove Scientific Notation and make strings Character type
options(scipen = 999)
options(stringsAsFactors = FALSE)

#Load Data, Create New Production Column, Filter by First Production Year > 2006
prod <- readr::read_csv('https://github.com/xbrl-data/class/raw/master/prodAntero.csv') %>%
  group_by(API) %>% mutate(fpYear = lubridate::year(min(Date))) %>% ungroup() %>%
  subset(select = -c(X1)) %>% filter(fpYear >= 2007)

The libraries and data sit at the top of the app.R file.

ui (front end)

The ui refers to the frontend, or what people see when they open the site. Most people using Shiny aren’t web developers and don’t really know anything about html or css. Well, luckily Shiny does most of the work for you, though you absolutely can customize it if you are experienced in web design.

I included shinyWidgets as it makes some of our front-end components look a bit nicer, and it will be used a lot more going forward.

shinyjs is a cool package, as it allows me to show or hide buttons depending on various actions, which is important if I want to add in two different decline methodologies (multi-segment or single-segment Arps).

our shiny app ui

If you may recall in the example, I worked through the decline curve code with variables. These variables are put into the ui with an initial value for most components, with a radio button to determine MultiorSingle Segment Decline.

I also see a sidebar and main panel. The main panel is holding my graph, while the sidebar is holding all of my variables.

ui <- fluidPage(
  
  # App title ----
  titlePanel("Type Curve Example"),
  
  # Sidebar layout with input and output definitions ----
  sidebarLayout(
    
    # Sidebar panel for inputs ----
    sidebarPanel(
      #Make sure to use shinyjs
      useShinyjs(),
      
      #Add a production year filter for our Antero actuals
      h4('Antero Well Data'),
      selectizeInput('fpYear', 'First Production Year', 
                      choices = sort(unique(prod$fpYear)),
                      selected = '2019', multiple = TRUE),

      #Radio Button for Either Single or Multi-Segment Decline
      shinyWidgets::awesomeRadio('segmentType', 'Decline Type',
                                  choices = c('Single-Segment', 'Multi-Segment'),
                                  selected = 'Single-Segment'),
      #Gas IP in MCFD
      numericInput('qiGas', 'Gas IP, MCFD', value = 20000, min= 1, max = 100000),
      #Segment 1 B-Factor
      numericInput('bGas', 'B-Factor', value = 1),
      #Segment 2 B-Factor
      numericInput('bGas2', 'B-Factor Segment 2', value = 1),
      #Segment 1 Initial Decline
      numericInput('DiGas', 'Effective Annual Di', value = 0.9),
      #Segment 2 Initial Decline
      numericInput('DiGas2', 'Effective Annual Di Segment 2', value = 0.9),
      #Terminal Decline
      numericInput('DfGas', 'Effective Annual Terminal Decline', value = 0.08),
      #Flat Period (curtailment) in Months
      numericInput('curtailGas', 'Flat Months', value = 4),
      #Segment 1 Period in Months
      numericInput('segment1', 'Segment 1 Life, Months', value = 12),
      #Total Well Life
      numericInput('wellLife', 'Well Life, Yrs', value = 30)
      
    ),
    
    # Main panel for displaying outputs ----
    mainPanel(
      
      # Output: Decline Curve
      highchartOutput(outputId = "tcPlot"),
      #Create a text string with our total Gas EUR
      textOutput('gasEUR')
      
    )
  )
)


server

The server is the back end of the application, basically doing the calculations whenever an input is changed in the ui. The graph is also built here. These are the equations from the initial workup, though instead of saying qiGas you say input$qiGas.

I will also be creating a reactive dataframe called prod1 that will automatically filter and group the data based on our selected year and the workflow we created in Part 1. This data will be included in my chart to compare our type curves against.

I am also going to use shinyjs to hide or show certain inputs in the ui depending on my selection of Multi-or-Single Segment.

server <- function(input, output, session) {
  
  #Create reactive dataframe
  prod1 <- reactive(
    
    prod %>% filter(fpYear %in% as.numeric(input$fpYear)) %>%
      group_by(API) %>% mutate(monthsOn = seq(1, n(), 1)) %>% ungroup() %>%
      group_by(fpYear, monthsOn) %>% summarise(gas = mean(gas), count = n()) %>%
      ungroup() %>% group_by(fpYear) %>% filter(count >= 0.4*max(count)) %>% ungroup()
                    
                    
                    )

  output$tcPlot <- renderHighchart({

    #If-then statement for single or multi segment
    if(input$segmentType == 'Single-Segment'){
      #Hide non-used variables
      shinyjs::hide('bGas2')
      shinyjs::hide('DiGas2')
      shinyjs::hide('segment1')
    
    #Build gas forecast with standard ARPS (with Terminal decline)
    gasFcst =  (curtailed.q(arps.decline(
      input$qiGas*365.25, as.nominal(input$DiGas), input$bGas,
      as.nominal(input$DfGas)),
      input$curtailGas/12.0,seq(1/12, input$wellLife, by= (1/12)))/12)

    } else {
      #Multi-segment shows all variables
      shinyjs::show('bGas2')
      shinyjs::show('DiGas2')
      shinyjs::show('segment1')
      
      period1 <- input$segment1 #months Segment 1
      
      qiGas1 <- input$qiGas #mcfd
      bGas1 <- input$bGas #B-factor Segment 1
      DiGas1 <- input$DiGas #Effective Annual Decline (Initial) Segment 1
      DfGas <- input$DfGas #Effective Annual Decline (Terminal)
      curtail <- input$curtailGas #Months of curtailment
      wellLife <- input$wellLife #Years
      
      period2 <- (wellLife*12 - period1)/12 #Life of Segment 2
      
      #Segment 1
      gasFcst1 =  curtailed.q(arps.decline(
        qiGas1*365.25, as.nominal(DiGas1), bGas1,
        as.nominal(0)),
        curtail/12.0,seq(1/12, period1/12, by= (1/12)))/12
      
      
      qiGas2 <- gasFcst1[length(gasFcst1)]/30.4375 #Calculate New qiGas as last period of Segment 1
      bGas2 <- input$bGas2 #New B Factor
      DiGas2 <- input$DiGas2 #New Initial Decline
      
      #Segment 2
      gasFcst2 =  curtailed.q(arps.decline(
        qiGas2*365.25, as.nominal(DiGas2), bGas2,
        as.nominal(DfGas)),
        0/12.0,seq(1/12, period2, by= (1/12)))/12
      
      #Combine together
      gasFcst <- append(gasFcst1, gasFcst2)
      
    }
    
    #Sum the gas EUR
    output$gasEUR <- renderText(paste0('Gas EUR: ', as.integer(sum(gasFcst)/1000), ' MMCF'))
    
    
    #Build our highchart
    highchart() %>% 
      hc_add_series(data.frame(months = seq(1, input$wellLife*12, 1), gas = gasFcst),
                    type = 'spline',
                    hcaes(x = months, y = as.integer(gas/30.4375)),
                    color = 'red',
                    name = 'Gas',
                    marker = list(enabled = FALSE),
                    showInLegend = FALSE) %>%
      hc_add_series(data = prod1(), type = 'spline', 
                    hcaes(x = monthsOn, y = as.integer(gas/30.4375),
                    group = fpYear), marker = list(enabled = FALSE),
                    showInLegend = TRUE) %>%
      hc_yAxis(type = 'logarithmic',
               title = list(text = '<b>Daily MCF</b>', 
                            style = list(fontSize = '18px')),
               labels = list(style = list(fontSize = '12px',
                                          fontWeight = 'bold')))%>%
      hc_xAxis(title = list(text = '<b>Months</b>', 
                            style = list(fontSize = '18px')),
               labels = list(style = list(fontSize = '12px',
                                          fontWeight = 'bold'))) %>%
      hc_credits(enabled = TRUE, text = 'Powered by Highcharts', 
                 href = "https://www.highcharts.com/") %>%
      hc_title(text = 'Modified Arps Type Curve', align = 'left') %>%
      hc_subtitle(text = 'aRpsDCA Package', align = 'left') %>%
      hc_chart(
        zoomType = "x"
      )
    
  })
  
}

Call the app

Now that the ui and server are built, we just put a line at the bottom to call the app, and we are done.

shinyApp(ui, server)

Save everything into a file called app.R and press Run App at the top right of the console.


Summary

And we’re done, we have a fully functioning type-curve app.


Full Code for app.R Below

library(shiny)
library(aRpsDCA)
library(highcharter)
library(shinyjs)
library(shinyWidgets)
library(dplyr)
library(readr)
library(lubridate)

#Remove Scientific Notation and make strings Character type
options(scipen = 999)
options(stringsAsFactors = FALSE)

#Load Data
prod <- readr::read_csv('https://github.com/xbrl-data/class/raw/master/prodAntero.csv') %>%
  group_by(API) %>% mutate(fpYear = lubridate::year(min(Date))) %>% ungroup() %>%
  subset(select = -c(X1)) %>% filter(fpYear >= 2007)

ui <- fluidPage(
  
  # App title ----
  titlePanel("Type Curve Example"),
  
  # Sidebar layout with input and output definitions ----
  sidebarLayout(
    
    # Sidebar panel for inputs ----
    sidebarPanel(
      useShinyjs(),
      
      #Add a production year filter for our Antero actuals
      h4('Antero Well Data'),
      selectizeInput('fpYear', 'First Production Year', 
                      choices = sort(unique(prod$fpYear)),
                      selected = '2019', multiple = TRUE),
                     
      shinyWidgets::awesomeRadio('segmentType', 'Decline Type', choices = c('Single-Segment', 'Multi-Segment'),
                                 selected = 'Single-Segment'),
      numericInput('qiGas', 'Gas IP, MCFD', value = 20000, min= 1, max = 100000),
      numericInput('bGas', 'B-Factor', value = 1),
      numericInput('bGas2', 'B-Factor Segment 2', value = 1),
      numericInput('DiGas', 'Effective Annual Di', value = 0.9),
      numericInput('DiGas2', 'Effective Annual Di Segment 2', value = 0.9),
      numericInput('DfGas', 'Effective Annual Terminal Decline', value = 0.08),
      numericInput('curtailGas', 'Flat Months', value = 4),
      numericInput('segment1', 'Segment 1 Life, Months', value = 24),
      numericInput('wellLife', 'Well Life, Yrs', value = 30)
      
    ),
    
    # Main panel for displaying outputs ----
    mainPanel(
      
      # Output: Decline Curve
      highchartOutput(outputId = "tcPlot"),
      textOutput('gasEUR')
      
    )
  )
)

server <- function(input, output, session) {
  
  
  prod1 <- reactive(
    
    prod %>% filter(fpYear %in% as.numeric(input$fpYear)) %>%
      group_by(API) %>% mutate(monthsOn = seq(1, n(), 1)) %>% ungroup() %>%
      group_by(fpYear, monthsOn) %>% summarise(gas = mean(gas), count = n()) %>%
      ungroup() %>% group_by(fpYear) %>% filter(count >= 0.4*max(count)) %>% ungroup()
                    
                    
                    )
  
  output$tcPlot <- renderHighchart({
    
    if(input$segmentType == 'Single-Segment'){
      shinyjs::hide('bGas2')
      shinyjs::hide('DiGas2')
      shinyjs::hide('segment1')
    
    gasFcst =  (curtailed.q(arps.decline(
      input$qiGas*365.25, as.nominal(input$DiGas), input$bGas,
      as.nominal(input$DfGas)),
      input$curtailGas/12.0,seq(1/12, input$wellLife, by= (1/12)))/12)
    } else {
      shinyjs::show('bGas2')
      shinyjs::show('DiGas2')
      shinyjs::show('segment1')
      
      period1 <- input$segment1 #months Segment 1
      
      qiGas1 <- input$qiGas #mcfd
      bGas1 <- input$bGas #B-factor Segment 1
      DiGas1 <- input$DiGas #Effective Annual Decline (Initial) Segment 1
      DfGas <- input$DfGas #Effective Annual Decline (Terminal)
      curtail <- input$curtailGas #Months of curtailment
      wellLife <- input$wellLife #Years
      
      period2 <- (wellLife*12 - period1)/12 #Life of Segment 2
      
      #Segment 1
      gasFcst1 =  curtailed.q(arps.decline(
        qiGas1*365.25, as.nominal(DiGas1), bGas1,
        as.nominal(0)),
        curtail/12.0,seq(1/12, period1/12, by= (1/12)))/12
      
      
      qiGas2 <- gasFcst1[length(gasFcst1)]/30.4375 #Calculate New qiGas as last period of Segment 1
      bGas2 <- input$bGas2 #New B Factor
      DiGas2 <- input$DiGas2 #New Initial Decline
      
      #Segment 2
      gasFcst2 =  curtailed.q(arps.decline(
        qiGas2*365.25, as.nominal(DiGas2), bGas2,
        as.nominal(DfGas)),
        0/12.0,seq(1/12, period2, by= (1/12)))/12
      
      #Combine together
      gasFcst <- append(gasFcst1, gasFcst2)
      
    }
    
    output$gasEUR <- renderText(paste0('Gas EUR: ', as.integer(sum(gasFcst)/1000), ' MMCF'))
    
    
    
    highchart() %>% 
      hc_add_series(data.frame(months = seq(1, input$wellLife*12, 1), gas = gasFcst),
                    type = 'spline',
                    hcaes(x = months, y = as.integer(gas/30.4375)),
                    color = 'red',
                    name = 'Gas',
                    marker = list(enabled = FALSE),
                    showInLegend = FALSE) %>%
      hc_add_series(data = prod1(), type = 'spline', 
                    hcaes(x = monthsOn, y = as.integer(gas/30.4375),
                    group = fpYear), marker = list(enabled = FALSE),
                    showInLegend = TRUE) %>%
      hc_yAxis(type = 'logarithmic',
               title = list(text = '<b>Daily MCF</b>', 
                            style = list(fontSize = '18px')),
               labels = list(style = list(fontSize = '12px',
                                          fontWeight = 'bold')))%>%
      hc_xAxis(title = list(text = '<b>Months</b>', 
                            style = list(fontSize = '18px')),
               labels = list(style = list(fontSize = '12px',
                                          fontWeight = 'bold'))) %>%
      hc_credits(enabled = TRUE, text = 'Powered by Highcharts', 
                 href = "https://www.highcharts.com/") %>%
      hc_title(text = 'Modified Arps Type Curve', align = 'left') %>%
      hc_subtitle(text = 'aRpsDCA Package', align = 'left') %>%
      hc_chart(
        zoomType = "x"
      )
    
  })
  
}

shinyApp(ui, server)

Leave a Reply

This site uses Akismet to reduce spam. Learn how your comment data is processed.

%d bloggers like this: