gsubmitでSASメニューをカスタマイズしたおす話

ちょっと身の回りで色々とあったりしてすっかり更新が滞ってしまってました。
僕自身は相変わらず元気です。
連絡いただいているのに返せていない方、ごめんなさい。少し落ち着いたので徐々に
返信させていただきます。不義理な真似してすみませんでした。

あと、掲示板の方を、amatsuさんに丸投げしているようで、本当にすみません。
いつも見てはいるんですが、ついつい甘えてしまってました。

さて、いつものことですがかなり需要のない話をします。

なんかデータセットがあったとして

data Q1;
x=1;y='A';output;
x=2;y='B';output;
run;


それをSAS上で、選択して右クリックすると以下のようなメニューがでてきます。



これ見て、「もっとマシなメニューにしろよ」って怒りを感じるのは、捻くれた僕だけですか?

しかもEXCELで表示とかいいながら、内部的に実行されているコードは以下のとおりで
filename _temp_ "XXXX.xls";
ods noresults;
ods listing close;
ods html file=_temp_ rs=none style=minimal;
   proc print data=Work.'Q1'N label noobs;
   run;
ods html close;
ods results;
ods listing;
filename _temp_;

ods htmlで無理やりだしてるだけやん。って感じですね。純粋なEXCELじゃないから
警告出てきてうざいし、そのまま人にだすのがためらわれて嫌なんです。

とはいえ、ここのメニューをどうこうしたりとかは SAS/AF みたいなアプリケーション開発用の
ライセンスないとできないんでしょって思ってました。

ところがなんとできたんです。

手順は「えぇ?」って感じなんですが、覚えれば簡単です。
(9.4は試してないのでわからないのですが9.13-9.3までは以下の手順でできるはずです)

まず、拡張エディタがアクティブな状態で
ツールバーの「表示」で「コンテンツのみ」をクリックします。何もおきませんけど必要なんです



次に「ツール」で「オプション」→「エクスプローラ」を選択します
※この「エクスプローラー」はコンテンツのみを選択した直後しか表示されない
隠し項目になります



ここで「メンバー」タブの「テーブル」を選択して、「編集」ボタンをおします




そこで「追加」をクリックします



アクションの部分に「FREQプロシージャにかける」
アクションコマンドの部分に以下のコードを書いてください。



gsubmit "proc freq data=%8b.'%32b'N;run;"

あとはOK OK OKでウインドウを閉じます。

そしたら、再度さっきのデータセットを選択して、右クリックします。

すると以下のようにメニューが追加されていることがわかります。






















そしてそれを実行してみると、



のように選択したデータセットがFREQプロシージャにかけられました。


これを応用すれば色々できます。
たとえば、さっき文句をつけたエクセル表示の場合

アクション「ちゃんとしたEXCELで表示」
アクションコマンド「
gsubmit "proc export data= %8b.'%32b'N outfile= 'c:\tmp.xlsx' dbms=excel label replace;newfile=yes;run;options noxwait noxsync;x 'c:\tmp.xlsx';"

とすれば、proc exportで出力したEXCELファイルが開きます
(そもそもproc exportの仕様自体に言いたいことは多いですが...)

で、肝心のアクションコマンドの書き方ですが
%8b.'%32b'Nで、ユーザーが選択したライブラリの選択したデータセットみたいな意味になります。
ここを普通のデータセット名前にしてしまうと、どれ選んで実行しても同じデータセット開いちゃいますからね。

で、どうもアクションコマンドは255までしか記述できないみたいです。
あとマクロを中で使いたい場合は%%testのように%を二度付けするとうまくいくようです。

このあたりに詳しい方がいれば逆に教えてください。情報なさすぎです。

ちなみに、この変の話は、大昔にもちょっと触れていたことがありましたので参考まで

〔記事〕
SASデータセットを開いた時にラベル名ではなく変数名を表示するのをデフォルト設定にする
http://sas-tumesas.blogspot.jp/2013/09/sas_20.html

また、当分、更新ペースはこんな感じか、下手したらさらに遅くなると思いますが
来年もよろしくお願いします

standardプロシジャやstdizeプロシジャで色んな標準化の話

なんかスコアデータみたいのがあって、最低スコアを0にして
最大スコアを100になるように値を変換してということがありました。

z得点だしたり、偏差値だしたり、はしょっちゅうするんで同じノリでproc standardでできるかなと
思ったけど、よく考えてみると、あれ?ってなりました。

proc standardで行ういわゆる標準化は、平均と標準偏差が一定の値になるように変換するわけで
今回みたいに無理やり最低値と最高値を決まった上限下限値にするのと全然違うよな~、平均も標準偏差も
使わないし。

もういいや~、面倒だからsummaryで各変数の最大、最小だして
変換値 =(元の値 - 最小値) / (最大値 - 最小値) * (設定上限値 - 設定下限値 ) + 設定下限値
でデータステップで片づけてしまいました。

で後で、対応するプロシジャってなんになるんだろう、多分stdizeだろうなと思って調べると
やぱりstdizeでした。

stdizeは広い意味での様々な標準化変換を行えるもので、かなり奥が深いです。

さわりだけ見てみましょう

今、以下のようなデータがあります

data q1;
x=1;y=20;z=-5;output;
x=6;y=10;z=5;output;
x=4;y=0;z=-1;output;
x=8;y=0;z=-3;output;
x=2;y=100;z=8;output;
run;











とりあえず基本統計量を見てみましょう
proc means data = q1  n mean std max min median sum maxdec=3;
run;








例えば、データを中心化したいから、平均0に寄せてと言われたら
以下のように各変数の平均を引けばいいわけです。

data q2;
set q1;
 x = x - 4.2;
 y = y - 26;
 z = z - 0.8;
run;

中身と統計量は以下になります。ちゃんと0になってますね

これをstandardプロシジャで行う場合は以下のように書きます
m=0というのが平均0にしている部分ですね

proc standard data=q1 out=a1 m=0;
 var x y z;
run;





















同じ結果になることが確認できました。

次はいわゆる偏差値です std=は標準偏差の指定です
proc standard data=q1 out=a2 m=50 std=10;
 var x y z;
run;

確認






















つづいてm=0 std=1 でz得点 標準得点ってやつですね
proc standard data=q1 out=a2 m=0 std=1;
 var x y z;
run;





















さて一方stdizeプロシジャとはなんなのかという話で、
まずは以下のように何も指定せずにまわしてみます

proc stdize data= q1 out = a3;
 var x y z;
run;




















さっきstandardプロシジャでzスコアだしたのと同じですね。
つまり何も指定しないとデフォルトで標準得点に変換するということがわかりました

実は、何も指定しなかった場合、内部的には以下のコードを実行しているのと同じになります

proc stdize data= q1 out = a3
 method=std
 add =0
 mult=1
;
 var x y z;
run;

method=std というのが標準偏差を使った標準化(変な言い方ですが)であること
add はこの場合、指定する平均
multiは指定する標準偏差になります

ですので偏差値をだすのであれば以下のようにかけます。
methodは省略可です。


proc stdize data= q1 out = a4
 method=std
 add=50
 mult=10
;
 var x y z;
run;



さて、ここまでだとstandardプロシジャと何が違うんだという話ですが
stdizeの味噌はmethod=の箇所にいろいろ指定できて、広い意味でのいろんな基準化ができるというところです

例えば冒頭の例のように0から100にデータを変換する場合

変換値 =(元の値 - 最小値) / (最大値 - 最小値) * (設定上限値 - 設定下限値 ) + 設定下限値にしたがって


data q3;
set q1;
x = ( x - 1 ) / ( 8 - 1 ) * (100 - 0) + 0;
y = ( y - 0 ) / ( 100 - 0 ) * (100 - 0) + 0;
z = ( z -(-5) ) / ( 8 - (-5) ) * (100 - 0) + 0;
run;

と書くところを、stdizeであれば以下のようにできます
mehodがrangeになっているところがポイントです

proc stdize data= q1
out = a5
        method=range
add = 0
mult = 100
;
 var x y z;
run;

結果は同じで




















最低値20 最大値100であれば

data q4;
set q1;
x = ( x - 1 ) / ( 8 - 1 )  * (100 - 20) + 20;
y = ( y - 0 ) / ( 100 - 0 ) * (100 - 20) + 20;
z = ( z -(-5) ) / ( 8 - (-5) ) * (100 - 20) + 20;
run;

を以下のように指定できます。
proc stdize data= q1
out = a6
        method=range
add = 20
mult = 80
;
 var x y z;
run;





















stdizeプロシジャの挙動は、わかると明快で
一貫した以下のルールに従って変換を行うんですね。

変換値 = add指定値 + mult指定値 ×[(元の値 - location(method毎に決まってる)/scale(method毎に決まってる]

method=stdの場合locationは平均値 scaleは標準偏差になります
method=rangeの場合locationは最小値 scaleはレンジになります

メソッドごとのlocationとscaleの設定は以下にまとまっております
http://support.sas.com/documentation/cdl/en/statug/63033/HTML/default/viewer.htm#statug_stdize_sect012.htm

methodに関わらず addのデフォルトは0 multのデフォルトは1になります。

なので、例えば中央値を使って標準化をする場合

proc stdize data= q1
out = a7
    method=median
add = 50
;
 var x y z;
run;




















最後に平均と標準偏差を使った標準化に対して
ノンパラ版として平均の代わりに中央値、標準偏差の代わりに正規化四分位範囲を使った方法が工業分野とかでよくあるらしいです。
すみません、まったくアホなんで詳しくないですが

四分位範囲はmethod=IQR で指定できるので、それに正規化のnormオプションを付けて

proc stdize data= q1
out = a8
    method=iqr
norm
;
 var x y z;
run;
















な感じですかね


ユニークなIDとか作れって言われたらの話

多分需要ないし、方法に工夫もないけど、与えらえた文字列から指定の長さで
ユニークなIDを作成するマクロです。

すでに発行済のIDが入ったデータセットを指定することで
過去に発行したものとも重複しない作成が可能です。

使用可能文字の数と、作成IDの長さの設定によって、生成できるIDの限界数が
決まります。
例えば100万の生成限界なのに90万のIDを発行したりすると実行効率遅いです。
生成限界はできるだけ余裕を持たせてください。

アルゴリズムは単純ですが
生成限界がぶっとんだ値であれば、何十万発行しようが結構速いと思います。

すでに存在するデータセットに付与して作りたい場合は
マクロをちょっと書き換えてsetをいれて、do untilのループをとっちゃえばいいです。


%macro unique_make(outds=,obs=,idlength=,seed=,moji=,ban=);
/*--------------------------------------------------------
outds=作成されるデータセット
obs =作成するオブザベーション数
idlength=作成される文字列の長さ
seed =作成のための乱数シード
moji =使用する文字列(半角英数字)
ban  =データセット指定(ここにあるidは作成されない)
----------------------------------------------------------*/
data &outds(keep = id);
length id $&idlength..;
if _N_ = 1 then do;
declare hash h1
%if %length(&ban) =0 %then %do;();%end;
%else %do;(dataset:"&ban");%end;
h1.definekey('id');
h1.definedone();
end;
x="&moji";
n=length(x);
kumi=n**&idlength;

put 'NOTE:与えられた文字の数は ' n;

put 'NOTE:生成限界は ' kumi;

call streaminit(&seed);

do until(obs=&obs);
do until(okfl=1);
do i = 1 to &idlength;
r=int(rand('uniform') * n +1);
id = cats(id , char(x,r));
if i = 5 then do;
if h1.check() ne 0 then do;
okfl=1;
h1.add();
output;
obs+1;
end;
else id='';
end;
end;
end;
end;
run;
%mend;

以下実行例です。


/*英数字で5桁のIDを10000発行*/

%unique_make(outds=A1
 ,obs=10000
 ,idlength=5
 ,seed=2345
 ,moji=abcdefghijklmnopqrstuvwxyz0123456789
);

/*先に発行したA1とかぶらないようにさらに10000発行*/

%unique_make(outds=A2
 ,obs=10000
 ,idlength=5
 ,seed=6789/*シード変えた方がよい*/
 ,moji=abcdefghijklmnopqrstuvwxyz0123456789
 ,ban=A1
);

引数指定の際のofとカンマ区切りの細かい話

最近ちょっと更新が途絶えてましたが元気です。

さて、昔、人にプログラムをあげた時に
s = sum(of a -numeric- e) ;
みたいな書き方を入れていたんですが、なんですかこれ??って
質問が来たことがあります。

特定の関数で、複数の引数を指定するときの方法として
カンマで区切って列記する方法と、ofで指定する方法があります
(併用もできます)。

が、うっかりしていると慣れた人でもハマりやすい罠があるので
おさらいしてみようと思います。

テストデータ

data Q1;
 x1=1;x2=2;x3=3;x4=4;x5=5;
run;

まずは基本。
x1からx5まで全部の合計をだすには例えば以下のように書きます。

data A1;
 set Q1;
 y1 = sum(x1,x2,x3,x4,x5);
 y2 = sum(of x1-x5);
 put (y1-y2) (=/);
run;

ログに
y1=15
y2=15

とでます。あってます。

y1は基本で、対象の変数を全部カンマ区切りで指定します。
y2はofを使用しています。
これから詳しく見ていきますが、ofを使うと

①of x1-x10  (変数の末尾の連番指定)
②of id--y (データセットの格納順 idからyまでの間にある変数全部)
③of _all_ や of _numeric_; や of _character_;(全変数や全数値変数や全文字変数)
④of ax{*} (配列を指定)
⑤of x: (コロンモディファイア指定→xから始まる変数名のもの全て)
⑥of x1 x3 x5 (変数列記 変数だけでなく①から⑤までのものを全て空白区切りで列記できる)

といった指定が可能になります(他にもあったら教えてください)。

で、とても便利なのですが、よくやってしまうのが

data A3;
 set Q1;
 y3 = sum(x1-x5);
 put y3=;
run;

結果は
y3=-4

なんで値がマイナスになっているかというと
of をつけないと x1からx5を引いた単一の値がsum関数の対象になってしまってるんですね。

続いて、複数の変数リストを指定する場合ですが

data A4;
 set Q1;
 y4 = sum(of x1-x2 x4-x5);
 y5 = sum(x1-x2 , x4-x5);
 y6 = sum(of x1-x2 , of x4-x5);
 y7 = sum(of x1-x2 , x4 , x5);
 put (y4-y7) (=/);
run;

結果は
y4=12
y5=-2
y6=12
y7=12

y4のようにof の後、空白でリストを区切ればOKです。
先ほどと同様にy5のようにしてしまうと x1引くx2とx4引くx5の値の合計値がでてしまいます。
意外と盲点なのが、y6のようにカンマで区切っても、その中ごとにofをつけてやれば
コードとして正しいということなんですね。
同様にy7のようにof指定とカンマ区切りを併用することもできます。
y4のようにカンマつけなきゃ一つのofで済む話なのに、なんで敢えてこういうことを書くかというと
例えば、プログラム仕様書の条件式や指定変数からコードを自動生成したりする場合、
仕様書の記載法と生成ロジックを考えなきゃいけないわけですが、そういう時に
こういう書き方でも式が正しく成立している(していない)といったケースを多く知ってると意外と役立つと思います。

で、次は、対象の変数に個々にマイナスをかけて合計したい場合です。
質問方向が反転の項目とかでそういうことありますよね。

以下を実行すると

data A5;
 set Q1;
 y8 = sum(-x1,-x2,-x3);
 y9 = sum(of -x1 -x2 -x3);
 put (y8-y9) (=/);
run;

結果は
y8=-6
y9=.

となってy8は正しいですがy9は正しく計算されません。
ofの場合、カンマ区切りと違ってマイナスつけはできないのです。

マイナスつけができないというより、もっと広く言えば
以下のように

data A6;
 set Q1;
 y10 = sum(x1+x2,x1*x2);
 y11 = sum(of x1+x2 x1*x2);
 put (y10-y11) (=/);
run;

結果は(y11のせいでエラーになりますが個別にだすと)

y10=5
y11=.

つまり、ofは変数の一括指定のためのキーワードで計算式を引数には
とれないうことです


さて次は、of使うといろいろできるよという例ですね

data A7;
 set Q1;
 array x{*} x: ;
 y11 = sum(of x{*});
 y12 = sum(of x{*} , x2 , of x3-x5  , of x:);
 put (y11-y12) (=/);
run;

結果
y11=15
y12=44

y11についてはカンマで区切らなければofは一個で、後は空白区切りでOKですからね。


最後は冒頭で述べた例に戻ります。
以下のテストデータがあり

data Q2;
 a=1;b=2;c=3;d='AAA';e=4;
run;

--を使うことによって変数の格納順を利用できます。

data A8;
 set Q2;
 y13= sum(of a--c);
 put y13 = ;
run;

結果
y13=6

で、以下の例のy13のように_numeric_としてデータセット内の
全数値型変数を対象にできるのですが、

さらにそれを--と組み合わせてy14のようにかくと


data A9;
 set Q2;
 y14 = sum(of _numeric_);
 y15 = sum(of a -numeric- e);
 put (y14-y15) (=/);
run;

y14=10
y15=10

aからeの間に格納されている変数のうち、数値型のものに
限るという指定ができます。

ながながと細かい話でした

自分のことだけ考えるマクロと相手のことも考えるマクロを対戦させて遊ぶ。ミニマックス法とかの話

今回もかなり役に立たない、書いてる僕だけが楽しい話になります。

例えば、しりとりをして15往復した時点で使用した言葉の文字数合計で勝負をするゲームがあるとします。
ただし通常のしりとりと違って、末尾に「ん」がついたら負けというのは無しにします。

さて、これをSASプログラムでやる場合、どういうロジックで言葉を選べばいいでしょうか?
単純に考えれば、出しうる言葉の中で一番長いやつを選んでいけばよさそうですね。
それじゃあ、やってみましょう。

プログラムは無駄に長いので読み飛ばしてください。
まず、以下のマクロを実行します。このマクロ%deep0は入力ワードを受け取って
そのお尻の1文字をとり、そこから始まる言葉で一番文字数が多いものを返すマクロです。
選択肢が複数ある場合は乱数で決めます。

%macro deep0(sente=Y);
/*先は読まずにとにかく一番長い言葉を選ぶマクロ*/

%let time = %eval(&time+1);

/*詰まされていないか判定*/
proc sql noprint;
 select count(*) into :obs
 from dic
 where atama = first(reverse("&in_word"));
quit;

%if &tumi ne Y %then %do;
 %if &obs > 0 %then %do;
 data minmax;
  length text1 $32.;
  set dic ;
  where atama = first(reverse("&in_word"));
  text1 = text;
  score1 = len;
  siri = first(compress((reverse(text1))));
  drop text atama siri len;
 run;

 data time&time._hyouka;
  set minmax;
  call streaminit(&seed);
  ransu = rand('uniform');
 run;

 proc sort data = time&time._hyouka;
  by descending score1 ransu;
 run;

 data _null_ ;
  set time&time._hyouka;
  if _N_=1 then do;
   call symputx( 'in_word' ,text1,'g');
   %if &sente = Y %then %do;
    call symputx( 'p1_score' ,score1+&p1_score ,'g');
   %end;
   %else %do;
    call symputx( 'p2_score' ,score1+&p2_score ,'g');
   %end;
  end;
 run;

 %put 選択したワード &in_word ;
 %put 現在の先手得点 &p1_score ;
 %put 現在の後手得点 &p2_score ;
 data temp;
 length time 8.  ban $4. word $32.;
     ban = ifc(mod(&time,2) = 1 ,'先','後');
  time = &time;
  word = "&in_word";
  p1_score = &p1_score;
  p2_score = &p2_score;
  output;
 run;

 proc append base = kekka data=temp;
 run;

 data dic;
  set dic;
  where text ne "&in_word";
 run;
 %end;


 %else %do;

  %let tumi=Y;

  %if &sente = Y %then %do;
    %let p1_score = -9999;
  %end;
  %else %do;
    %let p2_score = -9999;
  %end;

  %put 選択したワード ワード切れ負け ;
  %put 現在の先手得点 &p1_score ;
  %put 現在の後手得点 &p2_score ;

  data temp;
  length time 8.  ban $4. word $32.;
      ban = ifc(mod(&time,2) = 1 ,'先','後');
   time = &time;
   word = "切れ負け";
   p1_score = &p1_score;
   p2_score = &p2_score;
   output;
  run;

  proc append base = kekka data=temp;
  run;

 %end;
%end;

%mend deep0;


そしたら、以下の対戦マクロに設定をいれて、実行します。
今回は、ワードのもとをSAS関数の名前にします。なのでアルファベットでしりとりです。
※SASのバージョンによってSASHELPライブラリの関数テーブルに入っているデータが違うので
実行環境によって結果が違います。

ちなみに一度使った言葉は使用できず、もし選択できる言葉がなくなった場合はその時点で負けです。
そのルールで、先ほどの%deep0同士を対戦させてみましょう。
最初に与える言葉は最近忘備録で取り上げられていたSCAN関数にしてみます。

%macro battle;
 /*-----------------------
     対戦設定&実行マクロ
 -------------------------*/

 %global time tumi p1_score p2_score in_word;

 %let in_word = SCAN; /*最初の言葉*/
 %let p1_score=0;    /*先手のハンデ*/
 %let p2_score=0;    /*後手のハンデ*/
 %let endturn = 15;   /*何周で終わるか*/
 %let seed=777;      /*同じ評価値の場合、どの言葉を選ぶかの乱数シード*/

 /*前回までの結果をリセット*/
   proc datasets lib=work kill memtype=data;
   run;
   %let tumi = ;/*ワード切れによる負け判定フラグ*/

 /*使用辞書*/
 data dic;
  set sashelp.vfunc;
  where fncname ne '';
  text=upcase(fncname);
  atama=first(text);
  siri=first(compress(reverse(text)));
   len=length(fncname);
   if input(siri,?? best.) in (0:9) then delete;/*数字で終わる関数は除外*/
  keep  atama text len siri;
 run;

 %let time = 0;/*何手目*/

 /*ここで対戦させるマクロを指定*/
 %do %while(&time < &endturn * 2 and &tumi =  );
  %deep0(sente=Y)
  %deep0(sente=N)
 %end;

%mend battle;

/*実行*/
%battle

結果(データセットkekka)をみてみると、選択された言葉と、その時点の先手後手の点数が入ってます。
まず1手目、先手はNLMYDESC関数を選び、9文字なのでスコアは9です。そして2手目、後手はCから始まる関数ということでCOMPANION_NEXT関数という14文字のものを選んでスコア14です。


最終的にどうなったかをみると
























30手の終了時点で、先手が178点、後手が188点で後手の勝ちということになります。


ちなみに先手後手それぞれが各手番で、なぜその言葉を選んだかの思考ログの中身は
手番ごとにデータセットに入ってます





















例えば、一手目先手がNLMYDESC関数を選んだのか、データセットTIME1_HYOKAをみてみると

Nから始まる関数は41個(画像は途中まで)ありますが、その中で一番長いのは9文字で、あとはたまたま乱数が一番小さい先頭レコードがNLMYDESC関数だったから選ばれたということがわかります。



























さて、今回は先手が微差で負けてしまいました。開始する言葉を変えたり、乱数を変えれば結果は変わるでしょう。しかしここで、そういった条件は変えずに、アルゴリズムを改良して先手を勝ちに導くことはできないでしょうか?
あなたなら、どのようなロジックで常に最高得点で返してくる敵を倒しますか?

今回は、1手相手の手を先読みしてミニマックス法で評価値をだしてそれによって指してを決定するということを考えてみましょう。

ミニマックス法とは、想定される最大の損害が最小になるように決断する方法と説明されます。
わかりにくいので、実装用に方向を揃えたネガマックス法で説明すると、要するに自分も相手もお互いにとっての最高得点の手を選択するとして、自分の得と相手の得の差が最大の手を選べば勝てんじゃね?っていう割と当たり前の発想です。
例えば自分が10点の手を指しても、その次に相手が11点の手をさせる手が予想できるなら、それよりも自分が9点の手であっても、その次に相手が8点しか返せない手を優先させるべきでしょって感じです。

実際につくってみましょう

以下のような感じになりました。
マクロ名は%deep1です。

%macro deep1(sente=Y);
/*1手先を読むマクロ*/

%let time = %eval(&time+1);

/*詰まされていないか判定*/
proc sql noprint;
 select count(*) into :obs
 from dic
 where atama = first(reverse("&in_word"));
quit;

%if &tumi ne Y %then %do;
 %if &obs > 0 %then %do;
 data minmax;
  length text1 text2 $32.;
  set dic ;
  where atama = first(reverse("&in_word"));
  if _N_ = 1 then do;
   declare hash h1(dataset:'dic',multidata:'Y');
   h1.definekey('atama');
   h1.definedata('text','len','siri');
   h1.definedone();
  end;

  text1 = text;
  score1 = len;
  siri = first(compress((reverse(text1))));
  rc = h1.find(key:siri);
  if rc ^= 0 then do;
   text2="";
   score2=9999;
   output;
  end;
  if rc = 0 then do;
   text2=text;
   score2 = -1 * len;
   output;
   do while(rc=0);
    rc=h1.find_next(key:siri);
    if rc = 0 then do;
     text2=text;
     score2 = -1 * len;
  if text1 ne text2 then output;
    end;
   end;
  end;
  drop rc text atama siri len;
 run;

 data minmax2;
  set minmax;
  myscore = 0;
  yourscore=0;
  array ascore{*} score:;
  do i = 1 to dim(ascore);
   if mod(i,2) = 1 then do;
    myscore + ascore{i};
    if myscore >= 9999 then ascore{i} = 9999;
   end;
   if mod(i,2) = 0 then do;
    yourscore + -1*ascore{i};
    if yourscore <= -9999 then ascore{i} = -9999;
   end;
   if i + &time > &endturn * 2 +1 then ascore(i) = .;
  end;
  call streaminit(&seed);
  ransu = rand('uniform');
  total = sum(of score:);
  drop i;
 run;

 proc sort data = minmax2;
  by text1 descending score1 score2;
 run;
 data time&time._hyouka;
  set minmax2;
  by text1 descending score1 score2;
  if first.text1;
 run;
 proc sort data = time&time._hyouka;
  by descending total ransu;
 run;
 data _null_ ;
  set time&time._hyouka;
  by descending total ransu;
  if _N_=1 then do;
   call symputx( 'in_word' ,text1,'g');
   %if &sente = Y %then %do;
    call symputx( 'p1_score' ,score1+&p1_score ,'g');
   %end;
   %else %do;
    call symputx( 'p2_score' ,score1+&p2_score ,'g');
   %end;
  end;
 run;

 %put 選択したワード &in_word ;
 %put 現在の先手得点 &p1_score ;
 %put 現在の後手得点 &p2_score ;
 data temp;
 length time 8. ban $4. word $32.;
     ban = ifc(mod(&time,2) = 1 ,'先','後');
  time = &time;
  word = "&in_word";
  p1_score = &p1_score;
  p2_score = &p2_score;
  output;
 run;

 proc append base = kekka data=temp;
 run;

 data dic;
  set dic;
  where text ne "&in_word";
 run;
 %end;


 %else %do;

  %let tumi=Y;

  %if &sente = Y %then %do;
    %let p1_score = -9999;
  %end;
  %else %do;
    %let p2_score = -9999;
  %end;

  %put 選択したワード ワード切れ負け ;
  %put 現在の先手得点 &p1_score ;
  %put 現在の後手得点 &p2_score ;

  data temp;
  length time 8.  ban $4. word $32.;
      ban = ifc(mod(&time,2) = 1 ,'先','後');
   time = &time;
   word = "切れ負け";
   p1_score = &p1_score;
   p2_score = &p2_score;
   output;
  run;

  proc append base = kekka data=temp;
  run;

 %end;
%end;


%mend deep1;

そして先述の%battle内の、先の%deep0マクロを%deep1(sente=Y)として、実行すると
結果は

















































最終的に%deep1の先手150点と%deep0の後手107点で、1手先読みするマクロが勝利しました。

例えば、初手を見てみるとNから始まる言葉の最大は9文字のものがあるはずですが、敢えて8文字のNHOLIDAYを選択しています。なぜかは先ほどと同じくデータセットTIME1_HYOKAを開いてみると




























先ほど%deep0で先手をやった際に選択していたNHOLIDESC関数は優先順位として9番目の位置になっています。何故かというと、確かに選択すると自分に9点入るのですが、その次の相手のターンでCから始まる関数にCOMPANION_NEXTという14文字のものがあるため
9 - 14でトータル-5点で、自分が不利になると評価したからです。
これを見ると1手目でNHOLIDAYかNHOLIDLENを選べば、評価値は0で、少なくとも不利にならないということがわかるわけです。


さて、まあ今回の例の場合、ワードもとにしているデータが小さいことから、割と一本道の変化が多く、開始する言葉によっては先読みしてても負けるケースは多々あります。

開始語をランダムに変えて、何回も勝負させて、1手先読みによって勝率がどれくらい上がるかをっ測ろうかとも思いましたが、もう充分長い記事になったのでこの辺にしておきます。



SASで作った迷路をSASで解いてやったぞ!誰もそんなこと求めてないのは知ってるけどね!な話

ブログ「僕の頁 <SASと臨床試験と雑談と>」のSASNAMIさんも最近RWIに手をだされて、のっけから素晴らしい記事を書かれてます。

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以降)

う~ん、結局、人の褌で…みたいになってしまいましたが、まあ勘弁してください。

若干、GIIFだとセルの大きさが乱れたりしてますが、何ででしょうかね。PDFじゃないから??
まあ、遊びの出力なので大目にみてくださいな。


smoothconnectでSG系グラフの線を滑らかにする話

最近、エクセルで滑らかな曲線の折れ線グラフを書いてる人がいて、「へ~、そんなんできるんだ」と言うと、「は?そんなんも知らないんですか?」と馬鹿にされました。

だって、最近のエクセルあんまりよく知らないしと言うと、「スムージングにチェック入れるだけだし、2003とかでもありましたけど?」とさらに馬鹿にされました。

挙句に「SASではどう書くんですか?」と聞かれ「え、そんなんできたかな?ちょっとわかんない」と答えると、「SASが書けるだけが取り柄なのに全然駄目じゃないですか」と軽蔑の眼差しを向けられてしまいました。

家に帰って、泣きながら調べてみると、あったよ、smoothconnectオプション。
でも9.4からか、結構最近だなぁ。

適当にデータ作って

data Q1;
    call streaminit(777);
    do X=1 to 20;
        Y=rand('uniform');
        output;
    end;
run;

まずは普通にプロット

proc sgplot data=Q1;
    series x=X y=Y/ lineattrs=(thickness=2);
run;






















で、次に

proc sgplot data=Q1;
    series x=X y=Y/smoothconnect lineattrs=(thickness=2);
run;





















おぉ!できた!できたよ!

ちなみにGTLで表現するなら

proc template;
  define statgraph temp1;
     begingraph; 
     layout overlay;
        seriesplot x=X y=Y / lineattrs=(tickness=2)
         smoothconnect=true;
     endlayout;  
   endgraph;
 end;
run;

proc sgrender data=Q1 template=temp1;
run;























で同じだと思う。


ちなみに、また別記事にするかもですが、データ数が多い場合、細かい部分で線が表現しきれず
ドットぽくなってしまうことがあります。
またwaterfallpltのようなぴったりくっついた棒グラフを書きたいのになんか一部に変な隙間ができたりすることもあります。
そういう、細かい部分で生じるアラ?を補正にするにはsubpixelオプションを使います。
今回のグラフでも、画質マニアなら


proc sgplot data=Q1 subpixel;
    series x=X y=Y/smoothconnect lineattrs=(thickness=2);
run;

または

proc template;
  define statgraph temp1;
     begingraph/subpixel=on
     layout overlay;
        seriesplot x=X y=Y / lineattrs=(tickness=2)
         smoothconnect=true;
     endlayout;  
   endgraph;
 end;

proc sgrender data=Q1 template=temp1;
run;

とすると






















うん、やっぱこの程度のグラフだと素人には違いがさっぱりわかりませんね


SASでクイズ作って自分で遊ぶ虚しい話

以下のコードを丸ごとコピペして実行してみてください
※SAS雲丹では無理です。

data u_data;
   length name $20;
   window start
      #3   '★思いつく限りSAS関数名を入力欄に入れてEnterを押せ'
      #5   '※Enterを押すとクリアされるが内部に蓄積してるから安心しろ!'
      #8 '入力エリア:' +1 name attr=underline
      #12 'もう思いつかない!となったらウインドウを閉じるか、コマンド=>にendと打ってEnterを押せ!'
      #13 '';
   display start;
run;
data kaitou;
length level $100.;
if _N_=0 then set sashelp.vfunc(keep=fncname);
if _N_ = 1 then do;
declare hash h(dataset:"sashelp.vfunc(keep=fncname)");
h.definekey('fncname');
h.definedone();
end;
set u_data end = eof;
where name ^= '';
name=upcase(name);
rc=h.check(key:name);
if rc = 0 then do;
hantei='○';
score +1;
end;
if rc ne 0 then hantei ='×';
if eof then do;
if score <= 2 then level ="レベル1 エセSAS使い";
else if score <= 5 then level ="レベル2 駆け出しSAS使い";
else if score <= 10 then level ="レベル3 標準SAS使い";
else if score <= 15 then level ="レベル4 中々なSAS使い";
else if score <= 20 then level ="レベル5 頼りになるSAS使い";
else if score <= 30 then level ="レベル6 ちょっとキモがられてるSAS使い";
else if score <= 40 then level ="レベル7 知りすぎたSAS使い";
else if score <= 50 then level ="レベル8 極めたSAS使い";
else if score <= 60 then level ="レベル9 狂ったSAS使い";
else if score > 60 then level ="レベル10 ジム・グッドナイト SASインスティチュートCEO";
end;
keep name hantei score level;
run;

dm "viewtable kaitou";


多分、以下のような画面がでてきます。




さあ!!クイズの始まりです!!

入力エリアにカーソルを合わせて、知っているSAS関数名を入力し
Enterを押します。













すると文字が消えます。

これを、思いつく関数が無くなるまで繰り返します。

もう無理!となったら、ウインドウを閉じるか、コマンド=> の後にendと打ってEnterします。

※SAS自体を閉じちゃダメですよ。

すると、今まで入力したデータに対しての採点結果が表示され、
最終オブザベーションのlevelの箇所に、あなたのSASプログラマーとしての評価が表示されます。











はい、以上、悪ふざけでした!

※当然レベルの判定は冗談です

ふざけた例ですが一応、windowステートメントによって生成したウンインドウで
ユーザーの入力をうけとりデータセットを生成するテクニックとか、ハッシュオブジェクトの
checkメソッドとか使ってます。

%winodwによるマクロウインドウ生成は既に記事にしております

http://sas-tumesas.blogspot.jp/2013/10/window.html