I write the newton-method to find root from Scheme example in elisp as
#+begin_src emacs-lisp :session sicp :lexical t
(defun deriv(g)
(lambda (x)
(/ (- (funcall g (+ x dx)) (funcall g x))
dx)))
(defvar dx 0.00001)
(defvar tolerance 0.00001)
(defun fixed-point(f guess)
(defun close-enoughp(v1 v2)
(< (abs (- v1 v2)) tolerance))
(let ((next (funcall f guess)))
(if (close-enoughp guess next)
next
(fixed-point f next))))
(defun newton-transform(g)
(lambda (x)
(- x (/ (funcall g x) (funcall (funcall #'deriv g) x)))))
(defun newton-method(g guess)
(fixed-point (funcall #'newton-transform g) guess))
(defun curt(x)
(newton-method (lambda (y) (- (* y y y) x))
1.0))
(curt 12)
#+end_src
#+RESULTS:
: 2.2894284851069058
It works but observe the twisted code:
(defun newton-transform(g)
(lambda (x)
(- x (/ (funcall g x) (funcall (funcall #'deriv g) x)))))
Three funcalls, in which I could not imagine bad if more depths of closures.
Is there an alternative solution to the problem with elisp? (I guess it de-appreciates closures)
In newton-transform, (funcall #'deriv g) is identical to (deriv g), so you can eliminate one of the 3 funcalls. The other 2 are, indeed, necessary.
Same for newton-method: replace (funcall #'newton-transform g) with (newton-transform g).
PS. I strongly recommend either moving defun close-enoughp out of defun fixed-point or turning it into a cl-flet. Lisp is not Scheme.
PPS. close-enoughp should be close-enough-p.
A couple of the functions calls can be simplified, and we should implement #sds's advice regarding function names and conventions - like this:
(defvar dx 0.00001)
(defvar tolerance 0.00001)
(defun deriv (g)
(lambda (x)
(/ (- (funcall g (+ x dx)) (funcall g x))
dx)))
(defun close-enough-p (v1 v2)
(< (abs (- v1 v2)) tolerance))
(defun try (f guess)
(let ((next (funcall f guess)))
(if (close-enough-p guess next)
next
(try f next))))
(defun fixed-point (f first-guess)
(try f first-guess))
(defun newton-transform (g)
(lambda (x)
(- x (/ (funcall g x)
(funcall (deriv g) x)))))
(defun newton-method (g guess)
(fixed-point (newton-transform g) guess))
(defun curt (x)
(newton-method (lambda (y) (- (* y y y) x))
1.0))
Notice that we don't need to use funcall when invoking functions previously defined and named, such as deriv and newton-transform.
Related
SICP introduced Riemann integral formula in Chapter 1.3.1
(define (integral f a b dx)
(define (add-dx x) (+ x dx))
(* (sum f (+ a (/ dx 2.0)) add-dx b)
dx))
Apply it to a particular case
#+name: case-1.3.1-integral.scm
#+BEGIN_SRC scheme :session sicp
(define pi 3.141592653589793)
(define (integral2 f a b dx)
(define (add-dx x) (+ x dx))
(* (sum (f b)
(+ a (/ dx 2.0))
(lambda (x) (+ x dx))
b)
dx))
(define (f b)
(lambda (x) (/ 1 (sqrt
(- (sin x)
(sin b))))))
(* (integral2 f 0 (/ pi 6) 0.00001)
(sqrt (/ 40
(* 3 9.8))))
#+END_SRC
#+RESULTS: case-1.3.1-integral.scm
: 0.0-1.777598336021436i
Got a perfect answer 1.777598336021436
Then translate it to elisp
Start from small:
#+name: case-1.3.1-integral.el
#+begin_src emacs-lisp :session sicp :lexical t
(defun integral (f a b dx)
(* (sum f
(+ a (/ dx 2.0))
(lambda (x) (+ x dx))
b)
dx))
(defun sum(term a next b)
(if (> a b)
0
(+ (funcall term a)
(sum term (funcall next a) next b))))
(integral #'cube 0 1 0.01)
#+end_src
#+RESULTS: case-1.3.1-integral.el
: 0.24998750000000042
It works and thus use it to solve the previous problem
#+begin_src emacs-lisp :session sicp :lexical t
(defvar pi 3.141592653589793)
(defun integral (f a b dx)
(* (sum f
(+ a (/ dx 2.0))
(lambda (x) (+ x dx))
b)
dx))
(defun f (b)
(lambda (x) (/ 1 (sqrt
(- (sin x)
(sin b))))))
(defun integral2 (f a b dx)
(* (sum (funcall f b)
(+ a (/ dx 2.0))
(lambda (x) (+ x dx))
b)
dx))
(integral2 #'f 0 (/ pi 6) 0.01)
#+end_src
But it return a meaningless result
ELISP> (integral2 #'f 0 (/ pi 6) 0.01)
-0.0e+NaN
What's the problem?
The answer you obtained when using Scheme is a complex number, the result of calling sqrt (are you sure the Scheme code was correct in the first place? you should double-check it):
0.0-1.777598336021436i
Unfortunately, Elisp doesn't support complex numbers, that's why we get a NaN in there. But that's not the real problem; you should investigate why are you getting complex results in the Scheme code, an integral should not return complex values!
I am now following sicp Finding root of equations
#+begin_src emacs-lisp :session sicp :lexical t
(defun close-enoughp(x y)
(< (abs (- x y)) 0.001))
(defun search(f neg-point pos-point)
(let ((midpoint (average neg-point pos-point)))
(if (close-enoughp neg-point pos-point)
midpoint
(let ((test-value (funcall f midpoint)))
(cond ((posp test-value)
(search f neg-point midpoint))
((negp test-value)
(search f midpoint pos-point))
(t midpoint))))))
(defun half-interval-method(f a b)
(let ((a-value (funcall f a))
(b-value (funcall f b)))
(cond ((and (negp a-value) (posp b-value))
(search f a b))
((and (negp b-value) (posp a-value))
(search f b a))
(t
(error "Values are not of opposite sign" a b)))))
(defun negp(x)
(< x 0))
(defun posp(x)
(> x 0))
(defun average(a b)
(/ (+ a b) 2))
#+end_src
Test it
#+begin_src emacs-lisp :session sicp :lexical t
(half-interval-method (lambda (x) (- (* x x x) (* 2 x) 3))
0
20.0)
#+end_src
#+RESULTS:
: 1.89300537109375
But when try to find the square root of 3
#+begin_src emacs-lisp :session sicp :lexical t
(half-interval-method (lambda (x) (- (* x x) 3)
1
3.0)
)
#+end_src
It report error:
progn: Wrong number of arguments: ((t) (f a b) (let ((a-value (funcall f a)) (b-value (funcall f b))) (cond ((and (negp a-value) (posp b-value)) (search f a b)) ((and (negp b-value) (posp a-value)) (search f b a)) (t (error "Values are not of opposite sign" a b))))), 1
What' the reason that the function so much fragile?
You invoke the function incorrectly.
Replace
(half-interval-method (lambda (x) (- (* x x) 3)
1
3.0)
)
with
(half-interval-method (lambda (x) (- (* x x) 3))
1
3.0)
PS. Use show-paren-mode to catch such errors.
suppose I have the following functions:
(define (g x) (f x))
(define (f x) (+ 1 x))
I would like to temporarily call g with a different f. For example, something like this:
(let ((f (lambda (x) (+ 2 x))))
(g 5))
I would like the code above to evaluate to 7, but it doesn't. Instead, it evaluates to 6, since g calls the f outside the scope of the let.
Is there a way to do this without redefining g inside the let, and without inlining the entire body of the definition of g in the let? (In practice, g may be a very large, complicated function).
What you are asking for is dynamic rather than lexical binding of 'f'. R6RS and R7RS support this with parameters. This will do what you want:
(define f (make-parameter (lambda (x) (+ 1 x))))
(define (g x) ((f) x))
(display (g 5))(newline)
(parameterize ((f (lambda (x) (+ 2 x))))
(display (g 5))(newline))
I'm not sure that you can, but I'm by no means a Scheme expert.
I realise that you're trying to achieve this without redefining g inside the let, but how about:
(define (h f x) (f x))
(define (g x) (h f x))
(define (f x) (+ 1 x))
(let ((f (lambda (x) (+ 2 x))))
(h f 5))
That way, you preserve the behaviour of g where it's currently being called. But where you want to temporarily have a different behaviour, you can call h instead.
A bit more code for clarification:
(let ((f (lambda (x) (+ 2 x))))
(display (g 5)) ; 6
(newline)
(h f 5)) ; 7
You could use an optional parameter in g to pass the f from the let expression.
(define (g x . args)
(if (null? args)
(f x)
((car args) x)))
and
(let ((f (lambda (x) (+ 2 x))))
(g 5 f))
I found a way to do exactly what I wanted, although I have a feeling many people will not consider this kosher:
(define (g x) (f x))
(define (f x) (+ 1 x))
(let ((old-f f))
(set! f (lambda (x) (+ 2 x)))
(let ((ans (g 5)))
(set! f old-f)
ans))
; -> 7
(g 5) ; -> 6
edit In response to the comment below, I wasn't even aware that fluid-let was a thing. It even already works on MIT-Scheme. That's actually exactly what I needed. If commenter below posts something like this as an answer, it will be made the accepted answer:
(define (g x) (f x))
(define (f x) (+ 1 x))
(fluid-let ((f (lambda (x) (+ x 2))))
(g 5)) ; -> 7
(g 5) ; -> 6
I'm trying to create a function that wraps itself n times using a function called repeat
(define (repeat f n)
(if (= n 1)
f
(repeat (lambda (x) (f x)) (- n 1))))
((repeat inc 5) 2)
I'm expecting the result to be equal to
(inc (inc (inc (inc (inc 2))))) ; 7
But my result is 3
What am I doing wrong?
To be clear, I want repeat to return a function that accepts a single argument. f should not be applied until the return value of repeat is called with an argument.
e.g.,
(define inc5 (repeat inc 5))
(inc5 2) ; => 7
p.s.,
This is related but not identical to exercise 1.43 in SICP. I've solved the problem as it is presented there, but I'm curious if it can be solved this way too.
The problem with your definition is that (lambda (x) (f x)) is the same as f, i.e., your repeat repeats only once.
I think what you need is
(define (repeat f n)
(if (= n 1)
f
(lambda (x) (f ((repeat f (- n 1)) x)))))
PS. Note that you are using Scheme syntax under the Common Lisp tag; you might want to update one or the other.
Lets take a look at a similar function.
(define (repeat-exp fn ct)
(if (= ct 1)
fn
(repeat `(lambda (x) (,fn x)) (- ct 1))))
Calling it will get you
> (repeat-exp inc 5)
'(lambda (x)
((lambda (x)
((lambda (x)
((lambda (x)
((lambda (x)
(#<procedure:inc> x))
x))
x))
x))
x))
>
As you can see, your initial function only gets called once; in the innermost evaluation. If you want it to get called at each level, you need to call it there too.
(define (repeat-exp2 fn ct)
(if (= ct 1)
fn
`(lambda (x)
(,fn (,(repeat-exp2 fn (- ct 1)) x)))))
> (repeat-exp2 inc 5)
'(lambda (x)
(#<procedure:inc>
((lambda (x)
(#<procedure:inc>
((lambda (x)
(#<procedure:inc>
((lambda (x)
(#<procedure:inc>
(#<procedure:inc> x)))
x)))
x)))
x)))
>
Now you can write the numeric equivalent.
(define (repeat2 fn ct)
(if (= ct 1)
fn
(lambda (x)
(fn ((repeat2 fn (- ct 1)) x)))))
which should do what you wanted initially.
> (repeat2 inc 5)
#<procedure>
> ((repeat2 inc 5) 2)
7
I found code for generating Sierpinski carpet at http://rosettacode.org/wiki/Sierpinski_carpet#Scheme - but it won't run in the DrRacket environment or WeScheme. Could someone provide solutions for either environments?
It looks like this code runs fine in DrRacket after prepending a
#lang racket
line indicating that the code is written in Racket. I can provide more detail if this is not sufficient.
I've translated the program to run under WeScheme. I've made a few changes: rather than use (display) and (newline), I use the image primitives that WeScheme provides to make a slightly nicer picture. You can view the running program and its source code. For convenience, I also include the source here:
;; Sierpenski carpet.
;; http://rosettacode.org/wiki/Sierpinski_carpet#Scheme
(define SQUARE (square 10 "solid" "red"))
(define SPACE (square 10 "solid" "white"))
(define (carpet n)
(local [(define (in-carpet? x y)
(cond ((or (zero? x) (zero? y))
#t)
((and (= 1 (remainder x 3)) (= 1 (remainder y 3)))
#f)
(else
(in-carpet? (quotient x 3) (quotient y 3)))))]
(letrec ([outer (lambda (i)
(cond
[(< i (expt 3 n))
(local ([define a-row
(letrec ([inner
(lambda (j)
(cond [(< j (expt 3 n))
(cons (if (in-carpet? i j)
SQUARE
SPACE)
(inner (add1 j)))]
[else
empty]))])
(inner 0))])
(cons (apply beside a-row)
(outer (add1 i))))]
[else
empty]))])
(apply above (outer 0)))))
(carpet 3)
Here is the modified code for WeScheme. WeScheme don't support do-loop syntax, so I use unfold from srfi-1 instead
(define (unfold p f g seed)
(if (p seed) '()
(cons (f seed)
(unfold p f g (g seed)))))
(define (1- n) (- n 1))
(define (carpet n)
(letrec ((in-carpet?
(lambda (x y)
(cond ((or (zero? x) (zero? y))
#t)
((and (= 1 (remainder x 3)) (= 1 (remainder y 3)))
#f)
(else
(in-carpet? (quotient x 3) (quotient y 3)))))))
(let ((result
(unfold negative?
(lambda (i)
(unfold negative?
(lambda (j) (in-carpet? i j))
1-
(1- (expt 3 n))))
1-
(1- (expt 3 n)))))
(for-each (lambda (line)
(begin
(for-each (lambda (char) (display (if char #\# #\space))) line)
(newline)))
result))))