diff options
Diffstat (limited to 'ps02_generics')
| -rw-r--r-- | ps02_generics/amended-specs.txt | 129 | ||||
| -rw-r--r-- | ps02_generics/bnewbold_ps02.txt | 94 | ||||
| -rw-r--r-- | ps02_generics/full-gen-seq.scm | 632 |
3 files changed, 855 insertions, 0 deletions
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 + +|# + |