ZADANIE 8

Kristína Mečiarová

---

V tomto zadaní budeme opäť pracovať s dátovým súborom uscrime z knižnice SMS data. Súbor obsahuje 50 pozorovaní a 11 premenných s informáciami o počte výskytov rôznych trestných činov v rámci konkrétnych regiónov USA, ich rozlohe a populácii.

data(uscrime, package = "SMSdata")
data<-transform(uscrime,regn=as.numeric(reg),divn=as.numeric(div))
data<-data[,-c(10,11)]
D <- dist(data)
  
Kmeans <- kmeans(data, centers = 4)
means<-Kmeans$centers
colVector <- as.numeric(Kmeans$cluster)

plot(data$robbery ~ data$popu.1985, bg = colVector, xlab = "Population in 1985", ylab = "Robbery", pch = 20+data$regn, col = "black")
points(Kmeans$centers[,5] ~ Kmeans$centers[,2], col = 1:4, pch = 8, cex = 2)
text((data$robbery +20 ) ~ data$popu.1985 +1 ,labels=rownames(data), col=colVector, cex = 0.5)
legend("topright",legend=levels(uscrime$reg), pch=20+unique(data$regn),cex=0.5)

Na dáta aplikujeme “K-means” algoritmus, ktorý využijeme na nehierarckú konštrukciu clusterov. Prirodze by sme delili dáta do clusterov podľa príslušnosti k regiónu. Na obrázku vyššie sú regióny rozlíšené rôznymi útvarmi a príslušnosť do jednotlivých clusterov je odlišovaná farebne.

Obrázky nižšie vykresľujú clustre skonštruované hierarchicky. Opäť vidíme, že clustre nezachovávajú príslušnosť podľa jednotlivých regiónov. Pozorujeme taktiež, že clustre nie sú zhodnés clustrami v prípade nehierarchickej konštrukcie, čo by sme aj očakávali, keďže sa jedná o rozdielne algoritmy. Môžeme si však všimnúť, že Aljašku oba algoritmy priradili do zvlášť clusteru, ktorý je tvorený iba týmto jedným štátom.

library(dendextend)
D <- dist(scale(data))
HC1 <- hclust(D)
plot(HC1, xlab = "Observations", ylab = "Proximity measure", hang = -1, cex=0.5)
groups <- cutree(HC1, k=3)
rect.hclust(HC1, k=4, border="red")

dend <- as.dendrogram(HC1)

# Create a vector giving a color for each car to which company it belongs to
reg_type <- rep(NA, length(rownames(data)))
reg_type[data$regn=="1"] <- "Northeast"
reg_type[data$regn=="2"] <- "Midwest"
reg_type[data$regn=="3"] <- "South"
reg_type[data$regn=="4"] <- "West"
reg_type <- factor(reg_type)
n_reg_types <- length(unique(reg_type))
cols_4 <- colorspace::rainbow_hcl(n_reg_types, c = 70, l  = 50)
col_reg_type <- cols_4[reg_type]

# extra: showing the various clusters cuts 
k234 <- cutree(dend, k = 2:4)

# color labels by car company:
labels_colors(dend) <- col_reg_type[order.dendrogram(dend)]
# color branches based on cutting the tree into 4 clusters:
dend <- color_branches(dend, k = 4)

### plots
plot(dend)
colored_bars(cbind(k234[,3:1], col_reg_type), dend, rowLabels = c(paste0("k = ", 4:2), "Region"))
legend("topright", legend = levels(reg_type), fill = cols_4,cex=0.5)