Files
rose-ash/lib/apl/tests/structural.sx
giles 7dfa092ed2
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
apl: Phase 3 grade-up ⍋ / grade-down ⍒ — 74/74 tests green
Add apl-grade (stable insertion sort helper), apl-grade-up, apl-grade-down.
Stability guaranteed via secondary sort key (original index). 8 new tests.

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
2026-05-06 19:02:49 +00:00

477 lines
11 KiB
Plaintext
Raw Blame History

This file contains ambiguous Unicode characters
This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
;; lib/apl/tests/structural.sx — Phase 3: structural primitives
;; Tests for: apl-reshape, apl-ravel, apl-transpose, apl-transpose-dyadic
;; Loaded after runtime.sx; shares apl-test / apl-test-pass / apl-test-fail.
(define rv (fn (arr) (get arr :ravel)))
(define sh (fn (arr) (get arr :shape)))
;; ---------------------------------------------------------------------------
;; 1. Ravel (monadic ,)
;; ---------------------------------------------------------------------------
(apl-test "ravel scalar" (rv (apl-ravel (apl-scalar 5))) (list 5))
(apl-test
"ravel vector"
(rv (apl-ravel (make-array (list 3) (list 1 2 3))))
(list 1 2 3))
(apl-test
"ravel matrix"
(rv (apl-ravel (make-array (list 2 3) (list 1 2 3 4 5 6))))
(list 1 2 3 4 5 6))
(apl-test
"ravel shape is rank-1"
(sh (apl-ravel (make-array (list 2 3) (list 1 2 3 4 5 6))))
(list 6))
;; ---------------------------------------------------------------------------
;; 2. Reshape (dyadic )
;; ---------------------------------------------------------------------------
(apl-test
"reshape 2x3 ravel"
(rv
(apl-reshape
(make-array (list 2) (list 2 3))
(make-array (list 6) (list 1 2 3 4 5 6))))
(list 1 2 3 4 5 6))
(apl-test
"reshape 2x3 shape"
(sh
(apl-reshape
(make-array (list 2) (list 2 3))
(make-array (list 6) (list 1 2 3 4 5 6))))
(list 2 3))
(apl-test
"reshape cycle 6 from 1 2"
(rv
(apl-reshape
(make-array (list 1) (list 6))
(make-array (list 2) (list 1 2))))
(list 1 2 1 2 1 2))
(apl-test
"reshape cycle 2x3 from 1 2"
(rv
(apl-reshape
(make-array (list 2) (list 2 3))
(make-array (list 2) (list 1 2))))
(list 1 2 1 2 1 2))
(apl-test
"reshape scalar fill"
(rv (apl-reshape (make-array (list 1) (list 4)) (apl-scalar 7)))
(list 7 7 7 7))
(apl-test
"reshape truncate"
(rv
(apl-reshape
(make-array (list 1) (list 3))
(make-array (list 6) (list 10 20 30 40 50 60))))
(list 10 20 30))
(apl-test
"reshape matrix to vector"
(sh
(apl-reshape
(make-array (list 1) (list 6))
(make-array (list 2 3) (list 1 2 3 4 5 6))))
(list 6))
(apl-test
"reshape 2x2x3"
(sh
(apl-reshape
(make-array (list 3) (list 2 2 3))
(make-array (list 12) (range 1 13))))
(list 2 2 3))
(apl-test
"reshape to empty"
(rv
(apl-reshape
(make-array (list 1) (list 0))
(make-array (list 3) (list 1 2 3))))
(list))
;; ---------------------------------------------------------------------------
;; 3. Monadic transpose (⍉)
;; ---------------------------------------------------------------------------
(apl-test
"transpose scalar shape"
(sh (apl-transpose (apl-scalar 99)))
(list))
(apl-test
"transpose scalar ravel"
(rv (apl-transpose (apl-scalar 99)))
(list 99))
(apl-test
"transpose vector shape"
(sh (apl-transpose (make-array (list 3) (list 3 1 4))))
(list 3))
(apl-test
"transpose vector ravel"
(rv (apl-transpose (make-array (list 3) (list 3 1 4))))
(list 3 1 4))
(apl-test
"transpose 2x3 shape"
(sh (apl-transpose (make-array (list 2 3) (list 1 2 3 4 5 6))))
(list 3 2))
(apl-test
"transpose 2x3 ravel"
(rv (apl-transpose (make-array (list 2 3) (list 1 2 3 4 5 6))))
(list 1 4 2 5 3 6))
(apl-test
"transpose 3x3"
(rv (apl-transpose (make-array (list 3 3) (list 1 2 3 4 5 6 7 8 9))))
(list 1 4 7 2 5 8 3 6 9))
(apl-test
"transpose 1x4 shape"
(sh (apl-transpose (make-array (list 1 4) (list 1 2 3 4))))
(list 4 1))
(apl-test
"transpose twice identity"
(rv
(apl-transpose
(apl-transpose (make-array (list 2 3) (list 1 2 3 4 5 6)))))
(list 1 2 3 4 5 6))
(apl-test
"transpose 3d shape"
(sh (apl-transpose (make-array (list 2 3 4) (range 0 24))))
(list 4 3 2))
;; ---------------------------------------------------------------------------
;; 4. Dyadic transpose (perm⍉arr)
;; ---------------------------------------------------------------------------
(apl-test
"dyadic-transpose identity"
(rv
(apl-transpose-dyadic
(make-array (list 2) (list 1 2))
(make-array (list 2 3) (list 1 2 3 4 5 6))))
(list 1 2 3 4 5 6))
(apl-test
"dyadic-transpose swap 2x3"
(rv
(apl-transpose-dyadic
(make-array (list 2) (list 2 1))
(make-array (list 2 3) (list 1 2 3 4 5 6))))
(list 1 4 2 5 3 6))
(apl-test
"dyadic-transpose swap shape"
(sh
(apl-transpose-dyadic
(make-array (list 2) (list 2 1))
(make-array (list 2 3) (list 1 2 3 4 5 6))))
(list 3 2))
(apl-test
"dyadic-transpose 3d shape"
(sh
(apl-transpose-dyadic
(make-array (list 3) (list 2 1 3))
(make-array (list 2 3 4) (range 0 24))))
(list 3 2 4))
(apl-test
"take 3 from front"
(rv (apl-take (apl-scalar 3) (make-array (list 5) (list 1 2 3 4 5))))
(list 1 2 3))
(apl-test
"take 0"
(rv (apl-take (apl-scalar 0) (make-array (list 5) (list 1 2 3 4 5))))
(list))
(apl-test
"take -2 from back"
(rv (apl-take (apl-scalar -2) (make-array (list 5) (list 1 2 3 4 5))))
(list 4 5))
(apl-test
"take over-take pads with 0"
(rv (apl-take (apl-scalar 7) (make-array (list 5) (list 1 2 3 4 5))))
(list 1 2 3 4 5 0 0))
(apl-test
"take matrix 1 row 2 cols shape"
(sh
(apl-take
(make-array (list 2) (list 1 2))
(make-array (list 2 3) (list 1 2 3 4 5 6))))
(list 1 2))
(apl-test
"take matrix 1 row 2 cols ravel"
(rv
(apl-take
(make-array (list 2) (list 1 2))
(make-array (list 2 3) (list 1 2 3 4 5 6))))
(list 1 2))
(apl-test
"take matrix negative row"
(rv
(apl-take
(make-array (list 2) (list -1 3))
(make-array (list 2 3) (list 1 2 3 4 5 6))))
(list 4 5 6))
(apl-test
"drop 2 from front"
(rv (apl-drop (apl-scalar 2) (make-array (list 5) (list 1 2 3 4 5))))
(list 3 4 5))
(apl-test
"drop -2 from back"
(rv (apl-drop (apl-scalar -2) (make-array (list 5) (list 1 2 3 4 5))))
(list 1 2 3))
(apl-test
"drop all"
(rv (apl-drop (apl-scalar 5) (make-array (list 5) (list 1 2 3 4 5))))
(list))
(apl-test
"drop 0"
(rv (apl-drop (apl-scalar 0) (make-array (list 5) (list 1 2 3 4 5))))
(list 1 2 3 4 5))
(apl-test
"drop matrix 1 row shape"
(sh
(apl-drop
(make-array (list 2) (list 1 0))
(make-array (list 2 3) (list 1 2 3 4 5 6))))
(list 1 3))
(apl-test
"drop matrix 1 row ravel"
(rv
(apl-drop
(make-array (list 2) (list 1 0))
(make-array (list 2 3) (list 1 2 3 4 5 6))))
(list 4 5 6))
(apl-test
"reverse vector"
(rv (apl-reverse (make-array (list 5) (list 1 2 3 4 5))))
(list 5 4 3 2 1))
(apl-test
"reverse scalar identity"
(rv (apl-reverse (apl-scalar 42)))
(list 42))
(apl-test
"reverse matrix last axis"
(rv (apl-reverse (make-array (list 2 3) (list 1 2 3 4 5 6))))
(list 3 2 1 6 5 4))
(apl-test
"reverse-first matrix"
(rv (apl-reverse-first (make-array (list 2 3) (list 1 2 3 4 5 6))))
(list 4 5 6 1 2 3))
(apl-test
"reverse-first vector identity"
(rv (apl-reverse-first (make-array (list 4) (list 1 2 3 4))))
(list 4 3 2 1))
(apl-test
"rotate vector left by 2"
(rv (apl-rotate (apl-scalar 2) (make-array (list 5) (list 1 2 3 4 5))))
(list 3 4 5 1 2))
(apl-test
"rotate vector right by 1 (negative)"
(rv (apl-rotate (apl-scalar -1) (make-array (list 5) (list 1 2 3 4 5))))
(list 5 1 2 3 4))
(apl-test
"rotate by 0 is identity"
(rv (apl-rotate (apl-scalar 0) (make-array (list 5) (list 1 2 3 4 5))))
(list 1 2 3 4 5))
(apl-test
"rotate matrix last axis"
(rv
(apl-rotate (apl-scalar 1) (make-array (list 2 3) (list 1 2 3 4 5 6))))
(list 2 3 1 5 6 4))
(apl-test
"rotate-first matrix"
(rv
(apl-rotate-first
(apl-scalar 1)
(make-array (list 2 3) (list 1 2 3 4 5 6))))
(list 4 5 6 1 2 3))
(apl-test
"cat v,v ravel"
(rv
(apl-catenate
(make-array (list 3) (list 1 2 3))
(make-array (list 2) (list 4 5))))
(list 1 2 3 4 5))
(apl-test
"cat v,v shape"
(sh
(apl-catenate
(make-array (list 3) (list 1 2 3))
(make-array (list 2) (list 4 5))))
(list 5))
(apl-test
"cat scalar,v"
(rv (apl-catenate (apl-scalar 99) (make-array (list 3) (list 1 2 3))))
(list 99 1 2 3))
(apl-test
"cat v,scalar"
(rv (apl-catenate (make-array (list 3) (list 1 2 3)) (apl-scalar 99)))
(list 1 2 3 99))
(apl-test
"cat matrix last-axis shape"
(sh
(apl-catenate
(make-array (list 2 3) (list 1 2 3 4 5 6))
(make-array (list 2 2) (list 7 8 9 10))))
(list 2 5))
(apl-test
"cat matrix last-axis ravel"
(rv
(apl-catenate
(make-array (list 2 3) (list 1 2 3 4 5 6))
(make-array (list 2 2) (list 7 8 9 10))))
(list 1 2 3 7 8 4 5 6 9 10))
(apl-test
"cat-first v,v shape"
(sh
(apl-catenate-first
(make-array (list 3) (list 1 2 3))
(make-array (list 2) (list 4 5))))
(list 5))
(apl-test
"cat-first matrix shape"
(sh
(apl-catenate-first
(make-array (list 2 3) (list 1 2 3 4 5 6))
(make-array (list 3 3) (list 11 12 13 14 15 16 17 18 19))))
(list 5 3))
(apl-test
"cat-first matrix ravel"
(rv
(apl-catenate-first
(make-array (list 2 3) (list 1 2 3 4 5 6))
(make-array (list 3 3) (list 11 12 13 14 15 16 17 18 19))))
(list 1 2 3 4 5 6 11 12 13 14 15 16 17 18 19))
(apl-test
"squad scalar into vector"
(rv
(apl-squad (apl-scalar 2) (make-array (list 5) (list 10 20 30 40 50))))
(list 20))
(apl-test
"squad first element"
(rv (apl-squad (apl-scalar 1) (make-array (list 3) (list 10 20 30))))
(list 10))
(apl-test
"squad last element"
(rv
(apl-squad (apl-scalar 5) (make-array (list 5) (list 10 20 30 40 50))))
(list 50))
(apl-test
"squad fully specified matrix element"
(rv
(apl-squad
(make-array (list 2) (list 2 3))
(make-array (list 3 4) (list 1 2 3 4 5 6 7 8 9 10 11 12))))
(list 7))
(apl-test
"squad partial row of matrix shape"
(sh
(apl-squad
(apl-scalar 2)
(make-array (list 3 4) (list 1 2 3 4 5 6 7 8 9 10 11 12))))
(list 4))
(apl-test
"squad partial row of matrix ravel"
(rv
(apl-squad
(apl-scalar 2)
(make-array (list 3 4) (list 1 2 3 4 5 6 7 8 9 10 11 12))))
(list 5 6 7 8))
(apl-test
"squad partial 3d slice shape"
(sh (apl-squad (apl-scalar 1) (make-array (list 2 3 4) (range 1 25))))
(list 3 4))
(apl-test
"grade-up basic"
(rv (apl-grade-up (make-array (list 5) (list 3 1 4 1 5))))
(list 2 4 1 3 5))
(apl-test
"grade-up shape"
(sh (apl-grade-up (make-array (list 4) (list 4 1 3 2))))
(list 4))
(apl-test
"grade-up no duplicates"
(rv (apl-grade-up (make-array (list 4) (list 4 1 3 2))))
(list 2 4 3 1))
(apl-test
"grade-up already sorted"
(rv (apl-grade-up (make-array (list 3) (list 1 2 3))))
(list 1 2 3))
(apl-test
"grade-up reverse sorted"
(rv (apl-grade-up (make-array (list 3) (list 3 2 1))))
(list 3 2 1))
(apl-test
"grade-down basic"
(rv (apl-grade-down (make-array (list 5) (list 3 1 4 1 5))))
(list 5 3 1 2 4))
(apl-test
"grade-down no duplicates"
(rv (apl-grade-down (make-array (list 4) (list 4 1 3 2))))
(list 1 3 4 2))
(apl-test
"grade-up single element"
(rv (apl-grade-up (make-array (list 1) (list 42))))
(list 1))