Empirical reverse culmulative density function

Reply
N/A
Posts: 0

Empirical reverse culmulative density function

Hi,

I would like to plot an reverse culmulative density function (i.e. decreasing curve with percentile of sample Y-axis vs value of data X-axis). Since I don't have a SAS/QC PROC CAPACITY, I wonder if there is a sample SAS program written somewhere before I re-invent the wheel.

Thank you,
Martin
N/A
Posts: 0

Re: Empirical reverse culmulative density function

Hi,

I have a early (developed about year 2000, see codes below) macro to do that . But please adapt it to suit your needs. Try it also with the example code at the end.


%macro Cumucuv( Data= /* data set name being processed */
, Where= /* optional, to subset data per your preference */
, Resvar= /* Var. name of interest to be processed */
, Group= /* Var. name of strata, ex: group_NB, activity */
, V_label= /* V-axis label, default is " % " */
, H_label= /* Label of H-axis for result values */
, L_label= /* Label of treatment group in legend area */
, L_local= /* Legend pos.,TR, TC, TL; MR, MC, ML; BR, BC, BL
as Top|Middle|Bottom|Left|Center|Right */
, Sendout= /* Exact Path where to save the graph */
, Figname= /* name of out graph, use "data_cumcuv" if blank */
, Figtype= /* GIF, CGM, HPGL etc. GIF as default */
, Logscal= /* Use log-scale, default 10, can be E, PI ... */
, Symcolr= /* blank for black-white, non-missing for colored */
, Tikmark= /* min/max/step, for log-scale, separate by space */
, Cut_off= /* give value to add vertical ref. line in graph */
, INT_POL= /* default "STEPJR", "STEPJL" for reverse, NONE */
, Rev_cuv= /* Y to produce Reverse Cumulative Curve */
);

/*-- check &data & key macro vars exist in &data */
%let _dsin=&data;
%let Resvar=%upcase(&resvar);
%let group =%upcase(&group);
%let _KnamV=&resvar &group;
%let rc=%sysfunc(exist(&_dsin));
%if &rc=0 %then %do;
%put !-------------------------------------------------------------!;
%put ! The data set "&_dsin" does not exist, Please specify again. !;
%put !_____________________________________________________________!;
%goto OUT;
%end;

%let _cnt=0;
%let word=%qscan(&_Knamv, 1);
%do %while (&word ne );
%let _cnt=%eval(&_cnt+1);
%let word=%qscan(&_Knamv, &_cnt);
%let _kvnam&_cnt=&word;
%end;
%Let _cnkv=%eval(&_cnt-1);

** count how many var in "&_dsin" to be processed by macro **;
%let dsid=%sysfunc(open(&_dsin));
%let _count=%sysfunc(attrn(&dsid,nvars));

** loop to check if the key macro vars are among the vars in &_dsin **;
%let _Kvcum=0;
%let _vn=1;
%do %while (&_vn <= &_cnkv);
%let _KeyV=0;
%let i=1;
%do %while (&i <= &_count);
%let _Var&i=%sysfunc(varname(&dsid,&i));
%*put &&_var&i;
%if &&_kvnam&_vn=%upcase(&&_var&i) %then %do;
%let _keyV=%eval(&_keyV+1);
%let _kvcum=%eval(&_kvcum+1);
%end;
%let i=%eval(&i+1);
%end;
%if &_keyV=0 %then %do;
%let _namerr=&&_kvnam&_vn;
%put !--------------------------------------------------------------------------!;
%put ! Var.: "&_namerr" does not exist in data: "%upcase(&_dsin)", please check !;
%put !__________________________________________________________________________!;
%end;
%let _vn=%eval(&_vn+1);
%end;
%let rc=%sysfunc(close(&dsid));
%if &_kvcum < &_cnkv %then %do;
%goto out;
%end;

/*-- if "where = " process specified */
%let _wherein= ;
%if %bquote(&where) ne %then %do;
%let _wherein=(where=(&where));
%end;

/*-- H_axis label for var to be processed */
%if %bquote(&H_label)= %then %do;
%let H_label =%upcase(&ResVar);
%end;

/*-- add cut-off(if specified) for Hlabel */
%if %bquote(&Cut_off) ^= and %bquote(&Rev_cuv) ^= %then %do;
%let H_label =%str(&H_label, Cut-off=&Cut_off);
%end;

/*-- V_axis label for percent */
%if %bquote(&V_label)= %then %do;
%let _Vlabel=Percent;
%end;

%if %bquote(&V_label) ^= %then %do;
%let _Vlabel =%str(Percent of &V_label);
%end;

/*-- Default legenda label as &Group: */
%let _Leglab = %upcase(&group):;
%if %bquote(&L_label) ne %then %do;
%let _Leglab = %upcase(&L_label):;
%end;

/*-- if result variable has character values */
proc contents data=&data out=_outcum noprint; run;

data _null_;
set _outcum;
if upcase(name)="&ResVar" then call symput("_Rvtype", trim(left(type)));
run;
%*put *** &_Rvtype;

%if &_Rvtype=2 %then %do;
data _forcum &_wherein.; set &data;
_newres=input(&resVar, Best.);
if _newres = . then delete;
run;
%end;

%else %do;
data _forcum &_wherein.; set &data;
_newres=&resVar;
if _newres = . then delete;
run;
%end;

/*-- check if where process successful */
%let dsid=%sysfunc(open(_forcum));
%let _obsin=%sysfunc(attrn(&dsid,nobs));
%let rc=%sysfunc(close(&dsid));
%if &_obsin=0 %then %do;
%put !------------------------------------------------------------------------!;
%put ! Subset data has 0 obs entered, please check your "WHERE" specification !;
%put !________________________________________________________________________!;
%goto out;
%end;

%if %upcase(&logscal)=E %then %do;
%let logscal=2.7182818284590;
%end;

%if %upcase(&logscal)=PI %then %do;
%let logscal=3.14159265358979;
%end;

/*-- if by &group process */
%if %bquote(&group)= %then %do;
%let _Byin= ;
%Let _eqgrp=;
%let _nmobs=1;
%end;

%else %do;
%let _Byin =By &group;
%Let _eqgrp=%str(=&group);

proc sort data=_forcum;
by &group;
run;

/*-- count how many groups and the values of the group */
data _grp(keep=&group);
set _forcum;
proc sort nodupkey;
by &group;
run;

/*-- if group variable has character values */
proc contents data=_grp out=_gtype noprint; run;
data _null_;
set _gtype;
call symput("_Gtype", trim(left(type)));
run;
%*put ***Group type: &_Gtype;

data _null_;
set _grp end=eof;
if eof then call symput("_nmobs",trim(left(_N_)));
run;
%*put ***Group NB: &_nmobs;

proc transpose data=_grp out=_outg prefix=_G; var &group; run;

/*-- loop to set group values into macro var. */
%Let i=1;
%do %while(&i <= &_nmobs);
data _null_;
set _outg;
call symput("_Gv&i", trim(left(_G&i)));
run;
%let i=%eval(&i+1);
%end;
%end;

proc freq noprint data=_forcum;
tables _newres/out=_resfrq;
&_byin.;
run;

/*-- set ticks in plot parameters */
%let _Lgtik=;
%let _order=;
%let _Lgord=;

%if %bquote(&Logscal) ^= %then
%do;
%let _Lgtik=Y;
data null_; set _resfrq; where _newres <=0; run;

%let dsid=%sysfunc(open(null_));
%let _obsin=%sysfunc(attrn(&dsid,nobs));
%let rc=%sysfunc(close(&dsid));
%if &_obsin > 0 %then
%do;
%put !----------------------------------------------------------!;
%put !NOTE: &_obsin obs with values <=0 are not counted for log-scale !;
%put !__________________________________________________________!;
%end;

/* all positive values for logscale */
data _resfrq; set _resfrq; if _newres <= 0 then delete; run;

%if %bquote(&tikmark) = %then
%do;
data _minres; set _resfrq; Proc sort; by _newres; run;
data _null_; set _minres;
if _N_=1 then call symput("_minr", trim(left(_newres)));
run;

%if %bquote(&_minr) >= 1 %then
%do;
%let int_r=%sysfunc(floor(&_minr));
%let Len_R=%length(&int_r);
%let tik_L=%eval(&len_R-1);
%let tik_one=%sysevalf(&Logscal**&tik_L);
%end;

%if %bquote(&_minr) < 1 %then
%do;
%let _cnt=3;
%let _cnt0=1;
%let Td=%substr(&_minr, &_cnt,1);
%do %while (&td=0 );
%let _cnt=%eval(&_cnt+1);
%let td = %substr(&_minr, &_cnt,1);
%put &_cnt;
%let _cnt0=%eval(&_cnt-2);
%end;
%put Cnt: -&_cnt0 ***;
%let tik_one=%sysevalf(1/(&Logscal**&_cnt0));
%put tik_ONE: &tik_one;
%end;
%end;

%if %bquote(&tikmark) ne %then
%do;
%let _Utik=%index(&tikmark,/);
%if &_Utik ^=0 %then
%do;
%put !----------------------------------------------------------!;
%put ! Please enter tick marks separated by blank for log scale !;
%put !__________________________________________________________!;
%goto out;
%end;

%if &_Utik=0 %then
%do;
%let tik_one=%scan(&tikmark, 1, " ");
%let _Lgord=%str(order=(&tikmark));
%end;
%end;
%end;

%if &Logscal= %then
%do;
%let _Lgtik=N;
%if %bquote(&tikmark)= %then %do;
%let _order= ;
data _minres; set _resfrq; Proc sort; by _newres; run;
data _null_; set _minres;
if _N_=1 then call symput("_minr", trim(left(floor(_newres))));
run;
%put Min res: &_minr;
%let tik_one=%sysevalf(&_minr-1);
%put 1st tick: &tik_one;
%end;
%if %bquote(&tikmark) ne %then %do;
%let _Utik=%index(&tikmark,/);
%*put ***_UTIK: &_UTIK;
%if &_Utik=0 %then %do;
%put !---------------------------------------------------------!;
%put ! Please enter tik mark as: Min/Max/Step for normal scale !;
%put !_________________________________________________________!;
%goto out;
%end;
%if &_Utik ^= 0 %then %do;
%let mintik =%scan(&tikmark, 1, /);
%let maxtik =%scan(&tikmark, 2, /);
%let steptik=%scan(&tikmark, 3, /);
%let tik_one=&mintik;
%let _ord=%str(&mintik to &maxtik by &steptik);
%let _order=%str(order=(&_ord));
%end;
%end;
%end;
%*put *** tik: &_order;
%*put *** Logtik: &_Lgord;

/*------ data preparing for plot ----*/
%let _per_rv=%str(per_rv=pct_cumSmiley Wink;
%if %bquote(&Rev_cuv) ^= %then %do;
%let _per_rv=%str(per_rv=100 - pct_cumSmiley Wink;
%end;

%if %bquote(&group)= %then %do;
proc sql;
create table _resadd(_newres numeric, count numeric, percent numeric);
insert into _resadd
values(&tik_one, 0, 0);
quit;
data _cumup; set _resadd _resfrq;
retain pct_cum 0 cnt_cum 0;
pct_cum + percent;
cnt_cum + count;
&_per_rv;
run ;
%end;

%if %bquote(&group) ne %then %do;
%if &_gtype=1 %then %do;
%Let i=1;
%do %while(&i <= &_nmobs);
proc sql;
create table _resadd(_newres numeric, count numeric, percent numeric, &group numeric);
insert into _resadd
values(&tik_one, 0, 0,&&_Gv&i);
quit;
data _cumu&i;
set _resadd _resfrq(where=(&group=&&_Gv&i));
retain pct_cum 0 cnt_cum 0;
pct_cum + percent;
cnt_cum + count;
&_per_rv;
run ;
%let i=%eval(&i+1);
%end;
%end;
%if &_gtype=2 %then %do;
%Let i=1;
%do %while(&i <= &_nmobs);
proc sql;
create table _resadd(_newres numeric, count numeric, percent numeric, &group char);
insert into _resadd
values(&tik_one, 0, 0,"&&_Gv&i");
quit;
data _cumu&i;
set _resadd _resfrq(where=(&group="&&_Gv&i"));
retain pct_cum 0 cnt_cum 0;
pct_cum + percent;
cnt_cum + count;
&_per_rv;
run ;
%let i=%eval(&i+1);
%end;
%end;

data _cumup;
set %do n=1 %to &_nmobs;
_cumu&n
%end;;
run;
%end;

/*-- if send graph out */

GOPTIONS RESET=all;

%if %bquote(&sendout) ^= %then %do;

%let _rotate=%str(rotate=landscape);

%if %bquote(&figname) = %then %do;
%let figname=&data._&Resvar._cumcuv;
%end;

%if %bquote(&figtype) ^= %then %do;
%let _gtype=&figtype;
%LET _dev =&figtype;
%end;

%if %upcase(&figtype)=GIF or %bquote(&figtype)= %then %do;
%put *** The Default Type of Graph for Sending Out Is "GIF" ***;
%let _gtype=GIF;
%LET _dev =GIF;
%end;

%if %upcase(&figtype)=CGM %then %do;
%let _gtype=CGM;
%LET _dev =cgmof97l;
%let _rotate= ;
%end;

FILENAME grafout "&sendout\&figname..&_gtype";
GOPTIONS border &_rotate. Ftext=SWISS CBACK=white COLORS=(black)
DEVICE=&_dev. GSFNAME=grafout GSFMODE= REPLACE;
%end;


/*-- loop on plot symbol for diff. groups */
%if %bquote(&INT_POL) = %then %do;
%let int_pol=STEPJL;
%end;

%let _plotsymb=DOT TRIANGLE SQUARE CIRCLE STAR DIAMOND PLUS HASH # @ X Y Z A B C U V;
%let _pltcolor=BL R B G Y P GR LIB VIOLET GOLD CYAN TAN ROSE CREAM PINK MAROON OLIVE STEEL;

%let _cnt=1;
%do %while ( &_cnt <= &_nmobs);
%let _symb&_cnt=%qscan(&_plotsymb, &_cnt);
%let _colr&_cnt=%qscan(&_pltcolor, &_cnt);

%if &symcolr = %then %do;
SYMBOL&_cnt COLOR=BLACK INTERPOL=&INT_POL VALUE=&&_symb&_cnt HEIGHT=1.0;
%end;

%if &symcolr ^= %then %do;
SYMBOL&_cnt COLOR=&&_colr&_cnt INTERPOL=&INT_POL VALUE=&&_symb&_cnt HEIGHT=1.0;
%end;
%let _cnt=%eval(&_cnt+1);
%end;

AXIS1 LABEL=(HEIGHT=1.3 ANGLE = 90 "&_Vlabel") ORDER=(0 TO 100 BY 20) WIDTH=1;

%if &_lgtik=Y %then %do;
AXIS2 LOGBASE=&logscal LOGSTYLE=EXPAND label=(HEIGHT=1.4 "&H_label.") &_Lgord WIDTH=1;
%end;

%if &_lgtik=N %then %do;
AXIS2 label=(HEIGHT=1.4 "&H_label.") &_order WIDTH=1;
%end;

/*-- legend box positioning */
%if &L_local= %then %do; %let L_local=TR; %end;

%if %upcase(&L_local)=TL %then %do; %let _L_local=TOP LEFT inside; %let _offset=%str(OFFSET=( 5,-2)); %end;
%if %upcase(&L_local)=TC %then %do; %let _L_local=TOP CENTER inside; %let _offset=%str(OFFSET=( 0,-2)); %end;
%if %upcase(&L_local)=TR %then %do; %let _L_local=TOP RIGHT inside; %let _offset=%str(OFFSET=(-6,-2)); %end;

%if %upcase(&L_local)=ML %then %do; %let _L_local=MIddle LEFT inside; %let _offset=%str(OFFSET=( 5,2)); %end;
%if %upcase(&L_local)=MC %then %do; %let _L_local=MIddle CENTER inside;%let _offset=%str(OFFSET=( 0,2)); %end;
%if %upcase(&L_local)=MR %then %do; %let _L_local=MIddle RIGHT inside; %let _offset=%str(OFFSET=(-6,2)); %end;

%if %upcase(&L_local)=BL %then %do; %let _L_local=BOTTOM LEFT inside; %let _offset=%str(OFFSET=( 5,4)); %end;
%if %upcase(&L_local)=BC %then %do; %let _L_local=BOTTOM CENTER inside;%let _offset=%str(OFFSET=( 0,4)); %end;
%if %upcase(&L_local)=BR %then %do; %let _L_local=BOTTOM RIGHT inside; %let _offset=%str(OFFSET=(-6,4)); %end;

/*-- vertical cut-off reference line */
%if %bquote(&cut_off) = %then %do;
%let _cutoff= ;
%end;

%if %bquote(&cut_off) ^= %then %do;
%let _cutoff=%str(HREF=&cut_off LHREF=4);
%end;

LEGEND ACROSS=1
MODE=SHARE
SHAPE=SYMBOL(5,0.8)
LABEL=(POSITION=TOP J=L "&_Leglab")
VALUE=(J=L)
POSITION=(&_L_local)
&_offset;

PROC GPLOT DATA=_cumup;
PLOT per_rv*_newres&_eqgrp./Frame &_cutoff VAXIS=axis1 HAXIS=axis2
LEGEND=legend;
RUN;
QUIT;

%if %bquote(&sendout) ne %then %do;
FILENAME Grafout CLEAR;
%end;

/*-- reset all goptions */
GOPTIONS RESET=All;

/*-- drop all intermediate tables */
proc sql;
drop table _forcum, _outcum, _minres,
%if &group ne %then %do n=1 %to &_nmobs;
_cumu&n,
%end;
%if &group ne %then _grp, _gtype, _outg,;
%if &Logscal ne %then null_,;
_resadd, _resfrq;
quit;
%out:
%mend cumucuv;

/**---- Example To Run -----------------------------------**
** for reverse cumulative curve ***;
%cumucuv( data = sashelp.class
,Resvar = age
, Group = sex
,Rev_cuv= y
);


%cumucuv( data = sashelp.class
,Resvar = age
, Group = sex
,Rev_cuv=
);
**----------------------------------------------------------**/
N/A
Posts: 0

Re: Empirical reverse culmulative density function

It might be a limit to paste all codes, if you want it, let me know your e-mail address and I can send the whole macro codes to you.
Ask a Question
Discussion stats
  • 2 replies
  • 337 views
  • 0 likes
  • 1 in conversation