Decoding Shredded Messages in Haskell using AI techniques

Part 2 of my Introduction to Artifical Intelligence programming assignment was to decode a message,
which had been shredded and reassembled as a random jumble of strips like so:

de|  | f|Cl|nf|ed|au| i|ti|  |ma|ha|or|nn|ou| S|on|nd|on
ry|  |is|th|is| b|eo|as|  |  |f |wh| o|ic| t|, |  |he|h 
ab|  |la|pr|od|ge|ob| m|an|  |s |is|el|ti|ng|il|d |ua|c 
he|  |ea|of|ho| m| t|et|ha|  | t|od|ds|e |ki| c|t |ng|br
wo|m,|to|yo|hi|ve|u | t|ob|  |pr|d |s |us| s|ul|le|ol|e 
 t|ca| t|wi| M|d |th|"A|ma|l |he| p|at|ap|it|he|ti|le|er
ry|d |un|Th|" |io|eo|n,|is|  |bl|f |pu|Co|ic| o|he|at|mm
hi|  |  |in|  |  | t|  |  |  |  |ye|  |ar|  |s |  |  |. 

You could brute force this and generate all 19! combinations, but this is not the AI way.

The approach I took was to greedily combine strips from left to right until all strips have been used. That is, choose an initial starting strip then try all remaining strips, then choose the one that results in the highest score for the combined strips based on trigram frequency. Rinse and repeat until all strips used.

We then do this again, choosing a new starting strip from each of the candidates, and the result with the best score is our winner.

Sounds simple, doesn't it? However, to arrive at the correct result required some tweaking of the scoring.
In my first attempt, the first 15 or so strips would be correct but the last 4 would be jumbled... I think this was because the last line is mostly blank, which upset the scoring, which was based on the sum of the log probability score for each row (see my previous post for more info on trigram probability scoring).

Using only the first 6 out of 8 rows for scoring improved this significantly, however the correct answer was actually only the third highest scoring result. The other two were almost correct but started with a column of spaces. Tweaking the scoring code to punish rows with a leading space (assuming the text is left justified) brought the correct answer to the top of the list. Hooray!

This was quite a challenge, especially as it was only my third ever Haskell program.

If you're interested in seeing how I tackled this problem in a functional language like Haskell the source code is hosted on ideone. Any feedback appreciate!

Finally, here is the output:

Shredded Message Solver (ai-class)

shredded message:
de|  | f|Cl|nf|ed|au| i|ti|  |ma|ha|or|nn|ou| S|on|nd|on
ry|  |is|th|is| b|eo|as|  |  |f |wh| o|ic| t|, |  |he|h 
ab|  |la|pr|od|ge|ob| m|an|  |s |is|el|ti|ng|il|d |ua|c 
he|  |ea|of|ho| m| t|et|ha|  | t|od|ds|e |ki| c|t |ng|br
wo|m,|to|yo|hi|ve|u | t|ob|  |pr|d |s |us| s|ul|le|ol|e 
 t|ca| t|wi| M|d |th|"A|ma|l |he| p|at|ap|it|he|ti|le|er
ry|d |un|Th|" |io|eo|n,|is|  |bl|f |pu|Co|ic| o|he|at|mm
hi|  |  |in|  |  | t|  |  |  |  |ye|  |ar|  |s |  |  |. 

Top 3 results...
score: -1619.5501131298224

Claude Shannon founded information    
theory, which is the basis of         
probabilistic language models and     
of the code breaking methods that     
you would use to solve this problem,  
with the paper titled "A Mathematical 
Theory of Communication," published   
in this year.                         

score: -1631.76535223795

nnon founded informationClaude Sha    
ich is the basis of     theory, wh    
tic language models and probabilis    
e breaking methods that of the cod    
use to solve this probleyou would   m,
aper titled "A Mathematiwith the pl ca
Communication," publisheTheory of   d 
ar.                     in this ye    

score: -1632.7894584577352

nded informationClaude Shannon fou    
he basis of     theory, which is t    
uage models and probabilistic lang    
ng methods that of the code breaki    
olve this probleyou would use to s  m,
led "A Mathematiwith the paper titl ca
ation," publisheTheory of Communic  d 
                in this year.     

Solving Caesar Ciphers Using Haskell

I recently completed the free online Stanford Universivity Introduction to Artificial Intelligence class, taught by Peter Norvig and Sebastion Thrun. I can't highly recommend this course enough if you are interested in AI - and did i mention it's free?

Anyway, one of the optional programming assignments was to decode the following message:

"Esp qtcde nzyqpcpynp zy esp ezatn zq Lcetqtntlw Tyepwwtrpynp hld spwo le Olcexzfes Nzwwprp ty estd jplc."

The message is encoded using a Caesar Cipher - a very simple shift cipher, where each letter is substituted for another a fixed number of positions down the alphabet. Those of you old enough to remember Usenet may have encountered rot13, which is an example of a Caesar cipher.

The key to solving this problem is probabilistic analysis of the text. My first, rather naive approach based on intuition rather a strict application of probability theory was simply to analyse the text with the assumption that the most frequent letter in English is 'e'. Using AI jargon, we could say I used a probabilistic unigram letter model.

Anyway, I thought it was a great opportunity to practice my freshly minted Haskell skills, and to my surprise this naive approach actually worked!

Blogger does a lousy job of inlining code so I have hosted the code here on ideone.com, an awesome site that not only displays code with syntax highlighting, it can even take input, run the code and display the output. Thanks to Maxim on aiqus for improving my Haskell code.

Flush with my success, I tried a more sophisticated approach. This time I would use a trigram letter model, which are basically sequences of three adjacent letters- for example, one of the most common letter trigrams in English is 'THE". The approach was to generate all 26 possible decoding of the string, and score each one based on the trigram probabilities, choosing the one with the highest score as the most likely candidate. A few tricks that I learned in AI class were employed here - I used Laplace Smoothing to ensure that unlikely trigrams that I didn't have scores for would not invalidate my probability score due to multiplying by zero.  I also used the log of the probabilities so I could simply sum them and didn't have to deal with ridiculously small numbers.

The source code, along with the trigram input data and output can be found here on here on oneide.com.
I have copied the output below

Caesar Cypher Solver (ai-class)

encoded message:

Esp qtcde nzyqpcpynp zy esp ezatn zq Lcetqtntlw Tyepwwtrpynp hld spwo le Olcexzfes Nzwwprp ty estd jplc.

The top 3 candidates based on trigram letter probabilities for english language

The first conference on the topic of Artificial Intelligence was held at Dartmouth College in this year.

score: -742.9796021883617

Nby zclmn wihzylyhwy ih nby nijcw iz Ulnczcwcuf Chnyffcayhwy qum byfx un Xulngionb Wiffyay ch nbcm syul.

score: -913.8004146160043

Esp qtcde nzyqpcpynp zy esp ezatn zq Lcetqtntlw Tyepwwtrpynp hld spwo le Olcexzfes Nzwwprp ty estd jplc.

score: -921.9751546970537

I would appreciate any comments on my Haskell code, I'm a bit of a novice...  and any other feedback would be greatly appreciated.

          

          

Project Euler Problem 2

Due to my upcoming redundancy, I thought it is about time I learned  some new skills, so naturally I have chosen to learn a language with virtually zero commercial application - Haskell.

If you don't know what Haskell is, it's a functional programming language, which means that is it it deals with what to do, rather than how to do it, as most people are used to with typical procedural languages such as C.

Anyway, a good way to learn a new language is to try it out on some classic problems, such as those on the Project Euler page.

Problem 2 states:

"By considering the terms in the Fibonacci sequence whose values do not exceed four million, find the sum of the even-valued terms."

The fibonacci sequence starts with 0, 1.. then subsequent entries are constructed by summing the previous two entries. This conveniently recursive definition can be specified in Haskell recursively, ie:

fib :: Int -> Int

fib 0 = 0

fib 1 = 1

fib n = fib(n-1) + fib(n-2)

So the first step in solving this problem is to generate a list of fibonacci numbers... which is very easy to do using Haskell's list comprehension feature:

[ fib x | x <- [0..] ]

This basically says construct a list by calling the function fib x, where x is bound to the range of numbers from 0 to infinity. Infinite lists are a quirky feature of Haskell made possible by its use of lazy evaluation,  which means Haskell will defer actually calculating a result until it absolutely has to. The above expression will keep printing the list until the cows come home, but you will notice that after around 30 elements it gets slower and slower...


This is because it is fiendishly inefficient, having to recalculate each entry in the list from scratch, rather than re-using the previous two entries calculation. Clearly, this approach will not satisfy the Project Euler criteria that the solution should take less than a minute to run.

A new approach to calculate the fibonacci sequence using the results of the previous calculation is shown below:

fibs = 0 : 1 : zipWith (+) fibs (tail fibs )

Note that it is recursively defined also. By way of explanation, zipWith is a function which takes two lists and applies a function to the elements in the same corresponding positions in the list and tail is a function which returns a list minus the first element.

So in this case the effect of zipWith is to add the nth element of fibs with the n-1th element of fibs. This function will generate an infinite fibonacci sequence.

We can use a list comprehension to filter out the odd valued terms using the predicate x `mod` 2 == 0.
mod is actually a prefix function (ie: called before its arguments, eg: mod x 2 ), but using `backticks` allows us to call it using infix notation, which is more natural for mathematical functions.

[ x | x <- fibs, x `mod` 2 == 0 ]

Note that the predicate x <= 4000000 will also filter out all values less than 4000000, but the list comprehension will never terminate.

Instead, we can use the takeWhile function which takes values from a list whilst as a boolean criterion is satisfied, eg:

takeWhile ( <= 4000000 ) [ x | x <- fibs, x `mod` 2 == 0 ]

[0,2,8,34,144,610,2584,10946,46368,196418,832040,3524578]

Now all that is left if to sum the list to get our answer

sum (takeWhile ( <= 4000000 ) [ x | x <- fibs, x `mod` 2 == 0 ])

4613732

Which makes me the 139646th person to solve that problem on the Project Euler page. Only 342 left to solve!