Using inductively defined applicative instances for safe type vectors

I am trying to write Categoryvector spaces (finite-dimensional free) but I cannot convince the GHC that any indexed length vector matters Applicative,

here's what i have:

{-# LANGUAGE DataKinds, PolyKinds, MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, FlexibleContexts, GADTs, DeriveTraversable, StandaloneDeriving #-}

-- | Quick(slow) and dirty typesafe vectors
module Vector where
import Control.Category

Vectors are lists with a length parameter

data Natural = Z | S Natural
data Vec (n :: Natural) a where
  VNil :: Vec Z a
  VCons :: a -> Vec n a -> Vec (S n) a
deriving instance Functor (Vec n)
deriving instance Foldable (Vec n)
deriving instance Traversable (Vec n)

To get a category, we need matrix multiplication. The obvious implementation makes indexes a bit backward from what we usually want.

vmult :: Num a => Vec i (Vec k a) -> Vec j (Vec k a) -> Vec j (Vec i a)
--                    ^      ^           ^      ^           ^      ^
vmult _ VNil = VNil
vmult xs (VCons y ys) = VCons (dotProduct y <$> xs) $ vmult xs ys

dotProduct :: Num a => Vec n a -> Vec n a -> a
dotProduct VNil VNil = 0
dotProduct (VCons x xs) (VCons y ys) = x * y + dotProduct xs ys

EDIT

using @Probie help , I was able to solve an earlier problem, which is enough to define an instance for Semigroupoids

data KNat n where
  KZ :: KNat Z
  KS :: Finite n => KNat n -> KNat (S n)

class Finite (a :: Natural) where toFNat :: proxy a -> KNat a
instance Finite Z where toFNat _ = KZ
instance Finite n => Finite (S n) where toFNat _= KS (toFNat (Proxy :: Proxy n))

instance Finite n => Applicative (Vec n) where
  pure :: forall a. a -> Vec n a
  pure x = go (toFNat (Proxy :: Proxy n))
    where
      go :: forall (m :: Natural). KNat m -> Vec m a
      go KZ = VNil
      go (KS n) = VCons x $ go n

  (<*>) :: forall a b. Vec n (a -> b) -> Vec n a -> Vec n b
  nfs <*> nxs = go (toFNat (Proxy :: Proxy n)) nfs nxs
    where
      go :: forall (m :: Natural). KNat m -> Vec m (a -> b) -> Vec m a -> Vec m b
      go KZ VNil VNil = VNil
      go (KS n) (VCons f fs) (VCons x xs) = VCons (f x) (go n fs xs)

data Matrix a i j where
  Matrix :: (Finite i, Finite j) => Vec i (Vec j a) -> Matrix a i j

instance Num a => Semigroupoid (Matrix a) where
  Matrix x `o` Matrix y = Matrix (vmult (sequenceA x) y)

but I ran into a similar problem as before when defining Category.id:

instance Num a => Category (Matrix a) where
  (.) = o
  id :: forall (n :: Natural). Matrix a n n
  id = Matrix (go (toFNat (Proxy :: Proxy n)))
    where
      go :: forall (m :: Natural). (KNat m) -> Vec m (Vec m a)
      go KZ = VNil
      go (KS n) = VCons (VCons 1 (pure 0)) (VCons 0 <$> go n)

, Applicative (Vec n) , Finite n.

src/Vector.hs:59:8: error:
    • Could not deduce (Finite n) arising from a use of ‘Matrix’
      from the context: Num a
        bound by the instance declaration at src/Vector.hs:56:10-37
      Possible fix:
        add (Finite n) to the context of
          the type signature for:
            Control.Category.id :: forall (n :: Natural). Matrix a n nIn the expression: Matrix (go (toFNat (Proxy :: Proxy n)))
      In an equation for ‘Control.Category.id’:
          Control.Category.id
            = Matrix (go (toFNat (Proxy :: Proxy n)))
            where
                go :: forall (m :: Natural). (KNat m) -> Vec m (Vec m a)
                go KZ = VNil
                go (KS n) = VCons (VCons 1 (pure 0)) (VCons 0 <$> go n)
      In the instance declaration forCategory (Matrix a)’
   |
59 |   id = Matrix (go (toFNat (Proxy :: Proxy n)))
   |        ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

, .

end edits


. , , Vec n Applicative

instance Applicative (Vec Z) where
  pure _ = VNil
  _ <*> _ = VNil
instance Applicative (Vec n) => Applicative (Vec (S n)) where
  pure a = VCons a $ pure a
  VCons f fs <*> VCons x xs = VCons (f x) (fs <*> xs)

, a ...

data Matrix a i j where
  Matrix :: Vec i (Vec j a) -> Matrix a i j

, ...

instance Num a => Category (Matrix a) where
  Matrix x . Matrix y = Matrix $ (vmult (sequenceA x) y)
--                                       ^^^^^^^^^

:

src/Vector.hs:36:42: error:
    • Could not deduce (Applicative (Vec c))
        arising from a use of ‘sequenceA’
      from the context: Num a
        bound by the instance declaration at src/Vector.hs:35:10-37In the first argument of ‘vmult’, namely ‘(sequenceA x)’
      In the second argument of ‘($)’, namely ‘(vmult (sequenceA x) y)’
      In the expression: Matrix $ (vmult (sequenceA x) y)
   |
36 |   Matrix x . Matrix y = Matrix $ (vmult (sequenceA x) y)
   |                                          ^^^^^^^^^^^
+4
2

Haskell, -, . , , , , ...

, -, , , Vector. ( , , Finite, , , )

{-# LANGUAGE DataKinds, PolyKinds, MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, FlexibleContexts, GADTs, DeriveTraversable, StandaloneDeriving, ScopedTypeVariables #-}

module Vector where
import Control.Category
import Data.Proxy

data Natural = Z | S Natural

data SNat n where
  SZ :: SNat Z
  SS :: Finite n => SNat n -> SNat (S n)

class Finite (a :: Natural) where
  toSNat :: proxy a -> SNat a

instance Finite Z where
  toSNat _ = SZ
instance (Finite a) => Finite (S a) where
  toSNat _ = SS (toSNat (Proxy :: Proxy a))

data Vec (n :: Natural) a where
  VNil :: Vec Z a
  VCons :: (Finite n) => a -> Vec n a -> Vec (S n) a

deriving instance Functor (Vec n)
deriving instance Foldable (Vec n)
deriving instance Traversable (Vec n)

instance (Finite n) => Applicative (Vec n) where
  pure (a :: a) = go (toSNat (Proxy :: Proxy n))
    where go :: forall (x :: Natural) . SNat x -> Vec x a
          go SZ = VNil
          go (SS m) = VCons a (go m)
  (fv :: Vec n (a -> b)) <*> (xv :: Vec n a) = go (toSNat (Proxy :: Proxy n)) fv xv
    where go :: forall (x :: Natural) . SNat x -> Vec x (a -> b) -> Vec x a -> Vec x b
          go SZ VNil VNil = VNil
          go (SS m) (VCons f fs) (VCons x xs) = VCons (f x) (go m fs xs)

vmult :: Num a => Vec i (Vec k a) -> Vec j (Vec k a) -> Vec j (Vec i a)
vmult _ VNil = VNil
vmult xs (VCons y ys) = VCons (dotProduct y <$> xs) $ vmult xs ys

dotProduct :: Num a => Vec n a -> Vec n a -> a
dotProduct VNil VNil = 0
dotProduct (VCons x xs) (VCons y ys) = x * y + dotProduct xs ys

data Matrix a i j where
  Matrix :: (Finite i, Finite j) => Vec i (Vec j a) -> Matrix a i j

instance Num a => Category (Matrix a) where
  Matrix x . Matrix y = Matrix $ (vmult (sequenceA x) y)

: Matrix . - forall (n :: Natural) . Matrix a n n

, Haskell Any, Matrix a Any Any, , "true" Natural s, , , forall (n :: Natural) . Finite n => Matrix a n n , ,

+2

, ( ), .

Finite , ... , , .

vdiag :: forall a i j. a -> a -> a -> KNat i -> KNat j -> Vec i (Vec j a)
vdiag u d l = go
  where
    go :: forall i' j'. KNat i' -> KNat j' -> Vec i' (Vec j' a)
    go (KS i) (KS j) =
      VCons (VCons d  $  vpure u j)
            (VCons l <$> go i j)
    go KZ _ = VNil
    go (KS i) KZ = vpure VNil (KS i)

vpure :: a -> KNat m -> Vec m a
vpure x KZ = VNil
vpure x (KS n) = VCons x $ vpure x n

, i j , Category.id ( , ). CPS ! Matrix a 2.

data Matrix a i j where
  DiagonalMatrix :: (Finite i => KNat i -> Vec i (Vec i a)) -> Matrix a i i
--                  ^^^^^^^^^                             ^
  Matrix :: (Finite i, Finite j) => Vec i (Vec j a) -> Matrix a i j

, , k :

instance Num a => Semigroupoid (Matrix a) where
  o :: forall a i j k. Num a => Matrix a k j -> Matrix a i k -> Matrix a i j
  Matrix x          `o` Matrix y          =
      Matrix (vmult (sequenceA   x                             )   y)
  DiagonalMatrix fx `o` Matrix y          =
      Matrix (vmult (sequenceA (fx (toFNat (Proxy :: Proxy k))))   y)
  Matrix x          `o` DiagonalMatrix fy = 
      Matrix (vmult (sequenceA   x                             ) (fy (toFNat (Proxy :: Proxy k))))

. , , , :

  DiagonalMatrix fx `o` DiagonalMatrix fy = DiagonalMatrix $ 
      \i -> vmult (sequenceA (fx i)) (fy i)

- CPS'ed Matrix . CPSing , , , . , , , - , .

, , id - CPS'd vdiag.

instance Num a => Category (Matrix a) where
  (.) = o
  id = DiagonalMatrix $ \i -> vdiag 0 1 0 i i

, Matrix a , , .

unMatrix :: (Finite i, Finite j) => Matrix a i j -> Vec i (Vec j a)
unMatrix (Matrix x) = x
unMatrix (DiagonalMatrix fx) = fx (toFNat (Proxy))

type Zero = Z
type One = S Z
type Two = S One
type Three = S Two
type Four = S Three

f :: Vec Two (Vec Three Int)
f = VCons (VCons 1 $ VCons 2 $ VCons 3 VNil)
  $ VCons (VCons 4 $ VCons 5 $ VCons 6 VNil)
  $ VNil

g :: Vec Four (Vec Two Int)
g = VCons (VCons 1 $ VCons 2 VNil)
  $ VCons (VCons 3 $ VCons 4 VNil)
  $ VCons (VCons 5 $ VCons 6 VNil)
  $ VCons (VCons 7 $ VCons 8 VNil)
  $ VNil

fg = unMatrix $ Matrix f . id . Matrix g
--                         ^^

.

> fg
VCons (VCons 9 (VCons 12 (VCons 15 VNil))) (VCons (VCons 19 (VCons 26 (VCons 33 VNil))) (VCons (VCons 29 (VCons 40 (VCons 51 VNil))) (VCons (VCons 39 (VCons 54 (VCons 69 VNil))) VNil)))

, : https://gist.github.com/danbornside/f44907fe0afef17d5b1ce93dd36ce84d

0

Source: https://habr.com/ru/post/1696264/


All Articles