Clusteranalyse

Im Zusammenhang mit der Untersuchung des Surf-Verhaltens von Website-Besuchern bin ich auf das Mittel der Clusteranalyse gestossen. Die Clusteranalyse dient dazu, Individuen, denen ein oder mehrere numerische Merkmale zugeordnet werden könnnen, zu Clustern zusammen zu fassen, sodaß ähnliche Individuen im gleichen Cluster landen. Internet-Shops nutzen soche Analysen gerne um Nutzern zum Beispiel Bücher zu empfehlen. Dabei wird untersucht, ob es andere Nutzer mit einem ähnlichen Profil gibt. Die Bücher, die diese außerdem gekauft haben werden dem Shop-Benutzer dann empfohlen.

Bei der hier vorgestellten hierrarchischen Clusteranalyse werden wird der gesamte Datenbestand als Baum zusammengefasst. Die Individuen befinden sich nur in den Blättern

Der Algrithmus geht so vor, daß zunächst alles Individuen als Cluster aufegefasst werden. Sodann werden immer die Cluster, die sich am ähnlichsten sind (-> den geringsten Euklidischen Abstand haben) zu einem Cluster zusammengefasst. Die Berechnung endet, wenn nur noch ein Cluster übrig bleibt

Das Modul unten ist ein erster Prototyp, der eine solche Analyse durchführt.

package Cluster;
use strict;
use warnings;
# hierachische Clusteranalyse                                                                                                                                                                                                                               
sub new {
    # erzeuge neuen endknoten                                                                                                                                                                                                                               
    my ($class,$center) = @_;
    return bless {
        center => $center,
        nodes  => 1,
    }, $class;
}

sub combine {
    # fasse zwei cluster zu einem zusammen                                                                                                                                                                                                                  
    my ($class,$l,$r)= @_;
    my $res = bless {
        left=>$l,
        right=>$r,
        nodes=>do {
            my $n = 0;
            $n += $l->{nodes} if $l;
            $n += $r->{nodes} if $r;
            $n;
        },
    }, $class;
    my $fact_l = $l->{nodes};
    my $fact_r = $r->{nodes};
    my $quot = $res->{nodes};
    for (0..$#{$l->{center}}) {
        $res->{center}->[$_]=
             ($fact_l*$l->{center}->[$_]
              +$fact_r*$r->{center}->[$_])
             / $quot;
    }
    return $res;
}

sub distance {
    # bestimme die Distanz zwischen zwei clustern                                                                                                                                                                                                           
    my ($self,$other)=@_;
    die "Incompatible clusters" unless scalar(@{$self->{center}}) == scalar(@{$other->{center}});
    my $N = scalar(@{$self->{center}});
    my $h2;
    for my $i (0.. $N-1) {
        $h2 += ($self->{center}->[$i] - $other->{center}->[$i])**2;
    }
    return sqrt($h2);
}

use Memoize;
memoize "distance";

sub do_clustering {
    # führe hierarchisches clustering durch.                                                                                                                                                                                                                
    my (@clusters)  = @_;
    while (scalar(@clusters) > 1) {
        my $N=scalar(@clusters);
        my ($i_min,$j_min,$d_min) = (-1,-1,1e99);
        for my $i (0..$N-1) {
            for my $j ($i+1..$N-1) {
                my $d = $clusters[$i]->distance($clusters[$j]);
                if ($d < $d_min) {
                    ($i_min,$j_min,$d_min)=($i,$j,$d)
                }
            }
        }
        # $i_min und $j_min zusammenfassen                                                                                                                                                                                                                  
#       print "cluster($i_min,$j_min)\n";                                                                                                                                                                                                                   
        $clusters[$i_min] = __PACKAGE__->combine($clusters[$i_min],$clusters[$j_min]);
        $clusters[$j_min]=$clusters[$#clusters];
        pop @clusters;
    }
    return $clusters[0];
}
1;

Aufruf-Beispiel:

use Cluster;
my @clusters;

for  (1..200) {
    push @clusters,Cluster->new([int(rand(10)-5),int(rand(10)-5),int(rand(10)-5)]);
}

use Data::Dumper;
print Dumper( Cluster::do_clustering(@clusters));