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