Haskell implementation of a CHREST discrimination tree
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
-- This code was used in the paper: | |
-- P.C.R. Lane and F.Gobet, | |
-- 'Developing reproducible and comprehensible computational models,' | |
-- Artificial Intelligence, 144:251-263, 2003. | |
-- | |
-- Run it using the Glasgow Haskell Compiler, e.g.: ghci ai03.hs -e main | |
data PIECE = PIECE{xCoord, yCoord::Int, piece::Char} | |
deriving (Eq,Show) | |
data NODE = NODE{image::[PIECE], children::[LINK]} | |
deriving (Eq,Show) | |
data LINK = LINK{test::PIECE, node::NODE} | |
deriving (Eq,Show) | |
learn (NODE image links) example | |
| (null validLinks) && (image `matches` example) | |
= familiarise (NODE image links) example | |
| (null validLinks) && (not(image `matches` example)) | |
= discriminate (NODE image links) example | |
| otherwise = NODE image newLinks | |
where validLinks = [link | link <- links, (test link) `elem` example] | |
takenLink = head validLinks | |
otherLinks = [link | link <- links,link /= takenLink] | |
newLinks = (LINK (test takenLink) (learn (node takenLink) example)) | |
: otherLinks | |
xs `matches` ys = (take (length xs) ys) == xs | |
familiarise (NODE image links) example | |
| image /= example = NODE (image++[nextItem]) links | |
| otherwise = NODE image links | |
where nextItem = example!!(length image) | |
discriminate (NODE image links) example = NODE image (newLink:links) | |
where newTest = snd(head (dropWhile (\(x,y) -> x==y) (zip image example))) | |
newLink = LINK newTest (NODE[][]) | |
runTests = performTests [((tree1'==tree2),"Familiarise"), | |
((tree2'==tree3),"Discriminate")] | |
where tree1 = NODE [PIECE 7 8 'n'] | |
[LINK (PIECE 1 2 'P') | |
(NODE[PIECE 1 2 'P'] [])] | |
tree2 = NODE [PIECE 7 8 'n'] | |
[LINK (PIECE 1 2 'P') | |
(NODE [PIECE 1 2 'P',PIECE 1 1 'R'] [])] | |
tree3 = NODE [PIECE 7 8 'n'] | |
[LINK(PIECE 1 2 'P') | |
(NODE [PIECE 1 2 'P',PIECE 1 1 'R'] | |
[LINK(PIECE 1 1 'Q')(NODE [] [])])] | |
tree1' = learn tree1 [PIECE 1 2 'P', PIECE 1 1 'R'] | |
tree2' = learn tree2 [PIECE 1 2 'P', PIECE 1 1 'Q'] | |
performTests = putStr.concat.(map doTest) | |
where doTest(bool,str) | |
| bool = "." | |
| otherwise = "\n"++str++"\n" | |
main = do | |
putStrLn "Running Tests: " | |
runTests | |
putStrLn "" |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment