KitWiki Web>FinnishActivities>HyClt255s2007 (2008-11-21, HennaRiikkaLaitinen)

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.

HyClt255projSeppoNyrkko (esimerkkipohja)

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 

>