*
;

             options nosource; /*
    SPLINE - CALCULATES SPLINED DATA FROM A FUNCTION IN PARAMETERFORM
             F=(X,Y) OR F(X) OR BORDERLINES FOR PROC GMAP IN THE FORM
             Y*X=ID. MISSING VALUES ARE ALLOWED FOR SKIPPING.

    Written:  February 4, 1993, modified: April 7 and October 22, 1993
                                          April 22, 1994 and Sept. 29, 94
    Developed using SAS 6.07 on VM/CMS and on AIX UNIX
    Run able: also in SAS 6.08 under Windows, and 6.09 on AIX UNIX
    Author: Arnold Schick
    Procs:  PROC MEANS, PROC DATASETS, PROC APPEND, PROC IML (FUNCTION SPLINE)
    Other:  SAS MACRO language
    Macros: SPLINE, BERECHNE (both included in this file)
    Notes:  Do not use _INITIA_, _TEMP_, _ONE_ID_, _MINMAX_, _RESULT_, _LINIEN_
            or _MISSI_ or _NEW_ as a data set name. Please don't call %SPLINE;
            or %SPLINE(); .

            The splined precision depends from the number of given points and
            the algorithm of SAS/IML SPLINE function which can differ to results
            of spline interpolation-option in SAS/GRAPH SYMBOL statement.

    Macro Call:  %SPLINE(DATA,RESULT,ADD,X,Y,ID,NUMB);


    MACRO VARIABLE      DESCRIPTION
    ------------------+-------------------------------------------------
    In Request:

    DATA                Name of SAS data set with input data. If this
                        paramenter is missing or blank _LAST_ is used.

    RESULT              Name of SAS data set created by this macro for
                        storing of the splined result. If missing or
                        blank an SAS data set name _NEW_ is used.

    ADD                 Option for the created SAS data set RESULT,
                        it has the values:
                        NOADD - SAS data set is being created, a previously
                                SAS data set with this name will be deleted.
                        ADD   - appends on SAS data set RESULT splined
                                data
                        .  or blank options have a meaning like NOADD.

    X                   Variblename of numeric independent variable in input
                        SAS data set DATA. If missing or blank X is used.

    Y                   Variablename of numeric dependent variable in input SAS
                        data set DATA. If missing or blank Y is used.

    ID                  Variablename of numeric group variable (Z-variable) in
                        input SAS data set DATA. If missing or blank ID is
                        used. In cases of F=(X) and ID is not present, ID
                        is created and has missing values.

    NUMB                Number of interpolation-points for the length 1 of one
                        polyline length. NUMB must be integer. If this parameter
                        is missing or blank the macro calculates nearly
                        200 points for the complete polyline length.
                        If NUMB is a negative integer, the positive number of
                        interpolation-points are used for X-axis range.
                        NUMB is per group/subgrup ID or subgroup between
                        missings for skipping, missing-points and a subgroup
                        with X-axis parallel-points will not be counted.

     Example:                             SAS program steps in depth:


     filename in 'map.dat';               *defines external input file;
     data one;                            *defines SAS data set;
       infile in;                         *reads from input file;
       input x y id;                      *names variables;
     run;
     data two;    *selects wanted observations from input SAS data set one;
       set one;
       where id in (2 47 48 49 50 51 52 156);
     run;
     %spline (two,three,,x,y,id);         *macro call for example above;

     %spline (zwei,drei,,z,y,x);          *case of function z=f(x,y);
                                          *ZWEI must be sorted by x before;

     %spline (uno,due,,x,y);              *case of function y=f(x);


    For more information:                 Dipl.-Ing. Arnold Schick

    Academic Computing Center        INTERNET: SCHICK@HRZ.UNI-MARBURG.DE
    University of Marburg
    Hans-Meerwein-Str.  Room 5619
    35032 Marburg/Lahn   Germany  Phone: 06421/28-3536


    This macro is provided 'as it is'. If you find an error-condition,
    you can transmit it to the author.

  */

%macro berechne(ergebnis,x,y,id,numb);
  options nosource nostimer nosymbolgen nonotes;
  %global ident ;
  %local miss;
  %let miss = no;

data _temp_
     _one_id_ (keep= &x &y &id);
  set _temp_ ;
  retain zweige 0;
  id_p = lag(&id);
  if zweige=0
    then do;  if _N_  = 1  or
         (id_p = &id and
          &x ^= .    and
          &y ^= . )
           then do; output _one_id_; delete; end;
           else if _N_ > 1 then do;
                              zweige=1;
                              if &id = . or &x = . or &y = .
                                then do;
                                  call symput('miss','yes');
                                  delete;
                                 end;
                            end;
    end;
  if zweige=1 then do; drop zweige id_p; output _temp_; end;
run;

 data _NULL_ ;
   if 0 then set _one_id_ nobs=last;
   call symput('leer',left(put(last,8.)));
   stop;
 run;

%if &leer = 1 %then %do;
  %put note:  Subgroup &ident has only 1 value, not appended to &ergebnis;
  %goto quit;
%end;
%if &numb < 0 %then %do;
  %let numb = &numb*-1;
  %let n=&numb;
  data _NULL_;
    set _one_id_ nobs=last;
    if last = 2 then call symput('n',2);
    if _N_ = 1 then call symput('ident',&id);
    stop;
  run;
  %goto direct;
%end;

data _initia_;
  set _one_id_ nobs=last;
  x_p = lag(&x);
  y_p = lag(&y);
  if _N_ = 1 then do;
                call symput('ident',&id);
                sum=0;
             end;
             else do;
               if  &x ^=. and  &y ^=. and
                  x_p ^=. and y_p ^=.
                    then sum + sqrt((&x-x_p)**2 + (&y-y_p)**2);
             end;
  if last = 2 then sum=1/&numb;
  if x_p = &x then delete;
  keep sum;
run;
proc means data=_initia_ noprint;
   var sum;
   output out=_linien_  max=laenge;
run;
data _null_;
  set _linien_;
  points = round(laenge*&numb+0.5,1);
  call symput ('n',points);
run;
%direct : ;
proc iml;
  use _one_id_;
  read all;
  call spline(yy,&x||&y,,,&n);
  xx=yy(|,1|); yy=yy(|,2|);
  create _result_ var{xx yy};
  append;
quit;

 %if &miss = yes %then %do;
   data _missi_;
     xx =. ;  yy =. ;
     output;
   run;
   proc append base=_result_ data=_missi_ force; run;
 %end;

data _result_;
  set _result_;
  rename xx=&x yy=&y;
  k=&ident/1;
  &id = k;
  drop k;
run;
%put note:   Subgroup &id &ident calculated.;
proc append base=&ergebnis data=_result_ force; run;
%quit : ;
%mend berechne;

%macro spline(data,ergebnis,add,x,y,id,numb);
options nosource nostimer nosymbolgen nonotes;
%local empty;
  %if &data =. or &data =  %then %let data = _last_ ;
  %if &ergebnis =. or &ergebnis =  %then %let ergebnis = _new_;
  %if &add = . or &add =  %then %let add = noadd;
  %if &add = noadd or &add = add %then; %else %goto quit_2;
  %if &x =. or &x =  %then %let  x=x;
  %if &y =. or &y =  %then %let  y=y;
  %if &id=. or &id=  %then %let id=id;
  data _NULL_ ;
    if 0 then set &data nobs=last;
    call symput('empty',left(put(last,8.)));
    stop;
  run;

  %if &empty < 2 %then %goto quit_1;

  %if &numb =. or &numb =  %then %do;
    proc means data=&data noprint min max;
      var &x &y;
      output out=_minmax_  min=x_min y_min  max=x_max y_max;
    run;

    data _NULL_;
      set _minmax_;
      delta_x = x_max - x_min;
      delta_y = y_max - y_min;
      if delta_x >= delta_y then call symput('numb',200/delta_x);
                            else call symput('numb',200/delta_y);
      anzahl = round( symget('numb') , 0.01);
      put 'note: length one obtains ' anzahl 8.2 ' interpolation-points.';
    run;
  %end;

%if &add = noadd %then %do;
  data &ergebnis;
    &x = . ; &y = . ; &id = . ; output;
  run;
%end;

data _temp_;
  set &data;
run;

%do %until ( &empty < 2);
  %berechne(&ergebnis,&x,&y,&id,&numb);
  data _NULL_ ;
    if 0 then set _temp_ nobs=last;
    call symput('empty',left(put(last,8.)));
    stop;
  run;
%end;

%if &add =. or &add =  or &add = noadd %then %do;
  options notes;
  data &ergebnis;
    set &ergebnis;
    if _N_ = 1 then delete;
  run;
  options nonotes;
%end;
proc datasets nolist;
  delete _result_ _one_id_ _initia_ _minmax_ _linien_ _temp_;
quit;
%goto fin;
  %quit_1 : %put note:   data set &data is empty or has less than 2 values;
  %goto fin;
  %quit_2 : %put note:   miss-typed macro-call parameter (see 3rd. parameter);
            %put note:   inuse:      spline(&data,&ergebnis,&add,&x,&y,&id,&numb);
            %put note:   should be:  spline(&data,&ergebnis,noadd,&add,&x,&y,&id,&numb);
            %put note:   or shorted: spline(&data,&ergebnis,,&add,&x,&y);
%fin : ;
options source stimer notes ;
%mend spline; options source;

*
;