[icfp] update benchmarks with define: fix

This commit is contained in:
ben 2016-03-14 20:54:37 -04:00
parent 38d79619f0
commit 0294535670
16 changed files with 72 additions and 58 deletions

View File

@ -43,9 +43,9 @@
;; -----------------------------------------------------------------------------
(: COOPERATE State)
(define: COOPERATE 0)
(define COOPERATE 0)
(: DEFECT State)
(define: DEFECT 1)
(define DEFECT 1)
(define-type State Natural)
(define-type Transition* [Vectorof Transition])
@ -160,7 +160,7 @@
;; -----------------------------------------------------------------------------
;; PayoffTable = [Vectorof k [Vectorof k (cons Payoff Payoff)]]
(: PAYOFF-TABLE [Vectorof [Vectorof (cons Payoff Payoff)]])
(define: PAYOFF-TABLE
(define PAYOFF-TABLE
(vector (vector (cons 3 3) (cons 0 4))
(vector (cons 4 0) (cons 1 1))))

View File

@ -39,7 +39,7 @@
;; Population = (Cons Automaton* Automaton*)
;; Automaton* = [Vectorof Automaton]
(define: DEF-COO 2)
(define DEF-COO 2)
;; -----------------------------------------------------------------------------
(define (build-random-population n)

View File

@ -23,24 +23,24 @@
;; =============================================================================
(: NS/SECOND Natural)
(define: NS/SECOND 1000000000)
(define NS/SECOND 1000000000)
(: NS/MILLI Natural)
(define: NS/MILLI 1000000)
(define NS/MILLI 1000000)
;; (define NS/MILLI (/ NS/SECOND 1000))
(: NS/MICRO Natural)
(define: NS/MICRO 1000)
(define NS/MICRO 1000)
;; (define NS/MICRO (/ NS/MILLI 1000))
(: NS/MINUTE Natural)
(define: NS/MINUTE (* NS/SECOND 60))
(define NS/MINUTE (* NS/SECOND 60))
(: NS/HOUR Natural)
(define: NS/HOUR (* NS/MINUTE 60))
(define NS/HOUR (* NS/MINUTE 60))
(: NS/DAY Natural)
(define: NS/DAY (* 86400 NS/SECOND))
(define NS/DAY (* 86400 NS/SECOND))
(: MILLI/DAY Natural)
(define: MILLI/DAY 86400000)
(define MILLI/DAY 86400000)
;; (define MILLI/DAY (/ NS/DAY NS/MILLI))
(: DAYS/NS Exact-Rational)
(define: DAYS/NS (/ 1 NS/DAY))
(define DAYS/NS (/ 1 NS/DAY))
;; (define day-ns/c (integer-in 0 (sub1 NS/DAY)))
;; Codomain of hmsn->day-ns should be a day-ns/c

View File

@ -231,13 +231,13 @@
52]))
(: DAYS-PER-MONTH (Vector 0 31 28 31 30 31 30 31 31 30 31 30 31))
(define: DAYS-PER-MONTH
(define DAYS-PER-MONTH
(vector 0 31 28 31 30 31 30 31 31 30 31 30 31))
(: CUMULATIVE-MONTH-DAYS (Vector 0 31 59 90 120 151 181 212 243 273 304 334))
(define: CUMULATIVE-MONTH-DAYS
(define CUMULATIVE-MONTH-DAYS
(vector 0 31 59 90 120 151 181 212 243 273 304 334))
(: CUMULATIVE-MONTH-DAYS/LEAP (Vector 0 31 60 91 121 152 182 213 244 274 305 335))
(define: CUMULATIVE-MONTH-DAYS/LEAP
(define CUMULATIVE-MONTH-DAYS/LEAP
(vector 0 31 60 91 121 152 182 213 244 274 305 335))

View File

@ -1,5 +1,5 @@
#lang typed/racket/base
(require (except-in trivial/no-colon set!))
(require trivial/no-colon)
;; bg: removed XML and TxExprs from the original; this only works on strings now
@ -43,15 +43,15 @@
;; bg: changed default from #f
;; module data, define now but set! them later (because they're potentially big & slow)
(: patterns (HashTable String (Listof Index)))
(define patterns (make-hash))
(define patterns hashed-patterns)
(: pattern-cache (HashTable String (Listof Index)))
(define pattern-cache (make-hash))
;; module default values
(define: default-min-length 5)
(define: default-min-left-length 2)
(define: default-min-right-length 2)
(define: default-joiner #\u00AD)
(define default-min-length 5)
(define default-min-left-length 2)
(define default-min-right-length 2)
(define default-joiner #\u00AD)
;; bg: from racket docs http://docs.racket-lang.org/reference/hashtables.html?q=hash-empty#%28def._%28%28lib._racket%2Fprivate%2Fbase..rkt%29._hash-empty~3f%29%29
(define-syntax-rule (hash-empty? hash)
@ -65,9 +65,7 @@
(define (initialize-patterns)
(when (hash-empty? pattern-cache)
(for ([e default-exceptions])
(add-exception (symbol->string e))))
(when (hash-empty? patterns)
(set! patterns hashed-patterns)))
(add-exception (symbol->string e)))))
;; Convert the hyphenated pattern into a point array for use later.
(: add-exception (-> String Void))

View File

@ -1,4 +1,4 @@
#lang racket/base
#lang typed/racket/base
(require trivial/no-colon)
(require "hyphenate.rkt" typed/rackunit)
@ -20,6 +20,12 @@
(check-equal? (hyphenate "polymorphism" #\- #:min-left-length 7 #:min-right-length 7) "polymorphism")
(check-equal? (hyphenate "polymorphism" #\* #:exceptions '("polymo-rphism")) "polymo*rphism")
(check-equal? (hyphenate "formidable" #\-) "for-mi-da-ble"))
(check-equal? (hyphenate "formidable" #\-) "for-mi-da-ble")
(with-input-from-file "../base/common-words.rktd"
(lambda ()
(for ([word (in-lines)])
(hyphenate word))))
)
(time (main))

View File

@ -42,7 +42,7 @@
;; bg: changed default from #f
;; module data, define now but set! them later (because they're potentially big & slow)
(: patterns (HashTable String (Listof Index)))
(define patterns (make-hash))
(define patterns hashed-patterns)
(: pattern-cache (HashTable String (Listof Index)))
(define pattern-cache (make-hash))
@ -64,9 +64,7 @@
(define (initialize-patterns)
(when (hash-empty? pattern-cache)
(for ([e default-exceptions])
(add-exception (symbol->string e))))
(when (hash-empty? patterns)
(set! patterns hashed-patterns)))
(add-exception (symbol->string e)))))
;; Convert the hyphenated pattern into a point array for use later.
(: add-exception (-> String Void))

View File

@ -19,6 +19,12 @@
(check-equal? (hyphenate "polymorphism" #\- #:min-left-length 7 #:min-right-length 7) "polymorphism")
(check-equal? (hyphenate "polymorphism" #\* #:exceptions '("polymo-rphism")) "polymo*rphism")
(check-equal? (hyphenate "formidable" #\-) "for-mi-da-ble"))
(check-equal? (hyphenate "formidable" #\-) "for-mi-da-ble")
(with-input-from-file "../base/common-words.rktd"
(lambda ()
(for ([word (in-lines)])
(hyphenate word))))
)
(time (main))

View File

@ -216,9 +216,6 @@
(define b (car (cdddr d)))
(cons (car b) (cadr b)))
(define (rnd n)
(~r n #:precision '2))
(define (diff x)
(define b4 (car x))
(define after (cdr x))

View File

@ -433,11 +433,11 @@
;; For parsing nodes:
;; \node (ID) [pos]? {\rkt{ID}{NAME}};
(define: NODE_REGEXP
#rx"^\\\\node *\\(([0-9]+)\\) *(\\[.*\\]) *\\{\\\\rkt\\{([0-9]+)\\}\\{(.+)\\}\\};$")
(define NODE_REGEXP
#rx"^\\\\node *\\(([0-9]+)\\) *(\\[.*\\])? *\\{\\\\rkt\\{([0-9]+)\\}\\{(.+)\\}\\};$")
;; For parsing edges
;; \draw[style]? (ID) edge (ID);
(define: EDGE_REGEXP
(define EDGE_REGEXP
#rx"^\\\\draw\\[.*\\]? *\\(([0-9]+)\\)[^(]*\\(([0-9]+)\\);$")
;; Parsing
@ -456,11 +456,14 @@
(: string->texnode (-> String texnode))
(define (string->texnode str)
(define m (regexp-match NODE_REGEXP str))
(if m
(texnode (string->index (cadr m))
(string->index (cadddr m))
(cadr (cdddr m)))
(parse-error "Cannot parse node declaration '~a'" str)))
(match m
[(list _ id _ index name)
#:when (and id index name)
(texnode (or (string->index id) (parse-error "Could not parse integer from node id '~a'" id))
(or (string->index index) (parse-error "Could not parse integer from node index '~a'" index))
name)]
[else
(parse-error "Cannot parse node declaration '~a'" str)]))
;; Parse a string into a tex edge.
;; Edges are represented as cons pairs of their source and destination.
@ -468,11 +471,14 @@
(: string->texedge (-> String texedge))
(define (string->texedge str)
(define m (regexp-match EDGE_REGEXP str))
(if m
(cons
(string->index (cadr m))
(string->index (caddr m)))
(parse-error "Cannot parse edge declaration '~a'" str)))
(match m
[(list _ id-src id-dst)
#:when (and id-src id-dst)
((inst cons Index Index)
(string->index id-src)
(string->index id-dst))]
[else
(parse-error "Cannot parse edge declaration '~a'" str)]))
;; Convert nodes & edges parsed from a .tex file to a modulegraph struct
(: texnode->modulegraph (-> String (Listof texnode) (Listof texedge) ModuleGraph))
@ -548,7 +554,7 @@
acc))
acc)))
(define RX-REQUIRE: #rx"require.*\"(.*)\\.rkt\"")
(define RX-REQUIRE #rx"require.*\"(.*)\\.rkt\"")
;; Sort an adjacency list in order of transitive indegree, increasing.
;; Results are grouped by indegree, i.e.

View File

@ -21,7 +21,7 @@
;;; @end legal
#lang typed/racket/base
(require (except-in trivial/no-colon set!))
(require trivial/no-colon)
;;; @section Introduction
;;;
@ -79,19 +79,19 @@
((zero? b-len) a-len)
(else
(let: ((w : (Vectorof Index) (get-scratch (+ 1 b-len)))
(next : Index 0)) ;;bg changed from #f
(next : (Boxof Index) (box 0))) ;;bg changed from #f
(let fill ((k b-len))
(unless (index? k) (error "vl/p/g invariant error"))
(vector-set! w k k)
(or (zero? k) (fill (- k 1))))
(let loop-i ((i 0))
(if (= i a-len)
next
(unbox next)
(let ((a-i (vector-ref a i)))
(let loop-j ((j 0)
(cur (+ 1 i)))
(if (= j b-len)
(begin (vector-set! w b-len next)
(begin (vector-set! w b-len (unbox next))
(loop-i (+ 1 i)))
;; TODO: Make these costs parameters.
(let ((next* (min (+ 1 (vector-ref w (+ 1 j)))
@ -101,10 +101,10 @@
(vector-ref w j)
(+ 1 (vector-ref w j))))))
(unless (index? next*) (error "invariant"))
(set! next next*)
(set-box! next next*)
(unless (index? cur) (error "invariant error"))
(vector-set! w j cur)
(loop-j (+ 1 j) next))))))))))))
(loop-j (+ 1 j) (unbox next)))))))))))))
;;; @defproc vector-levenshtein/predicate a b pred
;;; @defprocx vector-levenshtein/eq a b

View File

@ -87,7 +87,8 @@
(for/list: : (Listof (Pair Char String))
([l : String lines])
(match
(regexp-match #px"^\\| \\{\\{[^|]*\\|[^|]*\\|(.)\\}\\} \\|\\| '''([^']*)'''" l)
(ann (regexp-match #px"^\\| \\{\\{[^|]*\\|[^|]*\\|(.)\\}\\} \\|\\| '''([^']*)'''" l)
(U False (Pairof String (Listof (U False String)))))
[#f
(match
(regexp-match #px"^\\| \\[\\[[^]]*\\]\\] \\[([^]]*)\\] \\|\\| '''([^']*)'''" l)

View File

@ -1,5 +1,6 @@
#lang typed/racket/base
(require trivial/no-colon)
(provide
(struct-out label)
(struct-out suffix-tree)

View File

@ -122,7 +122,7 @@
;; Gets a slice of the label on the half-open interval [i, j)
(: sublabel (case-> (-> label Index label)
(-> label Index Index label)))
(define sublabel
(define-values (sublabel)
(case-lambda
((label i)
(sublabel label i (label-length label)))
@ -137,7 +137,7 @@
;; destructively sets the input label to sublabel.
(: sublabel! (case-> (-> label Index Void)
(-> label Index Index Void)))
(define sublabel!
(define-values (sublabel!)
(case-lambda
((label i)
(sublabel! label i (label-length label)))

View File

@ -1,5 +1,6 @@
#lang typed/racket/base
(require trivial/no-colon)
(require (only-in racket/fixnum fx<= fxmax fxmodulo)
(only-in racket/string string-join)
(only-in racket/list empty? first rest)

View File

@ -30,7 +30,7 @@
(: ds* In-Indexes)
(define ds* (vector n-samples))
(: ds Indexes)
(define ds
(define-values (ds)
(check-array-shape ds*
(λ () (raise-argument-error 'name "Indexes" ds))))
(: vs (Vectorof Flonum))