 # TatriX's solution

## to Crypto Square in the PureScript Track

Published at Jul 13 2018 · 0 comments
Instructions
Test suite
Solution

#### Note:

This solution was written on an old version of Exercism. The tests below might not correspond to the solution code, and the exercise may have changed since this code was written.

Implement the classic method for composing secret messages called a square code.

Given an English text, output the encoded version of that text.

First, the input is normalized: the spaces and punctuation are removed from the English text and the message is downcased.

Then, the normalized characters are broken into rows. These rows can be regarded as forming a rectangle when printed with intervening newlines.

For example, the sentence

If man was meant to stay on the ground, god would have given us roots.

is normalized to:

ifmanwasmeanttostayonthegroundgodwouldhavegivenusroots

The plaintext should be organized in to a rectangle. The size of the rectangle (`r x c`) should be decided by the length of the message, such that `c >= r` and `c - r <= 1`, where `c` is the number of columns and `r` is the number of rows.

Our normalized text is 54 characters long, dictating a rectangle with `c = 8` and `r = 7`:

``````ifmanwas
meanttos
tayonthe
groundgo
dwouldha
vegivenu
sroots
``````

The coded message is obtained by reading down the columns going left to right.

The message above is coded as:

``````imtgdvsfearwermayoogoanouuiontnnlvtwttddesaohghnsseoau
``````

Output the encoded text in chunks. Phrases that fill perfect squares `(r X r)` should be output in `r`-length chunks separated by spaces. Imperfect squares will have `n` empty spaces. Those spaces should be distributed evenly across the last `n` rows.

``````imtgdvs fearwer mayoogo anouuio ntnnlvt wttddes aohghn sseoau
``````

Notice that were we to stack these, we could visually decode the cyphertext back in to the original message:

``````imtgdvs
fearwer
mayoogo
anouuio
ntnnlvt
wttddes
aohghn
sseoau
``````

## Source

J Dalbey's Programming Practice problems http://users.csc.calpoly.edu/~jdalbey/103/Projects/ProgrammingPractice.html

## Submitting Incomplete Solutions

It's possible to submit an incomplete solution so you can see how others have completed the exercise.

### Main.purs

``````module Test.Main where

import Prelude
import Test.Unit.Assert as Assert
import Test.Unit (TestSuite, suite, test)
import Test.Unit.Console (TESTOUTPUT)
import Test.Unit.Main (runTest)
import CryptoSquare ( normalizedPlaintext
, plaintextSegments
, encoded
, ciphertext
)

main :: forall eff
. Eff ( avar :: AVAR
, console :: CONSOLE
, testOutput :: TESTOUTPUT
| eff
)
Unit
main = runTest suites

suites :: forall e. TestSuite e
suites = do
suite "CryptoSquare.normalizedPlaintext" do

test "Lowercase" \$
Assert.equal "hello"
(normalizedPlaintext "Hello")

test "Remove spaces" \$
Assert.equal "hithere"
(normalizedPlaintext "Hi there")

test "Remove punctuation" \$
Assert.equal "123go"
(normalizedPlaintext "@1, 2%, 3 Go!")

suite "CryptoSquare.plaintextSegments" do

test "empty plaintext results in an empty rectangle" \$
Assert.equal
[]
(plaintextSegments "")

test "4 character plaintext results in an 2x2 rectangle" \$
Assert.equal
[ "ab"
, "cd"
]
(plaintextSegments "Ab Cd")

test "9 character plaintext results in an 3x3 rectangle" \$
Assert.equal
[ "thi"
, "sis"
, "fun"
]
(plaintextSegments "This is fun!")

test "54 character plaintext results in an 8x7 rectangle" \$
Assert.equal
[ "ifmanwas"
, "meanttos"
, "tayonthe"
, "groundgo"
, "dwouldha"
, "vegivenu"
, "sroots"
]
(plaintextSegments "If man was meant to stay on the ground, god would have given us roots.")

suite "CryptoSquare.encoded" do

test "empty plaintext results in an empty encode" \$
Assert.equal
""
(encoded "")

test "Non-empty plaintext results in the combined plaintext segments" \$
Assert.equal
"imtgdvsfearwermayoogoanouuiontnnlvtwttddesaohghnsseoau"
(encoded "If man was meant to stay on the ground, god would have given us roots.")

suite "CryptoSquare.ciphertext" do

test "empty plaintext results in an empty ciphertext" \$
Assert.equal
""
(ciphertext "")

test "9 character plaintext results in 3 chunks of 3 characters" \$
Assert.equal
"tsf hiu isn"
(ciphertext "This is fun!")

test "54 character plaintext results in 7 chunks, the last two padded with spaces" \$
Assert.equal
"imtgdvs fearwer mayoogo anouuio ntnnlvt wttddes aohghn  sseoau "
(ciphertext "If man was meant to stay on the ground, god would have given us roots.")``````
``````module CryptoSquare
( normalizedPlaintext
, plaintextSegments
, encoded
, ciphertext
) where

import Prelude

import Data.Array (filter, fromFoldable, replicate)
import Data.Char.Unicode (isAlphaNum, toLower)
import Data.Int (ceil, floor, toNumber)
import Data.List as L
import Data.String (drop, fromCharArray, joinWith, length, take, toCharArray)
import Math (sqrt)

normalizedPlaintext :: String -> String
normalizedPlaintext s =
toCharArray s #
filter isAlphaNum #
map toLower #
fromCharArray

plaintextSegments :: String -> Array String
plaintextSegments s = go [] \$ normalizedPlaintext s where
root = sqrt \$ toNumber \$ length s
r = ceil root
c = floor root
go :: Array String -> String -> Array String
go acc "" = acc
go acc ss
| length ss <= r = acc <> [ss]
| otherwise = go (acc <> [take c ss]) (drop c ss)

encoded :: String -> String
encoded s = joinWith "" segments where
lists = L.fromFoldable \$ (L.fromFoldable <<< toCharArray) <\$> plaintextSegments s
transposed = L.transpose lists
segments =  fromFoldable \$ (fromFoldable >>> fromCharArray) <\$> transposed

ciphertext :: String -> String
ciphertext s = joinWith " " \$ go [] \$ enc where
enc = encoded s
l = length enc
r = floor \$ sqrt \$ toNumber l
spaces = l - r * r
imperfect = r * (ceil \$ toNumber r / toNumber spaces)
pad = (floor \$ sqrt \$ toNumber spaces) - 1
span = fromCharArray \$ replicate pad ' '
go :: Array String -> String -> Array String
go acc "" = acc
go acc ss
| length ss < imperfect = go (acc <> [take (r - pad) ss <> span]) (drop (r - pad) ss)
| otherwise = go (acc <> [take r ss]) (drop r ss)``````