rose-ash/lib/apl/tests/scalar.sx

; APL scalar primitives test suite
; Requires: lib/apl/runtime.sx

; ============================================================
; Test framework
; ============================================================

(define apl-rt-count 0)
(define apl-rt-pass 0)
(define apl-rt-fails (list))

; Element-wise list comparison (handles both List and ListRef)
(define
  lists-eq
  (fn
    (a b)
    (if
      (and (= (len a) 0) (= (len b) 0))
      true
      (if
        (not (= (len a) (len b)))
        false
        (if
          (not (= (first a) (first b)))
          false
          (lists-eq (rest a) (rest b)))))))

(define
  apl-rt-test
  (fn
    (name actual expected)
    (begin
      (set! apl-rt-count (+ apl-rt-count 1))
      (if
        (equal? actual expected)
        (set! apl-rt-pass (+ apl-rt-pass 1))
        (append! apl-rt-fails {:actual actual :expected expected :name name})))))

; Test that a ravel equals a plain list (handles ListRef vs List)
(define
  ravel-test
  (fn
    (name arr expected-list)
    (begin
      (set! apl-rt-count (+ apl-rt-count 1))
      (let
        ((actual (get arr :ravel)))
        (if
          (lists-eq actual expected-list)
          (set! apl-rt-pass (+ apl-rt-pass 1))
          (append! apl-rt-fails {:actual actual :expected expected-list :name name}))))))

; Test a scalar ravel value (single-element list)
(define
  scalar-test
  (fn (name arr expected-val) (ravel-test name arr (list expected-val))))

; ============================================================
; Array constructor tests
; ============================================================

(apl-rt-test
  "scalar: shape is empty list"
  (get (apl-scalar 5) :shape)
  (list))

(apl-rt-test
  "scalar: ravel has one element"
  (get (apl-scalar 5) :ravel)
  (list 5))

(apl-rt-test "scalar: rank 0" (array-rank (apl-scalar 5)) 0)

(apl-rt-test "scalar? returns true for scalar" (scalar? (apl-scalar 5)) true)

(apl-rt-test "scalar: zero" (get (apl-scalar 0) :ravel) (list 0))

(apl-rt-test
  "vector: shape is (3)"
  (get (apl-vector (list 1 2 3)) :shape)
  (list 3))

(apl-rt-test
  "vector: ravel matches input"
  (get (apl-vector (list 1 2 3)) :ravel)
  (list 1 2 3))

(apl-rt-test "vector: rank 1" (array-rank (apl-vector (list 1 2 3))) 1)

(apl-rt-test
  "scalar? returns false for vector"
  (scalar? (apl-vector (list 1 2 3)))
  false)

(apl-rt-test
  "make-array: rank 2"
  (array-rank (make-array (list 2 3) (list 1 2 3 4 5 6)))
  2)

(apl-rt-test
  "make-array: shape"
  (get (make-array (list 2 3) (list 1 2 3 4 5 6)) :shape)
  (list 2 3))

(apl-rt-test
  "array-ref: first element"
  (array-ref (apl-vector (list 10 20 30)) 0)
  10)

(apl-rt-test
  "array-ref: last element"
  (array-ref (apl-vector (list 10 20 30)) 2)
  30)

(apl-rt-test "enclose: wraps in rank-0" (scalar? (enclose 42)) true)

(apl-rt-test
  "enclose: ravel contains value"
  (get (enclose 42) :ravel)
  (list 42))

(apl-rt-test "disclose: unwraps rank-0" (disclose (enclose 42)) 42)

; ============================================================
; Shape primitive tests
; ============================================================

(ravel-test "⍴ scalar: returns empty" (apl-shape (apl-scalar 5)) (list))

(ravel-test
  "⍴ vector: returns (3)"
  (apl-shape (apl-vector (list 1 2 3)))
  (list 3))

(ravel-test
  "⍴ matrix: returns (2 3)"
  (apl-shape (make-array (list 2 3) (list 1 2 3 4 5 6)))
  (list 2 3))

(ravel-test
  ", ravel scalar: vector of 1"
  (apl-ravel (apl-scalar 5))
  (list 5))

(apl-rt-test
  ", ravel vector: same elements"
  (get (apl-ravel (apl-vector (list 1 2 3))) :ravel)
  (list 1 2 3))

(apl-rt-test
  ", ravel matrix: all elements"
  (get (apl-ravel (make-array (list 2 3) (list 1 2 3 4 5 6))) :ravel)
  (list 1 2 3 4 5 6))

(scalar-test "≢ tally scalar: 1" (apl-tally (apl-scalar 5)) 1)

(scalar-test
  "≢ tally vector: first dimension"
  (apl-tally (apl-vector (list 1 2 3)))
  3)

(scalar-test
  "≢ tally matrix: first dimension"
  (apl-tally (make-array (list 2 3) (list 1 2 3 4 5 6)))
  2)

(scalar-test
  "≡ depth flat vector: 0"
  (apl-depth (apl-vector (list 1 2 3)))
  0)

(scalar-test "≡ depth scalar: 0" (apl-depth (apl-scalar 5)) 0)

(scalar-test
  "≡ depth nested (enclose in vector): 1"
  (apl-depth (enclose (apl-vector (list 1 2 3))))
  1)

; ============================================================
; ⍳ iota tests
; ============================================================

(apl-rt-test
  "⍳5 shape is (5)"
  (get (apl-iota (apl-scalar 5)) :shape)
  (list 5))

(ravel-test "⍳5 ravel is 1..5" (apl-iota (apl-scalar 5)) (list 1 2 3 4 5))

(ravel-test "⍳1 ravel is (1)" (apl-iota (apl-scalar 1)) (list 1))

(ravel-test "⍳0 ravel is empty" (apl-iota (apl-scalar 0)) (list))

(apl-rt-test "apl-io is 1" apl-io 1)

; ============================================================
; Arithmetic broadcast tests
; ============================================================

(scalar-test
  "+ scalar scalar: 3+4=7"
  (apl-add (apl-scalar 3) (apl-scalar 4))
  7)

(ravel-test
  "+ vector scalar: +10"
  (apl-add (apl-vector (list 1 2 3)) (apl-scalar 10))
  (list 11 12 13))

(ravel-test
  "+ scalar vector: 10+"
  (apl-add (apl-scalar 10) (apl-vector (list 1 2 3)))
  (list 11 12 13))

(ravel-test
  "+ vector vector"
  (apl-add (apl-vector (list 1 2 3)) (apl-vector (list 4 5 6)))
  (list 5 7 9))

(scalar-test "- negate monadic" (apl-neg-m (apl-scalar 5)) -5)

(scalar-test "- dyadic 10-3=7" (apl-sub (apl-scalar 10) (apl-scalar 3)) 7)

(scalar-test "× signum positive" (apl-signum (apl-scalar 7)) 1)

(scalar-test "× signum negative" (apl-signum (apl-scalar -3)) -1)

(scalar-test "× signum zero" (apl-signum (apl-scalar 0)) 0)

(scalar-test "× dyadic 3×4=12" (apl-mul (apl-scalar 3) (apl-scalar 4)) 12)

(scalar-test "÷ reciprocal 1÷4=0.25" (apl-recip (apl-scalar 4)) 0.25)

(scalar-test
  "÷ dyadic 10÷4=2.5"
  (apl-div (apl-scalar 10) (apl-scalar 4))
  2.5)

(scalar-test "⌈ ceiling 2.3→3" (apl-ceil (apl-scalar 2.3)) 3)

(scalar-test "⌈ max 3 5 → 5" (apl-max (apl-scalar 3) (apl-scalar 5)) 5)

(scalar-test "⌊ floor 2.7→2" (apl-floor (apl-scalar 2.7)) 2)

(scalar-test "⌊ min 3 5 → 3" (apl-min (apl-scalar 3) (apl-scalar 5)) 3)

(scalar-test "* exp monadic e^0=1" (apl-exp (apl-scalar 0)) 1)

(scalar-test
  "* pow dyadic 2^10=1024"
  (apl-pow (apl-scalar 2) (apl-scalar 10))
  1024)

(scalar-test "⍟ ln 1=0" (apl-ln (apl-scalar 1)) 0)

(scalar-test "| abs positive" (apl-abs (apl-scalar 5)) 5)

(scalar-test "| abs negative" (apl-abs (apl-scalar -5)) 5)

(scalar-test "| mod 3|7=1" (apl-mod (apl-scalar 3) (apl-scalar 7)) 1)

(scalar-test "! factorial 5!=120" (apl-fact (apl-scalar 5)) 120)

(scalar-test "! factorial 0!=1" (apl-fact (apl-scalar 0)) 1)

(scalar-test
  "! binomial 4 choose 2 = 6"
  (apl-binomial (apl-scalar 4) (apl-scalar 2))
  6)

(scalar-test "○ pi×0=0" (apl-pi-times (apl-scalar 0)) 0)

(scalar-test "○ trig sin(0)=0" (apl-trig (apl-scalar 1) (apl-scalar 0)) 0)

(scalar-test "○ trig cos(0)=1" (apl-trig (apl-scalar 2) (apl-scalar 0)) 1)

; ============================================================
; Comparison tests
; ============================================================

(scalar-test "< less: 3<5 → 1" (apl-lt (apl-scalar 3) (apl-scalar 5)) 1)

(scalar-test "< less: 5<3 → 0" (apl-lt (apl-scalar 5) (apl-scalar 3)) 0)

(scalar-test
  "≤ le equal: 3≤3 → 1"
  (apl-le (apl-scalar 3) (apl-scalar 3))
  1)

(scalar-test "= eq: 5=5 → 1" (apl-eq (apl-scalar 5) (apl-scalar 5)) 1)

(scalar-test "= ne: 5=6 → 0" (apl-eq (apl-scalar 5) (apl-scalar 6)) 0)

(scalar-test "≥ ge: 5≥3 → 1" (apl-ge (apl-scalar 5) (apl-scalar 3)) 1)

(scalar-test "> gt: 5>3 → 1" (apl-gt (apl-scalar 5) (apl-scalar 3)) 1)

(scalar-test "≠ ne: 5≠3 → 1" (apl-ne (apl-scalar 5) (apl-scalar 3)) 1)

(ravel-test
  "comparison vector broadcast: 1 2 3 < 2 → 1 0 0"
  (apl-lt (apl-vector (list 1 2 3)) (apl-scalar 2))
  (list 1 0 0))

; ============================================================
; Logical tests
; ============================================================

(scalar-test "~ not 0 → 1" (apl-not (apl-scalar 0)) 1)

(scalar-test "~ not 1 → 0" (apl-not (apl-scalar 1)) 0)

(ravel-test
  "~ not vector: 1 0 1 0 → 0 1 0 1"
  (apl-not (apl-vector (list 1 0 1 0)))
  (list 0 1 0 1))

(scalar-test
  "∧ and 1∧1 → 1"
  (apl-and (apl-scalar 1) (apl-scalar 1))
  1)

(scalar-test
  "∧ and 1∧0 → 0"
  (apl-and (apl-scalar 1) (apl-scalar 0))
  0)

(scalar-test "∨ or 0∨1 → 1" (apl-or (apl-scalar 0) (apl-scalar 1)) 1)

(scalar-test "∨ or 0∨0 → 0" (apl-or (apl-scalar 0) (apl-scalar 0)) 0)

(scalar-test
  "⍱ nor 0⍱0 → 1"
  (apl-nor (apl-scalar 0) (apl-scalar 0))
  1)

(scalar-test
  "⍱ nor 1⍱0 → 0"
  (apl-nor (apl-scalar 1) (apl-scalar 0))
  0)

(scalar-test
  "⍲ nand 1⍲1 → 0"
  (apl-nand (apl-scalar 1) (apl-scalar 1))
  0)

(scalar-test
  "⍲ nand 1⍲0 → 1"
  (apl-nand (apl-scalar 1) (apl-scalar 0))
  1)

; ============================================================
; plus-m identity test
; ============================================================

(scalar-test "+ monadic identity: +5 → 5" (apl-plus-m (apl-scalar 5)) 5)

; ============================================================
; Summary
; ============================================================

(define
  apl-scalar-summary
  (str
    "scalar "
    apl-rt-pass
    "/"
    apl-rt-count
    (if (= (len apl-rt-fails) 0) "" (str " FAILS: " apl-rt-fails))))