I am trying to write by myself the cons function in scheme. I have written this code:
(define (car. z)
(z (lambda (p q) p)))
and I am trying to run :
(car. '(1 2 3))
I expect to get the number 1, but it does not work properly.
When you implement language data structures you need to supply constructors and accessors that conform to the contract:
(car (cons 1 2)) ; ==> 1
(cdr (cons 1 2)) ; ==> 2
(pair? (cons 1 2)) ; ==> 2
Here is an example:
(define (cons a d)
(vector a d))
(define (car p)
(vector-ref p 0))
(define (cdr p)
(vector-ref p 1))
Now if you make an implementation you would implement read to be conformant to this way of doing pairs so that '(1 2 3) would create the correct data structure the simple rules above is still the same.
From looking at car I imagine cons looks like this:
(define (cons a d)
(lambda (p) (p a d)))
It works with closures. Now A stack machine implementation of Scheme would analyze the code for free variables living passed their scope and thus create them as boxes. Closures containing a, and d aren't much different than vectors.
I urge you to implement a minimalistic Scheme interpreter. First in Scheme since you can use the host language, then a different than a lisp language. You can even do it in an esoteric language, but it is very time consuming.
Sylwester's answer is great. Here's another possible implementation of null, null?, cons, car, cdr -
(define null 'null)
(define (null? xs)
(eq? null xs))
(define (cons a b)
(define (dispatch message)
(match message
('car a)
('cdr b)
(_ (error 'cons "unsupported message" message))
dispatch)
(define (car xs)
(if (null? xs)
(error 'car "cannot call car on an empty pair")
(xs 'car)))
(define (cdr xs)
(if (null? xs)
(error 'cdr "cannot call cdr on an empty pair")
(xs 'cdr)))
It works like this -
(define xs (cons 'a (cons 'b (cons 'c null))))
(printf "~a -> ~a -> ~a\n"
(car xs)
(car (cdr xs))
(car (cdr (cdr xs))))
;; a -> b -> c
It raises errors in these scenarios -
(cdr null)
; car: cannot call car on an empty pair
(cdr null)
; cdr: cannot call cdr on an empty pair
((cons 'a 'b) 'foo)
;; cons: unsupported dispatch: foo
define/match adds a little sugar, if you like sweet things -
(define (cons a b)
(define/match (dispatch msg)
(('car) a)
(('cdr) b)
(('pair?) #t)
((_) (error 'cons "unsupported dispatch: ~a" msg)))
dispatch)
((cons 1 2) 'car) ;; 1
((cons 1 2) 'cdr) ;; 2
((cons 1 2) 'pair?) ;; #t
((cons 1 2) 'foo) ;; cons: unsupported dispatch: foo
Related
Here is my code about postfix in scheme:
(define (stackupdate e s)
(if (number? e)
(cons e s)
(cons (eval '(e (car s) (cadr s))) (cddr s))))
(define (postfixhelper lst s)
(if (null? lst)
(car s)
(postfixhelper (cdr lst) (stackupdate (car lst) s))))
(define (postfix list)
(postfixhelper list '()))
(postfix '(1 2 +))
But when I tried to run it, the compiler said it takes wrong. I tried to check it, but still can't find why it is wrong. Does anyone can help me? Thanks so much!
And this is what the compiler said:
e: unbound identifier;
also, no #%app syntax transformer is bound in: e
eval never has any information about variables that some how are defined in the same scope as it is used. Thus e and s does not exist. Usually eval is the wrong solution, but if you are to use eval try doing it as as little as you can:
;; Use eval to get the global procedure
;; from the host scheme
(define (symbol->proc sym)
(eval sym))
Now instead of (eval '(e (car s) (cadr s))) you do ((symbol->proc e) (car s) (cadr s)). Now you should try (postfix '(1 2 pair?))
I've made many interpreters and none of them used eval. Here is what I would have done most of the time:
;; Usually you know what operators are supported
;; so you can map their symbol with a procedure
(define (symbol->proc sym)
(case sym
[(+) +]
[(hyp) (lambda (k1 k2) (sqrt (+ (* k1 k1) (* k2 k2))))]
[else (error "No such operation" sym)]))
This fixes the (postfix '(1 2 pair?)) problem. A thing that I see in your code is that you always assume two arguments. But how would you do a double? eg something that just doubles the one argument. In this case symbol->proc could return more information:
(define (symbol->op sym)
(case sym
[(+) (cons + 2)]
[(double) (cons (lambda (v) (* v v)) 1)]
[else (error "No such operation" sym)]))
(define op-proc car)
(define op-arity cdr)
And in your code you could do this if it's not a number:
(let* ([op (symbol->op e)]
[proc (op-proc op)]
[arity (op-arity op)])
(cons (apply proc (take s arity)
(drop s arity)))
take and drop are not R5RS, but they are simple to create.
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
In "The Scheme Programming Language 4th Edition" section 3.3 Continuations the following example is given:
(define product
(lambda (ls)
(call/cc
(lambda (break)
(let f ([ls ls])
(cond
[(null? ls) 1]
[(= (car ls) 0) (break 0)]
[else (* (car ls) (f (cdr ls)))]))))))
I can confirm it works in chezscheme as written:
> (product '(1 2 3 4 5))
120
What is 'f' in the above let? Why is the given ls being assigned to itself? It doesn't seem to match what I understand about (let ...) as described in 4.4 local binding:
syntax: (let ((var expr) ...) body1 body2 ...)
If 'f' is being defined here I would expect it inside parenthesis/square brackets:
(let ([f some-value]) ...)
This is 'named let', and it's a syntactic convenience.
(let f ([x y] ...)
...
(f ...)
...)
is more-or-less equivalent to
(letrec ([f (λ (x ...)
...
(f ...)
...)])
(f y ...))
or, in suitable contexts, to a local define followed by a call:
(define (outer ...)
(let inner ([x y] ...)
...
(inner ...)
...))
is more-or-less equivalent to
(define (outer ...)
(define (inner x ...)
...
(inner ...)
...)
(inner y ...))
The nice thing about named let is that it puts the definition and the initial call of the local function in the same place.
Cavemen like me who use CL sometimes use macros like binding, below, to implement this (note this is not production code: all its error messages are obscure jokes):
(defmacro binding (name/bindings &body bindings/decls/forms)
;; let / named let
(typecase name/bindings
(list
`(let ,name/bindings ,#bindings/decls/forms))
(symbol
(unless (not (null bindings/decls/forms))
(error "a syntax"))
(destructuring-bind (bindings . decls/forms) bindings/decls/forms
(unless (listp bindings)
(error "another syntax"))
(unless (listp decls/forms)
(error "yet another syntax"))
(multiple-value-bind (args inits)
(loop for binding in bindings
do (unless (and (listp binding)
(= (length binding) 2)
(symbolp (first binding)))
(error "a more subtle syntax"))
collect (first binding) into args
collect (second binding) into inits
finally (return (values args inits)))
`(labels ((,name/bindings ,args
,#decls/forms))
(,name/bindings ,#inits)))))
(t
(error "yet a different syntax"))))
f is bound to a procedure that has the body of let as a body and ls as a parameter.
http://www.r6rs.org/final/html/r6rs/r6rs-Z-H-14.html#node_sec_11.16
Think of this procedure:
(define (sum lst)
(define (helper lst acc)
(if (null? lst)
acc
(helper (cdr lst)
(+ (car lst) acc))))
(helper lst 0))
(sum '(1 2 3)) ; ==> 6
We can use named let instead of defining a local procedure and then use it like this:
(define (sum lst-arg)
(let helper ((lst lst-arg) (acc 0))
(if (null? lst)
acc
(helper (cdr lst)
(+ (car lst) acc)))))
Those are the exact same code with the exception of some duplicate naming situations. lst-arg can have the same name lst and it is never the same as lst inside the let.
Named let is easy to grasp. call/ccusually takes some maturing. I didn't get call/cc before I started creating my own implementations.
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)
Hi I got the error mcar: contract violationexpected: mpair? given: () while running these code:
(define helpy
(lambda (y listz)
(map (lambda (z) (list y z))
listz)))
(define print
(lambda (listy)
(cond
((null? list) (newline))
(#t (helpy (car listy) (cdr listy))
(print (cdr listy))))))
My code is trying to return pairs in a list. For example, when I call
(print '(a b c)) it should return ((a b) (a c) (b c)).
I just fix and update my code, now it don't return error but I can only get pair ( (a b) (a c), when running these code:
(define helpy
(lambda (y listz)
(map (lambda (z) (list y z))
listz)))
(define print
(lambda (listy)
(cond
((null? listy) (newline))
(#t (helpy (car listy) (cdr listy)))
(print (cdr listy)))))
I think that I got something wrong with the recursion
There are a couple of problems with the code. First, by convention the "else" clause of a cond should start with an else, not a #t. Second, the null? test in print should receive listy, not list. And third, you're not doing anything with the result returned by helpy in print, you're just advancing print over the cdr of the current list without doing anything with the value returned by the recursive call. Try this instead:
(define print
(lambda (listy)
(cond
((null? listy) (newline))
(else
(displayln (helpy (car listy) (cdr listy)))
(print (cdr listy))))))
displayln is just an example, do something else with the returned result if necessary.
I try to implement like this:
#lang racket
(define data '(a b c d))
(define (one-list head line-list)
(if (null? line-list)
null
(cons
(cons head (car line-list))
(one-list head (rest line-list)))))
(letrec ([deal-data
(lambda (data)
(if (null? data)
'()
(append
(one-list (car data) (rest data))
(deal-data (rest data)))))])
(deal-data data))
run result:
'((a . b) (a . c) (a . d) (b . c) (b . d) (c . d))