[rating of a hypo is a separate record field
martin.hofmann@uni-bamberg.de**20091126143130] hunk ./src/Data/HypoSpace.hs 47
-initHSpace = (pushHypo emptyHSpace) . hypo . (:[])    
+initHSpace r = hypo [r] >>= (pushHypo emptyHSpace)    
hunk ./src/Data/HypoSpace_heap.hs 1
-{-# OPTIONS_GHC -fglasgow-exts #-}
-module Data.HypoSpace (
-
-    HSpace, initHSpace, emptyHSpace, 
-    bestHypos, propagateHSp, countHypos,
-    
-    module Data.Hypotheses
-    
-   
-
-) where
-
-import qualified Data.GHeap as H
-import Rating.Rateable
-import Data.Hypotheses
-import Data.IOData
-
-import Logging
-
-import Control.Arrow ( (***), first, second )
-import Data.Maybe (mapMaybe)
-
-data HSpace = HS { cntr :: Int
-                 , heap :: H.Heap RatingData Hypo}
-                 
-
- -- | /O(1)/, create an empty Search Space
-emptyHSpace :: HSpace
-emptyHSpace = HS 
-    { cntr   = 0
-    , heap   = H.empty
-    }
-    
-countHypos :: HSpace -> Int  
-countHypos = cntr      
- 
--- | /O(1)/, initialise a search space with a 'CovrRule' as inital hypothese
-initHSpace :: CovrRule ->  HSpace  
-initHSpace = (pushHypo emptyHSpace) . hypo . (:[])    
-
--- | find the best valued Hypotheses
-bestHypo :: HSpace -> Hypo
-bestHypo = snd . H.getMin . heap
-
--- | find the best valued Hypothesis
-bestHypos :: HSpace -> Hypos
-bestHypos = hypos . (:[]) . bestHypo       
-
-
--- Propagate a Rule modification over the whole search space
-propagateHSp :: CovrRule -> [(CovrRules,[Call])] -> HSpace -> HSpace
-propagateHSp cr sucs hsp = 
-    (uncurry  pushHypos) . swap . (first $ develHs cr sucs) $ popHypo hsp 
-    where
-    swap (a,b) = (b,a)
-    -- develHs =   \c sucs h -> mapMaybe (\s -> developH c s h) sucs
-    develHs = flip . (mapMaybe .) . flip . developH
---------------------------------------------------------------------------------
--- Hidden helpers
---------------------------------------------------------------------------------
-
-
-pushHypo :: HSpace -> Hypo -> HSpace
-pushHypo = (incCntr . ) . pushUnsafe
-
-pushHypos :: HSpace -> [Hypo] -> HSpace
-pushHypos h = foldl pushHypo h
-
-popHypo :: HSpace -> (Hypo,HSpace)
-popHypo = (second decCntr) . popUnsafe
-
-
---------------------------------------------------------------------------------
--- Unsafe helpers
---------------------------------------------------------------------------------
-
-incCntr :: HSpace -> HSpace
-incCntr (HS c hp) = HS (c+1) hp
-
-decCntr :: HSpace -> HSpace
-decCntr (HS c hp) = HS (c-1) hp
-
-pushUnsafe :: HSpace -> Hypo -> HSpace
-pushUnsafe (HS c hp) h = HS c (H.insert (rate h) h hp)      
-
-popUnsafe :: HSpace -> (Hypo,HSpace)
-popUnsafe (HS c hp) = ( snd *** (HS c) ) . H.getDelMin $ hp
-
-  
---{- -----------------------------------------------------------------------------
--- | Show instances and pretty printing stuff
-------------------------------------------------------------------------------- -}
-  
-
-instance Show HSpace where
-        show = show.pretty            
-instance Pretty HSpace where
-        pretty hsp = text "HSPACE" <$> 
-                     parens ( indent 2 $ 
-                        text "Total Hypos:"     <+> (int.countHypos $ hsp) <$>
-                        text "Rating -> Hypo:" <^> indent 2 (vcat . (map asMap) .  H.toList . heap $ hsp)
---                        text "Rating -> HypoID:" <^> pretty (rateIdsMap hsp) <$> 
---                        text "Rule   -> HypoID:" <^> pretty (ruleIdsMap hsp) <$> 
---                        text "ID     -> Hypo:  " <$> pretty (hypoIdBimap hsp)
-                     )        
- 
+
rmfile ./src/Data/HypoSpace_heap.hs
hunk ./src/Data/HypoSpace_propagate.hs 1
-{-# OPTIONS_GHC -fglasgow-exts #-}
-module Data.HypoSpace (
-
-    HSpace, initHSpace, emptyHSpace, 
-    bestHypos, propagateHSp, countHypos,
-    
-    module Data.Hypotheses
-    
-   
-
-) where
-
-import Data.Hypotheses
-import Data.IOData
-
-import Data.Util 
-
-import Rating.Rateable
-
-import Text.Show
-
-import Control.Arrow ( (***) )
-import Data.List (foldl') 
-
-import qualified Data.Set as S
-
-import qualified Data.IntMap as I
-import qualified Data.Map as M
-import qualified Data.IntSet as IS
-
-import Data.Maybe (mapMaybe, catMaybes)
-import Data.Either (partitionEithers)
-
-import Data.Bimap (Bimap)
-import qualified Data.Bimap as B
-
-import Logging
-import Debug.Trace 
-{- 
- |-----------------------------------------------------------------------------
- | Datatype Definitions
- |----------------------------------------------------------------------------- 
--}
-
-
-
-type ID = Int
-type IDs = IS.IntSet
-    
--- | Hypotheses Space
-{- Hypospace is a Priority Queue, where each element is a Set of Hypotheses with
- | equal RatingData. Thus a each element isan  equivalence classes over 
- | hypotheses which are prioritized over the RatingData in ascending order.
--} 
-data  HSpace = HSpace
-    { hypoCounter  :: ID
-    , rateIdsMap   :: (M.Map RatingData IDs) --(I.IntMap IDs)  
-    , ruleIdsMap   :: (M.Map CovrRule IDs)
-    , hypoIdBimap  :: (Bimap Hypo ID)
-    }
-
-    
--- | /O(1)/, create an empty Search Space
-emptyHSpace :: HSpace
-emptyHSpace = HSpace 
-    { hypoCounter   = 0
-    , rateIdsMap  = M.empty -- I.empty
-    , ruleIdsMap  = M.empty
-    , hypoIdBimap = B.empty
-    }
- 
--- | /O(1)/, initialise a search space with a 'CovrRule' as inital hypothese
-initHSpace :: CovrRule ->  HSpace
-initHSpace rf = insert initHypo emptyHSpace
-    where
-    initHypo = hypo [rf]
-
-countHypos :: HSpace -> ID
-countHypos = B.size.hypoIdBimap
-
--- | /O(m log n)/ where m is the number of affected hypotheses and n the number 
---   of total rules
--- Propagate a Rule modification over the whole search space
-propagateHSp :: CovrRule -> [(CovrRules,[Call])] -> HSpace -> HSpace
-propagateHSp ro advs hsp = 
-        foldl' replaceByDeveloped hsp affectedHs
-    where
-    replaceByDeveloped = (\sp h -> replace h (develop h) sp)
-    develop h = catMaybes [ developH ro adv h | adv <- advs]
---                let (l,r) = partitionEithers [ developH ro adv h | adv <- advs]
---                in trace ("XXX\n" ++ (unlines l)) $ r
-    affectedHs =
-            case M.lookup ro (ruleIdsMap hsp) of
-                    Just ids -> mapMaybe (flip getById hsp) (IS.toList ids)
-                    Nothing -> []
-
--- | /O(log n)/ find the best valued Hypotheses
-bestHypos :: HSpace -> Hypos
-bestHypos  =  hypos.((IS.toList . snd . M.findMin . rateIdsMap) >>= getByIds)
-            --hypos.((IS.toList .  I.findMin . rateIdsMap) >>= getByIds)
-
-
---------------------------------------------------------------------------------
--- Internal functions
---------------------------------------------------------------------------------
-incrementHypoCount :: HSpace -> HSpace
-incrementHypoCount hsp =
-    let c = hypoCounter hsp
-    in hsp{hypoCounter = c+1}
-
-getById :: (Monad m) => ID -> HSpace -> m Hypo
-getById i = (B.lookupR i) . hypoIdBimap
---        let h = hsp `seq` B.lookupR i (hypoIdBimap hsp)
---        in h `seq` h
-
-getByIds is hsp = mapMaybe(flip getById hsp) is
-
-getByHypo :: (Monad m) => Hypo -> HSpace -> m ID
-getByHypo h = (B.lookup h) . hypoIdBimap
---        let i = hsp `seq` B.lookup h (hypoIdBimap hsp)
---        in i `seq` i
-
--- FIXME: necessary?
---getByRule :: CovrRule -> HSpace -> [Hypo]   
---getByRule r hsp = 
---    let ids = case M.lookup r (ruleIdsMap hsp) of
---                Just i -> i
---                Nothing -> []
---    in mapMaybe ((flip getById) hsp) ids
---    
---getByRate :: RatingData -> HSpace -> [Hypo]   
---getByRate r hsp = 
---    let ids = case M.lookup r (rateIdsMap hsp) of
---                Just i -> i
---                Nothing -> []
---    in mapMaybe ((flip getById) hsp) ids
-
-alterRateIdsMap :: (Maybe IDs -> Maybe IDs) -- ^alter with function
-                -> Hypo                     -- ^at 'Hypo'
-                -> HSpace                   -- ^in HypoSpace
-                -> HSpace                   -- ^yielding resulting HypoSpace
-alterRateIdsMap f h hsp  = 
-    let rhm = rateIdsMap hsp in
-    hsp{rateIdsMap = M.alter f (rate h) rhm}
-    --    hsp{rateIdsMap = I.alter f (rate h) rhm}
-        
-alterRuleIdsMap :: (Maybe IDs -> Maybe IDs) -- ^alter with function
-                -> Hypo                     -- ^at each CovrRule in Hypo
-                -> HSpace                   -- ^in HypoSpace
-                -> HSpace                   -- ^yielding resulting HypoSpace
-alterRuleIdsMap fun h hsp  = 
-    let rim  = ruleIdsMap hsp 
-        frgs = S.toList.open $ h in
-    hsp{ruleIdsMap = foldl' (flip (M.alter fun)) rim frgs}
-    
-alterHypoIdBimap :: (Hypo -> Bimap Hypo ID -> Bimap Hypo ID)
-                 -> Hypo                  -- ^at Hypo
-                 -> HSpace                -- ^in HypoSpace
-                 -> HSpace                -- ^yielding resulting HypoSpace
-alterHypoIdBimap f h hsp  = 
-    let him = hypoIdBimap hsp
-    in  hsp{hypoIdBimap = f h him} 
-
-    
--- | /O(log n)/, insert a new hypothese into the search space
-insert :: Hypo -> HSpace -> HSpace
-insert h hsp 
-        | (B.member h (hypoIdBimap hsp)) = hsp
-    -- duplicate hypos would not be stored anyway, but this saves a bit of 
-    -- computation and does not generate superfluous IDs 
-        | otherwise                              = 
-            incrementHypoCount $                      -- finally
-            alterRateIdsMap  (addToBin iD)      h $  -- third
-            alterRuleIdsMap  (addToBin iD)      h $  -- second
-            alterHypoIdBimap (flip B.insert iD) h $  -- first
-            hsp
-    where
-    iD = hypoCounter hsp
-    addToBin i is = 
-        case is of
-            Just is' -> Just $ IS.insert i is' -- put in bin
-            Nothing  -> Just $ IS.singleton i  -- create new bin
-
--- | /O(log n)/, delete a hypothese from the search space   
-delete :: Hypo -> HSpace -> HSpace
-delete h hsp =
-        --trace ("DELETE: " ++ " " ++ (show (M.elems (rateIdsMap hsp))) ++ "\n" ++ (show ((B.keysR.hypoIdBimap) hsp)))
-    alterRateIdsMap (removeFromBin iD) h $!
-    alterRuleIdsMap (removeFromBin iD) h $! 
-    alterHypoIdBimap B.delete          h $!
-    hsp 
-    where
-    iD = getByHypo h hsp
-    removeFromBin _ Nothing          = Nothing -- there is no bin
-    removeFromBin Nothing is         = is      -- nothing to remove
-    removeFromBin (Just i) (Just is) =      
-        let is' =  IS.delete i is
-        in if IS.null is'      -- is bin empty after deletion?
-             then Nothing      -- yes, the remove empty bin
-             else Just is'     -- no, return bin
-
--- | /O(log n)/, replace a 'Hypo', by a list of 'Hypo's
-replace :: Hypo -> [Hypo] -> HSpace -> HSpace       
-replace ho hn = (\hsp -> foldl' (flip insert) hsp hn) .(delete ho)
-    
-
-    
---{- -----------------------------------------------------------------------------
--- | Show instances and pretty printing stuff
-------------------------------------------------------------------------------- -}
-  
-
-instance Show HSpace where
-        show = show.pretty            
-instance Pretty HSpace where
-        pretty hsp = text "HSPACE" <$> 
-                     parens ( indent 2 $ 
-                        text "Total Hypos:"     <+> (int.S.size.S.fromList.M.elems.ruleIdsMap $ hsp) <$>
-                        text "Rating -> Hypo:" <^> indent 2 (vcat . (prntAssocs hsp) .  M.assocs . rateIdsMap $ hsp)
---                        text "Rating -> HypoID:" <^> pretty (rateIdsMap hsp) <$> 
---                        text "Rule   -> HypoID:" <^> pretty (ruleIdsMap hsp) <$> 
---                        text "ID     -> Hypo:  " <$> pretty (hypoIdBimap hsp)
-                     )        
- 
-prntAssocs hsp = map (asMap . (id *** ((mapMaybe (flip getById hsp)).  IS.toList) ) )
+
rmfile ./src/Data/HypoSpace_propagate.hs
hunk ./src/Data/Hypotheses.hs 10
-    developH, shrinkH, extendH, modifyH,
+    developH, 
hunk ./src/Data/Hypotheses.hs 53
+                , rtng :: RatingData
hunk ./src/Data/Hypotheses.hs 73
-	pretty h = text "No Pretty implemented"
---               let pbnds = either (const [text "No Bindings"]) ((map pretty) . rules2decs . snd ) (runC $ simplifiedBindings h)
---               in text "Hypo" <+> ( align . vcat $ ( (either (const $ text "NoData") pretty $ runC (rate  h)) <> colon): pbnds)
---						 text "open:" <+> pretty o <$> 
---						 text "closed:" <+> pretty c <$> 
---						 text "callings:" <+> pretty cs
---						 )
-
-bla = let x = 1
-          y = 2
-          z = 3 in
-          x + y + z
-          
+	pretty h = text "Hypo" <+> pretty (rtng h) <$> 
+			   text "open:" <+> pretty (open h) <$> 
+               text "closed:" <+> pretty (clsd h) <$> 
+               text "callings:" <+> pretty (callings h)         
hunk ./src/Data/Hypotheses.hs 79
-hypo :: [CovrRule] -> Hypo
-hypo rs  = foldl' (flip extendH) h rs 
+hypo :: (MonadError e m) => [CovrRule] -> C m Hypo
+hypo rs  = updateRating $ foldl' (flip unsafeExtend) h rs 
hunk ./src/Data/Hypotheses.hs 82
-    h = HH S.empty M.empty noCalls
+    h = HH S.empty M.empty noCalls eRD
+    eRD = mkRatingData (-1)(-1)(-1)(-1)([],(0/0))
hunk ./src/Data/Hypotheses.hs 145
-developH ::  (Monad m) => 
+developH ::  (MonadError e m) => 
hunk ./src/Data/Hypotheses.hs 150
-        m Hypo           -- the resulting hypothese in your favorite Monad
+        C m (Maybe Hypo) -- the resulting hypothese in your favorite Monad
hunk ./src/Data/Hypotheses.hs 152
-    let (HH open clsd cdps) = modifyH rf rfs h
-    cdps' <- foldM tryAddCall cdps calls
-    return $ HH open clsd cdps'   
+    let h@(HH open clsd cdps rd) = unsafeModify rf rfs h
+    maybe (return Nothing)(\c -> liftM Just $ updateRating h{callings = c}) $ foldM tryAddCall cdps calls
hunk ./src/Data/Hypotheses.hs 160
-extendH :: CovrRule -> Hypo -> Hypo
-extendH rf h@(HH os cs _ ) 
+unsafeExtend :: CovrRule -> Hypo -> Hypo
+unsafeExtend rf h@(HH os cs _ _) 
hunk ./src/Data/Hypotheses.hs 166
-shrinkH :: CovrRule -> Hypo -> Hypo
-shrinkH rf h@(HH os cs _ ) 
+unsafeShrink :: CovrRule -> Hypo -> Hypo
+unsafeShrink rf h@(HH os cs _ _) 
hunk ./src/Data/Hypotheses.hs 172
-modifyH 
-     :: CovrRule    -- ^replace/update old rule
+unsafeModify :: 
+        CovrRule    -- ^replace/update old rule
hunk ./src/Data/Hypotheses.hs 177
-modifyH rold newrs h =     
-    let shrnk = shrinkH rold h in
-    S.fold extendH shrnk newrs 
+unsafeModify rold newrs h =     
+    let shrnk = unsafeShrink rold h in
+    S.fold unsafeExtend shrnk newrs 
hunk ./src/Data/Hypotheses.hs 181
-    
+updateRating :: (MonadError e m) => Hypo -> C m Hypo
+updateRating h = do v <- rate h; return h{rtng = v}     
hunk ./src/Data/Hypotheses.hs 191
---	pretty (HHs s) = pretty s    
+--    pretty (HHs s) = pretty s    
hunk ./src/Rating/Rateable.hs 31
+
hunk ./src/RuleDevelopment.hs 17
-import Data.Maybe (mapMaybe)
+import Data.Maybe (catMaybes)
hunk ./src/RuleDevelopment.hs 27
-    let fhs = mapMaybe (developH r h) fs 
-    let nhs = mapMaybe (developH r h) ns 
-    let mhs = mapMaybe (developH r h) ms 
-    let phs = mapMaybe (developH r h) ps   
-    let chs = mapMaybe (developH r h) cs
-    let all = concat $ [fhs, nhs, mhs, phs, chs]
+    fhs <- (lift . lift . lift . lift) $ mapM (developH r h) fs 
+    nhs <- (lift . lift . lift . lift) $ mapM (developH r h) ns 
+    mhs <- (lift . lift . lift . lift) $ mapM (developH r h) ms 
+    phs <- (lift . lift . lift . lift) $ mapM (developH r h) ps   
+    chs <- (lift . lift . lift . lift) $ mapM (developH r h) cs
+    let all = catMaybes . concat $ [fhs, nhs, mhs, phs, chs]
hunk ./src/Syntax/Class/Antiunifier.hs 69
-lggL ls = do (r,s) <- runStateT (mapM aunify ls)  emptyVIMap
-             return $ (trace $ "AUNIL" ++ "\n " ++ (show $ pretty $ ls) ++ "\n " ++ (show $ pretty $ r)  ++ "\n " ++ (show $ pretty $  s) ) r
+lggL ls = evalStateT (mapM aunify ls)  emptyVIMap