Here is an example from Clojure Programming Paperback by Chas Emerick:
(import 'java.awt.image.BufferedImage
'(java.awt Color RenderingHints))
(defn- escape
[^double a0 ^double b0 ^long depth]
(loop [a a0, b b0, iteration 0]
(cond
(< 4 (+ (* a a) (* b b))) iteration
(>= iteration depth) -1
:else (recur (+ a0 (- (* a a) (* b b)))
(+ b0 (apply * [2 a b]))
(inc iteration)))))
(defn mandelbrot [rmin rmax imin imax
& {:keys [width height depth]
:or {width 80 height 40 depth 1000}}]
(let [mandelbrot-help
(fn [^double rmin ^double rmax
^double imin ^double imax
]
(let [stride-w (/ (- rmax rmin) width)
stride-h (/ (- imax imin) height)]
(loop [x 0
y (dec height)
escapes []]
(if (== x width)
(if (zero? y)
(partition width escapes)
(recur 0 (dec y) escapes))
(recur (inc x) y (conj escapes
(escape (+ rmin (* x stride-w))
(+ imin (* y stride-h))
depth)))))))]
(mandelbrot-help rmin rmax imin imax)))
(defn render-text
[mandelbrot-grid]
(doseq [row mandelbrot-grid]
(doseq [escape-iter row]
(print (if (neg? escape-iter)
\*
\space)))
(println)))
(defn render-image
[mandelbrot-grid]
(let [palette
(vec (for
[c (range 500)]
(Color/getHSBColor 0.0 0.0 (/ (Math/log c) (Math/log 500)))))
height (count mandelbrot-grid)
width (count (first mandelbrot-grid))
img (BufferedImage. width height BufferedImage/TYPE_INT_RGB)
^java.awt.Graphics2D g (.getGraphics img)]
(doseq [[y row] (map-indexed vector mandelbrot-grid)
[x escape-iter] (map-indexed vector row)]
(.setColor g (if (neg? escape-iter)
(palette 0)
(palette (mod (dec (count palette)) (inc escape-iter)))))
(.drawRect g x y 1 1))
(.dispose g)
img))
(do (time (mandelbrot -2.25 0.75 -1.5 1.5
:width 1600 :height 1200 :depth 1000))
nil)
Everything works except that it takes 60s on my machine, and only 8s according to the book (results on my laptop are consistently better in other examples).
Is there something that I did wrong?
Where did you get that code from? It is definitely not what appears either in the book (based on my PDF copy of it, page 449-452), or the code sample on github. In particular, the (apply * [2 a b]) in escape is crazy; that'll never be fast (at least not without any degree of [trivial] source-level optimization, which Clojure unfortunately doesn't apply). Even weirder, that particular snippet doesn't appear anywhere in the book, nor can I find it in the history of the git repo we used to collaborate on the writing of the book.
Maybe you were just tinkering with the examples? If not, I really would like to know where the sample you have came from, as it's absolutely not representative of our intent or best practice (obviously, given the timings you're seeing).
Anyway, here's the "fast escape" function from the book / github samples repo:
(defn- escape
[^double a0 ^double b0 depth]
(loop [a a0
b b0
iteration 0]
(cond
(< 4 (+ (* a a) (* b b))) iteration
(>= iteration depth) -1
:else (recur (+ a0 (- (* a a) (* b b)))
(+ b0 (* 2 (* a b)))
(inc iteration)))))
user> (do (time (mandelbrot -2.25 0.75 -1.5 1.5
:width 1600 :height 1200 :depth 1000))
nil)
"Elapsed time: 1987.460104 msecs"
Hinting the depth arg as ^long (something that I should have included in the book example) drops that to 1450ms on my laptop.
Related
I'm trying to write a code for extended Euclidian Algorithm in Scheme for an RSA implementation.
The thing about my problem is I can't write a recursive algorithm where the output of the inner step must be the input of the consecutive outer step. I want it to give the result of the most-outer step but as it can be seen, it gives the result of the most inner one. I wrote a program for this (it is a bit messy but I couldn't find time to edit.):
(define ax+by=1
(lambda (a b)
(define q (quotient a b))
(define r (remainder a b))
(define make-list (lambda (x y)
(list x y)))
(define solution-helper-x-prime (lambda (a b q r)
(if (= r 1) (- 0 q) (solution-helper-x-prime b r (quotient b r) (remainder b r)))
))
(define solution-helper-y-prime (lambda (a b q r)
(if (= r 1) (- r (* q (- 0 q) )) (solution-helper-y-prime b r (quotient b r) (remainder b r))
))
(define solution-first-step (lambda (a b q r)
(if (= r 1) (make-list r (- 0 q))
(make-list (solution-helper-x-prime b r (quotient b r) (remainder b r)) (solution-helper-y-prime b r (quotient b r) (remainder b r))))
))
(display (solution-first-step a b q r))
))
All kinds of help and advice would be greatly appreciated. (P.S. I added a scrrenshot of the instructions that was given to us but I can't see the image. If there is a problem, please let me know.)
This is a Diophantine equation and is a bit tricky to solve. I came up with an iterative solution adapted from this explanation, but had to split the problem in parts - first, obtain the list of quotients by applying the extended Euclidean algorithm:
(define (quotients a b)
(let loop ([a a] [b b] [lst '()])
(if (<= b 1)
lst
(loop b (remainder a b) (cons (quotient a b) lst)))))
Second, go back and solve the equation:
(define (solve x y lst)
(if (null? lst)
(list x y)
(solve y (+ x (* (car lst) y)) (cdr lst))))
Finally, put it all together and determine the correct signs of the solution:
(define (ax+by=1 a b)
(let* ([ans (solve 0 1 (quotients a b))]
[x (car ans)]
[y (cadr ans)])
(cond ((and (= a 0) (= b 1))
(list 0 1))
((and (= a 1) (= b 0))
(list 1 0))
((= (+ (* a (- x)) (* b y)) 1)
(list (- x) y))
((= (+ (* a x) (* b (- y))) 1)
(list x (- y)))
(else (error "Equation has no solution")))))
For example:
(ax+by=1 1027 712)
=> '(-165 238)
(ax+by=1 91 72)
=> '(19 -24)
(ax+by=1 13 13)
=> Equation has no solution
I'm trying to edit the current program I have
(define (sumofnumber n)
(if (= n 0)
1
(+ n (sumofnumber (modulo n 2 )))))
so that it returns the sum of an n number of positive squares. For example if you inputted in 3 the program would do 1+4+9 to get 14. I have tried using modulo and other methods but it always goes into an infinite loop.
The base case is incorrect (the square of zero is zero), and so is the recursive step (why are you taking the modulo?) and the actual operation (where are you squaring the value?). This is how the procedure should look like:
(define (sum-of-squares n)
(if (= n 0)
0
(+ (* n n)
(sum-of-squares (- n 1)))))
A definition using composition rather than recursion. Read the comments from bottom to top for the procedural logic:
(define (sum-of-squares n)
(foldl + ; sum the list
0
(map (lambda(x)(* x x)) ; square each number in list
(map (lambda(x)(+ x 1)) ; correct for range yielding 0...(n - 1)
(range n))))) ; get a list of numbers bounded by n
I provide this because you are well on your way to understanding the idiom of recursion. Composition is another of Racket's idioms worth exploring and often covered after recursion in educational contexts.
Sometimes I find composition easier to apply to a problem than recursion. Other times, I don't.
You're not squaring anything, so there's no reason to expect that to be a sum of squares.
Write down how you got 1 + 4 + 9 with n = 3 (^ is exponentiation):
1^2 + 2^2 + 3^2
This is
(sum-of-squares 2) + 3^2
or
(sum-of-squares (- 3 1)) + 3^2
that is,
(sum-of-squares (- n 1)) + n^2
Notice that modulo does not occur anywhere, nor do you add n to anything.
(And the square of 0 is 0 , not 1.)
You can break the problem into small chunks.
1. Create a list of numbers from 1 to n
2. Map a square function over list to square each number
3. Apply + to add all the numbers in squared list
(define (sum-of-number n)
(apply + (map (lambda (x) (* x x)) (sequence->list (in-range 1 (+ n 1))))))
> (sum-of-number 3)
14
This is the perfect opportunity for using the transducers technique.
Calculating the sum of a list is a fold. Map and filter are folds, too. Composing several folds together in a nested fashion, as in (sum...(filter...(map...sqr...))), leads to multiple (here, three) list traversals.
But when the nested folds are fused, their reducing functions combine in a nested fashion, giving us a one-traversal fold instead, with the one combined reducer function:
(define (((mapping f) kons) x acc) (kons (f x) acc)) ; the "mapping" transducer
(define (((filtering p) kons) x acc) (if (p x) (kons x acc) acc)) ; the "filtering" one
(define (sum-of-positive-squares n)
(foldl ((compose (mapping sqr) ; ((mapping sqr)
(filtering (lambda (x) (> x 0)))) ; ((filtering {> _ 0})
+) 0 (range (+ 1 n)))) ; +))
; > (sum-of-positive-squares 3)
; 14
Of course ((compose f g) x) is the same as (f (g x)). The combined / "composed" (pun intended) reducer function is created just by substituting the arguments into the definitions, as
((mapping sqr) ((filtering {> _ 0}) +))
=
( (lambda (kons)
(lambda (x acc) (kons (sqr x) acc)))
((filtering {> _ 0}) +))
=
(lambda (x acc)
( ((filtering {> _ 0}) +)
(sqr x) acc))
=
(lambda (x acc)
( ( (lambda (kons)
(lambda (x acc) (if ({> _ 0} x) (kons x acc) acc)))
+)
(sqr x) acc))
=
(lambda (x acc)
( (lambda (x acc) (if (> x 0) (+ x acc) acc))
(sqr x) acc))
=
(lambda (x acc)
(let ([x (sqr x)] [acc acc])
(if (> x 0) (+ x acc) acc)))
which looks almost as something a programmer would write. As an exercise,
((filtering {> _ 0}) ((mapping sqr) +))
=
( (lambda (kons)
(lambda (x acc) (if ({> _ 0} x) (kons x acc) acc)))
((mapping sqr) +))
=
(lambda (x acc)
(if (> x 0) (((mapping sqr) +) x acc) acc))
=
(lambda (x acc)
(if (> x 0) (+ (sqr x) acc) acc))
So instead of writing the fused reducer function definitions ourselves, which as every human activity is error-prone, we can compose these reducer functions from more atomic "transformations" nay transducers.
Works in DrRacket.
How can I implement the Extended Euclidean algorithm? Here's my first attempt:
(define ex-gcd a b
; gcd(a,b) = a * x+ b * y
; gcd(a,b)-> always will be 1
output: (x.y)
)
The algorithm is right here in Wikipedia, you just have to adapt it to only return Bézout coefficients, the car part of the returned cons-cell will be x, and the cdr will be y:
(define (extended-gcd a b)
(let loop ([s 0] [t 1] [r b]
[old-s 1] [old-t 0] [old-r a])
(if (zero? r)
(cons old-s old-t)
(let ((q (quotient old-r r)))
(loop (- old-s (* q s))
(- old-t (* q t))
(- old-r (* q r))
s t r)))))
It's easy to test it using Bézout's identity, use different values for a and b and verify that it works as advertised:
(define (test a b)
(let* ((ans (extended-gcd a b))
(x (car ans))
(y (cdr ans)))
(= (gcd a b) (+ (* a x) (* b y)))))
(test 384 256)
=> #t
Notice that the algorithm calculated other values, by changing what you return you can also obtain the following:
Bézout coefficients: old_s, old_t
Greatest common divisor: old_r
Quotients by the gcd: t, s
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
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)))))