sam@copland.jpl.nasa.gov (Sam Sirlin) (04/25/91)
Here's a translation of some code I use for graphs on PC's using
STSC's APL's. It's intended for workstations running X11. You can
do graphics using either xterm, or by remote login using PC Kermit
(which can automatically emulate a tektronix 4010). Under xterm, the
tektronix window opens up automatically, but doesn't close after
you leave J (sigh!). I don't claim that the code is the best that could
be done. I tried as simple a translation as I could.
I noticed that comments in functions are tricky in J, requiring large
quantities of quotes, especially for contractions within comments. I
prefer lamp. The hardest part, however, was changes for the scoping
and indexing.
'draw.js - ploting ws for j 2.9, version 1'
'Samuel W. Sirlin 4/91'
a=. 'draw.js - ploting ws for j 2.9, version 1'
a=. a,: 'Samuel W. Sirlin 4/91'
a=. a, ''
a=. a, 'This ws does plotting using tektronix 4010 commands. It''s'
a=. a, 'setup for either an xterm window or for remote login using PC Kermit.'
a=. a, ''
a=. a, 'To use, try something like'
a=. a, ''
a=. a, ' x=. x (,:"0) (3 o. 1 o. x) - 1 o. 3 o. x=. o. _0.5 + (i. 500)%500'
a=. a, ' b=. graph x'
a=. a, ' b=. b,label ''title'';''xlabel'';''ylabel'''
a=. a, ''
a=. a, 'in an xterm window. To use for Kermit, first change the type variable'
a=. a, 'in gobal gsetup:'
a=. a, ''
a=. a, ' gsetup=. (<1) (<5;1) }gsetup'
a=. a, ''
a=. a, 'I print stuff out on a laser printer using'
a=. a, ''
a=. a, '''file'' write b'
a=. a, ''
a=. a, 'And then using tek2ps file | lpr back in a csh. The functions'
a=. a, 'are commented.'
describe=.a
input=. '1!:1 (1)' :: ''
print=. 'y. 1!:2 (2)' :: ''
write=. 'y. 1!:2 (2)' :: 'y. 1!:2 (<x.)'
catb =. 'y.' :: ' 1 |. y. ; x. '
com=. ' '''''''',y.,'''''''' ' :: ' 1 |. ($: y.); x. '
'' }: '$. =. > ( cond ){ ( <$. ),<label'
d=. com 'buf =. wind axes nus'
d=. d com ' draw axes for a plot'
d=. d com '0 1{ nus = number of intervals'
d=. d com '2}. nus = size of tic marks'
d=. d com 'wind = window points'
d=. d com ' returns tektronix drawing codes'
d=. d com ''
d=. d catb 'buf =. 0 gil |: ( ((,:)(2&+)&(1&|.)) 0 0 1 1 0 ) { x.'
d=. d catb 'deli =. ( (-/"1) (2 2$1 0 3 2){x. ) % 2{. y.'
d=. d catb 'm =. _1 + 0 1{ y.'
d=. d catb 'xy =. ( ,|: (2,0{m)$ +/\ (0{m)$ 0{deli ) (,:"0) (2*0{m)$, 0(,:"0) 2}. y.'
d=. d catb 'xy =. xy,( (2*1{m)$,0(,:"0)2}. y.) (,:"0) (,|: (2,1{m)$, +/\ (1{m)$1{deli)'
d=. d com ''
d=. d catb 'xy =. <. 0.5 + xy + ($xy) $ 0 2{x.'
d=. d catb 'move =. 2 * i. <. (#xy)%2'
d=. d catb 'buf =. buf, move gil xy'
axes=. '' :: d
clear =. '( 27 91 63 51 56 104, 27 12, 27 3) { a.' :: ''
cleark =. '( 27 91 63 51 56 104, 27 12, 27 91 63 51 56 108) { a.' :: ''
d=. com 'clear '
d=. d com ' clears the screen'
d=. d com ' for tektronix or kermit'
d=. d catb '(0{"(1) gsetup)=. 1{"(1) gsetup'
d=. d catb '$. =. ,> (type =0) { $.;tek'
d=. d catb '$. =. ,> (type =1) { $.;kermit'
d=. d catb '$. =. 0'
d=. d catb 'tek) print ( cotek, cocls, covt ) { a.'
d=. d catb '$. =. 0'
d=. d catb 'kermit) print ( cotek, cocls, covtk){ a.'
clear=. d :: ''
d=. com 'a=. s cshape c'
d=. d com ' break up a character vector'
d=. d com ' into pieces of size s neatly'
d=. d com ' '
d=. d catb 's=. x.'
d=. d catb 'n=. $c=. ,y.'
d=. d catb 'a=. (x.,0)$'' '''
d=. d catb 'loop) i=. i + s*0= i =. n <. s - (|. s{. c)i. '' '''
d=. d catb 'a=. a (,"1); ,(<. 0.5*i-s)|. s{. i {. c'
d=. d catb '$. =. ,> (0 < n=. $c=. i }. c) { $. ; loop'
d=. d catb 'a '
cshape=. '' :: d
d=. com 'draw buf'
d=. d com ' draw buf on screen'
d=. d com ' type=. 0 for X windows'
d=. d com ' 1 for kermit 4010 emulation on a PC'
d=. d com ''
d=. d catb '(0{"(1) gsetup)=. 1{"(1) gsetup'
d=. d catb '$. =. ,> (type =0) { $.;tek'
d=. d catb '$. =. ,> (type =1) { $.;kermit'
d=. d catb '$. =. 0'
d=. d catb 'tek) print ( cotek, y. ,covt ) { a.'
d=. d catb '$. =. end'
d=. d catb 'kermit) print ( cotek, y. ){ a.'
d=. d com 'pause for cr '
d=. d catb 'z =. input i.0 '
d=. d catb 'print covtk { a.'
d=. d catb 'end) '
draw=. d :: ''
t=.'global variable of parameters needed inside graph function'
a=.' overall window size'
d=. 'window'; 250 820 100 700
a=. a,: ' border around window'
d=. d,: 'border'; _10 10 _10 10
a=. a,' number of major divisions on x and y axes'
d=. d, 'gndiv'; 4 4
a=. a,' font size: 14 12 10 8'
d=. d, 'gfont';14
a=. a,' printing precision for axis labels, x and y'
d=. d, 'gpr';1 1
a=. a,' screen type: 0 (X windows), 1 (kermit/pc)'
d=. d, 'type';0
a=. a,' codes to enter tektronix mode'
d=. d, 'cotek'; 27 91 63 51 56 104
a=. a,' codes to return to vt100 mode'
d=. d, 'covt'; 27 3
a=. a,' codes to return to vt100 mode, kermit'
d=. d, 'covtk'; 27 91 63 51 56 108
a=. a,' codes to clear the screen'
d=. d, 'cocls'; 27 12
gsetup=:d,"1 ;<"1 a
d=. com 'buf=. graph xy'
d=. d com ' plot rest against 1st column (expect >1 columns)'
d=. d com ' returns vector of tektronix drawing codes'
d=. d com ''
d=. d catb '(0{"(1) gsetup)=. 1{"(1) gsetup'
d=. d catb 'csize=. <. 14 22* {. ((+. /gfont=14 12 10 8)#gfont%14),1'
d=. d catb 'z =. (window;gndiv) scale y.'
d=. d catb 'buf =. (0,>3{z) gil >0{z'
d=. d catb 'buf =. buf, window axes (2*gndiv), 12 25'
d=. d catb 'buf =. buf, (window+border) axes (2*gndiv), 0 0'
d=. d com ''
d=. d catb 'yl=. <. 0.5+(_12 0.5 *csize)+0 3{window'
d=. d catb 'yl=. yl, <. 0.5+(-/ |. _2 {. window)% 1{ gndiv'
d=. d catb 'buf=. buf, yl ins (10,1{gpr) fm ((1+1{gndiv),1) $ |. > 2{z'
d=. d com ''
d=. d catb 'xf=. <. 0.5 + (-/1 0{window)% (0{gndiv)*0{csize'
d=. d catb 'xl=. <. 0.5 + (0 2{window) - 0.5 2*csize'
d=. d catb'buf=.buf, xl ins (+/ *./\ '' ''= xnum)|. xnum=.(xf,0{gpr)fm ,>1{z'
d=. d com ''
d=. d catb'ts=. 6!:0 (0)'
d=. d catb'blurb=. (5{.''SWS''),(5{. ": 1 2{ ts),: ": 0{ts'
d=. d catb'bloc=. ( (1 3{window)+( (1{border),0 ) + 1 0*csize ),1{csize'
d=. d catb'buf=. buf, bloc ins blurb'
d=. d com ''
d=. d catb 'draw cocls,buf'
d=. d catb 'buf { a.'
graph=. d :: ''
a=. com ' c=. a fm b'
a=. a com ' format numbers b according to a'
a=. a com ' switching between normal and exponential notation'
a=. a com ' as needed to fit'
a=.a catb'$.=. >(+./x. < (|.1,3 + _1{. x.)+ 1 _1 * <. 10^. >./ |,y.) { $.;ef'
a=. a catb 'c=. ( (0{x.)+0.1*1{x. ) ": y.'
a=. a catb '$. =. end'
a=. a catb 'ef) c=. ( -(0{x.)+0.1*1{x. ) ": y.'
a=. a catb 'end) c'
fm=. '' :: a
a=. com ' c=. move gil z'
a=. a com ' translates moves and points to drawing codes'
a=. a com ' move is index 0'
a=. a com ' z is (x (,"1) y1 (,"1) y2 ...),'
a=. a com ' screen units (1024 * 768)'
a=. a com 'output is ascii indices of tektronix 4010 drawing codes'
a=. a com 's.w. sirlin, 1/28/91'
a=. a com ''
a=. a catb '$. =. ( 0 ~: (i.0)$$y.) # $.'
a=. a catb '$. =. , > (2 = $ $ y.) { $.;nxt'
a=. a catb 'y. =. ( (<.0.5* */ $y.),2 ) $y.'
a=. a catb 'nxt) n=.#y.'
a=. a catb 'c=. ((n,4)$ 32 96 32 64)+(n,4)$, |."_1 ( <. y. %32 ) (,:"0) 32 | y.'
a=. a com 'zero index origin used in move'
a=. a catb 'c=. (; 29 ( 0, ( (0<x.) *. n>x. )#x. ) } n$0 ) (,"1) c'
a=. a catb 'c=. ((c ~: 0)#c=. ,c),31'
gil=.'0$: y.' :: a
a=. com ' buf =. a ins c'
a=. a com ' insert text (c) at (a)'
a=. a com ' a contains location(x,y) and, optionally,'
a=. a com ' the y spacing between rows'
a=. a com ' c is the text'
a=. a com ''
a=. a catb '(0{"(1) gsetup)=. 1{"(1) gsetup'
a=. a catb 'csize=. <. 14 22* {. ((+. /gfont=14 12 10 8)#gfont%14),1'
a=. a catb 'b=. _1 {. a=. x.'
a=. a catb '$. =. ,> (1 < $$ c =. y.){ $. ;out'
a=. a catb 'c=. (1,$c)$,c'
a=. a catb 'out) i=. 0'
a=. a catb 'r=. {. $c'
a=. a catb 'buf =. i. 0'
a=. a catb 'lp) buf =. buf, 0 gil (0{a),(1{a)-1{csize'
a=. a catb '$. =. > (14=gfont) { $. ; add'
a=. a catb 'buf=. buf,27, a. i. 1 {. ((gfont=14 12 10 8)#''89:;''),''8'' '
a=. a com ' add text to buf'
a=. a catb 'add) buf =. buf, a. i. ''_-'' replace i{c'
a=. a catb 'nxt) $. =. > (r = i=. i + 1) { $. ; end'
a=. a catb 'a=. ( (1{a)-b ) (,1) } a'
a=. a catb '$. =. lp'
a=. a catb 'end) buf'
ins=. '' :: a
d=. com 'buf=. label (title;xlabel;ylabel)'
d=. d com ' label axes if any of the boxes aren t empty'
d=. d com ' '
d=. d catb '(0{"(1) gsetup)=. 1{"(1) gsetup'
d=. d catb 'csize=. <. 14 22* {. ((+. /gfont=14 12 10 8)#gfont%14),1'
d=. d com ' '
d=. d catb 'size=. <. 0.5+ ((-/"1)(|."1)2 2$window)%csize'
d=. d catb 'buf=. i.0'
d=. d com ' title'
d=. d catb '$.=. ,> (0=$ ,tit=. >0{y.) { $.; xlabel'
d=. d catb 'i=. 4<. 1+1{. $ y=. |: (0{size) cshape tit'
d=. d catb 'loc=. (0 3{window) + csize*0,i'
d=. d catb 'buf=. buf,( loc, 1{csize ) ins y'
d=. d com ' xlabel'
d=. d catb'xlabel) $.=. ,> (0=$,xla=. >1{,y.) { $.;ylabel'
d=. d catb 'loc=. (0 2{window) - 0 3*csize '
d=. d catb 'buf=. buf,( loc, 1{csize ) ins |: (0{size) cshape xla'
d=. d com ' ylabel'
d=. d catb'ylabel) $.=. ,> (0=$, yla=. >2{,y.) { $.;end'
d=. d catb 'y=. (2{. ($, yla),1)$ yla'
d=. d catb 'loc=. (0 3{window)-csize*(3+10>. _1 {. $y),0 '
d=. d catb 'buf=. buf,(loc, 1{csize) ins (1{size) cshape y'
d=. d com ' '
d=. d catb'end) draw buf'
d=. d catb 'buf {a. '
label=. d :: ''
a=. com ' r =. c replace s'
a=. a com 'simple character replacement in text'
a=. a com 'replace 0{c by 1{c in s'
a=. a com ''
a=. a catb 'n=. $ y.'
a=. a catb 'r=. ,y.'
a=. a catb 'r=. (1{x.) ( (r=0{x.)# i. #r ) } r'
a=. a catb 'r=. n$r'
replace =. '' :: a
t=. com ' (xy;xnum;ynum;move) =. (window;gndiv) scale xy'
t=. t com' scaling function for graph'
t=. t com' window is a vector of 4 window points'
t=. t com' screen units (1024 * 768)'
t=. t com' gndiv is a vector of the number of the 2 axis subdivisions'
t=. t com'output '
t=. t com' xy is scaled to screen units'
t=. t com' xynum=. (xnum;ynum) axis labels'
t=. t com's.w. sirlin, 4/1/91'
t=. t com' no xy_scales'
d=.t catb'window=. >0{x.'
d=.d catb 'gndiv=. >1{x.'
d=. d catb 'x =. {."1 y.'
d=. d catb 'y =. }."1 y.'
d=.d catb 'range=. 1 2 5 10'
d=.d catb 'n=. #y.'
d=.d catb 'm=. _1 + _1 {. $y.'
d=.d catb 'b=. (>. / x), >. / ,y'
d=. d catb 'a=. (<. / x), <. / ,y'
d=. d catb '$. =. > ( +. /i =. b=a ){ (<$.),<ck'
d=. d catb 'ok) $. =. cal'
d=. d catb 'cal) a=. o*<. a%o=. 10 ^ <. 10 ^. b-a'
d=. d catb 'o =. 10 ^ <. 10 ^. d =. (b-a) % gndiv'
d=. d catb 'd=. o * ( +/"1 (d%o) >/ range ) { range'
d=. d catb 'nxt) i=. d >(d*gndiv)-b-a'
d=. d catb 'a=. (1-i%2)*d*(<. a*(1+i)%d)'
d=. d com ' make sure interval still fits'
d=. d catb '$. =. > ( +. / (d*gndiv) < b-a ){ (<$.),<cal'
d=. d com ''
d=. d catb 'xnum =. (0 { a) + 0,(0 { d)* 1+ i. 0 { gndiv'
d=. d catb 'ynum =. (1 { a) + 0,(1 { d)* 1+ i. 1 { gndiv'
d =. d com ' now scale x, y'
d=. d catb 'c=. -((-/"1) 2 2$ window)%gndiv*d'
d=. d catb 'min=. , 2 1 {. 2 2$window'
d=. d com ' j=. 1,(n,m)$2'
d=. d catb 'x=. <. 0.5+(0{min) + (0{c)*x-0{a'
d=. d catb 'y=. <. 0.5+(1{min) + (1{c)*y-1{a'
d=. d catb 'xy =. ((n*m)$x) ,:"0 , |: y'
d=. d catb 'move =. n* 1 + i. m-1'
d=. d catb '$. =. end'
d=. d com ' x and/or y is constant'
d=. d catb 'ck) b=. 1 ( (i *. a=0) # i. 2 ) } b'
d=. d catb 'a=. 0 ( (i *. a>0) # i. 2 ) } a'
d=. d catb '$. =. ok'
d=. d catb 'end) xy;xnum;ynum;move'
scale=. '' :: d
tek =. 27 91 63 51 56 104
vt=. 27 3
vtk =. 27 91 63 51 56 108
--
Sam Sirlin
Jet Propulsion Laboratory sam@kalessin.jpl.nasa.govcs450a03@uc780.umd.edu (04/25/91)
Samuel Sirlin writes: >I noticed that comments in functions are tricky in J, requiring large >quantities of quotes, especially for contractions within comments. I >prefer lamp. You can get around some of those quotes with a construct like: +------------------------------ |$.=.start | | comments | |start) | Though you do have to follow quoting and spelling rules. (and maybe parenthization rules -- I haven't played around with this much, yet). You can get around the contraction problem by not using contractions, or using backquote, can`t you? Raul Rockwell
sam@kalessin.jpl.nasa.gov (Sam Sirlin) (04/25/91)
(regarding Raul Rockwell's points [rn's not as good as xrn]) I think your branch around initial comments won't stop the parser from looking at the comment lines at the definition phase, so I suspect that function definition would fail without matching ''s or maybe bad tokens, though maybe you don't need a quoted string... It might also run faster than just running through the quotes at each invocation... On the other hand, I think any readable programming style should use comments sprinkled throughout a program, and this would be contorted using branching all the time. By making it cumbersome, J seems to be designed to discourage comments. Backquote is a good idea for contractions. Sam Sirlin Jet Propulsion Laboratory sam@kalessin.jpl.nasa.gov Sam Sirlin Jet Propulsion Laboratory sam@kalessin.jpl.nasa.gov