Práca s databázou - World population

library(knitr)

rm(list = ls())
udaje <- read.csv("world_population.csv", stringsAsFactors = FALSE)

# výber kontinentov podľa tvojich údajov
kontinenty <- c("Europe")

udaje2020 <- subset(udaje, Continent %in% kontinenty)

# výber stĺpcov, ktoré v databáze existujú
udaje2020 <- udaje2020[, c("Country.Territory",
                           "X2020.Population",
                           "Area..km..",
                           "Density..per.km..",
                           "Growth.Rate")]

# zmena názvu riadkov
rownames(udaje2020) <- udaje2020$Country.Territory
udaje2020$Country.Territory <- NULL

udaje2020

NA

Z našej svetovej databázy sme si na skúmanie vytiahli iba krajiny európskeho kontinetnu, ktorých celkový počet je 50.

udaje_complete <- na.omit(udaje2020)
udaje_scaled <- scale(udaje_complete)

num_vars <- as.data.frame(udaje_scaled)
num_plots <- ncol(num_vars)

par(mfrow = c(ceiling(sqrt(num_plots)), ceiling(num_plots / ceiling(sqrt(num_plots)))))
par(mar = c(4, 4, 2, 1))

for (col in names(num_vars)) {
  boxplot(num_vars[[col]],
          main = col,
          col = "lightpink",
          horizontal = TRUE)
}

mtext("Boxploty numerických premenných (rok 2020)", outer = TRUE, cex = 1.3, font = 2)

cor_mat <- cor(udaje_scaled, use="pairwise.complete.obs")
cor_mat <- round(cor_mat,2)
print(cor_mat)

                  X2020.Population Area..km.. Density..per.km.. Growth.Rate
X2020.Population              1.00       0.72             -0.11       -0.13
Area..km..                    0.72       1.00             -0.05       -0.06
Density..per.km..            -0.11      -0.05              1.00       -0.05
Growth.Rate                  -0.13      -0.06             -0.05        1.00

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

plot(hc, labels = rownames(udaje_scaled),
     main = "Hierarchical klastering of countries (Ward.D2)",
     xlab = "", sub = "")

k <- 3
h_cut <- hc$height[length(hc$height) - (k - 1)]
abline(h = h_cut, col = "pink", lwd = 2, lty = 2)

klaster_membership <- cutree(hc, k = k)

udaje_klasters <- data.frame(
  Country = rownames(udaje_complete),
  udaje_complete,
  klaster = factor(klaster_membership)
)

data_prac <- data.frame(cbind(udaje_klasters$Country, udaje_klasters$klaster))
colnames(data_prac) <- c("Country","klaster")
data_prac

ssq <- function(x, m) sum((x - m)^2)

var_names <- colnames(udaje_scaled)

TSS <- sapply(var_names, function(v) ssq(udaje_scaled[, v], mean(udaje_scaled[, v])))

WSS <- sapply(var_names, function(v) {
  x <- udaje_scaled[, v]
  tapply(x, klaster_membership, function(z) ssq(z, mean(z))) |> sum()
})

BSS <- TSS - WSS

ss_table <- data.frame(
  Variable = var_names,
  TSS = TSS,
  WSS = WSS,
  BSS = BSS,
  Prop_Between = BSS / TSS
)

ss_table

udaje2020 <- data.frame(
  udaje2020,
  klaster = udaje_klasters$klaster
)
library(dplyr)

descriptives <- udaje2020 %>%
  group_by(klaster) %>%
  summarise(
    across(
      .cols = where(is.numeric),
      .fns = list(
        mean = ~mean(.x, na.rm = TRUE)
      ),
      .names = "{.col}_{.fn}"
    )
  )
descriptives