A SAS Macro to Extend the SAS/IML Print Function

rbettinger — Wed, 08 Feb 2023 21:12:55 GMT

I have written a SAS macro to extend the SAS/IML PRINT function. It maintains the syntax of the PRINT function and adds the IML RESET options as modifiers to the PRINT environment. The code is:

%macro PRINTIML( ARG )/ parmbuff ;

   /* PURPOSE: enhance SAS/IML PRINT statement with additional capabilities
    *
    * NOTE:    must use same SAS/IML syntax in %PRINTIML macro as in SAS/IML PRINT statement
    *
    * NOTE:    must use backslash (\) after &ARG to indicate RESET settings to be applied to SAS/IML PRINT statement
    *          delimiter that separates SAS/IML PRINT statement options from RESET options is backslash (\)
    *
    * NOTE:    default values for RESET are: noautoname nocenter fw=9 noname spaces=1
    *
    * NOTE:    after printing, any specified RESET settings are restored to default values,
    *          regardless of former settings (simplistic approach due to inability to know
    *          value of RESET setting prior to invocation of %PRINTIML macro)
    *
    * SYNTAX:  %PRINTIML( <matrices> <( expression )> <"message"> <pointer controls> <[options]> \ <RESET Options> )
    *
    * EXAMPLES OF USE:
    *    proc iml ;
    *
    *       a = { 1 2 3, 4 5 6 } ;
    *       b = { 6 5 4, 3 2 1 } ;
    *
    *       r_name = { 'row 1', 'row 2' } ;
    *
    *       %PRINTIML( (( a + b )/ 7 ) \ center autoname spaces=3 fw=2 )
    *       %PRINTIML( ( a[ 1, ] ) ( b[ , 1 ] ) \ center autoname spaces=3 fw=2 )
    *       %PRINTIML( ( a + b )[ rowname=r_name format=10.5 ] \ spaces=1 )
    *       %PRINTIML( a , b / ( a + b ) \ spaces=1 )
    *    quit ;
    */

   %local I ;

   /* verify that PROC IML is licensed for use */

   %if not %sysprod(IML)
   %then %do ;
      %put /-----------------------------------------------\ ;
      %put | ERROR: PROC IML not licensed for your system. | ;
      %put | Terminating macro %PRINTIML forthwith.        | ;
      %put \-----------------------------------------------/ ;
   
      %goto L9999 ;
   %end ;

   /*############################################################################*/
   /* begin macro execution
   /*############################################################################*/

   %let AUTONAME = noautoname ;
   %let CENTER   = nocenter ;
   %let FW       = ;
   %let NAME     = noname ;
   %let SPACES   = %str( spaces=1 ) ;

   /*============================================================================*/
   /* remove left, right parens from &SYSPBUFF
   /* find start location of RESET options, if any (backslash indicates that RESET options follow)
   /*
   /* note: spaces in %bquote fcn are included in result, e.g., %bquote( A B C ) ne %bquote(A B C)
   /*
   /* note: must check for case when no RESET settings present
   /*============================================================================*/

   %let STRING  = %qsubstr( %bquote(&SYSPBUFF), 2, %length(&SYSPBUFF) - 2 ) ;
   %let STRING  = %qleft(%qtrim(&STRING)) ;

   %let STRING1 = %qsysfunc( reverse( &STRING )) ;

   %let NDX     = %index( &STRING1, %str(\)) ;

   /*============================================================================*/
   /* extract RESET settings from reversed string, reverse again to create original order,
   /* check for presence of settings. if none, set &NDX = 0 to prevent further action
   /*============================================================================*/

   %if &NDX > 0
   %then %do ;
      %let SETTINGS = %qupcase( %qsubstr( %bquote(&STRING1), 1, &NDX - 1 )) ;

      %let SETTINGS = %qsysfunc( reverse( &SETTINGS )) ;

      /* if any complex expression closing character, e.g., ) ] }, found, no settings used.
       * reset &NDX flag to prevent further parsing for settings
       */

      %if %eval( %index( &SETTINGS, %str(%))) + %index( &SETTINGS, ] ) + %index( &SETTINGS, } )) > 0
      %then %let NDX = 0 ;

      /* extract expression(s) to be printed from reversed string
       * reverse again to restore original order
       */

      %let STRING = %qsubstr( &STRING1, &NDX + 1 ) ;
      %let STRING = %qsysfunc( reverse( &STRING )) ;
   %end ;

   /*============================================================================*/
   /* insert blank around '[', '/', '(', ')', ',' to distinguish potential options
   /*============================================================================*/

   %let BUFFER = ;

   %do I = 1 %to %length( &STRING ) ;
      %let STRING1 = %qsubstr( &STRING, &I, 1 ) ;

      %if &STRING1 = [
       or &STRING1 = %str(/)
       or &STRING1 = %str(%()
       or &STRING1 = %str(%))
       or &STRING1 = %str(,)
      %then %let BUFFER = &BUFFER%str( &STRING1 ) ; %else %let BUFFER = &BUFFER.&STRING1 ;
   %end ;

   %let STRING = &BUFFER ;

   /*============================================================================*/
   /* create argument for SAS/IML PRINT statement
   /*    simple expressions, e.g., variable name, not enclosed in parentheses
   /*    complex expressions, e.g., ( a + b / c * d[ +, 1] ), must be enclosed in () pairs
   /*    options            , e.g., [ format=10.5 ]         , must be enclosed in [] pairs
   /*============================================================================*/

   %let NBKT   = 0 ;
   %let NPAR   = 0 ;
   %let NSTR   = 0 ;

   %let I         = 1 ;
   %let TOKEN1    = %qscan( %bquote(&STRING), &I, %str( )) ;

   %do %until( &&TOKEN&I = ) ;

      /*----------------------------------------------------------------------------*/
      /* create macro vars to indicate presence/absence of (), []. set counters.
      /*----------------------------------------------------------------------------*/

      %let TOKEN_1 = %qsubstr( &&TOKEN&I,                    1, 1 ) ;
      %let TOKEN_2 = %qsubstr( &&TOKEN&I, %length( &&TOKEN&I ), 1 ) ;

      /* process brackets */

      %let LBKT&I = %eval( %index( &&TOKEN&I, [ ) > 0 ) ;
      %let RBKT&I = %eval( %index( &&TOKEN&I, ] ) > 0 ) ;

      %let NBKT   = %eval( &NBKT + &&LBKT&I - &&RBKT&I ) ;
      %let NBKT&I = %eval( &NBKT + &&RBKT&I             ) ;

      /* process parentheses */

      %let LPAR&I = %eval( %index( &&TOKEN&I, %str(%() ) > 0 ) ;
      %let RPAR&I = %eval( %index( &&TOKEN&I, %str(%)) ) > 0 ) ;

      %let NPAR       = %eval( &NPAR + &&LPAR&I - &&RPAR&I ) ;
      %let NPAR&I     = %eval( &NPAR + &&RPAR&I            ) ;

      %let EXPR_END&I = %eval( &&NPAR&I = 1 and &NPAR = 0  ) ;

      /* process string quotes */

      %let LSTR&I = %eval( &TOKEN_1 = %str(%') or &TOKEN_1 = %str(%")) ;
      %let RSTR&I = %eval( &TOKEN_2 = %str(%') or &TOKEN_2 = %str(%")) ;

      %let NSTR   = %eval( &NSTR + &&LSTR&I - &&RSTR&I ) ;
      %let NSTR&I = %eval( &NSTR + &&RSTR&I            ) ;

      %let I = %eval( &I + 1 ) ;
      %let TOKEN&I = %qscan( &STRING, &I, %str( )) ;
   %end ;

   %let N_TOKEN = %eval( &I - 1 ) ;

   /*============================================================================*/
   /* assemble 3 cases:
   /*    simple expression  # paren = 0
   /*    string expression  # paren = 0, # strings > 0
   /*    complex expression # paren > 0, # strings > 0, # brackets > 0
   /*============================================================================*/

   %let BUFFER = ;
   %let TOKEN  = ;

   %do I = 1 %to &N_TOKEN ;

      %if &&NPAR&I = 0 and &&NSTR&I = 0 and &&NBKT&I = 0 /* i.e., outside of (expression) */
      %then %do ;
         %if &&TOKEN&I ne %str(,) and &&TOKEN&I ne %str(/)
         %then %let BUFFER = &BUFFER " &&TOKEN&I = " &&TOKEN&I ;
         %else %let BUFFER = &BUFFER.%str( &&TOKEN&I ) ;
      %end ;
      %else
      %if &&NPAR&I = 0 and ( &&NSTR&I > 0 or &&NBKT&I > 0 ) /* 'message' or [options] but not (expression) */
      %then %do ;
         %let BUFFER = &BUFFER &&TOKEN&I ;
      %end ;
      %else %do ;
         %let TOKEN = &TOKEN.&&TOKEN&I ; /* build (expression) */

         %if &&EXPR_END&I /* have built (expression), put to output buffer */
         %then %do ;
            %let BUFFER = &BUFFER " &TOKEN. = " &TOKEN ;
            %let TOKEN  = ;
         %end ;
      %end ;
   %end ;

   /*============================================================================*/
   /* if settings follow &ARG, parse them from &SYSPBUFF and apply them
   /*============================================================================*/

   %if &NDX > 0
   %then %do ;
      %let I = 1 ;
      %let TOKEN = %scan( &SETTINGS, 1, %str( )) ;

      %do %while( %length( &TOKEN ) > 0 ) ;
         %if &TOKEN                  = AUTONAME %then %let AUTONAME = autoname ;
         %if &TOKEN                  = CENTER   %then %let CENTER   = center ;
         %if %substr( &TOKEN, 1, 2 ) = FW       %then %let FW       = &TOKEN ;
         %if &TOKEN                  = NAME     %then %let NAME     = name ;
         %if %substr( &TOKEN, 1, 2 ) = SP       %then %let SPACES   = &TOKEN ;

         %let I = %eval( &I + 1 ) ;
         %let TOKEN = %scan( &SETTINGS, &I, %str( )) ;
      %end ;
   %end ;   

   reset &AUTONAME &CENTER &FW &NAME &SPACES ;

   /* resolve SAS/IML PRINT statement */

   print %unquote(&BUFFER) ;

   /*============================================================================*/
   /* invert settings, if any
   /*============================================================================*/

   %if &NDX > 0
   %then %do ;
      %if &AUTONAME ne %then %let AUTONAME = noautoname ;
      %if &CENTER   ne %then %let CENTER   = nocenter ;
      %if &FW       ne %then %let FW       = %str( FW=9 ) ;
      %if &NAME     ne %then %let NAME     = noname ;
      %if &SPACES   ne %then %let SPACES   = %str( SPACES=1 ) ;

      reset &AUTONAME &CENTER &FW &NAME &SPACES ;
   %end ;

%L9999:
%mend PRINTIML ;

and the results of executing the examples of use in the macro prologue are demonstrated below:

                           ((a+b)/7) =     1  1  1
                                           1  1  1


                  (a[1,]) =     1  2  3    (b[,1]) =     6
                                                         3


 (a+b) =  row 1    7.00000    7.00000    7.00000
          row 2    7.00000    7.00000    7.00000


 a =          1         2         3
              4         5         6
 b =          6         5         4
              3         2         1

Perhaps you will find it useful.

topic A SAS Macro to Extend the SAS/IML Print Function in SAS/IML Software and Matrix Computations

A SAS Macro to Extend the SAS/IML Print Function