From 44b60dda2d4b0c51df5bf34cad909911b9470c86 Mon Sep 17 00:00:00 2001 From: Smaug123 Date: Sun, 15 Jan 2023 13:30:58 +0000 Subject: [PATCH] Iniital commit --- .gitignore | 361 +++++++++++++++++++++++++++++++++ ConsoleApp2.sln | 22 ++ ConsoleApp2/BondSet.fs | 72 +++++++ ConsoleApp2/ConsoleApp2.fsproj | 14 ++ ConsoleApp2/Program.fs | 172 ++++++++++++++++ ConsoleApp2/Seq.fs | 16 ++ Solve.Test/Program.fs | 4 + Solve.Test/Solve.Test.fsproj | 29 +++ Solve.Test/UnitTest1.fs | 21 ++ 9 files changed, 711 insertions(+) create mode 100644 .gitignore create mode 100644 ConsoleApp2.sln create mode 100644 ConsoleApp2/BondSet.fs create mode 100644 ConsoleApp2/ConsoleApp2.fsproj create mode 100644 ConsoleApp2/Program.fs create mode 100644 ConsoleApp2/Seq.fs create mode 100644 Solve.Test/Program.fs create mode 100644 Solve.Test/Solve.Test.fsproj create mode 100644 Solve.Test/UnitTest1.fs diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..7351cd5 --- /dev/null +++ b/.gitignore @@ -0,0 +1,361 @@ +## Ignore Visual Studio temporary files, build results, and +## files generated by popular Visual Studio add-ons. +## +## Get latest from https://github.com/github/gitignore/blob/master/VisualStudio.gitignore + +# User-specific files +*.rsuser +*.suo +*.user +*.userosscache +*.sln.docstates + +# User-specific files (MonoDevelop/Xamarin Studio) +*.userprefs + +# Mono auto generated files +mono_crash.* + +# Build results +[Dd]ebug/ +[Dd]ebugPublic/ +[Rr]elease/ +[Rr]eleases/ +x64/ +x86/ +[Aa][Rr][Mm]/ +[Aa][Rr][Mm]64/ +bld/ +[Bb]in/ +[Oo]bj/ +[Ll]og/ +[Ll]ogs/ + +# Visual Studio 2015/2017 cache/options directory +.vs/ +# Uncomment if you have tasks that create the project's static files in wwwroot +#wwwroot/ + +# Visual Studio 2017 auto generated files +Generated\ Files/ + +# MSTest test Results +[Tt]est[Rr]esult*/ +[Bb]uild[Ll]og.* + +# NUnit +*.VisualState.xml +TestResult.xml +nunit-*.xml + +# Build Results of an ATL Project +[Dd]ebugPS/ +[Rr]eleasePS/ +dlldata.c + +# Benchmark Results +BenchmarkDotNet.Artifacts/ + +# .NET Core +project.lock.json +project.fragment.lock.json +artifacts/ + +# StyleCop +StyleCopReport.xml + +# Files built by Visual Studio +*_i.c +*_p.c +*_h.h +*.ilk +*.meta +*.obj +*.iobj +*.pch +*.pdb +*.ipdb +*.pgc +*.pgd +*.rsp +*.sbr +*.tlb +*.tli +*.tlh +*.tmp +*.tmp_proj +*_wpftmp.csproj +*.log +*.vspscc +*.vssscc +.builds +*.pidb +*.svclog +*.scc + +# Chutzpah Test files +_Chutzpah* + +# Visual C++ cache files +ipch/ +*.aps +*.ncb +*.opendb +*.opensdf +*.sdf +*.cachefile +*.VC.db +*.VC.VC.opendb + +# Visual Studio profiler +*.psess +*.vsp +*.vspx +*.sap + +# Visual Studio Trace Files +*.e2e + +# TFS 2012 Local Workspace +$tf/ + +# Guidance Automation Toolkit +*.gpState + +# ReSharper is a .NET coding add-in +_ReSharper*/ +*.[Rr]e[Ss]harper +*.DotSettings.user + +# JustCode is a .NET coding add-in +.JustCode + +# TeamCity is a build add-in +_TeamCity* + +# DotCover is a Code Coverage Tool +*.dotCover + +# AxoCover is a Code Coverage Tool +.axoCover/* +!.axoCover/settings.json + +# Visual Studio code coverage results +*.coverage +*.coveragexml + +# NCrunch +_NCrunch_* +.*crunch*.local.xml +nCrunchTemp_* + +# MightyMoose +*.mm.* +AutoTest.Net/ + +# Web workbench (sass) +.sass-cache/ + +# Installshield output folder +[Ee]xpress/ + +# DocProject is a documentation generator add-in +DocProject/buildhelp/ +DocProject/Help/*.HxT +DocProject/Help/*.HxC +DocProject/Help/*.hhc +DocProject/Help/*.hhk +DocProject/Help/*.hhp +DocProject/Help/Html2 +DocProject/Help/html + +# Click-Once directory +publish/ + +# Publish Web Output +*.[Pp]ublish.xml +*.azurePubxml +# Note: Comment the next line if you want to checkin your web deploy settings, +# but database connection strings (with potential passwords) will be unencrypted +*.pubxml +*.publishproj + +# Microsoft Azure Web App publish settings. Comment the next line if you want to +# checkin your Azure Web App publish settings, but sensitive information contained +# in these scripts will be unencrypted +PublishScripts/ + +# NuGet Packages +*.nupkg +# NuGet Symbol Packages +*.snupkg +# The packages folder can be ignored because of Package Restore +**/[Pp]ackages/* +# except build/, which is used as an MSBuild target. +!**/[Pp]ackages/build/ +# Uncomment if necessary however generally it will be regenerated when needed +#!**/[Pp]ackages/repositories.config +# NuGet v3's project.json files produces more ignorable files +*.nuget.props +*.nuget.targets + +# Microsoft Azure Build Output +csx/ +*.build.csdef + +# Microsoft Azure Emulator +ecf/ +rcf/ + +# Windows Store app package directories and files +AppPackages/ +BundleArtifacts/ +Package.StoreAssociation.xml +_pkginfo.txt +*.appx +*.appxbundle +*.appxupload + +# Visual Studio cache files +# files ending in .cache can be ignored +*.[Cc]ache +# but keep track of directories ending in .cache +!?*.[Cc]ache/ + +# Others +ClientBin/ +~$* +*~ +*.dbmdl +*.dbproj.schemaview +*.jfm +*.pfx +*.publishsettings +orleans.codegen.cs + +# Including strong name files can present a security risk +# (https://github.com/github/gitignore/pull/2483#issue-259490424) +#*.snk + +# Since there are multiple workflows, uncomment next line to ignore bower_components +# (https://github.com/github/gitignore/pull/1529#issuecomment-104372622) +#bower_components/ + +# RIA/Silverlight projects +Generated_Code/ + +# Backup & report files from converting an old project file +# to a newer Visual Studio version. Backup files are not needed, +# because we have git ;-) +_UpgradeReport_Files/ +Backup*/ +UpgradeLog*.XML +UpgradeLog*.htm +ServiceFabricBackup/ +*.rptproj.bak + +# SQL Server files +*.mdf +*.ldf +*.ndf + +# Business Intelligence projects +*.rdl.data +*.bim.layout +*.bim_*.settings +*.rptproj.rsuser +*- [Bb]ackup.rdl +*- [Bb]ackup ([0-9]).rdl +*- [Bb]ackup ([0-9][0-9]).rdl + +# Microsoft Fakes +FakesAssemblies/ + +# GhostDoc plugin setting file +*.GhostDoc.xml + +# Node.js Tools for Visual Studio +.ntvs_analysis.dat +node_modules/ + +# Visual Studio 6 build log +*.plg + +# Visual Studio 6 workspace options file +*.opt + +# Visual Studio 6 auto-generated workspace file (contains which files were open etc.) +*.vbw + +# Visual Studio LightSwitch build output +**/*.HTMLClient/GeneratedArtifacts +**/*.DesktopClient/GeneratedArtifacts +**/*.DesktopClient/ModelManifest.xml +**/*.Server/GeneratedArtifacts +**/*.Server/ModelManifest.xml +_Pvt_Extensions + +# Paket dependency manager +.paket/paket.exe +paket-files/ + +# FAKE - F# Make +.fake/ + +# CodeRush personal settings +.cr/personal + +# Python Tools for Visual Studio (PTVS) +__pycache__/ +*.pyc + +# Cake - Uncomment if you are using it +# tools/** +# !tools/packages.config + +# Tabs Studio +*.tss + +# Telerik's JustMock configuration file +*.jmconfig + +# BizTalk build output +*.btp.cs +*.btm.cs +*.odx.cs +*.xsd.cs + +# OpenCover UI analysis results +OpenCover/ + +# Azure Stream Analytics local run output +ASALocalRun/ + +# MSBuild Binary and Structured Log +*.binlog + +# NVidia Nsight GPU debugger configuration file +*.nvuser + +# MFractors (Xamarin productivity tool) working folder +.mfractor/ + +# Local History for Visual Studio +.localhistory/ + +# BeatPulse healthcheck temp database +healthchecksdb + +# Backup folder for Package Reference Convert tool in Visual Studio 2017 +MigrationBackup/ + +# Ionide (cross platform F# VS Code tools) working folder +.ionide/ + +.idea/ + +/result +.DS_Store + +/.profile +/.profile-*-link diff --git a/ConsoleApp2.sln b/ConsoleApp2.sln new file mode 100644 index 0000000..b23efc3 --- /dev/null +++ b/ConsoleApp2.sln @@ -0,0 +1,22 @@ + +Microsoft Visual Studio Solution File, Format Version 12.00 +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "ConsoleApp2", "ConsoleApp2\ConsoleApp2.fsproj", "{D18D6A10-3AAB-4F2A-8CE6-C0D598A8E144}" +EndProject +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Solve.Test", "Solve.Test\Solve.Test.fsproj", "{A4D67E0D-4DE2-4F6F-A443-6BE3B735C173}" +EndProject +Global + GlobalSection(SolutionConfigurationPlatforms) = preSolution + Debug|Any CPU = Debug|Any CPU + Release|Any CPU = Release|Any CPU + EndGlobalSection + GlobalSection(ProjectConfigurationPlatforms) = postSolution + {D18D6A10-3AAB-4F2A-8CE6-C0D598A8E144}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {D18D6A10-3AAB-4F2A-8CE6-C0D598A8E144}.Debug|Any CPU.Build.0 = Debug|Any CPU + {D18D6A10-3AAB-4F2A-8CE6-C0D598A8E144}.Release|Any CPU.ActiveCfg = Release|Any CPU + {D18D6A10-3AAB-4F2A-8CE6-C0D598A8E144}.Release|Any CPU.Build.0 = Release|Any CPU + {A4D67E0D-4DE2-4F6F-A443-6BE3B735C173}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {A4D67E0D-4DE2-4F6F-A443-6BE3B735C173}.Debug|Any CPU.Build.0 = Debug|Any CPU + {A4D67E0D-4DE2-4F6F-A443-6BE3B735C173}.Release|Any CPU.ActiveCfg = Release|Any CPU + {A4D67E0D-4DE2-4F6F-A443-6BE3B735C173}.Release|Any CPU.Build.0 = Release|Any CPU + EndGlobalSection +EndGlobal diff --git a/ConsoleApp2/BondSet.fs b/ConsoleApp2/BondSet.fs new file mode 100644 index 0000000..a1db4c6 --- /dev/null +++ b/ConsoleApp2/BondSet.fs @@ -0,0 +1,72 @@ +namespace Solve + +type BondSet = + private + | BondSet of ((int * int) * (int * int)) Set + +[] +module BondSet = + let sort a b = if a < b then (a, b) else (b, a) + + let addIfOk ((sourceX, sourceY) as source) ((destX, destY) as dest) (BondSet bonds) : BondSet option = + let distance = abs (sourceX - destX) + abs (sourceY - destY) + if distance = 2 then + // Check the other + if sourceX < destX && sourceY < destY then + if bonds.Contains (sort (sourceX + 1, sourceY) (sourceX, sourceY + 1)) then + None + else + bonds + |> Set.add (sort source dest) + |> BondSet + |> Some + elif sourceX > destX && sourceY > destY then + if bonds.Contains (sort (sourceX - 1, sourceY) (sourceX, sourceY - 1)) then + None + else + bonds + |> Set.add (sort source dest) + |> BondSet + |> Some + elif sourceX < destX then + if bonds.Contains (sort (sourceX, sourceY - 1) (sourceX + 1, sourceY)) then + None + else + bonds + |> Set.add (sort source dest) + |> BondSet + |> Some + else + if bonds.Contains (sort (sourceX - 1, sourceY) (sourceX, sourceY + 1)) then + None + else + bonds + |> Set.add (sort source dest) + |> BondSet + |> Some + + else + if distance <> 1 then failwith "bad assumption" + bonds + |> Set.add (sort source dest) + |> BondSet + |> Some + + let empty = BondSet Set.empty + + let directionList (BondSet s) = + let rec go (acc : _ list) (start : int * int) (s : Set<_>) = + if s.IsEmpty then List.rev (start :: acc) else + let next, toRem = + s + |> Seq.choose (fun (p1, p2) -> + if p1 = start then Some (p2, (p1, p2)) + elif p2 = start then Some (p1, (p1, p2)) + else None + ) + |> Seq.exactlyOne + go (start :: acc) next (Set.remove toRem s) + + go [] (0, 0) s + + diff --git a/ConsoleApp2/ConsoleApp2.fsproj b/ConsoleApp2/ConsoleApp2.fsproj new file mode 100644 index 0000000..8bb718e --- /dev/null +++ b/ConsoleApp2/ConsoleApp2.fsproj @@ -0,0 +1,14 @@ + + + + Exe + net7.0 + + + + + + + + + diff --git a/ConsoleApp2/Program.fs b/ConsoleApp2/Program.fs new file mode 100644 index 0000000..181eeb6 --- /dev/null +++ b/ConsoleApp2/Program.fs @@ -0,0 +1,172 @@ +namespace Solve + +module Program = + + let words = + [ + "LEAD" + "BEAD" + "BEAR" + "BEAT" + "BOAT" + "BOOT" + "BOLT" + "COLT" + "CULT" + "CURT" + "CART" + "CARD" + "CARE" + "DARE" + "DANE" + "DONE" + "DONG" + "DING" + "MING" + "MINX" + "MIND" + "MEND" + "MELD" + "MEAD" + ] + + let instructions = + words @ [ List.head words ] + |> List.pairwise + |> List.map (fun (start, next) -> + let instruction = + [1..4] + |> List.filter (fun i -> + start.[i - 1] <> next.[i - 1] + ) + |> List.exactlyOne + start, instruction + ) + + let restrict (board : Map) = + if Seq.range (board.Keys |> Seq.map snd) > 5 then false + elif Seq.range (board.Keys |> Seq.map fst) > 7 then false + else true + + let rec go + (currX : int) + (currY : int) + (bonds : BondSet) + (board : Map) + (instructions : (string * int) list) + : _ list + = + //if not (restrict board) then [] else + match instructions with + | [] -> [board, BondSet.directionList bonds] + | (word, i) :: rest -> + // Place this word. + let newBoard = + board + |> Map.add (currX, currY) word + + match i with + | 1 -> + // horizontal, i.e. change X + [ + match Map.tryFind (currX + 1, currY) newBoard with + | None -> + match bonds |> BondSet.addIfOk (currX + 1, currY) (currX, currY) with + | None -> () + | Some bonds -> + yield! go (currX + 1) currY bonds newBoard rest + | Some _ -> () + match Map.tryFind (currX - 1, currY) newBoard with + | None -> + match bonds |> BondSet.addIfOk (currX - 1, currY) (currX, currY) with + | None -> () + | Some bonds -> + yield! go (currX - 1) currY bonds newBoard rest + | Some _ -> () + ] + | 2 -> + // vertical, i.e. change Y + [ + match Map.tryFind (currX, currY + 1) newBoard with + | None -> + match bonds |> BondSet.addIfOk (currX, currY + 1) (currX, currY) with + | None -> () + | Some bonds -> + yield! go currX (currY + 1) bonds newBoard rest + | Some _ -> () + match Map.tryFind (currX, currY - 1) newBoard with + | None -> + match bonds |> BondSet.addIfOk (currX, currY - 1) (currX, currY) with + | None -> () + | Some bonds -> + yield! go currX (currY - 1) bonds newBoard rest + | Some _ -> () + ] + | 3 -> + // Bottom left to top right + [ + match Map.tryFind (currX + 1, currY + 1) newBoard with + | None -> + match bonds |> BondSet.addIfOk (currX + 1, currY + 1) (currX, currY) with + | None -> () + | Some bonds -> + yield! go (currX + 1) (currY + 1) bonds newBoard rest + | Some _ -> () + match Map.tryFind (currX - 1, currY - 1) newBoard with + | None -> + match bonds |> BondSet.addIfOk (currX - 1, currY - 1) (currX, currY) with + | None -> () + | Some bonds -> + yield! go (currX - 1) (currY - 1) bonds newBoard rest + | Some _ -> () + ] + | 4 -> + // Top left to bottom right + [ + match Map.tryFind (currX - 1, currY + 1) newBoard with + | None -> + match bonds |> BondSet.addIfOk (currX - 1, currY + 1) (currX, currY) with + | None -> () + | Some bonds -> + yield! go (currX - 1) (currY + 1) bonds newBoard rest + | Some _ -> () + match Map.tryFind (currX + 1, currY - 1) newBoard with + | None -> + match bonds |> BondSet.addIfOk (currX + 1, currY - 1) (currX, currY) with + | None -> () + | Some bonds -> + yield! go (currX + 1) (currY - 1) bonds newBoard rest + | Some _ -> () + ] + | _ -> failwith "bad direction" + + let print ((x, y), s) = + printfn "%i, %i: %s" x y s + + [] + let main _ = + let after = + instructions + |> go 0 0 BondSet.empty Map.empty + |> List.map (fun (examplePlacement, exampleBonds) -> + let munged = + exampleBonds + |> List.choose (fun (srcX, srcY) -> + match examplePlacement.TryFind (srcX, srcY) with + | Some w -> + Some ((srcX, srcY), w) + | None -> + None + ) + munged + ) + printfn "Before filtering, %i options" after.Length + after.[7000] |> List.iter print + let filtered = + after + |> List.filter (fun positions -> + let (endX, endY) = fst (List.last positions) + endY = 0 && (abs endX = 1) + ) + printfn "%i total options" filtered.Length + 0 \ No newline at end of file diff --git a/ConsoleApp2/Seq.fs b/ConsoleApp2/Seq.fs new file mode 100644 index 0000000..c25a7d3 --- /dev/null +++ b/ConsoleApp2/Seq.fs @@ -0,0 +1,16 @@ +namespace Solve + +[] +module Seq = + + let range (s : int seq) : int = + use e = s.GetEnumerator () + if not (e.MoveNext ()) then 0 else + + let mutable min = e.Current + 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 + max - min + diff --git a/Solve.Test/Program.fs b/Solve.Test/Program.fs new file mode 100644 index 0000000..176a7b6 --- /dev/null +++ b/Solve.Test/Program.fs @@ -0,0 +1,4 @@ +module Program = + + [] + let main _ = 0 diff --git a/Solve.Test/Solve.Test.fsproj b/Solve.Test/Solve.Test.fsproj new file mode 100644 index 0000000..fbfbb05 --- /dev/null +++ b/Solve.Test/Solve.Test.fsproj @@ -0,0 +1,29 @@ + + + + net7.0 + + false + false + + + + + + + + + + + + + + + + + + + + + + diff --git a/Solve.Test/UnitTest1.fs b/Solve.Test/UnitTest1.fs new file mode 100644 index 0000000..7ac18bc --- /dev/null +++ b/Solve.Test/UnitTest1.fs @@ -0,0 +1,21 @@ +namespace Solve.Test + +open FsUnitTyped +open NUnit.Framework +open Solve +open FsCheck + +[] +module TestSeq = + + [] + let ``Seq.range works`` () : unit = + Seq.range Seq.empty |> shouldEqual 0 + + let prop (i : int) (s : int list) = + let s = i :: s + Seq.range s + |> (=) (Seq.max s - Seq.min s) + + prop + |> Check.QuickThrowOnFailure \ No newline at end of file