アッカーマン関数
非常に大きな値を生み出すアッカーマン関数があるので、プログラムの息抜きと言うことで、つくってみました。
アッカーマン関数に関しては、インターネットで調べてください。
普通の整数演算では、m=3,n=12迄しか計算できません、これ以上の値を入れると、再起呼び出しのスタックオーバーフローとなります。
pop
push演算と言う特殊な計算を使用すると、m=3,n=60迄の値が計算できます。
Delphi にはBigIntegerが無いので使用するには、別途組み込む必要があります
DelphiのBigIntegers
辺りを組み込んでください。
此処では、参考の為に、今まで使用していた多倍長の計算を使用してみました、計算の桁数の関係で浮動小数点の計算をしています。
多倍長演算の浮動小数点演算だと、m=4,n=2迄は計算できますが、整数での計算はできません。
計算結果の指数部が19728となっているので、有効桁数が最低19728桁必要となり計算が出来ても、表示することが困難な値です。
多倍長の組み込みは MPArithからmparith_2018-11-27.zipをダウンロードして下さい。
Zipファイルを解凍して、解凍したフォルダーにパス(ツール->オプション->Delphiオプション->ライブラリ->ライブラリパス)を追加し、Uses に mp_types, mp_real, mp_cmplx,
mp_baseを追加すれば使用可能になります。
Push, Pop による演算は、
にょきにょきブログ にあるJavaのプログラムを参考に作りました。
プログラム
unit Main;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Buttons, Vcl.ExtCtrls, system.UITypes;
type
TForm1 = class(TForm)
BitBtn1: TBitBtn;
Edit1: TEdit;
BitBtn2: TBitBtn;
Edit2: TEdit;
LabeledEdit1: TLabeledEdit;
LabeledEdit2: TLabeledEdit;
BitBtn3: TBitBtn;
Edit3: TEdit;
Edit4: TEdit;
BitBtn4: TBitBtn;
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure BitBtn3Click(Sender: TObject);
procedure BitBtn4Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses mp_base, mp_real, mp_types;
function input(var m, n: cardinal): boolean; forward;
//==============================================================================
// mの値による計算式選択計算
// 多倍長演算
var
ansl : mp_float;
mpovf : boolean;
procedure Ackermann_function_calc(m: integer; nl: mp_float);
const
wp1 = maxword + 1; // 65536
nlmax = 2147483643; // m = 3 時 nl最大値
var
tmp: mp_float;
two, mpwm: mp_float;
nlmaxd : mp_float;
begin
mpovf := false;
mpf_init4(tmp, two, mpwm, nlmaxd);
mpf_set_int(two, 2); // 2
mpf_set_int(mpwm, wp1); // 65536
mpf_set_int(nlmaxd, nlmax); // 2147483643
if m = 0 then mpf_add_int(nl, 1, ansl); // m = 0 n + 1
if m = 1 then mpf_add_int(nl, 2, ansl); // m = 1 n + 2
if m = 2 then begin // m = 2
mpf_mul_int(nl, 2, ansl); // n * 2 + 3
mpf_add_int(ansl, 3, ansl);
end;
if m = 3 then begin // m = 3
if mpf_is_gt(nl, nlmaxd) then begin // nl最大値超えているか確認
mpovf := true; // 超えていたら overflow
end
else begin
mpf_add_int(nl, 3, tmp); // 2^(n+3) - 3
mpf_expt(two , tmp, ansl);
mpf_sub_int(ansl, 3, ansl);
end;
end;
if m = 4 then begin // m = 4
if mpf_is0(nl) then mpf_set_int(ansl, 13); // n = 0
if s_mpf_is_gt0(nl) then begin
if mpf_is1(nl) then mpf_sub_int(mpwm, 3, ansl); // n = 1 65536 - 3
if mpf_is_eq(nl, two) then begin
mpf_expt(two , mpwm, tmp); // n = 2 2^65536 - 3
mpf_sub_int(tmp, 3, ansl);
end;
if mpf_is_gt(nl, two) then mpovf := true; // n > 2 overflow
end;
end;
if m = 5 then begin // m = 5
if mpf_is0(nl) then mpf_sub_int(mpwm, 3, ansl); // n = 0 65536 - 3
if s_mpf_is_gt0(nl) then mpovf := true; // n > 0 overflow
end;
mpf_clear4(tmp, two, mpwm, nlmaxd);
end;
// 整数入力確認
// nの桁数が多すぎて通常のルーチンで確認できないのでここで確認します
function indatacheck(str: string): boolean;
var
stc : string;
i, m, leng : integer;
ch: char;
ff: boolean;
begin
stc := '0123456789';
leng := length(str); // 文字長さ
ff := true;
for i := 1 to leng do begin
ch := str[i];
ff := false;
for m := 1 to 10 do begin
if ch = stc[m] then ff := true; // 一致したらtrue
if ff then break; // 一致したらブレーク
end;
if not ff then break; // 一致しないとブレーク
end;
result := ff;
end;
procedure TForm1.BitBtn4Click(Sender: TObject);
const
mmax = 1; // m の最大文字数
nmax = 200; // n の最大文字数
var
m: integer;
nl : mp_float;
ch : integer;
begin
ch := length(form1.LabeledEdit1.Text);
if ch > mmax then begin
MessageDlg('mの桁数が多すぎます。', mtInformation, [mbOk], 0, mbOk);
exit;
end;
val(form1.LabeledEdit1.Text, m, ch);
if ch <> 0 then begin
MessageDlg('mの値に間違いがあります。', mtInformation, [mbOk], 0, mbOk);
exit;
end;
ch := length(form1.LabeledEdit2.Text);
if ch > nmax then begin
MessageDlg('nの桁数が多すぎます。', mtInformation, [mbOk], 0, mbOk);
exit;
end;
if not indatacheck(Form1.LabeledEdit2.Text) then begin
MessageDlg('nの値に間違いがあります。', mtInformation, [mbOk], 0, mbOk);
exit;
end;
bitbtn4.Enabled := False;
mpf_init2(ansl, nl);
mpf_read_decimal(nl, pansichar(ansistring(Form1.LabeledEdit2.Text)));
Ackermann_function_calc(m, nl);
if not mpovf then
Edit4.Text := string(mpf_decimal_alt(ansl, 35))
else
Edit4.Text := '値が大きすぎます。';
mpf_clear2(ansl, nl);
bitbtn4.Enabled := True;
end;
//==============================================================================
// 多倍長によるアッカーマン関数計算 push pop 使用
// push深さ制限値を超えると、mp_floatが最大値を超えます。
// 実際の制限値は指定の値(100000)より大きく設定できますが、
// pushl popl用定義
// 多倍長設定
const
ppsizel = 10000000; // push深さ制限値
var
retl : mp_float;
buffl: array of mp_float;
ppindexl, ppsizemax : cardinal;
ovf : boolean;
// push pop が Delphiに無いため作成
procedure pushl(X: mp_float);
begin
mpf_copy(X, buffl[ppindexl]);
if ppindexl > ppsizemax then ppsizemax := ppindexl;
inc(ppindexl);
end;
procedure popl(var X: mp_float);
begin
dec(ppindexl);
mpf_copy(buffl[ppindexl], X);
end;
// アッカーマン関数 push pop 多倍長演算
procedure Ackermann_function_pushpopl;
var
m, n: mp_float;
one, two: mp_float;
tmp: mp_float;
begin
mpf_init5(m, n, one, two, tmp);
mpf_set1(one);
mpf_set_int(two, 2);
ovf := False;
while ppindexl > 1 do begin
popl(n);
popl(m);
if mpf_is0(m) then begin
mpf_add_int(n, 1, tmp); // n + 1
pushl(tmp);
end
else
if mpf_is0(n) then begin
mpf_sub_int(m, 1, tmp); // m - 1
pushl(tmp);
pushl(one);
end
else
if mpf_is1(m) then begin
mpf_add_int(n, 2, tmp); // n + 2
pushl(tmp);
end
else
if mpf_is_eq(m, two) then begin
mpf_mul_int(n, 2, tmp); // n * 2
mpf_add_int(tmp, 3, tmp); // n * 2 + 3
pushl(tmp);
end
else
begin
mpf_sub_int(m, 1, tmp); // m - 1
pushl(tmp);
pushl(m);
mpf_sub_int(n, 1, tmp); // n - 1
pushl(tmp);
end;
// poshの深さ値が用意した配列数をに達したらループ終了
// breakで終了でもOKここでは ppindexlに１をセット
if ppindexl >= ppsizel - 1 then begin
ppindexl := 1;
ovf := True;
end;
end;
popl(retl);
mpf_clear5(m, n, one, two, tmp);
end;
// m,n の値は integerの最大値を超えないように
procedure TForm1.BitBtn3Click(Sender: TObject);
var
ml, nl: mp_float;
m, n: cardinal;
i : integer;
begin
if not input(m, n) then exit;
bitbtn3.Enabled := False;
mpf_init3(ml, nl, retl);
mpf_set_int(ml, m);
mpf_set_int(nl, n);
ppsizemax := 0;
ppindexl := 0;
setlength(buffl, ppsizel); // push pop 用配列初期化のため一度に確保
for i := 0 to ppsizel - 1 do begin
mpf_init(buffl[i]);
end;
pushl(ml);
pushl(nl);
Ackermann_function_pushpopl;
Form1.Canvas.TextOut(edit3.Left + 10, edit3.Top - 20, ' ');
if not ovf then begin
Edit3.Text := string(mpf_decimal_alt(retl, 35));
Form1.Canvas.TextOut(edit3.Left + 150, edit3.Top - 30, 'Push 深さ = ' + intTostr(ppsizemax));
end
else
Edit3.Text := 'Push 深さが制限値' + intTostr(ppsizel) + 'を超えました。';
for i := 0 to ppsizel - 1 do begin
mpf_clear(buffl[i]);
end;
mpf_clear3(ml, nl, retl);
bitbtn3.Enabled := True;
end;
//==============================================================================
// 再起呼び出しは数の制限がかかるので、配列による、pop pushを使用します。
// 演算速度も飛躍的に早くなります。
// push深さ制限値を超えると、uint64が最大値を超えて０からに戻ってしまいます。
// push pop用定義
var
buff: array of uint64;
ppindex, ppsize : cardinal;
ppMax : cardinal;
oovf : boolean;
const
addsize = 10;
psize = 64; // push深さ制限値
// push pop が Delphiに無いため作成
procedure push(X: uint64);
begin
if ppsize <= ppindex then begin // 配列が不足したら追加
ppsize := ppsize + addsize;
setlength(buff, ppsize); // push pop 用配列サイズ変更
end;
buff[ppindex] := X;
if ppindex > ppmax then ppmax := ppindex;
inc(ppindex);
end;
procedure pop(var X: uint64);
begin
dec(ppindex);
X := buff[ppindex];
end;
// アッカーマン関数 push pop 演算
function Ackermann_function_pushpop: uint64;
var
m, n: uint64;
begin
oovf := false;
while ppindex > 1 do begin
pop(n);
pop(m);
if m = 0 then
push(n + 1)
else
if n = 0 then begin
push(m - 1);
push(1);
end
else
if m = 1 then
push(n + 2)
else
if m = 2 then
push(n * 2 + 3)
else
begin
push(m - 1);
push(m);
push(n - 1);
end;
// posh深さの値が制限数に達したらループ終了
// breakで終了でもOKここでは ppindexに１をセット
if ppindex >= psize then begin
oovf := true;
ppindex := 1;
end;
end;
pop(result);
end;
// アッカーマン関数計算 push pop 計算実行
procedure TForm1.BitBtn2Click(Sender: TObject);
var
m, n: cardinal;
ans : uint64;
begin
if not input(m, n) then exit;
bitbtn2.Enabled := False;
ppMax := 0;
ppindex := 0;
ppsize := addsize;
setlength(buff, ppsize); // push pop 用配列確保
push(m);
push(n);
ans := Ackermann_function_pushpop;
Form1.Canvas.TextOut(edit2.Left + 10, edit2.Top - 20, ' ');
if not oovf then begin
edit2.Text := uintTostr(ans);
Form1.Canvas.TextOut(edit2.Left + 10, edit2.Top - 20, 'Push 深さ = ' + intTostr(ppmax));
end
else
edit2.Text := 'Push深さが制限値' + intTostr(psize) + 'を超えました。';
bitbtn2.Enabled := True;
end;
//==============================================================================
// 再起呼び出しアッカーマン関数計算。
// ack(m, n)
// n = 0 n + 1
// m = 0 ack(m-1 ,1)
// other ack(m-1, ack(m, n-1))
// 再起呼びたしが多すぎスタックオーバーによりプログラムが異常終了する場合は
// スタック深さ限度で調整して下さい。
const
stmax = 64562; // スタック深さ限度
var
ret : cardinal;
loop, loopn : cardinal;
stack : cardinal;
stf : boolean;
// アッカーマン関数
// スタックの量を少しでも少なくするためFunctionでなくprocedur使用
procedure Ackermann_function(m, n: cardinal);
begin
if stf then exit; // スタック限度に達した場合ここで終了スタック戻し
inc(loop); // スタックカウンターインクリメント
inc(loopn); // ループカウンター
if loop > stack then begin
stack := loop;
if stack >= stmax then begin // スタックが限度に達したら
stf := true; // スタック限度フラグセット
end;
end;
if m = 0 then begin
ret := n + 1; // アッカーマン数
dec(loop); // スタックカウンターデクリメント
exit;
end;
if n = 0 then begin
Ackermann_function(m - 1, 1); // 再起呼び出し
dec(loop); // スタックカウンターデクリメント
exit;
end;
Ackermann_function(m, n - 1); // 再起呼び出し
Ackermann_function(m - 1, ret); // 再起呼び出し
dec(loop); // スタックカウンターデクリメント
end;
// アッカーマン関数計算 実行
// m=4 n=0 より大きい値は計算不可です
procedure TForm1.BitBtn1Click(Sender: TObject);
var
m, n: cardinal;
begin
ret := 0;
if not input(m, n) then exit;
BitBtn1.Enabled := False;
edit1.Text := '計算中';
application.ProcessMessages;
loop := 0;
loopn := 0;
stack := 0;
stf := false;
Ackermann_function(m, n);
Form1.Canvas.TextOut(edit1.Left + edit1.Width + 20, edit1.Top - 5, ' ');
Form1.Canvas.TextOut(edit1.Left + edit1.Width + 10, edit1.Top + 10, ' ');
if not stf then begin
edit1.Text := intTostr(ret);
Form1.Canvas.TextOut(edit1.Left + edit1.Width + 20, edit1.Top - 5, 'Loop = ' + intTostr(loopn));
Form1.Canvas.TextOut(edit1.Left + edit1.Width + 20, edit1.Top + 10, 'stack = ' + intTostr(stack));
end
else begin
edit1.Text := 'スタック容量超過';
Form1.Canvas.TextOut(edit1.Left + edit1.Width + 10, edit1.Top + 10, 'stack制限値 = ' + intTostr(stmax));
end;
BitBtn1.Enabled := True;
end;
//==============================================================================
// データー入力処理
function input(var m, n: cardinal): boolean;
const
cmax = Maxlongint;
mmax = 1;
lmax = 10;
var
ch: integer;
cin: uint64;
begin
result := true;
ch := length(form1.LabeledEdit1.Text);
if ch > mmax then begin
MessageDlg('mの桁数が多すぎます。', mtInformation, [mbOk], 0, mbOk);
result := false;
exit;
end;
val(form1.LabeledEdit1.Text, cin, ch);
if ch <> 0 then begin
MessageDlg('mの値に間違いがあります。', mtInformation, [mbOk], 0, mbOk);
result := false;
exit;
end;
if cin > cmax then begin // integer最大値を超えてないか確認
MessageDlg('mの値が大きすぎます。', mtInformation, [mbOk], 0, mbOk);
result := false;
exit;
end;
m := cin;
ch := length(form1.LabeledEdit2.Text);
if ch > lmax then begin
MessageDlg('nの桁数が多すぎます。', mtInformation, [mbOk], 0, mbOk);
result := false;
exit;
end;
val(form1.LabeledEdit2.Text, cin, ch);
if ch <> 0 then begin
MessageDlg('nの値に間違いがあります。', mtInformation, [mbOk], 0, mbOk);
result := false;
exit;
end;
if cin > cmax then begin // integer最大値を超えてないか確認
MessageDlg('nの値が大きすぎます。', mtInformation, [mbOk], 0, mbOk);
result := false;
exit;
end;
n := cin;
end;
//==============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
edit1.Text := '';
edit2.Text := '';
edit3.Text := '';
edit4.Text := '';
Form1.Canvas.Font.Size := 11;
end;
end.
Ackermann_function.zip
三角関数、逆三角関数、その他関数 に戻る