この発言に対し以下のコメントが寄せられています

#00305　０７コナン      さん　RE:誤差の発生しない四則演算１







◆説明等◆
　これはSBORLANDのフォーラムで，川西大さんが提示した（昨年の夏ぐらいで
しょうか，私の記憶が確かならば）「AddFixedLong」と言う関数を応用したも
のです．つまり，自分なりに四則演算できるように応用したわけです（ですか
ら，もっと良い方法があると思います）．通貨型よりも大きい，又は小さい値
を扱うことが可能です．

　整数部20桁，小数部10桁を持つ数字の加減乗除が誤差なく計算できるように
なってます（なってないかもf(^^;;　私独自に考えたアルゴリズムなのでちょ
っと心配なんです）．乗算と除算を行うと答えの桁が整数部で２倍−１（この
−１に当たる部分は符号（実際はマイナス符号）になるわけです）に小数部は
それが倍になるのを考慮してます（間違ってないよなぁ）．MaxFigX の値を変
更すれば何桁でもOKです．が，処理速度は落ちます．

　尚，表示の都合上折り返しをしている箇所があります（DelphiってVBみたい
に _で改行表記できないんでしょうか？）．

　使い方はいたって簡単です．AddLongFixed（和算），SubLongFixed（減算），
MulLongFixed（乗算），QuoLongFixed（除算）の引数に数字を表す文字列を渡
せば結果が返ります．
　長行数になりますので２つに分けます．上記の４つの関数をパート２の方に
記します．

◆サンプルコード　１◆
uses
  SysUtils;

const
  MaxFig1 = 40;
  MaxFig2 = -10;
  MaxFig3 = 2 * MaxFig2;

type
  TLongFixed = array [MaxFig2..MaxFig1] of byte;
  TLongFixedLD = array [MaxFig3..MaxFig1] of byte;

function StrToLongFixed(const instr: string): TLongFixed;
var
  c, i, len: integer;
begin
  for i:=MaxFig2 to MaxFig1 do result[i] := 0;

  len := Length(instr);
  c := 1;
  while instr[c] in ['0'..'9'] do begin
    for i:=MaxFig1 downto 1 do result[i] := result[i-1];
    result[0] := ord(instr[c]) - ord('0');
    c := c + 1;
    if c > len then exit;
  end;

  if instr[c] = '.' then begin
    c := c + 1;
    i := -1;
    if c > len then exit;
    while instr[c] in ['0'..'9'] do begin
      if i>= MaxFig2 then result[i] := ord(instr[c]) - ord('0');
      c := c + 1;
      i := i - 1;
      if c > len then exit;
    end;
  end;

end;

function LongFixedToStr(const x: TLongFixed): string;
var
  i, n: integer;
begin
  result := '';
  n := MaxFig1;
  while (n > 0) and (x[n] = 0) do n := n - 1;

  for i := n downto 0 do result := result + Chr(Ord('0') + x[i]);
  result := result + '.';
  for i := -1 downto MaxFig2 do result := result +
                                          Chr(ord('0') + x[i]);

end;

function IsAbsGTE(const x, y: TLongFixed): boolean;
var
  i: integer;
begin
  result:=True;
  for i:=MaxFig2 to MaxFig1 do begin
    if x[i] = y[i] then Continue;

    if x[i] >= y[i] then begin
      result:=True;
    end
    else begin
      result:=False;
    end;
  end;

end;

function AddAbsLongFixed(const x, y: TLongFixed): TLongFixed;
var
  carry: byte;
  i: integer;
begin
  carry := 0;
  for i:=MaxFig2 to MaxFig1 do begin
    result[i] := x[i] + y[i] + carry;
    carry := result[i] div 10;
    result[i] := result[i] mod 10;
  end;

end;

function SubAbsLongFixed(const x, y: TLongFixed): TLongFixed;
var
  carry: byte;
  i: integer;
begin
  carry := 0;
  for i:=MaxFig2 to MaxFig1 do begin
    if (x[i] - carry) >= y[i] then begin
      result[i] := x[i] - carry - y[i];
      carry:=0;
    end
    else begin
      result[i] := x[i] + 10 - carry - y[i];
      carry:=1;
    end;
    result[i] := result[i] mod 10;
  end;

end;

function MulAbsLongFixed(const x, y: TLongFixed): TLongFixed;
var
  carry: byte;
  i,j,k: integer;
  result1, result2: TLongFixedLD;
begin
  for i:=MaxFig3 to MaxFig1 do result1[i] := 0;
  result2:=result1;
  
  for i:=MaxFig2 to MaxFig1 do begin
    carry := 0;
    for j:=MaxFig2 to MaxFig1 do begin
      k:=i+j;
      if k > MaxFig1 then Continue;

      result2[k] := x[i] * y[j] + result1[k] + carry;
      carry := result2[k] div 10;
      result2[k] := result2[k] mod 10;
      result1[k]:=result2[k];
    end;
  end;

  for i:=MaxFig2 to MaxFig1 do result[i]:=result2[i];

end;

function LShiftLongFixed(const x: TLongFixed; const y: Integer):
                        TLongFixed;
var
  i: integer;
begin
  for i:=MaxFig1 downto MaxFig2+y do result[i]:=x[i-y];
  for i:=MaxFig2+y-1 downto MaxFig2 do result[i]:=0;
end;

function QuoAbsLongFixed(const x, y: TLongFixed): TLongFixed;
var
  ini1, x0, x1, x2, x3, x4, x5, tmp1, tmp2, tmp3, k10: TLongFixed;
  fig,i,j: integer;
  s: string;
begin
  ini1:=StrToLongFixed('1');
  k10:=StrToLongFixed('10');
  result:=StrToLongFixed('0');

  x0:=x;
  while True do begin
    x1:=y;
    tmp1:=ini1;
    fig:=-1;
    while IsAbsGTE(x0, x1) do begin
      fig:=fig+1;
      tmp2:=tmp1;
      x2:=x1;

      x1:=LShiftLongFixed(x1, 1);
      tmp1:=LShiftLongFixed(tmp1, 1);

    end;
    if fig = -1 then break;

    i:=1;
    x3:=x2;
    while IsAbsGTE(x0, x3) do begin
      x4:=x3;
      tmp3:=tmp2;
      tmp2[fig]:=i+1;
      i:=i+1;
      x3:=AddAbsLongFixed(x3, x2);
    end;
    result:=AddAbsLongFixed(result, tmp3);
    x0:=SubAbsLongFixed(x0, x4);
  end;

  for j:=-1 downto MaxFig2 do begin
    x0:=LShiftLongFixed(x0, 1);
    i:=0;
    while IsAbsGTE(x0, y) do begin
      i:=i+1;
      x0:=SubAbsLongFixed(x0, y);
    end;
    result[j]:=i;
  end;

end;

function isPositive(const x: string): Boolean;
begin
  result:=True;
  if x[1] = '-' then result:=False;

end;

function GetAbsStr(const x: string): string;
var
  i, len: integer;
begin
  result:='';
  len:=Length(x);
  for i:=len downto 1 do begin
    if x[i] = '-' then Continue;
    result:=x[i]+result;
  end;

end;

　// 97/12/19 (金) 21:33:00 ０７コナン


Original document by ０７コナン      氏 ID:(QZM05143)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。