master..d4b69a9 · laop

git.iko.soy/laop

33 files changed+1420−1763

unifiedsplit

.ghc.environment.x86_64-linux-8.6.5+17 .github/workflows/ci.yml−43 .gitignore+2−54 .travis.yml−47 CHANGELOG.md−17 ChangeLog.md+3 LICENSE+26−17 README.md+27−35 Setup.hs+2 app/Benchmarks.hs+102 test/Examples/Readme.hs → app/Examples.hs+31−56 app/Main.hs+7 test/Examples/Spreadsheets.hs → app/Spreadsheets.hs+14−13 appveyor.yml−34 benchmark/Main.hs−175 hackage.sh+10 laop-0.1.0.0-docs.tar.gz laop.cabal−89 package.yaml+48 src/LAoP/Dist.hs+2−4 src/LAoP/Dist/Internal.hs+29−68 src/LAoP/Matrix/Internal.hs+392−399 src/LAoP/Matrix/Nat.hs+124−139 src/LAoP/Matrix/Type.hs+171−233 src/LAoP/Relation.hs+11−8 src/LAoP/Relation/Internal.hs+254−250 src/LAoP/Utils.hs+2−5 src/LAoP/Utils/Internal.hs+75−33 stack-8.8.3.yaml−1 stack.yaml+66−1 stack.yaml.lock+4−4 test/Examples/Quantum.hs−31 test/Spec.hs+1−7

.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+27−35

@@ -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,36 @@ 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.

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

2214

2315## Features

2416

25−This library offers 3 main matrix programming modules:

26−

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;

30−

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

32−distributions.

33−

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

49−

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).

17+This library offers:

18+

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

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

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

22+ around the internal matrix data type.

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

24+ around the internal matrix data type.

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

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

27+ AoP and Relational Calculus/Algebra.

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

29+ make it easier to deal with sample space.

30+

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

32+

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

34+- Statically typed dimensions;

35+- Polymorphic data type dimensions;

36+- Polymorphic matrix content;

37+- Awesome dimension type inference;

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

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

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

41+

42+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.

5143

5244## Notes

5345

Setup.hsnew file+2

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

1+import Distribution.Simple

2+main = defaultMain

app/Benchmarks.hsnew file+102

@@ -0,0 +1,102 @@

1+{-# LANGUAGE DataKinds #-}

2+{-# LANGUAGE BangPatterns #-}

3+{-# LANGUAGE TypeApplications #-}

4+{-# LANGUAGE FlexibleContexts #-}

5+{-# LANGUAGE AllowAmbiguousTypes #-}

6+{-# LANGUAGE ScopedTypeVariables #-}

8+module Benchmarks

9+ ( benchmark

10+ )

11+ where

12+

13+import LAoP.Dist.Internal

14+import LAoP.Utils

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

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

17+import Criterion.Main

18+import Control.DeepSeq

19+import Test.QuickCheck

20+import GHC.TypeLits

21+import Data.Proxy

22+import Data.Time.Clock.POSIX (getPOSIXTime)

23+

24+selectM2 ::

25+ ( Num e,

26+ T.FromListsN e b b,

27+ CountableN b

28+ ) => Matrix e cols (Either a b) -> Matrix e a b -> Matrix e cols b

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

30+

31+selectD2 ::

32+ ( FromListsN b b,

33+ CountableN b

34+ ) => Dist (Either a b) -> Matrix Prob a b -> Dist b

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

36+

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

38+randomDist = do

39+ let size = fromInteger (natVal (Proxy :: Proxy (Count a)))

40+ l <- vectorOf size (arbitrary :: Gen Prob)

41+ let ln = normalize l

42+ lr = map (:[]) ln

43+ m = fromLists lr

44+ return (D m)

45+

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

47+randomMatrix = do

48+ let cols = fromInteger (natVal (Proxy :: Proxy (Count a)))

49+ rows = fromInteger (natVal (Proxy :: Proxy (Count b)))

50+ l <- vectorOf (cols * rows) (arbitrary :: Gen Float)

51+ let lr = buildList l cols

52+ m = fromLists lr

53+ return m

54+

55+buildList [] _ = []

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

57+

58+normalize :: [Prob] -> [Prob]

59+normalize l = let l' = map abs l

60+ s = sum l'

61+ in map (/ s) l'

62+

63+setupEnv = do

64+ m11 <- generate (resize 1 (randomMatrix @(Natural 0 10) @(Natural 0 10) ))

65+ m12 <- generate (resize 1 (randomMatrix @(Natural 0 10) @(Natural 0 10) ))

66+ m21 <- generate (resize 1 (randomMatrix @(Natural 0 100) @(Natural 0 100) ))

67+ m22 <- generate (resize 1 (randomMatrix @(Natural 0 100) @(Natural 0 100) ))

68+ m31 <- generate (resize 1 (randomMatrix @(Natural 0 300) @(Natural 0 300) ))

69+ m32 <- generate (resize 1 (randomMatrix @(Natural 0 300) @(Natural 0 300) ))

70+ m40 <- generate (resize 1 (randomMatrix @(Natural 0 100) @(Either (Natural 0 100) (Natural 0 100) )))

71+ dist <- generate (resize 1 (randomDist @(Either (Natural 0 1000) (Natural 0 1000)) ))

72+ dist2 <- generate (resize 1 (randomMatrix @(Natural 0 1000) @(Natural 0 1000) ))

73+ return (m11, m12, m21, m22, m31, m32, m40, dist, dist2)

74+

75+benchmark :: IO ()

76+benchmark = defaultMain [

77+ env setupEnv $ \ ~(m11, m12, m21, m22, m31, m32, m40, dist, dist2) -> bgroup "main" [

78+ bgroup "Matrix composition" [

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

80+ , bench "NF - 10x10" $ nf (comp m11) m12

81+ , bench "WHNF - 100x100" $ whnf (comp m21) m22

82+ , bench "NF - 100x100" $ nf (comp m21) m22

83+ , bench "WHNF - 300x300" $ whnf (comp m31) m32

84+ , bench "NF - 300x300" $ nf (comp m31) m32

85+ ],

86+ bgroup "Dist - Applicative `select`" [

87+ bench "WHNF" $ whnf (selectD2 dist) dist2

88+ , bench "NF" $ nf (selectD2 dist) dist2

89+ ],

90+ bgroup "Dist - Selective `select`" [

91+ bench "WHNF" $ whnf (selectD dist) dist2

92+ , bench "NF" $ nf (selectD dist) dist2

93+ ],

94+ bgroup "Matrix - Applicative `select`" [

95+ bench "WHNF" $ whnf (selectM2 m40) m21

96+ , bench "NF" $ nf (selectM2 m40) m21

97+ ],

98+ bgroup "Matrix - Selective `select`" [

99+ bench "WHNF" $ whnf (selectM m40) m21

100+ , bench "NF" $ nf (selectM m40) m21

101+ ]

102+ ] ]

test/Examples/Readme.hs → app/Examples.hsrenamed+31−56

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

1−{-# LANGUAGE GADTs #-}

21{-# LANGUAGE DeriveGeneric #-}

32{-# LANGUAGE FlexibleContexts #-}

3+{-# LANGUAGE TypeOperators #-}

44{-# LANGUAGE TypeApplications #-}

55{-# LANGUAGE DataKinds #-}

7−module Examples.Readme

7+module Examples

88 ( exec

99 )

1010 where

@@ -15,12 +15,13 @@ import LAoP.Utils

1515import LAoP.Dist

1616import GHC.TypeLits

1717import Data.Coerce

18−import qualified GHC.Generics as G

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

18+import GHC.Generics

19+import Control.Category hiding (id)

20+import Prelude hiding ((.))

2021

2122-- Monty Hall Problem

2223data Outcome = Win | Lose

23− deriving (Bounded, Enum, Eq, Show, G.Generic)

24+ deriving (Bounded, Enum, Eq, Show, Generic)

2425

2526switch :: Outcome -> Outcome

2627switch Win = Lose

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

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

3132

3233secondChoice :: Matrix Double Outcome Outcome

33−secondChoice = fromF switch

34+secondChoice = fromF' switch

3435

3536-- Dice sum

3637

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

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

4041sumSS = coerceNat (+)

4142

42−sumSSM = fromF (uncurry sumSS)

43+sumSSM = fromF' (uncurry sumSS)

4344

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

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

@@ -49,64 +50,38 @@ condition (fst, snd) thrd = if fst == snd

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

5051conditionSS = coerceNat2 condition

5152

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

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

5354

5455die :: Matrix Double () SS

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

5657

5758-- Sprinkler

58−data G = Dry | Wet

59− deriving (Bounded, Enum, Eq, Show, G.Generic)

6059

61−data S = Off | On

62− deriving (Bounded, Enum, Eq, Show, G.Generic)

60+rain :: Matrix Double () Bool

61+rain = col [0.8, 0.2]

6362

64−data R = No | Yes

65− deriving (Bounded, Enum, Eq, Show, G.Generic)

63+sprinkler :: Matrix Double Bool Bool

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

6665

67−rain :: Matrix Double () R

68−rain = matrixBuilder gen

69− where

70− gen (_, No) = 0.8

71− gen (_, Yes) = 0.2

72−

73−sprinkler :: 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

80−

81−grass :: 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

92−

93−tag f = kr f id

66+grass :: Matrix Double (Bool, Bool) Bool

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

9468

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

69+state :: Matrix Double () (Bool, (Bool, Bool))

70+state = khatri grass identity . khatri sprinkler identity . rain

9671

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

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

72+grass_wet :: Matrix Double (Bool, (Bool, Bool)) One

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

9974

100−rainning :: Matrix Double (G, (S, R)) One

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

75+rainning :: Matrix Double (Bool, (Bool, Bool)) One

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

10277

10378-- Alcuin Puzzle

10479

10580data Being = Farmer | Fox | Goose | Beans

106− deriving (Bounded, Enum, Eq, Show, G.Generic)

81+ deriving (Bounded, Enum, Eq, Show, Generic)

10782

10883data Bank = LeftB | RightB

109− deriving (Bounded, Enum, Eq, Show, G.Generic)

84+ deriving (Bounded, Enum, Eq, Show, Generic)

11085

11186eats :: Being -> Being -> Bool

11287eats Fox Goose = True

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

12196cross RightB = LeftB

12297

12398crossR :: R.Relation Bank Bank

124−crossR = R.fromF cross

99+crossR = R.fromF' cross

125100

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

127102locationLeft :: Being -> Bank

128103locationLeft _ = LeftB

129104

130105locationLeftR :: R.Relation Being Bank

131−locationLeftR = R.fromF locationLeft

106+locationLeftR = R.fromF' locationLeft

132107

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

134109locationRight :: Being -> Bank

135110locationRight _ = RightB

136111

137112locationRightR :: R.Relation Being Bank

138−locationRightR = R.fromF locationRight

113+locationRightR = R.fromF' locationRight

139114

140115-- Properties

141116

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

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

153128 where

154129 farmer :: R.Relation Being Being

155− farmer = R.fromF (const Farmer)

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

156131

157132-- Arbitrary state

158133bankState :: Being -> Bank -> Bool

@@ -171,14 +146,14 @@ exec = do

171146 putStrLn "Monty Hall Problem solution:"

172147 prettyPrint (secondChoice . firstChoice)

173148 putStrLn "\n Sum of dices probability:"

174− prettyPrint (sumSSM . kr die die)

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

175150 putStrLn "\n Conditional dice throw:"

176151 prettyPrint conditionalThrows

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

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

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

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

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

155+ prettyPrint (grass_wet . state)

181156 putStrLn "\n Probability of rain:"

182− prettyPrint (rainning . state grass sprinkler rain)

157+ prettyPrint (rainning . state)

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

184159 print (inv bankStateR)

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+14−13

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

1+{-# LANGUAGE DataKinds #-}

2+{-# LANGUAGE GADTs #-}

3+{-# LANGUAGE FlexibleContexts #-}

14{-# LANGUAGE DeriveGeneric #-}

5+module Spreadsheets

6+ (

7+ )

8+ where

3−module Examples.Spreadsheets

4−

5−import LAoP.Utils

610import LAoP.Matrix.Type

711import GHC.Generics

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

912

1013data Student = Student1 | Student2 | Student3 | Student4

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

@@ -13,7 +16,7 @@ data Student = Student1 | Student2 | Student3 | Student4

1316data Question = Question1 | Question2 | Question3 | Question4

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

1518

16−data Results = Exam | Test | Final

19+data Results = Test | Exam | Final

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

1821

1922test :: Matrix Float One Results

@@ -35,13 +38,11 @@ xls :: Matrix Float Question One

3538 -> Matrix Float Question Student

3639 -> Matrix Float Student One

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

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

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

3942 where

40− rExam = m . tr w

43+ rExam = m `comp` tr w

4144 rTest = tr t

42− rFinal = rTest `maxPW` rExam

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

44−

45−-- | Overloaded, point-wise 'max' function

46−maxPW :: Ord e => Matrix e a b -> Matrix e a b -> Matrix e a b

47−maxPW = zipWithM max

45+ rFinal = rTest `max` rExam

46+ rAux = junc rTest (junc rExam rFinal)

47+ r = tr (converter `comp` tr rAux)

48+ converter = junc test (junc exam final)

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

benchmark/Main.hsdeleted−175

@@ -1,175 +0,0 @@

1−{-# LANGUAGE KindSignatures #-}

2−{-# LANGUAGE GeneralizedNewtypeDeriving #-}

3−{-# LANGUAGE DerivingVia #-}

4−{-# LANGUAGE DataKinds #-}

5−{-# LANGUAGE BangPatterns #-}

6−{-# LANGUAGE TypeApplications #-}

7−{-# LANGUAGE FlexibleContexts #-}

8−{-# LANGUAGE AllowAmbiguousTypes #-}

9−{-# LANGUAGE ScopedTypeVariables #-}

10−

11−module Main (main) where

12−

13−import LAoP.Dist.Internal

14−import LAoP.Utils

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

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

17−import Criterion.Main

18−import Control.DeepSeq

19−import Test.QuickCheck

20−import GHC.TypeLits

21−import Data.Proxy

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

23−

24−selectM2 ::

25− ( Num e,

26− T.FLN b b,

27− CountableN b

28− ) => Matrix e cols (Either a b) -> Matrix e a b -> Matrix e cols b

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

30−

31−selectD2 ::

32− ( FLN b b,

33− CountableN b

34− ) => Dist (Either a b) -> Matrix Prob a b -> Dist b

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

36−

37−-- Composition with iden

38−compId m = comp iden m

39−

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

41−randomDist = do

42− let size = fromInteger (natVal (Proxy :: Proxy (Count a)))

43− l <- vectorOf size (arbitrary :: Gen Prob)

44− let ln = normalize l

45− lr = map (:[]) ln

46− m = fromLists lr

47− return (D m)

48−

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

50−randomMatrix = do

51− let cols = fromInteger (natVal (Proxy :: Proxy (Count a)))

52− rows = fromInteger (natVal (Proxy :: Proxy (Count b)))

53− l <- vectorOf (cols * rows) arbitrary

54− let lr = buildList l cols

55− m = fromLists lr

56− return m

57−

58−buildList [] _ = []

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

60−

61−normalize :: [Prob] -> [Prob]

62−normalize l = let l' = map abs l

63− s = sum l'

64− in map (/ s) l'

65−

66−-- Probability

67−newtype Probability = P Double

68− deriving (Num, Show, Fractional, NFData) via Double

69−newtype Dist' a = D' { unD :: [(a,Probability)] }

70− deriving (Show, NFData)

71−

72−instance Functor Dist' where

73− fmap f (D' d) = D' [(f x,p) | (x,p) <- d]

74−

75−instance Applicative Dist' where

76− pure x = D' [(x, 1)]

77− fm <*> m = D' [(f x,q*p) | (f,p) <- unD fm, (x,q) <- unD m]

78−

79−class Applicative f => Selective f where

80− select :: f (Either a b) -> f (a -> b) -> f b

81−

82−instance Selective Dist' where

83− select x y = (\e f -> either f id e) <$> x <*> y -- selectA

84−

85−instance Monad Dist' where

86− return = pure

87− (D' d) >>= f = D' [(y,q*p) | (x,p) <- d, (y,q) <- unD (f x)]

88−

89−normalize2 :: forall a . (Enum a, Bounded a) => [Probability] -> [(a, Probability)]

90−normalize2 l = let l' = map abs l

91− as = [minBound .. maxBound]

92− s = sum l'

93− probs = map (/ s) l'

94− in zip as probs

95−

96−randomDist2 :: forall a . (Countable a, Enum a, Bounded a) => Gen (Dist' a)

97−randomDist2 = do

98− let size = fromInteger (natVal (Proxy :: Proxy (Count a)))

99− l <- vectorOf size (arbitrary :: Gen Prob)

100− let ln = normalize2 @a (map P l)

101− return (D' ln)

102−

103−normalize3 :: forall a . [a] -> [Probability] -> [(a, Probability)]

104−normalize3 as l = let s = sum l

105− probs = map (/ s) l

106− in zip as probs

107−

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

109−randomDistF = do

110− let a = fromInteger (natVal (Proxy :: Proxy (Count a)))

111− b = fromInteger (natVal (Proxy :: Proxy (Count b)))

112− size = a * b

113− l <- vectorOf size (arbitrary :: Gen Prob)

114− l2 <- vectorOf size (arbitrary :: Gen (a -> b))

115− let !ln = normalize3 l2 (map P l)

116− return (D' ln)

117−

118−instance CoArbitrary (Natural a b)

119−

120−instance forall (a :: Nat) (b :: Nat). (KnownNat a, KnownNat b) => Arbitrary (Natural a b)

121− where

122− arbitrary =

123− let bottom = fromInteger (natVal (Proxy :: Proxy a))

124− top = fromInteger (natVal (Proxy :: Proxy b))

125− in do

126− x <- arbitrary `suchThat` (\n -> n >= bottom && n <= top)

127− return (nat x)

128−

129−setupEnv = do

130− m11 <- generate (resize 1 (randomMatrix @(Natural 0 10) @(Natural 0 10) ))

131− m12 <- generate (resize 1 (randomMatrix @(Natural 0 10) @(Natural 0 10) ))

132− m21 <- generate (resize 1 (randomMatrix @(Natural 0 100) @(Natural 0 100) ))

133− m22 <- generate (resize 1 (randomMatrix @(Natural 0 100) @(Natural 0 100) ))

134− m31 <- generate (resize 1 (randomMatrix @(Natural 0 200) @(Natural 0 200) ))

135− m32 <- generate (resize 1 (randomMatrix @(Natural 0 200) @(Natural 0 200) ))

136− return (m11, m12, m21, m22, m31, m32)

137−

138−setupEnv2 = do

139− m21 <- generate (resize 1 (randomMatrix @(Natural 0 100) @(Natural 0 100) ))

140− m40 <- generate (resize 1 (randomMatrix @(Natural 0 100) @(Either (Natural 0 100) (Natural 0 100) )))

141− dist <- generate (resize 1 (randomDist @(Either (Natural 0 100) (Natural 0 100)) ))

142− dist2 <- generate (resize 1 (randomMatrix @(Natural 0 100) @(Natural 0 100) ))

143− distList1 <- generate (resize 1 (randomDist2 @(Either (Natural 0 100) (Natural 0 100))))

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

145− return (m21, m40, dist, dist2, distList1, distList2)

146−

147−main :: IO ()

148−main = defaultMain [

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

150− bgroup "10x10" [

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

152− , bench "NF - 10x10" $ nf (comp m11) m12

153− ],

154− bgroup "100x100" [

155− bench "WHNF - 100x100" $ whnf (comp m21) m22

156− , bench "NF - 100x100" $ nf (comp m21) m22

157− ],

158− bgroup "200x200" [

159− bench "WHNF - 200x200" $ whnf (comp m31) m32

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

161− ],

162− bgroup "200x200 - RULES" [

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

164− , bench "Rules - 200x200" $ nf compId m21

165− ] ],

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

167− bgroup "Distribution `select` - 100+100 / 100x100" [

168− bench "List Distribution - Applicative version" $ nf (select dl1) dl2

169− , bench "Matrix Distribution - Applicative version" $ nf (selectD2 dist) dist2

170− , bench "Matrix Distribution - Selective version" $ nf (selectD dist) dist2

171− ],

172− bgroup "Matrix `select` - 100x(100+100) / 100x100" [

173− bench "Applicative version" $ nf (selectM2 m40) m21

174− , bench "Selective version" $ nf (selectM m40) m21

175− ] ] ]

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-0.1.0.0-docs.tar.gznew file

Binary file not shown.

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+48

@@ -0,0 +1,48 @@

1+name: laop

2+version: 0.1.0.0

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: Web

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+

25+library:

26+ source-dirs: src

27+

28+#executables:

29+# laop-exe:

30+# main: Main.hs

31+# source-dirs: app

32+# ghc-options:

33+# - -threaded

34+# - -rtsopts

35+# - -with-rtsopts=-N

36+# dependencies:

37+# - laop

38+

39+tests:

40+ laop-test:

41+ main: Spec.hs

42+ source-dirs: test

43+ ghc-options:

44+ - -threaded

45+ - -rtsopts

46+ - -with-rtsopts=-N

47+ dependencies:

48+ - laop

src/LAoP/Dist.hs+2−4

@@ -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

@@ -53,8 +53,6 @@ module LAoP.Dist

5353

5454 -- * Selective equivalent functions

5555 selectD,

56− branchD,

57− ifD,

5856

5957 -- * Monad equivalent functions

6058 returnD,

src/LAoP/Dist/Internal.hs+29−68

@@ -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

@@ -25,8 +25,6 @@ module LAoP.Dist.Internal

2525 unitD,

2626 multD,

2727 selectD,

28− branchD,

29− ifD,

3028 returnD,

3129 bindD,

3230 (??),

@@ -43,18 +41,16 @@ module LAoP.Dist.Internal

4341 )

4442 where

4543

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

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

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

4845import qualified LAoP.Matrix.Internal as I

4946import LAoP.Utils

5047import GHC.TypeLits

5148import Data.Proxy

5249import Data.List (sortBy)

5350import Control.DeepSeq

54−import Data.Bool

5551

5652-- | Type synonym for probability value

57−type Prob = Double

53+type Prob = Float

5854

5955-- | Type synonym for column vector matrices. This represents a probability

6056-- distribution.

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

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

6359

6460-- | 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)

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

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

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

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

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

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

7167

7268-- | Functor instance

7369fmapD ::

7470 ( Liftable a b,

75− CountableDimsN a b,

76− FLN b a

71+ CountableDimensionsN a b,

72+ FromListsN b a

7773 )

7874 =>

7975 (a -> b) -> Dist a -> Dist b

@@ -85,58 +81,23 @@ unitD = D (one 1)

8581

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

8783multD ::

88− ( CountableDimsN a b,

84+ ( CountableDimensionsN a b,

8985 CountableN (a, b),

90− FLN (a, b) a,

91− FLN (a, b) b,

86+ FromListsN (a, b) a,

87+ FromListsN (a, b) b,

9288 TrivialP a b

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

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

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

9591

9692-- | Selective instance function

9793selectD ::

98− ( FLN b b,

94+ ( FromListsN b b,

9995 CountableN b

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

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

10298

103−-- | Chooses which of the two given effectful

104−-- functions to apply to a given argument;

105−branchD ::

106− ( 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

118− )

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

120−branchD x l r = f x `selectD` g l `selectD` r

121− where

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

123− g m = i2 `comp` m

124−

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

126−ifD ::

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

128− FLN a a,

129− FLN a (),

130− FLN () a,

131− FLN (Either () a) a

132− )

133− => Dist Bool -> Dist a -> Dist a -> Dist a

134−ifD x (D t) (D e) = branchD x' t e

135− where

136− x' = bool (Right ()) (Left ()) `fmapD` x

137−

13899-- | Monad instance 'return' function

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

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

140101returnD a = D (col l)

141102 where

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

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

151112(??) ::

152113 ( Enum a,

153114 Countable a,

154− FLN () a

115+ FromListsN () a

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

156117(??) p d =

157118 let l = toValues d

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

161122-- Distribution Construction

162123

163124-- | Constructs a Bernoulli distribution

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

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

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

166127

167128-- | Creates a distribution given a shape function

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

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

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

170131shape f xs =

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

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

173134 in fromFreqs (zip xs ps)

174135

175136-- | Constructs a Linear distribution

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

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

177138linear = shape id

178139

179140-- | Constructs an Uniform distribution

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

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

181142uniform = shape (const 1)

182143

183144-- | Constructs an Negative Exponential distribution

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

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

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

186147

187148-- | Constructs an Normal distribution

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

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

189150normal = shape (normalCurve 0.5 0.5)

190151

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

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

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

193154toValues (D d) =

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

195156 probs = toList d

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

197158 in res

198159

199160-- | Pretty a distribution

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

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

201162prettyDist d =

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

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

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

209170 showR n x = show x ++ " "

210171

211172-- | Pretty Print a distribution

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

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

213174prettyPrintDist = putStrLn . prettyDist @a

214175

215176-- Auxiliary functions

216177

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

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

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

219180 where q = sum $ map snd xs

220181

src/LAoP/Matrix/Internal.hs+392−399

@@ -1,4 +1,3 @@

1−{-# LANGUAGE StrictData #-}

21{-# LANGUAGE TypeFamilyDependencies #-}

32{-# LANGUAGE ConstraintKinds #-}

43{-# LANGUAGE AllowAmbiguousTypes #-}

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

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

3130--

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

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

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

3433--

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

3635--

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

4342 --

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

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

46− -- leads to a very straightforward implementation

47− -- of LAoP combinators.

45+ -- leads to a very straightforward implementation

46+ -- of LAoP combinators.

4847

4948 -- * Type safe matrix representation

5049 Matrix (..),

5150

52− -- * Constraint type aliases

53− Countable,

54− CountableDims,

55− CountableN,

56− CountableDimsN,

57− FL,

58− FLN,

59− Liftable,

60− Trivial,

61−

6251 -- * Primitives

52+ empty,

6353 one,

64− join,

65− fork,

54+ junc,

55+ split,

6656

6757 -- * Auxiliary type families

6858 FromNat,

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

7565 toLists,

7666 toList,

7767 matrixBuilder,

78− matrixBuilder',

7968 row,

8069 col,

8170 zeros,

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

8675 -- * Misc

8776 -- ** Get dimensions

8877 columns,

89− columns',

9078 rows,

91− rows',

9279

9380 -- ** Matrix Transposition

9481 tr,

9582

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

97− (.|),

98− (./),

99−

10083 -- ** Selective operator

10184 select,

10285 branch,

@@ -105,19 +88,16 @@ module LAoP.Matrix.Internal

10588 cond,

10689

10790 -- ** Matrix "abiding"

108− abideJF,

109− abideFJ,

110−

111− -- ** Zip matrices

112− zipWithM,

91+ abideJS,

92+ abideSJ,

11393

11494 -- * Biproduct approach

115− -- ** Fork

95+ -- ** Split

11696 (===),

11797 -- *** Projections

11898 p1,

11999 p2,

120− -- ** Join

100+ -- ** Junc

121101 (|||),

122102 -- *** Injections

123103 i1,

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

130110

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

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

133−

134113 -- *** Matrix pairing projections

135− fstM,

136− sndM,

114+ kp1,

115+ kp2,

137116

138117 -- *** Matrix pairing

139− kr,

118+ khatri,

140119

141120 -- * Matrix composition and lifting

142121

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

144123

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

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

147− iden,

126+ identity,

148127 comp,

149− fromF',

150128 fromF,

129+ fromF',

151130

152131 -- * Matrix printing

153132 pretty,

@@ -174,22 +153,21 @@ import LAoP.Utils.Internal

174153import Data.Bool

175154import Data.Kind

176155import Data.List

177−import Data.Maybe

178156import Data.Proxy

179−import Data.Typeable

180157import Data.Void

181158import GHC.TypeLits

182159import Data.Type.Equality

183160import GHC.Generics

184161import Control.DeepSeq

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

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

162+import Control.Category

163+import Prelude hiding ((.))

187164

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

189166data Matrix e cols rows where

167+ Empty :: Matrix e Void Void

190168 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)

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

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

193171

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

195173

@@ -216,95 +194,122 @@ type family Count (d :: Type) :: Nat where

216194--

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

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

197+ FromNat 0 = Void

219198 FromNat 1 = ()

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

221200

222201type family FromNat' (b :: Bool) (m :: Type) :: Type where

223− FromNat' 'True m = Either m m

202+ FromNat' 'True m = Either m m

224203 FromNat' 'False m = Either () (Either m m)

225204

226205-- | Type family that normalizes the representation of a given data

227206-- structure

228207type family Normalize (d :: Type) :: Type where

229− Normalize (Either a b) = Either (Normalize a) (Normalize b)

230− Normalize d = FromNat (Count d)

208+ Normalize (Either a b) = Either (Normalize a) (Normalize b)

209+ Normalize d = FromNat (Count d)

231210

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

233212type Countable a = KnownNat (Count a)

234213type 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)

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

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

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

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

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

241219

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

243−-- class.

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

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

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

223+--

224+-- Please use 'identity' instead.

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

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

246− id = iden

247− (.) = comp

226+ id = undefined

227+ (.) = comp

248228

249229instance 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

230+ rnf Empty = ()

231+ rnf (One e) = rnf e

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

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

253234

254235instance 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

236+ Empty == Empty = True

237+ (One a) == (One b) = a == b

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

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

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

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

260242

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

262− a + b = zipWithM (+) a b

263−

264− a - b = zipWithM (-) a b

265−

266− a * b = zipWithM (*) a b

267244

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)

271−

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)

245+ Empty + Empty = Empty

246+ (One a) + (One b) = One (a + b)

247+ (Junc a b) + (Junc c d) = Junc (a + c) (b + d)

248+ (Split a b) + (Split c d) = Split (a + c) (b + d)

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

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

251+

252+ Empty - Empty = Empty

253+ (One a) - (One b) = One (a - b)

254+ (Junc a b) - (Junc c d) = Junc (a - c) (b - d)

255+ (Split a b) - (Split c d) = Split (a - c) (b - d)

256+ x@(Split _ _) - y@(Junc _ _) = x - abideJS y

257+ x@(Junc _ _) - y@(Split _ _) = abideJS x - y

258+

259+ Empty * Empty = Empty

260+ (One a) * (One b) = One (a * b)

261+ (Junc a b) * (Junc c d) = Junc (a * c) (b * d)

262+ (Split a b) * (Split c d) = Split (a * c) (b * d)

263+ x@(Split _ _) * y@(Junc _ _) = x * abideJS y

264+ x@(Junc _ _) * y@(Split _ _) = abideJS x * y

265+

266+ abs Empty = Empty

267+ abs (One a) = One (abs a)

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

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

270+

271+ signum Empty = Empty

272+ signum (One a) = One (signum a)

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

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

275275

276276instance 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

277+ Empty <= Empty = True

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

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

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

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

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

282283

283284-- Primitives

284285

286+-- | Empty matrix constructor

287+empty :: Matrix e Void Void

288+empty = Empty

289+

285290-- | Unit matrix constructor

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

287292one = One

288293

289−-- | Matrix 'Join' constructor

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

291−join = Join

294+-- | Matrix 'Junc' constructor

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

296+junc = Junc

292297

293298infixl 3 |||

294299

295−-- | Matrix 'Join' constructor

300+-- | Matrix 'Junc' constructor

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

297−(|||) = Join

302+(|||) = Junc

298303

299−-- | Matrix 'Fork' constructor

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

301−fork = Fork

304+-- | Matrix 'Split' constructor

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

306+split = Split

302307

303308infixl 2 ===

304309

305−-- | Matrix 'Fork' constructor

310+-- | Matrix 'Split' constructor

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

307−(===) = Fork

312+(===) = Split

308313

309314-- Construction

310315

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

312317--

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

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

315−class FromLists cols rows where

320+class FromLists e cols rows where

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

317322 -- error if the dimensions do not match.

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

319324

320−instance FromLists () () where

325+instance FromLists e Void Void where

326+ fromLists [] = Empty

327+ fromLists _ = error "Wrong dimensions"

328+

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

321330 fromLists [[e]] = One e

322331 fromLists _ = error "Wrong dimensions"

323332

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

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

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

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

326335 fromLists _ = error "Wrong dimensions"

327336

328−instance {-# OVERLAPPABLE #-}

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

330− fromLists [l] =

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

338+ fromLists [l] =

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

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

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

333341 fromLists _ = error "Wrong dimensions"

334342

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

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

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

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

337345 fromLists _ = error "Wrong dimensions"

338346

339−instance {-# OVERLAPPABLE #-}

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

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

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

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

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

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

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

344351 fromLists _ = error "Wrong dimensions"

345352

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

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

353+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

348354 fromLists l@(h : t) =

349355 let lh = length h

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

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

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

352358 in if lh > 0 && condition

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

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

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

355361

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

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

358−matrixBuilder' ::

363+-- a construction function.

364+matrixBuilder ::

359365 forall e cols rows.

360− ( FL cols rows,

361− CountableDims cols rows

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

363−matrixBuilder' f =

366+ ( FromLists e cols rows,

367+ CountableDimensions cols rows

368+ ) =>

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

370+ Matrix e cols rows

371+matrixBuilder f =

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

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

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

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

368376

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−

389377-- | Constructs a column vector matrix

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

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

391379col = fromLists . map (: [])

392380

393381-- | Constructs a row vector matrix

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

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

395383row = fromLists . (: [])

396384

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

398386--

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

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

401−fromF' ::

389+fromF ::

402390 forall a b cols rows e.

403391 ( Liftable e a b,

404− CountableDims cols rows,

405− FL rows cols

392+ CountableDimensions cols rows,

393+ FromLists e rows cols

406394 ) =>

407395 (a -> b) ->

408396 Matrix e cols rows

409−fromF' f =

397+fromF f =

410398 let minA = minBound @a

411399 maxA = maxBound @a

412400 minB = minBound @b

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

416404 elementsA = take ccols [minA .. maxA]

417405 elementsB = take rrows [minB .. maxB]

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

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

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

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

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

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

422410 mList = buildList combAp rrows

423411 in tr $ fromLists mList

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

427415

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

429417-- cardinality's.

430−fromF ::

418+fromF' ::

431419 forall a b e.

432420 ( Liftable e a b,

433− CountableDimsN a b,

434− FLN b a

421+ CountableDimensionsN a b,

422+ FromListsN e b a

435423 ) =>

436424 (a -> b) ->

437425 Matrix e (Normalize a) (Normalize b)

438−fromF = fromF'

426+fromF' f =

427+ let minA = minBound @a

428+ maxA = maxBound @a

429+ minB = minBound @b

430+ maxB = maxBound @b

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

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

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

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

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

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

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

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

439+ mList = buildList combAp rrows

440+ in tr $ fromLists mList

441+ where

442+ buildList [] _ = []

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

439444

440445-- Conversion

441446

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

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

449+toLists Empty = []

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

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

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

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

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

447453

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

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

@@ -452,38 +458,37 @@ toList = concat . toLists

452458-- Zeros Matrix

453459

454460-- | 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)

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

462+zeros = matrixBuilder (const 0)

457463

458464-- Ones Matrix

459465

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

461467--

462468-- 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)

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

470+ones = matrixBuilder (const 1)

465471

466472-- Const Matrix

467473

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

469475-- value.

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

471−constant e = matrixBuilder' (const e)

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

477+constant e = matrixBuilder (const e)

472478

473479-- Bang Matrix

474480

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

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

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

477483bang =

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

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

480486

481−-- iden Matrix

487+-- Identity Matrix

482488

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 #-}

489+-- | Identity matrix.

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

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

487492

488493-- Matrix composition (MMM)

489494

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

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

493498-- from LAoP.

494499comp :: (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

499−{-# NOINLINE comp #-}

500−{-# RULES

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

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

503−#-}

504−

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)

500+comp Empty Empty = Empty

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

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

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

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

522505

523506-- Projections

524507

525508-- | 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

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

510+p1 =

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

512+ zero = zeros :: Matrix e n m

513+ in junc iden zero

528514

529515-- | 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

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

517+p2 =

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

519+ zero = zeros :: Matrix e m n

520+ in junc zero iden

532521

533522-- Injections

534523

535524-- | Biproduct first component injection

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

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

537526i1 = tr p1

538527

539528-- | Biproduct second component injection

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

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

541530i2 = tr p2

542531

543532-- Dimensions

544533

545534-- | Obtain the number of rows.

546535--

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''.

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

537+-- dimensions in constant time.

538+--

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

540+-- exchange for performance.

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

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

552543

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−

562544-- | Obtain the number of columns.

545+--

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

547+-- dimensions in constant time.

563548--

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''.

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

550+-- exchange for performance.

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

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

569553

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−

579554-- Coproduct Bifunctor

580555

581556infixl 5 -|-

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

584559(-|-) ::

585560 forall e n k m j.

586561 ( Num e,

587− CountableDims j k,

588− FL k k,

589− FL j k,

590− FL k j,

591− FL j j

562+ CountableDimensions j k,

563+ FromLists e k k,

564+ FromLists e j k,

565+ FromLists e k j,

566+ FromLists e j j

592567 ) =>

593568 Matrix e n k ->

594569 Matrix e m j ->

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

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

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

597572

598573-- Khatri Rao Product and projections

599574

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

601−fstM ::

576+kp1 ::

602577 forall e m k .

603578 ( Num e,

604− CountableDims k m,

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

579+ CountableDimensions k m,

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

606581 CountableN (m, k)

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

608−fstM = matrixBuilder' f

583+kp1 = matrixBuilder f

609584 where

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

611586 f (x, y)

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

613− | otherwise = 0

588+ | otherwise = 0

614589

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

616−sndM ::

591+kp2 ::

617592 forall e m k .

618593 ( Num e,

619− CountableDims k m,

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

594+ CountableDimensions k m,

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

621596 CountableN (m, k)

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

623−sndM = matrixBuilder' f

598+kp2 = matrixBuilder f

624599 where

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

626601 f (x, y)

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

628− | otherwise = 0

603+ | otherwise = 0

629604

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

631606--

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

633−--

608+--

634609-- @

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

636−-- kr a b ==> |

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

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

611+-- khatri a b ==> |

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

638613-- @

639614--

640615-- __Emphasis__ on the implication symbol.

641−kr ::

642− forall e cols a b.

616+khatri ::

617+ forall e cols a b.

643618 ( Num e,

644− CountableDims a b,

619+ CountableDimensions a b,

645620 CountableN (a, b),

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

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

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

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

648623 ) => 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)

624+khatri a b =

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

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

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

653628

654629-- Product Bifunctor (Kronecker)

655630

656631infixl 4 ><

657632

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

659−(><) ::

660− forall e m p n q.

634+(><) ::

635+ forall e m p n q.

661636 ( 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− )

637+ CountableDimensions m n,

638+ CountableDimensions p q,

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

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

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

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

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

644+ )

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

671646(><) a b =

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

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

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

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

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

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

675650

676−-- Matrix abide Join Fork

651+-- Matrix abide Junc Split

677652

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

679−--

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

654+--

680655-- Law:

681656--

682657-- @

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

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

684659-- @

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)

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

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

662+abideJS Empty = Empty

663+abideJS (One e) = One e

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

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

690666

691−-- Matrix abide Fork Join

667+-- Matrix abide Split Junc

692668

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

694−--

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

670+--

695671-- @

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

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

697673-- @

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)

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

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

676+abideSJ Empty = Empty

677+abideSJ (One e) = One e

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

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

703680

704681-- Matrix transposition

705682

706683-- | Matrix transposition.

707684tr :: 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)

685+tr Empty = Empty

686+tr (One e) = One e

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

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

711689

712690-- Selective 'select' operator

713691

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

715693-- 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

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

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

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

697+select m y = junc y identity . m

720698

721−branch ::

699+branch ::

722700 ( 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

701+ CountableDimensions a b,

702+ CountableDimensions c (Either b c),

703+ FromLists e c b,

704+ FromLists e a b,

705+ FromLists e a a,

706+ FromLists e b b,

707+ FromLists e c c,

708+ FromLists e b a,

709+ FromLists e b c,

710+ FromLists e (Either b c) b,

711+ FromLists e (Either b c) c

734712 )

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

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

737715 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)

716+ 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)

739717 => 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)

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

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

742720 g m = i2 . m

743721

744722-- McCarthy's Conditional

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

747725cond ::

748726 ( Trivial cols,

749727 Countable cols,

750− FL () cols,

751− FL cols (),

752− FL cols cols,

728+ FromLists e () cols,

729+ FromLists e cols (),

730+ FromLists e cols cols,

753731 Bounded a,

754732 Enum a,

755733 Num e,

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

757735 )

758736 =>

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

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

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

761739

762−grd ::

740+grd ::

763741 ( Trivial q,

764742 Countable q,

765− FL () q,

766− FL q (),

767− FL q q,

743+ FromLists e () q,

744+ FromLists e q (),

745+ FromLists e q q,

768746 Bounded a,

769747 Enum a,

770748 Num e,

@@ -772,86 +750,60 @@ grd ::

772750 )

773751 =>

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

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

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

776754

777−corr ::

778− forall e a q .

755+corr ::

756+ forall e a q .

779757 ( Trivial q,

780758 Countable q,

781− FL () q,

782− FL q (),

783− FL q q,

759+ FromLists e () q,

760+ FromLists e q (),

761+ FromLists e q q,

784762 Liftable e a Bool

785− )

763+ )

786764 => (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)

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

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

789767

790768-- Pretty print

791769

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

793771prettyAux [] _ = ""

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

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

795773 where

796774 v = fmap show m

797775 widest = maximum $ fmap length v

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

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

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

800778 where

801− v = fmap show m

802− widest = maximum $ fmap length v

779+ v = fmap show m

780+ widest = maximum $ fmap length v

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

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

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

805783 prettyAux t l

806784 where

807− v = fmap show l

808− widest = maximum $ fmap length v

785+ v = fmap show l

786+ widest = maximum $ fmap length v

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

810788

811789-- | Matrix pretty printer

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

813−pretty m = concat

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

815− , unlines

816− [ "│ " ++ unwords (fmap (\j -> fill $ show $ getElem i j m) [1..columns m]) ++ " │" | i <- [1..rows m] ]

817− , "└ ", unwords (replicate (columns m) blank), " ┘"

818− ]

819− where

820− strings = map show (toList m)

821− widest = maximum $ map length strings

790+pretty :: (Countable cols, Show e) => Matrix e cols rows -> String

791+pretty m = "┌ " ++ unwords (replicate (columns m) blank) ++ " ┐\n" ++

792+ prettyAux (toLists m) (toLists m) ++

793+ "└ " ++ unwords (replicate (columns m) blank) ++ " ┘"

794+ where

795+ v = fmap show (toList m)

796+ widest = maximum $ fmap length v

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

823− blank = fill ""

824− safeGet i j m

825− | i > rows m || j > columns m || i < 1 || j < 1 = Nothing

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

827− 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 =

830− fromMaybe

831− (error $

832− "getElem: Trying to get the "

833− ++ show (i, j)

834− ++ " element from a "

835− ++ show (rows m) ++ "x" ++ show (columns m)

836− ++ " matrix."

837− )

838− (safeGet i j m)

798+ blank = fill ""

839799

840800-- | Matrix pretty printer

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

801+prettyPrint :: (Countable cols, Show e) => Matrix e cols rows -> IO ()

842802prettyPrint = putStrLn . pretty

843803

844−-- | Zip two matrices with a given binary function

845−zipWithM :: (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

851−

852804-- Relational operators functions

853805

854−type Boolean = Natural 0 1

806+type Boolean = Natural 0 1

855807type Relation a b = Matrix Boolean a b

856808

857809-- | Helper conversion function

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

867819

868820-- | Relational negation

869821negateM :: 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)

822+negateM Empty = Empty

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

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

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

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

873827

874828-- | Relational addition

875829orM :: 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

830+orM Empty Empty = Empty

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

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

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

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

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

881836

882837-- | Relational multiplication

883838andM :: 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

839+andM Empty Empty = Empty

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

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

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

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

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

889845

890846-- | Relational subtraction

891847subM :: 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

848+subM Empty Empty = Empty

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

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

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

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

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

897854

898855-- | Matrix relational composition.

899856compRel :: 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

857+compRel Empty Empty = Empty

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

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

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

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

904862

905863-- | Matrix relational right division

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

865+divR Empty Empty = Empty

907866divR (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)

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

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

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

911870

912871-- | Matrix relational left division

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

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

923882--

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

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

926−fromFRel' ::

885+fromFRel ::

927886 forall a b cols rows.

928887 ( Liftable Boolean a b,

929− CountableDims cols rows,

930− FL rows cols

888+ CountableDimensions cols rows,

889+ FromLists Boolean rows cols

931890 ) =>

932891 (a -> b) ->

933892 Relation cols rows

934−fromFRel' = fromF'

893+fromFRel f =

894+ let minA = minBound @a

895+ maxA = maxBound @a

896+ minB = minBound @b

897+ maxB = maxBound @b

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

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

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

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

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

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

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

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

906+ mList = buildList combAp rrows

907+ in tr $ fromLists mList

908+ where

909+ buildList [] _ = []

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

935911

936912-- | Lifts functions to relations with dimensions matching @a@ and @b@

937913-- cardinality's.

938−fromFRel ::

914+fromFRel' ::

939915 forall a b.

940916 ( Liftable Boolean a b,

941− CountableDimsN a b,

942− FLN b a

917+ CountableDimensionsN a b,

918+ FromLists Boolean (Normalize b) (Normalize a)

943919 ) =>

944920 (a -> b) ->

945921 Relation (Normalize a) (Normalize b)

946−fromFRel = fromFRel'

922+fromFRel' f =

923+ let minA = minBound @a

924+ maxA = maxBound @a

925+ minB = minBound @b

926+ maxB = maxBound @b

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

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

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

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

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

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

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

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

935+ mList = buildList combAp rrows

936+ in tr $ fromLists mList

937+ where

938+ buildList [] _ = []

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

947940

948941-- | Lifts a relation function to a Boolean Matrix

949−toRel ::

942+toRel ::

950943 forall a b.

951944 ( Bounded a,

952945 Bounded b,

953946 Enum a,

954947 Enum b,

955948 Eq b,

956− CountableDims a b,

957− FLN b a

958− )

949+ CountableDimensionsN a b,

950+ FromListsN Boolean b a

951+ )

959952 => (a -> b -> Bool) -> Relation (Normalize a) (Normalize b)

960953toRel f =

961954 let minA = minBound @a

962955 maxA = maxBound @a

963956 minB = minBound @b

964957 maxB = maxBound @b

965− ccols = fromInteger $ natVal (Proxy :: Proxy (Count a))

966− rrows = fromInteger $ natVal (Proxy :: Proxy (Count b))

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

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

967960 elementsA = take ccols [minA .. maxA]

968961 elementsB = take rrows [minB .. maxB]

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

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

971− then ((fromEnum a, fromEnum b), nat 1)

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

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

972965 else ((fromEnum a, fromEnum b), nat 0)) $ combinations

973966 mList = buildList combAp rrows

974967 in tr $ fromLists mList

src/LAoP/Matrix/Nat.hs+124−139

@@ -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,16 @@ module LAoP.Matrix.Nat

108105 cond,

109106

110107 -- ** Matrix "abiding"

111− abideJF,

112− abideFJ,

113−

114− -- ** Zip Matrices

115− zipWithM,

108+ abideJS,

109+ abideSJ,

116110

117111 -- * Biproduct approach

118− -- ** Fork

112+ -- ** Split

119113 (===),

120114 -- *** Projections

121115 p1,

122116 p2,

123− -- ** Join

117+ -- ** Junc

124118 (|||),

125119 -- *** Injections

126120 i1,

@@ -134,11 +128,11 @@ module LAoP.Matrix.Nat

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

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

136130 -- *** Matrix pairing projections

137− fstM,

138− sndM,

131+ kp1,

132+ kp2,

139133

140134 -- *** Matrix pairing

141− kr,

135+ khatri,

142136

143137 -- * Matrix composition and lifting

144138

@@ -146,10 +140,10 @@ module LAoP.Matrix.Nat

146140

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

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

149− iden,

143+ identity,

150144 comp,

151− fromF',

152145 fromF,

146+ fromF',

153147

154148 -- * Matrix printing

155149 pretty,

@@ -160,34 +154,47 @@ where

160154import Data.Proxy

161155import GHC.TypeLits

162156import Control.DeepSeq

157+import qualified Control.Category as C

163158import qualified LAoP.Matrix.Internal as I

164159

165160newtype Matrix e (cols :: Nat) (rows :: Nat) = M (I.Matrix e (I.FromNat cols) (I.FromNat rows))

166161 deriving (Show, Num, Eq, Ord, NFData) via (I.Matrix e (I.FromNat cols) (I.FromNat rows))

167162

168163-- | 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))

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

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

166+type CountableN a = KnownNat (I.Count (I.FromNat a))

167+type CountableNz a = KnownNat (I.Count (I.Normalize a))

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

169+type FromListsN e a b = I.FromLists e (I.FromNat a) (I.FromNat b)

170+type FromListsNz e a b = I.FromLists e (I.Normalize a) (I.Normalize b)

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

172+type TrivialE a b = I.FromNat (a + b) ~ Either (I.FromNat a) (I.FromNat b)

173+type TrivialP a b = I.FromNat (a * b) ~ I.FromNat (I.Count (I.FromNat a) * I.Count (I.FromNat b))

174+

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

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

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

178+--

179+-- Please use 'identity' instead.

180+instance (Num e) => C.Category (Matrix e) where

181+ id = undefined

182+ (.) = comp

179183

180184-- Primitives

181185

186+empty :: Matrix e 0 0

187+empty = M I.Empty

188+

182189one :: e -> Matrix e 1 1

183190one = M . I.One

184191

185−join ::

192+junc ::

186193 (TrivialE a b) =>

187194 Matrix e a rows ->

188195 Matrix e b rows ->

189196 Matrix e (a + b) rows

190−join (M a) (M b) = M (I.Join a b)

197+junc (M a) (M b) = M (I.Junc a b)

191198

192199infixl 3 |||

193200(|||) ::

@@ -195,14 +202,14 @@ infixl 3 |||

195202 Matrix e a rows ->

196203 Matrix e b rows ->

197204 Matrix e (a + b) rows

198−(|||) = join

205+(|||) = junc

199206

200−fork ::

207+split ::

201208 (TrivialE a b) =>

202209 Matrix e cols a ->

203210 Matrix e cols b ->

204211 Matrix e cols (a + b)

205−fork (M a) (M b) = M (I.Fork a b)

212+split (M a) (M b) = M (I.Split a b)

206213

207214infixl 2 ===

208215(===) ::

@@ -210,45 +217,43 @@ infixl 2 ===

210217 Matrix e cols a ->

211218 Matrix e cols b ->

212219 Matrix e cols (a + b)

213−(===) = fork

220+(===) = split

214221

215222-- Construction

216223

217−fromLists :: (FLN e cols rows) => [[e]] -> Matrix e cols rows

224+fromLists :: (FromListsN e cols rows) => [[e]] -> Matrix e cols rows

218225fromLists = M . I.fromLists

219226

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)

227+matrixBuilder ::

228+ (FromListsN e cols rows, CountableN cols, CountableN rows)

224229 => ((Int, Int) -> e) -> Matrix e cols rows

225−matrixBuilder' = M . I.matrixBuilder'

230+matrixBuilder = M . I.matrixBuilder

226231

227−col :: (I.FL () (I.FromNat rows)) => [e] -> Matrix e 1 rows

232+col :: (I.FromLists e () (I.FromNat rows)) => [e] -> Matrix e 1 rows

228233col = M . I.col

229234

230−row :: (I.FL (I.FromNat cols) ()) => [e] -> Matrix e cols 1

235+row :: (I.FromLists e (I.FromNat cols) ()) => [e] -> Matrix e cols 1

231236row = M . I.row

232237

233−fromF' ::

238+fromF ::

234239 ( Liftable e a b,

235240 CountableN cols,

236241 CountableN rows,

237− FLN e rows cols

242+ FromListsN e rows cols

238243 ) =>

239244 (a -> b) ->

240245 Matrix e cols rows

241−fromF' = M . I.fromF'

246+fromF = M . I.fromF

242247

243−fromF ::

248+fromF' ::

244249 ( Liftable e a b,

245250 CountableNz a,

246251 CountableNz b,

247− FLNz e b a

252+ FromListsNz e b a

248253 ) =>

249254 (a -> b) ->

250255 Matrix e (I.Count a) (I.Count b)

251−fromF = undefined -- M . I.fromF

256+fromF' = undefined -- M . I.fromF'

252257

253258-- Conversion

254259

@@ -261,21 +266,21 @@ toList (M m) = I.toList m

261266-- Zeros Matrix

262267

263268zeros ::

264− (Num e, FLN e cols rows, CountableN cols, CountableN rows) =>

269+ (Num e, FromListsN e cols rows, CountableN cols, CountableN rows) =>

265270 Matrix e cols rows

266271zeros = M I.zeros

267272

268273-- Ones Matrix

269274

270275ones ::

271− (Num e, FLN e cols rows, CountableN cols, CountableN rows) =>

276+ (Num e, FromListsN e cols rows, CountableN cols, CountableN rows) =>

272277 Matrix e cols rows

273278ones = M I.ones

274279

275280-- Const Matrix

276281

277282constant ::

278− (Num e, FLN e cols rows, CountableN cols, CountableN rows) =>

283+ (Num e, FromListsN e cols rows, CountableN cols, CountableN rows) =>

279284 e ->

280285 Matrix e cols rows

281286constant = M . I.constant

@@ -284,41 +289,27 @@ constant = M . I.constant

284289

285290bang ::

286291 forall e cols.

287− (Num e, Enum e, I.FL (I.FromNat cols) (), CountableN cols) =>

292+ (Num e, Enum e, I.FromLists e (I.FromNat cols) (), CountableN cols) =>

288293 Matrix e cols 1

289294bang = M I.bang

290295

291−-- iden Matrix

296+-- Identity Matrix

292297

293−iden ::

294− (Num e, FLN e cols cols, CountableN cols) =>

298+identity ::

299+ (Num e, FromListsN e cols cols, CountableN cols) =>

295300 Matrix e cols cols

296−iden = M I.iden

301+identity = M I.identity

297302

298303-- Matrix composition (MMM)

299304

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

301306comp (M a) (M b) = M (I.comp a b)

302307

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−

317308p1 ::

318309 ( Num e,

319− CountableDimsN n m,

320− FLN e n m,

321− FLN e m m,

310+ CountableDimensionsN n m,

311+ FromListsN e n m,

312+ FromListsN e m m,

322313 TrivialE m n

323314 ) =>

324315 Matrix e (m + n) m

@@ -326,9 +317,9 @@ p1 = M I.p1

326317

327318p2 ::

328319 ( Num e,

329− CountableDimsN n m,

330− FLN e m n,

331− FLN e n n,

320+ CountableDimensionsN n m,

321+ FromListsN e m n,

322+ FromListsN e n n,

332323 TrivialE m n

333324 ) =>

334325 Matrix e (m + n) n

@@ -338,9 +329,9 @@ p2 = M I.p2

338329

339330i1 ::

340331 ( Num e,

341− CountableDimsN n rows,

342− FLN e n rows,

343− FLN e rows rows,

332+ CountableDimensionsN n rows,

333+ FromListsN e n rows,

334+ FromListsN e rows rows,

344335 TrivialE rows n

345336 ) =>

346337 Matrix e rows (rows + n)

@@ -348,9 +339,9 @@ i1 = tr p1

348339

349340i2 ::

350341 ( Num e,

351− CountableDimsN rows m,

352− FLN e m rows,

353− FLN e rows rows,

342+ CountableDimensionsN rows m,

343+ FromListsN e m rows,

344+ FromListsN e rows rows,

354345 TrivialE m rows

355346 ) =>

356347 Matrix e rows (m + rows)

@@ -364,16 +355,16 @@ rows (M m) = I.rows m

364355columns :: (CountableN cols) => Matrix e cols rows -> Int

365356columns (M m) = I.columns m

366357

358+-- | Coproduct Bifunctor

367359infixl 5 -|-

368360

369−-- | Coproduct Bifunctor (Direct sum)

370361(-|-) ::

371362 ( 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,

363+ CountableDimensionsN j k,

364+ FromListsN e k k,

365+ FromListsN e j k,

366+ FromListsN e k j,

367+ FromListsN e j j,

377368 TrivialE n m,

378369 TrivialE k j

379370 ) =>

@@ -382,42 +373,40 @@ infixl 5 -|-

382373 Matrix e (n + m) (k + j)

383374(-|-) (M a) (M b) = M ((I.-|-) a b)

384375

385−-- | Khatri Rao Product first projection

386−fstM ::

376+-- | Khatri Rao Product and projections

377+kp1 ::

387378 forall e m k .

388379 ( Num e,

389− CountableDimsN m k,

380+ CountableDimensionsN m k,

390381 CountableN (m * k),

391− FLN e (m * k) m,

382+ FromListsN e (m * k) m,

392383 TrivialP m k

393384 ) => Matrix e (m * k) m

394−fstM = M (I.fstM @e @(I.FromNat m) @(I.FromNat k))

385+kp1 = M (I.kp1 @e @(I.FromNat m) @(I.FromNat k))

395386

396−-- | Khatri Rao Product second projection

397−sndM ::

387+kp2 ::

398388 forall e m k.

399389 ( Num e,

400− CountableDimsN k m,

401− FLN e (m * k) k,

390+ CountableDimensionsN k m,

391+ FromListsN e (m * k) k,

402392 CountableN (m * k),

403393 TrivialP m k

404394 ) => Matrix e (m * k) k

405−sndM = M (I.sndM @e @(I.FromNat m) @(I.FromNat k))

395+kp2 = M (I.kp2 @e @(I.FromNat m) @(I.FromNat k))

406396

407−-- | Khatri Rao Product

408−kr ::

397+khatri ::

409398 forall e cols a b.

410399 ( Num e,

411− CountableDimsN a b,

400+ CountableDimensionsN a b,

412401 CountableN (a * b),

413− FLN e (a * b) a,

414− FLN e (a * b) b,

402+ FromListsN e (a * b) a,

403+ FromListsN e (a * b) b,

415404 TrivialP a b

416405 ) => 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

406+khatri a b =

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

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

409+ in comp (tr kp1') a * comp (tr kp2') b

421410

422411-- | Product Bifunctor (Kronecker)

423412infixl 4 ><

@@ -425,28 +414,28 @@ infixl 4 ><

425414(><) ::

426415 forall e m p n q.

427416 ( 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,

417+ CountableDimensionsN m n,

418+ CountableDimensionsN p q,

419+ CountableDimensionsN (m * n) (p * q),

420+ FromListsN e (m * n) m,

421+ FromListsN e (m * n) n,

422+ FromListsN e (p * q) p,

423+ FromListsN e (p * q) q,

435424 TrivialP m n,

436425 TrivialP p q

437426 ) => Matrix e m p -> Matrix e n q -> Matrix e (m * n) (p * q)

438427(><) a b =

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

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

441− in kr (comp a fstM') (comp b sndM')

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

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

430+ in khatri (comp a kp1') (comp b kp2')

442431

443−-- | Matrix abide Join Fork

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

445−abideJF (M m) = M (I.abideJF m)

432+-- | Matrix abide Junc Split

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

434+abideJS (M m) = M (I.abideJS m)

446435

447−-- | Matrix abide Fork Join

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

449−abideFJ (M m) = M (I.abideFJ m)

436+-- | Matrix abide Split Junc

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

438+abideSJ (M m) = M (I.abideSJ m)

450439

451440-- | Matrix transposition

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

@@ -455,7 +444,7 @@ tr (M m) = M (I.tr m)

455444-- Selective 'select' operator

456445select ::

457446 ( Num e,

458− FLN e rows1 rows1,

447+ FromListsN e rows1 rows1,

459448 CountableN rows1,

460449 I.FromNat rows2 ~ I.FromNat rows1,

461450 I.FromNat cols1 ~ I.FromNat cols2,

@@ -468,9 +457,9 @@ select (M m) (M y) = M (I.select m y)

468457cond ::

469458 ( I.FromNat (I.Count (I.FromNat cols)) ~ I.FromNat cols,

470459 CountableN cols,

471− I.FL () (I.FromNat cols),

472− I.FL (I.FromNat cols) (),

473− FLN e cols cols,

460+ I.FromLists e () (I.FromNat cols),

461+ I.FromLists e (I.FromNat cols) (),

462+ FromListsN e cols cols,

474463 Liftable e a Bool

475464 )

476465 =>

@@ -479,12 +468,8 @@ cond p (M a) (M b) = M (I.cond p a b)

479468

480469-- Pretty print

481470

482−pretty :: (CountableDimsN cols rows, Show e) => Matrix e cols rows -> String

471+pretty :: (CountableN cols, Show e) => Matrix e cols rows -> String

483472pretty (M m) = I.pretty m

484473

485−prettyPrint :: (CountableDimsN cols rows, Show e) => Matrix e cols rows -> IO ()

474+prettyPrint :: (CountableN cols, Show e) => Matrix e cols rows -> IO ()

486475prettyPrint (M m) = I.prettyPrint m

487−

488−-- | Zip two matrices with a given binary function

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

490−zipWithM f (M a) (M b) = M (I.zipWithM f a b)

src/LAoP/Matrix/Type.hs+171−233

@@ -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,

@@ -97,15 +97,14 @@ module LAoP.Matrix.Type

9797

9898 -- * Functor instance equivalent function

9999 fmapM,

100− bimapM,

101100

102101 -- * Applicative/Monoidal instance equivalent functions

103102 unitM,

104103 multM,

105104

106105 -- * Selective equivalent instance function

107− selectM,

108−

106+ selectM,

107+

109108 -- * Monad equivalent instance function

110109 returnM,

111110 bindM,

@@ -113,34 +112,25 @@ module LAoP.Matrix.Type

113112 -- * Misc

114113 -- ** Get dimensions

115114 columns,

116− columns',

117115 rows,

118− rows',

119116

120117 -- ** Matrix Transposition

121118 tr,

122119

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

124− (.|),

125− (./),

126−

127120 -- ** McCarthy's Conditional

128121 cond,

129122

130123 -- ** Matrix "abiding"

131− abideJF,

132− abideFJ,

133−

134− -- ** Zip Matrices

135− zipWithM,

124+ abideJS,

125+ abideSJ,

136126

137127 -- * Biproduct approach

138− -- ** Fork

128+ -- ** Split

139129 (===),

140130 -- *** Projections

141131 p1,

142132 p2,

143− -- ** Join

133+ -- ** Junc

144134 (|||),

145135 -- *** Injections

146136 i1,

@@ -154,11 +144,11 @@ module LAoP.Matrix.Type

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

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

156146 -- *** Matrix pairing projections

157− fstM,

158− sndM,

147+ kp1,

148+ kp2,

159149

160150 -- *** Matrix pairing

161− kr,

151+ khatri,

162152

163153 -- * Matrix composition and lifting

164154

@@ -166,10 +156,10 @@ module LAoP.Matrix.Type

166156

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

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

169− iden,

159+ identity,

170160 comp,

171− fromF',

172161 fromF,

162+ fromF',

173163

174164 -- * Relation

175165 toRel,

@@ -183,44 +173,35 @@ where

183173import Data.Void

184174import Data.Proxy

185175import Data.Kind

186−import GHC.TypeLits

176+import GHC.TypeLits

187177import Control.DeepSeq

188178import LAoP.Utils

179+import qualified Control.Category as C

189180import qualified LAoP.Matrix.Internal as I

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

191181

192182newtype Matrix e (cols :: Type) (rows :: Type) = M (I.Matrix e (I.Normalize cols) (I.Normalize rows))

193183 deriving (Show, Num, Eq, Ord, NFData) via (I.Matrix e (I.Normalize cols) (I.Normalize rows))

194184

195185-- | 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

213−

214−-- | Bifunctor equivalent function

215−bimapM ::

216− ( Liftable e a b,

217− Liftable e c d,

218− CountableDimsN a c,

219− CountableDimsN b d,

220− FLN d c,

221− FLN b a

222− ) => (a -> b) -> (c -> d) -> Matrix e a c -> Matrix e b d

223−bimapM f g m = fromF g . m . tr (fromF f)

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

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

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

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

190+type FromListsN e a b = I.FromLists e (I.Normalize a) (I.Normalize b)

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

192+type Trivial a = I.Normalize (I.Normalize a) ~ I.Normalize (I.Normalize (I.Normalize a))

193+type Trivial2 a = I.Normalize a ~ I.Normalize (I.Normalize a)

194+type Trivial3 a = I.FromNat (I.Count (I.Normalize (I.Normalize a))) ~ I.Normalize (I.Normalize a)

195+type TrivialP a b = I.Normalize (a, b) ~ I.Normalize (I.Normalize a, I.Normalize b)

196+

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

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

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

200+--

201+-- Please use 'identity' instead.

202+instance (Num e) => C.Category (Matrix e) where

203+ id = undefined

204+ (.) = comp

224205

225206-- | Zero type alias

226207type Zero = Void

@@ -230,74 +211,78 @@ type One = ()

230211

231212-- Primitives

232213

214+-- | Empty matrix constructor

215+empty :: Matrix e Zero Zero

216+empty = M I.Empty

217+

233218-- | Unit matrix constructor

234219one :: e -> Matrix e One One

235220one = M . I.One

236221

237−-- | Matrix 'Join' constructor

238−join ::

222+-- | Matrix 'Junc' constructor

223+junc ::

239224 Matrix e a rows ->

240225 Matrix e b rows ->

241226 Matrix e (Either a b) rows

242−join (M a) (M b) = M (I.Join a b)

227+junc (M a) (M b) = M (I.Junc a b)

243228

244229infixl 3 |||

245−-- | Matrix 'Join' constructor

230+-- | Matrix 'Junc' constructor

246231(|||) ::

247232 Matrix e a rows ->

248233 Matrix e b rows ->

249234 Matrix e (Either a b) rows

250−(|||) = join

235+(|||) = junc

251236

252−-- | Matrix 'Fork' constructor

253−fork ::

237+-- | Matrix 'Split' constructor

238+split ::

254239 Matrix e cols a ->

255240 Matrix e cols b ->

256241 Matrix e cols (Either a b)

257−fork (M a) (M b) = M (I.Fork a b)

242+split (M a) (M b) = M (I.Split a b)

258243

259244infixl 2 ===

260−-- | Matrix 'Fork' constructor

245+-- | Matrix 'Split' constructor

261246(===) ::

262247 Matrix e cols a ->

263248 Matrix e cols b ->

264249 Matrix e cols (Either a b)

265−(===) = fork

250+(===) = split

266251

267252-- Functor hierarchy

268253

269254-- | Functor instance equivalent function

270−fmapM ::

255+fmapM ::

271256 ( Liftable e a b,

272− CountableDimsN a b,

273− FLN b a

257+ CountableDimensionsN a b,

258+ FromListsN e b a

274259 )

275260 =>

276261 (a -> b) -> Matrix e c a -> Matrix e c b

277−fmapM f m = fromF f . m

262+fmapM f m = fromF' f `comp` m

278263

279264-- | Applicative instance equivalent 'unit' function,

280265unitM :: (Num e) => Matrix e () ()

281266unitM = one 1

282267

283268-- | Applicative instance equivalent 'unit' function,

284−multM ::

285− ( CountableDimsN a b,

269+multM ::

270+ ( CountableDimensionsN a b,

286271 CountableN (a, b),

287272 Num e,

288− FLN (a, b) a,

289− FLN (a, b) b,

273+ FromListsN e (a, b) a,

274+ FromListsN e (a, b) b,

290275 TrivialP a b

291276 ) => Matrix e c a -> Matrix e c b -> Matrix e c (a, b)

292−multM = kr

277+multM = khatri

293278

294279-- | Monad instance equivalent 'return' function,

295−returnM ::

296− forall e a .

280+returnM ::

281+ forall e a .

297282 ( Num e,

298283 Enum e,

299284 Enum a,

300− FLN () a,

285+ FromListsN e () a,

301286 Countable a

302287 ) => a -> Matrix e One a

303288returnM a = col l

@@ -314,64 +299,51 @@ bindM = flip comp

314299

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

316301-- error if the dimensions do not match.

317−fromLists :: (FLN cols rows) => [[e]] -> Matrix e cols rows

302+fromLists :: (FromListsN e cols rows) => [[e]] -> Matrix e cols rows

318303fromLists = M . I.fromLists

319304

320305-- | 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.

306+-- a construction function.

329307matrixBuilder ::

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)

308+ (FromListsN e cols rows, CountableDimensionsN cols rows )

309+ => ((Int, Int) -> e) -> Matrix e cols rows

310+matrixBuilder = M . I.matrixBuilder

339311

340312-- | Constructs a column vector matrix

341−col :: (FLN () rows) => [e] -> Matrix e One rows

313+col :: (FromListsN e () rows) => [e] -> Matrix e One rows

342314col = M . I.col

343315

344316-- | Constructs a row vector matrix

345−row :: (FLN cols ()) => [e] -> Matrix e cols One

317+row :: (FromListsN e cols ()) => [e] -> Matrix e cols One

346318row = M . I.row

347319

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

349321--

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

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

352−fromF' ::

324+fromF ::

353325 ( Liftable e a b,

354− CountableDimsN cols rows,

355− FLN rows cols

326+ CountableDimensionsN cols rows,

327+ FromListsN e rows cols

356328 ) =>

357329 (a -> b) -> Matrix e cols rows

358−fromF' = M . I.fromF'

330+fromF = M . I.fromF

359331

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

361333-- cardinality's.

362−fromF ::

334+fromF' ::

363335 ( Liftable e a b,

364− CountableDimsN a b,

365− FLN b a

336+ CountableDimensionsN a b,

337+ FromListsN e b a

366338 ) =>

367339 (a -> b) -> Matrix e a b

368−fromF = M . I.fromF

340+fromF' = M . I.fromF'

369341

370342-- | Lifts relation functions to Boolean Matrix

371343toRel ::

372344 ( Liftable (Natural 0 1) a b,

373− CountableDims a b,

374− FLN b a

345+ CountableDimensionsN a b,

346+ FromListsN (Natural 0 1) b a

375347 ) => (a -> b -> Bool) -> Matrix (Natural 0 1) a b

376348toRel = M . I.toRel

377349

@@ -389,7 +361,7 @@ toList (M m) = I.toList m

389361

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

391363zeros ::

392− (Num e, FLN cols rows, CountableDimsN cols rows)

364+ (Num e, FromListsN e cols rows, CountableDimensionsN cols rows)

393365 => Matrix e cols rows

394366zeros = M I.zeros

395367

@@ -399,7 +371,7 @@ zeros = M I.zeros

399371--

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

401373ones ::

402− (Num e, FLN cols rows, CountableDimsN cols rows)

374+ (Num e, FromListsN e cols rows, CountableDimensionsN cols rows)

403375 => Matrix e cols rows

404376ones = M I.ones

405377

@@ -408,7 +380,7 @@ ones = M I.ones

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

409381-- value.

410382constant ::

411− (Num e, FLN cols rows, CountableDimsN cols rows)

383+ (Num e, FromListsN e cols rows, CountableDimensionsN cols rows)

412384 => e -> Matrix e cols rows

413385constant = M . I.constant

414386

@@ -417,30 +389,29 @@ constant = M . I.constant

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

418390bang ::

419391 forall e cols.

420− (Num e, Enum e, FLN cols (), CountableN cols) =>

392+ (Num e, Enum e, FromListsN e cols (), CountableN cols) =>

421393 Matrix e cols One

422394bang = M I.bang

423395

424396-- | Point constant relation

425−point ::

397+point ::

426398 ( Bounded a,

427399 Enum a,

428400 Eq a,

429401 Num e,

430402 Ord e,

431403 CountableN a,

432− FLN a One

404+ FromListsN e a One

433405 ) => a -> Matrix e One a

434−point = fromF . const

406+point = fromF' . const

435407

436−-- iden Matrix

408+-- Identity Matrix

437409

438−-- | iden matrix

439−iden ::

440− (Num e, FLN a a, CountableN a) =>

410+-- | Identity matrix

411+identity ::

412+ (Num e, FromListsN e a a, CountableN a) =>

441413 Matrix e a a

442−iden = M I.iden

443−{-# NOINLINE iden #-}

414+identity = M I.identity

444415

445416-- Matrix composition (MMM)

446417

@@ -450,32 +421,13 @@ iden = M I.iden

450421-- from LAoP.

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

452423comp (M a) (M b) = M (I.comp a b)

453−{-# NOINLINE comp #-}

454−{-# RULES

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

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

457−#-}

458−

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)

472424

473425-- | Biproduct first component projection

474426p1 ::

475427 ( Num e,

476− CountableDimsN n m,

477− FLN n m,

478− FLN m m

428+ CountableDimensionsN n m,

429+ FromListsN e n m,

430+ FromListsN e m m

479431 ) =>

480432 Matrix e (Either m n) m

481433p1 = M I.p1

@@ -483,9 +435,9 @@ p1 = M I.p1

483435-- | Biproduct second component projection

484436p2 ::

485437 ( Num e,

486− CountableDimsN n m,

487− FLN m n,

488− FLN n n

438+ CountableDimensionsN n m,

439+ FromListsN e m n,

440+ FromListsN e n n

489441 ) =>

490442 Matrix e (Either m n) n

491443p2 = M I.p2

@@ -495,9 +447,9 @@ p2 = M I.p2

495447-- | Biproduct first component injection

496448i1 ::

497449 ( Num e,

498− CountableDimsN n m,

499− FLN n m,

500− FLN m m

450+ CountableDimensionsN n m,

451+ FromListsN e n m,

452+ FromListsN e m m

501453 ) =>

502454 Matrix e m (Either m n)

503455i1 = tr p1

@@ -505,9 +457,9 @@ i1 = tr p1

505457-- | Biproduct second component injection

506458i2 ::

507459 ( Num e,

508− CountableDimsN n m,

509− FLN m n,

510− FLN n n

460+ CountableDimensionsN n m,

461+ FromListsN e m n,

462+ FromListsN e n n

511463 ) =>

512464 Matrix e n (Either m n)

513465i2 = tr p2

@@ -516,34 +468,24 @@ i2 = tr p2

516468

517469-- | Obtain the number of rows.

518470--

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''.

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

472+-- dimensions in constant time.

473+--

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

475+-- exchange for performance.

522476rows :: (CountableN rows) => Matrix e cols rows -> Int

523477rows (M m) = I.rows m

524478

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−

532479-- | Obtain the number of columns.

480+--

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

482+-- dimensions in constant time.

533483--

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''.

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

485+-- exchange for performance.

537486columns :: (CountableN cols) => Matrix e cols rows -> Int

538487columns (M m) = I.columns m

539488

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−

547489-- Coproduct Bifunctor

548490

549491infixl 5 -|-

@@ -551,11 +493,11 @@ infixl 5 -|-

551493-- | Matrix coproduct functor also known as matrix direct sum.

552494(-|-) ::

553495 ( Num e,

554− CountableDimsN j k,

555− FLN k k,

556− FLN j k,

557− FLN k j,

558− FLN j j

496+ CountableDimensionsN j k,

497+ FromListsN e k k,

498+ FromListsN e j k,

499+ FromListsN e k j,

500+ FromListsN e j j

559501 ) =>

560502 Matrix e n k ->

561503 Matrix e m j ->

@@ -565,98 +507,98 @@ infixl 5 -|-

565507-- Khatri Rao Product and projections

566508

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

568−fstM ::

510+kp1 ::

569511 forall e m k .

570512 ( Num e,

571− CountableDimsN m k,

513+ CountableDimensionsN m k,

572514 CountableN (m, k),

573− FLN (m, k) m,

515+ FromListsN e (m, k) m,

574516 TrivialP m k

575517 ) => Matrix e (m, k) m

576−fstM = M (I.fstM @e @(I.Normalize m) @(I.Normalize k))

518+kp1 = M (I.kp1 @e @(I.Normalize m) @(I.Normalize k))

577519

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

579−sndM ::

521+kp2 ::

580522 forall e m k.

581523 ( Num e,

582− CountableDimsN k m,

524+ CountableDimensionsN k m,

583525 CountableN (m, k),

584− FLN (m, k) k,

526+ FromListsN e (m, k) k,

585527 TrivialP m k

586528 ) => Matrix e (m, k) k

587−sndM = M (I.sndM @e @(I.Normalize m) @(I.Normalize k))

529+kp2 = M (I.kp2 @e @(I.Normalize m) @(I.Normalize k))

588530

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

590532--

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

592−--

534+--

593535-- @

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

595−-- kr a b ==> |

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

536+-- | kp1 `comp` khatri a b == a

537+-- khatri a b ==> |

538+-- | kp2 `comp` khatri a b == b

597539-- @

598540--

599541-- __Emphasis__ on the implication symbol.

600−kr ::

542+khatri ::

601543 forall e cols a b.

602544 ( Num e,

603− CountableDimsN a b,

545+ CountableDimensionsN a b,

604546 CountableN (a, b),

605− FLN (a, b) a,

606− FLN (a, b) b,

547+ FromListsN e (a, b) a,

548+ FromListsN e (a, b) b,

607549 TrivialP a b

608550 ) => 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

551+khatri a b =

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

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

554+ in comp (tr kp1') a * comp (tr kp2') b

613555

614556-- Product Bifunctor (Kronecker)

615557

616558infixl 4 ><

617559

618−-- | Matrix product functor also known as Kronecker product

560+-- | Matrix product functor also known as kronecker product

619561(><) ::

620562 forall e m p n q.

621563 ( 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,

564+ CountableDimensionsN m n,

565+ CountableDimensionsN p q,

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

567+ FromListsN e (m, n) m,

568+ FromListsN e (m, n) n,

569+ FromListsN e (p, q) p,

570+ FromListsN e (p, q) q,

629571 TrivialP m n,

630572 TrivialP p q

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

632574(><) a b =

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

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

635− in kr (comp a fstM') (comp b sndM')

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

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

577+ in khatri (comp a kp1') (comp b kp2')

636578

637−-- Matrix abide Join Fork

579+-- Matrix abide Junc Split

638580

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

640−--

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

582+--

641583-- Law:

642584--

643585-- @

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

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

645587-- @

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

647−abideJF (M m) = M (I.abideJF m)

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

589+abideJS (M m) = M (I.abideJS m)

648590

649−-- Matrix abide Fork Join

591+-- Matrix abide Split Junc

650592

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

652−--

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

594+--

653595-- Law:

654596--

655597-- @

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

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

657599-- @

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

659−abideFJ (M m) = M (I.abideFJ m)

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

601+abideSJ (M m) = M (I.abideSJ m)

660602

661603-- Matrix transposition

662604

@@ -668,9 +610,9 @@ tr (M m) = M (I.tr m)

668610

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

670612-- ArrowMonad solution presented in the paper.

671−selectM ::

613+selectM ::

672614 ( Num e,

673− FLN b b,

615+ FromListsN e b b,

674616 CountableN b

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

676618selectM (M m) (M y) = M (I.select m y)

@@ -683,9 +625,9 @@ cond ::

683625 Trivial2 a,

684626 Trivial3 a,

685627 CountableN a,

686− FLN () a,

687− FLN a (),

688− FLN a a,

628+ FromListsN e () a,

629+ FromListsN e a (),

630+ FromListsN e a a,

689631 Liftable e a Bool

690632 )

691633 =>

@@ -695,13 +637,9 @@ cond p (M a) (M b) = M (I.cond p a b)

695637-- Pretty print

696638

697639-- | Matrix pretty printer

698−pretty :: (CountableDimsN cols rows, Show e) => Matrix e cols rows -> String

640+pretty :: (CountableN cols, Show e) => Matrix e cols rows -> String

699641pretty (M m) = I.pretty m

700642

701643-- | Matrix pretty printer

702−prettyPrint :: (CountableDimsN cols rows, Show e) => Matrix e cols rows -> IO ()

644+prettyPrint :: (CountableN cols, Show e) => Matrix e cols rows -> IO ()

703645prettyPrint (M m) = I.prettyPrint m

704−

705−-- | Zip two matrices with a given binary function

706−zipWithM :: (e -> f -> g) -> Matrix e a b -> Matrix f a b -> Matrix g a b

707−zipWithM f (M a) (M b) = M (I.zipWithM f a b)

src/LAoP/Relation.hs+11−8

@@ -32,19 +32,22 @@ 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,

41+ TrivialE,

4142 TrivialP,

43+ TrivialP2,

4244

4345 -- * Primitives

46+ empty,

4447 one,

45− join,

48+ junc,

4649 (|||),

47− fork,

50+ split,

4851 (===),

4952

5053 -- * Auxiliary type families

@@ -107,8 +110,8 @@ module LAoP.Relation

107110 splitR,

108111

109112 -- ** Projections

110− fstR,

111− sndR,

113+ p1,

114+ p2,

112115 -- ** Bifunctor

113116 (><),

114117 -- * Relational coproduct

@@ -147,7 +150,7 @@ module LAoP.Relation

147150 cond,

148151

149152 -- * Relational composition and lifting

150− iden,

153+ identity,

151154 comp,

152155 fromF,

153156 fromF',

src/LAoP/Relation/Internal.hs+254−250

@@ -1,4 +1,3 @@

1−{-# LANGUAGE TypeFamilies #-}

21{-# LANGUAGE ConstraintKinds #-}

32{-# LANGUAGE GADTs #-}

43{-# LANGUAGE UndecidableInstances #-}

@@ -43,19 +42,22 @@ 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,

51+ TrivialE,

5252 TrivialP,

53+ TrivialP2,

5354

5455 -- * Primitives

56+ empty,

5557 one,

56− join,

58+ junc,

5759 (|||),

58− fork,

60+ split,

5961 (===),

6062

6163 -- * Auxiliary type families

@@ -66,15 +68,14 @@ module LAoP.Relation.Internal

6668 -- * Matrix construction and conversion

6769 I.FromLists,

6870 fromLists,

69− fromF',

7071 fromF,

72+ fromF',

7173 toRel,

7274 toLists,

7375 toList,

7476 toBool,

7577 pt,

7678 belongs,

77− relationBuilder',

7879 relationBuilder,

7980 zeros,

8081 ones,

@@ -119,8 +120,8 @@ module LAoP.Relation.Internal

119120 splitR,

120121

121122 -- ** Projections

122− fstR,

123− sndR,

123+ p1,

124+ p2,

124125 -- ** Bifunctor

125126 (><),

126127 -- * Relational coproduct

@@ -159,10 +160,10 @@ module LAoP.Relation.Internal

159160 cond,

160161

161162 -- * Relational composition and lifting

162− iden,

163+ identity,

163164 comp,

164− fromF',

165165 fromF,

166+ fromF',

166167

167168 -- ** Relational application

168169 pointAp,

@@ -178,9 +179,9 @@ import Data.Void

178179import qualified LAoP.Matrix.Internal as I

179180import LAoP.Utils.Internal

180181import Control.DeepSeq

182+import qualified Control.Category as C

181183import Data.Bool

182184import GHC.TypeLits

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

184185

185186-- | Boolean type synonym for working with boolean matrices

186187type Boolean = Natural 0 1

@@ -193,30 +194,34 @@ newtype Relation a b = R (I.Matrix Boolean (I.Normalize a) (I.Normalize b))

193194deriving instance (Read (I.Matrix Boolean (I.Normalize a) (I.Normalize b))) => Read (Relation a b)

194195

195196-- | 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

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

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

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

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

201+type FromListsN a b = I.FromLists Boolean (I.Normalize a) (I.Normalize b)

202+type Liftable a b = (Bounded a, Bounded b, Enum a, Enum b, Eq b, Num Boolean, Ord Boolean)

203+type Trivial a = I.Normalize a ~ I.Normalize (I.Normalize a)

204+type TrivialE a b = I.Normalize (Either a b) ~ Either (I.Normalize a) (I.Normalize b)

205+type TrivialP a b = I.Normalize (a, b) ~ I.Normalize (I.Normalize a, I.Normalize b)

206+type TrivialP2 a b = I.Normalize (I.Normalize a, I.Normalize b) ~ I.Normalize (I.Normalize (a, b))

207+

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

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

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

211+--

212+-- Please use 'identity' instead.

213+instance C.Category Relation where

214+ id = undefined

215+ (.) = comp

211216

212217instance Num (Relation a b) where

213− -- | Matrix addition becomes Boolean matrix disjointion

218+ -- | Matrix addition becomes Boolean matrix disjunction

214219 (R a) + (R b) = R (I.orM a b)

215220

216221 -- | Matrix subtraction becomes Relational subtraction

217222 (R a) - (R b) = R (I.subM a b)

218223

219− -- | Matrix multiplication becomes Boolean matrix conjointion

224+ -- | Matrix multiplication becomes Boolean matrix conjunction

220225 (R a) * (R b) = R (I.andM a b)

221226

222227 -- | Matrix negation becomes Boolean matrix negation

@@ -228,92 +233,87 @@ type One = ()

228233

229234-- Primitives

230235

236+-- | Empty matrix constructor

237+empty :: Relation Zero Zero

238+empty = R I.Empty

239+

231240-- | Unit matrix constructor

232241one :: Boolean -> Relation One One

233242one = R . I.One

234243

235−-- | Boolean Matrix 'Join' constructor, also known as relational coproduct.

244+-- | Boolean Matrix 'Junc' constructor, also known as relational coproduct.

236245--

237246-- 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)

247+junc :: (TrivialE a b)

248+ => Relation a c -> Relation b c -> Relation (Either a b) c

249+junc (R a) (R b) = R (I.Junc a b)

240250

241251infixl 3 |||

242−-- | Boolean Matrix 'Join' constructor

252+-- | Boolean Matrix 'Junc' constructor

243253--

244254-- See 'eitherR'.

245255(|||) ::

256+ (TrivialE a b) =>

246257 Relation a c ->

247258 Relation b c ->

248259 Relation (Either a b) c

249−(|||) = join

260+(|||) = junc

250261

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)

262+-- | Boolean Matrix 'Split' constructor, also known as relational product.

263+split :: (TrivialE a b)

264+ => Relation c a -> Relation c b -> Relation c (Either a b)

265+split (R a) (R b) = R (I.Split a b)

254266

255267infixl 2 ===

256−-- | Boolean Matrix 'Fork' constructor

268+-- | Boolean Matrix 'Split' constructor

257269(===) ::

270+ (TrivialE a b) =>

258271 Relation c a ->

259272 Relation c b ->

260273 Relation c (Either a b)

261−(===) = fork

274+(===) = split

262275

263276-- Construction

264277

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

266279-- error if the dimensions do not match.

267−fromLists :: (FLN a b) => [[Boolean]] -> Relation a b

280+fromLists :: (FromListsN a b) => [[Boolean]] -> Relation a b

268281fromLists = R . I.fromLists

269282

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.

283+-- | Matrix builder function. Constructs a matrix provided with

284+-- a construction function.

279285relationBuilder ::

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

286+ (FromListsN a b, CountableDimensionsN a b) =>

287+ ((Int, Int) -> Boolean) -> Relation a b

288288relationBuilder = R . I.matrixBuilder

289289

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

291291--

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

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

294−fromF' ::

294+fromF ::

295295 ( Liftable a b,

296− CountableDimsN c d,

297− FLN d c

296+ CountableDimensionsN c d,

297+ FromListsN d c

298298 )

299299 => (a -> b) -> Relation c d

300−fromF' f = R (I.fromFRel' f)

300+fromF f = R (I.fromFRel f)

301301

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

303303-- cardinality's.

304−fromF ::

304+fromF' ::

305305 ( Liftable a b,

306− CountableDimsN a b,

307− FLN b a

306+ CountableDimensionsN a b,

307+ FromListsN b a

308308 )

309309 => (a -> b) -> Relation a b

310−fromF f = R (I.fromFRel f)

310+fromF' f = R (I.fromFRel' f)

311311

312312-- | Lifts relation functions to 'Relation'

313313toRel ::

314314 ( Liftable a b,

315− CountableDims a b,

316− FLN b a

315+ CountableDimensionsN a b,

316+ FromListsN b a

317317 )

318318 => (a -> b -> Bool) -> Relation a b

319319toRel = R . I.toRel

@@ -322,9 +322,9 @@ toRel = R . I.toRel

322322fromRel ::

323323 ( Liftable a b,

324324 Eq a,

325− CountableDimsN a b,

326− FLN a One,

327− FLN b One

325+ CountableDimensionsN a b,

326+ FromListsN a One,

327+ FromListsN b One

328328 )

329329 => Relation a b -> (a -> b -> Bool)

330330fromRel r a b = pointApBool a b r

@@ -348,12 +348,12 @@ toBool r = case toList r of

348348-- | Power transpose.

349349--

350350-- Maps a relation to a set valued function.

351−pt ::

351+pt ::

352352 ( Liftable a b,

353353 Eq a,

354− CountableDimsN a b,

355− FLN a One,

356− FLN b One

354+ CountableDimensionsN a b,

355+ FromListsN a One,

356+ FromListsN b One

357357 )

358358 => Relation a b -> (a -> List b)

359359pt r a =

@@ -365,8 +365,8 @@ belongs ::

365365 ( Bounded a,

366366 Enum a,

367367 Eq a,

368− CountableDims (List a) a,

369− FLN a (List a)

368+ CountableDimensionsN (List a) a,

369+ FromListsN a (List a)

370370 )

371371 => Relation (List a) a

372372belongs = toRel elemR

@@ -378,16 +378,16 @@ belongs = toRel elemR

378378-- | The zero relation. A relation where no element of type @a@ relates

379379-- with elements of type @b@.

380380--

381−-- Also known as ⊥ (Bottom) Relation.

381+-- Also known as ⊥ (Bottom) Relation or empty Relation.

382382--

383383-- @

384−-- r `.` ⊥ == ⊥ `.` r == ⊥

384+-- r ``comp`` ⊥ == ⊥ ``comp`` r == ⊥

385385-- ⊥ ``sse`` R && R ``sse`` T == True

386386-- @

387387zeros ::

388− (FLN a b, CountableDimsN a b) =>

388+ (FromListsN a b, CountableDimensionsN a b) =>

389389 Relation a b

390−zeros = relationBuilder' (const (nat 0))

390+zeros = relationBuilder (const (nat 0))

391391

392392-- Ones Matrix

393393

@@ -400,43 +400,43 @@ zeros = relationBuilder' (const (nat 0))

400400-- ⊥ ``sse`` R && R ``sse`` T == True

401401-- @

402402ones ::

403− (FLN a b, CountableDimsN a b) =>

403+ (FromListsN a b, CountableDimensionsN a b) =>

404404 Relation a b

405−ones = relationBuilder' (const (nat 1))

405+ones = relationBuilder (const (nat 1))

406406

407407-- Bang Matrix

408408

409409-- | The T (Top) row vector relation.

410410bang ::

411− (FLN a One, CountableN a) =>

411+ (FromListsN a One, CountableN a) =>

412412 Relation a One

413413bang = ones

414414

415415-- | Point constant relation

416−point ::

416+point ::

417417 ( Bounded a,

418418 Enum a,

419419 Eq a,

420420 CountableN a,

421− FLN a One

421+ FromListsN a One

422422 ) => a -> Relation One a

423−point = fromF . const

423+point = fromF' . const

424424

425−-- iden Matrix

425+-- Identity Matrix

426426

427−-- | iden matrix

427+-- | Identity matrix

428428--

429429-- @

430−-- 'iden' `.` r == r == r `.` 'iden'

430+-- 'identity' ``comp`` r == r == r ``comp`` 'identity'

431431-- @

432−iden ::

433− (FLN a a, CountableN a) => Relation a a

434−iden = relationBuilder' (bool (nat 0) (nat 1) . uncurry (==))

432+identity ::

433+ (FromListsN a a, CountableN a) => Relation a a

434+identity = relationBuilder (bool (nat 0) (nat 1) . uncurry (==))

435435

436436-- | Relational composition

437437--

438438-- @

439−-- r `.` (s `.` p) = (r `.` s) `.` p

439+-- r ``comp`` (s ``comp`` p) = (r ``comp`` s) ``comp`` p

440440-- @

441441comp :: Relation b c -> Relation a b -> Relation a c

442442comp (R a) (R b) = R (I.compRel a b)

@@ -484,7 +484,7 @@ shrunkBy r s = r `intersection` divR s (conv r)

484484-- r ``overriddenBy`` r == r

485485-- @

486486overriddenBy ::

487− ( FLN b b,

487+ ( FromListsN b b,

488488 CountableN b

489489 ) => Relation a b -> Relation a b -> Relation a b

490490overriddenBy r s = s `union` r `intersection` divR zeros (conv s)

@@ -496,11 +496,11 @@ overriddenBy r s = s `union` r `intersection` divR zeros (conv s)

496496pointAp ::

497497 ( Liftable a b,

498498 Eq a,

499− CountableDimsN a b,

500− FLN a One,

501− FLN b One

499+ CountableDimensionsN a b,

500+ FromListsN a One,

501+ FromListsN b One

502502 ) => a -> b -> Relation a b -> Relation One One

503−pointAp a b r = conv (point b) . r . point a

503+pointAp a b r = conv (point b) `comp` r `comp` point a

504504

505505-- | Relational application

506506--

@@ -508,11 +508,11 @@ pointAp a b r = conv (point b) . r . point a

508508pointApBool ::

509509 ( Liftable a b,

510510 Eq a,

511− CountableDimsN a b,

512− FLN a One,

513− FLN b One

511+ CountableDimensionsN a b,

512+ FromListsN a One,

513+ FromListsN b One

514514 ) => a -> b -> Relation a b -> Bool

515−pointApBool a b r = toBool $ conv (point b) . r . point a

515+pointApBool a b r = toBool $ conv (point b) `comp` r `comp` point a

516516

517517-- | Relational converse

518518--

@@ -538,7 +538,7 @@ iff r s = r == s

538538

539539-- | Relational intersection

540540--

541−-- Lifts pointwise conjointion.

541+-- Lifts pointwise conjunction.

542542--

543543-- @

544544-- (r ``intersection`` s) ``intersection`` t == r ``intersection`` (s ``intersection`` t)

@@ -549,13 +549,13 @@ intersection a b = a * b

549549

550550-- | Relational union

551551--

552−-- Lifts pointwise disjointion.

552+-- Lifts pointwise disjunction.

553553--

554554-- @

555555-- (r ``union`` s) ``union`` t == r `'union' (s ``union`` t)

556556-- 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)

557+-- r ``comp`` (s ``union`` t) == (r ``comp`` s) ``union`` (r ``comp`` t)

558+-- (s ``union`` t) ``comp`` r == (s ``comp`` r) ``union`` (t ``comp`` r)

559559-- @

560560union :: Relation a b -> Relation a b -> Relation a b

561561union a b = a + b

@@ -563,46 +563,46 @@ union a b = a + b

563563-- | Relation Kernel

564564--

565565-- @

566−-- 'ker' r == 'conv' r `.` r

566+-- 'ker' r == 'conv' r ``comp`` r

567567-- 'ker' r == 'img' ('conv' r)

568568-- @

569569ker :: Relation a b -> Relation a a

570−ker r = conv r . r

570+ker r = conv r `comp` r

571571

572572-- | Relation Image

573573--

574574-- @

575−-- 'img' r == r `.` conv r

575+-- 'img' r == r ``comp`` conv r

576576-- 'img' r == 'ker' ('conv' r)

577577-- @

578578img :: Relation a b -> Relation b b

579−img r = r . conv r

579+img r = r `comp` conv r

580580

581581-- | Function division. Special case of 'divS'.

582582--

583583-- NOTE: _This is only valid_ if @f@ and @g@ are 'function's, i.e. 'simple' and

584584-- 'entire'.

585585--

586−-- @'divisionF' f g == 'conv' g `.` f@

586+-- @'divisionF' f g == 'conv' g ``comp`` f@

587587divisionF :: Relation a c -> Relation b c -> Relation a b

588−divisionF f g = conv g . f

588+divisionF f g = conv g `comp` f

589589

590590-- Taxonomy of binary relations

591591

592592-- | A 'Relation' @r@ is 'simple' 'iff' @'coreflexive' ('img' r)@

593−simple :: (CountableN b, FLN b b) => Relation a b -> Bool

593+simple :: (CountableN b, FromListsN b b) => Relation a b -> Bool

594594simple = coreflexive . img

595595

596596-- | A 'Relation' @r@ is 'injective' 'iff' @'coreflexive' ('ker' r)@

597−injective :: (CountableN a, FLN a a) => Relation a b -> Bool

597+injective :: (CountableN a, FromListsN a a) => Relation a b -> Bool

598598injective = coreflexive . ker

599599

600600-- | A 'Relation' @r@ is 'entire' 'iff' @'reflexive' ('ker' r)@

601−entire :: (CountableN a, FLN a a) => Relation a b -> Bool

601+entire :: (CountableN a, FromListsN a a) => Relation a b -> Bool

602602entire = reflexive . ker

603603

604604-- | A 'Relation' @r@ is 'surjective' 'iff' @'reflexive' ('img' r)@

605−surjective :: (CountableN b, FLN b b) => Relation a b -> Bool

605+surjective :: (CountableN b, FromListsN b b) => Relation a b -> Bool

606606surjective = reflexive . img

607607

608608-- | A 'Relation' @r@ is a 'function' 'iff' @'simple' r && 'entire' r@

@@ -611,13 +611,13 @@ surjective = reflexive . img

611611-- relations:

612612--

613613-- @

614−-- f `.` r ``sse`` s == r ``sse`` f `.` s

615−-- r `.` f ``sse`` s == r ``sse`` s `.` f

614+-- f ``comp`` r ``sse`` s == r ``sse`` f ``comp`` s

615+-- r ``comp`` f ``sse`` s == r ``sse`` s ``comp`` f

616616-- @

617617function ::

618− ( CountableDimsN a b,

619− FLN a a,

620− FLN b b

618+ ( CountableDimensionsN a b,

619+ FromListsN a a,

620+ FromListsN b b

621621 )

622622 => Relation a b -> Bool

623623function r = simple r && entire r

@@ -625,7 +625,7 @@ function r = simple r && entire r

625625-- | A 'Relation' @r@ is a 'representation' 'iff' @'injective' r && 'entire' r@

626626representation ::

627627 ( CountableN a,

628− FLN a a

628+ FromListsN a a

629629 )

630630 => Relation a b -> Bool

631631representation r = injective r && entire r

@@ -633,91 +633,91 @@ representation r = injective r && entire r

633633-- | A 'Relation' @r@ is an 'abstraction' 'iff' @'surjective' r && 'simple' r@

634634abstraction ::

635635 ( CountableN b,

636− FLN b b

636+ FromListsN b b

637637 )

638638 => Relation a b -> Bool

639639abstraction r = surjective r && simple r

640640

641641-- | A 'Relation' @r@ is a 'surjection' 'iff' @'function' r && 'abstraction' r@

642642surjection ::

643− ( CountableDimsN a b,

644− FLN a a,

645− FLN b b

643+ ( CountableDimensionsN a b,

644+ FromListsN a a,

645+ FromListsN b b

646646 )

647647 => Relation a b -> Bool

648648surjection r = function r && abstraction r

649649

650650-- | A 'Relation' @r@ is a 'injection' 'iff' @'function' r && 'representation' r@

651651injection ::

652− ( CountableDimsN a b,

653− FLN a a,

654− FLN b b

652+ ( CountableDimensionsN a b,

653+ FromListsN a a,

654+ FromListsN b b

655655 )

656656 => Relation a b -> Bool

657657injection r = function r && representation r

658658

659659-- | A 'Relation' @r@ is an 'bijection' 'iff' @'injection' r && 'surjection' r@

660660bijection ::

661− ( CountableDimsN a b,

662− FLN b b,

663− FLN a a

661+ ( CountableDimensionsN a b,

662+ FromListsN b b,

663+ FromListsN a a

664664 ) => Relation a b -> Bool

665665bijection r = injection r && surjection r

666666

667667-- Properties of relations

668668

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

669+-- | A 'Relation' @r@ is 'reflexive' 'iff' @'identity' ``sse`` r@

670+reflexive :: (CountableN a, FromListsN a a) => Relation a a -> Bool

671+reflexive r = identity <= r

672672

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

673+-- | A 'Relation' @r@ is 'coreflexive' 'iff' @r ``sse`` 'identity'@

674+coreflexive :: (CountableN a, FromListsN a a) => Relation a a -> Bool

675+coreflexive r = r <= identity

676676

677−-- | A 'Relation' @r@ is 'transitive' 'iff' @(r `.` r) ``sse`` r@

677+-- | A 'Relation' @r@ is 'transitive' 'iff' @(r ``comp`` r) ``sse`` r@

678678transitive :: Relation a a -> Bool

679−transitive r = (r . r) `sse` r

679+transitive r = (r `comp` r) `sse` r

680680

681681-- | A 'Relation' @r@ is 'symmetric' 'iff' @r == 'conv' r@

682682symmetric :: Relation a a -> Bool

683683symmetric r = r == conv r

684684

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

685+-- | A 'Relation' @r@ is anti-symmetric 'iff' @(r ``intersection`` 'conv' r) ``sse`` 'identity'@

686+antiSymmetric :: (CountableN a, FromListsN a a) => Relation a a -> Bool

687+antiSymmetric r = (r `intersection` conv r) `sse` identity

688688

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

689+-- | A 'Relation' @r@ is 'irreflexive' 'iff' @(r ``intersection`` 'identity') == 'zeros'@

690+irreflexive :: (CountableN a, FromListsN a a) => Relation a a -> Bool

691+irreflexive r = (r `intersection` identity) == zeros

692692

693693-- | A 'Relation' @r@ is 'connected' 'iff' @(r ``union`` 'conv' r) == 'ones'@

694−connected :: (CountableN a, FLN a a) => Relation a a -> Bool

694+connected :: (CountableN a, FromListsN a a) => Relation a a -> Bool

695695connected r = (r `union` conv r) == ones

696696

697697-- | A 'Relation' @r@ is a 'preorder' 'iff' @'reflexive' r && 'transitive' r@

698−preorder :: (CountableN a, FLN a a) => Relation a a -> Bool

698+preorder :: (CountableN a, FromListsN a a) => Relation a a -> Bool

699699preorder r = reflexive r && transitive r

700700

701701-- | A 'Relation' @r@ is a partial-order 'iff' @'antiSymmetric' r && 'preorder' r@

702−partialOrder :: (CountableN a, FLN a a) => Relation a a -> Bool

702+partialOrder :: (CountableN a, FromListsN a a) => Relation a a -> Bool

703703partialOrder r = antiSymmetric r && preorder r

704704

705705-- | A 'Relation' @r@ is a linear-order 'iff' @'connected' r && 'partialOrder' r@

706−linearOrder :: (CountableN a, FLN a a) => Relation a a -> Bool

706+linearOrder :: (CountableN a, FromListsN a a) => Relation a a -> Bool

707707linearOrder r = connected r && partialOrder r

708708

709709-- | A 'Relation' @r@ is an 'equivalence' 'iff' @'symmetric' r && 'preorder' r@

710−equivalence :: (CountableN a, FLN a a) => Relation a a -> Bool

710+equivalence :: (CountableN a, FromListsN a a) => Relation a a -> Bool

711711equivalence r = symmetric r && preorder r

712712

713713-- | A 'Relation' @r@ is a partial-equivalence 'iff' @'partialOrder' r && 'equivalence' r@

714−partialEquivalence :: (CountableN a, FLN a a) => Relation a a -> Bool

714+partialEquivalence :: (CountableN a, FromListsN a a) => Relation a a -> Bool

715715partialEquivalence r = partialOrder r && equivalence r

716716

717717-- | A 'Relation' @r@ is 'difunctional' or regular wherever

718−-- @r `.` 'conv' r `.` r == r@

718+-- @r ``comp`` 'conv' r ``comp`` r == r@

719719difunctional :: Relation a b -> Bool

720−difunctional r = r . conv r . r == r

720+difunctional r = r `comp` conv r `comp` r == r

721721

722722-- Relational pairing

723723

@@ -726,61 +726,61 @@ difunctional r = r . conv r . r == r

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

727727--

728728-- @

729−-- | 'fstR' `.` 'splitR' a b ``sse`` a

729+-- | 'p1' ``comp`` 'splitR' a b ``sse`` a

730730-- 'splitR' a b <=> |

731−-- | 'sndR' `.` 'splitR' a b ``sse`` b

731+-- | 'p2' ``comp`` 'splitR' a b ``sse`` b

732732-- @

733733--

734734-- __Emphasis__ on the 'sse'.

735735--

736736-- @

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)

737+-- 'splitR' r s ``comp`` f == 'splitR' (r ``comp`` f) (s ``comp`` f)

738+-- (R '><' S) ``comp`` 'splitR' p q == 'splitR' (r ``comp`` p) (s ``comp`` q)

739+-- 'conv' ('splitR' r s) ``comp`` 'splitR' x y == ('conv' r ``comp`` x) ``intersection`` ('conv' s ``comp`` y)

740740-- @

741741--

742742-- @

743743-- 'eitherR' ('splitR' r s) ('splitR' t v) == 'splitR' ('eitherR' r t) ('eitherR' s v)

744744-- @

745745splitR ::

746− ( CountableDimsN a b,

746+ ( CountableDimensionsN a b,

747747 CountableN (a, b),

748− FLN (a, b) a,

749− FLN (a, b) b,

748+ FromListsN (a, b) a,

749+ FromListsN (a, b) b,

750750 TrivialP a b

751751 )

752752 => Relation c a -> Relation c b -> Relation c (a, b)

753−splitR (R f) (R g) = R (I.kr f g)

753+splitR (R f) (R g) = R (I.khatri f g)

754754

755755-- | Relational pairing first component projection

756756--

757757-- @

758−-- 'fstR' `.` 'splitR' r s ``sse`` r

758+-- 'p1' ``comp`` 'splitR' r s ``sse`` r

759759-- @

760−fstR ::

760+p1 ::

761761 forall a b .

762− ( CountableDimsN a b,

762+ ( CountableDimensionsN a b,

763763 CountableN (a, b),

764− FLN (a, b) a,

764+ FromListsN (a, b) a,

765765 TrivialP a b

766766 )

767767 => Relation (a, b) a

768−fstR = R (I.fstM @Boolean @(I.Normalize a) @(I.Normalize b))

768+p1 = R (I.kp1 @Boolean @(I.Normalize a) @(I.Normalize b))

769769

770770-- | Relational pairing second component projection

771771--

772772-- @

773−-- 'sndR' `.` 'splitR' r s ``sse`` s

773+-- 'p2' ``comp`` 'splitR' r s ``sse`` s

774774-- @

775−sndR ::

775+p2 ::

776776 forall a b .

777− ( CountableDimsN a b,

777+ ( CountableDimensionsN a b,

778778 CountableN (a, b),

779− FLN (a, b) b,

779+ FromListsN (a, b) b,

780780 TrivialP a b

781781 )

782782 => Relation (a, b) b

783−sndR = R (I.sndM @Boolean @(I.Normalize a) @(I.Normalize b))

783+p2 = R (I.kp2 @Boolean @(I.Normalize a) @(I.Normalize b))

784784

785785-- Relational pairing functor

786786

@@ -788,17 +788,17 @@ infixl 4 ><

788788-- | Relational pairing functor

789789--

790790-- @

791−-- r '><' s == 'splitR' (r `.` fstR) (s `.` sndR)

792−-- (r '><' s) `.` (p '><' q) == (r `.` p) '><' (s `.` q)

791+-- r '><' s == 'splitR' (r ``comp`` p1) (s ``comp`` p2)

792+-- (r '><' s) ``comp`` (p '><' q) == (r ``comp`` p) '><' (s ``comp`` q)

793793-- @

794794(><) ::

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,

795+ ( CountableDimensionsN a b,

796+ CountableDimensionsN c d,

797+ CountableDimensionsN (a, c) (b, d),

798+ FromListsN (a, c) a,

799+ FromListsN (a, c) c,

800+ FromListsN (b, d) b,

801+ FromListsN (b, d) d,

802802 TrivialP a c,

803803 TrivialP b d

804804 )

@@ -810,31 +810,33 @@ infixl 4 ><

810810-- | Relational coproduct.

811811--

812812-- @

813−-- | 'eitherR' a b `.` 'i1' == a

813+-- | 'eitherR' a b ``comp`` 'i1' == a

814814-- 'eitherR' a b <=> |

815−-- | 'eitherR' a b `.` 'i2' == b

815+-- | 'eitherR' a b ``comp`` 'i2' == b

816816-- @

817817--

818818-- @

819−-- 'eitherR' r s `.` 'conv' ('eitherR' t u) == (r `.` 'conv' t) ``union`` (s `.` 'conv' u)

819+-- 'eitherR' r s ``comp`` 'conv' ('eitherR' t u) == (r ``comp`` 'conv' t) ``union`` (s ``comp`` 'conv' u)

820820-- @

821821--

822822-- @

823823-- 'eitherR' ('splitR' r s) ('splitR' t v) == 'splitR' ('eitherR' r t) ('eitherR' s v)

824824-- @

825−eitherR :: Relation a c -> Relation b c -> Relation (Either a b) c

826−eitherR = join

825+eitherR :: (TrivialE a b)

826+ => Relation a c -> Relation b c -> Relation (Either a b) c

827+eitherR = junc

827828

828829-- | Relational coproduct first component injection

829830--

830831-- @

831−-- 'img' 'i1' ``union`` 'img' 'i2' == 'id'

832−-- 'i1' `.` 'i2' = 'zeros'

832+-- 'img' 'i1' ``union`` 'img' 'i2' == 'identity'

833+-- 'i1' ``comp`` 'i2' = 'zeros'

833834-- @

834835i1 ::

835− ( CountableDimsN a b,

836− FLN b a,

837− FLN a a

836+ ( CountableDimensionsN a b,

837+ FromListsN b a,

838+ FromListsN a a,

839+ TrivialE a b

838840 )

839841 => Relation a (Either a b)

840842i1 = R I.i1

@@ -842,13 +844,14 @@ i1 = R I.i1

842844-- | Relational coproduct second component injection

843845--

844846-- @

845−-- 'img' 'i1' ``union`` 'img' 'i2' == 'id'

846−-- 'i1' `.` 'i2' = 'zeros'

847+-- 'img' 'i1' ``union`` 'img' 'i2' == 'identity'

848+-- 'i1' ``comp`` 'i2' = 'zeros'

847849-- @

848850i2 ::

849− ( CountableDimsN a b,

850− FLN a b,

851− FLN b b

851+ ( CountableDimensionsN a b,

852+ FromListsN a b,

853+ FromListsN b b,

854+ TrivialE a b

852855 )

853856 => Relation b (Either a b)

854857i2 = R I.i2

@@ -858,14 +861,16 @@ infixl 5 -|-

858861-- | Relational coproduct functor.

859862--

860863-- @

861−-- r '-|-' s == 'eitherR' ('i1' `.` r) ('i2' `.` s)

864+-- r '-|-' s == 'eitherR' ('i1' ``comp`` r) ('i2' ``comp`` s)

862865-- @

863866(-|-) ::

864− ( CountableDimsN b d,

865− FLN b b,

866− FLN d b,

867− FLN b d,

868− FLN d d

867+ ( CountableDimensionsN b d,

868+ FromListsN b b,

869+ FromListsN d b,

870+ FromListsN b d,

871+ FromListsN d d,

872+ TrivialE a c,

873+ TrivialE b d

869874 )

870875 => Relation a b -> Relation c d -> Relation (Either a c) (Either b d)

871876(-|-) (R a) (R b) = R ((I.-|-) a b)

@@ -878,20 +883,20 @@ infixl 5 -|-

878883-- 'trans'/'untrans';

879884-- more-over, where each particular attribute is placed (input/output) is irrelevant.

880885trans ::

881− ( CountableDimsN a b,

886+ ( CountableDimensionsN a b,

882887 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,

888+ CountableDimensionsN (a, b) (c, b),

889+ FromListsN (c, b) c,

890+ FromListsN (c, b) b,

891+ FromListsN (a, b) a,

892+ FromListsN (a, b) b,

888893 Trivial (a, b),

889894 Trivial (c, b),

890− TrivialP a b,

891− TrivialP c b

895+ TrivialP2 a b,

896+ TrivialP2 c b

892897 )

893898 => Relation (a, b) c -> Relation a (c, b)

894−trans r = splitR r sndR . conv fstR

899+trans r = splitR r p2 `comp` conv p1

895900

896901-- | Relational 'untrans'

897902--

@@ -899,110 +904,109 @@ trans r = splitR r sndR . conv fstR

899904-- 'trans'/'untrans';

900905-- more-over, where each particular attribute is placed (input/output) is irrelevant.

901906untrans ::

902− ( CountableDimsN a b,

907+ ( CountableDimensionsN a b,

903908 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,

909+ CountableDimensionsN (a, b) (c, b),

910+ FromListsN (c, b) c,

911+ FromListsN (c, b) b,

912+ FromListsN (a, b) b,

913+ FromListsN (a, b) a,

909914 Trivial (a, b),

910915 Trivial (c, b),

911− TrivialP a b,

912− TrivialP c b

916+ TrivialP2 a b,

917+ TrivialP2 c b

913918 )

914919 => Relation a (c, b) -> Relation (a, b) c

915−untrans s = fstR . conv (splitR (conv s) sndR)

920+untrans s = p1 `comp` conv (splitR (conv s) p2)

916921

917922-- | Transforms predicate @p@ into a correflexive relation.

918923--

919924-- @

920−-- 'predR' ('const' True) == 'id'

925+-- 'predR' ('const' True) == 'identity'

921926-- 'predR' ('const' False) == 'zeros'

922927-- @

923928--

924929-- @

925−-- 'predR' q `.` 'predR' p == 'predR' q ``union`` 'predR' p

930+-- 'predR' q ``comp`` 'predR' p == 'predR' q ``union`` 'predR' p

926931-- @

927932predR ::

928933 ( Bounded a,

929934 Enum a,

930− Countable a,

931935 CountableN a,

932− FLN a a,

933− FLN Bool a

936+ FromListsN a a,

937+ FromListsN Bool a

934938 )

935939 => Relation a Bool -> Relation a a

936−predR p = id `intersection` divisionF (fromF (const True)) p

940+predR p = identity `intersection` divisionF (fromF' (const True)) p

937941

938942-- | Equalizes functions @f@ and @g@.

939943-- That is, @'equalizer' f g@ is the largest coreflexive

940944-- that restricts @g@ so that @f@ and @g@ yield the same outputs.

941945--

942946-- @

943−-- 'equalizer' r r == 'id'

947+-- 'equalizer' r r == 'identity'

944948-- 'equalizer' ('point' True) ('point' False) == 'zeros'

945949-- @

946950equalizer ::

947951 ( CountableN a,

948− FLN a a

952+ FromListsN a a

949953 )

950954 => Relation a b -> Relation a b -> Relation a a

951−equalizer f g = id `intersection` divisionF f g

955+equalizer f g = identity `intersection` divisionF f g

952956

953957-- | Relational conditional guard.

954958--

955959-- @

956−-- 'guard' p = 'i2' ``overriddenBy`` 'i1' `.` 'predR' p

960+-- 'guard' p = 'i2' ``overriddenBy`` 'i1' ``comp`` 'predR' p

957961-- @

958−guard ::

962+guard ::

959963 ( Bounded b,

960964 Enum b,

961965 CountableN b,

962− Countable b,

963− FLN b b,

964− FLN Bool b

966+ FromListsN b b,

967+ FromListsN Bool b,

968+ TrivialE b b

965969 ) => Relation b Bool -> Relation b (Either b b)

966970guard p = conv (eitherR (predR p) (predR (negate p)))

967971

968972-- | Relational McCarthy's conditional.

969−cond ::

973+cond ::

970974 ( Bounded b,

971975 Enum b,

972− Countable b,

973976 CountableN b,

974− FLN b b,

975− FLN Bool b

976− )

977+ FromListsN b b,

978+ FromListsN Bool b,

979+ TrivialE b b

980+ )

977981 => Relation b Bool -> Relation b c -> Relation b c -> Relation b c

978−cond p r s = eitherR r s . guard p

982+cond p r s = eitherR r s `comp` guard p

979983

980984-- | Relational domain.

981985--

982986-- For injective relations, 'domain' and 'ker'nel coincide,

983−-- since @'ker' r ``sse`` 'id'@ in such situations.

987+-- since @'ker' r ``sse`` 'identity'@ in such situations.

984988domain ::

985989 ( CountableN a,

986− FLN a a

990+ FromListsN a a

987991 ) => Relation a b -> Relation a a

988−domain r = ker r `intersection` id

992+domain r = ker r `intersection` identity

989993

990994-- | Relational range.

991995--

992996-- For functions, 'range' and 'img' (image) coincide,

993−-- since @'img' f ``sse`` id@ for any @f@.

997+-- since @'img' f ``sse`` 'identity'@ for any @f@.

994998range ::

995999 ( CountableN b,

996− FLN b b

1000+ FromListsN b b

9971001 ) => Relation a b -> Relation b b

998−range r = img r `intersection` id

1002+range r = img r `intersection` identity

9991003

10001004-- Relation pretty print

10011005

10021006-- | Relation pretty printing

1003−pretty :: (CountableDimsN a b) => Relation a b -> String

1007+pretty :: (CountableN a) => Relation a b -> String

10041008pretty (R a) = I.pretty a

10051009

10061010-- | Relation pretty printing

1007−prettyPrint :: (CountableDimsN a b) => Relation a b -> IO ()

1011+prettyPrint :: (CountableN a) => Relation a b -> IO ()

10081012prettyPrint (R a) = I.prettyPrint a

src/LAoP/Utils.hs+2−5

@@ -95,11 +95,8 @@ module LAoP.Utils

9595 coerceNat2,

9696 coerceNat3,

9797

98− -- * List data type

99− List (..),

100−

101− -- * Category type-class

102− Category(..)

98+ -- * Powerset data type

99+ List (..)

103100 )

104101where

105102

src/LAoP/Utils/Internal.hs+75−33

@@ -1,13 +1,82 @@

1−{-# LANGUAGE TypeFamilies #-}

2−{-# LANGUAGE DeriveGeneric #-}

31{-# LANGUAGE TypeApplications #-}

42{-# LANGUAGE DataKinds #-}

53{-# LANGUAGE FlexibleInstances #-}

64{-# LANGUAGE GeneralizedNewtypeDeriving #-}

5+{-# LANGUAGE KindSignatures #-}

76{-# LANGUAGE ScopedTypeVariables #-}

98module LAoP.Utils.Internal

10− (

9+ ( -- | This is an internal module and it is not meant to be imported.

10+ --

11+ -- Utility module that provides the 'Natural' data type.

12+ -- The semantic associated with this data type is that

13+ -- it's meant to be a restricted 'Int' value. For example

14+ -- the type @Natural 6@ can only be instanciated with @Nat n@

15+ -- where @0 <= n <= 6@. Why, You might ask, because with normal

16+ -- 'Int's it is not possible to have a decent @Enum (Int, Int)@

17+ -- instance. See the following probabilistic programming model as and

18+ -- example:

19+ --

20+ -- We want to calculate the probability of the sum of two dice throws.

21+ -- To do this we start by defining the sample space:

22+ --

23+ -- @

24+ -- type SampleSpace = Int -- We think 'Int' are enough

25+ --

26+ -- die :: Dist Int 6

27+ -- die = unifrom [1..6]

28+ --

29+ -- -- Promote 'Int' addition to a matrix

30+ -- addM = fromF (uncurry (+)) -- Impossible

31+ -- @

32+ --

33+ -- The last line is impossible because @(Int, Int)@ does not have

34+ -- a good 'Enum' instance: @[(0, 1), (0, 2), .. (0, maxBound), (1, 0),

35+ -- ..]@. And we'd like the addition matrix to be of 36 columns by 12

36+ -- rows but limited to integers up to @6@!

37+ --

38+ -- One way to solve this issue is by defining and auxilary data type to

39+ -- represent the sample space:

40+ --

41+ -- @

42+ -- data SampleSpace = S1 | S2 | S3 | S4 | S5 | S6

43+ -- deriving (Show, Eq, Enum, Bounded) -- Enum and Bounded are

44+ -- important

45+ -- @

46+ --

47+ -- And write the sample space addition function:

48+ --

49+ -- @

50+ -- ssAdd :: SampleSpace -> SampleSpace -> Int

51+ -- ssAdd a b = (fromEnum a + 1) + (fromEnum b + 1)

52+ -- @

53+ --

54+ -- And then promote that function to matrix and everything is alright:

55+ --

56+ -- @

57+ -- ssAddM = fromF' (uncurry ssAdd)

58+ --

59+ -- dieSumProb = ssAddM `comp` (khatri die die)

60+ -- @

61+ --

62+ -- This is a nice solution for small sample spaces. But for larger ones

63+ -- it is not feasible to write a data type with hundreds of constructors

64+ -- and then write manipulation functions that need to deal with them.

65+ -- To mitigate this limitation the 'Natural' type comes a long way and

66+ -- allows one to model the sample in an easier way. See for instance:

67+ --

68+ -- @

69+ -- ssAdd :: Natural 6 -> Natural 6 -> Natural 12

70+ -- ssAdd = coerceNat (+)

71+ --

72+ -- ssAddM = fromF' (uncurry sumSS)

73+ --

74+ -- die :: Dist (Natural 6) 6

75+ -- die = uniform [nat @6 1 .. nat 6]

76+ --

77+ -- dieSumProb = ssAddM `comp` (khatri die die)

78+ -- @

79+ --

1180 -- * 'Natural' data type

1281 Natural(..),

1382 nat,

@@ -18,11 +87,8 @@ module LAoP.Utils.Internal

1887 coerceNat2,

1988 coerceNat3,

2089

21− -- * 'List' data type

22− List (..),

23−

24− -- * Category type class

25− Category(..)

90+ -- * Powerset data type

91+ List (..)

2692 )

2793where

2894

@@ -32,16 +98,12 @@ import Data.List

3298import Data.Maybe

3399import GHC.TypeLits

34100import Control.DeepSeq

35−import GHC.Generics

36−import Data.Kind

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

38−import qualified Prelude

39101

40102-- | Wrapper around 'Int's that have a restrictive semantic associated.

41103-- A value of type @'Natural' n m@ can only be instanciated with some 'Int'

42104-- @i@ that's @n <= i <= m@.

43105newtype Natural (start :: Nat) (end :: Nat) = Nat Int

44− deriving (Show, Read, Eq, Ord, NFData, Generic)

106+ deriving (Show, Read, Eq, Ord, NFData)

45107

46108-- | Throws a runtime error if any of the operations overflows or

47109-- underflows.

@@ -174,23 +236,3 @@ instance

174236 fromEnum (L x) =

175237 let as = [minBound .. maxBound]

176238 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"