2007-02-16 14:51:30 +03:00
|
|
|
module Utils (
|
|
|
|
module Utils,
|
|
|
|
module Data.List,
|
2007-03-10 06:16:19 +03:00
|
|
|
module Data.Tree,
|
2007-02-16 14:51:30 +03:00
|
|
|
module Text.Printf,
|
|
|
|
module Text.Regex,
|
2007-03-12 12:38:02 +03:00
|
|
|
module Debug.Trace,
|
|
|
|
module Test.QuickCheck,
|
|
|
|
module Test.HUnit
|
2007-02-16 14:51:30 +03:00
|
|
|
)
|
2007-02-16 12:00:17 +03:00
|
|
|
where
|
2007-02-16 14:51:30 +03:00
|
|
|
import Data.List
|
2007-03-10 06:16:19 +03:00
|
|
|
import Data.Tree
|
2007-02-16 14:51:30 +03:00
|
|
|
import Text.Printf
|
|
|
|
import Text.Regex
|
2007-03-12 12:38:02 +03:00
|
|
|
import Debug.Trace
|
|
|
|
import Test.QuickCheck hiding (test, Testable)
|
|
|
|
import Test.HUnit
|
2007-02-16 14:51:30 +03:00
|
|
|
|
2007-02-16 12:00:17 +03:00
|
|
|
|
|
|
|
splitAtElement :: Eq a => a -> [a] -> [[a]]
|
|
|
|
splitAtElement e l =
|
|
|
|
case dropWhile (e==) l of
|
|
|
|
[] -> []
|
|
|
|
l' -> first : splitAtElement e rest
|
|
|
|
where
|
|
|
|
(first,rest) = break (e==) l'
|
|
|
|
|
2007-03-11 00:24:57 +03:00
|
|
|
-- tree tools
|
|
|
|
|
2007-07-03 03:41:07 +04:00
|
|
|
-- aliases
|
2007-03-11 00:24:57 +03:00
|
|
|
root = rootLabel
|
|
|
|
branches = subForest
|
|
|
|
|
2007-03-11 02:05:30 +03:00
|
|
|
-- remove all nodes past a certain depth
|
|
|
|
treeprune :: Int -> Tree a -> Tree a
|
|
|
|
treeprune 0 t = Node (root t) []
|
2007-07-02 20:43:14 +04:00
|
|
|
treeprune d t = Node (root t) (map (treeprune $ d-1) $ branches t)
|
2007-03-11 02:05:30 +03:00
|
|
|
|
2007-03-11 00:24:57 +03:00
|
|
|
-- apply f to all tree nodes
|
|
|
|
treemap :: (a -> b) -> Tree a -> Tree b
|
|
|
|
treemap f t = Node (f $ root t) (map (treemap f) $ branches t)
|
|
|
|
|
|
|
|
-- remove all subtrees whose nodes do not fulfill predicate
|
|
|
|
treefilter :: (a -> Bool) -> Tree a -> Tree a
|
|
|
|
treefilter f t = Node
|
|
|
|
(root t)
|
|
|
|
(map (treefilter f) $ filter (treeany f) $ branches t)
|
|
|
|
|
|
|
|
-- is predicate true in any node of tree ?
|
|
|
|
treeany :: (a -> Bool) -> Tree a -> Bool
|
|
|
|
treeany f t = (f $ root t) || (any (treeany f) $ branches t)
|
|
|
|
|
|
|
|
-- treedrop -- remove the leaves which do fulfill predicate.
|
|
|
|
-- treedropall -- do this repeatedly.
|
|
|
|
|
2007-07-02 20:43:14 +04:00
|
|
|
-- debugging
|
|
|
|
|
|
|
|
strace a = trace (show a) a
|
|
|
|
|
|
|
|
-- testing
|
|
|
|
|