This was an edit to an earlier post. I am reposting it because I think the original isn't getting any more views since I accepted a partial answer already.
I have written a function match-rewriter which is just match-lambda except that it returns its argument if no match is found.
Using match rewriter I want to be able to write rules that can be passed to another function rewrite which is this:
#| (rewrite rule s) repeatedly calls unary function 'rule' on every "part"
of s-expr s, in unspecified order, replacing each part with result of rule,
until calling rule makes no more changes to any part.
Parts are s, elements of s, and (recursively) parts of the elements of s. (define (rewrite rule s) |#
(let* ([with-subparts-rewritten
(if (list? s) (map (λ (element) (rewrite rule element)) s) s)]
[with-also-rule-self (rule with-subparts-rewritten)])
(if (equal? with-also-rule-self with-subparts-rewritten)
with-also-rule-self
(rewrite rule with-also-rule-self))))
Here is an example of proper usage:
(define arithmetic
(match-rewriter (`(+ ,a ,b) (+ a b))
(`(* ,a ,b) (* a b))
))
(rewrite arithmetic '(+ (* 2 (+ 3 4)) 5))
==>
19
Now I have written:
(define let→λ&call
(match-rewriter (`(let ((,<var> ,<val>) . (,<vars> ,<vals>)) ,<expr> . ,<exprs>)
`((λ (,<var> . ,<vars>) ,<expr> . ,<exprs>) ,<val> . ,<vals>))))
to implement lets as lambda calls, but this is how it is behaving:
(rewrite let→λ&call '(let((x 1) (y 2) (z 3)) (displayln x) (displayln y) (displayln z)))
'((λ (x y 2)
(displayln x)
(displayln y)
(displayln z))
1
z
3)
which, I have to say, really has me stumped. Strangely this call:
(rewrite let→λ&call '(let((w 0) (x 1) (y 2) (z 3)) (displayln w) (displayln x) (displayln y) (displayln z)))
'(let ((w 0) (x 1) (y 2) (z 3))
(displayln w)
(displayln x)
(displayln y)
(displayln z))
Just returns its argument, meaning that match-rewriter did not find a match for this pattern.
Any advice is appreciated.
Thanks.
This pattern:
((,<var> ,<val>) . (,<vars> ,<vals>))
does not do what you want. In particular, it's equivalent to:
((,<var> ,<val>) ,<vars> ,<vals>)
I recommend that you use regular match patterns, rather than quasi-patterns, until you have a better sense of how they work. The pattern for this would be:
(list (list <var> <val>) (list <vars> <vals>) ...)
Related
This function should return the symmetric closure of L.
Examples:
(Symmetric-Closure'((a a) (a b) (b a) (b c) (c b))) ---> '((a a) (a b) (b a) (b c) (c b))
(Symmetric-Closure'((a a) (a b) (a c))) ---> '((a a) (a b) (a c) (b a)(c a))
(Symmetric-Closure'((a a) (b b))) ---> '((a a) (b b))
(Symmetric-Closure'())---> '()
Here is what I have in Racket
(define (Symmetric-Closure L)
;Iterate over each pair in L
(andmap (lambda (x)
;If the flipped pair does not exist in L, it will
;return L and the flipped pair that is missing. Otherwise, return L.
(if(not(member (list (cadr x)(car x)) L))
(cons (list (cadr x)(car x)) L)
(append L)))
L))
How can I fix my code so that it will return all the flipped pairs that is missing
For example, my code only return L and the last missing flipped pair (c a) instead of (b a) and (c a)
;this is wrong, it should return '((c a)(b a)(a a)(a b)(a c))
(Symmetric-Closure '((a a)(a b)(a c))-----> '((c a)(a a)(a b)(a c))
;this is correct
(Symmetric-Closure '((a a)(a b)(b a)(b c)(c b)))-----> '((a a)(a b)(b a)(b c)(c b))
andmap means "map the list using this function and then and together the results." In Racket, whenever you and together any values, the result is going to be either the last value provided to it, or false. For example, (and value1 value2) results in value2 if neither value1 nor value2 is false (and if one of them is false, the result is false as well). Since the value produced by your lambda is never false, the result of your andmap is going to be the value of the lambda expression the final time it is called, which in this case, could be the list (cons (list (cadr x)(car x)) L) for the last value of x that it sees in the original list L. This means that all preceding values that were consed don't factor into the result at all.
You could modify this to use a simple map instead. But this produces a list of lists of pairs, not a list of pairs which is what you want. So at the end you need to flatten this to arrive at the result.
(define (symmetric-closure L)
;Iterate over each pair in L
(apply append
(map (lambda (x)
;If the flipped pair does not exist in L, it will
;return L and the flipped pair that is missing. Otherwise, return L.
(if (not (member (list (cadr x) (car x)) L))
(list (list (cadr x) (car x)) x)
(list x)))
L)))
One thing to be aware of, though, is that this algorithm calls member for every element in the original list. Checking for membership in a list is O(N) and you are doing this N times, meaning that the complexity of this algorithm is O(N²). You should be able to do this more efficiently, for instance by using a hash set.
I wrote a simple Lisp interpreter in Moonscript Lua. The evaluator looks like this:
eval = ( env, expr ) ->
if is_symbol expr
lookup env, expr
elseif is_define expr
eval_define env, expr
elseif is_lambda expr
eval_lambda env, expr
else call (map (partial eval, env), expr)
It works fine.
But now I would really like to trace out the process, in a way that looks something like this:
(+ (+ a b) (+ a c))
(+ (+ 1 2) (+ 1 4))
(+ 3 5)
8
The thing is, since the evaluation process is recursive, at no point do I have the whole expression to print out.
Do I have to rewrite the evaluator in imperative style or am I missing something obvious?
This answer is using Common Lisp, because I don't really know Lua.
Actual trace
Typically, you want to trace what actually happens in your code.
Here is a rewrite of your function and an example of what a tracing tool can do:
(defun normal-eval (form env)
(etypecase form
(cons (destructuring-bind (op . args) form
(apply op
(mapcar (lambda (u)
(normal-eval u env))
args))))
(null nil)
(symbol (cdr (assoc form env)))
(t form)))
> (trace normal-eval)
> (normal-eval '(+ (+ 1 3 a) 2) '((a . 5)))
0: (NORMAL-EVAL (+ (+ 1 3 A) 2) ((A . 5)))
1: (NORMAL-EVAL (+ 1 3 A) ((A . 5)))
2: (NORMAL-EVAL 1 ((A . 5)))
2: NORMAL-EVAL returned 1
2: (NORMAL-EVAL 3 ((A . 5)))
2: NORMAL-EVAL returned 3
2: (NORMAL-EVAL A ((A . 5)))
2: NORMAL-EVAL returned 5
1: NORMAL-EVAL returned 9
1: (NORMAL-EVAL 2 ((A . 5)))
1: NORMAL-EVAL returned 2
0: NORMAL-EVAL returned 11
Desired trace
There is no easy way as far as I know to have the kind of output you want with the code you provided.
But if you are willing to change your code, you can obtain the trace you want in a purely functional fashion, simply by rewriting the term step-by-step. However, you have to prevent evaluating a term that was already evaluated, in order to let the form be gradually changed.
(defun s-eval (x env)
(etypecase x
(cons (destructuring-bind (new-list . some-evalp)
(reduce
(lambda (element R)
(destructuring-bind (rec-list . some-evalp) R
(multiple-value-bind (value evalp) (s-eval element env)
(cons (list* value rec-list)
(or some-evalp evalp)))))
(rest x)
:from-end t
:initial-value (cons nil nil))
(values
(if some-evalp
;; a least one element required some work
;; so we return the modified term.
(cons (first x) new-list)
;; all elements are literal, we can actually
;; replace this form by its evaluation
(apply (first x) new-list))
T)))
(null (values nil nil))
(symbol (values (cdr (assoc x env)) t))
(t (values x nil))))
(defun step-eval (form &optional env)
(print form)
(multiple-value-bind (value evalp)
(s-eval form env)
(if evalp
(step-eval value env)
value)))
> (step-eval '(+ (+ 1 3 a) 2) '((a . 5)))
(+ (+ 1 3 A) 2)
(+ (+ 1 3 5) 2)
(+ 9 2)
11
> (step-eval '(+ (+ 1 3 a) (* b a)) '((a . 5) (b . 0)))
(+ (+ 1 3 A) (* B A))
(+ (+ 1 3 5) (* 0 5))
(+ 9 0)
9
> (step-eval '(+ (+ a b) (+ a c)) '((a . 1)
(b . 2)
(c . 4)))
(+ (+ A B) (+ A C))
(+ (+ 1 2) (+ 1 4))
(+ 3 5)
8
S-EVAL evaluates a form in an environment and returns two values: the evaluation of the form and a boolean indicating whether some evaluation actually occurred or if the term was self-evaluating (a literal). This boolean is used to prevent transforming a term where a subterm was transformed by a recursive evaluation.
STEP-EVAL prints the form and calls S-EVAL, before calling itself recursively until evaluation terminates.
Been playing around with LISP in class. This is admittedly the first LISP code I've written. I can't figure out why this code produces the error "invocation stack history overflow" for input values over 2000 to the function (longest_collatz n). Can anyone with more experience in this language help me understand the error?
(defun longest_collatz(n)
(reverse
(maxlist
(loop for x from 1 to n
collect (list x (length (collatz x)))))))
(defun collatz (n)
(if (<= n 1)
'(1)
(if (= (mod n 2) 0)
(cons (/ n 2) (collatz (/ n 2)))
(cons (+ (* n 3) 1) (collatz (+ (* n 3) 1))))))
(defun maxlist (z)
(if (> (length z) 1)
(if (< (cadr (elt z 0)) (cadr (elt z 1)))
(maxlist (cdr z))
(maxlist (cons (elt z 0) (cddr z))))
(car z)))
Yout collatz function is not tail recursive, so it is unlikely that it is converted to a loop even if you compile your code.
You can rewrite it using an accumulator, so that it is converted to a loop by the compiler:
(defun collatz (n &optional acc)
(unless (plusp n)
(error "~s(~s): positive argument is required" 'collatz n))
(if (= n 1)
(nreverse (cons 1 acc))
(let ((next (if (evenp n)
(ash n -1) ; same as (mod n 2)
(1+ (* n 3)))))
(collatz next (cons next acc)))))
(this is a bug-for-bug reimplementation).
Notes:
Avoid elt; using first and second instead would be must better.
Rewriting maxlist using reduce would make it both faster and clearer.
Here's a function that just returns the length of the collatz list instead of the list itself. It could be more efficient (and is tail recursive).
(defun collatz_length2 (n cnt)
(if (<= n 1)
cnt
(if (= (mod n 2) 0)
(collatz_length2 (/ n 2) (1+ cnt))
(collatz_length2 (+ (* n 3) 1) (1+ cnt)))))
(defun collatz_length (n) (collatz_length2 n 1))
I was wondering if anyone had any advice on writing the mandelbrot stream. I have wrote the following functions for myself to help:
(define (make-complex a b) (cons a b))
(define (real-coeff c) (car c))
(define (imag-coeff c) (cdr c))
(define (c-add c d)
(make-complex (+ (real-coeff c) (real-coeff d))
(+ (imag-coeff c) (imag-coeff d))))
(define (c-mult c d)
(make-complex (- (* (real-coeff c) (real-coeff d))
(* (imag-coeff c) (imag-coeff d)))
(+ (* (real-coeff c) (imag-coeff d))
(* (imag-coeff c) (real-coeff d)))))
(define (c-length c)
(define (square x) (* x x))
(sqrt (+ (square (real-coeff c))
(square (imag-coeff c)))))
I have that fz(x) = x2 +z. The stream should return: a, fz(a), fz(fz(a)), fz(fz(fz(a))). I am confused on how to use the functions that I wrote to create a stream that has this output. Anyone have some good advice as to where to go with this?
Start with a value for z and make your function fz(x) like:
(define (make-fz z) (lambda (x) (+ z (* 2 x))))
Now, using srfi-41 stream library, define a stream just as you've indicated:
Try it out (with z of 0):
> (stream->list (stream-take 10 (stream-iterate (make-fz 0) 1)))
(1 2 4 8 16 32 64 128 256 512)
Note: that stream-iterate is defined something like:
(define-stream (stream-iterate fz a)
(stream-cons a (stream-iterate fz (fz a))))
As uselpa said, Scheme has built-in complex numbers. The functions you mentioned are provided as follows:
make-rectangular
real-part
imag-part
+
*
magnitude
As for the second part of your question, what is z? It's hard to answer this without knowing what you're wanting.
I've been doing some homework, wrote some code and can't actually find the reason why it doesn't work. The main idea of this part of the work is to make a stream that will give me elements of Taylor series of cosine function for a given X (angle i guess). anyways here is my code, I'd be happy if some one could point me to the reasons it doesn't work :)
(define (force exp) exp)
(define (s-car s) (car s))
(define (s-cdr s) (force (cdr s)))
; returns n elements of stream s as a list
(define (stream->list s n)
(if (= n 0)
'()
(cons (s-car s) (stream->list (s-cdr s) (- n 1)))))
; returns the n-th element of stream s
(define stream-ref (lambda (s n)
(if (= n 1)
(s-car s)
(stream-ref (s-cdr s) (- n 1)))))
; well, the name kinda gives it away :) make factorial n!
(define (factorial x)
(cond ((= x 0) 1)
((= x 1) 1)
(else (* x (factorial (- x 1))))))
; this function is actually the equation for the
; n-th element of Taylor series of cosine
(define (tylorElementCosine x)
(lambda (n)
(* (/ (expt -1 n) (factorial (* 2 n))) (expt x (* 2 n)))))
; here i try to make a stream of those Taylor series elements of cosine
(define (cosineStream x)
(define (iter n)
(cons ((tylorElementCosine x) n)
(lambda() ((tylorElementCosine x) (+ n 1)))))
(iter 0))
; this definition should bind cosine
; to the stream of taylor series for cosine 10
(define cosine (cosineStream 10))
(stream->list cosine 10)
; this should printi on screen the list of first 10 elements of the series
However, this doesn't work, and I don't know why.
I'm using Dr.Scheme 4.2.5 with the language set to "Essentials of Programming Languages 3rd ed".
Since I was feeling nice (and nostalgic about scheme) I actually waded through your code to finde the mistakes. From what I can see there are 2 problems which keeps the code from running as it should:
If I understand your code correctly (force exp) should evaluate exp, however you directly return it (unevaluated). So it probably should be defined as (define (force exp) (exp))
The second problem is in your lambda: (lambda() ((tylorElementCosine x) (+ n 1)) ) will evaluate to the next element of the taylor series, while it should evaluate to a stream. You probably want something like this: (lambda() (iter (+ n 1)) )
I haven't checked if the output is correct, but with those modifications it does at least run. So if there are any more problems with the code the should be in the formula used.
However I'd suggest that next time you want help with your homework you at least tell us where exactly the problem manifests and what you tried already (the community does frown on "here is some code, please fix it for me" kind of questions).