Generating sets that pass is straightforward: here's code that generates full sets for a given prime, and you can mask out a subset of the values with undef. All such sets should return true when queried with the same prime:
#!/usr/bin/perl
use strict;
use warnings;
my($prime, $range, $count) = @ARGV;
for (1 .. $count) {
# report the full range for a random start point
my $start = int rand(2 ** 32 - $range);
print join(' ', map val($start + $_), 0 .. $range - 1), "\n";
}
exit 0;
# return the $p-adic order of $n
sub val {
my($n) = @_;
my $val = 0;
++$val, $n /= $prime while 0 == $n % $prime;
return $val;
}
It's less obvious how to generate a useful collection of sets that should not pass. Best I can suggest is to take one of the passing sets, randomly increment or decrement an element (that has not been masked out), and see if the valid_set() function in my original post rejects it. | [reply]
[d/l] |
You should also know which primes to expect. Probably all less 32?
In general, any prime p less than the size of the set, ie p should be small enough that it's possible to have 2 entries divisible by p. As you surmise, for the specific case that implies p < 32.
.. provided valid_set() works flawlessly. ;-)
I recommend taking that as given, until you actually find reason to believe it is flawed.
(and later) here my take on it
Thanks, I'll make time today or tomorrow to go through it and try to actually understand your algorithm.
| [reply] |
here my take on it:
The basic idea is that the maximal known value in a sequence rules it's neighborhood.
I probably over optimized it: I thought that comparing two arrays should be fastest and I'm caching those static sieves for comparison.
Of course it's also possible to work without a sieve-table and calculate on the entries on the fly. (So maybe premature optimization on my part)
This must be benchmarked and depends a lot on processor's caching of perl data structures.
Please test and tell me if you find a bug.
FWIW: I left a lot of debug code inside which is optimized away based on the constant DBG
# https://perlmonks.org/?node_id=11142871
use v5.12;
use warnings;
use Data::Dump qw/pp dd/;
my $range = 32;
my %sieves;
use constant DBG => 0;
sub get_sieve {
my ( $prime, $range ) = @_;
my @sieve = 0; # p^0 = 1
my @pos = (0);
while ( @sieve < 2*$range ) {
@sieve = (@sieve) x $prime ;
$sieve[-1]++;
push @pos, @sieve-1;
}
pop @pos; # forget edge
return {
prime => $prime,
sieve => [ @sieve[0 .. 2*$range-1] ],
sieve_pos => \@pos,
sieve_max => @pos-1,
};
}
sub valid_set_lanx {
warn "call:",pp \@_ if DBG;
my($p, $a_known) = @_;
my $h_sieve_cache =
$sieves{$p} //= get_sieve($p,$range);
my ($a_sieve, $a_sieve_pos, $sieve_max) = @{$h_sieve_cache}{qw/sie
+ve sieve_pos sieve_max/};
warn pp $h_sieve_cache if DBG;
# --- find max_known
my @known = @$a_known;
my $max_known = 0;
my $max_pos = 0;
my $idx = 0;
for my $e (@known) {
next unless defined $e;
if ($e > $max_known) {
$max_known = $e;
$max_pos = $idx;
}
} continue {
$idx++;
}
# --- adjust into sieve range
if ($max_known > $sieve_max) {
$max_known = $sieve_max;
$known[$max_pos] = $max_known;
}
my $idx_sieve = $a_sieve_pos->[$max_known]- $max_pos;
if ( DBG ) {
#warn pp [\@known,$a_sieve,$max_known,$a_sieve_pos->[$max_know
+n],$idx_sieve,$max_pos];
warn (". "x $idx_sieve, join " ", map { $_ // "?" } @known);
warn "@$a_sieve";
}
my $ok = 1;
for my $e (@known) {
#warn (($a_sieve->[$idx_sieve] //"?"), " - ", ($e//"?")) if DB
+G;
next unless defined $e;
$ok=0 if $e != $a_sieve->[$idx_sieve]
} continue {
$idx_sieve++
}
return $ok;
}
# test the examples: expect [yes, yes, no, no]
print valid_set_lanx(@$_) ? "yes\n" : "no\n"
for (
[ 2, [0, 1, 0, 2, 0]],
[ 2, [1, 0, 5, 0, 1]],
[ 2, [2, undef, undef, undef, 2]],
[ 3, [1, 0, 0, 1, 0, 0, 1]],
[ 2, [1, 0, 8, 0, 1]],
);
OUTPUT: yes
yes
no
no
yes
update
holes are tricky, still need to cover this buggy edge case, which is legit but won't pass now.
[ 3, [0, undef, 0, 0, 1]]
| [reply]
[d/l]
[select] |
> holes are tricky, still need to cover this buggy edge case, which is legit but won't pass now.
edge-case covered too :)
# https://perlmonks.org/?node_id=11142871
use v5.12;
use warnings;
use Data::Dump qw/pp dd/;
use constant DBG => 0;
my $range = 32;
$range = 8 if DBG;
my %sieves;
sub get_sieve {
my ( $prime, $range ) = @_;
my @sieve = 0; # p^0 = 1
my @pos = (0);
while ( @sieve < 2*$range ) {
@sieve = (@sieve) x $prime ;
$sieve[-1]++;
push @pos, @sieve-1;
}
pop @pos; # forget edge
return {
prime => $prime,
sieve => [ @sieve[0 .. 2*$range-1] ],
sieve_pos => \@pos,
sieve_max => @pos-1,
};
}
sub valid_set_lanx {
warn "call:",pp \@_ if DBG;
my($p, $a_known) = @_;
die "sequence bigger than range=$range" if
@$a_known > $range;
my $h_sieve_cache =
$sieves{$p} //= get_sieve($p,$range);
my ($a_sieve, $a_sieve_pos, $sieve_max) = @{$h_sieve_cache}{qw/sie
+ve sieve_pos sieve_max/};
warn "SIEVE CACHE:", pp $h_sieve_cache if DBG;
# --- find first max in known
my @known = @$a_known;
my $max_known = 0;
my $max_pos = 0;
my $idx = 0;
for my $e (@known) {
next unless defined $e;
if ($e > $max_known) {
$max_known = $e;
$max_pos = $idx;
}
} continue {
$idx++;
}
# --- reduce max into sieve range
if ($max_known > $sieve_max) {
$max_known = $sieve_max;
$known[$max_pos] = $max_known;
}
my $idx_sieve = $a_sieve_pos->[$max_known]- $max_pos;
# --- shift right if undefined holes cause problems
my $shift = 1;
$idx_sieve += 1+ $a_sieve_pos->[$max_known + ($shift++)]
while $idx_sieve < 0;
if ( DBG ) {
#warn pp [\@known,$a_sieve,$max_known,$a_sieve_pos->[$max_know
+n],$idx_sieve,$max_pos];
warn (". "x $idx_sieve, join " ", map { $_ // "?" } @known);
warn "@$a_sieve";
}
my $ok = 1;
for my $e (@known) {
#warn (($a_sieve->[$idx_sieve] //"?"), " - ", ($e//"?")) if DB
+G;
next unless defined $e;
return $ok = 0
if $e != $a_sieve->[$idx_sieve]
} continue {
$idx_sieve++
}
return $ok;
}
# test the examples: expect [yes, yes, no, no]
say pp($_)," => \t", valid_set_lanx(@$_) ? "yes" : "no"
for (
[ 2, [0, 1, 0, 2, 0]],
[ 2, [1, 0, 5, 0, 1]],
[ 2, [2, undef, undef, undef, 2]],
[ 3, [1, 0, 0, 1, 0, 0, 1]],
[ 2, [1, 0, 8, 0, 1]],
[ 3, [undef, 0, 0, undef, 0, 0, 1]],
);
OUTPUT: [2, [0, 1, 0, 2, 0]] => yes
[2, [1, 0, 5, 0, 1]] => yes
[2, [2, undef, undef, undef, 2]] => no
[3, [1, 0, 0, 1, 0, 0, 1]] => no
[2, [1, 0, 8, 0, 1]] => yes
[3, [undef, 0, 0, undef, 0, 0, 1]] => yes
| [reply]
[d/l]
[select] |