-
Notifications
You must be signed in to change notification settings - Fork 2
/
rp-test.rkt
172 lines (152 loc) · 8 KB
/
rp-test.rkt
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
#lang racket
;(require "main.rkt")
(require "rp-api.rkt")
(module+ test
(require rackunit)
; rf-equal as check
(define-simple-check (check-rf-equal? r-exp1 r-exp2)
(rf-equal? r-exp1 r-exp2))
(test-case
"nrm/exc"
(check-rf-equal? (nrm/exc 1 2 1)
(construct-ranking (1 . 0) (2 . 1)))
(check-rf-equal? (nrm/exc 1 2 2)
(construct-ranking (1 . 0) (2 . 2)))
(check-rf-equal? (nrm/exc 1 1 1)
(construct-ranking (1 . 0)))
(check-rf-equal? (nrm/exc 1 (nrm/exc 2 3 1) 1)
(construct-ranking (1 . 0) (2 . 1) (3 . 2)))
(check-rf-equal? (nrm/exc (nrm/exc 10 20 5) 2 1)
(construct-ranking (10 . 0) (2 . 1) (20 . 5))))
(test-case
"either-of"
(check-rf-equal? (either-of (list 1 2 3))
(construct-ranking (1 . 0) (2 . 0) (3 . 0)))
(check-rf-equal? (either-of `())
(failure)))
(test-case
"either/or test"
(check-rf-equal? (either/or)
(failure))
(check-rf-equal? (either/or 1)
(construct-ranking (1 . 0)))
(check-rf-equal? (either/or 1 2)
(construct-ranking (1 . 0) (2 . 0)))
(check-rf-equal? (either/or 1 2 3)
(construct-ranking (1 . 0) (2 . 0) (3 . 0)))
(check-rf-equal? (either/or (nrm/exc 1 2 1) (nrm/exc 10 20 10))
(construct-ranking (1 . 0) (10 . 0) (2 . 1) (20 . 10))))
(test-case
"observe"
(check-rf-equal? (observe odd? (construct-ranking (0 . 0) (1 . 1) (2 . 2) (3 . 3)))
(construct-ranking (1 . 0) (3 . 2)))
(check-rf-equal? (observe even? (construct-ranking (0 . 0) (1 . 1) (2 . 2) (3 . 3)))
(construct-ranking (0 . 0) (2 . 2)))
(check-rf-equal? (observe (lambda (x) #F) (construct-ranking (0 . 0) (1 . 1) (2 . 2) (3 . 3)))
(failure))
(check-rf-equal? (observe (lambda (x) #T) (construct-ranking (0 . 0) (1 . 1) (2 . 2) (3 . 3)))
(construct-ranking (0 . 0) (1 . 1) (2 . 2) (3 . 3))))
(test-case
"observe-r"
(check-rf-equal? (observe-r 100 odd? (construct-ranking (0 . 0) (1 . 1) (2 . 2) (3 . 3)))
(construct-ranking (1 . 0) (3 . 2) (0 . 100) (2 . 102)))
(check-rf-equal? (observe-r 100 even? (construct-ranking (0 . 0) (1 . 1) (2 . 2) (3 . 3)))
(construct-ranking (0 . 0) (2 . 2) (1 . 100) (3 . 102)))
(check-rf-equal? (observe-r 100 (lambda (x) #F) (construct-ranking (0 . 0) (1 . 1) (2 . 2) (3 . 3)))
(construct-ranking (0 . 0) (1 . 1) (2 . 2) (3 . 3)))
(check-rf-equal? (observe-r 100 (lambda (x) #T) (construct-ranking (0 . 0) (1 . 1) (2 . 2) (3 . 3)))
(construct-ranking (0 . 0) (1 . 1) (2 . 2) (3 . 3))))
(test-case
"observe-e"
(check-rf-equal? (observe-e 100 odd? (construct-ranking (0 . 0) (1 . 1) (2 . 2) (3 . 3)))
(construct-ranking (1 . 0) (3 . 2) (0 . 99) (2 . 101)))
(check-rf-equal? (observe-e 100 even? (construct-ranking (0 . 0) (1 . 1) (2 . 2) (3 . 3)))
(construct-ranking (0 . 0) (2 . 2) (1 . 101) (3 . 103)))
(check-rf-equal? (observe-e 100 (lambda (x) #F) (construct-ranking (0 . 0) (1 . 1) (2 . 2) (3 . 3)))
(failure))
(check-rf-equal? (observe-e 100 (lambda (x) #T) (construct-ranking (0 . 0) (1 . 1) (2 . 2) (3 . 3)))
(construct-ranking (0 . 0) (1 . 1) (2 . 2) (3 . 3))))
(test-case
"cut"
(check-rf-equal? (cut 0 (construct-ranking (0 . 0) (1 . 1) (2 . 2) (3 . 3)))
(construct-ranking (0 . 0)))
(check-rf-equal? (cut 1 (construct-ranking (0 . 0) (1 . 1) (2 . 2) (3 . 3)))
(construct-ranking (0 . 0) (1 . 1)))
(check-rf-equal? (cut 3 (construct-ranking (0 . 0) (1 . 1) (2 . 2) (3 . 3)))
(construct-ranking (0 . 0) (1 . 1) (2 . 2) (3 . 3))))
(test-case
"rank-of"
(check-equal? (rank-of odd? (construct-ranking (0 . 0) (1 . 1) (2 . 2) (3 . 3))) 1)
(check-equal? (rank-of even? (construct-ranking (0 . 0) (1 . 1) (2 . 2) (3 . 3))) 0)
(check-equal? (rank-of (lambda (x) (> x 2)) (construct-ranking (0 . 0) (1 . 1) (2 . 2) (3 . 3))) 3)
(check-true (infinite? (rank-of (lambda (x) #F) (construct-ranking (0 . 0) (1 . 1) (2 . 2) (3 . 3))))))
(test-case
"ranked application"
(check-rf-equal? ($ + 10 5)
(construct-ranking (15 . 0)))
(check-rf-equal? ($ (nrm/exc + - 1) 10 5)
(construct-ranking (15 . 0) (5 . 1)))
(check-rf-equal? ($ + (nrm/exc 10 20 1) 5)
(construct-ranking (15 . 0) (25 . 1)))
(check-rf-equal? ($ + (nrm/exc 10 20 1) (nrm/exc 5 50 2))
(construct-ranking (15 . 0) (25 . 1) (60 . 2) (70 . 3)))
(check-rf-equal? ($ (nrm/exc + - 1) (nrm/exc 10 20 1) (nrm/exc 5 50 2))
(construct-ranking (15 . 0) (25 . 1) (5 . 1) (60 . 2) (15 . 2) (70 . 3) (-40 . 3) (-30 . 4)))
(check-rf-equal? ($ + (nrm/exc 10 20 1) (nrm/exc 5 (nrm/exc 50 500 2) 2))
(construct-ranking (15 . 0) (25 . 1) (60 . 2) (70 . 3) (510 . 4) (520 . 5))))
(test-case
"rlet"
(check-rf-equal? (rlet ((x (nrm/exc 1 2 1))) x)
(construct-ranking (1 . 0) (2 . 1)))
(check-rf-equal? (rlet ((x (nrm/exc 1 2 1)) (y (nrm/exc 10 20 2))) (list x y))
(construct-ranking ((1 10) . 0) ((2 10) . 1) ((1 20) . 2) ((2 20) . 3)))
(check-rf-equal? (rlet ((x (nrm/exc 1 2 1)) (y (failure))) (list x y))
(failure)))
(test-case
"rlet*"
(check-rf-equal? (rlet* ((x (nrm/exc 1 2 1))) x)
(construct-ranking (1 . 0) (2 . 1)))
(check-rf-equal? (rlet* ((x (nrm/exc #F #T 1)) (y (if x (nrm/exc 1 2 1) 0))) (list x y))
(construct-ranking ((#F 0) . 0) ((#T 1) . 1) ((#T 2) . 2)))
(check-rf-equal? (rlet* ((x (nrm/exc 1 2 1)) (y (failure))) (list x y))
(failure)))
(test-case
"rf-equal"
(check-true (rf-equal? (failure) (failure)))
(check-true (rf-equal? (construct-ranking (0 . 0)) (construct-ranking (0 . 0))))
(check-true (rf-equal? (construct-ranking (0 . 0) (1 . 1)) (construct-ranking (0 . 0) (1 . 1))))
(check-false (rf-equal? (construct-ranking (0 . 0) (1 . 1)) (construct-ranking (0 . 0) (1 . 2))))
(check-false (rf-equal? (construct-ranking (0 . 0) (1 . 1)) (construct-ranking (0 . 0) (2 . 1))))
(check-false (rf-equal? (construct-ranking (0 . 0) (1 . 1)) (construct-ranking (0 . 0))))
(check-false (rf-equal? (construct-ranking (0 . 0)) (construct-ranking (0 . 0) (1 . 1))))
(check-false (rf-equal? (construct-ranking (0 . 0)) (failure))))
(test-case
"rf->hash"
(let ((hash1 (rf->hash (failure)))
(hash2 (rf->hash (construct-ranking (1 . 0))))
(hash3 (rf->hash (construct-ranking (1 . 0) (2 . 1))))
(hash4 (rf->hash (construct-ranking (1 . 0) (2 . 1) (2 . 2)))))
(check-equal? (hash-count hash1) 0)
(check-equal? (hash-count hash2) 1)
(check-equal? (hash-count hash3) 2)
(check-equal? (hash-count hash4) 2)
(check-equal? (hash-ref hash2 1) 0)
(check-equal? (hash-ref hash3 1) 0)
(check-equal? (hash-ref hash3 2) 1)
(check-equal? (hash-ref hash4 1) 0)
(check-equal? (hash-ref hash4 2) 1)))
(test-case
"rf->assoc"
(let ((r1 (failure))
(r2 (construct-ranking (1 . 0)))
(r3 (construct-ranking (1 . 0) (2 . 1))))
(check-equal? (rf->assoc (failure)) `())
(check-equal? (rf->assoc (construct-ranking (1 . 0))) `((1 . 0)))
(check-equal? (rf->assoc (construct-ranking (1 . 0) (2 . 1))) `((1 . 0) (2 . 1)))
(check-equal? (rf->assoc (construct-ranking (1 . 0) (2 . 1) (2 . 2))) `((1 . 0) (2 . 1)))))
(test-case
"set-global-dedup"
(let ((with_dedup (begin (set-global-dedup #T) (rf->assoc (nrm/exc 10 10 10))))
(without-dedup (begin (set-global-dedup #F) (let ((ret (rf->assoc (nrm/exc 10 10 10)))) (begin (set-global-dedup #T) ret)))))
(check-equal? with_dedup `((10 . 0)))
(check-equal? without-dedup `((10 . 0) (10 . 10))))))