FC2ブログ
2020年01月 / 12月≪ 12345678910111213141516171819202122232425262728293031≫02月

2009.11.01 (Sun)

告知

コメントの方法について。

2008.01.28 (Mon)

こないだの続き。(改訂)

program toi(input,output);
 
type
eletype = integer;
tree = ^cell;
cell = record
val : eletype;
left,right,parent : tree;
end;
 
var
root,t : tree;
x,sousa : integer;
 
procedure preorder(t : tree);
{前順探索法}
begin
if t <> nil then
begin
if t^.val <> 0 then
begin
write(t^.val);
if t^.parent = nil then writeln(':root') else writeln;
end;
preorder(t^.left);
preorder(t^.right);
end;
end; { preorder }
 
procedure inorder(t : tree);
{中順探索法}
begin
if t <> nil then
begin
inorder(t^.left);
if t^.val <> 0 then
begin
write(t^.val);
if t^.parent = nil then writeln(':root') else writeln;
end;
inorder(t^.right);
end;
end; { inorder }
 
procedure postorder(t : tree);
{後順探索法}
begin
if t <> nil then
begin
postorder(t^.left);
postorder(t^.right);
if t^.val <> 0 then
begin
write(t^.val);
if t^.parent = nil then writeln(':root') else writeln;
end;
end;
end; { postorder }
 
procedure create(var t : tree);
begin
t := nil;
end; { create }
 
function search(x : eletype ; t : tree ; var t2 : tree):boolean;
begin
if t = nil then search := false
else if x = t^.val then
begin
search := true;
t2 := t;
end
else if x < t^.val then search := search(x,t^.left,t2)
else search := search(x,t^.right,t2);
end; { search }
 
procedure insert(x : eletype; var t : tree;root : tree);
var
t2 : tree;
begin
if search(x,t,t2) then writeln('すでに登録されている数字です') else
begin
if t = nil then
begin
new(t);
t^.val := x;
t^.left := nil;
t^.right := nil;
if root <> nil then t^.parent := root;
end
else if x < t^.val then insert(x,t^.left,t) else insert(x,t^.right,t);
end;
end; { insert }
 
function min(t : tree;var t2 : tree):eletype;
begin
while t^.left <> nil do t := t^.left;
min := t^.val;
t2 := t;
end; { min }
 
procedure disp(var t : tree);
begin
t^.val := 0;
t^.right := nil;
t^.left := nil;
end; { disp }
 
 
procedure shoukaku(x :eletype; var t : tree);
var
t2,t3 : tree;
begin
t2 := t^.parent;
if t2^.left <> nil then
begin
t3 := t2^.left;
if (x = t3^.val) then
begin
if t^.left <> nil then t2^.left := t^.left else t2^.left := t^.right;
end
else
begin
if t^.left <> nil then t2^.right := t^.left else t2^.right := t^.right;
end;
end
else if t^.left <> nil then t2^.right := t^.left else t2^.right := t^.right;
 
end; { shoukaku }
 
procedure display(t : tree);
begin
writeln('-------------------------------------');
writeln('前順探索法');
preorder(t);
writeln('-------------------------------------');
writeln('中順探索法');
inorder(t);
writeln('-------------------------------------');
writeln('後順探索法');
postorder(t);
end; { disp }
 
 
procedure delete(x : eletype ;var t : tree);
var
t2,t3 : tree;
begin
if search(x,t,t2) then
begin
if ((t2^.right = nil) and (t2^.left = nil)) then disp(t2)
else if (t2^.right = nil) or (t2^.left = nil) then shoukaku(x,t2) else
begin
t2^.val := min(t^.right,t3);
if ((t3^.right = nil) and (t3^.left = nil)) then disp(t3)
else if ((t3^.right = nil) or (t3^.left = nil)) then shoukaku(x,t3);
end;
end
else
begin
writeln('削除すべき値が見つかりません.');
writeln;
end;
end; { delete }
 
begin
create(root);
create(t);
repeat
writeln;
writeln('操作を選択してください(数字を入力).');
writeln('1:要素を追加');
writeln('2:要素を削除');
writeln('3:木の状態を表示');
writeln('0:プログラム終了.');
writeln('-------------------------------------');
readln(sousa);
if sousa = 1 then
begin
writeln('-------------------------------------');
repeat
writeln('追加する数字を入力.終了は0を入力.');
readln(x);
root := t;
if x <> 0 then insert(x,t,root);
until x = 0;
writeln('-------------------------------------');
end
else if sousa = 2 then
begin
writeln('-------------------------------------');
repeat
writeln('削除する数字を入力.終了は0を入力.');
readln(x);
root := t;
if x <> 0 then delete(x,t);
until x = 0;
writeln('-------------------------------------');
end
else if sousa = 3 then
begin
writeln('-------------------------------------');
display(root);
writeln('-------------------------------------');
end
else if sousa <> 0 then writeln('値が不正です.確認してください.');
until sousa = 0;
writeln;
writeln('終了します。');
writeln('-------------------------------------');
end.
 
完成版。
課題内容は、
2分探索木(2進木/2分木)の削除をpascalで作成しなさい。
ということで。
はい、以上の通り完成。
全く大変だった。親の実装が意外に疲れた。
こないだのGoogleで二分木の削除のアルゴリズムを探してた人が来てたとしたら、参考になさってください。一応動くと思いますが、幼稚なプログラムになってしまったので、責任はとりませんww
これから、授業だなぁ……。
 
改訂(29日11:55)
普通に間違ってた。
Procedure deleteのif search(x,t,t2)文の中。
t2^.val := min(t,t3);
が、
t2^.val ;= min(t^.right,t3);
だった。
右部分木の中で最小のものだった。部分木の中で最小のものではない;
全く阿呆だった。提出前に気がついてよかった。
 
そして、もう一つ。
Procedure shoukakuが間違ってた。
ポインタの指定が違っていたので、、、運良くあうときもあるけど、基本的に二分木の構造を破壊してしまうとという致命的なエラー。もうだめぽ。
16:00  |  diary  |  TB(0)  |  CM(4)  |  EDIT  |  Top↑

*Comment

ちょっとアルゴリズム勉強しましたよwww

リニアサーチやらバイナリーサーチやらwwww


こっちは画像が重くなりすぎて表示が間に合わない段階にwww
孝之 |  2008.01.30(水) 19:46 |  URL |  【コメント編集】

>>孝之さん
画像処理のプログラムなんでしょうかー?
openGLに対応して、Quadroで処理とかwww
ふゆつきあおい |  2008.01.30(水) 21:36 |  URL |  【コメント編集】

今やってるのは画像処理です

ゼンブpov-rayってやつで
座標とか立体をタグでうって
それを読み込ますんですけど

1つの町を表示させるのに25分w
孝之 |  2008.01.31(木) 00:35 |  URL |  【コメント編集】

>>孝之さん
25分とかww 待てないなぁw
昼前に実行して、昼ごはん後に完成くらいの時間ですね;
あなたもそのうち、小牧愛佳とか立体化させて、躍らせるようになるんでしょうねw
ふゆつきあおい |  2008.02.01(金) 00:37 |  URL |  【コメント編集】

コメントを投稿する

URL
COMMENT
PASS  編集・削除するのに必要
SECRET  管理者だけにコメントを表示  (非公開コメント投稿可能)
 

▲PageTop

*Trackback

この記事のトラックバックURL

→http://iceuecmizuki.blog67.fc2.com/tb.php/312-ae41b23d

この記事にトラックバックする(FC2ブログユーザー)

この記事へのトラックバック

▲PageTop

 | BLOGTOP |