0

This is a continuation from the previous question: Apply function over every entry one table to every entry of another

I have the following tables loss.tib and bandstib and function 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))
}

It is possible to apply this function over loss.tib using bandstib as arguments:

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

However, I would like to add an index within map as follows:

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

But it does not seem to work as intended. I also want to add filter(!near(result,0)) within the map function too for efficient memory management.

The result I'm expecting is:

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

Thank you.

Vincent Risington
  • 167
  • 8

1 Answers1

1

Here is one possibility: you first nest bandstib and add it to loss.tib. This way the id sticks to your calculations:

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
  • 11,460
  • 7
  • 35
  • 58
  • Thanks @Cettt, I guess that obviates the need for the map function altogether... `result <- loss.tib %>% bind_cols(., slice(bandstib, rep(1, n))) %>% unnest %>% mutate(result = bandedlossfn(loss, start, end)) %>% filter(!near(result,0))`. I was looking to do this without creating a larger than necessary tibble and applying the filtering within the map. But it works. – Vincent Risington Apr 21 '19 at 23:15
  • Ok after playing around a bit, this seems to do the trick... `loss.tib %>% mutate(result = map( loss, ~ tibble(result = bandedlossfn(.x, bandstib$start, bandstib$end)) %>% mutate(bandid = seq(bandstib %>% nrow())) %>% filter(!near(result, 0)))) %>% unnest` – Vincent Risington Apr 21 '19 at 23:38