Создать функцию для создания лучших подмножеств для кластеризации - PullRequest
Новая
       88

Создать функцию для создания лучших подмножеств для кластеризации

0 голосов
/ 03 мая 2020

У меня есть кусок кода, который я написал некоторое время назад, и который мне нужно преобразовать в функцию, суть кода:

  1. Создание списка фреймов данных на основе группировки переменных
  2. Для каждого из фреймов данных на шаге 1 создайте еще один список фреймов данных, представляющих подмножества столбцов
  3. превратите каждого члена списка из шага 2 в матрицу различий
  4. запустите pam алгоритм кластеризации для каждого элемента списка из шага 3 для различных значений k
  5. Возвращение файла csv с переменными кластеризации и статистикой кластера

Я уверен, что код, окружающий шаг 5, мог бы быть выполнен более эффективно, но я так и не смог разобраться. Независимо от того, что код работает должным образом, но я должен включить дополнительный код для каждого значения k.

Мой вопрос заключается в том, как объединить все это в функцию, которая принимает в качестве аргумента фрейм данных и диапазон для k. Затем я могу использовать lapply или включить его в конвейер через вызов do и вернуть файл csv для каждого предоставленного кадра данных? В частности, как будет применен метод al oop или apply, чтобы он работал для диапазона k? Пример кода ниже для k в диапазоне 2: 3 

library(tidyverse)
library(cluster)
library(fpc)
library(rje)
options(scipen=999)

#Step 1
state.df = data.frame(state.x77, Region=state.region, Division=state.division)
state_grouped=state.df %>% group_by(Region) %>% group_split()
South=state_grouped[[2]]

#Step 2 
v_names=names(South)
combos=rje::powerSet(v_names)[-1]
combos=combos[lengths(combos)>1] 
df_list=list()
for (i in 1:length(combos)){
  df_list[[i]]=South[combos[[i]]]
}
#Step 3
gower_ls=lapply(df_list,daisy,metric="gower") 

model_num=c(NA)
sil_width <-c(NA)
min_sil<-c(NA)
mincluster<-c(NA)
k_clusters <-c(NA)
lowest_sil <-c(NA)
maxcluster <-c(NA)

#Step 4
#two clusters
set.seed(2)
clust_list_2=lapply(gower_ls,pam,diss=TRUE,k=2)
for(m in 1:length(clust_list_2)){

  sil_width[m] <-clust_list_2[[m]][7]$silinfo$avg.width
  min_sil[m] <- min(clust_list_2[[m]][7]$silinfo$clus.avg.widths)
  mincluster[m] <-min(clust_list_2[[m]][6]$clusinfo[,1])
  maxcluster[m] <-max(clust_list_2[[m]][6]$clusinfo[,1])
  k_clusters[m]<- nrow(clust_list_2[[m]][6]$clusinfo)
  lowest_sil[m]<-min(clust_list_2[[m]][7]$silinfo$widths)
  model_num[m]=m}

colresults_2=as.data.frame(cbind( sil_width, min_sil,mincluster,maxcluster,k_clusters,model_num,lowest_sil))

# three clusters
set.seed(3)
clust_list_3=lapply(gower_ls,pam,diss=TRUE,k=3)
for(m in 1:length(clust_list_3)){

  sil_width[m] <-clust_list_3[[m]][7]$silinfo$avg.width
  min_sil[m] <- min(clust_list_3[[m]][7]$silinfo$clus.avg.widths)
  mincluster[m] <-min(clust_list_3[[m]][6]$clusinfo[,1])
  maxcluster[m] <-max(clust_list_3[[m]][6]$clusinfo[,1])
  k_clusters[m]<- nrow(clust_list_3[[m]][6]$clusinfo)
  lowest_sil[m]<-min(clust_list_3[[m]][7]$silinfo$widths)
  model_num[m]=m}
colresults_3=as.data.frame(cbind( sil_width, min_sil,mincluster,maxcluster,k_clusters,model_num,lowest_sil))

#Step 5
clust_range=c(2:3)
clust_range_results=lapply(paste0("colresults_", 2:3), function(x) get(x))
model_stats=do.call(rbind, clust_range_results)


lapply(combos,write,"south_models.txt",append=TRUE,ncolumns=1000)
Combo_Models=read.csv("south_models.txt",header=FALSE,stringsAsFactors =FALSE)
Combo_Models$model_num=seq.int(nrow(Combo_Models))
names(Combo_Models)=c("Model","model_num")

model_stats=left_join(model_stats,Combo_Models,by="model_num")
model_stats$numOfVariables=count.fields(textConnection(model_stats$Model), sep = " ")
write.csv(model_stats,"model_stats.csv")
...