CODEWITHSUNDEEP
rshiny
myfatson
myfatson

Reputation: 549

How to make a shiny renderPlot conditional upon the existance of the plot?

I am using the plot_model function from the library sjPlot for diagnostic plots of a linear regression. If you have a univariate regression, it outputs 3 plots, if you have a multivariate regression then there are 4 plots. The plots update dynamically with checkboxGroupInput but I get 'Error: subscript out of bounds' where the 4th plot should be when I only have 1 input checked. I want the spot for the 4th plot to just return blank if there is only 1 input checked.

I include a sample of 150 rows generated with dput: [redacted]

library(sjPlot)
library(tidyverse)

regression_data <- read_csv("df.csv")

server <- function(input, output) {
  regFormula <- reactive({
    as.formula(paste("perc_suspensions", " ~ ", paste(input$iv1, collapse = "+")))
  }) #reactive for linear regression 
  
  # then, put that formula into lm() for a linear regression
  model <- reactive({
    lm(regFormula(), regression.data)
  })

  # Diagnostic plots 
  
  output$plot_a<-renderPlot({
    plot_model(model(), type = "diag")[[1]]
  })
  output$plot_b<-renderPlot({
    plot_model(model(), type = "diag")[[2]]
  })
  output$plot_c<-renderPlot({
    plot_model(model(), type = "diag")[[3]]
  })
  output$plot_d <- renderPlot({
    plot_model(model(), type = "diag")[[4]]
  })

# These were my futile attempts which did not work

#  output$plot_d<- renderPlot({
#      if(ncol(model()$model>2)){
#      plot_model(model(), type = "diag")[[4]]} else{renderPlot({""})}
#    })

#  output$plot_d <- renderPlot({""}) #this does work in the application and outputs nothing so I tried to nest this in my other attempts but alas

# output$plot_d <- reactive({
#    if(ncol(model()$model>2)){
#      renderPlot({
#    plot_model(model(), type = "diag")[[4]]
#  })
#    } else{
#      renderPlot({""})
#    }
#      })
} #server render

ui <- shinyUI(fluidPage(
  tabPanel(
    "",
 headerPanel("Header Panel PlaceHolder"),
  sidebarLayout(
    position = "right",
    sidebarPanel(
      h2("Build your model"),
      br(),
      checkboxGroupInput(
        "iv1",
        label = "Select any of the independent variables below to calculate your model. You can change your selection at any time.",
        c("Average % of student attendance"="Attendance",
          "Average number of new students per year"="New_student",
          "Average number of students who withdraw from the school per year"="Withdrawals", 
          "% of student body that is African American" = "African_American",
          "% of student body that is White" = "White",
          "% of student body that is Asian" = "Asian",
          "% of student body that is Latino" = "Latino",
          "% of student body that is another race" = "Other",
          "% of student body that is Pacific Islander" = "Pacific_Islander",
          "Percentage of student body that is from a low income family" = "Low_income_family",
          "Zip code" = "SCHOOL_ZIP",
          "Type of school" = "SCHOOL_LEVEL_NAME",
          "Drug infractions per 100 students" = "Drugs",
          "Morals infractions per 100 students" = "Morals",
          "Assaults per 100 students" = "Assaults",
          "Weapons infractions per 100 students" = "Weapons",
          "Thefts per 100 students" = "Thefts",
          "Average percentage of teacher attendance" = "Teacher_attendance",
          "Percentage of student body receiving special education" = "Special_education",
          "Percentage of student body receiving gifted education" = "Gifted_education",
          "Percentage of student body receiving ESL services" = "English_second_language",
          "Average teacher salary" = "Average_salary"), # c
        selected = c("Average_salary","Teacher_attendance")
        #Note Average Salary is selected when the app starts
      ) # checkboxGroupInput
    ), #sidebarpanel    
    mainPanel(br(),
                fluidRow(
                  plotOutput("plot_a"),
                  plotOutput("plot_b"),
                  plotOutput("plot_c"),
                  plotOutput("plot_d")
                ) #fluidrow for plot
              )# mainPanel
  ) #sidebarlayout
) # tab panel
) # fluidpage
) #shinyUI

enter image description here

Upvotes: 0

Views: 300

Answers (2)

St&#233;phane Laurent
St&#233;phane Laurent

Reputation: 84529

You are running plot_model(model(), type = "diag") multiple times in your app. Put this list of plots in a reactive conductor instead:

Plots <- reactive({
  plot_model(model(), type = "diag")
})

In this way you run this command only one time. Then:

  output$plot_a<-renderPlot({
    Plots()[[1]]
  })
  output$plot_b<-renderPlot({
    Plots()[[2]]
  })
  output$plot_c<-renderPlot({
    Plots()[[3]]
  })
  output$plot_d <- renderPlot({
    req(length(Plots()) == 4)
    Plots()[[4]]
  })

Upvotes: 0

VitaminB16
VitaminB16

Reputation: 1234

If you just want to suppress the error message, adding try() around plot_model() will do what you want:

output$plot_a<-renderPlot({
    try(plot_model(model(), type = "diag")[[1]])
})
output$plot_b<-renderPlot({
    try(plot_model(model(), type = "diag")[[2]])
})
output$plot_c<-renderPlot({
    try(plot_model(model(), type = "diag")[[3]])
})
output$plot_d <- renderPlot({
    try(plot_model(model(), type = "diag")[[4]])
})

Upvotes: 1

Related Questions