[Forgot to add RuleDevelopment/* !!!
martin.hofmann@uni-bamberg.de**20090408145420] addfile ./src/RuleDevelopment/Abduce.hs
hunk ./src/RuleDevelopment/Abduce.hs 1
+
+module RuleDevelopment.Abduce where
+
+import Data.IgorMonad
+import Data.IOData
+
+import Logging
+
addfile ./src/RuleDevelopment/Partition.hs
hunk ./src/RuleDevelopment/Partition.hs 1
-
+
+module RuleDevelopment.Partition (
+
+    partition, trivialPartition   
+
+    )where
+
+import Data.IgorMonad
+--import Data.IOData
+import qualified Data.Set as S
+import Data.List (foldl')
+import Data.Function
+import Logging
+
+-- No real partition, but an implementaion of overfitting :-), simply always
+-- splitting the first rule from the rest.
+trivialPartition :: RuleFrag -> IM (RuleFrags,[Call])
+trivialPartition rf = do
+    (first:rest) <- breakupM rf
+    fusedrest    <- return $ fuse rest
+    return (S.fromList [first, fusedrest],[])
+
+-- creates new partitions (i.e. RuleFragements) from one RuleFragement
+-- the resulting rules may be closed by antiunification
+-- and it should be assured, that each RuleFrag has only one open position
+-- --> closing pairwise with functionCall and subfunction
+partition :: RuleFrag -> IM [(RuleFrags,[Call])]
+partition rf = do
+    llogEnterIN 
+    iod <- getEvidence
+    let frags    = breakup rf iod
+    let partpos  = concat.init.ruleVarPos $ frag rf
+    allParts <- lift $ mapM (partitionAt frags) partpos
+    let parts = (filter (not.S.null)) allParts
+    llogIN ( text "Partitioning" <^>
+    		 text "Rule:" <+> pretty rf <^>
+             text "At  :" <+> pretty partpos <^>
+             text "Into:" <+> pretty parts
+            )
+    return $ map (\p -> (p,[])) parts 
+
+-- EXPONENTIELLER AUFWAND -- SCHLECHT IMPLEMENTIERT
+partitionAt :: [RuleFrag] -> RulePos -> LM RuleFrags
+partitionAt rfs p = return $ S.fromList $ map fuse bins
+   where
+   bins = 
+    case foldl' bin [] rfs of    
+     [(x:xs)] -> [] --[[x],xs]
+     (x1:x2:xs)   -> (x1:x2:xs)   
+   cmpAtPos = (sameSymAt p) `on` frag
+   bin [] e              = [[e]]
+   bin ((x:xs):done) e   = 
+    if (cmpAtPos e x)
+      then (e:x:xs):done
+      else (x:xs):(bin done e)        
+    
+ 
+
+
+    
addfile ./src/RuleDevelopment/Subfunction.hs
hunk ./src/RuleDevelopment/Subfunction.hs 1
-
+
+module RuleDevelopment.Subfunction where
+
+import Data.IgorMonad
+import Data.IOData
+import Data.Rules
+import qualified Data.Set as S
+import Data.Maybe
+import Data.List (foldl')
+import Logging
+import Debug.Trace
+
+
+callSubfunction :: RuleFrag -> IM [(RuleFrags,[Call])]
+callSubfunction rf =
+    llogEnterIN >>             
+    if (frag rf) `hasCtorAt` (Body Root) 
+      then subfunction rf 
+      else llogIN (text "Introducing Subfunction" <^>
+                   text "No Ctor at Root, return []") >> return []
+
+subfunction :: RuleFrag -> IM [(RuleFrags,[Call])]
+subfunction rf = do 
+    covfrags <- breakupM $ rf
+    novarpos <- return $  posOfNoVarSubts rf
+    let ios = map (abduceIOAt covfrags) novarpos
+    (tags,subfnnms) <- liftM unzip $ mapM addIO ios
+        
+    let rfnew = foldl' addCallAt rf $ zip novarpos subfnnms
+    let calls = map (\n -> ((name rf),n,EQ)) subfnnms
+    rfsubs <- mapM (coverAll.snd) $ filter fst $ zip tags subfnnms
+    
+    llogIN ( text "Introducing Subfunction" <^>
+             text "Rule_old:" <+> pretty rf <^>
+             text "Rule_new:" <+> pretty rfnew <^>
+             text "abducdIOs:" <+> pretty (zip3 tags subfnnms ios) <^>
+             text "Rule_sub:" <+> pretty rfsubs <^>
+             text "Pos:" <+> pretty novarpos <^>
+             text "Calls:" <+> pretty (show calls)
+            )
+    return [(S.fromList (rfnew:rfsubs), calls) ]
+    
+    where
+    addCallAt rf (p,n) = modifyFrag rf $(uncurry insertCall) (p,n)
+    -- replace rhs-subterm of 'rf'  at position 'p' with call ti 'n' using th elhs of 'rf' 
+    posOfNoVarSubts = fst . unzip . filterNoVars . label . subtrms 
+    -- get the positions of immediate subterms which contain variables
+    subtrms        =  subterms.rhs.frag             
+    -- get the immediate subterms on the rhs    
+    label        = zip [ Body (Root°i) | i<- [0..]]
+    -- keep track of the position
+    filterNoVars = filter (hasVars.snd)
+    -- throw away all subterms with no variables
+    
+    
+abduceIOAt :: [RuleFrag] -> RulePos -> Rules
+abduceIOAt rfs p =  S.fromList $ map (fromJust.(subrule p).frag) rfs
+
+ 