Question

我每小时跟踪一次移动的df。我在1、11、21、31、41小时的参考距离为零，所有的轨迹都在这些小时之间的某个点结束。

所以我想做的是找到每个组/试验在hour0和hour（end）之间移动的总距离。这意味着我需要添加结束前小时参考的累积总和，以及结束后一小时的比例距离。

例如，如果轨道在第34小时结束，我知道行进的长度将是（1,11,21,31小时的总和）+ 3/10长度（41）。

我已经将代码放到了可以找到积的位置，但是我不知道如何添加多余的比例位。

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

这使我拥有了我需要的所有数据的df，但是我希望能够summarise（）来找到到最后一个小时的长度总和+比例的额外位数。

 df3 %>% summarise(total = sum(length))
 # sum of all lengths, but this overshoots.

感谢您的帮助

Answer 1

如果我理解您的问题，则希望在任意小时（cumsum(length) ~ hour）内线性插值end。有一个方便的基本R函数approxfun。

给出您的df1和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>

现在，您有了功能列表，可以在所选时间评估每个功能。因此，让我们加入：

  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

现在我们可以purrr::map*沿着该列表。我们将使用map2，因为我们希望同时使用f和end进行求值，并且我们知道它应该返回一个数字，因此我们将专门使用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

如果您以前没有使用过purrr，那看起来就像是黑魔法。 map函数是迭代器，类似于基础R中的lapply。它们采用列表的元素并在其上应用函数。您可以使用类似于公式编写的这些“匿名”函数。像~.x+.y和function(arg1, arg2) {arg1 + arg2}一样。

这里强大的应用程序是参数之一本身就是我们要使用的函数f列。通过首先传递它，它是匿名函数中的.x。第二个参数end变为.y。因此，~.x(.y)与为四对中的每对呼叫f(end)相同。

让我们通过可视化结果进行一些健全性检查。将以上结果存储在df3中：

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)

修改后的总和-用比率r

1 个答案: