Asignación de un número específico de valores informados por una distribución de probabilidad (en R)

Question

¡Hola y gracias de antemano por la ayuda!

Estoy tratando de generar un vector con un número específico de valores que se asignan según una distribución de probabilidad. Por ejemplo, quiero un vector de longitud 31, que contenga 26 ceros y 5 unos. (La suma total del vector siempre debe ser de cinco.) Sin embargo, la ubicación de los mismos es importante. E identificar qué valores debe ser uno y lo que debería ser cero, tengo un vector de probabilidades (longitud 31), que se ve así:

probs<-c(0.01,0.02,0.01,0.02,0.01,0.01,0.01,0.04,0.01,0.01,0.12,0.01,0.02,0.01, 
0.14,0.06,0.01,0.01,0.01,0.01,0.01,0.14,0.01,0.07,0.01,0.01,0.04,0.08,0.01,0.02,0.01) 

puedo seleccionar valores de acuerdo con esta distribución y obtener un vector de longitud 31 usando rbinom, pero no puedo seleccionar exactamente cinco valores.

Inv=rbinom(length(probs),1,probs) 
Inv 
[1] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 

¿Alguna idea?

¡Gracias nuevamente!

Answer 1

¿Qué tal si utiliza un sample.int ponderado para seleccionar las ubicaciones?

Inv<-integer(31) 
Inv[sample.int(31,5,prob=probs)]<-1 
Inv 
[1] 0 0 0 1 0 1 0 0 0 0 1 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 

Answer 2

Creo que desea volver a muestrear desde la distribución binomial con un conjunto dado de probabilidades hasta que alcance el valor objetivo de 5, ¿verdad? Si es así, entonces creo que esto hace lo que quieres. Se puede usar un ciclo while para iterar hasta que se cumpla la condición. Si usted alimenta a probabilités muy poco realistas y los valores objetivo, supongo que podría convertirse en una función del fugitivo, por lo que considerar advertido :)

FOO <- function(probs, target) { 
    out <- rbinom(length(probs), 1, probs) 

    while (sum(out) != target) { 

    out <- rbinom(length(probs), 1, probs) 
    } 
    return(out) 
} 

FOO (hubieron problemas, target = 5)

> FOO(probs, target = 5) 
[1] 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 1 0 0 0 1 0 0 1 0 0 0 0 1 0 

Answer 3

Chase proporciona una excelente respuesta y menciona el problema de la iteración de run-away while(). Uno de los problemas con un run-away while() es que si realiza este un ensayo a la vez, y se necesitan muchos, por ejemplo t, para encontrar uno que coincida con el número objetivo de 1 s, incurre en la sobrecarga de t llama a la función principal, rbinom() en este caso.

Hay una salida, sin embargo, porque rbinom(), como todos estos (pseudo) generadores de números aleatorios en R, se vectorizado, podemos generar m ensayos a la vez y comprobar los m ensayos para la conformidad a los requisitos de 5 1 s. Si no se encuentra ninguno, repetidamente extraemos m ensayos hasta que encontremos uno que se conforme. Esta idea se implementa en la función foo() a continuación. El argumento chunkSize es m, el número de intentos a realizar a la vez. También aproveché la oportunidad para permitir que la función encontrara más de una única prueba conforme; El argumento n controla la cantidad de ensayos conformes que debe devolver.

foo <- function(probs, target, n = 1, chunkSize = 100) { 
    len <- length(probs) 
    out <- matrix(ncol = len, nrow = 0) ## return object 
    ## draw chunkSize trials 
    trial <- matrix(rbinom(len * chunkSize, 1, probs), 
        ncol = len, byrow = TRUE) 
    rs <- rowSums(trial) ## How manys `1`s 
    ok <- which(rs == 5L) ## which meet the `target` 
    found <- length(ok) ## how many meet the target 
    if(found > 0)   ## if we found some, add them to out 
     out <- rbind(out, 
        trial[ok, , drop = FALSE][seq_len(min(n,found)), , 
               drop = FALSE]) 
    ## if we haven't found enough, repeat the whole thing until we do 
    while(found < n) { 
     trial <- matrix(rbinom(len * chunkSize, 1, probs), 
          ncol = len, byrow = TRUE) 
     rs <- rowSums(trial) 
     ok <- which(rs == 5L) 
     New <- length(ok) 
     if(New > 0) { 
      found <- found + New 
      out <- rbind(out, trial[ok, , drop = FALSE][seq_len(min(n, New)), , 
                 drop = FALSE]) 
     } 
    } 
    if(n == 1L)   ## comment this, and 
     out <- drop(out) ## this if you don't want dimension dropping 
    out 
} 

funciona así:

> set.seed(1) 
> foo(probs, target = 5) 
[1] 1 0 0 0 0 0 0 0 1 0 0 0 0 0 1 0 0 0 0 0 0 1 0 0 0 1 0 0 0 0 
[31] 0 
> foo(probs, target = 5, n = 2) 
    [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] 
[1,] 0 0 0 0 0 0 0 0 0  0  0 
[2,] 0 0 0 0 0 0 0 0 0  0  1 
    [,12] [,13] [,14] [,15] [,16] [,17] [,18] [,19] [,20] [,21] 
[1,]  0  0  0  1  1  0  0  0  0  0 
[2,]  0  1  0  0  1  0  0  0  0  0 
    [,22] [,23] [,24] [,25] [,26] [,27] [,28] [,29] [,30] [,31] 
[1,]  1  0  1  0  0  0  1  0  0  0 
[2,]  1  0  1  0  0  0  0  0  0  0 

Tenga en cuenta que se me cae la dimensión vacía en el caso en que n == 1. Comente el último fragmento de código if si no desea esta característica.

Debe equilibrar el tamaño de chunkSize con la carga computacional de verificar tantas pruebas a la vez.Si el requisito (aquí 5 1 s) es muy poco probable, entonces aumente chunkSize, por lo que incurrirá en menos llamadas al rbinom(). Si el requisito es probable, hay pocos puntos de prueba de dibujo y grandes chunkSize a la vez si solo desea uno o dos, ya que debe evaluar cada sorteo de prueba.