Compare keyboard layouts to where your keystrokes go. http://share-elm.com/gists/1b632e6607a179b20dbd

KeyboardLayouts.elm

import Graphics.Input.Field as Field exposing
  (Content, noContent, field, defaultStyle, Direction)
import Graphics.Collage exposing (..)
import Maybe exposing (withDefault)
import Dict exposing (Dict)
import Graphics.Element as Elem exposing (..)
import Signal 
import Color exposing (..)
import String
import Window
import Text

inputString : Signal.Mailbox Content
inputString = Signal.mailbox noContent


main = Signal.map2 view Window.dimensions inputString.signal

zip = List.map2 (,)

normDict: Dict comparable Int -> Dict comparable Float
normDict dict = 
  let keys = Dict.keys dict
      values = Dict.values dict |> List.map toFloat
      max = List.maximum values |> withDefault 0 
      normedValues = List.map (rescale (0, max) (0, 1)) values
  in 
    Dict.fromList (zip keys normedValues)
    
myString = "This is a short story about a guy that I know. I hope you like it. There are lots of letters in this sentence."

view dims content = 
  let size = (toFloat (fst dims)) / 25 |> floor |> (\x -> List.minimum [40, x] |> withDefault 40)
      (w, h) = dims
      string = content.string
      letterFreqs = 
        string
        |> String.toLower
        |> String.toList
        |> List.filter (\char -> char /= ' ')
        |> frequencies
        |> normDict
      qwerty = viewKeyboard size ["qwertyuiop[]\\", "asdfghjkl;'","zxcvbnm,./"] letterFreqs
      dvorak = viewKeyboard size ["',.pyfgcrl/=\\", "aoeuidhtns-", ";qjkxbmwvz"] letterFreqs
      colemak = viewKeyboard size ["qwfpgjluy;[]\\", "arstdhneio'", "zxcvbkm,./"] letterFreqs
      layouts = 
        [ ("qwerty", qwerty)
        , ("dvorak", dvorak)
        , ("colemak", colemak)
        ]
  in 
    flow outward
      [ spacer (fst dims) (snd dims)
        |> color (hsl 192 0.62 0.17)
      , container (fst dims) (snd dims) midTop
          (flow down
          ([ field
               Field.defaultStyle
               (Signal.message inputString.address)
               "Paste some text in here to see how often each letter is typed."
               content 
               |> width ((fst dims) // 2)
               |> height 40
               |> container (fst dims) 150 middle
           ] ++
            (List.map (\(title, x) -> container w (h // 6) midTop x |> viewSection title) layouts
           )))
      ]


viewSection: String -> Element -> Element
viewSection label elem = 
  let h = heightOf elem
      w = widthOf elem
  in 
    flow down
      [ label
        |> Text.fromString
        |> Text.color white
        |> Text.height ((toFloat h) / 8)
        |> centered
        |> container w (h // 3) middle
      , elem
      ]


addSpacerX: Int -> Int -> Element -> Element
addSpacerX width height elem = flow right [(spacer width height), elem]

addSpacerY: Int -> Int -> Element -> Element
addSpacerY width height elem = flow down [(spacer width height), elem]

viewKeyboard: Int -> List String -> Dict Char Float -> Element    
viewKeyboard size rowStrings letterFreqs = 
  let rowElems = (List.map (getRowData letterFreqs >> viewRow size) rowStrings)      
      addSpacerX' = (flip addSpacerX) size
      addSpacerY' = addSpacerY size 1
  in 
    flow down
      (List.map addSpacerY'
        (List.map2 addSpacerX' [0, size // 2, size] rowElems))
    
    
getRowData: Dict Char Float -> String -> List (Char, Float)
getRowData letterFreqs row = 
  let createCharCountTuple char = 
        (char, Dict.get char letterFreqs |> withDefault 0)
  in 
    List.map createCharCountTuple (String.toList row)
    
    
viewRow: Int -> List (Char, Float) -> Element
viewRow size letterTuples = 
  flow right (List.map (viewKey' size >> addSpacerX 1 size) letterTuples)
      
  
viewKey': Int -> (Char, Float) -> Element
viewKey' size (letter, freq) = 
  let size' = toFloat size
      backgroundLightness = 0.95 --freq * 0.5 + 0.1
      complementColor = (greyscale (if backgroundLightness > 0.6 then 1 else 0))
      myStyle = (solid complementColor)
      barHeight = (freq * 0.9 * size')
  in 
    collage size size
      [ rect size' size' |> filled (hsl 4 1 backgroundLightness)
      , rect (size' / 2) barHeight
        |> filled white--outlined myStyle
        |> move (0, (-size' / 2) + (barHeight / 2))
        |> alpha 0.4
      , rect (size' / 2) barHeight
        |> outlined myStyle
        |> move (0, (-size' / 2) + (barHeight / 2))
        |> alpha 0.7        
      , letter 
        |> String.fromChar 
        |> Text.fromString 
        |> Text.color complementColor
        |> Text.height (size' / 2)
        |> leftAligned
        |> toForm
        |> alpha 0.2
      ]
  
-- Increment value, or return 1
increment: Maybe Int -> Maybe Int
increment n = 
  case n of
    Just value -> Just (value + 1)
    Nothing -> Just 1


-- Increment the chosen key is present. If absent, create key and set value to 1.
incrementKey: comparable -> Dict comparable Int -> Dict comparable Int
incrementKey key dict = 
  Dict.update key increment dict
  
  
frequencies list =
  List.foldl incrementKey Dict.empty list
  
rescale: (Float, Float) -> (Float, Float) -> Float -> Float
rescale (start1, end1) (start2, end2) x = 
  let xfactor = (end2 - start2) / (end1 - start1)
  in 
    (x - start1) * xfactor + start2