闪亮的列联表

Question

我有一张桌子：

structure(list(Gender = structure(c(2L, 1L, 2L, 2L, 2L), .Label = c("Female", 
"Male"), class = "factor"), AGE = c(20L, 20L, 15L, 16L, 13L), 
    BOTTLE_CNT = c(3L, 0L, 0L, 1L, 2L), QUALIFICATION_DESC = structure(c(2L, 
    2L, 1L, 2L, 2L), .Label = c("12th and below", "Graduation"
    ), class = "factor")), .Names = c("Gender", "AGE", "BOTTLE_CNT", 
"QUALIFICATION_DESC"), class = "data.frame", row.names = c(NA, 
-5L))

我正在构建一个闪亮的应用程序来呈现列联表。由于它是一个大表，我使用了以下代码：

library(shiny)

shinyApp(
    ui=shinyUI(bootstrapPage(
        fluidRow(
            column(3,
                   div(style = "font-size: 13px;", selectInput("colum", "Select Column Variable", ''))
            ),
            column(3,
                   div(style = "font-size: 13px;", selectInput("rowvar", label = "Select Row Variable", ''))
            )),
        fluidRow(
            tableOutput('foo')    
            )
    )),
    server=shinyServer(function(input, output, session) {

        s <- reactive(
            a
            )


        observe({
            updateSelectInput(session, "colum", choices = sort(as.character(colnames(s()))))
        })

        observe({
            updateSelectInput(session, "rowvar", choices = sort(as.character(colnames(s()))))
        })

        output$foo <- renderTable({
            with(s(), table(input$rowvar, input$colum))
        })
    })
)

而不是with(s(),table……我试过了，用

xtabs(~input$rowvar + input$colum, s())

如果我直接使用列名和行名，两者都不起作用。我想要的是选择的行和列变量，这两个变量的交叉表是必需的。我曾尝试使用来自library(gmodels) 的CrossTable，但无法弄清楚。

Answer 1

您需要将对象传递给table 和input$rowvar 和input$colum 是字符串。

你可以试试：

with(s(), table(get(input$rowvar),get(input$colum)))

如果您想使用xtabs，您可以尝试使用paste 和as.formula 从输入创建公式：

xtabs(as.formula(paste0("~",input$rowvar,"+",input$colum)), s())

另外，您可以设置用户可以直接在ui.R 中选择的值，而不是使用updateSelectInput。

selectInput("colum", "Select Column Variable", sort(as.character(colnames(a))))

如果你想使用updateSelectInput，你可能想在你的renderTable中使用validate/need，否则应用程序在初始化时会抛出一个错误，因为input$colum和input$rowvar在更新之前是NULL ：

output$foo <- renderTable({
      validate(need(input$rowvar,''),
               need(input$colum,''))
      xtabs(as.formula(paste0("~",input$rowvar,"+",input$colum)), s())
    })