6
\$\begingroup\$

I'm trying to solve the following Advent of Code problem in F# for practice.

Description of problem (can be found here):

Basically, there's a 'key pad' that I need to figure the combination to. To do that, I have to follow instructions in the form 'U'/'D'/'L'/'R' to move a key up, down, left, or right in a gird of keys (see puzzleInput below). A newline means to take down the number I'm currently on and record it. I am bounded to the grid (eg. if I'm on the upper edge I can't move any more if the instruction was 'U'). The challenge is in 2 parts, in the first part the keypad is a 3x3 numerical grid (1..9). In the second part the keypad is a diamond shaped 5x5 alphanumeric grid (1..9, A, B, C, D) - movement is constrained to the diamond shape.

My attempt:

open System
open System.IO

// possible instructions, halt means to 'take down current number'
type Instruction = 
  | Up
  | Down
  | Right
  | Left
  | Halt

// helper method used later
let getLastElementOf seq = 
  seq |> List.rev |> List.head  

// method to get code, see sample input below
let GetCode rawInput keyPadButtons startPos = 

  let parse (rawInput:string) :List<Instruction> = 
    rawInput.ToCharArray()
    |> Seq.map (function 
                | 'U' -> Up
                | 'D' -> Down
                | 'R' -> Right
                | 'L' -> Left
                | '\n' -> Halt
                | _ -> failwith "Unexpected token.")
    |> (fun x ->  Seq.toList x @ [Halt])

  // used to enforce grid bounds, method used by followOne
  let validate pos fallbackPos (tdarr:List<List<char>>)  = 
    try 
      if tdarr.[fst pos].[snd pos] <> ' '  //I'm using ' ' as a padding 
      then pos
      else fallbackPos
    with
    | e -> fallbackPos

  // follows one instruction, method used by followAll
  let followOne (grid:List<List<char>>) (pos:int * int) (instruction:Instruction) :int * int =
    validate (match instruction with
              | Up -> fst pos - 1 , snd pos
              | Down -> fst pos + 1, snd pos
              | Right -> fst pos, snd pos + 1
              | Left -> fst pos, snd pos - 1
              | _ -> failwith "Unknown instructon.") pos grid

  // follow all instructions & produce result
  let followAll (keyPadButtons:List<List<char>>) (instructions:List<Instruction>) :string = 
    instructions
    |> Seq.mapFold (fun state instruction -> 
                    "", (
                         if instruction = Halt 
                         then fst state, 
                              snd state + keyPadButtons
                                          .[fst (getLastElementOf (fst state))]
                                          .[snd (getLastElementOf (fst state))].ToString()
                         else fst state
                              @[followOne keyPadButtons (getLastElementOf (fst state)) instruction], 
                              snd state
                        )
                    ) ([startPos], "")
    |> snd |> snd

  rawInput
  |> parse
  |> followAll keyPadButtons

[<EntryPoint>]
let main argv = 

  let puzzleInput = "DLUUULUDLRDDLLLUDULLULLRUURURLUULDUUUDLDDRUDLUULLRLDDURURDDRDRDLDURRURDLDUURULDDULDRDDLDLDLRDRUURLDLUDDDURULRLLLLRLULLUDRDLDUURDURULULULRLULLLULURLRDRDDDDDDDLRLULUULLULURLLDLRLUDULLDLLURUDDLDULDLULDDRLRLRDDLRURLLLURRLDURRDLLUUUUDRURUULRLDRRULLRUDLDRLUDRDRDRRDDURURRDRDRUDURDLUDRUDLRRULDLRDDRURDDUUDLDRDULDDRRURLLULRDRURLRLDLLLUULUUDLUDLDRRRRDUURULDUDUDRLDLLULLLRDDDDDLRDDLLUULLRRRDURLRURDURURLUDRRLRURDRDRRRRULUDLDRDULULRUDULLLUDRRLRLURDDURULDUUDULLURUULRDRDULRUUUDURURDDRRUDURRLRDRULRUUU
LDRURRUUUULDRDDDLLULDRUDDRLLDLDRDLRUDDDLDDULULULLRULDUDRRDLRUURURDRURURDLLRUURDUUDRLDURDRDLRRURURDUUUURUURRLLLDRDUURRRRURULUUUDLUDDRUURRLDULRDULRRRRUDURRLURULRURRDRDLLDRRDUDRDURLDDRURULDRURUDDURDLLLUURRLDRULLURDRDRLDRRURRLRRRDDDDLUDLUDLLDURDURRDUDDLUDLRULRRRDRDDLUDRDURDRDDUURDULRRULDLDLLUDRDDUDUULUDURDRLDURLRRDLDDLURUDRLDUURLLRLUDLLRLDDUDLLLRRRLDLUULLUDRUUDRLDUUUDUURLRDDDDRRDRLDDRDLUDRULDDDRDUULLUUUUULDULRLLLRLLDULRDUDDRDDLRRLRDDULLDURRRURDDUDUDDRLURRLUUUULLDRDULUUDRDULDLLUDLURDLLURRDLUULURRULRLURRRRRUURDDURLRLLDDLRRDUUURDRDUDRDDDLLDDRDRRRLURRDUULULULULRRURDDLDDLLLRUDDDDDDLLLRDULURULLRLRDRR
DDRLLLDLRRURRDLDDRUURRURRLRRRRUURUURDLURRRDDLRUDRURLUURLLRRLRLURLURURDULLLLDLRURULUUDURRLULRDRDRRDDLLULRLUDLUUUDRLLRRURRLDULDDLRRLUUUUDDLRLDRLRRDRDLDDURDDRDDLDLURLRRRDDUDLLRLRLURRRRULLULLLLDRLDULDLLDULRLDRDLDDRRDDDDRUDRLLURULRLDDLLRRURURDDRLLLULLULDDRDLDDDLRLLDRLDRUURRULURDDRLULLDUURRULURUUDULLRUDDRRLLDLLRDRUDDDDLLLDDDLLUUUULLDUUURULRUUDUUUDDLDURLDRDRRLLUDULDLUDRLLLDRRRULUUDDURUDRLUDDRRLLDUDUURDDRURLUURDURURURRUUDUDDLLLDRRRURURRURDLRULLDUDRLRLLRUDRUDLR
RRRDRLRURLRRLUURDRLDUURURLRDRRUDLLUUDURULLUURDLLDRRLURRUDUUDRRURLRRDULLDDLRRRUDUUDUUDLDDDLUUDLDULDDULLDUUUUDDUUDUDULLDDURRDLRRUDUDLRDUULDULRURRRLDLLURUDLDDDRRLRDURDLRRLLLRUDLUDRLLLRLLRRURUDLUDURLDRLRUDLRUULDRULLRLDRDRRLDDDURRRUDDDUDRRDRLDDRDRLLRLLRDLRDUDURURRLLULRDRLRDDRUULRDDRLULDLULURDLRUDRRDDDLDULULRDDRUDRLRDDRLDRDDRRRDUURDRLLDDUULRLLLULLDRDUDRRLUUURLDULUUURULLRLUDLDDLRRDLLRDDLRDRUUDURDDLLLDUUULUUDLULDUDULDRLRUDDURLDDRRRDLURRLLRRRUDDLDDRURDUULRUURDRRURURRRUUDUDULUDLUDLLLUUUULRLLRRRRDUDRRDRUDURLUDDLDRDLDDRULLRRULDURUL
DLLLRDDURDULRRLULURRDULDLUDLURDDURRLLRRLLULRDLDRDULRLLRDRUUULURRRLLRLDDDRDRRULDRRLLLLDLUULRRRURDDRULLULDDDLULRLRRRUDRURULUDDRULDUDRLDRRLURULRUULLLRUURDURLLULUURUULUUDLUDLRRULLLRRLRURDRRURDRULRURRUDUDDDRDDULDLURUDRDURLDLDLUDURLLRUULLURLDDDURDULRLUUUDLLRRLLUURRDUUDUUDUURURDRRRRRRRRRUDULDLULURUDUURDDULDUDDRDDRDRLRUUUUDLDLRDUURRLRUUDDDDURLRRULURDUUDLUUDUUURUUDRURDRDDDDULRLLRURLRLRDDLRUULLULULRRURURDDUULRDRRDRDLRDRRLDUDDULLDRUDDRRRD"

  let part1Code = GetCode puzzleInput [ [' '; ' '; ' '; ' '; ' '];
                                        [' '; '1'; '2'; '3'; ' '];
                                        [' '; '4'; '5'; '6'; ' ']; 
                                        [' '; '7'; '8'; '9'; ' ']; 
                                        [' '; ' '; ' '; ' '; ' '] ] (2, 2)

  let part2Code = GetCode puzzleInput [ [' '; ' '; ' '; ' '; ' '; ' '; ' '];
                                        [' '; ' '; ' '; '1'; ' '; ' '; ' '];
                                        [' '; ' '; '2'; '3'; '4'; ' '; ' '];
                                        [' '; '5'; '6'; '7'; '8'; '9'; ' '];
                                        [' '; ' '; 'A'; 'B'; 'C'; ' '; ' '];
                                        [' '; ' '; ' '; 'D'; ' '; ' '; ' '];
                                        [' '; ' '; ' '; ' '; ' '; ' '; ' ']] (3, 1)

  printfn "Part 1: %A, Part 2: %A" part1Code part2Code

This code yields the correct answers required by the challenge. The problem is I think it is too verbose (I'm doing this to learn clean code) and honestly I think there must be a better way to do most things that I haven't considered. Feedback on how to shorten (DRY) this code and to make it more readable is appreciated.

\$\endgroup\$

2 Answers 2

1
\$\begingroup\$

As a late review I have the following comments:

 let getLastElementOf seq = seq |> List.rev |> List.head 

What's wrong with seq |> List.last?

You use a lot of fst and snd to reach tuple values, instead you could do:

 let validate (x, y) fallbackPos (tdarr:List<List<char>>)  = 
try 
  if tdarr.[x].[y] <> ' '  //I'm using ' ' as a padding 
  then (x, y)
  else fallbackPos
with
| e -> fallbackPos

To me it is much cleaner.

IMO the type definition of Instructions do more damage than good resulting in an unnecessary double match in parse and followOne.

I think it's a good idea to extent the keypad and use it for validation of a step.

My solution would be something like below. The concept is to think of the keypad as a coordinate system and then convert the result point of each instruction sequence to a key in the pad:

module Program
open System

let squarePad = [[' '; ' '; ' '; ' '; ' '];
                 [' '; '1'; '2'; '3'; ' '];
                 [' '; '4'; '5'; '6'; ' ']; 
                 [' '; '7'; '8'; '9'; ' ']; 
                 [' '; ' '; ' '; ' '; ' '] ]

let diamondPad = [[' '; ' '; ' '; ' '; ' '; ' '; ' '];
                  [' '; ' '; ' '; '1'; ' '; ' '; ' '];
                  [' '; ' '; '2'; '3'; '4'; ' '; ' '];
                  [' '; '5'; '6'; '7'; '8'; '9'; ' '];
                  [' '; ' '; 'A'; 'B'; 'C'; ' '; ' '];
                  [' '; ' '; ' '; 'D'; ' '; ' '; ' '];
                  [' '; ' '; ' '; ' '; ' '; ' '; ' ']]

let isValid (pad: char list list) = fun x y -> pad.[y].[x] <> ' '   // Checks if a field in the keypad has a value
let toKey (pad: char list list) = fun (x, y) -> pad.[y].[x]         // Converts a coordinate set to the key in the pad

// The main function for the pad walk
let doTheWalk (input: string) (pos: int * int) isValid toKey  = 
    // Move or hold according to the validation of the new position
    let move (x, y) instr = 
        let x1, y1 = match instr with
                     | 'L' -> x - 1, y
                     | 'R' -> x + 1, y
                     | 'U' -> x, y - 1
                     | 'D' -> x, y + 1
                     | _ -> x, y // Ignoring what ever invalid input
        match isValid x1 y1 with
        | true -> x1, y1
        | false -> x, y

    // Accumulating the resulting position through an instruction sequence 
    let parse pos instr = 
        let result = instr |> Seq.fold move pos
        result, result // The result of the move is both the current accumulated state and the current mapping result

    // The input is considered to be a string with line breaks defining each instruction sequence
    input.Split('\n') 
    |> Seq.mapFold (fun curPos instr -> instr |> parse curPos) pos // Maps each char in an instruction line to a new position with the "folded" position from the previous instruction as base
    |> fst // Use the sequence of points calculated in the mapFold above to...  
    |> Seq.mapFold(fun str pos -> str, sprintf "%s%c" str (toKey pos)) "" // ... convert to a key in the pad and finally concat them to a string
    |> snd // Returns the folded string with end key for each instruction line

// Starter function
let doMySolution input = 

    let squareResult = 
        doTheWalk 
            input (2, 2) 
            (isValid squarePad)
            (toKey squarePad)

    let diamondResult = 
        doTheWalk 
            input (3, 1) 
            (isValid diamondPad)
            (toKey diamondPad)

    printfn "Square: %A\tDiamond: %A" squareResult diamondResult

[<EntryPoint>]
let main argv = 

    let input = "ULL\nRRDDD\nLURDL\nUUUUD"
    let puzzleInput = "DLUUULUDLRDDLLLUDULLULLRUURURLUULDUUUDLDDRUDLUULLRLDDURURDDRDRDLDURRURDLDUURULDDULDRDDLDLDLRDRUURLDLUDDDURULRLLLLRLULLUDRDLDUURDURULULULRLULLLULURLRDRDDDDDDDLRLULUULLULURLLDLRLUDULLDLLURUDDLDULDLULDDRLRLRDDLRURLLLURRLDURRDLLUUUUDRURUULRLDRRULLRUDLDRLUDRDRDRRDDURURRDRDRUDURDLUDRUDLRRULDLRDDRURDDUUDLDRDULDDRRURLLULRDRURLRLDLLLUULUUDLUDLDRRRRDUURULDUDUDRLDLLULLLRDDDDDLRDDLLUULLRRRDURLRURDURURLUDRRLRURDRDRRRRULUDLDRDULULRUDULLLUDRRLRLURDDURULDUUDULLURUULRDRDULRUUUDURURDDRRUDURRLRDRULRUUU\n"
                    + "LDRURRUUUULDRDDDLLULDRUDDRLLDLDRDLRUDDDLDDULULULLRULDUDRRDLRUURURDRURURDLLRUURDUUDRLDURDRDLRRURURDUUUURUURRLLLDRDUURRRRURULUUUDLUDDRUURRLDULRDULRRRRUDURRLURULRURRDRDLLDRRDUDRDURLDDRURULDRURUDDURDLLLUURRLDRULLURDRDRLDRRURRLRRRDDDDLUDLUDLLDURDURRDUDDLUDLRULRRRDRDDLUDRDURDRDDUURDULRRULDLDLLUDRDDUDUULUDURDRLDURLRRDLDDLURUDRLDUURLLRLUDLLRLDDUDLLLRRRLDLUULLUDRUUDRLDUUUDUURLRDDDDRRDRLDDRDLUDRULDDDRDUULLUUUUULDULRLLLRLLDULRDUDDRDDLRRLRDDULLDURRRURDDUDUDDRLURRLUUUULLDRDULUUDRDULDLLUDLURDLLURRDLUULURRULRLURRRRRUURDDURLRLLDDLRRDUUURDRDUDRDDDLLDDRDRRRLURRDUULULULULRRURDDLDDLLLRUDDDDDDLLLRDULURULLRLRDRR\n"
                    + "DDRLLLDLRRURRDLDDRUURRURRLRRRRUURUURDLURRRDDLRUDRURLUURLLRRLRLURLURURDULLLLDLRURULUUDURRLULRDRDRRDDLLULRLUDLUUUDRLLRRURRLDULDDLRRLUUUUDDLRLDRLRRDRDLDDURDDRDDLDLURLRRRDDUDLLRLRLURRRRULLULLLLDRLDULDLLDULRLDRDLDDRRDDDDRUDRLLURULRLDDLLRRURURDDRLLLULLULDDRDLDDDLRLLDRLDRUURRULURDDRLULLDUURRULURUUDULLRUDDRRLLDLLRDRUDDDDLLLDDDLLUUUULLDUUURULRUUDUUUDDLDURLDRDRRLLUDULDLUDRLLLDRRRULUUDDURUDRLUDDRRLLDUDUURDDRURLUURDURURURRUUDUDDLLLDRRRURURRURDLRULLDUDRLRLLRUDRUDLR\n"
                    + "RRRDRLRURLRRLUURDRLDUURURLRDRRUDLLUUDURULLUURDLLDRRLURRUDUUDRRURLRRDULLDDLRRRUDUUDUUDLDDDLUUDLDULDDULLDUUUUDDUUDUDULLDDURRDLRRUDUDLRDUULDULRURRRLDLLURUDLDDDRRLRDURDLRRLLLRUDLUDRLLLRLLRRURUDLUDURLDRLRUDLRUULDRULLRLDRDRRLDDDURRRUDDDUDRRDRLDDRDRLLRLLRDLRDUDURURRLLULRDRLRDDRUULRDDRLULDLULURDLRUDRRDDDLDULULRDDRUDRLRDDRLDRDDRRRDUURDRLLDDUULRLLLULLDRDUDRRLUUURLDULUUURULLRLUDLDDLRRDLLRDDLRDRUUDURDDLLLDUUULUUDLULDUDULDRLRUDDURLDDRRRDLURRLLRRRUDDLDDRURDUULRUURDRRURURRRUUDUDULUDLUDLLLUUUULRLLRRRRDUDRRDRUDURLUDDLDRDLDDRULLRRULDURUL\n"
                    + "DLLLRDDURDULRRLULURRDULDLUDLURDDURRLLRRLLULRDLDRDULRLLRDRUUULURRRLLRLDDDRDRRULDRRLLLLDLUULRRRURDDRULLULDDDLULRLRRRUDRURULUDDRULDUDRLDRRLURULRUULLLRUURDURLLULUURUULUUDLUDLRRULLLRRLRURDRRURDRULRURRUDUDDDRDDULDLURUDRDURLDLDLUDURLLRUULLURLDDDURDULRLUUUDLLRRLLUURRDUUDUUDUURURDRRRRRRRRRUDULDLULURUDUURDDULDUDDRDDRDRLRUUUUDLDLRDUURRLRUUDDDDURLRRULURDUUDLUUDUUURUUDRURDRDDDDULRLLRURLRLRDDLRUULLULULRRURURDDUULRDRRDRDLRDRRLDUDDULLDRUDDRRRD"


    doMySolution input

    printfn "END"
    Console.ReadLine() |> ignore
    0
\$\endgroup\$
2
\$\begingroup\$

That was a fun exercise. Sorry if this isn't much help, but I'll post my approach here, since it at least has the advantage of being contrasting. It's late afternoon, and I didn't feel like thinking, so I thought I'd let the type system do the work.

In order to do that, I first defined these types:

type Instruction = Up | Down | Left | Right

type Key = One | Two | Three | Four | Five | Six | Seven | Eight | Nine

The reason for that is that I could now define a function with the type Key -> Instruction -> Key using pattern matching without having to think hard about the problem. Not only that, but I get compile-time checking that I've handled all possible combinations:

// Key -> Instruction -> Key
let nextKey current instruction =
    match current, instruction with
    | One, Up      -> One
    | One, Down    -> Four
    | One, Left    -> One
    | One, Right   -> Two
    | Two, Up      -> Two
    | Two, Down    -> Five
    | Two, Left    -> One
    | Two, Right   -> Three
    | Three, Up    -> Three
    | Three, Down  -> Six
    | Three, Left  -> Two
    | Three, Right -> Three
    | Four, Up     -> One
    | Four, Down   -> Seven
    | Four, Left   -> Four
    | Four, Right  -> Five
    | Five, Up     -> Two
    | Five, Down   -> Eight
    | Five, Left   -> Four
    | Five, Right  -> Six
    | Six, Up      -> Three
    | Six, Down    -> Nine
    | Six, Left    -> Five
    | Six, Right   -> Six
    | Seven, Up    -> Four
    | Seven, Down  -> Seven
    | Seven, Left  -> Seven
    | Seven, Right -> Eight
    | Eight, Up    -> Five
    | Eight, Down  -> Eight
    | Eight, Left  -> Seven
    | Eight, Right -> Nine
    | Nine, Up     -> Six
    | Nine, Down   -> Nine
    | Nine, Left   -> Eight
    | Nine, Right  -> Nine

Okay, so it's a little verbose, but it was trivial to write. It also included the benefit that I got to write Seven, Up as part of a regular piece of code ;)

Assuming that I'm going to read in my instructions text file and split it on newlines, I'll first write a function that finds the ultimate key by following the instructions from a previous key:

// Key -> seq<Instruction> -> Key
let follow startValue = Seq.fold nextKey startValue

This is simply a left fold over a sequence of Instruction values, using nextKey as the aggregator.

Likewise, you can scan an array of lines using the follow function:

// #seq<Instruction> [] -> Key []
let followAll instructions = instructions |> Array.scan follow Five |> Array.tail

This functions takes an array of Instruction sequences (one for each line), and scans it using the follow function for each line, using Five as the initial seed.

Since Array.scan also returns the initial state (Five), the function only returns the tail.

Finally, you'll need to parse the input string:

// char -> Instruction
let parseChar = function
    | 'U' -> Up
    | 'D' -> Down
    | 'L' -> Left
    | 'R' -> Right
    | c   -> invalidArg "arg1" (sprintf "Unexpected character: %c." c)

// string -> seq<Instruction> []    
let parse (s : string) =
    let lines = s.Split [|'\n'|]
    Array.map (Seq.map parseChar) lines

The parseChar function throws an exception if the character isn't one of 'U', 'D', 'L', or 'R'. It'd be more functional to return either a Maybe (option) or an Either value, but for a single-use script I thought this was okay.

You can now take your input string and compose it with parse and followAll, like this:

input |> parse |> followAll

This expression returns an array of Key values. I'll leave it as an exercise to translate back to a string of numbers, if that's required.

\$\endgroup\$
2
  • \$\begingroup\$ That solution is definitely concise & readable except for the huge match. The challenge also had a 'part 2' where you take on a keypad with a completely different scheme (diamond shaped) so it would be a bit tedious to have to re-write the match that whenever the keypad changes. Though I have to admit that's a pretty impressive usage of the type system. \$\endgroup\$
    – user124336
    Commented Dec 14, 2016 at 22:14
  • 1
    \$\begingroup\$ @Biarity Quite the opposite, I found the second part trivial to solve exactly due to the fast that I solved the first part similar to what Mark did. You just make a different match function, and all the rest still holds. If you needed to solve it for arbitrary field form, it will be relatively straightforward to replace manual match by a data structure with links between cells. \$\endgroup\$ Commented Dec 17, 2016 at 19:18

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.