firuz.safaev
firuz.safaev

Reputation: 119

How to make a data frame reactive to changes of a date range?

I have got two data frames "Table 1" and "Table 2".

Features of the data frame "Table 2" are the following:

Features of the data frame "Table 1" are the following:

Once data from the "Table 2" is populated in the "Table 1" by an initial insertion of a date range, "Table 1" is NOT getting updated any more by further date-range changes.

Can some show me what is wrong with my script below?

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

DF1 <- data.table(
    "Types" = as.character(c(
                "Type1",
                "Type2")),
    "Initial value" = as.numeric(0),
    "Increase" = as.numeric(0),
    "End value" = as.numeric(0),
    stringsAsFactors = FALSE)

DF2 <- data.table(
    "Date" = as.character(NA),
    "Name" = as.character(NA),
    "Type" = factor(NA, levels = c(NA, "Type1", "Type2"), ordered = TRUE),
    "Initial value" = as.numeric(NA),
    "Increase" = as.numeric(NA),
    "End value" = as.numeric(NA),
    stringsAsFactors = FALSE)

ui <- fluidPage(
  dashboardPage(
    dashboardHeader(),
    dashboardSidebar(
      sidebarMenu(
        menuItem("Item1", tabName = "tab1")
      )
    ),
   dashboardBody(
       tabItems(
        tabItem(tabName = "tab1",
          fluidRow(
            column(
              width = 12, br(),
              dateRangeInput("dates1", "Date Range",
                     start = Sys.Date(), end = Sys.Date(), separator = "-"),
              uiOutput("nested_ui1")),
            column(
              width = 12,
              "Table 1",
              rHandsontableOutput("dataFrame1")
        ),
            column(
              width = 12,
              "Table 2",
              rHandsontableOutput("dataFrame2") 
            )
          )
        )
      )
    )
  )
)

server = function(input, output, session) {

  r <- reactiveValues(
    start = ymd(Sys.Date()),
    end = ymd(Sys.Date())
  )

  data <- reactiveValues()

  observe({
    data$df1 <- as.data.table(DF1)
    data$df2 <- as.data.table(DF2)
  })

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

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

observe({
  if (!is.null(input$dates1) && !any(is.na(input$dates1))) {
    from = as.Date(input$dates1[1L])
    to = as.Date(input$dates1[2L])
    if (from > to) to = from
    selectdates1_1 <- seq.Date(from = from, to = to, by = "day")

    data$df2_3 <- data$df2[as.Date(data$df2$`Date`) %in% selectdates1_1 & 
                              !is.na(data$df2$`Name`) & 
                              !is.na(data$df2$`Type`) &
                              data$df2$`Type` == "Type1", ]
  } else {
    selectdates1_2 <- unique(as.Date(data$df2$`Date`))
    data$df2_3 <- data$df2[data$df2$`Date` %in% selectdates1_2, ]
  }
})

observe({
  if (!is.null(input$dates1) && !any(is.na(input$dates1))) {
    from = as.Date(input$dates1[1L])
    to = as.Date(input$dates1[2L])
    if (from > to) to = from
    selectdates1_3 <- seq.Date(from = from, to = to, by = "day")

    data$df2_4 <- data$df2[as.Date(data$df2$`Date`) %in% selectdates1_3 & 
                              !is.na(data$df2$`Name`) & 
                              !is.na(data$df2$`Type`) &
                              data$df2$`Type` == "Type2", ]
  } else {
    selectdates1_4 <- unique(as.Date(data$df2$`Date`))
    data$df2_4 <- data$df2[data$df2$`Date` %in% selectdates1_4, ]
  }
})

observe({
  if (!is.null(data$df2_3) && 'Type' %in% colnames(data$df2_3)) {
    if (any(data$df2_3$'Type' == "Type1")) {
      data$df1[1, 2:4] <- data$df2_3[, list(
        `Initial value` = sum(`Initial value`, na.rm = TRUE),
        `Increase` = sum(`Increase`, na.rm = TRUE),
        `End value` = sum(`End value`, na.rm = TRUE)
      ), by="Name"][, .(
        `Initial value` = sum(`Initial value`),
        `Increase` = sum(`Increase`),
        `End value` = sum(`End value`)
      )]
    }
  }
})

observe({
  if (!is.null(data$df2_4) && 'Type' %in% colnames(data$df2_4)) {
    if (any(data$df2_4$'Type' == "Type2")) {
      data$df1[2, 2:4] <- data$df2_4[, list(
        `Initial value` = sum(`Initial value`, na.rm = TRUE),
        `Increase` = sum(`Increase`, na.rm = TRUE),
        `End value` = sum(`End value`, na.rm = TRUE)
      ), by="Name"][, .(
        `Initial value` = sum(`Initial value`),
        `Increase` = sum(`Increase`),
        `End value` = sum(`End value`)
      )]
    }
  }
})

output$nested_ui1 <- renderUI({!any(is.na(input$dates1))})

output$dataFrame1 <- renderRHandsontable({
    rhandsontable(data$df1, height = 200, readOnly=TRUE, contextMenu = FALSE)
  })

output$dataFrame2 <- renderRHandsontable({

   data$df2[, `End value` := `Initial value` + `Increase`]

   rhandsontable(data$df2, height = 200) |>
     hot_col(1, dateFormat = "YYYY-MM-DD", type = "date")
 })

}
shinyApp(ui, server)

Upvotes: 0

Views: 47

Answers (0)

Related Questions