产品与闪亮

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) 

我想创建一个新的DataTable，结果就是从给定的与值每列的产品用户然后将它们总结为一个像

final=l*value1+m*value2 

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

荷拉是我的应用程序

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) 

表2的结果将是

value choice 
2  l 
3  m 

，并且如果用户选择列升和值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 

我在下面添加了这个行但是发生了这个错误 Warning ：*中的错误：二进制运算符的非数字参数

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

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

需要进行以下修改进行 - 些化妆品 - 但那些帮助了很多：

• 移动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) 

这里是一个屏幕截图：