data filtering based on dateRangeInput()

Question

I have two data frames "df" and "df2". I want data of the "df" to be rearranged as the "df2" by a selected date range in dateRangeInput(). However, it is simply not working. I cannot figure out what is wrong with the script below.

I think, the following interconnected two parts of the whole code have to be reviewed, namely:

The 1st part:

observe({
  if (!is.null(input$dates) && length(input$dates) == 4 && !any(is.na(input$dates))) {
     selected_dates <- seq(as.Date(input$dates[1], format = "%d.%m.%Y"), 
                           as.Date(input$dates[2], format = "%d.%m.%Y"), by = "day")
     data$df2 <- df[df$dasa %in% selected_dates, ]
     } else {
    selected_dates2 <- character(0)
    data$df2 <- df[df$dasa %in% selected_dates2, ]
    }
 })

and, the 2nd Part:

    output$Trial1_Item2 <- renderRHandsontable({
        rhandsontable(data$df2, stretchH = "all", rowHeaderWidth = 50, height = 300) |>
            hot_col(1, format = "%d.%m.%Y", type = "date")
    })

Here is the whole code:

library(data.table)
library(shiny)
library(shinydashboard)
library(rhandsontable)

df <- data.table(
    dasa = as.character(c("03.01.2000", "04.01.2000", "05.01.2000", "03.02.2000", "10.02.2000",     "25.03.2000")),
    nasa = as.numeric(c(23, 32, 34, 43, 51, 15)),
    casa = as.character(c("abc123", "bcd123", "fgh808", "abc123", "cde909", "fgh303")),
    stringsAsFactors = FALSE
)

ui <- dashboardPage(
    dashboardHeader(title = "Financial Statements of Uzbekistan"),
    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")),
                        uiOutput("nested_ui")
                    ),
                    column(
                        width = 6,
                        "Trial1_col3",
                        rHandsontableOutput("Trial1_Item2")
                    )
                )
            )
        )
    )
)

server <- function(input, output) {
    data <- reactiveValues()

    observe({
        data$df <- as.data.frame(df)
    })

    observe({
        if (!is.null(input$Trial1_Item1))
            data$df <- hot_to_r(input$Trial1_Item1)
    })

    observe({
        if (!is.null(input$Trial1_Item2))
            data$df2 <- hot_to_r(input$Trial1_Item2)
    })

observe({
  if (!is.null(input$dates) && length(input$dates) == 4 && !any(is.na(input$dates))) {
     selected_dates <- seq(as.Date(input$dates[1], format = "%d.%m.%Y"), 
                           as.Date(input$dates[2], format = "%d.%m.%Y"), by = "day")
     data$df2 <- df[df$dasa %in% selected_dates, ]
     } else {
    selected_dates2 <- character(0)
    data$df2 <- df[df$dasa %in% selected_dates2, ]
    }
 })

    output$Trial1_Item1 <- renderRHandsontable({
        rhandsontable(data$df, 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")
        } else if (input$choices == "choice 2") {
            textInput("text", "Enter some text:")
        }
    })

    output$Trial1_Item2 <- renderRHandsontable({
        rhandsontable(data$df2, stretchH = "all", rowHeaderWidth = 50, height = 300) |>
            hot_col(1, format = "%d.%m.%Y", type = "date")
    })
}

shinyApp(ui, server)

Answer 1

Perhaps your date format is the issue. You can try using YYYY-MM-DD format dates. Try this

library(data.table)
library(shiny)
library(shinydashboard)
library(rhandsontable)

df <- data.table(
  dasa = as.character(c("03.01.2000", "04.01.2000", "05.01.2000", "03.02.2000", "10.02.2000", "25.03.2000")),
  nasa = as.numeric(c(23, 32, 34, 43, 51, 15)),
  casa = as.character(c("abc123", "bcd123", "fgh808", "abc123", "cde909", "fgh303")),
  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 of Uzbekistan"),
  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")),
            uiOutput("nested_ui")
          ),
          column(
            width = 6,
            "Trial1_col3",
            rHandsontableOutput("Trial1_Item2")
          )
        )
      )
    )
  )
)

server <- function(input, output) {
  data <- reactiveValues()

  observe({
    data$df <- as.data.frame(df)
  })

  observe({
    if (!is.null(input$Trial1_Item1))
      data$df <- hot_to_r(input$Trial1_Item1)
  })

  observe({
    if (!is.null(input$Trial1_Item2))
      data$df2 <- hot_to_r(input$Trial1_Item2)
  })

  observe({

    if (!is.null(input$dates)) { # && length(input$dates) == 4 && !any(is.na(input$dates))) {
      selected_dates <- seq(as.Date(input$dates[1]),
                            as.Date(input$dates[2]), by = "day")
      data$df2 <- df[as.Date(df$das) %in% selected_dates, ]

    } else {
      selected_dates2 <- character(0)
      data$df2 <- df[df$dasa %in% selected_dates2, ]
    }
  })

  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 = "2000-03-31")
    } else if (input$choices == "choice 2") {
      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)