Skip to content

Commit ef9e3d6

Browse files
Refactor Algebra.Solver.*Monoid (#2407)
* refactor `Solver` infrastructure * refactor `Solver` infrastructure * tighten imports and some `with` * tidy up `Solver.Monoid` * refactor `Algebra.Solver.*Monoid` * regularise vocabulary: deprecations * `variable`s for `Algebra.Solver.Ring` * tweaks * forgot to add `Expression` module * refactor: use existing lemma * fixed deprecations to `v2.2` * v2.2 `CHANGELOG` * use `zipWith`! * remove dependency on `Data.Nat.GeneralisedArithmetic.fold` * simplify `import` dependencies * refactor: tweaks * change `Level` parameterisation of `NormalAPI` * clarify exports from `module R`? * deprecations * knock-on effects * deprecations * fixed exports of `Normal` form instantiations * fixed exports of `Solver` * fixed deprecations in `CHANGELOG` * note on import strategy in `CHANGELOG` * name of `Solver` module --------- Co-authored-by: MatthewDaggitt <[email protected]>
1 parent 4972983 commit ef9e3d6

File tree

13 files changed

+705
-523
lines changed

13 files changed

+705
-523
lines changed

CHANGELOG.md

+41
Original file line numberDiff line numberDiff line change
@@ -30,6 +30,28 @@ Deprecated names
3030
∣-factors-≈ ↦ xy≈z⇒x|z∧y|z
3131
```
3232

33+
* In `Algebra.Solver.CommutativeMonoid`:
34+
```agda
35+
normalise-correct ↦ Algebra.Solver.CommutativeMonoid.Normal.correct
36+
sg ↦ Algebra.Solver.CommutativeMonoid.Normal.singleton
37+
sg-correct ↦ Algebra.Solver.CommutativeMonoid.Normal.singleton-correct
38+
```
39+
40+
* In `Algebra.Solver.IdempotentCommutativeMonoid`:
41+
```agda
42+
flip12 ↦ Algebra.Properties.CommutativeSemigroup.xy∙z≈y∙xz
43+
distr ↦ Algebra.Properties.IdempotentCommutativeMonoid.∙-distrˡ-∙
44+
normalise-correct ↦ Algebra.Solver.IdempotentCommutativeMonoid.Normal.correct
45+
sg ↦ Algebra.Solver.IdempotentCommutativeMonoid.Normal.singleton
46+
sg-correct ↦ Algebra.Solver.IdempotentCommutativeMonoid.Normal.singleton-correct
47+
```
48+
49+
* In `Algebra.Solver.Monoid`:
50+
```agda
51+
homomorphic ↦ Algebra.Solver.Monoid.Normal.comp-correct
52+
normalise-correct ↦ Algebra.Solver.Monoid.Normal.correct
53+
```
54+
3355
* In `Data.Vec.Properties`:
3456
```agda
3557
++-assoc _ ↦ ++-assoc-eqFree
@@ -51,9 +73,28 @@ New modules
5173
Algebra.Properties.IdempotentCommutativeMonoid
5274
```
5375

76+
* Refactoring of the `Algebra.Solver.*Monoid` implementations, via
77+
a single `Solver` module API based on the existing `Expr`, and
78+
a common `Normal`-form API:
79+
```agda
80+
Algebra.Solver.CommutativeMonoid.Normal
81+
Algebra.Solver.IdempotentCommutativeMonoid.Normal
82+
Algebra.Solver.Monoid.Expression
83+
Algebra.Solver.Monoid.Normal
84+
Algebra.Solver.Monoid.Solver
85+
```
86+
87+
NB Imports of the existing proof procedures `solve` and `prove` etc. should still be via the top-level interfaces in `Algebra.Solver.*Monoid`.
88+
5489
Additions to existing modules
5590
-----------------------------
5691

92+
* In `Algebra.Solver.Ring`
93+
```agda
94+
Env : ℕ → Set _
95+
Env = Vec Carrier
96+
```
97+
5798
* In `Data.List.Properties`:
5899
```agda
59100
product≢0 : All NonZero ns → NonZero (product ns)

src/Algebra/Solver/CommutativeMonoid.agda

+18-174
Original file line numberDiff line numberDiff line change
@@ -8,196 +8,40 @@
88

99
{-# OPTIONS --cubical-compatible --safe #-}
1010

11-
open import Algebra
11+
open import Algebra.Bundles using (CommutativeMonoid)
1212

13-
module Algebra.Solver.CommutativeMonoid {m₁ m₂} (M : CommutativeMonoid m₁ m₂) where
13+
module Algebra.Solver.CommutativeMonoid {c ℓ} (M : CommutativeMonoid c ℓ) where
1414

15-
open import Data.Fin.Base using (Fin; zero; suc)
16-
open import Data.Maybe.Base as Maybe
17-
using (Maybe; From-just; from-just)
18-
open import Data.Nat as ℕ using (ℕ; zero; suc; _+_)
19-
open import Data.Nat.GeneralisedArithmetic using (fold)
20-
open import Data.Product.Base using (_×_; uncurry)
21-
open import Data.Vec.Base using (Vec; []; _∷_; lookup; replicate)
15+
import Algebra.Solver.CommutativeMonoid.Normal as Normal
16+
import Algebra.Solver.Monoid.Solver as Solver
2217

23-
open import Function.Base using (_∘_)
24-
25-
import Relation.Binary.Reasoning.Setoid as ≈-Reasoning
26-
import Relation.Binary.Reflection as Reflection
27-
import Relation.Nullary.Decidable as Dec
28-
import Data.Vec.Relation.Binary.Pointwise.Inductive as Pointwise
29-
30-
open import Relation.Binary.Consequences using (dec⇒weaklyDec)
31-
open import Relation.Binary.PropositionalEquality.Core as ≡ using (_≡_)
32-
open import Relation.Nullary.Decidable as Dec using (Dec)
33-
34-
open CommutativeMonoid M
35-
open ≈-Reasoning setoid
18+
open CommutativeMonoid M using (monoid)
3619

3720
private
38-
variable
39-
n :
40-
41-
------------------------------------------------------------------------
42-
-- Monoid expressions
43-
44-
-- There is one constructor for every operation, plus one for
45-
-- variables; there may be at most n variables.
46-
47-
infixr 5 _⊕_
48-
infixr 10 _•_
49-
50-
data Expr (n : ℕ) : Set where
51-
var : Fin n Expr n
52-
id : Expr n
53-
_⊕_ : Expr n Expr n Expr n
54-
55-
-- An environment contains one value for every variable.
56-
57-
Env : Set _
58-
Env n = Vec Carrier n
59-
60-
-- The semantics of an expression is a function from an environment to
61-
-- a value.
21+
module N = Normal M
6222

63-
⟦_⟧ : Expr n Env n Carrier
64-
⟦ var x ⟧ ρ = lookup ρ x
65-
⟦ id ⟧ ρ = ε
66-
⟦ e₁ ⊕ e₂ ⟧ ρ = ⟦ e₁ ⟧ ρ ∙ ⟦ e₂ ⟧ ρ
6723

6824
------------------------------------------------------------------------
6925
-- Normal forms
7026

71-
-- A normal form is a vector of multiplicities (a bag).
72-
73-
Normal : Set
74-
Normal n = Vec ℕ n
75-
76-
-- The semantics of a normal form.
77-
78-
⟦_⟧⇓ : Normal n Env n Carrier
79-
⟦ [] ⟧⇓ _ = ε
80-
⟦ n ∷ v ⟧⇓ (a ∷ ρ) = fold (⟦ v ⟧⇓ ρ) (a ∙_) n
27+
open N public
28+
renaming (correct to normalise-correct)
8129

8230
------------------------------------------------------------------------
83-
-- Constructions on normal forms
84-
85-
-- The empty bag.
86-
87-
empty : Normal n
88-
empty = replicate _ 0
89-
90-
-- A singleton bag.
31+
-- Proof procedures
9132

92-
sg : (i : Fin n) Normal n
93-
sg zero = 1 ∷ empty
94-
sg (suc i) = 0 ∷ sg i
33+
open Solver monoid (record { N }) public
9534

96-
-- The composition of normal forms.
97-
98-
_•_ : (v w : Normal n) Normal n
99-
[] • [] = []
100-
(l ∷ v) • (m ∷ w) = l + m ∷ v • w
10135

10236
------------------------------------------------------------------------
103-
-- Correctness of the constructions on normal forms
104-
105-
-- The empty bag stands for the unit ε.
106-
107-
empty-correct :: Env n) ⟦ empty ⟧⇓ ρ ≈ ε
108-
empty-correct [] = refl
109-
empty-correct (a ∷ ρ) = empty-correct ρ
110-
111-
-- The singleton bag stands for a single variable.
112-
113-
sg-correct : (x : Fin n) (ρ : Env n) ⟦ sg x ⟧⇓ ρ ≈ lookup ρ x
114-
sg-correct zero (x ∷ ρ) = begin
115-
x ∙ ⟦ empty ⟧⇓ ρ ≈⟨ ∙-congˡ (empty-correct ρ) ⟩
116-
x ∙ ε ≈⟨ identityʳ _ ⟩
117-
x ∎
118-
sg-correct (suc x) (m ∷ ρ) = sg-correct x ρ
119-
120-
-- Normal form composition corresponds to the composition of the monoid.
121-
122-
comp-correct : (v w : Normal n) (ρ : Env n)
123-
⟦ v • w ⟧⇓ ρ ≈ (⟦ v ⟧⇓ ρ ∙ ⟦ w ⟧⇓ ρ)
124-
comp-correct [] [] ρ = sym (identityˡ _)
125-
comp-correct (l ∷ v) (m ∷ w) (a ∷ ρ) = lemma l m (comp-correct v w ρ)
126-
where
127-
flip12 : a b c a ∙ (b ∙ c) ≈ b ∙ (a ∙ c)
128-
flip12 a b c = begin
129-
a ∙ (b ∙ c) ≈⟨ sym (assoc _ _ _) ⟩
130-
(a ∙ b) ∙ c ≈⟨ ∙-congʳ (comm _ _) ⟩
131-
(b ∙ a) ∙ c ≈⟨ assoc _ _ _ ⟩
132-
b ∙ (a ∙ c) ∎
133-
lemma : l m {d b c} (p : d ≈ b ∙ c)
134-
fold d (a ∙_) (l + m) ≈ fold b (a ∙_) l ∙ fold c (a ∙_) m
135-
lemma zero zero p = p
136-
lemma zero (suc m) p = trans (∙-congˡ (lemma zero m p)) (flip12 _ _ _)
137-
lemma (suc l) m p = trans (∙-congˡ (lemma l m p)) (sym (assoc a _ _))
138-
37+
-- DEPRECATED NAMES
13938
------------------------------------------------------------------------
140-
-- Normalization
141-
142-
-- A normaliser.
143-
144-
normalise : Expr n Normal n
145-
normalise (var x) = sg x
146-
normalise id = empty
147-
normalise (e₁ ⊕ e₂) = normalise e₁ • normalise e₂
148-
149-
-- The normaliser preserves the semantics of the expression.
150-
151-
normalise-correct : (e : Expr n) (ρ : Env n)
152-
⟦ normalise e ⟧⇓ ρ ≈ ⟦ e ⟧ ρ
153-
normalise-correct (var x) ρ = sg-correct x ρ
154-
normalise-correct id ρ = empty-correct ρ
155-
normalise-correct (e₁ ⊕ e₂) ρ = begin
156-
157-
⟦ normalise e₁ • normalise e₂ ⟧⇓ ρ
158-
159-
≈⟨ comp-correct (normalise e₁) (normalise e₂) ρ ⟩
160-
161-
⟦ normalise e₁ ⟧⇓ ρ ∙ ⟦ normalise e₂ ⟧⇓ ρ
162-
163-
≈⟨ ∙-cong (normalise-correct e₁ ρ) (normalise-correct e₂ ρ) ⟩
164-
165-
⟦ e₁ ⟧ ρ ∙ ⟦ e₂ ⟧ ρ
166-
167-
168-
------------------------------------------------------------------------
169-
-- "Tactic.
170-
171-
open module R = Reflection
172-
setoid var ⟦_⟧ (⟦_⟧⇓ ∘ normalise) normalise-correct
173-
public using (solve; _⊜_)
174-
175-
-- We can decide if two normal forms are /syntactically/ equal.
176-
177-
infix 5 _≟_
178-
179-
_≟_ : (nf₁ nf₂ : Normal n) Dec (nf₁ ≡ nf₂)
180-
nf₁ ≟ nf₂ = Dec.map Pointwise-≡↔≡ (decidable ℕ._≟_ nf₁ nf₂)
181-
where open Pointwise
182-
183-
-- We can also give a sound, but not necessarily complete, procedure
184-
-- for determining if two expressions have the same semantics.
185-
186-
prove′ : (e₁ e₂ : Expr n) Maybe ( ρ ⟦ e₁ ⟧ ρ ≈ ⟦ e₂ ⟧ ρ)
187-
prove′ e₁ e₂ =
188-
Maybe.map lemma (dec⇒weaklyDec _≟_ (normalise e₁) (normalise e₂))
189-
where
190-
lemma : normalise e₁ ≡ normalise e₂ ρ ⟦ e₁ ⟧ ρ ≈ ⟦ e₂ ⟧ ρ
191-
lemma eq ρ =
192-
R.prove ρ e₁ e₂ (begin
193-
⟦ normalise e₁ ⟧⇓ ρ ≡⟨ ≡.cong (λ e ⟦ e ⟧⇓ ρ) eq ⟩
194-
⟦ normalise e₂ ⟧⇓ ρ ∎)
195-
196-
-- This procedure can be combined with from-just.
39+
-- Please use the new names as continuing support for the old names is
40+
-- not guaranteed.
19741

198-
prove : n (e₁ e₂ : Expr n) From-just (prove′ e₁ e₂)
199-
prove _ e₁ e₂ = from-just (prove′ e₁ e₂)
42+
-- Version 2.2
20043

201-
-- prove : ∀ n (es : Expr n × Expr n) →
202-
-- From-just (uncurry prove′ es)
203-
-- prove _ = from-just ∘ uncurry prove′
44+
{-# WARNING_ON_USAGE normalise-correct
45+
"Warning: normalise-correct was deprecated in v2.2.
46+
Please use Algebra.Solver.CommutativeMonoid.Normal.correct instead."
47+
#-}

0 commit comments

Comments
 (0)