R语言混合型数据聚类分析案例.zip_R 案例_R 聚类_R语言案例_R语言聚类分析_聚类分析 案例

set.seed(1680) # 设置随机种子，使得本文结果具有可重现性 library(dplyr)#dplyr用于数据的清洗和整理 library(ISLR) #College#输入即可显示数据 #summary(College) library(cluster) library(Rtsne) library(ggplot2) #data(package="ISLR")#查看包中自带的数据集 #数据清洗工作 college_clean <- College %>% #管道函数 mutate(name = row.names(.),#对已有列进行数据运算并添加为新列#row.names(.)表示行的名字 accept_rate = Accept/Apps, isElite = cut(Top10perc,#cut 将数据进行分组,分成两组，左开右闭(] (0,50]和(50,100] breaks = c(0, 50, 100), labels = c("Not Elite", "Elite"), include.lowest = TRUE)) %>%#出现一个最低点应该被包含在区间内 mutate(isElite = factor(isElite)) %>% #将向量转化为因子 select(name, accept_rate, Outstate, Enroll, Grad.Rate, Private, isElite) glimpse(college_clean) # Remove college name before clustering（将大学的名称去掉） gower_dist <- daisy(college_clean[, -1], metric = "gower", type = list(logratio = 3))#对Enroll变量进行对数变换 # Check attributes to ensure the correct methods are being used # (I = interval, N = nominal) # Note that despite logratio being called, # the type remains coded as "I" summary(gower_dist) gower_mat <- as.matrix(gower_dist) # Output most similar pair college_clean[ which(gower_mat == min(gower_mat[gower_mat != min(gower_mat)]), arr.ind = TRUE)[1, ], ] # Output most dissimilar pair college_clean[ which(gower_mat == max(gower_mat[gower_mat != max(gower_mat)]), arr.ind = TRUE)[1, ], ] #聚类k的选择 # Calculate silhouette width for many k using PAM sil_width <- c(NA) for(i in 2:10){ pam_fit <- pam(gower_dist, diss = TRUE, k = i) sil_width[i] <- pam_fit$silinfo$avg.width#使用轮廓系数判断聚类效果的好坏 } # Plot sihouette width (higher is better) plot(1:10, sil_width, xlab = "Number of clusters", ylab = "Silhouette Width") lines(1:10, sil_width) pam_fit <- pam(gower_dist, diss = TRUE, k = 3)#k=3聚类效果最好 pam_results <- college_clean %>% dplyr::select(-name) %>% mutate(cluster = pam_fit$clustering) %>% group_by(cluster) %>% do(the_summary = summary(.)) print(pam_results$the_summary) #查看各个簇的中心点 college_clean[pam_fit$medoids, ] #t-SNE 是一种降维的方法 tsne_obj <- Rtsne(gower_dist, is_distance = TRUE) tsne_data <- tsne_obj$Y %>% data.frame() %>% setNames(c("X", "Y")) %>% mutate(cluster = factor(pam_fit$clustering), name = college_clean$name) ggplot(aes(x = X, y = Y), data = tsne_data) + geom_point(aes(color = cluster)) tsne_data %>% filter(X > -20 & X < -5, Y > -15 & Y < -10) %>% left_join(college_clean, by = "name") %>% collect %>% .[["name"]]