master..0991ecc · laop

git.iko.soy/laop

on 0991ecc help sign in

30 files changed+1884−1004

since splitsnapshots

unifiedsplit

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

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

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

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

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

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

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

6+--

7+clear-package-db

8+global-package-db

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

10+package-db packagedb/ghc-8.6.5

11+package-id laop-0.1.0.0-inplace

12+package-id base-4.12.0.0

13+package-id ghc-prim-0.5.3

14+package-id rts

15+package-id integer-gmp-1.0.2.0

16+package-id deepseq-1.4.4.0

17+package-id array-0.5.3.0

.github/workflows/ci.ymldeleted−43

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

1−name: CI

2−

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

4−on:

5− pull_request:

6− push:

7− branches: [master]

8−

9−jobs:

10− build:

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

12− runs-on: ubuntu-16.04

13− strategy:

14− matrix:

15− cabal: ["3.0"]

16− ghc:

17− - "8.6.5"

18− - "8.8.3"

19−

20− steps:

21− - uses: actions/checkout@v2

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

23−

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

25− name: Setup Haskell

26− with:

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

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

29−

30− - uses: actions/cache@v1

31− name: Cache ~/.cabal/store

32− with:

33− path: ~/.cabal/store

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

35−

36− - name: Build

37− run: |

38− cabal v2-update

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

40−

41− - name: Test

42− run: |

43− cabal v2-test --enable-tests

.gitignore+2−54

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

1−### Haskell

2−dist

3−dist-*

4−cabal-dev

5−*.o

6−*.hi

7−*.chi

8−*.chs.h

9−*.dyn_o

10−*.dyn_hi

11−*.prof

12−*.aux

13−*.hp

14−*.eventlog

15−.virtualenv

16−.hsenv

17−.hpc

18−.cabal-sandbox/

19−cabal.sandbox.config

20−cabal.config

21−cabal.project.local

22−.ghc.environment.*

23−.HTF/

24−# Stack

251.stack-work/

26−stack.yaml.lock

27−

28−### IDE/support

29−# Vim

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

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

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

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

34−*~

35−tags

36−

37−# IntellijIDEA

38−.idea/

39−.ideaHaskellLib/

40−*.iml

41−

42−# Atom

43−.haskell-ghc-mod.json

44−

45−# VS

46−.vscode/

47−

48−# Emacs

49−*#

50−.dir-locals.el

51−TAGS

52−

53−# other

54−.DS_Store

55−hackage.sh

2+laop.cabal

3+*~

.travis.ymldeleted−47

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

1−sudo: true

2−language: haskell

3−

4−git:

5− depth: 5

6−

7−cabal: "3.0"

8−

9−cache:

10− directories:

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

12− - "$HOME/.stack"

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

14−

15−matrix:

16− include:

17− - ghc: 8.6.5

18− - ghc: 8.8.3

19−

20− - ghc: 8.8.3

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

22−

23− - ghc: 8.6.5

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

25−

26−

27−install:

28− - |

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

30− cabal v2-update

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

32− else

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

34− stack --version

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

36− fi

37−

38−script:

39− - |

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

41− cabal v2-test --enable-tests

42− else

43− stack test --system-ghc

44− fi

45−

46−notifications:

47− email: false

CHANGELOG.mddeleted−17

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

1−# Changelog

2−

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

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

5−

6−## 0.1.1.1

7−

8−* Bump base version to work with cabal

9−

10−## 0.1.1.0

11−

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

13−* Repository is more organized and clean

14−* Added CI

15−

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

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

ChangeLog.mdnew file+3

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

1+# Changelog for laop

3+## Unreleased changes

LICENSE+26−17

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

1−MIT License

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

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

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

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

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

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

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

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

117

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

13−copies or substantial portions of the Software.

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

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

1410

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

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

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

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

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

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

21−SOFTWARE.

11+ * Redistributions in binary form must reproduce the above

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

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

14+ with the distribution.

15+

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

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

18+ from this software without specific prior written permission.

19+

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

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

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

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

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

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

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

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

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

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

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

README.md+30−34

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

11# laop - Linear Algebra of Programming library

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

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

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

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

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

8−

93The LAoP discipline generalises relations and functions treating them as

104Boolean matrices and in turn consider these as arrows.

115

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

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

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

1812

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

20−

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

22−

23−## Features

24−

25−This library offers 3 main matrix programming modules:

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

2614

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

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

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

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

3016

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

32−distributions.

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

3318

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

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

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

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

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

39−and transformation functions.

40−

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

42−

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

44−

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

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

47−

48−## Known issues

19+## Features

4920

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

21+This library offers:

22+

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

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

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

26+ around the internal matrix data type.

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

28+ around the internal matrix data type.

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

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

31+ AoP and Relational Calculus/Algebra.

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

33+ make it easier to deal with sample space.

34+

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

36+

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

38+- Statically typed dimensions;

39+- Polymorphic data type dimensions;

40+- Polymorphic matrix content;

41+- Awesome dimension type inference;

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

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

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

45+

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

5147

5248## Notes

5349

Setup.hsnew file+2

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

1+import Distribution.Simple

2+main = defaultMain

benchmark/Main.hs → app/Benchmarks.hsrenamed+19−13

@@ -8,12 +8,15 @@

88{-# LANGUAGE AllowAmbiguousTypes #-}

99{-# LANGUAGE ScopedTypeVariables #-}

1010

11−module Main (main) where

11+module Benchmarks

12+ ( benchmark

13+ )

14+ where

1215

1316import LAoP.Dist.Internal

1417import LAoP.Utils

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

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

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

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

1720import Criterion.Main

1821import Control.DeepSeq

1922import Test.QuickCheck

@@ -21,23 +24,26 @@ import GHC.TypeLits

2124import Data.Proxy

2225import Prelude hiding (id, (.))

2326

24−selectM2 ::

27+selectM2 ::

2528 ( Num e,

26− T.FLN b b,

27− CountableN b

29+ EqN b,

30+ ConstructN b,

31+ EnumerableN b

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

2933selectM2 m y = join y iden `comp` m

3034

3135selectD2 ::

32− ( FLN b b,

33− CountableN b

36+ ( Num e,

37+ EqN b,

38+ ConstructN b,

39+ EnumerableN b

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

3541selectD2 (D d) m = D (join m iden `comp` d)

3642

3743-- Composition with iden

3844compId m = comp iden m

3945

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

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

4147randomDist = do

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

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

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

4652 m = fromLists lr

4753 return (D m)

4854

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

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

5056randomMatrix = do

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

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

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

105111 probs = map (/ s) l

106112 in zip as probs

107113

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

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

109115randomDistF = do

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

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

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

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

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

146152

147−main :: IO ()

148−main = defaultMain [

153+benchmark :: IO ()

154+benchmark = defaultMain [

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

150156 bgroup "10x10" [

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

test/Examples/Readme.hs → app/Examples.hsrenamed+6−5

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

11{-# LANGUAGE GADTs #-}

22{-# LANGUAGE DeriveGeneric #-}

33{-# LANGUAGE FlexibleContexts #-}

4+{-# LANGUAGE TypeOperators #-}

45{-# LANGUAGE TypeApplications #-}

56{-# LANGUAGE DataKinds #-}

7−module Examples.Readme

8+module Examples

89 ( exec

910 )

1011 where

@@ -27,7 +28,7 @@ switch Win = Lose

2728switch Lose = Win

2829

2930firstChoice :: Matrix Double () Outcome

30−firstChoice = col [1/3, 2/3]

31+firstChoice = colL [1/3, 2/3]

3132

3233secondChoice :: Matrix Double Outcome Outcome

3334secondChoice = fromF switch

@@ -52,7 +53,7 @@ conditionSS = coerceNat2 condition

5253conditionalThrows = fromF (uncurry conditionSS) . kr (kr die die) die

5354

5455die :: Matrix Double () SS

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

56+die = colL $ map (const (1/6)) [nat @1 @6 1 .. nat 6]

5657

5758-- Sprinkler

5859data G = Dry | Wet

@@ -95,10 +96,10 @@ tag f = kr f id

9596state g s r = tag g . tag s . r

9697

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

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

99+grass_wet state = rowL [0,1] . fstM . state

99100

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

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

102+rainning = rowL [0,1] . sndM . sndM

102103

103104-- Alcuin Puzzle

104105

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/Quantum.hs → app/Quantum.hsrenamed+2−2

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

11{-# LANGUAGE StandaloneDeriving #-}

2−module Examples.Quantum where

2+module Quantum where

44import LAoP.Utils

55import LAoP.Matrix.Type

@@ -21,7 +21,7 @@ cnot = kr fstM (fromF xor)

2121ccnot :: (Num e, Ord e) => Matrix e ((Bool, Bool), Bool) ((Bool, Bool), Bool)

2222ccnot = kr fstM (fromF f)

2323 where

24− f = xor . tp (uncurry (&&)) id

24+ f = xor . (tp (uncurry (&&)) id)

2525 tp f g (a,b) = (f a, g b)

2626

2727had :: Matrix (Complex Double) Bool Bool

test/Examples/Spreadsheets.hs → app/Spreadsheets.hsrenamed+2−1

@@ -1,6 +1,7 @@

11{-# LANGUAGE DeriveGeneric #-}

3−module Examples.Spreadsheets

3+module Spreadsheets

4+ where

56import LAoP.Utils

67import LAoP.Matrix.Type

appveyor.ymldeleted−34

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

1−clone_folder: "c:\\WORK"

2−clone_depth: 5

3−

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

5−skip_branch_with_pr: true

6−

7−platform:

8− - x86_64

9−

10−cache:

11− - "C:\\SR"

12− - dist-newstyle

13−

14−environment:

15− global:

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

17−

18− matrix:

19− - GHCVER: 8.6.5

20−

21−install:

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

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

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

25− - refreshenv

26−

27−before_build:

28− - cabal --version

29− - ghc --version

30− - cabal %CABOPTS% v2-update

31−

32−build_script:

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

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

hackage.shnew file+10

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

1+#!/bin/sh

2+set -e

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

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

7+# assumes cabal 2.4 or later

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

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

laop.cabaldeleted−89

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

1−cabal-version: 2.4

2−name: laop

3−version: 0.1.1.1

4−synopsis: Matrix programming library

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

6− inspired by the Linear Algebra of Programming

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

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

9−license: MIT

10−license-file: LICENSE

11−author: Armando Santos

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

13−copyright: 2020 Armando Santos

14−category: Data

15−build-type: Simple

16−extra-doc-files: README.md

17− CHANGELOG.md

18−tested-with: GHC == 8.6.5

19− GHC == 8.8.3

20−

21−source-repository head

22− type: git

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

24−

25−common common-options

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

27− deepseq

28−

29− ghc-options: -Wall

30− -Wcompat

31− -Widentities

32− -Wincomplete-uni-patterns

33− -Wincomplete-record-updates

34− if impl(ghc >= 8.0)

35− ghc-options: -Wredundant-constraints

36− if impl(ghc >= 8.2)

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

38− if impl(ghc >= 8.4)

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

40− -Wpartial-fields

41− if impl(ghc >= 8.8)

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

43−

44− default-language: Haskell2010

45−

46−library

47− import: common-options

48− hs-source-dirs: src

49− exposed-modules: LAoP.Dist

50− LAoP.Dist.Internal

51− LAoP.Matrix.Internal

52− LAoP.Matrix.Nat

53− LAoP.Matrix.Type

54− LAoP.Relation

55− LAoP.Relation.Internal

56− LAoP.Utils

57− LAoP.Utils.Internal

58−

59−test-suite laop-test

60− import: common-options

61− type: exitcode-stdio-1.0

62− hs-source-dirs: test

63− other-modules: Examples.Readme

64− main-is: Spec.hs

65− build-depends: laop

66− ghc-options: -threaded

67− -rtsopts

68− -with-rtsopts=-N

69− -funfolding-use-threshold=16

70− -fexcess-precision

71− -optc-O3

72− -optc-ffast-math

73−

74−benchmark laop-benchmark

75− import: common-options

76− type: exitcode-stdio-1.0

77− hs-source-dirs: benchmark

78− main-is: Main.hs

79− build-depends: criterion

80− , QuickCheck

81− , deepseq

82− , laop

83− ghc-options: -threaded

84− -rtsopts

85− -with-rtsopts=-N

86− -funfolding-use-threshold=16

87− -fexcess-precision

88− -optc-O3

89− -optc-ffast-math

package.yamlnew file+57

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

1+name: laop

2+version: 0.1.0.7

3+github: "bolt12/laop"

4+license: BSD3

5+author: "Armando Santos"

6+maintainer: "armandoifsantos@gmail.com"

7+copyright: "MIT"

9+extra-source-files:

10+- README.md

11+- ChangeLog.md

12+

13+# Metadata used when publishing your package

14+# synopsis: Short description of your package

15+category: Data

16+

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

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

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

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

21+

22+dependencies:

23+- base >= 4.7 && < 5

24+- deepseq

25+

26+library:

27+ source-dirs: src

28+

29+executables:

30+ laop-exe:

31+ main: Main.hs

32+ source-dirs: app

33+ ghc-options:

34+ - -threaded

35+ - -rtsopts

36+ - -with-rtsopts=-N

37+ - -funfolding-use-threshold=16

38+ - -fexcess-precision # Good for doubles

39+ - -optc-O3 # Good for doubles

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

41+ - -O2

42+ dependencies:

43+ - laop

44+ - criterion

45+ - deepseq

46+ - QuickCheck

47+

48+tests:

49+ laop-test:

50+ main: Spec.hs

51+ source-dirs: test

52+ ghc-options:

53+ - -threaded

54+ - -rtsopts

55+ - -with-rtsopts=-N

56+ dependencies:

57+ - laop

src/LAoP/Dist.hs+2−2

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

3939 -- * Constraint type synonyms

4040 Countable,

4141 CountableN,

42− CountableDimsN,

43− FLN,

42+ CountableDimensionsN,

43+ FromListsN,

4444 Liftable,

4545 TrivialP,

4646

src/LAoP/Dist/Internal.hs+44−63

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

1616

1717 Countable,

1818 CountableN,

19− CountableDimsN,

20− FLN,

19+ CountableDimensionsN,

20+ FromListsN,

2121 Liftable,

2222 TrivialP,

2323

@@ -43,9 +43,9 @@ module LAoP.Dist.Internal

4343 )

4444 where

4545

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

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

4747import Prelude hiding (id, (.))

48−import qualified LAoP.Matrix.Internal as I

48+import qualified LAoP.Matrix.Alternative as I

4949import LAoP.Utils

5050import GHC.TypeLits

5151import Data.Proxy

@@ -62,41 +62,30 @@ newtype Dist a = D (Matrix Prob () a)

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

6363

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

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

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

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

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

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

7170

7271-- | Functor instance

73−fmapD ::

74− ( Liftable a b,

75− CountableDimsN a b,

76− FLN b a

77− )

78− =>

79− (a -> b) -> Dist a -> Dist b

80−fmapD f (D m) = D (fromF' f `comp` m)

72+fmapD :: Liftable a b => (a -> b) -> Dist a -> Dist b

73+fmapD f (D m) = D (fromF f `comp` m)

8174

8275-- | Applicative/Monoidal instance 'unit' function

8376unitD :: Dist ()

8477unitD = D (one 1)

8578

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

87−multD ::

88− ( CountableDimsN a b,

89− CountableN (a, b),

90− FLN (a, b) a,

91− FLN (a, b) b,

92− TrivialP a b

93− ) => Dist a -> Dist b -> Dist (a, b)

80+multD :: (FstM a b, SndM a b) => Dist a -> Dist b -> Dist (a, b)

9481multD (D a) (D b) = D (kr a b)

9582

9683-- | Selective instance function

97−selectD ::

98− ( FLN b b,

99− CountableN b

84+selectD ::

85+ ( EqN a,

86+ EqN b,

87+ EnumerableN b,

88+ ConstructN b

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

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

10291

@@ -104,17 +93,14 @@ selectD (D d) m = D (selectM d m)

10493-- functions to apply to a given argument;

10594branchD ::

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

96+ EqN a,

97+ EqN b,

98+ EqN c,

99+ ConstructableN a b,

100+ ConstructN c,

101+ EnumerableN a,

102+ EnumerableN b,

103+ EnumerableN c

118104 )

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

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

@@ -124,11 +110,10 @@ branchD x l r = f x `selectD` g l `selectD` r

124110

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

126112ifD ::

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

128− FLN a a,

129− FLN a (),

130− FLN () a,

131− FLN (Either () a) a

113+ ( Num e,

114+ EqN a,

115+ ConstructN a,

116+ EnumerableN a

132117 )

133118 => Dist Bool -> Dist a -> Dist a -> Dist a

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

@@ -136,12 +121,8 @@ ifD x (D t) (D e) = branchD x' t e

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

137122

138123-- | Monad instance 'return' function

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

140−returnD a = D (col l)

141− where

142− i = fromInteger $ natVal (Proxy :: Proxy (Count a))

143− x = fromEnum a

144− l = take x [0,0..] ++ [1] ++ take (i - x - 1) [0,0..]

124+returnD :: Liftable () a => a -> Dist a

125+returnD = D . returnM

145126

146127-- | Monad instance '(>>=)' function

147128bindD :: Dist a -> Matrix Prob a b -> Dist b

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

151132(??) ::

152133 ( Enum a,

153134 Countable a,

154− FLN () a

135+ FromListsN () a

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

156137(??) p d =

157138 let l = toValues d

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

161142-- Distribution Construction

162143

163144-- | Constructs a Bernoulli distribution

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

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

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

146+choose prob = D (colL [prob, 1 - prob])

166147

167148-- | Creates a distribution given a shape function

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

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

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

170151shape f xs =

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

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

173154 in fromFreqs (zip xs ps)

174155

175156-- | Constructs a Linear distribution

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

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

177158linear = shape id

178159

179160-- | Constructs an Uniform distribution

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

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

181162uniform = shape (const 1)

182163

183164-- | Constructs an Negative Exponential distribution

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

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

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

186167

187168-- | Constructs an Normal distribution

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

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

189170normal = shape (normalCurve 0.5 0.5)

190171

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

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

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

193174toValues (D d) =

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

195176 probs = toList d

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

197178 in res

198179

199180-- | Pretty a distribution

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

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

201182prettyDist d =

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

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

@@ -209,13 +190,13 @@ prettyDist d =

209190 showR n x = show x ++ " "

210191

211192-- | Pretty Print a distribution

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

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

213194prettyPrintDist = putStrLn . prettyDist @a

214195

215196-- Auxiliary functions

216197

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

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

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

199+fromFreqs xs = D (colL (map (\(x,p) -> p/q) xs))

219200 where q = sum $ map snd xs

220201

221202normalCurve :: Prob -> Prob -> Prob -> Prob

src/LAoP/Matrix/Alternative.hsnew file+956

@@ -0,0 +1,956 @@

1+{-# LANGUAGE TypeApplications #-}

2+{-# LANGUAGE LambdaCase #-}

3+{-# LANGUAGE StrictData #-}

4+{-# LANGUAGE TypeFamilyDependencies #-}

5+{-# LANGUAGE ConstraintKinds #-}

6+{-# LANGUAGE AllowAmbiguousTypes #-}

7+{-# LANGUAGE DataKinds #-}

8+{-# LANGUAGE FlexibleContexts #-}

9+{-# LANGUAGE FlexibleInstances #-}

10+{-# LANGUAGE GADTs #-}

11+{-# LANGUAGE InstanceSigs #-}

12+{-# LANGUAGE MultiParamTypeClasses #-}

13+{-# LANGUAGE NoStarIsType #-}

14+{-# LANGUAGE ScopedTypeVariables #-}

15+{-# LANGUAGE StandaloneDeriving #-}

16+{-# LANGUAGE TypeOperators #-}

17+{-# LANGUAGE UndecidableInstances #-}

18+

19+-----------------------------------------------------------------------------

20+-- |

21+-- Module : LAoP.Matrix.Internal

22+-- Copyright : (c) Armando Santos 2019-2020

23+-- Maintainer : armandoifsantos@gmail.com

24+-- Stability : experimental

25+--

26+-- The LAoP discipline generalises relations and functions treating them as

27+-- Boolean matrices and in turn consider these as arrows.

28+--

29+-- __LAoP__ is a library for algebraic (inductive) construction and manipulation of matrices

30+-- in Haskell. See <https://github.com/bolt12/master-thesis my Msc Thesis> for the

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

32+--

33+-- This module offers many of the combinators mentioned in the work of

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

35+--

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

37+--

38+-----------------------------------------------------------------------------

39+

40+module LAoP.Matrix.Alternative

41+ ( -- | This definition makes use of the fact that 'Void' is

42+ -- isomorphic to 0 and '()' to 1 and captures matrix

43+ -- dimensions as stacks of 'Either's.

44+ --

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

46+ -- matrix dimensions: 'FromNat' and 'Count'. This approach

47+ -- leads to a very straightforward implementation

48+ -- of LAoP combinators.

49+

50+ -- * Type safe matrix representation

51+ Matrix (..),

52+

53+ -- * Primitives

54+ empty,

55+ one,

56+ join,

57+ fork,

58+

59+ -- * Auxiliary type families

60+ FromNat,

61+ Count,

62+ Normalize,

63+

64+ -- * Matrix construction and conversion

65+ FromLists,

66+ fromLists,

67+ toLists,

68+ toList,

69+ matrixBuilder,

70+ matrixBuilderN,

71+ rowL,

72+ rowN,

73+ colL,

74+ colN,

75+ zeros,

76+ ones,

77+ bang,

78+ point,

79+ constant,

80+

81+ -- * Misc

82+ -- ** Get dimensions

83+ columns,

84+ rows,

85+

86+ -- ** Matrix Transposition

87+ tr,

88+

89+ -- ** Scalar multiplication/division of matrices

90+ (.|),

91+ (./),

92+

93+ -- ** Selective operator

94+ select,

95+ branch,

96+

97+ -- ** McCarthy's Conditional

98+ -- cond,

99+

100+ -- ** Matrix "abiding"

101+ abideJF,

102+ abideFJ,

103+

104+ -- ** Zip matrices

105+ zipWithM,

106+

107+ -- * Biproduct approach

108+ -- ** Fork

109+ (===),

110+ -- *** Projections

111+ p1,

112+ p2,

113+ -- ** Join

114+ (|||),

115+ -- *** Injections

116+ i1,

117+ i2,

118+ -- ** Bifunctors

119+ (-|-),

120+ (><),

121+

122+ -- ** Applicative matrix combinators

123+

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

125+ -- implement the standard type classes present in standard Haskell.

126+ -- *** Matrix pairing projections

127+ fstM,

128+ sndM,

129+

130+ -- *** Matrix pairing

131+ kr,

132+

133+ -- * Matrix composition and lifting

134+

135+ -- ** Arrow matrix combinators

136+

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

138+ -- implement the standard type classes present in standard Haskell.

139+ iden,

140+ comp,

141+ fromF,

142+ fromFN,

143+

144+ -- * Matrix printing

145+ pretty,

146+ prettyPrint,

147+

148+ -- * Other

149+ toBool,

150+ fromBool,

151+ compRel,

152+ divR,

153+ divL,

154+ divS,

155+ fromFRelN,

156+ toRelN,

157+ negateM,

158+ orM,

159+ andM,

160+ subM,

161+

162+ -- * Semantics

163+ Vector(..),

164+ LinearMap,

165+ Construct

166+ )

167+ where

168+

169+import LAoP.Utils.Internal

170+import Data.Bool

171+import Data.Functor.Contravariant

172+import Data.Kind

173+import Data.List

174+import Data.Maybe

175+import Data.Proxy

176+import Data.Void

177+import GHC.TypeLits

178+import Data.Type.Equality

179+import GHC.Generics

180+import Control.DeepSeq

181+import Prelude hiding (id, (.))

182+

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

184+data Matrix e cols rows where

185+ Empty :: Matrix e Void Void

186+ One :: e -> Matrix e () ()

187+ Join :: Matrix e a rows -> Matrix e b rows -> Matrix e (Either a b) rows

188+ Fork :: Matrix e cols a -> Matrix e cols b -> Matrix e cols (Either a b)

189+

190+deriving instance (Show e) => Show (Matrix e cols rows)

191+

192+-- | Type family that computes the cardinality of a given type dimension.

193+--

194+-- It can also count the cardinality of custom types that implement the

195+-- 'Generic' instance.

196+type family Count (d :: Type) :: Nat where

197+ Count (Natural n m) = (m - n) + 1

198+ Count (List a) = (^) 2 (Count a)

199+ Count (Either a b) = (+) (Count a) (Count b)

200+ Count (a, b) = (*) (Count a) (Count b)

201+ Count (a -> b) = (^) (Count b) (Count a)

202+ -- Generics

203+ Count (M1 _ _ f p) = Count (f p)

204+ Count (K1 _ _ _) = 1

205+ Count (V1 _) = 0

206+ Count (U1 _) = 1

207+ Count ((:*:) a b p) = Count (a p) * Count (b p)

208+ Count ((:+:) a b p) = Count (a p) + Count (b p)

209+ Count d = Count (Rep d R)

210+

211+-- | Type family that computes of a given type dimension from a given natural

212+--

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

214+type family FromNat (n :: Nat) :: Type where

215+ FromNat 0 = Void

216+ FromNat 1 = ()

217+ FromNat n = FromNat' (Mod n 2 == 0) (FromNat (Div n 2))

218+

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

220+ FromNat' 'True m = Either m m

221+ FromNat' 'False m = Either () (Either m m)

222+

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

224+-- structure

225+type family Normalize (d :: Type) :: Type where

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

227+ Normalize d = FromNat (Count d)

228+

229+-- | Constraint type synonyms to keep the type signatures less convoluted

230+type Countable a = KnownNat (Count a)

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

232+type Liftable a b = (Eq b, Constructable a b, Enumerable a)

233+type Enumerable a = (Enum a, Bounded a)

234+type ConstructNorm a = (Enum a, Enum (Normalize a))

235+type ConstructableNorm a b = (ConstructNorm a, ConstructNorm b)

236+type ConstructN a = Construct (Normalize a)

237+type Constructable a b = (Construct a, Construct b)

238+type ConstructableN a b = (Construct (Normalize a), Construct (Normalize b))

239+

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

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

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

243+--

244+-- Please use 'iden' instead.

245+instance (Num e) => Category (Matrix e) where

246+ type Object (Matrix e) a = Liftable a a

247+ id = iden

248+ (.) = comp

249+

250+instance NFData e => NFData (Matrix e cols rows) where

251+ rnf Empty = ()

252+ rnf (One e) = rnf e

253+ rnf (Join a b) = rnf a `seq` rnf b

254+ rnf (Fork a b) = rnf a `seq` rnf b

255+

256+instance Eq e => Eq (Matrix e cols rows) where

257+ Empty == Empty = True

258+ (One a) == (One b) = a == b

259+ (Join a b) == (Join c d) = a == c && b == d

260+ (Fork a b) == (Fork c d) = a == c && b == d

261+ x@(Fork _ _) == y@(Join _ _) = x == abideJF y

262+ x@(Join _ _) == y@(Fork _ _) = abideJF x == y

263+

264+instance Num e => Num (Matrix e cols rows) where

265+

266+ a + b = zipWithM (+) a b

267+

268+ a - b = zipWithM (-) a b

269+

270+ a * b = zipWithM (*) a b

271+

272+ abs Empty = Empty

273+ abs (One a) = One (abs a)

274+ abs (Join a b) = Join (abs a) (abs b)

275+ abs (Fork a b) = Fork (abs a) (abs b)

276+

277+ signum Empty = Empty

278+ signum (One a) = One (signum a)

279+ signum (Join a b) = Join (signum a) (signum b)

280+ signum (Fork a b) = Fork (signum a) (signum b)

281+

282+instance Ord e => Ord (Matrix e cols rows) where

283+ Empty <= Empty = True

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

285+ (Join a b) <= (Join c d) = (a <= c) && (b <= d)

286+ (Fork a b) <= (Fork c d) = (a <= c) && (b <= d)

287+ x@(Fork _ _) <= y@(Join _ _) = x <= abideJF y

288+ x@(Join _ _) <= y@(Fork _ _) = abideJF x <= y

289+

290+-- Primitives

291+

292+-- | Empty matrix constructor

293+empty :: Matrix e Void Void

294+empty = Empty

295+

296+-- | Unit matrix constructor

297+one :: e -> Matrix e () ()

298+one = One

299+

300+-- | Matrix 'Join' constructor

301+join :: Matrix e a rows -> Matrix e b rows -> Matrix e (Either a b) rows

302+join = Join

303+

304+infixl 3 |||

305+

306+-- | Matrix 'Join' constructor

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

308+(|||) = Join

309+

310+-- | Matrix 'Fork' constructor

311+fork :: Matrix e cols a -> Matrix e cols b -> Matrix e cols (Either a b)

312+fork = Fork

313+

314+infixl 2 ===

315+

316+-- | Matrix 'Fork' constructor

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

318+(===) = Fork

319+

320+-- Construction

321+

322+-- | Constructs a column vector matrix

323+colL :: (FromLists e () rows) => [e] -> Matrix e () rows

324+colL = fromLists . map (: [])

325+

326+-- | Constructs a row vector matrix

327+rowL :: (FromLists e cols ()) => [e] -> Matrix e cols ()

328+rowL = fromLists . (: [])

329+

330+-- Conversion

331+

332+-- | Converts a matrix to a list of lists of elements.

333+toLists :: Matrix e cols rows -> [[e]]

334+toLists Empty = []

335+toLists (One e) = [[e]]

336+toLists (Fork l r) = toLists l ++ toLists r

337+toLists (Join l r) = zipWith (++) (toLists l) (toLists r)

338+

339+-- | Converts a matrix to a list of elements.

340+toList :: Matrix e cols rows -> [e]

341+toList = concat . toLists

342+

343+-- Zeros Matrix

344+

345+-- | The zero matrix. A matrix wholly filled with zeros.

346+zeros :: (Num e, Constructable cols rows, Enumerable cols) => Matrix e cols rows

347+zeros = matrixBuilder (const 0)

348+

349+-- Ones Matrix

350+

351+-- | The ones matrix. A matrix wholly filled with ones.

352+--

353+-- Also known as T (Top) matrix.

354+ones :: (Num e, Constructable cols rows, Enumerable cols) => Matrix e cols rows

355+ones = matrixBuilder (const 1)

356+

357+-- Const Matrix

358+

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

360+-- value.

361+constant :: (Num e, Constructable cols rows, Enumerable cols) => e -> Matrix e cols rows

362+constant e = matrixBuilder (const e)

363+

364+-- Bang Matrix

365+

366+-- | The T (Top) row vector matrix.

367+bang :: (Num e, Constructable cols rows, Enumerable cols) => Matrix e cols ()

368+bang = ones

369+

370+-- | Point constant matrix

371+point :: (Num e, Liftable () a) => a -> Matrix e () a

372+point = fromF . const

373+

374+-- iden Matrix

375+

376+-- | iden matrix.

377+iden :: (Num e, Liftable cols cols) => Matrix e cols cols

378+iden = fromF id

379+

380+-- Matrix composition (MMM)

381+

382+-- | Matrix composition. Equivalent to matrix-matrix multiplication.

383+--

384+-- This definition takes advantage of divide-and-conquer and fusion laws

385+-- from LAoP.

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

387+comp Empty Empty = Empty

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

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

390+comp (Fork a b) c = Fork (comp a c) (comp b c) -- Fork fusion law

391+comp c (Join a b) = Join (comp c a) (comp c b) -- Join fusion law

392+{-# NOINLINE comp #-}

393+{-# RULES

394+ "comp/iden1" forall m. comp m iden = m ;

395+ "comp/iden2" forall m. comp iden m = m

396+#-}

397+

398+-- Scalar multiplication of matrices

399+

400+infixl 7 .|

401+-- | Scalar multiplication of matrices.

402+(.|) :: Num e => e -> Matrix e cols rows -> Matrix e cols rows

403+(.|) _ Empty = Empty

404+(.|) e (One a) = One (e * a)

405+(.|) e (Join a b) = Join (e .| a) (e .| b)

406+(.|) e (Fork a b) = Fork (e .| a) (e .| b)

407+

408+-- Scalar division of matrices

409+

410+infixl 7 ./

411+-- | Scalar multiplication of matrices.

412+(./) :: Fractional e => Matrix e cols rows -> e -> Matrix e cols rows

413+(./) Empty _ = Empty

414+(./) (One a) e = One (a / e)

415+(./) (Join a b) e = Join (a ./ e) (b ./ e)

416+(./) (Fork a b) e = Fork (a ./ e) (b ./ e)

417+

418+-- Projections

419+

420+-- | Biproduct first component projection

421+p1 :: (Num e, Eq m, Constructable m n, Enumerable m, Enumerable n) => Matrix e (Either m n) m

422+p1 = join iden zeros

423+

424+-- | Biproduct second component projection

425+p2 :: (Num e, Eq n, Constructable m n, Enumerable m, Enumerable n) => Matrix e (Either m n) n

426+p2 = join zeros iden

427+

428+-- Injections

429+

430+-- | Biproduct first component injection

431+i1 :: (Num e, Eq m, Constructable m n, Enumerable m, Enumerable n) => Matrix e m (Either m n)

432+i1 = tr p1

433+

434+-- | Biproduct second component injection

435+i2 :: (Num e, Eq n, Constructable m n, Enumerable m, Enumerable n) => Matrix e n (Either m n)

436+i2 = tr p2

437+

438+-- Dimensions

439+

440+-- | Obtain the number of rows.

441+--

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

443+-- dimensions in constant time.

444+--

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

446+-- exchange for performance.

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

448+rows _ = fromInteger $ natVal (Proxy :: Proxy (Count rows))

449+

450+-- | Obtain the number of columns.

451+--

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

453+-- dimensions in constant time.

454+--

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

456+-- exchange for performance.

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

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

459+

460+-- Coproduct Bifunctor

461+

462+infixl 5 -|-

463+

464+-- | Matrix coproduct functor also known as matrix direct sum.

465+(-|-) ::

466+ ( Num e,

467+ Eq k,

468+ Eq j,

469+ Constructable k j,

470+ Enumerable k,

471+ Enumerable j

472+ ) => Matrix e n k -> Matrix e m j -> Matrix e (Either n m) (Either k j)

473+(-|-) a b = Join (i1 . a) (i2 . b)

474+

475+-- Khatri Rao Product and projections

476+

477+-- | Khatri Rao product first component projection matrix.

478+fstM ::

479+ forall e a b .

480+ ( Num e,

481+ Eq a,

482+ ConstructableN (a, b) a,

483+ ConstructableNorm (a, b) a,

484+ Enumerable a,

485+ Enumerable b

486+ ) => Matrix e (Normalize (a, b)) (Normalize a)

487+fstM = fromFN (fst :: (a, b) -> a)

488+

489+-- | Khatri Rao product second component projection matrix.

490+sndM ::

491+ forall e a b .

492+ ( Num e,

493+ Eq b,

494+ ConstructableN (a, b) b,

495+ ConstructableNorm (a, b) b,

496+ Enumerable a,

497+ Enumerable b

498+ ) => Matrix e (Normalize (a, b)) (Normalize b)

499+sndM = fromFN (snd :: (a, b) -> b)

500+

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

502+--

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

504+--

505+-- @

506+-- | fstM . kr a b == a

507+-- kr a b ==> |

508+-- | sndM . kr a b == b

509+-- @

510+--

511+-- __Emphasis__ on the implication symbol.

512+kr ::

513+ forall e cols a b .

514+ ( Num e,

515+ Eq a,

516+ Eq b,

517+ ConstructableN a (a, b),

518+ ConstructN b,

519+ ConstructableNorm a b,

520+ ConstructNorm (a, b),

521+ Enumerable a,

522+ Enumerable b

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

524+kr a b =

525+ let fstM' = fstM @e @a @b

526+ sndM' = sndM @e @a @b

527+ in (tr fstM' . a) * (tr sndM' . b)

528+

529+-- Product Bifunctor (Kronecker)

530+

531+infixl 4 ><

532+

533+type Kronecker e m n p q =

534+ ( Num e,

535+ Eq m,

536+ Eq n,

537+ Eq p,

538+ Eq q,

539+ ConstructableN m n,

540+ ConstructableNorm m (m, n),

541+ ConstructNorm n,

542+ ConstructN (m, n),

543+ ConstructableN p q,

544+ ConstructableNorm p (p, q),

545+ ConstructNorm q,

546+ ConstructN (p, q),

547+ Enumerable m,

548+ Enumerable n,

549+ Enumerable p,

550+ Enumerable q

551+ )

552+

553+-- | Matrix product functor also known as kronecker product

554+(><) ::

555+ forall e m p n q .

556+ Kronecker e m n p q

557+ => Matrix e (Normalize m) (Normalize p)

558+ -> Matrix e (Normalize n) (Normalize q)

559+ -> Matrix e (Normalize (m, n)) (Normalize (p, q))

560+(><) a b =

561+ let fstM' = fstM @e @m @n

562+ sndM' = sndM @e @m @n

563+ in kr @e @(Normalize (m, n)) @p @q (a . fstM') (b . sndM')

564+

565+-- Matrix abide Join Fork

566+

567+-- | Matrix "abiding" following the 'Join'-'Fork' exchange law.

568+--

569+-- Law:

570+--

571+-- @

572+-- 'Join' ('Fork' a c) ('Fork' b d) == 'Fork' ('Join' a b) ('Join' c d)

573+-- @

574+abideJF :: Matrix e cols rows -> Matrix e cols rows

575+abideJF (Join (Fork a c) (Fork b d)) = Fork (Join (abideJF a) (abideJF b)) (Join (abideJF c) (abideJF d)) -- Join-Fork abide law

576+abideJF Empty = Empty

577+abideJF (One e) = One e

578+abideJF (Join a b) = Join (abideJF a) (abideJF b)

579+abideJF (Fork a b) = Fork (abideJF a) (abideJF b)

580+

581+-- Matrix abide Fork Join

582+

583+-- | Matrix "abiding" followin the 'Fork'-'Join' abide law.

584+--

585+-- @

586+-- 'Fork' ('Join' a b) ('Join' c d) == 'Join' ('Fork' a c) ('Fork' b d)

587+-- @

588+abideFJ :: Matrix e cols rows -> Matrix e cols rows

589+abideFJ (Fork (Join a b) (Join c d)) = Join (Fork (abideFJ a) (abideFJ c)) (Fork (abideFJ b) (abideFJ d)) -- Fork-Join abide law

590+abideFJ Empty = Empty

591+abideFJ (One e) = One e

592+abideFJ (Join a b) = Join (abideFJ a) (abideFJ b)

593+abideFJ (Fork a b) = Fork (abideFJ a) (abideFJ b)

594+

595+-- Matrix transposition

596+

597+-- | Matrix transposition.

598+tr :: Matrix e cols rows -> Matrix e rows cols

599+tr Empty = Empty

600+tr (One e) = One e

601+tr (Join a b) = Fork (tr a) (tr b)

602+tr (Fork a b) = Join (tr a) (tr b)

603+

604+-- Selective 'select' operator

605+

606+-- | Selective functors 'select' operator equivalent inspired by the

607+-- ArrowMonad solution presented in the paper.

608+select :: (Num e, Liftable b b) => Matrix e cols (Either a b) -> Matrix e a b -> Matrix e cols b

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

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

611+select m y = join y id . m

612+

613+branch ::

614+ ( Num e,

615+ Eq a,

616+ Eq b,

617+ Eq c,

618+ Constructable a b,

619+ Construct c,

620+ Enumerable a,

621+ Enumerable b,

622+ Enumerable c

623+ )

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

625+branch x l r = f x `select` g l `select` r

626+ where

627+ f m = fork (tr i1) (i1 . tr i2) . m

628+ g m = i2 . m

629+

630+-- Pretty print

631+

632+prettyAux :: Show e => [[e]] -> [[e]] -> String

633+prettyAux [] _ = ""

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

635+ where

636+ v = fmap show m

637+ widest = maximum $ fmap length v

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

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

640+ where

641+ v = fmap show m

642+ widest = maximum $ fmap length v

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

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

645+ prettyAux t l

646+ where

647+ v = fmap show l

648+ widest = maximum $ fmap length v

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

650+

651+-- | Matrix pretty printer

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

653+pretty m = concat

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

655+ , unlines

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

657+ , "└ ", unwords (replicate (columns m) blank), " ┘"

658+ ]

659+ where

660+ strings = map show (toList m)

661+ widest = maximum $ map length strings

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

663+ blank = fill ""

664+ safeGet i j m

665+ | i > rows m || j > columns m || i < 1 || j < 1 = Nothing

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

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

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

669+ getElem i j m =

670+ fromMaybe

671+ (error $

672+ "getElem: Trying to get the "

673+ ++ show (i, j)

674+ ++ " element from a "

675+ ++ show (rows m) ++ "x" ++ show (columns m)

676+ ++ " matrix."

677+ )

678+ (safeGet i j m)

679+

680+-- | Matrix pretty printer

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

682+prettyPrint = putStrLn . pretty

683+

684+-- | Zip two matrices with a given binary function

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

686+zipWithM _ Empty Empty = Empty

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

688+zipWithM f (Join a b) (Join c d) = Join (zipWithM f a c) (zipWithM f b d)

689+zipWithM f (Fork a b) (Fork c d) = Fork (zipWithM f a c) (zipWithM f b d)

690+zipWithM f x@(Fork _ _) y@(Join _ _) = zipWithM f x (abideJF y)

691+zipWithM f x@(Join _ _) y@(Fork _ _) = zipWithM f (abideJF x) y

692+

693+-- Relational operators functions

694+

695+type Boolean = Natural 0 1

696+type Relation a b = Matrix Boolean a b

697+

698+-- | Helper conversion function

699+toBool :: (Num e, Eq e) => e -> Bool

700+toBool n

701+ | n == 0 = False

702+ | n == 1 = True

703+

704+-- | Helper conversion function

705+fromBool :: Bool -> Natural 0 1

706+fromBool True = nat 1

707+fromBool False = nat 0

708+

709+-- | Relational negation

710+negateM :: Relation cols rows -> Relation cols rows

711+negateM Empty = Empty

712+negateM (One (Nat p)) = One (Nat (negate p))

713+negateM (Join a b) = Join (negateM a) (negateM b)

714+negateM (Fork a b) = Fork (negateM a) (negateM b)

715+

716+-- | Relational addition

717+orM :: Relation cols rows -> Relation cols rows -> Relation cols rows

718+orM Empty Empty = Empty

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

720+orM (Join a b) (Join c d) = Join (orM a c) (orM b d)

721+orM (Fork a b) (Fork c d) = Fork (orM a c) (orM b d)

722+orM x@(Fork _ _) y@(Join _ _) = orM x (abideJF y)

723+orM x@(Join _ _) y@(Fork _ _) = orM (abideJF x) y

724+

725+-- | Relational multiplication

726+andM :: Relation cols rows -> Relation cols rows -> Relation cols rows

727+andM Empty Empty = Empty

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

729+andM (Join a b) (Join c d) = Join (andM a c) (andM b d)

730+andM (Fork a b) (Fork c d) = Fork (andM a c) (andM b d)

731+andM x@(Fork _ _) y@(Join _ _) = andM x (abideJF y)

732+andM x@(Join _ _) y@(Fork _ _) = andM (abideJF x) y

733+

734+-- | Relational subtraction

735+subM :: Relation cols rows -> Relation cols rows -> Relation cols rows

736+subM Empty Empty = Empty

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

738+subM (Join a b) (Join c d) = Join (subM a c) (subM b d)

739+subM (Fork a b) (Fork c d) = Fork (subM a c) (subM b d)

740+subM x@(Fork _ _) y@(Join _ _) = subM x (abideJF y)

741+subM x@(Join _ _) y@(Fork _ _) = subM (abideJF x) y

742+

743+-- | Matrix relational composition.

744+compRel :: Relation cr rows -> Relation cols cr -> Relation cols rows

745+compRel Empty Empty = Empty

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

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

748+compRel (Fork a b) c = Fork (compRel a c) (compRel b c) -- Fork fusion law

749+compRel c (Join a b) = Join (compRel c a) (compRel c b) -- Join fusion law

750+

751+-- | Matrix relational right division

752+divR :: Relation b c -> Relation b a -> Relation a c

753+divR Empty Empty = Empty

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

755+divR (Join a b) (Join c d) = andM (divR a c) (divR b d)

756+divR (Fork a b) c = Fork (divR a c) (divR b c)

757+divR c (Fork a b) = Join (divR c a) (divR c b)

758+

759+-- | Matrix relational left division

760+divL :: Relation c b -> Relation a b -> Relation a c

761+divL x y = tr (divR (tr y) (tr x))

762+

763+-- | Matrix relational symmetric division

764+divS :: Relation c a -> Relation b a -> Relation c b

765+divS s r = divL r s `intersection` divR (tr r) (tr s)

766+ where

767+ intersection = andM

768+

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

770+-- cardinality's.

771+fromFRelN ::

772+ ( Eq b,

773+ ConstructableNorm a b,

774+ ConstructableN a b,

775+ Enumerable a

776+ )

777+ => (a -> b) -> Relation (Normalize a) (Normalize b)

778+fromFRelN = fromFN

779+

780+-- | Lifts a relation function to a Boolean Matrix

781+toRelN ::

782+ ( ConstructableN a b,

783+ ConstructableNorm a b,

784+ Enumerable a

785+ )

786+ => (a -> b -> Bool) -> Relation (Normalize a) (Normalize b)

787+toRelN f = matrixBuilderN (\a -> if uncurry f a then 1 else 0)

788+

789+----------------------------- Linear map semantics -----------------------------

790+newtype Vector e a = Vector { at :: a -> e }

791+

792+instance Contravariant (Vector e) where

793+ contramap f (Vector g) = Vector (g . f)

794+

795+instance Num e => Num (Vector e a) where

796+ fromInteger = Vector . const . fromInteger

797+

798+ (+) = liftV2 (+)

799+ (-) = liftV2 (-)

800+ (*) = liftV2 (*)

801+ abs = liftV1 abs

802+ negate = liftV1 negate

803+ signum = error "No sensible definition"

804+

805+liftV1 :: (e -> e) -> Vector e a -> Vector e a

806+liftV1 f x = Vector (f . at x)

807+

808+liftV2 :: (e -> e -> e) -> Vector e a -> Vector e a -> Vector e a

809+liftV2 f x y = Vector (\a -> f (at x a) (at y a))

810+

811+-- Semantics of Matrix e a b

812+type LinearMap e a b = Vector e a -> Vector e b

813+

814+semantics :: Num e => Matrix e a b -> LinearMap e a b

815+semantics m = case m of

816+ Empty -> id

817+ One e -> const (Vector (const e))

818+ Join x y -> \v -> semantics x (Left >$< v) + semantics y (Right >$< v)

819+ Fork x y -> \v -> Vector $ either (at (semantics x v)) (at (semantics y v))

820+

821+padLeft :: Num e => Vector e b -> Vector e (Either a b)

822+padLeft v = Vector $ \case Left _ -> 0

823+ Right b -> at v b

824+

825+padRight :: Num e => Vector e a -> Vector e (Either a b)

826+padRight v = Vector $ \case Left a -> at v a

827+ Right _ -> 0

828+

829+dot :: (Num e, Enumerable a) => Vector e a -> Vector e a -> e

830+dot x y = sum [ at x a * at y a | a <- enumerate ]

831+

832+--------------------------------- Construction ---------------------------------

833+

834+class Construct a where

835+ row :: Num e => Vector e a -> Matrix e a ()

836+

837+ linearMap :: (Construct b, Num e) => LinearMap e a b -> Matrix e a b

838+

839+instance Construct () where

840+ row v = one (at v ())

841+

842+ linearMap m = col (m 1)

843+

844+instance (Constructable a b) => Construct (Either a b) where

845+ row v = row (Left >$< v) ||| row (Right >$< v)

846+

847+ linearMap m = linearMap (m . padRight) ||| linearMap (m . padLeft)

848+

849+col :: (Construct a, Num e) => Vector e a -> Matrix e () a

850+col = tr . row

851+

852+-- | Matrix builder function. Constructs a matrix provided with

853+-- a construction function that operates with canonical types.

854+matrixBuilder :: (Num e, Constructable a b, Enumerable a) => ((a, b) -> e) -> Matrix e a b

855+matrixBuilder f = linearMap $ \v -> Vector $ \b -> dot v $ Vector $ \a -> f (a, b)

856+

857+-- | Lifts functions to matrices.

858+fromF :: (Num e, Liftable a b) => (a -> b) -> Matrix e a b

859+fromF f = matrixBuilder (\(a, b) -> if f a == b then 1 else 0)

860+

861+-------------------------------- Deconstruction --------------------------------

862+enumerate :: Enumerable a => [a]

863+enumerate = [minBound .. maxBound]

864+

865+basis :: (Enumerable a, Eq a, Num e) => [Vector e a]

866+basis = [ Vector (bool 0 1 . (==a)) | a <- enumerate ]

867+

868+toLists' :: (Enumerable a, Enumerable b, Eq a, Num e) => Matrix e a b -> [[e]]

869+toLists' m = transpose

870+ [ [ at r i | i <- enumerate ] | c <- basis, let r = semantics m c ]

871+

872+dump :: (Enumerable a, Enumerable b, Eq a, Num e, Show e) => Matrix e a b -> IO ()

873+dump = mapM_ print . toLists'

874+

875+------------------------------- Normalised types -------------------------------

876+class Profunctor p where

877+ dimap :: (a -> b) -> (c -> d) -> p b c -> p a d

878+

879+instance Profunctor (->) where

880+ dimap f g h = g . h . f

881+

882+toNorm :: ConstructNorm a => a -> Normalize a

883+toNorm = toEnum . fromEnum

884+

885+fromNorm :: ConstructNorm a => Normalize a -> a

886+fromNorm = toEnum . fromEnum

887+

888+rowN :: (ConstructN a, ConstructNorm a, Num e) => Vector e a -> Matrix e (Normalize a) ()

889+rowN = row . contramap fromNorm

890+

891+linearMapN :: (ConstructableN a b, ConstructableNorm a b, Num e)

892+ => LinearMap e a b -> Matrix e (Normalize a) (Normalize b)

893+linearMapN = linearMap . dimap (contramap toNorm) (contramap fromNorm)

894+

895+colN :: (ConstructN a, ConstructNorm a, Num e) => Vector e a -> Matrix e () (Normalize a)

896+colN = tr . rowN

897+

898+-- | Matrix builder function. Constructs a matrix provided with

899+-- a construction function that operates with arbitrary types.

900+matrixBuilderN :: (Num e, ConstructableN a b, ConstructableNorm a b, Enumerable a)

901+ => ((a, b) -> e) -> Matrix e (Normalize a) (Normalize b)

902+matrixBuilderN f = linearMapN $ \v -> Vector $ \b -> dot v $ Vector $ \a -> f (a, b)

903+

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

905+-- cardinality's.

906+fromFN :: (Num e, Eq b, ConstructableN a b, ConstructableNorm a b, Enumerable a)

907+ => (a -> b) -> Matrix e (Normalize a) (Normalize b)

908+fromFN f = matrixBuilderN (\(a, b) -> if f a == b then 1 else 0)

909+

910+------------------------------- Unsafe fromLists matrix construction -------------------------------

911+

912+-- | Type class for defining the 'fromList' conversion function.

913+--

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

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

916+class FromLists e cols rows where

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

918+ -- error if the dimensions do not match.

919+ fromLists :: [[e]] -> Matrix e cols rows

920+

921+instance FromLists e Void Void where

922+ fromLists [] = Empty

923+ fromLists _ = error "Wrong dimensions"

924+

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

926+ fromLists [[e]] = One e

927+ fromLists _ = error "Wrong dimensions"

928+

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

930+ fromLists [h : t] = Join (One h) (fromLists [t])

931+ fromLists _ = error "Wrong dimensions"

932+

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

934+ fromLists [l] =

935+ let rowsA = fromInteger (natVal (Proxy :: Proxy (Count a)))

936+ in Join (fromLists [take rowsA l]) (fromLists [drop rowsA l])

937+ fromLists _ = error "Wrong dimensions"

938+

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

940+ fromLists ([h] : t) = Fork (One h) (fromLists t)

941+ fromLists _ = error "Wrong dimensions"

942+

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

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

945+ let rowsA = fromInteger (natVal (Proxy :: Proxy (Count a)))

946+ in Fork (fromLists (take rowsA l)) (fromLists (drop rowsA l))

947+ fromLists _ = error "Wrong dimensions"

948+

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

950+ fromLists l@(h : t) =

951+ let lh = length h

952+ rowsC = fromInteger (natVal (Proxy :: Proxy (Count c)))

953+ condition = all ((== lh) . length) t

954+ in if lh > 0 && condition

955+ then Fork (fromLists (take rowsC l)) (fromLists (drop rowsC l))

956+ else error "Not all rows have the same length"

src/LAoP/Matrix/Internal.hs+191−130

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

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

3131--

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

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

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

3434--

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

3636--

@@ -43,23 +43,23 @@ module LAoP.Matrix.Internal

4343 --

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

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

46− -- leads to a very straightforward implementation

47− -- of LAoP combinators.

46+ -- leads to a very straightforward implementation

47+ -- of LAoP combinators.

4848

4949 -- * Type safe matrix representation

5050 Matrix (..),

5151

5252 -- * Constraint type aliases

5353 Countable,

54− CountableDims,

54+ CountableDimensions,

5555 CountableN,

56− CountableDimsN,

57− FL,

58− FLN,

56+ CountableDimensionsN,

57+ FromListsN,

5958 Liftable,

6059 Trivial,

6160

6261 -- * Primitives

62+ empty,

6363 one,

6464 join,

6565 fork,

@@ -86,9 +86,7 @@ module LAoP.Matrix.Internal

8686 -- * Misc

8787 -- ** Get dimensions

8888 columns,

89− columns',

9089 rows,

91− rows',

9290

9391 -- ** Matrix Transposition

9492 tr,

@@ -176,7 +174,6 @@ import Data.Kind

176174import Data.List

177175import Data.Maybe

178176import Data.Proxy

179−import Data.Typeable

180177import Data.Void

181178import GHC.TypeLits

182179import Data.Type.Equality

@@ -187,6 +184,7 @@ import qualified Prelude (id, (.))

187184

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

189186data Matrix e cols rows where

187+ Empty :: Matrix e Void Void

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

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

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

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

216214--

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

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

217+ FromNat 0 = Void

219218 FromNat 1 = ()

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

221220

@@ -232,26 +231,27 @@ type family Normalize (d :: Type) :: Type where

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

233232type Countable a = KnownNat (Count a)

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

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

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

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

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

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

241239

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

243241-- class.

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

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

246− id = iden

243+ type Object (Matrix e) a = (FromLists e a a, Countable a)

244+ id = iden

247245 (.) = comp

248246

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

248+ rnf Empty = ()

250249 rnf (One e) = rnf e

251250 rnf (Join a b) = rnf a `seq` rnf b

252251 rnf (Fork a b) = rnf a `seq` rnf b

253252

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

254+ Empty == Empty = True

255255 (One a) == (One b) = a == b

256256 (Join a b) == (Join c d) = a == c && b == d

257257 (Fork a b) == (Fork c d) = a == c && b == d

@@ -259,21 +259,25 @@ instance Eq e => Eq (Matrix e cols rows) where

259259 x@(Join _ _) == y@(Fork _ _) = abideJF x == y

260260

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

262+

262263 a + b = zipWithM (+) a b

263264

264265 a - b = zipWithM (-) a b

265266

266267 a * b = zipWithM (*) a b

267268

269+ abs Empty = Empty

268270 abs (One a) = One (abs a)

269271 abs (Join a b) = Join (abs a) (abs b)

270272 abs (Fork a b) = Fork (abs a) (abs b)

271273

274+ signum Empty = Empty

272275 signum (One a) = One (signum a)

273276 signum (Join a b) = Join (signum a) (signum b)

274277 signum (Fork a b) = Fork (signum a) (signum b)

275278

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

280+ Empty <= Empty = True

277281 (One a) <= (One b) = a <= b

278282 (Join a b) <= (Join c d) = (a <= c) && (b <= d)

279283 (Fork a b) <= (Fork c d) = (a <= c) && (b <= d)

@@ -282,6 +286,10 @@ instance Ord e => Ord (Matrix e cols rows) where

282286

283287-- Primitives

284288

289+-- | Empty matrix constructor

290+empty :: Matrix e Void Void

291+empty = Empty

292+

285293-- | Unit matrix constructor

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

287295one = One

@@ -312,39 +320,40 @@ infixl 2 ===

312320--

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

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

315−class FromLists cols rows where

323+class FromLists e cols rows where

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

317325 -- error if the dimensions do not match.

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

319327

320−instance FromLists () () where

328+instance FromLists e Void Void where

329+ fromLists [] = Empty

330+ fromLists _ = error "Wrong dimensions"

331+

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

321333 fromLists [[e]] = One e

322334 fromLists _ = error "Wrong dimensions"

323335

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

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

325337 fromLists [h : t] = Join (One h) (fromLists [t])

326338 fromLists _ = error "Wrong dimensions"

327339

328−instance {-# OVERLAPPABLE #-}

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

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

330341 fromLists [l] =

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

332343 in Join (fromLists [take rowsA l]) (fromLists [drop rowsA l])

333344 fromLists _ = error "Wrong dimensions"

334345

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

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

336347 fromLists ([h] : t) = Fork (One h) (fromLists t)

337348 fromLists _ = error "Wrong dimensions"

338349

339−instance {-# OVERLAPPABLE #-}

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

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

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

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

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

343353 in Fork (fromLists (take rowsA l)) (fromLists (drop rowsA l))

344354 fromLists _ = error "Wrong dimensions"

345355

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

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

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

348357 fromLists l@(h : t) =

349358 let lh = length h

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

@@ -357,8 +366,8 @@ instance (FromLists (Either a b) c, FromLists (Either a b) d, Countable c)

357366-- a construction function that operates with indices.

358367matrixBuilder' ::

359368 forall e cols rows.

360− ( FL cols rows,

361− CountableDims cols rows

369+ ( FromLists e cols rows,

370+ CountableDimensions cols rows

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

363372matrixBuilder' f =

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

@@ -370,16 +379,17 @@ matrixBuilder' f =

370379-- a construction function that operates with arbitrary types.

371380matrixBuilder ::

372381 forall e a b.

373− ( FLN a b,

382+ ( FromListsN e a b,

383+ CountableN b,

374384 Enum a,

375385 Enum b,

376386 Bounded a,

377387 Bounded b,

378388 Eq a,

379− Countable b

389+ CountableDimensionsN a b

380390 ) => ((a, b) -> e) -> Matrix e (Normalize a) (Normalize b)

381391matrixBuilder f =

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

392+ let r = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize b)))

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

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

385395 where

@@ -387,11 +397,11 @@ matrixBuilder f =

387397 buildList r l = take r l : buildList r (drop r l)

388398

389399-- | Constructs a column vector matrix

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

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

391401col = fromLists . map (: [])

392402

393403-- | Constructs a row vector matrix

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

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

395405row = fromLists . (: [])

396406

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

@@ -401,8 +411,8 @@ row = fromLists . (: [])

401411fromF' ::

402412 forall a b cols rows e.

403413 ( Liftable e a b,

404− CountableDims cols rows,

405− FL rows cols

414+ CountableDimensions cols rows,

415+ FromLists e rows cols

406416 ) =>

407417 (a -> b) ->

408418 Matrix e cols rows

@@ -430,17 +440,35 @@ fromF' f =

430440fromF ::

431441 forall a b e.

432442 ( Liftable e a b,

433− CountableDimsN a b,

434− FLN b a

443+ CountableDimensionsN a b,

444+ FromListsN e b a

435445 ) =>

436446 (a -> b) ->

437447 Matrix e (Normalize a) (Normalize b)

438−fromF = fromF'

448+fromF f =

449+ let minA = minBound @a

450+ maxA = maxBound @a

451+ minB = minBound @b

452+ maxB = maxBound @b

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

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

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

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

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

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

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

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

461+ mList = buildList combAp rrows

462+ in tr $ fromLists mList

463+ where

464+ buildList [] _ = []

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

439466

440467-- Conversion

441468

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

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

471+toLists Empty = []

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

445473toLists (Fork l r) = toLists l ++ toLists r

446474toLists (Join l r) = zipWith (++) (toLists l) (toLists r)

@@ -452,7 +480,7 @@ toList = concat . toLists

452480-- Zeros Matrix

453481

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

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

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

456484zeros = matrixBuilder' (const 0)

457485

458486-- Ones Matrix

@@ -460,20 +488,20 @@ zeros = matrixBuilder' (const 0)

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

461489--

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

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

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

464492ones = matrixBuilder' (const 1)

465493

466494-- Const Matrix

467495

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

469497-- value.

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

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

471499constant e = matrixBuilder' (const e)

472500

473501-- Bang Matrix

474502

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

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

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

477505bang =

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

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

@@ -481,7 +509,7 @@ bang =

481509-- iden Matrix

482510

483511-- | iden matrix.

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

512+iden :: forall e cols . (Num e, FromLists e cols cols, Countable cols) => Matrix e cols cols

485513iden = matrixBuilder' (bool 0 1 . uncurry (==))

486514{-# NOINLINE iden #-}

487515

@@ -492,12 +520,13 @@ iden = matrixBuilder' (bool 0 1 . uncurry (==))

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

493521-- from LAoP.

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

523+comp Empty Empty = Empty

495524comp (One a) (One b) = One (a * b)

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

497526comp (Fork a b) c = Fork (comp a c) (comp b c) -- Fork fusion law

498527comp c (Join a b) = Join (comp c a) (comp c b) -- Join fusion law

499528{-# NOINLINE comp #-}

500−{-# RULES

529+{-# RULES

501530 "comp/iden1" forall m. comp m iden = m ;

502531 "comp/iden2" forall m. comp iden m = m

503532#-}

@@ -507,6 +536,7 @@ comp c (Join a b) = Join (comp c a) (comp c b) -- Join fusion law

507536infixl 7 .|

508537-- | Scalar multiplication of matrices.

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

539+(.|) _ Empty = Empty

510540(.|) e (One a) = One (e * a)

511541(.|) e (Join a b) = Join (e .| a) (e .| b)

512542(.|) e (Fork a b) = Fork (e .| a) (e .| b)

@@ -516,6 +546,7 @@ infixl 7 .|

516546infixl 7 ./

517547-- | Scalar multiplication of matrices.

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

549+(./) Empty _ = Empty

519550(./) (One a) e = One (a / e)

520551(./) (Join a b) e = Join (a ./ e) (b ./ e)

521552(./) (Fork a b) e = Fork (a ./ e) (b ./ e)

@@ -523,59 +554,45 @@ infixl 7 ./

523554-- Projections

524555

525556-- | Biproduct first component projection

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

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

527558p1 = join id zeros

528559

529560-- | Biproduct second component projection

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

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

531562p2 = join zeros id

532563

533564-- Injections

534565

535566-- | Biproduct first component injection

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

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

537568i1 = tr p1

538569

539570-- | Biproduct second component injection

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

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

541572i2 = tr p2

542573

543574-- Dimensions

544575

545576-- | Obtain the number of rows.

546577--

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

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

579+-- dimensions in constant time.

580+--

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

582+-- exchange for performance.

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

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

552585

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−

562586-- | Obtain the number of columns.

587+--

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

589+-- dimensions in constant time.

563590--

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

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

592+-- exchange for performance.

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

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

569595

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−

579596-- Coproduct Bifunctor

580597

581598infixl 5 -|-

@@ -584,11 +601,11 @@ infixl 5 -|-

584601(-|-) ::

585602 forall e n k m j.

586603 ( Num e,

587− CountableDims j k,

588− FL k k,

589− FL j k,

590− FL k j,

591− FL j j

604+ CountableDimensions j k,

605+ FromLists e k k,

606+ FromLists e j k,

607+ FromLists e k j,

608+ FromLists e j j

592609 ) =>

593610 Matrix e n k ->

594611 Matrix e m j ->

@@ -601,8 +618,8 @@ infixl 5 -|-

601618fstM ::

602619 forall e m k .

603620 ( Num e,

604− CountableDims k m,

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

621+ CountableDimensions k m,

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

606623 CountableN (m, k)

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

608625fstM = matrixBuilder' f

@@ -616,8 +633,8 @@ fstM = matrixBuilder' f

616633sndM ::

617634 forall e m k .

618635 ( Num e,

619− CountableDims k m,

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

636+ CountableDimensions k m,

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

621638 CountableN (m, k)

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

623640sndM = matrixBuilder' f

@@ -630,7 +647,7 @@ sndM = matrixBuilder' f

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

631648--

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

633−--

650+--

634651-- @

635652-- | fstM . kr a b == a

636653-- kr a b ==> |

@@ -641,10 +658,10 @@ sndM = matrixBuilder' f

641658kr ::

642659 forall e cols a b.

643660 ( Num e,

644− CountableDims a b,

661+ CountableDimensions a b,

645662 CountableN (a, b),

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

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

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

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

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

649666kr a b =

650667 let fstM' = fstM @e @a @b

@@ -659,14 +676,14 @@ infixl 4 ><

659676(><) ::

660677 forall e m p n q.

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

679+ CountableDimensions m n,

680+ CountableDimensions p q,

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

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

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

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

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

686+ )

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

671688(><) a b =

672689 let fstM' = fstM @e @m @n

@@ -684,6 +701,7 @@ infixl 4 ><

684701-- @

685702abideJF :: Matrix e cols rows -> Matrix e cols rows

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

704+abideJF Empty = Empty

687705abideJF (One e) = One e

688706abideJF (Join a b) = Join (abideJF a) (abideJF b)

689707abideJF (Fork a b) = Fork (abideJF a) (abideJF b)

@@ -697,6 +715,7 @@ abideJF (Fork a b) = Fork (abideJF a) (abideJF b)

697715-- @

698716abideFJ :: Matrix e cols rows -> Matrix e cols rows

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

718+abideFJ Empty = Empty

700719abideFJ (One e) = One e

701720abideFJ (Join a b) = Join (abideFJ a) (abideFJ b)

702721abideFJ (Fork a b) = Fork (abideFJ a) (abideFJ b)

@@ -705,6 +724,7 @@ abideFJ (Fork a b) = Fork (abideFJ a) (abideFJ b)

705724

706725-- | Matrix transposition.

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

727+tr Empty = Empty

708728tr (One e) = One e

709729tr (Join a b) = Fork (tr a) (tr b)

710730tr (Fork a b) = Join (tr a) (tr b)

@@ -713,32 +733,32 @@ tr (Fork a b) = Join (tr a) (tr b)

713733

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

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

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

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

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

719739select m y = join y id . m

720740

721741branch ::

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

743+ CountableDimensions a b,

744+ CountableDimensions c (Either b c),

745+ FromLists e c b,

746+ FromLists e a b,

747+ FromLists e a a,

748+ FromLists e b b,

749+ FromLists e c c,

750+ FromLists e b a,

751+ FromLists e b c,

752+ FromLists e (Either b c) b,

753+ FromLists e (Either b c) c

734754 )

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

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

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

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

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

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

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

742762 g m = i2 . m

743763

744764-- McCarthy's Conditional

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

747767cond ::

748768 ( Trivial cols,

749769 Countable cols,

750− FL () cols,

751− FL cols (),

752− FL cols cols,

770+ FromLists e () cols,

771+ FromLists e cols (),

772+ FromLists e cols cols,

753773 Bounded a,

754774 Enum a,

755775 Num e,

@@ -762,9 +782,9 @@ cond p f g = join f g . grd p

762782grd ::

763783 ( Trivial q,

764784 Countable q,

765− FL () q,

766− FL q (),

767− FL q q,

785+ FromLists e () q,

786+ FromLists e q (),

787+ FromLists e q q,

768788 Bounded a,

769789 Enum a,

770790 Num e,

@@ -778,9 +798,9 @@ corr ::

778798 forall e a q .

779799 ( Trivial q,

780800 Countable q,

781− FL () q,

782− FL q (),

783− FL q q,

801+ FromLists e () q,

802+ FromLists e q (),

803+ FromLists e q q,

784804 Liftable e a Bool

785805 )

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

@@ -809,7 +829,7 @@ prettyAux (h : t) l = "│ " ++ fill (unwords $ map show h) ++ " │\n" ++

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

810830

811831-- | Matrix pretty printer

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

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

813833pretty m = concat

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

815835 , unlines

@@ -838,11 +858,12 @@ pretty m = concat

838858 (safeGet i j m)

839859

840860-- | Matrix pretty printer

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

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

842862prettyPrint = putStrLn . pretty

843863

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

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

866+zipWithM _ Empty Empty = Empty

846867zipWithM f (One a) (One b) = One (f a b)

847868zipWithM f (Join a b) (Join c d) = Join (zipWithM f a c) (zipWithM f b d)

848869zipWithM f (Fork a b) (Fork c d) = Fork (zipWithM f a c) (zipWithM f b d)

@@ -867,12 +888,14 @@ fromBool False = nat 0

867888

868889-- | Relational negation

869890negateM :: Relation cols rows -> Relation cols rows

891+negateM Empty = Empty

870892negateM (One (Nat p)) = One (Nat (negate p))

871893negateM (Join a b) = Join (negateM a) (negateM b)

872894negateM (Fork a b) = Fork (negateM a) (negateM b)

873895

874896-- | Relational addition

875897orM :: Relation cols rows -> Relation cols rows -> Relation cols rows

898+orM Empty Empty = Empty

876899orM (One a) (One b) = One (fromBool (toBool a || toBool b))

877900orM (Join a b) (Join c d) = Join (orM a c) (orM b d)

878901orM (Fork a b) (Fork c d) = Fork (orM a c) (orM b d)

@@ -881,6 +904,7 @@ orM x@(Join _ _) y@(Fork _ _) = orM (abideJF x) y

881904

882905-- | Relational multiplication

883906andM :: Relation cols rows -> Relation cols rows -> Relation cols rows

907+andM Empty Empty = Empty

884908andM (One a) (One b) = One (fromBool (toBool a && toBool b))

885909andM (Join a b) (Join c d) = Join (andM a c) (andM b d)

886910andM (Fork a b) (Fork c d) = Fork (andM a c) (andM b d)

@@ -889,6 +913,7 @@ andM x@(Join _ _) y@(Fork _ _) = andM (abideJF x) y

889913

890914-- | Relational subtraction

891915subM :: Relation cols rows -> Relation cols rows -> Relation cols rows

916+subM Empty Empty = Empty

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

893918subM (Join a b) (Join c d) = Join (subM a c) (subM b d)

894919subM (Fork a b) (Fork c d) = Fork (subM a c) (subM b d)

@@ -897,6 +922,7 @@ subM x@(Join _ _) y@(Fork _ _) = subM (abideJF x) y

897922

898923-- | Matrix relational composition.

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

925+compRel Empty Empty = Empty

900926compRel (One a) (One b) = One (fromBool (toBool a && toBool b))

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

902928compRel (Fork a b) c = Fork (compRel a c) (compRel b c) -- Fork fusion law

@@ -904,6 +930,7 @@ compRel c (Join a b) = Join (compRel c a) (compRel c b) -- Join fusion

904930

905931-- | Matrix relational right division

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

933+divR Empty Empty = Empty

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

908935divR (Join a b) (Join c d) = andM (divR a c) (divR b d)

909936divR (Fork a b) c = Fork (divR a c) (divR b c)

@@ -926,24 +953,58 @@ divS s r = divL r s `intersection` divR (tr r) (tr s)

926953fromFRel' ::

927954 forall a b cols rows.

928955 ( Liftable Boolean a b,

929− CountableDims cols rows,

930− FL rows cols

956+ CountableDimensions cols rows,

957+ FromLists Boolean rows cols

931958 ) =>

932959 (a -> b) ->

933960 Relation cols rows

934−fromFRel' = fromF'

961+fromFRel' f =

962+ let minA = minBound @a

963+ maxA = maxBound @a

964+ minB = minBound @b

965+ maxB = maxBound @b

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

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

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

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

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

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

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

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

974+ mList = buildList combAp rrows

975+ in tr $ fromLists mList

976+ where

977+ buildList [] _ = []

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

935979

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

937981-- cardinality's.

938982fromFRel ::

939983 forall a b.

940984 ( Liftable Boolean a b,

941− CountableDimsN a b,

942− FLN b a

985+ CountableDimensionsN a b,

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

943987 ) =>

944988 (a -> b) ->

945989 Relation (Normalize a) (Normalize b)

946−fromFRel = fromFRel'

990+fromFRel f =

991+ let minA = minBound @a

992+ maxA = maxBound @a

993+ minB = minBound @b

994+ maxB = maxBound @b

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

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

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

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

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

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

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

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

1003+ mList = buildList combAp rrows

1004+ in tr $ fromLists mList

1005+ where

1006+ buildList [] _ = []

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

9471008

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

9491010toRel ::

@@ -953,17 +1014,17 @@ toRel ::

9531014 Enum a,

9541015 Enum b,

9551016 Eq b,

956− CountableDims a b,

957− FLN b a

958− )

1017+ CountableDimensionsN a b,

1018+ FromListsN Boolean b a

1019+ )

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

9601021toRel f =

9611022 let minA = minBound @a

9621023 maxA = maxBound @a

9631024 minB = minBound @b

9641025 maxB = maxBound @b

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

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

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

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

9671028 elementsA = take ccols [minA .. maxA]

9681029 elementsB = take rrows [minB .. maxB]

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

src/LAoP/Matrix/Nat.hs+67−63

@@ -56,17 +56,18 @@ 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,

7172 join,

7273 fork,

@@ -77,7 +78,7 @@ 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,

@@ -166,19 +167,22 @@ newtype Matrix e (cols :: Nat) (rows :: Nat) = M (I.Matrix e (I.FromNat cols) (I

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

167168

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

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

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

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

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

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

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

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

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

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

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

179180

180181-- Primitives

181182

183+empty :: Matrix e 0 0

184+empty = M I.Empty

185+

182186one :: e -> Matrix e 1 1

183187one = M . I.One

184188

@@ -214,27 +218,27 @@ infixl 2 ===

214218

215219-- Construction

216220

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

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

218222fromLists = M . I.fromLists

219223

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

221225-- a construction function that operates with indices.

222226matrixBuilder' ::

223− (FLN e cols rows, CountableN cols, CountableN rows)

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

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

225229matrixBuilder' = M . I.matrixBuilder'

226230

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

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

228232col = M . I.col

229233

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

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

231235row = M . I.row

232236

233237fromF' ::

234238 ( Liftable e a b,

235239 CountableN cols,

236240 CountableN rows,

237− FLN e rows cols

241+ FromListsN e rows cols

238242 ) =>

239243 (a -> b) ->

240244 Matrix e cols rows

@@ -244,7 +248,7 @@ fromF ::

244248 ( Liftable e a b,

245249 CountableNz a,

246250 CountableNz b,

247− FLNz e b a

251+ FromListsNz e b a

248252 ) =>

249253 (a -> b) ->

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

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

261265-- Zeros Matrix

262266

263267zeros ::

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

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

265269 Matrix e cols rows

266270zeros = M I.zeros

267271

268272-- Ones Matrix

269273

270274ones ::

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

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

272276 Matrix e cols rows

273277ones = M I.ones

274278

275279-- Const Matrix

276280

277281constant ::

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

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

279283 e ->

280284 Matrix e cols rows

281285constant = M . I.constant

@@ -284,14 +288,14 @@ constant = M . I.constant

284288

285289bang ::

286290 forall e cols.

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

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

288292 Matrix e cols 1

289293bang = M I.bang

290294

291295-- iden Matrix

292296

293297iden ::

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

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

295299 Matrix e cols cols

296300iden = M I.iden

297301

@@ -316,9 +320,9 @@ infixl 7 ./

316320

317321p1 ::

318322 ( Num e,

319− CountableDimsN n m,

320− FLN e n m,

321− FLN e m m,

323+ CountableDimensionsN n m,

324+ FromListsN e n m,

325+ FromListsN e m m,

322326 TrivialE m n

323327 ) =>

324328 Matrix e (m + n) m

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

326330

327331p2 ::

328332 ( Num e,

329− CountableDimsN n m,

330− FLN e m n,

331− FLN e n n,

333+ CountableDimensionsN n m,

334+ FromListsN e m n,

335+ FromListsN e n n,

332336 TrivialE m n

333337 ) =>

334338 Matrix e (m + n) n

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

338342

339343i1 ::

340344 ( Num e,

341− CountableDimsN n rows,

342− FLN e n rows,

343− FLN e rows rows,

345+ CountableDimensionsN n rows,

346+ FromListsN e n rows,

347+ FromListsN e rows rows,

344348 TrivialE rows n

345349 ) =>

346350 Matrix e rows (rows + n)

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

348352

349353i2 ::

350354 ( Num e,

351− CountableDimsN rows m,

352− FLN e m rows,

353− FLN e rows rows,

355+ CountableDimensionsN rows m,

356+ FromListsN e m rows,

357+ FromListsN e rows rows,

354358 TrivialE m rows

355359 ) =>

356360 Matrix e rows (m + rows)

@@ -369,11 +373,11 @@ infixl 5 -|-

369373-- | Coproduct Bifunctor (Direct sum)

370374(-|-) ::

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

376+ CountableDimensionsN j k,

377+ FromListsN e k k,

378+ FromListsN e j k,

379+ FromListsN e k j,

380+ FromListsN e j j,

377381 TrivialE n m,

378382 TrivialE k j

379383 ) =>

@@ -386,9 +390,9 @@ infixl 5 -|-

386390fstM ::

387391 forall e m k .

388392 ( Num e,

389− CountableDimsN m k,

393+ CountableDimensionsN m k,

390394 CountableN (m * k),

391− FLN e (m * k) m,

395+ FromListsN e (m * k) m,

392396 TrivialP m k

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

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

@@ -397,8 +401,8 @@ fstM = M (I.fstM @e @(I.FromNat m) @(I.FromNat k))

397401sndM ::

398402 forall e m k.

399403 ( Num e,

400− CountableDimsN k m,

401− FLN e (m * k) k,

404+ CountableDimensionsN k m,

405+ FromListsN e (m * k) k,

402406 CountableN (m * k),

403407 TrivialP m k

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

@@ -408,10 +412,10 @@ sndM = M (I.sndM @e @(I.FromNat m) @(I.FromNat k))

408412kr ::

409413 forall e cols a b.

410414 ( Num e,

411− CountableDimsN a b,

415+ CountableDimensionsN a b,

412416 CountableN (a * b),

413− FLN e (a * b) a,

414− FLN e (a * b) b,

417+ FromListsN e (a * b) a,

418+ FromListsN e (a * b) b,

415419 TrivialP a b

416420 ) => Matrix e cols a -> Matrix e cols b -> Matrix e cols (a * b)

417421kr a b =

@@ -425,13 +429,13 @@ infixl 4 ><

425429(><) ::

426430 forall e m p n q.

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

432+ CountableDimensionsN m n,

433+ CountableDimensionsN p q,

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

435+ FromListsN e (m * n) m,

436+ FromListsN e (m * n) n,

437+ FromListsN e (p * q) p,

438+ FromListsN e (p * q) q,

435439 TrivialP m n,

436440 TrivialP p q

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

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

455459-- Selective 'select' operator

456460select ::

457461 ( Num e,

458− FLN e rows1 rows1,

462+ FromListsN e rows1 rows1,

459463 CountableN rows1,

460464 I.FromNat rows2 ~ I.FromNat rows1,

461465 I.FromNat cols1 ~ I.FromNat cols2,

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

468472cond ::

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

470474 CountableN cols,

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

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

473− FLN e cols cols,

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

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

477+ FromListsN e cols cols,

474478 Liftable e a Bool

475479 )

476480 =>

@@ -479,10 +483,10 @@ cond p (M a) (M b) = M (I.cond p a b)

479483

480484-- Pretty print

481485

482−pretty :: (CountableDimsN cols rows, Show e) => Matrix e cols rows -> String

486+pretty :: (CountableDimensionsN cols rows, Show e) => Matrix e cols rows -> String

483487pretty (M m) = I.pretty m

484488

485−prettyPrint :: (CountableDimsN cols rows, Show e) => Matrix e cols rows -> IO ()

489+prettyPrint :: (CountableDimensionsN cols rows, Show e) => Matrix e cols rows -> IO ()

486490prettyPrint (M m) = I.prettyPrint m

487491

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

src/LAoP/Matrix/Type.hs+236−246

@@ -58,19 +58,31 @@ 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,

67+ Trivial2,

6768 TrivialP,

69+ EqN,

70+ EnumN,

71+ Enumerable,

72+ EnumerableN,

73+ ConstructNorm,

74+ ConstructN,

75+ ConstructableN,

76+ FstM,

77+ SndM,

78+ Kronecker,

6879

6980 -- * Type aliases

7081 Zero,

7182 One,

7283

7384 -- * Primitives

85+ empty,

7486 one,

7587 join,

7688 fork,

@@ -85,9 +97,10 @@ module LAoP.Matrix.Type

8597 fromLists,

8698 toLists,

8799 toList,

88− matrixBuilder',

89100 matrixBuilder,

101+ rowL,

90102 row,

103+ colL,

91104 col,

92105 zeros,

93106 ones,

@@ -104,8 +117,8 @@ module LAoP.Matrix.Type

104117 multM,

105118

106119 -- * Selective equivalent instance function

107− selectM,

108−

120+ selectM,

121+

109122 -- * Monad equivalent instance function

110123 returnM,

111124 bindM,

@@ -113,9 +126,7 @@ module LAoP.Matrix.Type

113126 -- * Misc

114127 -- ** Get dimensions

115128 columns,

116− columns',

117129 rows,

118− rows',

119130

120131 -- ** Matrix Transposition

121132 tr,

@@ -125,7 +136,7 @@ module LAoP.Matrix.Type

125136 (./),

126137

127138 -- ** McCarthy's Conditional

128− cond,

139+ -- cond,

129140

130141 -- ** Matrix "abiding"

131142 abideJF,

@@ -168,7 +179,6 @@ module LAoP.Matrix.Type

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

169180 iden,

170181 comp,

171− fromF',

172182 fromF,

173183

174184 -- * Relation

@@ -181,44 +191,46 @@ module LAoP.Matrix.Type

181191where

182192

183193import Data.Void

184−import Data.Proxy

185194import Data.Kind

186195import GHC.TypeLits

187196import Control.DeepSeq

188197import LAoP.Utils

189−import qualified LAoP.Matrix.Internal as I

198+import qualified LAoP.Matrix.Alternative as I

190199import Prelude hiding (id, (.))

191200

192201newtype Matrix e (cols :: Type) (rows :: Type) = M (I.Matrix e (I.Normalize cols) (I.Normalize rows))

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

194203

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

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

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

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

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

209+type FromListsN e a b = I.FromLists e (I.Normalize a) (I.Normalize b)

210+type Liftable a b = (Eq b, Enumerable a, Enum a, EnumN a, Enum b, EnumN b, ConstructableN a b)

211+type Trivial a = I.Normalize (I.Normalize a) ~ I.Normalize (I.Normalize (I.Normalize a))

212+type Trivial2 a = I.Normalize a ~ I.Normalize (I.Normalize a)

213+type TrivialP a b = I.Normalize (a, b) ~ I.Normalize (I.Normalize a, I.Normalize b)

214+type EqN a = Eq (I.Normalize a)

215+type EnumN a = Enum (I.Normalize a)

216+type Enumerable a = (Enum a, Bounded a)

217+type EnumerableN a = (Enum (I.Normalize a), Bounded (I.Normalize a))

218+type ConstructNorm a = (Enum a, Enum (I.Normalize a))

219+type ConstructN a = I.Construct (I.Normalize a)

220+type ConstructableN a b = (I.Construct (I.Normalize a), I.Construct (I.Normalize b))

206221

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

208223-- class.

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

210− type Object (Matrix e) a = (FLN a a, CountableN a)

225+ type Object (Matrix e) a = (Num e, EqN a, ConstructN a, EnumerableN a)

211226 id = iden

212227 (.) = comp

213228

214229-- | Bifunctor equivalent function

215230bimapM ::

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

231+ ( Num e,

232+ Liftable a b,

233+ Liftable c d

222234 ) => (a -> b) -> (c -> d) -> Matrix e a c -> Matrix e b d

223235bimapM f g m = fromF g . m . tr (fromF f)

224236

@@ -230,6 +242,10 @@ type One = ()

230242

231243-- Primitives

232244

245+-- | Empty matrix constructor

246+empty :: Matrix e Zero Zero

247+empty = M I.Empty

248+

233249-- | Unit matrix constructor

234250one :: e -> Matrix e One One

235251one = M . I.One

@@ -267,113 +283,70 @@ infixl 2 ===

267283-- Functor hierarchy

268284

269285-- | Functor instance equivalent function

270−fmapM ::

271− ( Liftable e a b,

272− CountableDimsN a b,

273− FLN b a

274− )

275− =>

276− (a -> b) -> Matrix e c a -> Matrix e c b

286+fmapM :: (Num e, Liftable a b) => (a -> b) -> Matrix e c a -> Matrix e c b

277287fmapM f m = fromF f . m

278288

279289-- | Applicative instance equivalent 'unit' function,

280−unitM :: (Num e) => Matrix e () ()

290+unitM :: Num e => Matrix e () ()

281291unitM = one 1

282292

283293-- | Applicative instance equivalent 'unit' function,

284−multM ::

285− ( CountableDimsN a b,

286− CountableN (a, b),

287− Num e,

288− FLN (a, b) a,

289− FLN (a, b) b,

290− TrivialP a b

291− ) => Matrix e c a -> Matrix e c b -> Matrix e c (a, b)

294+multM :: (Num e, FstM a b, SndM a b) => Matrix e c a -> Matrix e c b -> Matrix e c (a, b)

292295multM = kr

293296

294297-- | Monad instance equivalent 'return' function,

295−returnM ::

296− forall e a .

297− ( Num e,

298− Enum e,

299− Enum a,

300− FLN () a,

301− Countable a

302− ) => a -> Matrix e One a

303−returnM a = col l

304− where

305− i = fromInteger $ natVal (Proxy :: Proxy (I.Count a))

306− x = fromEnum a

307− l = take x [0,0..] ++ [1] ++ take (i - x - 1) [0,0..]

298+returnM :: (Num e, Liftable () a) => a -> Matrix e One a

299+returnM = point

308300

309301-- | Monad instance equivalent '(>>=)' function,

310−bindM :: (Num e) => Matrix e a b -> Matrix e b c -> Matrix e a c

302+bindM :: Num e => Matrix e a b -> Matrix e b c -> Matrix e a c

311303bindM = flip comp

312304

313305-- Construction

314306

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

316308-- error if the dimensions do not match.

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

309+fromLists :: FromListsN e cols rows => [[e]] -> Matrix e cols rows

318310fromLists = M . I.fromLists

319311

320−-- | 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−

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

328313-- a construction function that operates with arbitrary types.

329314matrixBuilder ::

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)

315+ ( Num e,

316+ Enumerable a,

317+ Enum b,

318+ EnumN a,

319+ EnumN b,

320+ ConstructableN a b

321+ )

322+ => ((a, b) -> e) -> Matrix e a b

323+matrixBuilder = M . I.matrixBuilderN

324+

325+-- | Constructs a column vector matrix

326+colL :: FromListsN e () rows => [e] -> Matrix e One rows

327+colL = M . I.colL

339328

340329-- | Constructs a column vector matrix

341−col :: (FLN () rows) => [e] -> Matrix e One rows

342−col = M . I.col

330+col :: (Num e, Enum a, EnumN a, ConstructN a) => (a -> e) -> Matrix e One a

331+col = M . I.colN . I.Vector

343332

344333-- | Constructs a row vector matrix

345−row :: (FLN cols ()) => [e] -> Matrix e cols One

346−row = M . I.row

334+rowL :: FromListsN e cols () => [e] -> Matrix e cols One

335+rowL = M . I.rowL

347336

348−-- | Lifts functions to matrices with arbitrary dimensions.

349−--

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

351−-- types @a@ or @b@ allows.

352−fromF' ::

353− ( Liftable e a b,

354− CountableDimsN cols rows,

355− FLN rows cols

356− ) =>

357− (a -> b) -> Matrix e cols rows

358−fromF' = M . I.fromF'

337+-- | Constructs a row vector matrix

338+row :: (Num e, Enum a, EnumN a, ConstructN a) => (a -> e) -> Matrix e a One

339+row = M . I.rowN . I.Vector

359340

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

361342-- cardinality's.

362−fromF ::

363− ( Liftable e a b,

364− CountableDimsN a b,

365− FLN b a

366− ) =>

367− (a -> b) -> Matrix e a b

368−fromF = M . I.fromF

343+fromF :: (Num e, Liftable a b)

344+ => (a -> b) -> Matrix e a b

345+fromF = M . I.fromFN

369346

370347-- | Lifts relation functions to Boolean Matrix

371−toRel ::

372− ( Liftable (Natural 0 1) a b,

373− CountableDims a b,

374− FLN b a

375− ) => (a -> b -> Bool) -> Matrix (Natural 0 1) a b

376−toRel = M . I.toRel

348+toRel :: Liftable a b => (a -> b -> Bool) -> Matrix (Natural 0 1) a b

349+toRel = M . I.toRelN

377350

378351-- Conversion

379352

@@ -389,8 +362,11 @@ toList (M m) = I.toList m

389362

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

391364zeros ::

392− (Num e, FLN cols rows, CountableDimsN cols rows)

393− => Matrix e cols rows

365+ ( Num e,

366+ ConstructableN cols rows,

367+ EnumerableN cols

368+ )

369+ => Matrix e cols rows

394370zeros = M I.zeros

395371

396372-- Ones Matrix

@@ -399,8 +375,11 @@ zeros = M I.zeros

399375--

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

401377ones ::

402− (Num e, FLN cols rows, CountableDimsN cols rows)

403− => Matrix e cols rows

378+ ( Num e,

379+ ConstructableN cols rows,

380+ EnumerableN cols

381+ )

382+ => Matrix e cols rows

404383ones = M I.ones

405384

406385-- Const Matrix

@@ -408,37 +387,38 @@ ones = M I.ones

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

409388-- value.

410389constant ::

411− (Num e, FLN cols rows, CountableDimsN cols rows)

412− => e -> Matrix e cols rows

390+ ( Num e,

391+ ConstructableN cols rows,

392+ EnumerableN cols

393+ )

394+ => e -> Matrix e cols rows

413395constant = M . I.constant

414396

415397-- Bang Matrix

416398

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

418400bang ::

419− forall e cols.

420− (Num e, Enum e, FLN cols (), CountableN cols) =>

421− Matrix e cols One

422−bang = M I.bang

423−

424−-- | Point constant relation

425−point ::

426− ( Bounded a,

427− Enum a,

428− Eq a,

429− Num e,

430− Ord e,

431− CountableN a,

432− FLN a One

433− ) => a -> Matrix e One a

401+ ( Num e,

402+ ConstructN cols,

403+ EnumerableN cols

404+ )

405+ => Matrix e cols One

406+bang = ones

407+

408+-- | Point constant matrix

409+point :: (Num e, Liftable () a) => a -> Matrix e One a

434410point = fromF . const

435411

436412-- iden Matrix

437413

438414-- | iden matrix

439415iden ::

440− (Num e, FLN a a, CountableN a) =>

441− Matrix e a a

416+ ( Num e,

417+ EqN a,

418+ ConstructN a,

419+ EnumerableN a

420+ )

421+ => Matrix e a a

442422iden = M I.iden

443423{-# NOINLINE iden #-}

444424

@@ -448,10 +428,10 @@ iden = M I.iden

448428--

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

450430-- from LAoP.

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

431+comp :: Num e => Matrix e cr rows -> Matrix e cols cr -> Matrix e cols rows

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

453433{-# NOINLINE comp #-}

454−{-# RULES

434+{-# RULES

455435 "comp/iden1" forall m. comp m iden = m ;

456436 "comp/iden2" forall m. comp iden m = m

457437#-}

@@ -472,140 +452,144 @@ infixl 7 ./

472452

473453-- | Biproduct first component projection

474454p1 ::

475− ( Num e,

476− CountableDimsN n m,

477− FLN n m,

478− FLN m m

479− ) =>

480− Matrix e (Either m n) m

455+ ( Num e,

456+ EqN m,

457+ ConstructableN m n,

458+ EnumerableN m,

459+ EnumerableN n

460+ )

461+ => Matrix e (Either m n) m

481462p1 = M I.p1

482463

483464-- | Biproduct second component projection

484465p2 ::

485− ( Num e,

486− CountableDimsN n m,

487− FLN m n,

488− FLN n n

489− ) =>

490− Matrix e (Either m n) n

466+ ( Num e,

467+ EqN n,

468+ ConstructableN m n,

469+ EnumerableN m,

470+ EnumerableN n

471+ )

472+ => Matrix e (Either m n) n

491473p2 = M I.p2

492474

493475-- Injections

494476

495477-- | Biproduct first component injection

496478i1 ::

497− ( Num e,

498− CountableDimsN n m,

499− FLN n m,

500− FLN m m

501− ) =>

502− Matrix e m (Either m n)

479+ ( Num e,

480+ EqN m,

481+ ConstructableN m n,

482+ EnumerableN m,

483+ EnumerableN n

484+ )

485+ => Matrix e m (Either m n)

503486i1 = tr p1

504487

505488-- | Biproduct second component injection

506489i2 ::

507− ( Num e,

508− CountableDimsN n m,

509− FLN m n,

510− FLN n n

511− ) =>

512− Matrix e n (Either m n)

490+ ( Num e,

491+ EqN n,

492+ ConstructableN m n,

493+ EnumerableN m,

494+ EnumerableN n

495+ )

496+ => Matrix e n (Either m n)

513497i2 = tr p2

514498

515499-- Dimensions

516500

517501-- | Obtain the number of rows.

518502--

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

522−rows :: (CountableN rows) => Matrix e cols rows -> Int

523−rows (M m) = I.rows m

524−

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

526−-- constraints.

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

504+-- dimensions in constant time.

527505--

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

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

530−rows' (M m) = I.rows' m

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

507+-- exchange for performance.

508+rows :: CountableN rows => Matrix e cols rows -> Int

509+rows (M m) = I.rows m

531510

532511-- | Obtain the number of columns.

512+--

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

514+-- dimensions in constant time.

533515--

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

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

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

517+-- exchange for performance.

518+columns :: CountableN cols => Matrix e cols rows -> Int

538519columns (M m) = I.columns m

539520

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−

547521-- Coproduct Bifunctor

548522

549523infixl 5 -|-

550524

551525-- | Matrix coproduct functor also known as matrix direct sum.

552526(-|-) ::

553− ( Num e,

554− CountableDimsN j k,

555− FLN k k,

556− FLN j k,

557− FLN k j,

558− FLN j j

559− ) =>

560− Matrix e n k ->

561− Matrix e m j ->

562− Matrix e (Either n m) (Either k j)

527+ ( Num e,

528+ EqN k,

529+ EqN j,

530+ ConstructableN k j,

531+ EnumerableN k,

532+ EnumerableN j

533+ ) => Matrix e n k -> Matrix e m j -> Matrix e (Either n m) (Either k j)

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

564535

565536-- Khatri Rao Product and projections

566537

538+type FstM a b =

539+ ( EqN a,

540+ ConstructableN (I.Normalize a) (I.Normalize (a, b)),

541+ ConstructN (I.Normalize a, I.Normalize b),

542+ EnumerableN a,

543+ EnumerableN b,

544+ EnumN (I.Normalize a, I.Normalize b),

545+ Trivial2 a,

546+ TrivialP a b

547+ )

548+

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

568550fstM ::

569− forall e m k .

570− ( Num e,

571− CountableDimsN m k,

572− CountableN (m, k),

573− FLN (m, k) m,

574− TrivialP m k

575− ) => Matrix e (m, k) m

576−fstM = M (I.fstM @e @(I.Normalize m) @(I.Normalize k))

577−

551+ forall e a b .

552+ ( Num e,

553+ FstM a b

554+ ) => Matrix e (a, b) a

555+fstM = M (I.fstM @e @(I.Normalize a) @(I.Normalize b))

556+

557+type SndM a b =

558+ ( EqN b,

559+ ConstructableN (I.Normalize b) (I.Normalize (a, b)),

560+ ConstructN (I.Normalize a, I.Normalize b),

561+ EnumerableN a,

562+ EnumerableN b,

563+ EnumN (I.Normalize a, I.Normalize b),

564+ Trivial2 b,

565+ TrivialP a b

566+ )

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

579568sndM ::

580− forall e m k.

581− ( Num e,

582− CountableDimsN k m,

583− CountableN (m, k),

584− FLN (m, k) k,

585− TrivialP m k

586− ) => Matrix e (m, k) k

587−sndM = M (I.sndM @e @(I.Normalize m) @(I.Normalize k))

569+ forall e a b.

570+ ( Num e,

571+ SndM a b

572+ ) => Matrix e (a, b) b

573+sndM = M (I.sndM @e @(I.Normalize a) @(I.Normalize b))

588574

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

590576--

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

592−--

578+--

593579-- @

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

580+-- | fstM . kr a b == a

595581-- kr a b ==> |

596582-- | sndM . kr a b == b

597583-- @

598584--

599585-- __Emphasis__ on the implication symbol.

600586kr ::

601− forall e cols a b.

602− ( Num e,

603− CountableDimsN a b,

604− CountableN (a, b),

605− FLN (a, b) a,

606− FLN (a, b) b,

607− TrivialP a b

608− ) => Matrix e cols a -> Matrix e cols b -> Matrix e cols (a, b)

587+ forall e cols a b.

588+ ( Num e,

589+ FstM a b,

590+ SndM a b

591+ )

592+ => Matrix e cols a -> Matrix e cols b -> Matrix e cols (a, b)

609593kr a b =

610594 let fstM' = fstM @e @a @b

611595 sndM' = sndM @e @a @b

@@ -614,21 +598,38 @@ kr a b =

614598-- Product Bifunctor (Kronecker)

615599

616600infixl 4 ><

601+type Kronecker m n p q =

602+ ( EqN (I.Normalize m),

603+ EqN (I.Normalize n),

604+ EqN (I.Normalize p),

605+ EqN (I.Normalize q),

606+ ConstructableN (I.Normalize m) (I.Normalize n),

607+ ConstructableN (I.Normalize p) (I.Normalize q),

608+ ConstructableN (I.Normalize m, I.Normalize n) (I.Normalize p, I.Normalize q),

609+ ConstructableN (I.Normalize (I.Normalize m, I.Normalize n)) (I.Normalize (I.Normalize p, I.Normalize q)),

610+ FstM m n,

611+ SndM m n,

612+ EnumerableN (I.Normalize m),

613+ EnumerableN (I.Normalize n),

614+ EnumerableN (I.Normalize p),

615+ EnumerableN (I.Normalize q),

616+ EnumerableN (I.Normalize m, I.Normalize n),

617+ EnumerableN (I.Normalize p, I.Normalize q),

618+ Trivial2 m,

619+ Trivial2 n,

620+ Trivial2 p,

621+ Trivial2 q,

622+ TrivialP p q,

623+ TrivialP m m

624+ )

617625

618626-- | Matrix product functor also known as Kronecker product

619627(><) ::

620− forall e m p n q.

621− ( 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,

629− TrivialP m n,

630− TrivialP p q

631− ) => Matrix e m p -> Matrix e n q -> Matrix e (m, n) (p, q)

628+ forall e m p n q.

629+ ( Num e,

630+ Kronecker m n p q

631+ )

632+ => Matrix e m p -> Matrix e n q -> Matrix e (m, n) (p, q)

632633(><) a b =

633634 let fstM' = fstM @e @m @n

634635 sndM' = sndM @e @m @n

@@ -637,7 +638,7 @@ infixl 4 ><

637638-- Matrix abide Join Fork

638639

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

640−--

641+--

641642-- Law:

642643--

643644-- @

@@ -649,7 +650,7 @@ abideJF (M m) = M (I.abideJF m)

649650-- Matrix abide Fork Join

650651

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

652−--

653+--

653654-- Law:

654655--

655656-- @

@@ -668,38 +669,27 @@ tr (M m) = M (I.tr m)

668669

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

670671-- ArrowMonad solution presented in the paper.

671−selectM ::

672− ( Num e,

673− FLN b b,

674− CountableN b

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

672+selectM :: (Num e, EqN b, ConstructN b, EnumerableN b) => Matrix e cols (Either a b) -> Matrix e a b -> Matrix e cols b

676673selectM (M m) (M y) = M (I.select m y)

677674

678675-- McCarthy's Conditional

679676

680677-- | McCarthy's Conditional expresses probabilistic choice.

681−cond ::

682− ( Trivial a,

683− Trivial2 a,

684− Trivial3 a,

685− CountableN a,

686− FLN () a,

687− FLN a (),

688− FLN a a,

689− Liftable e a Bool

690− )

691− =>

692− (a -> Bool) -> Matrix e a b -> Matrix e a b -> Matrix e a b

693−cond p (M a) (M b) = M (I.cond p a b)

678+-- cond ::

679+-- (

680+-- )

681+-- =>

682+-- (a -> Bool) -> Matrix e a b -> Matrix e a b -> Matrix e a b

683+-- cond p (M a) (M b) =

694684

695685-- Pretty print

696686

697687-- | Matrix pretty printer

698−pretty :: (CountableDimsN cols rows, Show e) => Matrix e cols rows -> String

688+pretty :: (Show e, CountableDimensionsN cols rows) => Matrix e cols rows -> String

699689pretty (M m) = I.pretty m

700690

701691-- | Matrix pretty printer

702−prettyPrint :: (CountableDimsN cols rows, Show e) => Matrix e cols rows -> IO ()

692+prettyPrint :: (CountableDimensionsN cols rows, Show e) => Matrix e cols rows -> IO ()

703693prettyPrint (M m) = I.prettyPrint m

704694

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

src/LAoP/Relation.hs+4−3

@@ -32,15 +32,16 @@ module LAoP.Relation

3232

3333 -- * Constraint type synonyms

3434 Countable,

35− CountableDims,

35+ CountableDimensions,

3636 CountableN,

37− CountableDimsN,

38− FLN,

37+ CountableDimensionsN,

38+ FromListsN,

3939 Liftable,

4040 Trivial,

4141 TrivialP,

4242

4343 -- * Primitives

44+ empty,

4445 one,

4546 join,

4647 (|||),

src/LAoP/Relation/Internal.hs+130−128

@@ -43,15 +43,16 @@ module LAoP.Relation.Internal

4343

4444 -- * Constraint type synonyms

4545 Countable,

46− CountableDims,

46+ CountableDimensions,

4747 CountableN,

48− CountableDimsN,

49− FLN,

48+ CountableDimensionsN,

49+ FromListsN,

5050 Liftable,

5151 Trivial,

5252 TrivialP,

5353

5454 -- * Primitives

55+ empty,

5556 one,

5657 join,

5758 (|||),

@@ -193,19 +194,19 @@ 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)

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 TrivialP a b = I.Normalize (a, b) ~ I.Normalize (I.Normalize a, I.Normalize b)

204205

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

206207-- class.

207208instance Category Relation where

208− type Object Relation a = (FLN a a, CountableN a)

209+ type Object Relation a = (FromListsN a a, CountableN a)

209210 id = iden

210211 (.) = comp

211212

@@ -228,6 +229,10 @@ type One = ()

228229

229230-- Primitives

230231

232+-- | Empty matrix constructor

233+empty :: Relation Zero Zero

234+empty = R I.Empty

235+

231236-- | Unit matrix constructor

232237one :: Boolean -> Relation One One

233238one = R . I.One

@@ -264,26 +269,26 @@ infixl 2 ===

264269

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

266271-- error if the dimensions do not match.

267−fromLists :: (FLN a b) => [[Boolean]] -> Relation a b

272+fromLists :: (FromListsN a b) => [[Boolean]] -> Relation a b

268273fromLists = R . I.fromLists

269274

270275-- | Relation builder function. Constructs a relation provided with

271276-- a construction function that operates with indices.

272277relationBuilder' ::

273− (FLN a b, CountableDimsN a b) =>

278+ (FromListsN a b, CountableDimensionsN a b) =>

274279 ((Int, Int) -> Boolean) -> Relation a b

275280relationBuilder' = R . I.matrixBuilder'

276281

277282-- | Relation builder function. Constructs a relation provided with

278283-- a construction function that operates with arbitrary types.

279284relationBuilder ::

280− ( FLN a b,

285+ ( FromListsN a b,

281286 Enum a,

282287 Enum b,

283288 Bounded a,

284289 Bounded b,

285290 Eq a,

286− CountableDims a b

291+ CountableDimensionsN a b

287292 ) => ((a, b) -> Boolean) -> Relation a b

288293relationBuilder = R . I.matrixBuilder

289294

@@ -293,18 +298,18 @@ relationBuilder = R . I.matrixBuilder

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

294299fromF' ::

295300 ( Liftable a b,

296− CountableDimsN c d,

297− FLN d c

301+ CountableDimensionsN c d,

302+ FromListsN d c

298303 )

299304 => (a -> b) -> Relation c d

300305fromF' f = R (I.fromFRel' f)

301306

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

303308-- cardinality's.

304−fromF ::

309+fromF ::

305310 ( Liftable a b,

306− CountableDimsN a b,

307− FLN b a

311+ CountableDimensionsN a b,

312+ FromListsN b a

308313 )

309314 => (a -> b) -> Relation a b

310315fromF f = R (I.fromFRel f)

@@ -312,8 +317,8 @@ fromF f = R (I.fromFRel f)

312317-- | Lifts relation functions to 'Relation'

313318toRel ::

314319 ( Liftable a b,

315− CountableDims a b,

316− FLN b a

320+ CountableDimensionsN a b,

321+ FromListsN b a

317322 )

318323 => (a -> b -> Bool) -> Relation a b

319324toRel = R . I.toRel

@@ -322,9 +327,9 @@ toRel = R . I.toRel

322327fromRel ::

323328 ( Liftable a b,

324329 Eq a,

325− CountableDimsN a b,

326− FLN a One,

327− FLN b One

330+ CountableDimensionsN a b,

331+ FromListsN a One,

332+ FromListsN b One

328333 )

329334 => Relation a b -> (a -> b -> Bool)

330335fromRel r a b = pointApBool a b r

@@ -348,12 +353,12 @@ toBool r = case toList r of

348353-- | Power transpose.

349354--

350355-- Maps a relation to a set valued function.

351−pt ::

356+pt ::

352357 ( Liftable a b,

353358 Eq a,

354− CountableDimsN a b,

355− FLN a One,

356− FLN b One

359+ CountableDimensionsN a b,

360+ FromListsN a One,

361+ FromListsN b One

357362 )

358363 => Relation a b -> (a -> List b)

359364pt r a =

@@ -365,8 +370,8 @@ belongs ::

365370 ( Bounded a,

366371 Enum a,

367372 Eq a,

368− CountableDims (List a) a,

369− FLN a (List a)

373+ CountableDimensionsN (List a) a,

374+ FromListsN a (List a)

370375 )

371376 => Relation (List a) a

372377belongs = toRel elemR

@@ -378,14 +383,14 @@ belongs = toRel elemR

378383-- | The zero relation. A relation where no element of type @a@ relates

379384-- with elements of type @b@.

380385--

381−-- Also known as ⊥ (Bottom) Relation.

386+-- Also known as ⊥ (Bottom) Relation or empty Relation.

382387--

383388-- @

384389-- r `.` ⊥ == ⊥ `.` r == ⊥

385390-- ⊥ ``sse`` R && R ``sse`` T == True

386391-- @

387392zeros ::

388− (FLN a b, CountableDimsN a b) =>

393+ (FromListsN a b, CountableDimensionsN a b) =>

389394 Relation a b

390395zeros = relationBuilder' (const (nat 0))

391396

@@ -400,7 +405,7 @@ zeros = relationBuilder' (const (nat 0))

400405-- ⊥ ``sse`` R && R ``sse`` T == True

401406-- @

402407ones ::

403− (FLN a b, CountableDimsN a b) =>

408+ (FromListsN a b, CountableDimensionsN a b) =>

404409 Relation a b

405410ones = relationBuilder' (const (nat 1))

406411

@@ -408,17 +413,17 @@ ones = relationBuilder' (const (nat 1))

408413

409414-- | The T (Top) row vector relation.

410415bang ::

411− (FLN a One, CountableN a) =>

416+ (FromListsN a One, CountableN a) =>

412417 Relation a One

413418bang = ones

414419

415420-- | Point constant relation

416−point ::

421+point ::

417422 ( Bounded a,

418423 Enum a,

419424 Eq a,

420425 CountableN a,

421− FLN a One

426+ FromListsN a One

422427 ) => a -> Relation One a

423428point = fromF . const

424429

@@ -430,7 +435,7 @@ point = fromF . const

430435-- 'iden' `.` r == r == r `.` 'iden'

431436-- @

432437iden ::

433− (FLN a a, CountableN a) => Relation a a

438+ (FromListsN a a, CountableN a) => Relation a a

434439iden = relationBuilder' (bool (nat 0) (nat 1) . uncurry (==))

435440

436441-- | Relational composition

@@ -484,7 +489,7 @@ shrunkBy r s = r `intersection` divR s (conv r)

484489-- r ``overriddenBy`` r == r

485490-- @

486491overriddenBy ::

487− ( FLN b b,

492+ ( FromListsN b b,

488493 CountableN b

489494 ) => Relation a b -> Relation a b -> Relation a b

490495overriddenBy r s = s `union` r `intersection` divR zeros (conv s)

@@ -496,9 +501,9 @@ overriddenBy r s = s `union` r `intersection` divR zeros (conv s)

496501pointAp ::

497502 ( Liftable a b,

498503 Eq a,

499− CountableDimsN a b,

500− FLN a One,

501− FLN b One

504+ CountableDimensionsN a b,

505+ FromListsN a One,

506+ FromListsN b One

502507 ) => a -> b -> Relation a b -> Relation One One

503508pointAp a b r = conv (point b) . r . point a

504509

@@ -508,9 +513,9 @@ pointAp a b r = conv (point b) . r . point a

508513pointApBool ::

509514 ( Liftable a b,

510515 Eq a,

511− CountableDimsN a b,

512− FLN a One,

513− FLN b One

516+ CountableDimensionsN a b,

517+ FromListsN a One,

518+ FromListsN b One

514519 ) => a -> b -> Relation a b -> Bool

515520pointApBool a b r = toBool $ conv (point b) . r . point a

516521

@@ -590,19 +595,19 @@ divisionF f g = conv g . f

590595-- Taxonomy of binary relations

591596

592597-- | A 'Relation' @r@ is 'simple' 'iff' @'coreflexive' ('img' r)@

593−simple :: (CountableN b, FLN b b) => Relation a b -> Bool

598+simple :: (CountableN b, FromListsN b b) => Relation a b -> Bool

594599simple = coreflexive . img

595600

596601-- | A 'Relation' @r@ is 'injective' 'iff' @'coreflexive' ('ker' r)@

597−injective :: (CountableN a, FLN a a) => Relation a b -> Bool

602+injective :: (CountableN a, FromListsN a a) => Relation a b -> Bool

598603injective = coreflexive . ker

599604

600605-- | A 'Relation' @r@ is 'entire' 'iff' @'reflexive' ('ker' r)@

601−entire :: (CountableN a, FLN a a) => Relation a b -> Bool

606+entire :: (CountableN a, FromListsN a a) => Relation a b -> Bool

602607entire = reflexive . ker

603608

604609-- | A 'Relation' @r@ is 'surjective' 'iff' @'reflexive' ('img' r)@

605−surjective :: (CountableN b, FLN b b) => Relation a b -> Bool

610+surjective :: (CountableN b, FromListsN b b) => Relation a b -> Bool

606611surjective = reflexive . img

607612

608613-- | A 'Relation' @r@ is a 'function' 'iff' @'simple' r && 'entire' r@

@@ -615,9 +620,9 @@ surjective = reflexive . img

615620-- r `.` f ``sse`` s == r ``sse`` s `.` f

616621-- @

617622function ::

618− ( CountableDimsN a b,

619− FLN a a,

620− FLN b b

623+ ( CountableDimensionsN a b,

624+ FromListsN a a,

625+ FromListsN b b

621626 )

622627 => Relation a b -> Bool

623628function r = simple r && entire r

@@ -625,7 +630,7 @@ function r = simple r && entire r

625630-- | A 'Relation' @r@ is a 'representation' 'iff' @'injective' r && 'entire' r@

626631representation ::

627632 ( CountableN a,

628− FLN a a

633+ FromListsN a a

629634 )

630635 => Relation a b -> Bool

631636representation r = injective r && entire r

@@ -633,45 +638,45 @@ representation r = injective r && entire r

633638-- | A 'Relation' @r@ is an 'abstraction' 'iff' @'surjective' r && 'simple' r@

634639abstraction ::

635640 ( CountableN b,

636− FLN b b

641+ FromListsN b b

637642 )

638643 => Relation a b -> Bool

639644abstraction r = surjective r && simple r

640645

641646-- | A 'Relation' @r@ is a 'surjection' 'iff' @'function' r && 'abstraction' r@

642647surjection ::

643− ( CountableDimsN a b,

644− FLN a a,

645− FLN b b

648+ ( CountableDimensionsN a b,

649+ FromListsN a a,

650+ FromListsN b b

646651 )

647652 => Relation a b -> Bool

648653surjection r = function r && abstraction r

649654

650655-- | A 'Relation' @r@ is a 'injection' 'iff' @'function' r && 'representation' r@

651656injection ::

652− ( CountableDimsN a b,

653− FLN a a,

654− FLN b b

657+ ( CountableDimensionsN a b,

658+ FromListsN a a,

659+ FromListsN b b

655660 )

656661 => Relation a b -> Bool

657662injection r = function r && representation r

658663

659664-- | A 'Relation' @r@ is an 'bijection' 'iff' @'injection' r && 'surjection' r@

660665bijection ::

661− ( CountableDimsN a b,

662− FLN b b,

663− FLN a a

666+ ( CountableDimensionsN a b,

667+ FromListsN b b,

668+ FromListsN a a

664669 ) => Relation a b -> Bool

665670bijection r = injection r && surjection r

666671

667672-- Properties of relations

668673

669674-- | A 'Relation' @r@ is 'reflexive' 'iff' @'id' ``sse`` r@

670−reflexive :: (CountableN a, FLN a a) => Relation a a -> Bool

675+reflexive :: (CountableN a, FromListsN a a) => Relation a a -> Bool

671676reflexive r = id <= r

672677

673678-- | A 'Relation' @r@ is 'coreflexive' 'iff' @r ``sse`` 'id'@

674−coreflexive :: (CountableN a, FLN a a) => Relation a a -> Bool

679+coreflexive :: (CountableN a, FromListsN a a) => Relation a a -> Bool

675680coreflexive r = r <= id

676681

677682-- | A 'Relation' @r@ is 'transitive' 'iff' @(r `.` r) ``sse`` r@

@@ -683,35 +688,35 @@ symmetric :: Relation a a -> Bool

683688symmetric r = r == conv r

684689

685690-- | A 'Relation' @r@ is anti-symmetric 'iff' @(r ``intersection`` 'conv' r) ``sse`` 'id'@

686−antiSymmetric :: (CountableN a, FLN a a) => Relation a a -> Bool

691+antiSymmetric :: (CountableN a, FromListsN a a) => Relation a a -> Bool

687692antiSymmetric r = (r `intersection` conv r) `sse` id

688693

689694-- | A 'Relation' @r@ is 'irreflexive' 'iff' @(r ``intersection`` 'id') == 'zeros'@

690−irreflexive :: (CountableN a, FLN a a) => Relation a a -> Bool

695+irreflexive :: (CountableN a, FromListsN a a) => Relation a a -> Bool

691696irreflexive r = (r `intersection` id) == zeros

692697

693698-- | A 'Relation' @r@ is 'connected' 'iff' @(r ``union`` 'conv' r) == 'ones'@

694−connected :: (CountableN a, FLN a a) => Relation a a -> Bool

699+connected :: (CountableN a, FromListsN a a) => Relation a a -> Bool

695700connected r = (r `union` conv r) == ones

696701

697702-- | A 'Relation' @r@ is a 'preorder' 'iff' @'reflexive' r && 'transitive' r@

698−preorder :: (CountableN a, FLN a a) => Relation a a -> Bool

703+preorder :: (CountableN a, FromListsN a a) => Relation a a -> Bool

699704preorder r = reflexive r && transitive r

700705

701706-- | A 'Relation' @r@ is a partial-order 'iff' @'antiSymmetric' r && 'preorder' r@

702−partialOrder :: (CountableN a, FLN a a) => Relation a a -> Bool

707+partialOrder :: (CountableN a, FromListsN a a) => Relation a a -> Bool

703708partialOrder r = antiSymmetric r && preorder r

704709

705710-- | A 'Relation' @r@ is a linear-order 'iff' @'connected' r && 'partialOrder' r@

706−linearOrder :: (CountableN a, FLN a a) => Relation a a -> Bool

711+linearOrder :: (CountableN a, FromListsN a a) => Relation a a -> Bool

707712linearOrder r = connected r && partialOrder r

708713

709714-- | A 'Relation' @r@ is an 'equivalence' 'iff' @'symmetric' r && 'preorder' r@

710−equivalence :: (CountableN a, FLN a a) => Relation a a -> Bool

715+equivalence :: (CountableN a, FromListsN a a) => Relation a a -> Bool

711716equivalence r = symmetric r && preorder r

712717

713718-- | A 'Relation' @r@ is a partial-equivalence 'iff' @'partialOrder' r && 'equivalence' r@

714−partialEquivalence :: (CountableN a, FLN a a) => Relation a a -> Bool

719+partialEquivalence :: (CountableN a, FromListsN a a) => Relation a a -> Bool

715720partialEquivalence r = partialOrder r && equivalence r

716721

717722-- | A 'Relation' @r@ is 'difunctional' or regular wherever

@@ -743,10 +748,10 @@ difunctional r = r . conv r . r == r

743748-- 'eitherR' ('splitR' r s) ('splitR' t v) == 'splitR' ('eitherR' r t) ('eitherR' s v)

744749-- @

745750splitR ::

746− ( CountableDimsN a b,

751+ ( CountableDimensionsN a b,

747752 CountableN (a, b),

748− FLN (a, b) a,

749− FLN (a, b) b,

753+ FromListsN (a, b) a,

754+ FromListsN (a, b) b,

750755 TrivialP a b

751756 )

752757 => Relation c a -> Relation c b -> Relation c (a, b)

@@ -759,9 +764,9 @@ splitR (R f) (R g) = R (I.kr f g)

759764-- @

760765fstR ::

761766 forall a b .

762− ( CountableDimsN a b,

767+ ( CountableDimensionsN a b,

763768 CountableN (a, b),

764− FLN (a, b) a,

769+ FromListsN (a, b) a,

765770 TrivialP a b

766771 )

767772 => Relation (a, b) a

@@ -774,9 +779,9 @@ fstR = R (I.fstM @Boolean @(I.Normalize a) @(I.Normalize b))

774779-- @

775780sndR ::

776781 forall a b .

777− ( CountableDimsN a b,

782+ ( CountableDimensionsN a b,

778783 CountableN (a, b),

779− FLN (a, b) b,

784+ FromListsN (a, b) b,

780785 TrivialP a b

781786 )

782787 => Relation (a, b) b

@@ -792,13 +797,13 @@ infixl 4 ><

792797-- (r '><' s) `.` (p '><' q) == (r `.` p) '><' (s `.` q)

793798-- @

794799(><) ::

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,

800+ ( CountableDimensionsN a b,

801+ CountableDimensionsN c d,

802+ CountableDimensionsN (a, c) (b, d),

803+ FromListsN (a, c) a,

804+ FromListsN (a, c) c,

805+ FromListsN (b, d) b,

806+ FromListsN (b, d) d,

802807 TrivialP a c,

803808 TrivialP b d

804809 )

@@ -832,9 +837,9 @@ eitherR = join

832837-- 'i1' `.` 'i2' = 'zeros'

833838-- @

834839i1 ::

835− ( CountableDimsN a b,

836− FLN b a,

837− FLN a a

840+ ( CountableDimensionsN a b,

841+ FromListsN b a,

842+ FromListsN a a

838843 )

839844 => Relation a (Either a b)

840845i1 = R I.i1

@@ -846,9 +851,9 @@ i1 = R I.i1

846851-- 'i1' `.` 'i2' = 'zeros'

847852-- @

848853i2 ::

849− ( CountableDimsN a b,

850− FLN a b,

851− FLN b b

854+ ( CountableDimensionsN a b,

855+ FromListsN a b,

856+ FromListsN b b

852857 )

853858 => Relation b (Either a b)

854859i2 = R I.i2

@@ -861,11 +866,11 @@ infixl 5 -|-

861866-- r '-|-' s == 'eitherR' ('i1' `.` r) ('i2' `.` s)

862867-- @

863868(-|-) ::

864− ( CountableDimsN b d,

865− FLN b b,

866− FLN d b,

867− FLN b d,

868− FLN d d

869+ ( CountableDimensionsN b d,

870+ FromListsN b b,

871+ FromListsN d b,

872+ FromListsN b d,

873+ FromListsN d 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,13 +883,13 @@ 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),

890895 TrivialP a b,

@@ -899,13 +904,13 @@ 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),

911916 TrivialP a b,

@@ -927,10 +932,9 @@ untrans s = fstR . conv (splitR (conv s) sndR)

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

936940predR p = id `intersection` divisionF (fromF (const True)) p

@@ -945,7 +949,7 @@ predR p = id `intersection` divisionF (fromF (const True)) p

945949-- @

946950equalizer ::

947951 ( CountableN a,

948− FLN a a

952+ FromListsN a a

949953 )

950954 => Relation a b -> Relation a b -> Relation a a

951955equalizer f g = id `intersection` divisionF f g

@@ -955,25 +959,23 @@ equalizer f g = id `intersection` divisionF f g

955959-- @

956960-- 'guard' p = 'i2' ``overriddenBy`` 'i1' `.` '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

965968 ) => Relation b Bool -> Relation b (Either b b)

966969guard p = conv (eitherR (predR p) (predR (negate p)))

967970

968971-- | Relational McCarthy's conditional.

969−cond ::

972+cond ::

970973 ( Bounded b,

971974 Enum b,

972− Countable b,

973975 CountableN b,

974− FLN b b,

975− FLN Bool b

976− )

976+ FromListsN b b,

977+ FromListsN Bool b

978+ )

977979 => Relation b Bool -> Relation b c -> Relation b c -> Relation b c

978980cond p r s = eitherR r s . guard p

979981

@@ -983,7 +985,7 @@ cond p r s = eitherR r s . guard p

983985-- since @'ker' r ``sse`` 'id'@ in such situations.

984986domain ::

985987 ( CountableN a,

986− FLN a a

988+ FromListsN a a

987989 ) => Relation a b -> Relation a a

988990domain r = ker r `intersection` id

989991

@@ -993,16 +995,16 @@ domain r = ker r `intersection` id

993995-- since @'img' f ``sse`` id@ for any @f@.

994996range ::

995997 ( CountableN b,

996− FLN b b

998+ FromListsN b b

997999 ) => Relation a b -> Relation b b

9981000range r = img r `intersection` id

9991001

10001002-- Relation pretty print

10011003

10021004-- | Relation pretty printing

1003−pretty :: (CountableDimsN a b) => Relation a b -> String

1005+pretty :: (CountableDimensionsN a b) => Relation a b -> String

10041006pretty (R a) = I.pretty a

10051007

10061008-- | Relation pretty printing

1007−prettyPrint :: (CountableDimsN a b) => Relation a b -> IO ()

1009+prettyPrint :: (CountableDimensionsN a b) => Relation a b -> IO ()

10081010prettyPrint (R a) = I.prettyPrint a

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/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"