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] |
> Thanks, I'll make time today or tomorrow to go through it and try to actually understand your algorithm.
I'd start with automated testing, I'm not 100% sure it holds for all cases with "holes".
update
in hindsight ... it's still producing false negatives:
That's what the algo does with [3, [1, 0, 0, undef, 0, 0, 1]
. . 1 0 0 ? 0 0 1
0 0 1 0 0 1 0 0 2 0 0 1 0 0 1 0
^ *
That's how it should fit
. . . . . 1 0 0 ? 0 0 1
0 0 1 0 0 1 0 0 2 0 0 1 0 0 1 0
^
Sorry!
| [reply]
[d/l]
[select] |
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] |