Resources

Lists and Data Structures

/****************************************************************/
/*          S A S   S A M P L E   L I B R A R Y                 */
/*                                                              */
/*    NAME: Lists.sas                                           */
/*   TITLE: Lists and Data Structures                           */
/* PRODUCT: IML                                                 */
/*  SYSTEM: ALL                                                 */
/*                                                              */
/* SUPPORT: Rick Wicklin                UPDATE: July 2016       */
/*     REF:                                                     */
/*    MISC:                                                     */
/* Modules:                                                     */
/*                                                              */
/****************************************************************/


/**************************************************
 List Utilities: The ListUtil Package
 **************************************************/

proc iml;
package load ListUtil;
package help ListUtil;   /* display overview in SAS log */
quit;


/**************************************************
 Create a Growable List of Matrices
 **************************************************/

proc iml;
/* create a list of matrices; use ListSetItem to fill */
L = ListCreate(3);            /* allocate list of 3 elements */
do n = 1 to ListLen(L);       /* for each element in list */
   A = j(n, n, n-1);          /* define n x n matrix */
   call ListSetItem(L, n, A); /* assign n_th element of L */
end;

sum = j(ListLen(L), 1);
do n = 1 to ListLen(L);       /* for each element in list */
   B = ListGetItem(L, n);     /* get n_th matrix of L */
   sum[n] = sum(B);           /* compute sum of elements */
end;

C = 1:3;
call ListAddItem(L, C);    /* add C as 4th element to L */
D = {4 3, 2 1};
call ListAddItem(L, D);    /* add 5th element to L */

package load Listutil;
run struct(L);

call ListDeleteItem(L, {1 3 5}); /* remove three elements */

quit;

/**************************************************
 Create a List of Items of Different Types
 **************************************************/

proc iml;
M = {1 2, 3 4};
C = "A":"G";
tbl = TableCreateFromDataSet("Sashelp", "Class", "obs=5");
sublist = ListCreate(3);
do i = 1 to ListLen(sublist);
   call ListSetItem(sublist, i, j(i, i, i##2));
end;

list = ListCreate();
call ListAddItem(list, {1.2 3.45 6.789});   /* add numeric vector */
call ListAddItem(list, {"Male" "Female"});  /* add character vector */
call ListAddItem(list, sublist);            /* add sublist */

package load ListUtil;                      /* load ListPrint module */
run ListPrint(list);

quit;

/**************************************************
 Create an Associative Array
 **************************************************/

proc reg data=sashelp.class plots=none;
   where sex="M";
   model weight = height;
   output out=Out p=Pred r=Res;
   ods output ParameterEstimates=PE;
quit;

proc iml;
use PE; read all var {"Variable" "Estimate"}; close;
use Out; read all var {"Weight" "Pred" "Res"}; close;

StructNames = {"Variable" "Estimate" "DepVar" "Predicted" "Residual"};
RegModel = ListCreate( StructNames );
call ListSetItem(RegModel, "Variable", Variable);
call ListSetItem(RegModel, "Estimate", Estimate);
call ListSetItem(RegModel, "DepVar", Weight);
call ListSetItem(RegModel, "Predicted", Pred);
call ListSetItem(RegModel, "Residual", Res);

package load ListUtil;                      /* load ListPrint module */
run ListPrint(RegModel);

/* Module that creates a plot of observed vs predicted response.
   Pass in a list that contains elements named "DepVar"and "Predicted" */
start PredPlot(L);
   Observed = ListGetItem(L, "DepVar");
   Predicted = ListGetItem(L, "Predicted");
   call Scatter(Observed, Predicted) procopt="noautolegend"
                    other="lineparm x=0 y=0 slope=1 / clip";
finish;

run PredPlot(RegModel);

quit;

/**************************************************
 Create a List of Lists
 **************************************************/

proc iml;
use Sashelp.Class;           /* read data */
read all var {Age Sex Name};
close Sashelp.Class;

Age = char(Age, 2);          /* convert to character vector */
ages = unique(Age);
L = ListCreate(ages);        /* outer list: elements named "11":"16" */

gender = unique(Sex);
K = ListCreate(gender);      /* inner list: elements named {"F" "M"} */

do i = 1 to ncol(ages);      /* For each age level... */
   idx = loc(Age=ages[i]);   /* Find observations for this age */
   do j = 1 to ncol(gender);              /* for each gender... */
      jdx = loc( Sex[idx]=gender[j] );    /* find this age and gender */
      if ncol(jdx)=0 then students = {};  /* no students found */
      else students = Name[idx[jdx]];     /* get student names */
      call ListSetItem(K, gender[j], students);  /* value of inner list */
   end;
   call ListSetItem(L, ages[i], K);  /* set sublist as value */
end;

quit;

/**************************************************
 Construct a Stack
 **************************************************/

proc iml;
/* implement a stack, which is a 1-D FILO structure */
start StackCreate( item= );
   S = ListCreate();              /* create empty list   */
   if ^IsSkipped(item) then       /* if item specified,  */
      call ListAddItem(S, item);  /*    add item to list */
   return S;
finish;

/* push an item onto the stack */
start StackPush(S, item);
   call ListAddItem(S, item);     /* add item to the end */
finish;

/* pop an item from the stack */
start StackPop(S);
   A = ListGetItem(S, ListLen(S), 'd'); /* get & remove last item */
   return A;
finish;

/* peek at the item at the top of the stack without removing it */
start StackPeek(S);
   A = ListGetItem(S, ListLen(S), 'c'); /* get last item */
   return A;
finish;

/* return 1 if stack is empty; 0 otherwise */
start StackIsEmpty(S);
   return (ListLen(S) = 0);
finish;

/* return number of elements in stack */
start StackLen(S);
   return ListLen(S);
finish;

store module=_all_;
quit;


/**************************************************
 Reverse the Words in a Sentence
 **************************************************/

proc iml;
load module=(StackCreate StackPush StackPop
             StackPeek StackIsEmpty StackLen);

/* Create sentence. Break into vector of words. */
str = "Now is the time for all good men to come to the aid of their party.";
n = countw(str, " .");         /* use blanks and period as delimiters */
words = scan(str, 1:n, " .");  /* character vector */

S = StackCreate();             /* create an empty stack */
do i = 1 to ncol(words);
   run StackPush(S, words[i]); /* push each element onto the stack */
end;

print (StackPeek(S))[L="Top of Stack"]; /* the last word is on top */

/* retrieve the data in reverse order */
w = j(1, StackLen(S), "     ");
do i = 1 to ncol(w);           /* pop each element; insert into stack */
   w[i] = StackPop(S);
end;
print w[L="Reversed Words"];

if StackIsEmpty(S) then
   print "Stack is empty";
else print (StackPeek(S))[L="Top of Stack"];

quit;

/**************************************************
 Implement a Postfix Calculator
 **************************************************/

proc iml;
load module=(StackCreate StackPush StackPop);

/* Given a binary operator, return  the expression
  (L op R) where op is in the set {+, -, *, /} */
start BinaryCalc(operator, L, R);
   if      operator="+" then return L + R;
   else if operator="-" then return L - R;
   else if operator="*" then return L * R;
   else if operator="/" then return L / R;
   else return .;
finish;

/* Input a space-separated string that represents a valid
   arithmetic operation in postfix notation. The string
   can contain numbers and the binary operators {+, -, *, /}.
   The string must represent a valid operation; no error
   checking is performed. */
start PostfixCalc(str);
   n = countw(str, " ");
   tokens = scan(str, 1:n, " ");  /* character vector */
   binOps = {"+","-","*","/"};    /* four binary operators */
   S = StackCreate();             /* create an empty stack */
   do i = 1 to ncol(tokens);
      token = tokens[i];          /* get the token */
      if element(token, binOps) then do; /* it's binary op */
         R = StackPop(S);         /* retrieve the previous */
         L = StackPop(S);         /*    two numbers        */
         result = BinaryCalc(token, num(L), num(R));
         run StackPush(S, char(result)); /* push result on stack */
      end;
      else
         run StackPush(S, token);  /* push number on stack */
   end;
   return num(StackPop(S));        /* return result as number */
finish;

/* examples of parsing postfix expressions */
str = {"2 2.8 7.2 + * 5 /",    /* 2*(2.8+7.2) / 5  =   4 */
       "4 5 7 2 + - *",        /* 4*(5 - (7+2))    = -16 */
       "4 -5 + 6 -2 -  *",     /* (4 + -5)*(6 - -2)=  -8 */
       "2 2 2 2 * * *"    };   /*  2**4            =  16 */
result = j(nrow(str), 1);
do i = 1 to nrow(str);
   result[i] = PostfixCalc(str[i]);
end;
print str result;

quit;

/**************************************************
 Construct a Binary Search Tree
 **************************************************/

/* L[i] is key value; L[2] is left child; L[3] is right child */
proc format;
    value BSTFmt  1='Key'  2='Left'  3='Right';
run;

proc iml;
/* A node is a three-element list:
   node[1] contains the KEY   value
   node[2] contains the LEFT  value (or empty if null)
   node[3] contains the RIGHT value (or empty if null) */
start BSTNewNode(value);
   node = ListCreate(3);     /* create list with 3 null elements */
   call ListSetItem(node, 1, value);   /* set KEY value */
   return node;
finish;

/* Search for a target value in a binary search tree.
   Input: root is the root node of a BST
          value is the target value
   Output: path contains the path to the node that contains the target
          value or the node where the target value can be inserted.
   Return: 1 if the target value is in the tree; 0 otherwise */
start BSTLookup(path, root, value);
   KEY = 1; LEFT = 2; RIGHT = 3;
   path = {};
   T = root;
   do while (1);
      if value = ListGetItem(T, KEY) then
         return 1;                  /* found it: return path to subitem */
      else if value < ListGetItem(T, KEY) then do;
         path = path || LEFT;       /* add to path */
         T = ListGetItem(T, LEFT);  /* new root is left child */
      end;
      else do;
         path = path || RIGHT;      /* add to path */
         T = ListGetItem(T, RIGHT); /* new root is right child */
      end;
      if type(T)='U' then
         return 0;                  /* not found: return path to subitem */
   end;
finish;

/* pass a vector of key values to this routine to create a BST
   that has those values as keys */
start BSTCreate(x);
   bst =  BSTNewNode( x[1] );
   do i = 2 to nrow(colvec(x));
      run BSTInsert(bst, x[i]);
   end;
   return bst;
finish;

/* Insert a new branch for a key value in a BST. If the value
   already exists, do nothing (so there are never duplicates) */
start BSTInsert(root, value);
   if ListLen(root)=0 then do;   /* List empty. Set root node */
      root = BSTNewNode(value);
      return;
   end;
   /* otherwise, search tree to find value */
   found = BSTLookup(path, root, value);  /* if found, return */
   if ^found then                         /* else add to sub-path */
      call ListSetSubItem(root, path, BSTNewNode(value));
finish;

x = {5 3 1 9 1 6 4}`;
bst = BSTCreate(x);

found = BSTLookup(path, bst, 6);
print found[L="Was 6 found?"], path[L="Path from root" F=BSTFmt.];
found = BSTLookup(path, bst, 10);
print found[L="Was 10 found?"], path[L="Path from root" F=BSTFmt.];
quit;

/**************************************************
 Plot a Binary Search Tree
 **************************************************/

%include sampsrc(LstBST.sas);      /* define modules */
proc iml;
load module = _all_;                /* load modules */
x = {5 3 1 9 1 6 4}`;
bst = BSTCreate(x);
title "Diagram of Binary Search Tree";
call BSTPlot(bst);
quit;