Allow user to dynamically select the factor to compute statistics in shinyApp

Question

I have a dataframe as follows:

dat <- data.frame(Concentration = c("Placebo","Placebo","Placebo","Placebo","Placebo","Placebo","Low","Low","Low","Low","Low","Low", "Medium", "Medium", "Medium", "Medium", "Medium", "Medium", "High", "High", "High", "High", "High", "High"),
                 Value = c(0.0400, 0.04, 0.0200, 0.03, -0.00500, 0.0300, -0.04, 0, -0.1, -0.0200,  -0.0100, -0.0100, 0.0100, -0.0100, -0.05, 0.03,  0.0200, NA, 0.0100, 0.04, -0.0200, -0.00700, 0.0100, NA))

There's a function called cohen.d() from the library(effsize) package, that allows you to calculate the effect size between two groups. You could do, for exmaple, cohen.d(dat$Low, dat$Medium) to obtain the effect size between this two columns.

However, I would like to create a shinyApp that allows the user to select two variables, and compute the cohensD between one of the columns and the rest of them based on the user's selection.

So in the previous example, the user would choose for example Placebo, and obtain the cohens D between Placebo vs Low, Placebo vs Medium, etc.

In the following RepEx you can find the app, almost finished.

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

# Data
library(readxl)
library(dplyr)
library(vcd)
library(effsize)
library(RcppAlgos)
library(psych)
library(tidyverse)

not_sel <- "Not Selected"

dat <- data.frame(Concentration = c("Placebo","Placebo","Placebo","Placebo","Placebo","Placebo","Low","Low","Low","Low","Low","Low", "Medium", "Medium", "Medium", "Medium", "Medium", "Medium", "High", "High", "High", "High", "High", "High"),
                 Value = c(0.0400, 0.04, 0.0200, 0.03, -0.00500, 0.0300, -0.04, 0, -0.1, -0.0200,  -0.0100, -0.0100, 0.0100, -0.0100, -0.05, 0.03,  0.0200, NA, 0.0100, 0.04, -0.0200, -0.00700, 0.0100, NA))



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("cohend"),),
           )
        )
      )
    )
  )
)



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

  # Cohens D
  dat_cohen <- reactive({
    req(data_input(), input$num_var_1, input$num_var_2, input$selected_factors_stats)
    df <- data_input()
    # Select variables of interest
    df <- df[, c(input$num_var_1, input$num_var_2)]
    #Drop NA
    df <- df %>%
      drop_na(input$num_var_2)
    # Transpose
    df1 <- df %>% 
      group_by_(input$num_var_1) %>% 
      mutate(id = row_number()) %>% 
      pivot_wider(names_from = input$num_var_1, values_from = input$num_var_2)
    
    df1 <- df1[-1]
    
    #as.vector(unlist(df1[, input$selected_factors_stats]))
    
    a <- lapply(df[-1], function(x) {
      x1 <- na.omit(cbind(as.vector(unlist(df1[, input$selected_factors_stats])), as.vector(unlist(x))))
      cohen.d(x1[,1], x1[,2])
    })
    
  })
  
  output$cohend <- renderPrint({
    dat_cohen()
  })
  

}

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

However, there's an error in the dat_cohen() function; more specifically here.

    a <- lapply(df[-1], function(x) {
      x1 <- na.omit(cbind(as.vector(unlist(df1[, input$selected_factors_stats])), as.vector(unlist(x))))
      cohen.d(x1[,1], x1[,2])
    })

When executed, the app says:

Error: invalid 'row.names' length But I can't manage to find a solution.

Thanks

Answer 1

I think it is cleaner if you move the estimation of cohen's D out of the server, like this:

est_cohens <- function(df,v1,v2,s) {
  df = df %>%
    select(all_of(c(v1,v2))) %>% 
    drop_na(all_of(v2)) %>%
    group_by(across(v1)) %>% 
    mutate(id = row_number()) %>% 
    pivot_wider(names_from=all_of(v1), values_from = all_of(v2)) %>% 
    select(-id)
  
  lapply(df %>% select(-all_of(s)), function(x) cohen.d(na.omit(x),na.omit(df[[s]])))
  
}

Then, in your server function, you can reduce to :

dat_cohen <- reactive({
  est_cohens(data_input(),
             input$num_var_1,
             input$num_var_2,
             input$selected_factors_stats
  )
})