APL/D Source Code:
────────────────────────────────────────────────────────────────────────────────
trip←{⎕IO ⎕ML←1 0 ⍝ Trip from/to ⍵ in network space ⍺.
0=⍺.⎕NC'graph':⍺{ ⍝ source not compiled for this space.
⎕←'compiling graph ...' ⍝ explain slight delay.
(compile ⍺)trip ⍵ ⍝ try again with compiled graph.
}⍵
access←⍺.((1=≡¨labels)/labels) ⍝ access via station entrances.
legs←{ ⍝ start and end station indices.
hits←∨/⍵⍷↑access ⍝ stations containing supplied string.
best←1+⊃⍋↑⍴¨hits/access ⍝ best (tightest) fit.
best⊃0,hits/⍳⍴hits ⍝ index of chosen station.
}¨⍵ ⍝ for each leg of the journey.
0∊legs:'Can''t find: ',↑{ ⍝ misspelled station name:
⍺,' or ',⍵ ⍝ (one or more stations)
}/(0=legs)/⍵ ⍝ give up :-(
find←⍺.graph{⍺⍺ path ⍺ ⍵} ⍝ find one leg of the route.
route←↑{⍺,1↓⍵}/2 find/legs ⍝ suggested route via all points.
labels←⍺.labels[route] ⍝ labels for all legs of route.
masks←1 2=⊂≡¨labels ⍝ masks of stations and stops.
stats stops←masks/¨⊂labels ⍝ station and stop labels.
zip←{↓⍉↑⍵} ⍝ transpose vector-of-vectors.
cat←{↑,/⍵} ⍝ concatenate .. ..
pad←{↓↑⍵} ⍝ pad vectors with blanks.
slabs←cat¨zip pad¨zip stops ⍝ aligned stop labels.
↑(stats,slabs)[⍋⍋2⊃masks] ⍝ merged stations and stops.
}
────────────────────────────────────────────────────────────────────────────────
compile←{⎕IO ⎕ML←1 0 ⍝ Compile graph from ⍵.source.
zip←{↓⍉↑⍵} ⋄ cat←{↑,/⍵} ⍝ transpose/concatenate vec-of-vecs.
lines stats ctrls←zip zip¨{ ⍝ first pass: source → line sections.
vecs←{↓⎕FMT↑⍵} ⍝ normalise source to vector-of-vectors.
rcom←{(∧\~'//'⍷⍵)/⍵} ⍝ remove comments '// ···' from line.
rbls←{(∨/¨' '≠⍵)/⍵} ⍝ remove blanks lines: '' '' ···
segt←{(' '≠⊃¨⍵)⊂⍵} ⍝ segment at non-blank first column.
trim←{(∨\⍵≠' ')/⍵}{⌽⍺⍺⌽⍺⍺ ⍵} ⍝ remove blanks, fore and aft.
tupl←'+↓∊'{⍺(trim ⍵~⍺⍺)(⍺⍺∩⍵)} ⍝ tupl: (line stat ctrl).
tups←{(⊂trim⊃⍵)tupl¨1↓⍵} ⍝ tuples: tupl tupl ···.
tups¨segt rbls rcom¨vecs ⍵ ⍝ line segments.
}⍵.source
seqs←{(⍳¨⍵)+0,+\¯1↓⍵} ⍝ sequence of sequences.
csids←{⍵\¨seqs+/¨⍵}'+'∊¨¨ctrls ⍝ stations marked as cross-tracks.
stops←zip¨zip lines stats csids ⍝ subway stops.
plats←{↓⍵∘.,'^∨'}¨stops ⍝ platform for each direction.
slist←{⍵[⍋↑⍵]}∪cat stats ⍝ sorted station list.
verts←slist,∪cat cat plats ⍝ graph vertices.
platx←{↓verts⍳↑⍵}¨plats ⍝ platform indices within graph.
statx←{2/¨verts⍳⍵}¨stats ⍝ station indices within graph.
linex←{(∪⍵)⍳⍵}⊃¨lines ⍝ line indices per segment.
rests←'↓∊'∘∊¨¨ctrls ⍝ restrictions: 1-way sects and forks.
plinks←cat¨2{ ⍝ platform-to-platform links / section.
links((ow fk)_)←zip ⍺ ⍵ ⍝ directions and restrictions.
rev←{⌽⍵}\ ⍝ reverse second pair.
oway←{⍺:1↑⍵ ⋄ rev ⍵} ⍝ one-way section.
fork←{⍺:⌽zip rev ⍵ ⋄ zip ⍵} ⍝ fork.
ow oway fk fork links ⍝ ⍺←→⍵ links.
}/¨zip¨zip platx rests ⍝ pairwise for each line section.
clinks←((∪linex)=⊂linex)/¨⊂plinks ⍝ link sections collected by line.
llinks←cat↑{ ⍝ connected sections for all lines.
next←⍺~⍵ ⍝ next section, duplicates removed.
clash←↑∪zip∩⌿↑zip¨next ⍵ ⍝ incompatible directions.
diffs←⍉¯1 1∘.×-/clash ⍝ vertex index differences.
avecs←↑+/,diffs×clash=⊂next ⍝ adjustment vectors.
(next+avecs),⍵ ⍝ connected line subsections.
}/¨clinks ⍝ for each section of each line.
slinks←cat zip¨zip cat¨statx platx ⍝ (stat plat) ··· links.
elinks←0 1∘.⌽slinks ⍝ station-platform each-way links.
nlinks←{⍵[⍋↑⍵]}∪(,elinks),llinks ⍝ combined network-wide links.
⍵.graph←↑{(⍺≠¯1⌽⍺)⊂⍵}/zip nlinks ⍝ network graph.
stags←2/⌽¨2↑¨∪cat stops ⍝ (stop line) label pairs.
slabs←cat¨zip¨zip(⊂4 1↑¨⊂'')stags ⍝ indented stop labels.
⍵.labels←slist,slabs ⍝ station/stop labels.
1:shy←⍵ ⍝ shy result: namespace ref.
}
────────────────────────────────────────────────────────────────────────────────
path←{ ⍝ Shortest path from/to ⍵ in graph ⍺.
graph←⍺ ⍝ ⍺ is graph vector.
fm to←⍵ ⍝ starting and target vertex(ices).
tree←¯2+(⍳⍴⍺)∊fm ⍝ initial spanning tree.
free←{(¯2=tree[⍵])/⍵} ⍝ free vertices in ⍵.
⍬{ ⍝ path accumulator.
⍵<0:(⍵=¯2)↓⍺ ⍝ root or unvisited vertex: finished.
(⍵,⍺)∇ ⍵⊃tree ⍝ otherwise: prefix previous (parent) vertex.
}{ ⍝ find partial spanning tree:
⍵≡⍬:¯1 ⍝ no vertices left: stitched.
1∊to∊⍵:1↑⍵∩to ⍝ found target: finished.
next←free¨graph[⍵] ⍝ next vertices to visit.
back←↑,/⍵+0×next ⍝ back links.
wave←↑,/next ⍝ vertex wave front.
tree[wave]←back ⍝ set back links in tree.
∇∪wave ⍝ advance wave front.
}fm ⍝ from starting vertex.
}
────────────────────────────────────────────────────────────────────────────────
ed←{ ⍝ Edit source for subway ⍵.
_←'→'⍵.⎕ED'source' ⍝ edit source.
_←⍵.⎕EX'graph' ⍝ force recompilation by removing: graph,
_←⍵.⎕EX'labels' ⍝ and vertex labels.
}
────────────────────────────────────────────────────────────────────────────────
test←{ ⍝ Run test script: no news => good news.
⍺←0 ⍝ default: don't show progress.
⍵≡'':⍺ ∇ ⎕NL 2 ⍝ null: test all scripts.
2=⍴⍴⍵:⍺ ∇↓⍵ ⍝ matrix: each row is a script.
2=≡⍵:⍺ ∇¨⍵ ⍝ nested: test each script.
tag scr←{ ⍝ name and content of script.
⎕PATH←'' ⍝ isolate test.
6::{'' ''}⎕←'No test.',⍵ ⍝ value error:: display message.
⍵(⍎⍵) ⍝ name and content.
}⍵
exec←{⎕ML←0 ⍝ execute script lines in tmp space.
0=⍴⍵:⍺ ⍝ no more, finished.
⎕←show⊃⍵ ⍝ show expression.
exp←unc⊃⍵ ⍝ uncommented first line.
''≡exp~' ':⍺ ∇ 1↓⍵ ⍝ ignore blank line.
1∊'←{'⍷unq exp:⍺ ∇ dfn ⍵ ⍝ make local dfn.
'←'∊unq exp:⍺ ∇ asgn ⍵ ⍝ make local var.
act←tmp{6::0 0⍴'' ⋄ ⍺⍎⍵}exp ⍝ actual result.
⎕←show act ⍝ show result.
ok rem←act check 1↓⍵ ⍝ check against expected result.
(⍺∧ok)∇ rem ⍝ check remaining script.
}
check←{⎕ML←0
act←↓tmp.⎕FMT ⍺ ⍝ actual result,
exp←(⍴act)↑⍵ ⍝ expected result,
act≡exp:1,⊂(⍴act)↓⍵ ⍝ match: continue.
dexp dact←dots¨exp act ⍝ dots for spaces in,
⎕←tag,⊂dexp'→'dact ⍝ display of differences.
0,⊂(⍴act)↓⍵ ⍝ and continue.
}
dfn←{ ⍝ fix temp dfn.
raw←unq∘unc¨⍵ ⍝ raw code
depth←+\{⊃⌽-⌿+\'{}'∘.=⍵}¨raw ⍝ {}-nesting depth per line.
lines←1++/∧\×depth ⍝ no of lines in defn.
_←tmp.⎕FX↑lines↑⍵ ⍝ fix dfn in temp space.
⎕←show↑1↓lines↑⍵ ⍝ show dfn body.
lines↓⍵ ⍝ continue with remaining lines.
}
nest←{⎕ML←0 ⍝ split line vector,
nl←⊃2↓⎕TC ⍝ at nl char into,
1↓¨(1,⍵=nl)⊂nl,⍵ ⍝ vector of char vecs.
}
dots←{⎕IO←0 ⍝ replace ' ' with '·' in diff display.
sx←⎕AV⍳' ' ⍝ index of space.
to←(sx↑⎕AV),'·',1↓sx↓⎕AV ⍝ [·/ ]⎕av
↑{(⎕AV⍳⍵)⊃¨⊂to}¨⍵ ⍝ translated value.
}
asgn←{_←tmp⍎⊃⍵ ⋄ 1↓⍵} ⍝ assign local name.
unq←{(~≠\''''=⍵){⍺\⍺/⍵}⍵} ⍝ unquoted chars.
unc←{(∧\'⍝'≠unq ⍵)/⍵} ⍝ uncommented line.
show←⍺∘{↑⍺/↓⎕FMT ⍵} ⍝ show progress.
tmp←##.(⎕NS ⎕NL 3 4 9) ⍝ tmp space for evaluation.
''≡scr:ok←0 ⍝ bad script name.
2=≡⍵:ok←1 exec scr ⍝ vector of vectors: go ahead,
1:ok←1 exec nest scr ⍝ split line vector.
}
────────────────────────────────────────────────────────────────────────────────
Back to: contents