Scheme procedure in a list - scheme

So imagine i have a list '(+ (* (x) (5)) (2))
How would i make a procedure that changes the x to whichever parameter i give and then evaluates
the function inside the list?
((calculate expression x))
I had some ideas but didn't get it to work.
These are the helprocedures i made:
(define (atom? x)
(not (pair? x)))
(define (deep-map f l)
(cond
((null? l) '())
((atom? l) (f l))
(else
(cons (deep-map f (car l))
(deep-map f (cdr l))))))
(define (deep-change e1 e2 l)
(deep-map (lambda (x) (if (eq? x e1) e2 x)) l))
(define (go-through-list list)
(if (null? list)
'()
((car list) (go-through-list (cdr list)))))
Here is the main code:
(define (calculate expression x)
(let ((expressie (deep-change 'x x expression)))
(('+ (deep-change '+ (+) expression)))
(('- (deep-change '- (-) expression)))
(('* (deep-change '* (*) expression)))
(('/ (deep-change '/ (/) expression)))
(go-through-list expression)))
I managed to change the x in to to parameter i give but have problems with the * and + inside the list.

(define (replace x y tree)
(cond ((null? tree) tree)
((not (or (pair? tree) (list? tree))) (if (eq? x tree) y tree))
(else (cons (replace x y (car tree))
(replace x y (cdr tree))))))
And then you can simply (replace 'x 42 expr).
Assuming the tree is then valid scheme code. You can simply eval it.
If you're trying to replace multiple variables, it might be wise write a replace-multiple function that will handle arbitrary number of variables so that you can do something like this
(replace-multiple '(x y z) '(1 2 3) expr)
Implementing this function is basically calling replace multiple times.
e.g.
(replace 'x 1 (replace 'y 2 (replace 'z 3 expr)))
So you might want to use recursion there.
If your scheme has the fold operator (provided by srfi-1), use it because it essentially achieves the above.
It would probably look something like this:
(define (replace-multiple xs ys tree)
(fold replace tree xs ys))

This could be an interesting question; consider this clarification:
Evaluate list representing expression with free variable without using eval
What is a way to develop a function to evaluate a Scheme expression built from
the four arithmetic operations, numbers, and a free variable x, without using eval?
The function is given a list representing the expression and a value for x.
Example: (calculate '(+ (* x 5) 2) 3) => 17
Development is presented as a sequence of elaborations of the calculate function;
each define has a Signature comment on the same line, informally describing
argument/result types; function and following example(s) can be copy-pasted into a REPL.
Note: not all errors are detected; there is a compact version without comments at the end.
Getting started: write a function which works for the given example:
(define (calculate-0 expression-in-x value-for-x) ;; '(+ (* x 5) 2) Number -> Number
(if (equal? expression-in-x '(+ (* x 5) 2))
(+ (* value-for-x 5) 2)
(error #f "wrong expression" expression-in-x)))
(calculate-0 '(+ (* x 5) 2) 3) ;=> 17
Real function will have to extract pieces of expression
a simple example with all elements is '(+ x 1):
(define (calculate-1 expression value) ;; '(+ x <n>) Number -> Number
(let ([procedure (car expression)]
[argument-1 (cadr expression)]
[argument-2 (caddr expression)])
(if (and (eq? procedure '+)
(eq? argument-1 'x)
(number? argument-2))
(+ value argument-2)
(error #f "expression" expression))))
(calculate-1 '(+ x 1) 2) ;=> 3
+ in Scheme accepts any number of arguments, so replace if with map/cond:
(define (calculate-2 expression value) ;; '(+ x|<n> ...) Number -> Number
(let ([arguments (cdr expression)])
(let ([arguments
(map (lambda (argument)
(cond ;; (compare with (if ...) in calculate-1)
[(eq? argument 'x) value ]
[(number? argument) argument ]
[else (error #f "argument" argument)]))
arguments)])
(apply + arguments))))
(calculate-2 '(+ 1 x) 2) ;=> 3
(calculate-2 '(+ x 1 x) 3) ;=> 7
(calculate-2 '(+) 99) ;=> 0
Get all four operations working:
(define (calculate-3 expression value) ;; '(op x|<n> ...) Number -> Number
(let ([procedure (car expression)]
[arguments (cdr expression)])
(let ([arguments ;; (same as calculate-2)
(map (lambda (argument)
(cond
[(eq? argument 'x) value ]
[(number? argument) argument ]
[else (error #f "argument" argument)]))
arguments)])
(apply (case procedure
[(+) + ]
[(-) - ]
[(*) * ]
[(/) / ]
[else (error #f "procedure" procedure)])
arguments))))
(calculate-3 '(* x 5) 3) ;=> 15
Allowing nested sub-forms needs just one small change:
(define (calculate-4 expression value) ;; '(op x|<n>|Expr ...) Number -> Number
(let ([procedure (car expression)]
[arguments (cdr expression)])
(let ([arguments
(map (lambda (argument)
(cond
[(eq? argument 'x) value ]
[(number? argument) argument ]
[(pair? argument) ;; (<- only change)
(calculate-4 argument value) ] ;;
[else (error #f "argument" argument)]))
arguments)])
(apply (case procedure
[(+) + ]
[(-) - ]
[(*) * ]
[(/) / ]
[else (error #f "procedure" procedure)])
arguments))))
(calculate-4 '(+ (* x 5) 2) 3) ;=> 17
So there it is: try calculate-4 with the original example in the REPL:
$ scheme
> (calculate-4 '(+ (* x 5) 2) 3)
17
> ; works with all Scheme Numbers:
(calculate-4 '(+ (* x 15/3) 2+2i) 3.0)
17.0+2.0i
>
Not so fast ... expression is a list with the form of a Scheme expression using four
operations, Numbers, and x. But the question doesn't require value to be a Number: procedures are
first-class values in Scheme
(expression could be '(+ (x 3) 2) with value (lambda (n) (* n 5)) ):
(define (calculate-5 expression value) ;; '(x|op x|<n>|Expr ...) Number|Lambda -> Value
(let ([procedure (car expression)]
[arguments (cdr expression)])
(let ([arguments
(map (lambda (argument)
(cond
[(eq? argument 'x) value ]
[(number? argument) argument ]
[(pair? argument) (calculate-5 argument value) ]
[else (error #f "argument" argument)]))
arguments)])
(let ([procedure
(cond ;; (compare with argument cond above)
[(eq? procedure 'x) value ]
[(pair? procedure) (calculate-5 procedure value)]
[else (case procedure
[(+) + ]
[(-) - ]
[(*) * ]
[(/) / ]
[else (error #f "procedure" procedure)]) ]) ])
(apply procedure arguments)))))
(calculate-5 '(+ (x 3) 2) (lambda (n) (* n 5))) ;=> 17
(And so, finally, our calculate function is "Hello World!" capable :)
$ scheme
> ;(copy-paste calculate-5 here)
> (calculate-5 '(x) (lambda _ 'Hello!))
Hello!
>
Compact version (returns #f on error):
(define (calculate expr value)
(call/cc (lambda (error)
(let* ([proc (car expr)]
[args (map (lambda (arg) (cond
[(eq? arg 'x) value]
[(number? arg) arg]
[(pair? arg)
(or (calculate arg value) (error #f))]
[else (error #f)]))
(cdr expr))]
[proc (cond
[(eq? proc 'x) value ]
[(pair? proc) (calculate proc value)]
[else (case proc [(+) +] [(-) -] [(*) *] [(/) /]
[else (error #f)])])])
(apply proc args)))))

Related

mcdr: contract violation expected: mpair? given: 5

I am writing a program in scheme that takes in regular scheme notation ex: (* 5 6) and returns the notation that you would use in any other language ex: (5 * 6)
I have my recursive step down but I am having trouble breaking out into my base case.
(define (infix lis)
(if (null? lis) '()
(if (null? (cdr lis)) '(lis)
(list (infix (cadr lis)) (car lis) (infix(caddr lis))))))
(infix '(* 5 6))
the error happens at the (if (null? lis)) '(lis)
the error message is:
mcdr: contract violation
expected: mpair?
given: 5
>
why is it giving me an error and how can I fix this?
Right now your infix function is assuming that its input is always a list. The input is not always a list: sometimes it is a number.
A PrefixMathExpr is one of:
- Number
- (list BinaryOperation PrefixMathExpr PrefixMathExpr)
If this is the structure of your data, the code should follow that structure. The data definition has a one-of, so the code should have a conditional.
;; infix : PrefixMathExpr -> InfixMathExpr
(define (infix p)
(cond
[(number? p) ???]
[(list? p) ???]))
Each conditional branch can use the sub-parts from that case of the data definition. Here, the list branch can use (car p), (cadr p), and (caddr p).
;; infix : PrefixMathExpr -> InfixMathExpr
(define (infix p)
(cond
[(number? p) ???]
[(list? p) (.... (car p) (cadr p) (caddr p) ....)]))
Some of these sub-parts are complex data definitions, in this case self-references to PrefixMathExpr. Those self-references naturally turn into recursive calls:
;; infix : PrefixMathExpr -> InfixMathExpr
(define (infix p)
(cond
[(number? p) ???]
[(list? p) (.... (car p) (infix (cadr p)) (infix (caddr p)) ....)]))
Then fill in the holes.
;; infix : PrefixMathExpr -> InfixMathExpr
(define (infix p)
(cond
[(number? p) p]
[(list? p) (list (infix (cadr p)) (car p) (infix (caddr p)))]))
This process for basing the structure of the program on the structure of the data comes from How to Design Programs.
Mistake
(infix '(* 5 6))
; =
(list (infix (cadr '(* 5 6))) (car '(* 5 6)) (infix (caddr '(* 5 6))))
; =
(list (infix 5) '* (infix (caddr 6)))
; = ^^^^^^^^^
; |
; |
; v
(if ...
...
(if (null? (cdr 5)) ; <-- fails here
...
...))
Solution
First, you need to define the structure of the data you're manipulating:
; OpExp is one of:
; - Number
; - (cons Op [List-of OpExp])
; Op = '+ | '* | ...
In english: it's either a number or an operator followed by a list of other op-expressions.
We define some examples:
(define ex1 7)
(define ex2 '(* 1 2))
(define ex3 `(+ ,ex2 ,ex1))
(define ex4 '(* 1 2 3 (+ 4 3 2) (+ 9 8 7)))
Now we follow the structure of OpExp to make a "template":
(define (infix opexp)
(if (number? opexp)
...
(... (car opexp) ... (cdr opexp) ...)))
Two cases:
The first case: what to do when we just get a number?
The second case: first extract the componenet:
(car opexp) is the operator
(cdr opexp) is a list of operands of type OpExp
Refining the template:
(define (infix opexp)
(if (number? opexp)
opexp
(... (car opexp) ... (map infix (cdr opexp)) ...)))
Since we have a a list of op-exps, we need to map a recursive call on all of them. All we need to do is make the operator infix at the top-level.
We use a helper that intertwines the list with the operator:
; inserts `o` between every element in `l`
(define (insert-infix o l)
(cond ((or (null? l) (null? (cdr l))) l) ; no insertion for <= 1 elem lst
(else (cons (car l) (cons o (insert-infix o (cdr l)))))))
and finally use the helper to get the final version:
; converts OpExp into infix style
(define (infix opexp)
(if (number? opexp)
opexp
(insert-infix (car opexp) (map infix (cdr opexp)))))
We define respective results for our examples:
(define res1 7)
(define res2 '(1 * 2))
(define res3 `(,res2 + ,res1))
(define res4 '(1 * 2 * 3 * (4 + 3 + 2) * (9 + 8 + 7)))
And a call of infix on ex1 ... exN should result in res1 ... resN

Multiple different errors in scheme

I'm working on this project in Scheme and these errors on these three particular methods have me very stuck.
Method #1:
; Returns the roots of the quadratic formula, given
; ax^2+bx+c=0. Return only real roots. The list will
; have 0, 1, or 2 roots. The list of roots should be
; sorted in ascending order.
; a is guaranteed to be non-zero.
; Use the quadratic formula to solve this.
; (quadratic 1.0 0.0 0.0) --> (0.0)
; (quadratic 1.0 3.0 -4.0) --> (-4.0 1.0)
(define (quadratic a b c)
(if
(REAL? (sqrt(- (* b b) (* (* 4 a) c))))
((let ((X (/ (+ (* b -1) (sqrt(- (* b b) (* (* 4 a) c)))) (* 2 a)))
(Y (/ (- (* b -1) (sqrt(- (* b b) (* (* 4 a) c)))) (* 2 a))))
(cond
((< X Y) (CONS X (CONS Y '())))
((> X Y) (CONS Y (CONS X '())))
((= X Y) (CONS X '()))
)))#f)
Error:
assertion-violation: attempt to call a non-procedure [tail-call]
('(0.0) '())
1>
assertion-violation: attempt to call a non-procedure [tail-call]
('(-4.0 1.0) '())
I'm not sure what it is trying to call. (0.0) and (-4.0 1.0) is my expected output so I don't know what it is trying to do.
Method #2:
;Returns the list of atoms that appear anywhere in the list,
;including sublists
; (flatten '(1 2 3) --> (1 2 3)
; (flatten '(a (b c) ((d e) f))) --> (a b c d e f)
(define (flatten lst)
(cond
((NULL? lst) '())
((LIST? lst) (APPEND (CAR lst) (flatten(CDR lst))))
(ELSE (APPEND lst (flatten(CDR lst))))
)
)
Error: assertion-violation: argument of wrong type [car]
(car 3)
3>
assertion-violation: argument of wrong type [car]
(car 'a)
I'm not sure why this is happening, when I'm checking if it is a list before I append anything.
Method #3
; Returns the value that results from:
; item1 OP item2 OP .... itemN, evaluated from left to right:
; ((item1 OP item2) OP item3) OP ...
; You may assume the list is a flat list that has at least one element
; OP - the operation to be performed
; (accumulate '(1 2 3 4) (lambda (x y) (+ x y))) --> 10
; (accumulate '(1 2 3 4) (lambda (x y) (* x y))) --> 24
; (accumulate '(1) (lambda (x y) (+ x y))) --> 1
(define (accumulate lst OP)
(define f (eval OP (interaction-environment)))
(cond
((NULL? lst) '())
((NULL? (CDR lst)) (CAR lst))
(ELSE (accumulate(CONS (f (CAR lst) (CADR lst)) (CDDR lst)) OP))
)
)
Error:
syntax-violation: invalid expression [expand]
#{procedure 8664}
5>
syntax-violation: invalid expression [expand]
#{procedure 8668}
6>
syntax-violation: invalid expression [expand]
#{procedure 8672}
7>
syntax-violation: invalid expression [expand]
#{procedure 1325 (expt in scheme-level-1)}
This one I have no idea what this means, what is expand?
Any help would be greatly appreciated
code has (let () ...) which clearly evaluates to list? so the extra parentheses seems odd. ((let () +) 1 2) ; ==> 3 works because the let evaluates to a procedure, but if you try ((cons 1 '()) 1 2) you should get an error saying something like application: (1) is not a procedure since (1) isn't a procedure. Also know that case insensitivity is deprecated so CONS and REAL? are not future proof.
append concatenates lists. They have to be lists. In the else you know since lst is not list? that lst cannot be an argument of append. cons might be what you are looking for. Since lists are abstraction magic in Scheme I urge you to get comfortable with pairs. When I read (1 2 3) I see (1 . (2 . (3 . ()))) or perhaps (cons 1 (cons 2 (cons 3 '()))) and you should too.
eval is totally inappropriate in this code. If you pass (lambda (x y) (+ x y)) which evaluates to a procedure to OP you can do (OP 1 2). Use OP directly.

What is definition of “map” in Racket

What would be the definition of "map" function without using any other high-level functional in Racket?
I need a stack recursion version.
A simple definition of a map function could be:
(define (map f l)
(if (null? l)
'()
(cons (f (car l)) (map f (cdr l)))))
(map (lambda (n) (* n n)) '(1 2 3 4)) ;; => (1 4 9 16)
Usually you'll find map being made with fold, but I prefer doing everything with pair-for-each (maplist in CL). This defines pair-for-each, map, filter-map, filter, zip and unzip compatible with the same procedures in SRFI-1 List library.
#!racket/base
(define-values (pair-for-each map filter-map filter zip unzip)
(let ((%MAP-PASS (list 'MAP-PASS))
(%MAP-END (list 'MAP-END)))
;; pair-for-each-1 applies proc to every cons
;; in order until proc returns %MAP-END
;; when proc evaluates to %MAP-PASS the result is skipped
(define (pair-for-each-1 proc lst (next cdr))
(let loop ((lst lst))
(let ((res (proc lst)))
(cond ((eq? res %MAP-END) '())
((eq? res %MAP-PASS) (loop (next lst)))
(else (cons res
(loop (next lst))))))))
;; Transform a typical map procedure to include
;; a %MAP-END when the list argument is eq? a certain value
(define (stop-at value proc)
(lambda (lst)
(if (eq? value lst)
%MAP-END
(proc lst))))
;; Takes a lists of lists and returns a
;; new list with the cdrs
(define (cdrs lsts)
(pair-for-each-1 (stop-at '() cdar) lsts))
;; Takes a list of lists and returns a
;; new list with the cars except if one of
;; the sublists are nil in which the result is also nil
(define (cars lsts)
(call/cc (lambda (exit)
(pair-for-each-1 (stop-at '()
(lambda (x)
(let ((x (car x)))
(if (null? x)
(exit '())
(car x)))))
lsts))))
;; Takes a list of lists and returns #t if any are null
(define (any-null? lsts)
(if (null? lsts)
#f
(or (null? (car lsts))
(any-null? (cdr lsts)))))
;; Return value definitions starts here
;; pair-for-each is called maplist in CL
(define (pair-for-each proc lst . lsts)
(if (null? lsts)
(pair-for-each-1 (stop-at '() (lambda (x) (proc x))) lst)
(pair-for-each-1 (lambda (args)
(if (any-null? args)
%MAP-END
(apply proc args)))
(cons lst lsts)
cdrs)))
;; Multi arity map
(define (map f lst . lsts)
(if (null? lsts)
(pair-for-each-1 (stop-at '() (lambda (x) (f (car x)))) lst)
(pair-for-each-1 (lambda (x)
(let ((args (cars x)))
(if (null? args)
%MAP-END
(apply f args))))
(cons lst lsts)
cdrs)))
;; filter-map is like map except it skips false values
(define (filter-map proc . lsts)
(apply map (lambda x
(or (apply proc x) %MAP-PASS)))
lsts)
;; filter only takes one list and instead of the result it
;; takes the original argument as value (which may be #f)
(define (filter predicate? lst)
(pair-for-each-1 (stop-at '()
(lambda (x)
(let ((x (car x)))
(if (predicate? x)
x
%MAP-PASS))))
lst))
;; zip (zip '(1 2 3) '(a b c)) ; ==> ((1 a) (2 b) (3 c))
(define (zip lst . lsts)
(apply map list (cons lst lsts)))
;; unzip does the same except it takes a list of lists as argument
(define (unzip lsts)
(apply map list lsts))
;; return procedures
(values pair-for-each map filter-map filter zip unzip)))
It was unclear to me what kind of implementation the OP asked for, so here is yet another variation of map.
; map : function list -> list
; (map f '()) = '()
; (map f (cons x xs)) = (cons (f x) (map f xs))
(define (my-map f xs)
; loop : list list -> list
; (loop (list x1 ... xn) (list y1 ... ym)) = (list (f x1) ... (f xn) ym ... y1)
(define (loop xs ys)
(match xs
['() (reverse ys)]
[(cons x xs) (loop xs (cons (f x) ys))]))
(loop xs '()))
Example:
(my-map sqrt '(1 4 9 16))
'(1 2 3 4)

How to do square in RACKET

Here is my code:
(define (squares 1st)
(let loop([1st 1st] [acc 0])
(if (null? 1st)
acc
(loop (rest 1st) (* (first 1st) (first 1st) acc)))))
My test is:
(test (sum-squares '(1 2 3)) => 14 )
and it's failed.
The function input is a list of number [1 2 3] for example, and I need to square each number and sum them all together, output - number.
The test will return #t, if the correct answer was typed in.
This is rather similar to your previous question, but with a twist: here we add, instead of multiplying. And each element gets squared before adding it:
(define (sum-squares lst)
(if (empty? lst)
0
(+ (* (first lst) (first lst))
(sum-squares (rest lst)))))
As before, the procedure can also be written using tail recursion:
(define (sum-squares lst)
(let loop ([lst lst] [acc 0])
(if (empty? lst)
acc
(loop (rest lst) (+ (* (first lst) (first lst)) acc)))))
You must realize that both solutions share the same structure, what changes is:
We use + to combine the answers, instead of *
We square the current element (first lst) before adding it
The base case for adding a list is 0 (it was 1 for multiplication)
As a final comment, in a real application you shouldn't use explicit recursion, instead we would use higher-order procedures for composing our solution:
(define (square x)
(* x x))
(define (sum-squares lst)
(apply + (map square lst)))
Or even shorter, as a one-liner (but it's useful to have a square procedure around, so I prefer the previous solution):
(define (sum-squares lst)
(apply + (map (lambda (x) (* x x)) lst)))
Of course, any of the above solutions works as expected:
(sum-squares '())
=> 0
(sum-squares '(1 2 3))
=> 14
A more functional way would be to combine simple functions (sum and square) with high-order functions (map):
(define (square x) (* x x))
(define (sum lst) (foldl + 0 lst))
(define (sum-squares lst)
(sum (map square lst)))
I like Benesh's answer, just modifying it slightly so you don't have to traverse the list twice. (One fold vs a map and fold)
(define (square x) (* x x))
(define (square-y-and-addto-x x y) (+ x (square y)))
(define (sum-squares lst) (foldl square-y-and-addto-x 0 lst))
Or you can just define map-reduce
(define (map-reduce map-f reduce-f nil-value lst)
(if (null? lst)
nil-value
(map-reduce map-f reduce-f (reduce-f nil-value (map-f (car lst))))))
(define (sum-squares lst) (map-reduce square + 0 lst))
racket#> (define (f xs) (foldl (lambda (x b) (+ (* x x) b)) 0 xs))
racket#> (f '(1 2 3))
14
Without the use of loops or lamdas, cond can be used to solve this problem as follows ( printf is added just to make my exercises distinct. This is an exercise from SICP : exercise 1.3):
;; Takes three numbers and returns the sum of squares of two larger number
;; a,b,c -> int
;; returns -> int
(define (sum_sqr_two_large a b c)
(cond
((and (< a b) (< a c)) (sum-of-squares b c))
((and (< b c) (< b a)) (sum-of-squares a c))
((and (< c a) (< c b)) (sum-of-squares a b))
)
)
;; Sum of squares of numbers given
;; a,b -> int
;; returns -> int
(define (sum-of-squares a b)
(printf "ex. 1.3: ~a \n" (+ (square a)(square b)))
)
;; square of any integer
;; a -> int
;; returns -> int
(define (square a)
(* a a)
)
;; Sample invocation
(sum_sqr_two_large 1 2 6)

What is wrong with my scheme code?

The function I wrote for SICP 2.20 is:
(define (same-parity x . y)
(if (null? (car y)
'()
(if (= (even? (car y)) (even? x))
(cons (car y) (same-parity (cons x (cdr y))))
(same-parity (cons x (cdr y))))))
And then I try to call it with
(same-parity 1 2 3 4 5 6 7)
The error I get is:
"The object #t, passed as the first argument to integer-equal? is not the correct type."
I thought that equal works with #t and #f...
An example of code I found online is the following, I ran it and it works. But, what am I doing wrong?
(define (same-parity a . rest)
(define (filter rest)
(cond ((null? rest) '())
((= (remainder a 2) (remainder (car rest) 2))
(cons (car rest) (filter (cdr rest))))
(else
(filter (cdr rest)))))
(filter (cons a rest)))
The = procedure accepts numbers. But even? returns a boolean not a number.
Use equal? instead of =.
equal? works with booleans.
For instance at the REPL:
> (even? 2)
#t
> (= (even? 2) (even? 2))
=: expects type <number> as 1st argument, given: #t; other arguments were: #t
> (equal? (even? 2) (even? 2))
#t

Resources