Príprava údajov a z-škálovanie

Na začiatku odstránime nežiaduce stĺpce a použijeme z-škálovanie (standardizáciu), aby sme zabezpečili porovnateľnosť medzi rôznymi premennými, ako sú ROE, ROA a EBITDA marža. Týmto spôsobom sa každý ukazovateľ bude počítať so strednou hodnotou 0 a štandardnou odchýlkou 1.

# Načítanie údajov
udaje <- read.csv("dataEKONOMETRIA.csv", stringsAsFactors = FALSE)

# Z-škálovanie údajov (pre premenné, ktoré budeme používať na zhlukovanie)
udaje_scaled <- scale(udaje[, c("ROE", "ROA", "EBITDAmarza")], center = TRUE, scale = TRUE)

# Priradenie názvov krajín alebo firiem (pre lepšiu interpretáciu)
rownames(udaje_scaled) <- udaje$Country

Korelačná matica

Pred tým, než vykonáme zhlukovanie, je vhodné skontrolovať koreláciu medzi premennými. Ak sú premenné silne korelované, môže to ovplyvniť výsledky zhlukovej analýzy. Zobrazíme korelačnú maticu medzi ROE, ROA a EBITDA maržou.

# Korelačná matica medzi premennými ROE, ROA a EBITDAmarza
cor_matrix <- cor(udaje_scaled)
print(cor_matrix)
                   ROE       ROA EBITDAmarza
ROE         1.00000000 0.4362056  0.05509434
ROA         0.43620558 1.0000000  0.36642146
EBITDAmarza 0.05509434 0.3664215  1.00000000

Výpočet Euklidovskej vzdialenosti

Pre hierarchickú zhlukovú analýzu budeme používať Euklidovskú vzdialenosť medzi jednotlivými firmami, aby sme určili ich podobnosť.

# Výpočet Euklidovskej vzdialenosti medzi firmami
dist_mat <- dist(udaje_scaled, method = "euclidean")

Hierarchické zhlukovanie (Wardova metóda)

Použijeme Wardovu metódu pre zhlukovanie, ktorá začína zhlukovaním jednočlenných klastrov a postupne ich spája. Táto metóda minimalizuje nárast vnútornej variability pri spájaní klastrov.

# Hierarchické zhlukovanie s Wardovou metódou

hc <- hclust(dist_mat, method = "ward.D2")

# Vykreslenie dendrogramu s vašimi dátami

plot(hc,
labels = rownames(udaje),  # použijeme názvy firiem alebo iné identifikátory zo stĺpca v dátach
main = "Hierarchical clustering of firms (Ward.D2)",
xlab = "Firms",  # alebo ak máte iný identifikátor, použite názov stĺpca
ylab = "Height",
col.main = "black",
cex.main = 1.2,  # veľkosť nadpisu
cex.lab = 1,  # veľkosť popisov osí
col.lab = "black"
)

NA
NA

Rozdelenie na klastre

# Priradenie klasterového členstva do 3 klastrov
k <- 3
klaster_membership <- cutree(hc, k = k)

# Vytvorenie tabuľky s priradením firiem do klastrov
udaje_klasters <- data.frame(
  Firma = rownames(udaje_scaled), # Použijeme priradené riadky ako názvy firiem
  Klaster = klaster_membership
)

# Zobrazenie tabuľky s priradením firiem do klastrov
print(udaje_klasters)
NA

Deskriptívne štatistiky pre každý klaster:

Po priradení firiem do klastrov je užitočné analyzovať, ako sa firmy v jednotlivých klastroch líšia na základe premenných, ktoré sme použili pri zhlukovaní (ROE, ROA, EBITDA marža).

# Vytvorenie data frame s pridaným členstvom do klastrov
udaje_with_clusters <- data.frame(
  Klaster = as.factor(klaster_membership),
  udaje_scaled
)

# Získanie priemerných hodnôt pre každú premennú v jednotlivých klastroch
descriptives <- udaje_with_clusters %>%
  group_by(Klaster) %>%
  summarise(across(where(is.numeric), ~ mean(.x, na.rm = TRUE), .names = "{.col}"))

# Zobrazenie priemerných hodnôt premenných pre jednotlivé klastre
print(descriptives)
NA

Vizualizácia klastrov pomocou grafu:

Ak chcete získať vizuálny prehľad o tom, ako sú firmy rozdelené medzi klastre, môžete vytvoriť scatter plot, ktorý zobrazuje dve premenné, napríklad ROE a ROA, a použije farby na označenie jednotlivých klastrov.

# Vizualizácia klastrov pomocou scatter plotu
library(ggplot2)

ggplot(udaje_with_clusters, aes(x = ROE, y = ROA, color = Klaster)) +
  geom_point(size = 3) +
  labs(title = "Rozdelenie firiem do klastrov (ROE vs. ROA)", 
       x = "ROE", y = "ROA") +
  scale_color_manual(values = c("red", "green", "blue")) +
  theme_minimal()

Korelačná analýza medzi premennými v rámci jednotlivých klastrov:

Môžete tiež zistiť, ako sa korelácie medzi rôznymi premennými menia v závislosti od klastrov.

# Korelačná matica v rámci jednotlivých klastrov
library(corrplot)

for (i in 1:k) {
  cluster_data <- udaje_with_clusters[udaje_with_clusters$Klaster == i, ]
  cor_matrix <- cor(cluster_data[, -1]) # Bez klasterového označenia
  corrplot(cor_matrix, method = "circle", main = paste("Korelačná matica pre klaster", i))
}

NA

Vyhodnotenie kvality klastrovej analýzy (Vnútroklastrová a medziklastrová variabilita):

# Počet pozorovaní v každom klastru
table(klaster_membership)
klaster_membership
 1  2  3 
35 10  8 
# Vypočítať variabilitu: TSS, WSS, BSS
TSS <- sum((udaje_scaled - mean(udaje_scaled))^2)
WSS <- sum(sapply(1:k, function(cluster) sum((udaje_scaled[klaster_membership == cluster,] - colMeans(udaje_scaled[klaster_membership == cluster,]))^2)))
BSS <- TSS - WSS

# Vytvorenie tabuľky variácií
variability_table <- data.frame(
  Metric = c("TSS", "WSS", "BSS"),
  Value = c(TSS, WSS, BSS)
)

print(variability_table)
NA

Analýza ukázala, že zhlukovanie pomocou Wardovej metódy umožnilo rozpoznať tri odlišné skupiny firiem na základe ich finančných ukazovateľov. Prvý klaster obsahuje firmy s nižšími hodnotami ROE a ROA, druhý klaster má stredné hodnoty týchto ukazovateľov, a tretí klaster vykazuje najvyššie hodnoty ROE a ROA, čo naznačuje vysoce výkonné firmy.

LS0tCnRpdGxlOiAiUiBOb3RlYm9vayIKb3V0cHV0OiBodG1sX25vdGVib29rCi0tLQojIFByw61wcmF2YSDDumRham92IGEgei3FoWvDoWxvdmFuaWUKCk5hIHphxI1pYXRrdSBvZHN0csOhbmltZSBuZcW+aWFkdWNlIHN0xLpwY2UgYSBwb3XFvmlqZW1lIHotxaFrw6Fsb3ZhbmllIChzdGFuZGFyZGl6w6FjaXUpLCBhYnkgc21lIHphYmV6cGXEjWlsaSBwb3Jvdm5hdGXEvm5vc8WlIG1lZHppIHLDtHpueW1pIHByZW1lbm7DvW1pLCBha28gc8O6IFJPRSwgUk9BIGEgRUJJVERBIG1hcsW+YS4gVMO9bXRvIHNww7Rzb2JvbSBzYSBrYcW+ZMO9IHVrYXpvdmF0ZcS+IGJ1ZGUgcG/EjcOtdGHFpSBzbyBzdHJlZG5vdSBob2Rub3RvdSAwIGEgxaF0YW5kYXJkbm91IG9kY2jDvWxrb3UgMS4KYGBge3J9CiMgTmHEjcOtdGFuaWUgw7pkYWpvdgp1ZGFqZSA8LSByZWFkLmNzdigiZGF0YUVLT05PTUVUUklBLmNzdiIsIHN0cmluZ3NBc0ZhY3RvcnMgPSBGQUxTRSkKCiMgWi3FoWvDoWxvdmFuaWUgw7pkYWpvdiAocHJlIHByZW1lbm7DqSwga3RvcsOpIGJ1ZGVtZSBwb3XFvsOtdmHFpSBuYSB6aGx1a292YW5pZSkKdWRhamVfc2NhbGVkIDwtIHNjYWxlKHVkYWplWywgYygiUk9FIiwgIlJPQSIsICJFQklUREFtYXJ6YSIpXSwgY2VudGVyID0gVFJVRSwgc2NhbGUgPSBUUlVFKQoKIyBQcmlyYWRlbmllIG7DoXp2b3Yga3JhasOtbiBhbGVibyBmaXJpZW0gKHByZSBsZXDFoWl1IGludGVycHJldMOhY2l1KQpyb3duYW1lcyh1ZGFqZV9zY2FsZWQpIDwtIHVkYWplJENvdW50cnkKCmBgYAojIEtvcmVsYcSNbsOhIG1hdGljYQoKUHJlZCB0w71tLCBuZcW+IHZ5a29uw6FtZSB6aGx1a292YW5pZSwgamUgdmhvZG7DqSBza29udHJvbG92YcWlIGtvcmVsw6FjaXUgbWVkemkgcHJlbWVubsO9bWkuIEFrIHPDuiBwcmVtZW5uw6kgc2lsbmUga29yZWxvdmFuw6ksIG3DtMW+ZSB0byBvdnBseXZuacWlIHbDvXNsZWRreSB6aGx1a292ZWogYW5hbMO9enkuIFpvYnJhesOtbWUga29yZWxhxI1uw7ogbWF0aWN1IG1lZHppIFJPRSwgUk9BIGEgRUJJVERBIG1hcsW+b3UuCmBgYHtyfQojIEtvcmVsYcSNbsOhIG1hdGljYSBtZWR6aSBwcmVtZW5uw71taSBST0UsIFJPQSBhIEVCSVREQW1hcnphCmNvcl9tYXRyaXggPC0gY29yKHVkYWplX3NjYWxlZCkKcHJpbnQoY29yX21hdHJpeCkKCmBgYAojIFbDvXBvxI1ldCBFdWtsaWRvdnNrZWogdnpkaWFsZW5vc3RpCgpQcmUgaGllcmFyY2hpY2vDuiB6aGx1a292w7ogYW5hbMO9enUgYnVkZW1lIHBvdcW+w612YcWlIEV1a2xpZG92c2vDuiB2emRpYWxlbm9zxaUgbWVkemkgamVkbm90bGl2w71taSBmaXJtYW1pLCBhYnkgc21lIHVyxI1pbGkgaWNoIHBvZG9ibm9zxaUuCmBgYHtyfQojIFbDvXBvxI1ldCBFdWtsaWRvdnNrZWogdnpkaWFsZW5vc3RpIG1lZHppIGZpcm1hbWkKZGlzdF9tYXQgPC0gZGlzdCh1ZGFqZV9zY2FsZWQsIG1ldGhvZCA9ICJldWNsaWRlYW4iKQoKYGBgCgojIEhpZXJhcmNoaWNrw6kgemhsdWtvdmFuaWUgKFdhcmRvdmEgbWV0w7NkYSkKClBvdcW+aWplbWUgV2FyZG92dSBtZXTDs2R1IHByZSB6aGx1a292YW5pZSwga3RvcsOhIHphxI3DrW5hIHpobHVrb3ZhbsOtbSBqZWRub8SNbGVubsO9Y2gga2xhc3Ryb3YgYSBwb3N0dXBuZSBpY2ggc3DDoWphLiBUw6F0byBtZXTDs2RhIG1pbmltYWxpenVqZSBuw6FyYXN0IHZuw7p0b3JuZWogdmFyaWFiaWxpdHkgcHJpIHNww6FqYW7DrSBrbGFzdHJvdi4KYGBge3J9CiMgSGllcmFyY2hpY2vDqSB6aGx1a292YW5pZSBzIFdhcmRvdm91IG1ldMOzZG91CgpoYyA8LSBoY2x1c3QoZGlzdF9tYXQsIG1ldGhvZCA9ICJ3YXJkLkQyIikKCiMgVnlrcmVzbGVuaWUgZGVuZHJvZ3JhbXUgcyB2YcWhaW1pIGTDoXRhbWkKCnBsb3QoaGMsCmxhYmVscyA9IHJvd25hbWVzKHVkYWplKSwgICMgcG91xb5pamVtZSBuw6F6dnkgZmlyaWVtIGFsZWJvIGluw6kgaWRlbnRpZmlrw6F0b3J5IHpvIHN0xLpwY2EgdiBkw6F0YWNoCm1haW4gPSAiSGllcmFyY2hpY2FsIGNsdXN0ZXJpbmcgb2YgZmlybXMgKFdhcmQuRDIpIiwKeGxhYiA9ICJGaXJtcyIsICAjIGFsZWJvIGFrIG3DoXRlIGluw70gaWRlbnRpZmlrw6F0b3IsIHBvdcW+aXRlIG7DoXpvdiBzdMS6cGNhCnlsYWIgPSAiSGVpZ2h0IiwKY29sLm1haW4gPSAiYmxhY2siLApjZXgubWFpbiA9IDEuMiwgICMgdmXEvmtvc8WlIG5hZHBpc3UKY2V4LmxhYiA9IDEsICAjIHZlxL5rb3PFpSBwb3Bpc292IG9zw60KY29sLmxhYiA9ICJibGFjayIKKQoKCmBgYAojIFJvemRlbGVuaWUgbmEga2xhc3RyZQpgYGB7cn0KIyBQcmlyYWRlbmllIGtsYXN0ZXJvdsOpaG8gxI1sZW5zdHZhIGRvIDMga2xhc3Ryb3YKayA8LSAzCmtsYXN0ZXJfbWVtYmVyc2hpcCA8LSBjdXRyZWUoaGMsIGsgPSBrKQoKIyBWeXR2b3JlbmllIHRhYnXEvmt5IHMgcHJpcmFkZW7DrW0gZmlyaWVtIGRvIGtsYXN0cm92CnVkYWplX2tsYXN0ZXJzIDwtIGRhdGEuZnJhbWUoCiAgRmlybWEgPSByb3duYW1lcyh1ZGFqZV9zY2FsZWQpLCAjIFBvdcW+aWplbWUgcHJpcmFkZW7DqSByaWFka3kgYWtvIG7DoXp2eSBmaXJpZW0KICBLbGFzdGVyID0ga2xhc3Rlcl9tZW1iZXJzaGlwCikKCiMgWm9icmF6ZW5pZSB0YWJ1xL5reSBzIHByaXJhZGVuw61tIGZpcmllbSBkbyBrbGFzdHJvdgpwcmludCh1ZGFqZV9rbGFzdGVycykKCmBgYAojIERlc2tyaXB0w612bmUgxaF0YXRpc3Rpa3kgcHJlIGthxb5kw70ga2xhc3RlcjoKClBvIHByaXJhZGVuw60gZmlyaWVtIGRvIGtsYXN0cm92IGplIHXFvml0b8SNbsOpIGFuYWx5em92YcWlLCBha28gc2EgZmlybXkgdiBqZWRub3RsaXbDvWNoIGtsYXN0cm9jaCBsw63FoWlhIG5hIHrDoWtsYWRlIHByZW1lbm7DvWNoLCBrdG9yw6kgc21lIHBvdcW+aWxpIHByaSB6aGx1a292YW7DrSAoUk9FLCBST0EsIEVCSVREQSBtYXLFvmEpLgpgYGB7cn0KIyBWeXR2b3JlbmllIGRhdGEgZnJhbWUgcyBwcmlkYW7DvW0gxI1sZW5zdHZvbSBkbyBrbGFzdHJvdgp1ZGFqZV93aXRoX2NsdXN0ZXJzIDwtIGRhdGEuZnJhbWUoCiAgS2xhc3RlciA9IGFzLmZhY3RvcihrbGFzdGVyX21lbWJlcnNoaXApLAogIHVkYWplX3NjYWxlZAopCgojIFrDrXNrYW5pZSBwcmllbWVybsO9Y2ggaG9kbsO0dCBwcmUga2HFvmTDuiBwcmVtZW5uw7ogdiBqZWRub3RsaXbDvWNoIGtsYXN0cm9jaApkZXNjcmlwdGl2ZXMgPC0gdWRhamVfd2l0aF9jbHVzdGVycyAlPiUKICBncm91cF9ieShLbGFzdGVyKSAlPiUKICBzdW1tYXJpc2UoYWNyb3NzKHdoZXJlKGlzLm51bWVyaWMpLCB+IG1lYW4oLngsIG5hLnJtID0gVFJVRSksIC5uYW1lcyA9ICJ7LmNvbH0iKSkKCiMgWm9icmF6ZW5pZSBwcmllbWVybsO9Y2ggaG9kbsO0dCBwcmVtZW5uw71jaCBwcmUgamVkbm90bGl2w6kga2xhc3RyZQpwcmludChkZXNjcmlwdGl2ZXMpCgpgYGAKIyBWaXp1YWxpesOhY2lhIGtsYXN0cm92IHBvbW9jb3UgZ3JhZnU6CgpBayBjaGNldGUgesOtc2thxaUgdml6dcOhbG55IHByZWjEvmFkIG8gdG9tLCBha28gc8O6IGZpcm15IHJvemRlbGVuw6kgbWVkemkga2xhc3RyZSwgbcO0xb5ldGUgdnl0dm9yacWlIHNjYXR0ZXIgcGxvdCwga3RvcsO9IHpvYnJhenVqZSBkdmUgcHJlbWVubsOpLCBuYXByw61rbGFkIFJPRSBhIFJPQSwgYSBwb3XFvmlqZSBmYXJieSBuYSBvem5hxI1lbmllIGplZG5vdGxpdsO9Y2gga2xhc3Ryb3YuCmBgYHtyfQojIFZpenVhbGl6w6FjaWEga2xhc3Ryb3YgcG9tb2NvdSBzY2F0dGVyIHBsb3R1CmxpYnJhcnkoZ2dwbG90MikKCmdncGxvdCh1ZGFqZV93aXRoX2NsdXN0ZXJzLCBhZXMoeCA9IFJPRSwgeSA9IFJPQSwgY29sb3IgPSBLbGFzdGVyKSkgKwogIGdlb21fcG9pbnQoc2l6ZSA9IDMpICsKICBsYWJzKHRpdGxlID0gIlJvemRlbGVuaWUgZmlyaWVtIGRvIGtsYXN0cm92IChST0UgdnMuIFJPQSkiLCAKICAgICAgIHggPSAiUk9FIiwgeSA9ICJST0EiKSArCiAgc2NhbGVfY29sb3JfbWFudWFsKHZhbHVlcyA9IGMoInJlZCIsICJncmVlbiIsICJibHVlIikpICsKICB0aGVtZV9taW5pbWFsKCkKCmBgYAojIEtvcmVsYcSNbsOhIGFuYWzDvXphIG1lZHppIHByZW1lbm7DvW1pIHYgcsOhbWNpIGplZG5vdGxpdsO9Y2gga2xhc3Ryb3Y6CgpNw7TFvmV0ZSB0aWXFviB6aXN0acWlLCBha28gc2Ega29yZWzDoWNpZSBtZWR6aSByw7R6bnltaSBwcmVtZW5uw71taSBtZW5pYSB2IHrDoXZpc2xvc3RpIG9kIGtsYXN0cm92LgpgYGB7cn0KIyBLb3JlbGHEjW7DoSBtYXRpY2EgdiByw6FtY2kgamVkbm90bGl2w71jaCBrbGFzdHJvdgpsaWJyYXJ5KGNvcnJwbG90KQoKZm9yIChpIGluIDE6aykgewogIGNsdXN0ZXJfZGF0YSA8LSB1ZGFqZV93aXRoX2NsdXN0ZXJzW3VkYWplX3dpdGhfY2x1c3RlcnMkS2xhc3RlciA9PSBpLCBdCiAgY29yX21hdHJpeCA8LSBjb3IoY2x1c3Rlcl9kYXRhWywgLTFdKSAjIEJleiBrbGFzdGVyb3bDqWhvIG96bmHEjWVuaWEKICBjb3JycGxvdChjb3JfbWF0cml4LCBtZXRob2QgPSAiY2lyY2xlIiwgbWFpbiA9IHBhc3RlKCJLb3JlbGHEjW7DoSBtYXRpY2EgcHJlIGtsYXN0ZXIiLCBpKSkKfQoKYGBgCiMgVnlob2Rub3RlbmllIGt2YWxpdHkga2xhc3Ryb3ZlaiBhbmFsw716eSAoVm7DunRyb2tsYXN0cm92w6EgYSBtZWR6aWtsYXN0cm92w6EgdmFyaWFiaWxpdGEpOgpgYGB7cn0KIyBQb8SNZXQgcG96b3JvdmFuw60gdiBrYcW+ZG9tIGtsYXN0cnUKdGFibGUoa2xhc3Rlcl9tZW1iZXJzaGlwKQoKIyBWeXBvxI3DrXRhxaUgdmFyaWFiaWxpdHU6IFRTUywgV1NTLCBCU1MKVFNTIDwtIHN1bSgodWRhamVfc2NhbGVkIC0gbWVhbih1ZGFqZV9zY2FsZWQpKV4yKQpXU1MgPC0gc3VtKHNhcHBseSgxOmssIGZ1bmN0aW9uKGNsdXN0ZXIpIHN1bSgodWRhamVfc2NhbGVkW2tsYXN0ZXJfbWVtYmVyc2hpcCA9PSBjbHVzdGVyLF0gLSBjb2xNZWFucyh1ZGFqZV9zY2FsZWRba2xhc3Rlcl9tZW1iZXJzaGlwID09IGNsdXN0ZXIsXSkpXjIpKSkKQlNTIDwtIFRTUyAtIFdTUwoKIyBWeXR2b3JlbmllIHRhYnXEvmt5IHZhcmnDoWNpw60KdmFyaWFiaWxpdHlfdGFibGUgPC0gZGF0YS5mcmFtZSgKICBNZXRyaWMgPSBjKCJUU1MiLCAiV1NTIiwgIkJTUyIpLAogIFZhbHVlID0gYyhUU1MsIFdTUywgQlNTKQopCgpwcmludCh2YXJpYWJpbGl0eV90YWJsZSkKCmBgYApBbmFsw716YSB1a8OhemFsYSwgxb5lIHpobHVrb3ZhbmllIHBvbW9jb3UgV2FyZG92ZWogbWV0w7NkeSB1bW/Fvm5pbG8gcm96cG96bmHFpSB0cmkgb2RsacWhbsOpIHNrdXBpbnkgZmlyaWVtIG5hIHrDoWtsYWRlIGljaCBmaW5hbsSNbsO9Y2ggdWthem92YXRlxL5vdi4gUHJ2w70ga2xhc3RlciBvYnNhaHVqZSBmaXJteSBzIG5pxb7FocOtbWkgaG9kbm90YW1pIFJPRSBhIFJPQSwgZHJ1aMO9IGtsYXN0ZXIgbcOhIHN0cmVkbsOpIGhvZG5vdHkgdMO9Y2h0byB1a2F6b3ZhdGXEvm92LCBhIHRyZXTDrSBrbGFzdGVyIHZ5a2F6dWplIG5hanZ5xaHFoWllIGhvZG5vdHkgUk9FIGEgUk9BLCDEjW8gbmF6bmHEjXVqZSB2eXNvY2UgdsO9a29ubsOpIGZpcm15LgoKCgoKCgoKCgo=