Beefy Boxes and Bandwidth Generously Provided by pair Networks
more useful options
 
PerlMonks  

removing elements from an array containing duplicated patterns

by Anonymous Monk
on Aug 29, 2002 at 10:00 UTC ( [id://193719] : perlquestion . print w/replies, xml ) Need Help??

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

Hi, I require some perl wisdom.
I have an array containing ("$?/1dlw&"   "*%1sdh^?"   "@/!1dlw\/"   "$1cgi*&"   "?@1sdh%&"   "~#1xnf$%"). I am interested in the patterns 1dlw, 1sdh, 1cgi, 1xnf. However, I want to detect if any of these patterns are duplicated and then completely remove them so I am left with an array containing ("$1cgi*&"   "$#1xnf$%").

thanks

Edit kudra, 2002-08-29 Added code tags

Replies are listed 'Best First'.
Re: removing elements from an array containing duplicated patterns
by Arien (Pilgrim) on Aug 29, 2002 at 11:08 UTC

    Another way to do it:

    #!/usr/bin/perl use strict; use warnings; my @data = ( '$?/1dlw&', '*%1sdh^?', '@/!1dlw\\/', '$1cgi*&', '?@1sdh%&', '~#1xnf$%' ); my @patterns = qw/1dlw 1sdh 1cgi 1xnf/; my $re = join "|", map quotemeta, @patterns; my %seen; for (@data) { next unless /($re)/; # shouldn't happen, presumably if (defined $seen{$1}) { push @{ $seen{$1} }, $_; } else { $seen{$1} = [ $_ ]; } } my @unique = map { @{ $seen{$_} } == 1 ? $seen{$_}->[0] : () } keys %seen;

    Edit: Or another way...

    #!/usr/bin/perl use strict; use warnings; my @data = ( '$?/1dlw&', '*%1sdh^?', '@/!1dlw\\/', '$1cgi*&', '?@1sdh%&', '~#1xnf$%' ); my @patterns = qw/1dlw 1sdh 1cgi 1xnf/; my $re = join "|", map quotemeta, @patterns; my %seen; /($re)/ and $seen{$1}++ for (@data); my $unique = join "|", map quotemeta, grep { $seen{$_} == 1 } @pattern +s; my @unique = grep { /$unique/ } @data;

    — Arien

Re: removing elements from an array containing duplicated patterns
by ash (Monk) on Aug 29, 2002 at 10:33 UTC

    You can try this straight-forward solution:

    #!/usr/bin/perl -w use strict; # Define patterns to look for, and create a regexp with them. my @patterns = qw(1dlw 1sdh 1cgi 1xnf); my $expr = join("|", map {quotemeta} @patterns); # The source array. my @source = ( '$?/1dlw&', '*%1sdh^?', '@/!1dlw\/', '$1cgi*&', '?@1sdh%&', '~#1xnf$%', ); # Iterate over each element in source, # and store how many times each pattern # is found. my %seen; foreach my $element (@source) { if($element =~ /($expr)/) { $seen{$1}++; } } # ...and remove the patterns found more than once. while(my($pattern, $count) = each %seen) { @source = grep {!/\Q$pattern\E/} @source if $count > 1; } print join("\n", @source), "\n";
    -- Ash/asksh <ask@unixmonks.net>
Re: removing elements from an array containing duplicated patterns
by BrowserUk (Patriarch) on Aug 29, 2002 at 16:51 UTC

    Updated: Corrected an error and added the caveat.

    CAVEAT: If there are any values that you wish to retain but don't care if they are duplicated (hopefully an unlikely scenario) this won't work.

    With the kind assistance of bart (and the eternal patience of Zaxo!) a rather simplier solution.

    #! perl -w use strict; use Data::Dumper; my @data = ('$?/1dlw&', '*%1sdh^?', '@/!1dlw\/', '$?1cgi*&', '?@1sdh%& +', '~#1xnf$%'); my $patterns = join '|', qw(1dlw 1sdh 1cgi 1xnf); my $regex = qr/($patterns)/; my %count; my @deduped = grep { /$regex/ && $count{$1} == 1 } map { /$regex/; $count{$1} ++; $_ } @data; print "'$_'\n" for @deduped; __END__ C:\test>193719 '$?1cgi*&' '~#1xnf$%'

    Well It's better than the Abottoire, but Yorkshire!