1. #Autor: Mateusz Bieniek
2.  
3. euclid <- function(x1,x2)
4. {
5.   return(sqrt(rowSums((x1-x2)^2)))
6. }
7.  
8. rand_points <- function(data, k)
9. {
10.   return(sample(1:dim(data)[1],k))
11. }
12.  
13. max_distance <- function(data, k)
14. {
15.   n <- dim(data)[1]
16.   compare <- matrix(0,n,n)
17.   for (i in 1:n) # od 1 do n punktow
18.   {
19.     for (j in 2:n) # od 2 do n
20.     {
21.       compare[i,j] <- euclid(data[i,],data[j,]) #pierwszy punkt z drugim, pierwszy z trzecim itd
22.     }
23.   }
24.   pair <- which(compare==max(compare), arr.ind = TRUE)[1,]
25.   #po wyborze najbardziej oddalonej od siebie pary zostaja wybrane (jesli to konieczne) kolejne punkty
26.   #pierwszenstwo ma punkt najbardziej oddalony od ktoregos z pary
27.   compare1 <- matrix(0, 2, n)
28.   compare1[1,] <- compare[pair[1],]
29.   compare1[1,pair[2]] <- 0
30.   compare1[2,] <- compare[pair[2],]
31.   compare1[2,pair[1]] <- 0
32.   compare1 <- colSums(compare1)
33.  
34.   result <- c(pair)
35.   if(k==2) return(result)
36.   result[1:2] <- c(pair)
37.  
38.   for (l in 1 : (k-2))
39.   {
40.     result[l+2]<-which(compare1==max(compare1), arr.ind = TRUE)
41.     compare1[result[l+2]] <- 0
42.   }
43.   return(result)
44. }
45.  
46. k_means_test <- function(data, k, max_iter, fn, dim, method)
47.   #k - liczba klastrow, fn - funkcja celu
48. {
49.   # losowanie punktow poczatkowych
50.   cat("\ndane wejsciowe:\n")
51.   print(data)
52.  
53.   if(method == "max_distance")
54.   {
55.     cat("\nwybrano metode najbardziej oddalonych punktow poczatkowych\n")
56.     points <- max_distance(data,k)
57.   }
58.   else
59.   {
60.     cat("\nwybrano metode losowego wyboru punktow poczatkowych\n")
61.     points <- rand_points(data,k)
62.   }
63.   clusters <- data[points,1:dim]
64.   data[,dim+1]<-c(0)
65.   cat("\nklastry poczatkowe \n")
66.   print(clusters)
67.   cat("\nklastry zostaly wybrane sposrod punktow: \n")
68.   print(data)
69.  
70.   #do kazdego klastra zostana przypisane najblizej lezace punkty
71.   #dla kazdego punktu obliczane sa odleglosci od wszystkich klastrow
72.   #punkt przypisywany jest do najblizszego klastra jesli spelnia warunki
73.   clustlist = list() #inicjalizacja listy na macierze klastrow
74.   w = list()
75.   s = list()
76.   for (i in 1:max_iter)
77.   {
78.     for (j in 1:k) #petla po wszystkich klastrach
79.     {
80.       # macierz klastrow
81.       clustlist[[j]] <- t(matrix(clusters[j,1:dim],dim,dim(data)[1]))
82.       w[[j]]<-euclid(data[,1:dim],unlist(clustlist[[j]]))
83.     }
84.     y<-matrix(unlist(w),dim(data)[1],k) #macierz odleglosci punktow od klastrow
85.    
86.     cat("\nMacierz odleglosci punktow od klastrow\n")
87.     print(y)
88.    
89.     for (l in 1:dim(data)[1])
90.     {
91.       near <- which.min(y[l,]) # ktoremu klastrowi najblizszy jest dany punkt
92.       # obliczenie nowego klastra po dodaniu tego punktu
93.      
94.       # algorytm nie bierze pod uwage punktow, ktore sa juz w danym klastrze
95.       if(i == 1 | (data[l,dim+1] !=  near))
96.       {
97.         ncenter <- ((clusters[near,] + data[l,1:D])/D)
98.         ncenter <-unlist(ncenter)
99.        
100.         # warunek dodania punktu do klastra
101.        
102.         if (fn(ncenter) <= fn(unlist(clusters[near,])))
103.         {
104.           data[l,dim+1]<-which.min(y[l,]) # przypisanie numeru klastra
105.         }
106.         else
107.         {
108.           data[l,dim+1]<-10 #w.p.p przypisanie nieuzywanego klastra lub nie przypisanie zadnego klastra
109.         }  
110.       }
111.     }
112.     colnames(data)[dim+1] <- "klaster"
113.     # wybor nowych srodkow klastrow
114.    
115.     old_clusters <- clusters
116.     for (m in 1:k)
117.     {
118.       u = data[data$klaster == m,]
119.      
120.       clusters[m,] <- colSums(u[1:dim])/dim(u)[1]
121.      
122.     }
123.    
124.     #jesli klastry nie zmieniaja sie nastepuje zatrzymanie algorytmu
125.     if(sum(old_clusters - clusters, na.rm=TRUE) == 0 )
126.     {
127.       cat("wykonane iteracje: ", i)
128.       cat("\nkoncowe klastry\n")
129.       print(clusters)
130.      
131.       #moze sie zdarzyc, iz powstanie pusty klaster
132.       if(is.nan(sum(clusters)))
133.       {
134.         print("przynajmniej jeden z klastrow jest pusty")
135.       }
136.      
137.       data2 <- list(data, clusters)
138.       return(data2)
139.     }
140.     print("nowe klastry")
141.     print(clusters)
142.     cat("\nPunkty wraz z przypisanymi im klastrami po ", i)
143.     cat(" iteracjach\n")
144.     print(data)
145.     data2 <- list(data, clusters)
146.   }
147.   return(data2)
148. }
149.