Monday, 15 June 2015

Perl - extract series of numbers with offsets from array -



Perl - extract series of numbers with offsets from array -

i trying search series of numbers within array of integers. instance, if array consists of numbers 1,2,3,10,12,14, summarized

1 3 offset 1,

10 14 offset 2

below code, loop on array sec element, track offset between consecutive array elements , create new 'series' if offset changes:

use strict; utilize warnings; @numbers = (1,2,3,10,12,14); #array extract series $last_diff; $start = $numbers[0]; $end; @all_series; #array hold info on series $i (1..($#numbers+1)){ $diff; if ($i <($#numbers+1)){ $diff = $numbers[$i] - $numbers[$i-1]; } if (!$diff || ( $last_diff && ($last_diff != $diff)) ) { $end = $numbers[$i-1]; $series = { 'start'=> $start, 'end' => $end, 'offset'=> $start == $end ? 1 : $last_diff, }; force @all_series, $series; $start = $numbers[$i]; } $last_diff = $diff; } utilize data::dumper; print dumper(@all_series);

output looks follows:

$var1 = { 'offset' => 1, 'end' => 3, 'start' => 1 }; $var2 = { 'offset' => 1, 'end' => 10, 'start' => 10 }; $var3 = { 'offset' => 2, 'end' => 14, 'start' => 12 };

this not desired result, since lastly 2 series summarised 1 (10 14, offset 2 instead of 2 series).

the flaw in algorithm independent perl, however, maybe give me hint on how approach best, maybe there exist perl-specific tricks this.

in application, integers in array in ascending order , duplicate numbers not exist.

edit if single numbers occur cannot assignet serious, should series of length one.

the more numbers can summarized series, improve (i want minimize number of series!)

the problem in ternary operator. if used plain

offset => $last_diff,

you'd notice there

$var2 = { 'offset' => 7, 'end' => 10, 'start' => 10

which right in way. avoid it, can undef $diff after pushing @series. produce expected output case, still treat 1 2 3 7 10 12 14 3 sequences, starting @ 1, 7 , 12. need create longer sentence greedy somehow, now.

i experimented following, should test more:

#!/usr/bin/perl utilize warnings; utilize strict; utilize data::dumper; @numbers = (1, 2, 3, 10, 12, 14); $last_diff; $start = $numbers[0]; @all_series; $i (1 .. $#numbers + 1) { $diff; if ($i < $#numbers + 1) { $diff = $numbers[$i] - $numbers[ $i - 1 ]; } # merge lastly number previous series if needed: if (!$last_diff # starting new series. , $i > 2 # far plenty have preceding numbers. , $diff , $diff == $numbers[ $i - 1 ] - $numbers[ $i - 2 ] ) { $all_series[-1]{end} = $numbers[ $i - 3 ]; $all_series[-1]{offset} = 0 if $all_series[-1]{start} == $all_series[-1]{end}; $start = $numbers[ $i - 2 ]; } if (! $diff or ( $last_diff && ($last_diff != $diff)) ) { force @all_series, { start => $start, end => $numbers[ $i - 1 ], offset => $last_diff, }; $start = $numbers[$i]; undef $diff; } $last_diff = $diff; } print dumper(@all_series);

arrays perl extract sequence

No comments:

Post a Comment