Использование lapply для каждой матрицы списка - PullRequest
Новая
       17

Использование lapply для каждой матрицы списка

0 голосов
/ 08 июля 2019

Я пытаюсь использовать lapply для каждой матрицы списка.

Я хочу применить sample функцию, используя lapply.

Давайте рассмотрим пример. Я сгенерировал вероятность, которая будет использоваться для функции sample. (Извините, что не оптимизирую.) 

set.seed(1001)
given<-replicate(3,list(matrix(unlist(replicate(5,sample(c(0.2,0.3,0.4,0.1),4,replace=FALSE),simplify=FALSE)),ncol=4)))
given   


   [[1]]
     [,1] [,2] [,3] [,4]
[1,]  0.1  0.4  0.2  0.4
[2,]  0.3  0.2  0.1  0.2
[3,]  0.2  0.1  0.1  0.3
[4,]  0.4  0.3  0.3  0.1
[5,]  0.3  0.4  0.2  0.4

[[2]]
     [,1] [,2] [,3] [,4]
[1,]  0.4  0.4  0.3  0.4
[2,]  0.3  0.1  0.4  0.2
[3,]  0.1  0.2  0.1  0.4
[4,]  0.2  0.1  0.3  0.3
[5,]  0.3  0.2  0.2  0.1

[[3]]
     [,1] [,2] [,3] [,4]
[1,]  0.3  0.2  0.2  0.1
[2,]  0.2  0.3  0.3  0.3
[3,]  0.1  0.4  0.2  0.2
[4,]  0.4  0.4  0.3  0.4
[5,]  0.1  0.1  0.4  0.1

Итак, этот список состоит из трех компонентов, каждый из которых представляет собой матрицу 5 * 4. Каждой строке матрицы (то есть 15 строк) дается вероятность. Я хочу сгенерировать 10 образцов с заданной вероятностью. Для простоты я изменю выборку с «1» до «4» с заданной вероятностью.

С помощью этого документа ( Как создать случайный набор данных с прогнозируемой вероятностью? ) я научился применять функцию sample к компоненту одной матрицы. Если бы given была одной матрицей, я бы выполнил эту функцию.

lapply(1:nrow(given), function(x) sample(1:4, 10, replace = TRUE, prob = given[x, ]))

Но, как видите, given - это список с 3 матрицами. Я попробовал несколько попыток, например prob=given$x, prob=given[[x,]] и т. Д., Но все это не удалось. Есть ли способ применить это?

* дополнительный вопрос

Ронак Шаху

Получилось совершенно верно. Спасибо!

Однако, извините, что не задал все вопросы. На самом деле, в наборе вероятностей были некоторые пропущенные данные.

Я сделаю одну строку в given Устанавливаю пропущенное значение. 

given[[2]][1,]<-NA
given

[[1]]
     [,1] [,2] [,3] [,4]
[1,]  0.1  0.4  0.2  0.4
[2,]  0.3  0.2  0.1  0.2
[3,]  0.2  0.1  0.1  0.3
[4,]  0.4  0.3  0.3  0.1
[5,]  0.3  0.4  0.2  0.4

[[2]]
     [,1] [,2] [,3] [,4]
[1,]   NA   NA   NA   NA
[2,]  0.3  0.1  0.4  0.2
[3,]  0.1  0.2  0.1  0.4
[4,]  0.2  0.1  0.3  0.3
[5,]  0.3  0.2  0.2  0.1

[[3]]
     [,1] [,2] [,3] [,4]
[1,]  0.3  0.2  0.2  0.1
[2,]  0.2  0.3  0.3  0.3
[3,]  0.1  0.4  0.2  0.2
[4,]  0.4  0.4  0.3  0.4
[5,]  0.1  0.1  0.4  0.1

Прочитав ваш ответ, я манипулирую некоторым кодом в ваших ответах. Но результаты были совсем другими. 

 lapply(given, function(x) t(sapply(seq_len(nrow(x)), function(y)
 ifelse(is.na(x[y,]),NA,sample(1:4, 10, replace = TRUE, prob = x[y, ])))))

[[1]]
     [,1] [,2] [,3] [,4]
[1,]    4    4    4    2
[2,]    2    3    2    2
[3,]    4    4    1    1
[4,]    1    3    1    1
[5,]    3    3    1    1

[[2]]
     [,1] [,2] [,3] [,4]
[1,]   NA   NA   NA   NA
[2,]    3    4    3    2
[3,]    4    2    2    2
[4,]    4    2    1    1
[5,]    1    2    4    1

[[3]]
     [,1] [,2] [,3] [,4]
[1,]    1    1    2    2
[2,]    3    4    3    4
[3,]    2    3    2    4
[4,]    2    4    4    2
[5,]    2    3    3    3

Как видите, NA получилось правильно, но он сгенерировал только 4 сэмпла, а не 10 сэмплов. Не могли бы вы показать мне, как решить эту проблему?

1 Ответ

3 голосов
/ 08 июля 2019

Без чрезмерного усложнения и продолжения вашей попытки, мы можем использовать sapply внутри lapply.lapply будет зацикливаться на каждом списке, тогда как sapply будет зацикливаться на каждой строке в списке. 

lapply(given, function(x) t(sapply(seq_len(nrow(x)), function(y) 
             sample(1:4, 10, replace = TRUE, prob = x[y, ]))))

#[[1]]
#     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
#[1,]    2    3    4    4    3    4    4    4    2     1
#[2,]    1    1    1    2    4    1    2    2    2     3
#[3,]    1    4    4    1    4    1    1    2    2     4
#[4,]    1    1    3    2    3    2    3    1    1     3
#[5,]    4    2    3    1    2    2    1    4    1     4

#[[2]]
#     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
#[1,]    1    3    2    3    2    1    1    1    2     1
#[2,]    3    1    1    1    3    3    2    3    1     4
#[3,]    4    3    4    2    4    4    4    4    4     4
#[4,]    3    3    4    4    3    4    4    2    3     4
#[5,]    1    1    2    2    4    1    1    2    1     4

#[[3]]
#     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
#[1,]    3    1    1    2    1    3    3    1    2     1
#[2,]    4    4    3    1    3    3    3    3    2     4
#[3,]    1    1    2    2    2    3    4    4    2     4
#[4,]    2    1    4    4    1    3    3    4    4     1
#[5,]    3    3    3    3    3    3    1    2    3     3

Для обработки NA значений мы можем сделать 

lapply(given, function(x) t(sapply(seq_len(nrow(x)), function(y) 
      if (anyNA(x[y,])) rep(NA, 10) else 
         sample(1:4, 10, replace = TRUE, prob = x[y, ]))))
...