1;;; 2;;; Name: imath-test.scm 3;;; Purpose: Code to generate random rational number test cases. 4;;; Notes: Written for DrRacket (nee PLT Scheme) 5;;; 6(require (lib "27.ss" "srfi")) 7 8;; Generate a random natural number with the specified number of digits. 9(define (random-big-natural digits) 10 (let loop ((d "") (digits digits)) 11 (if (zero? digits) 12 (string->number d 10) 13 (let ((rnd (random 10))) 14 (loop (string-append d (list->string 15 (list 16 (integer->char 17 (+ rnd 18 (char->integer #\0)))))) 19 (- digits 1)))))) 20 21;; Generate a random integer with the specified number of digits and 22;; probability (0..1) of being negative. 23(define (random-big-integer digits pneg) 24 (let ((base (random-big-natural digits))) 25 (if (< (random-real) pneg) 26 (* base -1) 27 base))) 28 29;; Generate a random rational number with the specified number of numerator and 30;; denominator digits, and probability pneg (0..1) of being negative. 31(define (random-big-rational n-digits d-digits pneg) 32 (let ((num (random-big-natural n-digits)) 33 (den (random-big-natural d-digits))) 34 (if (zero? den) 35 (random-big-rational n-digits d-digits pneg) 36 (if (< (random-real) pneg) 37 (- (/ num den)) 38 (/ num den))))) 39 40;; Create a rational generator with a fixed negative probability. 41;; Always generates rationals. 42(define (make-rat-generator prob-neg) 43 (lambda (n-digits d-digits num) 44 (random-big-rational n-digits d-digits prob-neg))) 45 46;; Create a rational generator with a fixed negative probability. With 47;; probability prob-backref, generates a back-reference to an earlier input 48;; value, rather than a new value. This is used to make sure argument 49;; overlapping works the way it should. 50(define (make-backref-generator prob-neg prob-backref) 51 (lambda (n-digits d-digits num) 52 (if (and (> num 1) 53 (< (random-real) prob-backref)) 54 (let ((ref (+ (random (- num 1)) 1))) 55 (string-append "=" (number->string ref))) 56 (random-big-rational n-digits d-digits prob-neg)))) 57 58;; Just like make-backref-generator, except the second argument is always an 59;; integer, and the backreference can only be to the first argument. 60(define (make-backref-generator-2 prob-neg prob-backref) 61 (lambda (n-digits d-digits num) 62 (case num 63 ((1) (random-big-rational n-digits d-digits prob-neg)) 64 ((2) (random-big-integer n-digits prob-neg)) 65 (else 66 (if (< (random-real) prob-backref) 67 "=1" 68 (random-big-rational n-digits d-digits prob-neg)))))) 69 70(define (make-output-test-generator prob-neg max-dig) 71 (lambda (n-digits d-digits num) 72 (cond ((= num 1) 73 (random-big-rational n-digits d-digits prob-neg)) 74 ((= num 2) 75 (let loop ((radishes '(10 16 8 4 2))) 76 (cond ((null? radishes) 77 (+ (random 34) 2)) 78 ((< (random-real) 0.3) 79 (car radishes)) 80 (else 81 (loop (cdr radishes)))))) 82 (else 83 (random max-dig)) 84 ))) 85 86;; Given a test name, an argument generator, and an operation to compute the 87;; desired solution, return a function that generates a random test case for a 88;; given number of digits of precision in the numerator and denominator. 89(define (make-test-case-generator name arg-gen op) 90 (lambda (n-digits d-digits) 91 (let ((args (list (arg-gen n-digits d-digits 1) 92 (arg-gen n-digits d-digits 2) 93 (arg-gen n-digits d-digits 3)))) 94 (let* ((arg1 (car args)) 95 (arg2 (if (equal? (cadr args) "=1") 96 arg1 (cadr args))) 97 (soln (if (and (eq? op /) 98 (zero? arg2)) 99 "$MP_UNDEF" 100 (op arg1 arg2)))) 101 (list 102 name 103 args 104 (list soln)))))) 105 106;; Glue strings together with the specified joiner. 107(define (join-strings joiner lst) 108 (cond ((null? lst) "") 109 ((null? (cdr lst)) (car lst)) 110 (else 111 (string-append (car lst) joiner 112 (join-strings joiner (cdr lst)))))) 113 114;; Convert a test case generated by a test case generator function into a 115;; writable string, in the format used by imtest.c 116(define (test-case->string tcase) 117 (let ((s (open-output-string)) 118 (stringify (lambda (v) 119 (let ((s (open-output-string))) 120 (display v s) 121 (get-output-string s))))) 122 (display (car tcase) s) 123 (display ":" s) 124 (display (join-strings "," (map stringify (cadr tcase))) 125 s) 126 (display ":" s) 127 (display (join-strings "," (map stringify (caddr tcase))) 128 s) 129 (get-output-string s))) 130 131(define qadd (make-test-case-generator 132 'qadd (make-backref-generator 0.3 0.2) +)) 133(define qsub (make-test-case-generator 134 'qsub (make-backref-generator 0.3 0.2) -)) 135(define qmul (make-test-case-generator 136 'qmul (make-backref-generator 0.3 0.2) *)) 137(define qdiv (make-test-case-generator 138 'qdiv (make-backref-generator 0.3 0.2) /)) 139(define qtodec (make-test-case-generator 140 'qtodec (make-output-test-generator 0.3 25) 141 (lambda (a b) '?))) 142(define qaddz (make-test-case-generator 143 'qaddz (make-backref-generator-2 0.3 0.2) +)) 144(define qsubz (make-test-case-generator 145 'qsubz (make-backref-generator-2 0.3 0.2) -)) 146(define qmulz (make-test-case-generator 147 'qmulz (make-backref-generator-2 0.3 0.2) *)) 148(define qdivz (make-test-case-generator 149 'qdivz (make-backref-generator-2 0.3 0.2) /)) 150 151(define (write-test-cases test-fn lo-size hi-size num-each fname) 152 (let ((out (open-output-file fname))) 153 (do ((num lo-size (+ num 1))) 154 ((> num hi-size) (void)) 155 (do ((den hi-size (- den 1))) 156 ((< den lo-size) (void)) 157 (do ((ctr 1 (+ ctr 1))) 158 ((> ctr num-each) (void)) 159 (display (test-case->string (test-fn num den)) out) 160 (newline out)))) 161 (close-output-port out))) 162 163(define (write-lots-of-tests) 164 (write-test-cases qadd 1 20 2 "qadd.tc") 165 (write-test-cases qsub 1 20 2 "qsub.tc") 166 (write-test-cases qmul 1 20 2 "qmul.tc") 167 (write-test-cases qdiv 1 20 2 "qdiv.tc") 168 (write-test-cases qtodec 1 20 2 "qtodec.tc") 169 (write-test-cases qaddz 1 20 2 "qaddz.tc") 170 (write-test-cases qsubz 1 20 2 "qsubz.tc") 171 (write-test-cases qmulz 1 20 2 "qmulz.tc") 172 (write-test-cases qdivz 1 20 2 "qdivz.tc")) 173