week5

Demo tasks

testfunc <- function(x){print(x)}

#sometext exists within function
testfunc("this function is slightly more")

[1] "this function is slightly more"

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

#output_unit="auto" is default paramater,
my_age(birthday = "1997-04-23", output_unit = "days")

Time difference of 10619.45 days

#browser() to debug within functions

Task 1

bim <- function(weight, height, output_unit="auto") {
  bim <- weight/height
  units <- output_unit
  
  list(bim=bim, units=units )
}

bim(70, 180)

$bim
[1] 0.3888889

$units
[1] "auto"

farenheight <- function(celsius, output_unit="auto") {celsius * (9/5) + 32}
farenheight(20)

[1] 68

euclidean_dist <- function(x1,y1,x2, y2, output_unit="auto") {sqrt((x2-x1)^2 + (y2-y1)^2)}
euclidean_dist(1,2,7,3)

[1] 6.082763

#Task 2

library("readr")

Warning: Paket 'readr' wurde unter R Version 4.5.3 erstellt

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.

# filter for only taking rosa and Sabi and for specific timewindow
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 %>%
  filter(
    TierName %in% c("Rosa", "Sabi"),
    DatetimeUTC >= as.POSIXct("2015-04-01 00:00:00"),
    DatetimeUTC <= as.POSIXct("2015-04-15 23:59:59")
  )

# A tibble: 2,863 × 6
   TierID TierName CollarID DatetimeUTC                E        N
   <chr>  <chr>       <dbl> <dttm>                 <dbl>    <dbl>
 1 002A   Sabi        12275 2015-03-31 22:00:28 2570296. 1205283.
 2 002A   Sabi        12275 2015-03-31 22:15:44 2570259. 1205259.
 3 002A   Sabi        12275 2015-03-31 22:30:44 2570255. 1205259.
 4 002A   Sabi        12275 2015-03-31 22:46:04 2570245. 1205268.
 5 002A   Sabi        12275 2015-03-31 23:00:17 2570364. 1205314.
 6 002A   Sabi        12275 2015-03-31 23:15:12 2570375. 1205320.
 7 002A   Sabi        12275 2015-03-31 23:30:08 2570411. 1205347.
 8 002A   Sabi        12275 2015-03-31 23:45:13 2570429. 1205361.
 9 002A   Sabi        12275 2015-04-01 00:00:11 2570372. 1205313.
10 002A   Sabi        12275 2015-04-01 00:15:22 2570309. 1205262.
# ℹ 2,853 more rows

Task 3

#preprocessing for creating temporal join

library(lubridate)

Warning: Paket 'lubridate' wurde unter R Version 4.5.3 erstellt

Attache Paket: 'lubridate'

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

    date, intersect, setdiff, union

wildschwein$DatetimeUTC_15rounded <- round_date(
  wildschwein$DatetimeUTC,
  unit = "15 minutes",
  week_start = getOption("lubridate.week.start", 7)
)

# Create separate dataframe for each animal
rosa <- wildschwein %>% filter(TierName=="Rosa")
Sabi <- wildschwein %>% filter(TierName=="Sabi")

#Temporal join
joined_df <- inner_join(rosa, Sabi, by = "DatetimeUTC_15rounded")

Warning in inner_join(rosa, Sabi, by = "DatetimeUTC_15rounded"): Detected an unexpected many-to-many relationship between `x` and `y`.
ℹ Row 1383 of `x` matches multiple rows in `y`.
ℹ Row 6281 of `y` matches multiple rows in `x`.
ℹ If a many-to-many relationship is expected, set `relationship =
  "many-to-many"` to silence this warning.

Task 4

joined_df$dist<- euclidean_dist(joined_df$E.x, joined_df$N.x, joined_df$E.y, joined_df$N.y)

joined_df$meet <- joined_df$dist < 100

Task 5

plot(rosa$E, rosa$N,
     col = "red", pch = 16,
     xlim = range(c(rosa$E, Sabi$E)),
     ylim = range(c(rosa$N, Sabi$N)),
     xlab = "E", ylab = "N",
     main = "Meets between Rosa and Sabi")

points(Sabi$E, Sabi$N,
       col = "blue", pch = 16)

points(joined_df$E.x[joined_df$meet],
       joined_df$N.x[joined_df$meet],
       col = "black", pch = 19, cex = 1.3)