Copyright (c) 2018 Simon Hudon All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Tactics based on the strongly connected components (SCC) of a graph where
the vertices are propositions and the edges are implications found
They are used for finding the sets of equivalent propositions in a set
import category.basic data.sum
# Strongly Connected Components
This file defines tactics to construct proofs of equivalences between a set of mutually equivalent
propositions. The tactics use implications transitively to find sets of equivalent propositions.
The tactics use a strongly connected components algorithm on a graph where propositions are
vertices and edges are proofs that the source implies the target. The strongly connected components
are therefore sets of propositions that are pairwise equivalent to each other.
The resulting strongly connected components are encoded in a disjoint set data structure to
facilitate the construction of equivalence proofs between two arbitrary members of an equivalence
## Possible generalizations
Instead of reasoning about implications and equivalence, we could generalize the machinery to
reason about arbitrary partial orders.
* Tarjan, R. E. (1972), "Depth-first search and linear graph algorithms",
SIAM Journal on Computing, 1 (2): 146–160, doi:10.1137/0201010
* Dijkstra, Edsger (1976), A Discipline of Programming, NJ: Prentice Hall, Ch. 25.
graphs, tactic, strongly connected components, disjoint sets
`closure` implements a disjoint set data structure using path compression
optimization. For the sake of the scc algorithm, it also stores the preorder
numbering of the equivalence graph of the local assumptions.
The `expr_map` encodes a directed forest by storing for every non-root
node, a reference to its parent and a proof of equivalence between
that node's expression and its parent's expression. Given that data
structure, checking that two nodes belong to the same tree is easy and
fast by repeatedly following the parent references until a root is reached.
If both nodes have the same root, they belong to the same tree, i.e. their
expressions are equivalent. The proof of equivalence can be formed by
composing the proofs along the edges of the paths to the root.
More concretely, if we ignore preorder numbering, the set
`{ {e₀,e₁,e₂,e₃}, {e₄,e₅} }` is represented as:e₀ → ⊥ -- no parent, i.e. e₀ is a root
e₁ → e₀, p₁ -- with p₁ : e₁ ↔ e₀
e₂ → e₁, p₂ -- with p₂ : e₂ ↔ e₁
e₃ → e₀, p₃ -- with p₃ : e₃ ↔ e₀
e₄ → ⊥ -- no parent, i.e. e₄ is a root
e₅ → e₄, p₅ -- with p₅ : e₅ ↔ e₄
We can check that `e₂` and `e₃` are equivalent by seeking the root of
the tree of each. The parent of `e₂` is `e₁`, the parent of `e₁` is
`e₀` and `e₀` does not have a parent, and thus, this is the root of its tree.
The parent of `e₃` is `e₀` and it's also the root, the same as for `e₂` and
they are therefore equivalent. We can build a proof of that equivalence by using
transitivity on `p₂`, `p₁` and `p₃.symm` in that order.
Similarly, we can discover that `e₂` and `e₅` aren't equivalent.
A description of the path compression optimization can be found at:
meta def closure := ref (expr_map (ℕ ⊕ (expr × expr)))
/-- `with_new_closure f` creates an empty `closure` `c`, executes `f` on `c`, and then deletes `c`,
returning the output of `f`. -/
meta def with_new_closure {α} : (closure → tactic α) → tactic α :=using_new_ref (expr_map.mk _)
/-- `to_tactic_format cl` pretty-prints the `closure` `cl` as a list. Assuming `cl` was built by
`dfs_at`, each element corresponds to a node `pᵢ : expr` and is one of the folllowing:
- if `pᵢ` is a root: `"pᵢ ⇐ i"`, where `i` is the preorder number of `pᵢ`,
- otherwise: `"(pᵢ, pⱼ) : P"`, where `P` is `pᵢ ↔ pⱼ`.
meta def to_tactic_format (cl : closure) : tactic format :=
fmt ← l.mmap $ λ ⟨x,y⟩, match y with
| sum.inl y := pformat!"{x} ⇐ {y}" | sum.inr ⟨y,p⟩ := pformat!"({x}, {y}) : {infer_type p}"meta instance : has_to_tactic_format closure := ⟨ to_tactic_format ⟩
/-- `(n,r,p) ← root cl e` returns `r` the root of the tree that `e` is a part of (which might be
itself) along with `p` a proof of `e ↔ r` and `n`, the preorder numbering of the root. -/
meta def root (cl : closure) : expr → tactic (ℕ × expr × expr) | e :=
do p ← mk_app ``iff.refl [e],
do p ← mk_app ``iff.refl [e],
| (some (sum.inr (e₀,p₀))) :=
p ← mk_app ``iff.trans [p₀,p₁],
modify_ref cl $ λ m, m.insert e (sum.inr (e₁,p)),
/-- (Implementation of `merge`.) -/
meta def merge_intl (cl : closure) (p e₀ p₀ e₁ p₁ : expr) : tactic unit :=
do p₂ ← mk_app ``iff.symm [p₀],
p ← mk_app ``iff.trans [p₂,p],
p ← mk_app ``iff.trans [p,p₁],
modify_ref cl $ λ m, m.insert e₀ $ sum.inr (e₁,p)
/-- `merge cl p`, with `p` a proof of `e₀ ↔ e₁` for some `e₀` and `e₁`,
merges the trees of `e₀` and `e₁` and keeps the root with the smallest preorder
number as the root. This ensures that, in the depth-first traversal of the graph,
when encountering an edge going into a vertex whose equivalence class includes
a vertex that originated the current search, that vertex will be the root of
the corresponding tree. -/
meta def merge (cl : closure) (p : expr) : tactic unit :=
do `(%%e₀ ↔ %%e₁) ← infer_type p >>= instantiate_mvars,
if n₂ < n₃ then do p ← mk_app ``iff.symm [p],
cl.merge_intl p e₃ p₃ e₂ p₂
else cl.merge_intl p e₂ p₂ e₃ p₃
/-- Sequentially assign numbers to the nodes of the graph as they are being visited. -/
meta def assign_preorder (cl : closure) (e : expr) : tactic unit :=
modify_ref cl $ λ m, m.insert e (sum.inl m.size)
/-- `prove_eqv cl e₀ e₁` constructs a proof of equivalence of `e₀` and `e₁` if
meta def prove_eqv (cl : closure) (e₀ e₁ : expr) : tactic expr :=
do (_,r,p₀) ← root cl e₀,
guard (r = r') <|> fail!"{e₀} and {e₁} are not equivalent", p₁ ← mk_app ``iff.symm [p₁],
mk_app ``iff.trans [p₀,p₁]
/-- `prove_impl cl e₀ e₁` constructs a proof of `e₀ -> e₁` if they are equivalent. -/
meta def prove_impl (cl : closure) (e₀ e₁ : expr) : tactic expr :=
cl.prove_eqv e₀ e₁ >>= iff_mp
/-- `is_eqv cl e₀ e₁` checks whether `e₀` and `e₁` are equivalent without building a proof. -/
meta def is_eqv (cl : closure) (e₀ e₁ : expr) : tactic bool :=
do (_,r,p₀) ← root cl e₀,
/-- mutable graphs between local propositions that imply each other with the proof of implication -/
meta def impl_graph := ref (expr_map (list $ expr × expr))
/-- `with_impl_graph f` creates an empty `impl_graph` `g`, executes `f` on `g`, and then deletes
`g`, returning the output of `f`. -/
meta def with_impl_graph {α} : (impl_graph → tactic α) → tactic α :=using_new_ref (expr_map.mk (list $ expr × expr))
/-- `add_edge g p`, with `p` a proof of `v₀ → v₁` or `v₀ ↔ v₁`, adds an edge to the implication
meta def add_edge (g : impl_graph) : expr → tactic unit | p :=
let xs := (m.find v₀).get_or_else [],
let xs' := (m.find v₁).get_or_else [],
modify_ref g $ λ m, (m.insert v₀ ((v₁,p) :: xs)).insert v₁ xs'
do p₀ ← mk_mapp ``iff.mp [none,none,p],
p₁ ← mk_mapp ``iff.mpr [none,none,p],
parameter g : expr_map (list $ expr × expr)
parameter visit : ref $ expr_map bool
/-- `merge_path path e`, where `path` and `e` forms a cycle with proofs of implication between
consecutive vertices. The proofs are compiled into proofs of equivalences and added to the closure
structure. `e` and the first vertex of `path` do not have to be the same but they have to be
in the same equivalence class. -/
meta def merge_path (path : list (expr × expr)) (e : expr) : tactic unit :=
do p₁ ← cl.prove_impl e path.head.fst,
let path := (e,p₁) :: path,
(_,ls) ← path.mmap_accuml (λ p p',
prod.mk <$> mk_mapp ``implies.trans [none,p'.1,none,p,p'.2] <*> pure p) p₂,
(_,rs) ← path.mmap_accumr (λ p p',
prod.mk <$> mk_mapp ``implies.trans [none,none,none,p.2,p'] <*> pure p') p₂,
ps ← mzip_with (λ p₀ p₁, mk_app ``iff.intro [p₀,p₁]) ls.tail rs.init,
/-- (implementation of `collapse`) -/
meta def collapse' : list (expr × expr) → list (expr × expr) → expr → tactic unit
| acc [] v := merge_path acc v
| acc ((x,pr) :: xs) v :=
/-- `collapse path v`, where `v` is a vertex that originated the current search
(or a vertex in the same equivalence class as the one that originated the current search).
It or its equivalent should be found in `path`. Since the vertices following `v` in the path
form a cycle with `v`, they can all be added to an equivalence class. -/
meta def collapse : list (expr × expr) → expr → tactic unit :=
Strongly connected component algorithm inspired by Tarjan's and
Dijkstra's scc algorithm. Whereas they return strongly connected
components by enumerating them, this algorithm returns a disjoint set
data structure using path compression. This is a compact
representation that allows us, after the fact, to construct a proof of
equivalence between any two members of an equivalence class.
* Tarjan, R. E. (1972), "Depth-first search and linear graph algorithms",
SIAM Journal on Computing, 1 (2): 146–160, doi:10.1137/0201010
* Dijkstra, Edsger (1976), A Discipline of Programming, NJ: Prentice Hall, Ch. 25.
list (expr × expr) → expr → tactic unit
modify_ref visit $ λ m, m.insert v ff,
ns.mmap' $ λ ⟨w,e⟩, dfs_at ((v,e) :: vs) w,
modify_ref visit $ λ m, m.insert v tt,
/-- Use the local assumptions to create a set of equivalence classes. -/
meta def mk_scc (cl : closure) : tactic (expr_map (list (expr × expr))) :=
using_new_ref (expr_map.mk bool) $ λ visit,
ls.mmap' $ λ l, try (g.add_edge l),
m.to_list.mmap $ λ ⟨v,_⟩, impl_graph.dfs_at m visit cl [] v,
meta def prove_eqv_target (cl : closure) : tactic unit :=
do `(%%p ↔ %%q) ← target >>= whnf,
cl.prove_eqv p q >>= exact
/-- Use the available equivalences and implications to prove
a goal of the form `p ↔ q`. -/
meta def interactive.scc : tactic unit :=
closure.with_new_closure $ λ cl,
cl.prove_eqv p q >>= exact
/-- Collect all the available equivalences and implications and
add assumptions for every equivalence that can be proven using the
strongly connected components technique. Mostly useful for testing. -/
meta def interactive.scc' : tactic unit :=
closure.with_new_closure $ λ cl,
do m ← impl_graph.mk_scc cl,
let ls := m.to_list.map prod.fst,
let ls' := prod.mk <$> ls <*> ls,
do { h ← get_unused_name `h, try $ closure.prove_eqv cl x.1 x.2 >>= note h none }
