;;; Procedure:
;;; complicate
;;; Parameters:
;;; lst, a list
;;; Purpose:
;;; Duplicate and rearrange lst.
;;; Produces:
;;; complicated, a list
;;; Preconditions:
;;; [Standard]
;;; Postconditions:
;;; If a value, v, appears in lst, it appears at least once in complicated.
;;; If a value, v, appears in complicated, it appears in lst.
;;; The order of the values in v is different than the order of
;;; the values in complicated.
(define complicate
(lambda (lst)
(cond
((null? lst) null)
((= (random 6) 0) (cons (car lst) (complicate (cdr lst))))
((= (random 5) 0) (append (complicate (cdr lst)) (list (car lst))))
((= (random 2) 0) (cons (car lst) (complicate lst)))
(else (append (complicate lst) (list (car lst)))))))
;;; Procedure:
;;; intersection
;;; Parameters:
;;; left, a list
;;; right, a list
;;; Purpose:
;;; To produce a new list from left and right. The elements of that
;;; list are the elements that are shared by left and right.
;;; Produces:
;;; newlist, a list of the form (n1 n2 ... nk)
;;; Preconditions:
;;; [Standard]
;;; Postconditions:
;;; For each value, n, in newlist, n is an element of left and n is an
;;; element of right.
;;; For each value, n, that appears in left or right, n appears in
;;; newlist the minimum of the number of times it appears in left
;;; and the number of times it appears in right.
;;; Process:
;;; Recurse over the first list, checking each element in turn against
;;; the second list. Keep only those that appear in the second list.
(define weird-intersection
(lambda (left right)
(intersection (complicate left) (complicate right))))
(define intersection
; Determine if val appears in lst
; A value appears in a list if
; (a) The list is not empty
; and
; (b) either (1) the value is the first element of the list
; or (2) the value is one of the remaining elements.
(letrec ((member?
(lambda (val lst)
(and (not (null? lst))
(or (equal? val (car lst))
(member? val (cdr lst)))))))
(lambda (left right)
(cond
; The intersection of the empty list and another list is empty.
((null? left) null)
; Obvious.
((member? (car left) right)
(cons (car left) (intersection (cdr left) right)))
; If the first element of the first list does not appear in the
; other list, it can't be in the intersection.
(else (intersection (cdr left) right))))))
(define safe-intersection
; Determine if val appears in lst
; A value appears in a list if
; (a) The list is not empty
; and
; (b) either (1) the value is the first element of the list
; or (2) the value is one of the remaining elements.
(letrec ((member?
(lambda (val lst)
(and (not (null? lst))
(or (equal? val (car lst))
(member? val (cdr lst)))))))
(lambda (left right)
(cond
; The intersection of the empty list and another list is empty.
((null? left) null)
; The intersection of a list with the initial element repeated
; is the same as the intersection of that list w/o the initial
; element
((member? (car left) (cdr left))
(safe-intersection (cdr left) right))
; Obvious.
((member? (car left) right)
(cons (car left) (safe-intersection (cdr left) right)))
; If the first element of the first list does not appear in the
; other list, it can't be in the intersection.
(else (safe-intersection (cdr left) right))))))
;;; Problem: We need to look at every element of right.
; Observation: If a value appears twice in right, it appears only once
; in newlist. However, if a value appears twice in left, it appears
; twice in newlist.
;;; Procedure:
;;; delete-one
;;; Parameters:
;;; val, a Scheme value
;;; lst, a Scheme list of the form (v_1 v_2 ... v_n)
;;; Purpose:
;;; Delete one copy of val from lst.
;;; Produces:
;;; newlst, a list
;;; Preconditions:
;;; [Standard]
;;; Postconditions:
;;; If there is a v_i such that v_i = val then
;;; newlst has the form (v_1 v_2 ... v_(i-1) v_(i+1) ... v_n)
;;; Otherwise,
;;; newlst equals lst.
(define delete-one
(lambda (val lst)
(cond
((null? lst) null)
((equal? val (car lst)) (cdr lst))
(else (cons (car lst) (delete-one val (cdr lst)))))))
(define seth-intersection
; Determine if val appears in lst
; A value appears in a list if
; (a) The list is not empty
; and
; (b) either (1) the value is the first element of the list
; or (2) the value is one of the remaining elements.
(letrec ((member?
(lambda (val lst)
(and (not (null? lst))
(or (equal? val (car lst))
(member? val (cdr lst)))))))
(lambda (left right)
(display (list "intersection" left right))
(newline)
(cond
; The intersection of the empty list and another list is empty.
((null? left) null)
; Obvious.
((member? (car left) right)
(cons (car left)
(seth-intersection (cdr left) (delete-one (car left) right))))
; If the first element of the first list does not appear in the
; other list, it can't be in the intersection.
(else (seth-intersection (cdr left) right))))))