MCA - Exercise 6

Author

Anna

Preparation

library("readr")
library("sf")
library(terra)
library(ggplot2)
library(dplyr)
library(lubridate)

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

feldaufnahmen <- read_sf("data/Feldaufnahmen_Fanel.gpkg")

Task 1

What information does the dataset contain?

feldaufnahmen
Simple feature collection with 975 features and 2 fields
Geometry type: POLYGON
Dimension:     XY
Bounding box:  xmin: 2568099 ymin: 1199766 xmax: 2578824 ymax: 1207836
Projected CRS: CH1903+ / LV95
# A tibble: 975 × 3
   FieldID Frucht                                                           geom
     <dbl> <chr>                                                   <POLYGON [m]>
 1       1 Roggen ((2570914 1202743, 2570917 1202749, 2570985 1202833, 2571294 …
 2       0 <NA>   ((2570893 1202758, 2570893 1202758, 2570959 1202845, 2570985 …
 3       0 <NA>   ((2570868 1202776, 2570872 1202781, 2570913 1202828, 2570946 …
 4       2 Wiese  ((2570882 1203234, 2570641 1202974, 2570630 1202983, 2570606 …
 5       3 Weide  ((2570249 1203116, 2570371 1203328, 2570481 1203197, 2570390 …
 6       5 Weide  ((2570378 1203320, 2570466 1203436, 2570552 1203289, 2570481 …
 7       6 Weide  ((2570466 1203436, 2570572 1203495, 2570659 1203433, 2570659 …
 8       4 Weide  ((2569706 1203278, 2569706 1203342, 2570199 1203198, 2570223 …
 9       7 Wiese  ((2570804 1203310, 2570805 1203312, 2570900 1203608, 2571208 …
10       0 Wald   ((2571004 1202990, 2571041 1203029, 2571073 1203003, 2571035 …
# ℹ 965 more rows

What information does the dataset contain?

  • We have polygons depicting different kinds of crops.

What is the geometry type of the dataset (possible types are: Point, Lines and Polygons)?

  • We have polygons.

What is the coordinate system of the dataset?

  • CH1903+

Task 2

Annotate Trajectories from vector data

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

Explore trajectories and visualize the spatio-temporal pattern

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)

# can also be used in project -> eg. what road type was used?

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

Import and visualize vegetationindex (raster data)

veg <- rast("data/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

Annotate Trajectories

wildboar_veg <- extract(veg, wildschwein_BE)
nrow(wildboar_veg)
[1] 15559
nrow(wildschwein_BE)
[1] 15559

As we have the same amounts of rows:

wildschwein_BE$veg <- wildboar_veg$vegetationshoehe_LFI

Explore data

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()