Browse files

Added a web demo in herbie/reports/demo

+ Spawns a web server that serves /www
+ That server's /demo/ allows users to submit Herbie formulas
+ I'm not yet doing proper error handling or security or anything
  • Loading branch information...
pavpanchekha committed May 20, 2015
1 parent fcae2a5 commit f2e7def3960f1faeca8881e5e3f20f9889dac41f
@@ -6,7 +6,7 @@
(require "debug.rkt")
(provide reap define-table println ordinary-float? =-or-nan?
enumerate take-up-to argmins list-product alist-append
enumerate take-up-to argmins list-product alist-append list-join
pipe ulp-difference *bit-width* ulps->bits
write-file write-string has-duplicates?
symbol<? *start-prog*
@@ -231,3 +231,9 @@
(define (log2 x)
(/ (log x) (log 2)))
(define (list-join l1 l2)
(match l1
['() '()]
[(list but-last1 ... last1)
(append (append-map (curryr cons l2) but-last1) (list last1))]))
@@ -3,7 +3,9 @@
(require "../common.rkt")
(require "../syntax.rkt")
(provide texify-expression)
(provide texify-expression mathjax-url)
(define mathjax-url "")
(define-table texify-constants
[l "\\ell"]
@@ -4,6 +4,7 @@
(provide (all-defined-out))
(define-runtime-path report-output-path "../graphs/")
(define-runtime-path demo-output-path "../www/demo/")
(define-runtime-path benchmark-path "../bench/")
;; Flag Stuff
@@ -28,7 +28,7 @@
(name status start result target inf- inf+ result-est vars input output time bits link) #:prefab)
(struct report-info
(date commit branch seed flags points iterations bit-width note tests) #:prefab)
(date commit branch seed flags points iterations bit-width note tests) #:prefab #:mutable)
(define (make-report-info tests #:note [note ""])
(report-info (current-date)
@@ -71,9 +71,7 @@
(commit . ,commit)
(branch . ,branch)
(seed . ,(~a seed))
(flags .
,(for*/list ([rec (hash->list flags)] [fl (cdr rec)])
(format "~a:~a" (car rec) fl)))
(flags . ,(flags->list flags))
(points . ,points)
(iterations . ,iterations)
(bit_width . ,bit-width)
@@ -82,6 +80,17 @@
(call-with-output-file file (curry write-json data) #:exists 'replace))
(define (flags->list flags)
(for*/list ([rec (hash->list flags)] [fl (cdr rec)])
(format "~a:~a" (car rec) fl)))
(define (list->flags list)
(for/list ([part (multipartition
(map (compose (curry map string->symbol) (curryr string-split ":")) list)
(cons (car (first part)) (map cadr part)))))
(define (read-datafile file)
(define (parse-string s)
(if s
@@ -91,12 +100,13 @@
(let* ([json (call-with-input-file file read-json)]
[get (λ (field) (hash-ref json field))])
(report-info (seconds->date (get 'date)) (get 'commit) (get 'branch) (get 'seed)
(get 'flags) (get 'points) (get 'iterations) (hash-ref json 'bit_width 64)
(list->flags (get 'flags)) (get 'points) (get 'iterations) (hash-ref json 'bit_width 64)
(hash-ref json 'note #f)
(for/list ([test (get 'tests)])
(let ([get (λ (field) (hash-ref test field))])
; TODO: ignoring the result-est
(table-row (get 'name) (get 'status) (get 'start) (get 'end) (get 'target)
(get 'ninf) (get 'pinf) (hash-ref json 'end-est 0)
(get 'vars) (parse-string (get 'input)) (parse-string (get 'output))
(map string->symbol (get 'vars))
(parse-string (get 'input)) (parse-string (get 'output))
(get 'time) (get 'bits) (get 'link)))))))
@@ -0,0 +1,105 @@
#lang racket
(require openssl/md5)
(require xml)
(require web-server/servlet web-server/servlet-env web-server/dispatch web-server/page)
(require "thread-pool.rkt" "datafile.rkt" "make-graph.rkt" "make-report.rkt")
(require "../compile/tex.rkt")
(require "../common.rkt" "../config.rkt" "../programs.rkt" "../test.rkt")
(define/page (demo)
(when (not (directory-exists? demo-output-path))
(make-directory demo-output-path))
#:title "Herbie web demo"
`(p "Enter a formula below, and Herbie will try to improve it.")
`(form ([action ,(embed/url improve)] [method "post"] [id "formula"])
(input ((name "formula"))))
`(p "Note: all formulas submitted to the Herbie web demo are logged "
"and made publicly accessible. See what formulas other users submitted "
(a ([href "./report.html"]) "here") ".")
`(p "Supported functions:")
`(dl ([class "function-list"])
(dt ,@(list-join (for/list ([i '(+ - * / abs)]) `(code ,(~a i))) '(", ")))
(dd "The usual arithmetic functions")
(dt ,@(list-join (for/list ([i '(sqrt sqr)]) `(code ,(~a i))) '(", ")))
(dd "Squares and square roots")
(dt ,@(list-join (for/list ([i '(exp log)]) `(code ,(~a i))) '(", ")))
(dd "Natural exponent and natural log")
(dt ,@(list-join (for/list ([i '(expt)]) `(code ,(~a i))) '(", ")))
(dd "Raising a value to a power")
(dt ,@(list-join (for/list ([i '(sin cos tan cot)]) `(code ,(~a i))) '(", ")))
(dd "The trigonometric functions")
(dt ,@(list-join (for/list ([i '(asin acos atan)]) `(code ,(~a i))) '(", ")))
(dd "The inverse trigonometric functions")
(dt ,@(list-join (for/list ([i '(sinh cosh tanh)]) `(code ,(~a i))) '(", ")))
(dd "The hyperbolic trigonometric functions")))))
(define (herbie-page #:title title #:scripts [scripts '()] . body)
(meta ([charset "utf-8"]))
(title ,title)
,@(for/list ([script scripts])
`(script ([src ,script] [type "text/javascript"])))
(link ([rel "stylesheet"] [type "text/css"] [href "/main.css"])))
(img ([class "logo"] [src "/logo.png"]))
(h1 ,title)
(p "See " (a ([href "/index.html"]) "the main page") " for more info on Herbie."))
(define/page (improve)
(match (get-bindings 'formula)
[(list formula-str)
(match-define `(lambda ,vars ,body) (read (open-input-string formula-str)))
(define hash (md5 (open-input-string formula-str)))
(define dir (build-path demo-output-path hash))
(when (not (directory-exists? dir))
(make-directory dir)
(define result
(parameterize ([*timeout* (* 1000 60)] [*reeval-pts* 1000])
(get-test-result (test "User test" vars (map (const 'default) vars) body #f) dir)))
(define make-page
(cond [(test-result? result) make-graph]
[(test-timeout? result) make-timeout]
[(test-failure? result) make-traceback]))
(with-output-to-file (build-path dir "graph.html")
(λ () (make-page result #f)))
(define data (get-table-data result))
; Save new report data
(define info
(if (file-exists? (build-path demo-output-path "results.json"))
(let ([info (read-datafile (build-path demo-output-path "results.json"))])
(set-report-info-tests! info (cons data (report-info-tests info)))
(make-report-info (list data) #:note "Web demo results")))
(write-datafile (build-path demo-output-path "results.json") info)
(make-report-page (build-path demo-output-path "report.html") info))
(redirect-to (format "/demo/~a/graph.html" hash) see-other)]
(response/error "Demo Error"
`(p "You didn't specify a formula (or you specified serveral). "
"Please " (a ([href ,(embed/url demo)]) "go back") " and try again."))]))
(define (response/error title body)
(response/full 400 #"Bad Request" (current-seconds) TEXT/HTML-MIME-TYPE '()
(xexpr->string (herbie-page #:title title body))))
(define (go)
#:listen-ip #f
#:banner? #f
#:servlets-root (build-path demo-output-path "../..")
#:servlet-path "/demo/"
#:extra-files-paths (list (build-path demo-output-path ".."))))
(module+ main
@@ -2,7 +2,8 @@ body { width: 1200px; margin: 1em auto; font-family: sans; }
#about { float: left; width: 400px; }
#graphs { width: 400px; }
#graphs figure { margin: 0; }
#graphs figure { margin: 1em 0; }
#graphs figcaption { text-align: center; }
#details { width: 800px; float: right; }
#output { margin: 2em 0; text-align: center; }
@@ -27,7 +27,6 @@
[(and (r . > . 0) sign) (format "+~a" (/ (round (* r 10)) 10))]
[else (format "~a" (/ (round (* r 10)) 10))]))
(define (make-graph result profile?)
(match result
[(test-result test rdir time bits start-alt end-alt points exacts
@@ -45,7 +44,7 @@
(printf "<section id='about'>\n")
(printf "<div>\\[\\large~a\\]</div>\n"
(printf "<div>\\[~a\\]</div>\n"
(texify-expression (program-body (alt-program start-alt))))
(printf "<dl id='kv'>\n")
@@ -55,7 +54,7 @@
(printf "<div id='graphs'>\n")
(for ([var (test-vars test)] [idx (in-naturals)])
(call-with-output-file (build-path report-output-path rdir (format "plot-~a.png" idx)) #:exists 'replace
(call-with-output-file (build-path rdir (format "plot-~a.png" idx)) #:exists 'replace
(lambda (out)
#:port out #:kind 'png
@@ -67,8 +67,7 @@
; Scripts: the report script, MathJax, D3, and graph-drawing code
(printf "<script src='report.js'></script>\n")
(printf "<script src='~a'></script>" ; MathJax URL for prettifying programs
(printf "<script src='~a'></script>" mathjax-url)
(printf "<script src='' charset='utf-8'></script>\n")
(printf "<script type='text/javascript' src='graph.js'></script>\n")
(printf "</head>\n")
@@ -14,15 +14,15 @@
(require "datafile.rkt")
(require "../interface/interact.rkt")
(provide get-test-results)
(provide get-test-results get-test-result get-table-data *reeval-pts* *timeout* *seed*)
(define *reeval-pts* 8000)
(define *seed* #f)
(define *timeout* (* 1000 60 10))
(define *reeval-pts* (make-parameter 8000))
(define *seed* (pseudo-random-generator->vector (current-pseudo-random-generator)))
(define *timeout* (make-parameter (* 1000 60 10)))
(define *profile?* #f)
(define (get-test-result test rdir)
(define (file name) (build-path report-output-path rdir name))
(define (file name) (build-path rdir name))
; Reseed random number generator
(current-pseudo-random-generator (vector->pseudo-random-generator *seed*))
@@ -54,12 +54,12 @@
(compute-result test)))
(let* ([start-time (current-inexact-milliseconds)] [eng (engine in-engine)])
(engine-run *timeout* eng)
(engine-run (*timeout*) eng)
(match (engine-result eng)
[`(good ,start ,end ,context)
(define newcontext
(parameterize ([*num-points* *reeval-pts*])
(parameterize ([*num-points* (*reeval-pts*)])
(prepare-points (alt-program start) (test-samplers test))))
(match-define (list newpoints newexacts) (get-p&es newcontext))
(match-define (list points exacts) (get-p&es context))
@@ -97,7 +97,8 @@
[est-end-score (errors-score (test-result-end-est-error result))])
(let*-values ([(reals infs) (partition ordinary-float? (map - end-errors start-errors))]
[(good-inf bad-inf) (partition positive? infs)])
[(good-inf bad-inf) (partition positive? infs)]
[(link) (path-element->string (last (explode-path (test-result-rdir result))))])
(table-row name
(if target-score
@@ -122,15 +123,17 @@
(program-body (alt-program (test-result-end-alt result)))
(test-result-time result)
(test-result-bits result)
(test-result-rdir result))))]
[(test-failure? result)
(define link (path-element->string (last (explode-path (test-result-rdir result)))))
(table-row (test-name (test-failure-test result)) "crash"
#f #f #f #f #f #f #f (test-input (test-failure-test result)) #f
(test-failure-time result) (test-failure-bits result) (test-failure-rdir result))]
(test-failure-time result) (test-failure-bits result) link)]
[(test-timeout? result)
(define link (path-element->string (last (explode-path (test-result-rdir result)))))
(table-row (test-name (test-timeout-test result)) "timeout"
#f #f #f #f #f #f #f (test-input (test-timeout-test result)) #f
*timeout* (test-timeout-bits result) (test-timeout-rdir result))]))
(*timeout*) (test-timeout-bits result) link)]))
(define (make-graph-if-valid result tname index rdir)
(let* ([dir (build-path report-output-path rdir)])
@@ -156,7 +159,7 @@
(when (not (directory-exists? rdir*))
(make-directory rdir*))
(let ([result (get-test-result test rdir)])
(let ([result (get-test-result test rdir*)])
(make-graph-if-valid result (test-name test) index rdir)
(get-table-data result))))
@@ -26,24 +26,25 @@ <h1>Herbie</h1>
<div class="column-container">
<li><a href="/demo/">Web demo</a></li>
<li><a href="installing.html">Install</a></li>
<li><a href="">Read License</a></li>
<li><a href="tutorial.html">Tutorial</a></li>
<li><a href="pldi15-herbie.pdf">Read the Paper</a></li>
<li><a href="pldi15-herbie.pdf">PLDI'15 Paper</a></li>
<li><a href="">Join our List</a></li>
<li><a href="">Read Source</a></li>
<li><a href="">Mailing List</a></li>
<li><a href="">Source Code</a></li>
<li><a href="">License</a></li>
@@ -99,6 +100,8 @@ <h2>Blog posts about Herbie</h2>
<h2>Presentations about Herbie</h2>
<li><em>Automatically improving accuracy for floating point expressions</em>.<br/>
Talk given at Berkeley on 9 April 2015.</li>
<li><a href="">Casio: automatically improving floating-point code</a>.<br/>
Talk given at OPLSS on 17 June 2014.</li>
<li><a href="">What the Float‽ And what are we planning to do about it?</a>.<br/>
@@ -15,7 +15,7 @@ p, li, dd, blockquote, figcaption {
figcaption {font-size: 14px; line-height: 1.1;}
header {margin: 2em 0 1.5em 0; height: 60px;}
header {margin: 2em 0 2em 0; height: 60px;}
header h1 {margin: .5em 0 0 0; font-size: 16pt;}
header p {font-size: 14pt; margin: .5em 0 0 0;}
header img {float: left; width: 20%; margin: -3em 2em 0 0;}
@@ -26,7 +26,7 @@ header img {float: left; width: 20%; margin: -3em 2em 0 0;}
.author-list li:last-child:after {content: ""}
svg {margin: 0 auto; display: block;}
pre, dt {padding-left: 2.5em; font-size: 16px; font-family: monospace; background-color: #f1f1f1;}
pre {padding-left: 2.5em; font-size: 16px; font-family: monospace; background-color: #f1f1f1;}
div.column-container > div {width: 25%; float: left; padding: 0 4%}
div.column-container > div > h3 {margin: auto 10px}
@@ -35,3 +35,8 @@ div.column-container > div > ul {list-style: inside none; margin: 0; padding: 0;
ul {padding-left: 1em;}
a {color: #2A6496; text-decoration: none}
a:hover {text-decoration: underline; color: #295785}
#formula input { width: 100%; font-size: 125%; }
.function-list dt { font-weight: bold; float: left; width: 200px; clear: left; padding-left: 25px; }
.function-list dd { clear: right; }

0 comments on commit f2e7def

Please sign in to comment.