satchmo 2.9.1 → 2.9.2

raw patch · 3 files changed

+75/−10 lines, 3 files

Files

• Satchmo/Array.hs +38/−0
• Satchmo/Counting/Binary.hs +35/−9
• satchmo.cabal +2/−1

@@ -0,0 +1,38 @@+{-# language TupleSections #-}+{-# language FlexibleInstances #-}+{-# language MultiParamTypeClasses #-}++module Satchmo.Array++( Array+, unknown, constant+, (!), elems, indices, bounds, range, assocs+)+       +where++import Satchmo.Code as C+  +import qualified Data.Array as A+import Control.Applicative+import Control.Monad ( forM )++newtype Array i v = Array (A.Array i v)++unknown bnd build = +  Array <$> A.array bnd <$> forM (A.range bnd) ( \ i ->+    (i,) <$> build )++constant a = Array a++instance (Functor m, A.Ix i, Decode m c d )+         => Decode m (Array i c) (A.Array i d) where+  decode (Array a) = A.array (A.bounds a) <$> +    forM (A.assocs a) ( \(k,v) -> (k,) <$> decode v )++Array a ! i = a A.! i+elems (Array a) = A.elems a+indices (Array a) = A.indices a+bounds (Array a) = A.bounds a+range bnd = A.range bnd+assocs (Array a) = A.assocs a

@@ -26,26 +26,52 @@   $ map ( \ bit -> Satchmo.Binary.make [bit] )   $ bits +data NumCarries =+  NumCarries { num:: Number,carries:: [Boolean]}++zro = NumCarries {num=make [], carries=[] }+mke 0 b = NumCarries {num=make[],carries=[b]}+mke w b | w > 0 = NumCarries {num=make[b],carries=[]}+pls w x y = do+  z <- Satchmo.Binary.add (num x) (num y)+  let (pre,post) = splitAt w $ bits z+  return $ NumCarries+     { num = make pre+     , carries = post ++ carries x ++ carries y+     }++count_and_carry width bits +  = collect (return zro) (pls width) $ map (mke width) bits+   collect :: Monad m => m a -> (a -> a -> m a) -> [a] -> m a collect z b xs = case xs of   [] -> z   [x] -> return x   (x:y:zs) -> b x y >>= \ c -> collect z b (zs ++ [c])-    + atleast :: MonadSAT m => Int -> [ Boolean ] -> m Boolean-atleast k xs = common ge k xs+atleast k xs = common True ge k xs  atmost :: MonadSAT m => Int -> [ Boolean ] -> m Boolean-atmost k xs = common le k xs+atmost k xs = common False le k xs          exactly :: MonadSAT m => Int -> [ Boolean ] -> m Boolean-exactly k xs = common eq k xs+exactly k xs = common False eq k xs  common :: MonadSAT m-       => (Number -> Number -> m b)-       -> Int -> [ Boolean ] -> m b-common cmp k xs = do-  c <- count xs+       => Bool +       -> (Number -> Number -> m Boolean)+       -> Int -> [ Boolean ] -> m Boolean+common may_overflow cmp k xs = do+  let bk = Satchmo.Binary.toBinary $ fromIntegral k+  NumCarries { num=n,carries=cs} <-+    count_and_carry (length bk) xs   goal <- Satchmo.Binary.constant $ fromIntegral k-  cmp c goal +  ok <- cmp n goal +  if may_overflow+    then or $ ok : cs+    else and $ ok : map not cs+         +    + 

@@ -1,5 +1,5 @@ Name:           satchmo-Version:        2.9.1+Version:        2.9.2  License:        GPL License-file:	gpl-2.0.txt@@ -64,6 +64,7 @@         Satchmo.Set.Op         Satchmo.Map         Satchmo.Map.Data+        Satchmo.Array         Satchmo.Numeric         Satchmo.Binary.Numeric         Satchmo.BinaryTwosComplement.Numeric