patrick/mystery-hunt-2023-reactivation
1
0
Fork 0
mirror of https://github.com/Smaug123/mystery-hunt-2023-reactivation synced 2025-10-10 06:58:42 +00:00
Code Issues Packages Projects Releases Wiki Activity

Format

Browse Source
This commit is contained in:
Smaug123
2023-01-16 13:48:06 +00:00
parent 9697bb5311
commit 3973c5eaff
6 changed files with 171 additions and 121 deletions
Download Patch File Download Diff File Expand all files Collapse all files

12
.config/dotnet-tools.json Normal file
View File

@@ -0,0 +1,12 @@
{
"version": 1,
"isRoot": true,
"tools": {
"fantomas": {
"version": "5.2.0-alpha-010",
"commands": [
"fantomas"
]
}
}
}

41
.editorconfig Normal file
View File

@@ -0,0 +1,41 @@
root=true
[*]
charset=utf-8
end_of_line=crlf
trim_trailing_whitespace=true
insert_final_newline=true
indent_style=space
indent_size=4
# ReSharper properties
resharper_xml_indent_size=2
resharper_xml_max_line_length=100
resharper_xml_tab_width=2
[*.{csproj,fsproj,sqlproj,targets,props,ts,tsx,css,json}]
indent_style=space
indent_size=2
[*.{fs,fsi}]
fsharp_bar_before_discriminated_union_declaration=true
fsharp_space_before_uppercase_invocation=true
fsharp_space_before_class_constructor=true
fsharp_space_before_member=true
fsharp_space_before_colon=true
fsharp_space_before_semicolon=true
fsharp_multiline_block_brackets_on_same_column=true
fsharp_newline_between_type_definition_and_members=true
fsharp_align_function_signature_to_indentation=true
fsharp_alternative_long_member_definitions=true
fsharp_multi_line_lambda_closing_newline=true
fsharp_experimental_keep_indent_in_branch=true
fsharp_max_value_binding_width=80
fsharp_max_record_width=0
max_line_length=120
end_of_line=lf
[*.{appxmanifest,build,dtd,nuspec,xaml,xamlx,xoml,xsd}]
indent_style=space
indent_size=2
tab_width=2

8
Reactivation.Test/TestSeq.fs
View File

@@ -14,8 +14,8 @@ module TestSeq =
let prop (i : int) (s : int list) = let prop (i : int) (s : int list) =
let s = i :: s let s = i :: s
Seq.rangeOrZero s let actual = Seq.rangeOrZero s
|> (=) (Seq.max s - Seq.min s) let expected = Seq.max s - Seq.min s
expected = actual
prop prop |> Check.QuickThrowOnFailure
|> Check.QuickThrowOnFailure

57
Reactivation/BondSet.fs
View File

@@ -2,9 +2,7 @@ namespace Reactivation
open System.Collections.Immutable open System.Collections.Immutable
type BondSet = type BondSet = private | BondSet of ((int * int) * (int * int)) ImmutableHashSet
private
| BondSet of ((int * int) * (int * int)) ImmutableHashSet
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module BondSet = module BondSet =
@@ -12,56 +10,51 @@ module BondSet =
let addIfOk ((sourceX, sourceY) as source) ((destX, destY) as dest) (BondSet bonds) : BondSet option = let addIfOk ((sourceX, sourceY) as source) ((destX, destY) as dest) (BondSet bonds) : BondSet option =
let distance = abs (sourceX - destX) + abs (sourceY - destY) let distance = abs (sourceX - destX) + abs (sourceY - destY)
if distance = 2 then if distance = 2 then
// Check the other // Check the other
if sourceX < destX && sourceY < destY then if sourceX < destX && sourceY < destY then
if bonds.Contains (sort (sourceX + 1, sourceY) (sourceX, sourceY + 1)) then if bonds.Contains (sort (sourceX + 1, sourceY) (sourceX, sourceY + 1)) then
None None
else else
bonds.Add (sort source dest) bonds.Add (sort source dest) |> BondSet |> Some
|> BondSet
|> Some
elif sourceX > destX && sourceY > destY then elif sourceX > destX && sourceY > destY then
if bonds.Contains (sort (sourceX - 1, sourceY) (sourceX, sourceY - 1)) then if bonds.Contains (sort (sourceX - 1, sourceY) (sourceX, sourceY - 1)) then
None None
else else
bonds.Add (sort source dest) bonds.Add (sort source dest) |> BondSet |> Some
|> BondSet
|> Some
elif sourceX < destX then elif sourceX < destX then
if bonds.Contains (sort (sourceX, sourceY - 1) (sourceX + 1, sourceY)) then if bonds.Contains (sort (sourceX, sourceY - 1) (sourceX + 1, sourceY)) then
None None
else else
bonds.Add (sort source dest) bonds.Add (sort source dest) |> BondSet |> Some
|> BondSet else if bonds.Contains (sort (sourceX - 1, sourceY) (sourceX, sourceY + 1)) then
|> Some None
else else
if bonds.Contains (sort (sourceX - 1, sourceY) (sourceX, sourceY + 1)) then bonds.Add (sort source dest) |> BondSet |> Some
None
else
bonds.Add (sort source dest)
|> BondSet
|> Some
else else
if distance <> 1 then failwith "bad assumption" if distance <> 1 then
bonds.Add (sort source dest) failwith "bad assumption"
|> BondSet
|> Some bonds.Add (sort source dest) |> BondSet |> Some
let empty = BondSet ImmutableHashSet.Empty let empty = BondSet ImmutableHashSet.Empty
let directionList (BondSet s) = let directionList (BondSet s) =
let rec go (acc : _ list) (start : int * int) (s : ImmutableHashSet<_>) = let rec go (acc : _ list) (start : int * int) (s : ImmutableHashSet<_>) =
if s.IsEmpty then List.rev (start :: acc) else if s.IsEmpty then
let next, toRem = List.rev (start :: acc)
s else
|> Seq.choose (fun (p1, p2) -> let next, toRem =
if p1 = start then Some (p2, (p1, p2)) s
elif p2 = start then Some (p1, (p1, p2)) |> Seq.choose (fun (p1, p2) ->
else None if p1 = start then Some (p2, (p1, p2))
) elif p2 = start then Some (p1, (p1, p2))
|> Seq.exactlyOne else None
go (start :: acc) next (s.Remove toRem) )
|> Seq.exactlyOne
go (start :: acc) next (s.Remove toRem)
go [] (0, 0) s go [] (0, 0) s

148
Reactivation/Program.fs
View File

@@ -44,19 +44,21 @@ module Program =
|> List.pairwise |> List.pairwise
|> List.map (fun (start, next) -> |> List.map (fun (start, next) ->
let instruction = let instruction =
[1..4] [ 1..4 ]
|> List.filter (fun i -> |> List.filter (fun i -> start.[i - 1] <> next.[i - 1])
start.[i - 1] <> next.[i - 1]
)
|> List.exactlyOne |> List.exactlyOne
|> enum<Instruction> |> enum<Instruction>
start, instruction start, instruction
) )
let restrict (board : IReadOnlyDictionary<int * int, string>) = let restrict (board : IReadOnlyDictionary<int * int, string>) =
if Seq.rangeOrZero (board.Keys |> Seq.map snd) > 5 then false if Seq.rangeOrZero (board.Keys |> Seq.map snd) > 5 then
elif Seq.rangeOrZero (board.Keys |> Seq.map fst) > 7 then false false
else true elif Seq.rangeOrZero (board.Keys |> Seq.map fst) > 7 then
false
else
true
let rec go let rec go
(currX : int) (currX : int)
@@ -66,78 +68,71 @@ module Program =
(instructions : (string * Instruction) list) (instructions : (string * Instruction) list)
: _ list : _ list
= =
if not (restrict board) then [] else if not (restrict board) then
match instructions with []
| [] -> [board, BondSet.directionList bonds] else
| (word, i) :: rest -> match instructions with
// Place this word. | [] -> [ board, BondSet.directionList bonds ]
let newBoard = | (word, i) :: rest ->
board.Add ((currX, currY), word) // Place this word.
let newBoard = board.Add ((currX, currY), word)
match i with match i with
| Instruction.Horizontal -> | Instruction.Horizontal ->
// horizontal, i.e. change X // horizontal, i.e. change X
[ [
if not (newBoard.ContainsKey (currX + 1, currY)) then if not (newBoard.ContainsKey (currX + 1, currY)) then
match bonds |> BondSet.addIfOk (currX + 1, currY) (currX, currY) with match bonds |> BondSet.addIfOk (currX + 1, currY) (currX, currY) with
| None -> () | None -> ()
| Some bonds -> | Some bonds -> yield! go (currX + 1) currY bonds newBoard rest
yield! go (currX + 1) currY bonds newBoard rest
if not (newBoard.ContainsKey (currX - 1, currY)) then if not (newBoard.ContainsKey (currX - 1, currY)) then
match bonds |> BondSet.addIfOk (currX - 1, currY) (currX, currY) with match bonds |> BondSet.addIfOk (currX - 1, currY) (currX, currY) with
| None -> () | None -> ()
| Some bonds -> | Some bonds -> yield! go (currX - 1) currY bonds newBoard rest
yield! go (currX - 1) currY bonds newBoard rest ]
] | Instruction.Vertical ->
| Instruction.Vertical -> // vertical, i.e. change Y
// vertical, i.e. change Y [
[ if not (newBoard.ContainsKey (currX, currY + 1)) then
if not (newBoard.ContainsKey (currX, currY + 1)) then match bonds |> BondSet.addIfOk (currX, currY + 1) (currX, currY) with
match bonds |> BondSet.addIfOk (currX, currY + 1) (currX, currY) with | None -> ()
| None -> () | Some bonds -> yield! go currX (currY + 1) bonds newBoard rest
| Some bonds -> if not (newBoard.ContainsKey (currX, currY - 1)) then
yield! go currX (currY + 1) bonds newBoard rest match bonds |> BondSet.addIfOk (currX, currY - 1) (currX, currY) with
if not (newBoard.ContainsKey (currX, currY - 1)) then | None -> ()
match bonds |> BondSet.addIfOk (currX, currY - 1) (currX, currY) with | Some bonds -> yield! go currX (currY - 1) bonds newBoard rest
| None -> () ]
| Some bonds -> | Instruction.UpAndRight ->
yield! go currX (currY - 1) bonds newBoard rest [
] if not (newBoard.ContainsKey (currX + 1, currY + 1)) then
| Instruction.UpAndRight -> match bonds |> BondSet.addIfOk (currX + 1, currY + 1) (currX, currY) with
[ | None -> ()
if not (newBoard.ContainsKey (currX + 1, currY + 1)) then | Some bonds -> yield! go (currX + 1) (currY + 1) bonds newBoard rest
match bonds |> BondSet.addIfOk (currX + 1, currY + 1) (currX, currY) with if not (newBoard.ContainsKey (currX - 1, currY - 1)) then
| None -> () match bonds |> BondSet.addIfOk (currX - 1, currY - 1) (currX, currY) with
| Some bonds -> | None -> ()
yield! go (currX + 1) (currY + 1) bonds newBoard rest | Some bonds -> yield! go (currX - 1) (currY - 1) bonds newBoard rest
if not (newBoard.ContainsKey (currX - 1, currY - 1)) then ]
match bonds |> BondSet.addIfOk (currX - 1, currY - 1) (currX, currY) with | Instruction.DownAndRight ->
| None -> () [
| Some bonds -> if not (newBoard.ContainsKey (currX - 1, currY + 1)) then
yield! go (currX - 1) (currY - 1) bonds newBoard rest match bonds |> BondSet.addIfOk (currX - 1, currY + 1) (currX, currY) with
] | None -> ()
| Instruction.DownAndRight -> | Some bonds -> yield! go (currX - 1) (currY + 1) bonds newBoard rest
[ if not (newBoard.ContainsKey (currX + 1, currY - 1)) then
if not (newBoard.ContainsKey (currX - 1, currY + 1)) then match bonds |> BondSet.addIfOk (currX + 1, currY - 1) (currX, currY) with
match bonds |> BondSet.addIfOk (currX - 1, currY + 1) (currX, currY) with | None -> ()
| None -> () | Some bonds -> yield! go (currX + 1) (currY - 1) bonds newBoard rest
| Some bonds -> ]
yield! go (currX - 1) (currY + 1) bonds newBoard rest | _ -> failwith "bad direction"
if not (newBoard.ContainsKey (currX + 1, currY - 1)) then
match bonds |> BondSet.addIfOk (currX + 1, currY - 1) (currX, currY) with
| None -> ()
| Some bonds ->
yield! go (currX + 1) (currY - 1) bonds newBoard rest
]
| _ -> failwith "bad direction"
let print ((x, y), s) = let print ((x, y), s) = printfn "%i, %i: %s" x y s
printfn "%i, %i: %s" x y s
[<EntryPoint>] [<EntryPoint>]
let main _ = let main _ =
let sw = System.Diagnostics.Stopwatch.StartNew () let sw = System.Diagnostics.Stopwatch.StartNew ()
let after = let after =
instructions instructions
|> go 0 0 BondSet.empty ImmutableDictionary.Empty |> go 0 0 BondSet.empty ImmutableDictionary.Empty
@@ -146,11 +141,10 @@ module Program =
exampleBonds exampleBonds
|> List.choose (fun (srcX, srcY) -> |> List.choose (fun (srcX, srcY) ->
match examplePlacement.TryGetValue ((srcX, srcY)) with match examplePlacement.TryGetValue ((srcX, srcY)) with
| true, w -> | true, w -> Some ((srcX, srcY), w)
Some ((srcX, srcY), w) | false, _ -> None
| false, _ ->
None
) )
munged munged
) )
@@ -170,6 +164,7 @@ module Program =
let arr = Array2D.zeroCreate (maxY - minY + 1) (maxX - minX + 1) let arr = Array2D.zeroCreate (maxY - minY + 1) (maxX - minX + 1)
let mutable i = 0 let mutable i = 0
for x, y in positions do for x, y in positions do
arr.[y - minY, x - minX] <- words.[i].[int (snd instructions.[i]) - 1] arr.[y - minY, x - minX] <- words.[i].[int (snd instructions.[i]) - 1]
i <- i + 1 i <- i + 1
@@ -179,6 +174,7 @@ module Program =
match arr.[row - minY, col - minX] with match arr.[row - minY, col - minX] with
| '\000' -> printf "." | '\000' -> printf "."
| _ -> printf "O" | _ -> printf "O"
printfn "" printfn ""
0 0

22
Reactivation/Seq.fs
View File

@@ -5,14 +5,22 @@ module Seq =
let minMax (s : int seq) : struct (int * int) voption = let minMax (s : int seq) : struct (int * int) voption =
use e = s.GetEnumerator () use e = s.GetEnumerator ()
if not (e.MoveNext ()) then ValueNone else
let mutable min = e.Current if not (e.MoveNext ()) then
let mutable max = e.Current ValueNone
while e.MoveNext () do else
if e.Current < min then min <- e.Current
if e.Current > max then max <- e.Current let mutable min = e.Current
ValueSome (struct (min, max)) let mutable max = e.Current
while e.MoveNext () do
if e.Current < min then
min <- e.Current
if e.Current > max then
max <- e.Current
ValueSome (struct (min, max))
let rangeOrZero (s : int seq) : int = let rangeOrZero (s : int seq) : int =
match minMax s with match minMax s with