# 1) # Baca se kockica N puta, potrebno je odrediti frekvenciju bacanja sestice, ako je kocka homogena, tj P(i)=1/6 # za i=1,2,...,6. Napraviti funkciju koja iscrtava histogram od n ponovljenih eksperimenata. # Prvi nacin za resenje, preko "runif" funkcije. # Ideja koda jeste da slucajno simuliramo neki broj i proveravamo u koji interval je upao. # Ukoliko je broj veci od 5/6, onda je upao u interval [5/6, 1], a verovatnoca upadanja u taj interval je bas 1/6. # Sto i jeste trazena verovatnoca dobijanja sestice. frekvencija_sestice <- function(N) { x=runif(N, 0, 1) #obratite paznju, ovo je vektor duzine N return(mean(x >= 5/6)) } frekvencija_sestice(100000) # Moramo prethodnu funkciju ponoviti n- puta da bismo mogli da dobijemo vise podataka, taj ocenjenih verovatnoca # da bismo mogli da plotujemo histogram, stoga ova funkcija ispod. # Sve rezultate od n poziva funkcije frekvencija_sestice pakujemo u jedan vektor, prema kojem posle pravimo histogram. histogram1 <- function(n, N) { vektor_frekvencija = vector(length = n) # prazan vektor for(i in 1:n) { vektor_frekvencija = c(vektor_frekvencija, frekvencija_sestice(N)) } hist(vektor_frekvencija) return(vektor_frekvencija) } frekvencija_sestice(100000) 1/6 histogram1(100, 100) # Drugi nacin: # Umesto funkcije "runif", koristicemo funkcije "sample", koja ce na slucajan nacin, da odabere jedan broj od 1 do 6 (prvi argument), # sa datim verovatnocama dobijanja svakog od tih brojeva (cetvrti argument funkcije) # frekvencija_sestice2 <- function(N) { x=sample(1:6, N, replace = TRUE, prob=c(1/6, 1/6, 1/6, 1/6, 1/6, 1/6) ) return(mean(x == 6)) } histogram2 <-function(n, N) { vektor_frekvencija = vector(length = n) # prazan vektor duzine n # Drugi nacin da se izbegne for petlja vektor_frekvencija = sapply(vektor_frekvencija, function(x) frekvencija_sestice2(N) ) hist(vektor_frekvencija) return(vektor_frekvencija) } # 2) # Istovremeno i nezavisno se baca homogena kockica za igru i fer novcic. Naci verovatnocu da je pala sestica i glava. # I oceniti tu verovatnocu MonteKarlo metodom u R-u. # Slicno kao i u prethodnom zadatku napravimo funkciju zadatak2 <- function(n) { rezultati = runif(n) return(mean(rezultati < 1/12)) } # Ili zadatak2_druga_verzija <- function(n) { kockica = sample(1:6, size = n, replace = TRUE) # prob ne moramo da pisemo kad je jednakoverovatno novcic = sample(c('Glava', 'Pismo'), size = n, replace = TRUE) return(mean(kockica == 6 & novcic == 'Glava')) } zadatak2(10000) zadatak2_druga_verzija(10000) 1/12 # Ocekivano i vracaju slicne brojeve # 3) # (a) Napraviti funkciju koja vraca brojeve od 1 do 6, tako da su svi jednako verovatni. # Na jedan od od nacina koji su navedeni u prethodnom zadatku: moze preko sample (bas takav sample smo napravili u zadatku 1) # ili preko runif na sledeci nacin: x = runif(1, 0, 1) # dobijamo jedan realan broj izmedju 0 i 1. x1 = floor(6*x)+1 # mnozimo sa 6, uzimamo ceo deo i dodajemo 1, time dobijamo to sto je trazeno. # 4) # (a) Neka igrac ima pocetni kapital A i on baca kockicu. Ako dobije 1, 3 ili 5, njegov kapital # se uveca za 1 dinar, a u suprotnom izgubi 1 dinar. Za N ponovljenih bacanja, nacrtati # trajektoriju njegovog kapitala u zavisnosti od trenutnog bacanja. # Oceniti verovatnocu da je igrac u plusu nakon n partija? # Ideja: pomocu funkcije sample imitiramo bacanje kockice i proveravamo pomocu if naredbe da li smo dobili 1, 3 ili 5. # Ukoliko jesmo, kapiral se povecava za jedan, inace smanjuje za jedan. # Sve to smestimo u jedan vektor, koji smo nazvali trajektorija i plotujemo ga na kraju. bacanja <- function(a, N) { x = sample(1:6, N, replace = TRUE) rezultat = ifelse(x %% 2 == 1, 1, -1) trajektorija = cumsum(rezultat) + a return(trajektorija) } trajektorija = bacanja(10, 100) plot(trajektorija) abline(trajektorija[1], 0) # Moramo funkciju "bacanja" vise puta (u nasem slucaju n) da pokrenemo da bismo videli koliko cesto igrac zavrsava u plusu\minusu verovatnoca_plusa <- function(a, N, n) { bacanja = sapply(vector(length = n), function(x) bacanja(a, N)) rezultat = ifelse(bacanja > a, 1, 0) return(mean(rezultat)) } verovatnoca_plusa(1, 1000, 1000) system.time(verovatnoca_plusa(1, 1000, 1000)) # a sad isto preko for-petlji bacanja_for <- function(a, N) { trajektorija = a for(i in 1:N) { x = sample(1:6, 1, replace = TRUE) rezultat = ifelse(x %% 2 == 1, a <- a + 1, a <- a - 1) trajektorija=c(trajektorija, rezultat) } return(trajektorija) } # Moramo funkciju "bacanja" vise puta (u nasem slucaju n) da pokrenemo da bismo videli koliko cesto igrac zavrsava u plusu\minusu verovatnoca_plusa_for <- function(a, N, n) { vektor_plusa=c() for(i in 1:n) { x = bacanja_for(a, N) b = ifelse(x[N] > a , 1, 0) vektor_plusa=c(vektor_plusa, b) } return(mean(vektor_plusa)) } verovatnoca_plusa_for(1, 100, 100) system.time(verovatnoca_plusa_for(1, 1000, 1000)) system.time(verovatnoca_plusa(1, 1000, 1000)) # vidimo da je razlika OGROMNA, a nije ni samo zbog for-petlji, vec i generalno kod kvalitetnije napisan # (b) Imamo i drugog igraca, koji ide u kazino i igra rulet # (po americkim pravilima, odnosno moguci su brojevi:0, 00, 1, 2, 3, ..., 36 ) # Brojevi 0 i 00 su zeleni, dok su preostali prirodni brojevi crni ili crveni, tacno po pola. # Simulirati za N pokusaja da nas igrac igra na crveno i iscrtati trajektoriju (odnosno grafik njegovog kapitala) # njegovog kapitala. (Pobeda donosi 1$) # Simulirati za N pokusaja da nas igrac stavlja na neki tacan broj sve vreme, iscrtati trajektoriju. # (Pobeda donosi 35$) # Ideja: slicno kao u prethodnom zadatku, samo sada imamo 1/38 verovatnocu da ispadne neki broj. A kako je # brojeva jedne boje 18, to je verovatnoce boje 18/38, sto i proveravamo, da li smo upali u interval duzine 18/38. # Duzina intervala iz [0,1] zapravo predstavlja verovatnocu. rulet_boja <- function(a, N) { bacanja = ifelse(runif(N) <= 18/38, 1, -1) trajektorija = cumsum(bacanja) + a plot(trajektorija, type = "b") abline(a, 0) return(trajektorija) } # Slicno, samo ovoga puta za broj, ne za boju, znaci menja se verovatnoca. sada je 1/38 i vise dobijamo kada ubodemo tacan. rulet_broj<- function(a, N) { bacanja = ifelse(runif(N) <= 1/38, 35, -1) trajektorija = cumsum(bacanja) + a plot(trajektorija, type = "b") abline(a, 0) return(trajektorija) } par(mfrow = c(1,2)) boja = rulet_boja(10, 500) broj = rulet_broj(10, 500) # (c) Za domaci: isprobati i simulirati sistem dupliranja ulozenog novca, tj: # Pretpostavimo da ste stavili 1$ na crveno, svaki put kada pobedite opet stavljate 1$. Svaki put kada izgubite # duplirate ulaganje. I pretpostavimo da stajete posle 5$ dolara u plusu i 100$ u minusu. Da li se isplati? # 5) # Nesto o MonteKarlo metodi. # Zelimo da odredimo povrsinu ispod neke odredjene funkcije na intervalu [0, 1] pomocu Monte Karlo metode. N=100000 s=5 Montekarlo <- function(N,s) # s - stepen funkcije, s>0. { brojac = 0 for(i in 1:N) { x=runif(1, 0, 1) y=runif(1, 0, 1) # To su nase koodinate tacke if(y < x^s) #a mogli smo da stavimo i cos(x), sin(x) itd. { brojac = brojac + 1 } } return(brojac/N) } Montekarlo(N, s) Montekarlo2<-function(N,s) { x=runif(N, 0, 1) y=runif(N, 0, 1) z=ifelse(y < x^s, 1, 0) return(mean(z)) } Montekarlo2(N, s) system.time(Montekarlo(N*10, s)) system.time(Montekarlo2(N*10, s)) # 6) # Na turniru treba da odigrate tri partije stonog tenisa sa sampionom A i od njega slabijim igracem B po jednog od shema: # A-B-A ili B-A-B. Nagradu dobijate ako pobedite bar dve partije uzastopce. Koju biste strategiju odabrali i zasto? # Dokazati i pokazati ispravno resenje. shema1 <- function(p1, p2) { x = runif(1) y = runif(1) z = runif(1) if( (x < p1 & y < p2) | (y < p2 & z < p1) ) { return(1) } else { return(0) } } shema2 <- function(p1, p2) { x = runif(1) y = runif(1) z = runif(1) if( (x < p2 & y < p1) | (y < p1 & z < p2) ) { return(1) } else { return(0) } } bolja <- function(n, p1, p2) { vektor = c() for(i in 1:n) { v1 = shema1(p1, p2) v2 = shema2(p1, p2) if( v1 - v2 > 0 ) { vektor = c(vektor, 1) } else { if( v2-v1 > 0 ) { vektor = c(vektor,2) } } } return( sum(vektor == 1)/sum(vektor == 2) ) } bolja(10000, 0.4, 0.7) # 7) # Neka je dat novcic kod kojeg sa verovatnocom p > 0.5 pada Glava. Smisliti fer zreb izmedju dva igraca koristeci taj novcic. nefer_igra <- function(p, N) { pobeda1 = 0 pobeda2 = 0 for(i in 1:N) { x=sample(c(0, 1), 2, replace = TRUE, c(p, 1 - p)) if(x[1] == 0 & x[2] == 1) { pobeda1 = pobeda1+1 } if(x[1] == 1 & x[2] == 0) { pobeda2 = pobeda2 + 1 } } return(pobeda1/pobeda2) } nefer_igra(0.9, 10000) # 8) # Tri kockice za igru se bacaju n puta odjednom. Oceniti verovatnocu da se bar jednom u zavisnosti # od n dogode sve tri sestice. tri_sestice <- function(n) { rezultat_prve = sample(1:6, size = n, replace = TRUE) rezultat_druge = sample(1:6, size = n, replace = TRUE) rezultat_trece = sample(1:6, size = n, replace = TRUE) indikator = ifelse(rezultat_prve == 6 & rezultat_druge == 6 & rezultat_trece == 6, 1, 0) return(mean(indikator)) } tri_sestice(10000) 1/216 # 9) # Neka porodica pravi decu sve dok ne dobije zensko dete. Odrediti prosecan broj dece u porodici # ako se testira 100 000 porodica. Pretpostavka je da je P(musko dete) = P(zensko dete) = 1/2. # Ilustracija postojanja i "while" petlje u R-u. porodice <- function(n = 100000, p = 1/2) { broj_dece = rep(1, n) for(i in 1:n) { dete = runif(1) while(dete < p) { dete = runif(1) broj_dece[i] = broj_dece[i] + 1 } } return(mean(broj_dece)) } porodice() # Kombinatorika # 10) # U spilu postoje 52 karte: 4 boje po 13 vrednosti. Izvlacimo 5 karata. # Posmatrajmo dogadaje: # (a) A - izvukli smo boju (izraz koji govori da su karte u istom znaku, ali nisu 5 uzastopnih vrednosti), # (b) B -izvukli smo dva para (dva puta po ista vrednost i jedna karta razlicite vrednosti od prethodnih 4). # Izracunati verovatnoce dogadaja A i B. # resenje # (a) 4(C^13_5 - 10)/ C^52_5 # (b) (C^13_1 * C^4_2 * C^12_1 * C^4_2 * C^44_1 * 1/2 )/C^52_5 # 11) # Imamo tri kutije i sest identicnih kuglica. # (a) Ako delimo kuglice tako da se u svakoj kutiji nadje bar jedna, kolika je verovatnoca da u jednoj # kutiji budu dve kuglice, u drugoj da budu tri, a u trecoj da bude jedna? # (b) Kolika je verovatnoca ako dozvolimo da u nekoj kutiji nema kuglica? # resenje # (a) 1/10 # (b) 1/C^8_2 = 1/28, jer mogu i da se poklope pregrade