NB. The J script user\withj05.ijs

NB.  Cliff Reiter's script for creating function digraphs
NB.  withj05b.ijs
NB.  Modified April 31, 2010
NB.
NB.  bd is the prefix for box draw characters; to set box draw characters
NB.
NB.  fdigraph fv  where fv is a list of function values for a function mapping i.#fv into itself
NB.

'bdtl bdtt bdtr bdlt bdc bdrt bdbl bdbt bdbr bdv bdh'=: 9 !: 6 ''

NB. puts a loop out front to the left and does some spacing

drawcycle=:3 : 0
c=.{."1 y
y=.(,&1] 1 j. (}. *. }:)c=bdh)#y  NB. spaces when neighbors
if. 1=#y do. y=.y,bdh,bdh,bdbr end.
c=.{."1 y
i=.(c = bdh)# i. # c
if. 1=#i do.
   y=.(bdh,bdh,bdbr)(<"1 (>:{.i),.i.3)}y
   c=.{."1 y
   i=.(c = bdh)# i. # c
   end.
f=.{.i
l=.{:i
m=.}.}:i
z=.(f#' '),bdtl,((l->:f)#bdv),bdbl
z=.((#y){.z),.}."1 y
j=.(#~ f&< *. <&l *. -.@(e.&m))i.#c
if. 0<#j do. z=.bdv (<"1 j,.2)}z end.
z
)

fdigraph=:3 : 0
i=.i. p=.#y      NB. i is the domain, y the range, p is size of both
f=.{&y          NB. the function giving the relation
fm=.(#":p)&":    NB. vertex formater
le=.i-.y         NB. leaves
ce=./:~@~.@f^:_ i                 NB. cycle elements
bcy=.{&ce&.> C. ce i. f ce        NB. the boxed cycles
ncpr=.(-.@(e.&ce) # ])&.> y </. i
ncpr=.ncpr,(#le)#<''        NB. noncycle leaves
ncpr=.ncpr/:(~.y),le       NB. order them
pred=.>@({&ncpr)            NB. predecessors
gtl=.,.~ #@] {.!.bdv (#&' ' , bdtl"_ )@(i.&bdh)@:({."1)  NB. top left function
gbl=.,.~ #@] {. (#&bdv , bdbl"_ )@(i.&bdh)@:({."1)       NB. bottom right
gbm=.,.~ #@] {.!.bdv (#&bdv , bdlt"_ )@(i.&bdh)@:({."1)
cgl=.( -@(i.&bdh <. i.&bdrt)@:({."1)@] |. #@] {. ,:@[) ,. ]
t0=.,:@((bdh,' ')&,)@":                                  NB. deal with trees with 0 pred's
t1=. ,&' '@((bdh,' ')&,)@fm cgl tree@(''&$)@pred
t2=. (,&(' ',bdh))@((bdh,' ')&,)@fm cgl (gtl@tree@{. , (bdrt, ' ')"_ , gbl@tree@{:)@pred
t3=. (,&(' ',bdh))@((bdh,' ')&,)@fm cgl (gtl@tree@{. , (bdrt, ' ')"_ , ;@:(<@gbm@tree"0)@}.@}: , gbl@tree@{:)@pred
tree=:t0`t1`t2`t3@.(3&<.@#@pred)
drawcycle@;&:(<&tree"0) &.> bcy
)