%macro pcasign(
    data     = _last_    ,/* 入力データセット名          */
    out      = _pcaout_  ,/* 主成分得点出力データセット名*/
    outstat  = _stat_    ,/* 統計量の出力データセット名  */
    var      = _numeric_ ,/* 分析変数名リスト            */
    n        =           ,/* 主成分の個数                */
    option   =           ,/* 共分散行列の分析なら cov    */
    glmprint = noprint    /* GLM 出力（分散分析表）制御  */
);
/*-------------------------------------------------------*/
/*  PCAsign : 主成分得点の正・負群の平均値の有意差検定   */
/*-------------------------------------------------------*/
/* 猪原正守(1997)主成分得点を用いた主成分軸の解釈方法の  */
/* 提案．計算機統計学．第９巻・第２号：1996. 105-110.    */
/*                                                       */
/* に基づくＳＡＳマクロプログラム [Version 1.1 ]         */
/*-------------------------------------------------------*/
/* PGM by 鈴木督久 [ DATE: 1998-03-17 ]                  */
/*-------------------------------------------------------*/

data _null_ ;
    set &data ;
    array vv ( * ) &var ;
    nvar = dim( vv )    ;
    call symput( 'NVAR', left( put( nvar, 8.)) ) ;
run ;
%if &n = %str() %then %let n = &nvar ;
proc princomp data    = &data
              out     = &out
              outstat = &outstat
              n       = &n
                        &option
    ;
    var &var ;
run ;
proc corr data = &out nosimple noprob ;
    var prin: ;
    with &var ;
run ;
data &out ;
    set &out ;
    array pca( &n )    prin1 - prin&n ;
    array cls( &n ) $  sign1 - sign&n ;
    do i = 1 to &n ;
        if pca( i ) >= 0 then cls( i ) = '正符号群' ;
        else                  cls( i ) = '負符号群' ;
    end ;
    drop i ;
run ;
%do i = 1 %to &n ;
    proc glm data = &out ( drop = prin1 - prin&n )
             outstat = _anova&i &glmprint ;
        class sign&i ;
        model &var = sign&i / ss2 ;
    run ;
    quit ;
    data _anova&i ;
        set _anova&i ;
        if _type_ = 'SS2' ;
        keep _name_ prob ;
        rename prob = prin&i ;
    run ;
    proc transpose data = _anova&i out = _anova&i ;
    run ;
    data _anova&i ;
        length _type_ $ 16 ;
        set _anova&i    ;
        _type_ = 'Ｐ-値' ;
        n = 5 ;
    run ;
    proc summary data = &out ( drop = prin1 - prin&n ) nway ;
        class sign&i ;
        var   &var    ;
        output out = _mean&i ( drop = _type_ )  mean = ;
    run ;
    data _mean&i ;
        length _type_ _name_ $ 16 ;
        set _mean&i ;
        _name_ = "PRIN&i" ;
        _type_ = '平均値' || '(' || trim( sign&i ) ||  ')' ;
        n      = 2 ;
        drop sign&i ;
    run ;
    data _dif&i ;
        array obs1 ( &nvar ) _temporary_ ;
        array obs2 ( &nvar ) _temporary_ ;
        if _n_ = 1 then set _mean&i ( drop = n _freq_ _type_ _name_ ) ;
        array vars ( &nvar ) &var        ;

        obs = 1 ;
        set _mean&i point = obs ;
        do i = 1 to &nvar ;
            obs1( i ) = vars( i ) ;
        end ;

        obs = 2 ;
        set _mean&i point = obs ;
        do i = 1 to &nvar ;
            obs2( i ) = vars( i ) ;
            vars( i ) = obs1( i ) - obs2( i ) ;
        end ;
        _type_ = '平均値の差' ;
        n      = 4 ;
        drop _freq_ i ;
        output ;
        stop ;
    run ;
%end ;
data _eigen ;
    length _type_ $16 ;
    set &outstat ;
    if _type_ = 'SCORE' ;
    _type_ = '固有ベクトル' ;
    n = 1 ;
run ;
data _pcasign ;
    length _type_ $16 _freq_ 8 ;
    set _eigen
        %do i = 1 %to &n ;
            _mean&i _anova&i _dif&i
        %end ;
    ;
    label _name_ = '主成分'  _type_ = ' ' ;
run ;
proc sort data = _pcasign out = _pcasign( drop = n ) ;
    by _name_ n ;
run ;
proc print data = _pcasign label uniform ;
    by _name_ ;
    id _type_ ;
run ;

/*-------------------------------------------------------*/
/* SASマクロ %pcasign に関するコメント（鈴木督久）       */
/*-------------------------------------------------------*/
/* SASで平均値の差のｔ検定を実行する方法としては：       */
/* （１）DATA step のｔ分布関数で計算する．              */
/* （２）proc ttest を使う．                             */
/* （３）proc anova を使う．                             */
/* （４）proc glm   を使う．                             */
/* などがあるが，%pcasign では proc glm を使った．理由は */
/* （１）で書くには変数が多くで面倒である                */
/* （２）ttest では検定結果をデータセットに出力できない  */
/* （３）anova には noprint オプションがなく無駄な（？） */
/*       印刷（各変数ごとの分散分析表）出力をしてしまう．*/
/* （４）glm で実行するには簡単すぎる検定計算ではあるが，*/
/*       上記の機能を備えているため glm を使った．       */
/*-------------------------------------------------------*/
%mend pcasign ;