File Coverage

blib/lib/Math/DifferenceSet/Planar.pm
Criterion Covered Total %
statement 605 605 100.0
branch 256 262 97.7
condition 66 72 91.6
subroutine 85 85 100.0
pod 46 46 100.0
total 1058 1070 98.8


line stmt bran cond sub pod time code
1             package Math::DifferenceSet::Planar;
2              
3 5     5   62118 use strict;
  5         28  
  5         121  
4 5     5   23 use warnings;
  5         7  
  5         111  
5 5     5   21 use Carp qw(croak);
  5         9  
  5         299  
6 5     5   1931 use Math::DifferenceSet::Planar::Data;
  5         17  
  5         167  
7 5     5   6229 use Math::BigInt try => 'GMP';
  5         148653  
  5         54  
8 5         34 use Math::Prime::Util qw(
9             is_power is_prime_power euler_phi factor_exp gcd
10             mulmod addmod invmod powmod divmod
11 5     5   118250 );
  5         47940  
12              
13             # Math::DifferenceSet::Planar=ARRAY(...)
14             # ........... index ........... # ........... value ...........
15 5     5   854 use constant _F_ORDER => 0;
  5         11  
  5         262  
16 5     5   25 use constant _F_BASE => 1;
  5         10  
  5         183  
17 5     5   24 use constant _F_EXPONENT => 2;
  5         11  
  5         168  
18 5     5   23 use constant _F_MODULUS => 3;
  5         8  
  5         175  
19 5     5   23 use constant _F_N_PLANES => 4; # number of distinct planes this size
  5         11  
  5         279  
20 5     5   26 use constant _F_ELEMENTS => 5; # elements arrayref
  5         11  
  5         183  
21 5     5   26 use constant _F_ROTATORS => 6; # rotators arrayref, initially empty
  5         24  
  5         238  
22 5     5   30 use constant _F_INDEX_MIN => 7; # index of smallest element
  5         9  
  5         192  
23 5     5   25 use constant _F_GENERATION => 8; # database generation
  5         11  
  5         210  
24 5     5   28 use constant _F_LOG => 9; # plane logarithm value, may be undef
  5         20  
  5         204  
25 5     5   25 use constant _F_ZETA => 10; # "zeta" value, initially undef
  5         9  
  5         203  
26 5     5   26 use constant _F_ETA => 11; # "eta" value, initially undef
  5         20  
  5         196  
27 5     5   24 use constant _F_PEAK => 12; # peak elements arrayref, initially undef
  5         10  
  5         240  
28 5     5   28 use constant _NFIELDS => 13;
  5         11  
  5         29003  
29              
30             our $VERSION = '0.017';
31              
32             our $_LOG_MAX_ORDER = 22.1807; # limit for integer exponentiation
33             our $_MAX_ENUM_COUNT = 32768; # limit for stored rotator set size
34             our $_MAX_MEMO_COUNT = 4096; # limit for memoized values
35             our $_DEFAULT_DEPTH = 1024; # default check_elements() depth
36             our $_USE_SPACES_DB = 1; # enable looking up rotators
37             our $_MAX_FMT_COUNT = 5; # elements printed in messages
38              
39             my $current_data = undef; # current M::D::P::Data object
40             my $generation = 0; # incremented on $current_data update
41              
42             my %memo_n_planes = (); # memoized n_planes values
43              
44             # ----- private subroutines -----
45              
46             # calculate powers of p (mod m)
47             sub _multipliers {
48 7     7   15 my ($base, $exponent, $modulus) = @_;
49 7         14 my @mult = (1);
50 7         14 my $n = 3 * $exponent;
51 7         9 my $x = $base;
52 7   66     31 while (@mult < $n && $x != 1) {
53 41         55 push @mult, $x;
54 41         116 $x = mulmod($x, $base, $modulus);
55             }
56 7 50       18 push @mult, q[...] if $x != 1;
57 7 50       22 die "assertion failed: not $n elements: @mult" if @mult != $n;
58 7         19 return @mult;
59             }
60              
61             # return complete rotator base if known or small enough, otherwise undef
62             #
63             # If structure is known:
64             #
65             # rotators -> +-----------+
66             # | radices ----------------------------> +-------+
67             # +-----------+ | r_1 |
68             # | depths -----------------> +-------+ +-------+
69             # +-----------+ | d_1 | | r_2 |
70             # | inverses -----> +-------+ +-------+ +-------+
71             # +-----------+ | i_1 | | d_2 | | ... |
72             # +-------+ +-------+ +-------+
73             # | i_2 | | ... | | r_n |
74             # +-------+ +-------+ +-------+
75             # | ... | | d_n |
76             # +-------+ +-------+
77             # | i_n |
78             # +-------+
79             #
80             # n
81             # ___ j
82             # R _ | | r k 0 < j < d
83             # j j ...j = | | k (mod M), = k k
84             # 1 2 n
85             # k = 1
86             #
87             # d - 1 _
88             # i r k = 1 (mod M), d > d > ... > d > 2
89             # k k 1 = 2 = = n =
90             #
91             #
92             # Otherwise, if number of rotators is small:
93             #
94             # rotators -> +-------+-------+-- --+-------+
95             # | R_1 | R_2 | ... | R_N |
96             # +-------+-------+-- --+-------+
97             #
98             sub _rotators {
99 16     16   26 my ($this) = @_;
100             my ( $base, $exponent, $order, $modulus, $rotators) =
101 16         26 @{$this}[_F_BASE, _F_EXPONENT, _F_ORDER, _F_MODULUS, _F_ROTATORS];
  16         35  
102 16 100       22 return $rotators if @{$rotators};
  16         35  
103 13   66     38 my $space = $_USE_SPACES_DB && $this->_data->get_space($order);
104 13 100       17604 if ($space) {
105 10         219 my ($radices, $depths) = $space->rotator_space;
106             my $inverses = [
107             map {
108 10         58 invmod(
109             powmod($radices->[$_], $depths->[$_] - 1, $modulus),
110             $modulus
111             )
112 10         21 } 0 .. $#{$radices}
  10         22  
113             ];
114 10         27 $rotators = $this->[_F_ROTATORS] = [$radices, $depths, $inverses];
115 10         57 return $rotators;
116             }
117 3 100       10 return undef if $this->[_F_N_PLANES] > $_MAX_ENUM_COUNT;
118 1         2 my @mult = _multipliers($base, $exponent, $modulus);
119 1         7 my $sieve = '1' x $modulus;
120 1         7 substr($sieve, $_, 1) = '0' for @mult;
121 1         2 @{$rotators} = (1);
  1         3  
122 1         5 for (my $x = 2; $x < $modulus ; ++$x) {
123 89 100       156 if (substr $sieve, $x, 1) {
124 13 100       20 if (0 == $modulus % $x) {
125 2         6 for (my $i = $x; $i < $modulus; $i += $x) {
126 18         28 substr($sieve, $i, 1) = '0';
127             }
128 2         3 next;
129             }
130             substr($sieve, $_, 1) = '0'
131 11         16 for map { mulmod($_, $x, $modulus) } @mult;
  66         107  
132 11         14 push @{$rotators}, $x;
  11         21  
133             }
134             }
135 1         3 return $rotators;
136             }
137              
138             # iterative rotator base generator, slow, but memory efficient
139             sub _sequential_rotators {
140 2     2   4 my ($this) = @_;
141             my ( $base, $exponent, $modulus, $n_planes) =
142 2         4 @{$this}[_F_BASE, _F_EXPONENT, _F_MODULUS, _F_N_PLANES];
  2         4  
143 2         7 my @mult = _multipliers($base, $exponent, $modulus);
144 2         3 shift @mult;
145 2         9 my @pf = map { $_->[0] } factor_exp($modulus);
  3         8  
146 2 100       6 pop @pf if $pf[-1] == $modulus;
147 2         3 my $mx = 0;
148 2         2 my $x = 0;
149             return sub {
150 22 100   22   500 return 0 if $mx >= $n_planes;
151             ELEMENT:
152 20         22 while (1) {
153 71         75 ++$x;
154 71         80 foreach my $p (@pf) {
155 86 100       135 next ELEMENT if !($x % $p);
156             }
157 62         70 foreach my $e (@mult) {
158 265 100       480 next ELEMENT if mulmod($x, $e, $modulus) < $x;
159             }
160 20         20 ++$mx;
161 20         29 return $x;
162             }
163 2         15 };
164             }
165              
166             # structured rotator base iterator, time and space efficient
167             sub _structured_rotators {
168 12     12   18 my ($this) = @_;
169 12         19 my $modulus = $this->[_F_MODULUS];
170 12         24 my ($radices, $depths, $inverses) = @{ $this->[_F_ROTATORS] };
  12         33  
171 12         19 my @index = (0) x @{$radices};
  12         22  
172 12         19 my $next = 1;
173             return sub {
174 38 100   38   1060 return 0 if !$next;
175 36         46 my $element = $next;
176 36         43 my $i = 0;
177 36         65 while ($i < @index) {
178 36 100       68 if (++$index[$i] < $depths->[$i]) {
179 32         61 $next = mulmod($next, $radices->[$i], $modulus);
180 32         62 return $element;
181             }
182             }
183             continue {
184 4         8 $index[$i] = 0;
185 4         9 $next = mulmod($next, $inverses->[$i], $modulus);
186 4         10 ++$i;
187             }
188 4         7 $next = 0;
189 4         8 return $element;
190 12         56 };
191             }
192              
193             sub _space_description {
194 21     21   33 my ($spc) = @_;
195 21         426 my $order = $spc->order;
196 21         505 my $mul_radix = $spc->mul_radix;
197 21         453 my $mul_depth = $spc->mul_depth;
198 21         202 my ($radices, $depths) = $spc->rotator_space;
199 21         33 my @space = map {; "$radices->[$_]^$depths->[$_]"} 0 .. $#{$radices};
  34         97  
  21         42  
200 21         126 return "$order: $mul_radix^$mul_depth [@space]";
201             }
202              
203             # integer exponentiation
204             sub _pow {
205 13     13   36 my ($base, $exponent) = @_;
206 13 100 100     69 return 0 if $base <= 0 || $exponent < 0;
207 10 100       80 return Math::BigInt->new($base)->bpow($exponent)
208             if log(0+$base) * $exponent > $_LOG_MAX_ORDER;
209 9         16 my $power = 1;
210 9         28 while ($exponent) {
211 26 100       57 $power *= $base if 1 & $exponent;
212 26 100       62 $exponent >>= 1 and $base *= $base;
213             }
214 9         18 return $power;
215             }
216              
217             # 0 1 2 3 4 5 6 7 8 9 10
218             # 3 7 14 25 28 29 31 41 61 99 103
219             # 7 8 9 10 0 1 2 3 4 5 6
220             # re-arrange elements of a planar difference set in conventional order
221             sub _sort_elements {
222 65     65   91 my $modulus = shift;
223 65 50       189 my @elements = sort { $a <=> $b || croak "duplicate element: $a" } @_;
  962         1613  
224 64         105 my $lo = $elements[-1] - $modulus;
225 64         82 my $hi = $elements[0];
226 64         90 my $mx = 0;
227 64   100     228 while ($hi - $lo != 1 && ++$mx < @elements) {
228 204         493 ($lo, $hi) = ($hi, $elements[$mx]);
229             }
230 64 100       400 croak "delta 1 elements missing" if $mx >= @elements;
231 62 100       114 $mx += @elements if !$mx--;
232 62 100       160 push @elements, splice @elements, 0, $mx if $mx;
233 62 100       176 return (\@elements, $mx? @elements - $mx: 0);
234             }
235              
236             # 0 1 2 3 4 5 6 7
237             # 28 29 31 41 3 7 14 25
238             # L X H
239             # L X H
240             # LX H
241             # get index of smallest element (using bisection)
242             sub _index_min {
243 45     45   74 my ($elements) = @_;
244 45         107 my ($lx, $hx) = (0, $#$elements);
245 45         91 my $he = $elements->[$hx];
246 45         94 while ($lx < $hx) {
247 115         142 my $x = ($lx + $hx) >> 1;
248 115         136 my $e = $elements->[$x];
249 115 100       172 if ($e < $he) {
250 46         55 $hx = $x;
251 46         83 $he = $e;
252             }
253             else {
254 69         136 $lx = $x + 1;
255             }
256             }
257 45         71 return $hx;
258             }
259              
260             # return data connection, creating it if not yet open
261             sub _data {
262 89 100   89   469 if (!defined $current_data) {
263 4         55 ++$generation;
264 4         28 $current_data = Math::DifferenceSet::Planar::Data->new;
265             }
266 89         956 return $current_data;
267             }
268              
269             # compose a printable abbreviated description of a set
270             sub _fmt_set {
271 4     4   9 my ($this) = @_;
272             my @e = $this->[_F_ORDER] < $_MAX_FMT_COUNT?
273 1         4 @{$this->[_F_ELEMENTS]}:
274 4 100       12 (@{$this->[_F_ELEMENTS]}[0 .. $_MAX_FMT_COUNT-1], q[...]);
  3         10  
275 4         268 return '{' . join(q[,], @e) . '}';
276             }
277              
278             # identify a plane by its rotator value with respect to a given plane
279             # (both arguments zeta-canonized, second argument with known log)
280             sub _log {
281 26     26   73 my ($this, $that) = @_;
282 26         44 my $modulus = $this->[_F_MODULUS];
283 26         39 my %t = ();
284 26         39 foreach my $e (@{$this->[_F_ELEMENTS]}) {
  26         51  
285 157         294 $t{$e} = 1;
286             }
287 26         45 my $r = 0;
288 26         36 foreach my $e (@{$that->[_F_ELEMENTS]}) {
  26         50  
289 70         121 $r = invmod($e, $modulus);
290 70 100       128 last if $r;
291             }
292 26         37 my $factor = 0;
293 26 100       50 if ($r) {
294             ELEM:
295 17         46 foreach my $o (@{$this->[_F_ELEMENTS]}) {
  17         34  
296 29 100       49 next if !$o;
297 24         59 my $ro = mulmod($r, $o, $modulus);
298 24         31 foreach my $e (@{$that->[_F_ELEMENTS]}) {
  24         40  
299 120 100       263 next ELEM if !exists $t{ mulmod($e, $ro, $modulus) };
300             }
301 16         27 $factor = $ro;
302 16         25 last;
303             }
304             }
305             else {
306 9         20 my $ri = $this->iterate_rotators;
307             ROT:
308 9         19 while (my $ro = $ri->()) {
309 11         16 foreach my $e (@{$that->[_F_ELEMENTS]}) {
  11         19  
310 49 100       120 next ROT if !exists $t{ mulmod($e, $ro, $modulus) };
311             }
312 9         13 $factor = $ro;
313 9         55 last;
314             }
315             }
316 26 100       53 if ($factor) {
317 25         48 my $log = $this->[_F_LOG] =
318             mulmod($that->[_F_LOG], $factor, $modulus);
319 25         115 return $log;
320             }
321 1         5 croak 'unaligned sets: ', _fmt_set($this), ' versus ', _fmt_set($that);
322             }
323              
324             # $factor = _find_factor($ds1, $ds2);
325             sub _find_factor {
326 37     37   66 my ($this, $that) = @_;
327 37         78 my $order = $this->order;
328 37 100       73 croak 'sets of same size expected' if $order != $that->order;
329 35   100     145 my $log_this = $this->[_F_GENERATION] == $generation && $this->[_F_LOG];
330 35   100     101 my $log_that = $this->[_F_GENERATION] == $generation && $that->[_F_LOG];
331 35         56 $this->[_F_GENERATION] = $that->[_F_GENERATION] = $generation;
332 35 100       120 if (!$log_this) {
    100          
333 3         10 my $r1 = $this->zeta_canonize;
334 3         7 my $r2 = $that->zeta_canonize;
335 3 100       24 if (!$log_that) {
336 2         6 my $r3 = Math::DifferenceSet::Planar->new($order)->zeta_canonize;
337 2         9 $log_that = $that->[_F_LOG] = _log($r2, $r3);
338             }
339 3 100       12 $log_this = $this->[_F_LOG] =
340             $this == $that? $log_that: _log($r1, $r2);
341             }
342             elsif (!$log_that) {
343 23         56 my $r1 = $this->zeta_canonize;
344 23         43 my $r2 = $that->zeta_canonize;
345 22         53 $log_that = $that->[_F_LOG] = _log($r2, $r1);
346             }
347 33         67 return divmod($log_that, $log_this, $this->modulus);
348             }
349              
350             # translation amount between a multiple of a set and another set
351             sub _delta_f {
352 30     30   48 my ($this, $factor, $that) = @_;
353 30         45 my $modulus = $this->modulus;
354 30         69 my ($x) = $this->find_delta( invmod($factor, $modulus) );
355 30         45 my $s = $that->[_F_ELEMENTS]->[0];
356 30         80 return addmod($s, -mulmod($x, $factor, $modulus), $modulus);
357             }
358              
359             # ----- class methods -----
360              
361             sub list_databases {
362 1     1 1 1026 return Math::DifferenceSet::Planar::Data->list_databases;
363             }
364              
365             sub set_database {
366 4     4 1 3482 my $class = shift;
367 4         7 ++$generation;
368 4         23 $current_data = Math::DifferenceSet::Planar::Data->new(@_);
369 1         862 return $class->available_count;
370             }
371              
372             # print "ok" if Math::DifferenceSet::Planar->available(9);
373             # print "ok" if Math::DifferenceSet::Planar->available(3, 2);
374             sub available {
375 12     12 1 5604 my ($class, $base, $exponent) = @_;
376 12 100       52 my $order = defined($exponent)? _pow($base, $exponent): $base;
377 12 100 100     800 return undef if !$order || $order > $class->_data->max_order;
378 5         11689 my $pds = $class->_data->get($order, 'base');
379 5   66     10048 return !!$pds && (!defined($exponent) || $base == $pds->base);
380             }
381              
382             # print "ok" if Math::DifferenceSet::Planar->known_space(9);
383             sub known_space {
384 4     4 1 3251 my ($class, $order) = @_;
385 4 100 100     24 return 0 if $order <= 0 || $order > $class->_data->sp_max_order;
386 2         5088 my $spc = $class->_data->get_space($order);
387 2 100       4442 return 0 if !$spc;
388 1         41 my ($rad) = $spc->rotator_space;
389 1         2 return 0 + @{$rad};
  1         9  
390             }
391              
392             # $desc = Math::DifferenceSet::Planar->known_space_desc(9);
393             sub known_space_desc {
394 4     4 1 3860 my ($class, $order) = @_;
395 4 100 100     19 return undef if $order <= 0 || $order > $class->_data->sp_max_order;
396 2         4243 my $spc = $class->_data->get_space($order);
397 2 100       3488 return undef if !$spc;
398 1         25 return _space_description($spc);
399             }
400              
401             # $ds = Math::DifferenceSet::Planar->new(9);
402             # $ds = Math::DifferenceSet::Planar->new(3, 2);
403             sub new {
404 39     39 1 12542 my ($class, $base, $exponent) = @_;
405 39 100       133 my $order = defined($exponent)? _pow($base, $exponent): $base;
406 39   100     130 my $pds = $order && $class->_data->get($order);
407 39 100 100     73119 if (!$pds || defined($exponent) && $base != $pds->base) {
      100        
408 4 100       110 my $key = defined($exponent)? "$base, $exponent": $order;
409 4         346 croak "PDS($key) not available";
410             }
411 35         1611 return bless [
412             $pds->order,
413             $pds->base,
414             $pds->exponent,
415             $pds->modulus,
416             $pds->n_planes,
417             $pds->elements,
418             [], # rotators
419             0, # index_min
420             $generation,
421             1, # log
422             ], $class;
423             }
424              
425             # $ds = Math::DifferenceSet::Planar->from_elements_fast(
426             # 0, 1, 3, 9, 27, 49, 56, 61, 77, 81
427             # );
428             sub from_elements_fast {
429 32     32 1 744 my $class = shift;
430 32         51 my $order = $#_;
431 32         69 my ($base, $exponent);
432 32 100       308 $exponent = is_prime_power($order, \$base)
433             or croak "this implementation cannot handle order $order";
434 30         72 my $modulus = ($order + 1) * $order + 1;
435 30 100       56 if (grep { $_ < 0 || $modulus <= $_ } @_) {
  168 100       466  
436 2         4 my $max = $modulus - 1;
437 2         200 croak "element values inside range 0..$max expected";
438             }
439 28         76 my ($elements, $index_min) = _sort_elements($modulus, @_);
440 26         45 my $n_planes;
441 26 100       63 if (!exists $memo_n_planes{$order}) {
442 10         79 $n_planes = $memo_n_planes{$order} =
443             euler_phi($modulus) / (3 * $exponent);
444 10 100       36 %memo_n_planes = ($order => $n_planes)
445             if $_MAX_MEMO_COUNT < keys %memo_n_planes;
446             }
447             else {
448 16         83 $n_planes = $memo_n_planes{$order};
449             }
450 26         107 return bless [
451             $order,
452             $base,
453             $exponent,
454             $modulus,
455             $n_planes,
456             $elements,
457             [], # rotators
458             $index_min,
459             $generation,
460             ], $class;
461             }
462              
463             # $ds = Math::DifferenceSet::Planar->from_elements(
464             # 0, 1, 3, 9, 27, 49, 56, 61, 77, 81
465             # );
466             sub from_elements {
467 29     29 1 11788 my ($class, @elements) = @_;
468 29         79 my $this = $class->from_elements_fast(@elements);
469 23         63 my $ref = $class->new(@elements - 1);
470 23 100       342 eval { _find_factor($ref, $this) } or
  23         56  
471             croak "apparently not a planar difference set: ", _fmt_set($this);
472 21         88 return $this;
473             }
474              
475             # $bool = Math::DifferenceSet::Planar->verify_elements(
476             # 0, 1, 3, 9, 27, 49, 56, 61, 77, 81
477             # );
478             sub verify_elements {
479 16     16 1 7120 my ($class, @elements) = @_;
480 16         28 my $order = $#elements;
481 16 100       42 return undef if $order <= 1;
482 15         29 my $modulus = ($order + 1) * $order + 1;
483 15         29 my $median = ($modulus - 1) / 2;
484 15         31 my $seen = '0' x $median;
485 15         25 foreach my $r1 (@elements) {
486 66 100 100     229 return undef if $r1 < 0 || $modulus <= $r1 || $r1 != int $r1;
      100        
487 60         86 foreach my $r2 (@elements) {
488 184 100       273 last if $r1 == $r2;
489 128 100       198 my $d = $r1 < $r2? $r2 - $r1: $modulus + $r2 - $r1;
490 128 100       213 $d = $modulus - $d if $d > $median;
491 128 100       333 return !1 if substr($seen, $d-1, 1)++;
492             }
493             }
494 5         23 return $median == $seen =~ tr/1//;
495             }
496              
497             # $bool = Math::DifferenceSet::Planar->check_elements(
498             # [0, 1, 3, 9, 27, 49, 56, 61, 77, 81], 999
499             # );
500             sub check_elements {
501 14     14 1 6796 my ($class, $elem_listref, $depth, $factor) = @_;
502 14         21 my $order = $#{$elem_listref};
  14         20  
503 14 100       36 return undef if $order <= 1;
504 13         41 my $modulus = ($order + 1) * $order + 1;
505 13         27 my $median = ($modulus - 1) / 2;
506 13 100       32 $depth = $median <= $_DEFAULT_DEPTH? $median: $_DEFAULT_DEPTH
    100          
507             if !$depth;
508 13 100       26 my $limit = $median <= $depth? $median: $depth;
509 13         31 my $seen = '1' . ('0' x $limit);
510 13         18 foreach my $e (@{$elem_listref}) {
  13         25  
511 92 100 100     286 return undef if $e < 0 || $modulus <= $e || $e != int $e;
      100        
512             }
513 10         16 my @elements = sort { $a <=> $b } @{$elem_listref};
  128         156  
  10         28  
514             I1:
515 10         20 foreach my $i1 (0 .. $order) {
516 75         90 my $r1 = $elements[$i1];
517 75         94 my $i2 = $i1 - 1;
518 75         111 while ($i2 >= 0) {
519 129         137 my $r2 = $elements[$i2];
520 129         146 my $d = $r1 - $r2;
521 129 100       175 next I1 if $d > $limit;
522 93 100       186 return !1 if substr($seen, $d, 1)++;
523 92         164 --$i2;
524             }
525 38         51 $i2 = $order;
526 38         53 while ($i2 > $i1) {
527 68         79 my $r2 = $elements[$i2];
528 68         78 my $d = $modulus + $r1 - $r2;
529 68 100       116 next I1 if $d > $limit;
530 30 50       80 return !1 if substr($seen, $d, 1)++;
531 30         53 --$i2;
532             }
533             }
534 9 100       34 return !1 if 0 <= index $seen, '0';
535 7 100       16 return 2 if $median <= $depth;
536 5 100       12 if (!defined $factor) {
537 4 100       19 $factor = $order if !is_power($order, 0, \$factor);
538             }
539 5 100       10 if (1 < $factor) {
540 4         6 my $mx = $order;
541 4         9 for (my $i = 0; $i < $order; ++$i) {
542 11 100       24 $mx = $i, last if 1 == $elements[$i+1] - $elements[$i];
543             }
544 4 100       9 push @elements, splice @elements, 0, $mx if $mx;
545 4         7 my ($multiple) = eval { _sort_elements(
546             $modulus,
547 4         6 map { mulmod($_, $factor, $modulus) } @elements
  33         58  
548             )};
549 4 100       45 return 0 if !defined $multiple;
550 3         4 my $d1 = $elements[0] - $multiple->[0];
551 3 50       7 my $d2 = $d1 >= 0? $d1 - $modulus: $d1 + $modulus;
552 3 50       7 ($d1, $d2) = ($d2, $d1) if abs($d2) > abs($d1); # optimization
553 3         8 for (my $i = 1; $i <= $order; ++$i) {
554 18         23 my $d = $elements[$i] - $multiple->[$i];
555 18 100 66     52 return 0 if $d != $d1 && $d != $d2;
556             }
557             }
558 3         10 return 1;
559             }
560              
561             # $it1 = Math::DifferenceSet::Planar->iterate_available_sets;
562             # $it2 = Math::DifferenceSet::Planar->iterate_available_sets(10, 20);
563             # while (my $ds = $it2->()) {
564             # ...
565             # }
566             sub iterate_available_sets {
567 5     5 1 6027 my ($class, @minmax) = @_;
568 5         14 my $dit = $class->_data->iterate(@minmax);
569             return sub {
570 28     28   530 my $pds = $dit->();
571 28 100       13376 return undef if !$pds;
572 25         523 return bless [
573             $pds->order,
574             $pds->base,
575             $pds->exponent,
576             $pds->modulus,
577             $pds->n_planes,
578             $pds->elements,
579             [], # rotators
580             0, # index_min
581             $generation,
582             1, # log
583             ], $class;
584 5         37 };
585             }
586              
587             # $min = Math::DifferenceSet::Planar->available_min_order;
588 1     1 1 3995 sub available_min_order { $_[0]->_data->min_order }
589              
590             # $max = Math::DifferenceSet::Planar->available_max_order;
591 1     1 1 2947 sub available_max_order { $_[0]->_data->max_order }
592              
593             # $count = Math::DifferenceSet::Planar->available_count;
594 2     2 1 869 sub available_count { $_[0]->_data->count }
595              
596             # $min = Math::DifferenceSet::Planar->known_space_min_order;
597 1     1 1 3454 sub known_space_min_order { $_[0]->_data->sp_min_order }
598              
599             # $max = Math::DifferenceSet::Planar->known_space_max_order;
600 1     1 1 2870 sub known_space_max_order { $_[0]->_data->sp_max_order }
601              
602             # $count = Math::DifferenceSet::Planar->known_space_count;
603 1     1 1 2910 sub known_space_count { $_[0]->_data->sp_count }
604              
605             # $it3 = Math::DifferenceSet::Planar->iterate_known_spaces;
606             # $it3 = Math::DifferenceSet::Planar->iterate_known_spaces(10,20);
607             # while (my $spc = $it3->()) {
608             # print "$spc\n";
609             # }
610             sub iterate_known_spaces {
611 4     4 1 5098 my ($class, @minmax) = @_;
612 4         11 my $dit = $class->_data->iterate_spaces(@minmax);
613             return sub {
614 23     23   971 my $spc = $dit->();
615 23 100       10834 return undef if !$spc;
616 20         39 return _space_description($spc);
617 4         29 };
618             }
619              
620             # ----- object methods -----
621              
622             # $o = $ds->order;
623             # $p = $ds->order_base;
624             # $n = $ds->order_exponent;
625             # $m = $ds->modulus;
626             # $np = $ds->n_planes;
627             # @e = $ds->elements;
628             # $e0 = $ds->element(0);
629 373     373 1 1818 sub order { $_[0]->[_F_ORDER ] }
630 1     1 1 5 sub order_base { $_[0]->[_F_BASE ] }
631 1     1 1 5 sub order_exponent { $_[0]->[_F_EXPONENT] }
632 236     236 1 599 sub modulus { $_[0]->[_F_MODULUS ] }
633 3     3 1 523 sub n_planes { $_[0]->[_F_N_PLANES] }
634 40     40 1 11151 sub elements { @{ $_[0]->[_F_ELEMENTS] } }
  40         149  
635 5     5 1 25 sub element { $_[0]->[_F_ELEMENTS]->[$_[1]] }
636 1     1 1 447 sub start_element { $_[0]->[_F_ELEMENTS]->[ 0 ] }
637              
638             # @e = $ds->elements_sorted;
639             sub elements_sorted {
640 3     3 1 1318 my ($this) = @_;
641 3         6 my $elements = $this->[_F_ELEMENTS];
642 3 100       11 return @$elements if !wantarray;
643 2         5 my $index_min = $this->[_F_INDEX_MIN];
644 2         7 return @{$elements}[$index_min .. $#$elements, 0 .. $index_min - 1];
  2         10  
645             }
646              
647             # $ds1 = $ds->translate(1);
648             sub translate {
649 87     87 1 1521 my ($this, $delta) = @_;
650 87         128 my $modulus = $this->[_F_MODULUS];
651 87 100 100     273 $delta %= $modulus unless -$modulus < $delta && $delta < $modulus;
652 87 100       176 return $this if !$delta;
653             my @elements =
654 79         101 map { addmod($_, $delta, $modulus) } @{$this->[_F_ELEMENTS]};
  584         933  
  79         144  
655 79         110 my $that = bless [@{$this}], ref $this;
  79         200  
656 79         124 $that->[_F_ELEMENTS] = \@elements;
657 79 100       188 $that->[_F_INDEX_MIN] =
658             $elements[0] < $elements[-1]? 0: _index_min(\@elements);
659 79 100       165 if (defined (my $z = $that->[_F_ZETA])) {
660 62         164 $that->[_F_ZETA] = addmod($z,
661             mulmod($delta, $this->[_F_ORDER]-1, $modulus), $modulus);
662             }
663 79 100       148 if (defined (my $e = $that->[_F_ETA])) {
664 6         16 $that->[_F_ETA] = addmod($e,
665             mulmod($delta, $this->[_F_BASE]-1, $modulus), $modulus);
666             }
667 79         170 return $that;
668             }
669              
670             # $ds2 = $ds->canonize;
671 15     15 1 899 sub canonize { $_[0]->translate(- $_[0]->[_F_ELEMENTS]->[0]) }
672              
673             # $ds2 = $ds->gap_canonize;
674             sub gap_canonize {
675 1     1 1 487 my ($this) = @_;
676 1         5 my $delta = ($this->largest_gap)[1];
677 1         4 return $this->translate(-$delta);
678             }
679              
680             # $ds2 = $ds->zeta_canonize;
681             sub zeta_canonize {
682 61     61 1 1492 my ($this) = @_;
683 61         126 my $zeta = $this->zeta;
684 60         99 my $order = $this->order;
685 60         94 my $modulus = $this->modulus;
686 60 100       118 if ( ($order - 1) % 3 ) {
687 35 100       75 return $this if !$zeta;
688 21         51 my $delta = divmod($zeta, $order - 1, $modulus);
689 21         52 return $this->translate(-$delta);
690             }
691 25 100 100     62 return $this if !$zeta && !$this->contains(0);
692 22         41 $modulus /= 3;
693 22         158 my $delta = divmod($zeta, $order - 1, $modulus);
694 22         55 $delta += $modulus while $this->contains($delta); # 0..2 iterations
695 22         56 return $this->translate(-$delta);
696             }
697              
698             # $it = $ds->iterate_rotators;
699             # while (my $m = $it->()) {
700             # ...
701             # }
702             sub iterate_rotators {
703 16     16 1 928 my ($this) = @_;
704 16         35 my $rotators = $this->_rotators;
705 16 100       174 return $this->_sequential_rotators if !$rotators;
706 14 100       53 return $this->_structured_rotators if 'ARRAY' eq ref $rotators->[0];
707 2         3 my $mx = 0;
708 2 100   14   9 return sub { $mx < @{$rotators}? $rotators->[$mx++]: 0 };
  14         909  
  14         25  
709             }
710              
711             # $it = $ds->iterate_planes;
712             # while (my $ds = $it->()) {
713             # ...
714             # }
715             sub iterate_planes {
716 1     1 1 438 my ($this) = @_;
717 1         4 my $r_it = $this->iterate_rotators;
718             return sub {
719 13     13   500 my $r = $r_it->();
720 13 100       30 return $r? $this->multiply($r)->canonize: undef;
721 1         5 };
722             }
723              
724             # @pm = $ds->multipliers;
725             sub multipliers {
726 5     5 1 896 my ($this) = @_;
727             my ( $base, $exponent, $modulus) =
728 5         10 @{$this}[_F_BASE, _F_EXPONENT, _F_MODULUS];
  5         15  
729 5 100       16 return 3 * $exponent if !wantarray;
730 4         15 return _multipliers($base, $exponent, $modulus);
731             }
732              
733             # $ds3 = $ds->multiply($m);
734             sub multiply {
735 40     40 1 8155 my ($this, $factor) = @_;
736 40         59 my $modulus = $this->[_F_MODULUS];
737 40         57 $factor %= $modulus;
738 40 100       90 return $this if 1 == $factor;
739 34 100       258 croak "$_[1]: factor is not coprime to modulus"
740             if gcd($modulus, $factor) != 1;
741             my ($elements, $index_min) = _sort_elements(
742             $modulus,
743 33         50 map { mulmod($_, $factor, $modulus) } @{$this->[_F_ELEMENTS]}
  301         460  
  33         58  
744             );
745 33         52 my $that = bless [@{$this}], ref $this;
  33         88  
746 33         51 $that->[_F_ELEMENTS ] = $elements;
747 33         57 $that->[_F_INDEX_MIN] = $index_min;
748 33 100       64 if (defined(my $log = $that->[_F_LOG])) {
749 32         67 $that->[_F_LOG] = mulmod($log, $factor, $modulus);
750             }
751 33   66     87 $that->[_F_ZETA] &&= mulmod($that->[_F_ZETA], $factor, $modulus);
752 33   66     71 $that->[_F_ETA] &&= mulmod($that->[_F_ETA], $factor, $modulus);
753 33         77 return $that;
754             }
755              
756             # ($e1, $e2) = $ds->find_delta($delta);
757             sub find_delta {
758 99     99 1 1997 my ($this, $delta) = @_;
759 99         153 my $order = $this->order;
760 99         166 my $modulus = $this->modulus;
761 99         140 my $elements = $this->[_F_ELEMENTS];
762 99         134 my $de = $delta % $modulus;
763 99         150 my $up = $de + $de < $modulus;
764 99 100       155 $de = $modulus - $de if !$up;
765 99         161 my ($lx, $ux, $c) = (0, 0, 0);
766 99         140 my ($le, $ue) = @{$elements}[0, 0];
  99         158  
767 99         136 my $bogus = 0;
768 99         189 while ($c != $de) {
769 919 100       1174 if ($c < $de) {
770 555 100       820 if(++$ux > $order) {
771 53         69 $ux = 0;
772             }
773 555         628 $ue = $elements->[$ux];
774 555 100       783 $bogus = 1, last if $ux == $lx;
775             }
776             else {
777 364 100       530 $bogus = 1, last if ++$lx > $order;
778 363         422 $le = $elements->[$lx];
779             }
780 917 100       1589 $c = $ue < $le? $modulus + $ue - $le: $ue - $le;
781             }
782 99 100       437 croak "bogus set: delta not found: $delta (mod $modulus)" if $bogus;
783 97 100       231 return $up? ($le, $ue): ($ue, $le);
784             }
785              
786             # ($e1, $e2) = $ds->peak_elements
787             sub peak_elements {
788 2     2 1 801 my ($this) = @_;
789 2         5 my $peak = $this->[_F_PEAK];
790 2 100       6 if (!defined $peak) {
791 1         4 $peak = [$this->find_delta($this->modulus >> 1)];
792 1         3 $this->[_F_PEAK] = $peak;
793             }
794 2         4 return @{$peak};
  2         6  
795             }
796              
797             # ($e1, $e2, $delta) = $ds->largest_gap;
798             sub largest_gap {
799 2     2 1 511 my ($this) = @_;
800 2         7 my $modulus = $this->modulus;
801 2         3 my $p_max;
802             my $e_max;
803 2         4 my $d_max = 0;
804 2         6 my $e_pre = $this->element($this->order);
805 2         5 foreach my $e ($this->elements) {
806 20         22 my $d = $e - $e_pre;
807 20 100       31 $d += $modulus if $d < 0;
808 20 100       30 if ($d > $d_max) {
809 6         10 $d_max = $d;
810 6         7 $p_max = $e_pre;
811 6         8 $e_max = $e;
812             }
813 20         27 $e_pre = $e;
814             }
815 2         8 return ($p_max, $e_max, $d_max);
816             }
817              
818             # $e = $ds->zeta
819             sub zeta {
820 65     65 1 600 my ($this) = @_;
821 65         89 my $zeta = $this->[_F_ZETA];
822 65 100       130 if (!defined $zeta) {
823 56         83 my $order = $this->[_F_ORDER];
824 56         69 my $modulus = $this->[_F_MODULUS];
825 56         78 my $start = $this->[_F_ELEMENTS]->[0];
826 56         154 (undef, my $x) = $this->find_delta($order + 1);
827 55         276 $zeta = $this->[_F_ZETA] =
828             addmod(mulmod($x, $order, $modulus), -$start, $modulus);
829             }
830 64         114 return $zeta;
831             }
832              
833             # $e = $ds->eta
834             sub eta {
835 16     16 1 1514 my ($this) = @_;
836 16 100       38 return $this->zeta if $this->[_F_EXPONENT] == 1;
837 15         19 my $eta = $this->[_F_ETA];
838 15 100       29 if (!defined $eta) {
839 8         10 my $p = $this->[_F_BASE];
840 8         10 my $m = $this->[_F_MODULUS];
841 8         11 my $s = $this->[_F_ELEMENTS]->[0];
842 8         27 my ($x) = $this->find_delta( invmod($p, $m) );
843 8         28 $eta = $this->[_F_ETA] = addmod(mulmod($x, $p, $m), -$s, $m);
844             }
845 15         49 return $eta;
846             }
847              
848             # $bool = $ds->contains($e)
849             sub contains {
850 251     251 1 1439 my ($this, $elem) = @_;
851 251         287 my $elements = $this->[_F_ELEMENTS];
852 251         279 my $lx = $this->[_F_INDEX_MIN];
853 251         269 my $hx = $#{$elements};
  251         306  
854 251 100 100     533 ($lx, $hx) = (0, $lx - 1) if $lx && $elements->[0] <= $elem;
855 251         365 while ($lx <= $hx) {
856 764         878 my $x = ($lx + $hx) >> 1;
857 764         865 my $e = $elements->[$x];
858 764 100       996 if ($e <= $elem) {
859 487 100       748 return !0 if $e == $elem;
860 427         648 $lx = $x + 1;
861             }
862             else {
863 277         427 $hx = $x - 1;
864             }
865             }
866 191         359 return !1;
867             }
868              
869             # $cmp = $ds1->compare($ds2);
870             sub compare {
871 23     23 1 8638 my ($this, $that) = @_;
872 23         46 my $order = $this->order;
873 23         44 my $cmp = $order <=> $that->order;
874 23 100       55 return $cmp if $cmp;
875 17         26 my $lx = $this->[_F_INDEX_MIN];
876 17         23 my $rx = $that->[_F_INDEX_MIN];
877 17         20 my $le = $this->[_F_ELEMENTS];
878 17         27 my $re = $that->[_F_ELEMENTS];
879 17         36 foreach my $i (0 .. $order) {
880 57         72 $cmp = $le->[$lx] <=> $re->[$rx];
881 57 100       89 return $cmp if $cmp;
882 51 100       77 ++$lx <= $order or $lx = 0;
883 51 100       86 ++$rx <= $order or $rx = 0;
884             }
885 11         35 return 0;
886             }
887              
888             # $bool = $ds1->same_plane($ds2);
889             sub same_plane {
890 17     17 1 9066 my ($this, $that) = @_;
891 17         36 my $order = $this->order;
892 17 100       33 return !1 if $order != $that->order;
893 11         21 my $le = $this->[_F_ELEMENTS];
894 11         16 my $re = $that->[_F_ELEMENTS];
895 11         16 my $delta0 = $re->[0] - $le->[0];
896 11 100       27 if (!$delta0) {
897 6         13 foreach my $x (1 .. $order) {
898 13 100       28 return !1 if $re->[$x] != $le->[$x];
899             }
900 4         10 return !0;
901             }
902 5         12 my $modulus = $this->modulus;
903 5 100       17 my $delta1 = $delta0 < 0? $delta0 + $modulus: $delta0 - $modulus;
904 5         15 foreach my $x (1 .. $order) {
905 16         23 my $delta = $re->[$x] - $le->[$x];
906 16 100 100     49 return !1 if $delta != $delta0 && $delta != $delta1;
907             }
908 3         12 return !0;
909             }
910              
911             # @e = $ds1->common_elements($ds2);
912             sub common_elements {
913 16     16 1 8596 my ($this, $that) = @_;
914 16         32 my $order = $this->order;
915 16         26 my @common = ();
916 16 100       26 return @common if $order != $that->order;
917 10         17 my $li = 0;
918 10         13 my $ri = 0;
919 10         13 my $lx = $this->[_F_INDEX_MIN];
920 10         13 my $rx = $that->[_F_INDEX_MIN];
921 10         13 my $le = $this->[_F_ELEMENTS];
922 10         12 my $re = $that->[_F_ELEMENTS];
923 10         13 my $lv = $le->[$lx];
924 10         15 my $rv = $re->[$rx];
925 10         13 while (1) {
926 37         45 my $cmp = $lv <=> $rv;
927 37 100       60 push @common, $lv if !$cmp;
928 37 100       55 if ($cmp <= 0) {
929 28 100       43 ++$lx <= $order or $lx = 0;
930 28 100       48 last if ++$li > $order;
931 21         26 $lv = $le->[$lx];
932             }
933 30 100       46 if ($cmp >= 0) {
934 23 100       33 ++$rx <= $order or $rx = 0;
935 23 100       39 last if ++$ri > $order;
936 20         22 $rv = $re->[$rx];
937             }
938             }
939 10         23 return @common;
940             }
941              
942             # ($factor, $delta) = $ds1->find_linear_map($ds2);
943             sub find_linear_map {
944 10     10 1 1624 my ($this, $that) = @_;
945 10         23 my $factor = _find_factor($this, $that);
946 9         20 my $delta = _delta_f($this, $factor, $that);
947 9         26 return ($factor, $delta);
948             }
949              
950             # @factor_delta_pairs = $ds1->find_all_linear_maps($ds2);
951             sub find_all_linear_maps {
952 4     4 1 45 my ($this, $that) = @_;
953 4         9 my $f1 = eval { _find_factor($this, $that) };
  4         10  
954 4 100       58 return () if !defined $f1;
955 3         7 my $modulus = $this->modulus;
956             return
957 39         64 sort { $a->[0] <=> $b->[0] }
958             map {
959 3         12 my $f = mulmod($f1, $_, $modulus);
  21         31  
960 21         50 my $d = _delta_f($this, $f, $that);
961 21         52 [$f, $d]
962             } $this->multipliers;
963             }
964              
965             1;
966             __END__