module Holumbus.Data.PrefixTree.PrefixSet
where
import Data.List ( sort, nub )
import Holumbus.Data.PrefixTree.Types
data PrefixSet = PSempty
| PSelem PrefixSet
| PSnext Sym PrefixSet PrefixSet
deriving (Show)
emptyPS :: PrefixSet
emptyPS = PSempty
elemPS :: PrefixSet -> PrefixSet
elemPS s@(PSelem _) = s
elemPS s = PSelem s
elem0PS :: PrefixSet
elem0PS = elemPS emptyPS
nextPS :: Sym -> PrefixSet -> PrefixSet -> PrefixSet
nextPS _ PSempty n = n
nextPS s c n = PSnext s c n
lastPS :: Sym -> PrefixSet -> PrefixSet
lastPS s c = nextPS s c emptyPS
nullPS :: PrefixSet -> Bool
nullPS PSempty = True
nullPS _ = False
singlePS :: Key -> PrefixSet
singlePS = foldr (\ c r -> lastPS c r) elem0PS
prefixPS :: Key -> PrefixSet
prefixPS = foldr (\ c r -> elemPS (lastPS c r)) elem0PS
unionPS :: PrefixSet -> PrefixSet -> PrefixSet
unionPS PSempty ps2 = ps2
unionPS ps1 PSempty = ps1
unionPS (PSelem ps1) (PSelem ps2) = PSelem (unionPS ps1 ps2)
unionPS (PSelem ps1) ps2 = PSelem (unionPS ps1 ps2)
unionPS ps1 (PSelem ps2) = PSelem (unionPS ps1 ps2)
unionPS ps1@(PSnext c1 s1 n1)
ps2@(PSnext c2 s2 n2)
| c1 < c2 = nextPS c1 s1 (unionPS n1 ps2)
| c1 > c2 = nextPS c2 s2 (unionPS ps1 n2)
| otherwise = nextPS c1 (unionPS s1 s2) (unionPS n1 n2)
foldPS :: (Key -> b -> b) -> b -> (Key -> Key) -> PrefixSet -> b
foldPS _ r _ PSempty = r
foldPS f r kf (PSelem ps1) = let r' = foldPS f r kf ps1
in
f (kf []) r'
foldPS f r kf (PSnext c1 s1 n1) = let r' = foldPS f r kf n1
in
foldPS f r' (kf . (c1:)) s1
foldWithKeyPS :: (Key -> b -> b) -> b -> PrefixSet -> b
foldWithKeyPS f e = foldPS f e id
elemsPS :: PrefixSet -> [Key]
elemsPS = foldWithKeyPS (:) []
fuzzyCharPS :: (Sym -> [Sym]) -> PrefixSet -> PrefixSet
fuzzyCharPS _ PSempty = PSempty
fuzzyCharPS f (PSelem ps) = PSelem $ fuzzyCharPS f ps
fuzzyCharPS f (PSnext c s n) = unionPS ps1 (fuzzyCharPS f n)
where
s' = fuzzyCharPS f s
cs = sort . nub . f $ c
ps1 = foldr (\ c' r' -> nextPS c' s' r') emptyPS $ cs
fuzzyCharsPS :: (Sym -> [Key]) -> PrefixSet -> PrefixSet
fuzzyCharsPS _ PSempty = PSempty
fuzzyCharsPS f (PSelem ps) = PSelem $ fuzzyCharsPS f ps
fuzzyCharsPS f (PSnext c s n) = unionPS ps1 (fuzzyCharsPS f n)
where
s' = fuzzyCharsPS f s
cs = sort . nub . f $ c
ps1 = foldr (\ w' r' -> nextPSw w' s' r') emptyPS $ cs
nextPSw [] _ r' = r'
nextPSw (x:xs) s'' r' = nextPS x (foldr lastPS s'' xs) r'