/*-------------------------------------------------------*/ /* Macro Name : faplot */ /* 因子分析のバイプロットを作成する． */ /* class 変数を指定すると重心を求め円を描く */ /* */ /* Author : Tokuhisa SUZUKI */ /* Date : 1998/09/30 */ /*-------------------------------------------------------*/ %macro faplot ( data = _last_ , /* 分析データセット名 */ var = , /* 分析変数リスト */ out = _out_ , /* 因子得点の出力データセット */ outstat = _stat_ , /* 統計量の出力データセット */ anno = _anno_ , /* annoateデータセット名 */ n = 2 , /* 抽出する因子の個数 */ m = prin , /* 抽出する手法 */ r = none , /* 回転手法 */ fax = factor1 , /* 横軸の座標とする因子名 */ fay = factor2 , /* 縦軸の座標とする因子名 */ plotvar = , /* プロット変数ベクトルの選択 */ scale = 1.5 , /* ベクトルの長さ微調整係数 */ hlabel = 0.6 , /* 変数ラベルの高さ */ varfont = HWDMX004, /* 変数ラベルのフォント */ sizevtop = 0.5 , /* ベクトル頭（鏃）のサイズ */ markvtop = C , /* ベクトル頭（鏃）フォント値 「C」は「▲」．「S」は＋ 「K」は細い↑「G」は太い↑ */ lvref = 2, /* 垂直線の線種番号 */ lhref = 2, /* 水平線の線種番号 */ id = , /* 個体のラベルを含む変数名 */ fontolab = hwdmx001, /* 個体ラベルのフォント． */ sizeolab = 0.6 , /* 個体ラベルのサイズ */ class = , /* 分類変数の重心で円を描く */ colors = RED GREEN BLUE BLACK PURPLE BROWN ORANGE, symbols = circle plus triangle star x , hmean = 0.8, /* 群（平均）ラベルの高さ */ fmean = HWDMX002, /* 群（平均）ラベルのフォント */ circleds =, /* 分類変数別の半径値のデータ 分類変数名は &class と同一 半径変数名は size に固定 無指定で class だけ指定すると claa 別の観測数の比率を円 の面積とする */ /* 例えば比率pを面積で表現する 場合はsizeは以下のように作る size = sqrt( p / 3.14 ) */ device = win, /* グラフ出力デバイス */ /* デフォルトaxis オプション追加 */ horigin = 0 cm, /* device ^= WIN )の左余白 */ vorigin = 0 cm, /* device ^= WIN )の下余白 */ hlength = 60 pct , /* device ^= WIN )の水平軸長 */ vlength = 60 pct , /* device ^= WIN )の垂直軸長 */ /* A4横場合 hlength = 25 cm 程度 */ horder =, /* %str( order = ( ------ ) ) */ vorder =, /* %str( order = ( ------ ) ) */ hmajor =, /* 水平軸の主要目盛の定義 */ hminor =, /* 水平軸の補助目盛の定義 */ vmajor =, /* 垂直軸の主要目盛の定義 */ vminor =, /* 垂直軸の補助目盛の定義 */ /* AXIS, LEGEND マクロ外で指定 */ haxis =, /* AXIS statement for horizontal axis */ vaxis =, /* and for vertical axis- use to equate axes */ legend =, /* LEGEND statement */ hsym = 0.4, /* height of plot symbols */ hval = 0.6, /* 軸目盛の高さ */ fval = simplex, /* 軸目盛のフォント */ f1fmt =, /* dim1 へのformt指定 */ f2fmt =, /* dim2 へのformt指定 */ vref = 0, /* 垂直線 */ href = 0, /* 水平線 */ lvref = 33, /* 垂直線の線種番号 */ lhref = 33, /* 水平線の線種番号 */ lcircle = 1, /* 信頼楕円の線種 */ name = FAPLOT, /* for graphic catalog entry */ f1lab = f = hwdmx001 h = 0.8 "&fax * &fay : 個体は因子得点，ベクトルは因子負荷" , f2lab = ' ', title = f = hwdmx001 h = 1 "因子分析 Biplot" , plot = y /* プロット作成の抑止 Y|N */ ); %if &data = _LAST_ %then %let data = %scan(&sysdsn,1).%scan(&sysdsn,2); %put NOTE: dataset name = &data . ; proc factor data = &data out = &out outstat = &outstat n = &n m = &m r = &r ; var &var ; run ; /*------------------- データセット中の変数ラベル獲得 ---*/ data format ; if 0 then set &data ; keep start label fmtname type ; length start $8 label $40 ; fmtname = 'VLABELF' ; type = 'C' ; array vv( * ) &var ; do i = 1 to dim( vv ) ; call vname( vv(i), start ) ; call label( vv(i), label ) ; output ; end ; stop ; run ; proc format cntlin = format ; run ; /*------------------------------ 因子ベクトルを描く ---*/ %if &plotvar ne %str() %then %do ; data _plotv_ ; keep start label type fmtname ; length start $8 text $200 ; fmtname = 'plotvf' ; type = 'C' ; text = "&plotvar" ; i = 1 ; do until( start = ' ' ) ; start = upcase( scan( text, i , ' ') ) ; label = 'Y' ; if start ne ' ' then output ; i = i + 1 ; end ; run ; proc format cntlin = _plotv_ ; run ; %end ; data _vec_ ; set &outstat ; if _type_ = 'PATTERN' ; run ; proc transpose data = _vec_ out = _vec_ ; var &var ; run ; data _vec_ ; length function $8 text $20 ; set _vec_ ; retain xsys '2' ysys '2' position '6' ; %if &plotvar ne %str( ) %then %do ; if put( _name_ , $plotvf. ) = 'Y' ; %end ; x = 0 ; y = 0 ; function = 'MOVE ' ; output ; x = &scale * &fax ; y = &scale * &fay ; function = 'DRAW ' ; output ; /* 変数ラベルがあれば表示する */ text = _name_ ; text = put( text, $vlabelf. ) ; size = &hlabel ; style = "&varfont" ; select ; when( x >= 0 & y >= 0 ) position = '3' ; when( x >= 0 & y < 0 ) position = '9' ; when( x < 0 & y >= 0 ) position = '1' ; when( x < 0 & y < 0 ) position = '7' ; end ; function = 'LABEL' ; output ; /* 鏃（やじり）を描く */ function = 'LABEL' ; style = 'MARKER ' ; text = "&markvtop" ; size = &sizevtop ; position = '5' ; ab = sqrt( x ** 2 + y ** 2 ) ; /* 斜辺の長さ */ sin = y / ab ; /* SINを求める */ radian = arsin( sin ) ; /* ラジアン求める */ angle = abs( radian ) * 57.29578 ; /* 角度に変換 */ select ; /* 象限の条件分け */ when( sign(x) = 1 & sign(y) = 1 ) angle = angle + 270 ; when( sign(x) = -1 & sign(y) = 1 ) angle = 90 - angle ; when( sign(x) = -1 & sign(y) = -1 ) angle = angle + 90 ; when( sign(x) = 1 & sign(y) = -1 ) angle = 270 - angle ; when( sign(x) = 0 & sign(y) = 1 ) angle = 0 ; when( sign(x) = 0 & sign(y) = -1 ) angle = 180 ; when( sign(x) = 1 & sign(y) = 0 ) angle = 270 ; when( sign(x) = -1 & sign(y) = 0 ) angle = 90 ; end ; output ; run ; /*--------- ID変数の指定があれば個体ラベルを表示する ---*/ %if &id ne %str() %then %do ; data &id ; /* Label the observation */ set &out ( keep = &id &fax &fay ) ; color = 'BLACK' ; xsys = '2' ; ysys = '2' ; x = &fax ; y = &fay ; position = '6' ; /* 左寄せ */ style = "&fontolab" ; size = &sizeolab ; function = 'LABEL ' ; text = &id ; if n( &fax , &fay ) = 2 ; if &id ne ' ' ; run ; %end ; /*--------------------- 指定された分類変数で円を描く ---*/ %if &class ne %str() %then %do ; %if &circleds = %str() %then %do ; /* 分類変数別の個数比率を円の面積に */ proc summary data = &out ; class &class ; var factor1 - factor&n ; output mean = out = _mean_ ; run ; data _mean_ ; if _n_ = 1 then set _mean_( where = ( _type_ = 0 ) rename = ( _freq_ = total ) ) ; set _mean_( where = ( _type_ = 1 ) ) ; p = _freq_ / total * 10 ; size = sqrt( p / 3.14 ) ; keep size &class factor1 - factor&n ; run ; %let circleds = _mean_ ; %end ; data &circleds ; set &circleds end = eof ; length text $60 color function $8 ; retain xsys '2' ysys '2'; drop &fax &fay ; x = &fax ; y = &fay ; color = scan("&colors", _n_ ) ; /* mark the pie */ style = 'empty ' ; hsys = '2' ; function = 'pie ' ; rotate = 360 ; angle = 0 ; output ; /* mark the class mean */ text = left( &class ) ; hsys = '4' ; size = &hmean ; style = "&fmean" ; function = 'LABEL ' ; output ; /* save number of groups */ if eof then do ; call symput('NGP', put(_n_, best5.) ) ; end ; run ; %end ; %else %let ngp = 1 ; data &anno ; set _vec_ &id &circleds ; run ; %if %substr( %upcase( &plot ), 1, 1 ) = Y %then %do; goptions horigin = &horigin vorigin = &vorigin device = &device ; %let hlength = %str( length = &hlength ) ; %let vlength = %str( length = &vlength ) ; %if &hminor ne %str() %then %let hminor = %str( minor = &hminor ) ; %if &hmajor ne %str() %then %let hmajor = %str( major = &hmajor ) ; %if &vminor ne %str() %then %let vminor = %str( minor = &vminor ) ; %if &vmajor ne %str() %then %let vmajor = %str( major = &vmajor ) ; %gensym(n=&ngp, h=&hsym, symbols=&symbols, colors=&colors) ; %if %length( &haxis ) = 0 %then %do ; axis2 label = ( &f1lab ) &horder &hminor &hmajor value = ( f = &fval h = &hval ) &hlength ; %let haxis = axis2 ; %end; %if %length( &vaxis ) = 0 %then %do ; axis1 label = ( &f2lab ) &vorder &vminor &vmajor value = ( f = &fval h = &hval ) &vlength ; %let vaxis = axis1 ; %end; %if &legend = %str() %then %do ; legend1 label = ( h = &hmean f = &fmean ) value = ( h = &hmean f = &fmean ) frame ; %let legend = %str( legend = legend1 ) ; %end; %else %if %upcase( &legend ) = NOLEGEND %then %let legend = nolegend ; %if &f1fmt ne %str() %then %let f1fmt = %str( &fax &f1fmt ) ; %if &f2fmt ne %str() %then %let f2fmt = %str( &fay &f2fmt ) ; %if &class ne %str() %then %let classstm = %str( = &class ) ; %else %let classstm = ; title &title ; proc gplot data = &out ; plot &fay * &fax &classstm / anno = &anno frame href = &href vref = &vref lvref = &lvref lhref = &lhref vaxis =&vaxis haxis = &haxis &legend hm = 1 vm = 1 name = "&name" des = "FAplot of &data" ; %if &f1fmt ne %str() | &f2fmt ne %str() %then %do ; format &f1fmt &f2fmt ; %end ; run ; quit; title ; %end; goptions device = win ; %mend faplot ; /*----------------------------------------------------* | Macro to generate SYMBOL statement for each GROUP | *----------------------------------------------------*/ %macro gensym ( n = 1 , h = 1.5 , i = none, symbols = %str(- + : $ = X _ Y), colors = BLACK RED GREEN BLUE BROWN YELLOW ORANGE PURPLE ) ; /*-- note: only 8 symbols & colors are defined */ /*-- if more than 8 groups symbols and colors are recycled */ %local chr col k ; %do k = 1 %to &n ; %if %length( %scan( &symbols, &k, %str( ))) = 0 %then %let symbols = &symbols &symbols ; %if %length( %scan( &colors, &k, %str( ))) = 0 %then %let colors = &colors &colors ; %let chr = %scan ( &symbols, &k, %str( )) ; %let col = %scan ( &colors, &k, %str( )) ; symbol&k h = &h v = &chr c = &col i = &i ; %end ; %mend gensym ;