У меня есть кусок кода, который я написал некоторое время назад, и который мне нужно преобразовать в функцию, суть кода:
- Создание списка фреймов данных на основе группировки переменных
- Для каждого из фреймов данных на шаге 1 создайте еще один список фреймов данных, представляющих подмножества столбцов
- превратите каждого члена списка из шага 2 в матрицу различий
- запустите
pam
алгоритм кластеризации для каждого элемента списка из шага 3 для различных значений k
- Возвращение файла 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")