%macro colist
(
    data     = _last_,   /* 入力（proc corr の出力）データセット名 */
    out      = _colist_, /* 相関行列リストの出力データセット名     */
    file     = ,         /* 相関行列リストの外部出力ファイル参照名 */
    lrecl    = ,         /* 外部ファイル出力時のレコード長         */
    label    = yes,      /* 外部ファイル出力時のラベル出力の有無   */
    var      = yes,      /* 外部ファイル出力時の変数名出力の有無   */
    maxdec   = 2,        /* 相関係数の小数点以下の最大桁数         */
    intchr   = ,         /* 整数部１位の表示（ 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 ;