如何基于另一个闪亮的表构建聚合表?

时间:2017-10-29 19:39:15

标签: r shiny

我希望UI中的输出表具有基于"第3列和第34列的文本的条件列和。

这是我的示例代码:

library(shiny)
runApp(list(
ui=pageWithSidebar(headerPanel("Adding entries to table"),
                 sidebarPanel(textInput("text1", "Column 1", "66"),
                              textInput("text2", "Column 2", "100"),
                              textInput("text3", "Column 3", "Tony"),
                              actionButton("update", "Update Table")),
                 mainPanel(tableOutput("table1"))),
server=function(input, output, session) {
values <- reactiveValues()
values$df <- data.frame(Column3 = character(), 
                        Column1 = numeric(0), 
                        Column2 = numeric(0),
                        stringsAsFactors = FALSE)
newEntry <- observe({
  if(input$update > 0) {
    newLine <- isolate(c(input$text3, input$text1, input$text2))
    isolate(values$df[nrow(values$df) + 1,] <- c(input$text3, 
input$text1, input$text2))
  }
})
output$table1 <- renderTable({values$df})
}))

如果您点击&#34;更新表&#34;按钮两次,我想看到的输出表是:

`1    Tony    132    200`

&#34;第3栏和第34栏中的名字;将取决于侧边栏的输入值。输出表应该观察到,然后返回所有名称和&#34;列1和#34; &#34;第2列和第34列的总和;在那个名字下。

我尝试使用values$df上的聚合函数创建一个新数据框,但它无效。

1 个答案:

答案 0 :(得分:0)

我想这就是你的目标。我在代码中添加了适当的注释,供您理解。希望它有所帮助!

library(shiny)
    runApp(list(
      ui=pageWithSidebar(headerPanel("Adding entries to table"),
                         sidebarPanel(textInput("text1", "Column 1", "66"),
                                      textInput("text2", "Column 2", "100"),
                                      textInput("text3", "Column 3", "Tony"),
                                      actionButton("update", "Update Table")),
                         mainPanel(tableOutput("table1"))),
      server=function(input, output, session) {
        values <- reactiveValues()
        values$df <- data.frame(Column3 = character(), 
                                Column1 = numeric(0), 
                                Column2 = numeric(0),
                                stringsAsFactors = FALSE)
        observeEvent(input$update,{
          # if(input$update > 0) {#This is not required as this observeEvent will only be triggered when we click 'update' button 
            newLine <- isolate(c(input$text3, input$text1, input$text2))
            #If any column 3 has already been updated, just add the other columns
            if(any(values$df$Column3 == input$text3))
            {
              #Get the row where there is match in the Column3
              matchRow = which(values$df$Column3 == input$text3)
              #Just add the values in column2 and column3 with input values
              values$df$Column1[matchRow] <- as.numeric(values$df$Column1[matchRow])+as.numeric(input$text1)
              values$df$Column2[matchRow] <- as.numeric(values$df$Column2[matchRow])+as.numeric(input$text2)

            }else{#Just add the new rows

              isolate(values$df[nrow(values$df) + 1,] <- c(input$text3, 
                                                           input$text1, input$text2))
            }
          # }
        })
        output$table1 <- renderTable({values$df})
      }))