R-ohjelmointi.org

Tilastotieteellistä ohjelmointia R-kielellä

Onko paksu nuoliputki parempi kuin ohut?

Jousiammunnassa keskustellaan aika ajoin siitä, onko parempi käyttää paksua nuoliputkea vai ohutta. Keskeinen argumentti on, että paksulla nuoliputkella saa keskimäärin hieman enemmän pisteitä. Tämän uskotaan johtuvan siitä, että paksu nuoliputki koskee taulun renkaiden rajaa hieman useammin kuin ohut. Mikäli nuoliputki koskettaa kahta väriä tai mitä tahansa kahden pistevyöhykkeen rajaviivaa, merkitään tulokseen arvoksi vyöhykkeistä suurempi. Toisin sanoen, jos paksulla nuoliputkella saa useammin osumia pistevyöhykkeiden rajoille, saa niillä myös ohuempia nuoliputkia enemmän pisteitä, jos kaikki muut seikat pysyvät samoina. Tätä ajatusta on varmasti helpoin tutkia simulaatiolla, joskin voisi ajatella, että vastauksen saisi myös analyyttisellä ratkaisulla.

Tutkin aiempia huippuampujien tuloksia, ja niistä voi melko helposti päätellä, että keskimääräinen keskihajonta taulun keskikohdasta mitattuna on esimerkiksi 18 m matkalta ammuttaesaa 40 cm:n tauluun vain noin 8,5 mm. FITA-sääntöjen mukaisesti suurin sallittu putken ulkohalkaisija on 9,3 mm, ja miesten ammunnassa ohuin samanlaiselle jouselle soveltuva nuoliputki on halkaisijaltaan noin 5,5-6,0 mm. 18 metrin kierroksella ammutaan yhteensä 60 nuolta. Tämä riittääkin simulaation pohjaksi.

Pilkoin simulaatiokoodin kolmeen osaan. Ensimmäinen funktion plotTarget() piirtää taulun:

plotTarget<-function(size="40cm", relative=TRUE, visualize=TRUE) {
   if(size=="40cm") {
      expansion<-1
   }
   if(size=="60cm") {
      expansion<-1.5
   }
   if(size=="80cm") {
      expansion<-2
   }
   if(size=="122cm") {
      expansion<-3.05
   }
   library(plotrix)
   if(visualize) {
      if(relative) {
            plot(x=0, y=0, xlim=c(-65,65), ylim=c(-65,65), type="n", axes=F, xlab="", ylab="")
      } else {
         plot(x=0, y=0, xlim=c(-21*expansion,21*expansion), ylim=c(-21*expansion,21*expansion), type="n", axes=F, xlab="", ylab="")
      }
      draw.circle(0,0,20*expansion, col="white")
      draw.circle(0,0,18*expansion, col="white")
      draw.circle(0,0,16*expansion, col="black")
      draw.circle(0,0,14*expansion, col="black", border="white")
      draw.circle(0,0,12*expansion, col="blue")
      draw.circle(0,0,10*expansion, col="blue")
      draw.circle(0,0,8*expansion, col="red")
      draw.circle(0,0,6*expansion, col="red")
      draw.circle(0,0,4*expansion, col="gold")
      draw.circle(0,0,2*expansion, col="gold")
   }
   target<-list(size, expansion)
   target
}

Toinen funktion, plotArrows(), simuloi nuolten osumat:

plotArrows<-function(mx=0, my=0, sdx=3, sdy=3, arrow.diag=0.93, arrow.n=30, visualize=TRUE, dist="norm") {
   library(plotrix)
   if(dist=="norm") {
      x<-rnorm(arrow.n, mx, sdx)
      y<-rnorm(arrow.n, my, sdy)
   }
   if(dist=="exp") {
      x<-rexp(arrow.n, sdx)
      y<-rexp(arrow.n, sdy)
   }
   if(dist=="gamma") {
      x<-rgamma(arrow.n, mx, sdx)
      y<-rgamma(arrow.n, my, sdy)
   }
   if(visualize==TRUE) {
      for(i in 1:arrow.n) {
         draw.circle(x[i], y[i], arrow.diag/2, col="grey50")
      }
   }
   arrow<-list(x, y, arrow.diag)
   arrow
}

Ja lopuksi kolmas funktio, scoreArrows(), laskee pistemäärän:

scoreArrows<-function(target, arrow) {
   d<-sqrt(arrow[[1]]^2+arrow[[2]]^2)-arrow[[3]]/2
   p<-rep(NA, length(d))
   for(i in 1:length(d)) {
      if(d[i]<=2*target[[2]]) {
         p[i]<-10
      }
      if(d[i]>2*target[[2]] & d[i]<=4*target[[2]]) {
         p[i]<-9
      }
      if(d[i]>4*target[[2]] & d[i]<=6*target[[2]]) {
         p[i]<-8
      }
      if(d[i]>6*target[[2]] & d[i]<=8*target[[2]]) {
         p[i]<-7
      }
      if(d[i]>8*target[[2]] & d[i]<=10*target[[2]]) {
         p[i]<-6
      }
      if(d[i]>10*target[[2]] & d[i]<=12*target[[2]]) {
         p[i]<-5
      }
      if(d[i]>12*target[[2]] & d[i]<=14*target[[2]]) {
         p[i]<-4
      }
      if(d[i]>14*target[[2]] & d[i]<=16*target[[2]]) {
         p[i]<-3
      }
      if(d[i]>16*target[[2]] & d[i]<=18*target[[2]]) {
         p[i]<-2
      }
      if(d[i]>18*target[[2]] & d[i]<=20*target[[2]]) {
         p[i]<-1
      }
      if(d[i]>20*target[[2]]) {
         p[i]<-0
      }
   }
   scoring<-list(d, p)
   scoring
}
</p>

Seuraava koodi simuloi 1000 kierrosta, ja tallentaa niiden tulokset objektiin m. Kullakin kierroksella arvotaan nuolen paikat yhden kerran, mutta niiden tulokset lasketaan sekä paksulla (9.3 mm) että ohuella (6.0 mm) nuoliputkella.

m<-matrix(ncol=2, nrow=1000)
for(i in 1:1000) {
   tar<-plotTarget(visualize=FALSE)
   arr1<-plotArrows(arrow.n=60, sdx=0.85, sdy=0.85, visualize=FALSE, arrow.diag=0.93, dist="norm")
   arr2<-arr1
   arr2[[3]]<-0.60
   sco1<-scoreArrows(tar, arr1)
   sco2<-scoreArrows(tar, arr2)
   m[i,1]<-sum(sco1[[2]])
   m[i,2]<-sum(sco2[[2]])
}

Simulaatioiden valmistuttua, voidaan laskea keskimääräinen etu paksun nuoliputken käytöstä:

mean(m[,1]-m[,2])
[1] 0.6484
median(m[,1]-m[,2])
[1] 0
table(m[,1]-m[,2])
 
   0    1    2    3    4    5    6 
5269 3331 1114  227   52    6    1

Eli keskimääräinen piste-ero yhtä 60 nuolen kierrosta kohden on alle yksi piste, mutta maailman huipulla tuolla yhdelläkin pisteellä voi olla suuri merkitys. Sama analyysi voidaan toki toistaa myös sunnuntaiampujan tuloksia (sd = 4 cm) käyttäen. Tällöin tulos näyttää seuraavalta:

mean(m[,1]-m[,2])
[1] 4.7104
 
median(m[,1]-m[,2])
[1] 5
 
table(m[,1]-m[,2])
 
 0    1    2    3    4    5    6    7    8    9   10   11   12   13   14   15 
62  403  926 1638 1892 1783 1369  952  522  234  152   47   12    4    1    3

Sunnuntaiampujan tuloksissa ero on suhteessa vieläkin suurempi siksi, että hajonta on isompaa kuin huippuampujalla, ja nuolella on mahdollisuus osua useampien renkaiden rajalle. Miksi sitten kaikki eivät käytä mahdollisimman paksua putkea? Siihen on useitakin syitä, mm. se että nuoliputki pitää sovittaa sekä jouseen että ampujaan, eikä aina löydy sopivaa hyvin paksua putkea. Ulkona ammuttessa paksuun putkeen ottaa myös phemmin tuuli kuin ohueen putkeen.

Seuraava koodi esittelee vielä erilaisia ampujatyyppejä ja heidän keskihajontojaan. Keksin nimitykset omasta päästäni eivätkä ne välttämättä edusta yleistä käsitystä. Koodi tuottaa myös alta löytyvän kuvan, johon tulokset on visualisoitu.

par(mfrow=c(2,2), mar=c(1,1,1,1))
tar<-plotTarget(visualize=TRUE, relative=FALSE)
arr1<-plotArrows(arrow.n=60, sdx=0.85, sdy=0.85, visualize=TRUE, arrow.diag=0.93, dist="norm")
title(main="Huippuampuja")
 
tar<-plotTarget(visualize=TRUE, relative=FALSE)
arr1<-plotArrows(arrow.n=60, sdx=2, sdy=2, visualize=TRUE, arrow.diag=0.93, dist="norm")
title(main="Hyvä ampuja")
 
tar<-plotTarget(visualize=TRUE, relative=FALSE)
arr1<-plotArrows(arrow.n=60, sdx=4, sdy=4, visualize=TRUE, arrow.diag=0.93, dist="norm")
title(main="Sunnuntaiampuja")
 
tar<-plotTarget(visualize=TRUE, relative=FALSE)
arr1<-plotArrows(arrow.n=60, sdx=8, sdy=8, visualize=TRUE, arrow.diag=0.93, dist="norm")
title(main="Aloittelija")


Vastaa

Sähköpostiosoitettasi ei julkaista. Pakolliset kentät on merkitty *