addressalign-toparrow-leftarrow-rightbackbellblockcalendarcameraccwcheckchevron-downchevron-leftchevron-rightchevron-small-downchevron-small-leftchevron-small-rightchevron-small-upchevron-upcircle-with-checkcircle-with-crosscircle-with-pluscrossdots-three-verticaleditemptyheartexporteye-with-lineeyefacebookfolderfullheartglobegmailgooglegroupshelp-with-circleimageimagesinstagramFill 1linklocation-pinm-swarmSearchmailmessagesminusmoremuplabelShape 3 + Rectangle 1ShapeoutlookpersonJoin Group on CardStartprice-ribbonShapeShapeShapeShapeImported LayersImported LayersImported Layersshieldstartickettrashtriangle-downtriangle-uptwitteruserwarningyahoo

Hoodlums Message Board › Homework: Coded

Homework: Coded

Peter M.
peter_marks
Group Organizer
London, GB
Post #: 47
At this month's session, I had selected a logic problem that I thought we could solve neatly using the unification-fd package. As it turns out, this problem doesn't really need unification and we got sidetracked on peripheral issues, implementing stuff that we didn't really need.

I'll describe the problem here and provide some notes on how I've now solved it.


The problem

The following three words:

funk nuts stun

can be encoded using a simple substitution cipher. The resulting ciphertexts have been shuffled (the words not the characters) and an additional dummy string has been added below.

6348 8342 8436 2481

Your task is to discover the cipher – the mapping from each plaintext character to each ciphertext character. e.g. (but not the correct answer)

f=8, u=3, …


I've posted the code we worked on at the last session here, but I'm not sure it is very useful.


Notes (spoiler alert)

Whilst unification is unnecessary, using backtracking and variable binding still seems a good approach.

----------

The logict package gives us backtracking, and we can easily build on the StateT monad transformer to handle binding.

We'll be using monads, monad plus and monad transformers, so if you don't know about that stuff, you may find this hard to follow. This could be a good exercise to learn from, or my notes might be complete gibberish to you.

We'll go through a solution at the next session and, perhaps, try to find a more difficult logic problem that will build on this approach.

----------

Let's start by implementing binding using StateT. We want our monad to maintain a set of bindings from keys to values, so we'll define a type synonym:

type BindingT k v = StateT (Map k v)

We want a function to add a binding:

bind :: (...) => k → v → BindingT k v m ()

where … is a context that I'll leave to you. If we try to add a binding for a key we haven't previously added, we add it. If we try to rebind a key to the same value, that's fine, but if we try to bind it to a different value, we fail.

----------

Armed with BindingT and Logic (and some understanding of how to use them), solving the problem is quite easy.

I'll give you the top level and then sketch an algorithm.

main :: IO ()
main = print $ solve [“funk”, “nuts”, “stun”] [“6348”, “8342”, “8436”, “2481”]

solve :: [String] → [String] → [(Char, Char)]
solve ws cs = ...


We are going to stack our BindingT with a map from Char to Char on top of Logic. Stacking the binding on top of the backtracking gives us the correct unbinding behaviour on backtracking. If we put backtracking on top of binding, bindings would transcend backtracking.

solve, has to run our monad stack – remember we have to run from the outside in, so StateT then Logic. When running StateT, we can return the bindings and discard the final value (which will be unit). We also need to convert the bindings to a list.

----------

Let's call our monad stack a solver:

type Solver a = BindingT k v Logic a

Our top level solver (the one solve will run) is created by

solveWords :: [String] → [String] → Solver ()

This will try to solve for each word with the same bindings. If we solve for a word (described below), our bindings will capture the mappings for each character in that word. When we try to solve for subsequent words, if we can't find a solution given the bindings we already have, our bind function will fail causing backtracking. In backtracking, our existing bindings will be undone and we'll try to find another solution for the word.

We can write solveWords recursively, or we can try to find a library function that expresses this “for each” pattern – there is one.

----------

solveWord :: String → [String] → Solver ()

has to find a set of bindings that allow the given word to map to one of the codes. It does this by picking a code from the list and trying to bind the characters of the word to the characters of the code. On backtracking it will pick a different code from the list and try that one.

----------

The clever bit here is picking members of a list on each branch of backtracking. In order to provide alternatives in Logic, we use its MonadPlus behaviour. We want:

member :: [a] → Solver a

I'll leave the implementation to you.
Radu G.
user 13464758
London, GB
Post #: 4
This looks exponential. What am I missing?

Do you have any big tests?
Peter M.
peter_marks
Group Organizer
London, GB
Post #: 48
Hi Radu

I've not considered performance at all. The data set is tiny (3 words, 4 codes). My code feels instantaneous even in ghci, so no optimisation is required.

Of course, if you have an algorithm that would scale better that would be interesting too.


Peter
Radu G.
user 13464758
London, GB
Post #: 5
I don't have a faster algorithm.
Tim W.
user 12343318
London, GB
Post #: 11
Here's my quick effort: https://gist.github.c...­

Regarding alternative implementations, it should be possible to solve this without monads using only list comprehensions (mplus is ++ and fail is []) and maps.

Tim
Radu G.
user 13464758
London, GB
Post #: 6
Tim, try solve ["ab","ba"] ["01","01","11"­].
Peter M.
peter_marks
Group Organizer
London, GB
Post #: 49
Hi Radu

It is true that my algorithm gives an odd response to this, but is it wrong? Given the cypher mapping a->1 and b->1, ab and ba both get coded to 11. The spec isn't very clear as to whether this is allowed or not.

We could tighten the spec to say that each source character must map to a unique target character, or we could say that each source word must map to a different target word. The algorithm can be easily extended to implement either of these.

For the given test data, and any test data that does not hit this ambiguity in the spec, we give a sensible result I think.


Peter
Radu G.
user 13464758
London, GB
Post #: 7
I thought the spec says that there is one dummy word: "The resulting ciphertexts have been shuffled (the words not the characters) and an additional dummy string has been added [...]"

Of course, it's your spec so your interpretation takes precedence. smile In any case, if you allow an arbitrary number of dummies, then Tim's solution doesn't need the function selections at all.

Edit: Oh, and earlier I meant solve ["ab","ba"] ["01","10","11"­] but I mistyped. Luckily, the mistyped version still made some sense ...
Radu G.
user 13464758
London, GB
Post #: 8
Also, if the variable and word mappings aren't required to be injective, then the problem is NP-complete, which is a good excuse to use backtracking.

Reduction from 3SAT: A clause like a\/b\/¬c becomes the word abC. You also add words aA, bB, cC, ... The coded words are {001, 010, 011, ..., 111} union {01, 10}.

If the mappings are required to be injective, then I don't know.
Peter M.
peter_marks
Group Organizer
London, GB
Post #: 50
I've posted my solution here.
Powered by mvnForum

People in this
Meetup are also in:

Sign up

Meetup members, Log in

By clicking "Sign up" or "Sign up using Facebook", you confirm that you accept our Terms of Service & Privacy Policy