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!!
dplyr::filter(...)in the last observe as you may have filter from other packages. - YBS