'Compute statistic for more than two levels dynamically

I would like my shinyApp to be able to compute statistics for all the combination of factor levels of a given variable.

In the case of Iris dataset, for example, the user would be able to select the categorical variable (species) and the continous variable (any other).

Then, the user would be able to select the factor of the categorical variable (versicolor, virginica, setosa). The shinyApp then will compute the statistic for all the other factors against the chosen one.

More precisely this statistic is the cohens d (cohen.d, effsize package) which is one of the most common way of measuring effect size.

This is the code that I have:

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

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

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(),
              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_stats',
                  label = 'Select factors',
                  choices = c(a), selected=a[3], multiple = F,
                  options = list(`actions-box` = TRUE))
    }
    
  })
    
  multiple_cohens <- function(response, factor) {
    cohen.d(response, factor, paired = TRUE)$estimate
  }
    
  dat_cohen <- reactive({
    req(data_input(),input$num_var_1,input$num_var_2,input$selected_factors_stats)
    
    #with(data_input(), multiple_wilcox(input$num_var_2, relevel(input$num_var_1, input$selected_factors)))
    
    df <- data_input()
    df <- df %>% drop_na(input$num_var_2)
    fac <- unique(data_input()[[input$num_var_1]][data_input()[[input$num_var_1]] != input$selected_factors_stats])
    df$new <- df[[input$num_var_1]]
    newlevels <- c(input$selected_factors_stats,as.character(fac))
    df$new <- factor(df$new, levels=newlevels)
    
    with(df, multiple_cohens(df[[input$num_var_2]], new))
    
  })
  
  output$stats <- renderPrint({
    dat_cohen()
  })
   
}

shinyApp(ui = ui, server = server)

The dat_cohen is working properly, however, I didn't find a way of iterating with multiple_cohens



Sources

This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.

Source: Stack Overflow

Solution Source