diff --git a/lib/apl/runtime.sx b/lib/apl/runtime.sx index 8d26c5a9..19db9f8d 100644 --- a/lib/apl/runtime.sx +++ b/lib/apl/runtime.sx @@ -1016,3 +1016,45 @@ (fn (y) (disclose (f (apl-scalar x) (apl-scalar y)))) b-ravel)) a-ravel)))))) + +(define + apl-inner + (fn + (f g a b) + (let + ((a-shape (get a :shape)) + (b-shape (get b :shape)) + (a-ravel (get a :ravel)) + (b-ravel (get b :ravel))) + (let + ((a-rank (len a-shape)) (b-rank (len b-shape))) + (if + (and (= a-rank 0) (= b-rank 0)) + (apl-scalar (disclose (g a b))) + (let + ((inner-dim (last a-shape)) + (a-pre (take a-shape (- a-rank 1))) + (b-post (rest b-shape))) + (let + ((a-pre-size (reduce * 1 a-pre)) + (b-post-size (reduce * 1 b-post)) + (new-shape (append a-pre b-post))) + (make-array + new-shape + (flatten + (map + (fn + (i) + (map + (fn + (j) + (let + ((pairs (map (fn (k) (disclose (g (apl-scalar (nth a-ravel (+ (* i inner-dim) k))) (apl-scalar (nth b-ravel (+ (* k b-post-size) j)))))) (range 0 inner-dim)))) + (reduce + (fn + (x y) + (disclose (f (apl-scalar x) (apl-scalar y)))) + (first pairs) + (rest pairs)))) + (range 0 b-post-size))) + (range 0 a-pre-size))))))))))) diff --git a/lib/apl/tests/operators.sx b/lib/apl/tests/operators.sx index fbe07e1a..2e507811 100644 --- a/lib/apl/tests/operators.sx +++ b/lib/apl/tests/operators.sx @@ -335,4 +335,124 @@ apl-add (make-array (list 2 2) (list 1 2 3 4)) (make-array (list 3) (list 10 20 30)))) - (list 11 21 31 12 22 32 13 23 33 14 24 34)) \ No newline at end of file + (list 11 21 31 12 22 32 13 23 33 14 24 34)) + +(apl-test + "inner +.× dot product" + (rv + (apl-inner + apl-add + apl-mul + (make-array (list 3) (list 1 2 3)) + (make-array (list 3) (list 4 5 6)))) + (list 32)) + +(apl-test + "inner +.× dot product shape is scalar" + (sh + (apl-inner + apl-add + apl-mul + (make-array (list 3) (list 1 2 3)) + (make-array (list 3) (list 4 5 6)))) + (list)) + +(apl-test + "inner +.× matrix multiply 2x3 * 3x2 shape" + (sh + (apl-inner + apl-add + apl-mul + (make-array (list 2 3) (list 1 2 3 4 5 6)) + (make-array (list 3 2) (list 7 8 9 10 11 12)))) + (list 2 2)) + +(apl-test + "inner +.× matrix multiply 2x3 * 3x2 values" + (rv + (apl-inner + apl-add + apl-mul + (make-array (list 2 3) (list 1 2 3 4 5 6)) + (make-array (list 3 2) (list 7 8 9 10 11 12)))) + (list 58 64 139 154)) + +(apl-test + "inner +.× identity matrix 2x2" + (rv + (apl-inner + apl-add + apl-mul + (make-array (list 2 2) (list 1 0 0 1)) + (make-array (list 2 2) (list 5 6 7 8)))) + (list 5 6 7 8)) + +(apl-test + "inner ∧.= equal vectors" + (rv + (apl-inner + apl-and + apl-eq + (make-array (list 3) (list 1 2 3)) + (make-array (list 3) (list 1 2 3)))) + (list 1)) + +(apl-test + "inner ∧.= unequal vectors" + (rv + (apl-inner + apl-and + apl-eq + (make-array (list 3) (list 1 2 3)) + (make-array (list 3) (list 1 9 3)))) + (list 0)) + +(apl-test + "inner +.× matrix * vector shape" + (sh + (apl-inner + apl-add + apl-mul + (make-array (list 2 3) (list 1 2 3 4 5 6)) + (make-array (list 3) (list 7 8 9)))) + (list 2)) + +(apl-test + "inner +.× matrix * vector values" + (rv + (apl-inner + apl-add + apl-mul + (make-array (list 2 3) (list 1 2 3 4 5 6)) + (make-array (list 3) (list 7 8 9)))) + (list 50 122)) + +(apl-test + "inner +.× vector * matrix shape" + (sh + (apl-inner + apl-add + apl-mul + (make-array (list 3) (list 1 2 3)) + (make-array (list 3 2) (list 4 5 6 7 8 9)))) + (list 2)) + +(apl-test + "inner +.× vector * matrix values" + (rv + (apl-inner + apl-add + apl-mul + (make-array (list 3) (list 1 2 3)) + (make-array (list 3 2) (list 4 5 6 7 8 9)))) + (list 40 46)) + +(apl-test + "inner +.× single-element vectors" + (rv + (apl-inner + apl-add + apl-mul + (make-array (list 1) (list 6)) + (make-array (list 1) (list 7)))) + (list 42)) \ No newline at end of file diff --git a/plans/apl-on-sx.md b/plans/apl-on-sx.md index 291be996..08e68318 100644 --- a/plans/apl-on-sx.md +++ b/plans/apl-on-sx.md @@ -77,7 +77,7 @@ Core mapping: - [x] Scan `f\`, `f⍀` - [x] Each `f¨` — applies `f` to each scalar/element - [x] Outer product `∘.f` — `1 2 3 ∘.× 1 2 3` ↦ multiplication table -- [ ] Inner product `f.g` — `+.×` is matrix multiply +- [x] Inner product `f.g` — `+.×` is matrix multiply - [ ] Commute `f⍨` — `f⍨ x` ↔ `x f x`, `x f⍨ y` ↔ `y f x` - [ ] Compose `f∘g` — applies `g` first then `f` - [ ] Power `f⍣n` — apply f n times; `f⍣≡` until fixed point @@ -118,6 +118,7 @@ data; format for string templating. _Newest first._ +- 2026-05-06: Phase 4 step 5 — inner product f.g (apl-inner); +.× matrix multiply, ∧.= equal-vectors; 163/163 tests - 2026-05-06: Phase 4 step 4 — outer product ∘.f (apl-outer); rank-doubling result shape = a-shape++b-shape; 151/151 tests - 2026-05-06: Phase 4 step 3 — each f¨ (monadic apl-each + dyadic apl-each-dyadic); scalar broadcast both sides; 139/139 tests - 2026-05-06: Phase 4 step 2 — scan f\ (last axis) + f⍀ (first axis); apl-scan/apl-scan-first; 125/125 tests