git.iko.soy/laop
on master help sign in
swap
eea623152 ahead, 0 behind
33 files changed+1763−1420
since splitsnapshots
unifiedsplit
.ghc.environment.x86_64-linux-8.6.5−17 .github/workflows/ci.yml+43 .gitignore+54−2 .travis.yml+47 CHANGELOG.md+17 ChangeLog.md−3 LICENSE+17−26 README.md+35−27 Setup.hs−2 app/Benchmarks.hs−102 app/Main.hs−7 appveyor.yml+34 benchmark/Main.hs+175 hackage.sh−10 laop-0.1.0.0-docs.tar.gz laop.cabal+89 package.yaml−48 src/LAoP/Dist.hs+4−2 src/LAoP/Dist/Internal.hs+68−29 src/LAoP/Matrix/Internal.hs+399−392 src/LAoP/Matrix/Nat.hs+139−124 src/LAoP/Matrix/Type.hs+233−171 src/LAoP/Relation.hs+8−11 src/LAoP/Relation/Internal.hs+250−254 src/LAoP/Utils.hs+5−2 src/LAoP/Utils/Internal.hs+33−75 stack-8.8.3.yaml+1 stack.yaml+1−66 stack.yaml.lock+4−4 test/Examples/Quantum.hs+31 app/Examples.hs → test/Examples/Readme.hs+56−31 app/Spreadsheets.hs → test/Examples/Spreadsheets.hs+13−14 test/Spec.hs+7−1
.ghc.environment.x86_64-linux-8.6.5deleted−17
@@ -1,17 +0,0 @@
1−-- This is a GHC environment file written by cabal. This means you can
2−-- run ghc or ghci and get the environment of the project as a whole.
3−-- But you still need to use cabal repl $target to get the environment
4−-- of specific components (libs, exes, tests etc) because each one can
5−-- have its own source dirs, cpp flags etc.
6−--
7−clear-package-db
8−global-package-db
9−package-db /home/bolt/.cabal/store/ghc-8.6.5/package.db
10−package-db packagedb/ghc-8.6.5
11−package-id laop-0.1.0.0-inplace
12−package-id base-4.12.0.0
13−package-id ghc-prim-0.5.3
14−package-id rts
15−package-id integer-gmp-1.0.2.0
16−package-id deepseq-1.4.4.0
17−package-id array-0.5.3.0
.github/workflows/ci.ymlnew file+43
@@ -0,0 +1,43 @@
1+name: CI
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+54−2
@@ -1,3 +1,55 @@
1+### Haskell
2+dist
3+dist-*
4+cabal-dev
5+*.o
6+*.hi
7+*.chi
8+*.chs.h
9+*.dyn_o
10+*.dyn_hi
11+*.prof
12+*.aux
13+*.hp
14+*.eventlog
15+.virtualenv
16+.hsenv
17+.hpc
18+.cabal-sandbox/
19+cabal.sandbox.config
20+cabal.config
21+cabal.project.local
22+.ghc.environment.*
23+.HTF/
24+# Stack
125.stack-work/
2−laop.cabal
3−*~
26+stack.yaml.lock
27+
28+### IDE/support
29+# Vim
30+[._]*.s[a-v][a-z]
31+[._]*.sw[a-p]
32+[._]s[a-v][a-z]
33+[._]sw[a-p]
34+*~
35+tags
36+
37+# IntellijIDEA
38+.idea/
39+.ideaHaskellLib/
40+*.iml
41+
42+# Atom
43+.haskell-ghc-mod.json
44+
45+# VS
46+.vscode/
47+
48+# Emacs
49+*#
50+.dir-locals.el
51+TAGS
52+
53+# other
54+.DS_Store
55+hackage.sh
.travis.ymlnew file+47
@@ -0,0 +1,47 @@
1+sudo: true
2+language: haskell
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.mdnew file+17
@@ -0,0 +1,17 @@
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.mddeleted−3
@@ -1,3 +0,0 @@
1−# Changelog for laop
2−
3−## Unreleased changes
LICENSE+17−26
@@ -1,30 +1,21 @@
1−Copyright Armando Santos (c) 2019
1+MIT License
22
3−All rights reserved.
3+Copyright (c) 2020 Armando Santos
44
5−Redistribution and use in source and binary forms, with or without
6−modification, are permitted provided that the following conditions are met:
5+Permission is hereby granted, free of charge, to any person obtaining a copy
6+of this software and associated documentation files (the "Software"), to deal
7+in the Software without restriction, including without limitation the rights
8+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
9+copies of the Software, and to permit persons to whom the Software is
10+furnished to do so, subject to the following conditions:
711
8− * Redistributions of source code must retain the above copyright
9− notice, this list of conditions and the following disclaimer.
12+The above copyright notice and this permission notice shall be included in all
13+copies or substantial portions of the Software.
1014
11− * Redistributions in binary form must reproduce the above
12− copyright notice, this list of conditions and the following
13− disclaimer in the documentation and/or other materials provided
14− with the distribution.
15−
16− * Neither the name of Armando Santos nor the names of other
17− contributors may be used to endorse or promote products derived
18− from this software without specific prior written permission.
19−
20−THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21−"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
22−LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
23−A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
24−OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
25−SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
26−LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
27−DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
28−THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
29−(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
30−OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
15+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
16+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
17+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
18+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
19+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
20+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
21+SOFTWARE.
README.md+35−27
@@ -1,5 +1,11 @@
11# laop - Linear Algebra of Programming library
22
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+
39The LAoP discipline generalises relations and functions treating them as
410Boolean matrices and in turn consider these as arrows.
511
@@ -10,36 +16,38 @@ motivation behind the library, the underlying theory, and implementation details
1016This module offers many of the combinators mentioned in the work of
1117[Macedo (2012)](https://repositorium.sdum.uminho.pt/handle/1822/22894) and [Oliveira (2012)](https://pdfs.semanticscholar.org/ccf5/27fa9179081223bffe8067edd81948644fc0.pdf).
1218
13−See the candidate package in hackage [here](https://hackage.haskell.org/package/laop-0.1.0.0)
19+See the package in hackage [here](https://hackage.haskell.org/package/laop-0.1.1.0)
20+
21+A Functional Pearl has been written and can be regarded as the [reference document](https://github.com/bolt12/tymfgg-pearl) for this library.
1422
1523## Features
1624
17−This library offers:
18−
19−- An internal module representation that uses normal datatypes (`Void`, `()`, `Either`) for matrix dimensions and two
20− type families `FromNat` and `Count` to make it easier to work with these type of matrices.
21−- An interfacing module that uses generalised types for the dimensions and is just a newtype wrapper
22− around the internal matrix data type.
23−- An interfacing module that uses type level naturals for the dimensions and is just a newtype wrapper
24− around the internal matrix data type.
25−- An interfacing module that restricts the matrix contents to being only 0's or 1's (True
26− and False). This module is called 'Relation' and offers many of the combinators seen in
27− AoP and Relational Calculus/Algebra.
28−- A very simple Probabilistic Programming module and several functions and data types to
29− make it easier to deal with sample space.
30−
31−Given this, this new matrix formulation compared to other libraries one has much more advantages, such as:
32−
33−- Has an inductive definition enabling writing matrix manipulation functions in a much more elegant and calculational way;
34−- Statically typed dimensions;
35−- Polymorphic data type dimensions;
36−- Polymorphic matrix content;
37−- Awesome dimension type inference;
38−- Fast type natural conversion via `FromNat` type family;
39−- Matrix `Junc` and `Split`-ing in O(1);
40−- Matrix composition takes advantage of divide-and-conquer and fusion laws.
41−
42−Unfortunately, this approach does not solve the issue of type dimensions being in some way constrainted making it impossible to write Arrow instances, for example. Type inference isn't perfect, when it comes to infer the types of matrices which dimensions are computed using type level naturals multiplication, the compiler needs type annotations in order to succeed.
25+This library offers 3 main matrix programming modules:
26+
27+- One in which matrices are typed with type level natural numbers;
28+- One in which matrices are typed with arbitrary generic data types;
29+- One in which matrices are regarded as relations, i.e. boolean matrices;
30+
31+There's also an experimental module that uses matrices to represent probability
32+distributions.
33+
34+The most interesting feature is that matrices are represented as an inductive data type.
35+Given this formulation, matrix algorithms can be expressed in a much more elegant and
36+calculational style than the traditional vector of vectors representation. This data type
37+guarantees that a matrix will always have valid dimensions. It can also express block matrix
38+computations naturally, which leads to total, efficient and statically typed manipulation
39+and transformation functions.
40+
41+Like matrix multiplication, other common operations, such as matrix transposition, benefit from a block-oriented structure that leads to a simple and natural divide-and-conquer algorithmic solution. Performance wise, this means that without much effort we can obtain optimal cache-oblivious algorithms.
42+
43+Given this, this new matrix formulation compared to other libraries:
44+
45+- Is more compositional and polymorphic and does not have partial matrix manipulation functions (hence less chances for usage errors);
46+- Our implementation of matrices enables simple manipulation of submatrices, making it particularly suitable for formal verification and equation reasoning, using the mathematical framework defined by the linear algebra of programming. Furthermore, the data type constructors ensure that the matrices of this kind are sound, i.e. malformed matrices with incorrect dimensions of the sort, can not be constructed.
47+
48+## Known issues
49+
50+Unfortunately, due to the use of type-level programming features, this approach sometimes requires type dimensions to be constrainted, in some way, impossible to write idiomatic Arrow instances, for example. Type inference isn't perfect, when it comes to infer the types of matrices which dimensions are computed using type level naturals multiplication, the compiler needs type annotations in order to succeed. And not all kinds of programs can be modeled using matrices, namely programs that deal with arbitrary infinite data types such as lists or integers (although there are some workarounds).
4351
4452## Notes
4553
Setup.hsdeleted−2
@@ -1,2 +0,0 @@
1−import Distribution.Simple
2−main = defaultMain
app/Benchmarks.hsdeleted−102
@@ -1,102 +0,0 @@
1−{-# LANGUAGE DataKinds #-}
2−{-# LANGUAGE BangPatterns #-}
3−{-# LANGUAGE TypeApplications #-}
4−{-# LANGUAGE FlexibleContexts #-}
5−{-# LANGUAGE AllowAmbiguousTypes #-}
6−{-# LANGUAGE ScopedTypeVariables #-}
7−
8−module Benchmarks
9− ( benchmark
10− )
11− where
12−
13−import LAoP.Dist.Internal
14−import LAoP.Utils
15−import LAoP.Matrix.Type hiding (CountableN, Countable, FromListsN)
16−import qualified LAoP.Matrix.Type as T (FromListsN)
17−import Criterion.Main
18−import Control.DeepSeq
19−import Test.QuickCheck
20−import GHC.TypeLits
21−import Data.Proxy
22−import Data.Time.Clock.POSIX (getPOSIXTime)
23−
24−selectM2 ::
25− ( Num e,
26− T.FromListsN e b b,
27− CountableN b
28− ) => Matrix e cols (Either a b) -> Matrix e a b -> Matrix e cols b
29−selectM2 m y = junc y identity `comp` m
30−
31−selectD2 ::
32− ( FromListsN b b,
33− CountableN b
34− ) => Dist (Either a b) -> Matrix Prob a b -> Dist b
35−selectD2 (D d) m = D (junc m identity `comp` d)
36−
37−randomDist :: forall a . (Countable a, FromListsN () a) => Gen (Dist a)
38−randomDist = do
39− let size = fromInteger (natVal (Proxy :: Proxy (Count a)))
40− l <- vectorOf size (arbitrary :: Gen Prob)
41− let ln = normalize l
42− lr = map (:[]) ln
43− m = fromLists lr
44− return (D m)
45−
46−randomMatrix :: forall a b . (CountableDimensions a b, FromListsN a b) => Gen (Matrix Prob a b)
47−randomMatrix = do
48− let cols = fromInteger (natVal (Proxy :: Proxy (Count a)))
49− rows = fromInteger (natVal (Proxy :: Proxy (Count b)))
50− l <- vectorOf (cols * rows) (arbitrary :: Gen Float)
51− let lr = buildList l cols
52− m = fromLists lr
53− return m
54−
55−buildList [] _ = []
56−buildList l r = take r l : buildList (drop r l) r
57−
58−normalize :: [Prob] -> [Prob]
59−normalize l = let l' = map abs l
60− s = sum l'
61− in map (/ s) l'
62−
63−setupEnv = do
64− m11 <- generate (resize 1 (randomMatrix @(Natural 0 10) @(Natural 0 10) ))
65− m12 <- generate (resize 1 (randomMatrix @(Natural 0 10) @(Natural 0 10) ))
66− m21 <- generate (resize 1 (randomMatrix @(Natural 0 100) @(Natural 0 100) ))
67− m22 <- generate (resize 1 (randomMatrix @(Natural 0 100) @(Natural 0 100) ))
68− m31 <- generate (resize 1 (randomMatrix @(Natural 0 300) @(Natural 0 300) ))
69− m32 <- generate (resize 1 (randomMatrix @(Natural 0 300) @(Natural 0 300) ))
70− m40 <- generate (resize 1 (randomMatrix @(Natural 0 100) @(Either (Natural 0 100) (Natural 0 100) )))
71− dist <- generate (resize 1 (randomDist @(Either (Natural 0 1000) (Natural 0 1000)) ))
72− dist2 <- generate (resize 1 (randomMatrix @(Natural 0 1000) @(Natural 0 1000) ))
73− return (m11, m12, m21, m22, m31, m32, m40, dist, dist2)
74−
75−benchmark :: IO ()
76−benchmark = defaultMain [
77− env setupEnv $ \ ~(m11, m12, m21, m22, m31, m32, m40, dist, dist2) -> bgroup "main" [
78− bgroup "Matrix composition" [
79− bench "WHNF - 10x10" $ whnf (comp m11) m12
80− , bench "NF - 10x10" $ nf (comp m11) m12
81− , bench "WHNF - 100x100" $ whnf (comp m21) m22
82− , bench "NF - 100x100" $ nf (comp m21) m22
83− , bench "WHNF - 300x300" $ whnf (comp m31) m32
84− , bench "NF - 300x300" $ nf (comp m31) m32
85− ],
86− bgroup "Dist - Applicative `select`" [
87− bench "WHNF" $ whnf (selectD2 dist) dist2
88− , bench "NF" $ nf (selectD2 dist) dist2
89− ],
90− bgroup "Dist - Selective `select`" [
91− bench "WHNF" $ whnf (selectD dist) dist2
92− , bench "NF" $ nf (selectD dist) dist2
93− ],
94− bgroup "Matrix - Applicative `select`" [
95− bench "WHNF" $ whnf (selectM2 m40) m21
96− , bench "NF" $ nf (selectM2 m40) m21
97− ],
98− bgroup "Matrix - Selective `select`" [
99− bench "WHNF" $ whnf (selectM m40) m21
100− , bench "NF" $ nf (selectM m40) m21
101− ]
102− ] ]
app/Main.hsdeleted−7
@@ -1,7 +0,0 @@
1−module Main where
2−
3−import Examples
4−import Benchmarks
5−
6−main :: IO ()
7−main = benchmark
appveyor.ymlnew file+34
@@ -0,0 +1,34 @@
1+clone_folder: "c:\\WORK"
2+clone_depth: 5
3+
4+# Do not build feature branch with open Pull Requests
5+skip_branch_with_pr: true
6+
7+platform:
8+ - x86_64
9+
10+cache:
11+ - "C:\\SR"
12+ - dist-newstyle
13+
14+environment:
15+ global:
16+ CABOPTS: --store-dir=C:\\SR
17+
18+ matrix:
19+ - GHCVER: 8.6.5
20+
21+install:
22+ - choco source add -n mistuke -s https://www.myget.org/F/mistuke/api/v2
23+ - choco install -y cabal --version 2.4.1.0
24+ - choco install -y ghc --version 8.6.3
25+ - refreshenv
26+
27+before_build:
28+ - cabal --version
29+ - ghc --version
30+ - cabal %CABOPTS% v2-update
31+
32+build_script:
33+ - cabal %CABOPTS% v2-build --enable-tests
34+ - cabal %CABOPTS% v2-test --enable-tests
benchmark/Main.hsnew file+175
@@ -0,0 +1,175 @@
1+{-# LANGUAGE KindSignatures #-}
2+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
3+{-# LANGUAGE DerivingVia #-}
4+{-# LANGUAGE DataKinds #-}
5+{-# LANGUAGE BangPatterns #-}
6+{-# LANGUAGE TypeApplications #-}
7+{-# LANGUAGE FlexibleContexts #-}
8+{-# LANGUAGE AllowAmbiguousTypes #-}
9+{-# LANGUAGE ScopedTypeVariables #-}
10+
11+module Main (main) where
12+
13+import LAoP.Dist.Internal
14+import LAoP.Utils
15+import LAoP.Matrix.Type hiding (CountableN, Countable, FLN)
16+import qualified LAoP.Matrix.Type as T (FLN)
17+import Criterion.Main
18+import Control.DeepSeq
19+import Test.QuickCheck
20+import GHC.TypeLits
21+import Data.Proxy
22+import Prelude hiding (id, (.))
23+
24+selectM2 ::
25+ ( Num e,
26+ T.FLN b b,
27+ CountableN b
28+ ) => Matrix e cols (Either a b) -> Matrix e a b -> Matrix e cols b
29+selectM2 m y = join y iden `comp` m
30+
31+selectD2 ::
32+ ( FLN b b,
33+ CountableN b
34+ ) => Dist (Either a b) -> Matrix Prob a b -> Dist b
35+selectD2 (D d) m = D (join m iden `comp` d)
36+
37+-- Composition with iden
38+compId m = comp iden m
39+
40+randomDist :: forall a . (Countable a, FLN () a) => Gen (Dist a)
41+randomDist = do
42+ let size = fromInteger (natVal (Proxy :: Proxy (Count a)))
43+ l <- vectorOf size (arbitrary :: Gen Prob)
44+ let ln = normalize l
45+ lr = map (:[]) ln
46+ m = fromLists lr
47+ return (D m)
48+
49+randomMatrix :: forall a b . (CountableDims a b, FLN a b) => Gen (Matrix Prob a b)
50+randomMatrix = do
51+ let cols = fromInteger (natVal (Proxy :: Proxy (Count a)))
52+ rows = fromInteger (natVal (Proxy :: Proxy (Count b)))
53+ l <- vectorOf (cols * rows) arbitrary
54+ let lr = buildList l cols
55+ m = fromLists lr
56+ return m
57+
58+buildList [] _ = []
59+buildList l r = take r l : buildList (drop r l) r
60+
61+normalize :: [Prob] -> [Prob]
62+normalize l = let l' = map abs l
63+ s = sum l'
64+ in map (/ s) l'
65+
66+-- Probability
67+newtype Probability = P Double
68+ deriving (Num, Show, Fractional, NFData) via Double
69+newtype Dist' a = D' { unD :: [(a,Probability)] }
70+ deriving (Show, NFData)
71+
72+instance Functor Dist' where
73+ fmap f (D' d) = D' [(f x,p) | (x,p) <- d]
74+
75+instance Applicative Dist' where
76+ pure x = D' [(x, 1)]
77+ fm <*> m = D' [(f x,q*p) | (f,p) <- unD fm, (x,q) <- unD m]
78+
79+class Applicative f => Selective f where
80+ select :: f (Either a b) -> f (a -> b) -> f b
81+
82+instance Selective Dist' where
83+ select x y = (\e f -> either f id e) <$> x <*> y -- selectA
84+
85+instance Monad Dist' where
86+ return = pure
87+ (D' d) >>= f = D' [(y,q*p) | (x,p) <- d, (y,q) <- unD (f x)]
88+
89+normalize2 :: forall a . (Enum a, Bounded a) => [Probability] -> [(a, Probability)]
90+normalize2 l = let l' = map abs l
91+ as = [minBound .. maxBound]
92+ s = sum l'
93+ probs = map (/ s) l'
94+ in zip as probs
95+
96+randomDist2 :: forall a . (Countable a, Enum a, Bounded a) => Gen (Dist' a)
97+randomDist2 = do
98+ let size = fromInteger (natVal (Proxy :: Proxy (Count a)))
99+ l <- vectorOf size (arbitrary :: Gen Prob)
100+ let ln = normalize2 @a (map P l)
101+ return (D' ln)
102+
103+normalize3 :: forall a . [a] -> [Probability] -> [(a, Probability)]
104+normalize3 as l = let s = sum l
105+ probs = map (/ s) l
106+ in zip as probs
107+
108+randomDistF :: forall a b . (CountableDims a b, CoArbitrary a, Arbitrary b) => Gen (Dist' (a -> b))
109+randomDistF = do
110+ let a = fromInteger (natVal (Proxy :: Proxy (Count a)))
111+ b = fromInteger (natVal (Proxy :: Proxy (Count b)))
112+ size = a * b
113+ l <- vectorOf size (arbitrary :: Gen Prob)
114+ l2 <- vectorOf size (arbitrary :: Gen (a -> b))
115+ let !ln = normalize3 l2 (map P l)
116+ return (D' ln)
117+
118+instance CoArbitrary (Natural a b)
119+
120+instance forall (a :: Nat) (b :: Nat). (KnownNat a, KnownNat b) => Arbitrary (Natural a b)
121+ where
122+ arbitrary =
123+ let bottom = fromInteger (natVal (Proxy :: Proxy a))
124+ top = fromInteger (natVal (Proxy :: Proxy b))
125+ in do
126+ x <- arbitrary `suchThat` (\n -> n >= bottom && n <= top)
127+ return (nat x)
128+
129+setupEnv = do
130+ m11 <- generate (resize 1 (randomMatrix @(Natural 0 10) @(Natural 0 10) ))
131+ m12 <- generate (resize 1 (randomMatrix @(Natural 0 10) @(Natural 0 10) ))
132+ m21 <- generate (resize 1 (randomMatrix @(Natural 0 100) @(Natural 0 100) ))
133+ m22 <- generate (resize 1 (randomMatrix @(Natural 0 100) @(Natural 0 100) ))
134+ m31 <- generate (resize 1 (randomMatrix @(Natural 0 200) @(Natural 0 200) ))
135+ m32 <- generate (resize 1 (randomMatrix @(Natural 0 200) @(Natural 0 200) ))
136+ return (m11, m12, m21, m22, m31, m32)
137+
138+setupEnv2 = do
139+ m21 <- generate (resize 1 (randomMatrix @(Natural 0 100) @(Natural 0 100) ))
140+ m40 <- generate (resize 1 (randomMatrix @(Natural 0 100) @(Either (Natural 0 100) (Natural 0 100) )))
141+ dist <- generate (resize 1 (randomDist @(Either (Natural 0 100) (Natural 0 100)) ))
142+ dist2 <- generate (resize 1 (randomMatrix @(Natural 0 100) @(Natural 0 100) ))
143+ distList1 <- generate (resize 1 (randomDist2 @(Either (Natural 0 100) (Natural 0 100))))
144+ distList2 <- generate (resize 1 (randomDistF @(Natural 0 100) @(Natural 0 100)))
145+ return (m21, m40, dist, dist2, distList1, distList2)
146+
147+main :: IO ()
148+main = defaultMain [
149+ env setupEnv $ \ ~(m11, m12, m21, m22, m31, m32) -> bgroup "Matrix Composition" [
150+ bgroup "10x10" [
151+ bench "WHNF - 10x10" $ whnf (comp m11) m12
152+ , bench "NF - 10x10" $ nf (comp m11) m12
153+ ],
154+ bgroup "100x100" [
155+ bench "WHNF - 100x100" $ whnf (comp m21) m22
156+ , bench "NF - 100x100" $ nf (comp m21) m22
157+ ],
158+ bgroup "200x200" [
159+ bench "WHNF - 200x200" $ whnf (comp m31) m32
160+ , bench "NF - 200x200" $ nf (comp m31) m32
161+ ],
162+ bgroup "200x200 - RULES" [
163+ bench "No rules - 200x200" $ nf (comp m21) iden
164+ , bench "Rules - 200x200" $ nf compId m21
165+ ] ],
166+ env setupEnv2 $ \ ~(m21, m40, dist, dist2, dl1, dl2) -> bgroup "Matrix vs List - `select`" [
167+ bgroup "Distribution `select` - 100+100 / 100x100" [
168+ bench "List Distribution - Applicative version" $ nf (select dl1) dl2
169+ , bench "Matrix Distribution - Applicative version" $ nf (selectD2 dist) dist2
170+ , bench "Matrix Distribution - Selective version" $ nf (selectD dist) dist2
171+ ],
172+ bgroup "Matrix `select` - 100x(100+100) / 100x100" [
173+ bench "Applicative version" $ nf (selectM2 m40) m21
174+ , bench "Selective version" $ nf (selectM m40) m21
175+ ] ] ]
hackage.shdeleted−10
@@ -1,10 +0,0 @@
1−#!/bin/sh
2−set -e
3−
4−dir=$(mktemp -d dist-docs.XXXXXX)
5−trap 'rm -r "$dir"' EXIT
6−
7−# assumes cabal 2.4 or later
8−cabal v2-haddock --builddir="$dir" --haddock-for-hackage --enable-doc
9−
10−cabal upload -d $dir/*-docs.tar.gz --publish
laop-0.1.0.0-docs.tar.gzdeleted

Binary file not shown.

laop.cabalnew file+89
@@ -0,0 +1,89 @@
1+cabal-version: 2.4
2+name: laop
3+version: 0.1.1.1
4+synopsis: Matrix programming library
5+description: Matrix programming library that uses a type-safe inductive definition
6+ inspired by the Linear Algebra of Programming
7+homepage: https://github.com/bolt12/laop
8+bug-reports: https://github.com/bolt12/laop/issues
9+license: MIT
10+license-file: LICENSE
11+author: Armando Santos
12+maintainer: Armando Santos <armandoifsantos@gmail.com>
13+copyright: 2020 Armando Santos
14+category: Data
15+build-type: Simple
16+extra-doc-files: README.md
17+ CHANGELOG.md
18+tested-with: GHC == 8.6.5
19+ GHC == 8.8.3
20+
21+source-repository head
22+ type: git
23+ location: https://github.com/bolt12/laop.git
24+
25+common common-options
26+ build-depends: base >= 4.12.0.0 && < 5,
27+ deepseq
28+
29+ ghc-options: -Wall
30+ -Wcompat
31+ -Widentities
32+ -Wincomplete-uni-patterns
33+ -Wincomplete-record-updates
34+ if impl(ghc >= 8.0)
35+ ghc-options: -Wredundant-constraints
36+ if impl(ghc >= 8.2)
37+ ghc-options: -fhide-source-paths
38+ if impl(ghc >= 8.4)
39+ ghc-options: -Wmissing-export-lists
40+ -Wpartial-fields
41+ if impl(ghc >= 8.8)
42+ ghc-options: -Wmissing-deriving-strategies
43+
44+ default-language: Haskell2010
45+
46+library
47+ import: common-options
48+ hs-source-dirs: src
49+ exposed-modules: LAoP.Dist
50+ LAoP.Dist.Internal
51+ LAoP.Matrix.Internal
52+ LAoP.Matrix.Nat
53+ LAoP.Matrix.Type
54+ LAoP.Relation
55+ LAoP.Relation.Internal
56+ LAoP.Utils
57+ LAoP.Utils.Internal
58+
59+test-suite laop-test
60+ import: common-options
61+ type: exitcode-stdio-1.0
62+ hs-source-dirs: test
63+ other-modules: Examples.Readme
64+ main-is: Spec.hs
65+ build-depends: laop
66+ ghc-options: -threaded
67+ -rtsopts
68+ -with-rtsopts=-N
69+ -funfolding-use-threshold=16
70+ -fexcess-precision
71+ -optc-O3
72+ -optc-ffast-math
73+
74+benchmark laop-benchmark
75+ import: common-options
76+ type: exitcode-stdio-1.0
77+ hs-source-dirs: benchmark
78+ main-is: Main.hs
79+ build-depends: criterion
80+ , QuickCheck
81+ , deepseq
82+ , laop
83+ ghc-options: -threaded
84+ -rtsopts
85+ -with-rtsopts=-N
86+ -funfolding-use-threshold=16
87+ -fexcess-precision
88+ -optc-O3
89+ -optc-ffast-math
package.yamldeleted−48
@@ -1,48 +0,0 @@
1−name: laop
2−version: 0.1.0.0
3−github: "bolt12/laop"
4−license: BSD3
5−author: "Armando Santos"
6−maintainer: "armandoifsantos@gmail.com"
7−copyright: "MIT"
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: Web
16−
17−# To avoid duplicated efforts in documentation and dealing with the
18−# complications of embedding Haddock markup inside cabal files, it is
19−# common to point users to the README.md file.
20−description: Please see the README on GitHub at <https://github.com/bolt12/laop#readme>
21−
22−dependencies:
23−- base >= 4.7 && < 5
24−
25−library:
26− source-dirs: src
27−
28−#executables:
29−# laop-exe:
30−# main: Main.hs
31−# source-dirs: app
32−# ghc-options:
33−# - -threaded
34−# - -rtsopts
35−# - -with-rtsopts=-N
36−# dependencies:
37−# - laop
38−
39−tests:
40− laop-test:
41− main: Spec.hs
42− source-dirs: test
43− ghc-options:
44− - -threaded
45− - -rtsopts
46− - -with-rtsopts=-N
47− dependencies:
48− - laop
src/LAoP/Dist.hs+4−2
@@ -39,8 +39,8 @@ module LAoP.Dist
3939 -- * Constraint type synonyms
4040 Countable,
4141 CountableN,
42− CountableDimensionsN,
43− FromListsN,
42+ CountableDimsN,
43+ FLN,
4444 Liftable,
4545 TrivialP,
4646
@@ -53,6 +53,8 @@ module LAoP.Dist
5353
5454 -- * Selective equivalent functions
5555 selectD,
56+ branchD,
57+ ifD,
5658
5759 -- * Monad equivalent functions
5860 returnD,
src/LAoP/Dist/Internal.hs+68−29
@@ -16,8 +16,8 @@ module LAoP.Dist.Internal
1616
1717 Countable,
1818 CountableN,
19− CountableDimensionsN,
20− FromListsN,
19+ CountableDimsN,
20+ FLN,
2121 Liftable,
2222 TrivialP,
2323
@@ -25,6 +25,8 @@ module LAoP.Dist.Internal
2525 unitD,
2626 multD,
2727 selectD,
28+ branchD,
29+ ifD,
2830 returnD,
2931 bindD,
3032 (??),
@@ -41,16 +43,18 @@ module LAoP.Dist.Internal
4143 )
4244 where
4345
44−import LAoP.Matrix.Type hiding (TrivialP, Countable, CountableDimensions, CountableN, CountableDimensionsN, Liftable, FromListsN)
46+import LAoP.Matrix.Type hiding (TrivialP, Countable, CountableDims, CountableN, CountableDimsN, Liftable, FLN)
47+import Prelude hiding (id, (.))
4548import qualified LAoP.Matrix.Internal as I
4649import LAoP.Utils
4750import GHC.TypeLits
4851import Data.Proxy
4952import Data.List (sortBy)
5053import Control.DeepSeq
54+import Data.Bool
5155
5256-- | Type synonym for probability value
53−type Prob = Float
57+type Prob = Double
5458
5559-- | Type synonym for column vector matrices. This represents a probability
5660-- distribution.
@@ -58,18 +62,18 @@ newtype Dist a = D (Matrix Prob () a)
5862 deriving (Show, Num, Eq, Ord, NFData) via (Matrix Prob () a)
5963
6064-- | Constraint type synonyms to keep the type signatures less convoluted
61−type Countable a = KnownNat (I.Count a)
62−type CountableN a = KnownNat (I.Count (I.Normalize a))
63−type CountableDimensionsN a b = (CountableN a, CountableN b)
64−type FromListsN a b = I.FromLists Prob (I.Normalize a) (I.Normalize b)
65−type Liftable a b = (Bounded a, Bounded b, Enum a, Enum b, Eq b, Num Prob, Ord Prob)
66−type TrivialP a b = Normalize (a, b) ~ Normalize (Normalize a, Normalize b)
65+type Countable a = KnownNat (I.Count a)
66+type CountableN a = KnownNat (I.Count (I.Normalize a))
67+type CountableDimsN a b = (CountableN a, CountableN b)
68+type FLN a b = I.FL (I.Normalize a) (I.Normalize b)
69+type Liftable a b = (Bounded a, Bounded b, Enum a, Enum b, Eq b, Num Prob, Ord Prob)
70+type TrivialP a b = Normalize (a, b) ~ Normalize (Normalize a, Normalize b)
6771
6872-- | Functor instance
6973fmapD ::
7074 ( Liftable a b,
71− CountableDimensionsN a b,
72− FromListsN b a
75+ CountableDimsN a b,
76+ FLN b a
7377 )
7478 =>
7579 (a -> b) -> Dist a -> Dist b
@@ -81,23 +85,58 @@ unitD = D (one 1)
8185
8286-- | Applicative/Monoidal instance 'mult' function
8387multD ::
84− ( CountableDimensionsN a b,
88+ ( CountableDimsN a b,
8589 CountableN (a, b),
86− FromListsN (a, b) a,
87− FromListsN (a, b) b,
90+ FLN (a, b) a,
91+ FLN (a, b) b,
8892 TrivialP a b
8993 ) => Dist a -> Dist b -> Dist (a, b)
90−multD (D a) (D b) = D (khatri a b)
94+multD (D a) (D b) = D (kr a b)
9195
9296-- | Selective instance function
9397selectD ::
94− ( FromListsN b b,
98+ ( FLN b b,
9599 CountableN b
96100 ) => Dist (Either a b) -> Matrix Prob a b -> Dist b
97101selectD (D d) m = D (selectM d m)
98102
103+-- | Chooses which of the two given effectful
104+-- functions to apply to a given argument;
105+branchD ::
106+ ( Num e,
107+ CountableDimsN a b,
108+ CountableDimsN c (Either b c),
109+ FLN c b,
110+ FLN a b,
111+ FLN a a,
112+ FLN b b,
113+ FLN c c,
114+ FLN b a,
115+ FLN b c,
116+ FLN (Either b c) b,
117+ FLN (Either b c) c
118+ )
119+ => Dist (Either a b) -> Matrix Prob a c -> Matrix Prob b c -> Dist c
120+branchD x l r = f x `selectD` g l `selectD` r
121+ where
122+ f (D m) = D (fork (tr i1) (i1 `comp` tr i2) `comp` m)
123+ g m = i2 `comp` m
124+
125+-- | Branch on a Boolean value, skipping unnecessary computations.
126+ifD ::
127+ ( CountableDimsN a (Either () a),
128+ FLN a a,
129+ FLN a (),
130+ FLN () a,
131+ FLN (Either () a) a
132+ )
133+ => Dist Bool -> Dist a -> Dist a -> Dist a
134+ifD x (D t) (D e) = branchD x' t e
135+ where
136+ x' = bool (Right ()) (Left ()) `fmapD` x
137+
99138-- | Monad instance 'return' function
100−returnD :: forall a . (Enum a, FromListsN () a, Countable a) => a -> Dist a
139+returnD :: forall a . (Enum a, FLN () a, Countable a) => a -> Dist a
101140returnD a = D (col l)
102141 where
103142 i = fromInteger $ natVal (Proxy :: Proxy (Count a))
@@ -112,7 +151,7 @@ bindD (D d) m = D (m `comp` d)
112151(??) ::
113152 ( Enum a,
114153 Countable a,
115− FromListsN () a
154+ FLN () a
116155 ) => (a -> Bool) -> Dist a -> Prob
117156(??) p d =
118157 let l = toValues d
@@ -122,11 +161,11 @@ bindD (D d) m = D (m `comp` d)
122161-- Distribution Construction
123162
124163-- | Constructs a Bernoulli distribution
125−choose :: (FromListsN () a) => Prob -> Dist a
164+choose :: (FLN () a) => Prob -> Dist a
126165choose prob = D (col [prob, 1 - prob])
127166
128167-- | Creates a distribution given a shape function
129−shape :: (FromListsN () a) => (Prob -> Prob) -> [a] -> Dist a
168+shape :: (FLN () a) => (Prob -> Prob) -> [a] -> Dist a
130169shape _ [] = error "Probability.shape: empty list"
131170shape f xs =
132171 let incr = 1 / fromIntegral (length xs - 1)
@@ -134,23 +173,23 @@ shape f xs =
134173 in fromFreqs (zip xs ps)
135174
136175-- | Constructs a Linear distribution
137−linear :: (FromListsN () a) => [a] -> Dist a
176+linear :: (FLN () a) => [a] -> Dist a
138177linear = shape id
139178
140179-- | Constructs an Uniform distribution
141−uniform :: (FromListsN () a) => [a] -> Dist a
180+uniform :: (FLN () a) => [a] -> Dist a
142181uniform = shape (const 1)
143182
144183-- | Constructs an Negative Exponential distribution
145−negExp :: (FromListsN () a) => [a] -> Dist a
184+negExp :: (FLN () a) => [a] -> Dist a
146185negExp = shape (\x -> exp (-x))
147186
148187-- | Constructs an Normal distribution
149−normal :: (FromListsN () a) => [a] -> Dist a
188+normal :: (FLN () a) => [a] -> Dist a
150189normal = shape (normalCurve 0.5 0.5)
151190
152191-- | Transforms a 'Dist' into a list of pairs.
153−toValues :: forall a . (Enum a, Countable a, FromListsN () a) => Dist a -> [(a, Prob)]
192+toValues :: forall a . (Enum a, Countable a, FLN () a) => Dist a -> [(a, Prob)]
154193toValues (D d) =
155194 let rows = fromInteger (natVal (Proxy :: Proxy (Count a)))
156195 probs = toList d
@@ -158,7 +197,7 @@ toValues (D d) =
158197 in res
159198
160199-- | Pretty a distribution
161−prettyDist :: forall a. (Show a, Enum a, Countable a, FromListsN () a) => Dist a -> String
200+prettyDist :: forall a. (Show a, Enum a, Countable a, FLN () a) => Dist a -> String
162201prettyDist d =
163202 let values = sortBy (\(a, p1) (b, p2) -> compare p2 p1) (toValues @a d)
164203 w = maximum (map (length . show . fst) values)
@@ -170,12 +209,12 @@ prettyDist d =
170209 showR n x = show x ++ " "
171210
172211-- | Pretty Print a distribution
173−prettyPrintDist :: forall a . (Show a, Enum a, Countable a, FromListsN () a) => Dist a -> IO ()
212+prettyPrintDist :: forall a . (Show a, Enum a, Countable a, FLN () a) => Dist a -> IO ()
174213prettyPrintDist = putStrLn . prettyDist @a
175214
176215-- Auxiliary functions
177216
178−fromFreqs :: (FromListsN () a) => [(a,Prob)] -> Dist a
217+fromFreqs :: (FLN () a) => [(a,Prob)] -> Dist a
179218fromFreqs xs = D (col (map (\(x,p) -> p/q) xs))
180219 where q = sum $ map snd xs
181220
src/LAoP/Matrix/Internal.hs+399−392
@@ -1,3 +1,4 @@
1+{-# LANGUAGE StrictData #-}
12{-# LANGUAGE TypeFamilyDependencies #-}
23{-# LANGUAGE ConstraintKinds #-}
34{-# LANGUAGE AllowAmbiguousTypes #-}
@@ -29,7 +30,7 @@
2930-- motivation behind the library, the underlying theory, and implementation details.
3031--
3132-- This module offers many of the combinators mentioned in the work of
32−-- Macedo (2012) and Oliveira (2012).
33+-- Macedo (2012) and Oliveira (2012).
3334--
3435-- This is an Internal module and it is no supposed to be imported.
3536--
@@ -42,17 +43,26 @@ module LAoP.Matrix.Internal
4243 --
4344 -- There exists two type families that make it easier to write
4445 -- matrix dimensions: 'FromNat' and 'Count'. This approach
45− -- leads to a very straightforward implementation
46− -- of LAoP combinators.
46+ -- leads to a very straightforward implementation
47+ -- of LAoP combinators.
4748
4849 -- * Type safe matrix representation
4950 Matrix (..),
5051
52+ -- * Constraint type aliases
53+ Countable,
54+ CountableDims,
55+ CountableN,
56+ CountableDimsN,
57+ FL,
58+ FLN,
59+ Liftable,
60+ Trivial,
61+
5162 -- * Primitives
52− empty,
5363 one,
54− junc,
55− split,
64+ join,
65+ fork,
5666
5767 -- * Auxiliary type families
5868 FromNat,
@@ -65,6 +75,7 @@ module LAoP.Matrix.Internal
6575 toLists,
6676 toList,
6777 matrixBuilder,
78+ matrixBuilder',
6879 row,
6980 col,
7081 zeros,
@@ -75,11 +86,17 @@ module LAoP.Matrix.Internal
7586 -- * Misc
7687 -- ** Get dimensions
7788 columns,
89+ columns',
7890 rows,
91+ rows',
7992
8093 -- ** Matrix Transposition
8194 tr,
8295
96+ -- ** Scalar multiplication/division of matrices
97+ (.|),
98+ (./),
99+
83100 -- ** Selective operator
84101 select,
85102 branch,
@@ -88,16 +105,19 @@ module LAoP.Matrix.Internal
88105 cond,
89106
90107 -- ** Matrix "abiding"
91− abideJS,
92− abideSJ,
108+ abideJF,
109+ abideFJ,
110+
111+ -- ** Zip matrices
112+ zipWithM,
93113
94114 -- * Biproduct approach
95− -- ** Split
115+ -- ** Fork
96116 (===),
97117 -- *** Projections
98118 p1,
99119 p2,
100− -- ** Junc
120+ -- ** Join
101121 (|||),
102122 -- *** Injections
103123 i1,
@@ -110,12 +130,13 @@ module LAoP.Matrix.Internal
110130
111131 -- | Note that given the restrictions imposed it is not possible to
112132 -- implement the standard type classes present in standard Haskell.
133+
113134 -- *** Matrix pairing projections
114− kp1,
115− kp2,
135+ fstM,
136+ sndM,
116137
117138 -- *** Matrix pairing
118− khatri,
139+ kr,
119140
120141 -- * Matrix composition and lifting
121142
@@ -123,10 +144,10 @@ module LAoP.Matrix.Internal
123144
124145 -- | Note that given the restrictions imposed it is not possible to
125146 -- implement the standard type classes present in standard Haskell.
126− identity,
147+ iden,
127148 comp,
128− fromF,
129149 fromF',
150+ fromF,
130151
131152 -- * Matrix printing
132153 pretty,
@@ -153,21 +174,22 @@ import LAoP.Utils.Internal
153174import Data.Bool
154175import Data.Kind
155176import Data.List
177+import Data.Maybe
156178import Data.Proxy
179+import Data.Typeable
157180import Data.Void
158181import GHC.TypeLits
159182import Data.Type.Equality
160183import GHC.Generics
161184import Control.DeepSeq
162−import Control.Category
163−import Prelude hiding ((.))
185+import Prelude hiding (id, (.))
186+import qualified Prelude (id, (.))
164187
165188-- | LAoP (Linear Algebra of Programming) Inductive Matrix definition.
166189data Matrix e cols rows where
167− Empty :: Matrix e Void Void
168190 One :: e -> Matrix e () ()
169− Junc :: Matrix e a rows -> Matrix e b rows -> Matrix e (Either a b) rows
170− Split :: Matrix e cols a -> Matrix e cols b -> Matrix e cols (Either a b)
191+ Join :: Matrix e a rows -> Matrix e b rows -> Matrix e (Either a b) rows
192+ Fork :: Matrix e cols a -> Matrix e cols b -> Matrix e cols (Either a b)
171193
172194deriving instance (Show e) => Show (Matrix e cols rows)
173195
@@ -194,122 +216,95 @@ type family Count (d :: Type) :: Nat where
194216--
195217-- Thanks to Li-Yao Xia this type family is super fast.
196218type family FromNat (n :: Nat) :: Type where
197− FromNat 0 = Void
198219 FromNat 1 = ()
199220 FromNat n = FromNat' (Mod n 2 == 0) (FromNat (Div n 2))
200221
201222type family FromNat' (b :: Bool) (m :: Type) :: Type where
202− FromNat' 'True m = Either m m
223+ FromNat' 'True m = Either m m
203224 FromNat' 'False m = Either () (Either m m)
204225
205226-- | Type family that normalizes the representation of a given data
206227-- structure
207228type family Normalize (d :: Type) :: Type where
208− Normalize (Either a b) = Either (Normalize a) (Normalize b)
209− Normalize d = FromNat (Count d)
229+ Normalize (Either a b) = Either (Normalize a) (Normalize b)
230+ Normalize d = FromNat (Count d)
210231
211232-- | Constraint type synonyms to keep the type signatures less convoluted
212233type Countable a = KnownNat (Count a)
213234type CountableN a = KnownNat (Count (Normalize a))
214−type CountableDimensions a b = (Countable a, Countable b)
215−type CountableDimensionsN a b = (CountableN a, CountableN b)
216−type FromListsN e a b = FromLists e (Normalize a) (Normalize b)
235+type CountableDims a b = (Countable a, Countable b)
236+type CountableDimsN a b = (CountableN a, CountableN b)
237+type FL a b = FromLists a b
238+type FLN a b = FromLists (Normalize a) (Normalize b)
217239type Liftable e a b = (Bounded a, Bounded b, Enum a, Enum b, Eq b, Num e, Ord e)
218240type Trivial a = FromNat (Count a) ~ a
219241
220−-- | It isn't possible to implement the 'id' function so it's
221−-- implementation is 'undefined'. However 'comp' can be and this partial
222−-- class implementation exists just to make the code more readable.
223−--
224−-- Please use 'identity' instead.
242+-- | It is possible to implement a constrained version of the category type
243+-- class.
225244instance (Num e) => Category (Matrix e) where
226− id = undefined
227− (.) = comp
245+ type Object (Matrix e) a = (FL a a, Countable a)
246+ id = iden
247+ (.) = comp
228248
229249instance NFData e => NFData (Matrix e cols rows) where
230− rnf Empty = ()
231− rnf (One e) = rnf e
232− rnf (Junc a b) = rnf a `seq` rnf b
233− rnf (Split a b) = rnf a `seq` rnf b
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
234253
235254instance Eq e => Eq (Matrix e cols rows) where
236− Empty == Empty = True
237− (One a) == (One b) = a == b
238− (Junc a b) == (Junc c d) = a == c && b == d
239− (Split a b) == (Split c d) = a == c && b == d
240− x@(Split _ _) == y@(Junc _ _) = x == abideJS y
241− x@(Junc _ _) == y@(Split _ _) = abideJS x == y
255+ (One a) == (One b) = a == b
256+ (Join a b) == (Join c d) = a == c && b == d
257+ (Fork a b) == (Fork c d) = a == c && b == d
258+ x@(Fork _ _) == y@(Join _ _) = x == abideJF y
259+ x@(Join _ _) == y@(Fork _ _) = abideJF x == y
242260
243261instance Num e => Num (Matrix e cols rows) where
262+ a + b = zipWithM (+) a b
263+
264+ a - b = zipWithM (-) a b
265+
266+ a * b = zipWithM (*) a b
244267
245− Empty + Empty = Empty
246− (One a) + (One b) = One (a + b)
247− (Junc a b) + (Junc c d) = Junc (a + c) (b + d)
248− (Split a b) + (Split c d) = Split (a + c) (b + d)
249− x@(Split _ _) + y@(Junc _ _) = x + abideJS y
250− x@(Junc _ _) + y@(Split _ _) = abideJS x + y
251−
252− Empty - Empty = Empty
253− (One a) - (One b) = One (a - b)
254− (Junc a b) - (Junc c d) = Junc (a - c) (b - d)
255− (Split a b) - (Split c d) = Split (a - c) (b - d)
256− x@(Split _ _) - y@(Junc _ _) = x - abideJS y
257− x@(Junc _ _) - y@(Split _ _) = abideJS x - y
258−
259− Empty * Empty = Empty
260− (One a) * (One b) = One (a * b)
261− (Junc a b) * (Junc c d) = Junc (a * c) (b * d)
262− (Split a b) * (Split c d) = Split (a * c) (b * d)
263− x@(Split _ _) * y@(Junc _ _) = x * abideJS y
264− x@(Junc _ _) * y@(Split _ _) = abideJS x * y
265−
266− abs Empty = Empty
267− abs (One a) = One (abs a)
268− abs (Junc a b) = Junc (abs a) (abs b)
269− abs (Split a b) = Split (abs a) (abs b)
270−
271− signum Empty = Empty
272− signum (One a) = One (signum a)
273− signum (Junc a b) = Junc (signum a) (signum b)
274− signum (Split a b) = Split (signum a) (signum b)
268+ abs (One a) = One (abs a)
269+ abs (Join a b) = Join (abs a) (abs b)
270+ abs (Fork a b) = Fork (abs a) (abs b)
271+
272+ signum (One a) = One (signum a)
273+ signum (Join a b) = Join (signum a) (signum b)
274+ signum (Fork a b) = Fork (signum a) (signum b)
275275
276276instance Ord e => Ord (Matrix e cols rows) where
277− Empty <= Empty = True
278− (One a) <= (One b) = a <= b
279− (Junc a b) <= (Junc c d) = (a <= c) && (b <= d)
280− (Split a b) <= (Split c d) = (a <= c) && (b <= d)
281− x@(Split _ _) <= y@(Junc _ _) = x <= abideJS y
282− x@(Junc _ _) <= y@(Split _ _) = abideJS x <= y
277+ (One a) <= (One b) = a <= b
278+ (Join a b) <= (Join c d) = (a <= c) && (b <= d)
279+ (Fork a b) <= (Fork c d) = (a <= c) && (b <= d)
280+ x@(Fork _ _) <= y@(Join _ _) = x <= abideJF y
281+ x@(Join _ _) <= y@(Fork _ _) = abideJF x <= y
283282
284283-- Primitives
285284
286−-- | Empty matrix constructor
287−empty :: Matrix e Void Void
288−empty = Empty
289−
290285-- | Unit matrix constructor
291286one :: e -> Matrix e () ()
292287one = One
293288
294−-- | Matrix 'Junc' constructor
295−junc :: Matrix e a rows -> Matrix e b rows -> Matrix e (Either a b) rows
296−junc = Junc
289+-- | Matrix 'Join' constructor
290+join :: Matrix e a rows -> Matrix e b rows -> Matrix e (Either a b) rows
291+join = Join
297292
298293infixl 3 |||
299294
300−-- | Matrix 'Junc' constructor
295+-- | Matrix 'Join' constructor
301296(|||) :: Matrix e a rows -> Matrix e b rows -> Matrix e (Either a b) rows
302−(|||) = Junc
297+(|||) = Join
303298
304−-- | Matrix 'Split' constructor
305−split :: Matrix e cols a -> Matrix e cols b -> Matrix e cols (Either a b)
306−split = Split
299+-- | Matrix 'Fork' constructor
300+fork :: Matrix e cols a -> Matrix e cols b -> Matrix e cols (Either a b)
301+fork = Fork
307302
308303infixl 2 ===
309304
310−-- | Matrix 'Split' constructor
305+-- | Matrix 'Fork' constructor
311306(===) :: Matrix e cols a -> Matrix e cols b -> Matrix e cols (Either a b)
312−(===) = Split
307+(===) = Fork
313308
314309-- Construction
315310
@@ -317,84 +312,101 @@ infixl 2 ===
317312--
318313-- Given that it is not possible to branch on types at the term level type
319314-- classes are needed very much like an inductive definition but on types.
320−class FromLists e cols rows where
315+class FromLists cols rows where
321316 -- | Build a matrix out of a list of list of elements. Throws a runtime
322317 -- error if the dimensions do not match.
323318 fromLists :: [[e]] -> Matrix e cols rows
324319
325−instance FromLists e Void Void where
326− fromLists [] = Empty
327− fromLists _ = error "Wrong dimensions"
328−
329−instance {-# OVERLAPPING #-} FromLists e () () where
320+instance FromLists () () where
330321 fromLists [[e]] = One e
331322 fromLists _ = error "Wrong dimensions"
332323
333−instance {-# OVERLAPPING #-} (FromLists e cols ()) => FromLists e (Either () cols) () where
334− fromLists [h : t] = Junc (One h) (fromLists [t])
324+instance (FromLists cols ()) => FromLists (Either () cols) () where
325+ fromLists [h : t] = Join (One h) (fromLists [t])
335326 fromLists _ = error "Wrong dimensions"
336327
337−instance {-# OVERLAPPABLE #-} (FromLists e a (), FromLists e b (), Countable a) => FromLists e (Either a b) () where
338− fromLists [l] =
328+instance {-# OVERLAPPABLE #-}
329+ (FromLists a (), FromLists b (), Countable a) => FromLists (Either a b) () where
330+ fromLists [l] =
339331 let rowsA = fromInteger (natVal (Proxy :: Proxy (Count a)))
340− in Junc (fromLists [take rowsA l]) (fromLists [drop rowsA l])
332+ in Join (fromLists [take rowsA l]) (fromLists [drop rowsA l])
341333 fromLists _ = error "Wrong dimensions"
342334
343−instance {-# OVERLAPPING #-} (FromLists e () rows) => FromLists e () (Either () rows) where
344− fromLists ([h] : t) = Split (One h) (fromLists t)
335+instance (FromLists () rows) => FromLists () (Either () rows) where
336+ fromLists ([h] : t) = Fork (One h) (fromLists t)
345337 fromLists _ = error "Wrong dimensions"
346338
347−instance {-# OVERLAPPABLE #-} (FromLists e () a, FromLists e () b, Countable a) => FromLists e () (Either a b) where
348− fromLists l@([_] : _) =
339+instance {-# OVERLAPPABLE #-}
340+ (FromLists () a, FromLists () b, Countable a) => FromLists () (Either a b) where
341+ fromLists l@([_] : _) =
349342 let rowsA = fromInteger (natVal (Proxy :: Proxy (Count a)))
350− in Split (fromLists (take rowsA l)) (fromLists (drop rowsA l))
343+ in Fork (fromLists (take rowsA l)) (fromLists (drop rowsA l))
351344 fromLists _ = error "Wrong dimensions"
352345
353−instance {-# OVERLAPPABLE #-} (FromLists e (Either a b) c, FromLists e (Either a b) d, Countable c) => FromLists e (Either a b) (Either c d) where
346+instance (FromLists (Either a b) c, FromLists (Either a b) d, Countable c)
347+ => FromLists (Either a b) (Either c d) where
354348 fromLists l@(h : t) =
355349 let lh = length h
356350 rowsC = fromInteger (natVal (Proxy :: Proxy (Count c)))
357− condition = all (== lh) (map length t)
351+ condition = all ((== lh) . length) t
358352 in if lh > 0 && condition
359− then Split (fromLists (take rowsC l)) (fromLists (drop rowsC l))
353+ then Fork (fromLists (take rowsC l)) (fromLists (drop rowsC l))
360354 else error "Not all rows have the same length"
361355
362356-- | Matrix builder function. Constructs a matrix provided with
363−-- a construction function.
364−matrixBuilder ::
357+-- a construction function that operates with indices.
358+matrixBuilder' ::
365359 forall e cols rows.
366− ( FromLists e cols rows,
367− CountableDimensions cols rows
368− ) =>
369− ((Int, Int) -> e) ->
370− Matrix e cols rows
371−matrixBuilder f =
360+ ( FL cols rows,
361+ CountableDims cols rows
362+ ) => ((Int, Int) -> e) -> Matrix e cols rows
363+matrixBuilder' f =
372364 let c = fromInteger $ natVal (Proxy :: Proxy (Count cols))
373365 r = fromInteger $ natVal (Proxy :: Proxy (Count rows))
374366 positions = [(a, b) | a <- [0 .. (r - 1)], b <- [0 .. (c - 1)]]
375367 in fromLists . map (map f) . groupBy (\(x, _) (w, _) -> x == w) $ positions
376368
369+-- | Matrix builder function. Constructs a matrix provided with
370+-- a construction function that operates with arbitrary types.
371+matrixBuilder ::
372+ forall e a b.
373+ ( FLN a b,
374+ Enum a,
375+ Enum b,
376+ Bounded a,
377+ Bounded b,
378+ Eq a,
379+ Countable b
380+ ) => ((a, b) -> e) -> Matrix e (Normalize a) (Normalize b)
381+matrixBuilder f =
382+ let r = fromInteger $ natVal (Proxy :: Proxy (Count b))
383+ positions = [(a, b) | a <- [minBound .. maxBound], b <- [minBound .. maxBound]]
384+ in fromLists . map (map f) . transpose . buildList r $ positions
385+ where
386+ buildList _ [] = []
387+ buildList r l = take r l : buildList r (drop r l)
388+
377389-- | Constructs a column vector matrix
378−col :: (FromLists e () rows) => [e] -> Matrix e () rows
390+col :: (FL () rows) => [e] -> Matrix e () rows
379391col = fromLists . map (: [])
380392
381393-- | Constructs a row vector matrix
382−row :: (FromLists e cols ()) => [e] -> Matrix e cols ()
394+row :: (FL cols ()) => [e] -> Matrix e cols ()
383395row = fromLists . (: [])
384396
385397-- | Lifts functions to matrices with arbitrary dimensions.
386398--
387399-- NOTE: Be careful to not ask for a matrix bigger than the cardinality of
388400-- types @a@ or @b@ allows.
389−fromF ::
401+fromF' ::
390402 forall a b cols rows e.
391403 ( Liftable e a b,
392− CountableDimensions cols rows,
393− FromLists e rows cols
404+ CountableDims cols rows,
405+ FL rows cols
394406 ) =>
395407 (a -> b) ->
396408 Matrix e cols rows
397−fromF f =
409+fromF' f =
398410 let minA = minBound @a
399411 maxA = maxBound @a
400412 minB = minBound @b
@@ -404,8 +416,8 @@ fromF f =
404416 elementsA = take ccols [minA .. maxA]
405417 elementsB = take rrows [minB .. maxB]
406418 combinations = (,) <$> elementsA <*> elementsB
407− combAp = map snd . sort . map (\(a, b) -> if f a == b
408− then ((fromEnum a, fromEnum b), 1)
419+ combAp = map snd . sort . map (\(a, b) -> if f a == b
420+ then ((fromEnum a, fromEnum b), 1)
409421 else ((fromEnum a, fromEnum b), 0)) $ combinations
410422 mList = buildList combAp rrows
411423 in tr $ fromLists mList
@@ -415,41 +427,23 @@ fromF f =
415427
416428-- | Lifts functions to matrices with dimensions matching @a@ and @b@
417429-- cardinality's.
418−fromF' ::
430+fromF ::
419431 forall a b e.
420432 ( Liftable e a b,
421− CountableDimensionsN a b,
422− FromListsN e b a
433+ CountableDimsN a b,
434+ FLN b a
423435 ) =>
424436 (a -> b) ->
425437 Matrix e (Normalize a) (Normalize b)
426−fromF' f =
427− let minA = minBound @a
428− maxA = maxBound @a
429− minB = minBound @b
430− maxB = maxBound @b
431− ccols = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize a)))
432− rrows = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize b)))
433− elementsA = take ccols [minA .. maxA]
434− elementsB = take rrows [minB .. maxB]
435− combinations = (,) <$> elementsA <*> elementsB
436− combAp = map snd . sort . map (\(a, b) -> if f a == b
437− then ((fromEnum a, fromEnum b), 1)
438− else ((fromEnum a, fromEnum b), 0)) $ combinations
439− mList = buildList combAp rrows
440− in tr $ fromLists mList
441− where
442− buildList [] _ = []
443− buildList l r = take r l : buildList (drop r l) r
438+fromF = fromF'
444439
445440-- Conversion
446441
447442-- | Converts a matrix to a list of lists of elements.
448443toLists :: Matrix e cols rows -> [[e]]
449−toLists Empty = []
450444toLists (One e) = [[e]]
451−toLists (Split l r) = toLists l ++ toLists r
452−toLists (Junc l r) = zipWith (++) (toLists l) (toLists r)
445+toLists (Fork l r) = toLists l ++ toLists r
446+toLists (Join l r) = zipWith (++) (toLists l) (toLists r)
453447
454448-- | Converts a matrix to a list of elements.
455449toList :: Matrix e cols rows -> [e]
@@ -458,37 +452,38 @@ toList = concat . toLists
458452-- Zeros Matrix
459453
460454-- | The zero matrix. A matrix wholly filled with zeros.
461−zeros :: (Num e, FromLists e cols rows, CountableDimensions cols rows) => Matrix e cols rows
462−zeros = matrixBuilder (const 0)
455+zeros :: (Num e, FL cols rows, CountableDims cols rows) => Matrix e cols rows
456+zeros = matrixBuilder' (const 0)
463457
464458-- Ones Matrix
465459
466460-- | The ones matrix. A matrix wholly filled with ones.
467461--
468462-- Also known as T (Top) matrix.
469−ones :: (Num e, FromLists e cols rows, CountableDimensions cols rows) => Matrix e cols rows
470−ones = matrixBuilder (const 1)
463+ones :: (Num e, FL cols rows, CountableDims cols rows) => Matrix e cols rows
464+ones = matrixBuilder' (const 1)
471465
472466-- Const Matrix
473467
474468-- | The constant matrix constructor. A matrix wholly filled with a given
475469-- value.
476−constant :: (Num e, FromLists e cols rows, CountableDimensions cols rows) => e -> Matrix e cols rows
477−constant e = matrixBuilder (const e)
470+constant :: (Num e, FL cols rows, CountableDims cols rows) => e -> Matrix e cols rows
471+constant e = matrixBuilder' (const e)
478472
479473-- Bang Matrix
480474
481475-- | The T (Top) row vector matrix.
482−bang :: forall e cols. (Num e, Enum e, FromLists e cols (), Countable cols) => Matrix e cols ()
476+bang :: forall e cols. (Num e, Enum e, FL cols (), Countable cols) => Matrix e cols ()
483477bang =
484478 let c = fromInteger $ natVal (Proxy :: Proxy (Count cols))
485479 in fromLists [take c [1, 1 ..]]
486480
487−-- Identity Matrix
481+-- iden Matrix
488482
489−-- | Identity matrix.
490−identity :: (Num e, FromLists e cols cols, Countable cols) => Matrix e cols cols
491−identity = matrixBuilder (bool 0 1 . uncurry (==))
483+-- | iden matrix.
484+iden :: forall e cols . (Num e, FL cols cols, Countable cols) => Matrix e cols cols
485+iden = matrixBuilder' (bool 0 1 . uncurry (==))
486+{-# NOINLINE iden #-}
492487
493488-- Matrix composition (MMM)
494489
@@ -497,60 +492,90 @@ identity = matrixBuilder (bool 0 1 . uncurry (==))
497492-- This definition takes advantage of divide-and-conquer and fusion laws
498493-- from LAoP.
499494comp :: (Num e) => Matrix e cr rows -> Matrix e cols cr -> Matrix e cols rows
500−comp Empty Empty = Empty
501−comp (One a) (One b) = One (a * b)
502−comp (Junc a b) (Split c d) = comp a c + comp b d -- Divide-and-conquer law
503−comp (Split a b) c = Split (comp a c) (comp b c) -- Split fusion law
504−comp c (Junc a b) = Junc (comp c a) (comp c b) -- Junc fusion law
495+comp (One a) (One b) = One (a * b)
496+comp (Join a b) (Fork c d) = comp a c + comp b d -- Divide-and-conquer law
497+comp (Fork a b) c = Fork (comp a c) (comp b c) -- Fork fusion law
498+comp c (Join a b) = Join (comp c a) (comp c b) -- Join fusion law
499+{-# NOINLINE comp #-}
500+{-# RULES
501+ "comp/iden1" forall m. comp m iden = m ;
502+ "comp/iden2" forall m. comp iden m = m
503+#-}
504+
505+-- Scalar multiplication of matrices
506+
507+infixl 7 .|
508+-- | Scalar multiplication of matrices.
509+(.|) :: Num e => e -> Matrix e cols rows -> Matrix e cols rows
510+(.|) e (One a) = One (e * a)
511+(.|) e (Join a b) = Join (e .| a) (e .| b)
512+(.|) e (Fork a b) = Fork (e .| a) (e .| b)
513+
514+-- Scalar division of matrices
515+
516+infixl 7 ./
517+-- | Scalar multiplication of matrices.
518+(./) :: Fractional e => Matrix e cols rows -> e -> Matrix e cols rows
519+(./) (One a) e = One (a / e)
520+(./) (Join a b) e = Join (a ./ e) (b ./ e)
521+(./) (Fork a b) e = Fork (a ./ e) (b ./ e)
505522
506523-- Projections
507524
508525-- | Biproduct first component projection
509−p1 :: forall e m n. (Num e, CountableDimensions n m, FromLists e n m, FromLists e m m) => Matrix e (Either m n) m
510−p1 =
511− let iden = identity :: Matrix e m m
512− zero = zeros :: Matrix e n m
513− in junc iden zero
526+p1 :: (Num e, CountableDims n m, FL n m, FL m m) => Matrix e (Either m n) m
527+p1 = join id zeros
514528
515529-- | Biproduct second component projection
516−p2 :: forall e m n. (Num e, CountableDimensions n m, FromLists e m n, FromLists e n n) => Matrix e (Either m n) n
517−p2 =
518− let iden = identity :: Matrix e n n
519− zero = zeros :: Matrix e m n
520− in junc zero iden
530+p2 :: (Num e, CountableDims n m, FL m n, FL n n) => Matrix e (Either m n) n
531+p2 = join zeros id
521532
522533-- Injections
523534
524535-- | Biproduct first component injection
525−i1 :: (Num e, CountableDimensions n m, FromLists e n m, FromLists e m m) => Matrix e m (Either m n)
536+i1 :: (Num e, CountableDims n m, FL n m, FL m m) => Matrix e m (Either m n)
526537i1 = tr p1
527538
528539-- | Biproduct second component injection
529−i2 :: (Num e, CountableDimensions n m, FromLists e m n, FromLists e n n) => Matrix e n (Either m n)
540+i2 :: (Num e, CountableDims n m, FL m n, FL n n) => Matrix e n (Either m n)
530541i2 = tr p2
531542
532543-- Dimensions
533544
534545-- | Obtain the number of rows.
535546--
536−-- NOTE: The 'KnownNat' constaint is needed in order to obtain the
537−-- dimensions in constant time.
538−--
539−-- TODO: A 'rows' function that does not need the 'KnownNat' constraint in
540−-- exchange for performance.
547+-- NOTE: The 'KnownNat' constraint is needed in order to obtain the
548+-- dimensions in constant time. For a version that doesn't require the
549+-- constraint see 'rows''.
541550rows :: forall e cols rows. (Countable rows) => Matrix e cols rows -> Int
542551rows _ = fromInteger $ natVal (Proxy :: Proxy (Count rows))
543552
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+
544562-- | Obtain the number of columns.
545−--
546−-- NOTE: The 'KnownNat' constaint is needed in order to obtain the
547−-- dimensions in constant time.
548563--
549−-- TODO: A 'columns' function that does not need the 'KnownNat' constraint in
550−-- exchange for performance.
564+-- NOTE: The 'KnownNat' constraint is needed in order to obtain the
565+-- dimensions in constant time. For a version that doesn't require the
566+-- constraint see 'columns''.
551567columns :: forall e cols rows. (Countable cols) => Matrix e cols rows -> Int
552568columns _ = fromInteger $ natVal (Proxy :: Proxy (Count cols))
553569
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+
554579-- Coproduct Bifunctor
555580
556581infixl 5 -|-
@@ -559,164 +584,161 @@ infixl 5 -|-
559584(-|-) ::
560585 forall e n k m j.
561586 ( Num e,
562− CountableDimensions j k,
563− FromLists e k k,
564− FromLists e j k,
565− FromLists e k j,
566− FromLists e j j
587+ CountableDims j k,
588+ FL k k,
589+ FL j k,
590+ FL k j,
591+ FL j j
567592 ) =>
568593 Matrix e n k ->
569594 Matrix e m j ->
570595 Matrix e (Either n m) (Either k j)
571−(-|-) a b = Junc (i1 . a) (i2 . b)
596+(-|-) a b = Join (i1 . a) (i2 . b)
572597
573598-- Khatri Rao Product and projections
574599
575600-- | Khatri Rao product first component projection matrix.
576−kp1 ::
601+fstM ::
577602 forall e m k .
578603 ( Num e,
579− CountableDimensions k m,
580− FromLists e (Normalize (m, k)) m,
604+ CountableDims k m,
605+ FL (Normalize (m, k)) m,
581606 CountableN (m, k)
582607 ) => Matrix e (Normalize (m, k)) m
583−kp1 = matrixBuilder f
608+fstM = matrixBuilder' f
584609 where
585610 offset = fromInteger (natVal (Proxy :: Proxy (Count k)))
586611 f (x, y)
587612 | y >= (x * offset) && y <= (x * offset + offset - 1) = 1
588− | otherwise = 0
613+ | otherwise = 0
589614
590615-- | Khatri Rao product second component projection matrix.
591−kp2 ::
616+sndM ::
592617 forall e m k .
593618 ( Num e,
594− CountableDimensions k m,
595− FromLists e (Normalize (m, k)) k,
619+ CountableDims k m,
620+ FL (Normalize (m, k)) k,
596621 CountableN (m, k)
597622 ) => Matrix e (Normalize (m, k)) k
598−kp2 = matrixBuilder f
623+sndM = matrixBuilder' f
599624 where
600625 offset = fromInteger (natVal (Proxy :: Proxy (Count k)))
601626 f (x, y)
602627 | x == y || mod (y - x) offset == 0 = 1
603− | otherwise = 0
628+ | otherwise = 0
604629
605630-- | Khatri Rao Matrix product also known as matrix pairing.
606631--
607632-- NOTE: That this is not a true categorical product, see for instance:
608−--
633+--
609634-- @
610−-- | kp1 . khatri a b == a
611−-- khatri a b ==> |
612−-- | kp2 . khatri a b == b
635+-- | fstM . kr a b == a
636+-- kr a b ==> |
637+-- | sndM . kr a b == b
613638-- @
614639--
615640-- __Emphasis__ on the implication symbol.
616−khatri ::
617− forall e cols a b.
641+kr ::
642+ forall e cols a b.
618643 ( Num e,
619− CountableDimensions a b,
644+ CountableDims a b,
620645 CountableN (a, b),
621− FromLists e (Normalize (a, b)) a,
622− FromLists e (Normalize (a, b)) b
646+ FL (Normalize (a, b)) a,
647+ FL (Normalize (a, b)) b
623648 ) => Matrix e cols a -> Matrix e cols b -> Matrix e cols (Normalize (a, b))
624−khatri a b =
625− let kp1' = kp1 @e @a @b
626− kp2' = kp2 @e @a @b
627− in (tr kp1') . a * (tr kp2') . b
649+kr a b =
650+ let fstM' = fstM @e @a @b
651+ sndM' = sndM @e @a @b
652+ in (tr fstM' . a) * (tr sndM' . b)
628653
629654-- Product Bifunctor (Kronecker)
630655
631656infixl 4 ><
632657
633658-- | Matrix product functor also known as kronecker product
634−(><) ::
635− forall e m p n q.
659+(><) ::
660+ forall e m p n q.
636661 ( Num e,
637− CountableDimensions m n,
638− CountableDimensions p q,
639− CountableDimensionsN (m, n) (p, q),
640− FromLists e (Normalize (m, n)) m,
641− FromLists e (Normalize (m, n)) n,
642− FromLists e (Normalize (p, q)) p,
643− FromLists e (Normalize (p, q)) q
644− )
662+ CountableDims m n,
663+ CountableDims p q,
664+ CountableDimsN (m, n) (p, q),
665+ FL (Normalize (m, n)) m,
666+ FL (Normalize (m, n)) n,
667+ FL (Normalize (p, q)) p,
668+ FL (Normalize (p, q)) q
669+ )
645670 => Matrix e m p -> Matrix e n q -> Matrix e (Normalize (m, n)) (Normalize (p, q))
646671(><) a b =
647− let kp1' = kp1 @e @m @n
648− kp2' = kp2 @e @m @n
649− in khatri (a . kp1') (b . kp2')
672+ let fstM' = fstM @e @m @n
673+ sndM' = sndM @e @m @n
674+ in kr (a . fstM') (b . sndM')
650675
651−-- Matrix abide Junc Split
676+-- Matrix abide Join Fork
652677
653−-- | Matrix "abiding" followin the 'Junc'-'Split' abide law.
654−--
678+-- | Matrix "abiding" following the 'Join'-'Fork' exchange law.
679+--
655680-- Law:
656681--
657682-- @
658−-- 'Junc' ('Split' a c) ('Split' b d) == 'Split' ('Junc' a b) ('Junc' c d)
683+-- 'Join' ('Fork' a c) ('Fork' b d) == 'Fork' ('Join' a b) ('Join' c d)
659684-- @
660−abideJS :: Matrix e cols rows -> Matrix e cols rows
661−abideJS (Junc (Split a c) (Split b d)) = Split (Junc (abideJS a) (abideJS b)) (Junc (abideJS c) (abideJS d)) -- Junc-Split abide law
662−abideJS Empty = Empty
663−abideJS (One e) = One e
664−abideJS (Junc a b) = Junc (abideJS a) (abideJS b)
665−abideJS (Split a b) = Split (abideJS a) (abideJS b)
685+abideJF :: Matrix e cols rows -> Matrix e cols rows
686+abideJF (Join (Fork a c) (Fork b d)) = Fork (Join (abideJF a) (abideJF b)) (Join (abideJF c) (abideJF d)) -- Join-Fork abide law
687+abideJF (One e) = One e
688+abideJF (Join a b) = Join (abideJF a) (abideJF b)
689+abideJF (Fork a b) = Fork (abideJF a) (abideJF b)
666690
667−-- Matrix abide Split Junc
691+-- Matrix abide Fork Join
668692
669−-- | Matrix "abiding" followin the 'Split'-'Junc' abide law.
670−--
693+-- | Matrix "abiding" followin the 'Fork'-'Join' abide law.
694+--
671695-- @
672−-- 'Split' ('Junc' a b) ('Junc' c d) == 'Junc' ('Split' a c) ('Split' b d)
696+-- 'Fork' ('Join' a b) ('Join' c d) == 'Join' ('Fork' a c) ('Fork' b d)
673697-- @
674−abideSJ :: Matrix e cols rows -> Matrix e cols rows
675−abideSJ (Split (Junc a b) (Junc c d)) = Junc (Split (abideSJ a) (abideSJ c)) (Split (abideSJ b) (abideSJ d)) -- Split-Junc abide law
676−abideSJ Empty = Empty
677−abideSJ (One e) = One e
678−abideSJ (Junc a b) = Junc (abideSJ a) (abideSJ b)
679−abideSJ (Split a b) = Split (abideSJ a) (abideSJ b)
698+abideFJ :: Matrix e cols rows -> Matrix e cols rows
699+abideFJ (Fork (Join a b) (Join c d)) = Join (Fork (abideFJ a) (abideFJ c)) (Fork (abideFJ b) (abideFJ d)) -- Fork-Join abide law
700+abideFJ (One e) = One e
701+abideFJ (Join a b) = Join (abideFJ a) (abideFJ b)
702+abideFJ (Fork a b) = Fork (abideFJ a) (abideFJ b)
680703
681704-- Matrix transposition
682705
683706-- | Matrix transposition.
684707tr :: Matrix e cols rows -> Matrix e rows cols
685−tr Empty = Empty
686−tr (One e) = One e
687−tr (Junc a b) = Split (tr a) (tr b)
688−tr (Split a b) = Junc (tr a) (tr b)
708+tr (One e) = One e
709+tr (Join a b) = Fork (tr a) (tr b)
710+tr (Fork a b) = Join (tr a) (tr b)
689711
690712-- Selective 'select' operator
691713
692714-- | Selective functors 'select' operator equivalent inspired by the
693715-- ArrowMonad solution presented in the paper.
694−select :: (Num e, FromLists e b b, Countable b) => Matrix e cols (Either a b) -> Matrix e a b -> Matrix e cols b
695−select (Split a b) y = y . a + b -- Divide-and-conquer law
696−select (Junc (Split a c) (Split b d)) y = junc (y . a + c) (y . b + d) -- Pattern matching + DnC law
697−select m y = junc y identity . m
716+select :: (Num e, FL b b, Countable b) => Matrix e cols (Either a b) -> Matrix e a b -> Matrix e cols b
717+select (Fork a b) y = y . a + b -- Divide-and-conquer law
718+select (Join (Fork a c) (Fork b d)) y = join (y . a + c) (y . b + d) -- Pattern matching + DnC law
719+select m y = join y id . m
698720
699−branch ::
721+branch ::
700722 ( Num e,
701− CountableDimensions a b,
702− CountableDimensions c (Either b c),
703− FromLists e c b,
704− FromLists e a b,
705− FromLists e a a,
706− FromLists e b b,
707− FromLists e c c,
708− FromLists e b a,
709− FromLists e b c,
710− FromLists e (Either b c) b,
711− FromLists e (Either b c) c
723+ CountableDims a b,
724+ CountableDims c (Either b c),
725+ FL c b,
726+ FL a b,
727+ FL a a,
728+ FL b b,
729+ FL c c,
730+ FL b a,
731+ FL b c,
732+ FL (Either b c) b,
733+ FL (Either b c) c
712734 )
713735 => Matrix e cols (Either a b) -> Matrix e a c -> Matrix e b c -> Matrix e cols c
714736branch x l r = f x `select` g l `select` r
715737 where
716− f :: (Num e, Countable a, CountableDimensions b c, FromLists e a b, FromLists e c b, FromLists e b b, FromLists e b a, FromLists e a a)
738+ f :: (Num e, Countable a, CountableDims b c, FL a b, FL c b, FL b b, FL b a, FL a a)
717739 => Matrix e cols (Either a b) -> Matrix e cols (Either a (Either b c))
718− f m = split (tr i1) (i1 . tr i2) . m
719− g :: (Num e, CountableDimensions b c, FromLists e b c, FromLists e c c) => Matrix e a c -> Matrix e a (Either b c)
740+ f m = fork (tr i1) (i1 . tr i2) . m
741+ g :: (Num e, CountableDims b c, FL b c, FL c c) => Matrix e a c -> Matrix e a (Either b c)
720742 g m = i2 . m
721743
722744-- McCarthy's Conditional
@@ -725,9 +747,9 @@ branch x l r = f x `select` g l `select` r
725747cond ::
726748 ( Trivial cols,
727749 Countable cols,
728− FromLists e () cols,
729− FromLists e cols (),
730− FromLists e cols cols,
750+ FL () cols,
751+ FL cols (),
752+ FL cols cols,
731753 Bounded a,
732754 Enum a,
733755 Num e,
@@ -735,14 +757,14 @@ cond ::
735757 )
736758 =>
737759 (a -> Bool) -> Matrix e cols rows -> Matrix e cols rows -> Matrix e cols rows
738−cond p f g = junc f g . grd p
760+cond p f g = join f g . grd p
739761
740−grd ::
762+grd ::
741763 ( Trivial q,
742764 Countable q,
743− FromLists e () q,
744− FromLists e q (),
745− FromLists e q q,
765+ FL () q,
766+ FL q (),
767+ FL q q,
746768 Bounded a,
747769 Enum a,
748770 Num e,
@@ -750,60 +772,86 @@ grd ::
750772 )
751773 =>
752774 (a -> Bool) -> Matrix e q (Either q q)
753−grd f = split (corr f) (corr (not . f))
775+grd f = fork (corr f) (corr (not . f))
754776
755−corr ::
756− forall e a q .
777+corr ::
778+ forall e a q .
757779 ( Trivial q,
758780 Countable q,
759− FromLists e () q,
760− FromLists e q (),
761− FromLists e q q,
781+ FL () q,
782+ FL q (),
783+ FL q q,
762784 Liftable e a Bool
763− )
785+ )
764786 => (a -> Bool) -> Matrix e q q
765−corr p = let f = fromF p :: Matrix e q ()
766− in khatri f (identity :: Matrix e q q)
787+corr p = let f = fromF' p :: Matrix e q ()
788+ in kr f (id :: Matrix e q q)
767789
768790-- Pretty print
769791
770792prettyAux :: Show e => [[e]] -> [[e]] -> String
771793prettyAux [] _ = ""
772−prettyAux [[e]] m = "│ " ++ fill (show e) ++ " │\n"
794+prettyAux [[e]] m = "│ " ++ fill (show e) ++ " │\n"
773795 where
774796 v = fmap show m
775797 widest = maximum $ fmap length v
776798 fill str = replicate (widest - length str - 2) ' ' ++ str
777−prettyAux [h] m = "│ " ++ fill (unwords $ map show h) ++ " │\n"
799+prettyAux [h] m = "│ " ++ fill (unwords $ map show h) ++ " │\n"
778800 where
779− v = fmap show m
780− widest = maximum $ fmap length v
801+ v = fmap show m
802+ widest = maximum $ fmap length v
781803 fill str = replicate (widest - length str - 2) ' ' ++ str
782−prettyAux (h : t) l = "│ " ++ fill (unwords $ map show h) ++ " │\n" ++
804+prettyAux (h : t) l = "│ " ++ fill (unwords $ map show h) ++ " │\n" ++
783805 prettyAux t l
784806 where
785− v = fmap show l
786− widest = maximum $ fmap length v
807+ v = fmap show l
808+ widest = maximum $ fmap length v
787809 fill str = replicate (widest - length str - 2) ' ' ++ str
788810
789811-- | Matrix pretty printer
790−pretty :: (Countable cols, Show e) => Matrix e cols rows -> String
791−pretty m = "┌ " ++ unwords (replicate (columns m) blank) ++ " ┐\n" ++
792− prettyAux (toLists m) (toLists m) ++
793− "└ " ++ unwords (replicate (columns m) blank) ++ " ┘"
794− where
795− v = fmap show (toList m)
796− widest = maximum $ fmap length v
812+pretty :: (CountableDims cols rows, Show e) => Matrix e cols rows -> String
813+pretty m = concat
814+ [ "┌ ", unwords (replicate (columns m) blank), " ┐\n"
815+ , unlines
816+ [ "│ " ++ unwords (fmap (\j -> fill $ show $ getElem i j m) [1..columns m]) ++ " │" | i <- [1..rows m] ]
817+ , "└ ", unwords (replicate (columns m) blank), " ┘"
818+ ]
819+ where
820+ strings = map show (toList m)
821+ widest = maximum $ map length strings
797822 fill str = replicate (widest - length str) ' ' ++ str
798− blank = fill ""
823+ blank = fill ""
824+ safeGet i j m
825+ | i > rows m || j > columns m || i < 1 || j < 1 = Nothing
826+ | otherwise = Just $ unsafeGet i j m (toList m)
827+ unsafeGet i j m l = l !! encode (columns m) (i,j)
828+ encode m (i,j) = (i-1)*m + j - 1
829+ getElem i j m =
830+ fromMaybe
831+ (error $
832+ "getElem: Trying to get the "
833+ ++ show (i, j)
834+ ++ " element from a "
835+ ++ show (rows m) ++ "x" ++ show (columns m)
836+ ++ " matrix."
837+ )
838+ (safeGet i j m)
799839
800840-- | Matrix pretty printer
801−prettyPrint :: (Countable cols, Show e) => Matrix e cols rows -> IO ()
841+prettyPrint :: (CountableDims cols rows, Show e) => Matrix e cols rows -> IO ()
802842prettyPrint = putStrLn . pretty
803843
844+-- | Zip two matrices with a given binary function
845+zipWithM :: (e -> f -> g) -> Matrix e cols rows -> Matrix f cols rows -> Matrix g cols rows
846+zipWithM f (One a) (One b) = One (f a b)
847+zipWithM f (Join a b) (Join c d) = Join (zipWithM f a c) (zipWithM f b d)
848+zipWithM f (Fork a b) (Fork c d) = Fork (zipWithM f a c) (zipWithM f b d)
849+zipWithM f x@(Fork _ _) y@(Join _ _) = zipWithM f x (abideJF y)
850+zipWithM f x@(Join _ _) y@(Fork _ _) = zipWithM f (abideJF x) y
851+
804852-- Relational operators functions
805853
806−type Boolean = Natural 0 1
854+type Boolean = Natural 0 1
807855type Relation a b = Matrix Boolean a b
808856
809857-- | Helper conversion function
@@ -819,54 +867,47 @@ fromBool False = nat 0
819867
820868-- | Relational negation
821869negateM :: Relation cols rows -> Relation cols rows
822−negateM Empty = Empty
823−negateM (One (Nat 0)) = One (Nat 1)
824−negateM (One (Nat 1)) = One (Nat 0)
825−negateM (Junc a b) = Junc (negateM a) (negateM b)
826−negateM (Split a b) = Split (negateM a) (negateM b)
870+negateM (One (Nat p)) = One (Nat (negate p))
871+negateM (Join a b) = Join (negateM a) (negateM b)
872+negateM (Fork a b) = Fork (negateM a) (negateM b)
827873
828874-- | Relational addition
829875orM :: Relation cols rows -> Relation cols rows -> Relation cols rows
830−orM Empty Empty = Empty
831−orM (One a) (One b) = One (fromBool (toBool a || toBool b))
832−orM (Junc a b) (Junc c d) = Junc (orM a c) (orM b d)
833−orM (Split a b) (Split c d) = Split (orM a c) (orM b d)
834−orM x@(Split _ _) y@(Junc _ _) = orM x (abideJS y)
835−orM x@(Junc _ _) y@(Split _ _) = orM (abideJS x) y
876+orM (One a) (One b) = One (fromBool (toBool a || toBool b))
877+orM (Join a b) (Join c d) = Join (orM a c) (orM b d)
878+orM (Fork a b) (Fork c d) = Fork (orM a c) (orM b d)
879+orM x@(Fork _ _) y@(Join _ _) = orM x (abideJF y)
880+orM x@(Join _ _) y@(Fork _ _) = orM (abideJF x) y
836881
837882-- | Relational multiplication
838883andM :: Relation cols rows -> Relation cols rows -> Relation cols rows
839−andM Empty Empty = Empty
840−andM (One a) (One b) = One (fromBool (toBool a && toBool b))
841−andM (Junc a b) (Junc c d) = Junc (andM a c) (andM b d)
842−andM (Split a b) (Split c d) = Split (andM a c) (andM b d)
843−andM x@(Split _ _) y@(Junc _ _) = andM x (abideJS y)
844−andM x@(Junc _ _) y@(Split _ _) = andM (abideJS x) y
884+andM (One a) (One b) = One (fromBool (toBool a && toBool b))
885+andM (Join a b) (Join c d) = Join (andM a c) (andM b d)
886+andM (Fork a b) (Fork c d) = Fork (andM a c) (andM b d)
887+andM x@(Fork _ _) y@(Join _ _) = andM x (abideJF y)
888+andM x@(Join _ _) y@(Fork _ _) = andM (abideJF x) y
845889
846890-- | Relational subtraction
847891subM :: Relation cols rows -> Relation cols rows -> Relation cols rows
848−subM Empty Empty = Empty
849−subM (One a) (One b) = if a - b < nat 0 then One (nat 0) else One (a - b)
850−subM (Junc a b) (Junc c d) = Junc (subM a c) (subM b d)
851−subM (Split a b) (Split c d) = Split (subM a c) (subM b d)
852−subM x@(Split _ _) y@(Junc _ _) = subM x (abideJS y)
853−subM x@(Junc _ _) y@(Split _ _) = subM (abideJS x) y
892+subM (One a) (One b) = if a - b < nat 0 then One (nat 0) else One (a - b)
893+subM (Join a b) (Join c d) = Join (subM a c) (subM b d)
894+subM (Fork a b) (Fork c d) = Fork (subM a c) (subM b d)
895+subM x@(Fork _ _) y@(Join _ _) = subM x (abideJF y)
896+subM x@(Join _ _) y@(Fork _ _) = subM (abideJF x) y
854897
855898-- | Matrix relational composition.
856899compRel :: Relation cr rows -> Relation cols cr -> Relation cols rows
857−compRel Empty Empty = Empty
858−compRel (One a) (One b) = One (fromBool (toBool a && toBool b))
859−compRel (Junc a b) (Split c d) = orM (compRel a c) (compRel b d) -- Divide-and-conquer law
860−compRel (Split a b) c = Split (compRel a c) (compRel b c) -- Split fusion law
861−compRel c (Junc a b) = Junc (compRel c a) (compRel c b) -- Junc fusion law
900+compRel (One a) (One b) = One (fromBool (toBool a && toBool b))
901+compRel (Join a b) (Fork c d) = orM (compRel a c) (compRel b d) -- Divide-and-conquer law
902+compRel (Fork a b) c = Fork (compRel a c) (compRel b c) -- Fork fusion law
903+compRel c (Join a b) = Join (compRel c a) (compRel c b) -- Join fusion law
862904
863905-- | Matrix relational right division
864906divR :: Relation b c -> Relation b a -> Relation a c
865−divR Empty Empty = Empty
866907divR (One a) (One b) = One (fromBool (not (toBool b) || toBool a)) -- b implies a
867−divR (Junc a b) (Junc c d) = andM (divR a c) (divR b d)
868−divR (Split a b) c = Split (divR a c) (divR b c)
869−divR c (Split a b) = Junc (divR c a) (divR c b)
908+divR (Join a b) (Join c d) = andM (divR a c) (divR b d)
909+divR (Fork a b) c = Fork (divR a c) (divR b c)
910+divR c (Fork a b) = Join (divR c a) (divR c b)
870911
871912-- | Matrix relational left division
872913divL :: Relation c b -> Relation a b -> Relation a c
@@ -882,86 +923,52 @@ divS s r = divL r s `intersection` divR (tr r) (tr s)
882923--
883924-- NOTE: Be careful to not ask for a relation bigger than the cardinality of
884925-- types @a@ or @b@ allows.
885−fromFRel ::
926+fromFRel' ::
886927 forall a b cols rows.
887928 ( Liftable Boolean a b,
888− CountableDimensions cols rows,
889− FromLists Boolean rows cols
929+ CountableDims cols rows,
930+ FL rows cols
890931 ) =>
891932 (a -> b) ->
892933 Relation cols rows
893−fromFRel f =
894− let minA = minBound @a
895− maxA = maxBound @a
896− minB = minBound @b
897− maxB = maxBound @b
898− ccols = fromInteger $ natVal (Proxy :: Proxy (Count cols))
899− rrows = fromInteger $ natVal (Proxy :: Proxy (Count rows))
900− elementsA = take ccols [minA .. maxA]
901− elementsB = take rrows [minB .. maxB]
902− combinations = (,) <$> elementsA <*> elementsB
903− combAp = map snd . sort . map (\(a, b) -> if f a == b
904− then ((fromEnum a, fromEnum b), nat 1)
905− else ((fromEnum a, fromEnum b), nat 0)) $ combinations
906− mList = buildList combAp rrows
907− in tr $ fromLists mList
908− where
909− buildList [] _ = []
910− buildList l r = take r l : buildList (drop r l) r
934+fromFRel' = fromF'
911935
912936-- | Lifts functions to relations with dimensions matching @a@ and @b@
913937-- cardinality's.
914−fromFRel' ::
938+fromFRel ::
915939 forall a b.
916940 ( Liftable Boolean a b,
917− CountableDimensionsN a b,
918− FromLists Boolean (Normalize b) (Normalize a)
941+ CountableDimsN a b,
942+ FLN b a
919943 ) =>
920944 (a -> b) ->
921945 Relation (Normalize a) (Normalize b)
922−fromFRel' f =
923− let minA = minBound @a
924− maxA = maxBound @a
925− minB = minBound @b
926− maxB = maxBound @b
927− ccols = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize a)))
928− rrows = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize b)))
929− elementsA = take ccols [minA .. maxA]
930− elementsB = take rrows [minB .. maxB]
931− combinations = (,) <$> elementsA <*> elementsB
932− combAp = map snd . sort . map (\(a, b) -> if f a == b
933− then ((fromEnum a, fromEnum b), nat 1)
934− else ((fromEnum a, fromEnum b), nat 0)) $ combinations
935− mList = buildList combAp rrows
936− in tr $ fromLists mList
937− where
938− buildList [] _ = []
939− buildList l r = take r l : buildList (drop r l) r
946+fromFRel = fromFRel'
940947
941948-- | Lifts a relation function to a Boolean Matrix
942−toRel ::
949+toRel ::
943950 forall a b.
944951 ( Bounded a,
945952 Bounded b,
946953 Enum a,
947954 Enum b,
948955 Eq b,
949− CountableDimensionsN a b,
950− FromListsN Boolean b a
951− )
956+ CountableDims a b,
957+ FLN b a
958+ )
952959 => (a -> b -> Bool) -> Relation (Normalize a) (Normalize b)
953960toRel f =
954961 let minA = minBound @a
955962 maxA = maxBound @a
956963 minB = minBound @b
957964 maxB = maxBound @b
958− ccols = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize a)))
959− rrows = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize b)))
965+ ccols = fromInteger $ natVal (Proxy :: Proxy (Count a))
966+ rrows = fromInteger $ natVal (Proxy :: Proxy (Count b))
960967 elementsA = take ccols [minA .. maxA]
961968 elementsB = take rrows [minB .. maxB]
962969 combinations = (,) <$> elementsA <*> elementsB
963− combAp = map snd . sort . map (\(a, b) -> if uncurry f (a, b)
964− then ((fromEnum a, fromEnum b), nat 1)
970+ combAp = map snd . sort . map (\(a, b) -> if uncurry f (a, b)
971+ then ((fromEnum a, fromEnum b), nat 1)
965972 else ((fromEnum a, fromEnum b), nat 0)) $ combinations
966973 mList = buildList combAp rrows
967974 in tr $ fromLists mList
src/LAoP/Matrix/Nat.hs+139−124
@@ -56,21 +56,20 @@ module LAoP.Matrix.Nat
5656
5757 -- * Constraint type synonyms
5858 Countable,
59− CountableDimensions,
59+ CountableDims,
6060 CountableN,
6161 CountableNz,
62− CountableDimensionsN,
63− FromListsN,
64− FromListsNz,
62+ CountableDimsN,
63+ FLN,
64+ FLNz,
6565 Liftable,
6666 TrivialE,
6767 TrivialP,
6868
6969 -- * Primitives
70− empty,
7170 one,
72− junc,
73− split,
71+ join,
72+ fork,
7473
7574 -- * Auxiliary type families
7675 I.FromNat,
@@ -78,11 +77,11 @@ module LAoP.Matrix.Nat
7877 I.Normalize,
7978
8079 -- * Matrix construction and conversion
81− I.FromLists,
80+ I.FL,
8281 fromLists,
8382 toLists,
8483 toList,
85− matrixBuilder,
84+ matrixBuilder',
8685 row,
8786 col,
8887 zeros,
@@ -98,6 +97,10 @@ module LAoP.Matrix.Nat
9897 -- ** Matrix Transposition
9998 tr,
10099
100+ -- ** Scalar multiplication/division of matrices
101+ (.|),
102+ (./),
103+
101104 -- ** Selective operator
102105 select,
103106
@@ -105,16 +108,19 @@ module LAoP.Matrix.Nat
105108 cond,
106109
107110 -- ** Matrix "abiding"
108− abideJS,
109− abideSJ,
111+ abideJF,
112+ abideFJ,
113+
114+ -- ** Zip Matrices
115+ zipWithM,
110116
111117 -- * Biproduct approach
112− -- ** Split
118+ -- ** Fork
113119 (===),
114120 -- *** Projections
115121 p1,
116122 p2,
117− -- ** Junc
123+ -- ** Join
118124 (|||),
119125 -- *** Injections
120126 i1,
@@ -128,11 +134,11 @@ module LAoP.Matrix.Nat
128134 -- | Note that given the restrictions imposed it is not possible to
129135 -- implement the standard type classes present in standard Haskell.
130136 -- *** Matrix pairing projections
131− kp1,
132− kp2,
137+ fstM,
138+ sndM,
133139
134140 -- *** Matrix pairing
135− khatri,
141+ kr,
136142
137143 -- * Matrix composition and lifting
138144
@@ -140,10 +146,10 @@ module LAoP.Matrix.Nat
140146
141147 -- | Note that given the restrictions imposed it is not possible to
142148 -- implement the standard type classes present in standard Haskell.
143− identity,
149+ iden,
144150 comp,
145− fromF,
146151 fromF',
152+ fromF,
147153
148154 -- * Matrix printing
149155 pretty,
@@ -154,47 +160,34 @@ where
154160import Data.Proxy
155161import GHC.TypeLits
156162import Control.DeepSeq
157−import qualified Control.Category as C
158163import qualified LAoP.Matrix.Internal as I
159164
160165newtype Matrix e (cols :: Nat) (rows :: Nat) = M (I.Matrix e (I.FromNat cols) (I.FromNat rows))
161166 deriving (Show, Num, Eq, Ord, NFData) via (I.Matrix e (I.FromNat cols) (I.FromNat rows))
162167
163168-- | Constraint type synonyms to keep the type signatures less convoluted
164−type Countable a = KnownNat (I.Count a)
165−type CountableDimensions a b = (Countable a, Countable b)
166−type CountableN a = KnownNat (I.Count (I.FromNat a))
167−type CountableNz a = KnownNat (I.Count (I.Normalize a))
168−type CountableDimensionsN a b = (CountableN a, CountableN b)
169−type FromListsN e a b = I.FromLists e (I.FromNat a) (I.FromNat b)
170−type FromListsNz e a b = I.FromLists e (I.Normalize a) (I.Normalize b)
171−type Liftable e a b = (Bounded a, Bounded b, Enum a, Enum b, Eq b, Num e, Ord e)
172−type TrivialE a b = I.FromNat (a + b) ~ Either (I.FromNat a) (I.FromNat b)
173−type TrivialP a b = I.FromNat (a * b) ~ I.FromNat (I.Count (I.FromNat a) * I.Count (I.FromNat b))
174−
175−-- | It isn't possible to implement the 'id' function so it's
176−-- implementation is 'undefined'. However 'comp' can be and this partial
177−-- class implementation exists just to make the code more readable.
178−--
179−-- Please use 'identity' instead.
180−instance (Num e) => C.Category (Matrix e) where
181− id = undefined
182− (.) = comp
169+type Countable a = KnownNat (I.Count a)
170+type CountableDims a b = (Countable a, Countable b)
171+type CountableN a = KnownNat (I.Count (I.FromNat a))
172+type CountableNz a = KnownNat (I.Count (I.Normalize a))
173+type CountableDimsN a b = (CountableN a, CountableN b)
174+type FLN e a b = I.FL (I.FromNat a) (I.FromNat b)
175+type FLNz e a b = I.FL (I.Normalize a) (I.Normalize b)
176+type Liftable e a b = (Bounded a, Bounded b, Enum a, Enum b, Eq b, Num e, Ord e)
177+type TrivialE a b = I.FromNat (a + b) ~ Either (I.FromNat a) (I.FromNat b)
178+type TrivialP a b = I.FromNat (a * b) ~ I.FromNat (I.Count (I.FromNat a) * I.Count (I.FromNat b))
183179
184180-- Primitives
185181
186−empty :: Matrix e 0 0
187−empty = M I.Empty
188−
189182one :: e -> Matrix e 1 1
190183one = M . I.One
191184
192−junc ::
185+join ::
193186 (TrivialE a b) =>
194187 Matrix e a rows ->
195188 Matrix e b rows ->
196189 Matrix e (a + b) rows
197−junc (M a) (M b) = M (I.Junc a b)
190+join (M a) (M b) = M (I.Join a b)
198191
199192infixl 3 |||
200193(|||) ::
@@ -202,14 +195,14 @@ infixl 3 |||
202195 Matrix e a rows ->
203196 Matrix e b rows ->
204197 Matrix e (a + b) rows
205−(|||) = junc
198+(|||) = join
206199
207−split ::
200+fork ::
208201 (TrivialE a b) =>
209202 Matrix e cols a ->
210203 Matrix e cols b ->
211204 Matrix e cols (a + b)
212−split (M a) (M b) = M (I.Split a b)
205+fork (M a) (M b) = M (I.Fork a b)
213206
214207infixl 2 ===
215208(===) ::
@@ -217,43 +210,45 @@ infixl 2 ===
217210 Matrix e cols a ->
218211 Matrix e cols b ->
219212 Matrix e cols (a + b)
220−(===) = split
213+(===) = fork
221214
222215-- Construction
223216
224−fromLists :: (FromListsN e cols rows) => [[e]] -> Matrix e cols rows
217+fromLists :: (FLN e cols rows) => [[e]] -> Matrix e cols rows
225218fromLists = M . I.fromLists
226219
227−matrixBuilder ::
228− (FromListsN e cols rows, CountableN cols, CountableN rows)
220+-- | Matrix builder function. Constructs a matrix provided with
221+-- a construction function that operates with indices.
222+matrixBuilder' ::
223+ (FLN e cols rows, CountableN cols, CountableN rows)
229224 => ((Int, Int) -> e) -> Matrix e cols rows
230−matrixBuilder = M . I.matrixBuilder
225+matrixBuilder' = M . I.matrixBuilder'
231226
232−col :: (I.FromLists e () (I.FromNat rows)) => [e] -> Matrix e 1 rows
227+col :: (I.FL () (I.FromNat rows)) => [e] -> Matrix e 1 rows
233228col = M . I.col
234229
235−row :: (I.FromLists e (I.FromNat cols) ()) => [e] -> Matrix e cols 1
230+row :: (I.FL (I.FromNat cols) ()) => [e] -> Matrix e cols 1
236231row = M . I.row
237232
238−fromF ::
233+fromF' ::
239234 ( Liftable e a b,
240235 CountableN cols,
241236 CountableN rows,
242− FromListsN e rows cols
237+ FLN e rows cols
243238 ) =>
244239 (a -> b) ->
245240 Matrix e cols rows
246−fromF = M . I.fromF
241+fromF' = M . I.fromF'
247242
248−fromF' ::
243+fromF ::
249244 ( Liftable e a b,
250245 CountableNz a,
251246 CountableNz b,
252− FromListsNz e b a
247+ FLNz e b a
253248 ) =>
254249 (a -> b) ->
255250 Matrix e (I.Count a) (I.Count b)
256−fromF' = undefined -- M . I.fromF'
251+fromF = undefined -- M . I.fromF
257252
258253-- Conversion
259254
@@ -266,21 +261,21 @@ toList (M m) = I.toList m
266261-- Zeros Matrix
267262
268263zeros ::
269− (Num e, FromListsN e cols rows, CountableN cols, CountableN rows) =>
264+ (Num e, FLN e cols rows, CountableN cols, CountableN rows) =>
270265 Matrix e cols rows
271266zeros = M I.zeros
272267
273268-- Ones Matrix
274269
275270ones ::
276− (Num e, FromListsN e cols rows, CountableN cols, CountableN rows) =>
271+ (Num e, FLN e cols rows, CountableN cols, CountableN rows) =>
277272 Matrix e cols rows
278273ones = M I.ones
279274
280275-- Const Matrix
281276
282277constant ::
283− (Num e, FromListsN e cols rows, CountableN cols, CountableN rows) =>
278+ (Num e, FLN e cols rows, CountableN cols, CountableN rows) =>
284279 e ->
285280 Matrix e cols rows
286281constant = M . I.constant
@@ -289,27 +284,41 @@ constant = M . I.constant
289284
290285bang ::
291286 forall e cols.
292− (Num e, Enum e, I.FromLists e (I.FromNat cols) (), CountableN cols) =>
287+ (Num e, Enum e, I.FL (I.FromNat cols) (), CountableN cols) =>
293288 Matrix e cols 1
294289bang = M I.bang
295290
296−-- Identity Matrix
291+-- iden Matrix
297292
298−identity ::
299− (Num e, FromListsN e cols cols, CountableN cols) =>
293+iden ::
294+ (Num e, FLN e cols cols, CountableN cols) =>
300295 Matrix e cols cols
301−identity = M I.identity
296+iden = M I.iden
302297
303298-- Matrix composition (MMM)
304299
305300comp :: (Num e) => Matrix e cr rows -> Matrix e cols cr -> Matrix e cols rows
306301comp (M a) (M b) = M (I.comp a b)
307302
303+-- Scalar multiplication of matrices
304+
305+infixl 7 .|
306+-- | Scalar multiplication of matrices.
307+(.|) :: Num e => e -> Matrix e cols rows -> Matrix e cols rows
308+(.|) e (M m) = M (e I..| m)
309+
310+-- Scalar division of matrices
311+
312+infixl 7 ./
313+-- | Scalar multiplication of matrices.
314+(./) :: Fractional e => Matrix e cols rows -> e -> Matrix e cols rows
315+(./) (M m) e = M (m I../ e)
316+
308317p1 ::
309318 ( Num e,
310− CountableDimensionsN n m,
311− FromListsN e n m,
312− FromListsN e m m,
319+ CountableDimsN n m,
320+ FLN e n m,
321+ FLN e m m,
313322 TrivialE m n
314323 ) =>
315324 Matrix e (m + n) m
@@ -317,9 +326,9 @@ p1 = M I.p1
317326
318327p2 ::
319328 ( Num e,
320− CountableDimensionsN n m,
321− FromListsN e m n,
322− FromListsN e n n,
329+ CountableDimsN n m,
330+ FLN e m n,
331+ FLN e n n,
323332 TrivialE m n
324333 ) =>
325334 Matrix e (m + n) n
@@ -329,9 +338,9 @@ p2 = M I.p2
329338
330339i1 ::
331340 ( Num e,
332− CountableDimensionsN n rows,
333− FromListsN e n rows,
334− FromListsN e rows rows,
341+ CountableDimsN n rows,
342+ FLN e n rows,
343+ FLN e rows rows,
335344 TrivialE rows n
336345 ) =>
337346 Matrix e rows (rows + n)
@@ -339,9 +348,9 @@ i1 = tr p1
339348
340349i2 ::
341350 ( Num e,
342− CountableDimensionsN rows m,
343− FromListsN e m rows,
344− FromListsN e rows rows,
351+ CountableDimsN rows m,
352+ FLN e m rows,
353+ FLN e rows rows,
345354 TrivialE m rows
346355 ) =>
347356 Matrix e rows (m + rows)
@@ -355,16 +364,16 @@ rows (M m) = I.rows m
355364columns :: (CountableN cols) => Matrix e cols rows -> Int
356365columns (M m) = I.columns m
357366
358−-- | Coproduct Bifunctor
359367infixl 5 -|-
360368
369+-- | Coproduct Bifunctor (Direct sum)
361370(-|-) ::
362371 ( Num e,
363− CountableDimensionsN j k,
364− FromListsN e k k,
365− FromListsN e j k,
366− FromListsN e k j,
367− FromListsN e j j,
372+ CountableDimsN j k,
373+ FLN e k k,
374+ FLN e j k,
375+ FLN e k j,
376+ FLN e j j,
368377 TrivialE n m,
369378 TrivialE k j
370379 ) =>
@@ -373,40 +382,42 @@ infixl 5 -|-
373382 Matrix e (n + m) (k + j)
374383(-|-) (M a) (M b) = M ((I.-|-) a b)
375384
376−-- | Khatri Rao Product and projections
377−kp1 ::
385+-- | Khatri Rao Product first projection
386+fstM ::
378387 forall e m k .
379388 ( Num e,
380− CountableDimensionsN m k,
389+ CountableDimsN m k,
381390 CountableN (m * k),
382− FromListsN e (m * k) m,
391+ FLN e (m * k) m,
383392 TrivialP m k
384393 ) => Matrix e (m * k) m
385−kp1 = M (I.kp1 @e @(I.FromNat m) @(I.FromNat k))
394+fstM = M (I.fstM @e @(I.FromNat m) @(I.FromNat k))
386395
387−kp2 ::
396+-- | Khatri Rao Product second projection
397+sndM ::
388398 forall e m k.
389399 ( Num e,
390− CountableDimensionsN k m,
391− FromListsN e (m * k) k,
400+ CountableDimsN k m,
401+ FLN e (m * k) k,
392402 CountableN (m * k),
393403 TrivialP m k
394404 ) => Matrix e (m * k) k
395−kp2 = M (I.kp2 @e @(I.FromNat m) @(I.FromNat k))
405+sndM = M (I.sndM @e @(I.FromNat m) @(I.FromNat k))
396406
397−khatri ::
407+-- | Khatri Rao Product
408+kr ::
398409 forall e cols a b.
399410 ( Num e,
400− CountableDimensionsN a b,
411+ CountableDimsN a b,
401412 CountableN (a * b),
402− FromListsN e (a * b) a,
403− FromListsN e (a * b) b,
413+ FLN e (a * b) a,
414+ FLN e (a * b) b,
404415 TrivialP a b
405416 ) => Matrix e cols a -> Matrix e cols b -> Matrix e cols (a * b)
406−khatri a b =
407− let kp1' = kp1 @e @a @b
408− kp2' = kp2 @e @a @b
409− in comp (tr kp1') a * comp (tr kp2') b
417+kr a b =
418+ let fstM' = fstM @e @a @b
419+ sndM' = sndM @e @a @b
420+ in comp (tr fstM') a * comp (tr sndM') b
410421
411422-- | Product Bifunctor (Kronecker)
412423infixl 4 ><
@@ -414,28 +425,28 @@ infixl 4 ><
414425(><) ::
415426 forall e m p n q.
416427 ( Num e,
417− CountableDimensionsN m n,
418− CountableDimensionsN p q,
419− CountableDimensionsN (m * n) (p * q),
420− FromListsN e (m * n) m,
421− FromListsN e (m * n) n,
422− FromListsN e (p * q) p,
423− FromListsN e (p * q) q,
428+ CountableDimsN m n,
429+ CountableDimsN p q,
430+ CountableDimsN (m * n) (p * q),
431+ FLN e (m * n) m,
432+ FLN e (m * n) n,
433+ FLN e (p * q) p,
434+ FLN e (p * q) q,
424435 TrivialP m n,
425436 TrivialP p q
426437 ) => Matrix e m p -> Matrix e n q -> Matrix e (m * n) (p * q)
427438(><) a b =
428− let kp1' = kp1 @e @m @n
429− kp2' = kp2 @e @m @n
430− in khatri (comp a kp1') (comp b kp2')
439+ let fstM' = fstM @e @m @n
440+ sndM' = sndM @e @m @n
441+ in kr (comp a fstM') (comp b sndM')
431442
432−-- | Matrix abide Junc Split
433−abideJS :: Matrix e cols rows -> Matrix e cols rows
434−abideJS (M m) = M (I.abideJS m)
443+-- | Matrix abide Join Fork
444+abideJF :: Matrix e cols rows -> Matrix e cols rows
445+abideJF (M m) = M (I.abideJF m)
435446
436−-- | Matrix abide Split Junc
437−abideSJ :: Matrix e cols rows -> Matrix e cols rows
438−abideSJ (M m) = M (I.abideSJ m)
447+-- | Matrix abide Fork Join
448+abideFJ :: Matrix e cols rows -> Matrix e cols rows
449+abideFJ (M m) = M (I.abideFJ m)
439450
440451-- | Matrix transposition
441452tr :: Matrix e cols rows -> Matrix e rows cols
@@ -444,7 +455,7 @@ tr (M m) = M (I.tr m)
444455-- Selective 'select' operator
445456select ::
446457 ( Num e,
447− FromListsN e rows1 rows1,
458+ FLN e rows1 rows1,
448459 CountableN rows1,
449460 I.FromNat rows2 ~ I.FromNat rows1,
450461 I.FromNat cols1 ~ I.FromNat cols2,
@@ -457,9 +468,9 @@ select (M m) (M y) = M (I.select m y)
457468cond ::
458469 ( I.FromNat (I.Count (I.FromNat cols)) ~ I.FromNat cols,
459470 CountableN cols,
460− I.FromLists e () (I.FromNat cols),
461− I.FromLists e (I.FromNat cols) (),
462− FromListsN e cols cols,
471+ I.FL () (I.FromNat cols),
472+ I.FL (I.FromNat cols) (),
473+ FLN e cols cols,
463474 Liftable e a Bool
464475 )
465476 =>
@@ -468,8 +479,12 @@ cond p (M a) (M b) = M (I.cond p a b)
468479
469480-- Pretty print
470481
471−pretty :: (CountableN cols, Show e) => Matrix e cols rows -> String
482+pretty :: (CountableDimsN cols rows, Show e) => Matrix e cols rows -> String
472483pretty (M m) = I.pretty m
473484
474−prettyPrint :: (CountableN cols, Show e) => Matrix e cols rows -> IO ()
485+prettyPrint :: (CountableDimsN cols rows, Show e) => Matrix e cols rows -> IO ()
475486prettyPrint (M m) = I.prettyPrint m
487+
488+-- | Zip two matrices with a given binary function
489+zipWithM :: (e -> f -> g) -> Matrix e cols rows -> Matrix f cols rows -> Matrix g cols rows
490+zipWithM f (M a) (M b) = M (I.zipWithM f a b)
src/LAoP/Matrix/Type.hs+233−171
@@ -1,11 +1,11 @@
11{-# LANGUAGE ConstraintKinds #-}
2+{-# LANGUAGE TypeFamilies #-}
23{-# LANGUAGE AllowAmbiguousTypes #-}
34{-# LANGUAGE DataKinds #-}
45{-# LANGUAGE DerivingVia #-}
56{-# LANGUAGE FlexibleContexts #-}
67{-# LANGUAGE FlexibleInstances #-}
78{-# LANGUAGE GADTs #-}
8−{-# LANGUAGE KindSignatures #-}
99{-# LANGUAGE MultiParamTypeClasses #-}
1010{-# LANGUAGE NoStarIsType #-}
1111{-# LANGUAGE RankNTypes #-}
@@ -58,10 +58,10 @@ module LAoP.Matrix.Type
5858
5959 -- * Constraint type aliases
6060 Countable,
61− CountableDimensions,
61+ CountableDims,
6262 CountableN,
63− CountableDimensionsN,
64− FromListsN,
63+ CountableDimsN,
64+ FLN,
6565 Liftable,
6666 Trivial,
6767 TrivialP,
@@ -71,10 +71,9 @@ module LAoP.Matrix.Type
7171 One,
7272
7373 -- * Primitives
74− empty,
7574 one,
76− junc,
77− split,
75+ join,
76+ fork,
7877
7978 -- * Auxiliary type families
8079 I.FromNat,
@@ -86,6 +85,7 @@ module LAoP.Matrix.Type
8685 fromLists,
8786 toLists,
8887 toList,
88+ matrixBuilder',
8989 matrixBuilder,
9090 row,
9191 col,
@@ -97,14 +97,15 @@ module LAoP.Matrix.Type
9797
9898 -- * Functor instance equivalent function
9999 fmapM,
100+ bimapM,
100101
101102 -- * Applicative/Monoidal instance equivalent functions
102103 unitM,
103104 multM,
104105
105106 -- * Selective equivalent instance function
106− selectM,
107−
107+ selectM,
108+
108109 -- * Monad equivalent instance function
109110 returnM,
110111 bindM,
@@ -112,25 +113,34 @@ module LAoP.Matrix.Type
112113 -- * Misc
113114 -- ** Get dimensions
114115 columns,
116+ columns',
115117 rows,
118+ rows',
116119
117120 -- ** Matrix Transposition
118121 tr,
119122
123+ -- ** Scalar multiplication/division of matrices
124+ (.|),
125+ (./),
126+
120127 -- ** McCarthy's Conditional
121128 cond,
122129
123130 -- ** Matrix "abiding"
124− abideJS,
125− abideSJ,
131+ abideJF,
132+ abideFJ,
133+
134+ -- ** Zip Matrices
135+ zipWithM,
126136
127137 -- * Biproduct approach
128− -- ** Split
138+ -- ** Fork
129139 (===),
130140 -- *** Projections
131141 p1,
132142 p2,
133− -- ** Junc
143+ -- ** Join
134144 (|||),
135145 -- *** Injections
136146 i1,
@@ -144,11 +154,11 @@ module LAoP.Matrix.Type
144154 -- | Note that given the restrictions imposed it is not possible to
145155 -- implement the standard type classes present in standard Haskell.
146156 -- *** Matrix pairing projections
147− kp1,
148− kp2,
157+ fstM,
158+ sndM,
149159
150160 -- *** Matrix pairing
151− khatri,
161+ kr,
152162
153163 -- * Matrix composition and lifting
154164
@@ -156,10 +166,10 @@ module LAoP.Matrix.Type
156166
157167 -- | Note that given the restrictions imposed it is not possible to
158168 -- implement the standard type classes present in standard Haskell.
159− identity,
169+ iden,
160170 comp,
161− fromF,
162171 fromF',
172+ fromF,
163173
164174 -- * Relation
165175 toRel,
@@ -173,35 +183,44 @@ where
173183import Data.Void
174184import Data.Proxy
175185import Data.Kind
176−import GHC.TypeLits
186+import GHC.TypeLits
177187import Control.DeepSeq
178188import LAoP.Utils
179−import qualified Control.Category as C
180189import qualified LAoP.Matrix.Internal as I
190+import Prelude hiding (id, (.))
181191
182192newtype Matrix e (cols :: Type) (rows :: Type) = M (I.Matrix e (I.Normalize cols) (I.Normalize rows))
183193 deriving (Show, Num, Eq, Ord, NFData) via (I.Matrix e (I.Normalize cols) (I.Normalize rows))
184194
185195-- | Constraint type synonyms to keep the type signatures less convoluted
186−type Countable a = KnownNat (I.Count a)
187−type CountableDimensions a b = (Countable a, Countable b)
188−type CountableN a = KnownNat (I.Count (I.Normalize a))
189−type CountableDimensionsN a b = (CountableN a, CountableN b)
190−type FromListsN e a b = I.FromLists e (I.Normalize a) (I.Normalize b)
191−type Liftable e a b = (Bounded a, Bounded b, Enum a, Enum b, Eq b, Num e, Ord e)
192−type Trivial a = I.Normalize (I.Normalize a) ~ I.Normalize (I.Normalize (I.Normalize a))
193−type Trivial2 a = I.Normalize a ~ I.Normalize (I.Normalize a)
194−type Trivial3 a = I.FromNat (I.Count (I.Normalize (I.Normalize a))) ~ I.Normalize (I.Normalize a)
195−type TrivialP a b = I.Normalize (a, b) ~ I.Normalize (I.Normalize a, I.Normalize b)
196−
197−-- | It isn't possible to implement the 'id' function so it's
198−-- implementation is 'undefined'. However 'comp' can be and this partial
199−-- class implementation exists just to make the code more readable.
200−--
201−-- Please use 'identity' instead.
202−instance (Num e) => C.Category (Matrix e) where
203− id = undefined
204− (.) = comp
196+type Countable a = KnownNat (I.Count a)
197+type CountableDims a b = (Countable a, Countable b)
198+type CountableN a = KnownNat (I.Count (I.Normalize a))
199+type CountableDimsN a b = (CountableN a, CountableN b)
200+type FLN a b = I.FromLists (I.Normalize a) (I.Normalize b)
201+type Liftable e a b = (Bounded a, Bounded b, Enum a, Enum b, Eq b, Num e, Ord e)
202+type Trivial a = I.Normalize (I.Normalize a) ~ I.Normalize (I.Normalize (I.Normalize a))
203+type Trivial2 a = I.Normalize a ~ I.Normalize (I.Normalize a)
204+type Trivial3 a = I.FromNat (I.Count (I.Normalize (I.Normalize a))) ~ I.Normalize (I.Normalize a)
205+type TrivialP a b = I.Normalize (a, b) ~ I.Normalize (I.Normalize a, I.Normalize b)
206+
207+-- | It is possible to implement a constrained version of the category type
208+-- class.
209+instance (Num e) => Category (Matrix e) where
210+ type Object (Matrix e) a = (FLN a a, CountableN a)
211+ id = iden
212+ (.) = comp
213+
214+-- | Bifunctor equivalent function
215+bimapM ::
216+ ( Liftable e a b,
217+ Liftable e c d,
218+ CountableDimsN a c,
219+ CountableDimsN b d,
220+ FLN d c,
221+ FLN b a
222+ ) => (a -> b) -> (c -> d) -> Matrix e a c -> Matrix e b d
223+bimapM f g m = fromF g . m . tr (fromF f)
205224
206225-- | Zero type alias
207226type Zero = Void
@@ -211,78 +230,74 @@ type One = ()
211230
212231-- Primitives
213232
214−-- | Empty matrix constructor
215−empty :: Matrix e Zero Zero
216−empty = M I.Empty
217−
218233-- | Unit matrix constructor
219234one :: e -> Matrix e One One
220235one = M . I.One
221236
222−-- | Matrix 'Junc' constructor
223−junc ::
237+-- | Matrix 'Join' constructor
238+join ::
224239 Matrix e a rows ->
225240 Matrix e b rows ->
226241 Matrix e (Either a b) rows
227−junc (M a) (M b) = M (I.Junc a b)
242+join (M a) (M b) = M (I.Join a b)
228243
229244infixl 3 |||
230−-- | Matrix 'Junc' constructor
245+-- | Matrix 'Join' constructor
231246(|||) ::
232247 Matrix e a rows ->
233248 Matrix e b rows ->
234249 Matrix e (Either a b) rows
235−(|||) = junc
250+(|||) = join
236251
237−-- | Matrix 'Split' constructor
238−split ::
252+-- | Matrix 'Fork' constructor
253+fork ::
239254 Matrix e cols a ->
240255 Matrix e cols b ->
241256 Matrix e cols (Either a b)
242−split (M a) (M b) = M (I.Split a b)
257+fork (M a) (M b) = M (I.Fork a b)
243258
244259infixl 2 ===
245−-- | Matrix 'Split' constructor
260+-- | Matrix 'Fork' constructor
246261(===) ::
247262 Matrix e cols a ->
248263 Matrix e cols b ->
249264 Matrix e cols (Either a b)
250−(===) = split
265+(===) = fork
251266
252267-- Functor hierarchy
253268
254269-- | Functor instance equivalent function
255−fmapM ::
270+fmapM ::
256271 ( Liftable e a b,
257− CountableDimensionsN a b,
258− FromListsN e b a
272+ CountableDimsN a b,
273+ FLN b a
259274 )
260275 =>
261276 (a -> b) -> Matrix e c a -> Matrix e c b
262−fmapM f m = fromF' f `comp` m
277+fmapM f m = fromF f . m
263278
264279-- | Applicative instance equivalent 'unit' function,
265280unitM :: (Num e) => Matrix e () ()
266281unitM = one 1
267282
268283-- | Applicative instance equivalent 'unit' function,
269−multM ::
270− ( CountableDimensionsN a b,
284+multM ::
285+ ( CountableDimsN a b,
271286 CountableN (a, b),
272287 Num e,
273− FromListsN e (a, b) a,
274− FromListsN e (a, b) b,
288+ FLN (a, b) a,
289+ FLN (a, b) b,
275290 TrivialP a b
276291 ) => Matrix e c a -> Matrix e c b -> Matrix e c (a, b)
277−multM = khatri
292+multM = kr
278293
279294-- | Monad instance equivalent 'return' function,
280−returnM ::
281− forall e a .
295+returnM ::
296+ forall e a .
282297 ( Num e,
283298 Enum e,
284299 Enum a,
285− FromListsN e () a,
300+ FLN () a,
286301 Countable a
287302 ) => a -> Matrix e One a
288303returnM a = col l
@@ -299,51 +314,64 @@ bindM = flip comp
299314
300315-- | Build a matrix out of a list of list of elements. Throws a runtime
301316-- error if the dimensions do not match.
302−fromLists :: (FromListsN e cols rows) => [[e]] -> Matrix e cols rows
317+fromLists :: (FLN cols rows) => [[e]] -> Matrix e cols rows
303318fromLists = M . I.fromLists
304319
305320-- | Matrix builder function. Constructs a matrix provided with
306−-- a construction function.
307−matrixBuilder ::
308− (FromListsN e cols rows, CountableDimensionsN cols rows )
321+-- a construction function that operates with indices.
322+matrixBuilder' ::
323+ (FLN cols rows, CountableDimsN cols rows )
309324 => ((Int, Int) -> e) -> Matrix e cols rows
310−matrixBuilder = M . I.matrixBuilder
325+matrixBuilder' = M . I.matrixBuilder'
326+
327+-- | Matrix builder function. Constructs a matrix provided with
328+-- a construction function that operates with arbitrary types.
329+matrixBuilder ::
330+ ( FLN a b,
331+ Enum a,
332+ Enum b,
333+ Bounded a,
334+ Bounded b,
335+ Eq a,
336+ Countable b
337+ ) => ((a, b) -> e) -> Matrix e a b
338+matrixBuilder f = M (I.matrixBuilder f)
311339
312340-- | Constructs a column vector matrix
313−col :: (FromListsN e () rows) => [e] -> Matrix e One rows
341+col :: (FLN () rows) => [e] -> Matrix e One rows
314342col = M . I.col
315343
316344-- | Constructs a row vector matrix
317−row :: (FromListsN e cols ()) => [e] -> Matrix e cols One
345+row :: (FLN cols ()) => [e] -> Matrix e cols One
318346row = M . I.row
319347
320348-- | Lifts functions to matrices with arbitrary dimensions.
321349--
322350-- NOTE: Be careful to not ask for a matrix bigger than the cardinality of
323351-- types @a@ or @b@ allows.
324−fromF ::
352+fromF' ::
325353 ( Liftable e a b,
326− CountableDimensionsN cols rows,
327− FromListsN e rows cols
354+ CountableDimsN cols rows,
355+ FLN rows cols
328356 ) =>
329357 (a -> b) -> Matrix e cols rows
330−fromF = M . I.fromF
358+fromF' = M . I.fromF'
331359
332360-- | Lifts functions to matrices with dimensions matching @a@ and @b@
333361-- cardinality's.
334−fromF' ::
362+fromF ::
335363 ( Liftable e a b,
336− CountableDimensionsN a b,
337− FromListsN e b a
364+ CountableDimsN a b,
365+ FLN b a
338366 ) =>
339367 (a -> b) -> Matrix e a b
340−fromF' = M . I.fromF'
368+fromF = M . I.fromF
341369
342370-- | Lifts relation functions to Boolean Matrix
343371toRel ::
344372 ( Liftable (Natural 0 1) a b,
345− CountableDimensionsN a b,
346− FromListsN (Natural 0 1) b a
373+ CountableDims a b,
374+ FLN b a
347375 ) => (a -> b -> Bool) -> Matrix (Natural 0 1) a b
348376toRel = M . I.toRel
349377
@@ -361,7 +389,7 @@ toList (M m) = I.toList m
361389
362390-- | The zero matrix. A matrix wholly filled with zeros.
363391zeros ::
364− (Num e, FromListsN e cols rows, CountableDimensionsN cols rows)
392+ (Num e, FLN cols rows, CountableDimsN cols rows)
365393 => Matrix e cols rows
366394zeros = M I.zeros
367395
@@ -371,7 +399,7 @@ zeros = M I.zeros
371399--
372400-- Also known as T (Top) matrix.
373401ones ::
374− (Num e, FromListsN e cols rows, CountableDimensionsN cols rows)
402+ (Num e, FLN cols rows, CountableDimsN cols rows)
375403 => Matrix e cols rows
376404ones = M I.ones
377405
@@ -380,7 +408,7 @@ ones = M I.ones
380408-- | The constant matrix constructor. A matrix wholly filled with a given
381409-- value.
382410constant ::
383− (Num e, FromListsN e cols rows, CountableDimensionsN cols rows)
411+ (Num e, FLN cols rows, CountableDimsN cols rows)
384412 => e -> Matrix e cols rows
385413constant = M . I.constant
386414
@@ -389,29 +417,30 @@ constant = M . I.constant
389417-- | The T (Top) row vector matrix.
390418bang ::
391419 forall e cols.
392− (Num e, Enum e, FromListsN e cols (), CountableN cols) =>
420+ (Num e, Enum e, FLN cols (), CountableN cols) =>
393421 Matrix e cols One
394422bang = M I.bang
395423
396424-- | Point constant relation
397−point ::
425+point ::
398426 ( Bounded a,
399427 Enum a,
400428 Eq a,
401429 Num e,
402430 Ord e,
403431 CountableN a,
404− FromListsN e a One
432+ FLN a One
405433 ) => a -> Matrix e One a
406−point = fromF' . const
434+point = fromF . const
407435
408−-- Identity Matrix
436+-- iden Matrix
409437
410−-- | Identity matrix
411−identity ::
412− (Num e, FromListsN e a a, CountableN a) =>
438+-- | iden matrix
439+iden ::
440+ (Num e, FLN a a, CountableN a) =>
413441 Matrix e a a
414−identity = M I.identity
442+iden = M I.iden
443+{-# NOINLINE iden #-}
415444
416445-- Matrix composition (MMM)
417446
@@ -421,13 +450,32 @@ identity = M I.identity
421450-- from LAoP.
422451comp :: (Num e) => Matrix e cr rows -> Matrix e cols cr -> Matrix e cols rows
423452comp (M a) (M b) = M (I.comp a b)
453+{-# NOINLINE comp #-}
454+{-# RULES
455+ "comp/iden1" forall m. comp m iden = m ;
456+ "comp/iden2" forall m. comp iden m = m
457+#-}
458+
459+-- Scalar multiplication of matrices
460+
461+infixl 7 .|
462+-- | Scalar multiplication of matrices.
463+(.|) :: Num e => e -> Matrix e cols rows -> Matrix e cols rows
464+(.|) e (M m) = M (e I..| m)
465+
466+-- Scalar division of matrices
467+
468+infixl 7 ./
469+-- | Scalar multiplication of matrices.
470+(./) :: Fractional e => Matrix e cols rows -> e -> Matrix e cols rows
471+(./) (M m) e = M (m I../ e)
424472
425473-- | Biproduct first component projection
426474p1 ::
427475 ( Num e,
428− CountableDimensionsN n m,
429− FromListsN e n m,
430− FromListsN e m m
476+ CountableDimsN n m,
477+ FLN n m,
478+ FLN m m
431479 ) =>
432480 Matrix e (Either m n) m
433481p1 = M I.p1
@@ -435,9 +483,9 @@ p1 = M I.p1
435483-- | Biproduct second component projection
436484p2 ::
437485 ( Num e,
438− CountableDimensionsN n m,
439− FromListsN e m n,
440− FromListsN e n n
486+ CountableDimsN n m,
487+ FLN m n,
488+ FLN n n
441489 ) =>
442490 Matrix e (Either m n) n
443491p2 = M I.p2
@@ -447,9 +495,9 @@ p2 = M I.p2
447495-- | Biproduct first component injection
448496i1 ::
449497 ( Num e,
450− CountableDimensionsN n m,
451− FromListsN e n m,
452− FromListsN e m m
498+ CountableDimsN n m,
499+ FLN n m,
500+ FLN m m
453501 ) =>
454502 Matrix e m (Either m n)
455503i1 = tr p1
@@ -457,9 +505,9 @@ i1 = tr p1
457505-- | Biproduct second component injection
458506i2 ::
459507 ( Num e,
460− CountableDimensionsN n m,
461− FromListsN e m n,
462− FromListsN e n n
508+ CountableDimsN n m,
509+ FLN m n,
510+ FLN n n
463511 ) =>
464512 Matrix e n (Either m n)
465513i2 = tr p2
@@ -468,24 +516,34 @@ i2 = tr p2
468516
469517-- | Obtain the number of rows.
470518--
471−-- NOTE: The 'KnownNat' constaint is needed in order to obtain the
472−-- dimensions in constant time.
473−--
474−-- TODO: A 'rows' function that does not need the 'KnownNat' constraint in
475−-- exchange for performance.
519+-- NOTE: The 'KnownNat' constraint is needed in order to obtain the
520+-- dimensions in constant time. For a version that doesn't require the
521+-- constraint see 'rows''.
476522rows :: (CountableN rows) => Matrix e cols rows -> Int
477523rows (M m) = I.rows m
478524
525+-- | Obtain the number of rows in an inefficient manner, but without any
526+-- constraints.
527+--
528+-- For a more efficient version see 'rows'.
529+rows' :: Matrix e cols rows -> Int
530+rows' (M m) = I.rows' m
531+
479532-- | Obtain the number of columns.
480−--
481−-- NOTE: The 'KnownNat' constaint is needed in order to obtain the
482−-- dimensions in constant time.
483533--
484−-- TODO: A 'columns' function that does not need the 'KnownNat' constraint in
485−-- exchange for performance.
534+-- NOTE: The 'KnownNat' constraint is needed in order to obtain the
535+-- dimensions in constant time. For a version that doesn't require the
536+-- constraint see 'columns''.
486537columns :: (CountableN cols) => Matrix e cols rows -> Int
487538columns (M m) = I.columns m
488539
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+
489547-- Coproduct Bifunctor
490548
491549infixl 5 -|-
@@ -493,11 +551,11 @@ infixl 5 -|-
493551-- | Matrix coproduct functor also known as matrix direct sum.
494552(-|-) ::
495553 ( Num e,
496− CountableDimensionsN j k,
497− FromListsN e k k,
498− FromListsN e j k,
499− FromListsN e k j,
500− FromListsN e j j
554+ CountableDimsN j k,
555+ FLN k k,
556+ FLN j k,
557+ FLN k j,
558+ FLN j j
501559 ) =>
502560 Matrix e n k ->
503561 Matrix e m j ->
@@ -507,98 +565,98 @@ infixl 5 -|-
507565-- Khatri Rao Product and projections
508566
509567-- | Khatri Rao product first component projection matrix.
510−kp1 ::
568+fstM ::
511569 forall e m k .
512570 ( Num e,
513− CountableDimensionsN m k,
571+ CountableDimsN m k,
514572 CountableN (m, k),
515− FromListsN e (m, k) m,
573+ FLN (m, k) m,
516574 TrivialP m k
517575 ) => Matrix e (m, k) m
518−kp1 = M (I.kp1 @e @(I.Normalize m) @(I.Normalize k))
576+fstM = M (I.fstM @e @(I.Normalize m) @(I.Normalize k))
519577
520578-- | Khatri Rao product second component projection matrix.
521−kp2 ::
579+sndM ::
522580 forall e m k.
523581 ( Num e,
524− CountableDimensionsN k m,
582+ CountableDimsN k m,
525583 CountableN (m, k),
526− FromListsN e (m, k) k,
584+ FLN (m, k) k,
527585 TrivialP m k
528586 ) => Matrix e (m, k) k
529−kp2 = M (I.kp2 @e @(I.Normalize m) @(I.Normalize k))
587+sndM = M (I.sndM @e @(I.Normalize m) @(I.Normalize k))
530588
531589-- | Khatri Rao Matrix product also known as matrix pairing.
532590--
533591-- NOTE: That this is not a true categorical product, see for instance:
534−--
592+--
535593-- @
536−-- | kp1 `comp` khatri a b == a
537−-- khatri a b ==> |
538−-- | kp2 `comp` khatri a b == b
594+-- | fstM . kr a b == a
595+-- kr a b ==> |
596+-- | sndM . kr a b == b
539597-- @
540598--
541599-- __Emphasis__ on the implication symbol.
542−khatri ::
600+kr ::
543601 forall e cols a b.
544602 ( Num e,
545− CountableDimensionsN a b,
603+ CountableDimsN a b,
546604 CountableN (a, b),
547− FromListsN e (a, b) a,
548− FromListsN e (a, b) b,
605+ FLN (a, b) a,
606+ FLN (a, b) b,
549607 TrivialP a b
550608 ) => Matrix e cols a -> Matrix e cols b -> Matrix e cols (a, b)
551−khatri a b =
552− let kp1' = kp1 @e @a @b
553− kp2' = kp2 @e @a @b
554− in comp (tr kp1') a * comp (tr kp2') b
609+kr a b =
610+ let fstM' = fstM @e @a @b
611+ sndM' = sndM @e @a @b
612+ in comp (tr fstM') a * comp (tr sndM') b
555613
556614-- Product Bifunctor (Kronecker)
557615
558616infixl 4 ><
559617
560−-- | Matrix product functor also known as kronecker product
618+-- | Matrix product functor also known as Kronecker product
561619(><) ::
562620 forall e m p n q.
563621 ( Num e,
564− CountableDimensionsN m n,
565− CountableDimensionsN p q,
566− CountableDimensionsN (m, n) (p, q),
567− FromListsN e (m, n) m,
568− FromListsN e (m, n) n,
569− FromListsN e (p, q) p,
570− FromListsN e (p, q) q,
622+ CountableDimsN m n,
623+ CountableDimsN p q,
624+ CountableDimsN (m, n) (p, q),
625+ FLN (m, n) m,
626+ FLN (m, n) n,
627+ FLN (p, q) p,
628+ FLN (p, q) q,
571629 TrivialP m n,
572630 TrivialP p q
573631 ) => Matrix e m p -> Matrix e n q -> Matrix e (m, n) (p, q)
574632(><) a b =
575− let kp1' = kp1 @e @m @n
576− kp2' = kp2 @e @m @n
577− in khatri (comp a kp1') (comp b kp2')
633+ let fstM' = fstM @e @m @n
634+ sndM' = sndM @e @m @n
635+ in kr (comp a fstM') (comp b sndM')
578636
579−-- Matrix abide Junc Split
637+-- Matrix abide Join Fork
580638
581−-- | Matrix "abiding" followin the 'Junc'-'Split' abide law.
582−--
639+-- | Matrix "abiding" followin the 'Join'-'Fork' abide law.
640+--
583641-- Law:
584642--
585643-- @
586−-- 'Junc' ('Split' a c) ('Split' b d) == 'Split' ('Junc' a b) ('Junc' c d)
644+-- 'Join' ('Fork' a c) ('Fork' b d) == 'Fork' ('Join' a b) ('Join' c d)
587645-- @
588−abideJS :: Matrix e cols rows -> Matrix e cols rows
589−abideJS (M m) = M (I.abideJS m)
646+abideJF :: Matrix e cols rows -> Matrix e cols rows
647+abideJF (M m) = M (I.abideJF m)
590648
591−-- Matrix abide Split Junc
649+-- Matrix abide Fork Join
592650
593−-- | Matrix "abiding" followin the 'Split'-'Junc' abide law.
594−--
651+-- | Matrix "abiding" followin the 'Fork'-'Join' abide law.
652+--
595653-- Law:
596654--
597655-- @
598−-- 'Split' ('Junc' a b) ('Junc' c d) == 'Junc' ('Split' a c) ('Split' b d)
656+-- 'Fork' ('Join' a b) ('Join' c d) == 'Join' ('Fork' a c) ('Fork' b d)
599657-- @
600−abideSJ :: Matrix e cols rows -> Matrix e cols rows
601−abideSJ (M m) = M (I.abideSJ m)
658+abideFJ :: Matrix e cols rows -> Matrix e cols rows
659+abideFJ (M m) = M (I.abideFJ m)
602660
603661-- Matrix transposition
604662
@@ -610,9 +668,9 @@ tr (M m) = M (I.tr m)
610668
611669-- | Selective functors 'select' operator equivalent inspired by the
612670-- ArrowMonad solution presented in the paper.
613−selectM ::
671+selectM ::
614672 ( Num e,
615− FromListsN e b b,
673+ FLN b b,
616674 CountableN b
617675 ) => Matrix e cols (Either a b) -> Matrix e a b -> Matrix e cols b
618676selectM (M m) (M y) = M (I.select m y)
@@ -625,9 +683,9 @@ cond ::
625683 Trivial2 a,
626684 Trivial3 a,
627685 CountableN a,
628− FromListsN e () a,
629− FromListsN e a (),
630− FromListsN e a a,
686+ FLN () a,
687+ FLN a (),
688+ FLN a a,
631689 Liftable e a Bool
632690 )
633691 =>
@@ -637,9 +695,13 @@ cond p (M a) (M b) = M (I.cond p a b)
637695-- Pretty print
638696
639697-- | Matrix pretty printer
640−pretty :: (CountableN cols, Show e) => Matrix e cols rows -> String
698+pretty :: (CountableDimsN cols rows, Show e) => Matrix e cols rows -> String
641699pretty (M m) = I.pretty m
642700
643701-- | Matrix pretty printer
644−prettyPrint :: (CountableN cols, Show e) => Matrix e cols rows -> IO ()
702+prettyPrint :: (CountableDimsN cols rows, Show e) => Matrix e cols rows -> IO ()
645703prettyPrint (M m) = I.prettyPrint m
704+
705+-- | Zip two matrices with a given binary function
706+zipWithM :: (e -> f -> g) -> Matrix e a b -> Matrix f a b -> Matrix g a b
707+zipWithM f (M a) (M b) = M (I.zipWithM f a b)
src/LAoP/Relation.hs+8−11
@@ -32,22 +32,19 @@ module LAoP.Relation
3232
3333 -- * Constraint type synonyms
3434 Countable,
35− CountableDimensions,
35+ CountableDims,
3636 CountableN,
37− CountableDimensionsN,
38− FromListsN,
37+ CountableDimsN,
38+ FLN,
3939 Liftable,
4040 Trivial,
41− TrivialE,
4241 TrivialP,
43− TrivialP2,
4442
4543 -- * Primitives
46− empty,
4744 one,
48− junc,
45+ join,
4946 (|||),
50− split,
47+ fork,
5148 (===),
5249
5350 -- * Auxiliary type families
@@ -110,8 +107,8 @@ module LAoP.Relation
110107 splitR,
111108
112109 -- ** Projections
113− p1,
114− p2,
110+ fstR,
111+ sndR,
115112 -- ** Bifunctor
116113 (><),
117114 -- * Relational coproduct
@@ -150,7 +147,7 @@ module LAoP.Relation
150147 cond,
151148
152149 -- * Relational composition and lifting
153− identity,
150+ iden,
154151 comp,
155152 fromF,
156153 fromF',
src/LAoP/Relation/Internal.hs+250−254
@@ -1,3 +1,4 @@
1+{-# LANGUAGE TypeFamilies #-}
12{-# LANGUAGE ConstraintKinds #-}
23{-# LANGUAGE GADTs #-}
34{-# LANGUAGE UndecidableInstances #-}
@@ -42,22 +43,19 @@ module LAoP.Relation.Internal
4243
4344 -- * Constraint type synonyms
4445 Countable,
45− CountableDimensions,
46+ CountableDims,
4647 CountableN,
47− CountableDimensionsN,
48− FromListsN,
48+ CountableDimsN,
49+ FLN,
4950 Liftable,
5051 Trivial,
51− TrivialE,
5252 TrivialP,
53− TrivialP2,
5453
5554 -- * Primitives
56− empty,
5755 one,
58− junc,
56+ join,
5957 (|||),
60− split,
58+ fork,
6159 (===),
6260
6361 -- * Auxiliary type families
@@ -68,14 +66,15 @@ module LAoP.Relation.Internal
6866 -- * Matrix construction and conversion
6967 I.FromLists,
7068 fromLists,
71− fromF,
7269 fromF',
70+ fromF,
7371 toRel,
7472 toLists,
7573 toList,
7674 toBool,
7775 pt,
7876 belongs,
77+ relationBuilder',
7978 relationBuilder,
8079 zeros,
8180 ones,
@@ -120,8 +119,8 @@ module LAoP.Relation.Internal
120119 splitR,
121120
122121 -- ** Projections
123− p1,
124− p2,
122+ fstR,
123+ sndR,
125124 -- ** Bifunctor
126125 (><),
127126 -- * Relational coproduct
@@ -160,10 +159,10 @@ module LAoP.Relation.Internal
160159 cond,
161160
162161 -- * Relational composition and lifting
163− identity,
162+ iden,
164163 comp,
165− fromF,
166164 fromF',
165+ fromF,
167166
168167 -- ** Relational application
169168 pointAp,
@@ -179,9 +178,9 @@ import Data.Void
179178import qualified LAoP.Matrix.Internal as I
180179import LAoP.Utils.Internal
181180import Control.DeepSeq
182−import qualified Control.Category as C
183181import Data.Bool
184182import GHC.TypeLits
183+import Prelude hiding (id, (.))
185184
186185-- | Boolean type synonym for working with boolean matrices
187186type Boolean = Natural 0 1
@@ -194,34 +193,30 @@ newtype Relation a b = R (I.Matrix Boolean (I.Normalize a) (I.Normalize b))
194193deriving instance (Read (I.Matrix Boolean (I.Normalize a) (I.Normalize b))) => Read (Relation a b)
195194
196195-- | Constraint type synonyms to keep the type signatures less convoluted
197−type Countable a = KnownNat (I.Count a)
198−type CountableDimensions a b = (Countable a, Countable b)
199−type CountableN a = KnownNat (I.Count (I.Normalize a))
200−type CountableDimensionsN a b = (CountableN a, CountableN b)
201−type FromListsN a b = I.FromLists Boolean (I.Normalize a) (I.Normalize b)
202−type Liftable a b = (Bounded a, Bounded b, Enum a, Enum b, Eq b, Num Boolean, Ord Boolean)
203−type Trivial a = I.Normalize a ~ I.Normalize (I.Normalize a)
204−type TrivialE a b = I.Normalize (Either a b) ~ Either (I.Normalize a) (I.Normalize b)
205−type TrivialP a b = I.Normalize (a, b) ~ I.Normalize (I.Normalize a, I.Normalize b)
206−type TrivialP2 a b = I.Normalize (I.Normalize a, I.Normalize b) ~ I.Normalize (I.Normalize (a, b))
207−
208−-- | It isn't possible to implement the 'id' function so it's
209−-- implementation is 'undefined'. However 'comp' can be and this partial
210−-- class implementation exists just to make the code more readable.
211−--
212−-- Please use 'identity' instead.
213−instance C.Category Relation where
214− id = undefined
215− (.) = comp
196+type Countable a = KnownNat (I.Count a)
197+type CountableDims a b = (Countable a, Countable b)
198+type CountableN a = KnownNat (I.Count (I.Normalize a))
199+type CountableDimsN a b = (CountableN a, CountableN b)
200+type FLN a b = I.FromLists (I.Normalize a) (I.Normalize b)
201+type Liftable a b = (Bounded a, Bounded b, Enum a, Enum b, Eq b, Num Boolean, Ord Boolean)
202+type Trivial a = I.Normalize a ~ I.Normalize (I.Normalize a)
203+type TrivialP a b = I.Normalize (a, b) ~ I.Normalize (I.Normalize a, I.Normalize b)
204+
205+-- | It is possible to implement a constrained version of the category type
206+-- class.
207+instance Category Relation where
208+ type Object Relation a = (FLN a a, CountableN a)
209+ id = iden
210+ (.) = comp
216211
217212instance Num (Relation a b) where
218− -- | Matrix addition becomes Boolean matrix disjunction
213+ -- | Matrix addition becomes Boolean matrix disjointion
219214 (R a) + (R b) = R (I.orM a b)
220215
221216 -- | Matrix subtraction becomes Relational subtraction
222217 (R a) - (R b) = R (I.subM a b)
223218
224− -- | Matrix multiplication becomes Boolean matrix conjunction
219+ -- | Matrix multiplication becomes Boolean matrix conjointion
225220 (R a) * (R b) = R (I.andM a b)
226221
227222 -- | Matrix negation becomes Boolean matrix negation
@@ -233,87 +228,92 @@ type One = ()
233228
234229-- Primitives
235230
236−-- | Empty matrix constructor
237−empty :: Relation Zero Zero
238−empty = R I.Empty
239−
240231-- | Unit matrix constructor
241232one :: Boolean -> Relation One One
242233one = R . I.One
243234
244−-- | Boolean Matrix 'Junc' constructor, also known as relational coproduct.
235+-- | Boolean Matrix 'Join' constructor, also known as relational coproduct.
245236--
246237-- See 'eitherR'.
247−junc :: (TrivialE a b)
248− => Relation a c -> Relation b c -> Relation (Either a b) c
249−junc (R a) (R b) = R (I.Junc a b)
238+join :: Relation a c -> Relation b c -> Relation (Either a b) c
239+join (R a) (R b) = R (I.Join a b)
250240
251241infixl 3 |||
252−-- | Boolean Matrix 'Junc' constructor
242+-- | Boolean Matrix 'Join' constructor
253243--
254244-- See 'eitherR'.
255245(|||) ::
256− (TrivialE a b) =>
257246 Relation a c ->
258247 Relation b c ->
259248 Relation (Either a b) c
260−(|||) = junc
249+(|||) = join
261250
262−-- | Boolean Matrix 'Split' constructor, also known as relational product.
263−split :: (TrivialE a b)
264− => Relation c a -> Relation c b -> Relation c (Either a b)
265−split (R a) (R b) = R (I.Split a b)
251+-- | Boolean Matrix 'Fork' constructor, also known as relational product.
252+fork :: Relation c a -> Relation c b -> Relation c (Either a b)
253+fork (R a) (R b) = R (I.Fork a b)
266254
267255infixl 2 ===
268−-- | Boolean Matrix 'Split' constructor
256+-- | Boolean Matrix 'Fork' constructor
269257(===) ::
270− (TrivialE a b) =>
271258 Relation c a ->
272259 Relation c b ->
273260 Relation c (Either a b)
274−(===) = split
261+(===) = fork
275262
276263-- Construction
277264
278265-- | Build a matrix out of a list of list of elements. Throws a runtime
279266-- error if the dimensions do not match.
280−fromLists :: (FromListsN a b) => [[Boolean]] -> Relation a b
267+fromLists :: (FLN a b) => [[Boolean]] -> Relation a b
281268fromLists = R . I.fromLists
282269
283−-- | Matrix builder function. Constructs a matrix provided with
284−-- a construction function.
285−relationBuilder ::
286− (FromListsN a b, CountableDimensionsN a b) =>
270+-- | Relation builder function. Constructs a relation provided with
271+-- a construction function that operates with indices.
272+relationBuilder' ::
273+ (FLN a b, CountableDimsN a b) =>
287274 ((Int, Int) -> Boolean) -> Relation a b
275+relationBuilder' = R . I.matrixBuilder'
276+
277+-- | Relation builder function. Constructs a relation provided with
278+-- a construction function that operates with arbitrary types.
279+relationBuilder ::
280+ ( FLN a b,
281+ Enum a,
282+ Enum b,
283+ Bounded a,
284+ Bounded b,
285+ Eq a,
286+ CountableDims a b
287+ ) => ((a, b) -> Boolean) -> Relation a b
288288relationBuilder = R . I.matrixBuilder
289289
290290-- | Lifts functions to matrices with arbitrary dimensions.
291291--
292292-- NOTE: Be careful to not ask for a matrix bigger than the cardinality of
293293-- types @a@ or @b@ allows.
294−fromF ::
294+fromF' ::
295295 ( Liftable a b,
296− CountableDimensionsN c d,
297− FromListsN d c
296+ CountableDimsN c d,
297+ FLN d c
298298 )
299299 => (a -> b) -> Relation c d
300−fromF f = R (I.fromFRel f)
300+fromF' f = R (I.fromFRel' f)
301301
302302-- | Lifts functions to matrices with dimensions matching @a@ and @b@
303303-- cardinality's.
304−fromF' ::
304+fromF ::
305305 ( Liftable a b,
306− CountableDimensionsN a b,
307− FromListsN b a
306+ CountableDimsN a b,
307+ FLN b a
308308 )
309309 => (a -> b) -> Relation a b
310−fromF' f = R (I.fromFRel' f)
310+fromF f = R (I.fromFRel f)
311311
312312-- | Lifts relation functions to 'Relation'
313313toRel ::
314314 ( Liftable a b,
315− CountableDimensionsN a b,
316− FromListsN b a
315+ CountableDims a b,
316+ FLN b a
317317 )
318318 => (a -> b -> Bool) -> Relation a b
319319toRel = R . I.toRel
@@ -322,9 +322,9 @@ toRel = R . I.toRel
322322fromRel ::
323323 ( Liftable a b,
324324 Eq a,
325− CountableDimensionsN a b,
326− FromListsN a One,
327− FromListsN b One
325+ CountableDimsN a b,
326+ FLN a One,
327+ FLN b One
328328 )
329329 => Relation a b -> (a -> b -> Bool)
330330fromRel r a b = pointApBool a b r
@@ -348,12 +348,12 @@ toBool r = case toList r of
348348-- | Power transpose.
349349--
350350-- Maps a relation to a set valued function.
351−pt ::
351+pt ::
352352 ( Liftable a b,
353353 Eq a,
354− CountableDimensionsN a b,
355− FromListsN a One,
356− FromListsN b One
354+ CountableDimsN a b,
355+ FLN a One,
356+ FLN b One
357357 )
358358 => Relation a b -> (a -> List b)
359359pt r a =
@@ -365,8 +365,8 @@ belongs ::
365365 ( Bounded a,
366366 Enum a,
367367 Eq a,
368− CountableDimensionsN (List a) a,
369− FromListsN a (List a)
368+ CountableDims (List a) a,
369+ FLN a (List a)
370370 )
371371 => Relation (List a) a
372372belongs = toRel elemR
@@ -378,16 +378,16 @@ belongs = toRel elemR
378378-- | The zero relation. A relation where no element of type @a@ relates
379379-- with elements of type @b@.
380380--
381−-- Also known as ⊥ (Bottom) Relation or empty Relation.
381+-- Also known as ⊥ (Bottom) Relation.
382382--
383383-- @
384−-- r ``comp`` ⊥ == ⊥ ``comp`` r == ⊥
384+-- r `.` ⊥ == ⊥ `.` r == ⊥
385385-- ⊥ ``sse`` R && R ``sse`` T == True
386386-- @
387387zeros ::
388− (FromListsN a b, CountableDimensionsN a b) =>
388+ (FLN a b, CountableDimsN a b) =>
389389 Relation a b
390−zeros = relationBuilder (const (nat 0))
390+zeros = relationBuilder' (const (nat 0))
391391
392392-- Ones Matrix
393393
@@ -400,43 +400,43 @@ zeros = relationBuilder (const (nat 0))
400400-- ⊥ ``sse`` R && R ``sse`` T == True
401401-- @
402402ones ::
403− (FromListsN a b, CountableDimensionsN a b) =>
403+ (FLN a b, CountableDimsN a b) =>
404404 Relation a b
405−ones = relationBuilder (const (nat 1))
405+ones = relationBuilder' (const (nat 1))
406406
407407-- Bang Matrix
408408
409409-- | The T (Top) row vector relation.
410410bang ::
411− (FromListsN a One, CountableN a) =>
411+ (FLN a One, CountableN a) =>
412412 Relation a One
413413bang = ones
414414
415415-- | Point constant relation
416−point ::
416+point ::
417417 ( Bounded a,
418418 Enum a,
419419 Eq a,
420420 CountableN a,
421− FromListsN a One
421+ FLN a One
422422 ) => a -> Relation One a
423−point = fromF' . const
423+point = fromF . const
424424
425−-- Identity Matrix
425+-- iden Matrix
426426
427−-- | Identity matrix
427+-- | iden matrix
428428--
429429-- @
430−-- 'identity' ``comp`` r == r == r ``comp`` 'identity'
430+-- 'iden' `.` r == r == r `.` 'iden'
431431-- @
432−identity ::
433− (FromListsN a a, CountableN a) => Relation a a
434−identity = relationBuilder (bool (nat 0) (nat 1) . uncurry (==))
432+iden ::
433+ (FLN a a, CountableN a) => Relation a a
434+iden = relationBuilder' (bool (nat 0) (nat 1) . uncurry (==))
435435
436436-- | Relational composition
437437--
438438-- @
439−-- r ``comp`` (s ``comp`` p) = (r ``comp`` s) ``comp`` p
439+-- r `.` (s `.` p) = (r `.` s) `.` p
440440-- @
441441comp :: Relation b c -> Relation a b -> Relation a c
442442comp (R a) (R b) = R (I.compRel a b)
@@ -484,7 +484,7 @@ shrunkBy r s = r `intersection` divR s (conv r)
484484-- r ``overriddenBy`` r == r
485485-- @
486486overriddenBy ::
487− ( FromListsN b b,
487+ ( FLN b b,
488488 CountableN b
489489 ) => Relation a b -> Relation a b -> Relation a b
490490overriddenBy r s = s `union` r `intersection` divR zeros (conv s)
@@ -496,11 +496,11 @@ overriddenBy r s = s `union` r `intersection` divR zeros (conv s)
496496pointAp ::
497497 ( Liftable a b,
498498 Eq a,
499− CountableDimensionsN a b,
500− FromListsN a One,
501− FromListsN b One
499+ CountableDimsN a b,
500+ FLN a One,
501+ FLN b One
502502 ) => a -> b -> Relation a b -> Relation One One
503−pointAp a b r = conv (point b) `comp` r `comp` point a
503+pointAp a b r = conv (point b) . r . point a
504504
505505-- | Relational application
506506--
@@ -508,11 +508,11 @@ pointAp a b r = conv (point b) `comp` r `comp` point a
508508pointApBool ::
509509 ( Liftable a b,
510510 Eq a,
511− CountableDimensionsN a b,
512− FromListsN a One,
513− FromListsN b One
511+ CountableDimsN a b,
512+ FLN a One,
513+ FLN b One
514514 ) => a -> b -> Relation a b -> Bool
515−pointApBool a b r = toBool $ conv (point b) `comp` r `comp` point a
515+pointApBool a b r = toBool $ conv (point b) . r . point a
516516
517517-- | Relational converse
518518--
@@ -538,7 +538,7 @@ iff r s = r == s
538538
539539-- | Relational intersection
540540--
541−-- Lifts pointwise conjunction.
541+-- Lifts pointwise conjointion.
542542--
543543-- @
544544-- (r ``intersection`` s) ``intersection`` t == r ``intersection`` (s ``intersection`` t)
@@ -549,13 +549,13 @@ intersection a b = a * b
549549
550550-- | Relational union
551551--
552−-- Lifts pointwise disjunction.
552+-- Lifts pointwise disjointion.
553553--
554554-- @
555555-- (r ``union`` s) ``union`` t == r `'union' (s ``union`` t)
556556-- r ``union`` s ``sse`` x == r ``sse`` x && s ``sse`` x
557−-- r ``comp`` (s ``union`` t) == (r ``comp`` s) ``union`` (r ``comp`` t)
558−-- (s ``union`` t) ``comp`` r == (s ``comp`` r) ``union`` (t ``comp`` r)
557+-- r `.` (s ``union`` t) == (r `.` s) ``union`` (r `.` t)
558+-- (s ``union`` t) `.` r == (s `.` r) ``union`` (t `.` r)
559559-- @
560560union :: Relation a b -> Relation a b -> Relation a b
561561union a b = a + b
@@ -563,46 +563,46 @@ union a b = a + b
563563-- | Relation Kernel
564564--
565565-- @
566−-- 'ker' r == 'conv' r ``comp`` r
566+-- 'ker' r == 'conv' r `.` r
567567-- 'ker' r == 'img' ('conv' r)
568568-- @
569569ker :: Relation a b -> Relation a a
570−ker r = conv r `comp` r
570+ker r = conv r . r
571571
572572-- | Relation Image
573573--
574574-- @
575−-- 'img' r == r ``comp`` conv r
575+-- 'img' r == r `.` conv r
576576-- 'img' r == 'ker' ('conv' r)
577577-- @
578578img :: Relation a b -> Relation b b
579−img r = r `comp` conv r
579+img r = r . conv r
580580
581581-- | Function division. Special case of 'divS'.
582582--
583583-- NOTE: _This is only valid_ if @f@ and @g@ are 'function's, i.e. 'simple' and
584584-- 'entire'.
585585--
586−-- @'divisionF' f g == 'conv' g ``comp`` f@
586+-- @'divisionF' f g == 'conv' g `.` f@
587587divisionF :: Relation a c -> Relation b c -> Relation a b
588−divisionF f g = conv g `comp` f
588+divisionF f g = conv g . f
589589
590590-- Taxonomy of binary relations
591591
592592-- | A 'Relation' @r@ is 'simple' 'iff' @'coreflexive' ('img' r)@
593−simple :: (CountableN b, FromListsN b b) => Relation a b -> Bool
593+simple :: (CountableN b, FLN b b) => Relation a b -> Bool
594594simple = coreflexive . img
595595
596596-- | A 'Relation' @r@ is 'injective' 'iff' @'coreflexive' ('ker' r)@
597−injective :: (CountableN a, FromListsN a a) => Relation a b -> Bool
597+injective :: (CountableN a, FLN a a) => Relation a b -> Bool
598598injective = coreflexive . ker
599599
600600-- | A 'Relation' @r@ is 'entire' 'iff' @'reflexive' ('ker' r)@
601−entire :: (CountableN a, FromListsN a a) => Relation a b -> Bool
601+entire :: (CountableN a, FLN a a) => Relation a b -> Bool
602602entire = reflexive . ker
603603
604604-- | A 'Relation' @r@ is 'surjective' 'iff' @'reflexive' ('img' r)@
605−surjective :: (CountableN b, FromListsN b b) => Relation a b -> Bool
605+surjective :: (CountableN b, FLN b b) => Relation a b -> Bool
606606surjective = reflexive . img
607607
608608-- | A 'Relation' @r@ is a 'function' 'iff' @'simple' r && 'entire' r@
@@ -611,13 +611,13 @@ surjective = reflexive . img
611611-- relations:
612612--
613613-- @
614−-- f ``comp`` r ``sse`` s == r ``sse`` f ``comp`` s
615−-- r ``comp`` f ``sse`` s == r ``sse`` s ``comp`` f
614+-- f `.` r ``sse`` s == r ``sse`` f `.` s
615+-- r `.` f ``sse`` s == r ``sse`` s `.` f
616616-- @
617617function ::
618− ( CountableDimensionsN a b,
619− FromListsN a a,
620− FromListsN b b
618+ ( CountableDimsN a b,
619+ FLN a a,
620+ FLN b b
621621 )
622622 => Relation a b -> Bool
623623function r = simple r && entire r
@@ -625,7 +625,7 @@ function r = simple r && entire r
625625-- | A 'Relation' @r@ is a 'representation' 'iff' @'injective' r && 'entire' r@
626626representation ::
627627 ( CountableN a,
628− FromListsN a a
628+ FLN a a
629629 )
630630 => Relation a b -> Bool
631631representation r = injective r && entire r
@@ -633,91 +633,91 @@ representation r = injective r && entire r
633633-- | A 'Relation' @r@ is an 'abstraction' 'iff' @'surjective' r && 'simple' r@
634634abstraction ::
635635 ( CountableN b,
636− FromListsN b b
636+ FLN b b
637637 )
638638 => Relation a b -> Bool
639639abstraction r = surjective r && simple r
640640
641641-- | A 'Relation' @r@ is a 'surjection' 'iff' @'function' r && 'abstraction' r@
642642surjection ::
643− ( CountableDimensionsN a b,
644− FromListsN a a,
645− FromListsN b b
643+ ( CountableDimsN a b,
644+ FLN a a,
645+ FLN b b
646646 )
647647 => Relation a b -> Bool
648648surjection r = function r && abstraction r
649649
650650-- | A 'Relation' @r@ is a 'injection' 'iff' @'function' r && 'representation' r@
651651injection ::
652− ( CountableDimensionsN a b,
653− FromListsN a a,
654− FromListsN b b
652+ ( CountableDimsN a b,
653+ FLN a a,
654+ FLN b b
655655 )
656656 => Relation a b -> Bool
657657injection r = function r && representation r
658658
659659-- | A 'Relation' @r@ is an 'bijection' 'iff' @'injection' r && 'surjection' r@
660660bijection ::
661− ( CountableDimensionsN a b,
662− FromListsN b b,
663− FromListsN a a
661+ ( CountableDimsN a b,
662+ FLN b b,
663+ FLN a a
664664 ) => Relation a b -> Bool
665665bijection r = injection r && surjection r
666666
667667-- Properties of relations
668668
669−-- | A 'Relation' @r@ is 'reflexive' 'iff' @'identity' ``sse`` r@
670−reflexive :: (CountableN a, FromListsN a a) => Relation a a -> Bool
671−reflexive r = identity <= r
669+-- | A 'Relation' @r@ is 'reflexive' 'iff' @'id' ``sse`` r@
670+reflexive :: (CountableN a, FLN a a) => Relation a a -> Bool
671+reflexive r = id <= r
672672
673−-- | A 'Relation' @r@ is 'coreflexive' 'iff' @r ``sse`` 'identity'@
674−coreflexive :: (CountableN a, FromListsN a a) => Relation a a -> Bool
675−coreflexive r = r <= identity
673+-- | A 'Relation' @r@ is 'coreflexive' 'iff' @r ``sse`` 'id'@
674+coreflexive :: (CountableN a, FLN a a) => Relation a a -> Bool
675+coreflexive r = r <= id
676676
677−-- | A 'Relation' @r@ is 'transitive' 'iff' @(r ``comp`` r) ``sse`` r@
677+-- | A 'Relation' @r@ is 'transitive' 'iff' @(r `.` r) ``sse`` r@
678678transitive :: Relation a a -> Bool
679−transitive r = (r `comp` r) `sse` r
679+transitive r = (r . r) `sse` r
680680
681681-- | A 'Relation' @r@ is 'symmetric' 'iff' @r == 'conv' r@
682682symmetric :: Relation a a -> Bool
683683symmetric r = r == conv r
684684
685−-- | A 'Relation' @r@ is anti-symmetric 'iff' @(r ``intersection`` 'conv' r) ``sse`` 'identity'@
686−antiSymmetric :: (CountableN a, FromListsN a a) => Relation a a -> Bool
687−antiSymmetric r = (r `intersection` conv r) `sse` identity
685+-- | A 'Relation' @r@ is anti-symmetric 'iff' @(r ``intersection`` 'conv' r) ``sse`` 'id'@
686+antiSymmetric :: (CountableN a, FLN a a) => Relation a a -> Bool
687+antiSymmetric r = (r `intersection` conv r) `sse` id
688688
689−-- | A 'Relation' @r@ is 'irreflexive' 'iff' @(r ``intersection`` 'identity') == 'zeros'@
690−irreflexive :: (CountableN a, FromListsN a a) => Relation a a -> Bool
691−irreflexive r = (r `intersection` identity) == zeros
689+-- | A 'Relation' @r@ is 'irreflexive' 'iff' @(r ``intersection`` 'id') == 'zeros'@
690+irreflexive :: (CountableN a, FLN a a) => Relation a a -> Bool
691+irreflexive r = (r `intersection` id) == zeros
692692
693693-- | A 'Relation' @r@ is 'connected' 'iff' @(r ``union`` 'conv' r) == 'ones'@
694−connected :: (CountableN a, FromListsN a a) => Relation a a -> Bool
694+connected :: (CountableN a, FLN a a) => Relation a a -> Bool
695695connected r = (r `union` conv r) == ones
696696
697697-- | A 'Relation' @r@ is a 'preorder' 'iff' @'reflexive' r && 'transitive' r@
698−preorder :: (CountableN a, FromListsN a a) => Relation a a -> Bool
698+preorder :: (CountableN a, FLN a a) => Relation a a -> Bool
699699preorder r = reflexive r && transitive r
700700
701701-- | A 'Relation' @r@ is a partial-order 'iff' @'antiSymmetric' r && 'preorder' r@
702−partialOrder :: (CountableN a, FromListsN a a) => Relation a a -> Bool
702+partialOrder :: (CountableN a, FLN a a) => Relation a a -> Bool
703703partialOrder r = antiSymmetric r && preorder r
704704
705705-- | A 'Relation' @r@ is a linear-order 'iff' @'connected' r && 'partialOrder' r@
706−linearOrder :: (CountableN a, FromListsN a a) => Relation a a -> Bool
706+linearOrder :: (CountableN a, FLN a a) => Relation a a -> Bool
707707linearOrder r = connected r && partialOrder r
708708
709709-- | A 'Relation' @r@ is an 'equivalence' 'iff' @'symmetric' r && 'preorder' r@
710−equivalence :: (CountableN a, FromListsN a a) => Relation a a -> Bool
710+equivalence :: (CountableN a, FLN a a) => Relation a a -> Bool
711711equivalence r = symmetric r && preorder r
712712
713713-- | A 'Relation' @r@ is a partial-equivalence 'iff' @'partialOrder' r && 'equivalence' r@
714−partialEquivalence :: (CountableN a, FromListsN a a) => Relation a a -> Bool
714+partialEquivalence :: (CountableN a, FLN a a) => Relation a a -> Bool
715715partialEquivalence r = partialOrder r && equivalence r
716716
717717-- | A 'Relation' @r@ is 'difunctional' or regular wherever
718−-- @r ``comp`` 'conv' r ``comp`` r == r@
718+-- @r `.` 'conv' r `.` r == r@
719719difunctional :: Relation a b -> Bool
720−difunctional r = r `comp` conv r `comp` r == r
720+difunctional r = r . conv r . r == r
721721
722722-- Relational pairing
723723
@@ -726,61 +726,61 @@ difunctional r = r `comp` conv r `comp` r == r
726726-- NOTE: That this is not a true categorical product, see for instance:
727727--
728728-- @
729−-- | 'p1' ``comp`` 'splitR' a b ``sse`` a
729+-- | 'fstR' `.` 'splitR' a b ``sse`` a
730730-- 'splitR' a b <=> |
731−-- | 'p2' ``comp`` 'splitR' a b ``sse`` b
731+-- | 'sndR' `.` 'splitR' a b ``sse`` b
732732-- @
733733--
734734-- __Emphasis__ on the 'sse'.
735735--
736736-- @
737−-- 'splitR' r s ``comp`` f == 'splitR' (r ``comp`` f) (s ``comp`` f)
738−-- (R '><' S) ``comp`` 'splitR' p q == 'splitR' (r ``comp`` p) (s ``comp`` q)
739−-- 'conv' ('splitR' r s) ``comp`` 'splitR' x y == ('conv' r ``comp`` x) ``intersection`` ('conv' s ``comp`` y)
737+-- 'splitR' r s `.` f == 'splitR' (r `.` f) (s `.` f)
738+-- (R '><' S) `.` 'splitR' p q == 'splitR' (r `.` p) (s `.` q)
739+-- 'conv' ('splitR' r s) `.` 'splitR' x y == ('conv' r `.` x) ``intersection`` ('conv' s `.` y)
740740-- @
741741--
742742-- @
743743-- 'eitherR' ('splitR' r s) ('splitR' t v) == 'splitR' ('eitherR' r t) ('eitherR' s v)
744744-- @
745745splitR ::
746− ( CountableDimensionsN a b,
746+ ( CountableDimsN a b,
747747 CountableN (a, b),
748− FromListsN (a, b) a,
749− FromListsN (a, b) b,
748+ FLN (a, b) a,
749+ FLN (a, b) b,
750750 TrivialP a b
751751 )
752752 => Relation c a -> Relation c b -> Relation c (a, b)
753−splitR (R f) (R g) = R (I.khatri f g)
753+splitR (R f) (R g) = R (I.kr f g)
754754
755755-- | Relational pairing first component projection
756756--
757757-- @
758−-- 'p1' ``comp`` 'splitR' r s ``sse`` r
758+-- 'fstR' `.` 'splitR' r s ``sse`` r
759759-- @
760−p1 ::
760+fstR ::
761761 forall a b .
762− ( CountableDimensionsN a b,
762+ ( CountableDimsN a b,
763763 CountableN (a, b),
764− FromListsN (a, b) a,
764+ FLN (a, b) a,
765765 TrivialP a b
766766 )
767767 => Relation (a, b) a
768−p1 = R (I.kp1 @Boolean @(I.Normalize a) @(I.Normalize b))
768+fstR = R (I.fstM @Boolean @(I.Normalize a) @(I.Normalize b))
769769
770770-- | Relational pairing second component projection
771771--
772772-- @
773−-- 'p2' ``comp`` 'splitR' r s ``sse`` s
773+-- 'sndR' `.` 'splitR' r s ``sse`` s
774774-- @
775−p2 ::
775+sndR ::
776776 forall a b .
777− ( CountableDimensionsN a b,
777+ ( CountableDimsN a b,
778778 CountableN (a, b),
779− FromListsN (a, b) b,
779+ FLN (a, b) b,
780780 TrivialP a b
781781 )
782782 => Relation (a, b) b
783−p2 = R (I.kp2 @Boolean @(I.Normalize a) @(I.Normalize b))
783+sndR = R (I.sndM @Boolean @(I.Normalize a) @(I.Normalize b))
784784
785785-- Relational pairing functor
786786
@@ -788,17 +788,17 @@ infixl 4 ><
788788-- | Relational pairing functor
789789--
790790-- @
791−-- r '><' s == 'splitR' (r ``comp`` p1) (s ``comp`` p2)
792−-- (r '><' s) ``comp`` (p '><' q) == (r ``comp`` p) '><' (s ``comp`` q)
791+-- r '><' s == 'splitR' (r `.` fstR) (s `.` sndR)
792+-- (r '><' s) `.` (p '><' q) == (r `.` p) '><' (s `.` q)
793793-- @
794794(><) ::
795− ( CountableDimensionsN a b,
796− CountableDimensionsN c d,
797− CountableDimensionsN (a, c) (b, d),
798− FromListsN (a, c) a,
799− FromListsN (a, c) c,
800− FromListsN (b, d) b,
801− FromListsN (b, d) d,
795+ ( CountableDimsN a b,
796+ CountableDimsN c d,
797+ CountableDimsN (a, c) (b, d),
798+ FLN (a, c) a,
799+ FLN (a, c) c,
800+ FLN (b, d) b,
801+ FLN (b, d) d,
802802 TrivialP a c,
803803 TrivialP b d
804804 )
@@ -810,33 +810,31 @@ infixl 4 ><
810810-- | Relational coproduct.
811811--
812812-- @
813−-- | 'eitherR' a b ``comp`` 'i1' == a
813+-- | 'eitherR' a b `.` 'i1' == a
814814-- 'eitherR' a b <=> |
815−-- | 'eitherR' a b ``comp`` 'i2' == b
815+-- | 'eitherR' a b `.` 'i2' == b
816816-- @
817817--
818818-- @
819−-- 'eitherR' r s ``comp`` 'conv' ('eitherR' t u) == (r ``comp`` 'conv' t) ``union`` (s ``comp`` 'conv' u)
819+-- 'eitherR' r s `.` 'conv' ('eitherR' t u) == (r `.` 'conv' t) ``union`` (s `.` 'conv' u)
820820-- @
821821--
822822-- @
823823-- 'eitherR' ('splitR' r s) ('splitR' t v) == 'splitR' ('eitherR' r t) ('eitherR' s v)
824824-- @
825−eitherR :: (TrivialE a b)
826− => Relation a c -> Relation b c -> Relation (Either a b) c
827−eitherR = junc
825+eitherR :: Relation a c -> Relation b c -> Relation (Either a b) c
826+eitherR = join
828827
829828-- | Relational coproduct first component injection
830829--
831830-- @
832−-- 'img' 'i1' ``union`` 'img' 'i2' == 'identity'
833−-- 'i1' ``comp`` 'i2' = 'zeros'
831+-- 'img' 'i1' ``union`` 'img' 'i2' == 'id'
832+-- 'i1' `.` 'i2' = 'zeros'
834833-- @
835834i1 ::
836− ( CountableDimensionsN a b,
837− FromListsN b a,
838− FromListsN a a,
839− TrivialE a b
835+ ( CountableDimsN a b,
836+ FLN b a,
837+ FLN a a
840838 )
841839 => Relation a (Either a b)
842840i1 = R I.i1
@@ -844,14 +842,13 @@ i1 = R I.i1
844842-- | Relational coproduct second component injection
845843--
846844-- @
847−-- 'img' 'i1' ``union`` 'img' 'i2' == 'identity'
848−-- 'i1' ``comp`` 'i2' = 'zeros'
845+-- 'img' 'i1' ``union`` 'img' 'i2' == 'id'
846+-- 'i1' `.` 'i2' = 'zeros'
849847-- @
850848i2 ::
851− ( CountableDimensionsN a b,
852− FromListsN a b,
853− FromListsN b b,
854− TrivialE a b
849+ ( CountableDimsN a b,
850+ FLN a b,
851+ FLN b b
855852 )
856853 => Relation b (Either a b)
857854i2 = R I.i2
@@ -861,16 +858,14 @@ infixl 5 -|-
861858-- | Relational coproduct functor.
862859--
863860-- @
864−-- r '-|-' s == 'eitherR' ('i1' ``comp`` r) ('i2' ``comp`` s)
861+-- r '-|-' s == 'eitherR' ('i1' `.` r) ('i2' `.` s)
865862-- @
866863(-|-) ::
867− ( CountableDimensionsN b d,
868− FromListsN b b,
869− FromListsN d b,
870− FromListsN b d,
871− FromListsN d d,
872− TrivialE a c,
873− TrivialE b d
864+ ( CountableDimsN b d,
865+ FLN b b,
866+ FLN d b,
867+ FLN b d,
868+ FLN d d
874869 )
875870 => Relation a b -> Relation c d -> Relation (Either a c) (Either b d)
876871(-|-) (R a) (R b) = R ((I.-|-) a b)
@@ -883,20 +878,20 @@ infixl 5 -|-
883878-- 'trans'/'untrans';
884879-- more-over, where each particular attribute is placed (input/output) is irrelevant.
885880trans ::
886− ( CountableDimensionsN a b,
881+ ( CountableDimsN a b,
887882 CountableN c,
888− CountableDimensionsN (a, b) (c, b),
889− FromListsN (c, b) c,
890− FromListsN (c, b) b,
891− FromListsN (a, b) a,
892− FromListsN (a, b) b,
883+ CountableDimsN (a, b) (c, b),
884+ FLN (c, b) c,
885+ FLN (c, b) b,
886+ FLN (a, b) a,
887+ FLN (a, b) b,
893888 Trivial (a, b),
894889 Trivial (c, b),
895− TrivialP2 a b,
896− TrivialP2 c b
890+ TrivialP a b,
891+ TrivialP c b
897892 )
898893 => Relation (a, b) c -> Relation a (c, b)
899−trans r = splitR r p2 `comp` conv p1
894+trans r = splitR r sndR . conv fstR
900895
901896-- | Relational 'untrans'
902897--
@@ -904,109 +899,110 @@ trans r = splitR r p2 `comp` conv p1
904899-- 'trans'/'untrans';
905900-- more-over, where each particular attribute is placed (input/output) is irrelevant.
906901untrans ::
907− ( CountableDimensionsN a b,
902+ ( CountableDimsN a b,
908903 CountableN c,
909− CountableDimensionsN (a, b) (c, b),
910− FromListsN (c, b) c,
911− FromListsN (c, b) b,
912− FromListsN (a, b) b,
913− FromListsN (a, b) a,
904+ CountableDimsN (a, b) (c, b),
905+ FLN (c, b) c,
906+ FLN (c, b) b,
907+ FLN (a, b) b,
908+ FLN (a, b) a,
914909 Trivial (a, b),
915910 Trivial (c, b),
916− TrivialP2 a b,
917− TrivialP2 c b
911+ TrivialP a b,
912+ TrivialP c b
918913 )
919914 => Relation a (c, b) -> Relation (a, b) c
920−untrans s = p1 `comp` conv (splitR (conv s) p2)
915+untrans s = fstR . conv (splitR (conv s) sndR)
921916
922917-- | Transforms predicate @p@ into a correflexive relation.
923918--
924919-- @
925−-- 'predR' ('const' True) == 'identity'
920+-- 'predR' ('const' True) == 'id'
926921-- 'predR' ('const' False) == 'zeros'
927922-- @
928923--
929924-- @
930−-- 'predR' q ``comp`` 'predR' p == 'predR' q ``union`` 'predR' p
925+-- 'predR' q `.` 'predR' p == 'predR' q ``union`` 'predR' p
931926-- @
932927predR ::
933928 ( Bounded a,
934929 Enum a,
930+ Countable a,
935931 CountableN a,
936− FromListsN a a,
937− FromListsN Bool a
932+ FLN a a,
933+ FLN Bool a
938934 )
939935 => Relation a Bool -> Relation a a
940−predR p = identity `intersection` divisionF (fromF' (const True)) p
936+predR p = id `intersection` divisionF (fromF (const True)) p
941937
942938-- | Equalizes functions @f@ and @g@.
943939-- That is, @'equalizer' f g@ is the largest coreflexive
944940-- that restricts @g@ so that @f@ and @g@ yield the same outputs.
945941--
946942-- @
947−-- 'equalizer' r r == 'identity'
943+-- 'equalizer' r r == 'id'
948944-- 'equalizer' ('point' True) ('point' False) == 'zeros'
949945-- @
950946equalizer ::
951947 ( CountableN a,
952− FromListsN a a
948+ FLN a a
953949 )
954950 => Relation a b -> Relation a b -> Relation a a
955−equalizer f g = identity `intersection` divisionF f g
951+equalizer f g = id `intersection` divisionF f g
956952
957953-- | Relational conditional guard.
958954--
959955-- @
960−-- 'guard' p = 'i2' ``overriddenBy`` 'i1' ``comp`` 'predR' p
956+-- 'guard' p = 'i2' ``overriddenBy`` 'i1' `.` 'predR' p
961957-- @
962−guard ::
958+guard ::
963959 ( Bounded b,
964960 Enum b,
965961 CountableN b,
966− FromListsN b b,
967− FromListsN Bool b,
968− TrivialE b b
962+ Countable b,
963+ FLN b b,
964+ FLN Bool b
969965 ) => Relation b Bool -> Relation b (Either b b)
970966guard p = conv (eitherR (predR p) (predR (negate p)))
971967
972968-- | Relational McCarthy's conditional.
973−cond ::
969+cond ::
974970 ( Bounded b,
975971 Enum b,
972+ Countable b,
976973 CountableN b,
977− FromListsN b b,
978− FromListsN Bool b,
979− TrivialE b b
980− )
974+ FLN b b,
975+ FLN Bool b
976+ )
981977 => Relation b Bool -> Relation b c -> Relation b c -> Relation b c
982−cond p r s = eitherR r s `comp` guard p
978+cond p r s = eitherR r s . guard p
983979
984980-- | Relational domain.
985981--
986982-- For injective relations, 'domain' and 'ker'nel coincide,
987−-- since @'ker' r ``sse`` 'identity'@ in such situations.
983+-- since @'ker' r ``sse`` 'id'@ in such situations.
988984domain ::
989985 ( CountableN a,
990− FromListsN a a
986+ FLN a a
991987 ) => Relation a b -> Relation a a
992−domain r = ker r `intersection` identity
988+domain r = ker r `intersection` id
993989
994990-- | Relational range.
995991--
996992-- For functions, 'range' and 'img' (image) coincide,
997−-- since @'img' f ``sse`` 'identity'@ for any @f@.
993+-- since @'img' f ``sse`` id@ for any @f@.
998994range ::
999995 ( CountableN b,
1000− FromListsN b b
996+ FLN b b
1001997 ) => Relation a b -> Relation b b
1002−range r = img r `intersection` identity
998+range r = img r `intersection` id
1003999
10041000-- Relation pretty print
10051001
10061002-- | Relation pretty printing
1007−pretty :: (CountableN a) => Relation a b -> String
1003+pretty :: (CountableDimsN a b) => Relation a b -> String
10081004pretty (R a) = I.pretty a
10091005
10101006-- | Relation pretty printing
1011−prettyPrint :: (CountableN a) => Relation a b -> IO ()
1007+prettyPrint :: (CountableDimsN a b) => Relation a b -> IO ()
10121008prettyPrint (R a) = I.prettyPrint a
src/LAoP/Utils.hs+5−2
@@ -95,8 +95,11 @@ module LAoP.Utils
9595 coerceNat2,
9696 coerceNat3,
9797
98− -- * Powerset data type
99− List (..)
98+ -- * List data type
99+ List (..),
100+
101+ -- * Category type-class
102+ Category(..)
100103 )
101104where
102105
src/LAoP/Utils/Internal.hs+33−75
@@ -1,82 +1,13 @@
1+{-# LANGUAGE TypeFamilies #-}
2+{-# LANGUAGE DeriveGeneric #-}
13{-# LANGUAGE TypeApplications #-}
24{-# LANGUAGE DataKinds #-}
35{-# LANGUAGE FlexibleInstances #-}
46{-# LANGUAGE GeneralizedNewtypeDeriving #-}
5−{-# LANGUAGE KindSignatures #-}
67{-# LANGUAGE ScopedTypeVariables #-}
78
89module LAoP.Utils.Internal
9− ( -- | This is an internal module and it is not meant to be imported.
10− --
11− -- Utility module that provides the 'Natural' data type.
12− -- The semantic associated with this data type is that
13− -- it's meant to be a restricted 'Int' value. For example
14− -- the type @Natural 6@ can only be instanciated with @Nat n@
15− -- where @0 <= n <= 6@. Why, You might ask, because with normal
16− -- 'Int's it is not possible to have a decent @Enum (Int, Int)@
17− -- instance. See the following probabilistic programming model as and
18− -- example:
19− --
20− -- We want to calculate the probability of the sum of two dice throws.
21− -- To do this we start by defining the sample space:
22− --
23− -- @
24− -- type SampleSpace = Int -- We think 'Int' are enough
25− --
26− -- die :: Dist Int 6
27− -- die = unifrom [1..6]
28− --
29− -- -- Promote 'Int' addition to a matrix
30− -- addM = fromF (uncurry (+)) -- Impossible
31− -- @
32− --
33− -- The last line is impossible because @(Int, Int)@ does not have
34− -- a good 'Enum' instance: @[(0, 1), (0, 2), .. (0, maxBound), (1, 0),
35− -- ..]@. And we'd like the addition matrix to be of 36 columns by 12
36− -- rows but limited to integers up to @6@!
37− --
38− -- One way to solve this issue is by defining and auxilary data type to
39− -- represent the sample space:
40− --
41− -- @
42− -- data SampleSpace = S1 | S2 | S3 | S4 | S5 | S6
43− -- deriving (Show, Eq, Enum, Bounded) -- Enum and Bounded are
44− -- important
45− -- @
46− --
47− -- And write the sample space addition function:
48− --
49− -- @
50− -- ssAdd :: SampleSpace -> SampleSpace -> Int
51− -- ssAdd a b = (fromEnum a + 1) + (fromEnum b + 1)
52− -- @
53− --
54− -- And then promote that function to matrix and everything is alright:
55− --
56− -- @
57− -- ssAddM = fromF' (uncurry ssAdd)
58− --
59− -- dieSumProb = ssAddM `comp` (khatri die die)
60− -- @
61− --
62− -- This is a nice solution for small sample spaces. But for larger ones
63− -- it is not feasible to write a data type with hundreds of constructors
64− -- and then write manipulation functions that need to deal with them.
65− -- To mitigate this limitation the 'Natural' type comes a long way and
66− -- allows one to model the sample in an easier way. See for instance:
67− --
68− -- @
69− -- ssAdd :: Natural 6 -> Natural 6 -> Natural 12
70− -- ssAdd = coerceNat (+)
71− --
72− -- ssAddM = fromF' (uncurry sumSS)
73− --
74− -- die :: Dist (Natural 6) 6
75− -- die = uniform [nat @6 1 .. nat 6]
76− --
77− -- dieSumProb = ssAddM `comp` (khatri die die)
78− -- @
79− --
10+ (
8011 -- * 'Natural' data type
8112 Natural(..),
8213 nat,
@@ -87,8 +18,11 @@ module LAoP.Utils.Internal
8718 coerceNat2,
8819 coerceNat3,
8920
90− -- * Powerset data type
91− List (..)
21+ -- * 'List' data type
22+ List (..),
23+
24+ -- * Category type class
25+ Category(..)
9226 )
9327where
9428
@@ -98,12 +32,16 @@ import Data.List
9832import Data.Maybe
9933import GHC.TypeLits
10034import Control.DeepSeq
35+import GHC.Generics
36+import Data.Kind
37+import Prelude hiding (id, (.))
38+import qualified Prelude
10139
10240-- | Wrapper around 'Int's that have a restrictive semantic associated.
10341-- A value of type @'Natural' n m@ can only be instanciated with some 'Int'
10442-- @i@ that's @n <= i <= m@.
10543newtype Natural (start :: Nat) (end :: Nat) = Nat Int
106− deriving (Show, Read, Eq, Ord, NFData)
44+ deriving (Show, Read, Eq, Ord, NFData, Generic)
10745
10846-- | Throws a runtime error if any of the operations overflows or
10947-- underflows.
@@ -236,3 +174,23 @@ instance
236174 fromEnum (L x) =
237175 let as = [minBound .. maxBound]
238176 in fromMaybe (error "Does not exist") $ elemIndex x (powerset as)
177+
178+-- | Constrained category instance
179+class Category k where
180+ type Object k o :: Constraint
181+ type Object k o = ()
182+ id :: Object k a => k a a
183+ (.) :: k b c -> k a b -> k a c
184+
185+{-# RULES
186+"identity/left" forall p .
187+ id . p = p
188+"identity/right" forall p .
189+ p . id = p
190+"association" forall p q r .
191+ (p . q) . r = p . (q . r)
192+ #-}
193+
194+instance Category (->) where
195+ id = Prelude.id
196+ (.) = (Prelude..)
stack-8.8.3.yamlnew file+1
@@ -0,0 +1 @@
1+resolver: lts-15.5
stack.yaml+1−66
@@ -1,66 +1 @@
1−# This file was automatically generated by 'stack init'
2−#
3−# Some commonly used options have been documented as comments in this file.
4−# For advanced use and comprehensive documentation of the format, please see:
5−# https://docs.haskellstack.org/en/stable/yaml_configuration/
6−
7−# Resolver to choose a 'specific' stackage snapshot or a compiler version.
8−# A snapshot resolver dictates the compiler version and the set of packages
9−# to be used for project dependencies. For example:
10−#
11−# resolver: lts-3.5
12−# resolver: nightly-2015-09-21
13−# resolver: ghc-7.10.2
14−#
15−# The location of a snapshot can be provided as a file or url. Stack assumes
16−# a snapshot provided as a file might change, whereas a url resource does not.
17−#
18−# resolver: ./custom-snapshot.yaml
19−# resolver: https://example.com/snapshots/2018-01-01.yaml
20−resolver: lts-14.18
21−
22−# User packages to be built.
23−# Various formats can be used as shown in the example below.
24−#
25−# packages:
26−# - some-directory
27−# - https://example.com/foo/bar/baz-0.0.2.tar.gz
28−# subdirs:
29−# - auto-update
30−# - wai
31−packages:
32−- .
33−# Dependency packages to be pulled from upstream that are not in the resolver.
34−# These entries can reference officially published versions as well as
35−# forks / in-progress versions pinned to a git hash. For example:
36−#
37−# extra-deps:
38−# - acme-missiles-0.3
39−# - git: https://github.com/commercialhaskell/stack.git
40−# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
41−#
42−# extra-deps: []
43−
44−# Override default flag values for local packages and extra-deps
45−# flags: {}
46−
47−# Extra package databases containing global packages
48−# extra-package-dbs: []
49−
50−# Control whether we use the GHC we find on the path
51−# system-ghc: true
52−#
53−# Require a specific version of stack, using version ranges
54−# require-stack-version: -any # Default
55−# require-stack-version: ">=2.1"
56−#
57−# Override the architecture used by stack, especially useful on Windows
58−# arch: i386
59−# arch: x86_64
60−#
61−# Extra directories used by stack for building
62−# extra-include-dirs: [/path/to/dir]
63−# extra-lib-dirs: [/path/to/dir]
64−#
65−# Allow a newer minor version of GHC than the snapshot specifies
66−# compiler-check: newer-minor
1+resolver: lts-14.3
stack.yaml.lock+4−4
@@ -6,7 +6,7 @@
66packages: []
77snapshots:
88- completed:
9− size: 524789
10− url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/14/18.yaml
11− sha256: 646be71223e08234131c6989912e6011e01b9767bc447b6d466a35e14360bdf2
12− original: lts-14.18
9+ size: 523878
10+ url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/14/3.yaml
11+ sha256: 470c46c27746a48c7c50f829efc0cf00112787a7804ee4ac7a27754658f6d92c
12+ original: lts-14.3
test/Examples/Quantum.hsnew file+31
@@ -0,0 +1,31 @@
1+{-# LANGUAGE StandaloneDeriving #-}
2+module Examples.Quantum where
3+
4+import LAoP.Utils
5+import LAoP.Matrix.Type
6+import Data.Complex
7+import Prelude hiding (id, (.))
8+
9+deriving instance Ord a => Ord (Complex a)
10+
11+xor :: (Bool, Bool) -> Bool
12+xor (False, b) = b
13+xor (True, b) = not b
14+
15+ker :: Num e => Matrix e a b -> Matrix e a a
16+ker m = tr m . m
17+
18+cnot :: Matrix (Complex Double) (Bool, Bool) (Bool, Bool)
19+cnot = kr fstM (fromF xor)
20+
21+ccnot :: (Num e, Ord e) => Matrix e ((Bool, Bool), Bool) ((Bool, Bool), Bool)
22+ccnot = kr fstM (fromF f)
23+ where
24+ f = xor . tp (uncurry (&&)) id
25+ tp f g (a,b) = (f a, g b)
26+
27+had :: Matrix (Complex Double) Bool Bool
28+had = (1/sqrt 2) .| fromLists [[1, 1], [1, -1]]
29+
30+bell :: Matrix (Complex Double) (Bool, Bool) (Bool, Bool)
31+bell = cnot . (had >< iden)
app/Examples.hs → test/Examples/Readme.hsrenamed+56−31
@@ -1,10 +1,10 @@
1+{-# LANGUAGE GADTs #-}
12{-# LANGUAGE DeriveGeneric #-}
23{-# LANGUAGE FlexibleContexts #-}
3−{-# LANGUAGE TypeOperators #-}
44{-# LANGUAGE TypeApplications #-}
55{-# LANGUAGE DataKinds #-}
66
7−module Examples
7+module Examples.Readme
88 ( exec
99 )
1010 where
@@ -15,13 +15,12 @@ import LAoP.Utils
1515import LAoP.Dist
1616import GHC.TypeLits
1717import Data.Coerce
18−import GHC.Generics
19−import Control.Category hiding (id)
20−import Prelude hiding ((.))
18+import qualified GHC.Generics as G
19+import Prelude hiding (id, (.))
2120
2221-- Monty Hall Problem
2322data Outcome = Win | Lose
24− deriving (Bounded, Enum, Eq, Show, Generic)
23+ deriving (Bounded, Enum, Eq, Show, G.Generic)
2524
2625switch :: Outcome -> Outcome
2726switch Win = Lose
@@ -31,7 +30,7 @@ firstChoice :: Matrix Double () Outcome
3130firstChoice = col [1/3, 2/3]
3231
3332secondChoice :: Matrix Double Outcome Outcome
34−secondChoice = fromF' switch
33+secondChoice = fromF switch
3534
3635-- Dice sum
3736
@@ -40,7 +39,7 @@ type SS = Natural 1 6 -- Sample Space
4039sumSS :: SS -> SS -> Natural 2 12
4140sumSS = coerceNat (+)
4241
43−sumSSM = fromF' (uncurry sumSS)
42+sumSSM = fromF (uncurry sumSS)
4443
4544condition :: (Int, Int) -> Int -> Int
4645condition (fst, snd) thrd = if fst == snd
@@ -50,38 +49,64 @@ condition (fst, snd) thrd = if fst == snd
5049conditionSS :: (SS, SS) -> SS -> Natural 3 18
5150conditionSS = coerceNat2 condition
5251
53−conditionalThrows = fromF' (uncurry conditionSS) . khatri (khatri die die) die
52+conditionalThrows = fromF (uncurry conditionSS) . kr (kr die die) die
5453
5554die :: Matrix Double () SS
5655die = col $ map (const (1/6)) [nat @1 @6 1 .. nat 6]
5756
5857-- Sprinkler
58+data G = Dry | Wet
59+ deriving (Bounded, Enum, Eq, Show, G.Generic)
5960
60−rain :: Matrix Double () Bool
61−rain = col [0.8, 0.2]
61+data S = Off | On
62+ deriving (Bounded, Enum, Eq, Show, G.Generic)
6263
63−sprinkler :: Matrix Double Bool Bool
64−sprinkler = fromLists [[0.6, 0.99], [0.4, 0.01]]
64+data R = No | Yes
65+ deriving (Bounded, Enum, Eq, Show, G.Generic)
6566
66−grass :: Matrix Double (Bool, Bool) Bool
67−grass = fromLists [[1, 0.2, 0.1, 0.01], [0, 0.8, 0.9, 0.99]]
67+rain :: Matrix Double () R
68+rain = matrixBuilder gen
69+ where
70+ gen (_, No) = 0.8
71+ gen (_, Yes) = 0.2
72+
73+sprinkler :: Matrix Double R S
74+sprinkler = matrixBuilder gen
75+ where
76+ gen (No, Off) = 0.6
77+ gen (No, On) = 0.4
78+ gen (Yes, Off) = 0.99
79+ gen (Yes, On) = 0.01
80+
81+grass :: Matrix Double (S, R) G
82+grass = matrixBuilder gen
83+ where
84+ gen ((Off, No), Dry) = 1
85+ gen ((Off, Yes), Dry) = 0.2
86+ gen ((On, No), Dry) = 0.1
87+ gen ((On, Yes), Dry) = 0.01
88+ gen ((Off, No), Wet) = 0
89+ gen ((Off, Yes), Wet) = 0.8
90+ gen ((On, No), Wet) = 0.9
91+ gen ((On, Yes), Wet) = 0.99
92+
93+tag f = kr f id
6894
69−state :: Matrix Double () (Bool, (Bool, Bool))
70−state = khatri grass identity . khatri sprinkler identity . rain
95+state g s r = tag g . tag s . r
7196
72−grass_wet :: Matrix Double (Bool, (Bool, Bool)) One
73−grass_wet = row [0,1] . kp1
97+grass_wet :: Matrix Double () (G, (S, R)) -> Matrix Double One One
98+grass_wet state = row [0,1] . fstM . state
7499
75−rainning :: Matrix Double (Bool, (Bool, Bool)) One
76−rainning = row [0,1] . kp2 . kp2
100+rainning :: Matrix Double (G, (S, R)) One
101+rainning = row [0,1] . sndM . sndM
77102
78103-- Alcuin Puzzle
79104
80105data Being = Farmer | Fox | Goose | Beans
81− deriving (Bounded, Enum, Eq, Show, Generic)
106+ deriving (Bounded, Enum, Eq, Show, G.Generic)
82107
83108data Bank = LeftB | RightB
84− deriving (Bounded, Enum, Eq, Show, Generic)
109+ deriving (Bounded, Enum, Eq, Show, G.Generic)
85110
86111eats :: Being -> Being -> Bool
87112eats Fox Goose = True
@@ -96,21 +121,21 @@ cross LeftB = RightB
96121cross RightB = LeftB
97122
98123crossR :: R.Relation Bank Bank
99−crossR = R.fromF' cross
124+crossR = R.fromF cross
100125
101126-- | Initial state, everyone in the left bank
102127locationLeft :: Being -> Bank
103128locationLeft _ = LeftB
104129
105130locationLeftR :: R.Relation Being Bank
106−locationLeftR = R.fromF' locationLeft
131+locationLeftR = R.fromF locationLeft
107132
108133-- | Initial state, everyone in the right bank
109134locationRight :: Being -> Bank
110135locationRight _ = RightB
111136
112137locationRightR :: R.Relation Being Bank
113−locationRightR = R.fromF' locationRight
138+locationRightR = R.fromF locationRight
114139
115140-- Properties
116141
@@ -127,7 +152,7 @@ inv :: R.Relation Being Bank -> Bool
127152inv w = (w `R.comp` canEat w) `R.sse` (w `R.comp` farmer)
128153 where
129154 farmer :: R.Relation Being Being
130− farmer = R.fromF' (const Farmer)
155+ farmer = R.fromF (const Farmer)
131156
132157-- Arbitrary state
133158bankState :: Being -> Bank -> Bool
@@ -146,14 +171,14 @@ exec = do
146171 putStrLn "Monty Hall Problem solution:"
147172 prettyPrint (secondChoice . firstChoice)
148173 putStrLn "\n Sum of dices probability:"
149− prettyPrint (sumSSM `comp` khatri die die)
174+ prettyPrint (sumSSM . kr die die)
150175 putStrLn "\n Conditional dice throw:"
151176 prettyPrint conditionalThrows
152177 putStrLn "\n Checking that the last result is indeed a distribution: "
153− prettyPrint (bang . sumSSM . khatri die die)
178+ prettyPrint (bang . sumSSM . kr die die)
154179 putStrLn "\n Probability of grass being wet:"
155− prettyPrint (grass_wet . state)
180+ prettyPrint (grass_wet (state grass sprinkler rain))
156181 putStrLn "\n Probability of rain:"
157− prettyPrint (rainning . state)
182+ prettyPrint (rainning . state grass sprinkler rain)
158183 putStrLn "\n Is the arbitrary state a valid state? (Alcuin Puzzle)"
159184 print (inv bankStateR)
app/Spreadsheets.hs → test/Examples/Spreadsheets.hsrenamed+13−14
@@ -1,14 +1,11 @@
1−{-# LANGUAGE DataKinds #-}
2−{-# LANGUAGE GADTs #-}
3−{-# LANGUAGE FlexibleContexts #-}
41{-# LANGUAGE DeriveGeneric #-}
5−module Spreadsheets
6− (
7− )
8− where
92
3+module Examples.Spreadsheets
4+
5+import LAoP.Utils
106import LAoP.Matrix.Type
117import GHC.Generics
8+import Prelude hiding (id, (.))
129
1310data Student = Student1 | Student2 | Student3 | Student4
1411 deriving (Eq, Show, Enum, Bounded, Generic)
@@ -16,7 +13,7 @@ data Student = Student1 | Student2 | Student3 | Student4
1613data Question = Question1 | Question2 | Question3 | Question4
1714 deriving (Eq, Show, Enum, Bounded, Generic)
1815
19−data Results = Test | Exam | Final
16+data Results = Exam | Test | Final
2017 deriving (Eq, Show, Enum, Bounded, Generic)
2118
2219test :: Matrix Float One Results
@@ -38,11 +35,13 @@ xls :: Matrix Float Question One
3835 -> Matrix Float Question Student
3936 -> Matrix Float Student One
4037 -> Matrix Float (Either Question Results) (Either One Student)
41−xls w m t = junc (split w m) (split zeros r)
38+xls w m t = join (fork w m) (fork zeros r)
4239 where
43− rExam = m `comp` tr w
40+ rExam = m . tr w
4441 rTest = tr t
45− rFinal = rTest `max` rExam
46− rAux = junc rTest (junc rExam rFinal)
47− r = tr (converter `comp` tr rAux)
48− converter = junc test (junc exam final)
42+ rFinal = rTest `maxPW` rExam
43+ r = (rExam . tr exam) + (rTest . tr test) + (rFinal . tr final)
44+
45+-- | Overloaded, point-wise 'max' function
46+maxPW :: Ord e => Matrix e a b -> Matrix e a b -> Matrix e a b
47+maxPW = zipWithM max
test/Spec.hs+7−1
@@ -1,2 +1,8 @@
1+module Main (main) where
2+
3+import qualified Examples.Readme as RD
4+
15main :: IO ()
2−main = putStrLn "Test suite not yet implemented"
6+main = do
7+ putStrLn ("Testing if README works" :: String)
8+ RD.exec