时间戳

首页 > 解决方案 > 带有数字输入和反应列的 R 闪亮数据表

r - 带有数字输入和反应列的 R 闪亮数据表

问题描述

我正在构建一个闪亮的数据表，其中一列用于数字输入，另一列用于输入。它类似于您可以在 Excel 中使用嵌入在单元格中的方程来执行的操作。我在下面给出鸢尾花的例子并尝试计算花瓣面积。所以花瓣面积等于 Petal.Length*Petal.Width/Adjust。调整参数将由用户输入以调整区域。此处提出了类似的问题，但没有直接答案。 为每一行插入一个数字输入 - R Shiny

library(shiny)
library(DT)
library(dplyr)

ui <- basicPage(

  DT::dataTableOutput('x1')
)

server <- function(input, output, session) { 
  # create a character vector of shiny inputs 
  shinyInput = function(FUN, len, id, ...) { 
    inputs = character(len) 
    for (i in seq_len(len)) { 
      inputs[i] = as.character(FUN(paste0(id, i), label = NULL, ...))
    } 
    inputs 
  } 

  # obtain the values of inputs 
  shinyValue = function(id, len) { 
    unlist(lapply(seq_len(len), function(i) { 
      value = input[[paste0(id, i)]] 
      if (is.null(value)) 1 else value 
    })) 
  } 

  # a sample data frame 
  DF <- reactive(
    iris <- iris %>%
      mutate(
        adjust = shinyInput(numericInput, nrow(iris), 'adj', value = 1),
        Petal_Area = Petal.Length*Petal.Width/shinyValue('adj', nrow(iris)) 
      )
  )

  # render the table containing shiny inputs 
  output$x1 = DT::renderDataTable(

    # use slider to control number of rows shown in table
    DF(), server = FALSE, escape = FALSE, options = list( 
      preDrawCallback = JS('function() { 
                           Shiny.unbindAll(this.api().table().node()); }'), 
      drawCallback = JS('function() { 
                        Shiny.bindAll(this.api().table().node()); } ') 
      ) 
      ) 
} 

shinyApp(ui, server)

标签： rdatatableshinydplyrdt

解决方案

这是一个不完整的答案。希望其他用户可以改进它。如果不是，那么这是最好的答案。

我现在尝试了大约半小时，但由于某种原因（可能原因DT不是像 Excel 那样使用），我无法在DT-table 中得到计算结果。但是，如果我不在DT-table 中显示结果，反应性和计算就会起作用！

我只做了两个改变：

  1. 我添加了一个调试表
  2. 我替换了您的dplyr-code 并删除了计算

代码如下所示：

library(shiny)
library(DT)

ui <- basicPage(
  DT::dataTableOutput('x1'),
  tableOutput('debug')
)

server <- function(input, output, session) { 
  # create a character vector of shiny inputs 
  shinyInput = function(FUN, len, id, ...) { 
    inputs = character(len) 
    for (i in seq_len(len)) { 
      inputs[i] = as.character(FUN(paste0(id, i), label = NULL, ...))
    } 
    inputs 
  } 

  # obtain the values of inputs 
  shinyValue = function(id, len) { 
    unlist(lapply(seq_len(len), function(i) { 
      value = input[[paste0(id, i)]] 
      if (is.null(value)) 1 else value 
    })) 
  } 

  # a sample data frame 
  DF <- reactive({
    iris_adj <- iris
    iris_adj$adjust<-shinyInput(numericInput, nrow(iris), 'adj', value = 1)
    # iris_adj$Petal_area<-iris$Petal.Length*iris$Petal.Width/shinyValue('adj',nrow(iris))
    return(iris_adj)
  })


  # render the table containing shiny inputs 
  output$x1 <- DT::renderDataTable(

    # use slider to control number of rows shown in table
    DF(), server = FALSE, escape = FALSE, options = list( 
      preDrawCallback = JS('function() { 
                           Shiny.unbindAll(this.api().table().node()); }'), 
      drawCallback = JS('function() { 
                        Shiny.bindAll(this.api().table().node()); } ') 
      ) 
      )
  output$debug<-renderTable({
    cbind(DF()[,-6],shinyValue('adj',nrow(iris)),Petal_Area=iris$Petal.Length*iris$Petal.Width/shinyValue('adj',nrow(iris)))
  })
      } 

shinyApp(ui, server)

一旦我添加了计算，输出DT就不会找到它进入调试表的方式。

就个人而言：我记得大约半年前使用过这个shinyInput和技巧。shinyValue我还记得那是非常非常不稳定的。我不会向任何想要开发稳定应用程序的人推荐它

我还记得有另一个用于完整交互式表格的 R 包。它被称为rhandsontables。也许试试看：https ://jrowen.github.io/rhandsontable/

推荐阅读