文字列で 10 進任意精度整数の四則演算 その 3 符号付き除算

昨日の 2 つの符号なし除算ルーチンを利用して、符号付き除算を作ります。被除数と除数のいずれか一方だけが負のときに、商と余りの関係をどう扱うかは、定義次第で実装依存になるので、ここでは Ruby の Integer#divmod メソッドに合わせることにしました。被除数と除数の符号にかかわらず、すべての場合に、次の関係がなりたつようにします。

($q, $r) = _divmod($r0, $r1);
# $r0 == $q * $r1 + $r;

符号付き除算では、他にも、ゼロで割ろうとしたときに例外を投げたり、ゼロを割ろうとしたときは即座にゼロを返したりなどの処理を追加しています。

sub _divmod {
    my($r0, $r1) = @_;
    croak "DIV/0" if $r1 eq '0';
    return ('0', '0') if $r0 eq '0';
    return ($r0, '0') if $r1 eq '1';
    return (_neg($r0), '0') if $r1 eq '-1';
    my $s0 = '-' eq (substr $r0, 0, 1) ? '-' : '';
    my $s1 = '-' eq (substr $r1, 0, 1) ? '-' : '';
    $r0 =~ s/\A-//msx; $r1 =~ s/\A-//msx;
    my($q, $r);
    if (1 == length $r1) {
        ($q, $r) = _divmod_unsigned_short($r0, $r1);
    }
    else {
        my $cp = _cmp($r0, $r1);
        if ($cp < 0) {
            ($q, $r) = (0, $r0);
        }
        elsif ($cp == 0) {
            ($q, $r) = (1, 0);
        }
        else {
            ($q, $r) = _divmod_unsigned_large($r0, $r1);
        }
    }
    my $sq = q(); my $sr = q();
    if ($s0 eq '-' && $s1 eq '-') {
        $sr = '-';
    }
    elsif ($s0 eq '' && $s1 eq '-') {
        $sq = '-'; $sr = '-';
        $q = _add_unsigned($q, '1');
        $r = _sub_unsigned($r1, $r);
    }
    elsif ($s0 eq '-' && $s1 eq '') {
        $sq = '-';
        $q = _add_unsigned($q, '1');
        $r = _sub_unsigned($r1, $r);
    }
    $q =~ s/\A0+//msx;
    if ($q eq '') {
        $q = '0';
    }
    elsif ($sq eq '-') {
        substr $q, 0, 0, '-';
    }
    $r =~ s/\A0+//msx;
    if ($r eq '') {
        $r = '0';
    }
    elsif ($sr eq '-') {
        substr $r, 0, 0, '-';
    }
    return ($q, $r);
}

符号を反転させる _neg は、ゼロにマイナス符号をつけないように気をつけていれば、単なる文字の置換になります。

sub _neg {
    my($r0) = @_;
    return $r0 if $r0 eq '0';
    $r0 =~ s/\A([-]?)/$1 ? '' : '-'/emsx;
    return $r0;
}

巨大数の大小比較も、単なる数字列にすぎないので、文字列の大小比較を組み合わせます。

sub _cmp {
    my($r0, $r1) = @_;
    my $s0 = '-' eq (substr $r0, 0, 1) ? '-' : '';
    my $s1 = '-' eq (substr $r1, 0, 1) ? '-' : '';
    return -1 if $s0 eq '-' && $s1 eq '';
    return +1 if $s0 eq '' && $s1 eq '-';
    if ($s0 eq '-' && $s1 eq '-') {
        $r0 =~ s/\A-//msx; $r1 =~ s/\A-//msx;
        my $i0 = length $r0;
        my $i1 = length $r1;
        return +1 if $i0 < $i1;
        return -1 if $i0 > $i1;
        return $r1 cmp $r0;
    }
    else {
        my $i0 = length $r0;
        my $i1 = length $r1;
        return -1 if $i0 < $i1;
        return +1 if $i0 > $i1;
        return $r0 cmp $r1;
    }
}