Tänases praktikumis
Eelmisel korral
- Korrespondentsanalüüs
- lihtne korrespondentsanalüüs
- mitmene korrespondentsanalüüs
Sel korral
- Klasteranalüüs
Klasteranalüüs
Üks levinud juhendamata masinõppe meetod, mille eesmärk on avastada suurest hulgast andmetest peidetud struktuure, on klasteranalüüs. See on olemuselt klassifitseerimismeetod, kus objekte grupeeritakse nende omavahelise sarnasuse alusel (sarnased kõnelejad, sarnased vastajad, sarnased konstruktsioonid, sarnased murded, sarnased leiukohad, sarnased tekstid jne). Mudelile ei ole aga ette antud, millistesse klassidesse ta vaatlused täpselt jagama peab.
Klasteranalüüsis on 4 põhilist sammu:
1. Loe sisse ja normaliseeri andmed
2. Arvuta objektide/tunnuste vahelised kaugused
3. Arvuta kauguste põhjalt klastrid
4. Visualiseeri klastrid
1. Andmete sisselugemine ja normaliseerimine
Klasteranalüüsi sisendiks on üldjuhul tabelid, mille
- ridades on vaatlused/tunnused/objektid, mida soovitakse klasterdada,
- tulpades on tunnused, mille põhjal vaatlusi/tunnuseid/objekte klasterdada,
- lahtrites on tunnuse esinemise (normaliseeritud) väärtus.
Iga vaatluse/rea väärtused tulpades moodustavad selle vaatluse profiili.
Kui andmestikus on vaatlusi, millel mõne tunnuse väärtus puudub, siis tuleb need puuduvad väärtused andmestikust eemaldada või üldistada teiste vaatluste põhjalt (näiteks määrata puuduvale väärtusele tunnuse kõige populaarsem väärtus (mood) või aritmeetiline keskmine).
Oluline samm sisendandmete korrastamises on väärtuste normaliseerimine, selleks, et oleks võimalik adekvaatselt võrrelda eri skaalal tunnuseid (nt sõnade pikkus ja sõnade reaktsiooniaeg on erinevas suurusjärgus ja seega erinevatel skaaladel, kõikidest murretest ei ole korpuses sama palju sõnu jne). Kategoriaalsed tunnused saab muuta nt protsentideks või osakaaludeks, arvulised tunnused keskendada 0 ümber (selleks saab kasutada nt funktsiooni scale()).
Kasutame siin Levshina (2015) näidet keeleliste kausatiivkonstruktsioonide (nt ta ajas mu naerma) klasterdamisest. Sellised konstruktsioonid väljendavad põhjustatud sündmusi ning koosnevad mõjutajatest (ta), mõjutatavatest (mina) ja põhjustatud sündmusest (hakkasin naerma).
load("caus.RData")
head(caus)
## Cx CrSem CeSem CdEv Neg Coref Poss
## 1 be_made_toV Anim Anim Soc No No No
## 2 be_made_toV Anim Anim Soc No No No
## 3 be_made_toV Anim Anim Soc No No No
## 4 be_made_toV Anim Anim Ment No No No
## 5 be_made_toV Anim Anim Phys No No No
## 6 be_made_toV Anim Anim Soc No No No
summary(caus)
## Cx CrSem CeSem CdEv Neg Coref
## be_made_toV: 50 Anim :338 Anim :355 Ment: 53 No :434 No :438
## cause_toV : 50 Inanim:112 Inanim: 88 Phys:152 Yes: 16 Yes: 12
## get_toV : 50 NA's : 7 Soc :245
## get_Ved : 50
## get_Ving : 50
## have_V : 50
## (Other) :150
## Poss
## No :416
## Yes: 34
##
##
##
##
## 
Natalia Levshina, How to do Linguistics with R (2015: 294)
Näited konstruktsioonidest:
Natalia Levshina, How to do Linguistics with R (2015: 302)
# Muudame tulbanimed meile arusaadavamaks
names(caus) <- c("Konstr", # kausatiivkonstruktsioon
"Mja", # mõjutaja
"Mtav", # mõjutatav
"Syndmus", # põhisündmuse liik
"Eitus", # kas on eitav lause
"Koref", # kas mõjutaja ja mõjutatav on samaviitelised
"Poss") # kas mõjutatav kuulub kuidagi mõjutajaleNäeme, et mõjutatava tulbas on ka 7 puuduvat väärtust (NA). Vaatame, kus need asuvad.
caus[is.na(caus$Mtav),]
## Konstr Mja Mtav Syndmus Eitus Koref Poss
## 151 get_Ved Anim <NA> Phys No No Yes
## 152 get_Ved Anim <NA> Phys No No Yes
## 155 get_Ved Anim <NA> Phys No No Yes
## 157 get_Ved Anim <NA> Soc No No Yes
## 162 get_Ved Anim <NA> Phys No Yes No
## 163 get_Ved Anim <NA> Soc No Yes No
## 178 get_Ved Anim <NA> Soc No No NoTundub, et kõik puuduvad väärtused on get_Ved konstruktsioonist ja 7 vaatluse puhul ei teata, kas mõjutatav on elus või elutu referent. Jätame puuduvate väärtustega vaatlused välja.
Põhimõtteliselt võiksime normaliseerimise käigus välja jätta ka ainult puuduvad väärtused, mitte terveid vaatlusi, ent kindlam on välja jätta vaatlused tervikuna.
Kui tahame klasterdada 9 erinevat konstruktsiooni, peaksime iga konstruktsiooni jaoks eraldi normaliseerima kõikide tunnuste tasemete sagedused proportsioonideks. Näiteks konstruktsioonis be_made_toV on elusa ja elutu mõjutaja absoluutsagedused 48 ja 2 (kokku 50) ning proportsioonid järelikult vastavalt 0.96, 0.04 (vt table(caus[caus$Konstr == "be_made_toV","Mja"]) ja prop.table(table(caus[caus$Konstr == "be_made_toV","Mja"]))).
Sisendiks on meil vaja niisiis tabelit, kus oleks 9 rida (iga konstruktsiooni kohta 1) ning iga tunnuse iga taseme kohta eraldi tulp, kus on selle taseme proportsioon. Arvutame kokku, kui palju tulpasid oleks vaja.
# Iga andmestiku tulba kohta (v.a esimene, konstruktsiooni tulp)
# selle tasemete arv
sapply(caus[,-1], nlevels)
## Mja Mtav Syndmus Eitus Koref Poss
## 2 2 3 2 2 2
# Liida tasemete arvud kokku
sum(sapply(caus[-1], nlevels))
## [1] 13Kuidas kõikide tunnuse tasemete proportsioone leida?
Üheks võimaluseks on võtta iga konstruktsioon eraldi tabelist välja ning arvutada selle konstruktsiooni iga tunnuse kohta selle tunnuse tasemete proportsioonid.
levels(caus$Konstr)
## [1] "be_made_toV" "cause_toV" "get_toV" "get_Ved" "get_Ving"
## [6] "have_V" "have_Ved" "have_Ving" "make_V"
# Tee alamandmestik konstruktsioonist "be_made_toV"
be_made_toV <- caus[caus$Konstr == "be_made_toV",]
# Tee igast tulbast alamandmestikus (v.a esimesest) proportsioonide tabel
# (vaikimisi pannakse need tabelid tunnuste kaupa listi,
# aga meie tahaksime neid tavalise vektorina, seega
# kasutame ka funktsiooni unlist())
be_made_toV_props <- unlist(lapply(be_made_toV[,-1],
function(x) prop.table(table(x))))
be_made_toV_props
## Mja.Anim Mja.Inanim Mtav.Anim Mtav.Inanim Syndmus.Ment Syndmus.Phys
## 0.96 0.04 0.90 0.10 0.14 0.18
## Syndmus.Soc Eitus.No Eitus.Yes Koref.No Koref.Yes Poss.No
## 0.68 0.94 0.06 1.00 0.00 1.00
## Poss.Yes
## 0.00Ja nii tuleks arvutada profiilid eraldi iga konstruktsiooni kohta. Aga saame seda teha ka korraga. Selleks on erinevaid viise, aga kasutame siin funktsiooni lapply.
# Jagame andmestiku konstruktsiooni põhjal 9 alamandmestikuks
kaus_list <- split(caus, caus$Konstr) # list, kus on 9 andmetabelit
str(kaus_list)
## List of 9
## $ be_made_toV:'data.frame': 50 obs. of 7 variables:
## ..$ Konstr : Factor w/ 9 levels "be_made_toV",..: 1 1 1 1 1 1 1 1 1 1 ...
## ..$ Mja : Factor w/ 2 levels "Anim","Inanim": 1 1 1 1 1 1 1 1 1 1 ...
## ..$ Mtav : Factor w/ 2 levels "Anim","Inanim": 1 1 1 1 1 1 1 1 1 1 ...
## ..$ Syndmus: Factor w/ 3 levels "Ment","Phys",..: 3 3 3 1 2 3 3 1 2 1 ...
## ..$ Eitus : Factor w/ 2 levels "No","Yes": 1 1 1 1 1 1 1 1 1 1 ...
## ..$ Koref : Factor w/ 2 levels "No","Yes": 1 1 1 1 1 1 1 1 1 1 ...
## ..$ Poss : Factor w/ 2 levels "No","Yes": 1 1 1 1 1 1 1 1 1 1 ...
## ..- attr(*, "na.action")= 'omit' Named int [1:7] 151 152 155 157 162 163 178
## .. ..- attr(*, "names")= chr [1:7] "151" "152" "155" "157" ...
## $ cause_toV :'data.frame': 50 obs. of 7 variables:
## ..$ Konstr : Factor w/ 9 levels "be_made_toV",..: 2 2 2 2 2 2 2 2 2 2 ...
## ..$ Mja : Factor w/ 2 levels "Anim","Inanim": 1 1 2 2 2 1 2 1 2 2 ...
## ..$ Mtav : Factor w/ 2 levels "Anim","Inanim": 1 2 1 1 2 1 1 2 2 1 ...
## ..$ Syndmus: Factor w/ 3 levels "Ment","Phys",..: 2 2 1 3 2 2 1 2 3 2 ...
## ..$ Eitus : Factor w/ 2 levels "No","Yes": 1 1 1 1 1 1 1 1 1 1 ...
## ..$ Koref : Factor w/ 2 levels "No","Yes": 1 1 1 1 1 1 1 1 1 1 ...
## ..$ Poss : Factor w/ 2 levels "No","Yes": 2 2 1 1 1 1 1 1 1 1 ...
## ..- attr(*, "na.action")= 'omit' Named int [1:7] 151 152 155 157 162 163 178
## .. ..- attr(*, "names")= chr [1:7] "151" "152" "155" "157" ...
## $ get_toV :'data.frame': 50 obs. of 7 variables:
## ..$ Konstr : Factor w/ 9 levels "be_made_toV",..: 3 3 3 3 3 3 3 3 3 3 ...
## ..$ Mja : Factor w/ 2 levels "Anim","Inanim": 1 1 1 1 1 1 1 1 1 1 ...
## ..$ Mtav : Factor w/ 2 levels "Anim","Inanim": 1 1 1 1 1 1 1 1 1 1 ...
## ..$ Syndmus: Factor w/ 3 levels "Ment","Phys",..: 3 3 2 3 3 1 3 1 1 3 ...
## ..$ Eitus : Factor w/ 2 levels "No","Yes": 1 1 1 2 1 1 1 1 1 1 ...
## ..$ Koref : Factor w/ 2 levels "No","Yes": 1 1 1 1 1 1 1 2 2 1 ...
## ..$ Poss : Factor w/ 2 levels "No","Yes": 2 2 2 2 2 1 1 1 1 1 ...
## ..- attr(*, "na.action")= 'omit' Named int [1:7] 151 152 155 157 162 163 178
## .. ..- attr(*, "names")= chr [1:7] "151" "152" "155" "157" ...
## $ get_Ved :'data.frame': 43 obs. of 7 variables:
## ..$ Konstr : Factor w/ 9 levels "be_made_toV",..: 4 4 4 4 4 4 4 4 4 4 ...
## ..$ Mja : Factor w/ 2 levels "Anim","Inanim": 1 1 1 1 1 1 1 1 1 1 ...
## ..$ Mtav : Factor w/ 2 levels "Anim","Inanim": 1 1 1 1 1 1 1 1 1 1 ...
## ..$ Syndmus: Factor w/ 3 levels "Ment","Phys",..: 2 2 2 3 3 3 3 2 2 3 ...
## ..$ Eitus : Factor w/ 2 levels "No","Yes": 1 1 1 1 1 1 1 1 1 1 ...
## ..$ Koref : Factor w/ 2 levels "No","Yes": 1 1 1 2 2 2 2 2 2 1 ...
## ..$ Poss : Factor w/ 2 levels "No","Yes": 2 2 2 1 1 1 1 1 1 1 ...
## ..- attr(*, "na.action")= 'omit' Named int [1:7] 151 152 155 157 162 163 178
## .. ..- attr(*, "names")= chr [1:7] "151" "152" "155" "157" ...
## $ get_Ving :'data.frame': 50 obs. of 7 variables:
## ..$ Konstr : Factor w/ 9 levels "be_made_toV",..: 5 5 5 5 5 5 5 5 5 5 ...
## ..$ Mja : Factor w/ 2 levels "Anim","Inanim": 1 1 1 1 1 2 1 2 1 1 ...
## ..$ Mtav : Factor w/ 2 levels "Anim","Inanim": 2 2 1 2 1 1 2 2 2 2 ...
## ..$ Syndmus: Factor w/ 3 levels "Ment","Phys",..: 3 2 3 3 3 3 3 1 2 3 ...
## ..$ Eitus : Factor w/ 2 levels "No","Yes": 1 1 1 1 1 1 1 1 1 1 ...
## ..$ Koref : Factor w/ 2 levels "No","Yes": 1 1 1 1 1 1 1 1 1 1 ...
## ..$ Poss : Factor w/ 2 levels "No","Yes": 2 1 1 1 1 1 1 1 1 1 ...
## ..- attr(*, "na.action")= 'omit' Named int [1:7] 151 152 155 157 162 163 178
## .. ..- attr(*, "names")= chr [1:7] "151" "152" "155" "157" ...
## $ have_V :'data.frame': 50 obs. of 7 variables:
## ..$ Konstr : Factor w/ 9 levels "be_made_toV",..: 6 6 6 6 6 6 6 6 6 6 ...
## ..$ Mja : Factor w/ 2 levels "Anim","Inanim": 1 1 1 1 1 1 1 1 1 1 ...
## ..$ Mtav : Factor w/ 2 levels "Anim","Inanim": 1 2 1 1 1 1 1 1 1 1 ...
## ..$ Syndmus: Factor w/ 3 levels "Ment","Phys",..: 3 3 3 2 3 3 3 3 3 3 ...
## ..$ Eitus : Factor w/ 2 levels "No","Yes": 1 1 1 2 1 1 1 1 1 1 ...
## ..$ Koref : Factor w/ 2 levels "No","Yes": 1 1 1 1 1 1 1 2 2 1 ...
## ..$ Poss : Factor w/ 2 levels "No","Yes": 2 2 2 2 2 2 1 1 1 1 ...
## ..- attr(*, "na.action")= 'omit' Named int [1:7] 151 152 155 157 162 163 178
## .. ..- attr(*, "names")= chr [1:7] "151" "152" "155" "157" ...
## $ have_Ved :'data.frame': 50 obs. of 7 variables:
## ..$ Konstr : Factor w/ 9 levels "be_made_toV",..: 7 7 7 7 7 7 7 7 7 7 ...
## ..$ Mja : Factor w/ 2 levels "Anim","Inanim": 1 1 1 1 1 1 1 1 1 1 ...
## ..$ Mtav : Factor w/ 2 levels "Anim","Inanim": 1 1 1 1 1 1 1 1 1 1 ...
## ..$ Syndmus: Factor w/ 3 levels "Ment","Phys",..: 3 3 3 2 3 3 3 3 2 3 ...
## ..$ Eitus : Factor w/ 2 levels "No","Yes": 1 1 1 1 1 1 1 1 1 1 ...
## ..$ Koref : Factor w/ 2 levels "No","Yes": 1 1 1 1 1 1 1 1 1 1 ...
## ..$ Poss : Factor w/ 2 levels "No","Yes": 2 2 2 2 2 2 2 2 2 2 ...
## ..- attr(*, "na.action")= 'omit' Named int [1:7] 151 152 155 157 162 163 178
## .. ..- attr(*, "names")= chr [1:7] "151" "152" "155" "157" ...
## $ have_Ving :'data.frame': 50 obs. of 7 variables:
## ..$ Konstr : Factor w/ 9 levels "be_made_toV",..: 8 8 8 8 8 8 8 8 8 8 ...
## ..$ Mja : Factor w/ 2 levels "Anim","Inanim": 1 2 1 1 2 2 2 2 2 2 ...
## ..$ Mtav : Factor w/ 2 levels "Anim","Inanim": 1 1 1 1 1 1 1 1 1 2 ...
## ..$ Syndmus: Factor w/ 3 levels "Ment","Phys",..: 3 2 2 2 2 2 2 2 2 2 ...
## ..$ Eitus : Factor w/ 2 levels "No","Yes": 1 1 1 1 1 1 1 1 1 1 ...
## ..$ Koref : Factor w/ 2 levels "No","Yes": 1 1 1 1 1 1 1 1 1 1 ...
## ..$ Poss : Factor w/ 2 levels "No","Yes": 1 1 1 1 1 1 1 1 1 1 ...
## ..- attr(*, "na.action")= 'omit' Named int [1:7] 151 152 155 157 162 163 178
## .. ..- attr(*, "names")= chr [1:7] "151" "152" "155" "157" ...
## $ make_V :'data.frame': 50 obs. of 7 variables:
## ..$ Konstr : Factor w/ 9 levels "be_made_toV",..: 9 9 9 9 9 9 9 9 9 9 ...
## ..$ Mja : Factor w/ 2 levels "Anim","Inanim": 1 2 1 2 2 2 1 1 2 2 ...
## ..$ Mtav : Factor w/ 2 levels "Anim","Inanim": 1 1 1 1 1 2 2 2 1 1 ...
## ..$ Syndmus: Factor w/ 3 levels "Ment","Phys",..: 3 2 2 1 1 2 3 3 1 1 ...
## ..$ Eitus : Factor w/ 2 levels "No","Yes": 2 1 1 1 1 1 1 1 1 1 ...
## ..$ Koref : Factor w/ 2 levels "No","Yes": 1 1 1 1 1 1 1 1 1 1 ...
## ..$ Poss : Factor w/ 2 levels "No","Yes": 1 1 1 1 1 1 1 1 1 1 ...
## ..- attr(*, "na.action")= 'omit' Named int [1:7] 151 152 155 157 162 163 178
## .. ..- attr(*, "names")= chr [1:7] "151" "152" "155" "157" ...
# Eemaldame igast listi liikmest (= iga konstruktsiooni tabelist)
# esimese tulba konstruktsiooni nimega
kaus_list <- lapply(kaus_list,
function(x) x <- x[, -1])
str(kaus_list)
## List of 9
## $ be_made_toV:'data.frame': 50 obs. of 6 variables:
## ..$ Mja : Factor w/ 2 levels "Anim","Inanim": 1 1 1 1 1 1 1 1 1 1 ...
## ..$ Mtav : Factor w/ 2 levels "Anim","Inanim": 1 1 1 1 1 1 1 1 1 1 ...
## ..$ Syndmus: Factor w/ 3 levels "Ment","Phys",..: 3 3 3 1 2 3 3 1 2 1 ...
## ..$ Eitus : Factor w/ 2 levels "No","Yes": 1 1 1 1 1 1 1 1 1 1 ...
## ..$ Koref : Factor w/ 2 levels "No","Yes": 1 1 1 1 1 1 1 1 1 1 ...
## ..$ Poss : Factor w/ 2 levels "No","Yes": 1 1 1 1 1 1 1 1 1 1 ...
## $ cause_toV :'data.frame': 50 obs. of 6 variables:
## ..$ Mja : Factor w/ 2 levels "Anim","Inanim": 1 1 2 2 2 1 2 1 2 2 ...
## ..$ Mtav : Factor w/ 2 levels "Anim","Inanim": 1 2 1 1 2 1 1 2 2 1 ...
## ..$ Syndmus: Factor w/ 3 levels "Ment","Phys",..: 2 2 1 3 2 2 1 2 3 2 ...
## ..$ Eitus : Factor w/ 2 levels "No","Yes": 1 1 1 1 1 1 1 1 1 1 ...
## ..$ Koref : Factor w/ 2 levels "No","Yes": 1 1 1 1 1 1 1 1 1 1 ...
## ..$ Poss : Factor w/ 2 levels "No","Yes": 2 2 1 1 1 1 1 1 1 1 ...
## $ get_toV :'data.frame': 50 obs. of 6 variables:
## ..$ Mja : Factor w/ 2 levels "Anim","Inanim": 1 1 1 1 1 1 1 1 1 1 ...
## ..$ Mtav : Factor w/ 2 levels "Anim","Inanim": 1 1 1 1 1 1 1 1 1 1 ...
## ..$ Syndmus: Factor w/ 3 levels "Ment","Phys",..: 3 3 2 3 3 1 3 1 1 3 ...
## ..$ Eitus : Factor w/ 2 levels "No","Yes": 1 1 1 2 1 1 1 1 1 1 ...
## ..$ Koref : Factor w/ 2 levels "No","Yes": 1 1 1 1 1 1 1 2 2 1 ...
## ..$ Poss : Factor w/ 2 levels "No","Yes": 2 2 2 2 2 1 1 1 1 1 ...
## $ get_Ved :'data.frame': 43 obs. of 6 variables:
## ..$ Mja : Factor w/ 2 levels "Anim","Inanim": 1 1 1 1 1 1 1 1 1 1 ...
## ..$ Mtav : Factor w/ 2 levels "Anim","Inanim": 1 1 1 1 1 1 1 1 1 1 ...
## ..$ Syndmus: Factor w/ 3 levels "Ment","Phys",..: 2 2 2 3 3 3 3 2 2 3 ...
## ..$ Eitus : Factor w/ 2 levels "No","Yes": 1 1 1 1 1 1 1 1 1 1 ...
## ..$ Koref : Factor w/ 2 levels "No","Yes": 1 1 1 2 2 2 2 2 2 1 ...
## ..$ Poss : Factor w/ 2 levels "No","Yes": 2 2 2 1 1 1 1 1 1 1 ...
## $ get_Ving :'data.frame': 50 obs. of 6 variables:
## ..$ Mja : Factor w/ 2 levels "Anim","Inanim": 1 1 1 1 1 2 1 2 1 1 ...
## ..$ Mtav : Factor w/ 2 levels "Anim","Inanim": 2 2 1 2 1 1 2 2 2 2 ...
## ..$ Syndmus: Factor w/ 3 levels "Ment","Phys",..: 3 2 3 3 3 3 3 1 2 3 ...
## ..$ Eitus : Factor w/ 2 levels "No","Yes": 1 1 1 1 1 1 1 1 1 1 ...
## ..$ Koref : Factor w/ 2 levels "No","Yes": 1 1 1 1 1 1 1 1 1 1 ...
## ..$ Poss : Factor w/ 2 levels "No","Yes": 2 1 1 1 1 1 1 1 1 1 ...
## $ have_V :'data.frame': 50 obs. of 6 variables:
## ..$ Mja : Factor w/ 2 levels "Anim","Inanim": 1 1 1 1 1 1 1 1 1 1 ...
## ..$ Mtav : Factor w/ 2 levels "Anim","Inanim": 1 2 1 1 1 1 1 1 1 1 ...
## ..$ Syndmus: Factor w/ 3 levels "Ment","Phys",..: 3 3 3 2 3 3 3 3 3 3 ...
## ..$ Eitus : Factor w/ 2 levels "No","Yes": 1 1 1 2 1 1 1 1 1 1 ...
## ..$ Koref : Factor w/ 2 levels "No","Yes": 1 1 1 1 1 1 1 2 2 1 ...
## ..$ Poss : Factor w/ 2 levels "No","Yes": 2 2 2 2 2 2 1 1 1 1 ...
## $ have_Ved :'data.frame': 50 obs. of 6 variables:
## ..$ Mja : Factor w/ 2 levels "Anim","Inanim": 1 1 1 1 1 1 1 1 1 1 ...
## ..$ Mtav : Factor w/ 2 levels "Anim","Inanim": 1 1 1 1 1 1 1 1 1 1 ...
## ..$ Syndmus: Factor w/ 3 levels "Ment","Phys",..: 3 3 3 2 3 3 3 3 2 3 ...
## ..$ Eitus : Factor w/ 2 levels "No","Yes": 1 1 1 1 1 1 1 1 1 1 ...
## ..$ Koref : Factor w/ 2 levels "No","Yes": 1 1 1 1 1 1 1 1 1 1 ...
## ..$ Poss : Factor w/ 2 levels "No","Yes": 2 2 2 2 2 2 2 2 2 2 ...
## $ have_Ving :'data.frame': 50 obs. of 6 variables:
## ..$ Mja : Factor w/ 2 levels "Anim","Inanim": 1 2 1 1 2 2 2 2 2 2 ...
## ..$ Mtav : Factor w/ 2 levels "Anim","Inanim": 1 1 1 1 1 1 1 1 1 2 ...
## ..$ Syndmus: Factor w/ 3 levels "Ment","Phys",..: 3 2 2 2 2 2 2 2 2 2 ...
## ..$ Eitus : Factor w/ 2 levels "No","Yes": 1 1 1 1 1 1 1 1 1 1 ...
## ..$ Koref : Factor w/ 2 levels "No","Yes": 1 1 1 1 1 1 1 1 1 1 ...
## ..$ Poss : Factor w/ 2 levels "No","Yes": 1 1 1 1 1 1 1 1 1 1 ...
## $ make_V :'data.frame': 50 obs. of 6 variables:
## ..$ Mja : Factor w/ 2 levels "Anim","Inanim": 1 2 1 2 2 2 1 1 2 2 ...
## ..$ Mtav : Factor w/ 2 levels "Anim","Inanim": 1 1 1 1 1 2 2 2 1 1 ...
## ..$ Syndmus: Factor w/ 3 levels "Ment","Phys",..: 3 2 2 1 1 2 3 3 1 1 ...
## ..$ Eitus : Factor w/ 2 levels "No","Yes": 2 1 1 1 1 1 1 1 1 1 ...
## ..$ Koref : Factor w/ 2 levels "No","Yes": 1 1 1 1 1 1 1 1 1 1 ...
## ..$ Poss : Factor w/ 2 levels "No","Yes": 1 1 1 1 1 1 1 1 1 1 ...
kaus_list_props <- lapply(kaus_list, # Iga konstruktsiooni andmestiku kohta listis
function(x) # rakendame funktsiooni,
lapply(x, # kus iga tulba kohta andmestikus
function(y) # rakendame funktsiooni, kus
prop.table(table(y)))) # leiame selle tulba
# tunnuse väärtuste proportsioonid
str(kaus_list_props, max.level = 1) # konstruktsioonide list
## List of 9
## $ be_made_toV:List of 6
## $ cause_toV :List of 6
## $ get_toV :List of 6
## $ get_Ved :List of 6
## $ get_Ving :List of 6
## $ have_V :List of 6
## $ have_Ved :List of 6
## $ have_Ving :List of 6
## $ make_V :List of 6
str(kaus_list_props$be_made_toV) # ühe konstruktsiooni list
## List of 6
## $ Mja : 'table' num [1:2(1d)] 0.96 0.04
## ..- attr(*, "dimnames")=List of 1
## .. ..$ y: chr [1:2] "Anim" "Inanim"
## $ Mtav : 'table' num [1:2(1d)] 0.9 0.1
## ..- attr(*, "dimnames")=List of 1
## .. ..$ y: chr [1:2] "Anim" "Inanim"
## $ Syndmus: 'table' num [1:3(1d)] 0.14 0.18 0.68
## ..- attr(*, "dimnames")=List of 1
## .. ..$ y: chr [1:3] "Ment" "Phys" "Soc"
## $ Eitus : 'table' num [1:2(1d)] 0.94 0.06
## ..- attr(*, "dimnames")=List of 1
## .. ..$ y: chr [1:2] "No" "Yes"
## $ Koref : 'table' num [1:2(1d)] 1 0
## ..- attr(*, "dimnames")=List of 1
## .. ..$ y: chr [1:2] "No" "Yes"
## $ Poss : 'table' num [1:2(1d)] 1 0
## ..- attr(*, "dimnames")=List of 1
## .. ..$ y: chr [1:2] "No" "Yes"
# Teeme listist andmetabeli, kus
# esmalt võtame kõik väärtused listist välja (unlist),
# paneme need väärtused maatriksisse (matrix), mille
# ridade arv on võrdne listi pikkusega ehk konstruktsioonide arvuga (nrow)
# ning täidame maatriksi ridade kaupa (byrow).
# Maatriksi muudame andmetabeliks (data.frame).
df_props <- data.frame(matrix(unlist(kaus_list_props),
nrow = length(kaus_list_props),
byrow=T))
head(df_props)
## X1 X2 X3 X4 X5 X6 X7 X8 X9
## 1 0.96 0.04 0.90 0.10 0.14000000 0.1800000 0.680000 0.9400000 0.06000000
## 2 0.24 0.76 0.52 0.48 0.14000000 0.5600000 0.300000 0.9600000 0.04000000
## 3 0.92 0.08 0.92 0.08 0.10000000 0.2800000 0.620000 0.9200000 0.08000000
## 4 1.00 0.00 1.00 0.00 0.02325581 0.3488372 0.627907 0.9767442 0.02325581
## 5 0.78 0.22 0.34 0.66 0.06000000 0.1400000 0.800000 1.0000000 0.00000000
## 6 0.96 0.04 0.88 0.12 0.20000000 0.1600000 0.640000 0.9200000 0.08000000
## X10 X11 X12 X13
## 1 1.0000000 0.0000000 1.0000000 0.00000000
## 2 1.0000000 0.0000000 0.9600000 0.04000000
## 3 0.9600000 0.0400000 0.9000000 0.10000000
## 4 0.8604651 0.1395349 0.9302326 0.06976744
## 5 1.0000000 0.0000000 0.9800000 0.02000000
## 6 0.9600000 0.0400000 0.8800000 0.12000000
# Nüüd on vaja lihtsalt lisada rea- ja tulbanimed
# Reanimed saame kätte listist
names(kaus_list_props)
## [1] "be_made_toV" "cause_toV" "get_toV" "get_Ved" "get_Ving"
## [6] "have_V" "have_Ved" "have_Ving" "make_V"
rownames(df_props) <- names(kaus_list_props)
# Tulbanimed saame kätte ükskõik millise konstruktsiooni
# elementide nimedest listis
names(unlist(kaus_list_props$be_made_toV))
## [1] "Mja.Anim" "Mja.Inanim" "Mtav.Anim" "Mtav.Inanim" "Syndmus.Ment"
## [6] "Syndmus.Phys" "Syndmus.Soc" "Eitus.No" "Eitus.Yes" "Koref.No"
## [11] "Koref.Yes" "Poss.No" "Poss.Yes"
colnames(df_props) <- names(unlist(kaus_list_props$be_made_toV))
df_props
## Mja.Anim Mja.Inanim Mtav.Anim Mtav.Inanim Syndmus.Ment Syndmus.Phys
## be_made_toV 0.96 0.04 0.90 0.10 0.14000000 0.1800000
## cause_toV 0.24 0.76 0.52 0.48 0.14000000 0.5600000
## get_toV 0.92 0.08 0.92 0.08 0.10000000 0.2800000
## get_Ved 1.00 0.00 1.00 0.00 0.02325581 0.3488372
## get_Ving 0.78 0.22 0.34 0.66 0.06000000 0.1400000
## have_V 0.96 0.04 0.88 0.12 0.20000000 0.1600000
## have_Ved 1.00 0.00 1.00 0.00 0.02000000 0.4400000
## have_Ving 0.34 0.66 0.98 0.02 0.04000000 0.5800000
## make_V 0.56 0.44 0.70 0.30 0.34000000 0.3200000
## Syndmus.Soc Eitus.No Eitus.Yes Koref.No Koref.Yes Poss.No
## be_made_toV 0.680000 0.9400000 0.06000000 1.0000000 0.0000000 1.0000000
## cause_toV 0.300000 0.9600000 0.04000000 1.0000000 0.0000000 0.9600000
## get_toV 0.620000 0.9200000 0.08000000 0.9600000 0.0400000 0.9000000
## get_Ved 0.627907 0.9767442 0.02325581 0.8604651 0.1395349 0.9302326
## get_Ving 0.800000 1.0000000 0.00000000 1.0000000 0.0000000 0.9800000
## have_V 0.640000 0.9200000 0.08000000 0.9600000 0.0400000 0.8800000
## have_Ved 0.540000 1.0000000 0.00000000 1.0000000 0.0000000 0.7400000
## have_Ving 0.380000 0.9800000 0.02000000 1.0000000 0.0000000 1.0000000
## make_V 0.340000 0.9800000 0.02000000 1.0000000 0.0000000 1.0000000
## Poss.Yes
## be_made_toV 0.00000000
## cause_toV 0.04000000
## get_toV 0.10000000
## get_Ved 0.06976744
## get_Ving 0.02000000
## have_V 0.12000000
## have_Ved 0.26000000
## have_Ving 0.00000000
## make_V 0.00000000See on nüüd klasteranalüüsi sisendtabel.
2. Kauguste arvutamine
Järgmiseks arvutame iga konstruktsiooni profiili ehk proportsioonide rea kauguse paarikaupa kõikide teiste konstruktsioonide profiilidest.
Selliseid kaugusi saab tõlgendada konstruktsioonide omavaheliste sarnasuste ja erinevustena. Teisisõnu: mida sarnasemad on kahe konstruktsiooni reaprofiilid (tunnuste väärtused on sarnased), seda väiksem saab olema nendevaheline kaugus. Kauguse arvutamiseks on R-is funktsioon dist().
Kauguste arvutamiseks on kümneid erinevaid algoritme. R-i funktsiooni dist() vaikimisi algoritm on euclidean ehk eukleidiline kaugus. Teised variandid on manhattan, maximum, canberra, binary ja minkowski. Levinumad on euclidean ja manhattan. Sobiva algoritmi valik on klasteranalüüsis väga oluline samm, kuna see mõjutab objektidevaheliste sarnasuste ja erinevuste hinnanguid ning seeläbi ka seda, kuidas klastrid hiljem formuleeruvad.
euclidean: kahe profiili erinevused võetakse ruutu ja summeeritakse. Saadud väärtusest võetakse ruutjuur.
# euclidean
df_props[1:2,] # be_made_toV ja cause_toV
## Mja.Anim Mja.Inanim Mtav.Anim Mtav.Inanim Syndmus.Ment Syndmus.Phys
## be_made_toV 0.96 0.04 0.90 0.10 0.14 0.18
## cause_toV 0.24 0.76 0.52 0.48 0.14 0.56
## Syndmus.Soc Eitus.No Eitus.Yes Koref.No Koref.Yes Poss.No Poss.Yes
## be_made_toV 0.68 0.94 0.06 1 0 1.00 0.00
## cause_toV 0.30 0.96 0.04 1 0 0.96 0.04
df_props[1,]-df_props[2,] # kahe profiili erinevused
## Mja.Anim Mja.Inanim Mtav.Anim Mtav.Inanim Syndmus.Ment Syndmus.Phys
## be_made_toV 0.72 -0.72 0.38 -0.38 0 -0.38
## Syndmus.Soc Eitus.No Eitus.Yes Koref.No Koref.Yes Poss.No Poss.Yes
## be_made_toV 0.38 -0.02 0.02 0 0 0.04 -0.04
(df_props[1,]-df_props[2,])^2 # kahe profiili erinevuste ruudud
## Mja.Anim Mja.Inanim Mtav.Anim Mtav.Inanim Syndmus.Ment Syndmus.Phys
## be_made_toV 0.5184 0.5184 0.1444 0.1444 0 0.1444
## Syndmus.Soc Eitus.No Eitus.Yes Koref.No Koref.Yes Poss.No Poss.Yes
## be_made_toV 0.1444 4e-04 4e-04 0 0 0.0016 0.0016
sum((df_props[1,]-df_props[2,])^2) # kahe profiili erinevuste ruutude summa
## [1] 1.6184
sqrt(sum((df_props[1,]-df_props[2,])^2)) # ruutjuur erinevuste summast
## [1] 1.272164
# Võrdle
dist(df_props, method = "euclidean")[1]
## [1] 1.272164manhattan: kahe profiili erinevuste absoluutväärtused summeeritakse.
sum(abs(df_props[1,]-df_props[2,]))
## [1] 3.08
# Võrdle
dist(df_props, method = "manhattan")[1]
## [1] 3.08Nimetatud algoritmid on kõik põhimõtteliselt eukleidilise kauguse erivariandid ja töötavad dist()-funktsioonis arvuliste vektoritega (meil on nt vektoriks ühe konstruktsiooni profiil, kus on tunnuste väärtuste osakaalud). Võimalik on kasutada ka mitte-eukleidilisi kaugusi, nt Goweri kaugust paketi cluster funktsioonis daisy(metric = "gower"), mis töötab nii arvuliste, järjestus- kui ka nominaaltunnustega. See tähendab, et ei ole tingimata vaja kategoriaalseid tunnuseid eelnevalt normaliseerida ja võib sisendiks anda lihtsalt tavalise tabeli, kus ridades on individuaalsed vaatlused ja tulpades tunnused (eeldusel, et iga klasterdatava objekti kohta on siiski ainult üks rida). Samuti suudab see algoritm saada hakkama korraga ka eri tüüpi tunnustega.
Kuna meil on üht tüüpi (= kategoriaalsed) tunnused, mille normaliseerisime arvulisteks, kasutame siin varianti method = "canberra", mis on euclidean-meetodi kaalutud versioon ning rõhutab erinevusi väikeste kauguste vahel ja suhtub natuke lõdvemalt suurematesse kaugustesse.
df_dist <- dist(df_props, method = "canberra")
df_dist
## be_made_toV cause_toV get_toV get_Ved get_Ving have_V have_Ved
## cause_toV 4.934563
## get_toV 3.133571 5.071468
## get_Ved 5.718885 5.864806 4.204925
## get_Ving 5.017264 4.621744 5.274509 6.272429
## have_V 2.605590 5.369367 1.300911 4.737559 5.477050
## have_Ved 5.998960 6.464857 5.645268 3.597021 5.701188 5.970748
## have_Ving 4.677141 3.817992 5.597708 5.450257 5.964971 6.335640 5.748888
## make_V 3.867293 3.424332 5.258707 5.859127 5.128155 5.253519 6.383113
## have_Ving
## cause_toV
## get_toV
## get_Ved
## get_Ving
## have_V
## have_Ved
## have_Ving
## make_V 3.096398Kaugusmaatriksis on nüüd nii ridades kui ka tulpades meid huvitavad objektid (siin kausatiivkonstruktsioonid) ning lahtrites nendevahelised kaugused. Vaikimisi kuvatakse ainult üks pool maatriksist, kuna teine pool on selle peegelpilt ega pole seega rohkem informatiivne (nt rea get_toV kaugus tulbast cause_toV on sama suur kui rea cause_toV kaugus tulbas get_toV). Võime kontrolli mõttes trükkida välja ka terve maatriksi.
dist(df_props, method = "canberra", diag = TRUE, upper = TRUE)
## be_made_toV cause_toV get_toV get_Ved get_Ving have_V have_Ved
## be_made_toV 0.000000 4.934563 3.133571 5.718885 5.017264 2.605590 5.998960
## cause_toV 4.934563 0.000000 5.071468 5.864806 4.621744 5.369367 6.464857
## get_toV 3.133571 5.071468 0.000000 4.204925 5.274509 1.300911 5.645268
## get_Ved 5.718885 5.864806 4.204925 0.000000 6.272429 4.737559 3.597021
## get_Ving 5.017264 4.621744 5.274509 6.272429 0.000000 5.477050 5.701188
## have_V 2.605590 5.369367 1.300911 4.737559 5.477050 0.000000 5.970748
## have_Ved 5.998960 6.464857 5.645268 3.597021 5.701188 5.970748 0.000000
## have_Ving 4.677141 3.817992 5.597708 5.450257 5.964971 6.335640 5.748888
## make_V 3.867293 3.424332 5.258707 5.859127 5.128155 5.253519 6.383113
## have_Ving make_V
## be_made_toV 4.677141 3.867293
## cause_toV 3.817992 3.424332
## get_toV 5.597708 5.258707
## get_Ved 5.450257 5.859127
## get_Ving 5.964971 5.128155
## have_V 6.335640 5.253519
## have_Ved 5.748888 6.383113
## have_Ving 0.000000 3.096398
## make_V 3.096398 0.000000Võime kaugusi hõlpsalt ka paketi factoextra abiga visualiseerida.
library(factoextra)
df_dist_facto <- get_dist(df_props, method = "canberra")
df_dist_facto
## be_made_toV cause_toV get_toV get_Ved get_Ving have_V have_Ved
## cause_toV 4.934563
## get_toV 3.133571 5.071468
## get_Ved 5.718885 5.864806 4.204925
## get_Ving 5.017264 4.621744 5.274509 6.272429
## have_V 2.605590 5.369367 1.300911 4.737559 5.477050
## have_Ved 5.998960 6.464857 5.645268 3.597021 5.701188 5.970748
## have_Ving 4.677141 3.817992 5.597708 5.450257 5.964971 6.335640 5.748888
## make_V 3.867293 3.424332 5.258707 5.859127 5.128155 5.253519 6.383113
## have_Ving
## cause_toV
## get_toV
## get_Ved
## get_Ving
## have_V
## have_Ved
## have_Ving
## make_V 3.096398
fviz_dist(df_dist_facto,
gradient = list(low = "steelblue3", mid = "white", high = "tomato3"))
Mida tumedama punasega on kastike värvitud, seda suuremad on objektidevahelised (konstruktsioonidevahelised) kaugused ja seda erinevamad need objektid on. Mida tumedama sinisega on kastike, seda lähemal ja seda sarnasemad objektid on.
3. Klastrite leidmine ja 4. visualiseerimine
Ka klastrite tegemiseks on mitu erinevat algoritmi, neist levinumad on hierarhiline (aglomeratiivne) klasteranalüüs ning mittehierarhiline k-keskmiste klasteranalüüs.
- Hierarhilises aglomeratiivses (agglomerative) klasteranalüüsis alustatakse objektide grupeerimist olukorrast, kus iga objekt moodustab omaette klastri. Objekte hakatakse liitma põhimõttel, et üksteisele kõige sarnasemad objektid kuuluksid ühte klastrisse. Rühmade liitmine toimub seni, kuni kõik objektid on liidetud üheks klastriks. Siin pakub huvi optimaalne klastrite arv ehk nende klastrite hulk, mille puhul klastrisse kuuluvad objektid on üksteisele maksimaalselt sarnased ja teiste klastrite objektidest maksimaalselt erinevad. Hierarhilisest klasteranalüüsist on ka divisiivne (divisive) tüüp, mille suund on täpselt vastupidine: alustatakse seisust, kus kõik objektid on ühes klassis ning hakatakse neid sammhaaval klastritesse jagama. Divisiivse lähenemise loogika sarnaneb seega pisut otsustuspuu algoritmiga. Üldiselt leiab aglomeratiivne klasterdamine paremini üles väikesed klastrid ja divisiivne suured. Hierarhilise klasteranalüüsi väljundiks on dendrogramm ehk puukujuline graafik.
- K-keskmiste nalüüsis oskame enam-vähem ette ennustada sobivate klastrite arvu. Objektid jagatakse esialgsetesse klassidesse, seejärel arvutatakse välja klastrite keskpunktid ning hakatakse hindama iga klastri liikme kaugust kõikide klastrite keskpunktidest. Kui objekt on lähemal mõne teise klastri keskpunktile, tõstetakse ta sinna. Protsessi jätkatakse nii kaua, kuni kõik objektid on klastris, mille keskpunktile nad on kõige lähemal.
Vaatleme siin hierarhilist klasterdamist (K-keskmiste kohta loe lähemalt nt siit), mis on kahest algoritmist eksploratiivsema loomuga (st me ei tea andmete kohta ette eriti palju) ning annab visuaalseks väljundiks ka nn klastripuu. Kasutame funktsiooni hclust() ja selles omakorda klastripuu ehitamise meetodit ward.D2. Kui enne valisime kauguse mõõdiku, millega mõõta kahe objekti/vaatluse vahelisi sarnasusi-erinevusi, siis see meetod täpsustab, kuidas mõõta kahe vaatluste klastri sarnasust ja erinevust. Igal klastrite ehitamise sammul ühendatakse omavahel need klastrid, mille vaheline kaugus on kõige väiksem, aga see, mille alusel kaugust arvestatakse, on eri meetoditel erinev (nt kas kaugust loetakse kahe klastri üksteisele kõige lähemal asuvate objektide järgi, kõige kaugemal asuvate objektide järgi või hoopis mingi objektidevaheliste kauguste keskväärtuse järgi). Nn Wardi meetod minimeerib klastrisisest koguhajuvust ja ühendab klastreid selle järgi, et samasse klastrisse kuuluvad objektid oleksid üksteisega võimalikult sarnased.
df_clust <- hclust(df_dist, method = "ward.D2")
df_clust
##
## Call:
## hclust(d = df_dist, method = "ward.D2")
##
## Cluster method : ward.D2
## Distance : canberra
## Number of objects: 9
str(df_clust)
## List of 7
## $ merge : int [1:8, 1:2] -3 -8 -1 -4 -2 -5 3 6 -6 -9 ...
## $ height : num [1:8] 1.3 3.1 3.24 3.6 3.79 ...
## $ order : int [1:9] 5 2 8 9 1 3 6 4 7
## $ labels : chr [1:9] "be_made_toV" "cause_toV" "get_toV" "get_Ved" ...
## $ method : chr "ward.D2"
## $ call : language hclust(d = df_dist, method = "ward.D2")
## $ dist.method: chr "canberra"
## - attr(*, "class")= chr "hclust"
par(mfrow = c(1,2))
plot(df_clust)
plot(df_clust, hang = -1) # sildid graafiku alumisse serva
Tekib nn klastripuu, kus klastrid on üksteisega hierarhiliselt seotud: nt make_V ja have_Ving moodustavad ühe klastri, koos konstruktsiooniga cause_toV teise klastri, need omakorda koos konstruktsiooniga get_Ving kolmanda. Need neli konstruktsiooni on omavahel sarnasemad kui teiste konstruktsioonidega.
Võrdleme tulemust konstruktsioonide profiilidega ning keskendume eeskätt nt get_Ved ja have_Ved ning have_Ving ja make_V vahelistele erinevustele.
df_props[c("get_Ved", "have_Ved", "have_Ving", "make_V"),]
## Mja.Anim Mja.Inanim Mtav.Anim Mtav.Inanim Syndmus.Ment Syndmus.Phys
## get_Ved 1.00 0.00 1.00 0.00 0.02325581 0.3488372
## have_Ved 1.00 0.00 1.00 0.00 0.02000000 0.4400000
## have_Ving 0.34 0.66 0.98 0.02 0.04000000 0.5800000
## make_V 0.56 0.44 0.70 0.30 0.34000000 0.3200000
## Syndmus.Soc Eitus.No Eitus.Yes Koref.No Koref.Yes Poss.No
## get_Ved 0.627907 0.9767442 0.02325581 0.8604651 0.1395349 0.9302326
## have_Ved 0.540000 1.0000000 0.00000000 1.0000000 0.0000000 0.7400000
## have_Ving 0.380000 0.9800000 0.02000000 1.0000000 0.0000000 1.0000000
## make_V 0.340000 0.9800000 0.02000000 1.0000000 0.0000000 1.0000000
## Poss.Yes
## get_Ved 0.06976744
## have_Ved 0.26000000
## have_Ving 0.00000000
## make_V 0.00000000Näeme, et kõige selgemini tulevad kahe grupi erinevused välja selles, kas mõjutaja on elus või elutu.
Võime vaadata, millised klastripuud saaksime teiste klastritevahelise sarnasuse arvutamise meetoditega.
df_clust1 <- hclust(df_dist, method = "ward.D2")
df_clust2 <- hclust(df_dist, method = "complete")
df_clust3 <- hclust(df_dist, method = "single")
df_clust4 <- hclust(df_dist, method = "average")
par(mfrow = c(2,2))
plot(df_clust1, hang = -1)
plot(df_clust2, hang = -1)
plot(df_clust3, hang = -1)
plot(df_clust4, hang = -1)
See, millised klastrid saame, sõltub seega nii sellest, kuidas arvutame objektidevahelisi kaugusi kui ka sellest, kuidas arvutame klastrite vahelisi kaugusi ja mille alusel klastreid kokku paneme. Seda, millist meetodit valida, sõltub näiteks sellest, millise metafoori abil oma klastreid tõlgendada: kas klastrid peaksid esindama mingit tüüpi, ahelat, ringi vm. Meie eeldame, et erinevate konstruktsioonide klastrid esindavad mingisuguseid põhjustatud sündmuse väljendamise tüüpe, millel on tugevad prototüübid ja mingisugune hajusam ääreala, seetõttu sobib selle jaoks just Wardi meetod. Loe eri meetodite ja nende kasutamise kohta rohkem siit ja siit.
Võime funktsiooni hclust() asemel kasutada ka funktsiooni agnes() paketist cluster (aglomeratiivse hierarhilise klasterdamise jaoks), mis töötab üldjoontes samamoodi, ent annab üheks väljundiks ka koefitsiendi, mis väljendab, kui tugeva klastristruktuuri mingi meetod suudab leida. Mida lähemal on koefitsiendi väärtus 1-le, seda tugevam ja selgem on see struktuur ja seda paremini meetod andmetele sobib.
# ward
df_clust_ward <- cluster::agnes(df_dist, method = "ward")
df_clust_ward$ac
## [1] 0.6031129
# võrdleme 4 meetodit
meetod <- c("ward", "complete", "single", "average")
for(i in meetod){
cat(i, ": ", cluster::agnes(df_dist, method = i)$ac, "\n")
}
## ward : 0.6031129
## complete : 0.511594
## single : 0.3595413
## average : 0.4610116ward sobib niisiis tõepoolest kõige paremini.
Optimaalne klastrite arv
Uurime, mis oleks optimaalne klastrite arv selleks, et klastrid oleksid üksteisest võimalikult erinevad, aga klastrisiseselt võimalikult ühtsed. Seda ütleb meile klastri headus ehk silueti laius: hea klastri liikmed on üksteisega lähedased ja teiste klastrite liikmetega kauged. Keskmine silueti väärtus jääb 0 ja 1 vahele. 1 tähistab ideaalset klastrite eraldusvõimet, 0 täielikku struktuuri puudumist andmetes. Silueti laiuste võrdlemiseks saame kasutada funktsiooni silhouette() paketist cluster. Kõigepealt aga kasutame aga funktsiooni cutree(), et jagada klastripuus klastreid ümber (nii paljudesse klassidesse, kui ette anname).
# Millised grupid moodustuksid, kui jagada andmed ainult kahte klastrisse?
(K2 <- cutree(df_clust, k = 2))
## be_made_toV cause_toV get_toV get_Ved get_Ving have_V
## 1 2 1 1 2 1
## have_Ved have_Ving make_V
## 1 2 2
# Aga nelja?
cutree(df_clust, k = 4)
## be_made_toV cause_toV get_toV get_Ved get_Ving have_V
## 1 2 1 3 4 1
## have_Ved have_Ving make_V
## 3 2 2
# Kaheksasse?
cutree(df_clust, k = 8)
## be_made_toV cause_toV get_toV get_Ved get_Ving have_V
## 1 2 3 4 5 3
## have_Ved have_Ving make_V
## 6 7 8Kõige tugevamalt tunduvad olevat seotud niisiis get_toV ja have_V, kuna need jäävad alati samasse klastrisse.
Hindame nüüd siluettide laiust ehk klastrite headust, kui klastreid oleks ainult 2.
# install.packages("cluster")
library(cluster)
# individuaalsete objektide klassid, nende naabrid ja siluettide laiused
(sil2 <- silhouette(K2, df_dist))
## cluster neighbor sil_width
## [1,] 1 2 0.05618723
## [2,] 2 1 0.28628756
## [3,] 1 2 0.32627059
## [4,] 1 2 0.22127833
## [5,] 2 1 0.05590674
## [6,] 1 2 0.34858782
## [7,] 1 2 0.12700811
## [8,] 2 1 0.22812349
## [9,] 2 1 0.27071655
## attr(,"Ordered")
## [1] FALSE
## attr(,"call")
## silhouette.default(x = K2, dist = df_dist)
## attr(,"class")
## [1] "silhouette"
# loodud k (2) klastri keskmised silueti laiused
summary(sil2)
## Silhouette of 9 units in 2 clusters from silhouette.default(x = K2, dist = df_dist) :
## Cluster sizes and average silhouette widths:
## 5 4
## 0.2158664 0.2102586
## Individual silhouette widths:
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.05591 0.12701 0.22812 0.21337 0.28629 0.34859
# vrd mean(sil2[sil2[,"cluster"]==1,"sil_width"]) ja
# mean(sil2[sil2[,"cluster"]==2,"sil_width"])
# 2 klastriga mudeli keskmine silueti laius
summary(sil2)$avg.width
## [1] 0.213374
# vrd mean(sil2[,"sil_width"])Näeme, et keskmine silueti laius kahe klastriga mudeli puhul oleks ainult 0.21 ehk klastrite eristusvõime oleks võrdlemisi kehv.
Uurime siin 9 objekti ehk konstruktsiooni. Meid ei huvita üldjuhul klastrite headus siis, kui kõik objektid on eraldi klastrites (k = 9) või ühes ja samas klastris (k = 1). Seega võime võrrelda siluettide laiusi siis, kui 1 < k < 9.
# Silueti laiused 2-8 klastriga
for(arv in 2:8){ # Iga arvu kohta 2st 8ni (1, 2, ..., 8)
# leia silueti laius selle arvu klastritega
silueti_laius <- summary(silhouette(cutree(df_clust,
k = arv),
df_dist))$avg.width
# ja trüki see välja
print(paste(arv, ": ", silueti_laius))
}
## [1] "2 : 0.213374045950605"
## [1] "3 : 0.31801238884169"
## [1] "4 : 0.343473175962803"
## [1] "5 : 0.270125773269758"
## [1] "6 : 0.185943660550055"
## [1] "7 : 0.152259367617714"
## [1] "8 : 0.120618929975007"Kõige laiema silueti saaksime 4 klastriga, st et 4 klastri lahenduse puhul on klastrid üksteisest kõige erinevamad ja sisemiselt kõige sarnasemad. Joonistame oma klastripuule nende 4 klastri ümber kastid funktsiooniga rect.hclust().
Klastrite tõlgendamine
Kuidas nüüd ikkagi saada teada, mis tunnused mingit klastrit teistest täpselt eristavad? Selleks võrdleme klastrite keskmisi profiile.
Võrdleme kõigepealt paremalt 1. klastrit (get_Ved ja have_Ved) kõikide teistega.
df_props
## Mja.Anim Mja.Inanim Mtav.Anim Mtav.Inanim Syndmus.Ment Syndmus.Phys
## be_made_toV 0.96 0.04 0.90 0.10 0.14000000 0.1800000
## cause_toV 0.24 0.76 0.52 0.48 0.14000000 0.5600000
## get_toV 0.92 0.08 0.92 0.08 0.10000000 0.2800000
## get_Ved 1.00 0.00 1.00 0.00 0.02325581 0.3488372
## get_Ving 0.78 0.22 0.34 0.66 0.06000000 0.1400000
## have_V 0.96 0.04 0.88 0.12 0.20000000 0.1600000
## have_Ved 1.00 0.00 1.00 0.00 0.02000000 0.4400000
## have_Ving 0.34 0.66 0.98 0.02 0.04000000 0.5800000
## make_V 0.56 0.44 0.70 0.30 0.34000000 0.3200000
## Syndmus.Soc Eitus.No Eitus.Yes Koref.No Koref.Yes Poss.No
## be_made_toV 0.680000 0.9400000 0.06000000 1.0000000 0.0000000 1.0000000
## cause_toV 0.300000 0.9600000 0.04000000 1.0000000 0.0000000 0.9600000
## get_toV 0.620000 0.9200000 0.08000000 0.9600000 0.0400000 0.9000000
## get_Ved 0.627907 0.9767442 0.02325581 0.8604651 0.1395349 0.9302326
## get_Ving 0.800000 1.0000000 0.00000000 1.0000000 0.0000000 0.9800000
## have_V 0.640000 0.9200000 0.08000000 0.9600000 0.0400000 0.8800000
## have_Ved 0.540000 1.0000000 0.00000000 1.0000000 0.0000000 0.7400000
## have_Ving 0.380000 0.9800000 0.02000000 1.0000000 0.0000000 1.0000000
## make_V 0.340000 0.9800000 0.02000000 1.0000000 0.0000000 1.0000000
## Poss.Yes
## be_made_toV 0.00000000
## cause_toV 0.04000000
## get_toV 0.10000000
## get_Ved 0.06976744
## get_Ving 0.02000000
## have_V 0.12000000
## have_Ved 0.26000000
## have_Ving 0.00000000
## make_V 0.00000000
cutree(df_clust, k = 4) # Selle klastri number on 3
## be_made_toV cause_toV get_toV get_Ved get_Ving have_V
## 1 2 1 3 4 1
## have_Ved have_Ving make_V
## 3 2 2
# Read, kus on esimese klastri objektid
klaster3 <- df_props[c("get_Ved", "have_Ved"),]
# Kõik ülejäänud read
muud <- subset(df_props, !rownames(df_props) %in% c("get_Ved", "have_Ved"))
# Arvutame mõlema alamandmestiku kohta iga tulba keskmise proportsiooni
(kesk_props_klaster3 <- colMeans(klaster3))
## Mja.Anim Mja.Inanim Mtav.Anim Mtav.Inanim Syndmus.Ment Syndmus.Phys
## 1.00000000 0.00000000 1.00000000 0.00000000 0.02162791 0.39441860
## Syndmus.Soc Eitus.No Eitus.Yes Koref.No Koref.Yes Poss.No
## 0.58395349 0.98837209 0.01162791 0.93023256 0.06976744 0.83511628
## Poss.Yes
## 0.16488372
(kesk_props_muud <- colMeans(muud))
## Mja.Anim Mja.Inanim Mtav.Anim Mtav.Inanim Syndmus.Ment Syndmus.Phys
## 0.68000000 0.32000000 0.74857143 0.25142857 0.14571429 0.31714286
## Syndmus.Soc Eitus.No Eitus.Yes Koref.No Koref.Yes Poss.No
## 0.53714286 0.95714286 0.04285714 0.98857143 0.01142857 0.96000000
## Poss.Yes
## 0.04000000
# Arvutame kahe andmestiku keskmiste erinevuse
(erinevus <- kesk_props_klaster3-kesk_props_muud)
## Mja.Anim Mja.Inanim Mtav.Anim Mtav.Inanim Syndmus.Ment Syndmus.Phys
## 0.32000000 -0.32000000 0.25142857 -0.25142857 -0.12408638 0.07727575
## Syndmus.Soc Eitus.No Eitus.Yes Koref.No Koref.Yes Poss.No
## 0.04681063 0.03122924 -0.03122924 -0.05833887 0.05833887 -0.12488372
## Poss.Yes
## 0.12488372
# Teeme erinevustest andmetabeli nii, et
# erinevused on sorteeritud väiksemast suuremani
erinevus_df <- data.frame(diff = sort(erinevus))
erinevus_df
## diff
## Mja.Inanim -0.32000000
## Mtav.Inanim -0.25142857
## Poss.No -0.12488372
## Syndmus.Ment -0.12408638
## Koref.No -0.05833887
## Eitus.Yes -0.03122924
## Eitus.No 0.03122924
## Syndmus.Soc 0.04681063
## Koref.Yes 0.05833887
## Syndmus.Phys 0.07727575
## Poss.Yes 0.12488372
## Mtav.Anim 0.25142857
## Mja.Anim 0.32000000
library(ggplot2)
ggplot(data = erinevus_df,
aes(x = diff,
y = 1:nrow(erinevus_df))) +
geom_text(aes(label = rownames(erinevus_df),
color = diff)) +
scale_color_continuous(low = "steelblue",
high = "tomato3") +
theme_bw() +
labs(y = "",
x = "muud <------> klaster 3",
title = "3. klastrit eristavad tunnused",
subtitle = "(mida punasem, seda omasem 3. klastrile)") +
xlim(c(-0.4, 0.4))
Tundub, et 3. klastrit iseloomustab see, et nendes kahes konstruktsioonis on võrreldes teiste konstruktsioonidega eriti sagedasti nii mõjutaja kui ka mõjutatav elusad referendid (st inimesed, organisatsioonid vm elusana ja tahtlikult tegutsevana tajutavad olendid).
Võime leida ka konstruktsioonide ja kõige tugevamalt seotud tunnuse vahelise seosekordaja. Selleks teeme konstruktsioonide tulbast faktori, milles kolmanda klastri konstruktsioonide (get_Ved ja have_Ved) asemel on “1” ja kõikide teiste konstruktsioonide asemel “2”. Seejärel arvutame selle faktori ja tugevamalt seotud tunnuste vahel Craméri V seosekordaja.
klaster3 <- ifelse(caus$Konstr %in% c("get_Ved", "have_Ved"), 1, 2)
t3_Mja <- table(klaster3, caus$Mja)
vcd::assocstats(t3_Mja)
## X^2 df P(> X^2)
## Likelihood Ratio 62.148 1 3.2196e-15
## Pearson 39.830 1 2.7708e-10
##
## Phi-Coefficient : 0.3
## Contingency Coeff.: 0.287
## Cramer's V : 0.3
t3_Mtav <- table(klaster3, caus$Mtav)
vcd::assocstats(t3_Mtav)
## X^2 df P(> X^2)
## Likelihood Ratio 46.958 1 7.2506e-12
## Pearson 29.179 1 6.5985e-08
##
## Phi-Coefficient : 0.257
## Contingency Coeff.: 0.249
## Cramer's V : 0.257Võime teha joonise ka kõigi 4 klastri kohta.
# klastrite jaotus 4ks (optimaalne jaotus)
K4 <- cutree(df_clust, k = 4)
# tühi andmetabel
erinevused_df <- data.frame(tunnus = as.character(), # tunnuse tulp
konstr = as.character(), # konstruktsioonide tulp
diff = as.numeric(), # erinevuste tulp
y = as.numeric(), # y-koordinaatide tulp
stringsAsFactors = FALSE) # ära muuda teksti faktoriteks
for(klaster in 1:4){ # iga arvu kohta 1st 4ni (1, 2, 3, 4)
konstr_klaster <- names(K4[K4 == klaster]) # leia K4-objektist selle arvuga klastrisse kuuluvad konstr-d
klasterk <- df_props[konstr_klaster,] # võta välja df_props profiilide maatriksist konstr-de read
klastermuud <- subset(df_props, !rownames(df_props) %in% konstr_klaster) # võta välja kõik muud read
erinevus_df <- data.frame(diff = sort(colMeans(klasterk)-colMeans(klastermuud))) # leia profiilide erinevused
erinevus_df$y <- 1:nrow(erinevus_df) # lisa tulp y-koordinaatidega (1st 13ni)
erinevus_df$tunnus <- rownames(erinevus_df) # lisa tulp tunnuse nimedega
erinevus_df$konstr <- paste(konstr_klaster, collapse = ", ") # lisa tulp klastrisse kuuluvate konstruktsioonidega
erinevused_df <- rbind(erinevused_df, erinevus_df) # kleebi andmestiku read suurde (algul tühja) andmetabelisse
}
summary(erinevused_df)
## diff y tunnus konstr
## Min. :-0.556667 Min. : 1 Length:52 Length:52
## 1st Qu.:-0.069462 1st Qu.: 4 Class :character Class :character
## Median : 0.005892 Median : 7 Mode :character Mode :character
## Mean : 0.000000 Mean : 7
## 3rd Qu.: 0.078364 3rd Qu.:10
## Max. : 0.556667 Max. :13
ggplot(data = erinevused_df) +
geom_text(aes(x = diff, # x-teljele erinevused
y = y, # y-teljele 1:13 (tasemete arv)
label = tunnus, # tekst tunnuse taseme järgi
color = diff)) + # värv erinevuse suuruse järgi
facet_wrap("konstr") + # paneelid vastavalt klastrile
scale_color_continuous(low = "steelblue", # väikesed väärtused sinisega
high = "tomato3") + # suured väärtused punasega
theme_bw() +
theme(axis.text.y = element_blank(), # kustuta y-telje tekst
axis.ticks.y = element_blank()) + # kustuta y-telje punktid
labs(y = "",
x = "Klastrite keskmiste profiilide erinevused",
title = "Klastreid eristavad tunnused",
subtitle = "(mida punasem, seda omasem vastavale klastrile)")
Klastrite valideerimine
Kui stabiilne meie 4 klastriga lahendus on? Selle kontrollimiseks peame klastreid valideerima. Valideerimiseks kasutame jälle juhuslikke bootstrap-valimeid.
Transponeerime esmalt andmestiku funktsiooniga t() nii, et konstruktsioonide profiilid on ridade asemel tulpades.
df_transp <- t(df_props)
df_transp
## be_made_toV cause_toV get_toV get_Ved get_Ving have_V have_Ved
## Mja.Anim 0.96 0.24 0.92 1.00000000 0.78 0.96 1.00
## Mja.Inanim 0.04 0.76 0.08 0.00000000 0.22 0.04 0.00
## Mtav.Anim 0.90 0.52 0.92 1.00000000 0.34 0.88 1.00
## Mtav.Inanim 0.10 0.48 0.08 0.00000000 0.66 0.12 0.00
## Syndmus.Ment 0.14 0.14 0.10 0.02325581 0.06 0.20 0.02
## Syndmus.Phys 0.18 0.56 0.28 0.34883721 0.14 0.16 0.44
## Syndmus.Soc 0.68 0.30 0.62 0.62790698 0.80 0.64 0.54
## Eitus.No 0.94 0.96 0.92 0.97674419 1.00 0.92 1.00
## Eitus.Yes 0.06 0.04 0.08 0.02325581 0.00 0.08 0.00
## Koref.No 1.00 1.00 0.96 0.86046512 1.00 0.96 1.00
## Koref.Yes 0.00 0.00 0.04 0.13953488 0.00 0.04 0.00
## Poss.No 1.00 0.96 0.90 0.93023256 0.98 0.88 0.74
## Poss.Yes 0.00 0.04 0.10 0.06976744 0.02 0.12 0.26
## have_Ving make_V
## Mja.Anim 0.34 0.56
## Mja.Inanim 0.66 0.44
## Mtav.Anim 0.98 0.70
## Mtav.Inanim 0.02 0.30
## Syndmus.Ment 0.04 0.34
## Syndmus.Phys 0.58 0.32
## Syndmus.Soc 0.38 0.34
## Eitus.No 0.98 0.98
## Eitus.Yes 0.02 0.02
## Koref.No 1.00 1.00
## Koref.Yes 0.00 0.00
## Poss.No 1.00 1.00
## Poss.Yes 0.00 0.00Seejärel kasutame transponeeritud andmestikul funktsiooni pvclust() samanimelisest paketist, et vaadata, kui kindel saab olla selles, klaster ka päriselt andmetes eksisteerib. Selleks võetakse algandmetest hulk juhuslikke valimeid (10 erineva suurusega, sh originaalandmestikust ka väiksemaid ja suuremaid valimeid) ning kontrollitakse, kui tõenäoline on, et saame klastrid ka nendes valimites.
# install.packages("pvclust")
library(pvclust)
set.seed(123)
pvc <- pvclust(df_transp, method.hclust = "ward.D2", method.dist = "canberra")
## Bootstrap (r = 0.46)... Done.
## Bootstrap (r = 0.54)... Done.
## Bootstrap (r = 0.69)... Done.
## Bootstrap (r = 0.77)... Done.
## Bootstrap (r = 0.85)... Done.
## Bootstrap (r = 1.0)... Done.
## Bootstrap (r = 1.08)... Done.
## Bootstrap (r = 1.15)... Done.
## Bootstrap (r = 1.23)... Done.
## Bootstrap (r = 1.38)... Done.
plot(pvc, hang = -1)
Klastrite kohal on näha kaks väärtust - Approximately Unbiased p-value (au) ja Bootstrap Probability (bp) -, mis näitavad natuke erinevaid tõenäosusi (protsentides), et saaksime samad klastrid ka teistes valimites. AU-d peetakse siinkohal täpsemaks näitajaks. get_Ved ja have_Ved on seega üsna tugev klaster (p = 94%), mille suure tõenäosusega leiaksime ka mõnest teisest valimist. Umbes 10% eksimisvõimalusega leiaksime ka klastrid get_toV ja have_V ning cause_to_V, have_Ving ja make_V.
Kordamisküsimused
1. Wardi meetod on
- meetod klastritevahelise kauguse arvutamiseks
- meetod objektidevahelise kauguse arvutamiseks
- meetod klastrite visualiseerimiseks
2. Canberra meetod on
- meetod klastritevahelise kauguse arvutamiseks
- meetod objektidevahelise kauguse arvutamiseks
- meetod klastrite visualiseerimiseks
3. Sisendandmete normaliseerimine on vajalik
- puuduvate väärtuste eemaldamiseks
- erinevatel skaaladel tunnuste võrdlemiseks
- klastrite visualiseerimiseks
4. Hierarhiline aglomeratiivne klasterdamine
- annab algoritmile ette, kui mitmesse klastrisse objekte klasterdada
- alustab seisust, kus kõik objektid on ühes klastris
- alustab seisust, kus kõik objektid on eraldi klastris
Järgmisel korral
- R Markdown