Вложенные циклы в R занимают слишком много времени - PullRequest
Новая
       8

Вложенные циклы в R занимают слишком много времени

0 голосов
/ 28 мая 2018

Я пытался сделать алгоритм Kernel K-Means в R вручную, но мой цикл занимает более 30 минут, вот код: 

#Calculanting kernel k-means
rbfkmeans<-function(data,c,q=0.02,L=0.7){ 
        #associating random classifications to each observation
        iter=0
        data<-data%>%
                mutate(cluster=sample(1:c,nrow(data),replace=T))

        mini=rep(1,nrow(data))

        ## DISTÂNCIA EUCLIDIANA  
        # Remember: 
        #1.|| a || = sqrt(aDOTa), 
        #2. d(x,y) = || x - y || = sqrt((x-y)DOT(x-y))
        #3. aDOTb = sum(a*b)


        d<-function(x,y){
                aux=x-y
                dis=sqrt(sum(aux*aux))
                return(dis)
        }

        ##Radial Basis Function Kernel
        # Remember :
        # 1.K(x,x')=exp(-q||x-x'||^2) where ||x-x'|| is could be defined as the
        # euclidian distance and 'q' it's the gamma parameter
        rbf<-function(x,y,q=0.2){
                aux<-d(x,y)
                rbfd<-exp(-q*(aux)^2)
                return(rbfd)
        }
        #
        #calculating the kernel matrix
        kernelmatrix=matrix(0,nrow(data),nrow(data))
        for(i in 1:nrow(data)){
                for(j in 1:nrow(data)){
                        kernelmatrix[i,j]=rbf(data[i,1:(ncol(data)-1)],data[j,1:(ncol(data)-1)],q)
                }
        }
        r=rep(0,nrow(data))
        distance=matrix(0,nrow(data),c)
        while(  (sum(r==data[,'cluster'])!=nrow(data)) && iter <30 ){   
                ans=0

                #Calculating the distaces in the kernelized versions (RBF example)
                print('running')
                third=rep(0,c)#here third means the calculation from centers distances
                #as they not depend of each obserativion.
                for(g in 1:c){
                        ans=0
                        for(k in 1:nrow(data)){
                                for(l in 1:nrow(data)){
                                        ans = ans + (data[k,'cluster']==g)*(data[l,'cluster']==g)*kernelmatrix[k,l]

                                }
                        }
                        third[g]=ans
                }      
                for (ii in 1:nrow(data)){       #for (ii in 1:nrow(data))
                        for(j in 1:c)  {          #for(j in 1:c)
                                distance[ii,j]= kernelmatrix[ii,ii]-2*sum((data[,'cluster']==j)*kernelmatrix[ii,])/sum(data[,'cluster']==j)+third[j]/(sum(data[,'cluster']==j)^2)
                        }
                }
                r=data[,'cluster']
                #Checking the shortest distance
                for(k in 1:nrow(data)){
                        data[k,'cluster']=match(min(distance[k,]),distance[k,])
                        mini[k]=min(distance[k,])
                }  
                plot(data[1:(ncol(data)-1)], col=data$cluster)
                iter=iter+1  
                print(paste('Iteration number:',iter))
                print(paste('Mean of min. distances:',mean(mini)))

                #print(g==data$'cluster')
        }

        return(data)
}

Кто-то знает, как яможет это оптимизировать?Основная проблема - это вычисление термина #third, я думаю, что он тратит слишком много времени на проверку (data[k,'cluster']==g) внутри циклов, но у меня нет больше идей, чтобы улучшить это ...

OBS: data[k,'cluster']==g, чтобы проверить, принадлежит ли наблюдение к кластеру.

РЕДАКТИРОВАТЬ: часть кода, которая требует много времени для его выполнения это: 

for(g in 1:c){
                            ans=0
                            for(k in 1:nrow(data)){
                                    for(l in 1:nrow(data)){
                                            ans = ans + (data[k,'cluster']==g)*(data[l,'cluster']==g)*kernelmatrix[k,l]

                                    }
                            }
                            third[g]=ans
                    }

1 Ответ

0 голосов
/ 28 мая 2018

Похоже, вы можете оптимизировать расстояние и радиальную функцию.Ваше расстояние получит квадрат суммы суммы, но ваши радиальные функции возведены в квадрат, отрицая его 

    d<-function(x,y){
          aux=x-y
          sum(aux*aux)
    }

    ##Radial Basis Function Kernel
    # Remember :
    # 1.K(x,x')=exp(-q||x-x'||^2) where ||x-x'|| is could be defined as the
    # euclidian distance and 'q' it's the gamma parameter
    rbf<-function(x,y,q=0.2){
            aux<-d(x,y)
            rbfd<-exp(-q*(aux))
            return(rbfd)
    }

Также вы должны иметь возможность использовать преобразование кода для использования циклов foreach и иметь возможность воспользоваться одним избиблиотеки распараллеливания (например, doparallel)

...