跨两个嵌套列表列应用数学函数

Question

I have a question regarding the purrr map function.

I would like to apply a mathematical function across two nested list-columns within a tibble. I would like to convertthe column to a numeric vector to perform my calculations.

But i keep receiving the error: Error in mutate_impl(.data, dots) : Evaluation error: non-numeric argument to mathematical function.

I have tried applying the custom function using purrr :: map2 but it throws an error. Would lapply do the trick? Please see below.

mape <- function(actual,pred){
  mape <- mean(abs(ifelse(actual==0,
                          ifelse(pred==0,0,abs(1 - pred)*100),((actual - pred)/actual*100))))
  return (mape)
}

mape_score <- mape_lab %>% mutate(mape_score=map2(data[],pred_lab[],mape))

> mape_lab
# A tibble: 30 x 3
   Location     pred_lab   data             
   <fct>        <list>     <list>           
 1 Balsthal     <dbl [12]> <tibble [12 x 1]>
 2 Balsthal     <dbl [12]> <tibble [12 x 1]>
 3 Balsthal     <dbl [12]> <tibble [12 x 1]>
 4 Bettlach     <dbl [12]> <tibble [12 x 1]>
 5 Bettlach     <dbl [12]> <tibble [12 x 1]>
 6 Bettlach     <dbl [12]> <tibble [12 x 1]>
 7 Oberdorf Bio <dbl [12]> <tibble [12 x 1]>
 8 Oberdorf Bio <dbl [12]> <tibble [12 x 1]>
 9 Oberdorf Bio <dbl [12]> <tibble [12 x 1]>
10 Grenchen     <dbl [12]> <tibble [12 x 1]>

Expected Outcome:

> mape_lab
# A tibble: 30 x 3
   Location     pred_lab   data              mape_score
   <fct>        <list>     <list>            <num>
 1 Balsthal     <dbl [12]> <tibble [12 x 1]>  1244
 2 Balsthal     <dbl [12]> <tibble [12 x 1]>  32545
 3 Balsthal     <dbl [12]> <tibble [12 x 1]>  54554
 4 Bettlach     <dbl [12]> <tibble [12 x 1]>  .....
 5 Bettlach     <dbl [12]> <tibble [12 x 1]>
 6 Bettlach     <dbl [12]> <tibble [12 x 1]>
 7 Oberdorf Bio <dbl [12]> <tibble [12 x 1]>
 8 Oberdorf Bio <dbl [12]> <tibble [12 x 1]>
 9 Oberdorf Bio <dbl [12]> <tibble [12 x 1]>
10 Grenchen     <dbl [12]> <tibble [12 x 1]>

Answer 1

While asking question please add a reproducible example .

As far your question is concerned, the main issue is data is tibble and pred_lab is numeric vector. You can flatten the data since it has only one column and then apply mape .

library(tidyverse)
mape_lab %>% mutate(mape_score = map2_dbl(data %>% flatten, pred_lab, mape))