Shiny - Reactive filter function issue

Question

Hope someone can help with this tricky one: The Shiny app runs perfectly with the template Excel but when the user loads a new file and refreshes the calculation, this error appears:

Warning: Unknown or uninitialised column: `Distribution`.
Warning: Unknown or uninitialised column: `Distribution`.
Warning: Unknown or uninitialised column: `Distribution`.
Warning: Error in : Problem with `filter()` input `..1`.
x Input `..1` must be of size 3 or 1, not size 0.
i Input `..1` is `!is.na(rv$RRDTRaw$Likelihood) & !is.na(rv$RRDTRaw$Distribution)`.
  59: <Anonymous>

This issue only shows when the last "observe" function with a filter function in it is activein the code. If I comment it, the issue is gone. See below the code:

## LIBRARIES
        library(tidyverse)
        library(stats)
        library(data.table)
        library(triangle)
        library(base)
        library(matrixStats)
        library(ggplot2)
        library(ggthemes)
        library(readxl)
        library(httr)
        library(shiny)

## DEFINITIONS

    vQuantiles <- c(P00 = 0, P05 = .05, P50 = .50, P80 = .80, P95 = .95, P100 = 1)
        vtQuantiles <- names(vQuantiles)

    MCScenarioTotals <- list()
    MCTotalsQuantiles <- list()
    MCRecordsQuantiles <- list()
    MCRecordsQuantilesTop10 <- list()

## LOAD RR TEMPLATES

    ExcelTemplate <- tempfile(fileext = ".xlsx")
    GET(url = "https://www.openmontecarlo.com/SampleS.xlsx",write_disk(ExcelTemplate))
    defaultRR <- read_excel(ExcelTemplate)

## DEFINE UI

ui <-

fluidPage(
    hr(),
    h1("Monte Carlo Simulation",align = "center"),

    fluidRow(
        hr(),
        column(3,
            checkboxGroupInput("ISvModels", label = h3("Step 1:",br(),"Select which Models to Run"), 
            choices = list(
            "100 Scenarios" = 100,
            "1000 Scenarios" = 1000,
            "5000 Scenarios" = 5000,
            "10000 Scenarios" = 10000),
            selected = 100),offset = 1
        ),

        column(7,
            selectInput("templateSelection",h3("Step 2:",br(),"Select an existing Risk Register sample"),
                c(1,2,3,4),selected = 3,multiple = FALSE,selectize = TRUE,width = NULL,size = NULL),
            
            fileInput("userExcel", h3("Or upload your own Risk Register"),accept = ".xlsx"),
            offset = 1,
        ),
    ),
    hr(),

    fluidRow(
        column(5,
            h3("Step 3: Click to run the models"),
            offset = 1,
        ),

        column(6,
            br(),
            actionButton(inputId = "Refresh", label = "Run Simulation",
            ),
            offset = 0,
        ),
    ),
    hr(),

    mainPanel(  

        h3(strong("Risk Register - Imported Data")),
        br(),
        dataTableOutput("SRRImport"),

        h3(strong("Risk Register - Raw Data")),
        br(),
        dataTableOutput("SRRDTRaw"),

        h3(strong("Risk Register - Invalid Likelihood Data")),
        br(),
        dataTableOutput("SLikelihoodQADrop"),

        h3(strong("Risk Register - Invalid Impact Data")),
        br(),
        dataTableOutput("SImpactQADrop"),

        h3(strong("Risk Register - Valid Data")),
        br(),
        dataTableOutput("SRRDT"),

    )
)

server <- function(input, output) {

## CREATE DEFAULT RR AND REACTIVE VARIABLES

rv <- reactiveValues(
    inputRR = tempfile(fileext = ".xlsx"),
    inputPath = NULL,
    vModels = c(100),
    RRImport = defaultRR,
    RRuserExcel = data.frame(),
    RRDTRaw = data.frame(),
    LikelihoodQADrop = data.frame(),
    ImpactQADrop = data.frame(),
    RRDT = data.frame(),
    nDrop = 0,
    nRisks = 1,
    RRDTLong = data.frame()
    )

# SHINY INPUT REFRESH

    observeEvent(input$Refresh,{if (is.null(input$userExcel)) {rv$RRImport <- defaultRR}
        else {
        rv$inputPath <- input$userExcel
        output$SinputPath <- renderPrint({rv$inputPath[,4]})
        rv$inputRR <- read_excel(paste0(rv$inputPath[,4]))
        rv$RRImport <- rv$inputRR
        }
    })

# data.frame(suppressWarnings(

    output$SRRImport <- renderDataTable({rv$RRImport})

    observe({rv$nRisksImported <- nrow(rv$RRImport)})
        output$SnRisksImported <- renderPrint({rv$nRisksImported})

## PROCESS MODELS INPUT

    observeEvent(input$Refresh,{rv$vModels <- as.numeric(unlist(input$ISvModels))})
        output$vModelsText <- renderPrint({unlist(rv$vModels)})

    qtModels <- reactive({length(unlist(rv$vModels))})
        output$qtModelsText <- renderPrint({unlist(qtModels())})

    vtModels <- reactive({paste0("M",1:qtModels()," n = ",rv$vModels," scenarios")})
        output$vtModelsText <- renderPrint({unlist(vtModels())})

## RR RAW

    observe({rv$RRDTRaw <- rv$RRImport})
    observe({rv$RRDTRaw$Likelihood <- suppressWarnings(as.numeric(rv$RRDTRaw$Likelihood))})
    observe({rv$RRDTRaw$Min <- suppressWarnings(as.numeric(rv$RRDTRaw$Min))})
    observe({rv$RRDTRaw$ML <- suppressWarnings(as.numeric(rv$RRDTRaw$ML))})
    observe({rv$RRDTRaw$Max <- suppressWarnings(as.numeric(rv$RRDTRaw$Max))})
      
## QUALITY CHECK LIKELIHOOD

    observe({rv$RRDTRaw$Likelihood <- ifelse (rv$RRDTRaw$Likelihood <=0 | rv$RRDTRaw$Likelihood >=100,NA,rv$RRDTRaw$Likelihood)})

    observe({rv$LikelihoodQADrop <- rv$RRImport[which(is.na(rv$RRDTRaw$Likelihood)),]})
        output$SLikelihoodQADrop <- renderDataTable({rv$LikelihoodQADrop})

## CLASSIFY AND QUALITY CHECK DISTRIBUTIONS

    observe({rv$RRDTRaw <- mutate(rv$RRDTRaw,Distribution = case_when(is.na(rv$RRDTRaw$Min) & is.na(rv$RRDTRaw$Max) & !is.na(rv$RRDTRaw$ML) ~ "Single Point",
                                        is.na(rv$RRDTRaw$ML) & !is.na(rv$RRDTRaw$Min) & !is.na(rv$RRDTRaw$Max) & rv$RRDTRaw$Min<rv$RRDTRaw$Max ~ "Uniform",
                                        !is.na(rv$RRDTRaw$Min) & !is.na(rv$RRDTRaw$Max) & !is.na(rv$RRDTRaw$ML) & rv$RRDTRaw$Min<rv$RRDTRaw$ML & rv$RRDTRaw$ML<rv$RRDTRaw$Max ~ "3 Points"))
            })
        output$SRRDTRaw <- renderDataTable({rv$RRDTRaw})

    observe({rv$ImpactQADrop <- rv$RRImport[which(is.na(rv$RRDTRaw$Distribution)),]})
        output$SImpactQADrop <- renderDataTable({rv$ImpactQADrop})

## DROP + DECLARE NAs AND PROCEED + PRINT THE RISK REGISTER

    observe({rv$RRDT <- filter(rv$RRDTRaw, !is.na(rv$RRDTRaw$Likelihood) & !is.na(rv$RRDTRaw$Distribution))})

}

# Run the app ----
shinyApp(ui = ui, server = server)

Difficult to understand how the functions can work for the first automatically loaded file and why the user input file breaks the app. This happens even if I upload the same file as the template.

Hope you can help. Thanks!!

Answer 1

Your read_excel is not working for the user input file as it is just a path. Try read_xlsx as shown below.

observeEvent(input$Refresh,{if (is.null(input$userExcel)) {rv$RRImport <- defaultRR}
    else {
      inFile <- input$userExcel
      rv$inputPath <- inFile
      output$SinputPath <- renderPrint({rv$inputPath[,4]})
      #rv$inputRR <- read_excel(paste0(rv$inputPath[,4]))
      rv$inputRR <- read_xlsx(inFile$datapath, sheet =  1)
      rv$RRImport <- rv$inputRR
    }
  })