# Lojic Technologies

## Find Longest Substring Palindrome in Haskell

I stumbled upon a programming challenge a company was using for recruitment purposes and thought I’d create a Haskell solution as a learning exercise. The first problem was to find the longest palindrome embedded in a text string.

The following Haskell solution seems very readable to me, but it’s a naive solution that’s inefficient. It computes an answer on my 2.6 year old Macbook Pro in under 4 seconds, but a 2x increase in text requires a 7x increase in CPU time.

I believe there are algorithms to find the longest embedded palindrome in linear time, so I may post a refinement later.

```-- Find the longest palindrome in a text string.

module Main where
import Char

text = "I'll just type in some example text here and embed a little
palindrome - A man, a plan, a canal, Panama! - I expect that will be
the longest palindrome found in this text.
Lorem ipsum dolor sit amet, consectetur adipiscing elit.
Integer volutpat lorem imperdiet ante bibendum ullamcorper. Mauris
tempor hendrerit justo at elementum. Vivamus elit magna, accumsan id
condimentum a, luctus a ipsum. Donec fermentum, lectus at posuere
ullamcorper, mauris lectus tincidunt nulla, ut placerat justo odio sed
odio. Nulla blandit lorem sit amet odio varius nec vestibulum ante
ornare. Aliquam feugiat, velit a rhoncus rutrum, turpis metus pretium
dolor, et mattis leo turpis non est. Sed aliquet, sapien quis
consequat condimentum, sem magna ornare ligula, id blandit odio nisl
vitae erat. Nam vulputate tincidunt quam, non lacinia risus tincidunt
lacinia. Aenean fermentum tristique porttitor. Nam id dolor a eros
accumsan imperdiet. Aliquam quis nibh et dui ultricies cursus. Nunc
et ante non sapien vehicula rutrum. Duis posuere dictum blandit. Nunc
vitae tempus purus."

clean = map toLower . filter isAlpha

palindrome str = str == reverse str

substrings []     = []
substrings (x:xs) = substrings' (x:xs) ++ substrings xs where
substrings' []     = []
substrings' (y:ys) = [y] : [ (y:s) | s <- substrings' ys ]

longest []     = []
longest (x:xs) = if length x > length max then x else max
where max = longest xs

longest_palindrome xs =
longest (filter palindrome (substrings (clean text)))

main = print (longest_palindrome text)
```

As a comparison, I translated the program into Ruby. I program predominantly in Ruby these days, and I like it, but the Ruby version is 25 times slower (98 sec. vs. 4 sec.), and it’s 2.4 times more lines of code (31 vs. 13 – excluding the text).

A gain in runtime efficiency, expressive power and multi-core capability is very attractive!

I’m using Ruby 1.9.2 and GHC 6.12.3 on Mac OS X 10.5.8 on a 2.4 GHz Core 2 Duo w/ 4 GB RAM.

ruby 1.9.2p0 (2010-08-18 revision 29036) [i386-darwin9.8.0]
Glasgow Haskell Compiler, Version 6.12.3, for Haskell 98, stage 2 booted by GHC version 6.12.2

```TEXT = <<END
I'll just type in some example text here and embed a little
palindrome - A man, a plan, a canal, Panama! - I expect that will be
the longest palindrome found in this text.
Lorem ipsum dolor sit amet, consectetur adipiscing elit.
Integer volutpat lorem imperdiet ante bibendum ullamcorper. Mauris
tempor hendrerit justo at elementum. Vivamus elit magna, accumsan id
condimentum a, luctus a ipsum. Donec fermentum, lectus at posuere
ullamcorper, mauris lectus tincidunt nulla, ut placerat justo odio sed
odio. Nulla blandit lorem sit amet odio varius nec vestibulum ante
ornare. Aliquam feugiat, velit a rhoncus rutrum, turpis metus pretium
dolor, et mattis leo turpis non est. Sed aliquet, sapien quis
consequat condimentum, sem magna ornare ligula, id blandit odio nisl
vitae erat. Nam vulputate tincidunt quam, non lacinia risus tincidunt
lacinia. Aenean fermentum tristique porttitor. Nam id dolor a eros
accumsan imperdiet. Aliquam quis nibh et dui ultricies cursus. Nunc
et ante non sapien vehicula rutrum. Duis posuere dictum blandit. Nunc
vitae tempus purus.
END

def clean str
str.gsub(/[^A-Za-z]/,'').downcase
end

def palindrome? str
str == str.reverse
end

def subs str
return [] if str.empty?
y = str[0,1]
subs(str[1..-1]).inject([y]) do |result, s|
result << y + s
result
end
end

def substrings str
return [] if str.empty?
subs(str) + substrings(str[1..-1])
end

def longest strs
strs.inject("") do |max, str|
max = str if str.length > max.length
max
end
end

def longest_palindrome str
longest(substrings(clean(str)).inject([]) {|result, str|
result << str if palindrome?(str)
result
})
end

puts longest_palindrome(TEXT)

```

Update 3/13/11 19:30
Rick’s comment (see his blog post linked to in his comment) regarding the importance of algorithm choice is certainly a valid one – a better algorithm in a slower language may win over an inferior algorithm in a faster language (for large enough datasets). However, what I’m becoming interested in is the fact that one may gain both productivity/power and runtime speed by making wise programming language choices.

In the case of an interpreted language such as Ruby, it’s helpful to “stay in C code” as much as possible. In other words, to favor built-in library routines that have been implemented in C over hand written Ruby code. As much as I like Ruby, this is one of the things that bothers me – the fact that the Ruby code written by the programmer is vastly inferior in performance to the built-in library routines.

I wasn’t planning on refining the Haskell version this soon, but after seeing Rick’s blog post response, I couldn’t resist ðŸ™‚

I should first provide some background info for context. When I wrote the original Haskell version above, I was in the middle of an online programming challenge, and my goal was simply to compute the answer in a reasonable amount of time to move on to the next challenge, so the brief, easily understandable, Haskell version worked great. Hence, my disclaimers in the post regarding the naivity and inefficiency of the solution. The Ruby code in this post was an afterthought simply to see a comparison between identical algorithms. Given that apple & apple comparison, I’m impressed with the brevity and speed of the Haskell version.

Since I’m still very much a Haskell newbie, and short on time, I found an incredible solution by Johan Jeuring. It’s a little bit longer than the Ruby version, but much, much faster. It’s so fast, I had to increase the input quite a bit to get a reasonable comparison – I replicated the original text 23 times and reversed one of the replications to make a fairly long palindrome.

Rick’s Ruby version took 169.4 seconds, Johan’s Haskell version took 0.032 seconds. In other words, Ruby takes over 5,000 times as long to compute the result. Clearly this is an apples and oranges comparison, but I fully expect that a Ruby version using an identical algorithm will take 100 times as long (or longer) to run and would be less concise. Giving up runtime performance to gain programmer power is one thing, but giving up runtime performance and power is a tough pill to swallow.

Here is a slightly modified version of Johan Jeuring’s code. He was also kind enough to provide his code here:

```-- Reorganized from Johan Jeuring's solution:
module Main where
import Data.List (maximumBy,intersperse)
import Data.Char
import Data.Array

text = "I'll just type in some example text here and embed a little
palindrome - A man, a plan, a canal, Panama! - I expect that will be
the longest palindrome found in this text.
Lorem ipsum dolor sit amet, consectetur adipiscing elit.
Integer volutpat lorem imperdiet ante bibendum ullamcorper. Mauris
tempor hendrerit justo at elementum. Vivamus elit magna, accumsan id
condimentum a, luctus a ipsum. Donec fermentum, lectus at posuere
ullamcorper, mauris lectus tincidunt nulla, ut placerat justo odio sed
odio. Nulla blandit lorem sit amet odio varius nec vestibulum ante
ornare. Aliquam feugiat, velit a rhoncus rutrum, turpis metus pretium
dolor, et mattis leo turpis non est. Sed aliquet, sapien quis
consequat condimentum, sem magna ornare ligula, id blandit odio nisl
vitae erat. Nam vulputate tincidunt quam, non lacinia risus tincidunt
lacinia. Aenean fermentum tristique porttitor. Nam id dolor a eros
accumsan imperdiet. Aliquam quis nibh et dui ultricies cursus. Nunc
et ante non sapien vehicula rutrum. Duis posuere dictum blandit. Nunc
vitae tempus purus."

clean = map toLower . filter isAlpha

longestPalindrome input =
let inputArray      =  listArrayl0 input
(maxLength,pos) =  maximumBy
((l,_) (l',_) -> compare l l')
(zip (palindromesAroundCentres inputArray) [0..])
in showPalindrome inputArray (maxLength,pos)

longestPalindromes m input =
let inputArray =  listArrayl0 input
in concat \$ intersperse "n"
\$ map (showPalindrome inputArray)
\$ filter ((m String
lengthLongestPalindrome = show . maximum . palindromesAroundCentres . listArrayl0

lengthLongestPalindromes :: String -> String
lengthLongestPalindromes = show . palindromesAroundCentres . listArrayl0

palindromesAroundCentres a =
let (afirst,_) = bounds a
in reverse \$ extendTail a afirst 0 []

extendTail a n currentTail centres
| n > alast = finalCentres currentTail centres
(currentTail:centres)
| n-currentTail == afirst =
extendCentres a n (currentTail:centres)
centres currentTail
| a!n == a!(n-currentTail-1) =
extendTail a (n+1) (currentTail+2) centres
| otherwise =
extendCentres a n (currentTail:centres)
centres currentTail
where  (afirst,alast)  =  bounds a

extendCentres a n centres tcentres centreDistance
| centreDistance == 0 =
extendTail a (n+1) 1 centres
| centreDistance-1 == head tcentres  =
extendTail a n (head tcentres) centres
| otherwise =
extendCentres a n (min (head tcentres)
(centreDistance-1):centres)
(tail tcentres) (centreDistance-1)

finalCentres 0     _        centres  =  centres
finalCentres (n+1) tcentres centres  =
finalCentres n
(tail tcentres)
finalCentres _     _        _        =  error "finalCentres: input < 0"

showPalindrome a (len,pos) =
let startpos = pos `div` 2 - len `div` 2
endpos   = if odd len
then pos `div` 2 + len `div` 2
else pos `div` 2 + len `div` 2 - 1
in show [a!n|n <- [startpos .. endpos]]

listArrayl0 string  = listArray (0,length string - 1) string

sampleText s = concat (replicate 8 s ++ [ "x" ] ++ [ reverse s ] ++ replicate 14 s)

main = print (longestPalindrome (clean (sampleText text)))
```

Here’s the relevant change to Rick’s Ruby version:

```
def sample_text str
str * 8 + 'x' + str.reverse + str * 14
end

puts clean(sample_text(TEXT)).longest_palindrome
```

March 13, 2011 at 1:37 am

Posted in programming

Tagged with ,

## Cracker Barrel Peg Board Puzzle in Haskell

with one comment

I first wrote a program to solve the Cracker Barrel peg board puzzle (15 holes arranged in a triangle with 14 golf tees) many years ago as youth using the BASIC language. I wish I still had the source to that, because I’m pretty sure this Haskell version would kick its butt ðŸ™‚

I’m still trying to get my head around Haskell, so I expect there are many possible improvements to this program, but even so, I’m pleased with how Haskell allows me to express logic.

```-- Solve the Cracker Barrel Peg Board Puzzle

module Main where

type Pos = (Int, Int)
type Move = (Pos, Pos)
type Board = [ Pos ]

isOccupied b p = elem p b
isEmpty b p    = not (isOccupied b p)
isPos (r,c)    = elem r [0..4] && elem c [0..r]

-- Possible moves for one position
positionMoves b p = [ (p, dst) | (neighbor, dst)  isPos p1 && isPos p2)
[ ((r + or `div` 2, c + oc `div` 2),(r + or, c + oc)) |
(or, oc) <- [ (-2,0), (0,2), (2,2), (2,0), (0,-2), (-2,-2) ] ]

-- Possible moves for all positions on the board
possibleMoves b = concat [ positionMoves b pos | pos  (pos /= src) && (pos /= neighbor)

-- Make moves until the goal position is met
play b p moves =
if null nextMoves then
if length b == 1 && head b == p then reverse moves else []
else
tryMoves nextMoves
where
nextMoves       = possibleMoves b
tryMoves []     = []
tryMoves (m:ms) =
let result = play (move b m) p (m:moves)
in if null result then tryMoves ms else result

-- Compute the initial empty position to know the goal, then solve the puzzle
solve b = let emptyPos = head [ (r,c) | r <- [0..4], c <- [0..r], isEmpty b (r,c) ]
in play b emptyPos []

-- A sample board with the topmost hole empty
board :: Board
board = [ (1,0), (1,1),
(2,0), (2,1), (2,2),
(3,0), (3,1), (3,2), (3,3),
(4,0), (4,1), (4,2), (4,3), (4,4) ]

main = print (solve board)
```