coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

apl: inner product f.g (+12 tests, 163/163)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 58s
Details

Browse Source
This commit is contained in:
giles
2026-05-06 22:09:13 +00:00
parent 4332b4032f
commit d67e04a9ad
3 changed files with 165 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files

42
lib/apl/runtime.sx
View File

@@ -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)))))))))))

122
lib/apl/tests/operators.sx
View File

@@ -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))
(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))