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=