On Lisp – chapter 3

19 12 2009

Chapter 3 is a small chapter, it really talks about the wrong way to do things in Common Lisp.

;; Clojure is not the best Lisp dialect to implement 
;; bad reverse. In fact its rather painful. While the 
;; bad reverse example is great for what you 
;; shouldn't do, i'd rather port the good ones.

;; page 30

(defn good-reverse [lst]
  (loop [lst lst acc '()]
    (if (empty? lst)
      (recur (rest lst) (conj acc (first lst))))))

;; Clojure does not support multiple return values, 
;; however it does support destructuring

;; page 32

(defn powers [x]
  [x (Math/pow x 2)])

(let [[base square] (powers 4)]
  (list base square))

On Lisp – chapter 2

18 11 2009

Here’s the 2nd chapter of On Lisp translated to Clojure. I’m still learning Clojure and if you have any suggestions I would love to hear them. I am also working on the other chapters and will post them up as and when I finish them

;;page 10

(defn dbl [x]
  (* x 2))

(dbl 1)


;; page 11

(= dbl (first (list dbl)))

;; There are 2 ways to create anonymous functions in Clojure,
;; the #(...) syntax creates a function with the %/%1 %2 %3 as
;; the args. "fn" also create anonymous functions but these
;; can be named as well as have nested anonymous functions.

#(* % 2)

(fn [x] (* x 2))

(fn dbl [x] (* x 2))

(dbl 3)

(#(* % 2) 3)

;; page 13

;; In clojure, which is a lisp-1, there is a single namespace for
;; variables and functions, there is also a single function resolve
;; which resolves a symbol

(resolve 'dbl)

(def x conj)

;; In this case, the result is true, since we're testing the same
;; object for equality

  (= x conj) 

;; In this case, the result is false, since 'x resolves to 
;; user/x while 'conj resolves to clojure.core/conj. They're
;; different objects

  (= (resolve 'x) (resolve 'conj))

(defn dbl [x]
  (* x 2))

;; Clojure only allows you to bind to a symbol using
;; def, defn and let

(def dbl #(* % 2))

;; (def (symbol "dbl") #(* % 2)) is not valid clojure,
;; does anyone know an alternative.

(eval `(def ~(symbol "dbl") ~#(* % 2)))

;; page 13

(+ 1 2)

(apply + '(1 2))

(apply (resolve '+) '(1 2))

(apply #(+ %1 %2) '(1 2))

(apply + 1 2 '(3 4))

;; Clojure is a Lisp-1 so no need for funcall

;; page 14

(map #(+ % 10) '(1 2 3))

(map + '(1 2 3) '(10 100 1000))

(sort < '(1 4 2 5 6 7 3))

(remove even? '(1 2 3 4 5 6 7))

;; page 15

(defn our-remove-if [f lst]
  (if (empty? lst)
    (if (f (first lst))
      (recur f (rest lst))
      (conj (our-remove-if f (rest lst)) (first lst)))))

;; Not a true implementation, but condp is just so cool

(defn behave [animal]
  (condp = animal
    'dog "bark"
    'rat "squeak"
    'cat "scratch-carpet"))

;; page 16

(let [y 7]
  (defn scope-test [x]
    (list x y)))

;; page 17

(let [y 5]
  (scope-test 3))

;; page 18

(defn list+ [lst n]
  (map #(+ % n) lst))

(list+ '(1 2 3) 10)

;; Since clojure is purely functional, the only way to cause mutable
;; changes is to use atoms, refs and agents. Here I use atoms.

(let [counter (atom 0)]
  (defn new-id []
    (swap! counter inc))
  (defn reset-id []
    (reset! counter 0)))

(defn make-adder [n]
  #(+ % n))

;; page 19

(def add2 (make-adder 2))

(def add10 (make-adder 10))

(add2 5)

(add10 3)

(defn make-adderb [n]
  (let [n (atom n)]
    (fn [x & change]
      (if (and (not (empty? change)) (first change))
	(reset! n x)
	(+ x @n)))))

(make-adderb 1)

(def addx (make-adderb 1))

(addx 3)

(addx 100 true)

(addx 3)

;; page 20

(defn make-dbms [db]
  (let [db (atom db)]
    {:lookup #(@db %)
     :insert (fn [k v] (swap! db #(assoc % k v)))
     :delete (fn [k] (swap! db #(dissoc % k)))}))

(def cities (make-dbms {:boston 'US :paris 'France}))

((cities :lookup) :boston)

((cities :insert) :london 'England)

((cities :lookup) :london)

(defn lookup [k db]
  ((db :lookup) k))

;; page 22

;; Clojure doesn't require labels, again because it's a Lisp-1

(let [incr #(inc %)]
  (incr 3))

;; In clojure let is let*, so y here will be 10,
;; however, let does not allow self referential
;; bindings

(let [x 10
      y x]

(defn count-instances [obj lsts]
  (let [instances-in (fn instances-in [lst]
		       (if (not (empty? lst))
			 (+ (if (= (first lst) obj) 1 0)
			    (instances-in (rest lst)))
    (map instances-in lsts)))

(count-instances 'a '((a b c) (d a r p a) (d a r) (a a)))

;; The JVM does not have support for Tail Call Optimization (yet),
;; use the recur keyword for self recursion and trampoline for
;; mutual recursion

(defn our-length [lst]
  (if (empty? lst)
    (inc (our-length (rest lst)))))

;; page 23

(defn our-find-if [f lst]
  (if (f (first lst))
    (first lst)
    (recur f (rest lst))))

(defn our-length [lst]
  (let [rec (fn [lst acc]
	      (if (empty? lst)
		(recur (rest lst) (inc acc))))]
    (rec lst 0)))

;; page 24

(defn triangle [n]
  (let [tri (fn [c n]
	      (if (zero? n)
		(recur (+ n c) (dec n))))]
    (tri 0 n)))

(triangle 6)

;; All clojure code, before it is run, is transformed into JVM bytecode, there
;; is also the option of Ahead Of Time (AOT) compilation

On Lisp

2 11 2009

Another project i’m working on is translating Paul Graham’s On Lisp (which is available for free) into Clojure, well some of it anyway.

It’s really fun and interesting to read a book by graham since his essays inspired me to learn Lisp in the first place. As with the project Euler sums, i’ll post more info as I discover it

Problem 9: Pythagorean Triplet

19 10 2009

Find the only Pythagorean triplet which sums to get 1000

A Pythagorean triplet consists of 3 numbers say x, y and z such that x < y < z and x^2 + y^2 = z^2.

The task is to find a triplet which satisfies the equation x + y + z = 1000

(defn sqr [x]
    (* x x))

(defn triplets [n]
    (loop [x 1 y 2 z (- n 3) acc '()]
  	    (>= x z) acc
	    (>= y z) (recur (inc x) (+ 2 x) (- n (+ 3 x x)) acc)
	    :else (recur x (inc y) (dec z) (cons (list x y z) acc)))))

triplets generates all possible triplets (x, y, z) where x + y + z = 1000 and x < y < z

After this all that needs to be done is

(apply * (first (filter #(let [[a b c] %]
				(= (+ (sqr a) (sqr b)) (sqr c)))
			    (triplets 1000)))

The let construct in this case has new syntax

(let [[a b c] '(1 2 3)]

This is known as destructuring, this syntax binds a, b and c to 1, 2 and 3 respectively.

Problem 8: 1000 digit number

18 10 2009

Find the largest product of 5 consecutive digits of a 1000 digit number

This can be solved very elegantly in Clojure, the 1000 digit number can be found here.

(def number-string "73167...")

(def digits (map #(- (int %) 48) number-string))

(apply max (map * digits (drop 1 digits) (drop 2 digits) (drop 3 digits) (drop 4 digits)))

number-string stores the 1000 digit number as a string

digits creates a list of digits from number-string, 48 is the ASCII value for the character ‘0’, 49 for ‘1’ and so on. Subtracting 48 from the character gives the digit value.

map runs only till one of the list arguments terminates so the last line is valid

Problem 7: Primes

17 10 2009

Find the 10001’st prime number

The prime numbers are intriguing, there is no pattern and no direct formula for the nth term in the series of primes. While an nth term formula would be enough for this problem, it would be far more useful to have an infinite, lazy list of primes like the fibonacci list in my earlier post.

The sieve of Eratosthenes is the one of the fastest way to find primes up to a given number. Implementing the essence of the sieve to get an infinite list was the goal.

Start of with an initial list of primes: ( 2 ) and a counter: n = 3
If none of the primes in the list divides n, add n to the list
increment n

Using this algorithm, we can implement an infinite list of primes easily but this turned out to be slow, far slower than I expected.

While searching for inspiration I came across this paper and one basic conclusion, my original implementation was not the sieve.

I tried implementing a large number of different algorithms including the sieve of Sundaram but none of them was fast enough. The sieve of Sundaram has an interesting method of finding primes. Instead of finding the primes themselves, it searches for the next odd composite.

This was the Eureka moment, I combined the concept of next odd composite with the Sieve of Eratosthenes and came up with this algorithm

Start with lc: last composite = 3, and a map of key value pairs {(9, 6)}
Remove the element from the list with the smallest key [(9, 6)]
store the key as nc: next composite and value as increment [nc = 9, increment = 6]
All odd numbers between lc and nc are prime
For each odd number, n, between lc and the  nc, insert (sqr(n), 2*n) into the map [(25, 10) (49, 14)]
lc = nc [lc = 9]
nc = nc + increment [nc = 15]
while nc exists as key in the map
    nc = nc + increment
insert (nc, increment) into the map [(15, 6)]
repeat from step 1 for next set of primes

Repeating the algorithm for 3 iterations

lc = 3                              map: {(9, 6)}
lc = 9          primes: 5, 7        map: {(15, 6), (25, 10), (49, 14)}
lc = 15         primes: 11, 13      map: {(21, 6), (25, 10), (49, 14), (121, 22), (169, 26)}

One thing which differentiates Clojure from other Lisps is the addition of powerful data structures as primitives. Clojure includes implementations for Vectors, Maps and Sets besides the usual List. [Clojure Data Structures]

Clojure also provides sorted versions of its Map and Set data type which make implementing a priority queue a breeze.

List           ()
Vector         []
Hash-Map       {}
Set           #{}

So here’s the implementation

(defn make-composite-cell [composite increment]
    [composite increment])

(defn get-composite [composite-cell]
    (first composite-cell))

(defn get-increment [composite-cell]
    (last composite-cell))

What I’ve done here is use a vector to abstract/hide away the implementation details for a new data type, composite-cell. Composite-cell is made up of 2 parts, a composite and an increment.

(defn insert-composite-cell [composite-cell composite-cell-queue]
    (let [composite (get-composite cell)
	  increment (get-increment cell)]
        (loop [new-composite composite]
		(contains? composite-cell-queue new-composite) (recur (+ new-composite increment))
		:else (assoc composite-cell-queue new-composite increment)))))

insert-composite-cell inserts a composite-cell into the priority queue, contains? checks to see if the key/priority already exists in the queue and assoc is used to add a new key-value pair to the queue.

(defn make-prime-system [last-composite composite-cell-queue]
    {:last-composite last-composite
      :composite-cell-queue composite-cell-queue})

(defn get-last-composite [prime-system]
    (:last-composite prime-system))

(defn get-composite-cell-queue [prime-system]
    (:composite-cell-queue prime-system))

Just like composite-cell, this uses the hash-table to implement a new data-type, prime-system. Prime system consists of the last-composite used and a list of composite-cells.

(def initial-prime-system 3 (sorted-map 9 6))

The initial prime system is the starting position for the algorithm

(defn get-primes [prime-system]
    (let [last-composite (get-last-composite prime-system)]
  	   next-composite (get-composite (first (get-composite-cell-queue prime-system)))]
        (range (+ last-composite 2) next-composite 2)))

get-primes returns a list of primes given by the given prime-system

(get-primes initial-prime-system)
=> (5 7)

And finally next-prime-system

(defn next-prime-system [prime-system]
    (let [primes (get-primes prime-system)
           queue (get-composite-cell-queue prime-system)
	   composite-cell (first queue)
	   composite (get-composite composite-cell)
	    increment (get-increment composite-cell)
	    queue (if (empty? primes)
			 (apply assoc (cons queue (concat (map #(list (* 2 %) (* % %)) primes)))))]
	(make-prime-system composite
		           (insert-composite-cell (make-composite-cell (+ composite increment)
		                                  (dissoc queue composite)))))

Most of the let bindings in this function are to reduce calculations or improve readability. The last binding on queue performs an additional operation. If no primes are generated for the prime-system, the same queue is returned, otherwise the primes are added to the queue.

assoc appends key value pairs to a hash-map

(assoc {:one 1} :two 2 :three 3)
=> {:one 1 :two 2 :three 3}

apply applies a function on a list just like reduce, except the list is taken at once.

(apply + '(1 2 3))
=> 6

Just like before, for the fibonacci numbers, we’ll create an infinite list of primes

(defn create-prime-list
	(lazy-cat '(2 3) (create-prime-list initial-prime-system)))
	(lazy-cat (get-primes prime-system) (create-prime-list (next-prime-system prime-system)))))

(def primes (create-prime-list))

The solution to the problem, the 10001’st prime number

(nth 10001 primes)

Problem 6: Sums of Squares of Sums

14 10 2009

Difference between sum of squares and square of sums

Find the difference between the sum of squares and the square of the sum of the integers 1 to 100

Using the functions map and reduce, this becomes trivial to implement

(defn sqr [x]
    (* x x))

(let [terms (range 1 101)]
    (- (reduce + (map sqr terms)) (sqr (reduce + terms))))

map takes a function and 1 or more lists and generates a new list of terms which are a result of the application of the function on each of the terms in the list/lists

(map + '(1 2 3) '(1 2 3))
=> (2 4 6)