0991ecc..master · laop

git.iko.soy/laop

on master help sign in

30 files changed+1004−1884

since splitsnapshots

unifiedsplit

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

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

125.stack-work/

2−laop.cabal

3−*~

26+stack.yaml.lock

27+

28+### IDE/support

29+# Vim

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

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

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

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

34+*~

35+tags

36+

37+# IntellijIDEA

38+.idea/

39+.ideaHaskellLib/

40+*.iml

41+

42+# Atom

43+.haskell-ghc-mod.json

44+

45+# VS

46+.vscode/

47+

48+# Emacs

49+*#

50+.dir-locals.el

51+TAGS

52+

53+# other

54+.DS_Store

55+hackage.sh

.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

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

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

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

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

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

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

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

711

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

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

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

13+copies or substantial portions of the Software.

1014

11− * Redistributions in binary form must reproduce the above

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

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

14− with the distribution.

15−

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

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

18− from this software without specific prior written permission.

19−

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

21+SOFTWARE.

README.md+34−30

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

11# laop - Linear Algebra of Programming library

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

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

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

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

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

39The LAoP discipline generalises relations and functions treating them as

410Boolean matrices and in turn consider these as arrows.

511

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

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

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

1218

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

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

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

1620

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.

1822

1923## Features

2024

21−This library offers:

22−

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

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

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

26− around the internal matrix data type.

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

28− around the internal matrix data type.

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

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

31− AoP and Relational Calculus/Algebra.

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

33− make it easier to deal with sample space.

34−

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

36−

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

38−- Statically typed dimensions;

39−- Polymorphic data type dimensions;

40−- Polymorphic matrix content;

41−- Awesome dimension type inference;

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

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

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

45−

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

25+This library offers 3 main matrix programming modules:

26+

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

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

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

30+

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

32+distributions.

33+

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

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

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

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

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

39+and transformation functions.

40+

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

42+

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

44+

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

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

47+

48+## Known issues

49+

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

4751

4852## Notes

4953

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

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

88{-# LANGUAGE AllowAmbiguousTypes #-}

99{-# LANGUAGE ScopedTypeVariables #-}

1010

11−module Benchmarks

12− ( benchmark

13− )

14− where

11+module Main (main) where

1512

1613import LAoP.Dist.Internal

1714import LAoP.Utils

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

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

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

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

2017import Criterion.Main

2118import Control.DeepSeq

2219import Test.QuickCheck

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

2421import Data.Proxy

2522import Prelude hiding (id, (.))

2623

27−selectM2 ::

24+selectM2 ::

2825 ( Num e,

29− EqN b,

30− ConstructN b,

31− EnumerableN b

26+ T.FLN b b,

27+ CountableN b

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

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

3430

3531selectD2 ::

36− ( Num e,

37− EqN b,

38− ConstructN b,

39− EnumerableN b

32+ ( FLN b b,

33+ CountableN b

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

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

4236

4337-- Composition with iden

4438compId m = comp iden m

4539

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

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

4741randomDist = do

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

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

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

5246 m = fromLists lr

5347 return (D m)

5448

55−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)

5650randomMatrix = do

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

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

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

111105 probs = map (/ s) l

112106 in zip as probs

113107

114−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))

115109randomDistF = do

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

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

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

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

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

152146

153−benchmark :: IO ()

154−benchmark = defaultMain [

147+main :: IO ()

148+main = defaultMain [

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

156150 bgroup "10x10" [

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

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

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

3939 -- * Constraint type synonyms

4040 Countable,

4141 CountableN,

42− CountableDimensionsN,

43− FromListsN,

42+ CountableDimsN,

43+ FLN,

4444 Liftable,

4545 TrivialP,

4646

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

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

1616

1717 Countable,

1818 CountableN,

19− CountableDimensionsN,

20− FromListsN,

19+ CountableDimsN,

20+ FLN,

2121 Liftable,

2222 TrivialP,

2323

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

4343 )

4444 where

4545

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

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

4747import Prelude hiding (id, (.))

48−import qualified LAoP.Matrix.Alternative as I

48+import qualified LAoP.Matrix.Internal as I

4949import LAoP.Utils

5050import GHC.TypeLits

5151import Data.Proxy

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

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

6363

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

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

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

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

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

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

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

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

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

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

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

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

7071

7172-- | Functor instance

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

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

73+fmapD ::

74+ ( Liftable a b,

75+ CountableDimsN a b,

76+ FLN b a

77+ )

78+ =>

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

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

7481

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

7683unitD :: Dist ()

7784unitD = D (one 1)

7885

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

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

87+multD ::

88+ ( CountableDimsN a b,

89+ CountableN (a, b),

90+ FLN (a, b) a,

91+ FLN (a, b) b,

92+ TrivialP a b

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

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

8295

8396-- | Selective instance function

84−selectD ::

85− ( EqN a,

86− EqN b,

87− EnumerableN b,

88− ConstructN b

97+selectD ::

98+ ( FLN b b,

99+ CountableN b

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

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

91102

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

93104-- functions to apply to a given argument;

94105branchD ::

95106 ( Num e,

96− EqN a,

97− EqN b,

98− EqN c,

99− ConstructableN a b,

100− ConstructN c,

101− EnumerableN a,

102− EnumerableN b,

103− EnumerableN c

107+ CountableDimsN a b,

108+ CountableDimsN c (Either b c),

109+ FLN c b,

110+ FLN a b,

111+ FLN a a,

112+ FLN b b,

113+ FLN c c,

114+ FLN b a,

115+ FLN b c,

116+ FLN (Either b c) b,

117+ FLN (Either b c) c

104118 )

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

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

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

110124

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

112126ifD ::

113− ( Num e,

114− EqN a,

115− ConstructN a,

116− EnumerableN a

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

128+ FLN a a,

129+ FLN a (),

130+ FLN () a,

131+ FLN (Either () a) a

117132 )

118133 => Dist Bool -> Dist a -> Dist a -> Dist a

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

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

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

122137

123138-- | Monad instance 'return' function

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

125−returnD = D . returnM

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

140+returnD a = D (col l)

141+ where

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

143+ x = fromEnum a

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

126145

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

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

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

132151(??) ::

133152 ( Enum a,

134153 Countable a,

135− FromListsN () a

154+ FLN () a

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

137156(??) p d =

138157 let l = toValues d

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

142161-- Distribution Construction

143162

144163-- | Constructs a Bernoulli distribution

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

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

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

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

147166

148167-- | Creates a distribution given a shape function

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

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

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

151170shape f xs =

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

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

154173 in fromFreqs (zip xs ps)

155174

156175-- | Constructs a Linear distribution

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

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

158177linear = shape id

159178

160179-- | Constructs an Uniform distribution

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

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

162181uniform = shape (const 1)

163182

164183-- | Constructs an Negative Exponential distribution

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

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

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

167186

168187-- | Constructs an Normal distribution

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

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

170189normal = shape (normalCurve 0.5 0.5)

171190

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

173−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)]

174193toValues (D d) =

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

176195 probs = toList d

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

178197 in res

179198

180199-- | Pretty a distribution

181−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

182201prettyDist d =

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

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

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

190209 showR n x = show x ++ " "

191210

192211-- | Pretty Print a distribution

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

194213prettyPrintDist = putStrLn . prettyDist @a

195214

196215-- Auxiliary functions

197216

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

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

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

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

200219 where q = sum $ map snd xs

201220

202221normalCurve :: Prob -> Prob -> Prob -> Prob

src/LAoP/Matrix/Alternative.hsdeleted−956

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

1−{-# LANGUAGE TypeApplications #-}

2−{-# LANGUAGE LambdaCase #-}

3−{-# LANGUAGE StrictData #-}

4−{-# LANGUAGE TypeFamilyDependencies #-}

5−{-# LANGUAGE ConstraintKinds #-}

6−{-# LANGUAGE AllowAmbiguousTypes #-}

7−{-# LANGUAGE DataKinds #-}

8−{-# LANGUAGE FlexibleContexts #-}

9−{-# LANGUAGE FlexibleInstances #-}

10−{-# LANGUAGE GADTs #-}

11−{-# LANGUAGE InstanceSigs #-}

12−{-# LANGUAGE MultiParamTypeClasses #-}

13−{-# LANGUAGE NoStarIsType #-}

14−{-# LANGUAGE ScopedTypeVariables #-}

15−{-# LANGUAGE StandaloneDeriving #-}

16−{-# LANGUAGE TypeOperators #-}

17−{-# LANGUAGE UndecidableInstances #-}

18−

19−-----------------------------------------------------------------------------

20−-- |

21−-- Module : LAoP.Matrix.Internal

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

23−-- Maintainer : armandoifsantos@gmail.com

24−-- Stability : experimental

25−--

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

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

28−--

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

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

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

32−--

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

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

35−--

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

37−--

38−-----------------------------------------------------------------------------

39−

40−module LAoP.Matrix.Alternative

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

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

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

44− --

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

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

47− -- leads to a very straightforward implementation

48− -- of LAoP combinators.

49−

50− -- * Type safe matrix representation

51− Matrix (..),

52−

53− -- * Primitives

54− empty,

55− one,

56− join,

57− fork,

58−

59− -- * Auxiliary type families

60− FromNat,

61− Count,

62− Normalize,

63−

64− -- * Matrix construction and conversion

65− FromLists,

66− fromLists,

67− toLists,

68− toList,

69− matrixBuilder,

70− matrixBuilderN,

71− rowL,

72− rowN,

73− colL,

74− colN,

75− zeros,

76− ones,

77− bang,

78− point,

79− constant,

80−

81− -- * Misc

82− -- ** Get dimensions

83− columns,

84− rows,

85−

86− -- ** Matrix Transposition

87− tr,

88−

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

90− (.|),

91− (./),

92−

93− -- ** Selective operator

94− select,

95− branch,

96−

97− -- ** McCarthy's Conditional

98− -- cond,

99−

100− -- ** Matrix "abiding"

101− abideJF,

102− abideFJ,

103−

104− -- ** Zip matrices

105− zipWithM,

106−

107− -- * Biproduct approach

108− -- ** Fork

109− (===),

110− -- *** Projections

111− p1,

112− p2,

113− -- ** Join

114− (|||),

115− -- *** Injections

116− i1,

117− i2,

118− -- ** Bifunctors

119− (-|-),

120− (><),

121−

122− -- ** Applicative matrix combinators

123−

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

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

126− -- *** Matrix pairing projections

127− fstM,

128− sndM,

129−

130− -- *** Matrix pairing

131− kr,

132−

133− -- * Matrix composition and lifting

134−

135− -- ** Arrow matrix combinators

136−

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

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

139− iden,

140− comp,

141− fromF,

142− fromFN,

143−

144− -- * Matrix printing

145− pretty,

146− prettyPrint,

147−

148− -- * Other

149− toBool,

150− fromBool,

151− compRel,

152− divR,

153− divL,

154− divS,

155− fromFRelN,

156− toRelN,

157− negateM,

158− orM,

159− andM,

160− subM,

161−

162− -- * Semantics

163− Vector(..),

164− LinearMap,

165− Construct

166− )

167− where

168−

169−import LAoP.Utils.Internal

170−import Data.Bool

171−import Data.Functor.Contravariant

172−import Data.Kind

173−import Data.List

174−import Data.Maybe

175−import Data.Proxy

176−import Data.Void

177−import GHC.TypeLits

178−import Data.Type.Equality

179−import GHC.Generics

180−import Control.DeepSeq

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

182−

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

184−data Matrix e cols rows where

185− Empty :: Matrix e Void Void

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

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

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

189−

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

191−

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

193−--

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

195−-- 'Generic' instance.

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

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

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

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

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

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

202− -- Generics

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

204− Count (K1 _ _ _) = 1

205− Count (V1 _) = 0

206− Count (U1 _) = 1

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

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

209− Count d = Count (Rep d R)

210−

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

212−--

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

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

215− FromNat 0 = Void

216− FromNat 1 = ()

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

218−

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

220− FromNat' 'True m = Either m m

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

222−

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

224−-- structure

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

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

227− Normalize d = FromNat (Count d)

228−

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

230−type Countable a = KnownNat (Count a)

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

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

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

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

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

236−type ConstructN a = Construct (Normalize a)

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

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

239−

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

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

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

243−--

244−-- Please use 'iden' instead.

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

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

247− id = iden

248− (.) = comp

249−

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

251− rnf Empty = ()

252− rnf (One e) = rnf e

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

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

255−

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

257− Empty == Empty = True

258− (One a) == (One b) = a == b

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

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

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

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

263−

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

265−

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

267−

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

269−

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

271−

272− abs Empty = Empty

273− abs (One a) = One (abs a)

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

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

276−

277− signum Empty = Empty

278− signum (One a) = One (signum a)

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

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

281−

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

283− Empty <= Empty = True

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

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

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

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

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

289−

290−-- Primitives

291−

292−-- | Empty matrix constructor

293−empty :: Matrix e Void Void

294−empty = Empty

295−

296−-- | Unit matrix constructor

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

298−one = One

299−

300−-- | Matrix 'Join' constructor

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

302−join = Join

303−

304−infixl 3 |||

305−

306−-- | Matrix 'Join' constructor

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

308−(|||) = Join

309−

310−-- | Matrix 'Fork' constructor

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

312−fork = Fork

313−

314−infixl 2 ===

315−

316−-- | Matrix 'Fork' constructor

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

318−(===) = Fork

319−

320−-- Construction

321−

322−-- | Constructs a column vector matrix

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

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

325−

326−-- | Constructs a row vector matrix

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

328−rowL = fromLists . (: [])

329−

330−-- Conversion

331−

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

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

334−toLists Empty = []

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

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

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

338−

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

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

341−toList = concat . toLists

342−

343−-- Zeros Matrix

344−

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

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

347−zeros = matrixBuilder (const 0)

348−

349−-- Ones Matrix

350−

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

352−--

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

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

355−ones = matrixBuilder (const 1)

356−

357−-- Const Matrix

358−

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

360−-- value.

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

362−constant e = matrixBuilder (const e)

363−

364−-- Bang Matrix

365−

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

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

368−bang = ones

369−

370−-- | Point constant matrix

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

372−point = fromF . const

373−

374−-- iden Matrix

375−

376−-- | iden matrix.

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

378−iden = fromF id

379−

380−-- Matrix composition (MMM)

381−

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

383−--

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

385−-- from LAoP.

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

387−comp Empty Empty = Empty

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

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

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

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

392−{-# NOINLINE comp #-}

393−{-# RULES

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

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

396−#-}

397−

398−-- Scalar multiplication of matrices

399−

400−infixl 7 .|

401−-- | Scalar multiplication of matrices.

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

403−(.|) _ Empty = Empty

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

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

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

407−

408−-- Scalar division of matrices

409−

410−infixl 7 ./

411−-- | Scalar multiplication of matrices.

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

413−(./) Empty _ = Empty

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

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

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

417−

418−-- Projections

419−

420−-- | Biproduct first component projection

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

422−p1 = join iden zeros

423−

424−-- | Biproduct second component projection

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

426−p2 = join zeros iden

427−

428−-- Injections

429−

430−-- | Biproduct first component injection

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

432−i1 = tr p1

433−

434−-- | Biproduct second component injection

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

436−i2 = tr p2

437−

438−-- Dimensions

439−

440−-- | Obtain the number of rows.

441−--

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

443−-- dimensions in constant time.

444−--

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

446−-- exchange for performance.

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

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

449−

450−-- | Obtain the number of columns.

451−--

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

453−-- dimensions in constant time.

454−--

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

456−-- exchange for performance.

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

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

459−

460−-- Coproduct Bifunctor

461−

462−infixl 5 -|-

463−

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

465−(-|-) ::

466− ( Num e,

467− Eq k,

468− Eq j,

469− Constructable k j,

470− Enumerable k,

471− Enumerable j

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

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

474−

475−-- Khatri Rao Product and projections

476−

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

478−fstM ::

479− forall e a b .

480− ( Num e,

481− Eq a,

482− ConstructableN (a, b) a,

483− ConstructableNorm (a, b) a,

484− Enumerable a,

485− Enumerable b

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

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

488−

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

490−sndM ::

491− forall e a b .

492− ( Num e,

493− Eq b,

494− ConstructableN (a, b) b,

495− ConstructableNorm (a, b) b,

496− Enumerable a,

497− Enumerable b

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

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

500−

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

502−--

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

504−--

505−-- @

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

507−-- kr a b ==> |

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

509−-- @

510−--

511−-- __Emphasis__ on the implication symbol.

512−kr ::

513− forall e cols a b .

514− ( Num e,

515− Eq a,

516− Eq b,

517− ConstructableN a (a, b),

518− ConstructN b,

519− ConstructableNorm a b,

520− ConstructNorm (a, b),

521− Enumerable a,

522− Enumerable b

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

524−kr a b =

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

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

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

528−

529−-- Product Bifunctor (Kronecker)

530−

531−infixl 4 ><

532−

533−type Kronecker e m n p q =

534− ( Num e,

535− Eq m,

536− Eq n,

537− Eq p,

538− Eq q,

539− ConstructableN m n,

540− ConstructableNorm m (m, n),

541− ConstructNorm n,

542− ConstructN (m, n),

543− ConstructableN p q,

544− ConstructableNorm p (p, q),

545− ConstructNorm q,

546− ConstructN (p, q),

547− Enumerable m,

548− Enumerable n,

549− Enumerable p,

550− Enumerable q

551− )

552−

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

554−(><) ::

555− forall e m p n q .

556− Kronecker e m n p q

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

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

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

560−(><) a b =

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

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

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

564−

565−-- Matrix abide Join Fork

566−

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

568−--

569−-- Law:

570−--

571−-- @

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

573−-- @

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

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

576−abideJF Empty = Empty

577−abideJF (One e) = One e

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

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

580−

581−-- Matrix abide Fork Join

582−

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

584−--

585−-- @

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

587−-- @

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

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

590−abideFJ Empty = Empty

591−abideFJ (One e) = One e

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

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

594−

595−-- Matrix transposition

596−

597−-- | Matrix transposition.

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

599−tr Empty = Empty

600−tr (One e) = One e

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

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

603−

604−-- Selective 'select' operator

605−

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

607−-- ArrowMonad solution presented in the paper.

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

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

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

611−select m y = join y id . m

612−

613−branch ::

614− ( Num e,

615− Eq a,

616− Eq b,

617− Eq c,

618− Constructable a b,

619− Construct c,

620− Enumerable a,

621− Enumerable b,

622− Enumerable c

623− )

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

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

626− where

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

628− g m = i2 . m

629−

630−-- Pretty print

631−

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

633−prettyAux [] _ = ""

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

635− where

636− v = fmap show m

637− widest = maximum $ fmap length v

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

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

640− where

641− v = fmap show m

642− widest = maximum $ fmap length v

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

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

645− prettyAux t l

646− where

647− v = fmap show l

648− widest = maximum $ fmap length v

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

650−

651−-- | Matrix pretty printer

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

653−pretty m = concat

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

655− , unlines

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

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

658− ]

659− where

660− strings = map show (toList m)

661− widest = maximum $ map length strings

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

663− blank = fill ""

664− safeGet i j m

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

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

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

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

669− getElem i j m =

670− fromMaybe

671− (error $

672− "getElem: Trying to get the "

673− ++ show (i, j)

674− ++ " element from a "

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

676− ++ " matrix."

677− )

678− (safeGet i j m)

679−

680−-- | Matrix pretty printer

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

682−prettyPrint = putStrLn . pretty

683−

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

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

686−zipWithM _ Empty Empty = Empty

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

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

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

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

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

692−

693−-- Relational operators functions

694−

695−type Boolean = Natural 0 1

696−type Relation a b = Matrix Boolean a b

697−

698−-- | Helper conversion function

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

700−toBool n

701− | n == 0 = False

702− | n == 1 = True

703−

704−-- | Helper conversion function

705−fromBool :: Bool -> Natural 0 1

706−fromBool True = nat 1

707−fromBool False = nat 0

708−

709−-- | Relational negation

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

711−negateM Empty = Empty

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

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

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

715−

716−-- | Relational addition

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

718−orM Empty Empty = Empty

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

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

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

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

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

724−

725−-- | Relational multiplication

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

727−andM Empty Empty = Empty

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

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

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

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

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

733−

734−-- | Relational subtraction

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

736−subM Empty Empty = Empty

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

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

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

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

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

742−

743−-- | Matrix relational composition.

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

745−compRel Empty Empty = Empty

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

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

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

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

750−

751−-- | Matrix relational right division

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

753−divR Empty Empty = Empty

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

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

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

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

758−

759−-- | Matrix relational left division

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

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

762−

763−-- | Matrix relational symmetric division

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

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

766− where

767− intersection = andM

768−

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

770−-- cardinality's.

771−fromFRelN ::

772− ( Eq b,

773− ConstructableNorm a b,

774− ConstructableN a b,

775− Enumerable a

776− )

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

778−fromFRelN = fromFN

779−

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

781−toRelN ::

782− ( ConstructableN a b,

783− ConstructableNorm a b,

784− Enumerable a

785− )

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

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

788−

789−----------------------------- Linear map semantics -----------------------------

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

791−

792−instance Contravariant (Vector e) where

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

794−

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

796− fromInteger = Vector . const . fromInteger

797−

798− (+) = liftV2 (+)

799− (-) = liftV2 (-)

800− (*) = liftV2 (*)

801− abs = liftV1 abs

802− negate = liftV1 negate

803− signum = error "No sensible definition"

804−

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

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

807−

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

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

810−

811−-- Semantics of Matrix e a b

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

813−

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

815−semantics m = case m of

816− Empty -> id

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

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

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

820−

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

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

823− Right b -> at v b

824−

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

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

827− Right _ -> 0

828−

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

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

831−

832−--------------------------------- Construction ---------------------------------

833−

834−class Construct a where

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

836−

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

838−

839−instance Construct () where

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

841−

842− linearMap m = col (m 1)

843−

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

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

846−

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

848−

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

850−col = tr . row

851−

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

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

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

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

856−

857−-- | Lifts functions to matrices.

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

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

860−

861−-------------------------------- Deconstruction --------------------------------

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

863−enumerate = [minBound .. maxBound]

864−

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

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

867−

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

869−toLists' m = transpose

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

871−

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

873−dump = mapM_ print . toLists'

874−

875−------------------------------- Normalised types -------------------------------

876−class Profunctor p where

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

878−

879−instance Profunctor (->) where

880− dimap f g h = g . h . f

881−

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

883−toNorm = toEnum . fromEnum

884−

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

886−fromNorm = toEnum . fromEnum

887−

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

889−rowN = row . contramap fromNorm

890−

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

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

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

894−

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

896−colN = tr . rowN

897−

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

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

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

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

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

903−

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

905−-- cardinality's.

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

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

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

909−

910−------------------------------- Unsafe fromLists matrix construction -------------------------------

911−

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

913−--

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

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

916−class FromLists e cols rows where

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

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

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

920−

921−instance FromLists e Void Void where

922− fromLists [] = Empty

923− fromLists _ = error "Wrong dimensions"

924−

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

926− fromLists [[e]] = One e

927− fromLists _ = error "Wrong dimensions"

928−

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

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

931− fromLists _ = error "Wrong dimensions"

932−

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

934− fromLists [l] =

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

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

937− fromLists _ = error "Wrong dimensions"

938−

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

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

941− fromLists _ = error "Wrong dimensions"

942−

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

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

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

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

947− fromLists _ = error "Wrong dimensions"

948−

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

950− fromLists l@(h : t) =

951− let lh = length h

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

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

954− in if lh > 0 && condition

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

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

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

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

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

3131--

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

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

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

3434--

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

3636--

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

4343 --

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

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

46− -- leads to a very straightforward implementation

47− -- of LAoP combinators.

46+ -- leads to a very straightforward implementation

47+ -- of LAoP combinators.

4848

4949 -- * Type safe matrix representation

5050 Matrix (..),

5151

5252 -- * Constraint type aliases

5353 Countable,

54− CountableDimensions,

54+ CountableDims,

5555 CountableN,

56− CountableDimensionsN,

57− FromListsN,

56+ CountableDimsN,

57+ FL,

58+ FLN,

5859 Liftable,

5960 Trivial,

6061

6162 -- * Primitives

62− empty,

6363 one,

6464 join,

6565 fork,

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

8686 -- * Misc

8787 -- ** Get dimensions

8888 columns,

89+ columns',

8990 rows,

91+ rows',

9092

9193 -- ** Matrix Transposition

9294 tr,

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

174176import Data.List

175177import Data.Maybe

176178import Data.Proxy

179+import Data.Typeable

177180import Data.Void

178181import GHC.TypeLits

179182import Data.Type.Equality

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

184187

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

186189data Matrix e cols rows where

187− Empty :: Matrix e Void Void

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

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

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

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

214216--

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

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

217− FromNat 0 = Void

218219 FromNat 1 = ()

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

220221

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

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

232233type Countable a = KnownNat (Count a)

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

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

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

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

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

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

237+type FL a b = FromLists a b

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

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

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

239241

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

241243-- class.

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

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

244− id = iden

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

246+ id = iden

245247 (.) = comp

246248

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

248− rnf Empty = ()

249250 rnf (One e) = rnf e

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

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

252253

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

254− Empty == Empty = True

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

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

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

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

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

260260

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

262−

263262 a + b = zipWithM (+) a b

264263

265264 a - b = zipWithM (-) a b

266265

267266 a * b = zipWithM (*) a b

268267

269− abs Empty = Empty

270268 abs (One a) = One (abs a)

271269 abs (Join a b) = Join (abs a) (abs b)

272270 abs (Fork a b) = Fork (abs a) (abs b)

273271

274− signum Empty = Empty

275272 signum (One a) = One (signum a)

276273 signum (Join a b) = Join (signum a) (signum b)

277274 signum (Fork a b) = Fork (signum a) (signum b)

278275

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

280− Empty <= Empty = True

281277 (One a) <= (One b) = a <= b

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

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

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

286282

287283-- Primitives

288284

289−-- | Empty matrix constructor

290−empty :: Matrix e Void Void

291−empty = Empty

292−

293285-- | Unit matrix constructor

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

295287one = One

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

320312--

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

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

323−class FromLists e cols rows where

315+class FromLists cols rows where

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

325317 -- error if the dimensions do not match.

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

327319

328−instance FromLists e Void Void where

329− fromLists [] = Empty

330− fromLists _ = error "Wrong dimensions"

331−

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

320+instance FromLists () () where

333321 fromLists [[e]] = One e

334322 fromLists _ = error "Wrong dimensions"

335323

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

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

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

338326 fromLists _ = error "Wrong dimensions"

339327

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

328+instance {-# OVERLAPPABLE #-}

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

341330 fromLists [l] =

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

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

344333 fromLists _ = error "Wrong dimensions"

345334

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

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

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

348337 fromLists _ = error "Wrong dimensions"

349338

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

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

339+instance {-# OVERLAPPABLE #-}

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

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

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

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

354344 fromLists _ = error "Wrong dimensions"

355345

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

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

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

357348 fromLists l@(h : t) =

358349 let lh = length h

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

@@ -366,8 +357,8 @@ instance {-# OVERLAPPABLE #-} (FromLists e (Either a b) c, FromLists e (Either a

366357-- a construction function that operates with indices.

367358matrixBuilder' ::

368359 forall e cols rows.

369− ( FromLists e cols rows,

370− CountableDimensions cols rows

360+ ( FL cols rows,

361+ CountableDims cols rows

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

372363matrixBuilder' f =

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

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

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

380371matrixBuilder ::

381372 forall e a b.

382− ( FromListsN e a b,

383− CountableN b,

373+ ( FLN a b,

384374 Enum a,

385375 Enum b,

386376 Bounded a,

387377 Bounded b,

388378 Eq a,

389− CountableDimensionsN a b

379+ Countable b

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

391381matrixBuilder f =

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

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

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

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

395385 where

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

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

398388

399389-- | Constructs a column vector matrix

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

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

401391col = fromLists . map (: [])

402392

403393-- | Constructs a row vector matrix

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

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

405395row = fromLists . (: [])

406396

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

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

411401fromF' ::

412402 forall a b cols rows e.

413403 ( Liftable e a b,

414− CountableDimensions cols rows,

415− FromLists e rows cols

404+ CountableDims cols rows,

405+ FL rows cols

416406 ) =>

417407 (a -> b) ->

418408 Matrix e cols rows

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

440430fromF ::

441431 forall a b e.

442432 ( Liftable e a b,

443− CountableDimensionsN a b,

444− FromListsN e b a

433+ CountableDimsN a b,

434+ FLN b a

445435 ) =>

446436 (a -> b) ->

447437 Matrix e (Normalize a) (Normalize b)

448−fromF f =

449− let minA = minBound @a

450− maxA = maxBound @a

451− minB = minBound @b

452− maxB = maxBound @b

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

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

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

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

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

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

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

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

461− mList = buildList combAp rrows

462− in tr $ fromLists mList

463− where

464− buildList [] _ = []

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

438+fromF = fromF'

466439

467440-- Conversion

468441

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

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

471−toLists Empty = []

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

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

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

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

480452-- Zeros Matrix

481453

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

483−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

484456zeros = matrixBuilder' (const 0)

485457

486458-- Ones Matrix

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

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

489461--

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

491−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

492464ones = matrixBuilder' (const 1)

493465

494466-- Const Matrix

495467

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

497469-- value.

498−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

499471constant e = matrixBuilder' (const e)

500472

501473-- Bang Matrix

502474

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

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

505477bang =

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

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

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

509481-- iden Matrix

510482

511483-- | iden matrix.

512−iden :: forall e cols . (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

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

514486{-# NOINLINE iden #-}

515487

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

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

521493-- from LAoP.

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

523−comp Empty Empty = Empty

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

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

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

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

528499{-# NOINLINE comp #-}

529−{-# RULES

500+{-# RULES

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

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

532503#-}

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

536507infixl 7 .|

537508-- | Scalar multiplication of matrices.

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

539−(.|) _ Empty = Empty

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

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

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

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

546516infixl 7 ./

547517-- | Scalar multiplication of matrices.

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

549−(./) Empty _ = Empty

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

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

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

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

554523-- Projections

555524

556525-- | Biproduct first component projection

557−p1 :: (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

558527p1 = join id zeros

559528

560529-- | Biproduct second component projection

561−p2 :: (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

562531p2 = join zeros id

563532

564533-- Injections

565534

566535-- | Biproduct first component injection

567−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)

568537i1 = tr p1

569538

570539-- | Biproduct second component injection

571−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)

572541i2 = tr p2

573542

574543-- Dimensions

575544

576545-- | Obtain the number of rows.

577546--

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

579−-- dimensions in constant time.

580−--

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

582−-- exchange for performance.

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

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

549+-- constraint see 'rows''.

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

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

585552

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+

586562-- | Obtain the number of columns.

587−--

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

589−-- dimensions in constant time.

590563--

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

592−-- exchange for performance.

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

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

566+-- constraint see 'columns''.

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

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

595569

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+

596579-- Coproduct Bifunctor

597580

598581infixl 5 -|-

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

601584(-|-) ::

602585 forall e n k m j.

603586 ( Num e,

604− CountableDimensions j k,

605− FromLists e k k,

606− FromLists e j k,

607− FromLists e k j,

608− FromLists e j j

587+ CountableDims j k,

588+ FL k k,

589+ FL j k,

590+ FL k j,

591+ FL j j

609592 ) =>

610593 Matrix e n k ->

611594 Matrix e m j ->

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

618601fstM ::

619602 forall e m k .

620603 ( Num e,

621− CountableDimensions k m,

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

604+ CountableDims k m,

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

623606 CountableN (m, k)

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

625608fstM = matrixBuilder' f

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

633616sndM ::

634617 forall e m k .

635618 ( Num e,

636− CountableDimensions k m,

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

619+ CountableDims k m,

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

638621 CountableN (m, k)

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

640623sndM = matrixBuilder' f

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

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

648631--

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

650−--

633+--

651634-- @

652635-- | fstM . kr a b == a

653636-- kr a b ==> |

@@ -658,10 +641,10 @@ sndM = matrixBuilder' f

658641kr ::

659642 forall e cols a b.

660643 ( Num e,

661− CountableDimensions a b,

644+ CountableDims a b,

662645 CountableN (a, b),

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

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

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

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

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

666649kr a b =

667650 let fstM' = fstM @e @a @b

@@ -676,14 +659,14 @@ infixl 4 ><

676659(><) ::

677660 forall e m p n q.

678661 ( Num e,

679− CountableDimensions m n,

680− CountableDimensions p q,

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

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

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

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

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

686− )

662+ CountableDims m n,

663+ CountableDims p q,

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

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

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

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

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

669+ )

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

688671(><) a b =

689672 let fstM' = fstM @e @m @n

@@ -701,7 +684,6 @@ infixl 4 ><

701684-- @

702685abideJF :: Matrix e cols rows -> Matrix e cols rows

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

704−abideJF Empty = Empty

705687abideJF (One e) = One e

706688abideJF (Join a b) = Join (abideJF a) (abideJF b)

707689abideJF (Fork a b) = Fork (abideJF a) (abideJF b)

@@ -715,7 +697,6 @@ abideJF (Fork a b) = Fork (abideJF a) (abideJF b)

715697-- @

716698abideFJ :: Matrix e cols rows -> Matrix e cols rows

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

718−abideFJ Empty = Empty

719700abideFJ (One e) = One e

720701abideFJ (Join a b) = Join (abideFJ a) (abideFJ b)

721702abideFJ (Fork a b) = Fork (abideFJ a) (abideFJ b)

@@ -724,7 +705,6 @@ abideFJ (Fork a b) = Fork (abideFJ a) (abideFJ b)

724705

725706-- | Matrix transposition.

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

727−tr Empty = Empty

728708tr (One e) = One e

729709tr (Join a b) = Fork (tr a) (tr b)

730710tr (Fork a b) = Join (tr a) (tr b)

@@ -733,32 +713,32 @@ tr (Fork a b) = Join (tr a) (tr b)

733713

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

735715-- ArrowMonad solution presented in the paper.

736−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

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

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

739719select m y = join y id . m

740720

741721branch ::

742722 ( Num e,

743− CountableDimensions a b,

744− CountableDimensions c (Either b c),

745− FromLists e c b,

746− FromLists e a b,

747− FromLists e a a,

748− FromLists e b b,

749− FromLists e c c,

750− FromLists e b a,

751− FromLists e b c,

752− FromLists e (Either b c) b,

753− FromLists e (Either b c) c

723+ CountableDims a b,

724+ CountableDims c (Either b c),

725+ FL c b,

726+ FL a b,

727+ FL a a,

728+ FL b b,

729+ FL c c,

730+ FL b a,

731+ FL b c,

732+ FL (Either b c) b,

733+ FL (Either b c) c

754734 )

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

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

757737 where

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

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

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

760740 f m = fork (tr i1) (i1 . tr i2) . m

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

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

762742 g m = i2 . m

763743

764744-- McCarthy's Conditional

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

767747cond ::

768748 ( Trivial cols,

769749 Countable cols,

770− FromLists e () cols,

771− FromLists e cols (),

772− FromLists e cols cols,

750+ FL () cols,

751+ FL cols (),

752+ FL cols cols,

773753 Bounded a,

774754 Enum a,

775755 Num e,

@@ -782,9 +762,9 @@ cond p f g = join f g . grd p

782762grd ::

783763 ( Trivial q,

784764 Countable q,

785− FromLists e () q,

786− FromLists e q (),

787− FromLists e q q,

765+ FL () q,

766+ FL q (),

767+ FL q q,

788768 Bounded a,

789769 Enum a,

790770 Num e,

@@ -798,9 +778,9 @@ corr ::

798778 forall e a q .

799779 ( Trivial q,

800780 Countable q,

801− FromLists e () q,

802− FromLists e q (),

803− FromLists e q q,

781+ FL () q,

782+ FL q (),

783+ FL q q,

804784 Liftable e a Bool

805785 )

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

@@ -829,7 +809,7 @@ prettyAux (h : t) l = "│ " ++ fill (unwords $ map show h) ++ " │\n" ++

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

830810

831811-- | Matrix pretty printer

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

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

833813pretty m = concat

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

835815 , unlines

@@ -858,12 +838,11 @@ pretty m = concat

858838 (safeGet i j m)

859839

860840-- | Matrix pretty printer

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

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

862842prettyPrint = putStrLn . pretty

863843

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

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

866−zipWithM _ Empty Empty = Empty

867846zipWithM f (One a) (One b) = One (f a b)

868847zipWithM f (Join a b) (Join c d) = Join (zipWithM f a c) (zipWithM f b d)

869848zipWithM f (Fork a b) (Fork c d) = Fork (zipWithM f a c) (zipWithM f b d)

@@ -888,14 +867,12 @@ fromBool False = nat 0

888867

889868-- | Relational negation

890869negateM :: Relation cols rows -> Relation cols rows

891−negateM Empty = Empty

892870negateM (One (Nat p)) = One (Nat (negate p))

893871negateM (Join a b) = Join (negateM a) (negateM b)

894872negateM (Fork a b) = Fork (negateM a) (negateM b)

895873

896874-- | Relational addition

897875orM :: Relation cols rows -> Relation cols rows -> Relation cols rows

898−orM Empty Empty = Empty

899876orM (One a) (One b) = One (fromBool (toBool a || toBool b))

900877orM (Join a b) (Join c d) = Join (orM a c) (orM b d)

901878orM (Fork a b) (Fork c d) = Fork (orM a c) (orM b d)

@@ -904,7 +881,6 @@ orM x@(Join _ _) y@(Fork _ _) = orM (abideJF x) y

904881

905882-- | Relational multiplication

906883andM :: Relation cols rows -> Relation cols rows -> Relation cols rows

907−andM Empty Empty = Empty

908884andM (One a) (One b) = One (fromBool (toBool a && toBool b))

909885andM (Join a b) (Join c d) = Join (andM a c) (andM b d)

910886andM (Fork a b) (Fork c d) = Fork (andM a c) (andM b d)

@@ -913,7 +889,6 @@ andM x@(Join _ _) y@(Fork _ _) = andM (abideJF x) y

913889

914890-- | Relational subtraction

915891subM :: Relation cols rows -> Relation cols rows -> Relation cols rows

916−subM Empty Empty = Empty

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

918893subM (Join a b) (Join c d) = Join (subM a c) (subM b d)

919894subM (Fork a b) (Fork c d) = Fork (subM a c) (subM b d)

@@ -922,7 +897,6 @@ subM x@(Join _ _) y@(Fork _ _) = subM (abideJF x) y

922897

923898-- | Matrix relational composition.

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

925−compRel Empty Empty = Empty

926900compRel (One a) (One b) = One (fromBool (toBool a && toBool b))

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

928902compRel (Fork a b) c = Fork (compRel a c) (compRel b c) -- Fork fusion law

@@ -930,7 +904,6 @@ compRel c (Join a b) = Join (compRel c a) (compRel c b) -- Join fusion

930904

931905-- | Matrix relational right division

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

933−divR Empty Empty = Empty

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

935908divR (Join a b) (Join c d) = andM (divR a c) (divR b d)

936909divR (Fork a b) c = Fork (divR a c) (divR b c)

@@ -953,58 +926,24 @@ divS s r = divL r s `intersection` divR (tr r) (tr s)

953926fromFRel' ::

954927 forall a b cols rows.

955928 ( Liftable Boolean a b,

956− CountableDimensions cols rows,

957− FromLists Boolean rows cols

929+ CountableDims cols rows,

930+ FL rows cols

958931 ) =>

959932 (a -> b) ->

960933 Relation cols rows

961−fromFRel' f =

962− let minA = minBound @a

963− maxA = maxBound @a

964− minB = minBound @b

965− maxB = maxBound @b

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

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

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

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

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

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

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

973− else ((fromEnum a, fromEnum b), nat 0)) $ combinations

974− mList = buildList combAp rrows

975− in tr $ fromLists mList

976− where

977− buildList [] _ = []

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

934+fromFRel' = fromF'

979935

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

981937-- cardinality's.

982938fromFRel ::

983939 forall a b.

984940 ( Liftable Boolean a b,

985− CountableDimensionsN a b,

986− FromLists Boolean (Normalize b) (Normalize a)

941+ CountableDimsN a b,

942+ FLN b a

987943 ) =>

988944 (a -> b) ->

989945 Relation (Normalize a) (Normalize b)

990−fromFRel f =

991− let minA = minBound @a

992− maxA = maxBound @a

993− minB = minBound @b

994− maxB = maxBound @b

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

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

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

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

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

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

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

1002− else ((fromEnum a, fromEnum b), nat 0)) $ combinations

1003− mList = buildList combAp rrows

1004− in tr $ fromLists mList

1005− where

1006− buildList [] _ = []

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

946+fromFRel = fromFRel'

1008947

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

1010949toRel ::

@@ -1014,17 +953,17 @@ toRel ::

1014953 Enum a,

1015954 Enum b,

1016955 Eq b,

1017− CountableDimensionsN a b,

1018− FromListsN Boolean b a

1019− )

956+ CountableDims a b,

957+ FLN b a

958+ )

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

1021960toRel f =

1022961 let minA = minBound @a

1023962 maxA = maxBound @a

1024963 minB = minBound @b

1025964 maxB = maxBound @b

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

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

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

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

1028967 elementsA = take ccols [minA .. maxA]

1029968 elementsB = take rrows [minB .. maxB]

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

src/LAoP/Matrix/Nat.hs+63−67

@@ -56,18 +56,17 @@ module LAoP.Matrix.Nat

5656

5757 -- * Constraint type synonyms

5858 Countable,

59− CountableDimensions,

59+ CountableDims,

6060 CountableN,

6161 CountableNz,

62− CountableDimensionsN,

63− FromListsN,

64− FromListsNz,

62+ CountableDimsN,

63+ FLN,

64+ FLNz,

6565 Liftable,

6666 TrivialE,

6767 TrivialP,

6868

6969 -- * Primitives

70− empty,

7170 one,

7271 join,

7372 fork,

@@ -78,7 +77,7 @@ module LAoP.Matrix.Nat

7877 I.Normalize,

7978

8079 -- * Matrix construction and conversion

81− I.FromLists,

80+ I.FL,

8281 fromLists,

8382 toLists,

8483 toList,

@@ -167,22 +166,19 @@ newtype Matrix e (cols :: Nat) (rows :: Nat) = M (I.Matrix e (I.FromNat cols) (I

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

168167

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

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

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

172−type CountableN a = KnownNat (I.Count (I.FromNat a))

173−type CountableNz a = KnownNat (I.Count (I.Normalize a))

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

175−type FromListsN e a b = I.FromLists e (I.FromNat a) (I.FromNat b)

176−type FromListsNz e a b = I.FromLists e (I.Normalize a) (I.Normalize b)

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

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

179−type TrivialP a b = I.FromNat (a * b) ~ I.FromNat (I.Count (I.FromNat a) * I.Count (I.FromNat b))

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

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

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

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

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

174+type FLN e a b = I.FL (I.FromNat a) (I.FromNat b)

175+type FLNz e a b = I.FL (I.Normalize a) (I.Normalize b)

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

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

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

180179

181180-- Primitives

182181

183−empty :: Matrix e 0 0

184−empty = M I.Empty

185−

186182one :: e -> Matrix e 1 1

187183one = M . I.One

188184

@@ -218,27 +214,27 @@ infixl 2 ===

218214

219215-- Construction

220216

221−fromLists :: (FromListsN e cols rows) => [[e]] -> Matrix e cols rows

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

222218fromLists = M . I.fromLists

223219

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

225221-- a construction function that operates with indices.

226222matrixBuilder' ::

227− (FromListsN e cols rows, CountableN cols, CountableN rows)

223+ (FLN e cols rows, CountableN cols, CountableN rows)

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

229225matrixBuilder' = M . I.matrixBuilder'

230226

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

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

232228col = M . I.col

233229

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

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

235231row = M . I.row

236232

237233fromF' ::

238234 ( Liftable e a b,

239235 CountableN cols,

240236 CountableN rows,

241− FromListsN e rows cols

237+ FLN e rows cols

242238 ) =>

243239 (a -> b) ->

244240 Matrix e cols rows

@@ -248,7 +244,7 @@ fromF ::

248244 ( Liftable e a b,

249245 CountableNz a,

250246 CountableNz b,

251− FromListsNz e b a

247+ FLNz e b a

252248 ) =>

253249 (a -> b) ->

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

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

265261-- Zeros Matrix

266262

267263zeros ::

268− (Num e, FromListsN e cols rows, CountableN cols, CountableN rows) =>

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

269265 Matrix e cols rows

270266zeros = M I.zeros

271267

272268-- Ones Matrix

273269

274270ones ::

275− (Num e, FromListsN e cols rows, CountableN cols, CountableN rows) =>

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

276272 Matrix e cols rows

277273ones = M I.ones

278274

279275-- Const Matrix

280276

281277constant ::

282− (Num e, FromListsN e cols rows, CountableN cols, CountableN rows) =>

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

283279 e ->

284280 Matrix e cols rows

285281constant = M . I.constant

@@ -288,14 +284,14 @@ constant = M . I.constant

288284

289285bang ::

290286 forall e cols.

291− (Num e, Enum e, I.FromLists e (I.FromNat cols) (), CountableN cols) =>

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

292288 Matrix e cols 1

293289bang = M I.bang

294290

295291-- iden Matrix

296292

297293iden ::

298− (Num e, FromListsN e cols cols, CountableN cols) =>

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

299295 Matrix e cols cols

300296iden = M I.iden

301297

@@ -320,9 +316,9 @@ infixl 7 ./

320316

321317p1 ::

322318 ( Num e,

323− CountableDimensionsN n m,

324− FromListsN e n m,

325− FromListsN e m m,

319+ CountableDimsN n m,

320+ FLN e n m,

321+ FLN e m m,

326322 TrivialE m n

327323 ) =>

328324 Matrix e (m + n) m

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

330326

331327p2 ::

332328 ( Num e,

333− CountableDimensionsN n m,

334− FromListsN e m n,

335− FromListsN e n n,

329+ CountableDimsN n m,

330+ FLN e m n,

331+ FLN e n n,

336332 TrivialE m n

337333 ) =>

338334 Matrix e (m + n) n

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

342338

343339i1 ::

344340 ( Num e,

345− CountableDimensionsN n rows,

346− FromListsN e n rows,

347− FromListsN e rows rows,

341+ CountableDimsN n rows,

342+ FLN e n rows,

343+ FLN e rows rows,

348344 TrivialE rows n

349345 ) =>

350346 Matrix e rows (rows + n)

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

352348

353349i2 ::

354350 ( Num e,

355− CountableDimensionsN rows m,

356− FromListsN e m rows,

357− FromListsN e rows rows,

351+ CountableDimsN rows m,

352+ FLN e m rows,

353+ FLN e rows rows,

358354 TrivialE m rows

359355 ) =>

360356 Matrix e rows (m + rows)

@@ -373,11 +369,11 @@ infixl 5 -|-

373369-- | Coproduct Bifunctor (Direct sum)

374370(-|-) ::

375371 ( Num e,

376− CountableDimensionsN j k,

377− FromListsN e k k,

378− FromListsN e j k,

379− FromListsN e k j,

380− FromListsN e j j,

372+ CountableDimsN j k,

373+ FLN e k k,

374+ FLN e j k,

375+ FLN e k j,

376+ FLN e j j,

381377 TrivialE n m,

382378 TrivialE k j

383379 ) =>

@@ -390,9 +386,9 @@ infixl 5 -|-

390386fstM ::

391387 forall e m k .

392388 ( Num e,

393− CountableDimensionsN m k,

389+ CountableDimsN m k,

394390 CountableN (m * k),

395− FromListsN e (m * k) m,

391+ FLN e (m * k) m,

396392 TrivialP m k

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

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

@@ -401,8 +397,8 @@ fstM = M (I.fstM @e @(I.FromNat m) @(I.FromNat k))

401397sndM ::

402398 forall e m k.

403399 ( Num e,

404− CountableDimensionsN k m,

405− FromListsN e (m * k) k,

400+ CountableDimsN k m,

401+ FLN e (m * k) k,

406402 CountableN (m * k),

407403 TrivialP m k

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

@@ -412,10 +408,10 @@ sndM = M (I.sndM @e @(I.FromNat m) @(I.FromNat k))

412408kr ::

413409 forall e cols a b.

414410 ( Num e,

415− CountableDimensionsN a b,

411+ CountableDimsN a b,

416412 CountableN (a * b),

417− FromListsN e (a * b) a,

418− FromListsN e (a * b) b,

413+ FLN e (a * b) a,

414+ FLN e (a * b) b,

419415 TrivialP a b

420416 ) => Matrix e cols a -> Matrix e cols b -> Matrix e cols (a * b)

421417kr a b =

@@ -429,13 +425,13 @@ infixl 4 ><

429425(><) ::

430426 forall e m p n q.

431427 ( Num e,

432− CountableDimensionsN m n,

433− CountableDimensionsN p q,

434− CountableDimensionsN (m * n) (p * q),

435− FromListsN e (m * n) m,

436− FromListsN e (m * n) n,

437− FromListsN e (p * q) p,

438− FromListsN e (p * q) q,

428+ CountableDimsN m n,

429+ CountableDimsN p q,

430+ CountableDimsN (m * n) (p * q),

431+ FLN e (m * n) m,

432+ FLN e (m * n) n,

433+ FLN e (p * q) p,

434+ FLN e (p * q) q,

439435 TrivialP m n,

440436 TrivialP p q

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

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

459455-- Selective 'select' operator

460456select ::

461457 ( Num e,

462− FromListsN e rows1 rows1,

458+ FLN e rows1 rows1,

463459 CountableN rows1,

464460 I.FromNat rows2 ~ I.FromNat rows1,

465461 I.FromNat cols1 ~ I.FromNat cols2,

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

472468cond ::

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

474470 CountableN cols,

475− I.FromLists e () (I.FromNat cols),

476− I.FromLists e (I.FromNat cols) (),

477− FromListsN e cols cols,

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

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

473+ FLN e cols cols,

478474 Liftable e a Bool

479475 )

480476 =>

@@ -483,10 +479,10 @@ cond p (M a) (M b) = M (I.cond p a b)

483479

484480-- Pretty print

485481

486−pretty :: (CountableDimensionsN cols rows, Show e) => Matrix e cols rows -> String

482+pretty :: (CountableDimsN cols rows, Show e) => Matrix e cols rows -> String

487483pretty (M m) = I.pretty m

488484

489−prettyPrint :: (CountableDimensionsN cols rows, Show e) => Matrix e cols rows -> IO ()

485+prettyPrint :: (CountableDimsN cols rows, Show e) => Matrix e cols rows -> IO ()

490486prettyPrint (M m) = I.prettyPrint m

491487

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

src/LAoP/Matrix/Type.hs+246−236

@@ -58,31 +58,19 @@ module LAoP.Matrix.Type

5858

5959 -- * Constraint type aliases

6060 Countable,

61− CountableDimensions,

61+ CountableDims,

6262 CountableN,

63− CountableDimensionsN,

64− FromListsN,

63+ CountableDimsN,

64+ FLN,

6565 Liftable,

6666 Trivial,

67− Trivial2,

6867 TrivialP,

69− EqN,

70− EnumN,

71− Enumerable,

72− EnumerableN,

73− ConstructNorm,

74− ConstructN,

75− ConstructableN,

76− FstM,

77− SndM,

78− Kronecker,

7968

8069 -- * Type aliases

8170 Zero,

8271 One,

8372

8473 -- * Primitives

85− empty,

8674 one,

8775 join,

8876 fork,

@@ -97,10 +85,9 @@ module LAoP.Matrix.Type

9785 fromLists,

9886 toLists,

9987 toList,

88+ matrixBuilder',

10089 matrixBuilder,

101− rowL,

10290 row,

103− colL,

10491 col,

10592 zeros,

10693 ones,

@@ -117,8 +104,8 @@ module LAoP.Matrix.Type

117104 multM,

118105

119106 -- * Selective equivalent instance function

120− selectM,

121−

107+ selectM,

108+

122109 -- * Monad equivalent instance function

123110 returnM,

124111 bindM,

@@ -126,7 +113,9 @@ module LAoP.Matrix.Type

126113 -- * Misc

127114 -- ** Get dimensions

128115 columns,

116+ columns',

129117 rows,

118+ rows',

130119

131120 -- ** Matrix Transposition

132121 tr,

@@ -136,7 +125,7 @@ module LAoP.Matrix.Type

136125 (./),

137126

138127 -- ** McCarthy's Conditional

139− -- cond,

128+ cond,

140129

141130 -- ** Matrix "abiding"

142131 abideJF,

@@ -179,6 +168,7 @@ module LAoP.Matrix.Type

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

180169 iden,

181170 comp,

171+ fromF',

182172 fromF,

183173

184174 -- * Relation

@@ -191,46 +181,44 @@ module LAoP.Matrix.Type

191181where

192182

193183import Data.Void

184+import Data.Proxy

194185import Data.Kind

195186import GHC.TypeLits

196187import Control.DeepSeq

197188import LAoP.Utils

198−import qualified LAoP.Matrix.Alternative as I

189+import qualified LAoP.Matrix.Internal as I

199190import Prelude hiding (id, (.))

200191

201192newtype Matrix e (cols :: Type) (rows :: Type) = M (I.Matrix e (I.Normalize cols) (I.Normalize rows))

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

203194

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

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

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

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

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

209−type FromListsN e a b = I.FromLists e (I.Normalize a) (I.Normalize b)

210−type Liftable a b = (Eq b, Enumerable a, Enum a, EnumN a, Enum b, EnumN b, ConstructableN a b)

211−type Trivial a = I.Normalize (I.Normalize a) ~ I.Normalize (I.Normalize (I.Normalize a))

212−type Trivial2 a = I.Normalize a ~ I.Normalize (I.Normalize a)

213−type TrivialP a b = I.Normalize (a, b) ~ I.Normalize (I.Normalize a, I.Normalize b)

214−type EqN a = Eq (I.Normalize a)

215−type EnumN a = Enum (I.Normalize a)

216−type Enumerable a = (Enum a, Bounded a)

217−type EnumerableN a = (Enum (I.Normalize a), Bounded (I.Normalize a))

218−type ConstructNorm a = (Enum a, Enum (I.Normalize a))

219−type ConstructN a = I.Construct (I.Normalize a)

220−type ConstructableN a b = (I.Construct (I.Normalize a), I.Construct (I.Normalize b))

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

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

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

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

200+type FLN a b = I.FromLists (I.Normalize a) (I.Normalize b)

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

202+type Trivial a = I.Normalize (I.Normalize a) ~ I.Normalize (I.Normalize (I.Normalize a))

203+type Trivial2 a = I.Normalize a ~ I.Normalize (I.Normalize a)

204+type Trivial3 a = I.FromNat (I.Count (I.Normalize (I.Normalize a))) ~ I.Normalize (I.Normalize a)

205+type TrivialP a b = I.Normalize (a, b) ~ I.Normalize (I.Normalize a, I.Normalize b)

221206

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

223208-- class.

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

225− type Object (Matrix e) a = (Num e, EqN a, ConstructN a, EnumerableN a)

210+ type Object (Matrix e) a = (FLN a a, CountableN a)

226211 id = iden

227212 (.) = comp

228213

229214-- | Bifunctor equivalent function

230215bimapM ::

231− ( Num e,

232− Liftable a b,

233− Liftable c d

216+ ( Liftable e a b,

217+ Liftable e c d,

218+ CountableDimsN a c,

219+ CountableDimsN b d,

220+ FLN d c,

221+ FLN b a

234222 ) => (a -> b) -> (c -> d) -> Matrix e a c -> Matrix e b d

235223bimapM f g m = fromF g . m . tr (fromF f)

236224

@@ -242,10 +230,6 @@ type One = ()

242230

243231-- Primitives

244232

245−-- | Empty matrix constructor

246−empty :: Matrix e Zero Zero

247−empty = M I.Empty

248−

249233-- | Unit matrix constructor

250234one :: e -> Matrix e One One

251235one = M . I.One

@@ -283,70 +267,113 @@ infixl 2 ===

283267-- Functor hierarchy

284268

285269-- | Functor instance equivalent function

286−fmapM :: (Num e, Liftable a b) => (a -> b) -> Matrix e c a -> Matrix e c b

270+fmapM ::

271+ ( Liftable e a b,

272+ CountableDimsN a b,

273+ FLN b a

274+ )

275+ =>

276+ (a -> b) -> Matrix e c a -> Matrix e c b

287277fmapM f m = fromF f . m

288278

289279-- | Applicative instance equivalent 'unit' function,

290−unitM :: Num e => Matrix e () ()

280+unitM :: (Num e) => Matrix e () ()

291281unitM = one 1

292282

293283-- | Applicative instance equivalent 'unit' function,

294−multM :: (Num e, FstM a b, SndM a b) => Matrix e c a -> Matrix e c b -> Matrix e c (a, b)

284+multM ::

285+ ( CountableDimsN a b,

286+ CountableN (a, b),

287+ Num e,

288+ FLN (a, b) a,

289+ FLN (a, b) b,

290+ TrivialP a b

291+ ) => Matrix e c a -> Matrix e c b -> Matrix e c (a, b)

295292multM = kr

296293

297294-- | Monad instance equivalent 'return' function,

298−returnM :: (Num e, Liftable () a) => a -> Matrix e One a

299−returnM = point

295+returnM ::

296+ forall e a .

297+ ( Num e,

298+ Enum e,

299+ Enum a,

300+ FLN () a,

301+ Countable a

302+ ) => a -> Matrix e One a

303+returnM a = col l

304+ where

305+ i = fromInteger $ natVal (Proxy :: Proxy (I.Count a))

306+ x = fromEnum a

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

300308

301309-- | Monad instance equivalent '(>>=)' function,

302−bindM :: Num e => Matrix e a b -> Matrix e b c -> Matrix e a c

310+bindM :: (Num e) => Matrix e a b -> Matrix e b c -> Matrix e a c

303311bindM = flip comp

304312

305313-- Construction

306314

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

308316-- error if the dimensions do not match.

309−fromLists :: FromListsN e cols rows => [[e]] -> Matrix e cols rows

317+fromLists :: (FLN cols rows) => [[e]] -> Matrix e cols rows

310318fromLists = M . I.fromLists

311319

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

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

322+matrixBuilder' ::

323+ (FLN cols rows, CountableDimsN cols rows )

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

325+matrixBuilder' = M . I.matrixBuilder'

326+

312327-- | Matrix builder function. Constructs a matrix provided with

313328-- a construction function that operates with arbitrary types.

314329matrixBuilder ::

315− ( Num e,

316− Enumerable a,

317− Enum b,

318− EnumN a,

319− EnumN b,

320− ConstructableN a b

321− )

322− => ((a, b) -> e) -> Matrix e a b

323−matrixBuilder = M . I.matrixBuilderN

324−

325−-- | Constructs a column vector matrix

326−colL :: FromListsN e () rows => [e] -> Matrix e One rows

327−colL = M . I.colL

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)

328339

329340-- | Constructs a column vector matrix

330−col :: (Num e, Enum a, EnumN a, ConstructN a) => (a -> e) -> Matrix e One a

331−col = M . I.colN . I.Vector

341+col :: (FLN () rows) => [e] -> Matrix e One rows

342+col = M . I.col

332343

333344-- | Constructs a row vector matrix

334−rowL :: FromListsN e cols () => [e] -> Matrix e cols One

335−rowL = M . I.rowL

345+row :: (FLN cols ()) => [e] -> Matrix e cols One

346+row = M . I.row

336347

337−-- | Constructs a row vector matrix

338−row :: (Num e, Enum a, EnumN a, ConstructN a) => (a -> e) -> Matrix e a One

339−row = M . I.rowN . I.Vector

348+-- | Lifts functions to matrices with arbitrary dimensions.

349+--

350+-- NOTE: Be careful to not ask for a matrix bigger than the cardinality of

351+-- types @a@ or @b@ allows.

352+fromF' ::

353+ ( Liftable e a b,

354+ CountableDimsN cols rows,

355+ FLN rows cols

356+ ) =>

357+ (a -> b) -> Matrix e cols rows

358+fromF' = M . I.fromF'

340359

341360-- | Lifts functions to matrices with dimensions matching @a@ and @b@

342361-- cardinality's.

343−fromF :: (Num e, Liftable a b)

344− => (a -> b) -> Matrix e a b

345−fromF = M . I.fromFN

362+fromF ::

363+ ( Liftable e a b,

364+ CountableDimsN a b,

365+ FLN b a

366+ ) =>

367+ (a -> b) -> Matrix e a b

368+fromF = M . I.fromF

346369

347370-- | Lifts relation functions to Boolean Matrix

348−toRel :: Liftable a b => (a -> b -> Bool) -> Matrix (Natural 0 1) a b

349−toRel = M . I.toRelN

371+toRel ::

372+ ( Liftable (Natural 0 1) a b,

373+ CountableDims a b,

374+ FLN b a

375+ ) => (a -> b -> Bool) -> Matrix (Natural 0 1) a b

376+toRel = M . I.toRel

350377

351378-- Conversion

352379

@@ -362,11 +389,8 @@ toList (M m) = I.toList m

362389

363390-- | The zero matrix. A matrix wholly filled with zeros.

364391zeros ::

365− ( Num e,

366− ConstructableN cols rows,

367− EnumerableN cols

368− )

369− => Matrix e cols rows

392+ (Num e, FLN cols rows, CountableDimsN cols rows)

393+ => Matrix e cols rows

370394zeros = M I.zeros

371395

372396-- Ones Matrix

@@ -375,11 +399,8 @@ zeros = M I.zeros

375399--

376400-- Also known as T (Top) matrix.

377401ones ::

378− ( Num e,

379− ConstructableN cols rows,

380− EnumerableN cols

381− )

382− => Matrix e cols rows

402+ (Num e, FLN cols rows, CountableDimsN cols rows)

403+ => Matrix e cols rows

383404ones = M I.ones

384405

385406-- Const Matrix

@@ -387,38 +408,37 @@ ones = M I.ones

387408-- | The constant matrix constructor. A matrix wholly filled with a given

388409-- value.

389410constant ::

390− ( Num e,

391− ConstructableN cols rows,

392− EnumerableN cols

393− )

394− => e -> Matrix e cols rows

411+ (Num e, FLN cols rows, CountableDimsN cols rows)

412+ => e -> Matrix e cols rows

395413constant = M . I.constant

396414

397415-- Bang Matrix

398416

399417-- | The T (Top) row vector matrix.

400418bang ::

401− ( Num e,

402− ConstructN cols,

403− EnumerableN cols

404− )

405− => Matrix e cols One

406−bang = ones

407−

408−-- | Point constant matrix

409−point :: (Num e, Liftable () a) => a -> Matrix e One a

419+ forall e cols.

420+ (Num e, Enum e, FLN cols (), CountableN cols) =>

421+ Matrix e cols One

422+bang = M I.bang

423+

424+-- | Point constant relation

425+point ::

426+ ( Bounded a,

427+ Enum a,

428+ Eq a,

429+ Num e,

430+ Ord e,

431+ CountableN a,

432+ FLN a One

433+ ) => a -> Matrix e One a

410434point = fromF . const

411435

412436-- iden Matrix

413437

414438-- | iden matrix

415439iden ::

416− ( Num e,

417− EqN a,

418− ConstructN a,

419− EnumerableN a

420− )

421− => Matrix e a a

440+ (Num e, FLN a a, CountableN a) =>

441+ Matrix e a a

422442iden = M I.iden

423443{-# NOINLINE iden #-}

424444

@@ -428,10 +448,10 @@ iden = M I.iden

428448--

429449-- This definition takes advantage of divide-and-conquer and fusion laws

430450-- from LAoP.

431−comp :: Num e => Matrix e cr rows -> Matrix e cols cr -> Matrix e cols rows

451+comp :: (Num e) => Matrix e cr rows -> Matrix e cols cr -> Matrix e cols rows

432452comp (M a) (M b) = M (I.comp a b)

433453{-# NOINLINE comp #-}

434−{-# RULES

454+{-# RULES

435455 "comp/iden1" forall m. comp m iden = m ;

436456 "comp/iden2" forall m. comp iden m = m

437457#-}

@@ -452,144 +472,140 @@ infixl 7 ./

452472

453473-- | Biproduct first component projection

454474p1 ::

455− ( Num e,

456− EqN m,

457− ConstructableN m n,

458− EnumerableN m,

459− EnumerableN n

460− )

461− => Matrix e (Either m n) m

475+ ( Num e,

476+ CountableDimsN n m,

477+ FLN n m,

478+ FLN m m

479+ ) =>

480+ Matrix e (Either m n) m

462481p1 = M I.p1

463482

464483-- | Biproduct second component projection

465484p2 ::

466− ( Num e,

467− EqN n,

468− ConstructableN m n,

469− EnumerableN m,

470− EnumerableN n

471− )

472− => Matrix e (Either m n) n

485+ ( Num e,

486+ CountableDimsN n m,

487+ FLN m n,

488+ FLN n n

489+ ) =>

490+ Matrix e (Either m n) n

473491p2 = M I.p2

474492

475493-- Injections

476494

477495-- | Biproduct first component injection

478496i1 ::

479− ( Num e,

480− EqN m,

481− ConstructableN m n,

482− EnumerableN m,

483− EnumerableN n

484− )

485− => Matrix e m (Either m n)

497+ ( Num e,

498+ CountableDimsN n m,

499+ FLN n m,

500+ FLN m m

501+ ) =>

502+ Matrix e m (Either m n)

486503i1 = tr p1

487504

488505-- | Biproduct second component injection

489506i2 ::

490− ( Num e,

491− EqN n,

492− ConstructableN m n,

493− EnumerableN m,

494− EnumerableN n

495− )

496− => Matrix e n (Either m n)

507+ ( Num e,

508+ CountableDimsN n m,

509+ FLN m n,

510+ FLN n n

511+ ) =>

512+ Matrix e n (Either m n)

497513i2 = tr p2

498514

499515-- Dimensions

500516

501517-- | Obtain the number of rows.

502518--

503−-- NOTE: The 'KnownNat' constaint is needed in order to obtain the

504−-- dimensions in constant time.

505−--

506−-- TODO: A 'rows' function that does not need the 'KnownNat' constraint in

507−-- exchange for performance.

508−rows :: CountableN rows => Matrix e cols rows -> Int

519+-- NOTE: The 'KnownNat' constraint is needed in order to obtain the

520+-- dimensions in constant time. For a version that doesn't require the

521+-- constraint see 'rows''.

522+rows :: (CountableN rows) => Matrix e cols rows -> Int

509523rows (M m) = I.rows m

510524

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+

511532-- | Obtain the number of columns.

512−--

513−-- NOTE: The 'KnownNat' constaint is needed in order to obtain the

514−-- dimensions in constant time.

515533--

516−-- TODO: A 'columns' function that does not need the 'KnownNat' constraint in

517−-- exchange for performance.

518−columns :: CountableN cols => Matrix e cols rows -> Int

534+-- NOTE: The 'KnownNat' constraint is needed in order to obtain the

535+-- dimensions in constant time. For a version that doesn't require the

536+-- constraint see 'columns''.

537+columns :: (CountableN cols) => Matrix e cols rows -> Int

519538columns (M m) = I.columns m

520539

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+

521547-- Coproduct Bifunctor

522548

523549infixl 5 -|-

524550

525551-- | Matrix coproduct functor also known as matrix direct sum.

526552(-|-) ::

527− ( Num e,

528− EqN k,

529− EqN j,

530− ConstructableN k j,

531− EnumerableN k,

532− EnumerableN j

533− ) => Matrix e n k -> Matrix e m j -> Matrix e (Either n m) (Either k j)

553+ ( Num e,

554+ CountableDimsN j k,

555+ FLN k k,

556+ FLN j k,

557+ FLN k j,

558+ FLN j j

559+ ) =>

560+ Matrix e n k ->

561+ Matrix e m j ->

562+ Matrix e (Either n m) (Either k j)

534563(-|-) (M a) (M b) = M ((I.-|-) a b)

535564

536565-- Khatri Rao Product and projections

537566

538−type FstM a b =

539− ( EqN a,

540− ConstructableN (I.Normalize a) (I.Normalize (a, b)),

541− ConstructN (I.Normalize a, I.Normalize b),

542− EnumerableN a,

543− EnumerableN b,

544− EnumN (I.Normalize a, I.Normalize b),

545− Trivial2 a,

546− TrivialP a b

547− )

548−

549567-- | Khatri Rao product first component projection matrix.

550568fstM ::

551− forall e a b .

552− ( Num e,

553− FstM a b

554− ) => Matrix e (a, b) a

555−fstM = M (I.fstM @e @(I.Normalize a) @(I.Normalize b))

556−

557−type SndM a b =

558− ( EqN b,

559− ConstructableN (I.Normalize b) (I.Normalize (a, b)),

560− ConstructN (I.Normalize a, I.Normalize b),

561− EnumerableN a,

562− EnumerableN b,

563− EnumN (I.Normalize a, I.Normalize b),

564− Trivial2 b,

565− TrivialP a b

566− )

569+ forall e m k .

570+ ( Num e,

571+ CountableDimsN m k,

572+ CountableN (m, k),

573+ FLN (m, k) m,

574+ TrivialP m k

575+ ) => Matrix e (m, k) m

576+fstM = M (I.fstM @e @(I.Normalize m) @(I.Normalize k))

577+

567578-- | Khatri Rao product second component projection matrix.

568579sndM ::

569− forall e a b.

570− ( Num e,

571− SndM a b

572− ) => Matrix e (a, b) b

573−sndM = M (I.sndM @e @(I.Normalize a) @(I.Normalize b))

580+ forall e m k.

581+ ( Num e,

582+ CountableDimsN k m,

583+ CountableN (m, k),

584+ FLN (m, k) k,

585+ TrivialP m k

586+ ) => Matrix e (m, k) k

587+sndM = M (I.sndM @e @(I.Normalize m) @(I.Normalize k))

574588

575589-- | Khatri Rao Matrix product also known as matrix pairing.

576590--

577591-- NOTE: That this is not a true categorical product, see for instance:

578−--

592+--

579593-- @

580−-- | fstM . kr a b == a

594+-- | fstM . kr a b == a

581595-- kr a b ==> |

582596-- | sndM . kr a b == b

583597-- @

584598--

585599-- __Emphasis__ on the implication symbol.

586600kr ::

587− forall e cols a b.

588− ( Num e,

589− FstM a b,

590− SndM a b

591− )

592− => Matrix e cols a -> Matrix e cols b -> Matrix e cols (a, b)

601+ forall e cols a b.

602+ ( Num e,

603+ CountableDimsN a b,

604+ CountableN (a, b),

605+ FLN (a, b) a,

606+ FLN (a, b) b,

607+ TrivialP a b

608+ ) => Matrix e cols a -> Matrix e cols b -> Matrix e cols (a, b)

593609kr a b =

594610 let fstM' = fstM @e @a @b

595611 sndM' = sndM @e @a @b

@@ -598,38 +614,21 @@ kr a b =

598614-- Product Bifunctor (Kronecker)

599615

600616infixl 4 ><

601−type Kronecker m n p q =

602− ( EqN (I.Normalize m),

603− EqN (I.Normalize n),

604− EqN (I.Normalize p),

605− EqN (I.Normalize q),

606− ConstructableN (I.Normalize m) (I.Normalize n),

607− ConstructableN (I.Normalize p) (I.Normalize q),

608− ConstructableN (I.Normalize m, I.Normalize n) (I.Normalize p, I.Normalize q),

609− ConstructableN (I.Normalize (I.Normalize m, I.Normalize n)) (I.Normalize (I.Normalize p, I.Normalize q)),

610− FstM m n,

611− SndM m n,

612− EnumerableN (I.Normalize m),

613− EnumerableN (I.Normalize n),

614− EnumerableN (I.Normalize p),

615− EnumerableN (I.Normalize q),

616− EnumerableN (I.Normalize m, I.Normalize n),

617− EnumerableN (I.Normalize p, I.Normalize q),

618− Trivial2 m,

619− Trivial2 n,

620− Trivial2 p,

621− Trivial2 q,

622− TrivialP p q,

623− TrivialP m m

624− )

625617

626618-- | Matrix product functor also known as Kronecker product

627619(><) ::

628− forall e m p n q.

629− ( Num e,

630− Kronecker m n p q

631− )

632− => Matrix e m p -> Matrix e n q -> Matrix e (m, n) (p, q)

620+ forall e m p n q.

621+ ( Num e,

622+ CountableDimsN m n,

623+ CountableDimsN p q,

624+ CountableDimsN (m, n) (p, q),

625+ FLN (m, n) m,

626+ FLN (m, n) n,

627+ FLN (p, q) p,

628+ FLN (p, q) q,

629+ TrivialP m n,

630+ TrivialP p q

631+ ) => Matrix e m p -> Matrix e n q -> Matrix e (m, n) (p, q)

633632(><) a b =

634633 let fstM' = fstM @e @m @n

635634 sndM' = sndM @e @m @n

@@ -638,7 +637,7 @@ type Kronecker m n p q =

638637-- Matrix abide Join Fork

639638

640639-- | Matrix "abiding" followin the 'Join'-'Fork' abide law.

641−--

640+--

642641-- Law:

643642--

644643-- @

@@ -650,7 +649,7 @@ abideJF (M m) = M (I.abideJF m)

650649-- Matrix abide Fork Join

651650

652651-- | Matrix "abiding" followin the 'Fork'-'Join' abide law.

653−--

652+--

654653-- Law:

655654--

656655-- @

@@ -669,27 +668,38 @@ tr (M m) = M (I.tr m)

669668

670669-- | Selective functors 'select' operator equivalent inspired by the

671670-- ArrowMonad solution presented in the paper.

672−selectM :: (Num e, EqN b, ConstructN b, EnumerableN b) => Matrix e cols (Either a b) -> Matrix e a b -> Matrix e cols b

671+selectM ::

672+ ( Num e,

673+ FLN b b,

674+ CountableN b

675+ ) => Matrix e cols (Either a b) -> Matrix e a b -> Matrix e cols b

673676selectM (M m) (M y) = M (I.select m y)

674677

675678-- McCarthy's Conditional

676679

677680-- | McCarthy's Conditional expresses probabilistic choice.

678−-- cond ::

679−-- (

680−-- )

681−-- =>

682−-- (a -> Bool) -> Matrix e a b -> Matrix e a b -> Matrix e a b

683−-- cond p (M a) (M b) =

681+cond ::

682+ ( Trivial a,

683+ Trivial2 a,

684+ Trivial3 a,

685+ CountableN a,

686+ FLN () a,

687+ FLN a (),

688+ FLN a a,

689+ Liftable e a Bool

690+ )

691+ =>

692+ (a -> Bool) -> Matrix e a b -> Matrix e a b -> Matrix e a b

693+cond p (M a) (M b) = M (I.cond p a b)

684694

685695-- Pretty print

686696

687697-- | Matrix pretty printer

688−pretty :: (Show e, CountableDimensionsN cols rows) => Matrix e cols rows -> String

698+pretty :: (CountableDimsN cols rows, Show e) => Matrix e cols rows -> String

689699pretty (M m) = I.pretty m

690700

691701-- | Matrix pretty printer

692−prettyPrint :: (CountableDimensionsN cols rows, Show e) => Matrix e cols rows -> IO ()

702+prettyPrint :: (CountableDimsN cols rows, Show e) => Matrix e cols rows -> IO ()

693703prettyPrint (M m) = I.prettyPrint m

694704

695705-- | Zip two matrices with a given binary function

src/LAoP/Relation.hs+3−4

@@ -32,16 +32,15 @@ module LAoP.Relation

3232

3333 -- * Constraint type synonyms

3434 Countable,

35− CountableDimensions,

35+ CountableDims,

3636 CountableN,

37− CountableDimensionsN,

38− FromListsN,

37+ CountableDimsN,

38+ FLN,

3939 Liftable,

4040 Trivial,

4141 TrivialP,

4242

4343 -- * Primitives

44− empty,

4544 one,

4645 join,

4746 (|||),

src/LAoP/Relation/Internal.hs+128−130

@@ -43,16 +43,15 @@ module LAoP.Relation.Internal

4343

4444 -- * Constraint type synonyms

4545 Countable,

46− CountableDimensions,

46+ CountableDims,

4747 CountableN,

48− CountableDimensionsN,

49− FromListsN,

48+ CountableDimsN,

49+ FLN,

5050 Liftable,

5151 Trivial,

5252 TrivialP,

5353

5454 -- * Primitives

55− empty,

5655 one,

5756 join,

5857 (|||),

@@ -194,19 +193,19 @@ newtype Relation a b = R (I.Matrix Boolean (I.Normalize a) (I.Normalize b))

194193deriving instance (Read (I.Matrix Boolean (I.Normalize a) (I.Normalize b))) => Read (Relation a b)

195194

196195-- | Constraint type synonyms to keep the type signatures less convoluted

197−type Countable a = KnownNat (I.Count a)

198−type CountableDimensions a b = (Countable a, Countable b)

199−type CountableN a = KnownNat (I.Count (I.Normalize a))

200−type CountableDimensionsN a b = (CountableN a, CountableN b)

201−type FromListsN a b = I.FromLists Boolean (I.Normalize a) (I.Normalize b)

202−type Liftable a b = (Bounded a, Bounded b, Enum a, Enum b, Eq b, Num Boolean, Ord Boolean)

203−type Trivial a = I.Normalize a ~ I.Normalize (I.Normalize a)

204−type TrivialP a b = I.Normalize (a, b) ~ I.Normalize (I.Normalize a, I.Normalize b)

196+type Countable a = KnownNat (I.Count a)

197+type CountableDims a b = (Countable a, Countable b)

198+type CountableN a = KnownNat (I.Count (I.Normalize a))

199+type CountableDimsN a b = (CountableN a, CountableN b)

200+type FLN a b = I.FromLists (I.Normalize a) (I.Normalize b)

201+type Liftable a b = (Bounded a, Bounded b, Enum a, Enum b, Eq b, Num Boolean, Ord Boolean)

202+type Trivial a = I.Normalize a ~ I.Normalize (I.Normalize a)

203+type TrivialP a b = I.Normalize (a, b) ~ I.Normalize (I.Normalize a, I.Normalize b)

205204

206205-- | It is possible to implement a constrained version of the category type

207206-- class.

208207instance Category Relation where

209− type Object Relation a = (FromListsN a a, CountableN a)

208+ type Object Relation a = (FLN a a, CountableN a)

210209 id = iden

211210 (.) = comp

212211

@@ -229,10 +228,6 @@ type One = ()

229228

230229-- Primitives

231230

232−-- | Empty matrix constructor

233−empty :: Relation Zero Zero

234−empty = R I.Empty

235−

236231-- | Unit matrix constructor

237232one :: Boolean -> Relation One One

238233one = R . I.One

@@ -269,26 +264,26 @@ infixl 2 ===

269264

270265-- | Build a matrix out of a list of list of elements. Throws a runtime

271266-- 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

273268fromLists = R . I.fromLists

274269

275270-- | Relation builder function. Constructs a relation provided with

276271-- a construction function that operates with indices.

277272relationBuilder' ::

278− (FromListsN a b, CountableDimensionsN a b) =>

273+ (FLN a b, CountableDimsN a b) =>

279274 ((Int, Int) -> Boolean) -> Relation a b

280275relationBuilder' = R . I.matrixBuilder'

281276

282277-- | Relation builder function. Constructs a relation provided with

283278-- a construction function that operates with arbitrary types.

284279relationBuilder ::

285− ( FromListsN a b,

280+ ( FLN a b,

286281 Enum a,

287282 Enum b,

288283 Bounded a,

289284 Bounded b,

290285 Eq a,

291− CountableDimensionsN a b

286+ CountableDims a b

292287 ) => ((a, b) -> Boolean) -> Relation a b

293288relationBuilder = R . I.matrixBuilder

294289

@@ -298,18 +293,18 @@ relationBuilder = R . I.matrixBuilder

298293-- types @a@ or @b@ allows.

299294fromF' ::

300295 ( Liftable a b,

301− CountableDimensionsN c d,

302− FromListsN d c

296+ CountableDimsN c d,

297+ FLN d c

303298 )

304299 => (a -> b) -> Relation c d

305300fromF' f = R (I.fromFRel' f)

306301

307302-- | Lifts functions to matrices with dimensions matching @a@ and @b@

308303-- cardinality's.

309−fromF ::

304+fromF ::

310305 ( Liftable a b,

311− CountableDimensionsN a b,

312− FromListsN b a

306+ CountableDimsN a b,

307+ FLN b a

313308 )

314309 => (a -> b) -> Relation a b

315310fromF f = R (I.fromFRel f)

@@ -317,8 +312,8 @@ fromF f = R (I.fromFRel f)

317312-- | Lifts relation functions to 'Relation'

318313toRel ::

319314 ( Liftable a b,

320− CountableDimensionsN a b,

321− FromListsN b a

315+ CountableDims a b,

316+ FLN b a

322317 )

323318 => (a -> b -> Bool) -> Relation a b

324319toRel = R . I.toRel

@@ -327,9 +322,9 @@ toRel = R . I.toRel

327322fromRel ::

328323 ( Liftable a b,

329324 Eq a,

330− CountableDimensionsN a b,

331− FromListsN a One,

332− FromListsN b One

325+ CountableDimsN a b,

326+ FLN a One,

327+ FLN b One

333328 )

334329 => Relation a b -> (a -> b -> Bool)

335330fromRel r a b = pointApBool a b r

@@ -353,12 +348,12 @@ toBool r = case toList r of

353348-- | Power transpose.

354349--

355350-- Maps a relation to a set valued function.

356−pt ::

351+pt ::

357352 ( Liftable a b,

358353 Eq a,

359− CountableDimensionsN a b,

360− FromListsN a One,

361− FromListsN b One

354+ CountableDimsN a b,

355+ FLN a One,

356+ FLN b One

362357 )

363358 => Relation a b -> (a -> List b)

364359pt r a =

@@ -370,8 +365,8 @@ belongs ::

370365 ( Bounded a,

371366 Enum a,

372367 Eq a,

373− CountableDimensionsN (List a) a,

374− FromListsN a (List a)

368+ CountableDims (List a) a,

369+ FLN a (List a)

375370 )

376371 => Relation (List a) a

377372belongs = toRel elemR

@@ -383,14 +378,14 @@ belongs = toRel elemR

383378-- | The zero relation. A relation where no element of type @a@ relates

384379-- with elements of type @b@.

385380--

386−-- Also known as ⊥ (Bottom) Relation or empty Relation.

381+-- Also known as ⊥ (Bottom) Relation.

387382--

388383-- @

389384-- r `.` ⊥ == ⊥ `.` r == ⊥

390385-- ⊥ ``sse`` R && R ``sse`` T == True

391386-- @

392387zeros ::

393− (FromListsN a b, CountableDimensionsN a b) =>

388+ (FLN a b, CountableDimsN a b) =>

394389 Relation a b

395390zeros = relationBuilder' (const (nat 0))

396391

@@ -405,7 +400,7 @@ zeros = relationBuilder' (const (nat 0))

405400-- ⊥ ``sse`` R && R ``sse`` T == True

406401-- @

407402ones ::

408− (FromListsN a b, CountableDimensionsN a b) =>

403+ (FLN a b, CountableDimsN a b) =>

409404 Relation a b

410405ones = relationBuilder' (const (nat 1))

411406

@@ -413,17 +408,17 @@ ones = relationBuilder' (const (nat 1))

413408

414409-- | The T (Top) row vector relation.

415410bang ::

416− (FromListsN a One, CountableN a) =>

411+ (FLN a One, CountableN a) =>

417412 Relation a One

418413bang = ones

419414

420415-- | Point constant relation

421−point ::

416+point ::

422417 ( Bounded a,

423418 Enum a,

424419 Eq a,

425420 CountableN a,

426− FromListsN a One

421+ FLN a One

427422 ) => a -> Relation One a

428423point = fromF . const

429424

@@ -435,7 +430,7 @@ point = fromF . const

435430-- 'iden' `.` r == r == r `.` 'iden'

436431-- @

437432iden ::

438− (FromListsN a a, CountableN a) => Relation a a

433+ (FLN a a, CountableN a) => Relation a a

439434iden = relationBuilder' (bool (nat 0) (nat 1) . uncurry (==))

440435

441436-- | Relational composition

@@ -489,7 +484,7 @@ shrunkBy r s = r `intersection` divR s (conv r)

489484-- r ``overriddenBy`` r == r

490485-- @

491486overriddenBy ::

492− ( FromListsN b b,

487+ ( FLN b b,

493488 CountableN b

494489 ) => Relation a b -> Relation a b -> Relation a b

495490overriddenBy r s = s `union` r `intersection` divR zeros (conv s)

@@ -501,9 +496,9 @@ overriddenBy r s = s `union` r `intersection` divR zeros (conv s)

501496pointAp ::

502497 ( Liftable a b,

503498 Eq a,

504− CountableDimensionsN a b,

505− FromListsN a One,

506− FromListsN b One

499+ CountableDimsN a b,

500+ FLN a One,

501+ FLN b One

507502 ) => a -> b -> Relation a b -> Relation One One

508503pointAp a b r = conv (point b) . r . point a

509504

@@ -513,9 +508,9 @@ pointAp a b r = conv (point b) . r . point a

513508pointApBool ::

514509 ( Liftable a b,

515510 Eq a,

516− CountableDimensionsN a b,

517− FromListsN a One,

518− FromListsN b One

511+ CountableDimsN a b,

512+ FLN a One,

513+ FLN b One

519514 ) => a -> b -> Relation a b -> Bool

520515pointApBool a b r = toBool $ conv (point b) . r . point a

521516

@@ -595,19 +590,19 @@ divisionF f g = conv g . f

595590-- Taxonomy of binary relations

596591

597592-- | A 'Relation' @r@ is 'simple' 'iff' @'coreflexive' ('img' r)@

598−simple :: (CountableN b, FromListsN b b) => Relation a b -> Bool

593+simple :: (CountableN b, FLN b b) => Relation a b -> Bool

599594simple = coreflexive . img

600595

601596-- | A 'Relation' @r@ is 'injective' 'iff' @'coreflexive' ('ker' r)@

602−injective :: (CountableN a, FromListsN a a) => Relation a b -> Bool

597+injective :: (CountableN a, FLN a a) => Relation a b -> Bool

603598injective = coreflexive . ker

604599

605600-- | A 'Relation' @r@ is 'entire' 'iff' @'reflexive' ('ker' r)@

606−entire :: (CountableN a, FromListsN a a) => Relation a b -> Bool

601+entire :: (CountableN a, FLN a a) => Relation a b -> Bool

607602entire = reflexive . ker

608603

609604-- | A 'Relation' @r@ is 'surjective' 'iff' @'reflexive' ('img' r)@

610−surjective :: (CountableN b, FromListsN b b) => Relation a b -> Bool

605+surjective :: (CountableN b, FLN b b) => Relation a b -> Bool

611606surjective = reflexive . img

612607

613608-- | A 'Relation' @r@ is a 'function' 'iff' @'simple' r && 'entire' r@

@@ -620,9 +615,9 @@ surjective = reflexive . img

620615-- r `.` f ``sse`` s == r ``sse`` s `.` f

621616-- @

622617function ::

623− ( CountableDimensionsN a b,

624− FromListsN a a,

625− FromListsN b b

618+ ( CountableDimsN a b,

619+ FLN a a,

620+ FLN b b

626621 )

627622 => Relation a b -> Bool

628623function r = simple r && entire r

@@ -630,7 +625,7 @@ function r = simple r && entire r

630625-- | A 'Relation' @r@ is a 'representation' 'iff' @'injective' r && 'entire' r@

631626representation ::

632627 ( CountableN a,

633− FromListsN a a

628+ FLN a a

634629 )

635630 => Relation a b -> Bool

636631representation r = injective r && entire r

@@ -638,45 +633,45 @@ representation r = injective r && entire r

638633-- | A 'Relation' @r@ is an 'abstraction' 'iff' @'surjective' r && 'simple' r@

639634abstraction ::

640635 ( CountableN b,

641− FromListsN b b

636+ FLN b b

642637 )

643638 => Relation a b -> Bool

644639abstraction r = surjective r && simple r

645640

646641-- | A 'Relation' @r@ is a 'surjection' 'iff' @'function' r && 'abstraction' r@

647642surjection ::

648− ( CountableDimensionsN a b,

649− FromListsN a a,

650− FromListsN b b

643+ ( CountableDimsN a b,

644+ FLN a a,

645+ FLN b b

651646 )

652647 => Relation a b -> Bool

653648surjection r = function r && abstraction r

654649

655650-- | A 'Relation' @r@ is a 'injection' 'iff' @'function' r && 'representation' r@

656651injection ::

657− ( CountableDimensionsN a b,

658− FromListsN a a,

659− FromListsN b b

652+ ( CountableDimsN a b,

653+ FLN a a,

654+ FLN b b

660655 )

661656 => Relation a b -> Bool

662657injection r = function r && representation r

663658

664659-- | A 'Relation' @r@ is an 'bijection' 'iff' @'injection' r && 'surjection' r@

665660bijection ::

666− ( CountableDimensionsN a b,

667− FromListsN b b,

668− FromListsN a a

661+ ( CountableDimsN a b,

662+ FLN b b,

663+ FLN a a

669664 ) => Relation a b -> Bool

670665bijection r = injection r && surjection r

671666

672667-- Properties of relations

673668

674669-- | A 'Relation' @r@ is 'reflexive' 'iff' @'id' ``sse`` r@

675−reflexive :: (CountableN a, FromListsN a a) => Relation a a -> Bool

670+reflexive :: (CountableN a, FLN a a) => Relation a a -> Bool

676671reflexive r = id <= r

677672

678673-- | A 'Relation' @r@ is 'coreflexive' 'iff' @r ``sse`` 'id'@

679−coreflexive :: (CountableN a, FromListsN a a) => Relation a a -> Bool

674+coreflexive :: (CountableN a, FLN a a) => Relation a a -> Bool

680675coreflexive r = r <= id

681676

682677-- | A 'Relation' @r@ is 'transitive' 'iff' @(r `.` r) ``sse`` r@

@@ -688,35 +683,35 @@ symmetric :: Relation a a -> Bool

688683symmetric r = r == conv r

689684

690685-- | A 'Relation' @r@ is anti-symmetric 'iff' @(r ``intersection`` 'conv' r) ``sse`` 'id'@

691−antiSymmetric :: (CountableN a, FromListsN a a) => Relation a a -> Bool

686+antiSymmetric :: (CountableN a, FLN a a) => Relation a a -> Bool

692687antiSymmetric r = (r `intersection` conv r) `sse` id

693688

694689-- | A 'Relation' @r@ is 'irreflexive' 'iff' @(r ``intersection`` 'id') == 'zeros'@

695−irreflexive :: (CountableN a, FromListsN a a) => Relation a a -> Bool

690+irreflexive :: (CountableN a, FLN a a) => Relation a a -> Bool

696691irreflexive r = (r `intersection` id) == zeros

697692

698693-- | A 'Relation' @r@ is 'connected' 'iff' @(r ``union`` 'conv' r) == 'ones'@

699−connected :: (CountableN a, FromListsN a a) => Relation a a -> Bool

694+connected :: (CountableN a, FLN a a) => Relation a a -> Bool

700695connected r = (r `union` conv r) == ones

701696

702697-- | A 'Relation' @r@ is a 'preorder' 'iff' @'reflexive' r && 'transitive' r@

703−preorder :: (CountableN a, FromListsN a a) => Relation a a -> Bool

698+preorder :: (CountableN a, FLN a a) => Relation a a -> Bool

704699preorder r = reflexive r && transitive r

705700

706701-- | A 'Relation' @r@ is a partial-order 'iff' @'antiSymmetric' r && 'preorder' r@

707−partialOrder :: (CountableN a, FromListsN a a) => Relation a a -> Bool

702+partialOrder :: (CountableN a, FLN a a) => Relation a a -> Bool

708703partialOrder r = antiSymmetric r && preorder r

709704

710705-- | A 'Relation' @r@ is a linear-order 'iff' @'connected' r && 'partialOrder' r@

711−linearOrder :: (CountableN a, FromListsN a a) => Relation a a -> Bool

706+linearOrder :: (CountableN a, FLN a a) => Relation a a -> Bool

712707linearOrder r = connected r && partialOrder r

713708

714709-- | A 'Relation' @r@ is an 'equivalence' 'iff' @'symmetric' r && 'preorder' r@

715−equivalence :: (CountableN a, FromListsN a a) => Relation a a -> Bool

710+equivalence :: (CountableN a, FLN a a) => Relation a a -> Bool

716711equivalence r = symmetric r && preorder r

717712

718713-- | A 'Relation' @r@ is a partial-equivalence 'iff' @'partialOrder' r && 'equivalence' r@

719−partialEquivalence :: (CountableN a, FromListsN a a) => Relation a a -> Bool

714+partialEquivalence :: (CountableN a, FLN a a) => Relation a a -> Bool

720715partialEquivalence r = partialOrder r && equivalence r

721716

722717-- | A 'Relation' @r@ is 'difunctional' or regular wherever

@@ -748,10 +743,10 @@ difunctional r = r . conv r . r == r

748743-- 'eitherR' ('splitR' r s) ('splitR' t v) == 'splitR' ('eitherR' r t) ('eitherR' s v)

749744-- @

750745splitR ::

751− ( CountableDimensionsN a b,

746+ ( CountableDimsN a b,

752747 CountableN (a, b),

753− FromListsN (a, b) a,

754− FromListsN (a, b) b,

748+ FLN (a, b) a,

749+ FLN (a, b) b,

755750 TrivialP a b

756751 )

757752 => Relation c a -> Relation c b -> Relation c (a, b)

@@ -764,9 +759,9 @@ splitR (R f) (R g) = R (I.kr f g)

764759-- @

765760fstR ::

766761 forall a b .

767− ( CountableDimensionsN a b,

762+ ( CountableDimsN a b,

768763 CountableN (a, b),

769− FromListsN (a, b) a,

764+ FLN (a, b) a,

770765 TrivialP a b

771766 )

772767 => Relation (a, b) a

@@ -779,9 +774,9 @@ fstR = R (I.fstM @Boolean @(I.Normalize a) @(I.Normalize b))

779774-- @

780775sndR ::

781776 forall a b .

782− ( CountableDimensionsN a b,

777+ ( CountableDimsN a b,

783778 CountableN (a, b),

784− FromListsN (a, b) b,

779+ FLN (a, b) b,

785780 TrivialP a b

786781 )

787782 => Relation (a, b) b

@@ -797,13 +792,13 @@ infixl 4 ><

797792-- (r '><' s) `.` (p '><' q) == (r `.` p) '><' (s `.` q)

798793-- @

799794(><) ::

800− ( CountableDimensionsN a b,

801− CountableDimensionsN c d,

802− CountableDimensionsN (a, c) (b, d),

803− FromListsN (a, c) a,

804− FromListsN (a, c) c,

805− FromListsN (b, d) b,

806− FromListsN (b, d) d,

795+ ( CountableDimsN a b,

796+ CountableDimsN c d,

797+ CountableDimsN (a, c) (b, d),

798+ FLN (a, c) a,

799+ FLN (a, c) c,

800+ FLN (b, d) b,

801+ FLN (b, d) d,

807802 TrivialP a c,

808803 TrivialP b d

809804 )

@@ -837,9 +832,9 @@ eitherR = join

837832-- 'i1' `.` 'i2' = 'zeros'

838833-- @

839834i1 ::

840− ( CountableDimensionsN a b,

841− FromListsN b a,

842− FromListsN a a

835+ ( CountableDimsN a b,

836+ FLN b a,

837+ FLN a a

843838 )

844839 => Relation a (Either a b)

845840i1 = R I.i1

@@ -851,9 +846,9 @@ i1 = R I.i1

851846-- 'i1' `.` 'i2' = 'zeros'

852847-- @

853848i2 ::

854− ( CountableDimensionsN a b,

855− FromListsN a b,

856− FromListsN b b

849+ ( CountableDimsN a b,

850+ FLN a b,

851+ FLN b b

857852 )

858853 => Relation b (Either a b)

859854i2 = R I.i2

@@ -866,11 +861,11 @@ infixl 5 -|-

866861-- r '-|-' s == 'eitherR' ('i1' `.` r) ('i2' `.` s)

867862-- @

868863(-|-) ::

869− ( CountableDimensionsN b d,

870− FromListsN b b,

871− FromListsN d b,

872− FromListsN b d,

873− FromListsN d d

864+ ( CountableDimsN b d,

865+ FLN b b,

866+ FLN d b,

867+ FLN b d,

868+ FLN d d

874869 )

875870 => Relation a b -> Relation c d -> Relation (Either a c) (Either b d)

876871(-|-) (R a) (R b) = R ((I.-|-) a b)

@@ -883,13 +878,13 @@ infixl 5 -|-

883878-- 'trans'/'untrans';

884879-- more-over, where each particular attribute is placed (input/output) is irrelevant.

885880trans ::

886− ( CountableDimensionsN a b,

881+ ( CountableDimsN a b,

887882 CountableN c,

888− CountableDimensionsN (a, b) (c, b),

889− FromListsN (c, b) c,

890− FromListsN (c, b) b,

891− FromListsN (a, b) a,

892− FromListsN (a, b) b,

883+ CountableDimsN (a, b) (c, b),

884+ FLN (c, b) c,

885+ FLN (c, b) b,

886+ FLN (a, b) a,

887+ FLN (a, b) b,

893888 Trivial (a, b),

894889 Trivial (c, b),

895890 TrivialP a b,

@@ -904,13 +899,13 @@ trans r = splitR r sndR . conv fstR

904899-- 'trans'/'untrans';

905900-- more-over, where each particular attribute is placed (input/output) is irrelevant.

906901untrans ::

907− ( CountableDimensionsN a b,

902+ ( CountableDimsN a b,

908903 CountableN c,

909− CountableDimensionsN (a, b) (c, b),

910− FromListsN (c, b) c,

911− FromListsN (c, b) b,

912− FromListsN (a, b) b,

913− FromListsN (a, b) a,

904+ CountableDimsN (a, b) (c, b),

905+ FLN (c, b) c,

906+ FLN (c, b) b,

907+ FLN (a, b) b,

908+ FLN (a, b) a,

914909 Trivial (a, b),

915910 Trivial (c, b),

916911 TrivialP a b,

@@ -932,9 +927,10 @@ untrans s = fstR . conv (splitR (conv s) sndR)

932927predR ::

933928 ( Bounded a,

934929 Enum a,

930+ Countable a,

935931 CountableN a,

936− FromListsN a a,

937− FromListsN Bool a

932+ FLN a a,

933+ FLN Bool a

938934 )

939935 => Relation a Bool -> Relation a a

940936predR p = id `intersection` divisionF (fromF (const True)) p

@@ -949,7 +945,7 @@ predR p = id `intersection` divisionF (fromF (const True)) p

949945-- @

950946equalizer ::

951947 ( CountableN a,

952− FromListsN a a

948+ FLN a a

953949 )

954950 => Relation a b -> Relation a b -> Relation a a

955951equalizer f g = id `intersection` divisionF f g

@@ -959,23 +955,25 @@ equalizer f g = id `intersection` divisionF f g

959955-- @

960956-- 'guard' p = 'i2' ``overriddenBy`` 'i1' `.` 'predR' p

961957-- @

962−guard ::

958+guard ::

963959 ( Bounded b,

964960 Enum b,

965961 CountableN b,

966− FromListsN b b,

967− FromListsN Bool b

962+ Countable b,

963+ FLN b b,

964+ FLN Bool b

968965 ) => Relation b Bool -> Relation b (Either b b)

969966guard p = conv (eitherR (predR p) (predR (negate p)))

970967

971968-- | Relational McCarthy's conditional.

972−cond ::

969+cond ::

973970 ( Bounded b,

974971 Enum b,

972+ Countable b,

975973 CountableN b,

976− FromListsN b b,

977− FromListsN Bool b

978− )

974+ FLN b b,

975+ FLN Bool b

976+ )

979977 => Relation b Bool -> Relation b c -> Relation b c -> Relation b c

980978cond p r s = eitherR r s . guard p

981979

@@ -985,7 +983,7 @@ cond p r s = eitherR r s . guard p

985983-- since @'ker' r ``sse`` 'id'@ in such situations.

986984domain ::

987985 ( CountableN a,

988− FromListsN a a

986+ FLN a a

989987 ) => Relation a b -> Relation a a

990988domain r = ker r `intersection` id

991989

@@ -995,16 +993,16 @@ domain r = ker r `intersection` id

995993-- since @'img' f ``sse`` id@ for any @f@.

996994range ::

997995 ( CountableN b,

998− FromListsN b b

996+ FLN b b

999997 ) => Relation a b -> Relation b b

1000998range r = img r `intersection` id

1001999

10021000-- Relation pretty print

10031001

10041002-- | Relation pretty printing

1005−pretty :: (CountableDimensionsN a b) => Relation a b -> String

1003+pretty :: (CountableDimsN a b) => Relation a b -> String

10061004pretty (R a) = I.pretty a

10071005

10081006-- | Relation pretty printing

1009−prettyPrint :: (CountableDimensionsN a b) => Relation a b -> IO ()

1007+prettyPrint :: (CountableDimsN a b) => Relation a b -> IO ()

10101008prettyPrint (R a) = I.prettyPrint a

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

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

1+resolver: lts-14.3

stack.yaml.lock+4−4

@@ -6,7 +6,7 @@

66packages: []

77snapshots:

88- completed:

9− size: 524789

10− url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/14/18.yaml

11− sha256: 646be71223e08234131c6989912e6011e01b9767bc447b6d466a35e14360bdf2

12− original: lts-14.18

9+ size: 523878

10+ url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/14/3.yaml

11+ sha256: 470c46c27746a48c7c50f829efc0cf00112787a7804ee4ac7a27754658f6d92c

12+ original: lts-14.3

app/Quantum.hs → test/Examples/Quantum.hsrenamed+2−2

@@ -1,5 +1,5 @@

11{-# LANGUAGE StandaloneDeriving #-}

2−module Quantum where

2+module Examples.Quantum where

44import LAoP.Utils

55import LAoP.Matrix.Type

@@ -21,7 +21,7 @@ cnot = kr fstM (fromF xor)

2121ccnot :: (Num e, Ord e) => Matrix e ((Bool, Bool), Bool) ((Bool, Bool), Bool)

2222ccnot = kr fstM (fromF f)

2323 where

24− f = xor . (tp (uncurry (&&)) id)

24+ f = xor . tp (uncurry (&&)) id

2525 tp f g (a,b) = (f a, g b)

2626

2727had :: Matrix (Complex Double) Bool Bool

app/Examples.hs → test/Examples/Readme.hsrenamed+5−6

@@ -1,11 +1,10 @@

11{-# LANGUAGE GADTs #-}

22{-# LANGUAGE DeriveGeneric #-}

33{-# LANGUAGE FlexibleContexts #-}

4−{-# LANGUAGE TypeOperators #-}

54{-# LANGUAGE TypeApplications #-}

65{-# LANGUAGE DataKinds #-}

8−module Examples

7+module Examples.Readme

98 ( exec

109 )

1110 where

@@ -28,7 +27,7 @@ switch Win = Lose

2827switch Lose = Win

2928

3029firstChoice :: Matrix Double () Outcome

31−firstChoice = colL [1/3, 2/3]

30+firstChoice = col [1/3, 2/3]

3231

3332secondChoice :: Matrix Double Outcome Outcome

3433secondChoice = fromF switch

@@ -53,7 +52,7 @@ conditionSS = coerceNat2 condition

5352conditionalThrows = fromF (uncurry conditionSS) . kr (kr die die) die

5453

5554die :: Matrix Double () SS

56−die = colL $ map (const (1/6)) [nat @1 @6 1 .. nat 6]

55+die = col $ map (const (1/6)) [nat @1 @6 1 .. nat 6]

5756

5857-- Sprinkler

5958data G = Dry | Wet

@@ -96,10 +95,10 @@ tag f = kr f id

9695state g s r = tag g . tag s . r

9796

9897grass_wet :: Matrix Double () (G, (S, R)) -> Matrix Double One One

99−grass_wet state = rowL [0,1] . fstM . state

98+grass_wet state = row [0,1] . fstM . state

10099

101100rainning :: Matrix Double (G, (S, R)) One

102−rainning = rowL [0,1] . sndM . sndM

101+rainning = row [0,1] . sndM . sndM

103102

104103-- Alcuin Puzzle

105104

app/Spreadsheets.hs → test/Examples/Spreadsheets.hsrenamed+1−2

@@ -1,7 +1,6 @@

11{-# LANGUAGE DeriveGeneric #-}

3−module Spreadsheets

4− where

3+module Examples.Spreadsheets

65import LAoP.Utils

76import LAoP.Matrix.Type

test/Spec.hs+7−1

@@ -1,2 +1,8 @@

1+module Main (main) where

3+import qualified Examples.Readme as RD

15main :: IO ()

2−main = putStrLn "Test suite not yet implemented"

6+main = do

7+ putStrLn ("Testing if README works" :: String)

8+ RD.exec