master..089e42e · laop

git.iko.soy/laop

on 089e42e help sign in

32 files changed+1243−1479

since splitsnapshots

unifiedsplit

.ghc.environment.x86_64-linux-8.6.5new file+17

@@ -0,0 +1,17 @@

1+-- This is a GHC environment file written by cabal. This means you can

2+-- run ghc or ghci and get the environment of the project as a whole.

3+-- But you still need to use cabal repl $target to get the environment

4+-- of specific components (libs, exes, tests etc) because each one can

5+-- have its own source dirs, cpp flags etc.

6+--

7+clear-package-db

8+global-package-db

9+package-db /home/bolt/.cabal/store/ghc-8.6.5/package.db

10+package-db packagedb/ghc-8.6.5

11+package-id laop-0.1.0.0-inplace

12+package-id base-4.12.0.0

13+package-id ghc-prim-0.5.3

14+package-id rts

15+package-id integer-gmp-1.0.2.0

16+package-id deepseq-1.4.4.0

17+package-id array-0.5.3.0

.github/workflows/ci.ymldeleted−43

@@ -1,43 +0,0 @@

1−name: CI

2−

3−# Trigger the workflow on push or pull request, but only for the master branch

4−on:

5− pull_request:

6− push:

7− branches: [master]

8−

9−jobs:

10− build:

11− name: ghc ${{ matrix.ghc }}

12− runs-on: ubuntu-16.04

13− strategy:

14− matrix:

15− cabal: ["3.0"]

16− ghc:

17− - "8.6.5"

18− - "8.8.3"

19−

20− steps:

21− - uses: actions/checkout@v2

22− if: github.event.action == 'opened' || github.event.action == 'synchronize' || github.event.ref == 'refs/heads/master'

23−

24− - uses: actions/setup-haskell@v1

25− name: Setup Haskell

26− with:

27− ghc-version: ${{ matrix.ghc }}

28− cabal-version: ${{ matrix.cabal }}

29−

30− - uses: actions/cache@v1

31− name: Cache ~/.cabal/store

32− with:

33− path: ~/.cabal/store

34− key: ${{ runner.os }}-${{ matrix.ghc }}-cabal

35−

36− - name: Build

37− run: |

38− cabal v2-update

39− cabal v2-build --enable-tests --enable-benchmarks

40−

41− - name: Test

42− run: |

43− cabal v2-test --enable-tests

.gitignore+2−54

@@ -1,55 +1,3 @@

1−### Haskell

2−dist

3−dist-*

4−cabal-dev

5−*.o

6−*.hi

7−*.chi

8−*.chs.h

9−*.dyn_o

10−*.dyn_hi

11−*.prof

12−*.aux

13−*.hp

14−*.eventlog

15−.virtualenv

16−.hsenv

17−.hpc

18−.cabal-sandbox/

19−cabal.sandbox.config

20−cabal.config

21−cabal.project.local

22−.ghc.environment.*

23−.HTF/

24−# Stack

251.stack-work/

26−stack.yaml.lock

27−

28−### IDE/support

29−# Vim

30−[._]*.s[a-v][a-z]

31−[._]*.sw[a-p]

32−[._]s[a-v][a-z]

33−[._]sw[a-p]

34−*~

35−tags

36−

37−# IntellijIDEA

38−.idea/

39−.ideaHaskellLib/

40−*.iml

41−

42−# Atom

43−.haskell-ghc-mod.json

44−

45−# VS

46−.vscode/

47−

48−# Emacs

49−*#

50−.dir-locals.el

51−TAGS

52−

53−# other

54−.DS_Store

55−hackage.sh

2+laop.cabal

3+*~

.travis.ymldeleted−47

@@ -1,47 +0,0 @@

1−sudo: true

2−language: haskell

3−

4−git:

5− depth: 5

6−

7−cabal: "3.0"

8−

9−cache:

10− directories:

11− - "$HOME/.cabal/store"

12− - "$HOME/.stack"

13− - "$TRAVIS_BUILD_DIR/.stack-work"

14−

15−matrix:

16− include:

17− - ghc: 8.6.5

18− - ghc: 8.8.3

19−

20− - ghc: 8.8.3

21− env: STACK_YAML="$TRAVIS_BUILD_DIR/stack-8.8.3.yaml"

22−

23− - ghc: 8.6.5

24− env: STACK_YAML="$TRAVIS_BUILD_DIR/stack.yaml"

25−

26−

27−install:

28− - |

29− if [ -z "$STACK_YAML" ]; then

30− cabal v2-update

31− cabal v2-build --enable-tests --enable-benchmarks

32− else

33− curl -sSL https://get.haskellstack.org/ | sh

34− stack --version

35− stack build --system-ghc --test --bench --no-run-tests --no-run-benchmarks

36− fi

37−

38−script:

39− - |

40− if [ -z "$STACK_YAML" ]; then

41− cabal v2-test --enable-tests

42− else

43− stack test --system-ghc

44− fi

45−

46−notifications:

47− email: false

CHANGELOG.mddeleted−17

@@ -1,17 +0,0 @@

1−# Changelog

2−

3−`laop` uses [PVP Versioning][1].

4−The changelog is available [on GitHub][2].

5−

6−## 0.1.1.1

7−

8−* Bump base version to work with cabal

9−

10−## 0.1.1.0

11−

12−* Package is more organized and now has tests and benchmarks separated

13−* Repository is more organized and clean

14−* Added CI

15−

16−[1]: https://pvp.haskell.org

17−[2]: https://github.com/bolt12/laop2/releases

ChangeLog.mdnew file+3

@@ -0,0 +1,3 @@

1+# Changelog for laop

3+## Unreleased changes

LICENSE+26−17

@@ -1,21 +1,30 @@

1−MIT License

5−Permission is hereby granted, free of charge, to any person obtaining a copy

6−of this software and associated documentation files (the "Software"), to deal

7−in the Software without restriction, including without limitation the rights

8−to use, copy, modify, merge, publish, distribute, sublicense, and/or sell

9−copies of the Software, and to permit persons to whom the Software is

10−furnished to do so, subject to the following conditions:

5+Redistribution and use in source and binary forms, with or without

6+modification, are permitted provided that the following conditions are met:

117

12−The above copyright notice and this permission notice shall be included in all

13−copies or substantial portions of the Software.

8+ * Redistributions of source code must retain the above copyright

9+ notice, this list of conditions and the following disclaimer.

1410

15−THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR

16−IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,

17−FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE

18−AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER

19−LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,

20−OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE

21−SOFTWARE.

11+ * Redistributions in binary form must reproduce the above

12+ copyright notice, this list of conditions and the following

13+ disclaimer in the documentation and/or other materials provided

14+ with the distribution.

15+

16+ * Neither the name of Armando Santos nor the names of other

17+ contributors may be used to endorse or promote products derived

18+ from this software without specific prior written permission.

19+

20+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS

21+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT

22+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR

23+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT

24+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,

25+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT

26+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,

27+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY

28+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT

29+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE

30+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

README.md+30−34

@@ -1,11 +1,5 @@

11# laop - Linear Algebra of Programming library

3−[![GitHub CI](https://github.com/bolt12/laop/workflows/CI/badge.svg)](https://github.com/bolt12/laop/actions)

4−[![Build status](https://img.shields.io/travis/bolt12/laop.svg?logo=travis)](https://travis-ci.org/bolt12/laop)

5−[![Hackage](https://img.shields.io/hackage/v/laop.svg?logo=haskell)](https://hackage.haskell.org/package/laop)

6−[![Stackage Lts](http://stackage.org/package/laop/badge/lts)](http://stackage.org/lts/package/laop)

7−[![Stackage Nightly](http://stackage.org/package/laop/badge/nightly)](http://stackage.org/nightly/package/laop)

8−

93The LAoP discipline generalises relations and functions treating them as

104Boolean matrices and in turn consider these as arrows.

115

@@ -16,38 +10,40 @@ motivation behind the library, the underlying theory, and implementation details

1610This module offers many of the combinators mentioned in the work of

1711[Macedo (2012)](https://repositorium.sdum.uminho.pt/handle/1822/22894) and [Oliveira (2012)](https://pdfs.semanticscholar.org/ccf5/27fa9179081223bffe8067edd81948644fc0.pdf).

1812

19−See the package in hackage [here](https://hackage.haskell.org/package/laop-0.1.1.0)

20−

21−A Functional Pearl has been written and can be regarded as the [reference document](https://github.com/bolt12/tymfgg-pearl) for this library.

22−

23−## Features

24−

25−This library offers 3 main matrix programming modules:

13+See the package in hackage [here](https://hackage.haskell.org/package/laop-0.1.0.5)

2614

27−- One in which matrices are typed with type level natural numbers;

28−- One in which matrices are typed with arbitrary generic data types;

29−- One in which matrices are regarded as relations, i.e. boolean matrices;

15+There are a couple of repos with a WIP of benchmarks comparing [matrix composition](https://github.com/bolt12/laop-benchmarks) and a real use case of [data analytics](https://github.com/bolt12/laop-analytics).

3016

31−There's also an experimental module that uses matrices to represent probability

32−distributions.

17+A Functional Pearl is also on its way, hopefully will be the reference document for this library.

3318

34−The most interesting feature is that matrices are represented as an inductive data type.

35−Given this formulation, matrix algorithms can be expressed in a much more elegant and

36−calculational style than the traditional vector of vectors representation. This data type

37−guarantees that a matrix will always have valid dimensions. It can also express block matrix

38−computations naturally, which leads to total, efficient and statically typed manipulation

39−and transformation functions.

40−

41−Like matrix multiplication, other common operations, such as matrix transposition, benefit from a block-oriented structure that leads to a simple and natural divide-and-conquer algorithmic solution. Performance wise, this means that without much effort we can obtain optimal cache-oblivious algorithms.

42−

43−Given this, this new matrix formulation compared to other libraries:

44−

45−- Is more compositional and polymorphic and does not have partial matrix manipulation functions (hence less chances for usage errors);

46−- Our implementation of matrices enables simple manipulation of submatrices, making it particularly suitable for formal verification and equation reasoning, using the mathematical framework defined by the linear algebra of programming. Furthermore, the data type constructors ensure that the matrices of this kind are sound, i.e. malformed matrices with incorrect dimensions of the sort, can not be constructed.

47−

48−## Known issues

19+## Features

4920

50−Unfortunately, due to the use of type-level programming features, this approach sometimes requires type dimensions to be constrainted, in some way, impossible to write idiomatic Arrow instances, for example. Type inference isn't perfect, when it comes to infer the types of matrices which dimensions are computed using type level naturals multiplication, the compiler needs type annotations in order to succeed. And not all kinds of programs can be modeled using matrices, namely programs that deal with arbitrary infinite data types such as lists or integers (although there are some workarounds).

21+This library offers:

22+

23+- An internal module representation that uses normal datatypes (`Void`, `()`, `Either`) for matrix dimensions and two

24+ type families `FromNat` and `Count` to make it easier to work with these type of matrices.

25+- An interfacing module that uses generalised types for the dimensions and is just a newtype wrapper

26+ around the internal matrix data type.

27+- An interfacing module that uses type level naturals for the dimensions and is just a newtype wrapper

28+ around the internal matrix data type.

29+- An interfacing module that restricts the matrix contents to being only 0's or 1's (True

30+ and False). This module is called 'Relation' and offers many of the combinators seen in

31+ AoP and Relational Calculus/Algebra.

32+- A very simple Probabilistic Programming module and several functions and data types to

33+ make it easier to deal with sample space.

34+

35+Given this, this new matrix formulation compared to other libraries one has much more advantages, such as:

36+

37+- Has an inductive definition enabling writing matrix manipulation functions in a much more elegant and calculational way;

38+- Statically typed dimensions;

39+- Polymorphic data type dimensions;

40+- Polymorphic matrix content;

41+- Awesome dimension type inference;

42+- Fast type natural conversion via `FromNat` type family;

43+- Matrix `Junc` and `Split`-ing in O(1);

44+- Matrix composition takes advantage of divide-and-conquer and fusion laws.

45+

46+Unfortunately, this approach does not solve the issue of type dimensions being in some way constrainted making it impossible to write Arrow instances, for example. Type inference isn't perfect, when it comes to infer the types of matrices which dimensions are computed using type level naturals multiplication, the compiler needs type annotations in order to succeed.

5147

5248## Notes

5349

Setup.hsnew file+2

@@ -0,0 +1,2 @@

1+import Distribution.Simple

2+main = defaultMain

benchmark/Main.hs → app/Benchmarks.hsrenamed+18−16

@@ -8,36 +8,38 @@

88{-# LANGUAGE AllowAmbiguousTypes #-}

99{-# LANGUAGE ScopedTypeVariables #-}

1010

11−module Main (main) where

11+module Benchmarks

12+ ( benchmark

13+ )

14+ where

1215

1316import LAoP.Dist.Internal

1417import LAoP.Utils

15−import LAoP.Matrix.Type hiding (CountableN, Countable, FLN)

16−import qualified LAoP.Matrix.Type as T (FLN)

18+import LAoP.Matrix.Type hiding (CountableN, Countable, FromListsN)

19+import qualified LAoP.Matrix.Type as T (FromListsN)

1720import Criterion.Main

1821import Control.DeepSeq

1922import Test.QuickCheck

2023import GHC.TypeLits

2124import Data.Proxy

22−import Prelude hiding (id, (.))

2325

2426selectM2 ::

2527 ( Num e,

26− T.FLN b b,

28+ T.FromListsN e b b,

2729 CountableN b

2830 ) => Matrix e cols (Either a b) -> Matrix e a b -> Matrix e cols b

29−selectM2 m y = join y iden `comp` m

31+selectM2 m y = junc y identity `comp` m

3032

3133selectD2 ::

32− ( FLN b b,

34+ ( FromListsN b b,

3335 CountableN b

3436 ) => Dist (Either a b) -> Matrix Prob a b -> Dist b

35−selectD2 (D d) m = D (join m iden `comp` d)

37+selectD2 (D d) m = D (junc m identity `comp` d)

3638

37−-- Composition with iden

38−compId m = comp iden m

39+-- Composition with identity

40+compId m = comp identity m

3941

40−randomDist :: forall a . (Countable a, FLN () a) => Gen (Dist a)

42+randomDist :: forall a . (Countable a, FromListsN () a) => Gen (Dist a)

4143randomDist = do

4244 let size = fromInteger (natVal (Proxy :: Proxy (Count a)))

4345 l <- vectorOf size (arbitrary :: Gen Prob)

@@ -46,7 +48,7 @@ randomDist = do

4648 m = fromLists lr

4749 return (D m)

4850

49−randomMatrix :: forall a b . (CountableDims a b, FLN a b) => Gen (Matrix Prob a b)

51+randomMatrix :: forall a b . (CountableDimensions a b, FromListsN a b) => Gen (Matrix Prob a b)

5052randomMatrix = do

5153 let cols = fromInteger (natVal (Proxy :: Proxy (Count a)))

5254 rows = fromInteger (natVal (Proxy :: Proxy (Count b)))

@@ -105,7 +107,7 @@ normalize3 as l = let s = sum l

105107 probs = map (/ s) l

106108 in zip as probs

107109

108−randomDistF :: forall a b . (CountableDims a b, CoArbitrary a, Arbitrary b) => Gen (Dist' (a -> b))

110+randomDistF :: forall a b . (CountableDimensions a b, CoArbitrary a, Arbitrary b) => Gen (Dist' (a -> b))

109111randomDistF = do

110112 let a = fromInteger (natVal (Proxy :: Proxy (Count a)))

111113 b = fromInteger (natVal (Proxy :: Proxy (Count b)))

@@ -144,8 +146,8 @@ setupEnv2 = do

144146 distList2 <- generate (resize 1 (randomDistF @(Natural 0 100) @(Natural 0 100)))

145147 return (m21, m40, dist, dist2, distList1, distList2)

146148

147−main :: IO ()

148−main = defaultMain [

149+benchmark :: IO ()

150+benchmark = defaultMain [

149151 env setupEnv $ \ ~(m11, m12, m21, m22, m31, m32) -> bgroup "Matrix Composition" [

150152 bgroup "10x10" [

151153 bench "WHNF - 10x10" $ whnf (comp m11) m12

@@ -160,7 +162,7 @@ main = defaultMain [

160162 , bench "NF - 200x200" $ nf (comp m31) m32

161163 ],

162164 bgroup "200x200 - RULES" [

163− bench "No rules - 200x200" $ nf (comp m21) iden

165+ bench "No rules - 200x200" $ nf (comp m21) identity

164166 , bench "Rules - 200x200" $ nf compId m21

165167 ] ],

166168 env setupEnv2 $ \ ~(m21, m40, dist, dist2, dl1, dl2) -> bgroup "Matrix vs List - `select`" [

test/Examples/Readme.hs → app/Examples.hsrenamed+22−37

@@ -1,10 +1,11 @@

11{-# LANGUAGE GADTs #-}

22{-# LANGUAGE DeriveGeneric #-}

33{-# LANGUAGE FlexibleContexts #-}

4+{-# LANGUAGE TypeOperators #-}

45{-# LANGUAGE TypeApplications #-}

56{-# LANGUAGE DataKinds #-}

7−module Examples.Readme

8+module Examples

89 ( exec

910 )

1011 where

@@ -16,7 +17,8 @@ import LAoP.Dist

1617import GHC.TypeLits

1718import Data.Coerce

1819import qualified GHC.Generics as G

19−import Prelude hiding (id, (.))

20+import Control.Category hiding (id)

21+import Prelude hiding ((.))

2022

2123-- Monty Hall Problem

2224data Outcome = Win | Lose

@@ -30,7 +32,7 @@ firstChoice :: Matrix Double () Outcome

3032firstChoice = col [1/3, 2/3]

3133

3234secondChoice :: Matrix Double Outcome Outcome

33−secondChoice = fromF switch

35+secondChoice = fromF' switch

3436

3537-- Dice sum

3638

@@ -39,7 +41,7 @@ type SS = Natural 1 6 -- Sample Space

3941sumSS :: SS -> SS -> Natural 2 12

4042sumSS = coerceNat (+)

4143

42−sumSSM = fromF (uncurry sumSS)

44+sumSSM = fromF' (uncurry sumSS)

4345

4446condition :: (Int, Int) -> Int -> Int

4547condition (fst, snd) thrd = if fst == snd

@@ -49,7 +51,7 @@ condition (fst, snd) thrd = if fst == snd

4951conditionSS :: (SS, SS) -> SS -> Natural 3 18

5052conditionSS = coerceNat2 condition

5153

52−conditionalThrows = fromF (uncurry conditionSS) . kr (kr die die) die

54+conditionalThrows = fromF' (uncurry conditionSS) . khatri (khatri die die) die

5355

5456die :: Matrix Double () SS

5557die = col $ map (const (1/6)) [nat @1 @6 1 .. nat 6]

@@ -65,40 +67,23 @@ data R = No | Yes

6567 deriving (Bounded, Enum, Eq, Show, G.Generic)

6668

6769rain :: Matrix Double () R

68−rain = matrixBuilder gen

69− where

70− gen (_, No) = 0.8

71− gen (_, Yes) = 0.2

70+rain = col [0.8, 0.2]

7271

7372sprinkler :: Matrix Double R S

74−sprinkler = matrixBuilder gen

75− where

76− gen (No, Off) = 0.6

77− gen (No, On) = 0.4

78− gen (Yes, Off) = 0.99

79− gen (Yes, On) = 0.01

73+sprinkler = fromLists [[0.6, 0.99], [0.4, 0.01]]

8074

8175grass :: Matrix Double (S, R) G

82−grass = matrixBuilder gen

83− where

84− gen ((Off, No), Dry) = 1

85− gen ((Off, Yes), Dry) = 0.2

86− gen ((On, No), Dry) = 0.1

87− gen ((On, Yes), Dry) = 0.01

88− gen ((Off, No), Wet) = 0

89− gen ((Off, Yes), Wet) = 0.8

90− gen ((On, No), Wet) = 0.9

91− gen ((On, Yes), Wet) = 0.99

76+grass = fromLists [[1, 0.2, 0.1, 0.01], [0, 0.8, 0.9, 0.99]]

9277

93−tag f = kr f id

78+tag f = khatri f identity

9479

95−state g s r = tag g . tag s . r

80+state g s r = tag g `comp` tag s `comp` r

9681

97−grass_wet :: Matrix Double () (G, (S, R)) -> Matrix Double One One

98−grass_wet state = row [0,1] . fstM . state

82+grass_wet :: Matrix Double (G, (S, R)) One

83+grass_wet = row [0,1] . kp1

9984

10085rainning :: Matrix Double (G, (S, R)) One

101−rainning = row [0,1] . sndM . sndM

86+rainning = row [0,1] . kp2 . kp2

10287

10388-- Alcuin Puzzle

10489

@@ -121,21 +106,21 @@ cross LeftB = RightB

121106cross RightB = LeftB

122107

123108crossR :: R.Relation Bank Bank

124−crossR = R.fromF cross

109+crossR = R.fromF' cross

125110

126111-- | Initial state, everyone in the left bank

127112locationLeft :: Being -> Bank

128113locationLeft _ = LeftB

129114

130115locationLeftR :: R.Relation Being Bank

131−locationLeftR = R.fromF locationLeft

116+locationLeftR = R.fromF' locationLeft

132117

133118-- | Initial state, everyone in the right bank

134119locationRight :: Being -> Bank

135120locationRight _ = RightB

136121

137122locationRightR :: R.Relation Being Bank

138−locationRightR = R.fromF locationRight

123+locationRightR = R.fromF' locationRight

139124

140125-- Properties

141126

@@ -152,7 +137,7 @@ inv :: R.Relation Being Bank -> Bool

152137inv w = (w `R.comp` canEat w) `R.sse` (w `R.comp` farmer)

153138 where

154139 farmer :: R.Relation Being Being

155− farmer = R.fromF (const Farmer)

140+ farmer = R.fromF' (const Farmer)

156141

157142-- Arbitrary state

158143bankState :: Being -> Bank -> Bool

@@ -171,13 +156,13 @@ exec = do

171156 putStrLn "Monty Hall Problem solution:"

172157 prettyPrint (secondChoice . firstChoice)

173158 putStrLn "\n Sum of dices probability:"

174− prettyPrint (sumSSM . kr die die)

159+ prettyPrint (sumSSM `comp` khatri die die)

175160 putStrLn "\n Conditional dice throw:"

176161 prettyPrint conditionalThrows

177162 putStrLn "\n Checking that the last result is indeed a distribution: "

178− prettyPrint (bang . sumSSM . kr die die)

163+ prettyPrint (bang . sumSSM . khatri die die)

179164 putStrLn "\n Probability of grass being wet:"

180− prettyPrint (grass_wet (state grass sprinkler rain))

165+ prettyPrint (grass_wet . state grass sprinkler rain)

181166 putStrLn "\n Probability of rain:"

182167 prettyPrint (rainning . state grass sprinkler rain)

183168 putStrLn "\n Is the arbitrary state a valid state? (Alcuin Puzzle)"

app/Main.hsnew file+7

@@ -0,0 +1,7 @@

1+module Main where

3+import Examples

4+import Benchmarks

6+main :: IO ()

7+main = benchmark

test/Examples/Spreadsheets.hs → app/Spreadsheets.hsrenamed+6−6

@@ -1,11 +1,11 @@

11{-# LANGUAGE DeriveGeneric #-}

3−module Examples.Spreadsheets

3+module Spreadsheets

4+ where

5−import LAoP.Utils

66import LAoP.Matrix.Type

7+import qualified LAoP.Matrix.Internal as I

78import GHC.Generics

8−import Prelude hiding (id, (.))

1010data Student = Student1 | Student2 | Student3 | Student4

1111 deriving (Eq, Show, Enum, Bounded, Generic)

@@ -35,12 +35,12 @@ xls :: Matrix Float Question One

3535 -> Matrix Float Question Student

3636 -> Matrix Float Student One

3737 -> Matrix Float (Either Question Results) (Either One Student)

38−xls w m t = join (fork w m) (fork zeros r)

38+xls w m t = junc (split w m) (split zeros r)

3939 where

40− rExam = m . tr w

40+ rExam = m `comp` tr w

4141 rTest = tr t

4242 rFinal = rTest `maxPW` rExam

43− r = (rExam . tr exam) + (rTest . tr test) + (rFinal . tr final)

43+ r = (rExam `comp` tr exam) + (rTest `comp` tr test) + (rFinal `comp` tr final)

4444

4545-- | Overloaded, point-wise 'max' function

4646maxPW :: Ord e => Matrix e a b -> Matrix e a b -> Matrix e a b

appveyor.ymldeleted−34

@@ -1,34 +0,0 @@

1−clone_folder: "c:\\WORK"

2−clone_depth: 5

3−

4−# Do not build feature branch with open Pull Requests

5−skip_branch_with_pr: true

6−

7−platform:

8− - x86_64

9−

10−cache:

11− - "C:\\SR"

12− - dist-newstyle

13−

14−environment:

15− global:

16− CABOPTS: --store-dir=C:\\SR

17−

18− matrix:

19− - GHCVER: 8.6.5

20−

21−install:

22− - choco source add -n mistuke -s https://www.myget.org/F/mistuke/api/v2

23− - choco install -y cabal --version 2.4.1.0

24− - choco install -y ghc --version 8.6.3

25− - refreshenv

26−

27−before_build:

28− - cabal --version

29− - ghc --version

30− - cabal %CABOPTS% v2-update

31−

32−build_script:

33− - cabal %CABOPTS% v2-build --enable-tests

34− - cabal %CABOPTS% v2-test --enable-tests

hackage.shnew file+10

@@ -0,0 +1,10 @@

1+#!/bin/sh

2+set -e

4+dir=$(mktemp -d dist-docs.XXXXXX)

5+trap 'rm -r "$dir"' EXIT

7+# assumes cabal 2.4 or later

8+cabal v2-haddock --builddir="$dir" --haddock-for-hackage --enable-doc

10+cabal upload -d $dir/*-docs.tar.gz --publish

laop.cabaldeleted−89

@@ -1,89 +0,0 @@

1−cabal-version: 2.4

2−name: laop

3−version: 0.1.1.1

4−synopsis: Matrix programming library

5−description: Matrix programming library that uses a type-safe inductive definition

6− inspired by the Linear Algebra of Programming

7−homepage: https://github.com/bolt12/laop

8−bug-reports: https://github.com/bolt12/laop/issues

9−license: MIT

10−license-file: LICENSE

11−author: Armando Santos

12−maintainer: Armando Santos <armandoifsantos@gmail.com>

13−copyright: 2020 Armando Santos

14−category: Data

15−build-type: Simple

16−extra-doc-files: README.md

17− CHANGELOG.md

18−tested-with: GHC == 8.6.5

19− GHC == 8.8.3

20−

21−source-repository head

22− type: git

23− location: https://github.com/bolt12/laop.git

24−

25−common common-options

26− build-depends: base >= 4.12.0.0 && < 5,

27− deepseq

28−

29− ghc-options: -Wall

30− -Wcompat

31− -Widentities

32− -Wincomplete-uni-patterns

33− -Wincomplete-record-updates

34− if impl(ghc >= 8.0)

35− ghc-options: -Wredundant-constraints

36− if impl(ghc >= 8.2)

37− ghc-options: -fhide-source-paths

38− if impl(ghc >= 8.4)

39− ghc-options: -Wmissing-export-lists

40− -Wpartial-fields

41− if impl(ghc >= 8.8)

42− ghc-options: -Wmissing-deriving-strategies

43−

44− default-language: Haskell2010

45−

46−library

47− import: common-options

48− hs-source-dirs: src

49− exposed-modules: LAoP.Dist

50− LAoP.Dist.Internal

51− LAoP.Matrix.Internal

52− LAoP.Matrix.Nat

53− LAoP.Matrix.Type

54− LAoP.Relation

55− LAoP.Relation.Internal

56− LAoP.Utils

57− LAoP.Utils.Internal

58−

59−test-suite laop-test

60− import: common-options

61− type: exitcode-stdio-1.0

62− hs-source-dirs: test

63− other-modules: Examples.Readme

64− main-is: Spec.hs

65− build-depends: laop

66− ghc-options: -threaded

67− -rtsopts

68− -with-rtsopts=-N

69− -funfolding-use-threshold=16

70− -fexcess-precision

71− -optc-O3

72− -optc-ffast-math

73−

74−benchmark laop-benchmark

75− import: common-options

76− type: exitcode-stdio-1.0

77− hs-source-dirs: benchmark

78− main-is: Main.hs

79− build-depends: criterion

80− , QuickCheck

81− , deepseq

82− , laop

83− ghc-options: -threaded

84− -rtsopts

85− -with-rtsopts=-N

86− -funfolding-use-threshold=16

87− -fexcess-precision

88− -optc-O3

89− -optc-ffast-math

package.yamlnew file+57

@@ -0,0 +1,57 @@

1+name: laop

2+version: 0.1.0.5

3+github: "bolt12/laop"

4+license: BSD3

5+author: "Armando Santos"

6+maintainer: "armandoifsantos@gmail.com"

7+copyright: "MIT"

9+extra-source-files:

10+- README.md

11+- ChangeLog.md

12+

13+# Metadata used when publishing your package

14+# synopsis: Short description of your package

15+category: Data

16+

17+# To avoid duplicated efforts in documentation and dealing with the

18+# complications of embedding Haddock markup inside cabal files, it is

19+# common to point users to the README.md file.

20+description: Please see the README on GitHub at <https://github.com/bolt12/laop#readme>

21+

22+dependencies:

23+- base >= 4.7 && < 5

24+- deepseq

25+

26+library:

27+ source-dirs: src

28+

29+executables:

30+ laop-exe:

31+ main: Main.hs

32+ source-dirs: app

33+ ghc-options:

34+ - -threaded

35+ - -rtsopts

36+ - -with-rtsopts=-N

37+ - -funfolding-use-threshold=16

38+ - -fexcess-precision # Good for doubles

39+ - -optc-O3 # Good for doubles

40+ - -optc-ffast-math # Good for doubles

41+ - -O2

42+ dependencies:

43+ - laop

44+ - criterion

45+ - deepseq

46+ - QuickCheck

47+

48+tests:

49+ laop-test:

50+ main: Spec.hs

51+ source-dirs: test

52+ ghc-options:

53+ - -threaded

54+ - -rtsopts

55+ - -with-rtsopts=-N

56+ dependencies:

57+ - laop

report-strict.pdfnew file

Binary file not shown.

src/LAoP/Dist.hs+2−2

@@ -39,8 +39,8 @@ module LAoP.Dist

3939 -- * Constraint type synonyms

4040 Countable,

4141 CountableN,

42− CountableDimsN,

43− FLN,

42+ CountableDimensionsN,

43+ FromListsN,

4444 Liftable,

4545 TrivialP,

4646

src/LAoP/Dist/Internal.hs+45−46

@@ -16,8 +16,8 @@ module LAoP.Dist.Internal

1616

1717 Countable,

1818 CountableN,

19− CountableDimsN,

20− FLN,

19+ CountableDimensionsN,

20+ FromListsN,

2121 Liftable,

2222 TrivialP,

2323

@@ -43,8 +43,7 @@ module LAoP.Dist.Internal

4343 )

4444 where

4545

46−import LAoP.Matrix.Type hiding (TrivialP, Countable, CountableDims, CountableN, CountableDimsN, Liftable, FLN)

47−import Prelude hiding (id, (.))

46+import LAoP.Matrix.Type hiding (TrivialP, Countable, CountableDimensions, CountableN, CountableDimensionsN, Liftable, FromListsN)

4847import qualified LAoP.Matrix.Internal as I

4948import LAoP.Utils

5049import GHC.TypeLits

@@ -62,18 +61,18 @@ newtype Dist a = D (Matrix Prob () a)

6261 deriving (Show, Num, Eq, Ord, NFData) via (Matrix Prob () a)

6362

6463-- | Constraint type synonyms to keep the type signatures less convoluted

65−type Countable a = KnownNat (I.Count a)

66−type CountableN a = KnownNat (I.Count (I.Normalize a))

67−type CountableDimsN a b = (CountableN a, CountableN b)

68−type FLN a b = I.FL (I.Normalize a) (I.Normalize b)

69−type Liftable a b = (Bounded a, Bounded b, Enum a, Enum b, Eq b, Num Prob, Ord Prob)

70−type TrivialP a b = Normalize (a, b) ~ Normalize (Normalize a, Normalize b)

64+type Countable a = KnownNat (I.Count a)

65+type CountableN a = KnownNat (I.Count (I.Normalize a))

66+type CountableDimensionsN a b = (CountableN a, CountableN b)

67+type FromListsN a b = I.FromLists Prob (I.Normalize a) (I.Normalize b)

68+type Liftable a b = (Bounded a, Bounded b, Enum a, Enum b, Eq b, Num Prob, Ord Prob)

69+type TrivialP a b = Normalize (a, b) ~ Normalize (Normalize a, Normalize b)

7170

7271-- | Functor instance

7372fmapD ::

7473 ( Liftable a b,

75− CountableDimsN a b,

76− FLN b a

74+ CountableDimensionsN a b,

75+ FromListsN b a

7776 )

7877 =>

7978 (a -> b) -> Dist a -> Dist b

@@ -85,17 +84,17 @@ unitD = D (one 1)

8584

8685-- | Applicative/Monoidal instance 'mult' function

8786multD ::

88− ( CountableDimsN a b,

87+ ( CountableDimensionsN a b,

8988 CountableN (a, b),

90− FLN (a, b) a,

91− FLN (a, b) b,

89+ FromListsN (a, b) a,

90+ FromListsN (a, b) b,

9291 TrivialP a b

9392 ) => Dist a -> Dist b -> Dist (a, b)

94−multD (D a) (D b) = D (kr a b)

93+multD (D a) (D b) = D (khatri a b)

9594

9695-- | Selective instance function

9796selectD ::

98− ( FLN b b,

97+ ( FromListsN b b,

9998 CountableN b

10099 ) => Dist (Either a b) -> Matrix Prob a b -> Dist b

101100selectD (D d) m = D (selectM d m)

@@ -104,31 +103,31 @@ selectD (D d) m = D (selectM d m)

104103-- functions to apply to a given argument;

105104branchD ::

106105 ( Num e,

107− CountableDimsN a b,

108− CountableDimsN c (Either b c),

109− FLN c b,

110− FLN a b,

111− FLN a a,

112− FLN b b,

113− FLN c c,

114− FLN b a,

115− FLN b c,

116− FLN (Either b c) b,

117− FLN (Either b c) c

106+ CountableDimensionsN a b,

107+ CountableDimensionsN c (Either b c),

108+ FromListsN c b,

109+ FromListsN a b,

110+ FromListsN a a,

111+ FromListsN b b,

112+ FromListsN c c,

113+ FromListsN b a,

114+ FromListsN b c,

115+ FromListsN (Either b c) b,

116+ FromListsN (Either b c) c

118117 )

119118 => Dist (Either a b) -> Matrix Prob a c -> Matrix Prob b c -> Dist c

120119branchD x l r = f x `selectD` g l `selectD` r

121120 where

122− f (D m) = D (fork (tr i1) (i1 `comp` tr i2) `comp` m)

121+ f (D m) = D (split (tr i1) (i1 `comp` tr i2) `comp` m)

123122 g m = i2 `comp` m

124123

125124-- | Branch on a Boolean value, skipping unnecessary computations.

126125ifD ::

127− ( CountableDimsN a (Either () a),

128− FLN a a,

129− FLN a (),

130− FLN () a,

131− FLN (Either () a) a

126+ ( CountableDimensionsN a (Either () a),

127+ FromListsN a a,

128+ FromListsN a (),

129+ FromListsN () a,

130+ FromListsN (Either () a) a

132131 )

133132 => Dist Bool -> Dist a -> Dist a -> Dist a

134133ifD x (D t) (D e) = branchD x' t e

@@ -136,7 +135,7 @@ ifD x (D t) (D e) = branchD x' t e

136135 x' = bool (Right ()) (Left ()) `fmapD` x

137136

138137-- | Monad instance 'return' function

139−returnD :: forall a . (Enum a, FLN () a, Countable a) => a -> Dist a

138+returnD :: forall a . (Enum a, FromListsN () a, Countable a) => a -> Dist a

140139returnD a = D (col l)

141140 where

142141 i = fromInteger $ natVal (Proxy :: Proxy (Count a))

@@ -151,7 +150,7 @@ bindD (D d) m = D (m `comp` d)

151150(??) ::

152151 ( Enum a,

153152 Countable a,

154− FLN () a

153+ FromListsN () a

155154 ) => (a -> Bool) -> Dist a -> Prob

156155(??) p d =

157156 let l = toValues d

@@ -161,11 +160,11 @@ bindD (D d) m = D (m `comp` d)

161160-- Distribution Construction

162161

163162-- | Constructs a Bernoulli distribution

164−choose :: (FLN () a) => Prob -> Dist a

163+choose :: (FromListsN () a) => Prob -> Dist a

165164choose prob = D (col [prob, 1 - prob])

166165

167166-- | Creates a distribution given a shape function

168−shape :: (FLN () a) => (Prob -> Prob) -> [a] -> Dist a

167+shape :: (FromListsN () a) => (Prob -> Prob) -> [a] -> Dist a

169168shape _ [] = error "Probability.shape: empty list"

170169shape f xs =

171170 let incr = 1 / fromIntegral (length xs - 1)

@@ -173,23 +172,23 @@ shape f xs =

173172 in fromFreqs (zip xs ps)

174173

175174-- | Constructs a Linear distribution

176−linear :: (FLN () a) => [a] -> Dist a

175+linear :: (FromListsN () a) => [a] -> Dist a

177176linear = shape id

178177

179178-- | Constructs an Uniform distribution

180−uniform :: (FLN () a) => [a] -> Dist a

179+uniform :: (FromListsN () a) => [a] -> Dist a

181180uniform = shape (const 1)

182181

183182-- | Constructs an Negative Exponential distribution

184−negExp :: (FLN () a) => [a] -> Dist a

183+negExp :: (FromListsN () a) => [a] -> Dist a

185184negExp = shape (\x -> exp (-x))

186185

187186-- | Constructs an Normal distribution

188−normal :: (FLN () a) => [a] -> Dist a

187+normal :: (FromListsN () a) => [a] -> Dist a

189188normal = shape (normalCurve 0.5 0.5)

190189

191190-- | Transforms a 'Dist' into a list of pairs.

192−toValues :: forall a . (Enum a, Countable a, FLN () a) => Dist a -> [(a, Prob)]

191+toValues :: forall a . (Enum a, Countable a, FromListsN () a) => Dist a -> [(a, Prob)]

193192toValues (D d) =

194193 let rows = fromInteger (natVal (Proxy :: Proxy (Count a)))

195194 probs = toList d

@@ -197,7 +196,7 @@ toValues (D d) =

197196 in res

198197

199198-- | Pretty a distribution

200−prettyDist :: forall a. (Show a, Enum a, Countable a, FLN () a) => Dist a -> String

199+prettyDist :: forall a. (Show a, Enum a, Countable a, FromListsN () a) => Dist a -> String

201200prettyDist d =

202201 let values = sortBy (\(a, p1) (b, p2) -> compare p2 p1) (toValues @a d)

203202 w = maximum (map (length . show . fst) values)

@@ -209,12 +208,12 @@ prettyDist d =

209208 showR n x = show x ++ " "

210209

211210-- | Pretty Print a distribution

212−prettyPrintDist :: forall a . (Show a, Enum a, Countable a, FLN () a) => Dist a -> IO ()

211+prettyPrintDist :: forall a . (Show a, Enum a, Countable a, FromListsN () a) => Dist a -> IO ()

213212prettyPrintDist = putStrLn . prettyDist @a

214213

215214-- Auxiliary functions

216215

217−fromFreqs :: (FLN () a) => [(a,Prob)] -> Dist a

216+fromFreqs :: (FromListsN () a) => [(a,Prob)] -> Dist a

218217fromFreqs xs = D (col (map (\(x,p) -> p/q) xs))

219218 where q = sum $ map snd xs

220219

src/LAoP/Matrix/Internal.hs+375−359

@@ -30,7 +30,7 @@

3030-- motivation behind the library, the underlying theory, and implementation details.

3131--

3232-- This module offers many of the combinators mentioned in the work of

33−-- Macedo (2012) and Oliveira (2012).

33+-- Macedo (2012) and Oliveira (2012).

3434--

3535-- This is an Internal module and it is no supposed to be imported.

3636--

@@ -43,26 +43,17 @@ module LAoP.Matrix.Internal

4343 --

4444 -- There exists two type families that make it easier to write

4545 -- matrix dimensions: 'FromNat' and 'Count'. This approach

46− -- leads to a very straightforward implementation

47− -- of LAoP combinators.

46+ -- leads to a very straightforward implementation

47+ -- of LAoP combinators.

4848

4949 -- * Type safe matrix representation

5050 Matrix (..),

5151

52− -- * Constraint type aliases

53− Countable,

54− CountableDims,

55− CountableN,

56− CountableDimsN,

57− FL,

58− FLN,

59− Liftable,

60− Trivial,

61−

6252 -- * Primitives

53+ empty,

6354 one,

64− join,

65− fork,

55+ junc,

56+ split,

6657

6758 -- * Auxiliary type families

6859 FromNat,

@@ -75,7 +66,6 @@ module LAoP.Matrix.Internal

7566 toLists,

7667 toList,

7768 matrixBuilder,

78− matrixBuilder',

7969 row,

8070 col,

8171 zeros,

@@ -86,17 +76,11 @@ module LAoP.Matrix.Internal

8676 -- * Misc

8777 -- ** Get dimensions

8878 columns,

89− columns',

9079 rows,

91− rows',

9280

9381 -- ** Matrix Transposition

9482 tr,

9583

96− -- ** Scalar multiplication/division of matrices

97− (.|),

98− (./),

99−

10084 -- ** Selective operator

10185 select,

10286 branch,

@@ -105,19 +89,19 @@ module LAoP.Matrix.Internal

10589 cond,

10690

10791 -- ** Matrix "abiding"

108− abideJF,

109− abideFJ,

92+ abideJS,

93+ abideSJ,

11094

11195 -- ** Zip matrices

11296 zipWithM,

11397

11498 -- * Biproduct approach

115− -- ** Fork

99+ -- ** Split

116100 (===),

117101 -- *** Projections

118102 p1,

119103 p2,

120− -- ** Join

104+ -- ** Junc

121105 (|||),

122106 -- *** Injections

123107 i1,

@@ -130,13 +114,12 @@ module LAoP.Matrix.Internal

130114

131115 -- | Note that given the restrictions imposed it is not possible to

132116 -- implement the standard type classes present in standard Haskell.

133−

134117 -- *** Matrix pairing projections

135− fstM,

136− sndM,

118+ kp1,

119+ kp2,

137120

138121 -- *** Matrix pairing

139− kr,

122+ khatri,

140123

141124 -- * Matrix composition and lifting

142125

@@ -144,10 +127,10 @@ module LAoP.Matrix.Internal

144127

145128 -- | Note that given the restrictions imposed it is not possible to

146129 -- implement the standard type classes present in standard Haskell.

147− iden,

130+ identity,

148131 comp,

149− fromF',

150132 fromF,

133+ fromF',

151134

152135 -- * Matrix printing

153136 pretty,

@@ -176,20 +159,20 @@ import Data.Kind

176159import Data.List

177160import Data.Maybe

178161import Data.Proxy

179−import Data.Typeable

180162import Data.Void

181163import GHC.TypeLits

182164import Data.Type.Equality

183165import GHC.Generics

184166import Control.DeepSeq

185−import Prelude hiding (id, (.))

186−import qualified Prelude (id, (.))

167+import Control.Category

168+import Prelude hiding ((.))

187169

188170-- | LAoP (Linear Algebra of Programming) Inductive Matrix definition.

189171data Matrix e cols rows where

172+ Empty :: Matrix e Void Void

190173 One :: e -> Matrix e () ()

191− Join :: Matrix e a rows -> Matrix e b rows -> Matrix e (Either a b) rows

192− Fork :: Matrix e cols a -> Matrix e cols b -> Matrix e cols (Either a b)

174+ Junc :: Matrix e a rows -> Matrix e b rows -> Matrix e (Either a b) rows

175+ Split :: Matrix e cols a -> Matrix e cols b -> Matrix e cols (Either a b)

193176

194177deriving instance (Show e) => Show (Matrix e cols rows)

195178

@@ -216,6 +199,7 @@ type family Count (d :: Type) :: Nat where

216199--

217200-- Thanks to Li-Yao Xia this type family is super fast.

218201type family FromNat (n :: Nat) :: Type where

202+ FromNat 0 = Void

219203 FromNat 1 = ()

220204 FromNat n = FromNat' (Mod n 2 == 0) (FromNat (Div n 2))

221205

@@ -232,79 +216,90 @@ type family Normalize (d :: Type) :: Type where

232216-- | Constraint type synonyms to keep the type signatures less convoluted

233217type Countable a = KnownNat (Count a)

234218type CountableN a = KnownNat (Count (Normalize a))

235−type CountableDims a b = (Countable a, Countable b)

236−type CountableDimsN a b = (CountableN a, CountableN b)

237−type FL a b = FromLists a b

238−type FLN a b = FromLists (Normalize a) (Normalize b)

219+type CountableDimensions a b = (Countable a, Countable b)

220+type CountableDimensionsN a b = (CountableN a, CountableN b)

221+type FromListsN e a b = FromLists e (Normalize a) (Normalize b)

239222type Liftable e a b = (Bounded a, Bounded b, Enum a, Enum b, Eq b, Num e, Ord e)

240223type Trivial a = FromNat (Count a) ~ a

241224

242−-- | It is possible to implement a constrained version of the category type

243−-- class.

225+-- | It isn't possible to implement the 'id' function so it's

226+-- implementation is 'undefined'. However 'comp' can be and this partial

227+-- class implementation exists just to make the code more readable.

228+--

229+-- Please use 'identity' instead.

244230instance (Num e) => Category (Matrix e) where

245− type Object (Matrix e) a = (FL a a, Countable a)

246− id = iden

247− (.) = comp

231+ id = undefined

232+ (.) = comp

248233

249234instance NFData e => NFData (Matrix e cols rows) where

250− rnf (One e) = rnf e

251− rnf (Join a b) = rnf a `seq` rnf b

252− rnf (Fork a b) = rnf a `seq` rnf b

235+ rnf Empty = ()

236+ rnf (One e) = rnf e

237+ rnf (Junc a b) = rnf a `seq` rnf b

238+ rnf (Split a b) = rnf a `seq` rnf b

253239

254240instance Eq e => Eq (Matrix e cols rows) where

255− (One a) == (One b) = a == b

256− (Join a b) == (Join c d) = a == c && b == d

257− (Fork a b) == (Fork c d) = a == c && b == d

258− x@(Fork _ _) == y@(Join _ _) = x == abideJF y

259− x@(Join _ _) == y@(Fork _ _) = abideJF x == y

241+ Empty == Empty = True

242+ (One a) == (One b) = a == b

243+ (Junc a b) == (Junc c d) = a == c && b == d

244+ (Split a b) == (Split c d) = a == c && b == d

245+ x@(Split _ _) == y@(Junc _ _) = x == abideJS y

246+ x@(Junc _ _) == y@(Split _ _) = abideJS x == y

260247

261248instance Num e => Num (Matrix e cols rows) where

249+

262250 a + b = zipWithM (+) a b

263251

264252 a - b = zipWithM (-) a b

265253

266254 a * b = zipWithM (*) a b

267255

268− abs (One a) = One (abs a)

269− abs (Join a b) = Join (abs a) (abs b)

270− abs (Fork a b) = Fork (abs a) (abs b)

256+ abs Empty = Empty

257+ abs (One a) = One (abs a)

258+ abs (Junc a b) = Junc (abs a) (abs b)

259+ abs (Split a b) = Split (abs a) (abs b)

271260

272− signum (One a) = One (signum a)

273− signum (Join a b) = Join (signum a) (signum b)

274− signum (Fork a b) = Fork (signum a) (signum b)

261+ signum Empty = Empty

262+ signum (One a) = One (signum a)

263+ signum (Junc a b) = Junc (signum a) (signum b)

264+ signum (Split a b) = Split (signum a) (signum b)

275265

276266instance Ord e => Ord (Matrix e cols rows) where

277− (One a) <= (One b) = a <= b

278− (Join a b) <= (Join c d) = (a <= c) && (b <= d)

279− (Fork a b) <= (Fork c d) = (a <= c) && (b <= d)

280− x@(Fork _ _) <= y@(Join _ _) = x <= abideJF y

281− x@(Join _ _) <= y@(Fork _ _) = abideJF x <= y

267+ Empty <= Empty = True

268+ (One a) <= (One b) = a <= b

269+ (Junc a b) <= (Junc c d) = (a <= c) && (b <= d)

270+ (Split a b) <= (Split c d) = (a <= c) && (b <= d)

271+ x@(Split _ _) <= y@(Junc _ _) = x <= abideJS y

272+ x@(Junc _ _) <= y@(Split _ _) = abideJS x <= y

282273

283274-- Primitives

284275

276+-- | Empty matrix constructor

277+empty :: Matrix e Void Void

278+empty = Empty

279+

285280-- | Unit matrix constructor

286281one :: e -> Matrix e () ()

287282one = One

288283

289−-- | Matrix 'Join' constructor

290−join :: Matrix e a rows -> Matrix e b rows -> Matrix e (Either a b) rows

291−join = Join

284+-- | Matrix 'Junc' constructor

285+junc :: Matrix e a rows -> Matrix e b rows -> Matrix e (Either a b) rows

286+junc = Junc

292287

293288infixl 3 |||

294289

295−-- | Matrix 'Join' constructor

290+-- | Matrix 'Junc' constructor

296291(|||) :: Matrix e a rows -> Matrix e b rows -> Matrix e (Either a b) rows

297−(|||) = Join

292+(|||) = Junc

298293

299−-- | Matrix 'Fork' constructor

300−fork :: Matrix e cols a -> Matrix e cols b -> Matrix e cols (Either a b)

301−fork = Fork

294+-- | Matrix 'Split' constructor

295+split :: Matrix e cols a -> Matrix e cols b -> Matrix e cols (Either a b)

296+split = Split

302297

303298infixl 2 ===

304299

305−-- | Matrix 'Fork' constructor

300+-- | Matrix 'Split' constructor

306301(===) :: Matrix e cols a -> Matrix e cols b -> Matrix e cols (Either a b)

307−(===) = Fork

302+(===) = Split

308303

309304-- Construction

310305

@@ -312,101 +307,84 @@ infixl 2 ===

312307--

313308-- Given that it is not possible to branch on types at the term level type

314309-- classes are needed very much like an inductive definition but on types.

315−class FromLists cols rows where

310+class FromLists e cols rows where

316311 -- | Build a matrix out of a list of list of elements. Throws a runtime

317312 -- error if the dimensions do not match.

318313 fromLists :: [[e]] -> Matrix e cols rows

319314

320−instance FromLists () () where

315+instance FromLists e Void Void where

316+ fromLists [] = Empty

317+ fromLists _ = error "Wrong dimensions"

318+

319+instance {-# OVERLAPPING #-} FromLists e () () where

321320 fromLists [[e]] = One e

322321 fromLists _ = error "Wrong dimensions"

323322

324−instance (FromLists cols ()) => FromLists (Either () cols) () where

325− fromLists [h : t] = Join (One h) (fromLists [t])

323+instance {-# OVERLAPPING #-} (FromLists e cols ()) => FromLists e (Either () cols) () where

324+ fromLists [h : t] = Junc (One h) (fromLists [t])

326325 fromLists _ = error "Wrong dimensions"

327326

328−instance {-# OVERLAPPABLE #-}

329− (FromLists a (), FromLists b (), Countable a) => FromLists (Either a b) () where

330− fromLists [l] =

327+instance {-# OVERLAPPABLE #-} (FromLists e a (), FromLists e b (), Countable a) => FromLists e (Either a b) () where

328+ fromLists [l] =

331329 let rowsA = fromInteger (natVal (Proxy :: Proxy (Count a)))

332− in Join (fromLists [take rowsA l]) (fromLists [drop rowsA l])

330+ in Junc (fromLists [take rowsA l]) (fromLists [drop rowsA l])

333331 fromLists _ = error "Wrong dimensions"

334332

335−instance (FromLists () rows) => FromLists () (Either () rows) where

336− fromLists ([h] : t) = Fork (One h) (fromLists t)

333+instance {-# OVERLAPPING #-} (FromLists e () rows) => FromLists e () (Either () rows) where

334+ fromLists ([h] : t) = Split (One h) (fromLists t)

337335 fromLists _ = error "Wrong dimensions"

338336

339−instance {-# OVERLAPPABLE #-}

340− (FromLists () a, FromLists () b, Countable a) => FromLists () (Either a b) where

341− fromLists l@([_] : _) =

337+instance {-# OVERLAPPABLE #-} (FromLists e () a, FromLists e () b, Countable a) => FromLists e () (Either a b) where

338+ fromLists l@([_] : _) =

342339 let rowsA = fromInteger (natVal (Proxy :: Proxy (Count a)))

343− in Fork (fromLists (take rowsA l)) (fromLists (drop rowsA l))

340+ in Split (fromLists (take rowsA l)) (fromLists (drop rowsA l))

344341 fromLists _ = error "Wrong dimensions"

345342

346−instance (FromLists (Either a b) c, FromLists (Either a b) d, Countable c)

347− => FromLists (Either a b) (Either c d) where

343+instance {-# OVERLAPPABLE #-} (FromLists e (Either a b) c, FromLists e (Either a b) d, Countable c) => FromLists e (Either a b) (Either c d) where

348344 fromLists l@(h : t) =

349345 let lh = length h

350346 rowsC = fromInteger (natVal (Proxy :: Proxy (Count c)))

351− condition = all ((== lh) . length) t

347+ condition = all (== lh) (map length t)

352348 in if lh > 0 && condition

353− then Fork (fromLists (take rowsC l)) (fromLists (drop rowsC l))

349+ then Split (fromLists (take rowsC l)) (fromLists (drop rowsC l))

354350 else error "Not all rows have the same length"

355351

356352-- | Matrix builder function. Constructs a matrix provided with

357−-- a construction function that operates with indices.

358−matrixBuilder' ::

353+-- a construction function.

354+matrixBuilder ::

359355 forall e cols rows.

360− ( FL cols rows,

361− CountableDims cols rows

362− ) => ((Int, Int) -> e) -> Matrix e cols rows

363−matrixBuilder' f =

356+ ( FromLists e cols rows,

357+ CountableDimensions cols rows

358+ ) =>

359+ ((Int, Int) -> e) ->

360+ Matrix e cols rows

361+matrixBuilder f =

364362 let c = fromInteger $ natVal (Proxy :: Proxy (Count cols))

365363 r = fromInteger $ natVal (Proxy :: Proxy (Count rows))

366364 positions = [(a, b) | a <- [0 .. (r - 1)], b <- [0 .. (c - 1)]]

367365 in fromLists . map (map f) . groupBy (\(x, _) (w, _) -> x == w) $ positions

368366

369−-- | Matrix builder function. Constructs a matrix provided with

370−-- a construction function that operates with arbitrary types.

371−matrixBuilder ::

372− forall e a b.

373− ( FLN a b,

374− Enum a,

375− Enum b,

376− Bounded a,

377− Bounded b,

378− Eq a,

379− Countable b

380− ) => ((a, b) -> e) -> Matrix e (Normalize a) (Normalize b)

381−matrixBuilder f =

382− let r = fromInteger $ natVal (Proxy :: Proxy (Count b))

383− positions = [(a, b) | a <- [minBound .. maxBound], b <- [minBound .. maxBound]]

384− in fromLists . map (map f) . transpose . buildList r $ positions

385− where

386− buildList _ [] = []

387− buildList r l = take r l : buildList r (drop r l)

388−

389367-- | Constructs a column vector matrix

390−col :: (FL () rows) => [e] -> Matrix e () rows

368+col :: (FromLists e () rows) => [e] -> Matrix e () rows

391369col = fromLists . map (: [])

392370

393371-- | Constructs a row vector matrix

394−row :: (FL cols ()) => [e] -> Matrix e cols ()

372+row :: (FromLists e cols ()) => [e] -> Matrix e cols ()

395373row = fromLists . (: [])

396374

397375-- | Lifts functions to matrices with arbitrary dimensions.

398376--

399377-- NOTE: Be careful to not ask for a matrix bigger than the cardinality of

400378-- types @a@ or @b@ allows.

401−fromF' ::

379+fromF ::

402380 forall a b cols rows e.

403381 ( Liftable e a b,

404− CountableDims cols rows,

405− FL rows cols

382+ CountableDimensions cols rows,

383+ FromLists e rows cols

406384 ) =>

407385 (a -> b) ->

408386 Matrix e cols rows

409−fromF' f =

387+fromF f =

410388 let minA = minBound @a

411389 maxA = maxBound @a

412390 minB = minBound @b

@@ -416,8 +394,8 @@ fromF' f =

416394 elementsA = take ccols [minA .. maxA]

417395 elementsB = take rrows [minB .. maxB]

418396 combinations = (,) <$> elementsA <*> elementsB

419− combAp = map snd . sort . map (\(a, b) -> if f a == b

420− then ((fromEnum a, fromEnum b), 1)

397+ combAp = map snd . sort . map (\(a, b) -> if f a == b

398+ then ((fromEnum a, fromEnum b), 1)

421399 else ((fromEnum a, fromEnum b), 0)) $ combinations

422400 mList = buildList combAp rrows

423401 in tr $ fromLists mList

@@ -427,23 +405,41 @@ fromF' f =

427405

428406-- | Lifts functions to matrices with dimensions matching @a@ and @b@

429407-- cardinality's.

430−fromF ::

408+fromF' ::

431409 forall a b e.

432410 ( Liftable e a b,

433− CountableDimsN a b,

434− FLN b a

411+ CountableDimensionsN a b,

412+ FromListsN e b a

435413 ) =>

436414 (a -> b) ->

437415 Matrix e (Normalize a) (Normalize b)

438−fromF = fromF'

416+fromF' f =

417+ let minA = minBound @a

418+ maxA = maxBound @a

419+ minB = minBound @b

420+ maxB = maxBound @b

421+ ccols = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize a)))

422+ rrows = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize b)))

423+ elementsA = take ccols [minA .. maxA]

424+ elementsB = take rrows [minB .. maxB]

425+ combinations = (,) <$> elementsA <*> elementsB

426+ combAp = map snd . sort . map (\(a, b) -> if f a == b

427+ then ((fromEnum a, fromEnum b), 1)

428+ else ((fromEnum a, fromEnum b), 0)) $ combinations

429+ mList = buildList combAp rrows

430+ in tr $ fromLists mList

431+ where

432+ buildList [] _ = []

433+ buildList l r = take r l : buildList (drop r l) r

439434

440435-- Conversion

441436

442437-- | Converts a matrix to a list of lists of elements.

443438toLists :: Matrix e cols rows -> [[e]]

439+toLists Empty = []

444440toLists (One e) = [[e]]

445−toLists (Fork l r) = toLists l ++ toLists r

446−toLists (Join l r) = zipWith (++) (toLists l) (toLists r)

441+toLists (Split l r) = toLists l ++ toLists r

442+toLists (Junc l r) = zipWith (++) (toLists l) (toLists r)

447443

448444-- | Converts a matrix to a list of elements.

449445toList :: Matrix e cols rows -> [e]

@@ -452,38 +448,38 @@ toList = concat . toLists

452448-- Zeros Matrix

453449

454450-- | The zero matrix. A matrix wholly filled with zeros.

455−zeros :: (Num e, FL cols rows, CountableDims cols rows) => Matrix e cols rows

456−zeros = matrixBuilder' (const 0)

451+zeros :: (Num e, FromLists e cols rows, CountableDimensions cols rows) => Matrix e cols rows

452+zeros = matrixBuilder (const 0)

457453

458454-- Ones Matrix

459455

460456-- | The ones matrix. A matrix wholly filled with ones.

461457--

462458-- Also known as T (Top) matrix.

463−ones :: (Num e, FL cols rows, CountableDims cols rows) => Matrix e cols rows

464−ones = matrixBuilder' (const 1)

459+ones :: (Num e, FromLists e cols rows, CountableDimensions cols rows) => Matrix e cols rows

460+ones = matrixBuilder (const 1)

465461

466462-- Const Matrix

467463

468464-- | The constant matrix constructor. A matrix wholly filled with a given

469465-- value.

470−constant :: (Num e, FL cols rows, CountableDims cols rows) => e -> Matrix e cols rows

471−constant e = matrixBuilder' (const e)

466+constant :: (Num e, FromLists e cols rows, CountableDimensions cols rows) => e -> Matrix e cols rows

467+constant e = matrixBuilder (const e)

472468

473469-- Bang Matrix

474470

475471-- | The T (Top) row vector matrix.

476−bang :: forall e cols. (Num e, Enum e, FL cols (), Countable cols) => Matrix e cols ()

472+bang :: forall e cols. (Num e, Enum e, FromLists e cols (), Countable cols) => Matrix e cols ()

477473bang =

478474 let c = fromInteger $ natVal (Proxy :: Proxy (Count cols))

479475 in fromLists [take c [1, 1 ..]]

480476

481−-- iden Matrix

477+-- Identity Matrix

482478

483−-- | iden matrix.

484−iden :: forall e cols . (Num e, FL cols cols, Countable cols) => Matrix e cols cols

485−iden = matrixBuilder' (bool 0 1 . uncurry (==))

486−{-# NOINLINE iden #-}

479+-- | Identity matrix.

480+identity :: (Num e, FromLists e cols cols, Countable cols) => Matrix e cols cols

481+identity = matrixBuilder (bool 0 1 . uncurry (==))

482+{-# NOINLINE identity #-}

487483

488484-- Matrix composition (MMM)

489485

@@ -492,90 +488,65 @@ iden = matrixBuilder' (bool 0 1 . uncurry (==))

492488-- This definition takes advantage of divide-and-conquer and fusion laws

493489-- from LAoP.

494490comp :: (Num e) => Matrix e cr rows -> Matrix e cols cr -> Matrix e cols rows

495−comp (One a) (One b) = One (a * b)

496−comp (Join a b) (Fork c d) = comp a c + comp b d -- Divide-and-conquer law

497−comp (Fork a b) c = Fork (comp a c) (comp b c) -- Fork fusion law

498−comp c (Join a b) = Join (comp c a) (comp c b) -- Join fusion law

491+comp Empty Empty = Empty

492+comp (One a) (One b) = One (a * b)

493+comp (Junc a b) (Split c d) = comp a c + comp b d -- Divide-and-conquer law

494+comp (Split a b) c = Split (comp a c) (comp b c) -- Split fusion law

495+comp c (Junc a b) = Junc (comp c a) (comp c b) -- Junc fusion law

499496{-# NOINLINE comp #-}

500−{-# RULES

501− "comp/iden1" forall m. comp m iden = m ;

502− "comp/iden2" forall m. comp iden m = m

497+{-# RULES

498+ "comp/identity1" forall m. comp m identity = m ;

499+ "comp/identity2" forall m. comp identity m = m

503500#-}

504501

505−-- Scalar multiplication of matrices

506−

507−infixl 7 .|

508−-- | Scalar multiplication of matrices.

509−(.|) :: Num e => e -> Matrix e cols rows -> Matrix e cols rows

510−(.|) e (One a) = One (e * a)

511−(.|) e (Join a b) = Join (e .| a) (e .| b)

512−(.|) e (Fork a b) = Fork (e .| a) (e .| b)

513−

514−-- Scalar division of matrices

515−

516−infixl 7 ./

517−-- | Scalar multiplication of matrices.

518−(./) :: Fractional e => Matrix e cols rows -> e -> Matrix e cols rows

519−(./) (One a) e = One (a / e)

520−(./) (Join a b) e = Join (a ./ e) (b ./ e)

521−(./) (Fork a b) e = Fork (a ./ e) (b ./ e)

522−

523502-- Projections

524503

525504-- | Biproduct first component projection

526−p1 :: (Num e, CountableDims n m, FL n m, FL m m) => Matrix e (Either m n) m

527−p1 = join id zeros

505+p1 :: forall e m n. (Num e, CountableDimensions n m, FromLists e n m, FromLists e m m) => Matrix e (Either m n) m

506+p1 =

507+ let iden = identity :: Matrix e m m

508+ zero = zeros :: Matrix e n m

509+ in junc iden zero

528510

529511-- | Biproduct second component projection

530−p2 :: (Num e, CountableDims n m, FL m n, FL n n) => Matrix e (Either m n) n

531−p2 = join zeros id

512+p2 :: forall e m n. (Num e, CountableDimensions n m, FromLists e m n, FromLists e n n) => Matrix e (Either m n) n

513+p2 =

514+ let iden = identity :: Matrix e n n

515+ zero = zeros :: Matrix e m n

516+ in junc zero iden

532517

533518-- Injections

534519

535520-- | Biproduct first component injection

536−i1 :: (Num e, CountableDims n m, FL n m, FL m m) => Matrix e m (Either m n)

521+i1 :: (Num e, CountableDimensions n m, FromLists e n m, FromLists e m m) => Matrix e m (Either m n)

537522i1 = tr p1

538523

539524-- | Biproduct second component injection

540−i2 :: (Num e, CountableDims n m, FL m n, FL n n) => Matrix e n (Either m n)

525+i2 :: (Num e, CountableDimensions n m, FromLists e m n, FromLists e n n) => Matrix e n (Either m n)

541526i2 = tr p2

542527

543528-- Dimensions

544529

545530-- | Obtain the number of rows.

546531--

547−-- NOTE: The 'KnownNat' constraint is needed in order to obtain the

548−-- dimensions in constant time. For a version that doesn't require the

549−-- constraint see 'rows''.

532+-- NOTE: The 'KnownNat' constaint is needed in order to obtain the

533+-- dimensions in constant time.

534+--

535+-- TODO: A 'rows' function that does not need the 'KnownNat' constraint in

536+-- exchange for performance.

550537rows :: forall e cols rows. (Countable rows) => Matrix e cols rows -> Int

551538rows _ = fromInteger $ natVal (Proxy :: Proxy (Count rows))

552539

553−-- | Obtain the number of rows in an inefficient manner, but without any

554−-- constraints.

555−--

556−-- For a more efficient version see 'rows'.

557−rows' :: Matrix e cols rows -> Int

558−rows' (One _) = 1

559−rows' (Join lhs _) = rows' lhs

560−rows' (Fork top bottom) = rows' top + rows' bottom

561−

562540-- | Obtain the number of columns.

541+--

542+-- NOTE: The 'KnownNat' constaint is needed in order to obtain the

543+-- dimensions in constant time.

563544--

564−-- NOTE: The 'KnownNat' constraint is needed in order to obtain the

565−-- dimensions in constant time. For a version that doesn't require the

566−-- constraint see 'columns''.

545+-- TODO: A 'columns' function that does not need the 'KnownNat' constraint in

546+-- exchange for performance.

567547columns :: forall e cols rows. (Countable cols) => Matrix e cols rows -> Int

568548columns _ = fromInteger $ natVal (Proxy :: Proxy (Count cols))

569549

570−-- | Obtain the number of columns in an inefficient manner, but without any

571−-- constraints.

572−--

573−-- For a more efficient version see 'columns'.

574−columns' :: Matrix e cols rows -> Int

575−columns' (One _) = 1

576−columns' (Join lhs rhs) = columns' lhs + columns' rhs

577−columns' (Fork top _) = columns' top

578−

579550-- Coproduct Bifunctor

580551

581552infixl 5 -|-

@@ -584,161 +555,164 @@ infixl 5 -|-

584555(-|-) ::

585556 forall e n k m j.

586557 ( Num e,

587− CountableDims j k,

588− FL k k,

589− FL j k,

590− FL k j,

591− FL j j

558+ CountableDimensions j k,

559+ FromLists e k k,

560+ FromLists e j k,

561+ FromLists e k j,

562+ FromLists e j j

592563 ) =>

593564 Matrix e n k ->

594565 Matrix e m j ->

595566 Matrix e (Either n m) (Either k j)

596−(-|-) a b = Join (i1 . a) (i2 . b)

567+(-|-) a b = Junc (i1 . a) (i2 . b)

597568

598569-- Khatri Rao Product and projections

599570

600571-- | Khatri Rao product first component projection matrix.

601−fstM ::

572+kp1 ::

602573 forall e m k .

603574 ( Num e,

604− CountableDims k m,

605− FL (Normalize (m, k)) m,

575+ CountableDimensions k m,

576+ FromLists e (Normalize (m, k)) m,

606577 CountableN (m, k)

607578 ) => Matrix e (Normalize (m, k)) m

608−fstM = matrixBuilder' f

579+kp1 = matrixBuilder f

609580 where

610581 offset = fromInteger (natVal (Proxy :: Proxy (Count k)))

611582 f (x, y)

612583 | y >= (x * offset) && y <= (x * offset + offset - 1) = 1

613− | otherwise = 0

584+ | otherwise = 0

614585

615586-- | Khatri Rao product second component projection matrix.

616−sndM ::

587+kp2 ::

617588 forall e m k .

618589 ( Num e,

619− CountableDims k m,

620− FL (Normalize (m, k)) k,

590+ CountableDimensions k m,

591+ FromLists e (Normalize (m, k)) k,

621592 CountableN (m, k)

622593 ) => Matrix e (Normalize (m, k)) k

623−sndM = matrixBuilder' f

594+kp2 = matrixBuilder f

624595 where

625596 offset = fromInteger (natVal (Proxy :: Proxy (Count k)))

626597 f (x, y)

627598 | x == y || mod (y - x) offset == 0 = 1

628− | otherwise = 0

599+ | otherwise = 0

629600

630601-- | Khatri Rao Matrix product also known as matrix pairing.

631602--

632603-- NOTE: That this is not a true categorical product, see for instance:

633−--

604+--

634605-- @

635−-- | fstM . kr a b == a

636−-- kr a b ==> |

637−-- | sndM . kr a b == b

606+-- | kp1 . khatri a b == a

607+-- khatri a b ==> |

608+-- | kp2 . khatri a b == b

638609-- @

639610--

640611-- __Emphasis__ on the implication symbol.

641−kr ::

642− forall e cols a b.

612+khatri ::

613+ forall e cols a b.

643614 ( Num e,

644− CountableDims a b,

615+ CountableDimensions a b,

645616 CountableN (a, b),

646− FL (Normalize (a, b)) a,

647− FL (Normalize (a, b)) b

617+ FromLists e (Normalize (a, b)) a,

618+ FromLists e (Normalize (a, b)) b

648619 ) => Matrix e cols a -> Matrix e cols b -> Matrix e cols (Normalize (a, b))

649−kr a b =

650− let fstM' = fstM @e @a @b

651− sndM' = sndM @e @a @b

652− in (tr fstM' . a) * (tr sndM' . b)

620+khatri a b =

621+ let kp1' = kp1 @e @a @b

622+ kp2' = kp2 @e @a @b

623+ in (tr kp1') . a * (tr kp2') . b

653624

654625-- Product Bifunctor (Kronecker)

655626

656627infixl 4 ><

657628

658629-- | Matrix product functor also known as kronecker product

659−(><) ::

660− forall e m p n q.

630+(><) ::

631+ forall e m p n q.

661632 ( Num e,

662− CountableDims m n,

663− CountableDims p q,

664− CountableDimsN (m, n) (p, q),

665− FL (Normalize (m, n)) m,

666− FL (Normalize (m, n)) n,

667− FL (Normalize (p, q)) p,

668− FL (Normalize (p, q)) q

669− )

633+ CountableDimensions m n,

634+ CountableDimensions p q,

635+ CountableDimensionsN (m, n) (p, q),

636+ FromLists e (Normalize (m, n)) m,

637+ FromLists e (Normalize (m, n)) n,

638+ FromLists e (Normalize (p, q)) p,

639+ FromLists e (Normalize (p, q)) q

640+ )

670641 => Matrix e m p -> Matrix e n q -> Matrix e (Normalize (m, n)) (Normalize (p, q))

671642(><) a b =

672− let fstM' = fstM @e @m @n

673− sndM' = sndM @e @m @n

674− in kr (a . fstM') (b . sndM')

643+ let kp1' = kp1 @e @m @n

644+ kp2' = kp2 @e @m @n

645+ in khatri (a . kp1') (b . kp2')

675646

676−-- Matrix abide Join Fork

647+-- Matrix abide Junc Split

677648

678−-- | Matrix "abiding" following the 'Join'-'Fork' exchange law.

679−--

649+-- | Matrix "abiding" followin the 'Junc'-'Split' abide law.

650+--

680651-- Law:

681652--

682653-- @

683−-- 'Join' ('Fork' a c) ('Fork' b d) == 'Fork' ('Join' a b) ('Join' c d)

654+-- 'Junc' ('Split' a c) ('Split' b d) == 'Split' ('Junc' a b) ('Junc' c d)

684655-- @

685−abideJF :: Matrix e cols rows -> Matrix e cols rows

686−abideJF (Join (Fork a c) (Fork b d)) = Fork (Join (abideJF a) (abideJF b)) (Join (abideJF c) (abideJF d)) -- Join-Fork abide law

687−abideJF (One e) = One e

688−abideJF (Join a b) = Join (abideJF a) (abideJF b)

689−abideJF (Fork a b) = Fork (abideJF a) (abideJF b)

656+abideJS :: Matrix e cols rows -> Matrix e cols rows

657+abideJS (Junc (Split a c) (Split b d)) = Split (Junc (abideJS a) (abideJS b)) (Junc (abideJS c) (abideJS d)) -- Junc-Split abide law

658+abideJS Empty = Empty

659+abideJS (One e) = One e

660+abideJS (Junc a b) = Junc (abideJS a) (abideJS b)

661+abideJS (Split a b) = Split (abideJS a) (abideJS b)

690662

691−-- Matrix abide Fork Join

663+-- Matrix abide Split Junc

692664

693−-- | Matrix "abiding" followin the 'Fork'-'Join' abide law.

694−--

665+-- | Matrix "abiding" followin the 'Split'-'Junc' abide law.

666+--

695667-- @

696−-- 'Fork' ('Join' a b) ('Join' c d) == 'Join' ('Fork' a c) ('Fork' b d)

668+-- 'Split' ('Junc' a b) ('Junc' c d) == 'Junc' ('Split' a c) ('Split' b d)

697669-- @

698−abideFJ :: Matrix e cols rows -> Matrix e cols rows

699−abideFJ (Fork (Join a b) (Join c d)) = Join (Fork (abideFJ a) (abideFJ c)) (Fork (abideFJ b) (abideFJ d)) -- Fork-Join abide law

700−abideFJ (One e) = One e

701−abideFJ (Join a b) = Join (abideFJ a) (abideFJ b)

702−abideFJ (Fork a b) = Fork (abideFJ a) (abideFJ b)

670+abideSJ :: Matrix e cols rows -> Matrix e cols rows

671+abideSJ (Split (Junc a b) (Junc c d)) = Junc (Split (abideSJ a) (abideSJ c)) (Split (abideSJ b) (abideSJ d)) -- Split-Junc abide law

672+abideSJ Empty = Empty

673+abideSJ (One e) = One e

674+abideSJ (Junc a b) = Junc (abideSJ a) (abideSJ b)

675+abideSJ (Split a b) = Split (abideSJ a) (abideSJ b)

703676

704677-- Matrix transposition

705678

706679-- | Matrix transposition.

707680tr :: Matrix e cols rows -> Matrix e rows cols

708−tr (One e) = One e

709−tr (Join a b) = Fork (tr a) (tr b)

710−tr (Fork a b) = Join (tr a) (tr b)

681+tr Empty = Empty

682+tr (One e) = One e

683+tr (Junc a b) = Split (tr a) (tr b)

684+tr (Split a b) = Junc (tr a) (tr b)

711685

712686-- Selective 'select' operator

713687

714688-- | Selective functors 'select' operator equivalent inspired by the

715689-- ArrowMonad solution presented in the paper.

716−select :: (Num e, FL b b, Countable b) => Matrix e cols (Either a b) -> Matrix e a b -> Matrix e cols b

717−select (Fork a b) y = y . a + b -- Divide-and-conquer law

718−select (Join (Fork a c) (Fork b d)) y = join (y . a + c) (y . b + d) -- Pattern matching + DnC law

719−select m y = join y id . m

690+select :: (Num e, FromLists e b b, Countable b) => Matrix e cols (Either a b) -> Matrix e a b -> Matrix e cols b

691+select (Split a b) y = y . a + b -- Divide-and-conquer law

692+select (Junc (Split a c) (Split b d)) y = junc (y . a + c) (y . b + d) -- Pattern matching + DnC law

693+select m y = junc y identity . m

720694

721695branch ::

722696 ( Num e,

723− CountableDims a b,

724− CountableDims c (Either b c),

725− FL c b,

726− FL a b,

727− FL a a,

728− FL b b,

729− FL c c,

730− FL b a,

731− FL b c,

732− FL (Either b c) b,

733− FL (Either b c) c

697+ CountableDimensions a b,

698+ CountableDimensions c (Either b c),

699+ FromLists e c b,

700+ FromLists e a b,

701+ FromLists e a a,

702+ FromLists e b b,

703+ FromLists e c c,

704+ FromLists e b a,

705+ FromLists e b c,

706+ FromLists e (Either b c) b,

707+ FromLists e (Either b c) c

734708 )

735709 => Matrix e cols (Either a b) -> Matrix e a c -> Matrix e b c -> Matrix e cols c

736710branch x l r = f x `select` g l `select` r

737711 where

738− f :: (Num e, Countable a, CountableDims b c, FL a b, FL c b, FL b b, FL b a, FL a a)

712+ f :: (Num e, Countable a, CountableDimensions b c, FromLists e a b, FromLists e c b, FromLists e b b, FromLists e b a, FromLists e a a)

739713 => Matrix e cols (Either a b) -> Matrix e cols (Either a (Either b c))

740− f m = fork (tr i1) (i1 . tr i2) . m

741− g :: (Num e, CountableDims b c, FL b c, FL c c) => Matrix e a c -> Matrix e a (Either b c)

714+ f m = split (tr i1) (i1 . tr i2) . m

715+ g :: (Num e, CountableDimensions b c, FromLists e b c, FromLists e c c) => Matrix e a c -> Matrix e a (Either b c)

742716 g m = i2 . m

743717

744718-- McCarthy's Conditional

@@ -747,9 +721,9 @@ branch x l r = f x `select` g l `select` r

747721cond ::

748722 ( Trivial cols,

749723 Countable cols,

750− FL () cols,

751− FL cols (),

752− FL cols cols,

724+ FromLists e () cols,

725+ FromLists e cols (),

726+ FromLists e cols cols,

753727 Bounded a,

754728 Enum a,

755729 Num e,

@@ -757,14 +731,14 @@ cond ::

757731 )

758732 =>

759733 (a -> Bool) -> Matrix e cols rows -> Matrix e cols rows -> Matrix e cols rows

760−cond p f g = join f g . grd p

734+cond p f g = junc f g . grd p

761735

762−grd ::

736+grd ::

763737 ( Trivial q,

764738 Countable q,

765− FL () q,

766− FL q (),

767− FL q q,

739+ FromLists e () q,

740+ FromLists e q (),

741+ FromLists e q q,

768742 Bounded a,

769743 Enum a,

770744 Num e,

@@ -772,44 +746,44 @@ grd ::

772746 )

773747 =>

774748 (a -> Bool) -> Matrix e q (Either q q)

775−grd f = fork (corr f) (corr (not . f))

749+grd f = split (corr f) (corr (not . f))

776750

777−corr ::

778− forall e a q .

751+corr ::

752+ forall e a q .

779753 ( Trivial q,

780754 Countable q,

781− FL () q,

782− FL q (),

783− FL q q,

755+ FromLists e () q,

756+ FromLists e q (),

757+ FromLists e q q,

784758 Liftable e a Bool

785− )

759+ )

786760 => (a -> Bool) -> Matrix e q q

787−corr p = let f = fromF' p :: Matrix e q ()

788− in kr f (id :: Matrix e q q)

761+corr p = let f = fromF p :: Matrix e q ()

762+ in khatri f (identity :: Matrix e q q)

789763

790764-- Pretty print

791765

792766prettyAux :: Show e => [[e]] -> [[e]] -> String

793767prettyAux [] _ = ""

794−prettyAux [[e]] m = "│ " ++ fill (show e) ++ " │\n"

768+prettyAux [[e]] m = "│ " ++ fill (show e) ++ " │\n"

795769 where

796770 v = fmap show m

797771 widest = maximum $ fmap length v

798772 fill str = replicate (widest - length str - 2) ' ' ++ str

799−prettyAux [h] m = "│ " ++ fill (unwords $ map show h) ++ " │\n"

773+prettyAux [h] m = "│ " ++ fill (unwords $ map show h) ++ " │\n"

800774 where

801− v = fmap show m

802− widest = maximum $ fmap length v

775+ v = fmap show m

776+ widest = maximum $ fmap length v

803777 fill str = replicate (widest - length str - 2) ' ' ++ str

804−prettyAux (h : t) l = "│ " ++ fill (unwords $ map show h) ++ " │\n" ++

778+prettyAux (h : t) l = "│ " ++ fill (unwords $ map show h) ++ " │\n" ++

805779 prettyAux t l

806780 where

807− v = fmap show l

808− widest = maximum $ fmap length v

781+ v = fmap show l

782+ widest = maximum $ fmap length v

809783 fill str = replicate (widest - length str - 2) ' ' ++ str

810784

811785-- | Matrix pretty printer

812−pretty :: (CountableDims cols rows, Show e) => Matrix e cols rows -> String

786+pretty :: (CountableDimensions cols rows, Show e) => Matrix e cols rows -> String

813787pretty m = concat

814788 [ "┌ ", unwords (replicate (columns m) blank), " ┐\n"

815789 , unlines

@@ -817,16 +791,16 @@ pretty m = concat

817791 , "└ ", unwords (replicate (columns m) blank), " ┘"

818792 ]

819793 where

820− strings = map show (toList m)

821− widest = maximum $ map length strings

794+ strings = map show (toList m)

795+ widest = maximum $ map length strings

822796 fill str = replicate (widest - length str) ' ' ++ str

823− blank = fill ""

797+ blank = fill ""

824798 safeGet i j m

825799 | i > rows m || j > columns m || i < 1 || j < 1 = Nothing

826800 | otherwise = Just $ unsafeGet i j m (toList m)

827801 unsafeGet i j m l = l !! encode (columns m) (i,j)

828− encode m (i,j) = (i-1)*m + j - 1

829− getElem i j m =

802+ encode m (i,j) = (i-1)*m + j - 1

803+ getElem i j m =

830804 fromMaybe

831805 (error $

832806 "getElem: Trying to get the "

@@ -838,20 +812,21 @@ pretty m = concat

838812 (safeGet i j m)

839813

840814-- | Matrix pretty printer

841−prettyPrint :: (CountableDims cols rows, Show e) => Matrix e cols rows -> IO ()

815+prettyPrint :: (CountableDimensions cols rows, Show e) => Matrix e cols rows -> IO ()

842816prettyPrint = putStrLn . pretty

843817

844818-- | Zip two matrices with a given binary function

845819zipWithM :: (e -> f -> g) -> Matrix e cols rows -> Matrix f cols rows -> Matrix g cols rows

846−zipWithM f (One a) (One b) = One (f a b)

847−zipWithM f (Join a b) (Join c d) = Join (zipWithM f a c) (zipWithM f b d)

848−zipWithM f (Fork a b) (Fork c d) = Fork (zipWithM f a c) (zipWithM f b d)

849−zipWithM f x@(Fork _ _) y@(Join _ _) = zipWithM f x (abideJF y)

850−zipWithM f x@(Join _ _) y@(Fork _ _) = zipWithM f (abideJF x) y

820+zipWithM f Empty Empty = Empty

821+zipWithM f (One a) (One b) = One (f a b)

822+zipWithM f (Junc a b) (Junc c d) = Junc (zipWithM f a c) (zipWithM f b d)

823+zipWithM f (Split a b) (Split c d) = Split (zipWithM f a c) (zipWithM f b d)

824+zipWithM f x@(Split _ _) y@(Junc _ _) = zipWithM f x (abideJS y)

825+zipWithM f x@(Junc _ _) y@(Split _ _) = zipWithM f (abideJS x) y

851826

852827-- Relational operators functions

853828

854−type Boolean = Natural 0 1

829+type Boolean = Natural 0 1

855830type Relation a b = Matrix Boolean a b

856831

857832-- | Helper conversion function

@@ -867,47 +842,54 @@ fromBool False = nat 0

867842

868843-- | Relational negation

869844negateM :: Relation cols rows -> Relation cols rows

870−negateM (One (Nat p)) = One (Nat (negate p))

871−negateM (Join a b) = Join (negateM a) (negateM b)

872−negateM (Fork a b) = Fork (negateM a) (negateM b)

845+negateM Empty = Empty

846+negateM (One (Nat 0)) = One (Nat 1)

847+negateM (One (Nat 1)) = One (Nat 0)

848+negateM (Junc a b) = Junc (negateM a) (negateM b)

849+negateM (Split a b) = Split (negateM a) (negateM b)

873850

874851-- | Relational addition

875852orM :: Relation cols rows -> Relation cols rows -> Relation cols rows

876−orM (One a) (One b) = One (fromBool (toBool a || toBool b))

877−orM (Join a b) (Join c d) = Join (orM a c) (orM b d)

878−orM (Fork a b) (Fork c d) = Fork (orM a c) (orM b d)

879−orM x@(Fork _ _) y@(Join _ _) = orM x (abideJF y)

880−orM x@(Join _ _) y@(Fork _ _) = orM (abideJF x) y

853+orM Empty Empty = Empty

854+orM (One a) (One b) = One (fromBool (toBool a || toBool b))

855+orM (Junc a b) (Junc c d) = Junc (orM a c) (orM b d)

856+orM (Split a b) (Split c d) = Split (orM a c) (orM b d)

857+orM x@(Split _ _) y@(Junc _ _) = orM x (abideJS y)

858+orM x@(Junc _ _) y@(Split _ _) = orM (abideJS x) y

881859

882860-- | Relational multiplication

883861andM :: Relation cols rows -> Relation cols rows -> Relation cols rows

884−andM (One a) (One b) = One (fromBool (toBool a && toBool b))

885−andM (Join a b) (Join c d) = Join (andM a c) (andM b d)

886−andM (Fork a b) (Fork c d) = Fork (andM a c) (andM b d)

887−andM x@(Fork _ _) y@(Join _ _) = andM x (abideJF y)

888−andM x@(Join _ _) y@(Fork _ _) = andM (abideJF x) y

862+andM Empty Empty = Empty

863+andM (One a) (One b) = One (fromBool (toBool a && toBool b))

864+andM (Junc a b) (Junc c d) = Junc (andM a c) (andM b d)

865+andM (Split a b) (Split c d) = Split (andM a c) (andM b d)

866+andM x@(Split _ _) y@(Junc _ _) = andM x (abideJS y)

867+andM x@(Junc _ _) y@(Split _ _) = andM (abideJS x) y

889868

890869-- | Relational subtraction

891870subM :: Relation cols rows -> Relation cols rows -> Relation cols rows

892−subM (One a) (One b) = if a - b < nat 0 then One (nat 0) else One (a - b)

893−subM (Join a b) (Join c d) = Join (subM a c) (subM b d)

894−subM (Fork a b) (Fork c d) = Fork (subM a c) (subM b d)

895−subM x@(Fork _ _) y@(Join _ _) = subM x (abideJF y)

896−subM x@(Join _ _) y@(Fork _ _) = subM (abideJF x) y

871+subM Empty Empty = Empty

872+subM (One a) (One b) = if a - b < nat 0 then One (nat 0) else One (a - b)

873+subM (Junc a b) (Junc c d) = Junc (subM a c) (subM b d)

874+subM (Split a b) (Split c d) = Split (subM a c) (subM b d)

875+subM x@(Split _ _) y@(Junc _ _) = subM x (abideJS y)

876+subM x@(Junc _ _) y@(Split _ _) = subM (abideJS x) y

897877

898878-- | Matrix relational composition.

899879compRel :: Relation cr rows -> Relation cols cr -> Relation cols rows

900−compRel (One a) (One b) = One (fromBool (toBool a && toBool b))

901−compRel (Join a b) (Fork c d) = orM (compRel a c) (compRel b d) -- Divide-and-conquer law

902−compRel (Fork a b) c = Fork (compRel a c) (compRel b c) -- Fork fusion law

903−compRel c (Join a b) = Join (compRel c a) (compRel c b) -- Join fusion law

880+compRel Empty Empty = Empty

881+compRel (One a) (One b) = One (fromBool (toBool a && toBool b))

882+compRel (Junc a b) (Split c d) = orM (compRel a c) (compRel b d) -- Divide-and-conquer law

883+compRel (Split a b) c = Split (compRel a c) (compRel b c) -- Split fusion law

884+compRel c (Junc a b) = Junc (compRel c a) (compRel c b) -- Junc fusion law

904885

905886-- | Matrix relational right division

906887divR :: Relation b c -> Relation b a -> Relation a c

888+divR Empty Empty = Empty

907889divR (One a) (One b) = One (fromBool (not (toBool b) || toBool a)) -- b implies a

908−divR (Join a b) (Join c d) = andM (divR a c) (divR b d)

909−divR (Fork a b) c = Fork (divR a c) (divR b c)

910−divR c (Fork a b) = Join (divR c a) (divR c b)

890+divR (Junc a b) (Junc c d) = andM (divR a c) (divR b d)

891+divR (Split a b) c = Split (divR a c) (divR b c)

892+divR c (Split a b) = Junc (divR c a) (divR c b)

911893

912894-- | Matrix relational left division

913895divL :: Relation c b -> Relation a b -> Relation a c

@@ -923,52 +905,86 @@ divS s r = divL r s `intersection` divR (tr r) (tr s)

923905--

924906-- NOTE: Be careful to not ask for a relation bigger than the cardinality of

925907-- types @a@ or @b@ allows.

926−fromFRel' ::

908+fromFRel ::

927909 forall a b cols rows.

928910 ( Liftable Boolean a b,

929− CountableDims cols rows,

930− FL rows cols

911+ CountableDimensions cols rows,

912+ FromLists Boolean rows cols

931913 ) =>

932914 (a -> b) ->

933915 Relation cols rows

934−fromFRel' = fromF'

916+fromFRel f =

917+ let minA = minBound @a

918+ maxA = maxBound @a

919+ minB = minBound @b

920+ maxB = maxBound @b

921+ ccols = fromInteger $ natVal (Proxy :: Proxy (Count cols))

922+ rrows = fromInteger $ natVal (Proxy :: Proxy (Count rows))

923+ elementsA = take ccols [minA .. maxA]

924+ elementsB = take rrows [minB .. maxB]

925+ combinations = (,) <$> elementsA <*> elementsB

926+ combAp = map snd . sort . map (\(a, b) -> if f a == b

927+ then ((fromEnum a, fromEnum b), nat 1)

928+ else ((fromEnum a, fromEnum b), nat 0)) $ combinations

929+ mList = buildList combAp rrows

930+ in tr $ fromLists mList

931+ where

932+ buildList [] _ = []

933+ buildList l r = take r l : buildList (drop r l) r

935934

936935-- | Lifts functions to relations with dimensions matching @a@ and @b@

937936-- cardinality's.

938−fromFRel ::

937+fromFRel' ::

939938 forall a b.

940939 ( Liftable Boolean a b,

941− CountableDimsN a b,

942− FLN b a

940+ CountableDimensionsN a b,

941+ FromLists Boolean (Normalize b) (Normalize a)

943942 ) =>

944943 (a -> b) ->

945944 Relation (Normalize a) (Normalize b)

946−fromFRel = fromFRel'

945+fromFRel' f =

946+ let minA = minBound @a

947+ maxA = maxBound @a

948+ minB = minBound @b

949+ maxB = maxBound @b

950+ ccols = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize a)))

951+ rrows = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize b)))

952+ elementsA = take ccols [minA .. maxA]

953+ elementsB = take rrows [minB .. maxB]

954+ combinations = (,) <$> elementsA <*> elementsB

955+ combAp = map snd . sort . map (\(a, b) -> if f a == b

956+ then ((fromEnum a, fromEnum b), nat 1)

957+ else ((fromEnum a, fromEnum b), nat 0)) $ combinations

958+ mList = buildList combAp rrows

959+ in tr $ fromLists mList

960+ where

961+ buildList [] _ = []

962+ buildList l r = take r l : buildList (drop r l) r

947963

948964-- | Lifts a relation function to a Boolean Matrix

949−toRel ::

965+toRel ::

950966 forall a b.

951967 ( Bounded a,

952968 Bounded b,

953969 Enum a,

954970 Enum b,

955971 Eq b,

956− CountableDims a b,

957− FLN b a

958− )

972+ CountableDimensionsN a b,

973+ FromListsN Boolean b a

974+ )

959975 => (a -> b -> Bool) -> Relation (Normalize a) (Normalize b)

960976toRel f =

961977 let minA = minBound @a

962978 maxA = maxBound @a

963979 minB = minBound @b

964980 maxB = maxBound @b

965− ccols = fromInteger $ natVal (Proxy :: Proxy (Count a))

966− rrows = fromInteger $ natVal (Proxy :: Proxy (Count b))

981+ ccols = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize a)))

982+ rrows = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize b)))

967983 elementsA = take ccols [minA .. maxA]

968984 elementsB = take rrows [minB .. maxB]

969985 combinations = (,) <$> elementsA <*> elementsB

970− combAp = map snd . sort . map (\(a, b) -> if uncurry f (a, b)

971− then ((fromEnum a, fromEnum b), nat 1)

986+ combAp = map snd . sort . map (\(a, b) -> if uncurry f (a, b)

987+ then ((fromEnum a, fromEnum b), nat 1)

972988 else ((fromEnum a, fromEnum b), nat 0)) $ combinations

973989 mList = buildList combAp rrows

974990 in tr $ fromLists mList

src/LAoP/Matrix/Nat.hs+124−132

@@ -56,20 +56,21 @@ module LAoP.Matrix.Nat

5656

5757 -- * Constraint type synonyms

5858 Countable,

59− CountableDims,

59+ CountableDimensions,

6060 CountableN,

6161 CountableNz,

62− CountableDimsN,

63− FLN,

64− FLNz,

62+ CountableDimensionsN,

63+ FromListsN,

64+ FromListsNz,

6565 Liftable,

6666 TrivialE,

6767 TrivialP,

6868

6969 -- * Primitives

70+ empty,

7071 one,

71− join,

72− fork,

72+ junc,

73+ split,

7374

7475 -- * Auxiliary type families

7576 I.FromNat,

@@ -77,11 +78,11 @@ module LAoP.Matrix.Nat

7778 I.Normalize,

7879

7980 -- * Matrix construction and conversion

80− I.FL,

81+ I.FromLists,

8182 fromLists,

8283 toLists,

8384 toList,

84− matrixBuilder',

85+ matrixBuilder,

8586 row,

8687 col,

8788 zeros,

@@ -97,10 +98,6 @@ module LAoP.Matrix.Nat

9798 -- ** Matrix Transposition

9899 tr,

99100

100− -- ** Scalar multiplication/division of matrices

101− (.|),

102− (./),

103−

104101 -- ** Selective operator

105102 select,

106103

@@ -108,19 +105,19 @@ module LAoP.Matrix.Nat

108105 cond,

109106

110107 -- ** Matrix "abiding"

111− abideJF,

112− abideFJ,

108+ abideJS,

109+ abideSJ,

113110

114111 -- ** Zip Matrices

115112 zipWithM,

116113

117114 -- * Biproduct approach

118− -- ** Fork

115+ -- ** Split

119116 (===),

120117 -- *** Projections

121118 p1,

122119 p2,

123− -- ** Join

120+ -- ** Junc

124121 (|||),

125122 -- *** Injections

126123 i1,

@@ -134,11 +131,11 @@ module LAoP.Matrix.Nat

134131 -- | Note that given the restrictions imposed it is not possible to

135132 -- implement the standard type classes present in standard Haskell.

136133 -- *** Matrix pairing projections

137− fstM,

138− sndM,

134+ kp1,

135+ kp2,

139136

140137 -- *** Matrix pairing

141− kr,

138+ khatri,

142139

143140 -- * Matrix composition and lifting

144141

@@ -146,10 +143,10 @@ module LAoP.Matrix.Nat

146143

147144 -- | Note that given the restrictions imposed it is not possible to

148145 -- implement the standard type classes present in standard Haskell.

149− iden,

146+ identity,

150147 comp,

151− fromF',

152148 fromF,

149+ fromF',

153150

154151 -- * Matrix printing

155152 pretty,

@@ -160,34 +157,47 @@ where

160157import Data.Proxy

161158import GHC.TypeLits

162159import Control.DeepSeq

160+import qualified Control.Category as C

163161import qualified LAoP.Matrix.Internal as I

164162

165163newtype Matrix e (cols :: Nat) (rows :: Nat) = M (I.Matrix e (I.FromNat cols) (I.FromNat rows))

166164 deriving (Show, Num, Eq, Ord, NFData) via (I.Matrix e (I.FromNat cols) (I.FromNat rows))

167165

168166-- | Constraint type synonyms to keep the type signatures less convoluted

169−type Countable a = KnownNat (I.Count a)

170−type CountableDims a b = (Countable a, Countable b)

171−type CountableN a = KnownNat (I.Count (I.FromNat a))

172−type CountableNz a = KnownNat (I.Count (I.Normalize a))

173−type CountableDimsN a b = (CountableN a, CountableN b)

174−type FLN e a b = I.FL (I.FromNat a) (I.FromNat b)

175−type FLNz e a b = I.FL (I.Normalize a) (I.Normalize b)

176−type Liftable e a b = (Bounded a, Bounded b, Enum a, Enum b, Eq b, Num e, Ord e)

177−type TrivialE a b = I.FromNat (a + b) ~ Either (I.FromNat a) (I.FromNat b)

178−type TrivialP a b = I.FromNat (a * b) ~ I.FromNat (I.Count (I.FromNat a) * I.Count (I.FromNat b))

167+type Countable a = KnownNat (I.Count a)

168+type CountableDimensions a b = (Countable a, Countable b)

169+type CountableN a = KnownNat (I.Count (I.FromNat a))

170+type CountableNz a = KnownNat (I.Count (I.Normalize a))

171+type CountableDimensionsN a b = (CountableN a, CountableN b)

172+type FromListsN e a b = I.FromLists e (I.FromNat a) (I.FromNat b)

173+type FromListsNz e a b = I.FromLists e (I.Normalize a) (I.Normalize b)

174+type Liftable e a b = (Bounded a, Bounded b, Enum a, Enum b, Eq b, Num e, Ord e)

175+type TrivialE a b = I.FromNat (a + b) ~ Either (I.FromNat a) (I.FromNat b)

176+type TrivialP a b = I.FromNat (a * b) ~ I.FromNat (I.Count (I.FromNat a) * I.Count (I.FromNat b))

177+

178+-- | It isn't possible to implement the 'id' function so it's

179+-- implementation is 'undefined'. However 'comp' can be and this partial

180+-- class implementation exists just to make the code more readable.

181+--

182+-- Please use 'identity' instead.

183+instance (Num e) => C.Category (Matrix e) where

184+ id = undefined

185+ (.) = comp

179186

180187-- Primitives

181188

189+empty :: Matrix e 0 0

190+empty = M I.Empty

191+

182192one :: e -> Matrix e 1 1

183193one = M . I.One

184194

185−join ::

195+junc ::

186196 (TrivialE a b) =>

187197 Matrix e a rows ->

188198 Matrix e b rows ->

189199 Matrix e (a + b) rows

190−join (M a) (M b) = M (I.Join a b)

200+junc (M a) (M b) = M (I.Junc a b)

191201

192202infixl 3 |||

193203(|||) ::

@@ -195,14 +205,14 @@ infixl 3 |||

195205 Matrix e a rows ->

196206 Matrix e b rows ->

197207 Matrix e (a + b) rows

198−(|||) = join

208+(|||) = junc

199209

200−fork ::

210+split ::

201211 (TrivialE a b) =>

202212 Matrix e cols a ->

203213 Matrix e cols b ->

204214 Matrix e cols (a + b)

205−fork (M a) (M b) = M (I.Fork a b)

215+split (M a) (M b) = M (I.Split a b)

206216

207217infixl 2 ===

208218(===) ::

@@ -210,45 +220,43 @@ infixl 2 ===

210220 Matrix e cols a ->

211221 Matrix e cols b ->

212222 Matrix e cols (a + b)

213−(===) = fork

223+(===) = split

214224

215225-- Construction

216226

217−fromLists :: (FLN e cols rows) => [[e]] -> Matrix e cols rows

227+fromLists :: (FromListsN e cols rows) => [[e]] -> Matrix e cols rows

218228fromLists = M . I.fromLists

219229

220−-- | Matrix builder function. Constructs a matrix provided with

221−-- a construction function that operates with indices.

222−matrixBuilder' ::

223− (FLN e cols rows, CountableN cols, CountableN rows)

230+matrixBuilder ::

231+ (FromListsN e cols rows, CountableN cols, CountableN rows)

224232 => ((Int, Int) -> e) -> Matrix e cols rows

225−matrixBuilder' = M . I.matrixBuilder'

233+matrixBuilder = M . I.matrixBuilder

226234

227−col :: (I.FL () (I.FromNat rows)) => [e] -> Matrix e 1 rows

235+col :: (I.FromLists e () (I.FromNat rows)) => [e] -> Matrix e 1 rows

228236col = M . I.col

229237

230−row :: (I.FL (I.FromNat cols) ()) => [e] -> Matrix e cols 1

238+row :: (I.FromLists e (I.FromNat cols) ()) => [e] -> Matrix e cols 1

231239row = M . I.row

232240

233−fromF' ::

241+fromF ::

234242 ( Liftable e a b,

235243 CountableN cols,

236244 CountableN rows,

237− FLN e rows cols

245+ FromListsN e rows cols

238246 ) =>

239247 (a -> b) ->

240248 Matrix e cols rows

241−fromF' = M . I.fromF'

249+fromF = M . I.fromF

242250

243−fromF ::

251+fromF' ::

244252 ( Liftable e a b,

245253 CountableNz a,

246254 CountableNz b,

247− FLNz e b a

255+ FromListsNz e b a

248256 ) =>

249257 (a -> b) ->

250258 Matrix e (I.Count a) (I.Count b)

251−fromF = undefined -- M . I.fromF

259+fromF' = undefined -- M . I.fromF'

252260

253261-- Conversion

254262

@@ -261,21 +269,21 @@ toList (M m) = I.toList m

261269-- Zeros Matrix

262270

263271zeros ::

264− (Num e, FLN e cols rows, CountableN cols, CountableN rows) =>

272+ (Num e, FromListsN e cols rows, CountableN cols, CountableN rows) =>

265273 Matrix e cols rows

266274zeros = M I.zeros

267275

268276-- Ones Matrix

269277

270278ones ::

271− (Num e, FLN e cols rows, CountableN cols, CountableN rows) =>

279+ (Num e, FromListsN e cols rows, CountableN cols, CountableN rows) =>

272280 Matrix e cols rows

273281ones = M I.ones

274282

275283-- Const Matrix

276284

277285constant ::

278− (Num e, FLN e cols rows, CountableN cols, CountableN rows) =>

286+ (Num e, FromListsN e cols rows, CountableN cols, CountableN rows) =>

279287 e ->

280288 Matrix e cols rows

281289constant = M . I.constant

@@ -284,41 +292,27 @@ constant = M . I.constant

284292

285293bang ::

286294 forall e cols.

287− (Num e, Enum e, I.FL (I.FromNat cols) (), CountableN cols) =>

295+ (Num e, Enum e, I.FromLists e (I.FromNat cols) (), CountableN cols) =>

288296 Matrix e cols 1

289297bang = M I.bang

290298

291−-- iden Matrix

299+-- Identity Matrix

292300

293−iden ::

294− (Num e, FLN e cols cols, CountableN cols) =>

301+identity ::

302+ (Num e, FromListsN e cols cols, CountableN cols) =>

295303 Matrix e cols cols

296−iden = M I.iden

304+identity = M I.identity

297305

298306-- Matrix composition (MMM)

299307

300308comp :: (Num e) => Matrix e cr rows -> Matrix e cols cr -> Matrix e cols rows

301309comp (M a) (M b) = M (I.comp a b)

302310

303−-- Scalar multiplication of matrices

304−

305−infixl 7 .|

306−-- | Scalar multiplication of matrices.

307−(.|) :: Num e => e -> Matrix e cols rows -> Matrix e cols rows

308−(.|) e (M m) = M (e I..| m)

309−

310−-- Scalar division of matrices

311−

312−infixl 7 ./

313−-- | Scalar multiplication of matrices.

314−(./) :: Fractional e => Matrix e cols rows -> e -> Matrix e cols rows

315−(./) (M m) e = M (m I../ e)

316−

317311p1 ::

318312 ( Num e,

319− CountableDimsN n m,

320− FLN e n m,

321− FLN e m m,

313+ CountableDimensionsN n m,

314+ FromListsN e n m,

315+ FromListsN e m m,

322316 TrivialE m n

323317 ) =>

324318 Matrix e (m + n) m

@@ -326,9 +320,9 @@ p1 = M I.p1

326320

327321p2 ::

328322 ( Num e,

329− CountableDimsN n m,

330− FLN e m n,

331− FLN e n n,

323+ CountableDimensionsN n m,

324+ FromListsN e m n,

325+ FromListsN e n n,

332326 TrivialE m n

333327 ) =>

334328 Matrix e (m + n) n

@@ -338,9 +332,9 @@ p2 = M I.p2

338332

339333i1 ::

340334 ( Num e,

341− CountableDimsN n rows,

342− FLN e n rows,

343− FLN e rows rows,

335+ CountableDimensionsN n rows,

336+ FromListsN e n rows,

337+ FromListsN e rows rows,

344338 TrivialE rows n

345339 ) =>

346340 Matrix e rows (rows + n)

@@ -348,9 +342,9 @@ i1 = tr p1

348342

349343i2 ::

350344 ( Num e,

351− CountableDimsN rows m,

352− FLN e m rows,

353− FLN e rows rows,

345+ CountableDimensionsN rows m,

346+ FromListsN e m rows,

347+ FromListsN e rows rows,

354348 TrivialE m rows

355349 ) =>

356350 Matrix e rows (m + rows)

@@ -364,16 +358,16 @@ rows (M m) = I.rows m

364358columns :: (CountableN cols) => Matrix e cols rows -> Int

365359columns (M m) = I.columns m

366360

361+-- | Coproduct Bifunctor

367362infixl 5 -|-

368363

369−-- | Coproduct Bifunctor (Direct sum)

370364(-|-) ::

371365 ( Num e,

372− CountableDimsN j k,

373− FLN e k k,

374− FLN e j k,

375− FLN e k j,

376− FLN e j j,

366+ CountableDimensionsN j k,

367+ FromListsN e k k,

368+ FromListsN e j k,

369+ FromListsN e k j,

370+ FromListsN e j j,

377371 TrivialE n m,

378372 TrivialE k j

379373 ) =>

@@ -382,42 +376,40 @@ infixl 5 -|-

382376 Matrix e (n + m) (k + j)

383377(-|-) (M a) (M b) = M ((I.-|-) a b)

384378

385−-- | Khatri Rao Product first projection

386−fstM ::

379+-- | Khatri Rao Product and projections

380+kp1 ::

387381 forall e m k .

388382 ( Num e,

389− CountableDimsN m k,

383+ CountableDimensionsN m k,

390384 CountableN (m * k),

391− FLN e (m * k) m,

385+ FromListsN e (m * k) m,

392386 TrivialP m k

393387 ) => Matrix e (m * k) m

394−fstM = M (I.fstM @e @(I.FromNat m) @(I.FromNat k))

388+kp1 = M (I.kp1 @e @(I.FromNat m) @(I.FromNat k))

395389

396−-- | Khatri Rao Product second projection

397−sndM ::

390+kp2 ::

398391 forall e m k.

399392 ( Num e,

400− CountableDimsN k m,

401− FLN e (m * k) k,

393+ CountableDimensionsN k m,

394+ FromListsN e (m * k) k,

402395 CountableN (m * k),

403396 TrivialP m k

404397 ) => Matrix e (m * k) k

405−sndM = M (I.sndM @e @(I.FromNat m) @(I.FromNat k))

398+kp2 = M (I.kp2 @e @(I.FromNat m) @(I.FromNat k))

406399

407−-- | Khatri Rao Product

408−kr ::

400+khatri ::

409401 forall e cols a b.

410402 ( Num e,

411− CountableDimsN a b,

403+ CountableDimensionsN a b,

412404 CountableN (a * b),

413− FLN e (a * b) a,

414− FLN e (a * b) b,

405+ FromListsN e (a * b) a,

406+ FromListsN e (a * b) b,

415407 TrivialP a b

416408 ) => Matrix e cols a -> Matrix e cols b -> Matrix e cols (a * b)

417−kr a b =

418− let fstM' = fstM @e @a @b

419− sndM' = sndM @e @a @b

420− in comp (tr fstM') a * comp (tr sndM') b

409+khatri a b =

410+ let kp1' = kp1 @e @a @b

411+ kp2' = kp2 @e @a @b

412+ in comp (tr kp1') a * comp (tr kp2') b

421413

422414-- | Product Bifunctor (Kronecker)

423415infixl 4 ><

@@ -425,28 +417,28 @@ infixl 4 ><

425417(><) ::

426418 forall e m p n q.

427419 ( Num e,

428− CountableDimsN m n,

429− CountableDimsN p q,

430− CountableDimsN (m * n) (p * q),

431− FLN e (m * n) m,

432− FLN e (m * n) n,

433− FLN e (p * q) p,

434− FLN e (p * q) q,

420+ CountableDimensionsN m n,

421+ CountableDimensionsN p q,

422+ CountableDimensionsN (m * n) (p * q),

423+ FromListsN e (m * n) m,

424+ FromListsN e (m * n) n,

425+ FromListsN e (p * q) p,

426+ FromListsN e (p * q) q,

435427 TrivialP m n,

436428 TrivialP p q

437429 ) => Matrix e m p -> Matrix e n q -> Matrix e (m * n) (p * q)

438430(><) a b =

439− let fstM' = fstM @e @m @n

440− sndM' = sndM @e @m @n

441− in kr (comp a fstM') (comp b sndM')

431+ let kp1' = kp1 @e @m @n

432+ kp2' = kp2 @e @m @n

433+ in khatri (comp a kp1') (comp b kp2')

442434

443−-- | Matrix abide Join Fork

444−abideJF :: Matrix e cols rows -> Matrix e cols rows

445−abideJF (M m) = M (I.abideJF m)

435+-- | Matrix abide Junc Split

436+abideJS :: Matrix e cols rows -> Matrix e cols rows

437+abideJS (M m) = M (I.abideJS m)

446438

447−-- | Matrix abide Fork Join

448−abideFJ :: Matrix e cols rows -> Matrix e cols rows

449−abideFJ (M m) = M (I.abideFJ m)

439+-- | Matrix abide Split Junc

440+abideSJ :: Matrix e cols rows -> Matrix e cols rows

441+abideSJ (M m) = M (I.abideSJ m)

450442

451443-- | Matrix transposition

452444tr :: Matrix e cols rows -> Matrix e rows cols

@@ -455,7 +447,7 @@ tr (M m) = M (I.tr m)

455447-- Selective 'select' operator

456448select ::

457449 ( Num e,

458− FLN e rows1 rows1,

450+ FromListsN e rows1 rows1,

459451 CountableN rows1,

460452 I.FromNat rows2 ~ I.FromNat rows1,

461453 I.FromNat cols1 ~ I.FromNat cols2,

@@ -468,9 +460,9 @@ select (M m) (M y) = M (I.select m y)

468460cond ::

469461 ( I.FromNat (I.Count (I.FromNat cols)) ~ I.FromNat cols,

470462 CountableN cols,

471− I.FL () (I.FromNat cols),

472− I.FL (I.FromNat cols) (),

473− FLN e cols cols,

463+ I.FromLists e () (I.FromNat cols),

464+ I.FromLists e (I.FromNat cols) (),

465+ FromListsN e cols cols,

474466 Liftable e a Bool

475467 )

476468 =>

@@ -479,10 +471,10 @@ cond p (M a) (M b) = M (I.cond p a b)

479471

480472-- Pretty print

481473

482−pretty :: (CountableDimsN cols rows, Show e) => Matrix e cols rows -> String

474+pretty :: (CountableDimensionsN cols rows, Show e) => Matrix e cols rows -> String

483475pretty (M m) = I.pretty m

484476

485−prettyPrint :: (CountableDimsN cols rows, Show e) => Matrix e cols rows -> IO ()

477+prettyPrint :: (CountableDimensionsN cols rows, Show e) => Matrix e cols rows -> IO ()

486478prettyPrint (M m) = I.prettyPrint m

487479

488480-- | Zip two matrices with a given binary function

src/LAoP/Matrix/Type.hs+180−217

@@ -1,11 +1,11 @@

11{-# LANGUAGE ConstraintKinds #-}

2−{-# LANGUAGE TypeFamilies #-}

32{-# LANGUAGE AllowAmbiguousTypes #-}

43{-# LANGUAGE DataKinds #-}

54{-# LANGUAGE DerivingVia #-}

65{-# LANGUAGE FlexibleContexts #-}

76{-# LANGUAGE FlexibleInstances #-}

87{-# LANGUAGE GADTs #-}

8+{-# LANGUAGE KindSignatures #-}

99{-# LANGUAGE MultiParamTypeClasses #-}

1010{-# LANGUAGE NoStarIsType #-}

1111{-# LANGUAGE RankNTypes #-}

@@ -58,10 +58,10 @@ module LAoP.Matrix.Type

5858

5959 -- * Constraint type aliases

6060 Countable,

61− CountableDims,

61+ CountableDimensions,

6262 CountableN,

63− CountableDimsN,

64− FLN,

63+ CountableDimensionsN,

64+ FromListsN,

6565 Liftable,

6666 Trivial,

6767 TrivialP,

@@ -71,9 +71,10 @@ module LAoP.Matrix.Type

7171 One,

7272

7373 -- * Primitives

74+ empty,

7475 one,

75− join,

76− fork,

76+ junc,

77+ split,

7778

7879 -- * Auxiliary type families

7980 I.FromNat,

@@ -85,7 +86,6 @@ module LAoP.Matrix.Type

8586 fromLists,

8687 toLists,

8788 toList,

88− matrixBuilder',

8989 matrixBuilder,

9090 row,

9191 col,

@@ -104,8 +104,8 @@ module LAoP.Matrix.Type

104104 multM,

105105

106106 -- * Selective equivalent instance function

107− selectM,

108−

107+ selectM,

108+

109109 -- * Monad equivalent instance function

110110 returnM,

111111 bindM,

@@ -113,34 +113,28 @@ module LAoP.Matrix.Type

113113 -- * Misc

114114 -- ** Get dimensions

115115 columns,

116− columns',

117116 rows,

118− rows',

119117

120118 -- ** Matrix Transposition

121119 tr,

122120

123− -- ** Scalar multiplication/division of matrices

124− (.|),

125− (./),

126−

127121 -- ** McCarthy's Conditional

128122 cond,

129123

130124 -- ** Matrix "abiding"

131− abideJF,

132− abideFJ,

125+ abideJS,

126+ abideSJ,

133127

134128 -- ** Zip Matrices

135129 zipWithM,

136130

137131 -- * Biproduct approach

138− -- ** Fork

132+ -- ** Split

139133 (===),

140134 -- *** Projections

141135 p1,

142136 p2,

143− -- ** Join

137+ -- ** Junc

144138 (|||),

145139 -- *** Injections

146140 i1,

@@ -154,11 +148,11 @@ module LAoP.Matrix.Type

154148 -- | Note that given the restrictions imposed it is not possible to

155149 -- implement the standard type classes present in standard Haskell.

156150 -- *** Matrix pairing projections

157− fstM,

158− sndM,

151+ kp1,

152+ kp2,

159153

160154 -- *** Matrix pairing

161− kr,

155+ khatri,

162156

163157 -- * Matrix composition and lifting

164158

@@ -166,10 +160,10 @@ module LAoP.Matrix.Type

166160

167161 -- | Note that given the restrictions imposed it is not possible to

168162 -- implement the standard type classes present in standard Haskell.

169− iden,

163+ identity,

170164 comp,

171− fromF',

172165 fromF,

166+ fromF',

173167

174168 -- * Relation

175169 toRel,

@@ -183,44 +177,46 @@ where

183177import Data.Void

184178import Data.Proxy

185179import Data.Kind

186−import GHC.TypeLits

180+import GHC.TypeLits

187181import Control.DeepSeq

188182import LAoP.Utils

183+import qualified Control.Category as C

189184import qualified LAoP.Matrix.Internal as I

190−import Prelude hiding (id, (.))

191185

192186newtype Matrix e (cols :: Type) (rows :: Type) = M (I.Matrix e (I.Normalize cols) (I.Normalize rows))

193187 deriving (Show, Num, Eq, Ord, NFData) via (I.Matrix e (I.Normalize cols) (I.Normalize rows))

194188

195189-- | Constraint type synonyms to keep the type signatures less convoluted

196−type Countable a = KnownNat (I.Count a)

197−type CountableDims a b = (Countable a, Countable b)

198−type CountableN a = KnownNat (I.Count (I.Normalize a))

199−type CountableDimsN a b = (CountableN a, CountableN b)

200−type FLN a b = I.FromLists (I.Normalize a) (I.Normalize b)

201−type Liftable e a b = (Bounded a, Bounded b, Enum a, Enum b, Eq b, Num e, Ord e)

202−type Trivial a = I.Normalize (I.Normalize a) ~ I.Normalize (I.Normalize (I.Normalize a))

203−type Trivial2 a = I.Normalize a ~ I.Normalize (I.Normalize a)

204−type Trivial3 a = I.FromNat (I.Count (I.Normalize (I.Normalize a))) ~ I.Normalize (I.Normalize a)

205−type TrivialP a b = I.Normalize (a, b) ~ I.Normalize (I.Normalize a, I.Normalize b)

206−

207−-- | It is possible to implement a constrained version of the category type

208−-- class.

209−instance (Num e) => Category (Matrix e) where

210− type Object (Matrix e) a = (FLN a a, CountableN a)

211− id = iden

212− (.) = comp

190+type Countable a = KnownNat (I.Count a)

191+type CountableDimensions a b = (Countable a, Countable b)

192+type CountableN a = KnownNat (I.Count (I.Normalize a))

193+type CountableDimensionsN a b = (CountableN a, CountableN b)

194+type FromListsN e a b = I.FromLists e (I.Normalize a) (I.Normalize b)

195+type Liftable e a b = (Bounded a, Bounded b, Enum a, Enum b, Eq b, Num e, Ord e)

196+type Trivial a = I.Normalize (I.Normalize a) ~ I.Normalize (I.Normalize (I.Normalize a))

197+type Trivial2 a = I.Normalize a ~ I.Normalize (I.Normalize a)

198+type Trivial3 a = I.FromNat (I.Count (I.Normalize (I.Normalize a))) ~ I.Normalize (I.Normalize a)

199+type TrivialP a b = I.Normalize (a, b) ~ I.Normalize (I.Normalize a, I.Normalize b)

200+

201+-- | It isn't possible to implement the 'id' function so it's

202+-- implementation is 'undefined'. However 'comp' can be and this partial

203+-- class implementation exists just to make the code more readable.

204+--

205+-- Please use 'identity' instead.

206+instance (Num e) => C.Category (Matrix e) where

207+ id = undefined

208+ (.) = comp

213209

214210-- | Bifunctor equivalent function

215211bimapM ::

216212 ( Liftable e a b,

217213 Liftable e c d,

218− CountableDimsN a c,

219− CountableDimsN b d,

220− FLN d c,

221− FLN b a

214+ CountableDimensionsN a c,

215+ CountableDimensionsN b d,

216+ FromListsN e d c,

217+ FromListsN e b a

222218 ) => (a -> b) -> (c -> d) -> Matrix e a c -> Matrix e b d

223−bimapM f g m = fromF g . m . tr (fromF f)

219+bimapM f g m = fromF' g `comp` m `comp` tr (fromF' f)

224220

225221-- | Zero type alias

226222type Zero = Void

@@ -230,74 +226,78 @@ type One = ()

230226

231227-- Primitives

232228

229+-- | Empty matrix constructor

230+empty :: Matrix e Zero Zero

231+empty = M I.Empty

232+

233233-- | Unit matrix constructor

234234one :: e -> Matrix e One One

235235one = M . I.One

236236

237−-- | Matrix 'Join' constructor

238−join ::

237+-- | Matrix 'Junc' constructor

238+junc ::

239239 Matrix e a rows ->

240240 Matrix e b rows ->

241241 Matrix e (Either a b) rows

242−join (M a) (M b) = M (I.Join a b)

242+junc (M a) (M b) = M (I.Junc a b)

243243

244244infixl 3 |||

245−-- | Matrix 'Join' constructor

245+-- | Matrix 'Junc' constructor

246246(|||) ::

247247 Matrix e a rows ->

248248 Matrix e b rows ->

249249 Matrix e (Either a b) rows

250−(|||) = join

250+(|||) = junc

251251

252−-- | Matrix 'Fork' constructor

253−fork ::

252+-- | Matrix 'Split' constructor

253+split ::

254254 Matrix e cols a ->

255255 Matrix e cols b ->

256256 Matrix e cols (Either a b)

257−fork (M a) (M b) = M (I.Fork a b)

257+split (M a) (M b) = M (I.Split a b)

258258

259259infixl 2 ===

260−-- | Matrix 'Fork' constructor

260+-- | Matrix 'Split' constructor

261261(===) ::

262262 Matrix e cols a ->

263263 Matrix e cols b ->

264264 Matrix e cols (Either a b)

265−(===) = fork

265+(===) = split

266266

267267-- Functor hierarchy

268268

269269-- | Functor instance equivalent function

270−fmapM ::

270+fmapM ::

271271 ( Liftable e a b,

272− CountableDimsN a b,

273− FLN b a

272+ CountableDimensionsN a b,

273+ FromListsN e b a

274274 )

275275 =>

276276 (a -> b) -> Matrix e c a -> Matrix e c b

277−fmapM f m = fromF f . m

277+fmapM f m = fromF' f `comp` m

278278

279279-- | Applicative instance equivalent 'unit' function,

280280unitM :: (Num e) => Matrix e () ()

281281unitM = one 1

282282

283283-- | Applicative instance equivalent 'unit' function,

284−multM ::

285− ( CountableDimsN a b,

284+multM ::

285+ ( CountableDimensionsN a b,

286286 CountableN (a, b),

287287 Num e,

288− FLN (a, b) a,

289− FLN (a, b) b,

288+ FromListsN e (a, b) a,

289+ FromListsN e (a, b) b,

290290 TrivialP a b

291291 ) => Matrix e c a -> Matrix e c b -> Matrix e c (a, b)

292−multM = kr

292+multM = khatri

293293

294294-- | Monad instance equivalent 'return' function,

295−returnM ::

296− forall e a .

295+returnM ::

296+ forall e a .

297297 ( Num e,

298298 Enum e,

299299 Enum a,

300− FLN () a,

300+ FromListsN e () a,

301301 Countable a

302302 ) => a -> Matrix e One a

303303returnM a = col l

@@ -314,64 +314,51 @@ bindM = flip comp

314314

315315-- | Build a matrix out of a list of list of elements. Throws a runtime

316316-- error if the dimensions do not match.

317−fromLists :: (FLN cols rows) => [[e]] -> Matrix e cols rows

317+fromLists :: (FromListsN e cols rows) => [[e]] -> Matrix e cols rows

318318fromLists = M . I.fromLists

319319

320320-- | Matrix builder function. Constructs a matrix provided with

321−-- a construction function that operates with indices.

322−matrixBuilder' ::

323− (FLN cols rows, CountableDimsN cols rows )

324− => ((Int, Int) -> e) -> Matrix e cols rows

325−matrixBuilder' = M . I.matrixBuilder'

326−

327−-- | Matrix builder function. Constructs a matrix provided with

328−-- a construction function that operates with arbitrary types.

321+-- a construction function.

329322matrixBuilder ::

330− ( FLN a b,

331− Enum a,

332− Enum b,

333− Bounded a,

334− Bounded b,

335− Eq a,

336− Countable b

337− ) => ((a, b) -> e) -> Matrix e a b

338−matrixBuilder f = M (I.matrixBuilder f)

323+ (FromListsN e cols rows, CountableDimensionsN cols rows )

324+ => ((Int, Int) -> e) -> Matrix e cols rows

325+matrixBuilder = M . I.matrixBuilder

339326

340327-- | Constructs a column vector matrix

341−col :: (FLN () rows) => [e] -> Matrix e One rows

328+col :: (FromListsN e () rows) => [e] -> Matrix e One rows

342329col = M . I.col

343330

344331-- | Constructs a row vector matrix

345−row :: (FLN cols ()) => [e] -> Matrix e cols One

332+row :: (FromListsN e cols ()) => [e] -> Matrix e cols One

346333row = M . I.row

347334

348335-- | Lifts functions to matrices with arbitrary dimensions.

349336--

350337-- NOTE: Be careful to not ask for a matrix bigger than the cardinality of

351338-- types @a@ or @b@ allows.

352−fromF' ::

339+fromF ::

353340 ( Liftable e a b,

354− CountableDimsN cols rows,

355− FLN rows cols

341+ CountableDimensionsN cols rows,

342+ FromListsN e rows cols

356343 ) =>

357344 (a -> b) -> Matrix e cols rows

358−fromF' = M . I.fromF'

345+fromF = M . I.fromF

359346

360347-- | Lifts functions to matrices with dimensions matching @a@ and @b@

361348-- cardinality's.

362−fromF ::

349+fromF' ::

363350 ( Liftable e a b,

364− CountableDimsN a b,

365− FLN b a

351+ CountableDimensionsN a b,

352+ FromListsN e b a

366353 ) =>

367354 (a -> b) -> Matrix e a b

368−fromF = M . I.fromF

355+fromF' = M . I.fromF'

369356

370357-- | Lifts relation functions to Boolean Matrix

371358toRel ::

372359 ( Liftable (Natural 0 1) a b,

373− CountableDims a b,

374− FLN b a

360+ CountableDimensionsN a b,

361+ FromListsN (Natural 0 1) b a

375362 ) => (a -> b -> Bool) -> Matrix (Natural 0 1) a b

376363toRel = M . I.toRel

377364

@@ -389,7 +376,7 @@ toList (M m) = I.toList m

389376

390377-- | The zero matrix. A matrix wholly filled with zeros.

391378zeros ::

392− (Num e, FLN cols rows, CountableDimsN cols rows)

379+ (Num e, FromListsN e cols rows, CountableDimensionsN cols rows)

393380 => Matrix e cols rows

394381zeros = M I.zeros

395382

@@ -399,7 +386,7 @@ zeros = M I.zeros

399386--

400387-- Also known as T (Top) matrix.

401388ones ::

402− (Num e, FLN cols rows, CountableDimsN cols rows)

389+ (Num e, FromListsN e cols rows, CountableDimensionsN cols rows)

403390 => Matrix e cols rows

404391ones = M I.ones

405392

@@ -408,7 +395,7 @@ ones = M I.ones

408395-- | The constant matrix constructor. A matrix wholly filled with a given

409396-- value.

410397constant ::

411− (Num e, FLN cols rows, CountableDimsN cols rows)

398+ (Num e, FromListsN e cols rows, CountableDimensionsN cols rows)

412399 => e -> Matrix e cols rows

413400constant = M . I.constant

414401

@@ -417,30 +404,30 @@ constant = M . I.constant

417404-- | The T (Top) row vector matrix.

418405bang ::

419406 forall e cols.

420− (Num e, Enum e, FLN cols (), CountableN cols) =>

407+ (Num e, Enum e, FromListsN e cols (), CountableN cols) =>

421408 Matrix e cols One

422409bang = M I.bang

423410

424411-- | Point constant relation

425−point ::

412+point ::

426413 ( Bounded a,

427414 Enum a,

428415 Eq a,

429416 Num e,

430417 Ord e,

431418 CountableN a,

432− FLN a One

419+ FromListsN e a One

433420 ) => a -> Matrix e One a

434−point = fromF . const

421+point = fromF' . const

435422

436−-- iden Matrix

423+-- Identity Matrix

437424

438−-- | iden matrix

439−iden ::

440− (Num e, FLN a a, CountableN a) =>

425+-- | Identity matrix

426+identity ::

427+ (Num e, FromListsN e a a, CountableN a) =>

441428 Matrix e a a

442−iden = M I.iden

443−{-# NOINLINE iden #-}

429+identity = M I.identity

430+{-# NOINLINE identity #-}

444431

445432-- Matrix composition (MMM)

446433

@@ -451,31 +438,17 @@ iden = M I.iden

451438comp :: (Num e) => Matrix e cr rows -> Matrix e cols cr -> Matrix e cols rows

452439comp (M a) (M b) = M (I.comp a b)

453440{-# NOINLINE comp #-}

454−{-# RULES

455− "comp/iden1" forall m. comp m iden = m ;

456− "comp/iden2" forall m. comp iden m = m

441+{-# RULES

442+ "comp/identity1" forall m. comp m identity = m ;

443+ "comp/identity2" forall m. comp identity m = m

457444#-}

458445

459−-- Scalar multiplication of matrices

460−

461−infixl 7 .|

462−-- | Scalar multiplication of matrices.

463−(.|) :: Num e => e -> Matrix e cols rows -> Matrix e cols rows

464−(.|) e (M m) = M (e I..| m)

465−

466−-- Scalar division of matrices

467−

468−infixl 7 ./

469−-- | Scalar multiplication of matrices.

470−(./) :: Fractional e => Matrix e cols rows -> e -> Matrix e cols rows

471−(./) (M m) e = M (m I../ e)

472−

473446-- | Biproduct first component projection

474447p1 ::

475448 ( Num e,

476− CountableDimsN n m,

477− FLN n m,

478− FLN m m

449+ CountableDimensionsN n m,

450+ FromListsN e n m,

451+ FromListsN e m m

479452 ) =>

480453 Matrix e (Either m n) m

481454p1 = M I.p1

@@ -483,9 +456,9 @@ p1 = M I.p1

483456-- | Biproduct second component projection

484457p2 ::

485458 ( Num e,

486− CountableDimsN n m,

487− FLN m n,

488− FLN n n

459+ CountableDimensionsN n m,

460+ FromListsN e m n,

461+ FromListsN e n n

489462 ) =>

490463 Matrix e (Either m n) n

491464p2 = M I.p2

@@ -495,9 +468,9 @@ p2 = M I.p2

495468-- | Biproduct first component injection

496469i1 ::

497470 ( Num e,

498− CountableDimsN n m,

499− FLN n m,

500− FLN m m

471+ CountableDimensionsN n m,

472+ FromListsN e n m,

473+ FromListsN e m m

501474 ) =>

502475 Matrix e m (Either m n)

503476i1 = tr p1

@@ -505,9 +478,9 @@ i1 = tr p1

505478-- | Biproduct second component injection

506479i2 ::

507480 ( Num e,

508− CountableDimsN n m,

509− FLN m n,

510− FLN n n

481+ CountableDimensionsN n m,

482+ FromListsN e m n,

483+ FromListsN e n n

511484 ) =>

512485 Matrix e n (Either m n)

513486i2 = tr p2

@@ -516,34 +489,24 @@ i2 = tr p2

516489

517490-- | Obtain the number of rows.

518491--

519−-- NOTE: The 'KnownNat' constraint is needed in order to obtain the

520−-- dimensions in constant time. For a version that doesn't require the

521−-- constraint see 'rows''.

492+-- NOTE: The 'KnownNat' constaint is needed in order to obtain the

493+-- dimensions in constant time.

494+--

495+-- TODO: A 'rows' function that does not need the 'KnownNat' constraint in

496+-- exchange for performance.

522497rows :: (CountableN rows) => Matrix e cols rows -> Int

523498rows (M m) = I.rows m

524499

525−-- | Obtain the number of rows in an inefficient manner, but without any

526−-- constraints.

527−--

528−-- For a more efficient version see 'rows'.

529−rows' :: Matrix e cols rows -> Int

530−rows' (M m) = I.rows' m

531−

532500-- | Obtain the number of columns.

501+--

502+-- NOTE: The 'KnownNat' constaint is needed in order to obtain the

503+-- dimensions in constant time.

533504--

534−-- NOTE: The 'KnownNat' constraint is needed in order to obtain the

535−-- dimensions in constant time. For a version that doesn't require the

536−-- constraint see 'columns''.

505+-- TODO: A 'columns' function that does not need the 'KnownNat' constraint in

506+-- exchange for performance.

537507columns :: (CountableN cols) => Matrix e cols rows -> Int

538508columns (M m) = I.columns m

539509

540−-- | Obtain the number of columns in an inefficient manner, but without any

541−-- constraints.

542−--

543−-- For a more efficient version see 'columns'.

544−columns' :: Matrix e cols rows -> Int

545−columns' (M m) = I.columns' m

546−

547510-- Coproduct Bifunctor

548511

549512infixl 5 -|-

@@ -551,11 +514,11 @@ infixl 5 -|-

551514-- | Matrix coproduct functor also known as matrix direct sum.

552515(-|-) ::

553516 ( Num e,

554− CountableDimsN j k,

555− FLN k k,

556− FLN j k,

557− FLN k j,

558− FLN j j

517+ CountableDimensionsN j k,

518+ FromListsN e k k,

519+ FromListsN e j k,

520+ FromListsN e k j,

521+ FromListsN e j j

559522 ) =>

560523 Matrix e n k ->

561524 Matrix e m j ->

@@ -565,98 +528,98 @@ infixl 5 -|-

565528-- Khatri Rao Product and projections

566529

567530-- | Khatri Rao product first component projection matrix.

568−fstM ::

531+kp1 ::

569532 forall e m k .

570533 ( Num e,

571− CountableDimsN m k,

534+ CountableDimensionsN m k,

572535 CountableN (m, k),

573− FLN (m, k) m,

536+ FromListsN e (m, k) m,

574537 TrivialP m k

575538 ) => Matrix e (m, k) m

576−fstM = M (I.fstM @e @(I.Normalize m) @(I.Normalize k))

539+kp1 = M (I.kp1 @e @(I.Normalize m) @(I.Normalize k))

577540

578541-- | Khatri Rao product second component projection matrix.

579−sndM ::

542+kp2 ::

580543 forall e m k.

581544 ( Num e,

582− CountableDimsN k m,

545+ CountableDimensionsN k m,

583546 CountableN (m, k),

584− FLN (m, k) k,

547+ FromListsN e (m, k) k,

585548 TrivialP m k

586549 ) => Matrix e (m, k) k

587−sndM = M (I.sndM @e @(I.Normalize m) @(I.Normalize k))

550+kp2 = M (I.kp2 @e @(I.Normalize m) @(I.Normalize k))

588551

589552-- | Khatri Rao Matrix product also known as matrix pairing.

590553--

591554-- NOTE: That this is not a true categorical product, see for instance:

592−--

555+--

593556-- @

594−-- | fstM . kr a b == a

595−-- kr a b ==> |

596−-- | sndM . kr a b == b

557+-- | kp1 `comp` khatri a b == a

558+-- khatri a b ==> |

559+-- | kp2 `comp` khatri a b == b

597560-- @

598561--

599562-- __Emphasis__ on the implication symbol.

600−kr ::

563+khatri ::

601564 forall e cols a b.

602565 ( Num e,

603− CountableDimsN a b,

566+ CountableDimensionsN a b,

604567 CountableN (a, b),

605− FLN (a, b) a,

606− FLN (a, b) b,

568+ FromListsN e (a, b) a,

569+ FromListsN e (a, b) b,

607570 TrivialP a b

608571 ) => Matrix e cols a -> Matrix e cols b -> Matrix e cols (a, b)

609−kr a b =

610− let fstM' = fstM @e @a @b

611− sndM' = sndM @e @a @b

612− in comp (tr fstM') a * comp (tr sndM') b

572+khatri a b =

573+ let kp1' = kp1 @e @a @b

574+ kp2' = kp2 @e @a @b

575+ in comp (tr kp1') a * comp (tr kp2') b

613576

614577-- Product Bifunctor (Kronecker)

615578

616579infixl 4 ><

617580

618−-- | Matrix product functor also known as Kronecker product

581+-- | Matrix product functor also known as kronecker product

619582(><) ::

620583 forall e m p n q.

621584 ( Num e,

622− CountableDimsN m n,

623− CountableDimsN p q,

624− CountableDimsN (m, n) (p, q),

625− FLN (m, n) m,

626− FLN (m, n) n,

627− FLN (p, q) p,

628− FLN (p, q) q,

585+ CountableDimensionsN m n,

586+ CountableDimensionsN p q,

587+ CountableDimensionsN (m, n) (p, q),

588+ FromListsN e (m, n) m,

589+ FromListsN e (m, n) n,

590+ FromListsN e (p, q) p,

591+ FromListsN e (p, q) q,

629592 TrivialP m n,

630593 TrivialP p q

631594 ) => Matrix e m p -> Matrix e n q -> Matrix e (m, n) (p, q)

632595(><) a b =

633− let fstM' = fstM @e @m @n

634− sndM' = sndM @e @m @n

635− in kr (comp a fstM') (comp b sndM')

596+ let kp1' = kp1 @e @m @n

597+ kp2' = kp2 @e @m @n

598+ in khatri (comp a kp1') (comp b kp2')

636599

637−-- Matrix abide Join Fork

600+-- Matrix abide Junc Split

638601

639−-- | Matrix "abiding" followin the 'Join'-'Fork' abide law.

640−--

602+-- | Matrix "abiding" followin the 'Junc'-'Split' abide law.

603+--

641604-- Law:

642605--

643606-- @

644−-- 'Join' ('Fork' a c) ('Fork' b d) == 'Fork' ('Join' a b) ('Join' c d)

607+-- 'Junc' ('Split' a c) ('Split' b d) == 'Split' ('Junc' a b) ('Junc' c d)

645608-- @

646−abideJF :: Matrix e cols rows -> Matrix e cols rows

647−abideJF (M m) = M (I.abideJF m)

609+abideJS :: Matrix e cols rows -> Matrix e cols rows

610+abideJS (M m) = M (I.abideJS m)

648611

649−-- Matrix abide Fork Join

612+-- Matrix abide Split Junc

650613

651−-- | Matrix "abiding" followin the 'Fork'-'Join' abide law.

652−--

614+-- | Matrix "abiding" followin the 'Split'-'Junc' abide law.

615+--

653616-- Law:

654617--

655618-- @

656−-- 'Fork' ('Join' a b) ('Join' c d) == 'Join' ('Fork' a c) ('Fork' b d)

619+-- 'Split' ('Junc' a b) ('Junc' c d) == 'Junc' ('Split' a c) ('Split' b d)

657620-- @

658−abideFJ :: Matrix e cols rows -> Matrix e cols rows

659−abideFJ (M m) = M (I.abideFJ m)

621+abideSJ :: Matrix e cols rows -> Matrix e cols rows

622+abideSJ (M m) = M (I.abideSJ m)

660623

661624-- Matrix transposition

662625

@@ -668,9 +631,9 @@ tr (M m) = M (I.tr m)

668631

669632-- | Selective functors 'select' operator equivalent inspired by the

670633-- ArrowMonad solution presented in the paper.

671−selectM ::

634+selectM ::

672635 ( Num e,

673− FLN b b,

636+ FromListsN e b b,

674637 CountableN b

675638 ) => Matrix e cols (Either a b) -> Matrix e a b -> Matrix e cols b

676639selectM (M m) (M y) = M (I.select m y)

@@ -683,9 +646,9 @@ cond ::

683646 Trivial2 a,

684647 Trivial3 a,

685648 CountableN a,

686− FLN () a,

687− FLN a (),

688− FLN a a,

649+ FromListsN e () a,

650+ FromListsN e a (),

651+ FromListsN e a a,

689652 Liftable e a Bool

690653 )

691654 =>

@@ -695,11 +658,11 @@ cond p (M a) (M b) = M (I.cond p a b)

695658-- Pretty print

696659

697660-- | Matrix pretty printer

698−pretty :: (CountableDimsN cols rows, Show e) => Matrix e cols rows -> String

661+pretty :: (CountableDimensionsN cols rows, Show e) => Matrix e cols rows -> String

699662pretty (M m) = I.pretty m

700663

701664-- | Matrix pretty printer

702−prettyPrint :: (CountableDimsN cols rows, Show e) => Matrix e cols rows -> IO ()

665+prettyPrint :: (CountableDimensionsN cols rows, Show e) => Matrix e cols rows -> IO ()

703666prettyPrint (M m) = I.prettyPrint m

704667

705668-- | Zip two matrices with a given binary function

src/LAoP/Relation.hs+9−8

@@ -32,19 +32,20 @@ module LAoP.Relation

3232

3333 -- * Constraint type synonyms

3434 Countable,

35− CountableDims,

35+ CountableDimensions,

3636 CountableN,

37− CountableDimsN,

38− FLN,

37+ CountableDimensionsN,

38+ FromListsN,

3939 Liftable,

4040 Trivial,

4141 TrivialP,

4242

4343 -- * Primitives

44+ empty,

4445 one,

45− join,

46+ junc,

4647 (|||),

47− fork,

48+ split,

4849 (===),

4950

5051 -- * Auxiliary type families

@@ -107,8 +108,8 @@ module LAoP.Relation

107108 splitR,

108109

109110 -- ** Projections

110− fstR,

111− sndR,

111+ p1,

112+ p2,

112113 -- ** Bifunctor

113114 (><),

114115 -- * Relational coproduct

@@ -147,7 +148,7 @@ module LAoP.Relation

147148 cond,

148149

149150 -- * Relational composition and lifting

150− iden,

151+ identity,

151152 comp,

152153 fromF,

153154 fromF',

src/LAoP/Relation/Internal.hs+234−245

@@ -1,4 +1,3 @@

1−{-# LANGUAGE TypeFamilies #-}

21{-# LANGUAGE ConstraintKinds #-}

32{-# LANGUAGE GADTs #-}

43{-# LANGUAGE UndecidableInstances #-}

@@ -43,19 +42,20 @@ module LAoP.Relation.Internal

4342

4443 -- * Constraint type synonyms

4544 Countable,

46− CountableDims,

45+ CountableDimensions,

4746 CountableN,

48− CountableDimsN,

49− FLN,

47+ CountableDimensionsN,

48+ FromListsN,

5049 Liftable,

5150 Trivial,

5251 TrivialP,

5352

5453 -- * Primitives

54+ empty,

5555 one,

56− join,

56+ junc,

5757 (|||),

58− fork,

58+ split,

5959 (===),

6060

6161 -- * Auxiliary type families

@@ -66,15 +66,14 @@ module LAoP.Relation.Internal

6666 -- * Matrix construction and conversion

6767 I.FromLists,

6868 fromLists,

69− fromF',

7069 fromF,

70+ fromF',

7171 toRel,

7272 toLists,

7373 toList,

7474 toBool,

7575 pt,

7676 belongs,

77− relationBuilder',

7877 relationBuilder,

7978 zeros,

8079 ones,

@@ -119,8 +118,8 @@ module LAoP.Relation.Internal

119118 splitR,

120119

121120 -- ** Projections

122− fstR,

123− sndR,

121+ p1,

122+ p2,

124123 -- ** Bifunctor

125124 (><),

126125 -- * Relational coproduct

@@ -159,10 +158,10 @@ module LAoP.Relation.Internal

159158 cond,

160159

161160 -- * Relational composition and lifting

162− iden,

161+ identity,

163162 comp,

164− fromF',

165163 fromF,

164+ fromF',

166165

167166 -- ** Relational application

168167 pointAp,

@@ -178,9 +177,9 @@ import Data.Void

178177import qualified LAoP.Matrix.Internal as I

179178import LAoP.Utils.Internal

180179import Control.DeepSeq

180+import qualified Control.Category as C

181181import Data.Bool

182182import GHC.TypeLits

183−import Prelude hiding (id, (.))

184183

185184-- | Boolean type synonym for working with boolean matrices

186185type Boolean = Natural 0 1

@@ -193,30 +192,32 @@ newtype Relation a b = R (I.Matrix Boolean (I.Normalize a) (I.Normalize b))

193192deriving instance (Read (I.Matrix Boolean (I.Normalize a) (I.Normalize b))) => Read (Relation a b)

194193

195194-- | Constraint type synonyms to keep the type signatures less convoluted

196−type Countable a = KnownNat (I.Count a)

197−type CountableDims a b = (Countable a, Countable b)

198−type CountableN a = KnownNat (I.Count (I.Normalize a))

199−type CountableDimsN a b = (CountableN a, CountableN b)

200−type FLN a b = I.FromLists (I.Normalize a) (I.Normalize b)

201−type Liftable a b = (Bounded a, Bounded b, Enum a, Enum b, Eq b, Num Boolean, Ord Boolean)

202−type Trivial a = I.Normalize a ~ I.Normalize (I.Normalize a)

203−type TrivialP a b = I.Normalize (a, b) ~ I.Normalize (I.Normalize a, I.Normalize b)

204−

205−-- | It is possible to implement a constrained version of the category type

206−-- class.

207−instance Category Relation where

208− type Object Relation a = (FLN a a, CountableN a)

209− id = iden

210− (.) = comp

195+type Countable a = KnownNat (I.Count a)

196+type CountableDimensions a b = (Countable a, Countable b)

197+type CountableN a = KnownNat (I.Count (I.Normalize a))

198+type CountableDimensionsN a b = (CountableN a, CountableN b)

199+type FromListsN a b = I.FromLists Boolean (I.Normalize a) (I.Normalize b)

200+type Liftable a b = (Bounded a, Bounded b, Enum a, Enum b, Eq b, Num Boolean, Ord Boolean)

201+type Trivial a = I.Normalize a ~ I.Normalize (I.Normalize a)

202+type TrivialP a b = I.Normalize (a, b) ~ I.Normalize (I.Normalize a, I.Normalize b)

203+

204+-- | It isn't possible to implement the 'id' function so it's

205+-- implementation is 'undefined'. However 'comp' can be and this partial

206+-- class implementation exists just to make the code more readable.

207+--

208+-- Please use 'identity' instead.

209+instance C.Category Relation where

210+ id = undefined

211+ (.) = comp

211212

212213instance Num (Relation a b) where

213− -- | Matrix addition becomes Boolean matrix disjointion

214+ -- | Matrix addition becomes Boolean matrix disjunction

214215 (R a) + (R b) = R (I.orM a b)

215216

216217 -- | Matrix subtraction becomes Relational subtraction

217218 (R a) - (R b) = R (I.subM a b)

218219

219− -- | Matrix multiplication becomes Boolean matrix conjointion

220+ -- | Matrix multiplication becomes Boolean matrix conjunction

220221 (R a) * (R b) = R (I.andM a b)

221222

222223 -- | Matrix negation becomes Boolean matrix negation

@@ -228,92 +229,83 @@ type One = ()

228229

229230-- Primitives

230231

232+-- | Empty matrix constructor

233+empty :: Relation Zero Zero

234+empty = R I.Empty

235+

231236-- | Unit matrix constructor

232237one :: Boolean -> Relation One One

233238one = R . I.One

234239

235−-- | Boolean Matrix 'Join' constructor, also known as relational coproduct.

240+-- | Boolean Matrix 'Junc' constructor, also known as relational coproduct.

236241--

237242-- See 'eitherR'.

238−join :: Relation a c -> Relation b c -> Relation (Either a b) c

239−join (R a) (R b) = R (I.Join a b)

243+junc :: Relation a c -> Relation b c -> Relation (Either a b) c

244+junc (R a) (R b) = R (I.Junc a b)

240245

241246infixl 3 |||

242−-- | Boolean Matrix 'Join' constructor

247+-- | Boolean Matrix 'Junc' constructor

243248--

244249-- See 'eitherR'.

245250(|||) ::

246251 Relation a c ->

247252 Relation b c ->

248253 Relation (Either a b) c

249−(|||) = join

254+(|||) = junc

250255

251−-- | Boolean Matrix 'Fork' constructor, also known as relational product.

252−fork :: Relation c a -> Relation c b -> Relation c (Either a b)

253−fork (R a) (R b) = R (I.Fork a b)

256+-- | Boolean Matrix 'Split' constructor, also known as relational product.

257+split :: Relation c a -> Relation c b -> Relation c (Either a b)

258+split (R a) (R b) = R (I.Split a b)

254259

255260infixl 2 ===

256−-- | Boolean Matrix 'Fork' constructor

261+-- | Boolean Matrix 'Split' constructor

257262(===) ::

258263 Relation c a ->

259264 Relation c b ->

260265 Relation c (Either a b)

261−(===) = fork

266+(===) = split

262267

263268-- Construction

264269

265270-- | Build a matrix out of a list of list of elements. Throws a runtime

266271-- error if the dimensions do not match.

267−fromLists :: (FLN a b) => [[Boolean]] -> Relation a b

272+fromLists :: (FromListsN a b) => [[Boolean]] -> Relation a b

268273fromLists = R . I.fromLists

269274

270−-- | Relation builder function. Constructs a relation provided with

271−-- a construction function that operates with indices.

272−relationBuilder' ::

273− (FLN a b, CountableDimsN a b) =>

274− ((Int, Int) -> Boolean) -> Relation a b

275−relationBuilder' = R . I.matrixBuilder'

276−

277−-- | Relation builder function. Constructs a relation provided with

278−-- a construction function that operates with arbitrary types.

275+-- | Matrix builder function. Constructs a matrix provided with

276+-- a construction function.

279277relationBuilder ::

280− ( FLN a b,

281− Enum a,

282− Enum b,

283− Bounded a,

284− Bounded b,

285− Eq a,

286− CountableDims a b

287− ) => ((a, b) -> Boolean) -> Relation a b

278+ (FromListsN a b, CountableDimensionsN a b) =>

279+ ((Int, Int) -> Boolean) -> Relation a b

288280relationBuilder = R . I.matrixBuilder

289281

290282-- | Lifts functions to matrices with arbitrary dimensions.

291283--

292284-- NOTE: Be careful to not ask for a matrix bigger than the cardinality of

293285-- types @a@ or @b@ allows.

294−fromF' ::

286+fromF ::

295287 ( Liftable a b,

296− CountableDimsN c d,

297− FLN d c

288+ CountableDimensionsN c d,

289+ FromListsN d c

298290 )

299291 => (a -> b) -> Relation c d

300−fromF' f = R (I.fromFRel' f)

292+fromF f = R (I.fromFRel f)

301293

302294-- | Lifts functions to matrices with dimensions matching @a@ and @b@

303295-- cardinality's.

304−fromF ::

296+fromF' ::

305297 ( Liftable a b,

306− CountableDimsN a b,

307− FLN b a

298+ CountableDimensionsN a b,

299+ FromListsN b a

308300 )

309301 => (a -> b) -> Relation a b

310−fromF f = R (I.fromFRel f)

302+fromF' f = R (I.fromFRel' f)

311303

312304-- | Lifts relation functions to 'Relation'

313305toRel ::

314306 ( Liftable a b,

315− CountableDims a b,

316− FLN b a

307+ CountableDimensionsN a b,

308+ FromListsN b a

317309 )

318310 => (a -> b -> Bool) -> Relation a b

319311toRel = R . I.toRel

@@ -322,9 +314,9 @@ toRel = R . I.toRel

322314fromRel ::

323315 ( Liftable a b,

324316 Eq a,

325− CountableDimsN a b,

326− FLN a One,

327− FLN b One

317+ CountableDimensionsN a b,

318+ FromListsN a One,

319+ FromListsN b One

328320 )

329321 => Relation a b -> (a -> b -> Bool)

330322fromRel r a b = pointApBool a b r

@@ -348,12 +340,12 @@ toBool r = case toList r of

348340-- | Power transpose.

349341--

350342-- Maps a relation to a set valued function.

351−pt ::

343+pt ::

352344 ( Liftable a b,

353345 Eq a,

354− CountableDimsN a b,

355− FLN a One,

356− FLN b One

346+ CountableDimensionsN a b,

347+ FromListsN a One,

348+ FromListsN b One

357349 )

358350 => Relation a b -> (a -> List b)

359351pt r a =

@@ -365,8 +357,8 @@ belongs ::

365357 ( Bounded a,

366358 Enum a,

367359 Eq a,

368− CountableDims (List a) a,

369− FLN a (List a)

360+ CountableDimensionsN (List a) a,

361+ FromListsN a (List a)

370362 )

371363 => Relation (List a) a

372364belongs = toRel elemR

@@ -378,16 +370,16 @@ belongs = toRel elemR

378370-- | The zero relation. A relation where no element of type @a@ relates

379371-- with elements of type @b@.

380372--

381−-- Also known as ⊥ (Bottom) Relation.

373+-- Also known as ⊥ (Bottom) Relation or empty Relation.

382374--

383375-- @

384−-- r `.` ⊥ == ⊥ `.` r == ⊥

376+-- r ``comp`` ⊥ == ⊥ ``comp`` r == ⊥

385377-- ⊥ ``sse`` R && R ``sse`` T == True

386378-- @

387379zeros ::

388− (FLN a b, CountableDimsN a b) =>

380+ (FromListsN a b, CountableDimensionsN a b) =>

389381 Relation a b

390−zeros = relationBuilder' (const (nat 0))

382+zeros = relationBuilder (const (nat 0))

391383

392384-- Ones Matrix

393385

@@ -400,43 +392,43 @@ zeros = relationBuilder' (const (nat 0))

400392-- ⊥ ``sse`` R && R ``sse`` T == True

401393-- @

402394ones ::

403− (FLN a b, CountableDimsN a b) =>

395+ (FromListsN a b, CountableDimensionsN a b) =>

404396 Relation a b

405−ones = relationBuilder' (const (nat 1))

397+ones = relationBuilder (const (nat 1))

406398

407399-- Bang Matrix

408400

409401-- | The T (Top) row vector relation.

410402bang ::

411− (FLN a One, CountableN a) =>

403+ (FromListsN a One, CountableN a) =>

412404 Relation a One

413405bang = ones

414406

415407-- | Point constant relation

416−point ::

408+point ::

417409 ( Bounded a,

418410 Enum a,

419411 Eq a,

420412 CountableN a,

421− FLN a One

413+ FromListsN a One

422414 ) => a -> Relation One a

423−point = fromF . const

415+point = fromF' . const

424416

425−-- iden Matrix

417+-- Identity Matrix

426418

427−-- | iden matrix

419+-- | Identity matrix

428420--

429421-- @

430−-- 'iden' `.` r == r == r `.` 'iden'

422+-- 'identity' ``comp`` r == r == r ``comp`` 'identity'

431423-- @

432−iden ::

433− (FLN a a, CountableN a) => Relation a a

434−iden = relationBuilder' (bool (nat 0) (nat 1) . uncurry (==))

424+identity ::

425+ (FromListsN a a, CountableN a) => Relation a a

426+identity = relationBuilder (bool (nat 0) (nat 1) . uncurry (==))

435427

436428-- | Relational composition

437429--

438430-- @

439−-- r `.` (s `.` p) = (r `.` s) `.` p

431+-- r ``comp`` (s ``comp`` p) = (r ``comp`` s) ``comp`` p

440432-- @

441433comp :: Relation b c -> Relation a b -> Relation a c

442434comp (R a) (R b) = R (I.compRel a b)

@@ -484,7 +476,7 @@ shrunkBy r s = r `intersection` divR s (conv r)

484476-- r ``overriddenBy`` r == r

485477-- @

486478overriddenBy ::

487− ( FLN b b,

479+ ( FromListsN b b,

488480 CountableN b

489481 ) => Relation a b -> Relation a b -> Relation a b

490482overriddenBy r s = s `union` r `intersection` divR zeros (conv s)

@@ -496,11 +488,11 @@ overriddenBy r s = s `union` r `intersection` divR zeros (conv s)

496488pointAp ::

497489 ( Liftable a b,

498490 Eq a,

499− CountableDimsN a b,

500− FLN a One,

501− FLN b One

491+ CountableDimensionsN a b,

492+ FromListsN a One,

493+ FromListsN b One

502494 ) => a -> b -> Relation a b -> Relation One One

503−pointAp a b r = conv (point b) . r . point a

495+pointAp a b r = conv (point b) `comp` r `comp` point a

504496

505497-- | Relational application

506498--

@@ -508,11 +500,11 @@ pointAp a b r = conv (point b) . r . point a

508500pointApBool ::

509501 ( Liftable a b,

510502 Eq a,

511− CountableDimsN a b,

512− FLN a One,

513− FLN b One

503+ CountableDimensionsN a b,

504+ FromListsN a One,

505+ FromListsN b One

514506 ) => a -> b -> Relation a b -> Bool

515−pointApBool a b r = toBool $ conv (point b) . r . point a

507+pointApBool a b r = toBool $ conv (point b) `comp` r `comp` point a

516508

517509-- | Relational converse

518510--

@@ -538,7 +530,7 @@ iff r s = r == s

538530

539531-- | Relational intersection

540532--

541−-- Lifts pointwise conjointion.

533+-- Lifts pointwise conjunction.

542534--

543535-- @

544536-- (r ``intersection`` s) ``intersection`` t == r ``intersection`` (s ``intersection`` t)

@@ -549,13 +541,13 @@ intersection a b = a * b

549541

550542-- | Relational union

551543--

552−-- Lifts pointwise disjointion.

544+-- Lifts pointwise disjunction.

553545--

554546-- @

555547-- (r ``union`` s) ``union`` t == r `'union' (s ``union`` t)

556548-- r ``union`` s ``sse`` x == r ``sse`` x && s ``sse`` x

557−-- r `.` (s ``union`` t) == (r `.` s) ``union`` (r `.` t)

558−-- (s ``union`` t) `.` r == (s `.` r) ``union`` (t `.` r)

549+-- r ``comp`` (s ``union`` t) == (r ``comp`` s) ``union`` (r ``comp`` t)

550+-- (s ``union`` t) ``comp`` r == (s ``comp`` r) ``union`` (t ``comp`` r)

559551-- @

560552union :: Relation a b -> Relation a b -> Relation a b

561553union a b = a + b

@@ -563,46 +555,46 @@ union a b = a + b

563555-- | Relation Kernel

564556--

565557-- @

566−-- 'ker' r == 'conv' r `.` r

558+-- 'ker' r == 'conv' r ``comp`` r

567559-- 'ker' r == 'img' ('conv' r)

568560-- @

569561ker :: Relation a b -> Relation a a

570−ker r = conv r . r

562+ker r = conv r `comp` r

571563

572564-- | Relation Image

573565--

574566-- @

575−-- 'img' r == r `.` conv r

567+-- 'img' r == r ``comp`` conv r

576568-- 'img' r == 'ker' ('conv' r)

577569-- @

578570img :: Relation a b -> Relation b b

579−img r = r . conv r

571+img r = r `comp` conv r

580572

581573-- | Function division. Special case of 'divS'.

582574--

583575-- NOTE: _This is only valid_ if @f@ and @g@ are 'function's, i.e. 'simple' and

584576-- 'entire'.

585577--

586−-- @'divisionF' f g == 'conv' g `.` f@

578+-- @'divisionF' f g == 'conv' g ``comp`` f@

587579divisionF :: Relation a c -> Relation b c -> Relation a b

588−divisionF f g = conv g . f

580+divisionF f g = conv g `comp` f

589581

590582-- Taxonomy of binary relations

591583

592584-- | A 'Relation' @r@ is 'simple' 'iff' @'coreflexive' ('img' r)@

593−simple :: (CountableN b, FLN b b) => Relation a b -> Bool

585+simple :: (CountableN b, FromListsN b b) => Relation a b -> Bool

594586simple = coreflexive . img

595587

596588-- | A 'Relation' @r@ is 'injective' 'iff' @'coreflexive' ('ker' r)@

597−injective :: (CountableN a, FLN a a) => Relation a b -> Bool

589+injective :: (CountableN a, FromListsN a a) => Relation a b -> Bool

598590injective = coreflexive . ker

599591

600592-- | A 'Relation' @r@ is 'entire' 'iff' @'reflexive' ('ker' r)@

601−entire :: (CountableN a, FLN a a) => Relation a b -> Bool

593+entire :: (CountableN a, FromListsN a a) => Relation a b -> Bool

602594entire = reflexive . ker

603595

604596-- | A 'Relation' @r@ is 'surjective' 'iff' @'reflexive' ('img' r)@

605−surjective :: (CountableN b, FLN b b) => Relation a b -> Bool

597+surjective :: (CountableN b, FromListsN b b) => Relation a b -> Bool

606598surjective = reflexive . img

607599

608600-- | A 'Relation' @r@ is a 'function' 'iff' @'simple' r && 'entire' r@

@@ -611,13 +603,13 @@ surjective = reflexive . img

611603-- relations:

612604--

613605-- @

614−-- f `.` r ``sse`` s == r ``sse`` f `.` s

615−-- r `.` f ``sse`` s == r ``sse`` s `.` f

606+-- f ``comp`` r ``sse`` s == r ``sse`` f ``comp`` s

607+-- r ``comp`` f ``sse`` s == r ``sse`` s ``comp`` f

616608-- @

617609function ::

618− ( CountableDimsN a b,

619− FLN a a,

620− FLN b b

610+ ( CountableDimensionsN a b,

611+ FromListsN a a,

612+ FromListsN b b

621613 )

622614 => Relation a b -> Bool

623615function r = simple r && entire r

@@ -625,7 +617,7 @@ function r = simple r && entire r

625617-- | A 'Relation' @r@ is a 'representation' 'iff' @'injective' r && 'entire' r@

626618representation ::

627619 ( CountableN a,

628− FLN a a

620+ FromListsN a a

629621 )

630622 => Relation a b -> Bool

631623representation r = injective r && entire r

@@ -633,91 +625,91 @@ representation r = injective r && entire r

633625-- | A 'Relation' @r@ is an 'abstraction' 'iff' @'surjective' r && 'simple' r@

634626abstraction ::

635627 ( CountableN b,

636− FLN b b

628+ FromListsN b b

637629 )

638630 => Relation a b -> Bool

639631abstraction r = surjective r && simple r

640632

641633-- | A 'Relation' @r@ is a 'surjection' 'iff' @'function' r && 'abstraction' r@

642634surjection ::

643− ( CountableDimsN a b,

644− FLN a a,

645− FLN b b

635+ ( CountableDimensionsN a b,

636+ FromListsN a a,

637+ FromListsN b b

646638 )

647639 => Relation a b -> Bool

648640surjection r = function r && abstraction r

649641

650642-- | A 'Relation' @r@ is a 'injection' 'iff' @'function' r && 'representation' r@

651643injection ::

652− ( CountableDimsN a b,

653− FLN a a,

654− FLN b b

644+ ( CountableDimensionsN a b,

645+ FromListsN a a,

646+ FromListsN b b

655647 )

656648 => Relation a b -> Bool

657649injection r = function r && representation r

658650

659651-- | A 'Relation' @r@ is an 'bijection' 'iff' @'injection' r && 'surjection' r@

660652bijection ::

661− ( CountableDimsN a b,

662− FLN b b,

663− FLN a a

653+ ( CountableDimensionsN a b,

654+ FromListsN b b,

655+ FromListsN a a

664656 ) => Relation a b -> Bool

665657bijection r = injection r && surjection r

666658

667659-- Properties of relations

668660

669−-- | A 'Relation' @r@ is 'reflexive' 'iff' @'id' ``sse`` r@

670−reflexive :: (CountableN a, FLN a a) => Relation a a -> Bool

671−reflexive r = id <= r

661+-- | A 'Relation' @r@ is 'reflexive' 'iff' @'identity' ``sse`` r@

662+reflexive :: (CountableN a, FromListsN a a) => Relation a a -> Bool

663+reflexive r = identity <= r

672664

673−-- | A 'Relation' @r@ is 'coreflexive' 'iff' @r ``sse`` 'id'@

674−coreflexive :: (CountableN a, FLN a a) => Relation a a -> Bool

675−coreflexive r = r <= id

665+-- | A 'Relation' @r@ is 'coreflexive' 'iff' @r ``sse`` 'identity'@

666+coreflexive :: (CountableN a, FromListsN a a) => Relation a a -> Bool

667+coreflexive r = r <= identity

676668

677−-- | A 'Relation' @r@ is 'transitive' 'iff' @(r `.` r) ``sse`` r@

669+-- | A 'Relation' @r@ is 'transitive' 'iff' @(r ``comp`` r) ``sse`` r@

678670transitive :: Relation a a -> Bool

679−transitive r = (r . r) `sse` r

671+transitive r = (r `comp` r) `sse` r

680672

681673-- | A 'Relation' @r@ is 'symmetric' 'iff' @r == 'conv' r@

682674symmetric :: Relation a a -> Bool

683675symmetric r = r == conv r

684676

685−-- | A 'Relation' @r@ is anti-symmetric 'iff' @(r ``intersection`` 'conv' r) ``sse`` 'id'@

686−antiSymmetric :: (CountableN a, FLN a a) => Relation a a -> Bool

687−antiSymmetric r = (r `intersection` conv r) `sse` id

677+-- | A 'Relation' @r@ is anti-symmetric 'iff' @(r ``intersection`` 'conv' r) ``sse`` 'identity'@

678+antiSymmetric :: (CountableN a, FromListsN a a) => Relation a a -> Bool

679+antiSymmetric r = (r `intersection` conv r) `sse` identity

688680

689−-- | A 'Relation' @r@ is 'irreflexive' 'iff' @(r ``intersection`` 'id') == 'zeros'@

690−irreflexive :: (CountableN a, FLN a a) => Relation a a -> Bool

691−irreflexive r = (r `intersection` id) == zeros

681+-- | A 'Relation' @r@ is 'irreflexive' 'iff' @(r ``intersection`` 'identity') == 'zeros'@

682+irreflexive :: (CountableN a, FromListsN a a) => Relation a a -> Bool

683+irreflexive r = (r `intersection` identity) == zeros

692684

693685-- | A 'Relation' @r@ is 'connected' 'iff' @(r ``union`` 'conv' r) == 'ones'@

694−connected :: (CountableN a, FLN a a) => Relation a a -> Bool

686+connected :: (CountableN a, FromListsN a a) => Relation a a -> Bool

695687connected r = (r `union` conv r) == ones

696688

697689-- | A 'Relation' @r@ is a 'preorder' 'iff' @'reflexive' r && 'transitive' r@

698−preorder :: (CountableN a, FLN a a) => Relation a a -> Bool

690+preorder :: (CountableN a, FromListsN a a) => Relation a a -> Bool

699691preorder r = reflexive r && transitive r

700692

701693-- | A 'Relation' @r@ is a partial-order 'iff' @'antiSymmetric' r && 'preorder' r@

702−partialOrder :: (CountableN a, FLN a a) => Relation a a -> Bool

694+partialOrder :: (CountableN a, FromListsN a a) => Relation a a -> Bool

703695partialOrder r = antiSymmetric r && preorder r

704696

705697-- | A 'Relation' @r@ is a linear-order 'iff' @'connected' r && 'partialOrder' r@

706−linearOrder :: (CountableN a, FLN a a) => Relation a a -> Bool

698+linearOrder :: (CountableN a, FromListsN a a) => Relation a a -> Bool

707699linearOrder r = connected r && partialOrder r

708700

709701-- | A 'Relation' @r@ is an 'equivalence' 'iff' @'symmetric' r && 'preorder' r@

710−equivalence :: (CountableN a, FLN a a) => Relation a a -> Bool

702+equivalence :: (CountableN a, FromListsN a a) => Relation a a -> Bool

711703equivalence r = symmetric r && preorder r

712704

713705-- | A 'Relation' @r@ is a partial-equivalence 'iff' @'partialOrder' r && 'equivalence' r@

714−partialEquivalence :: (CountableN a, FLN a a) => Relation a a -> Bool

706+partialEquivalence :: (CountableN a, FromListsN a a) => Relation a a -> Bool

715707partialEquivalence r = partialOrder r && equivalence r

716708

717709-- | A 'Relation' @r@ is 'difunctional' or regular wherever

718−-- @r `.` 'conv' r `.` r == r@

710+-- @r ``comp`` 'conv' r ``comp`` r == r@

719711difunctional :: Relation a b -> Bool

720−difunctional r = r . conv r . r == r

712+difunctional r = r `comp` conv r `comp` r == r

721713

722714-- Relational pairing

723715

@@ -726,61 +718,61 @@ difunctional r = r . conv r . r == r

726718-- NOTE: That this is not a true categorical product, see for instance:

727719--

728720-- @

729−-- | 'fstR' `.` 'splitR' a b ``sse`` a

721+-- | 'p1' ``comp`` 'splitR' a b ``sse`` a

730722-- 'splitR' a b <=> |

731−-- | 'sndR' `.` 'splitR' a b ``sse`` b

723+-- | 'p2' ``comp`` 'splitR' a b ``sse`` b

732724-- @

733725--

734726-- __Emphasis__ on the 'sse'.

735727--

736728-- @

737−-- 'splitR' r s `.` f == 'splitR' (r `.` f) (s `.` f)

738−-- (R '><' S) `.` 'splitR' p q == 'splitR' (r `.` p) (s `.` q)

739−-- 'conv' ('splitR' r s) `.` 'splitR' x y == ('conv' r `.` x) ``intersection`` ('conv' s `.` y)

729+-- 'splitR' r s ``comp`` f == 'splitR' (r ``comp`` f) (s ``comp`` f)

730+-- (R '><' S) ``comp`` 'splitR' p q == 'splitR' (r ``comp`` p) (s ``comp`` q)

731+-- 'conv' ('splitR' r s) ``comp`` 'splitR' x y == ('conv' r ``comp`` x) ``intersection`` ('conv' s ``comp`` y)

740732-- @

741733--

742734-- @

743735-- 'eitherR' ('splitR' r s) ('splitR' t v) == 'splitR' ('eitherR' r t) ('eitherR' s v)

744736-- @

745737splitR ::

746− ( CountableDimsN a b,

738+ ( CountableDimensionsN a b,

747739 CountableN (a, b),

748− FLN (a, b) a,

749− FLN (a, b) b,

740+ FromListsN (a, b) a,

741+ FromListsN (a, b) b,

750742 TrivialP a b

751743 )

752744 => Relation c a -> Relation c b -> Relation c (a, b)

753−splitR (R f) (R g) = R (I.kr f g)

745+splitR (R f) (R g) = R (I.khatri f g)

754746

755747-- | Relational pairing first component projection

756748--

757749-- @

758−-- 'fstR' `.` 'splitR' r s ``sse`` r

750+-- 'p1' ``comp`` 'splitR' r s ``sse`` r

759751-- @

760−fstR ::

752+p1 ::

761753 forall a b .

762− ( CountableDimsN a b,

754+ ( CountableDimensionsN a b,

763755 CountableN (a, b),

764− FLN (a, b) a,

756+ FromListsN (a, b) a,

765757 TrivialP a b

766758 )

767759 => Relation (a, b) a

768−fstR = R (I.fstM @Boolean @(I.Normalize a) @(I.Normalize b))

760+p1 = R (I.kp1 @Boolean @(I.Normalize a) @(I.Normalize b))

769761

770762-- | Relational pairing second component projection

771763--

772764-- @

773−-- 'sndR' `.` 'splitR' r s ``sse`` s

765+-- 'p2' ``comp`` 'splitR' r s ``sse`` s

774766-- @

775−sndR ::

767+p2 ::

776768 forall a b .

777− ( CountableDimsN a b,

769+ ( CountableDimensionsN a b,

778770 CountableN (a, b),

779− FLN (a, b) b,

771+ FromListsN (a, b) b,

780772 TrivialP a b

781773 )

782774 => Relation (a, b) b

783−sndR = R (I.sndM @Boolean @(I.Normalize a) @(I.Normalize b))

775+p2 = R (I.kp2 @Boolean @(I.Normalize a) @(I.Normalize b))

784776

785777-- Relational pairing functor

786778

@@ -788,17 +780,17 @@ infixl 4 ><

788780-- | Relational pairing functor

789781--

790782-- @

791−-- r '><' s == 'splitR' (r `.` fstR) (s `.` sndR)

792−-- (r '><' s) `.` (p '><' q) == (r `.` p) '><' (s `.` q)

783+-- r '><' s == 'splitR' (r ``comp`` p1) (s ``comp`` p2)

784+-- (r '><' s) ``comp`` (p '><' q) == (r ``comp`` p) '><' (s ``comp`` q)

793785-- @

794786(><) ::

795− ( CountableDimsN a b,

796− CountableDimsN c d,

797− CountableDimsN (a, c) (b, d),

798− FLN (a, c) a,

799− FLN (a, c) c,

800− FLN (b, d) b,

801− FLN (b, d) d,

787+ ( CountableDimensionsN a b,

788+ CountableDimensionsN c d,

789+ CountableDimensionsN (a, c) (b, d),

790+ FromListsN (a, c) a,

791+ FromListsN (a, c) c,

792+ FromListsN (b, d) b,

793+ FromListsN (b, d) d,

802794 TrivialP a c,

803795 TrivialP b d

804796 )

@@ -810,31 +802,31 @@ infixl 4 ><

810802-- | Relational coproduct.

811803--

812804-- @

813−-- | 'eitherR' a b `.` 'i1' == a

805+-- | 'eitherR' a b ``comp`` 'i1' == a

814806-- 'eitherR' a b <=> |

815−-- | 'eitherR' a b `.` 'i2' == b

807+-- | 'eitherR' a b ``comp`` 'i2' == b

816808-- @

817809--

818810-- @

819−-- 'eitherR' r s `.` 'conv' ('eitherR' t u) == (r `.` 'conv' t) ``union`` (s `.` 'conv' u)

811+-- 'eitherR' r s ``comp`` 'conv' ('eitherR' t u) == (r ``comp`` 'conv' t) ``union`` (s ``comp`` 'conv' u)

820812-- @

821813--

822814-- @

823815-- 'eitherR' ('splitR' r s) ('splitR' t v) == 'splitR' ('eitherR' r t) ('eitherR' s v)

824816-- @

825817eitherR :: Relation a c -> Relation b c -> Relation (Either a b) c

826−eitherR = join

818+eitherR = junc

827819

828820-- | Relational coproduct first component injection

829821--

830822-- @

831−-- 'img' 'i1' ``union`` 'img' 'i2' == 'id'

832−-- 'i1' `.` 'i2' = 'zeros'

823+-- 'img' 'i1' ``union`` 'img' 'i2' == 'identity'

824+-- 'i1' ``comp`` 'i2' = 'zeros'

833825-- @

834826i1 ::

835− ( CountableDimsN a b,

836− FLN b a,

837− FLN a a

827+ ( CountableDimensionsN a b,

828+ FromListsN b a,

829+ FromListsN a a

838830 )

839831 => Relation a (Either a b)

840832i1 = R I.i1

@@ -842,13 +834,13 @@ i1 = R I.i1

842834-- | Relational coproduct second component injection

843835--

844836-- @

845−-- 'img' 'i1' ``union`` 'img' 'i2' == 'id'

846−-- 'i1' `.` 'i2' = 'zeros'

837+-- 'img' 'i1' ``union`` 'img' 'i2' == 'identity'

838+-- 'i1' ``comp`` 'i2' = 'zeros'

847839-- @

848840i2 ::

849− ( CountableDimsN a b,

850− FLN a b,

851− FLN b b

841+ ( CountableDimensionsN a b,

842+ FromListsN a b,

843+ FromListsN b b

852844 )

853845 => Relation b (Either a b)

854846i2 = R I.i2

@@ -858,14 +850,14 @@ infixl 5 -|-

858850-- | Relational coproduct functor.

859851--

860852-- @

861−-- r '-|-' s == 'eitherR' ('i1' `.` r) ('i2' `.` s)

853+-- r '-|-' s == 'eitherR' ('i1' ``comp`` r) ('i2' ``comp`` s)

862854-- @

863855(-|-) ::

864− ( CountableDimsN b d,

865− FLN b b,

866− FLN d b,

867− FLN b d,

868− FLN d d

856+ ( CountableDimensionsN b d,

857+ FromListsN b b,

858+ FromListsN d b,

859+ FromListsN b d,

860+ FromListsN d d

869861 )

870862 => Relation a b -> Relation c d -> Relation (Either a c) (Either b d)

871863(-|-) (R a) (R b) = R ((I.-|-) a b)

@@ -878,20 +870,20 @@ infixl 5 -|-

878870-- 'trans'/'untrans';

879871-- more-over, where each particular attribute is placed (input/output) is irrelevant.

880872trans ::

881− ( CountableDimsN a b,

873+ ( CountableDimensionsN a b,

882874 CountableN c,

883− CountableDimsN (a, b) (c, b),

884− FLN (c, b) c,

885− FLN (c, b) b,

886− FLN (a, b) a,

887− FLN (a, b) b,

875+ CountableDimensionsN (a, b) (c, b),

876+ FromListsN (c, b) c,

877+ FromListsN (c, b) b,

878+ FromListsN (a, b) a,

879+ FromListsN (a, b) b,

888880 Trivial (a, b),

889881 Trivial (c, b),

890882 TrivialP a b,

891883 TrivialP c b

892884 )

893885 => Relation (a, b) c -> Relation a (c, b)

894−trans r = splitR r sndR . conv fstR

886+trans r = splitR r p2 `comp` conv p1

895887

896888-- | Relational 'untrans'

897889--

@@ -899,110 +891,107 @@ trans r = splitR r sndR . conv fstR

899891-- 'trans'/'untrans';

900892-- more-over, where each particular attribute is placed (input/output) is irrelevant.

901893untrans ::

902− ( CountableDimsN a b,

894+ ( CountableDimensionsN a b,

903895 CountableN c,

904− CountableDimsN (a, b) (c, b),

905− FLN (c, b) c,

906− FLN (c, b) b,

907− FLN (a, b) b,

908− FLN (a, b) a,

896+ CountableDimensionsN (a, b) (c, b),

897+ FromListsN (c, b) c,

898+ FromListsN (c, b) b,

899+ FromListsN (a, b) b,

900+ FromListsN (a, b) a,

909901 Trivial (a, b),

910902 Trivial (c, b),

911903 TrivialP a b,

912904 TrivialP c b

913905 )

914906 => Relation a (c, b) -> Relation (a, b) c

915−untrans s = fstR . conv (splitR (conv s) sndR)

907+untrans s = p1 `comp` conv (splitR (conv s) p2)

916908

917909-- | Transforms predicate @p@ into a correflexive relation.

918910--

919911-- @

920−-- 'predR' ('const' True) == 'id'

912+-- 'predR' ('const' True) == 'identity'

921913-- 'predR' ('const' False) == 'zeros'

922914-- @

923915--

924916-- @

925−-- 'predR' q `.` 'predR' p == 'predR' q ``union`` 'predR' p

917+-- 'predR' q ``comp`` 'predR' p == 'predR' q ``union`` 'predR' p

926918-- @

927919predR ::

928920 ( Bounded a,

929921 Enum a,

930− Countable a,

931922 CountableN a,

932− FLN a a,

933− FLN Bool a

923+ FromListsN a a,

924+ FromListsN Bool a

934925 )

935926 => Relation a Bool -> Relation a a

936−predR p = id `intersection` divisionF (fromF (const True)) p

927+predR p = identity `intersection` divisionF (fromF' (const True)) p

937928

938929-- | Equalizes functions @f@ and @g@.

939930-- That is, @'equalizer' f g@ is the largest coreflexive

940931-- that restricts @g@ so that @f@ and @g@ yield the same outputs.

941932--

942933-- @

943−-- 'equalizer' r r == 'id'

934+-- 'equalizer' r r == 'identity'

944935-- 'equalizer' ('point' True) ('point' False) == 'zeros'

945936-- @

946937equalizer ::

947938 ( CountableN a,

948− FLN a a

939+ FromListsN a a

949940 )

950941 => Relation a b -> Relation a b -> Relation a a

951−equalizer f g = id `intersection` divisionF f g

942+equalizer f g = identity `intersection` divisionF f g

952943

953944-- | Relational conditional guard.

954945--

955946-- @

956−-- 'guard' p = 'i2' ``overriddenBy`` 'i1' `.` 'predR' p

947+-- 'guard' p = 'i2' ``overriddenBy`` 'i1' ``comp`` 'predR' p

957948-- @

958−guard ::

949+guard ::

959950 ( Bounded b,

960951 Enum b,

961952 CountableN b,

962− Countable b,

963− FLN b b,

964− FLN Bool b

953+ FromListsN b b,

954+ FromListsN Bool b

965955 ) => Relation b Bool -> Relation b (Either b b)

966956guard p = conv (eitherR (predR p) (predR (negate p)))

967957

968958-- | Relational McCarthy's conditional.

969−cond ::

959+cond ::

970960 ( Bounded b,

971961 Enum b,

972− Countable b,

973962 CountableN b,

974− FLN b b,

975− FLN Bool b

976− )

963+ FromListsN b b,

964+ FromListsN Bool b

965+ )

977966 => Relation b Bool -> Relation b c -> Relation b c -> Relation b c

978−cond p r s = eitherR r s . guard p

967+cond p r s = eitherR r s `comp` guard p

979968

980969-- | Relational domain.

981970--

982971-- For injective relations, 'domain' and 'ker'nel coincide,

983−-- since @'ker' r ``sse`` 'id'@ in such situations.

972+-- since @'ker' r ``sse`` 'identity'@ in such situations.

984973domain ::

985974 ( CountableN a,

986− FLN a a

975+ FromListsN a a

987976 ) => Relation a b -> Relation a a

988−domain r = ker r `intersection` id

977+domain r = ker r `intersection` identity

989978

990979-- | Relational range.

991980--

992981-- For functions, 'range' and 'img' (image) coincide,

993−-- since @'img' f ``sse`` id@ for any @f@.

982+-- since @'img' f ``sse`` 'identity'@ for any @f@.

994983range ::

995984 ( CountableN b,

996− FLN b b

985+ FromListsN b b

997986 ) => Relation a b -> Relation b b

998−range r = img r `intersection` id

987+range r = img r `intersection` identity

999988

1000989-- Relation pretty print

1001990

1002991-- | Relation pretty printing

1003−pretty :: (CountableDimsN a b) => Relation a b -> String

992+pretty :: (CountableDimensionsN a b) => Relation a b -> String

1004993pretty (R a) = I.pretty a

1005994

1006995-- | Relation pretty printing

1007−prettyPrint :: (CountableDimsN a b) => Relation a b -> IO ()

996+prettyPrint :: (CountableDimensionsN a b) => Relation a b -> IO ()

1008997prettyPrint (R a) = I.prettyPrint a

src/LAoP/Utils.hs+1−4

@@ -96,10 +96,7 @@ module LAoP.Utils

9696 coerceNat3,

9797

9898 -- * List data type

99− List (..),

100−

101− -- * Category type-class

102− Category(..)

99+ List (..)

103100 )

104101where

105102

src/LAoP/Utils/Internal.hs+2−28

@@ -1,9 +1,9 @@

1−{-# LANGUAGE TypeFamilies #-}

21{-# LANGUAGE DeriveGeneric #-}

32{-# LANGUAGE TypeApplications #-}

43{-# LANGUAGE DataKinds #-}

54{-# LANGUAGE FlexibleInstances #-}

65{-# LANGUAGE GeneralizedNewtypeDeriving #-}

6+{-# LANGUAGE KindSignatures #-}

77{-# LANGUAGE ScopedTypeVariables #-}

99module LAoP.Utils.Internal

@@ -19,10 +19,7 @@ module LAoP.Utils.Internal

1919 coerceNat3,

2020

2121 -- * 'List' data type

22− List (..),

23−

24− -- * Category type class

25− Category(..)

22+ List (..)

2623 )

2724where

2825

@@ -33,9 +30,6 @@ import Data.Maybe

3330import GHC.TypeLits

3431import Control.DeepSeq

3532import GHC.Generics

36−import Data.Kind

37−import Prelude hiding (id, (.))

38−import qualified Prelude

3933

4034-- | Wrapper around 'Int's that have a restrictive semantic associated.

4135-- A value of type @'Natural' n m@ can only be instanciated with some 'Int'

@@ -174,23 +168,3 @@ instance

174168 fromEnum (L x) =

175169 let as = [minBound .. maxBound]

176170 in fromMaybe (error "Does not exist") $ elemIndex x (powerset as)

177−

178−-- | Constrained category instance

179−class Category k where

180− type Object k o :: Constraint

181− type Object k o = ()

182− id :: Object k a => k a a

183− (.) :: k b c -> k a b -> k a c

184−

185−{-# RULES

186−"identity/left" forall p .

187− id . p = p

188−"identity/right" forall p .

189− p . id = p

190−"association" forall p q r .

191− (p . q) . r = p . (q . r)

192− #-}

193−

194−instance Category (->) where

195− id = Prelude.id

196− (.) = (Prelude..)

stack-8.8.3.yamldeleted−1

@@ -1 +0,0 @@

1−resolver: lts-15.5

stack.yaml+66−1

@@ -1 +1,66 @@

1−resolver: lts-14.3

1+# This file was automatically generated by 'stack init'

2+#

3+# Some commonly used options have been documented as comments in this file.

4+# For advanced use and comprehensive documentation of the format, please see:

5+# https://docs.haskellstack.org/en/stable/yaml_configuration/

7+# Resolver to choose a 'specific' stackage snapshot or a compiler version.

8+# A snapshot resolver dictates the compiler version and the set of packages

9+# to be used for project dependencies. For example:

10+#

11+# resolver: lts-3.5

12+# resolver: nightly-2015-09-21

13+# resolver: ghc-7.10.2

14+#

15+# The location of a snapshot can be provided as a file or url. Stack assumes

16+# a snapshot provided as a file might change, whereas a url resource does not.

17+#

18+# resolver: ./custom-snapshot.yaml

19+# resolver: https://example.com/snapshots/2018-01-01.yaml

20+resolver: lts-14.18

21+

22+# User packages to be built.

23+# Various formats can be used as shown in the example below.

24+#

25+# packages:

26+# - some-directory

27+# - https://example.com/foo/bar/baz-0.0.2.tar.gz

28+# subdirs:

29+# - auto-update

30+# - wai

31+packages:

32+- .

33+# Dependency packages to be pulled from upstream that are not in the resolver.

34+# These entries can reference officially published versions as well as

35+# forks / in-progress versions pinned to a git hash. For example:

36+#

37+# extra-deps:

38+# - acme-missiles-0.3

39+# - git: https://github.com/commercialhaskell/stack.git

40+# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a

41+#

42+# extra-deps: []

43+

44+# Override default flag values for local packages and extra-deps

45+# flags: {}

46+

47+# Extra package databases containing global packages

48+# extra-package-dbs: []

49+

50+# Control whether we use the GHC we find on the path

51+# system-ghc: true

52+#

53+# Require a specific version of stack, using version ranges

54+# require-stack-version: -any # Default

55+# require-stack-version: ">=2.1"

56+#

57+# Override the architecture used by stack, especially useful on Windows

58+# arch: i386

59+# arch: x86_64

60+#

61+# Extra directories used by stack for building

62+# extra-include-dirs: [/path/to/dir]

63+# extra-lib-dirs: [/path/to/dir]

64+#

65+# Allow a newer minor version of GHC than the snapshot specifies

66+# compiler-check: newer-minor

stack.yaml.lock+4−4

@@ -6,7 +6,7 @@

66packages: []

77snapshots:

88- completed:

9− size: 523878

10− url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/14/3.yaml

11− sha256: 470c46c27746a48c7c50f829efc0cf00112787a7804ee4ac7a27754658f6d92c

12− original: lts-14.3

9+ size: 524789

10+ url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/14/18.yaml

11+ sha256: 646be71223e08234131c6989912e6011e01b9767bc447b6d466a35e14360bdf2

12+ original: lts-14.18

test/Examples/Quantum.hsdeleted−31

@@ -1,31 +0,0 @@

1−{-# LANGUAGE StandaloneDeriving #-}

2−module Examples.Quantum where

3−

4−import LAoP.Utils

5−import LAoP.Matrix.Type

6−import Data.Complex

7−import Prelude hiding (id, (.))

8−

9−deriving instance Ord a => Ord (Complex a)

10−

11−xor :: (Bool, Bool) -> Bool

12−xor (False, b) = b

13−xor (True, b) = not b

14−

15−ker :: Num e => Matrix e a b -> Matrix e a a

16−ker m = tr m . m

17−

18−cnot :: Matrix (Complex Double) (Bool, Bool) (Bool, Bool)

19−cnot = kr fstM (fromF xor)

20−

21−ccnot :: (Num e, Ord e) => Matrix e ((Bool, Bool), Bool) ((Bool, Bool), Bool)

22−ccnot = kr fstM (fromF f)

23− where

24− f = xor . tp (uncurry (&&)) id

25− tp f g (a,b) = (f a, g b)

26−

27−had :: Matrix (Complex Double) Bool Bool

28−had = (1/sqrt 2) .| fromLists [[1, 1], [1, -1]]

29−

30−bell :: Matrix (Complex Double) (Bool, Bool) (Bool, Bool)

31−bell = cnot . (had >< iden)

test/Spec.hs+1−7

@@ -1,8 +1,2 @@

1−module Main (main) where

2−

3−import qualified Examples.Readme as RD

4−

51main :: IO ()

6−main = do

7− putStrLn ("Testing if README works" :: String)

8− RD.exec

2+main = putStrLn "Test suite not yet implemented"