Plot coordinate pairs/REXX: Difference between revisions
no edit summary
m (→$PLOT.REX (REXX) program: elided an unneeded subroutine.) |
No edit summary |
||
| (2 intermediate revisions by one other user not shown) | |||
Line 3:
This is a general purpose REXX program that supports a variety of options and data formats and produces output in text format.
See the
The <
REXX programs not included are <code>$H</code> which shows '''help''' and other documentation.
==$PLOT.REX (REXX) program==
<syntaxhighlight lang="rexx">
/*REXX program plots X or X,Y points (with/without labels). */
trace off
parse arg !
if !all(arg()) then exit /*if there was a doc request, then exit*/
if !cms then address ''
signal on halt
signal on noValue
signal on syntax
@abc= 'abcdefghijklmnopqrstuvwxyz' /*the lowercase Latin alphabet. */
@abcU= @abc
upper @abcU /*the uppercase Latin 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 are 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,
parse var _ . !. $$ gFID graf labelEnd labelSta labelX labelY tFID ,
tops xmaxuse ymaxuse xminuse yminuse xmnval ymnval ,
xmxval ymxval xy /* [↑] nullify these REXX vars. */
labelDatadef=
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
pntChars= '8eafd6f05c6c7b7c5b9c9f2b'x /* Ä»O0*%#@$£+ */
end
else do /*axis characters for ASCII mach.*/
xaxchar = 'c4'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 #
do
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 abbn('
when
when
when abbn('FUZZ')
when abb('
when abb('
when abb('
when abb('
when abb('
when
when
when
when abb('
when
when abbn('
when
when abbn('
when
when
when abbn('PLOTMULtiples') then plotMult= no()
when abbn('PLOTSEQuencial') then plotSeq= no()
when
when
abb('
abb('
abb('WIDth') then sw= nai()
when abb('SHOWDIGits') |,
when abbn('
abbn('
when abbn('
abbn('
when abbn('
when abbn('
when abbn('
when abbn('SORTascending') then sortA= no()
when abbn('
when
when
when
when
when abb('XMINUSE') then xminuse= nan()
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
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 digits. */
_= 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, , '_')
labelEnd= translate( labelEnd, , '_')
if sortA
if sortA
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'
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
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 _==*/
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
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
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. */
if xSin
end
do j=1 for kws
!.j= @.j
end /*j*/
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? */
Line 264 ⟶ 306:
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= x y
if xmnval=='' then do /*Not set? Use this value.*/
xmnval= x /*set the minimum X value. */
ymnval= y /* " " " Y " */
xmxval= x /* " " maximum X " */
ymxval= y /* " " " Y " */
end
if x>xmxval then xmxval= x
if
if y>ymxval then ymxval= y /* " " maximum Y " */
if y<ymnval then ymnval= y /* " " minimum " " */
end /*j=1 for kws*/
if _w==1 then call er 55,'XY-coordinate XY-plot-point' xy /*odd data pt.*/
oxmxval= xmxval /* " " " maximum.*/
oymxval= ymxval /* " " " " */
if \scaling then do /*Are we not scaling? Get MIN and MAX.*/
ymnval= _ /*minimum for X and Y. */
_= max(xmxval, ymxval)
xmxval= _
ymxval= _ /*maximum for X and Y. */
end
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, issue error. */
promptlen= length( !var('PROMPT') ) /*length of the PROMPT string. */
tsw= sw - 1 /*calculate the usuable scr width*/
tswu= tsw - 1 /*calculate the true screen width*/
tsd= sd - 3 - promptlen % sw - 1
tsdu= tsd - 1 /* " " " " depth*/
if plotSeq then tsw= tsw - length(pnts) /*Plot sequential? Make smaller.*/
#.= copies(bgchar, tsw) /*characters used for background.*/
minxx= /*actual minimum value for X. */
maxxx= /* " maximum " " " */
minyy= /* " minimum " " Y. */
maxyy= /* " " " " " */
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
minyy= yy0 /* " " minimum Y's. */
maxyy= yy0 /* " " maximum Y's. */
do 1 /*handle the 0,0 origin of plot*/
if substr(#.yy0, xx0 + 1, 1)\==bgchar then leave
xn= oxmnval<0 /*find the quadrant for X point. */
xp= oxmxval>0 /* " " " " X " */
yn= oymnval<0 /* " " " " Y " */
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 character.*/
end /*do 1*/ /* [↑] origin char: axis cross.*/
#.yy0= translate( #.yy0, xaxchar, bgchar) /*change the 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
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 /*set initial minimum value for X. */
maxxx= xx /* " " maximum " " X */
minyy= yy /* " " minimum " " Y. */
maxyy= yy /* " " maximum " " Y. */
end
minxx= min(minxx, xx)
minyy= min(minyy, yy) /*set the minimum value of Y. */
maxyy= max(maxyy, yy) /* " " maximum " " 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*/
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···*/
do j=maxyy to minyy
if showOrg then
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 all 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=
!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
Line 433 ⟶ 541:
abbl: return verify(arg(1)'a',@abc,'M')-1
abbn: parse arg abbn; return abb(abbn) | abb('NO'abbn)
er: parse arg _1,_2; call '$ERR' "14"p(_1) p(word(_1,2) !fid(1)) _2; if _1<0 then return _1; exit result
err: call er '-'arg(1),arg(2); return ''
erx: call er '-'arg(1),arg(2); exit ''
Line 457 ⟶ 566:
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)
</syntaxhighlight>
==$PLOT.REX (REXX) program HELP==
| |||