CIS 194 HW2

CIS 194 HW2 (haskell)

-- CIS 194: Homework 2 (http://www.cis.upenn.edu/~cis194/hw/02-lists.pdf)

{-# OPTIONS_GHC -Wall #-}

module HW02 where
    
-- Supporting code

data Peg = Red | Green | Blue | Yellow | Orange | Purple
         deriving (Show, Eq, Ord)


type Code = [Peg]

data Move = Move Code Int Int
          deriving (Show, Eq)

colors :: [Peg]
colors = [Red, Green, Blue, Yellow, Orange, Purple]

-- Exercise 1

count :: (a -> Bool) -> [a] -> Int
count p xs = length $ filter p xs

exactMatches :: Code -> Code -> Int
exactMatches c c' = (count eq) $ zip c c'
    where eq = uncurry (==)

-- Exercise 2

countColors :: Code -> [Int]
countColors code = [ count (c ==) code | c <- colors ]

matches :: Code -> Code -> Int
matches c c' = sum $ map (uncurry min) $ zip (countColors c) (countColors c')

-- Exercise 3

getMove :: Code -> Code -> Move
getMove c c' = Move c' m (n - m)
    where m = exactMatches c c'
          n = matches c c'

-- Exercise 4

isConsistent :: Move -> Code -> Bool
isConsistent (Move xs m n) ys = m == m' && n == n'
    where Move _ m' n' = getMove xs ys

-- Exercise 5

filterCodes :: Move -> [Code] -> [Code]
filterCodes m c = filter (isConsistent m) c

-- Exercise 6

allCodes :: Int -> [Code]
allCodes 0 = [[]]
allCodes n = [ c : code | c <- colors, code <- allCodes (n - 1) ]

-- Exercise 7

solve :: Code -> [Move]
solve c = choose c $ allCodes 6

choose :: Code -> [Code] -> [Move]
choose _ [] = []
choose c (x:xs) =
    if x == c then [m] else m : (choose c $ filterCodes m xs)
    where m = getMove c x