Использование lapply и !is.na для подмножества векторов списка в R

Я пытаюсь применить найденное здесь решение для создания моделей машинного обучения:

Вот фиктивный набор данных:

data_pred <- data.frame(x1 = 1:10, x2 = 11:20, x3 = 21:30)
data_resp <- data.frame(y1 = c(1:5, NA, 7:10), y2 = c(NA, 2, NA, 4:10))

Вот мой метод цикла for() для моделирования предикторов в data_pred для каждого отдельного столбца измеренных ответов в data_resp с использованием пакета caret:

# data_pred contains predictors
# data_resp contains one column per measurement
# 1 matching row per observation in both data_pred and data_resp

for (i in 1:ncol(data_resp)) {

   train(x = data_pred[!is.na(data_resp[, i]), ],
         y = data_resp[!is.na(data_resp[, i], i],
         ... )
}

Теперь я пытаюсь сделать то же самое с lapply, который, как мне кажется, имеет множество преимуществ. У меня возникла проблема с переводом критериев !is.na() на лету, поэтому я моделирую только случаи, не относящиеся к NA, для каждого ответа. Вот моя начальная функция для проверки метода lapply:

rf_func <- function(y) {
  train(x = data_pred,
        y = y,
        method = "rf",
        tuneGrid = data.frame(.mtry = 3:6),
        nodesize = 3,
        ntrees = 500,
        trControl = trControl) }

Затем создайте пустой список для хранения результатов и примените функцию к data_resp:

models <- list(NULL)
models$rf <- lapply(as.list(data_resp), rf_func)

Это прекрасно работает, так как randomForest может обрабатывать NA, но другие методы не могут, поэтому мне нужно удалить эти строки из каждого элемента data_resp, а также соответствующие строки из моих предикторов.

Я пробовал это без успеха:

train(x = data_pred_scale[!is.na(y), ],
      y = y[!is.na(y)],
      ... }

Я также пробовал y[[!is.na(y)]]

Как преобразовать метод data.frame (df[!is.na(df2), ]) в lapply?


r na subset lapply
person Hendy    schedule 22.07.2013    source источник
comment
Это довольно странная установка. У большинства людей есть одна переменная y, и они хотят обучать модели на основе различных комбинаций переменных x. Вы делаете наоборот.   -  person Hong Ooi    schedule 23.07.2013
comment
@HongOoi У меня есть набор x и множество взвешенных ответов, y. Я хотел бы использовать xs для прогнозирования каждого из ys, по одному. Вспомните химические формулы. Представьте, что я создаю смесь с различными ингредиентами (xs) и хочу смоделировать результирующую вязкость при различных температурах, модулях, температурах плавления и т. д. Имеет ли это больше смысла? Выяснение того, какие x использовать, является другим (и важным) вопросом, но мне все равно нужно смоделировать подмножество x для каждого y, что я и пытаюсь сделать выше.   -  person Hendy    schedule 23.07.2013
comment
Ничего страшного, мне просто было интересно.   -  person Hong Ooi    schedule 23.07.2013

Ответы (2)


arrow_upward
3
arrow_downward

несколько различных способов сделать это. Простой подход с анонимной функцией:

 lapply(data_resp, function(x) rf_func(x[!is.na(x)]))
person Ricardo Saporta    schedule 22.07.2013
comment
Это обеспечивает правильное подмножество каждого элемента data_resp. Могу ли я вместо data_pred использовать data_pred[y, ]? Кажется, что это поместит не-NA значения каждого столбца data_resp в мою функцию (которую я определил как принимающую y... как мне удалить соответствующие пропущенные строки из моих предикторов? - person Hendy; 23.07.2013

arrow_upward
0
arrow_downward

Немного повозившись с одним элементом моего as.list(data_frame), чтобы имитировать то, что будет передаваться lapply, я пришел к следующему, который, думаю, работает:

rf_func <- function(y) {
  train(x = data_pred_scale[!(unlist(lapply(y, is.na))), ], 
        y = y[!(unlist(lapply(y, is.na)))], 
        method = "rf",
        tuneGrid = data.frame(.mtry = 3:6),
        nodesize = 3,
        ntrees = 500,
        trControl = trControl) }

models$rf <- lapply(as.list(data_resp), rf_func)

действительно это работает. Я [хакерски] сравнил набор данных, отличный от NA, с результатами trainingData в каждой модели caret следующим образом:

nas <- NULL
for(i in 1:ncol(data_resp)) {nas <- c(nas, length(data_resp[!is.na(data_resp[, i]), i]))}

model_nas <- NULL
for(i in 1:length(nas)) {model_nas <- c(model_nas, nrow(models$rf[[i]]$trainingData))}

identical(nas, model_nas)
[1] TRUE

Итак, является ли y[!unlist(lapply(y, is.na)))] лучшим/самым элегантным способом сделать что-то подобное. Это довольно уродливо...

Редактировать: Основываясь на ответе @Ricardo Saporta, я смог придумать это (вероятно, очевидное для ветеранов, но потерпите меня):

rf_func <- function(x, y) {
  train(x = x,
        y = y,
        method = "rf",
        tuneGrid = data.frame(.mtry = 3:6),
        nodesize = 3,
        ntrees = 500,
        trControl = trControl) }

models$rf <- lapply(data_resp, function (y) {
  rf_func(data_pred_scale[!is.na(y), ], y[!is.na(y)] ) 
  }
)

Есть ли еще лучший способ, или это довольно прилично? (Конечно, красивее, чем мой первый беспорядок выше.)

person Hendy    schedule 22.07.2013