NB.  Cliff Reiter's script for creating function digraphs

NB.  withj05.ijs

NB.  Modified Dec 15, 1998

NB. 

NB.  bd is the prefix for box draw characters; to set box draw characters

NB.  use  bdset =: 0 for PC, 

NB.  or   bdset=:1 for ASCII

NB.  

NB.  fdigraph fv  where fv is a list of function values for a function mapping i.#fv into itself

NB. 



bdset=:0



'bdtl bdtt bdtr bdlt bdc bdrt bdbl bdbt bdbr bdv bdh'=: bdset{ 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=.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

)