173 lines · plain
1;;;2;;; Name: imath-test.scm3;;; 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->string15 (list16 (integer->char17 (+ rnd18 (char->integer #\0))))))19 (- digits 1))))))20 21;; Generate a random integer with the specified number of digits and22;; 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 and30;; 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. With47;; probability prob-backref, generates a back-reference to an earlier input48;; value, rather than a new value. This is used to make sure argument49;; 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 an59;; 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 num63 ((1) (random-big-rational n-digits d-digits prob-neg))64 ((2) (random-big-integer n-digits prob-neg))65 (else66 (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 (else81 (loop (cdr radishes))))))82 (else83 (random max-dig))84 )))85 86;; Given a test name, an argument generator, and an operation to compute the87;; desired solution, return a function that generates a random test case for a88;; 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 (list102 name103 args104 (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 (else111 (string-append (car lst) joiner112 (join-strings joiner (cdr lst))))))113 114;; Convert a test case generated by a test case generator function into a115;; writable string, in the format used by imtest.c116(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-generator132 'qadd (make-backref-generator 0.3 0.2) +))133(define qsub (make-test-case-generator134 'qsub (make-backref-generator 0.3 0.2) -))135(define qmul (make-test-case-generator136 'qmul (make-backref-generator 0.3 0.2) *))137(define qdiv (make-test-case-generator138 'qdiv (make-backref-generator 0.3 0.2) /))139(define qtodec (make-test-case-generator140 'qtodec (make-output-test-generator 0.3 25)141 (lambda (a b) '?)))142(define qaddz (make-test-case-generator143 'qaddz (make-backref-generator-2 0.3 0.2) +))144(define qsubz (make-test-case-generator145 'qsubz (make-backref-generator-2 0.3 0.2) -))146(define qmulz (make-test-case-generator147 'qmulz (make-backref-generator-2 0.3 0.2) *))148(define qdivz (make-test-case-generator149 '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