User:Ewart Shaw/Utils

From J Wiki
Jump to: navigation, search

Ewart Shaw's (old) utilities

These are my main general-purpose utilities up to J6.02.

They need tidying & extending for J8

NB. Ewart Shaw's programming utilities library
NB. ------------------------------------------
NB. Created 3-Nov-1995
NB. Last modified 17-Apr-2014
NB. ====================================================================

cocurrent 'z'

NB. ====================================================================
NB.* boxpos     v Omit all nonpositive elements from boxes
NB.* boxrest    v Append boxed atoms of (y not in x) to x
NB.* cart       a Cartesian product adverb
NB.* comb       v All combinations of x from y (Hui/Chakahwata)
NB.* copyshape  v Fill shape of x with elements of y
NB.* countint   v Frequency of 0,1,...
NB.* cutbeg     a Cut y using Boolean x & apply verb to each part
NB.* cutend     a as cutbeg, but 1s in x denote ends of cut
NB.* cutfirst   v Cut y at first occurrence of x (default LF)
NB.* diffs      v Successive differences
NB.* donoun     v Execute noun (script) y & return the J dialogue
NB.* execnoun   v Execute noun y (result displayed but NOT returned)
NB.* expand     v Expand y according to x (cf APL's \)
NB.* expprod    v 'Expanded product' of binary matrix x with matrix y
NB.* genlev     v Generate levels (all combs of factor levels y)
NB.* indexreflex v i.~ but often faster (e.g. y a large real array)
NB.* initrl     v Initialize random link based on date/time
NB.* iotav      v Ravel of i.each y (pardon my APL) (Roger Hui)
NB.* kronprod   v Kronecker product of matrices x and y
NB.* mkdir      v Create directory y
NB.* nint       v Round y to nearest integer
NB.* nub        v ~. (faster for real arrays)
NB.* nubfreq    v Frequency of each item in nub
NB.* nubkey     v Index of items in sorted nub
NB.* nubrank    v Replace min.value by 0, 2nd smallest by 1, etc.
NB.* ordercols  v Reorder columns of matrix y (put cols. x first)
NB.* out        v Output y to screen
NB.* pnx        v path;name;extension of filename y
NB.* prompt     v Prompt for input
NB.* rank       v Ranks of y
NB.* rowprod    v All products of rows of matrix x with matrix y
NB.* seginit    v Box y-sized initial segments of x (default i. _)
NB.* shape2     v Matrix containing elements of array y
NB.* showboxes  v Show boxed array omitting horizontal lines
NB.* slice      v Slice&box y wherever x occurs
NB.* tfn        v Text from numeric y, to x s.f., replacing '_' by '-'
NB.* tidyreals  v Tidy array y with tolerance x
NB.* ts         v (Time, space) to run expression
NB.* tts        v (Actual time, CPU time, space) to run expression
NB.* underravel a Apply u. to (,y) then reshape
NB.* values     v 2-col matrix: value (sorted), frequency
NB.* v2         v Conditional invocation (can speed up agenda with 2 options)
NB.* withdflt   v x with defaults appended from y
NB.

boxpos=: (>&0 # ]) &. >

boxrest=: [ , [: ;/ ] -. [: ; [
NB. or, for non-train enthusiasts,
NB.    boxrest=: [ , ;/ @ (-. ;)~

rcart=: *&# $ ]   NB. v Right part of cartesian product construction
lcart=: #~ #      NB. v Left part of cartesian product construction
cart=:  1 : 'lcart u rcart'

comb=: 4 : 0   NB. by Roger Hui & Ken Chakahwata
 k=. i.>:d=.y-x
 z=. (d$<i.0 0),<i.1 0
 for. i.x do. z=. k ,.&.> ,&.>/\. >:&.> z end.
 ; z
)

copyshape =: ($@[ $ ,@])

  cutc=: 2 : ';@(<@x ;. y)'
cutbeg=: cutc 1
cutend=: cutc 2

cutfirst=: LF&$: : (i.~ ({. ; >:@[ }. ]) ])

diffs=: }. - }:

donoun=: 3 : 0
out_jehs_ =. ''
for_ybjehs. <;._2 (, ({: ~: LF"_) # LF"_) y do.
  y_jehs_ =. > ybjehs
  addlf_jehs_=. -. 'NB.' -: 3 {. (#~ [: +./\ ~:&' ') y_jehs_
  out_jehs_ =. out_jehs_ , '   ' , y_jehs_ , addlf_jehs_ # LF
  try. temp_jehs_ =. ": ". y_jehs_
    if. -. (1 { (;: y_jehs_), 2#a:) e. '=.';'=:' do.
      out_jehs_ =. out_jehs_ , , temp_jehs_ ,&.|: LF
    end.
  catch.
    k_jehs_=. I. ': donoun' E. err_jehs_ =: (13!:12'')
    if. # k_jehs_ do.
      err_jehs_=. k_jehs_ ({. , (8 + [) }. ]) err_jehs_
    end.
    out_jehs_ =. out_jehs_ , err_jehs_
  end.
end.
}: out_jehs_
)

execnoun=: [: 0!:111 ,&(10{a.)

expand=: #^:_1
NB. expand=: /:@\:@[ { #@[ {. ]   NB. Old version (from Ken Iverson)

expprod=:  (#~#) (($$(*+/\)@,)@[ { 0:,+/@,@[$]) ,@]

genlev=: #: [: i. */

initrl=: 9!:1 @ <. @ ([: (0 60 60 24 31 12"_ #. |.) 6!:0)

iotav=: [: ; i.&.>   NB. (from Roger Hui)

isnewitem=: 1: , }. -.@-:"_1 }:
nubkey=: /:^:2 { (+/\ @ isnewitem @ /:~)
indexreflex=: i.~ @ nubkey
nub=: nubkey {./. ]

kronprod=: *&$ $ ,@: (*"0 1 cart) f.

mkdir=: 3 : 0
d=. {. yb=. (([: +/\ e.&'\/') </. ]) y
while. 0 < #yb=. }. yb do.
 try. 1!:5 d=. d ,&.> {. yb catch. end.
end.
)

nint=: [: <. +&0.5

nubfreq=: diffs @ (# ,~ (~:@/:~) # i.@#)
nubrank=: i.~ (/:~@~.@,)
countint=: <: @ (nubfreq @ (/:~ @ ((i.@>:@(>./)),])))

ordercols=: (([ , i.@#@] -. [) { ])"1

NB. out=: 1!:2 2:
out=: smoutput   NB. for compatibility; replace out by smoutput from stdlib
prompt=: [: 1!:1 [: 1: [: out '<Enter> to continue'"_ @ out

pnx=: monad define
n=. - <./ (|. y) i. '\/'
p=. n }. y [ nx=. n {. y
n=. nx i: '.'
p ; (n{.nx) ; (>:n)}.nx
)

rank=: /:^:2 -:@:+ /:^:2&.|.

rowprod=: ,"2/ @ (*"1/)

seginit=: (+/\@:(0 , }:) <@(+ i.)"0 ]) : ({L:0 _~ $:)

shape2=: ((*/@}: , {:) @ $ @ ,:) $ ,

showboxes=: (#~ (25 124{a.) e.~ {."1)@":

slice1=: #@[ }.&.> [ (E. <;.1 ]) ,

slice=: dyad define
x=. boxopen x [ y=. boxopen y
m=. shape2 x E.&> y
k=. +/ m * >:i.#x      NB. key
b=. (+/\ * k) </. >y   NB. boxed bits
kw=. (k-.0) { a:,x     NB. keyword
((-#b) {. kw) ([ ,. (#@[ }. ])&.>) b
)

tfn=: verb define
5 tfn y
:
pp=. 9!:10''
9!:11 x
y=. ": y
9!:11 pp
('-',a.) {~ ('_',a.) i. y
)

tidyreals=: 3 : 0
1e_13 tidyreals y
:
isint=. x > | y - k=. <. x + y=. , y [ s=. $y
y=. (k*isint) + y*-.isint
key=. +/\ 1 , x < | diffs nub=. /:~ ~. y
s $ (nub i. y) { ; key ([: < # # +/ % #)/. nub
)

ts=: 6!:2 , 7!:2@]

tts=: 3 : 0
t0=. 6!:1''
ts=. (6!:2 , 7!:2) y
((6!:1'')-t0), ts
)

underravel=: 1 : '$@] $ u@,'

values=: (~. ,"0 nubfreq) @ /:~

v2=: (v2false * -.@v2test) + v2true * v2test

withdflt=: [ , #@[ }. ]

NB. ====================================================================
NB. From other files
NB.
NB. basecount v Matrix with rows = 0 to x^y in base x (default 2)
NB. bincount  v Matrix with rows = 0 to 2^y in binary
NB. distsq    v Squared Euclidean distances between row vectors of y
NB. ident     v Identity matrix (size y * y)
NB. lmvn01    v Log of standard multivariate Normal density
NB. monomial  v y^x (x, y vectors)
NB. sfi       v Sign (-1,1) from incidence (0,1)
NB. signfs    v All combinations of y signs
NB.

LN2PI=:    ^. o. 2

bincount=: basecount=: 2&$: : ($~ #: i.@^)
distsq=: +/"1 @: *: @: (-"1/~)
ident=:     =@i.
lmvn01=: - @ -: @ (LN2PI&*@{:@$ + +/"1@:*:)
monomial=: */ @: ^"1~
sfi=: [: <: +:
signfs=:   sfi @ bincount

NB. ====================================================================
NB. Examples/Exercises/Execution
NB.
NB. multiex  v Display results of several one-liners
NB. runex    v Run example script(s) (as e.g. in ex_esutils.ijs)
NB.            name_EX0/EX1/EX2 = no header/1 example/>1 example
NB. TODO     n Banner-size TODO reminder
NB.

multiex=: (,: ".&.>)@:boxopen

runex=: 3 : 0
out '   NB. ', 70#'='
nl0=. ({.y) nl 0
if. nl0 e.~ <yex=. y,'_EX0' do.
  head=. ''
elseif. nl0 e.~ <yex=. y,'_EX1'' do.
  head=. 'NB. ### ', y, ': Example ###', LF, 'NB.', LF
elseif. nl0 e.~ <yex=. y,'_EX2' do.
  head=. 'NB. ### ', y, ': Examples ###', LF, 'NB.', LF
end.
execnoun head, ". yex
)

TODO=: (<'NB.     ') ,&> LF cut 0 : 0
TTTTT   OOO   DDDD    OOO     !!  !!
  T    O   O   D  D  O   O    !!  !!
  T    O   O   D  D  O   O    !!  !!
  T    O   O   D  D  O   O
  T     OOO   DDDD    OOO     !!  !!
)

NB. ====================================================================
NB. TO DO
NB.
NB. Tidy up & generalise kronprod
NB. Add "control structures"
NB.

Hacky script to produce examples of ES utilities

NB. Ewart Shaw programming utilities examples
NB. -----------------------------------------
NB. Created Nov-1995
NB. Last modified 17-Apr-2014
NB. ====================================================================

load 'esutils'

NB. ====================================================================

DESCRIBE=: 0 : 0
NB. Run examples of Ewart Shaw's utilities
NB. Type:-
   ex_esutils''
NB. to run all examples.
)

ex_esutils=: 3 : 0
runex&> ;: 'boxpos boxrest comb copyshape'
runex&> ;: 'diffs donoun'
([: 0!:111 ,&(10{a.)) execnoun_EX0 [ out '   NB. ', 70#'='
runex&> ;: 'expand expprod genlev indexreflex initrl iotav'
runex&> ;: 'kronprod mkdir nint nubs ordercols out pnx'
runex&> ;: 'rank rowprod seginit shape2 showboxes slice'
runex&> ;: 'tfn tidyreals ts underravel values v2 withdflt'
'done'
)

NB. ====================================================================

boxpos_EX1=: 0 : 0
1 2 ; 3 4 5 ; 6
v=. 1 2 ; 3 4 5 ; 6
]w=.>v
<"1 w
boxpos <"1 w
)

NB. ====================================================================

boxrest_EX1=: 0 : 0
(1 2 7 ; 4 5) boxrest i.10
)

NB. ====================================================================

cart_EX0=: 0 : 0
NB. ### cart: Example 1 ###
NB.
(i.2 3) ^cart i.3 3
NB.
NB. ### cart: Example 2 ###
NB.
(i.3 3) ,.cart 10+i.2 2
NB.
NB. ### cart: Alternatives ###
NB.
cartbox=: , @ { @ (, & (<@:(<"1)))
(i.3 3) (>@(;&.>) @ cartbox) 10+i.2 2
(i.20 3) ((>@(;&.>) @ cartbox) -: (,"1 cart)) i.20 3
20 ts '(i.20 3) (>@(;&.>) @ cartbox) i.20 3'
20 ts '(i.20 3) (,"1 cart) i.20 3'
c1=. ,"1 cart f.
20 ts '(i.20 3) c1 i.20 3'
)

NB. ====================================================================

comb_EX2=: 0 : 0
3 comb 5
ts '10 comb 20'
)

NB. ====================================================================

copyshape_EX2=: 0 : 0
(i. 15) copyshape i. 3 4
(i. 15) copyshape~ i. 3 4
)

NB. ====================================================================

cutfirst_EX2=: 0 : 0
cutfirst 'head',LF,'body',LF,'legs'
'|' cutfirst 'field0 | field1 | field 2 | field 3'
)

NB. ====================================================================

cuts_EX0=: 0 : 0
NB. ### cutbeg, cutend: Examples ###
NB. (cf J Phrases section 5B; phrases c0,a1,a2)
NB.
x=. 1 1 0 0 0 1 0 0 1 1
y=. 3 4 8 2 5 6 9 4 5 4
x +/\cutbeg y
x +/\cutend y
)

NB. ====================================================================

diffs_EX2=: 0 : 0
diffs 1 3 6 10
xy ; diffs xy=. 6 2$0 0 1 2 3 3 6 3 8 2 10 1
diff2=: 2&(-~/\)
diff2 1 3 6 10
10000 ts 'diffs xy'
10000 ts 'diff2 xy'
)

NB. ====================================================================

DONOUN_EX=: 0 : 0
NB. start of DONOUN
b=. o.1 [ a=: o.2
]a=. o.1
".'b=.o.2'
NB. end of DONOUN
)

donoun_EX1=: 0 : 0
DONOUN_EX   NB. already-created noun script
a=. donoun DONOUN_EX
a   NB. donoun returns but doesn't display result
)

NB. ====================================================================

execnoun_EX0=: 0 : 0
NB. ### execnoun: Example (cf donoun) ###
NB.
a=. execnoun DONOUN_EX
a   NB. execnoun displays but doesn't return result
)

NB. ====================================================================

expand_EX1=: 0 : 0
1 0 0 1 0 1 expand 2 3 4
)

NB. ====================================================================

expprod_EX0=: 0 : 0
NB. ### expprod: Example + Comparison ###
NB.
expprod2=: shape2 @ (expand"1/)
x=. #: 12 10 9 6 5 3 [ y=. 5 + i. 2 2
x;y;(x expprod y);x expprod2 y
20 ts 'x expprod y'
20 ts 'x expprod2 y'
)

NB. ====================================================================

genlev_EX2=: 0 : 0
multiex 'genlev 3 4';'genlev 4 3';'genlev 2 3 2'
)

NB. ====================================================================

indexreflex_EX0=: 0 : 0
NB. ### indexreflex, nub: Examples ###
NB.
a=. o. ?. 2000 8 $ 3
(indexreflex -: i.~) a
ts 'indexreflex a'
ts 'i.~ a'
(nub -: ~.) a
ts 'nub a'
ts '~. a'
)

NB. ====================================================================

initrl_EX1=: 0 : 0
initrl''
9!:0''
? 10#100
6!:3 ] 0.1   NB. delay 0.1 seconds before repeating
initrl''
9!:0''
? 10#100
)

NB. ====================================================================

iotav_EX1=: 0 : 0
iotav 3 1 4 1 5
10 ts '([: ; i.&.>) i.1000'   NB. fast!
)

NB. ====================================================================

kronprod_EX2=: 0 : 0
a=. 1 2,:3 _1 [ b=. i. 3 3
a kronprod b
b kronprod a
)

NB. ====================================================================

mkdir_EX1=: 0 : 0
mkdir 'd:\temp\blah\blah\blah'
NB. delete  'd:\temp\blah\blah\blah'  afterwards!!
)

NB. ====================================================================

nint_EX1=: 0 : 0
nint ((-: >: %: 5)^i.20) % %: 5
)

NB. ====================================================================

nubs_EX0=: 0 : 0
NB. ### nubfreq, nubrank, countint: Examples ###
NB.
(/:~@~. ; nubfreq) 3 1 4 1 5 9 2 6 5 3 5
(; nubrank) %/~ 1 2 3 4
countint 3 1 4 1 5 9 2 6 5 3 5
)

NB. ====================================================================

ordercols_EX1=: 0 : 0
1 2 ordercols i.7 5
)

NB. ====================================================================

outfn_EX=: 3 : 0
'a b c'=. out y    NB.  out  inserted for simple debugging
a*b - c*a          NB. do something
)

out_EX1=: 0 : 0
outfn_EX   NB. display already-created test function
outfn_EX i.4
)

NB. ====================================================================

pnx_EX2=: 0 : 0
pnx '~user\projects\ES_lib\ESutils.ijs'   NB. MS
pnx '~user/projects/ES_lib/ESutils.ijs'   NB. Unix
pnx 'nopath.name'
pnx 'c:\Program Files\Silly path\Silly name'
)

NB. ====================================================================

rank_EX1=: 0 : 0
rank 3 1 4 1 5 9 2 6 5 3 5
)

NB. ====================================================================

rowprod_EX1=: 0 : 0
(i.3 4) ; 10+i.2 4
(i.3 4) rowprod 10+i.2 4
)

NB. ====================================================================

seginit_EX2=: 0 : 0
seginit 3 0 4 1
'abcdefghijk' seginit 3 0 4 1
(seginit~ [: ?. +/ # 0:) 3 1 4   NB. reproducible pseudorandom lists
'a b c d e'=. 'antidisestablishmentarianism' seginit 3 2 2 9 3
d
si1=: (+/\@:(0 , }:) <@(+ i.)"0 ]) : ({L:0 _~ si1)
NB. Note (slight nevertheless existing) speed-up of using  $:
1000 ts 'a. seginit 3 14 159 26 5 3 5'
1000 ts 'a. si1 3 14 159 26 5 3 5'
NB. previous R.E.Boss / Ewart Shaw version based on
NB. http://jsoftware.com/pipermail/programming/2006-November/003852.html
NB. http://jsoftware.com/pipermail/programming/2006-November/003854.html
si2=: (* #^:_1 I. </. [: i. +/) : ({L:0 _~ $:)
1000 ts 'a. si2 3 14 159 26 5 3 5'
NB. related but worse idea
si3=: (<@}:/. (-~ i.@#))@I.@:>: : ({L:0 _~ $:)
1000 ts 'a. si3 3 14 159 26 5 3 5'
C=: ?. *: 100#20
multiex '1000 ts ''seginit C''';'1000 ts ''si2 C''';'1000 ts ''si3 C'''
)

NB. ====================================================================

shape2_EX0=: 0 : 0
NB. ### shape2: Examples + Comparison ###
NB.
($;]) shape2 4
($;]) shape2 i. 4
($;]) shape2 i. 3 4
($;]) shape2 i. 2 3 4
(shape2 -: ,.&.(|:"_1@|:)) i. 2 3 4 5 6 7
100 ts 'shape2 i. 2 3 4 5 6 7'
100 ts ',.&.(|:"_1@|:) i. 2 3 4 5 6 7'
)

NB. ====================================================================

showboxes_EX1=: 0 : 0
showboxes ('fee';'fie';'fo';'fum'), <"0 i. 3 4
)

NB. ====================================================================

slice_EX0=: 0 : 0
NB. ### slice & slice1: Examples ###
NB.
'br' slice1 'abracadabra'
'br' slice 'abracadabra'
'a' slice 'abracadabra'
('br';'c') slice 'abracadabra'
)

NB. ====================================================================

tfn_EX2=: 0 : 0
tfn 123456 _123456789 1p1 _1x1
8 tfn 2 2$123456 _123456789 1p1 _1x1
)

NB. ====================================================================

tidyreals_EX1=: 0 : 0
y=. 0 0 1 1 1 1 1.3 1.3 + 0 1e_14 0 1e_14 9e_14 1e_12 5e_14 _5e_14
~: y
~: tidyreals y
)

NB. ====================================================================

ts_EX1=: 0 : 0
100 ts 'i.1000'
)

NB. ====================================================================

underravel_EX1=: 0 : 0
] a=. ?. 5 10$100
/:~ a
/:~ underravel a
)

NB. ====================================================================

values_EX1=: 0 : 0
values %: 3 1 4 1 5 9
)

NB. ====================================================================

v2_EX0=: 0 : 0
NB. ### v2: Example 1 ###
NB.
v2test =. >
v2true =. ]
v2false =. [
min =: v2 f.
3 1 4 1 5 9 min 2 7 1 8 2 8
NB.
NB. ### v2: Example 2 ###
NB.
v2test  =. >&9
v2true  =. -:
v2false =. +:
dorh1   =: v2 f.
dorh =: +: ` -: @. (]>9:)
x =. ?5000$20
ts 'dorh"0 x'
ts 'dorh1 x'
(dorh"0 -: dorh1) x
ts '(+:`-: @. (>&9))"0 x'
)

NB. ====================================================================

withdflt_EX2=: 0 : 0
(<1 2 3) withdflt 2#a:   NB. 2nd argument defaults to a:
1 2 3 withdflt 2#a:      NB. 3 items overwrite defaults
(1;2;3) withdflt 2#a:
)

NB. ====================================================================
NB. describe on loading

1!:2&2 ] DESCRIBE

-- Ewart Shaw <<DateTime(2014-04-17T13:18:41+0100)>>