Report Writing Interface (RWI)を試してみる
http://sasboku.blog.fc2.com/blog-entry-54.html
そして、そのSASNAMIさんに火をつけた張本人である忘備録のa.matsuさんはというと、以下のような記事を書いて、もう何か色々イっちゃってます。
RWIで迷路を作る
http://sas-boubi.blogspot.jp/2015/08/rwi.html
迷路作成プログラムできましたか、matsuさんが迷路をSASで生成するというのなら
それならば僕はその迷路を解くプログラムを書きましょう！
というわけで、どうやって解くかなのです。迷路解法アルゴリズムは色々あるみたいなのですが
今回はセルオートマトンというものを使って解いてみましょう。
迷路生成部分と、それをRWIで描画する部分は忘備録の丸コピでいかせていただきます。
※ちょっとだけ迷路のサイズを小さくしているのは、解法過程をGIFアニメにするのにデフォルトの設定でちょうど1枚に入りきる、いいサイズにしたかったからです。アルゴリズム的にはどんな巨大な迷路でも解けます。
%let n = 31;
%let init = 1234;
data DT1;
*** 全マス目分の配列を定義 ;
array AR(&n, &n) ;
*** 最初から壁にする部分を2に設定 ;
do y=1 to &n;
do x=1 to &n;
if x in (1,&n) or y in (1,&n) or mod(x*y,2)=1 then AR(x,y)=2;
else AR(x,y)=1;
end;
end;
*** 乱数を生成して壁の位置を決める ;
*** 壁の位置 1:上、2:下、3:右、4:左 ;
call streaminit(&init);
do y=3 to &n-2 by 2;
do x=3 to &n-2 by 2;
*** 1段目は上下左右の壁の乱数を生成 ;
if y=3 then do;
* 左のマスが壁だったら上下右のみの壁の乱数を生成 ;
if AR(x-1,y)=2 then RAND = ceil(rand('uniform')*3);
else RAND = ceil(rand('uniform')*4);
end;
*** 2段目以降は下左右の壁の乱数を生成 ;
if y^=3 then do;
* 左のマスが壁だったら下右のみの壁の乱数を生成 ;
if AR(x-1,y)=2 then RAND = ceil(rand('uniform')*2)+1;
else RAND = ceil(rand('uniform')*3)+1;
end;
if RAND=1 then AR(x,y-1)=2; * 上 ;
if RAND=2 then AR(x,y+1)=2; * 下 ;
if RAND=3 then AR(x+1,y)=2; * 右 ;
if RAND=4 then AR(x-1,y)=2; * 左 ;
end;
end;
run;
描画描画部分については、マクロ化しています。
%macro rwi(data=);
/*描画マクロ*/
data _NULL_;
length VAR1 $5.;
set &data;
array AR(&n, &n);
dcl odsout ob();
ob.table_start();
do y=1 to &n;
ob.row_start();
do x=1 to &n;
*** 壁と床を描画 ;
VAR1="";
if (x=2 and y=2) or (x=&n-1 and y=&n-1) then VAR1="☆";
ob.format_cell(data:VAR1, style_attr: "background=" || choosec(AR(x,y),"white","black") ||
" height=0.4cm width=0.3cm");
end;
ob.row_end();
end;
ob.table_end();
run;
%mend;
そして、ここからが解法部分のコードになります。
%macro automaton;
/*GIFアニメの開始設定*/
options ANIMATION=START ANIMDURATION=0.5 PRINTERPATH=GIF ;
ods printer file="/home/sasyamasasyama0/sasuser.v94/meiro.gif"; ;
/*初期局面の描画*/
%rwi(data=DT1)
/*世代データセットの作成*/
data _DT1(genmax=2);
set DT1;
run;
/*ループ脱出条件*/
%let stop = ;
%do %until(&stop=1);
data _DT1;
array AR(&n, &n);
set _DT1;
do i=2 to &n-1;
do j=2 to &n-1;
if ^(i=2 and j=2) & ^(i=&n-1 and j=&n-1) then do;
if sum(AR{i-1, j}=2 , AR{i+1, j}=2 , AR{i, j-1}=2 , AR{i, j+1}=2)=3 then AR{i, j}=2;
end;
end;
end;
run;
/*ハッシュオブジェクトのequalsメソッドで1世代前のデータセットと差があるかを0 1で判定する*/
data _null_;
if 0 then set _DT1;
declare hash hq1(dataset:'_DT1');
hq1.defineKey(all:'yes');
hq1.defineDone();
declare hash hq2(dataset:'_DT1(gennum=-1)');
hq2.defineKey(all:'yes');
hq2.defineDone();
hq1.equals(hash: 'hq2', result: FL);
call symputx('stop',FL);
run;
/*描画*/
%rwi(data=_DT1)
%end;
/*アニメ終了*/
ods printer close ;
options ANIMATION=STOP ;
%mend automaton;
/*マクロ実行*/
%automaton
結果は
静止画で初期局面と最終局面を見てみると
となって正解のルートだけが残ります。
本当はこの正解の結果を初期局面にもっていって、そのルートにだけ色つけようかと思いましたが
ちょっと面倒になったのでここまでで。
で、実は解法の肝は
if sum(AR{i-1, j}=2 , AR{i+1, j}=2 , AR{i, j-1}=2 , AR{i, j+1}=2)=3 then AR{i, j}=2;
の一行だけなんです。
要するに、あるセルがあって、そのセルの周囲3方向が壁である場合、そのセルは行き止まりであって正解の通路ではないことが確定するといえますよね？
じゃあ、そういうセルは壁にしてしまおうという発想です。それを何回も何回も繰り返します。
そうやって、行き止まりを次々壁に塗り替えていくことで、周囲3方向が壁ではないセルだけが残ります。つまり、正解のルートが浮かびかがってくるわけです。
ただ、このアルゴリズムは迷路に、複数の空白セルが広場のようになっていたり、本ルート以外の意味のないループ道があった場合、それを削ることができないものになっています。
迷路の世界も奥が深いんですね。
SAS的には何回もデータステップを繰り返して、同名のデータセットを上書きしまくってます。
ただし、(genmax=2) の設定により、更新の1つ前のデータセットをDT1(gennum=-1) と書くことで
取得できるようになっています。
更新しても、更新前と内容が変わらない イコール 正解の通路だけが残っているということなので
そうなったらループを抜けます。
今回は更新前後の比較にハッシュオブジェクトのequalsメソッドを使っています。これは僕が単にハッシュ好きということもありますが、今回はどこに差があったかはどうてもよくて、同じか否かだけを01でみたいので、compareプロシジャよりやりやすいと考えたからです
【参考】
ハッシュオブジェクトの世界⑦ コンペア革命 equalsメソッド
で、GIFファイルの作成部分については忘備録の記事をそのまま使わせていただきました。
SASでアニメーションを作る方法（SAS9.4以降）
う～ん、結局、人の褌で…みたいになってしまいましたが、まあ勘弁してください。
若干、ＧＩＩＦだとセルの大きさが乱れたりしてますが、何ででしょうかね。PDFじゃないから？？
まあ、遊びの出力なので大目にみてくださいな。
0 件のコメント:
コメントを投稿