Solving Python Challenge with F# - The Chronicles

Recently I have tested my skills in Python Challenge and I definitly recommend this set of puzzles to everyone who likes quests and/or programming. Some of riddles require usage of Python standard library but others can be easily solved with arbitrary language. So my Python challenge was in fact Python/F# :)

WARNING!!! If you are going to pass through the Python challenge then stop reading this post, cause it contains solution to 24 level.

24 level meets you with this picture

Ex facte it looks like the labyrinth. Let't try to find the path, window title 'from top to bottom' contains the hint about traverse direction. Examination of the picture with a zoom reveals start and end points: 639,0 and 1,640 correspondingly.

#r "System.Drawing"

open System.Drawing

let wall = Color.FromArgb(255,255,255,255) // color of the wall
let bitmap = Image.FromFile(@"maze.png") :?> Bitmap
let findPath () = 
    let startx = 639
    let starty = 0
    let endx = 1
    let endy = 640

    let map = Array2D.zeroCreate (bitmap.Width) (bitmap.Height)
    let rec mark i x y k = 
        // out of range
        if x < 0 || x > bitmap.Width - 1 then k None
        elif y < 0 || y > bitmap.Height - 1 then k None
        // found exit
        elif x = endx && y = endy then k <| Some([x,y])
        // already visited
        elif map.[x, y] then k None
        // hit the wall
        elif bitmap.GetPixel(x, y).Equals(wall) then k None
        else
            map.[x,y] <- true
            mark (i + 1) (x - 1) y (function
                | Some(xs) -> k <| Some((x,y)::xs)
                | None -> mark (i + 1) (x + 1) y (function
                    | Some(xs) -> k <| Some((x,y)::xs)
                    | None -> mark (i + 1) x (y - 1) (function
                        | Some(xs) -> k <| Some((x,y)::xs)
                        | None -> mark (i + 1) x (y + 1) (function
                            | Some(xs) -> k <| Some((x,y)::xs)
                            | None -> k None 
                        )
                    )
                )
            )

    Option.get <| mark 1 startx starty id

To search the path we will use simple depth-first search. All visited points are marked in the map to prevent repeated visits. Algorithm itself is implemented in recursive way with continuations to avoid stack overflows.

val wall : System.Drawing.Color = Color [A=255, R=255, G=255, B=255]
val bitmap : System.Drawing.Bitmap
val findPath : unit -> (int * int) list

> #time;;

--> Timing now on

> let path = findPath ();;   
Real: 00:00:00.392, CPU: 00:00:00.390, GC gen0: 2, gen1: 2, gen2: 0

Now we have the path and no idea what to do next. Maybe we should draw it on the source labyrinth?

let copy = bitmap.Clone() :?> Bitmap
path |> List.iter(fun (x,y) -> copy.SetPixel(x,y, Color.Green))
copy.Save(@"solved.png", Imaging.ImageFormat.Png)

Impressive but useless... However as we have already noticed the picture is not monochrome, Maybe this can give us the clue? Let's walk through the path and save colours we met.

let f = System.IO.File.CreateText(@"path.txt")
path |> List.iter(fun(x,y) -> let px = bitmap.GetPixel(x,y) in f.WriteLine("{0},{1}: {2}, {3}, {4}, {5}", x, y, px.A, px.R, px.G, px.B))
f.Close()

639,0: 255, 0, 0, 0
639,1: 255, 80, 0, 0
639,2: 255, 0, 0, 0
639,3: 255, 75, 0, 0
639,4: 255, 0, 0, 0
639,5: 255, 3, 0, 0
639,6: 255, 0, 0, 0
639,7: 255, 4, 0, 0
639,8: 255, 0, 0, 0
639,9: 255, 20, 0, 0
639,10: 255, 0, 0, 0
639,11: 255, 0, 0, 0
638,11: 255, 0, 0, 0
637,11: 255, 0, 0, 0
636,11: 255, 0, 0, 0
635,11: 255, 0, 0, 0
635,12: 255, 0, 0, 0
635,13: 255, 8, 0, 0
635,14: 255, 0, 0, 0
635,15: 255, 0, 0, 0
635,16: 255, 0, 0, 0
635,17: 255, 136, 0, 0

That is definitly something! 1. Some special pixels in the path differ in the R component. 2. All these special pixels have odd both x and y coordinates. Obvious step: save R components of these pixels

let bytes = path |> Seq.filter(fun (x,y) -> x % 2 <> 0 && y % 2 <> 0) |> Seq.map(fun(x,y) -> bitmap.GetPixel(x,y).R) |> Seq.toArray
System.IO.File.WriteAllBytes(@"dmp.file", bytes)

What a surprise, result dmp.file is....zip file, after unpacking it we receive link to the next level.