Tehtävä 1.

Heikki mittasi lepopulssiaan ja sai seuraavat tulokset: 67, 62, 58, 74, 65, 66, 63.
Määritä 95 % luottamusväli Heikin keskimääräiselle lepopulssille.

pulssimittaus <- c(67,62,58,74,65,66,63)
pulssimittaus
# [1] 67 62 58 74 65 66 63
todennakoisyys = 0.95
pulssikeskiarvo <- round(mean(pulssimittaus), 2) #pyöristys 2 desimaalin tarkkuudella
pulssikeskiarvo
# [1] 65
pulssihajonta <- sqrt(mean(pulssimittaus^2) - mean(pulssimittaus)^2)
pulssihajonta <- round(pulssihajonta, 2)
pulssihajonta
# [1] 4.6
luottamusvali <- function(sampleMean, standardDeviation, sampleCount, confidenceLevel) {
  x <- 1-(1-confidenceLevel/100)/2  
  error <- qt(x, df=sampleCount-1)*standardDeviation/sqrt(sampleCount)  
  left <- sampleMean - error  
  right <- sampleMean + error  
  return(round(c(left, right), 2))  
  }  
luottorajat <- luottamusvali(mean(pulssikeskiarvo), pulssihajonta, 7, 95)  
round(((luottorajat[2]-luottorajat[1])/2), 2)  
# [1] 4.25
round(luottorajat[1], 2) #otoskeskiarvo miinus marginaali, alapään luottoraja
# [1] 60.75
round(luottorajat[2], 2) #otoskeskiarvo plus marginaali, yläpään luottoraja
# [1] 69.25

Vastaus tehtävään 1:
Heikin keskimääräinen lepopulssi osuu 95% varmuudella välille 60,75…69,25 bpm.


Tehtävä 2.

Estimoitaessa normaalisti N(\(\mu\) ; 2,2) jakautuneen satunnaissuureen odotusarvo, otetaan n kpl:n otos. Kuinka suuri otos on valittava, että \(\mu\):n 99 %:n luottamusvälin pituus ei ole suurempi kuin 1,5?

otoskoko <- function(error, standardDeviation) {
  n <- qnorm(0.995)^2 * standardDeviation^2 / error^2
  return(n)
}
round(otoskoko(0.75, 2.2), 0)
# [1] 57

Vastaus tehtävään 2:
Otoskoon on oltava vähintään 57 kpl.


Tehtävä 3.

Internetgallupissa kysyttiin 1500 suomalaiselta, onko heillä ilmalämpöpumppua. Ilmalämpöpumpun sanoi omistavansa 52.9 %. Määritä 95 %:n luottamusväli ilmalämpöpumpun omistavien suhteelliselle osuudelle.

library(Hmisc)
#Binomijakauman luottamusväli (prosenttiosuuden luottamusväli)
round(binconf((52.9/100*1500), 1500, alpha = 0.05), 3)
#  PointEst Lower Upper
#     0.529 0.504 0.554

Vastaus tehtävään 3:
95% varmuudella ilmalämpöpumpun omistaa 52,9% +- 2,5% suomalaisista.


Tehtävä 4.

Otoksesta, jonka koko on a) 35 b) 100, saadaan otoskeskiarvoksi 168.1 cm. Perusjoukon keskihajonta on \(\sigma\)=10,0 cm. Testaa, poikkeaako \(\mu\) arvosta 172 tilastollisesti.

#Data ja analyysi.pdf: "z-testiä käytetään, kun perusjoukon keskihajonta tunnetaan 
#ja otoskoko on yli 30"

#a)
#Hypoteesit:
#H0 -> Ei poikkea tilastollisesti.
#H1 -> Poikkeaa tilastollisesti.

z.testi <- function(keskiarvo, n, mu, sd) {
  zeta <- (keskiarvo - mu) / (sd/sqrt(n))
  return(zeta)
}
z4a <- z.testi(168.1, 35, 172, 10)
z4a
# [1] -2.307271
tarkka_parvo_t4a <- pnorm(z4a, lower.tail = TRUE)
tarkka_parvo_t4a
# [1] 0.01051986
round(tarkka_parvo_t4a, 3)
# [1] 0.011

Vastaus tehtävään 4 a):
Keskiarvo poikkeaa tilastollisesti lähes merkitsevästi. Vaihtoehtoinen hypoteesi voidaan ottaa käyttöön mikäli 1,1%:n riski voidaan hyväksyä.

#b)
#Hypoteesit:
#H0 -> Ei poikkea tilastollisesti.
#H1 -> Poikkeaa tilastollisesti.

z.testi <- function(keskiarvo, n, mu, sd) {
  zeta <- (keskiarvo - mu) / (sd/sqrt(n))
  return(zeta)
}
z4b <- z.testi(168.1, 100, 172, 10)
z4b
# [1] -3.9
tarkka_parvo_t4b <- pnorm(z4b, lower.tail = TRUE)
tarkka_parvo_t4b
# [1] 4.809634e-05
#0,00004809634 "prosentin 5 tuhannesosaa."

Vastaus tehtävään 4 b):
keskiarvo poikkeaa tilastollisesti erittäin merkitsevästi ja nollahypoteesi on hylättävä.


Tehtävä 5.

Suklaakonvehtirasian sisällön painoksi ilmoitetaan 300 g. Tuotannon luotettavuutta testattiin 20 rasian otoksella. Otoksen keskiarvo oli 295 g ja keskihajonta 7,8 g. Testaa kaksisuuntaisella testillä 5 %:n riskitasolla voidaanko luottaa siihen, että rasioiden keskipaino on 300 g.

t.testi <- function(keskiarvo, n, mu, sd){
  tee <- (keskiarvo - mu) / (sd / sqrt(n))
  return(tee)
}
t5 <- t.testi(295, 20, 300, 7.8)
t5
# [1] -2.866754
p_arvo_t5 <- 2*pt(-abs(t5), df = 20 - 1)
p_arvo_t5
# [1] 0.009873326
round(p_arvo_t5, 2)
# [1] 0.01

Vastaus tehtävään 5:
Koska p:n arvo on 0,01 eli < 0,05 hylätään nollahypoteesi. Toisin sanoen ei voida luottaa 5% riskillä, että rasioiden keskipaino olisi 300g.


Tehtävä 6.

Empaattisuutta käsittelevässä tutkimuksessa tyttöjen ja poikien saamat pistemäärät olivat seuraavat:

Tytöt 52 56 56 58 60 62 68 74
Pojat 60 58 56 54 52 50 48 46

Selvitä kaksisuuntaisella testillä, onko tyttöjen ja poikien keskiarvoissa eroa.

#H0 -> Keskiarvoissa ei ole eroa.
#H1 -> Keskiarvoissa on eroa.

tytot <- c(52, 56, 56, 58, 60, 62, 68, 74)
pojat <- c(60, 58, 56, 54, 52, 50, 48, 46)
tytot
# [1] 52 56 56 58 60 62 68 74
pojat
# [1] 60 58 56 54 52 50 48 46
#Tehdään F-testi, jotta saadaan selville onko otosten hajonnat riittävän samankaltaiset 
#T-testin tekemistä varten (edellytys).

var.test(tytot,pojat)
# 
#   F test to compare two variances
# 
# data:  tytot and pojat
# F = 2.1399, num df = 7, denom df = 7, p-value = 0.3369
# alternative hypothesis: true ratio of variances is not equal to 1
# 95 percent confidence interval:
#   0.4284124 10.6885111
# sample estimates:
# ratio of variances 
#           2.139881
#P-arvo on > 0,05, joten tyttöjen ja poikien empatiamittausten hajonnassa ei ole 
#merkitsevää eroa. Voidaan suorittaa T-testi.

t.test(tytot, pojat, var.equal = TRUE, paired = FALSE, alternative = 'two.sided')
# 
#   Two Sample t-test
# 
# data:  tytot and pojat
# t = 2.5251, df = 14, p-value = 0.02426
# alternative hypothesis: true difference in means is not equal to 0
# 95 percent confidence interval:
#   1.167342 14.332658
# sample estimates:
# mean of x mean of y 
#     60.75     53.00

Vastaus tehtävään 6:
2,4%:n riskillä voidaan hylätä nollahypoteesi. Keskiarvot poikkeavat toisistaan.

#Sidenote:
#Näköjään tämä R:n t.test kertoo millä riskillä H1 voidaan ottaa käyttöön. 
#Jos vertailuun laittaa samat mittaustulokset x:lle ja y:lle (esim. tytöt x 2), 
#niin riskiksi tulee 100% P:n arvolla 1.

Tehtävä 7.

Testaa 5 % riskillä, noudattavatko linja-autojen kulkuajat tasaista jakaumaa. Tätä varten laskettiin tunnin aikana havaintopisteen ohittavat linja-autot ja saatiin seuraava empiirinen jakauma:

Tunnin neljännes 1 2 3 4
Autojen lukumäärä 6 15 9 18
autojen_lukumaara <- c(6, 15, 9, 18)
autojen_lukumaara
# [1]  6 15  9 18
varttitunti <- c(1/4, 1/4, 1/4, 1/4)
varttitunti
# [1] 0.25 0.25 0.25 0.25
chisq.test(autojen_lukumaara, p = varttitunti)
# 
#   Chi-squared test for given probabilities
# 
# data:  autojen_lukumaara
# X-squared = 7.5, df = 3, p-value = 0.05756

vastaus tehtävään 7:
5%:n riskillä nollahypoteesi jää voimaan, eli linja-autojen kulkuajat noudattavat tasaista jakaumaa.


Tehtävä 8.

Väitettiin, että pojat ovat enemmän poissa koulusta kuin tytöt. Asiaa selvitettiin valitsemalla umpimähkään 50 pojan ja 75 tytön otos. Pojista 14 ja tytöistä 13 oli ollut poissa koulusta edellisen kuukauden aikana. Testaa väite 5%:n riskitasolla.

#Koska vertailutestissä käytetään nollahypoteesinä vertailuarvojen yhdenmukaisuutta;
#H0 -> poissaolojen määrä on tilastollisesti tarkasteltuna sukupuoliriippumatonta.
#H1 -> sukupuolella on tilastollista merkitsevyyttä poissaolojen määrään.

#Tarkastellaan ensin poikia ja tyttöjä itsenäisinä ryhminä 5%:n riskitasolla...

pojat_t8 <- binconf(14, 50, alpha = 0.05)
round(pojat_t8, 2)
#  PointEst Lower Upper
#      0.28  0.17  0.42
#Pojista 17%...42% lintsaavat 95% luottamustasolla. Näyte on liian pieni, 
#jotta ennuste olisi tarkempi.

tytot_t8 <- binconf(13, 75, 0.05)
round(tytot_t8, 2)
#  PointEst Lower Upper
#      0.17   0.1  0.27
#Tytöistä 10%...27% lintsaavat 95% luottamustasolla. Näyte on liian pieni, 
#jotta ennuste olisi tarkempi.
#Näistä kuitenkin nähdään että ennusteiden osuuksissa on päällekäisyyttä. 
#Tehdään näytteiden suhteita vertaileva z-testi jatkuvuuskorjauksella.

keskinainen_suhde <- prop.test(x = c(14, 13), n = c(50, 75))
keskinainen_suhde
# 
#   2-sample test for equality of proportions with continuity
#   correction
# 
# data:  c(14, 13) out of c(50, 75)
# X-squared = 1.4349, df = 1, p-value = 0.231
# alternative hypothesis: two.sided
# 95 percent confidence interval:
#  -0.06108918  0.27442251
# sample estimates:
#    prop 1    prop 2 
# 0.2800000 0.1733333

vastaus tehtävään 8:
Hylättäessä nollahypoteesi otetaan 23%:n riski, joten 5%:n riskillä nollahypoteesi jää voimaan ja poissaolojen määrä on riippumaton sukupuolesta.

Ratkaisumetodin lähde: http://www.sthda.com/english/wiki/two-proportions-z-test-in-r

Tarkistus (koska tarvitsin varmistusta tähän, sillä en ollut aluksi lainkaan varma tuloksesta):
Testasin vaihtoehtoista hypoteesiä siten, että pojat lintsaavat enemmän (greater) tai
vähemmän (less). Väitteellä, että pojat lintsaavat enemmän otetaan 11,6%:n riski hylättäessä
nollahypoteesi ja väittämällä poikien lintsaavan vähemmän otetaan vastakkainen 88,5%:n riski.
Ts. jos olisi vähäisestä otannasta ja tilastollisesti huomattavasta riskistä huolimatta pakko
veikata jompaa kumpaa olisi veikattava sitä, että pojat lintsaavat enemmän.

Testasin tätä tulosta vielä lisäämällä nollat sekä otantohin että poissaolomääriin
(kymmenkertaistus), jolloin suhteet säilyivät samoina, mutta tilaston luotettavuus parani siten,
että tuloksen mukaan nollahypoteesi tulisi hylätä tilastollisesti merkitsemättömällä riskillä
ja siten pojat lintsaavat enemmän kuin tytöt.

keskinainen_suhde_g <- prop.test(x = c(14, 13), n = c(50, 75), alternative = 'greater')
keskinainen_suhde_g #vaihtoehtoinen hypoteesi = pojat lintsaavat enemmän
# 
#   2-sample test for equality of proportions with continuity
#   correction
# 
# data:  c(14, 13) out of c(50, 75)
# X-squared = 1.4349, df = 1, p-value = 0.1155
# alternative hypothesis: greater
# 95 percent confidence interval:
#  -0.03679804  1.00000000
# sample estimates:
#    prop 1    prop 2 
# 0.2800000 0.1733333
#p-arvo: 0,1155 ~ 11,6% riski.  

keskinainen_suhde_l <- prop.test(x = c(14, 13), n = c(50, 75), alternative = 'less')
keskinainen_suhde_l #vaihtoehtoinen hypoteesi = pojat lintsaavat vähemmän
# 
#   2-sample test for equality of proportions with continuity
#   correction
# 
# data:  c(14, 13) out of c(50, 75)
# X-squared = 1.4349, df = 1, p-value = 0.8845
# alternative hypothesis: less
# 95 percent confidence interval:
#  -1.0000000  0.2501314
# sample estimates:
#    prop 1    prop 2 
# 0.2800000 0.1733333
#p-arvo: 0,8845 ~ 11,5% riski.  

keskinainen_suhde_n10x <- prop.test(x = c(140, 130), n = c(500, 750))
keskinainen_suhde_n10x #Kymmenkertaistus
# 
#   2-sample test for equality of proportions with continuity
#   correction
# 
# data:  c(140, 130) out of c(500, 750)
# X-squared = 19.531, df = 1, p-value = 9.897e-06
# alternative hypothesis: two.sided
# 95 percent confidence interval:
#  0.05722141 0.15611193
# sample estimates:
#    prop 1    prop 2 
# 0.2800000 0.1733333
#p-arvo: 0,000009897 < 0,001 ts. tulos on erittäin merkitsevä ja riski on ns. "olematon".