Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- library(factoextra)
- library(cluster)
- library(ggplot2)
- library(dplyr)
- library(dendextend)
- library(reshape2)
- library(RColorBrewer)
- data <- read.csv("Kvartiry_Ufa.csv")
- # вычисляем корреляцию
- cormat <- round(cor(data),2)
- # "растопим" корелялционную мутрицу
- melted_cormat <- melt(cormat)
- # достаем верхний треугольник кореляционной матрицы
- get_upper_tri <- function(cormat){
- cormat[lower.tri(cormat)]<- NA
- return(cormat)
- }
- upper_tri <- get_upper_tri(cormat)
- melted_cormat <- melt(upper_tri, na.rm = TRUE)
- # строим хитмэп
- ggheatmap <- ggplot(data = melted_cormat, aes(Var2, Var1, fill = value))+
- geom_tile(color = "white")+
- scale_fill_gradient2(low = "blue", high = "red", mid = "white",
- midpoint = 0, limit = c(-1,1), space = "Lab",
- name="Pearson\nCorrelation") +
- theme_minimal()+
- theme(axis.text.x = element_text(angle = 45, vjust = 1,
- size = 12, hjust = 1))+
- coord_fixed()
- # расположим значения на хитмэпе
- ggheatmap +
- geom_text(aes(Var2, Var1, label = value), color = "black", size = 4) +
- theme(
- axis.title.x = element_blank(),
- axis.title.y = element_blank(),
- panel.grid.major = element_blank(),
- panel.border = element_blank(),
- panel.background = element_blank(),
- axis.ticks = element_blank(),
- legend.justification = c(1, 0),
- legend.position = c(0.6, 0.7),
- legend.direction = "horizontal")+
- guides(fill = guide_colorbar(barwidth = 7, barheight = 1,
- title.position = "top", title.hjust = 0.5))
- # исходя из матрицы корреляции необходимо избавиться от living area
- drop <- c("living_area")
- data = data[,!(names(data) %in% drop)]
- # проведем кластеризацию методом agnes и представим в виде дендрограммы
- agn <- agnes(data, stand = TRUE, method = "complete") %>% as.dendrogram
- # отобразим дендрограмму agnes
- fviz_dend(agn,
- main="Дендрограмма - complete",
- xlab = "Квартиры", ylab = "Расстояние", sub = "")
- # вычислим количество кластеров методом локтя
- fviz_nbclust(data, FUN = hcut, method = "wss")
- n_clust <- 3
- # проведем срез дендрограммы
- # указав количество кластеров полученных в результате метода локтя
- cttr <- cutree(as.hclust(agn), k = n_clust)
- # отобразим дендрограмму
- fviz_dend(agn, k = n_clust, cex = 0.5,
- k_colors = "Set2",
- color_labels_by_k = TRUE,
- main="Дендрограмма",
- xlab = "Квартиры", ylab = "Расстояние", sub = "",
- rect = TRUE,
- rect_border = "Set2",
- rect_fill = TRUE)
- # отобразим кластеризацию с использованием метода главных компонентов
- fviz_cluster(list(data = data, cluster = cttr),
- palette = "Set2",
- ellipse.type = "convex",
- repel = TRUE,
- show.clust.cent = TRUE, ggtheme = theme_minimal())
- # отобразим диаграмму рассеяния признаков
- pairs(data, col = brewer.pal(n = n_clust, name = "Set2")[cttr], upper.panel=NULL)
- # необходимо избавиться от незначительных признаков
- drop <- c("floors_total", "ceiling_height", "rooms")
- data_vs = data[,!(names(data) %in% drop)]
- # отобразим диаграмму рассеяния признаков с учетом кластеризации agnes
- pairs(data_vs, col = brewer.pal(n = n_clust, name = "Set2")[cttr], upper.panel=NULL)
- # calculate means per group
- agn_centers <- aggregate(data, by = list(cttr), FUN = mean)
- # загрузим датасет с описанием центров кластеров
- # write.csv(agn_centers, "agnes_centers.csv", row.names=FALSE)
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement