Чтение входных значений функции, определенных в `...` из файла CSV в R - PullRequest
Новая
       12

Чтение входных значений функции, определенных в `...` из файла CSV в R

3 голосов
/ 22 июня 2019

Предположим, у меня есть функция R, такая как foo ниже.Эта функция имеет 4 фиксированных аргумента и любое количество произвольных аргументов, определенных в ....

Все входные значения для foo аргументов хранятся в ЭТОМ CSV-файле.

В приведенном ниже коде я могу успешно запустить foo используя 4 фиксированных аргумента, импортированных из файла CSV в цикле lapply. НО Мне интересно, как я могу вставить аргументы, определенные в ... в команде lapply? 

foo <- function(n = NULL, r = NULL, post, control, ...){ ## the function

data.frame(n = n, r = r, post, control, ...)

}

D <- read.csv("https://raw.githubusercontent.com/izeh/i/master/j.csv", h = T) # CSV file
L <- split(D, D$study.name) ; L[[1]] <- NULL

# the fixed args values:
      n <- lapply(1:length(L), function(i) L[[i]]$n)
      r <- lapply(1:length(L), function(i) L[[i]]$r)
   post <- lapply(1:length(L), function(i) L[[i]]$post)
control <- lapply(1:length(L), function(i) L[[i]]$control)

# names of args defined in `...`:
dot.names <- names(L[[1]])[!names(L[[1]]) %in% formalArgs(foo)][-1]

# the `...` args values:
a <- lapply(dot.names, function(i) lapply(L, function(j) j[grep(i, names(j))]))

## RUN `foo` function:
lapply(1:length(L), function(i) foo(n = n[[i]], r = r[[i]], post = post[[i]], 
                                     control = control[[i]])) # BUT! how can I insert the 
                                                              # arguments defined in `...` 
                                                              # in the function?

Ответы [ 2 ]

5 голосов
/ 22 июня 2019

Мы также можем использовать Map с do.call.Мы можем извлечь аргументы для foo за один вызов lapply, извлекая столбцы 'n', 'r', 'post', control 'и дополнительные столбцы (...), основываясь на выводе'dot.names ', затем transpose (из purrr - или используйте тот же подход, что и упомянутый здесь ) и передайте его на Map

args <- lapply(L, function(x) unclass(x[c("n", "r", "post", "control", dot.names)]))
library(purrr)
unname(do.call(Map, c(f = foo, transpose(args))))
#[[1]]
#   n   r post control ESL prof scope type
#1 13 0.5    1   FALSE   1    2     0    1
#2 13 0.5    2   FALSE   1    2     0    1
#3 15 0.5    1   FALSE   1    2     0    1
#4 15 0.5    2   FALSE   1    2     0    1
#5 16 0.5    1    TRUE   1    2     0    1
#6 16 0.5    2    TRUE   1    2     0    1

#[[2]]
#   n   r post control ESL prof scope type
#1 13 0.5    1   FALSE   0    1     1    0
#2 13 0.5    2   FALSE   0    1     1    0
#3 15 0.5    1   FALSE   0    1     1    0
#4 15 0.5    2   FALSE   0    1     1    0
#5 16 0.5    1    TRUE   0    1     1    0
#6 16 0.5    2    TRUE   0    1     1    0

#[[3]]
#   n   r post control ESL prof scope type
#1 13 0.5    1   FALSE   1    3     0    1
#2 13 0.5    2   FALSE   1    3     0    1
#3 13 0.5    3   FALSE   1    3     0    1
#4 15 0.5    1   FALSE   1    3     0    1
#5 15 0.5    2   FALSE   1    3     0    1
#6 15 0.5    3   FALSE   1    3     0    1
#7 16 0.5    1    TRUE   1    3     0    1
#8 16 0.5    2    TRUE   1    3     0    1
#9 16 0.5    3    TRUE   1    3     0    1

ОП, упомянутый озамена transpose на base R опция 

m1 <- simplify2array(lapply(names(args[[1]]), function(nm) 
     lapply(args, function(l1) l1[nm])))
do.call(Map, c(f = foo, unname(split(m1, col(m1)))))

Если мы можем использовать tidyverse

library(tidyverse)
map(L, ~ 
       .x %>%
           select(n, r, post, control, dot.names) %>% 
           as.list) %>% 
    transpose %>% 
    pmap(., foo)
#$Ellis.sh1
#   n   r post control ESL prof scope type
#1 13 0.5    1   FALSE   1    2     0    1
#2 13 0.5    2   FALSE   1    2     0    1
#3 15 0.5    1   FALSE   1    2     0    1
#4 15 0.5    2   FALSE   1    2     0    1
#5 16 0.5    1    TRUE   1    2     0    1
#6 16 0.5    2    TRUE   1    2     0    1

#$Goey1
#   n   r post control ESL prof scope type
#1 13 0.5    1   FALSE   0    1     1    0
#2 13 0.5    2   FALSE   0    1     1    0
#3 15 0.5    1   FALSE   0    1     1    0
#4 15 0.5    2   FALSE   0    1     1    0
#5 16 0.5    1    TRUE   0    1     1    0
#6 16 0.5    2    TRUE   0    1     1    0

#$kabla
#   n   r post control ESL prof scope type
#1 13 0.5    1   FALSE   1    3     0    1
#2 13 0.5    2   FALSE   1    3     0    1
#3 13 0.5    3   FALSE   1    3     0    1
#4 15 0.5    1   FALSE   1    3     0    1
#5 15 0.5    2   FALSE   1    3     0    1
#6 15 0.5    3   FALSE   1    3     0    1
#7 16 0.5    1    TRUE   1    3     0    1
#8 16 0.5    2    TRUE   1    3     0    1
#9 16 0.5    3    TRUE   1    3     0    1

Обновление

На основепример показал здесь , структура немного отличается, поэтому мы можем транспонировать list с помощью names (для base R) 

argsT <- setNames(lapply(names(args[[1]]), 
      function(nm) lapply(args, `[[`, nm)), names(args[[1]]))


out1 <- unname(do.call(Map, c(f = d.prepos, argsT)))
out2 <- unname(do.call(Map, c(f = d.prepos, purrr::transpose(args))))
identical(out1, out2)
#[1] TRUE
4 голосов
/ 22 июня 2019

Используйте mapply для этого типа проблемы.
В приведенном ниже коде я изменил способ определения n, r, post и control. 

n <- lapply(L, `[[`, 'n')
r <- lapply(L, `[[`, 'r')
post <- lapply(L, `[[`, 'post')
control <- lapply(L, `[[`, 'control')

Единственное отличие состоит в том, что для этих результатов установлен атрибут names.

Затем также измените способ создания списка a. Поменяйте местами два цикла. 

a <- lapply(L, function(i) lapply(dot.names, function(k) i[grep(k, names(i))]))

Теперь решение проблемы. Обязательно установить SIMPLIFY = FALSE, значение по умолчанию TRUE дает действительно плохой вывод. 

mapply(FUN = foo, n, r, post, control, a, SIMPLIFY = FALSE)
...