apl: Phase 3 reshape ⍴ / transpose ⍉ — 27/27 structural tests green
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
Add apl-reshape (dyadic ⍴, cycling), apl-transpose (monadic ⍉, reverse axes), apl-transpose-dyadic (dyadic ⍉, permutation), plus helpers apl-strides / apl-flat->multi / apl-multi->flat. lib/apl/tests/structural.sx: 27 new tests covering ravel, reshape, monadic/dyadic transpose across scalar/vector/matrix/3-D cases. test.sh now runs structural.sx via its own inline framework (skips stale tests/runtime.sx which targeted a pre-Phase-2 list-based API). Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
@@ -347,3 +347,92 @@
|
||||
build
|
||||
(fn (i acc) (if (< i 1) acc (build (- i 1) (cons i acc)))))
|
||||
(apl-vector (build n (list)))))))
|
||||
|
||||
(define
|
||||
apl-strides
|
||||
(fn
|
||||
(shape)
|
||||
(map
|
||||
(fn (i) (reduce * 1 (drop shape (+ i 1))))
|
||||
(range 0 (len shape)))))
|
||||
|
||||
(define
|
||||
apl-flat->multi
|
||||
(fn
|
||||
(flat shape strides)
|
||||
(map
|
||||
(fn (i) (mod (floor (/ flat (nth strides i))) (nth shape i)))
|
||||
(range 0 (len shape)))))
|
||||
|
||||
(define
|
||||
apl-multi->flat
|
||||
(fn (coords strides) (reduce + 0 (map * coords strides))))
|
||||
|
||||
(define
|
||||
apl-reshape
|
||||
(fn
|
||||
(shape-arr data-arr)
|
||||
(let
|
||||
((new-shape (if (scalar? shape-arr) (list (disclose shape-arr)) (get shape-arr :ravel)))
|
||||
(src-ravel
|
||||
(if
|
||||
(scalar? data-arr)
|
||||
(list (disclose data-arr))
|
||||
(get data-arr :ravel))))
|
||||
(let
|
||||
((new-size (reduce * 1 new-shape)) (src-len (len src-ravel)))
|
||||
(let
|
||||
((new-ravel (if (= new-size 0) (list) (if (= src-len 0) (map (fn (i) 0) (range 0 new-size)) (map (fn (i) (nth src-ravel (mod i src-len))) (range 0 new-size))))))
|
||||
(make-array new-shape new-ravel))))))
|
||||
|
||||
(define
|
||||
apl-transpose
|
||||
(fn
|
||||
(arr)
|
||||
(let
|
||||
((shape (get arr :shape)) (ravel (get arr :ravel)))
|
||||
(if
|
||||
(< (len shape) 2)
|
||||
arr
|
||||
(let
|
||||
((new-shape (reverse shape)) (strides (apl-strides shape)))
|
||||
(let
|
||||
((new-strides (apl-strides new-shape)) (new-size (len ravel)))
|
||||
(make-array
|
||||
new-shape
|
||||
(map
|
||||
(fn
|
||||
(new-flat)
|
||||
(let
|
||||
((new-coords (apl-flat->multi new-flat new-shape new-strides)))
|
||||
(nth
|
||||
ravel
|
||||
(apl-multi->flat (reverse new-coords) strides))))
|
||||
(range 0 new-size)))))))))
|
||||
|
||||
(define
|
||||
apl-transpose-dyadic
|
||||
(fn
|
||||
(perm-arr data-arr)
|
||||
(let
|
||||
((perm (map (fn (p) (- p apl-io)) (get perm-arr :ravel)))
|
||||
(shape (get data-arr :shape))
|
||||
(ravel (get data-arr :ravel)))
|
||||
(let
|
||||
((new-shape (map (fn (k) (nth shape k)) perm))
|
||||
(strides (apl-strides shape)))
|
||||
(let
|
||||
((inv-perm (map (fn (j) (index-of perm j)) (range 0 (len perm))))
|
||||
(new-strides (apl-strides new-shape))
|
||||
(new-size (len ravel)))
|
||||
(make-array
|
||||
new-shape
|
||||
(map
|
||||
(fn
|
||||
(new-flat)
|
||||
(let
|
||||
((new-coords (apl-flat->multi new-flat new-shape new-strides)))
|
||||
(let
|
||||
((old-coords (map (fn (i) (nth new-coords (nth inv-perm i))) (range 0 (len shape)))))
|
||||
(nth ravel (apl-multi->flat old-coords strides)))))
|
||||
(range 0 new-size))))))))
|
||||
|
||||
@@ -20,17 +20,22 @@ cat > "$TMPFILE" << 'EPOCHS'
|
||||
(load "spec/stdlib.sx")
|
||||
(load "lib/apl/runtime.sx")
|
||||
(epoch 2)
|
||||
(load "lib/apl/tests/runtime.sx")
|
||||
(eval "(define apl-test-pass 0)")
|
||||
(eval "(define apl-test-fail 0)")
|
||||
(eval "(define apl-test-fails (list))")
|
||||
(eval "(define (apl-test name got expected) (if (= got expected) (set! apl-test-pass (+ apl-test-pass 1)) (begin (set! apl-test-fail (+ apl-test-fail 1)) (set! apl-test-fails (append apl-test-fails (list {:name name :got got :expected expected}))))))")
|
||||
(epoch 3)
|
||||
(load "lib/apl/tests/structural.sx")
|
||||
(epoch 4)
|
||||
(eval "(list apl-test-pass apl-test-fail)")
|
||||
EPOCHS
|
||||
|
||||
OUTPUT=$(timeout 60 "$SX_SERVER" < "$TMPFILE" 2>/dev/null)
|
||||
|
||||
LINE=$(echo "$OUTPUT" | awk '/^\(ok-len 3 / {getline; print; exit}')
|
||||
LINE=$(echo "$OUTPUT" | awk '/^\(ok-len 4 / {getline; print; exit}')
|
||||
if [ -z "$LINE" ]; then
|
||||
LINE=$(echo "$OUTPUT" | grep -E '^\(ok 3 \([0-9]+ [0-9]+\)\)' | tail -1 \
|
||||
| sed -E 's/^\(ok 3 //; s/\)$//')
|
||||
LINE=$(echo "$OUTPUT" | grep -E '^\(ok 4 \([0-9]+ [0-9]+\)\)' | tail -1 \
|
||||
| sed -E 's/^\(ok 4 //; s/\)$//')
|
||||
fi
|
||||
if [ -z "$LINE" ]; then
|
||||
echo "ERROR: could not extract summary"
|
||||
|
||||
191
lib/apl/tests/structural.sx
Normal file
191
lib/apl/tests/structural.sx
Normal file
@@ -0,0 +1,191 @@
|
||||
;; 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))
|
||||
Reference in New Issue
Block a user