(require 'array)
(require 'subarray)
(require 'charplot)
(require 'array-for-each)

(define oparray (create-array (Au32 0) 11))

(define histarray (create-array (Au32 0) 310))

(define meter
  (let ((plain+ +)
	(fdx 0))
    (lambda (func)
      (define mydx fdx)
      (set! fdx (plain+ 1 fdx))
      (print 'meter mydx func)
      (lambda args
	(if (equal? '(unmeter) args)
	    func
	    (let ((ans (apply func args)))
	      (array-set! oparray (plain+ 1 (array-ref oparray mydx)) mydx)
	      (and (exact? ans)
		   (let ((btln (integer-length (abs ans))))
		     (array-set! histarray
				 (plain+ 1 (array-ref histarray btln))
				 btln)))
	      ans))))))

(define * (meter *))
(define + (meter +))
(define - (meter -))
(define / (meter /))
(define gcd (meter gcd))
(define lcm (meter lcm))
(define max (meter max))
(define min (meter min))
(define modulo (meter modulo))
(define quotient (meter quotient))
(define remainder (meter remainder))

(define (unmeter)
  (set! * (* 'unmeter))
  (set! + (+ 'unmeter))
  (set! - (- 'unmeter))
  (set! / (/ 'unmeter))
  (set! gcd (gcd 'unmeter))
  (set! lcm (lcm 'unmeter))
  (set! max (max 'unmeter))
  (set! min (min 'unmeter))
  (set! modulo (modulo 'unmeter))
  (set! quotient (quotient 'unmeter))
  (set! remainder (remainder 'unmeter)))

(load "math")
;;(batch "demo")
(batch "test.math")
(unmeter)

(let ()
  (print)
  (print 'function 'call 'counts)
  (array-for-each print
		  '#(* + - / gcd lcm max min modulo quotient remainder)
		  oparray))

;; FUNCTION CALL COUNTS
;; * 984056 
;; + 1964072 
;; - 728167 
;; / 4 
;; gcd 14027 
;; lcm 0 
;; max 18338 
;; min 6297 
;; modulo 71380 
;; quotient 136679 
;; remainder 21275 

(define (write-dat ra file)
  (call-with-output-file file
    (lambda (port)
      (array-for-each (lambda (x) (write x port) (newline port)) ra))))

(define (log2 x)
  (/ (log (+ 1 x)) (log 2)))

(define logarray (apply create-array (Ar32 0) (array-shape histarray)))
(array-map! logarray log2 histarray)
(let ()
  (newline)
  (plot logarray "bits" "log2cnt"))
(write-dat logarray "logdist.dat")

(define intarray (apply create-array (Ar32 0) (array-shape histarray)))
(define acc 0)
(serial-array-map! intarray
		   (lambda (x) (set! acc (+ x acc)) acc)
		   histarray)
(array-map! intarray (lambda (x) (* 100 (/ (- acc x) acc))) intarray)
(let ()
  (newline)
  (plot (subarray intarray '(0 65)) "bits" "%%"))
(write-dat intarray "intper.dat")

(define perarray (apply create-array (Ar32 0) (array-shape histarray)))
(array-map! perarray
	    (lambda (x) (* 100 (/ x acc)))
	    histarray)
(let ()
  (newline)
  (plot (subarray perarray '(0 65)) "bits" "%%"))
(write-dat perarray "per.dat")

(system "gnuplot intdist.plt")


;;log2cnt  _*________________________________________________________________
;;      20|-*                                                                |
;;        | **                                                               |
;;      18|-:                                                                |
;;        | :*                                                               |
;;      16|-:**                                                              |
;;        | :**   *   **                                                     |
;;      14|-:   * *   *                                                      |
;;        | : **** *  ***                                                    |
;;      12|-:  ****   ****                                                   |
;;        | :   **** *   **                                                  |
;;      10|-:      ***    **                                                 |
;;        | :       *      ***                                               |
;;       8|-:               **  *                                            |
;;        | :                   *                                            |
;;       6|-:                 ***                                            |
;;        | :                  *        *                                    |
;;       4|-:                 *  ** *   *   *   *                            |
;;        | :                    * ********* ***** **   *   *                |
;;       2|-:                     *****  ** * **  ** **** **    *       *    |
;;        | :                       ** * **  * *       *       *        *    |
;;       0|-:---------------------**-***-******-************************-----|
;;        |_:____.____:____.____:____.____:____.____:____.____:____.____:____|
;; bits     0         50       100       150       200       250       300