;; Nada Amin (namin@mit.edu)
;; 6.945 Problem Set 2
;; Due: Wed. 20 Feb. 2008

;; Problem 2.1

(define (sequence:construct type . items)
  (generic:list-construct type items))

(define generic:list-construct (make-generic-operator 2 #f))

(assign-operation generic:list-construct 
		  (lambda (type items)
		    (apply string items))
		  (is-exactly string?)
		  list?)

(assign-operation generic:list-construct 
		  (lambda (type items)
		    items)
		  (is-exactly list?)
		  list?)

(assign-operation generic:list-construct 
		  (lambda (type items)
		    (apply vector items))
		  (is-exactly vector?)
		  list?)
#|
(sequence:construct string? 'foo 'miao 'bar)
;Value: "foomiaobar"

(sequence:construct list? 'foo 'miao 'bar)
;Value: (foo miao bar)

(sequence:construct vector? 'foo 'miao 'bar)
;Value: #(foo miao bar)
|#

;;; (sequence:null <sequence-type>) already implemented
;;; (sequence:ref <sequence> <i>) already implemented
;;; (sequence:size <sequence>) already implemented
;;; (sequence:type <sequence>) already implemented
;;; (sequence:null? <sequence>) already implemented

(define sequence:equal? equal?)

;;; (sequence:set! <sequence> <i> <v>) already implemented
;;;  (sequence:subsequence <sequence> <start> <end>) already implemented
;;; (sequence:append <sequence-1> ... <sequence-n>) already implemented

(define (range from to)
  (if (= from to)
      '()
      (cons from (range (+ from 1) to))))

(define (sequence:generate type n fun)
  (apply sequence:construct type (map fun (range 0 n))))

#|
(sequence:generate 
 string? 3 
 (lambda (i) (string-append "foo" (number->string i))))
;Value: "foo0foo1foo2"

(sequence:generate 
 list? 3 
 (lambda (i) (string-append "foo" (number->string i))))
;Value: ("foo0" "foo1" "foo2")

(sequence:generate 
 vector? 3 
 (lambda (i) (string-append "foo" (number->string i))))
;Value: #("foo0" "foo1" "foo2")
|#

;; these helpers will make it easier to define 
;; some generic sequence procedures just in terms
;; of lists

(define generic:to-list (make-generic-operator 1 #f))

(assign-operation generic:to-list
		  (lambda (lst) lst)
		  list?)

(assign-operation generic:to-list
		  vector->list
		  vector?)

(assign-operation generic:to-list
		  string->list
		  string?)

(define generic:from-list (make-generic-operator 2 #f))

(assign-operation generic:from-list
		  (lambda (type lst) lst)
		  (is-exactly list?)
		  list?)

(assign-operation generic:from-list
		  (lambda (type lst) (list->vector lst))
		  (is-exactly vector?)
		  list?)

(assign-operation generic:from-list
		  (lambda (type lst) (apply string lst))
		  (is-exactly string?)
		  list?)

(define (generic:check-sequences sequences)
  (let ((type (sequence:type (car sequences)))
	(size (sequence:size (car sequences))))
    (if (or (not (for-all? (cdr sequences) type))
	    (not (for-all? (cdr sequences) 
			   (lambda (seq) 
			     (= size (sequence:size seq))))))
	(error 
	 "All sequences must be of the same type and size"
	 sequences)
	#t)))

(define (sequence:map fun . sequences)
  (generic:check-sequences sequences)
  (let ((type (sequence:type (car sequences))))
    (generic:from-list type
     (apply map fun (map generic:to-list sequences)))))

#|

(sequence:map (lambda (a b c)
		(string-append a " " b " " c))
	      (sequence:construct list? "art" "time")
	      (sequence:construct list? "is" "is")
	      (sequence:construct list? "long" "fleeting"))
;Value: ("art is long" "time is fleeting")

(sequence:map (lambda (a b c)
		(string-append a " " b " " c))
	      (sequence:construct vector? "art" "time")
	      (sequence:construct vector? "is" "is")
	      (sequence:construct vector? "long" "fleeting"))
;Value: #("art is long" "time is fleeting")

(sequence:map (lambda (a b c)
		(string a b c))
	      "a1"
	      "b2"
	      "c3")
;Value: "abc123"
|#

(define (sequence:for-each fun . sequences)
  (generic:check-sequences sequences)
  (apply for-each fun (map generic:to-list sequences)))

#|
(sequence:for-each (lambda (a b c)
		     (display (string-append a " " b " " c "\n")))
	      (sequence:construct list? "art" "time")
	      (sequence:construct list? "is" "is")
	      (sequence:construct list? "long" "fleeting"))
art is long
time is fleeting
;Unspecified return value

(sequence:for-each (lambda (a b c)
		     (display (string-append a " " b " " c "\n")))
	      (sequence:construct vector? "art" "time")
	      (sequence:construct vector? "is" "is")
	      (sequence:construct vector? "long" "fleeting"))
art is long
time is fleeting
;Unspecified return value

(sequence:for-each (lambda (a b c)
		     (display (string a b c "\n")))
		   "a1"
		   "b2"
		   "c3")
abc
123
;Unspecified return value

|#

(define (sequence:filter sequence predicate)
  (generic:from-list (sequence:type sequence)
   (filter predicate (generic:to-list sequence))))

#|

(sequence:filter '(1 2 3 4) even?)
;Value: (2 4)

(sequence:filter (vector 1 2 3 4) even?)
;Value: #(2 4)

(sequence:filter 
 "1234" 
 (lambda (c) (even? (string->number (string c)))))
;Value: "24"

|#

(define (sequence:get-index sequence predicate)
  (define (get-index i n)
    (cond ((= i n)
	   #f)
	  ((predicate (sequence:ref sequence i))
	   i)
	  (else (get-index (+ i 1) n))))
  (get-index 0 (sequence:size sequence)))

#|

(sequence:get-index '(1 2 3 4) even?)
;Value: 1

(sequence:get-index (vector 1 2 3 4) even?)
;Value: 1

(sequence:get-index
 "1234" 
 (lambda (c) (even? (string->number (string c)))))
;Value: 1

(sequence:get-index '(1 3) even?)
;Value: #f

|#

(define (sequence:get-element sequence predicate)
  (let ((index (sequence:get-index sequence predicate)))
    (and index
	 (sequence:ref sequence index))))

#|

(sequence:get-element '(1 2 3 4) even?)
;Value: 2

(sequence:get-element (vector 1 2 3 4) even?)
;Value: 2

(sequence:get-element
 "1234" 
 (lambda (c) (even? (string->number (string c)))))
;Value: #\2

(sequence:get-element '(1 3) even?)
;Value: #f

|#

(define (sequence:fold-right fun init sequence)
  (fold-right fun init (generic:to-list sequence)))

#|

(sequence:fold-right list 'end '(a b c))
;Value: (a (b (c end)))

(sequence:fold-right list 'end (vector 'a 'b 'c))
;Value: (a (b (c end)))

(sequence:fold-right list 'end "abc")
;Value: (#\a (#\b (#\c end)))

|#

(define (sequence:fold-left fun init sequence)
  (fold-left fun init (generic:to-list sequence)))

#|

(sequence:fold-left list 'start '(a b c))
;Value: (((start a) b) c)

(sequence:fold-left list 'start (vector 'a 'b 'c))
;Value: (((start a) b) c)

(sequence:fold-left list 'start "abc")
;Value: (((start #\a) #\b) #\c)

|#

;; Problem 2.2

#|

The only procedures that might benefit from mixing combinations of
sequence types are those that take more than one sequence, obviously.
Here are all such procedures, which I have amended:

|#

;;; (sequence:equal? <sequence-1> <sequence-2>)
;;;    Returns #t if the sequences have equal elements in the same
;;;    order, otherwise returns #f.

;;; (sequence:append <sequence-1> ... <sequence-n>)
;;;    Returns a new sequence of the first type, formed by
;;;    concatenating the elements of the given sequences.  The size of
;;;    the new sequence is the sum of the sizes of the given
;;;    sequences.

;;; (sequence:map <function> <seq-1> ... <seq-n>)
;;;    Requires that the sequences given are of the same size, and
;;;    that the arity of the function is n.  Returns a new sequence of
;;;    the first type. The ith element of the new sequence is the
;;;    value of the function applied to the n ith elements of the
;;;    given sequences.

;;; (sequence:for-each <procedure> <seq-1> ... <seq-n>)
;;;    Requires that the sequences given are of the same size, and
;;;    that the arity of the procedure is n.  Applies the procedure to
;;;    the n ith elements of the given sequences; discards the value.
;;;    This is done for effect.

(define (sequence:equal? seq1 seq2)
  (let ((n (sequence:size seq1)))
    (define (same-elements i)
      (or (= i n)
	  (and (equal? (sequence:ref seq1 i) (sequence:ref seq2 i))
	       (same-elements (+ i 1)))))
    (and (= n (sequence:size seq2))
	 (same-elements 0))))

#|

(sequence:equal? '(1 2 3) (vector 1 2 3))
;Value: #t

(sequence:equal? "123" '(#\1 #\2 #\3))
;Value: #t

(sequence:equal? "1234" '(#\1 #\2 #\3))
;Value: #f

(sequence:equal? "123" '(#\1 #\2 #\3 #\4))
;Value: #f

(sequence:equal? "" '())
;Value: #t

(sequence:equal? "" (vector))
;Value: #t

|#	

(define (compose-2nd-arg f g)
  (lambda (x y) (f x (g y))))

(define (vector->string x) (list->string (vector->list x)))
(define (string->vector x) (list->vector (string->list x)))

(assign-operation 
 generic:binary-append 
 (compose-2nd-arg string-append list->string)
 string? 
 list?)

(assign-operation 
 generic:binary-append 
 (compose-2nd-arg string-append vector->string)
 string? 
 vector?)

(assign-operation 
 generic:binary-append 
 (compose-2nd-arg vector-append string->vector)
 vector? 
 string?)

(assign-operation 
 generic:binary-append 
 (compose-2nd-arg vector-append list->vector)
 vector? 
 list?)

(assign-operation 
 generic:binary-append 
 (compose-2nd-arg append string->list)
 list? 
 string?)

(assign-operation 
 generic:binary-append 
 (compose-2nd-arg append vector->list)
 list? 
 vector?)

;; removing the same type check
(define (sequence:append . sequences)
  (if (null? sequences)
      (error "Need at least one sequence for append"))
  (fold-right generic:binary-append
	      (sequence:null (sequence:type (car sequences)))
	      sequences))
#|

(sequence:append "foo" '(#\b #\a #\r))
;Value: "foobar"

(sequence:append "foo" '(#\b #\a #\r) (vector #\f #\o #\o))
;Value: "foobarfoo"

(sequence:append (vector #\f #\o #\o) "foo" '(#\b #\a #\r))
;Value: #(#\f #\o #\o #\f #\o #\o #\b #\a #\r)

(sequence:append (vector 'f 'oo) '(miao miao))
;Value: #(f oo miao miao)

|#

;; for map and for-each
;; I simply need to remove the type check
;; as the code works already like the new spec
(define (generic:check-sequences sequences)
  (let ((size (sequence:size (car sequences))))
    (if (not (for-all? (cdr sequences)
		       (lambda (seq) 
			 (= size (sequence:size seq)))))
	(error 
	 "All sequences must be of the same size"
	 sequences)
	#t)))

#|

(sequence:map (lambda (a b c)
		(string-append a " " b " " c))
	      (sequence:construct list? "art" "time")
	      (sequence:construct vector? "is" "is")
	      (sequence:construct list? "long" "fleeting"))
;Value: ("art is long" "time is fleeting")

(sequence:map (lambda (a b c)
		(string-append a " " b " " c))
	      (sequence:construct vector? "art" "time")
	      (sequence:construct list? "is" "is")
	      (sequence:construct vector? "long" "fleeting"))
;Value: #("art is long" "time is fleeting")

(sequence:map (lambda (a b c)
		(string a b c))
	      "a1"
	      '(b 2)
	      (vector 'c '3))
;Value: "abc123"

|#

;; Problem 2.3

#|

It doesn't seem like a good idea to move the folding to the
type-specific procedures since the folding is the same for all types.

If we want to allow creation of procedures with unspecified arity in
the generic dispatch, we would need a more general dispatch mechanism
as it is impossible to separately specify the type of each argument
when the operator has variable arity.

I would change make-generic-operator to take an additional boolean,
variable-arity, which would indicate that the generic procedures takes
at least (as opposed to exactly) as many arguments as its formal
arity.

For assign-operation, operators with variable arities would take an
additional predicate of variable arity that would receive all the
extra arguments.

|#

;; Problem 2.4

#|

A. Louis' implementation of list<? doesn't ensure that
   (list<? x y) implies (not (list<? y x)) (when x != y).
   Indeed, define x and y as follows:
   (define x '(2 1 2 3))
   (define y '(1 2 3 4))
   Then, (list<? x y) is #t but (list<? y x) is also #t.

   A generic:less? with this behavior
   would cause problems if it were used to sort sets, 
   because the relative order of elements x and y 
   that satisfy both 
   (generic:less? x y) and (generic:less? y x)
   would be undefined. So two sets that are equal could
   end up with different representations. For example, 
   the set containing x and y could be represented
   sometimes as (x y) and sometimes as (y x). 
   This could be bad: for example, the seq:equal? 
   operation could fail.

B. The disadvantage of implementing generic:less? as an explicit case
   analysis is that it makes it tricky to extend to cover more data
   types, specially if many developers want to add data types at
   once. Indeed, the entire procedure would have to be re-evaluated.  In
   addition, we wouldn't be able to take advantage of any optimizations
   used in the dispatch implementation.

   In addition, since we're using predicate dispatch as opposed to
   tags, we don't actually need to put n^2 items into the table as we can
   combine types in our predicates or even use a default procedure (see
   implementation below).

|#

;; C.

(define (null<? x y)
  #f)

;; #f < #t
;; x<y #f #t
;; #f  #f #t
;; #t  #f #f
(define (boolean<? x y)
  (and (not x) y))

(define (vector<? vector-1 vector-2)
  (list<? (vector->list vector-1) (vector->list vector2)))

(define (list<? list-1 list-2)
  (let ((len-1 (length list-1))
        (len-2 (length list-2)))
    (cond ((< len-1 len-2) #t)
          ((> len-1 len-2) #f)
          ;; Invariant:  equal lengths
          (else
           (let prefix<? ((list-1 list-1)
                          (list-2 list-2))
             (cond ((null? list-1) #f)  ; same
                   ((generic:less? (car list-1) (car list-2)) #t)
                   ((generic:less? (car list-2) (car list-1)) #f)
                   (else (prefix<? (cdr list-1) (cdr list-2)))))))))

(define (less-true x y) #t)
(define (less-false x y) #f)
(define ((compose f g) x) (f (g x)))
(define ((or-compose . fs) x)
  (and (not (null? fs))
       (or ((car fs) x)
	   ((apply or-compose (cdr fs)) x))))

(define generic:less?
  (make-generic-operator 2 less-false))

(assign-operation 
 generic:less? 
 null<?
 null?
 null?)

(assign-operation 
 generic:less? 
 boolean<?
 boolean?
 boolean?)

(assign-operation 
 generic:less? 
 char<?
 char?
 char?)

(assign-operation 
 generic:less? 
 <
 number?
 number?)

(assign-operation 
 generic:less? 
 symbol<?
 symbol?
 symbol?)

(assign-operation 
 generic:less? 
 string<?
 string?
 string?)

(assign-operation 
 generic:less? 
 vector<?
 vector?
 vector?)

(assign-operation 
 generic:less? 
 list<?
 pair?
 pair?)

(assign-operation
 generic:less? 
 less-true
 null?
 (compose not null?))


(assign-operation
 generic:less?
 less-true
 boolean?
 (compose not (or-compose null? boolean?)))

(assign-operation
 generic:less?
 less-true
 char?
 (compose not (or-compose null? boolean? char?)))
 
(assign-operation
 generic:less?
 less-true
 number?
 (compose not (or-compose null? boolean? char? number?)))

(assign-operation
 generic:less?
 less-true
 symbol?
 (compose not (or-compose null? boolean? char? number? symbol?)))

(assign-operation
 generic:less?
 less-true
 string?
 (compose not (or-compose null? boolean? char? number? symbol? string?)))

(assign-operation
 generic:less?
 less-true
 vector?
 (compose not (or-compose null? boolean? char? number? symbol? string? vector?)))

#|

(generic:less? 3 (list 1 2 3))
;Value: #t


(generic:less? '() #f)
;Value: #t

(generic:less? #f '())
;Value: #f

(generic:less? '() '(list 1 2 3))
;Value: #t

(generic:less? '(list 1 2 3) '())
;Value: #f

|#

(define (remove-adjacent-duplicates lst)
  (cond ((or (null? lst) (null? (cdr lst))) lst)
	((equal? (car lst) (cadr lst)) (remove-adjacent-duplicates (cdr lst)))
	(else (cons (car lst) (remove-adjacent-duplicates (cdr lst))))))

(define list->set
  (lambda (lst) 
    (remove-adjacent-duplicates (sort lst generic:less?))))

(define generic:sequence->set (make-generic-operator 1 #f))
(assign-operation
 generic:sequence->set
 list->set
 list?)

(assign-operation
 generic:sequence->set
 (compose list->set vector->list)
 vector?)

(assign-operation
 generic:sequence->set
 (compose list->set string->list)
 string?)

(define set:equal? equal?)

(define (set:union set1 set2)
  (list->set (append set1 set2)))

(define (set:intersection set1 set2)
  (cond ((or (null? set1) (null? set2))
	 '())
	((equal? (car set1) (car set2))
	 (cons (car set1) (set:intersection (cdr set1) (cdr set2))))
	((generic:less? (car set1) (car set2))
	 (set:intersection (cdr set1) set2))
	((generic:less? (car set2) (car set1))
	 (set:intersection set1 (cdr set2)))
	(else
	 (error "(car set1) and (car set2) incomparable!" (list set1 set2)))))

(define (set:difference set1 set2)
  (cond ((or (null? set1) (null? set2)) set1)
	((equal? (car set1) (car set2))
	 (set:difference (cdr set1) (cdr set2)))
	((generic:less? (car set1) (car set2))
	 (cons (car set1) (set:difference (cdr set1) set2)))
	((generic:less? (car set2) (car set1))
	 (set:difference set1 (cdr set2)))
	(else
	 (error "(car set1) and (car set2) incomparable!" (list set1 set2)))))

(define (set:strict-subset? set1 set2)
  (define (set:subset? set1 set2)
    (cond ((null? set1) #t)
	  ((null? set2) #f)
	  ((equal? (car set1) (car set2)) (set:subset? (cdr set1) (cdr set2)))
	  ((generic:less? (car set1) (car set2)) #f)
	  ((generic:less? (car set2) (car set1)) (set:subset? set1 (cdr set2)))
	  (else
	   (error "(car set1) and (car set2) incomparable!" (list set1 set2)))))
  (and (not (set:equal? set1 set2))
       (set:subset? set1 set2)))

#|

(generic:sequence->set (vector 1 2 3 2 1))
;Value: (1 2 3)

(generic:sequence->set (vector 1 2 3 2 1 #\a "foo" (list 3 2 1)))
;Value: (#\a 1 2 3 "foo" (3 2 1))

(set:union (generic:sequence->set (list 3 2 1)) (generic:sequence->set (list 1 4 5 2)))
;Value: (1 2 3 4 5)

(set:intersection (generic:sequence->set (list 3 2 1)) (generic:sequence->set (list 1 4 5 2)))
;Value: (1 2)

(set:difference (generic:sequence->set (list 3 2 1)) (generic:sequence->set (list 1 4 5 2)))
;Value: (3)

(set:strict-subset? (generic:sequence->set (list 1 2 3)) (generic:sequence->set (list 1 2 3)))
;Value: #f

(set:strict-subset? (generic:sequence->set (list 1 2 3)) (generic:sequence->set (list 1 2 3 "foo" #\a)))
;Value: #t

|#

#|

D. With Alyssa's recommendation, the procedure to construct sets is
   more complex (both in code size and run-time) in order for the 
   procedures that manipulate sets to be simpler.

   run time       | Alyssa      | Sequence Representation
   sequence->set  | O(n log n)  | O(1)
   equal?         | O(n)        | O(n^2)

   If we didn't use Alyssa's recommendation, all our procedures that
   manipulate sets would be much more complicated because the mapping
   between the abstract representation and the internal representation
   (as just an underspecified sequence) would be much more complex.

|#

;; Problem 2.5

#|

Predicate dispatch costs as much as the predicates do. The issue is
that catching doesn't really make sense, because we're unlikely to
come across the exact same values many times.

With data tags, we can cache the dispatch on the tag, so that next
time the same tag is used, we can just call up the procedure as
opposed to calling the dispatch method.

Predicate dispatch gives us more flexibility compared to tag
dispatch. In particular, in problem 2.4, we were able to combine data
types to avoid having to store n^2 items manually in the dispatch
table. This wouldn't be possible with a simple tag system.

|#