File Coverage

blib/lib/Encode/Positive/Pairs.pm
Criterion Covered Total %
statement 54 54 100.0
branch 18 24 75.0
condition n/a
subroutine 11 11 100.0
pod 4 5 80.0
total 87 94 92.5


line stmt bran cond sub pod time code
1             #!/usr/bin/perl
2             #-------------------------------------------------------------------------------
3             # Encode pairs of positive integers as a single integer and vice-versa
4             #
5             # Philip R Brenan at gmail dot com, Appa Apps Ltd Inc, 2017
6             #-------------------------------------------------------------------------------
7             # podDocumentation
8              
9             package Encode::Positive::Pairs;
10             require v5.16.0;
11 1     1   389 use warnings FATAL => qw(all);
  1         2  
  1         29  
12 1     1   5 use strict;
  1         1  
  1         16  
13 1     1   4 use Carp;
  1         2  
  1         70  
14 1     1   785 use Math::BigInt;
  1         23094  
  1         5  
15              
16             our $VERSION = '20170810';
17              
18             #1 Convert # Encode pairs of positive integers as a single integer and vice-versa
19              
20             sub equation($) #P The sum of the numbers from 1 to a specified number
21 144314     144314 1 2386694 {my ($t) = @_; # The number of leading integers to sum
22 144314         302498 $t * ($t + 1) / 2
23             }
24              
25             sub search($$$) #P Return the pair that encode to the number specified
26 5145     5145 1 2359248 {my ($n, $l, $u) = @_; # Number to decode, lower limit, upper limit
27              
28 5145         17827 for(1..4*length($n))
29 36006         992037 {my ($L, $U) = map{equation(Math::BigInt->new($_))} $l, $u;
  72012         13321990  
30              
31 36006 50       13136695 return ($l, 0) if $n == $L;
32 36006 50       1008915 return ($u, 0) if $n == $U;
33              
34 36006         910182 my $m = ($l+$u) >> 1;
35              
36 36006 100       7989920 if ($l == $m)
37 5052         143461 {my $d = $n - $L;
38 5052         575124 return ($l - $d, $d);
39             }
40              
41 30954         888844 my $M = equation($m);
42 30954 100       11373424 return ($m, 0) if $M == $n;
43 30861 100       880067 ($M > $n ? $u : $l) = $m
44             }
45             }
46              
47             sub singleToPair($) # Decode a single integer into a pair of integers
48 5153     5153 1 14347 {my ($N) = @_; # Number to decode
49 5153 50       15320 $N =~ m/\A\d+\Z/s or confess "$N is not an integer";
50 5153 100       143364 return (0, 0) unless $N; # Simple case
51              
52 5152         121496 my $n = Math::BigInt->new($N);
53              
54 5152         176577 for my $x(0..4*length($N)) # Maximum number of searches required
55 41348         1093532 {my $t = Math::BigInt->new(1)<<$x;
56 41348         9217605 my $steps = equation($t);
57 41348 100       15183502 return ($t, 0) if $steps == $n;
58 41341 100       1180673 next if $steps < $n;
59 5145         138820 return search($n, Math::BigInt->new(1)<<($x-1), Math::BigInt->new(1)<<$x);
60             }
61             }
62              
63             sub pairToSingle($$) # Return the single integer representing a pair of integers
64 5153     5153 1 16559 {my ($I, $J) = @_; # First number of pair to encode, second number of pair to encode
65 5153         18546 my $i = Math::BigInt->new($I);
66 5153         203200 my $j = Math::BigInt->new($J);
67 5153         169556 my $d = $i + $j;
68 5153         378000 ($d * $d + $d) / 2 + $j
69             }
70              
71             #-------------------------------------------------------------------------------
72             # Export
73             #---------------------------------------/lib/Encode/Positive/Pairs.pm ----------------------------------------
74              
75             require Exporter;
76              
77 1     1   18494 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  1         3  
  1         232  
78              
79             @ISA = qw(Exporter);
80             @EXPORT = qw();
81             @EXPORT_OK = qw();
82             %EXPORT_TAGS = (all=>[@EXPORT, @EXPORT_OK]);
83              
84             # podDocumentation
85              
86             =pod
87              
88             =encoding utf-8
89              
90             =head1 Name
91              
92             Encode::Positive::Pairs - encode pairs of positive integers as a single integer and vice versa
93              
94             =head1 Synopsis
95              
96             use Encode::Positive::Pairs;
97              
98             my ($i, $j) = Encode::Positive::Pairs::singleToPair(4);
99             ok $i == 1 && $j == 1;
100              
101             ok 4 == Encode::Positive::Pairs::pairToSingle(1, 1);
102              
103             Larger numbers are automatically supported via L:
104              
105             my $n = '1'.('0'x121).'1';
106             my ($i, $j) = Encode::Positive::Pairs::singleToPair($n);
107              
108             ok $i == "1698366900312561357458283662619176178439283700581622961703001";
109             ok $j == "12443768723418389130558603579477804607257435053187857770063795";
110              
111             ok $n == Encode::Positive::Pairs::pairToSingle($i, $j);
112              
113             =head1 Description
114              
115             =head2 Convert
116              
117             Encode pairs of positive integers as a single integer and vice-versa
118              
119             =head3 singleToPair
120              
121             Decode a single integer into a pair of integers
122              
123             1 $N Number to decode
124              
125             =head3 pairToSingle
126              
127             Return the single integer representing a pair of integers
128              
129             1 $I First number of pair to encode
130             2 $J Second number of pair to encode
131              
132              
133             =head1 Private Methods
134              
135             =head2 equation
136              
137             The sum of the numbers from 1 to a specified number
138              
139             1 $t The number of leading integers to sum
140              
141             =head2 search
142              
143             Return the pair that encode to the number specified
144              
145             1 $n Number to decode
146             2 $l Lower limit
147             3 $u Upper limit
148              
149              
150             =head1 Index
151              
152              
153             L
154              
155             L
156              
157             L
158              
159             L
160              
161             =head1 Installation
162              
163             This module is written in 100% Pure Perl and, thus, it is easy to read, use,
164             modify and install.
165              
166             Standard Module::Build process for building and installing modules:
167              
168             perl Build.PL
169             ./Build
170             ./Build test
171             ./Build install
172              
173             =head1 Author
174              
175             L
176              
177             L
178              
179             =head1 Copyright
180              
181             Copyright (c) 2016-2017 Philip R Brenan.
182              
183             This module is free software. It may be used, redistributed and/or modified
184             under the same terms as Perl itself.
185              
186             =cut
187              
188              
189             # Tests and documentation
190              
191             sub test
192 1     1 0 11 {my $p = __PACKAGE__;
193 1 50       51 return if eval "eof(${p}::DATA)";
194 1         41 my $s = eval "join('', <${p}::DATA>)";
195 1 50       5 $@ and die $@;
196 1     1   426 eval $s;
  1         49106  
  1         18  
  1         50  
197 1 50       1444 $@ and die $@;
198             }
199              
200             test unless caller;
201              
202             1;
203             # podDocumentation
204             __DATA__