Well Log Viewer – R Coding Series

Following along with @fraclost, I will walk through coding an LAS log viewer using the R programming language and Shiny. The primary goals here are:

  • Gain more familiarity with Shiny, with more advanced topics like reactivity.
  • Introduce plotly, which works better with large datasets than my usual go-to, highcharter. To be honest, I’m not an expert at plotly, so a lot of this was learned over the last week and there’s probably more functionality I’ve yet to figure out.
  • Introduce error handling, as something will screw up and break your program while you do something important.
  • Teach everyone about geology….. just kidding. I’m not a geologist, though I did get a minor in it. Am I an expert at log analysis? No. I’ve used it quite a bit in the past and know the basics. What I will show here is how to build the framework, and allow the user to play with customization.

Why focus on this crazy conventional oil and gas analysis? I’ve got a feeling traditional geologists will make a roaring comeback over the next couple of decades as the shale world fizzles out, so good skill to have in your pocket. And if South Park has taught me anything, good geos don’t give up easily.


Log Analysis

Before I get started, a bit of a simple primer on log analysis. Basically, over the last 100+ years of oil and gas development, scientists/engineers/geos have developed methods to shoot waves of crap into the ground and interpret the resulting signals as signatures of both prescence of hydrocarbons as well as details of the rocks. Want to know more? Go search for well logging in the search bar and I’m sure you’ll find more info.

Of course, I will pump a guy’s website that was probably written in the 90’s, and if you have seen his pic it’s not hard to imagine he wouldn’t update it. Still, it’s a pretty awesome resource and as a non-geo I always found it helpful.

Anyway, these signals are usually presented in a very long graph format, like 100’s of pages folded so expertly by those old geysers that still use them. Folded slightly better than oversized geologic maps in fact. But, with the advent of the compooter, you can now view these things digitally.

The file of choice is call an LAS (Log ASCII Standard) and the Canadian Well Logging Society maintains the standard. There are tons of tools to view these things, but I’ve always found quite the learning curve and have yet to find one I really like as I don’t really have access to advanced software like Petrel. So why not just code one up myself?

In this analysis, I will be using a publicly available LAS log from UT Lands, which should give me a good Spraberry and Upper Wolfcamp section at the very least. The log in question can be found here.


Setting Up

There are several packages I will need to kick us off. Generally, there are two types of packages I need;, those that affect the front-end (UI), and those that serve the back-end (server), though many span both.

  • shiny – Web Development Framework for R

UI-Specific

  • shinyWidgets – Custom widgets for use in shiny. Basically buttons, dropdowns, etc..
  • shinydashboard – Shiny extension that provides a dashboard look to the shiny application.
  • shinydashboardPlus – An extension to the extension from rinterRface. Some more customized controls and layouts for the dashboard.
  • shinyjs – Common javascript operations in shiny. I largely use this for hiding or disabling stuff while the application is calculating.
  • bsplus – In this context, used to add a popup modal to view tables, enter well top data, or to download data.

Server-Specific

  • tidyr – Tidy messy data in R, part of the tidyverse.
  • dplyr -Data manipulation in R, part of the tidyverse.
  • readr – Reading in rectangular data (like csv’s) into R, part of the tidyverse. Also some other useful functionality for string manipulation.
  • zoo – Basically used for a single purpose for me; essentially a fill down empty data function called na.locf.
  • plotly – Common package (available in python and R/others). Plotly’s R graphing library makes interactive, publication-quality graphs.
  • DTDT provides an R interface to the JavaScript library DataTables. Used for customizable tables.
  • rhandsontable – Another Javasctipt table library, though this one makes it simple to override values in the table and use (similar to excel without formulas). I typically use for things like user-entered mins and maxes as opposed to new UI components each time.
  • SDAR – Lucky for me, there is already a package in the R universe (CRAN), built to read in LAS files. And I will definitely take advantage. Alternatively, I can read it in using readr, though it would take a significant amount of customization and data manipulation to get it to work correctly (still achievable but would take awhile).

As always, if the package is not installed already, you can do so via:

install.packages('shiny')

##Or for multiple packages

install.packages(c('shinyWidgets', 'shinydashboard'))

Building the App

There is a lot going on here, but I will try and keep it as succint as possible and explain what I’m doing at each step. But before we dig in, let’s talk about reactivity.

The primary means of reactivity are reactive() and reactiveValues() in shiny, which serve as a form of in-memory storage. We can use observe() and observeEvent(), which are “listeners”, to initiate actions and serve as gates in conjunction with these stored values.

Basically, there are two ways to accomplish a calculation or action. Either automatically, or via pressing a button. In an ideal world, everything flows flawlessly and quickly and I never have to put in these button “gates”. However, early on in coding, these buttons are needed as I’m not always aware of what change impacts some other part of the app. With time, however, reactivity becomes more intuitive. Essentially, every action that is dependent on a different data point will get updated automatically unless I tell it to stop with some sort of gating mechanism. With big, hunky, slow programs with lots of inter-dependency, I definitely want to include buttons. For this workflow, we will attempt to be as reactive as possible and limit the needs for buttons.


Shiny Setup

In this part, we will build out the initial shell. As mentioned previously, I’m using shinydashboard and shinydashboardPlus for the design of the app, but there are a multidue of options. If you check out the version on AFE Leaks, that is using the tablerDash design. It’s fun to experiment around with these dashboards and find one that works best for you. Be warned though, they all contain slightly different components for some of the design mechanisms. You can find a good list here. It is typically the various container boxes that are the most distinct between them.

Create a new file in RStudio called app.R. At the top we load our desired libraries,

library(shiny)
library(shinyWidgets)
library(shinydashboard)
library(shinydashboardPlus)
library(shinyjs)
library(plotly)
library(SDAR)
library(dplyr)
library(tidyr)
library(bsplus)
library(DT)
library(rhandsontable)
library(readr)h
library(zoo)

Next, we define some custom options. Anything you put here will occur before your app loads up. I’m going to tell the app to allow larger file uploads than default (which you’ll need to load up LAS files), and then put in a custom color scheme to use for my plots.

options(shiny.maxRequestSize=30*1024^2)

cols <- c('#00a4e3', '#a31c37', '#adafb2', '#d26400', '#eaa814', '#5c1848',
          '#786592', '#ff4e50', '#027971', '#008542', '#5c6d00','#0D1540', '#06357a' )

ui/server

Next we will set up the ui and server portions of the app with nothing in them, and fill in as we go.

shinyApp(
  ui = dashboardPagePlus(
    header = dashboardHeaderPlus(
      fixed = TRUE,
      enable_rightsidebar = FALSE
    ),
    sidebar = dashboardSidebar(
    
    ),
    body = dashboardBody(

     
    ),
    title = "Log Analysis Tool"
  ),
  server = function(input, output, session) { 
    
    }
)

We call the shinyApp() as a wrapper around the ui and server.

We see that as part of the ui (or front-end), we have a header, which can include a right sidebar that clicks open (we do not need it for this workflow but you can put just about anything there).

We have a regular sidebar, which is the black portion on the left. You can use various packages (or css) to customize the color-screen, but I will leave it as default for now. The only thing I will include in the sidebar for this workflow is a formation/depth tracker that will be coded near the end.

Body is the main portion of the application and will host most of what we code.

Figure 1: Empty Shiny Dashboard App

The server is basically for everything actually functional. I will do data calculations, populate tables and plots, and put in the reactivity. Session is the only portion of the server that is not actually necessary for a non-reactive app, but it is necessary for what we need to do.

One other thing I will add in here is a call that allows me to use the shinyjs package, which we include in the body. I will post the app progress so far below. For the remainder, I will specify whether I will be putting an item within the body, sidebar, or server.

library(shiny)
library(shinyWidgets)
library(shinydashboard)
library(shinydashboardPlus)
library(shinyjs)
library(plotly)
library(SDAR)
library(dplyr)
library(tidyr)
library(bsplus)
library(DT)
library(rhandsontable)
library(readr)
library(zoo)

options(shiny.maxRequestSize=30*1024^2)
cols <- c('#00a4e3', '#a31c37', '#adafb2', '#d26400', '#eaa814', '#5c1848',
          '#786592', '#ff4e50', '#027971', '#008542', '#5c6d00','#0D1540', '#06357a' )
shinyApp(
  ui = dashboardPagePlus(
    header = dashboardHeaderPlus(
      fixed = TRUE,
      enable_rightsidebar = FALSE
    ),
    sidebar = dashboardSidebar(
    
    ),
    body = dashboardBody(
       useShinyjs()

    ),
    title = "Log Analysis Tool"
  ),
  server = function(input, output, session) { 
    
    }
)

If I press Run App on the top of RStudio after I save, it will spin up the empty app. Now on to make this thing actually functional.


Nuts and Bolts

Load the Data

I want to give the user the ability to load up any LAS file and then interpret it.

While testing this, one of the files I loaded didn’t read correctly and crashed the app. So I need to plan around what happens in that scenario (and prevent it from crashing). Without the ability to load data, the app is useless.

ui

First though, I’m going to create a file upload input in the body of the ui.

There is a weird quirk in shinydashboard that doesn’t place the first item far enough down on the page, so I use three br() calls to shift it down a bit.

body = dashboardBody(
       useShinyjs(),
       br(),
       br(),
       br(),
       fluidRow(
        column(
          width = 3,
          boxPad(
            color = "gray",
            fileInput("file1", "Choose LAS File",
                      multiple = FALSE,
                      accept = c(".las")),
              textOutput('formCheck1')
          )
        )
      )

    )

We want to wrap everyting in a fluidRow, which basically is a row of items that will resize if I make the screen bigger or smaller.

Within the fluidRow, I want to build columns with what I want to put. Across the fluidRow, the various columns need to add up to 12.

Within the first column, I am going to use boxPad from shinydashboardPlus, which is a customized box that I can put a background color on, in this case gray.

I then use the shiny fileInput to define the ability to upload a .las file format. file1 is the name of the item so the server knows to reference it, “Choose LAS File”, is the button text, and accept is the file format.

I include the textOutput as a way to let the user know if my upload worked. I pass this portion into the body, save, and press Run App again.

This was quite a bit, but it was the first item. I’ll be more succinct the rest of the way.

server

Anyway, what happens when I upload a file? Well, nothing at all. I’ve yet to define what actually occurs in the server section once I upload the file. Let’s go there now.

  server = function(input, output, session) { 
    
    values <- reactiveValues()

    observe({
      if(is.null(input$file1$datapath)){
        NULL
      } else {
        
        tryCatch({
          
          values$logFile <- SDAR::read.LAS(input$file1$datapath)
          values$tops <- data.frame(formation = NA, top = NA)
          units <- read_delim(input$file1$datapath, delim = '  ')
          units <- units[,1:2]
          names(units)[1:2] <- c('Component', 'Unit')
          units$Component <- trimws(units$Component)
          units$Unit <- trimws(units$Unit)
          units <- units %>% filter(!is.na(Unit))
          units <- units %>% filter(Component %in% names(values$logFile)) %>% filter(!duplicated(Component))
          
          values$units <- units
          output$formCheck1 <- renderText('Success')
        },
        error = function(e) {
          e
          output$formCheck1 <- renderText('Error in Upload')
        })
        
        
      }
      
    }
    )
    
    
    
    }

values is basically a reactive list, defined with the reactiveValues() function. I can use this to store dataframes that I will use later in the application. I can also use observe and observeEvent calls to store things there.

Within the observe() call, I use SDAR to read the LAS file as a dataframe, and I store it in the reactive values list.

I also create a dummy dataframe to store tops. I will fill it in later with actuals.

Unfortunately, the SDAR package does not store units, so I will read in the las with the readr package. read_delim allows me to specify a delimeter. Here, I just use two spaces, and the package splits the entire LAS file into two columns. I then rename the columns, remove spaces at the beginning and end of each character, remove anything with a null Unit value, and then filter so that only Components that are in the columns of my original log file are in the dataframe. I will store this in values also.

tryCatch is my error-handler. I wrap the entire calculation within the function. If successful, it will update my formCheck1 textOutput defined in the ui to say Success. If my calculation returns an error, it will say Error in Upload and nothing else will occur in the app. You’ll need to reupload a successful try to continue.


Variable Selection

Now that I have the data loaded in, I want to be able to define which variables I want to put on my log tracks.

I thought about coding a way to define how many log tracks the user wants, but that is probably unnecessarily complicated for our use. Instead, I will pre-define 4 log tracks that the user can edit and add variables too. I also want the user to be able to specify scale and either a log or linear track.

ui

I need to create a new fluidRow with four equidistant columns. Don’t worry that there is nothing in the remaining area of the first fluidRow; we are going to fill that in later. This is added to the body.

body = dashboardBody(
      useShinyjs(),
      br(),
      br(),
      br(),
      fluidRow(
        column(
          width = 3,
          boxPad(
            color = "gray",
            fileInput("file1", "Choose LAS File",
                      multiple = FALSE,
                      accept = c(".las")),
            
            textOutput('formCheck1'),
            selectInput(
              "depth", 
              "Depth Track",
              c("")
            )
          )
        )
      ),
      fluidRow(
        column(width = 3,
               selectizeInput(
                 "track1", 
                 "Track 1",
                 c(""),
                 multiple = T
               ),            
               radioButtons('track1Type', '', choices = c('log', 'linear'), selected = 'linear')
        ),
        column(width = 3,
               
               selectizeInput(
                 "track2", 
                 "Track 2",
                 c(""),
                 multiple = T
               ),
               radioButtons('track2Type', '', choices = c('log', 'linear'), selected = 'linear')
        ),
        column(width = 3,
              selectizeInput(
                 "track3", 
                 "Track 3",
                 c(""),
                 multiple = T
               ),
               radioButtons('track3Type', '', choices = c('log', 'linear'), selected = 'linear')),
        column(width = 3,
               selectizeInput(
                 "track4", 
                 "Track 4",
                 c(""),
                 multiple = T
               ),
               radioButtons('track4Type', '', choices = c('log', 'linear'), selected = 'linear'))
            )
     
    )

New additions here. First, I added a selectInput called depth to the original file box. This will be the default depth column for the log, and will be used across all plotly graphs.

Next, I create a new row with four columns, each with a width of 3 (remember, the columns need to add up to 12). Within each one, I define a selectizeInput labelled table1table4. This defines the variables I will need for each log track. The reason I use selectizeInput as opposed to selectInput is that it allows me to select multiple items. Really there is no limit, but come on, it’ll look ridiculous with too many columns.

I also include a radioButtons item to determine if it is going to be a log or linear scale for the x-Axis.

You should now see this when you run the app.

Figure 2: Shiny App with Variable Definitions

Now, how the hell do we know what variables to choose? Well, that’s where the server comes in.

server

We need to use a form of reactivity to update each select/selectizeInput columns. Essentially, the app needs to read the columns of the data you loaded, and populate each input with that data. For the track input, we need to remove the depth column as well. The following needs to go somewhere within the server section.

  observe({
      if(is.null(values$logFile)||nrow(values$logFile) == 0){
        updateSelectInput(session, 'depth', choices = '')
      } else {
        updateSelectInput(session, 'depth', choices = unique(names(values$logFile)))
      }
    })
    
    observeEvent(input$depth, {
      
      if(is.null(values$logFile)||nrow(values$logFile) == 0||is.null(input$depth)||input$depth == ''){
       
        updateSelectizeInput(session, 'track1', choices = '')
        updateSelectizeInput(session, 'track2', choices = '')
        updateSelectizeInput(session, 'track3', choices = '')
        updateSelectizeInput(session, 'track4', choices = '')
        
      } else {
        
        tst2 <- which(names(values$logFile) == input$depth)
        names1 <- names(values$logFile[,-tst2])

        updateSelectizeInput(session, 'track1', choices =names1)
        updateSelectizeInput(session, 'track2', choices =names1)
        updateSelectizeInput(session, 'track3', choices =names1)
        updateSelectizeInput(session, 'track4', choices =names1)
        
      }
      
    })

This is a good example of using observe and observeEvent.

In the first instance, I have an automated update via observe. This will run automatically in the background if it senses any change. That change is defined largely by what you include within the function. For this one, if the values$logFile data is empty, it fills the depth selectInput with empty values. If there is data, it chooses from our columns. For every update function, the first item in the function is session.

In the second instance, it does something similar. With no data, nothing is filled into our selectizeInputs, but otherwise it is all columns but our depth column within each track. I made this an observeEvent largely because I want this to occur in the queue after I update the depth input.


New Variables

I need to build a methodology in the app for a user to create customized variables from the existing ones. In order to do so, I need to get creative. There are some “excel-like” packages in R, but in testing they were far too slow for this application. There also isn’t really a formula editor that I can find. Instead, I’ll just give some brief instructions to the user, and then make sure that any variables selected/equations work before adding them in to the overall table.

ui

I will utilize the remaining space at the top row of the app to create this functionality. This will go in the first fluidRow in the body.

 fluidRow(
        column(
          width = 3,
          boxPad(
            color = "gray",
            fileInput("file1", "Choose LAS File",
                      multiple = FALSE,
                      accept = c(".las")),
            
            textOutput('formCheck1'),
            selectInput(
              "depth", 
              "Depth Track",
              c("")
            )
          )
        ),
        column(width = 3,
               h4('Custom Column:'),
               p('Allows user to enter a custom formula based on the columns within the file.
                   The common convention is similar to excel.  For example, if I for some reason wanted to
                   double to DPOR column, the user would enter DPOR*2. Common operators (using DPOR as the variable) are:'),
               p('Simple Math: + - * / ^'),
               p('Square Root: sqrt(DPOR)'),
               p('Natural Log: log(DPOR)'),
               p('Exponential: exp(DPOR)'),
               p('Log Base 10: log10(DPOR)')
        ),
        column(width = 6,
               textInput('userColumn', 'Variable Name (Cannot exist in current table)', placeholder = 'DPOR2'),
               textInput('userFormula', 'Formula (Realize this calculation is meaningless, just an example)', placeholder = 'DPOR*2 + (GR - NPHI)'),
               actionButton('addFormula', '', icon = icon('plus'), class = "btn-primary"),
               textOutput('formCheck'))
      )

The first column is just some text. There is a brief explanation of what I am doing, and I show the common operators.

The last column has two textInputs to define the name of the variable, and the formula. There is a button to allow adding this into the dataset, and textOutput to let you know if it was successful or not.

Simple enough, but not really. The interactivity between the inputs and outputs here are a little complicated.

server

In the server, I need to create methods to determine if the user defined equation uses numbers or variables, and if it is a variable, make sure it exists in the data. I also need to create a methodology of disabling the button if nothing is entered.

observe({
      if(is.null(values$logFile)||nrow(values$logFile) == 0){
        shinyjs::disable('addFormula')
      } else {
        if(input$userColumn %in% names(values$logFile)||is.null(input$userFormula)||
           input$userFormula == ''||is.null(input$userColumn)||input$userColumn == ''){
          shinyjs::disable('addFormula')
        } else {
          shinyjs::enable('addFormula')
        }
      }
    })
    
    observeEvent(input$addFormula, {
      
      tryCatch({
        
        values$logFile <- values$logFile %>% mutate(txt1= eval(parse(text = input$userFormula)))
        names(values$logFile)[length(values$logFile)] <- input$userColumn
        tst2 <- which(names(values$logFile) == input$depth)
        names1 <- names(values$logFile[,-tst2])
        output$formCheck <- renderText('Success')
        updateSelectizeInput(session, 'track1', choices =names1)
        updateSelectizeInput(session, 'track2', choices =names1)
        updateSelectizeInput(session, 'track3', choices =names1)
        updateSelectizeInput(session, 'track4', choices =names1)
        
        
      },
      error = function(e) {
        e
        output$formCheck <- renderText('Error in Formula')
      })
      
    })

In the observe block, I first use shinyjs to disable the button if we haven’t uploaded a file yet. Then, I use an if statement to say that if the formula is empty or the column name is empty, it disables the button. Otherwise, it is enabled.

In the second block, I am using tryCatch again as an error-handler. Largely it is another if-then statement.

Then I perform the calcuation on the stored data table in memory (values$logFile). I am going to mutate (ie form new variable) using the input$userFormula input I defined and the user entered. To get it to actually work, I have to wrap it in eval(parse()). This will convert text to an actual equation. I name it text.

However, in the next step, I rename the last column to what the user specified in input$userColumn. I also remove the depth column from the list of names and update my track1-4 inputs to reflect the new name.

I also specify whether it was a success or failure in the output$formCheck calls.


Where’s my damn logs already?!?! Well, we are almost there, but not quite yet. We need to create one more thing first.

Depth Slider

I want the ability to select a custom range for the depth interval. I will just a slider in this instance, though there are other means to do it (like a number and slider combo input).

ui

First, I’m going to build another fluidRow and box that will hold the slider and eventually the plots.

column(width = 3,
               selectizeInput(
                 "track4", 
                 "Track 4",
                 c(""),
                 multiple = T
               ),
               radioButtons('track4Type', '', choices = c('log', 'linear'), selected = 'linear'))
            ),
      fluidRow(
        box(
          title = "Log Presentation",
          status = "primary",
          width = 12,
          
          column(width = 12,
                 sliderInput("depthSlide", label = h3("Depth Interval"), min = 0, 
                             max = 100, value = c(40, 60))
                 
                 
          )
        )
      )

Ignore the first part (above the fluidRow), as it is just for reference for where it needs to be placed within the body. This is just a sliderInput that allows the user to select a range, which is done by specifying the two values in value. Thes are dummy values for now. We will use the server to update the sliderInput once the user uploads a log.

server

I am going to add some code to the observeEvent() I called earlier for when I change the input$depth parameter.

   observeEvent(input$depth, {
      
      if(is.null(values$logFile)||nrow(values$logFile) == 0||is.null(input$depth)||input$depth == ''){
       
        updateSelectizeInput(session, 'track1', choices = '')
        updateSelectizeInput(session, 'track2', choices = '')
        updateSelectizeInput(session, 'track3', choices = '')
        updateSelectizeInput(session, 'track4', choices = '')

        #Reset slider to default

        updateSliderInput(session, 'depthSlide', min = 0, max = 100, value= c(40,60))
        
      } else {
        
        
        tst2 <- which(names(values$logFile) == input$depth)
        names1 <- names(values$logFile[,-tst2])

        updateSelectizeInput(session, 'track1', choices =names1)
        updateSelectizeInput(session, 'track2', choices =names1)
        updateSelectizeInput(session, 'track3', choices =names1)
        updateSelectizeInput(session, 'track4', choices =names1)

        #New Depth Update
        
        tst1 <- values$logFile %>%data.frame() %>% select(input$depth)
        names(tst1)[1] <- 'depth'
        
        tst1 <- tst1 %>% filter(depth != -999) %>% filter(!is.na(depth))
        tst1$depth <- abs(tst1$depth)
        
        updateSliderInput(session, 'depthSlide', min = min(tst1$depth, na.rm=T), max = max(tst1$depth, na.rm=T),
                          value = c(min(tst1$depth, na.rm=T), max(tst1$depth, na.rm = T)))
      }
      
    })
    

Within the server section, I add to the original code block. What this says is that, in the event that the depth input changes, something needs to occur. If my values$logFile list is empty, it resets the slider to defaults, else while, it takes the depth column, finds all the values (removed -999 as for some reason that is usually the missing data designator in LAS), and then takes the absolute value of that column. I update the sliderInput with the range of values.

I use the absolute value largely because I was having issues with trying to code a descending depth column in plotly when using negative values (ie TVD, Subsea). Will probably fix eventually, but just roll with it for now.


Log Plot

Now, I am finally ready to add the actual log plots.

ui

I am going to add this section into the fluidRow containing the depth slider.

fluidRow(
        box(
          title = "Log Presentation",
          status = "primary",
          width = 12,
          
          column(width = 12,
                 sliderInput("depthSlide", label = h3("Depth Interval"), min = 0, 
                             max = 100, value = c(40, 60))
                 
                 
          ),
          fluidRow(
            column(width = 3,
                   rhandsontable::rHandsontableOutput('track1Scale')),
            column(width = 3,
                   rhandsontable::rHandsontableOutput('track2Scale')),
            column(width = 3,
                   rhandsontable::rHandsontableOutput('track3Scale')),
            column(width = 3,
                   rhandsontable::rHandsontableOutput('track4Scale'))
          ),
          fluidRow(
            column(width = 3,
                   
                   plotlyOutput('track1Plot', height = '700px')),
            column(width = 3,
                   
                   plotlyOutput('track2Plot', height = '700px')),
            column(width = 3,
                   
                   plotlyOutput('track3Plot', height = '700px')),
            column(width = 3,
                   
                   plotlyOutput('track4Plot', height = '700px'))
          )
        )
      )

I create two fluidRows inside my box.

The top row contains rHandsontableOutput outputs. These are excel-like tables. They don’t allow me to put in equations, but I can put in default values. I will use this to define the scale range (min/max) for each output. If you put the min and max in reverse, it will reverse the scale (which is sometimes done on logs).

The second fluidRow are plotlyOutputs, which is our image renderer. There will be one for each track, as defined with the variables we select.

If you press Run now, you’ll see nothing. Haven’t populated it yet. Let’s do so in the server.

server

Let me start with the scale tables.

 output$track1Scale <- rhandsontable::renderRHandsontable({
      if(is.null(input$track1)||input$track1 == ''){
        NULL
      } else {
        
        DF <- data.frame(Component = input$track1, min = 0, max = 150) 

        DF <- DF %>% left_join(values$units)
        
        rhandsontable(DF, rowHeaders = NULL, width = '100%', stretchH = "all") %>%
          hot_col("Component", readOnly = TRUE)
        
      }
    })
    
    output$track2Scale <- rhandsontable::renderRHandsontable({
      if(is.null(input$track2)||input$track2 == ''){
        NULL
      } else {
        
        DF <- data.frame(Component = input$track2, min = 0, max = 150)
        
        DF <- DF %>% left_join(values$units)
        
        rhandsontable(DF, rowHeaders = NULL, width = '100%', stretchH = "all") %>%
          hot_col("Component", readOnly = TRUE)
        
      }
    })
    
    output$track3Scale <- rhandsontable::renderRHandsontable({
      if(is.null(input$track3)||input$track3 == ''){
        NULL
      } else {
        
        DF <- data.frame(Component = input$track3, min = 0, max = 150)
        DF <- DF %>% left_join(values$units)
        
        rhandsontable(DF, rowHeaders = NULL, width = '100%', stretchH = "all") %>%
          hot_col("Component", readOnly = TRUE)
        
      }
    })
    
    output$track4Scale <- rhandsontable::renderRHandsontable({
      if(is.null(input$track4)||input$track4 == ''){
        NULL
      } else {
        
        DF <- data.frame(Component = input$track4, min = 0, max = 150) 
        DF <- DF %>% left_join(values$units)
        
        rhandsontable(DF, rowHeaders = NULL, width = '100%', stretchH = "all") %>%
          hot_col("Component", readOnly = TRUE)
        
      }
    })

I set up a simple data.frame with the name of the selected variables for each track, and a basic min and max. It will be up to the user to adjust this scale. At some point I may add in an auto-scale update.

Next I will set up the plots.

 output$track1Plot <- renderPlotly({
      if(is.null(input$track1)||input$track1 == ''||is.null(input$track1Scale)){
        NULL
      } else {
        tst2 <- which(names(values$logFile) == input$depth|
                        names(values$logFile) %in% input$track1)
        
        tst1 <- values$logFile[,tst2]
        
        names1 <- which(names(tst1) == input$depth)
        
        names(tst1)[names1] <- 'depth'
        
        dfx <- data.frame(hot_to_r(input$track1Scale))
        
        tst1 <- tst1 %>% gather(Component, value, -depth) %>%
          left_join(dfx)
        
        tst1$plot <- 1+(tst1$value-tst1$min)/(tst1$max-tst1$min)*100
        tst1$depth <- abs(tst1$depth)
        
        
        plot_ly(
          type = 'scatter',
          x = tst1$plot,
          y = tst1$depth,
          group_by = tst1$Component,
          color = tst1$Component,
          colors = cols,
          text = paste(tst1$Component,
                       "<br>Depth: ", tst1$depth,
                       "<br>Value: ", tst1$value),
          hoverinfo = 'text',
          mode = 'lines'
        ) %>%
          layout(dragmode = "select", yaxis =list( range = c(max(tst1$depth), min(tst1$depth))),
                 xaxis = list( range = c(1, 100),
                               title = "",
                               zeroline = FALSE,
                               showline = FALSE,
                               showticklabels = FALSE,
                               showgrid = FALSE)) %>%
          event_register(event = "plotly_brushed") %>%
          event_register(event = 'plotly_click')
      }
    })
    
    output$track2Plot <- renderPlotly({
      if(is.null(input$track2)||input$track2 == ''||is.null(input$track2Scale)){
        NULL
      } else {
        tst2 <- which(names(values$logFile) == input$depth|
                        names(values$logFile) %in% input$track2)
        
        tst1 <- values$logFile[,tst2]
        
        names1 <- which(names(tst1) == input$depth)
        
        names(tst1)[names1] <- 'depth'
        dfx <- data.frame(hot_to_r(input$track2Scale))
        
        tst1 <- tst1 %>% gather(Component, value, -depth) %>%
          left_join(dfx)
        
        tst1$plot <- 1+(tst1$value-tst1$min)/(tst1$max-tst1$min)*100
        tst1$depth <- abs(tst1$depth)
        
        
        
        plot_ly(
          type = 'scatter',
          x = tst1$plot,
          y = tst1$depth,
          group_by = tst1$Component,
          color = tst1$Component,
          colors = cols[4:length(cols)],
          text = paste(tst1$Component,
                       "<br>Depth: ", tst1$depth,
                       "<br>Value: ", tst1$value),
          hoverinfo = 'text',
          mode = 'lines'
        ) %>%
          layout(dragmode = "select", yaxis =list( range = c(max(tst1$depth), min(tst1$depth))),
                 xaxis = list( range = c(1, 100),title = "",
                               zeroline = FALSE,
                               showline = FALSE,
                               showticklabels = FALSE,
                               showgrid = FALSE)) %>%
          event_register(event = "plotly_brushed") %>%
          event_register(event = 'plotly_click')
      }
    })
    
    
    output$track3Plot <- renderPlotly({
      if(is.null(input$track3)||input$track3 == ''||is.null(input$track3Scale)){
        NULL
      } else {
        tst2 <- which(names(values$logFile) == input$depth|
                        names(values$logFile) %in% input$track3)
        
        tst1 <- values$logFile[,tst2]
        
        names1 <- which(names(tst1) == input$depth)
        
        names(tst1)[names1] <- 'depth'
        
        dfx <- data.frame(hot_to_r(input$track3Scale))
        
        tst1 <- tst1 %>% gather(Component, value, -depth) %>%
          left_join(dfx)
        
        tst1$plot <- 1+(tst1$value-tst1$min)/(tst1$max-tst1$min)*100
        tst1$depth <- abs(tst1$depth)
        
        
        
        plot_ly(
          type = 'scatter',
          x = tst1$plot,
          y = tst1$depth,
          group_by = tst1$Component,
          color = tst1$Component,
          colors =cols[7:length(cols)],
          text = paste(tst1$Component,
                       "<br>Depth: ", tst1$depth,
                       "<br>Value: ", tst1$value),
          hoverinfo = 'text',
          mode = 'lines'
        ) %>%
          layout(dragmode = "select",  yaxis =list( range = c(max(tst1$depth), min(tst1$depth))),
                 xaxis = list( range = c(1, 100),title = "",
                               zeroline = FALSE,
                               showline = FALSE,
                               showticklabels = FALSE,
                               showgrid = FALSE)) %>%
          event_register(event = "plotly_brushed") %>%
          event_register(event = 'plotly_click')
      }
    })
    
    
    
    output$track4Plot <- renderPlotly({
      if(is.null(input$track4)||input$track4 == ''||is.null(input$track4Scale)){
        NULL
      } else {
        tst2 <- which(names(values$logFile) == input$depth|
                        names(values$logFile) %in% input$track4)
        
        tst1 <- values$logFile[,tst2]
        
        names1 <- which(names(tst1) == input$depth)
        
        names(tst1)[names1] <- 'depth'
        
        dfx <- data.frame(hot_to_r(input$track4Scale))
        
        tst1 <- tst1 %>% gather(Component, value, -depth) %>%
          left_join(dfx)
        
        tst1$plot <- 1+(tst1$value-tst1$min)/(tst1$max-tst1$min)*100
        tst1$depth <- abs(tst1$depth)
        
        
        plot_ly(
          type = 'scatter',
          x = tst1$plot,
          y = tst1$depth,
          group_by = tst1$Component,
          color = tst1$Component,
          colors =cols[10:length(cols)],
          text = paste(tst1$Component,
                       "<br>Depth: ", tst1$depth,
                       "<br>Value: ", tst1$value),
          hoverinfo = 'text',
          mode = 'lines'
        ) %>%
          layout(dragmode = "select",  yaxis =list( range = c(max(tst1$depth), min(tst1$depth))),
                 xaxis = list( range = c(1, 100),title = "",
                               zeroline = FALSE,
                               showline = FALSE,
                               showticklabels = FALSE,
                               showgrid = FALSE)) %>%
          event_register(event = "plotly_brushed") %>%
          event_register(event = 'plotly_click')
      }
    })

Looks long, but they are basically all the same. For each one, I grab the depth column and that track’s variables. I then join the scale table defined in the previous code block using hot_to_r().

The next part is a bit of an interpolation. Instead of trying to add many x-axes to the plot whenever a new variable is added, instead I fit every variable on a 1-100 scale. This saved me a lot of headaches. In order to make it work, I plot the transformed column, but then show the original value whenever a user hovers over it on the plot.

I take the absolute value of depth as well.

The plot is a simple scatter, with a defined x/y, and you need to call group_by to separate them by the variable. You change the mode to a ‘line’ plot, and define what the user sees when they hover on a track/point. The layout portion defines the range, and some customization for the axis. event_registers allow me to create actions when I click or drag on a plot, which I will save for the next post.

While the app should run now, there is one more thing I need to do so that it updates when I change the depth filter (this is the final one for this tutorial).

 observe({
      if(input$track1Type == 'log'){
      
        plotlyProxy("track1Plot", session) %>%
          plotlyProxyInvoke("relayout", list(yaxis =list( range = c(max(input$depthSlide), min(input$depthSlide))),
                                             xaxis =list(type = 'log', title = "",
                                                         zeroline = FALSE,
                                                         showline = FALSE,
                                                         showticklabels = FALSE,
                                                         showgrid = FALSE,
                                                         autorange = F, range = c(log10(1), log10(100)))))
      } else {
        plotlyProxy("track1Plot", session) %>%
          plotlyProxyInvoke("relayout", list(yaxis =list( range = c(max(input$depthSlide), min(input$depthSlide))),
                                             xaxis =list(type = 'linear', title = "",
                                                         zeroline = FALSE,
                                                         showline = FALSE,
                                                         showticklabels = FALSE,
                                                         showgrid = FALSE,
                                                         autorange = F, range = c(1, 100))))
      }
      
      if(input$track2Type == 'log'){
        
        plotlyProxy("track2Plot", session) %>%
          plotlyProxyInvoke("relayout", list(yaxis =list( range = c(max(input$depthSlide), min(input$depthSlide))),
                                             xaxis =list(type = 'log',title = "",
                                                         zeroline = FALSE,
                                                         showline = FALSE,
                                                         showticklabels = FALSE,
                                                         showgrid = FALSE,
                                                         autorange = F, range = c(log10(1), log10(100)))))
      } else {
        plotlyProxy("track2Plot", session) %>%
          plotlyProxyInvoke("relayout", list(yaxis =list( range = c(max(input$depthSlide), min(input$depthSlide))),
                                             xaxis =list(type = 'linear',title = "",
                                                         zeroline = FALSE,
                                                         showline = FALSE,
                                                         showticklabels = FALSE,
                                                         showgrid = FALSE,
                                                         autorange = F, range = c(1, 100))))
      }
      
      
      if(input$track3Type == 'log'){
        
        plotlyProxy("track3Plot", session) %>%
          plotlyProxyInvoke("relayout", list(yaxis =list( range = c(max(input$depthSlide), min(input$depthSlide))),
                                             xaxis =list(type = 'log',title = "",
                                                         zeroline = FALSE,
                                                         showline = FALSE,
                                                         showticklabels = FALSE,
                                                         showgrid = FALSE,
                                                         autorange = F, range = c(log10(1), log10(100)))))
      } else {
        plotlyProxy("track3Plot", session) %>%
          plotlyProxyInvoke("relayout", list(yaxis =list( range = c(max(input$depthSlide), min(input$depthSlide))),
                                             xaxis =list(type = 'linear',title = "",
                                                         zeroline = FALSE,
                                                         showline = FALSE,
                                                         showticklabels = FALSE,
                                                         showgrid = FALSE,
                                                         autorange = F, range = c(1, 100))))
      }
      
      if(input$track4Type == 'log'){
        
        plotlyProxy("track4Plot", session) %>%
          plotlyProxyInvoke("relayout", list(yaxis =list( range = c(max(input$depthSlide), min(input$depthSlide))),
                                             xaxis =list(type = 'log',title = "",
                                                         zeroline = FALSE,
                                                         showline = FALSE,
                                                         showticklabels = FALSE,
                                                         showgrid = FALSE,
                                                         autorange = F, range = c(log10(1), log10(100)))))
      } else {
        plotlyProxy("track4Plot", session) %>%
          plotlyProxyInvoke("relayout", list(yaxis =list( range = c(max(input$depthSlide), min(input$depthSlide))),
                                             xaxis =list(type = 'linear',title = "",
                                                         zeroline = FALSE,
                                                         showline = FALSE,
                                                         showticklabels = FALSE,
                                                         showgrid = FALSE,
                                                         autorange = F, range = c(1, 100))))
      }
      
      
      
    })

I am going to take advantage of plotlyProxy here. If I had set the depth slider range in the original plot definitions above, the plot would be redrawn every darned time I make a change to it. That is slow and painful. Instead, proxies keep the original graph in its’ original state, and it makes slight additions to move it around or change it. Makes everything move faster.

I use an if-then statement for each log track for if it is linear or log scale. Then, I invoke relayout to change the depth range (based on our selected depth slider), and then I change the xAxis range to either 1 to 100 (if linear), or the log10(1) and log10(100) if it is a log scale.

With this last part, everything should now be set up to run.


Summary

That should do it. We have a workable setup for a log analysis tool. Right now though, all we really get are the visuals.

In the next post I will add some bells and whistles. This includes the ability to add tops, to export the main data, and to perform pay calculations.

That is it for this go around. If you have any troubles, feel free to shoot us a comment. You can see a working version over at AFE Leaks. Login instructions can be found here:

AFE Leaks Update

AFE Leaks has been updated. Take a look to get insights into our capital expenditure data for Texas and Louisiana, as well as a taste of our XBRL Financial data.

And while you are at it, give us a follow.

Full code is below:

library(shiny)
library(shinyWidgets)
library(shinydashboard)
library(shinydashboardPlus)
library(shinyjs)
library(plotly)
library(SDAR)
library(dplyr)
library(tidyr)
library(bsplus)
library(DT)
library(rhandsontable)
library(readr)
library(zoo)

options(shiny.maxRequestSize=30*1024^2)
cols <- c('#00a4e3', '#a31c37', '#adafb2', '#d26400', '#eaa814', '#5c1848',
          '#786592', '#ff4e50', '#027971', '#008542', '#5c6d00','#0D1540', '#06357a' )


shinyApp(
  ui = dashboardPagePlus(
    header = dashboardHeaderPlus(
      fixed = TRUE,
      enable_rightsidebar = FALSE
    ),
    sidebar = dashboardSidebar(
    
    ),
    body = dashboardBody(
      useShinyjs(),
      br(),
      br(),
      br(),
      fluidRow(
        column(
          width = 3,
          boxPad(
            color = "gray",
            fileInput("file1", "Choose LAS File",
                      multiple = FALSE,
                      accept = c(".las")),
            
            textOutput('formCheck1'),
            selectInput(
              "depth", 
              "Depth Track",
              c("")
            )
          )
        ),
        column(width = 3,
               h4('Custom Column:'),
               p('Allows user to enter a custom formula based on the columns within the file.
                   The common convention is similar to excel.  For example, if I for some reason wanted to
                   double to DPOR column, the user would enter DPOR*2. Common operators (using DPOR as the variable) are:'),
               p('Simple Math: + - * / ^'),
               p('Square Root: sqrt(DPOR)'),
               p('Natural Log: log(DPOR)'),
               p('Exponential: exp(DPOR)'),
               p('Log Base 10: log10(DPOR)')
        ),
        column(width = 6,
               textInput('userColumn', 'Variable Name (Cannot exist in current table)', placeholder = 'DPOR2'),
               textInput('userFormula', 'Formula (Realize this calculation is meaningless, just an example)', placeholder = 'DPOR*2 + (GR - NPHI)'),
               actionButton('addFormula', '', icon = icon('plus'), class = "btn-primary"),
               textOutput('formCheck'))
      ),
      fluidRow(
        
        column(width = 3,
               selectizeInput(
                 "track1", 
                 "Track 1",
                 c(""),
                 multiple = T
               ),
               
               
               radioButtons('track1Type', '', choices = c('log', 'linear'), selected = 'linear')
        ),
        column(width = 3,
               
               selectizeInput(
                 "track2", 
                 "Track 2",
                 c(""),
                 multiple = T
               ),
               radioButtons('track2Type', '', choices = c('log', 'linear'), selected = 'linear')
        ),
        column(width = 3,
               
               selectizeInput(
                 "track3", 
                 "Track 3",
                 c(""),
                 multiple = T
               ),
               radioButtons('track3Type', '', choices = c('log', 'linear'), selected = 'linear')),
        column(width = 3,
               
               selectizeInput(
                 "track4", 
                 "Track 4",
                 c(""),
                 multiple = T
               ),
               radioButtons('track4Type', '', choices = c('log', 'linear'), selected = 'linear'))
            ),
      fluidRow(
        box(
          title = "Log Presentation",
          status = "primary",
          width = 12,
          
          column(width = 12,
                 sliderInput("depthSlide", label = h3("Depth Interval"), min = 0, 
                             max = 100, value = c(40, 60))
                 
                 
          ),
          fluidRow(
            column(width = 3,
                   rhandsontable::rHandsontableOutput('track1Scale')),
            column(width = 3,
                   rhandsontable::rHandsontableOutput('track2Scale')),
            column(width = 3,
                   rhandsontable::rHandsontableOutput('track3Scale')),
            column(width = 3,
                   rhandsontable::rHandsontableOutput('track4Scale'))
          ),
          fluidRow(
            column(width = 3,
                   
                   plotlyOutput('track1Plot', height = '700px')),
            column(width = 3,
                   
                   plotlyOutput('track2Plot', height = '700px')),
            column(width = 3,
                   
                   plotlyOutput('track3Plot', height = '700px')),
            column(width = 3,
                   
                   plotlyOutput('track4Plot', height = '700px'))
          )
        )
      )
     
    ),
    title = "Log Analysis Tool"
  ),
  server = function(input, output, session) { 
    
    values <- reactiveValues()
    
    observe({
      if(is.null(input$file1$datapath)){
        NULL
      } else {
        
        tryCatch({
          
          values$logFile <- SDAR::read.LAS(input$file1$datapath)
          values$tops <- data.frame(formation = NA, top = NA)
          units <- read_delim(input$file1$datapath, delim = '  ')
          units <- units[,1:2]
          names(units)[1:2] <- c('Component', 'Unit')
          units$Component <- trimws(units$Component)
          units$Unit <- trimws(units$Unit)
          units <- units %>% filter(!is.na(Unit))
          units <- units %>% filter(Component %in% names(values$logFile)) %>% filter(!duplicated(Component))
          values$units <- units
          output$formCheck1 <- renderText('Success')
        },
        error = function(e) {
          e
          output$formCheck1 <- renderText('Error in Upload')
        })
        
        
      }
      
    }
    )
    
    observe({
      if(is.null(values$logFile)||nrow(values$logFile) == 0){
        updateSelectInput(session, 'depth', choices = '')
      } else {
        updateSelectInput(session, 'depth', choices = unique(names(values$logFile)))
      }
    })
    
    
    
    observeEvent(input$depth, {
      
      if(is.null(values$logFile)||nrow(values$logFile) == 0||is.null(input$depth)||input$depth == ''){
       
        updateSelectizeInput(session, 'track1', choices = '')
        updateSelectizeInput(session, 'track2', choices = '')
        updateSelectizeInput(session, 'track3', choices = '')
        updateSelectizeInput(session, 'track4', choices = '')
        updateSliderInput(session, 'depthSlide', min = 0, max = 100, value= c(40,60))
        
      } else {
        
        
        tst2 <- which(names(values$logFile) == input$depth)
        names1 <- names(values$logFile[,-tst2])

        updateSelectizeInput(session, 'track1', choices =names1)
        updateSelectizeInput(session, 'track2', choices =names1)
        updateSelectizeInput(session, 'track3', choices =names1)
        updateSelectizeInput(session, 'track4', choices =names1)
        
        tst1 <- values$logFile %>%data.frame() %>% select(input$depth)
        names(tst1)[1] <- 'depth'
        
        tst1 <- tst1 %>% filter(depth != -999) %>% filter(!is.na(depth))
        tst1$depth <- abs(tst1$depth)
        
        updateSliderInput(session, 'depthSlide', min = min(tst1$depth, na.rm=T), max = max(tst1$depth, na.rm=T),
                          value = c(min(tst1$depth, na.rm=T), max(tst1$depth, na.rm = T)))
      }
      
    })
    
    
    observe({
      if(is.null(values$logFile)||nrow(values$logFile) == 0){
        shinyjs::disable('addFormula')
      } else {
        if(input$userColumn %in% names(values$logFile)||is.null(input$userFormula)||
           input$userFormula == ''||is.null(input$userColumn)||input$userColumn == ''){
          shinyjs::disable('addFormula')
        } else {
          shinyjs::enable('addFormula')
        }
      }
    })
    
    observeEvent(input$addFormula, {
      
    
      tryCatch({
        
        values$logFile <- values$logFile %>% mutate(txt1= eval(parse(text = input$userFormula)))
        names(values$logFile)[length(values$logFile)] <- input$userColumn
        tst2 <- which(names(values$logFile) == input$depth)
        names1 <- names(values$logFile[,-tst2])
        output$formCheck <- renderText('Success')
        updateSelectizeInput(session, 'track1', choices =names1)
        updateSelectizeInput(session, 'track2', choices =names1)
        updateSelectizeInput(session, 'track3', choices =names1)
        updateSelectizeInput(session, 'track4', choices =names1)
        
        
      },
      error = function(e) {
        e
        output$formCheck <- renderText('Error in Formula')
      })
      
    })
    
    output$track1Scale <- rhandsontable::renderRHandsontable({
      if(is.null(input$track1)||input$track1 == ''){
        NULL
      } else {
        
        DF <- data.frame(Component = input$track1, min = 0, max = 150) 
        # print(head(DF))
        # print(head(values$units))
        DF <- DF %>% left_join(values$units)
        
        rhandsontable(DF, rowHeaders = NULL, width = '100%', stretchH = "all") %>%
          hot_col("Component", readOnly = TRUE)
        
      }
    })
    
    output$track2Scale <- rhandsontable::renderRHandsontable({
      if(is.null(input$track2)||input$track2 == ''){
        NULL
      } else {
        
        DF <- data.frame(Component = input$track2, min = 0, max = 150)
        
        DF <- DF %>% left_join(values$units)
        
        rhandsontable(DF, rowHeaders = NULL, width = '100%', stretchH = "all") %>%
          hot_col("Component", readOnly = TRUE)
        
      }
    })
    
    output$track3Scale <- rhandsontable::renderRHandsontable({
      if(is.null(input$track3)||input$track3 == ''){
        NULL
      } else {
        
        DF <- data.frame(Component = input$track3, min = 0, max = 150)
        DF <- DF %>% left_join(values$units)
        
        rhandsontable(DF, rowHeaders = NULL, width = '100%', stretchH = "all") %>%
          hot_col("Component", readOnly = TRUE)
        
      }
    })
    
    output$track4Scale <- rhandsontable::renderRHandsontable({
      if(is.null(input$track4)||input$track4 == ''){
        NULL
      } else {
        
        DF <- data.frame(Component = input$track4, min = 0, max = 150) 
        DF <- DF %>% left_join(values$units)
        
        rhandsontable(DF, rowHeaders = NULL, width = '100%', stretchH = "all") %>%
          hot_col("Component", readOnly = TRUE)
        
      }
    })
    
    output$track1Plot <- renderPlotly({
      if(is.null(input$track1)||input$track1 == ''||is.null(input$track1Scale)){
        NULL
      } else {
        tst2 <- which(names(values$logFile) == input$depth|
                        names(values$logFile) %in% input$track1)
        
        tst1 <- values$logFile[,tst2]
        
        names1 <- which(names(tst1) == input$depth)
        
        names(tst1)[names1] <- 'depth'
        
        dfx <- data.frame(hot_to_r(input$track1Scale))
        
        tst1 <- tst1 %>% gather(Component, value, -depth) %>%
          left_join(dfx)
        
        tst1$plot <- 1+(tst1$value-tst1$min)/(tst1$max-tst1$min)*100
        tst1$depth <- abs(tst1$depth)
        
        
        plot_ly(
          type = 'scatter',
          x = tst1$plot,
          y = tst1$depth,
          group_by = tst1$Component,
          color = tst1$Component,
          colors = cols,
          text = paste(tst1$Component,
                       "<br>Depth: ", tst1$depth,
                       "<br>Value: ", tst1$value),
          hoverinfo = 'text',
          mode = 'lines'
        ) %>%
          layout(dragmode = "select", yaxis =list( range = c(max(tst1$depth), min(tst1$depth))),
                 xaxis = list( range = c(1, 100),
                               title = "",
                               zeroline = FALSE,
                               showline = FALSE,
                               showticklabels = FALSE,
                               showgrid = FALSE)) %>%
          event_register(event = "plotly_brushed") %>%
          event_register(event = 'plotly_click')
      }
    })
    
    output$track2Plot <- renderPlotly({
      if(is.null(input$track2)||input$track2 == ''||is.null(input$track2Scale)){
        NULL
      } else {
        tst2 <- which(names(values$logFile) == input$depth|
                        names(values$logFile) %in% input$track2)
        
        tst1 <- values$logFile[,tst2]
        
        names1 <- which(names(tst1) == input$depth)
        
        names(tst1)[names1] <- 'depth'
        dfx <- data.frame(hot_to_r(input$track2Scale))
        
        tst1 <- tst1 %>% gather(Component, value, -depth) %>%
          left_join(dfx)
        
        tst1$plot <- 1+(tst1$value-tst1$min)/(tst1$max-tst1$min)*100
        tst1$depth <- abs(tst1$depth)
        
        
        
        plot_ly(
          type = 'scatter',
          x = tst1$plot,
          y = tst1$depth,
          group_by = tst1$Component,
          color = tst1$Component,
          colors = cols[4:length(cols)],
          text = paste(tst1$Component,
                       "<br>Depth: ", tst1$depth,
                       "<br>Value: ", tst1$value),
          hoverinfo = 'text',
          mode = 'lines'
        ) %>%
          layout(dragmode = "select", yaxis =list( range = c(max(tst1$depth), min(tst1$depth))),
                 xaxis = list( range = c(1, 100),title = "",
                               zeroline = FALSE,
                               showline = FALSE,
                               showticklabels = FALSE,
                               showgrid = FALSE)) %>%
          event_register(event = "plotly_brushed") %>%
          event_register(event = 'plotly_click')
      }
    })
    
    
    output$track3Plot <- renderPlotly({
      if(is.null(input$track3)||input$track3 == ''||is.null(input$track3Scale)){
        NULL
      } else {
        tst2 <- which(names(values$logFile) == input$depth|
                        names(values$logFile) %in% input$track3)
        
        tst1 <- values$logFile[,tst2]
        
        names1 <- which(names(tst1) == input$depth)
        
        names(tst1)[names1] <- 'depth'
        
        dfx <- data.frame(hot_to_r(input$track3Scale))
        
        tst1 <- tst1 %>% gather(Component, value, -depth) %>%
          left_join(dfx)
        
        tst1$plot <- 1+(tst1$value-tst1$min)/(tst1$max-tst1$min)*100
        tst1$depth <- abs(tst1$depth)
        
        
        
        plot_ly(
          type = 'scatter',
          x = tst1$plot,
          y = tst1$depth,
          group_by = tst1$Component,
          color = tst1$Component,
          colors =cols[7:length(cols)],
          text = paste(tst1$Component,
                       "<br>Depth: ", tst1$depth,
                       "<br>Value: ", tst1$value),
          hoverinfo = 'text',
          mode = 'lines'
        ) %>%
          layout(dragmode = "select",  yaxis =list( range = c(max(tst1$depth), min(tst1$depth))),
                 xaxis = list( range = c(1, 100),title = "",
                               zeroline = FALSE,
                               showline = FALSE,
                               showticklabels = FALSE,
                               showgrid = FALSE)) %>%
          event_register(event = "plotly_brushed") %>%
          event_register(event = 'plotly_click')
      }
    })
    
    
    
    output$track4Plot <- renderPlotly({
      if(is.null(input$track4)||input$track4 == ''||is.null(input$track4Scale)){
        NULL
      } else {
        tst2 <- which(names(values$logFile) == input$depth|
                        names(values$logFile) %in% input$track4)
        
        tst1 <- values$logFile[,tst2]
        
        names1 <- which(names(tst1) == input$depth)
        
        names(tst1)[names1] <- 'depth'
        
        dfx <- data.frame(hot_to_r(input$track4Scale))
        
        tst1 <- tst1 %>% gather(Component, value, -depth) %>%
          left_join(dfx)
        
        tst1$plot <- 1+(tst1$value-tst1$min)/(tst1$max-tst1$min)*100
        tst1$depth <- abs(tst1$depth)
        
        
        plot_ly(
          type = 'scatter',
          x = tst1$plot,
          y = tst1$depth,
          group_by = tst1$Component,
          color = tst1$Component,
          colors =cols[10:length(cols)],
          text = paste(tst1$Component,
                       "<br>Depth: ", tst1$depth,
                       "<br>Value: ", tst1$value),
          hoverinfo = 'text',
          mode = 'lines'
        ) %>%
          layout(dragmode = "select",  yaxis =list( range = c(max(tst1$depth), min(tst1$depth))),
                 xaxis = list( range = c(1, 100),title = "",
                               zeroline = FALSE,
                               showline = FALSE,
                               showticklabels = FALSE,
                               showgrid = FALSE)) %>%
          event_register(event = "plotly_brushed") %>%
          event_register(event = 'plotly_click')
      }
    })
    
    observe({
      if(input$track1Type == 'log'){
        
        plotlyProxy("track1Plot", session) %>%
          plotlyProxyInvoke("relayout", list(yaxis =list( range = c(max(input$depthSlide), min(input$depthSlide))),
                                             xaxis =list(type = 'log', title = "",
                                                         zeroline = FALSE,
                                                         showline = FALSE,
                                                         showticklabels = FALSE,
                                                         showgrid = FALSE,
                                                         autorange = F, range = c(log10(1), log10(100)))))
      } else {
        plotlyProxy("track1Plot", session) %>%
          plotlyProxyInvoke("relayout", list(yaxis =list( range = c(max(input$depthSlide), min(input$depthSlide))),
                                             xaxis =list(type = 'linear', title = "",
                                                         zeroline = FALSE,
                                                         showline = FALSE,
                                                         showticklabels = FALSE,
                                                         showgrid = FALSE,
                                                         autorange = F, range = c(1, 100))))
      }
      
      if(input$track2Type == 'log'){
        
        plotlyProxy("track2Plot", session) %>%
          plotlyProxyInvoke("relayout", list(yaxis =list( range = c(max(input$depthSlide), min(input$depthSlide))),
                                             xaxis =list(type = 'log',title = "",
                                                         zeroline = FALSE,
                                                         showline = FALSE,
                                                         showticklabels = FALSE,
                                                         showgrid = FALSE,
                                                         autorange = F, range = c(log10(1), log10(100)))))
      } else {
        plotlyProxy("track2Plot", session) %>%
          plotlyProxyInvoke("relayout", list(yaxis =list( range = c(max(input$depthSlide), min(input$depthSlide))),
                                             xaxis =list(type = 'linear',title = "",
                                                         zeroline = FALSE,
                                                         showline = FALSE,
                                                         showticklabels = FALSE,
                                                         showgrid = FALSE,
                                                         autorange = F, range = c(1, 100))))
      }
      
      
      if(input$track3Type == 'log'){
        
        plotlyProxy("track3Plot", session) %>%
          plotlyProxyInvoke("relayout", list(yaxis =list( range = c(max(input$depthSlide), min(input$depthSlide))),
                                             xaxis =list(type = 'log',title = "",
                                                         zeroline = FALSE,
                                                         showline = FALSE,
                                                         showticklabels = FALSE,
                                                         showgrid = FALSE,
                                                         autorange = F, range = c(log10(1), log10(100)))))
      } else {
        plotlyProxy("track3Plot", session) %>%
          plotlyProxyInvoke("relayout", list(yaxis =list( range = c(max(input$depthSlide), min(input$depthSlide))),
                                             xaxis =list(type = 'linear',title = "",
                                                         zeroline = FALSE,
                                                         showline = FALSE,
                                                         showticklabels = FALSE,
                                                         showgrid = FALSE,
                                                         autorange = F, range = c(1, 100))))
      }
      
      if(input$track4Type == 'log'){
        
        plotlyProxy("track4Plot", session) %>%
          plotlyProxyInvoke("relayout", list(yaxis =list( range = c(max(input$depthSlide), min(input$depthSlide))),
                                             xaxis =list(type = 'log',title = "",
                                                         zeroline = FALSE,
                                                         showline = FALSE,
                                                         showticklabels = FALSE,
                                                         showgrid = FALSE,
                                                         autorange = F, range = c(log10(1), log10(100)))))
      } else {
        plotlyProxy("track4Plot", session) %>%
          plotlyProxyInvoke("relayout", list(yaxis =list( range = c(max(input$depthSlide), min(input$depthSlide))),
                                             xaxis =list(type = 'linear',title = "",
                                                         zeroline = FALSE,
                                                         showline = FALSE,
                                                         showticklabels = FALSE,
                                                         showgrid = FALSE,
                                                         autorange = F, range = c(1, 100))))
      }
      
      
      
    })
    
    
    }
)

Leave a Reply

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

%d bloggers like this: