obdd 0.4.0 → 0.5.0

raw patch · 3 files changed

+94/−2 lines, 3 filesdep ~basedep ~containersPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, containers

API changes (from Hackage documentation)

Files

• examples/Weight.hs +45/−0
• obdd.cabal +9/−2
• src/OBDD/Linopt.hs +40/−0

@@ -0,0 +1,45 @@+{-++The minimal number of knights needed to occupy or attack+every square on an n×n chessboard+(i.e., domination numbers for the n×n knight graphs)++http://mathworld.wolfram.com/KnightsProblem.html++-}++import Prelude hiding ((&&),(||),not,and,or)+import OBDD +import OBDD.Linopt++import Control.Monad ( guard )+import System.Environment ( getArgs )+import Data.List (sort)+import qualified Data.Map.Strict as M++type Position = (Int,Int)++positions :: Int -> [ Position ]+positions n = (,) <$> [1..n] <*> [1..n]++knight (a,b) (c,d) = 5 == (a-c)^2 + (b-d)^2++board :: Int -> OBDD Position+board n = and $ do+  p <- positions n ; q <- positions n+  guard $ p < q ; guard $ knight p q+  return $ not (variable p) || not (variable q)++main = do+    args <- getArgs+    case map read args :: [Int] of+        [] -> mainf 9+        [arg] -> mainf arg++mainf n = do+    let d :: OBDD Position+        d = board n+        a = linopt d $ M.fromList $ zip (positions n) $ repeat 1+    putStrLn $ unwords [ "board size", show n ]+    putStrLn $ unwords [ "BDD size", show $ OBDD.size d ]+    putStrLn $ show a

@@ -1,5 +1,5 @@ Name:                obdd-Version:             0.4.0+Version:             0.5.0 Cabal-Version:       >= 1.8 Build-type: Simple Synopsis:            Ordered Reduced Binary Decision Diagrams@@ -19,7 +19,7 @@ Library     Build-Depends:       base==4.*, random, mtl, containers>=0.5, array, process     Hs-Source-Dirs:	     src-    Exposed-Modules:     OBDD OBDD.Data OBDD.Make OBDD.Operation OBDD.Property+    Exposed-Modules:     OBDD OBDD.Data OBDD.Make OBDD.Operation OBDD.Property, OBDD.Linopt     Other-Modules:	     OBDD.IntIntMap, OBDD.VarIntIntMap     ghc-options: -funbox-strict-fields @@ -33,12 +33,19 @@     Hs-Source-Dirs : examples     Type: exitcode-stdio-1.0     Main-Is: Queens.hs+    ghc-options: -threaded -rtsopts     Build-Depends: base, containers, obdd  test-suite obdd-queens2     Hs-Source-Dirs : examples     Type: exitcode-stdio-1.0     Main-Is: Queens2.hs+    Build-Depends: base, containers, obdd++test-suite obdd-weight+    Hs-Source-Dirs : examples+    Type: exitcode-stdio-1.0+    Main-Is: Weight.hs     Build-Depends: base, containers, obdd      test-suite obdd-sort

@@ -0,0 +1,40 @@+module OBDD.Linopt where++import OBDD (OBDD, fold)++import qualified Data.Map.Strict as M++type Item v w = (w, [(v,Bool)])++-- | solve the constrained linear optimisation problem:+-- returns an assignment that is a model of the BDD+-- and maximises the sum of weights of variables.+linopt :: ( Ord v , Num w, Ord w ) +       => OBDD v +       -> M.Map v w +       -> Maybe (w, M.Map v Bool)+linopt d m = ( \(w,kvs) -> (w,M.fromList kvs) ) <$>+   fold ( \ leaf  -> if leaf then Just (0, []) else Nothing )+       ( \ v ml mr -> case (ml,mr) of+          (Nothing, Just r) -> Just $   add m v $ fill m v r+          (Just l, Nothing) -> Just $ noadd m v $ fill m v l+          (Just l,  Just r) -> Just $+                  let l' = noadd m v $ fill m v l +                      r' =   add m v $ fill m v r+                  in  if fst l' >= fst r' then l' else r'+       )+       d++fill :: (Ord v, Num w) => M.Map v w -> v -> Item v w -> Item v w+fill m v (w, xs) = +    let vs = (case xs of+               [] -> id+               (u,_):_ -> takeWhile (\(k,v) -> k > u) ) +           $ dropWhile (\(k,_) -> k >= v) +           $ M.toDescList m+    in  foldr (add m) (w, xs) $ map fst vs++noadd, add :: (Ord v, Num w) => M.Map v w -> v -> Item v w -> Item v w+noadd m v (w,xs) = (w          , (v,False) : xs)+add   m v (w,xs) = (w + m M.! v, (v, True) : xs)+