| Filename | /Users/ap13/perl5/lib/perl5/Array/Utils.pm |
| Statements | Executed 8 statements in 275µs |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1 | 1 | 1 | 24µs | 43µs | Array::Utils::BEGIN@91 |
| 0 | 0 | 0 | 0s | 0s | Array::Utils::array_diff |
| 0 | 0 | 0 | 0s | 0s | Array::Utils::array_minus |
| 0 | 0 | 0 | 0s | 0s | Array::Utils::intersect |
| 0 | 0 | 0 | 0s | 0s | Array::Utils::unique |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package Array::Utils; | ||||
| 2 | |||||
| 3 | =head1 NAME | ||||
| 4 | |||||
| 5 | Array::Utils - small utils for array manipulation | ||||
| 6 | |||||
| 7 | =head1 SYNOPSIS | ||||
| 8 | |||||
| 9 | use Array::Utils qw(:all); | ||||
| 10 | |||||
| 11 | my @a = qw( a b c d ); | ||||
| 12 | my @b = qw( c d e f ); | ||||
| 13 | |||||
| 14 | # symmetric difference | ||||
| 15 | my @diff = array_diff(@a, @b); | ||||
| 16 | |||||
| 17 | # intersection | ||||
| 18 | my @isect = intersect(@a, @b); | ||||
| 19 | |||||
| 20 | # unique union | ||||
| 21 | my @unique = unique(@a, @b); | ||||
| 22 | |||||
| 23 | # check if arrays contain same members | ||||
| 24 | if ( !array_diff(@a, @b) ) { | ||||
| 25 | # do something | ||||
| 26 | } | ||||
| 27 | |||||
| 28 | # get items from array @a that are not in array @b | ||||
| 29 | my @minus = array_minus( @a, @b ); | ||||
| 30 | |||||
| 31 | =head1 DESCRIPTION | ||||
| 32 | |||||
| 33 | A small pure-perl module containing list manipulation routines. The module | ||||
| 34 | emerged because I was tired to include same utility routines in numerous projects. | ||||
| 35 | |||||
| 36 | =head1 FUNCTIONS | ||||
| 37 | |||||
| 38 | =over 4 | ||||
| 39 | |||||
| 40 | =item C<unique> | ||||
| 41 | |||||
| 42 | Returns an array of unique items in the arguments list. | ||||
| 43 | |||||
| 44 | =item C<intersect> | ||||
| 45 | |||||
| 46 | Returns an intersection of two arrays passed as arguments, keeping the order of the | ||||
| 47 | second parameter. A nice side effect of this function can be exploited in situations as: | ||||
| 48 | |||||
| 49 | @atreides = qw( Leto Paul Alia 'Leto II' ); | ||||
| 50 | @mylist = qw( Alia Leto ); | ||||
| 51 | @mylist = intersect( @mylist, @atreides ); # and @mylist is ordered as Leto,Alia | ||||
| 52 | |||||
| 53 | =item C<array_diff> | ||||
| 54 | |||||
| 55 | Return symmetric difference of two arrays passed as arguments. | ||||
| 56 | |||||
| 57 | =item C<array_minus> | ||||
| 58 | |||||
| 59 | Returns the difference of the passed arrays A and B (only those | ||||
| 60 | array elements that exist in A and do not exist in B). | ||||
| 61 | If an empty array is returned, A is subset of B. | ||||
| 62 | |||||
| 63 | Function was proposed by Laszlo Forro <salmonix@gmail.com>. | ||||
| 64 | |||||
| 65 | =back | ||||
| 66 | |||||
| 67 | =head1 BUGS | ||||
| 68 | |||||
| 69 | None known yet | ||||
| 70 | |||||
| 71 | =head1 AUTHOR | ||||
| 72 | |||||
| 73 | Sergei A. Fedorov <zmij@cpan.org> | ||||
| 74 | |||||
| 75 | I will be happy to have your feedback about the module. | ||||
| 76 | |||||
| 77 | =head1 COPYRIGHT | ||||
| 78 | |||||
| 79 | This module is Copyright (c) 2007 Sergei A. Fedorov. | ||||
| 80 | All rights reserved. | ||||
| 81 | |||||
| 82 | You may distribute under the terms of either the GNU General Public | ||||
| 83 | License or the Artistic License, as specified in the Perl README file. | ||||
| 84 | |||||
| 85 | =head1 WARRANTY | ||||
| 86 | |||||
| 87 | This is free software. IT COMES WITHOUT WARRANTY OF ANY KIND. | ||||
| 88 | |||||
| 89 | =cut | ||||
| 90 | |||||
| 91 | 2 | 253µs | 2 | 62µs | # spent 43µs (24+19) within Array::Utils::BEGIN@91 which was called:
# once (24µs+19µs) by Bio::Roary::AnnotateGroups::BEGIN@23 at line 91 # spent 43µs making 1 call to Array::Utils::BEGIN@91
# spent 19µs making 1 call to strict::import |
| 92 | |||||
| 93 | 1 | 500ns | require Exporter; | ||
| 94 | 1 | 8µs | our @ISA = qw(Exporter); | ||
| 95 | |||||
| 96 | 1 | 2µs | our %EXPORT_TAGS = ( | ||
| 97 | all => [ qw( | ||||
| 98 | &unique | ||||
| 99 | &intersect | ||||
| 100 | &array_diff | ||||
| 101 | &array_minus | ||||
| 102 | ) ], | ||||
| 103 | ); | ||||
| 104 | 1 | 2µs | our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); | ||
| 105 | |||||
| 106 | 1 | 400ns | our $VERSION = '0.5'; | ||
| 107 | |||||
| 108 | sub unique(@) { | ||||
| 109 | return keys %{ {map { $_ => undef } @_}}; | ||||
| 110 | } | ||||
| 111 | |||||
| 112 | sub intersect(\@\@) { | ||||
| 113 | my %e = map { $_ => undef } @{$_[0]}; | ||||
| 114 | return grep { exists( $e{$_} ) } @{$_[1]}; | ||||
| 115 | } | ||||
| 116 | |||||
| 117 | sub array_diff(\@\@) { | ||||
| 118 | my %e = map { $_ => undef } @{$_[1]}; | ||||
| 119 | return @{[ ( grep { (exists $e{$_}) ? ( delete $e{$_} ) : ( 1 ) } @{ $_[0] } ), keys %e ] }; | ||||
| 120 | } | ||||
| 121 | |||||
| 122 | sub array_minus(\@\@) { | ||||
| 123 | my %e = map{ $_ => undef } @{$_[1]}; | ||||
| 124 | return grep( ! exists( $e{$_} ), @{$_[0]} ); | ||||
| 125 | } | ||||
| 126 | |||||
| 127 | 1 | 8µs | 1; |