Implementation of Simpson's Rule (SICP Exercise 1.29) - algorithm

Following is my code for SICP exercise 1.29. The exercise asks us to implement
Simpson's Rule using higher order procedure sum. It's supposed to be more
accurate than the original integral procedure. But I don't know why it's not
the case in my code:
(define (simpson-integral f a b n)
(define h (/ (- b a) n))
(define (next x) (+ x (* 2 h)))
(* (/ h 3) (+ (f a)
(* 4 (sum f (+ a h) next (- b h)))
(* 2 (sum f (+ a (* 2 h)) next (- b (* 2 h))))
(f b))))
Some explanations of my code: As
h/3 * (y_{0} + 4*y_{1} + 2*y_{2} + 4*y_{3} + 2*y_{4} + ... + 2*y_{n-2} + 4*y_{n-1} + y_{n})
equals
h/3 * (y_{0}
+ 4 * (y_{1} + y_{3} + ... + y_{n-1})
+ 2 * (y_{2} + y_{4} + ... + y_{n-2})
+ y_{n})
I just use sum to compute y_{1} + y_{3} + ... + y_{n-1} and y_{2} +
y_{4} + ... + y_{n-2}.
Complete code here:
#lang racket
(define (cube x) (* x x x))
(define (sum term a next b)
(if (> a b)
0
(+ (term a)
(sum term (next a) next b))))
(define (integral f a b dx)
(define (add-dx x) (+ x dx))
(* (sum f (+ a (/ dx 2.0)) add-dx b)
dx))
(define (simpson-integral f a b n)
(define h (/ (- b a) n))
(define (next x) (+ x (* 2 h)))
(* (/ h 3) (+ (f a)
(* 4 (sum f (+ a h) next (- b h)))
(* 2 (sum f (+ a (* 2 h)) next (- b (* 2 h))))
(f b))))
Some tests(The exact value should be 0.25):
> (integral cube 0 1 0.01)
0.24998750000000042
> (integral cube 0 1 0.001)
0.249999875000001
> (simpson-integral cube 0 1.0 100)
0.23078806666666699
> (simpson-integral cube 0 1.0 1000)
0.24800798800666748
> (simpson-integral cube 0 1.0 10000)
0.2499999999999509

In your solution the x-values are computed as follows:
h = (b-a)/n
x1 = a+1
x3 = x1 +2*h
x5 = x3 +2*h
...
This means rounding errors slowly accumulate.
It happens when (b-a)/n is not representable as floating point.
If we instead compute xi as a+ (i*(b-a))/n you will get more accurate results.
This variant of your solution uses the above method to compute the xi.
(define (simpson-integral3 f a b n)
(define h (/ (- b a) n))
(define (next i) (+ i 2))
(define (f* i) (f (+ a (/ (* i (- b a)) n))))
(* (/ h 3)
(+ (f a)
(* 4 (sum f* 1 next n))
(* 2 (sum f* 2 next (- n 1)))
(f b))))

There's a problem in how you're constructing the terms, the way you're alternating between even terms (multiplied by 2) and odd terms (multiplied by 4) is not correct. I solved this problem by passing an additional parameter to sum to keep track of the current term's even-or-odd nature, there are other ways but this worked for me, and the accuracy got improved:
(define (sum term a next b i)
(if (> a b)
0
(+ (term a i)
(sum term (next a) next b (+ i 1)))))
(define (simpson-integral f a b n)
(let* ((h (/ (- b a) n))
(term (lambda (x i)
(if (even? i)
(* 2.0 (f x))
(* 4.0 (f x)))))
(next (lambda (x) (+ x h))))
(* (+ (f a)
(sum term a next b 1)
(f b))
(/ h 3.0))))
(simpson-integral cube 0 1 1000)
=> 0.2510004999999994

Related

Printing decimal numbers get rounded up in chicken-scheme

I have a scheme procedure that returns 0.24999999999999992 as a result. However, when I tried to print this result with chicken-scheme on my machine, it gets rounded to 0.25. How can I prevent rounding?
I tried running the same procedure on repl.it, and the print command here outputs the result without rounding.
If it helps, the code below:
(define (sum term a next b)
(if
(> a b)
0
(+ (term a) (sum term (next a) next b))
)
)
(define (integral-simpson f a b n)
(define h (/ (- b a) n))
(define (inc x) (+ x 1))
(define (term x)
(cond
((or (= x 0) (= x n)) (f (+ a (* x h))))
((even? x) (* 2 (f (+ a (* x h)))))
((odd? x) (* 4 (f (+ a (* x h)))))
)
)
(* (/ h 3)
(sum
term
a
inc
n
)
)
)
(define (cube x)
(* x x x)
)
(print (integral-simpson cube 0 1 100))
Try changing the print precision: (flonum-print-precision 17)

Riemann integral formula to compute high-order function

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!

IDCT (inverse discrete cosine transformation) for Scheme impl. of jpeg decoder

Could someone explain me the inverse discrete cosine transform function and probably give me an implementation of it in Scheme/Racket which operates on 8x8 blocks? If you don't know scheme maybe you could help me out with some pseudo code.
The mathematical definition of Forward DCT (FDCT) and Inverse DCT (IDCT) is :
FDCT:
c(u,v) 7 7 2*x+1 2*y+1
F(u,v) = --------- * sum sum f(x,y) * cos (------- *u*PI)* cos (------ *v*PI)
4 x=0 y=0 16 16
u,v = 0,1,...,7
{ 1/2 when u=v=0
c(u,v) = {
{ 1 otherwise
IDCT:
1 7 7 2*x+1 2*y+1
f(x,y) = --- * sum sum c(u,v)*F(u,v)*cos (------- *u*PI)* cos (------ *v*PI)
4 u=0 v=0 16 16
x,y=0,1...7
This is just based on your definition of the dct above; I couldn't find any good example values for that formula, so this can't be considered tested.
(define pi 3.14) ; set this to however accurate you want
(define c
(lambda (u v)
(if (and (= u 0)
(= v 0))
1/2
1)))
(define fdct
(lambda (f u v)
(* (/ (c u v)
4)
(let x-loop ((x 0)
(x-sum 0))
(if (< x 7)
(x-loop (+ x 1)
(+ x-sum
(let y-loop ((y 0)
(y-sum 0))
(if (< y 7)
(y-loop (+ y 1)
(+ y-sum (* (f x y)
(cos (* (/ (+ (* 2 x)
1)
16)
u
pi))
(cos (* (/ (+ (* 2 y)
1)
16)
v
pi)))))
y-sum))))
x-sum)))))
(define idct
(lambda (f x y)
(* 1/4
(let u-loop ((u 0)
(u-sum 0))
(if (< u 7)
(u-loop (+ u 1)
(+ u-sum
(let v-loop ((v 0)
(v-sum 0))
(if (< v 7)
(v-loop (+ v 1)
(+ v-sum
(* (c u v)
(f u v)
(cos (* (/ (+ (* 2 x)
1)
16)
u
pi))
(cos (* (/ (+ (* 2 x)
1)
16)
u
pi)))))
v-sum))))
u-sum)))))

Why the bleep isn't my continued fraction approximating properly?

Reading through more SICP and I'm stuck on exercise 1.3.8. My code works properly for approximating 1/phi, but doesn't work for approximating e - 2.
(define (cont-frac n d k)
(define (frac n d k)
(if (= k 0)
1.0
(+ (d k) (/ (n (+ k 1)) (frac n d (- k 1))))))
(/ (n 1) (frac n d k)))
(define (eulers-e-2)
(cont-frac (lambda (i) 1.0)
(lambda (i)
(if (= (remainder (+ i 1) 3) 0)
(* 2.0 (/ (+ i 1) 3))
1.0))
100))
(define (1-over-phi)
(cont-frac (lambda (i) 1.0)
(lambda (i) 1.0)
100))
Instead of getting .7 blah blah blah for e-2, I'm getting .5 blah blah something. I can't figure out why. I'm pretty sure I have "d" defined properly in the "eulers-e-2" function.
Edit:
Thanks guys, I was calculating it backwards. Here's the fixed code.
(define (cont-frac n d k)
(define (frac n d i)
(if (= k i)
(d i)
(+ (d i) (/ (n (+ i 1)) (frac n d (+ i 1))))))
(/ (n 1) (frac n d 1)))
You seem to be calculating the following:
N1/(D100 + (N101/ D99 + N100/(D98 + N99/(..))))
Instead of
N1/(D1 + N2/(D2 + ...))
Since N and D are the same (all 1s) for 1/phi, you get the right answer there.

Calculate Sums with accumulate

procedure accumulate is defined like this:
(define (accumulate combiner null-value term a next b)
(if (> a b) null-value
(combiner (term a)
(accumulate combiner null-value term (next a) next b))))
problem 1: x^n
;Solution: recursive without accumulate
(define (expon x n)
(if (> n 0) (* x
(expon x (- n 1))
)
1))
problem 2: x + x^2 + x^4 + x^6 + ...+ ,calculate for given n the first n elements of the sequence.
problem 3: 1 + x/1! + x^2/2! + ... + x^n/n!; calculate the sum for given x,n
possibly incorrect solution:
(define (exp1 x n)
(define (term i)
(define (term1 k) (/ x k))
(accumulate * 1 term1 1 1+ i))
(accumulate + 0 term 1 1+ n))
why the previous code is incorrect:
(exp1 0 3) -> 0 ; It should be 1
(exp1 1 1) -> 1 ; It should be 2
First off, I would say that your EXP1 procedure is operating at too low a level in being defined in terms of ACCUMULATE, and for the sake of perspicacity rewrite it instead in terms of sums and factorials:
(define (sum term a b)
(accumulate + 0 term a 1+ b))
(define (product term a b)
(accumulate * 1 term a 1+ b))
(define (identity x) x)
(define (fact n)
(if (= n 0)
1
(product identity 1 n)))
(define (exp1 x n)
(define (term i)
(/ (expon x i) (fact i)))
(sum term 1 n))
Now to your question: the reason you are getting (EXP1 0 3) → 0 is no more than that you forgot to add the 1 at the start of the series, and are just computing x/1! + x^2/2! + ... + x^n/n!
Changing EXP1 to include the missing term works as expected:
(define (exp1 x n)
(define (term i)
(/ (expon x i) (fact i)))
(+ 1 (sum term 1 n)))
=> (exp1 0 3)
1
=> (exp1 1 1)
2

Resources