【问题标题】:Purr::map2 filtering on multiple criteriaPurrr::map2 过滤多个条件
【发布时间】:2020-06-16 18:43:47
【问题描述】:

我已经生成了一系列随机游走,每个人在有界的舞台上移动(data.frame fishmoves)。在这个舞台上,有一些感兴趣的网格方块(data.frame 蚂蚁,盒子的 x 和 y 坐标)。我想过滤 fishmoves 以仅包含感兴趣的网格正方形内的点。然后我想计算每个人在每个框中花费的个人数量和时间步长。

已解决我遇到了过滤问题。我正在使用 purr::map2 从蚂蚁传递过滤条件,但是当我调用所有四个参数时它不起作用——而是返回 null。我确保(data.frame tester)有实际值可以找到,所以一定是我在调用中做错了什么。 已解决

这使我无法进行下一步,即按 ant 拆分并按个人和 # 个时间步进行汇总。 任何帮助将不胜感激!

library(tidyverse)

n.times<-1000
OUT <-data.frame(time=vector("numeric", n.times), x.a = vector("numeric", n.times),y.a = vector("numeric", n.times))

walker <- function(n.times,
                   xlim=c(0,40),
                   ylim=c(0,20),
                   start=c(0,0),
                   stepsize=c(1,1)) {
  ## extract starting point
  x <- start[1]
  y <- start[2]

  for (i in 1:n.times) {
    repeat {
      ## pick jump sizes
      xi <- stepsize[1]*sample(rnorm(n = n.times, mean = 0, sd = .5),1)
      yi <- stepsize[2]*sample(rnorm(n = n.times, mean = 0, sd = .5),1)
      ## new candidate locations
      newx <- x+xi
      newy <- y+yi
      ## IF new locations are within bounds, then
      ##    break out of the repeat{} loop (otherwise
      ##    try again)
      if (newx>xlim[1] && newx<xlim[2] &&
          newy>ylim[1] && newy<ylim[2]) break
    }
    ## set new location to candidate location
    x <- newx
    y <- newy
    OUT[i,"time"]<-i
    OUT[i,"x.a"] <-x
    OUT[i, "y.a"] <-y
  }
  return(OUT)
}


#generate fake fish
fish<-data.frame(fish=as.character(letters[1:10]))

#apply walker to fake fish
fishmoves <- fish %>% 
  mutate(data= map(fish,~walker(n.times))) %>% 
  unnest(data)


#ants <- data.frame(ant=c("a", "b"),x.min=seq(from=2, to = 38, by= 4)),x.max=c(1,4),y.min=c(0,2), y.max=c(1,3)) 
ants <- data.frame(ant=LETTERS[1:16]) %>% 
  bind_cols(x.min=c(seq(from=4, to = 32, by= 4),seq(from=4, to = 32, by= 4)),
            y.min=c(rep(4,each=8),rep(12,each=8))) %>% 
  mutate(x.max=x.min+2,
         y.max=y.min+2) %>% 
  group_by(ant) 


#filter fishmoves based on the filter parameters - works separately for both x and y

ant_fish1 <- map2(ants$x.min, ants$x.max, ~ fishmoves %>%
         filter(between(x.a, ..1[1], ..2[1])) )

ant_fish2 <- map2(ants$y.min, ants$y.max, ~ fishmoves %>%
                    filter(between(y.a, ..1[1], ..2[1])) )  

#test to demonstrate that there are individuals that meet the joint criteria
tester <- fishmoves %>% filter (between(x.a, ants$x.min[1], ants$x.max[1]) & between(y.a, ants$y.min[1], ants$y.max[1]))

#### switched map2 to pmap

ant_fish <- pmap(list(ants$x.min, ants$x.max, ants$y.min, ants$y.max), ~ fishmoves %>%
                    filter(between(x.a, ..1[1], ..2[1]) & between(y.a, ..3[1], ..4[1])) )  

#conceptual approach? does not work...
ant_fish <- ants %>% nest(ant_loc = c(x.min, x.max, y.min, y.max)) %>% 
 pmap(list(ants$x.min, ants$x.max, ants$y.min, ants$y.max), ~ fishmoves %>%
                    filter(between(x.a, ..1[1], ..2[1]) & between(y.a, ..3[1], ..4[1])) ) %>% 
  group_by(fish) %>% 
  summarise(counts=n())

【问题讨论】:

    标签: r purrr


    【解决方案1】:

    问题是你不能像那样使用 map2。 map2 中的 2 表示您用于映射的函数必须接受 2 个(并且只有 2 个)参数,但您想使用接受 4 个参数的函数。做你想做的映射函数称为pmap

    而不是这个...

    #filter returns null
    ant_fish3 <- map2(ants$x.min, ants$x.max, ants$y.min, ants$y.max, ~ fishmoves %>%
                        filter(between(x.a, ..1[1], ..2[1]) & between(y.a, ..3[1], ..4[1])) )
    

    你会用这个...

    ant_fish3 <- pmap(list(ants$x.min, ants$x.max, ants$y.min, ants$y.max), function(one, two, three, four) { 
        fishmoves %>%
            filter(between(x.a, one[1], two[1]) & between(y.a, three[1], four[1])) })
    

    【讨论】:

    • 谢谢,这解决了问题 1,我发现文档在这一点上令人困惑。仍然没有弄清楚如何进行第 2 部分。
    【解决方案2】:

    我想我明白了。这似乎产生了我正在寻找的东西: 1) 将运动数据集过滤到空间限制 2) 生成个人数量和总时间/个人的汇总

    ant_fish <- ants %>% group_by(ant) %>% 
      mutate(data=pmap(list(x.min, x.max, y.min, y.max), ~ fishmoves %>%
             filter(between(x.a, ..1[1], ..2[1]) & between(y.a, ..3[1], ..4[1]))  %>% 
      group_by(fish) %>% 
      summarise(counts=n())))
    

    【讨论】:

      猜你喜欢
      • 1970-01-01
      • 2018-12-05
      • 2021-09-01
      • 2011-07-25
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      相关资源
      最近更新 更多