根据用户输入获取列联表 - R Shiny

Posted 2023-02-14

【中文标题】根据用户输入获取列联表 - R Shiny

【英文标题】：Obtain contingecy table based on users input - Rshiny

【发布时间】：2022-01-20 11:00:24

【问题描述】：

如果我想先获得 Fisher 测试，我需要一个列联表。我可以简单地为Arthritis 包做到这一点：

library(vcd)
data(Arthritis)
freq <- as.data.frame.matrix(table(Arthritis$Treatment, Arthritis$Improved))
> freq
        None Some Marked
Placebo   29    7      7
Treated   13    7     21

所以我可以做一个 Fisher 测试：

        Not marked Marked
Placebo   36           7
Treated   20          21

现在，我想要在闪亮中做的是允许用户选择两个分类变量（Treatment 和 Improved），然后通过另一个（Gender）过滤并获得列联表。

我可以稍后使用这个来获得 2x2 频率。但现在这就是我所拥有的：

# Shiny
library(shiny)
library(shinyWidgets)
library(shinyjqui)

# Data
library(vcd)
library(readxl)
library(dplyr)
library(arules) # Discretization

# Plots
library(ggplot2)


not_sel <- "Not Selected"

ui <- fluidPage(
  
  
  titlePanel("Plotter"),
    sidebarPanel(
      fileInput("xlsx_input", "Select XLSX file to import", accept = c(".xlsx")),
      selectInput("num_var_1", "Variable X axis", choices = c(not_sel)),
      selectInput("num_var_2", "Variable Y axis", choices = c(not_sel)),
      selectInput("biomarker", "Select Biomarker", choices = c(not_sel)), uiOutput("factor")
      ),
    mainPanel(
      tabsetPanel(
        tabPanel(
          verbatimTextOutput("test")
        
      )
    )
  )
)



## Server ##

server <- function(input, output)
  
  # Dynamic selection of the data. We allow the user to input the data that they want 
  data_input <- reactive(
    #req(input$xlsx_input)
    #inFile <- input$xlsx_input
    #read_excel(inFile$datapath, 1)
    Arthritis
  )
  
  # We update the choices available for each of the variables
  observeEvent(data_input(),
    choices <- c(not_sel, names(data_input()))
    updateSelectInput(inputId = "num_var_1", choices = choices)
    updateSelectInput(inputId = "num_var_2", choices = choices)
    updateSelectInput(inputId = "biomarker", choices = choices)
  )
  
  num_var_1 <- eventReactive(input$run_button, input$num_var_1)
  num_var_2 <- eventReactive(input$run_button, input$num_var_2)
  biomarker <- eventReactive(input$run_button, input$biomarker)
  
  output$factor <- renderUI(
    req(input$biomarker, data_input())
    if (input$biomarker != not_sel) 
      b <- unique(data_input()[[input$biomarker]])
      pickerInput(inputId = 'selected_factors',
                  label = 'Select factors',
                  choices = c(b[1:length(b)]), selected=b[1], multiple = TRUE,
                  # choices = c("NONE",b[1:length(b)]), selected="NONE", If we want "NONE" to appear as the first option
                  # multiple = TRUE,  ##  if you wish to select multiple factor values; then deselect NONE
                  options = list(`actions-box` = TRUE)) #options = list(`style` = "btn-warning"))
    
  )
  
  
  data_stats_discrete <- reactive(
    req(data_input(), input$num_var_1, input$num_var_2, input$biomarker) 
    # We filter by biomarker in case user selected, otherwise data_input() remains the same
    if (input$biomarker != "Not Selected") df <- data_input()[data_input()[[input$biomarker]] %in% input$selected_factors,]
    else df <- data_input()
    df <- as.data.frame.matrix(table(.data[[input$num_var_1]], .data[[input$num_var_2]]))
    df
  )
  
  output$test <- renderPrint(data_stats_discrete())
  
  



shinyApp(ui = ui, server = server)

正如您在此 RepEx 中所见，data_stats_discrete 中未选择任何数据帧。

【参考方案1】：

改变

df <- as.data.frame.matrix(table(.data[[input$num_var_1]], .data[[input$num_var_2]]))

到

df <- as.data.frame.matrix(table(df[[input$num_var_1]], df[[input$num_var_2]]))