Computing statistics in R shiny - first parameter must be numeric type (roman empire!)-CodePudding

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 (no romans unfortunately). Also, for example purposes, 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"), # Choosing group for 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.

CodePudding user response：

It appears to be incorrect call of cohen.d(). Try this

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 <- data_input()[data_input()[[input$num_var_1]] %in% input$selected_group,]
    group_1 <- group_1 %>% mutate(group = input$selected_group)
    group_2 <- data_input()[!(data_input()[[input$num_var_1]] %in% input$selected_group),]
    group_2 <- group_2 %>% mutate(group = paste0("Not_",input$selected_group))
    df <- rbind(group_1,group_2)
    d <- df[,2]
    f <- df[,4]
    cohen.d(d,f)
  })

output$cohensd <- renderPrint(cohensd())

CodePudding user response：

If I run the function cohen.d on two sets of data, it does not return a single number, nor a table, but an output with many things including the estimate of d, a confidence interval, and so on. I think all of this would be what is output in shiny, and it won't necessarily know how to display it as a table. If you just want the single number estimate, then I would suggest specifically pulling out that number and returning it:

library(effsize)
library(tidyverse)

a <- rnorm(20, 0, 1)
b <- rnorm(20, 1, 1)

cohen.d(a, b)

doutput <- cohen.d(a, b)

output.justd <- doutput$estimate

If you want the output to display as a table, e.g., including confidence intervals, then I would suggest making that table at you intend it to be, and then feeding that to renderTable:

library(effsize)
library(tidyverse)

a <- rnorm(20, 0, 1)
b <- rnorm(20, 1, 1)

cohen.d(a, b)

doutput <- cohen.d(a, b)

dtable <- tibble('d' = doutput$estimate,
                 'lowerbound' = doutput$conf.int[[1]],
                 'upperbound' = doutput$conf.int[[2]])

Hopefully this helps. As a note when working with shiny, I would also suggest trying to make your cohen's d function work outside of shiny, just in a standard r session, and see whether the output is as you expect, or if there might be errors in it.

PS - do you mean 'morale', not 'moral'?