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 | BEGIN@91 | Array::Utils::
0 | 0 | 0 | 0s | 0s | array_diff | Array::Utils::
0 | 0 | 0 | 0s | 0s | array_minus | Array::Utils::
0 | 0 | 0 | 0s | 0s | intersect | Array::Utils::
0 | 0 | 0 | 0s | 0s | unique | Array::Utils::
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; |