Skip to content

Instantly share code, notes, and snippets.

@abrudz
Created December 7, 2017 15:30
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save abrudz/9b89c5bbe2bcf8e143f2d965bf7c5d73 to your computer and use it in GitHub Desktop.
Save abrudz/9b89c5bbe2bcf8e143f2d965bf7c5d73 to your computer and use it in GitHub Desktop.
Sorting and grading any Dyalog APL array.
Sort←{⎕ML←1 ⍝ Total array ordering (TAO) comparison.
acmp←{ ⍝ array comparison.
≡/⍵:¯1 ⍝ match: equal.
~≡/⍴∘⍴¨⍵:∇ xrnk ⍵ ⍝ ranks differ: reshape with 1-axes.
⊃⊃⍷/⍵:1 ⍝ prefixes precede their continuations.
⊃⊃⍷/⌽⍵:0 ⍝ continuations follow their prefixes.
~≡/⍴¨⍵:∇ xshp ⍵ ⍝ shapes differ: stretch with fills.
0=×/⍴⊃⍵:∇⊃¨⍵ ⍝ null: comparison of proto items.
~⍵≡⊃¨⍵:∇ halves,¨⍵ ⍝ non-atomic: item-wise comparison.
⍝ comparison of atomic items:
types←type¨⍵ ⍝ item types: char, number, ...
≠/types:≤/types ⍝ types differ: compare.
3∧.=types:∇ fixor¨⍵ ⍝ ⎕ORs: comparison of fixed items.
1∧.=types:ncmp ⍵ ⍝ simple numbs: comparison.
0∧.=types:≤/⍋⍵ ⍝ simple chars: ⍋-style comparison.
⍝ comparison of refs:
≢/ot←⍵.⎕WG⊂'Type':∇ ot ⍝ object-type mismatch: order on types
∧/⍵∊¨⍺⍺:∇ ⍺⍺⍳¨⍺⍺ ⍝ cycles in both: cycle lengths (NN).
unms←⍵.(~∘' '¨↓⎕NL⍳10) ⍝ user-supplied names.
ucls←⍵.⎕NC↑¨unms ⍝ and their name-classes.
uvls←⍵ valu¨¨unms ⍝ value of each symbol in each space.
ucmp←zip¨zip unms ucls uvls ⍝ name/class/value triples.
scmp←⍵.(⎕CT ⎕DIV ⎕IO ⎕ML ⎕PP ⎕RL ⎕RTL) ⍝ system variable values.
pcmp←⍵.(⎕WG¨⎕WG'PropList') ⍝ property values.
(⍺⍺∪¨⍵)∇∇ zip ucmp scmp pcmp ⍝ cmp of user-vals; sysvars; props.
}
xshp←{ ⍝ stretch arrays of differing shape.
shp←⊃⌈/⍴¨⍵ ⍝ new shape
pad←{⍵@(⍳⍴⍵)⊢⍺⍴0} ⍝ padding of ref-array(s)
16::zip(shp∘pad¨⍵)(⍴¨⍵) ⍝ nonce: can't over-take ref array <V>
new←shp∘↑¨⍵ ⍝ extended arrays.
zip new(⍴¨⍵) ⍝ (⍺ shp)(⍵ shp)
}
xrnk←{ ⍝ stretch arrays of differing rank.
rnk←⊃⌈/⍴∘⍴¨⍵ ⍝ new rank.
ones←rnk⍴1 ⍝ sufficient 1-padding.
shps←(-rnk)↑¨ones∘,∘⍴¨⍵ ⍝ new shapes.
ors←{1 ⍬≡(≡⍵)(⍴⍵)}¨⍵ ⍝ must enclose ⎕or for reshape.
new←shps⍴¨ors{(⊂⍣⍺)⍵}¨⍵ ⍝ extended arrays.
zip new(⍴∘⍴¨⍵) ⍝ (⍺ rnk)(⍵ rnk)
}
type←{ ⍝ types of depth-0 items:
1 0≡(≡⍵),⍴⍴⍵:3 ⍝ ⎕OR: 3
9=⎕NC'⍵':2 ⍝ ref: 2
0=⊃0⍴⍵ ⍝ num: 1, char: 0
}
ncmp←{ ⍝ comparison of numbers.
0>⊃(9 11○-/⍵)~0 ⍝ real part trumps imaginary part.
}
fixor←{ ⍝ fix of ⎕OR item in tmp space.
11::⎕NS ⍵ ⍝ ⎕OR of namespace.
⎕NR(⎕NS'').⎕FX ⍵ ⍝ ⎕OR of fn/op.
}
valu←{ ⍝ referent value of name ⍺.⍵.
⍵≡'':'' ⍝ ignore null name.
3 4∨.=⍺.⎕NC ⍵:⍺.⎕NR ⍵ ⍝ fn/op: nested rep.
⍺.⍎⍵ ⍝ var or ref: value.
}
zip←{↓⍉↑⍵} ⍝ items interleaved.
halves←{ ⍝ compare vector halves.
n←⌊(≢⊃⍵)÷2 ⍝ half-way point.
n=0:⍺⍺⊃¨⍵ ⍝ compare single items
¯1≠c←⍺⍺ n↑¨⍵:c ⍝ first halves differ: done.
⍺⍺ n↓¨⍵ ⍝ comparison of second halves.
}
|⍬ ⍬ acmp ⍺ ⍵ ⍝ ⍺≤⍵
}{ ⍝ quicksort.
1≥⍴⍵:⍵ ⍝ single item or null: done.
head tail←(1↑⍵)(1↓⍵) ⍝ first and remaining items.
le gt←1 0=⊂tail ⍺⍺¨head ⍝ comparison with first item.
(∇ le/tail),head,∇ gt/tail ⍝ sorted vector.
}
GradeUp←{|⊢/↑Sort ⍵{⍺ ⍵}¨⍳⍴⍵}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment