Using a named list within a purrr::map function call for additional function parameters-CodePudding

I am beginning to work with purrr and came across the following problem - I hope the following example illustrates my problem:

I have three functions with the following two properties:

The parameters of each function function are named differently.
Each function can process only 1000 values at once in the first variable.

function1 <- function(num1, summand1){num1   summand1}
function2 <- function(num2, factor1){num2 * factor1} 
function3 <- function(num3, summand2, factor2){(num3   summand2) * factor2}

Now I have a vector with 2500 numbers, which I'd like to provide to the functions in three parts by splitting it up and using purrr::map:

unique_nums <- 1:2500
n_tn <- length(unique_nums)
n <- ceiling(n_tn/1000)
list_of_nums <- list()

for (i in 1:n) {
  if (i == n) {
    list_of_nums[[i]] <- unique_nums[(1 (i-1)*1000):n_tn]
  } else{
    list_of_nums[[i]] <- unique_nums[(1 (i-1)*1000):(1000 (i-1)*1000)]
  }
}

output1 <- list_of_nums |>
  purrr::map(~ function1(num1 = .x, summand1 = 1)) 
output2 <- list_of_nums |>
  purrr::map(~ function2(num2 = .x, factor1 = 3))
output3 <- list_of_nums |>
  purrr::map(~ function3(num3 = .x, summand2 = 1, factor2 = 2))

This works perfectly. Now I'd like to create a function, which automates the partitioning and the purrr::map function call. So far my ideas have led to the following:

function_1000 <- function(FUN, num, ...){
  
  unique_nums <- num
  n_tn <- length(unique_nums)
  n <- ceiling(n_tn/1000)
  list_of_nums <- list()
  
  for (i in 1:n) {
    if (i == n) {
      list_of_nums[[i]] <- unique_nums[(1 (i-1)*1000):n_tn]
    } else{
      list_of_nums[[i]] <- unique_nums[(1 (i-1)*1000):(1000 (i-1)*1000)]
    }
  }
  
  output <- list_of_nums |>
    purrr::map(~ FUN(num1 = .x, summand1 = 1)) 
}

And here my problems are starting:

The function call function_1000(FUN = function1, num = 1:2500, summand1 = 1) gives me the following error: Error in FUN(num1 = .x, summand1 = summand1) : object 'summand1' not found Am I using the ... argument incorrectly?
Even if it would work - function_1000 would only work for function1, since the parameters within the map functions are named. As a solution I thought about providing the arguments as a named list:

function_1000new <- function(FUN, num, args){
  
  unique_nums <- num
  n_tn <- length(unique_nums)
  n <- ceiling(n_tn/1000)
  list_of_nums <- list()
  
  for (i in 1:n) {
    if (i == n) {
      list_of_nums[[i]] <- unique_nums[(1 (i-1)*1000):n_tn]
    } else{
      list_of_nums[[i]] <- unique_nums[(1 (i-1)*1000):(1000 (i-1)*1000)]
    }
  }
    
  output <- list_of_nums |>
    purrr::map(~ rlang::exec(FUN, !!!args)) 
}

> args <- list(num1 = eval(parse(text = ".x")), summand1 = 1)
Error in eval(parse(text = ".x")) : object '.x' not found
> function_1000(FUN = function1, num = 1:2500, args = args)
Error in FUN(num1 = .x, summand1 = summand1) : 
  object 'summand1' not found

Here the same error as in 1. occurs, but also it does not seem to be possible to provide .x outside the purrr:map call.

Any ideas on how to fix these two issues? I'd be happy about a completly different solution for the problem as well. But for me this is the most obvious structure for a function like that.

Thanks!

CodePudding user response：

It may be better to have the same argument name num in the functions as we are calling all of them within function_1000new and its argument is num. Pass the args as a named list, then splice (!!!) the list of arguments after appending the num to the list while calling exec

function1 <- function(num, summand1){num   summand1}
function2 <- function(num, factor1){num * factor1} 
function3 <- function(num, summand2, factor2){(num   summand2) * factor2}
function_1000new <- function(FUN, num, args){
  
  unique_nums <- num
  n_tn <- length(unique_nums)
  n <- ceiling(n_tn/1000)
  list_of_nums <- list()
  
  for (i in 1:n) {
    if (i == n) {
      list_of_nums[[i]] <- unique_nums[(1 (i-1)*1000):n_tn]
    } else{
      list_of_nums[[i]] <- unique_nums[(1 (i-1)*1000):(1000 (i-1)*1000)]
    }
  }
    
     purrr::map(list_of_nums, 
        ~ rlang::exec(FUN, !!! c(list(num = .x), args)))
  
}

-testing


> out1 <- function_1000new(function1, num = 1:2500, list(summand1 = 1))
> map(out1, head)
[[1]]
[1] 2 3 4 5 6 7

[[2]]
[1] 1002 1003 1004 1005 1006 1007

[[3]]
[1] 2002 2003 2004 2005 2006 2007
> out2 <- function_1000new(function2, num = 1:2500, list(factor1= 3))
> map(out2, head)
[[1]]
[1]  3  6  9 12 15 18

[[2]]
[1] 3003 3006 3009 3012 3015 3018

[[3]]
[1] 6003 6006 6009 6012 6015 6018
> out3 <- function_1000new(function3, num = 1:2500,
   list(summand2= 1, factor2 = 2))
> map(out3, head)
[[1]]
[1]  4  6  8 10 12 14

[[2]]
[1] 2004 2006 2008 2010 2012 2014

[[3]]
[1] 4004 4006 4008 4010 4012 4014

If we want to keep the function arguments as is,

function1 <- function(num1, summand1){num1   summand1}
function2 <- function(num2, factor1){num2 * factor1} 
function3 <- function(num3, summand2, factor2){(num3   summand2) * factor2}


function_1000new <- function(FUN, num, args){
  
  unique_nums <- num
  n_tn <- length(unique_nums)
  n <- ceiling(n_tn/1000)
  list_of_nums <- list()
  
  for (i in 1:n) {
    if (i == n) {
      list_of_nums[[i]] <- unique_nums[(1 (i-1)*1000):n_tn]
    } else{
      list_of_nums[[i]] <- unique_nums[(1 (i-1)*1000):(1000 (i-1)*1000)]
    }
  }
    
    purrr::map(list_of_nums, 
       ~ purrr::invoke(FUN,  args))
  
}

-testing

> args1 <- alist(num1 = .x, summand1 = 1)
> out1 <- function_1000new(function1, num = 1:2500, args1)
> map(out1, head)
[[1]]
[1] 2 3 4 5 6 7

[[2]]
[1] 1002 1003 1004 1005 1006 1007

[[3]]
[1] 2002 2003 2004 2005 2006 2007
> args2 <- alist(num2 = .x, factor1 = 3)
> out2 <- function_1000new(function2, num = 1:2500, args2)
> map(out2, head)
[[1]]
[1]  3  6  9 12 15 18

[[2]]
[1] 3003 3006 3009 3012 3015 3018

[[3]]
[1] 6003 6006 6009 6012 6015 6018
> args3 <- alist(num3 = .x, summand2= 1, factor2 = 2)
> out3 <- function_1000new(function3, num = 1:2500, args3)
> map(out3, head)
[[1]]
[1]  4  6  8 10 12 14

[[2]]
[1] 2004 2006 2008 2010 2012 2014

[[3]]
[1] 4004 4006 4008 4010 4012 4014

Or may also use call2

function_1000new <- function(FUN, num, args){
  
  unique_nums <- num
  n_tn <- length(unique_nums)
  n <- ceiling(n_tn/1000)
  list_of_nums <- list()
  
  for (i in 1:n) {
    if (i == n) {
      list_of_nums[[i]] <- unique_nums[(1 (i-1)*1000):n_tn]
    } else{
      list_of_nums[[i]] <- unique_nums[(1 (i-1)*1000):(1000 (i-1)*1000)]
    }
  }
    
    purrr::map(list_of_nums, 
       ~ eval(rlang::call2(FUN,  !!! args)))
  
}

-testing

args1 <- alist(num1 = .x, summand1 = 1)
out1 <- function_1000new(function1, num = 1:2500, args1)

CodePudding user response：

in base R this can be easily accomplished by :

function1000_new <- function(FUN, num, args){
  v <- split(unique_nums, (seq_along(unique_nums) - 1) %/00)
  Map(FUN, v, MoreArgs = args, USE.NAMES = FALSE)
}

function1000_new(function1, 1:2500, list(summand1 = 1))
function1000_new(function2, 1:2500, list(factor1 = 3))
function1000_new(function3, 1:2500, list(summand2 = 1, factor2 = 2))