#!/usr/bin/perl -w
use strict;

my $numTracks  = shift or die;
my $perSession = shift or die;
my $lambda     = shift or die;

my $url = <>; chomp $url;
my $title = <>; chomp $title;

my @doc = ();
my $N   = 0;
my @info = ();
while (<>) {
    chomp;
    my ($url, $num, $title, $words) = split /\t/, $_;
    my @w = split /[\s]+/, $words;
    foreach my $w (@w) { $doc[$N]{$w}++; }
    $info[$N]{URL} = $url;
    $info[$N]{TIT} = $title;
    $N++;
}

my %df = ();
for (my $n=0; $n<$N; $n++) {
    foreach my $w (keys %{$doc[$n]}) { $df{$w}++; }
}

#print STDERR "$N: ";
my %g = ();
for (my $n=0; $n<$N; $n++) {
    #print STDERR ".";
    for (my $m=$n+1; $m<$N; $m++) {
        $g{$n}{$m} = similarity(\%{$doc[$n]}, \%{$doc[$m]});
    }
}

#print STDERR "\n";

# assign papers to sessions

my @order = ();
for (my $n=0; $n<$N; $n++) { $order[$n] = $n; }
for (my $n=0; $n<$N; $n++) {
    my $m = int(rand()*($N-$n)) + $n;
    my $t = $order[$n];
    $order[$n] = $order[$m];
    $order[$m] = $t;
}

my @S = ();
my $n = 0;
my $s = 0;
my $t = 0;
my $i = 0;
while ($n < $N) {
    $S[$s][$t][$i] = $order[$n];
    $n++;
    $i++; 
    if ($i >= $perSession) { $i = 0; $t++; }
    if ($t >= $numTracks)  { $t = 0; $s++; }
}


my $temp = 1;
my $iter = 0;
my $E = energy(@S);
while (1) {
    $iter++;
    # print "it $iter E = " . $E . " temp=$temp\n";

    if (rand() < 0.5) { # swap papers
        my $s1 = int(rand() * scalar @S);
        my $t1 = int(rand() * scalar @{$S[$s1]});
        my $i1 = int(rand() * scalar @{$S[$s1][$t1]});

        my $s2 = int(rand() * scalar @S);
        my $t2 = int(rand() * scalar @{$S[$s2]});
        my $i2 = int(rand() * scalar @{$S[$s2][$t2]});

        my $n1 = $S[$s1][$t1][$i1];
        my $n2 = $S[$s2][$t2][$i2];
    
        $S[$s1][$t1][$i1] = $n2;
        $S[$s2][$t2][$i2] = $n1;
        
        my $E2 = energy(@S);
        if (($E2 < $E) || (rand() < $temp)) {
            $E = $E2;
        } else {
            # revert
            $S[$s1][$t1][$i1] = $n1;
            $S[$s2][$t2][$i2] = $n2;
        }
    } else { # swap sessions
        my $s1 = int(rand() * scalar @S);
        my $t1 = int(rand() * scalar @{$S[$s1]});

        my $s2 = int(rand() * scalar @S);
        my $t2 = int(rand() * scalar @{$S[$s2]});

        my @a1 = @{$S[$s1][$t1]};
        my @a2 = @{$S[$s2][$t2]};
    
        @{$S[$s1][$t1]} = @a2;
        @{$S[$s2][$t2]} = @a1;
        
        my $E2 = energy(@S);
        if (($E2 < $E) || (rand() < $temp)) {
            $E = $E2;
        } else {
            # revert
            @{$S[$s1][$t1]} = @a1;
            @{$S[$s2][$t2]} = @a2;
        }
    }

    $temp *= 0.995;

    if ($iter >= 10000) { last; }
}

for (my $s=0; $s<@S; $s++) {
    print "SESSION $s\n";
    for (my $t=0; $t<@{$S[$s]}; $t++) {
        print "  TRACK $t\n";
        for (my $i=0; $i<@{$S[$s][$t]}; $i++) {
            print "    " . $info[$S[$s][$t][$i]]{TIT} . "\n";
        }
    }
}


sub similarity {
    my ($a, $b) = @_;
    my $n = 0; my $m = 0; my $d = 0;
    foreach my $x (keys %$a) {
        my $v = $a->{$x} * log($N / $df{$x});
        $n += $v * $v;
        if (exists $b->{$x}) {
            my $u = $b->{$x} * log($N / $df{$x});
            $d += $v * $u;
        }
    }
    foreach my $x (keys %$b) {
        my $v = $b->{$x} * log($N / $df{$x});
        $m += $v * $v;
    }
    return $d; # / sqrt($a * $b);
}

sub energy {
    my @S = @_;

    # if two very similar papers are in *opposing* tracks, this gives
    # us high energy.  if two very similar papers are in the same
    # session, this gives us low energy.  we otherwise don't care.

    # so for a given session, look at all tracks in this session.
    # for, say, track 1, look at all papers in this track.  we want
    # them all to be *very* similar.  so sum up their negative
    # similarities.

    # now, look at every pair of tracks in a session.  look at pairs
    # of papers in those tracks.  sum up their positive similarities.

    my $E = 0;

    for (my $s=0; $s<@S; $s++) {
        for (my $t=0; $t<@{$S[$s]}; $t++) {
            for (my $i=0; $i<@{$S[$s][$t]}; $i++) {
                for (my $j=$i+1; $j<@{$S[$s][$t]}; $j++) {
                    if ($S[$s][$t][$i] < $S[$s][$t][$j]) {
                        $E -= $lambda * $g{$S[$s][$t][$i]}{$S[$s][$t][$j]};
                    } else {
                        $E -= $lambda * $g{$S[$s][$t][$j]}{$S[$s][$t][$i]};
                    }
                }
            }
            for (my $u=$t+1; $u<@{$S[$s]}; $u++) {
                for (my $i=0; $i<@{$S[$s][$t]}; $i++) {
                    for (my $j=0; $j<@{$S[$s][$u]}; $j++) {
                        #print STDERR "[$S[$s][$t][$i] vs $S[$s][$u][$j]]\n";
                        if ($S[$s][$t][$i] < $S[$s][$u][$j]) {
                            $E += (1-$lambda) * $g{$S[$s][$t][$i]}{$S[$s][$u][$j]};
                        } else {
                            $E += (1-$lambda) * $g{$S[$s][$u][$j]}{$S[$s][$t][$i]};
                        }
                    }
                }
            }
        }
    }

    return $E;
}
