---
title: "Parciális rangsorok képzése hagyományos modell-, illetve adatredukciós módszerek alapján"
output:
  html_document:
    highlight: haddock
    theme: lumen
    toc: yes
    toc_float:
      collapsed: no
  html_notebook:
    fig_caption: yes
    highlight: haddock
    theme: lumen
    toc: yes
    toc_float:
      collapsed: no
  pdf_document:
    keep_tex: yes
    latex_engine: lualatex
    toc: yes
  word_document:
    toc: yes
---

1. Munkamenet (Tartalomjegyzék)
  + Szükséges függvénykönyvtárak beolvasása
  + Függvénykönyvtárak hivatkozásai
  + Szükséges adatok beolvasása
2. Kétlépéses klaszterezhetőség vizsgálata 
  + Indikátorok (oszlopok) klaszterezhetősége
    + Hopkins mutató számítása
    + Hierarchikus klaszterezés az indikátorok esetében
    + Többdimenziós skálázás alkalmazása az indikátorokra
  + Országok (sorok) klaszterezhetősége
    + Hopkins mutató számítása
    + Hierarchikus klaszterezés az indikátorok esetében
    + Többdimenziós skálázás alkalmazása az indikátorokra
3. Modellredukció
  + Főkomponens-elemzés
    + R (erőforrások) főkomponens meghatározása
    + E (környezet) főkomponens meghatározása
    + C (kapcsolatok) főkomponenes meghatározása
    + O (kiment) főkomponenes meghatározása
    + Korrelációs vizsgálat a főkomponensekre vonatkozóan
  + Faktor-elemzés
4. Adatredukció
  + A faktorok 3 klaszterbe rendezése
  + A faktorok 4 klaszterbe rendezése
5. Parciális rangsorok meghatározása
  + Rangsorok közti korreláció 3 klaszter esetén
  + Rangsorok közti korreláció 4 klaszter esetén
6. Összegzés

#1. Szükséges függvénykönyvtárak és adatok betöltése

##Szükséges függvénykönyvtárak beolvasása
```{r, warning=FALSE, message=FALSE}
#Korreláció-elemzés/megjelenítés
library(corrgram) #Korrelogram
library(corrplot) #Korreláció-ábra
source("http://www.sthda.com/upload/rquery_cormat.r") #Fejlett 2D-ábrák

#Faktor- és főkomponenselemzés, többdimenziós skálázás
library(psych) #Faktorelemzés, főkomponens-elemzés
library(factoextra) #További távolság/hasonlóság-mértékek
library(MASS) #isoMDS=többdimenziós skálázás

#Klaszterelemzés, klaszterezettség-elemzés
library(fclust) #VAT klaszterek
library(clustertend) #VAT, Hopkins mutatók
library(cluster) #Klaszterek kirajzolása
library(fpc) #Klaszterstatisztikák
library(mclust) #Többlépcsős klaszterelemzés

#Összetett modellek számítása, megjelenítése
library(lavaan) #CFA, SEM modellek számítása
library(semPlot) #Összetett modellek megjelenítése

#További statisztikai függvénykönyvtárak
library(Hmisc) #Fejlett statisztikai módszerek
library(seriation) #Sorbarendezés, szeriáció

#Adattranszformáció, táblázatmegjelenítés
library(reshape2) #Adattranszformáció
library("dplyr", character.only = TRUE) #Adattranszformáció
library(knitr) #Formázott táblázatok megjelenítése

#Térképes megjelenítés
library(maps) #Megjelenítés térképeken
library(mapdata) #Megjelenítés térképeken
library(maptools) #Megjelenítés térképeken

#Interaktív és 3D megjelenítések
library(shiny) #Interaktív megjelenítés
library(htmltools) #Interaktív megjelnítés
library(rgl) #3D megjelenítés
library(rglwidget) #3D interaktív megjelenítés
library(ggplot2) #Interaktív ábrák megjelenítése
library(ggrepel) #Interaktív ábrák megjelenítése
library(ggdendro) #Dendogram megjelenítése
library(d3heatmap) #Interaktív hőtérkép
library(igraph) #Gráf-megjelenítés
library(ggsci) #Simpson-paletta
```

Hivatkozások

```{r, warning=FALSE, message=FALSE}
#Korreláció-elemzés/megjelenítés
print(citation("corrgram"),style="text") #Korrelogram
print(citation("corrplot"), style ="text") #Korreláció-ábra


#Faktor- és főkomponenselemzés, többdimenziós skálázás
print(citation("psych"),style="text") #Faktorelemzés, főkomponens-elemzés
print(citation("factoextra"),style="text") #További távolság/hasonlóság-mértékek
print(citation("MASS"),style="text") #isoMDS=többdimenziós skálázás

#Klaszterelemzés, klaszterezettség-elemzés
print(citation("fclust"),style="text") #VAT klaszterek
print(citation("clustertend"),style="text") #VAT, Hopkins mutatók
print(citation("cluster"),style="text") #Klaszterek kirajzolása
print(citation("fpc"),style="text") #Klaszterstatisztikák
print(citation("mclust"),style="text") #Többlépcsős klaszterelemzés

#Összetett modellek számítása, megjelenítése
print(citation("lavaan"),style="text") #CFA, SEM modellek számítása
print(citation("semPlot"),style="text") #Összetett modellek megjelenítése

#További statisztikai függvénykönyvtárak
print(citation("Hmisc"),style="text") #Fejlett statisztikai módszerek
print(citation("seriation"),style="text") #Sorbarendezés, szeriáció

#Adattranszformáció, táblázatmegjelenítés
print(citation("reshape2"),style="text") #Adattranszformáció
print(citation("dplyr"),style="text") #Adattranszformáció
print(citation("knitr"),style="text") #Formázott táblázatok megjelenítése

#Térképes megjelenítés
print(citation("maps"),style="text") #Megjelenítés térképeken
print(citation("mapdata"),style="text") #Megjelenítés térképeken
print(citation("maptools"),style="text") #Megjelenítés térképeken

#Interaktív és 3D megjelenítések
print(citation("shiny"),style="text") #Interaktív megjelenítés
print(citation("htmltools"),style="text") #Interaktív megjelnítés
print(citation("rgl"),style="text") #3D megjelítés
print(citation("rglwidget"),style="text") #3D interaktív megjelenítés
print(citation("ggplot2"),style="text") #Interaktív ábrák megjelnítése
print(citation("ggrepel"),style="text") #Interaktív ábrák megjelnítése
print(citation("ggdendro"),style="text") #Dendogram megjelenítése
print(citation("d3heatmap"),style="text") #Interaktív hőtérkép
print(citation("igraph"),style="text") #Gráf-megjelenítés
print(citation("ggsci"),style="text") #Simpson-paletta
```

##Szükséges adatok beolvasása

Jelen html-ben az eredeti U21 adatokat használjuk.

```{r, warning=FALSE, message=FALSE}
load("U21_2014.RData")
rownames(U21_rank) <- rownames(U21_filtered)
orig_mtx <- as.matrix(U21_filtered)
#U21_filtered: 50 x 24 dataframe, amely az eredeti 2014-es U21-es adatokat tartalmazza
#U21_rank: 50 x 1 mátrix (vektor) U21 rangsor
#orig_mtx: 50 x 24 mátrix, eredeti U21 indikátorok az 50 országra
```

#2. Kétlépéses klaszterezhetőség vizsgálata

Első lépésként megvizsgáljuk, hogy az adatok alkalmasak-e a klaszterezésre. A klaszterezhetőséget mind a változók, mind pedig az országok esetében ellenőrizni kell.

##Indikátorok (oszlopok) klaszterezhetősége

###Hopkins mutató számítása

A klaszterezhetőség ellenőrzésében a *Hopkins mutató (H)* nyújt segítséget. Ha a *Hopkins mutató (H)* nagyobb, mint 0,5, akkor nem érdemes klaszterezni.
A változók klaszterezésénél a *Spearman-korrelációt* választjuk hasonlósági, az *1-Spearman-korrelációt* távolsági mutatónak, mivel a rangkorreláció nem lineáris kapcsolatokat is kimutat.

```{r,warning=FALSE, message=FALSE}
vars <- U21_filtered[,c("R1","R2","R3","R4","R5","E1","E2","E3","E4","C1","C2","C3","C4","C5","C6","O1","O2","O3","O4","O5","O6","O7","O8","O9")]
rownames(vars)<-rownames(U21_filtered)
countries<-t(vars)
colnames(countries) <- rownames(U21_filtered)

 dist.m<-1-cor(vars,method="spearman")
print(paste("H:= ",hopkins(dist.m, n=nrow(dist.m)-1, byrow = F, header = F)))
```

Mivel a Hopkins mutató kisebb, mint 0,5, ezért a változókat lehet klaszterezni.

Következő lépésként a klaszterek előzetes számának meghatározása érdekében kirajzoltatjuk a klaszterezettséget.
```{r, warning=FALSE, message=FALSE, fig.width = 7, fig.height = 5, fig.cap="**1. ábra** A változók klaszterezettsége"}
#Klaszterezettség meghatározása
clustend <- get_clust_tendency(scale(dist.m), nrow(dist.m)-1)
#Klaszterezettség kirajzolása
clustend$plot + 
  scale_fill_gradient(low = "yellow", high = "blue")
```

Az **1. ábra** alapján (ahol az adatmátrix cellái azok értékeinek nagysága szerint színezettek) 2-4 klaszter (ami itt indikátor csoport) meghatározása valószínűsíthető, de ezt további vizsgálatoknak kell megerősítenie.

###Hierarchikus klaszterezés az indikátorok esetében

A következő lépésként hierarchikus klaszterezést alkalmazunk az indikátorokra vonatkozóan. A klaszterezés eredménye a **2. ábrán** látható.

```{r,  warning=F, message=FALSE,fig.width = 7, fig.height = 5, fig.cap="**2. ábra** A hierarchikus klaszterezés eredménye az indikátorok esetében"}
hc <- hclust(dist(dist.m), method = "complete")
hcdata <- dendro_data(hc, type="rectangle")
o.cols <- hcdata$labels$label
ggplot(hcdata$segments) + 
  geom_segment(aes(x = x, y = y, xend = xend, yend = yend))+
  geom_text(data = hcdata$labels, aes(x, y, label = label), 
            hjust = 1.3, vjust=0.5, size = 4) +
  labs(x="", y="", title="A hierarchikus klaszterezés eredménye az indikátorok esetében") + 
  theme_bw() + 
  theme(plot.title = element_text(hjust = 0.5),
        axis.text.x = element_blank(),
        axis.text.y = element_blank()) +
  coord_flip()
```

A hierarchikus klaszterezés is 2-4 klaszter (ebben az esetben indikátorcsoport) meglétét valószínűsíti.
A távolságmátrix megjelenítése további segítséget nyújt a klaszterek számának meghatározásában. A **3. ábrán** az indikátorokra vonatkozó távolságmátrix látható, ahol a kék cellák -1-hez közeli értékeket, míg a sötétvörös cellák 1-hez közeli értékeket jelentenek.
```{r, message=FALSE,warning=FALSE, fig.width = 5, fig.height = 5, fig.cap="**3. ábra** Távolságmátrix az indikátorok esetében"}
cormat <- rquery.cormat(dist.m, graphType="heatmap")
```

Henning (2015) kritériumai alapján a klaszterek meghatározásánál az alábbi szempontok szerint kell eljárni.
[Henning (2015)](https://arxiv.org/abs/1503.02059) (7. oldal) -- Csak a klaszterek számára vonatkozó kritériumok szerepelnek a listában.

1. Klasztereken belül az átlagos távolság (dissimilarity) alacsony legyen.
2. Klaszterek között az átlagos távolság (dissimilarity) nagy legyen.
6. A klaszterek stabilak (többszöri újrafuttás után sem kapunk lényegesen különböző eredményeket).
12. A klaszterek körülbelül hasonló elemszámúak legyenek.
13. A klaszterek száma alacsony.

A következő lépésben összehasonlítjuk azokat az eseteket, amikor 2, 3 illetve 4 klasztert alakítunk ki a változókra vonatkozóan.
```{r, warning=FALSE, message=FALSE}
cluster.stats(dist.m,cutree(hc, k=2))
cluster.stats(dist.m,cutree(hc, k=3))
cluster.stats(dist.m,cutree(hc, k=4))
```

A fenti eredmények alapján azonban nem lehet eldönteni, hogy mennyi (2, 3  vagy 4) klaszter képezhető az indikátorokon. Tehát a klaszterek értelmezhetősége fog erről dönteni.

###Többdimenziós skálázás alkalmazása az indikátorokra

A klaszterek értelmezhetőségének vizsgálatára a következő lépésben a többdimenziós skálázást alkalmazzuk az indikátorokra vonatkozóan. Elsőként két klasztert alakítunk ki, az erre vonatkozó eredmények a **4. ábrán** láthatók.
```{r, warning=F, message=F, fig.cap="**4. ábra** Többdimenziós skálázás az indikátorokra vonatkozóan - 2 klaszter esetén"}
mds.isomds <- isoMDS(dist(dist.m), tol=1e-3, k=10, maxit = 200)

plotdata <- mds.isomds$points
plotdata <- as.data.frame(plotdata)
plotdata$names <- rownames(mds.isomds$points)
plotdata$cut <- cutree(hc, k=2)
ggplot(plotdata, aes(V1, V2, label=names)) + 
  geom_point(aes(colour=factor(cut)), size=2.3) +
  geom_text_repel(aes(colour=factor(cut)), size=4) + 
  scale_colour_discrete(name = "Klaszterek") +
  labs(x="", y="", title="Többdimenziós skálázás az indikátorokra vonatkozóan - 2 klaszter") + theme_bw()
```

Ahogy az a **4. ábrán** is látszik, a két klaszter nehezen értelmezhető. Az első klaszterbe 19 indikátor került, míg a másodikba csak 3. 

Az **5. ábrán** a többdimenziós skálázás eredménye látható abban az esetben, ha 3 klasztert hozunk létre. 
```{r, warning=F, message=F, fig.cap="**5. ábra** Többdimenziós skálázás az indikátorokra vonatkozóan - 3 klaszter esetén"}
mds.isomds <- isoMDS(dist(dist.m), tol=1e-3, k=10, maxit = 200)

plotdata <- mds.isomds$points
plotdata <- as.data.frame(plotdata)
plotdata$names <- rownames(mds.isomds$points)
plotdata$cut <- cutree(hc, k=3)
ggplot(plotdata, aes(V1, V2, label=names)) + 
  geom_point(aes(colour=factor(cut)), size=2.3) +
  geom_text_repel(aes(colour=factor(cut)), size=4) + 
  scale_colour_discrete(name = "Klaszterek") +
  labs(x="", y="", title="Többdimenziós skálázás az indikátorokra vonatkozóan - 3 klaszter") + theme_bw()
```

Az **5. ábra** alapján a 3 klaszter (azaz 3 indikátorcsoport) is nehezen értelmezhető. Az első klaszterbe 15, a második klaszterbe 3, a harmadik klaszterbe pedig 6 indikátor került. A kapcsolatokat mérő indikátorok (C1, C2, C3 és C4) azonban már egy klaszterbe kerültek.

A következő lépésben megnézzük, hogy ha 4 klasztert hozunk létre, akkor hogyan alakul az indikátorok csoportosítása. Ennek eredménye a **6. ábrán** látható.

```{r, warning=F, message=F, fig.cap="**6. ábra** Többdimenziós skálázás az indikátorokra vonatkozóan - 4 klaszter esetén"}
mds.isomds <- isoMDS(dist(dist.m), tol=1e-3, k=10, maxit = 200)

plotdata <- mds.isomds$points
plotdata <- as.data.frame(plotdata)
plotdata$names <- rownames(mds.isomds$points)
plotdata$cut <- cutree(hc, k=4)
ggplot(plotdata, aes(V1, V2, label=names)) + 
  geom_point(aes(colour=factor(cut)), size=2.3) +
  geom_text_repel(aes(colour=factor(cut)), size=4) + 
  scale_colour_discrete(name = "Klaszterek") +
  labs(x="", y="", title="Többdimenziós skálázás az indikátorokra vonatkozóan - 4 klaszter'") + theme_bw()
```

Ha négy klasztert hozunk létre, akkor az első klaszterbe 5, a másodikba 10, a harmadikba 3, a negyedikbe 6 indikátor kerül. Tisztán csak a C1-C4 változókat tartalmazó kapcsolatok változócsoportja jelenik meg a negyedik klaszterben, a többi klaszter esetében nagyon vegyes az indikátorok összetétele. Négy klaszter (változócsoport) is nehezen értelmezhető, ezért szükség van a változók számának redukálására, amit például főkomponens-elemzéssel tehetünk meg. 

##Országok (sorok) klaszterezhetősége

###Hopkins mutató számítása

A klaszterezhetőség ellenőrzésében a *Hopkins mutató (H)* nyújt segítséget. Ha a *Hopkins mutató (H)* nagyobb, mint 0,5, akkor nem érdemes klaszterezni. Az országok klaszterezésénél a távolságon az Euklideszi távolságot értjük. 
```{r,warning=FALSE, message=FALSE}
vars <- U21_filtered[,c("R1","R2","R3","R4","R5","E1","E2","E3","E4","C1","C2","C3","C4","C5","C6","O1","O2","O3","O4","O5","O6","O7","O8","O9")]
rownames(vars)<-rownames(U21_filtered)
countries<-t(vars)
colnames(countries) <- rownames(U21_filtered)
dist.c<-as.matrix(dist(vars))
print(paste("H:=",hopkins(dist.c, n=nrow(dist.c)-1, byrow = F, header = F)))
```

Mivel a Hopkins mutató kisebb, mint 0,5, ezért az országokat (azaz a sorokat) lehet klaszterezni.

Következő lépésként a klaszterek előzetes számának meghatározása érdekében kirajzoltatjuk a klaszterezettséget.
```{r,warning=FALSE,message=FALSE, fig.width = 7, fig.height = 5, fig.cap="**7. ábra** Az országok klaszterezettsége"}
#Klaszterezettség
clustend <- get_clust_tendency(scale(dist.c), nrow(dist.c)-1)
#Klaszterezettség kirajzolása
clustend$plot + 
  scale_fill_gradient(low = "yellow", high = "blue")
```

A **7. ábra** alapján 3 klaszter (azaz országcsoport) valószínűsíthető, de ezt további vizsgálatoknak kell megerősítenie.

###Hierarchikus klaszterezés az országok esetében

A következő lépésként hierarchikus klaszterezést alkalmazunk az országokra vonatkozóan. A klaszterezés eredménye a **8. ábrán** látható.

```{r, warning=F, message=FALSE, fig.width = 8, fig.height = 7,fig.cap="**8. ábra** A hierarchikus klaszterezés eredménye az országok esetében"}
hc <- hclust(dist(dist.c), method = "complete")
hcdata <- dendro_data(hc, type="rectangle")
o.rows <- hcdata$labels$label

ggplot(hcdata$segments) + 
  geom_segment(aes(x = x, y = y, xend = xend, yend = yend))+
  geom_text(data = hcdata$labels, aes(x, y, label = label), 
            hjust = 1, vjust=0.7, size = 3) +
  labs(x="", y="", title="A hierarchikus klaszterezés eredménye az országok esetében") + 
  theme_bw() + 
  theme(plot.title = element_text(hjust = 0.5),
        axis.text.x = element_blank(),
        axis.text.y = element_blank()) +
  coord_flip()
```

A hierarchikus klaszterezés 3-4 klaszter (itt országcsoport) meglétét valószínűsíti.

A távolságmátrix megjelenítése további segítséget nyújt a klaszterek számának meghatározásában. A **9. ábrán** az országokra vonatkozó távolságmátrix látható, ahol a kék cellák -1-hez közeli értékeket, míg a sötétvörös cellák 1-hez közeli értékeket jelentenek.

```{r, message=FALSE,warning=FALSE, fig.width = 5, fig.height = 5, fig.cap="**9. ábra** Távolságmátrix az országok esetében"}
cormat <- rquery.cormat(dist.c, graphType="heatmap")
```

A **9. ábrán** látható távolságmátrix alapján 3-4 klaszter valószínűsíthető. A következő lépésben összehasonlítjuk azokat az eseteket, amikor 3 vagy 4 klasztert alakítunk ki az országokra vonatkozóan.

```{r, warning=FALSE, message=FALSE}
cluster.stats(dist.c,cutree(hc, k=3))
cluster.stats(dist.c,cutree(hc, k=4))
```
A fenti eredmények alapján azonban nem lehet eldönteni, hogy hány (3  vagy 4) klaszter képezhető az országokon. Tehát az országok esetében is a klaszterek értelmezhetősége fog erről dönteni.

###Többdimenziós skálázás alkalmazása az országokra

A klaszterek értelmezhetőségének vizsgálatára a következő lépésben a többdimenziós skálázást alkalmazzuk az országokra vonatkozóan. Elsőként három klasztert (azaz három országcsoportot) alakítunk ki, az erre vonatkozó eredmények a **10. ábrán** láthatók.

```{r, warning=F, message=FALSE, fig.cap="**10. ábra** Többdimenziós skálázás az országokra vonatkozóan - 3 klaszter esetén"}
mds.isomds <- isoMDS(dist(dist.c), tol=1e-3, k=10, maxit = 200)

plotdata <- mds.isomds$points
plotdata <- as.data.frame(plotdata)
plotdata$names <- rownames(mds.isomds$points)
plotdata$cut <- cutree(hc, k=3)

ggplot(plotdata, aes(V1, V2, label=names)) + 
  geom_point(aes(colour=factor(cut)), size=2.3) +
  geom_text_repel(aes(colour=factor(cut)), size=4) + 
  scale_colour_discrete(name = "Klaszterek") +
  labs(x="", y="", title="Többdimenziós skálázás az országokra vonatkozóan - 3 klaszter") + theme_bw()
```

Ahogy az a **10. ábrán** is látható, az első klaszterbe 21, a másodikba 15, a harmadikba pedig 14 ország került.

A következő lépésben megnézzük, hogy ha 4 klasztert hozunk létre, akkor hogyan alakul az országok csoportosítása. Ennek eredménye a **11. ábrán** látható.

```{r, warning=F, message=FALSE, fig.cap="**11. ábra** Többdimenziós skálázás az országokra vonatkozóan - 4 klaszter esetén"}
mds.isomds <- isoMDS(dist(dist.c), tol=1e-3, k=10, maxit = 200)

plotdata <- mds.isomds$points
plotdata <- as.data.frame(plotdata)
plotdata$names <- rownames(mds.isomds$points)
plotdata$cut <- cutree(hc, k=4)

ggplot(plotdata, aes(V1, V2, label=names)) + 
  geom_point(aes(colour=factor(cut)), size=2.3) +
  geom_text_repel(aes(colour=factor(cut)), size=4) + 
  scale_colour_discrete(name = "Klaszterek") +
  labs(x="", y="", title="Többdimenziós skálázás az országokra vonatkozóan - 4 klaszter") + theme_bw()
```

Abban az esetben, ha négy klasztert hozunk létre, akkor az első klaszterbe 21, a másodikba 11, a harmadikba 14, míg a negyedikbe 4 ország került. Az előző esethez képest (amikor három klasztert hoztunk létre) az első és a harmadik klaszterben levő országok nem változtak. A negyedik klaszterbe azok az országok kerültek (Dánia, Svédország, Svájc, Egyesült Államok), amelyek az előző esetben a második klaszterhez tartoztak. A Henning (2015) által megfogalmazott elveket leginkább 4 klaszter teljesíti. 

**Klaszterezhetőség eredménye:** Egyértelműen látszik, hogy mind a változók, mind az országok szerint lehet csoportosításokat végezni (lásd: Hopkins mutató). Ugyanakkor a kapott klaszterek értelmezhetősége meglehetősen nehézkes. A változócsoportok vegyesen tartalmaznak mutatókat, így szükség van az országok csoportosítása előtt modellredukcióra.

#3. Modellredukció

##Főkomponens-elemzés

Első lépésként a főkomponensek/faktorok (esetünkben indikátorcsoportok) számának meghatározására van szükség. Ehhez segítséget nyújt a **12. ábrán** látható könyökdiagram.
```{r, warning=FALSE, message=FALSE, fig.cap="**12. ábra** Könyökdiagram"}
scree(U21_filtered)
```
A **12. ábra** alapján a főkomponens-elemzésnél maximum 5, faktorelemzésnél maximum 3 indikátorcsoportot érdemes megtartani.

Az U21 4 fő indikátorcsoportot tartalmaz: erőforrások (R1 - R5), környezet (E1 - E4), kapcsolatok (C1 - C6) és kimenetek (O1 - O9). A főkomponens elemzés esetén érdemes kiindulni ezekből az előre meghatározott indikátorcsoportokból.  Ekkor azt várjuk, hogy 4 jól interpretálható főkomponenst kapunk, amely 4 indikátorcsoportot kódol. Az elemzés során megkapjuk, hogy az eredményül kapott főkomponensekre az eredeti változók mennyire illeszkednek jól.

###*R (erőforrások)* főkomponens meghatározása

Elsőként az *R* főkomponenst határozzuk meg, amely az R1 - R5 indikátorokat tartalmazza, azaz azokat az indikátorokat, amelyek az egyes országok erőforrásait írják le. 

```{r, warning=FALSE, message=FALSE}
Rs<-U21_filtered[,c("R1","R2","R3","R4","R5")]
KMO(cor(Rs))
fitR <- principal(Rs,nfactors=1)
summary(fitR) # print variance accounted for 
fitR$communality
pcaR <- prcomp(Rs, scale = TRUE)
eigs <- pcaR$sdev^2
varR <- eigs[1] / sum(eigs)
print(paste("Variance rate=",varR))
```
Mivel a KMO értéke nagyobb, mint 0.5, ezért a főkomponens/faktorelemzés elvégezhető. Minden kommunalitás nagyobb, mint 0.25, amely azt jelenti, hogy az eredeti változók megfelelően illeszkednek az eredményváltozóra. Továbbá, a varianciahiányad 0.5-nél nagyobb, amely azt jelenti, hogy a modellredukció után is megmarad az információ legalább 50%-a. Ezek alapján a fentebb létrehozott *R* főkomponens megfelelő, felhasználható a további elemzések során.

###*E (környezet)* főkomponens meghatározása

A következő lépésben az *E* főkomponenst hozzuk létre, amely az E1 - E4 indikátorokat tartalmazza, azaz azokat a mutatókat, amelyek a környezetet írják le.

```{r, warning=FALSE, message=FALSE}
Es<-U21_filtered[,c("E1","E2","E3","E4")]
KMO(cor(Es))
fitE <- principal(Es,nfactors=1)
summary(fitE) # print variance accounted for 
fitE$communality
pcaE <- prcomp(Es, scale = TRUE)
eigs <- pcaE$sdev^2
varE <- eigs[1] / sum(eigs)
print(paste("Variance rate=",varE))
```

A fenti eredmények alapján látható, hogy az E2 mutató esetében a kommunalitás kisebb, mint 0.25 (0.189), tehát E2 nem illeszkedik megfelelően az eredményváltozóra. Ugyanakkor, ha a következő lépésben elhagynánk E2-t, E1 esetében lenne a kommunalitás kisebb, mint 0.25. A legtöbb változó akkor őrizhető meg, ha E3 változót hagyjuk el. Így a következő lépésben elhagyjuk E3-at.

```{r, warning=FALSE, message=FALSE}
Es<-U21_filtered[,c("E1","E2","E4")]
KMO(cor(Es))
fitE <- principal(Es,nfactors=1)
summary(fitE) 
fitE$communality
pcaE <- prcomp(Es, scale = TRUE)
eigs <- pcaE$sdev^2
varE <- eigs[1] / sum(eigs)
print(paste("Variance rate=",varE))
```

E3 elhagyása után a KMO 0.5 feletti, minden változó esetében a kommunalitás nagyobb, mint 0.25. A varianciahányad értéke azonban 0.5 alatti (0.477), amely azt jelenti, hogy a modellredukció után az információ legalább 50%-a elveszik.

###*C (kapcsolatok)* főkomponens meghatározása

A következő lépésben a *C* főkomponenst hozzuk létre, amely a C1 - C6 mutatókat tartalmazza, és az országok kapcsolatait írja majd le.

```{r, warning=FALSE, message=FALSE}
Cs<-U21_filtered[,c("C1","C2","C3","C4","C5","C6")]
KMO(cor(Cs))
fitC <- principal(Cs,nfactors=1)
summary(fitC) 
fitC$communality
pcaC <- prcomp(Cs, scale = TRUE)
eigs <- pcaC$sdev^2
varC <- eigs[1] / sum(eigs)
print(paste("Variance rate=",varC))
```

C3 kommunalitása alacsonyabb, mint 0.25, tehát nem illeszkedik a főkomponensre, ezért ezt a mutatót a következő lépésben elhagyjuk.

```{r, warning=FALSE, message=FALSE}
Cs<-U21_filtered[,c("C1","C2","C4","C5","C6")]
KMO(cor(Cs))
fitC <- principal(Cs,nfactors=1)
summary(fitC)
fitC$communality
pcaC <- prcomp(Cs, scale = TRUE)
eigs <- pcaC$sdev^2
varC <- eigs[1] / sum(eigs)
print(paste("Variance rate=",varC))
```

A megmaradt változókon a KMO értéke magasabb, mint 0.5, minden változó esetében a kommunalitás nagyobb, mint 0.25, vagyis az eredeti változók megfelelően illeszkednek az eredményváltozóra. Továbbá, a megőrzött varianciahányad is 50% feletti (0.56), tehát a modellredukció után is megmarad az eredeti információ legalább 50%-a.

###*O (kimenet)* főkomponens meghatározása

A legutolsó lépésben az *O* főkomponenst hozzuk létre, amely az O1 - O9 mutatókat tartalmazza, és az országok kimeneteit írja le.

```{r, warning=FALSE, message=FALSE}
Os<-U21_filtered[,c("O1","O2","O3","O4","O5","O6","O7","O8","O9")]
KMO(cor(Os))
fitO <- principal(Os,nfactors=1)
summary(fitO) 
fitO$communality
pcaO <- prcomp(Os, scale = TRUE)
eigs <- pcaC$sdev^2
varO <- eigs[1] / sum(eigs)
print(paste("Variance rate=",varO))
```

A fenti eredmények alapján az O1, és az O9 esetében is a kommunalitás alacsonyabb, mint 0.25, ugyanakkor a varianciahányad megfelelő (0.56). Két lehetőség kínálkozik: egy főkomponens, vagy két faktor használata.

Elsőként 1 főkomponenst hozunk létre, amelynek az eredményei lentebb láthatók.

```{r, warning=FALSE, message=FALSE}
Os<-U21_filtered[,c("O2","O3","O4","O5","O6","O7","O8")]
KMO(cor(Os))
fitO <- principal(Os,nfactors=1)
summary(fitO)
fitO$communality
pcaO <- prcomp(Os, scale = TRUE)
eigs <- pcaC$sdev^2
varO <- eigs[1] / sum(eigs)
print(paste("Variance rate=",varO))
```

A KMO értéke nagyobb, mint 0.5, minden változó esetében a kommunalitás nagyobb, mint 0.25, a varinciahányad értéke 0.56, vagyis a modellredukció után is megmarad az eredeti információ legalább 50%-a. Két fontos mutató (O1 és O9) azonban kiesett a modellből. Az O1 mutató a felsőoktatási intézmények által publikált cikkek számát jelenti, míg az O9 a diplomás munkanélküliek aránya. Ezeket a mutatókat is érdemes és szükséges lenne megőrizni a modellredukció után.

A második lehetőség, hogy több mutatót őrizzünk meg, 2 faktor használata. 2 faktorra vonatkozó eredmények lentebb olvashatók.

```{r, warning=FALSE, message=FALSE}
Os<-U21_filtered[,c("O1","O2","O3","O4","O5","O6","O7","O8","O9")]
KMO(cor(Os))
fitO2 <- principal(Os,nfactors=2)
summary(fitO2)
fitO2$communality
fitO2$loadings
```

Ha két faktort hozunk létre, akkor valamennyi kommunalitás magasabb, mint 0.25, azonban az O5 mutatóról nem lehet megállapítani, hogy melyik faktorhoz tartozik. Ezért a következő lépésben O5-t elhagyjuk, amely az adott ország 3 legjobb egyetemének Shanghai rangsorban szereplő pontértékét mutatja.

```{r, warning=FALSE, message=FALSE}
Os<-U21_filtered[,c("O1","O2","O3","O4","O6","O7","O8","O9")]
KMO(cor(Os))
fitO2 <- principal(Os,nfactors=2)
summary(fitO2) 
fitO2$communality
fitO2$loadings
```

Ezáltal a KMO értéke nagyobb, mint 0.5, és minden mutató esetében a kommunalitás nagyobb, mint 0.25, azaz az eredeti változók megfelelően illeszkednek az eredményváltozóra. A fenti eredmények alapján a két faktor nem tartalmaz közös indikátorokat.

Az első faktorhoz tartoznak az alábbi indikátorok:

  + O2: Népességre vetített publikációk száma
  + O3: Hivatkozások átlagos száma a Karolinska Intézet normalizált impakt faktora alapján
  + O4: Shanghai TOP 500-ban szereplő intézmények pontjaival súlyozott átlag/népesség
  + O6: Felsőfokú továbbtanulási ráta
  + O7: A 24-64 éves korosztályban a diplomások aránya
  + O8: Kutatók száma/népesség
  
A második faktorhoz tartoznak az alábbi indikátorok:

  + O1: A felsőoktatási intézmények által publikált cikkek száma
  + O9: Diplomás munkanélküliek aránya a 25-64 éves korosztályban/diplomával nem, csak középfokú végzettséggel rendelkezők munkanélküliségi rátája

Így az *O* főkomponens létrehozásához képest a második faktorban mind az O1 mind pedig az O9 mutató megőrzésre került. Mivel főkomponens elemzést végeztünk R, C, E, O mutatókra, így az esetek akár korrelálhatnak is. Ezért a következő lépésben ellenőrizzük a közöttük levő korrelációt.

###Korrelációs vizsgálat a főkomponensekre vonatkozóan

A korrelációs vizsgálat eredményei a **13. ábrán** olvashatók. A **13. ábra** alapján az *R*, *O* és *C* komponensek szoros szignifikáns kapcsolatban vannak.

```{r, warning=FALSE, message=FALSE, fig.cap="**13. ábra** A főkomponensek közötti korrelációs kapcsolatok"}
factors<-cbind(fitR$scores,fitE$scores,fitC$scores,fitO$scores)
colnames(factors) <- c("R","E","C","O")
cor(factors)
corrgram(factors,order = TRUE,main="Komponensek közötti korrelációs kapcsolatok",lower.panel=panel.conf)
```

A korrelációs vizsgálatot elvégezzük az R, E, C főkomponensekre és az O első és második faktorára (O_fact1 és O_fact2) vonatkozóan. A korrelációs vizsgálat eredménye a **14. ábrán** látható.

```{r, warning=FALSE, message=FALSE,fig.cap="**14. ábra** A főkomponensek és a faktorok közötti korrelációs kapcsolatok"}
factors<-cbind(fitR$scores,fitE$scores,fitC$scores,fitO2$scores)
colnames(factors) <- c("R","E","C","O_fact1","O_fact2")
cor(factors)
corrgram(factors,order = TRUE,main="Komponensek és a faktorok közötti korrelációs kapcsolatok",lower.panel=panel.conf)
```

A **14. ábra** alapján az R, O_fact1 és C komponensek szoros szignifikáns kapcsolatban vannak. EZT NEM ÉRTEM, MEGKÉRDEZNI -->  Ugyanakkor az R, C, O_fact1 összevonása után 3 változócsoport azonosítható: az egyik, amelyet az erősen korreláló R, C, O_fact1 összevonásával kapunk, a másik az O_fact2, a harmadik az E.

##Faktorelemzés

A főkomponens-elemzés után faktorelemzést végzünk a mutatókon. Első lépésként a faktorelemzés alkalmazhatóságát vizsgáljuk, amiben a könyökdiagram kirajzoltatása nyújt segítséget.

```{r, warning=FALSE, message=FALSE, fig.cap="**15. ábra** Könyökdiagram"}
scree(U21_filtered)
KMO(cor(U21_filtered))
```
Ahogy az a **15. ábrán** látszódik, faktorelemzés esetén 3 független változócsoport használata célravezető. (Ugyanezt láttuk már a 12. ábrán is.)

```{r, warning=FALSE, message=FALSE, fig.cap="**16. ábra** A három faktor jellemzői"}
U21s<-U21_filtered[,c("R1","R2","R3","R4","R5","E1","E2", "E3", "E4","C1","C2","C3","C4","C5","C6","O1","O2","O3","O4","O5","O6","O7","O8","O9")]
fit <- principal(U21s,nfactors=3,rotate = "varimax")
summary(fit) # print variance accounted for 
fit$communality
fit$loadings
biplot(fit)
```

A 16. ábra a három faktor jellemzőit mutatja. Ahogy az a fenti eredmények alapján is látszik, alacsony kommunalitású (pl. C3) és közös indikátorok (pl. R2) is vannak a kialakult faktoroknál. Ahhoz, hogy a faktorok egymáshoz viszonyított helyzetéről, illetve az egyes faktorokhoz tartozó mutatókról átfogó képet kapjunk, célszerű a faktorok (RC1, RC2, RC3) kezdeti állapotát 3D-ben kirajzoltatni. Ez a 3D-s ábra látható a **17. ábrán**. Az ábra forgatásával láthatóvá válik, hogy az egyes mutatók hogyan csoportosulnak, mely faktorokhoz tartoznak. A fenti eredményekkel összhangban itt is látható, hogy az első faktorhoz tartozik például az R3, R4 és R5 mutató.

```{r, warning=FALSE, message=FALSE, fig.cap="**17. ábra** A három létrehozott faktor kezdeti állapota 3D-ben"}
browsable(tagList(
  plot3d(fit$loadings),main="Initial set of indicators"))
    text3d(fit$loadings,texts = rownames(fit$loadings))
    coords <- NULL
    for (i in 1:nrow(fit$loadings)) {
      coords <- rbind(coords, rbind(c(0,0,0),fit$loadings[i,]))
    }
    lines3d(coords, col="red", lwd=4)
        
rglwidget()

```


Az alacsony kommunalitású és a közös indikátorok eltávolítása után a **18. ábrán** láthatóak a három faktor jellemzői. 

```{r, warning=FALSE, message=FALSE, fig.cap="**18. ábra** A végső faktorstruktúra jellemzői"}
columns<-c("R3","R4","R5","E1","E2","C1","C5","C6","O1","O4","O8","O9")
U21s<-U21_filtered[,columns]
KMO(cor(U21s))
fit <- principal(U21s,nfactors=3,rotate = "varimax")
summary(fit) 
fit$communality
fit$loadings

biplot(fit)
```

A **19. ábrán** pedig a végső három faktor egymáshoz viszonyított állapota, illetve az egyes faktorokhoz tartozó mutatók láthatók 3D-ben.

```{r, warning=FALSE, message=FALSE, fig.cap="**19. ábra** A végső három faktor állapota 3D-ben"}
browsable(tagList(
  plot3d(fit$loadings)))
text3d(fit$loadings,texts = rownames(fit$loadings))
coords <- NULL
for (i in 1:nrow(fit$loadings)) {
  coords <- rbind(coords, rbind(c(0,0,0),fit$loadings[i,]))
}
lines3d(coords, col="red", lwd=4)
rglwidget()
```

A fenti 3D-s ábra szemlélteti a három egymástól jól elkülöníthető mutatócsoportot.

A **20. ábrán** látható a struktúramodell, amely grafikusan mutatja, hogy mely mutatók mely faktorhoz tartoznak. Az ábrán a nyilak vastagsága és erőssége azt szemlélteti, hogy az egyes mutatók mennyiben járulnak hozzá az adott faktorhoz.

Az első faktorhoz (*f1*) tartoznak az alábbi mutatók:

  + R3: Éves összes kiadás dollárban/hallgató (nappali tagozatos egyenértékben számolva)
  + R4: Felsőoktatás K+F kiadásai a GDP százalékában
  + R5: Felsőoktatás K+F kiadásai/népesség
  + C1: Nemzetközi hallgatók aránya
  + C5: Tudástranszfer az egyetemek és az üzleti vállalkozások között
  + C6: Egyetemi és ipari szereplők közösen publikált cikkeinek aránya
  + O4: Shanghaj TOP 500-ban szereplő intézmények pontjaival súlyozott átlag/népesség
  + O8: Kutatók száma/népesség
  
A második faktorhoz (*f2*) tartoznak az alábbi indikátorok:

  + E1: Női hallgatók aránya
  + E2: Női oktatók aránya a felsőoktatásban
  
A harmadik faktorhoz (*f3*) tartoznak az alábbi mutatók:

  + O1: A felsőoktatási intézmények által publikált cikkek száma
  + O9: Diplomás munkanélküliek aránya a 25-64 éves korosztályban / diplomával nem, csak középfokú végzettséggel rendelkezők munkanélküliségi rátája

Az első faktor (*f1*) egyaránt tartalmaz kiadás-jellegű, kapcsolatokra vonatkozó, illetve output-jellegű mutatókat. A második faktor (*f2*) a nők szerepét mutatja a felsőoktatásban, a harmadik faktor (*f3*) pedig outputra vonatkozó indikátorokat tartalmaz.

```{r, warning=FALSE, message=FALSE, fig.cap="**20. ábra** A végső struktúramodell"}
model='f1=~R3+R4+R5+C1+C5+C6+O4+O8
       f2=~E1+E2
       f3=~O1+O9
       f1~~0*f2 + 0*f3
       f2~~0*f3'
fitsem <- cfa(model,U21_filtered,std.lv = TRUE)
semPaths(fitsem,residuals=FALSE,"std",edge.color = "black",color="yellow")
```

**Dimenzió-redukció összegzése:** Amennyiben cél, hogy független változócsoportokat alakítsunk ki, akkor mind a főkomponens, mind a faktorelemzéssel 3 változócsoportot definiálhatunk. Ezek közül a két "tiszta" változócsoport csak 2-2 mutatót tartalmaz, míg a harmadik vegyes csoport R, C, O mutatókból alakít ki egy csoportot. Komoly probléma, hogy a 24 indikátorból csak 12 őrződik meg.

#4. Adatredukció

##A faktorok 3 klaszterbe rendezése
A következőkben a fentebb kapott három faktort klaszterekbe rendezzük. Az előzetes klaszterezettség vizsgálat alapján 3-4 klaszter volt valószínűsíthető. Így első lépésként három klasztert hozunk létre.

```{r, warning=FALSE, message=FALSE}
set.seed(2)
km3 <- kmeans(fit$scores,3)$cluster
cluster.stats(dist(fit$scores),km3)
```

Az alábbi forgatható ábrán (**21. ábra**) három, egymástól jól elkülönülő klasztert láthatunk. Az egyes klaszterekbe tartozó országok a következők:

 | Első klaszter       | Második klaszter    | Harmadik klaszter|
 |---------------------|---------------------|------------------|
 | Ausztrália          | Argentína           | Chile            |
 | Ausztria            | Brazília            | Görögország      |
 | Belgium             | Bulgária            | India            |
 | Kanada              | Kína                | Indonézia        |
 | Dánia               | Horvátország        | Irán             |
 | Finnország          | Csehország          | Olaszország      |
 | Franciaország       | Németország         | Japán            |
 | Hong Kong           | Magyarország        | Dél-Korea        |
 | Írország            | Malajzia            | Mexikó           |
 | Izrael              | Lengyelország       | Szaúd Arábia     |
 | Hollandia           | Románia             | Tajvan           |
 | Új-Zéland           | Oroszország         | Törökország      |
 | Norvégia            | Szerbia             |                  |
 | Portugália          | Szlovákia           |                  |
 | Szingapúr           | Szlovénia           |                  |
 | Svédország          | Dél-Afrika          |                  |
 | Svájc               | Spanyolország       |                  |
 | Egyesült Királyság  | Thaiföld            |                  |
 |                     | Ukrajna             |                  |
 |                     | Egyesült Államok    |                  |
 
 Az első klaszterbe 18, a másodikba 20, a harmadikba pedig 12 ország került.
 
```{r, warning=FALSE, message=FALSE, fig.cap="**21. ábra** A létrehozott három klaszter"}
browsable(tagList(
  plot3d(fit$loadings)))
text3d(fit$loadings,texts = rownames(fit$loadings))
coords <- NULL
for (i in 1:nrow(fit$loadings)) {
  coords <- rbind(coords, rbind(c(0,0,0),fit$loadings[i,]))
}
lines3d(coords, col="red", lwd=4)

text3d(fit$scores,texts = rownames(U21_filtered),col=km3)
rglwidget()
```


A **22. ábrán** térképen ábrázolva láthatók, hogy mely országok kerültek egy klaszterbe. A térképen pirossal vannak jelölve azok az országok, amelyek az 1. klaszterbe, kékkel, amelyek a 2. klaszterbe, zölddel pedig azok, amelyek a 3. klaszterbe tartoznak.

```{r, warning=FALSE, message=FALSE,fig.cap="**22. ábra** A három klaszter térképen ábrázolva"}
data(wrld_simpl)
countries_km1 = wrld_simpl@data$NAME %in% c("Australia","Austria","Belgium","Canada","Denmark","Finland","France","Hon Kong","Ireland","Israel","Netherlands","New Zealand","Norway","Portugal","Singapore","Sweden","Switzerland","United Kingdom")
countries_km2 = wrld_simpl@data$NAME %in% c("Argentina","Brazil","Bulgaria","China", "Croatia", "Czech Republic", "Germany", "Hungary","Malaysia","Poland","Romania","Russia","Serbia","Slovakia","Slovenia","South Africa","Spain","Thailand","Ukraine","United States")
countries_km3 = wrld_simpl@data$NAME %in% c("Chile", "Greece", "India", "Indonesia", "Iran", "Italy", "Japan", "Mexico", "Saudi Arabia", "Taiwan", "Turkey", "Korea, Republic of")
countries_km2 = countries_km2 *2
countries_km3 = countries_km3 *3
countries_map = countries_km1+countries_km2+countries_km3+1
plot(wrld_simpl, col = c(gray(.80), "red", "blue", "green")[countries_map])

```

##A faktorok 4 klaszterbe rendezése

A következő lépésként a faktorokat 4 klaszterbe rendezzük.

```{r, warning=FALSE, message=FALSE}
set.seed(2)
km4 <- kmeans(fit$scores,4)$cluster
cluster.stats(dist(fit$scores),km4)
```

Ahogy az a **23. ábrán** látható, egymástól jól elkülönülő 4 klasztert kaptunk. Az első klaszterbe 22, a másodikba 4, a harmadikba 17, a negyedikbe pedig 7 ország került, amelyek az alábbiak:

 | Első klaszter    | Második klaszter    | Harmadik klaszter   | Negyedik klaszter |
 |------------------|---------------------|---------------------|-------------------|
 | Argentína        | Kína                | Ausztrália          | India             |
 | Brazília         | Németország         | Ausztria            | Indonézia         |
 | Bulgária         | Magyarország        | Belgium             | Irán              |
 | Chile            | Egyesült Államok    | Kanada              | Japán             |
 | Horvátország     |                     | Dánia               | Dél-Korea         |
 | Csehország       |                     | Finnország          | Tajvan            |
 | Görögország      |                     | Franciaország       | Törökország       |
 | Olaszország      |                     | Hong Kong           |                   |
 | Malajzia         |                     | Írország            |                   |
 | Mexikó           |                     | Izrael              |                   |
 | Lengyelország    |                     | Hollandia           |                   |
 | Portugália       |                     | Új-Zéland           |                   |
 | Románia          |                     | Norvégia            |                   |
 | Oroszország      |                     | Szingapúr           |                   |
 | Szaúd Arábia     |                     | Svédország          |                   |
 | Szerbia          |                     | Svájc               |                   |
 | Szlovákia        |                     | Egyesült Királyság  |                   |
 | Szlovénia        |                     |                     |                   |
 | Dél-Afrika       |                     |                     |                   |
 | Spanyolország    |                     |                     |                   |
 | Thaiföld         |                     |                     |                   |
 | Ukrajna          |                     |                     |                   |
 

```{r, warning=FALSE, message=FALSE, fig.cap="**23. ábra** A létrehozott négy klaszter"}
browsable(tagList(
  plot3d(fit$loadings)))
text3d(fit$loadings,texts = rownames(fit$loadings))
coords <- NULL
for (i in 1:nrow(fit$loadings)) {
  coords <- rbind(coords, rbind(c(0,0,0),fit$loadings[i,]))
}
lines3d(coords, col="red", lwd=4)

text3d(fit$scores,texts = rownames(U21_filtered),col=km4)
rglwidget()
```


A **24. ábrán** térképen ábrázolva látható a 4 klaszter.

```{r, warning=FALSE, message=FALSE,fig.cap="**24. ábra** A négy klaszter térképen ábrázolva"}
library(maptools)
data(wrld_simpl)
countries_km1 = wrld_simpl@data$NAME %in% c("Argentina","Brazil","Bulgaria","Chile","Croatia","Czech Republic","Greece", "Italy","Malaysia","Mexico","Poland","Portugal","Romania","Russia","Saudi Arabia","Serbia","Slovakia","Slovenia","South Africa","Spain","Thailand","Ukraine")
countries_km2 = wrld_simpl@data$NAME %in% c("China","Germany","Hungary","United States")
countries_km3 = wrld_simpl@data$NAME %in% c("Australia","Austria","Belgium","Canada","Denmark","Finland","France","Hong Kong", "Ireland","Israel","Netherlands","New Zealand","Norway","Singapore","Sweden","Switzerland","United Kingdom")
countries_km4 = wrld_simpl@data$NAME %in% c("India","Indonesia","Iran","Japan","Taiwan","Turkey","Korea, Republic of")
countries_km2 = countries_km2 *2
countries_km3 = countries_km3 *3
countries_km4 = countries_km4 *4
countries_map = countries_km1+countries_km2+countries_km3+countries_km4+1
plot(wrld_simpl, col = c(gray(.80), "red", "blue", "green", "orange")[countries_map])

```



#5. Parciális rangsorok meghatározása

A parciális (országklasztereken belüli) rangsorok meghatározásánál egyrészt felhasználjuk a kiszámított faktorsúlyokat, másrészt pedig az U21 által használt eredeti súlyokat.
A következő lépésben meghatározzuk az U21 által használt eredeti súlyokat.

```{r,message=FALSE,warning=FALSE}
weights=matrix(0,1,24)
colnames(weights)<-c("R1","R2","R3","R4","R5","E1","E2","E3","E4","C1","C2","C3","C4","C5","C6","O1","O2","O3","O4","O5","O6","O7","O8","O9")
weights[1,] <- c(0.05,0.05,0.05,0.025,0.025,0.02,0.02,0.02,0.14,0.04,0.04,0.02,0.02,0.04,0.04,0.13,0.03,0.03,0.03,0.03,0.03,0.03,0.03,0.03)
rownames(weights)<-c("weights")
```

A következő lépésben kiszámításra kerülnek a parciális rangsorok, amelyek az **1. táblázatban** láthatók. A táblázat utolsó két oszlopában jelzett *km3*, illetve *km4* jelzi azt, hogy az egyes országok 3, illetve 4 klaszter esetén melyik klaszterbe kerültek. Az *U21_overall_Rank* az eredeti U21 rangsor rangsorszámait tartalmazza, az *FA_Rank* a faktorscore-ok alapján képzett rangsort, az *U21_Rank_selected* pedig azokat a helyezéseket, amelyek már csak a faktoroknak megfelelő indikátorokat tartalmazzák.

```{r,warning=FALSE, message=FALSE}
base<-as.data.frame(1:nrow(U21_rank))
colnames(base)<-paste("ID")
#base$countries<-rownames(U21_rank)
base$U21_overall_Rank<-U21_rank
base$FA_weights <- as.matrix(pnorm(fit$scores[,1])*pnorm(fit$scores[,2])*pnorm(fit$scores[,3]))
base$FA_Rank<-rank(-base$FA_weights)
base$Score_selected <- rowSums(U21_filtered[,columns]*weights[,columns])*100/max(rowSums(U21_filtered[,columns]*weights[,columns]))
base$U21_Rank_selected<-rank(-base$Score_selected)
base$km3 <-km3
base$km4 <-km4
rownames(base)<-rownames(U21_rank)
kable(base, caption="**1. táblázat** Parciális rangsor")
```

A következő lépésben a rangsorok közötti rangkorrelációk kerülnek kiszámításra. 

##Rangsorok közötti korreláció 3 klaszter esetén


A **25-28. ábrák** szemléltetik a rangsorok között fennálló rangkorrelációk mértékét. A **25. ábra** az összes országra, a **26-28. ábra** külön-külön az 1-3. klaszter országaira vonatkozóan. 

Ha az összes országot vizsgáljuk (**25. ábra**), az eredeti U21 rangsor rangsorszámai (*U21_overall_Rank*) és az általunk kiszámított azon rangsor között, amely már csak az egyes faktoroknak megfelelő indikátorokat tartalmazzák (*U21_Rank_selected*) szoros pozitív kapcsolat figyelhető meg. Ez azt jelenti, hogy a két rangsorban a rangszámok hasonlóak egymáshoz. Ha csak az 1. és a 2. klaszterbe tartozó országok rangszámait vizsgáljuk, hasonló eredményt kapunk (lásd **26-27. ábra**).

```{r,warning=FALSE, message=FALSE, fig.cap="**25. ábra** A parciális rangsorok közötti rangkorrelációk három klaszter esetében - az összes országra"}
par(mfrow=c(2,2))
RANKS<-c("U21_overall_Rank","FA_Rank","U21_Rank_selected")
corrgram(base[,RANKS],cor.method = "spearman",order = TRUE,main="Összes országra",lower.panel=panel.cor)

```

```{r,warning=FALSE, message=FALSE, fig.cap="**26. ábra** A parciális rangsorok közötti rangkorrelációk három klaszter esetében - az 1. klaszter országaira"}
corrgram(base[km3==1,RANKS],cor.method = "spearman",order = TRUE,main=paste("1. klaszter országaira, ",sum(km3==1)," ország"),lower.panel=panel.cor)
```

```{r,warning=FALSE, message=FALSE, fig.cap="**27. ábra** A parciális rangsorok közötti rangkorrelációk három klaszter esetében - a 2. klaszter országaira"}
corrgram(base[km3==2,RANKS],cor.method = "spearman",order = TRUE,main=paste("2. klaszter országaira, ",sum(km3==2)," ország"),lower.panel=panel.cor)
```

```{r,warning=FALSE, message=FALSE, fig.cap="**28. ábra** A parciális rangsorok közötti rangkorrelációk három klaszter esetében - a 3. klaszter országaira"}
corrgram(base[km3==3,RANKS],cor.method = "spearman",order = TRUE,main=paste("3. klaszter országaira, ",sum(km3==3)," ország"),lower.panel=panel.cor)
```

##Rangsorok közötti korrelálció 4 klaszter esetén

A rangkorrelációk kiszámításra kerültek abban az esetben is, ha négy klasztert hozunk létre. Az 1.,2. és 3. klaszter esetében közepesen szoros kapcsolat van az eredeti U21-es rangszámok, és az általunk kiszámításra került rangszámok között. 

```{r,warning=FALSE, message=FALSE, fig.cap="**29. ábra** A parciális rangsorok közötti rangkorrelációk négy klaszter esetében - az 1. klaszter országaira"}
par(mfrow=c(2,2))
RANKS<-c("U21_overall_Rank","FA_Rank","U21_Rank_selected")
corrgram(base[km4==1,RANKS],cor.method = "spearman",order = TRUE,main=paste("1. klaszter országaira, ",sum(km4==1)," ország"),lower.panel=panel.cor)
```

```{r,warning=FALSE, message=FALSE, fig.cap="**30. ábra** A parciális rangsorok közötti rangkorrelációk négy klaszter esetében - a 2. klaszter országaira"}
corrgram(base[km4==2,RANKS],cor.method = "spearman",order = TRUE,main=paste("2. klaszter országaira, ",sum(km4==2)," ország"),lower.panel=panel.cor)
```

```{r,warning=FALSE, message=FALSE, fig.cap="**31. ábra** A parciális rangsorok közötti rangkorrelációk négy klaszter esetében - a 3. klaszter országaira"}
corrgram(base[km4==3,RANKS],cor.method = "spearman",order = TRUE,main=paste("3. klaszter országaira, ",sum(km4==3)," ország"),lower.panel=panel.cor)
```

```{r,warning=FALSE, message=FALSE, fig.cap="**32. ábra** A parciális rangsorok közötti rangkorrelációk négy klaszter esetében - a 4. klaszter országaira"}
corrgram(base[km4==4,RANKS],cor.method = "spearman",order = TRUE,main=paste("4. klaszter országaira, ",sum(km4==4)," ország"),lower.panel=panel.cor)
```

#6. Összegzés

A következőkben összefoglaljuk a kétlépéses klaszterezés eredményeit.

```{r,warning=FALSE, message=FALSE}
MTX3<-as.data.frame(matrix(0,nrow(U21_filtered),ncol(U21_filtered)))
MTX4<-as.data.frame(matrix(0,nrow(U21_filtered),ncol(U21_filtered)))
rownames(MTX3)<-rownames(U21_filtered)
colnames(MTX3)<-colnames(U21_filtered)
rownames(MTX4)<-rownames(U21_filtered)
colnames(MTX4)<-colnames(U21_filtered)
MTX3[,columns]<-km3
MTX4[,columns]<-km4
cols<-c('0'="#FFFFFF",'1'="#99FF66",'2'="#66FF33",'3'="#33CC00",'4'="#009900")
SER3<-c(seriate(dist(as.matrix(MTX3))),seriate(dist(t(as.matrix(MTX3)))))
SER4<-c(seriate(dist(as.matrix(MTX4))),seriate(dist(t(as.matrix(MTX4)))))
ORDERED3<-MTX3[get_order(SER3,dim=1),get_order(SER3,dim=2)]
ORDORIG3<-U21_filtered[get_order(SER3,dim=1),get_order(SER3,dim=2)]
ORDERED4<-MTX4[get_order(SER4,dim=1),get_order(SER4,dim=2)]
ORDORIG4<-U21_filtered[get_order(SER4,dim=1),get_order(SER4,dim=2)]
rownames(ORDERED3)<-rownames(MTX3[get_order(SER3,dim=1),get_order(SER3,dim=2)])
rownames(ORDERED4)<-rownames(MTX4[get_order(SER4,dim=1),get_order(SER4,dim=2)])
rownames(ORDORIG3)<-rownames(MTX3[get_order(SER3,dim=1),get_order(SER3,dim=2)])
rownames(ORDORIG4)<-rownames(MTX4[get_order(SER4,dim=1),get_order(SER4,dim=2)])
par(mfrow=c(2,2))

```

Az alábbi, **33. ábrán** az eredeti U21-es adatok hőtérképe látható. A cellák színezése az egyes mutatókhoz tartozó értékektől függ. Minél sötétebb bordó az adott cella, annál kisebb az adott mutató értéke, minél pedig sötétebb kék a cella, annál magasabb. Az ábrán az országok a 3 klaszter szerint vannak rendezve. Lentről felfele haladva, Belgiumtól Kanadáig az 1. klaszter országai láthatók, Magyarországtól Brazíliáig a 2. klaszteré, Görögországtól Indonéziáig pedig a 3. klaszteré. 

```{r,warning=FALSE, message=FALSE, fig.cap="**33. ábra** Az eredeti U21 adatok hőtérképe - a 3 klaszter szerint rendezve"}
d3heatmap(ORDORIG3,dendrogram = "none",colors = "RdBu")
```

A **34. ábrán** a létrehozott három klaszterbe tartozó országok láthatók, illetve azok az indikátorok, amelyek a három főkomponenshez tartoznak. Azok az indikátorok amelyek egyetlen főkomponenshez sem tartoznak, sötét bordó színű cellával jelennek meg. Látható, hogy az indikátorok fele (12) kiesett az elemzés során. Az első klaszterbe tartozó országok barackszínnel, a másodikba tartozók világoskékkel, a harmadikba tartozók pedig sötétkékkel jelennek meg.

```{r,warning=FALSE, message=FALSE, fig.cap="**34. ábra** A létrehozott három klaszter"}
d3heatmap(ORDERED3,dendrogram = "none",colors = "RdBu")
```


```{r,warning=FALSE, message=FALSE, fig.cap="**35. ábra** Az eredeti U21 adatok hőtérképe - a 4 klaszter szerint rendezve"}
d3heatmap(ORDORIG4,dendrogram = "none",colors = "RdBu")
```
A **35. ábra** - a **33. ábrához** hasonlóan - mutatja az országok eredeti U21 adatainak hőtérképet, azzal a különbséggel, hogy a függőleges tengelyen felsorolt országok most nem a 3, hanem a 4 klaszternek megfelelően csoportosítottak. Lentről felfele haladva, Brazíliától Argentináig az 1. klaszter országai láthatók, Magyarországtól Németországig a 2. klaszteré, Belgiumtól Ausztriáig a 3. klaszteré,Irántól Tajvanig pedig a 4. klaszteré. 

A **36. ábrán** a négy létrehozott klaszter látható, illetve azok az indikátorok, amelyek a három főkomponenshez tartoznak. 

```{r,warning=FALSE, message=FALSE, fig.cap="**36. ábra** A létrehozott négy klaszter"}
d3heatmap(ORDERED4,dendrogram = "none",colors = "RdBu")
```

**Összegzés:** *A kétlépéses klaszterezés ilyen kevés adat esetén kétséges. Maga a módszer nem engedi meg a klaszterek átlapolódását, ugyanakkor lehet, hogy adott ország valamely tényezőiben jól, míg másokban rosszul teljesít. A klaszterezés eredményeképpen nagyon kis klasztereket is kaptunk, amelyeket nehéz elemezni, értelmezni.*


**A tanulmányhoz csatolt kiegészítő fájlok (jelen html is) tudományos célra szabadon felhasználhatók. Kérjük az ezekre való hivatkozáskor magát a Közgazdasági Szemlében megjelent tanulmányt hivatkozni.**