module Data.GiST.GiST
(
GiST
,Entry(..)
,Predicates(..)
,LeafEntry,NodeEntry,Penalty
,entryPredicate
,search, insert, delete, empty, save, load, getData, size
) where
import Data.GiST.Types
import qualified Data.Text.IO as TIO
import qualified Data.Text as T
search :: Predicates p a => p a -> GiST p a -> [a]
search p (Leaf es) = [fst e | e <- es, consistent p (LeafEntry e)]
search _ (Node []) = []
search p (Node (e:es))
|consistent p (NodeEntry e) = (search p (fst e)) ++ (search p (Node es))
|otherwise = search p (Node es)
insert :: Predicates p a => LeafEntry p a -> (Int, Int) -> GiST p a -> GiST p a
insert (toIns, pred) (min,max) (Node es)
|search pred (Node es) /= [] = Node es
|length newEs <= max = Node newEs
|otherwise = Node [(Node $ map unNodeEntry es1, union $ map entryPredicate es1)
,(Node $ map unNodeEntry es2, union $ map entryPredicate es2)]
where newEs = case insertSubtree of
Right newSub -> [if (e == minSubtree)
then newSub
else e
|e <- es]
Left split -> (filter (/=minSubtree) es)++[fst split,snd split]
minSubtree = chooseSubtree es (toIns,pred)
insertSubtree = insertAndSplit minSubtree (min,max) (toIns,pred)
(es1,es2) = pickSplit $ map NodeEntry newEs
insert (toIns, p) (min,max) (Leaf es)
|search p (Leaf es) /= [] = Leaf es
|length newEs <= max = Leaf newEs
|otherwise = Node [(Leaf $ map unLeafEntry es1,union $ map entryPredicate es1)
,(Leaf $ map unLeafEntry es2, union $ map entryPredicate es2)]
where newEs = (toIns, p):es
(es1,es2) = pickSplit $ map LeafEntry newEs
delete :: Predicates p a => LeafEntry p a -> (Int, Int) -> GiST p a -> GiST p a
delete (toDel, p) (min,max) (Node es)
|length newEs == 1 = insertMultiple toAdd (makeRoot $ head newEs) (min,max)
|otherwise = insertMultiple toAdd (Node newEs) (min, max)
where newEs = filter (not.isNull) (map fst delNodes)
toAdd = concat (map snd delNodes)
delNodes = [if (consistent p (NodeEntry e))
then (deleteAndCondense e (min,max) (toDel,p))
else (e,[])
|e <- es]
delete (toDel, p) (min,max) (Leaf es) = Leaf [e | e <- es, not $ consistent p (LeafEntry e)]
empty :: GiST p a
empty = Leaf []
load :: (Read a, Read (p a)) => FilePath -> IO (GiST p a)
load f = do s <- TIO.readFile f
return (read $ T.unpack s)
save :: (Show a, Show (p a)) => GiST p a -> FilePath -> IO ()
save gist f = TIO.writeFile f $ T.pack (show gist)
insertAndSplit :: (Predicates p a) => NodeEntry p a -> (Int,Int) -> LeafEntry p a -> Either (NodeEntry p a, NodeEntry p a) (NodeEntry p a)
insertAndSplit (Node es,p) (min,max) (toIns,pred)
|length newEs <= max = Right (Node newEs,union $ map snd newEs)
|otherwise = Left ((Node (map unNodeEntry es1), union $ map entryPredicate es1)
,(Node (map unNodeEntry es2), union $ map entryPredicate es2))
where newEs = case insertSubtree of
Right newSub -> [if (e == minSubtree)
then newSub
else e
|e <- es]
Left split -> (filter (/=minSubtree) es)++[fst split,snd split]
minSubtree = chooseSubtree es (toIns,pred)
insertSubtree = insertAndSplit minSubtree (min,max) (toIns,pred)
(es1,es2) = pickSplit $ map NodeEntry newEs
insertAndSplit (Leaf es,p) (min,max) (toIns,pred)
|length newEs <= max = Right (Leaf newEs,union $ map snd newEs)
|otherwise = Left ((Leaf (map unLeafEntry es1), union $ map entryPredicate es1)
,(Leaf (map unLeafEntry es2), union $ map entryPredicate es2))
where newEs = ((toIns,pred) : es)
(es1,es2) = pickSplit $ map LeafEntry newEs
deleteAndCondense :: (Predicates p a) => NodeEntry p a -> (Int,Int) -> LeafEntry p a -> (NodeEntry p a, [LeafEntry p a])
deleteAndCondense (Node es, pred) (min, max) (toDel, p)
|length newEs < min = ((Null, pred), toAdd ++ getEntries (Node es))
|otherwise = ((Node newEs, union $ map snd newEs), toAdd)
where newEs = filter (not.isNull) (map fst delNodes)
toAdd = concat (map snd delNodes)
delNodes = [if (consistent p (NodeEntry e))
then (deleteAndCondense e (min,max) (toDel,p))
else (e,[])
|e <- es]
deleteAndCondense ((Leaf es),pred) (min, max) (toDel, p)
|length newEs < min = ((Null,pred), newEs)
|otherwise = ((Leaf newEs, union $ map snd newEs),[])
where newEs = [e | e <- es, not $ consistent p (LeafEntry e)]
insertMultiple :: (Predicates p a) => [LeafEntry p a] -> GiST p a -> (Int,Int) -> GiST p a
insertMultiple [] gist _ = gist
insertMultiple (e:es) gist (min,max) = insertMultiple es afterInsert (min,max)
where afterInsert = insert e (min,max) gist
chooseSubtree :: (Predicates p a )=>[(NodeEntry p a)] -> LeafEntry p a -> (NodeEntry p a)
chooseSubtree subtrees e = minPenalty penalties (head penalties)
where penalties = [(ne, penalty (snd e) (snd ne))|ne <- subtrees]
minPenalty :: [(NodeEntry p a, Penalty)]->(NodeEntry p a, Penalty) -> NodeEntry p a
minPenalty [] p = fst p
minPenalty ((ne, pen):ps) (nemin, minpen)
|pen < minpen = minPenalty ps (ne, pen)
|otherwise = minPenalty ps (nemin, minpen)
makeRoot :: NodeEntry p a -> GiST p a
makeRoot (Node es, p) = Node es
makeRoot (Leaf es, p) = Leaf es
isNull :: NodeEntry p a -> Bool
isNull (Null, p) = True
isNull _ = False
getEntries :: GiST p a -> [LeafEntry p a]
getEntries (Node es) = concat [getEntries sub | (sub,_) <- es]
getEntries (Leaf es) = es
getData :: GiST p a -> [a]
getData gist = map fst $ getEntries gist
size :: GiST p a -> Int
size gist = length $ getEntries gist