R-ohjelmointi.org

Tilastotieteellistä ohjelmointia R-kielellä

Heitä sikaa!

Heitä sikaa on se possunmuotoisten noppien heittelypeli, jota ainakin minä pelasin jo lapsena. Olen aina aiemmin ajatellut, että koko homma on ihan tuuripeliä, mutta kun tässä päivänä muutamana makasin sairaana kotisohvalla, niin aloin pohtia asiaa tarkemmin. Pakkohan näille possuillekin on voida esimerkiksi laskea yhden heiton keskimääräisen pistemäärän odotusarvo. Sitä varten tarvittaisiin vain tietoa eri yhdistelmien esiintymistaajuuksista. No, nakkelin possuja sohvapöydälle muutaman kerran, mutta se olin niin tylsää, että googlasin verkosta jo valmiiksi taulukoituja tuloksia, ja löytyihän niitä [1, 2, 3, 4].

Kokosin kaikki verkosta löytämäni tulokset yhteen, lisäsin joukkoon omat heittotulokseni, ja melko runsaaseen aineistoon perustuvan arvion kunkin possun todennäköisyydestä päätyä tiettyyn asentoon. Kahden possun eri asentojen yhdistelmille saadaan sitten kunkin heittovuoron pistemäärä. Näin luoduilla nopilla ja pisteytysmatriisilla on jo mahdollista pelata, kunhan ne ensin ohjelmoidaan tietokoneelle, tässä tapauksessa R-kieltä käyttäen (objektit die ja score.matrix). Hommaa voidaan kuitenkin helpottaa määrittelemällä muutamia apufunktioita yhden (cast.die()) ja kahden nopan (cast())heittämiseksi ja heiton pistemäärän selvittämiseksi (scoring()).

Asian olisi voinut todennäköisyyksien ja pisteytysmatriisin perusteella selvittää analyyttisestikin, mutta onhan tässä tietokonekin käytössä! Simulaatio selvitti 10 000 replikaatiolla, että keskimääräinen yhden heittovuoron pistemäärä on noin 4.7 pistettä. Heittojen jakauma näyttää seuraavalta:

Keskimääräinen yhden heiton pistemäärä ei vielä kauheasti auta keksimään sopivaa voittostrategiaa. Pelissähän voittaa se, joka ensimmäisenä saavuttaa sovitun pistemäärän, joka on tyypillisesti 100 pistettä. Tällöin aloittajalla voi olla etua jälkimmäisenä tulevaan pelaajaan verrattuna. Testataanpa onko tällaista etua aloittajalla: a) oletetaan että pelaajat haluavat saada heittovuorollaan vähintäänkin muutaman pisteen, mutta juuri muulla ei ole väliä ja b) peli päättyy 100 pisteeseen. Funktio cpu.plays.pig8() mahdollistaa erilaisten pelistrategioiden tutkimisen.

Simuloin 10 000 peliä, joista aloittava pelaaja voitti noin 51% ja toisena tuleva pelaaja noin 49%. Alla olevassa taulukossa on esitetty muutaman muunkin simulaation tuloksia. Niiden välillä on erona vain se, kuinka monta pistettä pelaajan on yhdellä heittovuorollaan saatava, jotta hän lopettaisi vuoronsa (sarake min. pst.). Sarakkeessa P1 on aloittajan voittofrekvenssi, ja sarakkeessa P2 puolestaan toisena tulevan pelaajan voittofrekvenssi.

    min. pst.  P1 (%)   P2 (%)
A.          1    50.0     50.0
B.          5    50.9     49.1
C.         10    52.3     47.7
D.         20    53.2     46.8

Pelaajan valitsema taktiikka siis näyttäisi vaikuttavan aloittajan todennäköisyyteen voittaa! Voisiko toisena tuleva pelaaja muuttaa tilannetta valitsemalla erilaisen taktiikan kuin aloittaja?

      min. P1  min. P2  P1 (%)   P2 (%)
E.         10      20     45.1     54.9

Ilmeisestikin toisena tulevalla pelaajalla on mahdollisuuksia vaikuttaa pelin lopputulokseen. Koska molemmilla pelaajilla on toki mahdollisuus muuttaa taktiikkaansa pelin edetessä, ei lopputulos ehkä ole ihan näin selvä, vaikka optimitilanteessa näin voisi ollakin.

Toinen helposti kuviteltava taktiikka olisi sellainen, jossa jälkimmäinen pelaaja jatkaa heittovuoroaan, kunnes on tietyn summan verran ensimmäistä pelaajaa edellä. Seuraavassa on testattu taktiikkaa, jossa jälkimmäinen pelaaj heittää noppia, kunnes johtaa aloittajaa vähintään kymmenellä pisteellä (lead P2). Tämäkin tasapainottaa pelaajien tilanteen:

      min. P1  min. P2  lead P2  P1 (%)   P2 (%)
F.         10      10        10    50.8     49.2

Käytännössä erot eri taktiikoiden ovat niin pieniä, etteivät ne näy kovin pienillä pelimäärillä, eivätkä useimmat pelaajat todennäköisesti koskaan kiinnitä niihin mitään huomiota. Olisi mielenkiintoista tutkia, löytyykö jokin järkevän oloinen, mutta täysin pöljä taktiikkaa, jossa pelaajien välinen ero korostuu edellä esitettyjä esimerkkejä enemmän.

Funktioiden koodi:

# Frequencies for the rolls
die<-c(
	rep("pink", 6288),
	rep("dot", 5486),
	rep("razorback", 3955),
	rep("trotter", 1574),
	rep("snouter", 544),
	rep("leaning jowler", 125),
	rep("oinker", 9)
)
 
# Scoring matrix
score.matrix<-matrix(ncol=7, nrow=7, data=NA)
colnames(score.matrix)<-c("pink", "dot", "razorback", "trotter", "snouter", "leaning jowler", "oinker")
rownames(score.matrix)<-c("pink", "dot", "razorback", "trotter", "snouter", "leaning jowler", "oinker")
score.matrix[1,]<-c(1,0,5,5,10,15,0)
score.matrix[2,]<-c(0,1,5,5,10,15,0)
score.matrix[3,]<-c(5,5,20,10,15,20,0)
score.matrix[4,]<-c(5,5,10,20,15,20,0)
score.matrix[5,]<-c(10,10,15,15,40,25,0)
score.matrix[6,]<-c(15,15,20,20,25,60,0)
score.matrix[7,]<-c(0,0,0,0,0,0,0)
 
# Essential die rolling and scoring functions
cast.die<-function() {
	die[sample(1:length(die), 1)]
}
 
cast<-function() {
	die1<-cast.die()
	die2<-cast.die()
	return(c(die1, die2))
}
 
scoring<-function(x) {
	score<-score.matrix[x[1], x[2]]
	return(score)
}
 
# Simulation using two computer player
# Options are:
# round cutoff = how many points one needs to get on a single round before stopping
# game cutoff  = when does the game end
# strategy     = the maximum (negative) difference to the other player before stopping the round
 
cpu.plays.pigs8<-function(cpu1.round.cutoff=1, cpu2.round.cutoff=1, cpu1.game.cutoff=100, cpu2.game.cutoff=100, cpu1.strategy=0, cpu2.strategy=0) {
cpu1.total.score<-0
cpu2.total.score<-0
b<-FALSE
for(i in 1:1000) {
#	cat(paste("Kierros ", i, "\n", sep=""))
	cpu1.round.score<-0
	if(cpu2.total.score-cpu1.total.score>cpu1.strategy) {
		cpu1.point.cutoff<-max(cpu1.round.cutoff, abs(cpu1.total.score-cpu2.total.score)+cpu1.strategy)
	} else {
		cpu1.point.cutoff<-cpu1.round.cutoff
	}
	while(cpu1.round.score<cpu1.point.cutoff & b==FALSE) {
		heitto<-cast()
		pisteet<-scoring(heitto)
#		cat(paste("CPU1 round score: ", pisteet, "\n", sep=""))
		if(sort(heitto)[1]=="dot" & sort(heitto)[2]=="pink") {
			cpu1.round.score<-0
			cpu1.point.cutoff<-(-1)
		} else {
			cpu1.round.score<-cpu1.round.score+pisteet
		}
		if(heitto[1]=="oinker" & heitto[2]=="oinker") {
			cpu1.round.score<-0
			cpu1.total.score<-0
		} 
	}
	cpu1.total.score<-cpu1.total.score+cpu1.round.score
#	cat(paste("CPU1 total score: ", cpu1.total.score, "\n", sep=""))
	if(cpu1.total.score>=100) {
		winner<-1
		cpu1.total.rounds<-i
		cpu2.total.rounds<-i-1
		b<-TRUE
	}
 
	cpu2.round.score<-0
	if(cpu1.total.score-cpu2.total.score>cpu2.strategy) {
		cpu2.point.cutoff<-max(cpu2.round.cutoff, abs(cpu2.total.score-cpu1.total.score)+cpu2.strategy)
	} else {
		cpu2.point.cutoff<-cpu2.round.cutoff
	}
	while(cpu2.round.score<cpu2.point.cutoff & b==FALSE) {
		heitto<-cast()
		pisteet<-scoring(heitto)
#		cat(paste("CPU2 round score: ", pisteet, "\n", sep=""))
		if(sort(heitto)[1]=="dot" & sort(heitto)[2]=="pink") {
			cpu2.round.score<-0
			cpu2.point.cutoff<-(-1)
		} else {
			cpu2.round.score<-cpu2.round.score+pisteet
		}
		if(heitto[1]=="oinker" & heitto[2]=="oinker") {
			cpu2.round.score<-0
			cpu2.total.score<-0
		} 
	}
	cpu2.total.score<-cpu2.total.score+cpu2.round.score
#	cat(paste("CPU2 total score: ", cpu2.total.score, "\n", sep=""))
	if(cpu2.total.score>=100) {
		winner<-2
		cpu1.total.rounds<-i
		cpu2.total.rounds<-i
		b<-TRUE
	}
#cat("\n\n")
if(b) {
	break()
	break()
}
}
d<-c(winner, cpu1.total.rounds, cpu1.total.score, cpu2.total.rounds, cpu2.total.score)
return(d)
}

Simulaatiokoodit:

# Keskimääräinen pistemäärä yhdellä heitolla
res<-replicate(100000, scoring(cast()))
barplot(table(res), beside=T, las=1, xlab="Heiton pistemäärä", border="grey50", col="grey50", axes=F)
abline(h=c(10,20,30,40)*1000, col="white", lwd=2)
mtext(side=2, at=c(0, 10,20,30,40)*1000, text=c(0, 10,20,30,40)*1000, las=1, line=-0.75)
mtext(side=2, at=45000, text="Lkm", las=1, line=-0.75)
 
 
# Pelisimulaatiot
 
# Aloittajalla etua?
s1<-replicate(10000, cpu.plays.pigs8(1, 1, 100, 100, 0, 0))  #A
s2<-replicate(10000, cpu.plays.pigs8(5, 5, 100, 100, 0, 0))  #B
s3<-replicate(10000, cpu.plays.pigs8(10, 10, 100, 100, 0, 0))#C
s4<-replicate(10000, cpu.plays.pigs8(20, 20, 100, 100, 0, 0))#D
table(s1[1,])
table(s2[1,])
table(s3[1,])
table(s4[1,])
 
# Toisen pelaajan vastine aloittajan etuun
s5<-replicate(10000, cpu.plays.pigs8(10, 20, 100, 100, 0, 0))#E
table(s5[1,])
 
# Toisen pelaajan vastine aloittajan etuun
s6<-replicate(10000, cpu.plays.pigs8(10, 10, 100, 100, 0, 10))#F
table(s6[1,])


Category