eda_caribou.Rmd

# 探索性数据分析-驯鹿迁移 {#eda-caribou}

本章我们分析加拿大哥伦比亚林地**驯鹿追踪数据**，数据包含了从1988年到2016年期间260只驯鹿，近250000个位置标签。

## 驯鹿位置跟踪

```{r eda-caribou-1, out.width='85%', fig.align='left', echo=FALSE}
knitr::include_graphics("images/caribou_location.png")
```


大家可以在[这里](https://github.com/tacookson/data/tree/master/caribou-location-tracking)了解数据集的信息，它包含了两个数据集


```{r eda-caribou-2, eval=FALSE}
# devtools::install_github("thebioengineer/tidytuesdayR")
library(tidytuesdayR)

tuesdata <- tidytuesdayR::tt_load("2020-06-23")
# or
# tuesdata <- tidytuesdayR::tt_load(2020, week = 26)
```



```{r eda-caribou-3, message=FALSE, warning=FALSE}
library(tidyverse)
library(lubridate)
library(gganimate)

individuals <- readr::read_csv("./demo_data/caribou/individuals.csv")
locations <- readr::read_csv("./demo_data/caribou/locations.csv")
```


## 驯鹿的身份信息

```{r eda-caribou-4}
individuals %>% glimpse()
```


```{r eda-caribou-5}
individuals %>% count(animal_id)
```


我们发现有重复id的，怎么办？
```{r eda-caribou-6}
individuals %>% janitor::get_dupes(animal_id)
```



```{r eda-caribou-7}
individuals %>%
  filter(deploy_on_latitude > 50) %>%
  ggplot(aes(x = deploy_on_longitude, y = deploy_on_latitude)) +
  geom_point(aes(color = study_site)) #+
# borders("world", regions = "china")
```


## 性别比例


## 每个站点运动最频繁的前10的驯鹿


## 驯鹿的活动信息

简单点说，就是哪个驯鹿在什么时间出现在什么地方



```{r eda-caribou-8}
locations %>%
  ggplot(aes(x = longitude, y = latitude)) +
  geom_point(aes(color = study_site))
```



## 被追踪最多次的驯鹿的轨迹

```{r eda-caribou-9}
top_animal_ids <-
  count(locations, animal_id, sort = TRUE) %>%
  slice(1:10) %>%
  pull(animal_id)


locations %>%
  filter(animal_id %in% top_animal_ids) %>%
  arrange(animal_id, timestamp) %>%
  group_by(animal_id) %>%
  mutate(measurement_n = row_number()) %>%
  ggplot(aes(
    x = longitude,
    y = latitude,
    color = animal_id,
    alpha = measurement_n
  )) +
  geom_point(show.legend = FALSE, size = 1) +
  geom_path(show.legend = FALSE, size = 1) +
  # scale_color_manual(values = ) +
  theme_minimal() +
  theme(
    plot.title = element_text(size = 20, face = "bold"),
    plot.subtitle = element_text(size = 10),
    text = element_text(color = "White"),
    panel.grid.minor = element_blank(),
    panel.grid.major = element_line(color = "gray60", size = 0.05),
    plot.background = element_rect(fill = "gray10"),
    axis.text = element_text(color = "white")
  ) +
  labs(
    x = "\nLongitude", y = "Latitude\n",
    title = "Caribou movement tracking",
    subtitle = "Latitude and longitude locations of the animals with the highest number of measurements\n",
    caption = "Tidy Tuesday: Caribou Location Tracking"
  )
```


## 某一只驯鹿的轨迹
```{r eda-caribou-10}
locations %>%
  dplyr::filter(animal_id %in% c("QU_car143")) %>%
  dplyr::arrange(animal_id, timestamp) %>%
  dplyr::group_by(animal_id) %>%
  dplyr::mutate(measurement_n = row_number()) %>%
  ggplot(aes(
    x = longitude,
    y = latitude,
    color = measurement_n,
    alpha = measurement_n
  )) +
  geom_point(show.legend = FALSE, size = 1) +
  geom_path(show.legend = FALSE, size = 1) +
  scale_color_gradient(low = "white", high = "firebrick3") +
  theme_minimal() +
  theme(
    plot.title = element_text(size = 20, face = "bold"),
    plot.subtitle = element_text(size = 10),
    text = element_text(color = "White"),
    panel.grid.minor = element_blank(),
    panel.grid.major = element_line(color = "gray60", size = 0.05),
    plot.background = element_rect(fill = "gray10"),
    axis.text = element_text(color = "white")
  ) +
  labs(
    x = "\nLongitude", y = "Latitude\n",
    title = "QU_car143 movement tracking",
    subtitle = "Latitude and longitude locations of the animals with the highest number of measurements\n Ligher colors indicate earlier measurements",
    caption = "Tidy Tuesday: Caribou Location Tracking"
  )
```


## 选择某个驯鹿，查看他的活动轨迹

```{r eda-caribou-11}
example_animal <- locations %>%
  dplyr::filter(animal_id == sample(animal_id, 1)) %>%
  dplyr::arrange(timestamp)
example_animal
```


```{r eda-caribou-12, eval=FALSE}
"2010-03-28 21:00:44" %>% lubridate::as_date()
"2010-03-28 21:00:44" %>% lubridate::as_datetime()
"2010-03-28 21:00:44" %>% lubridate::quarter()
```

```{r eda-caribou-13}
example_animal %>%
  dplyr::mutate(date = lubridate::as_date(timestamp)) %>%
  ggplot(aes(x = longitude, y = latitude, color = date)) +
  geom_path()
```

```{r eda-caribou-14}
example_animal %>%
  dplyr::mutate(quarter = lubridate::quarter(timestamp) %>% as.factor()) %>%
  ggplot(aes(x = longitude, y = latitude, color = quarter)) +
  geom_path() +
  facet_wrap(vars(quarter)) +
  labs(title = "A little reindeer ran around")
```

## 季节模式

看看驯鹿夏季和冬季运动模式，这段代码来自gkaramanis

```{r eda-caribou-15}
movement <- locations %>%
  filter(study_site != "Hart Ranges") %>%
  mutate(
    season = fct_rev(season),
    longitude = round(longitude, 2),
    latitude = round(latitude, 2)
  ) %>%
  distinct(season, study_site, longitude, latitude)



ggplot(movement) +
  geom_point(aes(longitude, latitude,
    group = study_site,
    colour = study_site
  ), size = 0.1) +
  gghighlight::gghighlight(
    unhighlighted_params = list(colour = "grey70"), use_direct_label = FALSE
  ) +
  scale_colour_manual(
    values = c("#ffe119", "#4363d8", "#f58231", "#e6194B", "#800000", "#000075", "#f032e6", "#3cb44b"),
    breaks = c("Graham", "Scott", "Moberly", "Burnt Pine", "Kennedy", "Quintette", "Narraway")
  ) +
  guides(colour = guide_legend(title = "Herd", override.aes = list(size = 3))) +
  coord_fixed(ratio = 1.5) +
  facet_wrap(vars(season), ncol = 2) +
  # labs(
  #   title = "Migration patterns of Northern Caribou\nin the South Peace of British Columbia",
  # 	subtitle = str_wrap("In summer, most caribou migrate towards the central core of the Rocky Mountains where they use alpine and subalpine habitat. The result of this movement to the central core of the Rocky Mountains is that some of the east side herds can overlap with west side herds during the summer.", 100),
  # 	caption = str_wrap("Source: Seip DR, Price E (2019) Data from: Science update for the South Peace Northern Caribou (Rangifer tarandus caribou pop. 15) in British Columbia. Movebank Data Repository. https://doi.org/10.5441/001/1.p5bn656k | Graphic: Georgios Karamanis", 70)
  # ) +
  theme_void() +
  theme(
    legend.position = c(0.5, 0.6),
    legend.text = element_text(size = 11, colour = "#F9EED9"),
    legend.title = element_text(size = 16, hjust = 0.5, colour = "#F9EED9"),
    panel.spacing.x = unit(3, "lines"),
    plot.margin = margin(20, 20, 20, 20),
    plot.background = element_rect(fill = "#7A6A4F", colour = NA),
    strip.text = element_text(colour = "#F9EED9", size = 18),
    plot.title = element_text(colour = "white", size = 20, hjust = 0, lineheight = 1),
    plot.subtitle = element_text(colour = "white", size = 12, hjust = 0, lineheight = 1, margin = margin(10, 0, 50, 0)),
    plot.caption = element_text(colour = "grey80", size = 7, hjust = 1, margin = margin(30, 0, 10, 0))
  )
```


## 迁移速度

```{r eda-caribou-16}
location_with_speed <- locations %>%
  dplyr::group_by(animal_id) %>%
  dplyr::mutate(
    last_longitude = lag(longitude),
    last_latitude = lag(latitude),
    hours = as.numeric(difftime(timestamp, lag(timestamp), units = "hours")),
    km = geosphere::distHaversine(
      cbind(longitude, latitude), cbind(last_longitude, last_latitude)
    ) / 1000,
    speed = km / hours
  ) %>%
  dplyr::ungroup()

location_with_speed
```


```{r eda-caribou-17}
location_with_speed %>%
  ggplot(aes(x = speed)) +
  geom_histogram() +
  scale_x_log10()
```


## 动态展示

```{r eda-caribou-18, eval=FALSE}
library(gganimate)

example_animal %>%
  ggplot(aes(x = longitude, y = latitude)) +
  geom_point() +
  transition_time(time = timestamp) +
  shadow_mark(past = TRUE) +
  labs(title = "date is {frame_time}")
```

## 更多

```{r eda-caribou-19, eval=FALSE}
df <- locations %>%
  dplyr::filter(
    study_site == "Graham",
    year(timestamp) == 2002
  ) %>%
  dplyr::group_by(animal_id) %>%
  dplyr::filter(
    as_date(min(timestamp)) == "2002-01-01",
    as_date(max(timestamp)) == "2002-12-31"
  ) %>%
  dplyr::ungroup() %>%
  dplyr::mutate(date = as_date(timestamp)) %>%
  dplyr::group_by(animal_id, date) %>%
  dplyr::summarise(
    longitude_centroid = mean(longitude),
    latitude_centroid = mean(latitude)
  ) %>%
  dplyr::ungroup() %>%
  tidyr::complete(animal_id, date) %>%
  dplyr::arrange(animal_id, date) %>%
  tidyr::fill(longitude_centroid, latitude_centroid, .direction = "down")
```


```{r eda-caribou-20, eval=FALSE}
p <- df %>%
  ggplot(aes(longitude_centroid, latitude_centroid, colour = animal_id)) +
  geom_point(size = 2) +
  coord_map() +
  theme_void() +
  theme(legend.position = "none") +
  transition_time(time = date) +
  shadow_mark(alpha = 0.2, size = 0.8) +
  ggtitle("Caribou location on {frame_time}")
p
```










```{r eda-caribou-21, echo = F}
# remove the objects
# rm(list=ls())
rm(example_animal, individuals, location_with_speed, locations, movement, top_animal_ids)
```

```{r eda-caribou-22, echo = F, message = F, warning = F, results = "hide"}
pacman::p_unload(pacman::p_loaded(), character.only = TRUE)
```