Computing statistics in Rshiny (roman empire!)

[RoyBatty]

Hello everyone.

Roman history fan here. So I have created a small dataframe with some legions (fifth and tirteenth), their casualties (numerical), and their moral (high, medium, low).

Legion <- c("Fifth", "Fifth", "Fifth","Fifth","Fifth","Tirteenth","Tirteenth", "Tirteenth", "Tirteenth","Tirteenth")
Casualties <- c(13, 34,23,123,0,234,3,67,87,4)
Moral <- c("High", "Medium", "Low","High", "Medium", "Low","High", "Medium", "Low", "High")
romans <- data.frame(Legion, Casualties, Moral)

I want to compute some statistics with this data. More precisely, I want to know if the moral is influenced by the casualties, for which I want to compute wilcox test and cohensd,
and eventually, filter by legion.

This is what I have (please notice this is a toy example, in reality there are many variables for x, y and factor variable. Also, for example porpuses, I'm going to show only the cohens d):

Legion <- c("Fifth", "Fifth", "Fifth","Fifth","Fifth","Tirteenth","Tirteenth", "Tirteenth", "Tirteenth","Tirteenth")
Casualties <- c(13, 34,23,123,0,234,3,67,87,4)
Moral <- c("High", "Medium", "Low","High", "Medium", "Low","High", "Medium", "Low", "High")
romans <- data.frame(Legion, Casualties, Moral)

# Shiny
library(shiny)
library(shinyWidgets)
# Data
library(readxl)
library(dplyr)
# Data
library(effsize)

# Objects and functions
not_sel <- "Not Selected"

main_page <- tabPanel(
  title = "Romans",
  titlePanel("Romans"),
  sidebarLayout(
    sidebarPanel(
      title = "Inputs",
      fileInput("xlsx_input", "Select XLSX file to import", accept = c(".xlsx")),
      selectInput("num_var_1", "Variable X axis", choices = c(not_sel)),
      selectInput("num_var_2", "Variable Y axis", choices = c(not_sel)),
      selectInput("factor", "Select factor", choices = c(not_sel)), uiOutput("leg"),
      uiOutput("group"), # This group will be the main against the one we will perform the statistics
      br(),
      actionButton("run_button", "Run Analysis", icon = icon("play"))
    ),
    mainPanel(
      tabsetPanel(
        tabPanel(
          title = "Statistics",
          verbatimTextOutput("cohensd"),
          verbatimTextOutput("wilcoxt")
        )
      )
    )
  )
)


# User interface -----------------------------------------
ui <- navbarPage(
  main_page
)


# Server ------------------------------------------------
server <- function(input, output){
  
    data_input <- reactive({
    #req(input$xlsx_input)
    #inFile <- input$xlsx_input
    #read_excel(inFile$datapath, 1)
    romans
  })
  
  # We update the choices available for each of the variables
  observeEvent(data_input(),{
    choices <- c(not_sel, names(data_input()))
    updateSelectInput(inputId = "num_var_1", choices = choices)
    updateSelectInput(inputId = "num_var_2", choices = choices)
    updateSelectInput(inputId = "factor", choices = choices)
  })
  
  # Allow user to select the legion
  output$leg <- renderUI({
    req(input$factor, data_input())
    if (input$factor != not_sel) {
      b <- unique(data_input()[[input$factor]])
      pickerInput(inputId = 'selected_factors',
                  label = 'Select factors',
                  choices = c(b[1:length(b)]), selected=b[1], multiple = TRUE,
                  # choices = c("NONE",b[1:length(b)]), selected="NONE", If we want "NONE" to appear as the first option
                  # multiple = TRUE,  ##  if you wish to select multiple factor values; then deselect NONE
                  options = list(`actions-box` = TRUE)) #options = list(`style` = "btn-warning"))
      
    }
  })
  
  # This will allow us to select the main group for the stats (e.g: High vs low and med)
  output$group <- renderUI({
    req(input$num_var_1, data_input())
    c <- unique(data_input()[[input$num_var_1]])
    pickerInput(inputId = 'selected_group',
                label = 'Select group for statistics',
                choices = c(c[1:length(c)]), selected=c[1], multiple = FALSE,
                options = list(`actions-box` = TRUE)) #options = list(`style` = "btn-warning"))
    })
  
  num_var_1 <- eventReactive(input$run_button, input$num_var_1)
  num_var_2 <- eventReactive(input$run_button, input$num_var_2)
  factor <- eventReactive(input$run_button, input$factor)
  
  
  ## Revise how to print the stats dynamically -----------------------------------
  # Obtain statistics dynamically
  cohensd <- eventReactive(input$run_button,{
    req(input$factor, data_input())
    if (!is.null(input$selected_factors)) df <- data_input()[data_input()[[input$factor]] %in% input$selected_factors,]
    else df <- data_input()
    # We create two vectors, one for the group selected and the other one for the none selected
    group_1 <- df[df[[input$num_var_1]] %in% input$selected_group,]
    group_2 <- df[!(df[[input$num_var_1]] %in% input$selected_group),]
    cohen.d(group_1, group_2)
  })
  
  output$cohensd <- renderTable(cohensd())
}
# Connection for the shinyApp
shinyApp(ui = ui, server = server)

After executing it for high moral (that should be the cohens d for High vs Medium and Low):

As you can see, this code prompts the error (not numeric value)
group_1 and group_2 are stored as html, but I don't know why is that.
Any help would be appreciated.

[nirgrahamuk]

you've named your input num_var_1 but then allowed choices to be non-numerics, for example moral which is not numeric.
so perhaps, apply more rigour to allow only numeric variable selections. It seems Casualties is the only numeric you provided in your example dataset.
your choices could be

select(romans,where(is.numeric)) %>% names()

e.g.

"Casualties"