Patterns and Trends - Exercise 5

Author

Dominik Erni

Task 1: Write your own functions

Create the following two functions:

  1. A function which calculates a persons BMI based on their height and weight Figure 1 (22.1)
  2. A function which converts degrees Celcius to Farenheight Figure 1 (22.2)
  3. A function which calculates the (Euclidean) distance between two sets of coordinates Figure 1 (22.3)
Figure 1: Equations 
# Function 1:
bmi <- function(weight_kg, height_m) {
  weight_kg/height_m^2
}
bmi(70, 1.77)
[1] 22.34352
# Function 2:
Farenheight <- function(celcius) {celcius * 9/5 + 32}
Farenheight(25)
[1] 77
# Function 3:
Euclidean_distance <- function(x1, y1, x2, y2) {
  sqrt((x2 - x1)^2 + (y2 - y1)^2)
}

Euclidean_distance(1,1,2,2)
[1] 1.414214

Task 2: Prepare Analysis

In the next tasks we will look for “meet” patterns in our wild boar data. To simplify this, we will only use a subset of our wild boar data: The individuals Rosa and Sabi for the timespan 01.04.2015 - 15.04.2015. Use the dataset wildschwein_BE_2056.csv (on moodle). Import the csv as a data.frame and filter it with the aforementioned criteria. You do not need to convert the data.frame to an sf object.

# Load R-Packages:
library(readr)
library(tidyverse)
library(sf)
library(lubridate)
boar <- read_delim("data/wildschwein_BE_2056.csv")
boar <- boar %>%
  filter(
    TierName %in% c("Sabi", "Rosa"),
    DatetimeUTC >= as.POSIXct("2015-04-01 00:00:00", tz = "UTC") & 
    DatetimeUTC <= as.POSIXct("2015-04-15 23:59:59", tz = "UTC")
  ) %>%
  arrange(DatetimeUTC)

Task 3: Create Join Key

Have a look at your dataset. You will notice that samples are taken at every full hour, quarter past, half past and quarter to. The sampling time is usually off by a couple of seconds.

To compare Rosa and Sabi’s locations, we first need to match the two animals temporally. For that we can use a join, but need identical time stamps to serve as a join key. We therefore need to slightly adjust our time stamps to a common, concurrent interval.

The task is therfore to round the minutes of DatetimeUTC to a multiple of 15 (00, 15, 30,45) and store the values in a new column1. You can use the lubridate function round_date() for this.

boar <- boar |> 
  mutate(
    Datetime_round = round_date(DatetimeUTC, "15 mins")
  )

Task 4: Measuring distance at concurrent locations

To measure the distance between concurrent locations, we need to follow the following steps.

  1. Split the wildschwein_filter object into one data.frame per animal
  2. Join these datasets by the new Datetime column created in the last task. The joined observations are temporally close.
  3. In the joined dataset, calculate Euclidean distances between concurrent observations and store the values in a new column
  4. Use a reasonable threshold on distance to determine if the animals are also spatially close enough to constitute a meet (we use 100 meters). Store this Boolean information (TRUE/FALSE) in a new column
# Splitting the dataset by animal
boar_split <- boar |> 
  group_split(TierID)

# Renaming columns for merging
boar_1 <- boar_split[[1]] |> 
  rename(E1 = E, N1 = N) |> 
  select(TierID, TierName, Datetime_round, E1, N1)

boar_2 <- boar_split[[2]] |> 
  rename(E2 = E, N2 = N) |> 
  select(TierID, TierName, Datetime_round, E2, N2)

# Merging datasets by rounded datetime
boar_joined <- full_join(boar_1, boar_2, by = "Datetime_round") |>
  drop_na()

# Calculating Euclidean distance
boar_joined <- boar_joined |> 
  mutate(distance = sqrt((E2 - E1)^2 + (N2 - N1)^2),
         meet = distance <= 100)  # 100m threshold

Task 5: Visualize data

# Visualise
boar_meet <- boar_joined |> 
  filter(meet == T)

ggplot() +
  # Points for boar_1 with color and alpha
  geom_point(data = boar_1, aes(x = E1, y = N1, color = "Sabi"), alpha = 0.5) +
  geom_point(data = boar_2, aes(x = E2, y = N2, color = "Rosa"), alpha = 0.5) +
  geom_point(data = boar_meet, aes(x = E1, y = N1, color = "Boar Meeting (not via Teams)"), alpha = 0.8, shape = 10, stroke = 1) +
  # Customize the legend labels and colors
  scale_color_manual(values = c("Sabi" = "pink", "Rosa" = "orange", "Boar Meeting (not via Teams)" = "brown")) +
  labs(x = "E", y = "N", color = "Legend") +
  theme_minimal()