Option 1

Create a set of four graphs. This must include: • 1- Base R graph • 1- ggplot graph • At least one of either: 1- trelliscope graph or 1- plotly graph. Each graph should include at least two variables. So, a single histogram, box plot, density plot, etc. will not be sufficient.

You will create these graphs in an Rmarkdown document. For each graph you must have a clear statement of what you are trying to investigate in the data. Discuss how your choice of graph will help in this investigation. This should be given in the document before each graph.

After each graph, you must include at least a 1-paragraph discussion. This should discuss any trends, insights, conclusions, etc. that you gained from your graph. That is, you should address your investigation statement and what you gained from the graph to answer it.

Complete the above in an Rmarkdown document and knit it to an html file. Your html page should include a title and your name. Publish this to an RPubs page.

Libraries

library(nflreadr)
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
## ✔ ggplot2   3.5.0     ✔ tibble    3.2.1
## ✔ lubridate 1.9.3     ✔ tidyr     1.3.1
## ✔ purrr     1.0.2     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(nflplotR)
library(ggplot2)
library(plotly)
## 
## 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(trelliscopejs)

Read in the data

season_rec <- load_pfr_advstats(stat_type = "rec", summary_level = "season")

Filter data

# Choose only primary pass catchers (running backs, wide receivers, and tight ends)
season_rec <- season_rec %>% 
  filter(pos %in% c("RB", "WR", "TE"))

# summary of stats played to find "qualified" players
summary(season_rec)
##      season        player             pfr_id               tm           
##  Min.   :2023   Length:442         Length:442         Length:442        
##  1st Qu.:2023   Class :character   Class :character   Class :character  
##  Median :2023   Mode  :character   Mode  :character   Mode  :character  
##  Mean   :2023                                                           
##  3rd Qu.:2023                                                           
##  Max.   :2023                                                           
##                                                                         
##       age            pos                  g               gs        
##  Min.   :21.00   Length:442         Min.   : 1.00   Min.   : 0.000  
##  1st Qu.:24.00   Class :character   1st Qu.:10.00   1st Qu.: 0.000  
##  Median :25.00   Mode  :character   Median :15.00   Median : 4.000  
##  Mean   :25.89                      Mean   :12.98   Mean   : 5.873  
##  3rd Qu.:28.00                      3rd Qu.:17.00   3rd Qu.:11.000  
##  Max.   :39.00                      Max.   :17.00   Max.   :17.000  
##                                                                     
##       tgt              rec             yds               td        
##  Min.   :  1.00   Min.   :  0.0   Min.   : -10.0   Min.   : 0.000  
##  1st Qu.:  8.00   1st Qu.:  5.0   1st Qu.:  40.5   1st Qu.: 0.000  
##  Median : 24.00   Median : 17.0   Median : 163.0   Median : 1.000  
##  Mean   : 38.81   Mean   : 26.2   Mean   : 287.0   Mean   : 1.683  
##  3rd Qu.: 58.75   3rd Qu.: 39.0   3rd Qu.: 409.8   3rd Qu.: 3.000  
##  Max.   :181.00   Max.   :135.0   Max.   :1799.0   Max.   :13.000  
##                                                                    
##       x1d             ybc             ybc_r             yac       
##  Min.   : 0.00   Min.   :-130.0   Min.   :-5.200   Min.   :-11.0  
##  1st Qu.: 3.00   1st Qu.:   1.0   1st Qu.: 0.325   1st Qu.: 28.0  
##  Median : 8.50   Median :  45.5   Median : 4.800   Median : 84.5  
##  Mean   :14.58   Mean   : 149.9   Mean   : 4.596   Mean   :137.1  
##  3rd Qu.:21.00   3rd Qu.: 233.8   3rd Qu.: 7.700   3rd Qu.:211.0  
##  Max.   :83.00   Max.   :1147.0   Max.   :37.000   Max.   :680.0  
##  NA's   :34                       NA's   :16                      
##      yac_r             adot          brk_tkl           rec_br     
##  Min.   :-5.500   Min.   :-5.00   Min.   : 0.000   Min.   : 2.00  
##  1st Qu.: 3.625   1st Qu.: 1.00   1st Qu.: 0.000   1st Qu.: 7.70  
##  Median : 5.100   Median : 6.60   Median : 1.000   Median :12.15  
##  Mean   : 5.463   Mean   : 6.47   Mean   : 1.833   Mean   :16.03  
##  3rd Qu.: 7.000   3rd Qu.:10.30   3rd Qu.: 2.000   3rd Qu.:21.00  
##  Max.   :19.700   Max.   :30.10   Max.   :16.000   Max.   :79.00  
##  NA's   :16                                        NA's   :194    
##       drop         drop_percent          int              rat        
##  Min.   : 0.000   Min.   :0.00000   Min.   :0.0000   Min.   :  0.00  
##  1st Qu.: 0.000   1st Qu.:0.00000   1st Qu.:0.0000   1st Qu.: 74.78  
##  Median : 1.000   Median :0.04100   Median :0.0000   Median : 90.50  
##  Mean   : 1.885   Mean   :0.05831   Mean   :0.9186   Mean   : 87.51  
##  3rd Qu.: 3.000   3rd Qu.:0.07100   3rd Qu.:1.0000   3rd Qu.:103.70  
##  Max.   :13.000   Max.   :1.00000   Max.   :8.0000   Max.   :149.30  
##                                                                      
##      loaded          
##  Min.   :2024-02-29  
##  1st Qu.:2024-02-29  
##  Median :2024-02-29  
##  Mean   :2024-02-29  
##  3rd Qu.:2024-02-29  
##  Max.   :2024-02-29  
## 
# filter by qualified players
season_rec_q <- season_rec %>% 
  filter(tgt >= 8) %>% 
  mutate(firstDown = x1d) %>% 
  select(-c(x1d, loaded))

# table of positions
table(season_rec_q$pos)
## 
##  RB  TE  WR 
##  80  83 169

Base R Graph

boxplot(rec ~ pos, data = season_rec_q, horizontal = TRUE,
        xlab = "Receptions",
        ylab = "Position",
        main = "Receptions by Position",
        col = c("#D3BC8D", "#E31837", "#869397"),
        notch = TRUE)

ggplot graph

season_rec_q %>% 
  # group by team and position
  group_by(tm, pos) %>% 
  
  # find the average YAC and receptions by the groups
  summarise(
    avg_yac = round(mean(yac), 2),
    avg_rec = round(mean(rec), 2)
  ) %>% 
  
  # reorder position to have the facet graph RB, WR, and TE in that order
  mutate(pos = factor(pos, levels = c("RB", "WR", "TE"))) %>% 
  
  # plot
  ggplot(aes(avg_rec, avg_yac)) +
  
  # NFL logos as points
  geom_nfl_logos(aes(team_abbr = tm), width = 0.10) +
  
  # attempted code that may work with some fixing
  # geom_label(aes(label = tm), nudge_y = -0.35, alpha = 0.5) +
  
  # labels
  labs(x = "Average Receptions",
       y = "Average YAC",
       title = "Average YAC by Average Receptions") + 
  
  # facet by position
  facet_wrap(~ pos) +
  
  # plot a regression line for each position 
  geom_smooth(method = "lm", formula = y ~ x) +
  
  # theme black and white
  theme_bw()
## `summarise()` has grouped output by 'tm'. You can override using the `.groups`
## argument.

plotly graph

load data

week_run <- season_rec <- load_pfr_advstats(stat_type = "rush", summary_level = "week")

team colors

### Load team names and colors
team_names <- load_teams()

### Team colors
team_colors_off <- team_names$team_color

plot

# plot_ly plot
week_run %>% 
  filter(game_type == "REG") %>% 
  group_by(team, week) %>% 
  summarise(
    carries = sum(carries), 
    rush_ybc = sum(rushing_yards_before_contact),
    rush_yac = sum(rushing_yards_after_contact)
  ) %>%
  
  # plot
  plot_ly(x = ~carries, y = ~rush_yac,
          color = ~team,
          colors = team_colors_off,
          hoverinfo = "text",
          text = ~paste0("Team: ", team,
                        "<br>Carries: ", carries,
                        "<br>Rush YAC: ", rush_yac, " yds")) %>% 
  
  # add frame for each week 
  add_markers(frame = ~week,
              size = ~rush_yac) %>% 
  
  # labels
  layout(xaxis = list(title = "Carries"),
         yaxis = list(title = "Rushing Yards After Contact"),
         title = "Rushing Yards After Contact by Carries for Each Week") %>%
  
  # adjust frame time to 6 seconds and transition time to 3 seconds with elastic easing
  animation_opts(frame = 6000, transition = 3000,
                 easing = "elastic") %>% 
  
  # change frame to "Week" and adjust color and size
  animation_slider(currentvalue = list(prefix = "Week: ", 
                                font = list(color = "black", size = 20)))
## `summarise()` has grouped output by 'team'. You can override using the
## `.groups` argument.

trelliscope graph

Load in QB Data

qbs_23 <- load_espn_qbr(league = "nfl", summary_type = "season")

plot

## filter data
qbs_23_img <- qbs_23 %>% 
  filter(qualified == TRUE, season_type == "Regular") %>% 
  mutate(Name = cog(val = name_display, default_label = TRUE),
         Team = cog(val = team, default_label = TRUE),
         panel = img_panel(headshot_href)) %>% 
  select(Name, Team, qbr_total, epa_total, panel)

trelliscope(qbs_23_img, name = "2023 Quarterbacks", nrow = 2, ncol = 3,
            self_contained = TRUE,
            path = ".")
## Warning: `filter_()` was deprecated in dplyr 0.7.0.
## ℹ Please use `filter()` instead.
## ℹ See vignette('programming') for more help
## ℹ The deprecated feature was likely used in the trelliscopejs package.
##   Please report the issue at <https://github.com/hafen/trelliscopejs/issues>.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.