%macro colist ( data = _last_, /* 入力(proc corr の出力)データセット名 */ out = _colist_, /* 相関行列リストの出力データセット名 */ file = , /* 相関行列リストの外部出力ファイル参照名 */ lrecl = , /* 外部ファイル出力時のレコード長 */ label = yes, /* 外部ファイル出力時のラベル出力の有無 */ var = yes, /* 外部ファイル出力時の変数名出力の有無 */ maxdec = 2, /* 相関係数の小数点以下の最大桁数 */ intchr = , /* 整数部1位の表示( 0 または空白など) */ diagchr = 1, /* 対角要素の表示法(文字列そのもの指定) */ triang = lower, /* 下三角表示 lower か上三角表示 upper か */ trianchr = . /* 対三角の表示文字( . または空白など) */ ) ; /*-----------------------------------------------------------------*/ /* NAME: colist */ /* TITLE: シンプルな相関行列を作る */ /* PRODUCT: Base */ /* SYSTEM: ALL */ /* PROCS: corr, macro */ /* */ /* SUPPORT: 鈴木督久 */ /* DATE: 1997.4.12 ( Version 1.0 ) */ /* DATE: 1997.4.18 ( Version 1.1 ) triang = オプション追加 */ /*-----------------------------------------------------------------*/ %let width = %eval( &maxdec + 3 ) ; %let format = &width..&maxdec ; %if &lrecl ne %str() %then %let lrecl = %str( lrecl = &lrecl ) ; %if %upcase( &triang ) = LOWER %then %let triang = i >= j ; %else %if %upcase( &triang ) = UPPER %then %let triang = i <= (j-2) ; data _null_ ; if 0 then set &data ; array num ( * ) _numeric_ ; call symput( 'nv', left(put(dim(num), 3.)) ) ; stop ; run ; data &out ; set &data ; where _type_ = 'CORR' ; keep _name_ _1 - _&nv _label_ ; array chr ( * ) $ &width _1 - _&nv ; array num ( * ) _numeric_ ; length _label_ $ 40 ; do i = 1 to &nv ; j = _n_ + 1 ; chr( i ) = put( num( i ), &format ) ; chr( i ) = tranwrd( chr( i ), '0.', "&intchr.." ) ; if i = (j - 1) then do ; chr( i ) = "&diagchr" ; select( chr( i ) ) ; when( '1' ) do ; select( "&intchr" ) ; when( '0' ) chr( i ) = ' 1' ; when( '' ) chr( i ) = '1' ; otherwise ; end ; end ; otherwise do ; select( "&intchr" ) ; when( '0' ) chr( i ) = right( chr(i) ) ; otherwise ; end ; end ; end ; end ; if &triang then do ; chr( i ) = "&trianchr" ; if chr( i ) = '.' then do ; select( "&intchr" ) ; when( '0' ) chr( i ) = ' .' ; when( '' ) chr( i ) = ' .' ; otherwise ; end ; end ; end ; call label( num( j - 1 ), _label_ ) ; end ; run ; %if &file ne %str() %then %do ; data _null_ ; file &file &lrecl ; set &out ; put %if %upcase( &var ) = YES %then %do ; _name_ %end ; ( _1 - _&nv ) ( $&width.. +1 ) %if %upcase( &label ) = YES %then %do ; +1 _label_ %end ; ; run ; %end ; %put ; %put NOTE: %nrstr(%colist) by T.SUZUKI (1997) NIKKEI RESEARCH INC. ; %put ; %mend colist ;