Apply function over every entry one table to every entry of another

问题

I would like to apply a function, bandedlossfn to all entries in loss.tib using every item in bandstib

library(tidyverse)
set.seed(1)
n <- 5
loss <- rbeta(n, 1, 10) * 100

loss.tib <- loss %>% as_tibble %>% mutate(loss = value) %>% mutate(lossid = 
row_number()) %>% select(lossid, loss)
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))
}

As per the answer below the following code produces the calculation:

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

However I'd like to include the bandid as the index within the map function and additionally filter(!near(result,0)) with the map function.

The result should be:

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

回答1:

here is one possibility using map2 from the purrr package:

bandstib %>% 
  mutate(result = map2(start, end, ~bandedlossfn(loss.tib[[1]], .x, .y)))

Depending on how you want your output to be you can continue from there by e.g. using unnest.

EDIT

Here is how you can apply it the otherway arround using map instead of map2:

loss.tib %>% 
  mutate(result = map(value, bandedlossfn, start = bandstib$start, end = bandstib$end)) %>%
  unnest() %>% 
  mutate(bandid = rep(seq(4), n))

来源：https://stackoverflow.com/questions/55783462/apply-function-over-every-entry-one-table-to-every-entry-of-another

标签

loops

dplyr

lapply

purrr