lockpick

lockpick.hs

{-

lockpick.hs
Copyright (C) 2020 Jonathan Lamothe <jonathan@jlamothe.net>

This work is licensed under the Creative Commons CC BY-SA 3.0 License.
To view a copy of the license, visit
<https://creativecommons.org/licenses/by-sa/3.0/>

-}

module Main where

main :: IO ()
main = let
  allCombos = [(a, b, c) | a <- digits, b <- digits, c <- digits]

  answers =
    [ x
    | x <- allCombos
    , check 6 8 2 x == (1, 1) -- one correct, right place
    , check 6 1 4 x == (1, 0) -- one correct, wrong place
    , check 2 0 6 x == (2, 0) -- two correct, wrong place
    , check 7 3 8 x == (0, 0) -- none correct
    , check 3 8 0 x == (1, 0) -- one correct, wrong place
    ]

  in putStrLn $ show answers

digits :: [Int]
digits = [0..9]

check
  :: Int
  -> Int
  -> Int
  -> (Int, Int, Int)
  -> (Int, Int)
check a b c x = (correctDigits a b c x, correctPlace a b c x)

correctDigits
  :: Int
  -> Int
  -> Int
  -> (Int, Int, Int)
  -> Int
correctDigits a b c (x, y, z) = let
  checkA = if any (a ==) [x, y, z]
    then 1
    else 0

  checkB = if any (b ==) [x, y, z]
    then 1
    else 0

  checkC = if any (c ==) [x, y, z]
    then 1
    else 0

  in checkA + checkB + checkC

correctPlace
  :: Int
  -> Int
  -> Int
  -> (Int, Int, Int)
  -> Int
correctPlace a b c (x, y, z) =
  foldr (\vals acc -> if uncurry (==) vals
    then succ acc
    else acc) 0 $ zip [a, b, c] [x, y, z]

So, this is super quick and dirty, but I wrote it in like 10 minutes.