Using a Scheme-like language, I am converting
(quote (lambda (a b) (* a b) (+ a b))))
to:
(quote (lambda (a) (lambda (b) (+ a b) (* a b))))
but with my current implementation I am getting an extra pair of parenthesis around the expressions (+ a b) and (* a b):
(lambda (a) (lambda (b) ((+ a b) (* a b))))
I have spent a lot of time trying to fix this problem, but can't figure it out. I feel like the fix should be trivial.
Here is my code currently:
(define (conv lyst)
(define (helper args)
(cond
((null? args) (append (cddr lyst) args))
(else (cons (car lyst)
(cons (list (car args))
(list (helper (cdr args))))))))
(cond
((eq? 1 (length (car (cdr lyst)))) lyst)
(else (helper (car (cdr lyst))))))
I think your implementation can be simplified. This should work:
(define (conv lyst)
(define (helper args)
(if (null? (cdr args))
(cons 'lambda
(append (list (list (car args)))
(cddr lyst)))
(list 'lambda
(list (car args))
(helper (cdr args)))))
(helper (cadr lyst)))
Or even simpler, using quasiquoting and splicing:
(define (conv lyst)
(define (helper args)
(if (null? (cdr args))
`(lambda (,(car args)) ,#(cddr lyst))
`(lambda (,(car args)) ,(helper (cdr args)))))
(helper (cadr lyst)))
Either way, it works as expected:
(conv '(lambda (a b) (* a b) (+ a b)))
=> '(lambda (a) (lambda (b) (* a b) (+ a b)))
Related
I am stuck with this particular problem I was doing for fun:
Why does it cause a contract violation everytime car comes around? And are there any possible fixes?
(define (fv expr)
(cond ((eq? (car expr) 'lambda) (fv (cadr (cdr expr))))
((pair? (car expr)) (union (fv (car expr)) (fv (cdr expr))))
((symbol? (car expr)) (remove (car expr) (fv (cdr expr))))
(else '())))
(define (union set1 set2)
(cond ((null? set1) set2)
((member (car set1) set2) (union (cdr set1) set2))
(else (cons (car set1) (union (cdr set1) set2)))))
(define (remove item set)
(cond ((null? set) '())
((equal? item (car set)) (cdr set))
(else (cons (car set) (remove item (cdr set))))))
Input = (fv '(λ f (λ x (f ((t g) g)))))
Output =
car: contract violation expected: pair? given: '()
Output Should Be: (t g)
The error message:
car: contract violation expected: pair? given: '()
means that the function car was called with the argument '() (the empty list) and this gives an error.
Now you know that the problem is related to a call to car.
Since car is called multiple times in your program it is hard
to spot which car is the culprit. Presumably your Scheme implementation
displays a source locations that points to the offending expression.
But let's say you are not so lucky. In that case, you'll need to figure out which function has the problem. Inserting a few calls to display helps:
(define (fv expr)
(display (list 'fv: 'expr expr) (newline)
(cond ((eq? (car expr) 'lambda) (fv (cadr (cdr expr))))
((pair? (car expr)) (union (fv (car expr)) (fv (cdr expr))))
((symbol? (car expr)) (remove (car expr) (fv (cdr expr))))
(else '())))
(define (union set1 set2)
(display (list 'union: 'set1 set1 'set2 set2) (newline)
(cond ((null? set1) set2)
((member (car set1) set2) (union (cdr set1) set2))
(else (cons (car set1) (union (cdr set1) set2)))))
(define (remove item set)
(display (list 'remove: 'item item 'set set) (newline)
(cond ((null? set) '())
((equal? item (car set)) (cdr set))
(else (cons (car set) (remove item (cdr set))))))
If you try your example now, you'll see which function is called before the error occurs. In this case, I bet the problem is fv. Here car is called without a check that the argument is a non-empty list first.
if this is rotating a list to the left:
(define (rotate-left l)
(if (null? l)
'()
(append (cdr l) (cons(car l) '()))))
How would I rotate a list to the right?
If you're ok with writing a helper function to find the last element, it's pretty easy to do a recursive implementation:
(define rotate-right
(lambda (lis full)
(if (null? (cdr lis))
(cons (car lis) (get-all-but-last full))
(rotate-right (cdr lis) full))))
(define get-all-but-last
(lambda (lis)
(if (null? (cdr lis))
'()
(cons (car lis) (get-all-but-last (cdr lis))))))
Here is a short non-recursive solution:
(define (rotate-right l)
(let ((rev (reverse l)))
(cons (car rev) (reverse (cdr rev)))))
And here is a iterative solution:
(define (rotate-right l)
(let iter ((remain l)
(output '()))
(if (null? (cdr remain))
(cons (car remain) (reverse output))
(iter (cdr remain) (cons (car remain) output)))))
(rotate-right '(1 2 3 4 5)) ;==> (5 1 2 3 4)
I've been self-teaching myself Scheme R5RS for the past few months and have just started learning about mutable functions. I've did a couple of functions like this, but seem to find my mistake for this one.
(define (lst-functions)
(let ((lst '()))
(define (sum lst)
(cond ((null? lst) 0)
(else
(+ (car lst) (sum (cdr lst))))))
(define (length? lst)
(cond ((null? lst) 0)
(else
(+ 1 (length? (cdr lst))))))
(define (average)
(/ (sum lst) (length? lst)))
(define (insert x)
(set! lst (cons x lst)))
(lambda (function)
(cond ((eq? function 'sum) sum)
((eq? function 'length) length?)
((eq? function 'average) average)
((eq? function 'insert) insert)
(else
'undefined)))))
(define func (lst-functions))
((func 'insert) 2)
((func 'average))
You're not declaring the lst parameter in the procedures that use it, but you're passing it when invoking them. I marked the lines that were modified, try this:
(define (lst-functions)
(let ((lst '()))
(define (sum lst) ; modified
(cond ((null? lst) 0)
(else
(+ (car lst) (sum (cdr lst))))))
(define (length? lst) ; modified
(cond ((null? lst) 0)
(else
(+ 1 (length? (cdr lst))))))
(define (average)
(/ (sum lst) (length? lst)))
(define (insert x)
(set! lst (cons x lst)))
(lambda (function)
(cond ((eq? function 'sum) (lambda () (sum lst))) ; modified
((eq? function 'length) (lambda () (length? lst))) ; modified
((eq? function 'average) average)
((eq? function 'insert) insert)
(else
'undefined)))))
Now it works as expected:
(define func (lst-functions))
((func 'insert) 2)
((func 'average))
=> 2
((func 'sum))
=> 2
((func 'length))
=> 1
Some of your functions are recursive but defined without argument. Thus (sum (cdr lst)) shouldn't work since sum uses lst. You could do it by defining a helper:
(define (sum-rec lst)
(if (null? lst)
0
(+ (car lst) (sum-rec (cdr lst)))))
Or perhaps with an accumulator:
(define (sum-iter lst acc)
(if (null? lst)
acc
(sum-iter (cdr lst) (+ (car lst) acc)))
Your sum would of course use it passing the lst:
(define (sum)
(sum-iter lst 0))
Or you can just have the driver partial apply them like this:
(lambda (function)
(cond ((eq? function 'sum) (lambda () (sum-iter lst))
...))
A side note. length? is a strangely named function. A question mark in the end of a name is usually reserved for functions that return a true or a false value and this clearly returns a number.
After writing:
(define (sort-asc l)
(cond ((eq? l '()) '())
((eq? (cdr l) '()) (list (car l)))
((< (car l) (cadr l)) (cons (car l) (sort-asc (cdr l)) ))
(else (cons (cadr l) (sort-asc (cons (car l) (cddr l)) )))))
How do you write a function that can additionally take a comparison function as a parameter?
Tried:
(define (sort-f l f)
(cond ((eq? l '()) '())
((eq? (cdr l) '()) (list (car l)))
((lambda ()(f (car l) (cadr l))) (cons (car l) (sort-f (cdr l) f)))
(else (cons (cadr l) (sort-f (cons (car l) (cddr l)) f)))))
But (sort-f '(4 3 8 2 5) <) returns the same list.
p.s. Is there any way to make this code look more elegant by somehow rewriting of all the car's, cadr's and cdr's?
Your third cond branch condition should be (f (car l) (cadr l)), not (lambda () ...). The lambda expression returns a procedure (which is not invoked), and since all procedures are truthy, the fourth (else) branch is never reached.
That is,
((lambda ()(f (car l) (cadr l))) (cons (car l) (sort-f (cdr l) f)))
should be
((f (car l) (cadr l)) (cons (car l) (sort-f (cdr l) f)))
I need to write a scheme function that returns as a function which then takes another argument, eg a list and in turn return the desired result. In this example (c?r "arg") would return -- (car(cdr -- which then subsequently takes the list argument to return 2
> ((c?r "ar") '(1 2 3 4))
2
> ((c?r "ara") '((1 2) 3 4))
2
The problem I have is how can I return a function that accepts another arg in petite?
Here's how you might write such a function:
(define (c?r cmds)
(lambda (lst)
(let recur ((cmds (string->list cmds)))
(if (null? cmds)
lst
(case (car cmds)
((#\a) (car (recur (cdr cmds))))
((#\d) (cdr (recur (cdr cmds))))
(else (recur (cdr cmds))))))))
Note that I'm using d to signify cdr, not r (which makes no sense, to me). You can also write this more succinctly using string-fold-right (requires SRFI 13):
(define (c?r cmds)
(lambda (lst)
(string-fold-right (lambda (cmd x)
(case cmd
((#\a) (car x))
((#\d) (cdr x))
(else x)))
lst cmds)))
Just wanted to add my playing with this. Uses SRFI-1.
(import (rnrs)
(only (srfi :1) fold)) ;; require fold from SRFI-1
(define (c?r str)
(define ops (reverse (string->list str)))
(lambda (lst)
(fold (lambda (x acc)
((if (eq? x #\a) car cdr) ; choose car or cdr for application
acc))
lst
ops)))
Its very similar to Chris' version (more the previous fold-right) but I do the reverseso i can use fold in the returned procedure. I choose which of car or cdr to call by looking at the character.
EDIT
Here is an alternative version with much more preprocessing. It uses tail-ref and list-tail as shortcuts when there are runs of #\d's.
(define (c?r str)
(let loop ((druns 0) (ops (string->list str)) (funs '()))
(cond ((null? ops)
(let ((funs (reverse
(if (zero? druns)
funs
(cons (lambda (x)
(list-tail x druns))
funs)))))
(lambda (lst)
(fold (lambda (fun lst)
(fun lst))
lst
funs))))
((eq? (car ops) #\d) (loop (+ druns 1) (cdr ops) funs))
((= druns 0) (loop 0 (cdr ops) (cons car funs)))
(else (loop 0 (cdr ops) (cons (lambda (x)
(list-ref x druns))
funs))))))
This can be made even simpler in #!racket. we skip the reverse and just do (apply compose1 funs).
(define (c?r str)
(let loop ((druns 0) (ops (string->list str)) (funs '()))
(cond ((null? ops)
(let ((funs (if (zero? druns)
funs
(cons (lambda (x)
(list-tail x druns))
funs))))
(apply compose1 funs)))
((eq? (car ops) #\d) (loop (+ druns 1) (cdr ops) funs))
((= druns 0) (loop 0 (cdr ops) (cons car funs)))
(else (loop 0 (cdr ops) (cons (lambda (x)
(list-ref x druns))
funs))))))
Assuming a compose procedure:
(define (compose funs . args)
(if (null? funs)
(apply values args)
(compose (cdr funs) (apply (car funs) args))))
(compose (list cdr car) '(1 2 3 4))
=> 2
c?r can be defined in terms of compose like so:
(define (c?r funs)
(lambda (e)
(compose
(map
(lambda (f) (if (char=? f #\a) car cdr))
(reverse (string->list funs)))
e)))
then
((c?r "ar") '(1 2 3 4))
=> 2
((c?r "ara") '((1 2) 3 4))
=> 2