| Filename | /home/ss5/perl5/perlbrew/perls/perl-5.22.0/lib/site_perl/5.22.0/x86_64-linux/List/MoreUtils/PP.pm |
| Statements | Executed 12 statements in 1.47ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1 | 1 | 1 | 20µs | 20µs | List::MoreUtils::PP::BEGIN@3 |
| 1 | 1 | 1 | 7µs | 11µs | List::MoreUtils::PP::BEGIN@5 |
| 1 | 1 | 1 | 6µs | 25µs | List::MoreUtils::PP::BEGIN@327 |
| 1 | 1 | 1 | 5µs | 13µs | List::MoreUtils::PP::BEGIN@334 |
| 1 | 1 | 1 | 5µs | 6µs | List::MoreUtils::PP::BEGIN@4 |
| 0 | 0 | 0 | 0s | 0s | List::MoreUtils::PP::_XScompiled |
| 0 | 0 | 0 | 0s | 0s | List::MoreUtils::PP::__ANON__[:261] |
| 0 | 0 | 0 | 0s | 0s | List::MoreUtils::PP::__ANON__[:396] |
| 0 | 0 | 0 | 0s | 0s | List::MoreUtils::PP::__ANON__[:405] |
| 0 | 0 | 0 | 0s | 0s | List::MoreUtils::PP::after |
| 0 | 0 | 0 | 0s | 0s | List::MoreUtils::PP::after_incl |
| 0 | 0 | 0 | 0s | 0s | List::MoreUtils::PP::all |
| 0 | 0 | 0 | 0s | 0s | List::MoreUtils::PP::all_u |
| 0 | 0 | 0 | 0s | 0s | List::MoreUtils::PP::any |
| 0 | 0 | 0 | 0s | 0s | List::MoreUtils::PP::any_u |
| 0 | 0 | 0 | 0s | 0s | List::MoreUtils::PP::apply |
| 0 | 0 | 0 | 0s | 0s | List::MoreUtils::PP::before |
| 0 | 0 | 0 | 0s | 0s | List::MoreUtils::PP::before_incl |
| 0 | 0 | 0 | 0s | 0s | List::MoreUtils::PP::bsearch |
| 0 | 0 | 0 | 0s | 0s | List::MoreUtils::PP::bsearchidx |
| 0 | 0 | 0 | 0s | 0s | List::MoreUtils::PP::each_array |
| 0 | 0 | 0 | 0s | 0s | List::MoreUtils::PP::each_arrayref |
| 0 | 0 | 0 | 0s | 0s | List::MoreUtils::PP::false |
| 0 | 0 | 0 | 0s | 0s | List::MoreUtils::PP::firstidx |
| 0 | 0 | 0 | 0s | 0s | List::MoreUtils::PP::firstres |
| 0 | 0 | 0 | 0s | 0s | List::MoreUtils::PP::firstval |
| 0 | 0 | 0 | 0s | 0s | List::MoreUtils::PP::indexes |
| 0 | 0 | 0 | 0s | 0s | List::MoreUtils::PP::insert_after |
| 0 | 0 | 0 | 0s | 0s | List::MoreUtils::PP::insert_after_string |
| 0 | 0 | 0 | 0s | 0s | List::MoreUtils::PP::lastidx |
| 0 | 0 | 0 | 0s | 0s | List::MoreUtils::PP::lastres |
| 0 | 0 | 0 | 0s | 0s | List::MoreUtils::PP::lastval |
| 0 | 0 | 0 | 0s | 0s | List::MoreUtils::PP::mesh |
| 0 | 0 | 0 | 0s | 0s | List::MoreUtils::PP::minmax |
| 0 | 0 | 0 | 0s | 0s | List::MoreUtils::PP::natatime |
| 0 | 0 | 0 | 0s | 0s | List::MoreUtils::PP::none |
| 0 | 0 | 0 | 0s | 0s | List::MoreUtils::PP::none_u |
| 0 | 0 | 0 | 0s | 0s | List::MoreUtils::PP::notall |
| 0 | 0 | 0 | 0s | 0s | List::MoreUtils::PP::notall_u |
| 0 | 0 | 0 | 0s | 0s | List::MoreUtils::PP::nsort_by |
| 0 | 0 | 0 | 0s | 0s | List::MoreUtils::PP::one |
| 0 | 0 | 0 | 0s | 0s | List::MoreUtils::PP::one_u |
| 0 | 0 | 0 | 0s | 0s | List::MoreUtils::PP::onlyidx |
| 0 | 0 | 0 | 0s | 0s | List::MoreUtils::PP::onlyres |
| 0 | 0 | 0 | 0s | 0s | List::MoreUtils::PP::onlyval |
| 0 | 0 | 0 | 0s | 0s | List::MoreUtils::PP::pairwise |
| 0 | 0 | 0 | 0s | 0s | List::MoreUtils::PP::part |
| 0 | 0 | 0 | 0s | 0s | List::MoreUtils::PP::singleton |
| 0 | 0 | 0 | 0s | 0s | List::MoreUtils::PP::sort_by |
| 0 | 0 | 0 | 0s | 0s | List::MoreUtils::PP::true |
| 0 | 0 | 0 | 0s | 0s | List::MoreUtils::PP::uniq |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package List::MoreUtils::PP; | ||||
| 2 | |||||
| 3 | 2 | 38µs | 1 | 20µs | # spent 20µs within List::MoreUtils::PP::BEGIN@3 which was called:
# once (20µs+0s) by List::MoreUtils::XS::BEGIN@1 at line 3 # spent 20µs making 1 call to List::MoreUtils::PP::BEGIN@3 |
| 4 | 2 | 13µs | 2 | 8µs | # spent 6µs (5+2) within List::MoreUtils::PP::BEGIN@4 which was called:
# once (5µs+2µs) by List::MoreUtils::XS::BEGIN@1 at line 4 # spent 6µs making 1 call to List::MoreUtils::PP::BEGIN@4
# spent 2µs making 1 call to strict::import |
| 5 | 2 | 764µs | 2 | 15µs | # spent 11µs (7+4) within List::MoreUtils::PP::BEGIN@5 which was called:
# once (7µs+4µs) by List::MoreUtils::XS::BEGIN@1 at line 5 # spent 11µs making 1 call to List::MoreUtils::PP::BEGIN@5
# spent 4µs making 1 call to warnings::import |
| 6 | |||||
| 7 | 1 | 300ns | our $VERSION = '0.413'; | ||
| 8 | |||||
| 9 | =pod | ||||
| 10 | |||||
| 11 | =head1 NAME | ||||
| 12 | |||||
| 13 | List::MoreUtils::PP - Provide List::MoreUtils pure Perl implementation | ||||
| 14 | |||||
| 15 | =head1 SYNOPSIS | ||||
| 16 | |||||
| 17 | BEGIN { $ENV{LIST_MOREUTILS_PP} = 1; } | ||||
| 18 | use List::MoreUtils qw(:all); | ||||
| 19 | |||||
| 20 | =cut | ||||
| 21 | |||||
| 22 | sub any (&@) | ||||
| 23 | { | ||||
| 24 | my $f = shift; | ||||
| 25 | foreach (@_) | ||||
| 26 | { | ||||
| 27 | return 1 if $f->(); | ||||
| 28 | } | ||||
| 29 | return 0; | ||||
| 30 | } | ||||
| 31 | |||||
| 32 | sub all (&@) | ||||
| 33 | { | ||||
| 34 | my $f = shift; | ||||
| 35 | foreach (@_) | ||||
| 36 | { | ||||
| 37 | return 0 unless $f->(); | ||||
| 38 | } | ||||
| 39 | return 1; | ||||
| 40 | } | ||||
| 41 | |||||
| 42 | sub none (&@) | ||||
| 43 | { | ||||
| 44 | my $f = shift; | ||||
| 45 | foreach (@_) | ||||
| 46 | { | ||||
| 47 | return 0 if $f->(); | ||||
| 48 | } | ||||
| 49 | return 1; | ||||
| 50 | } | ||||
| 51 | |||||
| 52 | sub notall (&@) | ||||
| 53 | { | ||||
| 54 | my $f = shift; | ||||
| 55 | foreach (@_) | ||||
| 56 | { | ||||
| 57 | return 1 unless $f->(); | ||||
| 58 | } | ||||
| 59 | return 0; | ||||
| 60 | } | ||||
| 61 | |||||
| 62 | sub one (&@) | ||||
| 63 | { | ||||
| 64 | my $f = shift; | ||||
| 65 | my $found = 0; | ||||
| 66 | foreach (@_) | ||||
| 67 | { | ||||
| 68 | $f->() and $found++ and return 0; | ||||
| 69 | } | ||||
| 70 | $found; | ||||
| 71 | } | ||||
| 72 | |||||
| 73 | sub any_u (&@) | ||||
| 74 | { | ||||
| 75 | my $f = shift; | ||||
| 76 | return if !@_; | ||||
| 77 | $f->() and return 1 foreach (@_); | ||||
| 78 | return 0; | ||||
| 79 | } | ||||
| 80 | |||||
| 81 | sub all_u (&@) | ||||
| 82 | { | ||||
| 83 | my $f = shift; | ||||
| 84 | return if !@_; | ||||
| 85 | $f->() or return 0 foreach (@_); | ||||
| 86 | return 1; | ||||
| 87 | } | ||||
| 88 | |||||
| 89 | sub none_u (&@) | ||||
| 90 | { | ||||
| 91 | my $f = shift; | ||||
| 92 | return if !@_; | ||||
| 93 | $f->() and return 0 foreach (@_); | ||||
| 94 | return 1; | ||||
| 95 | } | ||||
| 96 | |||||
| 97 | sub notall_u (&@) | ||||
| 98 | { | ||||
| 99 | my $f = shift; | ||||
| 100 | return if !@_; | ||||
| 101 | $f->() or return 1 foreach (@_); | ||||
| 102 | return 0; | ||||
| 103 | } | ||||
| 104 | |||||
| 105 | sub one_u (&@) | ||||
| 106 | { | ||||
| 107 | my $f = shift; | ||||
| 108 | return if !@_; | ||||
| 109 | my $found = 0; | ||||
| 110 | foreach (@_) | ||||
| 111 | { | ||||
| 112 | $f->() and $found++ and return 0; | ||||
| 113 | } | ||||
| 114 | $found; | ||||
| 115 | } | ||||
| 116 | |||||
| 117 | sub true (&@) | ||||
| 118 | { | ||||
| 119 | my $f = shift; | ||||
| 120 | my $count = 0; | ||||
| 121 | $f->() and ++$count foreach (@_); | ||||
| 122 | return $count; | ||||
| 123 | } | ||||
| 124 | |||||
| 125 | sub false (&@) | ||||
| 126 | { | ||||
| 127 | my $f = shift; | ||||
| 128 | my $count = 0; | ||||
| 129 | $f->() or ++$count foreach (@_); | ||||
| 130 | return $count; | ||||
| 131 | } | ||||
| 132 | |||||
| 133 | sub firstidx (&@) | ||||
| 134 | { | ||||
| 135 | my $f = shift; | ||||
| 136 | foreach my $i ( 0 .. $#_ ) | ||||
| 137 | { | ||||
| 138 | local *_ = \$_[$i]; | ||||
| 139 | return $i if $f->(); | ||||
| 140 | } | ||||
| 141 | return -1; | ||||
| 142 | } | ||||
| 143 | |||||
| 144 | sub firstval (&@) | ||||
| 145 | { | ||||
| 146 | my $test = shift; | ||||
| 147 | foreach (@_) | ||||
| 148 | { | ||||
| 149 | return $_ if $test->(); | ||||
| 150 | } | ||||
| 151 | return undef; | ||||
| 152 | } | ||||
| 153 | |||||
| 154 | sub firstres (&@) | ||||
| 155 | { | ||||
| 156 | my $test = shift; | ||||
| 157 | foreach (@_) | ||||
| 158 | { | ||||
| 159 | my $testval = $test->(); | ||||
| 160 | $testval and return $testval; | ||||
| 161 | } | ||||
| 162 | return undef; | ||||
| 163 | } | ||||
| 164 | |||||
| 165 | sub onlyidx (&@) | ||||
| 166 | { | ||||
| 167 | my $f = shift; | ||||
| 168 | my $found; | ||||
| 169 | foreach my $i ( 0 .. $#_ ) | ||||
| 170 | { | ||||
| 171 | local *_ = \$_[$i]; | ||||
| 172 | $f->() or next; | ||||
| 173 | defined $found and return -1; | ||||
| 174 | $found = $i; | ||||
| 175 | } | ||||
| 176 | return defined $found ? $found : -1; | ||||
| 177 | } | ||||
| 178 | |||||
| 179 | sub onlyval (&@) | ||||
| 180 | { | ||||
| 181 | my $test = shift; | ||||
| 182 | my $result = undef; | ||||
| 183 | my $found = 0; | ||||
| 184 | foreach (@_) | ||||
| 185 | { | ||||
| 186 | $test->() or next; | ||||
| 187 | $result = $_; | ||||
| 188 | $found++ and return undef; | ||||
| 189 | } | ||||
| 190 | return $result; | ||||
| 191 | } | ||||
| 192 | |||||
| 193 | sub onlyres (&@) | ||||
| 194 | { | ||||
| 195 | my $test = shift; | ||||
| 196 | my $result = undef; | ||||
| 197 | my $found = 0; | ||||
| 198 | foreach (@_) | ||||
| 199 | { | ||||
| 200 | my $rv = $test->() or next; | ||||
| 201 | $result = $rv; | ||||
| 202 | $found++ and return undef; | ||||
| 203 | } | ||||
| 204 | return $found ? $result : undef; | ||||
| 205 | } | ||||
| 206 | |||||
| 207 | sub lastidx (&@) | ||||
| 208 | { | ||||
| 209 | my $f = shift; | ||||
| 210 | foreach my $i ( reverse 0 .. $#_ ) | ||||
| 211 | { | ||||
| 212 | local *_ = \$_[$i]; | ||||
| 213 | return $i if $f->(); | ||||
| 214 | } | ||||
| 215 | return -1; | ||||
| 216 | } | ||||
| 217 | |||||
| 218 | sub lastval (&@) | ||||
| 219 | { | ||||
| 220 | my $test = shift; | ||||
| 221 | my $ix; | ||||
| 222 | for ( $ix = $#_; $ix >= 0; $ix-- ) | ||||
| 223 | { | ||||
| 224 | local *_ = \$_[$ix]; | ||||
| 225 | my $testval = $test->(); | ||||
| 226 | |||||
| 227 | # Simulate $_ as alias | ||||
| 228 | $_[$ix] = $_; | ||||
| 229 | return $_ if $testval; | ||||
| 230 | } | ||||
| 231 | return undef; | ||||
| 232 | } | ||||
| 233 | |||||
| 234 | sub lastres (&@) | ||||
| 235 | { | ||||
| 236 | my $test = shift; | ||||
| 237 | my $ix; | ||||
| 238 | for ( $ix = $#_; $ix >= 0; $ix-- ) | ||||
| 239 | { | ||||
| 240 | local *_ = \$_[$ix]; | ||||
| 241 | my $testval = $test->(); | ||||
| 242 | |||||
| 243 | # Simulate $_ as alias | ||||
| 244 | $_[$ix] = $_; | ||||
| 245 | return $testval if $testval; | ||||
| 246 | } | ||||
| 247 | return undef; | ||||
| 248 | } | ||||
| 249 | |||||
| 250 | sub insert_after (&$\@) | ||||
| 251 | { | ||||
| 252 | my ( $f, $val, $list ) = @_; | ||||
| 253 | my $c = &firstidx( $f, @$list ); | ||||
| 254 | @$list = ( @{$list}[ 0 .. $c ], $val, @{$list}[ $c + 1 .. $#$list ], ) and return 1 if $c != -1; | ||||
| 255 | return 0; | ||||
| 256 | } | ||||
| 257 | |||||
| 258 | sub insert_after_string ($$\@) | ||||
| 259 | { | ||||
| 260 | my ( $string, $val, $list ) = @_; | ||||
| 261 | my $c = firstidx { defined $_ and $string eq $_ } @$list; | ||||
| 262 | @$list = ( @{$list}[ 0 .. $c ], $val, @{$list}[ $c + 1 .. $#$list ], ) and return 1 if $c != -1; | ||||
| 263 | return 0; | ||||
| 264 | } | ||||
| 265 | |||||
| 266 | sub apply (&@) | ||||
| 267 | { | ||||
| 268 | my $action = shift; | ||||
| 269 | &$action foreach my @values = @_; | ||||
| 270 | wantarray ? @values : $values[-1]; | ||||
| 271 | } | ||||
| 272 | |||||
| 273 | sub after (&@) | ||||
| 274 | { | ||||
| 275 | my $test = shift; | ||||
| 276 | my $started; | ||||
| 277 | my $lag; | ||||
| 278 | grep $started ||= do | ||||
| 279 | { | ||||
| 280 | my $x = $lag; | ||||
| 281 | $lag = $test->(); | ||||
| 282 | $x; | ||||
| 283 | }, @_; | ||||
| 284 | } | ||||
| 285 | |||||
| 286 | sub after_incl (&@) | ||||
| 287 | { | ||||
| 288 | my $test = shift; | ||||
| 289 | my $started; | ||||
| 290 | grep $started ||= $test->(), @_; | ||||
| 291 | } | ||||
| 292 | |||||
| 293 | sub before (&@) | ||||
| 294 | { | ||||
| 295 | my $test = shift; | ||||
| 296 | my $more = 1; | ||||
| 297 | grep $more &&= !$test->(), @_; | ||||
| 298 | } | ||||
| 299 | |||||
| 300 | sub before_incl (&@) | ||||
| 301 | { | ||||
| 302 | my $test = shift; | ||||
| 303 | my $more = 1; | ||||
| 304 | my $lag = 1; | ||||
| 305 | grep $more &&= do | ||||
| 306 | { | ||||
| 307 | my $x = $lag; | ||||
| 308 | $lag = !$test->(); | ||||
| 309 | $x; | ||||
| 310 | }, @_; | ||||
| 311 | } | ||||
| 312 | |||||
| 313 | sub indexes (&@) | ||||
| 314 | { | ||||
| 315 | my $test = shift; | ||||
| 316 | grep { | ||||
| 317 | local *_ = \$_[$_]; | ||||
| 318 | $test->() | ||||
| 319 | } 0 .. $#_; | ||||
| 320 | } | ||||
| 321 | |||||
| 322 | sub pairwise (&\@\@) | ||||
| 323 | { | ||||
| 324 | my $op = shift; | ||||
| 325 | |||||
| 326 | # Symbols for caller's input arrays | ||||
| 327 | 2 | 32µs | 2 | 44µs | # spent 25µs (6+19) within List::MoreUtils::PP::BEGIN@327 which was called:
# once (6µs+19µs) by List::MoreUtils::XS::BEGIN@1 at line 327 # spent 25µs making 1 call to List::MoreUtils::PP::BEGIN@327
# spent 19µs making 1 call to vars::import |
| 328 | local ( *A, *B ) = @_; | ||||
| 329 | |||||
| 330 | # Localise $a, $b | ||||
| 331 | my ( $caller_a, $caller_b ) = do | ||||
| 332 | { | ||||
| 333 | my $pkg = caller(); | ||||
| 334 | 2 | 623µs | 2 | 20µs | # spent 13µs (5+8) within List::MoreUtils::PP::BEGIN@334 which was called:
# once (5µs+8µs) by List::MoreUtils::XS::BEGIN@1 at line 334 # spent 13µs making 1 call to List::MoreUtils::PP::BEGIN@334
# spent 8µs making 1 call to strict::unimport |
| 335 | \*{ $pkg . '::a' }, \*{ $pkg . '::b' }; | ||||
| 336 | }; | ||||
| 337 | |||||
| 338 | # Loop iteration limit | ||||
| 339 | my $limit = $#A > $#B ? $#A : $#B; | ||||
| 340 | |||||
| 341 | # This map expression is also the return value | ||||
| 342 | local ( *$caller_a, *$caller_b ); | ||||
| 343 | map { | ||||
| 344 | # Assign to $a, $b as refs to caller's array elements | ||||
| 345 | ( *$caller_a, *$caller_b ) = \( $A[$_], $B[$_] ); | ||||
| 346 | |||||
| 347 | # Perform the transformation | ||||
| 348 | $op->(); | ||||
| 349 | } 0 .. $limit; | ||||
| 350 | } | ||||
| 351 | |||||
| 352 | sub each_array (\@;\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@) | ||||
| 353 | { | ||||
| 354 | return each_arrayref(@_); | ||||
| 355 | } | ||||
| 356 | |||||
| 357 | sub each_arrayref | ||||
| 358 | { | ||||
| 359 | my @list = @_; # The list of references to the arrays | ||||
| 360 | my $index = 0; # Which one the caller will get next | ||||
| 361 | my $max = 0; # Number of elements in longest array | ||||
| 362 | |||||
| 363 | # Get the length of the longest input array | ||||
| 364 | foreach (@list) | ||||
| 365 | { | ||||
| 366 | unless ( ref $_ eq 'ARRAY' ) | ||||
| 367 | { | ||||
| 368 | require Carp; | ||||
| 369 | Carp::croak("each_arrayref: argument is not an array reference\n"); | ||||
| 370 | } | ||||
| 371 | $max = @$_ if @$_ > $max; | ||||
| 372 | } | ||||
| 373 | |||||
| 374 | # Return the iterator as a closure wrt the above variables. | ||||
| 375 | return sub { | ||||
| 376 | if (@_) | ||||
| 377 | { | ||||
| 378 | my $method = shift; | ||||
| 379 | unless ( $method eq 'index' ) | ||||
| 380 | { | ||||
| 381 | require Carp; | ||||
| 382 | Carp::croak("each_array: unknown argument '$method' passed to iterator."); | ||||
| 383 | } | ||||
| 384 | |||||
| 385 | # Return current (last fetched) index | ||||
| 386 | return undef if $index == 0 || $index > $max; | ||||
| 387 | return $index - 1; | ||||
| 388 | } | ||||
| 389 | |||||
| 390 | # No more elements to return | ||||
| 391 | return if $index >= $max; | ||||
| 392 | my $i = $index++; | ||||
| 393 | |||||
| 394 | # Return ith elements | ||||
| 395 | return map $_->[$i], @list; | ||||
| 396 | } | ||||
| 397 | } | ||||
| 398 | |||||
| 399 | sub natatime ($@) | ||||
| 400 | { | ||||
| 401 | my $n = shift; | ||||
| 402 | my @list = @_; | ||||
| 403 | return sub { | ||||
| 404 | return splice @list, 0, $n; | ||||
| 405 | } | ||||
| 406 | } | ||||
| 407 | |||||
| 408 | sub mesh (\@\@;\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@) | ||||
| 409 | { | ||||
| 410 | my $max = -1; | ||||
| 411 | $max < $#$_ && ( $max = $#$_ ) foreach @_; | ||||
| 412 | map { | ||||
| 413 | my $ix = $_; | ||||
| 414 | map $_->[$ix], @_; | ||||
| 415 | } 0 .. $max; | ||||
| 416 | } | ||||
| 417 | |||||
| 418 | sub uniq (@) | ||||
| 419 | { | ||||
| 420 | my %seen = (); | ||||
| 421 | my $k; | ||||
| 422 | my $seen_undef; | ||||
| 423 | grep { defined $_ ? not $seen{ $k = $_ }++ : not $seen_undef++ } @_; | ||||
| 424 | } | ||||
| 425 | |||||
| 426 | sub singleton (@) | ||||
| 427 | { | ||||
| 428 | my %seen = (); | ||||
| 429 | my $k; | ||||
| 430 | my $seen_undef; | ||||
| 431 | grep { 1 == ( defined $_ ? $seen{ $k = $_ } : $seen_undef ) } | ||||
| 432 | grep { defined $_ ? not $seen{ $k = $_ }++ : not $seen_undef++ } @_; | ||||
| 433 | } | ||||
| 434 | |||||
| 435 | sub minmax (@) | ||||
| 436 | { | ||||
| 437 | return unless @_; | ||||
| 438 | my $min = my $max = $_[0]; | ||||
| 439 | |||||
| 440 | for ( my $i = 1; $i < @_; $i += 2 ) | ||||
| 441 | { | ||||
| 442 | if ( $_[ $i - 1 ] <= $_[$i] ) | ||||
| 443 | { | ||||
| 444 | $min = $_[ $i - 1 ] if $min > $_[ $i - 1 ]; | ||||
| 445 | $max = $_[$i] if $max < $_[$i]; | ||||
| 446 | } | ||||
| 447 | else | ||||
| 448 | { | ||||
| 449 | $min = $_[$i] if $min > $_[$i]; | ||||
| 450 | $max = $_[ $i - 1 ] if $max < $_[ $i - 1 ]; | ||||
| 451 | } | ||||
| 452 | } | ||||
| 453 | |||||
| 454 | if ( @_ & 1 ) | ||||
| 455 | { | ||||
| 456 | my $i = $#_; | ||||
| 457 | if ( $_[ $i - 1 ] <= $_[$i] ) | ||||
| 458 | { | ||||
| 459 | $min = $_[ $i - 1 ] if $min > $_[ $i - 1 ]; | ||||
| 460 | $max = $_[$i] if $max < $_[$i]; | ||||
| 461 | } | ||||
| 462 | else | ||||
| 463 | { | ||||
| 464 | $min = $_[$i] if $min > $_[$i]; | ||||
| 465 | $max = $_[ $i - 1 ] if $max < $_[ $i - 1 ]; | ||||
| 466 | } | ||||
| 467 | } | ||||
| 468 | |||||
| 469 | return ( $min, $max ); | ||||
| 470 | } | ||||
| 471 | |||||
| 472 | sub part (&@) | ||||
| 473 | { | ||||
| 474 | my ( $code, @list ) = @_; | ||||
| 475 | my @parts; | ||||
| 476 | push @{ $parts[ $code->($_) ] }, $_ foreach @list; | ||||
| 477 | return @parts; | ||||
| 478 | } | ||||
| 479 | |||||
| 480 | sub bsearch(&@) | ||||
| 481 | { | ||||
| 482 | my $code = shift; | ||||
| 483 | |||||
| 484 | my $rc; | ||||
| 485 | my $i = 0; | ||||
| 486 | my $j = @_; | ||||
| 487 | do | ||||
| 488 | { | ||||
| 489 | my $k = int( ( $i + $j ) / 2 ); | ||||
| 490 | |||||
| 491 | $k >= @_ and return; | ||||
| 492 | |||||
| 493 | local *_ = \$_[$k]; | ||||
| 494 | $rc = $code->(); | ||||
| 495 | |||||
| 496 | $rc == 0 | ||||
| 497 | and return wantarray ? $_ : 1; | ||||
| 498 | |||||
| 499 | if ( $rc < 0 ) | ||||
| 500 | { | ||||
| 501 | $i = $k + 1; | ||||
| 502 | } | ||||
| 503 | else | ||||
| 504 | { | ||||
| 505 | $j = $k - 1; | ||||
| 506 | } | ||||
| 507 | } until $i > $j; | ||||
| 508 | |||||
| 509 | return; | ||||
| 510 | } | ||||
| 511 | |||||
| 512 | sub bsearchidx(&@) | ||||
| 513 | { | ||||
| 514 | my $code = shift; | ||||
| 515 | |||||
| 516 | my $rc; | ||||
| 517 | my $i = 0; | ||||
| 518 | my $j = @_; | ||||
| 519 | do | ||||
| 520 | { | ||||
| 521 | my $k = int( ( $i + $j ) / 2 ); | ||||
| 522 | |||||
| 523 | $k >= @_ and return -1; | ||||
| 524 | |||||
| 525 | local *_ = \$_[$k]; | ||||
| 526 | $rc = $code->(); | ||||
| 527 | |||||
| 528 | $rc == 0 and return $k; | ||||
| 529 | |||||
| 530 | if ( $rc < 0 ) | ||||
| 531 | { | ||||
| 532 | $i = $k + 1; | ||||
| 533 | } | ||||
| 534 | else | ||||
| 535 | { | ||||
| 536 | $j = $k - 1; | ||||
| 537 | } | ||||
| 538 | } until $i > $j; | ||||
| 539 | |||||
| 540 | return -1; | ||||
| 541 | } | ||||
| 542 | |||||
| 543 | sub sort_by(&@) | ||||
| 544 | { | ||||
| 545 | my ( $code, @list ) = @_; | ||||
| 546 | return map { $_->[0] } | ||||
| 547 | sort { $a->[1] cmp $b->[1] } | ||||
| 548 | map { [ $_, scalar( $code->() ) ] } @list; | ||||
| 549 | } | ||||
| 550 | |||||
| 551 | sub nsort_by(&@) | ||||
| 552 | { | ||||
| 553 | my ( $code, @list ) = @_; | ||||
| 554 | return map { $_->[0] } | ||||
| 555 | sort { $a->[1] <=> $b->[1] } | ||||
| 556 | map { [ $_, scalar( $code->() ) ] } @list; | ||||
| 557 | } | ||||
| 558 | |||||
| 559 | sub _XScompiled { 0 } | ||||
| 560 | |||||
| 561 | =head1 SEE ALSO | ||||
| 562 | |||||
| 563 | L<List::Util> | ||||
| 564 | |||||
| 565 | =head1 AUTHOR | ||||
| 566 | |||||
| 567 | Jens Rehsack E<lt>rehsack AT cpan.orgE<gt> | ||||
| 568 | |||||
| 569 | Adam Kennedy E<lt>adamk@cpan.orgE<gt> | ||||
| 570 | |||||
| 571 | Tassilo von Parseval E<lt>tassilo.von.parseval@rwth-aachen.deE<gt> | ||||
| 572 | |||||
| 573 | =head1 COPYRIGHT AND LICENSE | ||||
| 574 | |||||
| 575 | Some parts copyright 2011 Aaron Crane. | ||||
| 576 | |||||
| 577 | Copyright 2004 - 2010 by Tassilo von Parseval | ||||
| 578 | |||||
| 579 | Copyright 2013 - 2015 by Jens Rehsack | ||||
| 580 | |||||
| 581 | This library is free software; you can redistribute it and/or modify | ||||
| 582 | it under the same terms as Perl itself, either Perl version 5.8.4 or, | ||||
| 583 | at your option, any later version of Perl 5 you may have available. | ||||
| 584 | |||||
| 585 | =cut | ||||
| 586 | |||||
| 587 | 1 | 2µs | 1; |