apl: Phase 3 grade-up ⍋ / grade-down ⍒ — 74/74 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-grade (stable insertion sort helper), apl-grade-up, apl-grade-down. Stability guaranteed via secondary sort key (original index). 8 new tests. Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
@@ -688,3 +688,47 @@
|
||||
(map
|
||||
(fn (j) (nth ravel (+ start j)))
|
||||
(range 0 slice-size)))))))))))
|
||||
|
||||
(define
|
||||
apl-grade
|
||||
(fn
|
||||
(arr ascending)
|
||||
(let
|
||||
((ravel (get arr :ravel)) (n (len (get arr :ravel))))
|
||||
(let
|
||||
((pairs (map (fn (i) (list (nth ravel i) (+ i apl-io))) (range 0 n))))
|
||||
(define ins nil)
|
||||
(set!
|
||||
ins
|
||||
(fn
|
||||
(x sorted)
|
||||
(if
|
||||
(= (len sorted) 0)
|
||||
(list x)
|
||||
(let
|
||||
((xv (first x))
|
||||
(xi (nth x 1))
|
||||
(hd (first sorted))
|
||||
(sv (first hd))
|
||||
(si (nth hd 1)))
|
||||
(if
|
||||
(if
|
||||
ascending
|
||||
(or (< xv sv) (and (= xv sv) (< xi si)))
|
||||
(or (> xv sv) (and (= xv sv) (< xi si))))
|
||||
(cons x sorted)
|
||||
(cons hd (ins x (rest sorted))))))))
|
||||
(define isort nil)
|
||||
(set!
|
||||
isort
|
||||
(fn
|
||||
(lst)
|
||||
(if
|
||||
(= (len lst) 0)
|
||||
(list)
|
||||
(ins (first lst) (isort (rest lst))))))
|
||||
(make-array (list n) (map (fn (p) (nth p 1)) (isort pairs)))))))
|
||||
|
||||
(define apl-grade-up (fn (arr) (apl-grade arr true)))
|
||||
|
||||
(define apl-grade-down (fn (arr) (apl-grade arr false)))
|
||||
|
||||
@@ -434,4 +434,44 @@
|
||||
(apl-test
|
||||
"squad partial 3d slice shape"
|
||||
(sh (apl-squad (apl-scalar 1) (make-array (list 2 3 4) (range 1 25))))
|
||||
(list 3 4))
|
||||
(list 3 4))
|
||||
|
||||
(apl-test
|
||||
"grade-up basic"
|
||||
(rv (apl-grade-up (make-array (list 5) (list 3 1 4 1 5))))
|
||||
(list 2 4 1 3 5))
|
||||
|
||||
(apl-test
|
||||
"grade-up shape"
|
||||
(sh (apl-grade-up (make-array (list 4) (list 4 1 3 2))))
|
||||
(list 4))
|
||||
|
||||
(apl-test
|
||||
"grade-up no duplicates"
|
||||
(rv (apl-grade-up (make-array (list 4) (list 4 1 3 2))))
|
||||
(list 2 4 3 1))
|
||||
|
||||
(apl-test
|
||||
"grade-up already sorted"
|
||||
(rv (apl-grade-up (make-array (list 3) (list 1 2 3))))
|
||||
(list 1 2 3))
|
||||
|
||||
(apl-test
|
||||
"grade-up reverse sorted"
|
||||
(rv (apl-grade-up (make-array (list 3) (list 3 2 1))))
|
||||
(list 3 2 1))
|
||||
|
||||
(apl-test
|
||||
"grade-down basic"
|
||||
(rv (apl-grade-down (make-array (list 5) (list 3 1 4 1 5))))
|
||||
(list 5 3 1 2 4))
|
||||
|
||||
(apl-test
|
||||
"grade-down no duplicates"
|
||||
(rv (apl-grade-down (make-array (list 4) (list 4 1 3 2))))
|
||||
(list 1 3 4 2))
|
||||
|
||||
(apl-test
|
||||
"grade-up single element"
|
||||
(rv (apl-grade-up (make-array (list 1) (list 42))))
|
||||
(list 1))
|
||||
Reference in New Issue
Block a user