Using match in chez scheme - scheme

I'm trying to learn how to use match in scheme. I sort of understand how it works with really short problems (ie: defining length is just two lines) but not with problems where there's more than one input, and helper programs. For example, here's a popular way of defining union:
(define ele?
(lambda (ele ls)
(cond
[(null? ls) #f]
[(eq? ele (car ls)) #t]
[else (ele? ele (cdr ls))])))
(define union
(lambda (ls1 ls2)
(cond
[(null? ls2) ls1]
[(ele? (car ls2) ls1) (union ls1 (cdr ls2))]
[else (union (cons (car ls2) ls1) (cdr ls2))])))
How do you do this using match in both programs? (or would you even need two programs?)

the first one could be implemented like that:
(define ele?
(lambda (a b)
(let ((isa? (lambda (x) (eq? (car x) a))))
(match b [(? null?) #f]
[(? isa?) #t]
[_ (ele? a (cdr b))]))))
then the second is easy
(define uni
(lambda (ls1 ls2)
(let ((carinls2? (lambda (x) (ele? (car x) ls1))))
(match ls2 [(? null?) ls1]
[(? carinls2?) (uni ls1 (cdr ls2))]
[_ (uni (cons (car ls2) ls1) (cdr ls2))]))))
maybe there is a smarter way to avoid these one argument let lambdas but i'm still learning ;)

Related

The Liitle Schemer 4th page81 rember* function

I'm studying The Liitle Schemer 4th.
Sometimes I have a different solution. It confuses me and I can't easily understand the standard answer of the book.
For example, with rember*:
My solution is :
(define rember*
(lambda (a l)
(cond
((null? l) '())
((atom? l) l)
((eq? a (car l)) (rember* a (cdr l)))
(else (cons (rember* a (car l)) (rember* a (cdr l)))))))
The book's solution:
(define rember*
(lambda (a l)
(cond
((null? l) '())
((atom? (car l))
(cond
((eq? (car l) a)
(rember* a (cdr l)))
(else (cons (car l)
(rember* a (car l))))))
(else (cons (rember* a (car l))
(rember* a (cdr l)))))))
Which is better?
One more question.
Original structure:
(define rember*
(lambda (a l)
(cond
((null? l) '())
((atom? (car l))
(cond
((eq? (car l) a)
(rember* a (cdr l)))
(else (cons (car l)
(rember* a (car l))))))
(else (cons (rember* a (car l))
(rember* a (cdr l)))))))
New structrue:
(define rember*
(lambda (a l)
(cond
((null? l) '())
((atom? (car l)) (cond
((eq? (car l) a) (rember* a (cdr l)))
(else (cons (car l) (rember* a (cdr l))))))
(else (cons (rember* a (car l)) (rember* a (cdr l)))))))
Which is better for everyone?
In general, is not unusual that the same function is implemented by different programs. In your example, however, the two programs implement different functions, so that I think is not immediate to say “which is the best”.
The second program (that of the book), implements a function defined over the domain of the lists, and only that domain. So, you cannot give to it an atom, for instance, since it would produce an error.
The first one (your version), on the other hand, can be applied to lists (and in this case has the same behaviour of the second one), but can be applied also to atoms, so that you can do, for instance:
(rember* 'a 'a) ; returns a
(rember* 'a 'b) ; returns b
So, one should look at the specification of the function, and see if a program implements in a consistent way this specification. I would say that the first program in not entirely consistent with the specification of the function (remove an element from the second argument), but this is just an opinion, since the function is well defined only over the domain of the lists.

Records search function

I have a problem with my medical database in Scheme. I want to write a function that takes X symptoms and searches through my database for a match with a diagnose.
This is what I've done so far:
(define helper-match
(lambda (ls)
(reverse
(let loop ([ls ls] [found '()] [acc '()])
(cond
[(null? ls)
acc]
[(memq (car ls) found)
(loop (cdr ls)
found
(if (memq (car ls) acc)
acc
(cons (car ls) acc)))]
[else
(loop (cdr ls)
(cons (car ls) found)
acc)])))))
Above is a function that check for duplicates but I don't know how to write it so it compares with my database.
the structure of the database looks like this:
(define *medical-db-2*
'((1
(disease (meningit)
(symptom (fever) (headache) (vertigo) (vomiting) (stiffness) (light sensitivity))))
(2
(disease (encefalit)
(symptom (fever) (headache) (vertigo) (vomiting) (disorientation) (cramps))))

Scheme replacement problems

This code replaces first person words with second person words and vice versa. However, it goes through each pair for each word in the phrase, so sometimes it will change back.
Here is the code:
(define (replace pattern replacement lst replacement-pairs)
(cond ((null? lst) '())
((equal? (car lst) pattern)
(cons replacement
(many-replace (cdr replacement-pairs) (cdr lst))))
(else (cons (car lst)
(many-replace (cdr replacement-pairs) (cdr lst))))))
(define (many-replace replacement-pairs lst)
(cond ((null? replacement-pairs) lst)
(else (let ((pat-rep (car replacement-pairs)))
(replace (car pat-rep)
(cadr pat-rep)
(many-replace (cdr replacement-pairs)
lst) replacement-pairs)))))
(define (change-person phrase)
(many-replace '((i you) (me you) (am are) (my your) (are am) (you i) (your my))
phrase))
For example if I entered
(change-person '(you are not being very helpful to me))
it would change you to i but then back to you. How do I fix this?
The procedures replace and many-replace are overly complicated, and the mutual recursion is not doing what you think. If we simplify those procedures and make sure that only a single pass is performed over the input list, we can get a correct answer:
(define (replace replacement-pairs pattern)
(cond ((null? replacement-pairs)
pattern)
((equal? (caar replacement-pairs) pattern)
(cadar replacement-pairs))
(else
(replace (cdr replacement-pairs) pattern))))
(define (many-replace replacement-pairs lst)
(if (null? lst)
'()
(cons (replace replacement-pairs (car lst))
(many-replace replacement-pairs (cdr lst)))))
The keen eye will notice that the previous procedures can be expressed in a succinct way by using some higher-order procedures. A more idiomatic solution could look like this:
(define (replace replacement-pairs pattern)
(cond ((assoc pattern replacement-pairs) => cadr)
(else pattern)))
(define (many-replace replacement-pairs lst)
(map (curry replace replacement-pairs) lst))
Either way, it works as expected:
(change-person '(you are not being very helpful to me))
=> '(i am not being very helpful to you)
I've written a slightly easier solution:
(define (many-replace pattern phrase)
(let loop ((phrase phrase) (result '()))
(if (empty? phrase) (reverse result)
(let* ((c (car phrase)) (a (assoc c pattern)))
(if a
(loop (cdr phrase) (cons (cadr a) result))
(loop (cdr phrase) (cons c result)))))))
(change-person '(you are not being very helpful to me))
=> '(i am not being very helpful to you)

Writing flatten method in Scheme

I have been working on the following function flatten and so far have it working for just lists. I was wondering if someone could provide me with some insight on how to get it work with pairs? For example (flatten '(a .a)) would return (a a). Thanks.
(define (flatten list)
(cond ((null? list) null)
((list? (car list)) (append (flatten (car list)) (flatten (cdr list))))
(else
(cons (car list) (flatten (cdr list))))))
Here's one option:
(define (flatten x)
(cond ((null? x) '())
((pair? x) (append (flatten (car x)) (flatten (cdr x))))
(else (list x))))
This does what you want, without requiring append, making it o(n). I walks the list as a tree. Some schemes might throw a stack overflow error if the list is too deeply nested. In guile this is not the case.
I claim no copyright for this code.
(define (flatten lst)
(let loop ((lst lst) (acc '()))
(cond
((null? lst) acc)
((pair? lst) (loop (car lst) (loop (cdr lst) acc)))
(else (cons lst acc)))))
(define (flatten l)
(cond
[(empty? l) empty]
[(list? l)
(append (flatten (first l))
(flatten (rest l)))]
[else (list l)]))

Scheme function to remove atoms?

If I have a list like (e q(r))
How would I remove all the atoms and just return (()) ?
Hey, a technique known as tree-recursion is useful for this type of problem.
I agree with the general structure of the Greg's answer, but I think we need to explicitly filter atomic (non-list) values from nested lists.
(define (rem-atoms lst)
(cond
((not (list? lst)) lst)
((null? lst) (list))
(else
(filter
(lambda (a) (list? a))
(cons (rem-atoms (car lst))
(rem-atoms (cdr lst)))))))
(rem-atoms '(f (x y) z () (k ()))) ; --> (() () (()))
(rem-atoms '(f x (y))) ; --> (())
Upon further inspection, a tiny amendment to Greg's good solution also now provides the correct results. Specifically: (not (list? xx)) rather than (not (pair? xx)).
(define (rem-atoms lat)
(cond
((null? lat) lat)
((not (list? (car lat))) (rem-atoms (cdr lat)))
(else
(cons (rem-atoms (car lat))
(rem-atoms (cdr lat)))))))
(rem-atoms '(f (x y) z () (k ()))) ; --> (() () (()))
(rem-atoms '(f x (y))) ; --> (())
Hmm. I think I like this second version the best!
Note, I'm brand new here, but I hope this helps.
(define rem-atoms
(lambda (lat)
(cond
((null? lat) lat)
((not (pair? (car lat))) (rem-atoms (cdr lat)))
(else
(cons (rem-atoms (car lat)) (rem-atoms (cdr lat)))))))
If the list is empty, return the empty list. If it's an atom (or rather, not a list), just eliminate it. If it's a list, call the function recursively on both the car and the cdr of the list.

Resources