Question

例如，我的数据集就是那个

col1<-rep(c("a","b","c","d"),3)
col2<-rep(c(1:4),3)
col3<-rep(c("l","m","n"),4)
col4<-rep(c(9:12),3)
df<-data.table(col1,col2,col3,col4)

我正在尝试创建一个新的数据表，其中结果是每列的乘积，其中包含用户给出的值，然后将它们相加为一个

final=l*value1+m*value2

问题是如何使用值创建每列的产品值。

Hera是我的应用

library(shiny)

# Define UI for application that draws a histogram
ui <- fluidPage(

  # Application title
  titlePanel("Old Faithful Geyser Data"),

  # Sidebar with a slider input for number of bins
  sidebarLayout(
    sidebarPanel(
      textInput("value",
                "value"),
      selectInput("choice",
                  "choice",unique(df$col3)),
      actionButton("update", "Update"),actionButton("calculation", "calculation")
    ),

    # Show a plot of the generated distribution
    mainPanel(
      dataTableOutput("table"),dataTableOutput("table2"),dataTableOutput("combined")
    )
  )
)

# Define server logic required to draw a histogram
server <- function(input, output) {
  Data<- reactive({
    if(input$choice == "NULL") {data <- df}
    else {data <- subset(df, col1 == input$choice)}

    data
  })

  output$table<- renderDataTable(Data())



  dat<-c()

  table2 <- eventReactive(input$update, {
    if(!is.null(input$value) && input$update>0 ){
      newrow = data.table(value= input$value,choice=input$choice)
      dat <<- rbind(dat, newrow)
    }
    dat
  }, ignoreNULL = FALSE)

  output$table2<- renderDataTable(table2())

data_wide <-dcast( df, value.var=  "col2", col1~col3)
new<-c()


alldata<-eventReactive(input$calculation, {
  for (i in table2()$choice)
  { new<-c(new,i)}
  data_new<-na.omit(subset(data_wide, select=c("col1",new)))

})
output$combined <-  DT::renderDataTable( alldata())


}
# Run the application
shinyApp(ui = ui, server = server)

table2结果将是

value choice
 2      l
 3      m

如果用户选择列l和值2以及列m和值3，则结果输出将是最后一列

value1 l value2 m final
 2     2   3    3  5  
 2     4   6    3  10
 2     6   9    3  15
 2     8  12    3  20

我添加了此行下方的行但发生此错误警告：*：二进制运算符的非数字参数

出错

  product<-eventReactive(input$calculation, {
    for(j in 2:ncol(alldata())){
      set(alldata, i = NULL, j = j, value = alldata()[[j]] * table2()$value[j-1])
    }
    alldata()
  })
  output$product <-  DT::renderDataTable( product())

}
# Run the application
shinyApp(ui = ui, server = server)

Answer 1

是的，我想我终于明白了。

需要进行以下更改 - 一些化妆品 - 但这些有很大帮助：

将Big dat移动到reactiveValues，因为BigDataScientist建议我们可以摆脱讨厌的<<-作业。
将所有表格输出更改为verbatimPrintOutput，以便在屏幕上显示更多数据，此处不需要renderDataTable所有功能。
为df和data_wide添加了输出。提及data_wide以及如何在问题描述中计算它会有所帮助。
添加了您尝试执行的计算。将数据放在你面前可以更容易地看到需要做什么。
添加了Clear按钮，这样您就不用重新启动程序了。
为值而不是numericInput

textInput

可能还有其他一些我忘记过的小事。

以下是代码：

library(shiny)
library(reshape2)
library(data.table)

col1<-rep(c("a","b","c","d"),3)
col2<-rep(c(1:4),3)
col3<-rep(c("l","m","n"),4)
col4<-rep(c(9:12),3)
df<-data.table(col1,col2,col3,col4)

ui <- fluidPage(

  # Application title
  titlePanel("Old Faithful Column Product Calculations"),

  sidebarLayout(
    sidebarPanel(
      numericInput("value", "Value",value=2,min=-10,max=10),
      selectInput("choice", "choice",unique(df$col3)),
      actionButton("clear", "Clear"),
      actionButton("update", "Update"),
      actionButton("calculation", "calculation")
    ),

    mainPanel(
      h4("df"),verbatimTextOutput("dfout"),
      h4("table"),verbatimTextOutput("table"),
      h4("table2"),verbatimTextOutput("table2"),
      h4("data_wide"),verbatimTextOutput("data_wide"),
      h4("combined"),verbatimTextOutput("combined")
    )  
  )
)


server <- function(input, output) {
  Data<- reactive({

    if(input$choice == "NULL") {data <- df}
    else {data <- subset(df, col3 == input$choice)}

    data
  })

  output$table<- renderPrint(Data())

  rv <- reactiveValues(dat=NULL)

  observeEvent(input$clear,{rv$dat<-NULL})

  table2 <- eventReactive(input$update, {
    if(!is.null(input$value) && input$update>0 ){
      newrow = data.table(value= input$value,choice=input$choice)
      rv$dat <- rbind(rv$dat, newrow)
    }
    rv$dat
  }, ignoreNULL = FALSE)

  output$dfout <- renderPrint(df)
  output$table2<- renderPrint(table2())

  data_wide <-dcast( df, value.var=  "col2", col1~col3) 

  alldata<-eventReactive(input$calculation, {
    t2 <- table2()
    new <- t2$choice
    data_new<-na.omit(subset(data_wide, select=c("col1",new)))
    data_new$final <- 0
    for (i in 1:nrow(t2)){
      c <- t2$choice[i]
      v <- t2$value[i]
      print(sprintf("c:%s  v:%1.f",c,v))
      data_new$final <- data_new$final + v*data_new[[c]]
    }
    data_new
  })
  output$data_wide <-  renderPrint( print(data_wide) )
  output$combined <-  renderPrint( alldata() )
}
shinyApp(ui = ui, server = server)

这是一个截图：

具有闪亮

1 个答案: