;;;; math-utils-vector-test.scm  -*- Scheme -*-
;;;; Kon Lovett, Jul '23

(import test)
(import (only (chicken format) format) (test-utils gloss))
(import (test-utils test))

;;;

(test-begin "Math Utils Vector")

(import (math-utils vector))

;;;

(import (chicken string))
(import (chicken fixnum))
(import (chicken random))
(import (chicken time))
(import (only vector-lib vector-unfold))
(import math-utils)

;NOTE must have precision set
(define-syntax test-vector
  (syntax-rules ()
    ((test-vector ?r ?e)
      (test #f 0.0 (exact->inexact (vector-compare ?r ?e))) )
    ((test-vector ?lb ?r ?e)
      (test ?lb 0.0 (exact->inexact (vector-compare ?r ?e))) ) ) )

;;

;https://en.wikipedia.org/wiki/Cosine_similarity
(define (cosine-similarity/reference a b)
  (/ (dot-product a b)
     (* (absolute-magnitude a) (absolute-magnitude b))) )

#;
(repeat-random (100)
  (let*-random ((len 1000)
                (a (vector-of real len))
                (b (vector-of real len)) )
      (test "\"fast\" cosine-similarity eqv cosine-similarity reference"
            (cosine-similarity/reference a b)
            (cosine-similarity a b))
    )
)

(define (make-random-real-vector len #!optional (zeros? #f) (rnd pseudo-random-real) (trys 10))
  (vector-unfold
    (lambda _ #;(i . seeds)
      (let loop ((try trys))
        (let ((n (rnd)))
          (cond ((or (not (zero? n)) zeros?)  n)
                ((fx< try 0)                  1)
                (else                         (loop (fx- try 1)))) ) ) )
    len) )

(define (rndfix l h) (+ l (pseudo-random-integer (- h l))))

#; ;same results as below but larger intermediate
(define (now/ms) (current-process-milliseconds))
(define (now/ms) (receive (sys-ms _) (cpu-time) sys-ms))

(define-syntax time-of/ms
  (syntax-rules ()
    ((time-of/ms ?e)
      (let ((ms (now/ms)))
        ?e
        (- (now/ms) ms) ) ) ) )

;;

;FIXME should use a static set of test cases, not random!
(test-group "cosine-similarity \"fast\" = reference w/ real values"
  (do ((cnt 15 (fx- cnt 1)))
      ((fx= 0 cnt))
    (let* ((len (* cnt 1000))
           (a (make-random-real-vector len #t))
           (b (make-random-real-vector len #t)) )
      (test (conc "Length " len)
            (cosine-similarity/reference a b)
            (cosine-similarity a b)) ) )
)

(test-group "operations"
  (test 10 (dot-product #(1 2 3) #(3 2 1)))

  (test-group "any X empty is 0"
    (test 0 (cross-product #() #()))
    (test 0 (cross-product #() #(3)))
    (test 0 (cross-product #(1) #()))
  )
  (test 3 (cross-product #(1) #(3)))
  (test -4 (cross-product #(1 2) #(3 2)))
  (test #(-4 8 -4) (cross-product #(1 2 3) #(3 2 1)))
)

(test-group "vector apply"
  (define (vector-mul . vs) (apply vector-apply * vs))
  (define (vector-add . vs) (apply vector-apply + vs))
  (define (vector-dif . vs) (apply vector-apply - vs))

  (test-group "no data"
    (test 0 (vector-add))
    (test 1 (vector-mul))
    (test-error (vector-dif))
  )

  (test-group "2 vecs"
    (test "add" #(4 4 4) (vector-add #(1 2 3) #(3 2 1)))
    (test "mul" #(3 4 3) (vector-mul #(1 2 3) #(3 2 1)))
    (test "dif" #(-2 0 2) (vector-dif #(1 2 3) #(3 2 1)))
  )
)

(test-group "vector reduce"
  (test 6 (vector-sum #(1 2 3)))
  (test 6 (vector-prod #(1 2 3)))
  (test 1 (vector-min #(1 2 3)))
  (test 3 (vector-max #(1 2 3)))
)

(test-group "compare"
  (test-assert "diff len" (positive? (vector-compare #(1 2 3 4) #(3 2 1))))

  (test-assert "<" (negative? (vector-compare #(1 2 3) #(3 2 1))))
  (test-assert "=" (zero? (vector-compare #(3 2 1) #(3 2 1))))
  (test-assert ">" (positive? (vector-compare #(3 2 1) #(1 2 3))))

  (test-assert "multi <" (negative? (vector-compare #(-2 0 2) #(3 2 1) #(1 2 3))))
  (test-assert "multi =" (zero? (vector-compare #(1 2 3) #(1 2 3) #(1 2 3))))
  (test-assert "multi >" (positive? (vector-compare #(3 2 1) #(1 2 3) #(-2 0 2))))
)

(test-group "softmax"
  (parameterize ((current-test-epsilon 0.001)) ;2 places precision of input
    (test-vector "low spike"
                 #(0.01 0.00 0.03 0.09 0.61 0.00 0.25)
                 (softmax #(-0.8 -5.0 +0.5 +1.5 +3.4 -2.3 +2.5)))
    (test "low spike p"
          1.0 (vector-reduce + 0 (softmax #(-0.8 -5.0 +0.5 +1.5 +3.4 -2.3 +2.5))))
    (test-vector "high spike"
                 #(0.00 0.00 0.00 0.00 0.99 0.01 0.00)
                 (softmax #(-0.8 -5.0 +0.5 +1.5 +8.5 -2.3 +2.5)))
     (test "high spike p"
           1.0 (vector-reduce + 0 (softmax #(-0.8 -5.0 +0.5 +1.5 +8.5 -2.3 +2.5))))
 )

  ;wikipedia example
  ;#(0.000908800555363033 0.00247037603533682 0.9966208234093)
  ;#(0.001                0.002               0.997)
  ;(softmax #(1 2 8))
)

(test-group "softmax w/ temp"
  (parameterize ((current-test-epsilon 0.001)) ;2 places precision of input

    (test-vector "same when temp = 1"
                 #(0.01 0.00 0.03 0.09 0.61 0.00 0.25)
                 (softmax* #(-0.8 -5.0 +0.5 +1.5 +3.4 -2.3 +2.5))) ;default 1
     (test "same when temp = 1 p"
           1.0 (vector-reduce + 0 (softmax* #(-0.8 -5.0 +0.5 +1.5 +3.4 -2.3 +2.5))))

    (test-vector "temp > 1"
                 #(0.19 0.04 0.14 0.10 0.34 0.05 0.14)
                 (softmax* #(+6.0 -5.0 +4.0 +1.5 +9.9 -2.3 +4.0) 6.57))
     (test "temp > 1 p"
           1.0 (vector-reduce + 0 (softmax* #(+6.0 -5.0 +4.0 +1.5 +9.9 -2.3 +4.0) 6.57)))

    (test-vector "temp < 1"
                 #(0.0 0.0 0.0 0.0 0.99957 0.0 0.0)
                 (softmax* #(+6.0 -5.0 +4.0 +1.5 +9.9 -2.3 +4.0) 0.5))
     (test "temp < 1 p"
           1.0 (vector-reduce + 0 (softmax* #(+6.0 -5.0 +4.0 +1.5 +9.9 -2.3 +4.0) 0.5)))

    (test-vector "temp = 0"
                 #(0.00 0.00 0.00 0.00 1.00 0.00 0.00)
                 (softmax* #(+6.0 -5.0 +4.0 +1.5 +9.9 -2.3 +4.0) 0))
     (test "temp = 0 p"
           1.0 (vector-reduce + 0 (softmax* #(+6.0 -5.0 +4.0 +1.5 +9.9 -2.3 +4.0) 0)))

    ;(vector-apply (cut @prec 4 <> round) ^)
    (test-vector "temp < -1"
                 #(0.0661 0.3528 0.0897 0.1312 0.0365 0.2339 0.0897)
                 (softmax* #(+6.0 -5.0 +4.0 +1.5 +9.9 -2.3 +4.0) -6.57))
     (test "temp < -1 p"
           1.0 (vector-reduce + 0 (softmax* #(+6.0 -5.0 +4.0 +1.5 +9.9 -2.3 +4.0) -6.57)))

    (test-vector "temp < 0"
                 #(0.0 0.0 0.0 0.0 0.99957 0.0 0.0)
                 (softmax* #(+6.0 -5.0 +4.0 +1.5 +9.9 -2.3 +4.0) -0.5))
     (test "temp < 0 p"
           1.0 (vector-reduce + 0 (softmax* #(+6.0 -5.0 +4.0 +1.5 +9.9 -2.3 +4.0) -0.5)))

    ;(vector-apply (cut @prec 4 <> round) ^)
    (test-vector "temp >> 1"
                 #(0.1436 0.1412 0.1432 0.1426 0.1444 0.1418 0.1432)
                 (softmax* #(+6.0 -5.0 +4.0 +1.5 +9.9 -2.3 +4.0) 666))
     (test "temp >> 1 p"
           1.0 (vector-reduce + 0 (softmax* #(+6.0 -5.0 +4.0 +1.5 +9.9 -2.3 +4.0) 666)))

    ;(gloss (softmax* #(+6.0 -5.0 +4.0 +1.5 +9.9 -2.3 +4.0) 666))
    ;(vector-apply (cut @prec 4 <> round) ^)
    (test-vector "temp >>> 1"
                 #(0.1429 0.1429 0.1429 0.1429 0.1429 0.1429 0.1429)
                 (softmax* #(+6.0 -5.0 +4.0 +1.5 +9.9 -2.3 +4.0) most-positive-fixnum))
     (test "temp >>> 1 p"
           1.0 (vector-reduce + 0 (softmax* #(+6.0 -5.0 +4.0 +1.5 +9.9 -2.3 +4.0) most-positive-fixnum)))

    (test-vector "temp +inf"
                 #(0.0 0.0 0.0 0.0 0.0 0.0 0.0)
                 (softmax* #(+6.0 -5.0 +4.0 +1.5 +9.9 -2.3 +4.0) +inf.0))
     (test "temp inf p"
           0.0 (vector-reduce + 0 (softmax* #(+6.0 -5.0 +4.0 +1.5 +9.9 -2.3 +4.0) +inf.0)))
  )
)

;;;

(test-end "Math Utils Vector")

(test-exit)