in reply to CPAN Module to determing overlap of 2 lists?
G'day wazat,
Here's an implementation of &list_overlap. You could add it to a module if that would be useful to you.
#!/usr/bin/env perl use strict; use warnings; use constant { REF => 0, DATA => 1, EXP => 2, NAME => 3, JOIN => $;, }; use Test::More; my @ref = qw{a b c d c}; my @same = qw{a b c d c}; my @long = qw{c d c x y z}; my @short = qw{c x y z}; my @none = qw{x y z}; my @tests = ( [ [@ref], [@same], 5, 'Same' ], [ [@ref], [@long], 3, 'Long' ], [ [@ref], [@short], 1, 'Short' ], [ [@ref], [@none], 0, 'None' ], ); plan tests => 0+@tests; for my $test (@tests) { my $got = list_overlap($test->[REF], $test->[DATA]); is($got, $test->[EXP], $test->[NAME]); } sub list_overlap { my ($ref, $data) = @_; my $got = 0; my ($ref_len, $data_len) = (0+@$ref, 0+@$data); my $start = $ref_len > $data_len ? $ref_len - $data_len : 0; for my $i ($start .. $ref_len - 1) { if (join(JOIN, @{$ref}[$i .. $#$ref]) eq join(JOIN, @{$data}[0 .. $#$ref - $i]) ) { $got = 1 + $#$ref - $i; last; } } return $got; }
I find $; useful for this type of join because it's rarely used elsewhere. Pick something else if that's not appropriate.
Output:
1..4 ok 1 - Same ok 2 - Long ok 3 - Short ok 4 - None
— Ken
|
|---|
| Replies are listed 'Best First'. | |
|---|---|
|
Re^2: CPAN Module to determing overlap of 2 lists?
by wazat (Monk) on Aug 11, 2020 at 19:27 UTC | |
by kcott (Archbishop) on Aug 12, 2020 at 08:09 UTC | |
by wazat (Monk) on Aug 13, 2020 at 01:03 UTC |