diff --git a/lib/apl/runtime.sx b/lib/apl/runtime.sx index 43addb91..4b93ebfb 100644 --- a/lib/apl/runtime.sx +++ b/lib/apl/runtime.sx @@ -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)))))))) diff --git a/lib/apl/test.sh b/lib/apl/test.sh index a8a967c0..5d546d1a 100755 --- a/lib/apl/test.sh +++ b/lib/apl/test.sh @@ -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" diff --git a/lib/apl/tests/structural.sx b/lib/apl/tests/structural.sx new file mode 100644 index 00000000..10cb18e2 --- /dev/null +++ b/lib/apl/tests/structural.sx @@ -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)) \ No newline at end of file