Sublist.pm (1708B) - raw
1 package Sublist; 2 use strict; 3 use warnings; 4 use v5.22; 5 use Exporter qw<import>; 6 our @EXPORT_OK = qw<compare_lists>; 7 8 sub a_within_b { # assume @a <= @b 9 my ($a, $b) = @_; 10 my @a = @{$a}; 11 my @b = @{$b}; 12 # check to see if first element of @a is in @b 13 # @idx is array that stores all indexes of @b where first element of @a is in @b 14 my @idx = grep { $b[$_] eq $a[0] } 0 .. $#b; 15 return 0 unless (@idx); # first element of @a not found anywhere in @b 16 foreach my $i (@idx) { # loop through each index of @b we found 17 # skip if the first element of @a occurs too near the end of @b 18 # (i.e. the remaining elements of @a won't fit in @b) 19 next if ($i > scalar @b - scalar @a); 20 # $match counts number of matches of @a in @b. Start at 1 since we already 21 # know that the first element of @a was found in @b 22 my $match = 1; 23 # sequentially loop through remaining elements of @a to see if they 24 # appear in order in @b 25 for (my $a_idx=1, my $b_idx=$i+1; $a_idx<=$#a; $a_idx++, $b_idx++) { 26 $match++ if ($a[$a_idx] eq $b[$b_idx]); 27 } 28 # number of matches has to eqal number of elements in @a 29 return 1 if ($match == scalar @a); 30 } 31 return 0; 32 } 33 34 sub compare_lists { 35 my ($args) = @_; 36 my @a = @{$args->{listOne}}; 37 my @b = @{$args->{listTwo}}; 38 return "equal" if (@a == 0 && @b == 0); # empty lists 39 return "sublist" if (@a == 0 && @b > 0); # empty list within non empty list 40 return "superlist" if (@a > 0 && @b == 0); # non empty list contains empty list 41 return "equal" if (@a == @b && a_within_b(\@a, \@b)); 42 return "superlist" if (@a > @b && a_within_b(\@b, \@a)); 43 return "sublist" if (a_within_b(\@a, \@b)); 44 return "unequal"; 45 } 46 47 1;