Background

This is a brief post about making my first Shiny App (see also). I made this app following a meeting of the Advancing Social Cognition lab (ASC-Lab) where we discussed this paper by Yzerbyt et al. (2018) proposing a new method for mediation analysis. Any attempt to detail the differences in methods is well beyond the scope of a blog post. The take home message is that the method proposed by Yzerbyt et al. (2018) is less prone to Type I errors (or false positives) than the most commonly used methods (e.g., Hayes 2017). In addition to identifying a problem and proposing a solution, the authors also provide the tools to implement their solution with an R package (Batailler et al. 2019). Unfortunately, not everyone uses R, and this is why I set about developing a simple way for SPSS users to access this new method.

Regression and JS Mediation

Before I describe the Shiny App, I’ll briefly demonstrate the 2 functions that are included in the Shiny App. I’ll use the built in dataset mtcars and investigate the relationship between 1/4 mile time (qsec), gross horsepower (hp) and weight (wt), specifically¹:

• does horsepower predict 1/4 mile time?
• and is this relationship mediated by weight?

df <- mtcars          # create df from mtcars

# create new variables with generic names
df$dv <- df$qsec      # save 1/4 mile time as dv
df$iv <- df$hp        # save horsepower as iv
df$mediator <- df$wt  # save weight as mediator

fit <- lm(dv ~ iv + mediator, data=df)  # save the regression in an object 'fit'
summary(fit)                            # show the results
## 
## Call:
## lm(formula = dv ~ iv + mediator, data = df)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -1.8283 -0.4055 -0.1464  0.3519  3.7030 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 18.825585   0.671867  28.020  < 2e-16 ***
## iv          -0.027310   0.003795  -7.197 6.36e-08 ***
## mediator     0.941532   0.265897   3.541  0.00137 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.09 on 29 degrees of freedom
## Multiple R-squared:  0.652,  Adjusted R-squared:  0.628 
## F-statistic: 27.17 on 2 and 29 DF,  p-value: 2.251e-07

JS_model <- mdt_simple(data = df, # create an object 'JS_model'
                       DV = dv,
                       IV = iv,
                       M  = mediator)
add_index(JS_model)               # display the results of the mediation
## Test of mediation (simple mediation)
## ==============================================
## 
## Variables:
## 
## - IV: iv 
## - DV: dv 
## - M: mediator 
## 
## Paths:
## 
## ====  ==============  =====  ======================
## Path  Point estimate     SE  APA                   
## ====  ==============  =====  ======================
## a              0.009  0.002  t(30) = 4.80, p < .001
## b              0.942  0.266  t(29) = 3.54, p = .001
## c             -0.018  0.003  t(30) = 5.49, p < .001
## c'            -0.027  0.004  t(29) = 7.20, p < .001
## ====  ==============  =====  ======================
## 
## Indirect effect index:
## 
## - type: Indirect effect 
## - point estimate: 0.00885 
## - confidence interval:
##   - method: Monte Carlo (5000 iterations)
##   - level: 0.05 
##   - CI: [0.00337; 0.0156]
## 
## Fitted models:
## 
## - X -> Y 
## - X -> M 
## - X + M -> Y

Building a Shiny App

The full code for the app is below, for the next sections I’ll go through some of the key pieces of code.²

# UI for app
ui<-(pageWithSidebar(

# We use headerPanel() to give a title to our app 
  headerPanel("JS Mediation"),
  
# use sidebarPanel() to create the content of the side panel (panel on the left)
  sidebarPanel
  (
# use fileInput() to create a dialogue for inputting a file
    fileInput("file1", "Upload SPSS File",
              multiple = TRUE,
              accept = c(".sav")),
# create a horizontal line break
    tags$hr(),
    
# create a dropdown menu for selecting the dataset to be used
    selectInput("dataset","Data:",
                choices =list(iris = "iris",
                              mtcars = "mtcars",
                              uploaded_file = "inFile"), selected=NULL),
# create a dropdown menu for selecting the dependent variable to be used
    selectInput("dv","Dependent Variable:", choices = NULL),
# create a dropdown menu for selecting the Independent variable to be used
    selectInput("iv","Independent Variable:", choices = NULL),
# create a dropdown menu for selecting the mediator to be used
    selectInput("mediator","Mediator:", choices = NULL) #,
    
# use HTML() to input formatted text describing the App
    ,HTML('In response to 
    <a href="https://perso.uclouvain.be/vincent.yzerbyt/Yzerbyt%20et%20al.%20JPSP%202018.pdf">this</a>
    paper by Yzerbyt, Batailler and Judd (2018) which outined a new method of conducting mediation analyses
    (with less susceptability to false positives than Hayes’ PROCESS) I created a ShinyApp so that their
    R-package could be used by SPSS users. Upload your SPSS file above and select the variables you wish
    to compare.')
    ,br(),br(),br()
    ,HTML('<p>Yzerbyt, V., Muller, D., Batailler, C., & Judd, C. M. (2018). New Recommendations for
    Testing Indirect  Effects in Mediational Models: The Need to Report and Test Component Paths.
    <em>Journal of Personality and Social Psychology: Attitudes and Social Cognition</em>, 115(6), 
    929–943. <a href="http://dx.doi.org/10.1037/pspa0000132"
    class="uri">http://dx.doi.org/10.1037/pspa0000132</a></p>')
  ),
  
# use mainPanel() to create the panel on the right where the output of our tests will be
  mainPanel(
# give a title to the the first output
    h3("Summary of Regression Model"),
# report the result of the regression, saved in the object 'fit'
    verbatimTextOutput("fit"),
# give a title for the second output
    h3("Mediation Results"),
# report the result of the mediation, saved in the object 'mediation'
    verbatimTextOutput("mediation")
  )
))

 upload_data<-reactive({
    inFile <- input$file1
    if (is.null(inFile))
      return(NULL)
    read.spss(input$file1$datapath, to.data.frame = TRUE)
  })
  
  observeEvent(input$file1,{
    inFile<<-upload_data()
  })

# update variables based on the data
  observe({
# make sure upload exists
    if(!exists(input$dataset)) return() 
# retrieve names of columns (variable names) and save as 'var.opts'
    var.opts<-colnames(get(input$dataset))
# set var.opts as the options for the drop down menus
    updateSelectInput(session, "dv", choices = var.opts)
    updateSelectInput(session, "iv", choices = var.opts)
    updateSelectInput(session, "mediator", choices = var.opts)
  })

 
# get data object
  get_data<-reactive({
    if(!exists(input$dataset)) return() # if no upload
    check<-function(x){is.null(x) || x==""}
    if(check(input$dataset)) return()
# retrieve the selected data and create objects and     
    obj<-list(data=get(input$dataset),
              dv=input$dv,
              iv=input$iv,
              mediator=input$mediator
    )
    
# require all to be set to proceed
    if(any(sapply(obj,check))) return()
# make sure choices had a chance to update
    check<-function(obj){
      !all(c(obj$dv,obj$iv,obj$mediator) %in% colnames(obj$data))
    }
    if(check(obj)) return()
# return 'obj' on completion     
    obj
  })
  

  output$fit <- renderPrint({
# create an object 'data_list', which is a list that contains the selected data and variables
    dataset_list <- get_data()
    
# isloate the elements in the list as separate objects    
    a <- dataset_list$dv
    b <- dataset_list$iv
    m <- dataset_list$mediator
    c <- dataset_list$data
   
# create a dataframe 'df' from the object 'c' the selected dataset    
    df <- `colnames<-`(
      cbind.data.frame(
# we extract and use the variables from 'c' that have the same names as those selected
        c[which(colnames(c)==a)],
        c[which(colnames(c)==b)],
        c[which(colnames(c)==m)]
      ), c("dv","iv","mediator"))
# now we have a dataframe df with 3 variables named 'dv', 'iv', and 'mediator'

# we need to ensure data is numeric
    df$dv <- suppressWarnings(as.numeric(df$dv))
    df$iv <- suppressWarnings(as.numeric(df$iv))
    df$mediator <- suppressWarnings(as.numeric(df$mediator))
    
# using the same code previously discussed, we run the regression    
    fit <- lm(dv ~ iv + mediator, data=df)
    summary(fit) # show results
    
  })

  output$mediation <- renderPrint({
# create an object 'data_list', which is a list that contains the selected data and variables
    dataset_list <- get_data()
    
# isloate the elements in the list as separate objects    
    a <- dataset_list$dv
    b <- dataset_list$iv
    m <- dataset_list$mediator
    c <- dataset_list$data
    
# create a dataframe 'df' from the object 'c' the selected dataset    
    df <- `colnames<-`(
      cbind.data.frame(
# we extract and use the variables from 'c' that have the same names as those selected
        c[which(colnames(c)==a)],
        c[which(colnames(c)==b)],
        c[which(colnames(c)==m)]
      ), c("dv","iv","mediator"))
# now we have a dataframe df with 3 variables named 'dv', 'iv', and 'mediator'
    
# we need to ensure data is numeric
    df$dv <- suppressWarnings(as.numeric(df$dv))
    df$iv <- suppressWarnings(as.numeric(df$iv))
    df$mediator <- suppressWarnings(as.numeric(df$mediator))

# and we run the mediation using the same code as at the beginning of this post    
    JS_model <- mdt_simple(data = df,
                           DV = dv,
                           IV = iv,
                           M  = mediator)
    add_index(JS_model)
  })

Conclusion

Above I have described how I went about making my first Shiny App which makes a new method of mediation analysis accessible to SPSS users. Feel free to try it out (although I have not paid for a premium account with Shiny, so it might time out).

Both the mtcars dataset and the iris dataset are preloaded in the app if you want to try it but you don’t have any SPSS files to upload. If you are an R user hopefully this post might help you to make your own Shiny Apps to make R functionality available to your SPSS using colleagues. Many thanks to the examples online that helped me, particularly this example for uploading files and working with them.

(also if you have any suggestions for improving the app, or if I have left anything out, let me know)

library(shiny)
library(foreign)
library(purrr)
library(dplyr)
library("devtools")
#install.packages("JSmediation")
library(JSmediation)



# UI for app
ui<-(pageWithSidebar(
  
  # We use headerPanel() to give a title to our app 
  headerPanel("JS Mediation"),
  
  # use sidebarPanel() to create the content of the side panel (panel on the left)
  sidebarPanel
  (
    # use fileInput() to create a dialogue for inputting a file
    fileInput("file1", "Upload SPSS File",
              multiple = TRUE,
              accept = c(".sav")),
    # create a horizontal line break
    tags$hr(),
    
    # create a dropdown menu for selecting the dataset to be used
    selectInput("dataset","Data:",
                choices =list(iris = "iris",
                              mtcars = "mtcars",
                              uploaded_file = "inFile"), selected=NULL),
    # create a dropdown menu for selecting the dependent variable to be used
    selectInput("dv","Dependent Variable:", choices = NULL),
    # create a dropdown menu for selecting the Independent variable to be used
    selectInput("iv","Independent Variable:", choices = NULL),
    # create a dropdown menu for selecting the mediator to be used
    selectInput("mediator","Mediator:", choices = NULL) #,
    
    # use HTML() to input formatted text describing the App
    ,HTML('In response to 
    <a href="https://perso.uclouvain.be/vincent.yzerbyt/Yzerbyt%20et%20al.%20JPSP%202018.pdf">this</a>
    paper by Yzerbyt, Batailler and Judd (2018) which outined a new method of conducting mediation analyses
    (with less susceptability to false positives than Hayes’ PROCESS) I created a ShinyApp so that their
    R-package could be used by SPSS users. Upload your SPSS file above and select the variables you wish
    to compare.')
    ,br(),br(),br()
    ,HTML('<p>Yzerbyt, V., Muller, D., Batailler, C., & Judd, C. M. (2018). New Recommendations for
    Testing Indirect  Effects in Mediational Models: The Need to Report and Test Component Paths.
    <em>Journal of Personality and Social Psychology: Attitudes and Social Cognition</em>, 115(6), 
    929–943. <a href="http://dx.doi.org/10.1037/pspa0000132"
    class="uri">http://dx.doi.org/10.1037/pspa0000132</a></p>')
  ),
  
  # use mainPanel() to create the panel on the right where the output of our tests will be
  mainPanel(
    # give a title to the the first output
    h3("Summary of Regression Model"),
    # report the result of the regression, saved in the object 'fit'
    verbatimTextOutput("fit"),
    # give a title for the second output
    h3("Mediation Results"),
    # report the result of the mediation, saved in the object 'mediation'
    verbatimTextOutput("mediation")
  )
))


# shiny server side code for each call
server<-(function(input, output, session){
  
  # update variables based on the data
  observe({
    #browser()
    if(!exists(input$dataset)) return() #make sure upload exists
    var.opts<-colnames(get(input$dataset))
    updateSelectInput(session, "dv", choices = var.opts)
    updateSelectInput(session, "iv", choices = var.opts)
    updateSelectInput(session, "mediator", choices = var.opts)
  })

  # get data object
  get_data<-reactive({
    if(!exists(input$dataset)) return() # if no upload
    check<-function(x){is.null(x) || x==""}
    if(check(input$dataset)) return()
    
    obj<-list(data=get(input$dataset),
              dv=input$dv,
              iv=input$iv,
              mediator=input$mediator
    )
    # require all to be set to proceed
    if(any(sapply(obj,check))) return()
    #make sure choices had a chance to update
    check<-function(obj){
      !all(c(obj$dv,obj$iv,obj$mediator) %in% colnames(obj$data))
    }
    if(check(obj)) return()
    obj
  })
  
  upload_data<-reactive({
    inFile <- input$file1
    if (is.null(inFile))
      return(NULL)
    # could also store in a reactiveValues
    read.spss(input$file1$datapath, to.data.frame = TRUE)
  })
  
  observeEvent(input$file1,{
    inFile<<-upload_data()
  })
  
  
  # create regression output  
  output$fit <- renderPrint({
    
    dataset_list <- get_data()
    
    
    a <- dataset_list$dv
    b <- dataset_list$iv
    m <- dataset_list$mediator
    c <- dataset_list$data
   
    
    df <- `colnames<-`(
      cbind.data.frame(
        c[which(colnames(c)==a)],
        c[which(colnames(c)==b)],
        c[which(colnames(c)==m)]
      ), c("dv","iv","mediator"))
    
    df$dv <- suppressWarnings(as.numeric(df$dv))
    df$iv <- suppressWarnings(as.numeric(df$iv))
    df$mediator <- suppressWarnings(as.numeric(df$mediator))
    
    fit <- lm(dv ~ iv + mediator, data=df)
    summary(fit) # show results
  })

  # create mediation output  
  output$mediation <- renderPrint({
    
    dataset_list <- get_data()
    
    a <- dataset_list$dv
    b <- dataset_list$iv
    m <- dataset_list$mediator
    c <- dataset_list$data
    
    
    df <- `colnames<-`(
      cbind.data.frame(
        c[which(colnames(c)==a)],
        c[which(colnames(c)==b)],
        c[which(colnames(c)==m)]
      ), c("dv","iv","mediator"))
    
    df$dv <- suppressWarnings(as.numeric(df$dv))
    df$iv <- suppressWarnings(as.numeric(df$iv))
    df$mediator <- suppressWarnings(as.numeric(df$mediator))
    
    JS_model <- mdt_simple(data = df,
                           DV = dv,
                           IV = iv,
                           M  = mediator)
    add_index(JS_model)
  })
  # #JS_model
})


# Create Shiny app ----
shinyApp(ui, server)

References