Чтение входных значений функции, определенных в `...`, из CSV-файла в R
Предположим, у меня есть функция 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?
Из предыдущего поста нужно внести небольшое изменение. Пожалуйста, проверьте обновление для base R
Ответы 2
Используйте 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)
Мы также можем использовать 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
функция rnorouzian в ЭТИ ДАННЫЕ — d.prepos. И его код такой: D <- read.csv("https://raw.githubusercontent.com/izeh/i/master/k.csv", h = T) ; m <- split(D, D$study.name) ; m[[1]] <- NULL; ar <- formalArgs(d.prepos); dot.names <- names(m[[1]])[!names(m[[1]]) %in% ar]; args <- lapply(m, function(x) unclass(x[c(head(ar, -1), dot.names)])); argsT <- setNames(lapply(names(args[[1]]), function(i) lapply(args, [[, i)), names(args[[1]])); do.call(Map, c(f = d.prepos, argsT))
конечно, нет проблем.
не могли бы вы вставить сюда свое полное решение?
@ Реза, я нахожу это очень запутанным. Не могли бы вы задать как новый вопрос
Если вы используете так много вызовов
lapply, возможно, пришло время вместо этого написать функцию.dotsлегче работать внутри функции.