当插入新行时，反应值重置为 NA rhandsontable shiny
reactive value resets to NA when new row inserted rhandsontable shiny
我有一个带有 rhandsontable 和信息框的 Shiny 应用程序，它根据初始预算 (1000) 和用户在 rhandsontable 中输入的值报告剩余预算。
剩余预算的值会根据 W 列的值正确更新，但是，当插入新行时，该值首先会更改为 NA，然后再根据输入的值重新计算。
在添加新值之前，我希望剩余预算信息框的值保持不变。在我的代码下方：
library(shiny)
library(rhandsontable)
library(dplyr)
library(shinydashboard)
ui <- fluidPage( fluidRow(column(6, uiOutput("selA"))),
fluidRow(column(6, rHandsontableOutput('tbl1'))),
fluidRow(column(6,box(title = "Remaining budget", width = 6, status = "info",
textOutput("infoRestBudget"))))
)
server <- function(input, output, session){
dt0 <- data.frame( A = c("S2","S2","S2","S4","S4","S4"),
B = c("1","2","3","1","2","3"),
C = c(10,20,30,40,15,25),
D = c("A","B","C","D","E","F"))
# get the data for the selected BA
dt <- reactive(subset(dt0, A %in% input$selA))
# Render selectInput selBA
output$selA <- renderUI({
ba <- as.vector( unique(dt0$A) )
selectInput("selA","Choose BA", choices = ba)
})
DF <- data.frame("X" = c(""),
"Y" = c(""),
"Z" = c(""),
"Type_action" = c(""),
"W" = NA_integer_)
values <- reactiveValues(data = DF)
Y <- reactiveVal()
Z <- reactiveVal()
observe({
if(!is.null(input$tbl1)){
values$data <- as.data.frame(hot_to_r(req(input$tbl1)))
}
})
observeEvent(input$tbl1,{
Y(hot_to_r(input$tbl1)$Y)},
ignoreInit= TRUE
)
observeEvent(input$tbl1,{
Z(hot_to_r(input$tbl1)$Z)},
ignoreInit= TRUE
)
output$tbl1 = renderRHandsontable({
req(input$selA)
tmpTable <- rhandsontable(values$data, rowHeaders = FALSE, selectCallback = TRUE, width =
1000, height = 200) %>%
hot_table(highlightCol = TRUE, highlightRow = TRUE, stretchH = "all") %>%
hot_col(col = "X", type = "dropdown", colWidths = 90, source =
sort(unique(dt()$B))) %>%
hot_col(col = "Y", type = "dropdown", colWidths = 65, source =
sort(unique(dt()$D))) %>%
hot_col(col = "Z", type = "dropdown", colWidths = 60,source =
sort(unique(dt()$D))) %>%
hot_col(col = "Type_action", colWidths = 50, readOnly = TRUE, type = "text") %>%
hot_col(col = "W", colWidths = 50, readOnly = TRUE, type = "numeric")
if(!is.null(input$tbl1_select$select$r) && !is.na(values$data$Y[input$tbl1_select$select$r])
&& !is.na(values$data$Z[input$tbl1_select$select$r])){
values$data$Type_action <- ifelse(match(Y(), LETTERS) < match(Z(), LETTERS),"Upgrade","Downgrade")
if(!is.null(input$tbl1_select$select$r) && !is.na(values$data$Y[input$tbl1_select$select$r])
&& !is.na(values$data$Z[input$tbl1_select$select$r])){
val <- 100
values$data$W <- ifelse((match(Y(), LETTERS) < match(Z(), LETTERS)), val, -val)
}
}
tmpTable
})
val_W <- reactiveVal()
observeEvent(input$tbl1,{
val_W(hot_to_r(input$tbl1)$W)},
ignoreInit= TRUE
)
budget <- 1000
restBudget <- reactiveValues(val = budget)
observeEvent(input$tbl1, {
if(is.null(input$tbl1)){
restBudget$val <- budget} else{
restBudget$val <- budget - sum(as.numeric(val_W()))
}
}, ignoreInit = TRUE)
output$infoRestBudget <- renderText({
req(input$tbl1)
euro <- "\u20AC"
res <- paste(euro, "", restBudget$val)
res
})
}
shinyApp(ui, server)
试试下面的代码。您得到 NA 是因为出现的新行中没有数据。当 X、Y 或 Z 中有 NA 时，“剩余预算”为 NA，因为它需要计算 non-NA 个值。当您添加新行时，您将 NA 引入计算，因此它变为 NA。
解决方案是为新行设置默认值。在 hot_col(...) 对象中，您可以为新行中的列设置默认值。
我已设置 X = 1、Y = A、Z = A，但请使用您认为最适合您应用的任何值。
library(shiny)
library(rhandsontable)
library(dplyr)
library(shinydashboard)
ui <- fluidPage( fluidRow(column(6, uiOutput("selA"))),
fluidRow(column(6, rHandsontableOutput('tbl1'))),
fluidRow(column(6,box(title = "Remaining budget", width = 6, status = "info",
textOutput("infoRestBudget"))))
)
server <- function(input, output, session){
dt0 <- data.frame( A = c("S2","S2","S2","S4","S4","S4"),
B = c("1","2","3","1","2","3"),
C = c(10,20,30,40,15,25),
D = c("A","B","C","D","E","F"))
# get the data for the selected BA
dt <- reactive(subset(dt0, A %in% input$selA))
# Render selectInput selBA
output$selA <- renderUI({
ba <- as.vector( unique(dt0$A) )
selectInput("selA","Choose BA", choices = ba)
})
DF <- data.frame("X" = c(""),
"Y" = c(""),
"Z" = c(""),
"Type_action" = c(""),
"W" = NA_integer_)
values <- reactiveValues(data = DF)
Y <- reactiveVal()
Z <- reactiveVal()
observe({
if(!is.null(input$tbl1)){
values$data <- as.data.frame(hot_to_r(req(input$tbl1)))
}
})
observeEvent(input$tbl1,{
Y(hot_to_r(input$tbl1)$Y)},
ignoreInit= TRUE
)
observeEvent(input$tbl1,{
Z(hot_to_r(input$tbl1)$Z)},
ignoreInit= TRUE
)
output$tbl1 = renderRHandsontable({
req(input$selA)
tmpTable <- rhandsontable(values$data, rowHeaders = FALSE, selectCallback = TRUE, width =
1000, height = 200) %>%
hot_table(highlightCol = TRUE, highlightRow = TRUE, stretchH = "all") %>%
hot_col(col = "X", type = "dropdown", colWidths = 90, default = "1" , source =
sort(unique(dt()$B))) %>%
hot_col(col = "Y", type = "dropdown", colWidths = 65, default = "A", source =
sort(unique(dt()$D))) %>%
hot_col(col = "Z", type = "dropdown", colWidths = 60, default = "A", source =
sort(unique(dt()$D))) %>%
hot_col(col = "Type_action", colWidths = 50, readOnly = TRUE, type = "text") %>%
hot_col(col = "W", colWidths = 50, readOnly = TRUE, type = "numeric")
if(!is.null(input$tbl1_select$select$r) && !is.na(values$data$Y[input$tbl1_select$select$r])
&& !is.na(values$data$Z[input$tbl1_select$select$r])){
values$data$Type_action <- ifelse(match(Y(), LETTERS) < match(Z(), LETTERS),"Upgrade","Downgrade")
if(!is.null(input$tbl1_select$select$r) && !is.na(values$data$Y[input$tbl1_select$select$r])
&& !is.na(values$data$Z[input$tbl1_select$select$r])){
val <- 100
values$data$W <- ifelse((match(Y(), LETTERS) < match(Z(), LETTERS)), val, -val)
}
}
tmpTable
})
val_W <- reactiveVal()
observeEvent(input$tbl1,{
val_W(hot_to_r(input$tbl1)$W)},
ignoreInit= TRUE
)
budget <- 1000
restBudget <- reactiveValues(val = budget)
observeEvent(input$tbl1, {
if(is.null(input$tbl1)){
restBudget$val <- budget} else{
restBudget$val <- budget - sum(as.numeric(val_W()))
}
}, ignoreInit = TRUE)
output$infoRestBudget <- renderText({
req(input$tbl1)
euro <- "\u20AC"
res <- paste(euro, "", restBudget$val)
res
})
}
shinyApp(ui, server)
我有一个带有 rhandsontable 和信息框的 Shiny 应用程序，它根据初始预算 (1000) 和用户在 rhandsontable 中输入的值报告剩余预算。
剩余预算的值会根据 W 列的值正确更新，但是，当插入新行时，该值首先会更改为 NA，然后再根据输入的值重新计算。 在添加新值之前，我希望剩余预算信息框的值保持不变。在我的代码下方：
library(shiny)
library(rhandsontable)
library(dplyr)
library(shinydashboard)
ui <- fluidPage( fluidRow(column(6, uiOutput("selA"))),
fluidRow(column(6, rHandsontableOutput('tbl1'))),
fluidRow(column(6,box(title = "Remaining budget", width = 6, status = "info",
textOutput("infoRestBudget"))))
)
server <- function(input, output, session){
dt0 <- data.frame( A = c("S2","S2","S2","S4","S4","S4"),
B = c("1","2","3","1","2","3"),
C = c(10,20,30,40,15,25),
D = c("A","B","C","D","E","F"))
# get the data for the selected BA
dt <- reactive(subset(dt0, A %in% input$selA))
# Render selectInput selBA
output$selA <- renderUI({
ba <- as.vector( unique(dt0$A) )
selectInput("selA","Choose BA", choices = ba)
})
DF <- data.frame("X" = c(""),
"Y" = c(""),
"Z" = c(""),
"Type_action" = c(""),
"W" = NA_integer_)
values <- reactiveValues(data = DF)
Y <- reactiveVal()
Z <- reactiveVal()
observe({
if(!is.null(input$tbl1)){
values$data <- as.data.frame(hot_to_r(req(input$tbl1)))
}
})
observeEvent(input$tbl1,{
Y(hot_to_r(input$tbl1)$Y)},
ignoreInit= TRUE
)
observeEvent(input$tbl1,{
Z(hot_to_r(input$tbl1)$Z)},
ignoreInit= TRUE
)
output$tbl1 = renderRHandsontable({
req(input$selA)
tmpTable <- rhandsontable(values$data, rowHeaders = FALSE, selectCallback = TRUE, width =
1000, height = 200) %>%
hot_table(highlightCol = TRUE, highlightRow = TRUE, stretchH = "all") %>%
hot_col(col = "X", type = "dropdown", colWidths = 90, source =
sort(unique(dt()$B))) %>%
hot_col(col = "Y", type = "dropdown", colWidths = 65, source =
sort(unique(dt()$D))) %>%
hot_col(col = "Z", type = "dropdown", colWidths = 60,source =
sort(unique(dt()$D))) %>%
hot_col(col = "Type_action", colWidths = 50, readOnly = TRUE, type = "text") %>%
hot_col(col = "W", colWidths = 50, readOnly = TRUE, type = "numeric")
if(!is.null(input$tbl1_select$select$r) && !is.na(values$data$Y[input$tbl1_select$select$r])
&& !is.na(values$data$Z[input$tbl1_select$select$r])){
values$data$Type_action <- ifelse(match(Y(), LETTERS) < match(Z(), LETTERS),"Upgrade","Downgrade")
if(!is.null(input$tbl1_select$select$r) && !is.na(values$data$Y[input$tbl1_select$select$r])
&& !is.na(values$data$Z[input$tbl1_select$select$r])){
val <- 100
values$data$W <- ifelse((match(Y(), LETTERS) < match(Z(), LETTERS)), val, -val)
}
}
tmpTable
})
val_W <- reactiveVal()
observeEvent(input$tbl1,{
val_W(hot_to_r(input$tbl1)$W)},
ignoreInit= TRUE
)
budget <- 1000
restBudget <- reactiveValues(val = budget)
observeEvent(input$tbl1, {
if(is.null(input$tbl1)){
restBudget$val <- budget} else{
restBudget$val <- budget - sum(as.numeric(val_W()))
}
}, ignoreInit = TRUE)
output$infoRestBudget <- renderText({
req(input$tbl1)
euro <- "\u20AC"
res <- paste(euro, "", restBudget$val)
res
})
}
shinyApp(ui, server)
试试下面的代码。您得到 NA 是因为出现的新行中没有数据。当 X、Y 或 Z 中有 NA 时，“剩余预算”为 NA，因为它需要计算 non-NA 个值。当您添加新行时，您将 NA 引入计算，因此它变为 NA。
解决方案是为新行设置默认值。在 hot_col(...) 对象中，您可以为新行中的列设置默认值。
我已设置 X = 1、Y = A、Z = A，但请使用您认为最适合您应用的任何值。
library(shiny)
library(rhandsontable)
library(dplyr)
library(shinydashboard)
ui <- fluidPage( fluidRow(column(6, uiOutput("selA"))),
fluidRow(column(6, rHandsontableOutput('tbl1'))),
fluidRow(column(6,box(title = "Remaining budget", width = 6, status = "info",
textOutput("infoRestBudget"))))
)
server <- function(input, output, session){
dt0 <- data.frame( A = c("S2","S2","S2","S4","S4","S4"),
B = c("1","2","3","1","2","3"),
C = c(10,20,30,40,15,25),
D = c("A","B","C","D","E","F"))
# get the data for the selected BA
dt <- reactive(subset(dt0, A %in% input$selA))
# Render selectInput selBA
output$selA <- renderUI({
ba <- as.vector( unique(dt0$A) )
selectInput("selA","Choose BA", choices = ba)
})
DF <- data.frame("X" = c(""),
"Y" = c(""),
"Z" = c(""),
"Type_action" = c(""),
"W" = NA_integer_)
values <- reactiveValues(data = DF)
Y <- reactiveVal()
Z <- reactiveVal()
observe({
if(!is.null(input$tbl1)){
values$data <- as.data.frame(hot_to_r(req(input$tbl1)))
}
})
observeEvent(input$tbl1,{
Y(hot_to_r(input$tbl1)$Y)},
ignoreInit= TRUE
)
observeEvent(input$tbl1,{
Z(hot_to_r(input$tbl1)$Z)},
ignoreInit= TRUE
)
output$tbl1 = renderRHandsontable({
req(input$selA)
tmpTable <- rhandsontable(values$data, rowHeaders = FALSE, selectCallback = TRUE, width =
1000, height = 200) %>%
hot_table(highlightCol = TRUE, highlightRow = TRUE, stretchH = "all") %>%
hot_col(col = "X", type = "dropdown", colWidths = 90, default = "1" , source =
sort(unique(dt()$B))) %>%
hot_col(col = "Y", type = "dropdown", colWidths = 65, default = "A", source =
sort(unique(dt()$D))) %>%
hot_col(col = "Z", type = "dropdown", colWidths = 60, default = "A", source =
sort(unique(dt()$D))) %>%
hot_col(col = "Type_action", colWidths = 50, readOnly = TRUE, type = "text") %>%
hot_col(col = "W", colWidths = 50, readOnly = TRUE, type = "numeric")
if(!is.null(input$tbl1_select$select$r) && !is.na(values$data$Y[input$tbl1_select$select$r])
&& !is.na(values$data$Z[input$tbl1_select$select$r])){
values$data$Type_action <- ifelse(match(Y(), LETTERS) < match(Z(), LETTERS),"Upgrade","Downgrade")
if(!is.null(input$tbl1_select$select$r) && !is.na(values$data$Y[input$tbl1_select$select$r])
&& !is.na(values$data$Z[input$tbl1_select$select$r])){
val <- 100
values$data$W <- ifelse((match(Y(), LETTERS) < match(Z(), LETTERS)), val, -val)
}
}
tmpTable
})
val_W <- reactiveVal()
observeEvent(input$tbl1,{
val_W(hot_to_r(input$tbl1)$W)},
ignoreInit= TRUE
)
budget <- 1000
restBudget <- reactiveValues(val = budget)
observeEvent(input$tbl1, {
if(is.null(input$tbl1)){
restBudget$val <- budget} else{
restBudget$val <- budget - sum(as.numeric(val_W()))
}
}, ignoreInit = TRUE)
output$infoRestBudget <- renderText({
req(input$tbl1)
euro <- "\u20AC"
res <- paste(euro, "", restBudget$val)
res
})
}
shinyApp(ui, server)