simong has asked for the wisdom of the Perl Monks concerning the following question:

Hi all, i'm stucked on solve this situation: 2 arrays @a and @b containing both path elements. @a is quite heavy array of full path string;@b insted is a shorter array containing just a segment, a frame, of some of the elements in @a. Using (or not) a fast grep function, need to select the element in @a which satisfy (match)the content of @b. I try this , but not working:

%tmp = map{ $_ => 1 } @b;
@inte = grep(!/$tmp{$_}$/, @a) ;

[download]

Any advise ? thanks Simon

Sorry I posted the wrong code, but in any case cant how to match $tmp variable

%tmp = map{ $_ => $_ } @b;
@inte = grep(/$tmp{$_}$/, @a) ;

[download]

..in my intention would find, for every $_ of @a if any $_ of $tmp{$_} is part or $_ in @a

An example

@a = ('d:\1\1\1.txt',
'd:\1\1\2.txt',
'd:\1\1\3.txt',
'd:\1\1\4.txt')

[download]
@b = ('\1\2.txt',
'\1\3.txt'

[download]

Replies are listed 'Best First'.
Re: Dependant Arrays intersection
by Mr. Muskrat (Canon) on Feb 04, 2016 at 21:46 UTC

    Here is one way to do that. I chose to use List::Util's any subroutine in conjunction with a for loop.

    #!/bin/env perl
use strict;
use warnings;
use List::Util qw(any);

my @small = ('var/qWDszw1dQd', 'aHO0rvbglz/pg_extra_dump', 'OtherSchem
+a');
my @big = load_paths();

my @selected;
for my $item (@big) {
  push @selected, $item if any { $item =~ /\Q$_\E/ } @small; 
}

print "selected:\n", join "\n", @selected, "\n";

sub load_paths {
  return qw(
    ./gh/dbix-class-schema-loader/t/var/QN40VTMAuz
    ./gh/dbix-class-schema-loader/t/var/QN40VTMAuz/common_dump
    ./gh/dbix-class-schema-loader/t/var/QN40VTMAuz/common_dump/DBIXCSL
+_Test
    ./gh/dbix-class-schema-loader/t/var/QN40VTMAuz/common_dump/DBIXCSL
+_Test/Schema
    ./gh/dbix-class-schema-loader/t/var/QN40VTMAuz/common_dump/DBIXCSL
+_Test/Schema/MyResult
    ./gh/dbix-class-schema-loader/t/var/BIdR9nVlmM
    ./gh/dbix-class-schema-loader/t/var/Qt5_emwFhF
    ./gh/dbix-class-schema-loader/t/var/Qt5_emwFhF/common_dump
    ./gh/dbix-class-schema-loader/t/var/Qt5_emwFhF/common_dump/DBIXCSL
+_Test
    ./gh/dbix-class-schema-loader/t/var/Qt5_emwFhF/common_dump/DBIXCSL
+_Test/Schema
    ./gh/dbix-class-schema-loader/t/var/Qt5_emwFhF/common_dump/DBIXCSL
+_Test/Schema/MyResult
    ./gh/dbix-class-schema-loader/t/var/oc8ziKYqZb
    ./gh/dbix-class-schema-loader/t/var/VZa7q4FOlm
    ./gh/dbix-class-schema-loader/t/var/wxbUMQkA3e
    ./gh/dbix-class-schema-loader/t/var/wxbUMQkA3e/common_dump
    ./gh/dbix-class-schema-loader/t/var/wxbUMQkA3e/common_dump/DBIXCSL
+_Test
    ./gh/dbix-class-schema-loader/t/var/wxbUMQkA3e/common_dump/DBIXCSL
+_Test/Schema
    ./gh/dbix-class-schema-loader/t/var/wxbUMQkA3e/common_dump/DBIXCSL
+_Test/Schema/MyResult
    ./gh/dbix-class-schema-loader/t/var/9Br774226y
    ./gh/dbix-class-schema-loader/t/var/9Br774226y/common_dump
    ./gh/dbix-class-schema-loader/t/var/9Br774226y/common_dump/DBIXCSL
+_Test
    ./gh/dbix-class-schema-loader/t/var/9Br774226y/common_dump/DBIXCSL
+_Test/Schema
    ./gh/dbix-class-schema-loader/t/var/9Br774226y/common_dump/DBIXCSL
+_Test/Schema/MyResult
    ./gh/dbix-class-schema-loader/t/var/9Br774226y/common_dump/TestSch
+emaFromAnother
    ./gh/dbix-class-schema-loader/t/var/9Br774226y/common_dump/TestSch
+emaFromAnother/Result
    ./gh/dbix-class-schema-loader/t/var/AZzU5Mp5c8
    ./gh/dbix-class-schema-loader/t/var/BrS2LkS6Wh
    ./gh/dbix-class-schema-loader/t/var/SN_06brsqD
    ./gh/dbix-class-schema-loader/t/var/sso1WR7JVK
    ./gh/dbix-class-schema-loader/t/var/sso1WR7JVK/common_dump
    ./gh/dbix-class-schema-loader/t/var/aHO0rvbglz
    ./gh/dbix-class-schema-loader/t/var/aHO0rvbglz/pg_extra_dump
    ./gh/dbix-class-schema-loader/t/var/aHO0rvbglz/pg_extra_dump/PGMul
+tiSchema
    ./gh/dbix-class-schema-loader/t/var/aHO0rvbglz/pg_extra_dump/PGMul
+tiSchema/Result
    ./gh/dbix-class-schema-loader/t/var/aHO0rvbglz/common_dump
    ./gh/dbix-class-schema-loader/t/var/aHO0rvbglz/common_dump/DBIXCSL
+_Test
    ./gh/dbix-class-schema-loader/t/var/aHO0rvbglz/common_dump/DBIXCSL
+_Test/Schema
    ./gh/dbix-class-schema-loader/t/var/aHO0rvbglz/common_dump/DBIXCSL
+_Test/Schema/MyResult
    ./gh/dbix-class-schema-loader/t/var/aHO0rvbglz/common_dump/TestSch
+emaFromAnother
    ./gh/dbix-class-schema-loader/t/var/aHO0rvbglz/common_dump/TestSch
+emaFromAnother/Result
    ./gh/dbix-class-schema-loader/t/var/SMPvZQWwxI
    ./gh/dbix-class-schema-loader/t/var/ZQHeJ7xJLS
    ./gh/dbix-class-schema-loader/t/var/ZQHeJ7xJLS/common_dump
    ./gh/dbix-class-schema-loader/t/var/ZQHeJ7xJLS/common_dump/DBIXCSL
+_Test
    ./gh/dbix-class-schema-loader/t/var/ZQHeJ7xJLS/common_dump/DBIXCSL
+_Test/Schema
    ./gh/dbix-class-schema-loader/t/var/ZQHeJ7xJLS/common_dump/DBIXCSL
+_Test/Schema/MyResult
    ./gh/dbix-class-schema-loader/t/var/qWDszw1dQd
    ./gh/dbix-class-schema-loader/t/var/A_asDKxIPg
    ./gh/dbix-class-schema-loader/t/var/MbRwgdPYzG
    ./gh/dbix-class-schema-loader/t/var/OKOTLfXlcS
    ./gh/dbix-class-schema-loader/t/var/OKOTLfXlcS/common_dump
    ./gh/dbix-class-schema-loader/t/var/OKOTLfXlcS/common_dump/DBIXCSL
+_Test
    ./gh/dbix-class-schema-loader/t/var/OKOTLfXlcS/common_dump/DBIXCSL
+_Test/Schema
    ./gh/dbix-class-schema-loader/t/var/OKOTLfXlcS/common_dump/DBIXCSL
+_Test/Schema/MyResult
    ./gh/dbix-class-schema-loader/t/var/LDoLlFrpEm
    ./gh/dbix-class-schema-loader/t/var/xf484Q14Tm
    ./gh/dbix-class-schema-loader/t/var/xf484Q14Tm/common_dump
    ./gh/dbix-class-schema-loader/t/var/xf484Q14Tm/common_dump/DBIXCSL
+_Test
    ./gh/dbix-class-schema-loader/t/var/xf484Q14Tm/common_dump/DBIXCSL
+_Test/Schema
    ./gh/dbix-class-schema-loader/t/var/xf484Q14Tm/common_dump/DBIXCSL
+_Test/Schema/MyResult
    ./gh/dbix-class-schema-loader/t/var/4HJSJyMOLQ
    ./gh/dbix-class-schema-loader/t/var/4HJSJyMOLQ/common_dump
    ./gh/dbix-class-schema-loader/t/var/4HJSJyMOLQ/common_dump/DBIXCSL
+_Test
    ./gh/dbix-class-schema-loader/t/var/4HJSJyMOLQ/common_dump/DBIXCSL
+_Test/Schema
    ./gh/dbix-class-schema-loader/t/var/4HJSJyMOLQ/common_dump/DBIXCSL
+_Test/Schema/MyResult
    ./gh/dbix-class-schema-loader/t/var/Ta_ZGMdtD3
    ./gh/dbix-class-schema-loader/t/var/PvDTGVICln
    ./gh/dbix-class-schema-loader/t/var/VSshFiOQrb
    ./gh/dbix-class-schema-loader/t/var/VSshFiOQrb/dump
    ./gh/dbix-class-schema-loader/t/var/VSshFiOQrb/dump/DBICTest
    ./gh/dbix-class-schema-loader/t/var/VSshFiOQrb/dump/DBICTest/DumpM
+ore
    ./gh/dbix-class-schema-loader/t/var/VSshFiOQrb/dump/DBICTest/DumpM
+ore/1
    ./gh/dbix-class-schema-loader/t/var/VSshFiOQrb/dump/DBICTest/DumpM
+ore/1/Result
    ./gh/dbix-class-schema-loader/t/var/VSshFiOQrb/dump/DBICTest/DumpM
+ore/1/Result/MySchema
    ./gh/dbix-class-schema-loader/t/var/VSshFiOQrb/dump/DBICTest/DumpM
+ore/1/Result/OtherSchema
    ./gh/dbix-class-schema-loader/t/var/VSshFiOQrb/dump/DBICTest/DumpM
+ore/omit_timestamp
    ./gh/dbix-class-schema-loader/t/var/VSshFiOQrb/dump/DBICTest/DumpM
+ore/Upgrade
    ./gh/dbix-class-schema-loader/t/var/VSshFiOQrb/dump/DBICTest/DumpM
+ore/Upgrade/Result
    ./gh/dbix-class-schema-loader/t/var/VSshFiOQrb/dump/DBICTest/DumpM
+ore/omit_both
    ./gh/dbix-class-schema-loader/t/var/VSshFiOQrb/dump/DBICTest/DumpM
+ore/omit_version
  );
}

__DATA__
selected:
./gh/dbix-class-schema-loader/t/var/aHO0rvbglz/pg_extra_dump
./gh/dbix-class-schema-loader/t/var/aHO0rvbglz/pg_extra_dump/PGMultiSc
+hema
./gh/dbix-class-schema-loader/t/var/aHO0rvbglz/pg_extra_dump/PGMultiSc
+hema/Result
./gh/dbix-class-schema-loader/t/var/qWDszw1dQd
./gh/dbix-class-schema-loader/t/var/VSshFiOQrb/dump/DBICTest/DumpMore/
+1/Result/OtherSchema

    [download]
[reply]
[d/l]
      thanks Muskrat, already implemented your code, but since @big const 400k elements, 1 or worster 2 nested cycles , take very much time
[reply]

        Did I miss your examples or did you add them later? If all of the fragments in your small array will match the end of an item in the large array then you should anchor the search at the end with a $ like you had in your grep.

        push @selected, $item if any { $item =~ /\Q$_\E$/ } @small;
[reply]
[d/l]
Re: Dependant Arrays intersection
by AnomalousMonk (Archbishop) on Feb 04, 2016 at 23:57 UTC

    Here's a single pass through your  @big array and should be fairly fast: 

    c:\@Work\Perl\monks>perl -wMstrict -le
"use Data::Dumper qw(Dumper);
 ;;
 my @big = ('d:\1\1\1.txt', 'd:\1\1\2.txt', 'd:\1\1\3.txt', 'd:\1\1\4.
+txt');
 ;;
 my @small = ('\1\2.txt', '\1\3.txt');
 my ($has_some_small) =
   map qr{ $_ }xms,
   join q{ | },
   map quotemeta,
   @small
   ;
 print $has_some_small;
 ;;
 my @inte = grep m{ $has_some_small \z }xms, @big;
 print Dumper \@inte;
 print qq{'$_'} for @inte;
"
(?^msx: \\1\\2\.txt | \\1\\3\.txt )
$VAR1 = [
          'd:\\1\\1\\2.txt',
          'd:\\1\\1\\3.txt'
        ];

'd:\1\1\2.txt'
'd:\1\1\3.txt'

    [download]
    As a beginner, always  use warnings; and  use strict; at the start of your scripts. See warnings and strict. Data::Dumper is core, so you should have it; it's a great aid to debugging. Please see perlre, perlretut, and perlrequick for regex info.

    Give a man a fish:  <%-{-{-{-<

[reply]
[d/l]
[select]
Re: Dependant Arrays intersection
by Discipulus (Canon) on Feb 04, 2016 at 21:48 UTC
    Hello, your regex is anchored to the end of string with the $ anchor at the end of pattern. this seems not correspond to your description of the problem. More: your $_ inside the grep is each element of @a and you built the hash using partial strings of @b not @a aka not true by definition.

    L*

    There are no rules, there are no thumbs..
    Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.
[reply]
[d/l]
[select]

Back to Seekers of Perl Wisdom