/**********************************************************************/ proc iml; %include fourfold; dim={2 2 2}; /* Price: Lo Hi Repair Origin */ table = { 21 11, /* Lo American */ 4 12, /* Hi */ 2 1, /* Lo Foreign */ 7 11}; /* Hi */ /* variable labels */ vnames = {'PriceGp' 'RepairGp' 'Origin'}; lnames = {'Low' 'High', 'Low' 'High', 'American' 'Foreign'}; /* assign global options */ std='MARG'; sangle=90; run fourfold(dim,table,vnames,lnames); quit; /**********************************************************************/ start fourfold(dim,table,vnames,lnames) global (std,down,across,name,sangle); if type(std) ~='C' then std='MARG'; if type(down) ~='N' then down=2; if type(across) ~='N' then across=1; if type(name) ~='C' then name='FFOLD'; if type(sangle) ~='N' then sangle=0; /**********************************************************************/ /* Establish viewports */ np=max(down,across); pd=np-(across||down); size=int(100/np); do i=1 to across; px=size # ((i-1) // i)+(pd[1] # size/2); do j=1 to down; py=100-(size#(j//(j-1))+(pd[2]#size/2)); ports=ports // shape((px||py),1); end; end; nport=nrow(ports); /**********************************************************************/ xmin ymin xmax ymax 25 50 75 100 25 0 75 50 /**********************************************************************/ run odds(dim,table,lnames,odds); if ncol(dim)<3 then k=1; /* number of panels */ else k=dim[3]; page=0; do i=1 to k; r=2#i; /* row index, this table */ t=table[((r-1):r),]; /* current 2x2 table */ /* construct top label for this panel */ title=''; if k>1 then do; if vnames[,3]=" " then title=lnames[3,i]; else title=trim(vnames[,3])+': '+lnames[3,i]; end; /* standardize table to fit 100x100 square */ run stdize(fit,t,table); print title; print fit[c=(lnames[1,]) r=(lnames[2,]) f=8.2] ' ' t[c=(lnames[1,]) r=(lnames[2,]) f=8.0] ; /* start new page if needed */ if mod(i,nport)=1 then do; call gstart; page=page+1; /* count pages */ gname=trim(name)+char(page,1,0); call gopen(gname); /* name uniquely */ end; /* set viewport */ ip=1+mod(i-1,nport); /* viewport number */ port=ports[ip,]; /* coordinates */ call gport(port); /* draw this panel, display if end-of page */ call gpie2x2(fit,t,lnames,vnames,title, np,odds[i]); if mod(i,nport)=0 | i=k then call gshow; end; call gclose; finish; /**********************************************************************/ start stdize(fit,t,table) global(std); /* standardize table to equal margins */ if std='MARG' then do; config={1 2}; newtab={50 50,50 50}; call ipf(fit,status,{2 2},newtab,config,t); end; /* more program lines */ finish; /**********************************************************************/ start gpie2x2(tab,freq,lnames,vnames,title,np,d) global(sangle); /* Draw one fourfold display */ t=shape(tab,1,4); /* vector of scaled frequencies */ r=5 * sqrt(t); /* radii of each quarter circle */ /* set graphic window, font, and text height */ call gwindow({-16 -16 120 120}); call gset('FONT','DUPLEX'); ht=2.0 # max(np,2); call gset('HEIGHT',ht); /* set shading patterns for each quadrant */ /* cell:[1,1] [1,2] [2,1] [2,2] */ angle1= { 90 0 180 270 }; angle2= {180 90 270 0 }; shade= {'L1' 'X1' 'X1' 'L1', 'X1' 'L1' 'L1' 'X1'}[1+(d>0),]; /* draw quarter circles, with color and shading */ do i=1 to 4; pat=shade[,i]; if pat='X1' then color='BLUE'; else color='RED'; call gpie(50,50,r[i],angle1[i],angle2[i], color,3,pat); end; /* draw frame and axes */ call gxaxis({0 50},100,11,1,1); call gyaxis({50 0},100,11,1,1); call ggrid({0 100},{0 100}); /* set label coordinates, angles */ lx={50,-.5,50,101}; ly={99,50,-1,50}; ang={0,0,0,0}; /* label justification position */ /* ab lt bl rt */ posn={ 2, 4, 8, 6}; if vnames[,1]=" " then vl1=''; else vl1=trim(vnames[,1])+': '; vl2=''; /* are side labels rotated? */ if sangle=90 then do; ang[{2 4}]=sangle; posn[{2 4}]={2 8}; if vnames[,2] ^= " " then vl2=trim(vnames[,2])+': '; end; labels=(vl2+lnames[2,1])// (vl1+lnames[1,1])// (vl2+lnames[2,2])// (vl1+lnames[1,2]); run justify(lx,ly,labels,ang,posn,ht,xnew,ynew,len); /* write actual frequencies in the corners */ cells = char(shape(freq,4,1),4,0); lx = { 5, 95, 5, 95}; ly = { 94, 94, 4, 4}; ang= { 0, 0, 0, 0}; posn={ 6, 4, 6, 4}; run justify(lx,ly,cells,ang,posn,ht,xnew,ynew,len); /* write panel title centered above */ if length(title)>1 then do; ht=1.25#ht; call gstrlen(len,title,ht); call gscript((50-len/2),112,title,,,ht); end; finish; /**********************************************************************/ /* set label coordinates, angles */ lx={50,-.5,50,101}; ly={99,50,-1,50}; ang={0,0,0,0}; /* ab lt bl rt */ posn={ 2, 4, 8, 6}; /**********************************************************************/ start justify(x,y,labels,ang,pos,ht,xnew,ynew,len); n=nrow(x); call gstrlen(len,labels); xnew=x; ynew=y; /* x and y offset factors for each position */ /* 1 2 3 4 5 6 7 8 9 */ off1={-1 -.5 0 -1 -.5 0 -1 -.5 0}; off2= 1 1 1 0 0 0 -1.6 -1.6 -1.6}; do i=1 to n; if ang[i]=0 then do; xnew[i]=x[i]+(off1[pos[i]]#len[i]); ynew[i]=y[i]+(off2[pos[i]]#ht); end; else if ang[i]=90 then do; ynew[i]=y[i]+(off1[pos[i]]#len[i]); xnew[i]=x[i]-(off2[pos[i]]#ht); end; call gscript(xnew[i],ynew[i],labels[i],ang[i]); end; finish; /**********************************************************************/ goptions vsize=7.5 hsize=7.5; /* make plot square */ proc iml; %include fourfold; /* Berkeley Admissions data */ dim={2 2 6}; vnames={"Admit?" "Sex" "Department"}; lnames={"Yes" "No" " " " " " " " ", "Male" "Female" " " " " " " " ", "A" "B" "C" "D" "E" "F"}; /* Admit: Yes No Yes No */ /* Gender: M F */ table={ 512 313, 89 19, 353 207, 17 8, 120 205, 202 391, 138 279, 131 244, 53 138, 94 299, 22 351, 24 317}; down=3; across=2; std='MARG'; sangle=90; run fourfold(dim,table,vnames,lnames); quit; /**********************************************************************/