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
|
;;;
;;; Name: imath-test.scm
;;; Purpose: Code to generate random rational number test cases.
;;; Notes: Written for DrRacket (nee PLT Scheme)
;;;
(require (lib "27.ss" "srfi"))
;; Generate a random natural number with the specified number of digits.
(define (random-big-natural digits)
(let loop ((d "") (digits digits))
(if (zero? digits)
(string->number d 10)
(let ((rnd (random 10)))
(loop (string-append d (list->string
(list
(integer->char
(+ rnd
(char->integer #\0))))))
(- digits 1))))))
;; Generate a random integer with the specified number of digits and
;; probability (0..1) of being negative.
(define (random-big-integer digits pneg)
(let ((base (random-big-natural digits)))
(if (< (random-real) pneg)
(* base -1)
base)))
;; Generate a random rational number with the specified number of numerator and
;; denominator digits, and probability pneg (0..1) of being negative.
(define (random-big-rational n-digits d-digits pneg)
(let ((num (random-big-natural n-digits))
(den (random-big-natural d-digits)))
(if (zero? den)
(random-big-rational n-digits d-digits pneg)
(if (< (random-real) pneg)
(- (/ num den))
(/ num den)))))
;; Create a rational generator with a fixed negative probability.
;; Always generates rationals.
(define (make-rat-generator prob-neg)
(lambda (n-digits d-digits num)
(random-big-rational n-digits d-digits prob-neg)))
;; Create a rational generator with a fixed negative probability. With
;; probability prob-backref, generates a back-reference to an earlier input
;; value, rather than a new value. This is used to make sure argument
;; overlapping works the way it should.
(define (make-backref-generator prob-neg prob-backref)
(lambda (n-digits d-digits num)
(if (and (> num 1)
(< (random-real) prob-backref))
(let ((ref (+ (random (- num 1)) 1)))
(string-append "=" (number->string ref)))
(random-big-rational n-digits d-digits prob-neg))))
;; Just like make-backref-generator, except the second argument is always an
;; integer, and the backreference can only be to the first argument.
(define (make-backref-generator-2 prob-neg prob-backref)
(lambda (n-digits d-digits num)
(case num
((1) (random-big-rational n-digits d-digits prob-neg))
((2) (random-big-integer n-digits prob-neg))
(else
(if (< (random-real) prob-backref)
"=1"
(random-big-rational n-digits d-digits prob-neg))))))
(define (make-output-test-generator prob-neg max-dig)
(lambda (n-digits d-digits num)
(cond ((= num 1)
(random-big-rational n-digits d-digits prob-neg))
((= num 2)
(let loop ((radishes '(10 16 8 4 2)))
(cond ((null? radishes)
(+ (random 34) 2))
((< (random-real) 0.3)
(car radishes))
(else
(loop (cdr radishes))))))
(else
(random max-dig))
)))
;; Given a test name, an argument generator, and an operation to compute the
;; desired solution, return a function that generates a random test case for a
;; given number of digits of precision in the numerator and denominator.
(define (make-test-case-generator name arg-gen op)
(lambda (n-digits d-digits)
(let ((args (list (arg-gen n-digits d-digits 1)
(arg-gen n-digits d-digits 2)
(arg-gen n-digits d-digits 3))))
(let* ((arg1 (car args))
(arg2 (if (equal? (cadr args) "=1")
arg1 (cadr args)))
(soln (if (and (eq? op /)
(zero? arg2))
"$MP_UNDEF"
(op arg1 arg2))))
(list
name
args
(list soln))))))
;; Glue strings together with the specified joiner.
(define (join-strings joiner lst)
(cond ((null? lst) "")
((null? (cdr lst)) (car lst))
(else
(string-append (car lst) joiner
(join-strings joiner (cdr lst))))))
;; Convert a test case generated by a test case generator function into a
;; writable string, in the format used by imtest.c
(define (test-case->string tcase)
(let ((s (open-output-string))
(stringify (lambda (v)
(let ((s (open-output-string)))
(display v s)
(get-output-string s)))))
(display (car tcase) s)
(display ":" s)
(display (join-strings "," (map stringify (cadr tcase)))
s)
(display ":" s)
(display (join-strings "," (map stringify (caddr tcase)))
s)
(get-output-string s)))
(define qadd (make-test-case-generator
'qadd (make-backref-generator 0.3 0.2) +))
(define qsub (make-test-case-generator
'qsub (make-backref-generator 0.3 0.2) -))
(define qmul (make-test-case-generator
'qmul (make-backref-generator 0.3 0.2) *))
(define qdiv (make-test-case-generator
'qdiv (make-backref-generator 0.3 0.2) /))
(define qtodec (make-test-case-generator
'qtodec (make-output-test-generator 0.3 25)
(lambda (a b) '?)))
(define qaddz (make-test-case-generator
'qaddz (make-backref-generator-2 0.3 0.2) +))
(define qsubz (make-test-case-generator
'qsubz (make-backref-generator-2 0.3 0.2) -))
(define qmulz (make-test-case-generator
'qmulz (make-backref-generator-2 0.3 0.2) *))
(define qdivz (make-test-case-generator
'qdivz (make-backref-generator-2 0.3 0.2) /))
(define (write-test-cases test-fn lo-size hi-size num-each fname)
(let ((out (open-output-file fname)))
(do ((num lo-size (+ num 1)))
((> num hi-size) (void))
(do ((den hi-size (- den 1)))
((< den lo-size) (void))
(do ((ctr 1 (+ ctr 1)))
((> ctr num-each) (void))
(display (test-case->string (test-fn num den)) out)
(newline out))))
(close-output-port out)))
(define (write-lots-of-tests)
(write-test-cases qadd 1 20 2 "qadd.tc")
(write-test-cases qsub 1 20 2 "qsub.tc")
(write-test-cases qmul 1 20 2 "qmul.tc")
(write-test-cases qdiv 1 20 2 "qdiv.tc")
(write-test-cases qtodec 1 20 2 "qtodec.tc")
(write-test-cases qaddz 1 20 2 "qaddz.tc")
(write-test-cases qsubz 1 20 2 "qsubz.tc")
(write-test-cases qmulz 1 20 2 "qmulz.tc")
(write-test-cases qdivz 1 20 2 "qdivz.tc"))
|
