File Coverage

blib/lib/Bijection.pm
Criterion Covered Total %
statement 34 34 100.0
branch 6 6 100.0
condition n/a
subroutine 11 11 100.0
pod 4 4 100.0
total 55 55 100.0


line stmt bran cond sub pod time code
1             package Bijection;
2 5     5   328432 use 5.006; use strict; use warnings; our $VERSION = '0.04';
  5     5   54  
  5     5   27  
  5         9  
  5         131  
  5         36  
  5         9  
  5         237  
3 5     5   2602 use Import::Export; use base qw/Import::Export/;
  5     5   82646  
  5         32  
  5         195  
  5         11  
  5         435  
4 5     5   31 use Carp qw/croak/;
  5         11  
  5         1345  
5             our %EX = (biject => [qw/all main/], inverse => [qw/all main/], bijection_set => [qw/all set/], offset_set => [qw/all set/]);
6              
7             our (@ALPHA, $OFFSET, $COUNT, %INDEX);
8             BEGIN {
9             sub bijection_set {
10 8     8 1 1188 @ALPHA = @_;
11 8 100       66 $ALPHA[0] =~ m/^[1-9](?!$)\d+$/ ? offset_set(shift @ALPHA) : offset_set(scalar @ALPHA);
12 8         15 $COUNT = @ALPHA;
13 8         15 my $index = -1;
14 8         1735 %INDEX = map +( $_ => ++$index ), @ALPHA;
15             }
16             sub offset_set {
17 8     8 1 16 $OFFSET = shift;
18             }
19 5     5   41 bijection_set(qw/b c d f g h j k l m n p q r s t v w x y z B C D F G H J K L M N P Q R S T V W X Y Z 0 1 2 3 4 5 6 7 8 9/);
20             }
21              
22             sub biject {
23 5035     5035 1 2491110 my ($id, $out) = @_;
24 5035 100       27157 croak "id to encode must be an integer and non-negative: $id" unless ($id =~ m/^\d+$/);
25 5032         8922 $id += $OFFSET;
26 5032         6461 do { $out .= $ALPHA[($id % $COUNT)]; $id = int($id/$COUNT); } while ($id > 0);
  12417         21679  
  12417         28014  
27 5032         13046 reverse $out;
28             }
29              
30             sub inverse {
31 5032     5032 1 27939 my ($out, $id) = (@_, 0);
32             $id = exists $INDEX{$_}
33             ? $id * $COUNT + $INDEX{$_}
34             : croak "invalid character $_ in $out"
35 5032 100       26175 for (split //, $out);
36 5031         17455 $id - $OFFSET;
37             }
38              
39             1;
40              
41             __END__