LeArNr LeArNr - 1 month ago 17
R Question

contingency table in shiny

I have a table:

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))


I am building a shiny app to render a contingency table. Since its a large table, I have used the following code:

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))
})
})
)


Instead of with(s(), table...... I have tried, using

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


Neither works however both works if i use the column and row names directly. What I want is for the row and column variables selected, a cross tab of those two variables is required. I have tried using
CrossTable
from
library(gmodels)
, yet couldn't figure out.

Answer

You need to pass objects to table and input$rowvar and input$colum are string.

You could try:

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

If you want to use xtabs, you could try creating the formula from the inputs using paste and as.formula:

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

Also, instead of using the updateSelectInput, you could set the values the user can select directly in the ui.R.

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

If you want to use updateSelectInput, you might want to use validate/need in your renderTable, otherwise the app throws an error when it initialises because the input$colum and input$rowvar are NULL before they are updated:

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