⍝ Graphs:

⍝      Graph "a".
⍝    ┌─────A←────┐
⍝    │     │     │   5 vertices: A B C D E
⍝    ↓     ↓     │
⍝    B←───→C────→D   8 edges:    A→B  A→C  B→C  C→B
⍝          ↑     │               C→D  D→A  D→E  E→C
⍝          │     ↓
⍝          └─────E

    ⎕io←1

    a←(2 3)(3)(2 4)(1 5)(3)             ⍝ simple origin-1 graph "a" (above)

    a inslink 5 1                       ⍝ ··· with new link 5→1
┌───┬─┬───┬───┬───┐
│2 3│3│2 4│1 5│3 1│
└───┴─┴───┴───┴───┘

⍝ As many of the functions take a graph as <left> argument and a "modifier" on
⍝ the <right>, the "fold left" operator is useful:

    a inslink foldl (5 1) (3 5)         ⍝ graph "a" with new links: 5→1, 3→5.
┌───┬─┬─────┬───┬───┐
│2 3│3│2 4 5│1 5│3 1│
└───┴─┴─────┴───┴───┘
    a remlink foldl (1 3) (2 3)         ⍝ graph "a" without links: 1→3, 2→3.
┌─┬┬───┬───┬─┐
│2││2 4│1 5│3│
└─┴┴───┴───┴─┘

    vm←{{⍵/⍳⍴⍵}¨↓⍵}                     ⍝ vector from matrix form.

    mv←{⍉(⍳⍴⍵)∘.∊⍵}                     ⍝ matrix from vector form.

    (,¨a) ≡ vm mv a                     ⍝ round-trip graph a.
1

⍝ We  can borrow some lines from the <kt> Knight's Tour function, to generate
⍝ a graph (k) of the knight's moves on an ⍵-sized chessboard.

    kt_graph←{                      ⍝ Graph of knight's moves on ⍵-board.
        kdef←,0 1∘.⌽1 ¯1∘.,2 ¯2     ⍝ vector of relative knight's moves.
        net←(⊂,⍳⍵)∩¨↓(⍳⍵)∘.+kdef    ⍝ absolute moves from each square.
        ⎕io+,⍵∘⊥¨¨net-⎕io           ⍝ adjacency vector.
    }

    k←kt_graph 8 8                  ⍝ graph of knight's moves on an 8×8 board.
    k
┌─────┬────────┬──────────┬───────────┬───────────┬───────────┬────────┬─────┬───────┬──────────┬───────────────┬───────────────┬───────────────┬───────────────┬──────────┬───────┬──────────┬───────────────┬────────────────────┬─────────────────────┬─────────────────────┬─────────────────────┬───────────────┬──────────┬───────────┬────────────────┬───────────────────────┬───────────────────────┬───────────────────────┬───────────────────────┬─────────────────┬───────────┬───────────┬─────────────────┬───────────────────────┬───────────────────────┬───────────────────────┬───────────────────────┬─────────────────┬───────────┬───────────┬─────────────────┬───────────────────────┬───────────────────────┬───────────────────────┬───────────────────────┬─────────────────┬───────────┬────────┬───────────┬─────────────────┬─────────────────┬─────────────────┬─────────────────┬───────────┬────────┬─────┬────────┬───────────┬───────────┬───────────┬───────────┬────────┬─────┐
│11 18│12 17 19│9 13 18 20│10 14 19 21│11 15 20 22│12 16 21 23│13 22 24│14 23│3 19 26│4 20 25 27│1 5 17 21 26 28│2 6 18 22 27 29│3 7 19 23 28 30│4 8 20 24 29 31│5 21 30 32│6 22 31│2 11 27 34│1 3 12 28 33 35│2 4 9 13 25 29 34 36│3 5 10 14 26 30 35 37│4 6 11 15 27 31 36 38│5 7 12 16 28 32 37 39│6 8 13 29 38 40│7 14 30 39│10 19 35 42│9 11 20 36 41 43│10 12 17 21 33 37 42 44│11 13 18 22 34 38 43 45│12 14 19 23 35 39 44 46│13 15 20 24 36 40 45 47│14 16 21 37 46 48│15 22 38 47│18 27 43 50│17 19 28 44 49 51│18 20 25 29 41 45 50 52│19 21 26 30 42 46 51 53│20 22 27 31 43 47 52 54│21 23 28 32 44 48 53 55│22 24 29 45 54 56│23 30 46 55│26 35 51 58│25 27 36 52 57 59│26 28 33 37 49 53 58 60│27 29 34 38 50 54 59 61│28 30 35 39 51 55 60 62│29 31 36 40 52 56 61 63│30 32 37 53 62 64│31 38 54 63│34 43 59│33 35 44 60│34 36 41 45 57 61│35 37 42 46 58 62│36 38 43 47 59 63│37 39 44 48 60 64│38 40 45 61│39 46 62│42 51│41 43 52│42 44 49 53│43 45 50 54│44 46 51 55│45 47 52 56│46 48 53│47 54│
└─────┴────────┴──────────┴───────────┴───────────┴───────────┴────────┴─────┴───────┴──────────┴───────────────┴───────────────┴───────────────┴───────────────┴──────────┴───────┴──────────┴───────────────┴────────────────────┴─────────────────────┴─────────────────────┴─────────────────────┴───────────────┴──────────┴───────────┴────────────────┴───────────────────────┴───────────────────────┴───────────────────────┴───────────────────────┴─────────────────┴───────────┴───────────┴─────────────────┴───────────────────────┴───────────────────────┴───────────────────────┴───────────────────────┴─────────────────┴───────────┴───────────┴─────────────────┴───────────────────────┴───────────────────────┴───────────────────────┴───────────────────────┴─────────────────┴───────────┴────────┴───────────┴─────────────────┴─────────────────┴─────────────────┴─────────────────┴───────────┴────────┴─────┴────────┴───────────┴───────────┴───────────┴───────────┴────────┴─────┘

    ⍴¨k(↑,/k)                       ⍝ number of vertices and edges.
┌──┬───┐
│64│336│
└──┴───┘
    k path 1 2                      ⍝ Knight's path from square 1 to 2.
1 18 12 2

⍝ We  can  keep a vector of data associated with each vertex separate from, but
⍝ parallel with, the graph. In this case we might like a vector of board posit-
⍝ ion notations: A1 A2 ··· B1 B2 ··· H8. This vector may exist independently as
⍝ a workspace variable, or could be bound with a "translation" function.

    show←{(,⍉8 8↑⎕A∘.,1↓⎕D)[⍵]}     ⍝ show board positions.

    ⍕show k path 1 9                ⍝ a shortest path from A1 to A2.
 A1  B3  C1  A2 

    ⍕show k path 1 64               ⍝   ··  ··  ··  ··  to opposite corner.
 A1  B3  C5  B7  D8  F7  H8 

    ⍕show k path 1 10               ⍝   ··  ··  ··  ··  to adjacent diagonal
 A1  B3  C5  A4  B2 

    a span 1                        ⍝ spanning tree for graph "a" from vertex 1.
¯1 1 1 3 4

    (a span 1)stpath 2              ⍝ shortest path from 1 to 2 using span tree.
1 2
    (a span 1)∘stpath¨⍳⍴a           ⍝ shortest path from 1 to each vertex.
┌─┬───┬───┬─────┬───────┐
│1│1 2│1 3│1 3 4│1 3 4 5│
└─┴───┴───┴─────┴───────┘
                                    ⍝ shortest path between
    ↑{(a span ⍵)∘stpath¨⍳⍴a}¨⍳⍴a    ⍝ each pair of vertices.
┌───────┬─────┬─────┬─────┬───────┐
│1      │1 2  │1 3  │1 3 4│1 3 4 5│
├───────┼─────┼─────┼─────┼───────┤
│2 3 4 1│2    │2 3  │2 3 4│2 3 4 5│
├───────┼─────┼─────┼─────┼───────┤
│3 4 1  │3 2  │3    │3 4  │3 4 5  │
├───────┼─────┼─────┼─────┼───────┤
│4 1    │4 1 2│4 5 3│4    │4 5    │
├───────┼─────┼─────┼─────┼───────┤
│5 3 4 1│5 3 2│5 3  │5 3 4│5      │
└───────┴─────┴─────┴─────┴───────┘

    k span 1                        ⍝ knight's spanning tree from vertex 1.
¯1 12 18 21 11 12 13 23 3 25 1 18 3 29 21 31 11 1 25 35 11 12 29 39 35 11 33 18 35 45 21 38 18 28 18 26 52 28 29 55 35 52 33 50 35 52 62 38 43 35 45 35 43 60 45 62 51 52 53 50 55 52 53 54

    k span 10                       ⍝ spanning tree from vertex 10.
18 17 20 10 20 12 22 14 26 ¯1 17 27 30 20 30 22 27 33 25 10 27 12 40 30 10 20 10 45 44 20 37 47 27 44 25 42 27 44 54 30 35 27 33 27 35 61 37 54 59 44 61 42 59 44 61 62 42 52 44 54 44 52 53 54

⍝ We can write a format operator to display the spanning tree:

    mtree←{                         ⍝ Matrix format of spanning tree.
        vfmt←⍺⍺                     ⍝ vertex format function.
        tree←⍵                      ⍝ spanning tree.
        ↑''{                        ⍝ mix to char matrix.
            this←⊂⍺,⊃vfmt ⍵         ⍝ indented, formatted vertex.
            next←(tree=⍵)/⍳⍴tree    ⍝ child vertices of current vertex ⍵.
            next≡⍬:this             ⍝ childless: finished.
            dent←⍺,'·   '           ⍝ increased indent.
            this,↑,/dent∘∇¨next     ⍝ formatted sub-trees.
        }tree⍳¯1                    ⍝ ... from starting vertex.
    }

⍝ Using the small graph "a" and {⍵⊃⎕a} as a vertex formatting function:

    a                       ⍝ graph "a"
┌───┬─┬───┬───┬─┐
│2 3│3│2 4│1 5│3│
└───┴─┴───┴───┴─┘

    {⍵⊃⎕a}mtree a span 3    ⍝ spanning tree from vertex 3
C        
·   B    
·   D    
·   ·   A
·   ·   E

⍝ Graph of cube in ⍵-space:

    cube←{                      ⍝ ⍵-cube.
        ↓{                      ⍝ split simple matrix:
            0=⍵:1 0⍴0           ⍝ 0-cube: point.
            (2*⍵-1){            ⍝ number of vertices.
                (⍵⍪⍵+⍺),⍺⌽⍳2×⍺  ⍝ ⍵-cube from
            }∇ ⍵-1              ⍝   ⍵-1-cube.
        }⍵
    }

    cube 0              ⍝ point.
┌┐
││
└┘

    cube 1              ⍝ line.
┌─┬─┐
│2│1│
└─┴─┘

    cube 2              ⍝ square.
┌───┬───┬───┬───┐
│2 3│1 4│4 1│3 2│
└───┴───┴───┴───┘

    cube 3              ⍝ regular cube.
┌─────┬─────┬─────┬─────┬─────┬─────┬─────┬─────┐
│2 3 5│1 4 6│4 1 7│3 2 8│6 7 1│5 8 2│8 5 3│7 6 4│
└─────┴─────┴─────┴─────┴─────┴─────┴─────┴─────┘

    cube 4              ⍝ hypercube.
┌───────┬────────┬────────┬────────┬────────┬────────┬────────┬────────┬──────────┬─────────┬─────────┬──────────┬─────────┬──────────┬──────────┬──────────┐
│2 3 5 9│1 4 6 10│4 1 7 11│3 2 8 12│6 7 1 13│5 8 2 14│8 5 3 15│7 6 4 16│10 11 13 1│9 12 14 2│12 9 15 3│11 10 16 4│14 15 9 5│13 16 10 6│16 13 11 7│15 14 12 8│
└───────┴────────┴────────┴────────┴────────┴────────┴────────┴────────┴──────────┴─────────┴─────────┴──────────┴─────────┴──────────┴──────────┴──────────┘

    {(cube ⍵)path 1,2*⍵}10      ⍝ a path between opposite corners of a 10-cube.
1 513 769 897 961 993 1009 1017 1021 1023 1024

    tcm ← {⍵∨⍵∨.∧⍵}⍣≡                           ⍝ transitive closure (matrix).

    try ← tcm\∘{⍵ ⍵}                            ⍝ show (arg rslt) pair.

    try 4 4⍴ 0 1 0 0, 1 0 0 0, 0 0 0 1, 0 0 1 0
┌───────┬───────┐
│0 1 0 0│1 1 0 0│
│1 0 0 0│1 1 0 0│
│0 0 0 1│0 0 1 1│
│0 0 1 0│0 0 1 1│
└───────┴───────┘
    try 4 4⍴ 0 1 0 0, 0 0 1 0, 0 0 0 1, 1 0 0 0
┌───────┬───────┐
│0 1 0 0│1 1 1 1│
│0 0 1 0│1 1 1 1│
│0 0 0 1│1 1 1 1│
│1 0 0 0│1 1 1 1│
└───────┴───────┘
    try 4 4⍴ 0
┌───────┬───────┐
│0 0 0 0│0 0 0 0│
│0 0 0 0│0 0 0 0│
│0 0 0 0│0 0 0 0│
│0 0 0 0│0 0 0 0│
└───────┴───────┘

    tcv ← {⍵{(⍳⍴⍵)∩⍺,1↓↑,/0,⍺⊃¨⊂⍵}¨⊂⍵}⍣≡        ⍝ transitive closure (vector).

    try ← tcv\∘{⍵ ⍵}                            ⍝ show (arg rslt) pair.

    ⍕disp¨ try ,¨2 1 4 3
 ┌─┬─┬─┬─┐  ┌───┬───┬───┬───┐ 
 │2│1│4│3│  │1 2│1 2│3 4│3 4│ 
 └─┴─┴─┴─┘  └───┴───┴───┴───┘ 

    ⍕disp¨ try ,¨2 3 4 1
 ┌─┬─┬─┬─┐  ┌───────┬───────┬───────┬───────┐ 
 │2│3│4│1│  │1 2 3 4│1 2 3 4│1 2 3 4│1 2 3 4│ 
 └─┴─┴─┴─┘  └───────┴───────┴───────┴───────┘ 

    ⍕disp¨ try ⍬ ⍬ ⍬ ⍬                          ⍝ null graph.
 ┌┬┬┬┐  ┌┬┬┬┐ 
 │││││  │││││ 
 └┴┴┴┘  └┴┴┴┘ 

    ⍕disp¨ try a                    ⍝ transitive closure of graph "a" (above).
 ┌───┬─┬───┬───┬─┐  ┌─────────┬─────────┬─────────┬─────────┬─────────┐ 
 │2 3│3│2 4│1 5│3│  │1 2 3 4 5│1 2 3 4 5│1 2 3 4 5│1 2 3 4 5│1 2 3 4 5│ 
 └───┴─┴───┴───┴─┘  └─────────┴─────────┴─────────┴─────────┴─────────┘ 
 
⍝∇ inslink remlink path span stpath foldl

Back to: code

Back to: Workspaces