• Print |
• E-mail  |
• Bookmark

 

%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
    * 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 ;
    */

   /* 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 ;

Operating System and Release Information