0

En este post se comentó sobre como generar Números aleatorios con probabilidades distintas

Sé que R provee una función sample para obtener una muestra con y sin reposición para un conjunto de datos.

En tal sentido, sería sencillo escribir lo siguiente para mezclar todos los datos contenidos en dat con sus respectivas probabilidades prob

dat <- c(5,10,25,50,80)
prob <- c(0.6299994, 0.2998997, 0.0699999, 0.0001000, 0.0000010)

sample(dat, prob=prob) # size=3 obtendríamos 3 de los 5 números

He buscado sin éxito encontrar un package que permita gráficar las funciones de probabilidad sin reposición, no sé si alguien conozca alguna ya implementada.

Por ejemplo que grafique las probabilidad acumuladas de

sample(1:9)

Conforme se van extrayendo los números -sin reposición- quedando algo así

introducir la descripción de la imagen aquí

A pesar de no haber encontrar algo ya hecho para usar directamente, pude hacer una implementación sobre el particular.

sinReposicion <- function (x=1:10, p, n=F, g=F){
    if (missing(p)) { s<- length(x); p <- rep(1/s,s)}
    if (!n) {n <- length(x)}

    n <- min(n,length(x)) # la muestra no puede ser mayor
                          # a la cantidad de datos
    dat <- c()            # contenedor de datos a extraidos

    dm <- min(as.integer(round(sqrt(n),0)),3)   # dimensiones del grid máximo 3x3
    par(mfrow=c(dm,dm))                         # combinar graficos dmxdm

    for (j in 1:n){
        pA <- c(p[1], 0)    # longitud 2 como minimo
                            # pA seria de longitud 1 cuando el tamanio de
                            # muestra sea igual a los datos por tanto
                            # para que trabaje el siguiente bucle 'for' se debe
                            # garantizar que siempre hay un elemento anterior en
                            # el vector pA que contiene las probabilidades Acum

        for ( i in 2:max( length(p), 2 ) ) pA[i] <- p[i]+pA[i-1]

        if (g){
                if (j==n) pA<-pA[1] # tiene que haber solo una probabilidad 

                plot(   c(0,x), c(0,pA),
                        col=rgb(243,182,65, max=255),
                        col.main="azure4", col.lab="azure4",

                        cex.axis = 1, cex.lab = 1, type="s", xaxt="n",

                        main=paste0("En Extraccion ",j),
                        ylab="Probabilidad Acumulada",
                        xlab="Número de Interés"
                    )

                box(col="white")
                axis(side=1, at=c(0,x), col="azure4", col.axis="azure4", col.ticks="azure4")
                axis(side=2, col="azure4", col.axis="azure4", col.ticks="azure4")
        }

        a <- runif(1,0,1)           # se genera un número aleatorio entre 0 y 1
        id <- min( which( rank(pA)>a & pA>a ) ) # se determina 
        dat <- c(dat, x[id])        # x[id] es equivalente a x[pA>a][1]

        x <- x[-id]; p <- p[-id]    # retiramos el dato y
                                    # la probabilidad correspondiente

        p <- p/sum(p)               # actualizamos las probabilidades
                                    # de los elementos que quedan
                                    # para que todas sumen 1
    }

    dat
}

Puedes probar el código en replit

Mi consulta como dije es si ya existe un paquete que realice este tipo de cosas porque deduzco que estos, trabajan llamando a C y son más rápidos por ende.

debug   / funciones            sample         sinReposicion
Real time:                     0.225 s           0.254 s
User time:                     0.147 s           0.176 s
Sys. time:                     0.080 s           0.077 s
CPU share:                     101.34 %          99.78 %

Los valores arriba señalados pueden variar cuando los ejecutes

sample Try It Online - TIO

sinReposicion Try It Online - TIO

1 respuesta 1

0

Como el código en si mismo genera los gráficos y dado que no he tenido éxito en encontrar un paquete que obtenga lo solicitado, sólo puedo indicar que el código publicado inicialmente puede ser simplificado con la función cumsum

En tal sentido, se puede reemplazar estas sentencias:

pA <- c(p[1], 0)  
for ( i in 2:max( length(p), 2 ) ) pA[i] <- p[i]+pA[i-1]

Por esta otra:

pA <- cumsum(p)

Si bien no se gana mucho rendimiento

debug / funciones    sinReposicion / cumsum
Real time:                  0.244 s
User time:                  0.193 s
Sys. time:                  0.050 s
CPU share:                  99.65 %
Exit code:                  0

Los valores arriba señalados pueden variar cuando los ejecutes Try It Online - TIO

Por lo menos se simplifica código, sin que se pierda lo alcanzado.

Tu Respuesta

By clicking “Publica tu respuesta”, you agree to our terms of service and acknowledge you have read our privacy policy.

¿No es la respuesta que buscas? Examina otras preguntas con la etiqueta o formula tu propia pregunta.