rshinyrhandsontable

data filtering based on dateRangeInput()


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)

Solution

  • 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)