Plot coordinate pairs/REXX: Difference between revisions

added the REXX $PLOT.REX program.
(added a REXX program (source) page for "plot coordinate pairs".)
 
(added the REXX $PLOT.REX program.)
Line 1:
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
<lang rexx>
 
@abc='abcdefghijklmnopqrstuvwxyz'; @abcU=@abc; upper @abcU /*alphabet.*/
soon to be installed.
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 ,
</lang>
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.*/
 
#.=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>