Un programa dinámico para minimizar la suma de grupo desviaciones sujeto a estas restricciones es simple y razonablemente rápida, especialmente para un estrecho rango de tamaños de grupo. Se reproduce el publicado solución.
![Figure]()
Los datos se representan como punto de símbolos. Los grupos están codificadas por color y separados por líneas verticales. El grupo de medios se trazan como líneas horizontales.
Comentó R código de la siguiente manera. Calcula la solución de forma recursiva, el logro de la eficiencia mediante el almacenamiento en caché de los resultados a medida que avanza. El programa cluster(x,i) encuentra (y posteriormente registra) la mejor solución empieza en el índice i en la matriz de datos x buscando entre todos los posibles ventanas de longitudes n.min través n.max inicio índice i. Vuelve el mejor valor encontrado hasta el momento (y, dentro de la variable global cache$Breaks, deja tras de sí un indicador de los índices que se inicia cada grupo). Puede procesar matrices de miles de elementos en cuestión de segundos, dependiendo de cuán grande sea el rango de n.max-n.min es. Para problemas más grandes que tendría que ser mejorado para incluir algunos branch-and-bound heurística para limitar la cantidad de la búsqueda.
#
# Univariate minimum-variance clustering with constraints.
# Requires a global data structure `cache`.
#
cluster <- function(x, i) {
#
# Cluster x[i:length(x)] recursively.
# Begin with the terminal cases.
#
if (i > cache$Length) return(0) # Nothing to process $
cache$Breaks[i] <<- FALSE # Unmark this break $
if (i + cache$n.min - 1 > cache$Length) return(Inf)# Interval is too short
if (!is.na(v <- cache$Cache[i])) return(v) # Use the cached value $
n.min <- cache$n.min + i-1 # Start of search $
n.max <- min(cache$n.max + i-1, cache$Length) # End of search
if (n.max < n.min) return(0) # Prevents `R` errors
#
# The recursion: accumulate the best total within-group variances.
# To implement other objective functions, replace `var` by any measure of
# within-group homogeneity.
#
values <- sapply(n.min:n.max, function(k) var(x[i:k]) + cluster(x, k+1))
#
# Find and store the best result.
#
j <- which.min(values)
cache$Breaks[n.min + j] <<- TRUE # Mark this as a good break $
cache$Cache[i] <<- values[j] # Cache the result $
return(values[j]) # Pass it to the caller
}
#
# The data.
#
x <- c(3,2,1,3,4,5,0,0,0,1,2,3,2,8,9,10,9,8,2,3,4,9,5,3)
#
# Initialize `cache` to specify the constraints; and run the clustering.
#
system.time({
n <- length(x)
cache <- list(n.min=4, n.max=10, # The length constraints
Cache=rep(NA, n), # Values already found
Breaks=rep(FALSE, n+1), # Group start indexes
Length=n) # Cache size
cluster(x, 1) # I.e., process x[1:n]
cache$Breaks[1] <- TRUE # Indicate the start of the first group $
})
#
# Display the results.
#
breaks <- (1:(n+1))[cache$Breaks] # Group start indexes $
groups <- cumsum(cache$Breaks[-(n+1)]) # Group identifiers
averages <- tapply(x, groups, mean) # Group summaries
colors <- terrain.colors(max(groups)) # Group plotting colors
plot(x, pch=21, bg=colors[groups], ylab="Rating")
abline(v = breaks-1/2, col="Gray")
invisible(mapply(function(left, right, height, color) {
lines(c(left, right)-1/2, c(height, height), col=color, lwd=2)
}, breaks[-length(breaks)], breaks[-1], averages, colors))
