左図は、四点指定して、フラクタル補間をしたものです。黒の折れ線が元の値で、赤の線が、各点の間をフラクタル補間したもので、各点の間が、全体の値と補間係数の値で保管されています。
赤い線になって見えますが、実際には点のつながりです。
フラクタル補間
このプログラムは、C言語辞典アルゴリズムにあるフラクタル補間をdelphi
xe用に変換したものです。
かなり古いサンプルプログラムらしく、元は、Pascalでその後、「C言語による最新アルゴリズム辞典」として出版された様です。
サンプルプログラムは『C言語による最新アルゴリズム事典』からもダウンロードできます
algo.lzh をダウンロードしてください。
C言語は
Turbo C でPCは、NECの9801 又は IBM PC/AT Basicなので、グラフィック画面表示が、現在のWindowsとは互換性がないので、グラフィック部分の変更には注意が必要です。
グラフィックを使用しなければ、C++Builderのコンソール C のプログラムとして、そのまま実行することが可能ですが、フラクタル補間は、グラフィックを使用しないと、計算結果の確認は出来ません。
C++Builderを起動し、新規作成->その他->コンソールアプリケーション->ソースの種類 C->File1.c削除->プロジェクトに目的のCファイル追加
です。
Turbo C は
embarcadero からダウンロード可能ですがダウンロード用ユーザー登録が必要です。
Turbo
Cで、9801用とDos/V互換機用両方のプログラムが開発出来たと記憶していますが、此処でのC
サンプルのは9801用で、Dos/V(PC/AT)用のものも用意されていますが、IBM PC 画面サイズ640x480の基本機種でしか動作不可です、CPU
8086のレジスターを直接使用するルーチンが含まれている為です。
左図は、四点指定して、フラクタル補間をしたものです。
黒の折れ線が元の値で、赤の線が、各点の間をフラクタル補間したもので、各点の間が、全体の値と補間係数の値で保管されています。
赤い線になって見えますが、実際には点のつながりです。
プログラムは、四点座標となっていますがプログラムを修正すれば増やせます、その時には、補間係数dの値の数も増やす必要があります(N-1)。
赤い線は実際には、点の繋がりなので、プロット数の値を小さくすれば確認できます。
C プログラム
/*********************************************************** fracint.c -- フラクタル補間 ***********************************************************/ #include "window.c" /* ラージモデルでコンパイル */ /* window.c 9801 Pc/AT用 *1 double left = 0, bottom = 0, right = 100, top = 100, /* 座標の範囲 */ x[] = { 0, 30, 60, 100 }, y[] = { 0, 50, 40, 10 }; /* 各点の座標 */ #define N (sizeof x / sizeof x[0] - 1) int main() { int i, j; double p, q, a[N], c[N], d[N], e[N], f[N]; /* アフィン変換を求める */ q = x[N] - x[0]; for (i = 0; i < N; i++) { printf("d[%d] = ", i); scanf("%lf", &d[i]); a[i] = (x[i+1] - x[i]) / q; e[i] = (x[N] * x[i] - x[0] * x[i+1]) / q; c[i] = (y[i+1] - y[i] - d[i] * (y[N] - y[0])) / q; f[i] = (x[N] * y[i] - x[0] * y[i+1] - d[i] * (x[N] * y[0] - x[0] * y[N])) / q; } /* アトラクタをプロットする */ gr_on(); /* 9801 又は PC/ATグラフィックの起動 */ gr_window(left, bottom, right, top, 0, 0); /* 9801の640x400 又は PC/AT 640*480 の画面がこの値に設定されます */ p = x[0]; q = y[0]; for (i = 0; i < 5000; i++) { j = rand() / (RAND_MAX / N + 1); /* 0～N-1の乱数 */ q = c[j] * p + d[j] * q + f[j]; p = a[j] * p + e[j]; gr_wdot(p, q, WHITE); /* x座標 p y座標 q で白ドットプロット */ } hitanykey(); return EXIT_SUCCESS; }
Delphi Xeプログラム
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;
type
TForm1 = class(TForm)
Image1: TImage;
GroupBox1: TGroupBox;
x1: TLabeledEdit;
y4: TLabeledEdit;
x4: TLabeledEdit;
x2: TLabeledEdit;
x3: TLabeledEdit;
y3: TLabeledEdit;
y2: TLabeledEdit;
y1: TLabeledEdit;
GroupBox2: TGroupBox;
d3: TLabeledEdit;
d1: TLabeledEdit;
d2: TLabeledEdit;
Button1: TButton;
LabeledEdit1: TLabeledEdit;
LabeledEdit2: TLabeledEdit;
procedure Button1Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses system.Math;
procedure TForm1.Button1Click(Sender: TObject);
const
N = 3; // 0～3
xb = 50;
yb = 350;
var
x , y : array of integer;
a, c, d, e, f : array of double;
p, q, kc : double;
i, j, k : integer;
xi, yi : integer;
ch : integer;
ct : integer;
cp : Tcomponent;
mes : pchar;
begin
setlength(d, N);
for k := 0 to N - 1 do begin
cp := Findcomponent('d' + inttostr(k + 1));
val(Tlabelededit(cp).Text, d[k], ch);
if ch <> 0 then begin
mes := Pchar('d' + intTostr(k + 1) + 'の値に間違いがあります。');
application.MessageBox(mes,'注意',0);
exit;
end;
end;
setlength(x, N + 1);
setlength(y, N + 1);
for k := 0 to N do begin
cp := Findcomponent('x' + inttostr(k + 1));
val(Tlabelededit(cp).Text, x[k], ch);
if ch <> 0 then begin
mes := Pchar('x' + intTostr(k + 1) + 'の値に間違いがあります。');
application.MessageBox(mes,'注意',0);
exit;
end;
end;
for k := 0 to N do begin
cp := Findcomponent('y' + inttostr(k + 1));
val(Tlabelededit(cp).Text, y[k], ch);
if ch <> 0 then begin
mes := Pchar('y' + intTostr(k + 1) + 'の値に間違いがあります。');
application.MessageBox(mes,'注意',0);
exit;
end;
end;
for i := 0 to N - 1 do begin
if x[i] > x[i + 1] then begin
application.MessageBox('xの値の並びに間違いがあります。','注意',0);
exit;
end;
end;
val(Labelededit1.Text, ct, ch);
if ch <> 0 then begin
application.MessageBox('繰り返し回数の値に間違いがあります。','注意',0);
exit;
end;
if ct < 100 then begin
application.MessageBox('繰り返し回数の値が小さすぎます。','注意',0);
exit;
end;
if ct > 1000000 then begin
application.MessageBox('繰り返し回数の値が大きすぎます。','注意',0);
exit;
end;
val(Labelededit2.Text, kc, ch);
if ch <> 0 then begin
application.MessageBox('作図倍率の値に間違いがあります。','注意',0);
exit;
end;
if kc <= 0 then begin
application.MessageBox('作図倍率の値をゼロ以上にしてください。','注意',0);
exit;
end;
button1.Enabled := False;
application.ProcessMessages;
Image1.canvas.Brush.Color := clBtnface;
Image1.canvas.fillrect(rect(0, 0, image1.Width, image1.height));
// d[0] := 0.1; d[1] := 0.4; d[2] := -0.2;
// x[0] := 0; x[1] := 30; x[2] := 60; x[3] := 100;
// y[0] := 0; y[1] := 50; y[2] := 40; y[3] := 10;
// xyグラフ
Image1.canvas.Pen.Color := clBlack;
yi := yb - round(y[0] * kc);
xi := xb + round(x[0 ]* kc);
Image1.canvas.MoveTo(xi, yi);
for i := 1 to N do begin
yi := yb - round(y[i] * kc);
xi := xb + round(x[i] * kc);
Image1.canvas.LineTo(xi, yi);
end;
setlength(a, N);
setlength(c, N);
setlength(e, N);
setlength(f, N);
// アフィン変換
q := x[N] - x[0];
for i := 0 to N - 1 do begin
a[i] := (x[i + 1] - x[i]) / q;
e[i] := (x[N] * x[i] - x[0] * x[i + 1]) / q;
c[i] := (y[i + 1] - y[i] - d[i] * (y[N] - y[0])) / q;
f[i] := (x[N] * y[i] - x[0] * y[i + 1] - d[i] * (x[N] * y[0] - x[0] * y[N])) / q;
end;
// アトラクタプロット
p := x[0];
q := y[0];
Image1.canvas.Brush.Color := clRed;
for i := 0 to ct do begin
j := random(N);
q := c[j] * p + d[j] * q + f[j];
p := a[j] * p + e[j];
yi := yb - round(q * kc);
xi := xb + round(p * kc);
Image1.canvas.fillrect(rect(xi, yi, xi + 1, yi + 1));
end;
button1.Enabled := True;
end;
end.
Fractal_V0.zip
画像処理プログラム 作図 に戻る