The shiny app is forced to disappear when dateRangeInput() in "choice 1" and "choice 3" of selectInput() is manually made empty. Otherwise the code is working well. What should be fixed so that the shiny app does not disappear when date range is blank?
When the shiny app is forced to disappear, RStudio consoly is giving the Error in seq.int: 'to' must be a finite number
The code is the following:
library(data.table)
library(shiny)
library(shinydashboard)
library(lubridate)
library(rhandsontable)
df <- data.table(
dasa = as.character(c("01/01/2020")),
nasa = as.numeric(0),
casa = as.character(c("")),
stringsAsFactors = FALSE
)
cc <- strsplit(df$dasa,"/",fixed=TRUE)
d <- unlist(cc)[3*(1:length(df$dasa))-2]
m <- unlist(cc)[3*(1:length(df$dasa))-1]
y <- unlist(cc)[3*(1:length(df$dasa))]
df$das <- paste0(y,"-",m,"-",d)
ui <- dashboardPage(
dashboardHeader(title = "Financial Statements"),
dashboardSidebar(
menuItem("Home", tabName = "home"),
menuItem("Accounting", tabName = "Recognition",
menuSubItem("item1", tabName = "Item1")
)
),
dashboardBody(
tabItems(
tabItem(
tabName = "Item1",
fluidRow(
column(
width = 6,
"Trial1_col1",
rHandsontableOutput("Trial1_Item1")
),
column(
width = 6,
"Trial1_col2",
selectInput("choices", "Choose an option:",
choices = c("choice 1", "choice 2", "choice 3")), #"choice 3" is added
uiOutput("nested_ui")
),
column(
width = 6,
"Trial1_col3",
rHandsontableOutput("Trial1_Item2")
)
)
)
)
)
)
server <- function(input, output, session) {
data <- reactiveValues()
observe({
data$df <- as.data.frame(df)
})
observe({
if (!is.null(input$Trial1_Item1)) {
dfa <- hot_to_r(input$Trial1_Item1)
cc <- strsplit(dfa$dasa,"/",fixed=TRUE)
d <- unlist(cc)[3*(1:length(dfa$dasa))-2]
m <- unlist(cc)[3*(1:length(dfa$dasa))-1]
y <- unlist(cc)[3*(1:length(dfa$dasa))]
dfa$das <- paste0(y,"-",m,"-",d)
data$df <- dfa
if (!is.null(input$dates)) {
df1 <- data$df
selected_dates <- seq(as.Date(input$dates[1]),
as.Date(input$dates[2]), by = "day")
data$df2 <- df1[as.Date(df1$das) %in% selected_dates, ]
} else if (is.null(input$dates)) {
selected_dates2 <- unique(dfa$dasa)
data$df2 <- dfa[dfa$dasa %in% selected_dates2, ]
}
}
})
observe ({
if (!is.null(input$text) && input$text != "") {
updateTextInput(session, "text", value = input$text)
data$df2 <- data$df[data$df$casa == input$text, ]
}
})
observe({
if (!is.null(input$dates) && input$choices == "choice 3") {
df1 <- data$df
selected_dates <- seq(as.Date(input$dates[1]),
as.Date(input$dates[2]), by = "day")
data$df2 <- df1[as.Date(df1$das) %in% selected_dates & df1$casa == input$text, ]
} else if (!is.null(input$dates)) {
df1 <- data$df
selected_dates <- seq(as.Date(input$dates[1]),
as.Date(input$dates[2]), by = "day")
data$df2 <- df1[as.Date(df1$das) %in% selected_dates, ]
} else if (!is.null(input$text) && input$text != "") {
data$df2 <- data$df[data$df$casa == input$text, ]
} else {
data$df2 <- data$df
}
})
observe({
if (!is.null(input$Trial1_Item2)) {
data$df2 <- hot_to_r(input$Trial1_Item2)
}
})
output$Trial1_Item1 <- renderRHandsontable({
rhandsontable(data$df[,c(1:3)], stretchH = "all", rowHeaderWidth = 50, height = 300) |>
hot_col(1, format = "%d/%m/%Y", type = "date")
})
output$nested_ui <- renderUI({
if (input$choices == "choice 1") {
dateRangeInput("dates", "Select a date range:", format = "dd/mm/yyyy",
start = "2000-01-01", end = Sys.Date())
} else if (input$choices == "choice 2") {
textInput("text", "Enter some text:")
} else if (input$choices == "choice 3") {
fluidRow(
dateRangeInput("dates", "Select a date range:", format = "dd/mm/yyyy",
start = "2000-01-01", end = Sys.Date()),
textInput("text", "Enter some text:")
)
}
})
output$Trial1_Item2 <- renderRHandsontable({
rhandsontable(data$df2[,c(1:3)], stretchH = "all", rowHeaderWidth = 50, height = 300) |>
hot_col(1, format = "%d/%m/%Y", type = "date")
})
}
shinyApp(ui, server)
input$dates is a vector containing the two dates which are defined by the dateRangeInput. If the selection of the input of at least one date is cleared, then this vector contains an NA. Hence, you could extend your if clauses by checking whether there are no NA inside the vector, e.g. using !any(is.na(input$dates)):
library(data.table)
library(shiny)
library(shinydashboard)
library(lubridate)
library(rhandsontable)
df <- data.table(
dasa = as.character(c("01/01/2020")),
nasa = as.numeric(0),
casa = as.character(c("")),
stringsAsFactors = FALSE
)
cc <- strsplit(df$dasa,"/",fixed=TRUE)
d <- unlist(cc)[3*(1:length(df$dasa))-2]
m <- unlist(cc)[3*(1:length(df$dasa))-1]
y <- unlist(cc)[3*(1:length(df$dasa))]
df$das <- paste0(y,"-",m,"-",d)
ui <- dashboardPage(
dashboardHeader(title = "Financial Statements"),
dashboardSidebar(
menuItem("Home", tabName = "home"),
menuItem("Accounting", tabName = "Recognition",
menuSubItem("item1", tabName = "Item1")
)
),
dashboardBody(
tabItems(
tabItem(
tabName = "Item1",
fluidRow(
column(
width = 6,
"Trial1_col1",
rHandsontableOutput("Trial1_Item1")
),
column(
width = 6,
"Trial1_col2",
selectInput("choices", "Choose an option:",
choices = c("choice 1", "choice 2", "choice 3")), #"choice 3" is added
uiOutput("nested_ui")
),
column(
width = 6,
"Trial1_col3",
rHandsontableOutput("Trial1_Item2")
)
)
)
)
)
)
server <- function(input, output, session) {
data <- reactiveValues()
observe({
data$df <- as.data.frame(df)
})
observe({
if (!is.null(input$Trial1_Item1)) {
dfa <- hot_to_r(input$Trial1_Item1)
cc <- strsplit(dfa$dasa,"/",fixed=TRUE)
d <- unlist(cc)[3*(1:length(dfa$dasa))-2]
m <- unlist(cc)[3*(1:length(dfa$dasa))-1]
y <- unlist(cc)[3*(1:length(dfa$dasa))]
dfa$das <- paste0(y,"-",m,"-",d)
data$df <- dfa
if (!any(is.na(input$dates))) {
df1 <- data$df
selected_dates <- seq(as.Date(input$dates[1]),
as.Date(input$dates[2]), by = "day")
data$df2 <- df1[as.Date(df1$das) %in% selected_dates, ]
} else {
selected_dates2 <- unique(dfa$dasa)
data$df2 <- dfa[dfa$dasa %in% selected_dates2, ]
}
}
})
observe ({
if (!is.null(input$text) && input$text != "") {
updateTextInput(session, "text", value = input$text)
data$df2 <- data$df[data$df$casa == input$text, ]
}
})
observe({
if (!any(is.na(input$dates)) && input$choices == "choice 3") {
df1 <- data$df
selected_dates <- seq(as.Date(input$dates[1]),
as.Date(input$dates[2]), by = "day")
data$df2 <- df1[as.Date(df1$das) %in% selected_dates & df1$casa == input$text, ]
} else if (!is.null(input$dates) && !any(is.na(input$dates))) {
df1 <- data$df
selected_dates <- seq(as.Date(input$dates[1]),
as.Date(input$dates[2]), by = "day")
data$df2 <- df1[as.Date(df1$das) %in% selected_dates, ]
} else if (!is.null(input$text) && input$text != "") {
data$df2 <- data$df[data$df$casa == input$text, ]
} else {
data$df2 <- data$df
}
})
observe({
if (!is.null(input$Trial1_Item2)) {
data$df2 <- hot_to_r(input$Trial1_Item2)
}
})
output$Trial1_Item1 <- renderRHandsontable({
rhandsontable(data$df[,c(1:3)], stretchH = "all", rowHeaderWidth = 50, height = 300) |>
hot_col(1, format = "%d/%m/%Y", type = "date")
})
output$nested_ui <- renderUI({
if (input$choices == "choice 1") {
dateRangeInput("dates", "Select a date range:", format = "dd/mm/yyyy",
start = "2000-01-01", end = Sys.Date())
} else if (input$choices == "choice 2") {
textInput("text", "Enter some text:")
} else if (input$choices == "choice 3") {
fluidRow(
dateRangeInput("dates", "Select a date range:", format = "dd/mm/yyyy",
start = "2000-01-01", end = Sys.Date()),
textInput("text", "Enter some text:")
)
}
})
output$Trial1_Item2 <- renderRHandsontable({
rhandsontable(data$df2[,c(1:3)], stretchH = "all", rowHeaderWidth = 50, height = 300) |>
hot_col(1, format = "%d/%m/%Y", type = "date")
})
}
shinyApp(ui, server)