Calculator

MPFR による計算機能の強化

XML 拡張に続いて導入されたのが MPFR による任意精度計算でした。 gawk の計算は倍精度の浮動小数点演算のみで、精度の高い計算には不向きでしたが、MPFR の導入により大幅に強力な計算を行うことができます。

MPFR を分かってもらうためのデモとして、「プログラミング言語 AWK」の「6-5 普通の電卓」を McCormack や Alan Linton が拡張したスクリプトを MPFR に対応させてみました。 このスクリプトはそのまま本章の回答にもなっています。

mpfr_calc.awk

#! /usr/local/bin/xgawk -f
# calc3 - infix calculator - derived from calc3 in TAPL, chapter 6.
# by Kenny McCormack, Mon 3 Jan 2000
# modified by Alan Linton, $Date: 2000/01/06 21:37:36 $, $Revision: 1.16 $
# modified by Hirofumi Saito.

@load mpfr

BEGIN {
    MPFR_BASE = 10;
    MPFR_PRECISION = 100;
}

{
    printf( " = %s\n", eval($0));
}

# The rest is functions...
function eval(s   ,e) {
    _S_expr = s;
    gsub(/[ \t]+/, "", _S_expr);
    if (length(_S_expr) == 0) {
        return 0;
    }
    _f = 1;
    e = _expr();
    if (_f <= length(_S_expr)) {
        printf("An error occurred at %s\n", substr(_S_expr, _f));
    } else {
        return e;
    }
}

function _expr(    var,e) { # term | term [+-] term
    if (match(substr(_S_expr, _f), /^[A-Za-z_][A-Za-z0-9_]*=/)) {
        var = _advance();
        sub(/=$/, "", var);
        return _vars[var] = _expr();
    }
    e = _term();
    while (substr(_S_expr, _f, 1) ~ /[+-]/) {
        if (substr(_S_expr, _f++, 1) == "+") {
            e = mpfr_add(e, _term());
        } else {
            e = mpfr_sub(e, _term());
        }
    }
    return e;
}

function _term(    e) { # factor | factor [*/%] factor
    e = _factor();
    while (substr(_S_expr,_f,1) ~ /[*\/%]/) {
        _f++;
        if (substr(_S_expr, _f-1, 1) == "*") {
            return mpfr_mul(e, _factor());
        }
        if (substr(_S_expr,_ f-1, 1) == "/") {
            return mpfr_mul(e, _factor());
        }
        if (substr(_S_expr,_f-1,1) == "%") {
            return e % _factor();
        }
    }
    return e;
}

function _factor(   e) { # factor2 | factor2^factor
    e = _factor2();
    if (substr(_S_expr, _f, 1) != "^") {
        return e;
    }
    _f++;
    return mpfr_pow(e, _factor());
}

function _factor2(    e) { # [+-]?factor3 | !*factor2
    e = substr(_S_expr, _f);
    if (e ~ /^[\+\-\!]/) { #unary operators [+-!]
        _f++;
        if (e ~ /^\+/) {
            return +_factor3(); # only one unary + allowed
        }
        if (e ~ /^\-/) {
            return -_factor3(); # only one unary - allowed
        }
        if (e ~ /^\!/) {
            return !(_factor2() + 0); # unary ! may repeat
        }
    }
    return _factor3();
}

function _factor3(   e,fun,e2) { # number | varname | (expr) | function(...)
    e = substr(_S_expr, _f);

    #number
    if (match(e, /^([0-9]+[.]?[0-9]*|[.][0-9]+)([Ee][+-]?[0-9]+)?/)) {
        return _advance();
    }

    #function()
    if (match(e, /^([A-Za-z_][A-Za-z0-9_]+)?\(\)/)) {
        fun = _advance();
        if (fun ~ /^srand()/) {
            return srand();
        }
        if (fun ~ /^rand()/) {
            return rand();
        }
        if (fun ~ /^pi()/) {
            return mpfr_const_pi();
        }
        printf("error: unknown function %s\n", fun);
        return 0;
    }

    # (expr) | function(expr) | function(expr,expr)
    if (match(e, /^([A-Za-z_][A-Za-z0-9_]+)?\(/)) {
        fun=_advance();
        if (fun ~ /^((cos)|(exp)|(int)|(log)|(sin)|(sqrt)|(srand))?\(/) {
            e = _expr();
            e = _calcfun(fun, e);
        } else if (fun ~ /^atan2\(/) {
            e = _expr();
            if (substr(_S_expr, _f, 1) != ",") {
                printf("error: missing , at %s\n", substr(_S_expr, _f));
                return 0
            }
            _f++;
            e2 = _expr();
            e = mpfr_atan2(e, e2);
        } else {
            printf("error: unknown function %s\n", fun);
            return 0;
        }
        if (substr(_S_expr, _f++, 1) != ")") {
            printf("error: missing ) at %s\n", substr(_S_expr, _f));
            return 0;
        }
        return e;
    }

    #variable name
    if (match(e, /^[A-Za-z_][A-Za-z0-9_]*/)) {
        return _vars[_advance()];
    }

    #error
    printf("error in factor: expected number or ( at %s\n",
           substr(_S_expr, _f));
    return 0;
}

function _calcfun(fun, e) { #built-in functions of one variable
    if (fun == "(") {
        return e;
    }
    if (fun == "cos(") {
        return mpfr_cos(e);
    }
    if (fun == "exp(") {
        return mpfr_exp(e);
    }
    if (fun == "int(") {
        return int(e);
    }
    if (fun == "log(") {
        return mpfr_log(e);
    }
    if (fun == "sin(") {
        return mpfr_sin(e);
    }
    if (fun == "sqrt(") {
        return mpfr_sqrt(e);
    }
    if (fun == "srand(") {
        return srand(e);
    }
    if (fun == "exp(") {
        return mpfr_exp(e);
    }
}

function _advance(    tmp) {
    tmp = substr(_S_expr, _f, RLENGTH);
    _f += RLENGTH;
    return tmp;
}

実行結果