# 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; } # A225607 sub a { my $n = shift; my @r = torl($n); my @ar = (); push @ar => $r[0]; foreach (0..$#r-1) { push @ar => 1 + ( ($r[$_]-1) ^ ($r[$_+1]-1) ); } return fromrl(@ar); } foreach my $n (1..10_000) { my $a = a($n); print "$n $a\n"; }