List::Compare & reconciling multiple lists
#!/usr/bin/perl
use strict;
use warnings;
use List::Compare;
my (%have,
@seen,
%is_unique);
my @sets = (
[qw( a c f g e h i )], # X
[qw( a b c d e f g h i )], # Y
[qw( a c d e f g h i )], # Z
);
my $lcm = List::Compare->new(@sets);
foreach my $set (@sets) {
my %seen = map { $_ => 1 } @$set;
push @seen, \%seen;
}
foreach ($lcm->get_intersection) {
$have{$_} = [ 0..$#sets ];
}
my %index = map { $_ => undef } 0..$#sets;
foreach my $i (0..$#sets) {
foreach my $elem ($lcm->get_unique($i)) {
my @list;
foreach (keys %index) { $list[$_] = $index{$_} }
$list[$i] = $i;
$have{$elem} = [ @list ];
$is_unique{$elem}++;
}
}
foreach my $elem ($lcm->get_nonintersection) {
next if $is_unique{$elem};
my @list;
foreach (keys %index) { $list[$_] = $index{$_} }
foreach my $i (0..$#sets) { $list[$i] = $i if $seen[$i]{$elem} }
$have{$elem} = [ @list ];
}
foreach (sort keys %have) {
foreach my $i (0..@{$have{$_}}) {
print defined $have{$_}->[$i] ? "$_ " : ' ';
}
print "\n";
}
__OUTPUT__
a a a
b
c c c
d d
e e e
f f f
g g g
h h h
i i i
Determining list continuations
Update:
Try Number::Continuation (which originated thereof) instead. The "solution" below breaks for many edge-cases.
#!/usr/bin/perl
use strict;
use warnings;
my @nums = split / /, shift;
my ($have_begin, $have_inc, $not_follow_inc, $str);
for (my $i = 0; $i < @nums; $i++) {
no warnings 'uninitialized';
if (!$have_begin && !$not_follow_inc) {
$str .= $nums[$i];
$have_inc = $nums[$i];
$have_begin = 1;
} elsif (($nums[$i+1] - $nums[$i]) == 1) {
$have_inc++;
} elsif ($not_follow_inc) {
$str .= ', ' . $nums[$i];
$str .= ', ' if $i != $#nums;
$not_follow_inc = 0;
} else {
$str .= '-'.++$have_inc;
$have_begin = 0;
$not_follow_inc = 1;
}
}
print "$str\n";
__INPUT__
1 2 3 5 7 8 9
__OUTPUT__
1-3, 5, 7-9
|