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.
# Careful! What Timezone is assumed? #sabi <- wildschwein |>st_as_sf(coords =c("E", "N"), crs =2056, remove =FALSE) |>filter( TierName =="Sabi", DatetimeUTC >="2015-07-01", DatetimeUTC <"2015-07-03" )ggplot(sabi) +geom_sf()+geom_path(aes(E,N)) #connects the dots, specify names of columns.
##Step a) : specify a temporal window v Consistency accross dataset is important -> here every 15 minutes. To pack into a 60 minutes windows: pos[n-2] to pos[n] pos[n-1] to pos[n] pos[n] to pos[n+1] pos[n] to pos[n+2]
##Step b) : Measure the distance to every point within v
Show/Hide Code
distance_by_element <-function(later, now) {as.numeric(st_distance(later, now, by_element =TRUE) )}sabi <- sabi |># calculates distance b and saves it into datasetmutate(nMinus2 =distance_by_element(lag(geometry, 2), geometry), # distance to pos -30 minutesnMinus1 =distance_by_element(lag(geometry, 1), geometry), # distance to pos -15 minutesnPlus1 =distance_by_element(geometry, lead(geometry, 1)), # distance to pos +15 mintues, use of lead to offset in the other direction.nPlus2 =distance_by_element(geometry, lead(geometry, 2)) # distance to pos +30 minutes )sabi <- sabi |>rowwise()|>mutate (stepMean =mean(c(nMinus2,nMinus1,nPlus1,nPlus2))) |>ungroup()sabi <- sabi |>mutate(static = stepMean <mean(stepMean, na.rm =TRUE) # everything above mean of stepMean is moving point, everything under mean is stopping point )sabi_filter <- sabi |>filter(!static)sabi_filter |>ggplot(aes(E,N)) +geom_point(data = sabi, col ="red") +# red points are the removed points. Black should be the sabi_filter onegeom_path () +geom_point()
Show/Hide Code
coord_fixed()
<ggproto object: Class CoordFixed, CoordCartesian, Coord, gg>
aspect: function
backtransform_range: function
clip: on
default: FALSE
distance: function
expand: TRUE
is_free: function
is_linear: function
labels: function
limits: list
modify_scales: function
range: function
ratio: 1
render_axis_h: function
render_axis_v: function
render_bg: function
render_fg: function
setup_data: function
setup_layout: function
setup_panel_guides: function
setup_panel_params: function
setup_params: function
train_panel_guides: function
transform: function
super: <ggproto object: Class CoordFixed, CoordCartesian, Coord, gg>
Show/Hide Code
#nice way to quickly clean up data.
1 Exercice A Segmentation
1.1 Task 1 : Calculate distances
Step a) Temporal window -> every two hours
pos[n-4] to pos[n] pos[n-3] to pos[n] pos[n-2] to pos[n] pos[n-1] to pos[n] pos[n] to pos[n+1] pos[n] to pos[n+2] pos[n] to pos[n+3] pos[n] to pos[n+4]
Threshold = decision point between moving and stopping data.
Show/Hide Code
# Mean of distance is thresholdruth <- ruth|>rowwise()|>mutate (stepMean =mean(c(nMinus8,nMinus7,nMinus6,nMinus5,nMinus3,nMinus4,nMinus2,nMinus1,nPlus1,nPlus2,nPlus3,nPlus4,nPlus5,nPlus6,nPlus7,nPlus8))) |>ungroup()ruth <- ruth|>mutate(static = stepMean <mean (stepMean, na.rm =TRUE) )#store information
1.3 Task 3: visualized segemented trajectories
1.4 Task 4: Segment-based Analysis
Show/Hide Code
rle_id <-function(vec) { x <-rle(vec)$lengthsas.factor(rep(seq_along(x), times = x))}ruth <- ruth |>mutate(segment_id =rle_id(static))ruth_filter <- ruth |>filter(!static)ruth_filter |>ggplot(aes(E,N)) +geom_path (data = ruth, aes(E,N), col ="blue") +geom_point(data = ruth, col ="blue") +# red points are the removed points. Black should be the sabi_filter one geom_point() +geom_path(data = ruth_filter, aes(E,N, col = segment_id)) +coord_fixed()
Show/Hide Code
#red points are probably the first and last points (beginning + not really moving)
#Todo : calculate the duration of each segment to decide if keep in of not segment 11. #NOTIZEN - Task 4: Segment-based Analysis
# data set without movement point.# remove segment that are not long enough to be considered as movement.# For that, we assign ID to short segments. #only one segement -> can be due to long hours
2 Exercice B Similarity
2.1 Task 1 : Similarity
Import data set
Show/Hide Code
pedestrian <-read_delim("pedestrian.csv")
Rows: 289 Columns: 4
── Column specification ────────────────────────────────────────────────────────
Delimiter: ","
dbl (3): TrajID, 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.
All trajectories show a V-shape; meaning pedestrians turn at a similar point. Pedestrian 4 has however an other starting point. The graphic shows different walking patterns in regards to the velocity: Ped1: fast at the beginning; slow after, Ped2 slow at the beginning, fast after, Ped 3 regular walking spead; Ped 4; regular walking speed;
Question : which of these trajectories are similar? TrajID 1 seems to be a slow trajectory. TrajID 2 seems to be a bit faster TrajID 3 seems to be rather regular. TrajId 4 starts where else. TrajID 5 person is very fast, then slow. Person seems to have gone to the right. TrajID 6 - similar to 5.
2.2 Task 2 : Calculate similarity
Show/Hide Code
help(package ="SimilarityMeasures")
Which two trajectories to you percieve to be most similar, which are most dissimilar? Now visualize the results from the computed similarity measures. Which measure reflects your own intuition the closest?
Hypotheses 1 : 1 is most similar to 6. Hypotheses 2: 1 is most dissimilar to 3 and 4.
3 Run Dynamic Time Warping Algorithm and compare paths with DTW
Show/Hide Code
# use of generative A.I. to perform computation to extract trajectories into Matrixget_trajectory <-function(pedestrian, traj_id) { pedestrian |>filter(TrajID == traj_id) %>%st_coordinates()}traj1 <-get_trajectory(pedestrian, 1)traj2 <-get_trajectory(pedestrian, 2)traj3 <-get_trajectory(pedestrian, 3)traj4 <-get_trajectory(pedestrian, 4)traj5 <-get_trajectory(pedestrian, 5)traj6 <-get_trajectory(pedestrian, 6)# Calculate DTW and create data framedtw_results <-data.frame(Pair =c("traj1-traj2", "traj1-traj3", "traj1-traj4", "traj1-traj5", "traj1-traj6"),DTW =c(DTW(traj1, traj2, 4),DTW(traj1, traj3, 4),DTW(traj1, traj4, 4),DTW(traj1, traj5, 4),DTW(traj1, traj6, 4)))# create tablekable(dtw_results)
Hypothese 1 : confirmed - 1 is most similar to 5 and 6. Hypothese 2: no confirmed. 1 is most disimlar to traj 3 and 2. Traj 4 and one are not so dissimilar.
–> 1, 5, 6 have similar walking path. –> 1’s path is much different from 2’s and 3’s path.
! Difference of value for DTW traj 1-5 comparing to solution
4 Run Frecht and compare paths according to it.
Show/Hide Code
# Calculate Frechet and create table with Frechet resultsfrechet_results <-data.frame(Pair =c("traj1-traj2", "traj1-traj3", "traj1-traj4", "traj1-traj5", "traj1-traj6"),frechet =c(Frechet(traj1,traj2),Frechet(traj1,traj3),Frechet(traj1,traj4),Frechet(traj1,traj5),Frechet(traj1,traj6))) # create tablekable(frechet_results)
