STAT3280 Project Plots

# List of Packages 

library(plotly)

## Loading required package: ggplot2

## 
## Attaching package: 'plotly'

## The following object is masked from 'package:ggplot2':
## 
##     last_plot

## The following object is masked from 'package:stats':
## 
##     filter

## The following object is masked from 'package:graphics':
## 
##     layout

library(tidyverse)

## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.4     ✔ readr     2.1.5
## ✔ forcats   1.0.0     ✔ stringr   1.5.1
## ✔ lubridate 1.9.3     ✔ tibble    3.2.1
## ✔ purrr     1.0.2     ✔ tidyr     1.3.1

## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks plotly::filter(), stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

library(readxl)
library(ggplot2)
library(patchwork)
library(shiny)
library(bslib)

## 
## Attaching package: 'bslib'
## 
## The following object is masked from 'package:utils':
## 
##     page

library(dplyr)

Plot 1

data1 <- read_excel("data1.xlsx")
data1a <- data1[1:20,]

data1aa <- subset(data1a, select = -c(Rank,City))


ui <- fluidPage(

    
    sidebarLayout(
      sidebarPanel(
        
        br(), br(), br(), br(),br(), br(),
        selectInput(
        "column",
        "Select Index Variable to Display:",
        choices = colnames(data1aa))

      ),

      mainPanel(
        plotOutput("plot")
      )

))

server <- function(input, output) {

    output$plot <- renderPlot({
      
      ggplot(data1a, aes(x = reorder(City, .data[[input$column]]), y = .data[[input$column]],
                          fill = City == "Boston, MA, United States")) +
      geom_bar(stat = "identity", size = 1) +
      scale_fill_manual(values = c("TRUE" = "steelblue", "FALSE" = "grey"), guide = "none") +
      labs(
        title = paste("Bar Graph Ranking of", input$column),
        x = NULL,
        y = input$column
      ) +
      theme_minimal() + 
      theme(
        plot.title = element_text(hjust = 0.5), 
        panel.grid = element_blank()  ,
        axis.text.x = element_text(angle = 45, hjust = 1)
      )
      
    })
    
}

shinyApp(ui = ui, server = server)

Shiny applications not supported in static R Markdown documents

Plot 2

data2 <- read_excel("data2.xlsx")

## New names:
## • `Price` -> `Price...4`
## • `M/M%` -> `M/M%...5`
## • `Y/Y%` -> `Y/Y%...6`
## • `Price` -> `Price...7`
## • `M/M%` -> `M/M%...8`
## • `Y/Y%` -> `Y/Y%...9`

data2a <- data2 %>% 
  arrange(desc(Price...4)) %>% 
  slice(1:20)

plot2 <- ggplot(data2a, aes(x = reorder(City, Price...4), y = Price...4, 
                            fill = City == "Boston, MA")) + 
  geom_bar(stat = "identity") +
  geom_text(aes(label = paste0("$", format(Price...4, family = "Times"))), 
            # do not want space between $ and money
            hjust = 1.2, color = "white", size = 3.5, fontface = "bold") +
  scale_fill_manual(values = c("TRUE" = "steelblue", "FALSE" = "grey"), guide = "none") + 
  coord_flip() + 
  labs(title = "Top 20 Cities in the United States by Median Price of One Bedroom Rent",
    x = NULL,
    y = "Median Rent Price") + 
  theme_minimal() + 
  theme(panel.grid.major.y = element_blank(),
        panel.grid.minor.y = element_blank(),
        panel.grid.major.x = element_blank(),
        panel.grid.minor.x = element_blank(),
        axis.title.x = element_blank(),
        axis.ticks.x = element_blank(),
        axis.text.x = element_blank(),
        plot.title = element_text(size = 10))

plot2

Plot 3

data3 <- read_excel("data3.xlsx")

data3a <- data3$`Median Studio Rent`

ggplot(data3, aes(x = `Median Singles Income`, y = `Rent Cost as a % of Income`, label = City)) +
  geom_point(color = "steelblue", size = 3) + 
  geom_hline(yintercept = 0.3, color = "black", linetype = "solid", size = 1, alpha = 0.7) +
  geom_ribbon(aes(ymin = 0, ymax = pmin(0.3)), fill = "lightgreen", alpha = 0.2) +
  geom_text(data = subset(data3, City == "Boston"), aes(label = City), color = "black", size = 5, vjust = -1) +
  labs(
    title = "Rent Cost as a Percentage of Income",
    x = "Median Singles Income",
    y = "Rent Cost as a % of Income"
  ) +
  theme_minimal()

## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

  # + 
  # geom_ribbon(aes(ymin = 0, ymax = `Median Singles Income` * 12 * 0.3), 
             #  fill = "lightblue", alpha = 0.2)

Plot 4

data4 <- read_excel("data4.xlsx")

cities4 <- c("Boston", "United States")
# "New York City", "Philadelphia", "Washington D.C.", "San Francisco",

data4a <- data4 %>%
  filter(city %in% cities4)

accumulate_by <- function(dat, var) {
  var <- lazyeval::f_eval(var, dat)
  lvls <- plotly:::getLevels(var)
  dats <- lapply(seq_along(lvls), function(x) {
    cbind(dat[var %in% lvls[seq(1, x)], ], frame = lvls[[x]])
  })
  dplyr::bind_rows(dats)
}

accumulated_df <- data4a %>% accumulate_by(~year)

plot4Final <- accumulated_df %>%
  plot_ly(
    x = ~year,
    y = ~rl_hpi_b_1948,
    split = ~city,  
    frame = ~frame,   
    type = 'scatter',
    mode = 'lines',
    line = list(simplify = F)
  ) 

plot4Final <- plot4Final %>% 
  layout(
    title = "Changes In Housing Price Index (1890 - 2006): Boston vs Rest of the United States",
    xaxis = list(title = " ",
                 showgrid = F),
    yaxis = list(title = "Housing Price Index"), 
    legend = list(
      y = 0.5
    )
  )

plot4Final <- plot4Final %>% 
  animation_opts(
    frame = 50, 
    redraw = FALSE,
    transition = 0
  ) %>% 
  animation_slider(
  hide = T ) %>% 
  animation_button(
  x = 1, xanchor = "right", y = 0, yanchor = "bottom")

plot4Final

Plot 5

data5 <- read_excel("data7.xlsx")

library(lubridate)
data5$`Month of Period End` <- parse_date_time(data5$`Month of Period End`, orders = "my")

data5a <- data5[, c("Month of Period End", "Median Sale Price", "Median Sale Price YoY", "Days on Market", "Inventory YoY" , "Homes Sold YoY", "New Listings YoY", "Days on Market YoY")]
data5b <- data5[, c("Median Sale Price", "Median Sale Price YoY", "Homes Sold YoY", "Inventory YoY", "New Listings YoY", "Days on Market YoY")]

ui <- fluidPage(

      mainPanel(
        selectInput("variable", 
                    "Choose a variable to explore.", 
                    choices = names(data5b)),
        plotOutput("plot")
      )

)

server <- function(input, output) {

    output$plot <- renderPlot({
      
      ggplot(data5a, aes(x = `Month of Period End`, y = .data[[input$variable]])) +
      geom_line(color = "steelblue", size = 1) +
      # geom_point(color = "red", size = 2) +
      labs(
        title = paste("Line Graph of", input$variable, "Since 2012"),
        x = "Year",
        y = input$variable
      ) +
      theme_minimal() + 
      theme(
        plot.title = element_text(hjust = 0.5), 
        panel.grid = element_blank()  
      )
      
    })
    
}

shinyApp(ui = ui, server = server)

Shiny applications not supported in static R Markdown documents

Plot 6

dataSubset <- data5[substr(data5$`Month of Period End`, 6, 10) == "01-01", ]
dataSubset <- dataSubset[,2:3]

data9 <- read_excel("data9.xls")

data9$actualChange1 <- data9$medianIncome - data9$medianIncome[1]
data9$percentChange1 <- (data9$medianIncome - data9$medianIncome[1]) / data9$medianIncome[1] * 100

data9$actualChange2 <- data9$rent- data9$rent[1]
data9$percentChange2 <- (data9$rent - data9$rent[1]) / data9$rent[1] * 100

data9LongA <- data9 %>%
  pivot_longer(
    cols = c(actualChange1, actualChange2),
    names_to = "metric",
    values_to = "value"
  )

data9LongB <- data9 %>%
  pivot_longer(
    cols = c(percentChange1, percentChange2),
    names_to = "metric",
    values_to = "value"
  )

plot6a <- ggplot(data9LongA, aes(x = date, y = value, color = metric)) + 
  geom_line(size = 1) +
  labs(
    title = "Direct Change Over Time",
    x = "Year",
    y = "Change",
    color = "Metric"
  ) +
  theme_minimal()

plot6b <- ggplot(data9LongB, aes(x = date, y = value, color = metric)) + 
  geom_line(size = 1) +
  labs(
    title = "Percent Change Over Time",
    x = "Year",
    y = "Change",
    color = "Metric"
  ) +
  theme_minimal()

plot6a / plot6b