Exercise_6

Setup

library("readr")
library("sf")

Linking to GEOS 3.12.1, GDAL 3.8.4, PROJ 9.3.1; sf_use_s2() is TRUE

library(terra)

terra 1.7.83

library(ggplot2)
library(dplyr)

Attache Paket: 'dplyr'

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

    intersect, union

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

    filter, lag

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

    intersect, setdiff, setequal, union

library(lubridate)

Attache Paket: 'lubridate'

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

    intersect, union

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

    date, intersect, setdiff, union

wildschwein_BE <- read_delim("wildschwein_BE_2056.csv", ",") |>
    st_as_sf(coords = c("E", "N"), crs = 2056, remove = FALSE)

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.

feldaufnahmen <- read_sf("Feldaufnahmen_Fanel.gpkg")

#schnelle Darstellung einer Spalte
plot(feldaufnahmen["Frucht"])

What information does the dataset contain?

• Polygons depicting different kind of crops

What ist the geomatry type of the dataset?

• Polygons

What is the coodinate system of the dataset?

• CH1903+

Task 2

wildschwein_BE <- wildschwein_BE %>%
  filter(month(DatetimeUTC) %in% c(5, 6)) 

wildschwein_BE2 <- st_join(wildschwein_BE, feldaufnahmen)
# for every location of wildboar, info for type of land cover

wildschewein_BE3 <- st_join(feldaufnahmen, wildschwein_BE)
# get polygon back -> this join not useful in this case

# to verify if at same place -> for quick look at data
plot(feldaufnahmen["Frucht"])
plot(st_geometry(wildschwein_BE), add =TRUE)

Task 3

wildschwein_smry <- wildschwein_BE2 %>% 
  st_drop_geometry() %>%
  mutate(
    hour = hour(round_date(DatetimeUTC, "hour"))
  ) %>%
  group_by(TierName, hour, Frucht) %>%
  summarise( n =n()) %>%
  group_by(TierName, hour) %>%
  mutate(perc = n/sum(n))

`summarise()` has grouped output by 'TierName', 'hour'. You can override using
the `.groups` argument.

wildschwein_smry %>% ggplot(aes(hour, perc, fill = Frucht))+
  geom_col() +
  facet_wrap(~TierName)

wildschwein_BE2 <- wildschwein_BE2 %>%
  mutate(hour = hour(ymd_hms(DatetimeUTC))) %>%
  group_by(TierName, hour, Frucht) %>%
  summarise(count = n(), .groups = "drop") %>%
  group_by(TierName, hour) %>%
  mutate(percentage = count / sum(count) * 100)

ggplot(wildschwein_BE2, aes(x = hour, y = percentage, fill = Frucht)) +
  geom_area(position = "stack") +
  facet_wrap(~TierName) +  # Creates separate panels for each wild boar
  theme_minimal() +
  labs(
    x = "Time (rounded to the nearest hour)",
    y = "Percentage",
    fill = "Frucht"
  )  

Task 4

veg <- rast("vegetationshoehe_LFI.tif")
plot(veg, main = "Vegetation Height")

# high resolution vegetation
library(tmap)
tmap_mode("plot")

ℹ tmap mode set to "plot".

tm_shape(veg) +
  tm_raster(palette = terrain.colors(10), title = "Vegetation Height [m]") +
  tm_layout(legend.outside = TRUE)

── tmap v3 code detected ───────────────────────────────────────────────────────
[v3->v4] `tm_tm_raster()`: migrate the argument(s) related to the scale of the
visual variable `col` namely 'palette' (rename to 'values') to col.scale =
tm_scale(<HERE>).[v3->v4] `tm_raster()`: migrate the argument(s) related to the legend of the
visual variable `col` namely 'title' to 'col.legend = tm_legend(<HERE>)'SpatRaster object downsampled to 2753 by 3634 cells.

Task 5

wildboar_veg <- extract(veg, wildschwein_BE)
nrow(wildboar_veg)

[1] 15559

nrow(wildschwein_BE)

[1] 15559

wildschwein_BE$veg <- wildboar_veg$vegetationshoehe_LFI
wildschwein_5 <- wildschwein_BE %>%
  mutate(
    hour = hour(round_date(DatetimeUTC, "hour")), 
    veg_class = case_when(
      veg < 1 ~ "open", 
      veg < 5 ~ "Shrub",
      veg < 15 ~ "Young Forest",
      veg >= 15 ~ "Mature Forest",
      TRUE ~ NA_character_
    )
  )
    
wildschwein_5 <- wildschwein_5 %>%
  st_drop_geometry() %>%
  group_by(TierName, hour, veg_class) %>%
  summarise(count = n(), .groups = "drop") %>%
  group_by(TierName, hour) %>%
  mutate(percentage = count / sum(count) * 100)


ggplot(wildschwein_5, aes(x = hour, y = percentage, fill = veg_class)) +
  geom_area(position = "stack") +
  facet_wrap(~TierName) +
  scale_fill_brewer(palette = "YlGnBu") +
  labs(
    x = "Hour of Day",
    y = "Percentage of Locations",
    fill = "Vegetation Class"
  ) +
  theme_minimal()