/[gcl]/gcl/ansi-tests/cons-test-19.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/cons-test-19.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.4 by pfdietz, Wed Oct 23 03:10:23 2002 UTC revision 1.5 by pfdietz, Wed Nov 27 04:22:36 2002 UTC
# Line 10  Line 10 
10  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11  ;;; intersection  ;;; intersection
12    
 (defun is-intersection (x y z)  
   "Check that z is the intersection of x and y."  
   (and  
    (every #'(lambda (e)  
               (or (not (member e y))  
                   (member e z)))  
           x)  
    (every #'(lambda (e)  
               (or (not (member e x))  
                   (member e z)))  
           y)  
    (every #'(lambda (e)  
               (and (member e x) (member e y)))  
           z)  
    t))  
   
 (defun shuffle (x)  
   (cond  
    ((null x) nil)  
    ((null (cdr x)) x)  
    (t  
     (multiple-value-bind  
         (y z)  
         (split-list x)  
       (append (shuffle y) (shuffle z))))))  
   
 (defun split-list (x)  
   (cond  
    ((null x) (values nil nil))  
    ((null (cdr x)) (values x nil))  
    (t  
     (multiple-value-bind  
         (y z)  
         (split-list (cddr x))  
       (values (cons (car x) y) (cons (cadr x) z))))))  
     
   
13  (deftest intersection-1  (deftest intersection-1
14      (intersection nil nil)      (intersection nil nil)
15    nil)    nil)
# Line 184  Line 147 
147      (intersection-12-body 100 100)      (intersection-12-body 100 100)
148    nil)    nil)
149    
 (defun intersection-12-body (size niters &optional (maxelem (* 2 size)))  
   (let ((state (make-random-state)))  
   (loop  
    for i from 1 to niters do  
     (let ((x (shuffle (loop for j from 1 to size collect (random maxelem state))))  
           (y (shuffle (loop for j from 1 to size collect (random maxelem state)))))  
       (let ((z (intersection x y)))  
         (let ((is-good (is-intersection x y z)))  
           (unless is-good (return (values x y z)))))))  
   nil))  
   
150    
151  ;;  ;;
152  ;; :key argument  ;; :key argument
# Line 286  Line 238 
238  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
239  ;;; nintersection  ;;; nintersection
240    
 (defun nintersection-with-check (x y &key test)  
   (let ((ycopy (make-scaffold-copy y)))  
     (let ((result (if test  
                       (nintersection x y :test test)  
                     (nintersection x y))))  
       (if (check-scaffold-copy y ycopy)  
           result  
         'failed))))  
   
241  (deftest nintersection-1  (deftest nintersection-1
242    (nintersection nil nil)    (nintersection nil nil)
243    nil)    nil)
# Line 405  Line 348 
348    (nintersection-12-body 100 100)    (nintersection-12-body 100 100)
349    nil)    nil)
350    
 (defun nintersection-12-body (size niters &optional (maxelem (* 2 size)))  
   (let ((state (make-random-state t)))  
     (loop  
      for i from 1 to niters do  
      (let ((x (shuffle (loop for j from 1 to size collect (random maxelem state))))  
            (y (shuffle (loop for j from 1 to size collect (random maxelem state)))))  
        (let ((z (nintersection-with-check (copy-list x) y)))  
          (when (eqt z 'failed) (return (values x y z)))  
          (let ((is-good (is-intersection x y z)))  
            (unless is-good (return (values x y z)))))))  
     nil))  
   
351  ;; Key argument  ;; Key argument
352    
353  (deftest nintersection-13  (deftest nintersection-13

Legend:
Removed from v.1.4  
changed lines
  Added in v.1.5

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26