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

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





◆説明等◆
引用(参考)元：SBORLAND 会議室 DELPHI Visual, Compiler 1996/5/19 #11690
　通貨型よりも大きい，又は小さい値を扱うことが可能です．整数部20桁，小
数部10桁を持つ数字の加減乗除が誤差なく計算できます（独自に考えたアルゴ
リズムなのでちょっと心配）．MaxFigX の値を変更すれば何桁でもOKです．

使い方：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;
function SubLongFixed(const x, y: string): string;
var
  x1, y1: TLongFixed;
begin
  x1:=StrToLongFixed(GetAbsStr(x));
  y1:=StrToLongFixed(GetAbsStr(y));
  if isPositive(x) then begin
    if isPositive(y) then begin
      if isAbsGTE(x1, y1) then begin
        result:=LongFixedToStr(SubAbsLongFixed(x1, y1));
      end
      else begin
        result:='-'+LongFixedToStr(SubAbsLongFixed(y1, x1));
      end;
    end
    else begin
        result:=LongFixedToStr(AddAbsLongFixed(x1, y1));
    end;
  end
  else begin
    if isPositive(y) then begin
      result:='-'+LongFixedToStr(AddAbsLongFixed(x1, y1));
    end
    else begin
      if isAbsGTE(x1, y1) then begin
        result:='-'+LongFixedToStr(SubAbsLongFixed(x1, y1));
      end
      else begin
        result:=LongFixedToStr(SubAbsLongFixed(y1, x1));
      end;
    end;
  end;
end;
function AddLongFixed(const x, y: string): string;
begin
  if isPositive(x) then begin
    if isPositive(y) then begin
      result:=LongFixedToStr(AddAbsLongFixed(StrToLongFixed(x),
                                             StrToLongFixed(y)));
    end
    else begin
      result:=SubLongFixed(x, GetAbsStr(y));
    end;
  end
  else begin
    if isPositive(y) then begin
      result:=SubLongFixed(y, GetAbsStr(x));
    end
    else begin
      result:='-'+LongFixedToStr(AddAbsLongFixed(
                                   StrToLongFixed(
                                     GetAbsStr(x)),
                                     StrToLongFixed(GetAbsStr(y))));
    end;
  end;
end;
function MulLongFixed(const x, y: string): string;
begin
  if isPositive(x) then begin
    if isPositive(y) then begin
      result:=LongFixedToStr(MulAbsLongFixed(StrToLongFixed(x),
                                             StrToLongFixed(y)));
    end
    else begin
      result:='-'+LongFixedToStr(MulAbsLongFixed(StrToLongFixed(x),
                                   StrToLongFixed(GetAbsStr(y))));
    end;
  end
  else begin
    if isPositive(y) then begin
      result:='-'+LongFixedToStr(MulAbsLongFixed(StrToLongFixed(
                                   GetAbsStr(x)),StrToLongFixed(y)));
    end
    else begin
      result:=LongFixedToStr(MulAbsLongFixed(StrToLongFixed(
                                 GetAbsStr(x)),
                                 StrToLongFixed(GetAbsStr(y))));
    end;
  end;
end;
function QuoLongFixed(const x, y: string): string;
begin
  if isPositive(x) then begin
    if isPositive(y) then begin
      result:=LongFixedToStr(QuoAbsLongFixed(
                               StrToLongFixed(x),
                               StrToLongFixed(y)));
    end
    else begin
      result:='-'+LongFixedToStr(QuoAbsLongFixed(
                                   StrToLongFixed(x),
                                   StrToLongFixed(GetAbsStr(y))));
    end;
  end
  else begin
    if isPositive(y) then begin
      result:='-'+LongFixedToStr(QuoAbsLongFixed(
                                   StrToLongFixed(GetAbsStr(x)),
                                   StrToLongFixed(y)));
    end
    else begin
      result:=LongFixedToStr(QuoAbsLongFixed(
                               StrToLongFixed(GetAbsStr(x)),
                               StrToLongFixed(GetAbsStr(y))));
    end;
  end;


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

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