git.iko.soy/laop
on d2fbcb5 help sign in
eea6231
swap
2 ahead, 23 behind
.ghc.environment.x86_64-linux-8.6.5new file+17
since splitsnapshots
unifiedsplit
@@ -0,0 +1,17 @@
1+-- This is a GHC environment file written by cabal. This means you can
2+-- run ghc or ghci and get the environment of the project as a whole.
3+-- But you still need to use cabal repl $target to get the environment
4+-- of specific components (libs, exes, tests etc) because each one can
5+-- have its own source dirs, cpp flags etc.
6+--
7+clear-package-db
8+global-package-db
9+package-db /home/bolt/.cabal/store/ghc-8.6.5/package.db
10+package-db packagedb/ghc-8.6.5
11+package-id laop-0.1.0.0-inplace
12+package-id base-4.12.0.0
13+package-id ghc-prim-0.5.3
14+package-id rts
15+package-id integer-gmp-1.0.2.0
16+package-id deepseq-1.4.4.0
17+package-id array-0.5.3.0
.github/workflows/ci.ymldeleted−43
@@ -1,43 +0,0 @@
1−name: CI
2−
3−# Trigger the workflow on push or pull request, but only for the master branch
4−on:
5− pull_request:
6− push:
7− branches: [master]
8−
9−jobs:
10− build:
11− name: ghc ${{ matrix.ghc }}
12− runs-on: ubuntu-16.04
13− strategy:
14− matrix:
15− cabal: ["3.0"]
16− ghc:
17− - "8.6.5"
18− - "8.8.3"
19−
20− steps:
21− - uses: actions/checkout@v2
22− if: github.event.action == 'opened' || github.event.action == 'synchronize' || github.event.ref == 'refs/heads/master'
23−
24− - uses: actions/setup-haskell@v1
25− name: Setup Haskell
26− with:
27− ghc-version: ${{ matrix.ghc }}
28− cabal-version: ${{ matrix.cabal }}
29−
30− - uses: actions/cache@v1
31− name: Cache ~/.cabal/store
32− with:
33− path: ~/.cabal/store
34− key: ${{ runner.os }}-${{ matrix.ghc }}-cabal
35−
36− - name: Build
37− run: |
38− cabal v2-update
39− cabal v2-build --enable-tests --enable-benchmarks
40−
41− - name: Test
42− run: |
43− cabal v2-test --enable-tests
.gitignore+2−54
@@ -1,55 +1,3 @@
1−### Haskell
2−dist
3−dist-*
4−cabal-dev
5−*.o
6−*.hi
7−*.chi
8−*.chs.h
9−*.dyn_o
10−*.dyn_hi
11−*.prof
12−*.aux
13−*.hp
14−*.eventlog
15−.virtualenv
16−.hsenv
17−.hpc
18−.cabal-sandbox/
19−cabal.sandbox.config
20−cabal.config
21−cabal.project.local
22−.ghc.environment.*
23−.HTF/
24−# Stack
25.stack-work/
1.stack-work/
26−stack.yaml.lock
2+laop.cabal
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−*~
3+*~
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.ymldeleted−47
@@ -1,47 +0,0 @@
1−sudo: true
2−language: haskell
3−
4−git:
5− depth: 5
6−
7−cabal: "3.0"
8−
9−cache:
10− directories:
11− - "$HOME/.cabal/store"
12− - "$HOME/.stack"
13− - "$TRAVIS_BUILD_DIR/.stack-work"
14−
15−matrix:
16− include:
17− - ghc: 8.6.5
18− - ghc: 8.8.3
19−
20− - ghc: 8.8.3
21− env: STACK_YAML="$TRAVIS_BUILD_DIR/stack-8.8.3.yaml"
22−
23− - ghc: 8.6.5
24− env: STACK_YAML="$TRAVIS_BUILD_DIR/stack.yaml"
25−
26−
27−install:
28− - |
29− if [ -z "$STACK_YAML" ]; then
30− cabal v2-update
31− cabal v2-build --enable-tests --enable-benchmarks
32− else
33− curl -sSL https://get.haskellstack.org/ | sh
34− stack --version
35− stack build --system-ghc --test --bench --no-run-tests --no-run-benchmarks
36− fi
37−
38−script:
39− - |
40− if [ -z "$STACK_YAML" ]; then
41− cabal v2-test --enable-tests
42− else
43− stack test --system-ghc
44− fi
45−
46−notifications:
47− email: false
CHANGELOG.mddeleted−17
@@ -1,17 +0,0 @@
1−# Changelog
2−
3−`laop` uses [PVP Versioning][1].
4−The changelog is available [on GitHub][2].
5−
6−## 0.1.1.1
7−
8−* Bump base version to work with cabal
9−
10−## 0.1.1.0
11−
12−* Package is more organized and now has tests and benchmarks separated
13−* Repository is more organized and clean
14−* Added CI
15−
16−[1]: https://pvp.haskell.org
17−[2]: https://github.com/bolt12/laop2/releases
ChangeLog.mdnew file+3
@@ -0,0 +1,3 @@
1+# Changelog for laop
2+
3+## Unreleased changes
LICENSE+26−17
@@ -1,21 +1,30 @@
1−MIT License
1+Copyright Armando Santos (c) 2019
2
2
3−Copyright (c) 2020 Armando Santos
3+All rights reserved.
4
4
5−Permission is hereby granted, free of charge, to any person obtaining a copy
5+Redistribution and use in source and binary forms, with or without
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:
6+modification, are permitted provided that the following conditions are met:
11
7
12−The above copyright notice and this permission notice shall be included in all
8+ * Redistributions of source code must retain the above copyright
13−copies or substantial portions of the Software.
9+ notice, this list of conditions and the following disclaimer.
14
10
15−THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
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
16−IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
22+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
17−FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
23+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
18−AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
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
19−LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
28+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
20−OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
29+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
21−SOFTWARE.
30+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
README.md+30−34
@@ -1,11 +1,5 @@
1# laop - Linear Algebra of Programming library
1# laop - Linear Algebra of Programming library
2
2
3−[![GitHub CI](https://github.com/bolt12/laop/workflows/CI/badge.svg)](https://github.com/bolt12/laop/actions)
4−[![Build status](https://img.shields.io/travis/bolt12/laop.svg?logo=travis)](https://travis-ci.org/bolt12/laop)
5−[![Hackage](https://img.shields.io/hackage/v/laop.svg?logo=haskell)](https://hackage.haskell.org/package/laop)
6−[![Stackage Lts](http://stackage.org/package/laop/badge/lts)](http://stackage.org/lts/package/laop)
7−[![Stackage Nightly](http://stackage.org/package/laop/badge/nightly)](http://stackage.org/nightly/package/laop)
8−
9The LAoP discipline generalises relations and functions treating them as
3The LAoP discipline generalises relations and functions treating them as
10Boolean matrices and in turn consider these as arrows.
4Boolean matrices and in turn consider these as arrows.
11
5
@@ -16,38 +10,40 @@ motivation behind the library, the underlying theory, and implementation details
16This module offers many of the combinators mentioned in the work of
10This module offers many of the combinators mentioned in the work of
17[Macedo (2012)](https://repositorium.sdum.uminho.pt/handle/1822/22894) and [Oliveira (2012)](https://pdfs.semanticscholar.org/ccf5/27fa9179081223bffe8067edd81948644fc0.pdf).
11[Macedo (2012)](https://repositorium.sdum.uminho.pt/handle/1822/22894) and [Oliveira (2012)](https://pdfs.semanticscholar.org/ccf5/27fa9179081223bffe8067edd81948644fc0.pdf).
18
12
19−See the package in hackage [here](https://hackage.haskell.org/package/laop-0.1.1.0)
13+See the package in hackage [here](https://hackage.haskell.org/package/laop-0.1.0.5)
20−
21−A Functional Pearl has been written and can be regarded as the [reference document](https://github.com/bolt12/tymfgg-pearl) for this library.
22−
23−## Features
24−
25−This library offers 3 main matrix programming modules:
26
14
27−- One in which matrices are typed with type level natural numbers;
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).
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
16
31−There's also an experimental module that uses matrices to represent probability
17+A Functional Pearl is also on its way, hopefully will be the reference document for this library.
32−distributions.
33
18
34−The most interesting feature is that matrices are represented as an inductive data type.
19+## Features
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
20
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+
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).
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.
51
47
52## Notes
48## Notes
53
49
Setup.hsnew file+2
@@ -0,0 +1,2 @@
1+import Distribution.Simple
2+main = defaultMain
benchmark/Main.hs → app/Benchmarks.hsrenamed+13−10
@@ -8,12 +8,15 @@
8{-# LANGUAGE AllowAmbiguousTypes #-}
8{-# LANGUAGE AllowAmbiguousTypes #-}
9{-# LANGUAGE ScopedTypeVariables #-}
9{-# LANGUAGE ScopedTypeVariables #-}
10
10
11+module Benchmarks
12+ ( benchmark
13+ )
11−module Main (main) where
14+ where
12
15
13import LAoP.Dist.Internal
16import LAoP.Dist.Internal
14import LAoP.Utils
17import LAoP.Utils
15−import LAoP.Matrix.Type hiding (CountableN, Countable, FLN)
18+import LAoP.Matrix.Type hiding (CountableN, Countable, FromListsN)
16−import qualified LAoP.Matrix.Type as T (FLN)
19+import qualified LAoP.Matrix.Type as T (FromListsN)
17import Criterion.Main
20import Criterion.Main
18import Control.DeepSeq
21import Control.DeepSeq
19import Test.QuickCheck
22import Test.QuickCheck
@@ -23,13 +26,13 @@ import Prelude hiding (id, (.))
23
26
24selectM2 ::
27selectM2 ::
25 ( Num e,
28 ( Num e,
26− T.FLN b b,
29+ T.FromListsN e b b,
27 CountableN b
30 CountableN b
28 ) => Matrix e cols (Either a b) -> Matrix e a b -> Matrix e cols b
31 ) => Matrix e cols (Either a b) -> Matrix e a b -> Matrix e cols b
29selectM2 m y = join y iden `comp` m
32selectM2 m y = join y iden `comp` m
30
33
31selectD2 ::
34selectD2 ::
32− ( FLN b b,
35+ ( FromListsN b b,
33 CountableN b
36 CountableN b
34 ) => Dist (Either a b) -> Matrix Prob a b -> Dist b
37 ) => Dist (Either a b) -> Matrix Prob a b -> Dist b
35selectD2 (D d) m = D (join m iden `comp` d)
38selectD2 (D d) m = D (join m iden `comp` d)
@@ -37,7 +40,7 @@ selectD2 (D d) m = D (join m iden `comp` d)
37-- Composition with iden
40-- Composition with iden
38compId m = comp iden m
41compId m = comp iden m
39
42
40−randomDist :: forall a . (Countable a, FLN () a) => Gen (Dist a)
43+randomDist :: forall a . (Countable a, FromListsN () a) => Gen (Dist a)
41randomDist = do
44randomDist = do
42 let size = fromInteger (natVal (Proxy :: Proxy (Count a)))
45 let size = fromInteger (natVal (Proxy :: Proxy (Count a)))
43 l <- vectorOf size (arbitrary :: Gen Prob)
46 l <- vectorOf size (arbitrary :: Gen Prob)
@@ -46,7 +49,7 @@ randomDist = do
46 m = fromLists lr
49 m = fromLists lr
47 return (D m)
50 return (D m)
48
51
49−randomMatrix :: forall a b . (CountableDims a b, FLN a b) => Gen (Matrix Prob a b)
52+randomMatrix :: forall a b . (CountableDimensions a b, FromListsN a b) => Gen (Matrix Prob a b)
50randomMatrix = do
53randomMatrix = do
51 let cols = fromInteger (natVal (Proxy :: Proxy (Count a)))
54 let cols = fromInteger (natVal (Proxy :: Proxy (Count a)))
52 rows = fromInteger (natVal (Proxy :: Proxy (Count b)))
55 rows = fromInteger (natVal (Proxy :: Proxy (Count b)))
@@ -105,7 +108,7 @@ normalize3 as l = let s = sum l
105 probs = map (/ s) l
108 probs = map (/ s) l
106 in zip as probs
109 in zip as probs
107
110
108−randomDistF :: forall a b . (CountableDims a b, CoArbitrary a, Arbitrary b) => Gen (Dist' (a -> b))
111+randomDistF :: forall a b . (CountableDimensions a b, CoArbitrary a, Arbitrary b) => Gen (Dist' (a -> b))
109randomDistF = do
112randomDistF = do
110 let a = fromInteger (natVal (Proxy :: Proxy (Count a)))
113 let a = fromInteger (natVal (Proxy :: Proxy (Count a)))
111 b = fromInteger (natVal (Proxy :: Proxy (Count b)))
114 b = fromInteger (natVal (Proxy :: Proxy (Count b)))
@@ -144,8 +147,8 @@ setupEnv2 = do
144 distList2 <- generate (resize 1 (randomDistF @(Natural 0 100) @(Natural 0 100)))
147 distList2 <- generate (resize 1 (randomDistF @(Natural 0 100) @(Natural 0 100)))
145 return (m21, m40, dist, dist2, distList1, distList2)
148 return (m21, m40, dist, dist2, distList1, distList2)
146
149
147−main :: IO ()
150+benchmark :: IO ()
148−main = defaultMain [
151+benchmark = defaultMain [
149 env setupEnv $ \ ~(m11, m12, m21, m22, m31, m32) -> bgroup "Matrix Composition" [
152 env setupEnv $ \ ~(m11, m12, m21, m22, m31, m32) -> bgroup "Matrix Composition" [
150 bgroup "10x10" [
153 bgroup "10x10" [
151 bench "WHNF - 10x10" $ whnf (comp m11) m12
154 bench "WHNF - 10x10" $ whnf (comp m11) m12
test/Examples/Readme.hs → app/Examples.hsrenamed+2−1
@@ -1,10 +1,11 @@
1{-# LANGUAGE GADTs #-}
1{-# LANGUAGE GADTs #-}
2{-# LANGUAGE DeriveGeneric #-}
2{-# LANGUAGE DeriveGeneric #-}
3{-# LANGUAGE FlexibleContexts #-}
3{-# LANGUAGE FlexibleContexts #-}
4+{-# LANGUAGE TypeOperators #-}
4{-# LANGUAGE TypeApplications #-}
5{-# LANGUAGE TypeApplications #-}
5{-# LANGUAGE DataKinds #-}
6{-# LANGUAGE DataKinds #-}
6
7
7−module Examples.Readme
8+module Examples
8 ( exec
9 ( exec
9 )
10 )
10 where
11 where
app/Main.hsnew file+7
@@ -0,0 +1,7 @@
1+module Main where
2+
3+import Examples
4+import Benchmarks
5+
6+main :: IO ()
7+main = benchmark
test/Examples/Quantum.hs → app/Quantum.hsrenamed+2−2
@@ -1,5 +1,5 @@
1{-# LANGUAGE StandaloneDeriving #-}
1{-# LANGUAGE StandaloneDeriving #-}
2−module Examples.Quantum where
2+module Quantum where
3
3
4import LAoP.Utils
4import LAoP.Utils
5import LAoP.Matrix.Type
5import LAoP.Matrix.Type
@@ -21,7 +21,7 @@ cnot = kr fstM (fromF xor)
21ccnot :: (Num e, Ord e) => Matrix e ((Bool, Bool), Bool) ((Bool, Bool), Bool)
21ccnot :: (Num e, Ord e) => Matrix e ((Bool, Bool), Bool) ((Bool, Bool), Bool)
22ccnot = kr fstM (fromF f)
22ccnot = kr fstM (fromF f)
23 where
23 where
24− f = xor . tp (uncurry (&&)) id
24+ f = xor . (tp (uncurry (&&)) id)
25 tp f g (a,b) = (f a, g b)
25 tp f g (a,b) = (f a, g b)
26
26
27had :: Matrix (Complex Double) Bool Bool
27had :: Matrix (Complex Double) Bool Bool
test/Examples/Spreadsheets.hs → app/Spreadsheets.hsrenamed+2−1
@@ -1,6 +1,7 @@
1{-# LANGUAGE DeriveGeneric #-}
1{-# LANGUAGE DeriveGeneric #-}
2
2
3−module Examples.Spreadsheets
3+module Spreadsheets
4+ where
4
5
5import LAoP.Utils
6import LAoP.Utils
6import LAoP.Matrix.Type
7import LAoP.Matrix.Type
appveyor.ymldeleted−34
@@ -1,34 +0,0 @@
1−clone_folder: "c:\\WORK"
2−clone_depth: 5
3−
4−# Do not build feature branch with open Pull Requests
5−skip_branch_with_pr: true
6−
7−platform:
8− - x86_64
9−
10−cache:
11− - "C:\\SR"
12− - dist-newstyle
13−
14−environment:
15− global:
16− CABOPTS: --store-dir=C:\\SR
17−
18− matrix:
19− - GHCVER: 8.6.5
20−
21−install:
22− - choco source add -n mistuke -s https://www.myget.org/F/mistuke/api/v2
23− - choco install -y cabal --version 2.4.1.0
24− - choco install -y ghc --version 8.6.3
25− - refreshenv
26−
27−before_build:
28− - cabal --version
29− - ghc --version
30− - cabal %CABOPTS% v2-update
31−
32−build_script:
33− - cabal %CABOPTS% v2-build --enable-tests
34− - cabal %CABOPTS% v2-test --enable-tests
hackage.shnew file+10
@@ -0,0 +1,10 @@
1+#!/bin/sh
2+set -e
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.cabaldeleted−89
@@ -1,89 +0,0 @@
1−cabal-version: 2.4
2−name: laop
3−version: 0.1.1.1
4−synopsis: Matrix programming library
5−description: Matrix programming library that uses a type-safe inductive definition
6− inspired by the Linear Algebra of Programming
7−homepage: https://github.com/bolt12/laop
8−bug-reports: https://github.com/bolt12/laop/issues
9−license: MIT
10−license-file: LICENSE
11−author: Armando Santos
12−maintainer: Armando Santos <armandoifsantos@gmail.com>
13−copyright: 2020 Armando Santos
14−category: Data
15−build-type: Simple
16−extra-doc-files: README.md
17− CHANGELOG.md
18−tested-with: GHC == 8.6.5
19− GHC == 8.8.3
20−
21−source-repository head
22− type: git
23− location: https://github.com/bolt12/laop.git
24−
25−common common-options
26− build-depends: base >= 4.12.0.0 && < 5,
27− deepseq
28−
29− ghc-options: -Wall
30− -Wcompat
31− -Widentities
32− -Wincomplete-uni-patterns
33− -Wincomplete-record-updates
34− if impl(ghc >= 8.0)
35− ghc-options: -Wredundant-constraints
36− if impl(ghc >= 8.2)
37− ghc-options: -fhide-source-paths
38− if impl(ghc >= 8.4)
39− ghc-options: -Wmissing-export-lists
40− -Wpartial-fields
41− if impl(ghc >= 8.8)
42− ghc-options: -Wmissing-deriving-strategies
43−
44− default-language: Haskell2010
45−
46−library
47− import: common-options
48− hs-source-dirs: src
49− exposed-modules: LAoP.Dist
50− LAoP.Dist.Internal
51− LAoP.Matrix.Internal
52− LAoP.Matrix.Nat
53− LAoP.Matrix.Type
54− LAoP.Relation
55− LAoP.Relation.Internal
56− LAoP.Utils
57− LAoP.Utils.Internal
58−
59−test-suite laop-test
60− import: common-options
61− type: exitcode-stdio-1.0
62− hs-source-dirs: test
63− other-modules: Examples.Readme
64− main-is: Spec.hs
65− build-depends: laop
66− ghc-options: -threaded
67− -rtsopts
68− -with-rtsopts=-N
69− -funfolding-use-threshold=16
70− -fexcess-precision
71− -optc-O3
72− -optc-ffast-math
73−
74−benchmark laop-benchmark
75− import: common-options
76− type: exitcode-stdio-1.0
77− hs-source-dirs: benchmark
78− main-is: Main.hs
79− build-depends: criterion
80− , QuickCheck
81− , deepseq
82− , laop
83− ghc-options: -threaded
84− -rtsopts
85− -with-rtsopts=-N
86− -funfolding-use-threshold=16
87− -fexcess-precision
88− -optc-O3
89− -optc-ffast-math
package.yamlnew file+57
@@ -0,0 +1,57 @@
1+name: laop
2+version: 0.1.0.7
3+github: "bolt12/laop"
4+license: BSD3
5+author: "Armando Santos"
6+maintainer: "armandoifsantos@gmail.com"
7+copyright: "MIT"
8+
9+extra-source-files:
10+- README.md
11+- ChangeLog.md
12+
13+# Metadata used when publishing your package
14+# synopsis: Short description of your package
15+category: Data
16+
17+# To avoid duplicated efforts in documentation and dealing with the
18+# complications of embedding Haddock markup inside cabal files, it is
19+# common to point users to the README.md file.
20+description: Please see the README on GitHub at <https://github.com/bolt12/laop#readme>
21+
22+dependencies:
23+- base >= 4.7 && < 5
24+- deepseq
25+
26+library:
27+ source-dirs: src
28+
29+executables:
30+ laop-exe:
31+ main: Main.hs
32+ source-dirs: app
33+ ghc-options:
34+ - -threaded
35+ - -rtsopts
36+ - -with-rtsopts=-N
37+ - -funfolding-use-threshold=16
38+ - -fexcess-precision # Good for doubles
39+ - -optc-O3 # Good for doubles
40+ - -optc-ffast-math # Good for doubles
41+ - -O2
42+ dependencies:
43+ - laop
44+ - criterion
45+ - deepseq
46+ - QuickCheck
47+
48+tests:
49+ laop-test:
50+ main: Spec.hs
51+ source-dirs: test
52+ ghc-options:
53+ - -threaded
54+ - -rtsopts
55+ - -with-rtsopts=-N
56+ dependencies:
57+ - laop
src/LAoP/Dist.hs+2−2
@@ -39,8 +39,8 @@ module LAoP.Dist
39 -- * Constraint type synonyms
39 -- * Constraint type synonyms
40 Countable,
40 Countable,
41 CountableN,
41 CountableN,
42− CountableDimsN,
42+ CountableDimensionsN,
43− FLN,
43+ FromListsN,
44 Liftable,
44 Liftable,
45 TrivialP,
45 TrivialP,
46
46
src/LAoP/Dist/Internal.hs+43−43
@@ -16,8 +16,8 @@ module LAoP.Dist.Internal
16
16
17 Countable,
17 Countable,
18 CountableN,
18 CountableN,
19− CountableDimsN,
19+ CountableDimensionsN,
20− FLN,
20+ FromListsN,
21 Liftable,
21 Liftable,
22 TrivialP,
22 TrivialP,
23
23
@@ -43,7 +43,7 @@ module LAoP.Dist.Internal
43 )
43 )
44 where
44 where
45
45
46−import LAoP.Matrix.Type hiding (TrivialP, Countable, CountableDims, CountableN, CountableDimsN, Liftable, FLN)
46+import LAoP.Matrix.Type hiding (TrivialP, Countable, CountableDimensions, CountableN, CountableDimensionsN, Liftable, FromListsN)
47import Prelude hiding (id, (.))
47import Prelude hiding (id, (.))
48import qualified LAoP.Matrix.Internal as I
48import qualified LAoP.Matrix.Internal as I
49import LAoP.Utils
49import LAoP.Utils
@@ -62,18 +62,18 @@ newtype Dist a = D (Matrix Prob () a)
62 deriving (Show, Num, Eq, Ord, NFData) via (Matrix Prob () a)
62 deriving (Show, Num, Eq, Ord, NFData) via (Matrix Prob () a)
63
63
64-- | Constraint type synonyms to keep the type signatures less convoluted
64-- | Constraint type synonyms to keep the type signatures less convoluted
65−type Countable a = KnownNat (I.Count a)
65+type Countable a = KnownNat (I.Count a)
66−type CountableN a = KnownNat (I.Count (I.Normalize a))
66+type CountableN a = KnownNat (I.Count (I.Normalize a))
67−type CountableDimsN a b = (CountableN a, CountableN b)
67+type CountableDimensionsN a b = (CountableN a, CountableN b)
68−type FLN a b = I.FL (I.Normalize a) (I.Normalize b)
68+type FromListsN a b = I.FromLists Prob (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)
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)
70+type TrivialP a b = Normalize (a, b) ~ Normalize (Normalize a, Normalize b)
71
71
72-- | Functor instance
72-- | Functor instance
73fmapD ::
73fmapD ::
74 ( Liftable a b,
74 ( Liftable a b,
75− CountableDimsN a b,
75+ CountableDimensionsN a b,
76− FLN b a
76+ FromListsN b a
77 )
77 )
78 =>
78 =>
79 (a -> b) -> Dist a -> Dist b
79 (a -> b) -> Dist a -> Dist b
@@ -85,17 +85,17 @@ unitD = D (one 1)
85
85
86-- | Applicative/Monoidal instance 'mult' function
86-- | Applicative/Monoidal instance 'mult' function
87multD ::
87multD ::
88− ( CountableDimsN a b,
88+ ( CountableDimensionsN a b,
89 CountableN (a, b),
89 CountableN (a, b),
90− FLN (a, b) a,
90+ FromListsN (a, b) a,
91− FLN (a, b) b,
91+ FromListsN (a, b) b,
92 TrivialP a b
92 TrivialP a b
93 ) => Dist a -> Dist b -> Dist (a, b)
93 ) => Dist a -> Dist b -> Dist (a, b)
94multD (D a) (D b) = D (kr a b)
94multD (D a) (D b) = D (kr a b)
95
95
96-- | Selective instance function
96-- | Selective instance function
97selectD ::
97selectD ::
98− ( FLN b b,
98+ ( FromListsN b b,
99 CountableN b
99 CountableN b
100 ) => Dist (Either a b) -> Matrix Prob a b -> Dist b
100 ) => Dist (Either a b) -> Matrix Prob a b -> Dist b
101selectD (D d) m = D (selectM d m)
101selectD (D d) m = D (selectM d m)
@@ -104,17 +104,17 @@ selectD (D d) m = D (selectM d m)
104-- functions to apply to a given argument;
104-- functions to apply to a given argument;
105branchD ::
105branchD ::
106 ( Num e,
106 ( Num e,
107− CountableDimsN a b,
107+ CountableDimensionsN a b,
108− CountableDimsN c (Either b c),
108+ CountableDimensionsN c (Either b c),
109− FLN c b,
109+ FromListsN c b,
110− FLN a b,
110+ FromListsN a b,
111− FLN a a,
111+ FromListsN a a,
112− FLN b b,
112+ FromListsN b b,
113− FLN c c,
113+ FromListsN c c,
114− FLN b a,
114+ FromListsN b a,
115− FLN b c,
115+ FromListsN b c,
116− FLN (Either b c) b,
116+ FromListsN (Either b c) b,
117− FLN (Either b c) c
117+ FromListsN (Either b c) c
118 )
118 )
119 => Dist (Either a b) -> Matrix Prob a c -> Matrix Prob b c -> Dist c
119 => Dist (Either a b) -> Matrix Prob a c -> Matrix Prob b c -> Dist c
120branchD x l r = f x `selectD` g l `selectD` r
120branchD x l r = f x `selectD` g l `selectD` r
@@ -124,11 +124,11 @@ branchD x l r = f x `selectD` g l `selectD` r
124
124
125-- | Branch on a Boolean value, skipping unnecessary computations.
125-- | Branch on a Boolean value, skipping unnecessary computations.
126ifD ::
126ifD ::
127− ( CountableDimsN a (Either () a),
127+ ( CountableDimensionsN a (Either () a),
128− FLN a a,
128+ FromListsN a a,
129− FLN a (),
129+ FromListsN a (),
130− FLN () a,
130+ FromListsN () a,
131− FLN (Either () a) a
131+ FromListsN (Either () a) a
132 )
132 )
133 => Dist Bool -> Dist a -> Dist a -> Dist a
133 => Dist Bool -> Dist a -> Dist a -> Dist a
134ifD x (D t) (D e) = branchD x' t e
134ifD x (D t) (D e) = branchD x' t e
@@ -136,7 +136,7 @@ ifD x (D t) (D e) = branchD x' t e
136 x' = bool (Right ()) (Left ()) `fmapD` x
136 x' = bool (Right ()) (Left ()) `fmapD` x
137
137
138-- | Monad instance 'return' function
138-- | Monad instance 'return' function
139−returnD :: forall a . (Enum a, FLN () a, Countable a) => a -> Dist a
139+returnD :: forall a . (Enum a, FromListsN () a, Countable a) => a -> Dist a
140returnD a = D (col l)
140returnD a = D (col l)
141 where
141 where
142 i = fromInteger $ natVal (Proxy :: Proxy (Count a))
142 i = fromInteger $ natVal (Proxy :: Proxy (Count a))
@@ -151,7 +151,7 @@ bindD (D d) m = D (m `comp` d)
151(??) ::
151(??) ::
152 ( Enum a,
152 ( Enum a,
153 Countable a,
153 Countable a,
154− FLN () a
154+ FromListsN () a
155 ) => (a -> Bool) -> Dist a -> Prob
155 ) => (a -> Bool) -> Dist a -> Prob
156(??) p d =
156(??) p d =
157 let l = toValues d
157 let l = toValues d
@@ -161,11 +161,11 @@ bindD (D d) m = D (m `comp` d)
161-- Distribution Construction
161-- Distribution Construction
162
162
163-- | Constructs a Bernoulli distribution
163-- | Constructs a Bernoulli distribution
164−choose :: (FLN () a) => Prob -> Dist a
164+choose :: (FromListsN () a) => Prob -> Dist a
165choose prob = D (col [prob, 1 - prob])
165choose prob = D (col [prob, 1 - prob])
166
166
167-- | Creates a distribution given a shape function
167-- | Creates a distribution given a shape function
168−shape :: (FLN () a) => (Prob -> Prob) -> [a] -> Dist a
168+shape :: (FromListsN () a) => (Prob -> Prob) -> [a] -> Dist a
169shape _ [] = error "Probability.shape: empty list"
169shape _ [] = error "Probability.shape: empty list"
170shape f xs =
170shape f xs =
171 let incr = 1 / fromIntegral (length xs - 1)
171 let incr = 1 / fromIntegral (length xs - 1)
@@ -173,23 +173,23 @@ shape f xs =
173 in fromFreqs (zip xs ps)
173 in fromFreqs (zip xs ps)
174
174
175-- | Constructs a Linear distribution
175-- | Constructs a Linear distribution
176−linear :: (FLN () a) => [a] -> Dist a
176+linear :: (FromListsN () a) => [a] -> Dist a
177linear = shape id
177linear = shape id
178
178
179-- | Constructs an Uniform distribution
179-- | Constructs an Uniform distribution
180−uniform :: (FLN () a) => [a] -> Dist a
180+uniform :: (FromListsN () a) => [a] -> Dist a
181uniform = shape (const 1)
181uniform = shape (const 1)
182
182
183-- | Constructs an Negative Exponential distribution
183-- | Constructs an Negative Exponential distribution
184−negExp :: (FLN () a) => [a] -> Dist a
184+negExp :: (FromListsN () a) => [a] -> Dist a
185negExp = shape (\x -> exp (-x))
185negExp = shape (\x -> exp (-x))
186
186
187-- | Constructs an Normal distribution
187-- | Constructs an Normal distribution
188−normal :: (FLN () a) => [a] -> Dist a
188+normal :: (FromListsN () a) => [a] -> Dist a
189normal = shape (normalCurve 0.5 0.5)
189normal = shape (normalCurve 0.5 0.5)
190
190
191-- | Transforms a 'Dist' into a list of pairs.
191-- | Transforms a 'Dist' into a list of pairs.
192−toValues :: forall a . (Enum a, Countable a, FLN () a) => Dist a -> [(a, Prob)]
192+toValues :: forall a . (Enum a, Countable a, FromListsN () a) => Dist a -> [(a, Prob)]
193toValues (D d) =
193toValues (D d) =
194 let rows = fromInteger (natVal (Proxy :: Proxy (Count a)))
194 let rows = fromInteger (natVal (Proxy :: Proxy (Count a)))
195 probs = toList d
195 probs = toList d
@@ -197,7 +197,7 @@ toValues (D d) =
197 in res
197 in res
198
198
199-- | Pretty a distribution
199-- | Pretty a distribution
200−prettyDist :: forall a. (Show a, Enum a, Countable a, FLN () a) => Dist a -> String
200+prettyDist :: forall a. (Show a, Enum a, Countable a, FromListsN () a) => Dist a -> String
201prettyDist d =
201prettyDist d =
202 let values = sortBy (\(a, p1) (b, p2) -> compare p2 p1) (toValues @a d)
202 let values = sortBy (\(a, p1) (b, p2) -> compare p2 p1) (toValues @a d)
203 w = maximum (map (length . show . fst) values)
203 w = maximum (map (length . show . fst) values)
@@ -209,12 +209,12 @@ prettyDist d =
209 showR n x = show x ++ " "
209 showR n x = show x ++ " "
210
210
211-- | Pretty Print a distribution
211-- | Pretty Print a distribution
212−prettyPrintDist :: forall a . (Show a, Enum a, Countable a, FLN () a) => Dist a -> IO ()
212+prettyPrintDist :: forall a . (Show a, Enum a, Countable a, FromListsN () a) => Dist a -> IO ()
213prettyPrintDist = putStrLn . prettyDist @a
213prettyPrintDist = putStrLn . prettyDist @a
214
214
215-- Auxiliary functions
215-- Auxiliary functions
216
216
217−fromFreqs :: (FLN () a) => [(a,Prob)] -> Dist a
217+fromFreqs :: (FromListsN () a) => [(a,Prob)] -> Dist a
218fromFreqs xs = D (col (map (\(x,p) -> p/q) xs))
218fromFreqs xs = D (col (map (\(x,p) -> p/q) xs))
219 where q = sum $ map snd xs
219 where q = sum $ map snd xs
220
220
src/LAoP/Matrix/Alternative.hsnew file+954
@@ -0,0 +1,954 @@
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+ Construct
164+ )
165+ where
166+
167+import LAoP.Utils.Internal
168+import Data.Bool
169+import Data.Functor.Contravariant
170+import Data.Kind
171+import Data.List
172+import Data.Maybe
173+import Data.Proxy
174+import Data.Void
175+import GHC.TypeLits
176+import Data.Type.Equality
177+import GHC.Generics
178+import Control.DeepSeq
179+import Prelude hiding (id, (.))
180+
181+-- | LAoP (Linear Algebra of Programming) Inductive Matrix definition.
182+data Matrix e cols rows where
183+ Empty :: Matrix e Void Void
184+ One :: e -> Matrix e () ()
185+ Join :: Matrix e a rows -> Matrix e b rows -> Matrix e (Either a b) rows
186+ Fork :: Matrix e cols a -> Matrix e cols b -> Matrix e cols (Either a b)
187+
188+deriving instance (Show e) => Show (Matrix e cols rows)
189+
190+-- | Type family that computes the cardinality of a given type dimension.
191+--
192+-- It can also count the cardinality of custom types that implement the
193+-- 'Generic' instance.
194+type family Count (d :: Type) :: Nat where
195+ Count (Natural n m) = (m - n) + 1
196+ Count (List a) = (^) 2 (Count a)
197+ Count (Either a b) = (+) (Count a) (Count b)
198+ Count (a, b) = (*) (Count a) (Count b)
199+ Count (a -> b) = (^) (Count b) (Count a)
200+ -- Generics
201+ Count (M1 _ _ f p) = Count (f p)
202+ Count (K1 _ _ _) = 1
203+ Count (V1 _) = 0
204+ Count (U1 _) = 1
205+ Count ((:*:) a b p) = Count (a p) * Count (b p)
206+ Count ((:+:) a b p) = Count (a p) + Count (b p)
207+ Count d = Count (Rep d R)
208+
209+-- | Type family that computes of a given type dimension from a given natural
210+--
211+-- Thanks to Li-Yao Xia this type family is super fast.
212+type family FromNat (n :: Nat) :: Type where
213+ FromNat 0 = Void
214+ FromNat 1 = ()
215+ FromNat n = FromNat' (Mod n 2 == 0) (FromNat (Div n 2))
216+
217+type family FromNat' (b :: Bool) (m :: Type) :: Type where
218+ FromNat' 'True m = Either m m
219+ FromNat' 'False m = Either () (Either m m)
220+
221+-- | Type family that normalizes the representation of a given data
222+-- structure
223+type family Normalize (d :: Type) :: Type where
224+ Normalize (Either a b) = Either (Normalize a) (Normalize b)
225+ Normalize d = FromNat (Count d)
226+
227+-- | Constraint type synonyms to keep the type signatures less convoluted
228+type Countable a = KnownNat (Count a)
229+type CountableDimensions a b = (Countable a, Countable b)
230+type Liftable a b = (Eq b, Constructable a b, Enumerable a)
231+type Enumerable a = (Enum a, Bounded a)
232+type ConstructNorm a = (Enum a, Enum (Normalize a))
233+type ConstructableNorm a b = (ConstructNorm a, ConstructNorm b)
234+type ConstructN a = Construct (Normalize a)
235+type Constructable a b = (Construct a, Construct b)
236+type ConstructableN a b = (Construct (Normalize a), Construct (Normalize b))
237+
238+-- | It isn't possible to implement the 'id' function so it's
239+-- implementation is 'undefined'. However 'comp' can be and this partial
240+-- class implementation exists just to make the code more readable.
241+--
242+-- Please use 'iden' instead.
243+instance (Num e) => Category (Matrix e) where
244+ type Object (Matrix e) a = Liftable a a
245+ id = iden
246+ (.) = comp
247+
248+instance NFData e => NFData (Matrix e cols rows) where
249+ rnf Empty = ()
250+ rnf (One e) = rnf e
251+ rnf (Join a b) = rnf a `seq` rnf b
252+ rnf (Fork a b) = rnf a `seq` rnf b
253+
254+instance Eq e => Eq (Matrix e cols rows) where
255+ Empty == Empty = True
256+ (One a) == (One b) = a == b
257+ (Join a b) == (Join c d) = a == c && b == d
258+ (Fork a b) == (Fork c d) = a == c && b == d
259+ x@(Fork _ _) == y@(Join _ _) = x == abideJF y
260+ x@(Join _ _) == y@(Fork _ _) = abideJF x == y
261+
262+instance Num e => Num (Matrix e cols rows) where
263+
264+ a + b = zipWithM (+) a b
265+
266+ a - b = zipWithM (-) a b
267+
268+ a * b = zipWithM (*) a b
269+
270+ abs Empty = Empty
271+ abs (One a) = One (abs a)
272+ abs (Join a b) = Join (abs a) (abs b)
273+ abs (Fork a b) = Fork (abs a) (abs b)
274+
275+ signum Empty = Empty
276+ signum (One a) = One (signum a)
277+ signum (Join a b) = Join (signum a) (signum b)
278+ signum (Fork a b) = Fork (signum a) (signum b)
279+
280+instance Ord e => Ord (Matrix e cols rows) where
281+ Empty <= Empty = True
282+ (One a) <= (One b) = a <= b
283+ (Join a b) <= (Join c d) = (a <= c) && (b <= d)
284+ (Fork a b) <= (Fork c d) = (a <= c) && (b <= d)
285+ x@(Fork _ _) <= y@(Join _ _) = x <= abideJF y
286+ x@(Join _ _) <= y@(Fork _ _) = abideJF x <= y
287+
288+-- Primitives
289+
290+-- | Empty matrix constructor
291+empty :: Matrix e Void Void
292+empty = Empty
293+
294+-- | Unit matrix constructor
295+one :: e -> Matrix e () ()
296+one = One
297+
298+-- | Matrix 'Join' constructor
299+join :: Matrix e a rows -> Matrix e b rows -> Matrix e (Either a b) rows
300+join = Join
301+
302+infixl 3 |||
303+
304+-- | Matrix 'Join' constructor
305+(|||) :: Matrix e a rows -> Matrix e b rows -> Matrix e (Either a b) rows
306+(|||) = Join
307+
308+-- | Matrix 'Fork' constructor
309+fork :: Matrix e cols a -> Matrix e cols b -> Matrix e cols (Either a b)
310+fork = Fork
311+
312+infixl 2 ===
313+
314+-- | Matrix 'Fork' constructor
315+(===) :: Matrix e cols a -> Matrix e cols b -> Matrix e cols (Either a b)
316+(===) = Fork
317+
318+-- Construction
319+
320+-- | Constructs a column vector matrix
321+colL :: (FromLists e () rows) => [e] -> Matrix e () rows
322+colL = fromLists . map (: [])
323+
324+-- | Constructs a row vector matrix
325+rowL :: (FromLists e cols ()) => [e] -> Matrix e cols ()
326+rowL = fromLists . (: [])
327+
328+-- Conversion
329+
330+-- | Converts a matrix to a list of lists of elements.
331+toLists :: Matrix e cols rows -> [[e]]
332+toLists Empty = []
333+toLists (One e) = [[e]]
334+toLists (Fork l r) = toLists l ++ toLists r
335+toLists (Join l r) = zipWith (++) (toLists l) (toLists r)
336+
337+-- | Converts a matrix to a list of elements.
338+toList :: Matrix e cols rows -> [e]
339+toList = concat . toLists
340+
341+-- Zeros Matrix
342+
343+-- | The zero matrix. A matrix wholly filled with zeros.
344+zeros :: (Num e, Constructable cols rows, Enumerable cols) => Matrix e cols rows
345+zeros = matrixBuilder (const 0)
346+
347+-- Ones Matrix
348+
349+-- | The ones matrix. A matrix wholly filled with ones.
350+--
351+-- Also known as T (Top) matrix.
352+ones :: (Num e, Constructable cols rows, Enumerable cols) => Matrix e cols rows
353+ones = matrixBuilder (const 1)
354+
355+-- Const Matrix
356+
357+-- | The constant matrix constructor. A matrix wholly filled with a given
358+-- value.
359+constant :: (Num e, Constructable cols rows, Enumerable cols) => e -> Matrix e cols rows
360+constant e = matrixBuilder (const e)
361+
362+-- Bang Matrix
363+
364+-- | The T (Top) row vector matrix.
365+bang :: (Num e, Constructable cols rows, Enumerable cols) => Matrix e cols ()
366+bang = ones
367+
368+-- | Point constant matrix
369+point :: (Num e, Liftable () a) => a -> Matrix e () a
370+point = fromF . const
371+
372+-- iden Matrix
373+
374+-- | iden matrix.
375+iden :: (Num e, Liftable cols cols) => Matrix e cols cols
376+iden = fromF id
377+
378+-- Matrix composition (MMM)
379+
380+-- | Matrix composition. Equivalent to matrix-matrix multiplication.
381+--
382+-- This definition takes advantage of divide-and-conquer and fusion laws
383+-- from LAoP.
384+comp :: (Num e) => Matrix e cr rows -> Matrix e cols cr -> Matrix e cols rows
385+comp Empty Empty = Empty
386+comp (One a) (One b) = One (a * b)
387+comp (Join a b) (Fork c d) = comp a c + comp b d -- Divide-and-conquer law
388+comp (Fork a b) c = Fork (comp a c) (comp b c) -- Fork fusion law
389+comp c (Join a b) = Join (comp c a) (comp c b) -- Join fusion law
390+{-# NOINLINE comp #-}
391+{-# RULES
392+ "comp/iden1" forall m. comp m iden = m ;
393+ "comp/iden2" forall m. comp iden m = m
394+#-}
395+
396+-- Scalar multiplication of matrices
397+
398+infixl 7 .|
399+-- | Scalar multiplication of matrices.
400+(.|) :: Num e => e -> Matrix e cols rows -> Matrix e cols rows
401+(.|) _ Empty = Empty
402+(.|) e (One a) = One (e * a)
403+(.|) e (Join a b) = Join (e .| a) (e .| b)
404+(.|) e (Fork a b) = Fork (e .| a) (e .| b)
405+
406+-- Scalar division of matrices
407+
408+infixl 7 ./
409+-- | Scalar multiplication of matrices.
410+(./) :: Fractional e => Matrix e cols rows -> e -> Matrix e cols rows
411+(./) Empty _ = Empty
412+(./) (One a) e = One (a / e)
413+(./) (Join a b) e = Join (a ./ e) (b ./ e)
414+(./) (Fork a b) e = Fork (a ./ e) (b ./ e)
415+
416+-- Projections
417+
418+-- | Biproduct first component projection
419+p1 :: (Num e, Eq m, Constructable m n, Enumerable m, Enumerable n) => Matrix e (Either m n) m
420+p1 = join iden zeros
421+
422+-- | Biproduct second component projection
423+p2 :: (Num e, Eq n, Constructable m n, Enumerable m, Enumerable n) => Matrix e (Either m n) n
424+p2 = join zeros iden
425+
426+-- Injections
427+
428+-- | Biproduct first component injection
429+i1 :: (Num e, Eq m, Constructable m n, Enumerable m, Enumerable n) => Matrix e m (Either m n)
430+i1 = tr p1
431+
432+-- | Biproduct second component injection
433+i2 :: (Num e, Eq n, Constructable m n, Enumerable m, Enumerable n) => Matrix e n (Either m n)
434+i2 = tr p2
435+
436+-- Dimensions
437+
438+-- | Obtain the number of rows.
439+--
440+-- NOTE: The 'KnownNat' constaint is needed in order to obtain the
441+-- dimensions in constant time.
442+--
443+-- TODO: A 'rows' function that does not need the 'KnownNat' constraint in
444+-- exchange for performance.
445+rows :: forall e cols rows. (Countable rows) => Matrix e cols rows -> Int
446+rows _ = fromInteger $ natVal (Proxy :: Proxy (Count rows))
447+
448+-- | Obtain the number of columns.
449+--
450+-- NOTE: The 'KnownNat' constaint is needed in order to obtain the
451+-- dimensions in constant time.
452+--
453+-- TODO: A 'columns' function that does not need the 'KnownNat' constraint in
454+-- exchange for performance.
455+columns :: forall e cols rows. (Countable cols) => Matrix e cols rows -> Int
456+columns _ = fromInteger $ natVal (Proxy :: Proxy (Count cols))
457+
458+-- Coproduct Bifunctor
459+
460+infixl 5 -|-
461+
462+-- | Matrix coproduct functor also known as matrix direct sum.
463+(-|-) ::
464+ ( Num e,
465+ Eq k,
466+ Eq j,
467+ Constructable k j,
468+ Enumerable k,
469+ Enumerable j
470+ ) => Matrix e n k -> Matrix e m j -> Matrix e (Either n m) (Either k j)
471+(-|-) a b = Join (i1 . a) (i2 . b)
472+
473+-- Khatri Rao Product and projections
474+
475+-- | Khatri Rao product first component projection matrix.
476+fstM ::
477+ forall e a b .
478+ ( Num e,
479+ Eq a,
480+ ConstructableN (a, b) a,
481+ ConstructableNorm (a, b) a,
482+ Enumerable a,
483+ Enumerable b
484+ ) => Matrix e (Normalize (a, b)) (Normalize a)
485+fstM = fromFN (fst :: (a, b) -> a)
486+
487+-- | Khatri Rao product second component projection matrix.
488+sndM ::
489+ forall e a b .
490+ ( Num e,
491+ Eq b,
492+ ConstructableN (a, b) b,
493+ ConstructableNorm (a, b) b,
494+ Enumerable a,
495+ Enumerable b
496+ ) => Matrix e (Normalize (a, b)) (Normalize b)
497+sndM = fromFN (snd :: (a, b) -> b)
498+
499+-- | Khatri Rao Matrix product also known as matrix pairing.
500+--
501+-- NOTE: That this is not a true categorical product, see for instance:
502+--
503+-- @
504+-- | fstM . kr a b == a
505+-- kr a b ==> |
506+-- | sndM . kr a b == b
507+-- @
508+--
509+-- __Emphasis__ on the implication symbol.
510+kr ::
511+ forall e cols a b .
512+ ( Num e,
513+ Eq a,
514+ Eq b,
515+ ConstructableN a (a, b),
516+ ConstructN b,
517+ ConstructableNorm a b,
518+ ConstructNorm (a, b),
519+ Enumerable a,
520+ Enumerable b
521+ ) => Matrix e cols (Normalize a) -> Matrix e cols (Normalize b) -> Matrix e cols (Normalize (a, b))
522+kr a b =
523+ let fstM' = fstM @e @a @b
524+ sndM' = sndM @e @a @b
525+ in (tr fstM' . a) * (tr sndM' . b)
526+
527+-- Product Bifunctor (Kronecker)
528+
529+infixl 4 ><
530+
531+type Kronecker e m n p q =
532+ ( Num e,
533+ Eq m,
534+ Eq n,
535+ Eq p,
536+ Eq q,
537+ ConstructableN m n,
538+ ConstructableNorm m (m, n),
539+ ConstructNorm n,
540+ ConstructN (m, n),
541+ ConstructableN p q,
542+ ConstructableNorm p (p, q),
543+ ConstructNorm q,
544+ ConstructN (p, q),
545+ Enumerable m,
546+ Enumerable n,
547+ Enumerable p,
548+ Enumerable q
549+ )
550+
551+-- | Matrix product functor also known as kronecker product
552+(><) ::
553+ forall e m p n q .
554+ Kronecker e m n p q
555+ => Matrix e (Normalize m) (Normalize p)
556+ -> Matrix e (Normalize n) (Normalize q)
557+ -> Matrix e (Normalize (m, n)) (Normalize (p, q))
558+(><) a b =
559+ let fstM' = fstM @e @m @n
560+ sndM' = sndM @e @m @n
561+ in kr @e @(Normalize (m, n)) @p @q (a . fstM') (b . sndM')
562+
563+-- Matrix abide Join Fork
564+
565+-- | Matrix "abiding" following the 'Join'-'Fork' exchange law.
566+--
567+-- Law:
568+--
569+-- @
570+-- 'Join' ('Fork' a c) ('Fork' b d) == 'Fork' ('Join' a b) ('Join' c d)
571+-- @
572+abideJF :: Matrix e cols rows -> Matrix e cols rows
573+abideJF (Join (Fork a c) (Fork b d)) = Fork (Join (abideJF a) (abideJF b)) (Join (abideJF c) (abideJF d)) -- Join-Fork abide law
574+abideJF Empty = Empty
575+abideJF (One e) = One e
576+abideJF (Join a b) = Join (abideJF a) (abideJF b)
577+abideJF (Fork a b) = Fork (abideJF a) (abideJF b)
578+
579+-- Matrix abide Fork Join
580+
581+-- | Matrix "abiding" followin the 'Fork'-'Join' abide law.
582+--
583+-- @
584+-- 'Fork' ('Join' a b) ('Join' c d) == 'Join' ('Fork' a c) ('Fork' b d)
585+-- @
586+abideFJ :: Matrix e cols rows -> Matrix e cols rows
587+abideFJ (Fork (Join a b) (Join c d)) = Join (Fork (abideFJ a) (abideFJ c)) (Fork (abideFJ b) (abideFJ d)) -- Fork-Join abide law
588+abideFJ Empty = Empty
589+abideFJ (One e) = One e
590+abideFJ (Join a b) = Join (abideFJ a) (abideFJ b)
591+abideFJ (Fork a b) = Fork (abideFJ a) (abideFJ b)
592+
593+-- Matrix transposition
594+
595+-- | Matrix transposition.
596+tr :: Matrix e cols rows -> Matrix e rows cols
597+tr Empty = Empty
598+tr (One e) = One e
599+tr (Join a b) = Fork (tr a) (tr b)
600+tr (Fork a b) = Join (tr a) (tr b)
601+
602+-- Selective 'select' operator
603+
604+-- | Selective functors 'select' operator equivalent inspired by the
605+-- ArrowMonad solution presented in the paper.
606+select :: (Num e, Liftable b b) => Matrix e cols (Either a b) -> Matrix e a b -> Matrix e cols b
607+select (Fork a b) y = y . a + b -- Divide-and-conquer law
608+select (Join (Fork a c) (Fork b d)) y = join (y . a + c) (y . b + d) -- Pattern matching + DnC law
609+select m y = join y id . m
610+
611+branch ::
612+ ( Num e,
613+ Eq a,
614+ Eq b,
615+ Eq c,
616+ Constructable a b,
617+ Construct c,
618+ Enumerable a,
619+ Enumerable b,
620+ Enumerable c
621+ )
622+ => Matrix e cols (Either a b) -> Matrix e a c -> Matrix e b c -> Matrix e cols c
623+branch x l r = f x `select` g l `select` r
624+ where
625+ f m = fork (tr i1) (i1 . tr i2) . m
626+ g m = i2 . m
627+
628+-- Pretty print
629+
630+prettyAux :: Show e => [[e]] -> [[e]] -> String
631+prettyAux [] _ = ""
632+prettyAux [[e]] m = "│ " ++ fill (show e) ++ " │\n"
633+ where
634+ v = fmap show m
635+ widest = maximum $ fmap length v
636+ fill str = replicate (widest - length str - 2) ' ' ++ str
637+prettyAux [h] m = "│ " ++ fill (unwords $ map show h) ++ " │\n"
638+ where
639+ v = fmap show m
640+ widest = maximum $ fmap length v
641+ fill str = replicate (widest - length str - 2) ' ' ++ str
642+prettyAux (h : t) l = "│ " ++ fill (unwords $ map show h) ++ " │\n" ++
643+ prettyAux t l
644+ where
645+ v = fmap show l
646+ widest = maximum $ fmap length v
647+ fill str = replicate (widest - length str - 2) ' ' ++ str
648+
649+-- | Matrix pretty printer
650+pretty :: (CountableDimensions cols rows, Show e) => Matrix e cols rows -> String
651+pretty m = concat
652+ [ "┌ ", unwords (replicate (columns m) blank), " ┐\n"
653+ , unlines
654+ [ "│ " ++ unwords (fmap (\j -> fill $ show $ getElem i j m) [1..columns m]) ++ " │" | i <- [1..rows m] ]
655+ , "└ ", unwords (replicate (columns m) blank), " ┘"
656+ ]
657+ where
658+ strings = map show (toList m)
659+ widest = maximum $ map length strings
660+ fill str = replicate (widest - length str) ' ' ++ str
661+ blank = fill ""
662+ safeGet i j m
663+ | i > rows m || j > columns m || i < 1 || j < 1 = Nothing
664+ | otherwise = Just $ unsafeGet i j m (toList m)
665+ unsafeGet i j m l = l !! encode (columns m) (i,j)
666+ encode m (i,j) = (i-1)*m + j - 1
667+ getElem i j m =
668+ fromMaybe
669+ (error $
670+ "getElem: Trying to get the "
671+ ++ show (i, j)
672+ ++ " element from a "
673+ ++ show (rows m) ++ "x" ++ show (columns m)
674+ ++ " matrix."
675+ )
676+ (safeGet i j m)
677+
678+-- | Matrix pretty printer
679+prettyPrint :: (CountableDimensions cols rows, Show e) => Matrix e cols rows -> IO ()
680+prettyPrint = putStrLn . pretty
681+
682+-- | Zip two matrices with a given binary function
683+zipWithM :: (e -> f -> g) -> Matrix e cols rows -> Matrix f cols rows -> Matrix g cols rows
684+zipWithM _ Empty Empty = Empty
685+zipWithM f (One a) (One b) = One (f a b)
686+zipWithM f (Join a b) (Join c d) = Join (zipWithM f a c) (zipWithM f b d)
687+zipWithM f (Fork a b) (Fork c d) = Fork (zipWithM f a c) (zipWithM f b d)
688+zipWithM f x@(Fork _ _) y@(Join _ _) = zipWithM f x (abideJF y)
689+zipWithM f x@(Join _ _) y@(Fork _ _) = zipWithM f (abideJF x) y
690+
691+-- Relational operators functions
692+
693+type Boolean = Natural 0 1
694+type Relation a b = Matrix Boolean a b
695+
696+-- | Helper conversion function
697+toBool :: (Num e, Eq e) => e -> Bool
698+toBool n
699+ | n == 0 = False
700+ | n == 1 = True
701+
702+-- | Helper conversion function
703+fromBool :: Bool -> Natural 0 1
704+fromBool True = nat 1
705+fromBool False = nat 0
706+
707+-- | Relational negation
708+negateM :: Relation cols rows -> Relation cols rows
709+negateM Empty = Empty
710+negateM (One (Nat p)) = One (Nat (negate p))
711+negateM (Join a b) = Join (negateM a) (negateM b)
712+negateM (Fork a b) = Fork (negateM a) (negateM b)
713+
714+-- | Relational addition
715+orM :: Relation cols rows -> Relation cols rows -> Relation cols rows
716+orM Empty Empty = Empty
717+orM (One a) (One b) = One (fromBool (toBool a || toBool b))
718+orM (Join a b) (Join c d) = Join (orM a c) (orM b d)
719+orM (Fork a b) (Fork c d) = Fork (orM a c) (orM b d)
720+orM x@(Fork _ _) y@(Join _ _) = orM x (abideJF y)
721+orM x@(Join _ _) y@(Fork _ _) = orM (abideJF x) y
722+
723+-- | Relational multiplication
724+andM :: Relation cols rows -> Relation cols rows -> Relation cols rows
725+andM Empty Empty = Empty
726+andM (One a) (One b) = One (fromBool (toBool a && toBool b))
727+andM (Join a b) (Join c d) = Join (andM a c) (andM b d)
728+andM (Fork a b) (Fork c d) = Fork (andM a c) (andM b d)
729+andM x@(Fork _ _) y@(Join _ _) = andM x (abideJF y)
730+andM x@(Join _ _) y@(Fork _ _) = andM (abideJF x) y
731+
732+-- | Relational subtraction
733+subM :: Relation cols rows -> Relation cols rows -> Relation cols rows
734+subM Empty Empty = Empty
735+subM (One a) (One b) = if a - b < nat 0 then One (nat 0) else One (a - b)
736+subM (Join a b) (Join c d) = Join (subM a c) (subM b d)
737+subM (Fork a b) (Fork c d) = Fork (subM a c) (subM b d)
738+subM x@(Fork _ _) y@(Join _ _) = subM x (abideJF y)
739+subM x@(Join _ _) y@(Fork _ _) = subM (abideJF x) y
740+
741+-- | Matrix relational composition.
742+compRel :: Relation cr rows -> Relation cols cr -> Relation cols rows
743+compRel Empty Empty = Empty
744+compRel (One a) (One b) = One (fromBool (toBool a && toBool b))
745+compRel (Join a b) (Fork c d) = orM (compRel a c) (compRel b d) -- Divide-and-conquer law
746+compRel (Fork a b) c = Fork (compRel a c) (compRel b c) -- Fork fusion law
747+compRel c (Join a b) = Join (compRel c a) (compRel c b) -- Join fusion law
748+
749+-- | Matrix relational right division
750+divR :: Relation b c -> Relation b a -> Relation a c
751+divR Empty Empty = Empty
752+divR (One a) (One b) = One (fromBool (not (toBool b) || toBool a)) -- b implies a
753+divR (Join a b) (Join c d) = andM (divR a c) (divR b d)
754+divR (Fork a b) c = Fork (divR a c) (divR b c)
755+divR c (Fork a b) = Join (divR c a) (divR c b)
756+
757+-- | Matrix relational left division
758+divL :: Relation c b -> Relation a b -> Relation a c
759+divL x y = tr (divR (tr y) (tr x))
760+
761+-- | Matrix relational symmetric division
762+divS :: Relation c a -> Relation b a -> Relation c b
763+divS s r = divL r s `intersection` divR (tr r) (tr s)
764+ where
765+ intersection = andM
766+
767+-- | Lifts functions to relations with dimensions matching @a@ and @b@
768+-- cardinality's.
769+fromFRelN ::
770+ ( Eq b,
771+ ConstructableNorm a b,
772+ ConstructableN a b,
773+ Enumerable a
774+ )
775+ => (a -> b) -> Relation (Normalize a) (Normalize b)
776+fromFRelN = fromFN
777+
778+-- | Lifts a relation function to a Boolean Matrix
779+toRelN ::
780+ ( ConstructableN a b,
781+ ConstructableNorm a b,
782+ Enumerable a
783+ )
784+ => (a -> b -> Bool) -> Relation (Normalize a) (Normalize b)
785+toRelN f = matrixBuilderN (\a -> if uncurry f a then 1 else 0)
786+
787+----------------------------- Linear map semantics -----------------------------
788+newtype Vector e a = Vector { at :: a -> e }
789+
790+instance Contravariant (Vector e) where
791+ contramap f (Vector g) = Vector (g . f)
792+
793+instance Num e => Num (Vector e a) where
794+ fromInteger = Vector . const . fromInteger
795+
796+ (+) = liftV2 (+)
797+ (-) = liftV2 (-)
798+ (*) = liftV2 (*)
799+ abs = liftV1 abs
800+ negate = liftV1 negate
801+ signum = error "No sensible definition"
802+
803+liftV1 :: (e -> e) -> Vector e a -> Vector e a
804+liftV1 f x = Vector (f . at x)
805+
806+liftV2 :: (e -> e -> e) -> Vector e a -> Vector e a -> Vector e a
807+liftV2 f x y = Vector (\a -> f (at x a) (at y a))
808+
809+-- Semantics of Matrix e a b
810+type LinearMap e a b = Vector e a -> Vector e b
811+
812+semantics :: Num e => Matrix e a b -> LinearMap e a b
813+semantics m = case m of
814+ Empty -> id
815+ One e -> const (Vector (const e))
816+ Join x y -> \v -> semantics x (Left >$< v) + semantics y (Right >$< v)
817+ Fork x y -> \v -> Vector $ either (at (semantics x v)) (at (semantics y v))
818+
819+padLeft :: Num e => Vector e b -> Vector e (Either a b)
820+padLeft v = Vector $ \case Left _ -> 0
821+ Right b -> at v b
822+
823+padRight :: Num e => Vector e a -> Vector e (Either a b)
824+padRight v = Vector $ \case Left a -> at v a
825+ Right _ -> 0
826+
827+dot :: (Num e, Enumerable a) => Vector e a -> Vector e a -> e
828+dot x y = sum [ at x a * at y a | a <- enumerate ]
829+
830+--------------------------------- Construction ---------------------------------
831+
832+class Construct a where
833+ row :: Num e => Vector e a -> Matrix e a ()
834+
835+ linearMap :: (Construct b, Num e) => LinearMap e a b -> Matrix e a b
836+
837+instance Construct () where
838+ row v = one (at v ())
839+
840+ linearMap m = col (m 1)
841+
842+instance (Constructable a b) => Construct (Either a b) where
843+ row v = row (Left >$< v) ||| row (Right >$< v)
844+
845+ linearMap m = linearMap (m . padRight) ||| linearMap (m . padLeft)
846+
847+col :: (Construct a, Num e) => Vector e a -> Matrix e () a
848+col = tr . row
849+
850+-- | Matrix builder function. Constructs a matrix provided with
851+-- a construction function that operates with canonical types.
852+matrixBuilder :: (Num e, Constructable a b, Enumerable a) => ((a, b) -> e) -> Matrix e a b
853+matrixBuilder f = linearMap $ \v -> Vector $ \b -> dot v $ Vector $ \a -> f (a, b)
854+
855+-- | Lifts functions to matrices.
856+fromF :: (Num e, Liftable a b) => (a -> b) -> Matrix e a b
857+fromF f = matrixBuilder (\(a, b) -> if f a == b then 1 else 0)
858+
859+-------------------------------- Deconstruction --------------------------------
860+enumerate :: Enumerable a => [a]
861+enumerate = [minBound .. maxBound]
862+
863+basis :: (Enumerable a, Eq a, Num e) => [Vector e a]
864+basis = [ Vector (bool 0 1 . (==a)) | a <- enumerate ]
865+
866+toLists' :: (Enumerable a, Enumerable b, Eq a, Num e) => Matrix e a b -> [[e]]
867+toLists' m = transpose
868+ [ [ at r i | i <- enumerate ] | c <- basis, let r = semantics m c ]
869+
870+dump :: (Enumerable a, Enumerable b, Eq a, Num e, Show e) => Matrix e a b -> IO ()
871+dump = mapM_ print . toLists'
872+
873+------------------------------- Normalised types -------------------------------
874+class Profunctor p where
875+ dimap :: (a -> b) -> (c -> d) -> p b c -> p a d
876+
877+instance Profunctor (->) where
878+ dimap f g h = g . h . f
879+
880+toNorm :: ConstructNorm a => a -> Normalize a
881+toNorm = toEnum . fromEnum
882+
883+fromNorm :: ConstructNorm a => Normalize a -> a
884+fromNorm = toEnum . fromEnum
885+
886+rowN :: (ConstructN a, ConstructNorm a, Num e) => Vector e a -> Matrix e (Normalize a) ()
887+rowN = row . contramap fromNorm
888+
889+linearMapN :: (ConstructableN a b, ConstructableNorm a b, Num e)
890+ => LinearMap e a b -> Matrix e (Normalize a) (Normalize b)
891+linearMapN = linearMap . dimap (contramap toNorm) (contramap fromNorm)
892+
893+colN :: (ConstructN a, ConstructNorm a, Num e) => Vector e a -> Matrix e () (Normalize a)
894+colN = tr . rowN
895+
896+-- | Matrix builder function. Constructs a matrix provided with
897+-- a construction function that operates with arbitrary types.
898+matrixBuilderN :: (Num e, ConstructableN a b, ConstructableNorm a b, Enumerable a)
899+ => ((a, b) -> e) -> Matrix e (Normalize a) (Normalize b)
900+matrixBuilderN f = linearMapN $ \v -> Vector $ \b -> dot v $ Vector $ \a -> f (a, b)
901+
902+-- | Lifts functions to matrices with dimensions matching @a@ and @b@
903+-- cardinality's.
904+fromFN :: (Num e, Eq b, ConstructableN a b, ConstructableNorm a b, Enumerable a)
905+ => (a -> b) -> Matrix e (Normalize a) (Normalize b)
906+fromFN f = matrixBuilderN (\(a, b) -> if f a == b then 1 else 0)
907+
908+------------------------------- Unsafe fromLists matrix construction -------------------------------
909+
910+-- | Type class for defining the 'fromList' conversion function.
911+--
912+-- Given that it is not possible to branch on types at the term level type
913+-- classes are needed very much like an inductive definition but on types.
914+class FromLists e cols rows where
915+ -- | Build a matrix out of a list of list of elements. Throws a runtime
916+ -- error if the dimensions do not match.
917+ fromLists :: [[e]] -> Matrix e cols rows
918+
919+instance FromLists e Void Void where
920+ fromLists [] = Empty
921+ fromLists _ = error "Wrong dimensions"
922+
923+instance {-# OVERLAPPING #-} FromLists e () () where
924+ fromLists [[e]] = One e
925+ fromLists _ = error "Wrong dimensions"
926+
927+instance {-# OVERLAPPING #-} (FromLists e cols ()) => FromLists e (Either () cols) () where
928+ fromLists [h : t] = Join (One h) (fromLists [t])
929+ fromLists _ = error "Wrong dimensions"
930+
931+instance {-# OVERLAPPABLE #-} (FromLists e a (), FromLists e b (), Countable a) => FromLists e (Either a b) () where
932+ fromLists [l] =
933+ let rowsA = fromInteger (natVal (Proxy :: Proxy (Count a)))
934+ in Join (fromLists [take rowsA l]) (fromLists [drop rowsA l])
935+ fromLists _ = error "Wrong dimensions"
936+
937+instance {-# OVERLAPPING #-} (FromLists e () rows) => FromLists e () (Either () rows) where
938+ fromLists ([h] : t) = Fork (One h) (fromLists t)
939+ fromLists _ = error "Wrong dimensions"
940+
941+instance {-# OVERLAPPABLE #-} (FromLists e () a, FromLists e () b, Countable a) => FromLists e () (Either a b) where
942+ fromLists l@([_] : _) =
943+ let rowsA = fromInteger (natVal (Proxy :: Proxy (Count a)))
944+ in Fork (fromLists (take rowsA l)) (fromLists (drop rowsA l))
945+ fromLists _ = error "Wrong dimensions"
946+
947+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
948+ fromLists l@(h : t) =
949+ let lh = length h
950+ rowsC = fromInteger (natVal (Proxy :: Proxy (Count c)))
951+ condition = all ((== lh) . length) t
952+ in if lh > 0 && condition
953+ then Fork (fromLists (take rowsC l)) (fromLists (drop rowsC l))
954+ else error "Not all rows have the same length"
src/LAoP/Matrix/Internal.hs+191−130
@@ -30,7 +30,7 @@
30-- motivation behind the library, the underlying theory, and implementation details.
30-- motivation behind the library, the underlying theory, and implementation details.
31--
31--
32-- This module offers many of the combinators mentioned in the work of
32-- This module offers many of the combinators mentioned in the work of
33−-- Macedo (2012) and Oliveira (2012).
33+-- Macedo (2012) and Oliveira (2012).
34--
34--
35-- This is an Internal module and it is no supposed to be imported.
35-- This is an Internal module and it is no supposed to be imported.
36--
36--
@@ -43,23 +43,23 @@ module LAoP.Matrix.Internal
43 --
43 --
44 -- There exists two type families that make it easier to write
44 -- There exists two type families that make it easier to write
45 -- matrix dimensions: 'FromNat' and 'Count'. This approach
45 -- matrix dimensions: 'FromNat' and 'Count'. This approach
46− -- leads to a very straightforward implementation
46+ -- leads to a very straightforward implementation
47− -- of LAoP combinators.
47+ -- of LAoP combinators.
48
48
49 -- * Type safe matrix representation
49 -- * Type safe matrix representation
50 Matrix (..),
50 Matrix (..),
51
51
52 -- * Constraint type aliases
52 -- * Constraint type aliases
53 Countable,
53 Countable,
54− CountableDims,
54+ CountableDimensions,
55 CountableN,
55 CountableN,
56− CountableDimsN,
56+ CountableDimensionsN,
57− FL,
57+ FromListsN,
58− FLN,
59 Liftable,
58 Liftable,
60 Trivial,
59 Trivial,
61
60
62 -- * Primitives
61 -- * Primitives
62+ empty,
63 one,
63 one,
64 join,
64 join,
65 fork,
65 fork,
@@ -86,9 +86,7 @@ module LAoP.Matrix.Internal
86 -- * Misc
86 -- * Misc
87 -- ** Get dimensions
87 -- ** Get dimensions
88 columns,
88 columns,
89− columns',
90 rows,
89 rows,
91− rows',
92
90
93 -- ** Matrix Transposition
91 -- ** Matrix Transposition
94 tr,
92 tr,
@@ -176,7 +174,6 @@ import Data.Kind
176import Data.List
174import Data.List
177import Data.Maybe
175import Data.Maybe
178import Data.Proxy
176import Data.Proxy
179−import Data.Typeable
180import Data.Void
177import Data.Void
181import GHC.TypeLits
178import GHC.TypeLits
182import Data.Type.Equality
179import Data.Type.Equality
@@ -187,6 +184,7 @@ import qualified Prelude (id, (.))
187
184
188-- | LAoP (Linear Algebra of Programming) Inductive Matrix definition.
185-- | LAoP (Linear Algebra of Programming) Inductive Matrix definition.
189data Matrix e cols rows where
186data Matrix e cols rows where
187+ Empty :: Matrix e Void Void
190 One :: e -> Matrix e () ()
188 One :: e -> Matrix e () ()
191 Join :: Matrix e a rows -> Matrix e b rows -> Matrix e (Either a b) rows
189 Join :: Matrix e a rows -> Matrix e b rows -> Matrix e (Either a b) rows
192 Fork :: Matrix e cols a -> Matrix e cols b -> Matrix e cols (Either a b)
190 Fork :: Matrix e cols a -> Matrix e cols b -> Matrix e cols (Either a b)
@@ -216,6 +214,7 @@ type family Count (d :: Type) :: Nat where
216--
214--
217-- Thanks to Li-Yao Xia this type family is super fast.
215-- Thanks to Li-Yao Xia this type family is super fast.
218type family FromNat (n :: Nat) :: Type where
216type family FromNat (n :: Nat) :: Type where
217+ FromNat 0 = Void
219 FromNat 1 = ()
218 FromNat 1 = ()
220 FromNat n = FromNat' (Mod n 2 == 0) (FromNat (Div n 2))
219 FromNat n = FromNat' (Mod n 2 == 0) (FromNat (Div n 2))
221
220
@@ -232,26 +231,27 @@ type family Normalize (d :: Type) :: Type where
232-- | Constraint type synonyms to keep the type signatures less convoluted
231-- | Constraint type synonyms to keep the type signatures less convoluted
233type Countable a = KnownNat (Count a)
232type Countable a = KnownNat (Count a)
234type CountableN a = KnownNat (Count (Normalize a))
233type CountableN a = KnownNat (Count (Normalize a))
235−type CountableDims a b = (Countable a, Countable b)
234+type CountableDimensions a b = (Countable a, Countable b)
236−type CountableDimsN a b = (CountableN a, CountableN b)
235+type CountableDimensionsN a b = (CountableN a, CountableN b)
237−type FL a b = FromLists a b
238−type FLN a b = FromLists (Normalize a) (Normalize b)
236+type FromListsN e a b = FromLists e (Normalize a) (Normalize b)
239type Liftable e a b = (Bounded a, Bounded b, Enum a, Enum b, Eq b, Num e, Ord e)
237type Liftable e a b = (Bounded a, Bounded b, Enum a, Enum b, Eq b, Num e, Ord e)
240type Trivial a = FromNat (Count a) ~ a
238type Trivial a = FromNat (Count a) ~ a
241
239
242-- | It is possible to implement a constrained version of the category type
240-- | It is possible to implement a constrained version of the category type
243-- class.
241-- class.
244instance (Num e) => Category (Matrix e) where
242instance (Num e) => Category (Matrix e) where
245− type Object (Matrix e) a = (FL a a, Countable a)
243+ type Object (Matrix e) a = (FromLists e a a, Countable a)
246− id = iden
244+ id = iden
247 (.) = comp
245 (.) = comp
248
246
249instance NFData e => NFData (Matrix e cols rows) where
247instance NFData e => NFData (Matrix e cols rows) where
248+ rnf Empty = ()
250 rnf (One e) = rnf e
249 rnf (One e) = rnf e
251 rnf (Join a b) = rnf a `seq` rnf b
250 rnf (Join a b) = rnf a `seq` rnf b
252 rnf (Fork a b) = rnf a `seq` rnf b
251 rnf (Fork a b) = rnf a `seq` rnf b
253
252
254instance Eq e => Eq (Matrix e cols rows) where
253instance Eq e => Eq (Matrix e cols rows) where
254+ Empty == Empty = True
255 (One a) == (One b) = a == b
255 (One a) == (One b) = a == b
256 (Join a b) == (Join c d) = a == c && b == d
256 (Join a b) == (Join c d) = a == c && b == d
257 (Fork a b) == (Fork c d) = a == c && b == d
257 (Fork a b) == (Fork c d) = a == c && b == d
@@ -259,21 +259,25 @@ instance Eq e => Eq (Matrix e cols rows) where
259 x@(Join _ _) == y@(Fork _ _) = abideJF x == y
259 x@(Join _ _) == y@(Fork _ _) = abideJF x == y
260
260
261instance Num e => Num (Matrix e cols rows) where
261instance Num e => Num (Matrix e cols rows) where
262+
262 a + b = zipWithM (+) a b
263 a + b = zipWithM (+) a b
263
264
264 a - b = zipWithM (-) a b
265 a - b = zipWithM (-) a b
265
266
266 a * b = zipWithM (*) a b
267 a * b = zipWithM (*) a b
267
268
269+ abs Empty = Empty
268 abs (One a) = One (abs a)
270 abs (One a) = One (abs a)
269 abs (Join a b) = Join (abs a) (abs b)
271 abs (Join a b) = Join (abs a) (abs b)
270 abs (Fork a b) = Fork (abs a) (abs b)
272 abs (Fork a b) = Fork (abs a) (abs b)
271
273
274+ signum Empty = Empty
272 signum (One a) = One (signum a)
275 signum (One a) = One (signum a)
273 signum (Join a b) = Join (signum a) (signum b)
276 signum (Join a b) = Join (signum a) (signum b)
274 signum (Fork a b) = Fork (signum a) (signum b)
277 signum (Fork a b) = Fork (signum a) (signum b)
275
278
276instance Ord e => Ord (Matrix e cols rows) where
279instance Ord e => Ord (Matrix e cols rows) where
280+ Empty <= Empty = True
277 (One a) <= (One b) = a <= b
281 (One a) <= (One b) = a <= b
278 (Join a b) <= (Join c d) = (a <= c) && (b <= d)
282 (Join a b) <= (Join c d) = (a <= c) && (b <= d)
279 (Fork a b) <= (Fork c d) = (a <= c) && (b <= d)
283 (Fork a b) <= (Fork c d) = (a <= c) && (b <= d)
@@ -282,6 +286,10 @@ instance Ord e => Ord (Matrix e cols rows) where
282
286
283-- Primitives
287-- Primitives
284
288
289+-- | Empty matrix constructor
290+empty :: Matrix e Void Void
291+empty = Empty
292+
285-- | Unit matrix constructor
293-- | Unit matrix constructor
286one :: e -> Matrix e () ()
294one :: e -> Matrix e () ()
287one = One
295one = One
@@ -312,39 +320,40 @@ infixl 2 ===
312--
320--
313-- Given that it is not possible to branch on types at the term level type
321-- Given that it is not possible to branch on types at the term level type
314-- classes are needed very much like an inductive definition but on types.
322-- classes are needed very much like an inductive definition but on types.
315−class FromLists cols rows where
323+class FromLists e cols rows where
316 -- | Build a matrix out of a list of list of elements. Throws a runtime
324 -- | Build a matrix out of a list of list of elements. Throws a runtime
317 -- error if the dimensions do not match.
325 -- error if the dimensions do not match.
318 fromLists :: [[e]] -> Matrix e cols rows
326 fromLists :: [[e]] -> Matrix e cols rows
319
327
320−instance FromLists () () where
328+instance FromLists e Void Void where
329+ fromLists [] = Empty
330+ fromLists _ = error "Wrong dimensions"
331+
332+instance {-# OVERLAPPING #-} FromLists e () () where
321 fromLists [[e]] = One e
333 fromLists [[e]] = One e
322 fromLists _ = error "Wrong dimensions"
334 fromLists _ = error "Wrong dimensions"
323
335
324−instance (FromLists cols ()) => FromLists (Either () cols) () where
336+instance {-# OVERLAPPING #-} (FromLists e cols ()) => FromLists e (Either () cols) () where
325 fromLists [h : t] = Join (One h) (fromLists [t])
337 fromLists [h : t] = Join (One h) (fromLists [t])
326 fromLists _ = error "Wrong dimensions"
338 fromLists _ = error "Wrong dimensions"
327
339
328−instance {-# OVERLAPPABLE #-}
329− (FromLists a (), FromLists b (), Countable a) => FromLists (Either a b) () where
340+instance {-# OVERLAPPABLE #-} (FromLists e a (), FromLists e b (), Countable a) => FromLists e (Either a b) () where
330 fromLists [l] =
341 fromLists [l] =
331 let rowsA = fromInteger (natVal (Proxy :: Proxy (Count a)))
342 let rowsA = fromInteger (natVal (Proxy :: Proxy (Count a)))
332 in Join (fromLists [take rowsA l]) (fromLists [drop rowsA l])
343 in Join (fromLists [take rowsA l]) (fromLists [drop rowsA l])
333 fromLists _ = error "Wrong dimensions"
344 fromLists _ = error "Wrong dimensions"
334
345
335−instance (FromLists () rows) => FromLists () (Either () rows) where
346+instance {-# OVERLAPPING #-} (FromLists e () rows) => FromLists e () (Either () rows) where
336 fromLists ([h] : t) = Fork (One h) (fromLists t)
347 fromLists ([h] : t) = Fork (One h) (fromLists t)
337 fromLists _ = error "Wrong dimensions"
348 fromLists _ = error "Wrong dimensions"
338
349
339−instance {-# OVERLAPPABLE #-}
340− (FromLists () a, FromLists () b, Countable a) => FromLists () (Either a b) where
350+instance {-# OVERLAPPABLE #-} (FromLists e () a, FromLists e () b, Countable a) => FromLists e () (Either a b) where
341− fromLists l@([_] : _) =
351+ fromLists l@([_] : _) =
342 let rowsA = fromInteger (natVal (Proxy :: Proxy (Count a)))
352 let rowsA = fromInteger (natVal (Proxy :: Proxy (Count a)))
343 in Fork (fromLists (take rowsA l)) (fromLists (drop rowsA l))
353 in Fork (fromLists (take rowsA l)) (fromLists (drop rowsA l))
344 fromLists _ = error "Wrong dimensions"
354 fromLists _ = error "Wrong dimensions"
345
355
346−instance (FromLists (Either a b) c, FromLists (Either a b) d, Countable c)
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
347− => FromLists (Either a b) (Either c d) where
348 fromLists l@(h : t) =
357 fromLists l@(h : t) =
349 let lh = length h
358 let lh = length h
350 rowsC = fromInteger (natVal (Proxy :: Proxy (Count c)))
359 rowsC = fromInteger (natVal (Proxy :: Proxy (Count c)))
@@ -357,8 +366,8 @@ instance (FromLists (Either a b) c, FromLists (Either a b) d, Countable c)
357-- a construction function that operates with indices.
366-- a construction function that operates with indices.
358matrixBuilder' ::
367matrixBuilder' ::
359 forall e cols rows.
368 forall e cols rows.
360− ( FL cols rows,
369+ ( FromLists e cols rows,
361− CountableDims cols rows
370+ CountableDimensions cols rows
362 ) => ((Int, Int) -> e) -> Matrix e cols rows
371 ) => ((Int, Int) -> e) -> Matrix e cols rows
363matrixBuilder' f =
372matrixBuilder' f =
364 let c = fromInteger $ natVal (Proxy :: Proxy (Count cols))
373 let c = fromInteger $ natVal (Proxy :: Proxy (Count cols))
@@ -370,16 +379,17 @@ matrixBuilder' f =
370-- a construction function that operates with arbitrary types.
379-- a construction function that operates with arbitrary types.
371matrixBuilder ::
380matrixBuilder ::
372 forall e a b.
381 forall e a b.
373− ( FLN a b,
382+ ( FromListsN e a b,
383+ CountableN b,
374 Enum a,
384 Enum a,
375 Enum b,
385 Enum b,
376 Bounded a,
386 Bounded a,
377 Bounded b,
387 Bounded b,
378 Eq a,
388 Eq a,
379− Countable b
389+ CountableDimensionsN a b
380 ) => ((a, b) -> e) -> Matrix e (Normalize a) (Normalize b)
390 ) => ((a, b) -> e) -> Matrix e (Normalize a) (Normalize b)
381matrixBuilder f =
391matrixBuilder f =
382− let r = fromInteger $ natVal (Proxy :: Proxy (Count b))
392+ let r = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize b)))
383 positions = [(a, b) | a <- [minBound .. maxBound], b <- [minBound .. maxBound]]
393 positions = [(a, b) | a <- [minBound .. maxBound], b <- [minBound .. maxBound]]
384 in fromLists . map (map f) . transpose . buildList r $ positions
394 in fromLists . map (map f) . transpose . buildList r $ positions
385 where
395 where
@@ -387,11 +397,11 @@ matrixBuilder f =
387 buildList r l = take r l : buildList r (drop r l)
397 buildList r l = take r l : buildList r (drop r l)
388
398
389-- | Constructs a column vector matrix
399-- | Constructs a column vector matrix
390−col :: (FL () rows) => [e] -> Matrix e () rows
400+col :: (FromLists e () rows) => [e] -> Matrix e () rows
391col = fromLists . map (: [])
401col = fromLists . map (: [])
392
402
393-- | Constructs a row vector matrix
403-- | Constructs a row vector matrix
394−row :: (FL cols ()) => [e] -> Matrix e cols ()
404+row :: (FromLists e cols ()) => [e] -> Matrix e cols ()
395row = fromLists . (: [])
405row = fromLists . (: [])
396
406
397-- | Lifts functions to matrices with arbitrary dimensions.
407-- | Lifts functions to matrices with arbitrary dimensions.
@@ -401,8 +411,8 @@ row = fromLists . (: [])
401fromF' ::
411fromF' ::
402 forall a b cols rows e.
412 forall a b cols rows e.
403 ( Liftable e a b,
413 ( Liftable e a b,
404− CountableDims cols rows,
414+ CountableDimensions cols rows,
405− FL rows cols
415+ FromLists e rows cols
406 ) =>
416 ) =>
407 (a -> b) ->
417 (a -> b) ->
408 Matrix e cols rows
418 Matrix e cols rows
@@ -430,17 +440,35 @@ fromF' f =
430fromF ::
440fromF ::
431 forall a b e.
441 forall a b e.
432 ( Liftable e a b,
442 ( Liftable e a b,
433− CountableDimsN a b,
443+ CountableDimensionsN a b,
434− FLN b a
444+ FromListsN e b a
435 ) =>
445 ) =>
436 (a -> b) ->
446 (a -> b) ->
437 Matrix e (Normalize a) (Normalize b)
447 Matrix e (Normalize a) (Normalize b)
438−fromF = fromF'
448+fromF f =
449+ let minA = minBound @a
450+ maxA = maxBound @a
451+ minB = minBound @b
452+ maxB = maxBound @b
453+ ccols = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize a)))
454+ rrows = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize b)))
455+ elementsA = take ccols [minA .. maxA]
456+ elementsB = take rrows [minB .. maxB]
457+ combinations = (,) <$> elementsA <*> elementsB
458+ combAp = map snd . sort . map (\(a, b) -> if f a == b
459+ then ((fromEnum a, fromEnum b), 1)
460+ else ((fromEnum a, fromEnum b), 0)) $ combinations
461+ mList = buildList combAp rrows
462+ in tr $ fromLists mList
463+ where
464+ buildList [] _ = []
465+ buildList l r = take r l : buildList (drop r l) r
439
466
440-- Conversion
467-- Conversion
441
468
442-- | Converts a matrix to a list of lists of elements.
469-- | Converts a matrix to a list of lists of elements.
443toLists :: Matrix e cols rows -> [[e]]
470toLists :: Matrix e cols rows -> [[e]]
471+toLists Empty = []
444toLists (One e) = [[e]]
472toLists (One e) = [[e]]
445toLists (Fork l r) = toLists l ++ toLists r
473toLists (Fork l r) = toLists l ++ toLists r
446toLists (Join l r) = zipWith (++) (toLists l) (toLists r)
474toLists (Join l r) = zipWith (++) (toLists l) (toLists r)
@@ -452,7 +480,7 @@ toList = concat . toLists
452-- Zeros Matrix
480-- Zeros Matrix
453
481
454-- | The zero matrix. A matrix wholly filled with zeros.
482-- | The zero matrix. A matrix wholly filled with zeros.
455−zeros :: (Num e, FL cols rows, CountableDims cols rows) => Matrix e cols rows
483+zeros :: (Num e, FromLists e cols rows, CountableDimensions cols rows) => Matrix e cols rows
456zeros = matrixBuilder' (const 0)
484zeros = matrixBuilder' (const 0)
457
485
458-- Ones Matrix
486-- Ones Matrix
@@ -460,20 +488,20 @@ zeros = matrixBuilder' (const 0)
460-- | The ones matrix. A matrix wholly filled with ones.
488-- | The ones matrix. A matrix wholly filled with ones.
461--
489--
462-- Also known as T (Top) matrix.
490-- Also known as T (Top) matrix.
463−ones :: (Num e, FL cols rows, CountableDims cols rows) => Matrix e cols rows
491+ones :: (Num e, FromLists e cols rows, CountableDimensions cols rows) => Matrix e cols rows
464ones = matrixBuilder' (const 1)
492ones = matrixBuilder' (const 1)
465
493
466-- Const Matrix
494-- Const Matrix
467
495
468-- | The constant matrix constructor. A matrix wholly filled with a given
496-- | The constant matrix constructor. A matrix wholly filled with a given
469-- value.
497-- value.
470−constant :: (Num e, FL cols rows, CountableDims cols rows) => e -> Matrix e cols rows
498+constant :: (Num e, FromLists e cols rows, CountableDimensions cols rows) => e -> Matrix e cols rows
471constant e = matrixBuilder' (const e)
499constant e = matrixBuilder' (const e)
472
500
473-- Bang Matrix
501-- Bang Matrix
474
502
475-- | The T (Top) row vector matrix.
503-- | The T (Top) row vector matrix.
476−bang :: forall e cols. (Num e, Enum e, FL cols (), Countable cols) => Matrix e cols ()
504+bang :: forall e cols. (Num e, Enum e, FromLists e cols (), Countable cols) => Matrix e cols ()
477bang =
505bang =
478 let c = fromInteger $ natVal (Proxy :: Proxy (Count cols))
506 let c = fromInteger $ natVal (Proxy :: Proxy (Count cols))
479 in fromLists [take c [1, 1 ..]]
507 in fromLists [take c [1, 1 ..]]
@@ -481,7 +509,7 @@ bang =
481-- iden Matrix
509-- iden Matrix
482
510
483-- | iden matrix.
511-- | iden matrix.
484−iden :: forall e cols . (Num e, FL cols cols, Countable cols) => Matrix e cols cols
512+iden :: forall e cols . (Num e, FromLists e cols cols, Countable cols) => Matrix e cols cols
485iden = matrixBuilder' (bool 0 1 . uncurry (==))
513iden = matrixBuilder' (bool 0 1 . uncurry (==))
486{-# NOINLINE iden #-}
514{-# NOINLINE iden #-}
487
515
@@ -492,12 +520,13 @@ iden = matrixBuilder' (bool 0 1 . uncurry (==))
492-- This definition takes advantage of divide-and-conquer and fusion laws
520-- This definition takes advantage of divide-and-conquer and fusion laws
493-- from LAoP.
521-- from LAoP.
494comp :: (Num e) => Matrix e cr rows -> Matrix e cols cr -> Matrix e cols rows
522comp :: (Num e) => Matrix e cr rows -> Matrix e cols cr -> Matrix e cols rows
523+comp Empty Empty = Empty
495comp (One a) (One b) = One (a * b)
524comp (One a) (One b) = One (a * b)
496comp (Join a b) (Fork c d) = comp a c + comp b d -- Divide-and-conquer law
525comp (Join a b) (Fork c d) = comp a c + comp b d -- Divide-and-conquer law
497comp (Fork a b) c = Fork (comp a c) (comp b c) -- Fork fusion law
526comp (Fork a b) c = Fork (comp a c) (comp b c) -- Fork fusion law
498comp c (Join a b) = Join (comp c a) (comp c b) -- Join fusion law
527comp c (Join a b) = Join (comp c a) (comp c b) -- Join fusion law
499{-# NOINLINE comp #-}
528{-# NOINLINE comp #-}
500−{-# RULES
529+{-# RULES
501 "comp/iden1" forall m. comp m iden = m ;
530 "comp/iden1" forall m. comp m iden = m ;
502 "comp/iden2" forall m. comp iden m = m
531 "comp/iden2" forall m. comp iden m = m
503#-}
532#-}
@@ -507,6 +536,7 @@ comp c (Join a b) = Join (comp c a) (comp c b) -- Join fusion law
507infixl 7 .|
536infixl 7 .|
508-- | Scalar multiplication of matrices.
537-- | Scalar multiplication of matrices.
509(.|) :: Num e => e -> Matrix e cols rows -> Matrix e cols rows
538(.|) :: Num e => e -> Matrix e cols rows -> Matrix e cols rows
539+(.|) _ Empty = Empty
510(.|) e (One a) = One (e * a)
540(.|) e (One a) = One (e * a)
511(.|) e (Join a b) = Join (e .| a) (e .| b)
541(.|) e (Join a b) = Join (e .| a) (e .| b)
512(.|) e (Fork a b) = Fork (e .| a) (e .| b)
542(.|) e (Fork a b) = Fork (e .| a) (e .| b)
@@ -516,6 +546,7 @@ infixl 7 .|
516infixl 7 ./
546infixl 7 ./
517-- | Scalar multiplication of matrices.
547-- | Scalar multiplication of matrices.
518(./) :: Fractional e => Matrix e cols rows -> e -> Matrix e cols rows
548(./) :: Fractional e => Matrix e cols rows -> e -> Matrix e cols rows
549+(./) Empty _ = Empty
519(./) (One a) e = One (a / e)
550(./) (One a) e = One (a / e)
520(./) (Join a b) e = Join (a ./ e) (b ./ e)
551(./) (Join a b) e = Join (a ./ e) (b ./ e)
521(./) (Fork a b) e = Fork (a ./ e) (b ./ e)
552(./) (Fork a b) e = Fork (a ./ e) (b ./ e)
@@ -523,59 +554,45 @@ infixl 7 ./
523-- Projections
554-- Projections
524
555
525-- | Biproduct first component projection
556-- | Biproduct first component projection
526−p1 :: (Num e, CountableDims n m, FL n m, FL m m) => Matrix e (Either m n) m
557+p1 :: (Num e, CountableDimensions n m, FromLists e n m, FromLists e m m) => Matrix e (Either m n) m
527p1 = join id zeros
558p1 = join id zeros
528
559
529-- | Biproduct second component projection
560-- | Biproduct second component projection
530−p2 :: (Num e, CountableDims n m, FL m n, FL n n) => Matrix e (Either m n) n
561+p2 :: (Num e, CountableDimensions n m, FromLists e m n, FromLists e n n) => Matrix e (Either m n) n
531p2 = join zeros id
562p2 = join zeros id
532
563
533-- Injections
564-- Injections
534
565
535-- | Biproduct first component injection
566-- | Biproduct first component injection
536−i1 :: (Num e, CountableDims n m, FL n m, FL m m) => Matrix e m (Either m n)
567+i1 :: (Num e, CountableDimensions n m, FromLists e n m, FromLists e m m) => Matrix e m (Either m n)
537i1 = tr p1
568i1 = tr p1
538
569
539-- | Biproduct second component injection
570-- | Biproduct second component injection
540−i2 :: (Num e, CountableDims n m, FL m n, FL n n) => Matrix e n (Either m n)
571+i2 :: (Num e, CountableDimensions n m, FromLists e m n, FromLists e n n) => Matrix e n (Either m n)
541i2 = tr p2
572i2 = tr p2
542
573
543-- Dimensions
574-- Dimensions
544
575
545-- | Obtain the number of rows.
576-- | Obtain the number of rows.
546--
577--
547−-- NOTE: The 'KnownNat' constraint is needed in order to obtain the
578+-- NOTE: The 'KnownNat' constaint is needed in order to obtain the
548−-- dimensions in constant time. For a version that doesn't require the
579+-- dimensions in constant time.
549−-- constraint see 'rows''.
580+--
581+-- TODO: A 'rows' function that does not need the 'KnownNat' constraint in
582+-- exchange for performance.
550rows :: forall e cols rows. (Countable rows) => Matrix e cols rows -> Int
583rows :: forall e cols rows. (Countable rows) => Matrix e cols rows -> Int
551rows _ = fromInteger $ natVal (Proxy :: Proxy (Count rows))
584rows _ = fromInteger $ natVal (Proxy :: Proxy (Count rows))
552
585
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−
562-- | Obtain the number of columns.
586-- | Obtain the number of columns.
587+--
588+-- NOTE: The 'KnownNat' constaint is needed in order to obtain the
589+-- dimensions in constant time.
563--
590--
564−-- NOTE: The 'KnownNat' constraint is needed in order to obtain the
591+-- TODO: A 'columns' function that does not need the 'KnownNat' constraint in
565−-- dimensions in constant time. For a version that doesn't require the
592+-- exchange for performance.
566−-- constraint see 'columns''.
567columns :: forall e cols rows. (Countable cols) => Matrix e cols rows -> Int
593columns :: forall e cols rows. (Countable cols) => Matrix e cols rows -> Int
568columns _ = fromInteger $ natVal (Proxy :: Proxy (Count cols))
594columns _ = fromInteger $ natVal (Proxy :: Proxy (Count cols))
569
595
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−
579-- Coproduct Bifunctor
596-- Coproduct Bifunctor
580
597
581infixl 5 -|-
598infixl 5 -|-
@@ -584,11 +601,11 @@ infixl 5 -|-
584(-|-) ::
601(-|-) ::
585 forall e n k m j.
602 forall e n k m j.
586 ( Num e,
603 ( Num e,
587− CountableDims j k,
604+ CountableDimensions j k,
588− FL k k,
605+ FromLists e k k,
589− FL j k,
606+ FromLists e j k,
590− FL k j,
607+ FromLists e k j,
591− FL j j
608+ FromLists e j j
592 ) =>
609 ) =>
593 Matrix e n k ->
610 Matrix e n k ->
594 Matrix e m j ->
611 Matrix e m j ->
@@ -601,8 +618,8 @@ infixl 5 -|-
601fstM ::
618fstM ::
602 forall e m k .
619 forall e m k .
603 ( Num e,
620 ( Num e,
604− CountableDims k m,
621+ CountableDimensions k m,
605− FL (Normalize (m, k)) m,
622+ FromLists e (Normalize (m, k)) m,
606 CountableN (m, k)
623 CountableN (m, k)
607 ) => Matrix e (Normalize (m, k)) m
624 ) => Matrix e (Normalize (m, k)) m
608fstM = matrixBuilder' f
625fstM = matrixBuilder' f
@@ -616,8 +633,8 @@ fstM = matrixBuilder' f
616sndM ::
633sndM ::
617 forall e m k .
634 forall e m k .
618 ( Num e,
635 ( Num e,
619− CountableDims k m,
636+ CountableDimensions k m,
620− FL (Normalize (m, k)) k,
637+ FromLists e (Normalize (m, k)) k,
621 CountableN (m, k)
638 CountableN (m, k)
622 ) => Matrix e (Normalize (m, k)) k
639 ) => Matrix e (Normalize (m, k)) k
623sndM = matrixBuilder' f
640sndM = matrixBuilder' f
@@ -630,7 +647,7 @@ sndM = matrixBuilder' f
630-- | Khatri Rao Matrix product also known as matrix pairing.
647-- | Khatri Rao Matrix product also known as matrix pairing.
631--
648--
632-- NOTE: That this is not a true categorical product, see for instance:
649-- NOTE: That this is not a true categorical product, see for instance:
633−--
650+--
634-- @
651-- @
635-- | fstM . kr a b == a
652-- | fstM . kr a b == a
636-- kr a b ==> |
653-- kr a b ==> |
@@ -641,10 +658,10 @@ sndM = matrixBuilder' f
641kr ::
658kr ::
642 forall e cols a b.
659 forall e cols a b.
643 ( Num e,
660 ( Num e,
644− CountableDims a b,
661+ CountableDimensions a b,
645 CountableN (a, b),
662 CountableN (a, b),
646− FL (Normalize (a, b)) a,
663+ FromLists e (Normalize (a, b)) a,
647− FL (Normalize (a, b)) b
664+ FromLists e (Normalize (a, b)) b
648 ) => Matrix e cols a -> Matrix e cols b -> Matrix e cols (Normalize (a, b))
665 ) => Matrix e cols a -> Matrix e cols b -> Matrix e cols (Normalize (a, b))
649kr a b =
666kr a b =
650 let fstM' = fstM @e @a @b
667 let fstM' = fstM @e @a @b
@@ -659,14 +676,14 @@ infixl 4 ><
659(><) ::
676(><) ::
660 forall e m p n q.
677 forall e m p n q.
661 ( Num e,
678 ( Num e,
662− CountableDims m n,
679+ CountableDimensions m n,
663− CountableDims p q,
680+ CountableDimensions p q,
664− CountableDimsN (m, n) (p, q),
681+ CountableDimensionsN (m, n) (p, q),
665− FL (Normalize (m, n)) m,
682+ FromLists e (Normalize (m, n)) m,
666− FL (Normalize (m, n)) n,
683+ FromLists e (Normalize (m, n)) n,
667− FL (Normalize (p, q)) p,
684+ FromLists e (Normalize (p, q)) p,
668− FL (Normalize (p, q)) q
685+ FromLists e (Normalize (p, q)) q
669− )
686+ )
670 => Matrix e m p -> Matrix e n q -> Matrix e (Normalize (m, n)) (Normalize (p, q))
687 => Matrix e m p -> Matrix e n q -> Matrix e (Normalize (m, n)) (Normalize (p, q))
671(><) a b =
688(><) a b =
672 let fstM' = fstM @e @m @n
689 let fstM' = fstM @e @m @n
@@ -684,6 +701,7 @@ infixl 4 ><
684-- @
701-- @
685abideJF :: Matrix e cols rows -> Matrix e cols rows
702abideJF :: Matrix e cols rows -> Matrix e cols rows
686abideJF (Join (Fork a c) (Fork b d)) = Fork (Join (abideJF a) (abideJF b)) (Join (abideJF c) (abideJF d)) -- Join-Fork abide law
703abideJF (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
687abideJF (One e) = One e
705abideJF (One e) = One e
688abideJF (Join a b) = Join (abideJF a) (abideJF b)
706abideJF (Join a b) = Join (abideJF a) (abideJF b)
689abideJF (Fork a b) = Fork (abideJF a) (abideJF b)
707abideJF (Fork a b) = Fork (abideJF a) (abideJF b)
@@ -697,6 +715,7 @@ abideJF (Fork a b) = Fork (abideJF a) (abideJF b)
697-- @
715-- @
698abideFJ :: Matrix e cols rows -> Matrix e cols rows
716abideFJ :: Matrix e cols rows -> Matrix e cols rows
699abideFJ (Fork (Join a b) (Join c d)) = Join (Fork (abideFJ a) (abideFJ c)) (Fork (abideFJ b) (abideFJ d)) -- Fork-Join abide law
717abideFJ (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
700abideFJ (One e) = One e
719abideFJ (One e) = One e
701abideFJ (Join a b) = Join (abideFJ a) (abideFJ b)
720abideFJ (Join a b) = Join (abideFJ a) (abideFJ b)
702abideFJ (Fork a b) = Fork (abideFJ a) (abideFJ b)
721abideFJ (Fork a b) = Fork (abideFJ a) (abideFJ b)
@@ -705,6 +724,7 @@ abideFJ (Fork a b) = Fork (abideFJ a) (abideFJ b)
705
724
706-- | Matrix transposition.
725-- | Matrix transposition.
707tr :: Matrix e cols rows -> Matrix e rows cols
726tr :: Matrix e cols rows -> Matrix e rows cols
727+tr Empty = Empty
708tr (One e) = One e
728tr (One e) = One e
709tr (Join a b) = Fork (tr a) (tr b)
729tr (Join a b) = Fork (tr a) (tr b)
710tr (Fork a b) = Join (tr a) (tr b)
730tr (Fork a b) = Join (tr a) (tr b)
@@ -713,32 +733,32 @@ tr (Fork a b) = Join (tr a) (tr b)
713
733
714-- | Selective functors 'select' operator equivalent inspired by the
734-- | Selective functors 'select' operator equivalent inspired by the
715-- ArrowMonad solution presented in the paper.
735-- ArrowMonad solution presented in the paper.
716−select :: (Num e, FL b b, Countable b) => Matrix e cols (Either a b) -> Matrix e a b -> Matrix e cols b
736+select :: (Num e, FromLists e b b, Countable b) => Matrix e cols (Either a b) -> Matrix e a b -> Matrix e cols b
717select (Fork a b) y = y . a + b -- Divide-and-conquer law
737select (Fork a b) y = y . a + b -- Divide-and-conquer law
718select (Join (Fork a c) (Fork b d)) y = join (y . a + c) (y . b + d) -- Pattern matching + DnC law
738select (Join (Fork a c) (Fork b d)) y = join (y . a + c) (y . b + d) -- Pattern matching + DnC law
719select m y = join y id . m
739select m y = join y id . m
720
740
721branch ::
741branch ::
722 ( Num e,
742 ( Num e,
723− CountableDims a b,
743+ CountableDimensions a b,
724− CountableDims c (Either b c),
744+ CountableDimensions c (Either b c),
725− FL c b,
745+ FromLists e c b,
726− FL a b,
746+ FromLists e a b,
727− FL a a,
747+ FromLists e a a,
728− FL b b,
748+ FromLists e b b,
729− FL c c,
749+ FromLists e c c,
730− FL b a,
750+ FromLists e b a,
731− FL b c,
751+ FromLists e b c,
732− FL (Either b c) b,
752+ FromLists e (Either b c) b,
733− FL (Either b c) c
753+ FromLists e (Either b c) c
734 )
754 )
735 => Matrix e cols (Either a b) -> Matrix e a c -> Matrix e b c -> Matrix e cols c
755 => Matrix e cols (Either a b) -> Matrix e a c -> Matrix e b c -> Matrix e cols c
736branch x l r = f x `select` g l `select` r
756branch x l r = f x `select` g l `select` r
737 where
757 where
738− f :: (Num e, Countable a, CountableDims b c, FL a b, FL c b, FL b b, FL b a, FL a a)
758+ f :: (Num e, Countable a, CountableDimensions b c, FromLists e a b, FromLists e c b, FromLists e b b, FromLists e b a, FromLists e a a)
739 => Matrix e cols (Either a b) -> Matrix e cols (Either a (Either b c))
759 => Matrix e cols (Either a b) -> Matrix e cols (Either a (Either b c))
740 f m = fork (tr i1) (i1 . tr i2) . m
760 f m = fork (tr i1) (i1 . tr i2) . m
741− g :: (Num e, CountableDims b c, FL b c, FL c c) => Matrix e a c -> Matrix e a (Either b c)
761+ g :: (Num e, CountableDimensions b c, FromLists e b c, FromLists e c c) => Matrix e a c -> Matrix e a (Either b c)
742 g m = i2 . m
762 g m = i2 . m
743
763
744-- McCarthy's Conditional
764-- McCarthy's Conditional
@@ -747,9 +767,9 @@ branch x l r = f x `select` g l `select` r
747cond ::
767cond ::
748 ( Trivial cols,
768 ( Trivial cols,
749 Countable cols,
769 Countable cols,
750− FL () cols,
770+ FromLists e () cols,
751− FL cols (),
771+ FromLists e cols (),
752− FL cols cols,
772+ FromLists e cols cols,
753 Bounded a,
773 Bounded a,
754 Enum a,
774 Enum a,
755 Num e,
775 Num e,
@@ -762,9 +782,9 @@ cond p f g = join f g . grd p
762grd ::
782grd ::
763 ( Trivial q,
783 ( Trivial q,
764 Countable q,
784 Countable q,
765− FL () q,
785+ FromLists e () q,
766− FL q (),
786+ FromLists e q (),
767− FL q q,
787+ FromLists e q q,
768 Bounded a,
788 Bounded a,
769 Enum a,
789 Enum a,
770 Num e,
790 Num e,
@@ -778,9 +798,9 @@ corr ::
778 forall e a q .
798 forall e a q .
779 ( Trivial q,
799 ( Trivial q,
780 Countable q,
800 Countable q,
781− FL () q,
801+ FromLists e () q,
782− FL q (),
802+ FromLists e q (),
783− FL q q,
803+ FromLists e q q,
784 Liftable e a Bool
804 Liftable e a Bool
785 )
805 )
786 => (a -> Bool) -> Matrix e q q
806 => (a -> Bool) -> Matrix e q q
@@ -809,7 +829,7 @@ prettyAux (h : t) l = "│ " ++ fill (unwords $ map show h) ++ " │\n" ++
809 fill str = replicate (widest - length str - 2) ' ' ++ str
829 fill str = replicate (widest - length str - 2) ' ' ++ str
810
830
811-- | Matrix pretty printer
831-- | Matrix pretty printer
812−pretty :: (CountableDims cols rows, Show e) => Matrix e cols rows -> String
832+pretty :: (CountableDimensions cols rows, Show e) => Matrix e cols rows -> String
813pretty m = concat
833pretty m = concat
814 [ "┌ ", unwords (replicate (columns m) blank), " ┐\n"
834 [ "┌ ", unwords (replicate (columns m) blank), " ┐\n"
815 , unlines
835 , unlines
@@ -838,11 +858,12 @@ pretty m = concat
838 (safeGet i j m)
858 (safeGet i j m)
839
859
840-- | Matrix pretty printer
860-- | Matrix pretty printer
841−prettyPrint :: (CountableDims cols rows, Show e) => Matrix e cols rows -> IO ()
861+prettyPrint :: (CountableDimensions cols rows, Show e) => Matrix e cols rows -> IO ()
842prettyPrint = putStrLn . pretty
862prettyPrint = putStrLn . pretty
843
863
844-- | Zip two matrices with a given binary function
864-- | Zip two matrices with a given binary function
845zipWithM :: (e -> f -> g) -> Matrix e cols rows -> Matrix f cols rows -> Matrix g cols rows
865zipWithM :: (e -> f -> g) -> Matrix e cols rows -> Matrix f cols rows -> Matrix g cols rows
866+zipWithM _ Empty Empty = Empty
846zipWithM f (One a) (One b) = One (f a b)
867zipWithM f (One a) (One b) = One (f a b)
847zipWithM f (Join a b) (Join c d) = Join (zipWithM f a c) (zipWithM f b d)
868zipWithM f (Join a b) (Join c d) = Join (zipWithM f a c) (zipWithM f b d)
848zipWithM f (Fork a b) (Fork c d) = Fork (zipWithM f a c) (zipWithM f b d)
869zipWithM f (Fork a b) (Fork c d) = Fork (zipWithM f a c) (zipWithM f b d)
@@ -867,12 +888,14 @@ fromBool False = nat 0
867
888
868-- | Relational negation
889-- | Relational negation
869negateM :: Relation cols rows -> Relation cols rows
890negateM :: Relation cols rows -> Relation cols rows
891+negateM Empty = Empty
870negateM (One (Nat p)) = One (Nat (negate p))
892negateM (One (Nat p)) = One (Nat (negate p))
871negateM (Join a b) = Join (negateM a) (negateM b)
893negateM (Join a b) = Join (negateM a) (negateM b)
872negateM (Fork a b) = Fork (negateM a) (negateM b)
894negateM (Fork a b) = Fork (negateM a) (negateM b)
873
895
874-- | Relational addition
896-- | Relational addition
875orM :: Relation cols rows -> Relation cols rows -> Relation cols rows
897orM :: Relation cols rows -> Relation cols rows -> Relation cols rows
898+orM Empty Empty = Empty
876orM (One a) (One b) = One (fromBool (toBool a || toBool b))
899orM (One a) (One b) = One (fromBool (toBool a || toBool b))
877orM (Join a b) (Join c d) = Join (orM a c) (orM b d)
900orM (Join a b) (Join c d) = Join (orM a c) (orM b d)
878orM (Fork a b) (Fork c d) = Fork (orM a c) (orM b d)
901orM (Fork a b) (Fork c d) = Fork (orM a c) (orM b d)
@@ -881,6 +904,7 @@ orM x@(Join _ _) y@(Fork _ _) = orM (abideJF x) y
881
904
882-- | Relational multiplication
905-- | Relational multiplication
883andM :: Relation cols rows -> Relation cols rows -> Relation cols rows
906andM :: Relation cols rows -> Relation cols rows -> Relation cols rows
907+andM Empty Empty = Empty
884andM (One a) (One b) = One (fromBool (toBool a && toBool b))
908andM (One a) (One b) = One (fromBool (toBool a && toBool b))
885andM (Join a b) (Join c d) = Join (andM a c) (andM b d)
909andM (Join a b) (Join c d) = Join (andM a c) (andM b d)
886andM (Fork a b) (Fork c d) = Fork (andM a c) (andM b d)
910andM (Fork a b) (Fork c d) = Fork (andM a c) (andM b d)
@@ -889,6 +913,7 @@ andM x@(Join _ _) y@(Fork _ _) = andM (abideJF x) y
889
913
890-- | Relational subtraction
914-- | Relational subtraction
891subM :: Relation cols rows -> Relation cols rows -> Relation cols rows
915subM :: Relation cols rows -> Relation cols rows -> Relation cols rows
916+subM Empty Empty = Empty
892subM (One a) (One b) = if a - b < nat 0 then One (nat 0) else One (a - b)
917subM (One a) (One b) = if a - b < nat 0 then One (nat 0) else One (a - b)
893subM (Join a b) (Join c d) = Join (subM a c) (subM b d)
918subM (Join a b) (Join c d) = Join (subM a c) (subM b d)
894subM (Fork a b) (Fork c d) = Fork (subM a c) (subM b d)
919subM (Fork a b) (Fork c d) = Fork (subM a c) (subM b d)
@@ -897,6 +922,7 @@ subM x@(Join _ _) y@(Fork _ _) = subM (abideJF x) y
897
922
898-- | Matrix relational composition.
923-- | Matrix relational composition.
899compRel :: Relation cr rows -> Relation cols cr -> Relation cols rows
924compRel :: Relation cr rows -> Relation cols cr -> Relation cols rows
925+compRel Empty Empty = Empty
900compRel (One a) (One b) = One (fromBool (toBool a && toBool b))
926compRel (One a) (One b) = One (fromBool (toBool a && toBool b))
901compRel (Join a b) (Fork c d) = orM (compRel a c) (compRel b d) -- Divide-and-conquer law
927compRel (Join a b) (Fork c d) = orM (compRel a c) (compRel b d) -- Divide-and-conquer law
902compRel (Fork a b) c = Fork (compRel a c) (compRel b c) -- Fork fusion law
928compRel (Fork a b) c = Fork (compRel a c) (compRel b c) -- Fork fusion law
@@ -904,6 +930,7 @@ compRel c (Join a b) = Join (compRel c a) (compRel c b) -- Join fusion
904
930
905-- | Matrix relational right division
931-- | Matrix relational right division
906divR :: Relation b c -> Relation b a -> Relation a c
932divR :: Relation b c -> Relation b a -> Relation a c
933+divR Empty Empty = Empty
907divR (One a) (One b) = One (fromBool (not (toBool b) || toBool a)) -- b implies a
934divR (One a) (One b) = One (fromBool (not (toBool b) || toBool a)) -- b implies a
908divR (Join a b) (Join c d) = andM (divR a c) (divR b d)
935divR (Join a b) (Join c d) = andM (divR a c) (divR b d)
909divR (Fork a b) c = Fork (divR a c) (divR b c)
936divR (Fork a b) c = Fork (divR a c) (divR b c)
@@ -926,24 +953,58 @@ divS s r = divL r s `intersection` divR (tr r) (tr s)
926fromFRel' ::
953fromFRel' ::
927 forall a b cols rows.
954 forall a b cols rows.
928 ( Liftable Boolean a b,
955 ( Liftable Boolean a b,
929− CountableDims cols rows,
956+ CountableDimensions cols rows,
930− FL rows cols
957+ FromLists Boolean rows cols
931 ) =>
958 ) =>
932 (a -> b) ->
959 (a -> b) ->
933 Relation cols rows
960 Relation cols rows
934−fromFRel' = fromF'
961+fromFRel' f =
962+ let minA = minBound @a
963+ maxA = maxBound @a
964+ minB = minBound @b
965+ maxB = maxBound @b
966+ ccols = fromInteger $ natVal (Proxy :: Proxy (Count cols))
967+ rrows = fromInteger $ natVal (Proxy :: Proxy (Count rows))
968+ elementsA = take ccols [minA .. maxA]
969+ elementsB = take rrows [minB .. maxB]
970+ combinations = (,) <$> elementsA <*> elementsB
971+ combAp = map snd . sort . map (\(a, b) -> if f a == b
972+ then ((fromEnum a, fromEnum b), nat 1)
973+ else ((fromEnum a, fromEnum b), nat 0)) $ combinations
974+ mList = buildList combAp rrows
975+ in tr $ fromLists mList
976+ where
977+ buildList [] _ = []
978+ buildList l r = take r l : buildList (drop r l) r
935
979
936-- | Lifts functions to relations with dimensions matching @a@ and @b@
980-- | Lifts functions to relations with dimensions matching @a@ and @b@
937-- cardinality's.
981-- cardinality's.
938fromFRel ::
982fromFRel ::
939 forall a b.
983 forall a b.
940 ( Liftable Boolean a b,
984 ( Liftable Boolean a b,
941− CountableDimsN a b,
985+ CountableDimensionsN a b,
942− FLN b a
986+ FromLists Boolean (Normalize b) (Normalize a)
943 ) =>
987 ) =>
944 (a -> b) ->
988 (a -> b) ->
945 Relation (Normalize a) (Normalize b)
989 Relation (Normalize a) (Normalize b)
946−fromFRel = fromFRel'
990+fromFRel f =
991+ let minA = minBound @a
992+ maxA = maxBound @a
993+ minB = minBound @b
994+ maxB = maxBound @b
995+ ccols = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize a)))
996+ rrows = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize b)))
997+ elementsA = take ccols [minA .. maxA]
998+ elementsB = take rrows [minB .. maxB]
999+ combinations = (,) <$> elementsA <*> elementsB
1000+ combAp = map snd . sort . map (\(a, b) -> if f a == b
1001+ then ((fromEnum a, fromEnum b), nat 1)
1002+ else ((fromEnum a, fromEnum b), nat 0)) $ combinations
1003+ mList = buildList combAp rrows
1004+ in tr $ fromLists mList
1005+ where
1006+ buildList [] _ = []
1007+ buildList l r = take r l : buildList (drop r l) r
947
1008
948-- | Lifts a relation function to a Boolean Matrix
1009-- | Lifts a relation function to a Boolean Matrix
949toRel ::
1010toRel ::
@@ -953,17 +1014,17 @@ toRel ::
953 Enum a,
1014 Enum a,
954 Enum b,
1015 Enum b,
955 Eq b,
1016 Eq b,
956− CountableDims a b,
1017+ CountableDimensionsN a b,
957− FLN b a
1018+ FromListsN Boolean b a
958− )
1019+ )
959 => (a -> b -> Bool) -> Relation (Normalize a) (Normalize b)
1020 => (a -> b -> Bool) -> Relation (Normalize a) (Normalize b)
960toRel f =
1021toRel f =
961 let minA = minBound @a
1022 let minA = minBound @a
962 maxA = maxBound @a
1023 maxA = maxBound @a
963 minB = minBound @b
1024 minB = minBound @b
964 maxB = maxBound @b
1025 maxB = maxBound @b
965− ccols = fromInteger $ natVal (Proxy :: Proxy (Count a))
1026+ ccols = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize a)))
966− rrows = fromInteger $ natVal (Proxy :: Proxy (Count b))
1027+ rrows = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize b)))
967 elementsA = take ccols [minA .. maxA]
1028 elementsA = take ccols [minA .. maxA]
968 elementsB = take rrows [minB .. maxB]
1029 elementsB = take rrows [minB .. maxB]
969 combinations = (,) <$> elementsA <*> elementsB
1030 combinations = (,) <$> elementsA <*> elementsB
src/LAoP/Matrix/Nat.hs+67−63
@@ -56,17 +56,18 @@ module LAoP.Matrix.Nat
56
56
57 -- * Constraint type synonyms
57 -- * Constraint type synonyms
58 Countable,
58 Countable,
59− CountableDims,
59+ CountableDimensions,
60 CountableN,
60 CountableN,
61 CountableNz,
61 CountableNz,
62− CountableDimsN,
62+ CountableDimensionsN,
63− FLN,
63+ FromListsN,
64− FLNz,
64+ FromListsNz,
65 Liftable,
65 Liftable,
66 TrivialE,
66 TrivialE,
67 TrivialP,
67 TrivialP,
68
68
69 -- * Primitives
69 -- * Primitives
70+ empty,
70 one,
71 one,
71 join,
72 join,
72 fork,
73 fork,
@@ -77,7 +78,7 @@ module LAoP.Matrix.Nat
77 I.Normalize,
78 I.Normalize,
78
79
79 -- * Matrix construction and conversion
80 -- * Matrix construction and conversion
80− I.FL,
81+ I.FromLists,
81 fromLists,
82 fromLists,
82 toLists,
83 toLists,
83 toList,
84 toList,
@@ -166,19 +167,22 @@ newtype Matrix e (cols :: Nat) (rows :: Nat) = M (I.Matrix e (I.FromNat cols) (I
166 deriving (Show, Num, Eq, Ord, NFData) via (I.Matrix e (I.FromNat cols) (I.FromNat rows))
167 deriving (Show, Num, Eq, Ord, NFData) via (I.Matrix e (I.FromNat cols) (I.FromNat rows))
167
168
168-- | Constraint type synonyms to keep the type signatures less convoluted
169-- | Constraint type synonyms to keep the type signatures less convoluted
169−type Countable a = KnownNat (I.Count a)
170+type Countable a = KnownNat (I.Count a)
170−type CountableDims a b = (Countable a, Countable b)
171+type CountableDimensions a b = (Countable a, Countable b)
171−type CountableN a = KnownNat (I.Count (I.FromNat a))
172+type CountableN a = KnownNat (I.Count (I.FromNat a))
172−type CountableNz a = KnownNat (I.Count (I.Normalize a))
173+type CountableNz a = KnownNat (I.Count (I.Normalize a))
173−type CountableDimsN a b = (CountableN a, CountableN b)
174+type CountableDimensionsN a b = (CountableN a, CountableN b)
174−type FLN e a b = I.FL (I.FromNat a) (I.FromNat b)
175+type FromListsN e a b = I.FromLists e (I.FromNat a) (I.FromNat b)
175−type FLNz e a b = I.FL (I.Normalize a) (I.Normalize b)
176+type FromListsNz e a b = I.FromLists e (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 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 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))
179+type TrivialP a b = I.FromNat (a * b) ~ I.FromNat (I.Count (I.FromNat a) * I.Count (I.FromNat b))
179
180
180-- Primitives
181-- Primitives
181
182
183+empty :: Matrix e 0 0
184+empty = M I.Empty
185+
182one :: e -> Matrix e 1 1
186one :: e -> Matrix e 1 1
183one = M . I.One
187one = M . I.One
184
188
@@ -214,27 +218,27 @@ infixl 2 ===
214
218
215-- Construction
219-- Construction
216
220
217−fromLists :: (FLN e cols rows) => [[e]] -> Matrix e cols rows
221+fromLists :: (FromListsN e cols rows) => [[e]] -> Matrix e cols rows
218fromLists = M . I.fromLists
222fromLists = M . I.fromLists
219
223
220-- | Matrix builder function. Constructs a matrix provided with
224-- | Matrix builder function. Constructs a matrix provided with
221-- a construction function that operates with indices.
225-- a construction function that operates with indices.
222matrixBuilder' ::
226matrixBuilder' ::
223− (FLN e cols rows, CountableN cols, CountableN rows)
227+ (FromListsN e cols rows, CountableN cols, CountableN rows)
224 => ((Int, Int) -> e) -> Matrix e cols rows
228 => ((Int, Int) -> e) -> Matrix e cols rows
225matrixBuilder' = M . I.matrixBuilder'
229matrixBuilder' = M . I.matrixBuilder'
226
230
227−col :: (I.FL () (I.FromNat rows)) => [e] -> Matrix e 1 rows
231+col :: (I.FromLists e () (I.FromNat rows)) => [e] -> Matrix e 1 rows
228col = M . I.col
232col = M . I.col
229
233
230−row :: (I.FL (I.FromNat cols) ()) => [e] -> Matrix e cols 1
234+row :: (I.FromLists e (I.FromNat cols) ()) => [e] -> Matrix e cols 1
231row = M . I.row
235row = M . I.row
232
236
233fromF' ::
237fromF' ::
234 ( Liftable e a b,
238 ( Liftable e a b,
235 CountableN cols,
239 CountableN cols,
236 CountableN rows,
240 CountableN rows,
237− FLN e rows cols
241+ FromListsN e rows cols
238 ) =>
242 ) =>
239 (a -> b) ->
243 (a -> b) ->
240 Matrix e cols rows
244 Matrix e cols rows
@@ -244,7 +248,7 @@ fromF ::
244 ( Liftable e a b,
248 ( Liftable e a b,
245 CountableNz a,
249 CountableNz a,
246 CountableNz b,
250 CountableNz b,
247− FLNz e b a
251+ FromListsNz e b a
248 ) =>
252 ) =>
249 (a -> b) ->
253 (a -> b) ->
250 Matrix e (I.Count a) (I.Count b)
254 Matrix e (I.Count a) (I.Count b)
@@ -261,21 +265,21 @@ toList (M m) = I.toList m
261-- Zeros Matrix
265-- Zeros Matrix
262
266
263zeros ::
267zeros ::
264− (Num e, FLN e cols rows, CountableN cols, CountableN rows) =>
268+ (Num e, FromListsN e cols rows, CountableN cols, CountableN rows) =>
265 Matrix e cols rows
269 Matrix e cols rows
266zeros = M I.zeros
270zeros = M I.zeros
267
271
268-- Ones Matrix
272-- Ones Matrix
269
273
270ones ::
274ones ::
271− (Num e, FLN e cols rows, CountableN cols, CountableN rows) =>
275+ (Num e, FromListsN e cols rows, CountableN cols, CountableN rows) =>
272 Matrix e cols rows
276 Matrix e cols rows
273ones = M I.ones
277ones = M I.ones
274
278
275-- Const Matrix
279-- Const Matrix
276
280
277constant ::
281constant ::
278− (Num e, FLN e cols rows, CountableN cols, CountableN rows) =>
282+ (Num e, FromListsN e cols rows, CountableN cols, CountableN rows) =>
279 e ->
283 e ->
280 Matrix e cols rows
284 Matrix e cols rows
281constant = M . I.constant
285constant = M . I.constant
@@ -284,14 +288,14 @@ constant = M . I.constant
284
288
285bang ::
289bang ::
286 forall e cols.
290 forall e cols.
287− (Num e, Enum e, I.FL (I.FromNat cols) (), CountableN cols) =>
291+ (Num e, Enum e, I.FromLists e (I.FromNat cols) (), CountableN cols) =>
288 Matrix e cols 1
292 Matrix e cols 1
289bang = M I.bang
293bang = M I.bang
290
294
291-- iden Matrix
295-- iden Matrix
292
296
293iden ::
297iden ::
294− (Num e, FLN e cols cols, CountableN cols) =>
298+ (Num e, FromListsN e cols cols, CountableN cols) =>
295 Matrix e cols cols
299 Matrix e cols cols
296iden = M I.iden
300iden = M I.iden
297
301
@@ -316,9 +320,9 @@ infixl 7 ./
316
320
317p1 ::
321p1 ::
318 ( Num e,
322 ( Num e,
319− CountableDimsN n m,
323+ CountableDimensionsN n m,
320− FLN e n m,
324+ FromListsN e n m,
321− FLN e m m,
325+ FromListsN e m m,
322 TrivialE m n
326 TrivialE m n
323 ) =>
327 ) =>
324 Matrix e (m + n) m
328 Matrix e (m + n) m
@@ -326,9 +330,9 @@ p1 = M I.p1
326
330
327p2 ::
331p2 ::
328 ( Num e,
332 ( Num e,
329− CountableDimsN n m,
333+ CountableDimensionsN n m,
330− FLN e m n,
334+ FromListsN e m n,
331− FLN e n n,
335+ FromListsN e n n,
332 TrivialE m n
336 TrivialE m n
333 ) =>
337 ) =>
334 Matrix e (m + n) n
338 Matrix e (m + n) n
@@ -338,9 +342,9 @@ p2 = M I.p2
338
342
339i1 ::
343i1 ::
340 ( Num e,
344 ( Num e,
341− CountableDimsN n rows,
345+ CountableDimensionsN n rows,
342− FLN e n rows,
346+ FromListsN e n rows,
343− FLN e rows rows,
347+ FromListsN e rows rows,
344 TrivialE rows n
348 TrivialE rows n
345 ) =>
349 ) =>
346 Matrix e rows (rows + n)
350 Matrix e rows (rows + n)
@@ -348,9 +352,9 @@ i1 = tr p1
348
352
349i2 ::
353i2 ::
350 ( Num e,
354 ( Num e,
351− CountableDimsN rows m,
355+ CountableDimensionsN rows m,
352− FLN e m rows,
356+ FromListsN e m rows,
353− FLN e rows rows,
357+ FromListsN e rows rows,
354 TrivialE m rows
358 TrivialE m rows
355 ) =>
359 ) =>
356 Matrix e rows (m + rows)
360 Matrix e rows (m + rows)
@@ -369,11 +373,11 @@ infixl 5 -|-
369-- | Coproduct Bifunctor (Direct sum)
373-- | Coproduct Bifunctor (Direct sum)
370(-|-) ::
374(-|-) ::
371 ( Num e,
375 ( Num e,
372− CountableDimsN j k,
376+ CountableDimensionsN j k,
373− FLN e k k,
377+ FromListsN e k k,
374− FLN e j k,
378+ FromListsN e j k,
375− FLN e k j,
379+ FromListsN e k j,
376− FLN e j j,
380+ FromListsN e j j,
377 TrivialE n m,
381 TrivialE n m,
378 TrivialE k j
382 TrivialE k j
379 ) =>
383 ) =>
@@ -386,9 +390,9 @@ infixl 5 -|-
386fstM ::
390fstM ::
387 forall e m k .
391 forall e m k .
388 ( Num e,
392 ( Num e,
389− CountableDimsN m k,
393+ CountableDimensionsN m k,
390 CountableN (m * k),
394 CountableN (m * k),
391− FLN e (m * k) m,
395+ FromListsN e (m * k) m,
392 TrivialP m k
396 TrivialP m k
393 ) => Matrix e (m * k) m
397 ) => Matrix e (m * k) m
394fstM = M (I.fstM @e @(I.FromNat m) @(I.FromNat k))
398fstM = M (I.fstM @e @(I.FromNat m) @(I.FromNat k))
@@ -397,8 +401,8 @@ fstM = M (I.fstM @e @(I.FromNat m) @(I.FromNat k))
397sndM ::
401sndM ::
398 forall e m k.
402 forall e m k.
399 ( Num e,
403 ( Num e,
400− CountableDimsN k m,
404+ CountableDimensionsN k m,
401− FLN e (m * k) k,
405+ FromListsN e (m * k) k,
402 CountableN (m * k),
406 CountableN (m * k),
403 TrivialP m k
407 TrivialP m k
404 ) => Matrix e (m * k) k
408 ) => Matrix e (m * k) k
@@ -408,10 +412,10 @@ sndM = M (I.sndM @e @(I.FromNat m) @(I.FromNat k))
408kr ::
412kr ::
409 forall e cols a b.
413 forall e cols a b.
410 ( Num e,
414 ( Num e,
411− CountableDimsN a b,
415+ CountableDimensionsN a b,
412 CountableN (a * b),
416 CountableN (a * b),
413− FLN e (a * b) a,
417+ FromListsN e (a * b) a,
414− FLN e (a * b) b,
418+ FromListsN e (a * b) b,
415 TrivialP a b
419 TrivialP a b
416 ) => Matrix e cols a -> Matrix e cols b -> Matrix e cols (a * b)
420 ) => Matrix e cols a -> Matrix e cols b -> Matrix e cols (a * b)
417kr a b =
421kr a b =
@@ -425,13 +429,13 @@ infixl 4 ><
425(><) ::
429(><) ::
426 forall e m p n q.
430 forall e m p n q.
427 ( Num e,
431 ( Num e,
428− CountableDimsN m n,
432+ CountableDimensionsN m n,
429− CountableDimsN p q,
433+ CountableDimensionsN p q,
430− CountableDimsN (m * n) (p * q),
434+ CountableDimensionsN (m * n) (p * q),
431− FLN e (m * n) m,
435+ FromListsN e (m * n) m,
432− FLN e (m * n) n,
436+ FromListsN e (m * n) n,
433− FLN e (p * q) p,
437+ FromListsN e (p * q) p,
434− FLN e (p * q) q,
438+ FromListsN e (p * q) q,
435 TrivialP m n,
439 TrivialP m n,
436 TrivialP p q
440 TrivialP p q
437 ) => Matrix e m p -> Matrix e n q -> Matrix e (m * n) (p * q)
441 ) => Matrix e m p -> Matrix e n q -> Matrix e (m * n) (p * q)
@@ -455,7 +459,7 @@ tr (M m) = M (I.tr m)
455-- Selective 'select' operator
459-- Selective 'select' operator
456select ::
460select ::
457 ( Num e,
461 ( Num e,
458− FLN e rows1 rows1,
462+ FromListsN e rows1 rows1,
459 CountableN rows1,
463 CountableN rows1,
460 I.FromNat rows2 ~ I.FromNat rows1,
464 I.FromNat rows2 ~ I.FromNat rows1,
461 I.FromNat cols1 ~ I.FromNat cols2,
465 I.FromNat cols1 ~ I.FromNat cols2,
@@ -468,9 +472,9 @@ select (M m) (M y) = M (I.select m y)
468cond ::
472cond ::
469 ( I.FromNat (I.Count (I.FromNat cols)) ~ I.FromNat cols,
473 ( I.FromNat (I.Count (I.FromNat cols)) ~ I.FromNat cols,
470 CountableN cols,
474 CountableN cols,
471− I.FL () (I.FromNat cols),
475+ I.FromLists e () (I.FromNat cols),
472− I.FL (I.FromNat cols) (),
476+ I.FromLists e (I.FromNat cols) (),
473− FLN e cols cols,
477+ FromListsN e cols cols,
474 Liftable e a Bool
478 Liftable e a Bool
475 )
479 )
476 =>
480 =>
@@ -479,10 +483,10 @@ cond p (M a) (M b) = M (I.cond p a b)
479
483
480-- Pretty print
484-- Pretty print
481
485
482−pretty :: (CountableDimsN cols rows, Show e) => Matrix e cols rows -> String
486+pretty :: (CountableDimensionsN cols rows, Show e) => Matrix e cols rows -> String
483pretty (M m) = I.pretty m
487pretty (M m) = I.pretty m
484
488
485−prettyPrint :: (CountableDimsN cols rows, Show e) => Matrix e cols rows -> IO ()
489+prettyPrint :: (CountableDimensionsN cols rows, Show e) => Matrix e cols rows -> IO ()
486prettyPrint (M m) = I.prettyPrint m
490prettyPrint (M m) = I.prettyPrint m
487
491
488-- | Zip two matrices with a given binary function
492-- | Zip two matrices with a given binary function
src/LAoP/Matrix/Type.hs+224−236
@@ -6,6 +6,7 @@
6{-# LANGUAGE FlexibleContexts #-}
6{-# LANGUAGE FlexibleContexts #-}
7{-# LANGUAGE FlexibleInstances #-}
7{-# LANGUAGE FlexibleInstances #-}
8{-# LANGUAGE GADTs #-}
8{-# LANGUAGE GADTs #-}
9+{-# LANGUAGE KindSignatures #-}
9{-# LANGUAGE MultiParamTypeClasses #-}
10{-# LANGUAGE MultiParamTypeClasses #-}
10{-# LANGUAGE NoStarIsType #-}
11{-# LANGUAGE NoStarIsType #-}
11{-# LANGUAGE RankNTypes #-}
12{-# LANGUAGE RankNTypes #-}
@@ -58,10 +59,10 @@ module LAoP.Matrix.Type
58
59
59 -- * Constraint type aliases
60 -- * Constraint type aliases
60 Countable,
61 Countable,
61− CountableDims,
62+ CountableDimensions,
62 CountableN,
63 CountableN,
63− CountableDimsN,
64+ CountableDimensionsN,
64− FLN,
65+ FromListsN,
65 Liftable,
66 Liftable,
66 Trivial,
67 Trivial,
67 TrivialP,
68 TrivialP,
@@ -71,6 +72,7 @@ module LAoP.Matrix.Type
71 One,
72 One,
72
73
73 -- * Primitives
74 -- * Primitives
75+ empty,
74 one,
76 one,
75 join,
77 join,
76 fork,
78 fork,
@@ -85,10 +87,9 @@ module LAoP.Matrix.Type
85 fromLists,
87 fromLists,
86 toLists,
88 toLists,
87 toList,
89 toList,
88− matrixBuilder',
89 matrixBuilder,
90 matrixBuilder,
90− row,
91+ rowL,
91− col,
92+ colL,
92 zeros,
93 zeros,
93 ones,
94 ones,
94 bang,
95 bang,
@@ -104,8 +105,8 @@ module LAoP.Matrix.Type
104 multM,
105 multM,
105
106
106 -- * Selective equivalent instance function
107 -- * Selective equivalent instance function
107− selectM,
108+ selectM,
108−
109+
109 -- * Monad equivalent instance function
110 -- * Monad equivalent instance function
110 returnM,
111 returnM,
111 bindM,
112 bindM,
@@ -113,9 +114,7 @@ module LAoP.Matrix.Type
113 -- * Misc
114 -- * Misc
114 -- ** Get dimensions
115 -- ** Get dimensions
115 columns,
116 columns,
116− columns',
117 rows,
117 rows,
118− rows',
119
118
120 -- ** Matrix Transposition
119 -- ** Matrix Transposition
121 tr,
120 tr,
@@ -125,7 +124,7 @@ module LAoP.Matrix.Type
125 (./),
124 (./),
126
125
127 -- ** McCarthy's Conditional
126 -- ** McCarthy's Conditional
128− cond,
127+ -- cond,
129
128
130 -- ** Matrix "abiding"
129 -- ** Matrix "abiding"
131 abideJF,
130 abideJF,
@@ -168,7 +167,6 @@ module LAoP.Matrix.Type
168 -- implement the standard type classes present in standard Haskell.
167 -- implement the standard type classes present in standard Haskell.
169 iden,
168 iden,
170 comp,
169 comp,
171− fromF',
172 fromF,
170 fromF,
173
171
174 -- * Relation
172 -- * Relation
@@ -181,44 +179,46 @@ module LAoP.Matrix.Type
181where
179where
182
180
183import Data.Void
181import Data.Void
184−import Data.Proxy
185import Data.Kind
182import Data.Kind
186−import GHC.TypeLits
183+import GHC.TypeLits
187import Control.DeepSeq
184import Control.DeepSeq
188import LAoP.Utils
185import LAoP.Utils
189−import qualified LAoP.Matrix.Internal as I
186+import qualified LAoP.Matrix.Alternative as I
190import Prelude hiding (id, (.))
187import Prelude hiding (id, (.))
191
188
192newtype Matrix e (cols :: Type) (rows :: Type) = M (I.Matrix e (I.Normalize cols) (I.Normalize rows))
189newtype Matrix e (cols :: Type) (rows :: Type) = M (I.Matrix e (I.Normalize cols) (I.Normalize rows))
193 deriving (Show, Num, Eq, Ord, NFData) via (I.Matrix e (I.Normalize cols) (I.Normalize rows))
190 deriving (Show, Num, Eq, Ord, NFData) via (I.Matrix e (I.Normalize cols) (I.Normalize rows))
194
191
195-- | Constraint type synonyms to keep the type signatures less convoluted
192-- | Constraint type synonyms to keep the type signatures less convoluted
196−type Countable a = KnownNat (I.Count a)
193+type Countable a = KnownNat (I.Count a)
197−type CountableDims a b = (Countable a, Countable b)
194+type CountableDimensions a b = (Countable a, Countable b)
198−type CountableN a = KnownNat (I.Count (I.Normalize a))
195+type CountableN a = KnownNat (I.Count (I.Normalize a))
199−type CountableDimsN a b = (CountableN a, CountableN b)
196+type CountableDimensionsN a b = (CountableN a, CountableN b)
200−type FLN a b = I.FromLists (I.Normalize a) (I.Normalize b)
197+type FromListsN e a b = I.FromLists e (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)
198+type Liftable a b = (Eq b, Enumerable a, Enum a, EnumN a, Enum b, EnumN b, ConstructableN a b)
202−type Trivial a = I.Normalize (I.Normalize a) ~ I.Normalize (I.Normalize (I.Normalize a))
199+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)
200+type Trivial2 a = 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)
201+type TrivialP a b = I.Normalize (a, b) ~ I.Normalize (I.Normalize a, I.Normalize b)
202+type EqN a = Eq (I.Normalize a)
203+type EnumN a = Enum (I.Normalize a)
204+type Enumerable a = (Enum a, Bounded a)
205+type EnumerableN a = (Enum (I.Normalize a), Bounded (I.Normalize a))
206+type ConstructNorm a = (Enum a, Enum (I.Normalize a))
207+type ConstructN a = I.Construct (I.Normalize a)
208+type ConstructableN a b = (I.Construct (I.Normalize a), I.Construct (I.Normalize b))
206
209
207-- | It is possible to implement a constrained version of the category type
210-- | It is possible to implement a constrained version of the category type
208-- class.
211-- class.
209instance (Num e) => Category (Matrix e) where
212instance (Num e) => Category (Matrix e) where
210− type Object (Matrix e) a = (FLN a a, CountableN a)
213+ type Object (Matrix e) a = (Num e, EqN a, ConstructN a, EnumerableN a)
211 id = iden
214 id = iden
212 (.) = comp
215 (.) = comp
213
216
214-- | Bifunctor equivalent function
217-- | Bifunctor equivalent function
215bimapM ::
218bimapM ::
216− ( Liftable e a b,
219+ ( Num e,
217− Liftable e c d,
220+ Liftable a b,
218− CountableDimsN a c,
221+ Liftable c d
219− CountableDimsN b d,
220− FLN d c,
221− FLN b a
222 ) => (a -> b) -> (c -> d) -> Matrix e a c -> Matrix e b d
222 ) => (a -> b) -> (c -> d) -> Matrix e a c -> Matrix e b d
223bimapM f g m = fromF g . m . tr (fromF f)
223bimapM f g m = fromF g . m . tr (fromF f)
224
224
@@ -230,6 +230,10 @@ type One = ()
230
230
231-- Primitives
231-- Primitives
232
232
233+-- | Empty matrix constructor
234+empty :: Matrix e Zero Zero
235+empty = M I.Empty
236+
233-- | Unit matrix constructor
237-- | Unit matrix constructor
234one :: e -> Matrix e One One
238one :: e -> Matrix e One One
235one = M . I.One
239one = M . I.One
@@ -267,10 +271,9 @@ infixl 2 ===
267-- Functor hierarchy
271-- Functor hierarchy
268
272
269-- | Functor instance equivalent function
273-- | Functor instance equivalent function
270−fmapM ::
274+fmapM ::
271− ( Liftable e a b,
275+ ( Num e,
272− CountableDimsN a b,
276+ Liftable a b
273− FLN b a
274 )
277 )
275 =>
278 =>
276 (a -> b) -> Matrix e c a -> Matrix e c b
279 (a -> b) -> Matrix e c a -> Matrix e c b
@@ -281,30 +284,19 @@ unitM :: (Num e) => Matrix e () ()
281unitM = one 1
284unitM = one 1
282
285
283-- | Applicative instance equivalent 'unit' function,
286-- | Applicative instance equivalent 'unit' function,
284−multM ::
287+multM ::
285− ( CountableDimsN a b,
286− CountableN (a, b),
287− Num e,
288+ ( Num e,
288− FLN (a, b) a,
289+ FstM a b,
289− FLN (a, b) b,
290+ SndM a b
290− TrivialP a b
291 ) => Matrix e c a -> Matrix e c b -> Matrix e c (a, b)
291 ) => Matrix e c a -> Matrix e c b -> Matrix e c (a, b)
292multM = kr
292multM = kr
293
293
294-- | Monad instance equivalent 'return' function,
294-- | Monad instance equivalent 'return' function,
295returnM ::
295returnM ::
296− forall e a .
297 ( Num e,
296 ( Num e,
298− Enum e,
297+ Liftable () a
299− Enum a,
300− FLN () a,
301− Countable a
302 ) => a -> Matrix e One a
298 ) => a -> Matrix e One a
303−returnM a = col l
299+returnM = point
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..]
308
300
309-- | Monad instance equivalent '(>>=)' function,
301-- | Monad instance equivalent '(>>=)' function,
310bindM :: (Num e) => Matrix e a b -> Matrix e b c -> Matrix e a c
302bindM :: (Num e) => Matrix e a b -> Matrix e b c -> Matrix e a c
@@ -314,66 +306,42 @@ bindM = flip comp
314
306
315-- | Build a matrix out of a list of list of elements. Throws a runtime
307-- | Build a matrix out of a list of list of elements. Throws a runtime
316-- error if the dimensions do not match.
308-- error if the dimensions do not match.
317−fromLists :: (FLN cols rows) => [[e]] -> Matrix e cols rows
309+fromLists :: (FromListsN e cols rows) => [[e]] -> Matrix e cols rows
318fromLists = M . I.fromLists
310fromLists = M . I.fromLists
319
311
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−
327-- | Matrix builder function. Constructs a matrix provided with
312-- | Matrix builder function. Constructs a matrix provided with
328-- a construction function that operates with arbitrary types.
313-- a construction function that operates with arbitrary types.
329matrixBuilder ::
314matrixBuilder ::
330− ( FLN a b,
315+ ( Num e,
331− Enum a,
316+ Enumerable a,
332− Enum b,
317+ Enum b,
333− Bounded a,
318+ EnumN a,
334− Bounded b,
319+ EnumN b,
335− Eq a,
320+ ConstructableN a b
336− Countable b
321+ )
337− ) => ((a, b) -> e) -> Matrix e a b
322+ => ((a, b) -> e) -> Matrix e a b
338−matrixBuilder f = M (I.matrixBuilder f)
323+matrixBuilder = M . I.matrixBuilderN
339
324
340-- | Constructs a column vector matrix
325-- | Constructs a column vector matrix
341−col :: (FLN () rows) => [e] -> Matrix e One rows
326+colL :: (FromListsN e () rows) => [e] -> Matrix e One rows
342−col = M . I.col
327+colL = M . I.colL
343
328
344-- | Constructs a row vector matrix
329-- | Constructs a row vector matrix
345−row :: (FLN cols ()) => [e] -> Matrix e cols One
330+rowL :: (FromListsN e cols ()) => [e] -> Matrix e cols One
346−row = M . I.row
331+rowL = M . I.rowL
347−
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'
359
332
360-- | Lifts functions to matrices with dimensions matching @a@ and @b@
333-- | Lifts functions to matrices with dimensions matching @a@ and @b@
361-- cardinality's.
334-- cardinality's.
362fromF ::
335fromF ::
336+ ( Num e,
363− ( Liftable e a b,
337+ Liftable a b
364− CountableDimsN a b,
365− FLN b a
366− ) =>
338+ )
367− (a -> b) -> Matrix e a b
339+ => (a -> b) -> Matrix e a b
368−fromF = M . I.fromF
340+fromF = M . I.fromFN
369
341
370-- | Lifts relation functions to Boolean Matrix
342-- | Lifts relation functions to Boolean Matrix
371−toRel ::
372− ( Liftable (Natural 0 1) a b,
373− CountableDims a b,
374− FLN b a
375− ) => (a -> b -> Bool) -> Matrix (Natural 0 1) a b
343+toRel :: Liftable a b => (a -> b -> Bool) -> Matrix (Natural 0 1) a b
376−toRel = M . I.toRel
344+toRel = M . I.toRelN
377
345
378-- Conversion
346-- Conversion
379
347
@@ -389,8 +357,11 @@ toList (M m) = I.toList m
389
357
390-- | The zero matrix. A matrix wholly filled with zeros.
358-- | The zero matrix. A matrix wholly filled with zeros.
391zeros ::
359zeros ::
392− (Num e, FLN cols rows, CountableDimsN cols rows)
360+ ( Num e,
361+ ConstructableN cols rows,
362+ EnumerableN cols
363+ )
393− => Matrix e cols rows
364+ => Matrix e cols rows
394zeros = M I.zeros
365zeros = M I.zeros
395
366
396-- Ones Matrix
367-- Ones Matrix
@@ -399,8 +370,11 @@ zeros = M I.zeros
399--
370--
400-- Also known as T (Top) matrix.
371-- Also known as T (Top) matrix.
401ones ::
372ones ::
402− (Num e, FLN cols rows, CountableDimsN cols rows)
373+ ( Num e,
374+ ConstructableN cols rows,
375+ EnumerableN cols
376+ )
403− => Matrix e cols rows
377+ => Matrix e cols rows
404ones = M I.ones
378ones = M I.ones
405
379
406-- Const Matrix
380-- Const Matrix
@@ -408,28 +382,28 @@ ones = M I.ones
408-- | The constant matrix constructor. A matrix wholly filled with a given
382-- | The constant matrix constructor. A matrix wholly filled with a given
409-- value.
383-- value.
410constant ::
384constant ::
411− (Num e, FLN cols rows, CountableDimsN cols rows)
385+ ( Num e,
386+ ConstructableN cols rows,
387+ EnumerableN cols
388+ )
412− => e -> Matrix e cols rows
389+ => e -> Matrix e cols rows
413constant = M . I.constant
390constant = M . I.constant
414
391
415-- Bang Matrix
392-- Bang Matrix
416
393
417-- | The T (Top) row vector matrix.
394-- | The T (Top) row vector matrix.
418bang ::
395bang ::
419− forall e cols.
396+ ( Num e,
420− (Num e, Enum e, FLN cols (), CountableN cols) =>
397+ ConstructN cols,
398+ EnumerableN cols
399+ )
421− Matrix e cols One
400+ => Matrix e cols One
422−bang = M I.bang
401+bang = ones
423
402
424−-- | Point constant relation
403+-- | Point constant matrix
425point ::
404point ::
426− ( Bounded a,
427− Enum a,
428− Eq a,
429− Num e,
405+ ( Num e,
430− Ord e,
406+ Liftable () a
431− CountableN a,
432− FLN a One
433 ) => a -> Matrix e One a
407 ) => a -> Matrix e One a
434point = fromF . const
408point = fromF . const
435
409
@@ -437,8 +411,12 @@ point = fromF . const
437
411
438-- | iden matrix
412-- | iden matrix
439iden ::
413iden ::
440− (Num e, FLN a a, CountableN a) =>
414+ ( Num e,
415+ EqN a,
416+ ConstructN a,
417+ EnumerableN a
418+ )
441− Matrix e a a
419+ => Matrix e a a
442iden = M I.iden
420iden = M I.iden
443{-# NOINLINE iden #-}
421{-# NOINLINE iden #-}
444
422
@@ -451,7 +429,7 @@ iden = M I.iden
451comp :: (Num e) => Matrix e cr rows -> Matrix e cols cr -> Matrix e cols rows
429comp :: (Num e) => Matrix e cr rows -> Matrix e cols cr -> Matrix e cols rows
452comp (M a) (M b) = M (I.comp a b)
430comp (M a) (M b) = M (I.comp a b)
453{-# NOINLINE comp #-}
431{-# NOINLINE comp #-}
454−{-# RULES
432+{-# RULES
455 "comp/iden1" forall m. comp m iden = m ;
433 "comp/iden1" forall m. comp m iden = m ;
456 "comp/iden2" forall m. comp iden m = m
434 "comp/iden2" forall m. comp iden m = m
457#-}
435#-}
@@ -472,140 +450,144 @@ infixl 7 ./
472
450
473-- | Biproduct first component projection
451-- | Biproduct first component projection
474p1 ::
452p1 ::
475− ( Num e,
453+ ( Num e,
476− CountableDimsN n m,
454+ EqN m,
477− FLN n m,
455+ ConstructableN m n,
478− FLN m m
456+ EnumerableN m,
457+ EnumerableN n
479− ) =>
458+ )
480− Matrix e (Either m n) m
459+ => Matrix e (Either m n) m
481p1 = M I.p1
460p1 = M I.p1
482
461
483-- | Biproduct second component projection
462-- | Biproduct second component projection
484p2 ::
463p2 ::
485− ( Num e,
464+ ( Num e,
486− CountableDimsN n m,
465+ EqN n,
487− FLN m n,
466+ ConstructableN m n,
488− FLN n n
467+ EnumerableN m,
468+ EnumerableN n
489− ) =>
469+ )
490− Matrix e (Either m n) n
470+ => Matrix e (Either m n) n
491p2 = M I.p2
471p2 = M I.p2
492
472
493-- Injections
473-- Injections
494
474
495-- | Biproduct first component injection
475-- | Biproduct first component injection
496i1 ::
476i1 ::
497− ( Num e,
477+ ( Num e,
498− CountableDimsN n m,
478+ EqN m,
499− FLN n m,
479+ ConstructableN m n,
500− FLN m m
480+ EnumerableN m,
481+ EnumerableN n
501− ) =>
482+ )
502− Matrix e m (Either m n)
483+ => Matrix e m (Either m n)
503i1 = tr p1
484i1 = tr p1
504
485
505-- | Biproduct second component injection
486-- | Biproduct second component injection
506i2 ::
487i2 ::
507− ( Num e,
488+ ( Num e,
508− CountableDimsN n m,
489+ EqN n,
509− FLN m n,
490+ ConstructableN m n,
510− FLN n n
491+ EnumerableN m,
492+ EnumerableN n
511− ) =>
493+ )
512− Matrix e n (Either m n)
494+ => Matrix e n (Either m n)
513i2 = tr p2
495i2 = tr p2
514
496
515-- Dimensions
497-- Dimensions
516
498
517-- | Obtain the number of rows.
499-- | Obtain the number of rows.
518--
500--
519−-- NOTE: The 'KnownNat' constraint is needed in order to obtain the
501+-- NOTE: The 'KnownNat' constaint is needed in order to obtain the
520−-- dimensions in constant time. For a version that doesn't require the
502+-- dimensions in constant time.
521−-- constraint see 'rows''.
522−rows :: (CountableN rows) => Matrix e cols rows -> Int
523−rows (M m) = I.rows m
524−
525−-- | Obtain the number of rows in an inefficient manner, but without any
526−-- constraints.
527--
503--
528−-- For a more efficient version see 'rows'.
504+-- TODO: A 'rows' function that does not need the 'KnownNat' constraint in
505+-- exchange for performance.
529−rows' :: Matrix e cols rows -> Int
506+rows :: CountableN rows => Matrix e cols rows -> Int
530−rows' (M m) = I.rows' m
507+rows (M m) = I.rows m
531
508
532-- | Obtain the number of columns.
509-- | Obtain the number of columns.
510+--
511+-- NOTE: The 'KnownNat' constaint is needed in order to obtain the
512+-- dimensions in constant time.
533--
513--
534−-- NOTE: The 'KnownNat' constraint is needed in order to obtain the
514+-- TODO: A 'columns' function that does not need the 'KnownNat' constraint in
535−-- dimensions in constant time. For a version that doesn't require the
515+-- exchange for performance.
536−-- constraint see 'columns''.
537−columns :: (CountableN cols) => Matrix e cols rows -> Int
516+columns :: CountableN cols => Matrix e cols rows -> Int
538columns (M m) = I.columns m
517columns (M m) = I.columns m
539
518
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−
547-- Coproduct Bifunctor
519-- Coproduct Bifunctor
548
520
549infixl 5 -|-
521infixl 5 -|-
550
522
551-- | Matrix coproduct functor also known as matrix direct sum.
523-- | Matrix coproduct functor also known as matrix direct sum.
552(-|-) ::
524(-|-) ::
553− ( Num e,
525+ ( Num e,
554− CountableDimsN j k,
526+ EqN k,
555− FLN k k,
527+ EqN j,
556− FLN j k,
528+ ConstructableN k j,
557− FLN k j,
529+ EnumerableN k,
558− FLN j j
530+ EnumerableN j
559− ) =>
560− Matrix e n k ->
561− Matrix e m j ->
562− Matrix e (Either n m) (Either k j)
531+ ) => Matrix e n k -> Matrix e m j -> Matrix e (Either n m) (Either k j)
563(-|-) (M a) (M b) = M ((I.-|-) a b)
532(-|-) (M a) (M b) = M ((I.-|-) a b)
564
533
565-- Khatri Rao Product and projections
534-- Khatri Rao Product and projections
566
535
536+type FstM a b =
537+ ( EqN a,
538+ ConstructableN (I.Normalize a) (I.Normalize (a, b)),
539+ ConstructN (I.Normalize a, I.Normalize b),
540+ EnumerableN a,
541+ EnumerableN b,
542+ EnumN (I.Normalize a, I.Normalize b),
543+ Trivial2 a,
544+ TrivialP a b
545+ )
546+
567-- | Khatri Rao product first component projection matrix.
547-- | Khatri Rao product first component projection matrix.
568fstM ::
548fstM ::
569− forall e m k .
549+ forall e a b .
570− ( Num e,
550+ ( Num e,
571− CountableDimsN m k,
551+ FstM a b
572− CountableN (m, k),
573− FLN (m, k) m,
574− TrivialP m k
575− ) => Matrix e (m, k) m
552+ ) => Matrix e (a, b) a
576−fstM = M (I.fstM @e @(I.Normalize m) @(I.Normalize k))
553+fstM = M (I.fstM @e @(I.Normalize a) @(I.Normalize b))
577−
554+
555+type SndM a b =
556+ ( EqN b,
557+ ConstructableN (I.Normalize b) (I.Normalize (a, b)),
558+ ConstructN (I.Normalize a, I.Normalize b),
559+ EnumerableN a,
560+ EnumerableN b,
561+ EnumN (I.Normalize a, I.Normalize b),
562+ Trivial2 b,
563+ TrivialP a b
564+ )
578-- | Khatri Rao product second component projection matrix.
565-- | Khatri Rao product second component projection matrix.
579sndM ::
566sndM ::
580− forall e m k.
567+ forall e a b.
581− ( Num e,
568+ ( Num e,
582− CountableDimsN k m,
569+ SndM a b
583− CountableN (m, k),
584− FLN (m, k) k,
585− TrivialP m k
586− ) => Matrix e (m, k) k
570+ ) => Matrix e (a, b) b
587−sndM = M (I.sndM @e @(I.Normalize m) @(I.Normalize k))
571+sndM = M (I.sndM @e @(I.Normalize a) @(I.Normalize b))
588
572
589-- | Khatri Rao Matrix product also known as matrix pairing.
573-- | Khatri Rao Matrix product also known as matrix pairing.
590--
574--
591-- NOTE: That this is not a true categorical product, see for instance:
575-- NOTE: That this is not a true categorical product, see for instance:
592−--
576+--
593-- @
577-- @
594−-- | fstM . kr a b == a
578+-- | fstM . kr a b == a
595-- kr a b ==> |
579-- kr a b ==> |
596-- | sndM . kr a b == b
580-- | sndM . kr a b == b
597-- @
581-- @
598--
582--
599-- __Emphasis__ on the implication symbol.
583-- __Emphasis__ on the implication symbol.
600kr ::
584kr ::
601− forall e cols a b.
585+ forall e cols a b.
602− ( Num e,
586+ ( Num e,
603− CountableDimsN a b,
587+ FstM a b,
604− CountableN (a, b),
588+ SndM a b
605− FLN (a, b) a,
589+ )
606− FLN (a, b) b,
607− TrivialP a b
608− ) => Matrix e cols a -> Matrix e cols b -> Matrix e cols (a, b)
590+ => Matrix e cols a -> Matrix e cols b -> Matrix e cols (a, b)
609kr a b =
591kr a b =
610 let fstM' = fstM @e @a @b
592 let fstM' = fstM @e @a @b
611 sndM' = sndM @e @a @b
593 sndM' = sndM @e @a @b
@@ -614,21 +596,38 @@ kr a b =
614-- Product Bifunctor (Kronecker)
596-- Product Bifunctor (Kronecker)
615
597
616infixl 4 ><
598infixl 4 ><
599+type Kronecker m n p q =
600+ ( EqN (I.Normalize m),
601+ EqN (I.Normalize n),
602+ EqN (I.Normalize p),
603+ EqN (I.Normalize q),
604+ ConstructableN (I.Normalize m) (I.Normalize n),
605+ ConstructableN (I.Normalize p) (I.Normalize q),
606+ ConstructableN (I.Normalize m, I.Normalize n) (I.Normalize p, I.Normalize q),
607+ ConstructableN (I.Normalize (I.Normalize m, I.Normalize n)) (I.Normalize (I.Normalize p, I.Normalize q)),
608+ FstM m n,
609+ SndM m n,
610+ EnumerableN (I.Normalize m),
611+ EnumerableN (I.Normalize n),
612+ EnumerableN (I.Normalize p),
613+ EnumerableN (I.Normalize q),
614+ EnumerableN (I.Normalize m, I.Normalize n),
615+ EnumerableN (I.Normalize p, I.Normalize q),
616+ Trivial2 m,
617+ Trivial2 n,
618+ Trivial2 p,
619+ Trivial2 q,
620+ TrivialP p q,
621+ TrivialP m m
622+ )
617
623
618-- | Matrix product functor also known as Kronecker product
624-- | Matrix product functor also known as Kronecker product
619(><) ::
625(><) ::
620− forall e m p n q.
626+ forall e m p n q.
621− ( Num e,
627+ ( Num e,
622− CountableDimsN m n,
628+ Kronecker m n p q
623− CountableDimsN p q,
629+ )
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)
630+ => Matrix e m p -> Matrix e n q -> Matrix e (m, n) (p, q)
632(><) a b =
631(><) a b =
633 let fstM' = fstM @e @m @n
632 let fstM' = fstM @e @m @n
634 sndM' = sndM @e @m @n
633 sndM' = sndM @e @m @n
@@ -637,7 +636,7 @@ infixl 4 ><
637-- Matrix abide Join Fork
636-- Matrix abide Join Fork
638
637
639-- | Matrix "abiding" followin the 'Join'-'Fork' abide law.
638-- | Matrix "abiding" followin the 'Join'-'Fork' abide law.
640−--
639+--
641-- Law:
640-- Law:
642--
641--
643-- @
642-- @
@@ -649,7 +648,7 @@ abideJF (M m) = M (I.abideJF m)
649-- Matrix abide Fork Join
648-- Matrix abide Fork Join
650
649
651-- | Matrix "abiding" followin the 'Fork'-'Join' abide law.
650-- | Matrix "abiding" followin the 'Fork'-'Join' abide law.
652−--
651+--
653-- Law:
652-- Law:
654--
653--
655-- @
654-- @
@@ -668,38 +667,27 @@ tr (M m) = M (I.tr m)
668
667
669-- | Selective functors 'select' operator equivalent inspired by the
668-- | Selective functors 'select' operator equivalent inspired by the
670-- ArrowMonad solution presented in the paper.
669-- ArrowMonad solution presented in the paper.
671−selectM ::
672− ( Num e,
673− FLN b b,
674− CountableN b
675− ) => Matrix e cols (Either a b) -> Matrix e a b -> Matrix e cols b
670+selectM :: (Num e, EqN b, ConstructN b, EnumerableN b) => Matrix e cols (Either a b) -> Matrix e a b -> Matrix e cols b
676selectM (M m) (M y) = M (I.select m y)
671selectM (M m) (M y) = M (I.select m y)
677
672
678-- McCarthy's Conditional
673-- McCarthy's Conditional
679
674
680-- | McCarthy's Conditional expresses probabilistic choice.
675-- | McCarthy's Conditional expresses probabilistic choice.
681−cond ::
676+-- cond ::
682− ( Trivial a,
677+-- (
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− )
678+-- )
691− =>
679+-- =>
692− (a -> Bool) -> Matrix e a b -> Matrix e a b -> Matrix e a b
680+-- (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)
681+-- cond p (M a) (M b) =
694
682
695-- Pretty print
683-- Pretty print
696
684
697-- | Matrix pretty printer
685-- | Matrix pretty printer
698−pretty :: (CountableDimsN cols rows, Show e) => Matrix e cols rows -> String
686+pretty :: (Show e, CountableDimensionsN cols rows) => Matrix e cols rows -> String
699pretty (M m) = I.pretty m
687pretty (M m) = I.pretty m
700
688
701-- | Matrix pretty printer
689-- | Matrix pretty printer
702−prettyPrint :: (CountableDimsN cols rows, Show e) => Matrix e cols rows -> IO ()
690+prettyPrint :: (CountableDimensionsN cols rows, Show e) => Matrix e cols rows -> IO ()
703prettyPrint (M m) = I.prettyPrint m
691prettyPrint (M m) = I.prettyPrint m
704
692
705-- | Zip two matrices with a given binary function
693-- | Zip two matrices with a given binary function
src/LAoP/Relation.hs+4−3
@@ -32,15 +32,16 @@ module LAoP.Relation
32
32
33 -- * Constraint type synonyms
33 -- * Constraint type synonyms
34 Countable,
34 Countable,
35− CountableDims,
35+ CountableDimensions,
36 CountableN,
36 CountableN,
37− CountableDimsN,
37+ CountableDimensionsN,
38− FLN,
38+ FromListsN,
39 Liftable,
39 Liftable,
40 Trivial,
40 Trivial,
41 TrivialP,
41 TrivialP,
42
42
43 -- * Primitives
43 -- * Primitives
44+ empty,
44 one,
45 one,
45 join,
46 join,
46 (|||),
47 (|||),
src/LAoP/Relation/Internal.hs+130−128
@@ -43,15 +43,16 @@ module LAoP.Relation.Internal
43
43
44 -- * Constraint type synonyms
44 -- * Constraint type synonyms
45 Countable,
45 Countable,
46− CountableDims,
46+ CountableDimensions,
47 CountableN,
47 CountableN,
48− CountableDimsN,
48+ CountableDimensionsN,
49− FLN,
49+ FromListsN,
50 Liftable,
50 Liftable,
51 Trivial,
51 Trivial,
52 TrivialP,
52 TrivialP,
53
53
54 -- * Primitives
54 -- * Primitives
55+ empty,
55 one,
56 one,
56 join,
57 join,
57 (|||),
58 (|||),
@@ -193,19 +194,19 @@ newtype Relation a b = R (I.Matrix Boolean (I.Normalize a) (I.Normalize b))
193deriving instance (Read (I.Matrix Boolean (I.Normalize a) (I.Normalize b))) => Read (Relation a b)
194deriving instance (Read (I.Matrix Boolean (I.Normalize a) (I.Normalize b))) => Read (Relation a b)
194
195
195-- | Constraint type synonyms to keep the type signatures less convoluted
196-- | Constraint type synonyms to keep the type signatures less convoluted
196−type Countable a = KnownNat (I.Count a)
197+type Countable a = KnownNat (I.Count a)
197−type CountableDims a b = (Countable a, Countable b)
198+type CountableDimensions a b = (Countable a, Countable b)
198−type CountableN a = KnownNat (I.Count (I.Normalize a))
199+type CountableN a = KnownNat (I.Count (I.Normalize a))
199−type CountableDimsN a b = (CountableN a, CountableN b)
200+type CountableDimensionsN a b = (CountableN a, CountableN b)
200−type FLN a b = I.FromLists (I.Normalize a) (I.Normalize b)
201+type FromListsN a b = I.FromLists Boolean (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 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 Trivial a = I.Normalize a ~ I.Normalize (I.Normalize a)
203−type TrivialP a b = I.Normalize (a, b) ~ I.Normalize (I.Normalize a, I.Normalize b)
204+type TrivialP a b = I.Normalize (a, b) ~ I.Normalize (I.Normalize a, I.Normalize b)
204
205
205-- | It is possible to implement a constrained version of the category type
206-- | It is possible to implement a constrained version of the category type
206-- class.
207-- class.
207instance Category Relation where
208instance Category Relation where
208− type Object Relation a = (FLN a a, CountableN a)
209+ type Object Relation a = (FromListsN a a, CountableN a)
209 id = iden
210 id = iden
210 (.) = comp
211 (.) = comp
211
212
@@ -228,6 +229,10 @@ type One = ()
228
229
229-- Primitives
230-- Primitives
230
231
232+-- | Empty matrix constructor
233+empty :: Relation Zero Zero
234+empty = R I.Empty
235+
231-- | Unit matrix constructor
236-- | Unit matrix constructor
232one :: Boolean -> Relation One One
237one :: Boolean -> Relation One One
233one = R . I.One
238one = R . I.One
@@ -264,26 +269,26 @@ infixl 2 ===
264
269
265-- | Build a matrix out of a list of list of elements. Throws a runtime
270-- | Build a matrix out of a list of list of elements. Throws a runtime
266-- error if the dimensions do not match.
271-- error if the dimensions do not match.
267−fromLists :: (FLN a b) => [[Boolean]] -> Relation a b
272+fromLists :: (FromListsN a b) => [[Boolean]] -> Relation a b
268fromLists = R . I.fromLists
273fromLists = R . I.fromLists
269
274
270-- | Relation builder function. Constructs a relation provided with
275-- | Relation builder function. Constructs a relation provided with
271-- a construction function that operates with indices.
276-- a construction function that operates with indices.
272relationBuilder' ::
277relationBuilder' ::
273− (FLN a b, CountableDimsN a b) =>
278+ (FromListsN a b, CountableDimensionsN a b) =>
274 ((Int, Int) -> Boolean) -> Relation a b
279 ((Int, Int) -> Boolean) -> Relation a b
275relationBuilder' = R . I.matrixBuilder'
280relationBuilder' = R . I.matrixBuilder'
276
281
277-- | Relation builder function. Constructs a relation provided with
282-- | Relation builder function. Constructs a relation provided with
278-- a construction function that operates with arbitrary types.
283-- a construction function that operates with arbitrary types.
279relationBuilder ::
284relationBuilder ::
280− ( FLN a b,
285+ ( FromListsN a b,
281 Enum a,
286 Enum a,
282 Enum b,
287 Enum b,
283 Bounded a,
288 Bounded a,
284 Bounded b,
289 Bounded b,
285 Eq a,
290 Eq a,
286− CountableDims a b
291+ CountableDimensionsN a b
287 ) => ((a, b) -> Boolean) -> Relation a b
292 ) => ((a, b) -> Boolean) -> Relation a b
288relationBuilder = R . I.matrixBuilder
293relationBuilder = R . I.matrixBuilder
289
294
@@ -293,18 +298,18 @@ relationBuilder = R . I.matrixBuilder
293-- types @a@ or @b@ allows.
298-- types @a@ or @b@ allows.
294fromF' ::
299fromF' ::
295 ( Liftable a b,
300 ( Liftable a b,
296− CountableDimsN c d,
301+ CountableDimensionsN c d,
297− FLN d c
302+ FromListsN d c
298 )
303 )
299 => (a -> b) -> Relation c d
304 => (a -> b) -> Relation c d
300fromF' f = R (I.fromFRel' f)
305fromF' f = R (I.fromFRel' f)
301
306
302-- | Lifts functions to matrices with dimensions matching @a@ and @b@
307-- | Lifts functions to matrices with dimensions matching @a@ and @b@
303-- cardinality's.
308-- cardinality's.
304−fromF ::
309+fromF ::
305 ( Liftable a b,
310 ( Liftable a b,
306− CountableDimsN a b,
311+ CountableDimensionsN a b,
307− FLN b a
312+ FromListsN b a
308 )
313 )
309 => (a -> b) -> Relation a b
314 => (a -> b) -> Relation a b
310fromF f = R (I.fromFRel f)
315fromF f = R (I.fromFRel f)
@@ -312,8 +317,8 @@ fromF f = R (I.fromFRel f)
312-- | Lifts relation functions to 'Relation'
317-- | Lifts relation functions to 'Relation'
313toRel ::
318toRel ::
314 ( Liftable a b,
319 ( Liftable a b,
315− CountableDims a b,
320+ CountableDimensionsN a b,
316− FLN b a
321+ FromListsN b a
317 )
322 )
318 => (a -> b -> Bool) -> Relation a b
323 => (a -> b -> Bool) -> Relation a b
319toRel = R . I.toRel
324toRel = R . I.toRel
@@ -322,9 +327,9 @@ toRel = R . I.toRel
322fromRel ::
327fromRel ::
323 ( Liftable a b,
328 ( Liftable a b,
324 Eq a,
329 Eq a,
325− CountableDimsN a b,
330+ CountableDimensionsN a b,
326− FLN a One,
331+ FromListsN a One,
327− FLN b One
332+ FromListsN b One
328 )
333 )
329 => Relation a b -> (a -> b -> Bool)
334 => Relation a b -> (a -> b -> Bool)
330fromRel r a b = pointApBool a b r
335fromRel r a b = pointApBool a b r
@@ -348,12 +353,12 @@ toBool r = case toList r of
348-- | Power transpose.
353-- | Power transpose.
349--
354--
350-- Maps a relation to a set valued function.
355-- Maps a relation to a set valued function.
351−pt ::
356+pt ::
352 ( Liftable a b,
357 ( Liftable a b,
353 Eq a,
358 Eq a,
354− CountableDimsN a b,
359+ CountableDimensionsN a b,
355− FLN a One,
360+ FromListsN a One,
356− FLN b One
361+ FromListsN b One
357 )
362 )
358 => Relation a b -> (a -> List b)
363 => Relation a b -> (a -> List b)
359pt r a =
364pt r a =
@@ -365,8 +370,8 @@ belongs ::
365 ( Bounded a,
370 ( Bounded a,
366 Enum a,
371 Enum a,
367 Eq a,
372 Eq a,
368− CountableDims (List a) a,
373+ CountableDimensionsN (List a) a,
369− FLN a (List a)
374+ FromListsN a (List a)
370 )
375 )
371 => Relation (List a) a
376 => Relation (List a) a
372belongs = toRel elemR
377belongs = toRel elemR
@@ -378,14 +383,14 @@ belongs = toRel elemR
378-- | The zero relation. A relation where no element of type @a@ relates
383-- | The zero relation. A relation where no element of type @a@ relates
379-- with elements of type @b@.
384-- with elements of type @b@.
380--
385--
381−-- Also known as ⊥ (Bottom) Relation.
386+-- Also known as ⊥ (Bottom) Relation or empty Relation.
382--
387--
383-- @
388-- @
384-- r `.` ⊥ == ⊥ `.` r == ⊥
389-- r `.` ⊥ == ⊥ `.` r == ⊥
385-- ⊥ ``sse`` R && R ``sse`` T == True
390-- ⊥ ``sse`` R && R ``sse`` T == True
386-- @
391-- @
387zeros ::
392zeros ::
388− (FLN a b, CountableDimsN a b) =>
393+ (FromListsN a b, CountableDimensionsN a b) =>
389 Relation a b
394 Relation a b
390zeros = relationBuilder' (const (nat 0))
395zeros = relationBuilder' (const (nat 0))
391
396
@@ -400,7 +405,7 @@ zeros = relationBuilder' (const (nat 0))
400-- ⊥ ``sse`` R && R ``sse`` T == True
405-- ⊥ ``sse`` R && R ``sse`` T == True
401-- @
406-- @
402ones ::
407ones ::
403− (FLN a b, CountableDimsN a b) =>
408+ (FromListsN a b, CountableDimensionsN a b) =>
404 Relation a b
409 Relation a b
405ones = relationBuilder' (const (nat 1))
410ones = relationBuilder' (const (nat 1))
406
411
@@ -408,17 +413,17 @@ ones = relationBuilder' (const (nat 1))
408
413
409-- | The T (Top) row vector relation.
414-- | The T (Top) row vector relation.
410bang ::
415bang ::
411− (FLN a One, CountableN a) =>
416+ (FromListsN a One, CountableN a) =>
412 Relation a One
417 Relation a One
413bang = ones
418bang = ones
414
419
415-- | Point constant relation
420-- | Point constant relation
416−point ::
421+point ::
417 ( Bounded a,
422 ( Bounded a,
418 Enum a,
423 Enum a,
419 Eq a,
424 Eq a,
420 CountableN a,
425 CountableN a,
421− FLN a One
426+ FromListsN a One
422 ) => a -> Relation One a
427 ) => a -> Relation One a
423point = fromF . const
428point = fromF . const
424
429
@@ -430,7 +435,7 @@ point = fromF . const
430-- 'iden' `.` r == r == r `.` 'iden'
435-- 'iden' `.` r == r == r `.` 'iden'
431-- @
436-- @
432iden ::
437iden ::
433− (FLN a a, CountableN a) => Relation a a
438+ (FromListsN a a, CountableN a) => Relation a a
434iden = relationBuilder' (bool (nat 0) (nat 1) . uncurry (==))
439iden = relationBuilder' (bool (nat 0) (nat 1) . uncurry (==))
435
440
436-- | Relational composition
441-- | Relational composition
@@ -484,7 +489,7 @@ shrunkBy r s = r `intersection` divR s (conv r)
484-- r ``overriddenBy`` r == r
489-- r ``overriddenBy`` r == r
485-- @
490-- @
486overriddenBy ::
491overriddenBy ::
487− ( FLN b b,
492+ ( FromListsN b b,
488 CountableN b
493 CountableN b
489 ) => Relation a b -> Relation a b -> Relation a b
494 ) => Relation a b -> Relation a b -> Relation a b
490overriddenBy r s = s `union` r `intersection` divR zeros (conv s)
495overriddenBy r s = s `union` r `intersection` divR zeros (conv s)
@@ -496,9 +501,9 @@ overriddenBy r s = s `union` r `intersection` divR zeros (conv s)
496pointAp ::
501pointAp ::
497 ( Liftable a b,
502 ( Liftable a b,
498 Eq a,
503 Eq a,
499− CountableDimsN a b,
504+ CountableDimensionsN a b,
500− FLN a One,
505+ FromListsN a One,
501− FLN b One
506+ FromListsN b One
502 ) => a -> b -> Relation a b -> Relation One One
507 ) => a -> b -> Relation a b -> Relation One One
503pointAp a b r = conv (point b) . r . point a
508pointAp a b r = conv (point b) . r . point a
504
509
@@ -508,9 +513,9 @@ pointAp a b r = conv (point b) . r . point a
508pointApBool ::
513pointApBool ::
509 ( Liftable a b,
514 ( Liftable a b,
510 Eq a,
515 Eq a,
511− CountableDimsN a b,
516+ CountableDimensionsN a b,
512− FLN a One,
517+ FromListsN a One,
513− FLN b One
518+ FromListsN b One
514 ) => a -> b -> Relation a b -> Bool
519 ) => a -> b -> Relation a b -> Bool
515pointApBool a b r = toBool $ conv (point b) . r . point a
520pointApBool a b r = toBool $ conv (point b) . r . point a
516
521
@@ -590,19 +595,19 @@ divisionF f g = conv g . f
590-- Taxonomy of binary relations
595-- Taxonomy of binary relations
591
596
592-- | A 'Relation' @r@ is 'simple' 'iff' @'coreflexive' ('img' r)@
597-- | A 'Relation' @r@ is 'simple' 'iff' @'coreflexive' ('img' r)@
593−simple :: (CountableN b, FLN b b) => Relation a b -> Bool
598+simple :: (CountableN b, FromListsN b b) => Relation a b -> Bool
594simple = coreflexive . img
599simple = coreflexive . img
595
600
596-- | A 'Relation' @r@ is 'injective' 'iff' @'coreflexive' ('ker' r)@
601-- | A 'Relation' @r@ is 'injective' 'iff' @'coreflexive' ('ker' r)@
597−injective :: (CountableN a, FLN a a) => Relation a b -> Bool
602+injective :: (CountableN a, FromListsN a a) => Relation a b -> Bool
598injective = coreflexive . ker
603injective = coreflexive . ker
599
604
600-- | A 'Relation' @r@ is 'entire' 'iff' @'reflexive' ('ker' r)@
605-- | A 'Relation' @r@ is 'entire' 'iff' @'reflexive' ('ker' r)@
601−entire :: (CountableN a, FLN a a) => Relation a b -> Bool
606+entire :: (CountableN a, FromListsN a a) => Relation a b -> Bool
602entire = reflexive . ker
607entire = reflexive . ker
603
608
604-- | A 'Relation' @r@ is 'surjective' 'iff' @'reflexive' ('img' r)@
609-- | A 'Relation' @r@ is 'surjective' 'iff' @'reflexive' ('img' r)@
605−surjective :: (CountableN b, FLN b b) => Relation a b -> Bool
610+surjective :: (CountableN b, FromListsN b b) => Relation a b -> Bool
606surjective = reflexive . img
611surjective = reflexive . img
607
612
608-- | A 'Relation' @r@ is a 'function' 'iff' @'simple' r && 'entire' r@
613-- | A 'Relation' @r@ is a 'function' 'iff' @'simple' r && 'entire' r@
@@ -615,9 +620,9 @@ surjective = reflexive . img
615-- r `.` f ``sse`` s == r ``sse`` s `.` f
620-- r `.` f ``sse`` s == r ``sse`` s `.` f
616-- @
621-- @
617function ::
622function ::
618− ( CountableDimsN a b,
623+ ( CountableDimensionsN a b,
619− FLN a a,
624+ FromListsN a a,
620− FLN b b
625+ FromListsN b b
621 )
626 )
622 => Relation a b -> Bool
627 => Relation a b -> Bool
623function r = simple r && entire r
628function r = simple r && entire r
@@ -625,7 +630,7 @@ function r = simple r && entire r
625-- | A 'Relation' @r@ is a 'representation' 'iff' @'injective' r && 'entire' r@
630-- | A 'Relation' @r@ is a 'representation' 'iff' @'injective' r && 'entire' r@
626representation ::
631representation ::
627 ( CountableN a,
632 ( CountableN a,
628− FLN a a
633+ FromListsN a a
629 )
634 )
630 => Relation a b -> Bool
635 => Relation a b -> Bool
631representation r = injective r && entire r
636representation r = injective r && entire r
@@ -633,45 +638,45 @@ representation r = injective r && entire r
633-- | A 'Relation' @r@ is an 'abstraction' 'iff' @'surjective' r && 'simple' r@
638-- | A 'Relation' @r@ is an 'abstraction' 'iff' @'surjective' r && 'simple' r@
634abstraction ::
639abstraction ::
635 ( CountableN b,
640 ( CountableN b,
636− FLN b b
641+ FromListsN b b
637 )
642 )
638 => Relation a b -> Bool
643 => Relation a b -> Bool
639abstraction r = surjective r && simple r
644abstraction r = surjective r && simple r
640
645
641-- | A 'Relation' @r@ is a 'surjection' 'iff' @'function' r && 'abstraction' r@
646-- | A 'Relation' @r@ is a 'surjection' 'iff' @'function' r && 'abstraction' r@
642surjection ::
647surjection ::
643− ( CountableDimsN a b,
648+ ( CountableDimensionsN a b,
644− FLN a a,
649+ FromListsN a a,
645− FLN b b
650+ FromListsN b b
646 )
651 )
647 => Relation a b -> Bool
652 => Relation a b -> Bool
648surjection r = function r && abstraction r
653surjection r = function r && abstraction r
649
654
650-- | A 'Relation' @r@ is a 'injection' 'iff' @'function' r && 'representation' r@
655-- | A 'Relation' @r@ is a 'injection' 'iff' @'function' r && 'representation' r@
651injection ::
656injection ::
652− ( CountableDimsN a b,
657+ ( CountableDimensionsN a b,
653− FLN a a,
658+ FromListsN a a,
654− FLN b b
659+ FromListsN b b
655 )
660 )
656 => Relation a b -> Bool
661 => Relation a b -> Bool
657injection r = function r && representation r
662injection r = function r && representation r
658
663
659-- | A 'Relation' @r@ is an 'bijection' 'iff' @'injection' r && 'surjection' r@
664-- | A 'Relation' @r@ is an 'bijection' 'iff' @'injection' r && 'surjection' r@
660bijection ::
665bijection ::
661− ( CountableDimsN a b,
666+ ( CountableDimensionsN a b,
662− FLN b b,
667+ FromListsN b b,
663− FLN a a
668+ FromListsN a a
664 ) => Relation a b -> Bool
669 ) => Relation a b -> Bool
665bijection r = injection r && surjection r
670bijection r = injection r && surjection r
666
671
667-- Properties of relations
672-- Properties of relations
668
673
669-- | A 'Relation' @r@ is 'reflexive' 'iff' @'id' ``sse`` r@
674-- | A 'Relation' @r@ is 'reflexive' 'iff' @'id' ``sse`` r@
670−reflexive :: (CountableN a, FLN a a) => Relation a a -> Bool
675+reflexive :: (CountableN a, FromListsN a a) => Relation a a -> Bool
671reflexive r = id <= r
676reflexive r = id <= r
672
677
673-- | A 'Relation' @r@ is 'coreflexive' 'iff' @r ``sse`` 'id'@
678-- | A 'Relation' @r@ is 'coreflexive' 'iff' @r ``sse`` 'id'@
674−coreflexive :: (CountableN a, FLN a a) => Relation a a -> Bool
679+coreflexive :: (CountableN a, FromListsN a a) => Relation a a -> Bool
675coreflexive r = r <= id
680coreflexive r = r <= id
676
681
677-- | A 'Relation' @r@ is 'transitive' 'iff' @(r `.` r) ``sse`` r@
682-- | A 'Relation' @r@ is 'transitive' 'iff' @(r `.` r) ``sse`` r@
@@ -683,35 +688,35 @@ symmetric :: Relation a a -> Bool
683symmetric r = r == conv r
688symmetric r = r == conv r
684
689
685-- | A 'Relation' @r@ is anti-symmetric 'iff' @(r ``intersection`` 'conv' r) ``sse`` 'id'@
690-- | A 'Relation' @r@ is anti-symmetric 'iff' @(r ``intersection`` 'conv' r) ``sse`` 'id'@
686−antiSymmetric :: (CountableN a, FLN a a) => Relation a a -> Bool
691+antiSymmetric :: (CountableN a, FromListsN a a) => Relation a a -> Bool
687antiSymmetric r = (r `intersection` conv r) `sse` id
692antiSymmetric r = (r `intersection` conv r) `sse` id
688
693
689-- | A 'Relation' @r@ is 'irreflexive' 'iff' @(r ``intersection`` 'id') == 'zeros'@
694-- | A 'Relation' @r@ is 'irreflexive' 'iff' @(r ``intersection`` 'id') == 'zeros'@
690−irreflexive :: (CountableN a, FLN a a) => Relation a a -> Bool
695+irreflexive :: (CountableN a, FromListsN a a) => Relation a a -> Bool
691irreflexive r = (r `intersection` id) == zeros
696irreflexive r = (r `intersection` id) == zeros
692
697
693-- | A 'Relation' @r@ is 'connected' 'iff' @(r ``union`` 'conv' r) == 'ones'@
698-- | A 'Relation' @r@ is 'connected' 'iff' @(r ``union`` 'conv' r) == 'ones'@
694−connected :: (CountableN a, FLN a a) => Relation a a -> Bool
699+connected :: (CountableN a, FromListsN a a) => Relation a a -> Bool
695connected r = (r `union` conv r) == ones
700connected r = (r `union` conv r) == ones
696
701
697-- | A 'Relation' @r@ is a 'preorder' 'iff' @'reflexive' r && 'transitive' r@
702-- | A 'Relation' @r@ is a 'preorder' 'iff' @'reflexive' r && 'transitive' r@
698−preorder :: (CountableN a, FLN a a) => Relation a a -> Bool
703+preorder :: (CountableN a, FromListsN a a) => Relation a a -> Bool
699preorder r = reflexive r && transitive r
704preorder r = reflexive r && transitive r
700
705
701-- | A 'Relation' @r@ is a partial-order 'iff' @'antiSymmetric' r && 'preorder' r@
706-- | A 'Relation' @r@ is a partial-order 'iff' @'antiSymmetric' r && 'preorder' r@
702−partialOrder :: (CountableN a, FLN a a) => Relation a a -> Bool
707+partialOrder :: (CountableN a, FromListsN a a) => Relation a a -> Bool
703partialOrder r = antiSymmetric r && preorder r
708partialOrder r = antiSymmetric r && preorder r
704
709
705-- | A 'Relation' @r@ is a linear-order 'iff' @'connected' r && 'partialOrder' r@
710-- | A 'Relation' @r@ is a linear-order 'iff' @'connected' r && 'partialOrder' r@
706−linearOrder :: (CountableN a, FLN a a) => Relation a a -> Bool
711+linearOrder :: (CountableN a, FromListsN a a) => Relation a a -> Bool
707linearOrder r = connected r && partialOrder r
712linearOrder r = connected r && partialOrder r
708
713
709-- | A 'Relation' @r@ is an 'equivalence' 'iff' @'symmetric' r && 'preorder' r@
714-- | A 'Relation' @r@ is an 'equivalence' 'iff' @'symmetric' r && 'preorder' r@
710−equivalence :: (CountableN a, FLN a a) => Relation a a -> Bool
715+equivalence :: (CountableN a, FromListsN a a) => Relation a a -> Bool
711equivalence r = symmetric r && preorder r
716equivalence r = symmetric r && preorder r
712
717
713-- | A 'Relation' @r@ is a partial-equivalence 'iff' @'partialOrder' r && 'equivalence' r@
718-- | A 'Relation' @r@ is a partial-equivalence 'iff' @'partialOrder' r && 'equivalence' r@
714−partialEquivalence :: (CountableN a, FLN a a) => Relation a a -> Bool
719+partialEquivalence :: (CountableN a, FromListsN a a) => Relation a a -> Bool
715partialEquivalence r = partialOrder r && equivalence r
720partialEquivalence r = partialOrder r && equivalence r
716
721
717-- | A 'Relation' @r@ is 'difunctional' or regular wherever
722-- | A 'Relation' @r@ is 'difunctional' or regular wherever
@@ -743,10 +748,10 @@ difunctional r = r . conv r . r == r
743-- 'eitherR' ('splitR' r s) ('splitR' t v) == 'splitR' ('eitherR' r t) ('eitherR' s v)
748-- 'eitherR' ('splitR' r s) ('splitR' t v) == 'splitR' ('eitherR' r t) ('eitherR' s v)
744-- @
749-- @
745splitR ::
750splitR ::
746− ( CountableDimsN a b,
751+ ( CountableDimensionsN a b,
747 CountableN (a, b),
752 CountableN (a, b),
748− FLN (a, b) a,
753+ FromListsN (a, b) a,
749− FLN (a, b) b,
754+ FromListsN (a, b) b,
750 TrivialP a b
755 TrivialP a b
751 )
756 )
752 => Relation c a -> Relation c b -> Relation c (a, b)
757 => Relation c a -> Relation c b -> Relation c (a, b)
@@ -759,9 +764,9 @@ splitR (R f) (R g) = R (I.kr f g)
759-- @
764-- @
760fstR ::
765fstR ::
761 forall a b .
766 forall a b .
762− ( CountableDimsN a b,
767+ ( CountableDimensionsN a b,
763 CountableN (a, b),
768 CountableN (a, b),
764− FLN (a, b) a,
769+ FromListsN (a, b) a,
765 TrivialP a b
770 TrivialP a b
766 )
771 )
767 => Relation (a, b) a
772 => Relation (a, b) a
@@ -774,9 +779,9 @@ fstR = R (I.fstM @Boolean @(I.Normalize a) @(I.Normalize b))
774-- @
779-- @
775sndR ::
780sndR ::
776 forall a b .
781 forall a b .
777− ( CountableDimsN a b,
782+ ( CountableDimensionsN a b,
778 CountableN (a, b),
783 CountableN (a, b),
779− FLN (a, b) b,
784+ FromListsN (a, b) b,
780 TrivialP a b
785 TrivialP a b
781 )
786 )
782 => Relation (a, b) b
787 => Relation (a, b) b
@@ -792,13 +797,13 @@ infixl 4 ><
792-- (r '><' s) `.` (p '><' q) == (r `.` p) '><' (s `.` q)
797-- (r '><' s) `.` (p '><' q) == (r `.` p) '><' (s `.` q)
793-- @
798-- @
794(><) ::
799(><) ::
795− ( CountableDimsN a b,
800+ ( CountableDimensionsN a b,
796− CountableDimsN c d,
801+ CountableDimensionsN c d,
797− CountableDimsN (a, c) (b, d),
802+ CountableDimensionsN (a, c) (b, d),
798− FLN (a, c) a,
803+ FromListsN (a, c) a,
799− FLN (a, c) c,
804+ FromListsN (a, c) c,
800− FLN (b, d) b,
805+ FromListsN (b, d) b,
801− FLN (b, d) d,
806+ FromListsN (b, d) d,
802 TrivialP a c,
807 TrivialP a c,
803 TrivialP b d
808 TrivialP b d
804 )
809 )
@@ -832,9 +837,9 @@ eitherR = join
832-- 'i1' `.` 'i2' = 'zeros'
837-- 'i1' `.` 'i2' = 'zeros'
833-- @
838-- @
834i1 ::
839i1 ::
835− ( CountableDimsN a b,
840+ ( CountableDimensionsN a b,
836− FLN b a,
841+ FromListsN b a,
837− FLN a a
842+ FromListsN a a
838 )
843 )
839 => Relation a (Either a b)
844 => Relation a (Either a b)
840i1 = R I.i1
845i1 = R I.i1
@@ -846,9 +851,9 @@ i1 = R I.i1
846-- 'i1' `.` 'i2' = 'zeros'
851-- 'i1' `.` 'i2' = 'zeros'
847-- @
852-- @
848i2 ::
853i2 ::
849− ( CountableDimsN a b,
854+ ( CountableDimensionsN a b,
850− FLN a b,
855+ FromListsN a b,
851− FLN b b
856+ FromListsN b b
852 )
857 )
853 => Relation b (Either a b)
858 => Relation b (Either a b)
854i2 = R I.i2
859i2 = R I.i2
@@ -861,11 +866,11 @@ infixl 5 -|-
861-- r '-|-' s == 'eitherR' ('i1' `.` r) ('i2' `.` s)
866-- r '-|-' s == 'eitherR' ('i1' `.` r) ('i2' `.` s)
862-- @
867-- @
863(-|-) ::
868(-|-) ::
864− ( CountableDimsN b d,
869+ ( CountableDimensionsN b d,
865− FLN b b,
870+ FromListsN b b,
866− FLN d b,
871+ FromListsN d b,
867− FLN b d,
872+ FromListsN b d,
868− FLN d d
873+ FromListsN d d
869 )
874 )
870 => Relation a b -> Relation c d -> Relation (Either a c) (Either b d)
875 => Relation a b -> Relation c d -> Relation (Either a c) (Either b d)
871(-|-) (R a) (R b) = R ((I.-|-) a b)
876(-|-) (R a) (R b) = R ((I.-|-) a b)
@@ -878,13 +883,13 @@ infixl 5 -|-
878-- 'trans'/'untrans';
883-- 'trans'/'untrans';
879-- more-over, where each particular attribute is placed (input/output) is irrelevant.
884-- more-over, where each particular attribute is placed (input/output) is irrelevant.
880trans ::
885trans ::
881− ( CountableDimsN a b,
886+ ( CountableDimensionsN a b,
882 CountableN c,
887 CountableN c,
883− CountableDimsN (a, b) (c, b),
888+ CountableDimensionsN (a, b) (c, b),
884− FLN (c, b) c,
889+ FromListsN (c, b) c,
885− FLN (c, b) b,
890+ FromListsN (c, b) b,
886− FLN (a, b) a,
891+ FromListsN (a, b) a,
887− FLN (a, b) b,
892+ FromListsN (a, b) b,
888 Trivial (a, b),
893 Trivial (a, b),
889 Trivial (c, b),
894 Trivial (c, b),
890 TrivialP a b,
895 TrivialP a b,
@@ -899,13 +904,13 @@ trans r = splitR r sndR . conv fstR
899-- 'trans'/'untrans';
904-- 'trans'/'untrans';
900-- more-over, where each particular attribute is placed (input/output) is irrelevant.
905-- more-over, where each particular attribute is placed (input/output) is irrelevant.
901untrans ::
906untrans ::
902− ( CountableDimsN a b,
907+ ( CountableDimensionsN a b,
903 CountableN c,
908 CountableN c,
904− CountableDimsN (a, b) (c, b),
909+ CountableDimensionsN (a, b) (c, b),
905− FLN (c, b) c,
910+ FromListsN (c, b) c,
906− FLN (c, b) b,
911+ FromListsN (c, b) b,
907− FLN (a, b) b,
912+ FromListsN (a, b) b,
908− FLN (a, b) a,
913+ FromListsN (a, b) a,
909 Trivial (a, b),
914 Trivial (a, b),
910 Trivial (c, b),
915 Trivial (c, b),
911 TrivialP a b,
916 TrivialP a b,
@@ -927,10 +932,9 @@ untrans s = fstR . conv (splitR (conv s) sndR)
927predR ::
932predR ::
928 ( Bounded a,
933 ( Bounded a,
929 Enum a,
934 Enum a,
930− Countable a,
931 CountableN a,
935 CountableN a,
932− FLN a a,
936+ FromListsN a a,
933− FLN Bool a
937+ FromListsN Bool a
934 )
938 )
935 => Relation a Bool -> Relation a a
939 => Relation a Bool -> Relation a a
936predR p = id `intersection` divisionF (fromF (const True)) p
940predR p = id `intersection` divisionF (fromF (const True)) p
@@ -945,7 +949,7 @@ predR p = id `intersection` divisionF (fromF (const True)) p
945-- @
949-- @
946equalizer ::
950equalizer ::
947 ( CountableN a,
951 ( CountableN a,
948− FLN a a
952+ FromListsN a a
949 )
953 )
950 => Relation a b -> Relation a b -> Relation a a
954 => Relation a b -> Relation a b -> Relation a a
951equalizer f g = id `intersection` divisionF f g
955equalizer f g = id `intersection` divisionF f g
@@ -955,25 +959,23 @@ equalizer f g = id `intersection` divisionF f g
955-- @
959-- @
956-- 'guard' p = 'i2' ``overriddenBy`` 'i1' `.` 'predR' p
960-- 'guard' p = 'i2' ``overriddenBy`` 'i1' `.` 'predR' p
957-- @
961-- @
958−guard ::
962+guard ::
959 ( Bounded b,
963 ( Bounded b,
960 Enum b,
964 Enum b,
961 CountableN b,
965 CountableN b,
962− Countable b,
966+ FromListsN b b,
963− FLN b b,
964− FLN Bool b
967+ FromListsN Bool b
965 ) => Relation b Bool -> Relation b (Either b b)
968 ) => Relation b Bool -> Relation b (Either b b)
966guard p = conv (eitherR (predR p) (predR (negate p)))
969guard p = conv (eitherR (predR p) (predR (negate p)))
967
970
968-- | Relational McCarthy's conditional.
971-- | Relational McCarthy's conditional.
969−cond ::
972+cond ::
970 ( Bounded b,
973 ( Bounded b,
971 Enum b,
974 Enum b,
972− Countable b,
973 CountableN b,
975 CountableN b,
974− FLN b b,
976+ FromListsN b b,
975− FLN Bool b
977+ FromListsN Bool b
976− )
978+ )
977 => Relation b Bool -> Relation b c -> Relation b c -> Relation b c
979 => Relation b Bool -> Relation b c -> Relation b c -> Relation b c
978cond p r s = eitherR r s . guard p
980cond p r s = eitherR r s . guard p
979
981
@@ -983,7 +985,7 @@ cond p r s = eitherR r s . guard p
983-- since @'ker' r ``sse`` 'id'@ in such situations.
985-- since @'ker' r ``sse`` 'id'@ in such situations.
984domain ::
986domain ::
985 ( CountableN a,
987 ( CountableN a,
986− FLN a a
988+ FromListsN a a
987 ) => Relation a b -> Relation a a
989 ) => Relation a b -> Relation a a
988domain r = ker r `intersection` id
990domain r = ker r `intersection` id
989
991
@@ -993,16 +995,16 @@ domain r = ker r `intersection` id
993-- since @'img' f ``sse`` id@ for any @f@.
995-- since @'img' f ``sse`` id@ for any @f@.
994range ::
996range ::
995 ( CountableN b,
997 ( CountableN b,
996− FLN b b
998+ FromListsN b b
997 ) => Relation a b -> Relation b b
999 ) => Relation a b -> Relation b b
998range r = img r `intersection` id
1000range r = img r `intersection` id
999
1001
1000-- Relation pretty print
1002-- Relation pretty print
1001
1003
1002-- | Relation pretty printing
1004-- | Relation pretty printing
1003−pretty :: (CountableDimsN a b) => Relation a b -> String
1005+pretty :: (CountableDimensionsN a b) => Relation a b -> String
1004pretty (R a) = I.pretty a
1006pretty (R a) = I.pretty a
1005
1007
1006-- | Relation pretty printing
1008-- | Relation pretty printing
1007−prettyPrint :: (CountableDimsN a b) => Relation a b -> IO ()
1009+prettyPrint :: (CountableDimensionsN a b) => Relation a b -> IO ()
1008prettyPrint (R a) = I.prettyPrint a
1010prettyPrint (R a) = I.prettyPrint a
stack-8.8.3.yamldeleted−1
@@ -1 +0,0 @@
1−resolver: lts-15.5
stack.yaml+66−1
@@ -1 +1,66 @@
1+# 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
1−resolver: lts-14.3
20+resolver: lts-14.18
21+
22+# User packages to be built.
23+# Various formats can be used as shown in the example below.
24+#
25+# packages:
26+# - some-directory
27+# - https://example.com/foo/bar/baz-0.0.2.tar.gz
28+# subdirs:
29+# - auto-update
30+# - wai
31+packages:
32+- .
33+# Dependency packages to be pulled from upstream that are not in the resolver.
34+# These entries can reference officially published versions as well as
35+# forks / in-progress versions pinned to a git hash. For example:
36+#
37+# extra-deps:
38+# - acme-missiles-0.3
39+# - git: https://github.com/commercialhaskell/stack.git
40+# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
41+#
42+# extra-deps: []
43+
44+# Override default flag values for local packages and extra-deps
45+# flags: {}
46+
47+# Extra package databases containing global packages
48+# extra-package-dbs: []
49+
50+# Control whether we use the GHC we find on the path
51+# system-ghc: true
52+#
53+# Require a specific version of stack, using version ranges
54+# require-stack-version: -any # Default
55+# require-stack-version: ">=2.1"
56+#
57+# Override the architecture used by stack, especially useful on Windows
58+# arch: i386
59+# arch: x86_64
60+#
61+# Extra directories used by stack for building
62+# extra-include-dirs: [/path/to/dir]
63+# extra-lib-dirs: [/path/to/dir]
64+#
65+# Allow a newer minor version of GHC than the snapshot specifies
66+# compiler-check: newer-minor
stack.yaml.lock+4−4
@@ -6,7 +6,7 @@
6packages: []
6packages: []
7snapshots:
7snapshots:
8- completed:
8- completed:
9− size: 523878
9+ size: 524789
10− url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/14/3.yaml
10+ url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/14/18.yaml
11− sha256: 470c46c27746a48c7c50f829efc0cf00112787a7804ee4ac7a27754658f6d92c
11+ sha256: 646be71223e08234131c6989912e6011e01b9767bc447b6d466a35e14360bdf2
12− original: lts-14.3
12+ original: lts-14.18
test/Spec.hs+1−7
@@ -1,8 +1,2 @@
1−module Main (main) where
2−
3−import qualified Examples.Readme as RD
4−
5main :: IO ()
1main :: IO ()
6−main = do
2+main = putStrLn "Test suite not yet implemented"
7− putStrLn ("Testing if README works" :: String)
8− RD.exec