(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)
(sequence:construct list? 'foo 'miao 'bar)
(sequence:construct vector? 'foo 'miao 'bar)
|#
(define sequence:equal? equal?)
(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))))
(sequence:generate
list? 3
(lambda (i) (string-append "foo" (number->string i))))
(sequence:generate
vector? 3
(lambda (i) (string-append "foo" (number->string i))))
|#
(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"))
(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"))
(sequence:map (lambda (a b c)
(string a b c))
"a1"
"b2"
"c3")
|#
(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
(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
(sequence:for-each (lambda (a b c)
(display (string a b c "\n")))
"a1"
"b2"
"c3")
abc
123
|#
(define (sequence:filter sequence predicate)
(generic:from-list (sequence:type sequence)
(filter predicate (generic:to-list sequence))))
(sequence:filter '(1 2 3 4) even?)
(sequence:filter (vector 1 2 3 4) even?)
(sequence:filter
"1234"
(lambda (c) (even? (string->number (string c)))))
|#
(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?)
(sequence:get-index (vector 1 2 3 4) even?)
(sequence:get-index
"1234"
(lambda (c) (even? (string->number (string c)))))
(sequence:get-index '(1 3) even?)
|#
(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?)
(sequence:get-element (vector 1 2 3 4) even?)
(sequence:get-element
"1234"
(lambda (c) (even? (string->number (string c)))))
(sequence:get-element '(1 3) even?)
|#
(define (sequence:fold-right fun init sequence)
(fold-right fun init (generic:to-list sequence)))
(sequence:fold-right list 'end '(a b c))
(sequence:fold-right list 'end (vector 'a 'b 'c))
(sequence:fold-right list 'end "abc")
|#
(define (sequence:fold-left fun init sequence)
(fold-left fun init (generic:to-list sequence)))
(sequence:fold-left list 'start '(a b c))
(sequence:fold-left list 'start (vector 'a 'b 'c))
(sequence:fold-left list 'start "abc")
|#
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:
|#
(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))
(sequence:equal? "123" '(#\1 #\2 #\3))
(sequence:equal? "1234" '(#\1 #\2 #\3))
(sequence:equal? "123" '(#\1 #\2 #\3 #\4))
(sequence:equal? "" '())
(sequence:equal? "" (vector))
|#
(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?)
(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))
(sequence:append "foo" '(#\b #\a #\r) (vector #\f #\o #\o))
(sequence:append (vector #\f #\o #\o) "foo" '(#\b #\a #\r))
(sequence:append (vector 'f 'oo) '(miao miao))
|#
(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"))
(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"))
(sequence:map (lambda (a b c)
(string a b c))
"a1"
'(b 2)
(vector 'c '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.
|#
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).
|#
(define (null<? x y)
#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)
(else
(let prefix<? ((list-1 list-1)
(list-2 list-2))
(cond ((null? list-1) #f) ((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))
(generic:less? '() #f)
(generic:less? #f '())
(generic:less? '() '(list 1 2 3))
(generic:less? '(list 1 2 3) '())
|#
(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))
(generic:sequence->set (vector 1 2 3 2 1 #\a "foo" (list 3 2 1)))
(set:union (generic:sequence->set (list 3 2 1)) (generic:sequence->set (list 1 4 5 2)))
(set:intersection (generic:sequence->set (list 3 2 1)) (generic:sequence->set (list 1 4 5 2)))
(set:difference (generic:sequence->set (list 3 2 1)) (generic:sequence->set (list 1 4 5 2)))
(set:strict-subset? (generic:sequence->set (list 1 2 3)) (generic:sequence->set (list 1 2 3)))
(set:strict-subset? (generic:sequence->set (list 1 2 3)) (generic:sequence->set (list 1 2 3 "foo" #\a)))
|#
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.
|#
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.
|#