Challenge 24 / 2006 / An optimal keyboard

The first problem in the 2006 EC set is as follows (a bit compressed):

Given a text containing characters in the range of 33..126 in the ASCII table ('!'..'~') and a keyboard of which keys are assigned a difficulty between 0..9 (how 'easy' is to type the given key), we should distribute the keys on the keyboard so that typing the whole text should be the easiest (sum of all keys pressed should be minimal), with an addition: only lowercase characters are on the keyboard, so typing an uppercase character means two keypress, Shift and the character itself, but for the special characters (anything non-alpha) a separate key is used. The enter, space and shift keys have to be laid out on the keyboard too (represented in the output by the lowercase 'e', 's' and 'h' characters, respectively).

In their first sample, the input layout is like this (where 'x' means that place is not used):

xx88788xxx99
9x65556x9
6x21112xx9
9x65556x9
xx88788xxx99

and the text to type is the well known nursery rhyme,

"Mary had a little lamb

whose fleece was white as snow,

and everywhere that Mary went,

the lamb was sure to go"

And the solution: with an optimal layout, the difficulty of the text is 390, and an optimal layout is:

xx,VDUGxxx|{
`xMSHRYx_
NxTsEAWxx^
]xhLeOIx\
xxFCB~}xxx[Z

let's define a type 'Key' as:

type Key = 
    | Character of char
    | Shift
    | Enter
    | Space

Now we should read the layout and the text.
The input layout we're representing as a 'int option list list' - the outer list will be the rows of the keys, the inner list the key themselves, where Some(int) will represent a digit found in the layout file, and None would be the 'x' (non-used key):

let toDigit ch = if System.Char.IsDigit ch then Some(int ch - 48) else None
let parseLayout layoutLines = 
    let parseLine line = line |> Seq.map toDigit |> Seq.toList
    layoutLines |> Seq.map parseLine |> Seq.toList

The text we're going to represent as a sequence of keypresses - what the user would type in (e.g. 'a' will be represented as ['A'], and 'A' as [Shift, 'A']):

let parseText textLines : Key seq = 
    let parseChar ch = 
        match ch with
        | c when System.Char.IsLower c -> [Character(System.Char.ToUpper(c))]
        | c when System.Char.IsUpper c -> [Shift; Character(c)]
        | ' ' -> [Space]
        | c -> [Character(c)]
    let parseLine textLine = [Enter] |> Seq.append (textLine |> Seq.collect parseChar)
    textLines |> Seq.collect parseLine

To get an optimal layout, we're going to count how many times each key is to be pressed, sorted by the count, in decreasing order (most pressed first). We also need the weights, in increasing order, but only the same amount of them as the number of individual keys pressed by the user. We're going to merge these sequences into triplets of weight, key and count:

let weightsKeysCounts weightLayout text = 
    let charTypeNumber = text |> Seq.distinct |> Seq.length
    let significantWeights = weightLayout |> List.concat |> List.choose id |> List.sort |> Seq.take charTypeNumber
    let (keys, counts) = text |> Seq.countBy id |> Seq.sortBy snd |> Seq.toList |> List.rev |> List.unzip
    Seq.zip3 significantWeights keys counts

These triplets are actually representing the optimal layout - the keys that are pressed the most will be associated with the positions of the lowest difficulties and vice versa. To calculate the total cost we only need to sum the product of each lines' weight and count:

let wkc = weightsKeysCounts weightLayout text
let fullCost = wkc |> Seq.map (fun (w,_,c) -> w*c) |> Seq.reduce (+)

We also need to generate an optimal layout - we're doing it by iterating through the original weight-layout line-by-line, and replacing each weight by a key of that weight The function transforming a line of original layout:

let rec transform input output unusedKeys = 
    match input with
    | Some(weight) :: tail  -> match Map.tryFind weight unusedKeys with
                               | Some(key :: keysTail) -> transform tail (Some(key)::output) (unusedKeys |> Map.remove weight |> Map.add weight keysTail)
                               | Some([]) | None   -> transform tail (None::output) unusedKeys
    | None :: tail          -> transform tail (None::output) unusedKeys
    | []                    -> output |> List.rev, unusedKeys

And to apply it to all rows of the original layout, we're using the fold operation, using the already transformed lines and the still unused keys as intermediate state:

weightLayout 
|> List.fold (fun (output, unusedKeys) input -> let o, uuk = transform input List.empty unusedKeys in (o::output, uuk)) (List.empty, keysByWeight)
|> fst |> List.rev 

(in the last code line we had to reverse the list as we've accumulated the lines by always consing the new line to the head of the accumulated list). The only thing missing is to create the keysByWeight map, containing by weight the list of all keys:

let keysByWeight = wkc |> Seq.map (fun (w,k,_) -> w,k) |> Seq.groupBy fst |> Map.ofSeq |> Map.map (fun _ kvps -> kvps |> Seq.map snd |> Seq.toList)

The rest is only housekeeping (giving some structure, pretty printing, etc.) The complete code is: (and can also be found at http://github.com/sztupi/ch24/tree/master/ch24_2006/):

type Key = 
    | Character of char
    | Shift
    | Enter
    | Space

let toChar key = 
    match key with
    | Some(Character(c)) -> c
    | Some(Shift) -> 'h'
    | Some(Enter) -> 'e'
    | Some(Space) -> 's'
    | None -> 'x'

let solve input = 
    let toDigit ch = if System.Char.IsDigit ch then Some(int ch - 48) else None

    let parse (lines:string []) = 
        let layoutLines = System.Int32.Parse(lines.[0])

        let parseLayout layoutLines = 
            let parseLine line = line |> Seq.map toDigit |> Seq.toList
            layoutLines |> Seq.map parseLine |> Seq.toList

        let parseText textLines : Key seq = 
            let parseChar ch = 
                match ch with
                | c when System.Char.IsLower c -> [Character(System.Char.ToUpper(c))]
                | c when System.Char.IsUpper c -> [Shift; Character(c)]
                | ' ' -> [Space]
                | c -> [Character(c)]
            let parseLine textLine = [Enter] |> Seq.append (textLine |> Seq.collect parseChar)
            textLines |> Seq.collect parseLine
            
        (parseLayout lines.[1..layoutLines], parseText lines.[layoutLines+1..])

    let weightsKeysCounts weightLayout text = 
        let charTypeNumber = text |> Seq.distinct |> Seq.length
        let significantWeights = weightLayout |> List.concat |> List.choose id |> List.sort |> Seq.take charTypeNumber
        let (keys, counts) = text |> Seq.countBy id |> Seq.sortBy snd |> Seq.toList |> List.rev |> List.unzip
        Seq.zip3 significantWeights keys counts

    let createLayout weightLayout keysByWeight =
        let rec transform input output unusedKeys = 
            match input with
            | Some(weight) :: tail  -> match Map.tryFind weight unusedKeys with
                                       | Some(key :: keysTail) -> transform tail (Some(key)::output) (unusedKeys |> Map.remove weight |> Map.add weight keysTail)
                                       | Some([]) | None   -> transform tail (None::output) unusedKeys
            | None :: tail          -> transform tail (None::output) unusedKeys
            | []                    -> output |> List.rev, unusedKeys

        weightLayout 
        |> List.fold (fun (output, unusedKeys) input -> let o, uuk = transform input List.empty unusedKeys in (o::output, uuk)) (List.empty, keysByWeight) 
        |> fst |> List.rev 

    let toString layout = 
        System.String.Join(System.Environment.NewLine, 
            (layout |> List.length |> sprintf "%d") :: (layout |> List.map (fun l -> new System.String(l |> List.map toChar |> List.toArray)) |> List.map (sprintf "%s")))

    let weightLayout, text = input |> parse
    let wkc = weightsKeysCounts weightLayout text
    let fullCost = wkc |> Seq.map (fun (w,_,c) -> w*c) |> Seq.reduce (+)
    let keysByWeight = wkc |> Seq.map (fun (w,k,_) -> w,k) |> Seq.groupBy fst |> Map.ofSeq |> Map.map (fun _ kvps -> kvps |> Seq.map snd |> Seq.toList)
    fullCost, toString (createLayout weightLayout keysByWeight)

open System.IO
['0'..'9'] 
|> List.iter (fun n -> 
    let inputFile = sprintf @"..\..\..\problem_set\2006\inputs\A-%s.in" (n.ToString())
    let answerFile = sprintf @"..\..\..\problem_set\2006\outputs\A-%s.ans" (n.ToString())
    let cost, layout = File.ReadAllLines inputFile |> solve
    printfn "--- solution %s ---" (n.ToString())
    printfn "%d" cost
    printfn "%s" layout
    printfn "--- answer %s ---" (n.ToString())
    printfn "%s" (File.ReadAllText answerFile))