%macro prinplot( data    = _last_ ,
                 matrix  = cov ,
                 xvar    = ,          /* xという名前は指定できない */
                 yvar    = ,          /* yという名前は指定できない */
                 veclen  = 2.5 ,      /* 主成分ベクトルの長さ調整  */
                 ellisiz = 2   ,      /* 主成分の楕円の大きさ調整  */
                 prinsiz = 1.4 ,      /* PRIN1, PRIN2 の印刷サイズ */
                 prinf   = hwdmx001 , /* PRIN1, PRIN2 のフォント   */
                 prin1   = 第１主成分, 
                 prin2   = 第２主成分, 
                 princ   = black     , 
                 xorder  = ,
                 yorder  = ,
                 hlabf   = mincho , /* 横軸ラベルのフォント */
                 vlabf   = mincho , /* 縦軸ラベルのフォント */
                 device  = win   ,
                 v       = plus  ,
                 hlength = 60 pct, /* 縦横軸長の比は縦横目盛の */
                 vlength = 60 pct  /* 範囲比に合わせて指定する */
                ) ;
/*-----------------------------------------*/
/* ２観測変数の主成分ベクトルのプロット    */
/*                                         */
/*                                         */
/* original code by Friendly, M            */
/* modified by Suzuki, T ( 1999.1 )        */
/*-----------------------------------------*/
proc princomp data = &data &matrix outstat = _stat_ out = _prin_ ;
    var &xvar &yvar ;
run ;
data _weight_ ;
    set _stat_ ;
    retain mx my l1 l2 ;
    drop _type_ ;
    if _type_ = 'MEAN' then
        do ;
            mx = &xvar ;
            my = &yvar ;
        end ;
    if _type_ = 'EIGENVAL' then /* get length of PC vectors */
        do ;
            l1 = sqrt( &xvar ) ;
            l2 = sqrt( &yvar ) ;
        end ;
    if _type_ = 'SCORE' then output ;
run ;
title 'WEIGHTS dataset' ;
proc print data = _weight_ ;
    id _name_ ;
run ;
title ;

data _vector_ ;
    set _weight_ ;
    length function $8 text $20 ;
    drop &xvar &yvar mx my l1 l2 ;
    xsys = '2' ;
    ysys = '2' ;
    x = mx ;
    y = my ;
    function = 'MOVE' ;
    output ;
    
    color = "&princ" ;
    if _name_ = 'PRIN1' then /* length of vectors */
        do ;
            l        = &veclen * l1 ;
            position = 'C'          ;
        end ;
    else
        do ;
            l        = &veclen * l2 ;
            position = 'A'          ;
        end ;
    x = mx - l * &xvar ; /* draw & label them */
    y = my - l * &yvar ;
    function = 'DRAW'  ;
    output ;
    
    x = mx + l * &xvar ; /* draw & label them */
    y = my + l * &yvar ;
    function = 'DRAW'  ;
    output ;
    
    size  = &prinsiz ; /* 主成分ベクトルのラベル */
    text  = _name_ ;
    select( text ) ;
        when( 'PRIN1' ) text = "&prin1" ;
        when( 'PRIN2' ) text = "&prin2" ;
    end ;
    style = "hwdmx001" ;
    function = 'LABEL' ;
    output ;
run ;
title 'ANNOTATE dataset' ;
proc print data = _vector_ ;
run ;
title ;

data _ellipse ;
    set _weight_ ;
    length function $8 text $20 ;
    drop &xvar &yvar mx my l1 l2 xp yp ang ;
    xsys = '2' ;
    ysys = '2' ;
    if _name_ = 'PRIN1' then
        do ;
            tilt  = atan( &yvar / &xvar ) ;
            siz   = &ellisiz  ;
            color = 'RED' ;
            line  = 20    ;
            do a = 0 to 360 by 10 ;
                ang = a * arcos( -1 ) / 180 ;
                x = siz * l1 * cos( ang ) ;
                y = siz * l2 * sin( ang ) ;
                xp = ( x * cos( tilt ) ) - ( y * sin( tilt ) ) ; /* rotate */
                yp = ( x * sin( tilt ) ) - ( y * cos( tilt ) ) ;
                x = xp + mx ;
                y = yp + my ;
                if a = 0 then function = 'MOVE' ;
                else          function = 'DRAW' ;
                output ;
            end ;
        end ;
run ;
data _vector_ ;
    set _vector_ _ellipse ;
run ;

goptions device = &device ;
axis1 length = &vlength
      label = ( f = &vlabf )
      %if &yorder ne %str() %then order = ( &yorder ) ;
;
axis2 length = &hlength offset = ( 2 )
      label = ( f = &hlabf )
      %if &xorder ne %str() %then order = ( &xorder ) ;
;
symbol1 c = black v = &v ;
proc gplot data = _prin_ ;
    plot &yvar * &xvar / frame anno = _vector_ vminor = 1 hminor = 1
         vaxis = axis1 haxis = axis2 name = 'GB0913' ;
run ;
quit ;
%mend prinplot ;