R fornisce l'algoritmo di Lloyd come opzione per kmeans(); l'algoritmo predefinito, per Hartigan and Wong (1979) è molto più intelligente. Come l'algoritmo di MacQueen (MacQueen, 1967), aggiorna i centroidi ogni volta che un punto viene spostato; inoltre effettua scelte intelligenti (risparmio di tempo) nel controllo del cluster più vicino. D'altra parte l'algoritmo K-means di Lloyd è il primo e il più semplice di tutti questi algoritmi di clustering.
algoritmo di Lloyd (Lloyd, 1957) richiede una serie di osservazioni o casi (pensate: righe di una matrice nxp, o punti in real) e li cluster in k gruppi. Si cerca di ridurre al minimo il all'interno del cluster somma dei quadrati 
dove u_i è la media di tutti i punti del cluster S_i. L'algoritmo procede come segue (io ti la formalità della notazione esaustivo ricambio): 
C'è un problema con l'attuazione di R, tuttavia, e il problema si pone quando si considera molteplici punti di partenza. Devo notare che è generalmente prudente considerare diversi punti di partenza differenti, poiché l'algoritmo è garantito per convergere, ma non è garantito da per coprire un optima globale. Ciò è particolarmente vero per problemi di dimensioni elevate, ad alta dimensionalità . Inizierò con un semplice esempio (grande, non particolarmente dettato).
(Qui mi limiterò a incollare alcune immagini come non possiamo scrivere matematica lattice formulaswith)
Si noti che la soluzione è molto simile a quella raggiunta in precedenza, anche se il l'ordinamento dei cluster è arbitrario. Ancora più importante, il lavoro ha richiesto solo 0,199 secondi in parallelo! Sicuramente questo è troppo bello per essere vero: l'utilizzo di 3 processori core dovrebbe, nel migliore dei casi, prendere un terzo del tempo della nostra prima (sequenziale) esecuzione. È un problema? Sembra un pranzo gratis. Non c'è il problema con un pranzo gratis una volta ogni tanto, c'è?
Questo non sempre funziona con le funzioni di ricerca, ma a volte abbiamo la possibilità di guardare direttamente il codice. Questa è una di quelle volte. Inserirò questo codice nel file mykmeans.R, e lo modificherò a mano, inserendo le dichiarazioni cat() in vari punti. Ecco un modo intelligente per fare questo, utilizzando lavandino() (anche se questo non sembra funzionare in Sweave, funzionerà in modo interattivo):
> sink("mykmeans.R")
> kmeans
> sink()
Ora la modifica del file, cambiando il nome della funzione e l'aggiunta di gatto() dichiarazioni. Si noti che si hanno anche per cancellare una riga finale::
Siamo in grado di ripetere le nostre esplorazioni, ma utilizzando 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.
Ora noi' in attività: la maggior parte del tempo è stata consumata prima dell'affermazione 5 (lo sapevo del corso , motivo per cui l'affermazione 5 era 5 anziché 2) ... Tu può continuare a giocare con esso
Ecco il codice:
#######################################################################
# 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)
Qui è la descrizione:
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.
E dataset di sperimentare con esso https://www.dropbox.com/s/urgzagv0a22114n/Diving2000.csv
Si potrebbe ottenere molto di più attenzione a il sito di scambio dello stack "Cross Validated". – kdauria