Dolphin Data Visualization & Survival Analysis (with fuzzyjoin package used)

Top 5 Species Faceted by Sex

dolphins %>%
  count(species, sex, sort = T) %>%
  mutate(species = str_remove(species, "[,;].+"),
         species = fct_lump(species, n = 5, w = n),
         species = fct_reorder(species, n)
         ) %>%
  ggplot(aes(n, species, fill = species)) +
  geom_col(show.legend = F) +
  facet_wrap(~sex) +
  theme(
    strip.text = element_text(size = 10, face = "bold")
  ) +
  labs(x = "# of dolphins",
       title = "Top 5 Species Faceted by Sex")

dolphins %>%
  count(birthYear, sex, sort = T) %>%
  filter(!is.na(birthYear)) %>%
  ggplot(aes(birthYear, n, color = sex)) +
  geom_line(size = 1) +
  facet_wrap(~sex, ncol = 1) +
  theme(
    strip.text = element_text(size = 10, face = "bold")
  ) +
  labs(color = NULL,
       x = "birth year",
       y = "# of dolphins born",
       title = "Yearly Birth Counts") +
  scale_x_continuous(breaks = seq(1940, 2020, by = 10))

Birth year distribution

dolphins %>%
  ggplot(aes(birthYear)) +
  geom_histogram() 

dolphins %>%
  filter(status == "Died") %>%
  mutate(age = statusDate - originDate) %>%
  ggplot(aes(age)) +
  geom_histogram() +
  expand_limits(x = 0) +
  labs(x = "age (days)",
       title = "Dolphin Lifespan")

dolphins %>%
  filter(!is.na(birthYear),
         birthYear > 1980) %>%
  count(birthYear, acquisition, sort  = T) %>%
  #complete(birthYear, acquisition, fill = list(n = 0)) %>%
  mutate(
    acquisition = fct_lump(acquisition, n = 5, w = n),
    acquisition = fct_reorder(acquisition, n)
  ) %>%
  group_by(birthYear) %>%
  mutate(percent = n/sum(n)) %>%
  ggplot(aes(birthYear, percent, fill = acquisition)) +
  geom_area() +
  theme_minimal() +
  labs(x = "birth year", y = NULL,
       title = "Birth Year & Acquisition Status",
       subtitle = "Year after 1980") +
  scale_y_continuous(labels = percent)

As we can see from the plot above, there is some place where no color covers the plot. Using complete() from dplyr can help us cover the plot perfectly.

dolphins %>%
  filter(!is.na(birthYear),
         birthYear > 1980) %>%
  count(birthYear, acquisition, sort  = T) %>%
  complete(birthYear, acquisition, fill = list(n = 0)) %>%
  mutate(
    acquisition = fct_lump(acquisition, n = 5, w = n),
    acquisition = fct_reorder(acquisition, n)
  ) %>%
  group_by(birthYear) %>%
  mutate(percent = n/sum(n)) %>%
  ggplot(aes(birthYear, percent, fill = acquisition)) +
  geom_area() +
  theme_minimal() +
  labs(x = "birth year", y = NULL,
       title = "Birth Year & Acquisition Status",
       subtitle = "Year after 1980") +
  scale_y_continuous(labels = percent)

The following fuzzyjoin and survival analysis are mostly adopted and inspired by David Robinson’s code for learning purposes. This is my first time using both packages and practicing them here would help me shed some light on how these two packages work, especially for future reference.

fuzzyjoin package

tribble() is a nice and convenient way to compose a tibble.

regexes <- tribble(
  ~ regex, ~ category,
  "Unknown", "Unknown",
  "Gulf of Mexico", "Gulf of Mexico",
  "Florida|FL", "Florida",
  "Texas|TX", "Texas",
  "SeaWorld", "SeaWorld",
  "Pacific", "Pacific Ocean",
  "Atlantic", "Atlantic Ocean"
)

dolphins_annotated <- dolphins %>%
  mutate(unique_id = row_number()) %>%
  regex_left_join(regexes, c("originLocation" = "regex")) %>% 
  distinct(unique_id, .keep_all = TRUE) %>%
  mutate(category = coalesce(category, originLocation))

dolphins_annotated %>%
  filter(!is.na(birthYear),
         birthYear > 1990) %>%
  count(birthYear, originLocation, sort  = T) %>%
  complete(birthYear, originLocation, fill = list(n = 0)) %>%
  mutate(
    originLocation = fct_lump(originLocation, n = 5, w = n),
    originLocation = fct_reorder(originLocation, n)
  ) %>%
  group_by(birthYear) %>%
  mutate(percent = n/sum(n)) %>%
  ggplot(aes(birthYear, percent, fill = originLocation)) +
  geom_area() +
  theme_minimal() +
  labs(x = "birth year", y = NULL) +
  scale_y_continuous(labels = percent_format())

Survival Analysis

dolphin_sruvival <- dolphins %>%
  filter(status %in% c("Alive", "Died")) %>%
  mutate(deathYear = ifelse(status == "Alive", 2017, year(statusDate)),
         status = ifelse(status == "Alive", 0, 1),
         age = statusDate - originDate
  )%>%
  select(birthYear, deathYear, status, sex, age, acquisition, species)

survival_model1 <- survfit(Surv(age, status) ~ sex, dolphin_sruvival)

tidy(survival_model1) %>%
  mutate(
    strata = str_remove(strata, "sex=")
  ) %>%
  ggplot(aes(time, estimate, fill = strata, color = strata)) +
  geom_line(size = 1) +
  geom_ribbon(aes(ymin = conf.low,
              ymax = conf.high),
              alpha = 0.2) +
  scale_y_continuous(labels = percent) +
  labs(x = "days", y = "survival percentage")

survival_model2 <- survfit(Surv(birthYear, deathYear, status) ~ sex, dolphin_sruvival %>% filter(deathYear > birthYear))


tidy(survival_model2) %>%
  mutate(
    strata = str_remove(strata, "sex=")
  ) %>%
  ggplot(aes(time, estimate, fill = strata, color = strata)) +
  geom_line(size = 1) +
  geom_ribbon(aes(ymin = conf.low,
              ymax = conf.high),
              alpha = 0.2) +
  scale_y_continuous(labels = percent) +
  labs(x = "years", y = "survival percentage")

survival_model3 <- survfit(Surv(age, status) ~ acquisition, dolphin_sruvival)

tidy(survival_model3) %>%
  mutate(
    strata = str_remove(strata, "acquisition=")
  ) %>%
  ggplot(aes(time, estimate, fill = strata, color = strata)) +
  geom_line(size = 1) +
  geom_ribbon(aes(ymin = conf.low,
              ymax = conf.high),
              alpha = 0.2) +
  scale_y_continuous(labels = percent) +
  labs(x = "days", y = "survival percentage") +
  facet_wrap(~strata) +
  theme(
    legend.position = "none"
  )