Once again: Rolling Frame!

[Marek]

Hello all!


Once again thank you for all for your help with my "rolling frame" in
the thread "restrict a hash to 15 pairs and iterate over it" some
weeks ago! I learned a lot of all your suggestions!

I need once more your help in creating a multi-level hash like
follows:

We read in the line numbers, we count the lines ***and*** I need to
know, how many times these numbers occur in a frame of five lines ...

So my hash should have these informations in pseudo Perl code:

number @(line, line, line) => how many times (each number)

How to transform the genius code of the suggestion from Tad J
McClellan that the hash creation

$nums{$_}++ for values
%lines;

contains meantime the line numbers?

here the example code and best greetings to all

marek


#!/usr/bin/perl
use warnings;
use strict;
use Data:umper;

my $size = 5; # 5 instead of 15
my $line = 0; # "line" counter
my %lines; # buffer up $size lines

while ( <DATA> ) {
next if /\./; # skip dates
chomp;
$line++;

$lines{$line} = $_;

if ( keys %lines == $size ) {

print Dumper \%lines; # for debugging

# count what is in the buffer
my %nums;
$nums{$_}++ for values %lines;

# display what is in the (counted) buffer
foreach my $num ( sort { $a <=> $b } keys %nums ) {
printf "%3d: %3d times\n", $num, $nums{$num};
}
print "---------\n";

# maintain buffer size
delete $lines{ $line - $size + 1};
}

}

__DATA__
01.01.98
7
31
33
14
7
7
35
16
20
20
13
55
1
1
7
7
9
20
21
20
7
20

 

[sln]

Hello all!


Once again thank you for all for your help with my "rolling frame" in
the thread "restrict a hash to 15 pairs and iterate over it" some
weeks ago! I learned a lot of all your suggestions!

I need once more your help in creating a multi-level hash like
follows:

We read in the line numbers, we count the lines ***and*** I need to
know, how many times these numbers occur in a frame of five lines ...

So my hash should have these informations in pseudo Perl code:

number @(line, line, line) => how many times (each number)

How to transform the genius code of the suggestion from Tad J
McClellan that the hash creation

$nums{$_}++ for values
%lines;

contains meantime the line numbers?

here the example code and best greetings to all

marek


#!/usr/bin/perl
use warnings;
use strict;
use Data:umper;

my $size = 5; # 5 instead of 15
my $line = 0; # "line" counter
my %lines; # buffer up $size lines

while ( <DATA> ) {
next if /\./; # skip dates
chomp;
$line++;

$lines{$line} = $_;

if ( keys %lines == $size ) {

print Dumper \%lines; # for debugging

# count what is in the buffer
my %nums;
$nums{$_}++ for values %lines;

# display what is in the (counted) buffer
foreach my $num ( sort { $a <=> $b } keys %nums ) {
printf "%3d: %3d times\n", $num, $nums{$num};
}
print "---------\n";

# maintain buffer size
delete $lines{ $line - $size + 1};
}

}

__DATA__
01.01.98
7
31
33
14
7
7
35
16
20
20
13
55
1
1
7
7
9
20
21
20
7
20

This probably works.
-sln

----------------------------------------

use warnings;
use strict;
use Data:umper;

my $size = 5; # 5 instead of 15
my $line = 0; # "line" counter
my %lines; # buffer up $size lines

while ( <DATA> ) {
next if /\./; # skip dates
chomp;
$line++;

$lines{$line} = $_;

if ( keys %lines == $size ) {

print Dumper \%lines; # for debugging

# get line's for each number, %nums = nbr=>[line,line,,], nbr=>
my %nums;

for (sort { $a <=> $b } keys %lines) {
my $nbr = $lines{$_};
push @{$nums{$nbr}}, $_;
}

print Dumper \%nums; # for debugging

# display what is in the (counted) buffer
foreach my $nbr ( sort { $a <=> $b } keys %nums ) {
my $aref = $nums{$nbr};
printf "%3d: %3d times, lines (%s)\n", $nbr, scalar(@$aref), join ',',@$aref;
}
print "---------\n";

# maintain buffer size
delete $lines{ $line - $size + 1};
}

}

 

[Marek]

sln Thank you! Great help!


Best greetings marek

 

[sln]

[snip]

Your welcome. Since I save code fragments in a local folder,
thought this will give you more bang for the buck since you
don't have to generate new %nums hash each time the frame advances.
This reduces overhead quite a bit.

Good luck!
-sln
-----------------------------------------------
## frame2.pl
##
use warnings;
use strict;
use Data:umper;

my $size = 5; # 5 instead of 15 (for test).
my $line = 0; # "line" counter.
my %Lines; # Line buffer, up to $size lines: line => number.
my %Nums; # Number buffer, less than or equal to $size: number => [line,line,line]

my ($nbr,$nbr_count,$aref,$off_frame_nbr);

while ( <DATA> )
{
# Get digits
/^\s*(\d+)\s*$/;
next if (!defined $1);

$nbr = $1;

$line++;
$Lines{ $line} = $nbr;
unshift @{$Nums{ $nbr}}, $line; # prepend line to array

if ( keys %Lines == $size )
{
# print Dumper \%Lines; # for debugging
# print Dumper \%Nums; # for debugging
print "\nFrame ".($line-$size+1)."-$line\n";

# Display/check whats in the Numbs buffer
foreach $nbr ( sort { $a <=> $b } keys %Nums )
{
$aref = $Nums{ $nbr};
$nbr_count = @$aref;
# .... here can check if $nbr_count is excessive
# ....
printf "%3d: %3d times at lines (%s)\n", $nbr, $nbr_count, join(',', reverse @$aref);
}
print "---------\n";

# Deplete line going out of frame
$off_frame_nbr = $Lines{ $line - $size + 1};
pop @{$Nums{ $off_frame_nbr}};
delete $Nums{ $off_frame_nbr} if (!@{$Nums{ $off_frame_nbr}});

# Maintain buffer size
delete $Lines{ $line - $size + 1};
}
}

__DATA__
01.01.98
7
31
33
14
7
7
35
16
20
20
13
55
1
1
7
7
9
20
21
20
7
20
0
0
0

 

[Marek]

snip

Wow! This is great art! I am admiring such code, like a painting of
Ilya Repin or ( because you are from Netherlands Salomon van
Ruysdael. I will need weeks to fully understand, what is exactly going
on in your solution.

I know, the codex of honour in this group is to suggest first an own
attempt of code, before asking for help. But: Dear Master sln! I dare
not to ask a supplemental question. If you have no time, please simply
don't answer. I don't want to abuse your witness and ***art***. But
certainly I have a next big problem: How to work with these double
numbers, once they occur? If there appears a double number, for
example the 7 in line 5, I would like to see, whether it appears for a
third time in a frame of five steps later.

Thank you again


marek

 

[sln]

Wow! This is great art! I am admiring such code, like a painting of
Ilya Repin or ( because you are from Netherlands Salomon van
Ruysdael. I will need weeks to fully understand, what is exactly going
on in your solution.

I know, the codex of honour in this group is to suggest first an own
attempt of code, before asking for help. But: Dear Master sln! I dare
not to ask a supplemental question. If you have no time, please simply
don't answer. I don't want to abuse your witness and ***art***. But
certainly I have a next big problem: How to work with these double
numbers, once they occur? If there appears a double number, for
example the 7 in line 5, I would like to see, whether it appears for a
third time in a frame of five steps later.

Thank you again


marek

Play with $Frame, $subframe and $suboffset variables and ramp stuff.
Frame can be as large as you want, even larger than all your data.
Make it large enough to encapsulate the numeric searches you need.
This is really 2 subroutines. A third might be able to do number
processing with regular expressions, letting you define more specific
numeric traffic.

There is no need though, to do while() unless you either have a very
large file or are streaming real-time data. The same results can be had
by mapping (line/number) pairs into an array, the primary sort by number,
secondary by line. Then you can process the #line's withing the encolsing
#number's. Same thing.

Btw, I'm not from Europe.

Regards,
-sln

----------------------------------------------------
## frame3.pl
##
use warnings;
use strict;

# Variables that control buffer manipulation ...
my %Lines; # Line buffer, up to $frame lines: line => number.
my %Nums; # Number buffer, less than or equal to $frame: number => [line,line,line]
my $Frame = 20; # Frame size, can be many times larger than Subframe
my $line = 0; # "line" counter.

# Virtual frame variable (used for rampdown and data printing)
my $vframe = $Frame;

# Variables to control number matching ...
my $rampup = 0; # 1 = process frame before it fills (no match, for debug only), 0 = wait for full frame
my $rampdown = 1; # 1 = process last full frame until its empty (RECOMMENDED), 0 = do not process last frame
my $subframe = 3; # Subframe size to check for number after double (can be 1 .. # for different effects)
my $suboffset= 2; # Suboffset from 'double' where Subframe starts, 'double' is on Frame boundry (0 .. # for effects)
my $firstdouble = 1; # 1 = force first sequential double found (22)22222
# 0 = force last double found 22222(22), offset should be greater than 2
# Misc ...
my ($data,$nbr,$nbr_count,$aref,$off_frame_nbr);


print <<"EOINF";

===========================
Frame size $Frame
Subframe size $subframe
Suboffset $suboffset
Rampup $rampup
Rampdown $rampdown
First double $firstdouble
===========================
EOINF


while ( defined ($data = <DATA>) || ($rampdown && keys %Lines))
{
# Get digits
if (defined $data) {
$data =~ /^\s*(\d+)\s*$/;
next if (!defined $1);
$nbr = $1;
$line++;
$Lines{ $line} = $nbr;
unshift @{$Nums{ $nbr}}, $line; # prepend line to array
} else {
--$vframe;
$vframe = $line if ($vframe > $line);
}

if ( $rampup || ($vframe != $Frame) || keys %Lines == $vframe )
{
## Display/check whats in the Numbs buffer
if ( keys %Lines ) { print "\nFrame ".($line < $vframe ? 1: $line-$vframe+1)."-$line\n" }
foreach $nbr ( sort { $a <=> $b } keys %Nums )
{
$aref = $Nums{ $nbr};
$nbr_count = @$aref;
my @ln_array = reverse @$aref;

printf "%3d: %3d times at lines (%s)\n", $nbr, $nbr_count, join(',', @ln_array);

# -------------------------------------------------------------------------------------
# Check if number is seen within a subframe at suboffset past finding its 'double'.
# Detection of 'double' is on a frame boundry only.
# --------------
my ($cur,$prev,$offset,$check_subframe) = (0,-1,0,0);

foreach $cur (@ln_array)
{
if ( !($check_subframe && $firstdouble) && $cur == ($prev + 1)) {
$offset = $prev + $suboffset;
$check_subframe = 1;
# ---
# Force detection on frame boundry (full frame or ramp down frame).
last if (($line - $vframe + 1) != ($offset - $suboffset));
}
if ($check_subframe && $cur >= $offset && $cur < ($offset + $subframe) ) {
print "\t\$\$ >> Found #($nbr) !! Sequence \@ " . ($offset - $suboffset) .
", subframe = " . $offset ."-". ($offset + $subframe - 1) .
", line = $cur\n";
last;
}
$prev = $cur;
}
}
print "---------\n";

## Handle buffers
if ( keys %Lines == $vframe || !defined $data)
{
# Deplete line going out of frame
$off_frame_nbr = $Lines{ $line - $vframe + 1};
pop @{$Nums{ $off_frame_nbr}};
delete $Nums{ $off_frame_nbr} if (!@{$Nums{ $off_frame_nbr}});

# Maintain Line buffer size
delete $Lines{ $line - $vframe + 1};
}
}
}

__DATA__
01.01.98
7
7
7
31
7
33
14
77
7
35
26
20
20
7
7
7
23
55
2
2
2
2
2
2
2
2
2
2
2
2
2
2
2
21
2
20
7
20
0
2
0

 

[Marek]

snip

Thank you sln for your great code. I discovered it only two days ago
and I tried to thank you by email. But I was not "intelligent" enough
to complete your email address right.

I got through your code and I am amazed! I would like to code like
you, but I am still a beginner.

Could you send me your email-address? I have a question to you ...


Best greetings from Munich


marek

 

[sln]

Thank you sln for your great code. I discovered it only two days ago
and I tried to thank you by email. But I was not "intelligent" enough
to complete your email address right.

I got through your code and I am amazed! I would like to code like
you, but I am still a beginner.

Could you send me your email-address? I have a question to you ...


Best greetings from Munich


marek

I set up a temporary email:
(e-mail address removed)

-sln