week4_my_solution

Demo

testfun <- function() {}
testfun()

NULL

class(testfun)

[1] "function"

testfun <- function() {
    print("this function does nothing")
}

testfun()

[1] "this function does nothing"

testfun <- function(sometext) {
    print(sometext)
}

testfun(sometext = "this function does slightly more, but still not much")

[1] "this function does slightly more, but still not much"

my_age <- function(birthday, output_unit) {
    difftime(Sys.time(), birthday, units = output_unit)
}

my_age(birthday = "1996-09-02", output_unit = "days")

Time difference of 10430.73 days

my_age("1997-04-23", "days")

Time difference of 10197.73 days

my_age <- function(birthday="0000-01-01", output_unit = "days") {
    difftime(Sys.time(), birthday, units = output_unit)
}

# if not stated otherwise, our function uses the unit "days"
my_age("1997-04-23")

Time difference of 10197.73 days

#jesus would be
my_age() #verry old

Time difference of 739699.7 days

# We can still overwrite units
my_age("1997-04-23", "hours")

Time difference of 244745.5 hours

Task 1: Write your own functions

BMI

bmi <- function(weight, height){
  weight/(height)^2
}
bmi(weight=75,height=1.79) #bmi = 23.4

[1] 23.40751

Temperature

fahrenheit <- function(celsius=0){
  (celsius*9/5)+32
}
fahrenheit(celsius=25) #fahrenheit = 68

[1] 77

euclidian distance

euc_dist <- function(x1, y1, x2, y2) {
  sqrt((x2 - x1)^2 + (y2 - y1)^2)
}
euc_dist(x1=2,y1=3,x2=4,y2=5)

[1] 2.828427

Task 2: Prepare Analysis

library("dplyr")

Attaching package: 'dplyr'

The following objects are masked from 'package:stats':

    filter, lag

The following objects are masked from 'package:base':

    intersect, setdiff, setequal, union

library("tidyr")
library("readr")


wildschwein_BE <- read_delim("wildschwein_BE_2056.csv", delim=",")

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.

wildschw_filter <- wildschwein_BE |> 
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"))

Task 3: Create Join Key

library("lubridate")

Attaching package: 'lubridate'

The following objects are masked from 'package:base':

    date, intersect, setdiff, union

wildschw_rounded <- wildschw_filter |> 
  mutate(RoundedDatetime = round_date(DatetimeUTC, "15 minutes"))

Task 4: Measuring distance at concurrent locations

1. Split the wildschwein_filter object into one data.frame per animal

wildschw_rosa <- wildschw_rounded |> filter(TierName == "Rosa")
wildschw_sabi <- wildschw_rounded |> filter(TierName == "Sabi")

2. Join these datasets by the new Datetime column created in the last task. The joined observations are temporally close.

wildschw_join <- inner_join(wildschw_rosa, wildschw_sabi, by = "RoundedDatetime", suffix = c("_Rosa", "_Sabi"))

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

euc_dist <- wildschw_join |> 
  mutate(
    distance = sqrt((E_Rosa - E_Sabi)^2 + (N_Rosa - N_Sabi)^2),
    meet = distance <= 100  # TRUE if the distance is less than or equal to 100 meters
  )

meets <- euc_dist |> 
  filter(meet == TRUE)

Task 5: Visualize data

library(ggplot2)
wildschw_rosa |>
    ggplot(aes(E,N)) +
    geom_point(color="lightblue",alpha=0.4) +
    geom_point(data=wildschw_sabi,color="orchid",alpha=0.4)+
    geom_point(data=meets,aes(E_Sabi,N_Sabi),color="red")+
    geom_point(data=meets,aes(E_Rosa,N_Rosa),color="blue")+
    coord_fixed()

or with legend: (with help from ChatGPT)

library(ggplot2)
library(ggnewscale)

ggplot() +
  # Regular locations
  geom_point(data = wildschw_rosa, aes(E, N, color = "rosa"), alpha = 0.4) +
  geom_point(data = wildschw_sabi, aes(E, N, color = "sabi"), alpha = 0.4) +
  scale_color_manual(
    name = "Regular Locations",
    values = c("rosa" = "lightblue", "sabi" = "orchid")
  ) +
  # Add new color scale for meets
  new_scale_color() +
  geom_point(data = meets, aes(E_Sabi, N_Sabi, color = "sabi"), size = 2) +
  geom_point(data = meets, aes(E_Rosa, N_Rosa, color = "rosa"), size = 2) +
  scale_color_manual(
    name = "Meets",
    values = c("rosa" = "blue", "sabi" = "red")) +
  coord_fixed(
    xlim = c(2569500, 2571200),
    ylim = c(1204300, 1205800))