-
Notifications
You must be signed in to change notification settings - Fork 7
Expand file tree
/
Copy path079 Passcode derivation.pl
More file actions
68 lines (49 loc) · 1.85 KB
/
079 Passcode derivation.pl
File metadata and controls
68 lines (49 loc) · 1.85 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
#!/usr/bin/perl
# Author: Trizen
# Date: 24 March 2022
# https://github.com/trizen
# Passcode derivation
# https://projecteuler.net/problem=79
# General recursive solution.
# Runtime: 0.158s
use 5.020;
use warnings;
use List::Util qw(min);
use experimental qw(signatures);
sub find_candidates ($callback, $a, $b, $re_a = join('.*?', @$a), $re_b = join('.*?', @$b), $a_i = 0, $b_i = 0, $solution = [])
{
if (join('', @$solution) =~ $re_a and join('', @$solution) =~ $re_b) {
$callback->($solution);
return $solution;
}
if (($a_i <= $#$a) && ($b_i <= $#$b) && ($a->[$a_i] == $b->[$b_i])) {
__SUB__->($callback, $a, $b, $re_a, $re_b, $a_i + 1, $b_i + 1, [@$solution, $a->[$a_i]]);
}
__SUB__->($callback, $a, $b, $re_a, $re_b, $a_i + 1, $b_i, [@$solution, $a->[$a_i]]) if ($a_i <= $#$a);
__SUB__->($callback, $a, $b, $re_a, $re_b, $a_i, $b_i + 1, [@$solution, $b->[$b_i]]) if ($b_i <= $#$b);
}
my @passcodes = sort { $a <=> $b } qw(
319 680 180 690 129 620 762 689 318 368 710 720 629 168 160 716
731 736 729 316 769 290 719 389 162 289 718 790 890 362 760 380 728
);
my @candidates = [split(//, shift(@passcodes))];
while (@passcodes) {
my $b = [split(//, shift(@passcodes))];
my @new_candidates;
foreach my $a (@candidates) {
find_candidates(
sub ($solution) {
push @new_candidates, $solution;
},
$a, $b
);
}
@new_candidates = do { # remove duplicates
my %seen;
grep { !$seen{join('', @$_)}++ } @new_candidates;
};
my $min_len = min(map { $#$_ } @new_candidates);
@candidates = grep { $#$_ == $min_len } @new_candidates;
say sprintf("Found: %s candidates (best: %s)", scalar(@candidates), join('', @{$candidates[0]}));
}
say "Final candidates: ", join(', ', map { join('', @$_) } @candidates);