Experiment testing chance of low probabilities being replicated more than higher probabilities

Proportion of samples in which obs 0.3 is replicated more times than 3.3

set.seed(0)
p <- c(0.3, 3.3, 6.4)
x <- factor(c("0.3", "3.3", "6.4"))
sum(p)

## [1] 10

s <- sample(x = x, size = 10, prob = p, replace = T)
which(s == "3.3")

## [1] 1 5 7 8 9

Loop for 1000 areas'

l3.3 <- 1:1000
l0.3 <- l3.3
sdf <- data.frame(array(dim = c(1000, 10)))
for (i in 1:1000) {
    s <- sample(x = x, size = 10, prob = p, replace = T)
    sdf[i, ] <- s
    l3.3[i] <- length(which(s == 3.3))
    l0.3[i] <- length(which(s == 0.3))
}
head(l3.3)

## [1] 3 4 4 5 3 3

which(l3.3 < l0.3)

##  [1]  34  53  98 192 271 408 454 486 558 589 727 784 905

w <- which(l3.3 < l0.3)
sdf[w, ]

##      X1  X2  X3  X4  X5  X6  X7  X8  X9 X10
## 34  0.3 0.3 6.4 6.4 6.4 3.3 6.4 6.4 6.4 6.4
## 53  0.3 6.4 6.4 6.4 6.4 6.4 6.4 6.4 6.4 6.4
## 98  3.3 6.4 6.4 0.3 6.4 6.4 6.4 6.4 6.4 0.3
## 192 6.4 6.4 0.3 6.4 6.4 6.4 6.4 0.3 3.3 6.4
## 271 6.4 6.4 6.4 6.4 6.4 6.4 6.4 6.4 0.3 6.4
## 408 6.4 6.4 6.4 6.4 6.4 6.4 0.3 6.4 6.4 6.4
## 454 6.4 6.4 0.3 6.4 6.4 6.4 6.4 6.4 6.4 6.4
## 486 6.4 6.4 6.4 6.4 6.4 6.4 0.3 6.4 6.4 6.4
## 558 0.3 6.4 6.4 6.4 6.4 0.3 6.4 6.4 6.4 6.4
## 589 6.4 6.4 6.4 6.4 6.4 6.4 6.4 6.4 6.4 0.3
## 727 6.4 6.4 0.3 6.4 6.4 6.4 6.4 6.4 6.4 6.4
## 784 0.3 6.4 6.4 6.4 6.4 6.4 6.4 6.4 0.3 6.4
## 905 6.4 6.4 6.4 0.3 6.4 6.4 6.4 6.4 6.4 6.4

result = length(w)/nrow(sdf)
result  # Proportion of areas containing more 0.3s thann 3.3s

## [1] 0.013

Loops of 1000 areas n = 10

num <- 10  # number of runs
result <- 1:num
for (j in 1:num) {
    sdf <- data.frame(array(dim = c(1000, 10)))
    for (i in 1:1000) {
        s <- sample(x = x, size = 10, prob = p, replace = T)
        sdf[i, ] <- s
        l3.3[i] <- length(which(s == 3.3))
        l0.3[i] <- length(which(s == 0.3))
    }
    l3.3
    which(l3.3 < l0.3)
    w <- which(l3.3 < l0.3)
    sdf[w, ]
    result[j] = length(w)/nrow(sdf)
}
result

##  [1] 0.016 0.012 0.014 0.016 0.014 0.014 0.009 0.021 0.014 0.012

Loops of 1000 areas n = 4

This reproduces the experiment, but for only 4 individuals sampled in each area

p <- c(0.3, 3.3, 0.4)
x <- factor(c("0.3", "3.3", "0.4"))
num <- 10  # number of runs
result <- 1:num
for (j in 1:num) {
    sdf <- data.frame(array(dim = c(1000, 4)))
    for (i in 1:1000) {
        s <- sample(x = x, size = 4, prob = p, replace = T)
        sdf[i, ] <- s
        l3.3[i] <- length(which(s == 3.3))
        l0.3[i] <- length(which(s == 0.3))
    }
    l3.3
    which(l3.3 < l0.3)
    w <- which(l3.3 < l0.3)
    sdf[w, ]
    result[j] = length(w)/nrow(sdf)
}
result

##  [1] 0.008 0.006 0.012 0.006 0.009 0.007 0.004 0.005 0.010 0.010

Loops of 1000 areas n = 100

This reproduces the experiment, but for 100 individuals sampled in each area

p <- c(0.3, 3.3, 96.4)
x <- factor(c("0.3", "3.3", "96.4"))
num <- 10  # number of runs
result <- 1:num
for (j in 1:num) {
    sdf <- data.frame(array(dim = c(1000, 100)))
    for (i in 1:1000) {
        s <- sample(x = x, size = 100, prob = p, replace = T)
        sdf[i, ] <- s
        l3.3[i] <- length(which(s == 3.3))
        l0.3[i] <- length(which(s == 0.3))
    }
    l3.3
    which(l3.3 < l0.3)
    w <- which(l3.3 < l0.3)
    sdf[w, ]
    result[j] = length(w)/nrow(sdf)
}
result

##  [1] 0.022 0.009 0.012 0.017 0.014 0.013 0.015 0.015 0.015 0.016