Plot coordinate pairs/REXX

This is a REXX program that satisfies the Rosetta Code task Plot coordinate pairs.

<lang rexx>/**/trace o;parse arg !;if !all(arg()) then exit;if !cms then address ;signal on halt;signal on novalue;signal on syntax

@abc='abcdefghijklmnopqrstuvwxyz'; @abcU=@abc; upper @abcU /*alphabet.*/ bgchar=' ' /*character used for BackGround. */ colors=!cms | !pcrexx | !r4 | !roo /*REXXes that support term color.*/ digs=80 /*digits used for numeric digits.*/ fuzz=0 /*use 0 digits for numeric fuzz.*/ showdigs=10 /*show this many decimal digits. */ labelTag='()' /*chars used for label tags. */

                                      /* [↓] zero these REXX variables.*/

_=0; parse var _ $calc 1 kws 1 labelD 1 labelP 1 logs 1 lowcas 1,

                nDups 1 Oints 1 Onums 1 plotMult 1 1 plotSeq 1,
                plotSim 1 pnts 1 quiet 1 sd 1 shownXlab. 1 showVal 1,
                simple 1 sin 1 sortA 1 sortD 1 sortDu 1 sortU 1 sw 1,
                swapAx 1 uppcas 1 xSin 1 ySin
                                      /* [↓]  set these REXX vars to 1.*/

_=1; parse var _ clear 1 commas 1 ixs 1 labelEv 1 norm 1 showLab 1,

                showOrg 1 ixi 1 scaling

parse var _ . !. $$ gFID graf labelEnd labelSta labelX labelY tFID ,

                   tops xmaxuse ymaxuse xminuse yminuse xmnval ymnval ,
                   xmxval ymxval xy   /* [↑]  nullify these REXX vars. */

labelDatadef=9 /*default for LABELP if LABELDATA is specified.*/

numeric digits 500 /*now, use 500 for numeric digits*/

                                      /*(could be more, see DIGs below)*/

_=space(!!) /*remove superfluous blanks. */ parse var _ numbs '(' ops /*get numbers to be plotted, opts*/ ops=space(ops) /*remove superfluous blanks. */

if !ebcdic then do /*axis characters for EBCDIC mach*/

               xaxchar = 'bf'x;   yaxchar='fa'x         /*  ┐  and  ·  */
               orgchar = 'abbbacbcebeccccb8f'x          /*  ½╗¼╝δ∞╠╦Å  */
               pntChars= '8eafd6f05c6c7b7c5b9c9f2b'x    /* Ä»O0*%#@$£+ */
               end
          else do                     /*axis characters for ASCII mach.*/
               xaxchar = 'c4'x;   yaxchar='b3'x         /*  ─  and  │  */
               orgchar = 'c0d9dabfc3b4c1c2c5'x          /*  └┘┌┐├┤┴┬┼  */
               pntChars= 'faf94fe97ff0feb1b2b3db2b'x    /* ·∙OΘ?≡■▒▓█+ */
               end

numbs=translate(numbs,,',') /*remove commas from numbers. */

 do kws=1  while numbs\==           /*verify that thingys are numeric*/
 parse var numbs _ numbs              /*pick off the first "number".   */
 if \isnum(_)  then call er 55,_      /*¬ numeric?  Then show error msg*/
 !.kws=_                              /*build a number stemmed array.  */
 end   /*kws*/                        /* [↑]  traipse through all #'s. */

kws=kws-1 /*adjust # of data points because of the above DO loop.*/

 do  while  ops\==                  /*process all options  (or none).*/
 parse var ops _1 2 1 _ . 1 _o ops    /*get an option, first character.*/
 upper _                              /*uppercase a version of option. */

   select                             /*traipse through possible opts. */
   when _1='.' &pos("=",_)\==0  then tops=tops _o
   when  abb('$CALC')           then $calc=1
   when abbn('CLearscreen')     then clear=no()
   when abbn('COMMAs')          then commas=no()
   when abbn('COLORs')          then colors=no()
   when  abb('DIGits')|,
         abb('DIGs')            then digs=nai()
   when abbn('FUZZ')            then fuzz=nai()
   when  abb('GETfile')         then gfid=na()
   when  abb('INDEXIncrement')|,
         abb('IIncrement')      then ixi=nai()
   when  abb('INDEXStart')|,
         abb('IStart')          then ixs=nai()
   when  abb('LABELDatapoints') then labelD=no()
   when  abb('LABELEVery')      then labelEv=nai()
   when  abb('LABELPOints')     then labelP=nai()
   when  abb('LABELStart')      then labelSta=nai()
   when  abb('LABELTags')       then labelTag=nai()
   when  abb('LABELXpoints')    then labelX=nai()
   when  abb('LABELYpoints')    then labely=nai()
   when abbn('LOGs')            then logs=no()
   when abbn('LOWercased')      then lowcas=no()
   when abbn('Quiet')           then quiet=no()
   when  abb('NODUPlicates')|,
         abb('NODUPs')          then nDups=1
   when  abb('NOLABELTags')     then labelTag=
   when abbn('NORMalized')      then norm=left(_,3)=='NOR'
   when  abb('ONLYINTegers')|,
         abb('ONLYINTs')        then Oints=1
   when  abb('ONLYNUMbers')|,
         abb('ONLYNUMs')        then Onums=1
   when abbn('PLOTMULtiples')   then plotMult=no()
   when abbn('PLOTSEQuencial')  then plotSeq=no()
   when abbn('PLOTSIMples')     then plotSim=no()
   when abbn('SCALing')         then scaling=no()
   when  abb('SCREENDepth')|,
         abb('SCRDepth')|,
         abb('SDepth')|,
         abb('DEPth')           then sd=nai()
   when  abb('SCREENWidth')|,
         abb('SCRWidth')|,
         abb('SWidth')|,
         abb('WIDth')           then sw=nai()
   when  abb('SHOWDIGits')|,
         abb('SHOWDIGs')        then showdigs=nai()
   when abbn('SHOWLABels')|,
        abbn('LABels')          then showLab=no()
   when abbn('SHOWORGins')|,
        abbn('ORGins')          then showOrg=no()
   when abbn('SHOWVALues')      then showVal=no()
   when abbn('SIMplecharacters')|,
        abbn('SIMplechars')     then simple=no()
   when abbn('SINglevalues')|,
        abbn('SINgles')         then sin=no()
   when abbn('SORTascending')   then sortA=no()
   when abbn('SORTDescending')  then sortD=no()
   when abbn('SORTDUnique')     then sortDu=no()
   when abbn('SORTUnique')      then sortU=no()
   when abbn('SWAPAXises')|,
        abbn('SWAPXYs')|,
        abbn('SWAPYXs')         then swapAx=no()
   when abbn('UPPercased') then uppcas=no()
   when  abb('XMAXUSE')         then xmaxuse=nan()
   when  abb('XMINUSE')         then xminuse=nan()
   when abbn('XSINgles')        then xSin=no()
   when  abb('YMAXUSE')         then ymaxuse=nan()
   when  abb('YMINUSE')         then yminuse=nan()
   when abbn('YSINgles')        then ySin=no()
   otherwise if \$calc then call er 55,_o    /*oop-say, not kosher opt.*/
   end   /*select*/                          /* [↑]   process options.*/
 end     /*while  ops\== */

if digs<1 then call er 81,'1 ,' digs 'DIGITS' if showdigs<1 then call er 81,'1 ,' showdigs 'SHOWDIGITS' if fuzz<0 | fuzz>=digs then call er 81,0 digs-1 fuzz 'FUZZ' if fuzz\==0 then numeric fuzz fuzz /*user wants FUZZ, by gum*/ numeric digits max(digs,showdigs,ixs,ixs+ixi*length(kws)) /*adjust DIGs*/ _=length(labelTag) /*get length of label tags*/

if _\==0 then do /*get LENs of start & end.*/

              if labelSta==  then labelSta = left(labelTag,round(_/2))
              if labelEnd==  then labelEnd = right(labelTag,_%2)
              end

labelSta=translate(labelSta,,'_') /*trans underbars──►blanks*/ labelEnd=translate(labelEnd,,'_') /*trans underbars──►blanks*/

if sortA & sortD then call er 61,'SORTA SORTD' /*conflict.*/ if sortA & sortDu then call er 61,'SORTA SORTDU' /*conflict.*/ if plotSim & plotSeq then call er 61,'PLOTSIMple PLOTSEQuencial' if plotSim & plotMult then call er 61,'PLOTSIMple PLOTMultiple' if plotSeq & plotMult then call er 61,'PLOTSEQuential PLOTMultiple' labelP=int(labelP,'LABELPOINTS') /*insure LABELP is numeric*/ if labelP<0 then call er 81,0 ',' labelP 'LABELPOINTS' labelEv=int(labelEv,'LABELEVERY') /*insure LABELV is numeric*/ if labelD & labelP==0 then labelP=labelDatadef /*maybe use default.*/ labelX=int(p(labelX labelP),'LABELXPOINTS') /*insure labelX is numeric*/ labely=int(p(labely labelP),'LABELYPOINTS') /*insure labelY is numeric*/ if labelX<0 then call er 81,0 ',' labelX 'LABELXPOINTS' if labely<0 then call er 81,0 ',' labely 'LABELYPOINTS' ixi=int(ixi,'INDEXINCEMENT') /*insure IXI is numeric*/ ixs=int(ixs,'INDEXSTART') /*insure IXS is numeric*/ if xSin & ySin then call er 61,'XSINGle YSINGle' /*conflict.*/ if \xSin & \ySin then xSin=1 /*use X as single points.*/ if \(plotSim & plotSeq & plotMult) then plotSim=1 /*use simple plot?*/ if xminuse\== then xminuse=num(xminuse,"XMINUSE") /*min X.*/ if xmaxuse\== then xmaxuse=num(xmaxuse,"XMAXUSE") /*max X.*/ if yminuse\== then yminuse=num(yminuse,"YMINUSE") /*min Y.*/ if ymaxuse\== then ymaxuse=num(ymaxuse,"YMAXUSE") /*max Y.*/ if logs then tops='.F='gettFID(,"ANS") tops /*$T ops*/ if colors then tops='.C=green' tops /*colors*/ tops=space(tops) /* [↓] get screen size.*/ if sd==0 | sw==0 then parse value scrsize() with _sd _sw . if sd==0 then sd=_sd /*No scr depth? Use true.*/ if sw==0 then sw=_sw /*No scr width? Use true.*/

_=0 /*set all vars below to 0.*/ if showOrg then parse var _ xmnval 1 xmxval 1 ymnval 1 ymxval

if gfid\== then do /*there a gFID for input? */

                 call lineout gfid; gfide=0  /*close the gFID file.    */

                   do  while lines(gfid)\==0 /*read all lines in gFIF. */
                   gfide=1                   /*indicated there is data.*/
                   _=translate(linein(gfid),,',')   /*remove commas.   */
                                                    do  while  _\==
                                                    parse var _ z _
                                                    kws=kws+1
                                                    !.kws=z
                                                    end  /*while _\==*/
                   end  /*while lines···*/   /* [↑] put each #──► array*/

                 if \gfide  then call er 38,gfid /*No data? Tell errmsg*/
                 end                         /* [↑] process file plot#s*/

if sortDu then do /*sort descending, unique?*/

               sortD=1                       /*indicate sort descending*/
               sortU=1                       /*indicate sort unique.   */
               end

@.0=kws /*number of points to plot*/

if sin | (sortA | sortD | sortU) then /*single, any sort? */

 do
            do j=1  for kws                  /*prepare for the SORT sub*/
            @.j=!.j                          /*assign data points──►@. */
            end

 if sortA | sortD | sortU  then call qSort   /*use qSort to sort nums. */
 ep=kws+1                                    /*set the End-Point for @.*/
 if sortD  then do j=1  for kws%2            /*if descending, backward.*/
                _=ep-j                       /*do it bottom-to-top.    */
                parse value @.j @._ with @._ @.j      /*assign values. */
                end                          /* [↑]  order low-to=high.*/

 if sortU  then do                           /*is this a sort unique?  */
                _=@.1                        /*first sort number.      */
                k=1                          /*first sort number index.*/
                      do j=2  for kws-1      /*is there a duplicate ?  */
                      if @.j=_  then iterate /*Dup?  Then ignore the #.*/
                      k=k+1                  /*No dup, then bump # ctr.*/
                      parse var @.j @.k 1 _  /*assign unique number.   */
                      end    /*j*/
                kws=k                        /*keep track of # of nums.*/
                end
 end

if sin then do /*if SINGLE, then handle. */

            sino=ixs                         /*start with this number. */
                    do j=1  for kws          /*process each number in @*/
                    _=@.j                    /*get a plot point number.*/
                    if xSin  then @.j=sino _ /*handle X single data pt.*/
                             else @.j=_ sino /*   "   Y    "     "   " */
                    sino=sino+ixi            /*bump the SINGLE counter.*/
                    end   /*j*/
                                             do j=1 for kws; !.j=@.j; end
            end

 do j=1  for kws                             /*process the data points.*/
 _=!.j                                       /*get a data point number.*/
 xy=xy _                                     /*add it to list of nums. */
 _w=words(xy)                                /*number of numbers so far*/
 if _w==1   then iterate                     /*1st #?   Then get next. */
 if _w\==2  then call er 55,'XY-coordinate XY-plot-point' xy  /*2 nums?*/
                                             /* [↑]  if ¬ 2#'s, err msg*/
 if swapAx  then parse var xy y x            /*swap X,Y numbers ··· or */
            else parse var xy x y            /*    ··· use #'s  as is. */
 xy=
 if xminuse\==  then if x<xminuse  then iterate /*X value too small? */
 if xmaxuse\==  then if x>xmaxuse  then iterate /*X value too large? */
 if yminuse\==  then if y<yminuse  then iterate /*Y value too small? */
 if ymaxuse\==  then if y>ymaxuse  then iterate /*Y value too large? */

 is#=isnum(_)                                /*is data point a number? */
 if is# & Onums  then iterate                /*plot only numbers?      */

 isi=isint(_)                                /*is data point an int?   */
 if isi & Oints  then iterate                /*plot only integers?     */

 if nDups  then do                           /*plot only non-dups?     */
                _p=_                         /*set up a temporary value*/
                if sin                 then _p=word(_,2)
                if wordpos(_p,$$)\==0  then iterate
                $$=$$ _p                     /*add data point to string*/
                end

 if norm  then do                            /*normalize the numbers?  */
               x=$norm(x)                    /*normalize  "  X number. */
               y=$norm(y)                    /*    "      "  Y    "    */
               end
 pnts=pnts+1                                 /*bump the POINTS counter.*/
 @.pnts=x y                                  /*assign pnts to array @  */

 if xmnval==  then do                      /*Not set?  Use this value*/
                     xmnval=x;   ymnval=y    /*set the minimum values. */
                     xmxval=x;   ymxval=y    /* "   "  maximum    "    */
                     end

 if x>xmxval  then xmxval=x;   if x<xmnval  then xmnval=x  /*set MAX x.*/
 if y>ymxval  then ymxval=y;   if y<ymnval  then ymnval=y  /* "   "  y.*/
 end   /*j=1  for kws*/
                                             /* [↓] error if only 1 num*/

if _w==1 then call er 55,'XY-coordinate XY-plot-point' xy /*odd data pt*/ $$= /*nullify the unique vals.*/ oxmnval=xmnval; oymnval=ymnval /*used for scaling minimum*/ oxmxval=xmxval; oymxval=ymxval /* " " " maximum*/

if \scaling then do /*¬scaling? get MIN, MAX.*/

                _=min(xmnval,ymnval); xmnval=_; ymnval=_  /*min for X,Y*/
                _=max(xmxval,ymxval); xmxval=_; ymxval=_  /*max  "  " "*/
                end

if clear then !cls /*should the screen be cleared? */ xspread=max(1,xmxval-xmnval) /*calculate the spread of X vals.*/ yspread=max(1,ymxval-ymnval) /* " " " " Y " */ sd=int(sd,'SCREENDEPTH'); if sd<1 then call er 27,sd 'SCREENDEPTH' sw=int(sw,'SCREENWIDTH'); if sw<1 then call er 27,sw 'SCREENWIDTH' if pnts==0 then call er 54,'data-points' /*if no points to plot, error*/

promptlen=length(!var('PROMPT')) /*length of the PROMPT string. */ tsw=sw-1  ; tswu=tsw-1 /*calculate the true screen width*/ tsd=sd-3-promptlen%sw; tsdu=tsd-1 /* " " " " depth*/ if plotSeq then tsw=tsw-length(pnts) /*Plot sequential? Make smaller.*/

1. .=copies(bgchar,tsw) /*characters used for background.*/

minxx=; maxxx= /*actual min and max values for X*/ minyy=; maxyy= /* " " " " " " Y*/

 xx0=round(-oxmnval/xspread*tswu)     /*round the value for  X  origin.*/
 yy0=round(-oymnval/yspread*tsdu)     /*  "    "    "    "   Y     "   */

if showOrg then /*construct X & Y axis.*/

 do
 minxx=xx0;   maxxx=xx0               /*initialize the min and max X's.*/
 minyy=yy0;   maxyy=yy0               /*     "      "   "   "   "  Y's.*/

   do 1                               /*handle the  0,0  origin of plot*/
   if substr(#.yy0,xx0+1,1)\==bgchar  then leave   /*¬background, skip.*/
   xn=oxmnval<0;   xp=oxmxval>0       /*find the quadrant for X point. */
   yn=oymnval<0;   yp=oymxval>0       /*  "   "      "     "  Y   "    */
   _=1                                /*assume the 1st origin cross chr*/
   if  xn & \xp & \yn &  yp  then _=2 /*  use   "  2nd    "     "    " */
   if \xn &  xp &  yn & \yp  then _=3 /*  use   "  3rd    "     "    " */
   if  xn & \xp &  yn & \yp  then _=4 /*  use   "  4th    "     "    " */
   if \xn &  xp &  yn &  yp  then _=5 /*  use   "  5th    "     "    " */
   if  xn & \xp &  yn &  yp  then _=6 /*  use   "  6th    "     "    " */
   if  xn &  xp & \yn &  yp  then _=7 /*  use   "  7th    "     "    " */
   if  xn &  xp &  yn & \yp  then _=8 /*  use   "  8th    "     "    " */
   if  xn &  xp &  yn &  yp  then _=9 /*  use   "  9th    "     "    " */
   #.yy0=overlay(substr(orgchar,_,1),#.yy0,xx0+1)   /*plot origin char.*/
   end   /*do 1*/                     /* [↑]  origin char:  axis cross.*/

 #.yy0=translate(#.yy0,xaxchar,bgchar) /*change background to  X  axis.*/
 end

pntChar1=substr(pntChars,2,1) /*use this for a point character.*/ pntChar=pntChar1 /*make a copy of " " */ labelP=labelX+labelY /*indicate to label X or Y point.*/

 do j=1  for pnts                     /*plot the data points, ya betcha*/
 parse var @.j x y                    /*break apart the X & Y data pt. */
 xx=round((x-oxmnval)/xspread*tswu)   /*for this terminal, round X val.*/
 yy=round((y-oymnval)/yspread*tsdu)   /* "    "      "       "   Y  "  */

 if minxx==  then do;   minxx=xx;  maxxx=xx  /*set initial max value.*/
                          minyy=yy;  maxyy=yy  /* "     "    min   "   */
                    end

 minxx=min(minxx,xx);   maxxx=max(maxxx,xx)    /*set the min & max X #.*/
 minyy=min(minyy,yy);   maxyy=max(maxyy,yy)    /* "   "   "  "  "  Y " */
                                      /* [↓] if plot multiple points···*/
 if plotMult then pntChar=word(substr(pntChars,pos(substr(#.yy,xx+1,1),pntChars)+1,1) '+',1)
 if plotSeq  then pntChar=pntChar1||j /*if plotting sequentially ···   */
 #.yy=overlay(pntChar,#.yy,xx+1)      /*plot the  Y  data point.       */
 if labelP\==0  then @.j=x y xx yy    /*if show point labels, pre-pend.*/
 end   /*j=1 for pnts*/

do j=1  for pnts  while  labelP\==0   /*attach data point labels.      */
parse var @.j x y xx yy               /*obtain x&y values from orig pt.*/
_=                                    /* [↓]  use labels if existing.  */
if labelX\==0  then do;  xl=strip(left(x,labelX));   _ =     xl;    end
if labely\==0  then do;  yl=strip(left(y,labely));   _ = _','yl;    end
_=strip(_,,',')                       /*remove commas from data pt. #. */
if _==           then iterate       /*if nothing in data point, skip.*/
if labelEv<1       then iterate       /*don't label any data points.   */
if j//labelEv\==0  then iterate       /*only  label every N data points*/
_=labelSta || _ || labelEnd           /*add a label to the  data point.*/
ll=length(_)                          /*LL=length of label & data point*/
old=#.yy                              /*set an older copy of data point*/

if xx+1+ll<=tsw & ,                   /*can lab+data point fit on term?*/
   substr(#.yy,xx+2,ll)=' '  then #.yy = strip(overlay(_,#.yy,xx+2),'T')
                             else do 1; __=xx+1-ll; if __<1   then leave
                                  if substr(#.yy,__,ll)\=' '  then leave
                                  #.yy = overlay(_,#.yy,__)
                                  end   /*do 1*/

if length(#.yy)>tsw  then #.yy=old    /*if lab +data pt ¬ fit, use old.*/
end   /*j=1 for pnts while labelP···*/
                                      /* [↓]   now, display the graph. */
do j=maxyy  to minyy  by -1           /* only show data points that fit*/
if showOrg then                       /*Show origin?  Then place orgin.*/
  if substr(#.j,xx0+1,1)==bgchar  then #.j = overlay(yaxchar,#.j,xx0+1)

if showLab  then                      /*Show the plot labels?          */
   do                                 /*handle the min and max values. */
   if j==maxyy  then call labY oymxval         /*top*/
   if j==minyy  then call labY oymnval         /*bottom*/

     do jp=1  to -1  by -2                     /*show labels top──►bot.*/
     if j==yy0+jp  then do                     /*place min & max values*/
                        call labX oxmnval 0    /*left  (minimum value).*/
                        call labX oxmxval 1    /*right (maximum value).*/
                        end
     end   /*jp*/
   end

call plotL strip(#.j,'T')             /*display a particular plot line.*/
end   /*j=maxyy to minyy by -1 */
                                      /* [↓]   GRAF:  non-simple plots.*/

if graf\== then call $t '.KD=÷' tops substr(translate(graf,'ff'x," "),2) exit 0 /*stick a fork in it, we're done.*/

/*═════════════════════════════general 1-line subs══════════════════════*/ !all:!!=!;!=space(!);upper !;call !fid;!nt=right(!var('OS'),2)=='NT';!cls=word('CLS VMFCLEAR CLRSCREEN',1+!cms+!tso*2);if arg(1)\==1 then return 0;if wordpos(!,'? ?SAMPLES ?AUTHOR ?FLOW')==0 then return 0;!call=']$H';call '$H' !fn !;!call=;return 1 !cal:if symbol('!CALL')\=="VAR" then !call=;return !call !env:!env='ENVIRONMENT';if !sys=='MSDOS'|!brexx|!r4|!roo then !env='SYSTEM';if !os2 then !env='OS2'!env;!ebcdic=1=='f0'x;if !crx then !env='DOS';return !fid:parse upper source !sys !fun !fid . 1 . . !fn !ft !fm .;call !sys;if !dos then do;_=lastpos('\',!fn);!fm=left(!fn,_);!fn=substr(!fn,_+1);parse var !fn !fn '.' !ft;end;return word(0 !fn !ft !fm,1+('0'arg(1))) !rex:parse upper version !ver !vernum !verdate .;!brexx='BY'==!vernum;!kexx='KEXX'==!ver;!pcrexx='REXX/PERSONAL'==!ver|'REXX/PC'==!ver;!r4='REXX-R4'==!ver;!regina='REXX-REGINA'==left(!ver,11);!roo='REXX-ROO'==!ver;call !env;return !sys:!cms=!sys=='CMS';!os2=!sys=='OS2';!tso=!sys=='TSO'|!sys=='MVS';!vse=!sys=='VSE';!dos=pos('DOS',!sys)\==0|pos('WIN',!sys)\==0|!sys=='CMD';!crx=left(!sys,6)=='DOSCRX';call !rex;return !var:call !fid;if !kexx then return space(dosenv(arg(1)));return space(value(arg(1),,!env)) $fact!: procedure;parse arg x _ .;l=length(x);n=l-length(strip(x,'T',"!"));if n<=-n|_\==|arg()\==1 then return x;z=left(x,l-n);if z<0|\isint(z) then return x;return $fact(z,n) $fact: procedure;parse arg x _ .;arg ,n ! .;n=p(n 1);if \isint(n) then n=0;if x<-n|\isint(x)|n<1|_||!\==|arg()>2 then return x||copies("!",max(1,n));!=1;s=x//n;if s==0 then s=n;do j=s to x by n;!=!*j;end;return ! $norm: procedure expose showdigs !regina;parse arg x;if \datatype(x,'N') then return x;x=x/1;if pos('.',x)\==0 then x=format(x,,showdigs)/1;if !regina then do;_=x 'E0';parse var _ 'E' e .;if e<0&-e<showdigs then x=format(x,,showdigs,0);end;return x $sfxa: parse arg ,s,m;arg u,c;if pos(left(s,2),u)\==0 then do j=length(s) to compare(s,c)-1 by -1;if right(u,j)\==left(c,j) then iterate;_=left(u,length(u)-j);if isnum(_) then return m*_;leave;end;return arg(1) $sfxf: parse arg y;if right(y,1)=='!' then y=$fact!(y);if \isnum(y) then y=$sfxz();if isnum(y) then return y;return $sfxm(y) $sfxm: parse arg z;arg w;b=1000;if right(w,1)=='I' then do;z=shorten(z);w=z;upper w;b=1024;end;p=pos(right(w,1),'KMGTPEZYXWVU');if p==0 then return arg(1);n=shorten(z);r=num(n,f,1);if isnum(r) then return r*b**p;return arg(1) $sfxz: return $sfxa($sfxa($sfxa($sfxa($sfxa($sfxa(y,'PAIRs',2),'DOZens',12),'SCore',20),'GREATGRoss',1728),'GRoss',144),'GOOGOLs',1e100) $t: !call=']$T'; call "$T" arg(1); !call=;return abb: arg abbu; parse arg abb; return abbrev(abbu,_,abbl(abb)) abbl: return verify(arg(1)'a',@abc,'M')-1 abbn: parse arg abbn; return abb(abbn) | abb('NO'abbn) comma: procedure;parse arg _,c,p,t;arg ,cu;c=word(c ",",1);if cu=='BLANK' then c=' ';o=word(p 3,1);p=abs(o);t=word(t 999999999,1);if \datatype(p,'W')|\datatype(t,'W')|p==0|arg()>4 then return _;n=_'.9';#=123456789;k=0;return comma_() comma_: if o<0 then do;b=verify(_,' ');if b==0 then return _;e=length(_)-verify(reverse(_),' ')+1;end;else do;b=verify(n,#,"M");e=verify(n,#'0',,verify(n,#"0.",'M'))-p-1;end;do j=e to b by -p while k<t;_=insert(c,_,j);k=k+1;end;return _ err: call er '-'arg(1),arg(2); return erx: call er '-'arg(1),arg(2); exit getdtFID: tFID=p(!var("TMP") !var('TEMP') homedrive()"\"); if substr(tFID,2,1)==':' & substr(tFID,3,1)\=="\" then tFID=insert('\',t,2); return strip(tFID,'T',"\")'\'arg(1)'.'arg(2) getTFID: if symbol('TFID')=='LIT' then tFID=;if tFID\== then return tFID;gfn=word(arg(1) !fn,1);gft=word(arg(2) 'ANS',1);tFID='TEMP';if !tso then tFID=gfn'.'gft;if !cms then tFID=gfn','gft",A4";if !dos then tFID=getdTFID(gfn,gft);return tFID halt: call er .1 homedrive: if symbol('HOMEDRIVE')\=="VAR" then homedrive=p(!var('HOMEDRIVE') 'C:'); return homedrive int: int=num(arg(1),arg(2)); if \isint(int) then call er 92,arg(1) arg(2); return int/1 isint: return datatype(arg(1),'W') isnum: return datatype(arg(1),'N') labX: parse arg n r;if (shownXlab.0&\r)|(shownXlab.1&r) then return;z=copies(bgchar,length(n));_=#.j;if r then do;_=reverse(_);n=reverse(n);end;_p=pos(z,_);if _p>2|_p==0 then return;_=overlay(n,_,_p);shownXlab.r=1;if r then _=reverse(_);#.j=_;return labY: parse arg n; l=length(n); z=copies(bgchar,l); do k=2 to 5; _=xx0+k; if substr(#.j,_,l)==z then do; #.j=overlay(n,#.j,_); return; end; _=max(1,xx0-k+1); if substr(#.j,_,l)==z then do; #.j=overlay(n,#.j,_);return;end;end;return na: if arg(1)\== then call er 01,arg(2);parse var ops na ops;if na== then call er 35,_o;return na nai: return int(na(),_o) nan: return num(na(),_o) no: if arg(1)\== then call er 01,arg(2); return left(_,2)\=='NO' novalue: !sigl=sigl; call er 17,!fid(2) !fid(3) !sigl condition('D') sourceline(!sigl) num: procedure;parse arg x .,f,q;if x== then return x;if isnum(x) then return x/1;x=space(translate(x,,','),0);if \isnum(x) then x=$sfxf(x);if isnum(x) then return x/1;if q==1 then return x;if q== then call er 53,x f;call erx 53,x f p: return word(arg(1),1) plotL: if quiet then return; parse arg plotL; if simple then plotL=simple(plotL); if tops== then say arg(1); else graf=graf'÷'arg(1); return qSort: procedure expose @.; h=@.0; do while h>1; h=h%2; do i=1 for @.0-h; j=i; k=h+i; do while @.k<@.j; t=@.j; @.j=@.k; @.k=t; if h>=j then leave; j=j-h; k=k-h; end; end; end; return round: return format(arg(1),,p(arg(2) 0)) s: if arg(1)==1 then return arg(3); return word(arg(2) 's',1) shorten: procedure; parse arg a,n; return left(a,max(0,length(a)-p(n 1))) simple: return translate(arg(1),'.||--%<>AV'copies('+',25),"·│║─═☼◄►↑↓┤┐└┴┬├┼┘┌╔╗╚╝╟╢╞╡╫╪╤╧╥╨╠╣") syntax: !sigl=sigl; call er 13,!fid(2) !fid(3) !sigl !cal() condition('D') sourceline(!sigl)</lang>