Blog: "Thema: R", deel 7

In deze blog wordt R code gepresenteerd die benut kan worden om een datastructuur te transformeren.
Blog: "Thema: R", deel 7

Clusteranalyse is een veelgebruikt instrument om data te segmenteren. In dit blog worden een aantal R-functies gepresenteerd die gecombineerd een clusteranalyse uitvoeren.

(1)    av <- function(x) sum(x) / length(x)

Een snelle methode om een rekenkundig gemiddelde te bepalen.

(2)    cw <- function(x){
v <- as.numeric(as.factor(x))
s <- 1:length(unique(x))
f <- function(x) (v == s[x]) * v
m1 <- vapply(s, f, v)
m1 / (m1 + 1.0e-10)
}

De functie cw maakt een indicator matrix van een eq_ size – vector. Deze vector vervult in de clusteranalyse een criterium functie. Met andere woorden: op basis van de waarden van deze vector wordt de clustering uitgevoerd.

(3)    eq_size <- function(x, y) {
t1 <- x + (abs(min(x)) + 1)
t2 <- unique(as.list(quantile(t1, seq(0, 1, 1 / y), type = 2))[1:y])
t3 <- vapply(t2, function(w) ceiling(floor(t1 / w) / max(floor(t1 / w))) , numeric(length(x)))
rowSums(t3)
}

Eq_size verdeeld een vector in groepen van gelijke omvang.

Laten we de mtcars dataset uit R nemen als voorbeeld. Eerst standaardiseren we mtcars door over de kolommen z- scores te berekenen.  Vervolgens nemen we de kolomvector van rijsommen en passen daarop de functies eq_size en cw toe.

IM <- cw(eq_size(rowSums(scale(mtcars)), 6))

IM is een binaire [32, 6] matrix.

De twee stap is het transformeren van IM tot een logische matrix.

(4)    col_t <- function(x, f) {
r1 <- function(z) f(x[, z])
r2 <- lapply(1:dim(x)[2], r1)
do.call(cbind, r2)
}

W <- col_t(IM, function(x) as.logical(x))

W is een logische [32, 6] matrix.

De matrix W wordt benut om de gestandaardiseerde data te segmenteren via de functie d_clust.

(5)    d_clust <- function(data, W, f) {
L <- c(1:dim(W)[2])
cluster <- function(x){
x1 = data[W[ ,x], ]
x2 = f(x1)
}
lapply(L, cluster)
}

Per cluster is het mogelijk de passing van de analyse te berekenen via de functie cen_f

(6)    cen_f <- function(x){
na <- rownames(x)
xd <- length(na)
CM <- data.frame(colMeans(x))
names(CM) <- c("centroid-values")
BI <- sum(col_t(x, var))
TU <- (av(x) - CM)^2 * xd
fit <- ro(av(TU / (TU + BI)))
attributes(fit) = NULL
names(fit) <- c("clusterfit")
list(CM, fit, na)
}

cen_f geeft voor ieder cluster de ratio Errror variantie/ totale variantie. Bovendien plaatst cen_f de centroid waarden en de namen van de clusterelementen in twee aparte objecten.

Tenslotte brengen we alle functies onder in een omvattend clusterC algoritme:

(7)    clusterC <- function(x, nclus) {
x <- data.frame(scale(x))
crit <- rowSums(x)
na <- matrix(rownames(x), ,1)
IM <- cw(eq_size(crit, nclus))
W <- col_t(IM, function(x) as.logical(x))
V <- d_clust(x, W, cen_f)
names(V) <- paste("CLUSTER", 1:nclus,"")
fit_o <- av(unlist(lapply(V, function(x) x[[2]])))
list(result = V, mean_fit = ro(fit_o))
}

Het is na stap (7) bijzonder eenvoudig een exploratieve clusteranalyse uit te voeren met de uitsluitend de functie clusterC:

Eerst bepalen we het aantal clusters via maximalisatie van de fitmaat:

(clusterC(mtcars, 7)$mean_fit)
{1]          0.29
(clusterC(mtcars, 4)$mean_fit)
[1]          0.46
(clusterC(mtcars, 3)$mean_fit)
[1]          0.63

Vervolgens selecteren we de gewenste gegevens via $result en rechte haken:

(clusterC(mtcars, 3)$result[[1]])
centroid-values
mpg                       -0.37
cyl                        0.57
disp                       0.41
hp                         0.05
drat                      -0.95
wt                         0.28
qsec                       0.14
vs                        -0.27
am                        -0.81
gear                      -0.93
carb                      -0.50
[[2]]
clusterfit 
       0.9 
[[3]]
 [1] "Hornet 4 Drive"    "Hornet Sportabout" "Valiant"          
 [4] "Merc 450SE"        "Merc 450SL"        "Merc 450SLC"      
 [7] "Toyota Corona"     "Dodge Challenger"  "AMC Javelin"      
[10] "Pontiac Firebird"

De centroid waarden geven het profiel van de 10 merken over 11 kenmerken. Het zijn afwijkingsscores die uitgedrukt worden in eenheden standaarddeviatie. De criterium waarden stijgen met het clusternummer.

De functie eq_size beoogt uitdrukkelijk groepen te maken van gelijke omvang en plaatst deze in een vector van laag naar hoog. Dit stelt ons in staat snel laag scorende met hoog scorende groepen te vergelijken.

In een volgend blog laten we zien hoe we de criteriumvector op een andere manier kunnen bepalen.