Сделать фрейм данных реагирующим на SelectInput()
У меня есть два фрейма данных df и df2. Согласно приведенному ниже коду df2 должен содержать данные из df при фильтрации по dateRangeInput(). Однако df2 не реагирует на выбранный диапазон дат при добавлении новых строк в df. Чего мне не хватает в приведенном ниже коде?
library(data.table)
library(shiny)
library(shinydashboard)
library(lubridate)
library(rhandsontable)
df <- data.table(
dasa = as.character(c("01/05/2024", "04/06/2024")),
nasa = as.numeric(2,3),
casa = as.character(c("abc", "def")),
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")),
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)) {
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 <- unique(df$dasa)
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 = "2024-01-01", end = Sys.Date())
} 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)
У меня все работает, если df не равно нулю и вы выбираете правильные даты.
Я не могу вставить df какие-либо заранее заданные записи. Ожидается, что пользователи будут создавать свои собственные данные. Поэтому df остается пустым. Следуя приведенному выше совету YBS, я создал новые строки в df как пользователь, но проблема все еще не решена.
Я также попробовал добавить df несколько строк с заранее заданными примерами записей, которые впоследствии изменил. df2 предоставляет только предопределенные данные df и не обновляется после изменения данных в df. Кроме того, df2 не показывает строки df, которые не были вставлены изначально, а были созданы заново.
Вы не показываете, как пользователь создает новые записи в этом MRE. Возможно, проблема в формате даты во входных данных. Кроме того, вам необходимо определить, как ваше приложение должно реагировать при отсутствии записей (изначально).
дорогой YBS, я обновил свой код выше. Согласно вашему замечанию, я добавил две образцы строк в df. Можно поиграть с dateRangeInput(), чтобы отфильтровать существующие строки или добавить их. Щелкнув правой кнопкой мыши, можно добавить новые строки в df и попытаться изменить диапазон дат в dateRangeInput(), чтобы охватить эти новые строки. Тем не менее, df2 не реагирует на фильтр в этих вновь созданных строках df. Также есть еще одна проблема: когда даты изначально существующих двух строк df изменяются, df2 не обновляется соответствующим образом. Следовательно, я определенно должен что-то упустить или сделать неправильно в своем коде.
Ответы 1
Для обновления data$df вам необходимо использовать обновленный фрейм данных data$df2. Попробуй это
library(data.table)
library(shiny)
library(shinydashboard)
library(lubridate)
library(rhandsontable)
df <- data.table(
dasa = as.character(c("01/05/2024", "04/06/2024")),
nasa = as.numeric(2,3),
casa = as.character(c("abc", "def")),
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")),
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)) {
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
# print(data$df)
if (!is.null(input$dates)) {
# print(input$dates[2])
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, ]
}
# print(data$df2)
}
})
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:")
}
})
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)
дорогой YBS, твое решение идеально. Спасибо за ваше время и усилия! Отличная работа!
У вас
dfздесь ноль записей. Как вы собираетесь его подмножество получитьdf2?