git.iko.soy/laop
on 6a0ea00 help sign in
eea6231
swap
0 ahead, 68 behind
31 files changed+1532−2350
since splitsnapshots
unifiedsplit
.ghc.environment.x86_64-linux-8.6.5+17 .github/workflows/ci.yml−43 .gitignore+2−54 .travis.yml−47 CHANGELOG.md−17 ChangeLog.md+3 LICENSE+26−17 README.md+24−107 Setup.hs+2 test/Examples/Readme.hs → app/Main.hs+33−61 appveyor.yml−34 benchmark/Main.hs−175 hackage.sh+10 laop-0.1.0.0-docs.tar.gz laop.cabal−89 package.yaml+48 src/LAoP/Dist.hs−10 src/LAoP/Dist/Internal.hs+36−87 src/LAoP/Matrix/Internal.hs+436−445 src/LAoP/Matrix/Nat.hs+187−194 src/LAoP/Matrix/Type.hs+240−283 src/LAoP/Relation.hs+7−34 src/LAoP/Relation/Internal.hs+317−486 src/LAoP/Utils.hs−6 src/LAoP/Utils/Internal.hs+73−70 stack-8.8.3.yaml−1 stack.yaml+66−1 stack.yaml.lock+4−4 test/Examples/Quantum.hs−31 test/Examples/Spreadsheets.hs−47 test/Spec.hs+1−7
.ghc.environment.x86_64-linux-8.6.5new file+17
@@ -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
251.stack-work/
26−stack.yaml.lock
27−
28−### IDE/support
29−# Vim
30−[._]*.s[a-v][a-z]
31−[._]*.sw[a-p]
32−[._]s[a-v][a-z]
33−[._]sw[a-p]
34−*~
35−tags
36−
37−# IntellijIDEA
38−.idea/
39−.ideaHaskellLib/
40−*.iml
41−
42−# Atom
43−.haskell-ghc-mod.json
44−
45−# VS
46−.vscode/
47−
48−# Emacs
49−*#
50−.dir-locals.el
51−TAGS
52−
53−# other
54−.DS_Store
55−hackage.sh
2+laop.cabal
3+*~
.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
22
3−Copyright (c) 2020 Armando Santos
3+All rights reserved.
44
5−Permission is hereby granted, free of charge, to any person obtaining a copy
6−of this software and associated documentation files (the "Software"), to deal
7−in the Software without restriction, including without limitation the rights
8−to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
9−copies of the Software, and to permit persons to whom the Software is
10−furnished to do so, subject to the following conditions:
5+Redistribution and use in source and binary forms, with or without
6+modification, are permitted provided that the following conditions are met:
117
12−The above copyright notice and this permission notice shall be included in all
13−copies or substantial portions of the Software.
8+ * Redistributions of source code must retain the above copyright
9+ notice, this list of conditions and the following disclaimer.
1410
15−THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
16−IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
17−FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
18−AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
19−LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
20−OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
21−SOFTWARE.
11+ * Redistributions in binary form must reproduce the above
12+ copyright notice, this list of conditions and the following
13+ disclaimer in the documentation and/or other materials provided
14+ with the distribution.
15+
16+ * Neither the name of Armando Santos nor the names of other
17+ contributors may be used to endorse or promote products derived
18+ from this software without specific prior written permission.
19+
20+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
22+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
23+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
24+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
25+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
26+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
27+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
28+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
29+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
30+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
README.md+24−107
@@ -1,11 +1,5 @@
11# laop - Linear Algebra of Programming library
22
3−[![GitHub CI](https://github.com/bolt12/laop/workflows/CI/badge.svg)](https://github.com/bolt12/laop/actions)
4−[![Build status](https://img.shields.io/travis/bolt12/laop.svg?logo=travis)](https://travis-ci.org/bolt12/laop)
5−[![Hackage](https://img.shields.io/hackage/v/laop.svg?logo=haskell)](https://hackage.haskell.org/package/laop)
6−[![Stackage Lts](http://stackage.org/package/laop/badge/lts)](http://stackage.org/lts/package/laop)
7−[![Stackage Nightly](http://stackage.org/package/laop/badge/nightly)](http://stackage.org/nightly/package/laop)
8−
93The LAoP discipline generalises relations and functions treating them as
104Boolean matrices and in turn consider these as arrows.
115
@@ -16,38 +10,33 @@ motivation behind the library, the underlying theory, and implementation details
1610This module offers many of the combinators mentioned in the work of
1711[Macedo (2012)](https://repositorium.sdum.uminho.pt/handle/1822/22894) and [Oliveira (2012)](https://pdfs.semanticscholar.org/ccf5/27fa9179081223bffe8067edd81948644fc0.pdf).
1812
19−See the package in hackage [here](https://hackage.haskell.org/package/laop-0.1.1.0)
20−
21−A Functional Pearl has been written and can be regarded as the [reference document](https://github.com/bolt12/tymfgg-pearl) for this library.
13+See the candidate package in hackage [here](https://hackage.haskell.org/package/laop-0.1.0.0/candidate)
2214
2315## Features
2416
25−This library offers 3 main matrix programming modules:
26−
27−- One in which matrices are typed with type level natural numbers;
28−- One in which matrices are typed with arbitrary generic data types;
29−- One in which matrices are regarded as relations, i.e. boolean matrices;
30−
31−There's also an experimental module that uses matrices to represent probability
32−distributions.
33−
34−The most interesting feature is that matrices are represented as an inductive data type.
35−Given this formulation, matrix algorithms can be expressed in a much more elegant and
36−calculational style than the traditional vector of vectors representation. This data type
37−guarantees that a matrix will always have valid dimensions. It can also express block matrix
38−computations naturally, which leads to total, efficient and statically typed manipulation
39−and transformation functions.
40−
41−Like matrix multiplication, other common operations, such as matrix transposition, benefit from a block-oriented structure that leads to a simple and natural divide-and-conquer algorithmic solution. Performance wise, this means that without much effort we can obtain optimal cache-oblivious algorithms.
42−
43−Given this, this new matrix formulation compared to other libraries:
44−
45−- Is more compositional and polymorphic and does not have partial matrix manipulation functions (hence less chances for usage errors);
46−- Our implementation of matrices enables simple manipulation of submatrices, making it particularly suitable for formal verification and equation reasoning, using the mathematical framework defined by the linear algebra of programming. Furthermore, the data type constructors ensure that the matrices of this kind are sound, i.e. malformed matrices with incorrect dimensions of the sort, can not be constructed.
47−
48−## Known issues
49−
50−Unfortunately, due to the use of type-level programming features, this approach sometimes requires type dimensions to be constrainted, in some way, impossible to write idiomatic Arrow instances, for example. Type inference isn't perfect, when it comes to infer the types of matrices which dimensions are computed using type level naturals multiplication, the compiler needs type annotations in order to succeed. And not all kinds of programs can be modeled using matrices, namely programs that deal with arbitrary infinite data types such as lists or integers (although there are some workarounds).
17+This library offers:
18+
19+- An internal representation that uses normal datatypes (`Void`, `()`, `Either`) for matrix dimensions and two
20+ type families `FromNat` and `Count` to make it easier to work with these type of matrices.
21+- A module that uses generalised types for the dimensions and is just a newtype wrapper
22+ around the internal matrix data type.
23+- Other that uses type level naturals for the dimensions and is just a newtype wrapper
24+ around the internal matrix data type.
25+- A very simple Probabilistic Programming module and several functions and data types to
26+ make it easier to deal with sample space.
27+
28+Given this, this new matrix formulation compared to other libraries one has much more advantages, such as:
29+
30+- Has an inductive definition enabling writing matrix manipulation functions in a much more elegant and calculational way;
31+- Statically typed dimensions;
32+- Polymorphic data type dimensions;
33+- Polymorphic matrix content;
34+- Awesome dimension type inference;
35+- Fast type natural conversion via `FromNat` type family;
36+- Matrix `Junc` and `Split`-ing in O(1);
37+- Matrix composition takes advantage of divide-and-conquer and fusion laws.
38+
39+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.
5140
5241## Notes
5342
@@ -129,73 +118,6 @@ grass_wet = row [0,1] . kp1
129118rainning :: Matrix Double (Bool, (Bool, Bool)) One
130119rainning = row [0,1] . kp2 . kp2
131120
132−-- Alcuin Puzzle
133−
134−data Being = Farmer | Fox | Goose | Beans
135− deriving (Bounded, Enum, Eq, Show, Generic)
136−
137−data Bank = LeftB | RightB
138− deriving (Bounded, Enum, Eq, Show, Generic)
139−
140−eats :: Being -> Being -> Bool
141−eats Fox Goose = True
142−eats Goose Beans = True
143−eats _ _ = False
144−
145−eatsR :: R.Relation Being Being
146−eatsR = R.toRel eats
147−
148−cross :: Bank -> Bank
149−cross LeftB = RightB
150−cross RightB = LeftB
151−
152−crossR :: R.Relation Bank Bank
153−crossR = R.fromF' cross
154−
155−-- | Initial state, everyone in the left bank
156−locationLeft :: Being -> Bank
157−locationLeft _ = LeftB
158−
159−locationLeftR :: R.Relation Being Bank
160−locationLeftR = R.fromF' locationLeft
161−
162−-- | Initial state, everyone in the right bank
163−locationRight :: Being -> Bank
164−locationRight _ = RightB
165−
166−locationRightR :: R.Relation Being Bank
167−locationRightR = R.fromF' locationRight
168−
169−-- Properties
170−
171−-- Being at the same bank
172−sameBank :: R.Relation Being Bank -> R.Relation Being Being
173−sameBank = R.ker
174−
175−-- Risk of somebody eating somebody else
176−canEat :: R.Relation Being Bank -> R.Relation Being Being
177−canEat w = sameBank w `R.intersection` eatsR
178−
179−-- "Starvation" property.
180−inv :: R.Relation Being Bank -> Bool
181−inv w = (w `R.comp` canEat w) `R.sse` (w `R.comp` farmer)
182− where
183− farmer :: R.Relation Being Being
184− farmer = R.fromF' (const Farmer)
185−
186−-- Arbitrary state
187−bankState :: Being -> Bank -> Bool
188−bankState Farmer LeftB = True
189−bankState Fox LeftB = True
190−bankState Goose RightB = True
191−bankState Beans RightB = True
192−bankState _ _ = False
193−
194−bankStateR :: R.Relation Being Bank
195−bankStateR = R.toRel bankState
196−
197−-- Main
198−
199121main :: IO ()
200122main = do
201123 putStrLn "Monty Hall Problem solution:"
@@ -210,8 +132,6 @@ main = do
210132 prettyPrint (grass_wet . state)
211133 putStrLn "\n Probability of rain:"
212134 prettyPrint (rainning . state)
213− putStrLn "\n Is the arbitrary state a valid state? (Alcuin Puzzle)"
214− print (inv bankStateR)
215135```
216136
217137```Shell
@@ -270,7 +190,4 @@ Monty Hall Problem solution:
270190┌ ┐
271191│ 0.2 │
272192└ ┘
273−
274−Is the arbitrary state a valid state? (Alcuin Puzzle)
275−False
276193```
Setup.hsnew file+2
@@ -0,0 +1,2 @@
1+import Distribution.Simple
2+main = defaultMain
test/Examples/Readme.hs → app/Main.hsrenamed+33−61
@@ -1,13 +1,10 @@
1−{-# LANGUAGE GADTs #-}
21{-# LANGUAGE DeriveGeneric #-}
32{-# LANGUAGE FlexibleContexts #-}
3+{-# LANGUAGE TypeOperators #-}
44{-# LANGUAGE TypeApplications #-}
55{-# LANGUAGE DataKinds #-}
66
7−module Examples.Readme
8− ( exec
9− )
10− where
7+module Main where
118
129import LAoP.Matrix.Type
1310import qualified LAoP.Relation as R
@@ -15,12 +12,13 @@ import LAoP.Utils
1512import LAoP.Dist
1613import GHC.TypeLits
1714import Data.Coerce
18−import qualified GHC.Generics as G
19−import Prelude hiding (id, (.))
15+import GHC.Generics
16+import Control.Category hiding (id)
17+import Prelude hiding ((.))
2018
2119-- Monty Hall Problem
2220data Outcome = Win | Lose
23− deriving (Bounded, Enum, Eq, Show, G.Generic)
21+ deriving (Bounded, Enum, Eq, Show, Generic)
2422
2523switch :: Outcome -> Outcome
2624switch Win = Lose
@@ -30,7 +28,7 @@ firstChoice :: Matrix Double () Outcome
3028firstChoice = col [1/3, 2/3]
3129
3230secondChoice :: Matrix Double Outcome Outcome
33−secondChoice = fromF switch
31+secondChoice = fromF' switch
3432
3533-- Dice sum
3634
@@ -39,7 +37,7 @@ type SS = Natural 1 6 -- Sample Space
3937sumSS :: SS -> SS -> Natural 2 12
4038sumSS = coerceNat (+)
4139
42−sumSSM = fromF (uncurry sumSS)
40+sumSSM = fromF' (uncurry sumSS)
4341
4442condition :: (Int, Int) -> Int -> Int
4543condition (fst, snd) thrd = if fst == snd
@@ -49,64 +47,38 @@ condition (fst, snd) thrd = if fst == snd
4947conditionSS :: (SS, SS) -> SS -> Natural 3 18
5048conditionSS = coerceNat2 condition
5149
52−conditionalThrows = fromF (uncurry conditionSS) . kr (kr die die) die
50+conditionalThrows = fromF' (uncurry conditionSS) . khatri (khatri die die) die
5351
5452die :: Matrix Double () SS
5553die = col $ map (const (1/6)) [nat @1 @6 1 .. nat 6]
5654
5755-- Sprinkler
58−data G = Dry | Wet
59− deriving (Bounded, Enum, Eq, Show, G.Generic)
60−
61−data S = Off | On
62− deriving (Bounded, Enum, Eq, Show, G.Generic)
6356
64−data R = No | Yes
65− deriving (Bounded, Enum, Eq, Show, G.Generic)
66−
67−rain :: Matrix Double () R
68−rain = matrixBuilder gen
69− where
70− gen (_, No) = 0.8
71− gen (_, Yes) = 0.2
57+rain :: Matrix Double () Bool
58+rain = col [0.8, 0.2]
7259
73−sprinkler :: Matrix Double R S
74−sprinkler = matrixBuilder gen
75− where
76− gen (No, Off) = 0.6
77− gen (No, On) = 0.4
78− gen (Yes, Off) = 0.99
79− gen (Yes, On) = 0.01
80−
81−grass :: Matrix Double (S, R) G
82−grass = matrixBuilder gen
83− where
84− gen ((Off, No), Dry) = 1
85− gen ((Off, Yes), Dry) = 0.2
86− gen ((On, No), Dry) = 0.1
87− gen ((On, Yes), Dry) = 0.01
88− gen ((Off, No), Wet) = 0
89− gen ((Off, Yes), Wet) = 0.8
90− gen ((On, No), Wet) = 0.9
91− gen ((On, Yes), Wet) = 0.99
60+sprinkler :: Matrix Double Bool Bool
61+sprinkler = fromLists [[0.6, 0.99], [0.4, 0.01]]
9262
93−tag f = kr f id
63+grass :: Matrix Double (Bool, Bool) Bool
64+grass = fromLists [[1, 0.2, 0.1, 0.01], [0, 0.8, 0.9, 0.99]]
9465
95−state g s r = tag g . tag s . r
66+state :: Matrix Double () (Bool, (Bool, Bool))
67+state = khatri grass identity . khatri sprinkler identity . rain
9668
97−grass_wet :: Matrix Double () (G, (S, R)) -> Matrix Double One One
98−grass_wet state = row [0,1] . fstM . state
69+grass_wet :: Matrix Double (Bool, (Bool, Bool)) One
70+grass_wet = row [0,1] . kp1
9971
100−rainning :: Matrix Double (G, (S, R)) One
101−rainning = row [0,1] . sndM . sndM
72+rainning :: Matrix Double (Bool, (Bool, Bool)) One
73+rainning = row [0,1] . kp2 . kp2
10274
10375-- Alcuin Puzzle
10476
10577data Being = Farmer | Fox | Goose | Beans
106− deriving (Bounded, Enum, Eq, Show, G.Generic)
78+ deriving (Bounded, Enum, Eq, Show, Generic)
10779
10880data Bank = LeftB | RightB
109− deriving (Bounded, Enum, Eq, Show, G.Generic)
81+ deriving (Bounded, Enum, Eq, Show, Generic)
11082
11183eats :: Being -> Being -> Bool
11284eats Fox Goose = True
@@ -121,21 +93,21 @@ cross LeftB = RightB
12193cross RightB = LeftB
12294
12395crossR :: R.Relation Bank Bank
124−crossR = R.fromF cross
96+crossR = R.fromF' cross
12597
12698-- | Initial state, everyone in the left bank
12799locationLeft :: Being -> Bank
128100locationLeft _ = LeftB
129101
130102locationLeftR :: R.Relation Being Bank
131−locationLeftR = R.fromF locationLeft
103+locationLeftR = R.fromF' locationLeft
132104
133105-- | Initial state, everyone in the right bank
134106locationRight :: Being -> Bank
135107locationRight _ = RightB
136108
137109locationRightR :: R.Relation Being Bank
138−locationRightR = R.fromF locationRight
110+locationRightR = R.fromF' locationRight
139111
140112-- Properties
141113
@@ -152,7 +124,7 @@ inv :: R.Relation Being Bank -> Bool
152124inv w = (w `R.comp` canEat w) `R.sse` (w `R.comp` farmer)
153125 where
154126 farmer :: R.Relation Being Being
155− farmer = R.fromF (const Farmer)
127+ farmer = R.fromF' (const Farmer)
156128
157129-- Arbitrary state
158130bankState :: Being -> Bank -> Bool
@@ -166,19 +138,19 @@ bankStateR :: R.Relation Being Bank
166138bankStateR = R.toRel bankState
167139
168140-- Main
169−exec :: IO ()
170−exec = do
141+main :: IO ()
142+main = do
171143 putStrLn "Monty Hall Problem solution:"
172144 prettyPrint (secondChoice . firstChoice)
173145 putStrLn "\n Sum of dices probability:"
174− prettyPrint (sumSSM . kr die die)
146+ prettyPrint (sumSSM `comp` khatri die die)
175147 putStrLn "\n Conditional dice throw:"
176148 prettyPrint conditionalThrows
177149 putStrLn "\n Checking that the last result is indeed a distribution: "
178− prettyPrint (bang . sumSSM . kr die die)
150+ prettyPrint (bang . sumSSM . khatri die die)
179151 putStrLn "\n Probability of grass being wet:"
180− prettyPrint (grass_wet (state grass sprinkler rain))
152+ prettyPrint (grass_wet . state)
181153 putStrLn "\n Probability of rain:"
182− prettyPrint (rainning . state grass sprinkler rain)
154+ prettyPrint (rainning . state)
183155 putStrLn "\n Is the arbitrary state a valid state? (Alcuin Puzzle)"
184156 print (inv bankStateR)
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
benchmark/Main.hsdeleted−175
@@ -1,175 +0,0 @@
1−{-# LANGUAGE KindSignatures #-}
2−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
3−{-# LANGUAGE DerivingVia #-}
4−{-# LANGUAGE DataKinds #-}
5−{-# LANGUAGE BangPatterns #-}
6−{-# LANGUAGE TypeApplications #-}
7−{-# LANGUAGE FlexibleContexts #-}
8−{-# LANGUAGE AllowAmbiguousTypes #-}
9−{-# LANGUAGE ScopedTypeVariables #-}
10−
11−module Main (main) where
12−
13−import LAoP.Dist.Internal
14−import LAoP.Utils
15−import LAoP.Matrix.Type hiding (CountableN, Countable, FLN)
16−import qualified LAoP.Matrix.Type as T (FLN)
17−import Criterion.Main
18−import Control.DeepSeq
19−import Test.QuickCheck
20−import GHC.TypeLits
21−import Data.Proxy
22−import Prelude hiding (id, (.))
23−
24−selectM2 ::
25− ( Num e,
26− T.FLN b b,
27− CountableN b
28− ) => Matrix e cols (Either a b) -> Matrix e a b -> Matrix e cols b
29−selectM2 m y = join y iden `comp` m
30−
31−selectD2 ::
32− ( FLN b b,
33− CountableN b
34− ) => Dist (Either a b) -> Matrix Prob a b -> Dist b
35−selectD2 (D d) m = D (join m iden `comp` d)
36−
37−-- Composition with iden
38−compId m = comp iden m
39−
40−randomDist :: forall a . (Countable a, FLN () a) => Gen (Dist a)
41−randomDist = do
42− let size = fromInteger (natVal (Proxy :: Proxy (Count a)))
43− l <- vectorOf size (arbitrary :: Gen Prob)
44− let ln = normalize l
45− lr = map (:[]) ln
46− m = fromLists lr
47− return (D m)
48−
49−randomMatrix :: forall a b . (CountableDims a b, FLN a b) => Gen (Matrix Prob a b)
50−randomMatrix = do
51− let cols = fromInteger (natVal (Proxy :: Proxy (Count a)))
52− rows = fromInteger (natVal (Proxy :: Proxy (Count b)))
53− l <- vectorOf (cols * rows) arbitrary
54− let lr = buildList l cols
55− m = fromLists lr
56− return m
57−
58−buildList [] _ = []
59−buildList l r = take r l : buildList (drop r l) r
60−
61−normalize :: [Prob] -> [Prob]
62−normalize l = let l' = map abs l
63− s = sum l'
64− in map (/ s) l'
65−
66−-- Probability
67−newtype Probability = P Double
68− deriving (Num, Show, Fractional, NFData) via Double
69−newtype Dist' a = D' { unD :: [(a,Probability)] }
70− deriving (Show, NFData)
71−
72−instance Functor Dist' where
73− fmap f (D' d) = D' [(f x,p) | (x,p) <- d]
74−
75−instance Applicative Dist' where
76− pure x = D' [(x, 1)]
77− fm <*> m = D' [(f x,q*p) | (f,p) <- unD fm, (x,q) <- unD m]
78−
79−class Applicative f => Selective f where
80− select :: f (Either a b) -> f (a -> b) -> f b
81−
82−instance Selective Dist' where
83− select x y = (\e f -> either f id e) <$> x <*> y -- selectA
84−
85−instance Monad Dist' where
86− return = pure
87− (D' d) >>= f = D' [(y,q*p) | (x,p) <- d, (y,q) <- unD (f x)]
88−
89−normalize2 :: forall a . (Enum a, Bounded a) => [Probability] -> [(a, Probability)]
90−normalize2 l = let l' = map abs l
91− as = [minBound .. maxBound]
92− s = sum l'
93− probs = map (/ s) l'
94− in zip as probs
95−
96−randomDist2 :: forall a . (Countable a, Enum a, Bounded a) => Gen (Dist' a)
97−randomDist2 = do
98− let size = fromInteger (natVal (Proxy :: Proxy (Count a)))
99− l <- vectorOf size (arbitrary :: Gen Prob)
100− let ln = normalize2 @a (map P l)
101− return (D' ln)
102−
103−normalize3 :: forall a . [a] -> [Probability] -> [(a, Probability)]
104−normalize3 as l = let s = sum l
105− probs = map (/ s) l
106− in zip as probs
107−
108−randomDistF :: forall a b . (CountableDims a b, CoArbitrary a, Arbitrary b) => Gen (Dist' (a -> b))
109−randomDistF = do
110− let a = fromInteger (natVal (Proxy :: Proxy (Count a)))
111− b = fromInteger (natVal (Proxy :: Proxy (Count b)))
112− size = a * b
113− l <- vectorOf size (arbitrary :: Gen Prob)
114− l2 <- vectorOf size (arbitrary :: Gen (a -> b))
115− let !ln = normalize3 l2 (map P l)
116− return (D' ln)
117−
118−instance CoArbitrary (Natural a b)
119−
120−instance forall (a :: Nat) (b :: Nat). (KnownNat a, KnownNat b) => Arbitrary (Natural a b)
121− where
122− arbitrary =
123− let bottom = fromInteger (natVal (Proxy :: Proxy a))
124− top = fromInteger (natVal (Proxy :: Proxy b))
125− in do
126− x <- arbitrary `suchThat` (\n -> n >= bottom && n <= top)
127− return (nat x)
128−
129−setupEnv = do
130− m11 <- generate (resize 1 (randomMatrix @(Natural 0 10) @(Natural 0 10) ))
131− m12 <- generate (resize 1 (randomMatrix @(Natural 0 10) @(Natural 0 10) ))
132− m21 <- generate (resize 1 (randomMatrix @(Natural 0 100) @(Natural 0 100) ))
133− m22 <- generate (resize 1 (randomMatrix @(Natural 0 100) @(Natural 0 100) ))
134− m31 <- generate (resize 1 (randomMatrix @(Natural 0 200) @(Natural 0 200) ))
135− m32 <- generate (resize 1 (randomMatrix @(Natural 0 200) @(Natural 0 200) ))
136− return (m11, m12, m21, m22, m31, m32)
137−
138−setupEnv2 = do
139− m21 <- generate (resize 1 (randomMatrix @(Natural 0 100) @(Natural 0 100) ))
140− m40 <- generate (resize 1 (randomMatrix @(Natural 0 100) @(Either (Natural 0 100) (Natural 0 100) )))
141− dist <- generate (resize 1 (randomDist @(Either (Natural 0 100) (Natural 0 100)) ))
142− dist2 <- generate (resize 1 (randomMatrix @(Natural 0 100) @(Natural 0 100) ))
143− distList1 <- generate (resize 1 (randomDist2 @(Either (Natural 0 100) (Natural 0 100))))
144− distList2 <- generate (resize 1 (randomDistF @(Natural 0 100) @(Natural 0 100)))
145− return (m21, m40, dist, dist2, distList1, distList2)
146−
147−main :: IO ()
148−main = defaultMain [
149− env setupEnv $ \ ~(m11, m12, m21, m22, m31, m32) -> bgroup "Matrix Composition" [
150− bgroup "10x10" [
151− bench "WHNF - 10x10" $ whnf (comp m11) m12
152− , bench "NF - 10x10" $ nf (comp m11) m12
153− ],
154− bgroup "100x100" [
155− bench "WHNF - 100x100" $ whnf (comp m21) m22
156− , bench "NF - 100x100" $ nf (comp m21) m22
157− ],
158− bgroup "200x200" [
159− bench "WHNF - 200x200" $ whnf (comp m31) m32
160− , bench "NF - 200x200" $ nf (comp m31) m32
161− ],
162− bgroup "200x200 - RULES" [
163− bench "No rules - 200x200" $ nf (comp m21) iden
164− , bench "Rules - 200x200" $ nf compId m21
165− ] ],
166− env setupEnv2 $ \ ~(m21, m40, dist, dist2, dl1, dl2) -> bgroup "Matrix vs List - `select`" [
167− bgroup "Distribution `select` - 100+100 / 100x100" [
168− bench "List Distribution - Applicative version" $ nf (select dl1) dl2
169− , bench "Matrix Distribution - Applicative version" $ nf (selectD2 dist) dist2
170− , bench "Matrix Distribution - Selective version" $ nf (selectD dist) dist2
171− ],
172− bgroup "Matrix `select` - 100x(100+100) / 100x100" [
173− bench "Applicative version" $ nf (selectM2 m40) m21
174− , bench "Selective version" $ nf (selectM m40) m21
175− ] ] ]
hackage.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
laop-0.1.0.0-docs.tar.gznew file

Binary file not shown.

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+48
@@ -0,0 +1,48 @@
1+name: laop
2+version: 0.1.0.0
3+github: "bolt12/laop"
4+license: BSD3
5+author: "Armando Santos"
6+maintainer: "armandoifsantos@gmail.com"
7+copyright: "MIT"
8+
9+extra-source-files:
10+- README.md
11+- ChangeLog.md
12+
13+# Metadata used when publishing your package
14+# synopsis: Short description of your package
15+# category: Web
16+
17+# To avoid duplicated efforts in documentation and dealing with the
18+# complications of embedding Haddock markup inside cabal files, it is
19+# common to point users to the README.md file.
20+description: Please see the README on GitHub at <https://github.com/bolt12/laop#readme>
21+
22+dependencies:
23+- base >= 4.7 && < 5
24+
25+library:
26+ source-dirs: src
27+
28+executables:
29+ laop-exe:
30+ main: Main.hs
31+ source-dirs: app
32+ ghc-options:
33+ - -threaded
34+ - -rtsopts
35+ - -with-rtsopts=-N
36+ dependencies:
37+ - laop
38+
39+tests:
40+ laop-test:
41+ main: Spec.hs
42+ source-dirs: test
43+ ghc-options:
44+ - -threaded
45+ - -rtsopts
46+ - -with-rtsopts=-N
47+ dependencies:
48+ - laop
src/LAoP/Dist.hs−10
@@ -36,14 +36,6 @@ module LAoP.Dist
3636 Dist (..),
3737 Prob,
3838
39− -- * Constraint type synonyms
40− Countable,
41− CountableN,
42− CountableDimsN,
43− FLN,
44− Liftable,
45− TrivialP,
46−
4739 -- * Functor instance equivalent functions
4840 fmapD,
4941
@@ -53,8 +45,6 @@ module LAoP.Dist
5345
5446 -- * Selective equivalent functions
5547 selectD,
56− branchD,
57− ifD,
5848
5949 -- * Monad equivalent functions
6050 returnD,
src/LAoP/Dist/Internal.hs+36−87
@@ -1,5 +1,3 @@
1−{-# LANGUAGE DerivingVia #-}
2−{-# LANGUAGE ConstraintKinds #-}
31{-# LANGUAGE GADTs #-}
42{-# LANGUAGE AllowAmbiguousTypes #-}
53{-# LANGUAGE TypeApplications #-}
@@ -10,27 +8,18 @@
108{-# LANGUAGE RankNTypes #-}
119
1210module LAoP.Dist.Internal
13− (
11+ (
1412 Dist(..),
1513 Prob,
1614
17− Countable,
18− CountableN,
19− CountableDimsN,
20− FLN,
21− Liftable,
22− TrivialP,
23−
2415 fmapD,
2516 unitD,
2617 multD,
2718 selectD,
28− branchD,
29− ifD,
3019 returnD,
3120 bindD,
3221 (??),
33−
22+
3423 choose,
3524 shape,
3625 linear,
@@ -43,15 +32,11 @@ module LAoP.Dist.Internal
4332 )
4433 where
4534
46−import LAoP.Matrix.Type hiding (TrivialP, Countable, CountableDims, CountableN, CountableDimsN, Liftable, FLN)
47−import Prelude hiding (id, (.))
48−import qualified LAoP.Matrix.Internal as I
35+import LAoP.Matrix.Type
4936import LAoP.Utils
5037import GHC.TypeLits
5138import Data.Proxy
5239import Data.List (sortBy)
53−import Control.DeepSeq
54−import Data.Bool
5540
5641-- | Type synonym for probability value
5742type Prob = Double
@@ -59,21 +44,17 @@ type Prob = Double
5944-- | Type synonym for column vector matrices. This represents a probability
6045-- distribution.
6146newtype Dist a = D (Matrix Prob () a)
62− deriving (Show, Num, Eq, Ord, NFData) via (Matrix Prob () a)
63−
64−-- | Constraint type synonyms to keep the type signatures less convoluted
65−type Countable a = KnownNat (I.Count a)
66−type CountableN a = KnownNat (I.Count (I.Normalize a))
67−type CountableDimsN a b = (CountableN a, CountableN b)
68−type FLN a b = I.FL (I.Normalize a) (I.Normalize b)
69−type Liftable a b = (Bounded a, Bounded b, Enum a, Enum b, Eq b, Num Prob, Ord Prob)
70−type TrivialP a b = Normalize (a, b) ~ Normalize (Normalize a, Normalize b)
7147
7248-- | Functor instance
7349fmapD ::
74− ( Liftable a b,
75− CountableDimsN a b,
76− FLN b a
50+ ( Bounded a,
51+ Bounded b,
52+ Enum a,
53+ Enum b,
54+ Eq b,
55+ KnownNat (Count (Normalize a)),
56+ KnownNat (Count (Normalize b)),
57+ FromLists Prob (Normalize b) (Normalize a)
7758 )
7859 =>
7960 (a -> b) -> Dist a -> Dist b
@@ -85,58 +66,26 @@ unitD = D (one 1)
8566
8667-- | Applicative/Monoidal instance 'mult' function
8768multD ::
88− ( CountableDimsN a b,
89− CountableN (a, b),
90− FLN (a, b) a,
91− FLN (a, b) b,
92− TrivialP a b
69+ ( KnownNat (Count (Normalize a)),
70+ KnownNat (Count (Normalize b)),
71+ KnownNat (Count (Normalize (a, b))),
72+ FromLists Prob (Normalize (a, b)) (Normalize a),
73+ FromLists Prob (Normalize (a, b)) (Normalize b),
74+ Normalize (a, b) ~ Normalize (Normalize a, Normalize b)
9375 ) => Dist a -> Dist b -> Dist (a, b)
94−multD (D a) (D b) = D (kr a b)
76+multD (D a) (D b) = D (khatri a b)
9577
9678-- | Selective instance function
9779selectD ::
98− ( FLN b b,
99− CountableN b
80+ ( Normalize (Either a b) ~ Either (Normalize a) (Normalize b),
81+ FromLists Prob (Normalize b) (Normalize b),
82+ KnownNat (Count (Normalize b))
10083 ) => Dist (Either a b) -> Matrix Prob a b -> Dist b
101−selectD (D d) m = D (selectM d m)
102−
103−-- | Chooses which of the two given effectful
104−-- functions to apply to a given argument;
105−branchD ::
106− ( Num e,
107− CountableDimsN a b,
108− CountableDimsN c (Either b c),
109− FLN c b,
110− FLN a b,
111− FLN a a,
112− FLN b b,
113− FLN c c,
114− FLN b a,
115− FLN b c,
116− FLN (Either b c) b,
117− FLN (Either b c) c
118− )
119− => Dist (Either a b) -> Matrix Prob a c -> Matrix Prob b c -> Dist c
120−branchD x l r = f x `selectD` g l `selectD` r
121− where
122− f (D m) = D (fork (tr i1) (i1 `comp` tr i2) `comp` m)
123− g m = i2 `comp` m
124−
125−-- | Branch on a Boolean value, skipping unnecessary computations.
126−ifD ::
127− ( CountableDimsN a (Either () a),
128− FLN a a,
129− FLN a (),
130− FLN () a,
131− FLN (Either () a) a
132− )
133− => Dist Bool -> Dist a -> Dist a -> Dist a
134−ifD x (D t) (D e) = branchD x' t e
135− where
136− x' = bool (Right ()) (Left ()) `fmapD` x
84+selectD (D d) m = D (junc m identity `comp` d)
85+
13786
13887-- | Monad instance 'return' function
139−returnD :: forall a . (Enum a, FLN () a, Countable a) => a -> Dist a
88+returnD :: forall a . (Enum a, FromLists Prob () (Normalize a), KnownNat (Count a)) => a -> Dist a
14089returnD a = D (col l)
14190 where
14291 i = fromInteger $ natVal (Proxy :: Proxy (Count a))
@@ -150,8 +99,8 @@ bindD (D d) m = D (m `comp` d)
15099-- | Extract probabilities given an Event.
151100(??) ::
152101 ( Enum a,
153− Countable a,
154− FLN () a
102+ KnownNat (Count a),
103+ FromLists Prob () (Normalize a)
155104 ) => (a -> Bool) -> Dist a -> Prob
156105(??) p d =
157106 let l = toValues d
@@ -161,11 +110,11 @@ bindD (D d) m = D (m `comp` d)
161110-- Distribution Construction
162111
163112-- | Constructs a Bernoulli distribution
164−choose :: (FLN () a) => Prob -> Dist a
113+choose :: (FromLists Prob () (Normalize a)) => Prob -> Dist a
165114choose prob = D (col [prob, 1 - prob])
166115
167116-- | Creates a distribution given a shape function
168−shape :: (FLN () a) => (Prob -> Prob) -> [a] -> Dist a
117+shape :: (FromLists Prob () (Normalize a)) => (Prob -> Prob) -> [a] -> Dist a
169118shape _ [] = error "Probability.shape: empty list"
170119shape f xs =
171120 let incr = 1 / fromIntegral (length xs - 1)
@@ -173,23 +122,23 @@ shape f xs =
173122 in fromFreqs (zip xs ps)
174123
175124-- | Constructs a Linear distribution
176−linear :: (FLN () a) => [a] -> Dist a
125+linear :: (FromLists Prob () (Normalize a)) => [a] -> Dist a
177126linear = shape id
178127
179128-- | Constructs an Uniform distribution
180−uniform :: (FLN () a) => [a] -> Dist a
129+uniform :: (FromLists Prob () (Normalize a)) => [a] -> Dist a
181130uniform = shape (const 1)
182131
183132-- | Constructs an Negative Exponential distribution
184−negExp :: (FLN () a) => [a] -> Dist a
133+negExp :: (FromLists Prob () (Normalize a)) => [a] -> Dist a
185134negExp = shape (\x -> exp (-x))
186135
187136-- | Constructs an Normal distribution
188−normal :: (FLN () a) => [a] -> Dist a
137+normal :: (FromLists Prob () (Normalize a)) => [a] -> Dist a
189138normal = shape (normalCurve 0.5 0.5)
190139
191140-- | Transforms a 'Dist' into a list of pairs.
192−toValues :: forall a . (Enum a, Countable a, FLN () a) => Dist a -> [(a, Prob)]
141+toValues :: forall a . (Enum a, KnownNat (Count a), FromLists Prob () (Normalize a)) => Dist a -> [(a, Prob)]
193142toValues (D d) =
194143 let rows = fromInteger (natVal (Proxy :: Proxy (Count a)))
195144 probs = toList d
@@ -197,7 +146,7 @@ toValues (D d) =
197146 in res
198147
199148-- | Pretty a distribution
200−prettyDist :: forall a. (Show a, Enum a, Countable a, FLN () a) => Dist a -> String
149+prettyDist :: forall a. (Show a, Enum a, KnownNat (Count a), FromLists Prob () (Normalize a)) => Dist a -> String
201150prettyDist d =
202151 let values = sortBy (\(a, p1) (b, p2) -> compare p2 p1) (toValues @a d)
203152 w = maximum (map (length . show . fst) values)
@@ -209,12 +158,12 @@ prettyDist d =
209158 showR n x = show x ++ " "
210159
211160-- | Pretty Print a distribution
212−prettyPrintDist :: forall a . (Show a, Enum a, Countable a, FLN () a) => Dist a -> IO ()
161+prettyPrintDist :: forall a . (Show a, Enum a, KnownNat (Count a), FromLists Prob () (Normalize a)) => Dist a -> IO ()
213162prettyPrintDist = putStrLn . prettyDist @a
214163
215164-- Auxiliary functions
216165
217−fromFreqs :: (FLN () a) => [(a,Prob)] -> Dist a
166+fromFreqs :: (FromLists Prob () (Normalize a)) => [(a,Prob)] -> Dist a
218167fromFreqs xs = D (col (map (\(x,p) -> p/q) xs))
219168 where q = sum $ map snd xs
220169
src/LAoP/Matrix/Internal.hs+436−445
@@ -1,6 +1,4 @@
1−{-# LANGUAGE StrictData #-}
21{-# LANGUAGE TypeFamilyDependencies #-}
3−{-# LANGUAGE ConstraintKinds #-}
42{-# LANGUAGE AllowAmbiguousTypes #-}
53{-# LANGUAGE DataKinds #-}
64{-# LANGUAGE FlexibleContexts #-}
@@ -30,7 +28,7 @@
3028-- motivation behind the library, the underlying theory, and implementation details.
3129--
3230-- This module offers many of the combinators mentioned in the work of
33−-- Macedo (2012) and Oliveira (2012).
31+-- Macedo (2012) and Oliveira (2012).
3432--
3533-- This is an Internal module and it is no supposed to be imported.
3634--
@@ -43,26 +41,17 @@ module LAoP.Matrix.Internal
4341 --
4442 -- There exists two type families that make it easier to write
4543 -- matrix dimensions: 'FromNat' and 'Count'. This approach
46− -- leads to a very straightforward implementation
47− -- of LAoP combinators.
44+ -- leads to a very straightforward implementation
45+ -- of LAoP combinators.
4846
4947 -- * Type safe matrix representation
5048 Matrix (..),
5149
52− -- * Constraint type aliases
53− Countable,
54− CountableDims,
55− CountableN,
56− CountableDimsN,
57− FL,
58− FLN,
59− Liftable,
60− Trivial,
61−
6250 -- * Primitives
51+ empty,
6352 one,
64− join,
65− fork,
53+ junc,
54+ split,
6655
6756 -- * Auxiliary type families
6857 FromNat,
@@ -75,7 +64,6 @@ module LAoP.Matrix.Internal
7564 toLists,
7665 toList,
7766 matrixBuilder,
78− matrixBuilder',
7967 row,
8068 col,
8169 zeros,
@@ -86,38 +74,28 @@ module LAoP.Matrix.Internal
8674 -- * Misc
8775 -- ** Get dimensions
8876 columns,
89− columns',
9077 rows,
91− rows',
9278
9379 -- ** Matrix Transposition
9480 tr,
9581
96− -- ** Scalar multiplication/division of matrices
97− (.|),
98− (./),
99−
10082 -- ** Selective operator
101− select,
102− branch,
83+ select,
10384
10485 -- ** McCarthy's Conditional
10586 cond,
10687
10788 -- ** Matrix "abiding"
108− abideJF,
109− abideFJ,
110−
111− -- ** Zip matrices
112− zipWithM,
89+ abideJS,
90+ abideSJ,
11391
11492 -- * Biproduct approach
115− -- ** Fork
93+ -- ** Split
11694 (===),
11795 -- *** Projections
11896 p1,
11997 p2,
120− -- ** Join
98+ -- ** Junc
12199 (|||),
122100 -- *** Injections
123101 i1,
@@ -130,13 +108,12 @@ module LAoP.Matrix.Internal
130108
131109 -- | Note that given the restrictions imposed it is not possible to
132110 -- implement the standard type classes present in standard Haskell.
133−
134111 -- *** Matrix pairing projections
135− fstM,
136− sndM,
112+ kp1,
113+ kp2,
137114
138115 -- *** Matrix pairing
139− kr,
116+ khatri,
140117
141118 -- * Matrix composition and lifting
142119
@@ -144,10 +121,10 @@ module LAoP.Matrix.Internal
144121
145122 -- | Note that given the restrictions imposed it is not possible to
146123 -- implement the standard type classes present in standard Haskell.
147− iden,
124+ identity,
148125 comp,
149− fromF',
150126 fromF,
127+ fromF',
151128
152129 -- * Matrix printing
153130 pretty,
@@ -174,22 +151,21 @@ import LAoP.Utils.Internal
174151import Data.Bool
175152import Data.Kind
176153import Data.List
177−import Data.Maybe
178154import Data.Proxy
179−import Data.Typeable
180155import Data.Void
181156import GHC.TypeLits
182157import Data.Type.Equality
183158import GHC.Generics
184159import Control.DeepSeq
185−import Prelude hiding (id, (.))
186−import qualified Prelude (id, (.))
160+import Control.Category
161+import Prelude hiding ((.))
187162
188163-- | LAoP (Linear Algebra of Programming) Inductive Matrix definition.
189164data Matrix e cols rows where
165+ Empty :: Matrix e Void Void
190166 One :: e -> Matrix e () ()
191− Join :: Matrix e a rows -> Matrix e b rows -> Matrix e (Either a b) rows
192− Fork :: Matrix e cols a -> Matrix e cols b -> Matrix e cols (Either a b)
167+ Junc :: Matrix e a rows -> Matrix e b rows -> Matrix e (Either a b) rows
168+ Split :: Matrix e cols a -> Matrix e cols b -> Matrix e cols (Either a b)
193169
194170deriving instance (Show e) => Show (Matrix e cols rows)
195171
@@ -199,214 +175,221 @@ deriving instance (Show e) => Show (Matrix e cols rows)
199175-- 'Generic' instance.
200176type family Count (d :: Type) :: Nat where
201177 Count (Natural n m) = (m - n) + 1
202− Count (List a) = (^) 2 (Count a)
203− Count (Either a b) = (+) (Count a) (Count b)
204− Count (a, b) = (*) (Count a) (Count b)
205− Count (a -> b) = (^) (Count b) (Count a)
178+ Count (Either a b) = (+) (Count a) (Count b)
179+ Count (a, b) = (*) (Count a) (Count b)
180+ Count (a -> b) = (^) (Count b) (Count a)
206181 -- Generics
207− Count (M1 _ _ f p) = Count (f p)
208− Count (K1 _ _ _) = 1
209− Count (V1 _) = 0
210− Count (U1 _) = 1
182+ Count (M1 _ _ f p) = Count (f p)
183+ Count (K1 _ _ _) = 1
184+ Count (V1 _) = 0
185+ Count (U1 _) = 1
211186 Count ((:*:) a b p) = Count (a p) * Count (b p)
212187 Count ((:+:) a b p) = Count (a p) + Count (b p)
213− Count d = Count (Rep d R)
188+ Count d = Count (Rep d R)
214189
215190-- | Type family that computes of a given type dimension from a given natural
216191--
217192-- Thanks to Li-Yao Xia this type family is super fast.
218193type family FromNat (n :: Nat) :: Type where
194+ FromNat 0 = Void
219195 FromNat 1 = ()
220196 FromNat n = FromNat' (Mod n 2 == 0) (FromNat (Div n 2))
221197
222198type family FromNat' (b :: Bool) (m :: Type) :: Type where
223− FromNat' 'True m = Either m m
199+ FromNat' 'True m = Either m m
224200 FromNat' 'False m = Either () (Either m m)
225201
226202-- | Type family that normalizes the representation of a given data
227203-- structure
228204type family Normalize (d :: Type) :: Type where
229− Normalize (Either a b) = Either (Normalize a) (Normalize b)
230− Normalize d = FromNat (Count d)
231−
232−-- | Constraint type synonyms to keep the type signatures less convoluted
233−type Countable a = KnownNat (Count a)
234−type CountableN a = KnownNat (Count (Normalize a))
235−type CountableDims a b = (Countable a, Countable b)
236−type CountableDimsN a b = (CountableN a, CountableN b)
237−type FL a b = FromLists a b
238−type FLN a b = FromLists (Normalize a) (Normalize b)
239−type Liftable e a b = (Bounded a, Bounded b, Enum a, Enum b, Eq b, Num e, Ord e)
240−type Trivial a = FromNat (Count a) ~ a
241−
242−-- | It is possible to implement a constrained version of the category type
243−-- class.
205+ Normalize d = FromNat (Count d)
206+
207+-- | It isn't possible to implement the 'id' function so it's
208+-- implementation is 'undefined'. However 'comp' can be and this partial
209+-- class implementation exists just to make the code more readable.
210+--
211+-- Please use 'identity' instead.
244212instance (Num e) => Category (Matrix e) where
245− type Object (Matrix e) a = (FL a a, Countable a)
246− id = iden
247− (.) = comp
213+ id = undefined
214+ (.) = comp
248215
249216instance NFData e => NFData (Matrix e cols rows) where
250− rnf (One e) = rnf e
251− rnf (Join a b) = rnf a `seq` rnf b
252− rnf (Fork a b) = rnf a `seq` rnf b
217+ rnf Empty = ()
218+ rnf (One e) = rnf e
219+ rnf (Junc a b) = rnf a `seq` rnf b
220+ rnf (Split a b) = rnf a `seq` rnf b
253221
254222instance Eq e => Eq (Matrix e cols rows) where
255− (One a) == (One b) = a == b
256− (Join a b) == (Join c d) = a == c && b == d
257− (Fork a b) == (Fork c d) = a == c && b == d
258− x@(Fork _ _) == y@(Join _ _) = x == abideJF y
259− x@(Join _ _) == y@(Fork _ _) = abideJF x == y
223+ Empty == Empty = True
224+ (One a) == (One b) = a == b
225+ (Junc a b) == (Junc c d) = a == c && b == d
226+ (Split a b) == (Split c d) = a == c && b == d
227+ x@(Split _ _) == y@(Junc _ _) = x == abideJS y
228+ x@(Junc _ _) == y@(Split _ _) = abideJS x == y
260229
261230instance Num e => Num (Matrix e cols rows) where
262− a + b = zipWithM (+) a b
263−
264− a - b = zipWithM (-) a b
265−
266− a * b = zipWithM (*) a b
267−
268− abs (One a) = One (abs a)
269− abs (Join a b) = Join (abs a) (abs b)
270− abs (Fork a b) = Fork (abs a) (abs b)
271231
272− signum (One a) = One (signum a)
273− signum (Join a b) = Join (signum a) (signum b)
274− signum (Fork a b) = Fork (signum a) (signum b)
232+ Empty + Empty = Empty
233+ (One a) + (One b) = One (a + b)
234+ (Junc a b) + (Junc c d) = Junc (a + c) (b + d)
235+ (Split a b) + (Split c d) = Split (a + c) (b + d)
236+ x@(Split _ _) + y@(Junc _ _) = x + abideJS y
237+ x@(Junc _ _) + y@(Split _ _) = abideJS x + y
238+
239+ Empty - Empty = Empty
240+ (One a) - (One b) = One (a - b)
241+ (Junc a b) - (Junc c d) = Junc (a - c) (b - d)
242+ (Split a b) - (Split c d) = Split (a - c) (b - d)
243+ x@(Split _ _) - y@(Junc _ _) = x - abideJS y
244+ x@(Junc _ _) - y@(Split _ _) = abideJS x - y
245+
246+ Empty * Empty = Empty
247+ (One a) * (One b) = One (a * b)
248+ (Junc a b) * (Junc c d) = Junc (a * c) (b * d)
249+ (Split a b) * (Split c d) = Split (a * c) (b * d)
250+ x@(Split _ _) * y@(Junc _ _) = x * abideJS y
251+ x@(Junc _ _) * y@(Split _ _) = abideJS x * y
252+
253+ abs Empty = Empty
254+ abs (One a) = One (abs a)
255+ abs (Junc a b) = Junc (abs a) (abs b)
256+ abs (Split a b) = Split (abs a) (abs b)
257+
258+ signum Empty = Empty
259+ signum (One a) = One (signum a)
260+ signum (Junc a b) = Junc (signum a) (signum b)
261+ signum (Split a b) = Split (signum a) (signum b)
275262
276263instance Ord e => Ord (Matrix e cols rows) where
277− (One a) <= (One b) = a <= b
278− (Join a b) <= (Join c d) = (a <= c) && (b <= d)
279− (Fork a b) <= (Fork c d) = (a <= c) && (b <= d)
280− x@(Fork _ _) <= y@(Join _ _) = x <= abideJF y
281− x@(Join _ _) <= y@(Fork _ _) = abideJF x <= y
264+ Empty <= Empty = True
265+ (One a) <= (One b) = a <= b
266+ (Junc a b) <= (Junc c d) = (a <= c) && (b <= d)
267+ (Split a b) <= (Split c d) = (a <= c) && (b <= d)
268+ x@(Split _ _) <= y@(Junc _ _) = x <= abideJS y
269+ x@(Junc _ _) <= y@(Split _ _) = abideJS x <= y
282270
283271-- Primitives
284272
273+-- | Empty matrix constructor
274+empty :: Matrix e Void Void
275+empty = Empty
276+
285277-- | Unit matrix constructor
286278one :: e -> Matrix e () ()
287279one = One
288280
289−-- | Matrix 'Join' constructor
290−join :: Matrix e a rows -> Matrix e b rows -> Matrix e (Either a b) rows
291−join = Join
281+-- | Matrix 'Junc' constructor
282+junc :: Matrix e a rows -> Matrix e b rows -> Matrix e (Either a b) rows
283+junc = Junc
292284
293285infixl 3 |||
294286
295−-- | Matrix 'Join' constructor
287+-- | Matrix 'Junc' constructor
296288(|||) :: Matrix e a rows -> Matrix e b rows -> Matrix e (Either a b) rows
297−(|||) = Join
289+(|||) = Junc
298290
299−-- | Matrix 'Fork' constructor
300−fork :: Matrix e cols a -> Matrix e cols b -> Matrix e cols (Either a b)
301−fork = Fork
291+-- | Matrix 'Split' constructor
292+split :: Matrix e cols a -> Matrix e cols b -> Matrix e cols (Either a b)
293+split = Split
302294
303295infixl 2 ===
304296
305−-- | Matrix 'Fork' constructor
297+-- | Matrix 'Split' constructor
306298(===) :: Matrix e cols a -> Matrix e cols b -> Matrix e cols (Either a b)
307−(===) = Fork
299+(===) = Split
308300
309301-- Construction
310302
311303-- | Type class for defining the 'fromList' conversion function.
312304--
313305-- 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.
315−class FromLists cols rows where
306+-- classes are needed bery much like an inductive definition but on types.
307+class FromLists e cols rows where
316308 -- | Build a matrix out of a list of list of elements. Throws a runtime
317309 -- error if the dimensions do not match.
318310 fromLists :: [[e]] -> Matrix e cols rows
319311
320−instance FromLists () () where
312+instance FromLists e Void Void where
313+ fromLists [] = Empty
314+ fromLists _ = error "Wrong dimensions"
315+
316+instance {-# OVERLAPPING #-} FromLists e () () where
321317 fromLists [[e]] = One e
322318 fromLists _ = error "Wrong dimensions"
323319
324−instance (FromLists cols ()) => FromLists (Either () cols) () where
325− fromLists [h : t] = Join (One h) (fromLists [t])
320+instance {-# OVERLAPPING #-} (FromLists e cols ()) => FromLists e (Either () cols) () where
321+ fromLists [h : t] = Junc (One h) (fromLists [t])
326322 fromLists _ = error "Wrong dimensions"
327323
328−instance {-# OVERLAPPABLE #-}
329− (FromLists a (), FromLists b (), Countable a) => FromLists (Either a b) () where
330− fromLists [l] =
324+instance {-# OVERLAPPABLE #-} (FromLists e a (), FromLists e b (), KnownNat (Count a)) => FromLists e (Either a b) () where
325+ fromLists [l] =
331326 let rowsA = fromInteger (natVal (Proxy :: Proxy (Count a)))
332− in Join (fromLists [take rowsA l]) (fromLists [drop rowsA l])
327+ in Junc (fromLists [take rowsA l]) (fromLists [drop rowsA l])
333328 fromLists _ = error "Wrong dimensions"
334329
335−instance (FromLists () rows) => FromLists () (Either () rows) where
336− fromLists ([h] : t) = Fork (One h) (fromLists t)
330+instance {-# OVERLAPPING #-} (FromLists e () rows) => FromLists e () (Either () rows) where
331+ fromLists ([h] : t) = Split (One h) (fromLists t)
337332 fromLists _ = error "Wrong dimensions"
338333
339−instance {-# OVERLAPPABLE #-}
340− (FromLists () a, FromLists () b, Countable a) => FromLists () (Either a b) where
341− fromLists l@([_] : _) =
334+instance {-# OVERLAPPABLE #-} (FromLists e () a, FromLists e () b, KnownNat (Count a)) => FromLists e () (Either a b) where
335+ fromLists l@([_] : _) =
342336 let rowsA = fromInteger (natVal (Proxy :: Proxy (Count a)))
343− in Fork (fromLists (take rowsA l)) (fromLists (drop rowsA l))
337+ in Split (fromLists (take rowsA l)) (fromLists (drop rowsA l))
344338 fromLists _ = error "Wrong dimensions"
345339
346−instance (FromLists (Either a b) c, FromLists (Either a b) d, Countable c)
347− => FromLists (Either a b) (Either c d) where
340+instance {-# OVERLAPPABLE #-} (FromLists e (Either a b) c, FromLists e (Either a b) d, KnownNat (Count c)) => FromLists e (Either a b) (Either c d) where
348341 fromLists l@(h : t) =
349342 let lh = length h
350343 rowsC = fromInteger (natVal (Proxy :: Proxy (Count c)))
351− condition = all ((== lh) . length) t
344+ condition = all (== lh) (map length t)
352345 in if lh > 0 && condition
353− then Fork (fromLists (take rowsC l)) (fromLists (drop rowsC l))
346+ then Split (fromLists (take rowsC l)) (fromLists (drop rowsC l))
354347 else error "Not all rows have the same length"
355348
356349-- | Matrix builder function. Constructs a matrix provided with
357−-- a construction function that operates with indices.
358−matrixBuilder' ::
350+-- a construction function.
351+matrixBuilder ::
359352 forall e cols rows.
360− ( FL cols rows,
361− CountableDims cols rows
362− ) => ((Int, Int) -> e) -> Matrix e cols rows
363−matrixBuilder' f =
353+ ( FromLists e cols rows,
354+ KnownNat (Count cols),
355+ KnownNat (Count rows)
356+ ) =>
357+ ((Int, Int) -> e) ->
358+ Matrix e cols rows
359+matrixBuilder f =
364360 let c = fromInteger $ natVal (Proxy :: Proxy (Count cols))
365361 r = fromInteger $ natVal (Proxy :: Proxy (Count rows))
366362 positions = [(a, b) | a <- [0 .. (r - 1)], b <- [0 .. (c - 1)]]
367363 in fromLists . map (map f) . groupBy (\(x, _) (w, _) -> x == w) $ positions
368364
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−
389365-- | Constructs a column vector matrix
390−col :: (FL () rows) => [e] -> Matrix e () rows
366+col :: (FromLists e () rows) => [e] -> Matrix e () rows
391367col = fromLists . map (: [])
392368
393369-- | Constructs a row vector matrix
394−row :: (FL cols ()) => [e] -> Matrix e cols ()
370+row :: (FromLists e cols ()) => [e] -> Matrix e cols ()
395371row = fromLists . (: [])
396372
397373-- | Lifts functions to matrices with arbitrary dimensions.
398374--
399375-- NOTE: Be careful to not ask for a matrix bigger than the cardinality of
400376-- types @a@ or @b@ allows.
401−fromF' ::
377+fromF ::
402378 forall a b cols rows e.
403− ( Liftable e a b,
404− CountableDims cols rows,
405− FL rows cols
379+ ( Bounded a,
380+ Bounded b,
381+ Enum a,
382+ Enum b,
383+ Eq b,
384+ Num e,
385+ Ord e,
386+ KnownNat (Count cols),
387+ KnownNat (Count rows),
388+ FromLists e rows cols
406389 ) =>
407390 (a -> b) ->
408391 Matrix e cols rows
409−fromF' f =
392+fromF f =
410393 let minA = minBound @a
411394 maxA = maxBound @a
412395 minB = minBound @b
@@ -416,8 +399,8 @@ fromF' f =
416399 elementsA = take ccols [minA .. maxA]
417400 elementsB = take rrows [minB .. maxB]
418401 combinations = (,) <$> elementsA <*> elementsB
419− combAp = map snd . sort . map (\(a, b) -> if f a == b
420− then ((fromEnum a, fromEnum b), 1)
402+ combAp = map snd . sort . map (\(a, b) -> if f a == b
403+ then ((fromEnum a, fromEnum b), 1)
421404 else ((fromEnum a, fromEnum b), 0)) $ combinations
422405 mList = buildList combAp rrows
423406 in tr $ fromLists mList
@@ -427,23 +410,48 @@ fromF' f =
427410
428411-- | Lifts functions to matrices with dimensions matching @a@ and @b@
429412-- cardinality's.
430−fromF ::
413+fromF' ::
431414 forall a b e.
432− ( Liftable e a b,
433− CountableDimsN a b,
434− FLN b a
415+ ( Bounded a,
416+ Bounded b,
417+ Enum a,
418+ Enum b,
419+ Eq b,
420+ Num e,
421+ Ord e,
422+ KnownNat (Count (Normalize a)),
423+ KnownNat (Count (Normalize b)),
424+ FromLists e (Normalize b) (Normalize a)
435425 ) =>
436426 (a -> b) ->
437427 Matrix e (Normalize a) (Normalize b)
438−fromF = fromF'
428+fromF' f =
429+ let minA = minBound @a
430+ maxA = maxBound @a
431+ minB = minBound @b
432+ maxB = maxBound @b
433+ ccols = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize a)))
434+ rrows = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize b)))
435+ elementsA = take ccols [minA .. maxA]
436+ elementsB = take rrows [minB .. maxB]
437+ combinations = (,) <$> elementsA <*> elementsB
438+ combAp = map snd . sort . map (\(a, b) -> if f a == b
439+ then ((fromEnum a, fromEnum b), 1)
440+ else ((fromEnum a, fromEnum b), 0)) $ combinations
441+ mList = buildList combAp rrows
442+ in tr $ fromLists mList
443+ where
444+ buildList [] _ = []
445+ buildList l r = take r l : buildList (drop r l) r
439446
440447-- Conversion
441448
442449-- | Converts a matrix to a list of lists of elements.
443450toLists :: Matrix e cols rows -> [[e]]
451+toLists Empty = []
444452toLists (One e) = [[e]]
445−toLists (Fork l r) = toLists l ++ toLists r
446−toLists (Join l r) = zipWith (++) (toLists l) (toLists r)
453+toLists (Split l r) = toLists l ++ toLists r
454+toLists (Junc l r) = zipWith (++) (toLists l) (toLists r)
447455
448456-- | Converts a matrix to a list of elements.
449457toList :: Matrix e cols rows -> [e]
@@ -452,38 +460,37 @@ toList = concat . toLists
452460-- Zeros Matrix
453461
454462-- | The zero matrix. A matrix wholly filled with zeros.
455−zeros :: (Num e, FL cols rows, CountableDims cols rows) => Matrix e cols rows
456−zeros = matrixBuilder' (const 0)
463+zeros :: (Num e, FromLists e cols rows, KnownNat (Count cols), KnownNat (Count rows)) => Matrix e cols rows
464+zeros = matrixBuilder (const 0)
457465
458466-- Ones Matrix
459467
460468-- | The ones matrix. A matrix wholly filled with ones.
461469--
462470-- Also known as T (Top) matrix.
463−ones :: (Num e, FL cols rows, CountableDims cols rows) => Matrix e cols rows
464−ones = matrixBuilder' (const 1)
471+ones :: (Num e, FromLists e cols rows, KnownNat (Count cols), KnownNat (Count rows)) => Matrix e cols rows
472+ones = matrixBuilder (const 1)
465473
466474-- Const Matrix
467475
468476-- | The constant matrix constructor. A matrix wholly filled with a given
469477-- value.
470−constant :: (Num e, FL cols rows, CountableDims cols rows) => e -> Matrix e cols rows
471−constant e = matrixBuilder' (const e)
478+constant :: (Num e, FromLists e cols rows, KnownNat (Count cols), KnownNat (Count rows)) => e -> Matrix e cols rows
479+constant e = matrixBuilder (const e)
472480
473481-- Bang Matrix
474482
475483-- | The T (Top) row vector matrix.
476−bang :: forall e cols. (Num e, Enum e, FL cols (), Countable cols) => Matrix e cols ()
484+bang :: forall e cols. (Num e, Enum e, FromLists e cols (), KnownNat (Count cols)) => Matrix e cols ()
477485bang =
478486 let c = fromInteger $ natVal (Proxy :: Proxy (Count cols))
479487 in fromLists [take c [1, 1 ..]]
480488
481−-- iden Matrix
489+-- Identity Matrix
482490
483−-- | iden matrix.
484−iden :: forall e cols . (Num e, FL cols cols, Countable cols) => Matrix e cols cols
485−iden = matrixBuilder' (bool 0 1 . uncurry (==))
486−{-# NOINLINE iden #-}
491+-- | Identity matrix.
492+identity :: (Num e, FromLists e cols cols, KnownNat (Count cols)) => Matrix e cols cols
493+identity = matrixBuilder (bool 0 1 . uncurry (==))
487494
488495-- Matrix composition (MMM)
489496
@@ -492,90 +499,60 @@ iden = matrixBuilder' (bool 0 1 . uncurry (==))
492499-- This definition takes advantage of divide-and-conquer and fusion laws
493500-- from LAoP.
494501comp :: (Num e) => Matrix e cr rows -> Matrix e cols cr -> Matrix e cols rows
495−comp (One a) (One b) = One (a * b)
496−comp (Join a b) (Fork c d) = comp a c + comp b d -- Divide-and-conquer law
497−comp (Fork a b) c = Fork (comp a c) (comp b c) -- Fork fusion law
498−comp c (Join a b) = Join (comp c a) (comp c b) -- Join fusion law
499−{-# NOINLINE comp #-}
500−{-# RULES
501− "comp/iden1" forall m. comp m iden = m ;
502− "comp/iden2" forall m. comp iden m = m
503−#-}
504−
505−-- Scalar multiplication of matrices
506−
507−infixl 7 .|
508−-- | Scalar multiplication of matrices.
509−(.|) :: Num e => e -> Matrix e cols rows -> Matrix e cols rows
510−(.|) e (One a) = One (e * a)
511−(.|) e (Join a b) = Join (e .| a) (e .| b)
512−(.|) e (Fork a b) = Fork (e .| a) (e .| b)
513−
514−-- Scalar division of matrices
515−
516−infixl 7 ./
517−-- | Scalar multiplication of matrices.
518−(./) :: Fractional e => Matrix e cols rows -> e -> Matrix e cols rows
519−(./) (One a) e = One (a / e)
520−(./) (Join a b) e = Join (a ./ e) (b ./ e)
521−(./) (Fork a b) e = Fork (a ./ e) (b ./ e)
502+comp Empty Empty = Empty
503+comp (One a) (One b) = One (a * b)
504+comp (Junc a b) (Split c d) = comp a c + comp b d -- Divide-and-conquer law
505+comp (Split a b) c = Split (comp a c) (comp b c) -- Split fusion law
506+comp c (Junc a b) = Junc (comp c a) (comp c b) -- Junc fusion law
522507
523508-- Projections
524509
525510-- | Biproduct first component projection
526−p1 :: (Num e, CountableDims n m, FL n m, FL m m) => Matrix e (Either m n) m
527−p1 = join id zeros
511+p1 :: forall e m n. (Num e, KnownNat (Count n), KnownNat (Count m), FromLists e n m, FromLists e m m) => Matrix e (Either m n) m
512+p1 =
513+ let iden = identity :: Matrix e m m
514+ zero = zeros :: Matrix e n m
515+ in junc iden zero
528516
529517-- | Biproduct second component projection
530−p2 :: (Num e, CountableDims n m, FL m n, FL n n) => Matrix e (Either m n) n
531−p2 = join zeros id
518+p2 :: forall e m n. (Num e, KnownNat (Count n), KnownNat (Count m), FromLists e m n, FromLists e n n) => Matrix e (Either m n) n
519+p2 =
520+ let iden = identity :: Matrix e n n
521+ zero = zeros :: Matrix e m n
522+ in junc zero iden
532523
533524-- Injections
534525
535526-- | Biproduct first component injection
536−i1 :: (Num e, CountableDims n m, FL n m, FL m m) => Matrix e m (Either m n)
527+i1 :: (Num e, KnownNat (Count n), KnownNat (Count m), FromLists e n m, FromLists e m m) => Matrix e m (Either m n)
537528i1 = tr p1
538529
539530-- | Biproduct second component injection
540−i2 :: (Num e, CountableDims n m, FL m n, FL n n) => Matrix e n (Either m n)
531+i2 :: (Num e, KnownNat (Count n), KnownNat (Count m), FromLists e m n, FromLists e n n) => Matrix e n (Either m n)
541532i2 = tr p2
542533
543534-- Dimensions
544535
545536-- | Obtain the number of rows.
546537--
547−-- NOTE: The 'KnownNat' constraint is needed in order to obtain the
548−-- dimensions in constant time. For a version that doesn't require the
549−-- constraint see 'rows''.
550−rows :: forall e cols rows. (Countable rows) => Matrix e cols rows -> Int
551−rows _ = fromInteger $ natVal (Proxy :: Proxy (Count rows))
552−
553−-- | Obtain the number of rows in an inefficient manner, but without any
554−-- constraints.
538+-- NOTE: The 'KnownNat' constaint is needed in order to obtain the
539+-- dimensions in constant time.
555540--
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
541+-- TODO: A 'rows' function that does not need the 'KnownNat' constraint in
542+-- exchange for performance.
543+rows :: forall e cols rows. (KnownNat (Count rows)) => Matrix e cols rows -> Int
544+rows _ = fromInteger $ natVal (Proxy :: Proxy (Count rows))
561545
562546-- | Obtain the number of columns.
547+--
548+-- NOTE: The 'KnownNat' constaint is needed in order to obtain the
549+-- dimensions in constant time.
563550--
564−-- NOTE: The 'KnownNat' constraint is needed in order to obtain the
565−-- dimensions in constant time. For a version that doesn't require the
566−-- constraint see 'columns''.
567−columns :: forall e cols rows. (Countable cols) => Matrix e cols rows -> Int
551+-- TODO: A 'columns' function that does not need the 'KnownNat' constraint in
552+-- exchange for performance.
553+columns :: forall e cols rows. (KnownNat (Count cols)) => Matrix e cols rows -> Int
568554columns _ = fromInteger $ natVal (Proxy :: Proxy (Count cols))
569555
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−
579556-- Coproduct Bifunctor
580557
581558infixl 5 -|-
@@ -584,172 +561,157 @@ infixl 5 -|-
584561(-|-) ::
585562 forall e n k m j.
586563 ( Num e,
587− CountableDims j k,
588− FL k k,
589− FL j k,
590− FL k j,
591− FL j j
564+ KnownNat (Count j),
565+ KnownNat (Count k),
566+ FromLists e k k,
567+ FromLists e j k,
568+ FromLists e k j,
569+ FromLists e j j
592570 ) =>
593571 Matrix e n k ->
594572 Matrix e m j ->
595573 Matrix e (Either n m) (Either k j)
596−(-|-) a b = Join (i1 . a) (i2 . b)
574+(-|-) a b = Junc (i1 . a) (i2 . b)
597575
598576-- Khatri Rao Product and projections
599577
600578-- | Khatri Rao product first component projection matrix.
601−fstM ::
579+kp1 ::
602580 forall e m k .
603581 ( Num e,
604− CountableDims k m,
605− FL (Normalize (m, k)) m,
606− CountableN (m, k)
582+ KnownNat (Count k),
583+ FromLists e (FromNat (Count m * Count k)) m,
584+ KnownNat (Count m),
585+ KnownNat (Count (Normalize (m, k)))
607586 ) => Matrix e (Normalize (m, k)) m
608−fstM = matrixBuilder' f
587+kp1 = matrixBuilder f
609588 where
610589 offset = fromInteger (natVal (Proxy :: Proxy (Count k)))
611590 f (x, y)
612591 | y >= (x * offset) && y <= (x * offset + offset - 1) = 1
613− | otherwise = 0
592+ | otherwise = 0
614593
615594-- | Khatri Rao product second component projection matrix.
616−sndM ::
595+kp2 ::
617596 forall e m k .
618597 ( Num e,
619− CountableDims k m,
620− FL (Normalize (m, k)) k,
621− CountableN (m, k)
598+ KnownNat (Count k),
599+ FromLists e (FromNat (Count m * Count k)) k,
600+ KnownNat (Count m),
601+ KnownNat (Count (Normalize (m, k)))
622602 ) => Matrix e (Normalize (m, k)) k
623−sndM = matrixBuilder' f
603+kp2 = matrixBuilder f
624604 where
625605 offset = fromInteger (natVal (Proxy :: Proxy (Count k)))
626606 f (x, y)
627607 | x == y || mod (y - x) offset == 0 = 1
628− | otherwise = 0
608+ | otherwise = 0
629609
630610-- | Khatri Rao Matrix product also known as matrix pairing.
631611--
632612-- NOTE: That this is not a true categorical product, see for instance:
633−--
613+--
634614-- @
635−-- | fstM . kr a b == a
636−-- kr a b ==> |
637−-- | sndM . kr a b == b
615+-- | kp1 . khatri a b == a
616+-- khatri a b ==> |
617+-- | kp2 . khatri a b == b
638618-- @
639619--
640620-- __Emphasis__ on the implication symbol.
641−kr ::
642− forall e cols a b.
621+khatri ::
622+ forall e cols a b.
643623 ( Num e,
644− CountableDims a b,
645− CountableN (a, b),
646− FL (Normalize (a, b)) a,
647− FL (Normalize (a, b)) b
624+ KnownNat (Count a),
625+ KnownNat (Count b),
626+ KnownNat (Count (Normalize (a, b))),
627+ FromLists e (Normalize (a, b)) a,
628+ FromLists e (Normalize (a, b)) b
648629 ) => Matrix e cols a -> Matrix e cols b -> Matrix e cols (Normalize (a, b))
649−kr a b =
650− let fstM' = fstM @e @a @b
651− sndM' = sndM @e @a @b
652− in (tr fstM' . a) * (tr sndM' . b)
630+khatri a b =
631+ let kp1' = kp1 @e @a @b
632+ kp2' = kp2 @e @a @b
633+ in (tr kp1') . a * (tr kp2') . b
653634
654635-- Product Bifunctor (Kronecker)
655636
656637infixl 4 ><
657638
658639-- | Matrix product functor also known as kronecker product
659−(><) ::
660− forall e m p n q.
640+(><) ::
641+ forall e m p n q.
661642 ( Num e,
662− CountableDims m n,
663− CountableDims p q,
664− CountableDimsN (m, n) (p, q),
665− FL (Normalize (m, n)) m,
666− FL (Normalize (m, n)) n,
667− FL (Normalize (p, q)) p,
668− FL (Normalize (p, q)) q
669− )
643+ KnownNat (Count m),
644+ KnownNat (Count n),
645+ KnownNat (Count p),
646+ KnownNat (Count q),
647+ KnownNat (Count (Normalize (m, n))),
648+ FromLists e (Normalize (m, n)) m,
649+ FromLists e (Normalize (m, n)) n,
650+ KnownNat (Count (Normalize (p, q))),
651+ FromLists e (Normalize (p, q)) p,
652+ FromLists e (Normalize (p, q)) q
653+ )
670654 => Matrix e m p -> Matrix e n q -> Matrix e (Normalize (m, n)) (Normalize (p, q))
671655(><) a b =
672− let fstM' = fstM @e @m @n
673− sndM' = sndM @e @m @n
674− in kr (a . fstM') (b . sndM')
656+ let kp1' = kp1 @e @m @n
657+ kp2' = kp2 @e @m @n
658+ in khatri (a . kp1') (b . kp2')
675659
676−-- Matrix abide Join Fork
660+-- Matrix abide Junc Split
677661
678−-- | Matrix "abiding" following the 'Join'-'Fork' exchange law.
679−--
662+-- | Matrix "abiding" followin the 'Junc'-'Split' abide law.
663+--
680664-- Law:
681665--
682666-- @
683−-- 'Join' ('Fork' a c) ('Fork' b d) == 'Fork' ('Join' a b) ('Join' c d)
667+-- 'Junc' ('Split' a c) ('Split' b d) == 'Split' ('Junc' a b) ('Junc' c d)
684668-- @
685−abideJF :: Matrix e cols rows -> Matrix e cols rows
686−abideJF (Join (Fork a c) (Fork b d)) = Fork (Join (abideJF a) (abideJF b)) (Join (abideJF c) (abideJF d)) -- Join-Fork abide law
687−abideJF (One e) = One e
688−abideJF (Join a b) = Join (abideJF a) (abideJF b)
689−abideJF (Fork a b) = Fork (abideJF a) (abideJF b)
669+abideJS :: Matrix e cols rows -> Matrix e cols rows
670+abideJS (Junc (Split a c) (Split b d)) = Split (Junc (abideJS a) (abideJS b)) (Junc (abideJS c) (abideJS d)) -- Junc-Split abide law
671+abideJS Empty = Empty
672+abideJS (One e) = One e
673+abideJS (Junc a b) = Junc (abideJS a) (abideJS b)
674+abideJS (Split a b) = Split (abideJS a) (abideJS b)
690675
691−-- Matrix abide Fork Join
676+-- Matrix abide Split Junc
692677
693−-- | Matrix "abiding" followin the 'Fork'-'Join' abide law.
694−--
678+-- | Matrix "abiding" followin the 'Split'-'Junc' abide law.
679+--
695680-- @
696−-- 'Fork' ('Join' a b) ('Join' c d) == 'Join' ('Fork' a c) ('Fork' b d)
681+-- 'Split' ('Junc' a b) ('Junc' c d) == 'Junc' ('Split' a c) ('Split' b d)
697682-- @
698−abideFJ :: Matrix e cols rows -> Matrix e cols rows
699−abideFJ (Fork (Join a b) (Join c d)) = Join (Fork (abideFJ a) (abideFJ c)) (Fork (abideFJ b) (abideFJ d)) -- Fork-Join abide law
700−abideFJ (One e) = One e
701−abideFJ (Join a b) = Join (abideFJ a) (abideFJ b)
702−abideFJ (Fork a b) = Fork (abideFJ a) (abideFJ b)
683+abideSJ :: Matrix e cols rows -> Matrix e cols rows
684+abideSJ (Split (Junc a b) (Junc c d)) = Junc (Split (abideSJ a) (abideSJ c)) (Split (abideSJ b) (abideSJ d)) -- Split-Junc abide law
685+abideSJ Empty = Empty
686+abideSJ (One e) = One e
687+abideSJ (Junc a b) = Junc (abideSJ a) (abideSJ b)
688+abideSJ (Split a b) = Split (abideSJ a) (abideSJ b)
703689
704690-- Matrix transposition
705691
706692-- | Matrix transposition.
707693tr :: Matrix e cols rows -> Matrix e rows cols
708−tr (One e) = One e
709−tr (Join a b) = Fork (tr a) (tr b)
710−tr (Fork a b) = Join (tr a) (tr b)
694+tr Empty = Empty
695+tr (One e) = One e
696+tr (Junc a b) = Split (tr a) (tr b)
697+tr (Split a b) = Junc (tr a) (tr b)
711698
712699-- Selective 'select' operator
713700
714701-- | Selective functors 'select' operator equivalent inspired by the
715702-- 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
717−select (Fork a b) y = y . a + b -- Divide-and-conquer law
718−select (Join (Fork a c) (Fork b d)) y = join (y . a + c) (y . b + d) -- Pattern matching + DnC law
719−select m y = join y id . m
720−
721−branch ::
722− ( Num e,
723− CountableDims a b,
724− CountableDims c (Either b c),
725− FL c b,
726− FL a b,
727− FL a a,
728− FL b b,
729− FL c c,
730− FL b a,
731− FL b c,
732− FL (Either b c) b,
733− FL (Either b c) c
734− )
735− => Matrix e cols (Either a b) -> Matrix e a c -> Matrix e b c -> Matrix e cols c
736−branch x l r = f x `select` g l `select` r
737− 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)
739− => Matrix e cols (Either a b) -> Matrix e cols (Either a (Either b c))
740− f m = fork (tr i1) (i1 . tr i2) . m
741− g :: (Num e, CountableDims b c, FL b c, FL c c) => Matrix e a c -> Matrix e a (Either b c)
742− g m = i2 . m
703+select :: (Num e, FromLists e b b, KnownNat (Count b)) => Matrix e cols (Either a b) -> Matrix e a b -> Matrix e cols b
704+select m y = junc y identity . m
743705
744706-- McCarthy's Conditional
745707
746708-- | McCarthy's Conditional expresses probabilistic choice.
747709cond ::
748− ( Trivial cols,
749− Countable cols,
750− FL () cols,
751− FL cols (),
752− FL cols cols,
710+ ( cols ~ FromNat (Count cols),
711+ KnownNat (Count cols),
712+ FromLists e () cols,
713+ FromLists e cols (),
714+ FromLists e cols cols,
753715 Bounded a,
754716 Enum a,
755717 Num e,
@@ -757,14 +719,14 @@ cond ::
757719 )
758720 =>
759721 (a -> Bool) -> Matrix e cols rows -> Matrix e cols rows -> Matrix e cols rows
760−cond p f g = join f g . grd p
761−
762−grd ::
763− ( Trivial q,
764− Countable q,
765− FL () q,
766− FL q (),
767− FL q q,
722+cond p f g = junc f g . grd p
723+
724+grd ::
725+ ( q ~ FromNat (Count q),
726+ KnownNat (Count q),
727+ FromLists e () q,
728+ FromLists e q (),
729+ FromLists e q q,
768730 Bounded a,
769731 Enum a,
770732 Num e,
@@ -772,86 +734,63 @@ grd ::
772734 )
773735 =>
774736 (a -> Bool) -> Matrix e q (Either q q)
775−grd f = fork (corr f) (corr (not . f))
776−
777−corr ::
778− forall e a q .
779− ( Trivial q,
780− Countable q,
781− FL () q,
782− FL q (),
783− FL q q,
784− Liftable e a Bool
785− )
737+grd f = split (corr f) (corr (not . f))
738+
739+corr ::
740+ forall e a q .
741+ ( q ~ FromNat (Count q),
742+ KnownNat (Count q),
743+ FromLists e () q,
744+ FromLists e q (),
745+ FromLists e q q,
746+ Bounded a,
747+ Enum a,
748+ Num e,
749+ Ord e
750+ )
786751 => (a -> Bool) -> Matrix e q q
787−corr p = let f = fromF' p :: Matrix e q ()
788− in kr f (id :: Matrix e q q)
752+corr p = let f = fromF p :: Matrix e q ()
753+ in khatri f (identity :: Matrix e q q)
789754
790755-- Pretty print
791756
792757prettyAux :: Show e => [[e]] -> [[e]] -> String
793758prettyAux [] _ = ""
794−prettyAux [[e]] m = "│ " ++ fill (show e) ++ " │\n"
759+prettyAux [[e]] m = "│ " ++ fill (show e) ++ " │\n"
795760 where
796761 v = fmap show m
797762 widest = maximum $ fmap length v
798763 fill str = replicate (widest - length str - 2) ' ' ++ str
799−prettyAux [h] m = "│ " ++ fill (unwords $ map show h) ++ " │\n"
764+prettyAux [h] m = "│ " ++ fill (unwords $ map show h) ++ " │\n"
800765 where
801− v = fmap show m
802− widest = maximum $ fmap length v
766+ v = fmap show m
767+ widest = maximum $ fmap length v
803768 fill str = replicate (widest - length str - 2) ' ' ++ str
804−prettyAux (h : t) l = "│ " ++ fill (unwords $ map show h) ++ " │\n" ++
769+prettyAux (h : t) l = "│ " ++ fill (unwords $ map show h) ++ " │\n" ++
805770 prettyAux t l
806771 where
807− v = fmap show l
808− widest = maximum $ fmap length v
772+ v = fmap show l
773+ widest = maximum $ fmap length v
809774 fill str = replicate (widest - length str - 2) ' ' ++ str
810775
811776-- | Matrix pretty printer
812−pretty :: (CountableDims cols rows, Show e) => Matrix e cols rows -> String
813−pretty m = concat
814− [ "┌ ", unwords (replicate (columns m) blank), " ┐\n"
815− , unlines
816− [ "│ " ++ unwords (fmap (\j -> fill $ show $ getElem i j m) [1..columns m]) ++ " │" | i <- [1..rows m] ]
817− , "└ ", unwords (replicate (columns m) blank), " ┘"
818− ]
819− where
820− strings = map show (toList m)
821− widest = maximum $ map length strings
777+pretty :: (KnownNat (Count cols), Show e) => Matrix e cols rows -> String
778+pretty m = "┌ " ++ unwords (replicate (columns m) blank) ++ " ┐\n" ++
779+ prettyAux (toLists m) (toLists m) ++
780+ "└ " ++ unwords (replicate (columns m) blank) ++ " ┘"
781+ where
782+ v = fmap show (toList m)
783+ widest = maximum $ fmap length v
822784 fill str = replicate (widest - length str) ' ' ++ str
823− blank = fill ""
824− safeGet i j m
825− | i > rows m || j > columns m || i < 1 || j < 1 = Nothing
826− | otherwise = Just $ unsafeGet i j m (toList m)
827− unsafeGet i j m l = l !! encode (columns m) (i,j)
828− encode m (i,j) = (i-1)*m + j - 1
829− getElem i j m =
830− fromMaybe
831− (error $
832− "getElem: Trying to get the "
833− ++ show (i, j)
834− ++ " element from a "
835− ++ show (rows m) ++ "x" ++ show (columns m)
836− ++ " matrix."
837− )
838− (safeGet i j m)
785+ blank = fill ""
839786
840787-- | Matrix pretty printer
841−prettyPrint :: (CountableDims cols rows, Show e) => Matrix e cols rows -> IO ()
788+prettyPrint :: (KnownNat (Count cols), Show e) => Matrix e cols rows -> IO ()
842789prettyPrint = putStrLn . pretty
843790
844−-- | Zip two matrices with a given binary function
845−zipWithM :: (e -> f -> g) -> Matrix e cols rows -> Matrix f cols rows -> Matrix g cols rows
846−zipWithM f (One a) (One b) = One (f a b)
847−zipWithM f (Join a b) (Join c d) = Join (zipWithM f a c) (zipWithM f b d)
848−zipWithM f (Fork a b) (Fork c d) = Fork (zipWithM f a c) (zipWithM f b d)
849−zipWithM f x@(Fork _ _) y@(Join _ _) = zipWithM f x (abideJF y)
850−zipWithM f x@(Join _ _) y@(Fork _ _) = zipWithM f (abideJF x) y
851−
852791-- Relational operators functions
853792
854−type Boolean = Natural 0 1
793+type Boolean = Natural 0 1
855794type Relation a b = Matrix Boolean a b
856795
857796-- | Helper conversion function
@@ -867,47 +806,54 @@ fromBool False = nat 0
867806
868807-- | Relational negation
869808negateM :: Relation cols rows -> Relation cols rows
870−negateM (One (Nat p)) = One (Nat (negate p))
871−negateM (Join a b) = Join (negateM a) (negateM b)
872−negateM (Fork a b) = Fork (negateM a) (negateM b)
809+negateM Empty = Empty
810+negateM (One (Nat 0)) = One (Nat 1)
811+negateM (One (Nat 1)) = One (Nat 0)
812+negateM (Junc a b) = Junc (negateM a) (negateM b)
813+negateM (Split a b) = Split (negateM a) (negateM b)
873814
874815-- | Relational addition
875816orM :: Relation cols rows -> Relation cols rows -> Relation cols rows
876−orM (One a) (One b) = One (fromBool (toBool a || toBool b))
877−orM (Join a b) (Join c d) = Join (orM a c) (orM b d)
878−orM (Fork a b) (Fork c d) = Fork (orM a c) (orM b d)
879−orM x@(Fork _ _) y@(Join _ _) = orM x (abideJF y)
880−orM x@(Join _ _) y@(Fork _ _) = orM (abideJF x) y
817+orM Empty Empty = Empty
818+orM (One a) (One b) = One (fromBool (toBool a || toBool b))
819+orM (Junc a b) (Junc c d) = Junc (orM a c) (orM b d)
820+orM (Split a b) (Split c d) = Split (orM a c) (orM b d)
821+orM x@(Split _ _) y@(Junc _ _) = orM x (abideJS y)
822+orM x@(Junc _ _) y@(Split _ _) = orM (abideJS x) y
881823
882824-- | Relational multiplication
883825andM :: Relation cols rows -> Relation cols rows -> Relation cols rows
884−andM (One a) (One b) = One (fromBool (toBool a && toBool b))
885−andM (Join a b) (Join c d) = Join (andM a c) (andM b d)
886−andM (Fork a b) (Fork c d) = Fork (andM a c) (andM b d)
887−andM x@(Fork _ _) y@(Join _ _) = andM x (abideJF y)
888−andM x@(Join _ _) y@(Fork _ _) = andM (abideJF x) y
826+andM Empty Empty = Empty
827+andM (One a) (One b) = One (fromBool (toBool a && toBool b))
828+andM (Junc a b) (Junc c d) = Junc (andM a c) (andM b d)
829+andM (Split a b) (Split c d) = Split (andM a c) (andM b d)
830+andM x@(Split _ _) y@(Junc _ _) = andM x (abideJS y)
831+andM x@(Junc _ _) y@(Split _ _) = andM (abideJS x) y
889832
890833-- | Relational subtraction
891834subM :: Relation cols rows -> Relation cols rows -> Relation cols rows
892−subM (One a) (One b) = if a - b < nat 0 then One (nat 0) else One (a - b)
893−subM (Join a b) (Join c d) = Join (subM a c) (subM b d)
894−subM (Fork a b) (Fork c d) = Fork (subM a c) (subM b d)
895−subM x@(Fork _ _) y@(Join _ _) = subM x (abideJF y)
896−subM x@(Join _ _) y@(Fork _ _) = subM (abideJF x) y
835+subM Empty Empty = Empty
836+subM (One a) (One b) = if a - b < nat 0 then One (nat 0) else One (a - b)
837+subM (Junc a b) (Junc c d) = Junc (subM a c) (subM b d)
838+subM (Split a b) (Split c d) = Split (subM a c) (subM b d)
839+subM x@(Split _ _) y@(Junc _ _) = subM x (abideJS y)
840+subM x@(Junc _ _) y@(Split _ _) = subM (abideJS x) y
897841
898842-- | Matrix relational composition.
899843compRel :: Relation cr rows -> Relation cols cr -> Relation cols rows
900−compRel (One a) (One b) = One (fromBool (toBool a && toBool b))
901−compRel (Join a b) (Fork c d) = orM (compRel a c) (compRel b d) -- Divide-and-conquer law
902−compRel (Fork a b) c = Fork (compRel a c) (compRel b c) -- Fork fusion law
903−compRel c (Join a b) = Join (compRel c a) (compRel c b) -- Join fusion law
844+compRel Empty Empty = Empty
845+compRel (One a) (One b) = One (fromBool (toBool a && toBool b))
846+compRel (Junc a b) (Split c d) = orM (compRel a c) (compRel b d) -- Divide-and-conquer law
847+compRel (Split a b) c = Split (compRel a c) (compRel b c) -- Split fusion law
848+compRel c (Junc a b) = Junc (compRel c a) (compRel c b) -- Junc fusion law
904849
905850-- | Matrix relational right division
906851divR :: Relation b c -> Relation b a -> Relation a c
852+divR Empty Empty = Empty
907853divR (One a) (One b) = One (fromBool (not (toBool b) || toBool a)) -- b implies a
908−divR (Join a b) (Join c d) = andM (divR a c) (divR b d)
909−divR (Fork a b) c = Fork (divR a c) (divR b c)
910−divR c (Fork a b) = Join (divR c a) (divR c b)
854+divR (Junc a b) (Junc c d) = andM (divR a c) (divR b d)
855+divR (Split a b) c = Split (divR a c) (divR b c)
856+divR c (Split a b) = Junc (divR c a) (divR c b)
911857
912858-- | Matrix relational left division
913859divL :: Relation c b -> Relation a b -> Relation a c
@@ -923,52 +869,97 @@ divS s r = divL r s `intersection` divR (tr r) (tr s)
923869--
924870-- NOTE: Be careful to not ask for a relation bigger than the cardinality of
925871-- types @a@ or @b@ allows.
926−fromFRel' ::
872+fromFRel ::
927873 forall a b cols rows.
928− ( Liftable Boolean a b,
929− CountableDims cols rows,
930− FL rows cols
874+ ( Bounded a,
875+ Bounded b,
876+ Enum a,
877+ Enum b,
878+ Eq b,
879+ KnownNat (Count cols),
880+ KnownNat (Count rows),
881+ FromLists (Natural 0 1) rows cols
931882 ) =>
932883 (a -> b) ->
933884 Relation cols rows
934−fromFRel' = fromF'
885+fromFRel f =
886+ let minA = minBound @a
887+ maxA = maxBound @a
888+ minB = minBound @b
889+ maxB = maxBound @b
890+ ccols = fromInteger $ natVal (Proxy :: Proxy (Count cols))
891+ rrows = fromInteger $ natVal (Proxy :: Proxy (Count rows))
892+ elementsA = take ccols [minA .. maxA]
893+ elementsB = take rrows [minB .. maxB]
894+ combinations = (,) <$> elementsA <*> elementsB
895+ combAp = map snd . sort . map (\(a, b) -> if f a == b
896+ then ((fromEnum a, fromEnum b), nat 1)
897+ else ((fromEnum a, fromEnum b), nat 0)) $ combinations
898+ mList = buildList combAp rrows
899+ in tr $ fromLists mList
900+ where
901+ buildList [] _ = []
902+ buildList l r = take r l : buildList (drop r l) r
935903
936904-- | Lifts functions to relations with dimensions matching @a@ and @b@
937905-- cardinality's.
938−fromFRel ::
906+fromFRel' ::
939907 forall a b.
940− ( Liftable Boolean a b,
941− CountableDimsN a b,
942− FLN b a
908+ ( Bounded a,
909+ Bounded b,
910+ Enum a,
911+ Enum b,
912+ Eq b,
913+ KnownNat (Count (Normalize a)),
914+ KnownNat (Count (Normalize b)),
915+ FromLists (Natural 0 1) (Normalize b) (Normalize a)
943916 ) =>
944917 (a -> b) ->
945918 Relation (Normalize a) (Normalize b)
946−fromFRel = fromFRel'
919+fromFRel' f =
920+ let minA = minBound @a
921+ maxA = maxBound @a
922+ minB = minBound @b
923+ maxB = maxBound @b
924+ ccols = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize a)))
925+ rrows = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize b)))
926+ elementsA = take ccols [minA .. maxA]
927+ elementsB = take rrows [minB .. maxB]
928+ combinations = (,) <$> elementsA <*> elementsB
929+ combAp = map snd . sort . map (\(a, b) -> if f a == b
930+ then ((fromEnum a, fromEnum b), nat 1)
931+ else ((fromEnum a, fromEnum b), nat 0)) $ combinations
932+ mList = buildList combAp rrows
933+ in tr $ fromLists mList
934+ where
935+ buildList [] _ = []
936+ buildList l r = take r l : buildList (drop r l) r
947937
948938-- | Lifts a relation function to a Boolean Matrix
949−toRel ::
939+toRel ::
950940 forall a b.
951941 ( Bounded a,
952942 Bounded b,
953943 Enum a,
954944 Enum b,
955945 Eq b,
956− CountableDims a b,
957− FLN b a
958− )
946+ KnownNat (Count (Normalize a)),
947+ KnownNat (Count (Normalize b)),
948+ FromLists (Natural 0 1) (Normalize b) (Normalize a)
949+ )
959950 => (a -> b -> Bool) -> Relation (Normalize a) (Normalize b)
960951toRel f =
961952 let minA = minBound @a
962953 maxA = maxBound @a
963954 minB = minBound @b
964955 maxB = maxBound @b
965− ccols = fromInteger $ natVal (Proxy :: Proxy (Count a))
966− rrows = fromInteger $ natVal (Proxy :: Proxy (Count b))
956+ ccols = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize a)))
957+ rrows = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize b)))
967958 elementsA = take ccols [minA .. maxA]
968959 elementsB = take rrows [minB .. maxB]
969960 combinations = (,) <$> elementsA <*> elementsB
970− combAp = map snd . sort . map (\(a, b) -> if uncurry f (a, b)
971− then ((fromEnum a, fromEnum b), nat 1)
961+ combAp = map snd . sort . map (\(a, b) -> if uncurry f (a, b)
962+ then ((fromEnum a, fromEnum b), nat 1)
972963 else ((fromEnum a, fromEnum b), nat 0)) $ combinations
973964 mList = buildList combAp rrows
974965 in tr $ fromLists mList
src/LAoP/Matrix/Nat.hs+187−194
@@ -1,4 +1,3 @@
1−{-# LANGUAGE ConstraintKinds #-}
21{-# LANGUAGE AllowAmbiguousTypes #-}
32{-# LANGUAGE DataKinds #-}
43{-# LANGUAGE DerivingVia #-}
@@ -54,22 +53,11 @@ module LAoP.Matrix.Nat
5453 -- * Type safe matrix representation
5554 Matrix (..),
5655
57− -- * Constraint type synonyms
58− Countable,
59− CountableDims,
60− CountableN,
61− CountableNz,
62− CountableDimsN,
63− FLN,
64− FLNz,
65− Liftable,
66− TrivialE,
67− TrivialP,
68−
6956 -- * Primitives
57+ empty,
7058 one,
71− join,
72− fork,
59+ junc,
60+ split,
7361
7462 -- * Auxiliary type families
7563 I.FromNat,
@@ -77,11 +65,11 @@ module LAoP.Matrix.Nat
7765 I.Normalize,
7866
7967 -- * Matrix construction and conversion
80− I.FL,
68+ I.FromLists,
8169 fromLists,
8270 toLists,
8371 toList,
84− matrixBuilder',
72+ matrixBuilder,
8573 row,
8674 col,
8775 zeros,
@@ -97,10 +85,6 @@ module LAoP.Matrix.Nat
9785 -- ** Matrix Transposition
9886 tr,
9987
100− -- ** Scalar multiplication/division of matrices
101− (.|),
102− (./),
103−
10488 -- ** Selective operator
10589 select,
10690
@@ -108,19 +92,16 @@ module LAoP.Matrix.Nat
10892 cond,
10993
11094 -- ** Matrix "abiding"
111− abideJF,
112− abideFJ,
113−
114− -- ** Zip Matrices
115− zipWithM,
95+ abideJS,
96+ abideSJ,
11697
11798 -- * Biproduct approach
118− -- ** Fork
99+ -- ** Split
119100 (===),
120101 -- *** Projections
121102 p1,
122103 p2,
123− -- ** Join
104+ -- ** Junc
124105 (|||),
125106 -- *** Injections
126107 i1,
@@ -134,11 +115,11 @@ module LAoP.Matrix.Nat
134115 -- | Note that given the restrictions imposed it is not possible to
135116 -- implement the standard type classes present in standard Haskell.
136117 -- *** Matrix pairing projections
137− fstM,
138− sndM,
118+ kp1,
119+ kp2,
139120
140121 -- *** Matrix pairing
141− kr,
122+ khatri,
142123
143124 -- * Matrix composition and lifting
144125
@@ -146,10 +127,10 @@ module LAoP.Matrix.Nat
146127
147128 -- | Note that given the restrictions imposed it is not possible to
148129 -- implement the standard type classes present in standard Haskell.
149− iden,
130+ identity,
150131 comp,
151− fromF',
152132 fromF,
133+ fromF',
153134
154135 -- * Matrix printing
155136 pretty,
@@ -160,95 +141,107 @@ where
160141import Data.Proxy
161142import GHC.TypeLits
162143import Control.DeepSeq
144+import qualified Control.Category as C
163145import qualified LAoP.Matrix.Internal as I
164146
165147newtype Matrix e (cols :: Nat) (rows :: Nat) = M (I.Matrix e (I.FromNat cols) (I.FromNat rows))
166148 deriving (Show, Num, Eq, Ord, NFData) via (I.Matrix e (I.FromNat cols) (I.FromNat rows))
167149
168−-- | Constraint type synonyms to keep the type signatures less convoluted
169−type Countable a = KnownNat (I.Count a)
170−type CountableDims a b = (Countable a, Countable b)
171−type CountableN a = KnownNat (I.Count (I.FromNat a))
172−type CountableNz a = KnownNat (I.Count (I.Normalize a))
173−type CountableDimsN a b = (CountableN a, CountableN b)
174−type FLN e a b = I.FL (I.FromNat a) (I.FromNat b)
175−type FLNz e a b = I.FL (I.Normalize a) (I.Normalize b)
176−type Liftable e a b = (Bounded a, Bounded b, Enum a, Enum b, Eq b, Num e, Ord e)
177−type TrivialE a b = I.FromNat (a + b) ~ Either (I.FromNat a) (I.FromNat b)
178−type TrivialP a b = I.FromNat (a * b) ~ I.FromNat (I.Count (I.FromNat a) * I.Count (I.FromNat b))
150+-- | It isn't possible to implement the 'id' function so it's
151+-- implementation is 'undefined'. However 'comp' can be and this partial
152+-- class implementation exists just to make the code more readable.
153+--
154+-- Please use 'identity' instead.
155+instance (Num e) => C.Category (Matrix e) where
156+ id = undefined
157+ (.) = comp
179158
180159-- Primitives
181160
161+empty :: Matrix e 0 0
162+empty = M I.Empty
163+
182164one :: e -> Matrix e 1 1
183165one = M . I.One
184166
185−join ::
186− (TrivialE a b) =>
187− Matrix e a rows ->
188− Matrix e b rows ->
189− Matrix e (a + b) rows
190−join (M a) (M b) = M (I.Join a b)
167+junc ::
168+ (I.FromNat cols3 ~ Either (I.FromNat cols1) (I.FromNat cols2)) =>
169+ Matrix e cols1 rows ->
170+ Matrix e cols2 rows ->
171+ Matrix e cols3 rows
172+junc (M a) (M b) = M (I.Junc a b)
191173
192174infixl 3 |||
193175(|||) ::
194− (TrivialE a b) =>
195− Matrix e a rows ->
196− Matrix e b rows ->
197− Matrix e (a + b) rows
198−(|||) = join
199−
200−fork ::
201− (TrivialE a b) =>
202− Matrix e cols a ->
203− Matrix e cols b ->
204− Matrix e cols (a + b)
205−fork (M a) (M b) = M (I.Fork a b)
176+ (I.FromNat cols3 ~ Either (I.FromNat cols1) (I.FromNat cols2)) =>
177+ Matrix e cols1 rows ->
178+ Matrix e cols2 rows ->
179+ Matrix e cols3 rows
180+(|||) = junc
181+
182+split ::
183+ (I.FromNat rows3 ~ Either (I.FromNat rows1) (I.FromNat rows2)) =>
184+ Matrix e cols rows1 ->
185+ Matrix e cols rows2 ->
186+ Matrix e cols rows3
187+split (M a) (M b) = M (I.Split a b)
206188
207189infixl 2 ===
208190(===) ::
209− (TrivialE a b) =>
210− Matrix e cols a ->
211− Matrix e cols b ->
212− Matrix e cols (a + b)
213−(===) = fork
191+ (I.FromNat rows3 ~ Either (I.FromNat rows1) (I.FromNat rows2)) =>
192+ Matrix e cols rows1 ->
193+ Matrix e cols rows2 ->
194+ Matrix e cols rows3
195+(===) = split
214196
215197-- Construction
216198
217−fromLists :: (FLN e cols rows) => [[e]] -> Matrix e cols rows
199+fromLists :: (I.FromLists e (I.FromNat cols) (I.FromNat rows)) => [[e]] -> Matrix e cols rows
218200fromLists = M . I.fromLists
219201
220−-- | Matrix builder function. Constructs a matrix provided with
221−-- a construction function that operates with indices.
222−matrixBuilder' ::
223− (FLN e cols rows, CountableN cols, CountableN rows)
224− => ((Int, Int) -> e) -> Matrix e cols rows
225−matrixBuilder' = M . I.matrixBuilder'
202+matrixBuilder ::
203+ (I.FromLists e (I.FromNat cols) (I.FromNat rows), KnownNat (I.Count (I.FromNat cols)), KnownNat (I.Count (I.FromNat rows))) =>
204+ ((Int, Int) -> e) ->
205+ Matrix e cols rows
206+matrixBuilder = M . I.matrixBuilder
226207
227−col :: (I.FL () (I.FromNat rows)) => [e] -> Matrix e 1 rows
208+col :: (I.FromLists e () (I.FromNat rows)) => [e] -> Matrix e 1 rows
228209col = M . I.col
229210
230−row :: (I.FL (I.FromNat cols) ()) => [e] -> Matrix e cols 1
211+row :: (I.FromLists e (I.FromNat cols) ()) => [e] -> Matrix e cols 1
231212row = M . I.row
232213
233−fromF' ::
234− ( Liftable e a b,
235− CountableN cols,
236− CountableN rows,
237− FLN e rows cols
214+fromF ::
215+ ( Bounded a,
216+ Bounded b,
217+ Enum a,
218+ Enum b,
219+ Eq b,
220+ Num e,
221+ Ord e,
222+ KnownNat (I.Count (I.FromNat cols)),
223+ KnownNat (I.Count (I.FromNat rows)),
224+ I.FromLists e (I.FromNat rows) (I.FromNat cols)
238225 ) =>
239226 (a -> b) ->
240227 Matrix e cols rows
241−fromF' = M . I.fromF'
228+fromF = M . I.fromF
242229
243−fromF ::
244− ( Liftable e a b,
245− CountableNz a,
246− CountableNz b,
247− FLNz e b a
230+fromF' ::
231+ ( Bounded a,
232+ Bounded b,
233+ Enum a,
234+ Enum b,
235+ Eq b,
236+ Num e,
237+ Ord e,
238+ KnownNat (I.Count (I.Normalize a)),
239+ KnownNat (I.Count (I.Normalize b)),
240+ I.FromLists e (I.Normalize b) (I.Normalize a)
248241 ) =>
249242 (a -> b) ->
250243 Matrix e (I.Count a) (I.Count b)
251−fromF = undefined -- M . I.fromF
244+fromF' = M . I.fromF'
252245
253246-- Conversion
254247
@@ -261,21 +254,21 @@ toList (M m) = I.toList m
261254-- Zeros Matrix
262255
263256zeros ::
264− (Num e, FLN e cols rows, CountableN cols, CountableN rows) =>
257+ (Num e, I.FromLists e (I.FromNat cols) (I.FromNat rows), KnownNat (I.Count (I.FromNat cols)), KnownNat (I.Count (I.FromNat rows))) =>
265258 Matrix e cols rows
266259zeros = M I.zeros
267260
268261-- Ones Matrix
269262
270263ones ::
271− (Num e, FLN e cols rows, CountableN cols, CountableN rows) =>
264+ (Num e, I.FromLists e (I.FromNat cols) (I.FromNat rows), KnownNat (I.Count (I.FromNat cols)), KnownNat (I.Count (I.FromNat rows))) =>
272265 Matrix e cols rows
273266ones = M I.ones
274267
275268-- Const Matrix
276269
277270constant ::
278− (Num e, FLN e cols rows, CountableN cols, CountableN rows) =>
271+ (Num e, I.FromLists e (I.FromNat cols) (I.FromNat rows), KnownNat (I.Count (I.FromNat cols)), KnownNat (I.Count (I.FromNat rows))) =>
279272 e ->
280273 Matrix e cols rows
281274constant = M . I.constant
@@ -284,52 +277,40 @@ constant = M . I.constant
284277
285278bang ::
286279 forall e cols.
287− (Num e, Enum e, I.FL (I.FromNat cols) (), CountableN cols) =>
280+ (Num e, Enum e, I.FromLists e (I.FromNat cols) (), KnownNat (I.Count (I.FromNat cols))) =>
288281 Matrix e cols 1
289282bang = M I.bang
290283
291−-- iden Matrix
284+-- Identity Matrix
292285
293−iden ::
294− (Num e, FLN e cols cols, CountableN cols) =>
286+identity ::
287+ (Num e, I.FromLists e (I.FromNat cols) (I.FromNat cols), KnownNat (I.Count (I.FromNat cols))) =>
295288 Matrix e cols cols
296−iden = M I.iden
289+identity = M I.identity
297290
298291-- Matrix composition (MMM)
299292
300293comp :: (Num e) => Matrix e cr rows -> Matrix e cols cr -> Matrix e cols rows
301294comp (M a) (M b) = M (I.comp a b)
302295
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−
317296p1 ::
318297 ( Num e,
319− CountableDimsN n m,
320− FLN e n m,
321− FLN e m m,
322− TrivialE m n
298+ KnownNat (I.Count (I.FromNat n)),
299+ KnownNat (I.Count (I.FromNat m)),
300+ I.FromLists e (I.FromNat n) (I.FromNat m),
301+ I.FromLists e (I.FromNat m) (I.FromNat m),
302+ I.FromNat (m + n) ~ Either (I.FromNat m) (I.FromNat n)
323303 ) =>
324304 Matrix e (m + n) m
325305p1 = M I.p1
326306
327307p2 ::
328308 ( Num e,
329− CountableDimsN n m,
330− FLN e m n,
331− FLN e n n,
332− TrivialE m n
309+ KnownNat (I.Count (I.FromNat n)),
310+ KnownNat (I.Count (I.FromNat m)),
311+ I.FromLists e (I.FromNat m) (I.FromNat n),
312+ I.FromLists e (I.FromNat n) (I.FromNat n),
313+ I.FromNat (m + n) ~ Either (I.FromNat m) (I.FromNat n)
333314 ) =>
334315 Matrix e (m + n) n
335316p2 = M I.p2
@@ -338,125 +319,138 @@ p2 = M I.p2
338319
339320i1 ::
340321 ( Num e,
341− CountableDimsN n rows,
342− FLN e n rows,
343− FLN e rows rows,
344− TrivialE rows n
322+ KnownNat (I.Count (I.FromNat n)),
323+ KnownNat (I.Count (I.FromNat rows)),
324+ I.FromLists e (I.FromNat n) (I.FromNat rows),
325+ I.FromLists e (I.FromNat rows) (I.FromNat rows),
326+ I.FromNat (rows + n) ~ Either (I.FromNat rows) (I.FromNat n)
345327 ) =>
346328 Matrix e rows (rows + n)
347329i1 = tr p1
348330
349331i2 ::
350332 ( Num e,
351− CountableDimsN rows m,
352− FLN e m rows,
353− FLN e rows rows,
354− TrivialE m rows
333+ KnownNat (I.Count (I.FromNat rows)),
334+ KnownNat (I.Count (I.FromNat m)),
335+ I.FromLists e (I.FromNat m) (I.FromNat rows),
336+ I.FromLists e (I.FromNat rows) (I.FromNat rows),
337+ I.FromNat (m + rows) ~ Either (I.FromNat m) (I.FromNat rows)
355338 ) =>
356339 Matrix e rows (m + rows)
357340i2 = tr p2
358341
359342-- Dimensions
360343
361−rows :: (CountableN rows) => Matrix e cols rows -> Int
344+rows :: (KnownNat (I.Count (I.FromNat rows))) => Matrix e cols rows -> Int
362345rows (M m) = I.rows m
363346
364−columns :: (CountableN cols) => Matrix e cols rows -> Int
347+columns :: (KnownNat (I.Count (I.FromNat cols))) => Matrix e cols rows -> Int
365348columns (M m) = I.columns m
366349
350+-- Coproduct Bifunctor
351+
367352infixl 5 -|-
368353
369−-- | Coproduct Bifunctor (Direct sum)
370354(-|-) ::
371355 ( Num e,
372− CountableDimsN j k,
373− FLN e k k,
374− FLN e j k,
375− FLN e k j,
376− FLN e j j,
377− TrivialE n m,
378− TrivialE k j
356+ KnownNat (I.Count (I.FromNat j)),
357+ KnownNat (I.Count (I.FromNat k)),
358+ I.FromLists e (I.FromNat k) (I.FromNat k),
359+ I.FromLists e (I.FromNat j) (I.FromNat k),
360+ I.FromLists e (I.FromNat k) (I.FromNat j),
361+ I.FromLists e (I.FromNat j) (I.FromNat j),
362+ I.FromNat (n + m) ~ Either (I.FromNat n) (I.FromNat m),
363+ I.FromNat (k + j) ~ Either (I.FromNat k) (I.FromNat j)
379364 ) =>
380365 Matrix e n k ->
381366 Matrix e m j ->
382367 Matrix e (n + m) (k + j)
383368(-|-) (M a) (M b) = M ((I.-|-) a b)
384369
385−-- | Khatri Rao Product first projection
386−fstM ::
370+-- Khatri Rao Product and projections
371+
372+kp1 ::
387373 forall e m k .
388374 ( Num e,
389− CountableDimsN m k,
390− CountableN (m * k),
391− FLN e (m * k) m,
392− TrivialP m k
375+ KnownNat (I.Count (I.FromNat m)),
376+ KnownNat (I.Count (I.FromNat k)),
377+ KnownNat (I.Count (I.FromNat (m * k))),
378+ I.FromLists e (I.FromNat (m * k)) (I.FromNat m),
379+ I.FromNat (m * k) ~ I.FromNat (I.Count (I.FromNat m) * I.Count (I.FromNat k))
393380 ) => Matrix e (m * k) m
394−fstM = M (I.fstM @e @(I.FromNat m) @(I.FromNat k))
381+kp1 = M (I.kp1 @e @(I.FromNat m) @(I.FromNat k))
395382
396−-- | Khatri Rao Product second projection
397−sndM ::
383+kp2 ::
398384 forall e m k.
399385 ( Num e,
400− CountableDimsN k m,
401− FLN e (m * k) k,
402− CountableN (m * k),
403− TrivialP m k
386+ KnownNat (I.Count (I.FromNat k)),
387+ I.FromLists e (I.FromNat (m * k)) (I.FromNat k),
388+ KnownNat (I.Count (I.FromNat m)),
389+ KnownNat (I.Count (I.FromNat (m * k))),
390+ I.FromNat (m * k) ~ I.FromNat (I.Count (I.FromNat m) * I.Count (I.FromNat k))
404391 ) => Matrix e (m * k) k
405−sndM = M (I.sndM @e @(I.FromNat m) @(I.FromNat k))
392+kp2 = M (I.kp2 @e @(I.FromNat m) @(I.FromNat k))
406393
407−-- | Khatri Rao Product
408−kr ::
394+khatri ::
409395 forall e cols a b.
410396 ( Num e,
411− CountableDimsN a b,
412− CountableN (a * b),
413− FLN e (a * b) a,
414− FLN e (a * b) b,
415− TrivialP a b
397+ KnownNat (I.Count (I.FromNat a)),
398+ KnownNat (I.Count (I.FromNat b)),
399+ KnownNat (I.Count (I.FromNat (a * b))),
400+ I.FromLists e (I.FromNat (a * b)) (I.FromNat a),
401+ I.FromLists e (I.FromNat (a * b)) (I.FromNat b),
402+ I.FromNat (a * b) ~ I.FromNat (I.Count (I.FromNat a) * I.Count (I.FromNat b))
416403 ) => Matrix e cols a -> Matrix e cols b -> Matrix e cols (a * b)
417−kr a b =
418− let fstM' = fstM @e @a @b
419− sndM' = sndM @e @a @b
420− in comp (tr fstM') a * comp (tr sndM') b
404+khatri a b =
405+ let kp1' = kp1 @e @a @b
406+ kp2' = kp2 @e @a @b
407+ in comp (tr kp1') a * comp (tr kp2') b
408+
409+-- Product Bifunctor (Kronecker)
421410
422−-- | Product Bifunctor (Kronecker)
423411infixl 4 ><
424412
425413(><) ::
426414 forall e m p n q.
427415 ( Num e,
428− CountableDimsN m n,
429− CountableDimsN p q,
430− CountableDimsN (m * n) (p * q),
431− FLN e (m * n) m,
432− FLN e (m * n) n,
433− FLN e (p * q) p,
434− FLN e (p * q) q,
435− TrivialP m n,
436− TrivialP p q
416+ KnownNat (I.Count (I.FromNat m)),
417+ KnownNat (I.Count (I.FromNat n)),
418+ KnownNat (I.Count (I.FromNat p)),
419+ KnownNat (I.Count (I.FromNat q)),
420+ KnownNat (I.Count (I.FromNat (m * n))),
421+ KnownNat (I.Count (I.FromNat (p * q))),
422+ I.FromLists e (I.FromNat (m * n)) (I.FromNat m),
423+ I.FromLists e (I.FromNat (m * n)) (I.FromNat n),
424+ I.FromLists e (I.FromNat (p * q)) (I.FromNat p),
425+ I.FromLists e (I.FromNat (p * q)) (I.FromNat q),
426+ I.FromNat (m * n) ~ I.FromNat (I.Count (I.FromNat m) * I.Count (I.FromNat n)),
427+ I.FromNat (p * q) ~ I.FromNat (I.Count (I.FromNat p) * I.Count (I.FromNat q))
437428 ) => Matrix e m p -> Matrix e n q -> Matrix e (m * n) (p * q)
438429(><) a b =
439− let fstM' = fstM @e @m @n
440− sndM' = sndM @e @m @n
441− in kr (comp a fstM') (comp b sndM')
430+ let kp1' = kp1 @e @m @n
431+ kp2' = kp2 @e @m @n
432+ in khatri (comp a kp1') (comp b kp2')
433+
434+-- Matrix abide Junc Split
442435
443−-- | Matrix abide Join Fork
444−abideJF :: Matrix e cols rows -> Matrix e cols rows
445−abideJF (M m) = M (I.abideJF m)
436+abideJS :: Matrix e cols rows -> Matrix e cols rows
437+abideJS (M m) = M (I.abideJS m)
446438
447−-- | Matrix abide Fork Join
448−abideFJ :: Matrix e cols rows -> Matrix e cols rows
449−abideFJ (M m) = M (I.abideFJ m)
439+-- Matrix abide Split Junc
440+
441+abideSJ :: Matrix e cols rows -> Matrix e cols rows
442+abideSJ (M m) = M (I.abideSJ m)
443+
444+-- Matrix transposition
450445
451−-- | Matrix transposition
452446tr :: Matrix e cols rows -> Matrix e rows cols
453447tr (M m) = M (I.tr m)
454448
455449-- Selective 'select' operator
456450select ::
457451 ( Num e,
458− FLN e rows1 rows1,
459− CountableN rows1,
452+ I.FromLists e (I.FromNat rows1) (I.FromNat rows1),
453+ KnownNat (I.Count (I.FromNat rows1)),
460454 I.FromNat rows2 ~ I.FromNat rows1,
461455 I.FromNat cols1 ~ I.FromNat cols2,
462456 I.FromNat rows3 ~ Either (I.FromNat cols3) (I.FromNat rows1)
@@ -467,11 +461,14 @@ select (M m) (M y) = M (I.select m y)
467461
468462cond ::
469463 ( I.FromNat (I.Count (I.FromNat cols)) ~ I.FromNat cols,
470− CountableN cols,
471− I.FL () (I.FromNat cols),
472− I.FL (I.FromNat cols) (),
473− FLN e cols cols,
474− Liftable e a Bool
464+ KnownNat (I.Count (I.FromNat cols)),
465+ I.FromLists e () (I.FromNat cols),
466+ I.FromLists e (I.FromNat cols) (),
467+ I.FromLists e (I.FromNat cols) (I.FromNat cols),
468+ Bounded a,
469+ Enum a,
470+ Num e,
471+ Ord e
475472 )
476473 =>
477474 (a -> Bool) -> Matrix e cols rows -> Matrix e cols rows -> Matrix e cols rows
@@ -479,12 +476,8 @@ cond p (M a) (M b) = M (I.cond p a b)
479476
480477-- Pretty print
481478
482−pretty :: (CountableDimsN cols rows, Show e) => Matrix e cols rows -> String
479+pretty :: (KnownNat (I.Count (I.FromNat cols)), Show e) => Matrix e cols rows -> String
483480pretty (M m) = I.pretty m
484481
485−prettyPrint :: (CountableDimsN cols rows, Show e) => Matrix e cols rows -> IO ()
482+prettyPrint :: (KnownNat (I.Count (I.FromNat cols)), Show e) => Matrix e cols rows -> IO ()
486483prettyPrint (M m) = I.prettyPrint m
487−
488−-- | Zip two matrices with a given binary function
489−zipWithM :: (e -> f -> g) -> Matrix e cols rows -> Matrix f cols rows -> Matrix g cols rows
490−zipWithM f (M a) (M b) = M (I.zipWithM f a b)
src/LAoP/Matrix/Type.hs+240−283
@@ -1,11 +1,10 @@
1−{-# LANGUAGE ConstraintKinds #-}
2−{-# LANGUAGE TypeFamilies #-}
31{-# LANGUAGE AllowAmbiguousTypes #-}
42{-# LANGUAGE DataKinds #-}
53{-# LANGUAGE DerivingVia #-}
64{-# LANGUAGE FlexibleContexts #-}
75{-# LANGUAGE FlexibleInstances #-}
86{-# LANGUAGE GADTs #-}
7+{-# LANGUAGE KindSignatures #-}
98{-# LANGUAGE MultiParamTypeClasses #-}
109{-# LANGUAGE NoStarIsType #-}
1110{-# LANGUAGE RankNTypes #-}
@@ -56,24 +55,15 @@ module LAoP.Matrix.Type
5655 -- * Type safe matrix representation
5756 Matrix (..),
5857
59− -- * Constraint type aliases
60− Countable,
61− CountableDims,
62− CountableN,
63− CountableDimsN,
64− FLN,
65− Liftable,
66− Trivial,
67− TrivialP,
68−
6958 -- * Type aliases
7059 Zero,
7160 One,
7261
7362 -- * Primitives
63+ empty,
7464 one,
75− join,
76− fork,
65+ junc,
66+ split,
7767
7868 -- * Auxiliary type families
7969 I.FromNat,
@@ -85,27 +75,24 @@ module LAoP.Matrix.Type
8575 fromLists,
8676 toLists,
8777 toList,
88− matrixBuilder',
8978 matrixBuilder,
9079 row,
9180 col,
9281 zeros,
9382 ones,
9483 bang,
95− point,
9684 constant,
9785
9886 -- * Functor instance equivalent function
9987 fmapM,
100− bimapM,
10188
10289 -- * Applicative/Monoidal instance equivalent functions
10390 unitM,
10491 multM,
10592
10693 -- * Selective equivalent instance function
107− selectM,
108−
94+ selectM,
95+
10996 -- * Monad equivalent instance function
11097 returnM,
11198 bindM,
@@ -113,34 +100,25 @@ module LAoP.Matrix.Type
113100 -- * Misc
114101 -- ** Get dimensions
115102 columns,
116− columns',
117103 rows,
118− rows',
119104
120105 -- ** Matrix Transposition
121106 tr,
122107
123− -- ** Scalar multiplication/division of matrices
124− (.|),
125− (./),
126−
127108 -- ** McCarthy's Conditional
128109 cond,
129110
130111 -- ** Matrix "abiding"
131− abideJF,
132− abideFJ,
133−
134− -- ** Zip Matrices
135− zipWithM,
112+ abideJS,
113+ abideSJ,
136114
137115 -- * Biproduct approach
138− -- ** Fork
116+ -- ** Split
139117 (===),
140118 -- *** Projections
141119 p1,
142120 p2,
143− -- ** Join
121+ -- ** Junc
144122 (|||),
145123 -- *** Injections
146124 i1,
@@ -154,11 +132,11 @@ module LAoP.Matrix.Type
154132 -- | Note that given the restrictions imposed it is not possible to
155133 -- implement the standard type classes present in standard Haskell.
156134 -- *** Matrix pairing projections
157− fstM,
158− sndM,
135+ kp1,
136+ kp2,
159137
160138 -- *** Matrix pairing
161− kr,
139+ khatri,
162140
163141 -- * Matrix composition and lifting
164142
@@ -166,10 +144,10 @@ module LAoP.Matrix.Type
166144
167145 -- | Note that given the restrictions imposed it is not possible to
168146 -- implement the standard type classes present in standard Haskell.
169− iden,
147+ identity,
170148 comp,
171− fromF',
172149 fromF,
150+ fromF',
173151
174152 -- * Relation
175153 toRel,
@@ -183,44 +161,23 @@ where
183161import Data.Void
184162import Data.Proxy
185163import Data.Kind
186−import GHC.TypeLits
164+import GHC.TypeLits
187165import Control.DeepSeq
188166import LAoP.Utils
167+import qualified Control.Category as C
189168import qualified LAoP.Matrix.Internal as I
190−import Prelude hiding (id, (.))
191169
192170newtype Matrix e (cols :: Type) (rows :: Type) = M (I.Matrix e (I.Normalize cols) (I.Normalize rows))
193171 deriving (Show, Num, Eq, Ord, NFData) via (I.Matrix e (I.Normalize cols) (I.Normalize rows))
194172
195−-- | Constraint type synonyms to keep the type signatures less convoluted
196−type Countable a = KnownNat (I.Count a)
197−type CountableDims a b = (Countable a, Countable b)
198−type CountableN a = KnownNat (I.Count (I.Normalize a))
199−type CountableDimsN a b = (CountableN a, CountableN b)
200−type FLN a b = I.FromLists (I.Normalize a) (I.Normalize b)
201−type Liftable e a b = (Bounded a, Bounded b, Enum a, Enum b, Eq b, Num e, Ord e)
202−type Trivial a = I.Normalize (I.Normalize a) ~ I.Normalize (I.Normalize (I.Normalize a))
203−type Trivial2 a = I.Normalize a ~ I.Normalize (I.Normalize a)
204−type Trivial3 a = I.FromNat (I.Count (I.Normalize (I.Normalize a))) ~ I.Normalize (I.Normalize a)
205−type TrivialP a b = I.Normalize (a, b) ~ I.Normalize (I.Normalize a, I.Normalize b)
206−
207−-- | It is possible to implement a constrained version of the category type
208−-- class.
209−instance (Num e) => Category (Matrix e) where
210− type Object (Matrix e) a = (FLN a a, CountableN a)
211− id = iden
212− (.) = comp
213−
214−-- | Bifunctor equivalent function
215−bimapM ::
216− ( Liftable e a b,
217− Liftable e c d,
218− CountableDimsN a c,
219− CountableDimsN b d,
220− FLN d c,
221− FLN b a
222− ) => (a -> b) -> (c -> d) -> Matrix e a c -> Matrix e b d
223−bimapM f g m = fromF g . m . tr (fromF f)
173+-- | It isn't possible to implement the 'id' function so it's
174+-- implementation is 'undefined'. However 'comp' can be and this partial
175+-- class implementation exists just to make the code more readable.
176+--
177+-- Please use 'identity' instead.
178+instance (Num e) => C.Category (Matrix e) where
179+ id = undefined
180+ (.) = comp
224181
225182-- | Zero type alias
226183type Zero = Void
@@ -230,75 +187,92 @@ type One = ()
230187
231188-- Primitives
232189
190+-- | Empty matrix constructor
191+empty :: Matrix e Zero Zero
192+empty = M I.Empty
193+
233194-- | Unit matrix constructor
234195one :: e -> Matrix e One One
235196one = M . I.One
236197
237−-- | Matrix 'Join' constructor
238−join ::
198+-- | Matrix 'Junc' constructor
199+junc ::
200+ (I.Normalize (Either a b) ~ Either (I.Normalize a) (I.Normalize b)) =>
239201 Matrix e a rows ->
240202 Matrix e b rows ->
241203 Matrix e (Either a b) rows
242−join (M a) (M b) = M (I.Join a b)
204+junc (M a) (M b) = M (I.Junc a b)
243205
244206infixl 3 |||
245−-- | Matrix 'Join' constructor
207+-- | Matrix 'Junc' constructor
246208(|||) ::
209+ (I.Normalize (Either a b) ~ Either (I.Normalize a) (I.Normalize b)) =>
247210 Matrix e a rows ->
248211 Matrix e b rows ->
249212 Matrix e (Either a b) rows
250−(|||) = join
213+(|||) = junc
251214
252−-- | Matrix 'Fork' constructor
253−fork ::
215+-- | Matrix 'Split' constructor
216+split ::
217+ (I.Normalize (Either a b) ~ Either (I.Normalize a) (I.Normalize b)) =>
254218 Matrix e cols a ->
255219 Matrix e cols b ->
256220 Matrix e cols (Either a b)
257−fork (M a) (M b) = M (I.Fork a b)
221+split (M a) (M b) = M (I.Split a b)
258222
259223infixl 2 ===
260−-- | Matrix 'Fork' constructor
224+-- | Matrix 'Split' constructor
261225(===) ::
226+ (I.Normalize (Either a b) ~ Either (I.Normalize a) (I.Normalize b)) =>
262227 Matrix e cols a ->
263228 Matrix e cols b ->
264229 Matrix e cols (Either a b)
265−(===) = fork
230+(===) = split
266231
267232-- Functor hierarchy
268233
269234-- | Functor instance equivalent function
270−fmapM ::
271− ( Liftable e a b,
272− CountableDimsN a b,
273− FLN b a
235+fmapM ::
236+ ( Bounded a,
237+ Bounded b,
238+ Enum a,
239+ Enum b,
240+ Eq b,
241+ Num e,
242+ Ord e,
243+ KnownNat (I.Count (I.Normalize a)),
244+ KnownNat (I.Count (I.Normalize b)),
245+ I.FromLists e (I.Normalize b) (I.Normalize a)
274246 )
275247 =>
276248 (a -> b) -> Matrix e c a -> Matrix e c b
277−fmapM f m = fromF f . m
249+fmapM f m = fromF' f `comp` m
278250
279251-- | Applicative instance equivalent 'unit' function,
280252unitM :: (Num e) => Matrix e () ()
281253unitM = one 1
282254
283255-- | Applicative instance equivalent 'unit' function,
284−multM ::
285− ( CountableDimsN a b,
286− CountableN (a, b),
256+multM ::
257+ ( KnownNat (I.Count (I.Normalize a)),
258+ KnownNat (I.Count (I.Normalize b)),
259+ KnownNat (I.Count (I.Normalize (a, b))),
287260 Num e,
288− FLN (a, b) a,
289− FLN (a, b) b,
290− TrivialP a b
261+ I.FromLists e (I.Normalize (a, b)) (I.Normalize a),
262+ I.FromLists e (I.Normalize (a, b)) (I.Normalize b),
263+ I.Normalize (a, b) ~ I.Normalize (I.Normalize a, I.Normalize b)
291264 ) => Matrix e c a -> Matrix e c b -> Matrix e c (a, b)
292−multM = kr
265+multM a b = khatri a b
266+
293267
294268-- | Monad instance equivalent 'return' function,
295−returnM ::
296− forall e a .
297− ( Num e,
298− Enum e,
299− Enum a,
300− FLN () a,
301− Countable a
269+returnM ::
270+ forall e a .
271+ ( Num e,
272+ Enum e,
273+ Enum a,
274+ I.FromLists e () (I.Normalize a),
275+ KnownNat (I.Count a)
302276 ) => a -> Matrix e One a
303277returnM a = col l
304278 where
@@ -314,64 +288,73 @@ bindM = flip comp
314288
315289-- | Build a matrix out of a list of list of elements. Throws a runtime
316290-- error if the dimensions do not match.
317−fromLists :: (FLN cols rows) => [[e]] -> Matrix e cols rows
291+fromLists :: (I.FromLists e (I.Normalize cols) (I.Normalize rows)) => [[e]] -> Matrix e cols rows
318292fromLists = M . I.fromLists
319293
320294-- | Matrix builder function. Constructs a matrix provided with
321−-- a construction function that operates with indices.
322−matrixBuilder' ::
323− (FLN cols rows, CountableDimsN cols rows )
324− => ((Int, Int) -> e) -> Matrix e cols rows
325−matrixBuilder' = M . I.matrixBuilder'
326−
327−-- | Matrix builder function. Constructs a matrix provided with
328−-- a construction function that operates with arbitrary types.
295+-- a construction function.
329296matrixBuilder ::
330− ( FLN a b,
331− Enum a,
332− Enum b,
333− Bounded a,
334− Bounded b,
335− Eq a,
336− Countable b
337− ) => ((a, b) -> e) -> Matrix e a b
338−matrixBuilder f = M (I.matrixBuilder f)
297+ (I.FromLists e (I.Normalize cols) (I.Normalize rows), KnownNat (I.Count (I.Normalize cols)), KnownNat (I.Count (I.Normalize rows))) =>
298+ ((Int, Int) -> e) ->
299+ Matrix e cols rows
300+matrixBuilder = M . I.matrixBuilder
339301
340302-- | Constructs a column vector matrix
341−col :: (FLN () rows) => [e] -> Matrix e One rows
303+col :: (I.FromLists e () (I.Normalize rows)) => [e] -> Matrix e One rows
342304col = M . I.col
343305
344306-- | Constructs a row vector matrix
345−row :: (FLN cols ()) => [e] -> Matrix e cols One
307+row :: (I.FromLists e (I.Normalize cols) ()) => [e] -> Matrix e cols One
346308row = M . I.row
347309
348310-- | Lifts functions to matrices with arbitrary dimensions.
349311--
350312-- NOTE: Be careful to not ask for a matrix bigger than the cardinality of
351313-- types @a@ or @b@ allows.
352−fromF' ::
353− ( Liftable e a b,
354− CountableDimsN cols rows,
355− FLN rows cols
314+fromF ::
315+ ( Bounded a,
316+ Bounded b,
317+ Enum a,
318+ Enum b,
319+ Eq b,
320+ Num e,
321+ Ord e,
322+ KnownNat (I.Count (I.Normalize cols)),
323+ KnownNat (I.Count (I.Normalize rows)),
324+ I.FromLists e (I.Normalize rows) (I.Normalize cols)
356325 ) =>
357− (a -> b) -> Matrix e cols rows
358−fromF' = M . I.fromF'
326+ (a -> b) ->
327+ Matrix e cols rows
328+fromF = M . I.fromF
359329
360330-- | Lifts functions to matrices with dimensions matching @a@ and @b@
361331-- cardinality's.
362−fromF ::
363− ( Liftable e a b,
364− CountableDimsN a b,
365− FLN b a
332+fromF' ::
333+ ( Bounded a,
334+ Bounded b,
335+ Enum a,
336+ Enum b,
337+ Eq b,
338+ Num e,
339+ Ord e,
340+ KnownNat (I.Count (I.Normalize a)),
341+ KnownNat (I.Count (I.Normalize b)),
342+ I.FromLists e (I.Normalize b) (I.Normalize a)
366343 ) =>
367− (a -> b) -> Matrix e a b
368−fromF = M . I.fromF
344+ (a -> b) ->
345+ Matrix e a b
346+fromF' = M . I.fromF'
369347
370348-- | Lifts relation functions to Boolean Matrix
371349toRel ::
372− ( Liftable (Natural 0 1) a b,
373− CountableDims a b,
374− FLN b a
350+ ( Bounded a,
351+ Bounded b,
352+ Enum a,
353+ Enum b,
354+ Eq b,
355+ KnownNat (I.Count (I.Normalize a)),
356+ KnownNat (I.Count (I.Normalize b)),
357+ I.FromLists (Natural 0 1) (I.Normalize b) (I.Normalize a)
375358 ) => (a -> b -> Bool) -> Matrix (Natural 0 1) a b
376359toRel = M . I.toRel
377360
@@ -389,8 +372,8 @@ toList (M m) = I.toList m
389372
390373-- | The zero matrix. A matrix wholly filled with zeros.
391374zeros ::
392− (Num e, FLN cols rows, CountableDimsN cols rows)
393− => Matrix e cols rows
375+ (Num e, I.FromLists e (I.Normalize cols) (I.Normalize rows), KnownNat (I.Count (I.Normalize cols)), KnownNat (I.Count (I.Normalize rows))) =>
376+ Matrix e cols rows
394377zeros = M I.zeros
395378
396379-- Ones Matrix
@@ -399,8 +382,8 @@ zeros = M I.zeros
399382--
400383-- Also known as T (Top) matrix.
401384ones ::
402− (Num e, FLN cols rows, CountableDimsN cols rows)
403− => Matrix e cols rows
385+ (Num e, I.FromLists e (I.Normalize cols) (I.Normalize rows), KnownNat (I.Count (I.Normalize cols)), KnownNat (I.Count (I.Normalize rows))) =>
386+ Matrix e cols rows
404387ones = M I.ones
405388
406389-- Const Matrix
@@ -408,8 +391,9 @@ ones = M I.ones
408391-- | The constant matrix constructor. A matrix wholly filled with a given
409392-- value.
410393constant ::
411− (Num e, FLN cols rows, CountableDimsN cols rows)
412− => e -> Matrix e cols rows
394+ (Num e, I.FromLists e (I.Normalize cols) (I.Normalize rows), KnownNat (I.Count (I.Normalize cols)), KnownNat (I.Count (I.Normalize rows))) =>
395+ e ->
396+ Matrix e cols rows
413397constant = M . I.constant
414398
415399-- Bang Matrix
@@ -417,30 +401,17 @@ constant = M . I.constant
417401-- | The T (Top) row vector matrix.
418402bang ::
419403 forall e cols.
420− (Num e, Enum e, FLN cols (), CountableN cols) =>
404+ (Num e, Enum e, I.FromLists e (I.Normalize cols) (), KnownNat (I.Count (I.Normalize cols))) =>
421405 Matrix e cols One
422406bang = M I.bang
423407
424−-- | Point constant relation
425−point ::
426− ( Bounded a,
427− Enum a,
428− Eq a,
429− Num e,
430− Ord e,
431− CountableN a,
432− FLN a One
433− ) => a -> Matrix e One a
434−point = fromF . const
435−
436−-- iden Matrix
408+-- Identity Matrix
437409
438−-- | iden matrix
439−iden ::
440− (Num e, FLN a a, CountableN a) =>
410+-- | Identity matrix
411+identity ::
412+ (Num e, I.FromLists e (I.Normalize a) (I.Normalize a), KnownNat (I.Count (I.Normalize a))) =>
441413 Matrix e a a
442−iden = M I.iden
443−{-# NOINLINE iden #-}
414+identity = M I.identity
444415
445416-- Matrix composition (MMM)
446417
@@ -450,32 +421,15 @@ iden = M I.iden
450421-- from LAoP.
451422comp :: (Num e) => Matrix e cr rows -> Matrix e cols cr -> Matrix e cols rows
452423comp (M a) (M b) = M (I.comp a b)
453−{-# NOINLINE comp #-}
454−{-# RULES
455− "comp/iden1" forall m. comp m iden = m ;
456− "comp/iden2" forall m. comp iden m = m
457−#-}
458−
459−-- Scalar multiplication of matrices
460−
461−infixl 7 .|
462−-- | Scalar multiplication of matrices.
463−(.|) :: Num e => e -> Matrix e cols rows -> Matrix e cols rows
464−(.|) e (M m) = M (e I..| m)
465−
466−-- Scalar division of matrices
467−
468−infixl 7 ./
469−-- | Scalar multiplication of matrices.
470−(./) :: Fractional e => Matrix e cols rows -> e -> Matrix e cols rows
471−(./) (M m) e = M (m I../ e)
472424
473425-- | Biproduct first component projection
474426p1 ::
475427 ( Num e,
476− CountableDimsN n m,
477− FLN n m,
478− FLN m m
428+ KnownNat (I.Count (I.Normalize n)),
429+ KnownNat (I.Count (I.Normalize m)),
430+ I.FromLists e (I.Normalize n) (I.Normalize m),
431+ I.FromLists e (I.Normalize m) (I.Normalize m),
432+ I.Normalize (Either m n) ~ Either (I.Normalize m) (I.Normalize n)
479433 ) =>
480434 Matrix e (Either m n) m
481435p1 = M I.p1
@@ -483,9 +437,11 @@ p1 = M I.p1
483437-- | Biproduct second component projection
484438p2 ::
485439 ( Num e,
486− CountableDimsN n m,
487− FLN m n,
488− FLN n n
440+ KnownNat (I.Count (I.Normalize n)),
441+ KnownNat (I.Count (I.Normalize m)),
442+ I.FromLists e (I.Normalize m) (I.Normalize n),
443+ I.FromLists e (I.Normalize n) (I.Normalize n),
444+ I.Normalize (Either m n) ~ Either (I.Normalize m) (I.Normalize n)
489445 ) =>
490446 Matrix e (Either m n) n
491447p2 = M I.p2
@@ -495,9 +451,11 @@ p2 = M I.p2
495451-- | Biproduct first component injection
496452i1 ::
497453 ( Num e,
498− CountableDimsN n m,
499− FLN n m,
500− FLN m m
454+ KnownNat (I.Count (I.Normalize n)),
455+ KnownNat (I.Count (I.Normalize m)),
456+ I.FromLists e (I.Normalize n) (I.Normalize m),
457+ I.FromLists e (I.Normalize m) (I.Normalize m),
458+ I.Normalize (Either m n) ~ Either (I.Normalize m) (I.Normalize n)
501459 ) =>
502460 Matrix e m (Either m n)
503461i1 = tr p1
@@ -505,9 +463,11 @@ i1 = tr p1
505463-- | Biproduct second component injection
506464i2 ::
507465 ( Num e,
508− CountableDimsN n m,
509− FLN m n,
510− FLN n n
466+ KnownNat (I.Count (I.Normalize n)),
467+ KnownNat (I.Count (I.Normalize m)),
468+ I.FromLists e (I.Normalize m) (I.Normalize n),
469+ I.FromLists e (I.Normalize n) (I.Normalize n),
470+ I.Normalize (Either m n) ~ Either (I.Normalize m) (I.Normalize n)
511471 ) =>
512472 Matrix e n (Either m n)
513473i2 = tr p2
@@ -516,34 +476,24 @@ i2 = tr p2
516476
517477-- | Obtain the number of rows.
518478--
519−-- NOTE: The 'KnownNat' constraint is needed in order to obtain the
520−-- dimensions in constant time. For a version that doesn't require the
521−-- constraint see 'rows''.
522−rows :: (CountableN rows) => Matrix e cols rows -> Int
523−rows (M m) = I.rows m
524−
525−-- | Obtain the number of rows in an inefficient manner, but without any
526−-- constraints.
479+-- NOTE: The 'KnownNat' constaint is needed in order to obtain the
480+-- dimensions in constant time.
527481--
528−-- For a more efficient version see 'rows'.
529−rows' :: Matrix e cols rows -> Int
530−rows' (M m) = I.rows' m
482+-- TODO: A 'rows' function that does not need the 'KnownNat' constraint in
483+-- exchange for performance.
484+rows :: (KnownNat (I.Count (I.Normalize rows))) => Matrix e cols rows -> Int
485+rows (M m) = I.rows m
531486
532487-- | Obtain the number of columns.
488+--
489+-- NOTE: The 'KnownNat' constaint is needed in order to obtain the
490+-- dimensions in constant time.
533491--
534−-- NOTE: The 'KnownNat' constraint is needed in order to obtain the
535−-- dimensions in constant time. For a version that doesn't require the
536−-- constraint see 'columns''.
537−columns :: (CountableN cols) => Matrix e cols rows -> Int
492+-- TODO: A 'columns' function that does not need the 'KnownNat' constraint in
493+-- exchange for performance.
494+columns :: (KnownNat (I.Count (I.Normalize cols))) => Matrix e cols rows -> Int
538495columns (M m) = I.columns m
539496
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−
547497-- Coproduct Bifunctor
548498
549499infixl 5 -|-
@@ -551,11 +501,14 @@ infixl 5 -|-
551501-- | Matrix coproduct functor also known as matrix direct sum.
552502(-|-) ::
553503 ( Num e,
554− CountableDimsN j k,
555− FLN k k,
556− FLN j k,
557− FLN k j,
558− FLN j j
504+ KnownNat (I.Count (I.Normalize j)),
505+ KnownNat (I.Count (I.Normalize k)),
506+ I.FromLists e (I.Normalize k) (I.Normalize k),
507+ I.FromLists e (I.Normalize j) (I.Normalize k),
508+ I.FromLists e (I.Normalize k) (I.Normalize j),
509+ I.FromLists e (I.Normalize j) (I.Normalize j),
510+ I.Normalize (Either n m) ~ Either (I.Normalize n) (I.Normalize m),
511+ I.Normalize (Either k j) ~ Either (I.Normalize k) (I.Normalize j)
559512 ) =>
560513 Matrix e n k ->
561514 Matrix e m j ->
@@ -565,98 +518,104 @@ infixl 5 -|-
565518-- Khatri Rao Product and projections
566519
567520-- | Khatri Rao product first component projection matrix.
568−fstM ::
521+kp1 ::
569522 forall e m k .
570523 ( Num e,
571− CountableDimsN m k,
572− CountableN (m, k),
573− FLN (m, k) m,
574− TrivialP m k
524+ KnownNat (I.Count (I.Normalize m)),
525+ KnownNat (I.Count (I.Normalize k)),
526+ KnownNat (I.Count (I.Normalize (m, k))),
527+ I.FromLists e (I.Normalize (m, k)) (I.Normalize m),
528+ I.Normalize (m, k) ~ I.Normalize (I.Normalize m, I.Normalize k)
575529 ) => Matrix e (m, k) m
576−fstM = M (I.fstM @e @(I.Normalize m) @(I.Normalize k))
530+kp1 = M (I.kp1 @e @(I.Normalize m) @(I.Normalize k))
577531
578532-- | Khatri Rao product second component projection matrix.
579−sndM ::
533+kp2 ::
580534 forall e m k.
581535 ( Num e,
582− CountableDimsN k m,
583− CountableN (m, k),
584− FLN (m, k) k,
585− TrivialP m k
536+ KnownNat (I.Count (I.Normalize k)),
537+ KnownNat (I.Count (I.Normalize m)),
538+ KnownNat (I.Count (I.Normalize (m, k))),
539+ I.FromLists e (I.Normalize (m, k)) (I.Normalize k),
540+ I.Normalize (m, k) ~ I.Normalize (I.Normalize m, I.Normalize k)
586541 ) => Matrix e (m, k) k
587−sndM = M (I.sndM @e @(I.Normalize m) @(I.Normalize k))
542+kp2 = M (I.kp2 @e @(I.Normalize m) @(I.Normalize k))
588543
589544-- | Khatri Rao Matrix product also known as matrix pairing.
590545--
591546-- NOTE: That this is not a true categorical product, see for instance:
592−--
547+--
593548-- @
594−-- | fstM . kr a b == a
595−-- kr a b ==> |
596−-- | sndM . kr a b == b
549+-- | kp1 `comp` khatri a b == a
550+-- khatri a b ==> |
551+-- | kp2 `comp` khatri a b == b
597552-- @
598553--
599554-- __Emphasis__ on the implication symbol.
600−kr ::
555+khatri ::
601556 forall e cols a b.
602557 ( Num e,
603− CountableDimsN a b,
604− CountableN (a, b),
605− FLN (a, b) a,
606− FLN (a, b) b,
607− TrivialP a b
558+ KnownNat (I.Count (I.Normalize a)),
559+ KnownNat (I.Count (I.Normalize b)),
560+ KnownNat (I.Count (I.Normalize (a, b))),
561+ I.FromLists e (I.Normalize (a, b)) (I.Normalize a),
562+ I.FromLists e (I.Normalize (a, b)) (I.Normalize b),
563+ I.Normalize (a, b) ~ I.Normalize (I.Normalize a, I.Normalize b)
608564 ) => Matrix e cols a -> Matrix e cols b -> Matrix e cols (a, b)
609−kr a b =
610− let fstM' = fstM @e @a @b
611− sndM' = sndM @e @a @b
612− in comp (tr fstM') a * comp (tr sndM') b
565+khatri a b =
566+ let kp1' = kp1 @e @a @b
567+ kp2' = kp2 @e @a @b
568+ in comp (tr kp1') a * comp (tr kp2') b
613569
614570-- Product Bifunctor (Kronecker)
615571
616572infixl 4 ><
617573
618−-- | Matrix product functor also known as Kronecker product
574+-- | Matrix product functor also known as kronecker product
619575(><) ::
620576 forall e m p n q.
621577 ( Num e,
622− CountableDimsN m n,
623− CountableDimsN p q,
624− CountableDimsN (m, n) (p, q),
625− FLN (m, n) m,
626− FLN (m, n) n,
627− FLN (p, q) p,
628− FLN (p, q) q,
629− TrivialP m n,
630− TrivialP p q
578+ KnownNat (I.Count (I.Normalize m)),
579+ KnownNat (I.Count (I.Normalize n)),
580+ KnownNat (I.Count (I.Normalize p)),
581+ KnownNat (I.Count (I.Normalize q)),
582+ KnownNat (I.Count (I.Normalize (m, n))),
583+ KnownNat (I.Count (I.Normalize (p, q))),
584+ I.FromLists e (I.Normalize (m, n)) (I.Normalize m),
585+ I.FromLists e (I.Normalize (m, n)) (I.Normalize n),
586+ I.FromLists e (I.Normalize (p, q)) (I.Normalize p),
587+ I.FromLists e (I.Normalize (p, q)) (I.Normalize q),
588+ I.Normalize (m, n) ~ I.Normalize (I.Normalize m, I.Normalize n),
589+ I.Normalize (p, q) ~ I.Normalize (I.Normalize p, I.Normalize q)
631590 ) => Matrix e m p -> Matrix e n q -> Matrix e (m, n) (p, q)
632591(><) a b =
633− let fstM' = fstM @e @m @n
634− sndM' = sndM @e @m @n
635− in kr (comp a fstM') (comp b sndM')
592+ let kp1' = kp1 @e @m @n
593+ kp2' = kp2 @e @m @n
594+ in khatri (comp a kp1') (comp b kp2')
636595
637−-- Matrix abide Join Fork
596+-- Matrix abide Junc Split
638597
639−-- | Matrix "abiding" followin the 'Join'-'Fork' abide law.
640−--
598+-- | Matrix "abiding" followin the 'Junc'-'Split' abide law.
599+--
641600-- Law:
642601--
643602-- @
644−-- 'Join' ('Fork' a c) ('Fork' b d) == 'Fork' ('Join' a b) ('Join' c d)
603+-- 'Junc' ('Split' a c) ('Split' b d) == 'Split' ('Junc' a b) ('Junc' c d)
645604-- @
646−abideJF :: Matrix e cols rows -> Matrix e cols rows
647−abideJF (M m) = M (I.abideJF m)
605+abideJS :: Matrix e cols rows -> Matrix e cols rows
606+abideJS (M m) = M (I.abideJS m)
648607
649−-- Matrix abide Fork Join
608+-- Matrix abide Split Junc
650609
651−-- | Matrix "abiding" followin the 'Fork'-'Join' abide law.
652−--
610+-- | Matrix "abiding" followin the 'Split'-'Junc' abide law.
611+--
653612-- Law:
654613--
655614-- @
656−-- 'Fork' ('Join' a b) ('Join' c d) == 'Join' ('Fork' a c) ('Fork' b d)
615+-- 'Split' ('Junc' a b) ('Junc' c d) == 'Junc' ('Split' a c) ('Split' b d)
657616-- @
658−abideFJ :: Matrix e cols rows -> Matrix e cols rows
659−abideFJ (M m) = M (I.abideFJ m)
617+abideSJ :: Matrix e cols rows -> Matrix e cols rows
618+abideSJ (M m) = M (I.abideSJ m)
660619
661620-- Matrix transposition
662621
@@ -668,10 +627,11 @@ tr (M m) = M (I.tr m)
668627
669628-- | Selective functors 'select' operator equivalent inspired by the
670629-- ArrowMonad solution presented in the paper.
671−selectM ::
630+selectM ::
672631 ( Num e,
673− FLN b b,
674− CountableN b
632+ I.FromLists e (I.Normalize b) (I.Normalize b),
633+ KnownNat (I.Count (I.Normalize b)),
634+ I.Normalize (Either a b) ~ Either (I.Normalize a) (I.Normalize b)
675635 ) => Matrix e cols (Either a b) -> Matrix e a b -> Matrix e cols b
676636selectM (M m) (M y) = M (I.select m y)
677637
@@ -679,14 +639,15 @@ selectM (M m) (M y) = M (I.select m y)
679639
680640-- | McCarthy's Conditional expresses probabilistic choice.
681641cond ::
682− ( Trivial a,
683− Trivial2 a,
684− Trivial3 a,
685− CountableN a,
686− FLN () a,
687− FLN a (),
688− FLN a a,
689− Liftable e a Bool
642+ ( I.Normalize (I.Normalize a) ~ I.Normalize a,
643+ KnownNat (I.Count (I.Normalize a)),
644+ I.FromLists e () (I.Normalize a),
645+ I.FromLists e (I.Normalize a) (),
646+ I.FromLists e (I.Normalize a) (I.Normalize a),
647+ Bounded a,
648+ Enum a,
649+ Num e,
650+ Ord e
690651 )
691652 =>
692653 (a -> Bool) -> Matrix e a b -> Matrix e a b -> Matrix e a b
@@ -695,13 +656,9 @@ cond p (M a) (M b) = M (I.cond p a b)
695656-- Pretty print
696657
697658-- | Matrix pretty printer
698−pretty :: (CountableDimsN cols rows, Show e) => Matrix e cols rows -> String
659+pretty :: (KnownNat (I.Count (I.Normalize cols)), Show e) => Matrix e cols rows -> String
699660pretty (M m) = I.pretty m
700661
701662-- | Matrix pretty printer
702−prettyPrint :: (CountableDimsN cols rows, Show e) => Matrix e cols rows -> IO ()
663+prettyPrint :: (KnownNat (I.Count (I.Normalize cols)), Show e) => Matrix e cols rows -> IO ()
703664prettyPrint (M m) = I.prettyPrint m
704−
705−-- | Zip two matrices with a given binary function
706−zipWithM :: (e -> f -> g) -> Matrix e a b -> Matrix f a b -> Matrix g a b
707−zipWithM f (M a) (M b) = M (I.zipWithM f a b)
src/LAoP/Relation.hs+7−34
@@ -30,21 +30,12 @@ module LAoP.Relation
3030 Relation (..),
3131 Boolean,
3232
33− -- * Constraint type synonyms
34− Countable,
35− CountableDims,
36− CountableN,
37− CountableDimsN,
38− FLN,
39− Liftable,
40− Trivial,
41− TrivialP,
42−
4333 -- * Primitives
34+ empty,
4435 one,
45− join,
36+ junc,
4637 (|||),
47− fork,
38+ split,
4839 (===),
4940
5041 -- * Auxiliary type families
@@ -62,7 +53,6 @@ module LAoP.Relation
6253 toList,
6354 toBool,
6455 pt,
65− belongs,
6656 relationBuilder,
6757 zeros,
6858 ones,
@@ -90,25 +80,15 @@ module LAoP.Relation
9080 injection,
9181 surjection,
9282 bijection,
93− domain,
94− range,
9583
9684 -- * Function division
9785 divisionF,
9886
99− -- * Relation division
100− divR,
101− divL,
102− divS,
103− shrunkBy,
104− overriddenBy,
105−
10687 -- * Relational pairing
10788 splitR,
108−
10989 -- ** Projections
110− fstR,
111− sndR,
90+ p1,
91+ p2,
11292 -- ** Bifunctor
11393 (><),
11494 -- * Relational coproduct
@@ -136,25 +116,18 @@ module LAoP.Relation
136116 linearOrder,
137117 equivalence,
138118 partialEquivalence,
139− difunctional,
140−
141− -- * Conditionals
142− equalizer,
143119
144120 -- ** McCarthy's Conditional
145− predR,
146− guard,
147− cond,
121+ -- cond,
148122
149123 -- * Relational composition and lifting
150− iden,
124+ identity,
151125 comp,
152126 fromF,
153127 fromF',
154128
155129 -- ** Relational application
156130 pointAp,
157− pointApBool,
158131
159132 -- * Matrix printing
160133 pretty,
src/LAoP/Relation/Internal.hs+317−486
@@ -1,5 +1,3 @@
1−{-# LANGUAGE TypeFamilies #-}
2−{-# LANGUAGE ConstraintKinds #-}
31{-# LANGUAGE GADTs #-}
42{-# LANGUAGE UndecidableInstances #-}
53{-# LANGUAGE FlexibleContexts #-}
@@ -41,21 +39,12 @@ module LAoP.Relation.Internal
4139 Relation (..),
4240 Boolean,
4341
44− -- * Constraint type synonyms
45− Countable,
46− CountableDims,
47− CountableN,
48− CountableDimsN,
49− FLN,
50− Liftable,
51− Trivial,
52− TrivialP,
53−
5442 -- * Primitives
43+ empty,
5544 one,
56− join,
45+ junc,
5746 (|||),
58− fork,
47+ split,
5948 (===),
6049
6150 -- * Auxiliary type families
@@ -66,15 +55,13 @@ module LAoP.Relation.Internal
6655 -- * Matrix construction and conversion
6756 I.FromLists,
6857 fromLists,
69− fromF',
7058 fromF,
59+ fromF',
7160 toRel,
7261 toLists,
7362 toList,
7463 toBool,
7564 pt,
76− belongs,
77− relationBuilder',
7865 relationBuilder,
7966 zeros,
8067 ones,
@@ -102,8 +89,6 @@ module LAoP.Relation.Internal
10289 injection,
10390 surjection,
10491 bijection,
105− domain,
106− range,
10792
10893 -- * Function division
10994 divisionF,
@@ -119,8 +104,8 @@ module LAoP.Relation.Internal
119104 splitR,
120105
121106 -- ** Projections
122− fstR,
123− sndR,
107+ p1,
108+ p2,
124109 -- ** Bifunctor
125110 (><),
126111 -- * Relational coproduct
@@ -148,7 +133,6 @@ module LAoP.Relation.Internal
148133 linearOrder,
149134 equivalence,
150135 partialEquivalence,
151− difunctional,
152136
153137 -- * Conditionals
154138 equalizer,
@@ -159,10 +143,10 @@ module LAoP.Relation.Internal
159143 cond,
160144
161145 -- * Relational composition and lifting
162− iden,
146+ identity,
163147 comp,
164− fromF',
165148 fromF,
149+ fromF',
166150
167151 -- ** Relational application
168152 pointAp,
@@ -178,13 +162,12 @@ import Data.Void
178162import qualified LAoP.Matrix.Internal as I
179163import LAoP.Utils.Internal
180164import Control.DeepSeq
165+import qualified Control.Category as C
181166import Data.Bool
182167import GHC.TypeLits
183−import Prelude hiding (id, (.))
184168
185169-- | Boolean type synonym for working with boolean matrices
186170type Boolean = Natural 0 1
187−type Powerset a = List (List a)
188171
189172-- | Relation data type.
190173newtype Relation a b = R (I.Matrix Boolean (I.Normalize a) (I.Normalize b))
@@ -192,34 +175,25 @@ newtype Relation a b = R (I.Matrix Boolean (I.Normalize a) (I.Normalize b))
192175
193176deriving instance (Read (I.Matrix Boolean (I.Normalize a) (I.Normalize b))) => Read (Relation a b)
194177
195−-- | Constraint type synonyms to keep the type signatures less convoluted
196−type Countable a = KnownNat (I.Count a)
197−type CountableDims a b = (Countable a, Countable b)
198−type CountableN a = KnownNat (I.Count (I.Normalize a))
199−type CountableDimsN a b = (CountableN a, CountableN b)
200−type FLN a b = I.FromLists (I.Normalize a) (I.Normalize b)
201−type Liftable a b = (Bounded a, Bounded b, Enum a, Enum b, Eq b, Num Boolean, Ord Boolean)
202−type Trivial a = I.Normalize a ~ I.Normalize (I.Normalize a)
203−type TrivialP a b = I.Normalize (a, b) ~ I.Normalize (I.Normalize a, I.Normalize b)
204−
205−-- | It is possible to implement a constrained version of the category type
206−-- class.
207−instance Category Relation where
208− type Object Relation a = (FLN a a, CountableN a)
209− id = iden
210− (.) = comp
178+-- | It isn't possible to implement the 'id' function so it's
179+-- implementation is 'undefined'. However 'comp' can be and this partial
180+-- class implementation exists just to make the code more readable.
181+--
182+-- Please use 'identity' instead.
183+instance C.Category Relation where
184+ id = undefined
185+ (.) = comp
211186
212187instance Num (Relation a b) where
213− -- | Matrix addition becomes Boolean matrix disjointion
188+ -- | Matrix addition becomes Boolean matrix disjunction
214189 (R a) + (R b) = R (I.orM a b)
215190
216191 -- | Matrix subtraction becomes Relational subtraction
217192 (R a) - (R b) = R (I.subM a b)
218193
219− -- | Matrix multiplication becomes Boolean matrix conjointion
194+ -- | Matrix multiplication becomes Boolean matrix conjunction
220195 (R a) * (R b) = R (I.andM a b)
221196
222− -- | Matrix negation becomes Boolean matrix negation
223197 negate (R a) = R (I.negateM a)
224198
225199-- Type alias
@@ -228,107 +202,105 @@ type One = ()
228202
229203-- Primitives
230204
205+-- | Empty matrix constructor
206+empty :: Relation Zero Zero
207+empty = R I.Empty
208+
231209-- | Unit matrix constructor
232210one :: Boolean -> Relation One One
233211one = R . I.One
234212
235−-- | Boolean Matrix 'Join' constructor, also known as relational coproduct.
213+-- | Boolean Matrix 'Junc' constructor, also known as relational coproduct.
236214--
237215-- See 'eitherR'.
238−join :: Relation a c -> Relation b c -> Relation (Either a b) c
239−join (R a) (R b) = R (I.Join a b)
216+junc :: (I.Normalize (Either a b) ~ Either (I.Normalize a) (I.Normalize b))
217+ => Relation a c -> Relation b c -> Relation (Either a b) c
218+junc (R a) (R b) = R (I.Junc a b)
240219
241220infixl 3 |||
242−-- | Boolean Matrix 'Join' constructor
243−--
244−-- See 'eitherR'.
221+-- | Boolean Matrix 'Junc' constructor
245222(|||) ::
223+ (I.Normalize (Either a b) ~ Either (I.Normalize a) (I.Normalize b)) =>
246224 Relation a c ->
247225 Relation b c ->
248226 Relation (Either a b) c
249−(|||) = join
227+(|||) = junc
250228
251−-- | Boolean Matrix 'Fork' constructor, also known as relational product.
252−fork :: Relation c a -> Relation c b -> Relation c (Either a b)
253−fork (R a) (R b) = R (I.Fork a b)
229+-- | Boolean Matrix 'Split' constructor, also known as relational product.
230+split :: (I.Normalize (Either a b) ~ Either (I.Normalize a) (I.Normalize b))
231+ => Relation c a -> Relation c b -> Relation c (Either a b)
232+split (R a) (R b) = R (I.Split a b)
254233
255234infixl 2 ===
256−-- | Boolean Matrix 'Fork' constructor
235+-- | Boolean Matrix 'Split' constructor
257236(===) ::
237+ (I.Normalize (Either a b) ~ Either (I.Normalize a) (I.Normalize b)) =>
258238 Relation c a ->
259239 Relation c b ->
260240 Relation c (Either a b)
261−(===) = fork
241+(===) = split
262242
263243-- Construction
264244
265245-- | Build a matrix out of a list of list of elements. Throws a runtime
266246-- error if the dimensions do not match.
267−fromLists :: (FLN a b) => [[Boolean]] -> Relation a b
247+fromLists :: (I.FromLists Boolean (I.Normalize a) (I.Normalize b)) => [[Boolean]] -> Relation a b
268248fromLists = R . I.fromLists
269249
270−-- | Relation builder function. Constructs a relation provided with
271−-- a construction function that operates with indices.
272−relationBuilder' ::
273− (FLN a b, CountableDimsN a b) =>
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.
250+-- | Matrix builder function. Constructs a matrix provided with
251+-- a construction function.
279252relationBuilder ::
280− ( FLN a b,
281− Enum a,
282− Enum b,
283− Bounded a,
284− Bounded b,
285− Eq a,
286− CountableDims a b
287− ) => ((a, b) -> Boolean) -> Relation a b
253+ (I.FromLists Boolean (I.Normalize a) (I.Normalize b), KnownNat (I.Count (I.Normalize a)), KnownNat (I.Count (I.Normalize b))) =>
254+ ((Int, Int) -> Boolean) ->
255+ Relation a b
288256relationBuilder = R . I.matrixBuilder
289257
290258-- | Lifts functions to matrices with arbitrary dimensions.
291259--
292260-- NOTE: Be careful to not ask for a matrix bigger than the cardinality of
293261-- types @a@ or @b@ allows.
294−fromF' ::
295− ( Liftable a b,
296− CountableDimsN c d,
297− FLN d c
262+fromF ::
263+ ( Bounded a,
264+ Bounded b,
265+ Enum a,
266+ Enum b,
267+ Eq b,
268+ KnownNat (I.Count (I.Normalize c)),
269+ KnownNat (I.Count (I.Normalize d)),
270+ I.FromLists Boolean (I.Normalize d) (I.Normalize c)
298271 )
299272 => (a -> b) -> Relation c d
300−fromF' f = R (I.fromFRel' f)
273+fromF f = R (I.fromFRel f)
301274
302275-- | Lifts functions to matrices with dimensions matching @a@ and @b@
303276-- cardinality's.
304−fromF ::
305− ( Liftable a b,
306− CountableDimsN a b,
307− FLN b a
277+fromF' ::
278+ ( Bounded b,
279+ Bounded a,
280+ Enum a,
281+ Enum b,
282+ Eq b,
283+ KnownNat (I.Count (I.Normalize a)),
284+ KnownNat (I.Count (I.Normalize b)),
285+ I.FromLists Boolean (I.Normalize b) (I.Normalize a)
308286 )
309287 => (a -> b) -> Relation a b
310−fromF f = R (I.fromFRel f)
288+fromF' f = R (I.fromFRel' f)
311289
312290-- | Lifts relation functions to 'Relation'
313291toRel ::
314− ( Liftable a b,
315− CountableDims a b,
316− FLN b a
292+ ( Bounded b,
293+ Bounded a,
294+ Enum a,
295+ Enum b,
296+ Eq b,
297+ KnownNat (I.Count (I.Normalize a)),
298+ KnownNat (I.Count (I.Normalize b)),
299+ I.FromLists Boolean (I.Normalize b) (I.Normalize a)
317300 )
318− => (a -> b -> Bool) -> Relation a b
301+ => (a -> b -> Bool) -> Relation a b
319302toRel = R . I.toRel
320303
321−-- | Lowers a 'Relation' to a function
322−fromRel ::
323− ( Liftable a b,
324− Eq a,
325− CountableDimsN a b,
326− FLN a One,
327− FLN b One
328− )
329− => Relation a b -> (a -> b -> Bool)
330−fromRel r a b = pointApBool a b r
331−
332304-- Conversion
333305
334306-- | Converts a matrix to a list of lists of elements.
@@ -339,135 +311,93 @@ toLists (R m) = I.toLists m
339311toList :: Relation a b -> [Boolean]
340312toList (R m) = I.toList m
341313
342−-- | Converts a well typed 'Relation' to 'Bool'.
314+-- | Converts a well typed @'Relation'@ to @'Bool'@.
343315toBool :: Relation One One -> Bool
344316toBool r = case toList r of
345317 [Nat 0] -> False
346318 _ -> True
347319
348−-- | Power transpose.
349−--
350−-- Maps a relation to a set valued function.
351−pt ::
352− ( Liftable a b,
320+-- | Power transpose
321+pt ::
322+ ( Bounded a,
323+ Bounded b,
324+ Enum a,
325+ Enum b,
353326 Eq a,
354− CountableDimsN a b,
355− FLN a One,
356− FLN b One
327+ Eq b,
328+ KnownNat (I.Count (I.Normalize a)),
329+ KnownNat (I.Count (I.Normalize b)),
330+ I.FromLists Boolean (I.Normalize a) One,
331+ I.FromLists Boolean (I.Normalize b) One
357332 )
358− => Relation a b -> (a -> List b)
333+ => Relation a b -> (a -> [b])
359334pt r a =
360− let (L lb) = maxBound
361− in L [ b | b <- lb, toBool (pointAp a b r) ]
362−
363−-- | Belongs relation
364−belongs ::
365− ( Bounded a,
366− Enum a,
367− Eq a,
368− CountableDims (List a) a,
369− FLN a (List a)
370− )
371− => Relation (List a) a
372−belongs = toRel elemR
373− where
374− elemR (L l) x = x `elem` l
335+ let lb = [minBound .. maxBound]
336+ in [ b | b <- lb, toBool (pointAp a b r) ]
375337
376338-- Zeros Matrix
377339
378−-- | The zero relation. A relation where no element of type @a@ relates
379−-- with elements of type @b@.
380−--
381−-- Also known as ⊥ (Bottom) Relation.
382−--
383−-- @
384−-- r `.` ⊥ == ⊥ `.` r == ⊥
385−-- ⊥ ``sse`` R && R ``sse`` T == True
386−-- @
340+-- | The zero matrix. A matrix wholly filled with zeros.
387341zeros ::
388− (FLN a b, CountableDimsN a b) =>
342+ (I.FromLists Boolean (I.Normalize a) (I.Normalize b), KnownNat (I.Count (I.Normalize a)), KnownNat (I.Count (I.Normalize b))) =>
389343 Relation a b
390−zeros = relationBuilder' (const (nat 0))
344+zeros = relationBuilder (const (nat 0))
391345
392346-- Ones Matrix
393347
394−-- | The ones relation. A relation where every element of type @a@ relates
395−-- with every element of type @b@.
396−--
397−-- Also known as T (Top) Relation or universal Relation.
348+-- | The ones matrix. A matrix wholly filled with ones.
398349--
399−-- @
400−-- ⊥ ``sse`` R && R ``sse`` T == True
401−-- @
350+-- Also known as T (Top) matrix.
402351ones ::
403− (FLN a b, CountableDimsN a b) =>
352+ (I.FromLists Boolean (I.Normalize a) (I.Normalize b), KnownNat (I.Count (I.Normalize a)), KnownNat (I.Count (I.Normalize b))) =>
404353 Relation a b
405−ones = relationBuilder' (const (nat 1))
354+ones = relationBuilder (const (nat 1))
406355
407356-- Bang Matrix
408357
409−-- | The T (Top) row vector relation.
358+-- | The T (Top) row vector matrix.
410359bang ::
411− (FLN a One, CountableN a) =>
360+ (I.FromLists Boolean (I.Normalize a) One, KnownNat (I.Count (I.Normalize a))) =>
412361 Relation a One
413362bang = ones
414363
415364-- | Point constant relation
416−point ::
365+point ::
417366 ( Bounded a,
418367 Enum a,
419368 Eq a,
420− CountableN a,
421− FLN a One
369+ KnownNat (I.Count (I.Normalize a)),
370+ I.FromLists Boolean (I.Normalize a) One
422371 ) => a -> Relation One a
423−point = fromF . const
372+point = fromF' . const
424373
425−-- iden Matrix
374+-- Identity Matrix
426375
427−-- | iden matrix
428−--
429−-- @
430−-- 'iden' `.` r == r == r `.` 'iden'
431−-- @
432−iden ::
433− (FLN a a, CountableN a) => Relation a a
434−iden = relationBuilder' (bool (nat 0) (nat 1) . uncurry (==))
376+-- | Identity matrix
377+identity ::
378+ (I.FromLists Boolean (I.Normalize a) (I.Normalize a), KnownNat (I.Count (I.Normalize a))) =>
379+ Relation a a
380+identity = relationBuilder (bool (nat 0) (nat 1) . uncurry (==))
435381
436382-- | Relational composition
437−--
438−-- @
439−-- r `.` (s `.` p) = (r `.` s) `.` p
440−-- @
441383comp :: Relation b c -> Relation a b -> Relation a c
442384comp (R a) (R b) = R (I.compRel a b)
443385
444386-- | Relational right division
445−--
446−-- @'divR' x y@ is the largest relation @z@ which,
447−-- pre-composed with @y@, approximates @x@.
448387divR :: Relation b c -> Relation b a -> Relation a c
449388divR (R x) (R y) = R (I.divR x y)
450389
451390-- | Relational left division
452−--
453−-- The dual division operator:
454−--
455−-- @
456−-- 'divL' y x == 'conv' ('divR' ('conv' x) ('conv' y)
457−-- @
458391divL :: Relation c b -> Relation a b -> Relation a c
459392divL (R x) (R y) = R (I.divL x y)
460393
461394-- | Relational symmetric division
462−--
463−-- @'pointAp' c b ('divS' s r)@ means that @b@ and @c@
464−-- are related to exactly the same outputs by @r@ and by @s@.
465395divS :: Relation c a -> Relation b a -> Relation c b
466396divS (R x) (R y) = R (I.divS x y)
467397
468398-- | Relational shrinking.
469399--
470−-- @r ``shrunkBy`` s@ is the largest part of @r@ such that,
400+-- @r `'shrunkBy'` s@ is the largest part of @r@ such that,
471401-- if it yields an output for an input @x@, it must be a maximum,
472402-- with respect to @s@, among all possible outputs of @x@ by @r@.
473403shrunkBy :: Relation b a -> Relation a a -> Relation b a
@@ -475,52 +405,51 @@ shrunkBy r s = r `intersection` divR s (conv r)
475405
476406-- | Relational overriding.
477407--
478−-- @r ``overriddenBy`` s@ yields the relation which contains the
408+-- @r `'overriddenBy'` s@ yields the relation which contains the
479409-- whole of @s@ and that part of @r@ where @s@ is undefined.
480410--
481411-- @
482−-- 'zeros' ``overriddenBy`` s == s
483−-- r ``overriddenBy`` 'zeros' == r
484−-- r ``overriddenBy`` r == r
412+-- 'zeros' `'overriddenBy'` s == s
413+-- r `'overriddenBy'` 'zeros' == r
414+-- r `'overriddenBy'` r == r
485415-- @
486416overriddenBy ::
487− ( FLN b b,
488− CountableN b
417+ ( I.FromLists Boolean (I.Normalize b) (I.Normalize b),
418+ KnownNat (I.Count (I.Normalize b))
489419 ) => Relation a b -> Relation a b -> Relation a b
490420overriddenBy r s = s `union` r `intersection` divR zeros (conv s)
491421
492−-- | Relational application.
493−--
494−-- If @a@ and @b@ are related by 'Relation' @r@
495−-- then @'pointAp' a b r == 'one' ('nat' 1)@
422+-- | Relational application
496423pointAp ::
497− ( Liftable a b,
424+ ( Bounded a,
425+ Bounded b,
426+ Enum a,
427+ Enum b,
498428 Eq a,
499− CountableDimsN a b,
500− FLN a One,
501− FLN b One
429+ Eq b,
430+ KnownNat (I.Count (I.Normalize a)),
431+ KnownNat (I.Count (I.Normalize b)),
432+ I.FromLists Boolean (I.Normalize a) One,
433+ I.FromLists Boolean (I.Normalize b) One
502434 ) => a -> b -> Relation a b -> Relation One One
503−pointAp a b r = conv (point b) . r . point a
435+pointAp a b r = conv (point b) `comp` r `comp` point a
504436
505437-- | Relational application
506−--
507−-- The same as 'pointAp' but converts 'Boolean' to 'Bool'
508438pointApBool ::
509− ( Liftable a b,
439+ ( Bounded a,
440+ Bounded b,
441+ Enum a,
442+ Enum b,
510443 Eq a,
511− CountableDimsN a b,
512− FLN a One,
513− FLN b One
444+ Eq b,
445+ KnownNat (I.Count (I.Normalize a)),
446+ KnownNat (I.Count (I.Normalize b)),
447+ I.FromLists Boolean (I.Normalize a) One,
448+ I.FromLists Boolean (I.Normalize b) One
514449 ) => a -> b -> Relation a b -> Bool
515−pointApBool a b r = toBool $ conv (point b) . r . point a
450+pointApBool a b r = toBool $ conv (point b) `comp` r `comp` point a
516451
517452-- | Relational converse
518−--
519−-- Given binary 'Relation' r, writing @'pointAp' a b r@
520−-- (read: “@b@ is related to @a@ by @r@”) means the same as
521−-- @'pointAp' b a ('conv' r)@, where @'conv' r@ is said to be
522−-- the converse of @r@.
523−-- In terms of grammar, @'conv' r@ corresponds to the passive voice
524453conv :: Relation a b -> Relation b a
525454conv (R a) = R (I.tr a)
526455
@@ -538,187 +467,165 @@ iff r s = r == s
538467
539468-- | Relational intersection
540469--
541−-- Lifts pointwise conjointion.
542−--
543−-- @
544−-- (r ``intersection`` s) ``intersection`` t == r ``intersection`` (s ``intersection`` t)
545−-- x ``sse`` r ``intersection`` s == x ``intersection`` r && x ``intersection`` s
546−-- @
470+-- Lifts pointwise conjunction.
547471intersection :: Relation a b -> Relation a b -> Relation a b
548472intersection a b = a * b
549473
550474-- | Relational union
551475--
552−-- Lifts pointwise disjointion.
553−--
554−-- @
555−-- (r ``union`` s) ``union`` t == r `'union' (s ``union`` t)
556−-- r ``union`` s ``sse`` x == r ``sse`` x && s ``sse`` x
557−-- r `.` (s ``union`` t) == (r `.` s) ``union`` (r `.` t)
558−-- (s ``union`` t) `.` r == (s `.` r) ``union`` (t `.` r)
559−-- @
476+-- Lifts pointwise disjunction.
560477union :: Relation a b -> Relation a b -> Relation a b
561478union a b = a + b
562479
563480-- | Relation Kernel
564−--
565−-- @
566−-- 'ker' r == 'conv' r `.` r
567−-- 'ker' r == 'img' ('conv' r)
568−-- @
569481ker :: Relation a b -> Relation a a
570−ker r = conv r . r
482+ker r = conv r `comp` r
571483
572484-- | Relation Image
573−--
574−-- @
575−-- 'img' r == r `.` conv r
576−-- 'img' r == 'ker' ('conv' r)
577−-- @
578485img :: Relation a b -> Relation b b
579−img r = r . conv r
486+img r = r `comp` conv r
580487
581−-- | Function division. Special case of 'divS'.
488+-- | Function division.
582489--
583490-- NOTE: _This is only valid_ if @f@ and @g@ are 'function's, i.e. 'simple' and
584491-- 'entire'.
585492--
586−-- @'divisionF' f g == 'conv' g `.` f@
493+-- @division f g == conv g `'comp'` f@
587494divisionF :: Relation a c -> Relation b c -> Relation a b
588−divisionF f g = conv g . f
495+divisionF f g = conv g `comp` f
589496
590497-- Taxonomy of binary relations
591498
592−-- | A 'Relation' @r@ is 'simple' 'iff' @'coreflexive' ('img' r)@
593−simple :: (CountableN b, FLN b b) => Relation a b -> Bool
499+-- | A 'Relation' @r@ is simple iff @'coreflexive' ('img' r)@
500+simple :: (KnownNat (I.Count (I.Normalize b)), I.FromLists Boolean (I.Normalize b) (I.Normalize b)) => Relation a b -> Bool
594501simple = coreflexive . img
595502
596−-- | A 'Relation' @r@ is 'injective' 'iff' @'coreflexive' ('ker' r)@
597−injective :: (CountableN a, FLN a a) => Relation a b -> Bool
503+-- | A 'Relation' @r@ is injective iff @'coreflexive' ('ker' r)@
504+injective :: (KnownNat (I.Count (I.Normalize a)), I.FromLists Boolean (I.Normalize a) (I.Normalize a)) => Relation a b -> Bool
598505injective = coreflexive . ker
599506
600−-- | A 'Relation' @r@ is 'entire' 'iff' @'reflexive' ('ker' r)@
601−entire :: (CountableN a, FLN a a) => Relation a b -> Bool
507+-- | A 'Relation' @r@ is entire iff @'reflexive' ('ker' r)@
508+entire :: (KnownNat (I.Count (I.Normalize a)), I.FromLists Boolean (I.Normalize a) (I.Normalize a)) => Relation a b -> Bool
602509entire = reflexive . ker
603510
604−-- | A 'Relation' @r@ is 'surjective' 'iff' @'reflexive' ('img' r)@
605−surjective :: (CountableN b, FLN b b) => Relation a b -> Bool
511+-- | A 'Relation' @r@ is surjective iff @'reflexive' ('img' r)@
512+surjective :: (KnownNat (I.Count (I.Normalize b)), I.FromLists Boolean (I.Normalize b) (I.Normalize b)) => Relation a b -> Bool
606513surjective = reflexive . img
607514
608−-- | A 'Relation' @r@ is a 'function' 'iff' @'simple' r && 'entire' r@
515+-- | A 'Relation' @r@ is a function iff @'simple' r && 'entire' r@
609516--
610517-- A 'function' @f@ enjoys the following properties, where @r@ and @s@ are binary
611518-- relations:
612519--
613520-- @
614−-- f `.` r ``sse`` s == r ``sse`` f `.` s
615−-- r `.` f ``sse`` s == r ``sse`` s `.` f
521+-- f `'comp'` r `'sse'` s == r `'sse'` f `'comp'` s
522+-- r `'comp'` f `'sse'` s == r `'sse'` s `'comp'` f
616523-- @
617524function ::
618− ( CountableDimsN a b,
619− FLN a a,
620− FLN b b
525+ ( KnownNat (I.Count (I.Normalize b)),
526+ KnownNat (I.Count (I.Normalize a)),
527+ I.FromLists Boolean (I.Normalize a) (I.Normalize a),
528+ I.FromLists Boolean (I.Normalize b) (I.Normalize b)
621529 )
622530 => Relation a b -> Bool
623531function r = simple r && entire r
624532
625−-- | A 'Relation' @r@ is a 'representation' 'iff' @'injective' r && 'entire' r@
533+-- | A 'Relation' @r@ is a representation iff @'injective' r && 'entire' r@
626534representation ::
627− ( CountableN a,
628− FLN a a
535+ ( KnownNat (I.Count (I.Normalize a)),
536+ I.FromLists Boolean (I.Normalize a) (I.Normalize a)
629537 )
630538 => Relation a b -> Bool
631539representation r = injective r && entire r
632540
633−-- | A 'Relation' @r@ is an 'abstraction' 'iff' @'surjective' r && 'simple' r@
541+-- | A 'Relation' @r@ is an abstraction iff @'surjective' r && 'simple' r@
634542abstraction ::
635− ( CountableN b,
636− FLN b b
543+ ( KnownNat (I.Count (I.Normalize b)),
544+ I.FromLists Boolean (I.Normalize b) (I.Normalize b)
637545 )
638546 => Relation a b -> Bool
639547abstraction r = surjective r && simple r
640548
641−-- | A 'Relation' @r@ is a 'surjection' 'iff' @'function' r && 'abstraction' r@
549+-- | A 'Relation' @r@ is a surjection iff @'function' r && 'abstraction' r@
642550surjection ::
643− ( CountableDimsN a b,
644− FLN a a,
645− FLN b b
551+ ( KnownNat (I.Count (I.Normalize b)),
552+ KnownNat (I.Count (I.Normalize a)),
553+ I.FromLists Boolean (I.Normalize a) (I.Normalize a),
554+ I.FromLists Boolean (I.Normalize b) (I.Normalize b)
646555 )
647556 => Relation a b -> Bool
648557surjection r = function r && abstraction r
649558
650−-- | A 'Relation' @r@ is a 'injection' 'iff' @'function' r && 'representation' r@
559+-- | A 'Relation' @r@ is a injection iff @'function' r && 'representation' r@
651560injection ::
652− ( CountableDimsN a b,
653− FLN a a,
654− FLN b b
561+ ( KnownNat (I.Count (I.Normalize b)),
562+ KnownNat (I.Count (I.Normalize a)),
563+ I.FromLists Boolean (I.Normalize a) (I.Normalize a),
564+ I.FromLists Boolean (I.Normalize b) (I.Normalize b)
655565 )
656566 => Relation a b -> Bool
657567injection r = function r && representation r
658568
659−-- | A 'Relation' @r@ is an 'bijection' 'iff' @'injection' r && 'surjection' r@
569+-- | A 'Relation' @r@ is an bijection iff @'injection' r && 'surjection' r@
660570bijection ::
661− ( CountableDimsN a b,
662− FLN b b,
663− FLN a a
571+ ( KnownNat (I.Count (I.Normalize b)),
572+ KnownNat (I.Count (I.Normalize a)),
573+ I.FromLists Boolean (I.Normalize b) (I.Normalize b),
574+ I.FromLists Boolean (I.Normalize a) (I.Normalize a)
664575 ) => Relation a b -> Bool
665576bijection r = injection r && surjection r
666577
578+
667579-- Properties of relations
668580
669−-- | A 'Relation' @r@ is 'reflexive' 'iff' @'id' ``sse`` r@
670−reflexive :: (CountableN a, FLN a a) => Relation a a -> Bool
671−reflexive r = id <= r
581+-- | A 'Relation' @r@ is reflexive iff @'identity' `'sse'` r@
582+reflexive :: (KnownNat (I.Count (I.Normalize a)), I.FromLists Boolean (I.Normalize a) (I.Normalize a)) => Relation a a -> Bool
583+reflexive r = identity <= r
672584
673−-- | A 'Relation' @r@ is 'coreflexive' 'iff' @r ``sse`` 'id'@
674−coreflexive :: (CountableN a, FLN a a) => Relation a a -> Bool
675−coreflexive r = r <= id
585+-- | A 'Relation' @r@ is coreflexive iff @r `'sse'` 'identity'@
586+coreflexive :: (KnownNat (I.Count (I.Normalize a)), I.FromLists Boolean (I.Normalize a) (I.Normalize a)) => Relation a a -> Bool
587+coreflexive r = r <= identity
676588
677−-- | A 'Relation' @r@ is 'transitive' 'iff' @(r `.` r) ``sse`` r@
589+-- | A 'Relation' @r@ is transitive iff @(r `'comp'` r) `'sse'` r@
678590transitive :: Relation a a -> Bool
679−transitive r = (r . r) `sse` r
591+transitive r = (r `comp` r) `sse` r
680592
681−-- | A 'Relation' @r@ is 'symmetric' 'iff' @r == 'conv' r@
593+-- | A 'Relation' @r@ is symmetric iff @r == conv r@
682594symmetric :: Relation a a -> Bool
683595symmetric r = r == conv r
684596
685−-- | A 'Relation' @r@ is anti-symmetric 'iff' @(r ``intersection`` 'conv' r) ``sse`` 'id'@
686−antiSymmetric :: (CountableN a, FLN a a) => Relation a a -> Bool
687−antiSymmetric r = (r `intersection` conv r) `sse` id
597+-- | A 'Relation' @r@ is anti-symmetric iff @(r `'intersection'` 'conv' r) `'sse'` 'identity'@
598+antiSymmetric :: (KnownNat (I.Count (I.Normalize a)), I.FromLists Boolean (I.Normalize a) (I.Normalize a)) => Relation a a -> Bool
599+antiSymmetric r = (r `intersection` conv r) `sse` identity
688600
689−-- | A 'Relation' @r@ is 'irreflexive' 'iff' @(r ``intersection`` 'id') == 'zeros'@
690−irreflexive :: (CountableN a, FLN a a) => Relation a a -> Bool
691−irreflexive r = (r `intersection` id) == zeros
601+-- | A 'Relation' @r@ is irreflexive iff @(r `'intersection'` identity) == 'zeros'@
602+irreflexive :: (KnownNat (I.Count (I.Normalize a)), I.FromLists Boolean (I.Normalize a) (I.Normalize a)) => Relation a a -> Bool
603+irreflexive r = (r `intersection` identity) == zeros
692604
693−-- | A 'Relation' @r@ is 'connected' 'iff' @(r ``union`` 'conv' r) == 'ones'@
694−connected :: (CountableN a, FLN a a) => Relation a a -> Bool
605+-- | A 'Relation' @r@ is connected iff @(r `'union'` 'conv' r) == 'ones'@
606+connected :: (KnownNat (I.Count (I.Normalize a)), I.FromLists Boolean (I.Normalize a) (I.Normalize a)) => Relation a a -> Bool
695607connected r = (r `union` conv r) == ones
696608
697−-- | A 'Relation' @r@ is a 'preorder' 'iff' @'reflexive' r && 'transitive' r@
698−preorder :: (CountableN a, FLN a a) => Relation a a -> Bool
609+-- | A 'Relation @r@ is a preorder iff @'reflexive' r && 'transitive' r@
610+preorder :: (KnownNat (I.Count (I.Normalize a)), I.FromLists Boolean (I.Normalize a) (I.Normalize a)) => Relation a a -> Bool
699611preorder r = reflexive r && transitive r
700612
701−-- | A 'Relation' @r@ is a partial-order 'iff' @'antiSymmetric' r && 'preorder' r@
702−partialOrder :: (CountableN a, FLN a a) => Relation a a -> Bool
613+-- | A 'Relation @r@ is a partial order iff @'antiSymmetric' r && 'preorder' r@
614+partialOrder :: (KnownNat (I.Count (I.Normalize a)), I.FromLists Boolean (I.Normalize a) (I.Normalize a)) => Relation a a -> Bool
703615partialOrder r = antiSymmetric r && preorder r
704616
705−-- | A 'Relation' @r@ is a linear-order 'iff' @'connected' r && 'partialOrder' r@
706−linearOrder :: (CountableN a, FLN a a) => Relation a a -> Bool
617+-- | A 'Relation @r@ is a linear order iff @'connected' r && 'partialOrder' r@
618+linearOrder :: (KnownNat (I.Count (I.Normalize a)), I.FromLists Boolean (I.Normalize a) (I.Normalize a)) => Relation a a -> Bool
707619linearOrder r = connected r && partialOrder r
708620
709−-- | A 'Relation' @r@ is an 'equivalence' 'iff' @'symmetric' r && 'preorder' r@
710−equivalence :: (CountableN a, FLN a a) => Relation a a -> Bool
621+-- | A 'Relation @r@ is an equivalence iff @'symmetric' r && 'preorder' r@
622+equivalence :: (KnownNat (I.Count (I.Normalize a)), I.FromLists Boolean (I.Normalize a) (I.Normalize a)) => Relation a a -> Bool
711623equivalence r = symmetric r && preorder r
712624
713−-- | A 'Relation' @r@ is a partial-equivalence 'iff' @'partialOrder' r && 'equivalence' r@
714−partialEquivalence :: (CountableN a, FLN a a) => Relation a a -> Bool
625+-- | A 'Relation @r@ is a partial equivalence iff @'partialOrder' r && 'equivalence' r@
626+partialEquivalence :: (KnownNat (I.Count (I.Normalize a)), I.FromLists Boolean (I.Normalize a) (I.Normalize a)) => Relation a a -> Bool
715627partialEquivalence r = partialOrder r && equivalence r
716628
717−-- | A 'Relation' @r@ is 'difunctional' or regular wherever
718−-- @r `.` 'conv' r `.` r == r@
719−difunctional :: Relation a b -> Bool
720−difunctional r = r . conv r . r == r
721−
722629-- Relational pairing
723630
724631-- | Relational pairing.
@@ -726,81 +633,64 @@ difunctional r = r . conv r . r == r
726633-- NOTE: That this is not a true categorical product, see for instance:
727634--
728635-- @
729−-- | 'fstR' `.` 'splitR' a b ``sse`` a
730−-- 'splitR' a b <=> |
731−-- | 'sndR' `.` 'splitR' a b ``sse`` b
636+-- | 'p1' `'comp'` 'splitR' a b `'sse'` a
637+-- 'splitR' a b <=> |
638+-- | 'p2' `'comp'` 'splitR' a b `'sse'` b
732639-- @
733640--
734641-- __Emphasis__ on the 'sse'.
735−--
736−-- @
737−-- 'splitR' r s `.` f == 'splitR' (r `.` f) (s `.` f)
738−-- (R '><' S) `.` 'splitR' p q == 'splitR' (r `.` p) (s `.` q)
739−-- 'conv' ('splitR' r s) `.` 'splitR' x y == ('conv' r `.` x) ``intersection`` ('conv' s `.` y)
740−-- @
741−--
742−-- @
743−-- 'eitherR' ('splitR' r s) ('splitR' t v) == 'splitR' ('eitherR' r t) ('eitherR' s v)
744−-- @
745642splitR ::
746− ( CountableDimsN a b,
747− CountableN (a, b),
748− FLN (a, b) a,
749− FLN (a, b) b,
750− TrivialP a b
643+ ( KnownNat (I.Count (I.Normalize a)),
644+ KnownNat (I.Count (I.Normalize b)),
645+ KnownNat (I.Count (I.Normalize (a, b))),
646+ I.FromLists Boolean (I.Normalize (a, b)) (I.Normalize a),
647+ I.FromLists Boolean (I.Normalize (a, b)) (I.Normalize b),
648+ I.Normalize (a, b) ~ I.Normalize (I.Normalize a, I.Normalize b)
751649 )
752650 => Relation c a -> Relation c b -> Relation c (a, b)
753−splitR (R f) (R g) = R (I.kr f g)
651+splitR (R f) (R g) = R (I.khatri f g)
754652
755653-- | Relational pairing first component projection
756−--
757−-- @
758−-- 'fstR' `.` 'splitR' r s ``sse`` r
759−-- @
760−fstR ::
654+p1 ::
761655 forall a b .
762− ( CountableDimsN a b,
763− CountableN (a, b),
764− FLN (a, b) a,
765− TrivialP a b
656+ ( KnownNat (I.Count (I.Normalize a)),
657+ KnownNat (I.Count (I.Normalize b)),
658+ KnownNat (I.Count (I.Normalize (a, b))),
659+ I.FromLists Boolean (I.Normalize (a, b)) (I.Normalize a),
660+ I.Normalize (a, b) ~ I.Normalize (I.Normalize a, I.Normalize b)
766661 )
767662 => Relation (a, b) a
768−fstR = R (I.fstM @Boolean @(I.Normalize a) @(I.Normalize b))
663+p1 = R (I.kp1 @Boolean @(I.Normalize a) @(I.Normalize b))
769664
770665-- | Relational pairing second component projection
771−--
772−-- @
773−-- 'sndR' `.` 'splitR' r s ``sse`` s
774−-- @
775−sndR ::
666+p2 ::
776667 forall a b .
777− ( CountableDimsN a b,
778− CountableN (a, b),
779− FLN (a, b) b,
780− TrivialP a b
668+ ( KnownNat (I.Count (I.Normalize b)),
669+ KnownNat (I.Count (I.Normalize a)),
670+ KnownNat (I.Count (I.Normalize (a, b))),
671+ I.FromLists Boolean (I.Normalize (a, b)) (I.Normalize b),
672+ I.Normalize (a, b) ~ I.Normalize (I.Normalize a, I.Normalize b)
781673 )
782674 => Relation (a, b) b
783−sndR = R (I.sndM @Boolean @(I.Normalize a) @(I.Normalize b))
675+p2 = R (I.kp2 @Boolean @(I.Normalize a) @(I.Normalize b))
784676
785677-- Relational pairing functor
786678
787679infixl 4 ><
788680-- | Relational pairing functor
789−--
790−-- @
791−-- r '><' s == 'splitR' (r `.` fstR) (s `.` sndR)
792−-- (r '><' s) `.` (p '><' q) == (r `.` p) '><' (s `.` q)
793−-- @
794681(><) ::
795− ( CountableDimsN a b,
796− CountableDimsN c d,
797− CountableDimsN (a, c) (b, d),
798− FLN (a, c) a,
799− FLN (a, c) c,
800− FLN (b, d) b,
801− FLN (b, d) d,
802− TrivialP a c,
803− TrivialP b d
682+ ( KnownNat (I.Count (I.Normalize a)),
683+ KnownNat (I.Count (I.Normalize b)),
684+ KnownNat (I.Count (I.Normalize c)),
685+ KnownNat (I.Count (I.Normalize d)),
686+ KnownNat (I.Count (I.Normalize (a, c))),
687+ KnownNat (I.Count (I.Normalize (b, d))),
688+ I.FromLists Boolean (I.Normalize (a, c)) (I.Normalize a),
689+ I.FromLists Boolean (I.Normalize (a, c)) (I.Normalize c),
690+ I.FromLists Boolean (I.Normalize (b, d)) (I.Normalize b),
691+ I.FromLists Boolean (I.Normalize (b, d)) (I.Normalize d),
692+ I.Normalize (a, c) ~ I.Normalize (I.Normalize a, I.Normalize c),
693+ I.Normalize (b, d) ~ I.Normalize (I.Normalize b, I.Normalize d)
804694 )
805695 => Relation a b -> Relation c d -> Relation (a, c) (b, d)
806696(><) (R a) (R b) = R ((I.><) a b)
@@ -808,47 +698,28 @@ infixl 4 ><
808698-- Relational co-products
809699
810700-- | Relational coproduct.
811−--
812−-- @
813−-- | 'eitherR' a b `.` 'i1' == a
814−-- 'eitherR' a b <=> |
815−-- | 'eitherR' a b `.` 'i2' == b
816−-- @
817−--
818−-- @
819−-- 'eitherR' r s `.` 'conv' ('eitherR' t u) == (r `.` 'conv' t) ``union`` (s `.` 'conv' u)
820−-- @
821−--
822−-- @
823−-- 'eitherR' ('splitR' r s) ('splitR' t v) == 'splitR' ('eitherR' r t) ('eitherR' s v)
824−-- @
825−eitherR :: Relation a c -> Relation b c -> Relation (Either a b) c
826−eitherR = join
701+eitherR :: (I.Normalize (Either a b) ~ Either (I.Normalize a) (I.Normalize b))
702+ => Relation a c -> Relation b c -> Relation (Either a b) c
703+eitherR = junc
827704
828705-- | Relational coproduct first component injection
829−--
830−-- @
831−-- 'img' 'i1' ``union`` 'img' 'i2' == 'id'
832−-- 'i1' `.` 'i2' = 'zeros'
833−-- @
834706i1 ::
835− ( CountableDimsN a b,
836− FLN b a,
837− FLN a a
707+ ( KnownNat (I.Count (I.Normalize b)),
708+ KnownNat (I.Count (I.Normalize a)),
709+ I.FromLists Boolean (I.Normalize b) (I.Normalize a),
710+ I.FromLists Boolean (I.Normalize a) (I.Normalize a),
711+ I.Normalize (Either a b) ~ Either (I.Normalize a) (I.Normalize b)
838712 )
839713 => Relation a (Either a b)
840714i1 = R I.i1
841715
842716-- | Relational coproduct second component injection
843−--
844−-- @
845−-- 'img' 'i1' ``union`` 'img' 'i2' == 'id'
846−-- 'i1' `.` 'i2' = 'zeros'
847−-- @
848717i2 ::
849− ( CountableDimsN a b,
850− FLN a b,
851− FLN b b
718+ ( KnownNat (I.Count (I.Normalize b)),
719+ KnownNat (I.Count (I.Normalize a)),
720+ I.FromLists Boolean (I.Normalize a) (I.Normalize b),
721+ I.FromLists Boolean (I.Normalize b) (I.Normalize b),
722+ I.Normalize (Either a b) ~ Either (I.Normalize a) (I.Normalize b)
852723 )
853724 => Relation b (Either a b)
854725i2 = R I.i2
@@ -856,16 +727,15 @@ i2 = R I.i2
856727infixl 5 -|-
857728
858729-- | Relational coproduct functor.
859−--
860−-- @
861−-- r '-|-' s == 'eitherR' ('i1' `.` r) ('i2' `.` s)
862−-- @
863730(-|-) ::
864− ( CountableDimsN b d,
865− FLN b b,
866− FLN d b,
867− FLN b d,
868− FLN d d
731+ ( KnownNat (I.Count (I.Normalize d)),
732+ KnownNat (I.Count (I.Normalize b)),
733+ I.FromLists Boolean (I.Normalize b) (I.Normalize b),
734+ I.FromLists Boolean (I.Normalize d) (I.Normalize b),
735+ I.FromLists Boolean (I.Normalize b) (I.Normalize d),
736+ I.FromLists Boolean (I.Normalize d) (I.Normalize d),
737+ I.Normalize (Either a c) ~ Either (I.Normalize a) (I.Normalize c),
738+ I.Normalize (Either b d) ~ Either (I.Normalize b) (I.Normalize d)
869739 )
870740 => Relation a b -> Relation c d -> Relation (Either a c) (Either b d)
871741(-|-) (R a) (R b) = R ((I.-|-) a b)
@@ -873,136 +743,97 @@ infixl 5 -|-
873743-- Relational "Currying"
874744
875745-- | Relational 'trans'
876−--
877−-- Every n-ary relation can be expressed as a binary relation through
878−-- 'trans'/'untrans';
879−-- more-over, where each particular attribute is placed (input/output) is irrelevant.
880746trans ::
881− ( CountableDimsN a b,
882− CountableN c,
883− CountableDimsN (a, b) (c, b),
884− FLN (c, b) c,
885− FLN (c, b) b,
886− FLN (a, b) a,
887− FLN (a, b) b,
888− Trivial (a, b),
889− Trivial (c, b),
890− TrivialP a b,
891− TrivialP c b
747+ ( KnownNat (I.Count (I.Normalize (a, b))),
748+ KnownNat (I.Count (I.Normalize a)),
749+ KnownNat (I.Count (I.Normalize (c, b))),
750+ KnownNat (I.Count (I.Normalize b)),
751+ KnownNat (I.Count (I.Normalize c)),
752+ I.FromLists Boolean (I.Normalize (c, b)) (I.FromNat (I.Count c)),
753+ I.FromLists Boolean (I.Normalize (c, b)) (I.FromNat (I.Count b)),
754+ I.FromLists Boolean (I.Normalize (a, b)) (I.FromNat (I.Count b)),
755+ I.FromLists Boolean (I.Normalize (a, b)) (I.FromNat (I.Count a)),
756+ I.Normalize (a, b) ~ I.Normalize (I.Normalize (a, b)),
757+ I.Normalize (c, b) ~ I.Normalize (I.Normalize (c, b)),
758+ I.Normalize (I.Normalize a, I.Normalize b) ~ I.FromNat (I.Count (I.Normalize (a, b))),
759+ I.Normalize (I.Normalize c, I.Normalize b) ~ I.FromNat (I.Count (I.Normalize (c, b)))
892760 )
893761 => Relation (a, b) c -> Relation a (c, b)
894−trans r = splitR r sndR . conv fstR
762+trans r = splitR r p2 `comp` conv p1
895763
896764-- | Relational 'untrans'
897−--
898−-- Every n-ary relation can be expressed as a binary relation through
899−-- 'trans'/'untrans';
900−-- more-over, where each particular attribute is placed (input/output) is irrelevant.
901765untrans ::
902− ( CountableDimsN a b,
903− CountableN c,
904− CountableDimsN (a, b) (c, b),
905− FLN (c, b) c,
906− FLN (c, b) b,
907− FLN (a, b) b,
908− FLN (a, b) a,
909− Trivial (a, b),
910− Trivial (c, b),
911− TrivialP a b,
912− TrivialP c b
766+ ( KnownNat (I.Count (I.Normalize (a, b))),
767+ KnownNat (I.Count (I.Normalize a)),
768+ KnownNat (I.Count (I.Normalize (c, b))),
769+ KnownNat (I.Count (I.Normalize b)),
770+ KnownNat (I.Count (I.Normalize c)),
771+ I.FromLists Boolean (I.Normalize (c, b)) (I.FromNat (I.Count c)),
772+ I.FromLists Boolean (I.Normalize (c, b)) (I.FromNat (I.Count b)),
773+ I.FromLists Boolean (I.Normalize (a, b)) (I.FromNat (I.Count b)),
774+ I.FromLists Boolean (I.Normalize (a, b)) (I.FromNat (I.Count a)),
775+ I.Normalize (a, b) ~ I.Normalize (I.Normalize (a, b)),
776+ I.Normalize (c, b) ~ I.Normalize (I.Normalize (c, b)),
777+ I.Normalize (I.Normalize a, I.Normalize b) ~ I.FromNat (I.Count (I.Normalize (a, b))),
778+ I.Normalize (I.Normalize c, I.Normalize b) ~ I.FromNat (I.Count (I.Normalize (c, b)))
913779 )
914780 => Relation a (c, b) -> Relation (a, b) c
915−untrans s = fstR . conv (splitR (conv s) sndR)
781+untrans s = p1 `comp` conv (splitR (conv s) p2)
916782
917783-- | Transforms predicate @p@ into a correflexive relation.
918−--
919−-- @
920−-- 'predR' ('const' True) == 'id'
921−-- 'predR' ('const' False) == 'zeros'
922−-- @
923−--
924−-- @
925−-- 'predR' q `.` 'predR' p == 'predR' q ``union`` 'predR' p
926−-- @
927784predR ::
928785 ( Bounded a,
929786 Enum a,
930− Countable a,
931− CountableN a,
932− FLN a a,
933− FLN Bool a
787+ KnownNat (I.Count (I.Normalize a)),
788+ I.FromLists Boolean (I.Normalize a) (I.Normalize a),
789+ I.FromLists Boolean (I.Normalize Bool) (I.Normalize a)
934790 )
935− => Relation a Bool -> Relation a a
936−predR p = id `intersection` divisionF (fromF (const True)) p
791+ => (a -> Bool) -> Relation a a
792+predR p = identity `intersection` divisionF (fromF' (const True)) (fromF' p)
937793
938−-- | Equalizes functions @f@ and @g@.
794+-- | Equalizes functions @f@ and @g@.
939795-- That is, @'equalizer' f g@ is the largest coreflexive
940796-- that restricts @g@ so that @f@ and @g@ yield the same outputs.
941−--
942−-- @
943−-- 'equalizer' r r == 'id'
944−-- 'equalizer' ('point' True) ('point' False) == 'zeros'
945−-- @
946797equalizer ::
947− ( CountableN a,
948− FLN a a
798+ ( KnownNat (I.Count (I.Normalize a)),
799+ I.FromLists Boolean (I.Normalize a) (I.Normalize a)
949800 )
950801 => Relation a b -> Relation a b -> Relation a a
951−equalizer f g = id `intersection` divisionF f g
802+equalizer f g = identity `intersection` divisionF f g
952803
953804-- | Relational conditional guard.
954805--
955806-- @
956−-- 'guard' p = 'i2' ``overriddenBy`` 'i1' `.` 'predR' p
807+-- 'guard' p = 'i2' `'overriddenBy'` 'i1' `'comp'` 'predR' p
957808-- @
958−guard ::
809+guard ::
959810 ( Bounded b,
960811 Enum b,
961− CountableN b,
962− Countable b,
963− FLN b b,
964− FLN Bool b
965− ) => Relation b Bool -> Relation b (Either b b)
966−guard p = conv (eitherR (predR p) (predR (negate p)))
812+ KnownNat (I.Count (I.Normalize b)),
813+ I.FromLists Boolean (I.Normalize b) (I.Normalize b),
814+ I.FromLists Boolean (I.Normalize Bool) (I.Normalize b),
815+ I.Normalize (Either b b) ~ Either (I.Normalize b) (I.Normalize b)
816+ ) => (b -> Bool) -> Relation b (Either b b)
817+guard p = conv (eitherR (predR p) (predR (not . p)))
967818
968819-- | Relational McCarthy's conditional.
969−cond ::
820+cond ::
970821 ( Bounded b,
971822 Enum b,
972− Countable b,
973− CountableN b,
974− FLN b b,
975− FLN Bool b
976− )
977− => Relation b Bool -> Relation b c -> Relation b c -> Relation b c
978−cond p r s = eitherR r s . guard p
979−
980−-- | Relational domain.
981−--
982−-- For injective relations, 'domain' and 'ker'nel coincide,
983−-- since @'ker' r ``sse`` 'id'@ in such situations.
984−domain ::
985− ( CountableN a,
986− FLN a a
987− ) => Relation a b -> Relation a a
988−domain r = ker r `intersection` id
989−
990−-- | Relational range.
991−--
992−-- For functions, 'range' and 'img' (image) coincide,
993−-- since @'img' f ``sse`` id@ for any @f@.
994−range ::
995− ( CountableN b,
996− FLN b b
997− ) => Relation a b -> Relation b b
998−range r = img r `intersection` id
823+ KnownNat (I.Count (I.Normalize b)),
824+ I.FromLists Boolean (I.Normalize b) (I.Normalize b),
825+ I.FromLists Boolean (I.Normalize Bool) (I.Normalize b),
826+ I.Normalize (Either b b) ~ Either (I.Normalize b) (I.Normalize b)
827+ )
828+ => (b -> Bool) -> Relation b c -> Relation b c -> Relation b c
829+cond p r s = eitherR r s `comp` guard p
999830
1000831-- Relation pretty print
1001832
1002833-- | Relation pretty printing
1003−pretty :: (CountableDimsN a b) => Relation a b -> String
834+pretty :: (KnownNat (I.Count (I.Normalize a))) => Relation a b -> String
1004835pretty (R a) = I.pretty a
1005836
1006837-- | Relation pretty printing
1007−prettyPrint :: (CountableDimsN a b) => Relation a b -> IO ()
838+prettyPrint :: (KnownNat (I.Count (I.Normalize a))) => Relation a b -> IO ()
1008839prettyPrint (R a) = I.prettyPrint a
src/LAoP/Utils.hs−6
@@ -94,12 +94,6 @@ module LAoP.Utils
9494 coerceNat,
9595 coerceNat2,
9696 coerceNat3,
97−
98− -- * List data type
99− List (..),
100−
101− -- * Category type-class
102− Category(..)
10397 )
10498where
10599
src/LAoP/Utils/Internal.hs+73−70
@@ -1,13 +1,82 @@
1−{-# LANGUAGE TypeFamilies #-}
2−{-# LANGUAGE DeriveGeneric #-}
31{-# LANGUAGE TypeApplications #-}
42{-# LANGUAGE DataKinds #-}
53{-# LANGUAGE FlexibleInstances #-}
64{-# LANGUAGE GeneralizedNewtypeDeriving #-}
5+{-# LANGUAGE KindSignatures #-}
76{-# LANGUAGE ScopedTypeVariables #-}
87
98module LAoP.Utils.Internal
10− (
9+ ( -- | This is an internal module and it is not meant to be imported.
10+ --
11+ -- Utility module that provides the 'Natural' data type.
12+ -- The semantic associated with this data type is that
13+ -- it's meant to be a restricted 'Int' value. For example
14+ -- the type @Natural 6@ can only be instanciated with @Nat n@
15+ -- where @0 <= n <= 6@. Why, You might ask, because with normal
16+ -- 'Int's it is not possible to have a decent @Enum (Int, Int)@
17+ -- instance. See the following probabilistic programming model as and
18+ -- example:
19+ --
20+ -- We want to calculate the probability of the sum of two dice throws.
21+ -- To do this we start by defining the sample space:
22+ --
23+ -- @
24+ -- type SampleSpace = Int -- We think 'Int' are enough
25+ --
26+ -- die :: Dist Int 6
27+ -- die = unifrom [1..6]
28+ --
29+ -- -- Promote 'Int' addition to a matrix
30+ -- addM = fromF (uncurry (+)) -- Impossible
31+ -- @
32+ --
33+ -- The last line is impossible because @(Int, Int)@ does not have
34+ -- a good 'Enum' instance: @[(0, 1), (0, 2), .. (0, maxBound), (1, 0),
35+ -- ..]@. And we'd like the addition matrix to be of 36 columns by 12
36+ -- rows but limited to integers up to @6@!
37+ --
38+ -- One way to solve this issue is by defining and auxilary data type to
39+ -- represent the sample space:
40+ --
41+ -- @
42+ -- data SampleSpace = S1 | S2 | S3 | S4 | S5 | S6
43+ -- deriving (Show, Eq, Enum, Bounded) -- Enum and Bounded are
44+ -- important
45+ -- @
46+ --
47+ -- And write the sample space addition function:
48+ --
49+ -- @
50+ -- ssAdd :: SampleSpace -> SampleSpace -> Int
51+ -- ssAdd a b = (fromEnum a + 1) + (fromEnum b + 1)
52+ -- @
53+ --
54+ -- And then promote that function to matrix and everything is alright:
55+ --
56+ -- @
57+ -- ssAddM = fromF' (uncurry ssAdd)
58+ --
59+ -- dieSumProb = ssAddM `comp` (khatri die die)
60+ -- @
61+ --
62+ -- This is a nice solution for small sample spaces. But for larger ones
63+ -- it is not feasible to write a data type with hundreds of constructors
64+ -- and then write manipulation functions that need to deal with them.
65+ -- To mitigate this limitation the 'Natural' type comes a long way and
66+ -- allows one to model the sample in an easier way. See for instance:
67+ --
68+ -- @
69+ -- ssAdd :: Natural 6 -> Natural 6 -> Natural 12
70+ -- ssAdd = coerceNat (+)
71+ --
72+ -- ssAddM = fromF' (uncurry sumSS)
73+ --
74+ -- die :: Dist (Natural 6) 6
75+ -- die = uniform [nat @6 1 .. nat 6]
76+ --
77+ -- dieSumProb = ssAddM `comp` (khatri die die)
78+ -- @
79+ --
1180 -- * 'Natural' data type
1281 Natural(..),
1382 nat,
@@ -17,31 +86,19 @@ module LAoP.Utils.Internal
1786 coerceNat,
1887 coerceNat2,
1988 coerceNat3,
20−
21− -- * 'List' data type
22− List (..),
23−
24− -- * Category type class
25− Category(..)
2689 )
2790where
2891
2992import Data.Coerce
3093import Data.Proxy
31−import Data.List
32−import Data.Maybe
3394import GHC.TypeLits
3495import Control.DeepSeq
35−import GHC.Generics
36−import Data.Kind
37−import Prelude hiding (id, (.))
38−import qualified Prelude
3996
4097-- | Wrapper around 'Int's that have a restrictive semantic associated.
4198-- A value of type @'Natural' n m@ can only be instanciated with some 'Int'
4299-- @i@ that's @n <= i <= m@.
43100newtype Natural (start :: Nat) (end :: Nat) = Nat Int
44− deriving (Show, Read, Eq, Ord, NFData, Generic)
101+ deriving (Show, Read, Eq, Ord, NFData)
45102
46103-- | Throws a runtime error if any of the operations overflows or
47104-- underflows.
@@ -140,57 +197,3 @@ instance
140197
141198 fromEnum (Left a) = fromEnum a
142199 fromEnum (Right b) = fromEnum (maxBound :: a) + fromEnum b + 1
143−
144−-- | Powerset data type.
145−--
146−-- This data type is a newtype wrapper around '[]'. This exists in order to
147−-- implement an 'Enum' and 'Bounded' instance that cannot be harmful for the outside.
148−newtype List a = L [a]
149− deriving (Eq, Show, Read)
150−
151−powerset :: [a] -> [[a]]
152−powerset [] = [[]]
153−powerset (x:xs) = powerset xs ++ [x:ps | ps <- powerset xs]
154−
155−instance
156− ( Enum a,
157− Bounded a
158− ) => Bounded (List a)
159− where
160− minBound = L []
161− maxBound = L [minBound .. maxBound]
162−
163−instance
164− ( Bounded a,
165− Enum a,
166− Eq a
167− ) => Enum (List a)
168− where
169− toEnum i =
170− let as = [minBound .. maxBound]
171− in L (powerset as !! i)
172−
173− fromEnum (L []) = 0
174− fromEnum (L x) =
175− let as = [minBound .. maxBound]
176− in fromMaybe (error "Does not exist") $ elemIndex x (powerset as)
177−
178−-- | Constrained category instance
179−class Category k where
180− type Object k o :: Constraint
181− type Object k o = ()
182− id :: Object k a => k a a
183− (.) :: k b c -> k a b -> k a c
184−
185−{-# RULES
186−"identity/left" forall p .
187− id . p = p
188−"identity/right" forall p .
189− p . id = p
190−"association" forall p q r .
191− (p . q) . r = p . (q . r)
192− #-}
193−
194−instance Category (->) where
195− id = Prelude.id
196− (.) = (Prelude..)
stack-8.8.3.yamldeleted−1
@@ -1 +0,0 @@
1−resolver: lts-15.5
stack.yaml+66−1
@@ -1 +1,66 @@
1−resolver: lts-14.3
1+# This file was automatically generated by 'stack init'
2+#
3+# Some commonly used options have been documented as comments in this file.
4+# For advanced use and comprehensive documentation of the format, please see:
5+# https://docs.haskellstack.org/en/stable/yaml_configuration/
6+
7+# Resolver to choose a 'specific' stackage snapshot or a compiler version.
8+# A snapshot resolver dictates the compiler version and the set of packages
9+# to be used for project dependencies. For example:
10+#
11+# resolver: lts-3.5
12+# resolver: nightly-2015-09-21
13+# resolver: ghc-7.10.2
14+#
15+# The location of a snapshot can be provided as a file or url. Stack assumes
16+# a snapshot provided as a file might change, whereas a url resource does not.
17+#
18+# resolver: ./custom-snapshot.yaml
19+# resolver: https://example.com/snapshots/2018-01-01.yaml
20+resolver: lts-14.18
21+
22+# User packages to be built.
23+# Various formats can be used as shown in the example below.
24+#
25+# packages:
26+# - some-directory
27+# - https://example.com/foo/bar/baz-0.0.2.tar.gz
28+# subdirs:
29+# - auto-update
30+# - wai
31+packages:
32+- .
33+# Dependency packages to be pulled from upstream that are not in the resolver.
34+# These entries can reference officially published versions as well as
35+# forks / in-progress versions pinned to a git hash. For example:
36+#
37+# extra-deps:
38+# - acme-missiles-0.3
39+# - git: https://github.com/commercialhaskell/stack.git
40+# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
41+#
42+# extra-deps: []
43+
44+# Override default flag values for local packages and extra-deps
45+# flags: {}
46+
47+# Extra package databases containing global packages
48+# extra-package-dbs: []
49+
50+# Control whether we use the GHC we find on the path
51+# system-ghc: true
52+#
53+# Require a specific version of stack, using version ranges
54+# require-stack-version: -any # Default
55+# require-stack-version: ">=2.1"
56+#
57+# Override the architecture used by stack, especially useful on Windows
58+# arch: i386
59+# arch: x86_64
60+#
61+# Extra directories used by stack for building
62+# extra-include-dirs: [/path/to/dir]
63+# extra-lib-dirs: [/path/to/dir]
64+#
65+# Allow a newer minor version of GHC than the snapshot specifies
66+# compiler-check: newer-minor
stack.yaml.lock+4−4
@@ -6,7 +6,7 @@
66packages: []
77snapshots:
88- completed:
9− size: 523878
10− url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/14/3.yaml
11− sha256: 470c46c27746a48c7c50f829efc0cf00112787a7804ee4ac7a27754658f6d92c
12− original: lts-14.3
9+ size: 524789
10+ url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/14/18.yaml
11+ sha256: 646be71223e08234131c6989912e6011e01b9767bc447b6d466a35e14360bdf2
12+ original: lts-14.18
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/Examples/Spreadsheets.hsdeleted−47
@@ -1,47 +0,0 @@
1−{-# LANGUAGE DeriveGeneric #-}
2−
3−module Examples.Spreadsheets
4−
5−import LAoP.Utils
6−import LAoP.Matrix.Type
7−import GHC.Generics
8−import Prelude hiding (id, (.))
9−
10−data Student = Student1 | Student2 | Student3 | Student4
11− deriving (Eq, Show, Enum, Bounded, Generic)
12−
13−data Question = Question1 | Question2 | Question3 | Question4
14− deriving (Eq, Show, Enum, Bounded, Generic)
15−
16−data Results = Exam | Test | Final
17− deriving (Eq, Show, Enum, Bounded, Generic)
18−
19−test :: Matrix Float One Results
20−test = point Test
21−
22−exam :: Matrix Float One Results
23−exam = point Exam
24−
25−final :: Matrix Float One Results
26−final = point Final
27−
28−m :: Matrix Float Question Student
29−m = fromLists [[95, 90, 100, 40], [20, 90, 90, 0], [30, 20, 95, 0], [50, 80, 100, 30]]
30−
31−w :: Matrix Float Question One
32−w = fromLists [[0.2, 0.3, 0.2, 0.3]]
33−
34−xls :: Matrix Float Question One
35− -> Matrix Float Question Student
36− -> Matrix Float Student One
37− -> Matrix Float (Either Question Results) (Either One Student)
38−xls w m t = join (fork w m) (fork zeros r)
39− where
40− rExam = m . tr w
41− rTest = tr t
42− rFinal = rTest `maxPW` rExam
43− r = (rExam . tr exam) + (rTest . tr test) + (rFinal . tr final)
44−
45−-- | Overloaded, point-wise 'max' function
46−maxPW :: Ord e => Matrix e a b -> Matrix e a b -> Matrix e a b
47−maxPW = zipWithM max
test/Spec.hs+1−7
@@ -1,8 +1,2 @@
1−module Main (main) where
2−
3−import qualified Examples.Readme as RD
4−
51main :: IO ()
6−main = do
7− putStrLn ("Testing if README works" :: String)
8− RD.exec
2+main = putStrLn "Test suite not yet implemented"