Advertisement
korenizla

Untitled

Apr 19th, 2023 (edited)
1,700
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
R 4.97 KB | None | 0 0
  1. # подключение библиотек
  2. library (factoextra)
  3. library (cluster)
  4. library(ggplot2)
  5. library(dplyr)
  6. library(dendextend)
  7. library(reshape2)
  8. library(RColorBrewer)
  9.  
  10. data <- read.csv("Kvartiry_Ufa.csv", sep = ",")
  11.  
  12. # вычисляем корреляцию признаков
  13. cormat <- round(cor(data),2)
  14. # "растопим" корелялционную мутрицу
  15. melted_cormat <- melt(cormat)
  16. # достаем верхний треугольник кореляционной матрицы
  17. get_upper_tri <- function(cormat){
  18.   cormat[lower.tri(cormat)]<- NA
  19.   return(cormat)
  20. }
  21. upper_tri <- get_upper_tri(cormat)
  22. melted_cormat <- melt(upper_tri, na.rm = TRUE)
  23. # строим хитмэп
  24. ggheatmap <- ggplot(data = melted_cormat, aes(Var2, Var1, fill = value))+
  25.   geom_tile(color = "white")+
  26.   scale_fill_gradient2(low = "blue", high = "red", mid = "white",
  27.                        midpoint = 0, limit = c(-1,1), space = "Lab",
  28.                        name="Pearson\nCorrelation") +
  29.   theme_minimal()+
  30.   theme(axis.text.x = element_text(angle = 45, vjust = 1,
  31.                                    size = 12, hjust = 1))+
  32.   coord_fixed()
  33. # расположим значения на хитмэпе
  34. ggheatmap +
  35.   geom_text(aes(Var2, Var1, label = value), color = "black", size = 4) +
  36.   theme(
  37.     axis.title.x = element_blank(),
  38.     axis.title.y = element_blank(),
  39.     panel.grid.major = element_blank(),
  40.     panel.border = element_blank(),
  41.     panel.background = element_blank(),
  42.     axis.ticks = element_blank(),
  43.     legend.justification = c(1, 0),
  44.     legend.position = c(0.6, 0.7),
  45.     legend.direction = "horizontal")+
  46.   guides(fill = guide_colorbar(barwidth = 7, barheight = 1,
  47.                                title.position = "top", title.hjust = 0.5))
  48.  
  49. # исходя из матрицы корреляции необходимо избавиться от living area
  50. drop <- c("living_area")
  51. data = data[,!(names(data) %in% drop)]
  52.  
  53. # стандартизируем значения для корректной кластеризации
  54. data_scaled <- scale(data)
  55.  
  56. # определим оптимальное количество кластеров методом локтя
  57. fviz_nbclust(data_scaled, kmeans, method = "wss")
  58. # определим оптимальное количество кластеров методом силуэта
  59. fviz_nbclust(data_scaled, kmeans, method = "silhouette")
  60. n_clust <- 4
  61.  
  62. # определяем диапазон значений nstart для проверки
  63. nstart_range <- seq(1, 20, by = 1)
  64.  
  65. # создаем пустой вектор для хранения средней ширины силуэта
  66. avg_silhouette <- vector(length = length(nstart_range))
  67.  
  68. # перебираем каждое значение nstart и вычисляем среднюю ширину силуэта
  69. for (i in seq_along(nstart_range)) {
  70.   set.seed(123) # установили начальное значение для воспроизводимости
  71.   km <- kmeans(iris[, -5], centers = n_clust, nstart = nstart_range[i])
  72.   avg_silhouette[i] <- mean(silhouette(km$cluster, dist(iris[, -5])))
  73. }
  74.  
  75. # отображаем среднюю ширину силуэта для каждого значения nstart
  76. plot(nstart_range, avg_silhouette, type = "b", xlab = "nstart", ylab = "Average silhouette width")
  77.  
  78. # находим оптимальное значение nstart методом силуэта
  79. optimal_nstart <- nstart_range[which.max(avg_silhouette)]
  80.  
  81. # выведем оптимальное значение nstart
  82. cat("Optimal nstart value:", optimal_nstart)
  83.  
  84. # проведем кластеризацию методом kmeans
  85. km <- kmeans(data_scaled, n_clust, nstart = optimal_nstart)
  86. # сохраним вектор с кластером в отдельной переменной
  87. grp <- km$cluster
  88.  
  89. # отобразим кластеризацию с использованием метода главных компонентов
  90. fviz_cluster(km, data_scaled,
  91.              palette = "Set2", ggtheme = theme_minimal())
  92.  
  93. # отобразим диаграмму рассеяния признаков
  94. pairs(data, col = brewer.pal(n = n_clust, name = "Set2")[grp], upper.panel=NULL)
  95.  
  96. # необходимо избавиться от незначительных признаков
  97. drop <- c("floors_total", "ceiling_height", "rooms", "studio")
  98. data_vs = data[,!(names(data) %in% drop)]
  99.  
  100. # отобразим диаграмму рассеяния признаков с учетом кластеризации
  101. pairs(data_vs, col = brewer.pal(n = n_clust, name = "Set2")[grp], upper.panel=NULL)
  102.  
  103. # посмотрим на расположение центроидов кластеров
  104. km$centers
  105. km_centroids <- aggregate(data, by=list(cluster=km$cluster), mean)
  106. km_centroids
  107. # загрузим датасет с описанием центров кластеров
  108. write.csv(km_centroids, "File_Name.csv", row.names=FALSE)
  109.  
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement