A Baseball Dashboard in Time for Opening Weekend (part three)
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.
@ctrent I’ve always thought that it’d be fun to debate the @Reds HOF like the real one. Set a high , but debatable, bar. Bring on the JAWS
— Craig Wales (@C_Dubs1) August 22, 2017
it would be interesting, I don't have the math or computer skills to do so https://t.co/p5n9O5NjGT
— C. Trent Rosecrans (@ctrent) August 22, 2017
In part one, we collected the data and performed a little EDA. In part two, we did some calculations and prepared the data to be visualized. Now, we get to see the fruits of our labor. You’ll need these objects from part two: display_table
, jaws_group
, war_group
, and war_combo_avg
.
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 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.
R-bloggers.com offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.