【问题标题】:Index list within map function地图功能内的索引列表
【发布时间】:2019-04-21 15:45:03
【问题描述】:

这是上一个问题的延续: Apply function over every entry one table to every entry of another

我有以下表格loss.tibbandstib和函数bandedlossfn

library(tidyverse)
set.seed(1)
n <- 5
loss.tib <- tibble(lossid = seq(n),
                   loss = rbeta(n, 1, 10) * 100)

bandstib <- tibble(bandid = seq(4),
                   start = seq(0, 75, by = 25),
                    end = seq(25, 100, by = 25))

bandedlossfn <- function(loss, start, end) {
  pmin(end - start, pmax(0, loss - start))
} 

可以使用bandstib 作为参数在loss.tib 上应用此函数:

loss.tib %>% 
mutate(
  result = map(
    loss, ~ tibble(result = bandedlossfn(.x, bandstib$start, 
bandstib$end))
    )
    ) %>% unnest

但是,我想在地图中添加一个索引,如下所示:

loss.tib %>% 
mutate(
  result = map(
    loss, ~ tibble(result = bandedlossfn(.x, bandstib$start, 
bandstib$end)) %>% 
    mutate(bandid2 = row_number())
    )
    ) %>% unnest

但它似乎没有按预期工作。 我还想在 map 函数中添加 filter(!near(result,0)) 以实现高效的内存管理。

我期待的结果是:

lossid  loss    bandid  result
1   21.6691088  1   21.6691088  
2   6.9390647   1   6.9390647   
3   0.5822383   1   0.5822383   
4   5.5671643   1   5.5671643   
5   27.8237244  1   25.0000000  
5   27.8237244  2   2.8237244   

谢谢。

【问题讨论】:

    标签: r indexing dplyr purrr


    【解决方案1】:

    这是一种可能性: 您首先嵌套bandstib 并将其添加到loss.tib。这样 id 会与您的计算保持一致:

    bandstib <- tibble(bandid = seq(4),
                       start = seq(0, 75, by = 25),
                       end = seq(25, 100, by = 25)) %>% 
      nest(.key = "data")
    
    set.seed(1)
    n <- 5
    result <- tibble(loss = rbeta(n, 1, 10) * 100) %>% 
      bind_cols(., slice(bandstib, rep(1, n))) %>%
      mutate(result = map2(loss, data, ~bandedlossfn(.x, .y$start, .y$end))) %>% 
      unnest()
    

    【讨论】:

    • 谢谢@Cettt,我想这完全不需要地图功能......result &lt;- loss.tib %&gt;% bind_cols(., slice(bandstib, rep(1, n))) %&gt;% unnest %&gt;% mutate(result = bandedlossfn(loss, start, end)) %&gt;% filter(!near(result,0))。我希望在不创建大于必要的小标题并在地图中应用过滤的情况下做到这一点。但它有效。
    • 好吧,玩了一会儿,这似乎可以解决问题...loss.tib %&gt;% mutate(result = map( loss, ~ tibble(result = bandedlossfn(.x, bandstib$start, bandstib$end)) %&gt;% mutate(bandid = seq(bandstib %&gt;% nrow())) %&gt;% filter(!near(result, 0)))) %&gt;% unnest
    猜你喜欢
    • 1970-01-01
    • 2012-09-04
    • 1970-01-01
    • 1970-01-01
    • 2013-05-31
    • 1970-01-01
    • 1970-01-01
    • 2021-05-04
    相关资源
    最近更新 更多