Compute estimated merge times for Robin chatrooms (robin-estmerge: Estimated merge times in 80 lines; robin-cascade: human-readable output and other computations)

robin-cascade.pl

#!/usr/bin/perl
use JSON;
use warnings;
use strict;

my $EST_TIERS = 0;              # Estimate tiers of existing chats
my $T1_INTERVAL = -1;#9;           # In seconds (8000->6000 in 5-9PM => 9 sec)

my @duration = (0, 1, 3, 7, 15, 31);
sub duration {
    my ($level) = @_;
    my $dur =$duration[$level < @duration ? $level : -1];
    return $dur * 60;
}

my $obj = from_json(`curl -sS https://monstrouspeace.com/robintracker/json.php`);
$obj or die;
#my @counts = ();
#my @pop = ();

# Room tree [0=GUID, 1=Name, 2=Ready time, 3=Estimated time] for each tier
my @rooms = (undef, []);

# Estimate remaining tiers and count of rooms at each tier
foreach my $r ( @$obj ) {
    my $tier = $r->{tier};
    my $count = $r->{count};
    $tier = 0 if $tier =~ /\D/;
    $count = 0 if $count =~ /\D/;
    if ( $EST_TIERS && $count ) {
        my $est = int(log($count > 2 ? $count : 2)/log(2)+0.5);
        warn "Estimated level for $r->{room} as $est, actually $tier"
            if $tier and $tier < $est;
        $tier = $est if !$tier;
    }
    warn "Unable to estimate tier of $r->{room}: $count users"
        if $EST_TIERS and !$tier;
    #$pop[$tier] += $count;
    #$counts[$tier]++;
    $rooms[$tier] ||= [];
    push @{$rooms[$tier]}, [$r->{guid}, $r->{room}, $r->{reap}, -1];
}

$_ ||= [] foreach @rooms;

# Estimate additional participants required for a new room of each level
my $newpop = 0;
for my $level ( 17, 16, 15, 14, 13, 12 ) {
    my $total = 2**$level;
    for ( my $tier = 1; $tier < @rooms && $tier < $level; $tier++ ) {
        $total -= @{$rooms[$tier]} * 2**$tier;
    }
    printf("For T%2d: %6d more people\n", $level, $total);
    $newpop = $total if $total > $newpop;
}

# Generate fake rooms in room tree
my $now = time;
{
    my $t1_dur = duration(1);
    for ( my $i = 0; $i < $newpop+1; $i += 2 ) {
        if ( $T1_INTERVAL >= 0 ) {
            my $start = $now + $i * $T1_INTERVAL;
            push @{$rooms[1]}, ["U-$i", '', $start + $t1_dur, -1];
        }
    }
}

# Estimate merge times for each room
my $mcount = 0;
sub _sortable_time {
    my ($tm) = @_;
    return $tm < 0 ? 0x7FFFFFFF : $tm;
}

sub _wait {
    my ($dest) = @_;
    if ( $dest < 0 ) {
        return "never";
    }
    my $delta = $dest - time;
    my $str = '';
    if ( $delta < 0 ) {
        $str .= '-';
        $delta *= -1;
    }
    my $s = $delta % 60;
    $delta = int($delta/60);
    my $m = $delta % 60;
    $delta = int($delta/60);
    my $h = $delta;
    $str .= $h ? ($h . 'h') : '';
    $str .= sprintf("%02dm%02ds", $m, $s);
    return $str;
}

print "Tier Room Name    Scheduled   Estimated\n";
print "---------------------------------------\n";
for ( my $tier = 0; $tier < @rooms; $tier++ ) {
    next unless $rooms[$tier] && @{$rooms[$tier]};
    unless ( $tier ) {
        # Skip rooms at tier zero
        warn scalar(@{$rooms[$tier]}) . " rooms at tier 0";
        next;
    }

    # Make sure we have a list we can merge rooms into
    $rooms[$tier+1] ||= [];
    my $next_dur = duration($tier+1);

    # Merge the rooms in order of ready time
    my @a = sort { _sortable_time($a->[2]) <=> _sortable_time($b->[2]) }
        @{$rooms[$tier]};
    for ( my $i = 0; $i+1 < @a; $i += 2 ) {
        # Merge two rooms at a time
        my $atime = $a[$i  ][2];
        my $btime = $a[$i+1][2];
        # Compute merge time as latest ready time
        my $mtime;
        if ( $atime < 0 or $btime < 0 ) {
            $mtime = -1;
        }
        elsif ( $atime < $now and $btime < $now ) {
            $mtime = $now;
        }
        else {
            $mtime = $atime > $btime ? $atime : $btime;
        }
        $a[$i][3] = $a[$i+1][3] = $mtime;
        # Create merged room and compute its expiration time
        $mtime += $next_dur if $mtime >= 0;
        $mcount++;
        push @{$rooms[$tier+1]}, ["M-$mcount", '', $mtime, -1]
    }

    # Output
    for ( my $i = 0; $i < @a; $i++ ) {
        printf("T%2d: %-10s %11s %11s\n", $tier, $a[$i][1]||"($a[$i][0])",
               _wait($a[$i][2]), _wait($a[$i][3]));
    }
}

robin-estmerge.pl

#!/usr/bin/perl
#
# robin-estmerge.pl - Compute estimated merge times for Robin chatrooms
#
use JSON;
use warnings;
use strict;

# Durations for each next tier
my @duration = (0, 1, 3, 7, 15, 31);
sub duration {
    my ($level) = @_;
    my $dur =$duration[$level < @duration ? $level : -1];
    return $dur * 60;
}

# Room tree. Each element of @rooms is a list of rooms at each tier.
# Rooms are of the form [0=GUID, 1=Name, 2=Ready time, 3=Estimated time].
my @rooms = ();

# Load room data and separate by tier
my $obj = from_json(`curl -sS https://monstrouspeace.com/robintracker/json.php`) or die;
foreach my $r ( @$obj ) {
    next if $r->{tier} =~ /\D/;
    $rooms[$r->{tier}] ||= [];  # Initialize tier to empty array
    push @{$rooms[$r->{tier}]}, [$r->{guid}, $r->{room}, $r->{reap}, -1];
}
# Make sure all tiers are initialized
$_ ||= [] foreach @rooms;

my $mcount = 0;

# When sorting rooms by ready time, use 'year 2038' instead of -1
# because those rooms will merge last.
sub _sortable_time {
    my ($tm) = @_;
    return $tm < 0 ? 0x7FFFFFFF : $tm;
}

my $now = time;
for ( my $tier = 1; $tier < @rooms; $tier++ ) {
    next unless $rooms[$tier] && @{$rooms[$tier]};

    # Make sure we have a list we can merge rooms into
    my $next_dur = duration($tier+1);

    # Merge the rooms in order of (sortable) ready time
    my @a = sort { _sortable_time($a->[2]) <=> _sortable_time($b->[2]) }
        @{$rooms[$tier]};
    for ( my $i = 0; $i+1 < @a; $i += 2 ) {
        # Merge two rooms at a time
        my $atime = $a[$i  ][2];
        my $btime = $a[$i+1][2];
        # Compute merge time as latest ready time
        my $mtime;
        if ( $atime < 0 or $btime < 0 ) {
            # If any room has a -1 merge time, it won't merge.
            $mtime = -1;
        }
        elsif ( $atime < $now and $btime < $now ) {
            # If the ready times are both in the past, we will merge now.
            $mtime = $now;
        }
        else {
            # Otherwise, take the latest ready time as the merge time
            $mtime = $atime > $btime ? $atime : $btime;
        }
        $a[$i][3] = $a[$i+1][3] = $mtime;

        # Create merged room and compute its scheduled ready time
        next if $tier+1 >= @rooms;
        $mtime += $next_dur if $mtime >= 0;
        $mcount++;
        push @{$rooms[$tier+1]}, ["M-$mcount", '', $mtime, -1]
    }

    # Output
    for ( my $i = 0; $i < @a; $i++ ) {
        next unless $a[$i][1];
        print "$rooms[$tier][$i][1] $rooms[$tier][$i][3]\n";
    }
}