|
|
Re: 求助：按照指定条件随机配对
弄了一山寨版 <!-- s:) --><img src="{SMILIES_PATH}/icon_smile.gif" alt=":)" title="Smile" /><!-- s:) -->
[code:3rnk6uwp]/*******************************************************************************/
/* Using SAS to Perform Individual Matching in Design of Case-Control Studies */
/* http://support.sas.com/resources/papers/proceedings10/061-2010.pdf */
/*******************************************************************************/
libname mymacro 'd:\mymacro';
options mstored sasmstore=mymacro;
%macro matchcc(casedata=, /* SAS data set of all cases */
controldata=, /* SAS data set of potential controls (pool of all controls) */
matchvar=, /* List of matching variables */
matchval=, /* List of values giving the maximum difference allowed for the matching variables */
fopvar=, /* An optional variable giving the follow-up time of each subject */
id=id, /* Patient identifier are both datasets */
controlspercase=1 /* Mumber of controls to be matched with each case */
) / store des='Perform Individual Matching in Design of Case-Control Studies';
options nosymbolgen nomprint;
%local _error_ matchvar_cnt;
%let _error_=0;
%macro verify_ds_exist(inds,anno) /store;
/* 验证数据集是否存在 */
%if &_error_=0 %then
%do;
%if %sysfunc(exist(&inds))=0 %then
%do;
%let _error_=1;
%put ERROR: &anno 数据集 &inds 不存在！;
%end;
%end;
%mend verify_ds_exist;
%macro verify_keyvar_exist(invar,anno) /store;
/* 验证key变量列表是否为null */
%if &_error_=0 %then
%do;
%if &invar eq %then
%do;
%let _error_=1;
%put ERROR: &anno 为 NULL！;
%end;
%end;
%mend verify_keyvar_exist;
%macro return_ds_attribute(inds,type) /store;
/* 返回数据集的var个数 or 变量列表 or obs个数 */
%local dsid i dsid rc return_val;
%let dsid=%sysfunc(open(&inds,i));
%if &type=NVARS %then %let return_val=%sysfunc(attrn(&dsid,nvars));
%if &type=NLOBS %then %let return_val=%sysfunc(attrn(&dsid,nlobs));
%else %if &type=VARNAME %then
%do;
%let return_val=;
%do i=1 %to %sysfunc(attrn(&dsid,nvars));
%let return_val=&return_val %sysfunc(varname(&dsid,&i));
%end;
%end;
%let rc=%sysfunc(close(&dsid));
%upcase(&return_val)
%mend return_ds_attribute;
%macro verify_keyvar_affect(invar,inds,anno) /store;
/* 验证key变量是否存在于数据集,是否不唯一 */
%local varlist i sub_invar;
%if &_error_=0 and &invar ne %then
%do;
%let varlist=%return_ds_attribute(&inds,VARNAME);
%let i=1;
%let sub_invar=%scan(&invar,1,' ');
%do %until(&sub_invar eq);
%if %sysfunc(indexw(&varlist,&sub_invar))=0 %then
%do;
%let _error_=1;
%put ERROR: &anno 变量 &sub_invar 在数据集 &inds 中不存在！;
%let sub_invar=;
%end;
%else %do;
%let i=%eval(&i+1);
%let sub_invar=%scan(&invar,&i,' ');
%end;
%end;
%if &_error_=0 and &anno=MATCHVAR %then %let matchvar_cnt=%eval(&i-1); /* matchvar变量的个数，供匹配判断用 */
%end;
%if &_error_=0 and &invar ne %then
%do;
%if &anno=FOPVAR or &anno=ID or &anno=CONTROLSPERCASE %then
%do;
%if %scan(&invar,2,' ') ne %then
%do;
%let _error_=1;
%put ERROR: &anno 变量: &invar 不唯一！;
%end;
%end;
%end;
%mend verify_keyvar_affect;
%macro verify_keyval_num(inval,anno) /store;
/* 判断matchval的值是否为数字，个数与matchvar是否匹配 */
%local i sub_inval;
%if &_error_=0 %then
%do;
%let i=1;
%let sub_inval=%scan(&inval,1,' ');
%do %until(&sub_inval eq);
%if %sysfunc(notdigit(&sub_inval)) %then
%do;
%let _error_=1;
%put ERROR: &anno 的值 &sub_inval 不是有效数字！;
%let sub_inval=;
%end;
%else %do;
%let i=%eval(&i+1);
%let sub_inval=%scan(&inval,&i,' ');
%end;
%end;
%let i=%eval(&i-1);
%end;
%if &_error_=0 %then
%do;
%if &anno=MATCHVAL and &i ne &matchvar_cnt %then
%do;
%let _error_=1;
%put ERROR: MACTHVAL 值域与 MATCHVAR 不匹配！;
%put ERROR: MACTHVAR (&matchvar_cnt.个): &matchvar;
%put ERROR: MACTHVAL (&i.个): &matchval;
%end;
%else %if &anno=CONTROLSPERCASE and &i gt 1 %then
%do;
%let _error_=1;
%put ERROR: &anno 值: &inval 不唯一！;
%end;
%end;
%mend verify_keyval_num;
%macro create_var_loop(var_source,val_list,anno=) /store;
/* 1 根据数据集的变量列表创建rename语句or赋值语句 */
/* 2 根据参数创建if语句的condition */
%local var_list i sub_var return;
%let i=1;
%let return=;
%if &anno=RENAME or &anno=EVALUATE %then %let var_list=%return_ds_attribute(&var_source,VARNAME);
%else %let var_list=&var_source;
%let sub_var=%scan(&var_list,1,' ');
%let sub_val=%scan(&val_list,1,' ');
%do %until(&sub_var eq);
%if &anno=RENAME %then %let return=&return &sub_var=C_&sub_var;
%else %if &anno=EVALUATE %then %let return=&return &sub_var=C_&sub_var%nrstr(;);
%else %if &anno=FOPCONDITION %then %let return=C_&sub_var>=&sub_var;
%else %if &anno=MATCHCONDITION %then
%do;
%if &i=1 %then %let return=abs(&sub_var-C_&sub_var)<=&sub_val;
%else %let return=&return and abs(&sub_var-C_&sub_var)<=&sub_val;
%end;
%let i=%eval(&i+1);
%let sub_var=%scan(&var_list,&i,' ');
%let sub_val=%scan(&val_list,&i,' ');
%end;
&return
%mend create_var_loop;
%macro verify_parameter /store;
%let casedata=%upcase(&casedata);
%let controldata=%upcase(&controldata);
%let matchvar=%upcase(&matchvar);
%let matchval=%upcase(&matchval);
%let fopvar=%upcase(&fopvar);
%let id=%upcase(&id);
%let controlspercase=%upcase(&controlspercase);
%verify_ds_exist(&casedata,CASEDATA)
%verify_ds_exist(&controldata,CONTROLDATA)
%verify_keyvar_exist(&matchvar,MATCHVAR)
%verify_keyvar_exist(&matchval,MATCHVAL)
%verify_keyvar_exist(&id,ID)
%verify_keyvar_exist(&controlspercase,CONTROLSPERCASE)
%verify_keyvar_affect(&matchvar,&casedata,MATCHVAR)
%verify_keyvar_affect(&matchvar,&controldata,MATCHVAR)
%verify_keyvar_affect(&fopvar,&casedata,FOPVAR)
%verify_keyvar_affect(&fopvar,&controldata,FOPVAR)
%verify_keyvar_affect(&id,&casedata,ID)
%verify_keyvar_affect(&id,&controldata,ID)
%verify_keyval_num(&matchval,MATCHVAL)
%verify_keyval_num(&controlspercase,CONTROLSPERCASE)
%mend verify_parameter;
%macro match_pretreatment /store;
%macro delete_existds(inds) /store;
%if %sysfunc(exist(&inds)) %then
%do;
proc datasets library=work nolist;
delete &inds / memtype=data;
quit;
%end;
%mend delete_existds;
%if &_error_=0 %then
%do;
%delete_existds(matchall)
%delete_existds(nomatchall)
* Sort control dataset by a random number;
proc sql;
create table _temp_random_controls as
select *,ranuni(12345) as random
from &controldata
order by random;
quit;
* Rename control variable names - put c_ at beginning;
proc datasets library=work memtype=data nolist;
modify _temp_random_controls;
rename
%create_var_loop(&controldata,anno=RENAME)
;
quit;
%end;
%mend match_pretreatment;
%macro match_main /store;
%if &_error_=0 %then
%do;
%do i=1 %to %return_ds_attribute(&casedata,NLOBS);
* Select the current case;
data _temp_active;
n=&i;
set &casedata point=n;
output;
stop;
run;
%do j=1 %to &controlspercase;
* Main section of the program. Create dataset for matches, non-matches ;
data _temp_match(keep=%return_ds_attribute(&casedata,VARNAME) setnumber ccstat)
_temp_nomatch (keep=%return_ds_attribute(&casedata,VARNAME) setnumber)
_temp_used (keep=c_&id);
setnumber=&i;
set _temp_active;
do i=1 to totobs;
set _temp_random_controls point=i nobs=totobs;
if %create_var_loop(&matchvar,&matchval,anno=MATCHCONDITION) then
do;
%if &fopvar ne %then
%str(if %create_var_loop(&fopvar,anno=FOPCONDITION) then do;);
%if &j=1 %then
%do;
ccstat=1;
output _temp_match;
%end;
%create_var_loop(&casedata,anno=EVALUATE)
ccstat=&j+1;
output _temp_match;
output _temp_used;
stop;
%if &fopvar ne %then %str(end;);
end;
end;
output _temp_nomatch;
run;
proc append data=_temp_match base=matchall; run;
proc append data=_temp_nomatch base=nomatchall; run;
* Need to re-sort control dataset by subject id;
proc sort data=_temp_random_controls;
by c_&id;
run;
* Remove used control from control dataset;
data _temp_random_controls;
merge _temp_random_controls _temp_used (in=used);
by c_&id;
if used ne 1;
run;
* Need to resort control dataset by random number for next iteration;;
proc sort data=_temp_random_controls;
by random;
run;
%end;
%end;
%end;
proc datasets library=work nolist;
delete _temp: / memtype=data;
quit;
%mend match_main;
%macro note /store;
%if &_error_=0 and &syserr=0 %then
%do;
%put WARNING- *****************************************************;
%put WARNING- * MACRO MATCHCC: Execution completed successfully ! *;
%put WARNING- *****************************************************;
%end;
%if &_error_ ne 0 or &syserr ge 4 %then
%do;
%put ERROR- **************************************;
%put ERROR- * MACRO MATCHCC: An error occurred ! *;
%put ERROR- **************************************;
%end;
%mend;
%verify_parameter
%match_pretreatment
%match_main
%note
%mend matchcc;[/code:3rnk6uwp] |
|
楼主
