1

我正在尝试使用 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"))
})

```
4

1 回答 1

2

我根据此处发布的示例找到了它 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"))
})

```
于 2017-02-28T15:06:51.217 回答