I show how I can calculate loop to take the same values as your target_loop example,
I tried to apply your own rule logic where possible.
library(tidyverse)
df_1<-tibble::tribble(
~Household, ~person, ~trip, ~ZoneOfHome, ~start_zone, ~end_zone, ~purpose,~target_loop,
1L, 1L, 1L, 22L, 22L, 13L, "work", 1,
1L, 1L, 2L, 22L, 13L, 22L, "home", 1,
1L, 1L, 3L, 22L, 22L, 34L, "shopping", 2,
1L, 1L, 4L, 22L, 34L, 22L, "home", 2,
1L, 2L, 1L, 22L, 22L, 13L, "work", 1,
1L, 2L, 2L, 22L, 13L, 22L, "home", 1,
2L, 1L, 1L, 15L, 15L, 15L, "work", 1,
2L, 1L, 2L, 15L, 15L, 15L, "home", 1,
2L, 1L, 3L, 15L, 15L, 45L, "shopping", 2,
2L, 1L, 4L, 15L, 45L, 15L, "home", 2,
3L, 1L, 1L, 17L, 6L, 17L, "home", NA_real_,
3L, 1L, 2L, 17L, 17L, 10L, "work", 1,
3L, 1L, 3L, 17L, 10L, 17L, "home",1
)
df_2<-df_1 %>% mutate(loop_end = (end_zone==ZoneOfHome & purpose=="home"),
loop_start = (start_zone == ZoneOfHome),
loop = NA_integer_) %>%
group_by(Household,person)
loops_per_householdperson <- function(df){
for (i in 1:nrow(df)){
if(df$loop_start[[i]]){
if(i>1)
df$loop[[i]] <- coalesce(df$loop[[i-1]],0L) + 1L
else
df$loop[[i]] <- 1L
} else {
if(i>1)
df$loop[[i]] <- df$loop[[i-1]]
}
#special rule for case of subtable 3 where loop_start needs supressing normal behaviour
#because its also a loop end with purpose of home which seems to be the relevant difference
#from subtable 1
if(i>1 & df$loop_start[[i]] & df$loop_end[[i]] & df$purpose[[i]]=='home')
df$loop[[i]] <- df$loop[[i-1]]
}
return (df)
}
df3 <- group_map(.tbl = df_2,
.f = ~loops_per_householdperson(.),
keep = TRUE)
df4 <- bind_rows(df3)