/*NCLUSTERS: Number of clusters - positional & required. */
/*    DATA=: Input data set.  Default: last data set.    */
/*      ID=: ID variable from PROC CLUSTER.  The macro   */
/*           will guess if you don't specify a variable. */

%macro clustergroups(version, nclusters=, 
                     data=,    
                     id=);;   

%let _version=1.0;
%if &version ne %then %put ClusterGroups macro Version &_version;

%local i savenote abort;
%if %nrbquote(&data) eq %then %let data = &syslast;

%let savenote = %sysfunc(getoption(notes));
%let abort = 0;

options nonotes;   

/* Check for newer version */
 %if %sysevalf(&sysver >= 8.2) %then %do;
  %let _notfound=0;
  filename _ver url 'http://ftp.sas.com/techsup/download/stat/versions.dat' termstr=crlf;
  data _null_;
    infile _ver end=_eof;
    input name:$15. ver;
    if upcase(name)="&sysmacroname" then do;
       call symput("_newver",ver); stop;
    end;
    if _eof then call symput("_notfound",1);
    run;
  %if &syserr ne 0 or &_notfound=1 %then
    %put &sysmacroname: Unable to check for newer version;
  %else %if %sysevalf(&_newver > &_version) %then %do;
    %put &sysmacroname: A newer version of the &sysmacroname macro is available.;
    %put %str(         ) You can get the newer version at this location:;
    %put %str(         ) http://support.sas.com/ctx/samples/index.jsp;
  %end;
 %end;
   
data _null_;
   %if %nrbquote(&id) eq %then %do;
      if 0 then set &data(drop=_:);
      array __x[*] _all_;
      length __z $ 32;
      call vname(__x[1], __z);
      call symput('id', __z);
      put 'Note: Assuming that the ID variable is ' __z +(-1) '.';
      %end;

   n = input(symget('nclusters'), ?? 12.);
   if n le 1 then do;
      put "ERROR: NCLUSTERS=&nclusters is invalid.";
      call symput('abort', 1);
      end;
   if _error_ then call symput('abort', '1');
   run;

%if &syserr > 4 %then %let abort = 1; %if &abort %then %goto endit;

proc template;
   define statgraph __Dendrogram;
      begingraph / designheight=defaultdesignwidth designwidth=defaultdesignwidth;
         entrytitle "Cluster Analysis";
         layout overlay / yaxisopts=(discreteopts=(tickvaluefitpolicy=none));
            blockplot x=&id block=cluster / datatransparency=0.75 display=(fill);
            dendrogram nodeid=_name_ parentid=_parent_ clusterheight=_height_ /
                       orient=vertical primary=true;
            endlayout;
         endgraph;
      end;
   run;

%if &syserr > 4 %then %let abort = 1; %if &abort %then %goto endit;

data __init(keep=_name_);
   set &data;
   %do i = 1 %to &nclusters-1;
      if _name_ = "CL&i" then return;
      %end;
   %do i = 1 %to &nclusters-1;
      if _parent_ = "CL&i" then output;
      %end;
   if _error_ then call symput('abort', '1');
   run;
   
%if &syserr > 4 %then %let abort = 1; %if &abort %then %goto endit;

proc transpose data=__init out=__init(keep=list:) prefix=list;
   var _name_;
   run;

%if &syserr > 4 %then %let abort = 1; %if &abort %then %goto endit;
   
data __lists(keep=list:);
   k = nobs + 1 - _n_;
   set &data nobs=nobs point=k;
   length %do i = 1 %to &nclusters; list&i %end; $ 500;
   if _n_ = 1 then set __init;
   clname = _name_ =: 'CL' and n(input(substr(_name_, 3), ?? 12.));
   %do i = 1 %to &nclusters;
      if _parent_ ne ' ' and index(list&i, trim(_parent_) || ' ') and clname
         then list&i = catx(' ', list&i, _name_);
      %end;
   if k = 1 then do; output; stop; end;
   if _error_ then call symput('abort', '1');
   run;

%if &syserr > 4 %then %let abort = 1; %if &abort %then %goto endit;

data __tree2(drop=list:);
   set &data;
   if _n_ = 1 then set __lists;
   %do i = 1 %to &nclusters;
      if _parent_ ne ' ' and index(list&i, trim(_parent_) || ' ') then
         Cluster = &i;
      %end;
   %do i = 1 %to &nclusters;
      if nmiss(cluster) and list&i = _name_ then cluster = &i;
      %end;
   if _error_ then call symput('abort', '1');
   run;

%if &syserr > 4 %then %let abort = 1; %if &abort %then %goto endit;

options &savenote;

proc sgrender data=__tree2 template=__dendrogram;
run;

%if &syserr > 4 %then %let abort = 1; %if &abort %then %goto endit;

options nonotes;

proc datasets nolist;
   delete __init __lists __tree2;
   run; quit;

%if &syserr > 4 %then %let abort = 1; %if &abort %then %goto endit;

proc template;
   delete __dendrogram;
quit;

%if &syserr > 4 %then %let abort = 1; 

%endit:;
options &savenote;

%if &abort %then %put ERROR: The ClusterGroups macro ended abnormally.;

%mend;