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__ |