Compute dynamic pvalue in rshiny based on users variable selection - r

Question

I have a dataframe with several variables. One of them is continous and the other one is categorical.
I want to obtain wilcoxon test between these two variables, which is basically a metric to compare the difference between two groups of samples.
This is really easy when you know which factors you want to compare.
In base r this is pretty easy with the script:
# 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")))
I would like to implement this in shiny, so I would get all the p-values for a variable selected by the user.
This reactive function should do the work, as it's just the same.
dat <- reactive({
with(data_input(), multiple_wilcox(input$num_var_2, relevel(input$num_var_1, input$selected_factors)))
})
But I'm getting the error:
I don't find where this error is coming from, as the data should be the same.
Here is the 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

As relevel() is not working in shiny, you may need to change the factor manually as shown below.
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)