File Coverage

blib/lib/List/Search.pm
Criterion Covered Total %
statement 42 42 100.0
branch 12 12 100.0
condition n/a
subroutine 12 12 100.0
pod 6 6 100.0
total 72 72 100.0


line stmt bran cond sub pod time code
1 6     6   778986 use 5.006;
  6         24  
2 6     6   33 use strict;
  6         39  
  6         242  
3 6     6   44 use warnings;
  6         13  
  6         659  
4              
5             package List::Search;
6              
7             our $VERSION = '0.3_1';
8             $VERSION = eval $VERSION;
9              
10 6     6   51 use Exporter ();
  6         45  
  6         4240  
11             our (@ISA, @EXPORT_OK);
12             @ISA = qw(Exporter);
13             @EXPORT_OK = qw(
14             list_search nlist_search custom_list_search
15             list_contains nlist_contains custom_list_contains
16             );
17              
18             =head1 NAME
19              
20             List::Search - fast searching of sorted lists
21              
22             =head1 SYNOPSIS
23              
24             use List::Search qw( list_search nlist_search custom_list_search );
25              
26             # Create a list to search
27             my @list = sort qw( bravo charlie delta );
28              
29             # Search for a value, returns the index of first match
30             print list_search( 'alpha', \@list ); # 0
31             print list_search( 'charlie', \@list ); # 1
32             print list_search( 'zebra', \@list ); # -1
33              
34             # Search numerically
35             my @numbers = sort { $a <=> $b } ( 10, 20, 100, 200, );
36             print nlist_search( 20, \@numbers ); # 1
37              
38             # Search using some other comparison
39             my $cmp_code = sub { lc( $_[0] ) cmp lc( $_[1] ) };
40             my @custom_list = sort { $cmp_code->( $a, $b ) }
41             qw( FOO bar BAZ bundy ); # bar < BAZ < bundy < FOO
42             print custom_list_search( $cmp_code, 'foo', \@custom_list ); # 3
43              
44             =head1 DESCRIPTION
45              
46             This module lets you quickly search a sorted list. It will return the index of
47             the first entry that matches, or if there is no exact matches then the first
48             entry that is greater than the search key.
49              
50             For example in the list C searching for
51             C will return C<1> as C<$list[1] eq 'dave'>. Searching for C
52             will also return C<1> as C is the first entry that is greater than
53             C.
54              
55             If none of the entries match then C<-1> is returned. You can either
56             check for this or use it as an index to get the last values in the list.
57             Whichever approach you choose will depend on what you are trying to do.
58              
59             The actual searching is done using a binary search which is very fast.
60              
61             =head1 METHODS
62              
63             =head2 list_search
64              
65             my $idx = list_search( $key, \@sorted_list );
66              
67             Searches the list using C as the comparison operator. Returns the index
68             of the first entry that is equal to or greater than C<$key>. If there is no
69             match then returns C<-1>.
70              
71             =cut
72              
73             sub list_search {
74 16     16 1 409711 my ( $key, $array_ref ) = @_;
75 16         54 return custom_list_search( \&_alpha_sort, $key, $array_ref );
76             }
77              
78             =head2 nlist_search
79              
80             my $idx = nlist_search( $key, \@sorted_list );
81              
82             Searches the list using C=E> as the comparison operator. Returns the
83             index of the first entry that is equal to or greater than C<$key>. If there is
84             no match then returns C<-1>.
85              
86             =cut
87              
88             sub nlist_search {
89 34     34 1 30095 my ( $key, $array_ref ) = @_;
90 34         107 return custom_list_search( \&_numeric_sort, $key, $array_ref );
91             }
92              
93             =head2 custom_list_search
94              
95             my $cmp_sub = sub { $_[0] cmp $_[1] };
96             my $idx = custom_list_search( $cmp_sub, $key, \@sorted_list );
97              
98             Searches the list using the subroutine to compare the values. Returns the
99             index of the first entry that is equal to or greater than C<$key>. If there is
100             no match then returns C<-1>.
101              
102             NOTE - the list must have been sorted using the same comparison, ie:
103              
104             my @sorted_list = sort { $cmp_sub->( $a, $b ) } @list;
105              
106             =cut
107              
108             sub custom_list_search {
109 90     90 1 221663 my ( $cmp_code, $key, $array_ref ) = @_;
110              
111 90         166 my $max_index = scalar(@$array_ref) - 1;
112 90 100       245 return -1 if $max_index < 0;
113              
114             # Early return if there are no matches in the array
115 87 100       241 return -1 if $cmp_code->( $key, $array_ref->[-1] ) > 0;
116              
117 83         183 my $low = 0;
118 83         151 my $mid = undef;
119 83         116 my $high = $max_index;
120              
121 83         173 while ( $low <= $high ) {
122 275         525 $mid = int( $low + ( ( $high - $low ) / 2 ) );
123 275         427 my $mid_val = $array_ref->[$mid];
124              
125 275         416 my $cmp_result = $cmp_code->( $key, $mid_val );
126              
127 275 100       512 if ( $cmp_result > 0 ) {
128 136         255 $low = $mid + 1;
129             }
130             else {
131 139         332 $high = $mid - 1;
132             }
133             }
134              
135             # Look at the values here and work out what to return.
136              
137             # Perhaps $mid is just before the best match
138 83 100       139 return $mid + 1 if $cmp_code->( $key, $array_ref->[$mid] ) > 0;
139              
140             # $mid is correct
141 61         198 return $mid;
142             }
143              
144             =head2 list_contains, nlist_contains, custom_list_contains
145              
146             my $bool = list_contains( $key, \@sorted_list ); # string sort
147             my $bool = nlist_contains( $key, \@sorted_list ); # number sort
148              
149             my $bool = custom_list_contains( $cmp_sub_ref, $key, \@sorted_list );
150              
151             Returns true if C<$key> was found in the list, false otherwise.
152              
153             =cut
154              
155             sub list_contains {
156 11     11 1 171687 my ( $key, $array_ref ) = @_;
157 11         27 return custom_list_contains( \&_alpha_sort, $key, $array_ref );
158             }
159              
160             sub nlist_contains {
161 23     23 1 2500 my ( $key, $array_ref ) = @_;
162 23         44 return custom_list_contains( \&_numeric_sort, $key, $array_ref );
163             }
164              
165             sub custom_list_contains {
166 34     34 1 50 my ( $code, $key, $array_ref ) = @_;
167              
168             # Get the index of the key
169 34         52 my $idx = custom_list_search( $code, $key, $array_ref );
170 34 100       59 return 0 if $idx == -1;
171              
172             # Compare the key to the index
173 30         35 my $cmp_result = $code->( $key, $array_ref->[$idx] );
174              
175 30 100       122 return $cmp_result == 0 # is there a difference?
176             ? 1 # there was no difference, so $key is in array
177             : 0; # $key is not in array
178             }
179              
180 116     116   229 sub _alpha_sort { $_[0] cmp $_[1]; }
181 331     331   623 sub _numeric_sort { $_[0] <=> $_[1]; }
182              
183             =head1 AUTHOR
184              
185             Edmund von der Burg C<>
186              
187             L
188              
189             =head1 SEE ALSO
190              
191             For fast sorting of lists try L. For matching on not just the start
192             of the item try L. For matching in an unsorted
193             list try L.
194              
195             =head1 CREDITS
196              
197             Sean Woolcock submitted several bug fixes which were included in 0.3
198              
199             =head1 LINKS
200              
201             Starting May 2026, the source code repository of List::Search
202             lives on L.
203              
204             To report bugs, use Codeberg's built-in issue tracker
205             at L.
206             Alternatively, use RT at
207             L
208             or by emailing L.
209              
210             There is an information page regarding List::Search at
211             L.
212              
213             =head1 COPYRIGHT
214              
215             Copyright (C) 2007 Edmund von der Burg. All rights reserved.
216              
217             This module is free software; you can redistribute it and/or modify it under
218             the same terms as Perl itself. If it breaks you get to keep both pieces.
219              
220             THERE IS NO WARRANTY.
221              
222             =cut
223              
224             1;