# n -> binary run lengths sub torl { my $n = shift; my @r = (); while ($n) { my $z = 0; while ($n%2==0) { $n /= 2; $z++; } if ($z) { @r = ($z, @r); } my $o = 0; while ($n%2) { $n = ($n-1)/2; $o++; } @r = ($o, @r); } return @r; } # binary run lengths -> n sub fromrl { my $n = 0; my $b = 1; foreach my $r (@_) { $n = $n << $r; if ($b) { $n += 2**$r-1; } $b = 1-$b; } return $n; } # A227987 sub a { my $n = shift; my @r = torl($n); my $x = 0; my @ar = (); foreach my $r (@r) { $x = $x ^ ($r-1); @ar = (@ar, 1+$x); } return fromrl(@ar); } foreach my $n (1..10_000) { my $a = a($n); print "$n $a\n"; }