R: comando sample () sobject a un vincolo

Sto provando a campionare casualmente 7 numeri da 0 a 7 (con sostituzione), ma sobject al vincolo che i numeri scelti sumno a 7. Quindi, per esempio, l’output 0 1 1 2 3 0 0 è ok, ma l’output 1 2 3 4 5 6 7 non lo è. C’è un modo per utilizzare il comando di esempio con vincoli aggiunti?

Intendo utilizzare la funzione replicate () con il comando sample come argomento, per restituire un elenco di N diversi vettori dal comando di esempio. Nel modo in cui sto attualmente usando il comando di esempio (senza alcun vincolo), ho bisogno che N sia molto grande per ottenere il maggior numero ansible di vettori che sumno esattamente il 7 ansible. Immagino che ci debba essere un modo più semplice per farlo!

Ecco il mio codice per quella parte:

x <- replicate(100000, sample(0:7, 7, replace=T)) 

Idealmente, voglio 10.000 o 100.000 vettori in x per sumre a 7, ma per farlo è necessario un enorme valore N. Grazie per qualsiasi aiuto.

Per assicurarti di campionare in modo uniforms, potresti semplicemente generare tutte le permutazioni e limitare a quelle che sumno a 7:

 library(gtools) perms <- permutations(8, 7, 0:7, repeats.allowed=T) perms7 <- perms[rowSums(perms) == 7,] 

Da nrow(perms7) , vediamo che ci sono solo 1716 possibili permutazioni che sumno a 7. Ora puoi campionare uniformsmente dalle permutazioni:

 set.seed(144) my.perms <- perms7[sample(nrow(perms7), 100000, replace=T),] head(my.perms) # [,1] [,2] [,3] [,4] [,5] [,6] [,7] # [1,] 0 0 0 2 5 0 0 # [2,] 1 3 0 1 2 0 0 # [3,] 1 4 1 1 0 0 0 # [4,] 1 0 0 3 0 3 0 # [5,] 0 2 0 0 0 5 0 # [6,] 1 1 2 0 0 2 1 

Un vantaggio di questo approccio è che è facile vedere che stiamo campionando in modo uniforms a caso. Inoltre, è abbastanza veloce: la costruzione di perms7 ha richiesto 0,3 secondi sul mio computer e la costruzione di un milione di file my.perms ha richiesto 0,04 secondi. Se devi disegnare molti vettori, questo sarà un po 'più veloce di un approccio ricorsivo perché stai semplicemente usando l'indicizzazione della matrice in perms7 invece di generare ciascun vettore separatamente.

Ecco una distribuzione dei conteggi di numeri nel campione:

 # 0 1 2 3 4 5 6 7 # 323347 188162 102812 51344 22811 8629 2472 423 

Inizia con tutti gli zeri, aggiungi uno a qualsiasi elemento, fai 7 volte:

 sumTo = function(){ v = rep(0,7) for(i in 1:7){ addTo=sample(7)[1] v[addTo]=v[addTo]+1 } v } 

O in modo equivalente, basta scegliere quale dei 7 elementi si intende incrementare in un campione di lunghezza 7, quindi tabulare quelli, assicurandosi di tabellare fino a 7:

 sumTo = function(){tabulate(sample(7, 7, replace = TRUE), 7)} > sumTo() [1] 2 1 0 0 4 0 0 > sumTo() [1] 1 3 1 0 1 0 1 > sumTo() [1] 1 1 0 2 1 0 2 

Non so se questo produrrà un campione uniforms da tutte le combinazioni possibili …

La distribuzione dei singoli elementi oltre 100.000 rappresentanti è:

 > X = replicate(100000,sumTo()) > table(X) X 0 1 2 3 4 5 6 237709 277926 138810 38465 6427 627 36 

Non ha colpito 0,0,0,0,0,7 per quella volta!

Questo algoritmo ricorsivo produrrà una distribuzione con una probabilità maggiore per i numeri grandi rispetto alle altre soluzioni. L’idea è di lanciare un numero casuale y in 0:7 in uno qualsiasi dei sette slot disponibili, quindi ripetere con un numero casuale in 0:(7-y) , ecc:

 sample.sum <- function(x = 0:7, n = 7L, s = 7L) { if (n == 1) return(s) x <- x[x <= s] y <- sample(x, 1) sample(c(y, Recall(x, n - 1L, s - y))) } set.seed(123L) sample.sum() # [1] 0 4 0 2 0 0 1 

Il disegno di 100.000 vettori ha impiegato 11 secondi sulla mia macchina e qui è la distribuzione che ottengo:

 # 0 1 2 3 4 5 6 7 # 441607 98359 50587 33364 25055 20257 16527 14244 

Potrebbe esserci un modo più semplice e / o più elegante, ma ecco un metodo a forza bruta che utilizza la funzione LSPM:::.nPri . Il collegamento include la definizione di una versione solo R dell’algoritmo, per gli interessati.

 #install.packages("LSPM", repos="http://r-forge.r-project.org") library(LSPM) # generate all possible permutations, since there are only ~2.1e6 of them # (this takes < 40s on my 2.2Ghz laptop) x <- lapply(seq_len(8^7), nPri, n=8, r=7, replace=TRUE) # set each permutation that doesn't sum to 7 to NULL y <- lapply(x, function(p) if(sum(p-1) != 7) NULL else p-1) # subset all non-NULL permutations z <- y[which(!sapply(y, is.null))] 

Ora puoi provare da z e assicurarti che stai ottenendo una permutazione che si sum a 7.

Trovo questa domanda intrigante e gli ho dato qualche pensiero in più. Un altro (più generale) approccio al campione (approssimativo) uniformsmente da tutte le soluzioni possibili, senza generare e memorizzare tutte le permutazioni (che chiaramente non è ansible nel caso con molto più di 7 numeri), in R da sample() , potrebbe essere un Semplice implementazione MCMC:

 S <- c(0, 1, 1, 2, 3, 0, 0) #initial solution N <- 100 #number of dependent samples (or burn in period) series <- numeric(N) for(i in 1:N){ b <- sample(1:length(S), 2, replace=FALSE) #pick 2 elements at random opt <- sum(S[-b]) #sum of complementary elements a <- sample(0:(7-opt), 1) #sample a substistute S[b[1]] <- a #change elements S[b[2]] <- 7 - opt - a } S #new sample 

Questo è ovviamente molto veloce per alcuni campioni. La distribuzione":

 #"distribution" N=100.000: 0 1 2 3 4 5 6 7 # 321729 189647 103206 52129 22287 8038 2532 432 

Ovviamente in questo caso, dove è effettivamente ansible trovare e memorizzare tutte le combinazioni, e se si desidera un campione enorme da tutti i risultati possibili, basta usare partitions::compositions(7, 7) , come suggerito anche da Josh O'Brien in i commenti, per evitare di calcolare tutte le permutazioni, quando è necessaria solo una piccola frazione:

 perms7 <- partitions::compositions(7, 7) >tabulate(perms7[, sample(ncol(perms7), 100000, TRUE)]+1, 8) #"distribution" N=100.000: 0 1 2 3 4 5 6 7 # 323075 188787 102328 51511 22754 8697 2413 435