Primjer 1: Simulirati bacanje regularne kockice za igru. Izračunati frekvenciju pojavljivanja šestice u 1000 izvođenja eksperimenta.
sample(6, 1, prob = rep(1/6,6))
## [1] 3
s <- sample(6, 1000, prob = rep(1/6,6), replace = TRUE)
mean(s == 6) # ekvivalentan poziv sum(s==6)/length(s)
## [1] 0.188
Primjer 2: Kockica za igru je tako napravljena da je vjerovatnoća padanja nekog broja proporcionalna količini tackica na toj strani. Odrediti vjerovatnoću da padne paran broj.
s <- sample(1:6, 10000, replace = TRUE, prob = c(1/21,2/21,3/21,4/21,5/21,6/21))
mean(s%%2 == 0)
## [1] 0.567
# Ideja je da definisemo koji ishodi predstavljaju pobjedu za igraca 1 odnosno 2.
# Npr neka se baca novcic dva puta i kazemo da je igrac 1 pobijedio ako se dogo-
# dio ishod pismo-glava, a igrac 2 ako se dogodio ishod glava-pismo. Na ovaj na-
# cin vjerovatnoce pobjede oba igraca su jednake. Provjerite ovaj rezultat
# eksperimentalno.
nefer.igra <- function(p) {
# neka 0 predstavlja pismo, a 1 glavu
novcic <- sample(c(0, 1), 2, replace = TRUE, prob = c(p, 1 - p))
if (novcic[1] == 0 & novcic[2] == 1)
return(1)
else if (novcic[1] == 1 & novcic[2] == 0)
return(2)
else
return(nefer.igra(p)) # ako se nije desilo PG/GP, bacamo opet 2 puta
}
# Sada hocemo da provjerimo odnos pobjeda igraca 1 odnosno 2 u 10000 odigranih
# partija. Neka je p=0.1, 1-p=0.9
r <- replicate(10000, nefer.igra(0.1))
sum(r == 1) / sum(r == 2)
## [1] 1.0404
# Odnos je priblizno isti, sto znaci da smo napravili fer igru.
Primjer 4: (zadatak 25. na spisku) Na turniru treba igrati 3 partije stonog tenisa protiv sampiona A i slabijeg igraca B, po jednoj od sema A-B-A ili B-A-B. Nagrada se dobija ako se pobedi u bar dve partije uzastopno. Koja sema je povoljnija?
# Simuliramo 1 turnir po datoj semi
# Argumenti p_a i p_b odredjuju verovatnoce da u partiji pobedi A, odnosno B.
# Argument sema odredjuje po kojoj semi radimo "ABA" ili "BAB"
# Vracamo 1 ako smo dobili nagradu, a 0 ako nismo
turnir <- function(p_a, p_b, sema = "ABA") {
sema_vec <- unlist(strsplit(sema, split = ""))
vrv_seme <- ifelse(sema_vec == "A", p_a, p_b)
nase_pobede <- sapply(vrv_seme, function(p) {
sample(c(0, 1), 1, prob = c(p, 1-p))
}
)
return(nase_pobede[1] + nase_pobede[2] == 2 ||
nase_pobede[2] + nase_pobede[3] == 2)
}
# Simulirajmo semu ABA 10000 puta i vidimo verovatnocu da pobedimo
mean(replicate(1e4, turnir(0.7, 0.2, "ABA")))
## [1] 0.4023
# Simulirajmo semu BAB 10000 puta i vidimo verovatnocu da pobedimo
mean(replicate(1e4, turnir(0.7, 0.2, "BAB")))#
## [1] 0.2891
# Veca je verovatnoca da dobijemo po prvoj semi! (Uporedite rezultate sa teorisjkim resenjem sa casa.)
Primjer 5: (zadatak 21. na spisku) Svaka od 15 ispitnih cedulja sadrzi 2 razlicita pitanja. Student zna odgovor na 25 pitanja. Da bi polozio ispit, mora da zna oba sa cedulje koju prvu izvuce ili prvo sa druge cedulje. Odrediti verovatnocu da student polozi.
# Simuliramo 1 polaganje studenta.
ispit <- function() {
pitanja <- sample(1:30) # permutovacemo pitanja, da ne bi postojao poznat redosled
cedulje <- matrix(pitanja, ncol = 2) # svaka cedulja je jedan red u matrici
poznata_pitanja <- sample(1:25)
# Moguci problemi: Ako su pitanja 1:30, a poznata 1:25 (bez sample), verovatnoca
# ispada 1, jer postoji poznata struktura cedulja, pa je prvo pitanje uvek poznato
# (jer matrix se puni po kolonama, pa je prvo pitanje uvek iz prvih 15)
# izvlaci prvu cedulju i ako zna oba pitanja, polozio je
izvucena_cedulja <- sample(1:15, 1)
izvucena_pitanja <- cedulje[izvucena_cedulja, ]
if (all(izvucena_pitanja %in% poznata_pitanja)) {
return(TRUE)
} else if (any(izvucena_pitanja %in% poznata_pitanja)){
# Ako ne zna oba, ali zna bar jedno, izvlaci opet
ostale_cedulje <- cedulje[-izvucena_cedulja, ]
# PROBLEM: Kada ne bismo izbacili vec izvucenu cedulju, nego opet vukli iz
# 1:15, dobili bismo vrv 0.928, sto je neodoljivo blizu tacnog resenja, ali
# nije 0.935 koliko treba da bude!
novo_pitanje <- ostale_cedulje[sample(1:14, 1), 1] # prvo sa nove cedulje
# ako zna prvo, polozio je
if (novo_pitanje %in% poznata_pitanja) {
return(TRUE)
}
}
# u svim ostalim sljucajevima pada
return(FALSE)
}
# simuliramo ispit 10000 puta da ocenimo verovatnocu
mean(replicate(1e5, ispit()))
## [1] 0.93521
Primjer 6: (zadatak 15. na spisku) U voz koji ima \(m\) vagona penje se \(n\) (\(n\geq m\)) putnika. Odrediti verovatnocu da u svaki vagon udje bar po 1 putnik.
# simuliramo jedan raspored putnika u vozu
penjanje <- function(m, n) {
# broj ljudi po vagonu je vektor duzine m
vagoni <- numeric(m)
# svaki putnik koji naidje bira jedan vagon slucajno
for (i in 1:n) {
izabrani_vagon <- sample(1:m, 1)
vagoni[izabrani_vagon] = vagoni[izabrani_vagon] + 1
}
return(vagoni)
}
mean(replicate(1e4, all(penjanje(5, 10) > 0)))
## [1] 0.5251
# teorijsko resenje sa casa:
resenje <- function(m, n) {
k <- 0:m
clanovi_sume <- choose(m, k) * (-1)^k * ((m-k)/m)^n
sum(clanovi_sume)
}
resenje(5, 10)
## [1] 0.5225472
# priblizno isto