Reputation: 119
I have got two data frames "Table 1" and "Table 2".
Features of the data frame "Table 2" are the following:
rhandsontable
and, hence, new rows can be added by right-clicking on the mouse;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