间隔为键的类似地图的容器和类似zip的合并操作

时间:2018-07-24 11:14:24

标签: haskell containers intervals

我正在寻找一种使用间隔作为键的类似Data.Map的Haskell容器类型,其中最左边和最右边的键也可以是无界的间隔,但是不重叠。此外,容器应支持类似于zipWith的功能,该功能允许将两个键集的交集用作新键集,并将两个值集的按位组合的参数函数合并到一个新容器中

已经有一些软件包提供基于间隔的映射。我看过IntervalMapfingertreeSegmentTree,但是这些软件包似乎都不提供所需的组合功能。它们似乎都使用了相交函数的间隔,在两个图中都是等于,而我需要一个版本,可以根据需要将间隔分解为较小的间隔。

容器基本上应该为格式为Ord k => k -> Maybe a的键/值序列提供有效且可存储的映射,即仅在特定间隔上定义的函数或具有较大间隔的函数映射到相同值。

这是一个演示该问题的小例子:

... -4 -3 -2 -1  0  1  2  3  4  ...  -- key set
-----------------------------------
... -1 -1 -1 -1  0  1  1  1  1  ...  -- series corresponding to signum
...  5  5  5  5  5  5  5  5  5  ...  -- series corresponding to const 5

第一个系列可以通过映射[-infinity, -1] -> -1; [0, 0] -> 0; [1, infinity] -> 1高效地表达,第二个系列可以通过[-infinity, infinity] -> 5来表达。现在将(*)作为组合函数应用组合函数应该给出一个新的序列

... -4 -3 -2 -1  0  1  2  3  4  ...  -- key set
-----------------------------------
... -5 -5 -5 -5  0  5  5  5  5  ...  -- combined series

这里的关键点-并且所有上述软件包似乎都不能做到这一点-是,当结合这两个系列的密钥集时,还必须考虑到不同的值。这两个系列都涵盖了[-infinity, infinity]的全部范围,但是有必要将其分为最后一部分的三部分。

还有一些用于间隔工作的软件包,例如range程序包,它还提供间隔列表上的相交操作。但是,我没有找到一种将其与Map变体结合使用的方法,因为在使用它们进行计算时,它会折叠相邻区间。

NB:这样的容器有点像ZipList,它延伸到双方,因此我认为也有可能为其定义合法的Applicative实例,其中{{ 1}}对应于上述组合功能。

长话短说,是否已经有提供这种容器的包装?还是有使用现有软件包构建软件包的简便方法?

1 个答案:

答案 0 :(得分:0)

如B. Mehta所建议,上述评论中最好的建议似乎是step-function软件包。我还没有尝试过该程序包,但是看起来好像是在寻找那种SF类型的包装程序。


与此同时,我实现了另一个我想分享的解决方案。合并功能的代码(以下代码中的{combineAscListWith)有点笨拙,因为它比获取两个地图的交点更通用,所以我将概述一下:

首先,我们需要一个带有Interval实例的Ord类型,该实例存储成对的Val a值对,它们可以是-infinity,一些x或+ infinity。我们可以构建IntervalMap的形式,它只是将这些间隔映射到最终值的普通Map

当通过交集组合两个这样的IntervalMaps时,我们首先将地图转换为键/值对的列表。接下来,我们并行遍历两个列表,将两个列表压缩为与最终交点图相对应的另一个列表。组合列表元素时主要有两种情况:

  1. 两个最左边的间隔都从相同的值开始。在那种情况下,我们发现一个实际上重叠/相交的区间。我们将较长的时间间隔裁剪为较短的时间间隔,并使用与这两个时间间隔关联的值来获取结果值,该值现在与较短的时间间隔一起进入结果列表。较长的时间间隔的其余部分将返回到输入列表。
  2. 一个间隔的开始值比另一个间隔小,这意味着我们发现两个序列的一部分不重叠。因此,对于相交,可以区分区间的所有非重叠部分(甚至整个区间)。其余的(如果有)返回到输入列表。

为完整起见,这是完整的示例代码。同样,代码很笨拙。基于步进函数的实现肯定会更优雅。

import           Control.Applicative
import           Data.List
import qualified Data.Map as Map


data Val a = NegInf | Val a | Inf deriving (Show, Read, Eq, Ord)

instance Enum a => Enum (Val a) where
    succ v = case v of
        NegInf -> NegInf
        Val x  -> Val $ succ x
        Inf    -> Inf
    pred v = case v of
        NegInf -> NegInf
        Val x  -> Val $ pred x
        Inf    -> Inf
    toEnum = Val . toEnum
    fromEnum (Val x) = fromEnum x


data Interval a = Interval { lowerBound :: Val a, upperBound :: Val a } deriving (Show, Read, Eq)

instance Ord a => Ord (Interval a) where
    compare ia ib = let (a, a') = (lowerBound ia, upperBound ia)
                        (b, b') = (lowerBound ib, upperBound ib)
                    in  case () of
                            _ | a' < b             -> LT
                            _ | b' < a             -> GT
                            _ | a == b && a' == b' -> EQ
                            _ -> error "Ord.Interval.compare: undefined for overlapping intervals"


newtype IntervalMap i a = IntervalMap { unIntervalMap :: Map.Map (Interval i) a }
                          deriving (Show, Read)

instance Functor (IntervalMap i) where
    fmap f = IntervalMap . fmap f . unIntervalMap

instance (Ord i, Enum i) => Applicative (IntervalMap i) where
    pure = IntervalMap . Map.singleton (Interval NegInf Inf)
    (<*>) = intersectionWith ($)


intersectionWith :: (Ord i, Enum i) => (a -> b -> c)
                 -> IntervalMap i a -> IntervalMap i b -> IntervalMap i c
intersectionWith f = combineWith (liftA2 f)

combineWith :: (Ord i, Enum i) => (Maybe a -> Maybe b -> Maybe c)
            -> IntervalMap i a -> IntervalMap i b -> IntervalMap i c
combineWith f (IntervalMap mpA) (IntervalMap mpB) =
    let cs = combineAscListWith f (Map.toAscList mpA) (Map.toAscList mpB)
    in IntervalMap $ Map.fromList [ (i, v) | (i, Just v) <- cs ]

combineAscListWith :: (Ord i, Enum i) => (Maybe a -> Maybe b -> c)
            -> [(Interval i, a)] -> [(Interval i, b)] -> [(Interval i, c)]
combineAscListWith f as bs = case (as, bs) of
    ([], _) -> map (\(i, v) -> (i, f Nothing (Just v))) bs
    (_, []) -> map (\(i, v) -> (i, f (Just v) Nothing)) as
    ((Interval a a', va) : as', (Interval b b', vb) : bs')
        | a == b -> case () of
            _ | a' == b' -> (Interval a a', f (Just va) (Just vb)) : combineAscListWith f as' bs'
            _ | a' < b'  -> (Interval a a', f (Just va) (Just vb)) : combineAscListWith f as' ((Interval (succ a') b', vb) : bs')
            _ | a' > b'  -> (Interval a b', f (Just va) (Just vb)) : combineAscListWith f ((Interval (succ b') a', va) : as') bs'
        | a < b  -> case () of
            _ | a' < b   -> ((Interval a a', f (Just va) Nothing)) :
                (if succ a' == b then id else ((Interval (succ a') (pred b), f Nothing Nothing) :)) (combineAscListWith f as' bs)
            _ | True     -> (Interval a (pred b), f (Just va) Nothing) : combineAscListWith f ((Interval b a', va) : as') bs
        | a > b  -> case () of
            _ | b' < a   -> ((Interval b b', f Nothing (Just vb))) :
                (if succ b' == a then id else ((Interval (succ b') (pred a), f Nothing Nothing) :)) (combineAscListWith f as bs')
            _ | True     -> (Interval b (pred a), f Nothing (Just vb)) : combineAscListWith f as ((Interval a b', vb) : bs')


showIntervalMap :: (Show i, Show a, Eq i) => IntervalMap i a -> String
showIntervalMap = intercalate "; " . map (\(i, v) -> showInterval i ++ " -> " ++ show v)
    . Map.toAscList . unIntervalMap
    where
        showInterval (Interval (Val a) (Val b)) | a == b = "[" ++ show a ++ "]"
        showInterval (Interval a b) = "[" ++ showVal a ++ " .. " ++ showVal b ++ "]"
        showVal NegInf  = "-inf"
        showVal (Val x) = show x
        showVal Inf     = "inf"

main :: IO ()
main = do
    let signumMap = IntervalMap $ Map.fromList [(Interval NegInf (Val $ -1), -1),
            (Interval (Val 0) (Val 0), 0), (Interval (Val 1) Inf, 1)]
    putStrLn $ showIntervalMap $ (*) <$> signumMap <*> pure 5