diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,5 @@ +# Revision history for data-list-zigzag + +## 0.1.0.0 -- 2017-04-27 + +* First version. Released on an unsuspecting world. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2017, Eric Brisco + +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 Eric Brisco nor the names of other + 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 +OWNER 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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/data-list-zigzag.cabal b/data-list-zigzag.cabal new file mode 100644 --- /dev/null +++ b/data-list-zigzag.cabal @@ -0,0 +1,36 @@ +-- Initial data-list-zigzag.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/ + +name: data-list-zigzag +version: 0.1.0.0 +synopsis: A list but with a balanced enumeration of Cartesian product. +description: A list but with a balanced enumeration of Cartesian product. +homepage: https://github.com/erisco/data-list-zigzag +license: BSD3 +license-file: LICENSE +author: Eric Brisco +maintainer: eric.brisco@gmail.com +copyright: Copyright (c) 2017, Eric Brisco +category: Data +build-type: Simple +extra-source-files: ChangeLog.md +cabal-version: >=1.10 + +library + + exposed-modules: Data.List.ZigZag + + build-depends: base >=4.9 && <4.10 + + hs-source-dirs: src + + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/erisco/data-list-zigzag + +source-repository this + type: git + location: https://github.com/erisco/data-list-zigzag + tag: v0.1.0.0 diff --git a/src/Data/List/ZigZag.hs b/src/Data/List/ZigZag.hs new file mode 100644 --- /dev/null +++ b/src/Data/List/ZigZag.hs @@ -0,0 +1,358 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +-- | The feature of this module is 'ZigZag' and its class instances. It +-- is an abstract data type and can be constructed \/ deconstructed +-- by 'fromList' \/ 'toList' or 'fromDiagonals' \/ 'toDiagonals'. See the +-- associated documentation for more information. +-- +module Data.List.ZigZag + ( diagonals + , fromDiagonals + , fromList + , toDiagonals + , toList + , ZigZag() + ) + where +-- + +import Control.Applicative + ( Alternative(empty, (<|>)) + , Applicative(pure, (<*>)) + ) +-- + +import Control.Monad + ( ap + , join + , Monad(return, (>>=)) + , MonadPlus(mzero, mplus) + ) +-- + +import Data.Data + ( Data + ) +-- + +import Data.Foldable + ( concat + , Foldable + ) +-- + +import Data.List + ( transpose + , unzip + , (++) + ) +-- + +import Data.Maybe + ( catMaybes + , Maybe(Just, Nothing) + ) +-- + +import Data.Monoid + ( Monoid(mappend, mempty) + ) +-- + +import Data.Semigroup + ( Semigroup((<>)) + ) +-- + +import Data.Traversable + ( Traversable + ) +-- + +import Data.Typeable + ( Typeable + ) +-- + +import GHC.Base + ( Functor(fmap) + , (.) + ) +-- + +import GHC.Generics + ( Generic + , Generic1 + ) +-- + +import GHC.Read + ( Read + ) +-- + +import GHC.Show + ( Show(show) + ) +-- + +import Prelude + ( Eq + , Ord + ) +-- + +newtype Diagonal a = + Diagonal + { unDiagonal :: [a] + } + deriving + ( Alternative + , Applicative + , Data + , Eq + , Foldable + , Functor + , Generic + , Generic1 + , Monad + , MonadPlus + , Monoid + , Ord + , Read + , Semigroup + , Show + , Traversable + , Typeable + ) +-- + +-- NOTE: also defined in the "these" package but it has too many +-- irrelevant dependencies. +data These a b = + This a + | That b + | Both a b +-- + +-- | A list but with a balanced enumeration of Cartesian product such +-- that +-- +-- @ +-- fmap sum (sequence (replicate n (fromList [0..]))) +-- @ +-- +-- is monotonically increasing. +-- +-- Example: +-- +-- @ +-- sequence [fromList [0,1], fromList [0,1,2]] +-- = fromDiagonals +-- [ [[0,0]] +-- , [[1,0],[0,1]] +-- , [[1,1],[0,2]] +-- , [[1,2]] +-- ] +-- @ +-- +-- This variation is useful in at least two ways. One, it is not stuck +-- on infinite factors. Two, if the factors are ordered then the +-- product is similarly ordered; this can lend to efficient searching +-- of product elements. +-- +-- Note that this method fails for the infinitary product even if every +-- factor is known to be non-empty. The first element is known but +-- following it are infinite elements that each draw a second +-- element from one of the infinite factors. A product element drawing +-- a third factor element is never reached. +-- +newtype ZigZag a = + ZigZag + { unZigZag :: [Diagonal a] + } + deriving + ( Data + , Eq + , Foldable + , Functor + , Generic + , Generic1 + , Ord + , Read + , Traversable + , Typeable + ) +-- + +instance Alternative ZigZag where + empty = ZigZag empty + (<|>) (ZigZag xs) (ZigZag ys) = ZigZag (tie f xs ys) + where + f (Both x y) = x <|> y + f (This x) = x + f (That y) = y +-- + +instance Applicative ZigZag where + pure = return + (<*>) = ap +-- + +instance Monad ZigZag where + return = ZigZag . return . return + (>>=) (ZigZag xs) f = + ZigZag (fmap (join . Diagonal) (diagonals (fmap inner xs))) + where + inner = + fmap (Diagonal . concat) + . transpose + . unDiagonal + . fmap (fmap unDiagonal . unZigZag . f) +-- + +instance MonadPlus ZigZag where + mzero = empty + mplus = (<|>) +-- + +instance Monoid (ZigZag a) where + mempty = empty + mappend = (<|>) +-- + +instance Semigroup (ZigZag a) where + (<>) = mappend +-- + +instance Show a => Show (ZigZag a) where + show xs = "fromDiagonals " ++ show (toDiagonals xs) +-- + +-- | Finds the diagonals through a ragged list of lists. +-- +-- For example, the diagonals of: +-- +-- @ +-- [ [0,1,2] +-- , [] +-- , [3,4] +-- , [5,6,7] +-- ] +-- @ +-- +-- Are: +-- +-- @ +-- [ [0] +-- , [1] +-- , [3,2] +-- , [5,4] +-- , [6] +-- , [7] +-- ] +-- @ +-- +-- Which can be seen intuitively. +-- +-- This algorithm works by storing a list of tails of rows already +-- seen. To find the next diagonal we take the head of the next row +-- plus the head of each stored tail. The tail remainders are stored +-- plus the remainder of the new row. +-- +-- If there are no more rows but some remaining tails we then +-- iteratively form diagonals from the heads of each tail until there +-- are no tails remaining. +-- +-- Applied to the example: +-- +-- @ +-- Row | Output | Remaining +-- --------+--------+---------------- +-- [0,1,2] | [0] | [[1,2]] +-- [] | [1] | [[2]] +-- [3,4] | [3,2] | [[4]] +-- [5,6,7] | [5,4] | [[6,7]] +-- x | [6] | [[7]] +-- x | [7] | [] +-- @ +-- +diagonals :: [[a]] -> [[a]] +diagonals = h [] + where + h rem xxs = + let (heads, tails) = peel rem + in case xxs of + ((y:ys):xs) -> (y : heads) : h (ys : tails) xs + ([]:xs) -> heads : h tails xs + [] -> + case heads of + (_:_) -> heads : transpose tails + [] -> transpose tails + peel = unzip . catMaybes . fmap uncons +-- + +-- | Convert a list of diagonals to a ZigZag. +-- +-- @ +-- fromDiagonals . toDiagonals = id +-- toDiagonals . fromDiagonals = id +-- @ +-- +fromDiagonals :: [[a]] -> ZigZag a +fromDiagonals = ZigZag . fmap Diagonal + +-- | Convert a list to a ZigZag. +-- +-- @ +-- fromList . toList = id +-- toList . fromList = id +-- @ +-- +fromList :: [a] -> ZigZag a +fromList = ZigZag . fmap (Diagonal . return) + +-- | Zips up to the longest list rather than 'GHC.List.zip' which zips +-- up to the shortest list. +-- +-- Example: +-- +-- @ +-- tie id [1] [3,4] = [Both 1 3, That 4] +-- @ +-- +tie :: (These a b -> c) -> [a] -> [b] -> [c] +tie f (x:xs) (y:ys) = f (Both x y) : tie f xs ys +tie f (x:xs) [] = f (This x) : tie f xs [] +tie f [] (y:ys) = f (That y) : tie f [] ys +tie f [] [] = [] + +-- | Convert a ZigZag to a list of diagonals. +-- +-- @ +-- fromDiagonals . toDiagonals = id +-- toDiagonals . fromDiagonals = id +-- @ +-- +toDiagonals :: ZigZag a -> [[a]] +toDiagonals = fmap unDiagonal . unZigZag + +-- | Convert a ZigZag to a list. +-- +-- @ +-- fromList . toList = id +-- toList . fromList = id +-- @ +-- +toList :: ZigZag a -> [a] +toList = concat . fmap unDiagonal . unZigZag + +-- | Undo '(:)'. +-- +uncons :: [a] -> Maybe (a, [a]) +uncons (x:xs) = Just (x, xs) +uncons [] = Nothing