summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorbnewbold <bnewbold@eta.mit.edu>2009-02-24 19:53:14 -0500
committerbnewbold <bnewbold@eta.mit.edu>2009-02-24 19:53:14 -0500
commit3743c40e8c99d59abd95481848cb9e773a0c1ce4 (patch)
tree3a312d0cf24deae3fd0314faef2dc336fd4804e4
parentd63676b79430cac0b54bf50de5564a533866f9e2 (diff)
download6.945-3743c40e8c99d59abd95481848cb9e773a0c1ce4.tar.gz
6.945-3743c40e8c99d59abd95481848cb9e773a0c1ce4.zip
problem set 2
-rw-r--r--.gitignore1
-rw-r--r--ps02_generics/amended-specs.txt129
-rw-r--r--ps02_generics/bnewbold_ps02.txt94
-rw-r--r--ps02_generics/full-gen-seq.scm632
4 files changed, 856 insertions, 0 deletions
diff --git a/.gitignore b/.gitignore
index 24b146d..ca5849d 100644
--- a/.gitignore
+++ b/.gitignore
@@ -4,3 +4,4 @@ toread*
*.swp
*~
*.bak
+./ps02_generics/predicate-dispatch.pdf
diff --git a/ps02_generics/amended-specs.txt b/ps02_generics/amended-specs.txt
new file mode 100644
index 0000000..d43469e
--- /dev/null
+++ b/ps02_generics/amended-specs.txt
@@ -0,0 +1,129 @@
+;;;; Generic sequence operations
+
+;;; There are many kinds of data that can be used to represent sequences:
+;;; examples include strings, lists, and vectors.
+
+;;; There are operations that can be defined for all sequence types.
+
+;;; Constructing
+;;;
+;;; (sequence:construct <sequence-type> <item-1> ... <item-n>)
+;;; Constructs a new sequence of the given type and of size n with
+;;; the given elements: item-1 ... item-n
+
+;;; (sequence:null <sequence-type>)
+;;; Produces the null sequence of the given type
+
+
+;;; Selecting
+;;;
+;;; (sequence:ref <sequence> <i>)
+;;; Returns the ith element of the sequence. We use zero-based
+;;; indexing, so for a sequence of length n the ith item is
+;;; referenced by (sequence:ref <sequence> <i-1>).
+
+;;; (sequence:size <sequence>)
+;;; Returns the number of elements in the sequence.
+
+;;; (sequence:type <sequence>)
+;;; Returns the predicate defining the type of the sequence given.
+
+
+;;; Testing
+;;;
+;;; (sequence:null? <sequence>)
+;;; Returns #t if the sequence is null, otherwise returns #f.
+
+;;; (sequence:equal? <sequence-1> <sequence-2>)
+;;; Returns #t if the sequences are of the same type and have equal
+;;; elements in the same order, otherwise returns #f.
+
+; ADDITION:
+;;; (sequence:elements-equal? <sequence-1> <sequence-2>
+;;; Returns #t if the sequences have equal elements in the same order;
+;;; the sequences do not have to be of the same type. Otherwise
+;;; returns #f.
+
+
+;;; Mutation
+;;;
+;;; Some sequences are immutable, while others can be changed.
+;;;
+;;; For those that can be modified we can change an element:
+;;;
+;;; (sequence:set! <sequence> <i> <v>)
+;;; Sets the ith element of the sequence to v.
+
+;;; Cutting and Pasting
+;;;
+;;; (sequence:subsequence <sequence> <start> <end>)
+;;; The arguments start and end must be exact integers such that
+;;; 0 <= start <= end <= (sequence:size <sequence>).
+;;; Returns a new sequence of the same type as the given sequence,
+;;; of size end-start with elements selected from the given sequence.
+;;; The new sequence starts with the element of the given sequence
+;;; referenced by start. It ends with the element of the given
+;;; sequence referenced by end-1.
+
+;CHANGED:
+;;; (sequence:append <sequence-1> ... <sequence-n>)
+;;; Returns a new sequence of the type of the first sequence, 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.
+
+;;; Iterators
+;;;
+;;; (sequence:generate <sequence-type> <n> <function>)
+;;; Makes a new sequence of the given sequence type, of size n.
+;;; The ith element of the new sequence is the value of the
+;;; function at the index i.
+
+; CHANGED:
+;;; (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. The ith element
+;;; of the new sequence is the value of the function applied to the
+;;; n ith elements of the given sequences.
+
+; CHANGED:
+;;; (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.
+
+;;; Filtration and Search
+;;;
+;;; (sequence:filter <sequence> <predicate>)
+;;; Returns a new sequence with exactly those elements of the given
+;;; sequence for which the predicate is true (does not return #f).
+;;;
+;;; (sequence:get-index <sequence> <predicate>)
+;;; Returns the index of the first element of the sequence that
+;;; satisfies the predicate. Returns #f if no element of the
+;;; sequence satisfies the predicate.
+;;;
+;;; (sequence:get-element <sequence> <predicate>)
+;;; Returns the first element of the sequence that satisfies the
+;;; predicate. Returns #f if no element of the sequence satisfies
+;;; the predicate.
+
+;;; Accumulation
+;;;
+;;; (sequence:fold-right <function> <initial> <sequence>)
+;;; Returns the result of applying the given binary function,
+;;; from the right, starting with the initial value.
+;;; For example,
+;;; (sequence:fold-right list 'end '(a b c))
+;;; => (a (b (c end)))
+
+;;;
+;;; (sequence:fold-left <function> <initial> <sequence>)
+;;; Returns the result of applying the given binary function,
+;;; starting with the initial value, from the left.
+;;; For example,
+;;; (sequence:fold-left list 'start '(a b c))
+;;; => (((start a) b) c)
+
+
+
diff --git a/ps02_generics/bnewbold_ps02.txt b/ps02_generics/bnewbold_ps02.txt
new file mode 100644
index 0000000..1e6fbb5
--- /dev/null
+++ b/ps02_generics/bnewbold_ps02.txt
@@ -0,0 +1,94 @@
+;;; 6.945 Problem Set #2
+;;; 02/17/2009
+;;; Bryan Newbold <bnewbold@mit.edu>
+
+
+Problem 2.1
+------------------------
+(see attached code: gen-full-seq.scm)
+
+Problem 2.2
+------------------------
+(see attached code: amended-specs.txt,
+ gen-full-seq.scm)
+
+I changed sequence:append, sequence:map, sequence:for-each, and added
+sequence:elements-equal? to the specifications, but I only implemented the
+changes to sequence:append.
+
+Problem 2.3
+------------------------
+As we saw with sequence:append, the nice thing about folding with generic
+operators is that the "unspecified arity" part of the arguments can be made
+of any type of objects; this flexibility can be powerful. However, it could be
+more difficult to remove this ambiguity: if you only wanted, for instance,
+an arbitrary number of strings, you will have to check every single element
+of the argument while folding, or create special non-generic operators which
+check for themselves.
+
+One way to implement this flexibility would be to add a formal argument to
+make-generic-operator which would flag that the last predicate should be
+repeated for arbitrary many arguments, and save this flag in the table. Then
+specify either a specific predicate or any? when using assign-operation, and
+the operator defined within make-generic-operator would have to know to check
+for this flag when it has extra arguments and reapply the last predicate to all
+successive arguments.
+
+Problem 2.4
+------------------------
+A) The problem with Louis' implementation is that the car-s of the two lists
+aren't checked properly leading to possible not-well-orderings such as:
+
+'(2 1) < '(1 2) => true
+'(1 2) < '(2 1) => true
+
+And so either of the following ordered lists could be generated as sets:
+
+'(1 (2 1) (1 2) (a b c))
+'(1 (1 2) (2 1) (a b c))
+
+which ruins the 1-1 correspondence between ordered lists and sets.
+
+B) It would be harder to extend Alyssa's implementation because it is not
+modular: if later on Ben wanted to add a complex number type to the ordering
+and Louis wanted to add a puppy type to the ordering, they would both have to
+edit the single generic:less? procedure: loading one new version or the other
+would clobber the other's changes.
+
+C) (see attached code: gen-full-seq.scm)
+
+D) Without Alyssa's recommendation, I wouldn't have been able to reuse the
+existing scheme list manipulation tools and get correct results with reasonable
+computational complexity; the ordering makes the existing algorithms run
+quickly. Rewriting all of the set membership searches for a different data
+structure would have taken a lot of code and could potentially have had high
+computational overhead. Of course using hash tables or other techniques could
+improve membership searches even more...
+
+Problem 2.5
+------------------------
+Playing off the themes of this course, using predicate dispatch allows us to
+reuse existing data structures and types in ways they may not have originally
+been intended for. For systems with types already tagged, the predicate call
+overhead should be minimal, and for systems without tagging, it is very
+possible that the predicate overhead is not greater than the resources required
+to tag all of the individual objects. Using memoization would further reduce
+overhead by essentially only tagging those objects whose type will be important
+later.
+
+The predicate method also allows for additional flexibility when considering
+complicated type hierarchies; primitives would either have to be multiply
+tagged, have a more intelligent tag-checking predicate (eg, return multiple
+tags: *complex*, *real*, and *rational* for a tagged *rational* number), or
+have a HUGE procedure lookup table.
+
+I can't really think of a situation where the performance overhead of tags
+versus predicate dispatch would matter at all: any performance critical
+operation should be optimizing with static types anyways. Maybe a tagged data
+dispatch system would be easier for compiler to analyze and optimize?
+
+In short, a predicate dispatch /system/ can accommodate tagged /data/ quite
+easily with no loss of flexibility. Data with associated predicates could
+easily be statically tagged in specific instances with a loss of flexibility
+but the potential for run-time efficiency.
+
diff --git a/ps02_generics/full-gen-seq.scm b/ps02_generics/full-gen-seq.scm
new file mode 100644
index 0000000..e91ce30
--- /dev/null
+++ b/ps02_generics/full-gen-seq.scm
@@ -0,0 +1,632 @@
+;;;; Generic sequence operator definitions
+;;;; Filled in by Bryan Newbold for 6.945 problem set #2, Feb 19 2009
+
+; ===================== Problem 2.1 =======================
+
+(load "ghelper.scm")
+
+;;; First we declare the operators we want to be generic.
+;;; Each declaration specifies the arity (number of arguments)
+;;; and the default operation, if necessary.
+
+(define sequence:ref
+ (make-generic-operator 2 #f))
+
+(define sequence:size
+ (make-generic-operator 1 #f))
+
+(define sequence:type
+ (make-generic-operator 1 #f))
+
+(define sequence:null?
+ (make-generic-operator 1 #f))
+
+(define sequence:null
+ (make-generic-operator 1 #f))
+
+(define sequence:equal?
+ (make-generic-operator 2 #f))
+
+(define sequence:set!
+ (make-generic-operator 3 #f))
+
+(define sequence:subsequence
+ (make-generic-operator 3 #f))
+
+
+;;; sequence:append takes multiple arguments. It is defined in terms
+;;; of a binary generic append that takes a sequence and a list of sequences.
+
+(define (sequence:append . sequences)
+ (if (null? sequences)
+ (error "Need at least one sequence for append"))
+ (let ((type? (sequence:type (car sequences))))
+ (if (not (for-all? (cdr sequences) type?))
+ (error "All sequences for append must be of the same type"
+ sequences))
+ (fold-right generic:binary-append
+ (sequence:null (sequence:type (car sequences)))
+ sequences)))
+
+(define generic:binary-append (make-generic-operator 2 #f))
+
+
+;;; Implementations of the generic operators.
+
+(define (any? x) #t)
+(define (constant val) (lambda (x) val))
+(define (is-exactly val) (lambda (x) (eq? x val)))
+
+(assign-operation sequence:null (constant "") (is-exactly string?))
+(assign-operation sequence:null (constant '()) (is-exactly list?))
+(assign-operation sequence:null (constant #()) (is-exactly vector?))
+
+(assign-operation sequence:ref string-ref string? exact-integer?)
+(assign-operation sequence:ref list-ref list? exact-integer?)
+(assign-operation sequence:ref vector-ref vector? exact-integer?)
+
+(assign-operation sequence:size string-length string?)
+(assign-operation sequence:size length list?)
+(assign-operation sequence:size vector-length vector?)
+
+(assign-operation sequence:type (constant string?) string?)
+(assign-operation sequence:type (constant list?) list?)
+(assign-operation sequence:type (constant vector?) vector?)
+
+
+(define (vector-null? v) (= (vector-length v) 0))
+
+(assign-operation sequence:null? string-null? string?)
+(assign-operation sequence:null? null? list?)
+(assign-operation sequence:null? vector-null? vector?)
+
+
+;;; To assign to the ith element of a list:
+
+(define (list-set! list i val)
+ (cond ((null? list)
+ (error "List does not have enough elements" i))
+ ((= i 0) (set-car! list val))
+ (else (list-set! (cdr list) (- i 1) val))))
+
+(assign-operation sequence:set! string-set! string? exact-integer? any?)
+(assign-operation sequence:set! list-set! list? exact-integer? any?)
+(assign-operation sequence:set! vector-set! vector? exact-integer? any?)
+
+
+(assign-operation sequence:subsequence
+ substring
+ string? exact-integer? exact-integer?)
+(assign-operation sequence:subsequence
+ sublist
+ list? exact-integer? exact-integer?)
+(assign-operation sequence:subsequence
+ subvector
+ vector? exact-integer? exact-integer?)
+
+
+(define (vector-append v1 v2)
+ (let ((n1 (vector-length v1))
+ (n2 (vector-length v2)))
+ (make-initialized-vector (+ n1 n2)
+ (lambda (i)
+ (if (< i n1)
+ (vector-ref v1 i)
+ (vector-ref v2 (- i n1)))))))
+
+(assign-operation generic:binary-append string-append string? string?)
+(assign-operation generic:binary-append append list? list?)
+(assign-operation generic:binary-append vector-append vector? vector?)
+
+;;;;;;;;;;;;;;; My Additions ;;;;;;;;;;;;;;;;;;
+
+;;; sequence:construct
+
+(define (sequence:construct sequence-type . items)
+ (if (null? items)
+ (sequence:null sequence-type)
+ (let loop ((things items)
+ (seq (sequence:null sequence-type)))
+ (if (null? things)
+ seq
+ (loop (cdr things)
+ (sequence:add-item seq (car things)))))))
+
+(define sequence:add-item
+ (make-generic-operator 2 #f))
+
+(assign-operation sequence:add-item (lambda (a b)
+ (string-append a (string b)))
+ string? any?)
+(assign-operation sequence:add-item (lambda (a b)
+ (append a (list b)))
+ list? any?)
+(assign-operation sequence:add-item (lambda (a b)
+ (vector-append a (vector b)))
+ vector? any?)
+
+
+#| Test sequence:construct
+
+(sequence:construct string? 1 2 3 4)
+;Value: "1234"
+
+(sequence:construct vector? 'asdf 567 '(1 2 3))
+;Value: #(asdf 567 (1 2 3))
+
+(sequence:construct list? (sequence:construct string? "asdf" 's 45) 1)
+;Value: ("asdfs45" 1)
+
+(sequence:construct string?)
+;Value: ""
+
+|#
+
+;;; sequence:generate
+
+(define sequence:generate
+ (make-generic-operator 3 #f))
+
+(define (generate-string n f)
+ (if (zero? n)
+ (string (f n))
+ (string-append (generate-string (- n 1) f) (string (f n)))))
+
+;(generate-string 3 sqrt)
+;Value: "011.41421356237309511.7320508075688772"
+
+(assign-operation sequence:generate (lambda (a b c)
+ (generate-string b c))
+ (is-exactly string?) exact-integer? procedure?)
+(assign-operation sequence:generate (lambda (a b c)
+ (generate-list b c))
+ (is-exactly list?) exact-integer? procedure?)
+(assign-operation sequence:generate (lambda (a b c)
+ (generate-vector b c))
+ (is-exactly vector?) exact-integer? procedure?)
+
+#| Test sequence:generate
+(sequence:generate string? 4 (lambda (x)
+ (string-ref "abcdefghijklmno" (* 2 x))))
+;Value: "acegi"
+
+(sequence:generate list? 5 square)
+;Value: (0 1 4 9 16)
+
+(sequence:generate vector? 10 string)
+;Value: #("0" "1" "2" "3" "4" "5" "6" "7" "8" "9")
+
+|#
+
+;;; sequence:map
+; I didn't do a formal check for arity of the mapping function because I don't
+; really know how to...
+
+(define (sequence:map f . sequences)
+ (if (null? sequences)
+ (error "Need at least one sequence to map over")
+ (let ((type? (sequence:type (car sequences)))
+ (size? (lambda (x)
+ (equal? (sequence:size (car sequences))
+ (sequence:size x)))))
+ (if (not (for-all? (cdr sequences) type?))
+ (error "All sequences for map must be of the same type"
+ sequences))
+ (if (not (for-all? (cdr sequences) size?))
+ (error "All sequences for map must be of the same size"
+ sequences))
+ (sequence:map-by-type type? f sequences))))
+
+(define sequence:map-by-type
+ (make-generic-operator 3 #f))
+
+; wow, this one sucks!
+(assign-operation sequence:map-by-type
+ (lambda (a b c)
+ (sequence:generate string? (- (string-length (car c)) 1)
+ (lambda (n)
+ (apply b (map
+ (lambda (x)
+ (substring x n (+ 1 n)))
+ c)))))
+ (is-exactly string?) procedure? list?)
+(assign-operation sequence:map-by-type (lambda (a b c)
+ (apply map b c))
+ (is-exactly list?) procedure? list?)
+(assign-operation sequence:map-by-type (lambda (a b c)
+ (apply vector-map b c))
+ (is-exactly vector?) procedure? list?)
+
+#| Test sequence:map
+(sequence:map + "123" '(1 1 1))
+;All sequences for map must be of the same type ("123" (1 1 1))
+
+(sequence:map + "1234" "11111")
+;All sequences for map must be of the same size ("1234" "11111")
+
+(sequence:map + '(1 2 3) '(1 1 1))
+;Value: (2 3 4)
+
+(define (wrap-paren s)
+ (string-append "(" s ")"))
+(wrap-paren "asfd")
+;Value: "(asfd)"
+
+(sequence:map wrap-paren "abcdEfg")
+
+(define (wrap-paren2 s1 s2)
+ (string-append "(" s1 ", " s2 ")"))
+(wrap-paren2 "one" "two")
+;Value: "(one, two)"
+
+(sequence:map wrap-paren2 "one" "two")
+;Value: "(o, t)(n, w)(e, o)"
+
+|#
+
+;;; sequence:for-each
+; just throw away the map result... not really correct for strings because
+; map functions must return strings which are then appended, but for-each
+; functions shouldn't have to return strings
+
+(define (sequence:for-each f . sequences)
+ (apply sequence:map f sequences)
+ '())
+
+#| Testing sequence:for-each
+
+(sequence:for-each pp '(1 2 3 4))
+;1
+;2
+;3
+;4
+;Value: ()
+
+|#
+
+;;; sequence:get-index
+
+(define sequence:get-index
+ (make-generic-operator 2 #f))
+
+(define string-get-index
+ (lambda (s f)
+ (let next ((len (string-length s))
+ (n 0))
+ (if (equal? n len) #f)
+ (if (f (substring s n (+ 1 n)))
+ n
+ (next len (+ 1 n))))))
+
+(define vector-get-index
+ (lambda (v f)
+ (let next ((len (vector-length v))
+ (n 0))
+ (if (eq? (+ 1 n) len) #f
+ (if (f (vector-ref v n))
+ n
+ (next len (+ 1 n)))))))
+
+(assign-operation sequence:get-index string-get-index string? procedure?)
+(assign-operation sequence:get-index find-matching-item list? procedure?)
+(assign-operation sequence:get-index vector-get-index vector? procedure?)
+
+#| Testing sequence:get-index
+
+(sequence:get-index "asdf" identity)
+; 0
+
+(define (nicenum n)
+ (exact-integer? (sqrt n)))
+(nicenum 5)
+; #f
+(nicenum 64)
+; #t
+(sequence:get-index '(2351 34 3 4 215 3) nicenum)
+; 4
+(sequence:get-index '(1 2 3 4 5) (lambda (x) (eq? x 100)))
+; #f
+(sequence:get-index #(1 2 3 5 7 8 10) nicenum)
+; 0
+(sequence:get-index #(2 3 5 7 8 10) nicenum)
+; #f
+
+|#
+
+;;; sequence:get-element
+; exact same as get-index, only returns the element
+
+(define sequence:get-element
+ (make-generic-operator 2 #f))
+
+(define string-get-element
+ (lambda (s f)
+ (let next ((len (string-length s))
+ (n 0))
+ (if (equal? n len) #f)
+ (if (f (substring s n (+ 1 n)))
+ (substring s n (+ 1 n))
+ (next len (+ 1 n))))))
+
+(define vector-get-element
+ (lambda (v f)
+ (let next ((len (vector-length v))
+ (n 0))
+ (if (eq? (+ 1 n) len) #f
+ (if (f (vector-ref v n))
+ (vector-ref v n)
+ (next len (+ 1 n)))))))
+
+(assign-operation sequence:get-element string-get-element string? procedure?)
+(assign-operation sequence:get-element list-search-positive list? procedure?)
+(assign-operation sequence:get-element vector-get-element vector? procedure?)
+
+#| Testing sequence:get-element
+
+(sequence:get-element "asdf" identity)
+; "a"
+
+(sequence:get-element '(2351 34 3 64 215 3) nicenum)
+; 64
+(sequence:get-element '(1 2 3 4 5) (lambda (x) (eq? x 100)))
+; #f
+(sequence:get-element #(1 2 3 5 7 8 10) nicenum)
+; 1
+(sequence:get-element #(2 3 5 7 8 10) nicenum)
+; #f
+
+|#
+
+;;; sequence:filter
+
+(define (sequence:filter sequence predicate)
+ (letrec ((base (sequence:null (sequence:type sequence)))
+ (chomp (lambda (x)
+ (if (predicate x)
+ (set! base (sequence:append base
+ (sequence:construct
+ (sequence:type sequence)
+ x))))
+ x)))
+ (sequence:for-each chomp sequence)
+ base))
+
+#| Test sequence:filter
+(sequence:filter '(1 2 3 4 5 6 7) nicenum)
+;Value: (1 4)
+
+(sequence:filter "this is a sentance" identity)
+;Value: "ecnatnes a si siht"
+; ugh, wrong order, don't know why only this...
+
+(sequence:filter #(1 4 9 16 25) nicenum)
+;Value: #(1 4 9 16 25)
+|#
+
+;;; sequence:fold-left
+
+(define (sequence:fold-left f init sequence)
+ (letrec ((base init)
+ (chomp (lambda (x)
+ (set! base (f base x))
+ x)))
+ (sequence:for-each chomp sequence)
+ base))
+
+#|
+(sequence:fold-left list 'start '(a b c))
+;Value: (((end a) b) c)
+
+(sequence:fold-left string-append "first word" "abc")
+;Value: "first wordcba"
+
+|#
+
+;;; sequence:fold-right
+
+(define (sequence:fold-right f init sequence)
+ (if (sequence:null? sequence)
+ init
+ (f (sequence:ref sequence 0)
+ (sequence:fold-right f
+ init
+ (sequence:subsequence
+ sequence 1
+ (sequence:size sequence))))))
+
+#| test sequence-right
+(sequence:fold-right list 'end '(a b c))
+;Value: (a (b (c end)))
+
+(sequence:fold-right list 'end "abc")
+;Value: (#\a (#\b (#\c end)))
+
+(sequence:fold-right list 'end #('a 'b 'c))
+;Value: ((quote a) ((quote b) ((quote c) end)))
+
+|#
+
+; ======================== Problem 2.2 =========================
+
+
+(define (compose-1st-arg f g)
+ (lambda (x y) (f (g x) y)))
+
+(define (compose-2nd-arg f g)
+ (lambda (x y) (f x (g y))))
+
+(define string->vector (compose list->vector string->list))
+(define vector->string (compose list->string vector->list))
+
+; (string->vector "asdf")
+;Value: #(#\a #\s #\d #\f)
+; (vector->string #(1 2 3))
+
+(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)))
+
+(assign-operation generic:binary-append
+ (compose-2nd-arg append vector->list)
+ list? vector?)
+(assign-operation generic:binary-append
+ (compose-2nd-arg append string->list)
+ list? string?)
+(assign-operation generic:binary-append
+ (compose-2nd-arg vector-append list->vector)
+ vector? list?)
+(assign-operation generic:binary-append
+ (compose-2nd-arg vector-append string->vector)
+ vector? string?)
+(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?)
+
+#| testing sequence:append
+(sequence:append '(1 2 3))
+; (1 2 3)
+(sequence:append)
+; ERROR
+(sequence:append '(1 2 3) "456")
+;Value: (1 2 3 #\4 #\5 #\6)
+
+(sequence:append #(4 5 6) #(1 2 3) #(12 34 56))
+;Value: #(4 5 6 1 2 3 12 34 56)
+
+(sequence:append "asdf" "asdf")
+;Value: "asdfasdf"
+
+(sequence:append '(1 3 4 5) #(6 7 8) "91011")
+;Value: (1 3 4 5 6 7 8 #\9 #\1 #\0 #\1 #\1)
+|#
+
+
+;UNFINISHED:
+;sequence:elements-equal?
+;sequence:map
+;sequence:for-each
+
+; ===================== Problem 2.4 ========================
+
+(define (boolean<? a b)
+ (if (and (not b) a)
+ #t
+ #f))
+
+(define (null<? a b) #f)
+
+(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 (generic:binary-less? a b)
+ (cond ((null? a) (if (null? b) (null<? a b) #t))
+ ((null? b) #f)
+ ((boolean? a) (if (boolean? b) (boolean<? a b) #t))
+ ((boolean? b) #f)
+ ((char? a) (if (char? b) (char<? a b) #t))
+ ((char? b) #f)
+ ((number? a) (if (number? b) (< a b) #t))
+ ((number? b) #f)
+ ((symbol? a) (if (symbol? b) (symbol<? a b) #t))
+ ((symbol? b) #f)
+ ((string? a) (if (string? b) (string<? a b) #t))
+ ((string? b) #f)
+ ((vector? a) (if (vector? b) (list<? a b) #t))
+ ((vector? b) #f)
+ ((list? a) (if (list? b) (list<? a b) #t))
+ ((list? b) #f)
+ (else (error "Unknown type: " a))))
+
+(define generic:less?
+ (make-generic-operator 2 #f))
+
+(assign-operation generic:less? generic:binary-less? any? any?)
+
+;(generic:less? "asdf" '(a b c))
+; #t
+
+(define (list->set l)
+ (let next ((last '())
+ (l (sort l generic:less?)))
+ (if (null? l) '()
+ (if (equal? last (car l))
+ (next last (cdr l))
+ (cons (car l) (next (car l) (cdr l)))))))
+
+#|
+(list->set '(1 2 3 2 4 3))
+;Value: (1 2 3 4)
+
+(list->set '(4 (5 6) "asdf" '() #(1 2 3)))
+;Value: (4 "asdf" #(1 2 3) (5 6) (quote ()))
+|#
+
+(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 string->list) string?)
+(assign-operation generic:sequence->set
+ (compose list->set vector->list) vector?)
+
+(define set:equal? equal?)
+
+(define (set:union a b)
+ (list->set (append a b)))
+
+(define (set:intersection a b)
+ (filter (lambda (x) (member x b)) a))
+
+(define (set:difference a b)
+ (filter (lambda (x) (not (member x b))) a))
+
+(define (set:strict-subset? a b)
+ (and (not (eq? (length a) (length b)))
+ (eq? (length a) (length (set:intersection a b)))))
+
+#| Test:
+
+(generic:sequence->set "asdfsadgsadgfwqef")
+;Value: (#\a #\d #\e #\f #\g #\q #\s #\w)
+
+(set:equal? '(1 2 3) '(a b c))
+; #f
+(set:equal? '(1 2 3) '(1 2 3))
+; #t
+
+(set:union (generic:sequence->set "asdjhwrenslvc")
+ (generic:sequence->set "wroughlkdxjqw"))
+;Value: (#\a #\c #\d #\e #\g #\h #\j #\k #\l #\n #\o
+; #\q #\r #\s #\u #\v #\w #\x)
+(set:intersection (generic:sequence->set "asdjhwrenslvc")
+ (generic:sequence->set "wroughlkdxjqw"))
+;Value: (#\d #\h #\j #\l #\r #\w)
+
+(set:difference '(1 2 3 4 5) '(2 4 5))
+; (1 3)
+
+(set:strict-subset? '(1 3) '(1 2 3 4 5 6))
+; #t
+(set:strict-subset? '(1 3 0) '(1 2 3 4 5 6))
+; #f
+
+|#
+