BookmarkSubscribeRSS Feed
rbettinger
Pyrite | Level 9

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.

 

 

 

Ready to join fellow brilliant minds for the SAS Hackathon?

Build your skills. Make connections. Enjoy creative freedom. Maybe change the world. Registration is now open through August 30th. Visit the SAS Hackathon homepage.

Register today!
Multiple Linear Regression in SAS

Learn how to run multiple linear regression models with and without interactions, presented by SAS user Alex Chaplin.

Find more tutorials on the SAS Users YouTube channel.

From The DO Loop
Want more? Visit our blog for more articles like these.
Discussion stats
  • 0 replies
  • 509 views
  • 1 like
  • 1 in conversation