基于用户变量选择的rshiny动态p值计算

Question

我有一个包含多个变量的数据格式。其中一个是连续的，另一个是绝对的。

我想得到这两个变量之间的wilcoxon检验，这基本上是比较两组样本之间差异的一个度量。当您知道要比较哪些因素时，这是非常容易的。

在基本r中，使用脚本非常容易：

# Pairwise Wilcox Test allow us to obtain multiple tests at the same time
multiple_wilcox <- function(response, factor) {
  pairwise.wilcox.test(response, factor, p.adjust.method = "none")$p.value[, 1]
}

# By default, tests are found against the reference level
with(iris, multiple_wilcox(Sepal.Length, Species))
#>   versicolor    virginica 
#> 8.345827e-14 6.396699e-17

# ... which can be changed with `relevel()`
with(iris, multiple_wilcox(Sepal.Length, relevel(Species, "virginica")))

我希望在闪亮中实现这一点，因此我将获得用户选择的变量的所有p值。

这个反应函数应该做这个工作，因为它是一样的。

  dat <- reactive({
    with(data_input(), multiple_wilcox(input$num_var_2, relevel(input$num_var_1, input$selected_factors)))
    })

但我发现了错误：

​

​

我找不到这个错误的来源，因为数据应该是相同的。

这是RepEx。

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

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

# Plots
library(ggplot2)

not_sel <- "Not Selected"

ui <- navbarPage(
  tabPanel(
    "",
    fluidPage(
      fluidRow(
        sidebarPanel(
          title = "Inputs",
          fileInput("csv_input", "Select CSV file to import", accept = c(".csv")),
          selectInput("num_var_1", "Variable X axis", choices = c(not_sel)),
          selectInput("num_var_2", "Variable Y axis", choices = c(not_sel)),
          uiOutput("binning"),
          br(),
          actionButton("run_button", "Run Analysis", icon = icon("play"))
        ),
        
        # Main panel
        mainPanel(
          tabsetPanel(
            tabPanel(
              "Plot",
              br(),
              verbatimTextOutput("test"),
              uiOutput("var_stats"),
              br(),
              verbatimTextOutput("stats")),
           )
        )
      )
    )
  )
)

server <- function(input, output){
  
  # Load data and update inputs
  data_input <- reactive({
    #req(input$csv_input)
    #inFile <- input$csv_input
    #read.csv(inFile$datapath, 1)
    iris
  })
  
  observeEvent(data_input(),{
    choices <- c(not_sel, names(data_input()))
    updateSelectInput(inputId = "num_var_1", choices = choices)
    updateSelectInput(inputId = "num_var_2", choices = choices)
  })
  
  num_var_1 <- eventReactive(input$run_button, input$num_var_1)
  num_var_2 <- eventReactive(input$run_button, input$num_var_2)
  
  output$var_stats <- renderUI({
    req(input$num_var_1, data_input())
    if (input$num_var_1 != not_sel) {
      a <- unique(data_input()[[input$num_var_1]])
      pickerInput(inputId = 'selected_factors',
                  label = 'Select factors',
                  choices = c(a), selected=a[3], multiple = F,
                  options = list(`actions-box` = TRUE))
    }
    
  })
  
  
  multiple_wilcox <- function(response, factor) {
    pairwise.wilcox.test(response, factor, p.adjust.method = "none")$p.value[, 1]
  }

  dat <- reactive({
    with(data_input(), multiple_wilcox(input$num_var_2, relevel(input$num_var_1, input$selected_factors)))
    })
  
  output$test <- renderPrint({
    dat()
  })
  
}

# Connection for the shinyApp
shinyApp(ui = ui, server = server)

Answer 1

由于relevel()没有在闪亮环境中工作，您可能需要手动更改该因素，如下所示。

not_sel <- "Not Selected"

ui <- navbarPage(
  tabPanel(
    "",
    fluidPage(
      fluidRow(
        sidebarPanel(
          title = "Inputs",
          fileInput("csv_input", "Select CSV file to import", accept = c(".csv")),
          selectInput("num_var_1", "Variable X axis", choices = c(not_sel)),
          selectInput("num_var_2", "Variable Y axis", choices = c(not_sel)),
          uiOutput("binning"),
          br(),
          actionButton("run_button", "Run Analysis", icon = icon("play"))
        ),
        
        # Main panel
        mainPanel(
          tabsetPanel(
            tabPanel(
              "Plot",
              br(),
              verbatimTextOutput("test"),
              uiOutput("var_stats"),
              br(),
              verbatimTextOutput("stats")),
          )
        )
      )
    )
  )
)

server <- function(input, output){
  
  # Load data and update inputs
  data_input <- reactive({
    #req(input$csv_input)
    #inFile <- input$csv_input
    #read.csv(inFile$datapath, 1)
    iris
  })
  
  observeEvent(data_input(),{
    choices <- c(not_sel, names(data_input()))
    updateSelectInput(inputId = "num_var_1", choices = choices)
    updateSelectInput(inputId = "num_var_2", choices = choices)
  })
  
  num_var_1 <- eventReactive(input$run_button, input$num_var_1)
  num_var_2 <- eventReactive(input$run_button, input$num_var_2)
  
  output$var_stats <- renderUI({
    req(input$num_var_1, data_input())
    if (input$num_var_1 != "Not Selected") {
      a <- as.list(as.character(unique(data_input()[[input$num_var_1]])))
      
      pickerInput(inputId = 'selected_factors',
                  label = 'Select factors',
                  choices = list(Factor=a), selected=a[[3]], multiple = F,
                  options = list(`actions-box` = TRUE))
    }
    
  })
  
  
  multiple_wilcox <- function(response, factor) {
    pairwise.wilcox.test(response, factor, p.adjust.method = "none")$p.value[, 1]
  }
  
  dat <- eventReactive(input$run_button, {
    req(data_input(),input$num_var_1,input$num_var_2,input$selected_factors)
    
    #with(data_input(), multiple_wilcox(input$num_var_2, relevel(input$num_var_1, input$selected_factors)))
    
    df <- data_input()
    fac <- unique(data_input()[[input$num_var_1]][data_input()[[input$num_var_1]] != input$selected_factors])
    df$new <- data_input()[[input$num_var_1]]
    newlevels <- c(input$selected_factors,as.character(fac))
    df$new <- factor(df$new, levels=newlevels)
    
    with(df, multiple_wilcox(df[[input$num_var_2]], new))
    
  })
  
  output$test <- renderPrint({
    dat()
  })
  
}

# Connection for the shinyApp
shinyApp(ui = ui, server = server)