63abc15..master · laop

git.iko.soy/laop

on master help sign in

.ghc.environment.x86_64-linux-8.6.5deleted−17

since splitsnapshots

unifiedsplit

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

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.ymlnew file+43

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

1+name: CI

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]

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+54−2

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

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

1.stack-work/

25.stack-work/

2−laop.cabal

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]

3−*~

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

.travis.ymlnew file+47

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

1+sudo: true

2+language: haskell

4+git:

5+ depth: 5

7+cabal: "3.0"

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.mdnew file+17

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

1+# Changelog

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

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

6+## 0.1.1.1

8+* Bump base version to work with cabal

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.mddeleted−3

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

1−# Changelog for laop

2−

3−## Unreleased changes

LICENSE+17−26

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

1+MIT License

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

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

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

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

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

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

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

13+copies or substantial portions of the Software.

11− * Redistributions in binary form must reproduce the above

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

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

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

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

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

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

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

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

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

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

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

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

21+SOFTWARE.

README.md+34−30

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

1# 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)

3The LAoP discipline generalises relations and functions treating them as

9The LAoP discipline generalises relations and functions treating them as

4Boolean matrices and in turn consider these as arrows.

10Boolean matrices and in turn consider these as arrows.

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

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

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

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

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

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

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

14−

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

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

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

19## Features

23## Features

21−This library offers:

25+This library offers 3 main matrix programming modules:

22−

26+

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

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

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

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

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

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

26− around the internal matrix data type.

30+

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

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

28− around the internal matrix data type.

32+distributions.

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

33+

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

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

31− AoP and Relational Calculus/Algebra.

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

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

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

33− make it easier to deal with sample space.

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

34−

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

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

39+and transformation functions.

36−

40+

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

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.

38−- Statically typed dimensions;

42+

39−- Polymorphic data type dimensions;

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

40−- Polymorphic matrix content;

44+

41−- Awesome dimension type inference;

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

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

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.

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

47+

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

48+## Known issues

45−

49+

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.

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

48## Notes

52## Notes

Setup.hsdeleted−2

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

1−import Distribution.Simple

2−main = defaultMain

app/Main.hsdeleted−7

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

1−module Main where

2−

3−import Examples

4−import Benchmarks

5−

6−main :: IO ()

7−main = benchmark

appveyor.ymlnew file+34

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

1+clone_folder: "c:\\WORK"

2+clone_depth: 5

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

5+skip_branch_with_pr: true

7+platform:

8+ - x86_64

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

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

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

8{-# LANGUAGE AllowAmbiguousTypes #-}

9{-# LANGUAGE ScopedTypeVariables #-}

11−module Benchmarks

12− ( benchmark

13− )

14− where

11+module Main (main) where

16import LAoP.Dist.Internal

13import LAoP.Dist.Internal

17import LAoP.Utils

14import LAoP.Utils

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

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

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

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

20import Criterion.Main

17import Criterion.Main

21import Control.DeepSeq

18import Control.DeepSeq

22import Test.QuickCheck

19import Test.QuickCheck

23import GHC.TypeLits

20import GHC.TypeLits

24import Data.Proxy

21import Data.Proxy

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

26selectM2 ::

24selectM2 ::

27 ( Num e,

25 ( Num e,

28− T.FromListsN e b b,

26+ T.FLN b b,

29 CountableN b

27 CountableN b

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

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

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

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

33selectD2 ::

31selectD2 ::

34− ( FromListsN b b,

32+ ( FLN b b,

35 CountableN b

33 CountableN b

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

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

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

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

39−-- Composition with identity

37+-- Composition with iden

40−compId m = comp identity m

38+compId m = comp iden m

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

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

43randomDist = do

41randomDist = do

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

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

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

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

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

48 m = fromLists lr

46 m = fromLists lr

49 return (D m)

47 return (D m)

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

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

52randomMatrix = do

50randomMatrix = do

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

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

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

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

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

107 probs = map (/ s) l

105 probs = map (/ s) l

108 in zip as probs

106 in zip as probs

109

107

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

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

111randomDistF = do

109randomDistF = do

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

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

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

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

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

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

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

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

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

148

146

149−benchmark :: IO ()

147+main :: IO ()

150−benchmark = defaultMain [

148+main = defaultMain [

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

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

152 bgroup "10x10" [

150 bgroup "10x10" [

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

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

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

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

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

163 ],

161 ],

164 bgroup "200x200 - RULES" [

162 bgroup "200x200 - RULES" [

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

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

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

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

167 ] ],

165 ] ],

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

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

hackage.shdeleted−10

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

1−#!/bin/sh

2−set -e

3−

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

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

6−

7−# assumes cabal 2.4 or later

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

9−

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

laop.cabalnew file+89

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

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.yamldeleted−57

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

1−name: laop

2−version: 0.1.0.5

3−github: "bolt12/laop"

4−license: BSD3

5−author: "Armando Santos"

6−maintainer: "armandoifsantos@gmail.com"

7−copyright: "MIT"

8−

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

39 -- * Constraint type synonyms

40 Countable,

41 CountableN,

42− CountableDimensionsN,

42+ CountableDimsN,

43− FromListsN,

43+ FLN,

44 Liftable,

45 TrivialP,

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

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

17 Countable,

18 CountableN,

19− CountableDimensionsN,

19+ CountableDimsN,

20− FromListsN,

20+ FLN,

21 Liftable,

22 TrivialP,

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

43 )

44 where

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

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

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

47import qualified LAoP.Matrix.Internal as I

48import qualified LAoP.Matrix.Internal as I

48import LAoP.Utils

49import LAoP.Utils

49import GHC.TypeLits

50import GHC.TypeLits

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

71-- | Functor instance

72-- | Functor instance

72fmapD ::

73fmapD ::

73 ( Liftable a b,

74 ( Liftable a b,

74− CountableDimensionsN a b,

75+ CountableDimsN a b,

75− FromListsN b a

76+ FLN b a

76 )

77 )

77 =>

78 =>

78 (a -> b) -> Dist a -> Dist b

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

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

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

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

86multD ::

87multD ::

87− ( CountableDimensionsN a b,

88+ ( CountableDimsN a b,

88 CountableN (a, b),

89 CountableN (a, b),

89− FromListsN (a, b) a,

90+ FLN (a, b) a,

90− FromListsN (a, b) b,

91+ FLN (a, b) b,

91 TrivialP a b

92 TrivialP a b

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

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

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

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

95-- | Selective instance function

96-- | Selective instance function

96selectD ::

97selectD ::

97− ( FromListsN b b,

98+ ( FLN b b,

98 CountableN b

99 CountableN b

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

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

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

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

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

103-- functions to apply to a given argument;

104-- functions to apply to a given argument;

104branchD ::

105branchD ::

105 ( Num e,

106 ( Num e,

106− CountableDimensionsN a b,

107+ CountableDimsN a b,

107− CountableDimensionsN c (Either b c),

108+ CountableDimsN c (Either b c),

108− FromListsN c b,

109+ FLN c b,

109− FromListsN a b,

110+ FLN a b,

110− FromListsN a a,

111+ FLN a a,

111− FromListsN b b,

112+ FLN b b,

112− FromListsN c c,

113+ FLN c c,

113− FromListsN b a,

114+ FLN b a,

114− FromListsN b c,

115+ FLN b c,

115− FromListsN (Either b c) b,

116+ FLN (Either b c) b,

116− FromListsN (Either b c) c

117+ FLN (Either b c) c

117 )

118 )

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

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

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

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

120 where

121 where

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

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

122 g m = i2 `comp` m

123 g m = i2 `comp` m

123

124

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

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

125ifD ::

126ifD ::

126− ( CountableDimensionsN a (Either () a),

127+ ( CountableDimsN a (Either () a),

127− FromListsN a a,

128+ FLN a a,

128− FromListsN a (),

129+ FLN a (),

129− FromListsN () a,

130+ FLN () a,

130− FromListsN (Either () a) a

131+ FLN (Either () a) a

131 )

132 )

132 => Dist Bool -> Dist a -> Dist a -> Dist a

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

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

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

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

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

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

136

137

137-- | Monad instance 'return' function

138-- | Monad instance 'return' function

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

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

139returnD a = D (col l)

140returnD a = D (col l)

140 where

141 where

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

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

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

150(??) ::

151(??) ::

151 ( Enum a,

152 ( Enum a,

152 Countable a,

153 Countable a,

153− FromListsN () a

154+ FLN () a

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

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

155(??) p d =

156(??) p d =

156 let l = toValues d

157 let l = toValues d

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

160-- Distribution Construction

161-- Distribution Construction

161

162

162-- | Constructs a Bernoulli distribution

163-- | Constructs a Bernoulli distribution

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

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

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

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

165

166

166-- | Creates a distribution given a shape function

167-- | Creates a distribution given a shape function

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

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

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

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

169shape f xs =

170shape f xs =

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

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

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

172 in fromFreqs (zip xs ps)

173 in fromFreqs (zip xs ps)

173

174

174-- | Constructs a Linear distribution

175-- | Constructs a Linear distribution

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

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

176linear = shape id

177linear = shape id

177

178

178-- | Constructs an Uniform distribution

179-- | Constructs an Uniform distribution

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

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

180uniform = shape (const 1)

181uniform = shape (const 1)

181

182

182-- | Constructs an Negative Exponential distribution

183-- | Constructs an Negative Exponential distribution

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

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

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

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

185

186

186-- | Constructs an Normal distribution

187-- | Constructs an Normal distribution

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

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

188normal = shape (normalCurve 0.5 0.5)

189normal = shape (normalCurve 0.5 0.5)

189

190

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

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

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

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

192toValues (D d) =

193toValues (D d) =

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

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

194 probs = toList d

195 probs = toList d

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

196 in res

197 in res

197

198

198-- | Pretty a distribution

199-- | Pretty a distribution

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

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

200prettyDist d =

201prettyDist d =

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

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

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

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

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

208 showR n x = show x ++ " "

209 showR n x = show x ++ " "

209

210

210-- | Pretty Print a distribution

211-- | Pretty Print a distribution

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

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

212prettyPrintDist = putStrLn . prettyDist @a

213prettyPrintDist = putStrLn . prettyDist @a

213

214

214-- Auxiliary functions

215-- Auxiliary functions

215

216

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

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

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

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

218 where q = sum $ map snd xs

219 where q = sum $ map snd xs

219

220

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

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

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

31--

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

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

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

34--

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

36--

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

43 --

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

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

46− -- leads to a very straightforward implementation

46+ -- leads to a very straightforward implementation

47− -- of LAoP combinators.

47+ -- of LAoP combinators.

49 -- * Type safe matrix representation

50 Matrix (..),

52+ -- * Constraint type aliases

53+ Countable,

54+ CountableDims,

55+ CountableN,

56+ CountableDimsN,

57+ FL,

58+ FLN,

59+ Liftable,

60+ Trivial,

61+

52 -- * Primitives

62 -- * Primitives

53− empty,

54 one,

63 one,

55− junc,

64+ join,

56− split,

65+ fork,

58 -- * Auxiliary type families

67 -- * Auxiliary type families

59 FromNat,

68 FromNat,

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

66 toLists,

75 toLists,

67 toList,

76 toList,

68 matrixBuilder,

77 matrixBuilder,

78+ matrixBuilder',

69 row,

79 row,

70 col,

80 col,

71 zeros,

81 zeros,

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

76 -- * Misc

86 -- * Misc

77 -- ** Get dimensions

87 -- ** Get dimensions

78 columns,

88 columns,

89+ columns',

79 rows,

90 rows,

91+ rows',

81 -- ** Matrix Transposition

93 -- ** Matrix Transposition

82 tr,

94 tr,

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

97+ (.|),

98+ (./),

99+

84 -- ** Selective operator

100 -- ** Selective operator

85 select,

101 select,

86 branch,

102 branch,

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

89 cond,

105 cond,

106

91 -- ** Matrix "abiding"

107 -- ** Matrix "abiding"

92− abideJS,

108+ abideJF,

93− abideSJ,

109+ abideFJ,

110

95 -- ** Zip matrices

111 -- ** Zip matrices

96 zipWithM,

112 zipWithM,

113

98 -- * Biproduct approach

114 -- * Biproduct approach

99− -- ** Split

115+ -- ** Fork

100 (===),

116 (===),

101 -- *** Projections

117 -- *** Projections

102 p1,

118 p1,

103 p2,

119 p2,

104− -- ** Junc

120+ -- ** Join

105 (|||),

121 (|||),

106 -- *** Injections

122 -- *** Injections

107 i1,

123 i1,

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

114

130

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

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

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

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

133+

117 -- *** Matrix pairing projections

134 -- *** Matrix pairing projections

118− kp1,

135+ fstM,

119− kp2,

136+ sndM,

120

137

121 -- *** Matrix pairing

138 -- *** Matrix pairing

122− khatri,

139+ kr,

123

140

124 -- * Matrix composition and lifting

141 -- * Matrix composition and lifting

125

142

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

127

144

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

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

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

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

130− identity,

147+ iden,

131 comp,

148 comp,

132− fromF,

133 fromF',

149 fromF',

150+ fromF,

134

151

135 -- * Matrix printing

152 -- * Matrix printing

136 pretty,

153 pretty,

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

159import Data.List

176import Data.List

160import Data.Maybe

177import Data.Maybe

161import Data.Proxy

178import Data.Proxy

179+import Data.Typeable

162import Data.Void

180import Data.Void

163import GHC.TypeLits

181import GHC.TypeLits

164import Data.Type.Equality

182import Data.Type.Equality

165import GHC.Generics

183import GHC.Generics

166import Control.DeepSeq

184import Control.DeepSeq

167−import Control.Category

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

168−import Prelude hiding ((.))

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

169

187

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

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

171data Matrix e cols rows where

189data Matrix e cols rows where

172− Empty :: Matrix e Void Void

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

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

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

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

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

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

176

193

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

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

178

195

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

199--

216--

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

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

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

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

202− FromNat 0 = Void

203 FromNat 1 = ()

219 FromNat 1 = ()

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

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

205

221

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

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

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

217type Countable a = KnownNat (Count a)

233type Countable a = KnownNat (Count a)

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

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

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

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

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

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

237+type FL a b = FromLists a b

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

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

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

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

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

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

224

241

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

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

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

243+-- class.

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

228−--

229−-- Please use 'identity' instead.

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

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

231− id = undefined

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

246+ id = iden

232− (.) = comp

247+ (.) = comp

233

248

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

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

235− rnf Empty = ()

236− rnf (One e) = rnf e

250+ rnf (One e) = rnf e

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

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

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

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

239

253

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

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

241− Empty == Empty = True

242− (One a) == (One b) = a == b

255+ (One a) == (One b) = a == b

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

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

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

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

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

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

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

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

247

260

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

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

249−

250 a + b = zipWithM (+) a b

262 a + b = zipWithM (+) a b

251

263

252 a - b = zipWithM (-) a b

264 a - b = zipWithM (-) a b

253

265

254 a * b = zipWithM (*) a b

266 a * b = zipWithM (*) a b

255

267

256− abs Empty = Empty

257− abs (One a) = One (abs a)

268+ abs (One a) = One (abs a)

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

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

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

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

260

271

261− signum Empty = Empty

262− signum (One a) = One (signum a)

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

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

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

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

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

265

275

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

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

267− Empty <= Empty = True

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

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

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

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

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

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

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

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

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

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

273

282

274-- Primitives

283-- Primitives

275

284

276−-- | Empty matrix constructor

277−empty :: Matrix e Void Void

278−empty = Empty

279−

280-- | Unit matrix constructor

285-- | Unit matrix constructor

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

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

282one = One

287one = One

283

288

284−-- | Matrix 'Junc' constructor

289+-- | Matrix 'Join' constructor

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

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

286−junc = Junc

291+join = Join

287

292

288infixl 3 |||

293infixl 3 |||

289

294

290−-- | Matrix 'Junc' constructor

295+-- | Matrix 'Join' constructor

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

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

292−(|||) = Junc

297+(|||) = Join

293

298

294−-- | Matrix 'Split' constructor

299+-- | Matrix 'Fork' constructor

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

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

296−split = Split

301+fork = Fork

297

302

298infixl 2 ===

303infixl 2 ===

299

304

300−-- | Matrix 'Split' constructor

305+-- | Matrix 'Fork' constructor

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

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

302−(===) = Split

307+(===) = Fork

303

308

304-- Construction

309-- Construction

305

310

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

307--

312--

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

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

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

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

310−class FromLists e cols rows where

315+class FromLists cols rows where

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

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

312 -- error if the dimensions do not match.

317 -- error if the dimensions do not match.

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

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

314

319

315−instance FromLists e Void Void where

320+instance FromLists () () where

316− fromLists [] = Empty

317− fromLists _ = error "Wrong dimensions"

318−

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

320 fromLists [[e]] = One e

321 fromLists [[e]] = One e

321 fromLists _ = error "Wrong dimensions"

322 fromLists _ = error "Wrong dimensions"

322

323

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

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

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

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

325 fromLists _ = error "Wrong dimensions"

326 fromLists _ = error "Wrong dimensions"

326

327

328+instance {-# OVERLAPPABLE #-}

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

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

328− fromLists [l] =

330+ fromLists [l] =

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

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

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

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

331 fromLists _ = error "Wrong dimensions"

333 fromLists _ = error "Wrong dimensions"

332

334

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

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

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

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

335 fromLists _ = error "Wrong dimensions"

337 fromLists _ = error "Wrong dimensions"

336

338

339+instance {-# OVERLAPPABLE #-}

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

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

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

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

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

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

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

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

341 fromLists _ = error "Wrong dimensions"

344 fromLists _ = error "Wrong dimensions"

342

345

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

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

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

344 fromLists l@(h : t) =

348 fromLists l@(h : t) =

345 let lh = length h

349 let lh = length h

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

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

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

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

348 in if lh > 0 && condition

352 in if lh > 0 && condition

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

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

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

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

351

355

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

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

353−-- a construction function.

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

354−matrixBuilder ::

358+matrixBuilder' ::

355 forall e cols rows.

359 forall e cols rows.

356− ( FromLists e cols rows,

360+ ( FL cols rows,

357− CountableDimensions cols rows

361+ CountableDims cols rows

358− ) =>

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

360− Matrix e cols rows

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

361−matrixBuilder f =

363+matrixBuilder' f =

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

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

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

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

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

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

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

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

366

368

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

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

371+matrixBuilder ::

372+ forall e a b.

373+ ( FLN a b,

374+ Enum a,

375+ Enum b,

376+ Bounded a,

377+ Bounded b,

378+ Eq a,

379+ Countable b

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

381+matrixBuilder f =

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

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

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

385+ where

386+ buildList _ [] = []

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

388+

367-- | Constructs a column vector matrix

389-- | Constructs a column vector matrix

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

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

369col = fromLists . map (: [])

391col = fromLists . map (: [])

370

392

371-- | Constructs a row vector matrix

393-- | Constructs a row vector matrix

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

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

373row = fromLists . (: [])

395row = fromLists . (: [])

374

396

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

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

376--

398--

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

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

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

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

379−fromF ::

401+fromF' ::

380 forall a b cols rows e.

402 forall a b cols rows e.

381 ( Liftable e a b,

403 ( Liftable e a b,

382− CountableDimensions cols rows,

404+ CountableDims cols rows,

383− FromLists e rows cols

405+ FL rows cols

384 ) =>

406 ) =>

385 (a -> b) ->

407 (a -> b) ->

386 Matrix e cols rows

408 Matrix e cols rows

387−fromF f =

409+fromF' f =

388 let minA = minBound @a

410 let minA = minBound @a

389 maxA = maxBound @a

411 maxA = maxBound @a

390 minB = minBound @b

412 minB = minBound @b

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

394 elementsA = take ccols [minA .. maxA]

416 elementsA = take ccols [minA .. maxA]

395 elementsB = take rrows [minB .. maxB]

417 elementsB = take rrows [minB .. maxB]

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

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

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

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

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

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

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

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

400 mList = buildList combAp rrows

422 mList = buildList combAp rrows

401 in tr $ fromLists mList

423 in tr $ fromLists mList

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

405

427

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

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

407-- cardinality's.

429-- cardinality's.

408−fromF' ::

430+fromF ::

409 forall a b e.

431 forall a b e.

410 ( Liftable e a b,

432 ( Liftable e a b,

411− CountableDimensionsN a b,

433+ CountableDimsN a b,

412− FromListsN e b a

434+ FLN b a

413 ) =>

435 ) =>

414 (a -> b) ->

436 (a -> b) ->

415 Matrix e (Normalize a) (Normalize b)

437 Matrix e (Normalize a) (Normalize b)

416−fromF' f =

438+fromF = fromF'

417− let minA = minBound @a

418− maxA = maxBound @a

419− minB = minBound @b

420− maxB = maxBound @b

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

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

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

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

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

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

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

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

429− mList = buildList combAp rrows

430− in tr $ fromLists mList

431− where

432− buildList [] _ = []

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

434

439

435-- Conversion

440-- Conversion

436

441

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

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

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

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

439−toLists Empty = []

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

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

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

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

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

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

443

447

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

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

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

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

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

448-- Zeros Matrix

452-- Zeros Matrix

449

453

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

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

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

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

452−zeros = matrixBuilder (const 0)

456+zeros = matrixBuilder' (const 0)

453

457

454-- Ones Matrix

458-- Ones Matrix

455

459

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

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

457--

461--

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

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

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

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

460−ones = matrixBuilder (const 1)

464+ones = matrixBuilder' (const 1)

461

465

462-- Const Matrix

466-- Const Matrix

463

467

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

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

465-- value.

469-- value.

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

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

467−constant e = matrixBuilder (const e)

471+constant e = matrixBuilder' (const e)

468

472

469-- Bang Matrix

473-- Bang Matrix

470

474

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

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

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

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

473bang =

477bang =

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

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

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

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

476

480

477−-- Identity Matrix

481+-- iden Matrix

478

482

479−-- | Identity matrix.

483+-- | iden matrix.

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

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

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

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

482−{-# NOINLINE identity #-}

486+{-# NOINLINE iden #-}

483

487

484-- Matrix composition (MMM)

488-- Matrix composition (MMM)

485

489

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

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

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

489-- from LAoP.

493-- from LAoP.

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

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

491−comp Empty Empty = Empty

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

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

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

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

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

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

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

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

496{-# NOINLINE comp #-}

499{-# NOINLINE comp #-}

497−{-# RULES

500+{-# RULES

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

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

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

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

500#-}

503#-}

501

504

505+-- Scalar multiplication of matrices

506+

507+infixl 7 .|

508+-- | Scalar multiplication of matrices.

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

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

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

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

513+

514+-- Scalar division of matrices

515+

516+infixl 7 ./

517+-- | Scalar multiplication of matrices.

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

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

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

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

522+

502-- Projections

523-- Projections

503

524

504-- | Biproduct first component projection

525-- | Biproduct first component projection

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

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

506−p1 =

527+p1 = join id zeros

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

508− zero = zeros :: Matrix e n m

509− in junc iden zero

510

528

511-- | Biproduct second component projection

529-- | Biproduct second component projection

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

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

513−p2 =

531+p2 = join zeros id

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

515− zero = zeros :: Matrix e m n

516− in junc zero iden

517

532

518-- Injections

533-- Injections

519

534

520-- | Biproduct first component injection

535-- | Biproduct first component injection

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

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

522i1 = tr p1

537i1 = tr p1

523

538

524-- | Biproduct second component injection

539-- | Biproduct second component injection

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

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

526i2 = tr p2

541i2 = tr p2

527

542

528-- Dimensions

543-- Dimensions

529

544

530-- | Obtain the number of rows.

545-- | Obtain the number of rows.

531--

546--

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

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

533−-- dimensions in constant time.

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

534−--

549+-- constraint see 'rows''.

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

536−-- exchange for performance.

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

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

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

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

539

552

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+

540-- | Obtain the number of columns.

562-- | Obtain the number of columns.

541−--

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

543−-- dimensions in constant time.

544--

563--

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

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

546−-- exchange for performance.

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

566+-- constraint see 'columns''.

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

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

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

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

549

569

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+

550-- Coproduct Bifunctor

579-- Coproduct Bifunctor

551

580

552infixl 5 -|-

581infixl 5 -|-

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

555(-|-) ::

584(-|-) ::

556 forall e n k m j.

585 forall e n k m j.

557 ( Num e,

586 ( Num e,

558− CountableDimensions j k,

587+ CountableDims j k,

559− FromLists e k k,

588+ FL k k,

560− FromLists e j k,

589+ FL j k,

561− FromLists e k j,

590+ FL k j,

562− FromLists e j j

591+ FL j j

563 ) =>

592 ) =>

564 Matrix e n k ->

593 Matrix e n k ->

565 Matrix e m j ->

594 Matrix e m j ->

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

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

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

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

568

597

569-- Khatri Rao Product and projections

598-- Khatri Rao Product and projections

570

599

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

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

572−kp1 ::

601+fstM ::

573 forall e m k .

602 forall e m k .

574 ( Num e,

603 ( Num e,

575− CountableDimensions k m,

604+ CountableDims k m,

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

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

577 CountableN (m, k)

606 CountableN (m, k)

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

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

579−kp1 = matrixBuilder f

608+fstM = matrixBuilder' f

580 where

609 where

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

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

582 f (x, y)

611 f (x, y)

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

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

584− | otherwise = 0

613+ | otherwise = 0

585

614

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

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

587−kp2 ::

616+sndM ::

588 forall e m k .

617 forall e m k .

589 ( Num e,

618 ( Num e,

590− CountableDimensions k m,

619+ CountableDims k m,

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

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

592 CountableN (m, k)

621 CountableN (m, k)

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

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

594−kp2 = matrixBuilder f

623+sndM = matrixBuilder' f

595 where

624 where

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

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

597 f (x, y)

626 f (x, y)

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

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

599− | otherwise = 0

628+ | otherwise = 0

600

629

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

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

602--

631--

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

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

604−--

633+--

605-- @

634-- @

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

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

607−-- khatri a b ==> |

636+-- kr a b ==> |

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

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

609-- @

638-- @

610--

639--

611-- __Emphasis__ on the implication symbol.

640-- __Emphasis__ on the implication symbol.

612−khatri ::

641+kr ::

613− forall e cols a b.

642+ forall e cols a b.

614 ( Num e,

643 ( Num e,

615− CountableDimensions a b,

644+ CountableDims a b,

616 CountableN (a, b),

645 CountableN (a, b),

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

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

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

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

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

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

620−khatri a b =

649+kr a b =

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

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

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

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

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

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

624

653

625-- Product Bifunctor (Kronecker)

654-- Product Bifunctor (Kronecker)

626

655

627infixl 4 ><

656infixl 4 ><

628

657

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

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

630−(><) ::

659+(><) ::

631− forall e m p n q.

660+ forall e m p n q.

632 ( Num e,

661 ( Num e,

633− CountableDimensions m n,

662+ CountableDims m n,

634− CountableDimensions p q,

663+ CountableDims p q,

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

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

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

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

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

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

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

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

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

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

640− )

669+ )

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

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

642(><) a b =

671(><) a b =

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

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

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

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

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

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

646

675

647−-- Matrix abide Junc Split

676+-- Matrix abide Join Fork

648

677

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

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

650−--

679+--

651-- Law:

680-- Law:

652--

681--

653-- @

682-- @

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

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

655-- @

684-- @

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

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

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

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

658−abideJS Empty = Empty

659−abideJS (One e) = One e

687+abideJF (One e) = One e

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

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

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

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

662

690

663−-- Matrix abide Split Junc

691+-- Matrix abide Fork Join

664

692

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

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

666−--

694+--

667-- @

695-- @

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

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

669-- @

697-- @

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

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

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

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

672−abideSJ Empty = Empty

673−abideSJ (One e) = One e

700+abideFJ (One e) = One e

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

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

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

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

676

703

677-- Matrix transposition

704-- Matrix transposition

678

705

679-- | Matrix transposition.

706-- | Matrix transposition.

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

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

681−tr Empty = Empty

682−tr (One e) = One e

708+tr (One e) = One e

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

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

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

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

685

711

686-- Selective 'select' operator

712-- Selective 'select' operator

687

713

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

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

689-- ArrowMonad solution presented in the paper.

715-- ArrowMonad solution presented in the paper.

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

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

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

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

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

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

693−select m y = junc y identity . m

719+select m y = join y id . m

694

720

695branch ::

721branch ::

696 ( Num e,

722 ( Num e,

697− CountableDimensions a b,

723+ CountableDims a b,

698− CountableDimensions c (Either b c),

724+ CountableDims c (Either b c),

699− FromLists e c b,

725+ FL c b,

700− FromLists e a b,

726+ FL a b,

701− FromLists e a a,

727+ FL a a,

702− FromLists e b b,

728+ FL b b,

703− FromLists e c c,

729+ FL c c,

704− FromLists e b a,

730+ FL b a,

705− FromLists e b c,

731+ FL b c,

706− FromLists e (Either b c) b,

732+ FL (Either b c) b,

707− FromLists e (Either b c) c

733+ FL (Either b c) c

708 )

734 )

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

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

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

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

711 where

737 where

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

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

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

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

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

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

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

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

716 g m = i2 . m

742 g m = i2 . m

717

743

718-- McCarthy's Conditional

744-- McCarthy's Conditional

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

721cond ::

747cond ::

722 ( Trivial cols,

748 ( Trivial cols,

723 Countable cols,

749 Countable cols,

724− FromLists e () cols,

750+ FL () cols,

725− FromLists e cols (),

751+ FL cols (),

726− FromLists e cols cols,

752+ FL cols cols,

727 Bounded a,

753 Bounded a,

728 Enum a,

754 Enum a,

729 Num e,

755 Num e,

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

731 )

757 )

732 =>

758 =>

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

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

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

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

735

761

736−grd ::

762+grd ::

737 ( Trivial q,

763 ( Trivial q,

738 Countable q,

764 Countable q,

739− FromLists e () q,

765+ FL () q,

740− FromLists e q (),

766+ FL q (),

741− FromLists e q q,

767+ FL q q,

742 Bounded a,

768 Bounded a,

743 Enum a,

769 Enum a,

744 Num e,

770 Num e,

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

746 )

772 )

747 =>

773 =>

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

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

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

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

750

776

751−corr ::

777+corr ::

752− forall e a q .

778+ forall e a q .

753 ( Trivial q,

779 ( Trivial q,

754 Countable q,

780 Countable q,

755− FromLists e () q,

781+ FL () q,

756− FromLists e q (),

782+ FL q (),

757− FromLists e q q,

783+ FL q q,

758 Liftable e a Bool

784 Liftable e a Bool

759− )

785+ )

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

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

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

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

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

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

763

789

764-- Pretty print

790-- Pretty print

765

791

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

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

767prettyAux [] _ = ""

793prettyAux [] _ = ""

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

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

769 where

795 where

770 v = fmap show m

796 v = fmap show m

771 widest = maximum $ fmap length v

797 widest = maximum $ fmap length v

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

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

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

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

774 where

800 where

775− v = fmap show m

801+ v = fmap show m

776− widest = maximum $ fmap length v

802+ widest = maximum $ fmap length v

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

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

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

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

779 prettyAux t l

805 prettyAux t l

780 where

806 where

781− v = fmap show l

807+ v = fmap show l

782− widest = maximum $ fmap length v

808+ widest = maximum $ fmap length v

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

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

784

810

785-- | Matrix pretty printer

811-- | Matrix pretty printer

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

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

787pretty m = concat

813pretty m = concat

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

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

789 , unlines

815 , unlines

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

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

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

792 ]

818 ]

793 where

819 where

794− strings = map show (toList m)

820+ strings = map show (toList m)

795− widest = maximum $ map length strings

821+ widest = maximum $ map length strings

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

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

797− blank = fill ""

823+ blank = fill ""

798 safeGet i j m

824 safeGet i j m

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

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

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

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

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

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

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

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

803− getElem i j m =

829+ getElem i j m =

804 fromMaybe

830 fromMaybe

805 (error $

831 (error $

806 "getElem: Trying to get the "

832 "getElem: Trying to get the "

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

812 (safeGet i j m)

838 (safeGet i j m)

813

839

814-- | Matrix pretty printer

840-- | Matrix pretty printer

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

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

816prettyPrint = putStrLn . pretty

842prettyPrint = putStrLn . pretty

817

843

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

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

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

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

820−zipWithM f Empty Empty = Empty

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

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

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

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

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

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

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

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

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

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

826

851

827-- Relational operators functions

852-- Relational operators functions

828

853

829−type Boolean = Natural 0 1

854+type Boolean = Natural 0 1

830type Relation a b = Matrix Boolean a b

855type Relation a b = Matrix Boolean a b

831

856

832-- | Helper conversion function

857-- | Helper conversion function

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

842

867

843-- | Relational negation

868-- | Relational negation

844negateM :: Relation cols rows -> Relation cols rows

869negateM :: Relation cols rows -> Relation cols rows

845−negateM Empty = Empty

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

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

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

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

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

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

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

850

873

851-- | Relational addition

874-- | Relational addition

852orM :: Relation cols rows -> Relation cols rows -> Relation cols rows

875orM :: Relation cols rows -> Relation cols rows -> Relation cols rows

853−orM Empty Empty = Empty

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

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

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

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

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

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

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

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

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

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

859

881

860-- | Relational multiplication

882-- | Relational multiplication

861andM :: Relation cols rows -> Relation cols rows -> Relation cols rows

883andM :: Relation cols rows -> Relation cols rows -> Relation cols rows

862−andM Empty Empty = Empty

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

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

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

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

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

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

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

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

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

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

868

889

869-- | Relational subtraction

890-- | Relational subtraction

870subM :: Relation cols rows -> Relation cols rows -> Relation cols rows

891subM :: Relation cols rows -> Relation cols rows -> Relation cols rows

871−subM Empty Empty = Empty

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

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

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

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

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

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

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

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

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

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

877

897

878-- | Matrix relational composition.

898-- | Matrix relational composition.

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

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

880−compRel Empty Empty = Empty

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

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

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

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

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

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

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

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

885

904

886-- | Matrix relational right division

905-- | Matrix relational right division

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

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

888−divR Empty Empty = Empty

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

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

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

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

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

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

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

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

893

911

894-- | Matrix relational left division

912-- | Matrix relational left division

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

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

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

905--

923--

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

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

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

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

908−fromFRel ::

926+fromFRel' ::

909 forall a b cols rows.

927 forall a b cols rows.

910 ( Liftable Boolean a b,

928 ( Liftable Boolean a b,

911− CountableDimensions cols rows,

929+ CountableDims cols rows,

912− FromLists Boolean rows cols

930+ FL rows cols

913 ) =>

931 ) =>

914 (a -> b) ->

932 (a -> b) ->

915 Relation cols rows

933 Relation cols rows

916−fromFRel f =

934+fromFRel' = fromF'

917− let minA = minBound @a

918− maxA = maxBound @a

919− minB = minBound @b

920− maxB = maxBound @b

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

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

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

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

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

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

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

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

929− mList = buildList combAp rrows

930− in tr $ fromLists mList

931− where

932− buildList [] _ = []

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

934

935

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

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

936-- cardinality's.

937-- cardinality's.

937−fromFRel' ::

938+fromFRel ::

938 forall a b.

939 forall a b.

939 ( Liftable Boolean a b,

940 ( Liftable Boolean a b,

940− CountableDimensionsN a b,

941+ CountableDimsN a b,

941− FromLists Boolean (Normalize b) (Normalize a)

942+ FLN b a

942 ) =>

943 ) =>

943 (a -> b) ->

944 (a -> b) ->

944 Relation (Normalize a) (Normalize b)

945 Relation (Normalize a) (Normalize b)

945−fromFRel' f =

946+fromFRel = fromFRel'

946− let minA = minBound @a

947− maxA = maxBound @a

948− minB = minBound @b

949− maxB = maxBound @b

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

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

952− elementsA = take ccols [minA .. maxA]

953− elementsB = take rrows [minB .. maxB]

954− combinations = (,) <$> elementsA <*> elementsB

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

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

957− else ((fromEnum a, fromEnum b), nat 0)) $ combinations

958− mList = buildList combAp rrows

959− in tr $ fromLists mList

960− where

961− buildList [] _ = []

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

963

947

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

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

965−toRel ::

949+toRel ::

966 forall a b.

950 forall a b.

967 ( Bounded a,

951 ( Bounded a,

968 Bounded b,

952 Bounded b,

969 Enum a,

953 Enum a,

970 Enum b,

954 Enum b,

971 Eq b,

955 Eq b,

972− CountableDimensionsN a b,

956+ CountableDims a b,

973− FromListsN Boolean b a

957+ FLN b a

974− )

958+ )

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

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

976toRel f =

960toRel f =

977 let minA = minBound @a

961 let minA = minBound @a

978 maxA = maxBound @a

962 maxA = maxBound @a

979 minB = minBound @b

963 minB = minBound @b

980 maxB = maxBound @b

964 maxB = maxBound @b

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

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

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

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

983 elementsA = take ccols [minA .. maxA]

967 elementsA = take ccols [minA .. maxA]

984 elementsB = take rrows [minB .. maxB]

968 elementsB = take rrows [minB .. maxB]

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

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

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

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

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

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

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

972 else ((fromEnum a, fromEnum b), nat 0)) $ combinations

989 mList = buildList combAp rrows

973 mList = buildList combAp rrows

990 in tr $ fromLists mList

974 in tr $ fromLists mList

src/LAoP/Matrix/Nat.hs+132−124

@@ -56,21 +56,20 @@ module LAoP.Matrix.Nat

57 -- * Constraint type synonyms

58 Countable,

59− CountableDimensions,

59+ CountableDims,

60 CountableN,

61 CountableNz,

62− CountableDimensionsN,

62+ CountableDimsN,

63− FromListsN,

63+ FLN,

64− FromListsNz,

64+ FLNz,

65 Liftable,

66 TrivialE,

67 TrivialP,

69 -- * Primitives

70− empty,

71 one,

70 one,

72− junc,

71+ join,

73− split,

72+ fork,

75 -- * Auxiliary type families

74 -- * Auxiliary type families

76 I.FromNat,

75 I.FromNat,

@@ -78,11 +77,11 @@ module LAoP.Matrix.Nat

78 I.Normalize,

77 I.Normalize,

80 -- * Matrix construction and conversion

79 -- * Matrix construction and conversion

81− I.FromLists,

80+ I.FL,

82 fromLists,

81 fromLists,

83 toLists,

82 toLists,

84 toList,

83 toList,

85− matrixBuilder,

84+ matrixBuilder',

86 row,

85 row,

87 col,

86 col,

88 zeros,

87 zeros,

@@ -98,6 +97,10 @@ module LAoP.Matrix.Nat

98 -- ** Matrix Transposition

97 -- ** Matrix Transposition

99 tr,

98 tr,

100

100+ -- ** Scalar multiplication/division of matrices

101+ (.|),

102+ (./),

103+

101 -- ** Selective operator

104 -- ** Selective operator

102 select,

105 select,

103

106

@@ -105,19 +108,19 @@ module LAoP.Matrix.Nat

105 cond,

108 cond,

106

109

107 -- ** Matrix "abiding"

110 -- ** Matrix "abiding"

108− abideJS,

111+ abideJF,

109− abideSJ,

112+ abideFJ,

110

113

111 -- ** Zip Matrices

114 -- ** Zip Matrices

112 zipWithM,

115 zipWithM,

113

116

114 -- * Biproduct approach

117 -- * Biproduct approach

115− -- ** Split

118+ -- ** Fork

116 (===),

119 (===),

117 -- *** Projections

120 -- *** Projections

118 p1,

121 p1,

119 p2,

122 p2,

120− -- ** Junc

123+ -- ** Join

121 (|||),

124 (|||),

122 -- *** Injections

125 -- *** Injections

123 i1,

126 i1,

@@ -131,11 +134,11 @@ module LAoP.Matrix.Nat

131 -- | Note that given the restrictions imposed it is not possible to

134 -- | Note that given the restrictions imposed it is not possible to

132 -- implement the standard type classes present in standard Haskell.

135 -- implement the standard type classes present in standard Haskell.

133 -- *** Matrix pairing projections

136 -- *** Matrix pairing projections

134− kp1,

137+ fstM,

135− kp2,

138+ sndM,

136

139

137 -- *** Matrix pairing

140 -- *** Matrix pairing

138− khatri,

141+ kr,

139

142

140 -- * Matrix composition and lifting

143 -- * Matrix composition and lifting

141

144

@@ -143,10 +146,10 @@ module LAoP.Matrix.Nat

143

146

144 -- | Note that given the restrictions imposed it is not possible to

147 -- | Note that given the restrictions imposed it is not possible to

145 -- implement the standard type classes present in standard Haskell.

148 -- implement the standard type classes present in standard Haskell.

146− identity,

149+ iden,

147 comp,

150 comp,

148− fromF,

149 fromF',

151 fromF',

152+ fromF,

150

153

151 -- * Matrix printing

154 -- * Matrix printing

152 pretty,

155 pretty,

@@ -157,47 +160,34 @@ where

157import Data.Proxy

160import Data.Proxy

158import GHC.TypeLits

161import GHC.TypeLits

159import Control.DeepSeq

162import Control.DeepSeq

160−import qualified Control.Category as C

161import qualified LAoP.Matrix.Internal as I

163import qualified LAoP.Matrix.Internal as I

162

164

163newtype Matrix e (cols :: Nat) (rows :: Nat) = M (I.Matrix e (I.FromNat cols) (I.FromNat rows))

165newtype Matrix e (cols :: Nat) (rows :: Nat) = M (I.Matrix e (I.FromNat cols) (I.FromNat rows))

164 deriving (Show, Num, Eq, Ord, NFData) via (I.Matrix e (I.FromNat cols) (I.FromNat rows))

166 deriving (Show, Num, Eq, Ord, NFData) via (I.Matrix e (I.FromNat cols) (I.FromNat rows))

165

167

166-- | Constraint type synonyms to keep the type signatures less convoluted

168-- | Constraint type synonyms to keep the type signatures less convoluted

167−type Countable a = KnownNat (I.Count a)

169+type Countable a = KnownNat (I.Count a)

168−type CountableDimensions a b = (Countable a, Countable b)

170+type CountableDims a b = (Countable a, Countable b)

169−type CountableN a = KnownNat (I.Count (I.FromNat a))

171+type CountableN a = KnownNat (I.Count (I.FromNat a))

170−type CountableNz a = KnownNat (I.Count (I.Normalize a))

172+type CountableNz a = KnownNat (I.Count (I.Normalize a))

171−type CountableDimensionsN a b = (CountableN a, CountableN b)

173+type CountableDimsN a b = (CountableN a, CountableN b)

172−type FromListsN e a b = I.FromLists e (I.FromNat a) (I.FromNat b)

174+type FLN e a b = I.FL (I.FromNat a) (I.FromNat b)

173−type FromListsNz e a b = I.FromLists e (I.Normalize a) (I.Normalize b)

175+type FLNz e a b = I.FL (I.Normalize a) (I.Normalize b)

174−type Liftable e a b = (Bounded a, Bounded b, Enum a, Enum b, Eq b, Num e, Ord e)

176+type Liftable e a b = (Bounded a, Bounded b, Enum a, Enum b, Eq b, Num e, Ord e)

175−type TrivialE a b = I.FromNat (a + b) ~ Either (I.FromNat a) (I.FromNat b)

177+type TrivialE a b = I.FromNat (a + b) ~ Either (I.FromNat a) (I.FromNat b)

176−type TrivialP a b = I.FromNat (a * b) ~ I.FromNat (I.Count (I.FromNat a) * I.Count (I.FromNat b))

178+type TrivialP a b = I.FromNat (a * b) ~ I.FromNat (I.Count (I.FromNat a) * I.Count (I.FromNat b))

177−

178−-- | It isn't possible to implement the 'id' function so it's

179−-- implementation is 'undefined'. However 'comp' can be and this partial

180−-- class implementation exists just to make the code more readable.

181−--

182−-- Please use 'identity' instead.

183−instance (Num e) => C.Category (Matrix e) where

184− id = undefined

185− (.) = comp

186

179

187-- Primitives

180-- Primitives

188

181

189−empty :: Matrix e 0 0

190−empty = M I.Empty

191−

192one :: e -> Matrix e 1 1

182one :: e -> Matrix e 1 1

193one = M . I.One

183one = M . I.One

194

184

195−junc ::

185+join ::

196 (TrivialE a b) =>

186 (TrivialE a b) =>

197 Matrix e a rows ->

187 Matrix e a rows ->

198 Matrix e b rows ->

188 Matrix e b rows ->

199 Matrix e (a + b) rows

189 Matrix e (a + b) rows

200−junc (M a) (M b) = M (I.Junc a b)

190+join (M a) (M b) = M (I.Join a b)

201

191

202infixl 3 |||

192infixl 3 |||

203(|||) ::

193(|||) ::

@@ -205,14 +195,14 @@ infixl 3 |||

205 Matrix e a rows ->

195 Matrix e a rows ->

206 Matrix e b rows ->

196 Matrix e b rows ->

207 Matrix e (a + b) rows

197 Matrix e (a + b) rows

208−(|||) = junc

198+(|||) = join

209

199

210−split ::

200+fork ::

211 (TrivialE a b) =>

201 (TrivialE a b) =>

212 Matrix e cols a ->

202 Matrix e cols a ->

213 Matrix e cols b ->

203 Matrix e cols b ->

214 Matrix e cols (a + b)

204 Matrix e cols (a + b)

215−split (M a) (M b) = M (I.Split a b)

205+fork (M a) (M b) = M (I.Fork a b)

216

206

217infixl 2 ===

207infixl 2 ===

218(===) ::

208(===) ::

@@ -220,43 +210,45 @@ infixl 2 ===

220 Matrix e cols a ->

210 Matrix e cols a ->

221 Matrix e cols b ->

211 Matrix e cols b ->

222 Matrix e cols (a + b)

212 Matrix e cols (a + b)

223−(===) = split

213+(===) = fork

224

214

225-- Construction

215-- Construction

226

216

227−fromLists :: (FromListsN e cols rows) => [[e]] -> Matrix e cols rows

217+fromLists :: (FLN e cols rows) => [[e]] -> Matrix e cols rows

228fromLists = M . I.fromLists

218fromLists = M . I.fromLists

229

219

220+-- | Matrix builder function. Constructs a matrix provided with

221+-- a construction function that operates with indices.

230−matrixBuilder ::

222+matrixBuilder' ::

231− (FromListsN e cols rows, CountableN cols, CountableN rows)

223+ (FLN e cols rows, CountableN cols, CountableN rows)

232 => ((Int, Int) -> e) -> Matrix e cols rows

224 => ((Int, Int) -> e) -> Matrix e cols rows

233−matrixBuilder = M . I.matrixBuilder

225+matrixBuilder' = M . I.matrixBuilder'

234

226

235−col :: (I.FromLists e () (I.FromNat rows)) => [e] -> Matrix e 1 rows

227+col :: (I.FL () (I.FromNat rows)) => [e] -> Matrix e 1 rows

236col = M . I.col

228col = M . I.col

237

229

238−row :: (I.FromLists e (I.FromNat cols) ()) => [e] -> Matrix e cols 1

230+row :: (I.FL (I.FromNat cols) ()) => [e] -> Matrix e cols 1

239row = M . I.row

231row = M . I.row

240

232

241−fromF ::

233+fromF' ::

242 ( Liftable e a b,

234 ( Liftable e a b,

243 CountableN cols,

235 CountableN cols,

244 CountableN rows,

236 CountableN rows,

245− FromListsN e rows cols

237+ FLN e rows cols

246 ) =>

238 ) =>

247 (a -> b) ->

239 (a -> b) ->

248 Matrix e cols rows

240 Matrix e cols rows

249−fromF = M . I.fromF

241+fromF' = M . I.fromF'

250

242

251−fromF' ::

243+fromF ::

252 ( Liftable e a b,

244 ( Liftable e a b,

253 CountableNz a,

245 CountableNz a,

254 CountableNz b,

246 CountableNz b,

255− FromListsNz e b a

247+ FLNz e b a

256 ) =>

248 ) =>

257 (a -> b) ->

249 (a -> b) ->

258 Matrix e (I.Count a) (I.Count b)

250 Matrix e (I.Count a) (I.Count b)

259−fromF' = undefined -- M . I.fromF'

251+fromF = undefined -- M . I.fromF

260

252

261-- Conversion

253-- Conversion

262

254

@@ -269,21 +261,21 @@ toList (M m) = I.toList m

269-- Zeros Matrix

261-- Zeros Matrix

270

262

271zeros ::

263zeros ::

272− (Num e, FromListsN e cols rows, CountableN cols, CountableN rows) =>

264+ (Num e, FLN e cols rows, CountableN cols, CountableN rows) =>

273 Matrix e cols rows

265 Matrix e cols rows

274zeros = M I.zeros

266zeros = M I.zeros

275

267

276-- Ones Matrix

268-- Ones Matrix

277

269

278ones ::

270ones ::

279− (Num e, FromListsN e cols rows, CountableN cols, CountableN rows) =>

271+ (Num e, FLN e cols rows, CountableN cols, CountableN rows) =>

280 Matrix e cols rows

272 Matrix e cols rows

281ones = M I.ones

273ones = M I.ones

282

274

283-- Const Matrix

275-- Const Matrix

284

276

285constant ::

277constant ::

286− (Num e, FromListsN e cols rows, CountableN cols, CountableN rows) =>

278+ (Num e, FLN e cols rows, CountableN cols, CountableN rows) =>

287 e ->

279 e ->

288 Matrix e cols rows

280 Matrix e cols rows

289constant = M . I.constant

281constant = M . I.constant

@@ -292,27 +284,41 @@ constant = M . I.constant

292

284

293bang ::

285bang ::

294 forall e cols.

286 forall e cols.

295− (Num e, Enum e, I.FromLists e (I.FromNat cols) (), CountableN cols) =>

287+ (Num e, Enum e, I.FL (I.FromNat cols) (), CountableN cols) =>

296 Matrix e cols 1

288 Matrix e cols 1

297bang = M I.bang

289bang = M I.bang

298

290

299−-- Identity Matrix

291+-- iden Matrix

300

292

301−identity ::

293+iden ::

302− (Num e, FromListsN e cols cols, CountableN cols) =>

294+ (Num e, FLN e cols cols, CountableN cols) =>

303 Matrix e cols cols

295 Matrix e cols cols

304−identity = M I.identity

296+iden = M I.iden

305

297

306-- Matrix composition (MMM)

298-- Matrix composition (MMM)

307

299

308comp :: (Num e) => Matrix e cr rows -> Matrix e cols cr -> Matrix e cols rows

300comp :: (Num e) => Matrix e cr rows -> Matrix e cols cr -> Matrix e cols rows

309comp (M a) (M b) = M (I.comp a b)

301comp (M a) (M b) = M (I.comp a b)

310

302

303+-- Scalar multiplication of matrices

304+

305+infixl 7 .|

306+-- | Scalar multiplication of matrices.

307+(.|) :: Num e => e -> Matrix e cols rows -> Matrix e cols rows

308+(.|) e (M m) = M (e I..| m)

309+

310+-- Scalar division of matrices

311+

312+infixl 7 ./

313+-- | Scalar multiplication of matrices.

314+(./) :: Fractional e => Matrix e cols rows -> e -> Matrix e cols rows

315+(./) (M m) e = M (m I../ e)

316+

311p1 ::

317p1 ::

312 ( Num e,

318 ( Num e,

313− CountableDimensionsN n m,

319+ CountableDimsN n m,

314− FromListsN e n m,

320+ FLN e n m,

315− FromListsN e m m,

321+ FLN e m m,

316 TrivialE m n

322 TrivialE m n

317 ) =>

323 ) =>

318 Matrix e (m + n) m

324 Matrix e (m + n) m

@@ -320,9 +326,9 @@ p1 = M I.p1

320

326

321p2 ::

327p2 ::

322 ( Num e,

328 ( Num e,

323− CountableDimensionsN n m,

329+ CountableDimsN n m,

324− FromListsN e m n,

330+ FLN e m n,

325− FromListsN e n n,

331+ FLN e n n,

326 TrivialE m n

332 TrivialE m n

327 ) =>

333 ) =>

328 Matrix e (m + n) n

334 Matrix e (m + n) n

@@ -332,9 +338,9 @@ p2 = M I.p2

332

338

333i1 ::

339i1 ::

334 ( Num e,

340 ( Num e,

335− CountableDimensionsN n rows,

341+ CountableDimsN n rows,

336− FromListsN e n rows,

342+ FLN e n rows,

337− FromListsN e rows rows,

343+ FLN e rows rows,

338 TrivialE rows n

344 TrivialE rows n

339 ) =>

345 ) =>

340 Matrix e rows (rows + n)

346 Matrix e rows (rows + n)

@@ -342,9 +348,9 @@ i1 = tr p1

342

348

343i2 ::

349i2 ::

344 ( Num e,

350 ( Num e,

345− CountableDimensionsN rows m,

351+ CountableDimsN rows m,

346− FromListsN e m rows,

352+ FLN e m rows,

347− FromListsN e rows rows,

353+ FLN e rows rows,

348 TrivialE m rows

354 TrivialE m rows

349 ) =>

355 ) =>

350 Matrix e rows (m + rows)

356 Matrix e rows (m + rows)

@@ -358,16 +364,16 @@ rows (M m) = I.rows m

358columns :: (CountableN cols) => Matrix e cols rows -> Int

364columns :: (CountableN cols) => Matrix e cols rows -> Int

359columns (M m) = I.columns m

365columns (M m) = I.columns m

360

366

361−-- | Coproduct Bifunctor

362infixl 5 -|-

367infixl 5 -|-

363

368

369+-- | Coproduct Bifunctor (Direct sum)

364(-|-) ::

370(-|-) ::

365 ( Num e,

371 ( Num e,

366− CountableDimensionsN j k,

372+ CountableDimsN j k,

367− FromListsN e k k,

373+ FLN e k k,

368− FromListsN e j k,

374+ FLN e j k,

369− FromListsN e k j,

375+ FLN e k j,

370− FromListsN e j j,

376+ FLN e j j,

371 TrivialE n m,

377 TrivialE n m,

372 TrivialE k j

378 TrivialE k j

373 ) =>

379 ) =>

@@ -376,40 +382,42 @@ infixl 5 -|-

376 Matrix e (n + m) (k + j)

382 Matrix e (n + m) (k + j)

377(-|-) (M a) (M b) = M ((I.-|-) a b)

383(-|-) (M a) (M b) = M ((I.-|-) a b)

378

384

379−-- | Khatri Rao Product and projections

385+-- | Khatri Rao Product first projection

380−kp1 ::

386+fstM ::

381 forall e m k .

387 forall e m k .

382 ( Num e,

388 ( Num e,

383− CountableDimensionsN m k,

389+ CountableDimsN m k,

384 CountableN (m * k),

390 CountableN (m * k),

385− FromListsN e (m * k) m,

391+ FLN e (m * k) m,

386 TrivialP m k

392 TrivialP m k

387 ) => Matrix e (m * k) m

393 ) => Matrix e (m * k) m

388−kp1 = M (I.kp1 @e @(I.FromNat m) @(I.FromNat k))

394+fstM = M (I.fstM @e @(I.FromNat m) @(I.FromNat k))

389

395

390−kp2 ::

396+-- | Khatri Rao Product second projection

397+sndM ::

391 forall e m k.

398 forall e m k.

392 ( Num e,

399 ( Num e,

393− CountableDimensionsN k m,

400+ CountableDimsN k m,

394− FromListsN e (m * k) k,

401+ FLN e (m * k) k,

395 CountableN (m * k),

402 CountableN (m * k),

396 TrivialP m k

403 TrivialP m k

397 ) => Matrix e (m * k) k

404 ) => Matrix e (m * k) k

398−kp2 = M (I.kp2 @e @(I.FromNat m) @(I.FromNat k))

405+sndM = M (I.sndM @e @(I.FromNat m) @(I.FromNat k))

399

406

400−khatri ::

407+-- | Khatri Rao Product

408+kr ::

401 forall e cols a b.

409 forall e cols a b.

402 ( Num e,

410 ( Num e,

403− CountableDimensionsN a b,

411+ CountableDimsN a b,

404 CountableN (a * b),

412 CountableN (a * b),

405− FromListsN e (a * b) a,

413+ FLN e (a * b) a,

406− FromListsN e (a * b) b,

414+ FLN e (a * b) b,

407 TrivialP a b

415 TrivialP a b

408 ) => Matrix e cols a -> Matrix e cols b -> Matrix e cols (a * b)

416 ) => Matrix e cols a -> Matrix e cols b -> Matrix e cols (a * b)

409−khatri a b =

417+kr a b =

410− let kp1' = kp1 @e @a @b

418+ let fstM' = fstM @e @a @b

411− kp2' = kp2 @e @a @b

419+ sndM' = sndM @e @a @b

412− in comp (tr kp1') a * comp (tr kp2') b

420+ in comp (tr fstM') a * comp (tr sndM') b

413

421

414-- | Product Bifunctor (Kronecker)

422-- | Product Bifunctor (Kronecker)

415infixl 4 ><

423infixl 4 ><

@@ -417,28 +425,28 @@ infixl 4 ><

417(><) ::

425(><) ::

418 forall e m p n q.

426 forall e m p n q.

419 ( Num e,

427 ( Num e,

420− CountableDimensionsN m n,

428+ CountableDimsN m n,

421− CountableDimensionsN p q,

429+ CountableDimsN p q,

422− CountableDimensionsN (m * n) (p * q),

430+ CountableDimsN (m * n) (p * q),

423− FromListsN e (m * n) m,

431+ FLN e (m * n) m,

424− FromListsN e (m * n) n,

432+ FLN e (m * n) n,

425− FromListsN e (p * q) p,

433+ FLN e (p * q) p,

426− FromListsN e (p * q) q,

434+ FLN e (p * q) q,

427 TrivialP m n,

435 TrivialP m n,

428 TrivialP p q

436 TrivialP p q

429 ) => Matrix e m p -> Matrix e n q -> Matrix e (m * n) (p * q)

437 ) => Matrix e m p -> Matrix e n q -> Matrix e (m * n) (p * q)

430(><) a b =

438(><) a b =

431− let kp1' = kp1 @e @m @n

439+ let fstM' = fstM @e @m @n

432− kp2' = kp2 @e @m @n

440+ sndM' = sndM @e @m @n

433− in khatri (comp a kp1') (comp b kp2')

441+ in kr (comp a fstM') (comp b sndM')

434

442

435−-- | Matrix abide Junc Split

443+-- | Matrix abide Join Fork

436−abideJS :: Matrix e cols rows -> Matrix e cols rows

444+abideJF :: Matrix e cols rows -> Matrix e cols rows

437−abideJS (M m) = M (I.abideJS m)

445+abideJF (M m) = M (I.abideJF m)

438

446

439−-- | Matrix abide Split Junc

447+-- | Matrix abide Fork Join

440−abideSJ :: Matrix e cols rows -> Matrix e cols rows

448+abideFJ :: Matrix e cols rows -> Matrix e cols rows

441−abideSJ (M m) = M (I.abideSJ m)

449+abideFJ (M m) = M (I.abideFJ m)

442

450

443-- | Matrix transposition

451-- | Matrix transposition

444tr :: Matrix e cols rows -> Matrix e rows cols

452tr :: Matrix e cols rows -> Matrix e rows cols

@@ -447,7 +455,7 @@ tr (M m) = M (I.tr m)

447-- Selective 'select' operator

455-- Selective 'select' operator

448select ::

456select ::

449 ( Num e,

457 ( Num e,

450− FromListsN e rows1 rows1,

458+ FLN e rows1 rows1,

451 CountableN rows1,

459 CountableN rows1,

452 I.FromNat rows2 ~ I.FromNat rows1,

460 I.FromNat rows2 ~ I.FromNat rows1,

453 I.FromNat cols1 ~ I.FromNat cols2,

461 I.FromNat cols1 ~ I.FromNat cols2,

@@ -460,9 +468,9 @@ select (M m) (M y) = M (I.select m y)

460cond ::

468cond ::

461 ( I.FromNat (I.Count (I.FromNat cols)) ~ I.FromNat cols,

469 ( I.FromNat (I.Count (I.FromNat cols)) ~ I.FromNat cols,

462 CountableN cols,

470 CountableN cols,

463− I.FromLists e () (I.FromNat cols),

471+ I.FL () (I.FromNat cols),

464− I.FromLists e (I.FromNat cols) (),

472+ I.FL (I.FromNat cols) (),

465− FromListsN e cols cols,

473+ FLN e cols cols,

466 Liftable e a Bool

474 Liftable e a Bool

467 )

475 )

468 =>

476 =>

@@ -471,10 +479,10 @@ cond p (M a) (M b) = M (I.cond p a b)

471

479

472-- Pretty print

480-- Pretty print

473

481

474−pretty :: (CountableDimensionsN cols rows, Show e) => Matrix e cols rows -> String

482+pretty :: (CountableDimsN cols rows, Show e) => Matrix e cols rows -> String

475pretty (M m) = I.pretty m

483pretty (M m) = I.pretty m

476

484

477−prettyPrint :: (CountableDimensionsN cols rows, Show e) => Matrix e cols rows -> IO ()

485+prettyPrint :: (CountableDimsN cols rows, Show e) => Matrix e cols rows -> IO ()

478prettyPrint (M m) = I.prettyPrint m

486prettyPrint (M m) = I.prettyPrint m

479

487

480-- | Zip two matrices with a given binary function

488-- | Zip two matrices with a given binary function

src/LAoP/Matrix/Type.hs+217−180

@@ -1,11 +1,11 @@

1{-# LANGUAGE ConstraintKinds #-}

2+{-# LANGUAGE TypeFamilies #-}

2{-# LANGUAGE AllowAmbiguousTypes #-}

3{-# LANGUAGE AllowAmbiguousTypes #-}

3{-# LANGUAGE DataKinds #-}

4{-# LANGUAGE DataKinds #-}

4{-# LANGUAGE DerivingVia #-}

5{-# LANGUAGE DerivingVia #-}

5{-# LANGUAGE FlexibleContexts #-}

6{-# LANGUAGE FlexibleContexts #-}

6{-# LANGUAGE FlexibleInstances #-}

7{-# LANGUAGE FlexibleInstances #-}

7{-# LANGUAGE GADTs #-}

8{-# LANGUAGE GADTs #-}

8−{-# LANGUAGE KindSignatures #-}

9{-# LANGUAGE MultiParamTypeClasses #-}

10{-# LANGUAGE NoStarIsType #-}

11{-# LANGUAGE RankNTypes #-}

@@ -58,10 +58,10 @@ module LAoP.Matrix.Type

59 -- * Constraint type aliases

60 Countable,

61− CountableDimensions,

61+ CountableDims,

62 CountableN,

63− CountableDimensionsN,

63+ CountableDimsN,

64− FromListsN,

64+ FLN,

65 Liftable,

66 Trivial,

67 TrivialP,

@@ -71,10 +71,9 @@ module LAoP.Matrix.Type

71 One,

73 -- * Primitives

74− empty,

75 one,

74 one,

76− junc,

75+ join,

77− split,

76+ fork,

79 -- * Auxiliary type families

78 -- * Auxiliary type families

80 I.FromNat,

79 I.FromNat,

@@ -86,6 +85,7 @@ module LAoP.Matrix.Type

86 fromLists,

85 fromLists,

87 toLists,

86 toLists,

88 toList,

87 toList,

88+ matrixBuilder',

89 matrixBuilder,

90 row,

91 col,

@@ -104,8 +104,8 @@ module LAoP.Matrix.Type

104 multM,

105

106 -- * Selective equivalent instance function

107− selectM,

107+ selectM,

108−

108+

109 -- * Monad equivalent instance function

110 returnM,

111 bindM,

@@ -113,28 +113,34 @@ module LAoP.Matrix.Type

113 -- * Misc

114 -- ** Get dimensions

115 columns,

116+ columns',

116 rows,

117 rows,

118+ rows',

117

119

118 -- ** Matrix Transposition

120 -- ** Matrix Transposition

119 tr,

121 tr,

120

122

123+ -- ** Scalar multiplication/division of matrices

124+ (.|),

125+ (./),

126+

121 -- ** McCarthy's Conditional

127 -- ** McCarthy's Conditional

122 cond,

128 cond,

123

129

124 -- ** Matrix "abiding"

130 -- ** Matrix "abiding"

125− abideJS,

131+ abideJF,

126− abideSJ,

132+ abideFJ,

127

133

128 -- ** Zip Matrices

134 -- ** Zip Matrices

129 zipWithM,

135 zipWithM,

130

136

131 -- * Biproduct approach

137 -- * Biproduct approach

132− -- ** Split

138+ -- ** Fork

133 (===),

139 (===),

134 -- *** Projections

140 -- *** Projections

135 p1,

141 p1,

136 p2,

142 p2,

137− -- ** Junc

143+ -- ** Join

138 (|||),

144 (|||),

139 -- *** Injections

145 -- *** Injections

140 i1,

146 i1,

@@ -148,11 +154,11 @@ module LAoP.Matrix.Type

148 -- | Note that given the restrictions imposed it is not possible to

154 -- | Note that given the restrictions imposed it is not possible to

149 -- implement the standard type classes present in standard Haskell.

155 -- implement the standard type classes present in standard Haskell.

150 -- *** Matrix pairing projections

156 -- *** Matrix pairing projections

151− kp1,

157+ fstM,

152− kp2,

158+ sndM,

153

159

154 -- *** Matrix pairing

160 -- *** Matrix pairing

155− khatri,

161+ kr,

156

162

157 -- * Matrix composition and lifting

163 -- * Matrix composition and lifting

158

164

@@ -160,10 +166,10 @@ module LAoP.Matrix.Type

160

166

161 -- | Note that given the restrictions imposed it is not possible to

167 -- | Note that given the restrictions imposed it is not possible to

162 -- implement the standard type classes present in standard Haskell.

168 -- implement the standard type classes present in standard Haskell.

163− identity,

169+ iden,

164 comp,

170 comp,

165− fromF,

166 fromF',

171 fromF',

172+ fromF,

167

173

168 -- * Relation

174 -- * Relation

169 toRel,

175 toRel,

@@ -177,46 +183,44 @@ where

177import Data.Void

183import Data.Void

178import Data.Proxy

184import Data.Proxy

179import Data.Kind

185import Data.Kind

180−import GHC.TypeLits

186+import GHC.TypeLits

181import Control.DeepSeq

187import Control.DeepSeq

182import LAoP.Utils

188import LAoP.Utils

183−import qualified Control.Category as C

184import qualified LAoP.Matrix.Internal as I

189import qualified LAoP.Matrix.Internal as I

190+import Prelude hiding (id, (.))

185

191

186newtype Matrix e (cols :: Type) (rows :: Type) = M (I.Matrix e (I.Normalize cols) (I.Normalize rows))

192newtype Matrix e (cols :: Type) (rows :: Type) = M (I.Matrix e (I.Normalize cols) (I.Normalize rows))

187 deriving (Show, Num, Eq, Ord, NFData) via (I.Matrix e (I.Normalize cols) (I.Normalize rows))

193 deriving (Show, Num, Eq, Ord, NFData) via (I.Matrix e (I.Normalize cols) (I.Normalize rows))

188

194

189-- | Constraint type synonyms to keep the type signatures less convoluted

195-- | Constraint type synonyms to keep the type signatures less convoluted

190−type Countable a = KnownNat (I.Count a)

196+type Countable a = KnownNat (I.Count a)

191−type CountableDimensions a b = (Countable a, Countable b)

197+type CountableDims a b = (Countable a, Countable b)

192−type CountableN a = KnownNat (I.Count (I.Normalize a))

198+type CountableN a = KnownNat (I.Count (I.Normalize a))

193−type CountableDimensionsN a b = (CountableN a, CountableN b)

199+type CountableDimsN a b = (CountableN a, CountableN b)

194−type FromListsN e a b = I.FromLists e (I.Normalize a) (I.Normalize b)

200+type FLN a b = I.FromLists (I.Normalize a) (I.Normalize b)

195−type Liftable e a b = (Bounded a, Bounded b, Enum a, Enum b, Eq b, Num e, Ord e)

201+type Liftable e a b = (Bounded a, Bounded b, Enum a, Enum b, Eq b, Num e, Ord e)

196−type Trivial a = I.Normalize (I.Normalize a) ~ I.Normalize (I.Normalize (I.Normalize a))

202+type Trivial a = I.Normalize (I.Normalize a) ~ I.Normalize (I.Normalize (I.Normalize a))

197−type Trivial2 a = I.Normalize a ~ I.Normalize (I.Normalize a)

203+type Trivial2 a = I.Normalize a ~ I.Normalize (I.Normalize a)

198−type Trivial3 a = I.FromNat (I.Count (I.Normalize (I.Normalize a))) ~ I.Normalize (I.Normalize a)

204+type Trivial3 a = I.FromNat (I.Count (I.Normalize (I.Normalize a))) ~ I.Normalize (I.Normalize a)

199−type TrivialP a b = I.Normalize (a, b) ~ I.Normalize (I.Normalize a, I.Normalize b)

205+type TrivialP a b = I.Normalize (a, b) ~ I.Normalize (I.Normalize a, I.Normalize b)

200−

206+

201−-- | It isn't possible to implement the 'id' function so it's

207+-- | It is possible to implement a constrained version of the category type

202−-- implementation is 'undefined'. However 'comp' can be and this partial

208+-- class.

203−-- class implementation exists just to make the code more readable.

204−--

205−-- Please use 'identity' instead.

206−instance (Num e) => C.Category (Matrix e) where

209+instance (Num e) => Category (Matrix e) where

207− id = undefined

210+ type Object (Matrix e) a = (FLN a a, CountableN a)

211+ id = iden

208− (.) = comp

212+ (.) = comp

209

213

210-- | Bifunctor equivalent function

214-- | Bifunctor equivalent function

211bimapM ::

215bimapM ::

212 ( Liftable e a b,

216 ( Liftable e a b,

213 Liftable e c d,

217 Liftable e c d,

214− CountableDimensionsN a c,

218+ CountableDimsN a c,

215− CountableDimensionsN b d,

219+ CountableDimsN b d,

216− FromListsN e d c,

220+ FLN d c,

217− FromListsN e b a

221+ FLN b a

218 ) => (a -> b) -> (c -> d) -> Matrix e a c -> Matrix e b d

222 ) => (a -> b) -> (c -> d) -> Matrix e a c -> Matrix e b d

219−bimapM f g m = fromF' g `comp` m `comp` tr (fromF' f)

223+bimapM f g m = fromF g . m . tr (fromF f)

220

224

221-- | Zero type alias

225-- | Zero type alias

222type Zero = Void

226type Zero = Void

@@ -226,78 +230,74 @@ type One = ()

226

230

227-- Primitives

231-- Primitives

228

232

229−-- | Empty matrix constructor

230−empty :: Matrix e Zero Zero

231−empty = M I.Empty

232−

233-- | Unit matrix constructor

234one :: e -> Matrix e One One

235one = M . I.One

236

237−-- | Matrix 'Junc' constructor

237+-- | Matrix 'Join' constructor

238−junc ::

238+join ::

239 Matrix e a rows ->

240 Matrix e b rows ->

241 Matrix e (Either a b) rows

242−junc (M a) (M b) = M (I.Junc a b)

242+join (M a) (M b) = M (I.Join a b)

243

244infixl 3 |||

245−-- | Matrix 'Junc' constructor

245+-- | Matrix 'Join' constructor

246(|||) ::

247 Matrix e a rows ->

248 Matrix e b rows ->

249 Matrix e (Either a b) rows

250−(|||) = junc

250+(|||) = join

251

252−-- | Matrix 'Split' constructor

252+-- | Matrix 'Fork' constructor

253−split ::

253+fork ::

254 Matrix e cols a ->

255 Matrix e cols b ->

256 Matrix e cols (Either a b)

257−split (M a) (M b) = M (I.Split a b)

257+fork (M a) (M b) = M (I.Fork a b)

258

259infixl 2 ===

260−-- | Matrix 'Split' constructor

260+-- | Matrix 'Fork' constructor

261(===) ::

262 Matrix e cols a ->

263 Matrix e cols b ->

264 Matrix e cols (Either a b)

265−(===) = split

265+(===) = fork

266

267-- Functor hierarchy

268

269-- | Functor instance equivalent function

270−fmapM ::

270+fmapM ::

271 ( Liftable e a b,

272− CountableDimensionsN a b,

272+ CountableDimsN a b,

273− FromListsN e b a

273+ FLN b a

274 )

275 =>

276 (a -> b) -> Matrix e c a -> Matrix e c b

277−fmapM f m = fromF' f `comp` m

277+fmapM f m = fromF f . m

278

279-- | Applicative instance equivalent 'unit' function,

280unitM :: (Num e) => Matrix e () ()

281unitM = one 1

282

283-- | Applicative instance equivalent 'unit' function,

284−multM ::

284+multM ::

285− ( CountableDimensionsN a b,

285+ ( CountableDimsN a b,

286 CountableN (a, b),

287 Num e,

288− FromListsN e (a, b) a,

288+ FLN (a, b) a,

289− FromListsN e (a, b) b,

289+ FLN (a, b) b,

290 TrivialP a b

291 ) => Matrix e c a -> Matrix e c b -> Matrix e c (a, b)

292−multM = khatri

292+multM = kr

293

294-- | Monad instance equivalent 'return' function,

295−returnM ::

295+returnM ::

296− forall e a .

296+ forall e a .

297 ( Num e,

298 Enum e,

299 Enum a,

300− FromListsN e () a,

300+ FLN () a,

301 Countable a

302 ) => a -> Matrix e One a

303returnM a = col l

@@ -314,51 +314,64 @@ bindM = flip comp

314

315-- | Build a matrix out of a list of list of elements. Throws a runtime

316-- error if the dimensions do not match.

317−fromLists :: (FromListsN e cols rows) => [[e]] -> Matrix e cols rows

317+fromLists :: (FLN cols rows) => [[e]] -> Matrix e cols rows

318fromLists = M . I.fromLists

319

320-- | Matrix builder function. Constructs a matrix provided with

321−-- a construction function.

321+-- a construction function that operates with indices.

322−matrixBuilder ::

322+matrixBuilder' ::

323− (FromListsN e cols rows, CountableDimensionsN cols rows )

323+ (FLN cols rows, CountableDimsN cols rows )

324 => ((Int, Int) -> e) -> Matrix e cols rows

325−matrixBuilder = M . I.matrixBuilder

325+matrixBuilder' = M . I.matrixBuilder'

326+

327+-- | Matrix builder function. Constructs a matrix provided with

328+-- a construction function that operates with arbitrary types.

329+matrixBuilder ::

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)

326

339

327-- | Constructs a column vector matrix

340-- | Constructs a column vector matrix

328−col :: (FromListsN e () rows) => [e] -> Matrix e One rows

341+col :: (FLN () rows) => [e] -> Matrix e One rows

329col = M . I.col

342col = M . I.col

330

343

331-- | Constructs a row vector matrix

344-- | Constructs a row vector matrix

332−row :: (FromListsN e cols ()) => [e] -> Matrix e cols One

345+row :: (FLN cols ()) => [e] -> Matrix e cols One

333row = M . I.row

346row = M . I.row

334

347

335-- | Lifts functions to matrices with arbitrary dimensions.

348-- | Lifts functions to matrices with arbitrary dimensions.

336--

349--

337-- NOTE: Be careful to not ask for a matrix bigger than the cardinality of

350-- NOTE: Be careful to not ask for a matrix bigger than the cardinality of

338-- types @a@ or @b@ allows.

351-- types @a@ or @b@ allows.

339−fromF ::

352+fromF' ::

340 ( Liftable e a b,

353 ( Liftable e a b,

341− CountableDimensionsN cols rows,

354+ CountableDimsN cols rows,

342− FromListsN e rows cols

355+ FLN rows cols

343 ) =>

356 ) =>

344 (a -> b) -> Matrix e cols rows

357 (a -> b) -> Matrix e cols rows

345−fromF = M . I.fromF

358+fromF' = M . I.fromF'

346

359

347-- | Lifts functions to matrices with dimensions matching @a@ and @b@

360-- | Lifts functions to matrices with dimensions matching @a@ and @b@

348-- cardinality's.

361-- cardinality's.

349−fromF' ::

362+fromF ::

350 ( Liftable e a b,

363 ( Liftable e a b,

351− CountableDimensionsN a b,

364+ CountableDimsN a b,

352− FromListsN e b a

365+ FLN b a

353 ) =>

366 ) =>

354 (a -> b) -> Matrix e a b

367 (a -> b) -> Matrix e a b

355−fromF' = M . I.fromF'

368+fromF = M . I.fromF

356

369

357-- | Lifts relation functions to Boolean Matrix

370-- | Lifts relation functions to Boolean Matrix

358toRel ::

371toRel ::

359 ( Liftable (Natural 0 1) a b,

372 ( Liftable (Natural 0 1) a b,

360− CountableDimensionsN a b,

373+ CountableDims a b,

361− FromListsN (Natural 0 1) b a

374+ FLN b a

362 ) => (a -> b -> Bool) -> Matrix (Natural 0 1) a b

375 ) => (a -> b -> Bool) -> Matrix (Natural 0 1) a b

363toRel = M . I.toRel

376toRel = M . I.toRel

364

377

@@ -376,7 +389,7 @@ toList (M m) = I.toList m

376

389

377-- | The zero matrix. A matrix wholly filled with zeros.

390-- | The zero matrix. A matrix wholly filled with zeros.

378zeros ::

391zeros ::

379− (Num e, FromListsN e cols rows, CountableDimensionsN cols rows)

392+ (Num e, FLN cols rows, CountableDimsN cols rows)

380 => Matrix e cols rows

393 => Matrix e cols rows

381zeros = M I.zeros

394zeros = M I.zeros

382

395

@@ -386,7 +399,7 @@ zeros = M I.zeros

386--

399--

387-- Also known as T (Top) matrix.

400-- Also known as T (Top) matrix.

388ones ::

401ones ::

389− (Num e, FromListsN e cols rows, CountableDimensionsN cols rows)

402+ (Num e, FLN cols rows, CountableDimsN cols rows)

390 => Matrix e cols rows

403 => Matrix e cols rows

391ones = M I.ones

404ones = M I.ones

392

405

@@ -395,7 +408,7 @@ ones = M I.ones

395-- | The constant matrix constructor. A matrix wholly filled with a given

408-- | The constant matrix constructor. A matrix wholly filled with a given

396-- value.

409-- value.

397constant ::

410constant ::

398− (Num e, FromListsN e cols rows, CountableDimensionsN cols rows)

411+ (Num e, FLN cols rows, CountableDimsN cols rows)

399 => e -> Matrix e cols rows

412 => e -> Matrix e cols rows

400constant = M . I.constant

413constant = M . I.constant

401

414

@@ -404,30 +417,30 @@ constant = M . I.constant

404-- | The T (Top) row vector matrix.

417-- | The T (Top) row vector matrix.

405bang ::

418bang ::

406 forall e cols.

419 forall e cols.

407− (Num e, Enum e, FromListsN e cols (), CountableN cols) =>

420+ (Num e, Enum e, FLN cols (), CountableN cols) =>

408 Matrix e cols One

421 Matrix e cols One

409bang = M I.bang

422bang = M I.bang

410

423

411-- | Point constant relation

424-- | Point constant relation

412−point ::

425+point ::

413 ( Bounded a,

426 ( Bounded a,

414 Enum a,

427 Enum a,

415 Eq a,

428 Eq a,

416 Num e,

429 Num e,

417 Ord e,

430 Ord e,

418 CountableN a,

431 CountableN a,

419− FromListsN e a One

432+ FLN a One

420 ) => a -> Matrix e One a

433 ) => a -> Matrix e One a

421−point = fromF' . const

434+point = fromF . const

422

435

423−-- Identity Matrix

436+-- iden Matrix

424

437

425−-- | Identity matrix

438+-- | iden matrix

426−identity ::

439+iden ::

427− (Num e, FromListsN e a a, CountableN a) =>

440+ (Num e, FLN a a, CountableN a) =>

428 Matrix e a a

441 Matrix e a a

429−identity = M I.identity

442+iden = M I.iden

430−{-# NOINLINE identity #-}

443+{-# NOINLINE iden #-}

431

444

432-- Matrix composition (MMM)

445-- Matrix composition (MMM)

433

446

@@ -438,17 +451,31 @@ identity = M I.identity

438comp :: (Num e) => Matrix e cr rows -> Matrix e cols cr -> Matrix e cols rows

451comp :: (Num e) => Matrix e cr rows -> Matrix e cols cr -> Matrix e cols rows

439comp (M a) (M b) = M (I.comp a b)

452comp (M a) (M b) = M (I.comp a b)

440{-# NOINLINE comp #-}

453{-# NOINLINE comp #-}

441−{-# RULES

454+{-# RULES

442− "comp/identity1" forall m. comp m identity = m ;

455+ "comp/iden1" forall m. comp m iden = m ;

443− "comp/identity2" forall m. comp identity m = m

456+ "comp/iden2" forall m. comp iden m = m

444#-}

457#-}

445

458

459+-- Scalar multiplication of matrices

460+

461+infixl 7 .|

462+-- | Scalar multiplication of matrices.

463+(.|) :: Num e => e -> Matrix e cols rows -> Matrix e cols rows

464+(.|) e (M m) = M (e I..| m)

465+

466+-- Scalar division of matrices

467+

468+infixl 7 ./

469+-- | Scalar multiplication of matrices.

470+(./) :: Fractional e => Matrix e cols rows -> e -> Matrix e cols rows

471+(./) (M m) e = M (m I../ e)

472+

446-- | Biproduct first component projection

473-- | Biproduct first component projection

447p1 ::

474p1 ::

448 ( Num e,

475 ( Num e,

449− CountableDimensionsN n m,

476+ CountableDimsN n m,

450− FromListsN e n m,

477+ FLN n m,

451− FromListsN e m m

478+ FLN m m

452 ) =>

479 ) =>

453 Matrix e (Either m n) m

480 Matrix e (Either m n) m

454p1 = M I.p1

481p1 = M I.p1

@@ -456,9 +483,9 @@ p1 = M I.p1

456-- | Biproduct second component projection

483-- | Biproduct second component projection

457p2 ::

484p2 ::

458 ( Num e,

485 ( Num e,

459− CountableDimensionsN n m,

486+ CountableDimsN n m,

460− FromListsN e m n,

487+ FLN m n,

461− FromListsN e n n

488+ FLN n n

462 ) =>

489 ) =>

463 Matrix e (Either m n) n

490 Matrix e (Either m n) n

464p2 = M I.p2

491p2 = M I.p2

@@ -468,9 +495,9 @@ p2 = M I.p2

468-- | Biproduct first component injection

495-- | Biproduct first component injection

469i1 ::

496i1 ::

470 ( Num e,

497 ( Num e,

471− CountableDimensionsN n m,

498+ CountableDimsN n m,

472− FromListsN e n m,

499+ FLN n m,

473− FromListsN e m m

500+ FLN m m

474 ) =>

501 ) =>

475 Matrix e m (Either m n)

502 Matrix e m (Either m n)

476i1 = tr p1

503i1 = tr p1

@@ -478,9 +505,9 @@ i1 = tr p1

478-- | Biproduct second component injection

505-- | Biproduct second component injection

479i2 ::

506i2 ::

480 ( Num e,

507 ( Num e,

481− CountableDimensionsN n m,

508+ CountableDimsN n m,

482− FromListsN e m n,

509+ FLN m n,

483− FromListsN e n n

510+ FLN n n

484 ) =>

511 ) =>

485 Matrix e n (Either m n)

512 Matrix e n (Either m n)

486i2 = tr p2

513i2 = tr p2

@@ -489,24 +516,34 @@ i2 = tr p2

489

516

490-- | Obtain the number of rows.

517-- | Obtain the number of rows.

491--

518--

492−-- NOTE: The 'KnownNat' constaint is needed in order to obtain the

519+-- NOTE: The 'KnownNat' constraint is needed in order to obtain the

493−-- dimensions in constant time.

520+-- dimensions in constant time. For a version that doesn't require the

494−--

521+-- constraint see 'rows''.

495−-- TODO: A 'rows' function that does not need the 'KnownNat' constraint in

496−-- exchange for performance.

497rows :: (CountableN rows) => Matrix e cols rows -> Int

522rows :: (CountableN rows) => Matrix e cols rows -> Int

498rows (M m) = I.rows m

523rows (M m) = I.rows m

499

524

525+-- | Obtain the number of rows in an inefficient manner, but without any

526+-- constraints.

527+--

528+-- For a more efficient version see 'rows'.

529+rows' :: Matrix e cols rows -> Int

530+rows' (M m) = I.rows' m

531+

500-- | Obtain the number of columns.

532-- | Obtain the number of columns.

501−--

502−-- NOTE: The 'KnownNat' constaint is needed in order to obtain the

503−-- dimensions in constant time.

504--

533--

505−-- TODO: A 'columns' function that does not need the 'KnownNat' constraint in

534+-- NOTE: The 'KnownNat' constraint is needed in order to obtain the

506−-- exchange for performance.

535+-- dimensions in constant time. For a version that doesn't require the

536+-- constraint see 'columns''.

507columns :: (CountableN cols) => Matrix e cols rows -> Int

537columns :: (CountableN cols) => Matrix e cols rows -> Int

508columns (M m) = I.columns m

538columns (M m) = I.columns m

509

539

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+

510-- Coproduct Bifunctor

547-- Coproduct Bifunctor

511

548

512infixl 5 -|-

549infixl 5 -|-

@@ -514,11 +551,11 @@ infixl 5 -|-

514-- | Matrix coproduct functor also known as matrix direct sum.

551-- | Matrix coproduct functor also known as matrix direct sum.

515(-|-) ::

552(-|-) ::

516 ( Num e,

553 ( Num e,

517− CountableDimensionsN j k,

554+ CountableDimsN j k,

518− FromListsN e k k,

555+ FLN k k,

519− FromListsN e j k,

556+ FLN j k,

520− FromListsN e k j,

557+ FLN k j,

521− FromListsN e j j

558+ FLN j j

522 ) =>

559 ) =>

523 Matrix e n k ->

560 Matrix e n k ->

524 Matrix e m j ->

561 Matrix e m j ->

@@ -528,98 +565,98 @@ infixl 5 -|-

528-- Khatri Rao Product and projections

565-- Khatri Rao Product and projections

529

566

530-- | Khatri Rao product first component projection matrix.

567-- | Khatri Rao product first component projection matrix.

531−kp1 ::

568+fstM ::

532 forall e m k .

569 forall e m k .

533 ( Num e,

570 ( Num e,

534− CountableDimensionsN m k,

571+ CountableDimsN m k,

535 CountableN (m, k),

572 CountableN (m, k),

536− FromListsN e (m, k) m,

573+ FLN (m, k) m,

537 TrivialP m k

574 TrivialP m k

538 ) => Matrix e (m, k) m

575 ) => Matrix e (m, k) m

539−kp1 = M (I.kp1 @e @(I.Normalize m) @(I.Normalize k))

576+fstM = M (I.fstM @e @(I.Normalize m) @(I.Normalize k))

540

577

541-- | Khatri Rao product second component projection matrix.

578-- | Khatri Rao product second component projection matrix.

542−kp2 ::

579+sndM ::

543 forall e m k.

580 forall e m k.

544 ( Num e,

581 ( Num e,

545− CountableDimensionsN k m,

582+ CountableDimsN k m,

546 CountableN (m, k),

583 CountableN (m, k),

547− FromListsN e (m, k) k,

584+ FLN (m, k) k,

548 TrivialP m k

585 TrivialP m k

549 ) => Matrix e (m, k) k

586 ) => Matrix e (m, k) k

550−kp2 = M (I.kp2 @e @(I.Normalize m) @(I.Normalize k))

587+sndM = M (I.sndM @e @(I.Normalize m) @(I.Normalize k))

551

588

552-- | Khatri Rao Matrix product also known as matrix pairing.

589-- | Khatri Rao Matrix product also known as matrix pairing.

553--

590--

554-- NOTE: That this is not a true categorical product, see for instance:

591-- NOTE: That this is not a true categorical product, see for instance:

555−--

592+--

556-- @

593-- @

557−-- | kp1 `comp` khatri a b == a

594+-- | fstM . kr a b == a

558−-- khatri a b ==> |

595+-- kr a b ==> |

559−-- | kp2 `comp` khatri a b == b

596+-- | sndM . kr a b == b

560-- @

597-- @

561--

598--

562-- __Emphasis__ on the implication symbol.

599-- __Emphasis__ on the implication symbol.

563−khatri ::

600+kr ::

564 forall e cols a b.

601 forall e cols a b.

565 ( Num e,

602 ( Num e,

566− CountableDimensionsN a b,

603+ CountableDimsN a b,

567 CountableN (a, b),

604 CountableN (a, b),

568− FromListsN e (a, b) a,

605+ FLN (a, b) a,

569− FromListsN e (a, b) b,

606+ FLN (a, b) b,

570 TrivialP a b

607 TrivialP a b

571 ) => Matrix e cols a -> Matrix e cols b -> Matrix e cols (a, b)

608 ) => Matrix e cols a -> Matrix e cols b -> Matrix e cols (a, b)

572−khatri a b =

609+kr a b =

573− let kp1' = kp1 @e @a @b

610+ let fstM' = fstM @e @a @b

574− kp2' = kp2 @e @a @b

611+ sndM' = sndM @e @a @b

575− in comp (tr kp1') a * comp (tr kp2') b

612+ in comp (tr fstM') a * comp (tr sndM') b

576

613

577-- Product Bifunctor (Kronecker)

614-- Product Bifunctor (Kronecker)

578

615

579infixl 4 ><

616infixl 4 ><

580

617

581−-- | Matrix product functor also known as kronecker product

618+-- | Matrix product functor also known as Kronecker product

582(><) ::

619(><) ::

583 forall e m p n q.

620 forall e m p n q.

584 ( Num e,

621 ( Num e,

585− CountableDimensionsN m n,

622+ CountableDimsN m n,

586− CountableDimensionsN p q,

623+ CountableDimsN p q,

587− CountableDimensionsN (m, n) (p, q),

624+ CountableDimsN (m, n) (p, q),

588− FromListsN e (m, n) m,

625+ FLN (m, n) m,

589− FromListsN e (m, n) n,

626+ FLN (m, n) n,

590− FromListsN e (p, q) p,

627+ FLN (p, q) p,

591− FromListsN e (p, q) q,

628+ FLN (p, q) q,

592 TrivialP m n,

629 TrivialP m n,

593 TrivialP p q

630 TrivialP p q

594 ) => Matrix e m p -> Matrix e n q -> Matrix e (m, n) (p, q)

631 ) => Matrix e m p -> Matrix e n q -> Matrix e (m, n) (p, q)

595(><) a b =

632(><) a b =

596− let kp1' = kp1 @e @m @n

633+ let fstM' = fstM @e @m @n

597− kp2' = kp2 @e @m @n

634+ sndM' = sndM @e @m @n

598− in khatri (comp a kp1') (comp b kp2')

635+ in kr (comp a fstM') (comp b sndM')

599

636

600−-- Matrix abide Junc Split

637+-- Matrix abide Join Fork

601

638

602−-- | Matrix "abiding" followin the 'Junc'-'Split' abide law.

639+-- | Matrix "abiding" followin the 'Join'-'Fork' abide law.

603−--

640+--

604-- Law:

641-- Law:

605--

642--

606-- @

643-- @

607−-- 'Junc' ('Split' a c) ('Split' b d) == 'Split' ('Junc' a b) ('Junc' c d)

644+-- 'Join' ('Fork' a c) ('Fork' b d) == 'Fork' ('Join' a b) ('Join' c d)

608-- @

645-- @

609−abideJS :: Matrix e cols rows -> Matrix e cols rows

646+abideJF :: Matrix e cols rows -> Matrix e cols rows

610−abideJS (M m) = M (I.abideJS m)

647+abideJF (M m) = M (I.abideJF m)

611

648

612−-- Matrix abide Split Junc

649+-- Matrix abide Fork Join

613

650

614−-- | Matrix "abiding" followin the 'Split'-'Junc' abide law.

651+-- | Matrix "abiding" followin the 'Fork'-'Join' abide law.

615−--

652+--

616-- Law:

653-- Law:

617--

654--

618-- @

655-- @

619−-- 'Split' ('Junc' a b) ('Junc' c d) == 'Junc' ('Split' a c) ('Split' b d)

656+-- 'Fork' ('Join' a b) ('Join' c d) == 'Join' ('Fork' a c) ('Fork' b d)

620-- @

657-- @

621−abideSJ :: Matrix e cols rows -> Matrix e cols rows

658+abideFJ :: Matrix e cols rows -> Matrix e cols rows

622−abideSJ (M m) = M (I.abideSJ m)

659+abideFJ (M m) = M (I.abideFJ m)

623

660

624-- Matrix transposition

661-- Matrix transposition

625

662

@@ -631,9 +668,9 @@ tr (M m) = M (I.tr m)

631

668

632-- | Selective functors 'select' operator equivalent inspired by the

669-- | Selective functors 'select' operator equivalent inspired by the

633-- ArrowMonad solution presented in the paper.

670-- ArrowMonad solution presented in the paper.

634−selectM ::

671+selectM ::

635 ( Num e,

672 ( Num e,

636− FromListsN e b b,

673+ FLN b b,

637 CountableN b

674 CountableN b

638 ) => Matrix e cols (Either a b) -> Matrix e a b -> Matrix e cols b

675 ) => Matrix e cols (Either a b) -> Matrix e a b -> Matrix e cols b

639selectM (M m) (M y) = M (I.select m y)

676selectM (M m) (M y) = M (I.select m y)

@@ -646,9 +683,9 @@ cond ::

646 Trivial2 a,

683 Trivial2 a,

647 Trivial3 a,

684 Trivial3 a,

648 CountableN a,

685 CountableN a,

649− FromListsN e () a,

686+ FLN () a,

650− FromListsN e a (),

687+ FLN a (),

651− FromListsN e a a,

688+ FLN a a,

652 Liftable e a Bool

689 Liftable e a Bool

653 )

690 )

654 =>

691 =>

@@ -658,11 +695,11 @@ cond p (M a) (M b) = M (I.cond p a b)

658-- Pretty print

695-- Pretty print

659

696

660-- | Matrix pretty printer

697-- | Matrix pretty printer

661−pretty :: (CountableDimensionsN cols rows, Show e) => Matrix e cols rows -> String

698+pretty :: (CountableDimsN cols rows, Show e) => Matrix e cols rows -> String

662pretty (M m) = I.pretty m

699pretty (M m) = I.pretty m

663

700

664-- | Matrix pretty printer

701-- | Matrix pretty printer

665−prettyPrint :: (CountableDimensionsN cols rows, Show e) => Matrix e cols rows -> IO ()

702+prettyPrint :: (CountableDimsN cols rows, Show e) => Matrix e cols rows -> IO ()

666prettyPrint (M m) = I.prettyPrint m

703prettyPrint (M m) = I.prettyPrint m

667

704

668-- | Zip two matrices with a given binary function

705-- | Zip two matrices with a given binary function

src/LAoP/Relation.hs+8−9

@@ -32,20 +32,19 @@ module LAoP.Relation

33 -- * Constraint type synonyms

34 Countable,

35− CountableDimensions,

35+ CountableDims,

36 CountableN,

37− CountableDimensionsN,

37+ CountableDimsN,

38− FromListsN,

38+ FLN,

39 Liftable,

40 Trivial,

41 TrivialP,

43 -- * Primitives

44− empty,

45 one,

44 one,

46− junc,

45+ join,

47 (|||),

46 (|||),

48− split,

47+ fork,

49 (===),

48 (===),

51 -- * Auxiliary type families

50 -- * Auxiliary type families

@@ -108,8 +107,8 @@ module LAoP.Relation

108 splitR,

107 splitR,

109

108

110 -- ** Projections

109 -- ** Projections

111− p1,

110+ fstR,

112− p2,

111+ sndR,

113 -- ** Bifunctor

112 -- ** Bifunctor

114 (><),

113 (><),

115 -- * Relational coproduct

114 -- * Relational coproduct

@@ -148,7 +147,7 @@ module LAoP.Relation

148 cond,

147 cond,

149

148

150 -- * Relational composition and lifting

149 -- * Relational composition and lifting

151− identity,

150+ iden,

152 comp,

151 comp,

153 fromF,

152 fromF,

154 fromF',

153 fromF',

src/LAoP/Relation/Internal.hs+245−234

@@ -1,3 +1,4 @@

1+{-# LANGUAGE TypeFamilies #-}

1{-# LANGUAGE ConstraintKinds #-}

2{-# LANGUAGE ConstraintKinds #-}

2{-# LANGUAGE GADTs #-}

3{-# LANGUAGE GADTs #-}

3{-# LANGUAGE UndecidableInstances #-}

4{-# LANGUAGE UndecidableInstances #-}

@@ -42,20 +43,19 @@ module LAoP.Relation.Internal

43 -- * Constraint type synonyms

44 -- * Constraint type synonyms

44 Countable,

45 Countable,

45− CountableDimensions,

46+ CountableDims,

46 CountableN,

47 CountableN,

47− CountableDimensionsN,

48+ CountableDimsN,

48− FromListsN,

49+ FLN,

49 Liftable,

50 Liftable,

50 Trivial,

51 Trivial,

51 TrivialP,

52 TrivialP,

53 -- * Primitives

54 -- * Primitives

54− empty,

55 one,

56− junc,

56+ join,

57 (|||),

58− split,

58+ fork,

59 (===),

61 -- * Auxiliary type families

@@ -66,14 +66,15 @@ module LAoP.Relation.Internal

66 -- * Matrix construction and conversion

67 I.FromLists,

68 fromLists,

69− fromF,

70 fromF',

69 fromF',

70+ fromF,

71 toRel,

72 toLists,

73 toList,

74 toBool,

75 pt,

76 belongs,

77+ relationBuilder',

77 relationBuilder,

78 relationBuilder,

78 zeros,

79 zeros,

79 ones,

80 ones,

@@ -118,8 +119,8 @@ module LAoP.Relation.Internal

118 splitR,

119 splitR,

119

120

120 -- ** Projections

121 -- ** Projections

121− p1,

122+ fstR,

122− p2,

123+ sndR,

123 -- ** Bifunctor

124 -- ** Bifunctor

124 (><),

125 (><),

125 -- * Relational coproduct

126 -- * Relational coproduct

@@ -158,10 +159,10 @@ module LAoP.Relation.Internal

158 cond,

159 cond,

159

160

160 -- * Relational composition and lifting

161 -- * Relational composition and lifting

161− identity,

162+ iden,

162 comp,

163 comp,

163− fromF,

164 fromF',

165+ fromF,

165

166

166 -- ** Relational application

167 -- ** Relational application

167 pointAp,

168 pointAp,

@@ -177,9 +178,9 @@ import Data.Void

177import qualified LAoP.Matrix.Internal as I

178import qualified LAoP.Matrix.Internal as I

178import LAoP.Utils.Internal

179import LAoP.Utils.Internal

179import Control.DeepSeq

180import Control.DeepSeq

180−import qualified Control.Category as C

181import Data.Bool

182import GHC.TypeLits

183+import Prelude hiding (id, (.))

183

184

184-- | Boolean type synonym for working with boolean matrices

185-- | Boolean type synonym for working with boolean matrices

185type Boolean = Natural 0 1

186type Boolean = Natural 0 1

@@ -192,32 +193,30 @@ newtype Relation a b = R (I.Matrix Boolean (I.Normalize a) (I.Normalize b))

192deriving instance (Read (I.Matrix Boolean (I.Normalize a) (I.Normalize b))) => Read (Relation a b)

193deriving instance (Read (I.Matrix Boolean (I.Normalize a) (I.Normalize b))) => Read (Relation a b)

193

194

194-- | Constraint type synonyms to keep the type signatures less convoluted

195-- | Constraint type synonyms to keep the type signatures less convoluted

195−type Countable a = KnownNat (I.Count a)

196+type Countable a = KnownNat (I.Count a)

196−type CountableDimensions a b = (Countable a, Countable b)

197+type CountableDims a b = (Countable a, Countable b)

197−type CountableN a = KnownNat (I.Count (I.Normalize a))

198+type CountableN a = KnownNat (I.Count (I.Normalize a))

198−type CountableDimensionsN a b = (CountableN a, CountableN b)

199+type CountableDimsN a b = (CountableN a, CountableN b)

199−type FromListsN a b = I.FromLists Boolean (I.Normalize a) (I.Normalize b)

200+type FLN a b = I.FromLists (I.Normalize a) (I.Normalize b)

200−type Liftable a b = (Bounded a, Bounded b, Enum a, Enum b, Eq b, Num Boolean, Ord Boolean)

201+type Liftable a b = (Bounded a, Bounded b, Enum a, Enum b, Eq b, Num Boolean, Ord Boolean)

201−type Trivial a = I.Normalize a ~ I.Normalize (I.Normalize a)

202+type Trivial a = I.Normalize a ~ I.Normalize (I.Normalize a)

202−type TrivialP a b = I.Normalize (a, b) ~ I.Normalize (I.Normalize a, I.Normalize b)

203+type TrivialP a b = I.Normalize (a, b) ~ I.Normalize (I.Normalize a, I.Normalize b)

203−

204+

204−-- | It isn't possible to implement the 'id' function so it's

205+-- | It is possible to implement a constrained version of the category type

205−-- implementation is 'undefined'. However 'comp' can be and this partial

206+-- class.

206−-- class implementation exists just to make the code more readable.

207−--

208−-- Please use 'identity' instead.

209−instance C.Category Relation where

207+instance Category Relation where

210− id = undefined

208+ type Object Relation a = (FLN a a, CountableN a)

209+ id = iden

211− (.) = comp

210+ (.) = comp

212

211

213instance Num (Relation a b) where

212instance Num (Relation a b) where

214− -- | Matrix addition becomes Boolean matrix disjunction

213+ -- | Matrix addition becomes Boolean matrix disjointion

215 (R a) + (R b) = R (I.orM a b)

214 (R a) + (R b) = R (I.orM a b)

216

215

217 -- | Matrix subtraction becomes Relational subtraction

216 -- | Matrix subtraction becomes Relational subtraction

218 (R a) - (R b) = R (I.subM a b)

217 (R a) - (R b) = R (I.subM a b)

219

218

220− -- | Matrix multiplication becomes Boolean matrix conjunction

219+ -- | Matrix multiplication becomes Boolean matrix conjointion

221 (R a) * (R b) = R (I.andM a b)

220 (R a) * (R b) = R (I.andM a b)

222

221

223 -- | Matrix negation becomes Boolean matrix negation

222 -- | Matrix negation becomes Boolean matrix negation

@@ -229,83 +228,92 @@ type One = ()

229

228

230-- Primitives

229-- Primitives

231

230

232−-- | Empty matrix constructor

233−empty :: Relation Zero Zero

234−empty = R I.Empty

235−

236-- | Unit matrix constructor

231-- | Unit matrix constructor

237one :: Boolean -> Relation One One

232one :: Boolean -> Relation One One

238one = R . I.One

233one = R . I.One

239

234

240−-- | Boolean Matrix 'Junc' constructor, also known as relational coproduct.

235+-- | Boolean Matrix 'Join' constructor, also known as relational coproduct.

241--

236--

242-- See 'eitherR'.

237-- See 'eitherR'.

243−junc :: Relation a c -> Relation b c -> Relation (Either a b) c

238+join :: Relation a c -> Relation b c -> Relation (Either a b) c

244−junc (R a) (R b) = R (I.Junc a b)

239+join (R a) (R b) = R (I.Join a b)

245

240

246infixl 3 |||

241infixl 3 |||

247−-- | Boolean Matrix 'Junc' constructor

242+-- | Boolean Matrix 'Join' constructor

248--

243--

249-- See 'eitherR'.

244-- See 'eitherR'.

250(|||) ::

245(|||) ::

251 Relation a c ->

246 Relation a c ->

252 Relation b c ->

247 Relation b c ->

253 Relation (Either a b) c

248 Relation (Either a b) c

254−(|||) = junc

249+(|||) = join

255

250

256−-- | Boolean Matrix 'Split' constructor, also known as relational product.

251+-- | Boolean Matrix 'Fork' constructor, also known as relational product.

257−split :: Relation c a -> Relation c b -> Relation c (Either a b)

252+fork :: Relation c a -> Relation c b -> Relation c (Either a b)

258−split (R a) (R b) = R (I.Split a b)

253+fork (R a) (R b) = R (I.Fork a b)

259

254

260infixl 2 ===

255infixl 2 ===

261−-- | Boolean Matrix 'Split' constructor

256+-- | Boolean Matrix 'Fork' constructor

262(===) ::

257(===) ::

263 Relation c a ->

258 Relation c a ->

264 Relation c b ->

259 Relation c b ->

265 Relation c (Either a b)

260 Relation c (Either a b)

266−(===) = split

261+(===) = fork

267

262

268-- Construction

263-- Construction

269

264

270-- | Build a matrix out of a list of list of elements. Throws a runtime

265-- | Build a matrix out of a list of list of elements. Throws a runtime

271-- error if the dimensions do not match.

266-- error if the dimensions do not match.

272−fromLists :: (FromListsN a b) => [[Boolean]] -> Relation a b

267+fromLists :: (FLN a b) => [[Boolean]] -> Relation a b

273fromLists = R . I.fromLists

268fromLists = R . I.fromLists

274

269

275−-- | Matrix builder function. Constructs a matrix provided with

270+-- | Relation builder function. Constructs a relation provided with

276−-- a construction function.

271+-- a construction function that operates with indices.

277−relationBuilder ::

272+relationBuilder' ::

278− (FromListsN a b, CountableDimensionsN a b) =>

273+ (FLN a b, CountableDimsN a b) =>

279 ((Int, Int) -> Boolean) -> Relation a b

274 ((Int, Int) -> Boolean) -> Relation a b

275+relationBuilder' = R . I.matrixBuilder'

276+

277+-- | Relation builder function. Constructs a relation provided with

278+-- a construction function that operates with arbitrary types.

279+relationBuilder ::

280+ ( FLN a b,

281+ Enum a,

282+ Enum b,

283+ Bounded a,

284+ Bounded b,

285+ Eq a,

286+ CountableDims a b

287+ ) => ((a, b) -> Boolean) -> Relation a b

280relationBuilder = R . I.matrixBuilder

288relationBuilder = R . I.matrixBuilder

281

289

282-- | Lifts functions to matrices with arbitrary dimensions.

290-- | Lifts functions to matrices with arbitrary dimensions.

283--

291--

284-- NOTE: Be careful to not ask for a matrix bigger than the cardinality of

292-- NOTE: Be careful to not ask for a matrix bigger than the cardinality of

285-- types @a@ or @b@ allows.

293-- types @a@ or @b@ allows.

286−fromF ::

294+fromF' ::

287 ( Liftable a b,

295 ( Liftable a b,

288− CountableDimensionsN c d,

296+ CountableDimsN c d,

289− FromListsN d c

297+ FLN d c

290 )

298 )

291 => (a -> b) -> Relation c d

299 => (a -> b) -> Relation c d

292−fromF f = R (I.fromFRel f)

300+fromF' f = R (I.fromFRel' f)

293

301

294-- | Lifts functions to matrices with dimensions matching @a@ and @b@

302-- | Lifts functions to matrices with dimensions matching @a@ and @b@

295-- cardinality's.

303-- cardinality's.

296−fromF' ::

304+fromF ::

297 ( Liftable a b,

305 ( Liftable a b,

298− CountableDimensionsN a b,

306+ CountableDimsN a b,

299− FromListsN b a

307+ FLN b a

300 )

308 )

301 => (a -> b) -> Relation a b

309 => (a -> b) -> Relation a b

302−fromF' f = R (I.fromFRel' f)

310+fromF f = R (I.fromFRel f)

303

311

304-- | Lifts relation functions to 'Relation'

312-- | Lifts relation functions to 'Relation'

305toRel ::

313toRel ::

306 ( Liftable a b,

314 ( Liftable a b,

307− CountableDimensionsN a b,

315+ CountableDims a b,

308− FromListsN b a

316+ FLN b a

309 )

317 )

310 => (a -> b -> Bool) -> Relation a b

318 => (a -> b -> Bool) -> Relation a b

311toRel = R . I.toRel

319toRel = R . I.toRel

@@ -314,9 +322,9 @@ toRel = R . I.toRel

314fromRel ::

322fromRel ::

315 ( Liftable a b,

323 ( Liftable a b,

316 Eq a,

324 Eq a,

317− CountableDimensionsN a b,

325+ CountableDimsN a b,

318− FromListsN a One,

326+ FLN a One,

319− FromListsN b One

327+ FLN b One

320 )

328 )

321 => Relation a b -> (a -> b -> Bool)

329 => Relation a b -> (a -> b -> Bool)

322fromRel r a b = pointApBool a b r

330fromRel r a b = pointApBool a b r

@@ -340,12 +348,12 @@ toBool r = case toList r of

340-- | Power transpose.

348-- | Power transpose.

341--

349--

342-- Maps a relation to a set valued function.

350-- Maps a relation to a set valued function.

343−pt ::

351+pt ::

344 ( Liftable a b,

352 ( Liftable a b,

345 Eq a,

353 Eq a,

346− CountableDimensionsN a b,

354+ CountableDimsN a b,

347− FromListsN a One,

355+ FLN a One,

348− FromListsN b One

356+ FLN b One

349 )

357 )

350 => Relation a b -> (a -> List b)

358 => Relation a b -> (a -> List b)

351pt r a =

359pt r a =

@@ -357,8 +365,8 @@ belongs ::

357 ( Bounded a,

365 ( Bounded a,

358 Enum a,

366 Enum a,

359 Eq a,

367 Eq a,

360− CountableDimensionsN (List a) a,

368+ CountableDims (List a) a,

361− FromListsN a (List a)

369+ FLN a (List a)

362 )

370 )

363 => Relation (List a) a

371 => Relation (List a) a

364belongs = toRel elemR

372belongs = toRel elemR

@@ -370,16 +378,16 @@ belongs = toRel elemR

370-- | The zero relation. A relation where no element of type @a@ relates

378-- | The zero relation. A relation where no element of type @a@ relates

371-- with elements of type @b@.

379-- with elements of type @b@.

372--

380--

373−-- Also known as ⊥ (Bottom) Relation or empty Relation.

381+-- Also known as ⊥ (Bottom) Relation.

374--

382--

375-- @

383-- @

376−-- r ``comp`` ⊥ == ⊥ ``comp`` r == ⊥

384+-- r `.` ⊥ == ⊥ `.` r == ⊥

377-- ⊥ ``sse`` R && R ``sse`` T == True

385-- ⊥ ``sse`` R && R ``sse`` T == True

378-- @

386-- @

379zeros ::

387zeros ::

380− (FromListsN a b, CountableDimensionsN a b) =>

388+ (FLN a b, CountableDimsN a b) =>

381 Relation a b

389 Relation a b

382−zeros = relationBuilder (const (nat 0))

390+zeros = relationBuilder' (const (nat 0))

383

391

384-- Ones Matrix

392-- Ones Matrix

385

393

@@ -392,43 +400,43 @@ zeros = relationBuilder (const (nat 0))

392-- ⊥ ``sse`` R && R ``sse`` T == True

400-- ⊥ ``sse`` R && R ``sse`` T == True

393-- @

401-- @

394ones ::

402ones ::

395− (FromListsN a b, CountableDimensionsN a b) =>

403+ (FLN a b, CountableDimsN a b) =>

396 Relation a b

404 Relation a b

397−ones = relationBuilder (const (nat 1))

405+ones = relationBuilder' (const (nat 1))

398

406

399-- Bang Matrix

407-- Bang Matrix

400

408

401-- | The T (Top) row vector relation.

409-- | The T (Top) row vector relation.

402bang ::

410bang ::

403− (FromListsN a One, CountableN a) =>

411+ (FLN a One, CountableN a) =>

404 Relation a One

412 Relation a One

405bang = ones

413bang = ones

406

414

407-- | Point constant relation

415-- | Point constant relation

408−point ::

416+point ::

409 ( Bounded a,

417 ( Bounded a,

410 Enum a,

418 Enum a,

411 Eq a,

419 Eq a,

412 CountableN a,

420 CountableN a,

413− FromListsN a One

421+ FLN a One

414 ) => a -> Relation One a

422 ) => a -> Relation One a

415−point = fromF' . const

423+point = fromF . const

416

424

417−-- Identity Matrix

425+-- iden Matrix

418

426

419−-- | Identity matrix

427+-- | iden matrix

420--

428--

421-- @

429-- @

422−-- 'identity' ``comp`` r == r == r ``comp`` 'identity'

430+-- 'iden' `.` r == r == r `.` 'iden'

423-- @

431-- @

424−identity ::

432+iden ::

425− (FromListsN a a, CountableN a) => Relation a a

433+ (FLN a a, CountableN a) => Relation a a

426−identity = relationBuilder (bool (nat 0) (nat 1) . uncurry (==))

434+iden = relationBuilder' (bool (nat 0) (nat 1) . uncurry (==))

427

435

428-- | Relational composition

436-- | Relational composition

429--

437--

430-- @

438-- @

431−-- r ``comp`` (s ``comp`` p) = (r ``comp`` s) ``comp`` p

439+-- r `.` (s `.` p) = (r `.` s) `.` p

432-- @

440-- @

433comp :: Relation b c -> Relation a b -> Relation a c

441comp :: Relation b c -> Relation a b -> Relation a c

434comp (R a) (R b) = R (I.compRel a b)

442comp (R a) (R b) = R (I.compRel a b)

@@ -476,7 +484,7 @@ shrunkBy r s = r `intersection` divR s (conv r)

476-- r ``overriddenBy`` r == r

484-- r ``overriddenBy`` r == r

477-- @

485-- @

478overriddenBy ::

486overriddenBy ::

479− ( FromListsN b b,

487+ ( FLN b b,

480 CountableN b

488 CountableN b

481 ) => Relation a b -> Relation a b -> Relation a b

489 ) => Relation a b -> Relation a b -> Relation a b

482overriddenBy r s = s `union` r `intersection` divR zeros (conv s)

490overriddenBy r s = s `union` r `intersection` divR zeros (conv s)

@@ -488,11 +496,11 @@ overriddenBy r s = s `union` r `intersection` divR zeros (conv s)

488pointAp ::

496pointAp ::

489 ( Liftable a b,

497 ( Liftable a b,

490 Eq a,

498 Eq a,

491− CountableDimensionsN a b,

499+ CountableDimsN a b,

492− FromListsN a One,

500+ FLN a One,

493− FromListsN b One

501+ FLN b One

494 ) => a -> b -> Relation a b -> Relation One One

502 ) => a -> b -> Relation a b -> Relation One One

495−pointAp a b r = conv (point b) `comp` r `comp` point a

503+pointAp a b r = conv (point b) . r . point a

496

504

497-- | Relational application

505-- | Relational application

498--

506--

@@ -500,11 +508,11 @@ pointAp a b r = conv (point b) `comp` r `comp` point a

500pointApBool ::

508pointApBool ::

501 ( Liftable a b,

509 ( Liftable a b,

502 Eq a,

510 Eq a,

503− CountableDimensionsN a b,

511+ CountableDimsN a b,

504− FromListsN a One,

512+ FLN a One,

505− FromListsN b One

513+ FLN b One

506 ) => a -> b -> Relation a b -> Bool

514 ) => a -> b -> Relation a b -> Bool

507−pointApBool a b r = toBool $ conv (point b) `comp` r `comp` point a

515+pointApBool a b r = toBool $ conv (point b) . r . point a

508

516

509-- | Relational converse

517-- | Relational converse

510--

518--

@@ -530,7 +538,7 @@ iff r s = r == s

530

538

531-- | Relational intersection

539-- | Relational intersection

532--

540--

533−-- Lifts pointwise conjunction.

541+-- Lifts pointwise conjointion.

534--

542--

535-- @

543-- @

536-- (r ``intersection`` s) ``intersection`` t == r ``intersection`` (s ``intersection`` t)

544-- (r ``intersection`` s) ``intersection`` t == r ``intersection`` (s ``intersection`` t)

@@ -541,13 +549,13 @@ intersection a b = a * b

541

549

542-- | Relational union

550-- | Relational union

543--

551--

544−-- Lifts pointwise disjunction.

552+-- Lifts pointwise disjointion.

545--

553--

546-- @

554-- @

547-- (r ``union`` s) ``union`` t == r `'union' (s ``union`` t)

555-- (r ``union`` s) ``union`` t == r `'union' (s ``union`` t)

548-- r ``union`` s ``sse`` x == r ``sse`` x && s ``sse`` x

556-- r ``union`` s ``sse`` x == r ``sse`` x && s ``sse`` x

549−-- r ``comp`` (s ``union`` t) == (r ``comp`` s) ``union`` (r ``comp`` t)

557+-- r `.` (s ``union`` t) == (r `.` s) ``union`` (r `.` t)

550−-- (s ``union`` t) ``comp`` r == (s ``comp`` r) ``union`` (t ``comp`` r)

558+-- (s ``union`` t) `.` r == (s `.` r) ``union`` (t `.` r)

551-- @

559-- @

552union :: Relation a b -> Relation a b -> Relation a b

560union :: Relation a b -> Relation a b -> Relation a b

553union a b = a + b

561union a b = a + b

@@ -555,46 +563,46 @@ union a b = a + b

555-- | Relation Kernel

563-- | Relation Kernel

556--

564--

557-- @

565-- @

558−-- 'ker' r == 'conv' r ``comp`` r

566+-- 'ker' r == 'conv' r `.` r

559-- 'ker' r == 'img' ('conv' r)

567-- 'ker' r == 'img' ('conv' r)

560-- @

568-- @

561ker :: Relation a b -> Relation a a

569ker :: Relation a b -> Relation a a

562−ker r = conv r `comp` r

570+ker r = conv r . r

563

571

564-- | Relation Image

572-- | Relation Image

565--

573--

566-- @

574-- @

567−-- 'img' r == r ``comp`` conv r

575+-- 'img' r == r `.` conv r

568-- 'img' r == 'ker' ('conv' r)

576-- 'img' r == 'ker' ('conv' r)

569-- @

577-- @

570img :: Relation a b -> Relation b b

578img :: Relation a b -> Relation b b

571−img r = r `comp` conv r

579+img r = r . conv r

572

580

573-- | Function division. Special case of 'divS'.

581-- | Function division. Special case of 'divS'.

574--

582--

575-- NOTE: _This is only valid_ if @f@ and @g@ are 'function's, i.e. 'simple' and

583-- NOTE: _This is only valid_ if @f@ and @g@ are 'function's, i.e. 'simple' and

576-- 'entire'.

584-- 'entire'.

577--

585--

578−-- @'divisionF' f g == 'conv' g ``comp`` f@

586+-- @'divisionF' f g == 'conv' g `.` f@

579divisionF :: Relation a c -> Relation b c -> Relation a b

587divisionF :: Relation a c -> Relation b c -> Relation a b

580−divisionF f g = conv g `comp` f

588+divisionF f g = conv g . f

581

589

582-- Taxonomy of binary relations

590-- Taxonomy of binary relations

583

591

584-- | A 'Relation' @r@ is 'simple' 'iff' @'coreflexive' ('img' r)@

592-- | A 'Relation' @r@ is 'simple' 'iff' @'coreflexive' ('img' r)@

585−simple :: (CountableN b, FromListsN b b) => Relation a b -> Bool

593+simple :: (CountableN b, FLN b b) => Relation a b -> Bool

586simple = coreflexive . img

594simple = coreflexive . img

587

595

588-- | A 'Relation' @r@ is 'injective' 'iff' @'coreflexive' ('ker' r)@

596-- | A 'Relation' @r@ is 'injective' 'iff' @'coreflexive' ('ker' r)@

589−injective :: (CountableN a, FromListsN a a) => Relation a b -> Bool

597+injective :: (CountableN a, FLN a a) => Relation a b -> Bool

590injective = coreflexive . ker

598injective = coreflexive . ker

591

599

592-- | A 'Relation' @r@ is 'entire' 'iff' @'reflexive' ('ker' r)@

600-- | A 'Relation' @r@ is 'entire' 'iff' @'reflexive' ('ker' r)@

593−entire :: (CountableN a, FromListsN a a) => Relation a b -> Bool

601+entire :: (CountableN a, FLN a a) => Relation a b -> Bool

594entire = reflexive . ker

602entire = reflexive . ker

595

603

596-- | A 'Relation' @r@ is 'surjective' 'iff' @'reflexive' ('img' r)@

604-- | A 'Relation' @r@ is 'surjective' 'iff' @'reflexive' ('img' r)@

597−surjective :: (CountableN b, FromListsN b b) => Relation a b -> Bool

605+surjective :: (CountableN b, FLN b b) => Relation a b -> Bool

598surjective = reflexive . img

606surjective = reflexive . img

599

607

600-- | A 'Relation' @r@ is a 'function' 'iff' @'simple' r && 'entire' r@

608-- | A 'Relation' @r@ is a 'function' 'iff' @'simple' r && 'entire' r@

@@ -603,13 +611,13 @@ surjective = reflexive . img

603-- relations:

611-- relations:

604--

612--

605-- @

613-- @

606−-- f ``comp`` r ``sse`` s == r ``sse`` f ``comp`` s

614+-- f `.` r ``sse`` s == r ``sse`` f `.` s

607−-- r ``comp`` f ``sse`` s == r ``sse`` s ``comp`` f

615+-- r `.` f ``sse`` s == r ``sse`` s `.` f

608-- @

616-- @

609function ::

617function ::

610− ( CountableDimensionsN a b,

618+ ( CountableDimsN a b,

611− FromListsN a a,

619+ FLN a a,

612− FromListsN b b

620+ FLN b b

613 )

621 )

614 => Relation a b -> Bool

622 => Relation a b -> Bool

615function r = simple r && entire r

623function r = simple r && entire r

@@ -617,7 +625,7 @@ function r = simple r && entire r

617-- | A 'Relation' @r@ is a 'representation' 'iff' @'injective' r && 'entire' r@

625-- | A 'Relation' @r@ is a 'representation' 'iff' @'injective' r && 'entire' r@

618representation ::

626representation ::

619 ( CountableN a,

627 ( CountableN a,

620− FromListsN a a

628+ FLN a a

621 )

629 )

622 => Relation a b -> Bool

630 => Relation a b -> Bool

623representation r = injective r && entire r

631representation r = injective r && entire r

@@ -625,91 +633,91 @@ representation r = injective r && entire r

625-- | A 'Relation' @r@ is an 'abstraction' 'iff' @'surjective' r && 'simple' r@

633-- | A 'Relation' @r@ is an 'abstraction' 'iff' @'surjective' r && 'simple' r@

626abstraction ::

634abstraction ::

627 ( CountableN b,

635 ( CountableN b,

628− FromListsN b b

636+ FLN b b

629 )

637 )

630 => Relation a b -> Bool

638 => Relation a b -> Bool

631abstraction r = surjective r && simple r

639abstraction r = surjective r && simple r

632

640

633-- | A 'Relation' @r@ is a 'surjection' 'iff' @'function' r && 'abstraction' r@

641-- | A 'Relation' @r@ is a 'surjection' 'iff' @'function' r && 'abstraction' r@

634surjection ::

642surjection ::

635− ( CountableDimensionsN a b,

643+ ( CountableDimsN a b,

636− FromListsN a a,

644+ FLN a a,

637− FromListsN b b

645+ FLN b b

638 )

646 )

639 => Relation a b -> Bool

647 => Relation a b -> Bool

640surjection r = function r && abstraction r

648surjection r = function r && abstraction r

641

649

642-- | A 'Relation' @r@ is a 'injection' 'iff' @'function' r && 'representation' r@

650-- | A 'Relation' @r@ is a 'injection' 'iff' @'function' r && 'representation' r@

643injection ::

651injection ::

644− ( CountableDimensionsN a b,

652+ ( CountableDimsN a b,

645− FromListsN a a,

653+ FLN a a,

646− FromListsN b b

654+ FLN b b

647 )

655 )

648 => Relation a b -> Bool

656 => Relation a b -> Bool

649injection r = function r && representation r

657injection r = function r && representation r

650

658

651-- | A 'Relation' @r@ is an 'bijection' 'iff' @'injection' r && 'surjection' r@

659-- | A 'Relation' @r@ is an 'bijection' 'iff' @'injection' r && 'surjection' r@

652bijection ::

660bijection ::

653− ( CountableDimensionsN a b,

661+ ( CountableDimsN a b,

654− FromListsN b b,

662+ FLN b b,

655− FromListsN a a

663+ FLN a a

656 ) => Relation a b -> Bool

664 ) => Relation a b -> Bool

657bijection r = injection r && surjection r

665bijection r = injection r && surjection r

658

666

659-- Properties of relations

667-- Properties of relations

660

668

661−-- | A 'Relation' @r@ is 'reflexive' 'iff' @'identity' ``sse`` r@

669+-- | A 'Relation' @r@ is 'reflexive' 'iff' @'id' ``sse`` r@

662−reflexive :: (CountableN a, FromListsN a a) => Relation a a -> Bool

670+reflexive :: (CountableN a, FLN a a) => Relation a a -> Bool

663−reflexive r = identity <= r

671+reflexive r = id <= r

664

672

665−-- | A 'Relation' @r@ is 'coreflexive' 'iff' @r ``sse`` 'identity'@

673+-- | A 'Relation' @r@ is 'coreflexive' 'iff' @r ``sse`` 'id'@

666−coreflexive :: (CountableN a, FromListsN a a) => Relation a a -> Bool

674+coreflexive :: (CountableN a, FLN a a) => Relation a a -> Bool

667−coreflexive r = r <= identity

675+coreflexive r = r <= id

668

676

669−-- | A 'Relation' @r@ is 'transitive' 'iff' @(r ``comp`` r) ``sse`` r@

677+-- | A 'Relation' @r@ is 'transitive' 'iff' @(r `.` r) ``sse`` r@

670transitive :: Relation a a -> Bool

678transitive :: Relation a a -> Bool

671−transitive r = (r `comp` r) `sse` r

679+transitive r = (r . r) `sse` r

672

680

673-- | A 'Relation' @r@ is 'symmetric' 'iff' @r == 'conv' r@

681-- | A 'Relation' @r@ is 'symmetric' 'iff' @r == 'conv' r@

674symmetric :: Relation a a -> Bool

682symmetric :: Relation a a -> Bool

675symmetric r = r == conv r

683symmetric r = r == conv r

676

684

677−-- | A 'Relation' @r@ is anti-symmetric 'iff' @(r ``intersection`` 'conv' r) ``sse`` 'identity'@

685+-- | A 'Relation' @r@ is anti-symmetric 'iff' @(r ``intersection`` 'conv' r) ``sse`` 'id'@

678−antiSymmetric :: (CountableN a, FromListsN a a) => Relation a a -> Bool

686+antiSymmetric :: (CountableN a, FLN a a) => Relation a a -> Bool

679−antiSymmetric r = (r `intersection` conv r) `sse` identity

687+antiSymmetric r = (r `intersection` conv r) `sse` id

680

688

681−-- | A 'Relation' @r@ is 'irreflexive' 'iff' @(r ``intersection`` 'identity') == 'zeros'@

689+-- | A 'Relation' @r@ is 'irreflexive' 'iff' @(r ``intersection`` 'id') == 'zeros'@

682−irreflexive :: (CountableN a, FromListsN a a) => Relation a a -> Bool

690+irreflexive :: (CountableN a, FLN a a) => Relation a a -> Bool

683−irreflexive r = (r `intersection` identity) == zeros

691+irreflexive r = (r `intersection` id) == zeros

684

692

685-- | A 'Relation' @r@ is 'connected' 'iff' @(r ``union`` 'conv' r) == 'ones'@

693-- | A 'Relation' @r@ is 'connected' 'iff' @(r ``union`` 'conv' r) == 'ones'@

686−connected :: (CountableN a, FromListsN a a) => Relation a a -> Bool

694+connected :: (CountableN a, FLN a a) => Relation a a -> Bool

687connected r = (r `union` conv r) == ones

695connected r = (r `union` conv r) == ones

688

696

689-- | A 'Relation' @r@ is a 'preorder' 'iff' @'reflexive' r && 'transitive' r@

697-- | A 'Relation' @r@ is a 'preorder' 'iff' @'reflexive' r && 'transitive' r@

690−preorder :: (CountableN a, FromListsN a a) => Relation a a -> Bool

698+preorder :: (CountableN a, FLN a a) => Relation a a -> Bool

691preorder r = reflexive r && transitive r

699preorder r = reflexive r && transitive r

692

700

693-- | A 'Relation' @r@ is a partial-order 'iff' @'antiSymmetric' r && 'preorder' r@

701-- | A 'Relation' @r@ is a partial-order 'iff' @'antiSymmetric' r && 'preorder' r@

694−partialOrder :: (CountableN a, FromListsN a a) => Relation a a -> Bool

702+partialOrder :: (CountableN a, FLN a a) => Relation a a -> Bool

695partialOrder r = antiSymmetric r && preorder r

703partialOrder r = antiSymmetric r && preorder r

696

704

697-- | A 'Relation' @r@ is a linear-order 'iff' @'connected' r && 'partialOrder' r@

705-- | A 'Relation' @r@ is a linear-order 'iff' @'connected' r && 'partialOrder' r@

698−linearOrder :: (CountableN a, FromListsN a a) => Relation a a -> Bool

706+linearOrder :: (CountableN a, FLN a a) => Relation a a -> Bool

699linearOrder r = connected r && partialOrder r

707linearOrder r = connected r && partialOrder r

700

708

701-- | A 'Relation' @r@ is an 'equivalence' 'iff' @'symmetric' r && 'preorder' r@

709-- | A 'Relation' @r@ is an 'equivalence' 'iff' @'symmetric' r && 'preorder' r@

702−equivalence :: (CountableN a, FromListsN a a) => Relation a a -> Bool

710+equivalence :: (CountableN a, FLN a a) => Relation a a -> Bool

703equivalence r = symmetric r && preorder r

711equivalence r = symmetric r && preorder r

704

712

705-- | A 'Relation' @r@ is a partial-equivalence 'iff' @'partialOrder' r && 'equivalence' r@

713-- | A 'Relation' @r@ is a partial-equivalence 'iff' @'partialOrder' r && 'equivalence' r@

706−partialEquivalence :: (CountableN a, FromListsN a a) => Relation a a -> Bool

714+partialEquivalence :: (CountableN a, FLN a a) => Relation a a -> Bool

707partialEquivalence r = partialOrder r && equivalence r

715partialEquivalence r = partialOrder r && equivalence r

708

716

709-- | A 'Relation' @r@ is 'difunctional' or regular wherever

717-- | A 'Relation' @r@ is 'difunctional' or regular wherever

710−-- @r ``comp`` 'conv' r ``comp`` r == r@

718+-- @r `.` 'conv' r `.` r == r@

711difunctional :: Relation a b -> Bool

719difunctional :: Relation a b -> Bool

712−difunctional r = r `comp` conv r `comp` r == r

720+difunctional r = r . conv r . r == r

713

721

714-- Relational pairing

722-- Relational pairing

715

723

@@ -718,61 +726,61 @@ difunctional r = r `comp` conv r `comp` r == r

718-- NOTE: That this is not a true categorical product, see for instance:

726-- NOTE: That this is not a true categorical product, see for instance:

719--

727--

720-- @

728-- @

721−-- | 'p1' ``comp`` 'splitR' a b ``sse`` a

729+-- | 'fstR' `.` 'splitR' a b ``sse`` a

722-- 'splitR' a b <=> |

730-- 'splitR' a b <=> |

723−-- | 'p2' ``comp`` 'splitR' a b ``sse`` b

731+-- | 'sndR' `.` 'splitR' a b ``sse`` b

724-- @

732-- @

725--

733--

726-- __Emphasis__ on the 'sse'.

734-- __Emphasis__ on the 'sse'.

727--

735--

728-- @

736-- @

729−-- 'splitR' r s ``comp`` f == 'splitR' (r ``comp`` f) (s ``comp`` f)

737+-- 'splitR' r s `.` f == 'splitR' (r `.` f) (s `.` f)

730−-- (R '><' S) ``comp`` 'splitR' p q == 'splitR' (r ``comp`` p) (s ``comp`` q)

738+-- (R '><' S) `.` 'splitR' p q == 'splitR' (r `.` p) (s `.` q)

731−-- 'conv' ('splitR' r s) ``comp`` 'splitR' x y == ('conv' r ``comp`` x) ``intersection`` ('conv' s ``comp`` y)

739+-- 'conv' ('splitR' r s) `.` 'splitR' x y == ('conv' r `.` x) ``intersection`` ('conv' s `.` y)

732-- @

740-- @

733--

741--

734-- @

742-- @

735-- 'eitherR' ('splitR' r s) ('splitR' t v) == 'splitR' ('eitherR' r t) ('eitherR' s v)

743-- 'eitherR' ('splitR' r s) ('splitR' t v) == 'splitR' ('eitherR' r t) ('eitherR' s v)

736-- @

744-- @

737splitR ::

745splitR ::

738− ( CountableDimensionsN a b,

746+ ( CountableDimsN a b,

739 CountableN (a, b),

747 CountableN (a, b),

740− FromListsN (a, b) a,

748+ FLN (a, b) a,

741− FromListsN (a, b) b,

749+ FLN (a, b) b,

742 TrivialP a b

750 TrivialP a b

743 )

751 )

744 => Relation c a -> Relation c b -> Relation c (a, b)

752 => Relation c a -> Relation c b -> Relation c (a, b)

745−splitR (R f) (R g) = R (I.khatri f g)

753+splitR (R f) (R g) = R (I.kr f g)

746

754

747-- | Relational pairing first component projection

755-- | Relational pairing first component projection

748--

756--

749-- @

757-- @

750−-- 'p1' ``comp`` 'splitR' r s ``sse`` r

758+-- 'fstR' `.` 'splitR' r s ``sse`` r

751-- @

759-- @

752−p1 ::

760+fstR ::

753 forall a b .

761 forall a b .

754− ( CountableDimensionsN a b,

762+ ( CountableDimsN a b,

755 CountableN (a, b),

763 CountableN (a, b),

756− FromListsN (a, b) a,

764+ FLN (a, b) a,

757 TrivialP a b

765 TrivialP a b

758 )

766 )

759 => Relation (a, b) a

767 => Relation (a, b) a

760−p1 = R (I.kp1 @Boolean @(I.Normalize a) @(I.Normalize b))

768+fstR = R (I.fstM @Boolean @(I.Normalize a) @(I.Normalize b))

761

769

762-- | Relational pairing second component projection

770-- | Relational pairing second component projection

763--

771--

764-- @

772-- @

765−-- 'p2' ``comp`` 'splitR' r s ``sse`` s

773+-- 'sndR' `.` 'splitR' r s ``sse`` s

766-- @

774-- @

767−p2 ::

775+sndR ::

768 forall a b .

776 forall a b .

769− ( CountableDimensionsN a b,

777+ ( CountableDimsN a b,

770 CountableN (a, b),

778 CountableN (a, b),

771− FromListsN (a, b) b,

779+ FLN (a, b) b,

772 TrivialP a b

780 TrivialP a b

773 )

781 )

774 => Relation (a, b) b

782 => Relation (a, b) b

775−p2 = R (I.kp2 @Boolean @(I.Normalize a) @(I.Normalize b))

783+sndR = R (I.sndM @Boolean @(I.Normalize a) @(I.Normalize b))

776

784

777-- Relational pairing functor

785-- Relational pairing functor

778

786

@@ -780,17 +788,17 @@ infixl 4 ><

780-- | Relational pairing functor

788-- | Relational pairing functor

781--

789--

782-- @

790-- @

783−-- r '><' s == 'splitR' (r ``comp`` p1) (s ``comp`` p2)

791+-- r '><' s == 'splitR' (r `.` fstR) (s `.` sndR)

784−-- (r '><' s) ``comp`` (p '><' q) == (r ``comp`` p) '><' (s ``comp`` q)

792+-- (r '><' s) `.` (p '><' q) == (r `.` p) '><' (s `.` q)

785-- @

793-- @

786(><) ::

794(><) ::

787− ( CountableDimensionsN a b,

795+ ( CountableDimsN a b,

788− CountableDimensionsN c d,

796+ CountableDimsN c d,

789− CountableDimensionsN (a, c) (b, d),

797+ CountableDimsN (a, c) (b, d),

790− FromListsN (a, c) a,

798+ FLN (a, c) a,

791− FromListsN (a, c) c,

799+ FLN (a, c) c,

792− FromListsN (b, d) b,

800+ FLN (b, d) b,

793− FromListsN (b, d) d,

801+ FLN (b, d) d,

794 TrivialP a c,

802 TrivialP a c,

795 TrivialP b d

803 TrivialP b d

796 )

804 )

@@ -802,31 +810,31 @@ infixl 4 ><

802-- | Relational coproduct.

810-- | Relational coproduct.

803--

811--

804-- @

812-- @

805−-- | 'eitherR' a b ``comp`` 'i1' == a

813+-- | 'eitherR' a b `.` 'i1' == a

806-- 'eitherR' a b <=> |

814-- 'eitherR' a b <=> |

807−-- | 'eitherR' a b ``comp`` 'i2' == b

815+-- | 'eitherR' a b `.` 'i2' == b

808-- @

816-- @

809--

817--

810-- @

818-- @

811−-- 'eitherR' r s ``comp`` 'conv' ('eitherR' t u) == (r ``comp`` 'conv' t) ``union`` (s ``comp`` 'conv' u)

819+-- 'eitherR' r s `.` 'conv' ('eitherR' t u) == (r `.` 'conv' t) ``union`` (s `.` 'conv' u)

812-- @

820-- @

813--

821--

814-- @

822-- @

815-- 'eitherR' ('splitR' r s) ('splitR' t v) == 'splitR' ('eitherR' r t) ('eitherR' s v)

823-- 'eitherR' ('splitR' r s) ('splitR' t v) == 'splitR' ('eitherR' r t) ('eitherR' s v)

816-- @

824-- @

817eitherR :: Relation a c -> Relation b c -> Relation (Either a b) c

825eitherR :: Relation a c -> Relation b c -> Relation (Either a b) c

818−eitherR = junc

826+eitherR = join

819

827

820-- | Relational coproduct first component injection

828-- | Relational coproduct first component injection

821--

829--

822-- @

830-- @

823−-- 'img' 'i1' ``union`` 'img' 'i2' == 'identity'

831+-- 'img' 'i1' ``union`` 'img' 'i2' == 'id'

824−-- 'i1' ``comp`` 'i2' = 'zeros'

832+-- 'i1' `.` 'i2' = 'zeros'

825-- @

833-- @

826i1 ::

834i1 ::

827− ( CountableDimensionsN a b,

835+ ( CountableDimsN a b,

828− FromListsN b a,

836+ FLN b a,

829− FromListsN a a

837+ FLN a a

830 )

838 )

831 => Relation a (Either a b)

839 => Relation a (Either a b)

832i1 = R I.i1

840i1 = R I.i1

@@ -834,13 +842,13 @@ i1 = R I.i1

834-- | Relational coproduct second component injection

842-- | Relational coproduct second component injection

835--

843--

836-- @

844-- @

837−-- 'img' 'i1' ``union`` 'img' 'i2' == 'identity'

845+-- 'img' 'i1' ``union`` 'img' 'i2' == 'id'

838−-- 'i1' ``comp`` 'i2' = 'zeros'

846+-- 'i1' `.` 'i2' = 'zeros'

839-- @

847-- @

840i2 ::

848i2 ::

841− ( CountableDimensionsN a b,

849+ ( CountableDimsN a b,

842− FromListsN a b,

850+ FLN a b,

843− FromListsN b b

851+ FLN b b

844 )

852 )

845 => Relation b (Either a b)

853 => Relation b (Either a b)

846i2 = R I.i2

854i2 = R I.i2

@@ -850,14 +858,14 @@ infixl 5 -|-

850-- | Relational coproduct functor.

858-- | Relational coproduct functor.

851--

859--

852-- @

860-- @

853−-- r '-|-' s == 'eitherR' ('i1' ``comp`` r) ('i2' ``comp`` s)

861+-- r '-|-' s == 'eitherR' ('i1' `.` r) ('i2' `.` s)

854-- @

862-- @

855(-|-) ::

863(-|-) ::

856− ( CountableDimensionsN b d,

864+ ( CountableDimsN b d,

857− FromListsN b b,

865+ FLN b b,

858− FromListsN d b,

866+ FLN d b,

859− FromListsN b d,

867+ FLN b d,

860− FromListsN d d

868+ FLN d d

861 )

869 )

862 => Relation a b -> Relation c d -> Relation (Either a c) (Either b d)

870 => Relation a b -> Relation c d -> Relation (Either a c) (Either b d)

863(-|-) (R a) (R b) = R ((I.-|-) a b)

871(-|-) (R a) (R b) = R ((I.-|-) a b)

@@ -870,20 +878,20 @@ infixl 5 -|-

870-- 'trans'/'untrans';

878-- 'trans'/'untrans';

871-- more-over, where each particular attribute is placed (input/output) is irrelevant.

879-- more-over, where each particular attribute is placed (input/output) is irrelevant.

872trans ::

880trans ::

873− ( CountableDimensionsN a b,

881+ ( CountableDimsN a b,

874 CountableN c,

882 CountableN c,

875− CountableDimensionsN (a, b) (c, b),

883+ CountableDimsN (a, b) (c, b),

876− FromListsN (c, b) c,

884+ FLN (c, b) c,

877− FromListsN (c, b) b,

885+ FLN (c, b) b,

878− FromListsN (a, b) a,

886+ FLN (a, b) a,

879− FromListsN (a, b) b,

887+ FLN (a, b) b,

880 Trivial (a, b),

888 Trivial (a, b),

881 Trivial (c, b),

889 Trivial (c, b),

882 TrivialP a b,

890 TrivialP a b,

883 TrivialP c b

891 TrivialP c b

884 )

892 )

885 => Relation (a, b) c -> Relation a (c, b)

893 => Relation (a, b) c -> Relation a (c, b)

886−trans r = splitR r p2 `comp` conv p1

894+trans r = splitR r sndR . conv fstR

887

895

888-- | Relational 'untrans'

896-- | Relational 'untrans'

889--

897--

@@ -891,107 +899,110 @@ trans r = splitR r p2 `comp` conv p1

891-- 'trans'/'untrans';

899-- 'trans'/'untrans';

892-- more-over, where each particular attribute is placed (input/output) is irrelevant.

900-- more-over, where each particular attribute is placed (input/output) is irrelevant.

893untrans ::

901untrans ::

894− ( CountableDimensionsN a b,

902+ ( CountableDimsN a b,

895 CountableN c,

903 CountableN c,

896− CountableDimensionsN (a, b) (c, b),

904+ CountableDimsN (a, b) (c, b),

897− FromListsN (c, b) c,

905+ FLN (c, b) c,

898− FromListsN (c, b) b,

906+ FLN (c, b) b,

899− FromListsN (a, b) b,

907+ FLN (a, b) b,

900− FromListsN (a, b) a,

908+ FLN (a, b) a,

901 Trivial (a, b),

909 Trivial (a, b),

902 Trivial (c, b),

910 Trivial (c, b),

903 TrivialP a b,

911 TrivialP a b,

904 TrivialP c b

912 TrivialP c b

905 )

913 )

906 => Relation a (c, b) -> Relation (a, b) c

914 => Relation a (c, b) -> Relation (a, b) c

907−untrans s = p1 `comp` conv (splitR (conv s) p2)

915+untrans s = fstR . conv (splitR (conv s) sndR)

908

916

909-- | Transforms predicate @p@ into a correflexive relation.

917-- | Transforms predicate @p@ into a correflexive relation.

910--

918--

911-- @

919-- @

912−-- 'predR' ('const' True) == 'identity'

920+-- 'predR' ('const' True) == 'id'

913-- 'predR' ('const' False) == 'zeros'

921-- 'predR' ('const' False) == 'zeros'

914-- @

922-- @

915--

923--

916-- @

924-- @

917−-- 'predR' q ``comp`` 'predR' p == 'predR' q ``union`` 'predR' p

925+-- 'predR' q `.` 'predR' p == 'predR' q ``union`` 'predR' p

918-- @

926-- @

919predR ::

927predR ::

920 ( Bounded a,

928 ( Bounded a,

921 Enum a,

929 Enum a,

930+ Countable a,

922 CountableN a,

931 CountableN a,

923− FromListsN a a,

932+ FLN a a,

924− FromListsN Bool a

933+ FLN Bool a

925 )

934 )

926 => Relation a Bool -> Relation a a

935 => Relation a Bool -> Relation a a

927−predR p = identity `intersection` divisionF (fromF' (const True)) p

936+predR p = id `intersection` divisionF (fromF (const True)) p

928

937

929-- | Equalizes functions @f@ and @g@.

938-- | Equalizes functions @f@ and @g@.

930-- That is, @'equalizer' f g@ is the largest coreflexive

939-- That is, @'equalizer' f g@ is the largest coreflexive

931-- that restricts @g@ so that @f@ and @g@ yield the same outputs.

940-- that restricts @g@ so that @f@ and @g@ yield the same outputs.

932--

941--

933-- @

942-- @

934−-- 'equalizer' r r == 'identity'

943+-- 'equalizer' r r == 'id'

935-- 'equalizer' ('point' True) ('point' False) == 'zeros'

944-- 'equalizer' ('point' True) ('point' False) == 'zeros'

936-- @

945-- @

937equalizer ::

946equalizer ::

938 ( CountableN a,

947 ( CountableN a,

939− FromListsN a a

948+ FLN a a

940 )

949 )

941 => Relation a b -> Relation a b -> Relation a a

950 => Relation a b -> Relation a b -> Relation a a

942−equalizer f g = identity `intersection` divisionF f g

951+equalizer f g = id `intersection` divisionF f g

943

952

944-- | Relational conditional guard.

953-- | Relational conditional guard.

945--

954--

946-- @

955-- @

947−-- 'guard' p = 'i2' ``overriddenBy`` 'i1' ``comp`` 'predR' p

956+-- 'guard' p = 'i2' ``overriddenBy`` 'i1' `.` 'predR' p

948-- @

957-- @

949−guard ::

958+guard ::

950 ( Bounded b,

959 ( Bounded b,

951 Enum b,

960 Enum b,

952 CountableN b,

961 CountableN b,

953− FromListsN b b,

962+ Countable b,

963+ FLN b b,

954− FromListsN Bool b

964+ FLN Bool b

955 ) => Relation b Bool -> Relation b (Either b b)

965 ) => Relation b Bool -> Relation b (Either b b)

956guard p = conv (eitherR (predR p) (predR (negate p)))

966guard p = conv (eitherR (predR p) (predR (negate p)))

957

967

958-- | Relational McCarthy's conditional.

968-- | Relational McCarthy's conditional.

959−cond ::

969+cond ::

960 ( Bounded b,

970 ( Bounded b,

961 Enum b,

971 Enum b,

972+ Countable b,

962 CountableN b,

973 CountableN b,

963− FromListsN b b,

974+ FLN b b,

964− FromListsN Bool b

975+ FLN Bool b

965− )

976+ )

966 => Relation b Bool -> Relation b c -> Relation b c -> Relation b c

977 => Relation b Bool -> Relation b c -> Relation b c -> Relation b c

967−cond p r s = eitherR r s `comp` guard p

978+cond p r s = eitherR r s . guard p

968

979

969-- | Relational domain.

980-- | Relational domain.

970--

981--

971-- For injective relations, 'domain' and 'ker'nel coincide,

982-- For injective relations, 'domain' and 'ker'nel coincide,

972−-- since @'ker' r ``sse`` 'identity'@ in such situations.

983+-- since @'ker' r ``sse`` 'id'@ in such situations.

973domain ::

984domain ::

974 ( CountableN a,

985 ( CountableN a,

975− FromListsN a a

986+ FLN a a

976 ) => Relation a b -> Relation a a

987 ) => Relation a b -> Relation a a

977−domain r = ker r `intersection` identity

988+domain r = ker r `intersection` id

978

989

979-- | Relational range.

990-- | Relational range.

980--

991--

981-- For functions, 'range' and 'img' (image) coincide,

992-- For functions, 'range' and 'img' (image) coincide,

982−-- since @'img' f ``sse`` 'identity'@ for any @f@.

993+-- since @'img' f ``sse`` id@ for any @f@.

983range ::

994range ::

984 ( CountableN b,

995 ( CountableN b,

985− FromListsN b b

996+ FLN b b

986 ) => Relation a b -> Relation b b

997 ) => Relation a b -> Relation b b

987−range r = img r `intersection` identity

998+range r = img r `intersection` id

988

999

989-- Relation pretty print

1000-- Relation pretty print

990

1001

991-- | Relation pretty printing

1002-- | Relation pretty printing

992−pretty :: (CountableDimensionsN a b) => Relation a b -> String

1003+pretty :: (CountableDimsN a b) => Relation a b -> String

993pretty (R a) = I.pretty a

1004pretty (R a) = I.pretty a

994

1005

995-- | Relation pretty printing

1006-- | Relation pretty printing

996−prettyPrint :: (CountableDimensionsN a b) => Relation a b -> IO ()

1007+prettyPrint :: (CountableDimsN a b) => Relation a b -> IO ()

997prettyPrint (R a) = I.prettyPrint a

1008prettyPrint (R a) = I.prettyPrint a

src/LAoP/Utils.hs+4−1

@@ -96,7 +96,10 @@ module LAoP.Utils

96 coerceNat3,

98 -- * List data type

99− List (..)

99+ List (..),

100+

101+ -- * Category type-class

102+ Category(..)

100 )

103 )

101where

104where

102

105

src/LAoP/Utils/Internal.hs+28−2

@@ -1,9 +1,9 @@

1+{-# LANGUAGE TypeFamilies #-}

1{-# LANGUAGE DeriveGeneric #-}

2{-# LANGUAGE DeriveGeneric #-}

2{-# LANGUAGE TypeApplications #-}

3{-# LANGUAGE TypeApplications #-}

3{-# LANGUAGE DataKinds #-}

4{-# LANGUAGE DataKinds #-}

4{-# LANGUAGE FlexibleInstances #-}

5{-# LANGUAGE FlexibleInstances #-}

5{-# LANGUAGE GeneralizedNewtypeDeriving #-}

6{-# LANGUAGE GeneralizedNewtypeDeriving #-}

6−{-# LANGUAGE KindSignatures #-}

7{-# LANGUAGE ScopedTypeVariables #-}

9module LAoP.Utils.Internal

@@ -19,7 +19,10 @@ module LAoP.Utils.Internal

19 coerceNat3,

21 -- * 'List' data type

22− List (..)

22+ List (..),

23+

24+ -- * Category type class

25+ Category(..)

23 )

26 )

24where

27where

@@ -30,6 +33,9 @@ import Data.Maybe

30import GHC.TypeLits

33import GHC.TypeLits

31import Control.DeepSeq

34import Control.DeepSeq

32import GHC.Generics

35import GHC.Generics

36+import Data.Kind

37+import Prelude hiding (id, (.))

38+import qualified Prelude

34-- | Wrapper around 'Int's that have a restrictive semantic associated.

40-- | Wrapper around 'Int's that have a restrictive semantic associated.

35-- A value of type @'Natural' n m@ can only be instanciated with some 'Int'

41-- A value of type @'Natural' n m@ can only be instanciated with some 'Int'

@@ -168,3 +174,23 @@ instance

168 fromEnum (L x) =

174 fromEnum (L x) =

169 let as = [minBound .. maxBound]

175 let as = [minBound .. maxBound]

170 in fromMaybe (error "Does not exist") $ elemIndex x (powerset as)

176 in fromMaybe (error "Does not exist") $ elemIndex x (powerset as)

177+

178+-- | Constrained category instance

179+class Category k where

180+ type Object k o :: Constraint

181+ type Object k o = ()

182+ id :: Object k a => k a a

183+ (.) :: k b c -> k a b -> k a c

184+

185+{-# RULES

186+"identity/left" forall p .

187+ id . p = p

188+"identity/right" forall p .

189+ p . id = p

190+"association" forall p q r .

191+ (p . q) . r = p . (q . r)

192+ #-}

193+

194+instance Category (->) where

195+ id = Prelude.id

196+ (.) = (Prelude..)

stack-8.8.3.yamlnew file+1

@@ -0,0 +1 @@

1+resolver: lts-15.5

stack.yaml+1−66

@@ -1,66 +1 @@

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/

6−

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

1+resolver: lts-14.3

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 @@

6packages: []

7snapshots:

8- completed:

9− size: 524789

9+ size: 523878

10− url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/14/18.yaml

10+ url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/14/3.yaml

11− sha256: 646be71223e08234131c6989912e6011e01b9767bc447b6d466a35e14360bdf2

11+ sha256: 470c46c27746a48c7c50f829efc0cf00112787a7804ee4ac7a27754658f6d92c

12− original: lts-14.18

12+ original: lts-14.3

test/Examples/Quantum.hsnew file+31

@@ -0,0 +1,31 @@

1+{-# LANGUAGE StandaloneDeriving #-}

2+module Examples.Quantum where

4+import LAoP.Utils

5+import LAoP.Matrix.Type

6+import Data.Complex

7+import Prelude hiding (id, (.))

9+deriving instance Ord a => Ord (Complex a)

10+

11+xor :: (Bool, Bool) -> Bool

12+xor (False, b) = b

13+xor (True, b) = not b

14+

15+ker :: Num e => Matrix e a b -> Matrix e a a

16+ker m = tr m . m

17+

18+cnot :: Matrix (Complex Double) (Bool, Bool) (Bool, Bool)

19+cnot = kr fstM (fromF xor)

20+

21+ccnot :: (Num e, Ord e) => Matrix e ((Bool, Bool), Bool) ((Bool, Bool), Bool)

22+ccnot = kr fstM (fromF f)

23+ where

24+ f = xor . tp (uncurry (&&)) id

25+ tp f g (a,b) = (f a, g b)

26+

27+had :: Matrix (Complex Double) Bool Bool

28+had = (1/sqrt 2) .| fromLists [[1, 1], [1, -1]]

29+

30+bell :: Matrix (Complex Double) (Bool, Bool) (Bool, Bool)

31+bell = cnot . (had >< iden)

app/Examples.hs → test/Examples/Readme.hsrenamed+35−20

@@ -1,11 +1,10 @@

1{-# LANGUAGE GADTs #-}

2{-# LANGUAGE DeriveGeneric #-}

3{-# LANGUAGE FlexibleContexts #-}

4−{-# LANGUAGE TypeOperators #-}

5{-# LANGUAGE TypeApplications #-}

4{-# LANGUAGE TypeApplications #-}

6{-# LANGUAGE DataKinds #-}

5{-# LANGUAGE DataKinds #-}

8−module Examples

7+module Examples.Readme

9 ( exec

8 ( exec

10 )

9 )

11 where

10 where

@@ -17,8 +16,7 @@ import LAoP.Dist

17import GHC.TypeLits

16import GHC.TypeLits

18import Data.Coerce

17import Data.Coerce

19import qualified GHC.Generics as G

18import qualified GHC.Generics as G

20−import Control.Category hiding (id)

21−import Prelude hiding ((.))

19+import Prelude hiding (id, (.))

23-- Monty Hall Problem

21-- Monty Hall Problem

24data Outcome = Win | Lose

22data Outcome = Win | Lose

@@ -32,7 +30,7 @@ firstChoice :: Matrix Double () Outcome

32firstChoice = col [1/3, 2/3]

30firstChoice = col [1/3, 2/3]

34secondChoice :: Matrix Double Outcome Outcome

32secondChoice :: Matrix Double Outcome Outcome

35−secondChoice = fromF' switch

33+secondChoice = fromF switch

37-- Dice sum

35-- Dice sum

@@ -41,7 +39,7 @@ type SS = Natural 1 6 -- Sample Space

41sumSS :: SS -> SS -> Natural 2 12

39sumSS :: SS -> SS -> Natural 2 12

42sumSS = coerceNat (+)

40sumSS = coerceNat (+)

44−sumSSM = fromF' (uncurry sumSS)

42+sumSSM = fromF (uncurry sumSS)

46condition :: (Int, Int) -> Int -> Int

44condition :: (Int, Int) -> Int -> Int

47condition (fst, snd) thrd = if fst == snd

45condition (fst, snd) thrd = if fst == snd

@@ -51,7 +49,7 @@ condition (fst, snd) thrd = if fst == snd

51conditionSS :: (SS, SS) -> SS -> Natural 3 18

49conditionSS :: (SS, SS) -> SS -> Natural 3 18

52conditionSS = coerceNat2 condition

50conditionSS = coerceNat2 condition

54−conditionalThrows = fromF' (uncurry conditionSS) . khatri (khatri die die) die

52+conditionalThrows = fromF (uncurry conditionSS) . kr (kr die die) die

56die :: Matrix Double () SS

54die :: Matrix Double () SS

57die = col $ map (const (1/6)) [nat @1 @6 1 .. nat 6]

55die = col $ map (const (1/6)) [nat @1 @6 1 .. nat 6]

@@ -67,23 +65,40 @@ data R = No | Yes

67 deriving (Bounded, Enum, Eq, Show, G.Generic)

65 deriving (Bounded, Enum, Eq, Show, G.Generic)

69rain :: Matrix Double () R

67rain :: Matrix Double () R

70−rain = col [0.8, 0.2]

68+rain = matrixBuilder gen

69+ where

70+ gen (_, No) = 0.8

71+ gen (_, Yes) = 0.2

72sprinkler :: Matrix Double R S

73sprinkler :: Matrix Double R S

73−sprinkler = fromLists [[0.6, 0.99], [0.4, 0.01]]

74+sprinkler = matrixBuilder gen

75+ where

76+ gen (No, Off) = 0.6

77+ gen (No, On) = 0.4

78+ gen (Yes, Off) = 0.99

79+ gen (Yes, On) = 0.01

75grass :: Matrix Double (S, R) G

81grass :: Matrix Double (S, R) G

76−grass = fromLists [[1, 0.2, 0.1, 0.01], [0, 0.8, 0.9, 0.99]]

82+grass = matrixBuilder gen

83+ where

84+ gen ((Off, No), Dry) = 1

85+ gen ((Off, Yes), Dry) = 0.2

86+ gen ((On, No), Dry) = 0.1

87+ gen ((On, Yes), Dry) = 0.01

88+ gen ((Off, No), Wet) = 0

89+ gen ((Off, Yes), Wet) = 0.8

90+ gen ((On, No), Wet) = 0.9

91+ gen ((On, Yes), Wet) = 0.99

78−tag f = khatri f identity

93+tag f = kr f id

80−state g s r = tag g `comp` tag s `comp` r

95+state g s r = tag g . tag s . r

82grass_wet :: Matrix Double () (G, (S, R)) -> Matrix Double One One

97grass_wet :: Matrix Double () (G, (S, R)) -> Matrix Double One One

83−grass_wet state = row [0,1] . kp1 . state

98+grass_wet state = row [0,1] . fstM . state

85rainning :: Matrix Double (G, (S, R)) One

100rainning :: Matrix Double (G, (S, R)) One

86−rainning = row [0,1] . kp2 . kp2

101+rainning = row [0,1] . sndM . sndM

102

88-- Alcuin Puzzle

103-- Alcuin Puzzle

104

@@ -106,21 +121,21 @@ cross LeftB = RightB

106cross RightB = LeftB

121cross RightB = LeftB

107

122

108crossR :: R.Relation Bank Bank

123crossR :: R.Relation Bank Bank

109−crossR = R.fromF' cross

124+crossR = R.fromF cross

110

125

111-- | Initial state, everyone in the left bank

126-- | Initial state, everyone in the left bank

112locationLeft :: Being -> Bank

127locationLeft :: Being -> Bank

113locationLeft _ = LeftB

128locationLeft _ = LeftB

114

129

115locationLeftR :: R.Relation Being Bank

130locationLeftR :: R.Relation Being Bank

116−locationLeftR = R.fromF' locationLeft

131+locationLeftR = R.fromF locationLeft

117

132

118-- | Initial state, everyone in the right bank

133-- | Initial state, everyone in the right bank

119locationRight :: Being -> Bank

134locationRight :: Being -> Bank

120locationRight _ = RightB

135locationRight _ = RightB

121

136

122locationRightR :: R.Relation Being Bank

137locationRightR :: R.Relation Being Bank

123−locationRightR = R.fromF' locationRight

138+locationRightR = R.fromF locationRight

124

139

125-- Properties

140-- Properties

126

141

@@ -137,7 +152,7 @@ inv :: R.Relation Being Bank -> Bool

137inv w = (w `R.comp` canEat w) `R.sse` (w `R.comp` farmer)

152inv w = (w `R.comp` canEat w) `R.sse` (w `R.comp` farmer)

138 where

153 where

139 farmer :: R.Relation Being Being

154 farmer :: R.Relation Being Being

140− farmer = R.fromF' (const Farmer)

155+ farmer = R.fromF (const Farmer)

141

156

142-- Arbitrary state

157-- Arbitrary state

143bankState :: Being -> Bank -> Bool

158bankState :: Being -> Bank -> Bool

@@ -156,11 +171,11 @@ exec = do

156 putStrLn "Monty Hall Problem solution:"

171 putStrLn "Monty Hall Problem solution:"

157 prettyPrint (secondChoice . firstChoice)

172 prettyPrint (secondChoice . firstChoice)

158 putStrLn "\n Sum of dices probability:"

173 putStrLn "\n Sum of dices probability:"

159− prettyPrint (sumSSM `comp` khatri die die)

174+ prettyPrint (sumSSM . kr die die)

160 putStrLn "\n Conditional dice throw:"

175 putStrLn "\n Conditional dice throw:"

161 prettyPrint conditionalThrows

176 prettyPrint conditionalThrows

162 putStrLn "\n Checking that the last result is indeed a distribution: "

177 putStrLn "\n Checking that the last result is indeed a distribution: "

163− prettyPrint (bang . sumSSM . khatri die die)

178+ prettyPrint (bang . sumSSM . kr die die)

164 putStrLn "\n Probability of grass being wet:"

179 putStrLn "\n Probability of grass being wet:"

165 prettyPrint (grass_wet (state grass sprinkler rain))

180 prettyPrint (grass_wet (state grass sprinkler rain))

166 putStrLn "\n Probability of rain:"

181 putStrLn "\n Probability of rain:"

app/Spreadsheets.hs → test/Examples/Spreadsheets.hsrenamed+6−6

@@ -1,11 +1,11 @@

1{-# LANGUAGE DeriveGeneric #-}

3−module Spreadsheets

3+module Examples.Spreadsheets

4− where

5+import LAoP.Utils

6import LAoP.Matrix.Type

7−import qualified LAoP.Matrix.Internal as I

8import GHC.Generics

7import GHC.Generics

8+import Prelude hiding (id, (.))

10data Student = Student1 | Student2 | Student3 | Student4

11 deriving (Eq, Show, Enum, Bounded, Generic)

@@ -35,12 +35,12 @@ xls :: Matrix Float Question One

35 -> Matrix Float Question Student

36 -> Matrix Float Student One

37 -> Matrix Float (Either Question Results) (Either One Student)

38−xls w m t = junc (split w m) (split zeros r)

38+xls w m t = join (fork w m) (fork zeros r)

39 where

40− rExam = m `comp` tr w

40+ rExam = m . tr w

41 rTest = tr t

42 rFinal = rTest `maxPW` rExam

43− r = (rExam `comp` tr exam) + (rTest `comp` tr test) + (rFinal `comp` tr final)

43+ r = (rExam . tr exam) + (rTest . tr test) + (rFinal . tr final)

45-- | Overloaded, point-wise 'max' function

46maxPW :: Ord e => Matrix e a b -> Matrix e a b -> Matrix e a b

test/Spec.hs+7−1

@@ -1,2 +1,8 @@

1+module Main (main) where

3+import qualified Examples.Readme as RD

1main :: IO ()

5main :: IO ()

2−main = putStrLn "Test suite not yet implemented"

6+main = do

7+ putStrLn ("Testing if README works" :: String)

8+ RD.exec