git.iko.soy/laop
on ab2a4da help sign in
eea6231
swap
0 ahead, 54 behind
31 files changed+1300−1833
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+27−35 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+3−4 src/LAoP/Dist/Internal.hs+33−71 src/LAoP/Matrix/Internal.hs+379−414 src/LAoP/Matrix/Nat.hs+124−139 src/LAoP/Matrix/Type.hs+180−246 src/LAoP/Relation.hs+11−8 src/LAoP/Relation/Internal.hs+254−250 src/LAoP/Utils.hs+2−5 src/LAoP/Utils/Internal.hs+75−33 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+27−35
@@ -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,36 @@ 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)
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 module representation that uses normal datatypes (`Void`, `()`, `Either`) for matrix dimensions and two
20+ type families `FromNat` and `Count` to make it easier to work with these type of matrices.
21+- An interfacing module that uses generalised types for the dimensions and is just a newtype wrapper
22+ around the internal matrix data type.
23+- An interfacing module that uses type level naturals for the dimensions and is just a newtype wrapper
24+ around the internal matrix data type.
25+- An interfacing module that restricts the matrix contents to being only 0's or 1's (True
26+ and False). This module is called 'Relation' and offers many of the combinators seen in
27+ AoP and Relational Calculus/Algebra.
28+- A very simple Probabilistic Programming module and several functions and data types to
29+ make it easier to deal with sample space.
30+
31+Given this, this new matrix formulation compared to other libraries one has much more advantages, such as:
32+
33+- Has an inductive definition enabling writing matrix manipulation functions in a much more elegant and calculational way;
34+- Statically typed dimensions;
35+- Polymorphic data type dimensions;
36+- Polymorphic matrix content;
37+- Awesome dimension type inference;
38+- Fast type natural conversion via `FromNat` type family;
39+- Matrix `Junc` and `Split`-ing in O(1);
40+- Matrix composition takes advantage of divide-and-conquer and fusion laws.
41+
42+Unfortunately, this approach does not solve the issue of type dimensions being in some way constrainted making it impossible to write Arrow instances, for example. Type inference isn't perfect, when it comes to infer the types of matrices which dimensions are computed using type level naturals multiplication, the compiler needs type annotations in order to succeed.
5143
5244## Notes
5345
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 --publish
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+3−4
@@ -39,10 +39,11 @@ module LAoP.Dist
3939 -- * Constraint type synonyms
4040 Countable,
4141 CountableN,
42− CountableDimsN,
43− FLN,
42+ CountableDimensionsN,
43+ FromListsN,
4444 Liftable,
4545 TrivialP,
46+ TrivialE,
4647
4748 -- * Functor instance equivalent functions
4849 fmapD,
@@ -53,8 +54,6 @@ module LAoP.Dist
5354
5455 -- * Selective equivalent functions
5556 selectD,
56− branchD,
57− ifD,
5857
5958 -- * Monad equivalent functions
6059 returnD,
src/LAoP/Dist/Internal.hs+33−71
@@ -1,4 +1,3 @@
1−{-# LANGUAGE DerivingVia #-}
21{-# LANGUAGE ConstraintKinds #-}
32{-# LANGUAGE GADTs #-}
43{-# LANGUAGE AllowAmbiguousTypes #-}
@@ -16,17 +15,16 @@ module LAoP.Dist.Internal
1615
1716 Countable,
1817 CountableN,
19− CountableDimsN,
20− FLN,
18+ CountableDimensionsN,
19+ FromListsN,
2120 Liftable,
2221 TrivialP,
22+ TrivialE,
2323
2424 fmapD,
2525 unitD,
2626 multD,
2727 selectD,
28− branchD,
29− ifD,
3028 returnD,
3129 bindD,
3230 (??),
@@ -43,15 +41,12 @@ module LAoP.Dist.Internal
4341 )
4442 where
4543
46−import LAoP.Matrix.Type hiding (TrivialP, Countable, CountableDims, CountableN, CountableDimsN, Liftable, FLN)
47−import Prelude hiding (id, (.))
44+import LAoP.Matrix.Type hiding (TrivialP, TrivialE, Countable, CountableDimensions, CountableN, CountableDimensionsN, Liftable, FromListsN)
4845import qualified LAoP.Matrix.Internal as I
4946import LAoP.Utils
5047import GHC.TypeLits
5148import Data.Proxy
5249import Data.List (sortBy)
53−import Control.DeepSeq
54−import Data.Bool
5550
5651-- | Type synonym for probability value
5752type Prob = Double
@@ -59,21 +54,21 @@ type Prob = Double
5954-- | Type synonym for column vector matrices. This represents a probability
6055-- distribution.
6156newtype Dist a = D (Matrix Prob () a)
62− deriving (Show, Num, Eq, Ord, NFData) via (Matrix Prob () a)
6357
6458-- | 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)
59+type Countable a = KnownNat (I.Count a)
60+type CountableN a = KnownNat (I.Count (I.Normalize a))
61+type CountableDimensionsN a b = (CountableN a, CountableN b)
62+type FromListsN a b = I.FromLists Prob (I.Normalize a) (I.Normalize b)
63+type Liftable a b = (Bounded a, Bounded b, Enum a, Enum b, Eq b, Num Prob, Ord Prob)
64+type TrivialP a b = Normalize (a, b) ~ Normalize (Normalize a, Normalize b)
65+type TrivialE a b = Normalize (Either a b) ~ Either (Normalize a) (Normalize b)
7166
7267-- | Functor instance
7368fmapD ::
7469 ( Liftable a b,
75− CountableDimsN a b,
76− FLN b a
70+ CountableDimensionsN a b,
71+ FromListsN b a
7772 )
7873 =>
7974 (a -> b) -> Dist a -> Dist b
@@ -85,58 +80,25 @@ unitD = D (one 1)
8580
8681-- | Applicative/Monoidal instance 'mult' function
8782multD ::
88− ( CountableDimsN a b,
83+ ( CountableDimensionsN a b,
8984 CountableN (a, b),
90− FLN (a, b) a,
91− FLN (a, b) b,
85+ FromListsN (a, b) a,
86+ FromListsN (a, b) b,
9287 TrivialP a b
9388 ) => Dist a -> Dist b -> Dist (a, b)
94−multD (D a) (D b) = D (kr a b)
89+multD (D a) (D b) = D (khatri a b)
9590
9691-- | Selective instance function
9792selectD ::
98− ( FLN b b,
93+ ( TrivialE a b,
94+ FromListsN b b,
9995 CountableN b
10096 ) => 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
97+selectD (D d) m = D (junc m identity `comp` d)
98+
13799
138100-- | Monad instance 'return' function
139−returnD :: forall a . (Enum a, FLN () a, Countable a) => a -> Dist a
101+returnD :: forall a . (Enum a, FromListsN () a, Countable a) => a -> Dist a
140102returnD a = D (col l)
141103 where
142104 i = fromInteger $ natVal (Proxy :: Proxy (Count a))
@@ -151,7 +113,7 @@ bindD (D d) m = D (m `comp` d)
151113(??) ::
152114 ( Enum a,
153115 Countable a,
154− FLN () a
116+ FromListsN () a
155117 ) => (a -> Bool) -> Dist a -> Prob
156118(??) p d =
157119 let l = toValues d
@@ -161,11 +123,11 @@ bindD (D d) m = D (m `comp` d)
161123-- Distribution Construction
162124
163125-- | Constructs a Bernoulli distribution
164−choose :: (FLN () a) => Prob -> Dist a
126+choose :: (FromListsN () a) => Prob -> Dist a
165127choose prob = D (col [prob, 1 - prob])
166128
167129-- | Creates a distribution given a shape function
168−shape :: (FLN () a) => (Prob -> Prob) -> [a] -> Dist a
130+shape :: (FromListsN () a) => (Prob -> Prob) -> [a] -> Dist a
169131shape _ [] = error "Probability.shape: empty list"
170132shape f xs =
171133 let incr = 1 / fromIntegral (length xs - 1)
@@ -173,23 +135,23 @@ shape f xs =
173135 in fromFreqs (zip xs ps)
174136
175137-- | Constructs a Linear distribution
176−linear :: (FLN () a) => [a] -> Dist a
138+linear :: (FromListsN () a) => [a] -> Dist a
177139linear = shape id
178140
179141-- | Constructs an Uniform distribution
180−uniform :: (FLN () a) => [a] -> Dist a
142+uniform :: (FromListsN () a) => [a] -> Dist a
181143uniform = shape (const 1)
182144
183145-- | Constructs an Negative Exponential distribution
184−negExp :: (FLN () a) => [a] -> Dist a
146+negExp :: (FromListsN () a) => [a] -> Dist a
185147negExp = shape (\x -> exp (-x))
186148
187149-- | Constructs an Normal distribution
188−normal :: (FLN () a) => [a] -> Dist a
150+normal :: (FromListsN () a) => [a] -> Dist a
189151normal = shape (normalCurve 0.5 0.5)
190152
191153-- | Transforms a 'Dist' into a list of pairs.
192−toValues :: forall a . (Enum a, Countable a, FLN () a) => Dist a -> [(a, Prob)]
154+toValues :: forall a . (Enum a, Countable a, FromListsN () a) => Dist a -> [(a, Prob)]
193155toValues (D d) =
194156 let rows = fromInteger (natVal (Proxy :: Proxy (Count a)))
195157 probs = toList d
@@ -197,7 +159,7 @@ toValues (D d) =
197159 in res
198160
199161-- | Pretty a distribution
200−prettyDist :: forall a. (Show a, Enum a, Countable a, FLN () a) => Dist a -> String
162+prettyDist :: forall a. (Show a, Enum a, Countable a, FromListsN () a) => Dist a -> String
201163prettyDist d =
202164 let values = sortBy (\(a, p1) (b, p2) -> compare p2 p1) (toValues @a d)
203165 w = maximum (map (length . show . fst) values)
@@ -209,12 +171,12 @@ prettyDist d =
209171 showR n x = show x ++ " "
210172
211173-- | Pretty Print a distribution
212−prettyPrintDist :: forall a . (Show a, Enum a, Countable a, FLN () a) => Dist a -> IO ()
174+prettyPrintDist :: forall a . (Show a, Enum a, Countable a, FromListsN () a) => Dist a -> IO ()
213175prettyPrintDist = putStrLn . prettyDist @a
214176
215177-- Auxiliary functions
216178
217−fromFreqs :: (FLN () a) => [(a,Prob)] -> Dist a
179+fromFreqs :: (FromListsN () a) => [(a,Prob)] -> Dist a
218180fromFreqs xs = D (col (map (\(x,p) -> p/q) xs))
219181 where q = sum $ map snd xs
220182
src/LAoP/Matrix/Internal.hs+379−414
@@ -1,4 +1,3 @@
1−{-# LANGUAGE StrictData #-}
21{-# LANGUAGE TypeFamilyDependencies #-}
32{-# LANGUAGE ConstraintKinds #-}
43{-# LANGUAGE AllowAmbiguousTypes #-}
@@ -30,7 +29,7 @@
3029-- motivation behind the library, the underlying theory, and implementation details.
3130--
3231-- This module offers many of the combinators mentioned in the work of
33−-- Macedo (2012) and Oliveira (2012).
32+-- Macedo (2012) and Oliveira (2012).
3433--
3534-- This is an Internal module and it is no supposed to be imported.
3635--
@@ -43,26 +42,17 @@ module LAoP.Matrix.Internal
4342 --
4443 -- There exists two type families that make it easier to write
4544 -- matrix dimensions: 'FromNat' and 'Count'. This approach
46− -- leads to a very straightforward implementation
47− -- of LAoP combinators.
45+ -- leads to a very straightforward implementation
46+ -- of LAoP combinators.
4847
4948 -- * Type safe matrix representation
5049 Matrix (..),
5150
52− -- * Constraint type aliases
53− Countable,
54− CountableDims,
55− CountableN,
56− CountableDimsN,
57− FL,
58− FLN,
59− Liftable,
60− Trivial,
61−
6251 -- * Primitives
52+ empty,
6353 one,
64− join,
65− fork,
54+ junc,
55+ split,
6656
6757 -- * Auxiliary type families
6858 FromNat,
@@ -75,7 +65,6 @@ module LAoP.Matrix.Internal
7565 toLists,
7666 toList,
7767 matrixBuilder,
78− matrixBuilder',
7968 row,
8069 col,
8170 zeros,
@@ -86,38 +75,28 @@ module LAoP.Matrix.Internal
8675 -- * Misc
8776 -- ** Get dimensions
8877 columns,
89− columns',
9078 rows,
91− rows',
9279
9380 -- ** Matrix Transposition
9481 tr,
9582
96− -- ** Scalar multiplication/division of matrices
97− (.|),
98− (./),
99−
10083 -- ** Selective operator
101− select,
102− branch,
84+ select,
10385
10486 -- ** McCarthy's Conditional
10587 cond,
10688
10789 -- ** Matrix "abiding"
108− abideJF,
109− abideFJ,
110−
111− -- ** Zip matrices
112− zipWithM,
90+ abideJS,
91+ abideSJ,
11392
11493 -- * Biproduct approach
115− -- ** Fork
94+ -- ** Split
11695 (===),
11796 -- *** Projections
11897 p1,
11998 p2,
120− -- ** Join
99+ -- ** Junc
121100 (|||),
122101 -- *** Injections
123102 i1,
@@ -130,13 +109,12 @@ module LAoP.Matrix.Internal
130109
131110 -- | Note that given the restrictions imposed it is not possible to
132111 -- implement the standard type classes present in standard Haskell.
133−
134112 -- *** Matrix pairing projections
135− fstM,
136− sndM,
113+ kp1,
114+ kp2,
137115
138116 -- *** Matrix pairing
139− kr,
117+ khatri,
140118
141119 -- * Matrix composition and lifting
142120
@@ -144,10 +122,10 @@ module LAoP.Matrix.Internal
144122
145123 -- | Note that given the restrictions imposed it is not possible to
146124 -- implement the standard type classes present in standard Haskell.
147− iden,
125+ identity,
148126 comp,
149− fromF',
150127 fromF,
128+ fromF',
151129
152130 -- * Matrix printing
153131 pretty,
@@ -174,22 +152,21 @@ import LAoP.Utils.Internal
174152import Data.Bool
175153import Data.Kind
176154import Data.List
177−import Data.Maybe
178155import Data.Proxy
179−import Data.Typeable
180156import Data.Void
181157import GHC.TypeLits
182158import Data.Type.Equality
183159import GHC.Generics
184160import Control.DeepSeq
185−import Prelude hiding (id, (.))
186−import qualified Prelude (id, (.))
161+import Control.Category
162+import Prelude hiding ((.))
187163
188164-- | LAoP (Linear Algebra of Programming) Inductive Matrix definition.
189165data Matrix e cols rows where
166+ Empty :: Matrix e Void Void
190167 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)
168+ Junc :: Matrix e a rows -> Matrix e b rows -> Matrix e (Either a b) rows
169+ Split :: Matrix e cols a -> Matrix e cols b -> Matrix e cols (Either a b)
193170
194171deriving instance (Show e) => Show (Matrix e cols rows)
195172
@@ -216,197 +193,205 @@ type family Count (d :: Type) :: Nat where
216193--
217194-- Thanks to Li-Yao Xia this type family is super fast.
218195type family FromNat (n :: Nat) :: Type where
196+ FromNat 0 = Void
219197 FromNat 1 = ()
220198 FromNat n = FromNat' (Mod n 2 == 0) (FromNat (Div n 2))
221199
222200type family FromNat' (b :: Bool) (m :: Type) :: Type where
223− FromNat' 'True m = Either m m
201+ FromNat' 'True m = Either m m
224202 FromNat' 'False m = Either () (Either m m)
225203
226204-- | Type family that normalizes the representation of a given data
227205-- structure
228206type family Normalize (d :: Type) :: Type where
229− Normalize (Either a b) = Either (Normalize a) (Normalize b)
230− Normalize d = FromNat (Count d)
207+ Normalize d = FromNat (Count d)
231208
232209-- | Constraint type synonyms to keep the type signatures less convoluted
233210type Countable a = KnownNat (Count a)
234211type 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)
212+type CountableDimensions a b = (Countable a, Countable b)
213+type CountableDimensionsN a b = (CountableN a, CountableN b)
214+type FromListsN e a b = FromLists e (Normalize a) (Normalize b)
239215type 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
241216
242−-- | It is possible to implement a constrained version of the category type
243−-- class.
217+-- | It isn't possible to implement the 'id' function so it's
218+-- implementation is 'undefined'. However 'comp' can be and this partial
219+-- class implementation exists just to make the code more readable.
220+--
221+-- Please use 'identity' instead.
244222instance (Num e) => Category (Matrix e) where
245− type Object (Matrix e) a = (FL a a, Countable a)
246− id = iden
247− (.) = comp
223+ id = undefined
224+ (.) = comp
248225
249226instance 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
227+ rnf Empty = ()
228+ rnf (One e) = rnf e
229+ rnf (Junc a b) = rnf a `seq` rnf b
230+ rnf (Split a b) = rnf a `seq` rnf b
253231
254232instance 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
233+ Empty == Empty = True
234+ (One a) == (One b) = a == b
235+ (Junc a b) == (Junc c d) = a == c && b == d
236+ (Split a b) == (Split c d) = a == c && b == d
237+ x@(Split _ _) == y@(Junc _ _) = x == abideJS y
238+ x@(Junc _ _) == y@(Split _ _) = abideJS x == y
260239
261240instance 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
267241
268− abs (One a) = One (abs a)
269− abs (Join a b) = Join (abs a) (abs b)
270− abs (Fork a b) = Fork (abs a) (abs b)
271−
272− signum (One a) = One (signum a)
273− signum (Join a b) = Join (signum a) (signum b)
274− signum (Fork a b) = Fork (signum a) (signum b)
242+ Empty + Empty = Empty
243+ (One a) + (One b) = One (a + b)
244+ (Junc a b) + (Junc c d) = Junc (a + c) (b + d)
245+ (Split a b) + (Split c d) = Split (a + c) (b + d)
246+ x@(Split _ _) + y@(Junc _ _) = x + abideJS y
247+ x@(Junc _ _) + y@(Split _ _) = abideJS x + y
248+
249+ Empty - Empty = Empty
250+ (One a) - (One b) = One (a - b)
251+ (Junc a b) - (Junc c d) = Junc (a - c) (b - d)
252+ (Split a b) - (Split c d) = Split (a - c) (b - d)
253+ x@(Split _ _) - y@(Junc _ _) = x - abideJS y
254+ x@(Junc _ _) - y@(Split _ _) = abideJS x - y
255+
256+ Empty * Empty = Empty
257+ (One a) * (One b) = One (a * b)
258+ (Junc a b) * (Junc c d) = Junc (a * c) (b * d)
259+ (Split a b) * (Split c d) = Split (a * c) (b * d)
260+ x@(Split _ _) * y@(Junc _ _) = x * abideJS y
261+ x@(Junc _ _) * y@(Split _ _) = abideJS x * y
262+
263+ abs Empty = Empty
264+ abs (One a) = One (abs a)
265+ abs (Junc a b) = Junc (abs a) (abs b)
266+ abs (Split a b) = Split (abs a) (abs b)
267+
268+ signum Empty = Empty
269+ signum (One a) = One (signum a)
270+ signum (Junc a b) = Junc (signum a) (signum b)
271+ signum (Split a b) = Split (signum a) (signum b)
275272
276273instance 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
274+ Empty <= Empty = True
275+ (One a) <= (One b) = a <= b
276+ (Junc a b) <= (Junc c d) = (a <= c) && (b <= d)
277+ (Split a b) <= (Split c d) = (a <= c) && (b <= d)
278+ x@(Split _ _) <= y@(Junc _ _) = x <= abideJS y
279+ x@(Junc _ _) <= y@(Split _ _) = abideJS x <= y
282280
283281-- Primitives
284282
283+-- | Empty matrix constructor
284+empty :: Matrix e Void Void
285+empty = Empty
286+
285287-- | Unit matrix constructor
286288one :: e -> Matrix e () ()
287289one = One
288290
289−-- | Matrix 'Join' constructor
290−join :: Matrix e a rows -> Matrix e b rows -> Matrix e (Either a b) rows
291−join = Join
291+-- | Matrix 'Junc' constructor
292+junc :: Matrix e a rows -> Matrix e b rows -> Matrix e (Either a b) rows
293+junc = Junc
292294
293295infixl 3 |||
294296
295−-- | Matrix 'Join' constructor
297+-- | Matrix 'Junc' constructor
296298(|||) :: Matrix e a rows -> Matrix e b rows -> Matrix e (Either a b) rows
297−(|||) = Join
299+(|||) = Junc
298300
299−-- | Matrix 'Fork' constructor
300−fork :: Matrix e cols a -> Matrix e cols b -> Matrix e cols (Either a b)
301−fork = Fork
301+-- | Matrix 'Split' constructor
302+split :: Matrix e cols a -> Matrix e cols b -> Matrix e cols (Either a b)
303+split = Split
302304
303305infixl 2 ===
304306
305−-- | Matrix 'Fork' constructor
307+-- | Matrix 'Split' constructor
306308(===) :: Matrix e cols a -> Matrix e cols b -> Matrix e cols (Either a b)
307−(===) = Fork
309+(===) = Split
308310
309311-- Construction
310312
311313-- | Type class for defining the 'fromList' conversion function.
312314--
313315-- 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
316+-- classes are needed bery much like an inductive definition but on types.
317+class FromLists e cols rows where
316318 -- | Build a matrix out of a list of list of elements. Throws a runtime
317319 -- error if the dimensions do not match.
318320 fromLists :: [[e]] -> Matrix e cols rows
319321
320−instance FromLists () () where
322+instance FromLists e Void Void where
323+ fromLists [] = Empty
324+ fromLists _ = error "Wrong dimensions"
325+
326+instance {-# OVERLAPPING #-} FromLists e () () where
321327 fromLists [[e]] = One e
322328 fromLists _ = error "Wrong dimensions"
323329
324−instance (FromLists cols ()) => FromLists (Either () cols) () where
325− fromLists [h : t] = Join (One h) (fromLists [t])
330+instance {-# OVERLAPPING #-} (FromLists e cols ()) => FromLists e (Either () cols) () where
331+ fromLists [h : t] = Junc (One h) (fromLists [t])
326332 fromLists _ = error "Wrong dimensions"
327333
328−instance {-# OVERLAPPABLE #-}
329− (FromLists a (), FromLists b (), Countable a) => FromLists (Either a b) () where
330− fromLists [l] =
334+instance {-# OVERLAPPABLE #-} (FromLists e a (), FromLists e b (), Countable a) => FromLists e (Either a b) () where
335+ fromLists [l] =
331336 let rowsA = fromInteger (natVal (Proxy :: Proxy (Count a)))
332− in Join (fromLists [take rowsA l]) (fromLists [drop rowsA l])
337+ in Junc (fromLists [take rowsA l]) (fromLists [drop rowsA l])
333338 fromLists _ = error "Wrong dimensions"
334339
335−instance (FromLists () rows) => FromLists () (Either () rows) where
336− fromLists ([h] : t) = Fork (One h) (fromLists t)
340+instance {-# OVERLAPPING #-} (FromLists e () rows) => FromLists e () (Either () rows) where
341+ fromLists ([h] : t) = Split (One h) (fromLists t)
337342 fromLists _ = error "Wrong dimensions"
338343
339−instance {-# OVERLAPPABLE #-}
340− (FromLists () a, FromLists () b, Countable a) => FromLists () (Either a b) where
341− fromLists l@([_] : _) =
344+instance {-# OVERLAPPABLE #-} (FromLists e () a, FromLists e () b, Countable a) => FromLists e () (Either a b) where
345+ fromLists l@([_] : _) =
342346 let rowsA = fromInteger (natVal (Proxy :: Proxy (Count a)))
343− in Fork (fromLists (take rowsA l)) (fromLists (drop rowsA l))
347+ in Split (fromLists (take rowsA l)) (fromLists (drop rowsA l))
344348 fromLists _ = error "Wrong dimensions"
345349
346−instance (FromLists (Either a b) c, FromLists (Either a b) d, Countable c)
347− => FromLists (Either a b) (Either c d) where
350+instance {-# OVERLAPPABLE #-} (FromLists e (Either a b) c, FromLists e (Either a b) d, Countable c) => FromLists e (Either a b) (Either c d) where
348351 fromLists l@(h : t) =
349352 let lh = length h
350353 rowsC = fromInteger (natVal (Proxy :: Proxy (Count c)))
351− condition = all ((== lh) . length) t
354+ condition = all (== lh) (map length t)
352355 in if lh > 0 && condition
353− then Fork (fromLists (take rowsC l)) (fromLists (drop rowsC l))
356+ then Split (fromLists (take rowsC l)) (fromLists (drop rowsC l))
354357 else error "Not all rows have the same length"
355358
356359-- | Matrix builder function. Constructs a matrix provided with
357−-- a construction function that operates with indices.
358−matrixBuilder' ::
360+-- a construction function.
361+matrixBuilder ::
359362 forall e cols rows.
360− ( FL cols rows,
361− CountableDims cols rows
362− ) => ((Int, Int) -> e) -> Matrix e cols rows
363−matrixBuilder' f =
363+ ( FromLists e cols rows,
364+ CountableDimensions cols rows
365+ ) =>
366+ ((Int, Int) -> e) ->
367+ Matrix e cols rows
368+matrixBuilder f =
364369 let c = fromInteger $ natVal (Proxy :: Proxy (Count cols))
365370 r = fromInteger $ natVal (Proxy :: Proxy (Count rows))
366371 positions = [(a, b) | a <- [0 .. (r - 1)], b <- [0 .. (c - 1)]]
367372 in fromLists . map (map f) . groupBy (\(x, _) (w, _) -> x == w) $ positions
368373
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−
389374-- | Constructs a column vector matrix
390−col :: (FL () rows) => [e] -> Matrix e () rows
375+col :: (FromLists e () rows) => [e] -> Matrix e () rows
391376col = fromLists . map (: [])
392377
393378-- | Constructs a row vector matrix
394−row :: (FL cols ()) => [e] -> Matrix e cols ()
379+row :: (FromLists e cols ()) => [e] -> Matrix e cols ()
395380row = fromLists . (: [])
396381
397382-- | Lifts functions to matrices with arbitrary dimensions.
398383--
399384-- NOTE: Be careful to not ask for a matrix bigger than the cardinality of
400385-- types @a@ or @b@ allows.
401−fromF' ::
386+fromF ::
402387 forall a b cols rows e.
403388 ( Liftable e a b,
404− CountableDims cols rows,
405− FL rows cols
389+ CountableDimensions cols rows,
390+ FromLists e rows cols
406391 ) =>
407392 (a -> b) ->
408393 Matrix e cols rows
409−fromF' f =
394+fromF f =
410395 let minA = minBound @a
411396 maxA = maxBound @a
412397 minB = minBound @b
@@ -416,8 +401,8 @@ fromF' f =
416401 elementsA = take ccols [minA .. maxA]
417402 elementsB = take rrows [minB .. maxB]
418403 combinations = (,) <$> elementsA <*> elementsB
419− combAp = map snd . sort . map (\(a, b) -> if f a == b
420− then ((fromEnum a, fromEnum b), 1)
404+ combAp = map snd . sort . map (\(a, b) -> if f a == b
405+ then ((fromEnum a, fromEnum b), 1)
421406 else ((fromEnum a, fromEnum b), 0)) $ combinations
422407 mList = buildList combAp rrows
423408 in tr $ fromLists mList
@@ -427,23 +412,41 @@ fromF' f =
427412
428413-- | Lifts functions to matrices with dimensions matching @a@ and @b@
429414-- cardinality's.
430−fromF ::
415+fromF' ::
431416 forall a b e.
432417 ( Liftable e a b,
433− CountableDimsN a b,
434− FLN b a
418+ CountableDimensionsN a b,
419+ FromListsN e b a
435420 ) =>
436421 (a -> b) ->
437422 Matrix e (Normalize a) (Normalize b)
438−fromF = fromF'
423+fromF' f =
424+ let minA = minBound @a
425+ maxA = maxBound @a
426+ minB = minBound @b
427+ maxB = maxBound @b
428+ ccols = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize a)))
429+ rrows = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize b)))
430+ elementsA = take ccols [minA .. maxA]
431+ elementsB = take rrows [minB .. maxB]
432+ combinations = (,) <$> elementsA <*> elementsB
433+ combAp = map snd . sort . map (\(a, b) -> if f a == b
434+ then ((fromEnum a, fromEnum b), 1)
435+ else ((fromEnum a, fromEnum b), 0)) $ combinations
436+ mList = buildList combAp rrows
437+ in tr $ fromLists mList
438+ where
439+ buildList [] _ = []
440+ buildList l r = take r l : buildList (drop r l) r
439441
440442-- Conversion
441443
442444-- | Converts a matrix to a list of lists of elements.
443445toLists :: Matrix e cols rows -> [[e]]
446+toLists Empty = []
444447toLists (One e) = [[e]]
445−toLists (Fork l r) = toLists l ++ toLists r
446−toLists (Join l r) = zipWith (++) (toLists l) (toLists r)
448+toLists (Split l r) = toLists l ++ toLists r
449+toLists (Junc l r) = zipWith (++) (toLists l) (toLists r)
447450
448451-- | Converts a matrix to a list of elements.
449452toList :: Matrix e cols rows -> [e]
@@ -452,38 +455,37 @@ toList = concat . toLists
452455-- Zeros Matrix
453456
454457-- | 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)
458+zeros :: (Num e, FromLists e cols rows, CountableDimensions cols rows) => Matrix e cols rows
459+zeros = matrixBuilder (const 0)
457460
458461-- Ones Matrix
459462
460463-- | The ones matrix. A matrix wholly filled with ones.
461464--
462465-- 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)
466+ones :: (Num e, FromLists e cols rows, CountableDimensions cols rows) => Matrix e cols rows
467+ones = matrixBuilder (const 1)
465468
466469-- Const Matrix
467470
468471-- | The constant matrix constructor. A matrix wholly filled with a given
469472-- value.
470−constant :: (Num e, FL cols rows, CountableDims cols rows) => e -> Matrix e cols rows
471−constant e = matrixBuilder' (const e)
473+constant :: (Num e, FromLists e cols rows, CountableDimensions cols rows) => e -> Matrix e cols rows
474+constant e = matrixBuilder (const e)
472475
473476-- Bang Matrix
474477
475478-- | The T (Top) row vector matrix.
476−bang :: forall e cols. (Num e, Enum e, FL cols (), Countable cols) => Matrix e cols ()
479+bang :: forall e cols. (Num e, Enum e, FromLists e cols (), Countable cols) => Matrix e cols ()
477480bang =
478481 let c = fromInteger $ natVal (Proxy :: Proxy (Count cols))
479482 in fromLists [take c [1, 1 ..]]
480483
481−-- iden Matrix
484+-- Identity Matrix
482485
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 #-}
486+-- | Identity matrix.
487+identity :: (Num e, FromLists e cols cols, Countable cols) => Matrix e cols cols
488+identity = matrixBuilder (bool 0 1 . uncurry (==))
487489
488490-- Matrix composition (MMM)
489491
@@ -492,90 +494,60 @@ iden = matrixBuilder' (bool 0 1 . uncurry (==))
492494-- This definition takes advantage of divide-and-conquer and fusion laws
493495-- from LAoP.
494496comp :: (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)
497+comp Empty Empty = Empty
498+comp (One a) (One b) = One (a * b)
499+comp (Junc a b) (Split c d) = comp a c + comp b d -- Divide-and-conquer law
500+comp (Split a b) c = Split (comp a c) (comp b c) -- Split fusion law
501+comp c (Junc a b) = Junc (comp c a) (comp c b) -- Junc fusion law
522502
523503-- Projections
524504
525505-- | 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
506+p1 :: forall e m n. (Num e, CountableDimensions n m, FromLists e n m, FromLists e m m) => Matrix e (Either m n) m
507+p1 =
508+ let iden = identity :: Matrix e m m
509+ zero = zeros :: Matrix e n m
510+ in junc iden zero
528511
529512-- | 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
513+p2 :: forall e m n. (Num e, CountableDimensions n m, FromLists e m n, FromLists e n n) => Matrix e (Either m n) n
514+p2 =
515+ let iden = identity :: Matrix e n n
516+ zero = zeros :: Matrix e m n
517+ in junc zero iden
532518
533519-- Injections
534520
535521-- | Biproduct first component injection
536−i1 :: (Num e, CountableDims n m, FL n m, FL m m) => Matrix e m (Either m n)
522+i1 :: (Num e, CountableDimensions n m, FromLists e n m, FromLists e m m) => Matrix e m (Either m n)
537523i1 = tr p1
538524
539525-- | Biproduct second component injection
540−i2 :: (Num e, CountableDims n m, FL m n, FL n n) => Matrix e n (Either m n)
526+i2 :: (Num e, CountableDimensions n m, FromLists e m n, FromLists e n n) => Matrix e n (Either m n)
541527i2 = tr p2
542528
543529-- Dimensions
544530
545531-- | Obtain the number of rows.
546532--
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''.
533+-- NOTE: The 'KnownNat' constaint is needed in order to obtain the
534+-- dimensions in constant time.
535+--
536+-- TODO: A 'rows' function that does not need the 'KnownNat' constraint in
537+-- exchange for performance.
550538rows :: forall e cols rows. (Countable rows) => Matrix e cols rows -> Int
551539rows _ = fromInteger $ natVal (Proxy :: Proxy (Count rows))
552540
553−-- | Obtain the number of rows in an inefficient manner, but without any
554−-- constraints.
555−--
556−-- For a more efficient version see 'rows'.
557−rows' :: Matrix e cols rows -> Int
558−rows' (One _) = 1
559−rows' (Join lhs _) = rows' lhs
560−rows' (Fork top bottom) = rows' top + rows' bottom
561−
562541-- | Obtain the number of columns.
542+--
543+-- NOTE: The 'KnownNat' constaint is needed in order to obtain the
544+-- dimensions in constant time.
563545--
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''.
546+-- TODO: A 'columns' function that does not need the 'KnownNat' constraint in
547+-- exchange for performance.
567548columns :: forall e cols rows. (Countable cols) => Matrix e cols rows -> Int
568549columns _ = fromInteger $ natVal (Proxy :: Proxy (Count cols))
569550
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−
579551-- Coproduct Bifunctor
580552
581553infixl 5 -|-
@@ -584,172 +556,150 @@ infixl 5 -|-
584556(-|-) ::
585557 forall e n k m j.
586558 ( Num e,
587− CountableDims j k,
588− FL k k,
589− FL j k,
590− FL k j,
591− FL j j
559+ CountableDimensions j k,
560+ FromLists e k k,
561+ FromLists e j k,
562+ FromLists e k j,
563+ FromLists e j j
592564 ) =>
593565 Matrix e n k ->
594566 Matrix e m j ->
595567 Matrix e (Either n m) (Either k j)
596−(-|-) a b = Join (i1 . a) (i2 . b)
568+(-|-) a b = Junc (i1 . a) (i2 . b)
597569
598570-- Khatri Rao Product and projections
599571
600572-- | Khatri Rao product first component projection matrix.
601−fstM ::
573+kp1 ::
602574 forall e m k .
603575 ( Num e,
604− CountableDims k m,
605− FL (Normalize (m, k)) m,
576+ CountableDimensions k m,
577+ FromLists e (Normalize (m, k)) m,
606578 CountableN (m, k)
607579 ) => Matrix e (Normalize (m, k)) m
608−fstM = matrixBuilder' f
580+kp1 = matrixBuilder f
609581 where
610582 offset = fromInteger (natVal (Proxy :: Proxy (Count k)))
611583 f (x, y)
612584 | y >= (x * offset) && y <= (x * offset + offset - 1) = 1
613− | otherwise = 0
585+ | otherwise = 0
614586
615587-- | Khatri Rao product second component projection matrix.
616−sndM ::
588+kp2 ::
617589 forall e m k .
618590 ( Num e,
619− CountableDims k m,
620− FL (Normalize (m, k)) k,
591+ CountableDimensions k m,
592+ FromLists e (Normalize (m, k)) k,
621593 CountableN (m, k)
622594 ) => Matrix e (Normalize (m, k)) k
623−sndM = matrixBuilder' f
595+kp2 = matrixBuilder f
624596 where
625597 offset = fromInteger (natVal (Proxy :: Proxy (Count k)))
626598 f (x, y)
627599 | x == y || mod (y - x) offset == 0 = 1
628− | otherwise = 0
600+ | otherwise = 0
629601
630602-- | Khatri Rao Matrix product also known as matrix pairing.
631603--
632604-- NOTE: That this is not a true categorical product, see for instance:
633−--
605+--
634606-- @
635−-- | fstM . kr a b == a
636−-- kr a b ==> |
637−-- | sndM . kr a b == b
607+-- | kp1 . khatri a b == a
608+-- khatri a b ==> |
609+-- | kp2 . khatri a b == b
638610-- @
639611--
640612-- __Emphasis__ on the implication symbol.
641−kr ::
642− forall e cols a b.
613+khatri ::
614+ forall e cols a b.
643615 ( Num e,
644− CountableDims a b,
616+ CountableDimensions a b,
645617 CountableN (a, b),
646− FL (Normalize (a, b)) a,
647− FL (Normalize (a, b)) b
618+ FromLists e (Normalize (a, b)) a,
619+ FromLists e (Normalize (a, b)) b
648620 ) => 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)
621+khatri a b =
622+ let kp1' = kp1 @e @a @b
623+ kp2' = kp2 @e @a @b
624+ in (tr kp1') . a * (tr kp2') . b
653625
654626-- Product Bifunctor (Kronecker)
655627
656628infixl 4 ><
657629
658630-- | Matrix product functor also known as kronecker product
659−(><) ::
660− forall e m p n q.
631+(><) ::
632+ forall e m p n q.
661633 ( 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− )
634+ CountableDimensions m n,
635+ CountableDimensions p q,
636+ CountableDimensionsN (m, n) (p, q),
637+ FromLists e (Normalize (m, n)) m,
638+ FromLists e (Normalize (m, n)) n,
639+ FromLists e (Normalize (p, q)) p,
640+ FromLists e (Normalize (p, q)) q
641+ )
670642 => Matrix e m p -> Matrix e n q -> Matrix e (Normalize (m, n)) (Normalize (p, q))
671643(><) a b =
672− let fstM' = fstM @e @m @n
673− sndM' = sndM @e @m @n
674− in kr (a . fstM') (b . sndM')
644+ let kp1' = kp1 @e @m @n
645+ kp2' = kp2 @e @m @n
646+ in khatri (a . kp1') (b . kp2')
675647
676−-- Matrix abide Join Fork
648+-- Matrix abide Junc Split
677649
678−-- | Matrix "abiding" following the 'Join'-'Fork' exchange law.
679−--
650+-- | Matrix "abiding" followin the 'Junc'-'Split' abide law.
651+--
680652-- Law:
681653--
682654-- @
683−-- 'Join' ('Fork' a c) ('Fork' b d) == 'Fork' ('Join' a b) ('Join' c d)
655+-- 'Junc' ('Split' a c) ('Split' b d) == 'Split' ('Junc' a b) ('Junc' c d)
684656-- @
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)
657+abideJS :: Matrix e cols rows -> Matrix e cols rows
658+abideJS (Junc (Split a c) (Split b d)) = Split (Junc (abideJS a) (abideJS b)) (Junc (abideJS c) (abideJS d)) -- Junc-Split abide law
659+abideJS Empty = Empty
660+abideJS (One e) = One e
661+abideJS (Junc a b) = Junc (abideJS a) (abideJS b)
662+abideJS (Split a b) = Split (abideJS a) (abideJS b)
690663
691−-- Matrix abide Fork Join
664+-- Matrix abide Split Junc
692665
693−-- | Matrix "abiding" followin the 'Fork'-'Join' abide law.
694−--
666+-- | Matrix "abiding" followin the 'Split'-'Junc' abide law.
667+--
695668-- @
696−-- 'Fork' ('Join' a b) ('Join' c d) == 'Join' ('Fork' a c) ('Fork' b d)
669+-- 'Split' ('Junc' a b) ('Junc' c d) == 'Junc' ('Split' a c) ('Split' b d)
697670-- @
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)
671+abideSJ :: Matrix e cols rows -> Matrix e cols rows
672+abideSJ (Split (Junc a b) (Junc c d)) = Junc (Split (abideSJ a) (abideSJ c)) (Split (abideSJ b) (abideSJ d)) -- Split-Junc abide law
673+abideSJ Empty = Empty
674+abideSJ (One e) = One e
675+abideSJ (Junc a b) = Junc (abideSJ a) (abideSJ b)
676+abideSJ (Split a b) = Split (abideSJ a) (abideSJ b)
703677
704678-- Matrix transposition
705679
706680-- | Matrix transposition.
707681tr :: 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)
682+tr Empty = Empty
683+tr (One e) = One e
684+tr (Junc a b) = Split (tr a) (tr b)
685+tr (Split a b) = Junc (tr a) (tr b)
711686
712687-- Selective 'select' operator
713688
714689-- | Selective functors 'select' operator equivalent inspired by the
715690-- 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
691+select :: (Num e, FromLists e b b, Countable b) => Matrix e cols (Either a b) -> Matrix e a b -> Matrix e cols b
692+select m y = junc y identity . m
743693
744694-- McCarthy's Conditional
745695
746696-- | McCarthy's Conditional expresses probabilistic choice.
747697cond ::
748− ( Trivial cols,
698+ ( cols ~ Normalize cols,
749699 Countable cols,
750− FL () cols,
751− FL cols (),
752− FL cols cols,
700+ FromLists e () cols,
701+ FromLists e cols (),
702+ FromLists e cols cols,
753703 Bounded a,
754704 Enum a,
755705 Num e,
@@ -757,14 +707,14 @@ cond ::
757707 )
758708 =>
759709 (a -> Bool) -> Matrix e cols rows -> Matrix e cols rows -> Matrix e cols rows
760−cond p f g = join f g . grd p
710+cond p f g = junc f g . grd p
761711
762−grd ::
763− ( Trivial q,
712+grd ::
713+ ( q ~ Normalize q,
764714 Countable q,
765− FL () q,
766− FL q (),
767− FL q q,
715+ FromLists e () q,
716+ FromLists e q (),
717+ FromLists e q q,
768718 Bounded a,
769719 Enum a,
770720 Num e,
@@ -772,86 +722,60 @@ grd ::
772722 )
773723 =>
774724 (a -> Bool) -> Matrix e q (Either q q)
775−grd f = fork (corr f) (corr (not . f))
725+grd f = split (corr f) (corr (not . f))
776726
777−corr ::
778− forall e a q .
779− ( Trivial q,
727+corr ::
728+ forall e a q .
729+ ( q ~ Normalize q,
780730 Countable q,
781− FL () q,
782− FL q (),
783− FL q q,
731+ FromLists e () q,
732+ FromLists e q (),
733+ FromLists e q q,
784734 Liftable e a Bool
785− )
735+ )
786736 => (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)
737+corr p = let f = fromF p :: Matrix e q ()
738+ in khatri f (identity :: Matrix e q q)
789739
790740-- Pretty print
791741
792742prettyAux :: Show e => [[e]] -> [[e]] -> String
793743prettyAux [] _ = ""
794−prettyAux [[e]] m = "│ " ++ fill (show e) ++ " │\n"
744+prettyAux [[e]] m = "│ " ++ fill (show e) ++ " │\n"
795745 where
796746 v = fmap show m
797747 widest = maximum $ fmap length v
798748 fill str = replicate (widest - length str - 2) ' ' ++ str
799−prettyAux [h] m = "│ " ++ fill (unwords $ map show h) ++ " │\n"
749+prettyAux [h] m = "│ " ++ fill (unwords $ map show h) ++ " │\n"
800750 where
801− v = fmap show m
802− widest = maximum $ fmap length v
751+ v = fmap show m
752+ widest = maximum $ fmap length v
803753 fill str = replicate (widest - length str - 2) ' ' ++ str
804−prettyAux (h : t) l = "│ " ++ fill (unwords $ map show h) ++ " │\n" ++
754+prettyAux (h : t) l = "│ " ++ fill (unwords $ map show h) ++ " │\n" ++
805755 prettyAux t l
806756 where
807− v = fmap show l
808− widest = maximum $ fmap length v
757+ v = fmap show l
758+ widest = maximum $ fmap length v
809759 fill str = replicate (widest - length str - 2) ' ' ++ str
810760
811761-- | 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
762+pretty :: (Countable cols, Show e) => Matrix e cols rows -> String
763+pretty m = "┌ " ++ unwords (replicate (columns m) blank) ++ " ┐\n" ++
764+ prettyAux (toLists m) (toLists m) ++
765+ "└ " ++ unwords (replicate (columns m) blank) ++ " ┘"
766+ where
767+ v = fmap show (toList m)
768+ widest = maximum $ fmap length v
822769 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)
770+ blank = fill ""
839771
840772-- | Matrix pretty printer
841−prettyPrint :: (CountableDims cols rows, Show e) => Matrix e cols rows -> IO ()
773+prettyPrint :: (Countable cols, Show e) => Matrix e cols rows -> IO ()
842774prettyPrint = putStrLn . pretty
843775
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−
852776-- Relational operators functions
853777
854−type Boolean = Natural 0 1
778+type Boolean = Natural 0 1
855779type Relation a b = Matrix Boolean a b
856780
857781-- | Helper conversion function
@@ -867,47 +791,54 @@ fromBool False = nat 0
867791
868792-- | Relational negation
869793negateM :: 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)
794+negateM Empty = Empty
795+negateM (One (Nat 0)) = One (Nat 1)
796+negateM (One (Nat 1)) = One (Nat 0)
797+negateM (Junc a b) = Junc (negateM a) (negateM b)
798+negateM (Split a b) = Split (negateM a) (negateM b)
873799
874800-- | Relational addition
875801orM :: 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
802+orM Empty Empty = Empty
803+orM (One a) (One b) = One (fromBool (toBool a || toBool b))
804+orM (Junc a b) (Junc c d) = Junc (orM a c) (orM b d)
805+orM (Split a b) (Split c d) = Split (orM a c) (orM b d)
806+orM x@(Split _ _) y@(Junc _ _) = orM x (abideJS y)
807+orM x@(Junc _ _) y@(Split _ _) = orM (abideJS x) y
881808
882809-- | Relational multiplication
883810andM :: 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
811+andM Empty Empty = Empty
812+andM (One a) (One b) = One (fromBool (toBool a && toBool b))
813+andM (Junc a b) (Junc c d) = Junc (andM a c) (andM b d)
814+andM (Split a b) (Split c d) = Split (andM a c) (andM b d)
815+andM x@(Split _ _) y@(Junc _ _) = andM x (abideJS y)
816+andM x@(Junc _ _) y@(Split _ _) = andM (abideJS x) y
889817
890818-- | Relational subtraction
891819subM :: 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
820+subM Empty Empty = Empty
821+subM (One a) (One b) = if a - b < nat 0 then One (nat 0) else One (a - b)
822+subM (Junc a b) (Junc c d) = Junc (subM a c) (subM b d)
823+subM (Split a b) (Split c d) = Split (subM a c) (subM b d)
824+subM x@(Split _ _) y@(Junc _ _) = subM x (abideJS y)
825+subM x@(Junc _ _) y@(Split _ _) = subM (abideJS x) y
897826
898827-- | Matrix relational composition.
899828compRel :: 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
829+compRel Empty Empty = Empty
830+compRel (One a) (One b) = One (fromBool (toBool a && toBool b))
831+compRel (Junc a b) (Split c d) = orM (compRel a c) (compRel b d) -- Divide-and-conquer law
832+compRel (Split a b) c = Split (compRel a c) (compRel b c) -- Split fusion law
833+compRel c (Junc a b) = Junc (compRel c a) (compRel c b) -- Junc fusion law
904834
905835-- | Matrix relational right division
906836divR :: Relation b c -> Relation b a -> Relation a c
837+divR Empty Empty = Empty
907838divR (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)
839+divR (Junc a b) (Junc c d) = andM (divR a c) (divR b d)
840+divR (Split a b) c = Split (divR a c) (divR b c)
841+divR c (Split a b) = Junc (divR c a) (divR c b)
911842
912843-- | Matrix relational left division
913844divL :: Relation c b -> Relation a b -> Relation a c
@@ -923,52 +854,86 @@ divS s r = divL r s `intersection` divR (tr r) (tr s)
923854--
924855-- NOTE: Be careful to not ask for a relation bigger than the cardinality of
925856-- types @a@ or @b@ allows.
926−fromFRel' ::
857+fromFRel ::
927858 forall a b cols rows.
928859 ( Liftable Boolean a b,
929− CountableDims cols rows,
930− FL rows cols
860+ CountableDimensions cols rows,
861+ FromLists Boolean rows cols
931862 ) =>
932863 (a -> b) ->
933864 Relation cols rows
934−fromFRel' = fromF'
865+fromFRel f =
866+ let minA = minBound @a
867+ maxA = maxBound @a
868+ minB = minBound @b
869+ maxB = maxBound @b
870+ ccols = fromInteger $ natVal (Proxy :: Proxy (Count cols))
871+ rrows = fromInteger $ natVal (Proxy :: Proxy (Count rows))
872+ elementsA = take ccols [minA .. maxA]
873+ elementsB = take rrows [minB .. maxB]
874+ combinations = (,) <$> elementsA <*> elementsB
875+ combAp = map snd . sort . map (\(a, b) -> if f a == b
876+ then ((fromEnum a, fromEnum b), nat 1)
877+ else ((fromEnum a, fromEnum b), nat 0)) $ combinations
878+ mList = buildList combAp rrows
879+ in tr $ fromLists mList
880+ where
881+ buildList [] _ = []
882+ buildList l r = take r l : buildList (drop r l) r
935883
936884-- | Lifts functions to relations with dimensions matching @a@ and @b@
937885-- cardinality's.
938−fromFRel ::
886+fromFRel' ::
939887 forall a b.
940888 ( Liftable Boolean a b,
941− CountableDimsN a b,
942− FLN b a
889+ CountableDimensionsN a b,
890+ FromLists Boolean (Normalize b) (Normalize a)
943891 ) =>
944892 (a -> b) ->
945893 Relation (Normalize a) (Normalize b)
946−fromFRel = fromFRel'
894+fromFRel' f =
895+ let minA = minBound @a
896+ maxA = maxBound @a
897+ minB = minBound @b
898+ maxB = maxBound @b
899+ ccols = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize a)))
900+ rrows = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize b)))
901+ elementsA = take ccols [minA .. maxA]
902+ elementsB = take rrows [minB .. maxB]
903+ combinations = (,) <$> elementsA <*> elementsB
904+ combAp = map snd . sort . map (\(a, b) -> if f a == b
905+ then ((fromEnum a, fromEnum b), nat 1)
906+ else ((fromEnum a, fromEnum b), nat 0)) $ combinations
907+ mList = buildList combAp rrows
908+ in tr $ fromLists mList
909+ where
910+ buildList [] _ = []
911+ buildList l r = take r l : buildList (drop r l) r
947912
948913-- | Lifts a relation function to a Boolean Matrix
949−toRel ::
914+toRel ::
950915 forall a b.
951916 ( Bounded a,
952917 Bounded b,
953918 Enum a,
954919 Enum b,
955920 Eq b,
956− CountableDims a b,
957− FLN b a
958− )
921+ CountableDimensionsN a b,
922+ FromListsN Boolean b a
923+ )
959924 => (a -> b -> Bool) -> Relation (Normalize a) (Normalize b)
960925toRel f =
961926 let minA = minBound @a
962927 maxA = maxBound @a
963928 minB = minBound @b
964929 maxB = maxBound @b
965− ccols = fromInteger $ natVal (Proxy :: Proxy (Count a))
966− rrows = fromInteger $ natVal (Proxy :: Proxy (Count b))
930+ ccols = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize a)))
931+ rrows = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize b)))
967932 elementsA = take ccols [minA .. maxA]
968933 elementsB = take rrows [minB .. maxB]
969934 combinations = (,) <$> elementsA <*> elementsB
970− combAp = map snd . sort . map (\(a, b) -> if uncurry f (a, b)
971− then ((fromEnum a, fromEnum b), nat 1)
935+ combAp = map snd . sort . map (\(a, b) -> if uncurry f (a, b)
936+ then ((fromEnum a, fromEnum b), nat 1)
972937 else ((fromEnum a, fromEnum b), nat 0)) $ combinations
973938 mList = buildList combAp rrows
974939 in tr $ fromLists mList
src/LAoP/Matrix/Nat.hs+124−139
@@ -56,20 +56,21 @@ module LAoP.Matrix.Nat
5656
5757 -- * Constraint type synonyms
5858 Countable,
59− CountableDims,
59+ CountableDimensions,
6060 CountableN,
6161 CountableNz,
62− CountableDimsN,
63− FLN,
64− FLNz,
62+ CountableDimensionsN,
63+ FromListsN,
64+ FromListsNz,
6565 Liftable,
6666 TrivialE,
6767 TrivialP,
6868
6969 -- * Primitives
70+ empty,
7071 one,
71− join,
72− fork,
72+ junc,
73+ split,
7374
7475 -- * Auxiliary type families
7576 I.FromNat,
@@ -77,11 +78,11 @@ module LAoP.Matrix.Nat
7778 I.Normalize,
7879
7980 -- * Matrix construction and conversion
80− I.FL,
81+ I.FromLists,
8182 fromLists,
8283 toLists,
8384 toList,
84− matrixBuilder',
85+ matrixBuilder,
8586 row,
8687 col,
8788 zeros,
@@ -97,10 +98,6 @@ module LAoP.Matrix.Nat
9798 -- ** Matrix Transposition
9899 tr,
99100
100− -- ** Scalar multiplication/division of matrices
101− (.|),
102− (./),
103−
104101 -- ** Selective operator
105102 select,
106103
@@ -108,19 +105,16 @@ module LAoP.Matrix.Nat
108105 cond,
109106
110107 -- ** Matrix "abiding"
111− abideJF,
112− abideFJ,
113−
114− -- ** Zip Matrices
115− zipWithM,
108+ abideJS,
109+ abideSJ,
116110
117111 -- * Biproduct approach
118− -- ** Fork
112+ -- ** Split
119113 (===),
120114 -- *** Projections
121115 p1,
122116 p2,
123− -- ** Join
117+ -- ** Junc
124118 (|||),
125119 -- *** Injections
126120 i1,
@@ -134,11 +128,11 @@ module LAoP.Matrix.Nat
134128 -- | Note that given the restrictions imposed it is not possible to
135129 -- implement the standard type classes present in standard Haskell.
136130 -- *** Matrix pairing projections
137− fstM,
138− sndM,
131+ kp1,
132+ kp2,
139133
140134 -- *** Matrix pairing
141− kr,
135+ khatri,
142136
143137 -- * Matrix composition and lifting
144138
@@ -146,10 +140,10 @@ module LAoP.Matrix.Nat
146140
147141 -- | Note that given the restrictions imposed it is not possible to
148142 -- implement the standard type classes present in standard Haskell.
149− iden,
143+ identity,
150144 comp,
151− fromF',
152145 fromF,
146+ fromF',
153147
154148 -- * Matrix printing
155149 pretty,
@@ -160,34 +154,47 @@ where
160154import Data.Proxy
161155import GHC.TypeLits
162156import Control.DeepSeq
157+import qualified Control.Category as C
163158import qualified LAoP.Matrix.Internal as I
164159
165160newtype Matrix e (cols :: Nat) (rows :: Nat) = M (I.Matrix e (I.FromNat cols) (I.FromNat rows))
166161 deriving (Show, Num, Eq, Ord, NFData) via (I.Matrix e (I.FromNat cols) (I.FromNat rows))
167162
168163-- | 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))
164+type Countable a = KnownNat (I.Count a)
165+type CountableDimensions a b = (Countable a, Countable b)
166+type CountableN a = KnownNat (I.Count (I.FromNat a))
167+type CountableNz a = KnownNat (I.Count (I.Normalize a))
168+type CountableDimensionsN a b = (CountableN a, CountableN b)
169+type FromListsN e a b = I.FromLists e (I.FromNat a) (I.FromNat b)
170+type FromListsNz e a b = I.FromLists e (I.Normalize a) (I.Normalize b)
171+type Liftable e a b = (Bounded a, Bounded b, Enum a, Enum b, Eq b, Num e, Ord e)
172+type TrivialE a b = I.FromNat (a + b) ~ Either (I.FromNat a) (I.FromNat b)
173+type TrivialP a b = I.FromNat (a * b) ~ I.FromNat (I.Count (I.FromNat a) * I.Count (I.FromNat b))
174+
175+-- | It isn't possible to implement the 'id' function so it's
176+-- implementation is 'undefined'. However 'comp' can be and this partial
177+-- class implementation exists just to make the code more readable.
178+--
179+-- Please use 'identity' instead.
180+instance (Num e) => C.Category (Matrix e) where
181+ id = undefined
182+ (.) = comp
179183
180184-- Primitives
181185
186+empty :: Matrix e 0 0
187+empty = M I.Empty
188+
182189one :: e -> Matrix e 1 1
183190one = M . I.One
184191
185−join ::
192+junc ::
186193 (TrivialE a b) =>
187194 Matrix e a rows ->
188195 Matrix e b rows ->
189196 Matrix e (a + b) rows
190−join (M a) (M b) = M (I.Join a b)
197+junc (M a) (M b) = M (I.Junc a b)
191198
192199infixl 3 |||
193200(|||) ::
@@ -195,14 +202,14 @@ infixl 3 |||
195202 Matrix e a rows ->
196203 Matrix e b rows ->
197204 Matrix e (a + b) rows
198−(|||) = join
205+(|||) = junc
199206
200−fork ::
207+split ::
201208 (TrivialE a b) =>
202209 Matrix e cols a ->
203210 Matrix e cols b ->
204211 Matrix e cols (a + b)
205−fork (M a) (M b) = M (I.Fork a b)
212+split (M a) (M b) = M (I.Split a b)
206213
207214infixl 2 ===
208215(===) ::
@@ -210,45 +217,43 @@ infixl 2 ===
210217 Matrix e cols a ->
211218 Matrix e cols b ->
212219 Matrix e cols (a + b)
213−(===) = fork
220+(===) = split
214221
215222-- Construction
216223
217−fromLists :: (FLN e cols rows) => [[e]] -> Matrix e cols rows
224+fromLists :: (FromListsN e cols rows) => [[e]] -> Matrix e cols rows
218225fromLists = M . I.fromLists
219226
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)
227+matrixBuilder ::
228+ (FromListsN e cols rows, CountableN cols, CountableN rows)
224229 => ((Int, Int) -> e) -> Matrix e cols rows
225−matrixBuilder' = M . I.matrixBuilder'
230+matrixBuilder = M . I.matrixBuilder
226231
227−col :: (I.FL () (I.FromNat rows)) => [e] -> Matrix e 1 rows
232+col :: (I.FromLists e () (I.FromNat rows)) => [e] -> Matrix e 1 rows
228233col = M . I.col
229234
230−row :: (I.FL (I.FromNat cols) ()) => [e] -> Matrix e cols 1
235+row :: (I.FromLists e (I.FromNat cols) ()) => [e] -> Matrix e cols 1
231236row = M . I.row
232237
233−fromF' ::
238+fromF ::
234239 ( Liftable e a b,
235240 CountableN cols,
236241 CountableN rows,
237− FLN e rows cols
242+ FromListsN e rows cols
238243 ) =>
239244 (a -> b) ->
240245 Matrix e cols rows
241−fromF' = M . I.fromF'
246+fromF = M . I.fromF
242247
243−fromF ::
248+fromF' ::
244249 ( Liftable e a b,
245250 CountableNz a,
246251 CountableNz b,
247− FLNz e b a
252+ FromListsNz e b a
248253 ) =>
249254 (a -> b) ->
250255 Matrix e (I.Count a) (I.Count b)
251−fromF = undefined -- M . I.fromF
256+fromF' = M . I.fromF'
252257
253258-- Conversion
254259
@@ -261,21 +266,21 @@ toList (M m) = I.toList m
261266-- Zeros Matrix
262267
263268zeros ::
264− (Num e, FLN e cols rows, CountableN cols, CountableN rows) =>
269+ (Num e, FromListsN e cols rows, CountableN cols, CountableN rows) =>
265270 Matrix e cols rows
266271zeros = M I.zeros
267272
268273-- Ones Matrix
269274
270275ones ::
271− (Num e, FLN e cols rows, CountableN cols, CountableN rows) =>
276+ (Num e, FromListsN e cols rows, CountableN cols, CountableN rows) =>
272277 Matrix e cols rows
273278ones = M I.ones
274279
275280-- Const Matrix
276281
277282constant ::
278− (Num e, FLN e cols rows, CountableN cols, CountableN rows) =>
283+ (Num e, FromListsN e cols rows, CountableN cols, CountableN rows) =>
279284 e ->
280285 Matrix e cols rows
281286constant = M . I.constant
@@ -284,41 +289,27 @@ constant = M . I.constant
284289
285290bang ::
286291 forall e cols.
287− (Num e, Enum e, I.FL (I.FromNat cols) (), CountableN cols) =>
292+ (Num e, Enum e, I.FromLists e (I.FromNat cols) (), CountableN cols) =>
288293 Matrix e cols 1
289294bang = M I.bang
290295
291−-- iden Matrix
296+-- Identity Matrix
292297
293−iden ::
294− (Num e, FLN e cols cols, CountableN cols) =>
298+identity ::
299+ (Num e, FromListsN e cols cols, CountableN cols) =>
295300 Matrix e cols cols
296−iden = M I.iden
301+identity = M I.identity
297302
298303-- Matrix composition (MMM)
299304
300305comp :: (Num e) => Matrix e cr rows -> Matrix e cols cr -> Matrix e cols rows
301306comp (M a) (M b) = M (I.comp a b)
302307
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−
317308p1 ::
318309 ( Num e,
319− CountableDimsN n m,
320− FLN e n m,
321− FLN e m m,
310+ CountableDimensionsN n m,
311+ FromListsN e n m,
312+ FromListsN e m m,
322313 TrivialE m n
323314 ) =>
324315 Matrix e (m + n) m
@@ -326,9 +317,9 @@ p1 = M I.p1
326317
327318p2 ::
328319 ( Num e,
329− CountableDimsN n m,
330− FLN e m n,
331− FLN e n n,
320+ CountableDimensionsN n m,
321+ FromListsN e m n,
322+ FromListsN e n n,
332323 TrivialE m n
333324 ) =>
334325 Matrix e (m + n) n
@@ -338,9 +329,9 @@ p2 = M I.p2
338329
339330i1 ::
340331 ( Num e,
341− CountableDimsN n rows,
342− FLN e n rows,
343− FLN e rows rows,
332+ CountableDimensionsN n rows,
333+ FromListsN e n rows,
334+ FromListsN e rows rows,
344335 TrivialE rows n
345336 ) =>
346337 Matrix e rows (rows + n)
@@ -348,9 +339,9 @@ i1 = tr p1
348339
349340i2 ::
350341 ( Num e,
351− CountableDimsN rows m,
352− FLN e m rows,
353− FLN e rows rows,
342+ CountableDimensionsN rows m,
343+ FromListsN e m rows,
344+ FromListsN e rows rows,
354345 TrivialE m rows
355346 ) =>
356347 Matrix e rows (m + rows)
@@ -364,16 +355,16 @@ rows (M m) = I.rows m
364355columns :: (CountableN cols) => Matrix e cols rows -> Int
365356columns (M m) = I.columns m
366357
358+-- | Coproduct Bifunctor
367359infixl 5 -|-
368360
369−-- | Coproduct Bifunctor (Direct sum)
370361(-|-) ::
371362 ( 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,
363+ CountableDimensionsN j k,
364+ FromListsN e k k,
365+ FromListsN e j k,
366+ FromListsN e k j,
367+ FromListsN e j j,
377368 TrivialE n m,
378369 TrivialE k j
379370 ) =>
@@ -382,42 +373,40 @@ infixl 5 -|-
382373 Matrix e (n + m) (k + j)
383374(-|-) (M a) (M b) = M ((I.-|-) a b)
384375
385−-- | Khatri Rao Product first projection
386−fstM ::
376+-- | Khatri Rao Product and projections
377+kp1 ::
387378 forall e m k .
388379 ( Num e,
389− CountableDimsN m k,
380+ CountableDimensionsN m k,
390381 CountableN (m * k),
391− FLN e (m * k) m,
382+ FromListsN e (m * k) m,
392383 TrivialP m k
393384 ) => Matrix e (m * k) m
394−fstM = M (I.fstM @e @(I.FromNat m) @(I.FromNat k))
385+kp1 = M (I.kp1 @e @(I.FromNat m) @(I.FromNat k))
395386
396−-- | Khatri Rao Product second projection
397−sndM ::
387+kp2 ::
398388 forall e m k.
399389 ( Num e,
400− CountableDimsN k m,
401− FLN e (m * k) k,
390+ CountableDimensionsN k m,
391+ FromListsN e (m * k) k,
402392 CountableN (m * k),
403393 TrivialP m k
404394 ) => Matrix e (m * k) k
405−sndM = M (I.sndM @e @(I.FromNat m) @(I.FromNat k))
395+kp2 = M (I.kp2 @e @(I.FromNat m) @(I.FromNat k))
406396
407−-- | Khatri Rao Product
408−kr ::
397+khatri ::
409398 forall e cols a b.
410399 ( Num e,
411− CountableDimsN a b,
400+ CountableDimensionsN a b,
412401 CountableN (a * b),
413− FLN e (a * b) a,
414− FLN e (a * b) b,
402+ FromListsN e (a * b) a,
403+ FromListsN e (a * b) b,
415404 TrivialP a b
416405 ) => 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
406+khatri a b =
407+ let kp1' = kp1 @e @a @b
408+ kp2' = kp2 @e @a @b
409+ in comp (tr kp1') a * comp (tr kp2') b
421410
422411-- | Product Bifunctor (Kronecker)
423412infixl 4 ><
@@ -425,28 +414,28 @@ infixl 4 ><
425414(><) ::
426415 forall e m p n q.
427416 ( 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,
417+ CountableDimensionsN m n,
418+ CountableDimensionsN p q,
419+ CountableDimensionsN (m * n) (p * q),
420+ FromListsN e (m * n) m,
421+ FromListsN e (m * n) n,
422+ FromListsN e (p * q) p,
423+ FromListsN e (p * q) q,
435424 TrivialP m n,
436425 TrivialP p q
437426 ) => Matrix e m p -> Matrix e n q -> Matrix e (m * n) (p * q)
438427(><) a b =
439− let fstM' = fstM @e @m @n
440− sndM' = sndM @e @m @n
441− in kr (comp a fstM') (comp b sndM')
428+ let kp1' = kp1 @e @m @n
429+ kp2' = kp2 @e @m @n
430+ in khatri (comp a kp1') (comp b kp2')
442431
443−-- | Matrix abide Join Fork
444−abideJF :: Matrix e cols rows -> Matrix e cols rows
445−abideJF (M m) = M (I.abideJF m)
432+-- | Matrix abide Junc Split
433+abideJS :: Matrix e cols rows -> Matrix e cols rows
434+abideJS (M m) = M (I.abideJS m)
446435
447−-- | Matrix abide Fork Join
448−abideFJ :: Matrix e cols rows -> Matrix e cols rows
449−abideFJ (M m) = M (I.abideFJ m)
436+-- | Matrix abide Split Junc
437+abideSJ :: Matrix e cols rows -> Matrix e cols rows
438+abideSJ (M m) = M (I.abideSJ m)
450439
451440-- | Matrix transposition
452441tr :: Matrix e cols rows -> Matrix e rows cols
@@ -455,7 +444,7 @@ tr (M m) = M (I.tr m)
455444-- Selective 'select' operator
456445select ::
457446 ( Num e,
458− FLN e rows1 rows1,
447+ FromListsN e rows1 rows1,
459448 CountableN rows1,
460449 I.FromNat rows2 ~ I.FromNat rows1,
461450 I.FromNat cols1 ~ I.FromNat cols2,
@@ -468,9 +457,9 @@ select (M m) (M y) = M (I.select m y)
468457cond ::
469458 ( I.FromNat (I.Count (I.FromNat cols)) ~ I.FromNat cols,
470459 CountableN cols,
471− I.FL () (I.FromNat cols),
472− I.FL (I.FromNat cols) (),
473− FLN e cols cols,
460+ I.FromLists e () (I.FromNat cols),
461+ I.FromLists e (I.FromNat cols) (),
462+ FromListsN e cols cols,
474463 Liftable e a Bool
475464 )
476465 =>
@@ -479,12 +468,8 @@ cond p (M a) (M b) = M (I.cond p a b)
479468
480469-- Pretty print
481470
482−pretty :: (CountableDimsN cols rows, Show e) => Matrix e cols rows -> String
471+pretty :: (CountableN cols, Show e) => Matrix e cols rows -> String
483472pretty (M m) = I.pretty m
484473
485−prettyPrint :: (CountableDimsN cols rows, Show e) => Matrix e cols rows -> IO ()
474+prettyPrint :: (CountableN cols, Show e) => Matrix e cols rows -> IO ()
486475prettyPrint (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+180−246
@@ -1,11 +1,11 @@
11{-# LANGUAGE ConstraintKinds #-}
2−{-# LANGUAGE TypeFamilies #-}
32{-# LANGUAGE AllowAmbiguousTypes #-}
43{-# LANGUAGE DataKinds #-}
54{-# LANGUAGE DerivingVia #-}
65{-# LANGUAGE FlexibleContexts #-}
76{-# LANGUAGE FlexibleInstances #-}
87{-# LANGUAGE GADTs #-}
8+{-# LANGUAGE KindSignatures #-}
99{-# LANGUAGE MultiParamTypeClasses #-}
1010{-# LANGUAGE NoStarIsType #-}
1111{-# LANGUAGE RankNTypes #-}
@@ -58,12 +58,13 @@ module LAoP.Matrix.Type
5858
5959 -- * Constraint type aliases
6060 Countable,
61− CountableDims,
61+ CountableDimensions,
6262 CountableN,
63− CountableDimsN,
64− FLN,
63+ CountableDimensionsN,
64+ FromListsN,
6565 Liftable,
6666 Trivial,
67+ TrivialE,
6768 TrivialP,
6869
6970 -- * Type aliases
@@ -71,9 +72,10 @@ module LAoP.Matrix.Type
7172 One,
7273
7374 -- * Primitives
75+ empty,
7476 one,
75− join,
76− fork,
77+ junc,
78+ split,
7779
7880 -- * Auxiliary type families
7981 I.FromNat,
@@ -85,27 +87,24 @@ module LAoP.Matrix.Type
8587 fromLists,
8688 toLists,
8789 toList,
88− matrixBuilder',
8990 matrixBuilder,
9091 row,
9192 col,
9293 zeros,
9394 ones,
9495 bang,
95− point,
9696 constant,
9797
9898 -- * Functor instance equivalent function
9999 fmapM,
100− bimapM,
101100
102101 -- * Applicative/Monoidal instance equivalent functions
103102 unitM,
104103 multM,
105104
106105 -- * Selective equivalent instance function
107− selectM,
108−
106+ selectM,
107+
109108 -- * Monad equivalent instance function
110109 returnM,
111110 bindM,
@@ -113,34 +112,25 @@ module LAoP.Matrix.Type
113112 -- * Misc
114113 -- ** Get dimensions
115114 columns,
116− columns',
117115 rows,
118− rows',
119116
120117 -- ** Matrix Transposition
121118 tr,
122119
123− -- ** Scalar multiplication/division of matrices
124− (.|),
125− (./),
126−
127120 -- ** McCarthy's Conditional
128121 cond,
129122
130123 -- ** Matrix "abiding"
131− abideJF,
132− abideFJ,
133−
134− -- ** Zip Matrices
135− zipWithM,
124+ abideJS,
125+ abideSJ,
136126
137127 -- * Biproduct approach
138− -- ** Fork
128+ -- ** Split
139129 (===),
140130 -- *** Projections
141131 p1,
142132 p2,
143− -- ** Join
133+ -- ** Junc
144134 (|||),
145135 -- *** Injections
146136 i1,
@@ -154,11 +144,11 @@ module LAoP.Matrix.Type
154144 -- | Note that given the restrictions imposed it is not possible to
155145 -- implement the standard type classes present in standard Haskell.
156146 -- *** Matrix pairing projections
157− fstM,
158− sndM,
147+ kp1,
148+ kp2,
159149
160150 -- *** Matrix pairing
161− kr,
151+ khatri,
162152
163153 -- * Matrix composition and lifting
164154
@@ -166,10 +156,10 @@ module LAoP.Matrix.Type
166156
167157 -- | Note that given the restrictions imposed it is not possible to
168158 -- implement the standard type classes present in standard Haskell.
169− iden,
159+ identity,
170160 comp,
171− fromF',
172161 fromF,
162+ fromF',
173163
174164 -- * Relation
175165 toRel,
@@ -183,44 +173,34 @@ where
183173import Data.Void
184174import Data.Proxy
185175import Data.Kind
186−import GHC.TypeLits
176+import GHC.TypeLits
187177import Control.DeepSeq
188178import LAoP.Utils
179+import qualified Control.Category as C
189180import qualified LAoP.Matrix.Internal as I
190−import Prelude hiding (id, (.))
191181
192182newtype Matrix e (cols :: Type) (rows :: Type) = M (I.Matrix e (I.Normalize cols) (I.Normalize rows))
193183 deriving (Show, Num, Eq, Ord, NFData) via (I.Matrix e (I.Normalize cols) (I.Normalize rows))
194184
195185-- | 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)
186+type Countable a = KnownNat (I.Count a)
187+type CountableDimensions a b = (Countable a, Countable b)
188+type CountableN a = KnownNat (I.Count (I.Normalize a))
189+type CountableDimensionsN a b = (CountableN a, CountableN b)
190+type FromListsN e a b = I.FromLists e (I.Normalize a) (I.Normalize b)
191+type Liftable e a b = (Bounded a, Bounded b, Enum a, Enum b, Eq b, Num e, Ord e)
192+type Trivial a = I.Normalize a ~ I.Normalize (I.Normalize a)
193+type TrivialE a b = I.Normalize (Either a b) ~ Either (I.Normalize a) (I.Normalize b)
194+type TrivialP a b = I.Normalize (a, b) ~ I.Normalize (I.Normalize a, I.Normalize b)
195+
196+-- | It isn't possible to implement the 'id' function so it's
197+-- implementation is 'undefined'. However 'comp' can be and this partial
198+-- class implementation exists just to make the code more readable.
199+--
200+-- Please use 'identity' instead.
201+instance (Num e) => C.Category (Matrix e) where
202+ id = undefined
203+ (.) = comp
224204
225205-- | Zero type alias
226206type Zero = Void
@@ -230,74 +210,82 @@ type One = ()
230210
231211-- Primitives
232212
213+-- | Empty matrix constructor
214+empty :: Matrix e Zero Zero
215+empty = M I.Empty
216+
233217-- | Unit matrix constructor
234218one :: e -> Matrix e One One
235219one = M . I.One
236220
237−-- | Matrix 'Join' constructor
238−join ::
221+-- | Matrix 'Junc' constructor
222+junc ::
223+ (TrivialE a b) =>
239224 Matrix e a rows ->
240225 Matrix e b rows ->
241226 Matrix e (Either a b) rows
242−join (M a) (M b) = M (I.Join a b)
227+junc (M a) (M b) = M (I.Junc a b)
243228
244229infixl 3 |||
245−-- | Matrix 'Join' constructor
230+-- | Matrix 'Junc' constructor
246231(|||) ::
232+ (TrivialE a b) =>
247233 Matrix e a rows ->
248234 Matrix e b rows ->
249235 Matrix e (Either a b) rows
250−(|||) = join
236+(|||) = junc
251237
252−-- | Matrix 'Fork' constructor
253−fork ::
238+-- | Matrix 'Split' constructor
239+split ::
240+ (TrivialE a b) =>
254241 Matrix e cols a ->
255242 Matrix e cols b ->
256243 Matrix e cols (Either a b)
257−fork (M a) (M b) = M (I.Fork a b)
244+split (M a) (M b) = M (I.Split a b)
258245
259246infixl 2 ===
260−-- | Matrix 'Fork' constructor
247+-- | Matrix 'Split' constructor
261248(===) ::
249+ (TrivialE a b) =>
262250 Matrix e cols a ->
263251 Matrix e cols b ->
264252 Matrix e cols (Either a b)
265−(===) = fork
253+(===) = split
266254
267255-- Functor hierarchy
268256
269257-- | Functor instance equivalent function
270−fmapM ::
258+fmapM ::
271259 ( Liftable e a b,
272− CountableDimsN a b,
273− FLN b a
260+ CountableDimensionsN a b,
261+ FromListsN e b a
274262 )
275263 =>
276264 (a -> b) -> Matrix e c a -> Matrix e c b
277−fmapM f m = fromF f . m
265+fmapM f m = fromF' f `comp` m
278266
279267-- | Applicative instance equivalent 'unit' function,
280268unitM :: (Num e) => Matrix e () ()
281269unitM = one 1
282270
283271-- | Applicative instance equivalent 'unit' function,
284−multM ::
285− ( CountableDimsN a b,
272+multM ::
273+ ( CountableDimensionsN a b,
286274 CountableN (a, b),
287275 Num e,
288− FLN (a, b) a,
289− FLN (a, b) b,
276+ FromListsN e (a, b) a,
277+ FromListsN e (a, b) b,
290278 TrivialP a b
291279 ) => Matrix e c a -> Matrix e c b -> Matrix e c (a, b)
292−multM = kr
280+multM = khatri
293281
294282-- | Monad instance equivalent 'return' function,
295−returnM ::
296− forall e a .
283+returnM ::
284+ forall e a .
297285 ( Num e,
298286 Enum e,
299287 Enum a,
300− FLN () a,
288+ FromListsN e () a,
301289 Countable a
302290 ) => a -> Matrix e One a
303291returnM a = col l
@@ -314,64 +302,51 @@ bindM = flip comp
314302
315303-- | Build a matrix out of a list of list of elements. Throws a runtime
316304-- error if the dimensions do not match.
317−fromLists :: (FLN cols rows) => [[e]] -> Matrix e cols rows
305+fromLists :: (FromListsN e cols rows) => [[e]] -> Matrix e cols rows
318306fromLists = M . I.fromLists
319307
320308-- | 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.
309+-- a construction function.
329310matrixBuilder ::
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)
311+ (FromListsN e cols rows, CountableDimensionsN cols rows )
312+ => ((Int, Int) -> e) -> Matrix e cols rows
313+matrixBuilder = M . I.matrixBuilder
339314
340315-- | Constructs a column vector matrix
341−col :: (FLN () rows) => [e] -> Matrix e One rows
316+col :: (FromListsN e () rows) => [e] -> Matrix e One rows
342317col = M . I.col
343318
344319-- | Constructs a row vector matrix
345−row :: (FLN cols ()) => [e] -> Matrix e cols One
320+row :: (FromListsN e cols ()) => [e] -> Matrix e cols One
346321row = M . I.row
347322
348323-- | Lifts functions to matrices with arbitrary dimensions.
349324--
350325-- NOTE: Be careful to not ask for a matrix bigger than the cardinality of
351326-- types @a@ or @b@ allows.
352−fromF' ::
327+fromF ::
353328 ( Liftable e a b,
354− CountableDimsN cols rows,
355− FLN rows cols
329+ CountableDimensionsN cols rows,
330+ FromListsN e rows cols
356331 ) =>
357332 (a -> b) -> Matrix e cols rows
358−fromF' = M . I.fromF'
333+fromF = M . I.fromF
359334
360335-- | Lifts functions to matrices with dimensions matching @a@ and @b@
361336-- cardinality's.
362−fromF ::
337+fromF' ::
363338 ( Liftable e a b,
364− CountableDimsN a b,
365− FLN b a
339+ CountableDimensionsN a b,
340+ FromListsN e b a
366341 ) =>
367342 (a -> b) -> Matrix e a b
368−fromF = M . I.fromF
343+fromF' = M . I.fromF'
369344
370345-- | Lifts relation functions to Boolean Matrix
371346toRel ::
372347 ( Liftable (Natural 0 1) a b,
373− CountableDims a b,
374− FLN b a
348+ CountableDimensionsN a b,
349+ FromListsN (Natural 0 1) b a
375350 ) => (a -> b -> Bool) -> Matrix (Natural 0 1) a b
376351toRel = M . I.toRel
377352
@@ -389,7 +364,7 @@ toList (M m) = I.toList m
389364
390365-- | The zero matrix. A matrix wholly filled with zeros.
391366zeros ::
392− (Num e, FLN cols rows, CountableDimsN cols rows)
367+ (Num e, FromListsN e cols rows, CountableDimensionsN cols rows)
393368 => Matrix e cols rows
394369zeros = M I.zeros
395370
@@ -399,7 +374,7 @@ zeros = M I.zeros
399374--
400375-- Also known as T (Top) matrix.
401376ones ::
402− (Num e, FLN cols rows, CountableDimsN cols rows)
377+ (Num e, FromListsN e cols rows, CountableDimensionsN cols rows)
403378 => Matrix e cols rows
404379ones = M I.ones
405380
@@ -408,7 +383,7 @@ ones = M I.ones
408383-- | The constant matrix constructor. A matrix wholly filled with a given
409384-- value.
410385constant ::
411− (Num e, FLN cols rows, CountableDimsN cols rows)
386+ (Num e, FromListsN e cols rows, CountableDimensionsN cols rows)
412387 => e -> Matrix e cols rows
413388constant = M . I.constant
414389
@@ -417,30 +392,17 @@ constant = M . I.constant
417392-- | The T (Top) row vector matrix.
418393bang ::
419394 forall e cols.
420− (Num e, Enum e, FLN cols (), CountableN cols) =>
395+ (Num e, Enum e, FromListsN e cols (), CountableN cols) =>
421396 Matrix e cols One
422397bang = M I.bang
423398
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
399+-- Identity Matrix
435400
436−-- iden Matrix
437−
438−-- | iden matrix
439−iden ::
440− (Num e, FLN a a, CountableN a) =>
401+-- | Identity matrix
402+identity ::
403+ (Num e, FromListsN e a a, CountableN a) =>
441404 Matrix e a a
442−iden = M I.iden
443−{-# NOINLINE iden #-}
405+identity = M I.identity
444406
445407-- Matrix composition (MMM)
446408
@@ -450,32 +412,14 @@ iden = M I.iden
450412-- from LAoP.
451413comp :: (Num e) => Matrix e cr rows -> Matrix e cols cr -> Matrix e cols rows
452414comp (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)
472415
473416-- | Biproduct first component projection
474417p1 ::
475418 ( Num e,
476− CountableDimsN n m,
477− FLN n m,
478− FLN m m
419+ CountableDimensionsN n m,
420+ FromListsN e n m,
421+ FromListsN e m m,
422+ TrivialE m n
479423 ) =>
480424 Matrix e (Either m n) m
481425p1 = M I.p1
@@ -483,9 +427,10 @@ p1 = M I.p1
483427-- | Biproduct second component projection
484428p2 ::
485429 ( Num e,
486− CountableDimsN n m,
487− FLN m n,
488− FLN n n
430+ CountableDimensionsN n m,
431+ FromListsN e m n,
432+ FromListsN e n n,
433+ TrivialE m n
489434 ) =>
490435 Matrix e (Either m n) n
491436p2 = M I.p2
@@ -495,9 +440,10 @@ p2 = M I.p2
495440-- | Biproduct first component injection
496441i1 ::
497442 ( Num e,
498− CountableDimsN n m,
499− FLN n m,
500− FLN m m
443+ CountableDimensionsN n m,
444+ FromListsN e n m,
445+ FromListsN e m m,
446+ TrivialE m n
501447 ) =>
502448 Matrix e m (Either m n)
503449i1 = tr p1
@@ -505,9 +451,10 @@ i1 = tr p1
505451-- | Biproduct second component injection
506452i2 ::
507453 ( Num e,
508− CountableDimsN n m,
509− FLN m n,
510− FLN n n
454+ CountableDimensionsN n m,
455+ FromListsN e m n,
456+ FromListsN e n n,
457+ TrivialE m n
511458 ) =>
512459 Matrix e n (Either m n)
513460i2 = tr p2
@@ -516,34 +463,24 @@ i2 = tr p2
516463
517464-- | Obtain the number of rows.
518465--
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''.
466+-- NOTE: The 'KnownNat' constaint is needed in order to obtain the
467+-- dimensions in constant time.
468+--
469+-- TODO: A 'rows' function that does not need the 'KnownNat' constraint in
470+-- exchange for performance.
522471rows :: (CountableN rows) => Matrix e cols rows -> Int
523472rows (M m) = I.rows m
524473
525−-- | Obtain the number of rows in an inefficient manner, but without any
526−-- constraints.
527−--
528−-- For a more efficient version see 'rows'.
529−rows' :: Matrix e cols rows -> Int
530−rows' (M m) = I.rows' m
531−
532474-- | Obtain the number of columns.
475+--
476+-- NOTE: The 'KnownNat' constaint is needed in order to obtain the
477+-- dimensions in constant time.
533478--
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''.
479+-- TODO: A 'columns' function that does not need the 'KnownNat' constraint in
480+-- exchange for performance.
537481columns :: (CountableN cols) => Matrix e cols rows -> Int
538482columns (M m) = I.columns m
539483
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−
547484-- Coproduct Bifunctor
548485
549486infixl 5 -|-
@@ -551,11 +488,13 @@ infixl 5 -|-
551488-- | Matrix coproduct functor also known as matrix direct sum.
552489(-|-) ::
553490 ( Num e,
554− CountableDimsN j k,
555− FLN k k,
556− FLN j k,
557− FLN k j,
558− FLN j j
491+ CountableDimensionsN j k,
492+ FromListsN e k k,
493+ FromListsN e j k,
494+ FromListsN e k j,
495+ FromListsN e j j,
496+ TrivialE n m,
497+ TrivialE k j
559498 ) =>
560499 Matrix e n k ->
561500 Matrix e m j ->
@@ -565,98 +504,98 @@ infixl 5 -|-
565504-- Khatri Rao Product and projections
566505
567506-- | Khatri Rao product first component projection matrix.
568−fstM ::
507+kp1 ::
569508 forall e m k .
570509 ( Num e,
571− CountableDimsN m k,
510+ CountableDimensionsN m k,
572511 CountableN (m, k),
573− FLN (m, k) m,
512+ FromListsN e (m, k) m,
574513 TrivialP m k
575514 ) => Matrix e (m, k) m
576−fstM = M (I.fstM @e @(I.Normalize m) @(I.Normalize k))
515+kp1 = M (I.kp1 @e @(I.Normalize m) @(I.Normalize k))
577516
578517-- | Khatri Rao product second component projection matrix.
579−sndM ::
518+kp2 ::
580519 forall e m k.
581520 ( Num e,
582− CountableDimsN k m,
521+ CountableDimensionsN k m,
583522 CountableN (m, k),
584− FLN (m, k) k,
523+ FromListsN e (m, k) k,
585524 TrivialP m k
586525 ) => Matrix e (m, k) k
587−sndM = M (I.sndM @e @(I.Normalize m) @(I.Normalize k))
526+kp2 = M (I.kp2 @e @(I.Normalize m) @(I.Normalize k))
588527
589528-- | Khatri Rao Matrix product also known as matrix pairing.
590529--
591530-- NOTE: That this is not a true categorical product, see for instance:
592−--
531+--
593532-- @
594−-- | fstM . kr a b == a
595−-- kr a b ==> |
596−-- | sndM . kr a b == b
533+-- | kp1 `comp` khatri a b == a
534+-- khatri a b ==> |
535+-- | kp2 `comp` khatri a b == b
597536-- @
598537--
599538-- __Emphasis__ on the implication symbol.
600−kr ::
539+khatri ::
601540 forall e cols a b.
602541 ( Num e,
603− CountableDimsN a b,
542+ CountableDimensionsN a b,
604543 CountableN (a, b),
605− FLN (a, b) a,
606− FLN (a, b) b,
544+ FromListsN e (a, b) a,
545+ FromListsN e (a, b) b,
607546 TrivialP a b
608547 ) => 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
548+khatri a b =
549+ let kp1' = kp1 @e @a @b
550+ kp2' = kp2 @e @a @b
551+ in comp (tr kp1') a * comp (tr kp2') b
613552
614553-- Product Bifunctor (Kronecker)
615554
616555infixl 4 ><
617556
618−-- | Matrix product functor also known as Kronecker product
557+-- | Matrix product functor also known as kronecker product
619558(><) ::
620559 forall e m p n q.
621560 ( 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,
561+ CountableDimensionsN m n,
562+ CountableDimensionsN p q,
563+ CountableDimensionsN (m, n) (p, q),
564+ FromListsN e (m, n) m,
565+ FromListsN e (m, n) n,
566+ FromListsN e (p, q) p,
567+ FromListsN e (p, q) q,
629568 TrivialP m n,
630569 TrivialP p q
631570 ) => Matrix e m p -> Matrix e n q -> Matrix e (m, n) (p, q)
632571(><) a b =
633− let fstM' = fstM @e @m @n
634− sndM' = sndM @e @m @n
635− in kr (comp a fstM') (comp b sndM')
572+ let kp1' = kp1 @e @m @n
573+ kp2' = kp2 @e @m @n
574+ in khatri (comp a kp1') (comp b kp2')
636575
637−-- Matrix abide Join Fork
576+-- Matrix abide Junc Split
638577
639−-- | Matrix "abiding" followin the 'Join'-'Fork' abide law.
640−--
578+-- | Matrix "abiding" followin the 'Junc'-'Split' abide law.
579+--
641580-- Law:
642581--
643582-- @
644−-- 'Join' ('Fork' a c) ('Fork' b d) == 'Fork' ('Join' a b) ('Join' c d)
583+-- 'Junc' ('Split' a c) ('Split' b d) == 'Split' ('Junc' a b) ('Junc' c d)
645584-- @
646−abideJF :: Matrix e cols rows -> Matrix e cols rows
647−abideJF (M m) = M (I.abideJF m)
585+abideJS :: Matrix e cols rows -> Matrix e cols rows
586+abideJS (M m) = M (I.abideJS m)
648587
649−-- Matrix abide Fork Join
588+-- Matrix abide Split Junc
650589
651−-- | Matrix "abiding" followin the 'Fork'-'Join' abide law.
652−--
590+-- | Matrix "abiding" followin the 'Split'-'Junc' abide law.
591+--
653592-- Law:
654593--
655594-- @
656−-- 'Fork' ('Join' a b) ('Join' c d) == 'Join' ('Fork' a c) ('Fork' b d)
595+-- 'Split' ('Junc' a b) ('Junc' c d) == 'Junc' ('Split' a c) ('Split' b d)
657596-- @
658−abideFJ :: Matrix e cols rows -> Matrix e cols rows
659−abideFJ (M m) = M (I.abideFJ m)
597+abideSJ :: Matrix e cols rows -> Matrix e cols rows
598+abideSJ (M m) = M (I.abideSJ m)
660599
661600-- Matrix transposition
662601
@@ -668,10 +607,11 @@ tr (M m) = M (I.tr m)
668607
669608-- | Selective functors 'select' operator equivalent inspired by the
670609-- ArrowMonad solution presented in the paper.
671−selectM ::
610+selectM ::
672611 ( Num e,
673− FLN b b,
674− CountableN b
612+ FromListsN e b b,
613+ CountableN b,
614+ TrivialE a b
675615 ) => Matrix e cols (Either a b) -> Matrix e a b -> Matrix e cols b
676616selectM (M m) (M y) = M (I.select m y)
677617
@@ -680,12 +620,10 @@ selectM (M m) (M y) = M (I.select m y)
680620-- | McCarthy's Conditional expresses probabilistic choice.
681621cond ::
682622 ( Trivial a,
683− Trivial2 a,
684− Trivial3 a,
685623 CountableN a,
686− FLN () a,
687− FLN a (),
688− FLN a a,
624+ FromListsN e () a,
625+ FromListsN e a (),
626+ FromListsN e a a,
689627 Liftable e a Bool
690628 )
691629 =>
@@ -695,13 +633,9 @@ cond p (M a) (M b) = M (I.cond p a b)
695633-- Pretty print
696634
697635-- | Matrix pretty printer
698−pretty :: (CountableDimsN cols rows, Show e) => Matrix e cols rows -> String
636+pretty :: (CountableN cols, Show e) => Matrix e cols rows -> String
699637pretty (M m) = I.pretty m
700638
701639-- | Matrix pretty printer
702−prettyPrint :: (CountableDimsN cols rows, Show e) => Matrix e cols rows -> IO ()
640+prettyPrint :: (CountableN cols, Show e) => Matrix e cols rows -> IO ()
703641prettyPrint (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+11−8
@@ -32,19 +32,22 @@ module LAoP.Relation
3232
3333 -- * Constraint type synonyms
3434 Countable,
35− CountableDims,
35+ CountableDimensions,
3636 CountableN,
37− CountableDimsN,
38− FLN,
37+ CountableDimensionsN,
38+ FromListsN,
3939 Liftable,
4040 Trivial,
41+ TrivialE,
4142 TrivialP,
43+ TrivialP2,
4244
4345 -- * Primitives
46+ empty,
4447 one,
45− join,
48+ junc,
4649 (|||),
47− fork,
50+ split,
4851 (===),
4952
5053 -- * Auxiliary type families
@@ -107,8 +110,8 @@ module LAoP.Relation
107110 splitR,
108111
109112 -- ** Projections
110− fstR,
111− sndR,
113+ p1,
114+ p2,
112115 -- ** Bifunctor
113116 (><),
114117 -- * Relational coproduct
@@ -147,7 +150,7 @@ module LAoP.Relation
147150 cond,
148151
149152 -- * Relational composition and lifting
150− iden,
153+ identity,
151154 comp,
152155 fromF,
153156 fromF',
src/LAoP/Relation/Internal.hs+254−250
@@ -1,4 +1,3 @@
1−{-# LANGUAGE TypeFamilies #-}
21{-# LANGUAGE ConstraintKinds #-}
32{-# LANGUAGE GADTs #-}
43{-# LANGUAGE UndecidableInstances #-}
@@ -43,19 +42,22 @@ module LAoP.Relation.Internal
4342
4443 -- * Constraint type synonyms
4544 Countable,
46− CountableDims,
45+ CountableDimensions,
4746 CountableN,
48− CountableDimsN,
49− FLN,
47+ CountableDimensionsN,
48+ FromListsN,
5049 Liftable,
5150 Trivial,
51+ TrivialE,
5252 TrivialP,
53+ TrivialP2,
5354
5455 -- * Primitives
56+ empty,
5557 one,
56− join,
58+ junc,
5759 (|||),
58− fork,
60+ split,
5961 (===),
6062
6163 -- * Auxiliary type families
@@ -66,15 +68,14 @@ module LAoP.Relation.Internal
6668 -- * Matrix construction and conversion
6769 I.FromLists,
6870 fromLists,
69− fromF',
7071 fromF,
72+ fromF',
7173 toRel,
7274 toLists,
7375 toList,
7476 toBool,
7577 pt,
7678 belongs,
77− relationBuilder',
7879 relationBuilder,
7980 zeros,
8081 ones,
@@ -119,8 +120,8 @@ module LAoP.Relation.Internal
119120 splitR,
120121
121122 -- ** Projections
122− fstR,
123− sndR,
123+ p1,
124+ p2,
124125 -- ** Bifunctor
125126 (><),
126127 -- * Relational coproduct
@@ -159,10 +160,10 @@ module LAoP.Relation.Internal
159160 cond,
160161
161162 -- * Relational composition and lifting
162− iden,
163+ identity,
163164 comp,
164− fromF',
165165 fromF,
166+ fromF',
166167
167168 -- ** Relational application
168169 pointAp,
@@ -178,9 +179,9 @@ import Data.Void
178179import qualified LAoP.Matrix.Internal as I
179180import LAoP.Utils.Internal
180181import Control.DeepSeq
182+import qualified Control.Category as C
181183import Data.Bool
182184import GHC.TypeLits
183−import Prelude hiding (id, (.))
184185
185186-- | Boolean type synonym for working with boolean matrices
186187type Boolean = Natural 0 1
@@ -193,30 +194,34 @@ newtype Relation a b = R (I.Matrix Boolean (I.Normalize a) (I.Normalize b))
193194deriving instance (Read (I.Matrix Boolean (I.Normalize a) (I.Normalize b))) => Read (Relation a b)
194195
195196-- | 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
197+type Countable a = KnownNat (I.Count a)
198+type CountableDimensions a b = (Countable a, Countable b)
199+type CountableN a = KnownNat (I.Count (I.Normalize a))
200+type CountableDimensionsN a b = (CountableN a, CountableN b)
201+type FromListsN a b = I.FromLists Boolean (I.Normalize a) (I.Normalize b)
202+type Liftable a b = (Bounded a, Bounded b, Enum a, Enum b, Eq b, Num Boolean, Ord Boolean)
203+type Trivial a = I.Normalize a ~ I.Normalize (I.Normalize a)
204+type TrivialE a b = I.Normalize (Either a b) ~ Either (I.Normalize a) (I.Normalize b)
205+type TrivialP a b = I.Normalize (a, b) ~ I.Normalize (I.Normalize a, I.Normalize b)
206+type TrivialP2 a b = I.Normalize (I.Normalize a, I.Normalize b) ~ I.Normalize (I.Normalize (a, b))
207+
208+-- | It isn't possible to implement the 'id' function so it's
209+-- implementation is 'undefined'. However 'comp' can be and this partial
210+-- class implementation exists just to make the code more readable.
211+--
212+-- Please use 'identity' instead.
213+instance C.Category Relation where
214+ id = undefined
215+ (.) = comp
211216
212217instance Num (Relation a b) where
213− -- | Matrix addition becomes Boolean matrix disjointion
218+ -- | Matrix addition becomes Boolean matrix disjunction
214219 (R a) + (R b) = R (I.orM a b)
215220
216221 -- | Matrix subtraction becomes Relational subtraction
217222 (R a) - (R b) = R (I.subM a b)
218223
219− -- | Matrix multiplication becomes Boolean matrix conjointion
224+ -- | Matrix multiplication becomes Boolean matrix conjunction
220225 (R a) * (R b) = R (I.andM a b)
221226
222227 -- | Matrix negation becomes Boolean matrix negation
@@ -228,92 +233,87 @@ type One = ()
228233
229234-- Primitives
230235
236+-- | Empty matrix constructor
237+empty :: Relation Zero Zero
238+empty = R I.Empty
239+
231240-- | Unit matrix constructor
232241one :: Boolean -> Relation One One
233242one = R . I.One
234243
235−-- | Boolean Matrix 'Join' constructor, also known as relational coproduct.
244+-- | Boolean Matrix 'Junc' constructor, also known as relational coproduct.
236245--
237246-- 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)
247+junc :: (TrivialE a b)
248+ => Relation a c -> Relation b c -> Relation (Either a b) c
249+junc (R a) (R b) = R (I.Junc a b)
240250
241251infixl 3 |||
242−-- | Boolean Matrix 'Join' constructor
252+-- | Boolean Matrix 'Junc' constructor
243253--
244254-- See 'eitherR'.
245255(|||) ::
256+ (TrivialE a b) =>
246257 Relation a c ->
247258 Relation b c ->
248259 Relation (Either a b) c
249−(|||) = join
260+(|||) = junc
250261
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)
262+-- | Boolean Matrix 'Split' constructor, also known as relational product.
263+split :: (TrivialE a b)
264+ => Relation c a -> Relation c b -> Relation c (Either a b)
265+split (R a) (R b) = R (I.Split a b)
254266
255267infixl 2 ===
256−-- | Boolean Matrix 'Fork' constructor
268+-- | Boolean Matrix 'Split' constructor
257269(===) ::
270+ (TrivialE a b) =>
258271 Relation c a ->
259272 Relation c b ->
260273 Relation c (Either a b)
261−(===) = fork
274+(===) = split
262275
263276-- Construction
264277
265278-- | Build a matrix out of a list of list of elements. Throws a runtime
266279-- error if the dimensions do not match.
267−fromLists :: (FLN a b) => [[Boolean]] -> Relation a b
280+fromLists :: (FromListsN a b) => [[Boolean]] -> Relation a b
268281fromLists = R . I.fromLists
269282
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.
283+-- | Matrix builder function. Constructs a matrix provided with
284+-- a construction function.
279285relationBuilder ::
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
286+ (FromListsN a b, CountableDimensionsN a b) =>
287+ ((Int, Int) -> Boolean) -> Relation a b
288288relationBuilder = R . I.matrixBuilder
289289
290290-- | Lifts functions to matrices with arbitrary dimensions.
291291--
292292-- NOTE: Be careful to not ask for a matrix bigger than the cardinality of
293293-- types @a@ or @b@ allows.
294−fromF' ::
294+fromF ::
295295 ( Liftable a b,
296− CountableDimsN c d,
297− FLN d c
296+ CountableDimensionsN c d,
297+ FromListsN d c
298298 )
299299 => (a -> b) -> Relation c d
300−fromF' f = R (I.fromFRel' f)
300+fromF f = R (I.fromFRel f)
301301
302302-- | Lifts functions to matrices with dimensions matching @a@ and @b@
303303-- cardinality's.
304−fromF ::
304+fromF' ::
305305 ( Liftable a b,
306− CountableDimsN a b,
307− FLN b a
306+ CountableDimensionsN a b,
307+ FromListsN b a
308308 )
309309 => (a -> b) -> Relation a b
310−fromF f = R (I.fromFRel f)
310+fromF' f = R (I.fromFRel' f)
311311
312312-- | Lifts relation functions to 'Relation'
313313toRel ::
314314 ( Liftable a b,
315− CountableDims a b,
316− FLN b a
315+ CountableDimensionsN a b,
316+ FromListsN b a
317317 )
318318 => (a -> b -> Bool) -> Relation a b
319319toRel = R . I.toRel
@@ -322,9 +322,9 @@ toRel = R . I.toRel
322322fromRel ::
323323 ( Liftable a b,
324324 Eq a,
325− CountableDimsN a b,
326− FLN a One,
327− FLN b One
325+ CountableDimensionsN a b,
326+ FromListsN a One,
327+ FromListsN b One
328328 )
329329 => Relation a b -> (a -> b -> Bool)
330330fromRel r a b = pointApBool a b r
@@ -348,12 +348,12 @@ toBool r = case toList r of
348348-- | Power transpose.
349349--
350350-- Maps a relation to a set valued function.
351−pt ::
351+pt ::
352352 ( Liftable a b,
353353 Eq a,
354− CountableDimsN a b,
355− FLN a One,
356− FLN b One
354+ CountableDimensionsN a b,
355+ FromListsN a One,
356+ FromListsN b One
357357 )
358358 => Relation a b -> (a -> List b)
359359pt r a =
@@ -365,8 +365,8 @@ belongs ::
365365 ( Bounded a,
366366 Enum a,
367367 Eq a,
368− CountableDims (List a) a,
369− FLN a (List a)
368+ CountableDimensionsN (List a) a,
369+ FromListsN a (List a)
370370 )
371371 => Relation (List a) a
372372belongs = toRel elemR
@@ -378,16 +378,16 @@ belongs = toRel elemR
378378-- | The zero relation. A relation where no element of type @a@ relates
379379-- with elements of type @b@.
380380--
381−-- Also known as ⊥ (Bottom) Relation.
381+-- Also known as ⊥ (Bottom) Relation or empty Relation.
382382--
383383-- @
384−-- r `.` ⊥ == ⊥ `.` r == ⊥
384+-- r ``comp`` ⊥ == ⊥ ``comp`` r == ⊥
385385-- ⊥ ``sse`` R && R ``sse`` T == True
386386-- @
387387zeros ::
388− (FLN a b, CountableDimsN a b) =>
388+ (FromListsN a b, CountableDimensionsN a b) =>
389389 Relation a b
390−zeros = relationBuilder' (const (nat 0))
390+zeros = relationBuilder (const (nat 0))
391391
392392-- Ones Matrix
393393
@@ -400,43 +400,43 @@ zeros = relationBuilder' (const (nat 0))
400400-- ⊥ ``sse`` R && R ``sse`` T == True
401401-- @
402402ones ::
403− (FLN a b, CountableDimsN a b) =>
403+ (FromListsN a b, CountableDimensionsN a b) =>
404404 Relation a b
405−ones = relationBuilder' (const (nat 1))
405+ones = relationBuilder (const (nat 1))
406406
407407-- Bang Matrix
408408
409409-- | The T (Top) row vector relation.
410410bang ::
411− (FLN a One, CountableN a) =>
411+ (FromListsN a One, CountableN a) =>
412412 Relation a One
413413bang = ones
414414
415415-- | Point constant relation
416−point ::
416+point ::
417417 ( Bounded a,
418418 Enum a,
419419 Eq a,
420420 CountableN a,
421− FLN a One
421+ FromListsN a One
422422 ) => a -> Relation One a
423−point = fromF . const
423+point = fromF' . const
424424
425−-- iden Matrix
425+-- Identity Matrix
426426
427−-- | iden matrix
427+-- | Identity matrix
428428--
429429-- @
430−-- 'iden' `.` r == r == r `.` 'iden'
430+-- 'identity' ``comp`` r == r == r ``comp`` 'identity'
431431-- @
432−iden ::
433− (FLN a a, CountableN a) => Relation a a
434−iden = relationBuilder' (bool (nat 0) (nat 1) . uncurry (==))
432+identity ::
433+ (FromListsN a a, CountableN a) => Relation a a
434+identity = relationBuilder (bool (nat 0) (nat 1) . uncurry (==))
435435
436436-- | Relational composition
437437--
438438-- @
439−-- r `.` (s `.` p) = (r `.` s) `.` p
439+-- r ``comp`` (s ``comp`` p) = (r ``comp`` s) ``comp`` p
440440-- @
441441comp :: Relation b c -> Relation a b -> Relation a c
442442comp (R a) (R b) = R (I.compRel a b)
@@ -484,7 +484,7 @@ shrunkBy r s = r `intersection` divR s (conv r)
484484-- r ``overriddenBy`` r == r
485485-- @
486486overriddenBy ::
487− ( FLN b b,
487+ ( FromListsN b b,
488488 CountableN b
489489 ) => Relation a b -> Relation a b -> Relation a b
490490overriddenBy r s = s `union` r `intersection` divR zeros (conv s)
@@ -496,11 +496,11 @@ overriddenBy r s = s `union` r `intersection` divR zeros (conv s)
496496pointAp ::
497497 ( Liftable a b,
498498 Eq a,
499− CountableDimsN a b,
500− FLN a One,
501− FLN b One
499+ CountableDimensionsN a b,
500+ FromListsN a One,
501+ FromListsN b One
502502 ) => a -> b -> Relation a b -> Relation One One
503−pointAp a b r = conv (point b) . r . point a
503+pointAp a b r = conv (point b) `comp` r `comp` point a
504504
505505-- | Relational application
506506--
@@ -508,11 +508,11 @@ pointAp a b r = conv (point b) . r . point a
508508pointApBool ::
509509 ( Liftable a b,
510510 Eq a,
511− CountableDimsN a b,
512− FLN a One,
513− FLN b One
511+ CountableDimensionsN a b,
512+ FromListsN a One,
513+ FromListsN b One
514514 ) => a -> b -> Relation a b -> Bool
515−pointApBool a b r = toBool $ conv (point b) . r . point a
515+pointApBool a b r = toBool $ conv (point b) `comp` r `comp` point a
516516
517517-- | Relational converse
518518--
@@ -538,7 +538,7 @@ iff r s = r == s
538538
539539-- | Relational intersection
540540--
541−-- Lifts pointwise conjointion.
541+-- Lifts pointwise conjunction.
542542--
543543-- @
544544-- (r ``intersection`` s) ``intersection`` t == r ``intersection`` (s ``intersection`` t)
@@ -549,13 +549,13 @@ intersection a b = a * b
549549
550550-- | Relational union
551551--
552−-- Lifts pointwise disjointion.
552+-- Lifts pointwise disjunction.
553553--
554554-- @
555555-- (r ``union`` s) ``union`` t == r `'union' (s ``union`` t)
556556-- r ``union`` s ``sse`` x == r ``sse`` x && s ``sse`` x
557−-- r `.` (s ``union`` t) == (r `.` s) ``union`` (r `.` t)
558−-- (s ``union`` t) `.` r == (s `.` r) ``union`` (t `.` r)
557+-- r ``comp`` (s ``union`` t) == (r ``comp`` s) ``union`` (r ``comp`` t)
558+-- (s ``union`` t) ``comp`` r == (s ``comp`` r) ``union`` (t ``comp`` r)
559559-- @
560560union :: Relation a b -> Relation a b -> Relation a b
561561union a b = a + b
@@ -563,46 +563,46 @@ union a b = a + b
563563-- | Relation Kernel
564564--
565565-- @
566−-- 'ker' r == 'conv' r `.` r
566+-- 'ker' r == 'conv' r ``comp`` r
567567-- 'ker' r == 'img' ('conv' r)
568568-- @
569569ker :: Relation a b -> Relation a a
570−ker r = conv r . r
570+ker r = conv r `comp` r
571571
572572-- | Relation Image
573573--
574574-- @
575−-- 'img' r == r `.` conv r
575+-- 'img' r == r ``comp`` conv r
576576-- 'img' r == 'ker' ('conv' r)
577577-- @
578578img :: Relation a b -> Relation b b
579−img r = r . conv r
579+img r = r `comp` conv r
580580
581581-- | Function division. Special case of 'divS'.
582582--
583583-- NOTE: _This is only valid_ if @f@ and @g@ are 'function's, i.e. 'simple' and
584584-- 'entire'.
585585--
586−-- @'divisionF' f g == 'conv' g `.` f@
586+-- @'divisionF' f g == 'conv' g ``comp`` f@
587587divisionF :: Relation a c -> Relation b c -> Relation a b
588−divisionF f g = conv g . f
588+divisionF f g = conv g `comp` f
589589
590590-- Taxonomy of binary relations
591591
592592-- | A 'Relation' @r@ is 'simple' 'iff' @'coreflexive' ('img' r)@
593−simple :: (CountableN b, FLN b b) => Relation a b -> Bool
593+simple :: (CountableN b, FromListsN b b) => Relation a b -> Bool
594594simple = coreflexive . img
595595
596596-- | A 'Relation' @r@ is 'injective' 'iff' @'coreflexive' ('ker' r)@
597−injective :: (CountableN a, FLN a a) => Relation a b -> Bool
597+injective :: (CountableN a, FromListsN a a) => Relation a b -> Bool
598598injective = coreflexive . ker
599599
600600-- | A 'Relation' @r@ is 'entire' 'iff' @'reflexive' ('ker' r)@
601−entire :: (CountableN a, FLN a a) => Relation a b -> Bool
601+entire :: (CountableN a, FromListsN a a) => Relation a b -> Bool
602602entire = reflexive . ker
603603
604604-- | A 'Relation' @r@ is 'surjective' 'iff' @'reflexive' ('img' r)@
605−surjective :: (CountableN b, FLN b b) => Relation a b -> Bool
605+surjective :: (CountableN b, FromListsN b b) => Relation a b -> Bool
606606surjective = reflexive . img
607607
608608-- | A 'Relation' @r@ is a 'function' 'iff' @'simple' r && 'entire' r@
@@ -611,13 +611,13 @@ surjective = reflexive . img
611611-- relations:
612612--
613613-- @
614−-- f `.` r ``sse`` s == r ``sse`` f `.` s
615−-- r `.` f ``sse`` s == r ``sse`` s `.` f
614+-- f ``comp`` r ``sse`` s == r ``sse`` f ``comp`` s
615+-- r ``comp`` f ``sse`` s == r ``sse`` s ``comp`` f
616616-- @
617617function ::
618− ( CountableDimsN a b,
619− FLN a a,
620− FLN b b
618+ ( CountableDimensionsN a b,
619+ FromListsN a a,
620+ FromListsN b b
621621 )
622622 => Relation a b -> Bool
623623function r = simple r && entire r
@@ -625,7 +625,7 @@ function r = simple r && entire r
625625-- | A 'Relation' @r@ is a 'representation' 'iff' @'injective' r && 'entire' r@
626626representation ::
627627 ( CountableN a,
628− FLN a a
628+ FromListsN a a
629629 )
630630 => Relation a b -> Bool
631631representation r = injective r && entire r
@@ -633,91 +633,91 @@ representation r = injective r && entire r
633633-- | A 'Relation' @r@ is an 'abstraction' 'iff' @'surjective' r && 'simple' r@
634634abstraction ::
635635 ( CountableN b,
636− FLN b b
636+ FromListsN b b
637637 )
638638 => Relation a b -> Bool
639639abstraction r = surjective r && simple r
640640
641641-- | A 'Relation' @r@ is a 'surjection' 'iff' @'function' r && 'abstraction' r@
642642surjection ::
643− ( CountableDimsN a b,
644− FLN a a,
645− FLN b b
643+ ( CountableDimensionsN a b,
644+ FromListsN a a,
645+ FromListsN b b
646646 )
647647 => Relation a b -> Bool
648648surjection r = function r && abstraction r
649649
650650-- | A 'Relation' @r@ is a 'injection' 'iff' @'function' r && 'representation' r@
651651injection ::
652− ( CountableDimsN a b,
653− FLN a a,
654− FLN b b
652+ ( CountableDimensionsN a b,
653+ FromListsN a a,
654+ FromListsN b b
655655 )
656656 => Relation a b -> Bool
657657injection r = function r && representation r
658658
659659-- | A 'Relation' @r@ is an 'bijection' 'iff' @'injection' r && 'surjection' r@
660660bijection ::
661− ( CountableDimsN a b,
662− FLN b b,
663− FLN a a
661+ ( CountableDimensionsN a b,
662+ FromListsN b b,
663+ FromListsN a a
664664 ) => Relation a b -> Bool
665665bijection r = injection r && surjection r
666666
667667-- Properties of relations
668668
669−-- | A 'Relation' @r@ is 'reflexive' 'iff' @'id' ``sse`` r@
670−reflexive :: (CountableN a, FLN a a) => Relation a a -> Bool
671−reflexive r = id <= r
669+-- | A 'Relation' @r@ is 'reflexive' 'iff' @'identity' ``sse`` r@
670+reflexive :: (CountableN a, FromListsN a a) => Relation a a -> Bool
671+reflexive r = identity <= r
672672
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
673+-- | A 'Relation' @r@ is 'coreflexive' 'iff' @r ``sse`` 'identity'@
674+coreflexive :: (CountableN a, FromListsN a a) => Relation a a -> Bool
675+coreflexive r = r <= identity
676676
677−-- | A 'Relation' @r@ is 'transitive' 'iff' @(r `.` r) ``sse`` r@
677+-- | A 'Relation' @r@ is 'transitive' 'iff' @(r ``comp`` r) ``sse`` r@
678678transitive :: Relation a a -> Bool
679−transitive r = (r . r) `sse` r
679+transitive r = (r `comp` r) `sse` r
680680
681681-- | A 'Relation' @r@ is 'symmetric' 'iff' @r == 'conv' r@
682682symmetric :: Relation a a -> Bool
683683symmetric r = r == conv r
684684
685−-- | A 'Relation' @r@ is anti-symmetric 'iff' @(r ``intersection`` 'conv' r) ``sse`` 'id'@
686−antiSymmetric :: (CountableN a, FLN a a) => Relation a a -> Bool
687−antiSymmetric r = (r `intersection` conv r) `sse` id
685+-- | A 'Relation' @r@ is anti-symmetric 'iff' @(r ``intersection`` 'conv' r) ``sse`` 'identity'@
686+antiSymmetric :: (CountableN a, FromListsN a a) => Relation a a -> Bool
687+antiSymmetric r = (r `intersection` conv r) `sse` identity
688688
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
689+-- | A 'Relation' @r@ is 'irreflexive' 'iff' @(r ``intersection`` 'identity') == 'zeros'@
690+irreflexive :: (CountableN a, FromListsN a a) => Relation a a -> Bool
691+irreflexive r = (r `intersection` identity) == zeros
692692
693693-- | A 'Relation' @r@ is 'connected' 'iff' @(r ``union`` 'conv' r) == 'ones'@
694−connected :: (CountableN a, FLN a a) => Relation a a -> Bool
694+connected :: (CountableN a, FromListsN a a) => Relation a a -> Bool
695695connected r = (r `union` conv r) == ones
696696
697697-- | A 'Relation' @r@ is a 'preorder' 'iff' @'reflexive' r && 'transitive' r@
698−preorder :: (CountableN a, FLN a a) => Relation a a -> Bool
698+preorder :: (CountableN a, FromListsN a a) => Relation a a -> Bool
699699preorder r = reflexive r && transitive r
700700
701701-- | A 'Relation' @r@ is a partial-order 'iff' @'antiSymmetric' r && 'preorder' r@
702−partialOrder :: (CountableN a, FLN a a) => Relation a a -> Bool
702+partialOrder :: (CountableN a, FromListsN a a) => Relation a a -> Bool
703703partialOrder r = antiSymmetric r && preorder r
704704
705705-- | A 'Relation' @r@ is a linear-order 'iff' @'connected' r && 'partialOrder' r@
706−linearOrder :: (CountableN a, FLN a a) => Relation a a -> Bool
706+linearOrder :: (CountableN a, FromListsN a a) => Relation a a -> Bool
707707linearOrder r = connected r && partialOrder r
708708
709709-- | A 'Relation' @r@ is an 'equivalence' 'iff' @'symmetric' r && 'preorder' r@
710−equivalence :: (CountableN a, FLN a a) => Relation a a -> Bool
710+equivalence :: (CountableN a, FromListsN a a) => Relation a a -> Bool
711711equivalence r = symmetric r && preorder r
712712
713713-- | A 'Relation' @r@ is a partial-equivalence 'iff' @'partialOrder' r && 'equivalence' r@
714−partialEquivalence :: (CountableN a, FLN a a) => Relation a a -> Bool
714+partialEquivalence :: (CountableN a, FromListsN a a) => Relation a a -> Bool
715715partialEquivalence r = partialOrder r && equivalence r
716716
717717-- | A 'Relation' @r@ is 'difunctional' or regular wherever
718−-- @r `.` 'conv' r `.` r == r@
718+-- @r ``comp`` 'conv' r ``comp`` r == r@
719719difunctional :: Relation a b -> Bool
720−difunctional r = r . conv r . r == r
720+difunctional r = r `comp` conv r `comp` r == r
721721
722722-- Relational pairing
723723
@@ -726,61 +726,61 @@ difunctional r = r . conv r . r == r
726726-- NOTE: That this is not a true categorical product, see for instance:
727727--
728728-- @
729−-- | 'fstR' `.` 'splitR' a b ``sse`` a
729+-- | 'p1' ``comp`` 'splitR' a b ``sse`` a
730730-- 'splitR' a b <=> |
731−-- | 'sndR' `.` 'splitR' a b ``sse`` b
731+-- | 'p2' ``comp`` 'splitR' a b ``sse`` b
732732-- @
733733--
734734-- __Emphasis__ on the 'sse'.
735735--
736736-- @
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)
737+-- 'splitR' r s ``comp`` f == 'splitR' (r ``comp`` f) (s ``comp`` f)
738+-- (R '><' S) ``comp`` 'splitR' p q == 'splitR' (r ``comp`` p) (s ``comp`` q)
739+-- 'conv' ('splitR' r s) ``comp`` 'splitR' x y == ('conv' r ``comp`` x) ``intersection`` ('conv' s ``comp`` y)
740740-- @
741741--
742742-- @
743743-- 'eitherR' ('splitR' r s) ('splitR' t v) == 'splitR' ('eitherR' r t) ('eitherR' s v)
744744-- @
745745splitR ::
746− ( CountableDimsN a b,
746+ ( CountableDimensionsN a b,
747747 CountableN (a, b),
748− FLN (a, b) a,
749− FLN (a, b) b,
748+ FromListsN (a, b) a,
749+ FromListsN (a, b) b,
750750 TrivialP a b
751751 )
752752 => Relation c a -> Relation c b -> Relation c (a, b)
753−splitR (R f) (R g) = R (I.kr f g)
753+splitR (R f) (R g) = R (I.khatri f g)
754754
755755-- | Relational pairing first component projection
756756--
757757-- @
758−-- 'fstR' `.` 'splitR' r s ``sse`` r
758+-- 'p1' ``comp`` 'splitR' r s ``sse`` r
759759-- @
760−fstR ::
760+p1 ::
761761 forall a b .
762− ( CountableDimsN a b,
762+ ( CountableDimensionsN a b,
763763 CountableN (a, b),
764− FLN (a, b) a,
764+ FromListsN (a, b) a,
765765 TrivialP a b
766766 )
767767 => Relation (a, b) a
768−fstR = R (I.fstM @Boolean @(I.Normalize a) @(I.Normalize b))
768+p1 = R (I.kp1 @Boolean @(I.Normalize a) @(I.Normalize b))
769769
770770-- | Relational pairing second component projection
771771--
772772-- @
773−-- 'sndR' `.` 'splitR' r s ``sse`` s
773+-- 'p2' ``comp`` 'splitR' r s ``sse`` s
774774-- @
775−sndR ::
775+p2 ::
776776 forall a b .
777− ( CountableDimsN a b,
777+ ( CountableDimensionsN a b,
778778 CountableN (a, b),
779− FLN (a, b) b,
779+ FromListsN (a, b) b,
780780 TrivialP a b
781781 )
782782 => Relation (a, b) b
783−sndR = R (I.sndM @Boolean @(I.Normalize a) @(I.Normalize b))
783+p2 = R (I.kp2 @Boolean @(I.Normalize a) @(I.Normalize b))
784784
785785-- Relational pairing functor
786786
@@ -788,17 +788,17 @@ infixl 4 ><
788788-- | Relational pairing functor
789789--
790790-- @
791−-- r '><' s == 'splitR' (r `.` fstR) (s `.` sndR)
792−-- (r '><' s) `.` (p '><' q) == (r `.` p) '><' (s `.` q)
791+-- r '><' s == 'splitR' (r ``comp`` p1) (s ``comp`` p2)
792+-- (r '><' s) ``comp`` (p '><' q) == (r ``comp`` p) '><' (s ``comp`` q)
793793-- @
794794(><) ::
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,
795+ ( CountableDimensionsN a b,
796+ CountableDimensionsN c d,
797+ CountableDimensionsN (a, c) (b, d),
798+ FromListsN (a, c) a,
799+ FromListsN (a, c) c,
800+ FromListsN (b, d) b,
801+ FromListsN (b, d) d,
802802 TrivialP a c,
803803 TrivialP b d
804804 )
@@ -810,31 +810,33 @@ infixl 4 ><
810810-- | Relational coproduct.
811811--
812812-- @
813−-- | 'eitherR' a b `.` 'i1' == a
813+-- | 'eitherR' a b ``comp`` 'i1' == a
814814-- 'eitherR' a b <=> |
815−-- | 'eitherR' a b `.` 'i2' == b
815+-- | 'eitherR' a b ``comp`` 'i2' == b
816816-- @
817817--
818818-- @
819−-- 'eitherR' r s `.` 'conv' ('eitherR' t u) == (r `.` 'conv' t) ``union`` (s `.` 'conv' u)
819+-- 'eitherR' r s ``comp`` 'conv' ('eitherR' t u) == (r ``comp`` 'conv' t) ``union`` (s ``comp`` 'conv' u)
820820-- @
821821--
822822-- @
823823-- 'eitherR' ('splitR' r s) ('splitR' t v) == 'splitR' ('eitherR' r t) ('eitherR' s v)
824824-- @
825−eitherR :: Relation a c -> Relation b c -> Relation (Either a b) c
826−eitherR = join
825+eitherR :: (TrivialE a b)
826+ => Relation a c -> Relation b c -> Relation (Either a b) c
827+eitherR = junc
827828
828829-- | Relational coproduct first component injection
829830--
830831-- @
831−-- 'img' 'i1' ``union`` 'img' 'i2' == 'id'
832−-- 'i1' `.` 'i2' = 'zeros'
832+-- 'img' 'i1' ``union`` 'img' 'i2' == 'identity'
833+-- 'i1' ``comp`` 'i2' = 'zeros'
833834-- @
834835i1 ::
835− ( CountableDimsN a b,
836− FLN b a,
837− FLN a a
836+ ( CountableDimensionsN a b,
837+ FromListsN b a,
838+ FromListsN a a,
839+ TrivialE a b
838840 )
839841 => Relation a (Either a b)
840842i1 = R I.i1
@@ -842,13 +844,14 @@ i1 = R I.i1
842844-- | Relational coproduct second component injection
843845--
844846-- @
845−-- 'img' 'i1' ``union`` 'img' 'i2' == 'id'
846−-- 'i1' `.` 'i2' = 'zeros'
847+-- 'img' 'i1' ``union`` 'img' 'i2' == 'identity'
848+-- 'i1' ``comp`` 'i2' = 'zeros'
847849-- @
848850i2 ::
849− ( CountableDimsN a b,
850− FLN a b,
851− FLN b b
851+ ( CountableDimensionsN a b,
852+ FromListsN a b,
853+ FromListsN b b,
854+ TrivialE a b
852855 )
853856 => Relation b (Either a b)
854857i2 = R I.i2
@@ -858,14 +861,16 @@ infixl 5 -|-
858861-- | Relational coproduct functor.
859862--
860863-- @
861−-- r '-|-' s == 'eitherR' ('i1' `.` r) ('i2' `.` s)
864+-- r '-|-' s == 'eitherR' ('i1' ``comp`` r) ('i2' ``comp`` s)
862865-- @
863866(-|-) ::
864− ( CountableDimsN b d,
865− FLN b b,
866− FLN d b,
867− FLN b d,
868− FLN d d
867+ ( CountableDimensionsN b d,
868+ FromListsN b b,
869+ FromListsN d b,
870+ FromListsN b d,
871+ FromListsN d d,
872+ TrivialE a c,
873+ TrivialE b d
869874 )
870875 => Relation a b -> Relation c d -> Relation (Either a c) (Either b d)
871876(-|-) (R a) (R b) = R ((I.-|-) a b)
@@ -878,20 +883,20 @@ infixl 5 -|-
878883-- 'trans'/'untrans';
879884-- more-over, where each particular attribute is placed (input/output) is irrelevant.
880885trans ::
881− ( CountableDimsN a b,
886+ ( CountableDimensionsN a b,
882887 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+ CountableDimensionsN (a, b) (c, b),
889+ FromListsN (c, b) c,
890+ FromListsN (c, b) b,
891+ FromListsN (a, b) a,
892+ FromListsN (a, b) b,
888893 Trivial (a, b),
889894 Trivial (c, b),
890− TrivialP a b,
891− TrivialP c b
895+ TrivialP2 a b,
896+ TrivialP2 c b
892897 )
893898 => Relation (a, b) c -> Relation a (c, b)
894−trans r = splitR r sndR . conv fstR
899+trans r = splitR r p2 `comp` conv p1
895900
896901-- | Relational 'untrans'
897902--
@@ -899,110 +904,109 @@ trans r = splitR r sndR . conv fstR
899904-- 'trans'/'untrans';
900905-- more-over, where each particular attribute is placed (input/output) is irrelevant.
901906untrans ::
902− ( CountableDimsN a b,
907+ ( CountableDimensionsN a b,
903908 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+ CountableDimensionsN (a, b) (c, b),
910+ FromListsN (c, b) c,
911+ FromListsN (c, b) b,
912+ FromListsN (a, b) b,
913+ FromListsN (a, b) a,
909914 Trivial (a, b),
910915 Trivial (c, b),
911− TrivialP a b,
912− TrivialP c b
916+ TrivialP2 a b,
917+ TrivialP2 c b
913918 )
914919 => Relation a (c, b) -> Relation (a, b) c
915−untrans s = fstR . conv (splitR (conv s) sndR)
920+untrans s = p1 `comp` conv (splitR (conv s) p2)
916921
917922-- | Transforms predicate @p@ into a correflexive relation.
918923--
919924-- @
920−-- 'predR' ('const' True) == 'id'
925+-- 'predR' ('const' True) == 'identity'
921926-- 'predR' ('const' False) == 'zeros'
922927-- @
923928--
924929-- @
925−-- 'predR' q `.` 'predR' p == 'predR' q ``union`` 'predR' p
930+-- 'predR' q ``comp`` 'predR' p == 'predR' q ``union`` 'predR' p
926931-- @
927932predR ::
928933 ( Bounded a,
929934 Enum a,
930− Countable a,
931935 CountableN a,
932− FLN a a,
933− FLN Bool a
936+ FromListsN a a,
937+ FromListsN Bool a
934938 )
935939 => Relation a Bool -> Relation a a
936−predR p = id `intersection` divisionF (fromF (const True)) p
940+predR p = identity `intersection` divisionF (fromF' (const True)) p
937941
938942-- | Equalizes functions @f@ and @g@.
939943-- That is, @'equalizer' f g@ is the largest coreflexive
940944-- that restricts @g@ so that @f@ and @g@ yield the same outputs.
941945--
942946-- @
943−-- 'equalizer' r r == 'id'
947+-- 'equalizer' r r == 'identity'
944948-- 'equalizer' ('point' True) ('point' False) == 'zeros'
945949-- @
946950equalizer ::
947951 ( CountableN a,
948− FLN a a
952+ FromListsN a a
949953 )
950954 => Relation a b -> Relation a b -> Relation a a
951−equalizer f g = id `intersection` divisionF f g
955+equalizer f g = identity `intersection` divisionF f g
952956
953957-- | Relational conditional guard.
954958--
955959-- @
956−-- 'guard' p = 'i2' ``overriddenBy`` 'i1' `.` 'predR' p
960+-- 'guard' p = 'i2' ``overriddenBy`` 'i1' ``comp`` 'predR' p
957961-- @
958−guard ::
962+guard ::
959963 ( Bounded b,
960964 Enum b,
961965 CountableN b,
962− Countable b,
963− FLN b b,
964− FLN Bool b
966+ FromListsN b b,
967+ FromListsN Bool b,
968+ TrivialE b b
965969 ) => Relation b Bool -> Relation b (Either b b)
966970guard p = conv (eitherR (predR p) (predR (negate p)))
967971
968972-- | Relational McCarthy's conditional.
969−cond ::
973+cond ::
970974 ( Bounded b,
971975 Enum b,
972− Countable b,
973976 CountableN b,
974− FLN b b,
975− FLN Bool b
976− )
977+ FromListsN b b,
978+ FromListsN Bool b,
979+ TrivialE b b
980+ )
977981 => Relation b Bool -> Relation b c -> Relation b c -> Relation b c
978−cond p r s = eitherR r s . guard p
982+cond p r s = eitherR r s `comp` guard p
979983
980984-- | Relational domain.
981985--
982986-- For injective relations, 'domain' and 'ker'nel coincide,
983−-- since @'ker' r ``sse`` 'id'@ in such situations.
987+-- since @'ker' r ``sse`` 'identity'@ in such situations.
984988domain ::
985989 ( CountableN a,
986− FLN a a
990+ FromListsN a a
987991 ) => Relation a b -> Relation a a
988−domain r = ker r `intersection` id
992+domain r = ker r `intersection` identity
989993
990994-- | Relational range.
991995--
992996-- For functions, 'range' and 'img' (image) coincide,
993−-- since @'img' f ``sse`` id@ for any @f@.
997+-- since @'img' f ``sse`` 'identity'@ for any @f@.
994998range ::
995999 ( CountableN b,
996− FLN b b
1000+ FromListsN b b
9971001 ) => Relation a b -> Relation b b
998−range r = img r `intersection` id
1002+range r = img r `intersection` identity
9991003
10001004-- Relation pretty print
10011005
10021006-- | Relation pretty printing
1003−pretty :: (CountableDimsN a b) => Relation a b -> String
1007+pretty :: (CountableN a) => Relation a b -> String
10041008pretty (R a) = I.pretty a
10051009
10061010-- | Relation pretty printing
1007−prettyPrint :: (CountableDimsN a b) => Relation a b -> IO ()
1011+prettyPrint :: (CountableN a) => Relation a b -> IO ()
10081012prettyPrint (R a) = I.prettyPrint a
src/LAoP/Utils.hs+2−5
@@ -95,11 +95,8 @@ module LAoP.Utils
9595 coerceNat2,
9696 coerceNat3,
9797
98− -- * List data type
99− List (..),
100−
101− -- * Category type-class
102− Category(..)
98+ -- * Powerset data type
99+ List (..)
103100 )
104101where
105102
src/LAoP/Utils/Internal.hs+75−33
@@ -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,
@@ -18,11 +87,8 @@ module LAoP.Utils.Internal
1887 coerceNat2,
1988 coerceNat3,
2089
21− -- * 'List' data type
22− List (..),
23−
24− -- * Category type class
25− Category(..)
90+ -- * Powerset data type
91+ List (..)
2692 )
2793where
2894
@@ -32,16 +98,12 @@ import Data.List
3298import Data.Maybe
3399import GHC.TypeLits
34100import Control.DeepSeq
35−import GHC.Generics
36−import Data.Kind
37−import Prelude hiding (id, (.))
38−import qualified Prelude
39101
40102-- | Wrapper around 'Int's that have a restrictive semantic associated.
41103-- A value of type @'Natural' n m@ can only be instanciated with some 'Int'
42104-- @i@ that's @n <= i <= m@.
43105newtype Natural (start :: Nat) (end :: Nat) = Nat Int
44− deriving (Show, Read, Eq, Ord, NFData, Generic)
106+ deriving (Show, Read, Eq, Ord, NFData)
45107
46108-- | Throws a runtime error if any of the operations overflows or
47109-- underflows.
@@ -174,23 +236,3 @@ instance
174236 fromEnum (L x) =
175237 let as = [minBound .. maxBound]
176238 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"