In this exercise, we develop an interactive shiny app that two does things: (1) creates an effect plot for a linear model and (2) returns an expected value using the same linear model. We’ll use the Albemarle County home data that should be familiar by now.

data and the model

library(tidyverse)
homes <- readRDS(url("http://people.virginia.edu/~jcf2d/data/albemarle_homes.rds"))

# Today we'll look at homes in the top 6 cities by number of homes
vars <- c("CHARLOTTESVILLE", "CROZET", "EARLYSVILLE", 
          "KESWICK", "SCOTTSVILLE", "NORTH GARDEN")

# filter for our cities of interest and homes with at least 1 bedroom and 1 bathroom
homes <- homes %>% 
  filter(city %in% vars & Bedroom > 0 & FullBath > 0)

# drop unusued levels for city
homes$city <- droplevels(homes$city)

# Fit model with FullBath and 3-way interaction between FinSqFt, city and Lot Size;
# LotSize = Deeded acreage for the parcel
mod <- lm(log(TotalValue) ~ FullBath + poly(FinSqFt, 3) * city * poly(LotSize, 3), data = homes)

code for the effect plot that we would like to make interactive

library(effects)
library(scales) # for dollar()
effDF <- as.data.frame(Effect(c("LotSize","FinSqFt","city"), mod = mod, 
                              xlevels = list(LotSize = seq(0,10,length.out = 20), 
                                             FinSqFt = round(seq(500,5000,length.out = 4))),
                              fixed.predictors = list(given.values = c(FullBath = 2))))

yaxs <- select(effDF, lower, upper) %>% exp() %>% range() %>% pretty()
filter(effDF, city %in% c("KESWICK","CROZET", "NORTH GARDEN")) %>% 
  ggplot(aes(x = LotSize, y = fit, color = factor(FinSqFt))) +
  geom_line() +
  geom_ribbon(aes(ymin = lower, ymax = upper), alpha = 1/5) + 
  facet_wrap(~city) +
  scale_y_continuous(breaks = log(yaxs),
                     labels = dollar(yaxs)) +
  scale_color_discrete("Finished Sq Ft", 
                       guide = guide_legend(reverse = TRUE)) +
  ylab("Total Value") +
  xlab("Lot Size") +
  theme_bw()

What we would like to make interactive:

code for the model estimate that we would like to make interactive

pred <- round(exp(predict(mod, newdata = data.frame(FullBath = 2, 
                                                    LotSize = 1.5,
                                                    city = "CHARLOTTESVILLE",
                                                    FinSqFt = 1500))))
dollar(pred)
## [1] "$246,486"

What we would like to make interactive:

1. start a new shiny app

  1. File…New File…Shiny Web App
  2. Give the application a names such as “homes” or “ac_home_app”
  3. Browse to a location on your computer to save the app
  4. click Create

2. add packages that our app will use

Just below library(shiny), add the following

library(effects)
library(scales)
library(tidyverse)

3. add the data and model to the app

Our app will need the data and model, which we can load outside of the server. Add the following R code before the UI definition. (ui <- fluidPage(...) This is NOT an R Markdown file, so we’re not adding a code chunk. Just insert the code like you would in any normal R script.

homes <- readRDS(url("http://people.virginia.edu/~jcf2d/data/albemarle_homes.rds"))
vars <- c("CHARLOTTESVILLE", "CROZET", "EARLYSVILLE", 
          "KESWICK", "SCOTTSVILLE", "NORTH GARDEN")
homes <- homes %>% 
  filter(city %in% vars & Bedroom > 0 & FullBath > 0)
homes$city <- droplevels(homes$city)
mod <- lm(log(TotalValue) ~ FullBath + poly(FinSqFt, 3) * city * poly(LotSize, 3), data = homes)

4. Update the UI

  1. change the titlePanel to say “Effect Plot”
  2. change the arguments of the existing sliderInput to have the following values
    • inputId = “fullbaths”,
    • label = “Number of Full Bathrooms”,
    • min = 1,
    • max = 6,
    • value = 2

5. Add controls to the UI

We need to add controls that will allow us to set the minimum and maximum values of Finished Sq Ft, set the maximum value of Lot Size on the x axis, and pick which cities are displayed.

Add the following just before the existing slider input for full bathrooms:

               checkboxGroupInput(inputId = "city", label = "city",
                                  choices = c("Charlottesville" = "CHARLOTTESVILLE",
                                              "Crozet" = "CROZET",
                                              "Earlysville" = "EARLYSVILLE",
                                              "Keswick" = "KESWICK",
                                              "North Garden" = "NORTH GARDEN",
                                              "Scottsville" = "SCOTTSVILLE"),
                           selected = "CHARLOTTESVILLE"),
               sliderInput(inputId = "fsfMin", label = "Minimum Finished Sq Ft",
                           min = 300, max = 10000, value = 500, step = 50),
               sliderInput(inputId = "fsfMax", label = "Maximum Finished Sq Ft",
                           min = 300, max = 10000, value = 5000, step = 50),
               sliderInput(inputId = "LotSize", label = "Maximum Lot Size:",
                           min = 2, max = 20, value = 10, step = 0.25),

6. update the server: add a modular reaction

We want to make the effect estimates modular since the effects will get calculated for ALL cities. This will allow us to interactively change which cities are displayed without re-running the effect estimates each time.

  1. Just after server <- function(input, output) { but before output$distPlot <- renderPlot({, add the following R code:
  # reactive for creating effect dataframe
  re <- reactive({
    effDF <- as.data.frame(Effect(c("LotSize","FinSqFt","city"), mod = mod, 
                      xlevels = list(LotSize = seq(0,input$LotSize,length.out = 20), 
                                     FinSqFt = round(seq(input$fsfMin,input$fsfMax,length.out = 4))),
                      fixed.predictors = list(given.values = c(FullBath = input$fullbaths))))
    
  }) 

7. update the server: update renderPlot

  1. delete the existing histogram code; after it’s gone all you should have is the following:
   output$distPlot <- renderPlot({

   })
  1. Inside renderPlot, insert the following code. Notice the filter function calls re() instead of effDF. This allows us to filter effDF without re-calculating all the effects.
    yaxs <- select(re(), lower, upper) %>% exp() %>% range() %>% pretty()
    filter(re(), city %in% input$city) %>% 
      ggplot(aes(x = LotSize, y = fit, color = factor(FinSqFt))) +
      geom_line() +
      geom_ribbon(aes(ymin = lower, ymax = upper), alpha = 1/5) + 
      facet_wrap(~city) +
      scale_y_continuous(breaks = log(yaxs),
                         labels = dollar(yaxs)) +
      scale_color_discrete("Finished Sq Ft", 
                           guide = guide_legend(reverse = TRUE)) +
      ylab("Total Value") +
      xlab("Lot Size") +
      theme_bw()
  1. Finally, change output$distPlot to output$effPlot

8. Update plotOutput in the UI

Change plotOutput("distPlot") to plotOutput("effPlot"). We need to do this because we changed output$distPlot to output$effPlot in the previous step.

9. test the app!

Click the Run button and see if the app works. It should! If not, review steps 2 - 7 to see where you might have made a mistake. When finished testing, close the app.

10. Add tabsetPanel and two tabPanel containers

Now we’re ready to start work on the second app that generates a home estimate based on number of full baths, lot size, finished square feet and city.

To begin we need set up a tabPanel for each app.

  1. Immediately after ui <- fluidPage(, insert tabsetPanel(. It should look like
ui <- fluidPage(tabsetPanel(
  1. On the very next line, insert tabPanel("Effects",. It should look like
ui <- fluidPage(tabsetPanel(
  tabPanel("Effects",
  1. Go to the closing parenthesis of the UI object and add two more closing parentheses to accommodate the two functions we just added. There should be a red X next to the line number where you need to add the two parentheses.

  2. Just before the two parentheses you just added, insert ,tabPanel("Estimates"). When you’re finished, the last line of the UI section should look something like this.

),tabPanel("Estimates")))

11. Test the app

Click the Run button and verify we have two tabs: one that says “Effects” and one that says “Estimates”. Clicking on the Estimates tab should reveal a blank tab.

12. Add a UI for the Estimates app

Now we will begin work on the app that will appear on the Estimates tab.

Add a comma immediately after "Estimates" in the tabPanel function (before the closing parenthesis), like so:

),tabPanel("Estimates",)))

Then insert the following code immediately after the comma you just entered:

titlePanel("Home Estimates"),
           sidebarLayout(
             sidebarPanel(
               h3("A home with..."),
               sliderInput(inputId = "fullbaths2", label = "Full Bathrooms:", 
                           min = 1, max = 5, value = 2),
               numericInput(inputId = "finsqft", "Finished Sq Ft:",
                            value = 2000, min = 500, max = 5000, step = 1),
               numericInput(inputId = "lotsize", "Lot Size:",
                            value = 1, min = 0, max = 50, step = 0.5),
               selectInput(inputId = "city2", label = "City:", 
                           choices = c("Charlottesville" = "CHARLOTTESVILLE",
                                       "Crozet" = "CROZET",
                                       "Earlysville" = "EARLYSVILLE",
                                       "Keswick" = "KESWICK",
                                       "North Garden" = "NORTH GARDEN",
                                       "Scottsville" = "SCOTTSVILLE"))
             ),
             mainPanel(wellPanel(
               h3("...has an expected value of about"),
               h3(textOutput("estimate"))
             )
               )
             )

13. Update the server: create an output object for the Estimates tab

Next we update the server section.

Locate the closing }) of the output$effPlot object. This should be right below ggplot2 code:

       ylab("Total Value") +
       xlab("Lot Size") +
       theme_bw()
   })

Immediately after the closing }) of the output$effPlot object, insert the following code:

  output$estimate <- renderText({
    pred <- round(exp(predict(mod, newdata = data.frame(FullBath = input$fullbaths2, 
                                                        LotSize = input$lotsize,
                                                        city = input$city2,
                                                        FinSqFt = input$finsqft))))
    dollar(pred)
  })

This code estimates Total Value given various input values of FullBath, LotSize, city and FinSqFt. The result is rendered as text using the renderText function. The rendered text is assigned the value estimate in the output object. This object is displayed in the UI with the code textOutput("estimate").

14. Test the app

Click the Run button and verify the “Estimates” tab contains a working app that returns an estimated home. If it’s not working, please check your work on steps 12 - 14.

15. Add instructions for how to use the apps

  1. In the Effects tabPanel, just after titlePanel("Effect Plot"),, insert the following: (Don’t forget the commas at the end!)
p("Select which cities you want to compare. Use the Lot Size slider to set the maximum 
   values of the x axis. Use the Finished Square Ft sliders to set the minimum and/or maximum 
   values of the four Finished Square Ft groups in the effect plot. Use the Full 
   Bathrooms slider to change the assumed number of Full Bathrooms in creating the effect plots."),
  1. In the Estimates tabPanel, just after titlePanel("Home Estimates"),, insert the following: (Don’t forget the commas at the end!)
p("Estimate the expected value of a home given the various settings below."),

16. Test the app

Verify the apps on both tabs work. And we’re done!