Created
June 2, 2019 03:05
-
-
Save micromaomao/1c28f8840d79cb5316334aaf7090ac41 to your computer and use it in GitHub Desktop.
My Haskell "Hello World" Practice.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
import Data.List | |
toListNums :: Int -> [Int] | |
chrToInt :: Char -> Int | |
chrToInt chr = read ([chr]) | |
toListNums num = if length rs == 4 then rs else 0:rs where rs = map chrToInt (show num) | |
ifDistinct :: (Eq a) => [a] -> Bool | |
ifDistinct [] = True | |
ifDistinct (x:px) = x `notElem` px && ifDistinct px | |
noRepeatingDegit :: Int -> Bool | |
noRepeatingDegit n = if n < 100 then False else ifDistinct lst where lst = toListNums n | |
countMatch :: (Eq a) => [a] -> [a] -> Int | |
countMatch [] b = 0 | |
countMatch a [] = 0 | |
countMatch (a0:a) (b0:b) = if a0 == b0 then 1 + rest else rest where rest = countMatch a b | |
getAB :: Int -> Int -> (Int, Int) | |
getAB expectNum check = if noRepeatingDegit expectNum && noRepeatingDegit check | |
then (getA, getCommon - getA) | |
else error "both expectNum and check must not contain repeating digits." | |
where getA = countMatch (toListNums expectNum) (toListNums check) | |
getCommon = length (filter (`elem` (toListNums expectNum)) (toListNums check)) | |
abFilter :: Int -> (Int, Int) -> Int -> Bool | |
abFilter expectNum (a, b) check = a == expectA && b == expectB | |
where (expectA, expectB) = getAB expectNum check | |
initialList = filter noRepeatingDegit [0..9999] | |
askConstraint :: Int -> IO (Int, Int, Int) | |
askConstraint query = do | |
putStrLn ("I ask you: " ++ (intercalate "" (map show (toListNums query)))) | |
putStrLn " Type your response in the format _a_b" | |
line <- getLine | |
if length line /= 4 then error "Invalid input." else do {return 0} | |
let [sa, _, sb, _] = line | |
let a = read [sa] | |
let b = read [sb] | |
return (query, a, b) | |
game :: [Int] -> [(Int, Int, Int)] -> IO [Int] | |
game remaining constraints = do | |
np <- (askConstraint chooseRandom) | |
let nCons = np : constraints | |
let matchAllConstraints = \guess -> all (\(num, a, b) -> abFilter guess (a, b) num) nCons | |
let flt = (filter matchAllConstraints remaining) | |
putStrLn ("Progress: " ++ (show (length flt))) | |
ret <- if length flt > 1 then game flt nCons else do {return flt} | |
return ret | |
where remExceptCons = filter (\n -> all (\(query, _, _) -> query /= n) constraints) remaining | |
chooseRandom = if length remExceptCons > 0 then head remExceptCons else error "Nothing left to choose from." | |
main = do | |
gResult <- game initialList [] | |
if length gResult /= 0 then putStrLn (show gResult) else putStrLn "Failed." |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment