clt255: Kieliteknologian tilastomenetelmät - syksy 2007
Kotitentti (julkaistu 29.11.2007 klo 12:00)
HyClt255s2007homeExam
Kurssityöt
Kurssin loppupuolella (Periodi 2) pidetään esityksiä (suullinen ja kirjallinen esitys) työryhmissä tai itsenäisesti tehdyistä töistä. Tämä korvaa kurssin lopputentin.
Aikataulu
pvm |
agenda |
8.11. |
Esimerkkitestejä, esim. ANOVA |
15.11. |
Kertausta, projektityöskentelyä |
22.11. |
Projektityöskentelyä, esityksiä? |
29.11. |
Esitykset, kotitentti jaetaan |
13.12. |
Kotitentin deadline*, *kirjallisten työraporttien palautus |
Ehdotuksia töiden aiheiksi
- Automaattinen PDF-raportin generointi korpus- tai frekvenssidatasyötteestä
- Raportti omasta lingvistisestä tilastollisesta analyysista
- "Yksi data, monta visualisointia"
- Tutkimussuunnitelman selvitys tilastollisista analyyseista + mahdollisia esimerkkiajoja
- R-portfolio, jossa tiivistettynä itse tehdyn tilastoanalyysin vaiheet + esimerkkejä
Ehdotuksia lähdemateriaaliksi
3. Istunnon mallit
# ESIMERKKI 1: SANAPITUUDET
> read.table("http://www.ling.helsinki.fi/~anyrkko/Rplot/sanapituudet.txt",header=T) -> data
> data
len
1 12
2 11
... # tulikin 1-sarakkeinen taulu
> data$len->pit
> pit
[1] 12 11 11 9 11 10 8 2 17 5 10 2 18 15 4 13 5 4 8 5 7 20 10 11 8
[26] 9 11 10 11 14 11 4 6 14 9 4 22 10 7 21 15 9 5 18 17 22 7 7 9 5
[51] 9 2 11 9 4 22 5 5 7 8 12 2 8 11 9 9 10 7 10 9 2 10 11 7 6
[76] 11 7 10 18 12 2 8 8 2 9 10 16 2 11 11 9 6 11 16 2 2 4 4 8 5
[101] 9 5 11 8 11 13 2 11 3 6 4 7 4 9 16 7 8 14 14 6 10 18 8 10 2
[126] 16 6 6 1 5 11 12 5 11 6 3 7 11 21 5 10 3 4 8 6 3 4 11 9 17
[151] 5 14 10 12 8 4 10 18 2 10 23 9 2 11 4 2 3 6 4 3 2 14 15 3 5
[176] 13 9 17 3 13 6 22 16 8 21 7 19 8 5 6 14 23 13 7 16 2 6 5 8 6
[201] 13 5 18 6 23 12 7 9
> hist(pit)
> range(pit)
[1] 1 23
> hist(pit,breaks=0:23)
> truehist(pit) # MASS-kirjaston funtktio
Error: could not find function "truehist"
> library(MASS)
> truehist(pit) # nyt toimii, tulee värikäs plottaus
> hist(pit,breaks=0:23)->h
# hist() tuottaa grafiikan lisäksi myös data framen:
> h
> read.table("http://www.ling.helsinki.fi/~anyrkko/Rplot/sanaluokka.txt", header=T) -> luokka
> luokka
n pos
1 7 A
2 14 ADV
3 101 N
4 7 NUM
5 8 PRON
6 46 V
> plot(luokka)
# kiinnitetään data frame jotta voidaan käyttää suoraan sen sarakkeita nimillä
> attach(luokka)
> barplot(n,names=pos)
# tehdään sama tiedostoon
> jpeg("posbar.jpg",width=400,height=300)
> barplot(n,names=pos)
> dev.off()
# Värien käyttö:
> barplot(n,names=pos,legend.text=pos,col=c("WHITE","BLACK","BLUE","YELLOW","RED","ORANGE"))
# lopuksi irroitetaan data frame
> detach(luokka)
# ESIMERKKI 2: Sanaluokka ja sanapituus
> read.table("http://www.ling.helsinki.fi/~anyrkko/Rplot/pospit.txt",header=T)->pospit
> pospit
pos len
1 A 11
2 A 11
3 A 14
4 A 10
5 A 5
6 A 12
7 A 14
8 ADV 11
9 ADV 11
10 ADV 8
...
> summary(pospit)
pos len
A : 7 Min. : 2.000
ADV : 3 1st Qu.: 6.000
N :101 Median : 9.000
NUM : 7 Mean : 9.843
PRON: 8 3rd Qu.:12.250
V : 46 Max. :23.000
> plot(pospit)
> attach(pospit)
> tapply(len,pos,mean)
A ADV N NUM PRON V
11.000000 10.000000 12.148515 4.428571 4.375000 6.369565
# Sanapituuksien kvantiilit sanaluokittain
> tapply(pospit$len,pospit$pos,quantile)
$A
0% 25% 50% 75% 100%
5.0 10.5 11.0 13.0 14.0
$ADV
0% 25% 50% 75% 100%
8.0 9.5 11.0 11.0 11.0
$N
0% 25% 50% 75% 100%
4 8 11 16 23
$NUM
0% 25% 50% 75% 100%
2.0 2.0 3.0 6.5 9.0
$PRON
0% 25% 50% 75% 100%
2.00 3.75 4.50 5.25 6.00
$V
0% 25% 50% 75% 100%
2.00 3.25 6.00 9.00 14.00
> detach(pospit)
# ESIMERKKI 3: SANALUOKKA, SANAPITUUS JA FREKVENSSI
> read.table("http://www.ling.helsinki.fi/~anyrkko/Rplot/pospitfrekv.txt")->ppf
> ppf
V1 V2 V3
1 pos len n
2 A 10 1
3 A 11 2
4 A 12 1
5 A 14 2
...
> attach(ppf)
Tulostetaan sama data tiiviinä (tässä mean-funktion käyttö on turhaa)
> tapply(n,list(pos,len),mean)
2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23
A NA NA NA 1 NA NA NA NA 1 2 1 NA 2 NA NA NA NA NA NA NA NA NA
ADV NA NA NA NA NA NA 1 NA NA 2 NA NA NA NA NA NA NA NA NA NA NA NA
N NA NA 1 3 6 8 9 10 10 10 5 4 4 3 6 4 6 1 1 3 4 3
NUM 3 1 1 NA NA NA NA 2 NA NA NA NA NA NA NA NA NA NA NA NA NA NA
PRON 1 1 2 2 2 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
V 8 4 3 6 3 4 5 4 3 4 NA 1 1 NA NA NA NA NA NA NA NA NA
# Sanapituuksien frekvenssit - Frequency of word lengths (summataan kaikista sanaluokista):
> tapply(n,list(len),sum)->fol
> fol
2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23
12 6 7 12 11 12 15 16 14 18 6 5 7 3 6 4 6 1 1 3 4 3
> barplot(fol)
> detach(ppf)
# VINKKI 3. ISTUNNON KOTITEHTÄVÄN TEKEMISTÄ VARTEN
> read.table("http://www.ling.helsinki.fi/~anyrkko/Rplot/perusmuodot.txt",header=T)
n lemma
1 3 aikaisemmin
2 2 aikoa
3 1 asia
4 1 budjetti
5 1 budjetti
> read.table("http://www.ling.helsinki.fi/~anyrkko/Rplot/perusmuodot.txt",header=T)->f
# Järjestetään yleisyyden mukaan:
> f[order(f$n),]
n lemma
3 1 asia
4 1 budjetti
5 1 budjetti
6 1 budjetti
...
12 4 ei
90 4 se
126 5 veikkaus
17 6 että
20 6 hallitus
10 8 edus
24 8 ja
73 10 olla
# Tallennetaan tämä sortatuksi data frameksi "sd".
# Lisätään rank-sarake:
> 1:134->sd$rank
# Ja sitten plottailemaan.
5. istunto
> read.table("http://www.ling.helsinki.fi/~anyrkko/Rmacbeth/Macbeth_lemmas.txt")->lemmas
> cut(1:4101,breaks=41,labels=F)->lemmas$chunk
> lemmas$V1->l
> lemmas$the<-(l=="the")
> lemmas$king<-(l=="king")
> lemmas$have<-(l=="have")
> countThe = tapply(lemmas$the,lemmas$chunk,sum)
> countHave = tapply(lemmas$have,lemmas$chunk,sum)
> countKing = tapply(lemmas$king,lemmas$chunk,sum)
6. istunto
Kappale 3, tehtävä 2: (Sanojen määrä kussakin pätkässä)
> plot(countHave,type="h")
> plot(countThe,type="h")
> plot(countKing,type="h")
(h = high density line)
Kappale 3, tehtävä 3: (Pätkien lukumäärä, joissa n kpl sanan esiintymiä)
> plot(xtabs(~countHave))
> plot(xtabs(~countThe))
> plot(xtabs(~countKing))
Kappale 3, tehtävä 4: (Suhteutetaan edellinen tulos ja plotataan lisäksi teoreettinen Poisson-jakauma)
> lambdaThe=sum(lemmas$the==TRUE)/max(lemmas$chunk)
> lambdaHave=sum(lemmas$have==TRUE)/max(lemmas$chunk)
> lambdaKing=sum(lemmas$king==TRUE)/max(lemmas$chunk)
> lambdaThe
[1] 4.170732
> lambdaHave
[1] 2.439024
> lambdaKing
[1] 0.4146341
> plot(xtabs(~countThe)/41)
> lines(0:9,dpois(0:9,lambdaThe))
> plot(xtabs(~countHave)/41)
> lines(0:11,dpois(0:11,lambdaHave))
> plot(xtabs(~countKing)/41)
> lines(0:3,dpois(0:3,lambdaKing))
Kappale 3, tehtävä 5: (Tarkastele graafisesti teoreettisten (Poisson) ja toteutuneiden kvantiilien suhdetta.)
> q=(1:19)*.05
> plot(qpois(q,lambdaThe),quantile(countThe,q),type="o")
> plot(qpois(q,lambdaHave),quantile(countHave,q),type="o")
> plot(qpois(q,lambdaKing),quantile(countKing,q),type="o")
8. istunto
read.table("http://www.ling.helsinki.fi/~anyrkko/Rplot/sanapituudet.txt",header=T) -> data
attach(data)
xtabs(~len)
plot(xtabs(~len))
lines(1:23,100*dpois(1:23,mean(len)))
lines(1:23,100*dnorm(1:23,mean(len),sd(len)))
> ks.test(jitter(len),"pnorm",mean=mean(len),sd=sd(len))
One-sample Kolmogorov-Smirnov test
data: jitter(len)
D = 0.1061, p-value = 0.0185
alternative hypothesis: two-sided
> ks.test(jitter(len),"ppois",lambda=mean(len))
One-sample Kolmogorov-Smirnov test
data: jitter(len)
D = 0.2059, p-value = 4.372e-08
alternative hypothesis: two-sided
> detach(data)
...
read.table("http://www.ling.helsinki.fi/~anyrkko/Rplot/pospit.txt",header=T)->pospit
attach(pospit)
> tapply(len,list(pos),summary)
len[pos=="PRON"] -> pronlen
len[pos=="V"] -> vlen
len[pos=="NUM"] -> numlen
len[pos=="N"] -> nlen
len[pos=="ADV"] -> advlen
len[pos=="A"] -> alen
plot(pospit)
t.test(nlen,vlen)
...
> anova(lm(len~pos))
Analysis of Variance Table
Response: len
Df Sum Sq Mean Sq F value Pr(>F)
pos 5 1545.68 309.14 16.442 3.626e-13 ***
Residuals 166 3121.08 18.80
---
Signif. codes: 0 ?***? 0.001 ?**? 0.01 ?*? 0.05 ?.? 0.1 ? ? 1
> anova(lm(len~pos=="PRON"))
Analysis of Variance Table
Response: len
Df Sum Sq Mean Sq F value Pr(>F)
pos == "PRON" 1 250.9 250.9 9.6575 0.002211 **
Residuals 170 4415.9 26.0
---
Signif. codes: 0 ?***? 0.001 ?**? 0.01 ?*? 0.05 ?.? 0.1 ? ? 1
> detach(pospit)
...
> read.table("http://www.ling.helsinki.fi/~anyrkko/Rmacbeth/Macbeth_data.txt",header=T)->macbeth
> attach(macbeth)
> plot(macbeth)
> plot(pos,len)
> xtabs(~pos)
> N<-(pos=="N")+0
> V<-(pos=="V")+0
> xtabs(~len[V==1])
len[V == 1]
2 3 4 5 6 7 8 9 10
153 80 315 144 52 33 17 4 3
> xtabs(~len[N==1])
len[N == 1]
3 4 5 6 7 8 9 10 11 12 13 14 15 16 18
88 222 195 155 173 57 38 21 9 9 2 2 1 1 3
> plot(xtabs(~len[N==1]))
> lines(xtabs(~len[V==1]))
> anova(lm(len~V+N))
Analysis of Variance Table
Response: len
Df Sum Sq Mean Sq F value Pr(>F)
V 1 0.01704 0.01704 0.0054 0.9416
N 1 3871.9 3871.9 1218.4148 <2e-16 ***
Residuals 4098 13022.5 3.2
---
Signif. codes: 0 ?***? 0.001 ?**? 0.01 ?*? 0.05 ?.? 0.1 ? ? 1
> anova(lm(len~PL+SG))
Analysis of Variance Table
Response: len
Df Sum Sq Mean Sq F value Pr(>F)
PL 1 18.5 18.5 4.4866 0.03422 *
SG 1 9.5 9.5 2.3169 0.12805
Residuals 4098 16866.4 4.1
---
Signif. codes: 0 ?***? 0.001 ?**? 0.01 ?*? 0.05 ?.? 0.1 ? ? 1
9. istunnon koodit
> read.table("http://www.ling.helsinki.fi/~anyrkko/Rmacbeth/Macbeth_data.txt",header=T)->macbeth
> summary(macbeth)
lemma len pos SG PL
the : 171 Min. : 1.000 N :976 Min. :0.000 Min. :0.0000
and : 137 1st Qu.: 3.000 V :801 1st Qu.:0.000 1st Qu.:0.0000
i : 122 Median : 4.000 PRON :675 Median :0.000 Median :0.0000
you : 122 Mean : 4.088 PREP :364 Mean :0.474 Mean :0.1714
be : 120 3rd Qu.: 5.000 DET :289 3rd Qu.:1.000 3rd Qu.:0.0000
he : 101 Max. :18.000 ADV :258 Max. :1.000 Max. :1.0000
(Other):3328 (Other):738
# Lisätään tarkasteluun chunk-indeksi (kukin pätkä sisältää 100 sanaa)
> length(macbeth$lemma)
[1] 4101
> macbeth$chunk<-floor((1:4101)/100)+1
> attach(macbeth)
> length(lemma)
[1] 4101
> summary(macbeth)
lemma len pos SG PL
the : 171 Min. : 1.000 N :976 Min. :0.000 Min. :0.0000
and : 137 1st Qu.: 3.000 V :801 1st Qu.:0.000 1st Qu.:0.0000
i : 122 Median : 4.000 PRON :675 Median :0.000 Median :0.0000
you : 122 Mean : 4.088 PREP :364 Mean :0.474 Mean :0.1714
be : 120 3rd Qu.: 5.000 DET :289 3rd Qu.:1.000 3rd Qu.:0.0000
he : 101 Max. :18.000 ADV :258 Max. :1.000 Max. :1.0000
(Other):3328 (Other):738
chunk
Min. : 1.00
1st Qu.:11.00
Median :21.00
Mean :21.02
3rd Qu.:31.00
Max. :42.00
> N<-(pos=="N")+0
> V<-(pos=="V")+0
> lm(len~N+V)->m
> summary(m)
Call:
lm(formula = len ~ N + V)
Residuals:
Min 1Q Median 3Q Max
-2.7602 -1.3868 -0.3868 0.6132 12.2398
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 3.38683 0.03698 91.59 <2e-16 ***
N 2.37341 0.06799 34.91 <2e-16 ***
V 0.69681 0.07304 9.54 <2e-16 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 1.783 on 4098 degrees of freedom
Multiple R-Squared: 0.2292, Adjusted R-squared: 0.2288
F-statistic: 609.2 on 2 and 4098 DF, p-value: < 2.2e-16
> summary(lm(len~N*PL))
Call:
lm(formula = len ~ N * PL)
Residuals:
Min 1Q Median 3Q Max
-2.7680 -1.6301 -0.2286 0.7714 12.2320
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 3.63005 0.03511 103.386 < 2e-16 ***
N 2.13799 0.07347 29.099 < 2e-16 ***
PL -0.40143 0.08752 -4.587 4.64e-06 ***
N:PL 0.36338 0.16729 2.172 0.0299 *
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 1.798 on 4097 degrees of freedom
Multiple R-Squared: 0.2161, Adjusted R-squared: 0.2155
F-statistic: 376.5 on 3 and 4097 DF, p-value: < 2.2e-16
> anova(lm(len~N*PL))
Analysis of Variance Table
Response: len
Df Sum Sq Mean Sq F value Pr(>F)
N 1 3582.6 3582.6 1108.3186 < 2.2e-16 ***
PL 1 53.0 53.0 16.3919 5.246e-05 ***
N:PL 1 15.3 15.3 4.7181 0.02990 *
Residuals 4097 13243.5 3.2
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
> N<-(pos=="N")+0
> PRON<-(pos=="PRON")+0
> anova(lm(len~N*PL+PRON*PL))
Analysis of Variance Table
Response: len
Df Sum Sq Mean Sq F value Pr(>F)
N 1 3582.6 3582.6 1178.2364 < 2.2e-16 ***
PL 1 53.0 53.0 17.4260 3.049e-05 ***
PRON 1 547.6 547.6 180.1072 < 2.2e-16 ***
N:PL 1 0.8 0.8 0.2675 0.605
PL:PRON 1 258.8 258.8 85.0987 < 2.2e-16 ***
Residuals 4095 12451.6 3.0
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
> summary(chunk)
Min. 1st Qu. Median Mean 3rd Qu. Max.
1.00 11.00 21.00 21.02 31.00 42.00
> xtabs(PRON~chunk)
chunk
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26
6 12 14 9 17 14 15 22 7 20 15 13 15 22 18 16 13 15 17 21 19 18 19 18 19 20
27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42
20 24 12 11 12 21 19 19 13 9 20 28 21 17 15 0
> plot(xtabs(PRON~chunk))
> xtabs(PRON~chunk)->nPRON
> hist(nPRON)
> hist(nPRON,0:30)
> sum(PRON)
[1] 675
> lPRON=sum(PRON)/41
> lPRON
[1] 16.46341
> plot(nPRON)
> xtabs(~nPRON)
nPRON
0 6 7 9 11 12 13 14 15 16 17 18 19 20 21 22 24 28
1 1 1 2 1 3 3 2 5 1 3 3 5 4 3 2 1 1
> xtabs(~nPRON)->cfPRON
> plot(cfPRON)
> lines(0:28,dpois(0:28,lambda=lPRON)*10)
> lines(0:28,dpois(0:28,lambda=lPRON)*41)
> ks.test(jitter(nPRON),"ppois",lambda=lPRON)
One-sample Kolmogorov-Smirnov test
data: jitter(nPRON)
D = 0.1314, p-value = 0.4263
alternative hypothesis: two-sided
>
Linkkivinkkejä
Korpuksia:
Testeistä: