Dynamically compute stats (cohens D) in R shiny

Question

Imagina I have a dataframe that looks like this

Concentration  Value
Low            0.21
Medium         0.85    
Low            0.10
Low            0.36
High           2.21
Medium         0.50
High           1.85

With the pivot_wider function you can transform this into a dataframe where each column is a factors of the first variable Concentration:

Low           Medium         High
c(0.21,...)   c(0.87 ,...)   c(1.47 ,...)

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 these two columns.

In this case, however, I would like to use a function from the apply family to compute the cohend between one factor (one column) and the rest of the factors (all the other columns).

In the case of the iris data, for example, this would be:

library(effsize)
library(tidyverse)

data(iris)

# Extract variables of interest and drop NA
dat1 <- iris[, c("Species", "Sepal.Length")]
dat1 <- dat1 %>%
  drop_na("Sepal.Length")

# Transpose
dat2 <- dat1 %>% 
  group_by(Species) %>% 
  mutate(id = row_number()) %>% 
  pivot_wider(names_from = Species, values_from = Sepal.Length)

dat2 <- dat2[-1]

val <- sapply(dat2[-1], function(i) cohen.d(dat2$setosa, na.omit(i)))
val["estimate", ]

$versicolor
[1] -2.104197

$virginica
[1] -3.077239

I would like to implement this in a ShinyApp, so the user would be able to specify the variables, and then, for which factors he want to compute the stats.

However, I'm having trouble doing this, as Rshiny captures the variable (input$num_var_1) as a character ("Species") and not (Species) as it's requested by group_by() function. You can not use either functions as noquote() or cat() as it changes the object class.

Here you have the Repex.

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

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

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

server <- function(input, output){
  
  # Load data and update inputs
  data_input <- reactive({
    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))
    }
    
  })
  
  # 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]
    
    val <- sapply(df1[-1], function(i) cohen.d(input$selected_factors_stats, na.omit(i)))
    val["estimate", ]
    
  })
  
  output$cohend <- renderPrint({
    dat_cohen()
  })
  
}

shinyApp(ui = ui, server = server)

I believe the only problem is the transpose method that I've used. Maybe other method could be used as well.

Here you can see how the data looks like before applying the cohen.d() function with sapply.

Answer 1

My guess is that you need to inject (?rlang::!!) symbols into the tidyverse data-masking functions (e.g. pivot_wider, mutate, select ...).

See for instance this code:

library(effsize)
library(dplyr)
library(tidyr)

f <- function(input) {
  df <- iris
  # convert to symbol
  nv1 <- sym(input$num_var_1)
  nv2 <- sym(input$num_var_2)
  selected_factor_stats <- sym(input$selected_factor_stats)

  df <- df  %>%
    select(c(!!nv1,!!nv2)) %>%
    drop_na(!!nv1)

  ## Transpose
  df1 <- df %>% 
    group_by(!!nv1) %>% 
    mutate(id = row_number()) %>% 
    pivot_wider(names_from = !!nv1, values_from = !!nv2)

  df1 <- df1[-1]

  val <- sapply(df1[-1], function(i) cohen.d(pull(df1, !!selected_factor_stats), i))
  ## val
  val["estimate", ]
}


input <- list(num_var_1 = "Species",
              num_var_2 = "Sepal.Width",
              selected_factor_stats = "setosa")

f(input)

$versicolor
[1] 1.890995

$virginica
[1] 1.29007

Alternatively, you can use the .data pronoun (see ?rlang::.data) like this:

iris %>% 
    group_by(.data[[input$num_var_1]]) %>% 
    summarize(n = n())

# A tibble: 3 × 2
  Species        n
  <fct>      <int>
1 setosa        50
2 versicolor    50
3 virginica     50