Updated some of the typed benchmarks.

This commit is contained in:
Vincent St-Amour 2010-05-11 13:22:35 -04:00 committed by Vincent St-Amour
parent e90e37ec62
commit fb09e9da23
2 changed files with 186 additions and 184 deletions

View File

@ -1,5 +1,6 @@
;;; NQUEENS -- Compute number of solutions to 8-queens problem. ;;; NQUEENS -- Compute number of solutions to 8-queens problem.
;; 2006/08 -- renamed `try' to `try-it' to avoid Bigloo collision (mflatt) ;; 2006/08 -- renamed `try' to `try-it' to avoid Bigloo collision (mflatt)
;; 2010/04 -- got rid of the one-armed id (stamourv)
(module nqueens-typed typed/scheme (module nqueens-typed typed/scheme

View File

@ -1,197 +1,198 @@
;;; PARAFFINS -- Compute how many paraffins exist with N carbon atoms. ;;; PARAFFINS -- Compute how many paraffins exist with N carbon atoms.
(module paraffins-typed typed/scheme #lang typed/scheme/base
(define-type Radical (Rec Radical (U 'C 'H 'BCP 'CCP (Vectorof Radical)))) (require/typed scheme/base (collect-garbage ( -> Void)))
(: gen (Integer -> (Vectorof (Listof Radical))))
(define (gen n)
(let*: ((n/2 : Integer (quotient n 2))
(radicals : (Vectorof (Listof Radical)) (make-vector (+ n/2 1) '(H))))
(: rads-of-size (Integer -> (Listof Radical))) (define-type Radical (Rec Radical (U 'C 'H 'BCP 'CCP (Vectorof Radical))))
(define (rads-of-size n)
(let: loop1 : (Listof Radical)
((ps : (Listof (Vectorof Integer))
(three-partitions (- n 1)))
(lst : (Listof Radical)
'()))
(if (null? ps)
lst
(let* ((p (car ps))
(nc1 (vector-ref p 0))
(nc2 (vector-ref p 1))
(nc3 (vector-ref p 2)))
(let: loop2 : (Listof Radical)
((rads1 : (Listof Radical)
(vector-ref radicals nc1))
(lst : (Listof Radical)
(loop1 (cdr ps)
lst)))
(if (null? rads1)
lst
(let: loop3 : (Listof Radical)
((rads2 : (Listof Radical)
(if (= nc1 nc2)
rads1
(vector-ref radicals nc2)))
(lst : (Listof Radical)
(loop2 (cdr rads1)
lst)))
(if (null? rads2)
lst
(let: loop4 : (Listof Radical)
((rads3 : (Listof Radical)
(if (= nc2 nc3)
rads2
(vector-ref radicals nc3)))
(lst : (Listof Radical)
(loop3 (cdr rads2)
lst)))
(if (null? rads3)
lst
(cons (vector 'C
(car rads1)
(car rads2)
(car rads3))
(loop4 (cdr rads3)
lst))))))))))))
(: bcp-generator (Integer -> (Listof Radical))) (: gen (Integer -> (Vectorof (Listof Radical))))
(define (bcp-generator j) (define (gen n)
(if (odd? j) (let*: ((n/2 : Integer (quotient n 2))
'() (radicals : (Vectorof (Listof Radical)) (make-vector (+ n/2 1) '(H))))
(let: loop1 : (Listof Radical)
((rads1 : (Listof Radical)
(vector-ref radicals (quotient j 2)))
(lst : (Listof Radical)
'()))
(if (null? rads1)
lst
(let loop2 ((rads2
rads1)
(lst
(loop1 (cdr rads1)
lst)))
(if (null? rads2)
lst
(cons (vector 'BCP
(car rads1)
(car rads2))
(loop2 (cdr rads2)
lst))))))))
(: ccp-generator (Integer -> (Listof Radical))) (: rads-of-size (Integer -> (Listof Radical)))
(define (ccp-generator j) (define (rads-of-size n)
(let: loop1 : (Listof Radical) (let: loop1 : (Listof Radical)
((ps : (Listof (Vectorof Integer)) ((ps : (Listof (Vectorof Integer))
(four-partitions (- j 1))) (three-partitions (- n 1)))
(lst : (Listof Radical) (lst : (Listof Radical)
'())) '()))
(if (null? ps) (if (null? ps)
lst lst
(let* ((p (car ps)) (let* ((p (car ps))
(nc1 (vector-ref p 0)) (nc1 (vector-ref p 0))
(nc2 (vector-ref p 1)) (nc2 (vector-ref p 1))
(nc3 (vector-ref p 2)) (nc3 (vector-ref p 2)))
(nc4 (vector-ref p 3))) (let: loop2 : (Listof Radical)
(let loop2 ((rads1 ((rads1 : (Listof Radical)
(vector-ref radicals nc1)) (vector-ref radicals nc1))
(lst (lst : (Listof Radical)
(loop1 (cdr ps) (loop1 (cdr ps)
lst)))
(if (null? rads1)
lst
(let loop3 ((rads2
(if (= nc1 nc2)
rads1
(vector-ref radicals nc2)))
(lst
(loop2 (cdr rads1)
lst))) lst)))
(if (null? rads2) (if (null? rads1)
lst lst
(let loop4 ((rads3 (let: loop3 : (Listof Radical)
(if (= nc2 nc3) ((rads2 : (Listof Radical)
rads2 (if (= nc1 nc2)
(vector-ref radicals nc3))) rads1
(lst (vector-ref radicals nc2)))
(loop3 (cdr rads2) (lst : (Listof Radical)
lst))) (loop2 (cdr rads1)
(if (null? rads3) lst)))
lst (if (null? rads2)
(let loop5 ((rads4 lst
(if (= nc3 nc4) (let: loop4 : (Listof Radical)
rads3 ((rads3 : (Listof Radical)
(vector-ref radicals nc4))) (if (= nc2 nc3)
(lst rads2
(loop4 (cdr rads3) (vector-ref radicals nc3)))
lst))) (lst : (Listof Radical)
(if (null? rads4) (loop3 (cdr rads2)
lst lst)))
(cons (vector 'CCP (if (null? rads3)
(car rads1) lst
(car rads2) (cons (vector 'C
(car rads3) (car rads1)
(car rads4)) (car rads2)
(loop5 (cdr rads4) (car rads3))
lst)))))))))))))) (loop4 (cdr rads3)
lst))))))))))))
(let loop ((i 1)) (: bcp-generator (Integer -> (Listof Radical)))
(if (> i n/2) (define (bcp-generator j)
(vector (bcp-generator n) (if (odd? j)
(ccp-generator n)) '()
(begin (let: loop1 : (Listof Radical)
(vector-set! radicals i (rads-of-size i)) ((rads1 : (Listof Radical)
(loop (+ i 1))))))) (vector-ref radicals (quotient j 2)))
(lst : (Listof Radical)
'()))
(if (null? rads1)
lst
(let loop2 ((rads2
rads1)
(lst
(loop1 (cdr rads1)
lst)))
(if (null? rads2)
lst
(cons (vector 'BCP
(car rads1)
(car rads2))
(loop2 (cdr rads2)
lst))))))))
(: three-partitions (Integer -> (Listof (Vectorof Integer)))) (: ccp-generator (Integer -> (Listof Radical)))
(define (three-partitions m) (define (ccp-generator j)
(let: loop1 : (Listof (Vectorof Integer)) (let: loop1 : (Listof Radical)
((lst : (Listof (Vectorof Integer)) '()) ((ps : (Listof (Vectorof Integer))
(nc1 : Integer (quotient m 3))) (four-partitions (- j 1)))
(if (< nc1 0) (lst : (Listof Radical)
lst '()))
(let loop2 ((lst lst) (if (null? ps)
(nc2 (quotient (- m nc1) 2))) lst
(if (< nc2 nc1) (let* ((p (car ps))
(loop1 lst (nc1 (vector-ref p 0))
(- nc1 1)) (nc2 (vector-ref p 1))
(loop2 (cons (vector nc1 nc2 (- m (+ nc1 nc2))) lst) (nc3 (vector-ref p 2))
(- nc2 1))))))) (nc4 (vector-ref p 3)))
(let loop2 ((rads1
(vector-ref radicals nc1))
(lst
(loop1 (cdr ps)
lst)))
(if (null? rads1)
lst
(let loop3 ((rads2
(if (= nc1 nc2)
rads1
(vector-ref radicals nc2)))
(lst
(loop2 (cdr rads1)
lst)))
(if (null? rads2)
lst
(let loop4 ((rads3
(if (= nc2 nc3)
rads2
(vector-ref radicals nc3)))
(lst
(loop3 (cdr rads2)
lst)))
(if (null? rads3)
lst
(let loop5 ((rads4
(if (= nc3 nc4)
rads3
(vector-ref radicals nc4)))
(lst
(loop4 (cdr rads3)
lst)))
(if (null? rads4)
lst
(cons (vector 'CCP
(car rads1)
(car rads2)
(car rads3)
(car rads4))
(loop5 (cdr rads4)
lst))))))))))))))
(: four-partitions (Integer -> (Listof (Vectorof Integer)))) (let loop ((i 1))
(define (four-partitions m) (if (> i n/2)
(let: loop1 : (Listof (Vectorof Integer)) (vector (bcp-generator n)
((lst : (Listof (Vectorof Integer)) '()) (ccp-generator n))
(nc1 : Integer (quotient m 4))) (begin
(if (< nc1 0) (vector-set! radicals i (rads-of-size i))
lst (loop (+ i 1)))))))
(let loop2 ((lst lst)
(nc2 (quotient (- m nc1) 3)))
(if (< nc2 nc1)
(loop1 lst
(- nc1 1))
(let ((start (max nc2 (- (quotient (+ m 1) 2) (+ nc1 nc2)))))
(let loop3 ((lst lst)
(nc3 (quotient (- m (+ nc1 nc2)) 2)))
(if (< nc3 start)
(loop2 lst (- nc2 1))
(loop3 (cons (vector nc1 nc2 nc3 (- m (+ nc1 (+ nc2 nc3)))) lst)
(- nc3 1))))))))))
(: nb (Integer -> Integer)) (: three-partitions (Integer -> (Listof (Vectorof Integer))))
(define (nb n) (define (three-partitions m)
(let ((x (gen n))) (let: loop1 : (Listof (Vectorof Integer))
(+ (length (vector-ref x 0)) ((lst : (Listof (Vectorof Integer)) '())
(length (vector-ref x 1))))) (nc1 : Integer (quotient m 3)))
(if (< nc1 0)
lst
(let loop2 ((lst lst)
(nc2 (quotient (- m nc1) 2)))
(if (< nc2 nc1)
(loop1 lst
(- nc1 1))
(loop2 (cons (vector nc1 nc2 (- m (+ nc1 nc2))) lst)
(- nc2 1)))))))
(let ((input (with-input-from-file "input.txt" read))) (: four-partitions (Integer -> (Listof (Vectorof Integer))))
(time (define (four-partitions m)
(let: loop : Integer (let: loop1 : (Listof (Vectorof Integer))
((n : Integer 100) (v : Integer 0)) ((lst : (Listof (Vectorof Integer)) '())
(if (zero? n) (nc1 : Integer (quotient m 4)))
v (if (< nc1 0)
(loop (- n 1) (nb (if input 17 0))))))) lst
(let loop2 ((lst lst)
(nc2 (quotient (- m nc1) 3)))
(if (< nc2 nc1)
(loop1 lst
(- nc1 1))
(let ((start (max nc2 (- (quotient (+ m 1) 2) (+ nc1 nc2)))))
(let loop3 ((lst lst)
(nc3 (quotient (- m (+ nc1 nc2)) 2)))
(if (< nc3 start)
(loop2 lst (- nc2 1))
(loop3 (cons (vector nc1 nc2 nc3 (- m (+ nc1 (+ nc2 nc3)))) lst)
(- nc3 1))))))))))
(: nb (Integer -> Integer))
(define (nb n)
(let ((x (gen n)))
(+ (length (vector-ref x 0))
(length (vector-ref x 1)))))
(let ((input (with-input-from-file "input.txt" read)))
(time
(let: loop : Integer
((n : Integer 100) (v : Integer 0))
(if (zero? n)
v
(loop (- n 1) (nb (if input 17 0)))))))
)