Learning from FP: Simulated Annealing in Haskell and Ruby

Haskell is a functional programming language that cleanly separates pure algorithms from messy real-world concerns. To learn how it ticks, I've translated an algorithm for Simulated Annealing from Haskell to Ruby. It also gave me an excuse to play with ruby-processing, a toolkit for graphics processing ;). Come learn about Functional Programming and how it can make your Ruby better!

Josh organizes the DC Polyglot Programming Meetup, The Ruby Hangout, DCRUG, and is the CTO at Optoro, a DC-based startup in the reverse logistics industry. Josh has used lots of languages and thinks you should too!

Video available at: http://confreaks.tv/videos/rubyconf2014-learning-from-fp-simulated-annealing-in-haskell-and-ruby

Transcript

1. Learning from Functional Programming Simulated Annealing in Ruby and Haskell
2. Procedural vs Functional Images: http://blogs.lib.unc.edu/ncm/index.php/2012/12/11/recipes-for-every-kind-of-fruit-cake-you-can-imagine-and-then-some/ http://www.smallbatchcreative.com/2011/04/the-anatomy-of-a-cupcake/
3. Just enough Haskell
4. Haskell 1 f :: Int -> Int 2 f x = 2 * x $ ghci GHCi, version 7.8.3: http://www.haskell.org/ghc/ :? for help Loading package ghc-prim ... linking ... done. Loading package integer-gmp ... linking ... done. Loading package base ... linking ... done. Prelude> :l f.hs [1 of 1] Compiling Main ( f.hs, interpreted ) Ok, modules loaded: Main. *Main> f 5 10
5. Haskell 1 quicksort :: Ord a => [a] -> [a] 2 quicksort [] = [] 3 quicksort (p:xs) = (quicksort lesser) ++ [p] ++ (quicksort greater) 4 where 5 lesser = filter (< p) xs 6 greater = filter (>= p) xs $ ghci GHCi, version 7.8.3: http://www.haskell.org/ghc/ :? for help Loading package ghc-prim ... linking ... done. Loading package integer-gmp ... linking ... done. Loading package base ... linking ... done. Prelude> :l quicksort.hs [1 of 1] Compiling Main ( quicksort.hs, interpreted ) Ok, modules loaded: Main. *Main> quicksort [4,1,6,7,2,1,7,8] [1,1,2,4,6,7,7,8] *Main>
6. Lazy $ ghci GHCi, version 7.8.3: http://www.haskell.org/ghc/ :? for help Loading package ghc-prim ... linking ... done. Loading package integer-gmp ... linking ... done. Loading package base ... linking ... done. Prelude> [0..] [0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,1Interrupted. Prelude> take 4 [0..] [0,1,2,3] Prelude> take 4 [0,2..] [0,2,4,6] Prelude> take 10 [ n | n <- [0..], odd n, n `mod` 17 == 0 ] [17,51,85,119,153,187,221,255,289,323]
7. Types 1 bangIt :: String -> Char -> Int -> String 2 bangIt msg bang count = msg ++ replicate count bang *Main> :t bangIt bangIt :: String -> Char -> Int -> String *Main> bangIt "hello" '!' 4 "hello!!!!"
8. Types 1 type BangCount = Int 2 type Message = String 3 type Bang = Char 4 type Result = String 5 6 bangIt :: Message -> Bang -> BangCount -> Result 7 bangIt msg bang count = msg ++ replicate count bang *Main> :t bangIt bangIt :: Message -> Bang -> BangCount -> Result *Main> bangIt "hello" '!' 4 “hello!!!!" *Main> import Data.Char *Main Data.Char> map toUpper $ bangIt "hello" '!' 4 "HELLO!!!!"
9. Partial Application 1 > 3 * 5 2 15 3 > :t (*) 4 (*) :: Num a => a -> a -> a 5 > (*) 3 5 -- 3 -> 5 -> 15 6 15 7 > :t (*) 3 8 (*) 3 :: Num a => a -> a 9 10 mulThree :: Num a => a -> a 11 mulThree n = (*) 3 n 12 13 > mulThree 5 14 15 15 16 mulThree :: Num a => a -> a 17 mulThree = (*) 3
10. Higher-order functions Prelude> :t foldl foldl :: (b -> a -> b) -> b -> [a] -> b Prelude> foldl (+) 0 [1,2,3,4] 10 2.1.2 :001 > [1,2,3,4].inject(0){ |s,i| s + i } => 10
11. IO main :: IO () main = do putStrLn "What's your name?" name <- getLine putStrLn $ "Hello, " ++ name Prelude> :l io.hs [1 of 1] Compiling Main ( io.hs, interpreted ) Ok, modules loaded: Main. *Main> main What's your name? Josh Hello, Josh
12. Annealing Images: http://jewelrymakingjournal.com/face-framing-wire-earrings-tutorial/ http://starrglass.com/?page_id=407 http://www.sti-laser.com/technology/heat-treatments/heat-treatment-annealing/
13. Simulated Annealing 1 state = initial_state 2 cur_energy = state.energy 3 total_time.times do |i| 4 t = temperature(total_time, i) 5 6 next_state = state.mutate 7 next_energy = next_state.energy 8 9 if probability(cur_energy, next_energy, t) > rand(0.0..1.0) 10 state = next_state 11 cur_energy = next_energy 12 end 13 end
14. Simulated Annealing 1 temperature :: Int -> Int -> Float 2 probability :: Int -> Int -> Float -> Float 3 mutate :: StdGen -> a -> (StdGen, a) 4 energy :: a -> Int 5 6 tick :: (a, StdGen) -> Float -> (a, StdGen) 7 tick (state, gen) t = 8 let (rand, g2) = randomR (0.0,1.0) gen 9 (nextState, g3) = mutate state g2 10 e1 = energy state 11 e2 = energy nextState 12 shouldMutate = (probability e1 e2 t) > rand 13 in (if shouldMutate then nextState else state, g3) 14 15 anneal :: a -> Int -> StdGen -> a 16 anneal initState time gen = 17 fst $ foldl' tick (initState, gen) (map (temperature time) [0..time])
15. 1 [ 2 [2,3,3,4,4,3,5,2,2,3,2,2,2,3,2,5,3,1,3,5,2,5,2,2,2,3,2,5,2,3], 3 [2,3,3,2,3,3,5,2,3,4,2,2,1,1,1,2,1,5,1,4,2,5,2,2,2,2,4,1,1,1], 4 [2,3,4,3,3,5,5,2,3,5,2,3,2,1,2,4,4,3,3,1,2,5,3,5,2,3,4,1,1,2], 5 [1,3,3,3,3,3,3,3,4,4,3,3,4,4,2,3,3,3,1,4,3,4,3,3,2,1,3,2,3,3], 6 [4,1,3,3,3,3,4,1,3,4,3,3,1,2,1,4,4,2,2,4,2,2,2,1,2,3,4,2,5,1], 7 [2,1,1,2,3,5,4,1,1,1,2,3,5,1,3,2,4,2,3,5,2,5,2,2,2,3,4,2,2,4], 8 [1,3,4,2,3,5,4,1,3,1,2,2,2,3,1,1,1,2,2,2,2,1,2,1,2,3,3,1,3,3], 9 [3,3,3,1,3,2,2,1,2,3,2,3,2,3,2,3,3,5,2,1,2,5,2,1,2,1,4,2,2,2], 10 [1,3,4,3,3,5,5,3,1,4,2,4,1,1,5,1,1,4,2,5,2,5,3,1,2,3,4,2,1,4], 11 [1,3,4,2,4,5,4,3,2,1,3,4,1,1,4,5,4,5,3,4,2,2,2,1,2,3,3,4,1,4], 12 [1,1,1,4,4,1,4,3,3,3,4,3,1,2,1,4,1,5,2,2,2,4,2,5,2,1,4,4,1,3], 13 [2,2,1,3,4,3,4,2,5,2,3,3,3,2,5,2,3,5,2,3,1,1,4,1,2,3,4,1,3,2], 14 [2,3,3,1,3,4,4,2,4,1,3,3,1,2,1,5,1,1,2,4,2,1,2,1,2,2,3,1,1,3], 15 [1,3,2,1,3,2,3,2,3,3,3,3,4,2,5,1,4,5,3,4,2,5,2,1,2,3,4,5,1,4], 16 [1,2,1,2,1,5,4,2,4,4,2,1,1,1,5,4,4,3,3,2,2,1,3,2,2,3,3,5,1,2], 17 [5,3,4,4,3,2,4,3,1,5,4,2,5,1,1,2,4,3,3,4,2,5,4,2,2,3,3,3,1,4], 18 [5,3,4,2,3,2,4,3,4,1,2,3,1,2,2,2,4,3,2,5,2,1,2,2,2,3,4,4,2,4], 19 [3,3,3,1,3,2,5,2,5,3,3,2,2,3,5,3,4,5,2,4,1,5,2,2,2,2,4,3,2,3], The Perfect Picnic
16. Tessellation
17. Allotment
18. Neighbor Determination
19. Energy
20. Annealed
21. Implementation 1 state = initial_state 2 cur_energy = state.energy 3 total_time.times do |i| 4 t = temperature(total_time, i) 5 6 next_state = state.mutate 7 next_energy = next_state.energy 8 9 if probability(cur_energy, next_energy, t) > rand(0.0..1.0) 10 state = next_state 11 cur_energy = next_energy 12 end 13 end 1 temperature :: Int -> Int -> Float 2 probability :: Int -> Int -> Float -> Float 3 mutate :: StdGen -> a -> (StdGen, a) 4 energy :: a -> Int 5 6 tick :: (a, StdGen) -> Float -> (a, StdGen) 7 tick (state, gen) t = 8 let (rand, g2) = randomR (0.0,1.0) gen 9 (nextState, g3) = mutate state g2 10 e1 = energy state 11 e2 = energy nextState 12 shouldMutate = (probability e1 e2 t) > ran 13 in (if shouldMutate then nextState else state, g3 14 15 anneal :: a -> Int -> StdGen -> a 16 anneal initState time gen = 17 fst $ foldl' tick (initState, gen) (map (temperat
22. Data Structures 1 type Point = (Float,Float) 2 type Person = [Int] 3 type Polygon = [Point] 4 5 type Link = [Point] 6 type Placement = [(Point,Person)] 7 type Park = [Polygon] 8 9 type TimeAllowed = Int 10 type CurrentTime = Int 11 type Temperature = Float 12 type Energy = Int 13 type Probability = Float 14 15 type EnergyFunction a = a -> Int 16 type TemperatureFunction = TimeAllowed -> CurrentTime -> Temperature 17 type ProbabilityFunction = Energy -> Energy -> Temperature -> Probability 18 type MutationFunction a = StdGen -> a -> (StdGen,a) 1 module Annealing 2 class Point < Struct.new(:x, :y) 3 class Person < Struct.new(:answers) 4 class Polygon < Struct.new(:points) 5 class PolyGroup < Struct.new(:polys) 6 class Placement < Struct.new(:point, :person) 7 class Park < Struct.new(:placements)
23. Tests $ be rspec spec/ ‗ ‗ ‗ ‗ ‗ ‗ ‗ ‗ ‗ ‗ ‗ ‗ ‗ ‗ ‗ ‗ ‗ ‗ ‗ ‗ ‗ ‗ ‗ ‗ ‗ ‗ ‗ ‗ ‗ ‗ ‗ ‗ ‗ ‗ ‗ ‗ ‗ ‗ ‗ ‗ ‗ ‗ Finished in 1.8 seconds 42 examples, 0 failures $ ghc Main.hs [1 of 7] Compiling Comb ( Comb.hs, Comb.o ) [2 of 7] Compiling Color ( Color.hs, Color.o ) [3 of 7] Compiling Polygon ( Polygon.hs, Polygon.o ) [4 of 7] Compiling SVG ( SVG.hs, SVG.o ) [5 of 7] Compiling SimulatedAnnealing ( SimulatedAnnealing.hs, SimulatedAnnealing.o ) [6 of 7] Compiling Park ( Park.hs, Park.o ) [7 of 7] Compiling Main ( Main.hs, Main.o ) Linking Main ... Static Types FTW!
24. Geometry 1 triangulate :: Polygon -> [Polygon] 2 triangulate (a:b:c:xs) = [a,b,c] : triangulate (a:c:xs) 1 module Annealing 2 class Polygon < Struct.new(:points) 3 def triangulate(set = points) 4 return PolyGroup.new([]) if set.length < 3 5 a,b,c = set[0..3] 6 rest = set[3..-1] 7 8 rest_group = triangulate([a,c] + rest) 9 PolyGroup.new( [Polygon.new([a,b,c])] + rest_group.polys) 10 end
25. 1 picnicEnergy :: [Link] -> Placement -> Int 2 picnicEnergy links park = sum linkEnergies 3 where 4 linkEnergies = map linkEnergy links 5 linkEnergy [a,b] = mismatches (findPerson park a) (findPerson park b) 6 7 mismatches :: Person -> Person -> Int 8 mismatches a b = length $ filter (uncurry (/=)) $ zip a b 1 module Annealing 2 class Park < Struct.new(:placements) 3 def energy 4 energies = links.map {|a,b| a.person.mismatches(b.person) } 5 energies.inject(0){|s,e| s + e } 6 end 7 8 class Person < Struct.new(:answers) 9 def mismatches(other) 10 answers.zip(other.answers).select{|a,b| a != b}.length 11 end 1 > :t uncurry 2 uncurry :: (a -> b -> c) -> (a, b) -> c
26. 1 picnicTemperature :: TemperatureFunction 2 -- picnicTemperature :: TimeAllowed -> CurrentTime -> Temperature 3 -- picnicTemperature :: Int -> Int -> Float 4 picnicTemperature max cur = 50.0 * exp (0.0 - (5.0 * currentRatio)) 5 where currentRatio = fromIntegral cur / fromIntegral max 1 module Annealing 2 class ParkAnnealer 3 def temperature(max, current) 4 50 * Math.exp(0 - (5 * ( current / max.to_f))) 5 end
27. 1 module Annealing 2 class ParkAnnealer 3 def probability(e1, e2, temperature) 4 Math.exp( (e1 - e2) / temperature ) 5 end 6 7 if probability(cur_energy, next_energy, t) > rand(0.0..1.0) 1 probability :: ProbabilityFunction 2 -- probability :: Energy -> Energy -> Temperature -> Probability 3 -- probability :: Int -> Int -> Float -> Float 4 probability e1 e2 t = exp (fromIntegral (e1 - e2) / t) 5 6 -- 7 (rand, g2) = randomR (0.0,1.0) gen 8 shouldSwap = probability (ef state) (ef nextState) t > rand
28. 1 mutate :: [Link] -> SA.MutationFunction Placement 2 -- type MutationFunction a = StdGen -> a -> (StdGen,a) 3 -- type Placement = [(Point,Person)] 4 -- mutate :: [Link] -> StdGen -> Placement -> (StdGen, Placement) 5 -- mutate :: [Link] -> StdGen -> Placement -> (StdGen, Placement) 6 mutate links gen park = 7 let (n, gen2) = randomR (0, length links - 1) gen 8 [p1, p2] = links !! n 9 per1 = findPerson park p1 10 per2 = findPerson park p2 11 in (gen2, 12 (p1, per2) : (p2, per1) : filter (not . flip elem [p1,p2] . fst) park) 1 module Annealing 2 class Park < Struct.new(:placements) 3 def mutate 4 p0, p1 = walking_neighbors(4).sample 5 p = p0.person 6 p0.person = p1.person 7 p1.person = p 8 @inspected = [a0,a1] 9 end 10 def rollback 11 p0, p1 = @inspected 12 p = p0.person 13 p0.person = p1.person 14 p1.person = p 15 end
29. Not enough time! • Side Effects / Purity • Mutation • Parallelization • Polymorphism
30. Ruby-Processing • jashkenas/ruby-processing • jruby • gem install ruby-processing 1 def setup 2 size 400, 400 3 fill 255 4 end 5 6 def draw 7 background 0 8 ellipse mouse_x, mouse_y, 100, 100 9 end
32. Park Links Swapped Progress Bar
33. Sorted Link Energies Current Temperature Annealing Schedule
34. 1 def park_triangles 2 fill 255 3 stroke_weight 2 4 stroke 255 5 @park_triangles.polys.each do |p| 6 triangle( 7 p.points[0].x, p.points[0].y, 8 p.points[1].x, p.points[1].y, 9 p.points[2].x, p.points[2].y 10 ) 11 end 12 end 1 def progress_bar(current, max) 2 bar_width = 600 3 pct = current / max.to_f 4 progress_width = bar_width * pct 5 6 stroke_weight 1 7 stroke 150 8 fill 255 9 rect 10, 340, bar_width, 15 10 fill 150 11 rect 10, 340, progress_width, 15 12 end
35. Demo!
36. Links, Links, Links ★ Simulated Annealing: http://en.wikipedia.org/wiki/Simulated_annealing ★ Annealing the Traveling Salesman Problem: http://toddwschneider.com/posts/traveling- salesman-with-simulated-annealing-r-and-shiny/ ★ Learn Haskell: learnyouahaskell.com ★ More on Lazy: http://chimera.labs.oreilly.com/books/1230000000929/ch02.html#sec_par- eval-whnf ★ Exercism Haskell Track: http://help.exercism.io/getting-started-with-haskell.html ★ XMonad, the tiling window manager construction kit: http://xmonad.org/ ★ Conrad Barski’s Haskell Tutorial, AKA what I ripped off to do this ;) http://lisperati.com/ haskell/
37. Thanks! ★ Josh Szmajda @jszmajda ★ CTO ★ Organizer: ★ github.com/joshsz/annealing ★ exercism.io Haskell Track ★ learnyouahaskell.com ★ http://lisperati.com/haskell/ by Conrad Barski - THANK YOU