%macro cercle(infond,inpoint,indata,incolor,annot,id,rap,xc,yc,xl,yl,hsize,vsize,legh,fonte=,rmax=0,format=,ai=no); /* Macro écrite par Patrick Brossier (GIP RECLUS) infond tableau contenant le fond de carte pour déterminer l'espace graphique inpoint tableau contenant les coordonnées des points où seront placés les cercles indata tableau contenant les données à cartographier incolor tableau décrivant les couleurs utilisées pour les cercles (voir plus bas) annot tableau recevant les instrutions d'annotations id liste des variables identifiant les données et les points rap liste de variables, la première donne la taille des cercles, la seconde détermine le couleur, cette seconde variable est facultative. xc,yc coordonnées des cercles de la légende (en % de hsize et vsize) xl,yl coordonnées des caissons de la légende (en % de hsize et vsize), s'il n'y a qu'une seule variable dans la liste rap mettre 0,0 hsize largeur de l'espace graphique, si égale 0 la valeur est prise dans le goption vsize hauteur de l'espace graphique, si égale 0 la valeur est prise dans le goption legh hauteur des caractères de la légende fonte police utilisée pour la légende rmax taille maximale des cercles format nom du format utilisé pour déterminer la couleur des cercles avec la seconde variable de rap (un nom de format comprend le point) ai pour Adobe Illustrator, il peut être préférable que les cercles ne soient pas pleins, mais seulement les entourés (NO ou YES) Cette macro génère dans un tableau d'annotation les cercles pour une carte en cercles Macros utilisées: %obsnvars (attention variables globales nvars nobs) %listevar (attention variable globale listevar) %varexist Version du 14/04/07 */ %global listevar nvars nobs exist; data _null_; %if &infond= or &inpoint= or &indata= or &incolor= or &annot= or &id= or &rap= or &xc= or &yc= or &xl= or &yl= or &hsize= or &vsize= or &legh= %then %do; a='25'x||"cercle(infond,inpoint,indata,incolor,annot,id,rap,xc,yc,xl,yl,hsize,vsize,legh,fonte=,rmax=0,format=,ai=no);"; put "ERROR: Usage " a;run; %goto fin;%end; %if &hsize=0 %then hsize=upcase(%quote("%sysfunc(getoption(hsize,in))")); %else hsize=%quote("&hsize");; %if &vsize=0 %then vsize=upcase(%quote("%sysfunc(getoption(vsize,in))")); %else vsize=%quote("&vsize");; i=index(hsize,"IN")-1; if i>0 then hsize=substr(hsize,1,i)*2.54; i=index(vsize,"IN")-1; if i>0 then vsize=substr(vsize,1,i)*2.54; call symput('hsize',compress(hsize)); call symput('vsize',compress(vsize)); run; %varexist(&infond, x y); %if &exist=no %then %do;data _null_;put "ERROR: Les variables x y n'existent pas dans la tableau &infond";run;%goto fin;%end; %varexist(&inpoint, &id x y); %if &exist=no %then %do;data _null_;put "ERROR: Les variables &id x y n'existent pas dans la tableau &inpoint";run;%goto fin;%end; %varexist(&indata, &id &rap); %if &exist=no %then %do;data _null_;put "ERROR: Les variables &id &rap n'existent pas dans la tableau &indata";run;%goto fin;%end; %varexist(&incolor, couleur id); %if &exist=no %then %do;data _null_;put "ERROR: Les variables couleur id n'existent pas dans la tableau &incolor";run;%goto fin;%end; %let fonte=%upcase(&fonte); %put NOTE: device=%trim(%sysfunc(getoption(device))), hsize=&hsize cm, vsize=&vsize cm; /* obtention de la liste des variables */ %listevar(&indata,&rap); data _null_; length name $ 8; derv=upcase(%quote("&listevar")); id=0; b:i=index(trim(derv),' '); if i>0 then do; name=substr(derv,1,i-1); DERV=SUBSTR(DERV,I+1); if id=0 then do; call symput('varcer',name); call symput('varcol',derv); end; id=id+1; goto b; end; if id=0 then do; call symput('varcer',derv); call symput('varcol',name); end; run; /* obtention du dernier identificateur */ %listevar(&indata,&id); data _null_; DERV=upcase(%quote("&listevar")); A:I=INDEX(TRIM(DERV),' '); IF I>0 THEN DO;DERV=SUBSTR(DERV,I+1); GOTO A; END; CALL SYMPUT('VARD',DERV); run; /* le fichier des couleurs provient des macros %cmyrgbd; %cmyrgb(cyan,magenta,jaune); ... autant de couleurs -1 que de variables dans rap %cmyrgbc(incolor,ID); ID est le nom de la variable et ne peut être changé %cmyrgbf; */ /* calcul des min max */ data tempo2;set &indata; if ^(&varcer in(0 .)); _varcer=abs(&varcer); keep &id _varcer &varcol; %if &varcol^= %then %do; length _varcol $ 40; %if &format^= %then _varcol=put(&varcol,&format); %else _varcol=compress(&varcol); ;keep _varcol; proc sort data=tempo2;by _varcol; data tempo1;set tempo2;by _varcol; if first._varcol; keep _varcol &varcol; proc sort data=tempo1;by &varcol; data tempo1;set tempo1; _id=_N_; keep _varcol _id; data tempo1; merge tempo1(in=check) &incolor(rename=(couleur=color id=_id));by _id; if check; proc sort data=tempo1 out=tempo7;by _varcol; data tempo7;merge tempo2 tempo7;by _varcol; drop _varcol; %end; %else %do; data tempo7;set tempo2; if _N_=1 then set &incolor(rename=(couleur=color id=_id)); run; %end; proc means data=tempo7 min max mean noprint; var _varcer; output out=tempo2 min=minvarc max=maxvarc mean=meanvarc n=_nb_; proc means data=&infond min max noprint; var x y; output out=tempo3 min=minx miny max=maxx maxy; /* annotate cercles de légende */ data tempo4; merge tempo2 tempo3; /* fichiers des extrêmes */ length function style color $ 8 hsys xsys ysys when position $1 text $ 40; retain when 'A' line 0; %if &rmax=0 %then rm=120/_nb_; %else rm=&rmax;; array arc maxvarc meanvarc minvarc; meanvarc=(sqrt(maxvarc)+sqrt(minvarc))/2; meanvarc=meanvarc*meanvarc; xo=&xc*100/&hsize; yo=&yc*100/&vsize; do over arc; r=(sqrt(arc)/sqrt(maxvarc))*rm; xsys='3';ysys='3';x=xo;y=yo;function='move';output; x=rm;y=r;xsys='7';ysys='7';size=r;angle=0;rotate=360;hsys='1'; style='EMPTY';color='black';function='PIE'; output; x=rm;y=r;xsys='7';ysys='7';function='MOVE';output; x=(&legh*(5/12))*100/&vsize;y=.;xsys='B';ysys='B';function='MOVE';output; x=.;y=.;function='cntl2txt';output; style=%quote("&fonte");hsys='5'; text=compress(put(arc,10.0)); size=(&legh*(5/12))*100/&vsize; function='LABEL'; position='6'; angle=0; rotate=0; output; end; keep x y size angle rotate style color function when xsys ysys hsys line text position; run; /* caissons de légende */ %if &varcol ne %then %do; %obsnvars(tempo1); data tempo1; set tempo1; if _N_=1 then do; yl=&yl*100/&vsize; xl=&xl*100/&hsize; unit1=(&legh/&vsize)*100; unit2=unit1*(5/6); unit3=(&legh*1000)/(&hsize*6); unit4=unit3*1.25; yl=yl+(unit1*(&nobs-1)); end; length function style color $ 8 hsys xsys ysys when position $1 text $ 40; retain when 'A' xsys ysys hsys '3' position 'C' line angle rotate yl xl unit1-unit4 .; x=xl;y=yl;function='poly';style='solid';output; y=yl+unit2;function='polycont';color='black';output; x=xl+unit3;output; y=yl;output; x=xl;output; x=xl+unit4;function='label';size=unit2/2;style=%quote("&fonte"); color='black';text=_varcol;output; yl=yl-unit1; keep x y size angle rotate style color function when xsys ysys hsys line text position; run; proc append data=tempo1 out=tempo4 force; run; %end; /* Merge des données et des points */ proc sort data=&inpoint(keep=&id x y) out=tempo5;by &id; proc sort data=tempo7;by &id; data tempo6;merge tempo7(in=check1) tempo5(in=check2);by &id; /* taille min et max des cercles */ if _N_=1 then set tempo2(keep=minvarc maxvarc _nb_); if first.&vard; if check1 & check2; proc sort data=tempo6;by descending _varcer; /* Calcul des cercles */ data tempo8; set tempo6; length function color style $ 8 xsys ysys hsys when position $ 1 text $ 40; retain function 'PIE' hsys '1' xsys ysys '2' when 'A' line angle 0 rotate 360 position text ' '; if _N_=1 then set tempo3; /* fichier des valeurs extrêmes du fond */ if &rmax=0 then rm=120/_nb_; else rm=&rmax; size=(sqrt(_varcer)/sqrt(maxvarc))*rm; %if %upcase(&ai)=NO %then %do; style='SOLID';output; color='WHITE'; /* paramètre de couleur */ %end; style='EMPTY';output; keep x y size angle rotate style color function when xsys ysys hsys line text position; run; data &annot;set tempo4 tempo8; run; PROC DATASETS DD=WORK NOLIST NOWARN FORCE NOFS; DELETE TEMPO1 TEMPO2 TEMPO3 TEMPO4 TEMPO5 TEMPO6 TEMPO7 TEMPO8; run; quit; %fin: %mend;