Introduction

I’ve had a fat bike since late November 2013, mostly using it to commute the 4.1 miles to and from work on the Goldstream Valley trail system. I used to classic ski exclusively, but that’s not particularly pleasant once the temperatures are below 0°F because I can’t keep my hands and feet warm enough, and the amount of glide you get on skis declines as the temperature goes down.

However, it’s also true that fat biking gets much harder the colder it gets. I think this is partly due to biking while wearing lots of extra layers, but also because of increased friction between the large tires and tubes in a fat bike. In this post I will look at how temperature and other variables affect the performance of a fat bike (and it’s rider).

The code and data for this post is available on GitHub.

Data

I log all my commutes (and other exercise) using the RunKeeper app, which uses the phone’s GPS to keep track of distance and speed, and connects to my heart rate monitor to track heart rate. I had been using a Polar HR chest strap, but after about a year it became flaky and I replaced it with a Scosche Rhythm+ arm band monitor. The data from RunKeeper is exported into GPX files, which I process and insert into a PostgreSQL database.

From the heart rate data, I estimate energy consumption (in kilocalories, or what appears on food labels as calories) using a formula from Keytel LR, et al. 2005, which I talk about in this blog post.

Let’s take a look at the data:

library(dplyr)
library(ggplot2)
library(scales)
library(lubridate)
library(munsell)

fat_bike <- read.csv("fat_bike.csv", stringsAsFactors=FALSE, header=TRUE) %>%
    tbl_df() %>%
    mutate(start_time=ymd_hms(start_time, tz="US/Alaska"))

kable(head(fat_bike))

There are a few things we need to do to the raw data before analyzing it. First, we want to restrict the data to just my commutes to and from work, and we want to categorize them as being one or the other. That way we can analyze trips to ABR and home separately, and we’ll reduce the variation within each analysis. If we were to analyze all fat biking trips together, we’d be lumping short and long trips, as well as those with a different proportion of hills or more challenging conditions. To get just trips to and from work, I’m restricting the distance to trips between 4.0 and 4.3 miles, and only those activities where there were two of them in a single day (to work and home from work). To categorize them into commutes to work and home, I filter based on the time of day.

I’m also calculating energy per mile, and adding a “winter day of year” variable (wdoy), which is a measure of how far into the winter season the trip took place. We can’t just use day of year because that starts over on January 1st, so we subtract the number of days between January and May from the date and get day of year from that. Finally, we split the data into trips to work and home.

I’m also excluding the really early season data from 2015 because the trail was in really poor condition.

fat_bike_commute <- fat_bike %>%
    filter(miles>4, miles<4.3) %>%
    mutate(direction=ifelse(hour(start_time)<10, 'north', 'south'),
           date=as.Date(start_time, tz='US/Alaska'),
           wdoy=yday(date-days(120)),
           kcal_per_mile=kcal/miles) %>%
    group_by(date) %>%
    mutate(n=n()) %>%
    ungroup() %>%
    filter(n>1)

to_abr <- fat_bike_commute %>% filter(direction=='north',
                                      wdoy>210)
to_home <- fat_bike_commute %>% filter(direction=='south',
                                       wdoy>210)
kable(head(to_home %>% select(-date, -kcal, -n)))

Analysis

Here a plot of the data. We’re plotting all trips with winter day of year on the x-axis and energy per mile on the y-axis. The color of the points indicates the minimum temperature and the straight line shows the trend of the relationship.

s <- ggplot(data=fat_bike_commute %>% filter(wdoy>210), aes(x=wdoy, y=kcal_per_mile, colour=min_temp)) +
    geom_smooth(method="lm", se=FALSE, colour=mnsl("10B 7/10", fix=TRUE)) +
    geom_point(size=3) +
    scale_x_continuous(name=NULL,
                       breaks=c(215, 246, 277, 305, 336),
                       labels=c('1-Dec', '1-Jan', '1-Feb', '1-Mar', '1-Apr')) +
    scale_y_continuous(name="Energy (kcal)", breaks=pretty_breaks(n=10)) +
    scale_colour_continuous(low=mnsl("7.5B 5/12", fix=TRUE), high=mnsl("7.5R 5/12", fix=TRUE),
                            breaks=pretty_breaks(n=5),
                            guide=guide_colourbar(title="Min temp (°F)", reverse=FALSE, barheight=8)) +
    ggtitle("All fat bike trips") +
    theme_bw()
print(s)

Across all trips, we can see that as the winter progresses, I consume less energy per mile. This is hopefully because my physical condition improves the more I ride, and also because the trail conditions also improve as the snow pack develops and the trail gets harder with use. You can also see a pattern in the color of the dots, with the bluer (and colder) points near the top and the warmer temperature trips near the bottom.

Let’s look at the temperature relationship:

s <- ggplot(data=fat_bike_commute %>% filter(wdoy>210), aes(x=min_temp, y=kcal_per_mile, colour=wdoy)) +
    geom_smooth(method="lm", se=FALSE, colour=mnsl("10B 7/10", fix=TRUE)) +
    geom_point(size=3) +
    scale_x_continuous(name="Minimum temperature (degrees F)", breaks=pretty_breaks(n=10)) +
    scale_y_continuous(name="Energy (kcal)", breaks=pretty_breaks(n=10)) +
    scale_colour_continuous(low=mnsl("7.5PB 2/12", fix=TRUE), high=mnsl("7.5PB 8/12", fix=TRUE),
                            breaks=c(215, 246, 277, 305, 336),
                            labels=c('1-Dec', '1-Jan', '1-Feb', '1-Mar', '1-Apr'),
                            guide=guide_colourbar(title=NULL, reverse=TRUE, barheight=8)) +
    ggtitle("All fat bike trips") +
    theme_bw()
print(s)

A similar pattern. As the temperature drops, it takes more energy to go the same distance. And the color of the points also shows the relationship from the earlier plot where trips taken later in the season require less energy.

There is also be a correlation between winter day of year and temperature. Since the winter fat biking season essentially begins in December, it tends to warm up throughout.

Results

The relationship between winter day of year and temperature means that we’ve got multicollinearity in any model that includes both of them. This doesn’t mean we shouldn’t include them, nor that the significance or predictive power of the model is reduced. All it means is that we can’t use the individual regression coefficients to make predictions.

Here are the linear models for trips to work, and home:

to_abr_lm <- lm(data=to_abr, kcal_per_mile ~ min_temp + wdoy)
print(summary(to_abr_lm))

##
## Call:
## lm(formula = kcal_per_mile ~ min_temp + wdoy, data = to_abr)
##
## Residuals:
##     Min      1Q  Median      3Q     Max
## -27.845  -6.964  -3.186   3.609  53.697
##
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)
## (Intercept) 170.81359   15.54834  10.986 1.07e-14 ***
## min_temp     -0.45694    0.18368  -2.488   0.0164 *
## wdoy         -0.29974    0.05913  -5.069 6.36e-06 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 15.9 on 48 degrees of freedom
## Multiple R-squared:  0.4069, Adjusted R-squared:  0.3822
## F-statistic: 16.46 on 2 and 48 DF,  p-value: 3.595e-06

to_home_lm <- lm(data=to_home, kcal_per_mile ~ min_temp + wdoy)
print(summary(to_home_lm))

##
## Call:
## lm(formula = kcal_per_mile ~ min_temp + wdoy, data = to_home)
##
## Residuals:
##     Min      1Q  Median      3Q     Max
## -21.615 -10.200  -1.068   3.741  39.005
##
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)
## (Intercept) 144.16615   18.55826   7.768 4.94e-10 ***
## min_temp     -0.47659    0.16466  -2.894  0.00570 **
## wdoy         -0.20581    0.07502  -2.743  0.00852 **
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 13.49 on 48 degrees of freedom
## Multiple R-squared:  0.5637, Adjusted R-squared:  0.5455
## F-statistic: 31.01 on 2 and 48 DF,  p-value: 2.261e-09

The models confirm what we saw in the plots. Both regression coefficients are negative, which means that as the temperature rises (and as the winter goes on) I consume less energy per mile. The models themselves are significant as are the coefficients, although less so in the trips to work. The amount of variation in kcal/mile explained by minimum temperature and winter day of year is 41% for trips to work and 56% for trips home.

What accounts for the rest of the variation? My guess is that trail conditions are the missing factor here; specifically fresh snow, or a trail churned up by snowmachiners. I think that’s also why the results are better on trips home than to work. On days when we get snow overnight, I am almost certainly riding on an pristine snow-covered trail, but by the time I leave work, the trail will be smoother and harder due to all the traffic it’s seen over the course of the day.

Conclusions

We didn’t really find anything surprising here: it is significantly harder to ride a fat bike when it’s colder. Because of conditioning, improved trail conditions, as well as the tendency for warmer weather later in the season, it also gets easier to ride as the winter goes on.

Introduction

Often when I’m watching Major League Baseball games a player will come up to bat or pitch and I’ll comment “former Oakland Athletic” and the player’s name. It seems like there’s always one or two players on the roster of every team that used to be an Athletic.

Let’s find out. We’ll use the Retrosheet database again, this time using the roster lists from 1990 through 2014 and comparing it against the 40-man rosters of current teams. That data will have to be scraped off the web, since Retrosheet data doesn’t exist for the current season and rosters change frequently during the season.

Methods

As usual, I’ll use R for the analysis, and rmarkdown to produce this post.

library(plyr)
library(dplyr)
library(rvest)
options(stringsAsFactors=FALSE)

We’re using plyr and dplyr for most of the data manipulation and rvest to grab the 40-man rosters for each team from the MLB website. Setting stringsAsFactors to false prevents various base R packages from converting everything to factors. We're not doing any statistics with this data, so factors aren't necessary and make comparisons and joins between data frames more difficult.

retrosheet_db <- src_postgres(host="localhost", port=5438,
                              dbname="retrosheet", user="cswingley")

rosters <- tbl(retrosheet_db, "rosters")

all_recent_players <-
     rosters %>%
     filter(year>1989) %>%
     collect() %>%
     mutate(player=paste(first_name, last_name),
            team=team_id) %>%
     select(player, team, year)

save(all_recent_players, file="all_recent_players.rdata", compress="gzip")

oakland_players <- all_recent_players %>%
    filter(team=='OAK') %>%
    group_by(player) %>%
    summarise(years=paste(year, collapse=', '))

kable(head(oakland_players))

teams=c("ana", "ari", "atl", "bal", "bos", "cws", "chc", "cin", "cle", "col",
        "det", "mia", "hou", "kc", "la", "mil", "min", "nyy", "nym", "oak",
        "phi", "pit", "sd", "sea", "sf", "stl", "tb", "tex", "tor", "was")

team_names = c("Angels", "Diamondbacks", "Braves", "Orioles", "Red Sox",
               "White Sox", "Cubs", "Reds", "Indians", "Rockies", "Tigers",
               "Marlins", "Astros", "Royals", "Dodgers", "Brewers", "Twins",
               "Yankees", "Mets", "Athletics", "Phillies", "Pirates",
               "Padres", "Mariners", "Giants", "Cardinals", "Rays", "Rangers",
               "Blue Jays", "Nationals")

get_players <- function(team) {
    # reads the 40-man roster data for a team, returns a data frame

    roster_html <- html(paste("http://www.mlb.com/team/roster_40man.jsp?c_id=",
                              team,
                              sep=''))

    players <- roster_html %>%
        html_nodes("#roster_40_man a") %>%
        html_text()

    data.frame(team=team, player=players)
}

current_rosters <- ldply(teams, get_players)

save(current_rosters, file="current_rosters.rdata", compress="gzip")

kable(head(current_rosters))

Combine the data

To find out how many players on each Major League team used to play for the A’s we combine the former A’s players with the current rosters using player name. This may not be perfect due to differences in spelling (accented characters being the most likely issue), but the results look pretty good.

roster_with_oakland_time <- current_rosters %>%
    left_join(oakland_players, by="player") %>%
    filter(!is.na(years))

kable(head(roster_with_oakland_time))

You can see from this table (just the first six rows of the results) that the Angels have three players that were Athletics.

Let’s do the math and find out how many former A’s are on each team’s roster.

n_former_players_by_team <-
    roster_with_oakland_time %>%
        group_by(team) %>%
        arrange(player) %>%
        summarise(number_of_players=n(),
                  players=paste(player, collapse=", ")) %>%
        arrange(desc(number_of_players)) %>%
        inner_join(data.frame(team=teams, team_name=team_names),
                   by="team") %>%
        select(team_name, number_of_players, players)

names(n_former_players_by_team) <- c('Team', 'Number',
                                     'Former Oakland Athletics')
kable(n_former_players_by_team,
      align=c('l', 'r', 'r'))

Pretty cool. I do notice one problem: there are actually two Chris Young’s playing in baseball today. Chris Young the outfielder played for the A’s in 2013 and now plays for the Yankees. There’s also a pitcher named Chris Young who shows up on our list as a former A’s player who now plays for the Royals. This Chris Young never actually played for the A’s. The Retrosheet roster data includes which hand (left and/or right) a player bats and throws with, and it’s possible this could be used with the MLB 40-man roster data to eliminate incorrect joins like this, but even with that enhancement, we still have the problem that we’re joining on things that aren’t guaranteed to uniquely identify a player. That’s the nature of attempting to combine data from different sources.

One other interesting thing. I kept the A’s in the list because the number of former A’s currently playing for the A’s is a measure of how much turnover there is within an organization. Of the 40 players on the current A’s roster, only 22 of them have ever played for the A’s. That means that 18 came from other teams or are promotions from the minors that haven’t played for any Major League teams yet.

All teams

teams <- c("ANA", "ARI", "ATL", "BAL", "BOS", "CAL", "CHA", "CHN", "CIN",
           "CLE", "COL", "DET", "FLO", "HOU", "KCA", "LAN", "MIA", "MIL",
           "MIN", "MON", "NYA", "NYN", "OAK", "PHI", "PIT", "SDN", "SEA",
           "SFN", "SLN", "TBA", "TEX", "TOR", "WAS")

team_names <- c("Angels", "Diamondbacks", "Braves", "Orioles", "Red Sox",
                "Angels", "White Sox", "Cubs", "Reds", "Indians", "Rockies",
                "Tigers", "Marlins", "Astros", "Royals", "Dodgers", "Marlins",
                "Brewers", "Twins", "Expos", "Yankees", "Mets", "Athletics",
                "Phillies", "Pirates", "Padres", "Mariners", "Giants",
                "Cardinals", "Rays", "Rangers", "Blue Jays", "Nationals")

players_on_other_teams <- all_recent_players %>%
    group_by(player, team) %>%
    summarise(years=paste(year, collapse=", ")) %>%
    inner_join(current_rosters, by="player") %>%
    mutate(current_team=team.y, former_team=team.x) %>%
    select(player, current_team, former_team, years) %>%
    inner_join(data.frame(former_team=teams, former_team_name=team_names),
                by="former_team") %>%
    group_by(former_team_name, current_team) %>%
    summarise(n=n()) %>%
    group_by(former_team_name) %>%
    arrange(desc(n)) %>%
    mutate(rank=row_number()) %>%
    filter(rank!=1) %>%
    summarise(n=sum(n)) %>%
    arrange(desc(n))

names(players_on_other_teams) <- c('Former Team', 'Number of players')

kable(players_on_other_teams)

players_on_same_team <- all_recent_players %>%
    group_by(player, team) %>%
    summarise(years=paste(year, collapse=", ")) %>%
    inner_join(current_rosters, by="player") %>%
    mutate(current_team=team.y, former_team=team.x) %>%
    select(player, current_team, former_team, years) %>%
    inner_join(data.frame(former_team=teams, former_team_name=team_names),
                by="former_team") %>%
    group_by(former_team_name, current_team) %>%
    summarise(n=n()) %>%
    group_by(former_team_name) %>%
    arrange(desc(n)) %>%
    mutate(rank=row_number()) %>%
    filter(rank==1,
           former_team_name!="Expos") %>%
    summarise(n=sum(n)) %>%
    arrange(desc(n))

names(players_on_same_team) <- c('Team', 'Number of players')

kable(players_on_same_team)