processing a list of events

[BluePerlDev]

So, I have an array of 2 types of events, and the times they occurred. I need to parse through the array and take teh time of the first Event A, and then find the first Event B after Event A, and calculate the time delta. using a simple grep on the array isn't a viable option because there could be multiple occurrences of Event A before there is an Event B, potentially looking like this:

EVENT A
EVENT A
EVENT B
EVENT A
EVENT A
EVENT A
EVENT B
EVENT A
EVENT B

I had initially thought of using a for loop with a dual index, something that would look kinda like this:

my $i = 0;
my $j = $i;
 
       for ( $i ; $i <= $#eventlist ; $i++ ){
          print "i is $i, j is $j\n";
          my ($subj,$date) = split(',',$eventlist[$i]);
          if ( $subj eq "Event B" ){
             while ( $subj ne "Event A" ){
                 $i++;
              ($subj,$date) = split(',',$eventlist[$i]);
             }
          print "i is $i, j is $j\n";
             $j = $i;
          print "i is $i, j is $j\n";
             my ($str,$date1) = split(',',$eventlist[$i]);
             my ($subj2,$x) = split(',',$eventlist[$j]);
             while ( $subj2 ne "Event B" ){
                 $j++;
             ($subj2,$x) = split(',',$eventlist[$j]);

But that never finished, and stayed at the top 2 events of the array. I was looking at the List::Util and List::MoreUtils modules, for the first adn first_idx functions, but I can't see how to update the list to have the function move from the last occurrence it returned of Event A or Event B. and I really can't do foreach because it just goes blindly through the entire list, and I want to be able to skip through the list after I find an event, to get to the corresponding second event.

Is there another iteration method I could be using, or a better set of list processing utilities? I have the Date::Manip module set up for teh date delta calculations, that was not hard. I just can't seem to get the list to process.

[BrowserUk]

Something like this?:

#! perl -slw
use strict;

chomp( my @events = <DATA> );

for( my( $lastA, $lastB ) = ( 0, 0 ); $lastA < @events and $lastB < @e
+vents; ++$lastA, ++$lastB ) {
    ++$lastA until $events[ $lastA ] =~ m[^a\s(\d+)];
    my $aTime = $1;
    ++$lastB until $events[ $lastB ] =~ m[^b\s(\d+)];
    my $bTime = $1;
    print "$events[ $lastB ] - $events[ $lastA ] := ", $bTime - $aTime
+;
}

__DATA__
a 123
a 125
b 127
a 129
a 130
b 131
a 132
b 133

Produces:

C:\test>junk
b 127 - a 123 := 4
b 131 - a 125 := 6
b 133 - a 129 := 4

[davido]

You could write it as two iterators; one that returns the index of the next "A" event each time it's called, and one that returns the index of each "B" event each time it's called:

use strict;
use warnings;
use List::Util 'first';

my @ary = qw/EVENT_A EVENT_A EVENT_B EVENT_A EVENT_B EVENT_B/;

my($a_it, $b_it) 
    = map{ my $w = "EVENT_$_"; mk_it(\@ary, sub{ shift eq $w }) } qw/A
+ B/;

while( defined(my $eva = $a_it->()) ) {
    my $evb = $b_it->();
    die "A/B event mismatch for $ary[$eva]" unless defined $evb && $ev
+b>$eva;
    print "$ary[$eva]($eva) => $ary[$evb]($evb)\n";
}   

sub mk_it {
    my($pos, $aref, $wanted) = (0, @_);
    sub {
        my $rv = first{$wanted->($aref->[$_])} $pos..$#$aref;
        $pos = defined $rv ? $rv+1 : $pos+1;
        $rv;
    }
}

Update: Found the time to present actual code (not pseudo-code).

[Laurent_R]

I was also thinking about iterators, I like the idea and I have written quite a number of them over the last years. Here, however, I would tend to prefer only one iterator that would keep a buffer of the unused A values and return a pair of A and B values when needed.

The following was written directly at the command line and is not an iterator (in the sense that it is not a subroutine returning the next relevant element), but it is iterating only once over the input data and it would be simple to put that code into an iterator closure that would keep track of the A buffer and return the A and the B values on demand:

$ perl -e '
> use strict;
> use warnings;
> my @in = split /\n/,
> "a 123
> a 125
> b 127
> a 129
> a 130
> b 131
> a 132
> b 133";
>
> my @a_buff;
> for (@in) {
>   push @a_buff, $_ and next if /a/;
>   my $aa = shift @a_buff; # avoid to use the $a special variable
>   my $diff = $2 - $1 if "$aa - $_" =~ /(\d+)[^\d]*(\d+)/;
>   print "$aa ; $_ => $diff\n";
> }
> '
a 123 ; b 127 => 4
a 125 ; b 131 => 6
a 129 ; b 133 => 4

Update: I have now done a full-fledged iterator as a closure:

use strict;
use warnings;


my $iter = create_iter();
while (my ($aa, $bb) = $iter->()) {
    last unless defined $bb;
    my $diff = $2 - $1 if "$aa $bb" =~ /(\d+)[^\d]*(\d+)/;
    print "$aa ; $bb => $diff\n";
}

sub create_iter {
    my @a_buff;
    return sub {
        while (<DATA>){
            chomp;
            push @a_buff, $_ and next if  /a/;
            return shift @a_buff, $_;
        }
    }
}
__DATA__
a 123
a 125
b 127
a 129
a 130
b 131
a 132
b 133

And this prints the same result:

$ perl iter_pairs.pl
a 123 ; b 127 => 4
a 125 ; b 131 => 6
a 129 ; b 133 => 4

Update 2: the same using a state variable (we are stuck with old versions of Perl at work, so I sometimes don't think about such relatively new features which, in this case, make the code a bit simpler than a closure):

use strict;
use warnings;
use feature "state";

while (my ($aa, $bb) = iter()) {
    last unless defined $bb;
    my $diff = $2 - $1 if "$aa $bb" =~ /(\d+)[^\d]*(\d+)/;
    print "$aa ; $bb => $diff\n";
}

sub iter {
    state @a_buff;
    while (<DATA>){
        chomp;
        push @a_buff, $_ and next if  /a/;
        return shift @a_buff, $_;
    }
}
__DATA__
a 123
...

[GotToBTru]

use strict;
use warnings;
use List::Util qw/first/;

my (@list);
push @list, {type=>'A',time=>1000};
push @list, {type=>'A',time=>1002};
push @list, {type=>'B',time=>1004};
push @list, {type=>'B',time=>1006};
push @list, {type=>'A',time=>1008};
push @list, {type=>'B',time=>1009};

my $ea = first { $_->{type} eq 'A' } @list;
my $eb = first { $_->{type} eq 'B' && $_->{time} >= $ea->{time} } @lis
+t;

printf "A %d B %d Diff %d\n", $ea->{time},$eb->{time},$eb->{time}-$ea-
+>{time};

Update: all pairs

my ($i,$j);
while (1) {
  $i = -1; $j = -1;
  my $ea = first { $i++; $_->{type} eq 'A' } @list;
  last unless $ea;
  my $eb = first { $j++; $_->{type} eq 'B' && $_->{time} >= $ea->{time
+} } @list;
  last unless $eb;
  printf "A %d B %d Diff %d\n", $ea->{time},$eb->{time},$eb->{time}-$e
+a->{time};
  splice @list,$j,1;
  splice @list,$i,1;
}

A 1000 B 1004 Diff 4
A 1002 B 1006 Diff 4
A 1008 B 1009 Diff 1

[Laurent_R]

A quick test made at the command line, copying and pasting BrowserUk's test data (thanks to him), and separating the data into two parts:

$ perl -e '
> use strict;
> use warnings;
> my $in =
> "a 123
> a 125
> b 127
> a 129
> a 130
> b 131
> a 132
> b 133";
>
> my @a = grep /a/, split /\n/, $in;
> print shift @a, " => $_\n" for grep /b/, split /\n/, $in;
> '
a 123 => b 127
a 125 => b 131
a 129 => b 133

Just 2 lines of actual code, but not golfing either in the slightest manner, I think it is fairly clear and straight forward.

Separating the data into two lots has an additional advantage if the input data is not ordered because sorting is just trivial:

$ perl -e '
> use strict;
> use warnings;
> my $in =
> "a 123
> a 125
> b 131
> a 130
> b 127
> a 129
> a 132
> b 133";
>
> my @a = sort grep /a/, split /\n/, $in;
> print shift @a, " => $_\n" for sort grep /b/, split /\n/, $in;
> '
a 123 => b 127
a 125 => b 131
a 129 => b 133

Update: I forgot to include the calculation of the elapsed time, but this is so simple that it is left as an exercise to the OP.

[jeffa]

"I need to parse through the array and take teh time of the first Event A, and then find the first Event B after Event A, and calculate the time delta."

And then what? Do you look for the next Event A and use it as the base to find the delta against the next Event B or do you go all the way back to the 2nd Event A that you found in the first iteration? All the answers given so far seem to pick the later, but i'm choosing the former and providing a solution that uses a hash. :) Hope this helps!

use strict;
use warnings;

my %h;
while (<DATA>) {
    chomp;
    ($a,$b) = split;
    if ($a eq 'a') {
        $h{a} ||= $b;
    } elsif ($a eq 'b') {
        print $b - $h{a}, $/;
        %h = ();
    }
}

__DATA__
a 123
a 125
b 127
a 129
a 130
b 131
a 132
b 133

[kroach]

If I understood correctly, you want the indices of the first EVENT A and the first EVENT B after the EVENT A. It would be helpful if you provided an example of desired output for your data.

As for the solution, how about a simple dispatch table?

use strict;
use warnings;
use feature 'say';

# Sample data
my @events = (
    'EVENT A',
    'EVENT A',
    'EVENT B',
    'EVENT A',
    'EVENT A',
    'EVENT A',
    'EVENT B',
    'EVENT A',
    'EVENT B'
);

my ($first_A, $first_B);
my $state = 'find_A';
my %parse = (
    find_A => sub {
        my ($event, $index) = @_;
        if ($event eq 'EVENT A') {
            $first_A = $index;
            $state = 'find_B';
        }
    },
    find_B => sub {
        my ($event, $index) = @_;
        if ($event eq 'EVENT B') {
            $first_B = $index;
            $state = 'finished';
        }
    }
);

while (my ($index, $event) = each @events and $state ne 'finished') {
    $parse{$state}->($event, $index);
}

say 'First occurrence of A: ', $first_A // 'none';
say 'First occurrence of B: ', $first_B // 'none';

The script is going to execute one of the functions from the %parse hash, according to the search state. If an EVENT A still hasn't been found, it will check for 'EVENT A' and save the index if it's found, then it will switch to the second state, searching for 'EVENT B'. After an EVENT B is found, the loop will terminate.

[Anonymous Monk]

Something like this?

#!/usr/bin/perl

# http://perlmonks.org/?node_id=1125305

use strict;

$_ = join '', <DATA>;

print "$1 to $3 := ", $4 - $2, "\n" while /^(.*) (.*)\n(?:\1 .*\n)*(?=
+(.*) (.*))/gm;

__DATA__
a 123
a 125
b 127
a 129
a 130
b 131
a 132
b 133

Produces:

a to b := 4
b to a := 2
a to b := 2
b to a := 1
a to b := 1