Permalink
Browse files

Much faster re-evaluation

  • Loading branch information...
pavpanchekha committed May 30, 2014
1 parent 2c007c6 commit f0bf35df03acd440e5902e5879195820d8e05add
Showing with 26 additions and 12 deletions.
  1. +24 −9 casio/points.rkt
  2. +2 −1 reports/make-graph.rkt
  3. +0 −2 reports/make-report.rkt
View
@@ -33,9 +33,29 @@
[neg-ticks (- num-ticks pos-ticks)]
[first (append (select-points pos-ticks)
(map - (select-points neg-ticks)))])
(apply append
(for/list ([rest (make-points rest-num (- dim 1))])
(map (λ (x) (cons x rest)) first))))))
(sort
(apply append
(for/list ([rest (make-points rest-num (- dim 1))])
(map (λ (x) (cons x rest)) first)))
< #:key car))))
(define (make-exacts* f pts start-prec inc-prec prev)
(bf-precision start-prec)
(let loop ([pts pts] [new (map f pts)] [prev prev] [good '()] [bad '()])
(cond
[(null? pts)
(let* ([bad-pts (map car bad)] [bad-ans (map cdr bad)]
[new-ans
(if (null? bad-pts)
'()
(make-exacts* f bad-pts (+ start-prec inc-prec) inc-prec bad-ans))])
(map cdr (sort (append good (map cons bad-pts new-ans)) < #:key caar)))]
[(and (car prev) (or (and (nan? (car prev)) (nan? (car new))) (= (car prev) (car new))))
(loop (cdr pts) (cdr new) (cdr prev)
(cons (cons (car pts) (car new)) good) bad)]
[else
(loop (cdr pts) (cdr new) (cdr prev)
good (cons (cons (car pts) (car new)) bad))])))
(define (make-exacts prog pts)
"Given a list of arguments,
@@ -44,12 +64,7 @@
available until the exact values converge.
Not guaranteed to terminate."
(let ([f (eval-prog prog mode:bf)])
(let loop ([prec 64] [prev #f])
(bf-precision prec)
(let ([curr (map f pts)])
(if (list= prev curr)
curr
(loop (+ prec 16) curr))))))
(make-exacts* f pts 64 16 (map (const #f) pts))))
(define (filter-points pts exacts)
"Take only the points for which the exact value is normal"
View
@@ -128,7 +128,8 @@
(printf "<body>\n")
(printf "<div id='graphs'>\n")
(printf "~a\n" (make-graph-svg (append pre-error-lines post-error-lines) 0 0 800 400))
(when (not (and (null? pre-error-lines) (null? post-error-lines)))
(printf "~a\n" (make-graph-svg (append pre-error-lines post-error-lines) 0 0 800 400)))
(printf "</div>\n")
(printf "<ol id='process-info'>\n")
(output-history end)
View
@@ -1,6 +1,5 @@
#lang racket
(require racket/match)
(require racket/date)
(require reports/make-graph)
(require reports/tools-common)
@@ -16,7 +15,6 @@
(provide (all-defined-out))
(define *graph-folder-name-length* 8)
(define *handle-crashes* #t)
(define *output-directory* "graphs")
(define *reeval-pts* 1000)

0 comments on commit f0bf35d

Please sign in to comment.