From 9eecbde61e9c7d7f2f16c404f1d59451656f208f Mon Sep 17 00:00:00 2001
From: giles <giles.bradshaw@rose-ash.com>
Date: Thu, 7 May 2026 00:00:14 +0000
Subject: [PATCH] =?UTF-8?q?apl:=20rank=20f=E2=8D=A4k=20cell=20decompositio?=
 =?UTF-8?q?n=20(+10=20tests,=20201/201)?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 lib/apl/runtime.sx         | 25 ++++++++++++++++
 lib/apl/tests/operators.sx | 60 +++++++++++++++++++++++++++++++++++++-
 plans/apl-on-sx.md         |  3 +-
 3 files changed, 86 insertions(+), 2 deletions(-)

diff --git a/lib/apl/runtime.sx b/lib/apl/runtime.sx
index 9f0d9028..7f6ba879 100644
--- a/lib/apl/runtime.sx
+++ b/lib/apl/runtime.sx
@@ -1083,3 +1083,28 @@
           (equal? (get next :ravel) (get x :ravel)))
         x
         (apl-power-fixed f next)))))
+
+(define
+  apl-rank
+  (fn
+    (f k arr)
+    (let
+      ((shape (get arr :shape)) (ravel (get arr :ravel)))
+      (let
+        ((rank (len shape)))
+        (if
+          (>= k rank)
+          (f arr)
+          (let
+            ((frame-shape (take shape (- rank k)))
+              (cell-shape (drop shape (- rank k))))
+            (let
+              ((frame-size (reduce * 1 frame-shape))
+                (cell-size (reduce * 1 cell-shape)))
+              (let
+                ((cells (map (fn (i) (let ((start (* i cell-size))) (make-array cell-shape (map (fn (j) (nth ravel (+ start j))) (range 0 cell-size))))) (range 0 frame-size))))
+                (let
+                  ((results (map (fn (c) (f c)) cells)))
+                  (make-array
+                    (append frame-shape (get (first results) :shape))
+                    (flatten (map (fn (r) (get r :ravel)) results))))))))))))
diff --git a/lib/apl/tests/operators.sx b/lib/apl/tests/operators.sx
index 532acf50..39115a70 100644
--- a/lib/apl/tests/operators.sx
+++ b/lib/apl/tests/operators.sx
@@ -640,4 +640,62 @@
   "power-fixed shape preserved"
   (sh
     (apl-power-fixed (fn (a) a) (make-array (list 2 2) (list 1 2 3 4))))
-  (list 2 2))
\ No newline at end of file
+  (list 2 2))
+
+(apl-test
+  "rank tally⍤1 row tallies"
+  (rv (apl-rank apl-tally 1 (make-array (list 2 3) (list 1 2 3 4 5 6))))
+  (list 3 3))
+
+(apl-test
+  "rank tally⍤1 row tallies shape"
+  (sh (apl-rank apl-tally 1 (make-array (list 2 3) (list 1 2 3 4 5 6))))
+  (list 2))
+
+(apl-test
+  "rank neg⍤0 vector scalar cells"
+  (rv (apl-rank apl-neg-m 0 (make-array (list 3) (list 1 2 3))))
+  (list -1 -2 -3))
+
+(apl-test
+  "rank neg⍤0 vector preserves shape"
+  (sh (apl-rank apl-neg-m 0 (make-array (list 3) (list 1 2 3))))
+  (list 3))
+
+(apl-test
+  "rank neg⍤1 matrix per-row"
+  (rv (apl-rank apl-neg-m 1 (make-array (list 2 3) (list 1 2 3 4 5 6))))
+  (list -1 -2 -3 -4 -5 -6))
+
+(apl-test
+  "rank neg⍤1 matrix preserves shape"
+  (sh (apl-rank apl-neg-m 1 (make-array (list 2 3) (list 1 2 3 4 5 6))))
+  (list 2 3))
+
+(apl-test
+  "rank k>=rank fallthrough"
+  (rv (apl-rank apl-tally 5 (make-array (list 4) (list 1 2 3 4))))
+  (list 4))
+
+(apl-test
+  "rank tally⍤2 whole matrix tally"
+  (rv
+    (apl-rank
+      apl-tally
+      2
+      (make-array (list 3 5) (list 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15))))
+  (list 3))
+
+(apl-test
+  "rank reverse⍤1 matrix reverse rows"
+  (rv (apl-rank apl-reverse 1 (make-array (list 2 3) (list 1 2 3 4 5 6))))
+  (list 3 2 1 6 5 4))
+
+(apl-test
+  "rank tally⍤1 3x4 row tallies"
+  (rv
+    (apl-rank
+      apl-tally
+      1
+      (make-array (list 3 4) (list 1 2 3 4 5 6 7 8 9 10 11 12))))
+  (list 4 4 4))
\ No newline at end of file
diff --git a/plans/apl-on-sx.md b/plans/apl-on-sx.md
index 8b218fd0..e22d3695 100644
--- a/plans/apl-on-sx.md
+++ b/plans/apl-on-sx.md
@@ -81,7 +81,7 @@ Core mapping:
 - [x] Commute `f⍨` — `f⍨ x` ↔ `x f x`, `x f⍨ y` ↔ `y f x`
 - [x] Compose `f∘g` — applies `g` first then `f`
 - [x] Power `f⍣n` — apply f n times; `f⍣≡` until fixed point
-- [ ] Rank `f⍤k` — apply f at sub-rank k
+- [x] Rank `f⍤k` — apply f at sub-rank k
 - [ ] At `@` — selective replace
 - [ ] 40+ tests in `lib/apl/tests/operators.sx`
 
@@ -118,6 +118,7 @@ data; format for string templating.
 
 _Newest first._
 
+- 2026-05-07: Phase 4 step 9 — rank f⍤k (apl-rank); cell decomposition + reassembly via frame/cell shapes; 201/201 tests
 - 2026-05-06: Phase 4 step 8 — power f⍣n (apl-power) + fixed-point f⍣≡ (apl-power-fixed); 191/191 tests
 - 2026-05-06: Phase 4 step 7 — compose f∘g (apl-compose monadic f∘g x, apl-compose-dyadic dyadic f x (g y)); 182/182 tests
 - 2026-05-06: Phase 4 step 6 — commute f⍨ (apl-commute monadic dup, apl-commute-dyadic swap); 173/173 tests