Scheme - Wordtranslator - scheme

I had to do a word translator in the school, ive tried it like this in the Programm: DrRacket, but when I translate german into english, it gives me "Error", my teacher also don't knows how to fix the mistake, I hope someone of you can help me.
(define *lex*
'((cat Katze)
(dog Hund)
(eats frisst)
(jumps springt)
(the die)
(the der)))
(define (wordtranslator word *lex*)
(cond ((null? liste) 'Error)
((not (equal? word (or (car (car list)) (car (cdr (car list)))))) (wordtranslator word (cdr liste)))
(else
(cond
((equal? word (car (car list))) (car (cdr (car list))))
((equal? word (car (cdr (car list)))) (car (car list)))))))
when I want to translate "Hund" it shows:
> (wordtranslator 'Hund *lex*)
Error
>

The implementation is unnecessarily complex, and it has a couple of syntax errors - for instance: is the list parameter called *lex*, list or liste? and why nest cond expressions, if a single multi-part cond suffices? also notice that the way you're using or within equal? is wrong. It'd be better to try again from scratch:
(define (wordtranslator word liste)
; if the list is empty, we didn't find the word, signal an error
(cond ((null? liste) 'Error)
; is the word in the first element of pair?
((equal? word (caar liste))
; then return the second element of pair
(cadar liste))
; is the word in the second element of pair?
((equal? word (cadar liste))
; then return the first element of pair
(caar liste))
; otherwise, the word is not in the current pair
(else
; advance the recursion to the next pair
(wordtranslator word (cdr liste)))))
From the comments I understand that you were trying to find first if the word is not in the current pair. This is also possible, but IMHO the code will be less readable and you'll need to use more comparisons; also take notice of the correct way to express the second condition. I'll write this in a way that is similar to what you had in mind, but remember - both implementations are equivalent:
(define (wordtranslator word liste)
(cond ((null? liste) 'Error)
((not (or (equal? word (car (car liste)))
(equal? word (car (cdr (car liste))))))
(wordtranslator word (cdr liste)))
(else
(cond ((equal? word (car (car liste)))
(car (cdr (car liste))))
((equal? word (car (cdr (car liste))))
(car (car liste)))))))
I recommend that you use the first implementation, the else part is already expressing what the complex second condition is doing in the second implementation, see how reordering the conditions can simplify the code. Either way the translation works on both directions:
(wordtranslator 'Hund *lex*)
=> 'dog
(wordtranslator 'dog *lex*)
=> 'Hund
(wordtranslator 'bunny *lex*)
=> 'Error

Related

Inserting word beside another word starting from the end of list

I have code which is inserting new word on the right side of choosen word
(define insertR
(lambda (new old lst)
(cond
((null? lst) (lst))
(else (cond
((eq? (car lst) old)
(cons old
(cons new (cdr lst))))
(else (cons (car lst)
(insertR new old
(cdr lst)))))))))
i need to make it insert that word beside first appearance of word starting from the end of list. Tried to work with reverse but could not get that to work.
There are two strategies you can take to add it next to the last occurence.
The first is to use a helper and start off with the reverse list. This is very simple and my preferred solution.
(define (insert-by-last-match insert find lst)
(let loop ((lst (reverse lst)) (acc '()))
(if (null? lst)
acc
(let ((a (car lst)))
(if (equal? a find)
(append (reverse (cdr lst))
(list* find insert acc))
(loop (cdr lst) (cons a acc)))))))
The other one is kind of obscure. Whenever you find the element you replace last-match with a callback that replaces the computation since it was made and until it gets called with the replacement and the rest of the list, which of course is the correct result. The work done until the end of the list is simply discarded since it is not used, but we do it since we are not sure if we are going to find a later one and then all the work uptil that is of course included in the result.
(define (insert-by-last-match insert find lst)
(define (helper lst last-match)
(if (null? lst)
(last-match)
(let* ((a (car lst)) (d (cdr lst)))
(cons a
(if (equal? a find)
(let/cc k
(helper d (lambda () (k (cons insert d)))))
(helper d last-match))))))
(helper lst (lambda () lst)))
call/cc (or its variant let/cc) is often described as time travel or advanced goto. It is not very intuitive. Here is a CPS version:
(define (insert-by-last-match insert find lst)
(define (helper lst last-match k)
(if (null? lst)
(last-match)
(let* ((a (car lst)) (d (cdr lst)) (k2 (lambda (v) (k (cons a v)))))
(if (equal? a find)
(helper d (lambda () (k2 (cons insert d))) k2)
(helper d last-match k2)))))
(helper lst (lambda () lst) (lambda (v) v)))
Basically this is the same as the previous only that here I have written the CPS code and with the let/cc version the implementation does it for me and I get to use k exactly where I need it. In this version you see there is no magic or time travel but the execution that should happen later is simply replaced at a point.
Write in a similar way insertL and apply it to the reversed list.
And reverse the result. Then you will have an insertion beside first appearance of word starting from the end of list
(define insertL
(lambda (new old lst)
(cond ((null? lst) '())
((eq? (car lst) old) (cons new lst))
(else (cons (car lst) (insertL new old (cdr lst)))))))
(define last-insertR
(lambda (new old lst)
(let* ((rlst (reverse lst))
(result (insertL new old rlst)))
(reverse result))))
test:
(last-insertR 'aa 'a '(b c d a h i a g))
;; '(b c d a h i a aa g)
By the way, the beauty of cond is that you can put the conditions always at the beginning - listed one under the other.
So one can write your insertR nicer as:
(define insertR
(lambda (new old lst)
(cond ((null? lst) '())
((eq? (car lst) old) (cons old (cons new (cdr lst))))
(else (cons (car lst) (insertR new old (cdr lst)))))))

How to check if first and last element in a list are identical (Language: Scheme)

I am writing a program in Scheme and having difficulty with this one part. Below is an example to make my question clear
(endsmatch lst) should return #t if the first element in the list is the same as the last element in the list and return #f otherwise.
For example:
(endsmatch '(s t u v w x y z)) should return: #f
and
(endsmatch (LIST 'j 'k 'l 'm 'n 'o 'j)) should return: #t
Here is what I have so far (just error handling). The main issue I am having is solving this recursively. I understand there are easier solutions that are not recursive but I need to solve this using recursion.
My code so far:
(define (endsmatch lst)
(if (not(list? lst))
"USAGE: (endsmatch [list])"
(if (or (null? lst)
(= (length lst) 1))
#t
(equal? ((car lst)) (endsmatch(car lst)))
)))
I believe my code starting at "(equal? " is where it is broken and doesn't work. This is also where I believe recursion will take place. Any help is appreciated!
Easiest way is to use a (recursive) helper function to do the looping:
(define (endsmatch lst)
(define (helper no1 lst)
(if (null? (cdr lst))
(equal? no1 (car lst))
(helper no1 (cdr lst))))
(if (or (not (list? lst)) (null? lst))
"USAGE: (endsmatch [list])"
(helper (car lst) lst)))
The reason I pass lst and not (cdr lst) as the second argument in the last line is so that it also works for 1-element lists.
I tend to use KISS when programming. aka. "Keep it simple, stupid!"
With that regard I would have oped for:
(define (ends-match? lst)
(or (null? lst)
(equal? (car lst)
(last lst))))
Now last we can define like this:
(define (last lst)
(foldl (lambda (e a) e) last lst))
It's not perfect. It should signal an error if you pass an empty list, but in the ends-match? you check for this and thus it's not a problem.

How to add an element into a specific position of a list, using Scheme?

This is the code I have so far. I believe that I'm close, but what returns is just #procedure, acknowledging that a procedure has created, it does not return the list with the newly added element. I have been working on this for hours and I am at a loss of where I have gone wrong.
(define (add-into new p lst)
(cond ((null? lst)
(cons new lst)
((eq? p 0)
(cons new lst)
(else
(cons (car lst) (add-into (- p 1) new (cdr l))))))))
You have parentheses problems, in one place you passed l instead of lst and the order of the parameters is incorrect when doing the recursive call. This should fix the errors:
(define (add-into new p lst)
(cond ((null? lst)
(cons new lst))
((= p 0)
(cons new lst))
(else
(cons (car lst) (add-into new (- p 1) (cdr lst))))))
Just pasting the code into DrRacket and pressing CTRL+i and I get this:
(define (add-into new p lst)
(cond ((null? lst)
(cons new lst)
((eq? p 0)
(cons new lst)
(else
(cons (car lst) (add-into (- p 1) new (cdr l))))))))
Notice that you only have one term. If (null? lst) is #f there are no more terms in the cond so it will evaluate to a implementation defined value as it is it is undefined in the specification. In #lang racket that value is the same as returned if you evaluate (void)
To fix it you need to close the terms in the cond so that you have 3 terms instead of one. You should have seen this when you press enter that the parentheses didn't align to the previous term. If you want to use another editor you should get one that aligns and indent lisp syntax as writing lisp without is slightly painful.

checking the first atom against the other atoms in a list

I am trying to check the first atom in a list against the other atoms in a list, so if the first atom is 3 and the 3rd atom is three, I would want to evaluate it to false.
I have something like
(define (doubles a_list)
(cond
((null? a_list) #t)
(not ((eq? (car a_list) (car (cdr a_list)))) (doubles(cdr a_list)))
I have a feeling that this will only check atoms next to each other and not the one atom with the rest of them. what can i do to check all the items with the first one?
You want to repeatedly compare the first two elements of your list, reducing the cdr as you go:
(define (unique-first? x)
; uncomment the following line to trace the execution
;(display x) (newline)
(or (null? x) (null? (cdr x))
(and (not (eq? (car x) (cadr x)))
(unique-first? (cons (car x) (cddr x))))))
note on special cases:
(unique-first? '()) -> #t
(unique-first? '(a)) -> #t
(which, indeed, verify the "first element doesn't appear twice" criteria).
I've got my tea, my code-review hat and a few spare minutes. You know what time it is.
What you want is a predicate that will tell you if there are duplicates of the first atom in a list.
(define (doubles a_list)
(cond ((null? a_list) #t)
(not ((eq? (car a_list) (car (cdr a_list)))) (doubles(cdr a_list)))
Regardless of anything else, this won't work because it has unbalanced parentheses.
(define (doubles a_list)
(cond ((null? a_list) #t)
(not ((eq? (car a_list) (car (cdr a_list)))) (doubles(cdr a_list)))))
That revised version won't work because it has a malformed second clause in the case. Oddly, it does seem to evaluate fine, but when you call it, you'll get an odd error message
Welcome to Racket v5.3.6.
> (define (doubles a_list)
(cond ((null? a_list) #t)
(not ((eq? (car a_list) (car (cdr a_list)))) (doubles(cdr a_list)))))
> (doubles (list 1 2 3 4 5 6 7 3))
application: not a procedure;
expected a procedure that can be applied to arguments
given: #f
arguments...: [none]
>
The direct cause is this bit
... ((eq? (car a_list) (car (cdr a_list)))) ...
Because of the extra parens surrounding this expression, what it actually means is
"See if the first element of a_list is the same as the second, then call the result of that check as a function".
This is not what you want. The correct resolution is getting that not into these parens, which would make that a valid cond clause.
(define (doubles a_list)
(cond ((null? a_list) #t)
((not (eq? (car a_list) (car (cdr a_list))))
(doubles (cdr a_list)))))
You can't call car on the empty list in Scheme. This works fine, for some definition of "fine", in Common Lisp but will throw you an error here.
> (define (doubles a_list)
(cond ((null? a_list) #t)
((not (eq? (car a_list) (car (cdr a_list))))
(doubles (cdr a_list)))))
> (doubles (list 1 2 3 4 5 6 7 3))
car: contract violation
expected: pair?
given: '()
>
The cause of this error is that you're checking whether a_list is null?, but then calling (car (cdr a_list)) later on. You'll get this error in the situation where a_list is something like (3). The fix for this is checking whether a_list or its cdr are null?
(define (doubles a_list)
(cond ((or (null? a_list) (null? (cdr a_list))) #t)
((not (eq? (car a_list) (car (cdr a_list))))
(doubles (cdr a_list)))))
> (doubles (list 1 2 3 4 5 6 7 3))
#t
Now that we've got a version of your function that doesn't error out, lets take a look at your logic. The procedure for finding doubles in a list is
for lists of length zero or one, the answer is False, since there can be no doubles in a list shorter than two elements
otherwise, check if the first element of the list is in the rest.
if it is, the answer is True since we've found a duplicate
Now, you've named your function doubles, but your prose explanation tells me that it really should have been unique-first?. Because you're not looking for doubles, your're looking to check if the first element of your list is unique among its peers. What you really want to do is
for lists of length one, the answer is True, since that single element must be unique (I'm going to assume that you want the same for lists of length zero, but that might not actually make sense depending on the application)
otherwise, check that the first element of the list is not in the rest.
That translates to
(define (unique-first? a_list)
(if (or (null? a_list) (null? (cdr a_list)))
#t
(not (member? (car a_list) (cdr a_list)))))
The member? function is fairly straightforward, and works on the same principles.
(define (member? elem lst)
(cond ((null? lst) #f)
((eq? elem (car lst)) #t)
(else (member? elem (cdr lst)))))
Finally, a couple of style points. The Scheme convention is to name predicates with a trailing ?, which will hint to your functions' callers that it will return #t or #f (I've done this above), and to use spinal-case rather than snake_case for names.
(define (unique-first? a-list)
(if (or (null? a-list) (null? (cdr a-list)))
#t
(not (member? (car a-list) (cdr a-list)))))

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)

Resources