我正在尝试使用rhandsontable记录用户输入并将其传递给Shiny服务器端以进一步处理。 具体来说,对于以下代码,我想添加一列来记录用户输入,并在flexdashboard valueBox中显示列的总和。 但不知何故,reativeValue似乎没有反应。无论我改变第一列Vol_Percent,valueBox都不会改变。有什么建议吗?谢谢!
---
title: "Test"
output:
flexdashboard::flex_dashboard:
orientation: rows
vertical_layout: scroll
runtime: shiny
---
```{r global, include=FALSE}
packages <- c("flexdashboard", "readr", "dplyr", "rhandsontable", "shiny")
for (p in packages) {
library(p, character.only = TRUE, quietly = TRUE)
}
```
Column {.sidebar}
-----------------------------------------------------------------------
### Input and Control
```{r input_panel}
# Input file
fileInput(inputId = "file_property_input", label = "Upload Properties")
```
Row
-----------------------------------------------------------------------
### Properties
```{r property_table}
# Load input data file
values <- reactiveValues()
df_input <- reactive({
validate(need(input$file_property_input, message = FALSE))
input_file <- input$file_property_input
return(read_csv(input_file$datapath))
})
data <- reactive({
if(is.null(values[["data"]])) {
data <- cbind(Vol_Percent = rep(0, nrow(df_input())), data.frame(df_input()))
} else {
data <- values[["data"]]
}
values[["data"]] <- data
return(data)
})
renderRHandsontable({
rhandsontable(data(), search = TRUE, readOnly = TRUE, height = 400) %>%
hot_col("Vol_Percent", readOnly = FALSE) %>%
hot_cols(fixedColumnsLeft = 1) %>%
hot_context_menu(allowRowEdit = FALSE, allowColEdit = FALSE,
customOpts = list(
search = list(name = "Search",
callback = htmlwidgets::JS(
"function (key, options) {
var srch = prompt('Search criteria');
this.search.query(srch);
this.render();
}"))))
})
```
Row
-----------------------------------------------------------------------
### Input Validility
```{r input_valid}
renderValueBox({
info <- "Input Validated"
valueBox(value = info, icon = ifelse(info == "Input Validated", "fa-check", "fa-times"), color = ifelse(info == "Input Validated", "success", "danger"))
})
```
### Total Percentage
```{r information}
renderValueBox({
rate <- sum(values[["data"]]$Vol_Percent)
valueBox(value = rate, icon = ifelse(rate == 100, "fa-check", "fa-times"), color = ifelse(rate == 100, "success", "warning"))
})
```
答案 0 :(得分:1)
我根据此处发布的示例计算出来了 https://github.com/jrowen/rhandsontable/blob/master/inst/examples/rhandsontable_portfolio/server.R
这是更新后的代码
---
title: "Test"
output:
flexdashboard::flex_dashboard:
orientation: rows
vertical_layout: scroll
runtime: shiny
---
```{r global, include=FALSE}
packages <- c("flexdashboard", "readr", "dplyr", "rhandsontable", "shiny")
for (p in packages) {
library(p, character.only = TRUE, quietly = TRUE)
}
```
Column {.sidebar}
-----------------------------------------------------------------------
### Input and Control
```{r input_panel}
# Input file
fileInput(inputId = "file_property_input", label = "Upload Properties")
```
Row
-----------------------------------------------------------------------
### Properties
```{r property_table}
# Load input data file
values <- reactiveValues(hot = NULL)
sum_percentage <- reactive({
return(sum(values[["hot"]]$Vol_Percent))
})
df_input <- reactive({
validate(need(input$file_property_input, message = FALSE))
input_file <- input$file_property_input
return(read_csv(input_file$datapath))
})
output$hot <- renderRHandsontable({
data <- NULL
if (is.null(values[["hot"]])) {
values[["hot"]] <- cbind(Vol_Percent = rep(0, nrow(df_input())), data.frame(df_input()))
}
if (!is.null(input$hot)) {
data <- hot_to_r(input$hot)
values[["hot"]] <- data
} else if (!is.null(values[["hot"]])) {
data <- values[["hot"]]
}
if (!is.null(data)) {
rhandsontable(data, search = TRUE, readOnly = TRUE, height = 400) %>%
hot_col("Vol_Percent", readOnly = FALSE) %>%
hot_cols(fixedColumnsLeft = 1) %>%
hot_context_menu(allowRowEdit = FALSE, allowColEdit = FALSE,
customOpts = list(
search = list(name = "Search",
callback = htmlwidgets::JS(
"function (key, options) {
var srch = prompt('Search criteria');
this.search.query(srch);
this.render();
}"))))
}
})
rHandsontableOutput("hot")
```
Row
-----------------------------------------------------------------------
### Input Validility
```{r input_valid}
renderValueBox({
info <- "Input Validated"
valueBox(value = info, icon = ifelse(info == "Input Validated", "fa-check", "fa-times"), color = ifelse(info == "Input Validated", "success", "danger"))
})
```
### Total Percentage
```{r information}
renderValueBox({
rate <- ifelse(!is.null(sum_percentage()), sum_percentage(), 0)
valueBox(value = rate, icon = ifelse(rate == 100, "fa-check", "fa-times"), color = ifelse(rate == 100, "success", "warning"))
})
```