• A joins, color: 0
• B joins, color: 1
• C joins, color: 2
• D joins, color: 3
• ...Time passes...
• E joins, color: 0
• F joins, color: 1

My code can do this, but: To build the interference graph (look at the source) the whole log has to be known.

  # 0=>A, B=>1, C=>2, D=>3, E=>4, F=>5
  # A joins
  $chat->tick(0, $stamp+0);
  # B joins
  $chat->tick(1, $stamp+1);
  # C joins
  $chat->tick(2, $stamp+2);
  # D joins
  $chat->tick(3, $stamp+3);
  # ...Time passes...
  # E joins
  $chat->tick(4, $stamp+10000+0);
  # F joins
  $chat->tick(4, $stamp+10000+1);

  # Get the colors:
  local $_;
  print "$_: " . join ", ", $chat->color($_) for 0..5;
[download]

I'd like a solution where the colors can get calculated before all other users are known:

  # 0=>A, B=>1, C=>2, D=>3, E=>4, F=>5
  # A joins
  $chat->tick(0, $stamp+0);
  print "A: " . join ", ", $chat->color(0);
  # B joins
  $chat->tick(1, $stamp+1);
  print "B: " . join ", ", $chat->color(1);
  # etc.
[download]

The problem is: The color calculating sub I use, calc_color, needs the total number of persons as an argument. But, at the point in time I'd like to call $chat->color there's no possibility to know the total number of persons in advance.

So, my question is: Is there a nice way To Do What I Want? Maybe there isn't a 100% correct algorithm, but a 99%? I.e. The algorithm is allowed to make "small mistakes".

The following code does work, but it needs full knowledge of all events in order to build the interference graph.

Thanks!

package Heinz::Colors;

use warnings;
use strict;

# FADE_AWAY specifies the time in seconds after a nick is considered a
+way/left.
use constant FADE_AWAY => 3600 * 2;
use constant DEBUG     => 0;

sub new { bless [
  {}, # current
  [], # interference graph
  [], # total number of people "met"
  [], # color_id
] => shift }

# $chat->tick(3, 1092927374) marks person id 3 as present at unix-time
# 1092927374.
sub tick {
  my ($self, $id, $time) = @_;

  # First, we fade out persons who haven't said anything for FADE_AWAY
+ seconds.
  $self->fade($time);

  # Mark $id as involved in a conversation.
  # If $self->cur->{$id} was false before the next line, the person ju
+st
  # joined.
  $self->cur->{$id} = $time;
  # keys %{ $self->cur } is now a list of "active people".

  # Now we update our interference graph $self->i.
  local $_;

  # Make sure we don't get ...is not a hashref... errors.
  $self->i->[$id] ||= {};
  # If $self->i->[$a]->{$b} is true, persons $a and $b have "met" each
+ other,
  # i.e. they said sth. in the same time window.

  # For everbody who's online ATM...
  for (keys %{ $self->cur }) {
    # ...mark $_ and $id as persons who have "met" each other.
    $self->i->[$id]->{$_}  = 1;
    $self->i->[$_] ->{$id} = 1;
  }
}

# $chat->fade(1092927374) fades all people away which haven't said any
+thing for
# FADE_AWAY seconds.
sub fade {
  my ($self, $time) = @_;

  local $_;

  # $self->cur is a hashref. If $self->cur->{$id} has a true value, pe
+rson $id
  # is currently involved in a conversation.
  # We delete everybody who hasn't said anything for FADE_AWAY seconds
+.
  for(keys %{ $self->cur }) {
    delete $self->cur->{$_} if $time - $self->cur->{$_} >= FADE_AWAY;
  }
  # delete()ing keys of a hash which is iterated over is safe as long 
+as the
  # key which is deleted is the current key.
}

# Calculate the "total number" of people $id met.
# Example (left-to-right: time):

# 
#   AAAAAAAAAAAAAAAAAAA
#      BBB      
#              CCCC    +--- No connection between A..E and F,G!
#       DDDDD          |
#          EEEEEEE     v
#                        FFFFFFF
#                          GGGGGGG
# 
# "Total number" count of A,B,C,D,E: 5
# "Total number" count of F,G:       2
# 
# The interference graph for this example is:
# 
#  4/5 E        0/2   1/2
#       \         F---G
#        \
#     0/5 A---B 1/5
#        / \
#       /   \
#  3/5 D     C 2/5
# 
# The "total number" of $id is the number of nodes in the graph $id is
+ in.
# The color_id/total_number pair is what we have to calculate (calc_co
+lor needs
# color_id and total_number as arguments).
sub collapse {
  my ($self, $id) = @_;

  # %visited is a hash of nodes we visited. If $visited{$a} is true, w
+e visited
  # node $a. That's necessary to break the recursion.
  my %visited;

  # $recurse is a coderef. It marks $iid, its first argument, as visit
+ed and
  # visits all nodes $iid is connected to.
  my $recurse; $recurse = sub {
    my $iid = shift;
    $visited{$iid} = 1;

    foreach my $iiid (keys %{ $self->i->[$iid] || {} }) {
      # Break the recursion: unless $visited{$iiid} -- Don't visit nod
+es we
      # already visited.
      $recurse->($iiid) unless $visited{$iiid};
    }
  };

  # Start.
  $recurse->($id);

  # The "total number" is the number of people we visited.
  my $count = keys %visited;

  # Now, assign color_ids. We have to sort keys %visited so we get the
+ same
  # color_ids each time we execute da script.
  my $i = 0;
  foreach my $iid (sort { $a <=> $b } keys %visited) {
    # $self->met: "Total number"
    $self->met->[$iid] = $count;

    # $self->col: color_id
    $self->col->[$iid] = $i++;
  }
}

# Return the color (C< ("#foreground", "#background") >) of person $id
+.
sub color {
  my ($self, $id) = @_;

  # If we haven't calculated the total number of people $id met, do th
+at now.
  $self->collapse($id) unless $self->met->[$id];

  # Fetch the values $self->collapse calculated.
  my ($me, $total) = ($self->col->[$id], $self->met->[$id] - 1);

  # And execute calc_color.
  return $self->calc_color($me, $total);
}

# calc_color copied from irclog2html.pl
# (http://freshmeat.net/projects/irclog2html.pl/), Copyleft (C) 2000-2
+002 Jeff
# Waugh, licensed under the Terms of the GNU General Public License, v
+ersion 2
# or higher.
# calc_color expects the total number of colors to assign ($_[2]) and 
+the color
# id ($_[1]) and returns a HTML-("#foreground", "#background")-pair wi
+th nice
# contrast etc.
# Take calc_color as a sub w/o errors.

sub calc_color {
  my ($self, $i, $ncolors) = @_;
    $ncolors = 1 if $ncolors == 0; # No division /0.

  my $a = 0.95;     # tune these for the starting and ending concentra
+tions of R,G,B
  my $b = 0.5;
  my $rgb = [ [$a,$b,$b], [$b,$a,$b], [$b,$b,$a], [$a,$a,$b], [$a,$b,$
+a], [$b,$a,$a] ];
  my $rgbmax = 125;   # tune these two for the outmost ranges of colou
+r depth
  my $rgbmin = 240;

  my $n = $i % @$rgb;
  my $m = $rgbmin + ($rgbmax - $rgbmin) * ($ncolors - $i) / $ncolors;

  my @c = map { $rgb->[$n][$_] * $m } 0 .. 2;
  my $g = $c[0] * .3 + $c[1] * .59 + $c[2] * .11;
  my $f = $g > 127 ? "#000000" : "#ffffff";
  my $h = sprintf "#%02x%02x%02x", @c;

  ($f, $h);
}

sub cur : lvalue { $_[0]->[0] }
sub i   : lvalue { $_[0]->[1] }
sub met : lvalue { $_[0]->[2] }
sub col : lvalue { $_[0]->[3] }

1;
[download]