[icfp] update benchmarks with define: fix
This commit is contained in:
parent
38d79619f0
commit
0294535670
|
@ -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))))
|
||||
|
||||
|
|
|
@ -39,7 +39,7 @@
|
|||
;; Population = (Cons Automaton* Automaton*)
|
||||
;; Automaton* = [Vectorof Automaton]
|
||||
|
||||
(define: DEF-COO 2)
|
||||
(define DEF-COO 2)
|
||||
|
||||
;; -----------------------------------------------------------------------------
|
||||
(define (build-random-population n)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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.
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -1,5 +1,6 @@
|
|||
#lang typed/racket/base
|
||||
(require trivial/no-colon)
|
||||
|
||||
(provide
|
||||
(struct-out label)
|
||||
(struct-out suffix-tree)
|
||||
|
|
|
@ -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)))
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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))
|
||||
|
|
Loading…
Reference in New Issue
Block a user