Addition chains
my @Example = ();
sub check-Sequence($pos, @seq, $n, $minLen --> List) {
if ($pos > $minLen or @seq[0] > $n) {
return $minLen, 0;
} elsif (@seq[0] == $n) {
@Example = @seq;
return $pos, 1;
} elsif ($pos < $minLen) {
return try-Permutation 0, $pos, @seq, $n, $minLen;
} else {
return $minLen, 0;
}
}
multi sub try-Permutation($i, $pos, @seq, $n, $minLen --> List) {
return $minLen, 0 if $i > $pos;
my @res1 = check-Sequence $pos+1, (@seq[0]+@seq[$i],@seq).flat, $n, $minLen;
my @res2 = try-Permutation $i+1, $pos, @seq, $n, @res1[0];
if (@res2[0] < @res1[0]) {
return @res2[0], @res2[1];
} elsif (@res2[0] == @res1[0]) {
return @res2[0], @res1[1]+@res2[1];
} else {
note "Error in try-Permutation";
return 0, 0;
}
}
multi sub try-Permutation($x, $minLen --> List) {
return try-Permutation 0, 0, [1], $x, $minLen;
}
sub find-Brauer($num, $minLen, $nbLimit) {
my ($actualMin, $brauer) = try-Permutation $num, $minLen;
say "\nN = ", $num;
say "Minimum length of chains : L($num) = $actualMin";
say "Number of minimum length Brauer chains : ", $brauer;
say "Brauer example : ", @Example.reverse if $brauer > 0;
@Example = ();
if ($num ≤ $nbLimit) {
my $nonBrauer = find-Non-Brauer $num, $actualMin+1, $brauer;
say "Number of minimum length non-Brauer chains : ", $nonBrauer;
say "Non-Brauer example : ", @Example if $nonBrauer > 0;
@Example = ();
} else {
say "Non-Brauer analysis suppressed";
}
}
sub is-Addition-Chain(@a --> Bool) {
for 2 .. @a.end -> $i {
return False if @a[$i] > @a[$i-1]*2 ;
my $ok = False;
for $i-1 … 0 -> $j {
for $j … 0 -> $k {
{ $ok = True; last } if @a[$j]+@a[$k] == @a[$i];
}
}
return False unless $ok;
}
@Example = @a unless @Example or is-Brauer @a;
return True;
}
sub is-Brauer(@a --> Bool) {
for 2 .. @a.end -> $i {
my $ok = False;
for $i-1 … 0 -> $j {
{ $ok = True; last } if @a[$i-1]+@a[$j] == @a[$i];
}
return False unless $ok;
}
return True;
}
sub find-Non-Brauer($num, $len, $brauer --> Int) {
my @seq = flat 1 .. $len-1, $num;
my $count = is-Addition-Chain(@seq) ?? 1 !! 0;
sub next-Chains($index) {
loop {
next-Chains $index+1 if $index < $len-1;
return if @seq[$index]+$len-1-$index ≥ @seq[$len-1];
@seq[$index]++;
for $index^..^$len-1 { @seq[$_] = @seq[$_-1] + 1 }
$count++ if is-Addition-Chain @seq;
}
}
next-Chains 2;
return $count - $brauer;
}
say "Searching for Brauer chains up to a minimum length of 12:";
find-Brauer $_, 12, 79 for 7, 14, 21, 29, 32, 42, 64 #, 47, 79, 191, 382, 379, 379, 12509 # un-comment for extra-credit
Output:
Searching for Brauer chains up to a minimum length of 12:
N = 7
Minimum length of chains : L(7) = 4
Number of minimum length Brauer chains : 5
Brauer example : (1 2 3 4 7)
Number of minimum length non-Brauer chains : 0
N = 14
Minimum length of chains : L(14) = 5
Number of minimum length Brauer chains : 14
Brauer example : (1 2 3 4 7 14)
Number of minimum length non-Brauer chains : 0
N = 21
Minimum length of chains : L(21) = 6
Number of minimum length Brauer chains : 26
Brauer example : (1 2 3 4 7 14 21)
Number of minimum length non-Brauer chains : 3
Non-Brauer example : [1 2 4 5 8 13 21]
N = 29
Minimum length of chains : L(29) = 7
Number of minimum length Brauer chains : 114
Brauer example : (1 2 3 4 7 11 18 29)
Number of minimum length non-Brauer chains : 18
Non-Brauer example : [1 2 3 6 9 11 18 29]
N = 32
Minimum length of chains : L(32) = 5
Number of minimum length Brauer chains : 1
Brauer example : (1 2 4 8 16 32)
Number of minimum length non-Brauer chains : 0
N = 42
Minimum length of chains : L(42) = 7
Number of minimum length Brauer chains : 78
Brauer example : (1 2 3 4 7 14 21 42)
Number of minimum length non-Brauer chains : 6
Non-Brauer example : [1 2 4 5 8 13 21 42]
N = 64
Minimum length of chains : L(64) = 6
Number of minimum length Brauer chains : 1
Brauer example : (1 2 4 8 16 32 64)
Number of minimum length non-Brauer chains : 0
Last updated