trying to tie the knot
Hi All, I thought I was starting to get my head around the whole tying the knot phenomenon, but when my program produced "*** Exception: <<loop>>" I figured I was probably missing something :). Here's what I'm trying to do (I know I could do it without tying the knot, but that seemed like a reasonable approach and I wanted to get my hands dirty or feat wet): I'm reading in a file; that is I have a function String -> MyDataType. More specifically I'm reading in a Tree, and the tree is specified in the file with these "Subtree" fields. So you can be reading along in the tree and then instead of actually seeing a branch or leaf, you'll see somethign like "[S1]" which means "stick subtree S1 in here". later in the file (arbitrarily later), you will see something like "Subtree [S1]" and then following that is that tree. So what I did was I changed my function to a String -> [(String,Tree)] -> (Tree, [(String,Tree)] function where the list is a lookup for the subtrees. I then said: readTrees s = let (t, st) = readTrees' s st in t and then the readTrees' basically read the tree in as normal; except when it gets to something like "[S1]" it does lookup "[S1]" subTrees to get the subtree and then when it gets to "Subtree [S1]" it reads in the subtree and then adds it to the subtree list. Is this not an appropriate use of tying the knot or amd I just doing something wrong? I've attached my code if you want to read it; It's marginally more complex that I've written here jsut because of some of the idiosyncracies in the file format... - Hal -- Hal Daume III "Computer science is no more about computers | hdaume@isi.edu than astronomy is about telescopes." -Dijkstra | www.isi.edu/~hdaume
Hello! Hal Daume III wrote: [description of a parsing problem that involves forward references] Forward references is the problem. To properly solve it, you have to find a fixpoint. The best way to avoid hitting the bottom is to make sure that the fixpoint combinator is applied to a function. Hence the solution: type TreeDictLate = [(String,DecisionTreeLate)] -- lookup for subtrees newtype DecisionTreeLate = DTL (TreeDictLate -> DecisionTree) ft (DTL late_tree) st = late_tree st readDecisionTree :: String -> DecisionTree readDecisionTree s = let (_, wholeTreeLate, subTrees) = readDecisionTree' False [] (filter (/=[]) (lines s)) in ft wholeTreeLate subTrees The function readDecisionTree' will return a delayed decision tree: a function that _will_ yield the decision tree when it is applied to the forest dictionary. The forest dictionary is itself an assoc list of tree labels and _late_ decision trees. Now the test "readDecisionTree $ unlines simpleDT3" passes as well, and gives the reasonable result: simpleDT3 = [ "isArgument0 = t: u (33.0/1.4)", "isArgument0 = f:", "| isArgument1 = f :[S1]", "| isArgument1 = t:", "| | isRecursive1 = t: s (945.0/39.8)", "| | isRecursive1 = f: u (2.0/1.0)", "", "Subtree [S1]", "", "localDefCount <= 15 : u (281.0/1.4)", "localDefCount > 15 : s (139.0/11.8)"] DecisionTree> readDecisionTree $ unlines simpleDT3 Test "isArgument0" "=" "t" (Value "u" 33.0 1.4) (Test "isArgument0" "=" "f" (Test "isArgument1" "=" "f" (Test "localDefCount" "<=" "15" (Value "u" 281.0 1.4) (Value "s" 139.0 11.8)) (Test "isArgument1" "=" "t" (Test "isRecursive1" "=" "t" (Value "s" 945.0 39.8) (Value "u" 2.0 1.0)) (Value "" 0.0 0.0))) (Value "" 0.0 0.0)) which seems reasonable. And even the following passes: simpleDT4 = [ "isArgument0 = t: u (33.0/1.4)", "isArgument0 = f:", "| isArgument1 = f :[S1]", "| isArgument1 = t :[S2]", "", "Subtree [S1]", "", "localDefCount <= 15 : [S2]", "localDefCount > 15 : s (139.0/11.8)", "", "Subtree [S2]", "", "ll <= 15 : u (2.0/1.4)", "ll > 15 : s (1.0/11.8)"] readDecisionTree $ unlines simpleDT4 [skipped] The code enclosed. BTW, it seemed the original code had a few bugs. module DecisionTree where import IO import List data DecisionTree = Test String String String DecisionTree DecisionTree | Value String Double Double deriving (Show, Eq, Ord, Read) type TreeDictLate = [(String,DecisionTreeLate)] -- lookup for subtrees newtype DecisionTreeLate = DTL (TreeDictLate -> DecisionTree) ft (DTL late_tree) st = late_tree st readDecisionTree :: String -> DecisionTree readDecisionTree s = let (_, wholeTreeLate, subTrees) = readDecisionTree' False [] (filter (/=[]) (lines s)) in ft wholeTreeLate subTrees readDecisionTree' :: Bool -> TreeDictLate -> [String] -> ([String], DecisionTreeLate, TreeDictLate) readDecisionTree' _ subTrees [] = ([], DTL $ \st -> Value "" 0 0, subTrees) readDecisionTree' areValue subTrees (x:xs) = let (lineDepth, lineType, values') = readLine x (subTreesX,xs1) = if xs /= [] && "Subtree" `isPrefixOf` head xs then readSubTrees subTrees xs else (subTrees,xs) (xs', lhs, subTrees') = readDecisionTree' False subTreesX xs1 (xs'' , rhs, subTrees'') = readDecisionTree' False subTrees' xs' (xs''', other, subTrees''') = readDecisionTree' True subTreesX xs1 values = values' ++ ["0.0"] in if lineType -- are we a value then if areValue then (xs1, DTL $ \st->Value (values !! 3) (read (values !! 4)) (read (values !! 5)), subTreesX) else (xs''', DTL $ \st->Test (values !! 0) (values !! 1) (values !! 2) (Value (values !! 3) (read (values !! 4)) (read (values !! 5))) (ft other st), subTrees''') else if '[' == head (last values') -- are we a subtree? then (xs'', DTL $ \st-> let (Just dt) = lookup (last values') st in Test (values !! 0) (values !! 1) (values !!2) (ft dt st) (ft lhs st), subTrees') else (xs'', DTL $ \st->Test (values !! 0) (values !! 1) (values !! 2) (ft lhs st) (ft rhs st), subTrees'') readSubTrees subTrees [] = (subTrees,[]) readSubTrees subTrees (x:xs) | "Subtree" `isPrefixOf` x = let name = (words x) !! 1 treeDef = takeWhile (\x -> not ("Subtree" `isPrefixOf` x)) xs rest = dropWhile (\x -> not ("Subtree" `isPrefixOf` x)) xs (_, thisDT, _) = readDecisionTree' False subTrees treeDef in readSubTrees ((name,thisDT):subTrees) rest | otherwise = (subTrees,(x:xs)) readLine :: String -> (Int,Bool,[String]) -- True = Value, False = Test readLine s = (length (elemIndices '|' s), ')' `elem` s, vals) where vals = words $ map (\x -> if x `elem` ":()/" then ' ' else x) $ dropWhile (`elem` "| ") s simpleDT = ["localDefCountSum <= 4 : p (101.0/6.0)", "localDefCountSum > 4 : u (7.0)"] simpleDT2 = [ "isArgument0 = t: u (33.0/1.4)", "isArgument0 = f:", "| isArgument1 = f: u (9.0/1.3)", "| isArgument1 = t:", "| | isRecursive1 = t: s (945.0/39.8)", "| | isRecursive1 = f: u (2.0/1.0)"] {- Test "isArgument0" "=" "t" (Value "u" 33.0 1.4) (Test "isArgument0" "=" "f" (Test "isArgument1" "=" "f" (Value "u" 9.0 1.3) (Test "isArgument1" "=" "t" (Test "isRecursive1" "=" "t" (Value "s" 945.0 39.8) (Value "u" 2.0 1.0)) (Value "" 0.0 0.0))) (Value "" 0.0 0.0)) -} simpleDT3 = [ "isArgument0 = t: u (33.0/1.4)", "isArgument0 = f:", "| isArgument1 = f :[S1]", "| isArgument1 = t:", "| | isRecursive1 = t: s (945.0/39.8)", "| | isRecursive1 = f: u (2.0/1.0)", "", "Subtree [S1]", "", "localDefCount <= 15 : u (281.0/1.4)", "localDefCount > 15 : s (139.0/11.8)"] simpleDT4 = [ "isArgument0 = t: u (33.0/1.4)", "isArgument0 = f:", "| isArgument1 = f :[S1]", "| isArgument1 = t :[S2]", "", "Subtree [S1]", "", "localDefCount <= 15 : [S2]", "localDefCount > 15 : s (139.0/11.8)", "", "Subtree [S2]", "", "ll <= 15 : u (2.0/1.4)", "ll > 15 : s (1.0/11.8)"] --readDecisionTree $ unlines simpleDT
participants (2)
-
Hal Daume III -
oleg＠pobox.com