modified cumsum - summarise with ratios r - r

Question

I have a df of moving particles that I'm tracking hourly. I have reference distances at hours 1,11,21,31,41, and the tracks all end at some point between those hours.
So what I want to do is find the total distance traveled for each group/trial between hour0 and hour(end). That means I'll need to add the cumulative sum of hour references before end, and the proportional distance for the hour after end.
For example, if the track ends at hour 34, I would know the length traveled would be (cumsum of lengths of hours 1,11,21,31) + 3/10 length(41).
I've got my code to where I can find the cumsum, but I can't figure out how to add the extra little proportional bit.
set.seed(1)
df1 <- data.frame(matrix(nrow=20,ncol=4))
colnames(df1) <- c("group","trial","hour","length")
df1$group <- rep(c("a","b"),each=10)
df1$trial <- rep(c(1,1,1,1,1,2,2,2,2,2),times=2)
df1$hour <- rep(c(1,11,21,31,41),times=4)
df1$length <- rep(c(10,12,13,17,21),times=4)
df2 <- data.frame(matrix(nrow=4,ncol=3))
colnames(df2) <- c("group","trial","end")
df2$group <- c("a","a","b","b")
df2$trial <- c(1,2,1,2)
df2$end <- runif(4,1,40)
df3 <- df2 %>%
left_join(df1,by=c("group","trial")) %>%
group_by(group,trial) %>%
mutate(cumlength = cumsum(length)) %>%
slice({i1 <- which(hour <= end)
c(i1, tail(i1, 1) + 1)})
that gets me to a df with all the data I should need, but I want to be able to summarise() to find the sum of lengths to the last hour + proportional extra bit.
df3 %>% summarise(total = sum(length))
# sum of all lengths, but this overshoots.
Thanks for the help

Answer 1

If I understand your question, you want to linearly interpolate your cumsum(length) ~ hour for any arbitrary hour (end). There's a handy base R function for this, approxfun.
Given your df1 and df2:
library(dplyr)
df1 %>%
group_by(group, trial) %>%
summarise(
f = list(approxfun(cumsum(length) ~ hour))
)
# A tibble: 4 x 3
# Groups: group [2]
group trial f
<chr> <dbl> <list>
1 a 1 <fn>
2 a 2 <fn>
3 b 1 <fn>
4 b 2 <fn>
Now you have a list of functions, each of which can be evaluated at your selected time. So let's do that join:
df1 %>%
group_by(group, trial) %>%
summarise(
f = list(approxfun(cumsum(length) ~ hour))
) %>%
full_join(df2)
Joining, by = c("group", "trial")
# A tibble: 4 x 4
# Groups: group [2]
group trial f end
<chr> <dbl> <list> <dbl>
1 a 1 <fn> 11.4
2 a 2 <fn> 15.5
3 b 1 <fn> 23.3
4 b 2 <fn> 36.4
Now we can just purrr::map* along that list. We'll use map2 since we want to evaluate along f and end in parallel, and we know it should return a single number, so we'll specifically use map2_dbl.
library(purrr)
df1 %>%
group_by(group, trial) %>%
summarise(
f = list(approxfun(cumsum(length) ~ hour))
) %>%
full_join(df2) %>%
mutate(total = map2_dbl(f, end, ~.x(.y)))
Joining, by = c("group", "trial")
# A tibble: 4 x 5
# Groups: group [2]
group trial f end total
<chr> <dbl> <list> <dbl> <dbl>
1 a 1 <fn> 11.4 22.5
2 a 2 <fn> 15.5 27.9
3 b 1 <fn> 23.3 39.0
4 b 2 <fn> 36.4 63.4
If you haven't used purrr before, that might look like black magic. The map functions are iterators, similar to lapply in base R. They take an element of a list and apply a function on it. You can use these "anonymous" functions, written like formulas. Something like ~.x+.y is the same as function(arg1, arg2) {arg1 + arg2}.
The powerful application here is that one of the arguments is itself the function we want to use, the column f. By passing it first, it's .x in the anonymous function. The second argument, end, becomes .y. So then ~.x(.y) is the same as calling f(end) for each of the four pairs.
Let's do some sanity checking by visualizing the result. Store the above results in df3 and:
library(ggplot2)
df1 %>%
group_by(group, trial) %>%
mutate(cumlength = cumsum(length)) %>%
ggplot(aes(hour, cumlength)) +
geom_point() +
geom_path() +
geom_vline(
data = df3,
aes(xintercept = end),
color = "red"
) +
geom_point(
data = df3,
aes(end, total),
color = "red", size = 3, shape = 0
) +
facet_grid(group~trial)