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) |
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 |
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) |
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 |