Got Stack working with days in separate packages
authorNeil Smith <neil.git@njae.me.uk>
Fri, 23 Dec 2016 19:41:11 +0000 (19:41 +0000)
committerNeil Smith <neil.git@njae.me.uk>
Fri, 23 Dec 2016 19:41:11 +0000 (19:41 +0000)
81 files changed:
adventofcode16.cabal [deleted file]
adventofcode16/adventofcode16.cabal [new file with mode: 0644]
adventofcode16/app/Main.hs [new file with mode: 0644]
adventofcode16/app/advent03.hs [new file with mode: 0644]
adventofcode16/app/advent04.hs [new file with mode: 0644]
adventofcode16/app/advent05.hs [new file with mode: 0644]
adventofcode16/app/advent06-old.hs [new file with mode: 0644]
adventofcode16/app/advent06.hs [new file with mode: 0644]
adventofcode16/app/advent07.hs [new file with mode: 0644]
adventofcode16/app/advent08.hs [new file with mode: 0644]
adventofcode16/app/advent09.hs [new file with mode: 0644]
adventofcode16/app/advent10.hs [new file with mode: 0644]
adventofcode16/app/advent11.hs [new file with mode: 0644]
adventofcode16/app/advent11a.hs [new file with mode: 0644]
adventofcode16/app/advent11h.hs [new file with mode: 0644]
adventofcode16/app/advent11p.hs [new file with mode: 0644]
adventofcode16/app/advent12.hs [new file with mode: 0644]
adventofcode16/app/advent13.hs [new file with mode: 0644]
adventofcode16/app/advent14.hs [new file with mode: 0644]
adventofcode16/app/advent14c.hs [new file with mode: 0644]
adventofcode16/app/advent14parallel.hs [new file with mode: 0644]
adventofcode16/app/advent15.hs [new file with mode: 0644]
adventofcode16/app/advent15l.hs [new file with mode: 0644]
adventofcode16/app/advent16.hs [new file with mode: 0644]
adventofcode16/app/advent16i.hs [new file with mode: 0644]
adventofcode16/app/advent17.hs [new file with mode: 0644]
adventofcode16/app/advent18.hs [new file with mode: 0644]
adventofcode16/app/advent18f.hs [new file with mode: 0644]
adventofcode16/app/advent19.hs [new file with mode: 0644]
adventofcode16/app/advent20.hs [new file with mode: 0644]
adventofcode16/app/advent21.hs [new file with mode: 0644]
adventofcode16/app/advent22.hs [new file with mode: 0644]
adventofcode16/app/advent22library.hs [new file with mode: 0644]
adventofcode16/app/advent22search.hs [new file with mode: 0644]
adventofcode16/app/advent22showgrid.hs [new file with mode: 0644]
adventofcode16/app/advent23.hs [new file with mode: 0644]
adventofcode16/src/Lib.hs [new file with mode: 0644]
adventofcode16/test/Spec.hs [new file with mode: 0644]
adventofcode1601/adventofcode1601.cabal [new file with mode: 0644]
adventofcode1601/app/Main.hs [new file with mode: 0644]
adventofcode1602/adventofcode1602.cabal [new file with mode: 0644]
adventofcode1602/app/Main.hs [new file with mode: 0644]
app/Main.hs [deleted file]
app/advent01.hs [deleted file]
app/advent02.hs [deleted file]
app/advent03.hs [deleted file]
app/advent04.hs [deleted file]
app/advent05.hs [deleted file]
app/advent06-old.hs [deleted file]
app/advent06.hs [deleted file]
app/advent07.hs [deleted file]
app/advent08.hs [deleted file]
app/advent09.hs [deleted file]
app/advent10.hs [deleted file]
app/advent11.hs [deleted file]
app/advent11a.hs [deleted file]
app/advent11h.hs [deleted file]
app/advent11p.hs [deleted file]
app/advent12.hs [deleted file]
app/advent13.hs [deleted file]
app/advent14.hs [deleted file]
app/advent14c.hs [deleted file]
app/advent14parallel.hs [deleted file]
app/advent15.hs [deleted file]
app/advent15l.hs [deleted file]
app/advent16.hs [deleted file]
app/advent16i.hs [deleted file]
app/advent17.hs [deleted file]
app/advent18.hs [deleted file]
app/advent18f.hs [deleted file]
app/advent19.hs [deleted file]
app/advent20.hs [deleted file]
app/advent21.hs [deleted file]
app/advent22.hs [deleted file]
app/advent22library.hs [deleted file]
app/advent22search.hs [deleted file]
app/advent22showgrid.hs [deleted file]
app/advent23.hs [deleted file]
src/Lib.hs [deleted file]
stack.yaml
test/Spec.hs [deleted file]

diff --git a/adventofcode16.cabal b/adventofcode16.cabal
deleted file mode 100644 (file)
index 6216e51..0000000
+++ /dev/null
@@ -1,365 +0,0 @@
-name:                adventofcode16
-version:             0.1.0.0
-synopsis:            Initial project template from stack
-description:         Please see README.md
-homepage:            https://github.com/neilnjae/adventofcode16#readme
-license:             BSD3
-license-file:        LICENSE
-author:              Neil Smith
-maintainer:          noone@njae.me.uk
-copyright:           2016 Neil Smith
-category:            None
-build-type:          Simple
-extra-source-files:  README.md
-cabal-version:       >=1.10
-
-library
-  hs-source-dirs:      src
-  exposed-modules:     Lib
-  build-depends:       base >= 4.7 && < 5
-  default-language:    Haskell2010
-
-executable advent01
-  hs-source-dirs:      app
-  main-is:             advent01.hs
-  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
-  build-depends:       base
-                     , adventofcode16
-                     , split
-  default-language:    Haskell2010
-
-executable advent02
-  hs-source-dirs:      app
-  main-is:             advent02.hs
-  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
-  build-depends:       base
-                     , adventofcode16
-                     , array
-  default-language:    Haskell2010
-
-executable advent03
-  hs-source-dirs:      app
-  main-is:             advent03.hs
-  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
-  build-depends:       base
-                     , adventofcode16
-                     , split
-  default-language:    Haskell2010
-
-executable advent04
-  hs-source-dirs:      app
-  main-is:             advent04.hs
-  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
-  build-depends:       base
-                     , adventofcode16
-                     , split
-                     , containers
-  default-language:    Haskell2010
-
-executable advent05
-  hs-source-dirs:      app
-  main-is:             advent05.hs
-  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
-  build-depends:       base
-                     , adventofcode16
-                     , containers
-                     , MissingH
-  default-language:    Haskell2010
-
-executable advent06
-  hs-source-dirs:      app
-  main-is:             advent06.hs
-  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
-  build-depends:       base
-                     , adventofcode16
-  default-language:    Haskell2010
-
-executable advent07
-  hs-source-dirs:      app
-  main-is:             advent07.hs
-  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
-  build-depends:       base
-                     , adventofcode16
-                     , parsec
-  default-language:    Haskell2010
-
-executable advent08
-  hs-source-dirs:      app
-  main-is:             advent08.hs
-  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
-  build-depends:       base
-                     , adventofcode16
-                     , array
-                     , parsec
-  default-language:    Haskell2010
-
-executable advent09
-  hs-source-dirs:      app
-  main-is:             advent09.hs
-  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
-  build-depends:       base
-                     , adventofcode16
-                     , split
-  default-language:    Haskell2010
-
-executable advent10
-  hs-source-dirs:      app
-  main-is:             advent10.hs
-  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
-  build-depends:       base
-                     , adventofcode16
-                     , parsec
-                     , text
-                     , mtl
-  default-language:    Haskell2010
-
-executable advent11
-  hs-source-dirs:      app
-  main-is:             advent11.hs
-  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
-  build-depends:       base
-                     , adventofcode16
-  default-language:    Haskell2010
-
-executable advent11a
-  hs-source-dirs:      app
-  main-is:             advent11a.hs
-  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
-  build-depends:       base
-                     , adventofcode16
-  default-language:    Haskell2010
-
-executable advent11h
-  hs-source-dirs:      app
-  main-is:             advent11h.hs
-  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
-  build-depends:       base
-                     , adventofcode16
-  default-language:    Haskell2010
-
-executable advent11p
-  hs-source-dirs:      app
-  main-is:             advent11p.hs
-  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
-  build-depends:       base
-                     , adventofcode16
-                     , pqueue
-  default-language:    Haskell2010
-
-executable advent12
-  hs-source-dirs:      app
-  main-is:             advent12.hs
-  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
-  build-depends:       base
-                     , adventofcode16
-                     , parsec
-                     , parsec-numbers
-                     , mtl
-  default-language:    Haskell2010
-
-executable advent13
-  hs-source-dirs:      app
-  main-is:             advent13.hs
-  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
-  build-depends:       base
-                     , adventofcode16
-                     , MissingH
-  default-language:    Haskell2010
-
-executable advent14
-  hs-source-dirs:      app
-  main-is:             advent14.hs
-  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
-  build-depends:       base
-                     , adventofcode16
-                     , MissingH
-  default-language:    Haskell2010
-
-executable advent14c
-  hs-source-dirs:      app
-  main-is:             advent14c.hs
-  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
-  build-depends:       base
-                     , adventofcode16
-                     , bytestring
-                     , cryptonite
-  default-language:    Haskell2010
-
-executable advent14parallel
-  hs-source-dirs:      app
-  main-is:             advent14parallel.hs
-  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
-  build-depends:       base
-                     , adventofcode16
-                     , parallel
-                     , bytestring
-                     , cryptonite
-  default-language:    Haskell2010
-
-executable advent15
-  hs-source-dirs:      app
-  main-is:             advent15.hs
-  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
-  build-depends:       base
-                     , adventofcode16
-                     , parsec
-                     , parsec-numbers
-  default-language:    Haskell2010
-
-executable advent15l
-  hs-source-dirs:      app
-  main-is:             advent15l.hs
-  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
-  build-depends:       base
-                     , adventofcode16
-                     , parsec
-                     , parsec-numbers
-  default-language:    Haskell2010
-
-executable advent16
-  hs-source-dirs:      app
-  main-is:             advent16.hs
-  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
-  build-depends:       base
-                     , adventofcode16
-  default-language:    Haskell2010
-
-executable advent16i
-  hs-source-dirs:      app
-  main-is:             advent16i.hs
-  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
-  build-depends:       base
-                     , adventofcode16
-  default-language:    Haskell2010
-
-executable advent17
-  hs-source-dirs:      app
-  main-is:             advent17.hs
-  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
-  build-depends:       base
-                     , adventofcode16
-                     , bytestring
-                     , cryptonite
-  default-language:    Haskell2010
-
-executable advent18
-  hs-source-dirs:      app
-  main-is:             advent18.hs
-  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
-  build-depends:       base
-                     , adventofcode16
-  default-language:    Haskell2010
-
-executable advent18f
-  hs-source-dirs:      app
-  main-is:             advent18f.hs
-  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
-  build-depends:       base
-                     , adventofcode16
-  default-language:    Haskell2010
-
-executable advent19
-  hs-source-dirs:      app
-  main-is:             advent19.hs
-  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
-  build-depends:       base
-                     , adventofcode16
-                     , containers
-  default-language:    Haskell2010
-
-executable advent20
-  hs-source-dirs:      app
-  main-is:             advent20.hs
-  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
-  build-depends:       base
-                     , adventofcode16
-                     , parsec
-                     , parsec-numbers
-  default-language:    Haskell2010
-
-executable advent21
-  hs-source-dirs:      app
-  main-is:             advent21.hs
-  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
-  build-depends:       base
-                     , adventofcode16
-                     , parsec
-                     , parsec-numbers
-                     , mtl
-  default-language:    Haskell2010
-
-executable advent22
-  hs-source-dirs:      app
-  main-is:             advent22.hs
-  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
-  build-depends:       base
-                     , adventofcode16
-                     , parsec
-                     , parsec-numbers
-  default-language:    Haskell2010
-
-executable advent22search
-  hs-source-dirs:      app
-  main-is:             advent22search.hs
-  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
-  build-depends:       base
-                     , adventofcode16
-                     , parsec
-                     , parsec-numbers
-  default-language:    Haskell2010
-
-executable advent22showgrid
-  hs-source-dirs:      app
-  main-is:             advent22showgrid.hs
-  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
-  build-depends:       base
-                     , adventofcode16
-                     , parsec
-                     , parsec-numbers
-  default-language:    Haskell2010
-
-executable advent22library
-  hs-source-dirs:      app
-  main-is:             advent22library.hs
-  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
-  build-depends:       base
-                     , adventofcode16
-                     , parsec
-                     , parsec-numbers
-                     , containers
-                     , astar
-                     , unordered-containers
-                     , hashable
-  default-language:    Haskell2010
-
-executable advent23
-  hs-source-dirs:      app
-  main-is:             advent23.hs
-  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
-  build-depends:       base
-                     , adventofcode16
-                     , parsec
-                     , parsec-numbers
-                     , mtl
-  default-language:    Haskell2010
-
-executable adventofcode16-exe
-  hs-source-dirs:      app
-  main-is:             Main.hs
-  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
-  build-depends:       base
-                     , adventofcode16
-  default-language:    Haskell2010
-
-test-suite adventofcode16-test
-  type:                exitcode-stdio-1.0
-  hs-source-dirs:      test
-  main-is:             Spec.hs
-  build-depends:       base
-                     , adventofcode16
-  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
-  default-language:    Haskell2010
-
-source-repository head
-  type:     git
-  location: https://github.com/neilnjae/adventofcode16
diff --git a/adventofcode16/adventofcode16.cabal b/adventofcode16/adventofcode16.cabal
new file mode 100644 (file)
index 0000000..18cc51d
--- /dev/null
@@ -0,0 +1,347 @@
+name:                adventofcode16
+version:             0.1.0.0
+synopsis:            Initial project template from stack
+description:         Please see README.md
+homepage:            https://github.com/neilnjae/adventofcode16#readme
+license:             BSD3
+license-file:        LICENSE
+author:              Neil Smith
+maintainer:          noone@njae.me.uk
+copyright:           2016 Neil Smith
+category:            None
+build-type:          Simple
+extra-source-files:  README.md
+cabal-version:       >=1.10
+
+library
+  hs-source-dirs:      src
+  exposed-modules:     Lib
+  build-depends:       base >= 4.7 && < 5
+  default-language:    Haskell2010
+
+executable advent03
+  hs-source-dirs:      app
+  main-is:             advent03.hs
+  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
+  build-depends:       base
+                     , adventofcode16
+                     , split
+  default-language:    Haskell2010
+
+executable advent04
+  hs-source-dirs:      app
+  main-is:             advent04.hs
+  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
+  build-depends:       base
+                     , adventofcode16
+                     , split
+                     , containers
+  default-language:    Haskell2010
+
+executable advent05
+  hs-source-dirs:      app
+  main-is:             advent05.hs
+  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
+  build-depends:       base
+                     , adventofcode16
+                     , containers
+                     , MissingH
+  default-language:    Haskell2010
+
+executable advent06
+  hs-source-dirs:      app
+  main-is:             advent06.hs
+  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
+  build-depends:       base
+                     , adventofcode16
+  default-language:    Haskell2010
+
+executable advent07
+  hs-source-dirs:      app
+  main-is:             advent07.hs
+  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
+  build-depends:       base
+                     , adventofcode16
+                     , parsec
+  default-language:    Haskell2010
+
+executable advent08
+  hs-source-dirs:      app
+  main-is:             advent08.hs
+  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
+  build-depends:       base
+                     , adventofcode16
+                     , array
+                     , parsec
+  default-language:    Haskell2010
+
+executable advent09
+  hs-source-dirs:      app
+  main-is:             advent09.hs
+  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
+  build-depends:       base
+                     , adventofcode16
+                     , split
+  default-language:    Haskell2010
+
+executable advent10
+  hs-source-dirs:      app
+  main-is:             advent10.hs
+  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
+  build-depends:       base
+                     , adventofcode16
+                     , parsec
+                     , text
+                     , mtl
+  default-language:    Haskell2010
+
+executable advent11
+  hs-source-dirs:      app
+  main-is:             advent11.hs
+  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
+  build-depends:       base
+                     , adventofcode16
+  default-language:    Haskell2010
+
+executable advent11a
+  hs-source-dirs:      app
+  main-is:             advent11a.hs
+  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
+  build-depends:       base
+                     , adventofcode16
+  default-language:    Haskell2010
+
+executable advent11h
+  hs-source-dirs:      app
+  main-is:             advent11h.hs
+  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
+  build-depends:       base
+                     , adventofcode16
+  default-language:    Haskell2010
+
+executable advent11p
+  hs-source-dirs:      app
+  main-is:             advent11p.hs
+  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
+  build-depends:       base
+                     , adventofcode16
+                     , pqueue
+  default-language:    Haskell2010
+
+executable advent12
+  hs-source-dirs:      app
+  main-is:             advent12.hs
+  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
+  build-depends:       base
+                     , adventofcode16
+                     , parsec
+                     , parsec-numbers
+                     , mtl
+  default-language:    Haskell2010
+
+executable advent13
+  hs-source-dirs:      app
+  main-is:             advent13.hs
+  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
+  build-depends:       base
+                     , adventofcode16
+                     , MissingH
+  default-language:    Haskell2010
+
+executable advent14
+  hs-source-dirs:      app
+  main-is:             advent14.hs
+  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
+  build-depends:       base
+                     , adventofcode16
+                     , MissingH
+  default-language:    Haskell2010
+
+executable advent14c
+  hs-source-dirs:      app
+  main-is:             advent14c.hs
+  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
+  build-depends:       base
+                     , adventofcode16
+                     , bytestring
+                     , cryptonite
+  default-language:    Haskell2010
+
+executable advent14parallel
+  hs-source-dirs:      app
+  main-is:             advent14parallel.hs
+  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
+  build-depends:       base
+                     , adventofcode16
+                     , parallel
+                     , bytestring
+                     , cryptonite
+  default-language:    Haskell2010
+
+executable advent15
+  hs-source-dirs:      app
+  main-is:             advent15.hs
+  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
+  build-depends:       base
+                     , adventofcode16
+                     , parsec
+                     , parsec-numbers
+  default-language:    Haskell2010
+
+executable advent15l
+  hs-source-dirs:      app
+  main-is:             advent15l.hs
+  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
+  build-depends:       base
+                     , adventofcode16
+                     , parsec
+                     , parsec-numbers
+  default-language:    Haskell2010
+
+executable advent16
+  hs-source-dirs:      app
+  main-is:             advent16.hs
+  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
+  build-depends:       base
+                     , adventofcode16
+  default-language:    Haskell2010
+
+executable advent16i
+  hs-source-dirs:      app
+  main-is:             advent16i.hs
+  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
+  build-depends:       base
+                     , adventofcode16
+  default-language:    Haskell2010
+
+executable advent17
+  hs-source-dirs:      app
+  main-is:             advent17.hs
+  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
+  build-depends:       base
+                     , adventofcode16
+                     , bytestring
+                     , cryptonite
+  default-language:    Haskell2010
+
+executable advent18
+  hs-source-dirs:      app
+  main-is:             advent18.hs
+  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
+  build-depends:       base
+                     , adventofcode16
+  default-language:    Haskell2010
+
+executable advent18f
+  hs-source-dirs:      app
+  main-is:             advent18f.hs
+  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
+  build-depends:       base
+                     , adventofcode16
+  default-language:    Haskell2010
+
+executable advent19
+  hs-source-dirs:      app
+  main-is:             advent19.hs
+  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
+  build-depends:       base
+                     , adventofcode16
+                     , containers
+  default-language:    Haskell2010
+
+executable advent20
+  hs-source-dirs:      app
+  main-is:             advent20.hs
+  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
+  build-depends:       base
+                     , adventofcode16
+                     , parsec
+                     , parsec-numbers
+  default-language:    Haskell2010
+
+executable advent21
+  hs-source-dirs:      app
+  main-is:             advent21.hs
+  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
+  build-depends:       base
+                     , adventofcode16
+                     , parsec
+                     , parsec-numbers
+                     , mtl
+  default-language:    Haskell2010
+
+executable advent22
+  hs-source-dirs:      app
+  main-is:             advent22.hs
+  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
+  build-depends:       base
+                     , adventofcode16
+                     , parsec
+                     , parsec-numbers
+  default-language:    Haskell2010
+
+executable advent22search
+  hs-source-dirs:      app
+  main-is:             advent22search.hs
+  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
+  build-depends:       base
+                     , adventofcode16
+                     , parsec
+                     , parsec-numbers
+  default-language:    Haskell2010
+
+executable advent22showgrid
+  hs-source-dirs:      app
+  main-is:             advent22showgrid.hs
+  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
+  build-depends:       base
+                     , adventofcode16
+                     , parsec
+                     , parsec-numbers
+  default-language:    Haskell2010
+
+executable advent22library
+  hs-source-dirs:      app
+  main-is:             advent22library.hs
+  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
+  build-depends:       base
+                     , adventofcode16
+                     , parsec
+                     , parsec-numbers
+                     , containers
+                     , astar
+                     , unordered-containers
+                     , hashable
+  default-language:    Haskell2010
+
+executable advent23
+  hs-source-dirs:      app
+  main-is:             advent23.hs
+  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
+  build-depends:       base
+                     , adventofcode16
+                     , parsec
+                     , parsec-numbers
+                     , mtl
+  default-language:    Haskell2010
+
+executable adventofcode16-exe
+  hs-source-dirs:      app
+  main-is:             Main.hs
+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
+  build-depends:       base
+                     , adventofcode16
+  default-language:    Haskell2010
+
+test-suite adventofcode16-test
+  type:                exitcode-stdio-1.0
+  hs-source-dirs:      test
+  main-is:             Spec.hs
+  build-depends:       base
+                     , adventofcode16
+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
+  default-language:    Haskell2010
+
+source-repository head
+  type:     git
+  location: https://github.com/neilnjae/adventofcode16
diff --git a/adventofcode16/app/Main.hs b/adventofcode16/app/Main.hs
new file mode 100644 (file)
index 0000000..de1c1ab
--- /dev/null
@@ -0,0 +1,6 @@
+module Main where
+
+import Lib
+
+main :: IO ()
+main = someFunc
diff --git a/adventofcode16/app/advent03.hs b/adventofcode16/app/advent03.hs
new file mode 100644 (file)
index 0000000..ef40bcc
--- /dev/null
@@ -0,0 +1,33 @@
+module Main(main) where
+
+import Data.List (transpose, sort)
+import Data.List.Split (splitOn, chunksOf)
+
+type Triple = [Integer]
+
+main :: IO ()
+main = do 
+        instrText <- readFile "data/advent03.txt" 
+        let triangles = map (parseLine) $ lines instrText
+        part1 triangles
+        part2 triangles
+
+
+part1 :: [Triple] -> IO ()
+part1 triangles = do 
+    print $ length $ filter (validTriangle) triangles 
+
+part2 :: [Triple] -> IO ()
+part2 triangles = do 
+    print $ length $ filter (validTriangle) $ byColumns triangles 
+
+
+parseLine :: String -> Triple
+parseLine = map (read) . filter (not . null) . splitOn " "
+
+validTriangle :: Triple -> Bool
+validTriangle triple = sortedTriple!!0 + sortedTriple!!1 > sortedTriple!!2
+    where sortedTriple = sort triple
+
+byColumns :: [[Integer]] -> [Triple]
+byColumns = chunksOf 3 . concat . transpose 
diff --git a/adventofcode16/app/advent04.hs b/adventofcode16/app/advent04.hs
new file mode 100644 (file)
index 0000000..85b7555
--- /dev/null
@@ -0,0 +1,66 @@
+module Main(main) where
+
+import Data.List (last, intersperse, sortBy, intercalate, isInfixOf, init)
+import Data.List.Split (splitOn)
+import Data.Char (isLetter, ord, chr)
+import qualified Data.Map.Lazy as Map
+
+data Room = Room { name :: String
+                 , sector :: Int
+                 , checksum :: String
+                 } deriving (Show)
+
+main :: IO ()
+main = do 
+        instrText <- readFile "data/advent04.txt" 
+        let rooms = map (parseLine) $ lines instrText
+        part1 rooms
+        part2 rooms
+
+
+part1 :: [Room] -> IO ()
+part1 rooms = do 
+    print $ sum $ map (sector) validRooms
+    where 
+        validChecksum room = (checksum room) == makeChecksum (name room)
+        validRooms = filter (validChecksum) rooms
+
+part2 :: [Room] -> IO ()
+part2 rooms = do 
+    print $ fst $ head $ filter (\sn -> isInfixOf "north" (snd sn)) sectorNames
+    where 
+        validChecksum room = (checksum room) == makeChecksum (name room)
+        validRooms = filter (validChecksum) rooms
+        sectorNames = [((sector r),
+            shiftWord (sector r) (name r)) | r <- validRooms]
+
+
+parseLine :: String -> Room
+parseLine line = Room {name=name, sector=sector, checksum=checksum}
+    where components = splitOn "-" line
+          name = intercalate "-" $ init components
+          sector = read $ head $ splitOn "[" $ last components
+          checksum = filter (isLetter) $ last components
+
+countedLetters :: String -> [(Char, Int)]
+countedLetters name = sortBy sortCLetter $ unsortedCountedLetters name
+    where unsortedCountedLetters name = 
+            Map.toList $ Map.fromListWith (+) [(c, 1) | c <- filter (isLetter) name]
+
+sortCLetter :: (Char, Int) -> (Char, Int) -> Ordering
+sortCLetter (l1, n1) (l2, n2)
+    | n1 < n2 = GT
+    | n1 > n2 = LT
+    | n1 == n2 = compare l1 l2
+
+makeChecksum :: String -> String
+makeChecksum name = [l | (l, _) <- take 5 $ countedLetters name]
+
+
+shiftWord :: Int -> String -> String
+shiftWord shift letters = map (shiftLetter shift) letters
+
+shiftLetter :: Int -> Char -> Char
+shiftLetter shift letter
+    | isLetter letter = chr $ (ord letter - ord 'a' + shift) `mod` 26 + ord 'a'
+    | otherwise = ' '
diff --git a/adventofcode16/app/advent05.hs b/adventofcode16/app/advent05.hs
new file mode 100644 (file)
index 0000000..82a035e
--- /dev/null
@@ -0,0 +1,44 @@
+module Main(main) where
+
+import Data.Hash.MD5 (md5s, Str(..))
+import Data.List (isPrefixOf)
+import qualified Data.Map.Lazy as Map 
+
+type Password = Map.Map Integer Char
+
+input = "cxdnnyjw"
+
+main :: IO ()
+main = do 
+        part1 
+        part2
+
+
+part1 :: IO ()
+part1 = do 
+    putStrLn $ take 8 [h!!5 | h <- filter (interesting) $ md5sequence input 0]
+
+part2 :: IO ()
+part2 = do 
+    putStrLn $ Map.foldr (:) [] password
+    where interestingHashes = 
+            [(read [h!!5], h!!6) | 
+              h <- filter (interesting) (md5sequence input 0), 
+              h!!5 `elem` "01234567"]
+          password = findPassword Map.empty interestingHashes
+
+
+md5sequence :: String -> Integer -> [String]
+md5sequence key i = (md5s (Str (key ++ show i))) : (md5sequence key (i+1))
+
+interesting :: String -> Bool
+interesting hash = "00000" `isPrefixOf` hash
+
+dontReplace :: (Integer, Char) -> Password -> Password
+dontReplace (k, v) = Map.insertWith (\_ v -> v) k v
+
+findPassword :: Password -> [(Integer, Char)] -> Password
+findPassword p (c:cs)
+  | Map.size p == 8 = p
+  | otherwise = findPassword p' cs
+      where p' = dontReplace c p
diff --git a/adventofcode16/app/advent06-old.hs b/adventofcode16/app/advent06-old.hs
new file mode 100644 (file)
index 0000000..77d4093
--- /dev/null
@@ -0,0 +1,36 @@
+module Main(main) where
+
+import Data.List (transpose)
+import Data.Char (isLetter)
+import qualified Data.Map.Lazy as Map
+
+main :: IO ()
+main = do 
+    text <- readFile "advent06.txt" 
+    let message = lines text
+    part1 message
+    part2 message
+
+part1 :: [String] -> IO ()
+part1 message = do 
+    print $ map (fst) $ map (mostCommon) $ map (countedLetters) $ transpose message
+
+part2 :: [String] -> IO ()
+part2 message = do 
+    print $ map (fst) $ map (leastCommon) $ map (countedLetters) $ transpose message
+
+
+countedLetters :: String -> Map.Map Char Int
+countedLetters name = Map.fromListWith (+) [(c, 1) | c <- filter (isLetter) name]
+
+mostCommon = Map.foldlWithKey (mostCommonP) ('a', 0)
+
+mostCommonP (letter0, count0) letter count
+    | count > count0 = (letter, count)
+    | otherwise = (letter0, count0)
+
+leastCommon = Map.foldlWithKey (leastCommonP) ('a', maxBound :: Int)
+
+leastCommonP (letter0, count0) letter count
+    | count < count0 = (letter, count)
+    | otherwise = (letter0, count0)
\ No newline at end of file
diff --git a/adventofcode16/app/advent06.hs b/adventofcode16/app/advent06.hs
new file mode 100644 (file)
index 0000000..96c4aa2
--- /dev/null
@@ -0,0 +1,22 @@
+module Main(main) where
+
+import Data.List (transpose, maximum, minimum, sort, group)
+import Data.Tuple (swap)
+
+main :: IO ()
+main = do 
+    text <- readFile "data/advent06.txt" 
+    let message = lines text
+    part1 message
+    part2 message
+
+part1 :: [String] -> IO ()
+part1 message = do 
+    putStrLn $ map (snd . maximum . counts) $ transpose message
+
+part2 :: [String] -> IO ()
+part2 message = do 
+    putStrLn $ map (snd . minimum . counts) $ transpose message
+
+counts :: (Eq a, Ord a) => [a] -> [(Int, a)]
+counts = map (\g -> (length g, head g)) . group . sort
\ No newline at end of file
diff --git a/adventofcode16/app/advent07.hs b/adventofcode16/app/advent07.hs
new file mode 100644 (file)
index 0000000..8700958
--- /dev/null
@@ -0,0 +1,136 @@
+module Main(main) where
+
+import Text.Parsec
+import Data.List (partition, union, intersect, tails)
+import Data.Char (isAlphaNum)
+
+data Chunk = Include String | Exclude String deriving (Show)
+data ChunkV = Includev Bool | Excludev Bool deriving (Show)
+
+chunkValue :: Chunk -> String
+chunkValue (Include v) = v
+chunkValue (Exclude v) = v
+
+isInclude :: Chunk -> Bool
+isInclude (Include _) = True
+isInclude (Exclude _) = False
+
+chunkValueV :: ChunkV -> Bool
+chunkValueV (Includev v) = v
+chunkValueV (Excludev v) = v
+
+isIncludeV :: ChunkV -> Bool
+isIncludeV (Includev _) = True
+isIncludeV (Excludev _) = False
+
+
+main :: IO ()
+main = do 
+    text <- readFile "data/advent07.txt" 
+    part1 text
+    part2 text
+
+
+part1 :: String -> IO ()
+part1 text = do 
+    print $ length $ filter (allowsAbba) $ successfulParse $ parseI7vf text
+
+
+part2 :: String -> IO ()
+part2 text = do 
+    print $ length $ filter (supportsSSL) $ successfulParse $ parseI7f text
+
+allowsAbba :: [ChunkV] -> Bool
+allowsAbba chunks = (any (chunkValueV) includeChunks) && (not (any (chunkValueV) excludeChunks))
+    where (includeChunks, excludeChunks) = partition (isIncludeV) chunks
+
+i7file = i7line `endBy` newline 
+i7line = many1 (includeChunk <|> excludeChunk)
+
+chunk = many1 alphaNum
+
+excludeChunk = Exclude <$> (between (char '[') (char ']') $ chunk)
+includeChunk = Include <$> chunk
+
+hasABBA = preambleAbba <* (many alphaNum)
+preambleAbba = (try abba) <|> (alphaNum >> preambleAbba)
+
+-- abba = 
+--     do  a <- alphaNum
+--         b <- alphaNum
+--         if a == b then
+--             fail "Identical"
+--         else do char b
+--                 char a
+--                 return [a, b, b, a]
+
+abba = 
+    do  a <- alphaNum
+        b <- noneOf [a]
+        char b
+        char a
+        return [a, b, b, a]
+
+--         where
+-- Â  firstChar = satisfy (\a -> isLetter a || a == '_')
+-- Â  nonFirstChar = satisfy (\a -> isDigit a || isLetter a || a == '_')
+
+   -- b <- bChar
+-- where bChar = satisfy (\l -> lsLetter l && l /= a)
+
+
+
+i7filev = i7linev `endBy` newline
+i7linev = many1 (includeChunkv <|> excludeChunkv)
+
+excludeChunkv = Excludev <$> (between (char '[') (char ']') $ hasABBAv)
+includeChunkv = Includev <$> hasABBAv
+
+hasABBAv = 
+    (try (id True <$ preambleAbba <* (many alphaNum)))
+    <|>
+    (id False <$ (many1 alphaNum))
+
+
+parseI7f :: String -> Either ParseError [[Chunk]]
+parseI7f input = parse i7file "(unknown)" input
+
+parseI7 :: String -> Either ParseError [Chunk]
+parseI7 input = parse i7line "(unknown)" input
+
+parseAbba :: String -> Either ParseError String
+parseAbba input = parse hasABBA "(unknown)" input
+
+parseI7v :: String -> Either ParseError [ChunkV]
+parseI7v input = parse i7linev "(unknown)" input
+
+parseI7vf :: String -> Either ParseError [[ChunkV]]
+parseI7vf input = parse i7filev "(unknown)" input
+
+successfulParse :: Either ParseError [a] -> [a]
+successfulParse (Left _) = []
+successfulParse (Right a) = a
+
+
+allSubstrings :: Int -> [a] -> [[a]]
+-- allSubstrings n es 
+--     | length es < n = []
+--     | otherwise = (take n es) : (allSubstrings n $ tail es)
+allSubstrings n e = filter (\s -> length s == n) $ map (take n) $ tails e
+
+
+ieCandidates :: [Chunk] -> ([String], [String])
+ieCandidates chunks = (includeCandidates, excludeCandidates)
+    where (includeChunks, excludeChunks) = partition (isInclude) chunks
+          isABA s = (s!!0 == s!!2) && (s!!0 /= s!!1)
+          candidates = (filter (isABA)) . (foldl (union) []) . (map ((allSubstrings 3) . chunkValue))
+          includeCandidates = candidates includeChunks
+          excludeCandidates = candidates excludeChunks
+          
+inverseABA :: String -> String
+inverseABA s = [s!!1, s!!0, s!!1]
+
+supportsSSL :: [Chunk] -> Bool
+supportsSSL chunks = not $ null $ intersect abas eabas
+    where (abas, babs) = ieCandidates chunks
+          eabas = map (inverseABA) babs
diff --git a/adventofcode16/app/advent08.hs b/adventofcode16/app/advent08.hs
new file mode 100644 (file)
index 0000000..ccf2de0
--- /dev/null
@@ -0,0 +1,148 @@
+module Main(main) where
+
+import Data.Array.IArray
+import Text.Parsec
+import Control.Monad (liftM, ap)
+
+-- Row 1 is top, column 1 is left
+type Position = (Int, Int)
+type Screen = Array Position Bool
+
+data Direction = Row | Column deriving (Show)
+data Command = Rect Int Int | Rotate Direction Int Int deriving (Show)
+
+data ScState a = ScState (Screen -> (Screen, a))
+
+mkScreen :: Int -> Int -> Screen
+mkScreen w h = array ((0, 0), (h - 1, w - 1))
+    [((i, j), False) | i <- [0..(h-1)], j <- [0..(w-1)]]
+
+showScreen :: Screen -> String
+showScreen screen = unlines [showRow r | r <- [minRow..maxRow]]
+    where ((minRow, minCol), (maxRow, maxCol)) = bounds screen
+          showCell True  = '*'
+          showCell False = ' '
+          showRow r = [showCell (screen!(r, c)) | c <- [minCol..maxCol]]
+
+countLights :: Screen -> Int
+countLights screen = length $ filter (id) $ elems screen
+
+screen0 :: Screen
+screen0 = mkScreen 50 6
+
+
+main :: IO ()
+main = do
+    text <- readFile "data/advent08.txt"
+    let instrs = successfulParse $ parseCommands text
+    part1 instrs
+    part2 instrs
+
+part1 :: [Command] -> IO ()
+part1 commands =
+    print $ countLights $ (extractScreen . doCommands) commands
+
+part2 :: [Command] -> IO ()
+part2 commands = 
+    putStrLn $ showScreen $ (extractScreen . doCommands) commands
+
+
+instance Functor ScState where
+  fmap = liftM
+
+instance Applicative ScState where
+  pure  = return
+  (<*>) = ap
+
+instance Monad ScState where
+    return x = ScState (\screen -> (screen, x))
+
+    (ScState st) >>= f
+        = ScState (\screen -> let
+                            (newScreen, y) = st screen
+                            (ScState transformer) = f y
+                            in
+                            transformer newScreen)
+
+doCommands :: [Command] -> ScState (Int)
+doCommands [] = return 0
+doCommands (i:is) = 
+    do doCommand i
+       doCommands is
+       return 0
+
+doCommand :: Command -> ScState Int
+doCommand i = ScState (execute i)
+
+execute :: Command -> (Screen -> (Screen, Int))
+execute (Rect w h) screen = (rect screen w h, 0)
+execute (Rotate Column c n) screen = (rotateColumn screen c n, 0)
+execute (Rotate Row r n) screen = (rotateRow screen r n, 0)
+
+extractScreen :: ScState Int -> Screen
+extractScreen (ScState st) = fst (st screen0)
+
+
+
+parseCommands :: String -> Either ParseError [Command]
+parseCommands input = parse commandFile "(unknown)" input
+
+commandFile = commandLine `endBy` newline
+commandLine = (try rectCommand) <|> rotateCommand
+
+rectCommand = 
+    do  string "rect"
+        spaces
+        w <- (many1 digit)
+        char 'x'
+        h <- (many1 digit)
+        return (Rect (read w) (read h))
+
+rotateCommand = 
+    do  string "rotate"
+        spaces
+        direction <- (string "row" <|> string "column")
+        spaces
+        string "x=" <|> string "y="
+        index <- (many1 digit)
+        spaces
+        string "by"
+        spaces
+        distance <- (many1 digit)
+        return (buildCommand direction index distance)
+
+buildCommand "row" i d = Rotate Row (read i) (read d)
+buildCommand "column" i d = Rotate Column (read i) (read d)
+
+successfulParse :: Either ParseError [a] -> [a]
+successfulParse (Left _) = []
+successfulParse (Right a) = a
+
+
+
+
+rect :: Screen -> Int -> Int -> Screen
+rect screen w h = screen // newBits
+    where newBits = [((i, j), True) | i <- [0..(h-1)], j <- [0..(w-1)]]
+
+rotateColumn :: Screen -> Int -> Int -> Screen
+rotateColumn screen column givenShift = screen // newCells
+    where 
+        ((minRow, minCol), (maxRow, maxCol)) = bounds screen
+        colLength = 1 + maxRow - minRow
+        shift = givenShift `mod` colLength
+        offset = colLength - shift
+        column0 = [screen!(r, column) | r <- [minRow..maxRow]]
+        newColumn = (drop offset column0) ++ (take offset column0)
+        newCells = [((r, column), cell) | (r, cell) <- zip [minRow..maxRow] newColumn]
+
+rotateRow :: Screen -> Int -> Int -> Screen
+rotateRow screen row givenShift = screen // newCells
+    where 
+        ((minRow, minCol), (maxRow, maxCol)) = bounds screen
+        rowLength = 1 + maxCol - minCol
+        shift = givenShift `mod` rowLength
+        offset = rowLength - shift
+        row0 = [screen!(row, c) | c <- [minCol..maxCol]]
+        newRow = (drop offset row0) ++ (take offset row0)
+        newCells = [((row, c), cell) | (c, cell) <- zip [minCol..maxCol] newRow]
diff --git a/adventofcode16/app/advent09.hs b/adventofcode16/app/advent09.hs
new file mode 100644 (file)
index 0000000..a3ce495
--- /dev/null
@@ -0,0 +1,57 @@
+module Main(main) where
+
+import Data.List.Split (splitOn)
+import Data.Char (isSpace)
+
+type Chunk = (Int, String)
+
+main :: IO ()
+main = do 
+        textL <- readFile "data/advent09.txt" 
+        let text = filter (not . isSpace) textL
+        part1 text
+        part2 text
+
+part1 :: String -> IO ()
+part1 text = do 
+    print $ cLength $ decompress text
+
+part2 :: String -> IO ()
+part2 text = do 
+    print $ cLength $ decompress2 text
+
+
+decompress :: String -> [Chunk]
+decompress text = 
+    if not (null msuf) 
+        then (1, pre):(num, chunk):drest
+        else [(1, pre)]
+    where 
+        (pre, msuf) = span ('(' /= ) text
+        (marker, suf) = span (')' /= ) msuf
+        ln = splitOn "x" (tail marker)
+        len = read (ln!!0) :: Int
+        num = read (ln!!1) :: Int
+        (chunk, remainder) = splitAt len (tail suf)
+        drest = decompress remainder
+
+decompress2 :: String -> [Chunk]
+decompress2 text = 
+    if not (null msuf) 
+        then [(1, pre)] ++ mulDchunks ++ drest
+        else [(1, pre)]
+    where 
+        (pre, msuf) = span ('(' /= ) text
+        (marker, suf) = span (')' /= ) msuf
+        ln = splitOn "x" (tail marker)
+        len = read (ln!!0) :: Int
+        num = read (ln!!1) :: Int
+        (chunk, remainder) = splitAt len (tail suf)
+        dchunks = decompress2 chunk
+        mulDchunks = [(dl * num, ds) | (dl, ds) <- dchunks]
+        drest = decompress2 remainder
+
+cLength :: [Chunk] -> Int
+cLength = sum . map (clen)
+    where clen (n, t) = n * (length t)
+
diff --git a/adventofcode16/app/advent10.hs b/adventofcode16/app/advent10.hs
new file mode 100644 (file)
index 0000000..70e80e0
--- /dev/null
@@ -0,0 +1,217 @@
+import Text.Parsec hiding (State)
+import Data.Text (pack, unpack, toTitle)
+import Control.Monad.State.Lazy
+import Data.List (partition, findIndices, sort, find)
+import Data.Maybe (fromJust)
+
+data Destination = Bot | Output deriving (Show, Read, Eq)
+-- Rule bot low-destination high-destination
+-- Gift bot value
+data Instruction = Rule { ruleId :: Int 
+                        , lowDestType :: Destination
+                        , lowDestId :: Int
+                        , highDestType :: Destination
+                        , highDestId :: Int
+                        } | 
+                   Gift { giftId :: Int
+                        , value :: Int 
+                        }
+                   deriving (Show)
+
+-- bod id [item1, item2]
+data Place = Place { placeId :: Int
+                   , placeType :: Destination
+                   , items :: [Int]} 
+                   deriving (Show)
+
+-- delivery by bot of low-value and high-value
+data Event = Delivery { deliveryId :: Int
+                      , lowDelivery :: Int
+                      , highDelivery :: Int
+                      } | 
+             Update { updateId :: Int
+                    , updateType :: Destination
+                    , updateItem :: Int
+                    } deriving (Show)
+
+type Factory = ([Place], [Instruction], [Event]) 
+-- data FactorySt History = FactorySt (Factory -> (Factory, History))
+
+emptyFactory :: Factory
+emptyFactory = ([], [], [])
+
+main :: IO ()
+main = do 
+    text <- readFile "data/advent10.txt" 
+    let instructions = successfulParse $ parseIfile text
+    part1 instructions
+    part2 instructions
+
+
+part1 :: [Instruction] -> IO ()
+part1 instructions = 
+    do  let (_, _, events) = snd $  runState (runFactory instructions) emptyFactory
+        -- let (places, instructions, events) = snd finalFactory
+        print $ deliveryId $ fromJust $ findDelivery events 17 61
+
+part2 :: [Instruction] -> IO ()
+part2 instructions = 
+    do  let (places, _, _) = snd $  runState (runFactory instructions) emptyFactory
+        let outs = findOutputs places [0, 1, 2]
+        let product = foldl1 (*) $ concatMap (items) outs
+        print $ product
+
+
+findDelivery :: [Event] -> Int -> Int -> Maybe Event
+findDelivery events lowItem highItem = find (delivery) events
+    where delivery Update {} = False
+          delivery Delivery {deliveryId = bot, lowDelivery = l, highDelivery = h} 
+            | l == lowItem && h == highItem = True
+            | otherwise = False
+
+findOutputs :: [Place] -> [Int] -> [Place]
+findOutputs outputs ids = filter (interesting) outputs
+    where interesting Place {placeId = p, placeType = t, items = i}
+            | (p `elem` ids) && t == Output = True
+            | otherwise = False
+
+
+runFactory :: [Instruction] -> State Factory ()
+runFactory instructions = do
+    addInstructions instructions
+    runInstructions instructions
+
+
+
+instructionFile = instructionLine `endBy` newline 
+instructionLine = ruleL <|> giftL
+
+
+ruleL = 
+    do (string "bot" >> spaces)
+       bot <- many1 digit
+       (spaces >> string "gives low to" >> spaces)
+       lowDestType <- (string "output" <|> string "bot")
+       spaces
+       lowDest <- many1 digit
+       (spaces >> string "and high to" >> spaces)
+       highDestType <- (string "output" <|> string "bot")
+       spaces
+       highDest <- many1 digit
+       let rule = Rule (read bot)
+                   (read $ unpack $ toTitle $ pack lowDestType)
+                   (read lowDest)
+                   (read $ unpack $ toTitle $ pack highDestType)
+                   (read highDest)
+       return rule
+
+giftL = 
+    do (string "value" >> spaces)
+       value <- many1 digit
+       (spaces >> string "goes to bot" >> spaces)
+       bot <- many1 digit
+       let gift = Gift (read bot) (read value)
+       return gift
+
+
+parseIfile :: String -> Either ParseError [Instruction]
+parseIfile input = parse instructionFile "(unknown)" input
+
+parseIline :: String -> Either ParseError Instruction
+parseIline input = parse instructionLine "(unknown)" input
+
+successfulParse :: Either ParseError [a] -> [a]
+successfulParse (Left _) = []
+successfulParse (Right a) = a
+
+
+
+
+addInstructions :: [Instruction] -> State Factory ()
+addInstructions [] = return ()
+addInstructions (i:is) = do
+    addInstruction i
+    addInstructions is
+
+
+addInstruction :: Instruction -> State Factory ()
+addInstruction r@(Rule {lowDestType = ld, lowDestId = li,
+                     highDestType = hd, highDestId = hi}) = 
+    do (places, rules, history) <- get
+       put (places, r:rules, history)
+       addPlace (Place {placeType = ld, placeId = li, items = []})
+       addPlace (Place {placeType = hd, placeId = hi, items = []})
+addInstruction Gift {giftId = g} = 
+    do addPlace (Place {placeType = Bot, placeId = g, items = []})
+
+
+addPlace :: Place -> State Factory ()
+addPlace place = 
+    do  (places, rules, history) <- get
+        if not $ placeElem place places
+            then put ((place:places), rules, history)
+        else return ()
+
+
+runInstructions :: [Instruction] -> State Factory ()
+runInstructions [] = return ()
+runInstructions (i:is) = 
+    do  runInstruction i
+        runInstructions is
+
+
+runInstruction :: Instruction -> State Factory ()
+runInstruction Rule {} = return ()
+runInstruction g@(Gift {}) = 
+    do  updatePlace (giftId g) Bot (value g)
+        propogateUpdates
+
+updatePlace :: Int -> Destination -> Int -> State Factory ()
+updatePlace b d i = 
+    do  (places, instructions, events) <- get
+        let (place0s, otherPlaces) = partition (samePlace (Place {placeId = b, placeType = d, items = []})) places
+        let place = head place0s
+        let place' = place {items = i:(items place)}
+        let update = Update {updateId = b, updateType = d, updateItem = i}
+        put (place':otherPlaces, instructions, update:events)
+  
+
+propogateUpdates :: State Factory ()
+propogateUpdates = 
+    do  (places, instructions, events) <- get
+        let (fullBots, otherPlaces) = fullRobots places
+        if (not . null) fullBots
+            then do let fullBot = head fullBots
+                    let maybeRule = findRule instructions (placeId fullBot)
+                    case maybeRule of
+                        Nothing -> propogateUpdates
+                        Just rule -> do let small:large:_ = sort $ items fullBot
+                                        let emptyBot = fullBot {items = []}
+                                        let delivery = Delivery { deliveryId = placeId fullBot
+                                                                , lowDelivery = small
+                                                                , highDelivery = large
+                                                                }
+                                        put (emptyBot:(tail fullBots) ++ otherPlaces,
+                                             instructions, 
+                                             delivery:events)
+                                        updatePlace (lowDestId rule) (lowDestType rule) small
+                                        updatePlace (highDestId rule) (highDestType rule) large
+                                        propogateUpdates
+            else return ()
+
+
+placeElem :: Place -> [Place] -> Bool
+placeElem place places = (not . null) $ findIndices (samePlace place) places
+
+samePlace :: Place -> Place -> Bool
+samePlace p1 p2 = (placeId p1 == placeId p2) && (placeType p1 == placeType p2)
+
+fullRobots :: [Place] -> ([Place], [Place])
+fullRobots places = partition (\p -> placeType p == Bot && length (items p) >= 2) places
+
+findRule :: [Instruction] -> Int -> Maybe Instruction
+findRule instructions bot = find ruleForBot instructions
+    where ruleForBot Gift {} = False
+          ruleForBot Rule {ruleId = b}
+            | b == bot = True
+            | otherwise = False
diff --git a/adventofcode16/app/advent11.hs b/adventofcode16/app/advent11.hs
new file mode 100644 (file)
index 0000000..0286d77
--- /dev/null
@@ -0,0 +1,137 @@
+module Main(main) where
+
+import Data.List (subsequences, (\\), sort, sortBy)
+import Data.Ord (comparing)
+
+data Item = Generator String | Microchip String deriving (Show, Eq)
+type Floor = [Item]
+data Building = Building Int [Floor] deriving (Show, Eq)
+
+instance Ord Item where
+    compare (Generator a) (Generator b) = compare a b
+    compare (Microchip a) (Microchip b) = compare a b
+    compare (Generator _) (Microchip _) = LT
+    compare (Microchip _) (Generator _) = GT
+
+instance Ord Building where
+    compare b1 b2 = comparing estimateCost b1 b2
+
+building1 = Building 0 [
+    (sort [Generator "polonium", Generator "thulium", 
+     Microchip "thulium", Generator "promethium", Generator "ruthenium",
+     Microchip "ruthenium", Generator "cobalt", Microchip "cobalt"]),
+    (sort [Microchip "polonium", Microchip "promethium"]),
+    [],
+    []
+    ]
+
+building2 = Building 0 [
+    (sort [Generator "polonium", Generator "thulium", 
+     Microchip "thulium", Generator "promethium", Generator "ruthenium",
+     Microchip "ruthenium", Generator "cobalt", Microchip "cobalt",
+     Generator "elerium", Microchip "elerium",
+     Generator "dilithium", Microchip "dilithium"]),
+    (sort [Microchip "polonium", Microchip "promethium"]),
+    [],
+    []
+    ]
+
+
+buildingTest = Building 0 [
+    sort([Microchip "hydrogen", Microchip "lithium"]),
+    [Generator "hydrogen"],
+    [Generator "lithium"],
+    []]
+
+main :: IO ()
+main = do 
+    part1 
+    part2 
+
+
+part1 :: IO ()
+-- part1 = print $ length $ init $ extractJust $ hillClimb [[buildingTest]] []
+part1 = print $ length $ init $ extractJust $ hillClimb [[building1]] []
+-- part1 = print $ length $ init $ extractJust $ aStar [[building1]] []
+
+part2 :: IO ()
+part2 = print $ length $ init $ extractJust $ hillClimb [[building2]] []
+
+
+extractJust :: Maybe [a] -> [a]
+extractJust Nothing = []
+extractJust (Just x) = x
+
+hillClimb :: [[Building]] -> [Building] -> Maybe [Building]
+hillClimb [] _ = Nothing
+hillClimb (currentTrail:trails) closed = 
+    if isGoal (head currentTrail) then Just currentTrail
+    else hillClimb newAgenda ((head currentTrail): closed) 
+    where newAgenda = 
+            sortBy (\t1 t2 -> (head t1) `compare` (head t2)) $ 
+            trails ++ (candidates currentTrail closed)
+
+aStar :: [[Building]] -> [Building] -> Maybe [Building]
+aStar [] _ = Nothing
+aStar (currentTrail:trails) closed = 
+    if isGoal (head currentTrail) then Just currentTrail
+    else aStar newAgenda ((head currentTrail): closed) 
+    where newAgenda = 
+            sortBy (\t1 t2 -> (trailCost t1) `compare` (trailCost t2)) $ 
+            trails ++ (candidates currentTrail closed)
+          trailCost t = estimateCost (head t) + length t - 1
+
+
+candidates :: [Building] -> [Building] -> [[Building]]
+candidates currentTrail closed = newCandidates
+    where
+        (candidate:trail) = currentTrail
+        succs = legalSuccessors $ successors candidate
+        nonloops = (succs \\ trail) \\ closed
+        newCandidates = map (\n -> n:candidate:trail) nonloops
+
+isGoal :: Building -> Bool
+isGoal (Building f floors) =
+    f+1 == height && (all (null) $ take f floors)
+    where height = length floors
+
+isLegal :: Building -> Bool
+isLegal (Building f floors) = 
+    null floor 
+    ||
+    not (any (isGenerator) floor)
+    ||
+    any (safePair) pairs
+    where floor = floors!!f
+          pairs = [(i, j) | i <- floor, j <- floor, isGenerator i]
+          safePair (Generator e, Microchip f) = e == f
+          safePair (Generator _, Generator _) = False
+
+isGenerator :: Item -> Bool
+isGenerator (Generator _) = True
+isGenerator (Microchip _) = False
+
+successors :: Building -> [Building]
+successors (Building f floors) = [updateBuilding f floors nf is | nf <- nextFloors, is <- items]
+    where 
+        floor = floors!!f
+        items = filter (\is -> length is == 1 || length is == 2) $ subsequences floor
+        nextFloors = if f == 0 then [1]
+                     else if f+1 == length floors then [f-1]
+                     else [f+1, f-1]
+
+legalSuccessors :: [Building] -> [Building]
+legalSuccessors = filter (isLegal)
+
+updateBuilding :: Int -> [Floor] -> Int -> [Item] -> Building
+updateBuilding oldF oldFloors newF items = Building newF newFloors
+    where newFloors = map (updateFloor) $ zip [0..] oldFloors
+          updateFloor (f, fl) 
+            | f == oldF = sort $ fl \\ items
+            | f == newF = sort $ items ++ fl
+            | otherwise = fl
+
+estimateCost :: Building -> Int
+estimateCost (Building _ floors) = 
+    sum $ map (\(c, f) -> c * length f) $ zip [0..] $ reverse floors
+
diff --git a/adventofcode16/app/advent11a.hs b/adventofcode16/app/advent11a.hs
new file mode 100644 (file)
index 0000000..c5349c8
--- /dev/null
@@ -0,0 +1,164 @@
+-- Using the idea of canonical representation of buildings from
+-- https://andars.github.io/aoc_day11.html by Andrew Foote,
+-- plus my extension of represening the pairs as an integer.
+
+-- This version is A* search, using a list for the agenda.
+
+module Main(main) where
+
+import Data.List (subsequences, (\\), sort, sortOn, nub, findIndices)
+import Data.Ord (comparing)
+import Data.Char (isDigit)
+
+data Item = Generator String | Microchip String deriving (Show, Eq)
+type Floor = [Item]
+data Building = Building Int [Floor] deriving (Show, Eq)
+data CBuilding = CBuilding Int Integer deriving (Show, Eq)
+data Agendum = Agendum {current :: Building, trail :: [CBuilding], cost :: Int}
+
+instance Ord Item where
+    compare (Generator a) (Generator b) = compare a b
+    compare (Microchip a) (Microchip b) = compare a b
+    compare (Generator _) (Microchip _) = LT
+    compare (Microchip _) (Generator _) = GT
+
+instance Ord Building where
+    compare b1 b2 = comparing estimateCost b1 b2
+
+building1 = Building 0 [
+    (sort [Generator "polonium", Generator "thulium", 
+     Microchip "thulium", Generator "promethium", Generator "ruthenium",
+     Microchip "ruthenium", Generator "cobalt", Microchip "cobalt"]),
+    (sort [Microchip "polonium", Microchip "promethium"]),
+    [],
+    []
+    ]
+
+building0 = Building 0 [
+    (sort [Generator "polonium", Generator "thulium", 
+     Microchip "thulium", Generator "promethium"]),
+    (sort [Microchip "polonium", Microchip "promethium"]),
+    [],
+    []
+    ]
+
+building2 = Building 0 [
+    (sort [Generator "polonium", Generator "thulium", 
+     Microchip "thulium", Generator "promethium", Generator "ruthenium",
+     Microchip "ruthenium", Generator "cobalt", Microchip "cobalt",
+     Generator "elerium", Microchip "elerium",
+     Generator "dilithium", Microchip "dilithium"]),
+    (sort [Microchip "polonium", Microchip "promethium"]),
+    [],
+    []
+    ]
+
+
+buildingTest = Building 0 [
+    sort([Microchip "hydrogen", Microchip "lithium"]),
+    [Generator "hydrogen"],
+    [Generator "lithium"],
+    []]
+
+canonical :: Building -> CBuilding
+canonical (Building f floors) = CBuilding f (read $ filter (isDigit) $ show $ sort pairs)
+    where names = nub $ map (\(Generator n) -> n) $ filter (isGenerator) $ concat floors
+          floorOf (Generator g) = head (findIndices 
+                                                (\fl -> (Generator g) `elem` fl) 
+                                                floors)
+          floorOf (Microchip g) = head (findIndices 
+                                                (\fl -> (Microchip g) `elem` fl) 
+                                                floors)
+          pairs = foldl (\ps n -> (floorOf (Generator n), floorOf (Microchip n)):ps) [] names
+
+
+
+main :: IO ()
+main = do 
+    part1 
+    part2 
+
+
+part1 :: IO ()
+part1 = print $ length $ trail $ aStar (initAgenda building1) []
+
+part2 :: IO ()
+part2 = print $ length $ trail $aStar (initAgenda building2) []
+
+initAgenda :: Building -> [Agendum]
+initAgenda b = [Agendum {current = b, trail=[], cost = estimateCost b}]
+
+
+aStar :: [Agendum] -> [CBuilding] -> Agendum
+aStar [] _ = Agendum {current=buildingTest, trail=[], cost=0}
+aStar (currentAgendum:agenda) closed = 
+    if isGoal reached then currentAgendum
+    else if creached `elem` closed 
+        then aStar agenda closed
+        else aStar newAgenda (creached:closed) 
+    where 
+        reached = current currentAgendum
+        creached = canonical reached
+        newAgenda = 
+            sortOn (cost) $ 
+            agenda ++ (candidates currentAgendum closed)
+
+
+candidates :: Agendum -> [CBuilding] -> [Agendum]
+candidates agendum closed = newCandidates
+    where
+        candidate = current agendum
+        previous = trail agendum
+        succs = legalSuccessors $ successors candidate
+        excludable = previous ++ closed
+        nonloops = filter (\s -> not $ (canonical s) `elem` excludable) succs
+        newCandidates = map (\n -> makeAgendum n) nonloops
+        makeAgendum new = Agendum {current = new, 
+                                    trail = (canonical candidate):previous, 
+                                    cost = estimateCost new + length previous + 1}
+
+isGoal :: Building -> Bool
+isGoal (Building f floors) =
+    f+1 == height && (all (null) $ take f floors)
+    where height = length floors
+
+isLegal :: Building -> Bool
+isLegal (Building f floors) = 
+    null floor 
+    ||
+    not (any (isGenerator) floor)
+    ||
+    any (safePair) pairs
+    where floor = floors!!f
+          pairs = [(i, j) | i <- floor, j <- floor, isGenerator i]
+          safePair (Generator e, Microchip f) = e == f
+          safePair (Generator _, Generator _) = False
+
+isGenerator :: Item -> Bool
+isGenerator (Generator _) = True
+isGenerator (Microchip _) = False
+
+successors :: Building -> [Building]
+successors (Building f floors) = [updateBuilding f floors nf is | nf <- nextFloors, is <- items]
+    where 
+        floor = floors!!f
+        items = filter (\is -> length is == 1 || length is == 2) $ subsequences floor
+        nextFloors = if f == 0 then [1]
+                     else if f+1 == length floors then [f-1]
+                     else [f+1, f-1]
+
+legalSuccessors :: [Building] -> [Building]
+legalSuccessors = filter (isLegal)
+
+updateBuilding :: Int -> [Floor] -> Int -> [Item] -> Building
+updateBuilding oldF oldFloors newF items = Building newF newFloors
+    where newFloors = map (updateFloor) $ zip [0..] oldFloors
+          updateFloor (f, fl) 
+            | f == oldF = sort $ fl \\ items
+            | f == newF = sort $ items ++ fl
+            | otherwise = fl
+
+estimateCost :: Building -> Int
+estimateCost (Building _ floors) = 
+    sum $ map (\(c, f) -> c * length f) $ zip [0..] $ reverse floors
+
diff --git a/adventofcode16/app/advent11h.hs b/adventofcode16/app/advent11h.hs
new file mode 100644 (file)
index 0000000..d362ee8
--- /dev/null
@@ -0,0 +1,162 @@
+-- Using the idea of canonical representation of buildings from
+-- https://andars.github.io/aoc_day11.html by Andrew Foote,
+-- plus my extension of represening the pairs as an integer.
+
+-- This version is hillclimbing search, using a list for the agenda.
+module Main(main) where
+    
+import Data.List (subsequences, (\\), sort, sortOn, nub, findIndices)
+import Data.Ord (comparing)
+import Data.Char (isDigit)
+
+data Item = Generator String | Microchip String deriving (Show, Eq)
+type Floor = [Item]
+data Building = Building Int [Floor] deriving (Show, Eq)
+data CBuilding = CBuilding Int Integer deriving (Show, Eq)
+data Agendum = Agendum {current :: Building, trail :: [CBuilding], cost :: Int}
+
+instance Ord Item where
+    compare (Generator a) (Generator b) = compare a b
+    compare (Microchip a) (Microchip b) = compare a b
+    compare (Generator _) (Microchip _) = LT
+    compare (Microchip _) (Generator _) = GT
+
+instance Ord Building where
+    compare b1 b2 = comparing estimateCost b1 b2
+
+building1 = Building 0 [
+    (sort [Generator "polonium", Generator "thulium", 
+     Microchip "thulium", Generator "promethium", Generator "ruthenium",
+     Microchip "ruthenium", Generator "cobalt", Microchip "cobalt"]),
+    (sort [Microchip "polonium", Microchip "promethium"]),
+    [],
+    []
+    ]
+
+building0 = Building 0 [
+    (sort [Generator "polonium", Generator "thulium", 
+     Microchip "thulium", Generator "promethium"]),
+    (sort [Microchip "polonium", Microchip "promethium"]),
+    [],
+    []
+    ]
+
+building2 = Building 0 [
+    (sort [Generator "polonium", Generator "thulium", 
+     Microchip "thulium", Generator "promethium", Generator "ruthenium",
+     Microchip "ruthenium", Generator "cobalt", Microchip "cobalt",
+     Generator "elerium", Microchip "elerium",
+     Generator "dilithium", Microchip "dilithium"]),
+    (sort [Microchip "polonium", Microchip "promethium"]),
+    [],
+    []
+    ]
+
+
+buildingTest = Building 0 [
+    sort([Microchip "hydrogen", Microchip "lithium"]),
+    [Generator "hydrogen"],
+    [Generator "lithium"],
+    []]
+
+canonical :: Building -> CBuilding
+canonical (Building f floors) = CBuilding f (read $ filter (isDigit) $ show $ sort pairs)
+    where names = nub $ map (\(Generator n) -> n) $ filter (isGenerator) $ concat floors
+          floorOf (Generator g) = head (findIndices 
+                                                (\fl -> (Generator g) `elem` fl) 
+                                                floors)
+          floorOf (Microchip g) = head (findIndices 
+                                                (\fl -> (Microchip g) `elem` fl) 
+                                                floors)
+          pairs = foldl (\ps n -> (floorOf (Generator n), floorOf (Microchip n)):ps) [] names
+
+
+
+main :: IO ()
+main = do 
+    part1 
+    part2 
+
+
+part1 :: IO ()
+part1 = print $ length $ trail $ hillClimb (initAgenda building1) []
+
+part2 :: IO ()
+part2 = print $ length $ trail $ hillClimb (initAgenda building2) []
+
+initAgenda :: Building -> [Agendum]
+initAgenda b = [Agendum {current = b, trail=[], cost = estimateCost b}]
+
+hillClimb :: [Agendum] -> [CBuilding] -> Agendum
+hillClimb [] _ = Agendum {current=buildingTest, trail=[], cost=0}
+hillClimb (currentAgendum:agenda) closed = 
+    if isGoal reached then currentAgendum
+    else if creached `elem` closed 
+        then hillClimb agenda closed
+        else hillClimb newAgenda (creached:closed) 
+    where 
+        reached = current currentAgendum
+        creached = canonical reached
+        newAgenda = 
+            sortOn (cost) $ 
+            agenda ++ (candidates currentAgendum closed)
+
+
+candidates :: Agendum -> [CBuilding] -> [Agendum]
+candidates agendum closed = newCandidates
+    where
+        candidate = current agendum
+        previous = trail agendum
+        succs = legalSuccessors $ successors candidate
+        excludable = previous ++ closed
+        nonloops = filter (\s -> not $ (canonical s) `elem` excludable) succs
+        newCandidates = map (\n -> makeAgendum n) nonloops
+        makeAgendum new = Agendum {current = new, 
+                                    trail = (canonical candidate):previous, 
+                                    cost = estimateCost new}
+
+isGoal :: Building -> Bool
+isGoal (Building f floors) =
+    f+1 == height && (all (null) $ take f floors)
+    where height = length floors
+
+isLegal :: Building -> Bool
+isLegal (Building f floors) = 
+    null floor 
+    ||
+    not (any (isGenerator) floor)
+    ||
+    any (safePair) pairs
+    where floor = floors!!f
+          pairs = [(i, j) | i <- floor, j <- floor, isGenerator i]
+          safePair (Generator e, Microchip f) = e == f
+          safePair (Generator _, Generator _) = False
+
+isGenerator :: Item -> Bool
+isGenerator (Generator _) = True
+isGenerator (Microchip _) = False
+
+successors :: Building -> [Building]
+successors (Building f floors) = [updateBuilding f floors nf is | nf <- nextFloors, is <- items]
+    where 
+        floor = floors!!f
+        items = filter (\is -> length is == 1 || length is == 2) $ subsequences floor
+        nextFloors = if f == 0 then [1]
+                     else if f+1 == length floors then [f-1]
+                     else [f+1, f-1]
+
+legalSuccessors :: [Building] -> [Building]
+legalSuccessors = filter (isLegal)
+
+updateBuilding :: Int -> [Floor] -> Int -> [Item] -> Building
+updateBuilding oldF oldFloors newF items = Building newF newFloors
+    where newFloors = map (updateFloor) $ zip [0..] oldFloors
+          updateFloor (f, fl) 
+            | f == oldF = sort $ fl \\ items
+            | f == newF = sort $ items ++ fl
+            | otherwise = fl
+
+estimateCost :: Building -> Int
+estimateCost (Building _ floors) = 
+    sum $ map (\(c, f) -> c * length f) $ zip [0..] $ reverse floors
+
diff --git a/adventofcode16/app/advent11p.hs b/adventofcode16/app/advent11p.hs
new file mode 100644 (file)
index 0000000..4136e8f
--- /dev/null
@@ -0,0 +1,166 @@
+-- Using the idea of canonical representation of buildings from
+-- https://andars.github.io/aoc_day11.html by Andrew Foote,
+-- plus my extension of represening the pairs as an integer.
+
+-- This version is A* search, using a priority queue for the agenda.
+
+module Main(main) where
+
+import Data.List (subsequences, (\\), sort, sortOn, nub, findIndices)
+import Data.Ord (comparing)
+import Data.Char (isDigit)
+import Data.Maybe (fromMaybe)
+import qualified Data.PQueue.Prio.Min as P
+
+data Item = Generator String | Microchip String deriving (Show, Eq)
+type Floor = [Item]
+data Building = Building Int [Floor] deriving (Show, Eq)
+data CBuilding = CBuilding Int Integer deriving (Show, Eq)
+data Agendum = Agendum {current :: Building, trail :: [CBuilding], cost :: Int}
+type Agenda = P.MinPQueue Int Agendum
+
+instance Ord Item where
+    compare (Generator a) (Generator b) = compare a b
+    compare (Microchip a) (Microchip b) = compare a b
+    compare (Generator _) (Microchip _) = LT
+    compare (Microchip _) (Generator _) = GT
+
+instance Ord Building where
+    compare b1 b2 = comparing estimateCost b1 b2
+
+building1 = Building 0 [
+    (sort [Generator "polonium", Generator "thulium", 
+     Microchip "thulium", Generator "promethium", Generator "ruthenium",
+     Microchip "ruthenium", Generator "cobalt", Microchip "cobalt"]),
+    (sort [Microchip "polonium", Microchip "promethium"]),
+    [],
+    []
+    ]
+
+building0 = Building 0 [
+    (sort [Generator "polonium", Generator "thulium", 
+     Microchip "thulium", Generator "promethium"]),
+    (sort [Microchip "polonium", Microchip "promethium"]),
+    [],
+    []
+    ]
+
+building2 = Building 0 [
+    (sort [Generator "polonium", Generator "thulium", 
+     Microchip "thulium", Generator "promethium", Generator "ruthenium",
+     Microchip "ruthenium", Generator "cobalt", Microchip "cobalt",
+     Generator "elerium", Microchip "elerium",
+     Generator "dilithium", Microchip "dilithium"]),
+    (sort [Microchip "polonium", Microchip "promethium"]),
+    [],
+    []
+    ]
+
+
+buildingTest = Building 0 [
+    sort([Microchip "hydrogen", Microchip "lithium"]),
+    [Generator "hydrogen"],
+    [Generator "lithium"],
+    []]
+
+canonical :: Building -> CBuilding
+canonical (Building f floors) = CBuilding f (read $ filter (isDigit) $ show $ sort pairs)
+    where names = nub $ map (\(Generator n) -> n) $ filter (isGenerator) $ concat floors
+          floorOf (Generator g) = head (findIndices 
+                                                (\fl -> (Generator g) `elem` fl) 
+                                                floors)
+          floorOf (Microchip g) = head (findIndices 
+                                                (\fl -> (Microchip g) `elem` fl) 
+                                                floors)
+          pairs = foldl (\ps n -> (floorOf (Generator n), floorOf (Microchip n)):ps) [] names
+
+
+main :: IO ()
+main = do 
+    part1 
+    part2 
+
+part1 :: IO ()
+part1 = print $ length $ trail $ fromMaybe (snd $ P.findMin $ initAgenda buildingTest) $ aStar (initAgenda building1) []
+
+part2 :: IO ()
+part2 = print $ length $ trail $ fromMaybe (snd $ P.findMin $ initAgenda buildingTest) $ aStar (initAgenda building2) []
+
+initAgenda :: Building -> Agenda
+initAgenda b = P.singleton (estimateCost b) Agendum {current = b, trail=[], cost = estimateCost b}
+
+
+aStar :: Agenda -> [CBuilding] -> Maybe Agendum
+-- aStar [] _ = Agendum {current=buildingTest, trail=[], cost=0}
+aStar agenda closed 
+    | P.null agenda = Nothing
+    | otherwise = 
+        if isGoal reached then Just currentAgendum
+        else if creached `elem` closed 
+            then aStar (P.deleteMin agenda) closed
+            else aStar newAgenda (creached:closed) 
+        where 
+            (_, currentAgendum) = P.findMin agenda
+            reached = current currentAgendum
+            creached = canonical reached
+            newAgenda = P.union (P.deleteMin agenda) 
+                                (P.fromList $ candidates currentAgendum closed)
+
+
+candidates :: Agendum -> [CBuilding] -> [(Int, Agendum)]
+candidates agendum closed = newCandidates
+    where
+        candidate = current agendum
+        previous = trail agendum
+        succs = legalSuccessors $ successors candidate
+        nonloops = filter (\s -> not $ (canonical s) `elem` closed) succs
+        newCandidates = map (\a -> (cost a, a)) $ map (\n -> makeAgendum n) nonloops
+        makeAgendum new = Agendum {current = new, 
+                                    trail = (canonical candidate):previous, 
+                                    cost = estimateCost new + length previous + 1}
+
+isGoal :: Building -> Bool
+isGoal (Building f floors) =
+    f+1 == height && (all (null) $ take f floors)
+    where height = length floors
+
+isLegal :: Building -> Bool
+isLegal (Building f floors) = 
+    null floor 
+    ||
+    not (any (isGenerator) floor)
+    ||
+    any (safePair) pairs
+    where floor = floors!!f
+          pairs = [(i, j) | i <- floor, j <- floor, isGenerator i]
+          safePair (Generator e, Microchip f) = e == f
+          safePair (Generator _, Generator _) = False
+
+isGenerator :: Item -> Bool
+isGenerator (Generator _) = True
+isGenerator (Microchip _) = False
+
+successors :: Building -> [Building]
+successors (Building f floors) = [updateBuilding f floors nf is | nf <- nextFloors, is <- items]
+    where 
+        floor = floors!!f
+        items = filter (\is -> length is == 1 || length is == 2) $ subsequences floor
+        nextFloors = if f == 0 then [1]
+                     else if f+1 == length floors then [f-1]
+                     else [f+1, f-1]
+
+legalSuccessors :: [Building] -> [Building]
+legalSuccessors = filter (isLegal)
+
+updateBuilding :: Int -> [Floor] -> Int -> [Item] -> Building
+updateBuilding oldF oldFloors newF items = Building newF newFloors
+    where newFloors = map (updateFloor) $ zip [0..] oldFloors
+          updateFloor (f, fl) 
+            | f == oldF = sort $ fl \\ items
+            | f == newF = sort $ items ++ fl
+            | otherwise = fl
+
+estimateCost :: Building -> Int
+estimateCost (Building _ floors) = 
+    sum $ map (\(c, f) -> c * length f) $ zip [0..] $ reverse floors
+
diff --git a/adventofcode16/app/advent12.hs b/adventofcode16/app/advent12.hs
new file mode 100644 (file)
index 0000000..906c185
--- /dev/null
@@ -0,0 +1,134 @@
+module Main(main) where
+
+import Text.Parsec hiding (State)
+import Text.ParserCombinators.Parsec.Number
+import Data.List (partition, union, intersect, tails)
+import Data.Char (isDigit)
+import Control.Monad.State.Lazy
+
+data Location = Literal Int | Register Char deriving (Show)
+data Instruction = Cpy Location Location | 
+                   Inc Location |
+                   Dec Location | 
+                   Jnz Location Int
+                   deriving (Show)
+
+data Machine = Machine { a :: Int
+                       , b :: Int
+                       , c :: Int
+                       , d :: Int
+                       , pc :: Int
+                       , instructions :: [Instruction]} 
+               deriving (Show)
+
+emptyMachine :: Machine
+emptyMachine = Machine {a=0, b=0, c=0, d=0, pc=0, instructions=[]}
+
+main :: IO ()
+main = do 
+    text <- readFile "data/advent12.txt" 
+    let instructions = successfulParse $ parseIfile text
+    part1 instructions
+    part2 instructions
+
+
+part1 :: [Instruction] -> IO ()
+part1 instrs = 
+    do  let m0 = emptyMachine {instructions=instrs}
+        let mf = snd $ runState runMachine m0
+        print (a mf)
+
+part2 :: [Instruction] -> IO ()
+part2 instrs = 
+    do  let m0 = emptyMachine {instructions=instrs, c=1}
+        let mf = snd $ runState runMachine m0
+        print (a mf)
+
+
+
+runMachine :: State Machine ()
+runMachine = 
+    do  m <- get
+        if (pc m) >= (length $ instructions m)
+            then return ()
+            else do executeStep
+                    runMachine
+
+executeStep :: State Machine ()
+executeStep = 
+    do  m <- get
+        let i = (instructions m)!!(pc m)
+        put (executeInstruction i m)
+
+executeInstruction :: Instruction -> Machine -> Machine
+executeInstruction (Inc (Register r)) m = m' {pc=pc1}
+    where pc1 = (pc m) + 1
+          v = evaluate m (Register r)
+          m' = writeValue m (Register r) (v+1)
+executeInstruction (Dec (Register r)) m = m' {pc=pc1}
+    where pc1 = (pc m) + 1
+          v = evaluate m (Register r)
+          m' = writeValue m (Register r) (v-1)
+executeInstruction (Cpy s d) m = m' {pc=pc1}
+    where pc1 = (pc m) + 1
+          v = evaluate m s
+          m' = writeValue m d v
+executeInstruction (Jnz s d) m 
+    | v == 0 = m {pc=pc1}
+    | otherwise = m {pc=pcj}
+    where pc1 = (pc m) + 1
+          pcj = (pc m) + d
+          v = evaluate m s
+          
+
+evaluate :: Machine -> Location -> Int
+evaluate _ (Literal i) = i
+evaluate m (Register r) = 
+    case r of
+        'a' -> (a m)
+        'b' -> (b m)
+        'c' -> (c m)
+        'd' -> (d m)
+
+writeValue :: Machine -> Location -> Int -> Machine
+writeValue m (Literal i) _ = m
+writeValue m (Register r) v =
+    case r of 
+        'a' -> m {a=v}
+        'b' -> m {b=v}
+        'c' -> m {c=v}
+        'd' -> m {d=v}
+
+
+instructionFile = instructionLine `endBy` newline 
+-- instructionLine = choice [cpyL, incL, decL, jnzL]
+instructionLine = incL <|> decL <|> cpyL <|> jnzL
+
+incL = incify <$> (string "inc" *> spaces *> (oneOf "abcd"))
+        where incify r = Inc (Register r)
+decL = decify <$> (string "dec" *> spaces *> (oneOf "abcd"))
+        where decify r = Dec (Register r)
+cpyL = cpyify <$> (string "cpy" *> spaces *> ((many1 letter) <|> (many1 digit))) 
+                  <*> (spaces *> (oneOf "abcd"))
+        where cpyify s r = Cpy (readLocation s) (Register r)
+jnzL = jnzify <$> (string "jnz" *> spaces *> ((many1 letter) <|> (many1 digit))) 
+                  <*> (spaces *> int)
+        where jnzify r d = Jnz (readLocation r) d
+
+
+readLocation :: String -> Location
+readLocation l
+    | all (isDigit) l = Literal (read l)
+    | otherwise = Register (head l)
+
+
+
+parseIfile :: String -> Either ParseError [Instruction]
+parseIfile input = parse instructionFile "(unknown)" input
+
+parseIline :: String -> Either ParseError Instruction
+parseIline input = parse instructionLine "(unknown)" input
+
+successfulParse :: Either ParseError [a] -> [a]
+successfulParse (Left _) = []
+successfulParse (Right a) = a
\ No newline at end of file
diff --git a/adventofcode16/app/advent13.hs b/adventofcode16/app/advent13.hs
new file mode 100644 (file)
index 0000000..86981df
--- /dev/null
@@ -0,0 +1,95 @@
+module Main(main) where
+
+import Data.List ((\\), nub, sortOn)
+import Data.Bits (popCount)
+import Data.Maybe (fromMaybe)
+
+type Pos = (Int, Int)
+
+seed = 1362
+
+goal1 = (31, 39)
+
+main :: IO ()
+main = do 
+    part1 
+    part2 
+
+
+part1 :: IO ()
+part1 = print $ length $ tail $ fromMaybe [] $ aStar [[(1, 1)]] []
+
+part2 :: IO ()
+part2 = do print $ length $ tail $ edl 50 [[(1, 1)]] []
+           putStrLn $ showRoomR 30 25 $ edl 50 [[(1, 1)]] []
+
+
+-- extractJust :: Maybe [a] -> [a]
+-- extractJust Nothing = []
+-- extractJust (Just x) = x
+isWall :: Int -> Int -> Bool
+isWall x y = odd $ popCount n
+    where 
+        n = x*x + 3*x + 2*x*y + y + y*y + seed
+
+
+showRoom w h = showRoomR w h []
+
+showRoomR w h reached = unlines rows
+    where 
+        rows = [row x | x <- [0..h]]
+        row x = [showCell x y | y <- [0..w]]
+        showCell x y = if (isWall x y) 
+            then '#' 
+            else if (x, y) `elem` reached 
+                then 'O'
+                else '.'
+
+
+aStar :: [[Pos]] -> [Pos] -> Maybe [Pos]
+aStar [] _ = Nothing
+aStar (currentTrail:trails) closed = 
+    if isGoal (head currentTrail) then Just currentTrail
+    else if (head currentTrail) `elem` closed then aStar trails closed
+         else aStar newAgenda ((head currentTrail): closed) 
+    where newAgenda = 
+            sortOn (\a -> trailCost a) $ 
+            trails ++ (candidates currentTrail closed)
+          trailCost t = estimateCost (head t) + length t - 1
+
+
+-- exhaustive depth-limited
+edl :: Int -> [[Pos]] -> [Pos] -> [Pos]
+edl _ [] closed = nub closed
+edl limit (currentTrail:trails) closed = 
+    if (length currentTrail) > (limit+1) then edl limit trails ((head currentTrail):closed)
+    else if (head currentTrail) `elem` closed then edl limit trails closed
+         else edl limit newAgenda ((head currentTrail):closed) 
+    where newAgenda = trails ++ (candidates currentTrail closed)
+
+candidates :: [Pos] -> [Pos] -> [[Pos]]
+candidates currentTrail closed = newCandidates
+    where
+        (candidate:trail) = currentTrail
+        succs = legalSuccessors $ successors candidate
+        nonloops = (succs \\ trail) \\ closed
+        newCandidates = map (\n -> n:candidate:trail) nonloops
+
+isGoal :: Pos -> Bool
+isGoal p = p == goal1
+
+isLegal :: Pos -> Bool
+isLegal (x, y) = 
+    x >= 0 && y >= 0 && (not $ isWall x y)
+
+successors :: Pos -> [Pos]
+successors (x, y) = [(x-1, y), (x+1, y), (x, y-1), (x, y+1)]
+
+legalSuccessors :: [Pos] -> [Pos]
+legalSuccessors = filter (isLegal)
+
+estimateCost :: Pos -> Int
+estimateCost (x, y) = abs (x - gx) + abs (y - gy)
+    where (gx, gy) = goal1
+
diff --git a/adventofcode16/app/advent14.hs b/adventofcode16/app/advent14.hs
new file mode 100644 (file)
index 0000000..c6c092e
--- /dev/null
@@ -0,0 +1,43 @@
+module Main(main) where
+
+import Data.List (nub, tails, null)
+import Data.Hash.MD5 (md5s, Str(..))
+
+salt = "yjdafjpo"
+-- salt = "abc"
+
+main :: IO ()
+main = do 
+        part1 
+        part2
+
+part1 :: IO ()
+part1 = print $ head $ drop 63 $ filter (\i -> possibleKey sq i && confirmKey sq i) [0..]
+    where sq = md5sequence
+
+part2 :: IO ()
+part2 = print $ head $ drop 63 $ filter (\i -> possibleKey sq i && confirmKey sq i) [0..]
+    where sq = md5sequenceS
+
+md5sequence :: [String]
+md5sequence = [makeMd5 i | i <- [0..]]
+    where makeMd5 i = md5s (Str (salt ++ show i))
+
+md5sequenceS :: [String]
+md5sequenceS = [makeMd5 i | i <- [0..]]
+    where makeMd5 i = stretch $ md5s (Str (salt ++ show i)) 
+          stretch h0 = foldr (\_ h -> md5s (Str h)) h0 [1..2016]
+
+possibleKey :: [String] -> Int-> Bool
+possibleKey s = not . null . repeats 3 . ((!!) s)
+
+confirmKey :: [String] -> Int -> Bool
+confirmKey s i = any (confirmation) $ take 1000 $ drop (i+1) s
+    where c = head $ repeats 3 $ s!!i
+          confirmation m = c `elem` (repeats 5 m)
+
+repeats :: Int -> String -> [String]
+repeats n = filter (null . tail) . map (nub) . substrings n
+
+substrings :: Int -> [a] -> [[a]]
+substrings l = filter (\s -> (length s) == l) . map (take l) . tails
diff --git a/adventofcode16/app/advent14c.hs b/adventofcode16/app/advent14c.hs
new file mode 100644 (file)
index 0000000..ea699ed
--- /dev/null
@@ -0,0 +1,47 @@
+module Main(main) where
+
+import Data.List (nub, tails)
+import Data.ByteString.Char8 (pack)
+import Crypto.Hash (hash, Digest, MD5)
+
+salt = "yjdafjpo"
+-- salt = "abc"
+
+main :: IO ()
+main = do 
+        part1 
+        part2
+
+part1 :: IO ()
+part1 = print $ head $ drop 63 $ filter (\i -> possibleKey sq i && confirmKey sq i) [0..]
+    where sq = md5sequence
+
+part2 :: IO ()
+part2 = print $ head $ drop 63 $ filter (\i -> possibleKey sq i && confirmKey sq i) [0..]
+    where sq = md5sequenceS
+
+getHash :: String -> String
+getHash bs = show (hash $ pack bs :: Digest MD5)
+
+md5sequence :: [String]
+md5sequence = [makeMd5 i | i <- [0..]]
+    where makeMd5 i = getHash (salt ++ show i)
+
+md5sequenceS :: [String]
+md5sequenceS = [makeMd5 i | i <- [0..]]
+    where makeMd5 i = stretch $ getHash (salt ++ show i)
+          stretch h0 = foldr (\_ h -> getHash h) h0 [1..2016]
+
+possibleKey :: [String] -> Int-> Bool
+possibleKey s = not . null . repeats 3 . ((!!) s)
+
+confirmKey :: [String] -> Int -> Bool
+confirmKey s i = any (confirmation) $ take 1000 $ drop (i+1) s
+    where c = head $ repeats 3 $ s!!i
+          confirmation m = c `elem` (repeats 5 m)
+                              
+repeats :: Int -> String -> [String]
+repeats n = filter (null . tail) . map (nub) . substrings n
+
+substrings :: Int -> [a] -> [[a]]
+substrings l = filter (\s -> (length s) == l) . map (take l) . tails
diff --git a/adventofcode16/app/advent14parallel.hs b/adventofcode16/app/advent14parallel.hs
new file mode 100644 (file)
index 0000000..b0ca781
--- /dev/null
@@ -0,0 +1,53 @@
+module Main(main) where
+
+import Data.List (nub, tails)
+import Data.ByteString.Char8 (pack)
+import Crypto.Hash (hash, Digest, MD5)
+import Control.Parallel.Strategies (withStrategy, parBuffer, rdeepseq)
+
+salt = "yjdafjpo"
+-- salt = "abc"
+
+stretch_factor = [1..2016]
+-- stretch_factor = [1..100]
+
+main :: IO ()
+main = do 
+        part1 
+        part2
+
+part1 :: IO ()
+part1 = print $ head $ drop 63 $ filter (\i -> possibleKey sq i && confirmKey sq i) [0..]
+    where sq = md5sequence
+
+part2 :: IO ()
+part2 = print $ head $ drop 63 $ filter (\i -> possibleKey sq i && confirmKey sq i) [0..]
+    where sq = md5sequenceS
+
+getHash :: String -> String
+getHash bs = show (hash $ pack bs :: Digest MD5)
+
+md5sequence :: [String]
+-- md5sequence = [makeMd5 i | i <- [0..]]
+md5sequence = withStrategy (parBuffer 100 rdeepseq) $ map (makeMd5) [0..]
+    where makeMd5 i = getHash (salt ++ show i)
+
+md5sequenceS :: [String]
+-- md5sequenceS = [makeMd5 i | i <- [0..]]
+md5sequenceS = withStrategy (parBuffer 100 rdeepseq) $ map (makeMd5) [0..]
+    where makeMd5 i = stretch $ getHash (salt ++ show i)
+          stretch h0 = foldr (\_ h -> getHash h) h0 stretch_factor
+
+possibleKey :: [String] -> Int-> Bool
+possibleKey s = not . null . repeats 3 . ((!!) s)
+
+confirmKey :: [String] -> Int -> Bool
+confirmKey s i = any (confirmation) $ take 1000 $ drop (i+1) s
+    where c = head $ repeats 3 $ s!!i
+          confirmation m = c `elem` (repeats 5 m)
+                              
+repeats :: Int -> String -> [String]
+repeats n = filter (null . tail) . map (nub) . substrings n
+
+substrings :: Int -> [a] -> [[a]]
+substrings l = filter (\s -> (length s) == l) . map (take l) . tails
diff --git a/adventofcode16/app/advent15.hs b/adventofcode16/app/advent15.hs
new file mode 100644 (file)
index 0000000..5970bd6
--- /dev/null
@@ -0,0 +1,43 @@
+module Main(main) where
+
+import Text.Parsec 
+import Text.ParserCombinators.Parsec.Number
+
+type Disk = (Int -> Bool)
+
+main :: IO ()
+main = do 
+    text <- readFile "data/advent15.txt" 
+    let disks = successfulParse $ parseIfile text
+    part1 disks
+    part2 disks
+
+part1 :: [Disk] -> IO ()
+part1 disks = print $ head $ filter (canFall disks) [0..]
+
+part2 :: [Disk] -> IO ()
+part2 disks = print $ head $ filter (canFall disks2) [0..]
+    where disks2 = disks ++ [diskify 7 11 0]
+
+canFall :: [Disk] -> Int -> Bool
+canFall ds i = all (\d -> (d i)) ds
+
+
+instructionFile = instructionLine `endBy` newline 
+instructionLine = diskify <$> (string "Disc #" *> int) 
+                          <*> (string " has " *> int)
+                          <*> (string " positions; at time=0, it is at position " *> int)
+                          <*  (string ".")
+
+diskify :: Int -> Int -> Int -> (Int -> Bool)
+diskify n size pos0 = (\i -> (size + n + pos0 + i) `mod` size == 0)
+
+parseIfile :: String -> Either ParseError [Disk]
+parseIfile input = parse instructionFile "(unknown)" input
+
+parseIline :: String -> Either ParseError Disk
+parseIline input = parse instructionLine "(unknown)" input
+
+successfulParse :: Either ParseError [a] -> [a]
+successfulParse (Left _) = []
+successfulParse (Right a) = a
diff --git a/adventofcode16/app/advent15l.hs b/adventofcode16/app/advent15l.hs
new file mode 100644 (file)
index 0000000..67e2ac0
--- /dev/null
@@ -0,0 +1,39 @@
+module Main(main) where
+
+import Text.Parsec 
+import Text.ParserCombinators.Parsec.Number
+
+main :: IO ()
+main = do 
+    text <- readFile "data/advent15.txt" 
+    let disks = successfulParse $ parseIfile text
+    part1 disks
+    part2 disks
+
+part1 :: [[Int]] -> IO ()
+part1 disks = print $ head $ filter (canFall disks) [0..]
+
+part2 :: [[Int]] -> IO ()
+part2 disks = print $ head $ filter (canFall disks2) [0..]
+    where disks2 = disks ++ [drop 7 $ drop 0 $ cycle [0..(11-1)]]
+
+canFall :: [[Int]] -> Int -> Bool
+canFall ds i = all (\d -> (d!!i) == 0) ds
+
+
+instructionFile = instructionLine `endBy` newline 
+instructionLine = diskify <$> (string "Disc #" *> int) 
+                          <*> (string " has " *> int)
+                          <*> (string " positions; at time=0, it is at position " *> int)
+                          <*  (string ".")
+                    where diskify n size pos0 = drop n $ drop pos0 $ cycle [0..(size-1)]
+
+parseIfile :: String -> Either ParseError [[Int]]
+parseIfile input = parse instructionFile "(unknown)" input
+
+parseIline :: String -> Either ParseError [Int]
+parseIline input = parse instructionLine "(unknown)" input
+
+successfulParse :: Either ParseError [a] -> [a]
+successfulParse (Left _) = []
+successfulParse (Right a) = a
diff --git a/adventofcode16/app/advent16.hs b/adventofcode16/app/advent16.hs
new file mode 100644 (file)
index 0000000..88b8b59
--- /dev/null
@@ -0,0 +1,42 @@
+module Main(main) where
+
+import Data.List (nub)
+
+input = "11100010111110100"
+disk1length = 272
+disk2length = 35651584
+
+-- input = "10000"
+-- disk1length = 20
+
+main :: IO ()
+main = do 
+    part1 
+    part2
+
+part1 :: IO ()
+part1 = putStrLn $ checksum $ take disk1length $ expand disk1length input
+
+part2 :: IO ()
+part2 = putStrLn $ checksum $ take disk2length $ expand disk2length input
+
+
+expand :: Int -> String -> String
+expand len a
+    | length a >= len = a
+    | otherwise = expand len $ a ++ "0" ++ b
+        where b = map (invert) $ reverse a
+              invert '0' = '1'
+              invert '1' = '0'
+
+checksum :: String -> String
+checksum digits
+    | odd $ length digits = digits
+    | otherwise = checksum $ map (checksumPair) $ pairs digits
+        where checksumPair p = if (length $ nub p) == 1 then '1' else '0'
+
+
+pairs :: [a] -> [[a]]
+pairs [] = []
+pairs xs = [p] ++ (pairs ys)
+    where (p, ys) = splitAt 2 xs 
diff --git a/adventofcode16/app/advent16i.hs b/adventofcode16/app/advent16i.hs
new file mode 100644 (file)
index 0000000..897559d
--- /dev/null
@@ -0,0 +1,45 @@
+module Main(main) where
+
+input = "11100010111110100"
+disk1length = 272
+disk2length = 35651584
+
+-- input = "10000"
+-- disk1length = 20
+
+main :: IO ()
+main = do 
+    part1 
+    part2
+
+part1 :: IO ()
+part1 = print $ fill disk1length input
+
+part2 :: IO ()
+part2 = print $ fill disk2length input
+
+fill :: Int -> String -> String
+fill len filler = deBool $ checksum $ take len $ expand len $ enBool filler
+
+enBool :: String -> [Bool]
+enBool = map (== '1')
+
+deBool :: [Bool] -> String
+deBool = map (\b -> if b then '1' else '0')
+
+
+expand :: Int -> [Bool] -> [Bool]
+expand len = head . dropWhile ((<= len) . length) . iterate expandStep
+
+expandStep :: [Bool] -> [Bool]
+expandStep a = a ++ [False] ++ b
+        where b = map (not) $ reverse a
+
+checksum :: [Bool] -> [Bool]
+checksum = head . dropWhile (even . length) . iterate checksumStep 
+
+checksumStep :: [Bool] -> [Bool]
+checksumStep [] = []
+checksumStep [x] = [x]
+checksumStep (x:y:xs) = (x==y):(checksumStep xs)
+
diff --git a/adventofcode16/app/advent17.hs b/adventofcode16/app/advent17.hs
new file mode 100644 (file)
index 0000000..e757def
--- /dev/null
@@ -0,0 +1,77 @@
+module Main(main) where
+
+import Data.ByteString.Char8 (pack)
+import qualified Crypto.Hash as C
+
+type Position = (Int, Int)
+data Agendum = Agendum {position :: Position, path :: String, hash :: String} deriving (Show, Eq)
+type Agenda = [Agendum]
+
+-- input = "hijkl"
+-- input = "ihgpwlah"
+
+input = "qljzarfv" -- my input
+
+main :: IO ()
+main = do 
+    part1 
+    part2 
+
+part1 :: IO ()
+part1 = putStrLn $ path $ extractJust $ bfs initialAgenda
+
+part2 :: IO ()
+part2 = print $ bfs2 initialAgenda 0
+
+initialAgenda :: Agenda
+initialAgenda = [Agendum {position=(1, 1), path="", hash=(getHash "")}]
+
+getHash :: String -> String
+getHash path = show (C.hash $ pack (input ++ path) :: C.Digest C.MD5)
+
+extractJust :: Maybe Agendum -> Agendum
+extractJust Nothing = head initialAgenda
+extractJust (Just x) = x
+
+bfs :: Agenda -> Maybe Agendum
+bfs [] = Nothing
+bfs (current:agenda) = 
+    if isGoal current then Just current
+    else bfs (agenda ++ (successors current))
+
+bfs2 :: Agenda -> Int -> Int
+bfs2 [] l = l
+bfs2 (current:agenda) l = 
+    if isGoal current then bfs2 agenda (length $ path $ current)
+    else bfs2 (agenda ++ (successors current)) l
+
+isGoal :: Agendum -> Bool
+isGoal agendum = (position agendum) == (4, 4)
+
+isLegalPos :: Position -> Bool
+isLegalPos p = fst p >= 1 && fst p <= 4 && snd p >= 1 && snd p <= 4
+
+successors :: Agendum -> Agenda
+successors state = [Agendum {position = step p0 ld, 
+                             path = path0 ++ [ld],
+                             hash = getHash (path0 ++ [ld])} | ld <- legalDoors ]
+    where 
+        p0 = position state
+        path0 = path state
+        h0 = hash state
+        doors = openDoors h0
+        legalDoors = filter (isLegalPos . (step p0)) doors
+
+openDoors :: String -> String
+openDoors h = up ++ down ++ left ++ right
+    where
+        up    = if h!!0 `elem` "bcdef" then "U" else ""
+        down  = if h!!1 `elem` "bcdef" then "D" else ""
+        left  = if h!!2 `elem` "bcdef" then "L" else ""
+        right = if h!!3 `elem` "bcdef" then "R" else ""
+
+step :: Position -> Char -> Position
+step (r, c) 'U' = (r-1, c)
+step (r, c) 'D' = (r+1, c)
+step (r, c) 'L' = (r, c-1)
+step (r, c) 'R' = (r, c+1)
diff --git a/adventofcode16/app/advent18.hs b/adventofcode16/app/advent18.hs
new file mode 100644 (file)
index 0000000..2b1462f
--- /dev/null
@@ -0,0 +1,42 @@
+module Main(main) where
+
+import Data.List (tails)
+
+-- input = "..^^."
+-- input = ".^^.^.^^^^"
+input = "^.^^^.^..^....^^....^^^^.^^.^...^^.^.^^.^^.^^..^.^...^.^..^.^^.^..^.....^^^.^.^^^..^^...^^^...^...^."
+
+main :: IO ()
+main = do 
+        part1 
+        part2
+
+part1 :: IO ()
+-- part1 = putStrLn $ unlines $ map (showRow) $ take 10 $ iterate nextRow $ readRow input
+part1 = print $ length $ filter (not) $ concat $ take 40 $ iterate nextRow $ readRow input
+
+part2 :: IO ()
+part2 = print $ length $ filter (not) $ concat $ take 400000 $ iterate nextRow $ readRow input
+
+readRow :: String -> [Bool]
+readRow = map (=='^')
+
+showRow :: [Bool] -> String
+showRow = map (\c -> if c then '^' else '.')
+
+extended :: [Bool] -> [Bool]
+extended row = [False] ++ row ++ [False]
+
+nextRow :: [Bool] -> [Bool]
+nextRow = map (isTrap) . segments . extended
+
+segments :: [a] -> [[a]]
+segments = filter ((==3) . length) . map (take 3) . tails
+
+isTrap :: [Bool] -> Bool
+isTrap segment
+    | segment == [True, True, False] = True
+    | segment == [False, True, True] = True
+    | segment == [True, False, False] = True
+    | segment == [False, False, True] = True
+    | otherwise = False
diff --git a/adventofcode16/app/advent18f.hs b/adventofcode16/app/advent18f.hs
new file mode 100644 (file)
index 0000000..d1650e6
--- /dev/null
@@ -0,0 +1,50 @@
+module Main(main) where
+
+import Data.List (tails, foldl')
+
+-- input = "..^^."
+-- input = ".^^.^.^^^^"
+input = "^.^^^.^..^....^^....^^^^.^^.^...^^.^.^^.^^.^^..^.^...^.^..^.^^.^..^.....^^^.^.^^^..^^...^^^...^...^."
+
+main :: IO ()
+main = do 
+        part1 
+        part2
+
+part1 :: IO ()
+part1 = print $ fst $ foldl' nextRowFold (countSafe row, row) [2..40]
+    where row = readRow input
+
+part2 :: IO ()
+part2 = print $ fst $ foldl' nextRowFold (countSafe row, row) [2..400000]
+    where row = readRow input
+
+readRow :: String -> [Bool]
+readRow = map (=='^')
+
+showRow :: [Bool] -> String
+showRow = map (\c -> if c then '^' else '.')
+
+extended :: [Bool] -> [Bool]
+extended row = [False] ++ row ++ [False]
+
+nextRow :: [Bool] -> [Bool]
+nextRow = map (isTrap) . segments . extended
+
+nextRowFold :: (Int, [Bool]) -> Int -> (Int, [Bool])
+nextRowFold (n, row) _ = (n + countSafe newRow, newRow)
+    where newRow = nextRow row
+
+countSafe :: [Bool] -> Int
+countSafe = length . filter (not)
+
+segments :: [a] -> [[a]]
+segments = filter ((==3) . length) . map (take 3) . tails
+
+isTrap :: [Bool] -> Bool
+isTrap segment
+    | segment == [True, True, False] = True
+    | segment == [False, True, True] = True
+    | segment == [True, False, False] = True
+    | segment == [False, False, True] = True
+    | otherwise = False
diff --git a/adventofcode16/app/advent19.hs b/adventofcode16/app/advent19.hs
new file mode 100644 (file)
index 0000000..009a07c
--- /dev/null
@@ -0,0 +1,37 @@
+module Main(main) where
+
+import Prelude hiding (length, take, drop)
+import Data.Sequence
+
+-- input = 5 
+input = 3012210 
+
+main :: IO ()
+main = do 
+    part1 
+    part2
+
+part1 :: IO ()
+part1 = print $ 2 * (input - 2 ^ (toInteger (floor $ logBase 2 (fromIntegral input)))) + 1
+
+part2 :: IO ()
+part2 = print $ flip index 0 $ presentSteps initial
+
+presentSteps :: Seq Int -> Seq Int
+presentSteps elves 
+    | isFinished elves = elves
+    | otherwise = presentSteps $ next elves
+
+initial :: Seq Int
+initial = fromList [1..input] 
+
+isFinished :: Seq Int -> Bool
+isFinished elves = length elves == 1
+
+next :: Seq Int -> Seq Int
+next elves = prefix >< (midfix |> suffix)
+    where 
+        target = length elves `quot` 2
+        prefix = drop 1 $ take target elves
+        midfix = drop (target+1) elves
+        suffix = index elves 0
diff --git a/adventofcode16/app/advent20.hs b/adventofcode16/app/advent20.hs
new file mode 100644 (file)
index 0000000..8830c45
--- /dev/null
@@ -0,0 +1,74 @@
+module Main(main) where
+
+import Text.Parsec 
+import Text.ParserCombinators.Parsec.Number
+import Data.List (foldl')
+
+data Interval = Interval Int Int deriving (Show, Eq)
+
+low :: Interval -> Int
+low (Interval l _) = l
+
+high :: Interval -> Int
+high (Interval _ h) = h
+
+main :: IO ()
+main = do 
+    text <- readFile "data/advent20.txt" 
+    let intervals = successfulParse $ parseIfile text
+    part1 intervals
+    part2 intervals
+
+part1 :: [Interval] -> IO ()
+part1 intervals = print $ (+1) $ high $ head $ foldl' (mergeAdjacent) [] $ foldl' (merge) [] intervals
+
+part2 :: [Interval] -> IO ()
+part2 intervals = do
+    let ints = foldl' (mergeAdjacent) [] $ foldl' (merge) [] intervals
+    let gapCount = gaps ints
+    let lowGap = low $ head ints
+    let highGap = 4294967295 - (high $ last ints)
+    print (lowGap + gapCount + highGap)
+
+disjoint :: Interval -> Interval -> Bool
+disjoint (Interval a b) (Interval c d)
+    | b < c = True
+    | d < a = True
+    | a > d = True
+    | c > b = True
+    | otherwise = False
+
+intersect :: Interval -> Interval -> Bool
+intersect a b = not $ disjoint a b
+
+merge :: [Interval] -> Interval -> [Interval]
+merge [] i0 = [i0]
+merge (i1:intervals) i0
+    | (high i0) < (low i1) = i0:i1:intervals
+    | intersect i0 i1 = merge intervals (Interval a' b')
+    | otherwise = i1:(merge intervals i0)
+        where a' = minimum [low i0, low i1]
+              b' = maximum [high i0, high i1]
+
+mergeAdjacent :: [Interval] -> Interval -> [Interval]
+mergeAdjacent [] i0 = [i0]
+mergeAdjacent (i1:intervals) i0
+    | high i0 + 1 == low i1 = (Interval (low i0) (high i1)):intervals
+    | low i0 == high i1 + 1 = (Interval (low i1) (high i0)):intervals
+    | otherwise = i1:(mergeAdjacent intervals i0)
+
+gaps :: [Interval] -> Int
+gaps [] = 0
+gaps [_] = 0
+gaps ((Interval _ b):(Interval c d):intervals) = 
+    (c - b - 1) + gaps ((Interval c d):intervals)
+
+intervalFile = intervalLine `endBy` newline 
+intervalLine = Interval <$> int <*> (string "-" *> int)
+
+parseIfile :: String -> Either ParseError [Interval]
+parseIfile input = parse intervalFile "(unknown)" input
+
+successfulParse :: Either ParseError [a] -> [a]
+successfulParse (Left _) = []
+successfulParse (Right a) = a
diff --git a/adventofcode16/app/advent21.hs b/adventofcode16/app/advent21.hs
new file mode 100644 (file)
index 0000000..2415974
--- /dev/null
@@ -0,0 +1,198 @@
+module Main(main) where
+
+import Text.Parsec hiding (State)
+import Text.ParserCombinators.Parsec.Number
+import Data.Maybe (fromJust)
+import Data.List (elemIndex)
+
+import Control.Monad.Identity
+import Control.Monad.State
+import Control.Monad.Writer
+
+data Instruction =    SwapPosition Int Int 
+                    | SwapLetter Char Char
+                    | RotateSteps Int
+                    | RotateLetter Char
+                    | Reverse Int Int
+                    | Move Int Int 
+                    deriving (Show, Eq)
+
+data Log = Log {
+    action :: String
+    } deriving (Show)
+
+data Password = Password {
+    password :: String
+    } deriving (Show)
+
+
+type App = WriterT [Log] (StateT Password Identity)
+
+infixl 9 ??
+
+(??) :: Eq a => [a] -> a -> Int
+(??) items item = fromJust $ elemIndex item items
+
+
+initial = "abcdefgh"
+final   = "fbgdceah"
+
+testInstructions = "\
+\swap position 4 with position 0\n\
+\swap letter d with letter b\n\
+\reverse positions 0 through 4\n\
+\rotate left 1 step\n\
+\move position 1 to position 4\n\
+\move position 3 to position 0\n\
+\rotate based on position of letter b\n\
+\rotate based on position of letter d\n"
+
+main :: IO ()
+main = do 
+    -- let ti = successfulParse $ parseIfile testInstructions
+    -- part1 ti "abcde"
+    -- part2 (reverse ti) "decab"
+    text <- readFile "data/advent21.txt" 
+    let instructions = successfulParse $ parseIfile text
+    part1 instructions initial
+    part2 (reverse instructions) final
+
+part1 :: [Instruction] -> String -> IO ()
+part1 instructions start = 
+    let st = Password {password = start}
+        ((_, log), st') = runIdentity (runStateT (runWriterT (apply instructions)) st)
+    in do 
+        -- putStrLn $ unlines $ map (action) log
+        putStrLn $ password st'
+
+part2 :: [Instruction] -> String -> IO ()
+part2 instructions end = 
+    let st = Password {password = end}
+        ((_, log), st') = runIdentity (runStateT (runWriterT (unApply instructions)) st)
+    in do 
+        -- putStrLn $ unlines $ map (action) log
+        putStrLn $ password st'
+
+
+apply :: [Instruction] -> App ()
+apply [] = return ()
+apply (i:is) = 
+    do  st <- get
+        let p0 = password st
+        let p1 = applyInstruction i p0
+        put st {password = p1}
+        tell [Log (p0 ++ " -> " ++ p1 ++ " : " ++ (show i))]
+        apply is
+
+
+applyInstruction :: Instruction -> String -> String
+applyInstruction (SwapPosition from to) p0 
+    | from == to = p0
+    | otherwise = prefix ++ [p0!!end] ++ midfix ++ [p0!!start] ++ suffix
+        where start = minimum [from, to]
+              end = maximum [from, to]
+              prefix = take start p0
+              midfix = take (end-start-1) $ drop (start+1) p0
+              suffix = drop (end+1) p0
+
+applyInstruction (SwapLetter l0 l1) p0 = applyInstruction (SwapPosition (p0??l0) (p0??l1)) p0
+
+applyInstruction (RotateSteps n) p0 = (drop n' p0) ++ (take n' p0)
+    where n' = if n < 0 
+                then (-1 * n)
+                else (length p0) - n
+
+applyInstruction (RotateLetter l) p0 = applyInstruction (RotateSteps n) p0
+    where n = (1 + (p0??l) + if (p0??l) >= 4 then 1 else 0) `mod` (length p0)
+
+applyInstruction (Reverse from to) p0
+    | from == to = p0
+    | otherwise = prefix ++ (reverse midfix) ++ suffix
+        where start = minimum [from, to]
+              end = maximum [from, to]
+              prefix = take start p0
+              midfix = take (end-start+1) $ drop start p0
+              suffix = drop (end+1) p0
+
+applyInstruction (Move from to) p0 
+    | from == to = p0
+    | otherwise = prefix ++ [p0!!from] ++ suffix
+        where without = take from p0 ++ drop (from+1) p0
+              prefix = take to without
+              suffix = drop (to) without
+
+
+unApply :: [Instruction] -> App ()
+unApply [] = return ()
+unApply (i:is) = 
+    do  st <- get
+        let p0 = password st
+        let p1 = unApplyInstruction i p0
+        put st {password = p1}
+        tell [Log (p1 ++ " <- " ++ p0 ++ " : " ++ (show i))]
+        unApply is
+
+unApplyInstruction :: Instruction -> String -> String
+unApplyInstruction (SwapPosition from to) p0 = applyInstruction (SwapPosition from to) p0
+unApplyInstruction (SwapLetter l0 l1) p0 = applyInstruction (SwapLetter l0 l1) p0
+unApplyInstruction (RotateSteps n) p0 = applyInstruction (RotateSteps (-1 * n)) p0
+unApplyInstruction (Reverse from to) p0 = applyInstruction (Reverse from to) p0
+unApplyInstruction (Move from to) p0 = applyInstruction (Move to from) p0
+unApplyInstruction (RotateLetter l) p0 = applyInstruction (RotateSteps n) p0
+    where n = case (p0??l) of
+                0 -> -1
+                1 -> -1
+                2 ->  2
+                3 -> -2
+                4 ->  1
+                5 -> -3
+                6 ->  0
+                7 -> -4
+    -- where n = case (p0??l) of
+    --             0 -> -1
+    --             1 -> -1
+    --             2 ->  1
+    --             3 -> -2
+    --             4 ->  1
+
+
+instructionFile = instructionLine `endBy` newline 
+instructionLine = choice [ swapL 
+                         , rotateL
+                         , reverseL
+                         , moveL
+                         ]
+
+swapL = (try (string "swap ")) *> (swapPosL <|> swapLetterL)
+
+swapPosL = SwapPosition <$> (string "position" *> spaces *> int) 
+                        <*> (spaces *> string "with position" *> spaces *> int)
+
+swapLetterL = SwapLetter <$> (string "letter" *> spaces *> letter) 
+                         <*> (spaces *> string "with letter" *> spaces *> letter)
+
+rotateL = (try (string "rotate ")) *> (rotateDirL <|> rotateLetterL)
+
+rotateDirL = rotateStepify <$> ((string "left") <|> (string "right"))
+                           <*> (spaces *> int <* spaces <* skipMany letter)
+    where rotateStepify dir n = case dir of 
+                                     "left" -> (RotateSteps (-1 * n))
+                                     "right" -> (RotateSteps n)
+rotateLetterL = RotateLetter <$> (string "based on position of letter " *> letter)
+
+reverseL = Reverse <$> (string "reverse positions" *> spaces *> int)
+                   <*> (spaces *> (string "through") *> spaces *> int)
+
+moveL = Move <$> (string "move position" *> spaces *> int)
+             <*> (spaces *> (string "to position") *> spaces *> int)
+
+
+parseIfile :: String -> Either ParseError [Instruction]
+parseIfile input = parse instructionFile "(unknown)" input
+
+parseIline :: String -> Either ParseError Instruction
+parseIline input = parse instructionLine "(unknown)" input
+
+successfulParse :: Either ParseError [a] -> [a]
+successfulParse (Left _) = []
+successfulParse (Right a) = a
diff --git a/adventofcode16/app/advent22.hs b/adventofcode16/app/advent22.hs
new file mode 100644 (file)
index 0000000..f2e084a
--- /dev/null
@@ -0,0 +1,156 @@
+module Main(main) where
+
+import GHC.Generics (Generic)
+import Text.Parsec 
+import Text.ParserCombinators.Parsec.Number
+import Data.Maybe (catMaybes, fromJust)
+import Data.List (find, delete, sort, sortOn, reverse)
+
+data Node = Node { x :: Int
+                 , y :: Int
+                 , size :: Int
+                 , used :: Int
+                 , available :: Int
+                 , use_pc :: Int 
+                 } deriving (Show, Eq, Ord)
+
+data SearchState = SearchState { cx :: Int
+                               , cy :: Int 
+                               , grid :: [Node]
+                               } deriving (Show)
+instance Ord SearchState where
+    s1 `compare` s2 = (heuristic s1) `compare` (heuristic s2)
+instance Eq SearchState where
+  s1 == s2 = equivalentState s1 s2
+
+equivalentState :: SearchState -> SearchState -> Bool
+equivalentState s1 s2 =
+    let h1 = fromJust $ find (\n -> used n == 0) $ grid s1
+        h2 = fromJust $ find (\n -> used n == 0) $ grid s2
+      in
+        cx s1 == cx s2 && cy s1 == cy s2 && 
+                    x h1 == x h2 && y h1 == y h2
+
+
+testGrid = "\
+\Filesystem            Size  Used  Avail  Use%\n\
+\/dev/grid/node-x0-y0   10T    8T     2T   80%\n\
+\/dev/grid/node-x0-y1   11T    6T     5T   54%\n\
+\/dev/grid/node-x0-y2   32T   28T     4T   87%\n\
+\/dev/grid/node-x1-y0    9T    7T     2T   77%\n\
+\/dev/grid/node-x1-y1    8T    0T     8T    0%\n\
+\/dev/grid/node-x1-y2   11T    7T     4T   63%\n\
+\/dev/grid/node-x2-y0   10T    6T     4T   60%\n\
+\/dev/grid/node-x2-y1    9T    8T     1T   88%\n\
+\/dev/grid/node-x2-y2    9T    6T     3T   66%\n\
+\"
+
+main :: IO ()
+main = do 
+    text <- readFile "data/advent22.txt" 
+    let sizes = successfulParse $ parseFile text
+    part1 sizes
+    part2 sizes
+
+part1 :: [Node] ->  IO ()
+part1 sizes = print $ length viable
+    where viable = [(a, b) | a <- sizes, 
+                             b <- sizes, 
+                             a /= b,
+                             (used a) > 0,
+                             (used a) <= (available b)]
+
+
+part2 :: [Node] ->  IO ()
+part2 sizes = 
+    -- do let testSizes = successfulParse $ parseFile testGrid
+    --    putStrLn $ searchTraceH $ reverse $ aStar [[startSt testSizes]] []
+       print (26 + 26 + 29 + 5 * 36)
+
+
+aStar :: [[SearchState]] -> [SearchState] -> [SearchState]
+aStar [] _ = []
+aStar (currentPath:agenda) closed = 
+    if isGoal reached then currentPath
+    else if reached `elem` closed 
+        then aStar agenda closed
+        else aStar newAgenda (reached:closed) 
+    where 
+        reached = head currentPath
+        successorPaths = map (:currentPath) $ successors reached
+        newAgenda = sortOn (cost) $ successorPaths ++ agenda 
+
+
+searchTrace :: [SearchState] -> String
+searchTrace ss = unlines $ map (sst) ss
+    where sst s = "(" ++ show (cx s) ++ ", " ++ show (cy s) ++ ")"
+
+searchTraceH :: [SearchState] -> String
+searchTraceH ss = unlines $ map (sst) ss
+    where sst s = "(" ++ show (cx s) ++ ", " ++ show (cy s) ++ ") :: " ++ holeS s
+          hole sk = fromJust $ find (\n -> used n == 0) $ grid sk 
+          holeS sk = "(" ++ show (x $ hole sk) ++ ", " ++ show (y $ hole sk) ++ ")"
+
+startSt :: [Node] -> SearchState
+startSt nodes = SearchState {cx = maximum xs, cy = 0, grid = nodes}
+    where xs = map (\n -> x n) nodes
+
+isGoal :: SearchState -> Bool
+isGoal st = cx st == 0 && cy st == 0
+
+adjacent :: Node -> Node -> Bool
+adjacent n1 n2 = abs ((x n1) - (x n2)) + abs ((y n1) - (y n2)) == 1
+
+-- A move of data from n1 to n2 is legal.
+legal :: Node -> Node -> Bool
+legal n1 n2 = adjacent n1 n2 && used n1 > 0 && used n1 <= available n2
+
+heuristic :: SearchState -> Int
+heuristic st = (cx st) + (cy st)
+
+successors :: SearchState -> [SearchState]
+successors st = map (newState st current) possibleMoves
+    where nodes = grid st
+          current = fromJust $ find (\n -> (x n) == (cx st) && (y n) == (cy st)) nodes
+          possibleMoves = [(n1, n2) | n1 <- nodes, n2 <- nodes, legal n1 n2]
+
+
+-- Moving data from n1 to n2
+newState :: SearchState -> Node -> (Node, Node) -> SearchState
+newState st current (n1, n2) = st {cx = cx', cy = cy', grid = grid'}
+    where cx' = if current == n1 then x n2 else x current
+          cy' = if current == n1 then y n2 else y current
+          grid' = sort $ (n2 {used = (used n2 + used n1), available = (available n2 - used n1)}):
+                        (n1 {used = 0, available = (size n1)}):
+                        (delete n1 $ delete n2 (grid st))
+
+cost :: [SearchState] -> Int
+cost p = (heuristic $ head p) + (length p)
+
+
+
+duFile = duLine `sepEndBy` newline 
+-- duLine = (optionMaybe nodeL)
+
+duLine = (nodeL >>= return . Just) <|> (headerL >> return Nothing)
+
+headerL = (many (noneOf "\r\n"))
+
+nodeL = nodeify <$> (string "/dev/grid/node-x" *> int)
+                <*> (string "-y" *> int)
+                <*> (spaces *> int <* string "T")
+                <*> (spaces *> int <* string "T")
+                <*> (spaces *> int <* string "T")
+                <*> (spaces *> int <* string "%")
+            where nodeify x y size used available use_pc = 
+                      Node {x=x, y=y, size=size, used=used, available=available, use_pc=use_pc}
+
+parseFile :: String -> Either ParseError [Maybe Node]
+parseFile input = parse duFile "(unknown)" input
+
+parseLine :: String -> Either ParseError (Maybe Node)
+parseLine input = parse duLine "(unknown)" input
+
+successfulParse :: Either ParseError [Maybe a] -> [a]
+successfulParse (Left _) = []
+successfulParse (Right a) = catMaybes a
diff --git a/adventofcode16/app/advent22library.hs b/adventofcode16/app/advent22library.hs
new file mode 100644 (file)
index 0000000..bad3621
--- /dev/null
@@ -0,0 +1,143 @@
+{-# LANGUAGE DeriveGeneric #-}
+
+module Main(main) where
+
+import GHC.Generics (Generic)
+import Text.Parsec 
+import Text.ParserCombinators.Parsec.Number
+import Data.Maybe (catMaybes, fromJust)
+import Data.List (find, delete, sort)
+import Data.Graph.AStar
+import Data.Hashable
+import qualified Data.HashSet
+
+data Node = Node { x :: Int
+                 , y :: Int
+                 , size :: Int
+                 , used :: Int
+                 , available :: Int
+                 , use_pc :: Int 
+                 } deriving (Show, Eq, Ord, Generic)
+instance Hashable Node
+
+data SearchState = SearchState { cx :: Int
+                               , cy :: Int 
+                               , grid :: [Node]
+                               } deriving (Show, Eq, Generic)
+instance Hashable SearchState
+instance Ord SearchState where
+    s1 `compare` s2 = (heuristic s1) `compare` (heuristic s2)
+
+
+testGrid = "\
+\Filesystem            Size  Used  Avail  Use%\n\
+\/dev/grid/node-x0-y0   10T    8T     2T   80%\n\
+\/dev/grid/node-x0-y1   11T    6T     5T   54%\n\
+\/dev/grid/node-x0-y2   32T   28T     4T   87%\n\
+\/dev/grid/node-x1-y0    9T    7T     2T   77%\n\
+\/dev/grid/node-x1-y1    8T    0T     8T    0%\n\
+\/dev/grid/node-x1-y2   11T    7T     4T   63%\n\
+\/dev/grid/node-x2-y0   10T    6T     4T   60%\n\
+\/dev/grid/node-x2-y1    9T    8T     1T   88%\n\
+\/dev/grid/node-x2-y2    9T    6T     3T   66%\n\
+\"
+
+main :: IO ()
+main = do 
+    text <- readFile "data/advent22.txt" 
+    let sizes = successfulParse $ parseFile text
+    part1 sizes
+    part2 sizes
+
+part1 :: [Node] ->  IO ()
+part1 sizes = print $ length viable
+    where viable = [(a, b) | a <- sizes, 
+                             b <- sizes, 
+                             a /= b,
+                             (used a) > 0,
+                             (used a) <= (available b)]
+
+
+part2 :: [Node] ->  IO ()
+part2 sizes = 
+    -- do let testSizes = successfulParse $ parseFile testGrid
+    --    putStrLn $ searchTrace $ fromJust $ 
+    --                 aStar successors 
+    --                         (\_ _ -> 1) 
+    --                         heuristic
+    --                         isGoal
+    --                         (startSt testSizes)
+    putStrLn $ searchTrace $ fromJust $ 
+                    aStar successors 
+                            (\_ _ -> 1) 
+                            heuristic
+                            isGoal
+                            (startSt sizes)
+
+
+
+searchTrace :: [SearchState] -> String
+searchTrace ss = unlines $ map (sst) ss
+    where sst s = "(" ++ show (cx s) ++ ", " ++ show (cy s) ++ ") :: " ++ holeS s
+          hole sk = fromJust $ find (\n -> used n == 0) $ grid sk 
+          holeS sk = "(" ++ show (x $ hole sk) ++ ", " ++ show (y $ hole sk) ++ ")"
+
+startSt :: [Node] -> SearchState
+startSt nodes = SearchState {cx = maximum xs, cy = 0, grid = nodes}
+    where xs = map (\n -> x n) nodes
+
+isGoal :: SearchState -> Bool
+isGoal st = cx st == 0 && cy st == 0
+
+adjacent :: Node -> Node -> Bool
+adjacent n1 n2 = abs ((x n1) - (x n2)) + abs ((y n1) - (y n2)) == 1
+
+-- A move of data from n1 to n2 is legal.
+legal :: Node -> Node -> Bool
+legal n1 n2 = adjacent n1 n2 && used n1 > 0 && used n1 <= available n2
+
+heuristic :: SearchState -> Int
+heuristic st = (cx st) + (cy st)
+
+successors :: SearchState -> Data.HashSet.HashSet SearchState
+successors st = Data.HashSet.fromList $ map (newState st current) possibleMoves
+    where nodes = grid st
+          current = fromJust $ find (\n -> (x n) == (cx st) && (y n) == (cy st)) nodes
+          possibleMoves = [(n1, n2) | n1 <- nodes, n2 <- nodes, legal n1 n2]
+
+
+-- Moving data from n1 to n2
+newState :: SearchState -> Node -> (Node, Node) -> SearchState
+newState st current (n1, n2) = st {cx = cx', cy = cy', grid = grid'}
+    where cx' = if current == n1 then x n2 else x current
+          cy' = if current == n1 then y n2 else y current
+          grid' = sort $ (n2 {used = (used n2 + used n1), available = (available n2 - used n1)}):
+                        (n1 {used = 0, available = (size n1)}):
+                        (delete n1 $ delete n2 (grid st))
+
+
+duFile = duLine `sepEndBy` newline 
+-- duLine = (optionMaybe nodeL)
+
+duLine = (nodeL >>= return . Just) <|> (headerL >> return Nothing)
+
+headerL = (many (noneOf "\r\n"))
+
+nodeL = nodeify <$> (string "/dev/grid/node-x" *> int)
+                <*> (string "-y" *> int)
+                <*> (spaces *> int <* string "T")
+                <*> (spaces *> int <* string "T")
+                <*> (spaces *> int <* string "T")
+                <*> (spaces *> int <* string "%")
+            where nodeify x y size used available use_pc = 
+                      Node {x=x, y=y, size=size, used=used, available=available, use_pc=use_pc}
+
+parseFile :: String -> Either ParseError [Maybe Node]
+parseFile input = parse duFile "(unknown)" input
+
+parseLine :: String -> Either ParseError (Maybe Node)
+parseLine input = parse duLine "(unknown)" input
+
+successfulParse :: Either ParseError [Maybe a] -> [a]
+successfulParse (Left _) = []
+successfulParse (Right a) = catMaybes a
diff --git a/adventofcode16/app/advent22search.hs b/adventofcode16/app/advent22search.hs
new file mode 100644 (file)
index 0000000..32ada24
--- /dev/null
@@ -0,0 +1,156 @@
+module Main(main) where
+
+import GHC.Generics (Generic)
+import Text.Parsec 
+import Text.ParserCombinators.Parsec.Number
+import Data.Maybe (catMaybes, fromJust)
+import Data.List (find, delete, sort, sortOn, reverse)
+
+data Node = Node { x :: Int
+                 , y :: Int
+                 , size :: Int
+                 , used :: Int
+                 , available :: Int
+                 , use_pc :: Int 
+                 } deriving (Show, Eq, Ord)
+
+data SearchState = SearchState { cx :: Int
+                               , cy :: Int 
+                               , grid :: [Node]
+                               } deriving (Show)
+instance Ord SearchState where
+    s1 `compare` s2 = (heuristic s1) `compare` (heuristic s2)
+instance Eq SearchState where
+  s1 == s2 = equivalentState s1 s2
+
+equivalentState :: SearchState -> SearchState -> Bool
+equivalentState s1 s2 =
+    let h1 = fromJust $ find (\n -> used n == 0) $ grid s1
+        h2 = fromJust $ find (\n -> used n == 0) $ grid s2
+      in
+        cx s1 == cx s2 && cy s1 == cy s2 && 
+                    x h1 == x h2 && y h1 == y h2
+
+
+testGrid = "\
+\Filesystem            Size  Used  Avail  Use%\n\
+\/dev/grid/node-x0-y0   10T    8T     2T   80%\n\
+\/dev/grid/node-x0-y1   11T    6T     5T   54%\n\
+\/dev/grid/node-x0-y2   32T   28T     4T   87%\n\
+\/dev/grid/node-x1-y0    9T    7T     2T   77%\n\
+\/dev/grid/node-x1-y1    8T    0T     8T    0%\n\
+\/dev/grid/node-x1-y2   11T    7T     4T   63%\n\
+\/dev/grid/node-x2-y0   10T    6T     4T   60%\n\
+\/dev/grid/node-x2-y1    9T    8T     1T   88%\n\
+\/dev/grid/node-x2-y2    9T    6T     3T   66%\n\
+\"
+
+main :: IO ()
+main = do 
+    text <- readFile "data/advent22.txt" 
+    let sizes = successfulParse $ parseFile text
+    part1 sizes
+    part2 sizes
+
+part1 :: [Node] ->  IO ()
+part1 sizes = print $ length viable
+    where viable = [(a, b) | a <- sizes, 
+                             b <- sizes, 
+                             a /= b,
+                             (used a) > 0,
+                             (used a) <= (available b)]
+
+
+part2 :: [Node] ->  IO ()
+part2 sizes = 
+    -- do let testSizes = successfulParse $ parseFile testGrid
+    --    putStrLn $ searchTraceH $ reverse $ aStar [[startSt testSizes]] []
+       print $ length $ aStar [[startSt sizes]] []
+
+
+aStar :: [[SearchState]] -> [SearchState] -> [SearchState]
+aStar [] _ = []
+aStar (currentPath:agenda) closed = 
+    if isGoal reached then currentPath
+    else if reached `elem` closed 
+        then aStar agenda closed
+        else aStar newAgenda (reached:closed) 
+    where 
+        reached = head currentPath
+        successorPaths = map (:currentPath) $ successors reached
+        newAgenda = sortOn (cost) $ successorPaths ++ agenda 
+
+
+searchTrace :: [SearchState] -> String
+searchTrace ss = unlines $ map (sst) ss
+    where sst s = "(" ++ show (cx s) ++ ", " ++ show (cy s) ++ ")"
+
+searchTraceH :: [SearchState] -> String
+searchTraceH ss = unlines $ map (sst) ss
+    where sst s = "(" ++ show (cx s) ++ ", " ++ show (cy s) ++ ") :: " ++ holeS s
+          hole sk = fromJust $ find (\n -> used n == 0) $ grid sk 
+          holeS sk = "(" ++ show (x $ hole sk) ++ ", " ++ show (y $ hole sk) ++ ")"
+
+startSt :: [Node] -> SearchState
+startSt nodes = SearchState {cx = maximum xs, cy = 0, grid = nodes}
+    where xs = map (\n -> x n) nodes
+
+isGoal :: SearchState -> Bool
+isGoal st = cx st == 0 && cy st == 0
+
+adjacent :: Node -> Node -> Bool
+adjacent n1 n2 = abs ((x n1) - (x n2)) + abs ((y n1) - (y n2)) == 1
+
+-- A move of data from n1 to n2 is legal.
+legal :: Node -> Node -> Bool
+legal n1 n2 = adjacent n1 n2 && used n1 > 0 && used n1 <= available n2
+
+heuristic :: SearchState -> Int
+heuristic st = (cx st) + (cy st)
+
+successors :: SearchState -> [SearchState]
+successors st = map (newState st current) possibleMoves
+    where nodes = grid st
+          current = fromJust $ find (\n -> (x n) == (cx st) && (y n) == (cy st)) nodes
+          possibleMoves = [(n1, n2) | n1 <- nodes, n2 <- nodes, legal n1 n2]
+
+
+-- Moving data from n1 to n2
+newState :: SearchState -> Node -> (Node, Node) -> SearchState
+newState st current (n1, n2) = st {cx = cx', cy = cy', grid = grid'}
+    where cx' = if current == n1 then x n2 else x current
+          cy' = if current == n1 then y n2 else y current
+          grid' = sort $ (n2 {used = (used n2 + used n1), available = (available n2 - used n1)}):
+                        (n1 {used = 0, available = (size n1)}):
+                        (delete n1 $ delete n2 (grid st))
+
+cost :: [SearchState] -> Int
+cost p = (heuristic $ head p) + (length p)
+
+
+
+duFile = duLine `sepEndBy` newline 
+-- duLine = (optionMaybe nodeL)
+
+duLine = (nodeL >>= return . Just) <|> (headerL >> return Nothing)
+
+headerL = (many (noneOf "\r\n"))
+
+nodeL = nodeify <$> (string "/dev/grid/node-x" *> int)
+                <*> (string "-y" *> int)
+                <*> (spaces *> int <* string "T")
+                <*> (spaces *> int <* string "T")
+                <*> (spaces *> int <* string "T")
+                <*> (spaces *> int <* string "%")
+            where nodeify x y size used available use_pc = 
+                      Node {x=x, y=y, size=size, used=used, available=available, use_pc=use_pc}
+
+parseFile :: String -> Either ParseError [Maybe Node]
+parseFile input = parse duFile "(unknown)" input
+
+parseLine :: String -> Either ParseError (Maybe Node)
+parseLine input = parse duLine "(unknown)" input
+
+successfulParse :: Either ParseError [Maybe a] -> [a]
+successfulParse (Left _) = []
+successfulParse (Right a) = catMaybes a
diff --git a/adventofcode16/app/advent22showgrid.hs b/adventofcode16/app/advent22showgrid.hs
new file mode 100644 (file)
index 0000000..aec4309
--- /dev/null
@@ -0,0 +1,77 @@
+{-# LANGUAGE DeriveGeneric #-}
+
+module Main(main) where
+
+import GHC.Generics (Generic)
+import Text.Parsec 
+import Text.ParserCombinators.Parsec.Number
+import Data.Maybe (catMaybes, fromJust)
+import Data.List (find, delete, sort, sortOn, reverse)
+
+data Node = Node { x :: Int
+                 , y :: Int
+                 , size :: Int
+                 , used :: Int
+                 , available :: Int
+                 , use_pc :: Int 
+                 } deriving (Show, Eq, Ord)
+
+
+testGrid = "\
+\Filesystem            Size  Used  Avail  Use%\n\
+\/dev/grid/node-x0-y0   10T    8T     2T   80%\n\
+\/dev/grid/node-x0-y1   11T    6T     5T   54%\n\
+\/dev/grid/node-x0-y2   32T   28T     4T   87%\n\
+\/dev/grid/node-x1-y0    9T    7T     2T   77%\n\
+\/dev/grid/node-x1-y1    8T    0T     8T    0%\n\
+\/dev/grid/node-x1-y2   11T    7T     4T   63%\n\
+\/dev/grid/node-x2-y0   10T    6T     4T   60%\n\
+\/dev/grid/node-x2-y1    9T    8T     1T   88%\n\
+\/dev/grid/node-x2-y2    9T    6T     3T   66%\n\
+\"
+
+main :: IO ()
+main = do 
+    text <- readFile "data/advent22.txt" 
+    let sizes = successfulParse $ parseFile text
+    let maxX = maximum $ map (\n -> x n) sizes
+    let maxY = maximum $ map (\n -> y n) sizes
+    putStrLn $ unlines $ map (showRow maxX sizes) [0..(maxY-1)]
+
+
+showRow maxX sizes r = map (charOf) row
+  where row = sortOn (\c -> x c) $ filter (\c -> y c == r) sizes
+        charOf c = if (used c) == 0 
+                      then '+'
+                      else if (used c) > 100
+                              then '#'
+                              else '_'
+
+
+
+
+duFile = duLine `sepEndBy` newline 
+-- duLine = (optionMaybe nodeL)
+
+duLine = (nodeL >>= return . Just) <|> (headerL >> return Nothing)
+
+headerL = (many (noneOf "\r\n"))
+
+nodeL = nodeify <$> (string "/dev/grid/node-x" *> int)
+                <*> (string "-y" *> int)
+                <*> (spaces *> int <* string "T")
+                <*> (spaces *> int <* string "T")
+                <*> (spaces *> int <* string "T")
+                <*> (spaces *> int <* string "%")
+            where nodeify x y size used available use_pc = 
+                      Node {x=x, y=y, size=size, used=used, available=available, use_pc=use_pc}
+
+parseFile :: String -> Either ParseError [Maybe Node]
+parseFile input = parse duFile "(unknown)" input
+
+parseLine :: String -> Either ParseError (Maybe Node)
+parseLine input = parse duLine "(unknown)" input
+
+successfulParse :: Either ParseError [Maybe a] -> [a]
+successfulParse (Left _) = []
+successfulParse (Right a) = catMaybes a
diff --git a/adventofcode16/app/advent23.hs b/adventofcode16/app/advent23.hs
new file mode 100644 (file)
index 0000000..2903967
--- /dev/null
@@ -0,0 +1,180 @@
+module Main(main) where
+
+import Text.Parsec hiding (State)
+import Text.ParserCombinators.Parsec.Number
+import Control.Monad.State.Lazy
+-- import Debug.Trace
+
+data Location = Literal Int | Register Char deriving (Show, Eq)
+data Instruction =   Cpy Location Location 
+                   | Inc Location 
+                   | Dec Location 
+                   | Jnz Location Location
+                   | Tgl Location
+                   deriving (Show, Eq)
+
+data Machine = Machine { a :: Int
+                       , b :: Int
+                       , c :: Int
+                       , d :: Int
+                       , pc :: Int
+                       , instructions :: [Instruction]} 
+               deriving (Show, Eq)
+
+testInstructions = "cpy 2 a\n\
+\tgl a\n\
+\tgl a\n\
+\tgl a\n\
+\cpy 1 a\n\
+\dec a\n\
+\dec a"
+
+emptyMachine :: Machine
+emptyMachine = Machine {a=0, b=0, c=0, d=0, pc=0, instructions=[]}
+
+main :: IO ()
+main = do 
+    text <- readFile "data/advent23.txt" 
+    let instructions = successfulParse $ parseIfile text
+    part1 instructions
+    part2 instructions
+
+
+part1 :: [Instruction] -> IO ()
+part1 instrs = 
+    do  let m0 = emptyMachine {instructions=instrs, a = 7}
+        let mf = snd $ runState runMachine m0
+        print (a mf)
+
+part2 :: [Instruction] -> IO ()
+part2 instrs = 
+    do  let m0 = emptyMachine {instructions=instrs, a = 12}
+        let mf = snd $ runState runMachine m0
+        print (a mf)
+
+
+runMachine :: State Machine ()
+runMachine = 
+    do  m <- get
+        if (pc m) >= (length $ instructions m)
+            then return ()
+            else do executeStep
+                    runMachine
+
+executeStep :: State Machine ()
+executeStep = 
+    do  m <- get
+        let i = (instructions m)!!(pc m)
+        put (executeInstructionPeep i m)
+        -- put (executeInstruction i m)
+
+executeInstructionPeep :: Instruction -> Machine -> Machine
+executeInstructionPeep i m =
+    if sample1 == sample1Target
+        -- then trace ("Peeping 1 " ++ (show m) ++ " to " ++ (show m1)) m1
+        then m1
+        else if sample2 == sample2Target
+            -- then trace ("Peeping 2 " ++ (show m) ++ " to " ++ (show m2)) m2
+            then m2
+            else executeInstruction i m
+    where sample1 = take (length sample1Target) $ drop (pc m) $ instructions m 
+          sample1Target = [ Cpy (Literal 0)    (Register 'a')
+                          , Cpy (Register 'b') (Register 'c')
+                          , Inc (Register 'a')
+                          , Dec (Register 'c')
+                          , Jnz (Register 'c') (Literal (-2))
+                          , Dec (Register 'd')
+                          , Jnz (Register 'd') (Literal (-5)) ]
+          m1 = m {a = b m * d m, c = 0, d = 0, pc = pc m + (length sample1)}
+          sample2 = take (length sample2Target) $ drop (pc m) $ instructions m 
+          sample2Target = [ Dec (Register 'b')
+                          , Cpy (Register 'b') (Register 'c')
+                          , Cpy (Register 'c') (Register 'd')
+                          , Dec (Register 'd')
+                          , Inc (Register 'c')
+                          , Jnz (Register 'd') (Literal (-2)) ]
+          m2 = m {b = b m - 1, c = (b m - 1) * 2, d = 0, pc = pc m + (length sample2)}
+
+
+executeInstruction :: Instruction -> Machine -> Machine
+executeInstruction (Inc r@(Register _)) m = m' {pc=pc1}
+    where pc1 = (pc m) + 1
+          v = evaluate m r
+          m' = writeValue m r (v+1)
+executeInstruction (Inc (Literal _)) m = m {pc=pc1}
+    where pc1 = (pc m) + 1
+executeInstruction (Dec r@(Register _)) m = m' {pc=pc1}
+    where pc1 = (pc m) + 1
+          v = evaluate m r
+          m' = writeValue m r (v-1)
+executeInstruction (Dec (Literal _)) m = m {pc=pc1}
+    where pc1 = (pc m) + 1
+executeInstruction (Cpy s d@(Register _)) m = m' {pc=pc1}
+    where pc1 = (pc m) + 1
+          v = evaluate m s
+          m' = writeValue m d v
+executeInstruction (Cpy s (Literal _)) m = m {pc=pc1}
+    where pc1 = (pc m) + 1
+executeInstruction (Jnz s d) m 
+    | v == 0 = m {pc=pc1}
+    | otherwise = m {pc=pcj}
+    where pc1 = (pc m) + 1
+          ed = evaluate m d
+          pcj = (pc m) + ed
+          v = evaluate m s
+executeInstruction (Tgl a) m 
+    | v < (length $ instructions m) = m {instructions = (replace (instructions m) i' v),
+                                       pc=pc1}
+    | otherwise = m {pc=pc1}
+    where pc1 = pc m + 1
+          v = evaluate m a + pc m
+          i = (instructions m)!!v
+          i' = case i of
+                  Inc x -> Dec x
+                  Dec x -> Inc x
+                  Tgl x -> Inc x
+                  Cpy x y -> Jnz x y
+                  Jnz x y -> Cpy x y
+          replace xs x i = take i xs ++ [x] ++ drop (i+1) xs
+
+
+evaluate :: Machine -> Location -> Int
+evaluate _ (Literal i) = i
+evaluate m (Register r) = 
+    case r of
+        'a' -> (a m)
+        'b' -> (b m)
+        'c' -> (c m)
+        'd' -> (d m)
+
+writeValue :: Machine -> Location -> Int -> Machine
+writeValue m (Literal i) _ = m
+writeValue m (Register r) v =
+    case r of 
+        'a' -> m {a=v}
+        'b' -> m {b=v}
+        'c' -> m {c=v}
+        'd' -> m {d=v}
+
+
+instructionFile = instructionLine `sepEndBy` newline 
+instructionLine = incL <|> decL <|> cpyL <|> jnzL <|> tglL
+
+incL = Inc <$> (string "inc" *> spaces *> register)
+decL = Dec <$> (string "dec" *> spaces *> register)
+cpyL = Cpy <$> (string "cpy" *> spaces *> location) <*> (spaces *> register)
+jnzL = Jnz <$> (string "jnz" *> spaces *> location) <*> (spaces *> location)
+tglL = Tgl <$> (string "tgl" *> spaces *> location)
+
+location = (Literal <$> int) <|> register
+register = Register <$> (oneOf "abcd")
+
+parseIfile :: String -> Either ParseError [Instruction]
+parseIfile input = parse instructionFile "(unknown)" input
+
+parseIline :: String -> Either ParseError Instruction
+parseIline input = parse instructionLine "(unknown)" input
+
+successfulParse :: Either ParseError [a] -> [a]
+successfulParse (Left _) = []
+successfulParse (Right a) = a
diff --git a/adventofcode16/src/Lib.hs b/adventofcode16/src/Lib.hs
new file mode 100644 (file)
index 0000000..d36ff27
--- /dev/null
@@ -0,0 +1,6 @@
+module Lib
+    ( someFunc
+    ) where
+
+someFunc :: IO ()
+someFunc = putStrLn "someFunc"
diff --git a/adventofcode16/test/Spec.hs b/adventofcode16/test/Spec.hs
new file mode 100644 (file)
index 0000000..cd4753f
--- /dev/null
@@ -0,0 +1,2 @@
+main :: IO ()
+main = putStrLn "Test suite not yet implemented"
diff --git a/adventofcode1601/adventofcode1601.cabal b/adventofcode1601/adventofcode1601.cabal
new file mode 100644 (file)
index 0000000..a152de7
--- /dev/null
@@ -0,0 +1,44 @@
+name:                adventofcode1601
+version:             0.1.0.0
+synopsis:            Initial project template from stack
+description:         Please see README.md
+homepage:            https://github.com/neilnjae/adventofcode16#readme
+license:             BSD3
+license-file:        LICENSE
+author:              Neil Smith
+maintainer:          noone@njae.me.uk
+copyright:           2016 Neil Smith
+category:            None
+build-type:          Simple
+extra-source-files:  README.md
+cabal-version:       >=1.10
+
+library
+  hs-source-dirs:      src
+  build-depends:       base >= 4.7 && < 5
+  default-language:    Haskell2010
+
+executable advent01
+  hs-source-dirs:      app
+  main-is:             Main.hs
+  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
+  build-depends:       base
+                     , adventofcode1601
+                     , adventofcode16
+                     , split
+  default-language:    Haskell2010
+
+test-suite adventofcode1601-test
+  type:                exitcode-stdio-1.0
+  hs-source-dirs:      test
+  main-is:             Spec.hs
+  build-depends:       base
+                     , adventofcode1601
+                     , adventofcode16
+                     , split
+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
+  default-language:    Haskell2010
+
+source-repository head
+  type:     git
+  location: https://github.com/neilnjae/adventofcode16
diff --git a/adventofcode1601/app/Main.hs b/adventofcode1601/app/Main.hs
new file mode 100644 (file)
index 0000000..b76195d
--- /dev/null
@@ -0,0 +1,99 @@
+module Main(main) where
+
+import Data.List (sort)
+import Data.List.Split (splitOn)
+
+-- turn direction, number of steps
+data Step = Step Char Int deriving (Show)
+
+data Direction = North | East | South | West 
+    deriving (Enum, Show, Bounded, Eq)
+
+-- direction, easting, northing
+data Position = Position Direction Int Int deriving (Show)
+-- Two positions are the same if they're in the same place, 
+-- regardless of facing
+instance Eq Position where
+    Position _ e n == Position _ e' n' = e == e' && n == n'
+
+main :: IO ()
+main = do 
+        instructions <- readFile "data/advent01.txt"
+        part1 instructions
+        part2 instructions
+
+part1 :: String -> IO ()
+part1 instructions = do
+        let answer = finalDistance $ last $ stepsFromStart $ steps instructions
+        print answer
+
+part2 :: String -> IO ()
+part2 instructions = do
+        let visited = finalDistance $ firstRepeat $ stepsFromStart $ expandSteps $ steps instructions
+        print visited
+
+
+-- Extract the steps from the input string.
+steps :: String -> [Step]
+steps s = map readStep $ splitOn ", " s
+    where readStep (d:l) = Step d (read l)
+
+-- Take steps from the starting position
+stepsFromStart :: [Step] -> [Position]
+stepsFromStart = takeSteps (Position North 0 0)
+
+-- Calculate manhattan distance from start to this state
+finalDistance :: Position -> Int
+finalDistance (Position _ e n) = (abs e) + (abs n)
+
+-- For part 2: convert one step of many spaces to many steps of one space each
+expandSteps :: [Step] -> [Step]
+expandSteps = 
+    concatMap expandStep
+    where expandStep (Step dir d) = (Step dir 1) : replicate (d - 1) (Step 'S' 1)
+
+-- Execute a series of steps, keeping track of the positions after each step
+takeSteps :: Position -> [Step] -> [Position]
+-- takeSteps pos steps = scanl move pos steps
+takeSteps = scanl move
+
+-- Make one move, by updating direction then position
+move :: Position -> Step -> Position
+move (Position facing easting northing)
+    (Step turnInstr distance) = 
+    Position facing' easting' northing'
+    where facing' = turn turnInstr facing
+          (easting', northing') = takeStep facing' distance easting northing
+
+-- Turn right, left, or straight
+turn :: Char -> Direction -> Direction
+turn 'R' direction = turnCW direction
+turn 'L' direction = turnACW direction
+turn 'S' direction = direction
+
+-- Move in the current direction
+takeStep :: Direction -> Int -> Int -> Int -> (Int, Int)
+takeStep North d e n = (e, n+d)
+takeStep South d e n = (e, n-d)
+takeStep West  d e n = (e-d, n)
+takeStep East  d e n = (e+d, n)
+
+
+-- | a `succ` that wraps 
+turnCW :: (Bounded a, Enum a, Eq a) => a -> a 
+turnCW dir | dir == maxBound = minBound
+         | otherwise = succ dir
+
+-- | a `pred` that wraps
+turnACW :: (Bounded a, Enum a, Eq a) => a -> a
+turnACW dir | dir == minBound = maxBound
+            | otherwise = pred dir
+
+-- All the prefixes of a list of items
+prefixes = scanl addTerm []
+    where addTerm ps t = ps ++ [t]
+
+-- The first item that exists in a prefix of the list to that point
+firstRepeat positions = 
+    last $ head $ dropWhile (\p -> (last p) `notElem` (tail $ reverse p)) 
+                            (tail $ prefixes positions)
diff --git a/adventofcode1602/adventofcode1602.cabal b/adventofcode1602/adventofcode1602.cabal
new file mode 100644 (file)
index 0000000..1e4aa7d
--- /dev/null
@@ -0,0 +1,44 @@
+name:                adventofcode1602
+version:             0.1.0.0
+synopsis:            Initial project template from stack
+description:         Please see README.md
+homepage:            https://github.com/neilnjae/adventofcode16#readme
+license:             BSD3
+license-file:        LICENSE
+author:              Neil Smith
+maintainer:          noone@njae.me.uk
+copyright:           2016 Neil Smith
+category:            None
+build-type:          Simple
+extra-source-files:  README.md
+cabal-version:       >=1.10
+
+library
+  hs-source-dirs:      src
+  build-depends:       base >= 4.7 && < 5
+  default-language:    Haskell2010
+
+executable advent02
+  hs-source-dirs:      app
+  main-is:             Main.hs
+  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N
+  build-depends:       base
+                     , adventofcode1602
+                     , adventofcode16
+                     , array
+  default-language:    Haskell2010
+
+test-suite adventofcode1602-test
+  type:                exitcode-stdio-1.0
+  hs-source-dirs:      test
+  main-is:             Spec.hs
+  build-depends:       base
+                     , adventofcode1602
+                     , adventofcode16
+                     , array
+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
+  default-language:    Haskell2010
+
+source-repository head
+  type:     git
+  location: https://github.com/neilnjae/adventofcode16
diff --git a/adventofcode1602/app/Main.hs b/adventofcode1602/app/Main.hs
new file mode 100644 (file)
index 0000000..747001d
--- /dev/null
@@ -0,0 +1,90 @@
+module Main(main) where
+
+import Data.Array.IArray
+
+-- Row 1 is top, column 1 is left
+type Position = (Int, Int)
+type Keyboard = Array Position Char
+
+kb1 = ["xxxxx", 
+       "x123x", 
+       "x456x",
+       "x789x",
+       "xxxxx"]
+
+kb2 = ["xxxxxxx",
+       "xxx1xxx",
+       "xx234xx",
+       "x56789x",
+       "xxABCxx",
+       "xxxDxxx",
+       "xxxxxxx"]
+
+enumerate = zip [0..]
+
+mkKeyboard :: [String] -> Keyboard
+mkKeyboard kb = array ((0, 0), (length kb - 1, length (kb!!0) - 1))
+    [((i, j), c) | (i, r) <- enumerate kb, (j, c) <- enumerate r]
+
+keyboard1 = mkKeyboard kb1
+keyboard2 = mkKeyboard kb2
+
+findKey :: Keyboard -> Char-> Position
+findKey kb c = fst $ head $ filter (\a -> (snd a) == c) $ assocs kb
+
+-- data Coord = One | Two | Three
+--     deriving (Read, Show, Eq, Ord, Enum, Bounded)
+-- -- instance Bounded Coord where
+-- --     minBound = Coord 1
+-- --     maxBound = Coord 3
+
+-- data Position = Position Coord Coord
+--     deriving (Show, Eq)
+
+main :: IO ()
+main = do 
+        instrText <- readFile "data/advent02.txt" 
+        let instructions = lines instrText
+        part1 instructions
+        part2 instructions
+
+part1 :: [String] -> IO ()
+part1 instructions = do 
+        putStrLn $ followInstructions keyboard1 instructions
+
+
+part2 :: [String] -> IO ()
+part2 instructions = do 
+        putStrLn $ followInstructions keyboard2 instructions
+
+
+followInstructions :: Keyboard -> [String] -> String
+followInstructions kb instr = moveSeries kb (startPosition kb) instr
+
+
+startPosition :: Keyboard -> Position
+startPosition kb = findKey kb '5'
+
+moveSeries :: Keyboard -> Position -> [String] -> String
+moveSeries _ _ [] = []
+moveSeries kb p (i:is) = (n:ns)
+    where p' = makeMoves kb p i
+          n = kb ! p'
+          ns = moveSeries kb p' is
+
+makeMoves :: Keyboard -> Position -> [Char] -> Position
+makeMoves kb p ms = foldl (safeMove kb) p ms
+
+safeMove :: Keyboard -> Position -> Char -> Position
+safeMove kb pos dir = maybeRevert kb pos (move pos dir)
+
+move :: Position -> Char -> Position
+move (r, c) 'U' = (r-1, c)
+move (r, c) 'D' = (r+1, c)
+move (r, c) 'L' = (r, c-1)
+move (r, c) 'R' = (r, c+1)
+
+maybeRevert :: Keyboard -> Position -> Position -> Position
+maybeRevert kb oldPos newPos 
+    | kb ! newPos == 'x' = oldPos
+    | otherwise = newPos
diff --git a/app/Main.hs b/app/Main.hs
deleted file mode 100644 (file)
index de1c1ab..0000000
+++ /dev/null
@@ -1,6 +0,0 @@
-module Main where
-
-import Lib
-
-main :: IO ()
-main = someFunc
diff --git a/app/advent01.hs b/app/advent01.hs
deleted file mode 100644 (file)
index b76195d..0000000
+++ /dev/null
@@ -1,99 +0,0 @@
-module Main(main) where
-
-import Data.List (sort)
-import Data.List.Split (splitOn)
-
--- turn direction, number of steps
-data Step = Step Char Int deriving (Show)
-
-data Direction = North | East | South | West 
-    deriving (Enum, Show, Bounded, Eq)
-
--- direction, easting, northing
-data Position = Position Direction Int Int deriving (Show)
--- Two positions are the same if they're in the same place, 
--- regardless of facing
-instance Eq Position where
-    Position _ e n == Position _ e' n' = e == e' && n == n'
-
-main :: IO ()
-main = do 
-        instructions <- readFile "data/advent01.txt"
-        part1 instructions
-        part2 instructions
-
-part1 :: String -> IO ()
-part1 instructions = do
-        let answer = finalDistance $ last $ stepsFromStart $ steps instructions
-        print answer
-
-part2 :: String -> IO ()
-part2 instructions = do
-        let visited = finalDistance $ firstRepeat $ stepsFromStart $ expandSteps $ steps instructions
-        print visited
-
-
--- Extract the steps from the input string.
-steps :: String -> [Step]
-steps s = map readStep $ splitOn ", " s
-    where readStep (d:l) = Step d (read l)
-
--- Take steps from the starting position
-stepsFromStart :: [Step] -> [Position]
-stepsFromStart = takeSteps (Position North 0 0)
-
--- Calculate manhattan distance from start to this state
-finalDistance :: Position -> Int
-finalDistance (Position _ e n) = (abs e) + (abs n)
-
--- For part 2: convert one step of many spaces to many steps of one space each
-expandSteps :: [Step] -> [Step]
-expandSteps = 
-    concatMap expandStep
-    where expandStep (Step dir d) = (Step dir 1) : replicate (d - 1) (Step 'S' 1)
-
--- Execute a series of steps, keeping track of the positions after each step
-takeSteps :: Position -> [Step] -> [Position]
--- takeSteps pos steps = scanl move pos steps
-takeSteps = scanl move
-
--- Make one move, by updating direction then position
-move :: Position -> Step -> Position
-move (Position facing easting northing)
-    (Step turnInstr distance) = 
-    Position facing' easting' northing'
-    where facing' = turn turnInstr facing
-          (easting', northing') = takeStep facing' distance easting northing
-
--- Turn right, left, or straight
-turn :: Char -> Direction -> Direction
-turn 'R' direction = turnCW direction
-turn 'L' direction = turnACW direction
-turn 'S' direction = direction
-
--- Move in the current direction
-takeStep :: Direction -> Int -> Int -> Int -> (Int, Int)
-takeStep North d e n = (e, n+d)
-takeStep South d e n = (e, n-d)
-takeStep West  d e n = (e-d, n)
-takeStep East  d e n = (e+d, n)
-
-
--- | a `succ` that wraps 
-turnCW :: (Bounded a, Enum a, Eq a) => a -> a 
-turnCW dir | dir == maxBound = minBound
-         | otherwise = succ dir
-
--- | a `pred` that wraps
-turnACW :: (Bounded a, Enum a, Eq a) => a -> a
-turnACW dir | dir == minBound = maxBound
-            | otherwise = pred dir
-
--- All the prefixes of a list of items
-prefixes = scanl addTerm []
-    where addTerm ps t = ps ++ [t]
-
--- The first item that exists in a prefix of the list to that point
-firstRepeat positions = 
-    last $ head $ dropWhile (\p -> (last p) `notElem` (tail $ reverse p)) 
-                            (tail $ prefixes positions)
diff --git a/app/advent02.hs b/app/advent02.hs
deleted file mode 100644 (file)
index 747001d..0000000
+++ /dev/null
@@ -1,90 +0,0 @@
-module Main(main) where
-
-import Data.Array.IArray
-
--- Row 1 is top, column 1 is left
-type Position = (Int, Int)
-type Keyboard = Array Position Char
-
-kb1 = ["xxxxx", 
-       "x123x", 
-       "x456x",
-       "x789x",
-       "xxxxx"]
-
-kb2 = ["xxxxxxx",
-       "xxx1xxx",
-       "xx234xx",
-       "x56789x",
-       "xxABCxx",
-       "xxxDxxx",
-       "xxxxxxx"]
-
-enumerate = zip [0..]
-
-mkKeyboard :: [String] -> Keyboard
-mkKeyboard kb = array ((0, 0), (length kb - 1, length (kb!!0) - 1))
-    [((i, j), c) | (i, r) <- enumerate kb, (j, c) <- enumerate r]
-
-keyboard1 = mkKeyboard kb1
-keyboard2 = mkKeyboard kb2
-
-findKey :: Keyboard -> Char-> Position
-findKey kb c = fst $ head $ filter (\a -> (snd a) == c) $ assocs kb
-
--- data Coord = One | Two | Three
---     deriving (Read, Show, Eq, Ord, Enum, Bounded)
--- -- instance Bounded Coord where
--- --     minBound = Coord 1
--- --     maxBound = Coord 3
-
--- data Position = Position Coord Coord
---     deriving (Show, Eq)
-
-main :: IO ()
-main = do 
-        instrText <- readFile "data/advent02.txt" 
-        let instructions = lines instrText
-        part1 instructions
-        part2 instructions
-
-part1 :: [String] -> IO ()
-part1 instructions = do 
-        putStrLn $ followInstructions keyboard1 instructions
-
-
-part2 :: [String] -> IO ()
-part2 instructions = do 
-        putStrLn $ followInstructions keyboard2 instructions
-
-
-followInstructions :: Keyboard -> [String] -> String
-followInstructions kb instr = moveSeries kb (startPosition kb) instr
-
-
-startPosition :: Keyboard -> Position
-startPosition kb = findKey kb '5'
-
-moveSeries :: Keyboard -> Position -> [String] -> String
-moveSeries _ _ [] = []
-moveSeries kb p (i:is) = (n:ns)
-    where p' = makeMoves kb p i
-          n = kb ! p'
-          ns = moveSeries kb p' is
-
-makeMoves :: Keyboard -> Position -> [Char] -> Position
-makeMoves kb p ms = foldl (safeMove kb) p ms
-
-safeMove :: Keyboard -> Position -> Char -> Position
-safeMove kb pos dir = maybeRevert kb pos (move pos dir)
-
-move :: Position -> Char -> Position
-move (r, c) 'U' = (r-1, c)
-move (r, c) 'D' = (r+1, c)
-move (r, c) 'L' = (r, c-1)
-move (r, c) 'R' = (r, c+1)
-
-maybeRevert :: Keyboard -> Position -> Position -> Position
-maybeRevert kb oldPos newPos 
-    | kb ! newPos == 'x' = oldPos
-    | otherwise = newPos
diff --git a/app/advent03.hs b/app/advent03.hs
deleted file mode 100644 (file)
index ef40bcc..0000000
+++ /dev/null
@@ -1,33 +0,0 @@
-module Main(main) where
-
-import Data.List (transpose, sort)
-import Data.List.Split (splitOn, chunksOf)
-
-type Triple = [Integer]
-
-main :: IO ()
-main = do 
-        instrText <- readFile "data/advent03.txt" 
-        let triangles = map (parseLine) $ lines instrText
-        part1 triangles
-        part2 triangles
-
-
-part1 :: [Triple] -> IO ()
-part1 triangles = do 
-    print $ length $ filter (validTriangle) triangles 
-
-part2 :: [Triple] -> IO ()
-part2 triangles = do 
-    print $ length $ filter (validTriangle) $ byColumns triangles 
-
-
-parseLine :: String -> Triple
-parseLine = map (read) . filter (not . null) . splitOn " "
-
-validTriangle :: Triple -> Bool
-validTriangle triple = sortedTriple!!0 + sortedTriple!!1 > sortedTriple!!2
-    where sortedTriple = sort triple
-
-byColumns :: [[Integer]] -> [Triple]
-byColumns = chunksOf 3 . concat . transpose 
diff --git a/app/advent04.hs b/app/advent04.hs
deleted file mode 100644 (file)
index 85b7555..0000000
+++ /dev/null
@@ -1,66 +0,0 @@
-module Main(main) where
-
-import Data.List (last, intersperse, sortBy, intercalate, isInfixOf, init)
-import Data.List.Split (splitOn)
-import Data.Char (isLetter, ord, chr)
-import qualified Data.Map.Lazy as Map
-
-data Room = Room { name :: String
-                 , sector :: Int
-                 , checksum :: String
-                 } deriving (Show)
-
-main :: IO ()
-main = do 
-        instrText <- readFile "data/advent04.txt" 
-        let rooms = map (parseLine) $ lines instrText
-        part1 rooms
-        part2 rooms
-
-
-part1 :: [Room] -> IO ()
-part1 rooms = do 
-    print $ sum $ map (sector) validRooms
-    where 
-        validChecksum room = (checksum room) == makeChecksum (name room)
-        validRooms = filter (validChecksum) rooms
-
-part2 :: [Room] -> IO ()
-part2 rooms = do 
-    print $ fst $ head $ filter (\sn -> isInfixOf "north" (snd sn)) sectorNames
-    where 
-        validChecksum room = (checksum room) == makeChecksum (name room)
-        validRooms = filter (validChecksum) rooms
-        sectorNames = [((sector r),
-            shiftWord (sector r) (name r)) | r <- validRooms]
-
-
-parseLine :: String -> Room
-parseLine line = Room {name=name, sector=sector, checksum=checksum}
-    where components = splitOn "-" line
-          name = intercalate "-" $ init components
-          sector = read $ head $ splitOn "[" $ last components
-          checksum = filter (isLetter) $ last components
-
-countedLetters :: String -> [(Char, Int)]
-countedLetters name = sortBy sortCLetter $ unsortedCountedLetters name
-    where unsortedCountedLetters name = 
-            Map.toList $ Map.fromListWith (+) [(c, 1) | c <- filter (isLetter) name]
-
-sortCLetter :: (Char, Int) -> (Char, Int) -> Ordering
-sortCLetter (l1, n1) (l2, n2)
-    | n1 < n2 = GT
-    | n1 > n2 = LT
-    | n1 == n2 = compare l1 l2
-
-makeChecksum :: String -> String
-makeChecksum name = [l | (l, _) <- take 5 $ countedLetters name]
-
-
-shiftWord :: Int -> String -> String
-shiftWord shift letters = map (shiftLetter shift) letters
-
-shiftLetter :: Int -> Char -> Char
-shiftLetter shift letter
-    | isLetter letter = chr $ (ord letter - ord 'a' + shift) `mod` 26 + ord 'a'
-    | otherwise = ' '
diff --git a/app/advent05.hs b/app/advent05.hs
deleted file mode 100644 (file)
index 82a035e..0000000
+++ /dev/null
@@ -1,44 +0,0 @@
-module Main(main) where
-
-import Data.Hash.MD5 (md5s, Str(..))
-import Data.List (isPrefixOf)
-import qualified Data.Map.Lazy as Map 
-
-type Password = Map.Map Integer Char
-
-input = "cxdnnyjw"
-
-main :: IO ()
-main = do 
-        part1 
-        part2
-
-
-part1 :: IO ()
-part1 = do 
-    putStrLn $ take 8 [h!!5 | h <- filter (interesting) $ md5sequence input 0]
-
-part2 :: IO ()
-part2 = do 
-    putStrLn $ Map.foldr (:) [] password
-    where interestingHashes = 
-            [(read [h!!5], h!!6) | 
-              h <- filter (interesting) (md5sequence input 0), 
-              h!!5 `elem` "01234567"]
-          password = findPassword Map.empty interestingHashes
-
-
-md5sequence :: String -> Integer -> [String]
-md5sequence key i = (md5s (Str (key ++ show i))) : (md5sequence key (i+1))
-
-interesting :: String -> Bool
-interesting hash = "00000" `isPrefixOf` hash
-
-dontReplace :: (Integer, Char) -> Password -> Password
-dontReplace (k, v) = Map.insertWith (\_ v -> v) k v
-
-findPassword :: Password -> [(Integer, Char)] -> Password
-findPassword p (c:cs)
-  | Map.size p == 8 = p
-  | otherwise = findPassword p' cs
-      where p' = dontReplace c p
diff --git a/app/advent06-old.hs b/app/advent06-old.hs
deleted file mode 100644 (file)
index 77d4093..0000000
+++ /dev/null
@@ -1,36 +0,0 @@
-module Main(main) where
-
-import Data.List (transpose)
-import Data.Char (isLetter)
-import qualified Data.Map.Lazy as Map
-
-main :: IO ()
-main = do 
-    text <- readFile "advent06.txt" 
-    let message = lines text
-    part1 message
-    part2 message
-
-part1 :: [String] -> IO ()
-part1 message = do 
-    print $ map (fst) $ map (mostCommon) $ map (countedLetters) $ transpose message
-
-part2 :: [String] -> IO ()
-part2 message = do 
-    print $ map (fst) $ map (leastCommon) $ map (countedLetters) $ transpose message
-
-
-countedLetters :: String -> Map.Map Char Int
-countedLetters name = Map.fromListWith (+) [(c, 1) | c <- filter (isLetter) name]
-
-mostCommon = Map.foldlWithKey (mostCommonP) ('a', 0)
-
-mostCommonP (letter0, count0) letter count
-    | count > count0 = (letter, count)
-    | otherwise = (letter0, count0)
-
-leastCommon = Map.foldlWithKey (leastCommonP) ('a', maxBound :: Int)
-
-leastCommonP (letter0, count0) letter count
-    | count < count0 = (letter, count)
-    | otherwise = (letter0, count0)
\ No newline at end of file
diff --git a/app/advent06.hs b/app/advent06.hs
deleted file mode 100644 (file)
index 96c4aa2..0000000
+++ /dev/null
@@ -1,22 +0,0 @@
-module Main(main) where
-
-import Data.List (transpose, maximum, minimum, sort, group)
-import Data.Tuple (swap)
-
-main :: IO ()
-main = do 
-    text <- readFile "data/advent06.txt" 
-    let message = lines text
-    part1 message
-    part2 message
-
-part1 :: [String] -> IO ()
-part1 message = do 
-    putStrLn $ map (snd . maximum . counts) $ transpose message
-
-part2 :: [String] -> IO ()
-part2 message = do 
-    putStrLn $ map (snd . minimum . counts) $ transpose message
-
-counts :: (Eq a, Ord a) => [a] -> [(Int, a)]
-counts = map (\g -> (length g, head g)) . group . sort
\ No newline at end of file
diff --git a/app/advent07.hs b/app/advent07.hs
deleted file mode 100644 (file)
index 8700958..0000000
+++ /dev/null
@@ -1,136 +0,0 @@
-module Main(main) where
-
-import Text.Parsec
-import Data.List (partition, union, intersect, tails)
-import Data.Char (isAlphaNum)
-
-data Chunk = Include String | Exclude String deriving (Show)
-data ChunkV = Includev Bool | Excludev Bool deriving (Show)
-
-chunkValue :: Chunk -> String
-chunkValue (Include v) = v
-chunkValue (Exclude v) = v
-
-isInclude :: Chunk -> Bool
-isInclude (Include _) = True
-isInclude (Exclude _) = False
-
-chunkValueV :: ChunkV -> Bool
-chunkValueV (Includev v) = v
-chunkValueV (Excludev v) = v
-
-isIncludeV :: ChunkV -> Bool
-isIncludeV (Includev _) = True
-isIncludeV (Excludev _) = False
-
-
-main :: IO ()
-main = do 
-    text <- readFile "data/advent07.txt" 
-    part1 text
-    part2 text
-
-
-part1 :: String -> IO ()
-part1 text = do 
-    print $ length $ filter (allowsAbba) $ successfulParse $ parseI7vf text
-
-
-part2 :: String -> IO ()
-part2 text = do 
-    print $ length $ filter (supportsSSL) $ successfulParse $ parseI7f text
-
-allowsAbba :: [ChunkV] -> Bool
-allowsAbba chunks = (any (chunkValueV) includeChunks) && (not (any (chunkValueV) excludeChunks))
-    where (includeChunks, excludeChunks) = partition (isIncludeV) chunks
-
-i7file = i7line `endBy` newline 
-i7line = many1 (includeChunk <|> excludeChunk)
-
-chunk = many1 alphaNum
-
-excludeChunk = Exclude <$> (between (char '[') (char ']') $ chunk)
-includeChunk = Include <$> chunk
-
-hasABBA = preambleAbba <* (many alphaNum)
-preambleAbba = (try abba) <|> (alphaNum >> preambleAbba)
-
--- abba = 
---     do  a <- alphaNum
---         b <- alphaNum
---         if a == b then
---             fail "Identical"
---         else do char b
---                 char a
---                 return [a, b, b, a]
-
-abba = 
-    do  a <- alphaNum
-        b <- noneOf [a]
-        char b
-        char a
-        return [a, b, b, a]
-
---         where
--- Â  firstChar = satisfy (\a -> isLetter a || a == '_')
--- Â  nonFirstChar = satisfy (\a -> isDigit a || isLetter a || a == '_')
-
-   -- b <- bChar
--- where bChar = satisfy (\l -> lsLetter l && l /= a)
-
-
-
-i7filev = i7linev `endBy` newline
-i7linev = many1 (includeChunkv <|> excludeChunkv)
-
-excludeChunkv = Excludev <$> (between (char '[') (char ']') $ hasABBAv)
-includeChunkv = Includev <$> hasABBAv
-
-hasABBAv = 
-    (try (id True <$ preambleAbba <* (many alphaNum)))
-    <|>
-    (id False <$ (many1 alphaNum))
-
-
-parseI7f :: String -> Either ParseError [[Chunk]]
-parseI7f input = parse i7file "(unknown)" input
-
-parseI7 :: String -> Either ParseError [Chunk]
-parseI7 input = parse i7line "(unknown)" input
-
-parseAbba :: String -> Either ParseError String
-parseAbba input = parse hasABBA "(unknown)" input
-
-parseI7v :: String -> Either ParseError [ChunkV]
-parseI7v input = parse i7linev "(unknown)" input
-
-parseI7vf :: String -> Either ParseError [[ChunkV]]
-parseI7vf input = parse i7filev "(unknown)" input
-
-successfulParse :: Either ParseError [a] -> [a]
-successfulParse (Left _) = []
-successfulParse (Right a) = a
-
-
-allSubstrings :: Int -> [a] -> [[a]]
--- allSubstrings n es 
---     | length es < n = []
---     | otherwise = (take n es) : (allSubstrings n $ tail es)
-allSubstrings n e = filter (\s -> length s == n) $ map (take n) $ tails e
-
-
-ieCandidates :: [Chunk] -> ([String], [String])
-ieCandidates chunks = (includeCandidates, excludeCandidates)
-    where (includeChunks, excludeChunks) = partition (isInclude) chunks
-          isABA s = (s!!0 == s!!2) && (s!!0 /= s!!1)
-          candidates = (filter (isABA)) . (foldl (union) []) . (map ((allSubstrings 3) . chunkValue))
-          includeCandidates = candidates includeChunks
-          excludeCandidates = candidates excludeChunks
-          
-inverseABA :: String -> String
-inverseABA s = [s!!1, s!!0, s!!1]
-
-supportsSSL :: [Chunk] -> Bool
-supportsSSL chunks = not $ null $ intersect abas eabas
-    where (abas, babs) = ieCandidates chunks
-          eabas = map (inverseABA) babs
diff --git a/app/advent08.hs b/app/advent08.hs
deleted file mode 100644 (file)
index ccf2de0..0000000
+++ /dev/null
@@ -1,148 +0,0 @@
-module Main(main) where
-
-import Data.Array.IArray
-import Text.Parsec
-import Control.Monad (liftM, ap)
-
--- Row 1 is top, column 1 is left
-type Position = (Int, Int)
-type Screen = Array Position Bool
-
-data Direction = Row | Column deriving (Show)
-data Command = Rect Int Int | Rotate Direction Int Int deriving (Show)
-
-data ScState a = ScState (Screen -> (Screen, a))
-
-mkScreen :: Int -> Int -> Screen
-mkScreen w h = array ((0, 0), (h - 1, w - 1))
-    [((i, j), False) | i <- [0..(h-1)], j <- [0..(w-1)]]
-
-showScreen :: Screen -> String
-showScreen screen = unlines [showRow r | r <- [minRow..maxRow]]
-    where ((minRow, minCol), (maxRow, maxCol)) = bounds screen
-          showCell True  = '*'
-          showCell False = ' '
-          showRow r = [showCell (screen!(r, c)) | c <- [minCol..maxCol]]
-
-countLights :: Screen -> Int
-countLights screen = length $ filter (id) $ elems screen
-
-screen0 :: Screen
-screen0 = mkScreen 50 6
-
-
-main :: IO ()
-main = do
-    text <- readFile "data/advent08.txt"
-    let instrs = successfulParse $ parseCommands text
-    part1 instrs
-    part2 instrs
-
-part1 :: [Command] -> IO ()
-part1 commands =
-    print $ countLights $ (extractScreen . doCommands) commands
-
-part2 :: [Command] -> IO ()
-part2 commands = 
-    putStrLn $ showScreen $ (extractScreen . doCommands) commands
-
-
-instance Functor ScState where
-  fmap = liftM
-
-instance Applicative ScState where
-  pure  = return
-  (<*>) = ap
-
-instance Monad ScState where
-    return x = ScState (\screen -> (screen, x))
-
-    (ScState st) >>= f
-        = ScState (\screen -> let
-                            (newScreen, y) = st screen
-                            (ScState transformer) = f y
-                            in
-                            transformer newScreen)
-
-doCommands :: [Command] -> ScState (Int)
-doCommands [] = return 0
-doCommands (i:is) = 
-    do doCommand i
-       doCommands is
-       return 0
-
-doCommand :: Command -> ScState Int
-doCommand i = ScState (execute i)
-
-execute :: Command -> (Screen -> (Screen, Int))
-execute (Rect w h) screen = (rect screen w h, 0)
-execute (Rotate Column c n) screen = (rotateColumn screen c n, 0)
-execute (Rotate Row r n) screen = (rotateRow screen r n, 0)
-
-extractScreen :: ScState Int -> Screen
-extractScreen (ScState st) = fst (st screen0)
-
-
-
-parseCommands :: String -> Either ParseError [Command]
-parseCommands input = parse commandFile "(unknown)" input
-
-commandFile = commandLine `endBy` newline
-commandLine = (try rectCommand) <|> rotateCommand
-
-rectCommand = 
-    do  string "rect"
-        spaces
-        w <- (many1 digit)
-        char 'x'
-        h <- (many1 digit)
-        return (Rect (read w) (read h))
-
-rotateCommand = 
-    do  string "rotate"
-        spaces
-        direction <- (string "row" <|> string "column")
-        spaces
-        string "x=" <|> string "y="
-        index <- (many1 digit)
-        spaces
-        string "by"
-        spaces
-        distance <- (many1 digit)
-        return (buildCommand direction index distance)
-
-buildCommand "row" i d = Rotate Row (read i) (read d)
-buildCommand "column" i d = Rotate Column (read i) (read d)
-
-successfulParse :: Either ParseError [a] -> [a]
-successfulParse (Left _) = []
-successfulParse (Right a) = a
-
-
-
-
-rect :: Screen -> Int -> Int -> Screen
-rect screen w h = screen // newBits
-    where newBits = [((i, j), True) | i <- [0..(h-1)], j <- [0..(w-1)]]
-
-rotateColumn :: Screen -> Int -> Int -> Screen
-rotateColumn screen column givenShift = screen // newCells
-    where 
-        ((minRow, minCol), (maxRow, maxCol)) = bounds screen
-        colLength = 1 + maxRow - minRow
-        shift = givenShift `mod` colLength
-        offset = colLength - shift
-        column0 = [screen!(r, column) | r <- [minRow..maxRow]]
-        newColumn = (drop offset column0) ++ (take offset column0)
-        newCells = [((r, column), cell) | (r, cell) <- zip [minRow..maxRow] newColumn]
-
-rotateRow :: Screen -> Int -> Int -> Screen
-rotateRow screen row givenShift = screen // newCells
-    where 
-        ((minRow, minCol), (maxRow, maxCol)) = bounds screen
-        rowLength = 1 + maxCol - minCol
-        shift = givenShift `mod` rowLength
-        offset = rowLength - shift
-        row0 = [screen!(row, c) | c <- [minCol..maxCol]]
-        newRow = (drop offset row0) ++ (take offset row0)
-        newCells = [((row, c), cell) | (c, cell) <- zip [minCol..maxCol] newRow]
diff --git a/app/advent09.hs b/app/advent09.hs
deleted file mode 100644 (file)
index a3ce495..0000000
+++ /dev/null
@@ -1,57 +0,0 @@
-module Main(main) where
-
-import Data.List.Split (splitOn)
-import Data.Char (isSpace)
-
-type Chunk = (Int, String)
-
-main :: IO ()
-main = do 
-        textL <- readFile "data/advent09.txt" 
-        let text = filter (not . isSpace) textL
-        part1 text
-        part2 text
-
-part1 :: String -> IO ()
-part1 text = do 
-    print $ cLength $ decompress text
-
-part2 :: String -> IO ()
-part2 text = do 
-    print $ cLength $ decompress2 text
-
-
-decompress :: String -> [Chunk]
-decompress text = 
-    if not (null msuf) 
-        then (1, pre):(num, chunk):drest
-        else [(1, pre)]
-    where 
-        (pre, msuf) = span ('(' /= ) text
-        (marker, suf) = span (')' /= ) msuf
-        ln = splitOn "x" (tail marker)
-        len = read (ln!!0) :: Int
-        num = read (ln!!1) :: Int
-        (chunk, remainder) = splitAt len (tail suf)
-        drest = decompress remainder
-
-decompress2 :: String -> [Chunk]
-decompress2 text = 
-    if not (null msuf) 
-        then [(1, pre)] ++ mulDchunks ++ drest
-        else [(1, pre)]
-    where 
-        (pre, msuf) = span ('(' /= ) text
-        (marker, suf) = span (')' /= ) msuf
-        ln = splitOn "x" (tail marker)
-        len = read (ln!!0) :: Int
-        num = read (ln!!1) :: Int
-        (chunk, remainder) = splitAt len (tail suf)
-        dchunks = decompress2 chunk
-        mulDchunks = [(dl * num, ds) | (dl, ds) <- dchunks]
-        drest = decompress2 remainder
-
-cLength :: [Chunk] -> Int
-cLength = sum . map (clen)
-    where clen (n, t) = n * (length t)
-
diff --git a/app/advent10.hs b/app/advent10.hs
deleted file mode 100644 (file)
index 70e80e0..0000000
+++ /dev/null
@@ -1,217 +0,0 @@
-import Text.Parsec hiding (State)
-import Data.Text (pack, unpack, toTitle)
-import Control.Monad.State.Lazy
-import Data.List (partition, findIndices, sort, find)
-import Data.Maybe (fromJust)
-
-data Destination = Bot | Output deriving (Show, Read, Eq)
--- Rule bot low-destination high-destination
--- Gift bot value
-data Instruction = Rule { ruleId :: Int 
-                        , lowDestType :: Destination
-                        , lowDestId :: Int
-                        , highDestType :: Destination
-                        , highDestId :: Int
-                        } | 
-                   Gift { giftId :: Int
-                        , value :: Int 
-                        }
-                   deriving (Show)
-
--- bod id [item1, item2]
-data Place = Place { placeId :: Int
-                   , placeType :: Destination
-                   , items :: [Int]} 
-                   deriving (Show)
-
--- delivery by bot of low-value and high-value
-data Event = Delivery { deliveryId :: Int
-                      , lowDelivery :: Int
-                      , highDelivery :: Int
-                      } | 
-             Update { updateId :: Int
-                    , updateType :: Destination
-                    , updateItem :: Int
-                    } deriving (Show)
-
-type Factory = ([Place], [Instruction], [Event]) 
--- data FactorySt History = FactorySt (Factory -> (Factory, History))
-
-emptyFactory :: Factory
-emptyFactory = ([], [], [])
-
-main :: IO ()
-main = do 
-    text <- readFile "data/advent10.txt" 
-    let instructions = successfulParse $ parseIfile text
-    part1 instructions
-    part2 instructions
-
-
-part1 :: [Instruction] -> IO ()
-part1 instructions = 
-    do  let (_, _, events) = snd $  runState (runFactory instructions) emptyFactory
-        -- let (places, instructions, events) = snd finalFactory
-        print $ deliveryId $ fromJust $ findDelivery events 17 61
-
-part2 :: [Instruction] -> IO ()
-part2 instructions = 
-    do  let (places, _, _) = snd $  runState (runFactory instructions) emptyFactory
-        let outs = findOutputs places [0, 1, 2]
-        let product = foldl1 (*) $ concatMap (items) outs
-        print $ product
-
-
-findDelivery :: [Event] -> Int -> Int -> Maybe Event
-findDelivery events lowItem highItem = find (delivery) events
-    where delivery Update {} = False
-          delivery Delivery {deliveryId = bot, lowDelivery = l, highDelivery = h} 
-            | l == lowItem && h == highItem = True
-            | otherwise = False
-
-findOutputs :: [Place] -> [Int] -> [Place]
-findOutputs outputs ids = filter (interesting) outputs
-    where interesting Place {placeId = p, placeType = t, items = i}
-            | (p `elem` ids) && t == Output = True
-            | otherwise = False
-
-
-runFactory :: [Instruction] -> State Factory ()
-runFactory instructions = do
-    addInstructions instructions
-    runInstructions instructions
-
-
-
-instructionFile = instructionLine `endBy` newline 
-instructionLine = ruleL <|> giftL
-
-
-ruleL = 
-    do (string "bot" >> spaces)
-       bot <- many1 digit
-       (spaces >> string "gives low to" >> spaces)
-       lowDestType <- (string "output" <|> string "bot")
-       spaces
-       lowDest <- many1 digit
-       (spaces >> string "and high to" >> spaces)
-       highDestType <- (string "output" <|> string "bot")
-       spaces
-       highDest <- many1 digit
-       let rule = Rule (read bot)
-                   (read $ unpack $ toTitle $ pack lowDestType)
-                   (read lowDest)
-                   (read $ unpack $ toTitle $ pack highDestType)
-                   (read highDest)
-       return rule
-
-giftL = 
-    do (string "value" >> spaces)
-       value <- many1 digit
-       (spaces >> string "goes to bot" >> spaces)
-       bot <- many1 digit
-       let gift = Gift (read bot) (read value)
-       return gift
-
-
-parseIfile :: String -> Either ParseError [Instruction]
-parseIfile input = parse instructionFile "(unknown)" input
-
-parseIline :: String -> Either ParseError Instruction
-parseIline input = parse instructionLine "(unknown)" input
-
-successfulParse :: Either ParseError [a] -> [a]
-successfulParse (Left _) = []
-successfulParse (Right a) = a
-
-
-
-
-addInstructions :: [Instruction] -> State Factory ()
-addInstructions [] = return ()
-addInstructions (i:is) = do
-    addInstruction i
-    addInstructions is
-
-
-addInstruction :: Instruction -> State Factory ()
-addInstruction r@(Rule {lowDestType = ld, lowDestId = li,
-                     highDestType = hd, highDestId = hi}) = 
-    do (places, rules, history) <- get
-       put (places, r:rules, history)
-       addPlace (Place {placeType = ld, placeId = li, items = []})
-       addPlace (Place {placeType = hd, placeId = hi, items = []})
-addInstruction Gift {giftId = g} = 
-    do addPlace (Place {placeType = Bot, placeId = g, items = []})
-
-
-addPlace :: Place -> State Factory ()
-addPlace place = 
-    do  (places, rules, history) <- get
-        if not $ placeElem place places
-            then put ((place:places), rules, history)
-        else return ()
-
-
-runInstructions :: [Instruction] -> State Factory ()
-runInstructions [] = return ()
-runInstructions (i:is) = 
-    do  runInstruction i
-        runInstructions is
-
-
-runInstruction :: Instruction -> State Factory ()
-runInstruction Rule {} = return ()
-runInstruction g@(Gift {}) = 
-    do  updatePlace (giftId g) Bot (value g)
-        propogateUpdates
-
-updatePlace :: Int -> Destination -> Int -> State Factory ()
-updatePlace b d i = 
-    do  (places, instructions, events) <- get
-        let (place0s, otherPlaces) = partition (samePlace (Place {placeId = b, placeType = d, items = []})) places
-        let place = head place0s
-        let place' = place {items = i:(items place)}
-        let update = Update {updateId = b, updateType = d, updateItem = i}
-        put (place':otherPlaces, instructions, update:events)
-  
-
-propogateUpdates :: State Factory ()
-propogateUpdates = 
-    do  (places, instructions, events) <- get
-        let (fullBots, otherPlaces) = fullRobots places
-        if (not . null) fullBots
-            then do let fullBot = head fullBots
-                    let maybeRule = findRule instructions (placeId fullBot)
-                    case maybeRule of
-                        Nothing -> propogateUpdates
-                        Just rule -> do let small:large:_ = sort $ items fullBot
-                                        let emptyBot = fullBot {items = []}
-                                        let delivery = Delivery { deliveryId = placeId fullBot
-                                                                , lowDelivery = small
-                                                                , highDelivery = large
-                                                                }
-                                        put (emptyBot:(tail fullBots) ++ otherPlaces,
-                                             instructions, 
-                                             delivery:events)
-                                        updatePlace (lowDestId rule) (lowDestType rule) small
-                                        updatePlace (highDestId rule) (highDestType rule) large
-                                        propogateUpdates
-            else return ()
-
-
-placeElem :: Place -> [Place] -> Bool
-placeElem place places = (not . null) $ findIndices (samePlace place) places
-
-samePlace :: Place -> Place -> Bool
-samePlace p1 p2 = (placeId p1 == placeId p2) && (placeType p1 == placeType p2)
-
-fullRobots :: [Place] -> ([Place], [Place])
-fullRobots places = partition (\p -> placeType p == Bot && length (items p) >= 2) places
-
-findRule :: [Instruction] -> Int -> Maybe Instruction
-findRule instructions bot = find ruleForBot instructions
-    where ruleForBot Gift {} = False
-          ruleForBot Rule {ruleId = b}
-            | b == bot = True
-            | otherwise = False
diff --git a/app/advent11.hs b/app/advent11.hs
deleted file mode 100644 (file)
index 0286d77..0000000
+++ /dev/null
@@ -1,137 +0,0 @@
-module Main(main) where
-
-import Data.List (subsequences, (\\), sort, sortBy)
-import Data.Ord (comparing)
-
-data Item = Generator String | Microchip String deriving (Show, Eq)
-type Floor = [Item]
-data Building = Building Int [Floor] deriving (Show, Eq)
-
-instance Ord Item where
-    compare (Generator a) (Generator b) = compare a b
-    compare (Microchip a) (Microchip b) = compare a b
-    compare (Generator _) (Microchip _) = LT
-    compare (Microchip _) (Generator _) = GT
-
-instance Ord Building where
-    compare b1 b2 = comparing estimateCost b1 b2
-
-building1 = Building 0 [
-    (sort [Generator "polonium", Generator "thulium", 
-     Microchip "thulium", Generator "promethium", Generator "ruthenium",
-     Microchip "ruthenium", Generator "cobalt", Microchip "cobalt"]),
-    (sort [Microchip "polonium", Microchip "promethium"]),
-    [],
-    []
-    ]
-
-building2 = Building 0 [
-    (sort [Generator "polonium", Generator "thulium", 
-     Microchip "thulium", Generator "promethium", Generator "ruthenium",
-     Microchip "ruthenium", Generator "cobalt", Microchip "cobalt",
-     Generator "elerium", Microchip "elerium",
-     Generator "dilithium", Microchip "dilithium"]),
-    (sort [Microchip "polonium", Microchip "promethium"]),
-    [],
-    []
-    ]
-
-
-buildingTest = Building 0 [
-    sort([Microchip "hydrogen", Microchip "lithium"]),
-    [Generator "hydrogen"],
-    [Generator "lithium"],
-    []]
-
-main :: IO ()
-main = do 
-    part1 
-    part2 
-
-
-part1 :: IO ()
--- part1 = print $ length $ init $ extractJust $ hillClimb [[buildingTest]] []
-part1 = print $ length $ init $ extractJust $ hillClimb [[building1]] []
--- part1 = print $ length $ init $ extractJust $ aStar [[building1]] []
-
-part2 :: IO ()
-part2 = print $ length $ init $ extractJust $ hillClimb [[building2]] []
-
-
-extractJust :: Maybe [a] -> [a]
-extractJust Nothing = []
-extractJust (Just x) = x
-
-hillClimb :: [[Building]] -> [Building] -> Maybe [Building]
-hillClimb [] _ = Nothing
-hillClimb (currentTrail:trails) closed = 
-    if isGoal (head currentTrail) then Just currentTrail
-    else hillClimb newAgenda ((head currentTrail): closed) 
-    where newAgenda = 
-            sortBy (\t1 t2 -> (head t1) `compare` (head t2)) $ 
-            trails ++ (candidates currentTrail closed)
-
-aStar :: [[Building]] -> [Building] -> Maybe [Building]
-aStar [] _ = Nothing
-aStar (currentTrail:trails) closed = 
-    if isGoal (head currentTrail) then Just currentTrail
-    else aStar newAgenda ((head currentTrail): closed) 
-    where newAgenda = 
-            sortBy (\t1 t2 -> (trailCost t1) `compare` (trailCost t2)) $ 
-            trails ++ (candidates currentTrail closed)
-          trailCost t = estimateCost (head t) + length t - 1
-
-
-candidates :: [Building] -> [Building] -> [[Building]]
-candidates currentTrail closed = newCandidates
-    where
-        (candidate:trail) = currentTrail
-        succs = legalSuccessors $ successors candidate
-        nonloops = (succs \\ trail) \\ closed
-        newCandidates = map (\n -> n:candidate:trail) nonloops
-
-isGoal :: Building -> Bool
-isGoal (Building f floors) =
-    f+1 == height && (all (null) $ take f floors)
-    where height = length floors
-
-isLegal :: Building -> Bool
-isLegal (Building f floors) = 
-    null floor 
-    ||
-    not (any (isGenerator) floor)
-    ||
-    any (safePair) pairs
-    where floor = floors!!f
-          pairs = [(i, j) | i <- floor, j <- floor, isGenerator i]
-          safePair (Generator e, Microchip f) = e == f
-          safePair (Generator _, Generator _) = False
-
-isGenerator :: Item -> Bool
-isGenerator (Generator _) = True
-isGenerator (Microchip _) = False
-
-successors :: Building -> [Building]
-successors (Building f floors) = [updateBuilding f floors nf is | nf <- nextFloors, is <- items]
-    where 
-        floor = floors!!f
-        items = filter (\is -> length is == 1 || length is == 2) $ subsequences floor
-        nextFloors = if f == 0 then [1]
-                     else if f+1 == length floors then [f-1]
-                     else [f+1, f-1]
-
-legalSuccessors :: [Building] -> [Building]
-legalSuccessors = filter (isLegal)
-
-updateBuilding :: Int -> [Floor] -> Int -> [Item] -> Building
-updateBuilding oldF oldFloors newF items = Building newF newFloors
-    where newFloors = map (updateFloor) $ zip [0..] oldFloors
-          updateFloor (f, fl) 
-            | f == oldF = sort $ fl \\ items
-            | f == newF = sort $ items ++ fl
-            | otherwise = fl
-
-estimateCost :: Building -> Int
-estimateCost (Building _ floors) = 
-    sum $ map (\(c, f) -> c * length f) $ zip [0..] $ reverse floors
-
diff --git a/app/advent11a.hs b/app/advent11a.hs
deleted file mode 100644 (file)
index c5349c8..0000000
+++ /dev/null
@@ -1,164 +0,0 @@
--- Using the idea of canonical representation of buildings from
--- https://andars.github.io/aoc_day11.html by Andrew Foote,
--- plus my extension of represening the pairs as an integer.
-
--- This version is A* search, using a list for the agenda.
-
-module Main(main) where
-
-import Data.List (subsequences, (\\), sort, sortOn, nub, findIndices)
-import Data.Ord (comparing)
-import Data.Char (isDigit)
-
-data Item = Generator String | Microchip String deriving (Show, Eq)
-type Floor = [Item]
-data Building = Building Int [Floor] deriving (Show, Eq)
-data CBuilding = CBuilding Int Integer deriving (Show, Eq)
-data Agendum = Agendum {current :: Building, trail :: [CBuilding], cost :: Int}
-
-instance Ord Item where
-    compare (Generator a) (Generator b) = compare a b
-    compare (Microchip a) (Microchip b) = compare a b
-    compare (Generator _) (Microchip _) = LT
-    compare (Microchip _) (Generator _) = GT
-
-instance Ord Building where
-    compare b1 b2 = comparing estimateCost b1 b2
-
-building1 = Building 0 [
-    (sort [Generator "polonium", Generator "thulium", 
-     Microchip "thulium", Generator "promethium", Generator "ruthenium",
-     Microchip "ruthenium", Generator "cobalt", Microchip "cobalt"]),
-    (sort [Microchip "polonium", Microchip "promethium"]),
-    [],
-    []
-    ]
-
-building0 = Building 0 [
-    (sort [Generator "polonium", Generator "thulium", 
-     Microchip "thulium", Generator "promethium"]),
-    (sort [Microchip "polonium", Microchip "promethium"]),
-    [],
-    []
-    ]
-
-building2 = Building 0 [
-    (sort [Generator "polonium", Generator "thulium", 
-     Microchip "thulium", Generator "promethium", Generator "ruthenium",
-     Microchip "ruthenium", Generator "cobalt", Microchip "cobalt",
-     Generator "elerium", Microchip "elerium",
-     Generator "dilithium", Microchip "dilithium"]),
-    (sort [Microchip "polonium", Microchip "promethium"]),
-    [],
-    []
-    ]
-
-
-buildingTest = Building 0 [
-    sort([Microchip "hydrogen", Microchip "lithium"]),
-    [Generator "hydrogen"],
-    [Generator "lithium"],
-    []]
-
-canonical :: Building -> CBuilding
-canonical (Building f floors) = CBuilding f (read $ filter (isDigit) $ show $ sort pairs)
-    where names = nub $ map (\(Generator n) -> n) $ filter (isGenerator) $ concat floors
-          floorOf (Generator g) = head (findIndices 
-                                                (\fl -> (Generator g) `elem` fl) 
-                                                floors)
-          floorOf (Microchip g) = head (findIndices 
-                                                (\fl -> (Microchip g) `elem` fl) 
-                                                floors)
-          pairs = foldl (\ps n -> (floorOf (Generator n), floorOf (Microchip n)):ps) [] names
-
-
-
-main :: IO ()
-main = do 
-    part1 
-    part2 
-
-
-part1 :: IO ()
-part1 = print $ length $ trail $ aStar (initAgenda building1) []
-
-part2 :: IO ()
-part2 = print $ length $ trail $aStar (initAgenda building2) []
-
-initAgenda :: Building -> [Agendum]
-initAgenda b = [Agendum {current = b, trail=[], cost = estimateCost b}]
-
-
-aStar :: [Agendum] -> [CBuilding] -> Agendum
-aStar [] _ = Agendum {current=buildingTest, trail=[], cost=0}
-aStar (currentAgendum:agenda) closed = 
-    if isGoal reached then currentAgendum
-    else if creached `elem` closed 
-        then aStar agenda closed
-        else aStar newAgenda (creached:closed) 
-    where 
-        reached = current currentAgendum
-        creached = canonical reached
-        newAgenda = 
-            sortOn (cost) $ 
-            agenda ++ (candidates currentAgendum closed)
-
-
-candidates :: Agendum -> [CBuilding] -> [Agendum]
-candidates agendum closed = newCandidates
-    where
-        candidate = current agendum
-        previous = trail agendum
-        succs = legalSuccessors $ successors candidate
-        excludable = previous ++ closed
-        nonloops = filter (\s -> not $ (canonical s) `elem` excludable) succs
-        newCandidates = map (\n -> makeAgendum n) nonloops
-        makeAgendum new = Agendum {current = new, 
-                                    trail = (canonical candidate):previous, 
-                                    cost = estimateCost new + length previous + 1}
-
-isGoal :: Building -> Bool
-isGoal (Building f floors) =
-    f+1 == height && (all (null) $ take f floors)
-    where height = length floors
-
-isLegal :: Building -> Bool
-isLegal (Building f floors) = 
-    null floor 
-    ||
-    not (any (isGenerator) floor)
-    ||
-    any (safePair) pairs
-    where floor = floors!!f
-          pairs = [(i, j) | i <- floor, j <- floor, isGenerator i]
-          safePair (Generator e, Microchip f) = e == f
-          safePair (Generator _, Generator _) = False
-
-isGenerator :: Item -> Bool
-isGenerator (Generator _) = True
-isGenerator (Microchip _) = False
-
-successors :: Building -> [Building]
-successors (Building f floors) = [updateBuilding f floors nf is | nf <- nextFloors, is <- items]
-    where 
-        floor = floors!!f
-        items = filter (\is -> length is == 1 || length is == 2) $ subsequences floor
-        nextFloors = if f == 0 then [1]
-                     else if f+1 == length floors then [f-1]
-                     else [f+1, f-1]
-
-legalSuccessors :: [Building] -> [Building]
-legalSuccessors = filter (isLegal)
-
-updateBuilding :: Int -> [Floor] -> Int -> [Item] -> Building
-updateBuilding oldF oldFloors newF items = Building newF newFloors
-    where newFloors = map (updateFloor) $ zip [0..] oldFloors
-          updateFloor (f, fl) 
-            | f == oldF = sort $ fl \\ items
-            | f == newF = sort $ items ++ fl
-            | otherwise = fl
-
-estimateCost :: Building -> Int
-estimateCost (Building _ floors) = 
-    sum $ map (\(c, f) -> c * length f) $ zip [0..] $ reverse floors
-
diff --git a/app/advent11h.hs b/app/advent11h.hs
deleted file mode 100644 (file)
index d362ee8..0000000
+++ /dev/null
@@ -1,162 +0,0 @@
--- Using the idea of canonical representation of buildings from
--- https://andars.github.io/aoc_day11.html by Andrew Foote,
--- plus my extension of represening the pairs as an integer.
-
--- This version is hillclimbing search, using a list for the agenda.
-module Main(main) where
-    
-import Data.List (subsequences, (\\), sort, sortOn, nub, findIndices)
-import Data.Ord (comparing)
-import Data.Char (isDigit)
-
-data Item = Generator String | Microchip String deriving (Show, Eq)
-type Floor = [Item]
-data Building = Building Int [Floor] deriving (Show, Eq)
-data CBuilding = CBuilding Int Integer deriving (Show, Eq)
-data Agendum = Agendum {current :: Building, trail :: [CBuilding], cost :: Int}
-
-instance Ord Item where
-    compare (Generator a) (Generator b) = compare a b
-    compare (Microchip a) (Microchip b) = compare a b
-    compare (Generator _) (Microchip _) = LT
-    compare (Microchip _) (Generator _) = GT
-
-instance Ord Building where
-    compare b1 b2 = comparing estimateCost b1 b2
-
-building1 = Building 0 [
-    (sort [Generator "polonium", Generator "thulium", 
-     Microchip "thulium", Generator "promethium", Generator "ruthenium",
-     Microchip "ruthenium", Generator "cobalt", Microchip "cobalt"]),
-    (sort [Microchip "polonium", Microchip "promethium"]),
-    [],
-    []
-    ]
-
-building0 = Building 0 [
-    (sort [Generator "polonium", Generator "thulium", 
-     Microchip "thulium", Generator "promethium"]),
-    (sort [Microchip "polonium", Microchip "promethium"]),
-    [],
-    []
-    ]
-
-building2 = Building 0 [
-    (sort [Generator "polonium", Generator "thulium", 
-     Microchip "thulium", Generator "promethium", Generator "ruthenium",
-     Microchip "ruthenium", Generator "cobalt", Microchip "cobalt",
-     Generator "elerium", Microchip "elerium",
-     Generator "dilithium", Microchip "dilithium"]),
-    (sort [Microchip "polonium", Microchip "promethium"]),
-    [],
-    []
-    ]
-
-
-buildingTest = Building 0 [
-    sort([Microchip "hydrogen", Microchip "lithium"]),
-    [Generator "hydrogen"],
-    [Generator "lithium"],
-    []]
-
-canonical :: Building -> CBuilding
-canonical (Building f floors) = CBuilding f (read $ filter (isDigit) $ show $ sort pairs)
-    where names = nub $ map (\(Generator n) -> n) $ filter (isGenerator) $ concat floors
-          floorOf (Generator g) = head (findIndices 
-                                                (\fl -> (Generator g) `elem` fl) 
-                                                floors)
-          floorOf (Microchip g) = head (findIndices 
-                                                (\fl -> (Microchip g) `elem` fl) 
-                                                floors)
-          pairs = foldl (\ps n -> (floorOf (Generator n), floorOf (Microchip n)):ps) [] names
-
-
-
-main :: IO ()
-main = do 
-    part1 
-    part2 
-
-
-part1 :: IO ()
-part1 = print $ length $ trail $ hillClimb (initAgenda building1) []
-
-part2 :: IO ()
-part2 = print $ length $ trail $ hillClimb (initAgenda building2) []
-
-initAgenda :: Building -> [Agendum]
-initAgenda b = [Agendum {current = b, trail=[], cost = estimateCost b}]
-
-hillClimb :: [Agendum] -> [CBuilding] -> Agendum
-hillClimb [] _ = Agendum {current=buildingTest, trail=[], cost=0}
-hillClimb (currentAgendum:agenda) closed = 
-    if isGoal reached then currentAgendum
-    else if creached `elem` closed 
-        then hillClimb agenda closed
-        else hillClimb newAgenda (creached:closed) 
-    where 
-        reached = current currentAgendum
-        creached = canonical reached
-        newAgenda = 
-            sortOn (cost) $ 
-            agenda ++ (candidates currentAgendum closed)
-
-
-candidates :: Agendum -> [CBuilding] -> [Agendum]
-candidates agendum closed = newCandidates
-    where
-        candidate = current agendum
-        previous = trail agendum
-        succs = legalSuccessors $ successors candidate
-        excludable = previous ++ closed
-        nonloops = filter (\s -> not $ (canonical s) `elem` excludable) succs
-        newCandidates = map (\n -> makeAgendum n) nonloops
-        makeAgendum new = Agendum {current = new, 
-                                    trail = (canonical candidate):previous, 
-                                    cost = estimateCost new}
-
-isGoal :: Building -> Bool
-isGoal (Building f floors) =
-    f+1 == height && (all (null) $ take f floors)
-    where height = length floors
-
-isLegal :: Building -> Bool
-isLegal (Building f floors) = 
-    null floor 
-    ||
-    not (any (isGenerator) floor)
-    ||
-    any (safePair) pairs
-    where floor = floors!!f
-          pairs = [(i, j) | i <- floor, j <- floor, isGenerator i]
-          safePair (Generator e, Microchip f) = e == f
-          safePair (Generator _, Generator _) = False
-
-isGenerator :: Item -> Bool
-isGenerator (Generator _) = True
-isGenerator (Microchip _) = False
-
-successors :: Building -> [Building]
-successors (Building f floors) = [updateBuilding f floors nf is | nf <- nextFloors, is <- items]
-    where 
-        floor = floors!!f
-        items = filter (\is -> length is == 1 || length is == 2) $ subsequences floor
-        nextFloors = if f == 0 then [1]
-                     else if f+1 == length floors then [f-1]
-                     else [f+1, f-1]
-
-legalSuccessors :: [Building] -> [Building]
-legalSuccessors = filter (isLegal)
-
-updateBuilding :: Int -> [Floor] -> Int -> [Item] -> Building
-updateBuilding oldF oldFloors newF items = Building newF newFloors
-    where newFloors = map (updateFloor) $ zip [0..] oldFloors
-          updateFloor (f, fl) 
-            | f == oldF = sort $ fl \\ items
-            | f == newF = sort $ items ++ fl
-            | otherwise = fl
-
-estimateCost :: Building -> Int
-estimateCost (Building _ floors) = 
-    sum $ map (\(c, f) -> c * length f) $ zip [0..] $ reverse floors
-
diff --git a/app/advent11p.hs b/app/advent11p.hs
deleted file mode 100644 (file)
index 4136e8f..0000000
+++ /dev/null
@@ -1,166 +0,0 @@
--- Using the idea of canonical representation of buildings from
--- https://andars.github.io/aoc_day11.html by Andrew Foote,
--- plus my extension of represening the pairs as an integer.
-
--- This version is A* search, using a priority queue for the agenda.
-
-module Main(main) where
-
-import Data.List (subsequences, (\\), sort, sortOn, nub, findIndices)
-import Data.Ord (comparing)
-import Data.Char (isDigit)
-import Data.Maybe (fromMaybe)
-import qualified Data.PQueue.Prio.Min as P
-
-data Item = Generator String | Microchip String deriving (Show, Eq)
-type Floor = [Item]
-data Building = Building Int [Floor] deriving (Show, Eq)
-data CBuilding = CBuilding Int Integer deriving (Show, Eq)
-data Agendum = Agendum {current :: Building, trail :: [CBuilding], cost :: Int}
-type Agenda = P.MinPQueue Int Agendum
-
-instance Ord Item where
-    compare (Generator a) (Generator b) = compare a b
-    compare (Microchip a) (Microchip b) = compare a b
-    compare (Generator _) (Microchip _) = LT
-    compare (Microchip _) (Generator _) = GT
-
-instance Ord Building where
-    compare b1 b2 = comparing estimateCost b1 b2
-
-building1 = Building 0 [
-    (sort [Generator "polonium", Generator "thulium", 
-     Microchip "thulium", Generator "promethium", Generator "ruthenium",
-     Microchip "ruthenium", Generator "cobalt", Microchip "cobalt"]),
-    (sort [Microchip "polonium", Microchip "promethium"]),
-    [],
-    []
-    ]
-
-building0 = Building 0 [
-    (sort [Generator "polonium", Generator "thulium", 
-     Microchip "thulium", Generator "promethium"]),
-    (sort [Microchip "polonium", Microchip "promethium"]),
-    [],
-    []
-    ]
-
-building2 = Building 0 [
-    (sort [Generator "polonium", Generator "thulium", 
-     Microchip "thulium", Generator "promethium", Generator "ruthenium",
-     Microchip "ruthenium", Generator "cobalt", Microchip "cobalt",
-     Generator "elerium", Microchip "elerium",
-     Generator "dilithium", Microchip "dilithium"]),
-    (sort [Microchip "polonium", Microchip "promethium"]),
-    [],
-    []
-    ]
-
-
-buildingTest = Building 0 [
-    sort([Microchip "hydrogen", Microchip "lithium"]),
-    [Generator "hydrogen"],
-    [Generator "lithium"],
-    []]
-
-canonical :: Building -> CBuilding
-canonical (Building f floors) = CBuilding f (read $ filter (isDigit) $ show $ sort pairs)
-    where names = nub $ map (\(Generator n) -> n) $ filter (isGenerator) $ concat floors
-          floorOf (Generator g) = head (findIndices 
-                                                (\fl -> (Generator g) `elem` fl) 
-                                                floors)
-          floorOf (Microchip g) = head (findIndices 
-                                                (\fl -> (Microchip g) `elem` fl) 
-                                                floors)
-          pairs = foldl (\ps n -> (floorOf (Generator n), floorOf (Microchip n)):ps) [] names
-
-
-main :: IO ()
-main = do 
-    part1 
-    part2 
-
-part1 :: IO ()
-part1 = print $ length $ trail $ fromMaybe (snd $ P.findMin $ initAgenda buildingTest) $ aStar (initAgenda building1) []
-
-part2 :: IO ()
-part2 = print $ length $ trail $ fromMaybe (snd $ P.findMin $ initAgenda buildingTest) $ aStar (initAgenda building2) []
-
-initAgenda :: Building -> Agenda
-initAgenda b = P.singleton (estimateCost b) Agendum {current = b, trail=[], cost = estimateCost b}
-
-
-aStar :: Agenda -> [CBuilding] -> Maybe Agendum
--- aStar [] _ = Agendum {current=buildingTest, trail=[], cost=0}
-aStar agenda closed 
-    | P.null agenda = Nothing
-    | otherwise = 
-        if isGoal reached then Just currentAgendum
-        else if creached `elem` closed 
-            then aStar (P.deleteMin agenda) closed
-            else aStar newAgenda (creached:closed) 
-        where 
-            (_, currentAgendum) = P.findMin agenda
-            reached = current currentAgendum
-            creached = canonical reached
-            newAgenda = P.union (P.deleteMin agenda) 
-                                (P.fromList $ candidates currentAgendum closed)
-
-
-candidates :: Agendum -> [CBuilding] -> [(Int, Agendum)]
-candidates agendum closed = newCandidates
-    where
-        candidate = current agendum
-        previous = trail agendum
-        succs = legalSuccessors $ successors candidate
-        nonloops = filter (\s -> not $ (canonical s) `elem` closed) succs
-        newCandidates = map (\a -> (cost a, a)) $ map (\n -> makeAgendum n) nonloops
-        makeAgendum new = Agendum {current = new, 
-                                    trail = (canonical candidate):previous, 
-                                    cost = estimateCost new + length previous + 1}
-
-isGoal :: Building -> Bool
-isGoal (Building f floors) =
-    f+1 == height && (all (null) $ take f floors)
-    where height = length floors
-
-isLegal :: Building -> Bool
-isLegal (Building f floors) = 
-    null floor 
-    ||
-    not (any (isGenerator) floor)
-    ||
-    any (safePair) pairs
-    where floor = floors!!f
-          pairs = [(i, j) | i <- floor, j <- floor, isGenerator i]
-          safePair (Generator e, Microchip f) = e == f
-          safePair (Generator _, Generator _) = False
-
-isGenerator :: Item -> Bool
-isGenerator (Generator _) = True
-isGenerator (Microchip _) = False
-
-successors :: Building -> [Building]
-successors (Building f floors) = [updateBuilding f floors nf is | nf <- nextFloors, is <- items]
-    where 
-        floor = floors!!f
-        items = filter (\is -> length is == 1 || length is == 2) $ subsequences floor
-        nextFloors = if f == 0 then [1]
-                     else if f+1 == length floors then [f-1]
-                     else [f+1, f-1]
-
-legalSuccessors :: [Building] -> [Building]
-legalSuccessors = filter (isLegal)
-
-updateBuilding :: Int -> [Floor] -> Int -> [Item] -> Building
-updateBuilding oldF oldFloors newF items = Building newF newFloors
-    where newFloors = map (updateFloor) $ zip [0..] oldFloors
-          updateFloor (f, fl) 
-            | f == oldF = sort $ fl \\ items
-            | f == newF = sort $ items ++ fl
-            | otherwise = fl
-
-estimateCost :: Building -> Int
-estimateCost (Building _ floors) = 
-    sum $ map (\(c, f) -> c * length f) $ zip [0..] $ reverse floors
-
diff --git a/app/advent12.hs b/app/advent12.hs
deleted file mode 100644 (file)
index 906c185..0000000
+++ /dev/null
@@ -1,134 +0,0 @@
-module Main(main) where
-
-import Text.Parsec hiding (State)
-import Text.ParserCombinators.Parsec.Number
-import Data.List (partition, union, intersect, tails)
-import Data.Char (isDigit)
-import Control.Monad.State.Lazy
-
-data Location = Literal Int | Register Char deriving (Show)
-data Instruction = Cpy Location Location | 
-                   Inc Location |
-                   Dec Location | 
-                   Jnz Location Int
-                   deriving (Show)
-
-data Machine = Machine { a :: Int
-                       , b :: Int
-                       , c :: Int
-                       , d :: Int
-                       , pc :: Int
-                       , instructions :: [Instruction]} 
-               deriving (Show)
-
-emptyMachine :: Machine
-emptyMachine = Machine {a=0, b=0, c=0, d=0, pc=0, instructions=[]}
-
-main :: IO ()
-main = do 
-    text <- readFile "data/advent12.txt" 
-    let instructions = successfulParse $ parseIfile text
-    part1 instructions
-    part2 instructions
-
-
-part1 :: [Instruction] -> IO ()
-part1 instrs = 
-    do  let m0 = emptyMachine {instructions=instrs}
-        let mf = snd $ runState runMachine m0
-        print (a mf)
-
-part2 :: [Instruction] -> IO ()
-part2 instrs = 
-    do  let m0 = emptyMachine {instructions=instrs, c=1}
-        let mf = snd $ runState runMachine m0
-        print (a mf)
-
-
-
-runMachine :: State Machine ()
-runMachine = 
-    do  m <- get
-        if (pc m) >= (length $ instructions m)
-            then return ()
-            else do executeStep
-                    runMachine
-
-executeStep :: State Machine ()
-executeStep = 
-    do  m <- get
-        let i = (instructions m)!!(pc m)
-        put (executeInstruction i m)
-
-executeInstruction :: Instruction -> Machine -> Machine
-executeInstruction (Inc (Register r)) m = m' {pc=pc1}
-    where pc1 = (pc m) + 1
-          v = evaluate m (Register r)
-          m' = writeValue m (Register r) (v+1)
-executeInstruction (Dec (Register r)) m = m' {pc=pc1}
-    where pc1 = (pc m) + 1
-          v = evaluate m (Register r)
-          m' = writeValue m (Register r) (v-1)
-executeInstruction (Cpy s d) m = m' {pc=pc1}
-    where pc1 = (pc m) + 1
-          v = evaluate m s
-          m' = writeValue m d v
-executeInstruction (Jnz s d) m 
-    | v == 0 = m {pc=pc1}
-    | otherwise = m {pc=pcj}
-    where pc1 = (pc m) + 1
-          pcj = (pc m) + d
-          v = evaluate m s
-          
-
-evaluate :: Machine -> Location -> Int
-evaluate _ (Literal i) = i
-evaluate m (Register r) = 
-    case r of
-        'a' -> (a m)
-        'b' -> (b m)
-        'c' -> (c m)
-        'd' -> (d m)
-
-writeValue :: Machine -> Location -> Int -> Machine
-writeValue m (Literal i) _ = m
-writeValue m (Register r) v =
-    case r of 
-        'a' -> m {a=v}
-        'b' -> m {b=v}
-        'c' -> m {c=v}
-        'd' -> m {d=v}
-
-
-instructionFile = instructionLine `endBy` newline 
--- instructionLine = choice [cpyL, incL, decL, jnzL]
-instructionLine = incL <|> decL <|> cpyL <|> jnzL
-
-incL = incify <$> (string "inc" *> spaces *> (oneOf "abcd"))
-        where incify r = Inc (Register r)
-decL = decify <$> (string "dec" *> spaces *> (oneOf "abcd"))
-        where decify r = Dec (Register r)
-cpyL = cpyify <$> (string "cpy" *> spaces *> ((many1 letter) <|> (many1 digit))) 
-                  <*> (spaces *> (oneOf "abcd"))
-        where cpyify s r = Cpy (readLocation s) (Register r)
-jnzL = jnzify <$> (string "jnz" *> spaces *> ((many1 letter) <|> (many1 digit))) 
-                  <*> (spaces *> int)
-        where jnzify r d = Jnz (readLocation r) d
-
-
-readLocation :: String -> Location
-readLocation l
-    | all (isDigit) l = Literal (read l)
-    | otherwise = Register (head l)
-
-
-
-parseIfile :: String -> Either ParseError [Instruction]
-parseIfile input = parse instructionFile "(unknown)" input
-
-parseIline :: String -> Either ParseError Instruction
-parseIline input = parse instructionLine "(unknown)" input
-
-successfulParse :: Either ParseError [a] -> [a]
-successfulParse (Left _) = []
-successfulParse (Right a) = a
\ No newline at end of file
diff --git a/app/advent13.hs b/app/advent13.hs
deleted file mode 100644 (file)
index 86981df..0000000
+++ /dev/null
@@ -1,95 +0,0 @@
-module Main(main) where
-
-import Data.List ((\\), nub, sortOn)
-import Data.Bits (popCount)
-import Data.Maybe (fromMaybe)
-
-type Pos = (Int, Int)
-
-seed = 1362
-
-goal1 = (31, 39)
-
-main :: IO ()
-main = do 
-    part1 
-    part2 
-
-
-part1 :: IO ()
-part1 = print $ length $ tail $ fromMaybe [] $ aStar [[(1, 1)]] []
-
-part2 :: IO ()
-part2 = do print $ length $ tail $ edl 50 [[(1, 1)]] []
-           putStrLn $ showRoomR 30 25 $ edl 50 [[(1, 1)]] []
-
-
--- extractJust :: Maybe [a] -> [a]
--- extractJust Nothing = []
--- extractJust (Just x) = x
-isWall :: Int -> Int -> Bool
-isWall x y = odd $ popCount n
-    where 
-        n = x*x + 3*x + 2*x*y + y + y*y + seed
-
-
-showRoom w h = showRoomR w h []
-
-showRoomR w h reached = unlines rows
-    where 
-        rows = [row x | x <- [0..h]]
-        row x = [showCell x y | y <- [0..w]]
-        showCell x y = if (isWall x y) 
-            then '#' 
-            else if (x, y) `elem` reached 
-                then 'O'
-                else '.'
-
-
-aStar :: [[Pos]] -> [Pos] -> Maybe [Pos]
-aStar [] _ = Nothing
-aStar (currentTrail:trails) closed = 
-    if isGoal (head currentTrail) then Just currentTrail
-    else if (head currentTrail) `elem` closed then aStar trails closed
-         else aStar newAgenda ((head currentTrail): closed) 
-    where newAgenda = 
-            sortOn (\a -> trailCost a) $ 
-            trails ++ (candidates currentTrail closed)
-          trailCost t = estimateCost (head t) + length t - 1
-
-
--- exhaustive depth-limited
-edl :: Int -> [[Pos]] -> [Pos] -> [Pos]
-edl _ [] closed = nub closed
-edl limit (currentTrail:trails) closed = 
-    if (length currentTrail) > (limit+1) then edl limit trails ((head currentTrail):closed)
-    else if (head currentTrail) `elem` closed then edl limit trails closed
-         else edl limit newAgenda ((head currentTrail):closed) 
-    where newAgenda = trails ++ (candidates currentTrail closed)
-
-candidates :: [Pos] -> [Pos] -> [[Pos]]
-candidates currentTrail closed = newCandidates
-    where
-        (candidate:trail) = currentTrail
-        succs = legalSuccessors $ successors candidate
-        nonloops = (succs \\ trail) \\ closed
-        newCandidates = map (\n -> n:candidate:trail) nonloops
-
-isGoal :: Pos -> Bool
-isGoal p = p == goal1
-
-isLegal :: Pos -> Bool
-isLegal (x, y) = 
-    x >= 0 && y >= 0 && (not $ isWall x y)
-
-successors :: Pos -> [Pos]
-successors (x, y) = [(x-1, y), (x+1, y), (x, y-1), (x, y+1)]
-
-legalSuccessors :: [Pos] -> [Pos]
-legalSuccessors = filter (isLegal)
-
-estimateCost :: Pos -> Int
-estimateCost (x, y) = abs (x - gx) + abs (y - gy)
-    where (gx, gy) = goal1
-
diff --git a/app/advent14.hs b/app/advent14.hs
deleted file mode 100644 (file)
index c6c092e..0000000
+++ /dev/null
@@ -1,43 +0,0 @@
-module Main(main) where
-
-import Data.List (nub, tails, null)
-import Data.Hash.MD5 (md5s, Str(..))
-
-salt = "yjdafjpo"
--- salt = "abc"
-
-main :: IO ()
-main = do 
-        part1 
-        part2
-
-part1 :: IO ()
-part1 = print $ head $ drop 63 $ filter (\i -> possibleKey sq i && confirmKey sq i) [0..]
-    where sq = md5sequence
-
-part2 :: IO ()
-part2 = print $ head $ drop 63 $ filter (\i -> possibleKey sq i && confirmKey sq i) [0..]
-    where sq = md5sequenceS
-
-md5sequence :: [String]
-md5sequence = [makeMd5 i | i <- [0..]]
-    where makeMd5 i = md5s (Str (salt ++ show i))
-
-md5sequenceS :: [String]
-md5sequenceS = [makeMd5 i | i <- [0..]]
-    where makeMd5 i = stretch $ md5s (Str (salt ++ show i)) 
-          stretch h0 = foldr (\_ h -> md5s (Str h)) h0 [1..2016]
-
-possibleKey :: [String] -> Int-> Bool
-possibleKey s = not . null . repeats 3 . ((!!) s)
-
-confirmKey :: [String] -> Int -> Bool
-confirmKey s i = any (confirmation) $ take 1000 $ drop (i+1) s
-    where c = head $ repeats 3 $ s!!i
-          confirmation m = c `elem` (repeats 5 m)
-
-repeats :: Int -> String -> [String]
-repeats n = filter (null . tail) . map (nub) . substrings n
-
-substrings :: Int -> [a] -> [[a]]
-substrings l = filter (\s -> (length s) == l) . map (take l) . tails
diff --git a/app/advent14c.hs b/app/advent14c.hs
deleted file mode 100644 (file)
index ea699ed..0000000
+++ /dev/null
@@ -1,47 +0,0 @@
-module Main(main) where
-
-import Data.List (nub, tails)
-import Data.ByteString.Char8 (pack)
-import Crypto.Hash (hash, Digest, MD5)
-
-salt = "yjdafjpo"
--- salt = "abc"
-
-main :: IO ()
-main = do 
-        part1 
-        part2
-
-part1 :: IO ()
-part1 = print $ head $ drop 63 $ filter (\i -> possibleKey sq i && confirmKey sq i) [0..]
-    where sq = md5sequence
-
-part2 :: IO ()
-part2 = print $ head $ drop 63 $ filter (\i -> possibleKey sq i && confirmKey sq i) [0..]
-    where sq = md5sequenceS
-
-getHash :: String -> String
-getHash bs = show (hash $ pack bs :: Digest MD5)
-
-md5sequence :: [String]
-md5sequence = [makeMd5 i | i <- [0..]]
-    where makeMd5 i = getHash (salt ++ show i)
-
-md5sequenceS :: [String]
-md5sequenceS = [makeMd5 i | i <- [0..]]
-    where makeMd5 i = stretch $ getHash (salt ++ show i)
-          stretch h0 = foldr (\_ h -> getHash h) h0 [1..2016]
-
-possibleKey :: [String] -> Int-> Bool
-possibleKey s = not . null . repeats 3 . ((!!) s)
-
-confirmKey :: [String] -> Int -> Bool
-confirmKey s i = any (confirmation) $ take 1000 $ drop (i+1) s
-    where c = head $ repeats 3 $ s!!i
-          confirmation m = c `elem` (repeats 5 m)
-                              
-repeats :: Int -> String -> [String]
-repeats n = filter (null . tail) . map (nub) . substrings n
-
-substrings :: Int -> [a] -> [[a]]
-substrings l = filter (\s -> (length s) == l) . map (take l) . tails
diff --git a/app/advent14parallel.hs b/app/advent14parallel.hs
deleted file mode 100644 (file)
index b0ca781..0000000
+++ /dev/null
@@ -1,53 +0,0 @@
-module Main(main) where
-
-import Data.List (nub, tails)
-import Data.ByteString.Char8 (pack)
-import Crypto.Hash (hash, Digest, MD5)
-import Control.Parallel.Strategies (withStrategy, parBuffer, rdeepseq)
-
-salt = "yjdafjpo"
--- salt = "abc"
-
-stretch_factor = [1..2016]
--- stretch_factor = [1..100]
-
-main :: IO ()
-main = do 
-        part1 
-        part2
-
-part1 :: IO ()
-part1 = print $ head $ drop 63 $ filter (\i -> possibleKey sq i && confirmKey sq i) [0..]
-    where sq = md5sequence
-
-part2 :: IO ()
-part2 = print $ head $ drop 63 $ filter (\i -> possibleKey sq i && confirmKey sq i) [0..]
-    where sq = md5sequenceS
-
-getHash :: String -> String
-getHash bs = show (hash $ pack bs :: Digest MD5)
-
-md5sequence :: [String]
--- md5sequence = [makeMd5 i | i <- [0..]]
-md5sequence = withStrategy (parBuffer 100 rdeepseq) $ map (makeMd5) [0..]
-    where makeMd5 i = getHash (salt ++ show i)
-
-md5sequenceS :: [String]
--- md5sequenceS = [makeMd5 i | i <- [0..]]
-md5sequenceS = withStrategy (parBuffer 100 rdeepseq) $ map (makeMd5) [0..]
-    where makeMd5 i = stretch $ getHash (salt ++ show i)
-          stretch h0 = foldr (\_ h -> getHash h) h0 stretch_factor
-
-possibleKey :: [String] -> Int-> Bool
-possibleKey s = not . null . repeats 3 . ((!!) s)
-
-confirmKey :: [String] -> Int -> Bool
-confirmKey s i = any (confirmation) $ take 1000 $ drop (i+1) s
-    where c = head $ repeats 3 $ s!!i
-          confirmation m = c `elem` (repeats 5 m)
-                              
-repeats :: Int -> String -> [String]
-repeats n = filter (null . tail) . map (nub) . substrings n
-
-substrings :: Int -> [a] -> [[a]]
-substrings l = filter (\s -> (length s) == l) . map (take l) . tails
diff --git a/app/advent15.hs b/app/advent15.hs
deleted file mode 100644 (file)
index 5970bd6..0000000
+++ /dev/null
@@ -1,43 +0,0 @@
-module Main(main) where
-
-import Text.Parsec 
-import Text.ParserCombinators.Parsec.Number
-
-type Disk = (Int -> Bool)
-
-main :: IO ()
-main = do 
-    text <- readFile "data/advent15.txt" 
-    let disks = successfulParse $ parseIfile text
-    part1 disks
-    part2 disks
-
-part1 :: [Disk] -> IO ()
-part1 disks = print $ head $ filter (canFall disks) [0..]
-
-part2 :: [Disk] -> IO ()
-part2 disks = print $ head $ filter (canFall disks2) [0..]
-    where disks2 = disks ++ [diskify 7 11 0]
-
-canFall :: [Disk] -> Int -> Bool
-canFall ds i = all (\d -> (d i)) ds
-
-
-instructionFile = instructionLine `endBy` newline 
-instructionLine = diskify <$> (string "Disc #" *> int) 
-                          <*> (string " has " *> int)
-                          <*> (string " positions; at time=0, it is at position " *> int)
-                          <*  (string ".")
-
-diskify :: Int -> Int -> Int -> (Int -> Bool)
-diskify n size pos0 = (\i -> (size + n + pos0 + i) `mod` size == 0)
-
-parseIfile :: String -> Either ParseError [Disk]
-parseIfile input = parse instructionFile "(unknown)" input
-
-parseIline :: String -> Either ParseError Disk
-parseIline input = parse instructionLine "(unknown)" input
-
-successfulParse :: Either ParseError [a] -> [a]
-successfulParse (Left _) = []
-successfulParse (Right a) = a
diff --git a/app/advent15l.hs b/app/advent15l.hs
deleted file mode 100644 (file)
index 67e2ac0..0000000
+++ /dev/null
@@ -1,39 +0,0 @@
-module Main(main) where
-
-import Text.Parsec 
-import Text.ParserCombinators.Parsec.Number
-
-main :: IO ()
-main = do 
-    text <- readFile "data/advent15.txt" 
-    let disks = successfulParse $ parseIfile text
-    part1 disks
-    part2 disks
-
-part1 :: [[Int]] -> IO ()
-part1 disks = print $ head $ filter (canFall disks) [0..]
-
-part2 :: [[Int]] -> IO ()
-part2 disks = print $ head $ filter (canFall disks2) [0..]
-    where disks2 = disks ++ [drop 7 $ drop 0 $ cycle [0..(11-1)]]
-
-canFall :: [[Int]] -> Int -> Bool
-canFall ds i = all (\d -> (d!!i) == 0) ds
-
-
-instructionFile = instructionLine `endBy` newline 
-instructionLine = diskify <$> (string "Disc #" *> int) 
-                          <*> (string " has " *> int)
-                          <*> (string " positions; at time=0, it is at position " *> int)
-                          <*  (string ".")
-                    where diskify n size pos0 = drop n $ drop pos0 $ cycle [0..(size-1)]
-
-parseIfile :: String -> Either ParseError [[Int]]
-parseIfile input = parse instructionFile "(unknown)" input
-
-parseIline :: String -> Either ParseError [Int]
-parseIline input = parse instructionLine "(unknown)" input
-
-successfulParse :: Either ParseError [a] -> [a]
-successfulParse (Left _) = []
-successfulParse (Right a) = a
diff --git a/app/advent16.hs b/app/advent16.hs
deleted file mode 100644 (file)
index 88b8b59..0000000
+++ /dev/null
@@ -1,42 +0,0 @@
-module Main(main) where
-
-import Data.List (nub)
-
-input = "11100010111110100"
-disk1length = 272
-disk2length = 35651584
-
--- input = "10000"
--- disk1length = 20
-
-main :: IO ()
-main = do 
-    part1 
-    part2
-
-part1 :: IO ()
-part1 = putStrLn $ checksum $ take disk1length $ expand disk1length input
-
-part2 :: IO ()
-part2 = putStrLn $ checksum $ take disk2length $ expand disk2length input
-
-
-expand :: Int -> String -> String
-expand len a
-    | length a >= len = a
-    | otherwise = expand len $ a ++ "0" ++ b
-        where b = map (invert) $ reverse a
-              invert '0' = '1'
-              invert '1' = '0'
-
-checksum :: String -> String
-checksum digits
-    | odd $ length digits = digits
-    | otherwise = checksum $ map (checksumPair) $ pairs digits
-        where checksumPair p = if (length $ nub p) == 1 then '1' else '0'
-
-
-pairs :: [a] -> [[a]]
-pairs [] = []
-pairs xs = [p] ++ (pairs ys)
-    where (p, ys) = splitAt 2 xs 
diff --git a/app/advent16i.hs b/app/advent16i.hs
deleted file mode 100644 (file)
index 897559d..0000000
+++ /dev/null
@@ -1,45 +0,0 @@
-module Main(main) where
-
-input = "11100010111110100"
-disk1length = 272
-disk2length = 35651584
-
--- input = "10000"
--- disk1length = 20
-
-main :: IO ()
-main = do 
-    part1 
-    part2
-
-part1 :: IO ()
-part1 = print $ fill disk1length input
-
-part2 :: IO ()
-part2 = print $ fill disk2length input
-
-fill :: Int -> String -> String
-fill len filler = deBool $ checksum $ take len $ expand len $ enBool filler
-
-enBool :: String -> [Bool]
-enBool = map (== '1')
-
-deBool :: [Bool] -> String
-deBool = map (\b -> if b then '1' else '0')
-
-
-expand :: Int -> [Bool] -> [Bool]
-expand len = head . dropWhile ((<= len) . length) . iterate expandStep
-
-expandStep :: [Bool] -> [Bool]
-expandStep a = a ++ [False] ++ b
-        where b = map (not) $ reverse a
-
-checksum :: [Bool] -> [Bool]
-checksum = head . dropWhile (even . length) . iterate checksumStep 
-
-checksumStep :: [Bool] -> [Bool]
-checksumStep [] = []
-checksumStep [x] = [x]
-checksumStep (x:y:xs) = (x==y):(checksumStep xs)
-
diff --git a/app/advent17.hs b/app/advent17.hs
deleted file mode 100644 (file)
index e757def..0000000
+++ /dev/null
@@ -1,77 +0,0 @@
-module Main(main) where
-
-import Data.ByteString.Char8 (pack)
-import qualified Crypto.Hash as C
-
-type Position = (Int, Int)
-data Agendum = Agendum {position :: Position, path :: String, hash :: String} deriving (Show, Eq)
-type Agenda = [Agendum]
-
--- input = "hijkl"
--- input = "ihgpwlah"
-
-input = "qljzarfv" -- my input
-
-main :: IO ()
-main = do 
-    part1 
-    part2 
-
-part1 :: IO ()
-part1 = putStrLn $ path $ extractJust $ bfs initialAgenda
-
-part2 :: IO ()
-part2 = print $ bfs2 initialAgenda 0
-
-initialAgenda :: Agenda
-initialAgenda = [Agendum {position=(1, 1), path="", hash=(getHash "")}]
-
-getHash :: String -> String
-getHash path = show (C.hash $ pack (input ++ path) :: C.Digest C.MD5)
-
-extractJust :: Maybe Agendum -> Agendum
-extractJust Nothing = head initialAgenda
-extractJust (Just x) = x
-
-bfs :: Agenda -> Maybe Agendum
-bfs [] = Nothing
-bfs (current:agenda) = 
-    if isGoal current then Just current
-    else bfs (agenda ++ (successors current))
-
-bfs2 :: Agenda -> Int -> Int
-bfs2 [] l = l
-bfs2 (current:agenda) l = 
-    if isGoal current then bfs2 agenda (length $ path $ current)
-    else bfs2 (agenda ++ (successors current)) l
-
-isGoal :: Agendum -> Bool
-isGoal agendum = (position agendum) == (4, 4)
-
-isLegalPos :: Position -> Bool
-isLegalPos p = fst p >= 1 && fst p <= 4 && snd p >= 1 && snd p <= 4
-
-successors :: Agendum -> Agenda
-successors state = [Agendum {position = step p0 ld, 
-                             path = path0 ++ [ld],
-                             hash = getHash (path0 ++ [ld])} | ld <- legalDoors ]
-    where 
-        p0 = position state
-        path0 = path state
-        h0 = hash state
-        doors = openDoors h0
-        legalDoors = filter (isLegalPos . (step p0)) doors
-
-openDoors :: String -> String
-openDoors h = up ++ down ++ left ++ right
-    where
-        up    = if h!!0 `elem` "bcdef" then "U" else ""
-        down  = if h!!1 `elem` "bcdef" then "D" else ""
-        left  = if h!!2 `elem` "bcdef" then "L" else ""
-        right = if h!!3 `elem` "bcdef" then "R" else ""
-
-step :: Position -> Char -> Position
-step (r, c) 'U' = (r-1, c)
-step (r, c) 'D' = (r+1, c)
-step (r, c) 'L' = (r, c-1)
-step (r, c) 'R' = (r, c+1)
diff --git a/app/advent18.hs b/app/advent18.hs
deleted file mode 100644 (file)
index 2b1462f..0000000
+++ /dev/null
@@ -1,42 +0,0 @@
-module Main(main) where
-
-import Data.List (tails)
-
--- input = "..^^."
--- input = ".^^.^.^^^^"
-input = "^.^^^.^..^....^^....^^^^.^^.^...^^.^.^^.^^.^^..^.^...^.^..^.^^.^..^.....^^^.^.^^^..^^...^^^...^...^."
-
-main :: IO ()
-main = do 
-        part1 
-        part2
-
-part1 :: IO ()
--- part1 = putStrLn $ unlines $ map (showRow) $ take 10 $ iterate nextRow $ readRow input
-part1 = print $ length $ filter (not) $ concat $ take 40 $ iterate nextRow $ readRow input
-
-part2 :: IO ()
-part2 = print $ length $ filter (not) $ concat $ take 400000 $ iterate nextRow $ readRow input
-
-readRow :: String -> [Bool]
-readRow = map (=='^')
-
-showRow :: [Bool] -> String
-showRow = map (\c -> if c then '^' else '.')
-
-extended :: [Bool] -> [Bool]
-extended row = [False] ++ row ++ [False]
-
-nextRow :: [Bool] -> [Bool]
-nextRow = map (isTrap) . segments . extended
-
-segments :: [a] -> [[a]]
-segments = filter ((==3) . length) . map (take 3) . tails
-
-isTrap :: [Bool] -> Bool
-isTrap segment
-    | segment == [True, True, False] = True
-    | segment == [False, True, True] = True
-    | segment == [True, False, False] = True
-    | segment == [False, False, True] = True
-    | otherwise = False
diff --git a/app/advent18f.hs b/app/advent18f.hs
deleted file mode 100644 (file)
index d1650e6..0000000
+++ /dev/null
@@ -1,50 +0,0 @@
-module Main(main) where
-
-import Data.List (tails, foldl')
-
--- input = "..^^."
--- input = ".^^.^.^^^^"
-input = "^.^^^.^..^....^^....^^^^.^^.^...^^.^.^^.^^.^^..^.^...^.^..^.^^.^..^.....^^^.^.^^^..^^...^^^...^...^."
-
-main :: IO ()
-main = do 
-        part1 
-        part2
-
-part1 :: IO ()
-part1 = print $ fst $ foldl' nextRowFold (countSafe row, row) [2..40]
-    where row = readRow input
-
-part2 :: IO ()
-part2 = print $ fst $ foldl' nextRowFold (countSafe row, row) [2..400000]
-    where row = readRow input
-
-readRow :: String -> [Bool]
-readRow = map (=='^')
-
-showRow :: [Bool] -> String
-showRow = map (\c -> if c then '^' else '.')
-
-extended :: [Bool] -> [Bool]
-extended row = [False] ++ row ++ [False]
-
-nextRow :: [Bool] -> [Bool]
-nextRow = map (isTrap) . segments . extended
-
-nextRowFold :: (Int, [Bool]) -> Int -> (Int, [Bool])
-nextRowFold (n, row) _ = (n + countSafe newRow, newRow)
-    where newRow = nextRow row
-
-countSafe :: [Bool] -> Int
-countSafe = length . filter (not)
-
-segments :: [a] -> [[a]]
-segments = filter ((==3) . length) . map (take 3) . tails
-
-isTrap :: [Bool] -> Bool
-isTrap segment
-    | segment == [True, True, False] = True
-    | segment == [False, True, True] = True
-    | segment == [True, False, False] = True
-    | segment == [False, False, True] = True
-    | otherwise = False
diff --git a/app/advent19.hs b/app/advent19.hs
deleted file mode 100644 (file)
index 009a07c..0000000
+++ /dev/null
@@ -1,37 +0,0 @@
-module Main(main) where
-
-import Prelude hiding (length, take, drop)
-import Data.Sequence
-
--- input = 5 
-input = 3012210 
-
-main :: IO ()
-main = do 
-    part1 
-    part2
-
-part1 :: IO ()
-part1 = print $ 2 * (input - 2 ^ (toInteger (floor $ logBase 2 (fromIntegral input)))) + 1
-
-part2 :: IO ()
-part2 = print $ flip index 0 $ presentSteps initial
-
-presentSteps :: Seq Int -> Seq Int
-presentSteps elves 
-    | isFinished elves = elves
-    | otherwise = presentSteps $ next elves
-
-initial :: Seq Int
-initial = fromList [1..input] 
-
-isFinished :: Seq Int -> Bool
-isFinished elves = length elves == 1
-
-next :: Seq Int -> Seq Int
-next elves = prefix >< (midfix |> suffix)
-    where 
-        target = length elves `quot` 2
-        prefix = drop 1 $ take target elves
-        midfix = drop (target+1) elves
-        suffix = index elves 0
diff --git a/app/advent20.hs b/app/advent20.hs
deleted file mode 100644 (file)
index 8830c45..0000000
+++ /dev/null
@@ -1,74 +0,0 @@
-module Main(main) where
-
-import Text.Parsec 
-import Text.ParserCombinators.Parsec.Number
-import Data.List (foldl')
-
-data Interval = Interval Int Int deriving (Show, Eq)
-
-low :: Interval -> Int
-low (Interval l _) = l
-
-high :: Interval -> Int
-high (Interval _ h) = h
-
-main :: IO ()
-main = do 
-    text <- readFile "data/advent20.txt" 
-    let intervals = successfulParse $ parseIfile text
-    part1 intervals
-    part2 intervals
-
-part1 :: [Interval] -> IO ()
-part1 intervals = print $ (+1) $ high $ head $ foldl' (mergeAdjacent) [] $ foldl' (merge) [] intervals
-
-part2 :: [Interval] -> IO ()
-part2 intervals = do
-    let ints = foldl' (mergeAdjacent) [] $ foldl' (merge) [] intervals
-    let gapCount = gaps ints
-    let lowGap = low $ head ints
-    let highGap = 4294967295 - (high $ last ints)
-    print (lowGap + gapCount + highGap)
-
-disjoint :: Interval -> Interval -> Bool
-disjoint (Interval a b) (Interval c d)
-    | b < c = True
-    | d < a = True
-    | a > d = True
-    | c > b = True
-    | otherwise = False
-
-intersect :: Interval -> Interval -> Bool
-intersect a b = not $ disjoint a b
-
-merge :: [Interval] -> Interval -> [Interval]
-merge [] i0 = [i0]
-merge (i1:intervals) i0
-    | (high i0) < (low i1) = i0:i1:intervals
-    | intersect i0 i1 = merge intervals (Interval a' b')
-    | otherwise = i1:(merge intervals i0)
-        where a' = minimum [low i0, low i1]
-              b' = maximum [high i0, high i1]
-
-mergeAdjacent :: [Interval] -> Interval -> [Interval]
-mergeAdjacent [] i0 = [i0]
-mergeAdjacent (i1:intervals) i0
-    | high i0 + 1 == low i1 = (Interval (low i0) (high i1)):intervals
-    | low i0 == high i1 + 1 = (Interval (low i1) (high i0)):intervals
-    | otherwise = i1:(mergeAdjacent intervals i0)
-
-gaps :: [Interval] -> Int
-gaps [] = 0
-gaps [_] = 0
-gaps ((Interval _ b):(Interval c d):intervals) = 
-    (c - b - 1) + gaps ((Interval c d):intervals)
-
-intervalFile = intervalLine `endBy` newline 
-intervalLine = Interval <$> int <*> (string "-" *> int)
-
-parseIfile :: String -> Either ParseError [Interval]
-parseIfile input = parse intervalFile "(unknown)" input
-
-successfulParse :: Either ParseError [a] -> [a]
-successfulParse (Left _) = []
-successfulParse (Right a) = a
diff --git a/app/advent21.hs b/app/advent21.hs
deleted file mode 100644 (file)
index 2415974..0000000
+++ /dev/null
@@ -1,198 +0,0 @@
-module Main(main) where
-
-import Text.Parsec hiding (State)
-import Text.ParserCombinators.Parsec.Number
-import Data.Maybe (fromJust)
-import Data.List (elemIndex)
-
-import Control.Monad.Identity
-import Control.Monad.State
-import Control.Monad.Writer
-
-data Instruction =    SwapPosition Int Int 
-                    | SwapLetter Char Char
-                    | RotateSteps Int
-                    | RotateLetter Char
-                    | Reverse Int Int
-                    | Move Int Int 
-                    deriving (Show, Eq)
-
-data Log = Log {
-    action :: String
-    } deriving (Show)
-
-data Password = Password {
-    password :: String
-    } deriving (Show)
-
-
-type App = WriterT [Log] (StateT Password Identity)
-
-infixl 9 ??
-
-(??) :: Eq a => [a] -> a -> Int
-(??) items item = fromJust $ elemIndex item items
-
-
-initial = "abcdefgh"
-final   = "fbgdceah"
-
-testInstructions = "\
-\swap position 4 with position 0\n\
-\swap letter d with letter b\n\
-\reverse positions 0 through 4\n\
-\rotate left 1 step\n\
-\move position 1 to position 4\n\
-\move position 3 to position 0\n\
-\rotate based on position of letter b\n\
-\rotate based on position of letter d\n"
-
-main :: IO ()
-main = do 
-    -- let ti = successfulParse $ parseIfile testInstructions
-    -- part1 ti "abcde"
-    -- part2 (reverse ti) "decab"
-    text <- readFile "data/advent21.txt" 
-    let instructions = successfulParse $ parseIfile text
-    part1 instructions initial
-    part2 (reverse instructions) final
-
-part1 :: [Instruction] -> String -> IO ()
-part1 instructions start = 
-    let st = Password {password = start}
-        ((_, log), st') = runIdentity (runStateT (runWriterT (apply instructions)) st)
-    in do 
-        -- putStrLn $ unlines $ map (action) log
-        putStrLn $ password st'
-
-part2 :: [Instruction] -> String -> IO ()
-part2 instructions end = 
-    let st = Password {password = end}
-        ((_, log), st') = runIdentity (runStateT (runWriterT (unApply instructions)) st)
-    in do 
-        -- putStrLn $ unlines $ map (action) log
-        putStrLn $ password st'
-
-
-apply :: [Instruction] -> App ()
-apply [] = return ()
-apply (i:is) = 
-    do  st <- get
-        let p0 = password st
-        let p1 = applyInstruction i p0
-        put st {password = p1}
-        tell [Log (p0 ++ " -> " ++ p1 ++ " : " ++ (show i))]
-        apply is
-
-
-applyInstruction :: Instruction -> String -> String
-applyInstruction (SwapPosition from to) p0 
-    | from == to = p0
-    | otherwise = prefix ++ [p0!!end] ++ midfix ++ [p0!!start] ++ suffix
-        where start = minimum [from, to]
-              end = maximum [from, to]
-              prefix = take start p0
-              midfix = take (end-start-1) $ drop (start+1) p0
-              suffix = drop (end+1) p0
-
-applyInstruction (SwapLetter l0 l1) p0 = applyInstruction (SwapPosition (p0??l0) (p0??l1)) p0
-
-applyInstruction (RotateSteps n) p0 = (drop n' p0) ++ (take n' p0)
-    where n' = if n < 0 
-                then (-1 * n)
-                else (length p0) - n
-
-applyInstruction (RotateLetter l) p0 = applyInstruction (RotateSteps n) p0
-    where n = (1 + (p0??l) + if (p0??l) >= 4 then 1 else 0) `mod` (length p0)
-
-applyInstruction (Reverse from to) p0
-    | from == to = p0
-    | otherwise = prefix ++ (reverse midfix) ++ suffix
-        where start = minimum [from, to]
-              end = maximum [from, to]
-              prefix = take start p0
-              midfix = take (end-start+1) $ drop start p0
-              suffix = drop (end+1) p0
-
-applyInstruction (Move from to) p0 
-    | from == to = p0
-    | otherwise = prefix ++ [p0!!from] ++ suffix
-        where without = take from p0 ++ drop (from+1) p0
-              prefix = take to without
-              suffix = drop (to) without
-
-
-unApply :: [Instruction] -> App ()
-unApply [] = return ()
-unApply (i:is) = 
-    do  st <- get
-        let p0 = password st
-        let p1 = unApplyInstruction i p0
-        put st {password = p1}
-        tell [Log (p1 ++ " <- " ++ p0 ++ " : " ++ (show i))]
-        unApply is
-
-unApplyInstruction :: Instruction -> String -> String
-unApplyInstruction (SwapPosition from to) p0 = applyInstruction (SwapPosition from to) p0
-unApplyInstruction (SwapLetter l0 l1) p0 = applyInstruction (SwapLetter l0 l1) p0
-unApplyInstruction (RotateSteps n) p0 = applyInstruction (RotateSteps (-1 * n)) p0
-unApplyInstruction (Reverse from to) p0 = applyInstruction (Reverse from to) p0
-unApplyInstruction (Move from to) p0 = applyInstruction (Move to from) p0
-unApplyInstruction (RotateLetter l) p0 = applyInstruction (RotateSteps n) p0
-    where n = case (p0??l) of
-                0 -> -1
-                1 -> -1
-                2 ->  2
-                3 -> -2
-                4 ->  1
-                5 -> -3
-                6 ->  0
-                7 -> -4
-    -- where n = case (p0??l) of
-    --             0 -> -1
-    --             1 -> -1
-    --             2 ->  1
-    --             3 -> -2
-    --             4 ->  1
-
-
-instructionFile = instructionLine `endBy` newline 
-instructionLine = choice [ swapL 
-                         , rotateL
-                         , reverseL
-                         , moveL
-                         ]
-
-swapL = (try (string "swap ")) *> (swapPosL <|> swapLetterL)
-
-swapPosL = SwapPosition <$> (string "position" *> spaces *> int) 
-                        <*> (spaces *> string "with position" *> spaces *> int)
-
-swapLetterL = SwapLetter <$> (string "letter" *> spaces *> letter) 
-                         <*> (spaces *> string "with letter" *> spaces *> letter)
-
-rotateL = (try (string "rotate ")) *> (rotateDirL <|> rotateLetterL)
-
-rotateDirL = rotateStepify <$> ((string "left") <|> (string "right"))
-                           <*> (spaces *> int <* spaces <* skipMany letter)
-    where rotateStepify dir n = case dir of 
-                                     "left" -> (RotateSteps (-1 * n))
-                                     "right" -> (RotateSteps n)
-rotateLetterL = RotateLetter <$> (string "based on position of letter " *> letter)
-
-reverseL = Reverse <$> (string "reverse positions" *> spaces *> int)
-                   <*> (spaces *> (string "through") *> spaces *> int)
-
-moveL = Move <$> (string "move position" *> spaces *> int)
-             <*> (spaces *> (string "to position") *> spaces *> int)
-
-
-parseIfile :: String -> Either ParseError [Instruction]
-parseIfile input = parse instructionFile "(unknown)" input
-
-parseIline :: String -> Either ParseError Instruction
-parseIline input = parse instructionLine "(unknown)" input
-
-successfulParse :: Either ParseError [a] -> [a]
-successfulParse (Left _) = []
-successfulParse (Right a) = a
diff --git a/app/advent22.hs b/app/advent22.hs
deleted file mode 100644 (file)
index f2e084a..0000000
+++ /dev/null
@@ -1,156 +0,0 @@
-module Main(main) where
-
-import GHC.Generics (Generic)
-import Text.Parsec 
-import Text.ParserCombinators.Parsec.Number
-import Data.Maybe (catMaybes, fromJust)
-import Data.List (find, delete, sort, sortOn, reverse)
-
-data Node = Node { x :: Int
-                 , y :: Int
-                 , size :: Int
-                 , used :: Int
-                 , available :: Int
-                 , use_pc :: Int 
-                 } deriving (Show, Eq, Ord)
-
-data SearchState = SearchState { cx :: Int
-                               , cy :: Int 
-                               , grid :: [Node]
-                               } deriving (Show)
-instance Ord SearchState where
-    s1 `compare` s2 = (heuristic s1) `compare` (heuristic s2)
-instance Eq SearchState where
-  s1 == s2 = equivalentState s1 s2
-
-equivalentState :: SearchState -> SearchState -> Bool
-equivalentState s1 s2 =
-    let h1 = fromJust $ find (\n -> used n == 0) $ grid s1
-        h2 = fromJust $ find (\n -> used n == 0) $ grid s2
-      in
-        cx s1 == cx s2 && cy s1 == cy s2 && 
-                    x h1 == x h2 && y h1 == y h2
-
-
-testGrid = "\
-\Filesystem            Size  Used  Avail  Use%\n\
-\/dev/grid/node-x0-y0   10T    8T     2T   80%\n\
-\/dev/grid/node-x0-y1   11T    6T     5T   54%\n\
-\/dev/grid/node-x0-y2   32T   28T     4T   87%\n\
-\/dev/grid/node-x1-y0    9T    7T     2T   77%\n\
-\/dev/grid/node-x1-y1    8T    0T     8T    0%\n\
-\/dev/grid/node-x1-y2   11T    7T     4T   63%\n\
-\/dev/grid/node-x2-y0   10T    6T     4T   60%\n\
-\/dev/grid/node-x2-y1    9T    8T     1T   88%\n\
-\/dev/grid/node-x2-y2    9T    6T     3T   66%\n\
-\"
-
-main :: IO ()
-main = do 
-    text <- readFile "data/advent22.txt" 
-    let sizes = successfulParse $ parseFile text
-    part1 sizes
-    part2 sizes
-
-part1 :: [Node] ->  IO ()
-part1 sizes = print $ length viable
-    where viable = [(a, b) | a <- sizes, 
-                             b <- sizes, 
-                             a /= b,
-                             (used a) > 0,
-                             (used a) <= (available b)]
-
-
-part2 :: [Node] ->  IO ()
-part2 sizes = 
-    -- do let testSizes = successfulParse $ parseFile testGrid
-    --    putStrLn $ searchTraceH $ reverse $ aStar [[startSt testSizes]] []
-       print (26 + 26 + 29 + 5 * 36)
-
-
-aStar :: [[SearchState]] -> [SearchState] -> [SearchState]
-aStar [] _ = []
-aStar (currentPath:agenda) closed = 
-    if isGoal reached then currentPath
-    else if reached `elem` closed 
-        then aStar agenda closed
-        else aStar newAgenda (reached:closed) 
-    where 
-        reached = head currentPath
-        successorPaths = map (:currentPath) $ successors reached
-        newAgenda = sortOn (cost) $ successorPaths ++ agenda 
-
-
-searchTrace :: [SearchState] -> String
-searchTrace ss = unlines $ map (sst) ss
-    where sst s = "(" ++ show (cx s) ++ ", " ++ show (cy s) ++ ")"
-
-searchTraceH :: [SearchState] -> String
-searchTraceH ss = unlines $ map (sst) ss
-    where sst s = "(" ++ show (cx s) ++ ", " ++ show (cy s) ++ ") :: " ++ holeS s
-          hole sk = fromJust $ find (\n -> used n == 0) $ grid sk 
-          holeS sk = "(" ++ show (x $ hole sk) ++ ", " ++ show (y $ hole sk) ++ ")"
-
-startSt :: [Node] -> SearchState
-startSt nodes = SearchState {cx = maximum xs, cy = 0, grid = nodes}
-    where xs = map (\n -> x n) nodes
-
-isGoal :: SearchState -> Bool
-isGoal st = cx st == 0 && cy st == 0
-
-adjacent :: Node -> Node -> Bool
-adjacent n1 n2 = abs ((x n1) - (x n2)) + abs ((y n1) - (y n2)) == 1
-
--- A move of data from n1 to n2 is legal.
-legal :: Node -> Node -> Bool
-legal n1 n2 = adjacent n1 n2 && used n1 > 0 && used n1 <= available n2
-
-heuristic :: SearchState -> Int
-heuristic st = (cx st) + (cy st)
-
-successors :: SearchState -> [SearchState]
-successors st = map (newState st current) possibleMoves
-    where nodes = grid st
-          current = fromJust $ find (\n -> (x n) == (cx st) && (y n) == (cy st)) nodes
-          possibleMoves = [(n1, n2) | n1 <- nodes, n2 <- nodes, legal n1 n2]
-
-
--- Moving data from n1 to n2
-newState :: SearchState -> Node -> (Node, Node) -> SearchState
-newState st current (n1, n2) = st {cx = cx', cy = cy', grid = grid'}
-    where cx' = if current == n1 then x n2 else x current
-          cy' = if current == n1 then y n2 else y current
-          grid' = sort $ (n2 {used = (used n2 + used n1), available = (available n2 - used n1)}):
-                        (n1 {used = 0, available = (size n1)}):
-                        (delete n1 $ delete n2 (grid st))
-
-cost :: [SearchState] -> Int
-cost p = (heuristic $ head p) + (length p)
-
-
-
-duFile = duLine `sepEndBy` newline 
--- duLine = (optionMaybe nodeL)
-
-duLine = (nodeL >>= return . Just) <|> (headerL >> return Nothing)
-
-headerL = (many (noneOf "\r\n"))
-
-nodeL = nodeify <$> (string "/dev/grid/node-x" *> int)
-                <*> (string "-y" *> int)
-                <*> (spaces *> int <* string "T")
-                <*> (spaces *> int <* string "T")
-                <*> (spaces *> int <* string "T")
-                <*> (spaces *> int <* string "%")
-            where nodeify x y size used available use_pc = 
-                      Node {x=x, y=y, size=size, used=used, available=available, use_pc=use_pc}
-
-parseFile :: String -> Either ParseError [Maybe Node]
-parseFile input = parse duFile "(unknown)" input
-
-parseLine :: String -> Either ParseError (Maybe Node)
-parseLine input = parse duLine "(unknown)" input
-
-successfulParse :: Either ParseError [Maybe a] -> [a]
-successfulParse (Left _) = []
-successfulParse (Right a) = catMaybes a
diff --git a/app/advent22library.hs b/app/advent22library.hs
deleted file mode 100644 (file)
index bad3621..0000000
+++ /dev/null
@@ -1,143 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-
-module Main(main) where
-
-import GHC.Generics (Generic)
-import Text.Parsec 
-import Text.ParserCombinators.Parsec.Number
-import Data.Maybe (catMaybes, fromJust)
-import Data.List (find, delete, sort)
-import Data.Graph.AStar
-import Data.Hashable
-import qualified Data.HashSet
-
-data Node = Node { x :: Int
-                 , y :: Int
-                 , size :: Int
-                 , used :: Int
-                 , available :: Int
-                 , use_pc :: Int 
-                 } deriving (Show, Eq, Ord, Generic)
-instance Hashable Node
-
-data SearchState = SearchState { cx :: Int
-                               , cy :: Int 
-                               , grid :: [Node]
-                               } deriving (Show, Eq, Generic)
-instance Hashable SearchState
-instance Ord SearchState where
-    s1 `compare` s2 = (heuristic s1) `compare` (heuristic s2)
-
-
-testGrid = "\
-\Filesystem            Size  Used  Avail  Use%\n\
-\/dev/grid/node-x0-y0   10T    8T     2T   80%\n\
-\/dev/grid/node-x0-y1   11T    6T     5T   54%\n\
-\/dev/grid/node-x0-y2   32T   28T     4T   87%\n\
-\/dev/grid/node-x1-y0    9T    7T     2T   77%\n\
-\/dev/grid/node-x1-y1    8T    0T     8T    0%\n\
-\/dev/grid/node-x1-y2   11T    7T     4T   63%\n\
-\/dev/grid/node-x2-y0   10T    6T     4T   60%\n\
-\/dev/grid/node-x2-y1    9T    8T     1T   88%\n\
-\/dev/grid/node-x2-y2    9T    6T     3T   66%\n\
-\"
-
-main :: IO ()
-main = do 
-    text <- readFile "data/advent22.txt" 
-    let sizes = successfulParse $ parseFile text
-    part1 sizes
-    part2 sizes
-
-part1 :: [Node] ->  IO ()
-part1 sizes = print $ length viable
-    where viable = [(a, b) | a <- sizes, 
-                             b <- sizes, 
-                             a /= b,
-                             (used a) > 0,
-                             (used a) <= (available b)]
-
-
-part2 :: [Node] ->  IO ()
-part2 sizes = 
-    -- do let testSizes = successfulParse $ parseFile testGrid
-    --    putStrLn $ searchTrace $ fromJust $ 
-    --                 aStar successors 
-    --                         (\_ _ -> 1) 
-    --                         heuristic
-    --                         isGoal
-    --                         (startSt testSizes)
-    putStrLn $ searchTrace $ fromJust $ 
-                    aStar successors 
-                            (\_ _ -> 1) 
-                            heuristic
-                            isGoal
-                            (startSt sizes)
-
-
-
-searchTrace :: [SearchState] -> String
-searchTrace ss = unlines $ map (sst) ss
-    where sst s = "(" ++ show (cx s) ++ ", " ++ show (cy s) ++ ") :: " ++ holeS s
-          hole sk = fromJust $ find (\n -> used n == 0) $ grid sk 
-          holeS sk = "(" ++ show (x $ hole sk) ++ ", " ++ show (y $ hole sk) ++ ")"
-
-startSt :: [Node] -> SearchState
-startSt nodes = SearchState {cx = maximum xs, cy = 0, grid = nodes}
-    where xs = map (\n -> x n) nodes
-
-isGoal :: SearchState -> Bool
-isGoal st = cx st == 0 && cy st == 0
-
-adjacent :: Node -> Node -> Bool
-adjacent n1 n2 = abs ((x n1) - (x n2)) + abs ((y n1) - (y n2)) == 1
-
--- A move of data from n1 to n2 is legal.
-legal :: Node -> Node -> Bool
-legal n1 n2 = adjacent n1 n2 && used n1 > 0 && used n1 <= available n2
-
-heuristic :: SearchState -> Int
-heuristic st = (cx st) + (cy st)
-
-successors :: SearchState -> Data.HashSet.HashSet SearchState
-successors st = Data.HashSet.fromList $ map (newState st current) possibleMoves
-    where nodes = grid st
-          current = fromJust $ find (\n -> (x n) == (cx st) && (y n) == (cy st)) nodes
-          possibleMoves = [(n1, n2) | n1 <- nodes, n2 <- nodes, legal n1 n2]
-
-
--- Moving data from n1 to n2
-newState :: SearchState -> Node -> (Node, Node) -> SearchState
-newState st current (n1, n2) = st {cx = cx', cy = cy', grid = grid'}
-    where cx' = if current == n1 then x n2 else x current
-          cy' = if current == n1 then y n2 else y current
-          grid' = sort $ (n2 {used = (used n2 + used n1), available = (available n2 - used n1)}):
-                        (n1 {used = 0, available = (size n1)}):
-                        (delete n1 $ delete n2 (grid st))
-
-
-duFile = duLine `sepEndBy` newline 
--- duLine = (optionMaybe nodeL)
-
-duLine = (nodeL >>= return . Just) <|> (headerL >> return Nothing)
-
-headerL = (many (noneOf "\r\n"))
-
-nodeL = nodeify <$> (string "/dev/grid/node-x" *> int)
-                <*> (string "-y" *> int)
-                <*> (spaces *> int <* string "T")
-                <*> (spaces *> int <* string "T")
-                <*> (spaces *> int <* string "T")
-                <*> (spaces *> int <* string "%")
-            where nodeify x y size used available use_pc = 
-                      Node {x=x, y=y, size=size, used=used, available=available, use_pc=use_pc}
-
-parseFile :: String -> Either ParseError [Maybe Node]
-parseFile input = parse duFile "(unknown)" input
-
-parseLine :: String -> Either ParseError (Maybe Node)
-parseLine input = parse duLine "(unknown)" input
-
-successfulParse :: Either ParseError [Maybe a] -> [a]
-successfulParse (Left _) = []
-successfulParse (Right a) = catMaybes a
diff --git a/app/advent22search.hs b/app/advent22search.hs
deleted file mode 100644 (file)
index 32ada24..0000000
+++ /dev/null
@@ -1,156 +0,0 @@
-module Main(main) where
-
-import GHC.Generics (Generic)
-import Text.Parsec 
-import Text.ParserCombinators.Parsec.Number
-import Data.Maybe (catMaybes, fromJust)
-import Data.List (find, delete, sort, sortOn, reverse)
-
-data Node = Node { x :: Int
-                 , y :: Int
-                 , size :: Int
-                 , used :: Int
-                 , available :: Int
-                 , use_pc :: Int 
-                 } deriving (Show, Eq, Ord)
-
-data SearchState = SearchState { cx :: Int
-                               , cy :: Int 
-                               , grid :: [Node]
-                               } deriving (Show)
-instance Ord SearchState where
-    s1 `compare` s2 = (heuristic s1) `compare` (heuristic s2)
-instance Eq SearchState where
-  s1 == s2 = equivalentState s1 s2
-
-equivalentState :: SearchState -> SearchState -> Bool
-equivalentState s1 s2 =
-    let h1 = fromJust $ find (\n -> used n == 0) $ grid s1
-        h2 = fromJust $ find (\n -> used n == 0) $ grid s2
-      in
-        cx s1 == cx s2 && cy s1 == cy s2 && 
-                    x h1 == x h2 && y h1 == y h2
-
-
-testGrid = "\
-\Filesystem            Size  Used  Avail  Use%\n\
-\/dev/grid/node-x0-y0   10T    8T     2T   80%\n\
-\/dev/grid/node-x0-y1   11T    6T     5T   54%\n\
-\/dev/grid/node-x0-y2   32T   28T     4T   87%\n\
-\/dev/grid/node-x1-y0    9T    7T     2T   77%\n\
-\/dev/grid/node-x1-y1    8T    0T     8T    0%\n\
-\/dev/grid/node-x1-y2   11T    7T     4T   63%\n\
-\/dev/grid/node-x2-y0   10T    6T     4T   60%\n\
-\/dev/grid/node-x2-y1    9T    8T     1T   88%\n\
-\/dev/grid/node-x2-y2    9T    6T     3T   66%\n\
-\"
-
-main :: IO ()
-main = do 
-    text <- readFile "data/advent22.txt" 
-    let sizes = successfulParse $ parseFile text
-    part1 sizes
-    part2 sizes
-
-part1 :: [Node] ->  IO ()
-part1 sizes = print $ length viable
-    where viable = [(a, b) | a <- sizes, 
-                             b <- sizes, 
-                             a /= b,
-                             (used a) > 0,
-                             (used a) <= (available b)]
-
-
-part2 :: [Node] ->  IO ()
-part2 sizes = 
-    -- do let testSizes = successfulParse $ parseFile testGrid
-    --    putStrLn $ searchTraceH $ reverse $ aStar [[startSt testSizes]] []
-       print $ length $ aStar [[startSt sizes]] []
-
-
-aStar :: [[SearchState]] -> [SearchState] -> [SearchState]
-aStar [] _ = []
-aStar (currentPath:agenda) closed = 
-    if isGoal reached then currentPath
-    else if reached `elem` closed 
-        then aStar agenda closed
-        else aStar newAgenda (reached:closed) 
-    where 
-        reached = head currentPath
-        successorPaths = map (:currentPath) $ successors reached
-        newAgenda = sortOn (cost) $ successorPaths ++ agenda 
-
-
-searchTrace :: [SearchState] -> String
-searchTrace ss = unlines $ map (sst) ss
-    where sst s = "(" ++ show (cx s) ++ ", " ++ show (cy s) ++ ")"
-
-searchTraceH :: [SearchState] -> String
-searchTraceH ss = unlines $ map (sst) ss
-    where sst s = "(" ++ show (cx s) ++ ", " ++ show (cy s) ++ ") :: " ++ holeS s
-          hole sk = fromJust $ find (\n -> used n == 0) $ grid sk 
-          holeS sk = "(" ++ show (x $ hole sk) ++ ", " ++ show (y $ hole sk) ++ ")"
-
-startSt :: [Node] -> SearchState
-startSt nodes = SearchState {cx = maximum xs, cy = 0, grid = nodes}
-    where xs = map (\n -> x n) nodes
-
-isGoal :: SearchState -> Bool
-isGoal st = cx st == 0 && cy st == 0
-
-adjacent :: Node -> Node -> Bool
-adjacent n1 n2 = abs ((x n1) - (x n2)) + abs ((y n1) - (y n2)) == 1
-
--- A move of data from n1 to n2 is legal.
-legal :: Node -> Node -> Bool
-legal n1 n2 = adjacent n1 n2 && used n1 > 0 && used n1 <= available n2
-
-heuristic :: SearchState -> Int
-heuristic st = (cx st) + (cy st)
-
-successors :: SearchState -> [SearchState]
-successors st = map (newState st current) possibleMoves
-    where nodes = grid st
-          current = fromJust $ find (\n -> (x n) == (cx st) && (y n) == (cy st)) nodes
-          possibleMoves = [(n1, n2) | n1 <- nodes, n2 <- nodes, legal n1 n2]
-
-
--- Moving data from n1 to n2
-newState :: SearchState -> Node -> (Node, Node) -> SearchState
-newState st current (n1, n2) = st {cx = cx', cy = cy', grid = grid'}
-    where cx' = if current == n1 then x n2 else x current
-          cy' = if current == n1 then y n2 else y current
-          grid' = sort $ (n2 {used = (used n2 + used n1), available = (available n2 - used n1)}):
-                        (n1 {used = 0, available = (size n1)}):
-                        (delete n1 $ delete n2 (grid st))
-
-cost :: [SearchState] -> Int
-cost p = (heuristic $ head p) + (length p)
-
-
-
-duFile = duLine `sepEndBy` newline 
--- duLine = (optionMaybe nodeL)
-
-duLine = (nodeL >>= return . Just) <|> (headerL >> return Nothing)
-
-headerL = (many (noneOf "\r\n"))
-
-nodeL = nodeify <$> (string "/dev/grid/node-x" *> int)
-                <*> (string "-y" *> int)
-                <*> (spaces *> int <* string "T")
-                <*> (spaces *> int <* string "T")
-                <*> (spaces *> int <* string "T")
-                <*> (spaces *> int <* string "%")
-            where nodeify x y size used available use_pc = 
-                      Node {x=x, y=y, size=size, used=used, available=available, use_pc=use_pc}
-
-parseFile :: String -> Either ParseError [Maybe Node]
-parseFile input = parse duFile "(unknown)" input
-
-parseLine :: String -> Either ParseError (Maybe Node)
-parseLine input = parse duLine "(unknown)" input
-
-successfulParse :: Either ParseError [Maybe a] -> [a]
-successfulParse (Left _) = []
-successfulParse (Right a) = catMaybes a
diff --git a/app/advent22showgrid.hs b/app/advent22showgrid.hs
deleted file mode 100644 (file)
index aec4309..0000000
+++ /dev/null
@@ -1,77 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-
-module Main(main) where
-
-import GHC.Generics (Generic)
-import Text.Parsec 
-import Text.ParserCombinators.Parsec.Number
-import Data.Maybe (catMaybes, fromJust)
-import Data.List (find, delete, sort, sortOn, reverse)
-
-data Node = Node { x :: Int
-                 , y :: Int
-                 , size :: Int
-                 , used :: Int
-                 , available :: Int
-                 , use_pc :: Int 
-                 } deriving (Show, Eq, Ord)
-
-
-testGrid = "\
-\Filesystem            Size  Used  Avail  Use%\n\
-\/dev/grid/node-x0-y0   10T    8T     2T   80%\n\
-\/dev/grid/node-x0-y1   11T    6T     5T   54%\n\
-\/dev/grid/node-x0-y2   32T   28T     4T   87%\n\
-\/dev/grid/node-x1-y0    9T    7T     2T   77%\n\
-\/dev/grid/node-x1-y1    8T    0T     8T    0%\n\
-\/dev/grid/node-x1-y2   11T    7T     4T   63%\n\
-\/dev/grid/node-x2-y0   10T    6T     4T   60%\n\
-\/dev/grid/node-x2-y1    9T    8T     1T   88%\n\
-\/dev/grid/node-x2-y2    9T    6T     3T   66%\n\
-\"
-
-main :: IO ()
-main = do 
-    text <- readFile "data/advent22.txt" 
-    let sizes = successfulParse $ parseFile text
-    let maxX = maximum $ map (\n -> x n) sizes
-    let maxY = maximum $ map (\n -> y n) sizes
-    putStrLn $ unlines $ map (showRow maxX sizes) [0..(maxY-1)]
-
-
-showRow maxX sizes r = map (charOf) row
-  where row = sortOn (\c -> x c) $ filter (\c -> y c == r) sizes
-        charOf c = if (used c) == 0 
-                      then '+'
-                      else if (used c) > 100
-                              then '#'
-                              else '_'
-
-
-
-
-duFile = duLine `sepEndBy` newline 
--- duLine = (optionMaybe nodeL)
-
-duLine = (nodeL >>= return . Just) <|> (headerL >> return Nothing)
-
-headerL = (many (noneOf "\r\n"))
-
-nodeL = nodeify <$> (string "/dev/grid/node-x" *> int)
-                <*> (string "-y" *> int)
-                <*> (spaces *> int <* string "T")
-                <*> (spaces *> int <* string "T")
-                <*> (spaces *> int <* string "T")
-                <*> (spaces *> int <* string "%")
-            where nodeify x y size used available use_pc = 
-                      Node {x=x, y=y, size=size, used=used, available=available, use_pc=use_pc}
-
-parseFile :: String -> Either ParseError [Maybe Node]
-parseFile input = parse duFile "(unknown)" input
-
-parseLine :: String -> Either ParseError (Maybe Node)
-parseLine input = parse duLine "(unknown)" input
-
-successfulParse :: Either ParseError [Maybe a] -> [a]
-successfulParse (Left _) = []
-successfulParse (Right a) = catMaybes a
diff --git a/app/advent23.hs b/app/advent23.hs
deleted file mode 100644 (file)
index 2903967..0000000
+++ /dev/null
@@ -1,180 +0,0 @@
-module Main(main) where
-
-import Text.Parsec hiding (State)
-import Text.ParserCombinators.Parsec.Number
-import Control.Monad.State.Lazy
--- import Debug.Trace
-
-data Location = Literal Int | Register Char deriving (Show, Eq)
-data Instruction =   Cpy Location Location 
-                   | Inc Location 
-                   | Dec Location 
-                   | Jnz Location Location
-                   | Tgl Location
-                   deriving (Show, Eq)
-
-data Machine = Machine { a :: Int
-                       , b :: Int
-                       , c :: Int
-                       , d :: Int
-                       , pc :: Int
-                       , instructions :: [Instruction]} 
-               deriving (Show, Eq)
-
-testInstructions = "cpy 2 a\n\
-\tgl a\n\
-\tgl a\n\
-\tgl a\n\
-\cpy 1 a\n\
-\dec a\n\
-\dec a"
-
-emptyMachine :: Machine
-emptyMachine = Machine {a=0, b=0, c=0, d=0, pc=0, instructions=[]}
-
-main :: IO ()
-main = do 
-    text <- readFile "data/advent23.txt" 
-    let instructions = successfulParse $ parseIfile text
-    part1 instructions
-    part2 instructions
-
-
-part1 :: [Instruction] -> IO ()
-part1 instrs = 
-    do  let m0 = emptyMachine {instructions=instrs, a = 7}
-        let mf = snd $ runState runMachine m0
-        print (a mf)
-
-part2 :: [Instruction] -> IO ()
-part2 instrs = 
-    do  let m0 = emptyMachine {instructions=instrs, a = 12}
-        let mf = snd $ runState runMachine m0
-        print (a mf)
-
-
-runMachine :: State Machine ()
-runMachine = 
-    do  m <- get
-        if (pc m) >= (length $ instructions m)
-            then return ()
-            else do executeStep
-                    runMachine
-
-executeStep :: State Machine ()
-executeStep = 
-    do  m <- get
-        let i = (instructions m)!!(pc m)
-        put (executeInstructionPeep i m)
-        -- put (executeInstruction i m)
-
-executeInstructionPeep :: Instruction -> Machine -> Machine
-executeInstructionPeep i m =
-    if sample1 == sample1Target
-        -- then trace ("Peeping 1 " ++ (show m) ++ " to " ++ (show m1)) m1
-        then m1
-        else if sample2 == sample2Target
-            -- then trace ("Peeping 2 " ++ (show m) ++ " to " ++ (show m2)) m2
-            then m2
-            else executeInstruction i m
-    where sample1 = take (length sample1Target) $ drop (pc m) $ instructions m 
-          sample1Target = [ Cpy (Literal 0)    (Register 'a')
-                          , Cpy (Register 'b') (Register 'c')
-                          , Inc (Register 'a')
-                          , Dec (Register 'c')
-                          , Jnz (Register 'c') (Literal (-2))
-                          , Dec (Register 'd')
-                          , Jnz (Register 'd') (Literal (-5)) ]
-          m1 = m {a = b m * d m, c = 0, d = 0, pc = pc m + (length sample1)}
-          sample2 = take (length sample2Target) $ drop (pc m) $ instructions m 
-          sample2Target = [ Dec (Register 'b')
-                          , Cpy (Register 'b') (Register 'c')
-                          , Cpy (Register 'c') (Register 'd')
-                          , Dec (Register 'd')
-                          , Inc (Register 'c')
-                          , Jnz (Register 'd') (Literal (-2)) ]
-          m2 = m {b = b m - 1, c = (b m - 1) * 2, d = 0, pc = pc m + (length sample2)}
-
-
-executeInstruction :: Instruction -> Machine -> Machine
-executeInstruction (Inc r@(Register _)) m = m' {pc=pc1}
-    where pc1 = (pc m) + 1
-          v = evaluate m r
-          m' = writeValue m r (v+1)
-executeInstruction (Inc (Literal _)) m = m {pc=pc1}
-    where pc1 = (pc m) + 1
-executeInstruction (Dec r@(Register _)) m = m' {pc=pc1}
-    where pc1 = (pc m) + 1
-          v = evaluate m r
-          m' = writeValue m r (v-1)
-executeInstruction (Dec (Literal _)) m = m {pc=pc1}
-    where pc1 = (pc m) + 1
-executeInstruction (Cpy s d@(Register _)) m = m' {pc=pc1}
-    where pc1 = (pc m) + 1
-          v = evaluate m s
-          m' = writeValue m d v
-executeInstruction (Cpy s (Literal _)) m = m {pc=pc1}
-    where pc1 = (pc m) + 1
-executeInstruction (Jnz s d) m 
-    | v == 0 = m {pc=pc1}
-    | otherwise = m {pc=pcj}
-    where pc1 = (pc m) + 1
-          ed = evaluate m d
-          pcj = (pc m) + ed
-          v = evaluate m s
-executeInstruction (Tgl a) m 
-    | v < (length $ instructions m) = m {instructions = (replace (instructions m) i' v),
-                                       pc=pc1}
-    | otherwise = m {pc=pc1}
-    where pc1 = pc m + 1
-          v = evaluate m a + pc m
-          i = (instructions m)!!v
-          i' = case i of
-                  Inc x -> Dec x
-                  Dec x -> Inc x
-                  Tgl x -> Inc x
-                  Cpy x y -> Jnz x y
-                  Jnz x y -> Cpy x y
-          replace xs x i = take i xs ++ [x] ++ drop (i+1) xs
-
-
-evaluate :: Machine -> Location -> Int
-evaluate _ (Literal i) = i
-evaluate m (Register r) = 
-    case r of
-        'a' -> (a m)
-        'b' -> (b m)
-        'c' -> (c m)
-        'd' -> (d m)
-
-writeValue :: Machine -> Location -> Int -> Machine
-writeValue m (Literal i) _ = m
-writeValue m (Register r) v =
-    case r of 
-        'a' -> m {a=v}
-        'b' -> m {b=v}
-        'c' -> m {c=v}
-        'd' -> m {d=v}
-
-
-instructionFile = instructionLine `sepEndBy` newline 
-instructionLine = incL <|> decL <|> cpyL <|> jnzL <|> tglL
-
-incL = Inc <$> (string "inc" *> spaces *> register)
-decL = Dec <$> (string "dec" *> spaces *> register)
-cpyL = Cpy <$> (string "cpy" *> spaces *> location) <*> (spaces *> register)
-jnzL = Jnz <$> (string "jnz" *> spaces *> location) <*> (spaces *> location)
-tglL = Tgl <$> (string "tgl" *> spaces *> location)
-
-location = (Literal <$> int) <|> register
-register = Register <$> (oneOf "abcd")
-
-parseIfile :: String -> Either ParseError [Instruction]
-parseIfile input = parse instructionFile "(unknown)" input
-
-parseIline :: String -> Either ParseError Instruction
-parseIline input = parse instructionLine "(unknown)" input
-
-successfulParse :: Either ParseError [a] -> [a]
-successfulParse (Left _) = []
-successfulParse (Right a) = a
diff --git a/src/Lib.hs b/src/Lib.hs
deleted file mode 100644 (file)
index d36ff27..0000000
+++ /dev/null
@@ -1,6 +0,0 @@
-module Lib
-    ( someFunc
-    ) where
-
-someFunc :: IO ()
-someFunc = putStrLn "someFunc"
index b77fb38e9489eb6c907045800b15ef2bb09b8fa9..48e2e2e7544e29afa60afc1985e49e804c4c03e3 100644 (file)
@@ -1,7 +1,9 @@
 flags: {}
 extra-package-dbs: []
 packages:
 flags: {}
 extra-package-dbs: []
 packages:
-- '.'
+- adventofcode16
+- adventofcode1601
+- adventofcode1602
 system-ghc: true
 extra-deps:
 - astar-0.3.0.0
 system-ghc: true
 extra-deps:
 - astar-0.3.0.0
diff --git a/test/Spec.hs b/test/Spec.hs
deleted file mode 100644 (file)
index cd4753f..0000000
+++ /dev/null
@@ -1,2 +0,0 @@
-main :: IO ()
-main = putStrLn "Test suite not yet implemented"