產品與閃亮

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) 

這裏是一個屏幕截圖：