Permalink
Fetching contributors…
Cannot retrieve contributors at this time
405 lines (348 sloc) 15.2 KB
#lang racket
(require "printer.rkt")
(provide stat% print-stat-all create-stat-from-file get-best-info)
(define-syntax-rule (ratio x y) (~r (exact->inexact (/ x y)) #:precision 6))
(define stat%
(class object%
(init-field printer
[best-correct-program #f]
[best-correct-cost #f]
[best-correct-len #f]
[stat-mutations (get-field report-mutations printer)]
[n (vector-length stat-mutations)]
[start-time (current-seconds)]
[time #f]
[propose-stat (make-vector n 0)]
[accept-stat (make-vector n 0)]
[best-correct-time 0]
[best-program #f]
[best-cost (arithmetic-shift 1 32)]
[current-mutate #f]
[iter-count 0]
[misalign-count 0]
[validate-count 0]
[correct-count 0]
[accept-count 0]
[accept-higher-count 0]
[name #f]
[simulate-time 0]
[check-time 0]
[validate-time 0]
[mutate-time 0]
[dir #f]
)
(super-new)
(define/public (set-name my-name)
(set! name my-name)
(when name
(define tokens (string-split my-name "/"))
(set! dir (string-join (take tokens (sub1 (length tokens))) "/"))))
(define/public (inc-iter current-cost)
;; (with-output-to-file #:exists 'append (format "~a.csv" name)
;; (thunk
;; (pretty-display (format "~a,~a" iter-count current-cost))))
(set! iter-count (add1 iter-count))
(and (= (modulo iter-count 30000) 0) ;;30000
(let-values ([(cost len time id) (get-best-info dir)])
(print-stat-to-file)
(and cost len))))
(define/public (inc-propose x)
(define index (vector-member x stat-mutations))
(vector-set! propose-stat index
(add1 (vector-ref propose-stat index)))
(set! current-mutate index))
(define/public (inc-accept)
(set! accept-count (add1 accept-count))
(vector-set! accept-stat current-mutate
(add1 (vector-ref accept-stat current-mutate))))
(define/public (inc-accept-higher)
(set! accept-higher-count (add1 accept-higher-count)))
(define/public (inc-correct)
(set! correct-count (add1 correct-count)))
(define/public (inc-validate)
(set! validate-count (add1 validate-count)))
(define/public (inc-misalign)
(set! misalign-count (add1 misalign-count)))
(define/public (get-best-info-stat)
(get-best-info dir))
(define/public (update-best program cost)
(set! best-program program)
(set! best-cost cost)
(with-output-to-file #:exists 'truncate (format "~a.cand" name)
(thunk
;; (pretty-display (format "best-correct-cost: ~a" best-correct-cost))
;; (pretty-display (format "best-correct-time: ~a" best-correct-time))
(send printer print-syntax (send printer decode program))))
)
(define/public (update-best-correct-program program)
(set! best-correct-program program))
(define/public (update-best-correct program cost)
(set! best-correct-program program)
(set! best-correct-cost cost)
(set! best-correct-len (vector-length program))
(set! best-correct-time (- (current-seconds) start-time))
(pretty-display `(time ,best-correct-time))
(when dir
(define info-file (format "~a/best.info" dir))
(define-values (cost-r len-r time-r id-r) (get-best-info dir))
(when (or (not cost-r) (< cost cost-r))
(pretty-display "FOUND!!!")
(with-output-to-file #:exists 'append (format "~a/summary" dir)
(thunk
(pretty-display
(format
"~a,~a,~a,~a"
best-correct-cost best-correct-len best-correct-time name))))
(with-output-to-file #:exists 'truncate (format "~a/best.s" dir)
(thunk
(send printer print-syntax (send printer decode best-correct-program))))
(with-output-to-file #:exists 'truncate info-file
(thunk
(pretty-display best-correct-cost)
(pretty-display best-correct-len)
(pretty-display best-correct-time)
(pretty-display name)
))
(with-output-to-file #:exists 'truncate (format "~a/best-~a.s" dir best-correct-cost)
(thunk
(send printer print-syntax (send printer decode best-correct-program))))
)
(with-output-to-file #:exists 'truncate (format "~a.best" name)
(thunk
(send printer print-syntax (send printer decode best-correct-program))))
)
)
(define/public (simulate x) (set! simulate-time (+ simulate-time x)))
(define/public (check x) (set! check-time (+ check-time x)))
(define/public (validate x) (set! validate-time (+ validate-time x)))
(define/public (mutate x) (set! mutate-time (+ mutate-time x)))
(define/public (print-stat-to-file)
(set! time (- (current-seconds) start-time))
(with-output-to-file #:exists 'truncate (format "~a.stat" name)
(thunk (print-stat)))
;;(print-stat)
)
(define/public (print-stat)
(pretty-display "---------------------------------------------------------")
;(pretty-display (format "memory-use:\t~a" (exact->inexact (/ (current-memory-use) 1000))))
(pretty-display (format "elapsed-time:\t~a" time))
(pretty-display (format "mutate-time:\t~a" mutate-time))
(pretty-display (format "simulate-time:\t~a" simulate-time))
(pretty-display (format "check-time:\t~a" check-time))
(pretty-display (format "validate-time:\t~a" validate-time))
(newline)
(pretty-display (format "validate-count:\t~a" validate-count))
(pretty-display (format "correct-count:\t~a" correct-count))
;(pretty-display (format "misalign-count:\t~a" misalign-count))
(newline)
(pretty-display (format "iterations:\t~a" iter-count))
(when (> time 0)
(pretty-display (format "iterations/s:\t~a" (exact->inexact (/ iter-count time)))))
(pretty-display (format "best-cost:\t~a" best-cost))
(pretty-display (format "best-correct-cost:\t~a" best-correct-cost))
(pretty-display (format "best-correct-time:\t~a" best-correct-time))
(newline)
(define proposed (foldl + 0 (vector->list propose-stat)))
(define accepted (foldl + 0 (vector->list accept-stat)))
(pretty-display (format "Mutate\tProposed\t\tAccepted\t\tAccepted/Proposed"))
(for ([i n])
(pretty-display (format "~a\t~a\t~a\t~a"
(vector-ref stat-mutations i)
(exact->inexact (/ (vector-ref propose-stat i) proposed))
(exact->inexact (/ (vector-ref accept-stat i) proposed))
(if (> (vector-ref propose-stat i) 0)
(exact->inexact (/ (vector-ref accept-stat i) (vector-ref propose-stat i)))
0))))
(newline)
;; (pretty-display (format "acceptance-rate:\t~a"
;; (exact->inexact (/ accepted proposed))))
(pretty-display (format "accept-count:\t~a" accept-count))
(pretty-display (format "accept-higher-count:\t~a" accept-higher-count))
;; (pretty-display (format "accept-higher-percent:\t~a"
;; (exact->inexact (/ accept-higher-count accept-count))))
)
))
;; (define (get-output-id stat-list)
;; (define best-correct-cost (arithmetic-shift 1 32))
;; (define best-correct-time (arithmetic-shift 1 32))
;; (define best-correct-id #f)
;; (for ([stat stat-list]
;; [id (length stat-list)])
;; (when stat
;; (let ([correct-cost (get-field best-correct-cost stat)]
;; [correct-time (get-field best-correct-time stat)])
;; (when (< correct-cost best-correct-cost)
;; (set! best-correct-cost correct-cost)
;; (set! best-correct-time correct-time)
;; (set! best-correct-id id)
;; )
;; (when (and (= correct-cost best-correct-cost)
;; (< correct-time best-correct-time))
;; (set! best-correct-time correct-time)
;; (set! best-correct-id id)
;; ))))
;; (pretty-display (format "best-correct-cost:\t~a" best-correct-cost))
;; (pretty-display (format "best-correct-time:\t~a" best-correct-time))
;; best-correct-id)
(define (print-stat-all stat-list printer)
(define stat-mutations (get-field report-mutations printer))
(define n (vector-length stat-mutations))
(define-syntax-rule (reduce+ field)
(foldl + 0 (map (lambda (x) (get-field field x)) stat-list)))
;(pretty-display "time")
(define time (reduce+ time))
(define mutate-time (reduce+ mutate-time))
(define simulate-time (reduce+ simulate-time))
(define check-time (reduce+ check-time))
(define validate-time (reduce+ validate-time))
;(pretty-display "iter-count")
(define iter-count (reduce+ iter-count))
;(pretty-display "validate-count")
(define validate-count (reduce+ validate-count))
;(pretty-display "correct-count")
(define correct-count (reduce+ correct-count))
;(pretty-display "misalign-count")
;(define misalign-count (reduce+ misalign-count))
;(pretty-display "accept-higher-count")
(define accept-higher-count (reduce+ accept-higher-count))
(define accept-count (reduce+ accept-count))
(define all 0)
;(pretty-display "propose-stat")
(define propose-stat
(for/vector ([i n])
(foldl + 0 (map (lambda (x) (vector-ref (get-field propose-stat x) i))
stat-list))))
;(pretty-display "accept-stat")
(define accept-stat
(for/vector ([i n])
(foldl + 0 (map (lambda (x) (vector-ref (get-field accept-stat x) i))
stat-list))))
(define best-correct-cost (arithmetic-shift 1 32))
(define best-correct-time (arithmetic-shift 1 32))
(define best-cost (arithmetic-shift 1 32))
(for ([stat stat-list]
[id (length stat-list)])
(let ([correct-cost (get-field best-correct-cost stat)]
[correct-time (get-field best-correct-time stat)]
[cost (get-field best-cost stat)])
(when (< correct-cost best-correct-cost)
(set! best-correct-cost correct-cost)
(set! best-correct-time correct-time)
)
(when (and (= correct-cost best-correct-cost)
(< correct-time best-correct-time))
(set! best-correct-time correct-time)
)
(when (< cost best-cost)
(set! best-cost cost))))
(define stat (new stat%
[printer printer]
[time (quotient time (length stat-list))]
[mutate-time (ratio (/ mutate-time 1000) time)]
[simulate-time (ratio (/ simulate-time 1000) time)]
[check-time (ratio (/ check-time 1000) time)]
[validate-time (ratio (/ validate-time 1000) time)]
[iter-count iter-count]
[validate-count (ratio validate-count iter-count)]
[correct-count (ratio correct-count iter-count)]
[accept-count (ratio accept-count iter-count)]
[accept-higher-count (ratio accept-higher-count iter-count)]
;[misalign-count (ratio misalign-count iter-count)]
[propose-stat propose-stat]
[accept-stat accept-stat]
[best-correct-program #f]
[best-correct-time best-correct-time]
[best-correct-cost best-correct-cost]
[best-cost best-cost]))
(send stat print-stat))
(define (create-stat-from-file file printer)
(define in-port (open-input-file file))
(define stat-mutations (get-field report-mutations printer))
(define n (vector-length stat-mutations))
(define id #f)
(define time #f)
(define mutate-time #f)
(define simulate-time #f)
(define check-time #f)
(define validate-time #f)
(define iter-count #f)
(define validate-count #f)
(define correct-count #f)
;(define misalign-count #f)
(define accept-count #f)
(define accept-higher-count #f)
(define propose-stat (make-vector n))
(define accept-stat (make-vector n))
(define best-correct-cost #f)
(define best-correct-time #f)
(define best-correct-id #f)
(define best-cost #f)
(define (parse)
(define line (read-line in-port))
(unless (equal? eof line)
(define tokens (string-split line))
;(pretty-display `(tokens ,tokens))
(define-syntax-rule (pattern (a b) ...)
(cond
[(< (length tokens) 2) #f]
[(regexp-match a (car tokens)) (set! b (string->number (second tokens)))]
...
[(vector-member (string->symbol (car tokens)) stat-mutations)
(let ([index (vector-member (string->symbol (car tokens)) stat-mutations)])
(vector-set! propose-stat index (string->number (list-ref tokens 1)))
(vector-set! accept-stat index (string->number (list-ref tokens 2))))]
))
(pattern (#rx"elapsed-time" time)
(#rx"mutate-time" mutate-time)
(#rx"simulate-time" simulate-time)
(#rx"check-time" check-time)
(#rx"validate-time" validate-time)
(#rx"iterations:" iter-count)
(#rx"validate-count:" validate-count)
(#rx"correct-count:" correct-count)
;(#rx"misalign-count:" misalign-count)
(#rx"accept-count:" accept-count)
(#rx"accept-higher-count:" accept-higher-count)
(#rx"best-cost" best-cost)
(#rx"best-correct-cost" best-correct-cost)
(#rx"best-correct-time" best-correct-time))
(parse)))
(parse)
(close-input-port in-port)
;; (pretty-display `(validate-count ,validate-count))
;; (pretty-display `(correct-count ,correct-count))
;; (pretty-display `(misalign-count ,misalign-count))
(new stat%
[printer printer]
[time time]
[mutate-time mutate-time]
[simulate-time simulate-time]
[check-time check-time]
[validate-time validate-time]
[iter-count iter-count]
[validate-count validate-count]
[correct-count correct-count]
;[misalign-count misalign-count]
[accept-count accept-count]
[accept-higher-count accept-higher-count]
[propose-stat propose-stat]
[accept-stat accept-stat]
[best-correct-program #f]
[best-correct-time best-correct-time]
[best-correct-cost best-correct-cost]
[best-cost best-cost]))
(define (get-best-info dir)
(define info-file (format "~a/best.info" dir))
;; (pretty-display `(get-best-info ,info-file ,(file-exists? info-file)))
(if (file-exists? info-file)
(with-handlers*
([exn?
(lambda (e) (values #f #f #f #f))])
(let* ([in-port (open-input-file info-file)]
[cost (read-line in-port)]
[len (read-line in-port)]
[time (read-line in-port)]
[id (read-line in-port)])
(close-input-port in-port)
(values (string->number cost) (string->number len) time id)))
(values #f #f #f #f)))