dc/sas/sasjs/macros/mpe_derived.sas

/**
  @file
  @brief Generates the SAS statements that create derived variables
  @details Derived (computed) variables are configured in MPE_DERIVED.  Each
  row defines one variable, which is created in a DATA step view ahead of the
  filter, so that it can be filtered on in the EDIT screen.

  The macro writes the generated statements to a fileref, so that callers can
  compose them into a view:

      %mpe_derived(libds=&libds,dclib=&mpelib,outref=dercode)
      data work.vw_derived / view=work.vw_derived;
        set &libds;
        %include dercode;
      run;

  Alternatively, pass outview= and the macro will build the view itself.

  The filter must be applied by the caller, in the step that reads the view:

      data out;
        set work.vw_derived;
        where %inc filtref;;
      run;

  A WHERE statement applies to the data set named on the SET statement, so it
  cannot reference a variable that is created in the same data step.  Applying
  it to the view puts the derived variables on the input, which is what makes
  them filterable.

  Each statement block is of the form:

      attrib REGION length=$21 label='REGION=<expression>' format=$21.;
      REGION = <expression>;

  Type and length are declared by the administrator, so the result is
  deterministic, and a derived variable may shadow a physical column - the
  expression then reads the physical value, eg SUMMER = SUMMER + 1 - in which
  case VAR_TYPE and VAR_LEN must match the column, as attrib cannot change
  either on an existing variable.  The label is the variable name, an equals
  sign and the expression.

  VAR_DEPS lists every input the expression uses - physical columns and
  derived variables alike.  The statements are generated in dependency order,
  so a derived variable may build on another one without a sequence number
  being maintained.  A cycle is rejected.

  The declaration is checked against the expression: a derived variable that
  is referenced must be declared, a declared name that is not referenced is an
  error, and a declared name must be a column of the target table or a derived
  variable defined for it.

  Semicolons, macro triggers and comments are rejected, so a row can only ever
  be an expression.

  <h4> SAS Macros </h4>
  @li mf_existds.sas
  @li mf_getuniquename.sas
  @li mf_nobs.sas
  @li mp_abort.sas
  @li mp_getcols.sas

  @param [in] libds= The target table (libref.dataset, lib must be assigned)
  @param [in] dclib= The Data Controller control library
  @param [out] outref= (0) Fileref to receive the generated statements
  @param [out] outvars= (work.derived_vars) Dataset of derived variable names
  @param [in] outview= (0) Optional two-level name for the derived view

  @version 9.2
  @author 4GL Apps Ltd
  @copyright 4GL Apps Ltd.  This code may only be used within Data Controller
    and may not be re-distributed or re-sold without the express permission of
    4GL Apps Ltd.

**/

%macro mpe_derived(libds=,
  dclib=,
  outref=0,
  outvars=work.derived_vars,
  outview=0
);

%local physlist derived_err resv_list i w left nready nplaced
  cyc_start cyc_cur cyc_next cyc_path cyc_seen cyc_i
  ds_cfg ds_byname ds_bad ds_baddep ds_dup ds_dep ds_ref ds_stale
  ds_undecl ds_self ds_shadow ds_cols ds_edge ds_todo ds_ready ds_placed ds_srt;

/* every working table gets its own name, so a caller with tables of the same
  name in WORK cannot collide with this macro's intermediates */
%let ds_cfg=%mf_getuniquename(prefix=dvcfg);
%let ds_byname=%mf_getuniquename(prefix=dvbyn);
%let ds_bad=%mf_getuniquename(prefix=dvbad);
%let ds_baddep=%mf_getuniquename(prefix=dvbdp);
%let ds_dup=%mf_getuniquename(prefix=dvdup);
%let ds_dep=%mf_getuniquename(prefix=dvdep);
%let ds_ref=%mf_getuniquename(prefix=dvref);
%let ds_stale=%mf_getuniquename(prefix=dvstl);
%let ds_undecl=%mf_getuniquename(prefix=dvund);
%let ds_self=%mf_getuniquename(prefix=dvsfl);
%let ds_shadow=%mf_getuniquename(prefix=dvshw);
%let ds_cols=%mf_getuniquename(prefix=dvcol);
%let ds_edge=%mf_getuniquename(prefix=dvedg);
%let ds_todo=%mf_getuniquename(prefix=dvtd);
%let ds_ready=%mf_getuniquename(prefix=dvrdy);
%let ds_placed=%mf_getuniquename(prefix=dvpld);
%let ds_srt=%mf_getuniquename(prefix=dvsrt);

%mp_abort(iftrue= (%length(&libds)=0 or %length(&dclib)=0)
  ,mac=&sysmacroname
  ,msg=%str(Missing: libds dclib)
)
%mp_abort(iftrue= (&outref = 0)
  ,mac=&sysmacroname
  ,msg=%str(Please provide an outref for the generated statements)
)
%mp_abort(iftrue= (%mf_existds(libds=&libds) ne 1)
  ,mac=&sysmacroname
  ,msg=%str(Target table not found: &libds)
)

filename &outref temp;

/* ensure the outputs exist, and are empty */
data _null_;
  file &outref;
run;
data &outvars(keep=name);
  length name $32;
  name='';
  if 0;
run;

%if %mf_existds(libds=&dclib..mpe_derived) ne 1 %then %do;
  %put &sysmacroname: &dclib..MPE_DERIVED not found - no derived variables;
  %return;
%end;

data work.&ds_cfg.;
  set &dclib..mpe_derived;
  where &dc_dttmtfmt lt tx_to
    and active=1
    and upcase(libref)="%upcase(%scan(&libds,1,.))"
    and upcase(dsn)="%upcase(%scan(&libds,2,.))";
  length name $32 logic $4000 fmt $32 deps $4000;
  name=upcase(strip(var_nm));
  logic=strip(var_logic);
  type=upcase(strip(var_type));
  len=var_len;
  fmt=strip(upcase(var_fmt));
  deps=upcase(strip(var_deps));
run;

%if %mf_nobs(work.&ds_cfg.)=0 %then %return;

proc sort data=work.&ds_cfg. out=work.&ds_byname.;
  by name;
run;

/* one contents pass gives the names, types and lengths.  The type and length
  matter when a derived variable shadows a physical column. */
%mp_getcols(&libds, outds=work.&ds_cols)

%let physlist=;
proc sql noprint;
select quote(name) into: physlist separated by ','
  from work.&ds_cols;
quit;
/* a table with no columns still has to compile into a valid in-list */
%if %length(&physlist)=0 %then %let physlist=%str(%'%');
%let physlist=%upcase(&physlist);

/* names that may never be used - DC's own metadata columns */
%let resv_list=%str("_____DELETE__THIS__RECORD_____","TX_FROM","TX_TO","PROCESSED_DTTM","VAR_TXFROM","VAR_TXTO","VAR_PROCESSED");

/**
  * Reject anything that could break the generated data step, or that would
  * produce a variable we cannot describe to the caller
  */
data work.&ds_bad.;
  set work.&ds_byname.;
  length reason $200;
  call missing(reason);

  if name='' then reason='VAR_NM is required';
  else if verify(strip(name),'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_')>0
    then reason='VAR_NM must be a valid SAS name';
  else if verify(substr(name,1,1),'0123456789')=0
    then reason='VAR_NM must not start with a digit';
  else if name in (%unquote(&resv_list))
    then reason='VAR_NM is reserved';
  else if type not in ('C','N')
    then reason='VAR_TYPE must be C or N';
  else if missing(len) or len ne int(len) or len<1
    then reason='VAR_LEN must be a positive integer';
  else if type='C' and len>32767
    then reason='VAR_LEN exceeds 32767 for a character variable';
  else if type='N' and len>8
    then reason='VAR_LEN exceeds 8 for a numeric variable';
  else if index(fmt,';')>0 or indexc(fmt,'&%')>0
    or index(fmt,'/*')>0 or index(fmt,'*/')>0
    then reason='VAR_FMT must be a format name, without ; & % or //*';
  else if verify(strip(fmt),'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_$.')>0
    then reason='VAR_FMT must be a format name';
  else if missing(logic)
    then reason='VAR_LOGIC is required';
  else if index(logic,';')>0
    then reason='VAR_LOGIC must be a single expression - remove the ;';
  else if indexc(logic,'&%')>0
    then reason='VAR_LOGIC must not contain macro triggers';
  else if index(logic,'/*')>0 or index(logic,'*/')>0
    then reason='VAR_LOGIC must not contain comments';

  if missing(reason)=0 then output;
run;

data work.&ds_dup.;
  set work.&ds_byname.;
  by name;
  length reason $200;
  if first.name and not last.name;
  reason='VAR_NM is defined more than once';
run;

proc append base=work.&ds_bad. data=work.&ds_dup.;
run;

/**
  * The declared dependencies, one row per word
  */
data work.&ds_dep.;
  set work.&ds_byname.;
  length dep_nm $32;
  do i=1 to countw(deps,' ');
    dep_nm=scan(deps,i,' ');
    if not missing(dep_nm) then output;
  end;
  keep name dep_nm;
run;

/**
  * The identifiers the expression actually references - quoted strings are
  * removed first, so a name inside a literal is not mistaken for a reference
  */
data work.&ds_ref.;
  set work.&ds_byname.;
  length l $4000 tok $32;
  l=prxchange("s/'([^']|'')*'//",-1,logic);
  l=prxchange('s/"([^"]|"")*"//',-1,l);
  l=prxchange('s/[^A-Za-z0-9_]/ /',-1,upcase(l));
  do i=1 to countw(l,' ');
    tok=scan(l,i,' ');
    if not missing(tok) then output;
  end;
  keep name tok;
run;

/* a declared name must resolve - to a column of the target, or to a variable
  in this configuration */
proc sql noprint;
create table work.&ds_baddep. as
  select d.name, d.dep_nm
  from work.&ds_dep. d
  where d.dep_nm not in (%unquote(&physlist))
    and d.dep_nm not in (select name from work.&ds_byname.);

/* every declared name must actually appear in the expression */
create table work.&ds_stale. as
  select d.name, d.dep_nm
  from work.&ds_dep. d
  where not exists (
    select 1 from work.&ds_ref. r
    where r.name=d.name and r.tok=d.dep_nm
  );

/* a derived variable referenced by the expression must be declared, otherwise
  the statement order would be wrong and the value would be silently missing */
create table work.&ds_undecl. as
  select distinct r.name, r.tok as dep_nm
  from work.&ds_ref. r
  where r.tok in (select name from work.&ds_byname.)
    and r.tok ne r.name
    and not exists (
      select 1 from work.&ds_dep. d
      where d.name=r.name and d.dep_nm=r.tok
    );

/* a variable may not depend on itself */
create table work.&ds_self. as
  select name, dep_nm from work.&ds_dep.
  where name=dep_nm
    and name not in (%unquote(&physlist));

/* a derived variable may shadow a physical column, but the two must agree on
  type and length - attrib cannot change either on an existing variable */
create table work.&ds_shadow. as
  select c.name, c.type, c.len, p.type as ptype, p.length as plen
  from work.&ds_byname. c
  inner join work.&ds_cols. p
    on c.name=p.name
  where c.type ne p.type
    or (c.type='C' and c.len gt p.length)
    or (c.type='N' and c.len ne p.length);
quit;

%if %mf_nobs(work.&ds_baddep.)>0 %then %do;
  data _null_;
    set work.&ds_baddep.(obs=1);
    call symputx('derived_err'
      ,cats(name,': VAR_DEPS lists ',dep_nm
        ,', which is not a column of the table or a derived variable'));
  run;
  %mp_abort(iftrue=1,mac=&sysmacroname,msg=%superq(derived_err))
%end;

%if %mf_nobs(work.&ds_shadow.)>0 %then %do;
  data _null_;
    set work.&ds_shadow.(obs=1);
    call symputx('derived_err'
      ,cats(name,': VAR_NM shadows a column of the table, so VAR_TYPE and'
        ,' VAR_LEN must match it - the column is ',ptype,'(',plen,')'));
  run;
  %mp_abort(iftrue=1,mac=&sysmacroname,msg=%superq(derived_err))
%end;

%if %mf_nobs(work.&ds_self.)>0 %then %do;
  data _null_;
    set work.&ds_self.(obs=1);
    call symputx('derived_err',cats(name,': VAR_DEPS may not list itself'));
  run;
  %mp_abort(iftrue=1,mac=&sysmacroname,msg=%superq(derived_err))
%end;

%if %mf_nobs(work.&ds_undecl.)>0 %then %do;
  data _null_;
    set work.&ds_undecl.(obs=1);
    call symputx('derived_err'
      ,cats(name,': VAR_LOGIC references ',dep_nm
        ,', which is not in VAR_DEPS'));
  run;
  %mp_abort(iftrue=1,mac=&sysmacroname,msg=%superq(derived_err))
%end;

%if %mf_nobs(work.&ds_stale.)>0 %then %do;
  data _null_;
    set work.&ds_stale.(obs=1);
    call symputx('derived_err'
      ,cats(name,': VAR_DEPS lists ',dep_nm
        ,', which VAR_LOGIC does not reference'));
  run;
  %mp_abort(iftrue=1,mac=&sysmacroname,msg=%superq(derived_err))
%end;

%if %mf_nobs(work.&ds_bad.)>0 %then %do;
  data _null_;
    set work.&ds_bad.;
    putlog 'ERR' 'OR: derived variable config: ' name= reason=;
  run;
  data _null_;
    set work.&ds_bad.(obs=1);
    call symputx('derived_err',cats(name,': ',reason));
  run;
  %mp_abort(iftrue=1
    ,mac=&sysmacroname
    ,msg=%str(Invalid derived variable configuration - &derived_err)
  )
%end;

/**
  * Dependency order.  The edges are between derived variables only - a
  * physical column is available from the start.  Repeatedly take the variables
  * whose derived inputs have all been placed, alphabetically within a round;
  * if a round places nothing, what is left is a cycle.
  */
proc sql;
create table work.&ds_edge. as
  select d.name as child, d.dep_nm as parent
  from work.&ds_dep. d
  where d.dep_nm in (select name from work.&ds_byname.)
    and d.dep_nm ne d.name;
quit;

data work.&ds_todo.(keep=name);
  set work.&ds_byname.;
run;

data work.&ds_placed.(keep=name seq);
  length name $32;
  name='';
  seq=0;
  if 0;
run;

%let left=%mf_nobs(work.&ds_todo.);
%let nplaced=0;

%do %while (&left>0);
  proc sql;
  create table work.&ds_ready. as
    select t.name
    from work.&ds_todo. t
    where not exists (
      select 1 from work.&ds_edge. e
      inner join work.&ds_todo. t2 on e.parent=t2.name
      where e.child=t.name
    )
    order by t.name;
  quit;

  %let nready=%mf_nobs(work.&ds_ready.);
  %if &nready=0 %then %do;
    /* walk the edges, so the message names the cycle rather than just the
      names that could not be placed */
    data _null_;
      set work.&ds_todo.(obs=1);
      call symputx('cyc_start',name);
    run;
    %let cyc_path=&cyc_start;
    %let cyc_cur=&cyc_start;
    %let cyc_seen=%str(.&cyc_start..);
    %do cyc_i=1 %to &left;
      %let cyc_next=;
      proc sql noprint;
        select e.parent into: cyc_next
        from work.&ds_edge. e
        where e.child="&cyc_cur"
          and e.parent in (select name from work.&ds_todo.);
      quit;
      %if %length(&cyc_next)=0 %then %let cyc_i=&left;
      %else %do;
        %let cyc_path=&cyc_path. -> &cyc_next;
        %if %index(&cyc_seen,%str(.&cyc_next..))>0 %then %let cyc_i=&left;
        %else %do;
          %let cyc_seen=&cyc_seen.&cyc_next..;
          %let cyc_cur=&cyc_next;
        %end;
      %end;
    %end;
    %mp_abort(iftrue=1
      ,mac=&sysmacroname
      ,msg=%str(VAR_DEPS contains a cycle: &cyc_path)
    )
  %end;

  /* seq carries the dependency order - the placement rounds are not name
    ordered, so the final merge must not rely on by name alone */
  data work.&ds_ready.;
    set work.&ds_ready.;
    seq=_n_+&nplaced;
  run;
  proc append base=work.&ds_placed. data=work.&ds_ready. force;
  run;
  %let nplaced=%eval(&nplaced+&nready);

  proc sql;
  delete from work.&ds_todo.
    where name in (select name from work.&ds_ready.);
  quit;

  %let left=%mf_nobs(work.&ds_todo.);
%end;

proc sort data=work.&ds_placed.;
  by name;
run;

data work.&ds_srt.;
  merge work.&ds_placed.(in=in1) work.&ds_byname.(in=in2);
  by name;
  if in1 and in2;
run;

proc sort data=work.&ds_srt.;
  by seq;
run;

/**
  * Generate the attrib + assignment statements
  */
data _null_;
  file &outref;
  set work.&ds_srt.;
  length stmt $4100 label $256 fmt2 $49;
  /* labels cannot contain single quotes, and are limited to 256 chars */
  label=cats(name,'=',translate(logic,' ','0D0A'x));
  label=tranwrd(label,"'","''");
  label=substr(label,1,256);
  if not missing(fmt) and index(fmt,'.')=0 then fmt=cats(fmt,'.');
  if type='C' then do;
    if missing(fmt) then fmt2=cats('$',len,'.');
    else fmt2=fmt;
    stmt=catx(' ','attrib',name,cats('length=$',len)
      ,cats("label='",label,"'"),cats('format=',fmt2,';'));
  end;
  else do;
    if missing(fmt) then fmt2=cats(len,'.');
    else fmt2=fmt;
    stmt=catx(' ','attrib',name,cats('length=',len)
      ,cats("label='",label,"'"),cats('format=',fmt2,';'));
  end;
  put stmt;
  stmt=cats(name,' = ',logic,';');
  put stmt;
run;

%mp_abort(iftrue= (&syscc ne 0)
  ,mac=&sysmacroname
  ,msg=%str(Unable to generate derived variables for &libds)
)

data &outvars(keep=name);
  set work.&ds_srt.;
run;

%if %length(&outview)>0 and &outview ne 0 %then %do;
  data &outview / view=&outview;
    set &libds;
    %include &outref;
  run;
  %mp_abort(iftrue= (&syscc ne 0)
    ,mac=&sysmacroname
    ,msg=%str(Unable to build derived view &outview for &libds)
  )
%end;

%mend mpe_derived;