如何根据运行时值创建有界实例？

Question

我一直在玩O'Connor基于* -semirings的matrix实现，为图算法提供了非常巧妙的解决方案：

import Data.Array
newtype Matrix i e = Matrix (Array (i,i) e)

matrix :: (Ix i, Bounded i) => ((i,i) -> e) -> Matrix i e
matrix f = Matrix . listArray (minBound, maxBound) . map f $ entireRange

但是，我想从外部世界的文件中读取任意大小的邻接矩阵，因此使用枚举类型（矩阵被索引）（如同一篇文章中的Matrix Node :: Matrix Node2 (Maybe Integer)）不会真的对我有用。

我的第一个想法是

toMatrix :: [[a]] -> Matrix Int a
toMatrix list = Matrix (listArray ((0,0),(l-1,l-1)) $ concat list)
  where l = length list

但当然这也不起作用：当各种类型类实例尝试访问索引(minBound :: Int, minBound :: Int)时，尝试实际使用此矩阵会爆炸。

使用类似

的大小参数化矩阵类型

newtype Matrix i e = Matrix i (Array (i,i) e)

也不能正常工作：虽然我可以通过这种方式更改matrix函数来构建矩阵，但现在我无法为pure实例编写Applicative (Matrix i e)或{{1}对于one实例，正确的Semiring (Matrix i e)取决于上下文中矩阵的大小。

从概念上讲，我可以想出两种方法：

1. 定义一个新的one :: Matrix i e类型，其中BoundedInt实例可以在我们知道数组大小时在运行时设置，或者
2. 找到一种方法来声明在矩阵大小上参数化的Bounded实例。

但是我不知道如何实现其中任何一个，围绕这个主题的搜索似乎变得非常复杂。 This问题看起来也很相似，但我认为它不会解决问题（尽管它会让我在固定Applicative (Matrix i e)大小的矩阵上使用Bounded i构造函数。）

这里最简单的解决方案是什么？有没有必须学习如何使用单例库/某种依赖类型？

Answer 1

我写了一篇关于 Hasochism 的Matrix的{​​{1}}实例的长答案，使用有限集作为索引类型，但它可能有点过分了你想要的，更不用说博客文章中基于Applicative的代码效率低了。

你的问题源于这样一个事实：博客文章代码中的各种操作都假设矩阵索引类型的Array实例是覆盖，从界限内的每个值开始将在矩阵中具有相应的元素。核心假设似乎是矩阵的大小是静态已知的。

解决此问题的最简单方法是对Bounded类型进行调整，以便使用它来调整其大小。你仍然需要动态地检查所有边界，但我认为与Hasochism方法的权重相比，这是一个相当不错的权衡。

Matrix

但是，当您需要在类型类实例中构造矩阵时，这会卡住。您无法通过运行时值抽象实例：实例声明中-- Bounded as an explicit (minBound, maxBound) tuple type Bounds i = (i, i) data Matrix i e = Matrix { getBounds :: Bounds i, getMatrix :: Array (Edge i) e } entireRange :: Ix i => Bounds i -> [i] entireRange b = range b matrix :: Ix i => Bounds i -> (Edge i -> e) -> Matrix i e matrix bounds f = Matrix bounds $ listArray bounds $ map f $ entireRange bounds 左侧唯一有效的是另一个类型类约束。在像

这样的声明中

=>

我们别无选择，只能在实例字典中静态传递边界，因为instance Bounded i => Applicative (Matrix i) where pure x = matrix (const x) (<*>) = -- ... 的类型不允许我们传递显式配置数据。 This restriction has its ups and downs，但是现在它确实是一个明确的挫折：修复是完全从你的代码中删除所有的经典性。

好消息是：你可以使用疯狂的reflection库来模拟这种显式的字典传递方式，这种方法可以将运行时值推送到类型字典中。这是可怕的东西，但它确实有效，而且它是安全的。

这一切都发生在reify和reflect组合中。 pure获取运行时值和带有约束的代码块，具体取决于该值的可用性并将它们相互插入。在块内调用reify会返回传递给它之外的reflect的值。

reify

花一点时间来反思（哈哈）这是多么奇怪。通常，每种类型的范围内只有一个类字典（尽管有重叠的实例）。 needsAnInt :: Reifies s Int => Proxy s -> IO () needsAnInt p = print (reflect p + 1) example1 :: IO () example1 = reify 3 (\p -> needsAnInt p) -- prints 4 example2 :: IO () example2 = reify 5 (\p -> needsAnInt p) -- prints 6 只有一个值（Proxy），那么data Proxy a = Proxy如何区分两个代理，每次都返回不同的值？

无论如何，这有什么意义？实例不能依赖于运行时值，但它们可以依赖于其他实例。 reflect为我们提供了将运行时值转换为实例字典的工具，因此这允许我们构建动态依赖于运行时值的实例！

在这种情况下，我们正在构建reflection的实例。我们需要一个Bounded来创建一个与其他实例不重叠的实例：

newtype

显然-- in this case it's fine to just lift the Ix instance from the underlying type newtype B s i = B i deriving (Eq, Ord, Ix) 可以是B的实例，如果Bounded是 - 它可以从i的实例获得minBound和maxBound - 但我们希望从i上下文中获取它们。换句话说，我们将填入Reifies字典的运行时值将是一对Reifies s。

i

我正在使用instance Reifies s (i, i) => Bounded (B s i) where minBound = B $ fst $ reflect (Proxy :: Proxy s) maxBound = B $ snd $ reflect (Proxy :: Proxy s) 来提出正确类型的ScopedTypeVariables值。

现在你可以编写使用Proxy上下文的完美普通代码（即使由于某些其他实例而出现该上下文），并使用Bounded动态构建的Bounded字典来调用它}。

reify

嗯，是的使用entireRange :: (Ix i, Bounded i) => [i] entireRange = range (minBound, maxBound) example3 :: IO () example3 = reify (3, 6) myComputation where myComputation :: forall s. Bounded (B s Int) => Proxy s -> IO () myComputation p = print $ map unB (entireRange :: [B s Int]) ghci> example3 [3,4,5,6] 可能很棘手。在一天结束时，只要不打扰课程就可能更简单。

Answer 2

今天在英国的银行假期，所以我有时间完成关于静态大小矩阵的答案。我不一定会建议在生产中这样做 - 即使不考虑代码是多么愚蠢，如果你想在真实的硬件上做有效的线性代数，这是一个可怕的矩阵表示 - 但它＆ ＃39;有点玩得很开心。

来自Hasochism：

-- Natural numbers and their singletons in explicit and implicit varieties
data Nat = Z | S Nat  -- page 2 of the paper
intToNat :: Int -> Maybe Nat  -- paraphrased from page 10
intToNat n
    | n < 0     = Nothing
    | n == 0    = Just Z
    | otherwise = S <$> intToNat (n-1)
data Natty n where  -- page 2
    Zy :: Natty Z
    Sy :: Natty n -> Natty (S n)
-- page 3
class NATTY n where
    natty :: Natty n
instance NATTY Z where
    natty = Zy
instance NATTY n => NATTY (S n) where
    natty = Sy natty

-- turn an explicit Natty into an implicit one
natter :: Natty n -> (NATTY n => r) -> r  -- page 4
natter Zy r = r
natter (Sy n) r = natter n r

-- vectors, matrices in row-major order
data Vec n a where  -- page 2
    V0 :: Vec Z a
    (:>) :: a -> Vec n a -> Vec (S n) a
newtype Mat w h a = Mat { unMat :: Vec h (Vec w a) }  -- page 4

-- vector addition, in the form of an Applicative instance
vcopies :: Natty n -> a -> Vec n a  -- page 4
vcopies Zy x = V0
vcopies (Sy n) x =  :> vcopies n x
vapp :: Vec n (a -> b) -> Vec n a -> Vec n b  -- page 4
vapp V0 V0 = V0
vapp (f :> fs) (x :> xs) = f x :> vapp fs xs
instance NATTY n => Applicative (Vec n) where  -- page 4
    pure = vcopies natty
    (<*>) = vapp

-- iterating vectors
instance Traversable (Vec n) where  -- page 4
    traverse f V0 = pure V0
    traverse f (x :> xs) = liftA2 (:>) (f x) (traverse f xs)
instance Foldable (Vec n) where  -- page 4
    foldMap = foldMapDefault
instance Functor (Vec n) where  -- page 4
    fmap = fmapDefault

transpose :: NATTY w => Mat w h a -> Mat h w a  -- page 4
transpose = Mat . sequenceA . unMat

我冒昧重新命名作者＆＃39; Matrix键入Mat，重新排列其类型参数，并将其从GADT更改为新类型。请原谅我跳过上述的解释 - 本文比我做得更好，我想谈谈我回答你问题的部分。

Mat w h是h - w - 向量的向量。它是两个Vec仿函数的type-level composition。其实现矩阵添加的Applicative实例反映了该结构，

instance (NATTY w, NATTY h) => Applicative (Mat w h) where
    pure = Mat . pure . pure
    Mat fss <*> Mat xss = Mat $ liftA2 (<*>) fss xss

与Traversable实例一样。

instance Traversable (Mat w h) where
    traverse f = fmap Mat . traverse (traverse f) . unMat
instance Foldable (Mat w h) where
    foldMap = foldMapDefault
instance Functor (Mat w h) where
    fmap = fmapDefault

我们还需要一些设备来处理矢量索引。要识别n - 向量中的特定元素，您必须提供小于n的数字。

data Fin n where
    FZ :: Fin (S n)
    FS :: Fin n -> Fin (S n)

类型Fin n具有完全n个元素，因此Fin是有限集的系列。类型Fin n的值在结构上是自然数小于n（将FS FZ与S Z进行比较），因此FS FZ :: Fin (S (S Z))或FS FZ :: Fin (S (S (S Z)))，但是FS FZ :: Fin (S Z)将无法输入支票。

这是一个更高阶的函数，它构建一个包含其参数的所有可能结果的向量。

tabulate :: Natty n -> (Fin n -> a) -> Vec n a
tabulate Zy f = V0
tabulate (Sy n) f = f FZ :> tabulate n (f . FS)

现在我们可以开始使用semirings了。取两个向量的点积包括将它们的元素相乘，然后对结果求和。

dot :: Semiring a => Vec n a -> Vec n a -> a
dot xs ys = foldr (<+>) zero $ vapp (fmap (<.>) xs) ys

这里的矢量除了指定的索引外，到处都是zero。

oneAt :: Semiring a => Natty n -> Fin n -> Vec n a
oneAt (Sy n) FZ = one :> vcopies n zero
oneAt (Sy n) (FS f) = zero :> oneAt n f

我们将oneAt和tabulate用于制作单位矩阵。

type Square n = Mat n n

identity :: Semiring a => Natty n -> Square n a
identity n = Mat $ tabulate n (oneAt n)

ghci> identity (Sy (Sy Zy)) :: Square (S (S Z)) Int
Mat {unMat = (1 :> (0 :> V0)) :> ((0 :> (1 :> V0)) :> V0)}
-- ┌      ┐
-- │ 1, 0 │
-- │ 0, 1 │
-- └      ┘

并且transpose对矩阵乘法很有用。

mul :: (NATTY w, Semiring a) => Mat r h a -> Mat w r a -> Mat w h a
mul m n =
    let mRows = unMat m
        nCols = unMat $ transpose n
    in Mat $ fmap (\r -> dot r <$> nCols) mRows

ghci> let m = Mat $ (1 :> 2 :> V0) :> (3 :> 4 :> V0) :> V0 :: Square (S (S Z)) Int in mul m m
Mat {unMat = (7 :> (10 :> V0)) :> ((15 :> (22 :> V0)) :> V0)}
-- ┌      ┐2   ┌        ┐
-- │ 1, 2 │  = │  7, 10 │
-- │ 3, 4 │    │ 15, 22 │
-- └      ┘    └        ┘

这样，方形矩阵的Semiring实例已排序。呼！

instance (NATTY n, Semiring a) => Semiring (Square n a) where
    zero = pure zero
    (<+>) = liftA2 (<+>)
    one = identity natty
    (<.>) = mul

有关此实现的注意事项是zero和one动态构建静态已知大小的矩阵，通常基于呼叫站点的上下文类型信息。他们从Natty字典中获取该大小的运行时表示（NATTY），阐述者根据矩阵的推断类型构建该字典。

这是一种完全不同于reflection库（我在my other answer中概述）的方法。 reflection是关于将显式运行时值填充到隐式实例字典中，而这种样式获取的信息本来只能在运行时知道 - 矩阵的大小 - 并使其成为静态，使用单例来提供类型信息价值世界。当然，一种真正依赖类型的语言将省略Natty仪式：n将是一个普通的旧值，我们可以直接使用它，而不必通过隐藏在实例字典中的单例。

我会把Kleene代数留给你，因为我很懒，我想继续讨论根据运行时输入合成类型信息的问题。

当我们不了解静态大小时，我们如何使用这些静态大小的矩阵？您提到您的程序会询问用户图表的大小（因此用于表示图形的邻接矩阵有多大）。因此，用户键入一个数字（Nat - 值，而不是Nat - 类型）我们以某种方式预期会静态地知道用户要键入的内容？

诀窍是编写与矩阵大小值无关的代码块。然后，无论输入是什么，只要它是一个自然数，我们就知道该代码块将起作用。我们可以使用更高级别的类型强制函数变为多态。

withNatty :: Nat -> (forall n. Natty n -> r) -> r
withNatty Z r = r Zy
withNatty (S n) r = withNatty n (r . Sy)

withNatty n r将函数r应用于自然数n的单例表示。 r在运行时提供Natty n，因此它可以通过匹配n的模式恢复Natty的静态知识，但n无法泄漏到街区外面。 （你也可以使用 Hasochism 中简要介绍的存在量化来包装Natty并传递它。它相同的东西。）

因此，例如，假设我们要打印动态确定大小的单位矩阵：

main = do
    Just size <- fmap intToNat readLn
    withNatty size (print . mkIdentity)
        where mkIdentity :: Natty n -> Square n Int
              mkIdentity n = natter n one

ghci> main
4
Mat {unMat = (1 :> (0 :> (0 :> (0 :> V0)))) :> ((0 :> (1 :> (0 :> (0 :> V0)))) :> ((0 :> (0 :> (1 :> (0 :> V0)))) :> ((0 :> (0 :> (0 :> (1 :> V0)))) :> V0)))}

如果您想要从列表列表构建矩阵，则应用相同的技术。这次它有点棘手，因为你必须通过测量它们来向GHC证明所有列表具有相同的长度。

withVec :: [a] -> (forall n. NATTY n => Vec n a -> r) -> r
withVec [] r = r V0
withVec (x:xs) r = withVec xs (r . (x :>))


-- this operation can fail because the input lists may not all be the same length
withMat :: [[a]] -> (forall w h. (NATTY w, NATTY h) => Mat w h a -> r) -> Maybe r
withMat xss r = assertEqualLengths xss (\vs -> withVec vs (r . Mat))
    where assertEqualLengths :: [[a]] -> (forall n. NATTY n => [Vec n a] -> r) -> Maybe r
          assertEqualLengths [] r = Just (r noVecs)
          assertEqualLengths xss@(xs:_) r = withLen xs (\n -> natter n $ r <$> traverse (assertLength n) xss)

          noVecs :: [Vec Z a]
          noVecs = []

          assertLength :: Natty n -> [a] -> Maybe (Vec n a)
          assertLength Zy [] = Just V0
          assertLength (Sy n) (x:xs) = fmap (x :>) (assertLength n xs)
          assertLength _ _ = Nothing

          withLen :: [a] -> (forall n. Natty n -> r) -> r
          withLen [] r = r Zy
          withLen (x:xs) r = withLen xs (r . Sy)

ghci> withMat [[1,2], [3,4]] show
Just "Mat {unMat = (1 :> (2 :> V0)) :> ((3 :> (4 :> V0)) :> V0)}"
ghci> withMat [[1,2], [3]] show  -- a ragged input list
Nothing

如果你想使用方形矩阵，你必须向GHC证明矩阵的高度等于它的宽度。

withEqual :: Natty n -> Natty m -> (n ~ m => r) -> Maybe r
withEqual Zy Zy r = Just r
withEqual (Sy n) (Sy m) r = withEqual n m r
withEqual _ _ _ = Nothing

square :: Natty w -> Natty h -> Mat w h a -> Maybe (Square w a)
square = withEqual