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