Posts on Swimming + Data Science

Fast, Deep, Fast and Deep

Tue, 16 Nov 2021 08:58:16 -0500

Swimming + Data Science has been quiet for a while as I worked on other projects. Today though we’re back at it in an attempt to quantify the speed and depth of swim meets. It’s more than that though, because this is vintage me, back on my hobby horses. We will be using SwimmeR. We will be focusing, perhaps myopically, on swim meets from my local area. We will also be using a discussion I had with some friends as a jumping off point. It’s a perfect Swimming + Data Science trifecta!

So here’s the story. I was officiating at the Section IV Class C sectional finals meet, held recently. During an awards break I got into a conversation with a couple of people about swim meets past, as I am wont to do. These people, and I’m paraphrasing, remarked that:

The meet was generally both slower and less deep than previous years, particularly 2006
That a specific team from 2006 that these people were associated with would have run rampant all over the current iteration of the meet

Now I enjoy a good “things were better in my day” bit as much as anyone - perhaps even more - but I also enjoy testing assertions. So that’s what we’re going to do. These tests will proceed in two parts, one for each assertion.

To start let’s load some packages. There’s a new version of SwimmeR, v0.13.0, released November 5th 2021. It’s great and has lots of new features, none of which are particularly relevant to the contents of this article. Still though, might as well update.

Setup

install.packages("SwimmeR")

We’ll use a few tidyverse packages plus flextable.

library(SwimmeR)
library(dplyr)
library(stringr)
library(tidyr)
library(flextable)

flextable_style <- function(x) {
  x %>%
    flextable() %>%
    bold(part = "header") %>% # bolds header
    bg(bg = "#D3D3D3", part = "header")  # puts gray background behind the header row
}

Collecting the meet results

Collecting meet results with SwimmeR is easy. Simply find a link to the results and pipe them into read_results followed by swim_parse. Here we’ll do that with both the 2006 and 2021 Section VI Class C meet results.

C_2006 <-
  "http://www.section4swim.com/Results/GirlsHS/2006/Sec4/C/Single.htm" %>%
  read_results() %>%
  swim_parse() %>%
  mutate(Year = 2006) %>%
  mutate(Event = str_remove(Event, "Girls "))

C_2006 <- C_2006 %>%
  mutate(Event = factor(Event, levels = unique(C_2006$Event))) # to maintain event order later on

C_2021 <-
  "http://www.section4swim.com/Results/GirlsHS/2021/Sec4/C/Single.htm" %>%
  read_results() %>%
  swim_parse() %>%
  mutate(Year = 2021) %>%
  mutate(Event = str_remove(Event, "Girls "))

C_2021 <- C_2021 %>%
  mutate(Event = factor(Event, levels = unique(C_2021$Event))) # to maintain event order later on

Assertion #1 - Faster and Deeper

Fast?

First off let me apologize to our diving friends. “Fast” is a term commonly used by swimming people to describe an entire meet, including diving. Diving obviously isn’t timed though, so the better term might be “strength” - a strong meet, a weak meet etc. Still, I’m going to mostly stick with references to speed just because that’s the more common term.

“Fast” is almost always a relative measure. Is a 4:56.00 in the 500 free fast? Depends on the context. That time would have won the 500 free in a recent men’s dual meet at my alma mater - 4:56.00 would be a fast time in the context of that meet. On the other hand in this women’s dual meet at Stanford a 4:56.00 would have been good for 6th - i.e. last place. Katie Ledecky won that 500 going 4:33.94. What we’d really like is a quantitative measure of the speed for each event, which taken together can describe the strength of a meet.

I propose that what’s really meant by a statement like “the meet is fast this year” is that in some kind of weighted fashion the times are faster than years past for the same finish places. Sounds obvious, I know. What’s the weighing though? We need it in order to be quantitative. Luckily it’s already been determined. It’s point value by place. First place in these meets is worth 20 points, 16th place is worth 1 point and it seems reasonable to me that the first place time is 20x more important in describing the speed of a meet than the 16th place time. The 16th place time does still matter a bit though.

Let’s try and compare the “fastness” between the 2006 and 2021 meets. Our goal is to use the weighed.mean function on times and place-points to get a time (or score for diving), describing the overall strength of each event. We’ll stick C_2006 and C_2021 together and then summarise using weighed.mean and then pivot_wider to format a nice table.

C_Combined <- C_2021 %>%
  bind_rows(C_2006) %>%
  filter(Exhibition < 1,
         DQ < 1) %>%
  group_by(Event) %>%
  select(Place, Name, Team, Event, Finals_Time, Points, Year) %>%
  filter(Place <= 16) %>%
  filter(is.na(Points) == FALSE)

C_Combined %>%
  group_by(Event, Year) %>%
  summarise(W_Avg = mmss_format(weighted.mean(sec_format(Finals_Time), Points, na.rm = TRUE))) %>%
  mutate(W_Avg = case_when(
    str_detect(Event, "Diving") ~ as.character(sec_format(W_Avg)),
    # mmss format doesn't make sense for diving results
    TRUE ~ W_Avg
  )) %>%
  pivot_wider(names_from = "Year", values_from = "W_Avg") %>%
  flextable_style()

Event	2006	2021
200 Yard Medley Relay	2:08.18	2:14.39
200 Yard Freestyle	2:14.29	2:18.60
200 Yard IM	2:32.42	2:36.67
50 Yard Freestyle	26.63	27.64
1 mtr Diving	238.13	260.45
100 Yard Butterfly	1:09.05	1:13.90
100 Yard Freestyle	59.21	1:02.58
500 Yard Freestyle	6:07.36	6:23.79
200 Yard Freestyle Relay	1:54.92	1:57.09
100 Yard Backstroke	1:08.89	1:12.08
100 Yard Breaststroke	1:18.93	1:22.85
400 Yard Freestyle Relay	4:04.83	4:21.62

The 2006 meet was faster than the 2021 meet in every event except diving, and margin was more than 1 second per 100, sometimes as much as 4 s/100 - which is a lot. Diving is interesting too. Let’s look closer.

C_Combined %>% 
  ungroup() %>% 
  filter(str_detect(Event, "Diving")) %>% 
  select(Place, "Score" = Finals_Time, Year) %>% 
  pivot_wider(names_from = "Year", values_from = "Score") %>% 
  select(Place, `2006`, `2021`) %>% 
  flextable_style()

Place	2006	2021
1	284.80	267.10
2	267.30	258.05
3	258.50	254.70
4	239.50
5	228.65
6	225.50
7	222.45
8	176.85
9	169.60

In 2006 there were 9 divers and a winning score of 284.80. In 2021 there were 3 divers and a winning score of 267.10. Yes the weighed average score was higher for 2021 but I ask you - do you think 2021 was a better year for the sport of diving in Section IV Class C than 2006? I sure don’t. As I discuss frequently in this space, models and quantitative analysis are great, but it does help to actually know things too.

Deep?

A quantitative description of meet depth is simpler - it’s the difference in time (or diving score) between 1st place and some other place of interest - usually the last scoring place. If the difference is small the meet is deep. Here we’ll compute the difference, in seconds, between the min and max scoring marks.

C_Combined %>% 
  group_by(Event, Year) %>% 
  mutate(Finals_Time = sec_format(Finals_Time)) %>% 
  summarise(Range = max(Finals_Time, na.rm = TRUE) - min(Finals_Time, na.rm = TRUE)) %>% 
    mutate(Range = case_when(str_detect(Event, "Diving", negate = TRUE) ~ mmss_format(Range),
                           TRUE ~ as.character(Range))) %>% 
  pivot_wider(names_from = "Year", values_from = "Range") %>% 
  flextable_style()

Event	2006	2021
200 Yard Medley Relay	21.56	51.07
200 Yard Freestyle	27.07	34.50
200 Yard IM	36.27	50.27
50 Yard Freestyle	04.69	04.79
1 mtr Diving	115.2	12.4
100 Yard Butterfly	18.06	43.41
100 Yard Freestyle	10.52	16.95
500 Yard Freestyle	56.91	2:27.39
200 Yard Freestyle Relay	22.53	27.86
100 Yard Backstroke	15.95	26.31
100 Yard Breaststroke	16.16	31.73
400 Yard Freestyle Relay	39.29	46.32

The range is much smaller in 2006 for all swimming events, meaning the meet was much deeper.

Faster and Deeper

Those people i was chatting with were right on both counts. The 2006 meet was indeed faster and deeper, by a wide margin, than the 2021 meet.

Assertion #2 - Lion Redux

The team in question here is the 2006 Dryden Lady Lions, headed by eventual DIII All-American Sheila Rhoades.

To start we’ll need to remove all of the Dryden results from C_2021 - it wouldn’t be fair for Dryden to have two teams. Then we’ll collect only the Dryden results from 2006 and join the two sets of results together. The 2006 Dryden team will then be “swimming” in the 2021 meet.

C_2021_No_Dryden <- C_2021 %>%
  filter(Team != "Dryden") # remove dryden

C_2006_Only_Dryden <- C_2006 %>%
  filter(Team == "Dryden") # keep only dryden

C_Comp <- C_2021_No_Dryden %>%
  bind_rows(C_2006_Only_Dryden) %>%
  mutate( # clean up names
    Team = str_replace(Team, "Susquehanna Vall$", "Susquehanna Valley"),
    Team = str_replace(Team, "Notre Dame-E$", "Notre Dame-Elmira"),
    Team = str_replace(Team, "Watkins Glen-OM", "Watkins Glen-Odessa Montour")
  )

It’s more complicated than that though. We need to reconstruct prelims to sort athletes into A Finals and B Finals before the finals themselves can be scored. Fortunately we have access to everyone’s Prelims_Time, although because of how SwimmeR works some prelims times are in the Finals_Time column. In SwimmeR the Finals_Time represents the final (i.e. last) swim for each swimmer, which may or may not actually be in the finals. It’s confusing I know and I apologize, but it’s important to the underlying functioning of swim_parse so that’s the way it will stay. Anyway, swimmers who have Finals_Times but no Prelims_Time in a prelims-finals meet actually have their prelims performance listed in Finals_Time. Let’s fix our results.

We’ll also need to handle diving separately, because in diving the highest value (score) wins, whereas in swimming the lowest value (time) wins.

C_Comp <- C_Comp %>%
  mutate(Prelims_NA = case_when(is.na(Prelims_Time) ~ 1,
                                TRUE ~ 0)) %>%
  mutate(Prelims_Time = case_when(is.na(Prelims_Time) ~ Finals_Time,
                                  TRUE ~ Prelims_Time)) %>%
  mutate(Finals_Time = case_when(Prelims_NA > 0 ~ "NA",
                                 TRUE ~ Finals_Time)) %>%
  na_if("NA") %>%
  select(-Prelims_NA)

C_Comp_Diving <- C_Comp %>%
  filter(str_detect(Event, "Diving") == TRUE) %>%
  mutate(Prelims_Time = as.numeric(Prelims_Time)) %>%
  mutate(
    Place = rank(desc(Prelims_Time), ties.method = "min"),
    # highest score gets rank 1
    Prelims_Time = as.character(Prelims_Time)
  )

C_Comp_Swimming <- C_Comp %>%
  filter(str_detect(Event, "Diving") == FALSE) %>%
  filter(DQ < 1) %>%
  mutate(Prelims_Time_sec = SwimmeR::sec_format(Prelims_Time)) %>% # time as seconds
  group_by(Event) %>%
  mutate(Place = rank(Prelims_Time_sec, ties.method = "min")) %>% # places, low number wins
  select(-Prelims_Time_sec) %>% 
  arrange(Place)

C_Comp_Prelims <- C_Comp_Diving %>%
  bind_rows(C_Comp_Swimming) %>%
  mutate(
    Finals_Time = case_when(
      is.na(Finals_Time) &
        is.na(Prelims_Time) == FALSE &
        DQ < 1 & Exhibition < 1 ~ Prelims_Time,
      TRUE ~ Finals_Time
    )
  )

Great, now we have our meet, with athletes sorted into A and B finals by place, with 8th place as the cutoff for the A finals. We can use results_score to rescore the meet on the basis of Finals_Time.

C_Finals_Score <- C_Comp_Prelims %>%
  results_score(
    events = unique(C_2021$Event),
    meet_type = "prelims_finals",
    lanes = 8,
    point_values = c(20, 17, 16, 15, 14, 13, 12, 11, 9, 7, 6, 5, 4, 3, 2, 1),
    scoring_heats = 2
  )

C_Finals_Score %>%
  group_by(Team) %>%
  summarise(Score = sum(Points, na.rm = TRUE)) %>%
  mutate(Place = round(rank(desc(Score), ties.method = "min"), 1)) %>%
  arrange(desc(Score)) %>%
  select(Place, everything()) %>%
  flextable_style()

Place	Team	Score
1	Dryden	466
2	Watkins Glen-Odessa Montour	433
3	Lansing	322
4	Chenango Forks	221
4	Southern Cayuga	221
6	Notre Dame-Elmira	171
7	Greene	101
8	Susquehanna Valley	83
9	Whitney Point	15

My friends are vindicated again. Dryden 2006 would have indeed won the 2021 meet - although only by 33 points. The real question is how did they know?

In Conclusion

We’ve come up with a quantitative framework for determining the speed and depth of a swim meet, which I’m sure will come in handy somewhere. We’ve also made use of some SwimmeR functions and lots of tidyverse functions and hopefully learned a little bit on the way. Join us next time back here at Swimming + Data Science where we’ll be doing something else fun.

Olympics, Reaction Times, Volleyball, and a New Version of SwimmeR

Thu, 19 Aug 2021 00:00:00 +0000

There’s a new version of SwimmeR available, 0.12.0, which includes capabilities for parsing swimming results from the 2020 Tokyo Olympics. Naturally I’m going to use it to investigate the theory I have about volleyball.

To play along at home you’ll need a version of SwimmeR that’s at least 0.12.0, so go ahead and grab that from CRAN.

install.packages("SwimmeR")

To do this analysis we’ll use a few tidyverse packages plus flextable.

library(SwimmeR)
library(rvest)
library(dplyr)
library(stringr)
library(purrr)
library(ggplot2)
library(flextable)

flextable_style <- function(x) {
  x %>%
    flextable() %>%
    bold(part = "header") %>% # bolds header
    bg(bg = "#D3D3D3", part = "header") %>%  # puts gray background behind the header row
    autofit()
}

Tokyo 2020 Olympic Results

Omega, the official timing partner of the Olympics, has released swimming results by round (heats, semis, finals) and event. That’s a lot of pdf files, but I’ve collected them into a Github repository here. We can use SwimmeR to parse all of them and build a single data frame with all the 2020 Olympic results. Collecting and parsing the results will proceed in much the same way as other Swimming + Data Science adventures like Scraping Websites and Building a Large Dataset with SwimmeR, Dataset of All ISL Results Season 1 and 2 and COVID Impacts in Swimming Results?.

Basically assemble a list of links with tools from the rvest package and then map SwimmeR’s read_results followed by swim_parse over that list.

Here’s the list of links, nicely cleaned up.

tokyo_url <- "https://github.com/gpilgrim2670/Pilgrim_Data/tree/master/Tokyo2020" # repository url
selector <- ".js-navigation-open" # selector where links are kept
page_contents <- read_html(tokyo_url) # get content of repository web page
tokyo_links <- html_attr(html_nodes(page_contents, selector), "href") # raw links extracted from selector node

tokyo_links <- paste0("https://github.com", tokyo_links) # add beginning to link
tokyo_links <- str_replace(tokyo_links, "blob", "raw") # replace blob with raw
tokyo_links <- tokyo_links[6:95] # only want links 7-19, the rest aren't swimming results
tokyo_links <- tokyo_links[is.na(tokyo_links) == FALSE] # don't want NA links
tokyo_links <- tokyo_links[str_detect(tokyo_links, "\\.rds") == FALSE] # don't want the .rds file of compiled results
head(tokyo_links) # print a few links

And here’s the mapping of read_results and swim_parse.

tokyo <- map(tokyo_links, safely(read_results, otherwise = NA)) # read_results with safely to keep going even if there are errors.  No errors are expected.
tokyo <- SwimmeR::discard_errors(tokyo) # discard errors (there aren't actually any)

tokyo_parse <- map(tokyo, safely(swim_parse, otherwise = NA), splits = TRUE, relay_swimmers = TRUE) # swim_parse with safely to parse results
tokyo_parse <- SwimmeR::discard_errors(tokyo_parse) # discard errors (there aren't actually any)

tokyo_df <- bind_rows(tokyo_parse) # bind into data frame

Ta-da! Here’s the final of the Men’s 100 Fly just to show off what we’ve got.

tokyo_df %>% 
  filter(Event == "Men's 100m Butterfly",
         Heat == "Final") %>% 
  select(where(~ !(all(is.na(.)))),
         -Heat) %>% 
  relocate(any_of(c("DQ", "Exhibition")), .after = last_col()) %>% 
  flextable_style()

Place	Lane	Name	Team	Reaction_Time	Finals_Time	Event	Split_50	Split_100
1	4	DRESSEL Caeleb	USA	0.60	49.45	Men's 100m Butterfly	23.00	26.45
2	5	MILAK Kristof	HUN	0.67	49.68	Men's 100m Butterfly	23.65	26.03
3	3	PONTI Noe	SUI	0.68	50.74	Men's 100m Butterfly	23.67	27.07
4	2	MINAKOV Andrei	ROC	0.61	50.88	Men's 100m Butterfly	23.65	27.23
5	1	MAJERSKI Jakub	POL	0.65	50.92	Men's 100m Butterfly	23.99	26.93
5	7	TEMPLE Matthew	AUS	0.61	50.92	Men's 100m Butterfly	23.83	27.09
7	8	MARTINEZ Luis Carlos	GUA	0.60	51.09	Men's 100m Butterfly	24.23	26.86
8	6	MILADINOV Josif	BUL	0.64	51.49	Men's 100m Butterfly	24.09	27.40

Reaction Times and Volleyball

Years ago there was an event called the Empire State Games. It was an Olympics style event held in New York every year, with winter and summer versions hosted at different SUNY campuses across the state. It was awesome but sadly is no more, a victim of budget cuts.

One year when I was competing the Games were held at SUNY Binghamton. SUNY Binghamton doesn’t have a 50m pool though, so the swimming portion was actually held 90 minutes away at SUNY Cortland. For other reasons unknown to me volleyball was also held at SUNY Cortland, which meant I watched a lot of volleyball. I’d never really seen volleyball before, and found it to be very enjoyable. I enjoyed women’s volleyball more than men’s but wasn’t really sure why (it wasn’t the shorts, don’t be disrespectful).

After puzzling on it for the entire week I came up with this theory.

The most exciting thing in volleyball are the volleys, where the ball goes back and forth a lot
- The longer the volley the more exciting it is
The men’s volleyball game has higher powered offense than the women’s game
- Male volleyball players are on average taller and stronger than female volleyball players
- Male players spike the ball down at sharper angles on average, because they’re taller
- Male players hit the ball faster on average, because they’re stronger
Defense is largely driven by ability to see a ball coming in and react to block/dig/save it
- Reaction time matters most
- There probably aren’t gendered differences in reaction time

Summing up - the women’s volleyball game has relatively stronger defense vs. offense, leading to longer volleys and a more exciting game

It was over a decade ago that I came up with my theory, and now is the time to test it. Those Tokyo Olympic swimming results have reaction times, and while swimmers aren’t volleyball players I think there’s reason to believe that gender differences in reaction time, if they even exist, will hold across sports.

tokyo_df_gender <- tokyo_df %>% 
  filter(str_detect(Event, "Relay") == FALSE) %>% 
  mutate(Gender = case_when(str_detect(Event, "Men") ~ "M",
                            str_detect(Event, "Women") ~ "F"))

Here’s the Women’s 100 Fly, with a Gender column.

tokyo_df_gender %>% 
  filter(Event == "Women's 100m Butterfly",
         Heat == "Final") %>% 
  select(where(~ !(all(is.na(.)))),
         -Heat) %>% 
  relocate(any_of(c("DQ", "Exhibition")), .after = last_col()) %>% 
  flextable_style()

Place	Lane	Name	Team	Reaction_Time	Finals_Time	Event	Split_50	Split_100	Gender
1	7	MACNEIL Margaret	CAN	0.63	55.59	Women's 100m Butterfly	26.50	29.09	F
2	4	ZHANG Yufei	CHN	0.64	55.64	Women's 100m Butterfly	25.71	29.93	F
3	3	McKEON Emma	AUS	0.73	55.72	Women's 100m Butterfly	26.16	29.56	F
4	2	HUSKE Torri	USA	0.64	55.73	Women's 100m Butterfly	25.84	29.89	F
5	1	HANSSON Louise	SWE	0.69	56.22	Women's 100m Butterfly	26.36	29.86	F
6	5	WATTEL Marie	FRA	0.69	56.27	Women's 100m Butterfly	26.11	30.16	F
7	6	SJOESTROEM Sarah	SWE	0.67	56.91	Women's 100m Butterfly	26.91	30.00	F
8	8	SHKURDAI Anastasiya	BLR	0.64	57.05	Women's 100m Butterfly	26.45	30.60	F

Now all we need to do is collect reaction times by athlete and then by gender.

tokyo_df_gender %>% 
  group_by(Name) %>% 
  summarise(Reaction_Time_Avg = mean(as.numeric(Reaction_Time), na.rm = TRUE),
            Team = unique(Team)) %>% 
  arrange(Reaction_Time_Avg) %>% 
  head(5) %>% 
  flextable_style()

Name	Reaction_Time_Avg	Team
LARA Krystal	0.495	DOM
LAITAROVSKY Michael	0.510	ISR
LEVTEROV Kaloyan	0.510	BUL
IRIE Ryosuke	0.524	JPN
MURPHY Ryan	0.525	USA

Hmmm, something interesting has happened. You may not know it, but all of those athletes are backstrokers. Backstroke uses a different start compared to the other swimming disciplines, so we need to address that.

tokyo_df_gender <- tokyo_df_gender %>% 
  group_by(Name, Event) %>% 
  summarise(Reaction_Time_Avg = mean(as.numeric(Reaction_Time), na.rm = TRUE),
            Team = unique(Team),
            Gender = unique(Gender)) %>%
  mutate(Discipline = case_when(str_detect(Event, "Back") ~ "Backstroke",
                                TRUE ~ "Not Backstroke")) %>% 
  filter(Reaction_Time_Avg < 1)

tokyo_df_gender %>% 
  ggplot() +
  geom_histogram(aes(x = Reaction_Time_Avg, fill = Discipline), position = "identity", alpha = 0.5) +
  theme_bw() +
  labs(title = "Reaction Time Differences by Start Type",
       y = "Number of Athletes",
       x = "Average Reaction Time (s)")

Breaking gender out visually - looks about the same to me. We’ll need to test to be sure though.

tokyo_df_gender %>% 
  ggplot() +
  geom_histogram(aes(x = Reaction_Time_Avg, fill = Discipline), position="identity", alpha = 0.5) +
  theme_bw() +
  facet_wrap(. ~ Gender) +
  labs(title = "Reaction Time Differences by Gender and Start Type",
       y = "Number of Athletes",
       x = "Average Reaction Time (s)")

T Tests for Comparison

Histogram data looks normally distributed, so t tests are appropriate means of comparing two sets of data. Throughout I’ll use 0.01 (99%) as my significance level.

female_backstrokers <- tokyo_df_gender %>% 
  filter(Gender == "F",
         Discipline == "Backstroke")

male_backstrokers <- tokyo_df_gender %>% 
  filter(Gender == "M",
         Discipline == "Backstroke")

female_nonbackstrokers <- tokyo_df_gender %>% 
  filter(Gender == "F",
         Discipline == "Not Backstroke")

male_nonbackstrokers <- tokyo_df_gender %>% 
  filter(Gender == "M",
         Discipline == "Not Backstroke")

all_backstrokers <- tokyo_df_gender %>% 
  filter(Discipline == "Backstroke")

all_nonbackstrokers <- tokyo_df_gender %>% 
  filter(Discipline == "Not Backstroke")

Comparing Reaction Times Across Genders for Backstrokers

back_t.test <- t.test(female_backstrokers$Reaction_Time_Avg, male_backstrokers$Reaction_Time_Avg)
back_t.test

## 
##  Welch Two Sample t-test
## 
## data:  female_backstrokers$Reaction_Time_Avg and male_backstrokers$Reaction_Time_Avg
## t = 3.2722, df = 129.01, p-value = 0.001369
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  0.01177603 0.04779629
## sample estimates:
## mean of x mean of y 
## 0.6152451 0.5854589

The p value is 0.0013694 which is less than 0.01, so we can reject the null hypothesis and embrace the alternative hypothesis. Average reaction times for male and female backstrokers are not the same.

Comparing Reaction Times Across Genders for Non-Backstrokers

non_back_t.test <- t.test(female_nonbackstrokers$Reaction_Time_Avg, male_nonbackstrokers$Reaction_Time_Avg)
non_back_t.test

## 
##  Welch Two Sample t-test
## 
## data:  female_nonbackstrokers$Reaction_Time_Avg and male_nonbackstrokers$Reaction_Time_Avg
## t = 12.711, df = 890.73, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  0.03393902 0.04633348
## sample estimates:
## mean of x mean of y 
## 0.6956908 0.6555545

Similarly the p value for comparing non-backstrokers is 3.8904097^{-34}, which is also less than 0.01, so we can reject the null hypothesis here too. Average reaction times for male and female non-backstrokers are also not the same.

Comparing Reaction Times for Backstrokers and Non-Backstrokers

While not specifically relevant to my volleyball theory we can also check our observations from the histogram above and determine if our population of backstrokers has significantly different reaction times from our population of non-backstrokers, again at a confidence level of 99% (0.01).

back_non_back_t.test <- t.test(all_backstrokers$Reaction_Time_Avg, all_nonbackstrokers$Reaction_Time_Avg)
back_non_back_t.test

## 
##  Welch Two Sample t-test
## 
## data:  all_backstrokers$Reaction_Time_Avg and all_nonbackstrokers$Reaction_Time_Avg
## t = -14.579, df = 173.18, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -0.08276967 -0.06303023
## sample estimates:
## mean of x mean of y 
## 0.6002433 0.6731433

We see that the p-value is 6.2556088^{-32}, well less than 0.01, so we can reject the null hypothesis (that the reaction times for backstrokers and non-backstrokers are the same) and say there is a difference in average reaction times at 99% confidence.

reaction_time_gender <- tokyo_df_gender %>% 
  ungroup() %>% 
  group_by(Gender, Discipline) %>% 
  summarise(Reaction_Time_Avg_2 = mean(Reaction_Time_Avg, na.rm = TRUE)) %>% 
  ungroup() %>% 
  group_split(Discipline)

reaction_time_backstroke <- tokyo_df_gender %>% 
  ungroup() %>% 
  group_by(Gender, Discipline) %>% 
  summarise(Reaction_Time_Avg_2 = mean(Reaction_Time_Avg, na.rm = TRUE)) %>% 
  ungroup() %>% 
  group_split(Gender)

My Volleybal Theory Revisited

So we’re seeing a statistically significant difference between the reaction times of male and female swimmers. That said, what’s the actual difference?

tokyo_df_gender %>% 
  group_by(Gender, Discipline) %>% 
  summarise(Reaction_Time_Avg = round(mean(Reaction_Time_Avg, na.rm = TRUE), 2)) %>% 
  arrange(Discipline) %>% 
  flextable_style()

## `summarise()` has grouped output by 'Gender'. You can override using the `.groups` argument.

Gender	Discipline	Reaction_Time_Avg
F	Backstroke	0.62
M	Backstroke	0.59
F	Not Backstroke	0.70
M	Not Backstroke	0.66

The differences between men and women are a few hundreths of a second in reaction time, or about 5%. It’s something, sometimes the difference between a gold and a silver medal. The question with respect to my volleyball theory though is how does that difference in reaction times compare to the differences in ball velocity when hit by men vs. women.

There’s lots of sports science about ball velocity in volleyball. This review article¹ collects much of it and cites this article² reporting the spike speeds of elite male Italian players using an elevation style spike at 25.6 m/s and similarly elite female Italian players spiking the ball at 20.1 m/s using the elevation style. Comparable numbers are observed for athletes using the backswing style of spike. That means men spike approximately 25% faster than women. We found men’s reaction times to only be about 5% faster than women’s. From the evidence I’ve been able to uncover so far I’m concluding that my theory is largely correct. The women’s volleyball games I observed probably did have longer volleys. Of course if I’d been really on my game I would have counted some, but that ship has sailed. This analysis could also be deepened, perhaps by including a race-type component when considering swimmer reaction times.

There is also some literature evidence for my theory - that defense is relatively more potent compared to offense in women’s volleyball than in men’s volleyball. Here³ authors show that women have more successful digs, and fewer faulty digs than men at the 2000, 2004, 2008 and 2016 Olympics.

In Closing

The key messages I hope you’ll take from investigating my volleyball theory have nothing to do with gender based performance differences. Instead they are:

Domain specific knowledge is important. Recognizing differences between backstroke starts and the forward starts used in other events requires knowledge not just of R or stats, but of the actual topic at hand - swimming
Just because a t-test tells you that there’s a statistically significant difference between two populations doesn’t mean the difference actually matters in your evaluation. A 5% difference in reaction times is dwarfed by a 25% difference in ball speed
SwimmeR is an awesome package and you should tell all your friends about it

Thanks for reading, we hope to see you again here at [Swimming + Data Science]!

References

Oliveira L dos S, Moura TBMA, Rodacki ALF, Tilp M, Okazaki VHA. A systematic review of volleyball spike kinematics: Implications for practice and research. International Journal of Sports Science & Coaching. 2020;15(2):239-255. doi:10.1177/1747954119899881
Seminati E, Marzari A, Vacondio O, et al. Shoulder 3D range of motion and humerus rotation in two volleyball spike techniques: injury prevention and performance. Sports Biomech 2015; 14: 216–231
Kountouris P, Drikos S, Aggelonidis I, Laios A, Kyprianou M. Evidence for Differences in Men’s and Women’s Volleyball Games Based on Skills Effectiveness in Four Consecutive Olympic Tournaments. Comprehensive Psychology. January 2015. doi:10.2466/30.50.CP.4.9

Handling Splits with SwimmeR

Thu, 22 Jul 2021 00:00:00 +0000

Splits are generally reported in one of two formats, cumulative or lap. When working with data I find lap format to be more useful, but what’s most useful is to have all splits in the same format. This post discusses how to do just that with data from swimming and track. First step is to make sure you have the most recent versions of SwimmeR and JumpeR installed. SwimmeR is available from CRAN, JumpeR is from github.

install.packages("SwimmeR")
devtools::install_github("gpilgrim2670/JumpeR")

This post will consist of a demonstration of the tools available in SwimmeR for converting between split formats and their applicability to swimming and track data.

library(SwimmeR)
library(JumpeR)
library(dplyr)
library(flextable)

flextable_style <- function(x) {
  x %>%
    flextable() %>%
    bold(part = "header") %>% # bolds header
    bg(bg = "#D3D3D3", part = "header") %>%  # puts gray background behind the header row
    autofit()
}

Split Formats

Cumulative splits accumulate over the duration of an event. Say an athlete was clocked at 30.00 seconds for her first 50 yards. That 30.00 seconds is her 50 split. If the clock keeps running, and she’s clocked at 1:05.00 at the 100y mark that 1:05.00 is her cumulative 100 split. It contains the 30.00 50 split inside it. Her lap 100y split is 1:05.00 minus 30.00, which is 35.00. Lap splits are generally preferred, because they’re more specific. Rather than containing information about the entire race to a given point they only contain information about one specific component (lap) of a race.

Results with only cumulative splits do exist. Luckily the SwimmeR package contains functions to convert between the two types.

Cumulative Splits to Lap Splits

link <- "https://swimswam.com/wp-content/uploads/2019/03/D3.NCAA-2005.pdf"
df <- link %>% 
  SwimmeR::read_results() %>% 
  swim_parse(splits = TRUE, avoid = c("QUALIFYING", "NCAA"))

df_demo <- df %>% 
  filter(Event == "WOMEN's 200 Yard BUTTERFLY") %>% 
  filter(is.na(Name) == FALSE) %>% 
  head(3) %>% 
  select(Name, Finals_Time, contains("Split")) %>% 
  select(where(~!all(is.na(.x))))

df_demo %>% 
  flextable_style() %>% 
  set_caption("Raw Results, Cumulative Splits")

Table 1: Raw Results, Cumulative Splits
Name	Finals_Time	Split_50	Split_100	Split_150	Split_200
KEPHART, SAMANTHA	2:04.16	28.46	59.91	1:32.09	2:04.16
ROSS, MARIKA	2:05.13	28.39	1:00.59	1:33.10	2:05.13
WILLIAMSON, VANESSA	2:05.57	28.75	1:00.68	1:33.08	2:05.57

These splits, from the 2005 DIII NCAA championships are cumulative, which is not ideal. Enter SwimmeR’s splits_to_lap function, which uhhh, converts splits to lap format.

df_demo %>% 
  splits_to_lap() %>% 
  flextable_style() %>% 
  set_caption("Splits Converted to Lap Format")

Table 2: Splits Converted to Lap Format
Name	Finals_Time	Split_50	Split_100	Split_150	Split_200
KEPHART, SAMANTHA	2:04.16	28.46	31.45	32.18	32.07
ROSS, MARIKA	2:05.13	28.39	32.20	32.51	32.03
WILLIAMSON, VANESSA	2:05.57	28.75	31.93	32.40	32.49

Of course if you’re some kind of sicko and like cumulative splits SwimmeR is also (begrudgingly) here for you with the splits_to_cumulative function. Here’s splits_to_cumulative undoing all the good work of splits_to_lap.

df_demo %>% 
  splits_to_lap() %>% 
  splits_to_cumulative() %>% 
  flextable_style() %>% 
  set_caption("Splits Converted back to Cumulative Format")

Table 3: Splits Converted back to Cumulative Format
Name	Finals_Time	Split_50	Split_100	Split_150	Split_200
KEPHART, SAMANTHA	2:04.16	28.46	59.91	1:32.09	2:04.16
ROSS, MARIKA	2:05.13	28.39	1:00.59	1:33.10	2:05.13
WILLIAMSON, VANESSA	2:05.57	28.75	1:00.68	1:33.08	2:05.57

Data Frames with Mixed Cumulative and Lap Splits

Here at Swimming + Data Science we often assemble data frames from multiple meets. That means that some splits in a given data frame could be in cumulative format, while others are in lap format. How can we deal with a mixed format data frame? Well, here’s a example data frame with data from two swimmers, one with lap format splits and the other with cumulative.

df_mixed <- data.frame(
  Place = 1,
  Name = c("Lenore Lap", "Casey Cumulative"),
  Team = rep("KVAC", 2),
  Event = rep("Womens 200 Freestyle", 2),
  Finals_Time = rep("1:58.00", 2),
  Split_50 = rep("28.00", 2),
  Split_100 = c("31.00", "59.00"),
  Split_150 = c("30.00", "1:29.00"),
  Split_200 = c("29.00", "1:58.00")
)

df_mixed %>% 
  flextable_style() %>% 
  set_caption("Mixed Lap and Cumulative Splits")

Table 4: Mixed Lap and Cumulative Splits
Place	Name	Team	Event	Finals_Time	Split_50	Split_100	Split_150	Split_200
1	Lenore Lap	KVAC	Womens 200 Freestyle	1:58.00	28.00	31.00	30.00	29.00
1	Casey Cumulative	KVAC	Womens 200 Freestyle	1:58.00	28.00	59.00	1:29.00	1:58.00

In order to convert cumulative splits to lap format, but not interfere with those splits already in lap format it’s necessary to set a parameter called threshold in splits_to_lap. Setting threshold defines a maximum acceptable split value. All splits greater than threshold will be converted to lap format, and all splits less threshold will be unchanged. Looking at the table above all of Lenore Lap’s splits are less than 31.01, and all of Casey Cumulative’s cumulative splits are greater than 58.99, so any value between 31.01 and 58.99 will work for threshold. I’ll use threshold = 35 for this example

df_mixed %>% 
  splits_to_lap(threshold = 35) %>% 
  flextable_style() %>% 
  set_caption("All Splits in Lap Format")

Table 5: All Splits in Lap Format
Place	Name	Team	Event	Finals_Time	Split_50	Split_100	Split_150	Split_200
1	Lenore Lap	KVAC	Womens 200 Freestyle	1:58.00	28.00	31.00	30.00	29.00
1	Casey Cumulative	KVAC	Womens 200 Freestyle	1:58.00	28.00	31.00	30.00	29.00

Similarly splits_to_cumulatve also has a threshold parameter, which serves the same purpose. In splits_to_cumulative the threshold parameter is basically a minimum split time. The fastest (i.e. minimum) split in df_mixed is 28.00, so any value less than 28.00 will work. I’ll use threshold = 27.99 and all splits will be converted to cumulative format.

df_mixed %>% 
  splits_to_cumulative(threshold = 27.99) %>% 
  flextable_style() %>% 
  set_caption("All Splits in Cumulative Format")

Table 6: All Splits in Cumulative Format
Place	Name	Team	Event	Finals_Time	Split_50	Split_100	Split_150	Split_200
1	Lenore Lap	KVAC	Womens 200 Freestyle	1:58.00	28.00	59.00	1:29.00	1:58.00
1	Casey Cumulative	KVAC	Womens 200 Freestyle	1:58.00	28.00	59.00	1:29.00	1:58.00

Track and Field

Hadley has the tidyverse, his empire of interconnected packages. I’ve got my two, SwimmeR and JumpeR, which together make up the name-pending-verse. Send in your ideas.

A goal for the two packages going forward is to make utility functions, like splits_to_lap and splits_to_cumulative work for data gathered with both packages. This is an ongoing goal, and not fully realized, but the split handling functions are a step in the right direction.

Here’s an example of track data read in with JumpeR. The splits are in cumulative format.

df_track <- "https://www.flashresults.com/2017_Meets/Outdoor/04-29_VirginiaGrandPrix/025-1-01.htm" %>% 
  flash_parse_table(clean = TRUE, wide_format = TRUE) %>% 
  select(Name, Event, contains("Split")) %>% 
  head(3)

df_track %>% 
  flextable_style() %>% 
  set_caption("Track Results in Cumulative Format")

Table 7: Track Results in Cumulative Format
Name	Event	Split_300	Split_700	Split_1100	Split_1500
Khalil RMIDI KININI	1500m	44.81	1:46.73	2:49.10	3:46.70
Colin SCHULTZ	1500m	44.40	1:46.11	2:48.28	3:47.14
Andrew GOLDMAN	1500m	44.70	1:46.53	2:48.36	3:47.33

Converting these track splits to lap format is done exactly the same way as with swimming results, via SwimmeR::splits_to_lap.

df_track %>% 
  splits_to_lap() %>% 
  flextable_style() %>% 
  set_caption("Track Results in Lap Format")

Table 8: Track Results in Lap Format
Name	Event	Split_300	Split_700	Split_1100	Split_1500
Khalil RMIDI KININI	1500m	44.81	1:01.92	1:02.37	57.60
Colin SCHULTZ	1500m	44.40	1:01.71	1:02.17	58.86
Andrew GOLDMAN	1500m	44.70	1:01.83	1:01.83	58.97

In Closing

SwimmeR now offers functions for regularizing split formats and they’re also applicable to track results collected with JumpeR. Continued and expanded interoperability between the two packages is a development focus going forward. Thanks for joining us here at Swimming + Data Science

Omega Results and the 2021 Olympic Trials

Wed, 16 Jun 2021 00:00:00 +0000

Omega Timing is the official timekeeper for the Olympic Games, including US Olympic Trails. They don’t do very many other events, which is why SwimmeR hasn’t supported Omega-style results. Until now that is. Omega results can now be read into R with versions of SwimmeR >= 0.10.2, presently available as developmental versions from Github. We’ll read some Omega results in, and then do a quick set of tests about athlete reaction times.

devtools::install_github("gpilgrim2670/SwimmeR", build_vignettes = TRUE)

The 2020 US Trials are being held in 2021, in two parts. Wave I was held June 4th to 7th, and Wave II is currently being held June 13th - 20th. Omega has published the entire Wave I results here, but to avoid any potential broken links down the road I’m also hosting them on github here.

Let’s get set up and take a look.

library(SwimmeR)
library(dplyr)
library(stringr)
library(ggplot2)
library(flextable)

flextable_style <- function(x) {
  x %>%
    flextable() %>%
    bold(part = "header") %>% # bolds header
    bg(bg = "#D3D3D3", part = "header") %>%  # puts gray background behind the header row
    autofit()
}

US Trials Wave I - Getting Omega Results

The process of reading in Omega results with SwimmeR is exactly the same as reading in Hy-Tek or S.A.M.M.S.. Here’s the entire set of results from Wave I.

file <-
  "https://github.com/gpilgrim2670/Pilgrim_Data/raw/master/Omega/Omega_OT_Wave1_FullResults_2021.pdf"

Wave_I <- file %>%
  read_results() %>%
  swim_parse(splits = TRUE)

Here’s the top three finishers in the Women’s 100 Fly Final. The usual information is present - Place, Name, Team Finals_Time (Omega results don’t include prelims times…), various Splits columns. Also present is a Reaction_Time column, that will be the focus of a little demonstration later on.

Wave_I %>%
  filter(Event == "6 JUN 2021 - 7:37 PM Women's 100m Butterfly Final") %>%
  head(3) %>%
  select(where( ~ !all(is.na(.)))) %>% # remove splits columns that aren't relevant to this race (Split_150 etc.)
  select(-DQ,
         -Exhibition,
         "Reaction" = "Reaction_Time",
         "Finals" = "Finals_Time") %>%
  flextable_style()

Place	Lane	Name	Team	Reaction	Finals	Event	Split_50	Split_100
1	6	LU Sydney	PLS	0.64	1:00.38	6 JUN 2021 - 7:37 PM Women's 100m Butterfly Final	28.54	31.84
2	4	SMITHWICK Heidi	JDST	0.68	1:00.56	6 JUN 2021 - 7:37 PM Women's 100m Butterfly Final	28.08	32.48
3	5	VANNOTE Ellie	UNC	0.69	1:00.60	6 JUN 2021 - 7:37 PM Women's 100m Butterfly Final	28.33	32.27

US Trials Wave II

Wave II of the US trials is where the actual Olympic Team is being selected. It’s still underway as of this writing, so there’s not a single document containing all results available. Individual result documents for each event are being posted however, as the events are completed. Here’s the Women’s 100 Breaststroke final, featuring Lilly King.

file <-
  "https://github.com/gpilgrim2670/Pilgrim_Data/raw/master/Omega/Omega_OT_Wave2_W100Br_Finals_2021.pdf"

W100Br <- file %>%
  read_results() %>%
  swim_parse(splits = TRUE)

W100Br %>%
  select(-DQ,
         -Exhibition,
         "Reaction" = "Reaction_Time", 
         "Finals" = "Finals_Time") %>%
  flextable_style()

Place	Lane	Name	Team	Reaction	Finals	Event	Split_50	Split_100
1	4	KING Lilly	ISC	0.65	1:04.79	PM Women's 100m Breaststroke Final	30.34	34.45
2	3	JACOBY Lydia	STSC	0.63	1:05.28	PM Women's 100m Breaststroke Final	30.94	34.34
3	5	LAZOR Annie	MVN	0.66	1:05.60	PM Women's 100m Breaststroke Final	30.82	34.78
4	6	GALAT Bethany	AGS	0.53	1:05.75	PM Women's 100m Breaststroke Final	30.69	35.06
5	0	DOBLER Kaitlyn	TDPS	0.65	1:06.29	PM Women's 100m Breaststroke Final	30.83	35.46
6	2	SUMRALL Micah	GAME	0.71	1:06.84	PM Women's 100m Breaststroke Final	31.83	35.01
7	7	HANNIS Molly	TNAQ	0.70	1:07.26	PM Women's 100m Breaststroke Final	31.29	35.97
8	1	ESCOBEDO Emily	COND	0.68	1:07.31	PM Women's 100m Breaststroke Final	31.91	35.40
9	8	TUCKER Miranda	UN-MI	0.68	1:07.44	PM Women's 100m Breaststroke Final	31.73	35.71

Australian Trials

Also underway are the Australian Trials. Similarly to the US Trials they can be read into R using SwimmeR versions >= 0.10.2. For the very curious, these are Hy-Tek results, not Omega. We at Swimming + Data Science have scrapped entire Hy-Tek live results pages before and the same general principles can be applied the collect all Australian Trials results. Here’s just the Men’s 100 Fly Final.

file <-
  "http://liveresults.swimming.org.au/SAL/2021TRIALS/210612F015.htm"

M100Bk <- file %>%
  read_results() %>%
  swim_parse(splits = TRUE)

M100Bk %>%
  select(-DQ,
         -Exhibition,
         -Points,
         "Prelims" = "Prelims_Time",
         "Finals" = "Finals_Time") %>%
  flextable_style()

Place	Name	Age	Team	Prelims	Finals	Event	Split_50	Split_100
1	LARKIN, MITCH	27	STPET	53.04	53.40	Male 100 LC Metre Backstroke	25.86	27.54
2	COOPER, ISAAC	17	RACKL	53.79	53.49	Male 100 LC Metre Backstroke	25.94	27.55
3	HOLLARD, TRISTA	24	STHPT	54.56	54.00	Male 100 LC Metre Backstroke	26.73	27.27
4	WOODWARD, BRADL	22	MING	54.47	54.13	Male 100 LC Metre Backstroke	26.19	27.94
5	YANG, WILLIAM	22	LNSC	54.75	54.56	Male 100 LC Metre Backstroke	25.98	28.58
6	MAHONEY, TRAVIS	30	MARI	55.03	55.02	Male 100 LC Metre Backstroke	26.78	28.24
7	VAN KOOL, KAI	19	GUSC	54.68	55.13	Male 100 LC Metre Backstroke	26.38	28.75
8	HARTWELL, TY	20	CHAND	55.00	55.23	Male 100 LC Metre Backstroke	26.66	28.57
9	TYSOE, CAMERON	24	GIND	55.05	54.84	Male 100 LC Metre Backstroke	26.46	28.38
10	MILLS, PETER	24	MBAY	55.04	55.30	Male 100 LC Metre Backstroke	26.74	28.56
11	SWINBURN, STUAR	19	UNSW	55.80	55.65	Male 100 LC Metre Backstroke	27.00	28.65
12	BAYLISS, JAMES	17	NCOLL	56.06	55.91	Male 100 LC Metre Backstroke	26.68	29.23
13	BOOTH, SHAYE	20	MING	56.33	55.99	Male 100 LC Metre Backstroke	27.21	28.78
14	DAFF, CONOR	18	MBAY	56.25	56.08	Male 100 LC Metre Backstroke	26.93	29.15
15	FOOTE, NATHAN	20	STAND	56.19	56.33	Male 100 LC Metre Backstroke	27.59	28.74
16	CORNWELL, JYE	24	YERPK	56.03	56.43	Male 100 LC Metre Backstroke	27.17	29.26

US Trials Wave I Reaction Time Demo

Let’s see if there’s a difference between the reaction times of sprinters, mid distance swimmers and distance swimmers in the US Trials Wave I results. We’ll define anyone who swims 50 or 100m distances as a sprinter, anyone who swims the 800 or 1500m distances as a distance swimmer, and everyone else as mid-distance.

For this analysis We’ll need the Lane, Name, Reaction_Time and Event columns. The other columns won’t be needed, so I’ll remove them.

We can pull distances out the event names. Note however from the 100 Fly results above that the event names contain more information than we’re perhaps used to seeing. Let’s clean that up.

Wave_I_Clean <- Wave_I %>%
  select(Lane, Name, Team, Reaction_Time, Event) %>% # select only columns of interest
  mutate(Event = str_remove(Event, ".*(?=(Men)|(Women))")) %>% # remove everything in event names before Men or Women
  mutate(Reaction_Time = as.numeric(Reaction_Time)) # change type of Reaction_Time column

Now we can classify swimmers by type.

Wave_I_Clean <- Wave_I_Clean %>%
  group_by(Name) %>% # determining type by athlete
  mutate(Type = case_when(
    # encode athlete types based on events swam
    any(str_detect(Event, "(1500m)|(800m)"), na.rm = TRUE) == TRUE ~ "Distance",
    any(str_detect(Event, "(100m)|(50m)"), na.rm = TRUE) == TRUE ~ "Sprint",
    TRUE ~ "Mid"
  )) %>%
  mutate(Type = factor(Type, levels = c("Sprint", "Mid", "Distance"))) # type as ordered factor for ggplot later

Let’s look at the distribution of reaction times by swimmer type.

Wave_I_Clean %>%
  ggplot(aes(x = Type, y = Reaction_Time, fill = Type)) +
  geom_violin() +
  theme_bw() +
  labs(y = "Reaction Time (s)",
       title = "Reaction Times by Swimmer Type")

There is a noticeable shift towards slower reaction times for distance swimmers compared to sprint and mid-distance, but is it significant? We can use an ANOVA test to determine if the values are significantly different to some standard (called a p value).

reaction_anova <- aov(Reaction_Time ~ Type, data = Wave_I_Clean) # calculate anova
reaction_anova_summary <- summary(reaction_anova) # save summary anova object
reaction_anova_summary # view anova results

##               Df Sum Sq Mean Sq F value Pr(>F)    
## Type           2  0.479 0.23930   74.65 <2e-16 ***
## Residuals   1270  4.071 0.00321                   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

The p value is very low, at 2.2336931^{-31}. We can conclude that their are significant differences between the groups to at least a significance value (p value) of 0.001. That means the likelihood of these level of difference between the three groups appearing as the result of random variations in populations that are actually identical is less than 0.1%. The ANOVA test doesn’t tell us which group(s) have the significant differences though. For that we can use a Tukey HSD test.

reaction_Tukey <- TukeyHSD(reaction_anova) # calculate Tukey HSD
reaction_Tukey # view results

##   Tukey multiple comparisons of means
##     95% family-wise confidence level
## 
## Fit: aov(formula = Reaction_Time ~ Type, data = Wave_I_Clean)
## 
## $Type
##                       diff        lwr        upr p adj
## Mid-Sprint      0.02606628 0.01762142 0.03451114     0
## Distance-Sprint 0.07474784 0.05854508 0.09095060     0
## Distance-Mid    0.04868156 0.03158292 0.06578019     0

The adjusted p values are all approximately zero. we can see what they actually are by pulling them out of the reaction_Tukey model object.

reaction_Tukey$Type[,"p adj"] # view actual adjusted p values

##      Mid-Sprint Distance-Sprint    Distance-Mid 
##    1.634137e-12    0.000000e+00    1.058689e-10

All very low, so all the groups have differences significant at the p = 0.001 level. Sprinters really do have faster reaction times than mid-distance, who are in turn faster than distance swimmers.

Reaction Times By Lane

Just for giggles let’s also look by lane. When I was swimming there was always this rumor going around that swimmers in the outside lane nearest the starting device would have an advantage, because the light/sound from the device would reach them before it reached athletes further from the device. It never made much sense, since faster swimmers were deliberately seeded into inner lanes and they usually won. Nowadays each block is equipped with a LED light bar and a sounding device so everything should be equal (if it ever wasn’t).

Wave_I_Clean %>%
  filter(Lane != "0") %>% 
  ggplot(aes(x = Lane, y = Reaction_Time, fill = Lane)) +
  geom_violin() +
  theme_bw() +
  labs(y = "Reaction Time (s)",
       title = "Reaction Times by Lane")

That looks about even to me. Let’s see what the testing has to say.

reaction_anova <- aov(Reaction_Time ~ Lane, data = Wave_I_Clean) # calculate anova
reaction_anova_summary <- summary(reaction_anova) # save summary anova object
reaction_anova_summary # view anova results

##               Df Sum Sq  Mean Sq F value Pr(>F)
## Lane           8  0.025 0.003144   0.878  0.534
## Residuals   1264  4.525 0.003580

Here the p value is 0.5341483, which is larger than any p value we’d care to use. There is no significant difference in reaction time by lane.

In Closing

I hope you’re enjoying the various Olympic Trials meets, even all the more so now that SwimmeR makes it easy to import them into R. Join us next time here at Swimming + Data Science where we’ll take a look at something else swimming-centric.

The 2021 USMS ePostal Championship Results, Working Up Data for a Shiny App

Tue, 27 Apr 2021 00:00:00 +0000

Final results for the 2021 USMS ePostal National Championships have been posted. We’ll take a look at them using some basic summary stats and charts, then work up the data from inclusion in Shiny application built to present it interactively.

If you’d like to just skip to playing with the app and not bother about working up the data the app is available here.

This will be a tutorial style post, where I’ll prioritize making the code clear and readable, while perhaps sacrificing efficiency. No building functions and them mapping them like I sometimes do.

With that in mind let’s grab some packages. We’ll use readr to actually read in the data set. Then dplyr and stringr to work it up and finally ggplot2 and flextable to present it at various points throughout the article.

library(readr)
library(dplyr)
library(stringr)
library(ggplot2)
library(flextable)


flextable_style <- function(x) {
  x %>%
    flextable() %>%
    bold(part = "header") %>% # bolds header
    bg(bg = "#D3D3D3", part = "header") %>%  # puts gray background behind the header row
    autofit()
}

I’ve already collected the data from USMS, wrestled it into a .csv file and hosted that on Github (you’re all very welcome). We can grab it directly with read_csv.

Postal <- read_csv("https://raw.githubusercontent.com/gpilgrim2670/MastersPostal/master/Postal_Raw.csv")

Last year I did a big analysis of the 2020 ePostal results and another on the ePostal over the past two+ decades. Rather than just repurposing all that code (which you’re welcome to do if you’d like) we’ll just take a quick look at the 2021 results before working up all the data, from all the years for the Shiny app.

How Many People Participated This Year?

Postal %>% 
  filter(Year == "2021") %>% 
  group_by(Gender) %>% 
  summarise(Count = n()) %>% 
  flextable_style()

Gender	Count
M	317
W	372

How Does That Compare to Previous Years?

Postal %>% 
  group_by(Year, Gender) %>%
  summarise(Count = n()) %>% 
  ggplot() +
  geom_line(aes(x = Year, y = Count, color = Gender)) +
  theme_bw() +
  labs(title = "USMS ePostal Participation by Year")

It’s fewer people. Probably COVID, and the general trends discussed here. Moving on.

Shiny App

Cleaning Data for a Shiny App

The data we’ve already downloaded and named Postal contains the as-reported results from all ePostals from 1998 through 2021. Let’s take a look.

names(Postal)

## [1] "Place"           "Name"            "Age"             "USMS_ID"        
## [5] "Distance"        "Club"            "Gender"          "Year"           
## [9] "National_Record"

Pretty self explanatory column names, and quite a bit of information. There’s more though that we can tease out.

I’d like to add to Postal in the following ways:

Age groups. The ePostal is scored by age group, 18-24 and then by 5 year windows thereafter (25-29 etc.)
Athlete’s relative place within their age and gender category by year
An athlete’s average 50 split, based on distance traveled and assuming a 25 yard pool
Cleaning up USMS identification to identify athletes across years
Club sizes. USMS defines club sizes and scores based on those sizes, both by gender and total size by year
Summary stats for clubs by year
- Total distance swam
- Club rankings by gender
- Average distance traveled and 50 split by gender
- Average age by gender

Since this is headed for a Shiny app, where it will be displayed the goal will be to make information readable, which will involve some sacrifices. For example an athlete’s relative place will be a string in the form of “Athlete place of Total place” (i.e. “1 of 54”) rather than just a naked numeric.

Age Groups

Since we already have an Age column making an age group column is a simple matter of using dplyr::case_when to match the appropriate age range to the Age. We’ll do this using dplyr::between. between takes three arguments - a value x, a left and a right. If x >= left & x <= right then between returns TRUE. Otherwise between returns FASLE. The resulting code is perhaps long, and there are more compact ways to do this, but it’s also very readable, approximating written English. Readability is useful in the context of a blog entry and I’ll continue to prioritize it throughout.

Postal <- Postal %>% 
  mutate(
    Age_Group = case_when(
      between(Age, 0, 24) ~ "18-24",
      between(Age, 25, 29) ~ "25-29",
      between(Age, 30, 34) ~ "30-34",
      between(Age, 35, 39) ~ "35-39",
      between(Age, 40, 44) ~ "40-44",
      between(Age, 45, 49) ~ "45-49",
      between(Age, 50, 54) ~ "50-54",
      between(Age, 55, 59) ~ "55-59",
      between(Age, 60, 64) ~ "60-64",
      between(Age, 65, 69) ~ "65-69",
      between(Age, 70, 74) ~ "70-74",
      between(Age, 75, 79) ~ "75-79",
      between(Age, 80, 84) ~ "80-84",
      between(Age, 85, 89) ~ "85-89",
      between(Age, 90, 94) ~ "90-94",
      between(Age, 95, 99)~ "95-99",
      between(Age, 100, 104) ~ "100-104",
      TRUE ~ "NA" # if for some reason Age doesn't match any of the above this will catch it and write the string 'NA'
    )
  ) %>% 
  mutate(Age_Group = factor(Age_Group, levels = c("18-24", "25-29", "30-34", "35-39", "40-44", "45-49", "50-54", "55-59", "60-64", "65-69", "70-74", "75-79", "80-84", "85-89", "90-94", "95-99")))

# demonstration table
Postal %>%
  select(Place, Name, Distance, Year, Age, Age_Group, Gender) %>% 
  head(5) %>%
  flextable_style()

Place	Name	Distance	Year	Age	Age_Group	Gender
1	Robert Wagner	5450	2021	19	18-24	M
2	Elliott Roman	5215	2021	24	18-24	M
3	William Kemp	4700	2021	22	18-24	M
4	Dylan Ogle	4250	2021	23	18-24	M
5	Gregory Willett	4035	2021	24	18-24	M

Athlete Relative Place

As discussed above the athlete place column will contain a string giving an individual athlete’s place within their age and gender category for a given year. The point is to provide a means of comparing two athletes in the Shiny app. If Athlete A and Athlete B both finished 6th, but Athlete A did so in a category with 50 entrants vs. only 10 in Athlete B’s category then that’s worth knowing when comparing them.

Here we’ll just paste an athlete’s Place, the string " of " and the maximumn place from that age group together.

Postal <- Postal %>%
  group_by(Gender, Age_Group, Year) %>% # places are caluclated by gender, age group and year
  mutate(Relative_Place = paste(Place, max(Place, na.rm = TRUE), sep = " of ")) # use paste to build string

# demonstration table
Postal %>%
  select(Place, Name, Distance, Year, Age_Group, Gender, Relative_Place) %>% 
  head(5) %>%
  flextable_style()

Place	Name	Distance	Year	Age_Group	Gender	Relative_Place
1	Robert Wagner	5450	2021	18-24	M	1 of 5
2	Elliott Roman	5215	2021	18-24	M	2 of 5
3	William Kemp	4700	2021	18-24	M	3 of 5
4	Dylan Ogle	4250	2021	18-24	M	4 of 5
5	Gregory Willett	4035	2021	18-24	M	5 of 5

Average 50 Split

I’m accustomed to looking at 50 splits in swimming, and I think it’s an interesting metric by which to evaluate ePostal results as well. An athlete’s split can be calculated by converting the time (1 hour), then multiplying that number of seconds by 50 and then multiplying again by reciprocal distance to get a number in units of seconds per 50 yards. We can then round and format the result to make it pleasant to look at.

Postal <- Postal %>%
  mutate(Avg_Split_50 = (1 / Distance) * 60 * 60 * 50) %>% # compute split
  mutate(Avg_Split_50 = format(round(Avg_Split_50, 2), nsmall = 2)) # want two decimal places, even if the last one is a zero

# demonstration table
Postal %>%
  select(Place, Name, Distance, Year, Age_Group, Gender, Avg_Split_50) %>% 
  head(5) %>%
  flextable_style()

Place	Name	Distance	Year	Age_Group	Gender	Avg_Split_50
1	Robert Wagner	5450	2021	18-24	M	33.03
2	Elliott Roman	5215	2021	18-24	M	34.52
3	William Kemp	4700	2021	18-24	M	38.30
4	Dylan Ogle	4250	2021	18-24	M	42.35
5	Gregory Willett	4035	2021	18-24	M	44.61

USMS_ID

The value in USMS_ID has two parts. The first four characters, before the "-" vary year to year. The last five characters, after the "-" are an athlete’s permanent identification string, used to identify athletes without relaying on names. We discuss this records matching problem a lot around here, because athlete names aren’t a stable means of identification. Sometimes people get married and change their names. Sometimes people use nicknames. Things happen and the permanant portion of the USMS_ID is a good way of handling things. Sadly ePostal results only include USMS_ID after 2010, so we need to come up with something for pre-2011 results.

Here’s the plan. We’ll break off the permanent portion of USMS_ID into a new column called Perm_ID based on the location of "-" using str_split_fixed. Rows without a USMS_ID will have an empty character string "" in Perm_ID, which we’ll convert to NA with na_if. Then we’ll group athletes by name. If any entry for that athlete, using that name, is from post-2010 they’ll have a Perm_ID which we’ll be able to copy to all rows involving that name using the tidyr::fill function. It’s of course possible to have two athletes with the same name. We could be stricter here and group_by name and club for example, but athletes do change clubs. There are other things we could try as well, like matching on age progression, but for right now we’re just going to accept that there might be some false matches.

Postal <- Postal %>%
  mutate(Perm_ID = str_split_fixed(USMS_ID, "-", n = 2)[, 2], # only want the second part of the split
         Perm_ID = na_if(Perm_ID, "")) %>%  # turn empty strings "" into NAs
  group_by(Name) %>%
  tidyr::fill(Perm_ID, .direction = "updown") # all instances of name will get non-NA value of Perm_ID - assumes there's only one unique Perm_ID for each name

Some athletes still don’t have a Perm_ID though, because they don’t have a USMS_ID listed.

# demonstration table
Postal %>%
  filter(Year == 1998) %>% 
  select(Place, Name, Year, USMS_ID, Perm_ID) %>%
  head(5) %>%
  flextable_style()

Place	Name	Year	USMS_ID	Perm_ID
1	Becky Crowe	1998
2	Johanna Hardin	1998
3	Sarah Anderson	1998
4	Sarah Baker	1998		09RB9
5	Jane Kelsey	1998

We’re going to make them fake Perm_IDs. Each fake Perm_ID will be a six character string of upper case letters. We’ll use this slightly different format (compared to the five character alphanumeric real Perm_IDs) so that it’s possible to differentiate the fake from the real.

Each unique name without a real Perm_ID needs a fake Perm_ID. Let’s first collect those unique names.

Unique_Names <- Postal %>%
  ungroup() %>%
  select(Name, Perm_ID) %>% # don't need all the columns, only these two
  filter(is.na(Perm_ID) == TRUE) %>% # want only rows where there isn't a Perm_ID
  unique() # don't need duplicates

Unique_Names %>% 
  head(5) %>%
  flextable_style()

Name	Perm_ID
Glen Christiansen
Lou Hill
Sue Lyon
Masao Miyasaka
Karina Horton

Now we need a list of random strings, one for each name. Since we’re generating something random we’ll use set.seed to make it reproducible. Then we’ll use the stringi::stri_rand_strings function to generate a list of random strings with length 6. The length of the list will be the number of rows in unique_names.

set.seed(1) # to make random strings reproducible

Unique_Names <- Unique_Names %>% 
  mutate(Perm_ID = stringi::stri_rand_strings( # make random strings
    n = nrow(Unique_Names), # number of random strings to make
    length = 6, # number of characters in each string
    pattern = "[A-Z]" # what to make the string out of, in this case all capital letters
  ))

# demonstration table
Unique_Names %>% 
  head(5) %>%
  flextable_style()

Name	Perm_ID
Glen Christiansen	GJOXFX
Lou Hill	YRQBFE
Sue Lyon	RJUMSZ
Masao Miyasaka	JUYFQD
Karina Horton	GKAJWI

Now we’ll join Postal and Unique_Names back up by Name and use coalesce to get non-NA values of Perm_ID for each row. Each Name, which hopefully means each athlete, now has a unique Perm_ID.

Postal <- Postal %>% 
  left_join(Unique_Names, by = "Name") %>% # attach newly made strings back to original data frame based on name
  mutate(Perm_ID = coalesce(Perm_ID.x, Perm_ID.y)) %>% # use first non-na value between original data frame (x) and new data frame (y)
  select(-Perm_ID.x, -Perm_ID.y) # don't need these columns any more

# demonstration table
Postal %>%
  filter(Year == 1998) %>% 
  select(Place, Name, Year, USMS_ID, Perm_ID) %>%
  head(5) %>%
  flextable_style()

Place	Name	Year	USMS_ID	Perm_ID
1	Becky Crowe	1998		XZPOKS
2	Johanna Hardin	1998		EOFXZG
3	Sarah Anderson	1998		YSAWZT
4	Sarah Baker	1998		09RB9
5	Jane Kelsey	1998		DHNSNX

Club Sizes

USMS defines categories of club size for the ePostal as small, medium, large and extra large based on the number of athletes representing that club. Here we’ll count the number of athletes for each club with n and categorize appropriately with case_when. It’s also interesting to look at participation by gender, so we’ll count the male and female athletes for each club using sum. We’ll get new columns of the form Club_Count (number of athletes in a club) and Club_Size (a factor with levels S, M, L, XL).

# total club size
Postal <- Postal %>% 
    group_by(Club, Year) %>% # working with clubs now, by year
    mutate(Club_Count = n()) %>% # number of athletes in each club for a given year
    mutate(Club_Size_Combined = case_when( # code in club sizes based on number of athletes
      Club_Count < 26 ~ "S",
      Club_Count < 50 ~ "M",
      Club_Count <= 100 ~ "L",
      TRUE ~ "XL"
    )) %>% 
  mutate(Club_Size_Combined = factor(Club_Size_Combined, levels = c("S", "M", "L", "XL")))

# male club size
Postal <- Postal %>% 
    group_by(Club, Year) %>%
    mutate(Club_Count_Male = sum(Gender == "M", na.rm = TRUE)) %>% # only want to count men this time
    mutate(Club_Size_Male = case_when(
      Club_Count_Male < 26 ~ "S",
      Club_Count_Male < 50 ~ "M",
      Club_Count_Male <= 100 ~ "L",
      TRUE ~ "XL"
    )) %>% 
    mutate(Club_Size_Male = factor(Club_Size_Male, levels = c("S", "M", "L", "XL")))

# female club size
Postal <- Postal %>% 
    group_by(Club, Year) %>%
    mutate(Club_Count_Female = sum(Gender == "W", na.rm = TRUE)) %>% # only want to count women this time
    mutate(Club_Size_Female = case_when(
      Club_Count_Female < 26 ~ "S",
      Club_Count_Female < 50 ~ "M",
      Club_Count_Female <= 100 ~ "L",
      TRUE ~ "XL"
    )) %>% 
    mutate(Club_Size_Female = factor(Club_Size_Female, levels = c("S", "M", "L", "XL")))

# demonstration table
Postal %>%
  select(Club, Year, Club_Count, Club_Size_Combined, Club_Size_Male) %>% 
  head(5) %>%
  flextable_style()

Club	Year	Club_Count	Club_Size_Combined	Club_Size_Male
BSMT	2021	46	M	S
SKY	2021	15	S	S
SKY	2021	15	S	S
GS	2021	3	S	S
SKY	2021	15	S	S

Club Summary Stats

In addition to making comparisons between athletes we can also make comparisons between clubs.

Club Total and Average Distance

Clubs are scored based on the total distance swam by their memberships. Here we can group_by club can year, then add up the total distance each club swam with sum.

# total club stats
Postal <- Postal %>%
  mutate(Distance = na_if(Distance, 0)) %>% # shouldn't be any distance NA values, but convert to zero if there are
  group_by(Club, Year) %>%
  mutate(Total_Distance_Combined = sum(Distance, na.rm = TRUE)) %>% # add up distance for each club/year
  mutate(Avg_Distance_Combined = Total_Distance_Combined / Club_Count) %>% # calculate avg distance per athlete
  mutate(Avg_Distance_Combined = round(Avg_Distance_Combined, 0))# don't want decimal places


# male stats
Postal <- Postal %>%
  group_by(Club, Year) %>%
  mutate(Total_Distance_Male = sum(Distance[Gender == "M"], na.rm = TRUE)) %>%
  mutate(Avg_Distance_Male = Total_Distance_Male / Club_Count_Male) %>%
  mutate(Avg_Distance_Male = round(Avg_Distance_Male, 0))

# female stats
Postal <- Postal %>%
  group_by(Club, Year) %>%
  mutate(Total_Distance_Female = sum(Distance[Gender == "W"], na.rm = TRUE)) %>%
  mutate(Avg_Distance_Female = Total_Distance_Female / Club_Count_Female) %>%
  mutate(Avg_Distance_Female = round(Avg_Distance_Female, 0))

# demonstration table
Postal %>%
  filter(Gender == "W") %>% 
  select(Club, Year, Total_Distance_Female, Avg_Distance_Female) %>% 
  head(5) %>%
  flextable_style()

Club	Year	Total_Distance_Female	Avg_Distance_Female
IM	2021	45420	3785
GS	2021	5850	2925
UC08	2021	3400	3400
CRUZ	2021	18475	4619
1776	2021	38340	4260

Club Rank

Clubs can be ranked within their size/gender categories by total distance swam in much the same way we ranked swimmers within their age/gender categories. Since their are only three categories (combined, male, female) I’m not going to bother about including category size like with did with individual athletes although it’s certainly possible to do so. Here we’ll just group_by the appropriate Club_size column and the year and then use dense_rank to get the ranking for each club. dense_rank is one of the the six dplyr ranking functions. It ranks values in a vector giving tied values a minimum rank and does not skip places as a result of ties. Here’s a demonstration, because some of you might not be familiar with dense_rank.

Assume four clubs A-D, each of which swam some total distance.

distances <- c(10000, 15000, 15000, 20000)
names(distances) <- c("A", "B", "C", "D")
distances

##     A     B     C     D 
## 10000 15000 15000 20000

What we’d like to say is that club D is first, clubs B and C are tied for second and club A is third. Club B and C both getting second (rather than say, 2.5th, or randomly giving one 2nd and the other 3rd) is what I mean by “giving tied values a minimum rank”. Club A getting third, rather than forth (as the forth club on the list) is what I mean by “not skip[ping] places as a result of ties”. We also need to use desc because we want the clubs with the largest distance values to get the lowest valued places - club D should be first.

dense_rank(desc(distances))

## [1] 3 2 2 1

Now to use dense_rank with our real data.

# total club stats
Postal <- Postal %>%
  group_by(Club_Size_Combined, Year) %>%
  mutate(Combined_Rank = dense_rank(desc(Total_Distance_Combined))) # calculate ranking

# male stats
Postal <- Postal %>%
  group_by(Club_Size_Male, Year) %>%
  mutate(Male_Rank = dense_rank(desc(Total_Distance_Male)))


# female stats
Postal <- Postal %>%
  group_by(Club_Size_Female, Year) %>%
  mutate(Female_Rank = dense_rank(desc(Total_Distance_Female)))

# demonstration table
Postal %>%
  filter(Gender == "W") %>%
  select(Club,
         Year,
         Club_Size_Female,
         Total_Distance_Female,
         Female_Rank) %>%
  head(5) %>%
  flextable_style()

Club	Year	Club_Size_Female	Total_Distance_Female	Female_Rank
IM	2021	S	45420	5
GS	2021	S	5850	44
UC08	2021	S	3400	67
CRUZ	2021	S	18475	14
1776	2021	S	38340	8

Average Club Splits

Average club splits are similar to athlete splits, just for an entire club. There are lots of ways to calculate such a value. We could group_by club and average the Avg_Split_50 that we already calculated. Or we could recalculate based on Avg_Club_Distance. Let’s do that.

# total club splits
Postal <- Postal %>%
  ungroup() %>% 
  group_by(Club, Year) %>% 
  mutate(Avg_Split_50_Club_Combined = (1 / Avg_Distance_Combined) * 60 * # compute 50 splits by club, year
           60 * 50) %>%
  mutate(Avg_Split_50_Club_Combined = format(round(Avg_Split_50_Club_Combined, 2), nsmall = 2))
  
# male club splits
Postal <- Postal %>%
  ungroup() %>%
  group_by(Club, Year) %>%
  mutate(Avg_Split_50_Club_Male = (1 / Avg_Distance_Male) * 60 * 60 *
           50) %>%
  mutate(Avg_Split_50_Club_Male =
           format(round(Avg_Split_50_Club_Male, 2), nsmall = 2))

# female club splits
Postal <- Postal %>%
  ungroup() %>%
  group_by(Club, Year) %>%
  mutate(Avg_Split_50_Club_Female = (1 / Avg_Distance_Female) * 60 * 60 *
           50) %>%
  mutate(Avg_Split_50_Club_Female =
           format(round(Avg_Split_50_Club_Female, 2), nsmall = 2))

# demonstration table
Postal %>%
  filter(Gender == "W") %>%
  arrange(desc(Avg_Distance_Female)) %>% 
  select(Club,
         Year,
         Club_Size_Female,
         Avg_Split_50_Club_Female,
         Female_Rank) %>%
  head(5) %>%
  flextable_style()

Club	Year	Club_Size_Female	Avg_Split_50_Club_Female	Female_Rank
CFMS	2015	S	33.12	88
UHM	2000	S	33.77	55
LVM	2009	S	34.42	75
TERA	1999	S	34.42	51
ALEX	2014	S	34.45	105

Average Club Age

Here we’ll go the other way, and compute average club ages by grouping_by Club and Year and then taking the mean of Age for all athletes in each group.

# total club age
Postal <- Postal %>%
  group_by(Club, Year) %>%
  mutate(Avg_Age_Club = mean(Age, na.rm = TRUE)) %>% # average age of club athletes in a given year
  mutate(Avg_Age_Club = round(Avg_Age_Club, 2)) # round off to 2 decimal places


# male club age
Postal <- Postal %>%
  group_by(Club, Year) %>%
  mutate(Avg_Age_Club_Male = mean(Age[Gender == "M"], na.rm = TRUE)) %>%
  mutate(Avg_Age_Club_Male = round(Avg_Age_Club_Male, 2))
  
# female club age
Postal <- Postal %>%
  group_by(Club, Year) %>%
  mutate(Avg_Age_Club_Female = mean(Age[Gender == "W"], na.rm = TRUE)) %>%
  mutate(Avg_Age_Club_Female = round(Avg_Age_Club_Female, 2))

# demonstration table
Postal %>%
  arrange(Avg_Age_Club) %>% 
  select(Club,
         Year,
         Club_Size_Combined,
         Avg_Age_Club,
         Combined_Rank) %>%
  head(5) %>%
  flextable_style()

Club	Year	Club_Size_Combined	Avg_Age_Club	Combined_Rank
BAY	2013	S	19	129
SBAS	2006	S	19	78
UCSB	2006	S	20	79
CHR	2005	S	20	88
GSC	2001	S	20	95

A Shiny App

We’re not going to build a Shiny app here, but I’ll show you one I’ve already built that runs off this data. You can explore it here and view the source code here. Please note I only have so much bandwidth available for the Shiny app. If it doesn’t open for you try again later. Below are some screen shots of the app in action.

It will let you view results from individual athletes and/or whole clubs over the years:

Screenshot of Timeseries Plot for SFGG Athletes

Or box plots by gender for a given year, similar to this post:

Screenshot of Box Plots for Age Groups by Gender in 2021

Or a table of club results for a given year:

Screenshot of Club Results Table 2021

All the data is downloadable as .csv files directly from the app.

Conclusions

Thank you for joining us here at Swimming + Data Science for what’s hopefully been an informative look at working up data and the USMS ePostal. Come back and join us next time when we’ll be doing - something else. I’m not quite sure yet.

SwimmeR goes to the Para Games and other Updates - v0.9.0

Tue, 20 Apr 2021 00:00:00 +0000

There’s a new version of SwimmeR available, v0.9.0. It follows v0.8.0, which I didn’t like and didn’t write about. I’ve made some improvements though and here we are. Rather than just telling you what’s in v0.9.0 I’m going to indulge myself and approach this new version via one of my other (tangentially related) interests and touch on the motivations behind some of the changes.

Panel Shows and Swimmers

I really like are panel shows. We don’t really have them in the US, but they’re common in Britain, and available online. Generally speaking a panel show is a type of television program where a host and a number of panelists undertake a game or conversation in an entertaining fashion. Panelists are usually stand up comedians but sometimes other notables, like athletes, participate as well. Olympic gold medalist Rebecca Adlington was a panelist on 8 Out of Ten Cats (“a show about statistics” as the tag line goes) after the London Games.

Rebecca Adlington joins Comedians Jon Richardson and Romesh Ranganathan

After the Rio games gold medalist and Paralympian Ellie Simmonds was on as well and demonstrated her skill at a “cereal box game”. When it comes to having swimmers on as guests though no show does better than the Last Leg. They’ve had lots of swimmers. Liz Johnson, Sasha Kindred, Jeanette Chippington, the aforementioned Ellie Simmonds, and plenty more.

Ellie Simmonds on the Last Leg

I watch that show all the time and it brings me a lot of joy. Host Adam Hills frequently challenges people to do better, often specifically advocating for improved access for people with disabilities.

So, as you may have guessed from the post title, we here at Swimming + Data Science are attempting to meet Hillsy’s challenge by better addressing para athletics within SwimmeR. As of v0.8.0 SwimmeR now handles para swimming codes (S4, SM10 etc.).

Setup

First download the new version from CRAN.

install.packages("SwimmeR")

Then load the package and some others that we’ll also need.

library(SwimmeR)
library(flextable)
library(dplyr)

flextable_style <- function(x) {
  x %>%
    flextable() %>%
    bold(part = "header") %>% # bolds header
    bg(bg = "#D3D3D3", part = "header") %>%  # puts gray background behind the header row
    autofit()
}

Para Codes

We can take a look at results from the 2020 Jimi Flowers meet, the most recent meet results hosted on the U.S. Paralympic Swimming results repository.

file <- "https://raw.githubusercontent.com/gpilgrim2670/Pilgrim_Data/master/2020_Jimi_Flowers_Results_PDF.pdf"

df <- swim_parse(read_results(file))

df %>% 
  head(10) %>% 
  flextable_style()

Place	Name	Age	Para	Team	Prelims_Time	Finals_Time	Event
1	Smith, Leanne	31	S3	US Paralympics Resident Team-CO-	44.28	42.96	Women 50 LC Meter Freestyle Multi-Class S3
2	Ramirez Martinez, Fabiola	29	S3	Jalisco-	1:13.10	1:12.17	Women 50 LC Meter Freestyle Multi-Class S3
1	Locatelli, Wendi	37	S5	Unattached-	49.00	47.73	Women 50 LC Meter Freestyle Multi-Class S5
2	Hernandez Torres, Karina Ama	25	S5	Jalisco-	53.10	54.00	Women 50 LC Meter Freestyle Multi-Class S5
3	Pareé , Cleé mence	17	S5	Unattached-CAN	54.43	57.09	Women 50 LC Meter Freestyle Multi-Class S5
1	Lomeli Santos, Nancy Nayely	23	S6	Jalisco-	40.35	41.37	Women 50 LC Meter Freestyle Multi-Class S6
2	Bravo Gonzalez, Karla France	21	S6	Jalisco-	41.30	43.03	Women 50 LC Meter Freestyle Multi-Class S6
1	Coan, McKenzie	23	S7	Cumming Waves Swim Team-GA-	32.52	33.46	Women 50 LC Meter Freestyle Multi-Class S7
2	Weggemann, Mallory	30	S7	Unattached-	33.00	34.43	Women 50 LC Meter Freestyle Multi-Class S7
3	Gaffney, Julia	19	S7	US Paralympics Resident Team-CO-	34.30	35.39	Women 50 LC Meter Freestyle Multi-Class S7

Note the addition of a new column, Para, containing paralympic classification codes parsed from the result. It’s not a big change, but those codes are literally the only difference between para and non-para swimming results.

Names

We’ve discussed names here before, specifically the “records matching” problem. It’s probably the trickiest problem in dealing with swimming results, which is the aim of SwimmeR. There aren’t any perfect solutions. Still, we’re plugging away. Version 0.9.0 contains our latest contribution to the issue.

Names in swimming results aren’t presented in a consistent format. Sometimes they’re done as Firstname Lastname (Lilly King), sometimes as Lastname, Firstname (King, Lilly). This is simple enough for athletes with only one first or last name, but imagine a swimmer named Kara Lynn Joyce. There’s no way to tell just based on the name itself if she should be Lynn Joyce, Kara or Joyce, Kara Lynn. What this means is that while there’s more information encoded in Lastname, Firstname (because the comma differentiates between Lastname, however long, and Firstname, however long) the default format must be Firstname Lastname. It’s simply not possible to rigorously convert Firstname Lastname to Lastname, Firstname based on the information available.

Enter the name_reorder function. name_reorder works on lists or whole data frames.

Lists

Passing a list to name_reorder is simpler and more general than passing a data frame, just outputting a list with the names reordered to “Firstname Lastname”.

name_examples_list <- c("Kara Lynn Joyce", "Joyce, Kara Lynn", "de Bruijn, Inge", "Inge de Bruijn", NA)

name_examples_list %>% 
  name_reorder()

## [1] "Kara Lynn Joyce" "Kara Lynn Joyce" "Inge de Bruijn"  "Inge de Bruijn" 
## [5] NA

Since columns in a data frame are really just lists this also works with dplyr functions like mutate.

name_examples_dplyr <- data.frame(Athlete = c("Kara Lynn Joyce", "Joyce, Kara Lynn", "de Bruijn, Inge", "Inge de Bruijn", NA))

name_examples_dplyr %>%
  mutate(Name = name_reorder(Athlete)) %>% 
  flextable_style()

Athlete	Name
Kara Lynn Joyce	Kara Lynn Joyce
Joyce, Kara Lynn	Kara Lynn Joyce
de Bruijn, Inge	Inge de Bruijn
Inge de Bruijn	Inge de Bruijn

Data Frames

In contrast to usage with lists using name_reorder with entire data frames has a very SwimmeR-centric flavor. When given a data frame name_reoder converts all names, in a column called “Name” (to match the output of swim_parse) to Firstname Lastname format. By default the output is a data frame with one extra column, called Name_Reorder.

name_examples_df <- data.frame(Name = c("Kara Lynn Joyce", "Joyce, Kara Lynn", "de Bruijn, Inge", "Inge de Bruijn", NA))

name_examples_df %>%
  name_reorder() %>%
  relocate(Name) %>% # want Name column first for presentation
  flextable_style()

Name	Name_Reorder
Kara Lynn Joyce	Kara Lynn Joyce
Joyce, Kara Lynn	Kara Lynn Joyce
de Bruijn, Inge	Inge de Bruijn
Inge de Bruijn	Inge de Bruijn

Setting the optional argument verbose = TRUE will add additional columns First_Name and Last_Name if extracting them is possible. This is perhaps helpful to people like me with an interest in names.

name_examples_df %>%
  name_reorder(verbose = TRUE) %>%
  relocate(Name) %>% # want Name column first for presentation
  flextable_style()

Name	Name_Reorder	First_Name	Last_Name
Kara Lynn Joyce	Kara Lynn Joyce
Joyce, Kara Lynn	Kara Lynn Joyce	Kara Lynn	Joyce
de Bruijn, Inge	Inge de Bruijn	Inge	de Bruijn
Inge de Bruijn	Inge de Bruijn

With name_reorder one can insure that a data set comprised of results from several meets will have all names in a consistent format. This is the first step in series of several planned additions to SwimmeR aimed at addressing name-related issues.

Split Distances

We’ve discussed splits before, in conjunction with the splits and splits_length arguments to swim_parse. The idea is simple: setting splits = TRUE causes splits to be collected in columns, with the column names based on splits_length. There’s a problem though when some events in a set of results have different split lengths than others. Consider the 2021 Women’s NCAA DI championships.

file <- "https://s3.amazonaws.com/sidearm.sites/gopack.com/documents/2021/3/20/2021_DI_Women_Final_Results.pdf"

DI_W_2021 <- swim_parse(read_results(file), splits = TRUE, split_length = 50)

Most of the events are split by 50, except for the 50 Yard Freestyle and 200 Yard Freestyle Relay. They’re split by 25, but the column names don’t reflect that.

DI_W_2021 %>% 
  filter(Event %in% c("Women 50 Yard Freestyle", "Women 200 Yard Freestyle Relay", "Women 200 Yard Freestyle")) %>% 
  select(Place, Team, Event, Finals_Time, Split_50:Split_400) %>% 
  group_by(Event) %>% 
  slice_head() %>% 
  flextable_style()

Place	Team	Event	Finals_Time	Split_50	Split_100	Split_150	Split_200	Split_250	Split_300	Split_350	Split_400
1	Virginia	Women 200 Yard Freestyle	1:42.35	24.13	25.60	25.91	26.71
1	California	Women 200 Yard Freestyle Relay	1:25.78	10.82	22.09	10.02	21.23	10.18	21.24	10.05	21.22
1	Virginia	Women 50 Yard Freestyle	21.13	10.33	10.80

We can fix this issue with the new correct_split_distance function. It will rename columns in the indicated events based on a new_split_length. I recognized too late that this function should really be called correct_split_length and have ahem corrected this oversight via an alias in the latest dev version of SwimmeR.

DI_W_2021 %>%
  correct_split_distance(
    new_split_length = 25,
    events = c("Women 50 Yard Freestyle", "Women 200 Yard Freestyle Relay")
  ) %>%
  filter(
    Event %in% c(
      "Women 50 Yard Freestyle",
      "Women 200 Yard Freestyle Relay",
      "Women 200 Yard Freestyle"
    )
  ) %>%
  group_by(Event) %>%
  select(
    Place,
    Team,
    Event,
    Finals_Time,
    Split_25,
    Split_50,
    Split_75,
    Split_100,
    Split_125,
    Split_150,
    Split_175,
    Split_200
  ) %>%
  slice_head() %>%
  flextable_style()

Place	Team	Event	Finals_Time	Split_25	Split_50	Split_75	Split_100	Split_125	Split_150	Split_175	Split_200
1	California	Women 200 Yard Freestyle Relay	1:25.78	10.82	22.09	10.02	21.23	10.18	21.24	10.05	21.22
1	Virginia	Women 50 Yard Freestyle	21.13	10.33	10.80
1	Virginia	Women 200 Yard Freestyle	1:42.35		24.13		25.60		25.91		26.71

In Closing

That’s it for this version of SwimmeR. Be on the lookout for some coverage of the 2021 USMS ePostal and a new version of JumpeR in the coming weeks. Until next time, thanks for joining us here at Swimming + Data Science!

Introducing JumpeR - For Track and Field Data

Tue, 23 Feb 2021 00:00:00 +0000

Ordinarily posts on Swimming + Data Science have focused on swimming, or sometimes diving. Today though we’re going to visit some of our more gravity-afflicted colleagues and do a bit of cross-training. That’s because following what I’m going to call the SwimmeR package’s massive success literally several people reached out to me regarding developing a similar package for track and field. That package, called JumpeR, is now available on CRAN.

Please not this post was updated to reflect changes contained in JumpeR v0.3.0 released November 2021

You can get your very own copy of this cutting edge sports-data-science package, for free, today!

install.packages("JumpeR")

library(JumpeR)
library(flextable)
library(dplyr)
library(ggplot2)

flextable_style <- function(x) {
  x %>%
    flextable() %>%
    bold(part = "header") %>% # bolds header
    bg(bg = "#D3D3D3", part = "header") %>%  # puts gray background behind the header row
    autofit()
}

What does JumpeR do?

JumpeR is very similar to SwimmeR. They both mostly serve to convert results from human readable documents to machine & human readable data frames in the context of the R programming environment.

Supported Results Format

JumpeR currently supports single column Hy-Tek results, like these, and Flash Results .pdf files like these. JumpeR does not support multi-column Hy-Tek results or Flash .html files. Further details are available in the package readme file.

Examples

A Running Race

Here’s an example, reading in the 2019 Ivy League Championships and looking at the finals of the Women’s 200M Dash

df <- tf_parse(
  read_results("http://www.leonetiming.com/2020/Indoor/IvyLeague/Results.htm")
  )

df %>% 
  filter(Event == "Women 200 Meter Dash") %>% 
  group_by(Name, Team) %>% # to remove prelims
  slice(2) %>% # to remove prelims
  arrange(Place) %>% # arrange by Place
  flextable_style()

Place	Name	Age	Team	Finals_Result	Tiebreaker	DQ	Event
1	Katina Martin	SO	Harvard	24.05		0	Women 200 Meter Dash
2	Olivia Okoli	JR	Harvard	24.44		0	Women 200 Meter Dash
3	Cecil Ene	SR	Penn	24.52	24.511	0	Women 200 Meter Dash
4	Elena Brown-Soler	SR	Penn	24.52	24.520	0	Women 200 Meter Dash
5	Katie DiFrancesco	JR	Princeton	24.53		0	Women 200 Meter Dash
6	Libby McMahon	SO	Yale	25.12		0	Women 200 Meter Dash
7	Isabella Hilditch	SO	Princeton	40.06		0	Women 200 Meter Dash
	Kennedy Waite	FR	Brown	DNF		1	Women 200 Meter Dash

Discus, with Flights

But wait, there’s more! Field events, like jumping and throwing, allow athletes to try several times, with each try called a “round”. Rounds can be captured as well. Here’s the Men’s Discus from the 2019 Virginia Grand Prix

df <- tf_parse(
  read_results("https://www.flashresults.com/2019_Meets/Outdoor/04-27_VirginiaGrandPrix/038-1.pdf"),
  rounds = TRUE
  )

df %>% 
  flextable_style()

Place	Name	Age	Team	Finals_Result	DQ	Event	Round_1	Round_2	Round_3	Round_4	Round_5	Round_6	Event_Date
1	Nicholas EDWARDS	FR	HAMPTON	49.86m	0	Men Discus	X	47.11	45.99	47.28	X	49.86	2019-04-27
2	Michael ALBERT	JR	APP STATE	48.30m	0	Men Discus	48.30	47.16	44.96	X	45.85	X	2019-04-27
3	Joshua HUNTER	SO	HAMPTON	47.43m	0	Men Discus	31.94	X	46.54	X	47.43	X	2019-04-27
4	Peter KENN	SR	APP STATE	46.14m	0	Men Discus	X	42.83	46.14	44.26	43.80	44.66	2019-04-27
5	Asher PRINCE	FR	CHARLOTTE	45.98m	0	Men Discus	X	45.98	44.62	X	X	X	2019-04-27
6	Sasha DAJIA	SR	CHARLOTTE	44.40m	0	Men Discus	X	44.40	44.19	X	44.08	42.04	2019-04-27
7	Britton MANN	SR	HIGH POINT	42.07m	0	Men Discus	X	38.31	X	40.49	X	42.07	2019-04-27
8	Gabriel STAINBACK	SO	HIGH POINT	39.37m	0	Men Discus	38.53	36.94	39.37	–	–	–	2019-04-27
FOUL	Kysheen MYRICK	SO	LIBERTY	FOUL	1	Men Discus	X	X	X				2019-04-27
FOUL	Tyson JONES	FR	VIRGINIA TECH	FOUL	1	Men Discus	X	X	X				2019-04-27

Pole Vault, with Rounds and Attempts

JumpeR can even capture attempts for vertical jumping events, like in these Women’s Pole Vault results from the 2019 Texas A&M Invite. These results do get quite wide, so here they’re cut off at Flight 2.

df <- tf_parse(
  read_results("https://www.flashresults.com/2019_Meets/Outdoor/04-12_TamuInvite/014-1.pdf"),
  rounds = TRUE,
  round_attempts = TRUE
  )

df %>% 
  select(Place:Round_2_Attempts) %>% 
  flextable_style()

Place	Name	Age	Team	Finals_Result	DQ	Event	Round_1	Round_1_Attempts	Round_2	Round_2_Attempts
1	Caroline BELLOWS	SR	UTSA	3.88m	0	Women Pole Vault	3.28	---	3.43	O
2	Myka STEINBEISSER	FR	ARIZONA STATE	3.73m	0	Women Pole Vault	3.28	---	3.43	O
3	Tommi HINTNAUS	SO	ARIZONA STATE	3.73m	0	Women Pole Vault	3.28	---	3.43	---
4	Erika WILLIS	FR	AIR FORCE	3.58m	0	Women Pole Vault	3.28	---	3.43	O
5	Kylie SWIEKATOWSKI	JR	RICE	3.58m	0	Women Pole Vault	3.28	---	3.43	XO
6	Cameron BOEDEKER	JR	SAM HOUSTON ST.	3.58m	0	Women Pole Vault	3.28	---	3.43	O
6	Kendahl SHUE	JR	TCU	3.58m	0	Women Pole Vault	3.28	---	3.43	---
8	Corey FRIEDENBACH	FR	AIR FORCE	3.58m	0	Women Pole Vault	3.28	---	3.43	O
9	Tysen TOWNSEND	FR	TCU	3.58m	0	Women Pole Vault	3.28	---	3.43	XXO
10	Lauren LABAY	JR	SAM HOUSTON ST.	3.43m	0	Women Pole Vault	3.28	---	3.43	O
10	Margaret LASSALLE	SR	SAM HOUSTON ST.	3.43m	0	Women Pole Vault	3.28	---	3.43	O
12	Emily HARRISON	FR	RICE	3.43m	0	Women Pole Vault	3.28	---	3.43	XXO
12	Frankie PORAMBO	FR	AIR FORCE	3.43m	0	Women Pole Vault	3.28	O	3.43	XXO
DNS	Alexandria GRAY	FR	UTSA	DNS	0	Women Pole Vault	3.28		3.43
NH	Hannah SEARBY	SO	TEXAS A&M	NH	1	Women Pole Vault	3.28	---	3.43	XXX
NH	Jerni SELF	SR	AIR FORCE	NH	1	Women Pole Vault	3.28	---	3.43	---
NH	Kathryn TOMCZAK	SR	AIR FORCE	NH	1	Women Pole Vault	3.28	---	3.43	---

Pole Vault Long Format

These results do get quite wide, but don’t worry. Switching to longer is easy as with JumpeR::attempts_split_long.

df <- tf_parse(
  read_results("https://www.flashresults.com/2019_Meets/Outdoor/04-12_TamuInvite/014-1.pdf"),
  rounds = TRUE,
  round_attempts = TRUE
  )


df %>% 
  attempts_split_long() %>% 
  filter(Place == 1) %>% # only first place athlete
  select(Place, Name, Age, Team, Finals_Result, Event, Bar_Height, Attempt, Result) %>% 
  flextable_style()

Place	Name	Age	Team	Finals_Result	Event	Bar_Height	Attempt	Result
1	Caroline BELLOWS	SR	UTSA	3.88m	Women Pole Vault	3.28	1	-
1	Caroline BELLOWS	SR	UTSA	3.88m	Women Pole Vault	3.28	2	-
1	Caroline BELLOWS	SR	UTSA	3.88m	Women Pole Vault	3.28	3	-
1	Caroline BELLOWS	SR	UTSA	3.88m	Women Pole Vault	3.43	1	O
1	Caroline BELLOWS	SR	UTSA	3.88m	Women Pole Vault	3.58	1	X
1	Caroline BELLOWS	SR	UTSA	3.88m	Women Pole Vault	3.58	2	O
1	Caroline BELLOWS	SR	UTSA	3.88m	Women Pole Vault	3.73	1	X
1	Caroline BELLOWS	SR	UTSA	3.88m	Women Pole Vault	3.73	2	O
1	Caroline BELLOWS	SR	UTSA	3.88m	Women Pole Vault	3.88	1	X
1	Caroline BELLOWS	SR	UTSA	3.88m	Women Pole Vault	3.88	2	O
1	Caroline BELLOWS	SR	UTSA	3.88m	Women Pole Vault	4.03	1	X
1	Caroline BELLOWS	SR	UTSA	3.88m	Women Pole Vault	4.03	2	X
1	Caroline BELLOWS	SR	UTSA	3.88m	Women Pole Vault	4.03	3	X

Relay Athletes

Going back to those Ivy League results, we can pull out the names relay athletes for each relay.

df <- tf_parse(
  read_results("http://www.leonetiming.com/2020/Indoor/IvyLeague/Results.htm"),
  relay_athletes = TRUE
  )

df %>% 
  filter(Event == "Men 4x400 Meter Relay") %>% 
  select(-Tiebreaker, -Name) %>% 
  flextable_style()

Place	Team	Finals_Result	Event	Relay_Athlete_1	Relay_Athlete_2	Relay_Athlete_3	Relay_Athlete_4
1	Harvard	3:13.85	Men 4x400 Meter Relay	Aaron Shirley	Gregory Lapit	Charles Lego	Jovahn Williamson
2	Penn	3:15.55	Men 4x400 Meter Relay	Robbie Ruppel	Anthony Okolo	Emerson Douds	Antaures Jackson
3	Yale	3:16.60	Men 4x400 Meter Relay	Christopher Colbert	Juma Sei	Phil Zuccaro	Marcus Woods
4	Cornell	3:17.61	Men 4x400 Meter Relay	Christian Martin	Myles Solan	Malick Diomande	Tien Henderson
5	Dartmouth	3:17.66	Men 4x400 Meter Relay	Mathieu Farber	Charlie Wade	Julian Martelly	Max Frye
6	Columbia	3:19.42	Men 4x400 Meter Relay	Chris Balthazar	Jahi Hernandez	Brodie Holmes	Vasilis Kopanas
7	Princeton	3:20.61	Men 4x400 Meter Relay	Gregory Sholars	Klaudio Gjetja	Anderson Dimon	Michael Phillippy
8	Brown	3:25.72	Men 4x400 Meter Relay	Sergey Gorban	Austin Reynolds	Kevin Boyce	Tim McDonough

Formating Results

Track and field results are of two forms. Times, as “MM:SS.HH”, and lengths/heights, often as “X.XXm”. JumpeR has math_format for converting these result strings into numerics, which is useful when doing comparisons and plotting. Here’s the men’s pole vault at the USA T&F 2019 Championships .

df <- tf_parse(
  read_results("https://www.flashresults.com/2019_Meets/Outdoor/07-25_USATF_CIS/026-1.pdf"))


df %>%
  mutate(Finals_Math = math_format(Finals_Result)) %>% # results to numerics
  mutate(Name = factor(Name, unique(Name))) %>% # order names by order of finish
  ggplot(aes(x = Name, y = Finals_Math)) +
  geom_col() +
  theme_bw() +
  theme(axis.text.x = element_text(
    angle = 90,
    vjust = 0.5,
    hjust = 1
  )) +
  labs(y = "Height Cleared (m)",
       title = "USA Pole Vault Championships")

One can use math_format on mixed format lists too. Times will be converted to seconds, meters will remain in meters, and standard units (feet, inches) will be converted to inches. Units however are not included, so be aware.

demo_list <- c(
  "1.23m", # a height/length in meters, output in meters
  "5-06.45", # a height/length in standard, output in inches
  "10:34.34", # a time with minutes, output in seconds
  "9.45" # a time without minutes, output in seconds
)

math_format(demo_list)

## [1]   1.23  66.45 634.34   9.45

JumpeR Going Forward

I plan to maintain JumpeR, fix bugs, and respond to feature requests as I’m able. Another useful improvement would be increasing the number/types of supported results. More contributors are certainly welcome. If you’d like to be involved get in touch, or visit the project repo on github.

SwimmeR version 0.7.2 - Now Better than Ever

Wed, 20 Jan 2021 00:00:00 +0000

SwimmeR version 0.7.2 is now available from CRAN. This new version contains some new features, plus a few changes to make it more user-friendly. Let me show you what I’ve been working on.

library(SwimmeR)
library(dplyr)
library(stringr)
library(flextable)
library(rbenchmark)

flextable_style <- function(x) {
  x %>%
    flextable() %>%
    bold(part = "header") %>% # bold header
    bg(bg = "#D3D3D3", part = "header") %>% # puts gray background behind the header row
    align_nottext_col(align = "center", header = TRUE, footer = TRUE) %>% # center alignment
    autofit()
}

New Features

SwimmeR can now parse S.A.M.M.S. style results. S.A.M.M.S., which stands for Swimclub And Meet Management System, was an ahem swim club and meet management system that predated Hy-Tek’s Meet and Team Manager. It seems to have been most popular in California, where it’s still used by USA Swimming clubs and high schools into the present day.

S.A.M.M.S. meets look like this:

Parsing them is a simple matter for you SwimmeR users - it’s exactly the same as parsing Hy-Tek style results. The only differences come in with respect to relay_swimmers and splits. Same read_results, same swim_parse. S.A.M.M.S. results that I’ve seen don’t include relay swimmers, so of course SwimmeR doesn’t collect them. Splits are also rarely seen in S.A.M.M.S. results and at this moment are also not collected by SwimmeR, although they may be in a future release.

df <-
  swim_parse(
    read_results(
      "http://www.pacswim.org/userfiles/meets/documents/1629/1119bac.htm"
    )
  )

df %>%
  head(5) %>%
  flextable_style()

Place	Name	Age	Team	Finals_Time	Event
1	LADOMIRAK, ALEGRIA	8	PC PALO ALTO STANFORD	16.11	EVENT 73 FEMALE 8&UN 25 FREE
2	DIEHN, EVA	8	PC BULL DOG SWIM CLUB	16.36	EVENT 73 FEMALE 8&UN 25 FREE
3	HILL, NAOMI	8	PC PALO ALTO STANFORD	16.50	EVENT 73 FEMALE 8&UN 25 FREE
4	HOUTZER, AMELIA	8	PC PALO ALTO STANFORD	16.88	EVENT 73 FEMALE 8&UN 25 FREE
5	CHANG, KAYLA	8	PC BURLINGAME AQUATIC	17.55	EVENT 73 FEMALE 8&UN 25 FREE

On a personal level working with these S.A.M.M.S. results was very encouraging, because they have all kinds of weird bugs and cut corners that make me feel better about SwimmeR. For example some S.A.M.M.S. results list a place order for finals swims, as “F1”, “F2”, etc. But S.A.M.M.S. can’t handle more than two characters in that field, so if someone comes in 10th they just get “F”.

Just “F”

S.A.M.M.S. also doesn’t know what to make of diving, and records diving results like swimming results, so “347.56” is written as “3:47.56” (swim_parse corrects this). S.A.M.M.S. also orders diving results backwards with the lowest (i.e. fastest) score/time listed first.

Maybe divers don’t mind being upside down?

S.A.M.M.S. was a commercial product. SwimmeR might have its issues sometimes, but at least it’s free!

Under the hood changes to speed up swim_parse. We can test this with benchmark from the rbenchmark package because I’ve left the old swim_parse function in SwimmeR, renamed swim_parse_old. It’s not exported though so to actually access it you’ll need to call it as SwimmeR:::swim_parse_old.

benchmark("new" = {
  swim_parse(
    read_results(
      "http://www.pacswim.org/userfiles/meets/documents/1547/nvst-results.htm"
    )
  )
},
"old" = {
  SwimmeR:::swim_parse_old(
    read_results(
      "http://www.pacswim.org/userfiles/meets/documents/1547/nvst-results.htm"
    )
  )
},
replications = 5) %>% 
  flextable_style()

test	replications	elapsed	relative	user.self	sys.self
new	5	33.62	1.000	30.67	0.06
old	5	76.72	2.282	74.16	0.09

As you can see, from the relative column above, the new version of swim_parse is a little over twice as fast as the old version (on my computer at least). You’re all very welcome.

Kinder and gentler all around. There have been several changes to make swim_parse more user friendly. First is decreased reliance on the typo and replacement arguments. They’re still present, and still work, but they’re hopefully now much less necessary.

By way of example in this meet there’s a young man named “DU Fayet DE LA Tour, Vin”.

swim_parse_old gets his name wrong.

df_old <-
  SwimmeR:::swim_parse_old(
    read_results(
      "http://www.pacswim.org/userfiles/meets/documents/1547/nvst-results.htm"
    )
  )

df_old %>%
  filter(str_detect(Name, "DU Fayet DE LA Tour") == TRUE) %>%
  select(-Points,-DQ,-Exhibition) %>%
  flextable_style()

Place	Name	Age	Team	Prelims_Time	Finals_Time	Event
13	DU Fayet DE LA Tour	14	NBA-PC	1:02.09	1:00.08	Boys 13-14 100 Yard Freestyle
12	DU Fayet DE LA Tour	14	NBA-PC	1:20.75	1:09.03	Boys 13-14 100 Yard Backstroke
14	DU Fayet DE LA Tour	14	NBA-PC	1:16.16	1:10.01	Boys 13-14 100 Yard Butterfly
16	DU Fayet DE LA Tour	14	NBA-PC	2:50.00	2:35.25	Boys 13-14 200 Yard IM

We can fix the problem in a hacky, and non-intuitive kind of way using typo and replacement, plus some after the parse changes. It works, but it’s not terribly easy.

df_old_tr <-
  SwimmeR:::swim_parse_old(
    read_results(
      "http://www.pacswim.org/userfiles/meets/documents/1547/nvst-results.htm"
    ),
    typo = ", Vin ",
    replacement = " Vin  "
  ) %>%
  mutate(Name = str_replace(Name, " Vin", ", Vin"))

df_old_tr %>%
  filter(str_detect(Name, "DU Fayet DE LA Tour") == TRUE) %>%
  select(-Points, -DQ, -Exhibition) %>%
  flextable_style()

Place	Name	Age	Team	Prelims_Time	Finals_Time	Event
13	DU Fayet DE LA Tour, Vin	14	NBA-PC	1:02.09	1:00.08	Boys 13-14 100 Yard Freestyle
12	DU Fayet DE LA Tour, Vin	14	NBA-PC	1:20.75	1:09.03	Boys 13-14 100 Yard Backstroke
14	DU Fayet DE LA Tour, Vin	14	NBA-PC	1:16.16	1:10.01	Boys 13-14 100 Yard Butterfly
16	DU Fayet DE LA Tour, Vin	14	NBA-PC	2:50.00	2:35.25	Boys 13-14 200 Yard IM

Compare that to the much simpler approach available in swimmeR version 0.7.2. - no need for typo & replacement, and no need to after-parse fixes to Vin’s name.

df_new <-
  swim_parse(
    read_results(
      "http://www.pacswim.org/userfiles/meets/documents/1547/nvst-results.htm"
    )
  )

df_new %>%
  filter(str_detect(Name, "DU Fayet DE LA Tour") == TRUE) %>%
  select(-DQ, -Exhibition) %>%
  flextable_style()

Place	Name	Age	Team	Prelims_Time	Finals_Time	Event
13	DU Fayet DE LA Tour, Vin	14	NBA-PC	1:02.09	1:00.08	Boys 13-14 100 Yard Freestyle
12	DU Fayet DE LA Tour, Vin	14	NBA-PC	1:20.75	1:09.03	Boys 13-14 100 Yard Backstroke
14	DU Fayet DE LA Tour, Vin	14	NBA-PC	1:16.16	1:10.01	Boys 13-14 100 Yard Butterfly
16	DU Fayet DE LA Tour, Vin	14	NBA-PC	2:50.00	2:35.25	Boys 13-14 200 Yard IM

This is not a promise that there will be no need for typo and replacement. Sometimes there really are typos that need replacing. Things should be easier now though.

Second - event names were also an issue in older versions of SwimmeR. If swim_parse didn’t find any event names it liked it would throw an error and return nothing. Now, in SwimmeR version 0.7.2 the event name definitions are much broader, and failing to find any event names will not result in an error.

These results, from the 2019 Australian Nationals won’t read in previous version of SwimmeR because the events are named with “Metre” rather than “Meter”. Now though, with SwimmeR version 0.7.2 we can see the Campbell sisters doing their thing.

df_aus <-
  swim_parse(
    read_results(
      "https://www.swimming.org.au/sites/default/files/assets/documents/full%20results_0.pdf"
    )
  )

df_aus %>%
  head(2) %>%
  flextable_style()

Place	Name	Para	Age	Team	Prelims_Time	Finals_Time	Points	DQ	Exhibition	Event
1	CAMPBELL, CATE		27	KNOX PYMBLE	24.33	24.05	953	0	0	Women 50 LC Metre Freestyle
2	CAMPBELL, BRONTE		25	KNOX PYMBLE	24.60	24.17	939	0	0	Women 50 LC Metre Freestyle

Modifications to swim_parse to begin to handle older style Hy-Tek results, like these from 2002. Issues with inconstant treatment of splits within the results themselves remain, so let the user beware. These older results are still an active area of development.

df_2002 <-
  swim_parse(
    read_results(
      "https://cdn.swimswam.com/wp-content/uploads/2018/08/2002-Division-I-NCAA-Championships-Men-results1.pdf"
    )
  )

df_2002 %>%
  filter(str_detect(Event, "100 Yard BUTTERFLY")) %>%
  head(3) %>%
  flextable_style()

Place	Name	Age	Team	Prelims_Time	Finals_Time	Event
1	CROCKER, IAN	SO	TEXAS	45.70	45.44	Event 9 MEN's 100 Yard BUTTERFLY
2	MARSHALL, PETER	SO	STANFORD	46.39	46.48	Event 9 MEN's 100 Yard BUTTERFLY
3	SCHOEMAN, ROLAND	SR	ARIZONA	46.57	46.50	Event 9 MEN's 100 Yard BUTTERFLY

Bug fixes, always bug fixes.

In Closing

Please do download the newest version of SwimmeR from wherever you get your packages. You’re also welcome to submit bug reports or feature requests on the SwimmeR project github page.

COVID Impacts in Swimming Results?

Thu, 10 Dec 2020 00:00:00 +0000

As you may have heard there’s a global pandemic going on. One of the more minor impacts of that pandemic has been the disruption of athletics, including swimming. In this post we’re going to compare results from the New York State Section V girls championship meets conducted in Fall 2020 to the same meets conducted in years past. Since the NYS championships are canceled Sectionals are the culmination of the high school season in NY, a season conducted under COVID restrictions. For those of you unaware, Section V is in western NY, seated in Rochester. I’ve drawn a map of where that is in this post.

We’re going to do a case study, with the goal of answering two questions:

Were the 2020 results different from other years?
If so, in what way, re: performances, where they different?

library(SwimmeR)
library(rvest)
library(purrr)
library(dplyr)
library(ggplot2)
library(stringr)
library(flextable)

flextable_style <- function(x) {
  x %>%
    flextable() %>%
    bold(part = "header") %>% # bolds header
    bg(bg = "#D3D3D3", part = "header") %>%  # puts gray background behind the header row
    autofit()
}

Web Scraping to Get Results

As we often do around here we’re going to scrape a bunch of swim meets from some online repository. The strategy here is roughly the same as in my previous post about webscraping with SwimmeR.

We’ll get out target link (sec_v_link), and css node (".xspLinkViewColumn") and then use html_nodes and html_attr to get a list of links. We’ll then cut that list down to what we want with by using map_lgl to apply str_detect across it.

sec_v_link <-
  "http://www.swimdata.info/NYState/MeetResultsRepository.nsf/Sec5Girls.xsp"

page_contents <- read_html(sec_v_link)

links <-
  html_attr(html_nodes(page_contents, ".xspLinkViewColumn"), "href")

sectional_links <- links %>%
    .[map_lgl(., str_detect, "http")] %>%
    .[map_lgl(., str_detect, "Meet")] %>%
    .[map_lgl(., str_detect, "Sec5")] %>%
    .[!map_lgl(., str_detect, "nyhsswim")] %>% 
    .[!map_lgl(., str_detect, "\\.zip")] %>%
    .[!map_lgl(., str_detect, "\\.nsf")]

The 2020 results aren’t included in our scraped results (they must not have been added to the repository yet). We can add them to our list manually.

links_2020 <-
  c(
    "http://www.section5swim.com/Results/GirlsHS/2020/Sec5/C/Single.htm",
    "http://www.section5swim.com/Results/GirlsHS/2020/Sec5/B/Single.htm",
    "http://www.section5swim.com/Results/GirlsHS/2020/Sec5/A/Single.htm"
  )

sectional_links <- c(sectional_links, links_2020)

Now we just need to map our SwimmeR functions over the list of links. First read_results to read in the raw files, and then swim_parse to parse them. We’ll do this inside of safely in case there are bad links (there aren’t, but still) and discard problematic imports with discard_errors.

Running this code will take a while. You can also download the results directly from my github.

results_raw <- map(sectional_links, read_results)
results <- map(results_raw, safely(swim_parse, otherwise = NA))

results <- SwimmeR:::discard_errors(results)

We can name each file based on its link, and stick them all together into one dataframe with bind_rows.

meet_names <- sectional_links %>% 
  str_extract("\\d{4}/Sec5/[:upper:]") %>%
  str_replace("/Sec5/", "_")

names(results) <- meet_names

results <- dplyr::bind_rows(results_2, .id = "Meet")

Cleaning Up the Data

We’d like to separate the Meet column into two pieces of information, which means two columns. The first is the Year in which the meet took place - pretty simple. The second is we’ll Class, which is the term used by Section V to denote the size of the schools competing at a given meet. Class A schools are the largest, with Class B being smaller, and Class C being the smallest. This means that we’re usually looking at three meets per year, over 21 years, for a total of 63 meets. The reality though is that there’s only 60 meets because in three separate years (2000, 2001 and 2016) Section V attempted to realign the classes and have only two meets, Class A and Class B. This meant that in those years the larger Class B schools went up to Class A and all of the Class C schools ended up in Class B.

results <- results %>% 
  filter(str_detect(Event, "Swim\\-off") == FALSE) %>% # remove swim offs
  mutate(Year = as.numeric(str_extract(Meet, "\\d{4}")), # get meet year
         Class = str_extract(Meet, "[:upper:]")) %>% # get meet class
  mutate(Finals_Sec = sec_format(Finals_Time)) %>% # convert finals time to seconds format for doing math
  mutate(Event = str_remove(Event, "Girls "), # shortening event names for easier plotting
         Event = str_remove(Event, "style")) # shortening event names for easier plotting

Top 8 Times

The variable I want to look at is the average time for all swimmers in the top 8 of a given event at a given meet for each year. Looking at individual times is just too noisy. Sometimes athletes have especially good (or bad) meets, different people taper for different meets, seniors graduate, it’s too much noise. The top 8 though is a reasonable metric for what’s going on in an event though.

I’m going to exclude diving from this analysis, not because it can’t apply, but because diving results are much much noisier than swimming results, which makes plotting a pain.

results_summary <- results %>% 
  group_by(Class, Event, Year) %>%
  filter(Place <= 8) %>% # get top 8 finishers
  summarise(Top_8_Avg = round(mean(Finals_Sec, na.rm = TRUE), 2)) # calcuate average time of top 8 swims

Just to see what we’ve got, let’s look at all four 100 yard races.

results_summary %>%
  filter(str_detect(Event, 'Div') == FALSE) %>% # don't want to include diving
  filter(str_detect(Event, "100") == TRUE) %>% # only want 100s
  ggplot(aes(x = Year, y = Top_8_Avg, color = Class)) +
  geom_point() +
  geom_line() +
  facet_wrap(. ~ Event) +
  theme_bw() +
  labs(y = "Average Top 8 Time (s)",
       title = "Average Top 8 Time Trend by Event - 100s")

Times for these races look to maybe trend down, i.e. swimmers are getting faster and faster. The trend, if it even actually exists, certainly isn’t monotonic. It’s noisy and maybe imaginary. Let’s calculate the percent change year to year, for each event and class.

Percent change will also allow us to directly compare events of different lengths, where comparing absolute times won’t, because longer races just naturally take longer more time to complete.

results_summary <- results_summary %>%
  group_by(Event, Class) %>%
  arrange(Year, .by_group = TRUE) %>% # arrange by year within group
  mutate(Perc_Change = round((Top_8_Avg - lag(Top_8_Avg, default = NA)) / # calculate year-to-year percentage change
                               Top_8_Avg * 100, 2)) %>%
  mutate(Perc_Change = case_when(str_detect(Event, "Diving") ~ Perc_Change * -1, # in case someone wants to include diving
                                 TRUE ~ Perc_Change))

results_summary %>%
  filter(str_detect(Event, 'Div') == FALSE) %>% # don't want diving
  ggplot(aes(x = Year, y = Perc_Change, color = Class)) +
  geom_point() +
  geom_line() +
  facet_wrap(. ~ Event) +
  theme_bw() +
  theme(axis.text.x = element_text(angle = 70, hjust = 1)) +
  labs(y = "Year-To-Year Percentage Change (%)",
       title = "Percent Change in Average Top 8 Time Trend by Event")

It’s not super clear, but it looks to me like there’s a percentage increase in times in 2020. Let’s look at some actual numbers and get some clarity.

results_summary <- results_summary %>%
  mutate(Direction = case_when(Perc_Change > 0 ~ 1, # get directions of changes (not magnitudes)
                               Perc_Change <= 0 ~ -1))

results_summary %>% 
  filter(str_detect(Event, "Diving") == FALSE) %>% # don't want diving
  filter(Year < 2020) %>% # don't want year 2020 results (setting baseline)
  ungroup() %>%
  summarise(Perc_Mean = round(mean(Perc_Change, na.rm = TRUE), 2)) %>% # average year-to-year change for entire data set
  flextable_style()

Average change per year is -0.08%, meaning that on average the top 8 swimmers get ever so slightly faster year to year. We were right that there was an overall negative trend to those plots. It is small though.

Directions

Let’s put aside magnitude for a moment and just consider the sign on Perc_Change. If the sign is negative that means the top 8 swimmers in a given event/meet/year combination were faster on average than the top 8 swimmers from that same event/meet the previous year. If the sign is positive then the reverse is true, the top 8 swimmers got slower on average compared to the previous year. It’s also possible that Perc_Change could be zero, although that doesn’t happen in this data set. We’ll treat the possibility though by including zero with the positives, because if you’re not improving then what are you doing?

results_odds <- results_summary %>%
  filter(str_detect(Event, "Diving") == FALSE) %>% # don't want diving
  filter(Year < 2020) %>%  # don't want year 2020 results
  group_by(Event, Class) %>% 
  summarise(Decline = sum(Perc_Change >= 0, na.rm = TRUE), # get number of declines (worse times year-to-year)
            Improvement = sum(Perc_Change < 0, na.rm = TRUE)) %>% # get number of improvements (better times year-to-year)
  mutate(Perc_Decline = Decline/(Improvement + Decline) * 100, # percentage of declines
         Perc_Improvement = Improvement/(Improvement + Decline) * 100) # percentage of improvements

What we’ve calculated here is the rates at which the top 8 swimmers in each event of each meet are faster (negative sign, Improvement) or slower (positive sign, Decline) than the top 8 swimmers from that same meet and event the previous year. We could compare the 2020 results to these probabilities, but that actually wouldn’t be very interesting. All the probabilities are about 50/50, and there’s only one 2020 result for each meet/event combination. Either outcome, improvement or decline, for the 2020 results overall would make sense given a 50/50 probability.

What we need to do instead is get an overall probability for a improvement or decline outcome, and then compare the 33 meet/event outcomes from 2020 to that probability. (This is admittedly a bit sneaky, and there might be other, better, ways to handle it. Leave comments with your own approaches if you feel so moved.)

results_odds_pre2020 <- results_odds %>% 
  ungroup() %>% 
  summarise(Perc_Decline = round(mean(Perc_Decline), 2), # overall percent decline
            Perc_Improvement = round(mean(Perc_Improvement), 2)) # overall percent improvement

results_odds_pre2020 %>% 
  flextable_style()

Here’s something interesting - although year-to-year change is an ever-so-slight improvement, the overall probability of a improved result (that is, a collective improvement of the top 8 swimmers in a meet) is actually less than that of a declining result. I suspect the reason for this is that improved results are driven by exceptional swimmers in the first few places, who effectively improve the top 8 average by a wide margin. Those swimmers only come along occasionally, but when they do their impacts are significantly. I’m not going to attempt to demonstrate this today, but it could be done with this data set. (Also, I might be wrong. Stranger things have happened.)

In any case what we have here, for years 2000-2019 is basically a coin flip. We expect that the top 8 swimmers in an average event in given meet will be faster than the year previous 47.8% of the time, and slower 52.2% of the time.

Let’s see what happened in 2020.

results_2020_odds <- results_summary %>%
  filter(str_detect(Event, "Diving") == FALSE) %>% # don't want diving
  filter(Year == 2020) %>% # want results from 2020
  ungroup() %>% 
  summarise(Decline = sum(Perc_Change >= 0, na.rm = TRUE), # how many declines in 2020
            Improvement = sum(Perc_Change < 0, na.rm = TRUE)) # how many improvements in 2020

results_2020_odds %>% 
  flextable_style()

That’s 31 declines and 2 improvements. This looks suspicious, given that we expect declines and improvements to occur at about the same rate. We can check our suspicion using prop.test, which we previously used during the State-Off to see if seniors really do rule.

We need to state a formal null hypothesis to use prop.test, which in this case is “the results from 2020 match those from previous years in that the likelihood of the top 8 swimmers from in a given meet/event from 2020 being collectively slower than the top 8 swimmers from from that same meet/event in 2019 is 0.522”. We also need a significance value, for which we’ll use the standard 0.05. If the p-value from prop.test is less than our significance value then we can reject the null hypothesis.

prop.test(x = results_2020_odds$Decline[1], n = sum(results_2020_odds$Decline, results_2020_odds$Improvement), p = results_odds_pre2020$Perc_Decline[1]/100) # print prop test results

## 
##  1-sample proportions test with continuity correction
## 
## data:  results_2020_odds$Decline[1] out of sum(results_2020_odds$Decline, results_2020_odds$Improvement), null probability results_odds_pre2020$Perc_Decline[1]/100
## X-squared = 26.336, df = 1, p-value = 2.868e-07
## alternative hypothesis: true p is not equal to 0.478
## 95 percent confidence interval:
##  0.7837902 0.9894327
## sample estimates:
##         p 
## 0.9393939

The p-value from out test is 2.868239410^{-7}, which is much less than 0.05, so we reject the null hypothesis. Something is different about the behavior of the average top 8 times in 2020 versus the previous years.

We should check the rest of the years too though.

results_pval_allyears <- results_summary %>%
  filter(str_detect(Event, "Diving") == FALSE) %>% # don't want diving
  filter(Year > 2000) %>% # year 2000 doesn't have a previous year, so no values
  group_by(Year) %>% 
  summarise(Decline = sum(Perc_Change >= 0, na.rm = TRUE), # total declines
            Improvement = sum(Perc_Change < 0, na.rm = TRUE), # total improvements
            Total = sum(Improvement, Decline), # total events
            P = 0.522) %>% # calculated above
  rowwise() %>% # need to do next calcuation across rows not dnow columns
  mutate(P_Val = round(prop.test(x = Decline, n = Total, p = P)$p.value, 3)) # get the p-value for every year

row_id_fail_to_reject <- # values where P_Val is greater or equal to than the significance value, should be green, fail to reject null hypothesis
  with(results_pval_allyears, round(P_Val, 2) >= 0.05)

row_id_reject <- # values where P_Val is less than the significance value, should be red, reject null hypothesis
  with(results_pval_allyears, round(P_Val, 2) < 0.05)

col_id <- c("P_Val") # which column to change background color in

results_pval_allyears %>%
  select(-P) %>% 
  flextable_style() %>%
  bg(i = row_id_fail_to_reject, # color rows with p-value >= 0.05 green
     j = col_id,
     bg = "green",
     part = "body") %>%
  bg(i = row_id_reject, # color rows with p-value < 0.05 red
     j = col_id,
     bg = "red",
     part = "body") %>%
  colformat_num(j = "P_Val",
                big.mark = ",",
                digits = 3) %>%
  autofit()

What we’re seeing is that while yes, 2020 was a weird year, with the biggest discrepancy between improvement and decline in the top 8 results in the data set, 2018 was also a weird year. I don’t know why that’s the case, but it is.

We can look at the total change in Perc_Change across all meet/events for a given year to get a magnitude for weirdness.

results_summary %>%
  filter(str_detect(Event, "Diving") == FALSE, # don't want diving
         Year %!in% c(2000, 2001, 2016)) %>% # these years are different, no Class C meet
  group_by(Year) %>% 
  summarise(Total_Perc_Change = sum(Perc_Change, na.rm =TRUE), # add up all Perc_Changes
            Avg_Perc_Change_Per_Event = round(Total_Perc_Change/33, 2)) %>% # 33 is number of events across the three class meets
  flextable_style()

While 2018 remains a strange year, the total percentage change in average top 8 time for 2020 is more than three times larger than that for 2018. 2020 is ~3x weirder than 2018, compared to the other years. 2020 also has, specifically, an increase in time, meaning a decline in performance. This is doubly bad. The NYS championships being canceled means this is the last meet for the high school season, so maybe more people would have tapered for it (I don’t know what the USA season holds, maybe there are worthy taper meets there).

Answering Our Questions

At the beginning of the post I asked these two questions:

Were the 2020 results different from other years?
If so, in what way, re: performances, where they different?

Regarding question #1 - yes, 2020 was different.

Regarding question #2 - The meet normally operates close to equilibrium, with the average top 8 time changing less than 1% year to year. Times go up and down around this equilibrium, going up just over 50% of the time, and down just under 50%. Downward movements though are of a slightly larger magnitude, meaning that overall the meets get slightly faster with time. Not in 2020 though. We saw that the roughly 50/50 split between times improving and backsliding did not hold for 2020. Similarly we saw that the average top 8 time increased (got worse) by over 3%, more than 3x the normal.

Is It COVID?

Maybe. We can’t say with this analysis. What we’ve done here is effectively drawn a correlation between COVID, which was in effect in 2020 but in no other years, and especially strange results that also occurred in 2020. What we can’t say is that COVID caused the strangeness. Clearly there are variables other than COVID, like whatever went on in 2018, that could also cause strange results. This analysis doesn’t control for any of those variables. We don’t even know what they are. So while at a high level what we’ve seen in our analysis makes sense with what we might expect the impacts of COVID/COVID restrictions on a swim meet or season to be (times get slower versus previous years) we CANNOT say for sure that COVID/COVID restrictions are the cause. We can’t say anything is the cause, this just isn’t that kind of experiment.

We do know, based on reporting from the Democrat and Chronicle, that COVID caused limited off-season workouts, limited access to pools, changes to rest in the meet itself, all sorts of things that as subject matter experts in the sport of swimming we can say would hurt performances.

So is it impacts of COVID/COVID restrictions? From the data, we can’t say. From our swimming expertise though, yeah, it is.

This is how I generally use data - not in a vacuum, but in combination with subject matter expertise. Here the data is probably overkill, no one from the swimming world is likely surprised that this season was slower than previous ones. The point of this exercise isn’t to prove a surprising point, it’s to demonstrate how to do the exercise.

In Closing

Once again, thanks for tuning in to another case study here at Swimming + Data Science. We hope to see you next time, when we’ll be doing something else.

Dataset of All ISL Results Season 1 and 2

Tue, 01 Dec 2020 00:00:00 +0000

The second ISL season wrapped up a couple of weeks ago, meaning that now we’re in the off-season. I loved watching the CBC’s coverage of the ISL. The races were exciting, the swimmers seemed like they were having a great time, they were absolutely swimming great times. My other sporting love is the NBA and I massively enjoyed the games in the Orlando bubble, but I never for a second wished I was down at Disney World seeing them in person. The ISL Budapest bubble though - man did I ever want to be there.

In lieu of being on deck though I stayed home and worked on the ISL-centric features of SwimmeR, namely the swim_parse_ISL function. I’m doing this because I love swimming and I want it to thrive and I want the ISL to succeed. SwimmeR is my tiny contribution to that effort. I’m skeptical though, skeptical about the viability of a professional swimming league, and skeptical about this particular incarnation of such a league.

One area that helps a sporting league make money and sustain itself is being able to drive interest even during the off-season. The NBA is great about this, especially over the last few years, as many articles have noted. Within the swimming world the importance of driving interest year round is recognized as well, as, Torrey Hart recent discussed with Mel Stewart, following her article on the business of the ISL. One of the things that makes the NBA work so well in the off-season is all the trades and salary cap machinations and the associated analytics. People love that stuff and they pay attention to it.

My original plan for this post was to do a bit of web scrapping using swim_parse_ISL to build data sets of all the International Swimming League results in the two year history of the league. Then I was going to put on my best Zach Lowe disguise to do some slick analytics on that data and make some trenchant points about roster construction for each team. I’m still going to do the first part, building the data set for all of you. The second part though, about the analytics, is premature.

I have a theory about sports analytics: they basically operate in the margins. It’s not a terribly revolutionary theory, in fact I suspect most analytics aficionados would agree. Lets examine what what means though in the context of two different leagues, the National Basketball Association (NBA) and the International Swimming League (ISL).

There are two relevant characteristics of the NBA with respect to analytics. One is the totality of the NBA. All, or very nearly all eligible players who are known, or even thought to be capable of contributing to an NBA team are already on NBA rosters. Yes there’s the occasional Sergio Llull who decides to play at a high level in other leagues, and there are plenty of guys who are talented by struggle with the professionalism the NBA requires, but it wouldn’t be possible to assemble a competitive NBA roster from eligible players not in the league. So the thinking goes at least. NBA front offices, and their analytics departments, spend their time looking for players that other teams don’t think can make it, but actually can - the Duncan Robinsons and Fred VanVleets of the world. The difference between the consensus about Robinson (can’t play in the league) and the reality (can excel in the league) is the margin in which the Miami Heat front office is operating. Some strong analytics can make that margin bigger - that’s the goal.

The situation in the ISL is quite different. A very plausible plan for any ISL team looking to improve is to sign Simone Manuel, Olympic and world champs gold medalist in the 100 freestyle, or Xu Jiayu, 100 backstroke world championships gold medalist, or any of of the many other top flight swimmers who have never swam in the ISL. Heck since the ISL swimmers don’t have contracts like NBA players, just do what London Roar GM Rob Woodhouse suggested on the championship broadcast and sign Caeleb Dressel away from the Condors - that would be great for any team. Tinkering with season 3 roster spots for potential or fringe contributors, just doesn’t make sense until we know what top level talent is doing.

The second key difference between the NBA and ISL is the salary cap structure. The NBA cap is extremely complex, but for our purposes it’s enough to say that there’s a limit to the total salary that each team is allowed to pay its players. Since individual players would like to be paid as much as possible this sets up a market, where teams will offer players different salaries, and the player will chose to play for the team that offers him the largest one. (I realize in practice this doesn’t exactly happen, but stick with me.) Teams, and their analytics departments aren’t trying to determine if a player is good or not, so much as they’re trying to determine how good a player is in relation to his market value. Determining that a player is worth a 10 million dollar/year salary and then paying him that 10 million dollars/year salary isn’t a win for an analytics department. A win is getting a 10 mil/year worth of value from a player for less than 10 mil/year - the difference between value and salary is the margin. The salary cap also means that NBA teams can’t just go and sign a full roster of A-list players. Those players want the big salaries that they earn with their excellent play, and teams are only allowed to pay out so much salary.

ISL athletes aren’t paid in the same way though, and there’s no cap. There’s nothing to prevent the reigning champion Condors from signing more awesome swimmers, and they don’t have to worry about exactly how to value a Simone Manual-level addition, they just need to know if she’s better than whoever is in their last roster spot. It’s a much simpler decision.

The ISL isn’t ready yet for the kind of analytics in use in the NBA. It’s not needed. If you’re a ISL GM what you can do to improve your team over the off-season is just find the fastest swimmers available and get them to join. No special insights are required to identify them - their medals are easy tell. Once all that’s sorted though - then maybe some analytics in the margins.

On a larger level, the uncertainty about the ISL, about what Season 3 will look like, and frankly when and if it will happen is what makes off-season coverage so difficult and makes it difficult to sustain excitement. I watched the excellent championship match, with all of its close races and world records and fantastic performances and when it was over I wasn’t sure it would ever happen again. I’m still not, but I am hopeful.

Okay, R people - you’ve waited very patiently - here’s how we’re going to put together the ISL data sets.

Web Scraping

library(SwimmeR)
library(rvest)
library(stringr)
library(dplyr)
library(purrr)
library(ggplot2)

ISL releases their results as .pdf files, and I’ve collected all of those files on github.

The process here is about the same as in my previous web-scraping post.

Get web address for where the stuff of interest is
Identify CSS for the stuff
Make list of links to the stuff with rvest functions html_nodes and html_attr
Clean up list of links
Use SwimmeR functions to grab contents of list

We’ll start with season 2, since it’s the most recent one. Season 1 will be handled later with the same methods.

The web address is easy, just copy it out of your browser window.

# Part 1 - web address
web_url_season_2 <- "https://github.com/gpilgrim2670/Pilgrim_Data/tree/master/ISL/Season_2_2020"

CSS can be a bit more complicated, but some clicking around with the selector gadget got me what we need.

# Part 2 - CSS
selector <- ".js-navigation-open"

Now for rvest. We’ll use read_html to get the contents of web_url_season_2 and then html_attr and html_nodes to get those contents which are links.

# Part 3 - rvest fun
page_contents <- read_html(web_url_season_2)
links_season_2 <- html_attr(html_nodes(page_contents, selector), "href")
web_url_season_2 <- "https://github.com/gpilgrim2670/Pilgrim_Data/tree/master/ISL/Season_2_2020"
head(links_season_2, 10)

##  [1] ""                                                                                            
##  [2] ""                                                                                            
##  [3] ""                                                                                            
##  [4] ""                                                                                            
##  [5] "/gpilgrim2670/Pilgrim_Data/tree/master/ISL"                                                  
##  [6] "/gpilgrim2670/Pilgrim_Data/blob/master/ISL/Season_2_2020/ISL%202020%20Season%202%20Notes.txt"
##  [7] "/gpilgrim2670/Pilgrim_Data/blob/master/ISL/Season_2_2020/ISL_01112020_Budapest_Match_6.pdf"  
##  [8] "/gpilgrim2670/Pilgrim_Data/blob/master/ISL/Season_2_2020/ISL_05112020_Budapest_Match_7.pdf"  
##  [9] "/gpilgrim2670/Pilgrim_Data/blob/master/ISL/Season_2_2020/ISL_05112020_Budapest_Match_8.pdf"  
## [10] "/gpilgrim2670/Pilgrim_Data/blob/master/ISL/Season_2_2020/ISL_09112020_Budapest_Match_10.pdf"

The first 5 elements (R indexes start at 1) I don’t want. Maybe if I was better at CSS selectors I could have avoided them outright, but I didn’t. I’ll just get rid of them here. The links are also partials, missing their beginnings, so we’ll add “http://github.com” to the beginning of each with paste0. We’ll also need to change “blob” to “raw” so that we just get the .pdfs, rather than the .pdfs and a github landing page. Little github trick there.

# Part 4 - cleaning
links_season_2 <- links_season_2[7:19] # only want links 7-19
links_season_2 <- paste0("https://github.com", links_season_2) # add beginning to link
links_season_2 <- str_replace(links_season_2, "blob", "raw") # replace blob with raw

Now it’s just up to SwimmeR, with a bit of help from purrr. We’ll use read_results inside of map to read in all of the elements of links_season_2. Then we’ll map again, to apply swim_parse_ISL, inside of safely to all the results we read in. We’ll also set splits = TRUE and relay_swimmers = TRUE to capture both splits and relay swimmers. After that we’ll name each of our results based on their source link and then stick them all together with bind_rows.

# Part 5 - deploy SwimmeR
season_2 <- map(links_season_2, read_results)
season_2_parse <- map(season_2, safely(swim_parse_ISL, otherwise = NA), splits = TRUE, relay_swimmers = TRUE)
names(season_2_parse) <- str_split_fixed(links_season_2, "/", n = 10)[, 10]
season_2_parse <- SwimmeR:::discard_errors(season_2_parse)
season_2_df <- bind_rows(season_2_parse, .id = "ID")

A Season 2 Demo

Just to show you what we’ve got in this data set here’s a little exercise to get the major contributors to each team’s point total. Since the ISL is focusing on points and contributing to one’s team rather than times we’ll do the same.

season_2_df <- season_2_df %>% 
  mutate(ID = str_remove(ID, "\\.pdf\\.result")) %>% 
  mutate(Start_Date = as.Date(str_split_fixed(ID, "_", 4)[, 2], format = "%d%m%Y")) %>% 
  mutate(Match = str_split_fixed(ID, "_", 4)[, 4]) %>% 
  mutate(Season = 2) %>% 
  arrange(Start_Date) %>% 
  select(-ID)

ISL teams have 28 swimmers eligible for individual events. If they all contributed equally to the team score then each would account for about 3.5% of the total. That doesn’t happen though, most teams have a few athletes who score most of the points, and the rest are what Shaquille O’Neal refers to as “others” - role players who contribute in different ways. We’re going to name all the athletes who scored more than 7% of their team’s total as the major contributors - those athletes are worth twice their share of points.

What we’ll do here is collect all athletes scoring less than 7% of their team’s total points as “Other” and look at the breakdown for each team. This is also useful because trying to differentiate 28 different colors or point shapes or whatever on a plot, one for each athlete, is real pain.

First we’ll sum up each team’s total score. Mind you some teams competed in the post season and some did not. Teams that participated in the Semis and Championships had the most opportunity to earn points. By dividing each athlete’s total by their team’s total we’re removing this effect. It’s still worth noting though that an athlete scoring 15% of the league leading California Condors’ points has scored a lot more points than another athlete who scored 15% of the league trailing DC Trident.

team_scores <- season_2_df %>% 
  filter(is.na(Name) == FALSE) %>% 
  group_by(Team) %>% 
  summarise(Team_Score = sum(Points, na.rm = TRUE)) # score for each team

Now we need the total scores for each swimmer as a percentage of their team’s total score.

individual_scores <- season_2_df %>%
  filter(is.na(Name) == FALSE) %>%
  group_by(Name) %>%
  summarise(
    Score = sum(Points, na.rm = TRUE), # score for each athlete
    Team = unique(Team)
  ) %>%
  group_by(Team) %>%
  left_join(team_scores) %>% # get team scores
  mutate(Score_Perc = 100 * round(Score/Team_Score, 5)) %>% # calculate percentage of team score for each athlete
  mutate(Name = case_when(Score_Perc < 7 ~ "Other", # rename athletes with less than 7% as other
                          TRUE ~ Name)) %>% 
  group_by(Name, Team) %>% 
  summarise(Score = sum(Score, na.rm = TRUE), # collect all "others" together
            Score_Perc = sum(Score_Perc)) %>%
  group_by(Team) %>% 
  mutate(Score_Rank = rank(desc(Score_Perc))) # get numeric rank for each athlete and other in terms of their percent of the total team score

Here’s the Condors. Four swimmers scored almost 50% of their points, including our favorite, the undefeated queen of ISL 100 breaststroke, Lilly King!

individual_scores %>%
  filter(Team == "CAC") %>% # just want cali condors
  arrange(Score_Perc) %>%
  mutate(Name = factor(Name, unique(Name))) %>% # order athlete names by sore_perc
  ggplot(aes(
    x = "",
    y = Score_Perc,
    fill = Name,
    label = paste0(round(Score_Perc, 2), "%") # put score_perc values in plot
  )) +
  geom_bar(width = 1, stat = "identity") +
  geom_text(size = 4, position = position_stack(vjust = 0.5)) +
  theme_bw() +
  theme(axis.text.x = element_blank(),
        axis.title.x = element_blank()) +
  labs(title = "California Condors",
       y = "Percentage of Total Team Score")

Pie charts aren’t terribly well loved in the data-vis community. They’re fairly panned as being hard to get values off of, and the colors can make them difficult to read. Pie charts are pretty though - they look like flowers. Just look at this, ten pretty, pretty data flowers, one for each team.

individual_scores %>% 
  ggplot(aes(x = "", y = Score_Perc, fill = as.factor(Score_Rank))) +
  geom_bar(width = 1, stat = "identity") +
  coord_polar("y", start = 0) + # converts bar chart into pie chart
  scale_fill_discrete(name = "Point Source", labels = c("Other", "#1 Swimmer", "#2 Swimmer", "#3 Swimmer", "#4 Swimmer", "#5 Swimmer")) + # labels for colors
  facet_wrap(. ~ Team) + # one plot per team
  theme_void() +
  theme(axis.text.x = element_blank()) +
        # legend.position = "none") +
  labs(title = "ISL Season 2")

We can convey a similar point with a chart like this - the percent of each team’s points scored by their top (non-other) athletes.

individual_scores %>% 
  filter(Name != "Other") %>%
  group_by(Team) %>% 
  summarise(Score_Perc = sum(Score_Perc)) %>% 
  arrange(Score_Perc) %>% 
  mutate(Team = factor(Team, unique(Team))) %>% 
  ggplot(aes(x = reorder(Team, Score_Perc), y = Score_Perc)) +
  geom_point() +
  scale_y_continuous(breaks = seq(5, 50, 5)) +
  theme_bw() +
  labs(title = "Percentage Of Total Points Scored by Top Swimmers",
       x = "Team",
       y = "Score Percentage")

Some teams, like the London Roar are more balanced than others, like the Condors are more top heavy. There’s not an obvious lesson to be drawn here though, because LON, CAC, ENS and LAC where the best teams in the league in Season 2 and they’re all over this plot. Also there’s nothing to be surmised about next season, because we don’t know anything about next season. We’re just doing this for fun.

Season 1 Data Set

The ISL made a lot of changes between season 1 and season 2, so they’re not directly comparable. It’s still possible to build a data set from season 1 though. The methods are exactly the same as for season 2 above.

web_url_season_1 <- "https://github.com/gpilgrim2670/Pilgrim_Data/tree/master/ISL/Season_1_2019"
selector <- ".js-navigation-open"

page_contents <- read_html(web_url_season_1)
links_season_1 <- html_attr(html_nodes(page_contents, selector), "href")
links_season_1 <- links_season_1[5:18]
links_season_1 <- paste0("https://github.com", links_season_1)
links_season_1 <- str_replace(links_season_1, "blob", "raw")
links_season_1 <- links_season_1[2:14]

season_1 <- map(links_season_1, read_results)
season_1_parse <- map(season_1, safely(swim_parse_ISL, otherwise = NA), splits = TRUE, relay_swimmers = TRUE)
names(season_1_parse) <- str_split_fixed(links_season_1, "/", n = 10)[, 10]
season_1_parse <- SwimmeR:::discard_errors(season_1_parse)
season_1_df <- bind_rows(season_1_parse, .id = "ID") %>% 
  mutate(ID = str_remove(ID, "\\.pdf\\.result")) %>% 
  mutate(Start_Date = as.Date(str_split_fixed(ID, "_", 4)[, 2], format = "%d%m%Y")) %>% 
  mutate(Match = str_split_fixed(ID, "_", 5)[, 3]) %>% 
  mutate(Season = 1) %>% 
  arrange(Start_Date) %>% 
  select(-ID)

In closing

Thank you for once again joining us here at Swimming + Data Science. We hope to see you back next time, just like we hope to see the ISL back next season!

Tidy Troubles and SwimmeR does the Splits - v0.6.0

Mon, 23 Nov 2020 00:00:00 +0000

If you’re only going to read one line of this post let it be this one: v0.6.0 of SwimmeR is now available from CRAN and it’s better now than ever before. But don’t just stop at one line though, grab that update and come along on this journey, deep into the heart of SwimmeR.

library(SwimmeR)
library(dplyr)
library(stringr)
library(flextable)

flextable_style <- function(x) {
  x %>%
    flextable() %>%
    bold(part = "header") %>% # bold header
    bg(bg = "#D3D3D3", part = "header") %>% # puts gray background behind the header row
    align_nottext_col(align = "center", header = TRUE, footer = TRUE) %>% # center alignment
    autofit()
}

The rest of this post, which I promise will be super interesting and even have jokes, is about the tidy framework, inconsistencies in source material, subcategories and my failure to get all those things to play nicely together in the context of SwimmeR. I realize calling it a failure makes it sound like I was lying a few lines ago when I said that SwimmeR v0.6.0 is better than ever before, but I wasn’t. Don’t jump to conclusions.

Breaking Change

Before going any further though there’s one important, breaking, change. The output of swim_parse has been modified, such that the Grade column is renamed to Age and the School column is renamed to Team. These are frankly overdue changes, which reflect the broader applicability of SwimmeR outside the American high school swimming arena I first developed it for. My apologies and please adjust your work flows.

Tidy Data

Tidy is a way of organizing data that’s been championed by Hadley Wickham. He’s, I think indisputably, the most famous proponent of R, and from his post as Chief Scientist at RStudio he’s in a prime position to drive his personal philosophies forward. One of those philosophies is tidy data. He also has a distinctive first name, so you’ll often see him referred to simply as Hadley, like he’s Kobe or Madonna or something, but that’s neither here nor there.

Tidy data has several benefits.

It’s easy to explain. Tidy data is simply data where each row is a distinct observation, or event (like a swim), and each column contains one and only one variable, like a name, or a time.
It’s easy to represent in a table, or even a spreadsheet.
It’s super easy to work with in R. This is arguably because of tidy data’s relative simplicity of structure, but it’s also in some part because Hadley Wickham/RStudio release tons of free, excellent, packages that use (and enforce the norms of) tidy data.

In spite of what I see as tidy data’s real utility, bemoaning the influence of Hadley Wickham/RStudio is something of a sport in the R blog-o-sphere. This is the Swimming + Data Science blog though, and the only sport we care about here is swimming (and also diving). I’ve got my hands way too full dealing with getting SwimmeR releases out, the International Swim League changing their results formats for no reason, and breaststrokers trying to cheat all the time to be complaining about someone releasing free tools. I need all the help I can get.

Back to SwimmeR v0.6.0 and its many improvements…

Splits

SwimmeR can now read split times. Both the swim_parse and swim_parse_ISL now have another argument, called splits. Setting splits = TRUE will direct each function to attempt to read in splits. The default is FALSE so splits won’t be collected unless you, the user, decide they should be.

In swim_parse there’s another argument, splits_length. This is the length of pool at which the splits are recorded. It’s usually 50 (the default).

file_50 <- read_results("http://www.section1swim.com/Results/BoysHS/2020/Sec1/Single.htm")

df_50 <- swim_parse(file_50, splits = TRUE)

df_50 %>% 
  filter(Event == "Men 100 Yard Butterfly") %>% 
  select(Place, Name, Finals_Time, Split_50:Split_100) %>% 
  head(3) %>% 
  flextable_style()

Sometimes though splits_length should be set to 25, because splits are taken every 25 meters or yards.

file_25 <- read_results("https://github.com/gpilgrim2670/Pilgrim_Data/raw/master/SwimmeR%20Demo%20Files/7th-snsc-scm-2017-full-results.pdf")

df_25 <- swim_parse(file_25, avoid = c("MR\\:", "NR\\:"), splits = TRUE, split_length = 25)

df_25 %>% 
  filter(Event == "Women 100 SC Meter IM") %>% 
  select(Place, Name, Finals_Time, Split_25:Split_100) %>% 
  head(3) %>% 
  flextable_style()

This is new, exciting, and undoubtedly the most requested feature, so there you go people - enjoy!

Relay Swimmers

SwimmeR can also now capture relay swimmers, by setting the argument relay_swimmers = TRUE inside either swim_parse or swim_parse_ISL. Like splits, relay_swimmers defaults to FALSE - using it is optional.

df_relay <- swim_parse(file_50, relay_swimmers = TRUE)

df_relay %>% 
  filter(Event == "Men 400 Yard Freestyle Relay") %>% 
  select(Place, Team, Finals_Time, Relay_Swimmer_1:Relay_Swimmer_4) %>% 
  head(3) %>% 
  flextable_style()

The Troubles

Splits

“All that sounds great”, I hear you saying, “and your examples worked flawlessly!” Wrong, wrong, wrong. I picked those examples as traps. Splits can be trouble, as Ricky Berens well knows.

Not where you want a split

Here’s the problem. SwimmeR reads in data from sources, but it also imposes a structure on that data, a tidy structure in fact. In versions prior to v0.6.0 there was no issue with imposing a tidy structure, it didn’t chafe at all, because the source data SwimmeR was reading in was fundamentally tidy. Each row was a swim, each column the corresponding event, or athlete name, or final time. Splits are different though.

There are two general types of splits, cumulative and non-cumulative. Cumulative splits work like this: The first 50 meters of your race takes you 29.00 seconds. The second 50 meters takes you 31.00 seconds. Your cumulative split for the 50 is 29.00, and for the 100 is 61.00 seconds (1:01.00). You keep going, your third 50 takes you 31.50 seconds, so your cumulative split for the 150 is 29.00 plus 31.00 plus 31.50, for a total of 92.50 seconds (1:32.50). That’s all fine.

Non cumulative is the same, just without the adding. Your split for the 50 is still 29.00, for the next 50 (not the 100), it’s 31.00, for the third 50 (not the 150) it’s 31.50. This is fine too. SwimmeR prefers non-cumulative splits due to tidy principles - each split is it’s own variable, rather than the splits being collections (sums, or accumulations) of other splits/variables but if only cumulative splits are available SwimmeR will take them.

Either cumulative or non-cumulative splits wouldn’t be a problem, for SwimmeR or otherwise, and indeed both are often used together in swimming results, with non-cumulative printed inside parenthesis and cumulative outside. What about when the non-cumulative isn’t quite non-cumulative? Sounds daft right, but that’s the convention during relays. Take a look:

In the 1st place relay Christian Lee swims his first 50 in 23.27, then his next 50 in what? Not 47.33 - that’s his total time, despite it being wrapped in parenthesis. Then Samuel Andrews dives in and he swims the third 50 in 23.06, for a total time 1:10.39. He swims his second 50 in - again, not 48.65, that’s his cumulative 100. You see the problem. This problem is reproduced within the results from swim_parse.

df_50 %>%
  filter(Event == "Men 400 Yard Freestyle Relay") %>%
  select(Place, Team, Finals_Time, Split_50:Split_400) %>%
  head(3) %>%
  flextable_style()

I could of course convert the cumulative splits to non-cumulative.

df_50 %>%
  rowwise() %>% 
  mutate(
    Split_100 = case_when(
      str_detect(Event, "Men 400 Yard Freestyle Relay") ~ as.character(sec_format(Split_100) - sec_format(Split_50)),
      TRUE ~ Split_100
    ),
    Split_200 = case_when(
      str_detect(Event, "Men 400 Yard Freestyle Relay") ~ as.character(sec_format(Split_200) - sec_format(Split_150)),
      TRUE ~ Split_200
    ),
    Split_300 = case_when(
      str_detect(Event, "Men 400 Yard Freestyle Relay") ~ as.character(sec_format(Split_300) - sec_format(Split_250)),
      TRUE ~ Split_300
    ),
    Split_400 = case_when(
      str_detect(Event, "Men 400 Yard Freestyle Relay") ~ as.character(sec_format(Split_400) - sec_format(Split_350)),
      TRUE ~ Split_400
    )
  ) %>%
  filter(Event == "Men 400 Yard Freestyle Relay") %>%
  select(Place, Team, Finals_Time, Split_50:Split_400) %>%
  head(3) %>%
  flextable_style()

I can do the conversion here, and I could have built the conversion into swim_parse and swim_parse_ISL, but there’s a tension, between the extremely useful tidy framework on one hand, and fidelity to the source material on the other. SwimmeR thus far gives users the choice. You can choose to read in splits (and remember, the default is not to), and then you can choose how you treat splits if you decide to read them in. You can choose between tidiness and fidelity.

I may bundle the above code, for converting split types, into a future version of SwimmeR but if I do its use will also be at the discretion of the user.

Even deeper is the fact that (for example), the third 50 of a 200 Freestyle and the third 50 of a 200 Freestyle relay are both recorded in the same column (Split_150) but they’re fundamentally different, because the third 50 on a relay begins with a relay pickup (a start from the blocks), and involves a fresh swimmer, where the third 50 in the individual event starts from a turn and involves the same swimmer who swam the first two 50s. One column contains two variables. That’s a no-no. I could put relay splits in their own columns, but I’d have to break them up by relay type too. The 2nd 50 of a 200 Freestyle Relay is almost always done with the front crawl stroke (freestyle), but the 2nd 50 of a 200 Medley Relay is required to be swam breaststroke - different animals all together. Differentiating them means a lot lot lot of columns/variables.

And what if the length at which splits are taken varies within a meet, or even within a race? Have a look at this:

The splits are by 25 for the first 800m of this 1500m freestyle, but for the last 700 there’s only one split, for the whole 700m. swim_parse faithfully reproduces this, except that it doesn’t know that suddenly the split length has changed mid-race. The result is a column labeled Split_825 that isn’t actually the 825m split.

df_25 %>% 
  filter(Event == "Men 1500 SC Meter Freestyle") %>%
  select(Place, Name, Finals_Time, Split_700:Split_825) %>%
  head(3) %>%
  flextable_style()

There’s nothing I can do here - I can’t recreate splits that aren’t included in some form in the source data. You’ll just have to know what’s going on in your results.

For further discussion of potential issues with splits please see vignette("SwimmeR").

Relay Swimmers

Relay swimmers aren’t anywhere near as troublesome as splits, but they’re still in tension with tidy principles. Let’s say you were interested in what races a particular athlete had participated in. It’s easy to filter or in some other way subset the data based on Name. With relay_swimmers = TRUE though that athlete’s name might be in Name or it might be in one of the relay swimmer columns. Having one variable (athlete name) in multiple columns is not tidy.

I could put relay swimmers in the names columns, but then what to do about their times? They don’t have a Finals_Time in the normal sense, only their splits, and as you’ve just read that’s a whole other mess.

Again my approach here has been reasonable fidelity to the results, and letting users decide if they want to opt into tidy troubles (by affirmatively setting relay_swimmers = TRUE).

In Conclusion

To be clear, in neither the case of splits nor the case of relay swimmers is the issue with the principles of tidy data as such. They’re fine, sensible principles, although they do have their limitations. The issue is also not with the conventions of reporting for swimming data. They also make sense and are perfectly usable for the millions of people who participate in the sport every year. The issue is in the tension between the two - how to put swimming data into a computationally useful format, while still being friendly to the human analyst. This is the central tension at the heart of SwimmeR, all the more on display now in v0.6.0.

Thanks for reading, and be sure to come back to Swimming + Data Science where next time we’ll be doing a look back over the recently completed International Swimming League Season 2! Lilly King will be involved, so get excited.

Scraping Websites and Building a Large Dataset with SwimmeR

Tue, 10 Nov 2020 00:00:00 +0000

Today we’re going to use SwimmeR to build a large database of results - that’s the overall goal. Having a more specific goal in mind can be useful though, so here goes.

A friend of mine is a college administrator. It’s part of her job to keep up on what Kids These Days (TM) are doing and one thing they’re apparently doing is getting participation trophies. Looking back to my childhood I participated in a lot of swim meets, and swam a lot of races. For my trouble I’ve got piles of ribbons, enough medals to cover my entire head if I were to try and wear them all at once, and even a few plaques - but almost no trophies. My lack of trophies could be due to my modest swimming abilities, but I’ve checked with some of my faster friends and teammates and they report the same thing - very few trophies. I don’t want swimmers to be left out of the zeitgeist, and if that means participation trophies then I’ve got some wrongs to right.

Who should get these participation trophies though? Not everyone of course, just handing them out would cheapen them. I want to award participation trophies to only the most participatory athletes, the crème de la crème of participation. To that end today I’m going to try and determine the most participatory swimmers in my USA Swimming LSC for the 2018-2019 season. These ultra-participatory athletes will win the coveted Swimming + Data Science Participation Trophies.

Rules are as follows:

The winners shall be the athlete(s) who have participated in, and legally completed, the most individual events in the 2018-2019 Niagara LSC age group season and the athlete(s) who have swam the furthest distance in their events during the same period
Any individual event swam at a meet in Niagara LSC during the 2018-2019 age group season will count. Sectionals will also count if the results are on the Niagara LSC website in .pdf or .html form
Only swimmers from Niagara LSC are eligible
Tiebreaker will be the other category - total distance swam for the events category, and number of events swam for the distance category

To do this I’ll of course need results for all meets swam in Niagara LSC for 2018-2019 - SwimmeR, take your mark!

library(SwimmeR)
library(dplyr)
library(purrr)
library(stringr)
library(rvest)
library(flextable)

flextable_style <- function(x) {
  x %>%
    flextable() %>%
    bold(part = "header") %>% # bold header
    bg(bg = "#D3D3D3", part = "header") %>% # puts gray background behind the header row
    align_nottext_col(align = "center", header = TRUE, footer = TRUE) %>% # center alignment
    autofit()
}

Please note the following analysis was done using the development version of SwimmeR current on November 22nd, 2020, equivalent to version 0.6.0 from CRAN. Please make sure your version of SwimmeR is up-to-date.

Getting Links to Results

During the State-Off Tournament we sometimes built lists of links to pull results from. In those cases the link addresses followed a pattern, which we used to generate them within R. What do we do though if there are links we’re interested in, but their addresses don’t follow a pattern?

Niagara LSC has a repository of results for each season, and the 2018-2019 one is here. It’s basically a list of meets, each with a link called “Results”, and each with a different address. We want the content of all of those links, but there’s a lot and typing all the addresses in manually is of course out of the question. To get them we need the CSS selector that defines them. If you’re a CSS whiz maybe you can just read the website source code a determine it, but I use the Selector Gadget Google Chrome add-on. After a bit of clicking around I’ve determined that the selector in this case is called span a.

Now it’s time to deploy the rvest package. rvest is another hit from the good folks at RStudio and for our purposes today it’s pretty simple. We’ll need to direct it to the results repository and then extract all the links from span a. We’ll use read_html to read the results repository web page, then html_nodes to get the content of our selector, and also html_attr to make sure that content is a link. In this way we’ll build a list of links.

Please note that as of November 17th 2021 the Niagara results archive is down so the reading-in portion of this, while correct in theory, will not actually run.

web_url <- "https://www.teamunify.com/team/eznslsc/page/times/2018-2019-results"
selector <- "span a"

page_contents <- read_html(web_url)
links <- html_attr(html_nodes(page_contents, selector), "href")

If we look at our list of links we’ll see that most of them look like .pdf files of results (what we want), but some of them, like the first one, are other junk.

head(links, 5)

We only want links that end in either “.pdf” or “.htm” because a) those are the results and b) SwimmeR can read those file types.

links <- links[links %>% 
  str_detect("\\.pdf$|.htm")]

Looking at head(links) again we can also see that these aren’t full links. They’re partials, missing their beginnings. Links should begin with something like “https://www.r-bloggers.com/”. In this case the desired beginning, as visible in your browser window, is “http://www.teamunify.com”. We’ve got to be a bit careful though - there might be a few fully formed links in our list. Let’s check.

links[str_detect(links, "http")]

So there’s a few Sectional results that are already full links. Let’s modify the rest to make them complete as well.

links <- ifelse(str_detect(links, "http"), paste0("", links), paste0("http://www.teamunify.com", links))

Reading in Results

Now that we have our list of links we can use read_results to pull their contents into R. Because there might still be some bad links we’ll use the safely function inside of map. map will apply read_results to every element of links, but because read_results is wrapped in safely if it fails rather than posting an error and aborting it will note the issue and keep going, reading in the rest of the elements of links.

We’ll then name each element of the list of results produced by read_results with the link from whence it came.

Please note - running the following code will take several minutes. I also have the results hosted on github. You can download them directly using this code: raw_results <- readRDS(url("https://github.com/gpilgrim2670/Pilgrim_Data/raw/master/Niagara%20LSC%202018-2019%20Dataset/Niagara_raw_results.rds)).

raw_results <- map(links, safely(read_results, otherwise = NA))

names(raw_results) <- links

We now have a list of lists. Each sublist contains results (hopefully) and also an error register as elements 1 and 2 respectively. We want to remove sublists where the error register isn’t NULL - that is, sublists that have an error. We also then want only the first element (the results) of the remaining sublists - we don’t want the empty error register. Here’s a handy little function to do just that, which we can apply to raw_results to clean them.

discard_errors <- function(results) {
  element_extract <- function(lst, n) {
    sapply(lst, `[`, n)
  }
  clean_results <- discard(results, ~ !is.null(.x$error))
  clean_results <- element_extract(clean_results, 1)
  return(clean_results)
}

clean_results <- discard_errors(raw_results)

Parsing Results

With our clean_results in hand we now can pass them to swim_parse, again via map, to apply over every element of clean_results, and again inside safely, to power through (but note) any errors.

The typo and replacement arguments to swim_parse are used for correcting issues in the source materials. Their use requires a bit of practice so that typos can be correctly identified and fixed, but in general the issues relate to one of two things.

Special strings. Strings like “DQ” and “–” (two or three dashes together) have special meaning in swimming results, and therefore inside swim_parse. “DQ” obviously means a swimmer has been disqualified. The two (or three) dashes, “–” are used instead of a place number for athletes who were DQ’d, or scratched etc. Incorrect usage of these strings within results can cause problems, but are easily corrected with typo and replace
White space issues. swim_parse uses instances of two or more spaces to split results into data frame columns. If those spaces aren’t as they should be, for example if an athlete or team name is long enough that it encroaches on the next column parsing issues will result.

Please note - running the following code will take a long time,as much as 30 minutes depending on your internet connection and computer. I also have the results hosted on github. You can download them directly using this code: Niagara_Results <- readRDS(url("https://github.com/gpilgrim2670/Pilgrim_Data/raw/master/Niagara%20LSC%202018-2019%20Dataset/Niagara_2018_2019.rds")).

Niagara_Results <-
  map(
    clean_results,
    safely(swim_parse, otherwise = NA),
    typo = c(
      "111", # an actual typo in a kid's name
      "Greater Rochester Area YMCA --NI", # incorrect usage of special string "--"
      "(?<=[:alpha:]) (?=[:digit:])", # regex to identify any space that is preceded by a letter and followed by a number, so that it can be expanded to two+ spaces - a white space issue
      "PENINSULA WAVE RIDERS SWIMMING-A", # team name so long that it got to close to athlete's times - a white space issue
      "DQY", # wrong DQ string
      "XDQ", # wrong DQ string
      "Alexis/Lexi J", # an actual typo in a kid's name
      "La Face, Isabella or Bella F", # an actual typo in a kid's name
      "Cunningham, Rhys*", # an actual typo in a kid's name
      " FUT " # extraneous string used to signify a Futures cut
    ),
    replacement = c(
      "III",
      "Greater Rochester Area YMCA-NI",
      "   ",
      "PENINSULA WAVE RIDERS SWIMMING  ",
      "DQ",
      "DQ",
      "Alexis J",
      "La Face, Isabella",
      "Cunningham, Rhys",
      ""
    )
  )

We’ve got a list of results, but a few of them will contain errors. For example #r links[42] doesn’t actually contain results, just a list of high-point scores. That one won’t read. We’ll just use our discard errors function again and then data.table::rbindlist to stick all the results together with a column called Source, containing the element name, which we already made the link it was downloaded from.

Niagara_Results <- discard_errors(Niagara_Results)

Niagara_Results <- data.table::rbindlist(Niagara_Results, use.names = TRUE, idcol = "Source", fill = TRUE)

How big is our data set? dim can tell us.

dim(Niagara_Results)

## [1] 108127     11

We’ve got 108127 rows and 11 columns. There are bigger sets for sure, but this one isn’t small.

Cleaning the Data

A few minor things before we get going. The Source column has appended a string to the end of our links. Let’s get rid of that. Let’s also convert the Age column to numeric, and then use select to order the columns in a sensible way.

Niagara_Results  <- Niagara_Results  %>%
  mutate(Source = str_remove(Source, "\\.result\\.result")) %>% 
  mutate(Age = as.numeric(Age)) %>% 
  select(Source, Place, Name, Age, Event, everything())

Names - A Thorny Problem

It’s tempting to just rush in and count events by athlete name - let’s try it.

Niagara_Results %>%
  filter(is.na(Name) == FALSE,
         DQ == 0) %>% # DQs don't count
  group_by(Name) %>%
  summarise(No_Swims = n(), # number of events swam by each athlete
            Team = get_mode(Team), # use only most common team name
            Age = round(mean(Age, na.rm = TRUE), 0)) %>%
  arrange(desc(No_Swims)) %>%
  head(5) %>% 
  flextable_style()

It worked I guess, we get some names, with Emily Chung on top. Let’s look a bit more closely at Miss Chung’s results though.

Niagara_Results %>%
  filter(is.na(Name) == FALSE,
         DQ == 0) %>% # DQs don't count
  filter(str_detect(Name, "Chung")) %>%
  filter(str_detect(Name, "Emily")) %>%
  group_by(Name) %>%
  summarise(No_Swim = n(), # number of events swam
            Team = get_mode(Team)) %>% # use only most common team name
  flextable_style()

Turns out she’s here twice, once as “Chung, Emily” and again as “Emily Chung”. Our first analysis didn’t catch her as “Emily Chung” though. We’ll need to count both together, and other athletes may be similarly undercounted.

There’s another issue highlighted by Sidra El Ghissassi. Let’s take a look at her doings.

Niagara_Results %>%
  filter(is.na(Name) == FALSE,
         DQ == 0) %>% # DQs don't count
  filter(str_detect(Name, "El Ghissassi")) %>%
  filter(str_detect(Name, "Sidra")) %>%
  group_by(Name) %>%
  summarise(No_Swim = n(),
            # number of events swam
            Team = get_mode(Team),
            # use only most common team name
            Age = round(mean(Age, na.rm = TRUE), 0)) %>%
  flextable_style()

She’s here three times, sometimes with a middle initial and sometimes not, sometimes with her last name first, sometimes with her first name first. What’s more she has two words in her last name. We need to keep track of all this stuff.

There’s also the question of nicknames. For example everyone calls me Greg, but my name is actually Gregory. In swimming results sometimes I’m Gregory and sometimes I’m Greg. The goal here is to be able to recognize “Emily Chung” and “Chung, Emily” as the same person, and also “Greg Pilgrim” and “Pilgrim, Gregory A” as the same person, plus “El Ghissassi, Sidra S” and “Sidra El Ghissassi” as the same person. Let’s take a whack at assigning everyone an ID based on the first 3 letters of their first name and the last 5 letters of their last name. To do that we’ll need to get everyone’s name in the same order - let’s do Firstname Lastname.

Niagara_Results <- Niagara_Results %>%
  mutate(Name_2 = str_replace(Name, " [:upper:]$", "")) %>% # removes middle initials
  mutate(Last_Name = case_when( # pulls out last name when it's followed by a comma
    str_detect(Name_2, ",") ~ str_split_fixed(Name_2, ",", n = 2)[, 1],
    TRUE ~ ""
  )) %>%
  na_if("") %>%
  mutate(First_Name = case_when(is.na(Last_Name) == FALSE ~ str_remove(Name_2, paste0(Last_Name, ",", " ")), # gets first name if last name was identified above
                                TRUE ~ "")) %>%
  na_if("") %>%
  mutate(Name_3 = case_when( # recombines first names and last names identified above into Firstname Lastname order
    is.na(First_Name) == FALSE &
      is.na(Last_Name) == FALSE ~ paste(First_Name, Last_Name, sep = " "),
    TRUE ~ Name_2 # names not identified above are already in Firstname Lastname order
  )) %>%
  mutate(ID = paste0( # make an ID value based on first 3 letters of first name, last 5 letters of last name
    stringr::str_extract(Name_3, "^.{3}"),
    str_extract(Name_3, ".{5}$")
  )) %>%
  select("Name_Rework" = Name_3, # cleanup columns
         ID,
         everything(),
         -Name_2,
         -First_Name,
         -Last_Name)

As a check, let’s look at Emily again and see if her ID is doing what we’d like.

Niagara_Results %>%
  filter(str_detect(Name, "Chung")) %>%
  filter(str_detect(Name, "Emily")) %>%
  group_by(Name) %>%
  summarise(No_Swim = n(),
            Team = get_mode(Team), # use only most common team name
            Age = round(mean(Age, na.rm = TRUE), 0),
            ID = unique(ID)) %>% # show ID
  flextable_style()

And Sidra:

Niagara_Results %>%
  filter(str_detect(Name, "El Ghissassi")) %>%
  filter(str_detect(Name, "Sidra")) %>%
  group_by(Name) %>%
  summarise(No_Swim = n(),
            Team = get_mode(Team), # use only most common team name
            Age = round(mean(Age, na.rm = TRUE), 0),
            ID = unique(ID)) %>% 
  flextable_style()

Both girls have their own ID, which is consistent across the multiple variants of their names. We’re going to stop here, but it is worth noting that there are real and sometimes unsolvable problems of this type - often called record linkage.

If there were two athletes named Emily Chung (and there might be) we wouldn’t be able to tell with this approach. We could maybe differentiate them based on team, but people do sometimes change teams, so even if there were Emily Chungs who swam for two different teams they could be the same person. We could also check their ages, but if you look back to Emily’s table above you’ll see that her age changes. She was 12, but then she turned 13. Probably. It’s also possible that there are two Emily Chungs who both swim for Clarence Swim Club, but one is a year older than the other. We could go even further and try to extract dates for each meet, and see if the (potentially) two Emily Chungs ever swim in the same meet while being different ages but if they didn’t we still couldn’t be sure there was only one Emily Chung.

Additionally if there was a third girl named Emily ZChung her ID would also be EmiChung, same as the original Emily Chung(s) - it’s tricky! We could instead make the ID from the last 6 characters of each name, but that doesn’t solve the fundamental issue.

What’s more, if your name is Andre, but you’re known as Dre - this approach doesn’t help you. Same for Rebecca/Becca and William/Bill.

My point isn’t that this is hopeless, but rather that data science can be hard, and it requires some checking of assumptions to make sure your code is actually doing what you think it’s doing. Solving your problem might be much harder than you first realize. There are more tools we could bring to bear on this names issue, and they may be the subject of another article down the line, but for now let’s press forward.

Distance

With our IDs in hand there’s now the matter of other category - distance swam. Distance is included in Event, but there are two wrinkles. The first is getting the number of yards/meters swam out, and the second is converting them all to a consistent unit, in our case yards.

We’ll extract all groups of digits from each Event using str_extract_all. This will get us the distances, but also the age groups, like “12” from “12 & Under” or “13” and “14” from “Boys 13-14…”. Crucially though the distance will always be the last set of numbers, so we can use tail to get it out.

Then we’ll do something similar with the strings “Yard” and “Meter”, multiplying distance by 1.1 whenever str_detect detects “Meter” in Event and keeping distance the same when str_detect detects “Yard”. A meter is 1.1 yards.

Niagara_Results <- Niagara_Results %>% 
  mutate(Event_Numb = str_extract_all(Event, "\\d{1,}")) %>% # get all groups of digits as a list
  rowwise() %>% # since rows contain lists we need this to act across rows rather than down columns
  mutate(Distance = as.numeric(tail(Event_Numb, 1))) %>% # take the last element of each list
  mutate(Distance = case_when(str_detect(Event, "Yard") ~ Distance ,
                              str_detect(Event, "Meter") ~ Distance * 1.1, # convert distances swam in meters to yards
                              TRUE ~ Distance)) %>% 
  select(-Event_Numb)

Niagara_Results <- Niagara_Results %>% 
  filter(is.na(Name) == FALSE,
         DQ == 0) %>% # DQ events don't count
  group_by(ID) %>% 
  summarise(No_Swims = n(), # count up total swims
            Name = get_mode(Name), # use only most common name
            Team = get_mode(Team), # use only most common team
            Age = round(mean(Age, na.rm = TRUE), 0),
            Distance = sum(Distance, na.rm = TRUE)) %>% 
  ungroup() %>% 
  select(-ID)

Final Results

We’ve reached the end, who will win the coveted Swimming + Data Science Participation Trophy for most events swam?

Niagara_Results %>% 
  arrange(desc(No_Swims)) %>% # sort by number of swims, highest to lowest
  head(5) %>% 
  flextable_style()

It’s Luciana M. Alessi from Buffalo Aquatics (BAAC)! She swam a gargantuan 183 races averaging just over 85 yards per race. That’s a lot!

And now for the Swimming + Data Science Participation Trophy for most furthest distance swam…

Niagara_Results %>% 
  arrange(desc(Distance)) %>% # sort by distance swam, highest to lowest
  head(5) %>% 
  flextable_style()

It’s Matthew J. Cole from the Oswego Lakers, who swam 32,655 yards over 118 events for a ~275 yard per event average! That’s over 18 miles by the way.

A massive congratulations to both Luciana and Matthew for your staggering levels of participation! If either of you happen to be reading this (or if you’re a coach from BAAC or the Lakers), get in touch, I really will have trophies made and sent.

Conclusion

Thank you for joining us here at Swimming + Data Science where we’ve used SwimmeR to get a big data set of swimming results and then answered the questions - who swam the most events and furthest distance. I hope you’ve enjoyed yourself - be sure to check back in next time for another adventure.

A CRAN Downloads Experiment

Wed, 28 Oct 2020 00:00:00 +0000

I’ve done an experiment regarding package downloads from CRAN (or the RStudio CRAN mirror at least) and now it’s time to share the results.

When the first version (0.0.1.0) of SwimmeR was released on CRAN in October of 2019 it had very few features - just a couple functions for formatting times and doing course conversions. It also had no web presence, no Swimming + Data Science blog, no particular way for anyone to find out what it was, or what it did, or even that it existed. So imagine my surprise when I checked the package download stats 6 months later and found out SwimmeR v0.0.1.0 had been downloaded over 1700 times. SwimmeR was, and is, a fairly niche package - there just aren’t that many people in the world interested in both swimming and R, so 1700 seemed like a lot. And remember, SwimmeR v0.0.1.0 had very few features.

library(dplyr)
library(ggplot2)
library(purrr)
library(dlstats)
library(flextable)

flextable_style <- function(x) {
  x %>%
    flextable() %>%
    bold(part = "header") %>% # bold header
    bg(bg = "#D3D3D3", part = "header") %>% # puts gray background behind the header row
    align_nottext_col(align = "center", header = TRUE, footer = TRUE) %>% # center alignment
    autofit()
}

SwimmeR has been out for about a year now, has many more features, and a little over 6500 downloads. That’s still not many in the grand scheme of things, but it’s many more than I ever expected. For comparison here’s how SwimmeR stacks up versus dplyr.

df <- cran_stats(c("SwimmeR", "ThreeWiseMonkeys", "dplyr"))

df <- df %>%
  group_by(package) %>%
  mutate(days = cumsum(as.numeric(end - start, units = "days")),
         total_downloads = cumsum(downloads),
         package = as.character(package))

df %>% 
  filter(package != "ThreeWiseMonkeys") %>% 
  group_by(package) %>% 
  ggplot(aes(x = package, y = sum(downloads))) +
  geom_col() +
  labs(y = "Total Downloads",
       x = "Package",
       title = "dplyr vs. SwimmeR") +
  theme_bw()

Too Many Downloads

Those initial 1700 downloads for a minimally featured SwimmeR v0.0.1.0 seemed so excessive that I got suspicious and decided to do an experiment. Allow me to introduce to the world the ThreeWiseMonkeys package. The documentation says “[ThreeWiseMonkeys d]oes nothing useful…”, which is mostly, but not quite, true. The reality is that ThreeWiseMonkeys is intended to do nothing useful for its users - the people who download it. I wrote ThreeWiseMonkeys in April 2020, released it to CRAN and told no one. What ThreeWiseMonkeys has been doing since then is steadily accruing downloads at a rate I’m prepared to call baseline. That’s what ThreeWiseMonkeys does - it marks out the CRAN downloads floor for me, the (supposedly) only person who knew or cared about it. It has about 2000 downloads as of this writing. Take a look versus SwimmeR:

df %>%
  filter(package != "dplyr") %>% 
  ggplot(aes(
    x = end,
    y = total_downloads,
    group = package,
    color = package
  )) +
  geom_line() +
  geom_point(aes(shape = package)) +
  theme_bw() +
  labs(y = "Total Downloads",
       x = "Date",
       color = "Package",
       shape = "Package")

Now if we line up SwimmeR and ThreeWiseMonkeys by the number of says since their releases we can see something interesting:

df %>%
    filter(package != "dplyr") %>% 
  ggplot(aes(
    x = days,
    y = total_downloads,
    group = package,
    color = package
  )) +
  geom_line() +
  geom_point(aes(shape = package)) +
  theme_bw() +
  labs(y = "Total Downloads",
       x = "Days Since Release",
       color = "Package",
       shape = "Package")

SwimmeR Gets Some PR

What happened around April of 2020, 200 days after SwimmeR was released? SwimmeR and ThreeWiseMonkeys had pretty much identical download rates until then, but all of a sudden SwimmeR started trending upward much faster. Well, COVID happened, and maybe folks took to R rather than socializing. That’s possible but I’m going to set it aside for the moment, because it doesn’t explain why SwimmeR jumped but ThreeWiseMonkeys didn’t. As far as SwimmeR specific changes in that time range SwimmeR v0.2.0 was released on April 10th, with many more features, effectively beginning its life as a useful package. Still further, the Swimming + Data Science blog launched and debuted on R-bloggers, introducing the world to SwimmeR more directly. Let’s take a look at the difference in downloads, with the post April 2020 SwimmeR package renamed as "SwimmeR + Blog".

df <- df %>%
  filter(package != "dplyr") %>% # don't need dplyr stats any more
  mutate(package = case_when(
    package == "SwimmeR" &
      start > as.Date("2020-04-01") ~ "SwimmeR + Blog", # rename package for month of April
    TRUE ~ package
  ))

ggplot(data = df, aes(group = package, color = package)) +
  geom_point(aes(
    x = days,
    y = total_downloads
  )) +
  geom_smooth( # fit lines for SwimmeR and ThreeWiseMonkeys (want full range)
    data = df %>%
      filter(package != "SwimmeR + Blog"),
    aes(x = days,
    y = total_downloads,
    group = package),
    method = "lm",
    fullrange = TRUE,
    se = FALSE
  ) +
    geom_smooth( # fit line for SwimmeR + Blog (don't want full range on this one)
    data = df %>%
      filter(package == "SwimmeR + Blog"),
    aes(x = days,
    y = total_downloads,
    group = package),
    method = "lm",
    fullrange = FALSE,
    se = FALSE
  ) +
  labs(y = "Total Downloads",
       x = "Days Since Release",
       color = "Package") +
  theme_bw()

What this means is that of the 6500 downloads SwimmeR has as of October 28th, 2020, about 4000 can be provisionally attributed to whatever this CRAN baseline is. The other ~2500 are more likely to be the result of actual people who share my interests in swimming and R - thank you friends, I hope SwimmeR is helping you! Now lets get the slope (total downloads per day) for each package and compare download rates for SwimmeR before and after the launch of the Swimming + Data Science blog and v0.2.0.

df %>% 
  group_split() %>% # breaks into separate dataframes for each group (package)
  map(~lm(total_downloads ~ days, data = .x)) %>% # apply lm function to each dataframe
  map_df(broom::tidy) %>% # clean up results by converting back to single dataframe - broom heh heh
  filter(term == "days") %>% # only want the slope term
  mutate(package = unique(df$package)) %>% # add package names back in
  select(package, "download rate" = estimate) %>% 
  mutate(`download rate` = round(`download rate`, 2)) %>% 
  arrange(desc(`download rate`)) %>% 
  flextable_style()

The download rate for SwimmeR more than doubled (as of October 28th, 2020) after I started writing these articles and building out the package features - exactly what I was looking for! What’s the deal with ThreeWiseMonkeys and its 2000 downloads though?

The Remaining Mystery

The dlstats package I used to collect download information queries the RStudio CRAN mirror. RStudio’s mirror is the default for RStudio users when they download packages, but if anything the numbers from dlstats are an undercount for total package downloads. There are other mirrors, and other development environments for R and people can download packages using them rather than RStudio. That still leaves some questions.

Who are these 2000+ people who downloaded ThreeWiseMonkeys and are they the same as the 1700+ people who downloaded SwimmeR v0.0.1.0?
How did they even know ThreeWiseMonkeys existed? I know that CRAN lists it and all, but how would people know to look?
Why did they download ThreeWiseMonkeys even having found it? It’s useless!

It seems possible that there’s some kind of maintenance/testing/checks that go on in the background at CRAN, but I’m not aware of anything that would require the same (useless) package to be re-downloaded 10 times a day, every day, for 6 months. If you have any insight into what’s going on leave a comment or send me an email. I’m interested to know… Also don’t go and download ThreeWiseMonkeys - that’s not what it’s about. It’s useless - trust me.

New International Swimming League Season - New Version(s) of SwimmeR

Tue, 20 Oct 2020 00:00:00 +0000

Welcome back to Swimming + Data Science friends. Last week something exciting happened - two things actually! First, the International Swimming League kicked off its 2020 season in Budapest. Second, and directly related, I released version 0.5.0 of SwimmeR to CRAN with functions to read ISL results from the inaugural 2019 season and from the newly begun 2020 season. ISL functions in SwimmeR v0.5.0 were fully tested on all the available meets and working great. Then however, there was a problem. ISL did me dirty.

They changed their reporting for the second meet, in a way that broke SwimmeR v0.5.0. What a pain! I quickly patched the problem and was preparing another CRAN submission but then I thought “hmmm there’s more ISL meets next week. What if they do it again?”. I’ve decided that rather than pestering the good folks at CRAN with another version of SwimmeR every time someone at ISL decides to mess around I’m going to limit myself to releasing development versions of SwimmeR throughout the 2020 ISL season. Hopefully that will give ISL time to settle on a results format, at which point I’ll do another CRAN release. We start today with the now-available SwimmeR v0.5.1.

SwimmeR v0.5.1 includes the function swim_parse_ISL specifically for dealing with ISL results. So update your version of SwimmeR with devtools::install_github() and let’s get going.

devtools::install_github("gpilgrim2670/SwimmeR", build_vignettes = TRUE, force = TRUE)

In addition to the new SwimmeR v0.5.1 we’ll use the always excellent dplyr, purrr, and stringr and take these new ISL results for a spin. I also want flextable for reporting, and my special flextable_style function.

library(SwimmeR)
library(dplyr)
library(purrr)
library(stringr)
library(flextable)

flextable_style <- function(x) {
  x %>%
    flextable() %>%
    bold(part = "header") %>% # bold header
    bg(bg = "#D3D3D3", part = "header") %>% # puts gray background behind the header row
    align_nottext_col(align = "center", header = TRUE, footer = TRUE)# center alignment
}

ISL Results

There have been two ISL meets thus far, both in the “Budapest Bubble”. Results are available at SwimSwam.

match_1 <- "https://cdn.swimswam.com/wp-content/uploads/2020/10/Results_Book_Match_1_V2.pdf"
match_2 <- "https://cdn.swimswam.com/wp-content/uploads/2020/10/Results_Book_Full_M2-1.pdf"

ISL_matches <- c(match_1, match_2)

swim_parse_ISL works just like our old friend swim_parse. It takes the output of read_results and returns a data frame. It’s dead simple.

match_1 %>% 
  read_results() %>% 
  swim_parse_ISL() %>% 
  head(5) %>% 
  flextable_style()

We do have a list of match results though, so rather than doing them individually let’s do them all at once with some tidyverse magic. All we have to do is pass our list of ISL match results to read_results and then to swim_parse_ISL. Since we have a list we’ll use map to do the passing, applying read_results and swim_parse_ISL to each element, that is, each match result in the list of matches. Then we’ll name the resulting list elements, which are two data frames, by match number (1 and 2) with setNames and stick them together with bind_rows.

ISL_results <-
  map(ISL_matches , read_results) %>% # map SwimmeR::read_results over the list of links
  map(swim_parse_ISL) %>% # now it's swim_parse_ILS's turn
  setNames(c(1, 2)) %>%  # name the dataframes 1 and 2 respectively
  bind_rows(.id = "Match") %>% # stick the dataframes together, with a new column called "Match" which will contain the relevant dataframe name, either 1 or 2
  mutate(Match = as.numeric(Match))

ISL Dataframe - Now What?

Now we have one big data frame of ISL results, almost exactly like we do when we use swim_parse.

ISL_results %>%
  head() %>%
  flextable_style()

Those of you who are close readers of SwimmeR documentation (so all of you, right?) know that Lilly King is a hero around these parts. Let’s see how she’s doing in the ISL.

ISL_results %>% 
  filter(Name == "KING Lilly") %>% # only want Lilly's results
  flextable_style()

So Lilly swam 6 races and won all of them. That sounds like her. Lilly only swam in the first match though. Let’s look at the women’s breaststrokes in both matches. We’ll exclude the skins matches because in match 2 the skins races weren’t breaststroke. Probably because none of the teams in that match had Lilly King.

First we’ll filter out events that aren’t women’s breaststroke. Then we’ll create a new column with times in seconds format (total seconds) rather than minutes:seconds.hundreths using the sec_format function from SwimmeR. Next we’ll group_by event, arrange the entries in order of time, change the places with mutate to reflect our new ordering and finally, check out the results.

ISL_results %>% 
  filter(str_detect(Event, "Women's \\d{2,3}m Breaststroke$") == TRUE) %>% # only want women's breaststroke events
  mutate(Time_sec = sec_format(Finals_Time)) %>% # convert times to second format
  group_by(Event) %>% 
  arrange(Time_sec) %>% # order entries by increasing time 
  mutate(Place = rank(Time_sec)) %>% # recode place to new order, based on time
  select(-Time_sec, Lane, Points) %>% # don't need these columns
  slice(1:3) %>% # top three finishers in each event
  flextable_style()

Turns out Lilly King is dominant in both matches. Makes sense. SwimmeR v0.5.1 is working well.

In Closing

So that’s how you can use SwimmeR v0.5.1 to get ISL results into R. Not to bad right? Now we’ll just wait and see what other mischief the results people over at ISL can come up next week. If and when they strike again I’ll update SwimmeR appropriately. If you find an issue please leave a comment, or post it on github. That’s it until next time here at Swimming + Data Science.

Where Are All The 10s - Diving Math

Thu, 01 Oct 2020 00:00:00 +0000

Welcome to another case study here at Swimming + Data Science. We’re returning the world of diving, a place we’ve visited before, in an attempt to answer the question “where are all the 10s?” Today’s data science component will consist of matching calculated values to sets of allowed solutions, plus some tidyverse style data wrangling and plotting with ggplot2.

Over the past decade I’ve judged a fair bit of high school and college diving. I’ve never given a 10. I’ve never even seen anyone give a 10. Heck I’ve only given a total of two 9s. What gives? Where are all the 10s?

Introduction to Diving Scores

library(dplyr)
library(purrr)
library(tidyr)
library(ggplot2)

For those of you, like me, whose background isn’t in diving let’s start out with a bit on how diving point totals are calculated. There are a finite number of dives, each of which has an assigned degree of difficulty (DD). When a diver performs a particular dive the performance is judged by a panel of (usually) 3, 5, or 7 judges, who each score the dive between 0 and 10, in increments of 0.5 points. If there are 5 or 7 judges than the highest and lowest, or two highest and lowest scores are thrown out, leaving the three in middle. The three remaining judges’ scores, called awards, are then added together and that number is multiplied by the degree of difficultly to get the total points for that particular dive.

For this discussion we’re going to sometimes drop the “three judges” component, and talk rather about an average judges’ score. This will make things easier later, but right now there’s a bit of complexity. Since judges can only award their scores in increments of 0.5 between 0 and 10 the average score can’t be just any number between 0 and 10. In fact there are only 61 possible average judges’ awards. We need a list of those possibilities.

vec <- seq(0, 30, 0.5) # every possible total score, from all three judges giving 0s to all three judges giving 10s

decimals <- unique((vec %% 3)/3) # possible decimal components for the average score
integers <- seq(0, 10, 1) # possible integer components for the average score

l <- unlist(lapply(integers, decimals, FUN = function(x, y) {x + y})) # add all of the possible decimals to all of the possible integers
Possible_Avg_Awards <- l[l <= 10] # only want values less than or equal to 10 (the max possible score)

We also need a list of each dive and its degree of difficulty. FINA, the international governing body for diving (and swimming) publishes such a list. I’ve formatted it for our use, and hosted it on github.

Our first step is to read the dives and DDs into R. For this study we’ll be working with “forward” dives, that is dives done using a forward approach and involving a number of half somersaults (flips). Each dive has a number in addition to an equivalent name. The numbers for forward dives are three digits long and always begins with a “1” The second digit is either a “0”, for standard forward dives, or a “1”, for “flying” dives. We’re only going to look at standard forward dives, so our first two digits will be “10”. The last digit encodes the number of half somersaults the dive entails. So a third digit of “1” means forward dive, standard, one-half somersault. A half somersault means the diver, who begins standing upright, will flip 180 degrees, and enter the water head first. Similarly in a “102” dive the diver will begin standing upright, do two half somersaults (i.e. one full somersault), for a total flip of 360 degrees, entering the water feet first. There’s a progression here, “10X” series dives become more difficult, and have higher DDs as “X” increments from 1 to a maximum of “9”, requiring more half somersaults. We’ll also restrict ourselves to dives in the “tuck” position for the sake of consistent comparisons across dives.

DDs_Link <- "https://raw.githubusercontent.com/gpilgrim2670/Pilgrim_Data/master/Diving_DDs.csv"
Forward_DDs <- read.csv(url(DDs_Link)) %>% 
  filter(Number <= 109, # only forward dives, no twists, no flying position
         Board == "1m") %>%  # only looking at dives from a 1 meter high springboard
  select(Number, Name, "DD" = C) # only want dives in the "C" - that is "tuck" position

Calculating Possible Scores for Each Dive

Now that we have the dives and DDs, we’d like to know what scores are possible for each dive. For each dive we’ll multiply the DD by each of the possible average awards to get a list of possible scores for each dive. We’ll collect those lists together into a data frame containing the average judges’ award, the DD, the and the corresponding score for each dive.

# here's we'll get a list of nine lists.  Each list is all the possible scores for a specific dive
Scores_List <- map(Forward_DDs$DD, function(x, y) {x * Possible_Avg_Awards * 3})

# name each list with the dive number it corresponds to
names(Scores_List) <- Forward_DDs$Number

Scores_List <- Scores_List %>%
  bind_rows() %>% #stick the lists together
  bind_cols(Possible_Avg_Awards) %>% # add a column containing the list of possible average judge's awards
  pivot_longer(names_to = "Number",
               cols = starts_with("1"),
               values_to = "Total_Score") %>% # go from wide to long format by creating a new column called
  # number containing each dive number, and a new column called Total_Score containing each possible score
  rename(Award = "...10") %>% # rename our average judge award column to something sensible
  mutate(Number = as.numeric(Number)) # will need dive number as a number later

Embedded in Scores_List is the maximum possible score for each dive. We’d like to make this information available in a tidy way since we’ll be relying on various tidyverse packages like ggplot2 for visualization later. Similarly we want the maximum dive of the previous dive in the series as well, so we can look at moving up/down in the dive series.

Scores_List <- Forward_DDs %>% 
  mutate(Max_Award = DD * 30, # maximum possible score is the DD times 3 10s
         Prev_Max = lag(Max_Award)) %>%  # maximum possible score for the previous dive in the forward series
  right_join(Scores_List) %>%  # attach data frame of all possible scores
  mutate(Name = factor(Name, levels = unique(Forward_DDs$Name)), # make Name a factor so we can order it on plots
         Dive_Label = paste0(as.character(Number), "C: ", Name)) # combines dive name and number

If we compare for example the maximum possible points for a 101C, (36) and then look at the next dive in the series, a 102C which has a DD of 1.4 we can determine what judges’ award would be needed on a 102C to score more than the maximum possible score on a 101C. That number is the max score for a 101C, divided by the DD for a 102C, divided by 3 (for the three judges), so 36, divided by 1.4 divided by 3, which is 8.57. However, 8.57 isn’t actually possible as an average judges’ score. It’s not on our Possible_Avg_Awards list. So we need a way to go from our computed number to the nearest, higher possible score.

Award_Match <- function(x, D_D = DD, Pos = Possible_Avg_Awards) {
  Pos[base::findInterval(x / (D_D) / 3, Pos) + 1] # matches the next highest element of Possible_Avg_Awards, by adding one to the match
}

So the actual possible combination of judges awards that makes a 102C worth more points than are possible to score when diving a 101C is 8.67.

Possible Points for Each Dive

There’s a linear relationship between judges’ award and possible score for each dive, dictated by that dive’s DD, which is the slope of each line in the plot below.

Scores_List %>%
  ggplot() +
  geom_line(aes(
    x = Award,
    y = Total_Score,
    color = as.factor(Dive_Label), # naturally ordered by the numeric portion 101, 102 etc.
    group = as.factor(Dive_Label)
  )) +
  scale_x_continuous(breaks = seq(0, 10 , 1)) +
  scale_y_continuous(breaks = seq(0, 150 , 25)) +
  labs(color = "Dive",
       y = "Total Score") +
  theme_bw()

Since judges’ awards are limited to a maximum of 10 (total 30), each dive then has a maximum possible score. For a diver to improve their total score it eventually becomes necessary to perform a harder dive, with a correspondingly higher DD, and higher maximum score. Where exactly are these crossover points though?

Crossover Points

As we saw for the 101C/102C case above there’s a point, corresponding to a possible combination of judges’ awards, for each pair of dives where the dive with the higher DD becomes mathematically more valuable in terms of points scored than the lower DD dive. We’ll plot that point of strict mathematical superiority for each neighbor-pair of dives in the forward dive series. That means 101C and 102C are a pair, 102C and 103C, 103C and 104C etc.

Scores_List %>%
  ggplot() +
  geom_line(aes(x = Award,
                y = Total_Score,
                group = Number)) +
  geom_segment(aes(
    x = 0,
    xend = Award_Match(Prev_Max, DD, Possible_Avg_Awards),
    y = Award_Match(Prev_Max, DD, Possible_Avg_Awards) * 3 * DD,
    yend = Award_Match(Prev_Max, DD, Possible_Avg_Awards) * 3 * DD
  ),
  color = "blue") +
  geom_segment(aes(
    x = Award_Match(Prev_Max, DD, Possible_Avg_Awards),
    xend = Award_Match(Prev_Max, DD, Possible_Avg_Awards),
    y = 0,
    yend = Award_Match(Prev_Max, DD, Possible_Avg_Awards) * 3 * DD
  ),
  color = "blue") +
  geom_point(aes(
    x = Award_Match(Prev_Max, DD, Possible_Avg_Awards),
    y = Award_Match(Prev_Max, DD, Possible_Avg_Awards) * 3 * DD
  ),
  color = "blue",
  alpha = 0.5) +
  scale_x_continuous(breaks = seq(0, 10 , 1)) +
  scale_y_continuous(breaks = seq(0, 150 , 25)) +
  facet_wrap(. ~ Dive_Label) +
  labs(y = "Total Score") +
  theme_bw()

Each point on the plot above is the score a diver must achieve on a given dive to score mathematically more points on that dive than would be possible on the previous dive. The 101C doesn’t have a point drawn because there is not a previous dive to compare to - it’s the first dive. Let’s pull out just these points.

Scores_List %>%
  group_by(Name) %>%
  mutate(
    Slope = lm(Award ~ (Total_Score))$coefficients[2],
    Award_Cross = Award_Match(Prev_Max, DD, Possible_Avg_Awards)
  ) %>%
  summarise(Award_Cross = unique(Award_Cross)) %>%
  ggplot() +
  geom_point(aes(x = Name, y = Award_Cross)) +
  scale_x_discrete(labels = unique(Scores_List$Dive_Label)) + 
  scale_y_continuous(breaks = seq(7, 10.5, 0.5)) +
  coord_cartesian(ylim = c(7, 10)) +
  theme_bw() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
  labs(y = "Judge's Award Crossing Point",
       x = "Dive")

We can see that FINA believes going from an odd number of half somersaults (10X, X is odd) to an even number is harder than going even to odd, because the strict points for switching to even dive numbers are much lower than the strict points for switching to odd dive numbers.

Changing Dives

Here’s the thing though - most divers don’t expect (or deserve) 10s on the dives they do. That might sound unfair coming from an official, but consider the case of a hypothetical diver, Riley Ripit. Let’s say Riley can do a 101C for 10s, scoring a total of 36 points. She goes to a meet, dives as planned, gets her 10s and her 36 points. Great! The next week she goes to another meet and dives even better. Her height off the board is higher, her rotation in the air is faster, her entry is perfect, she’s on fire! She still gets 10s though, because that’s the maximum possible award. She has no upside risk in her dive. Of course if she goes to a third meet and has a bad day, she can get lower than 10s, much lower even. That’s to say she has a lot of downside risk. This is a bad situation to be in. What she wants is to do a harder dive, with an approximately equivalent expected score (36 points), but with some upside risk, so if she dives better than expected she can score more points. Also if she dives poorly she won’t fall as low, meaning less downside risk. A similar argument is possible with 9.5s. If Riley expects 9.5s, and dives well she can only get a little award bump, up to 10s. Ideally she’d plan her dives to have upside risk and minimal downside risk, although exactly how much she wants of either is between her and her coach. This is the answer to today’s overall question about the lack of 10s though - we don’t see many 10s in diving competitions because it doesn’t make sense from the diver’s side to aim for 10s. Still, it’s a dream of mine to one day award some deserving diver a 10.

It would be useful to know, given a dive done for a particular average judges’ award, what award a new dive would need to be done for to make a switch worth considering. Let’s make a function to do that.

dive_calc <- function(current_dive, new_dive, current_award, FDDs = Forward_DDs, Pos = Possible_Avg_Awards){
  # given an incumbent dive and an incumbent average score, what average score would be required on a given new dive to get at least the same total number of points
  current_DD <- FDDs[FDDs$Number == current_dive, ]$DD # get DD on current dive
  new_DD <- FDDs[FDDs$Number == new_dive, ]$DD # get DD of new dive
  new_award <- (current_award * current_DD)/new_DD # calculate score where two dives are equivalent
  new_award_switch <- round(Pos[base::findInterval(new_award, Pos) + 1], 2) # convert score to possible award

  return(new_award_switch)
}

We can use our function to determine the equivalence point between a 103C done for 5.5s and a 104C.

round(dive_calc(current_dive = 103, new_dive = 104, current_award = 5.5, FDDs = Forward_DDs, Pos = Possible_Avg_Awards), 2)

## [1] 4.17

Let’s also look a every possible switching point for a given pair of dives by mapping dive_calc across every possible judges’ award.

New_Dive <-
  unlist(map(Possible_Avg_Awards, dive_calc, current_dive = 103, new_dive = 104)) %>%
  bind_cols(Possible_Avg_Awards)

New_Dive %>% 
  ggplot() +
  geom_point(aes(x = `...2`,
                 y = `...1`)) +
  scale_x_continuous(breaks = seq(0,10,1)) +
  scale_y_continuous(breaks = seq(0,10,1)) +
  labs(x = "Current Dive Award",
      y = "New Dive Award to Switch") +
  theme_bw()

The plot isn’t exactly linear, because not every score is available, due to the limited set of possible judges’ awards.

Conclusions

We answered our initial question about the dearth of 10s in diving competitions by examining upside risk from the diver’s perspective. Going into a competition expecting 10s doesn’t leave any upside risk, so unless a diver can do the most difficult dives available perfectly (like in the Olympics) doing more difficult, higher DD dives for lower expected judges’ awards makes more sense than aiming for 10s on easier dives.

More mathematically we’ve seen two reasons why a diver might change their dive. The first, strict mathematical superiority, is an absolutely iron clad reason, but it’s quite rare in practice. The second, a desire for more upside risk, dominates in real life. That said, learning a new dive isn’t trivial, and it’s possible that for a particular diver/dive it might be wiser to improve an existing dive rather than attempt to learn a new one. I’m not a diving coach and I don’t know how to weigh those two options. If you are a diving coach or have some theories, write in or leave a comment and maybe that will be the focus of another post here at Swimming (and also diving) + Data Science.

High School Swimming State Off Tournament Conclusion and Battle Royale

Thu, 24 Sep 2020 00:00:00 +0000

Welcome to the final post in the State-Off Tournament series. This will be a battle royale meet, with each of the 8 State-Off states competing against all the others at once (or in swimming terms, this is an invitational style meet). We’ll also reexamine the seeding assumptions from the beginning of the State-Off and discuss how Pearson’s and Spearman’s correlation tests work. Before we begin though let’s look back at a few of the highlights from the past two+ months.

The basic premise was simple - use the SwimmeR package to collect data from each of the 8 states, and pit the 8 states against each other in a single elimination tournament. For 7 of the 8 states the data collection process went smoothly. We pulled data from pdf files, from Hy-Tek real time results web pages and from single sheet web pages without issue. Georgia though was a problem and we discussed their failings extensively https://pilgrim.netlify.app/post/high-school-swimming-state-off-tournament-california-1-vs-georgia-8/.

We had an upset in the very first meet, when fifth seeded Pennsylvania knocked off its northern neighbor, 4th seeded New York. We discussed possible explanations, including differences in population distribution.

Over the first round we worked on functionalizing bits of our code, including building a function to score swim meets. That results_score function formed the basis of SwimmeR::results_score, released in version 0.4.1 between rounds one and two.

A meet between second seeded Texas and seventh seeded Ohio was also the beginning of a tournament long discussion of outdoor swimming in the San Francisco Bay Area and just how unsuitable the climate is. This eventually lead to pulling data from the National Weather Service and later some commentary from a friend of mine via a remixed Peanuts cartoon.

The second round shifted focus from importing results with SwimmeR to working with them, and doing some statistical hypothesis testing. We checked out DQ rates by event and wondered aloud about the moral fiber of breaststrokers. We also determined that seniors really do rule, at least in one particular meet between California (1) and Pennsylvania (5).

In the championship, between California (1) and Texas (2) we also looked at drops between prelims and finals, and determined they really do happen, but that place matters a whole lot in determining their magnitude.

That’s enough recapping. Let’s get started on today’s meet!

library(SwimmeR)
library(purrr)
library(dplyr)
library(stringr)
library(flextable)
library(ggplot2)

Please note the following analysis was updated November 22nd 2020 to reflect changes beginning with SwimmeR v0.6.0 released via CRAN on November 22nd 2020. Please make sure your version of SwimmeR is up-to-date.

My flextable styling function is still working great since I made it three weeks ago. I’m not changing it. I’m not even really changing this paragraph. Reusable code/content for life!

flextable_style <- function(x) {
  x %>%
    flextable() %>%
    bold(part = "header") %>% # bold header
    bg(bg = "#D3D3D3", part = "header") %>% # puts gray background behind the header row
    autofit()
}

Getting Results

After the first round where we used SwimmeR::read_results and SwimmeR::swim_parse to get and clean our data respectively I kept it all, and stored it all on github. Let’s get this thing underway by grabbing those results. First step is just to list out links to each data set.

CA_Link <-
  "https://raw.githubusercontent.com/gpilgrim2670/Pilgrim_Data/master/CA_States_2019.csv"

TX_Link <-
  "https://raw.githubusercontent.com/gpilgrim2670/Pilgrim_Data/master/TX_States_2020.csv"

FL_Link <- "https://raw.githubusercontent.com/gpilgrim2670/Pilgrim_Data/master/FL_States_2020.csv"

NY_Link <- "https://raw.githubusercontent.com/gpilgrim2670/Pilgrim_Data/master/NY_States_2020.csv"

PA_Link <- "https://raw.githubusercontent.com/gpilgrim2670/Pilgrim_Data/master/PA_States_2020.csv"

IL_Link <- "https://raw.githubusercontent.com/gpilgrim2670/Pilgrim_Data/master/IL_States_2020.csv"

OH_Link <- "https://raw.githubusercontent.com/gpilgrim2670/Pilgrim_Data/master/OH_States_2020.csv"

Links <- c(CA_Link, TX_Link, FL_Link, NY_Link, PA_Link, IL_Link, OH_Link)

Georgia of course is a special case because their results reporting is so bad.

GA_Link <- "https://raw.githubusercontent.com/gpilgrim2670/Pilgrim_Data/master/GA_States_2020.csv"
GA_Results <- read.csv(url(GA_Link)) %>% 
  rename("Grade" = Age, Finals_Time = "Time") %>% 
  mutate(State = "GA",
         Grade = as.character(Grade),
         Exhibition = 0,
         DQ = 0,
         Finals_Time = str_remove(Finals_Time, "^0"))

Now that we have our links we’ll read them all in together by mapping a reading function across the list of links.

Read_Links <- function(x) {
  df <- read.csv(url(x)) %>% # reads each CSV file
    mutate(Grade = as.character(Grade)) # some states use FR/SO etc. for grade, others use 9, 10 - need column to be all the same type
  return(df)
}

Results <- map(Links, Read_Links) %>%
  bind_rows(GA_Results) %>% # add in GA results
  mutate(Gender = case_when( # create gender column to score boys and girls meet
    str_detect(Event, "Girls") == TRUE ~ "Girls",
    str_detect(Event, "Boys") == TRUE ~ "Boys"
  )) %>%
  mutate( # slightly different event naming for some states
    Event = str_replace(Event, "Boys 1m Diving", "Boys 1 mtr Diving"),
    Event = str_replace(Event, "Girls 1m Diving", "Girls 1 mtr Diving")
  ) %>%
  filter(str_detect(Event, "AWD") == FALSE, # remove events outside the standard 12 each for boys and girls
         str_detect(Event, "Swim-off") == FALSE) %>% 
  rename("Team" = "School",
         "Age" = "Grade")

Scoring the Meet

We’ll use SwimmeR::results_score to score each swim, then collect the scores to get overall totals for each state, by gender.

Results_Final <- results_score(
  results = Results,
  events = unique(Results$Event), # want to score all events
  meet_type = "timed_finals",
  lanes = 8,
  scoring_heats = 2,
  point_values = c(20, 17, 16, 15, 14, 13, 12, 11, 9, 7, 6, 5, 4, 3, 2, 1)
)

Scores <- Results_Final %>%
  group_by(State, Gender) %>% # score for each state and gender
  summarise(Score = sum(Points)) %>% 
  group_by(Gender) %>% 
  group_split() # new dataframe for boys and girls

Boys Scores

Scores[[1]] %>%
  arrange(desc(Score)) %>%
  mutate(Place = rank(desc(Score), ties.method = "min")) %>%
  select(Place, State, Score) %>%
  flextable_style()

Girls Scores

Scores[[2]] %>%
  arrange(desc(Score)) %>%
  mutate(Place = rank(desc(Score), ties.method = "min")) %>%
  select(Place, State, Score) %>%
  flextable_style()

Overall Scores

Combined_Scores <- Scores %>%
  bind_rows %>%
  group_by(State) %>%
  summarise(Score = sum(Score, na.rm = TRUE)) %>%
  arrange(desc(Score)) %>%
  mutate(Place = rank(desc(Score), ties.method = "min")) %>% # using rank here is important because we actually do have a tie
  select(Place, State, Score)

Combined_Scores %>% 
  flextable_style()

California wins again, but the real story here is Ohio. Ohio was seeded 7th, but finished 2nd today. The heroes for Ohio were the boys from Cincinnati St Xavier, who won all three relays and scored 120 points in doing so.

Results_Final %>%
  filter(is.na(Name) == TRUE,
         Team == "Cincinnati St Xavier") %>%
  select(Place, Team, Finals_Time, Event, Points) %>%
  flextable_style()

Testing Seeding Assumptions

Original Assumption

Way back in July, when the State-Off started I made the decision to seed states based on their population. The assumption, which seemed reasonable at the time, was that states with larger populations would have a larger population pool (heh heh) from which to draw potential swimmers, and thus would have more, faster, swimmers than less populous states. Seeding by population made sense, with more populous states expected to defeat less populous ones.

Pop_Data <- read.csv("http://www2.census.gov/programs-surveys/popest/datasets/2010-2019/national/totals/nst-est2019-alldata.csv?#") # download data
Seeds <- Pop_Data %>%
  mutate(STATE = as.numeric(STATE)) %>%
  filter(STATE >= 1) %>%
  select(NAME, POPESTIMATE2019) %>% # get populations
  arrange(desc(POPESTIMATE2019)) %>%
  top_n(8) %>% # cut down to top 8 most populated states
  mutate(Seed = 1:n(),
         POPESTIMATE2019 = round(POPESTIMATE2019 / 1000000, 2)) %>%
  select(Seed, "State" = NAME, "Population_mil" = POPESTIMATE2019) %>% 
  mutate(State = state.abb[match(State,state.name)]) # convert names (California) to abbreviations (CA)

Seeds %>% 
  flextable_style()

Actual Results

In the head-to-head matchups that followed my original assumption was largely born out. There was only one upset, when 5th seeded Pennsylvania upset 4th seeded New York. Otherwise more populous states did defeat less populous ones. Today’s results however don’t show the same trend between population and score, or seed and place.

Score_Pop <- Combined_Scores %>% 
  left_join(Seeds, by = "State")

Score_Pop %>%
  ggplot(aes(x = Population_mil, y = Score)) +
  geom_point(aes(color = State)) +
  geom_smooth(method = "lm") + # add linear fit line, with standard error
  theme_bw()

Score_Pop %>% 
  ggplot(aes(x = Seed, y = Place)) +
  geom_point(aes(color = State)) +
  geom_smooth(method = "lm") + # add linear fit line, with standard error
  theme_bw()

There doesn’t look to be any particular relationship between either population and score, or seed and actual order of finish (place). Population vs. score looks more linear, but I suspect that’s just because California is so far in the upper right corner that it’s just dragging the fit out. We can, should, and in fact will, do some testing to confirm though. One possible relationship between to variables is a linear relationship. There are of course other relationships, but let’s focus on linearity for a moment.

To be clear, my original assumption when I devised the seeding wasn’t that population and score would be linearly related - it was more general. I assumed that score would increase as population increased. The increase could be linear, but could also be exponential, cubic, etc., any of which would have justified population as a seeding mechanism. Built into that original assumption though was a second assumption, which is linear. I assigned seeds based on population, and then earlier in this post we assigned places based on score. Seed and place are in effect ordinal values corresponding to the numeric values of population and score respectively, and if score does increase with population than seed and place should have a linear relationship. We can see such a relationship below. The fit line from geom_smooth intersects each point perfectly. Standard error is also enabled, as in the plots above, but doesn’t show up, because there is no error. The linear fit is literally perfect.

df <- data.frame(Seed = seq(1, 8, 1),
                 Place = seq(1, 8, 1))

df %>% 
  ggplot(aes(x = Seed, y = Place)) +
  geom_point(size = 2) +
  geom_smooth(method = "lm") +
  theme_bw()

Correlation Testing

I bring all this up because R has the built in function cor.test, which we can use to test for linear correlation. In addition to arguments specifying each of the two variables under test, cor.test also has an argument called method, used to specify the exact statistical test used. The two tests we’ll consider here are Pearson’s (method = "pearson", the default) and Spearman’s (method = "spearman"). Pearson’s test assumes that 1. There is a linear relationship between the two variables. Again, this is the case for seed/place, but need not be for population/score 2. The variables are normally distributed. Let’s test for this.

shapiro.test(Score_Pop$Score)

## 
##  Shapiro-Wilk normality test
## 
## data:  Score_Pop$Score
## W = 0.81856, p-value = 0.04507

shapiro.test(Score_Pop$Population_mil)

## 
##  Shapiro-Wilk normality test
## 
## data:  Score_Pop$Population_mil
## W = 0.85247, p-value = 0.1009

The null assumption for shapiro.test is that the variable is normally distributed. We see that for Score_Pop$Score and Score_Pop$Population_mil the p-values are 0.045 and 0.101 respectively. The value for Score is less than 0.05, so we can reject the null hypothesis and conclude Score is not normally distributed. Between that and the need-not-be-linear relationship between population and score Pearson’s test is out.

That leaves Spearman’s. Spearman’s test does not require variables to be normally distributed, and it doesn’t require a the assumption of a linear relationship between variables. This is because Spearman’s uses a rank method, ordering each variable, assigning a rank, and checking for correlation between those ranks. This sounds a lot like what we’ve already done, ranking population and assigning seed, and ranking score and assigning place. The null hypothesis for Spearman’s test is that there is not a linear relationship between the two variables.

Spearman_Place_Seed <- cor.test(Score_Pop$Place, Score_Pop$Seed, method = "spearman")
Spearman_Place_Seed

## 
##  Spearman's rank correlation rho
## 
## data:  Score_Pop$Place and Score_Pop$Seed
## S = 53.82, p-value = 0.3821
## alternative hypothesis: true rho is not equal to 0
## sample estimates:
##       rho 
## 0.3592879

Spearman_Score_Pop <- cor.test(Score_Pop$Score, Score_Pop$Population_mil, method = "spearman")
Spearman_Score_Pop

## 
##  Spearman's rank correlation rho
## 
## data:  Score_Pop$Score and Score_Pop$Population_mil
## S = 53.82, p-value = 0.3821
## alternative hypothesis: true rho is not equal to 0
## sample estimates:
##       rho 
## 0.3592879

For both tests our p-value is 0.382, greater than 0.05. We cannot reject the null hypothesis, and so we conclude there is not a linear relationship between seed and place, or between population and score, in today’s meet. Not only are our p-values the same for each test, Our Spearman’s test results are in fact exactly the same, which we can confirm. First, let’s look at the structure:

str(Spearman_Place_Seed)

## List of 8
##  $ statistic  : Named num 53.8
##   ..- attr(*, "names")= chr "S"
##  $ parameter  : NULL
##  $ p.value    : num 0.382
##  $ estimate   : Named num 0.359
##   ..- attr(*, "names")= chr "rho"
##  $ null.value : Named num 0
##   ..- attr(*, "names")= chr "rho"
##  $ alternative: chr "two.sided"
##  $ method     : chr "Spearman's rank correlation rho"
##  $ data.name  : chr "Score_Pop$Place and Score_Pop$Seed"
##  - attr(*, "class")= chr "htest"

Each result has 8 elements, the last of which are the variable names. These will of course be different between tests, because we’re testing different variables. Everything else though is either a result of the test, or an input to the test. We can thus compare everything except the 8th element and expect them to be identical.

identical(Spearman_Place_Seed[1:7], Spearman_Score_Pop[1:7])

## [1] TRUE

The test results are identical because the Spearman’s test does to population and score what we already did in assigning seed and place. As for the test results, correlations are of course not the same as causations. Even if population and score had been correlated for today’s meet we wouldn’t be able to prove that higher population actually causes faster swims and higher scores. For today’s meet population proves to not have a linear relationship with score, nor does another relationship readily present itself.

Swimmers of the Meet

Swimmer of the Meet criteria is still the same as it’s been for the entire State-Off. We’ll look for athletes who have won two events, thereby scoring a the maximum possible forty points. In the event of a tie, where multiple athletes win two events, we’ll use All-American standards as a tiebreaker.

Cuts_Link <-
  "https://raw.githubusercontent.com/gpilgrim2670/Pilgrim_Data/master/State_Cuts.csv"
Cuts <- read.csv(url(Cuts_Link))

Cuts <- Cuts %>% # clean up Cuts
  filter(Stroke %!in% c("MR", "FR", "11 Dives")) %>% # %!in% is now included in SwimmeR
  rename(Gender = Sex) %>%
  mutate(
    Event = case_when((Distance == 200 & #match events
                         Stroke == 'Free') ~ "200 Yard Freestyle",
                      (Distance == 200 &
                         Stroke == 'IM') ~ "200 Yard IM",
                      (Distance == 50 &
                         Stroke == 'Free') ~ "50 Yard Freestyle",
                      (Distance == 100 &
                         Stroke == 'Fly') ~ "100 Yard Butterfly",
                      (Distance == 100 &
                         Stroke == 'Free') ~ "100 Yard Freestyle",
                      (Distance == 500 &
                         Stroke == 'Free') ~ "500 Yard Freestyle",
                      (Distance == 100 &
                         Stroke == 'Back') ~ "100 Yard Backstroke",
                      (Distance == 100 &
                         Stroke == 'Breast') ~ "100 Yard Breaststroke",
                      TRUE ~ paste(Distance, "Yard", Stroke, sep = " ")
    ),
    
    Event = case_when(
      Gender == "M" ~ paste("Boys", Event, sep = " "),
      Gender == "F" ~ paste("Girls", Event, sep = " ")
    )
  )

Ind_Swimming_Results <- Results_Final %>%
  filter(str_detect(Event, "Diving|Relay") == FALSE) %>% # join Ind_Swimming_Results and Cuts
  left_join(Cuts %>% filter((Gender == "M" &
                               Year == 2020) |
                              (Gender == "F" &
                                 Year == 2019)) %>%
              select(AAC_Cut, AA_Cut, Event),
            by = 'Event')

Swimmer_Of_Meet <- Ind_Swimming_Results %>%
  mutate(
    AA_Diff = (Finals_Time_sec - sec_format(AA_Cut)) / sec_format(AA_Cut),
    Name = str_to_title(Name)
  ) %>%
  group_by(Name) %>%
  filter(n() == 2) %>% # get swimmers that competed in two events
  summarise(
    Avg_Place = sum(Place) / 2,
    AA_Diff_Avg = round(mean(AA_Diff, na.rm = TRUE), 3),
    Gender = unique(Gender),
    State = unique(State)
  ) %>%
  arrange(Avg_Place, AA_Diff_Avg) %>%
  group_split(Gender) # split out a dataframe for boys (1) and girls (2)

Boys

Swimmer_Of_Meet[[1]] %>%
  slice_head(n = 5) %>%
  select(-Gender) %>%
  ungroup() %>%
  flextable_style()

Jake Magahey is a fresh face in the Swimmer of the Meet arena. He didn’t win any Swimmer of the Meet crowns during the State-Off Rounds. He wasn’t ever even runner up. Here he is though, top of the heap, in the State-Off Battle Royale. Maybe we didn’t predict it, but that’s why they play the games. On the other hand he was tied for first in the CollegeSwimming 2020 cycle rankings so maybe we could have predicted it after all. Congratulations to Jake!

Results_Final %>%
  filter(Name == "Magahey, Jake") %>%
  select(Place, Name, Team, Finals_Time, Event) %>%
  arrange(desc(Event)) %>%
  ungroup() %>%
  flextable_style()

Girls

Swimmer_Of_Meet[[2]] %>%
  slice_head(n = 5) %>%
  select(-Gender) %>%
  ungroup() %>%
  flextable() %>%
  bold(part = "header") %>%
  bg(bg = "#D3D3D3", part = "header") %>%
  autofit()

Meet the new boss, same as the old boss. Zoie Hartman is well known around these parts, as she swept all the Swimmer of the Meet crowns in the standard tournament. Today is no different, in fact it’s a replay of the California vs. Texas championship meet where Zoie edged out Lillie Nordmann. Congratulations again to Zoie for an extremely successful State-Off run!

Results_Final %>%
  filter(Name == "Hartman, Zoie") %>%
  select(Place, Name, Team, Finals_Time, Event) %>%
  arrange(desc(Event)) %>%
  ungroup() %>%
  flextable_style()

In Closing

This was the last meet, and last post, in the State-Off Tournament. It’s been a great ride. I’m not going to say it was as much fun as the Olympics, but at least it was something for these swimming-less months. Hopefully you’ve had some fun, and maybe learned a bit along the way - I know I have! Next week we’ll be switching gears and talking about diving math here at Swimming + Data Science. We’ll see you then!

High School Swimming State-Off Tournament Championship California (1) vs. Texas (2)

Thu, 17 Sep 2020 00:00:00 +0000

This is it folks, the big one, the finals of the State-Off Tournament, where we’ll see California (1) take on Texas (2) for high school swimming superiority. We’ll also use a t-test to determine whether or not swimmers actually swim faster in finals sessions, when the pressure is on. Oh and it’s so on!

library(SwimmeR)
library(dplyr)
library(stringr)
library(flextable)
library(ggplot2)

My flextable styling function is still working great since I made it two weeks ago. In the finals you’ve just gotta stick with what works.

flextable_style <- function(x) {
  x %>%
    flextable() %>%
    bold(part = "header") %>% # bold header
    bg(bg = "#D3D3D3", part = "header") %>% # puts gray background behind the header row
    autofit()
}

Getting Results

The suspense is killing me here! Let’s get this thing underway by grabbing results from github.

California_Link <-
  "https://raw.githubusercontent.com/gpilgrim2670/Pilgrim_Data/master/CA_States_2019.csv"
California_Results <- read.csv(url(California_Link)) %>% 
  mutate(State = "CA")

Texas_Link <-
  "https://raw.githubusercontent.com/gpilgrim2670/Pilgrim_Data/master/TX_States_2020.csv"
Texas_Results <- read.csv(url(Texas_Link)) %>% 
  mutate(State = "TX",
         Grade = as.character(Grade))

Results <- California_Results %>%
  bind_rows(Texas_Results) %>%
  mutate(Gender = case_when(
    str_detect(Event, "Girls") == TRUE ~ "Girls",
    str_detect(Event, "Boys") == TRUE ~ "Boys"
  )) %>% 
  rename("Age" = Grade,
         "Team" = School)

Scoring the Meet

Results_Final <- results_score(
  results = Results,
  events = unique(Results$Event),
  meet_type = "timed_finals",
  lanes = 8,
  scoring_heats = 2,
  point_values = c(20, 17, 16, 15, 14, 13, 12, 11, 9, 7, 6, 5, 4, 3, 2, 1)
)

Scores <- Results_Final %>%
  group_by(State, Gender) %>%
  summarise(Score = sum(Points))

Scores %>%
  arrange(Gender, desc(Score)) %>%
  ungroup() %>%
  flextable_style()

Scores %>%
  group_by(State) %>%
  summarise(Score = sum(Score)) %>%
  arrange(desc(Score)) %>%
  ungroup() %>%
  flextable_style()

In an outcome that many of you probably predicted ahead of time, California (1) lives up to their number one ranking and secures State-Off Tournament crown over Texas (2). Just because it was expected though doesn’t meet it’s not impressive. This meet was super fast. Let’s look at some individual performances and name our Swimmers of the Meet.

Swimmers of the Meet

Two swimmers come into this meet on Swimmer of the Meet streaks. Lillie Nordmann has won two in row for the Texas girls, and Zoie Hartman has won two in a row for the California girls. Swimmer of the Meet criteria is still the same as it’s been for the entire State-Off. We’ll look for athletes who have won two events, thereby scoring a the maximum possible forty points. In the event of a tie, where multiple athletes win two events, we’ll use All-American standards as a tiebreaker.

Cuts_Link <-
  "https://raw.githubusercontent.com/gpilgrim2670/Pilgrim_Data/master/State_Cuts.csv"
Cuts <- read.csv(url(Cuts_Link))

Cuts <- Cuts %>% # clean up Cuts
  filter(Stroke %!in% c("MR", "FR", "11 Dives")) %>% # %!in% is now included in SwimmeR
  rename(Gender = Sex) %>%
  mutate(
    Event = case_when((Distance == 200 & #match events
                         Stroke == 'Free') ~ "200 Yard Freestyle",
                      (Distance == 200 &
                         Stroke == 'IM') ~ "200 Yard IM",
                      (Distance == 50 &
                         Stroke == 'Free') ~ "50 Yard Freestyle",
                      (Distance == 100 &
                         Stroke == 'Fly') ~ "100 Yard Butterfly",
                      (Distance == 100 &
                         Stroke == 'Free') ~ "100 Yard Freestyle",
                      (Distance == 500 &
                         Stroke == 'Free') ~ "500 Yard Freestyle",
                      (Distance == 100 &
                         Stroke == 'Back') ~ "100 Yard Backstroke",
                      (Distance == 100 &
                         Stroke == 'Breast') ~ "100 Yard Breaststroke",
                      TRUE ~ paste(Distance, "Yard", Stroke, sep = " ")
    ),
    
    Event = case_when(
      Gender == "M" ~ paste("Boys", Event, sep = " "),
      Gender == "F" ~ paste("Girls", Event, sep = " ")
    )
  )

Ind_Swimming_Results <- Results_Final %>%
  filter(str_detect(Event, "Diving|Relay") == FALSE) %>% # join Ind_Swimming_Results and Cuts
  left_join(Cuts %>% filter((Gender == "M" &
                               Year == 2020) |
                              (Gender == "F" &
                                 Year == 2019)) %>%
              select(AAC_Cut, AA_Cut, Event),
            by = 'Event')

Swimmer_Of_Meet <- Ind_Swimming_Results %>%
  mutate(
    AA_Diff = (Finals_Time_sec - sec_format(AA_Cut)) / sec_format(AA_Cut),
    Name = str_to_title(Name)
  ) %>%
  group_by(Name) %>%
  filter(n() == 2) %>% # get swimmers that competed in two events
  summarise(
    Avg_Place = sum(Place) / 2,
    AA_Diff_Avg = round(mean(AA_Diff, na.rm = TRUE), 3),
    Gender = unique(Gender),
    State = unique(State)
  ) %>%
  arrange(Avg_Place, AA_Diff_Avg) %>%
  group_split(Gender) # split out a dataframe for boys (1) and girls (2)

Boys

Swimmer_Of_Meet[[1]] %>%
  slice_head(n = 5) %>%
  select(-Gender) %>%
  ungroup() %>%
  flextable_style()

Ethan Hu leads a California sweep en route to winning his second Swimmer of the Meet title, following the one he earned against Georgia (8) in the first round. Ethan of course now swims for Stanford, and those of you who have been following along know that Stanford is something of trigger for me. The great school and swim program aside, I’m genuinely confused as to why anyone wants to swim outdoors in the sneakily cold Bay Area. I’ve mentioned before that I used to live, and swim, in the Bay. I hated the cold and complained about it so much that a non-swimming, long-suffering, friend was inspired to remix this Peanuts cartoon about it.

Anyways, here’s Ethan’s results:

Results_Final %>%
  filter(Name == "Hu, Ethan") %>%
  select(Place, Name, Finals_Time, Event) %>%
  arrange(desc(Event)) %>%
  ungroup() %>%
  flextable_style()

Girls

Swimmer_Of_Meet[[2]] %>%
  slice_head(n = 5) %>%
  select(-Gender) %>%
  ungroup() %>%
  flextable() %>%
  bold(part = "header") %>%
  bg(bg = "#D3D3D3", part = "header") %>%
  autofit()

Zoie Hartman just beats out Lillie Nordmann to win her third Swimmer of the Meet crown - the most by any athlete in the whole State-Off Tournament! A hearty congratulations to Zoie on what I’m sure she considers the crowning achievement of her swimming career thus far. Zoie is from Danville CA, a town quite near the Bay Area, but she swims for the University of Georgia, which unlike Stanford, and the Bay in general, is nice and warm while also having a lovely indoor pool. Zoie just might be my favorite athlete in this entire meet. She’s truly the embodiment of everything the State-Off stands for - being super fast and also grousing about how Northern California is to cold for outdoor swimming. Here are her results:

Results_Final %>%
  filter(Name == "Hartman, Zoie") %>%
  select(Place, Name, Finals_Time, Event) %>%
  arrange(desc(Event)) %>%
  ungroup() %>%
  flextable_style()

Prelims-Finals Drops

My memories of swimming in finals at prelims-finals meets are mixed. Sometimes I remember feeling really jazzed up and energized by the finals atmosphere. Other times my memories are of being tired, worn out by the slog of the previous sessions. Memory is a tricky thing though - can’t always trust it. Instead of looking inward, into the murk of my mind, let’s instead look at the data and try to answer the question - do swimmers swim faster in finals than they do in prelims? We’ll only consider individual events because it’s possible to change the composition of relay teams between prelims and finals and that’s not what we’re talking about here.

First we’ll want to calculate the difference between a swimmer’s finals time and prelims time, but let’s do it as a difference per 50 yards, so all events can be compared on an even basis.

Drops <- Results %>%
  filter(
    is.na(Finals_Time) == FALSE,
    is.na(Prelims_Time) == FALSE,
    str_detect(Event, "Diving") == FALSE,
    Place <= 16 # only swimmers in places 1-16 actually swim in both prelims and finals
  ) %>%
  mutate(
    Distance = as.numeric(str_extract(Event, "\\d{1,}")), # distance in yards for each race
    Drop = sec_format(Finals_Time) - sec_format(Prelims_Time), # change in time between prelims and finals
    Per_Drop = Drop / (Distance / 50) # time dropped per 50 of the the race
  )

Event_Drop <- Drops %>%
  filter(str_detect(Event, "Relay") == FALSE) %>%
  group_by(Event) %>%
  summarise(Drop_Avg = mean(Per_Drop, na.rm = TRUE)) %>% # average time dropped per 50, in seconds
  mutate(Event = factor(Event, levels = unique(Results$Event))) %>% # set event order
  arrange(Event) # order by event

Event_Drop %>%
  flextable_style() %>%
  set_formatter_type(fmt_double = "%.02f", # format doubles to have two decimal places
                     fmt_integer = "%.0f") %>% # format integers to have no decimal places
  autofit()

So there’s some numbers. In most events the number is negative, meaning the swimmers got faster on average in the finals. A few events have positive numbers, meaning swimmers got slower in finals. More clarity is required.

We can use a test to see if on average swimmers swim faster (or slower) in finals compared to prelims. We’re going to use a t-test, which maybe some of you are familiar with, although there are other tests, like the Wilcoxen test that are arguably better suited to this purpose. To do so we need a properly phrased null hypothesis: “the average change in time per 50 yards between prelims and finals is 0 seconds”. We’ll pass 0 to mu inside t.test.

It’s worth noting that for small samples it’s important to check that the samples are normally distributed, but for larger (n > 20-30 is a rule of thumb) it’s not important. There are 1039 samples in our data set, so we don’t need to check for normality.

t.test(Drops$Per_Drop, mu = 0)

## 
##  One Sample t-test
## 
## data:  Drops$Per_Drop
## t = -7.6983, df = 1038, p-value = 3.203e-14
## alternative hypothesis: true mean is not equal to 0
## 95 percent confidence interval:
##  -0.07791070 -0.04626014
## sample estimates:
##   mean of x 
## -0.06208542

Taking a look at the t.test results we see that our p-value is 3.20e-14, well below the customary threshold of 0.05, so we can reject the null hypothesis that there’s no difference between times per 50 in prelims and times per 50 in finals, and conclude that there is in fact a difference. Crucially though the test does not tell us specifically what the difference is. If we keep examining the results though we can see a 95 percent confidence interval of -0.078 to -0.046, meaning that we can be 95% sure the true value is in that range. Since the entire confidence interval is negative we can be 95% confident (or more) that swimmers do swim faster in finals than they do in prelims - at least for this meet.

We can show this visually by plotting a density plot, with our sample mean denoted by a blue line, and our null hypothesis by a red one.

Drops %>%
  ggplot(aes(x = Per_Drop)) +
  geom_density() + 
  geom_vline( # mean value
    aes(xintercept = mean(Per_Drop)),
    color = "blue",
    linetype = "dotted",
    size = 1
  ) +
  geom_vline( # null hypothesis at 0
    aes(xintercept = 0),
    color = "red",
    linetype = "dotted",
    size = 1
  ) +
  theme_bw() +
  labs(x = "Seconds Dropped Per 50 Yards",
       y = "Density",
       title = "Change In Performance in Finals vs. Prelims")

From the plot, and from the t.test results above, it’s clear that although swimmers do drop time, it’s not much time on average, only about 0.06 seconds. It might also be interesting to see how place impacts amount of time dropped. Let’s plot that.

Place_Drop <- Drops %>% 
  group_by(Place, State) %>% 
  summarise(Drop_Avg = mean(Per_Drop, na.rm = TRUE))

Place_Drop %>% 
  ggplot() +
  geom_line(aes(x = Place, y = Drop_Avg, color = State)) +
  scale_x_continuous(breaks = seq(1, 16, 1)) +
  theme_bw()

There’s a couple things going on here. One is that the amount of time dropped tracks with place. Athletes who win tend to drop more time than those who come 16th. It could be that those athletes are just better, and “flip the switch” to deliver in the finals. It could also be that winning is lots of fun, and the chance to do so brings something more out of swimmers. Heck it could be both.

We can also see that there’s a big discontinuity around 8th-9th place. Those of you familiar with swimming can probably figure out what’s going on, and skip the rest of this paragraph where I’m going to explain it in excruciating detail. Assuming an 8 lane pool, which is the case for both the California and Texas meets, swimmers who place between 1st and 8th in the prelims swim in the “A” final at finals. These swimmers can place no higher than 1st (of course) and, critically, no lower than 8th overall long as they complete the race without being disqualified. That means that if a swimmer is in 8th place mid race and doesn’t think they can catch the 7th place swimmer there’s an incentive to just coast to the finish, because they’re guaranteed 8th regardless of their time. Similarly, swimmers who place between 9th and 16th in prelims swim in a “B” final at finals, where they can place no higher than 9th (regardless of time) and no lower than 16th. Getting 9th means winning the heat, and there’s a drive to do so. The further back one is in one’s heat though the more difficult it is to tell what’s going on, and be motivated to race those around you, and the less likely one is to win (the heat or the overall), so less drive to improve on a prelims time.

In Closing

Well that’s it for the State-Off championship round. California, the number one seed, has in fact prevailed. There will be one more post in the State-Off series next week, where I’ll throw all 8 teams into one giant battle royale of a meet. Be sure to come back to Swimming + Data Science for that!

draw_bracket(
  teams = c(
    "California",
    "Texas",
    "Florida",
    "New York",
    "Pennsylvania",
    "Illinois",
    "Ohio",
    "Georgia"
  ),
  round_two = c("California", "Texas", "Florida", "Pennsylvania"),
  round_three = c("California", "Texas"),
  champion = "California", 
  title = "Swimming + Data Science High School Swimming State-Off",
  text_size = 0.9
)

High School Swimming State-Off Tournament California (1) vs. Pennsylvania (5)

Thu, 10 Sep 2020 00:00:00 +0000

Here we have it, the last meet of the State-Off semi-final round, where California (1) takes on the Cinderella story that is Pennsylvania (5) for a trip to the finals. Don’t forget to update your version of SwimmeR to 0.4.1, because we’ll be using some newly released functions. We’ll also do some more plotting/data-vis and use prop.test to do some statistical work with the results, this time looking at grade distributions across events.

library(SwimmeR)
library(dplyr)
library(purrr)
library(tidyr)
library(stringr)
library(flextable)
library(ggplot2)

My flextable styling function is still working great since I made it last week so why mess with a good thing? Here it is again.

flextable_style <- function(x) {
  x %>%
    flextable() %>%
    bold(part = "header") %>% # bolds header
    bg(bg = "#D3D3D3", part = "header") %>% # puts gray background behind the header row
    autofit()
}

Getting Results

As discussed previously we’ll just grab clean results that I’m hosting on github rather than going through the exercise of reimporting them with SwimmeR.

California_Link <-
  "https://raw.githubusercontent.com/gpilgrim2670/Pilgrim_Data/master/CA_States_2019.csv"
California_Results <- read.csv(url(California_Link)) %>% 
  mutate(State = "CA")

Pennsylvania_Link <-
  "https://raw.githubusercontent.com/gpilgrim2670/Pilgrim_Data/master/PA_States_2020.csv"
Pennsylvania_Results <- read.csv(url(Pennsylvania_Link)) %>% 
  mutate(State = "PA")

Results <- California_Results %>%
  bind_rows(Pennsylvania_Results) %>%
  mutate(Gender = case_when(
    str_detect(Event, "Girls") == TRUE ~ "Girls",
    str_detect(Event, "Boys") == TRUE ~ "Boys"
  )) %>% 
  filter(str_detect(Event, "Swim-off") == FALSE) %>% 
  rename("Team" = School,
         "Age" = Grade)

Scoring the Meet

Results_Final <- results_score(
  results = Results,
  events = unique(Results$Event),
  meet_type = "timed_finals",
  lanes = 8,
  scoring_heats = 2,
  point_values = c(20, 17, 16, 15, 14, 13, 12, 11, 9, 7, 6, 5, 4, 3, 2, 1)
)

Scores <- Results_Final %>%
  group_by(State, Gender) %>%
  summarise(Score = sum(Points))

Scores %>%
  arrange(Gender, desc(Score)) %>%
  ungroup() %>%
  flextable_style()

Scores %>%
  group_by(State) %>%
  summarise(Score = sum(Score)) %>%
  arrange(desc(Score)) %>%
  ungroup() %>%
  flextable_style()

Pennsylvania’s charmed run through (one round of) the State-Off Tournament has come to an end, with California dominating both the boys and girls meets, and winning the overall handily.

Swimmers of the Meet

Swimmer of the Meet criteria is the same as it’s been for the entire State-Off. First we’ll look for athletes who have won two events, thereby scoring a the maximum possible forty points. In the event of a tie, where multiple athletes win two events, we’ll use All-American standards as a tiebreaker. Will anyone join Lillie Nordmann as a multiple Swimmer of the Meet winner?

Cuts_Link <-
  "https://raw.githubusercontent.com/gpilgrim2670/Pilgrim_Data/master/State_Cuts.csv"
Cuts <- read.csv(url(Cuts_Link))

Cuts <- Cuts %>% # clean up Cuts
  filter(Stroke %!in% c("MR", "FR", "11 Dives")) %>% # %!in% is now included in SwimmeR
  rename(Gender = Sex) %>%
  mutate(
    Event = case_when((Distance == 200 & #match events
                         Stroke == 'Free') ~ "200 Yard Freestyle",
                      (Distance == 200 &
                         Stroke == 'IM') ~ "200 Yard IM",
                      (Distance == 50 &
                         Stroke == 'Free') ~ "50 Yard Freestyle",
                      (Distance == 100 &
                         Stroke == 'Fly') ~ "100 Yard Butterfly",
                      (Distance == 100 &
                         Stroke == 'Free') ~ "100 Yard Freestyle",
                      (Distance == 500 &
                         Stroke == 'Free') ~ "500 Yard Freestyle",
                      (Distance == 100 &
                         Stroke == 'Back') ~ "100 Yard Backstroke",
                      (Distance == 100 &
                         Stroke == 'Breast') ~ "100 Yard Breaststroke",
                      TRUE ~ paste(Distance, "Yard", Stroke, sep = " ")
    ),
    
    Event = case_when(
      Gender == "M" ~ paste("Boys", Event, sep = " "),
      Gender == "F" ~ paste("Girls", Event, sep = " ")
    )
  )

Ind_Swimming_Results <- Results_Final %>%
  filter(str_detect(Event, "Diving|Relay") == FALSE) %>% # join Ind_Swimming_Results and Cuts
  left_join(Cuts %>% filter((Gender == "M" &
                               Year == 2020) |
                              (Gender == "F" &
                                 Year == 2019)) %>%
              select(AAC_Cut, AA_Cut, Event),
            by = 'Event')

Swimmer_Of_Meet <- Ind_Swimming_Results %>%
  mutate(
    AA_Diff = (Finals_Time_sec - sec_format(AA_Cut)) / sec_format(AA_Cut),
    Name = str_to_title(Name)
  ) %>%
  group_by(Name) %>%
  filter(n() == 2) %>% # get swimmers that competed in two events
  summarise(
    Avg_Place = sum(Place) / 2,
    AA_Diff_Avg = round(mean(AA_Diff, na.rm = TRUE), 3),
    Gender = unique(Gender),
    State = unique(State)
  ) %>%
  arrange(Avg_Place, AA_Diff_Avg) %>%
  group_split(Gender) # split out a dataframe for boys (1) and girls (2)

Boys

Swimmer_Of_Meet[[1]] %>%
  slice_head(n = 5) %>%
  select(-Gender) %>%
  ungroup() %>%
  flextable_style()

Turns out yes, Matt Brownstead from Pennsylvania joins Lillie in the multiple winners club. As we discussed previously Matt broke the national high school record in the 50 free, so that guaranteed him one win. He also won the 100 free - the only boy here to win two events. We don’t even need to go to the All-American tie breaker, but it is worth noting that Ethan Hu outperformed Matt by that metric. Pennsylvania also managed three of the top five finishers here - very nice!

Results_Final %>%
  filter(Name == "Brownstead, Matt") %>%
  select(Place, Name, Team, Finals_Time, Event) %>%
  arrange(desc(Event)) %>%
  ungroup() %>%
  flextable_style()

Girls

Swimmer_Of_Meet[[2]] %>%
  slice_head(n = 5) %>%
  select(-Gender) %>%
  ungroup() %>%
  flextable() %>%
  bold(part = "header") %>%
  bg(bg = "#D3D3D3", part = "header") %>%
  autofit()

Zoie Hartman heads a California sweep of the girls swimmer of the meet top 5 while also winning her second swimmer of the meet crown.

Results_Final %>%
  filter(Name == "Hartman, Zoie") %>%
  select(Place, Name, Team, Finals_Time, Event) %>%
  arrange(desc(Event)) %>%
  ungroup() %>%
  flextable_style()

Performances By Grade

It might be interesting to see what fraction of athletes from each grade compete in various events. We might hypothesize that sprint events, like the 50 freestyle in particular, would have a higher percentage of older athletes, who benefit from extra years of growth, muscle development etc. SwimmeR can capture grade (or age) values, assuming they’re present in the original results. In this case we do have grade values, so let’s take a look.

Results_Age <- Results_Final %>%
  filter(is.na(Age) == FALSE,
         Age %!in% c("ST", "1")) %>% # remove nonsense values
  mutate(
    Age = case_when(
      # regularize encoding of grade values
      Age == "9" ~ "FR",
      Age == "10" ~ "SO",
      Age == "11" ~ "JR",
      Age == "12" ~ "SR",
      TRUE ~ Age
    )
  ) %>%
  mutate(Age = factor(Age, levels = c("FR", "SO", "JR", "SR"))) %>% # factor to order grade levels
  filter(str_detect(Event, "Relay") == FALSE) %>% # remove relays since they don't have grades
  mutate(Event = str_remove(Event, "Girls |Boys "),
         Event = factor(Event, levels = rev(unique(
           # order events by meet order, in this case with diving first
           str_remove(unique(Results$Event), "Girls |Boys ")
         ))))

Results_Age_Sum <- Results_Age %>%
  group_by(Event, Gender, Age) %>%
  summarise(Numb = n()) %>% # number of athletes for each event/gender/grade combination
  ungroup() %>%
  group_by(Event, Gender) %>%
  mutate(Percentage = Numb / sum(Numb)) # percentage of athletes in each grade for each event/gender combination

Results_Age_Sum %>%
  ggplot() +
  geom_col(aes(x = Event, y = Percentage, fill = Age)) +
  coord_flip() +
  facet_wrap(. ~ Gender) +
  theme_bw() +
  labs(y = "Frequency")

That’s a lovely plot (if I do say so myself). Interestingly, the 50 freestyle doesn’t appear to be the most senior heavy event for boys or girls. It would be nice though to have the data in a table form to aid in taking a closer look, so let’s work on that.

Tables

# Split results by gender, creating a list of two dataframes
Results_Age_Gender <- Results_Age_Sum %>%
  ungroup() %>% 
  group_by(Gender) %>% 
  group_split()

# function to apply to both dataframes that will produce columns with percentages for each grade and event
Age_Fill <- function(x) {
  x <- x %>%
    mutate(Percentage = round(Percentage, 2)) %>% 
    pivot_wider(names_from = Age, values_from = Percentage) %>%
    select(-Numb) %>%
    group_by(Event) %>%
    fill(everything(), .direction = "updown") %>%
    unique() %>% 
    mutate(Event = factor(Event, levels = unique(str_remove(unique(Results$Event), "Girls |Boys ")))) %>% 
    mutate_if(is.numeric, ~replace(., is.na(.), 0))
  
  return(x)
}

# map Age_Fill function over list of dataframes
Results_Age_Gender <- Results_Age_Gender %>% 
  map(Age_Fill)

# print boys table
Results_Age_Gender[[1]] %>% 
  arrange(Event) %>% 
  flextable_style()

# print girls table
Results_Age_Gender[[2]] %>% 
  arrange(Event) %>% 
  flextable_style()

There’s been a rumor going around that “seniors rule” and I gotta say, these results are pushing me towards believing it. On the boys side seniors have the highest percentage representation in every event (although admittedly tied with sophomores (?) in diving). On the girls side seniors again dominated, although sophomores had the most representatives in the 100 butterfly and the 100 breaststroke was a three way tie between sophomores (again with the sophomores…), juniors and seniors.

Let’s check this out a bit further though. We can use prop.test to check whether or not a given population proportion matches what we expect. For starters let’s define “ruling” as being over represented in an event or in the meet. More formally, we can set up a null hypothesis, where the null value for population proportion (the percentage of athletes in a given event who are seniors) is 0.25. We can then accept or reject that null hypothesis based on a significance level. We’ll choose the standard 0.05 as a significance level. Running prop.test will give us (among other things) a p value, which we can compare to our significance level. If the p value is less than our significance level of 0.05 we can reject the null hypothesis and conclude that there are more seniors than we would expect. If there are more seniors than than an underlying 1/4 probability would suggest we can confirm an instance of seniors “ruling”.

Prop_Test_Results <- Results_Age_Sum %>%
  group_by(Event, Gender) %>%
  mutate(Total_Athletes = sum(Numb)) %>%
  filter(Age == "SR") %>% # only testing seniors
  rowwise() %>%
  mutate(P_Val = prop.test(Numb, Total_Athletes, p = 0.25)$p.value[1]) # run prop test and extract p values

Prop_Test_Results_Gender <- Prop_Test_Results %>% 
  ungroup() %>% 
  group_by(Gender) %>% 
  arrange(rev(Event)) %>%
  group_split()

We can look at each event for boys and girls, and highlight (in red) p values that are less than our significance value of 0.05, meaning that for those events we can reject the null hypothesis. We’ll collect a list of rows meeting each criteria (greater or less than our significance value) and then use flextable::bg to provide the appropriate background fill color.

Please note, the number of athletes in an event can be more than 16 in the event of a tie, or less than 16 for the purposes of this analysis if an athlete didn’t have their grade specified.

Boys Proportion Test

row_id_accept_boys <- # values where P_Val is greater or equal to than the significance value, should be green, fail to reject null hypothesis
  with(Prop_Test_Results_Gender[[1]], round(P_Val, 2) >= 0.05)
row_id_reject_boys <- # values where P_Val is less than the significance value, should be red, reject null hypothesis
  with(Prop_Test_Results_Gender[[1]], round(P_Val, 2) < 0.05)
col_id <- c("P_Val") # which column to change background color in

Prop_Test_Results_Gender[[1]] %>%
  flextable_style() %>%
  bg(i = row_id_accept_boys,
     j = col_id,
     bg = "green",
     part = "body") %>%
  bg(i = row_id_reject_boys,
     j = col_id,
     bg = "red",
     part = "body") %>%
  colformat_num(j = "P_Val",
                big.mark = ",",
                digits = 3) %>%
  autofit()

Girls Proportion Test

row_id_accept_girls <- # values where P_Val is greater or equal to than the significance value, should be green, fail to reject null
  with(Prop_Test_Results_Gender[[2]], round(P_Val, 2) >= 0.05)
row_id_reject_girls <- # values where P_Val is less than the significance value, should be red, reject null hypothesis
  with(Prop_Test_Results_Gender[[2]], round(P_Val, 2) < 0.05)
col_id <- c("P_Val") # which column to change background color in

Prop_Test_Results_Gender[[2]] %>%
  flextable_style() %>%
  bg(i = row_id_accept_girls,
     j = col_id,
     bg = "green",
     part = "body") %>%
  bg(i = row_id_reject_girls,
     j = col_id,
     bg = "red",
     part = "body") %>%
  colformat_num(j = "P_Val",
                big.mark = ",",
                digits = 3) %>%
  autofit()

Overall Proportion Test

In 13/18 (0.72%) of events the p-value is less than 0.05, meaning we can reject the null hypothesis for those events. There really are more seniors than a simple 1/4 probability would indicate, so in 72% of events seniors really do rule. We can also check for the whole meet:

Results_Age_Sum %>%
  ungroup() %>%
  mutate(Total_Athletes = sum(Numb)) %>%
  filter(Age == "SR") %>%
  mutate(Total_Seniors = sum(Numb)) %>%
  select(Total_Seniors, Total_Athletes) %>%
  unique() %>%
  mutate(P_Val = prop.test(Total_Seniors, Total_Athletes, p = 0.25)$p.value[1]) %>%
  flextable_style()

The p value (2.24e-22) is much less than 0.05 so we can reject the null hypothesis and conclude that at least as far as this meet is concerned seniors really do rule. Now if only there was some way to find out if O’Doyle also actually rules…

In Closing

Many thanks to all of you for joining us in another round of the State-Off here at Swimming + Data Science. Next week the final State-Off Champion will be crowned. Let’s update our bracket and prepare ourselves for a 1-2 matchup between California (1) and Texas (2)!

draw_bracket(
  teams = c(
    "California",
    "Texas",
    "Florida",
    "New York",
    "Pennsylvania",
    "Illinois",
    "Ohio",
    "Georgia"
  ),
  round_two = c("California", "Texas", "Florida", "Pennsylvania"),
  round_three = c("California", "Texas"),
  title = "Swimming + Data Science High School Swimming State-Off",
  text_size = 0.9
)

High School Swimming State-Off Tournament Texas (2) vs. Florida (3)

Fri, 04 Sep 2020 00:00:00 +0000

Welcome to round two of the State-Off. Today we have Texas (2) taking on Florida (3) for the right to compete in the State-Off championships! Don’t forget to update your version of SwimmeR to 0.4.1, because we’ll be using some newly released functions. We’ll also take a look at how to plot swimming times while maintaining their format.

library(SwimmeR)
library(dplyr)
library(stringr)
library(flextable)
library(ggplot2)

Since I like to use the same style flextable to display a lot of results, rather than retyping the associated flextable calls let’s just define a function now, which we can reuse every time.

flextable_style <- function(x) {
  x %>%
    flextable() %>%
    bold(part = "header") %>% # bolds header
    bg(bg = "#D3D3D3", part = "header") %>% # puts gray background behind the header row
    autofit()
}

Getting Results

As I mentioned in the SwimmeR 0.4.1 post last week these posts are no longer going to focus on using SwimmeR to read in results. That’s been covered extensively in previous State-Off posts. Instead I’ve already read in the results for each state and I’m hosting them on github.

We’ll just pull results for Texas and Florida, and then stick them together with bind_rows.

Texas_Link <-
  "https://raw.githubusercontent.com/gpilgrim2670/Pilgrim_Data/master/TX_States_2020.csv"
Texas_Results <- read.csv(url(Texas_Link)) %>% 
  mutate(State = "TX",
         Grade = as.character(Grade))

Florida_Link <-
  "https://raw.githubusercontent.com/gpilgrim2670/Pilgrim_Data/master/FL_States_2020.csv"
Florida_Results <- read.csv(url(Florida_Link)) %>% 
  mutate(State = "FL")

Results <- Texas_Results %>%
  bind_rows(Florida_Results) %>%
  mutate(Gender = case_when(
    str_detect(Event, "Girls") == TRUE ~ "Girls",
    str_detect(Event, "Boys") == TRUE ~ "Boys"
  )) %>% 
  rename("Team" = School,
         "Age" = Grade)

Scoring the Meet

Here’s one of the new functions for SwimmeR 0.4.1. If you followed along with previous State-Off posts then you remember we developed the results_score function together during the first round. Now we get to use it in all of its released glory. results_score takes several arguments, results, which are the results to score, events, which are the events of interest, meet_type, which is either "timed_finals" or "prelims_finals". The last three, lanes, scoring_heats, and point_values are fairly self-explanatory, as the number of lanes, scoring heats, and the point values for each place respectively.

For the State_Off we’ve been using a "timed_finals" meet type, with 8 lanes, 2 scoring heats and point values per NFHS.

Results_Final <- results_score(
  results = Results,
  events = unique(Results$Event),
  meet_type = "timed_finals",
  lanes = 8,
  scoring_heats = 2,
  point_values = c(20, 17, 16, 15, 14, 13, 12, 11, 9, 7, 6, 5, 4, 3, 2, 1)
)

Scores <- Results_Final %>%
  group_by(State, Gender) %>%
  summarise(Score = sum(Points))

Scores %>%
  arrange(Gender, desc(Score)) %>%
  ungroup() %>%
  flextable_style()

We have our first split result of of the State-Off, with the Texas boys and Florida girls each winning. This is a combined affair though, so let’s see which state will advance…

Scores %>%
  group_by(State) %>%
  summarise(Score = sum(Score)) %>%
  arrange(desc(Score)) %>%
  ungroup() %>%
  flextable_style()

And it’s Texas, living up to it’s higher seed!

Swimmers of the Meet

Swimmer of the Meet criteria is the same as it’s been for the entire State-Off. First we’ll look for athletes who won two events, thereby scoring a the maximum possible forty points. We’ll also grab the All-American cuts to use as a tiebreaker, in case multiple athletes win two events. It’s possible this week we’ll have our first multiple Swimmer of the Meet winner - the suspense!

Cuts_Link <-
  "https://raw.githubusercontent.com/gpilgrim2670/Pilgrim_Data/master/State_Cuts.csv"
Cuts <- read.csv(url(Cuts_Link))

Cuts <- Cuts %>% # clean up Cuts
  filter(Stroke %!in% c("MR", "FR", "11 Dives")) %>% # %!in% is now included in SwimmeR
  rename(Gender = Sex) %>%
  mutate(
    Event = case_when((Distance == 200 & #match events
                         Stroke == 'Free') ~ "200 Yard Freestyle",
                      (Distance == 200 &
                         Stroke == 'IM') ~ "200 Yard IM",
                      (Distance == 50 &
                         Stroke == 'Free') ~ "50 Yard Freestyle",
                      (Distance == 100 &
                         Stroke == 'Fly') ~ "100 Yard Butterfly",
                      (Distance == 100 &
                         Stroke == 'Free') ~ "100 Yard Freestyle",
                      (Distance == 500 &
                         Stroke == 'Free') ~ "500 Yard Freestyle",
                      (Distance == 100 &
                         Stroke == 'Back') ~ "100 Yard Backstroke",
                      (Distance == 100 &
                         Stroke == 'Breast') ~ "100 Yard Breaststroke",
                      TRUE ~ paste(Distance, "Yard", Stroke, sep = " ")
    ),
    
    Event = case_when(
      Gender == "M" ~ paste("Boys", Event, sep = " "),
      Gender == "F" ~ paste("Girls", Event, sep = " ")
    )
  )

Ind_Swimming_Results <- Results_Final %>%
  filter(str_detect(Event, "Diving|Relay") == FALSE) %>% # join Ind_Swimming_Results and Cuts
  left_join(Cuts %>% filter((Gender == "M" &
                               Year == 2020) |
                              (Gender == "F" &
                                 Year == 2019)) %>%
              select(AAC_Cut, AA_Cut, Event),
            by = 'Event')

Swimmer_Of_Meet <- Ind_Swimming_Results %>%
  mutate(
    AA_Diff = (Finals_Time_sec - sec_format(AA_Cut)) / sec_format(AA_Cut),
    Name = str_to_title(Name)
  ) %>%
  group_by(Name) %>%
  filter(n() == 2) %>% # get swimmers that competed in two events
  summarise(
    Avg_Place = sum(Place) / 2,
    AA_Diff_Avg = round(mean(AA_Diff, na.rm = TRUE), 3),
    Gender = unique(Gender),
    State = unique(State)
  ) %>%
  arrange(Avg_Place, AA_Diff_Avg) %>%
  group_split(Gender) # split out a dataframe for boys (1) and girls (2)

Boys

Swimmer_Of_Meet[[1]] %>%
  slice_head(n = 5) %>%
  select(-Gender) %>%
  ungroup() %>%
  flextable_style()

Joshua Zuchowski is the boys swimmer of the meet. He’s a new face for this particular award - in Florida’s first round meet he finished third behind two guys from Illinois. Also no boy won two events.

Results_Final %>%
  filter(Name == "Zuchowski, Joshua") %>%
  select(Place, Name, Team, Finals_Time, Event) %>%
  arrange(desc(Event)) %>%
  ungroup() %>%
  flextable_style()

Girls

Swimmer_Of_Meet[[2]] %>%
  slice_head(n = 5) %>%
  select(-Gender) %>%
  ungroup() %>%
  flextable() %>%
  bold(part = "header") %>%
  bg(bg = "#D3D3D3", part = "header") %>%
  autofit()

Lillie Nordmann continues her winning ways, being named girls swimmer of the meet for the second meet in a row. While she hasn’t written in to answer my questions about swimming outdoors in cold weather she did tell SwimSwam that she’s postponing her collegiate career because of the ongoing pandemic. I don’t blame her. As these results attest, she’s a champ, and frankly this way she’ll be able to focus more on trying to make the Olympic team. Also, it’s warmer in Texas than it is in Palo Alto (or nearby San Jose). Just saying. Actually I’m not just saying - I have data on the temperatures in San Jose and Houston, from the National Weather Service. Let me show you what I’m talking about, in both Fahrenheit and Celsius (the State-Off has a surprisingly international audience).

San_Jose_Link <- "https://raw.githubusercontent.com/gpilgrim2670/Pilgrim_Data/master/San_Jose_Temps.csv"
San_Jose <- read.csv(url(San_Jose_Link)) %>% 
  mutate(City = "San Jose")
Houston_Link <- "https://raw.githubusercontent.com/gpilgrim2670/Pilgrim_Data/master/Houston_Temps.csv"
Houston <- read.csv(url(Houston_Link)) %>% 
  mutate(City = "Houston")

Temps <- bind_rows(San_Jose, Houston)

names(Temps) <- c("Month", "Mean_Max", "Mean_Min", "Mean_Avg", "City")

Temps$Month <- factor(Temps$Month, ordered = TRUE, 
                                levels = unique(Temps$Month))

Temps %>%
  ggplot() +
  geom_line(aes(
    x = Month,
    y = Mean_Avg,
    group = City,
    color = City
  )) +
  scale_y_continuous(sec.axis = sec_axis( ~ (. - 32) * (5/9), name = "Monthly Mean Average Temperature (C)")) +
  theme_bw() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
  labs(x = "Month", y = "Monthly Mean Average Temperature (F)")

Those are the monthly average temperatures. Plotting Mean_Min is even colder, and closer to what it feels like in those early mornings. If I was going to swim outdoors I’d much rather do it in Texas versus shivering in NorCal. I am a delicate flower.

Results_Final %>%
  filter(Name == "Lillie Nordmann") %>%
  select(Place, Name, Team, Finals_Time, Event) %>%
  arrange(desc(Event)) %>%
  ungroup() %>%
  flextable_style()

The DQ Column

A new feature in SwimmeR 0.4.1 is that results now include a column called DQ. When DQ == 1 a swimmer or relay has been disqualified. Recording DQs is of course important to the overall mission of SwimmeR (making swimming results available in usable formats etc. etc.), but it’s also of personal interest to me as an official.

Results %>%
  group_by(State) %>%
  summarise(DQs = sum(DQ, na.rm = TRUE) / n()) %>%
  flextable_style()

Results %>% 
  mutate(Event = str_remove(Event, "Girls |Boys ")) %>% 
  group_by(Event) %>% 
  summarise(DQs = sum(DQ, na.rm = TRUE)) %>%
  filter(DQs > 0) %>% 
  arrange(desc(DQs)) %>% 
  head(5) %>% 
  flextable_style()

Not surprisingly most DQs are seen in relays. False starts can and do happen as teams push for every advantage. The line between a fast start and a false start is exceedingly fine. No one is trying to false start, it just happens sometimes. Breaststroke on the other hand is a disciple where intentional cheating can and sometimes does prosper. Recall Cameron van der Burgh admitting to taking extra dolphin kicks after winning gold in Rio, or Kosuke Kitajima having “no response” to Aaron Peirsol’s accusation (backed up by video) that he took an illegal dolphin kick en route to gold in Beijing. Breaststrokers also seem to struggle with the modern “brush” turn, and ring up a lot of one-hand touches. The Texas results (5A, 6A) actually say what infraction was committed, and it’s the usual mix of kicking violations and one hand touches. Florida doesn’t share reasons for DQs, but just from my own experience - kicking and one hand touches. Must be in the water. Or not, because butterflyers don’t seem to suffer from the same issues. Could be the the butterfly recovery is more difficult to stop short, or to do in an unbalanced fashion such that only one hand makes contact with the wall? I don’t know, it’s an genuine mystery, but it is nice that my personal observations from officiating are borne out in the data.

Plotting Times With SwimmeR

We might be interested in seeing a distribution of times for a particular event. There’s a problem though. Swimming times are traditionally reported as minutes:seconds.hundredths. In R that means they’re stored as character strings, which can be confirmed by calling str(Results$Finals_Time). We’d like to be able to look at times from fastest to slowest though - that is we’d like them to have an order. One option would be to convert the character strings in Results$Finals_Time to an ordered factor, but that would be awful. We’d likely need to manually define the ordering - no fun at all. SwimmeR instead offers a pair of functions to make this easier. The function sec_format will take a time written as minutes:seconds.hundredths, like the ones in Results$Finals_Time and covert it to a numeric value - the total duration in seconds. Ordering numerics is easy, R handles it automatically. While that’s very nice, we as swimming aficionados would still like to look at times in the standard swimming format. This is where mmss_format comes in - it simply coverts times back to the standard minutes:seconds.hundredths for our viewing pleasure. Below is an example of converting times to numeric with sec_format for plotting, and then converting the axis labels to swimming format with mmss_format for viewing.

Results %>%
  filter(Gender == 'Girls',
         str_detect(Event, "Relay") == FALSE) %>%
  left_join(Cuts %>% filter(Year == 2019, Gender == "F"), by = c("Event")) %>% # add in All-American cuts
  filter(Event == "Girls 200 Yard Freestyle") %>% # pick event
  mutate(Finals_Time = sec_format(Finals_Time)) %>% # change time format to seconds
  ggplot() +
  geom_histogram(aes(x = Finals_Time, fill = State), binwidth = 0.5) +
  geom_vline(aes(xintercept = sec_format(AA_Cut))) + # line for All-American cut
  geom_vline(aes(xintercept = sec_format(AAC_Cut))) + # line for All-American consideration cut
  scale_y_continuous(breaks = seq(0, 10, 2)) +
  scale_x_continuous(
    breaks = seq(100, 150, 5),
    labels = scales::trans_format("identity", mmss_format) # labels in swimming format
  ) +
  geom_label(
    label = "All-American",
    x = 107,
    y = 7,
    color = "black"
  ) +
  geom_label(
    label = "All-American Cons.",
    x = 110.5,
    y = 10,
    color = "black"
  ) +
  theme_bw() +
  labs(y = "No. of Swimmers",
       x = "Finals Time")

Here we see classic “bell” curves for each state, with a few very fast or very slow (comparatively speaking) swimmers, and a bunch of athletes clumped right in the middle.

In Closing

Texas wins the overall, despite a winning effort from the Florida girls. Next week at Swimming + Data Science we’ll have number one seed California (1) vs. number five Pennsylvania (5). We’ll also dig further into new SwimmeR 0.4.1 functionality. Hope to see you then!

New Version of SwimmeR and the Next Round of the State-Off Tournament

Fri, 28 Aug 2020 00:00:00 +0000

The first round of the 2020 High School Swimming State-Off Tournament is in the books and saw California (1), Texas (2), Florida, and Pennsylvania (5) advance.

Before beginning the next round there are a few administrative details I’d like to cover.

First and foremost: SwimmeR version 0.4.1 is now available on CRAN! The State-Off has been the first major outing for my SwimmeR package. We’ve used it extensively to read in and parse swimming results from a variety of sources, including “normal” html web pages, Hy-Tek real time results pages, and .pdf files. It’s performed admirably, but some bugs have revealed themselves behind the scenes. Version 0.4.1 contains bug fixes plus a host of new features:

A version of results_score, the function we developed during the State-Off. It handles timed finals style meets (like the State-Off) but also scores prelims-finals style meets, a more common and also more complex format.

library(stringr)
library(dplyr)
library(purrr)
library(SwimmeR)
library(flextable)

base <- "http://sidearmstats.com/auburn/swim/200218F0"
event_numbers <-
  1:42 # sequence of numbers, total of 42 events across men and women
event_numbers <-
  str_pad(event_numbers,
          width = 2,
          side = "left",
          pad = "0") # add leading zeros to single digit numbers
SEC_Links <-
  paste0(base, event_numbers, ".htm") # paste together base urls and sequence of numbers (with leading zeroes as needed)

SEC_Results <-
  map(SEC_Links, read_results, node = "pre") %>% # map SwimmeR::read_results over the list of links
  map(
    swim_parse,
    typo = c(
      "A&M",
      "FLOR",
      "Celaya-Hernande",
      # names which were cut off, and missing the last, first structure
      "Hernandez-Tome",
      "Garcia Varela,",
      "Von Biberstein,"
    ),
    replacement = c(
      "AM",
      "Florida",
      "Celaya, Hernande",
      # replacement names that artificially impose last, first structure.  Names can be fixed after parsing
      "Hernandez, Tome",
      "Garcia, Varela",
      "Von, Biberstein"
    )
  ) %>%
  bind_rows()


# some diving finals results don't list places 9-24, which do score.  we can get those divers from the prelim results
SEC_Diving_Prelims_Links <-
  c(
    "http://sidearmstats.com/auburn/swim/200218P015.htm",
    # M 1m prelims
    "http://sidearmstats.com/auburn/swim/200218P001.htm",
    # W 1m prelims
    "http://sidearmstats.com/auburn/swim/200218P022.htm",
    # W 3m prelims
    "http://sidearmstats.com/auburn/swim/200218P029.htm",
    # M platform prelims
    "http://sidearmstats.com/auburn/swim/200218P040.htm"
  ) # W platform prelims

SEC_Diving_Prelims <-
  map(SEC_Diving_Prelims_Links, read_results, node = "pre") %>% # map SwimmeR::read_results over the list of links
  map(
    swim_parse,
    typo = c("A&M", "FLOR", "Celaya-Hernande", "Garcia Varela,"),
    replacement = c("AM", "Florida", "Celaya, Hernande", "Garcia, Varela")
  ) %>%
  bind_rows()

SEC_Diving_Prelims <- SEC_Diving_Prelims %>%
  anti_join(SEC_Results, by = c("Name", "Team", "Event")) # make sure divers aren't counted twice for a given event

SEC_Results <- bind_rows(SEC_Results, SEC_Diving_Prelims)

SEC_Results <-
  SEC_Results %>% # actual use of new results_score function
  results_score(
    events = unique(SEC_Results$Event),
    meet_type = "prelims_finals",
    lanes = 8,
    scoring_heats = 3,
    point_values = c(
      32,
      28,
      27,
      26,
      25,
      24,
      23,
      22,
      20,
      17,
      16,
      15,
      14,
      13,
      12,
      11,
      9,
      7,
      6,
      5,
      4,
      3,
      2,
      1
    )
  )

SEC_Results_Gender <- SEC_Results %>%
  mutate(Gender = case_when(str_detect(Event, "Men") ~ "M",
                            str_detect(Event, "Women") ~ "F")) %>%
  group_by(Team, Gender) %>%
  summarise(Score = sum(Points, na.rm = TRUE)) %>%
  arrange(desc(Score)) %>%
  arrange(Gender) %>%
  ungroup() %>%
  group_split(Gender)

The scored results match the official results for women:

SEC_Results_Gender[[1]] %>%
  flextable() %>%
  bold(part = "header") %>%
  bg(bg = "#D3D3D3", part = "header") %>%
  autofit()

SEC Women Final Scores

Scores also match for men:

SEC_Results_Gender[[2]] %>%
  flextable() %>%
  bold(part = "header") %>%
  bg(bg = "#D3D3D3", part = "header") %>%
  autofit()

SEC Men Final Scores

The ability to read in .hy3 files. Hy-Tek .hy3 files are another form of results, intended to be read into Team Manager. As of version 0.4.1 SwimmeR can now also read them. This feature is not complete and will evolve in future releases. Bug reports are welcome at the SwimmeR github page. Here though we can use it to read in results from the USA Swimming 2019 December Sectional Meet for CA and NV.

temp <- tempfile()
temp2 <- tempfile()
url <-
  "http://www.pacswim.org/userfiles/meets/documents/1691/meet-results-speedo-sectionals-2019-ca-nv-december-2019-13dec2019-003.zip"

download.file(url, temp)
unzip(zipfile = temp, exdir = temp2)
raw_results <-
  read_results(
    file.path(
      temp2,
      "Meet Results-Speedo Sectionals 2019 CA-NV December 2019-13Dec2019-003.hy3"
    )
  )
unlink(c(temp, temp2))

results <- swim_parse(raw_results) %>%
  mutate(Event = str_replace(Event, "NA", "Yard"))

results %>%
  filter(Event == "100 Yard Butterfly",
         Gender == "M") %>%
  select(Name, Team, Prelims_Time, Finals_Time) %>%
  arrange(Finals_Time) %>%
  head(5) %>%
  flextable() %>%
  bold(part = "header") %>%
  bg(bg = "#D3D3D3", part = "header") %>%
  autofit()

Recording of DQ and Exhibition swims in the output of swim_parse, as the columns DQ and Exhibition respectively. This ended up being important for results_score, since Exhibition and DQ swimmers can’t score.

Ithaca_Union <-
  swim_parse(
    read_results(
      "https://athletics.ithaca.edu/services/download_file.ashx?file_location=https://s3.amazonaws.com/sidearm.sites/bombers.ithaca.edu/documents/2020/2/1/ithaca_vs_union_2020.pdf"
    )
  )

Ithaca_Union %>%
  filter(Event == "Men 400 Yard Freestyle Relay") %>%
  select(Place, Team, Finals_Time, Exhibition, DQ) %>%
  flextable() %>%
  bold(part = "header") %>%
  bg(bg = "#D3D3D3", part = "header") %>%
  autofit()

We can see that in the Mens 400 Yard Freestyle Relay the third place relay was exhibition (Exhibition == 1) and that another relay was disqualified (DQ == 1).

Bug fixes include fixing an issue where tied athletes, with "*" in front of their places would not be imported, an issue where times or scores with a “J” in front of them (a Hy-Tek marker meaning a time/score was judged) would not be imported.

Since we’ve already read in results for each state I’m not going to re-read them in each State-Off post going forward. Instead I’m hosting the results on github and will just pull them from there. Don’t worry, there will still be plenty of work for SwimmeR to do.
Continuing from point 2, the focus of the first round was mostly on demonstrating how to read in swimming data with Swimmer. This next round will focus more on exactly what that data is and how to use it.

Thanks for joining us, and don’t forget to update your version of SwimmeR in preparation of the next round of the High School Swimming State-Off Tournament!

High School Swimming State-Off Tournament Texas (2) vs. Ohio (7)

Wed, 12 Aug 2020 00:00:00 +0000

Did you know that Ohio’s state song is Hang On Sloopy, best known as a hit for the McCoys in 1965? Me either, but this week in the State-Off Tournament we’ll see if seventh seed Ohio (7) can cough hang on against second seeded Texas (2).

We’ll also continue building our meet scoring function, with en eye towards including it in a future SwimmeR release.

library(SwimmeR)
library(dplyr)
library(readr)
library(stringr)
library(purrr)
library(flextable)
library(ggplot2)

Texas Results

The Texas results repository strangely doesn’t have results for the 2019-2020 meet, although it was held. After a bit of googling I did find them, in the form of two Hy-Tek real-time results pages, one for each division (5A and 6A). We already have a function for putting together a list of links from a real-time results page, so we’ll use that again. SwimmeR::read_results and SwimmeR::swim_parse can handle the rest.

base_6A <-
  "https://www.uiltexas.org/tournament-results/swimming-diving/2020/6a/200214F0"

base_5A <-
  "https://www.uiltexas.org/tournament-results/swimming-diving/2020/5a/200214F0"

real_time_links <- function(base, event_numbers) {
  event_numbers <- sprintf("%02d", as.numeric(event_numbers))
  links <- map(base, paste0, event_numbers, ".htm")
  links <- unlist(links, recursive = FALSE)
  return(links)
}

TX_Links <-
  real_time_links(base = c(base_6A, base_5A),
                  event_numbers = 1:24)

TX_Results <-
  map(TX_Links, read_results, node = "pre") %>% # map SwimmeR::read_results over the list of links
  map(swim_parse,
      # typo = c("\\s\\d{1,2}\\s{2,}"),
      # replacement = c(" ")
      ) %>%
  bind_rows() %>% # bind together results from each link
  select(Name, Team, Finals_Time, Event) %>% # only the columns we need
  mutate(State = "TX") # add column for state since we'll be combining results with OH

Ohio Results

Ohio has a nice repository, with results for what they call Division I and Division II. The Division I diving results are separate though, and oddly formatted, so I’m hosting cleaned versions on github. Otherwise though this is a straightforward exercise of using SwimmeR::read_results and SwimmeR::swim_parse on .pdf files.

Ohio_DI_Link <-
  "https://ohsaaweb.blob.core.windows.net/files/Sports/Swimming-Diving/2019-20/State%20Tournament/Division%20I/2020DivisionISwimmingFinalsResults.pdf"

OH_DI <- swim_parse(
  read_results(Ohio_DI_Link),
  # typo = c(# fix issue with some class designation strings
  #   "SR\\s{2,}",
  #   "JR\\s{2,}",
  #   "SO\\s{2,}",
  #   "FR\\s{2,}"),
  # replacement = c("SR ",
  #                 "JR ",
  #                 "SO ",
  #                 "FR ")
)

OH_DI_Diving_Link <-
  "https://raw.githubusercontent.com/gpilgrim2670/Pilgrim_Data/master/OH_DI_Diving_2020.txt"

OH_DI_Diving <-
  read_delim(url(OH_DI_Diving_Link), delim = "\t") %>%
  tidyr::fill(Event, .direction = "down") %>%
  select(-c(Semis_Time, Order)) %>%
  na_if("Cut")

Ohio_DII_Link <-
  "https://ohsaaweb.blob.core.windows.net/files/Sports/Swimming-Diving/2019-20/State%20Tournament/Division%20II/2020DivisionIISwimmingFinalsResults.pdf"

OH_DII <- swim_parse(read_results(Ohio_DII_Link))

OH_Results <- bind_rows(OH_DI, OH_DII, OH_DI_Diving) %>%
  mutate(State = "OH",
         Event = str_remove(Event, " DIVISION \\d")) # remove division labels from event names

Joining Up Results

As usual we’ll now join together the results from each state, adding a column for gender and removing events outside the standard program. We’re also going to remove the Points column since we’ll be rescoring the (newly formed) meet ourselves.

Results <- bind_rows(TX_Results, OH_Results) %>%
  mutate(Gender = case_when(
    str_detect(Event, "Girls") == TRUE ~ "Girls",
    str_detect(Event, "Boys") == TRUE ~ "Boys"
  )) %>%
  filter(str_detect(Event, "Swim-off") == FALSE)

Scoring Function

Last week we built the results_score function, to compute point values for each place, including ties. This week we’re going to start breaking it into sub-functions, which will make it much easier to maintain as a part of the SwimmeR package.

The way I look for likely sub-function candidates is to look for duplicated chunks of code. Last week’s version of read_results had 6 lines that were used in creating both relay_results and results. These six lines are will now be a sub-function called swim_place, because what they do is assign place numbers to swimming events, based on a rank of the Finals_Time_sec column, with the lowest (fastest) time winning. This is distinct from diving_results, where the highest value of the Finals_Time column wins.

results_score <-
  function(results, events, point_values, max_place) {
    # defining sub-function, which will be used later in main function
    swim_place <- function(df) {
      df <- df %>%
        slice(1) %>% # first instance of every swimmer
        ungroup() %>%
        group_by(Event) %>%
        mutate(Finals_Time_sec = sec_format(Finals_Time)) %>% # time as seconds
        mutate(Place = rank(Finals_Time_sec, ties.method = "min")) %>% # places, low number wins
        filter(Place <= max_place)
      return(df)
    }
    
    # add 0 to list of point values
    point_values <- c(point_values, 0)
    
    # name point values for their respective places
    names(point_values) <- 1:length(point_values)
    
    results <- results %>%
      filter(str_detect(Event, paste(events, collapse = "|")) == TRUE)
    
    # diving
    if (any(str_detect(results$Event, "Diving"))) {
      diving_results <- results %>%
        filter(str_detect(Event, "Diving")) %>%
        mutate(Finals_Time = as.numeric(Finals_Time)) %>%
        group_by(Event, Name) %>%
        slice(1) %>% # first instance of every diver
        ungroup() %>%
        group_by(Event) %>%
        mutate(
          Place = rank(desc(Finals_Time), ties.method = "min"),
          # again, highest score gets rank 1
          Finals_Time = as.character(Finals_Time)
        ) %>%
        filter(Place <= max_place)
      
    } else {
      diving_results  <- results[0, ]
    }
    
    # relays
    if (any(str_detect(results$Event, "Relay"))) {
      relay_results <- results %>%
        filter(str_detect(Event, "Relay") == TRUE) %>% # only want relays
        group_by(Event, Team) %>%
        swim_place()
      
    } else {
      relay_results  <- results[0, ]
    }
    
    # individual swimming results
    results <- results %>%
      filter(str_detect(Event, "Diving|Relay") == FALSE) %>%
      group_by(Event, Name) %>%
      swim_place()
    
    # collecting all results
    results <- bind_rows(results, diving_results, relay_results)
    
    # rescoring to deal with ties
    results <- results %>%
      group_by(Event) %>%
      mutate(New_Place = rank(Place, ties.method = "first"),
             Points = point_values[New_Place]) %>%
      group_by(Place, Event) %>%
      summarize(Points = mean(Points)) %>%
      inner_join(results) %>%
      mutate(Points = case_when(str_detect(Event, "Relay") == TRUE ~ Points * 2,
                                TRUE ~ Points)) %>%
      ungroup()
    
  }

Scored Results

Now we’ll use our newly improved results_score function to score Texas (2) vs. Ohio (7) - very exciting!

Results_Final <-
  results_score(
    results = Results,
    events = unique(Results$Event),
    point_values = c(20, 17, 16, 15, 14, 13, 12, 11, 9, 7, 6, 5, 4, 3, 2, 1),
    max_place = 16
  )

Scores <- Results_Final %>%
  group_by(State, Gender) %>%
  summarise(Score = sum(Points))

Texas wins both meets and the overall, but Ohio acquits itself very well. Let’s dig in a little deeper.

Scores %>%
  arrange(Gender, desc(Score)) %>%
  ungroup() %>%
  flextable() %>%
  bold(part = "header") %>%
  bg(bg = "#D3D3D3", part = "header") %>%
  autofit()

Scores %>%
  group_by(State) %>%
  summarise(Score = sum(Score)) %>%
  arrange(desc(Score)) %>%
  ungroup() %>%
  flextable() %>%
  bold(part = "header") %>%
  bg(bg = "#D3D3D3", part = "header") %>%
  autofit()

They say that it’s not the winning, it’s the taking part, but I say once you’re already taking part you might as well try and win. Also the math says that winning is worth more points than any other option, so let’s look at the number of event winners from each state.

Results_Final %>%
  filter(Place == 1) %>%
  select(Event, State) %>%
  group_by(State) %>%
  summarise(Total = n()) %>%
  arrange(desc(Total)) %>%
  flextable() %>%
  bold(part = "header") %>%
  bg(bg = "#D3D3D3", part = "header") %>%
  autofit()

The ratio of scores in the overall meet is 1.14, meaning Texas scored 1.14 points for every point Ohio scored. The event wins were equal though, meaning Texas only won 1 (12/12) event for every event Ohio won. This means that Texas’s margin of victory is larger than its share of first place finishes would indicate. Let’s see where those extra points Texas got came from. If we look at the total number of scoring performances (swims or dives) we see that Texas just had more them. Turns out that while winning is important, taking part is also pretty valuable.

Results_Final %>%
  select(State, Gender) %>%
  group_by(State, Gender) %>%
  summarise(Count = n()) %>%
  arrange(Gender, desc(Count)) %>%
  flextable() %>%
  bold(part = "header") %>%
  bg(bg = "#D3D3D3", part = "header") %>%
  autofit()

We can visualize Texas’s superior depth with a bar chart. Sometimes things are easier to understand in a visual format. Just look at all that extra blue.

Results_Final %>%
  select(Event, State, Place, Gender) %>%
  group_by(State) %>%
  ggplot() +
  geom_bar(aes(x = Place, fill = State),
           width = 0.8,
           position = position_dodge(width = 0.8)) +
  scale_x_continuous(breaks = seq(1, 16)) +
  scale_y_continuous(breaks = seq(1, 13)) +
  theme_bw() +
  labs(y = "Count") +
  facet_grid(. ~ Gender)

Swimmers of the Meet

Now for the awards. We’ll look for athletes who won two events (I keep saying, winning really is nice), and use the All-American standards as a tie-breaker.

Cuts_Link <-
  "https://raw.githubusercontent.com/gpilgrim2670/Pilgrim_Data/master/State_Cuts.csv"
Cuts <- read.csv(url(Cuts_Link))

'%!in%' <- function(x, y)
  ! ('%in%'(x, y)) # "not in" function

Cuts <- Cuts %>% # clean up Cuts
  filter(Stroke %!in% c("MR", "FR", "11 Dives")) %>%
  rename(Gender = Sex) %>%
  mutate(
    Event = case_when((Distance == 200 & #match events
                         Stroke == 'Free') ~ "200 Yard Freestyle",
                      (Distance == 200 &
                         Stroke == 'IM') ~ "200 Yard IM",
                      (Distance == 50 &
                         Stroke == 'Free') ~ "50 Yard Freestyle",
                      (Distance == 100 &
                         Stroke == 'Fly') ~ "100 Yard Butterfly",
                      (Distance == 100 &
                         Stroke == 'Free') ~ "100 Yard Freestyle",
                      (Distance == 500 &
                         Stroke == 'Free') ~ "500 Yard Freestyle",
                      (Distance == 100 &
                         Stroke == 'Back') ~ "100 Yard Backstroke",
                      (Distance == 100 &
                         Stroke == 'Breast') ~ "100 Yard Breaststroke",
                      TRUE ~ paste(Distance, "Yard", Stroke, sep = " ")
    ),
    
    Event = case_when(
      Gender == "M" ~ paste("Boys", Event, sep = " "),
      Gender == "F" ~ paste("Girls", Event, sep = " ")
    )
  )

Ind_Swimming_Results <- Results_Final %>%
  filter(str_detect(Event, "Diving|Relay") == FALSE) %>% # join Ind_Swimming_Results and Cuts
  left_join(Cuts %>% filter((Gender == "M" &
                               Year == 2020) |
                              (Gender == "F" &
                                 Year == 2019)) %>%
              select(AAC_Cut, AA_Cut, Event),
            by = 'Event')

Swimmer_Of_Meet <- Ind_Swimming_Results %>%
  mutate(
    AA_Diff = (Finals_Time_sec - sec_format(AA_Cut)) / sec_format(AA_Cut),
    Name = str_to_title(Name)
  ) %>%
  group_by(Name) %>%
  filter(n() == 2) %>% # get swimmers that competed in two events
  summarise(
    Avg_Place = sum(Place) / 2,
    AA_Diff_Avg = round(mean(AA_Diff, na.rm = TRUE), 3),
    Gender = unique(Gender),
    State = unique(State)
  ) %>%
  arrange(Avg_Place, AA_Diff_Avg) %>%
  group_split(Gender) # split out a dataframe for boys (1) and girls (2)

Boys

Swimmer_Of_Meet[[1]] %>%
  slice_head(n = 5) %>%
  select(-Gender) %>%
  ungroup() %>%
  flextable() %>%
  bold(part = "header") %>%
  bg(bg = "#D3D3D3", part = "header") %>%
  autofit()

Adam Chaney of Ohio won both sprint freestyle events and is your boys swimmer of the meet. Aaron Sequeira was actually slightly stronger on the All-American metric, but again, winning is important.

Results_Final %>%
  filter(Name == "Adam Chaney") %>%
  select(Place, Name, Team, Finals_Time, Event) %>%
  arrange(desc(Event)) %>%
  ungroup() %>%
  flextable() %>%
  bold(part = "header") %>%
  bg(bg = "#D3D3D3", part = "header") %>%
  autofit()

Girls

Swimmer_Of_Meet[[2]] %>%
  slice_head(n = 5) %>%
  select(-Gender) %>%
  ungroup() %>%
  flextable() %>%
  bold(part = "header") %>%
  bg(bg = "#D3D3D3", part = "header") %>%
  autofit()

Lillie Nordmann of Texas is your girls swimmer of the meet, winning two events and dominating the All-American metric. She’ll be swimming at Stanford next year. Lillie, (or other Cardinal swimmers) if you’re reading this, I’m confused. I get that Stanford is a great school and all, and I’m sure you’ll get a fantastic education going there. The swim teams are obviously massively successful, with great coaches, and with their help you’ll likely excel in the sport. I used to live in the Bay Area though, and it’s kind of cold there during the winter. Especially in the morning. Not cold like it is in New York, where I live now, but colder than I like it to be if I’m swimming outdoors. Stanford’s pool area is very nice, but it’s outdoors, no roof or anything. You’re signing up for four years of chilly mornings. It just doesn’t sound that good. I’m not against Stanford (or Cal - same situation) it’s just that there are good schools, with good swim teams, that have outdoor pools, but that are also in warm places. Or there are good schools with good swim teams in cold places but that have indoor pools. Either seems preferable to me. Just write in Lillie, let me know what I’m missing.

Kit Kat Zenick also won two events. She also apparently decided she likes the state of Ohio, because she’s headed back, to swim for Ohio State. Was it this meet that gave her such a favorable impression of the Buckeye State? Probably not since a) she committed before the meet was held and b) the meet is made up, only happening in our collective imaginations. Ohio State has a lovely, indoor, pool though, so I get it.

Results_Final %>%
  filter(Name == "Lillie Nordmann") %>%
  select(Place, Name, Team, Finals_Time, Event) %>%
  arrange(desc(Event)) %>%
  ungroup() %>%
  flextable() %>%
  bold(part = "header") %>%
  bg(bg = "#D3D3D3", part = "header") %>%
  autofit()

In Closing

This ends the first round of the High School Swimming State-Off Tournament, and that means it’s time to update our bracket. In March Madness the round of four is called the ‘Final Four’, which is odd since they redo it every year. I’m going to call mine the Fabulous Four, because if I do this again next year, there’ll just be more fabulousness, and that’s fine by me.

draw_bracket(
  teams = c(
    "California",
    "Texas",
    "Florida",
    "New York",
    "Pennsylvania",
    "Illinois",
    "Ohio",
    "Georgia"
  ),
  round_two = c("California", "Texas", "Florida", "Pennsylvania"),
  title = "Swimming + Data Science High School Swimming State-Off",
  text_size = 0.9
)

High School Swimming State-Off Tournament Florida (3) vs. Illinois (6)

Fri, 07 Aug 2020 00:00:00 +0000

This week in the High School Swimming State-Off Tournament we have the third seeded Sunshine State, Florida (3) taking on the sixth seeded Illinois (6) aka the Prairie State.

library(SwimmeR)
library(dplyr)
library(stringr)
library(purrr)
library(flextable)

Florida Results

Florida has a nice results repository, with Hy-Tek real-time results. This will then be similar to last week when we first scraped a Hy-Tek real-time results page. This time though we’re going to scrape four, one for each of Florida’s four divisions.

Please note, Florida has changed their results repository since this post was written and have made results unavailable. Rather than reading in the now unavailable results directly from the FHSAA I’m downloading them from github, here I had archived them.

FL_Link <- "https://raw.githubusercontent.com/gpilgrim2670/Pilgrim_Data/master/FL_States_2020.csv"

FL_Results <- read.csv(url(FL_Link)) %>% # reads CSV file
  select(Name, "Team" = School, Finals_Time, Event, State)

### original code for posterity
# base_4A <- "https://www.fhsaa.org/sites/default/files/orig_uploads/sports/swimming-diving/archives/2019-20/state/4A/191115F0"
# 
# base_3A <- "https://www.fhsaa.org/sites/default/files/orig_uploads/sports/swimming-diving/archives/2019-20/state/3A/191116F0"
# 
# base_2A <- "https://www.fhsaa.org/sites/default/files/orig_uploads/sports/swimming-diving/archives/2019-20/state/191108F0"
# 
# base_1A <- "https://www.fhsaa.org/sites/default/files/orig_uploads/sports/swimming-diving/archives/2019-20/state/1A/191109F0"
# 
# real_time_links <- function(base, event_numbers) { # function to make list of results links
#   event_numbers <-
#     sprintf("%02d", as.numeric(event_numbers)) # adds leading zeros where needed on event numbers
#   links <-
#     map(base, paste0, event_numbers, ".htm") # combines link base with event numbers
#   links <- unlist(links, recursive = FALSE)
#   return(links)
# }
# 
# FL_Links <-
#   real_time_links(base = c(base_4A, base_3A, base_2A, base_1A),
#                   event_numbers = 1:24)
# 
# FL_Results <-
#   map(FL_Links, read_results, node = "pre") %>% # map SwimmeR::read_results over the list of links
#   map(swim_parse) %>%
#   bind_rows() %>% # bind together results from each link
#   select(Name, Team, Finals_Time, Event) %>% # only the columns we need
#   mutate(State = "FL") # add column for state since we'll be combining results with IL

Illinois Results

Illinois splits their results repositories into boys and girls. Final results from the Illinois girls state meet was just a scan of a printout, or as it’s sometime called .norm format (as of 8/12/2020 this file has been moved by IHSA, so now there are no results). Not a good look Illinois, not a good look at all. Illinois will be penalized for this egregious data-foul by being made to use their preliminary results on the girls side. Frankly it’s the only way to include them in the meet at all, short of transcribing that miserable scan. Even I’m not that interested.

Both Illinois boys and Illinois girls (prelim) results are available as .pdf files, which SwimmeR::read_results can handle. There are some inconsistencies in spacing for class designators (“Sr”, “Jr” etc.) as well as a few leading spaces. There’s also an issue with a region name, which follows school names, but is placed in parentheses. We can clean these up with the typo and replacement arguments of swim_parse.

Please note: Illinois has moved their repository since this article was first posted. Links have been updated.

IL_Link <- "https://raw.githubusercontent.com/gpilgrim2670/Pilgrim_Data/master/IL_States_2020.csv"

IL_Results <- read.csv(url(IL_Link)) %>% # reads CSV file
  select(Name, "Team" = School, Finals_Time, Event, State)

### original code for posterity ###
# IL_Boys_Link <- "https://www.ihsa.org/archive/swb/2019-20/StateResults.pdf"
# IL_Girls_Link <-
#   "https://www.ihsa.org/Portals/0/prelim%20results.pdf"
# 
# IL_Results <-
#   map(c(IL_Girls_Link, IL_Boys_Link), read_results) %>% # map SwimmeR::read_results over the list of links
#   map(
#     swim_parse,
#     avoid = c("IHSA", "NFHS", "POOL", "NATIONAL"),
#     typo = c(
#       "Sr\\s{2,}",
#       # fix issue with some class designation strings
#       "Jr\\s{2,}",
#       "So\\s{2,}",
#       "Fr\\s{2,}",
#       "\\s{2,}\\(",
#       # region designation fix
#       "\\s\\d{1,2}\\s{2,}" # fix leading spaces
#     ),
#     replacement = c("Sr ",
#                     "Jr ",
#                     "So ",
#                     "Fr ",
#                     " \\)",
#                     " ")
#   ) %>%
#   bind_rows() %>% # bind together results from each link
#   mutate(Ind = case_when(str_detect(Event, "Relay") == FALSE ~ 1,
#                          TRUE ~ 0)) %>%
#   mutate(
#     Age = case_when(
#       is.na(Age) == TRUE &
#         Ind == 1 ~ str_extract(Team, "^Fr|^So|^Jr|^Sr")
#     ),
#     Team = case_when(is.na(Age) == FALSE ~ str_remove(Team, Age),
#                        TRUE ~ Team)
#   ) %>%
#   select(Name, Team, Finals_Time, Event) %>% # only the columns we need
#   mutate(State = "IL")

Joining Up Results

Having collected results from Florida and Illinois we just need to join them up, add a column for gender and remove events outside the standard 12 event program.

Results <- bind_rows(FL_Results, IL_Results) %>%
  mutate(Gender = case_when(
    str_detect(Event, "Girls") == TRUE ~ "Girls",
    # coding gender
    str_detect(Event, "Boys") == TRUE ~ "Boys"
  )) %>%
  filter(str_detect(Event, "Swim-off") == FALSE,
         # removing extra events
         str_detect(Event, "AWD") == FALSE)

Analysis

Last week to make a point about reusable code I copied my code from the week prior. Copy and pasting code is all well and good, but even better is to functionalize code. So this week we’re going to start working on function for scoring each event type (diving, relay and individual swim). The eventual goal, over the next few weeks, is to develop this code into a robust function for inclusion in a future release of the SwimmeR package.

Below is our starting point. It’s basically just the code from previous weeks wrapped in curly brackets. Inside the curly brackets there are still cases, determined by if, to break up the input results into diving, relays, and individual swims, and then to score them exactly as before. The difference is that this function does not assume there actually are any diving, relay or individual swims. It has else conditions following each if that insure the function does not fault if a particular event type isn’t represented.

Scoring Function

results_score <-
  function(results, events, point_values, max_place) {
    point_values <- c(point_values, 0)
    names(point_values) <- 1:length(point_values)
    
    results <- results %>%
      filter(str_detect(Event, paste(events, collapse = "|")) == TRUE)
    
    if (any(str_detect(results$Event, "Diving"))) {
      # break out diving results
      diving_results <- results %>%
        filter(str_detect(Event, "Diving")) %>%
        mutate(Finals_Time = as.numeric(Finals_Time)) %>%
        group_by(Event, Name) %>%
        slice(1) %>% # first instance of every diver
        ungroup() %>%
        group_by(Event) %>%
        mutate(
          Place = rank(desc(Finals_Time), ties.method = "min"),
          # highest score gets rank 1
          Finals_Time = as.character(Finals_Time)
        ) %>%
        filter(Place <= max_place)
      
    } else {
      diving_results  <-
        results[0, ] # if there are no diving results create a blank dataframe called diving_results, with the same columns as results
    }
    
    if (any(str_detect(results$Event, "Relay"))) {
      # break out relay results
      relay_results <- results %>%
        filter(str_detect(Event, "Relay") == TRUE) %>% # only want relays
        group_by(Event, Team) %>%
        slice(1) %>% # select first occurrence of team in each event
        ungroup() %>%
        mutate(Finals_Time_sec = sec_format(Finals_Time)) %>% # convert time to seconds
        group_by(Event) %>%
        mutate(Place = rank(Finals_Time_sec, ties.method = "min")) %>% # places, low number wins
        filter(Place <= max_place)
      
    } else {
      relay_results  <-
        results[0, ] # if there are no relay results create a blank dataframe called relay_results, with the same columns as results
    }
    
    if (any(str_detect(results$Event, "Diving|Relay") == FALSE)) {
      # break out non diving/relay events
      ind_results <- results %>%
        filter(str_detect(Event, "Diving|Relay") == FALSE) %>%
        group_by(Event, Name) %>%
        slice(1) %>% # first instance of every swimmer
        ungroup() %>%
        group_by(Event) %>%
        mutate(Finals_Time_sec = sec_format(Finals_Time)) %>% # time as seconds
        mutate(Place = rank(Finals_Time_sec, ties.method = "min")) %>% # places, low number wins
        filter(Place <= max_place)
      
    } else {
      ind_results <-
        results[0, ] # if there are no non relay/diving results create a blank dataframe called ind_results, with the same columns as results
    }
    
    results <-
      bind_rows(ind_results, diving_results, relay_results) # bind together all the dataframes.  This is why we needed blank dataframes in the case of no relay/diving results
    
    results <- results %>% # deal with ties
      group_by(Event) %>%
      mutate(New_Place = rank(Place, ties.method = "first"),
             Points = point_values[New_Place]) %>%
      group_by(Place, Event) %>%
      summarize(Points = mean(Points)) %>%
      inner_join(results) %>%
      mutate(Points = case_when(str_detect(Event, "Relay") == TRUE ~ Points * 2,
                                TRUE ~ Points)) %>%
      ungroup()
    
  }

In future installments of the Swim-Off we’ll add peices of code to this function to sanitize inputs, provide error messages, and eventually to score other meet formats.
Because results_score can score arbitrary events, we don’t actually have to score an entire meet. We can select only a few events. Say we were interested in short axis strokes, butterfly and breaststroke. Those events can be passed to results_score in place of the full suite of events.

Results_Short_Axis <-
  results_score(
    results = Results,
    events = c("Butterfly", "Breaststroke"),
    point_values = c(20, 17, 16, 15, 14, 13, 12, 11, 9, 7, 6, 5, 4, 3, 2, 1),
    max_place = 16
  )

Results_Short_Axis %>%
  filter(Place <= 2) %>%
  select(Place, Name, State, Event, Points) %>%
  arrange(Event, Place) %>%
  flextable() %>%
  bold(part = "header") %>%
  bg(bg = "#D3D3D3", part = "header") %>%
  autofit()

Scored Results

we are interested in scoring a full meet though, so let’s pass all the events from Florida vs. Illinois to results_score and get the scores for each event.

Results_Final <-
  results_score(
    results = Results,
    events = unique(Results$Event),
    point_values = c(20, 17, 16, 15, 14, 13, 12, 11, 9, 7, 6, 5, 4, 3, 2, 1),
    max_place = 16
  )

Scores <- Results_Final %>%
  group_by(State, Gender) %>%
  summarise(Score = sum(Points))

Florida wins both the boys and girls meets, but it’s close, especially on the boys side. On the girls side Illinois was likely hampered by not having their finals swims available. Serves them right for their lousy data practices.

Scores %>%
  arrange(Gender, desc(Score)) %>%
  ungroup() %>%
  flextable() %>%
  bold(part = "header") %>%
  bg(bg = "#D3D3D3", part = "header") %>%
  autofit()

Scores %>%
  group_by(State) %>%
  summarise(Score = sum(Score)) %>%
  arrange(desc(Score)) %>%
  ungroup() %>%
  flextable() %>%
  bold(part = "header") %>%
  bg(bg = "#D3D3D3", part = "header") %>%
  autofit()

Let’s take a closer look, and see how many events each state won, by gender.

Results_Final %>%
  filter(Place == 1) %>%
  select(Event, State, Gender) %>%
  unique() %>% # to remove ties, of which there is one
  group_by(Gender, State) %>%
  summarise(Total = n()) %>%
  arrange(Gender, desc(Total)) %>%
  flextable() %>%
  bold(part = "header") %>%
  bg(bg = "#D3D3D3", part = "header") %>%
  autofit()

The Illinois boys won 11 of 12 events - that’s impressive! Let’s see that listed out, including a tie in the Medley Relay:

Results_Final <-
  Results_Final[order(match(Results_Final$Event, Results$Event)),] # to order events correctly

Results_Final %>%
  filter(Gender == "Boys",
         Place == 1) %>%
  select(Name, Team, State, Finals_Time, Event) %>%
  flextable() %>%
  bold(part = "header") %>%
  bg(bg = "#D3D3D3", part = "header") %>%
  autofit()

Swimmers of the Meet

Just to remind everyone of the Swimmer of the Meet criteria first we’ll look for athletes who won two events, thereby scoring a the maximum possible forty points. We’ll also grab the All-American cuts to use as a tiebreaker, in case multiple athletes win two events.

Cuts_Link <-
  "https://raw.githubusercontent.com/gpilgrim2670/Pilgrim_Data/master/State_Cuts.csv"
Cuts <- read.csv(url(Cuts_Link))

'%!in%' <- function(x, y)
  ! ('%in%'(x, y)) # "not in" function

Cuts <- Cuts %>% # clean up Cuts
  filter(Stroke %!in% c("MR", "FR", "11 Dives")) %>%
  rename(Gender = Sex) %>%
  mutate(
    Event = case_when((Distance == 200 & #match events
                         Stroke == 'Free') ~ "200 Yard Freestyle",
                      (Distance == 200 &
                         Stroke == 'IM') ~ "200 Yard IM",
                      (Distance == 50 &
                         Stroke == 'Free') ~ "50 Yard Freestyle",
                      (Distance == 100 &
                         Stroke == 'Fly') ~ "100 Yard Butterfly",
                      (Distance == 100 &
                         Stroke == 'Free') ~ "100 Yard Freestyle",
                      (Distance == 500 &
                         Stroke == 'Free') ~ "500 Yard Freestyle",
                      (Distance == 100 &
                         Stroke == 'Back') ~ "100 Yard Backstroke",
                      (Distance == 100 &
                         Stroke == 'Breast') ~ "100 Yard Breaststroke",
                      TRUE ~ paste(Distance, "Yard", Stroke, sep = " ")
    ),
    
    Event = case_when(
      Gender == "M" ~ paste("Boys", Event, sep = " "),
      Gender == "F" ~ paste("Girls", Event, sep = " ")
    )
  )

Ind_Swimming_Results <- Results_Final %>%
  filter(str_detect(Event, "Diving|Relay") == FALSE) %>% # join Ind_Swimming_Results and Cuts
  left_join(Cuts %>% filter((Gender == "M" &
                               Year == 2020) |
                              (Gender == "F" &
                                 Year == 2019)) %>%
              select(AAC_Cut, AA_Cut, Event),
            by = 'Event')

Swimmer_Of_Meet <- Ind_Swimming_Results %>%
  mutate(
    AA_Diff = (Finals_Time_sec - sec_format(AA_Cut)) / sec_format(AA_Cut),
    Name = str_to_title(Name)
  ) %>%
  group_by(Name) %>%
  filter(n() == 2) %>% # get swimmers that competed in two events
  summarise(
    Avg_Place = sum(Place) / 2,
    AA_Diff_Avg = round(mean(AA_Diff, na.rm = TRUE), 3),
    Gender = unique(Gender),
    State = unique(State)
  ) %>%
  arrange(Avg_Place, AA_Diff_Avg) %>%
  group_split(Gender) # split out a dataframe for boys (1) and girls (2)

Boys

As we’ve already seen, Illinois boys won 11 of 12 events, with Connor Boyle and Max Iida both winning two apiece. That means we’ll be going to the All-American standard tiebreaker.

Swimmer_Of_Meet[[1]] %>% 
  slice_head(n = 5) %>% 
  select(-Gender) %>% 
  ungroup() %>%
  flextable() %>% 
  bold(part = "header") %>%
  bg(bg = "#D3D3D3", part = "header") %>% 
  autofit()

It’s Connor Boyle by a nose, just squeaking past Max Iida. Interestingly Florida’s lone event winner, Joshua Zuchowski, had the same All-American score as Connor, but only won one event, finishing second to Max in the 200 IM. He’s young though, so maybe next year.

Results_Final %>%
  filter(Name == "Boyle, Connor") %>%
  select(Place, Name, Team, Finals_Time, Event) %>%
  arrange(desc(Event)) %>%
  ungroup() %>%
  flextable() %>%
  bold(part = "header") %>%
  bg(bg = "#D3D3D3", part = "header") %>%
  autofit()

Girls

Swimmer_Of_Meet[[2]] %>%
  slice_head(n = 5) %>%
  select(-Gender) %>%
  ungroup() %>%
  flextable() %>% 
  bold(part = "header") %>%
  bg(bg = "#D3D3D3", part = "header") %>% 
  autofit()

The girls meet was overall much stronger, with the top three girls swimmers further under the All-American cuts than any of the boys. Micayla Cronk was especially excellent, not only winning two events, but doing so with extremely impressive times. Emma Weyant also won two events, but was pipped by Micayla on the All-American tie-breaker.

Results_Final %>%
  filter(Name == "Cronk, Micayla") %>%
  select(Place, Name, Team, Finals_Time, Event) %>%
  arrange(desc(Event)) %>% 
  ungroup() %>%
  flextable() %>% 
  bold(part = "header") %>%
  bg(bg = "#D3D3D3", part = "header") %>% 
  autofit()

In Closing

Thanks for joining us for another installment of the High School Swimming State-Off here at Swimming + Data Science. Come back next week for Texas (2) vs. Ohio (7), where we’ll be making further improvements to our new results_score function.

Year	Decline	Improvement	Total	P_Val
2,001	13	9	22	0.665
2,002	15	7	22	0.198
2,003	15	18	33	0.548
2,004	15	18	33	0.548
2,005	13	20	33	0.194
2,006	13	20	33	0.194
2,007	14	19	33	0.342
2,008	15	18	33	0.548
2,009	22	11	33	0.136
2,010	13	20	33	0.194
2,011	13	20	33	0.194
2,012	14	19	33	0.342
2,013	16	17	33	0.800
2,014	12	21	33	0.100
2,015	13	20	33	0.194
2,016	13	9	22	0.665
2,017	11	22	33	0.046
2,018	24	9	33	0.029
2,019	19	14	33	0.657
2,020	31	2	33	0.000

Year	Total_Perc_Change	Avg_Perc_Change_Per_Event
2,002	14.89	0.45
2,003	-16.00	-0.48
2,004	-2.03	-0.06
2,005	-11.71	-0.35
2,006	-11.49	-0.35
2,007	-10.44	-0.32
2,008	-5.57	-0.17
2,009	9.40	0.28
2,010	-6.27	-0.19
2,011	-18.72	-0.57
2,012	9.02	0.27
2,013	-13.82	-0.42
2,014	-23.26	-0.70
2,015	-5.62	-0.17
2,017	-26.62	-0.81
2,018	31.62	0.96
2,019	9.93	0.30
2,020	110.18	3.34

Name	No_Swims	Team	Age
Chung, Emily	99	Clarence Swim Club-NI	13
Anderson, Max	96	VELO-NI	10
Cavallerano, Jack S	96	Liverpool Jets Swim Club-NI	11
Anderson, Madden	91	VELO-NI	11
Barillari, Emma	91	Velocity Aquatics, Llc-NI	12

Name	No_Swim	Team
Chung, Emily	99	Clarence Swim Club-NI
Emily Chung	4	Clarence Swim Club-NI

package	download rate
SwimmeR + Blog	25.73
SwimmeR	11.93
ThreeWiseMonkeys	9.54

Match	Place	Lane	Name	Team	Finals_Time	Event	Points	DQ
1	1	4	SJOSTROM Sarah	ENS	56.00	Women's 100m Butterfly	9	0
1	2	3	SHKURDAI Anastasiya	ENS	56.07	Women's 100m Butterfly	7	0
1	3	5	DAHLIA Kelsi	CAC	56.70	Women's 100m Butterfly	6	0
1	4	6	BROWN Erika	CAC	56.80	Women's 100m Butterfly	5	0
1	5	8	SURKOVA Arina	NYB	57.18	Women's 100m Butterfly	4	0
1	6	7	OTTESEN Jeanette	NYB	57.81	Women's 100m Butterfly	3	0

Place	State	Score
1	CA	761.0
2	OH	462.0
3	PA	314.5
4	TX	250.0
5	IL	224.0
6	GA	221.5
7	FL	63.0
8	NY	29.0

Seed	State	Population_mil
1	CA	39.51
2	TX	29.00
3	FL	21.48
4	NY	19.45
5	PA	12.80
6	IL	12.67
7	OH	11.69
8	GA	10.62

Name	Avg_Place	AA_Diff_Avg	State
Magahey, Jake	1.0	-0.042	GA
Brownstead, Matt	1.5	-0.050	PA
Aikins, Jack	1.5	-0.038	GA
Hu, Ethan	2.0	-0.052	CA
Dillard, Ben	2.5	-0.044	CA

Event	Drop_Avg
Girls 200 Yard Freestyle	-0.1
Boys 200 Yard Freestyle	-0.1
Girls 200 Yard IM	-0.1
Boys 200 Yard IM	-0.1
Girls 50 Yard Freestyle	-0.1
Boys 50 Yard Freestyle	-0.1
Girls 100 Yard Butterfly	-0.1
Boys 100 Yard Butterfly	-0.1
Girls 100 Yard Freestyle	-0.1
Boys 100 Yard Freestyle	-0.0
Girls 500 Yard Freestyle	0.0
Boys 500 Yard Freestyle	-0.1
Girls 100 Yard Backstroke	-0.1
Boys 100 Yard Backstroke	0.0
Girls 100 Yard Breaststroke	-0.0
Boys 100 Yard Breaststroke	0.0

Event	Gender	Age	Numb	Percentage	Total_Athletes	P_Val
1 mtr Diving	Boys	SR	5	0.3125	16	0.77282999268
200 Yard Freestyle	Boys	SR	9	0.5625	16	0.00937476846
200 Yard IM	Boys	SR	9	0.5625	16	0.00937476846
50 Yard Freestyle	Boys	SR	10	0.6250	16	0.00149616429
100 Yard Butterfly	Boys	SR	9	0.5625	16	0.00937476846
100 Yard Freestyle	Boys	SR	12	0.7500	16	0.00001490234
500 Yard Freestyle	Boys	SR	9	0.5625	16	0.00937476846
100 Yard Backstroke	Boys	SR	9	0.5625	16	0.00937476846
100 Yard Breaststroke	Boys	SR	6	0.3750	16	0.38647623077

Total_Seniors	Total_Athletes	P_Val
144	288	0.000000000000000000000224775