A Baseball Dashboard in Time for Opening Weekend (part three)

DataTable

RStudio and DataTable have excellent documentation on the various features, so I won’t explain every option I’ve enabled here. I will bring to your attention to a few things though.

If you decide to include CSV and PDF buttons, I recommend you also include the “Show entries” feature. It’s activated by default but I’ve turned it off here with lengthChange = FALSE. When a user downloads data using either of these buttons, only the data that is displayed is downloaded, so allowing the user to be able to choose how many rows are displayed is a good option. The problem is the default position (“lfrtip”) is in the header which now is crowded with buttons and the search window. The dom option allows you to configure the location of control elements by specifying the element order. “l” represents the “entries” feature. This order places it in the bottom left corner of the table. In my opinion this is the most display-friendly location.

I also consider the horizontal scrolling option a necessity. There’s an extension Responsive that’s supposed to make your table mobile-friendly but I’ve found it to be buggy. It sometimes creates edge effects that make your columns unreadable. The stable option is to enable horizontal scrolling by setting scrollX = TRUE (capital X).

You’ll also notice the javascript at the bottom. This allows you to change the background and text color of the header. If you want to match the colors of the visuals to a particular team, teamcolorcodes.com or codeofcolors.com provides color codes to all MLB teams and other sports teams as well.

library(DT)

dt <- datatable(data = display_table,
          rownames = FALSE,
          extensions = c("FixedColumns","Buttons"),
          options = list(language = list(sSearch = "Filter:"),
                         search = list(regex = TRUE),
                         buttons = c("colvis", "csv", "pdf"),
                         scrollX = TRUE,
                         pageLength = 3,
                         lengthChange = FALSE,
                         fixedColumns = list(leftColumns = 1),
                         dom = "Bfrtlip",
                         initComplete = JS(
                               "function(settings, json) {",
                               "$(this.api().table().header()).css({'background-color': '#C6011F', 'color': '#FFF'});",
                               "}"
                         ))
)

Cleveland Dot Plots

Dot plots are the old-new hotness as an alternative to bar charts according to my twitter feed, so I thought I’d give them a look. I used this article from University of Cincinnati Stats (coincidence or destiny?) site to guide me.

There will be two dot plots for the dashboard, but I’m only showing one here. The main issues I had were the legend placement and the value labels. If you have (or don’t have) large spreads between some players and the “typical HOF’er”, you’ll want to play with the limits in scale_x_continuous. If the legend gives you problems, I’d look at legend.position and maybe legend.direction.

library(tidyverse)

head(war_group, 3)

## # A tibble: 3 x 4
##   Name         Group Stat  Value
##   <chr>        <chr> <chr> <dbl>
## 1 Aaron Boone  3B    WAR    11.6
## 2 Adam Dunn    LF    WAR    16.4
## 3 Barry Larkin SS    WAR    70.2

war_dot <- war_group %>% 
      filter(Name == "Adam Dunn")


war_right_label <- war_dot %>% 
      group_by(Group) %>% 
      arrange(desc(Value)) %>% 
      top_n(1)

war_left_label <- war_dot %>% 
      group_by(Group) %>% 
      arrange(desc(Value)) %>% 
      slice(2)

ggplot(war_dot, aes(x = Value, y = Group)) +
      geom_line(aes(group = Group)) +
      geom_point(aes(color = Stat), size = 3) +
      geom_text(data = war_right_label, aes(color = Stat, label = round(Value, 1)), size = 5, hjust = -0.5) +
      geom_text(data = war_left_label, aes(color = Stat, label = round(Value, 1)), size = 5, hjust = 1.5) +
      scale_x_continuous(limits = c(min(war_dot$Value)-30, max(war_dot$Value)+28)) + 
      scale_color_manual(labels = c("Typical HOFer (weighted)", "Player"), values = c("#000000", "#C6011F")) +
      labs(title = "WARtenure") +
      theme_minimal() +
      theme(axis.title = element_blank(),
            panel.grid.major.x = element_blank(),
            panel.grid.minor = element_blank(),
            legend.title = element_blank(),
            legend.justification = c(0,1),
            legend.position = c(.1, 1),
            legend.background = element_blank(),
            legend.direction = "vertical",
            plot.title = element_text(size = 20, margin = margin(b = 10))
      )

Interactive Line Chart

The line chart shows the player’s WAR for every season he was a Red. Hovering over each point displays its value. The horizontal dashed line is one of two values: the median WAR per season of pitchers or the median WAR per season of position players.

library(ggiraph)

head(war_combo_avg, 3)

## # A tibble: 3 x 7
##   bbref_id  Name       yearId    WAR POS   type  `Median WAR`
##   <chr>     <chr>       <int>  <dbl> <chr> <chr>        <dbl>
## 1 luquedo01 Dolf Luque   1918 -0.140 P     WAR           2.38
## 2 luquedo01 Dolf Luque   1919  1.14  P     WAR           2.38
## 3 luquedo01 Dolf Luque   1922  3.10  P     WAR           2.38

war_line <- war_combo_avg %>% 
      filter(Name == "Johnny Bench")

line_filtered <- war_line %>% 
      filter(type == "WAR4")

p <- ggplot(data = war_line) + 
      geom_point_interactive(aes(x = yearId, y = WAR, group = type, tooltip = WAR), color = alpha("#000000", 0.5)) +
      geom_point_interactive(data = line_filtered, aes(x = yearId, y = WAR, color = type, tooltip = WAR), size = 2.5, shape = 17) +
      geom_line(aes(x = yearId, y = WAR)) +
      # all the Median WAR values the same, taking mean is just me hacking to get a value instead of a vector for the y-intercept
      geom_hline(aes(yintercept = mean(`Median WAR`), linetype = "Typical HOFer"), color = alpha("#C6011F", 0.5), size = 1.25) +
      scale_linetype_manual(values = 2, guide = guide_legend(override.aes = list(color = "#C6011F"))) +
      scale_y_continuous(limits = c(min(war_line$WAR)-5, max(war_line$WAR)+5)) +
      labs(title = "WAR") +
      theme_minimal() +
      theme(axis.title = element_blank(),
            panel.grid.major.x = element_blank(),
            panel.grid.minor = element_blank(),
            legend.title = element_blank(),
            legend.justification = c(0,1),
            legend.position = c(.1, 1),
            legend.box = "horizontal",
            legend.background = element_blank(),
            legend.direction = "horizontal",
            plot.title = element_text(size = 20, margin = margin(b = 10))
      )

ggiraph(ggobj = p)

Dashboard

I won’t be going over the shinydashboard code in detail but you can check it out on your own, here. There is some html I’d like to highlight though.

dashBody <- dashboardBody(
      # Changes color of header
      tags$head(
            tags$style(HTML('
                            /* Changes color of title portion of header */
                            .skin-blue .main-header .logo {
                            background-color: #C6011F;
                            }
                            
                            .skin-blue .main-header .logo:hover {
                            background-color: #C6011F;
                            }
                            
                            /* Changes color of rest of header */
                            .skin-blue .main-header .navbar {
                            background-color: #C6011F;
                            }
                            
                            /* Changes color of sidebar toggle when hovered */
                            .skin-blue .main-header .navbar .sidebar-toggle:hover{
                            background-color: #000000;
                            }
                            
                            '))
            
            ),

Placing this HTML at the beginning of dashboardBody will allow you to choose the colors of various elements of the header.

# Stops errors being displayed in plot windows
      tags$style(type="text/css",
                 ".shiny-output-error { visibility: hidden; }",
                 ".shiny-output-error:before { visibility: hidden; }"
      ),

Normally, while the dashboard is waiting for user input, an error will be displayed in place of the charts. Placing this code at the beginning of dashboardBody will hide this error. The code should be on the same level as tags$head( above.

Without further ado, here’s the final product…

(Due to my website’s sidebar, the dashboard will probably appear stacked. Here’s a link to the dashboard that should display full-screen.)

Conclusion

This dashboard is actually only one item in a more tricked-out version that I finished a few weeks ago. If you’d like to take this even further, you can see my other dashboard here and the code is on my github. The processing scripts are a little rough, so be prepared. It was a learning experience ?. Hopefully, I’ll get around to making them more presentable this fall.

This project combined two loves of mine: baseball and r – which I really enjoyed. There wasn’t any complex modeling but it really challenged me in ways I didn’t think it would. The visual design decisions were more difficult than I anticipated, and it also allowed me to level-up in purrr and tidyeval. Hope you enjoyed it.

References

[1] C. Boettiger. knitcitations: Citations for ‘Knitr’ Markdown Files. R package version 1.0.8. 2017. URL: https://CRAN.R-project.org/package=knitcitations.

[2] W. Chang and B. Borges Ribeiro. shinydashboard: Create Dashboards with ‘Shiny’. R package version 0.6.1. 2017. URL: https://CRAN.R-project.org/package=shinydashboard.

[3] D. Gohel. ggiraph: Make ‘ggplot2’ Graphics Interactive. R package version 0.4.2. 2017. URL: https://CRAN.R-project.org/package=ggiraph.

[4] B. Karambelkar. widgetframe: ‘Htmlwidgets’ in Responsive ‘iframes’. https://github.com/bhaskarvk/widgetframe, https://bhaskarvk.github.io/widgetframe/. 2018.

[5] H. Wickham. tidyverse: Easily Install and Load the ‘Tidyverse’. R package version 1.2.1. 2017. URL: https://CRAN.R-project.org/package=tidyverse.

[6] Y. Xie. DT: A Wrapper of the JavaScript Library ‘DataTables’. R package version 0.4. 2018. URL: https://rstudio.github.io/DT.