1 module Auxil where 2 3 import Key 4 5 data Key = K String Char Char Int {- String, end letters, length of string -} 6 data HashSet = H (Maybe Int) (Maybe Int) [Int] 7 type HashFun = [(Char,Int)] {- Association list of Character to values -} 8 --1.3:data Maybe a = Nothing | Just a deriving Text 9 10 ends :: Key -> String 11 ends (K _ a z _) = [a,z] 12 13 morefreq :: Key -> Key -> Bool 14 morefreq (K _ a x _) (K _ b y _) = freq a + freq x > freq b + freq y 15 16 freq :: Char -> Int 17 freq c = assoc c freqtab 18 19 assoc :: (Eq a) => a -> [(a,b)] -> b 20 assoc x ((y,z):yzs) = if x == y then z else assoc x yzs 21 22 assocm :: (Eq a) => a -> [(a,b)] -> Maybe b 23 assocm x [] = Nothing 24 assocm x ((y,z):yzs) = if x == y then Just z else assocm x yzs 25 26 freqtab :: [(Char, Int)] 27 freqtab = histo (concat (map ends attribkeys)) 28 29 histo :: (Eq a) => [a] -> [(a,Int)] 30 histo = foldr histins [] 31 where 32 histins x [] = [(x,1)] 33 histins x (yn@(y,n):yns) = if x==y then (y,n+1):yns 34 else yn:histins x yns 35 36 maxval :: Int 37 maxval = length (freqtab) 38 39 subset :: (Eq a) => [a] -> [a] -> Bool 40 subset xs ys = all (\x -> member x ys) xs 41 42 --partain: in the prelude 43 --all :: (a->Bool) -> [a] -> Bool 44 --all p = foldr (\x -> \b ->(p x && b)) True 45 46 union :: (Eq a) => [a] -> [a] -> [a] 47 union xs ys = xs ++ [y | y <- ys, not (member y xs)] 48 49 attribkeys :: [Key] 50 attribkeys = map (\k->(K k (head k) (last k) (length k))) keys 51 52 hinsert :: Int -> HashSet -> Maybe HashSet 53 hinsert h (H lo hi hs) = 54 if member h hs || 1 + hi'- lo' > numberofkeys then Nothing 55 else Just (H (Just lo') (Just hi') (h:hs)) 56 where 57 lo' = minm lo h 58 hi' = maxm hi h 59 60 minm, maxm :: Maybe Int -> Int -> Int 61 minm Nothing y = y 62 minm (Just x) y = min x y 63 maxm Nothing y = y 64 maxm (Just x) y = max x y 65 66 member :: (Eq a) => a -> [a] -> Bool 67 member _ [] = False 68 member x (y:ys) = x == y || member x ys 69 70 hash :: HashFun -> Key -> Int 71 hash cvs (K _ a z n) = n + assoc a cvs + assoc z cvs 72 73 numberofkeys :: Int 74 numberofkeys = length keys 75 76 77 partition' :: (a->Bool) -> [a] -> ([a],[a]) 78 partition' p = foldr select ([],[]) 79 where select x (ts,fs) | p x = (x:ts,fs) 80 | otherwise = (ts,x:fs) 81 82 freqsorted :: [Key] -> [Key] 83 freqsorted = 84 \x->x 85 {-foldr freqins [] 86 where 87 freqins x [] = [x] 88 freqins x (y:ys) = if morefreq x y then x:y:ys else y:freqins x ys-} 89 90 blocked :: [Key] -> [Key] 91 blocked = blocked' [] 92 blocked' ds [] = [] 93 blocked' ds (k : ks) = k : det ++ blocked' ds' rest 94 where 95 (det,rest) = partition' (\x->subset (ends x) ds') ks 96 ds' = union ds (ends k) 97