R udostępnia algorytm Lloyda jako opcję dla kmeans(); domyślny algorytm, Hartigan i Wong (1979) jest znacznie mądrzejszy. Podobnie jak algorytm MacQueena (MacQueen, 1967), aktualizuje centroidy za każdym razem, gdy punkt zostanie przesunięty; to także sprawia, że sprytnie (oszczędzając czas) wyborów sprawdza się w najbliższym klastrze. Z drugiej strony algorytm k-średnich Lloyda jest pierwszym i najprostszym ze wszystkich algorytmów grupowania.
Algorytm Lloyda (Lloyd, 1957) przyjmuje zestaw obserwacji lub przypadków (pomyśl: wiersze macierzy nxp lub punkty w Reals) i grupuje je w grupy k. Stara się zminimalizować w klastrem sumę kwadratów 
gdzie u_i jest średnią wszystkich punktów w klastrze S_i. Wpływy algorytm następujące (będę oszczędzić Ci formalność wyczerpującym notacji): 
Jest problem z realizacją R jest jednak, a problem pojawia się, gdy rozważa wiele punktów wyjściowych. Powinienem zauważyć, że ogólnie rzecz biorąc rozważne jest rozważanie kilku różnych punktów początkowych, ponieważ algorytm gwarantuje zbieg, ale nie jest gwarantowany, aby zapewnić globalną optymalność. Jest to szczególnie ważne w przypadku dużych, wielowymiarowych problemów związanych z . Zacznę od prostego przykładu (dużego, nieszczególnie trudnego).
(Tutaj będę wkleić kilka zdjęć, ponieważ nie możemy napisać matematycznego formulaswith lateks)
Należy zauważyć, że rozwiązanie jest bardzo podobny do osiągniętego wcześniej, chociaż Zamawianie klastrów jest arbitralne. Co ważniejsze, praca trwała tylko 0.199 sekund! Z pewnością jest to zbyt piękne, aby mogło być prawdziwe: używanie 3 rdzeni procesorów powinno w najlepszym przypadku zajmować jedną trzecią czasu naszego pierwszego (sekwencyjnego) przebiegu. Czy to problem? To brzmi jak darmowy lunch. Nie ma problemu z darmowym obiadem raz na jakiś czas, prawda?
To nie zawsze działa z funkcji R, ale czasami mamy szansę spojrzeć bezpośrednio w kodzie. To jeden z tych czasów. Zamierzam umieścić ten kod w pliku, mykmeans.R, i edytować go ręcznie, wstawiając instrukcje cat() w różnych miejscach. Oto sprytny sposób zrobić to, używając umywalkę() (choć nie wydają się działać w Sweave, to będzie działać interaktywnie):
> sink("mykmeans.R")
> kmeans
> sink()
teraz edycję pliku, zmiana nazwy funkcji i dodanie kota() sprawozdania. Uwaga że trzeba także usunąć linię spływu::
Możemy następnie powtórzyć nasze poszukiwania, ale przy użyciu mykmeans():
> source("mykmeans.R")
> start.kmeans <- proc.time()[3]
> ans.kmeans <- mykmeans(x, 4, nstart = 3, iter.max = 10, algorithm = "Lloyd")
JJJ statement 1: 0 elapsed time.
JJJ statement 5: 2.424 elapsed time.
JJJ statement 6: 2.425 elapsed time.
JJJ statement 7: 2.52 elapsed time.
JJJ statement 6: 2.52 elapsed time.
JJJ statement 7: 2.563 elapsed time.
Teraz my” Ponownie w biznesie: większość czasu została zużyta przed stwierdzeniem 5 (wiedziałem o tym z kursu , dlatego oświadczenie 5 było 5 zamiast 2) ... Ty Można grać dalej z nim
Oto kod:
#######################################################################
# kmeans()
N <- 100000
x <- matrix(0, N, 2)
x[seq(1,N,by=4),] <- rnorm(N/2)
x[seq(2,N,by=4),] <- rnorm(N/2, 3, 1)
x[seq(3,N,by=4),] <- rnorm(N/2, -3, 1)
x[seq(4,N,by=4),1] <- rnorm(N/4, 2, 1)
x[seq(4,N,by=4),2] <- rnorm(N/4, -2.5, 1)
start.kmeans <- proc.time()[3]
ans.kmeans <- kmeans(x, 4, nstart=3, iter.max=10, algorithm="Lloyd")
ans.kmeans$centers
end.kmeans <- proc.time()[3]
end.kmeans - start.kmeans
these <- sample(1:nrow(x), 10000)
plot(x[these,1], x[these,2], pch=".")
points(ans.kmeans$centers, pch=19, cex=2, col=1:4)
library(foreach)
library(doMC)
registerDoMC(3)
start.kmeans <- proc.time()[3]
ans.kmeans.par <- foreach(i=1:3) %dopar% {
return(kmeans(x, 4, nstart=1, iter.max=10, algorithm="Lloyd"))
}
TSS <- sapply(ans.kmeans.par, function(a) return(sum(a$withinss)))
ans.kmeans.par <- ans.kmeans.par[[which.min(TSS)]]
ans.kmeans.par$centers
end.kmeans <- proc.time()[3]
end.kmeans - start.kmeans
sink("mykmeans.Rfake")
kmeans
sink()
source("mykmeans.R")
start.kmeans <- proc.time()[3]
ans.kmeans <- mykmeans(x, 4, nstart=3, iter.max=10, algorithm="Lloyd")
ans.kmeans$centers
end.kmeans <- proc.time()[3]
end.kmeans - start.kmeans
#######################################################################
# Diving
x <- read.csv("Diving2000.csv", header=TRUE, as.is=TRUE)
library(YaleToolkit)
whatis(x)
x[1:14,c(3,6:9)]
meancol <- function(scores) {
temp <- matrix(scores, length(scores)/7, ncol=7)
means <- apply(temp, 1, mean)
ans <- rep(means,7)
return(ans)
}
x$panelmean <- meancol(x$JScore)
x[1:14,c(3,6:9,11)]
meancol <- function(scores) {
browser()
temp <- matrix(scores, length(scores)/7, ncol=7)
means <- apply(temp, 1, mean)
ans <- rep(means,7)
return(ans)
}
x$panelmean <- meancol(x$JScore)
Oto opis:
Number of cases: 10,787 scores from 1,541 dives (7 judges score each
dive) performed in four events at the 2000 Olympic Games in Sydney,
Australia.
Number of variables: 10.
Description: A full description and analysis is available in an
article in The American Statistician (publication details to be
announced).
Variables:
Event Four events, men's and women's 3M and 10m.
Round Preliminary, semifinal, and final rounds.
Diver The name of the diver.
Country The country of the diver.
Rank The final rank of the diver in the event.
DiveNo The number of the dive in sequence within round.
Difficulty The degree of difficulty of the dive.
JScore The score provided for the judge on this dive.
Judge The name of the judge.
JCountry The country of the judge.
A zbiór danych do eksperymentowania z nim https://www.dropbox.com/s/urgzagv0a22114n/Diving2000.csv
Możecie dostać dużo większą uwagę na Witryna wymiany stosów "Cross Validated". – kdauria