CMA_Week5

Demo: R Funktions

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"

class(testfun)

[1] "function"

You can add options to executable code like this

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

my_age(birthday = "1997-04-23", output_unit = "days")

Time difference of 10193.48 days

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

Time difference of 10193.48 days

my_age <- function(birthday, 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 10193.48 days

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

Time difference of 244643.6 hours

Tasks and inputs

Task 1: Write your own functions

1. Function which calculates a persons BMI based on their height and weight

calculate_bmi <- function(weight, height) {
  bmi = weight / (height^2)
  return(bmi)
}
calculate_bmi(weight = 70, height = 1.75)

[1] 22.85714

2. Function which converts degrees Celsius to Farenheit

calculate_farenheight <- function(celsius, farenheigt) {
  farenheight = celsius*(9/5)+32
  return(farenheight)
}
calculate_farenheight(celsius=5)

[1] 41

3. Function which calculates Euclidean distance between two sets of coordinates

euclidean_distance = function(x1,y1,x2,y2) {
  sqrt((x2-x1)^2 + (y2-y1)^2)
}
euclidean_distance(0,0,1,1)

[1] 1.414214

Task 2: Write your own functions

Subset of our wild boar data: Individuals Rosa and Sabi for 01.04.2015 - 15.04.2015 mit dem Dataset Wildschwein_BE_2056.csv

library("readr")
library("dplyr")

Attache Paket: 'dplyr'

Die folgenden Objekte sind maskiert von 'package:stats':

    filter, lag

Die folgenden Objekte sind maskiert von 'package:base':

    intersect, setdiff, setequal, union

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

subset_wildschwein = wildschwein_BE |> 
  filter(TierName %in% c("Sabi", "Rosa")) |>
  filter(DatetimeUTC >= as.POSIXct("2015-04-01",tz = "UTC") & DatetimeUTC <= as.POSIXct("2015-04-15", tz = "UTC"))

Task 3: Create Join Key

Round the minutes of DatetimeUTC to a multiple of 15 and store the values in a new column.

library(lubridate)

Attache Paket: 'lubridate'

Die folgenden Objekte sind maskiert von 'package:base':

    date, intersect, setdiff, union

subset_wildschwein$Datetime_rounded = round_date(subset_wildschwein$DatetimeUTC,
           unit = "15 minutes",
           )

Task 4: Measuring distance at concurrent locations

Measure distance between concurrent locations

library(dplyr)
wildschwein_list = split(subset_wildschwein, subset_wildschwein$TierName)
wildschwein_sabi = wildschwein_list[["Sabi"]]
wildschwein_rosa = wildschwein_list[["Rosa"]]

wildschwein_join = inner_join(wildschwein_sabi,wildschwein_rosa,by="Datetime_rounded",suffix= c("_Sabi", "_Rosa"))

wildschwein_join = wildschwein_join |> 
  mutate(Euclidean_Distance = sqrt((E_Sabi - E_Rosa)^2 + (N_Sabi - N_Rosa)^2))

wildschwein_join = wildschwein_join |> 
  mutate(meet = ifelse(Euclidean_Distance <= 100,TRUE, FALSE))

Task 5: Visualize data

library(ggplot2)
library(dplyr)

filter_meets = wildschwein_join |> 
  filter(meet == TRUE)

ggplot() +
  geom_point(data=subset_wildschwein, aes(x = E, y = N, color=TierName)) +
  geom_point(data=filter_meets, aes (x = E_Sabi, y = N_Sabi, shape = TierName_Sabi), color = "black") +
  geom_point(data=filter_meets, aes (x = E_Rosa, y = N_Rosa, shape = TierName_Rosa), color = "black") +
  labs(x = "E", y = "N", color = "Standorte", shape = "Treffpunkte") +
  theme_minimal()