newlisp/qa-specific-tests/qa-bigint

; test big integer operators

(unless bigint
    (println "big integers not enabled in this version")
    (exit))

(println ">>>>> testing big ints arithmetik ... ")

(set-locale "C")

;; check embedded bigint 0's

(set 'nums '(
; aligned
 12345678901000000000L
 123456789010000000001234567890L
 123456789010000000000000000001234567890L
 123456789010000000000000000000L
 123000000000000000000000000000L
 123000000000000000001L
; not aligned
 123456789010000000000L
 1234567890100000000001234567890L
 1234567890100000000000000000000L
 1230000000000000000000000000000L
 1230000000000000000001L
 1234578901000000000L
 12345789010000000001234567890L
 12345789010000000000000000000L
 123000000000000000000000000L
 123000000000000001L
))

(dolist (num nums)
    (unless (= (/ num 1) num)
        (println num)
        (println ">>>>> ERROR in big integer zeros")
        (exit))
)

; some special cases
(unless (and
    (= (/ 1234567890123456789012345678901234567890 12345678901234567890) 100000000000000000001L)
    (= (/ 1234567890L 12345L) 100005L)
    (= (/ 1234567891L 1234567890L) 1L)
    (= (/ 1234567890L 1234567890L) 1L)
    (= (/ 888888888888888888888888888888888888888888888888888888888888888888888888
          888888888888888888888888888888888888888888888888888888888888889) 999999999L)
    (= (/ 888888888888888888888888888888888888888888888888888888888888888888888888
          888888888888888888888888888888888888888888888888888888888888888) 1000000000L)
    (= (/ 888888888888888888888888888888888888888888888888888888888888888888888888
          888888888888888888888888888888888888888888888888888888888888887) 1000000000L)
    (= (/ 11111111111111111L 11111111111111111L) 1L) ; problems with gcc optimizations on Linux
    (= (/ 22222222222222222L 22222222222222222L) 1L) 
    (= (/ 44444444444444444L 44444444444444444L) 1L) 
    (= (/ 88888888888888888L 88888888888888888L) 1L) 
    (= (/ 99999999999999999L 99999999999999999L) 1L)  )
        (println ">>>>> ERROR in special cases")
            (exit)
)

(seed 5212011)

(if (> (length (main-args)) 2)
    (set 'N (int (main-args -1)))
    (set 'N 100000))

(if eval-string-js (set 'N 1000)) ; for JavaScript compiled newLISP

(dotimes (i N)
    (set 'f (pow (random 10 100) (+ 15 (rand 50))))
    (set 'f1 (float (bigint f)))
    (unless eval-string-js 
        (when (= i (* (/ i 1000) 1000)) (print ".")))
    ;(println "=>" (sub (abs (div f f1)) 1.0))
    (unless (<= (abs (sub (abs (div f f1)) 1.0)) 0.000000001)
       (println f "   " f1 " " (abs (sub (abs (div f f1)) 1)))
       (println ">>>>> ERROR in big integer/float conversion")
       (exit))
)
(println)
(define (get-bignum n , num)
    (set 'num (amb "-" ""))
    (if (zero? n) (++ n))
    (dotimes (i n)
        (extend num (string (+ (rand 1000) 1))))
    (extend num (dup (string (rand 10)) (rand 10)))
    (extend num "L")
    (bigint num))
        
(dotimes (i N)
    (setq x (get-bignum (rand 30)))
    (setq y (get-bignum (rand 30)))
    ;(println "x=" x " y=" y)
    (unless eval-string-js 
        (when (= i (* (/ i 1000) 1000)) (print ".")))
    (unless (= (zero? x) (= x 0))
        (println ">>>>> ERROR in zero? for x = " x)
        (exit))

    (unless (and
        (= (/ x x) 1L)
        (= (/ y y) 1L)
        )
            (println ">>>>> ERROR in x/x y/y " x " " y)
            (exit))
    
    (setq x+y (+ x y))
    (setq x-y (- x y))

    (setq x*y (* x y))
    (setq x/y (/ x y))

    (set 'xx x)
    (unless (= (++ xx y) x+y)
        (println ">>>>> ERROR in ++ with " x " " y)
        (exit))

    (set 'xx x)
    (unless (= (-- xx y) x-y)
        (println ">>>>> ERROR in -- with " x " " y)
        (exit))

    (unless (and (= (- x+y y) x) (= (- x+y x) y) (= (+ x-y y) x) ) 
            (println ">>>>> ERROR in +, - with " x " " y)
            (exit))

    (unless (and (= (/ x*y x) y) (= (/ x*y y) x)) 
        (println ">>>>> ERROR in * / with:\n" x "\n" y "\nat: " i)
        (println "x*y / x ->" (/ x*y x) )
        (println "x*y / y ->" (/ x*y y) )
        (exit))

    (unless (= (% x y) (- x (* x/y y)))
            (println ">>>>> ERROR in %, * , / operation with " x " " y)
            (exit))

    (when (> (abs x/y) 0)
        ;(println x " " y " remainder " (- (abs x) (* (abs x/y) (abs y))))
        (unless (< (- (abs x) (* (abs x/y) (abs y))) (abs y))
            (println ">>>>> ERROR in abs, -, *, - with " x " " y)
            (exit))
    )

)
(println)

; gcd for bigint
; from http://bit-player.org/2013/the-keys-to-the-keydom
; and: http://en.wikipedia.org/wiki/Euclidean_algorithm

(set 'x  123784517654557044204572030015647643260197571566202790882488143432336664289530131607571273603815008562006802500078945576463726847087638846268210782306492856139635102768022084368721012277184508607370805021154629821395702654988748083875440199841915223400907734192655713097895866822706517949507993107455319103401)

(set 'y  139752806258570179719657334941265463008205415047073349942370461270597321020717639292879992151626413610247750429267916230424010955054750502833517070395986289724237112410816000558148623785411568845517146303421384063525091824898318226175234193815950597041627518140906384889218054867887058429444934835873139133193) 

(define (gcd-big a b)
	(if (= b 0) a (gcd-big b (% a b))))

(define (gcd-big a b , t)
	(until (= b 0)
		(set 't b)
		(set 'b (% a b))
		(set 'a t)
	)) 

(set 'f 10704679319376067064256301459487150226969621912489596482628509800922080318199635726117009340189103336170841315900354200725312700639146605265442630619090531)

(unless (= (gcd x y) f)
    (println ">>>>> ERROR in big integer gcd") 
    (exit))

(unless (= (length 1234567890123456789012345) 25)
    (println ">>>>> ERROR in big integer length") 
    (exit))

(dotimes (i 1000)
    (unless (= (gcd i (- 1000 i)) (gcd (bigint i) (- 1000 i)))
        (println ">>>>> ERROR in gcd to bigint gcd comparison")))

;;(println ">>> big int gcd benchmark " (time (gcd x y) 1000) " micro secs")

(println ">>>>> abs bigint float gcd length zero? + - * / % ++ -- big ints tested SUCCESSFUL")

(exit)

;; eof