Week 5: Tasks and inputs

Task 1: Write your own functions

# A function which calculates a persons BMI based on their height and weight
bmi <- function(weight, height) {
  bmi_value <- weight/height^2
  bmi_value # Wert zurückgeben
}

bmi(55, 1.63)
[1] 20.70082
# A function which converts degrees Celcius to Farenheight

calculate_farenheight<- function(celcius) {
  farenheight <- celcius*(9/5) +32
  farenheight
}

calculate_farenheight(26)
[1] 78.8
# A function which calculates the (Euclidean) distance between two sets of coordinates

calculate_euclidean <- function(x1, x2, y1, y2) {
  sqrt((x2-x1)^2 + (y2-y1)^2)
}

calculate_euclidean(2691454, 2691570, 1230296, 1230270)
[1] 118.8781

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. 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.

library(readr)
library(tidyverse)
── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
✔ dplyr     1.2.1     ✔ purrr     1.2.2
✔ forcats   1.0.1     ✔ stringr   1.6.0
✔ ggplot2   4.0.3     ✔ tibble    3.3.1
✔ lubridate 1.9.5     ✔ tidyr     1.3.2
── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag()    masks stats::lag()
ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
wildschwein<- read_delim("wildschwein_BE_2056.csv")
Rows: 51246 Columns: 6
── Column specification ────────────────────────────────────────────────────────
Delimiter: ","
chr  (2): TierID, TierName
dbl  (3): CollarID, E, N
dttm (1): DatetimeUTC

ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
from <- as.POSIXct("2015-04-01", tz = "UCT")
to <- as.POSIXct("2015-04-15", tz = "UCT")

wildschwein_filter <- wildschwein |> 
  filter(TierName == "Rosa" | TierName == "Sabi",
        DatetimeUTC >= from, 
        DatetimeUTC < to)

Task 3: Create Join Key

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 therefoe 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 column. You can use the lubridate function round_date() for this.

library(lubridate)

wildschwein_filter <- wildschwein_filter |> 
  mutate(DatetimeRound = round_date(DatetimeUTC, unit = "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

# Split the wildschwein_filter object into one data.frame per animal
Sabi <- wildschwein_filter |>
  filter(TierName == "Sabi")
  
Rosa <- wildschwein_filter |> 
  filter(TierName == "Rosa")
# Join these datasets by the new Datetime column 
library(dplyr)

wildschwein_join <- inner_join(Sabi, Rosa, by = "DatetimeRound")

wildschwein_join <- wildschwein_join |> 
  rename(x1 = E.x, x2 = E.y, y1 = N.x, y2 = N.y, TierName1 = TierName.x, TierName2 = TierName.y)
#  calculate Euclidean distances between concurrent observations

calculate_euclidean <- function(x1, x2, y1, y2) {
  sqrt((x2-x1)^2 + (y2-y1)^2)
}

wildschwein_join <- wildschwein_join |> 
  mutate(distance = calculate_euclidean(wildschwein_join$x1, wildschwein_join$x2, wildschwein_join$y1, wildschwein_join$y2))
# 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

threshold <- 100

wildschwein_join <- wildschwein_join |> 
  mutate(Meets = distance < threshold)

Task 5: Visualize data

Now, visualize the meets spatially in a way that you think reasonable. For example in the plot as shows below. To produce this plot we:

  • Used the individual dataframes from rosa and sabi (from the previous task)

  • Used the joined dataset (also from the previous task), filtered to only the meets

  • Manually changed the x and y axis limits

library(ggplot2)
library(tidyr)

wildschwein_join2 <- wildschwein_join |> 
  filter(Meets == TRUE) |> 
  pivot_longer(c(TierName1, TierName2), values_to = "TierName")

ggplot() +
  geom_point(data = Rosa, aes(E, N, colour = TierName, alpha = .1)) +
  geom_point(data = Sabi, aes(E, N, colour = TierName, alpha = .1)) +
  geom_point(data = wildschwein_join2, aes(x1, y1, fill = TierName))

Task 6 : Visualize data as timecube with plotly

Finally, you can nicely visualize the meeting patterns and trajectories in a Space-Time-Cube (Hägerstraand 1970) with the package plotly. There are some nice ressources available online.

# install.packages("plotly")
library(plotly)

Attache Paket: 'plotly'
Das folgende Objekt ist maskiert 'package:ggplot2':

    last_plot
Das folgende Objekt ist maskiert 'package:stats':

    filter
Das folgende Objekt ist maskiert 'package:graphics':

    layout
wildschwein_join3 <- wildschwein_join |> 
  pivot_longer(c(TierName1, TierName2), values_to = "TierName")


fig <- plot_ly(Rosa, x = ~E, y = ~N, z = ~DatetimeRound, type = 'scatter3d', mode = 'lines',
        line = list(color = '#1f77b4', width = 1))
fig <- fig %>% add_trace(data = Sabi, x = ~E, y = ~N, z = ~DatetimeRound,
            line = list(color = 'rgb(44, 160, 44)', width = 1))
fig <- fig %>% add_trace(data = wildschwein_join2, x = ~x1, y = ~y1, z = ~DatetimeRound, mode = "markers",
            marker = list(color = "green", width = 1)) %>%
  layout(showlegend = FALSE)

fig
A line object has been specified, but lines is not in the mode
Adding lines to the mode...