You are viewing a single comment's thread. Return to all comments →
Such a brilliant puzzle! I like that kind. My solution with F# is not concise at all. Full text is about 100 lines. Here is the heart without I/O:
Parsing placeholders:
let (|=>|) x (a, len) = x >= a && x <= a + len - 1 type Dir = H | V let dirShift dir = if dir = H then (1, 0) else (0, 1) let (|->) (x, y) (dx, dy) = (x + dx, y + dy) let (*) (dx, dy) n = (dx * n, dy * n) let len (s : string) = s.Length let makeTuple a b = (a, b) type Placeholder = { P : int * int; Dir : Dir; Len : int } with member p.IndexOf (x, y) = let (px, py) = p.P if p.Dir = H && y = py && x |=>| (px, p.Len) then Some (x - px) elif p.Dir = V && x = px && y |=>| (py, p.Len) then Some (y - py) else None member p.Cells = let shift = dirShift p.Dir [ for i in [0 .. p.Len - 1] -> p.P |-> (shift * i)] let parsePlaceholders lines = let parseCells = Seq.mapi (fun y s -> s |> Seq.indexed |> Seq.filter (snd >> (=) '-') |> Seq.map (fun (x, _) -> (x, y)) ) >> Seq.concat >> Set.ofSeq let cells = parseCells lines let rec extend p shift cells = let next = p |-> shift if Set.contains next <| cells then p :: extend next shift cells else [p] let dirPlaceholders dir cells = let shift = dirShift dir cells |> Set.fold (fun (chains, rest) cell -> match extend cell shift rest with | [_] -> (chains, rest) | chain -> (chain :: chains, Set.difference rest (Set.ofList chain))) ([], cells) |> fst |> List.map (fun chain -> { P = List.min chain; Dir = dir; Len = List.length chain }) (dirPlaceholders H cells) @ (dirPlaceholders V cells)
Finding a solution (just a consequent recoursive "trying" of each word for each next placeholder with checking letters in "joint" points):
type Joint = { H : Placeholder; V : Placeholder; Cell : int * int } let solveCrossword placeholders words = let findJoints placeholders = List.allPairs placeholders placeholders |> List.filter (fun (a, b) -> a.P < b.P && a.Dir <> b.Dir) |> List.fold (fun joints (a, b) -> let (h, v) = if a.Dir = H then (a, b) else (b, a) let ((hX, hY), hLen) = (h.P, h.Len) let ((vX, vY), vLen) = (v.P, v.Len) if hY |=>| (vY, vLen) && vX |=>| (hX, hLen) then { H = h; V = v; Cell = (vX, hY)} :: joints else joints) ([]) let joints = findJoints placeholders let rec findDecision alreadyPlaced placeholders words = match placeholders with | [] -> Some alreadyPlaced | ph :: restPlaceholders -> let fitJoints ph (w : string) = joints |> List.filter (fun j -> j.H = ph || j.V = ph) |> List.forall (fun j -> let c = w.[(ph.IndexOf j.Cell).Value] not (List.exists (fun (oPh : Placeholder, oW : string) -> match oPh.IndexOf j.Cell with | None -> false | Some i -> oW.[i] <> c) alreadyPlaced)) let validWords = words |> List.filter (fun w -> len w = ph.Len && fitJoints ph w) match validWords with | [] -> None | _ -> validWords |> List.choose (fun w -> let restWords = List.except [w] words findDecision ((ph, w) :: alreadyPlaced) restPlaceholders restWords) |> List.tryHead findDecision [] placeholders words
Seems like cookies are disabled on this browser, please enable them to open this website
An unexpected error occurred. Please try reloading the page. If problem persists, please contact support@hackerrank.com
Crosswords-101
You are viewing a single comment's thread. Return to all comments →
Such a brilliant puzzle! I like that kind. My solution with F# is not concise at all. Full text is about 100 lines. Here is the heart without I/O:
Parsing placeholders:
Finding a solution (just a consequent recoursive "trying" of each word for each next placeholder with checking letters in "joint" points):