Last active
August 29, 2015 14:27
-
-
Save dela3499/adf55265598b30dd453b to your computer and use it in GitHub Desktop.
Encode and decode strings using the simple letter-shifting cipher! http://share-elm.com/gists/adf55265598b30dd453b
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
import Graphics.Input.Field as Field exposing | |
(Content, noContent, field, defaultStyle, Direction) | |
import Graphics.Element as Elem exposing (..) | |
import Graphics.Collage exposing (..) | |
import Maybe exposing (withDefault) | |
import Color exposing (..) | |
import Text exposing (..) | |
import Dict exposing (Dict) | |
import Window | |
import String | |
import Signal exposing ((<~), (~)) | |
import List | |
import Char | |
import Time | |
--main = view <~ Window.dimensions ~ time ~ inputString.signal | |
--main = view <~ Window.dimensions ~ (Time.fps 0.3) ~ inputString.signal | |
main = view <~ Window.dimensions ~ (Signal.constant 1) ~ inputString.signal | |
view: (Int, Int) -> Float -> Content -> Element | |
view (windowWidth, windowHeight) t content = | |
let shiftedStrings = getShiftedStrings content.string | |
scores = List.map score shiftedStrings |> rescaleScores | |
components = | |
List.map2 | |
(createComponent t (windowWidth * 3 // 4)) | |
scores | |
shiftedStrings | |
totalHeight = List.sum <| List.map heightOf components | |
in | |
[ spacer 40 40 | |
, field | |
Field.defaultStyle | |
(Signal.message inputString.address) | |
"Encode and decode strings using the simple letter-shifting cipher!" | |
content | |
|> width (windowWidth * 3 // 4) | |
, spacer 10 10 | |
, if content.string == "" | |
then image 540 300 "https://j.gifs.com/vp0EPq.gif" | |
else Elem.empty | |
] | |
++ components | |
|> flow down | |
|> container windowWidth (totalHeight + 400) midTop | |
createComponent: Float -> Int -> Float -> String -> Element | |
createComponent t w score string = | |
let thickness = 5 | |
barWidth = (thickness + (score * 5 * t |> floor)) | |
margin = 2 | |
myColor = hsl 10 (score * 2) 0.50 | |
textElem = | |
string | |
|> fromString | |
|> Text.color myColor | |
|> leftAligned | |
|> width (w - (thickness + barWidth) - (2 * margin)) | |
elemHeight = heightOf textElem | |
in | |
container (w + (2 * margin)) (elemHeight + (2 * margin)) middle | |
( flow right | |
[ spacer barWidth elemHeight |> Elem.color myColor | |
, spacer (thickness) elemHeight |> Elem.color white | |
, textElem | |
] ) | |
time = | |
Time.timestamp (Time.fps 60) | |
|> Signal.map (fst >> Time.inSeconds >> (\x -> sin (x * 10) * 0.5 + 0.5)) | |
signalString = Signal.map (\sig -> sig.string) inputString.signal | |
inputString : Signal.Mailbox Content | |
inputString = Signal.mailbox noContent | |
rescaleScore x = | |
let threshold = 0.09 | |
in | |
if x > threshold | |
then 1 | |
else 0 | |
rescaleScores x = | |
let max = List.maximum x |> withDefault 0 | |
in | |
List.map (\xi -> if (xi == max && xi /= 0) then 1 else 0) x | |
-- Take first n elements of infinitely repeated list | |
wrapList: Int -> List a -> List a | |
wrapList n list = | |
let nRepeats = (toFloat n) / (list |> List.length |> toFloat) |> ceiling | |
in | |
list |> List.repeat nRepeats |> List.concat |> List.take n | |
-- Apply f to pair of lists. If lists are different | |
-- lengths, shorter list is wrapped. | |
wrapMap2: (a -> b -> c) -> List a -> List b -> List c | |
wrapMap2 f a b = | |
let n = [List.length a, List.length b] |> List.maximum |> withDefault 0 | |
in List.map2 f (wrapList n a) (wrapList n b) | |
{-- Module exposing (getShiftedStrings) --} | |
alphabet = "abcdefghijklmnopqrstuvwxyz" | |
-- Return list of integers from start to end (not including end) | |
range: Int -> Int -> List Int | |
range start end = | |
if start < end | |
then start :: (range (start + 1) end) | |
else [] | |
-- Apply function to input n times, building up a list of results | |
applyN: (a -> a) -> a -> Int -> List a | |
applyN f x n = | |
List.scanl (\_ y -> f y) x (range 0 n) | |
-- Pair elements from each of two lists | |
zip xs ys = | |
List.map2 (,) xs ys | |
-- Return True if letter, False if special character. | |
isLetter: Char -> Bool | |
isLetter char = | |
char | |
|> Char.toLower | |
|> String.fromChar | |
|> \x -> String.contains x alphabet | |
-- Return new list with each element replaced by the one that | |
-- follows it. Last element is replaced by first. | |
rshift: List a -> List a | |
rshift xs = | |
case xs of | |
head::tail -> tail ++ [head] | |
[] -> [] | |
-- Return dict where keys are from provided | |
-- given list and values from shifted list. | |
getShiftMap: List comparable -> Dict comparable comparable | |
getShiftMap xs = | |
zip xs (rshift xs) |> Dict.fromList | |
-- Dict mapping each letter of the alphabet to the next. | |
letterMap: Dict Char Char | |
letterMap = | |
let lowercase = String.toList alphabet | |
uppercase = List.map Char.toUpper lowercase | |
lowerMap = getShiftMap lowercase | |
upperMap = getShiftMap uppercase | |
in Dict.union lowerMap upperMap | |
-- Given a letter, return next letter in alphabet. | |
shiftLetter: Char -> Char | |
shiftLetter letter = | |
let shiftedLetter = Dict.get letter letterMap | |
in case shiftedLetter of | |
Just x -> x | |
Nothing -> '_' | |
-- Return next letter in alphabet unless special character. | |
shiftCharacter: Char -> Char | |
shiftCharacter char = | |
if isLetter char | |
then shiftLetter char | |
else char | |
-- Shift every letter in string forward one. | |
shiftString: String -> String | |
shiftString string = | |
String.map shiftCharacter string | |
-- Return all 26 shifted versions of string | |
getShiftedStrings: String -> List String | |
getShiftedStrings string = | |
applyN shiftString string 25 | |
commonBigrams = | |
[ "th", "he", "in", "er", "an" | |
, "re", "nd", "on", "en", "at" | |
, "ou", "ed", "ha", "to", "or" | |
, "it", "is", "hi", "es", "ng"] | |
toBigrams: String -> List String | |
toBigrams string = | |
if (String.length string) < 2 | |
then | |
[] | |
else | |
String.left 2 string :: toBigrams (String.dropLeft 1 string) | |
score string = | |
let bigrams = toBigrams string | |
nBigrams = | |
bigrams | |
|> List.length | |
|> toFloat | |
nCommonBigrams = | |
bigrams | |
|> List.filter ((flip List.member) commonBigrams) | |
|> List.length | |
|> toFloat | |
in | |
nCommonBigrams / nBigrams |> replaceNaN 0 | |
replaceNaN replacementValue x = | |
if isNaN x | |
then | |
replacementValue | |
else | |
x | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Current issue: