Условно-вероятный эксперимент в R - PullRequest
Новая
       63

Условно-вероятный эксперимент в R

0 голосов
/ 20 марта 2020

Вот мой код 

library(dplyr)

rain_vector <- sample(c(0,1), 1000000, replace = T, prob= c(0.2,0.8))

for(el in 1:10){

df <- data.frame(rain = rain_vector )
df <- df %>% mutate(A= if_else(rain == 1, sample(c(0,1), 1, replace = T, prob= c(1/3,2/3)),
                          sample(c(0,1), 1, replace = T, prob= c(2/3,1/3))))

print(NROW(df[df$A==1,]))
print(NROW(df[df$A == 1 & df$rain == 1, ]))
print(NROW(df[df$rain == 1,]))
print("______________")

}

Вот вывод: 

[1] 0
[1] 0
[1] 800325
[1] "______________"
[1] 800325
[1] 800325
[1] 800325
[1] "______________"
[1] 800325
[1] 800325
[1] 800325
[1] "______________"
[1] 800325
[1] 800325
[1] 800325
[1] "______________"
[1] 800325
[1] 800325
[1] 800325
[1] "______________"
[1] 800325
[1] 800325
[1] 800325
[1] "______________"
[1] 800325
[1] 800325
[1] 800325
[1] "______________"
[1] 1000000
[1] 800325
[1] 800325
[1] "______________"
[1] 1000000
[1] 800325
[1] 800325
[1] "______________"
[1] 1000000
[1] 800325
[1] 800325
[1] "______________"

Ни один из результатов не имеет смысла для меня. Давайте посмотрим на последний. Случай A = 1 происходит всегда, в то время как он должен происходить с вероятностью 1/3 и 2/3 в зависимости от дождя. Есть ли что-нибудь о dplyr упаковке. Есть предложения?

1 Ответ

1 голос
/ 20 марта 2020

Проблема в том, что sample(c(0,1), 1, replace = T, prob= c(1/3,2/3)) имеет длину 1, поэтому он повторяет значение для каждой строки.

Вместо этого вы можете использовать rowwise() перед вызовом mutate, так что вы явно говорите, что должно быть sample() вызов для каждой строки. 

  df <- df %>% 
    rowwise() %>%
    mutate(A= if_else(rain == 1, sample(c(0,1), 1, replace = T, prob= c(1/3,2/3)),
                                 sample(c(0,1), 1, replace = T, prob= c(2/3,1/3))))

Другим более быстрым вариантом является использование базы R и вычисление одной выборки с соответствующей длиной для каждого значения из двух значений rain, уменьшая количество вызовов до sample() с 1000000 до 2: 

rain_vector <- sample(c(0,1), 1000000, replace = T, prob= c(0.2,0.8))

for(el in 1:10){

  df <- data.frame(rain = rain_vector, A = numeric(length(rain_vector)))
  df[rain_vector == 1, "A"] <- sample(c(0,1), sum(rain_vector==1), prob= c(1/3,2/3), replace = T)
  df[rain_vector == 0, "A"] <- sample(c(0,1), sum(rain_vector==0), prob= c(2/3,1/3), replace = T)

  print(NROW(df[df$A==1,]))
  print(NROW(df[df$A == 1 & df$rain == 1, ]))
  print(NROW(df[df$rain == 1,]))
  print("______________")

}
...