305 lines
9.0 KiB
Racket
305 lines
9.0 KiB
Racket
#lang typed/racket/base
|
|
|
|
(module+ test
|
|
(require
|
|
trivial/math
|
|
trivial/vector
|
|
typed/rackunit)
|
|
|
|
;; -- vector-length:
|
|
(check-equal?
|
|
(vector-length: '#()) 0)
|
|
(check-equal?
|
|
(vector-length: (vector 1 2 2)) 3)
|
|
(check-equal?
|
|
(ann (-: (vector-length: (vector 5 5 5 5 5)) 4)
|
|
One)
|
|
1)
|
|
(let-vector: ([v1 (vector 2 3 4)]
|
|
[v2 (vector 4 3 2)])
|
|
(check-equal?
|
|
(ann (+: 1 (-: (*: 5 (vector-length: v1)) (+: (*: 4 3) (vector-length: v2))))
|
|
One)
|
|
1))
|
|
(let ()
|
|
(define-vector: v1 (vector 2 3 4))
|
|
(define-vector: v2 (vector 4 3 2))
|
|
(check-equal?
|
|
(ann (*: 5 (-: (vector-length: v1) (*: 1 1 (vector-length: v2) 1)))
|
|
Zero)
|
|
0))
|
|
|
|
;(test-suite "vector-ref:"
|
|
(test-case "vector/length ref"
|
|
(check-equal? (vector-ref: (vector 1) 0) 1))
|
|
|
|
(test-case "vector/length ref, via let"
|
|
(let-vector: ([v (vector 2)])
|
|
(check-equal? (vector-ref: v 0) 2)))
|
|
|
|
(test-case "vector/length ref, via define"
|
|
(define-vector: v (vector "a" "bee" "sea"))
|
|
(check-equal? (vector-ref: v 2) "sea"))
|
|
|
|
(test-case "plain vector ref"
|
|
(check-equal?
|
|
((lambda (v) (vector-ref: v 3)) (vector 8 2 19 3 0))
|
|
3))
|
|
|
|
(test-case "higher-order vector ref"
|
|
(check-exn exn:fail:contract?
|
|
(lambda ()
|
|
((lambda ([f : (-> (Vectorof Any) Natural Any)])
|
|
(f (vector 0 1 2) 10)) vector-ref:))))
|
|
|
|
(test-case "2-level ref"
|
|
(let-vector: ([v1 (vector 'X)])
|
|
(let-vector: ([v2 (vector v1)])
|
|
(check-equal? (vector-ref: (vector-ref: v2 0) 0) 'X))))
|
|
;)
|
|
|
|
;(test-suite "vector-set!:"
|
|
(test-case "vector/length set!"
|
|
(check-equal? (vector-set!: (vector 1) 0 8) (void)))
|
|
|
|
(test-case "vector/length set!, via let"
|
|
(let-vector: ([v (vector 2)])
|
|
(vector-set! v 0 3)
|
|
(check-equal? (vector-ref: v 0) 3)))
|
|
|
|
(test-case "vector/length set, via define"
|
|
(define-vector: v (vector "a" "bee" "sea"))
|
|
(vector-set! v 1 "bye")
|
|
(check-equal? (vector-ref: v 1) "bye"))
|
|
|
|
(test-case "plain vector set"
|
|
(check-equal?
|
|
((lambda (v) (vector-set!: v 3 4) (vector-ref: v 3)) (vector 8 2 19 3 0))
|
|
4))
|
|
|
|
(test-case "higher-order vector set"
|
|
(check-exn exn:fail:contract?
|
|
(lambda ()
|
|
((lambda ([f : (-> (Vectorof Any) Natural Any Void)])
|
|
(f (vector 0 1 2) 10 9)) vector-set!:))))
|
|
;)
|
|
|
|
;(test-suite "vector-map:"
|
|
(test-case "vector/length map"
|
|
(check-equal? (vector-map: add1 (vector 1)) (vector 2)))
|
|
|
|
(test-case "vector/length map via let"
|
|
(check-equal?
|
|
(let-vector: ([v (vector (vector 1) (vector 2 2)
|
|
(vector 3 3 3) (vector 4 4 4 4))])
|
|
(vector-map: vector-length: v))
|
|
(vector 1 2 3 4)))
|
|
|
|
(test-case "map^3"
|
|
(check-equal?
|
|
(vector-map: add1 (vector-map: add1 (vector-map: add1 (vector 0 0 0))))
|
|
(vector 3 3 3)))
|
|
|
|
(test-case "plain map"
|
|
(check-equal?
|
|
((lambda ([v : (Vectorof (Vectorof Any))])
|
|
(vector-map: vector-length: v))
|
|
(vector (vector 1) (vector 2 2) (vector 3 3 3) (vector 4 4 4 4)))
|
|
(vector 1 2 3 4)))
|
|
|
|
(test-case "large vector"
|
|
(let-vector: ([v* (make-vector 200 #f)])
|
|
(check-true (for/and ([v (in-vector (vector-map: not v*))]) v))))
|
|
|
|
(test-case "higher-order map pass"
|
|
(check-equal?
|
|
((lambda ([f : (-> (-> Symbol String) (Vectorof Symbol) (Vectorof String))])
|
|
(f symbol->string '#(x yy z)))
|
|
vector-map:)
|
|
(vector "x" "yy" "z")))
|
|
|
|
(test-case "higher-order map fail"
|
|
(check-exn exn:fail:contract?
|
|
(lambda ()
|
|
((lambda ([f : (-> (-> Integer Integer) (Vectorof Integer) (Vectorof Integer))])
|
|
(vector-ref: (f add1 (vector 0 0)) 3))
|
|
vector-map:))))
|
|
;)
|
|
|
|
;(test-suite "vector-map!:"
|
|
(test-case "vector/length map!"
|
|
(check-equal? (vector-map!: add1 (vector 1)) (vector 2)))
|
|
|
|
(test-case "vector/length map! via let"
|
|
(check-equal?
|
|
(let ()
|
|
(: v (Vectorof (Vectorof Integer)))
|
|
(define-vector: v (vector (vector 1) (vector 2 2) (vector 3 3 3) (vector 4 4 4 4)))
|
|
(vector-map!: (lambda ([x : (Vectorof Integer)]) (vector (vector-length: x))) v))
|
|
'#(#(1) #(2) #(3) #(4))))
|
|
|
|
(test-case "map!^3"
|
|
(check-equal?
|
|
(vector-map!: add1 (vector-map!: add1 (vector-map!: add1 (vector 0 0 0))))
|
|
(vector 3 3 3)))
|
|
|
|
(test-case "plain map!"
|
|
(check-equal?
|
|
((lambda ([v : (Vectorof (Vectorof Any))])
|
|
(vector-map!: (lambda ([x : (Vectorof Any)]) (vector (vector-ref: x 0))) v))
|
|
(vector (vector 1) (vector 2 2) (vector 3 3 3) (vector 4 4 4 4)))
|
|
'#(#(1) #(2) #(3) #(4))))
|
|
|
|
(test-case "large vector"
|
|
(let-vector: ([v* (ann (make-vector 200 #f) (Vectorof Boolean))])
|
|
(vector-map!: not v*)
|
|
(check-true (for/and ([v (in-vector v*)]) v))))
|
|
|
|
(test-case "higher-order map! pass"
|
|
(check-equal?
|
|
((lambda ([f : (-> (-> Symbol Symbol) (Vectorof Symbol) (Vectorof Symbol))])
|
|
(f (lambda (x) 'hi) (vector 'x 'yy 'z)))
|
|
vector-map!:)
|
|
(vector 'hi 'hi 'hi)))
|
|
|
|
(test-case "higher-order map! fail"
|
|
(check-exn exn:fail:contract?
|
|
(lambda ()
|
|
((lambda ([f : (-> (-> Integer Integer) (Vectorof Integer) (Vectorof Integer))])
|
|
(vector-ref: (f add1 (vector 0 0)) 3))
|
|
vector-map!:))))
|
|
;)
|
|
|
|
;(test-suite "vector-append:"
|
|
(test-case "append"
|
|
(let-vector: ([v (vector 0 0 8)]
|
|
[v2 (vector 1 2)])
|
|
(check-equal?
|
|
(vector-ref: (vector-append: v2 v) 4)
|
|
8)))
|
|
;)
|
|
|
|
;(test-suite "vector->list:"
|
|
(test-case "vector->list basic"
|
|
(let-vector: ([v (vector 8 8 8 1 8)])
|
|
(check-equal?
|
|
(vector->list: v)
|
|
'(8 8 8 1 8))))
|
|
|
|
(test-case "large vector->list"
|
|
(check-equal?
|
|
(vector->list: (ann (make-vector 300 '()) (Vectorof (Listof Any))))
|
|
(build-list 300 (lambda (i) '()))))
|
|
;)
|
|
|
|
;(test-suite "vector->immutable-vector"
|
|
(test-case "vector->immutable, basic"
|
|
(check-equal?
|
|
(vector-ref: (vector->immutable-vector: (vector 'a 'd 'e)) 0)
|
|
'a))
|
|
(test-case "vector->immutable"
|
|
(check-equal?
|
|
(vector-ref: (vector->immutable-vector: (vector 9 9 4)) 0)
|
|
9))
|
|
;)
|
|
|
|
;(test-suite "vector-fill!"
|
|
(test-case "vfill basic"
|
|
(let-vector: ([v (vector 2 3 1)])
|
|
(check-equal? (vector-fill!: v 9) (void))
|
|
(check-equal? (vector-ref v 2) 9)))
|
|
;)
|
|
|
|
;(test-suite "vector-take"
|
|
(test-case "take basis"
|
|
(let-vector: ([v (vector 2 3 1)])
|
|
(check-equal? (vector-take: v 3) v)
|
|
(check-equal? (vector-take: v 2) (vector 2 3))
|
|
(check-equal? (vector-take: v 1) (vector 2))
|
|
(check-equal? (vector-take: v 0) (vector))))
|
|
;)
|
|
|
|
;(test-suite "vector-take-right"
|
|
(test-case "take-right basic"
|
|
(let-vector: ([v (vector 2 3 1)])
|
|
(check-equal? (vector-take-right: v 3) v)
|
|
(check-equal? (vector-take-right: v 2) (vector 3 1))
|
|
(check-equal? (vector-take-right: v 1) (vector 1))
|
|
(check-equal? (vector-take-right: v 0) (vector))))
|
|
;)
|
|
|
|
;(test-suite "vector-drop-right"
|
|
(test-case "drop-right basic"
|
|
(let-vector: ([v (vector 2 3 1)])
|
|
(check-equal? (vector-drop-right: v 0) v)
|
|
(check-equal? (vector-drop-right: v 1) (vector 2 3))
|
|
(check-equal? (vector-drop-right: v 2) (vector 2))
|
|
(check-equal? (vector-drop-right: v 3) (vector))))
|
|
;)
|
|
|
|
;(test-suite "vector-drop"
|
|
(test-case "drop basic"
|
|
(let-vector: ([v (vector 2 3 1)])
|
|
(check-equal? (vector-drop: v 0) v)
|
|
(check-equal? (vector-drop: v 1) (vector 3 1))
|
|
(check-equal? (vector-drop: v 2) (vector 1))
|
|
(check-equal? (vector-drop: v 3) (vector))))
|
|
;)
|
|
|
|
;; -- define-vector:
|
|
(let ()
|
|
(define-vector: v (vector 1 1 2 2))
|
|
(check-equal? (vector-ref: v 0) 1))
|
|
;; -- let-vector:
|
|
)
|
|
|
|
;; -----------------------------------------------------------------------------
|
|
; ;; -- parse-vector-length
|
|
; ;; --- '#
|
|
; (check-equal?
|
|
; (parse-vector-length #'#())
|
|
; 0)
|
|
;; (check-equal?
|
|
;; (parse-vector-length #`#,'#(1 2))
|
|
;; 2)
|
|
; (check-equal?
|
|
; (parse-vector-length #'#(1 2 3 4))
|
|
; 4)
|
|
; (check-equal?
|
|
; (parse-vector-length #'#(a b c e s aue d al))
|
|
; 8)
|
|
; ;; --- vector
|
|
; (check-equal?
|
|
; (parse-vector-length #'(vector))
|
|
; 0)
|
|
; (check-equal?
|
|
; (parse-vector-length #'(vector 0 1))
|
|
; 2)
|
|
; ;; --- make-vector
|
|
; (check-equal?
|
|
; (parse-vector-length #'(make-vector -1 1))
|
|
; #f)
|
|
; (check-equal?
|
|
; (parse-vector-length #'(make-vector 0 8))
|
|
; 0)
|
|
; (check-equal?
|
|
; (parse-vector-length #'(make-vector 3 3))
|
|
; 3)
|
|
; (check-equal?
|
|
; (parse-vector-length #'(make-vector 99))
|
|
; 99)
|
|
; ;; --- build-vector
|
|
; (check-equal?
|
|
; ;; Type error
|
|
; (parse-vector-length #'(build-vector -1))
|
|
; #f)
|
|
; (check-equal?
|
|
; (parse-vector-length #'(build-vector 0 (lambda (x) x)))
|
|
; 0)
|
|
; (check-equal?
|
|
; (parse-vector-length #'(build-vector 3 (lambda (x) 8)))
|
|
; 3)
|
|
; (check-equal?
|
|
; (parse-vector-length #'(build-vector 61 add1))
|
|
; 61)
|