文字列で 10 進任意精度整数の四則演算 その 1 加減乗算

10 進数表記の文字列をピュア Perl で直接四則演算してみようというネタ・プログラミングをやってみます。10 進数で計算をおこなうことにし、どうせ遅いので、アルゴリズムは筆算のやりかたを採用します。いまどきの高速化乗算・除算アルゴリズムは使わないことにします。ネタ元は D. KnuthThe Art of Computer Programming Vol.2 asin:4756145434 第二版 (以下 Knuth1998 と表す)の 4.3.1 節です。

演算対象は、10 進数表記の任意精度整数を表した文字列です。ゼロと負の数も許すことにします。符号はマイナスだけを許し、ゼロには符号をつけない約束にします。無限大と NaN はありません。通常の数の表記の通りに 1 の位は文字列の末尾に配置し、文字列の先頭に向かって桁が上がっていきます。

like $decimal, qr/\A(?:0|-?[1-9][0-9]*)\z/msx;

まずは符号なし加減算から。符号付き加減算は、符号なし加減算を使うため、まず符号なしから書きます。加算はフルアダーを1桁目から順番に摘要していきます。フルアダーなので、入力は2つの数の対応する桁の数が2個にキャリーを加えて3つです。出力は桁の値とキャリーの2つになります。符号なし加算では、引数の1つ目の数の方が2つ目よりも桁数が大きいか等しいことを前提にします。Perl が数字の列を自動的に数として扱うため、数字と整数の変換は不要ですが、整数から文字列への変換段階で、バグで 0 から 9 以外の数になったときに変な文字列になった方がバグがあることがわかりやすいので、chr 関数で変換しています。

my $base = 10;
my $ord0 = ord '0';

# see [Knuth1998] page.266 Algorithm A (Addition of nonnegative integers)
sub _add_unsigned {
    my($r0, $r1) = @_;
    use integer;
    my $j = length $r0;
    my $i = length $r1;
    my $r2 = '0' x $j;
    my $k = 0;
    while (--$j >= 0) {
        my $a = (substr $r0, $j, 1) + (--$i < 0 ? 0 : (substr $r1, $i, 1)) + $k;
        $k = $a >= $base ? 1 : 0;
        $a -= $k * $base;
        substr $r2, $j, 1, chr $a + $ord0;
    }
    return $r2 if ! $k;
    return (chr $k + $ord0) . $r2;
}

これを使うと、大きなフィボナッチ数を計算することができます。文字列と文字列を直接足し合わせて 10 進数表記の文字列を作るので、入力と表示に悩まなくて済むのが利点です。

sub fib {
    my($n) = @_;
    return '1' if $n <= 2;
    my $f1 = '1';
    my $f2 = '1';
    for my $i (3 .. $n) {
        my $f = _add_unsigned($f2, $f1);
        $f1 = $f2;
        $f2 = $f;
    }
    return $f2;
}

say fib(1000);
#=> '434665576869374564356885276750406258025646605173717804024817'
# . '290895365554179490518904038798400792551692959225930803226347'
# . '752096896232398733224711616429964409065331879382989696499285'
# . '16003704476137795166849228875'

符号なし減算も簡単です。加算と同じで桁数は 1 つ目の引数の方が多いことを前提にしています。なお、ボローの値はゼロか 1 にして、各桁は補数をフルアダーで計算しています。

# see [Knuth1998] page.267 Algorithm S (Subtraction of nonnegative integers)
sub _sub_unsigned {
    my($r0, $r1) = @_;
    use integer;
    my $j = length $r0;
    my $i = length $r1;
    my $r2 = '0' x $j;
    my $k = 1;
    while (--$j >= 0) {
        my $a = (substr $r0, $j, 1) - (--$i < 0 ? 0 : (substr $r1, $i, 1)) + $k + $base - 1;
        $k = $a >= $base ? 1 : 0;
        $a -= $k * $base;
        substr $r2, $j, 1, chr $a + $ord0;
    }
    return $r2;
}

符号付きの加算は、上の2つを利用します。符号と桁数によって、場合分けをしていくだけです。

sub _add {
    my($r0, $r1) = @_;
    my $s0 = '-' eq (substr $r0, 0, 1) ? '-' : '';
    my $s1 = '-' eq (substr $r1, 0, 1) ? '-' : '';
    my($s2, $r2);
    if (($s0 eq '-') ^ ($s1 eq '-')) {
        $r0 =~ s/\A-//msx; $r1 =~ s/\A-//msx;
        my $i0 = length $r0;
        my $i1 = length $r1;
        if ($i0 > $i1 || ($i0 == $i1 && $r0 ge $r1)) {
            $s2 = $s0;
            $r2 = _sub_unsigned($r0, $r1);
        }
        else {
            $s2 = $s1;
            $r2 = _sub_unsigned($r1, $r0);
        }
    }
    else {
        $r0 =~ s/\A-//msx; $r1 =~ s/\A-//msx;
        my $i0 = length $r0;
        my $i1 = length $r1;
        if ($i0 > $i1 || ($i0 == $i1 && $r0 ge $r1)) {
            $s2 = $s0;
            $r2 = _add_unsigned($r0, $r1);
        }
        else {
            $s2 = $s1;
            $r2 = _add_unsigned($r1, $r0);
        }
    }
    $r2 =~ s/\A0+//msx;
    return '0' if $r2 eq q();
    return $s2 . $r2;
}

最初の符号を抜き出す部分を変えるだけで、符号付きの減算になります。

sub _sub {
    my($r0, $r1) = @_;
    my $s0 = '-' eq (substr $r0, 0, 1) ? '-' : '';
    my $s1 = '-' eq (substr $r1, 0, 1) ? '' : '-';
    # 以下、_add と同じなので略す。
}

乗算は、筆算のやりかたそのままです。引数に桁数の大小の制限はありませんが、1 つ目の引数の桁を内側のループで繰り返すので、1 つ目の方に桁が長い方を渡す方が、若干速くなるはずです。

# see [Knuth1998] page.268 Algorithm M (Multiplication of nonnegative integers)
sub _mul_unsigned {
    my($r0, $r1) = @_;
    use integer;
    my $m = length $r0;
    my $j = length $r1;
    my $r2 = '0' x ($m + $j);
    while (--$j >= 0) {
        my $v = 0 + (substr $r1, $j, 1);
        next if $v == 0;
        my $i = $m;
        my $k = 0;
        while (--$i >= 0) {
            my $a = (substr $r0, $i, 1) * $v + (substr $r2, $i + $j + 1, 1) + $k;
            $k = $a / $base;
            $a -= $k * $base;
            substr $r2, $i + $j + 1, 1, chr $a + $ord0;
        }
        substr $r2, $j, 1, chr $k + $ord0;
    }
    return $r2;
}

乗算の符号は排他的論理和で求まります。

sub _mul {
    my($r0, $r1) = @_;
    my $s0 = '-' eq (substr $r0, 0, 1) ? '-' : '';
    my $s1 = '-' eq (substr $r1, 0, 1) ? '-' : '';
    my $s2 = $s0 ^ $s1;
    $r0 =~ s/\A-//msx; $r1 =~ s/\A-//msx;
    $r2 = _mul_unsigned($r0, $r1);
    $r2 =~ s/\A0+//msx;
    return '0' if $r2 eq q();
    return $s2 . $r2;
}