You're helping to write a large machine translation project whose implementation language is Scheme. Your project uses the builtin Scheme function map a lot, but it's proving to be inadequate. The basic problem is that map is defined to work only on lists, but you need two variants of map that work on other data structures in common use in your project.
First, your project uses many binary trees whose internal nodes are represented by pairs and whose leaves are non-pairs; as a special case, the empty list represents an absent leaf. For example, (a . (() . c)) represents a binary tree whose left subtree is the leaf a and whose right subtree is a subtree whose left and right subtrees are absent and c, respectively. More generally, a pair p represents a binary tree whose left subtree is (car p) and whose right subtree is (cdr p). So, for example, the list (a b (c d) (e (() f . g))), which is equivalent to (a . (b . ((c . (d . ())) . ((e . ((() . (f . g)))) . ())))), can be diagrammed as the following binary tree:
/\
/ \
a /\
/ \
b /\
/ \
/\ \
/ \ \
c /\ \
/ \ \
d () \
/\
/ \
/\ ()
/ \
e /\
/ \
/\ ()
/ \
() /\
/ \
f g
Second, your project uses a lot of ingrown binary trees (IBTs). These are like binary trees except that a node's sub-IBT is also allowed to be either the node itself, or one of the node's ancestors (i.e., on the path from the node to the tree's root). For example, after the following code is executed:
(define foo (list #f 2 3)) (set-car! foo foo) (set-cdr! (list-tail foo 2) (cdr foo))
then foo is an IBT that MzScheme prints as #0=(#0# . #1=(2 3 . #1#)); its left sub-IBT is foo itself, and its right sub-IBT is a value #1 such that (cdr (cdr #1)) is eq? to #1.
Write two functions, one designed for binary trees and the other designed for IBTs.
(mapbt proc bt1 bt2 …) applies proc element-wise to the elements of the binary trees bt1, bt2, … and returns a binary tree containing the results, in the same order that they appeared in the arguments. The bt arguments must be binary trees of the same shape; the result will also take that shape. Also, proc must be a procedure taking as many arguments as there are bts and returning a single value. There must be at least one bt argument.
(mapibt proc ibt1 ibt2 …) acts like mapbt, except that its arguments are IBTs rather than binary trees.
Your implementation of mapbt must be free of side effects; for example you cannot use the set! procedure. It should invoke cons only as many times as needed to construct the result; it should not invoke any other constructor.
Your implementation of mapibt is allowed to invoke the side-effect procedures set-car! and set-cdr!, but it should not use any other procedures with side effects. Also, it should not use set-car! and set-cdr! to modify its arguments; it should modify only the data structures that it creates. It need not minimize the number of calls to cons.
Your implementations can assume that the arguments of mapbt and mapibt are of the proper form. For example, you need not worry about a call like (mapbt cons '(a b) '(c (d e))), where the input binary trees are not all the same shape.
To turn in your assignment, submit a file bt.ss containing your Scheme code. The first line of bt.ss should be a comment containing your name and student ID. Make sure that your definitions work with MzScheme, the Scheme implementation installed on SEASnet.
Since mapibt is an extension of mapbt, every test case for mapbt is also a valid test case for mapibt, and should return the same result. The converse is not true, however: the mapibt test cases are not valid for mapbt.
(mapbt + '(37) '(12))
===> (49)
(mapbt cons
'(a b (c d) (e (f g)))
'(h i (j k) (l (m n))))
===> ((a . h) (b . i) ((c . j) (d . k)) ((e . l) ((f . m) (g . n))))
(mapbt list
'(a b (c d) (e (f g)))
'(h i (j k) (l (m n))))
===> ((a h) (b i) ((c j) (d k)) ((e l) ((f m) (g n))))
(mapbt * 3 5 7)
===> 105
(mapbt max '() '() '())
===> ()
(mapbt cons '(a . (() . c)) '(1 . (() . 3)))
===> ((a . 1) () c . 3)
(mapbt equal? '("abc" "def" (3.0 12.00)) '("abc" def (3 12.0)))
===> (#t #f (#f #t))
(mapbt * '((1 () 2) 3) '((4 () 5) 6) '((7 () 8) 9))
===> ((28 () 80) 162)
(mapbt mapbt
(list + * - / max list)
'( 1 2 3 4 5 6)
'( 7 8 9 10 11 12)
'( 13 14 15 16 17 18))
===> ( 21 224 -21 1/40 17 (6 12 18))
(define id (lambda (x) x))
(define a (list #f 2 3 4 5 6))
(set-car! a a)
(define b (mapibt - a))
(define c (mapibt id b))
(set-cdr! (list-tail c 5) c)
(define d (mapibt - c))
(define e (mapibt id a))
(define f (mapibt id a))
(set-car! (list-tail e 3) (cdr f))
(set-car! (list-tail f 3) (cdr e))
a
===> #0=(#0# 2 3 4 5 6)
b
===> #0=(#0# -2 -3 -4 -5 -6)
c
===> #0=(#0# -2 -3 -4 -5 -6 . #0#)
d
===> #0=(#0# 2 3 4 5 6 . #0#)
(list e f)
===> (#0=(#0# . #1=(2 3 #3=(2 3 #1# 5 6) 5 6)) #2=(#2# . #3#))
(mapibt * c d)
===> #0=(#0# -4 -9 -16 -25 -36 . #0#)
(mapibt / (cons 1 c) (cons 3 d))
===> (1/3 . #0=(#0# -1 -1 -1 -1 -1 . #0#))
(mapibt list e e)
===> #0=(#0# . #1=((2 2) (3 3) ((2 2) (3 3) #1# (5 5) (6 6)) (5 5) (6 6)))
(mapibt list e f)
===> #0=(#0# . #1=((2 2) (3 3) ((2 2) (3 3) #1# (5 5) (6 6)) (5 5) (6 6)))
(define (mapbt f obj1 . objs)
(let mapit ((obj1 obj1) (objs objs))
(cond ((pair? obj1)
(cons (mapit (car obj1) (map car objs))
(mapit (cdr obj1) (map cdr objs))))
((null? obj1)
'())
(else
(apply f obj1 objs)))))
(define (mapibt f obj1 . objs)
(let mapit ((obj1 obj1) (objs objs) (parents '()))
(cond ((pair? obj1)
(let ((already-seen (assq obj1 parents)))
(if already-seen
(cdr already-seen)
(let* ((result (cons #f #f))
(parents1 (cons (cons obj1 result) parents)))
(set-car! result (mapit (car obj1) (map car objs) parents1))
(set-cdr! result (mapit (cdr obj1) (map cdr objs) parents1))
result))))
((null? obj1)
'())
(else
(apply f obj1 objs)))))