The Daily Cryptogram

July 14, 2009

Many newspapers publish a cryptogram each day; for instance:


The deciphered cryptogram is usually a quote from a famous author, often advice for daily life or a pithy saying. Cryptographically, these puzzles are monoalphabetic substitution ciphers, with each of the twenty-six plain-text letters systematically replaced by a cipher-text letter.

Your task is to write a program that decrypts the daily cryptogram, and use that program to read the message given above. When you are finished, you are welcome to read or run a suggested solution, or to post your own solution or discuss the exercise in the comments below.


Pages: 1 2

4 Responses to “The Daily Cryptogram”

  1. […] Praxis – The Daily Cryptogram By Remco Niemeijer Today‚Äôs Programming Praxis problem is an interesting one: we have to write a program to solve […]

  2. Remco Niemeijer said

    First a small notification: I’ll be on vacation the next 4 weeks, so I won’t be able to post any solutions in that period. I should be back for puzzle 59.

    My Haskell solution (see for a version with comments):

    import Data.Char
    import Data.List
    import qualified Data.Map as M
    import GHC.Exts

    match :: M.Map Char String -> String -> String -> Bool
    match _ [] [] = True
    match k (c:cs) (p:ps) = M.findWithDefault [p] c k == [p] &&
    match (M.insert c [p] k) cs ps
    match _ _ _ = False

    substitute :: M.Map Char String -> String -> String
    substitute key = concatMap (\c -> M.findWithDefault [c] c key)

    getKeys :: M.Map Char String -> [String] -> String -> [M.Map Char String]
    getKeys k dict c = [M.fromList .
    unionBy (\(a,x) (b,y) -> a == b || x == y) (M.assocs k) .
    zip w $ map return p | w <- words c, let ps = filter (match k w) dict, length ps < 100, p <- ps] score :: M.Map Char String -> String -> Int
    score k = negate . length . filter isLower . substitute k

    findBestKeys :: Int -> [String] -> String -> [M.Map Char String]
    findBestKeys n dict c = iterate (take 10 . sortWith (`score` c) .
    concatMap (\k -> getKeys k dict c)) [M.empty] !! n

    solve :: Int -> [String] -> String -> [String]
    solve n dict c = map (`substitute` c) $ findBestKeys n dict $
    filter (\x -> isAlpha x || isSpace x) c


    main :: IO ()
    main = do dict <- fmap lines $ readFile "english-words.10" mapM_ print $ solve 7 dict crypto [/sourcecode]

  3. Several years ago, I got involved in Simon Singh’s Code Challenge, and wrote a number of programs to try to crack classic ciphers. As part of this, I wrote a program which used a genetic algorithm to crack cryptograms. In many ways, it’s kind of crude: it doesn’t use a dictionary of english words, and ignored punctuation and word spacing. What it does use is a table containing the logarithm of the probability of each trigram for a corpus of text I analyzed (don’t remember what I used, maybe Sherlock Holmes or the Bible or something from Project Gutenberg). For longer cryptograms, it almost always works perfectly. It mucked up a couple of letters on this one, which is short and includes a fairly diverse set of trigrams, but the message was very easy to read even with these few mistakes in assigning low probability letters.

    Here’s the Python source. For some reason, I can’t find the code which generated the pickled “corpus”, but it shouldn’t be too hard to figure out. Perhaps I’ll rewrite one during lunch. The code ia also strictly speaking not an “algorithm”, since doesn’t actually stop: it just keeps running, trying to maximize the score, and does nothing to detect stasis. But you might find it amusing.

    [ EDIT: I put the word ‘python’ in single quotes in the sourcecode tag; without the single quotes, the tag is not recognized and the formatting is incorrect. I also fixed some ampersand-coded html characters. I hope this is correct now. ProgPrax ]

    # _
    # __ _ _ _ _ _ __| |_ ___ __ _ _ _ __ _ _ __
    # / _| ‘_| || | ‘_ \ _/ _ \/ _` | ‘_/ _` | ‘ \
    # \__|_| \_, | .__/\__\___/\__, |_| \__,_|_|_|_|
    # |__/|_| |___/
    # A simple program for automatically solving simple substitution ciphers
    # Written by Mark VandeWettering

    import pickle
    import random
    import string
    import re
    import sys

    ldict = pickle.load(open(‘newcorpus.p’))


    sorig = open(sys.argv[1]).read().upper()

    swork = re.sub(r”[^A-Z\!?.,’]+”, ” “, sorig)
    swork = filter(lambda x : x in r”ABCDEFGHIJKLMNOPQRSTUVWXYZ!?.,’ “, swork)

    print “SWORK: “, swork

    POOLSIZE = 1000

    pool = []

    for p in range(POOLSIZE):
    a = list(letters)

    def calculatescore(x):
    s = 0
    for i in range(len(x)-3):
    s = s + ldict.get(x[i:i+3], 0)
    return s

    class BogusError(Exception):

    def mutate(str):
    if random.uniform(0, 1) < 0.01: a = list(letters) random.shuffle(a) return ''.join(a) s = list(str) c0 = random.choice(range(26)) c1 = random.choice(range(26)) s[c0], s[c1] = s[c1], s[c0] return ''.join(s) def crossover(pop, mom): pop = list(pop) mom = list(mom) c0 = random.randint(0, 13) c1 = random.randint(1, 13) c1 = c0 + c1 child = pop[:] for idx in range(c0, c1): idx2 = pop.index(mom[idx]) child[idx], child[idx2] = child[idx2], child[idx] child = ''.join(child) for c in string.uppercase: if c not in child: raise BogusError return child def sumpool(pool): total = 0 sums = [] for score, key in pool: total = total + score sums.append(total) return total, sums import bisect def pick(total, l): idx = bisect.bisect_right(l, random.randint(0, total)) return idx while True: newpool = [] for p in pool: twork = string.translate(swork, string.maketrans(letters, p)) score = calculatescore(twork) newpool.append((score, p)) newpool.sort(lambda x, y: cmp(y,x)) newpool = newpool[:POOLSIZE/2] # now, generate the distribution total, sums = sumpool(newpool) newpool = map(lambda x: x[1], newpool) torig = string.translate(sorig, string.maketrans(letters, newpool[0])) print "Best Decode score = %d" % sums[0] print torig for x in range(POOLSIZE/2): idx = pick(total, sums) if (random.uniform(0, 1) < 0.15): newpool.append(mutate(newpool[idx])) else: idx2 = pick(total, sums) newpool.append(crossover(newpool[idx], newpool[idx2])) pool = newpool [/sourcecode]

  4. Pete Bevin said

    FYI, words 4 and 5 (AEFGAD and FZGPEAG) aren’t in /usr/share/dict/words on Mac. Only word 4 is missing on Ubuntu.

Leave a Reply

Fill in your details below or click an icon to log in: Logo

You are commenting using your account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s

%d bloggers like this: