Sunday, January 25, 2009

Clojure: Genetic Mona Lisa problem in 250 beautiful lines


Clojure is surrounded by hype these days. The word on the streets is that Clojure is the Next Big Thing. It has access to the largest library of code and it proposes a nice solution the to the concurrency problem. Lots more has been said...

But I haven't seen a lot of code.

So I set out to make a small but meaningful program in Clojure to get a sense of it's potential.

I give Clojure two thumbs up, and I think you'll do too.

The Mona Lisa Problem

The program I present tries to paint Mona Lisa with a small number of semi-transparent colored polygons. It does so by using Darwin's theory of evolution to evolve programs that draw Mona Lisa.

Here's the simplified algorithm:
1. Generate an initial population of programs
2. Take the n best programs of the current population
3. Create Children from the best programs by mating and mutating them
4. Replace the current population with the n-best and the children programs
5. Repeat from 2 until satisfied

See my more complete java version for details and don't miss Roger Alsing's seminal post.

Clojure is Lisp

Lisp code can be treated as data. That makes evolving programs painless. My Genetic Algorithm simply evolves lambdas. Running the evolved programs is a matter of calling 'eval.

The program is side-effects free(almost!). The majority of the program is functional. There are only two sources of side-effects:
1. Drawing on the canvas
2. Handling the GUI

Clojure is Java

It can be distributed and run anywhere. Clojure is compiled to Java bytecodes.

Clojure can use Java objects directly without wrappers. I was able to create a cross-platform GUI in a few lines with Swing.

Let me illustrate this by creating an object deriving from JPanel that overides the paint method to draw a green rectangle.


(def rec-panel (proxy [JPanel] []
(paint [graphics]
(doto graphics
(.setColor Color/green)
(.fillRect 0 0 10 10)))))

Parallelism

I painlessly parallelized my code because it is side-effects free. Clojure provides primitives that can parallelize functional code.

The bottleneck of the application is calculating the fitness of each individual of a population. In functional terms, it is expressed by mapping each individual to it's fitness using 'map with 'fitness function as it's first argument and the population as it's second argument.

Clojure provides the 'pmap function to make that mapping parallel. It divides the work between worker threads and it uses as many of them as you have CPU cores.

Thus, writing functionaly allowed me to parallelize my code by adding one 'p' character.

See clojure.parallel.

Performance

Performance wasn't a concern when I wrote the application. I tried to keep it simple. After all, that is the purpose of using a high-level language.

Surprisingly, the fitness function(the bottleneck) runs faster in Clojure than in Java. Unfortunately I don't have time to dig into this now.

Here's a graph comparing the run time the fitness function in Java and Clojure. The measure is the average of 25 samples of 100 runs of the fitness function in each language.



Here's the benchmark for reference.

A deal breaker

Lambdas are not garbage collected.

Yes. That means lambdas can be the cause of memory leaks.

As described by Charles Nutter, each lambda in Clojure is an anonymous class in Java. The problem is that classes are never garbage collected. They reside in a special place called the PermGen.

No need to say, my program quickly fills up the PermGen.

The only solution for now is to extend the PermGen.

java -XX:MaxPermSize=1024m -cp clojure.jar clojure.lang.Repl mona-clojure.clj

I don't think this is a problem for most applications though.

EDIT: As of r1232, lambdas created in eval can be GCed. Thanks to Christophe Grand for pointing it out.

The Mona Lisa Challenge

Let's see what your favorite language can do. The challenge is to write a small program that solves the Mona Lisa problem using Genetic Programming.

Show us some code!

Some of the languages I'd like to see are Haskell, Factor, Potion, Ioke, Erlang among lots of others.

Don't forget to leave a link in the comment section of this post.

The code

Here's the github repository.

Please read the source code with syntax highlighting on github.

The following is the full code listing for the impatient only.


(import
'(java.awt Graphics Graphics2D Color Polygon)
'(java.awt.image BufferedImage PixelGrabber)
'(java.io File)
'(javax.imageio ImageIO)
'(javax.swing JFrame JPanel JFileChooser))

; ---------------------------------------------------------------------
; This section defines the building blocks of the genetic programs.

; color :: Integer -> Integer -> Integer -> Integer -> Color
(defn color [red blue green alpha] {:type :Color :red red :blue blue :green green :alpha alpha})

; point :: Integer -> Integer -> Point
(defn point [x y] {:type :Point :x x :y y})

; polygon :: Color -> [Point] -> Polygon
(defn polygon [color points] {:type :Polygon :color color :points points})

; draw-polygon :: Graphics -> Polygon -> Nothing
(defn draw-polygon [graphics polygon]
(doto graphics
(.setColor (new Color (:red (:color polygon))
(:blue (:color polygon))
(:green (:color polygon))
(:alpha (:color polygon))))
(.fillPolygon (let [jpolygon (new Polygon)]
(doseq [p (:points polygon)] (. jpolygon (addPoint (:x p) (:y p))))
jpolygon)))
nil)

; ----------------------------------------------------------------------
; This sections defines helper functions.

; random-double :: Double
(defn random-double
"Returns a double between -1.0 and 1.0."
[]
(- (* 2 (rand)) 1))

; remove-item :: Sequence -> Integer -> Sequence
(defn remove-item
"Returns a sequence without the n-th item of s."
[s n]
(cond
(vector? s) (into (subvec s 0 n)
(subvec s (min (+ n 1) (count s)) (count s)))
(list? s) (concat (take n s)
(drop (inc n) s))))

; replace-item :: [a] -> Integer -> a -> [a]
(defn replace-item
"Returns a list with the n-th item of l replaced by v."
[l n v]
(concat (take n l) (list v) (drop (inc n) l)))

; grab-pixels :: BufferedImage -> [Integer]
(defn grab-pixels
"Returns an array containing the pixel values of image."
[image]
(let [w (. image (getWidth))
h (. image (getHeight))
pixels (make-array (. Integer TYPE) (* w h))]
(doto (new PixelGrabber image 0 0 w h pixels 0 w)
(.grabPixels))
pixels))

; ----------------------------------------------------------------------
; This sections define the primitives of the genetic algorithm.

; program :: S-Expression -> Maybe Integer -> Maybe BufferedImage -> Program
(defn program [code fitness image] {:type :Program :code code :fitness fitness :image image})

; initial-program :: Program
(def initial-program (program '(fn [graphics]) nil nil))

; program-header :: Program -> S-Expression
(defn program-header [p] (take 2 (:code p)))

; program-expressions :: Program -> S-Expression
(defn program-expressions [p] (drop (count (program-header p)) (:code p)))

; mutate :: a -> Map -> a
(defmulti mutate :type)

; mutate :: Color -> Map -> Color
(defmethod mutate :Color [c settings]
(let [dr (int (* (:red c) (random-double)))
dg (int (* (:green c) (random-double)))
db (int (* (:blue c) (random-double)))
da (int (* (:alpha c) (random-double)))]
(assoc c :red (max (min (- (:red c) dr) 255) 0)
:green (max (min (- (:green c) dg) 255) 0)
:blue (max (min (- (:blue c) db) 255) 0)
:alpha (max (min (- (:alpha c) da) 255) 0))))

; mutate :: Point -> Map -> Point
(defmethod mutate :Point [p settings]
(let [dx (int (* (:x p) (random-double)))
dy (int (* (:y p) (random-double)))]
(assoc p :x (max (min (- (:x p) dx) (:image-width settings)) 0)
:y (max (min (- (:y p) dy) (:image-height settings)) 0))))

; mutate :: Polygon -> Map -> Polygon
(defmethod mutate :Polygon [p settings]
; mutate-point :: Polygon -> Map -> Polygon
(defn mutate-point [p settings]
(let [n (rand-int (count (:points p)))]
(update-in p [:points n] (fn [point] (mutate point settings)))))

; mutate-color :: Polygon -> Map -> Polygon
(defn mutate-color [p settings] (assoc p :color (mutate (:color p) settings)))

(let [roulette (rand-int 2)]
(cond
(= 0 roulette) (mutate-point p settings)
(= 1 roulette) (mutate-color p settings))))

; mutate :: Program -> Map -> Program
(defmethod mutate :Program [p settings]
; add-polygon :: Program -> Map -> Program
(defn add-polygon [p settings]
(assoc p :code
(concat (:code p)
[(list 'draw-polygon
(first (nth (:code initial-program) 1))
(polygon
(color (rand-int 255) (rand-int 255) (rand-int 255) (rand-int 255))
(vec (map
(fn [n]
(point
(rand-int (:image-width settings))
(rand-int (:image-height settings))))
(range 5)))))])
:fitness nil :image nil))

; remove-polygon :: Program -> Map -> Program
(defn remove-polygon [p settings]
(let [n (rand-int (count (program-expressions p)))]
(assoc p :code (concat (program-header p)
(remove-item (program-expressions p) n))
:fitness nil :image nil)))

; mutate-polygon :: Program -> Map -> Program
(defn mutate-polygon [p settings]
(let [expressions (program-expressions p)
n (rand-int (count expressions))
target (nth expressions n)]
(assoc p :code
(concat (program-header p)
(replace-item expressions
n
(list (nth target 0)
(nth target 1)
(mutate (nth target 2) settings))))
:fitness nil :image nil)))

(let [polygon-count (count (program-expressions p))
roulette (cond
(empty? (program-expressions p)) 4
(>= polygon-count (:max-polygons settings)) (rand-int 4)
:else (rand-int 5))]
(cond
(> 3 roulette) (mutate-polygon p settings)
(= 3 roulette) (remove-polygon p settings)
(= 4 roulette) (add-polygon p settings))))

; fitness :: Program -> Map -> Program
(defn fitness [individual settings]
(if (:fitness individual)
individual
(let [gen-image (new BufferedImage (:image-width settings)
(:image-height settings)
BufferedImage/TYPE_INT_ARGB)
src-pixels (:source-pixels settings)]
(apply (eval (:code individual)) [(. gen-image (createGraphics))])
(def gen-pixels (grab-pixels gen-image))
(loop [i (int 0)
lms (int 0)]
(if (< i (alength gen-pixels))
(let [src-color (new Color (aget src-pixels i))
gen-color (new Color (aget gen-pixels i))
dr (- (. src-color (getRed)) (. gen-color (getRed)))
dg (- (. src-color (getGreen)) (. gen-color (getGreen)))
db (- (. src-color (getBlue)) (. gen-color (getBlue)))]
(recur (unchecked-inc i) (int (+ lms (* dr dr) (* dg dg) (* db db )))))
(assoc individual :fitness lms :image gen-image))))))

; select :: [Program] -> Map -> [Program]
(defn select [individuals settings]
(take (:select-rate settings)
(sort-by :fitness
(pmap (fn [i] (fitness i settings))
individuals))))

; evolve :: Map -> Nothing
(defn evolve [settings]
(loop [i 0
population (list initial-program)]
(let [fittest (select population settings)
newborns (map (fn [i] (mutate i settings)) fittest)]
((:new-generation-callback settings (fn [a b])) i fittest)
(when-not (= (first population) (first fittest))
((:new-fittest-callback settings (fn [a b])) i fittest))
(recur (inc i) (concat fittest newborns)))))

; ----------------------------------------------------------------------
; This sections defines the graphical interface.

; main :: Nothing
(defn main []
(def file-chooser (new JFileChooser))
(doto file-chooser
(.setCurrentDirectory (new File "."))
(.showOpenDialog nil))

(let [jframe (new JFrame "Fittest Program")
fittest (atom (list initial-program))
image (ImageIO/read (. file-chooser (getSelectedFile)))
settings {:image-width (. image (getWidth))
:image-height (. image (getHeight))
:source-pixels (grab-pixels image)
:select-rate 1 :max-polygons 50
:new-fittest-callback (fn [i f]
(swap! fittest (fn [o n] n) f)
(. jframe (repaint)))}]
(doto jframe
(.setSize (. image (getWidth)) (. image (getHeight)))
(.add (proxy [JPanel] []
(paint [g]
(doto g
(.setColor Color/white)
(.fillRect 0 0 (. image (getWidth)) (. image (getHeight)))
(.drawImage (:image (first @fittest)) nil 0 0)))))
(.setVisible true))
(evolve settings)))

(main)

32 comments:

Christophe Grand said...

As of r1232, lambdas created in eval can be GCed.

Harold Fowler said...

Fascinating stuff! I think you might just be onto something!

RT
www.total-privacy.us.tc

The Great Hive said...

Maybe you should credit the guy who did his last month in Javascript, since you clearly took your lead from him.

Daniel said...

Interesting code, but there should be more information.

www.reviewstash.com

For the latest in tech news!

Yann N. Dauphin said...

@Daniel. Thanks. What else would you like to know?

@The Great Hive. I did see his version. Anyway, I plan to link to him in a follow-up post commenting on all known implentations of this problem.

Emeka said...

Great job son!

Lauri said...

I think you're missing the second argument to max for :blue and :alpha in (mutate).

Also, if any of the colours or coordinates hit 0, they'll be stuck there, because the mutation is based on multiplication. Maybe this does not matter, i.e. those individuals will be eventually culled from the population?

-- Lauri

Yann N. Dauphin said...

@Lauri. Thanks, I corrected the mistakes.

I'm still unsure about what to do about the colors/coordinates hitting 0. I'll perform some tests to find out.

Yann.

Xetas said...

I wonder is there less ugly way to express following line:

(assoc p :points (assoc (:points p) n (mutate (get (:points p) n) settings)))

which actually means:

mutate(p.points[n], settings)

Xetas said...

Found answer to my own question:

(update-in p [:points n] #(mutate %1 settings))

Yann N. Dauphin said...

@Xetas. Great find. I'll update my code when I get home.

e7ektro said...

Hello Yann,

I liked your solution with clojure, I think clojure is definitely cool and worth learning.

I wrote a Haskell application for the Mona Lisa problem. It is a bit longer than 250 lines (and probably not as beautiful). I kept close to the original implementation (C#). There are two different branches, one of them uses Data Parallel Haskell for the fitness-/error- function. This is a vectorisation approach (about 27 percent speedup).

More details about it in my blog:
http://e7ektro.wordpress.com/2009/01/31/hevolisa/

Download Cabal package from Hackage:
http://hackage.haskell.org/cgi-bin/hackage-scripts/package/hevolisa-0.0
http://hackage.haskell.org/cgi-bin/hackage-scripts/package/hevolisa-dph-0.0

Git repository on github:
http://github.com/dneun/hevolisa/tree/master

The implementation is based on Gtk2Hs.

Yann N. Dauphin said...

@e7ektro

I was eager to see a solution with Haskell. Yours is great.

It gives a clear sense of what Haskell is. I like that everything is a combination of functions. Like the implementation of the error function:

error :: [Integer] -> [Integer] -> Integer
error c1 c2 = sum $ zipWith (\x y -> (x - y)^2) c1 c2

Short and Sweet.

Yann.

Andrew said...

I'm playing around with your code and saw that you said the evals can be GCed now, but I'm still seeing a huge memory footprint. Is there new code that needs to be added to do the GC? I'm new to Clojure, so maybe I'm missing something.

Yann N. Dauphin said...

@Andrew

The fix for the GC problem hasn't been officially released yet. That's probably why you don't see any difference.

You can get the fix from the lastest SVN revision:
svn checkout http://clojure.googlecode.com/svn/trunk/ clojure-read-only

Andrew said...

Ah, thanks. :)

daniel john said...

I like that everything is a combination of functions. Thanks for sharing.
Term Paper

Lanthanum said...

nice post thanks for sharing...

looking for your next post.
hamza@samruz.com
http://www.jobspert.com

Maurits said...

Any idea why this is so much slower when using Clojure 1.2?

Term Papers said...

Term Papers
Amazingly done with the text. Thank you for sharing the text.

Term Papers said...

That is a magnificent stuff, the codes are really useful and helpful. Thank you for the post.


College term papers

Kyle Grando said...

Nice! I have visited this site. it give me information about work and study. i like to know more about this site. This site is very helpful for work and study. Thanks for sharing the blog.

Denver Pavilions

Felix Smith said...

It's really nice information provided by you. Thanks for sharing this with us. Cheap Essay Writing

Tom Brian said...

I love it your ideas are great. Nice one good job..
Airport Taxi

sara jay said...

Impressive work I like your post you have shared.
geoessay

david paul said...

Your work is really being appreciated. Great piece of work.
Custom Essays

jacqueline fernandez said...

Good to see this blog really informative.
SEO Company

Tina brian said...

Awesome post this one realy helped me at my point of confusion :) Realy thanx alot for sharing :) Keep it up ;)
Billy Bishop Airport
YTZ Airport
Taxi to Billy Bishop Airport

sophia martin said...

Such a nice way to discuss the blog! fantastic work.
Cheap Essay

Tina brian said...

Thanx for sharing such useful post keep it up :)
Cereb

Tina brian said...

Awesome post thanx for sharing this one realy helped me :)
Labaik Tours
Umrah Packages
Hajj Packages

sextoy terbaru said...

kami penyededia informasi alat bantu sex.
sekaligus jual alat sex wanita.
alat bantu sex pria.
semua alat seks ada pada kami.
sex toys terbaru.