packages feed

enumeration (empty) → 0.1.0

raw patch · 8 files changed

+901/−0 lines, 8 filesdep +Cabaldep +HUnit-Plusdep +arith-encodesetup-changed

Dependencies added: Cabal, HUnit-Plus, arith-encode, arithmoi, base, binary, containers, heap

Files

+ LICENSE view
@@ -0,0 +1,28 @@+Copyright (c) 2014, Eric McCorkle+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++* Redistributions of source code must retain the above copyright notice, this+  list of conditions and the following disclaimer.++* Redistributions in binary form must reproduce the above copyright notice,+  this list of conditions and the following disclaimer in the documentation+  and/or other materials provided with the distribution.++* Neither the name of the {organization} nor the names of its+  contributors may be used to endorse or promote products derived from+  this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ enumeration.cabal view
@@ -0,0 +1,60 @@+Name:                   enumeration+Category:               Data, Serialization, Test, Testing+Version:                0.1.0+License:                BSD3+License-File:           LICENSE+Author:                 Eric McCorkle+Maintainer:             Eric McCorkle <emc2@metricspace.net>+Stability:              Beta+Synopsis:               A practical API for building recursive enumeration+                        procedures and enumerating datatypes.+Homepage:               https://github.com/emc2/enumeration+Bug-Reports:            https://github.com/emc2/enumeration/issues+Copyright:              Copyright (c) 2014 Eric McCorkle.  All rights reserved.+Description:+  A library providing tools for building enumeration procedures for recursively-+  enumerable datatypes.  This is built atop the arith-encode library, and makes+  use of the natural number isomorphisms it provides to represent individual+  decisions in the enumeration procedure.  As such, each enumeration result is+  denoted by a unique path, consisting of a sequence of natural numbers.  An+  enumeration procedure is simply a (partial) mapping between sequences+  and a given datatype.+  .+  The library provides functionality for constructing enumeration procedures,+  as well as facilities for performing enumeration according to various search+  strategies (depth-first, breadth-first, etc).  These procedures can also be+  "warm-started" using a path or a set of paths.  Obvious applications include+  exhaustive search, testing, automated proving, and others.+  .+  Additionally, as a path is simply a sequence of natural numbers, an+  enumeration procedure can double as a binary serializer/deserializer.  For+  well-behaved enumeration procedures (ie. those where the mapping is an+  isomorphism), the resulting binary format should be very nearly succinct.+  .+  This is the first release candidate for 1.0 (initial release)+Build-type:             Simple+Cabal-version:          >= 1.16++Source-Repository head+  Type: git+  Location: git@github.com:emc2/enumeration.git++Test-Suite UnitTest+  default-language:     Haskell2010+  type:                 exitcode-stdio-1.0+  Main-Is:              UnitTest.hs+  hs-source-dirs:       src test+  build-depends:        base >= 4.4.0 && < 5, Cabal >= 1.16.0, HUnit-Plus, arith-encode,+                        containers, binary, arithmoi, heap+  ghc-options:          -fhpc++Library+  default-language:     Haskell2010+  hs-source-dirs:       src+  build-depends:        base >= 4.4.0 && < 5, Cabal >= 1.16.0, containers, arith-encode,+                        binary, arithmoi, heap+  exposed-modules:      Data.Enumeration+                        Data.Enumeration.Binary+                        Data.Enumeration.Traversal+  other-modules:+                        Data.Enumeration.Traversal.Class
+ src/Data/Enumeration.hs view
@@ -0,0 +1,321 @@+-- Copyright (c) 2014 Eric McCorkle.  All rights reserved.+--+-- Redistribution and use in source and binary forms, with or without+-- modification, are permitted provided that the following conditions+-- are met:+--+-- 1. Redistributions of source code must retain the above copyright+--    notice, this list of conditions and the following disclaimer.+--+-- 2. Redistributions in binary form must reproduce the above copyright+--    notice, this list of conditions and the following disclaimer in the+--    documentation and/or other materials provided with the distribution.+--+-- 3. Neither the name of the author nor the names of any contributors+--    may be used to endorse or promote products derived from this software+--    without specific prior written permission.+--+-- THIS SOFTWARE IS PROVIDED BY THE AUTHORS AND CONTRIBUTORS ``AS IS''+-- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A+-- PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+-- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+-- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF+-- USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND+-- ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+-- OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT+-- OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+-- SUCH DAMAGE.+{-# OPTIONS_GHC -Wall -Werror -funbox-strict-fields #-}+{-# LANGUAGE DeriveDataTypeable #-}++-- | Utilities for constructing enumerations over datatypes.+--+-- An 'Enumeration' is a mapping between a particular datatype and a+-- 'Path', which consists of a list of natural numbers.  Conceptually,+-- we can think of all the values of a given datatype as being+-- organized into a tree, with nodes representing decisions that+-- narrow down the choices.  In such a scheme, a 'Path' represents a+-- path through the tree to a single value, and an 'Enumeration' is a+-- procedure for converting a 'Path' to and from a value.+--+--+-- An 'Enumeration' has two key functions: 'fromPath' and 'toPath',+-- which translate between paths and instances of a datatype.  These+-- functions are expected to be inverses; or:+--+--   * @fromPath (toPath v) == v@ for all values in the domain+--+-- Beyond this, there are no additional restrictions.  Specifically,+-- two paths /may/ map to the same value.+--+--+-- The 'numBranches' function indicates the maximum value of the first+-- path element for an 'Enumeration'.  The minimum value is always 0,+-- and all values between 0 and 'numBranches' must be valid.  If there+-- is no upper bound on the value of the first path element,+-- 'numBranches' returns 'Nothing'.  The 'toSizedPath' maps a value to+-- a path, which also contains the result of 'numBranches' at each+-- step in the path.+--+--+-- The 'withPrefix' function supplies a partial path to an+-- 'Enumeration', yielding a new 'Enumeration' that maps each value to+-- the same path(s) as the original 'Enumeration', with the prefix+-- added or removed.  More formally, if+--+--   * @subenc = withPrefix enc prepath@+--+-- Then+--+--   * @toPath enc val == prepath ++ toPath subenc val@+--+--   * @fromPath enc (prepath ++ subpath) == fromPath subenc subpath@+--+-- With multiple uses of 'withPrefix', the following must be true:+--+--   * @withPrefix (withPrefix enc path1) path2 == withPrefix enc (path1 ++ path2)@+--+-- Finally, if a complete path is given to 'withPrefix', then the+-- result is a singleton encoding that gives the value associated with+-- that path.  That is:+--+--   * @fromPath enc fullpath == fromPath (withPrefix enc fullpath) []@+--+-- This provides \"warm-start\" functionality for 'Enumeration's.+-- When translating a large number of 'Path's with the same prefix, it+-- will generally be much more efficient to use 'withPrefix' and use+-- the resulting 'Enumeration' than to translate the 'Path's directly.+--+--+-- The 'prefix' function gives the current prefix for an+-- 'Enumeration'.  The following rule describes the relationship+-- between 'prefix' and 'withPrefix':+--+--   * @prefix (withPrefix enc prepath) == prepath@+--+--+-- 'Enumeration's are similar to 'Encoding's from the arith-encode+-- library, except 'Enumeration's are generally more flexible, and can+-- more easily accomodate complex datatypes with invariants.  However,+-- as 'Path's are constructed from natural numbers, we can create an+-- 'Enumeration' using a series of 'Encoding's for intermediate data.+-- The functions in this module provide the ability to construct+-- 'Enumeration's using 'Encoding's+--+-- A singleton 'Enumeration' can be constructed using the 'singleton'+-- and 'singletonWithPrefix' functions.+--+-- An 'Encoding' for a datatype can be converted into an 'Enumeration'+-- (where all paths have a single element) using the 'fromEncoding'+-- and 'fromEncodingWithPrefix' functions.+--+-- The 'step' and 'stepWithPrefix' functions construct an+-- 'Enumeration' from an 'Encoding' for an intermediate value, and a+-- generator function that produces an 'Enumeration' from the+-- intermediate value.+--+-- The @withPrefix@ variants for each of these take a prefix path,+-- where the non-@withPrefix@ variants set the prefix to @[]@.+module Data.Enumeration(+       -- * Definitions+       Enumeration,+       Path,+       BadPath(..),+       IllegalArgument(..),++       -- ** Using Enumerations+       fromPath,+       toPath,+       toSizedPath,+       withPrefix,+       numBranches,+       prefix,++       -- * Constructions+       singleton,+       singletonWithPrefix,+       fromEncoding,+       fromEncodingWithPrefix,+       step,+       stepWithPrefix+       ) where++import Control.Exception+import Data.List+import Data.ArithEncode hiding (singleton)+import Data.Typeable++-- | A path that uniquely identifies a value in an @Enumeration@.+type Path = [Integer]++-- | A datatype that represents a mapping between @Path@s and @ty@s.+-- Note that unlike @Encoding@s, not all @Path@s are necessarily+-- valid.+data Enumeration ty =+  Enumeration {+    -- | Convert a @ty@ to a @Path@+    toPath :: !(ty -> Path),+    -- | Convert to a list of pairs, where the @fst@ holds+    -- the path entry, and @snd@ holds @numBranches@.  This is used+    -- primarily for encoding values as binary.+    toSizedPath :: !(ty -> [(Integer, Maybe Integer)]),+    -- | Generate a @ty@ from a @Path@+    fromPath :: !(Path -> ty),+    -- | Given a prefix path, get an enumeration that generates @ty@s+    -- from the rest of the path.+    withPrefix :: !(Path -> Enumeration ty),+    -- | Get the upper bound on values for the first path component,+    -- or @Nothing@ if there is no bound.+    numBranches :: !(Maybe Integer),+    -- | The prefix path.+    prefix :: !Path+  }++-- | An exception thrown when a 'Path' is invalid.+data BadPath = BadPath String+  deriving Typeable++instance Show BadPath where+  show (BadPath "") = "Bad Path"+  show (BadPath msg) = "Bad Path: " ++ msg++instance Exception BadPath++showPath :: Path -> String+showPath = intercalate "." . map show++-- | Create an 'Enumeration' with an empty prefix that maps a single+-- value to and from the empty path.  Equivalent to+-- @singletonWithPrefix []@+singleton :: Eq ty =>+             ty+          -- ^ The value to map to and from the empty path.+          -> Enumeration ty+singleton = singletonWithPrefix []++-- | Create an 'Enumeration' with a given prefix path that maps a+-- single value to and from the empty path.+singletonWithPrefix :: Eq ty => Path -> ty -> Enumeration ty+singletonWithPrefix prefixPath val =+  let+    showCompletePath path = showPath (prefixPath ++ path)++    fromPathFunc [] = val+    fromPathFunc path =+      throw $! BadPath $! "Extra path elements " ++ showCompletePath path++    toPathFunc val'+      | val' == val = []+      | otherwise = throw $! IllegalArgument "Bad argument to singleton"++    toSizedPathFunc val'+      | val' == val = []+      | otherwise = throw $! IllegalArgument "Bad argument to singleton"++    withPrefixFunc [] = out+    withPrefixFunc path =+      throw $! BadPath $! "Extra path elements " ++ showCompletePath path++    out = Enumeration { fromPath = fromPathFunc, toPath = toPathFunc,+                        withPrefix = withPrefixFunc, numBranches = Just 0,+                        prefix = prefixPath, toSizedPath = toSizedPathFunc }+  in+    out++-- | Create an 'Enumeration' with an empty prefix from a single+-- 'Encoding'.  The 'Path' will always be of length 1, and contains+-- the encoded value.+fromEncoding :: Eq ty =>+                Encoding ty+             -- ^ The 'Encoding' to use+             -> Enumeration ty+fromEncoding = fromEncodingWithPrefix []++-- | Create an 'Enumeration' with a given prefix from a single+-- 'Encoding'.  The 'Path' will always be of length 1, and contains+-- the encoded value.+fromEncodingWithPrefix :: Eq ty => Path -> Encoding ty -> Enumeration ty+fromEncodingWithPrefix prefixPath enc =+  let+    fromPathFunc [encoded] = decode enc encoded+    fromPathFunc [] = throw $! BadPath "Path too short"+    fromPathFunc (_ : path) =+      throw $! BadPath $! "Extra path elements " ++ showPath path++    toPathFunc val = [encode enc val]+    toSizedPathFunc val = [(encode enc val, size enc)]++    withPrefixFunc newPrefix @ [encoded] =+      singletonWithPrefix (prefixPath ++ newPrefix) (decode enc encoded)+    withPrefixFunc [] = out+    withPrefixFunc (_ : path) =+      throw $! BadPath $! "Extra path elements " ++ showPath path++    out = Enumeration { fromPath = fromPathFunc, toPath = toPathFunc,+                        withPrefix = withPrefixFunc, numBranches = size enc,+                        prefix = prefixPath, toSizedPath = toSizedPathFunc }+  in+    out++-- | Create an 'Enumeration' with an empty prefix that uses an+-- 'Encoding' to convert the first element of the path to an interim+-- value, then uses that value to construct an 'Enumeration' to decode+-- the rest of the path.+step :: Encoding ty1+     -- ^ The encoding for the first type.+     -> (Path -> ty1 -> Enumeration ty2)+     -- ^ A function that produces an enumeration from the first type.+     -> (ty2 -> ty1)+     -- ^ A function that extracts the first type from the second.+     -> Enumeration ty2+step = stepWithPrefix []++-- | Create an 'Enumeration' with a prefix that uses an 'Encoding' to+-- convert the first element of the path to an interim value, then+-- uses that value to construct an 'Enumeration' to decode the rest of+-- the path.+stepWithPrefix :: Path+               -- ^ The prefix path.+               -> Encoding ty1+               -- ^ The 'Encoding' for the first type.+               -> (Path -> ty1 -> Enumeration ty2)+               -- ^ A function that produces an enumeration from the first type.+               -> (ty2 -> ty1)+               -- ^ A function that extracts the first type from the second.+               -> Enumeration ty2+stepWithPrefix prefixPath enc build extract =+  let+    fromPathFunc (first : rest) =+      fromPath (build prefixPath (decode enc first)) rest+    fromPathFunc [] = throw $! BadPath "Path too short"++    toPathFunc val =+      let+        extracted = extract val+        inner = build prefixPath extracted+      in+        encode enc extracted : toPath inner val++    toSizedPathFunc val =+      let+        extracted = extract val+        inner = build prefixPath extracted+      in+        (encode enc extracted, size enc) : toSizedPath inner val++    withPrefixFunc (first : rest) =+      let+        extracted = decode enc first+        newPrefix = prefixPath ++ [first]+        inner = build newPrefix extracted+      in+       withPrefix inner rest+    withPrefixFunc [] = out++    out = Enumeration { fromPath = fromPathFunc, toPath = toPathFunc,+                        withPrefix = withPrefixFunc, numBranches = size enc,+                        prefix = prefixPath, toSizedPath = toSizedPathFunc }+  in+    out
+ src/Data/Enumeration/Binary.hs view
@@ -0,0 +1,192 @@+-- Copyright (c) 2014 Eric McCorkle.  All rights reserved.+--+-- Redistribution and use in source and binary forms, with or without+-- modification, are permitted provided that the following conditions+-- are met:+--+-- 1. Redistributions of source code must retain the above copyright+--    notice, this list of conditions and the following disclaimer.+--+-- 2. Redistributions in binary form must reproduce the above copyright+--    notice, this list of conditions and the following disclaimer in the+--    documentation and/or other materials provided with the distribution.+--+-- 3. Neither the name of the author nor the names of any contributors+--    may be used to endorse or promote products derived from this software+--    without specific prior written permission.+--+-- THIS SOFTWARE IS PROVIDED BY THE AUTHORS AND CONTRIBUTORS ``AS IS''+-- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A+-- PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+-- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+-- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF+-- USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND+-- ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+-- OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT+-- OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+-- SUCH DAMAGE.+{-# OPTIONS_GHC -Wall -Werror #-}++-- | Functions for binary serialization/deserialization of datatypes+-- using an 'Enumeration'.  These functions write out/read in binary+-- data as a sequence of natural numbers representing a path (using+-- the same coding scheme as "Data.Encoding.Binary").+module Data.Enumeration.Binary(+       putWithEnumeration,+       getWithEnumeration+       ) where++import Data.Binary.Get hiding (remaining)+import Data.Binary.Put+import Data.Bits+import Data.Enumeration+import Math.NumberTheory.Logarithms++-- Emit a natural number as a sequence of some number of bytes+putNatural :: Int -> Integer -> Put+putNatural 0 0 = return ()+putNatural 0 _ = error "Data remaining at end of encoding"+putNatural remaining natural+  | remaining > 8 =+    let+      output = fromInteger (natural .&. 0xffffffffffffffff)+      rest = natural `shiftR` 64+    in do+      putWord64le output+      putNatural (remaining - 8) rest+  | remaining > 4 =+    let+      output = fromInteger (natural .&. 0xffffffff)+      rest = natural `shiftR` 32+    in do+      putWord32le output+      putNatural (remaining - 4) rest+  | remaining > 2 =+    let+      output = fromInteger (natural .&. 0xffff)+      rest = natural `shiftR` 16+    in do+      putWord16le output+      putNatural (remaining - 2) rest+  | otherwise =+    let+      output = fromInteger (natural .&. 0xff)+      rest = natural `shiftR` 8+    in do+      putWord8 output+      putNatural (remaining - 1) rest++-- | Use an 'Enumeration' to write out a @ty@ as binary data+putWithEnumeration :: Enumeration ty -> ty -> Put+putWithEnumeration enum =+  let+    putWithEnumeration' [] = return ()+    putWithEnumeration' ((encoded, branches) : rest) =+      case branches of+        Just 0 -> return ()+        Just 1 -> putWithEnumeration' rest+        Just finitesize ->+          let+            bytes = (integerLog2 (finitesize - 1) `quot` 3) + 1+          in do+            putNatural bytes encoded+            putWithEnumeration' rest+        Nothing ->+          do+            if encoded < 64+              then+                putWord8 (fromInteger encoded `shiftL` 2)+              else+                let+                  bytes = (integerLog2 (encoded - 1) `quot` 3) + 1+                in do+                  if bytes <= 64+                    then putWord8 (fromIntegral (((bytes - 1) `shiftL` 2) .|.+                                                 0x1))+                    else if bytes <= 16384+                      then+                        putWord16le (fromIntegral (((bytes - 1) `shiftL` 2) .|.+                                                     0x2))+                      else+                        putWord64le (fromIntegral (((bytes - 1) `shiftL` 2) .|.+                                                   0x3))+                  putNatural bytes encoded+            putWithEnumeration' rest+  in+    putWithEnumeration' . toSizedPath enum++-- Read in a natural number as a sequence of some number of bytes+getNatural :: Int -> Get Integer+getNatural bytes =+  let+    getNatural' :: Integer -> Int -> Get Integer+    getNatural' accum count+      | count + 8 < bytes =+        do+          input <- getWord64le+          getNatural' ((toInteger input `shiftL` (count * 8)) .|. accum)+                      (count + 8)+      | count + 4 < bytes =+        do+          input <- getWord32le+          getNatural' ((toInteger input `shiftL` (count * 8)) .|. accum)+                      (count + 4)+      | count + 2 < bytes =+        do+          input <- getWord16le+          getNatural' ((toInteger input `shiftL` (count * 8)) .|. accum)+                      (count + 2)+      | count < bytes =+        do+          input <- getWord8+          getNatural' ((toInteger input `shiftL` (count * 8)) .|. accum)+                      (count + 1)+      | otherwise = return accum+  in+    getNatural' 0 0++-- | Use an 'Enumeration' to extract a @ty@ from binary data.+getWithEnumeration :: Enumeration ty -> Get ty+getWithEnumeration enum =+  case numBranches enum of+    Just 0 -> return (fromPath enum [])+    Just 1 -> getWithEnumeration (withPrefix enum [0])+    Just finitesize ->+      let+        bytes = (integerLog2 (finitesize - 1) `quot` 3) + 1+      in do+        encoded <- getNatural bytes+        getWithEnumeration (withPrefix enum [encoded])+    -- Arbitrary-length naturals are encoded with a more complex+    -- scheme.  The first two bits are a tag, which tells how to+    -- interpret the rest.+    Nothing ->+      do+        firstbyte <- lookAhead getWord8+        encoded <-+          case firstbyte .&. 0x03 of+            -- Naturals less than 64 get packed into the same byte as+            -- the tag+            0x0 ->+              do+                datafield <- getWord8+                return (toInteger (datafield `shiftR` 2))+            -- One-byte length field, and then up to 64 bytes of data+            0x1 ->+              do+                lenfield <- getWord8+                getNatural (fromIntegral (lenfield `shiftR` 2) + 1)+            -- Two-byte length field, and then up to 16384 bytes of data+            0x2 ->+              do+                lenfield <- getWord16le+                getNatural (fromIntegral (lenfield `shiftR` 2) + 1)+            -- Eight-byte length field, and then data+            0x3 ->+              do+                lenfield <- getWord64le+                getNatural (fromIntegral (lenfield `shiftR` 2) + 1)+            _ -> error "Impossible case"+        getWithEnumeration (withPrefix enum [encoded])
+ src/Data/Enumeration/Traversal.hs view
@@ -0,0 +1,204 @@+-- Copyright (c) 2014 Eric McCorkle.  All rights reserved.+--+-- Redistribution and use in source and binary forms, with or without+-- modification, are permitted provided that the following conditions+-- are met:+--+-- 1. Redistributions of source code must retain the above copyright+--    notice, this list of conditions and the following disclaimer.+--+-- 2. Redistributions in binary form must reproduce the above copyright+--    notice, this list of conditions and the following disclaimer in the+--    documentation and/or other materials provided with the distribution.+--+-- 3. Neither the name of the author nor the names of any contributors+--    may be used to endorse or promote products derived from this software+--    without specific prior written permission.+--+-- THIS SOFTWARE IS PROVIDED BY THE AUTHORS AND CONTRIBUTORS ``AS IS''+-- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A+-- PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+-- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+-- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF+-- USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND+-- ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+-- OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT+-- OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+-- SUCH DAMAGE.+{-# OPTIONS_GHC -Wall -Werror -funbox-strict-fields #-}++-- | Functionality for traversing an 'Enumeration'.+--+-- This module provides a typeclass, 'Traversal', which represents a+-- traversal scheme for 'Enumeration's.  Traversals should be largely+-- independent of the 'Enumeration', though some variants like+-- 'Prioritized' cannot be wholly independent.+--+-- Three 'Traversal' instances are provided by this module:+-- 'DepthFirst', 'BreadthFirst', and 'Prioritized'.  All traversals+-- work by maintaining a set of positions, which consist of an+-- 'Enumeration' and an index (the next value to give as a first path+-- element).  At each step, some position is \"expanded\" by replacing+-- it with two positions: one with the index as an additional prefix+-- element, and one with the index incremented.+--+-- 'DepthFirst' is a simple depth-first scheme.  It is not guaranteed+-- to reach all elements, and in some 'Enumeration's, it may never+-- produce an answer.+--+-- 'BreadthFirst' is a breadth-first scheme, which tends to be+-- better-behaved than 'DepthFirst'.  It explores paths in ascending+-- order of path length.  For 'Enumeration's with infinite-sized+-- branches, its behavior is not strictly breadth-first (as this would+-- never yield an answer), but it should still behave well for this+-- case.+--+-- 'Prioritized' is a scheme that uses a scoring function to rank+-- paths.  At each step, it will select the \"best\" (highest-ranked)+-- option and expand it.+module Data.Enumeration.Traversal(+       Traversal(..),+       DepthFirst,+       BreadthFirst,+       Prioritized,+       scoring,+       mkPrioritizedTraversal+       ) where++import Data.Enumeration+import Data.Enumeration.Traversal.Class+import Data.Heap(MaxPrioHeap)+import Data.Sequence(Seq, (<|), (|>), ViewL(..), viewl)++import qualified Data.Heap as Heap+import qualified Data.Sequence as Sequence++-- | Depth-first traversal.  Note that this style of traversal is not+-- guaranteed to be complete (it may deep-dive and never visit some+-- possibilities).  However, this implementation should continue+-- producing results even with infinite-sized branches, so long as the+-- depth of any one path isn't too great.+newtype DepthFirst ty = DepthFirst { dfStack :: [(Enumeration ty, Integer)] }++instance Traversal DepthFirst where+  mkTraversal enum = DepthFirst { dfStack = [(enum, 0)] }++  getNext DepthFirst { dfStack = [] } = Nothing+  getNext DepthFirst { dfStack = (enum, curr) : rest } =+    case numBranches enum of+      -- For a leaf, produce a result+      Just 0 -> Just (fromPath enum [], prefix enum,+                      DepthFirst { dfStack = rest })+      Just high+        -- If we are exhausting the current step, proceed directly to+        -- the next level+        | curr + 1 >= high ->+          getNext DepthFirst { dfStack = (withPrefix enum [curr], 0) : rest }+        -- Otherwise, keep it on the stack.+        | otherwise ->+          getNext DepthFirst { dfStack = (withPrefix enum [curr], 0) :+                                         (enum, curr + 1) : rest }+      -- When there's a step with infinite branches, go ahead and+      -- jettison the rest of the stack; we'll never get to it+      -- anyway.+      Nothing ->+        getNext DepthFirst { dfStack = [(withPrefix enum [curr], 0),+                                        (enum, curr + 1)] }+++-- | Breadth-first traversal.  This style of traversal is guaranteed+-- to be complete- that is, it will visit every possibility+-- eventually.  However, it may take a very long time to reach any+-- given possibility.+newtype BreadthFirst ty =+  BreadthFirst { bfQueue :: Seq (Enumeration ty, Integer) }++instance Traversal BreadthFirst where+  mkTraversal enum = BreadthFirst { bfQueue = Sequence.singleton (enum, 0) }++  getNext BreadthFirst { bfQueue = queue } =+    case viewl queue of+      (enum, curr) :< rest ->+        case numBranches enum of+          -- For a leaf, produce a result+          Just 0 -> Just (fromPath enum [], prefix enum,+                          BreadthFirst { bfQueue = rest })+          Just high+            -- If we are exhausting the current head of the queue, remove it+            | curr + 1 >= high ->+              getNext BreadthFirst { bfQueue = rest |>+                                               (withPrefix enum [curr], 0) }+            -- Otherwise, keep it on the queue+            | otherwise ->+              getNext BreadthFirst { bfQueue = ((enum, curr + 1) <| rest) |>+                                               (withPrefix enum [curr], 0) }+          -- If there's a step with infinite branches, cycle it to the+          -- back of the queue, so we don't deep-dive into it.+          Nothing ->+            getNext BreadthFirst { bfQueue = rest |>+                                             (withPrefix enum [curr], 0) |>+                                             (enum, curr + 1) }+      EmptyL -> Nothing++-- | Prioritized traversal.  Will always pick the highest-scored+-- option.  Completeness depends entirely on the scoring function.+data Prioritized ty =+  Prioritized {+    -- | The scoring function used in a 'Prioritized' traversal scheme.+    scoring :: !((Enumeration ty, Integer) -> Float),+    priHeap :: !(MaxPrioHeap Float (Enumeration ty, Integer))+  }++-- | Create a prioritized traversal with a given scoring function.+mkPrioritizedTraversal :: ((Enumeration ty, Integer) -> Float)+                       -- ^ The scoring function to use.+                       -> Enumeration ty+                       -- ^ The enumeration to use.+                       -> Prioritized ty+mkPrioritizedTraversal scorefunc enum =+  let+    initial = (enum, 0)+    scored = (scorefunc initial, initial)+  in+    Prioritized { scoring = scorefunc, priHeap = Heap.singleton scored }++inverseDepth :: (Enumeration ty, Integer) -> Float+inverseDepth (enum, curr) =+  case numBranches enum of+    Just finitemax -> -(fromIntegral (length (prefix enum)) -+                        (fromIntegral curr / fromIntegral finitemax))+    Nothing -> -(fromIntegral (length (prefix enum)))++instance Traversal Prioritized where+  mkTraversal = mkPrioritizedTraversal inverseDepth++  getNext pri @ Prioritized { scoring = scorefunc, priHeap = heap } =+    case Heap.view heap of+      Just ((_, (enum, curr)), rest) ->+        case numBranches enum of+          -- For a leaf, produce a result+          Just 0 -> Just (fromPath enum [], prefix enum,+                          pri { priHeap = rest })+          -- If we're exhausting the current step, don't keep it in the heap+          Just high | curr + 1 >= high ->+            let+              newelem = (withPrefix enum [curr], 0)+              scored = (scorefunc newelem, newelem)+              withNew = Heap.insert scored rest+            in+              getNext pri { priHeap = withNew }+          -- Otherwise, insert the incremented current and the new+          -- branch into the heap.+          _ ->+            let+              newelem = (withPrefix enum [curr], 0)+              scored = (scorefunc newelem, newelem)+              increment = (enum, curr + 1)+              incscored = (scorefunc increment, increment)+              withNew = Heap.insert scored rest+              withInc = Heap.insert incscored withNew+            in+              getNext pri { priHeap = withInc }+      Nothing -> Nothing
+ src/Data/Enumeration/Traversal/Class.hs view
@@ -0,0 +1,51 @@+-- Copyright (c) 2014 Eric McCorkle.  All rights reserved.+--+-- Redistribution and use in source and binary forms, with or without+-- modification, are permitted provided that the following conditions+-- are met:+--+-- 1. Redistributions of source code must retain the above copyright+--    notice, this list of conditions and the following disclaimer.+--+-- 2. Redistributions in binary form must reproduce the above copyright+--    notice, this list of conditions and the following disclaimer in the+--    documentation and/or other materials provided with the distribution.+--+-- 3. Neither the name of the author nor the names of any contributors+--    may be used to endorse or promote products derived from this software+--    without specific prior written permission.+--+-- THIS SOFTWARE IS PROVIDED BY THE AUTHORS AND CONTRIBUTORS ``AS IS''+-- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A+-- PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+-- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+-- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF+-- USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND+-- ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+-- OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT+-- OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+-- SUCH DAMAGE.+{-# OPTIONS_GHC -Wall -Werror #-}++-- | Definition of a class for traversals.+module Data.Enumeration.Traversal.Class(+       Traversal(..)+       ) where++import Data.Enumeration++-- | A typeclass representing a traversal scheme over an enumeration.+class Traversal trav where+  -- | Create a @Traversal@ from an @Enumeration@.+  mkTraversal :: Enumeration ty -> trav ty+  -- | Get the next item in the traversal.+  getNext :: trav ty -> Maybe (ty, Path, trav ty)++  -- | Get all items in the traversal as a list.+  getAll :: trav ty -> [(ty, Path)]+  getAll trav =+    case getNext trav of+      Just (item, path, next) -> (item, path) : getAll next+      Nothing -> []
+ test/UnitTest.hs view
@@ -0,0 +1,43 @@+-- Copyright (c) 2014 Eric McCorkle.  All rights reserved.+--+-- Redistribution and use in source and binary forms, with or without+-- modification, are permitted provided that the following conditions+-- are met:+--+-- 1. Redistributions of source code must retain the above copyright+--    notice, this list of conditions and the following disclaimer.+--+-- 2. Redistributions in binary form must reproduce the above copyright+--    notice, this list of conditions and the following disclaimer in the+--    documentation and/or other materials provided with the distribution.+--+-- 3. Neither the name of the author nor the names of any contributors+--    may be used to endorse or promote products derived from this software+--    without specific prior written permission.+--+-- THIS SOFTWARE IS PROVIDED BY THE AUTHORS AND CONTRIBUTORS ``AS IS''+-- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A+-- PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+-- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+-- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF+-- USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND+-- ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+-- OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT+-- OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+-- SUCH DAMAGE.++module Main(main) where++import Test.HUnitPlus++import qualified Tests.Data as Data++tests = [ Data.tests ]++testsuite = TestSuite { suiteName = "UnitTests", suiteConcurrently = True,+                        suiteTests = tests, suiteOptions = [] }++main :: IO ()+main = createMain [testsuite]