#!perl # OEIS A213457 Intertwined numbers # @(#) $Id$ # 2018-03-21, Georg Fischer # # Definition in <https://oeis.org/search?q=A213457> # a(n) for n=1..7: 1, 1, 2, 10, 148, 7384, 1380960 # a(8) = 1058349286 found in 3818.873 s #------------------------------------------------------ # usage: # perl a213457_Perl.txt n [visible [debug]] # n = number of digits to be used # visible = number of partial sums to be shown # debug = 0 (none), 1 (some), 2 (more), 3 (most) trace output #-------------------------------------------------------- use strict; use Time::HiRes qw(time); # yields microseconds my $max_n = shift(@ARGV); my $count = 0; # the overall counter for tuples my @counters; # subcounters for each digit my $visible = 0; # show outmost partial sums only; 1 : next level, 2: 3 levels ... if (scalar(@ARGV) > 0) { $visible = shift(@ARGV); } my $debug = 0; # 0 = none, 1 = some, 2 = more if (scalar(@ARGV) > 0) { $debug = shift(@ARGV); } my $SUCC = 1; my $FAIL = 0; my @arr; # operate on this array of digits # preset the array with an alternating sequence of the 2 biggest digits for (my $i = 0; $i < $max_n; $i ++) { push(@arr, $max_n); push(@arr, $max_n - 1); } # for $i pop(@arr); # remove the trailing $max_n-1 my $start_time = time(); my $high_digit = $max_n - 2; &insert($max_n - 2); # calls itself recursively my $duration = (time() - $start_time); $duration =~ s{(\d+)\.(\d{3})\d*}{$1.$2}; print "# $count tuples found in $duration s\n"; # print STDERR "# $count tuples found in $duration s\n"; #--------------------------------- sub insert { # recursively try to insert the parameter digit in the array my ($digit) = @_; my $beflo = 1; # determine the leftmost position of $digit while ($arr[$beflo] > $digit + 1) { $beflo ++; } $beflo ++; # now $arr[$beflo] == $digit my $befhi = scalar(@arr) - 2; # determine the rightmost position of $digit + 1 while ($arr[$befhi] > $digit + 1) { $befhi --; } # now $arr[$befhi] == $digit + 1 my $fillno = $befhi - $beflo + 1; # number of positions where $digit can be inserted if ($debug >= 2) { print "# " . join(" ", (0,1,2,3,4,5,6,7,8,9)) . " digit=$digit\n"; print "# " . join(" ", @arr) . " beflo=$beflo, befhi=$befhi, fillno=$fillno\n"; } #[0]1 2 3 4 5 6 # 4 3 4 3 4 3 4 # x x x x <- may insert 2 2s before these positions # now insert $digit occurrences of $digit # into the $fillno positions before $arr[$beflo..$befhi] if ($digit == 1) { # anywhere possible # simply count the possible positions, no need to insert them really $count += $fillno; if ($debug >= 1) { print "# + $fillno ones\n"; } } else { # $digit > 1 - check conditions, and maybe insert, recurse and remove again my $target = (((1 << $max_n) - 1) - ((1 << $digit) - 1)) << 1; # bitmask for digits which must occur inside the pair #------------- # head of binomial combination enumeration algorithm my $k = $digit; my $n = $fillno; my $n2 = 1 << $n; my $bitmap = (1 << $k) - 1; # k bit sets while ($bitmap < $n2) { # evaluate binomial possibilities my @combin = (); # pick k out of n for (my $i = 0; $i < $n; $i++) { if ((($bitmap >> $i) & 1) != 0) { push(@combin, $i); } } # for $i # end head of binomial combination enumeration algorithm my $result = $SUCC; # check rule 1: between any pair of $digit all higher digits must occur if ($debug >= 2 and $digit >= $high_digit or $debug >= 3) { print "# combination " . join(" ", @combin) . "\n"; } my $ipair = scalar(@combin) - 2; while ($result == $SUCC and $ipair >= 0) { my $start = $combin[$ipair]; my $end = $combin[$ipair + 1]; if ($end - $start >= $max_n - $digit) { my $source = 0; for (my $jpos = $start; $jpos < $end; $jpos ++) { $source |= 1 << $arr[$befhi - 1 - $jpos]; if ($debug >= 3) { print "# source |= digit at " . ($befhi - 1 - $jpos) . " = " . $arr[$befhi - $combin[$jpos]] . "\n"; } } # for jpos if ($source != $target) { # not all higher digits did occur if ($debug >= 3) { print "# source " . sprintf("%b", $source) . " failed\n"; } $result = $FAIL; } else { if ($debug >= 3) { print "# source " . sprintf("%b", $source) . " succeeded\n"; } } } else { $result = $FAIL; } $ipair --; } # while ipair if ($result == $SUCC) { # valid combination $counters[$digit] = $count; if ($debug >= 1 and $digit >= $high_digit || $debug >= 3) { print "# insert($digit) -> " . join(" ", @combin) . " result=$result\n"; } my $cind; #----------------- # insert for ($cind = 0; $cind < scalar(@combin); $cind ++) { # important: splice downwards splice(@arr, $befhi - $combin[$cind], 0, $digit); # insert 1 element before } # for cind backwards if ($debug >= 2) { print "# inserted: " . join(" ", @arr) . "\n"; } #----------------- # recurse &insert($digit - 1); #----------------- # remove for ($cind = scalar(@combin) - 1; $cind >= 0; $cind --) { # important: splice upwards splice(@arr, $befhi - $combin[$cind], 1); # remove 1 element } # for cind backwards if ($debug >= 2) { print "# removed: " . join(" ", @arr) . "\n"; } #----------------- my $diff = $count - $counters[$digit]; if ($digit >= $high_digit - $visible) { print "# " . (" " x $digit) . "$digit: +$diff\n"; } } # valid combination # tail of binomial combination enumeration algorithm my $x = $bitmap & -$bitmap; my $y = $bitmap + $x; my $z = ($bitmap & ~$y); $bitmap = $z / $x; $bitmap >>= 1; $bitmap |= $y; } # while # end tail of binomial combination enumeration algorithm } # $digit > 1 } # insert __DATA__ # 1, 1, 2, 10, 148, 7384, 1380960, # 1058349286 tuples found in 3818.873 s -------------------------------------- (2 1) = 2 positions for c 2 1 2 =1 -------------------------------------- 3 2 3 2 3 3 2 1 3 2 3 3 2 3 1 2 3 c b a c b c A3 c b c a b c /A3 =2 -------------------------------------- (5 2) = 10 positions for 2 d times 2*A3 d cba d cb d c d A4 A3 d cba d c d bc d B4 A3 d cb d acb d c d C4 A3 d cb d ac d bc d D4 A3 d c d bac d bc d /E4 A3 d cb d cab d c d E4 /A3 d cb d ca d bc d /D4 /A3 d cb d c d abc d /B4 /A3 d c d bca d bc d /C4 /A3 d c d bc d abc d /A4 /A3 4 3 4 3 4 3 4 Z 4 3 2 4 3 2 4 3 4 A 4 3 2 4 3 4 2 3 4 B 4 3 4 2 3 4 2 3 4 C 4 3 2 1 4 3 2 4 3 4 A1 4 3 2 4 1 3 2 4 3 4 A2 4 3 2 4 3 1 2 4 3 4 A3 4 3 2 1 4 3 4 2 3 4 B1 4 3 2 4 1 3 4 2 3 4 B2 4 3 2 4 3 1 4 2 3 4 B3 4 3 2 4 3 4 1 2 3 4 B4 4 3 4 2 1 3 4 2 3 4 C1 4 3 4 2 3 1 4 2 3 4 C2 4 3 4 2 3 4 1 2 3 4 C3 =10 -------------------------------------- 5 4 5 4 5 4 5 4 5 5 4 3 5 4 3 5 4 3 5 4 5 A 5 4 3 5 4 3 5 4 5 3 4 5 B 5 4 3 5 4 5 3 4 5 3 4 5 D 5 4 5 3 4 5 3 4 5 3 4 5 H 5 4 3 2 5 4 3 2 5 4 3 5 4 5 A 4 positions for 1 between 2s 5 4 3 2 5 4 3 5 2 4 3 5 4 5 A 5 5 4 3 2 5 4 3 5 4 2 3 5 4 5 A 6 5 4 3 5 2 4 3 5 2 4 3 5 4 5 A 4 5 4 3 5 2 4 3 5 4 2 3 5 4 5 A 5 5 4 3 5 4 2 3 5 4 2 3 5 4 5 A 4 = 28 5 4 3 2 5 4 3 2 5 4 5 3 4 5 B 4 5 4 3 2 5 4 3 5 2 4 5 3 4 5 B 5 5 4 3 2 5 4 3 5 4 2 5 3 4 5 B 6 5 4 3 2 5 4 3 5 4 5 2 3 4 5 B 7 5 4 3 5 2 4 3 5 2 4 5 3 4 5 B 4 5 4 3 5 2 4 3 5 4 2 5 3 4 5 B 5 5 4 3 5 2 4 3 5 4 5 2 3 4 5 B 6 5 4 3 5 4 2 3 5 4 2 5 3 4 5 B 4 5 4 3 5 4 2 3 5 4 5 2 3 4 5 B 5 = 46 5 4 3 2 5 4 5 3 2 4 5 3 4 5 D 5 5 4 3 2 5 4 5 3 4 2 5 3 4 5 D 6 5 4 3 2 5 4 5 3 4 5 2 3 4 5 D 7 5 4 3 5 2 4 5 3 2 4 5 3 4 5 D 4 5 4 3 5 2 4 5 3 4 2 5 3 4 5 D 5 5 4 3 5 2 4 5 3 4 5 2 3 4 5 D 6 5 4 3 5 4 2 5 3 4 2 5 3 4 5 D 4 5 4 3 5 4 2 5 3 4 5 2 3 4 5 D 5 5 4 3 5 4 5 2 3 4 5 2 3 4 5 D 4 = 46 5 4 5 3 2 4 5 3 2 4 5 3 4 5 H 4 5 4 5 3 2 4 5 3 4 2 5 3 4 5 H 5 5 4 5 3 2 4 5 3 4 5 2 3 4 5 H 6 5 4 5 3 4 2 5 3 4 2 5 3 4 5 H 4 5 4 5 3 4 2 5 3 4 5 2 3 4 5 H 5 5 4 5 3 4 5 2 3 4 5 2 3 4 5 H 4 = 28 A+B+D+H = 148 ! -------------------------------------- # perl twine2.pl 5 2 # 2: +4 # 2: +5 # 2: +4 # 2: +6 # 2: +5 # 2: +4 # 3: +28 # 2: +4 # 2: +5 # 2: +4 # 2: +6 # 2: +5 # 2: +4 # 2: +7 # 2: +6 # 2: +5 # 3: +46 # 2: +5 # 2: +4 # 2: +6 # 2: +5 # 2: +4 # 2: +7 # 2: +6 # 2: +5 # 2: +4 # 3: +46 # 2: +4 # 2: +5 # 2: +4 # 2: +6 # 2: +5 # 2: +4 # 3: +28 # 148 tuples found in 0.001 s # perl twine2.pl 7 # 4: +3684 # 4: +6426 # 4: +7058 # 4: +6426 # 4: +3684 # 4: +9858 # 4: +11656 # 4: +10878 # 4: +6426 # 4: +11824 # 4: +11656 # 4: +7058 # 4: +9858 # 4: +6426 # 4: +3684 # 5: +116602 # 4: +3684 # 4: +6426 # 4: +7058 # 4: +6426 # 4: +3684 # 4: +9858 # 4: +11656 # 4: +10878 # 4: +6426 # 4: +11824 # 4: +11656 # 4: +7058 # 4: +9858 # 4: +6426 # 4: +3684 # 4: +14040 # 4: +17344 # 4: +16400 # 4: +9858 # 4: +18822 # 4: +18814 # 4: +11656 # 4: +16400 # 4: +10878 # 4: +6426 # 5: +257240 # 4: +5672 # 4: +6304 # 4: +5642 # 4: +3172 # 4: +9080 # 4: +10854 # 4: +10040 # 4: +5872 # 4: +11050 # 4: +10812 # 4: +6498 # 4: +8984 # 4: +5842 # 4: +3335 # 4: +13238 # 4: +16494 # 4: +15508 # 4: +9262 # 4: +17976 # 4: +17886 # 4: +11030 # 4: +15436 # 4: +10222 # 4: +6023 # 4: +17278 # 4: +17916 # 4: +11213 # 4: +16368 # 4: +10988 # 4: +6643 # 5: +316638 # 4: +6643 # 4: +6023 # 4: +3335 # 4: +10988 # 4: +10222 # 4: +5842 # 4: +11213 # 4: +11030 # 4: +6498 # 4: +9262 # 4: +5872 # 4: +3172 # 4: +16368 # 4: +15436 # 4: +8984 # 4: +17916 # 4: +17886 # 4: +10812 # 4: +15508 # 4: +10040 # 4: +5642 # 4: +17278 # 4: +17976 # 4: +11050 # 4: +16494 # 4: +10854 # 4: +6304 # 4: +13238 # 4: +9080 # 4: +5672 # 5: +316638 # 4: +6426 # 4: +3684 # 4: +10878 # 4: +6426 # 4: +11656 # 4: +7058 # 4: +9858 # 4: +6426 # 4: +3684 # 4: +16400 # 4: +9858 # 4: +18814 # 4: +11656 # 4: +16400 # 4: +10878 # 4: +6426 # 4: +18822 # 4: +11824 # 4: +17344 # 4: +11656 # 4: +7058 # 4: +14040 # 4: +9858 # 4: +6426 # 4: +3684 # 5: +257240 # 4: +3684 # 4: +6426 # 4: +7058 # 4: +6426 # 4: +3684 # 4: +9858 # 4: +11656 # 4: +10878 # 4: +6426 # 4: +11824 # 4: +11656 # 4: +7058 # 4: +9858 # 4: +6426 # 4: +3684 # 5: +116602 # 1380960 tuples found in 5.797 s # perl twine2.pl 7 # 5: +116602 # 5: +257240 # 5: +316638 # 5: +316638 # 5: +257240 # 5: +116602 # 1380960 tuples found in 5.693 s # perl twine2.pl 8 # 6: +62425636 # 6: +153912067 # 6: +203960729 # 6: +217752422 # 6: +203960729 # 6: +153912067 # 6: +62425636 # 1058349286 tuples found in 3818.873 s #