%macro mascat( data = _last_, /* 入力データセット名 */ var = , /* 例> %str(x1, x2, x3) */ v = plus, /* プロット文字の種類 */ h = 8, /* プロット文字の高さ */ varfont = swiss, /* 変数名のフォント */ varh = 1, /* 変数名の高さ */ print = , /* プリンタへ印刷の有無 */ pairwise= , /* ペアワイズ処理の有無 */ stat = +15, /* 箱ひげ図の統計語位置 */ val = +20, /* 箱ひげ図の統計値位置 */ title1 = , /* タイトル１行目文字列 */ title2 = , /* タイトル２行目文字列 */ title3 = , /* タイトル３行目文字列 */ foot1 = , /* フッター文字列 */ t1h = 2, /* タイトル文字１の高さ */ t2h = 2, /* タイトル文字２の高さ */ t3h = 2, /* タイトル文字３の高さ */ f1h = 1.5, /* フッター文字の高さ */ t1font = mincho, /* タイトル文字１のfont */ t2font = mincho, /* タイトル文字２のfont */ t3font = mincho, /* タイトル文字３のfont */ f1font = mincho /* フッター文字のfont */ ) ; /*-------------------------------------------------------*/ /* 多変量連関図 : %mascat */ /*-------------------------------------------------------*/ /* */ /* このマクロはＳＡＳ社のサンプルプログラム IMLGEX2 を */ /* 書き直してマクロ化したものです。 */ /* */ /* 主な改良点 */ /* （１）出力制御オプションをつけた */ /* （２）欠損値を含むデータに対処した */ /* */ /* ---------------- */ /* OS: Windows95 */ /* SAS: 6.12 */ /*-------------------------------------------------------*/ /* 1997/07/30 */ /* Tokuhisa SUZUKI < NIKKEI RESEARCH INC. > */ /*-------------------------------------------------------*/ /***********************************************/ /* S A S S A M P L E L I B R A R Y */ /* */ /* NAME: IMLGEX2 */ /* TITLE: SCATTERPLOT MATRIX */ /* PRODUCT: IML */ /* SYSTEM: ALL */ /* KEYS: GRAPHICS SUGI6 */ /* PROCS: IML */ /* DATA: */ /* */ /* REF: */ /* MISC: */ /* */ /***********************************************/ /*------------------------------------------------------- This program generates a data set and uses IML graphics subsystem to draw a scatterplot matrix. -----------------------------------------------------*/ /* need extra work space, modules take quite a bit of space */ PROC IML WORKSIZE=100; /*-- load graphics --*/ CALL GSTART; /*--------------------*/ /*-- define modules --*/ /*--------------------*/ /*-- MODULE : compute contours --*/ START CONTOUR(C,X,Y,NPOINTS,PVALUES); /* this routine computes contours for a scatter plot -------*/ /* c returns the contours as consecutive pairs of columns --*/ /* x and y are the x and y coordinates of the points -------*/ /* npoints is the number of points in a contour ------------*/ /* pvalues is a column vector of contour probabilities -----*/ /* the number of contours is controled by the ncol(pvalue) */ XX=X||Y; N=NROW(X); /* CORRECT FOR THE MEAN */ MEAN=XX[+,]/N; XX=XX-MEAN@J(N,1,1); /* find principle axes of ellipses */ XX=XX`*XX/N; CALL EIGEN(V,E,XX); /* set contour levels */ C=-2*LOG(1-PVALUES); A=SQRT(C*V[1]); B=SQRT(C*V[2]); /* parameterize the ellipse by angle */ T=( (1:NPOINTS) - {1})#ATAN(1)#8/(NPOINTS-1); S=SIN(T); T=COS(T); S=S`*A; T=T`*B; /* form contour points */ S =((E*(SHAPE(S,1)//SHAPE(T,1)))+MEAN`@J(1,NPOINTS*NCOL(C),1) )`; C=SHAPE( S , NPOINTS ) ; /* returned as ncol pairs of columns for contours */ FINISH; /*-- MODULE : draw contour curves --*/ START GCONTOUR(XT1, XT2) ; /*----------- ペアワイズ処理の有無 ------------*/ %if pairwise ne %str() %then %do ; T1 = XT1[ LOC( XT1 + XT2 ^= . ) , ] ; T2 = XT2[ LOC( XT1 + XT2 ^= . ) , ] ; %end ; %else %do ; T1 = XT1 ; T2 = XT2 ; %end ; RUN CONTOUR(T12, T1, T2, 30, {.5 .8 .9}); WINDOW=( MIN(T12[ ,{1 3}],T1 ) || MIN(T12[ ,{2 4}],T2 )) // ( MAX(T12[ ,{1 3}],T1 ) || MAX(T12[ ,{2 4}],T2 )); CALL GWINDOW(WINDOW); CALL GDRAW(T12[,1],T12[,2],,'BLUE'); CALL GDRAW(T12[,3],T12[,4],,'BLUE'); CALL GDRAW(T12[,5],T12[,6],,'BLUE'); CALL GPOINT(T1, T2, "&v" ,'RED', &h ) ; FINISH; /*-- MODULE : find median, quartiles for box and whisker plot --*/ START BOXWHSKR(VX, U, Q2, M, Q1, L); /*----------- 欠損値の有無 ------------*/ %if pairwise ne %str() %then %do ; X = VX[ LOC( VX ^= . ) , ] ; %end ; %else %do ; X = VX ; %end ; RX=RANK(X); S=X; S[RX,] = X; N = NROW(X); /*-- median --*/ M=FLOOR( ((N+1)/2) || ((N+2)/2) ); M=(S[M,])[+,]/2; /*-- compute quartiles --*/ Q1=FLOOR( ((N+3)/4) || ((N+6)/4) ); Q1=(S[Q1,])[+,]/2; Q2=CEIL( ((3*N+1)/4) || ((3*N-2)/4) ); Q2=(S[Q2,])[+,]/2; H=1.5*(Q2-Q1); /* step=1.5*(interquartile range)*/ U=Q2+H; L=Q1-H; U=(U>S)[+,]; U=S[U,]; /* adjacent values --------------*/ L=(L>S)[+,]; L=S[L+1,]; FINISH; /*-- box and whisker plot --*/ START GBXWHSKR(T, HT); RUN BOXWHSKR(T, UP, Q2,MED, Q1, LO); *---adjust screen viewport and data window---; Y = MIN(T) // MAX(T); CALL GWINDOW({0, 100} || Y); MID = 50; WLEN = 20; *-- add whiskers --; WSTART=MID - (WLEN / 2); FROM = (WSTART || UP) // (WSTART || LO); TO = ((WSTART // WSTART) + WLEN) || FROM[,2]; *-- add box --; LEN = 50; WSTART=MID - (LEN / 2); WSTOP=WSTART + LEN; FROM= FROM // (WSTART || Q2) // (WSTART || Q1) // (WSTART || Q2) // (WSTOP || Q2); TO = TO // (WSTOP || Q2) // (WSTOP || Q1) // (WSTART || Q1) // (WSTOP || Q1); *---add median line---; FROM = FROM // (WSTART || MED); TO = TO // (WSTOP || MED); *---attach whiskers to box---; FROM = FROM // (MID || UP) // (MID || LO); TO = TO // (MID || Q2) // (MID || Q1); *-- draw box and whiskers ---; CALL GDRAWL(FROM, TO,,'RED'); *---add minimum and maximum data points---; CALL GPOINT(MID, Y ,3,'RED'); *---label min, max, and mean---; Y = MED // Y; s = {'MED' 'MIN' 'MAX'}; CALL GSET("FONT","SIMPLEX"); CALL GSET('HEIGHT',13); CALL GSCRIPT(WSTOP+HT &stat , Y, CHAR(Y,5,2),,,,,'BLUE'); /* ~~~~~ 印刷用の箱ひげ微調整（変数の個数で違う）*/ CALL GSTRLEN(LEN, S); CALL GSCRIPT(WSTART-LEN-HT &val ,Y,S,,,,,'BLUE'); /* ~~~~ Ａ４印刷用の箱ひげ微調整 */ CALL GSET('HEIGHT'); FINISH; /*-- MODULE : do scatterplot matrix --*/ START GSCATMAT(DATA, VNAME); CALL GOPEN('SCATTER'); NV = NCOL(VNAME); IF (NV = 1) THEN NV = NROW(VNAME); CELLWID = INT(90/NV); DIST = 0.1 * CELLWID; WIDTH = CELLWID - 2*DIST; XSTART = INT((90 -CELLWID * NV)/2) + 5; XGRID = ((0:NV)#CELLWID + XSTART)`; /*-- delineate cells --*/ CELL1 = XGRID; CELL1 = CELL1 || (CELL1[NV+1] // CELL1[NV+1-(0:NV-1)]); CELL2 = J(NV+1, 1, XSTART); CELL2 = CELL1[,1] || CELL2; CALL GDRAWL(CELL1, CELL2); CALL GDRAWL(CELL1[,{2 1}], CELL2[,{2 1}]); XSTART = XSTART + DIST; YSTART = XGRID[NV] + DIST; /*-- label variables ---*/ CALL GSET("HEIGHT", &varh ) ; CALL GSET("FONT", "&varfont" ) ; CALL GSTRLEN(LEN, VNAME); WHERE = XGRID[1:NV] + (CELLWID-LEN)/2; CALL GSCRIPT(WHERE, 3, VNAME) ; LEN = LEN[NV-(0:NV-1)]; WHERE = XGRID[1:NV] + (CELLWID-LEN)/2; CALL GSCRIPT(4,WHERE, VNAME[NV - (0:NV-1)],90); /*-- First viewport --*/ VP = (XSTART || YSTART) // ((XSTART || YSTART) + WIDTH) ; /*-- Since the characters are scaled to the viewport (which is inversely porportional to the number of variables), enlarge it proportional to the number of variables --*/ HT = 2*NV; CALL GSET("HEIGHT", HT); DO I=1 TO NV; DO J=1 TO I; CALL GPORTSTK(VP); IF (I=J) THEN RUN GBXWHSKR(DATA[,I], HT); ELSE RUN GCONTOUR(DATA[,J], DATA[,I]); /*-- onto the next viewport --*/ VP[,1] = VP[,1] + CELLWID; CALL GPORTPOP; END; VP = (XSTART // XSTART + WIDTH) || (VP[,2] - CELLWID); END; title1 = "&title1 " ; title2 = "&title2 " ; title3 = "&title3 " ; foot1 = "&foot1 " ; call gwindow ({0 0 100 100}); call gstrlen(t1len,title1, &t1h, "&t1font", {0 0 100 100}); call gstrlen(t2len,title2, &t2h, "&t2font", {0 0 100 100}); call gstrlen(t3len,title3, &t3h, "&t3font", {0 0 100 100}); call gstrlen(f1len,foot1, &f1h, "&f1font", {0 0 100 100}); call gset('color','black') ; call gscript(92-t1len, 90, title1,,,&t1h, "&t1font" ) ; call gscript(92-t2len, 85, title2,,,&t2h, "&t2font" ) ; call gscript(92-t3len, 80, title3,,,&t3h, "&t3font" ) ; call gscript((92-f1len)/2, 0.5, foot1,,,&f1h, "&f1font" ) ; call gset('color'); CALL GSHOW; FINISH; %if &print ne %str() %then /*--- プリンタに印刷 ---*/ %do ; goptions horigin = 1.5 cm vorigin = 1 cm device = winprtm ; %end ; /*-- Placement of text are based on the character height. The IML modules defined here assume percent as the unit of character height for device independent control. --*/ GOPTIONS GUNIT=PCT ; USE &data ; VNAME = { &var }; READ ALL VAR VNAME INTO XYZ; RUN GSCATMAT(XYZ, VNAME); QUIT; GOPTIONS GUNIT=CELL device = win ; /*-- reset back to default --*/ %mend mascat ;