ryan.freumh.org
The Package Calculus
init
author
Ryan Gibb
date
(Jun 3, 2026, 6:36 AM +0100)
commit
bfe40caa
bfe40caa1c453a6de0e9061584c88250ae8a4ed4
+11758
+1
.gitignore
+1
.gitignore
···
1
+
.lake
+83
PackageCalculus.lean
+83
PackageCalculus.lean
···
1
+
import PackageCalculus.Core.Definition
2
+
import PackageCalculus.Versions.Formula
3
+
import PackageCalculus.Versions.Reduction.Definition
4
+
import PackageCalculus.Versions.Reduction.Correctness
5
+
import PackageCalculus.Versions.Lifting.Definition
6
+
import PackageCalculus.Versions.Lifting.Retraction
7
+
import PackageCalculus.Versions.Lifting.Soundness
8
+
import PackageCalculus.Versions.Lifting.Completeness
9
+
10
+
import PackageCalculus.Extensions.Conflict.Definition
11
+
import PackageCalculus.Extensions.Conflict.Reduction.Definition
12
+
import PackageCalculus.Extensions.Conflict.Reduction.Soundness
13
+
import PackageCalculus.Extensions.Conflict.Reduction.Completeness
14
+
import PackageCalculus.Extensions.Conflict.Lifting.Definition
15
+
import PackageCalculus.Extensions.Conflict.Lifting.Retraction
16
+
import PackageCalculus.Extensions.Conflict.Lifting.Soundness
17
+
import PackageCalculus.Extensions.Conflict.Lifting.Completeness
18
+
19
+
import PackageCalculus.Extensions.Concurrent.Definition
20
+
import PackageCalculus.Extensions.Concurrent.Reduction.Definition
21
+
import PackageCalculus.Extensions.Concurrent.Reduction.Soundness
22
+
import PackageCalculus.Extensions.Concurrent.Reduction.Completeness
23
+
import PackageCalculus.Extensions.Concurrent.Lifting.Definition
24
+
import PackageCalculus.Extensions.Concurrent.Lifting.Retraction
25
+
import PackageCalculus.Extensions.Concurrent.Lifting.Soundness
26
+
import PackageCalculus.Extensions.Concurrent.Lifting.Completeness
27
+
28
+
import PackageCalculus.Extensions.PeerDependency.Definition
29
+
import PackageCalculus.Extensions.PeerDependency.Reduction.Definition
30
+
import PackageCalculus.Extensions.PeerDependency.Reduction.Soundness
31
+
import PackageCalculus.Extensions.PeerDependency.Reduction.Completeness
32
+
import PackageCalculus.Extensions.PeerDependency.Lifting.Definition
33
+
import PackageCalculus.Extensions.PeerDependency.Lifting.Retraction
34
+
import PackageCalculus.Extensions.PeerDependency.Lifting.Soundness
35
+
import PackageCalculus.Extensions.PeerDependency.Lifting.Completeness
36
+
37
+
import PackageCalculus.Extensions.Feature.Definition
38
+
import PackageCalculus.Extensions.Feature.Reduction.Definition
39
+
import PackageCalculus.Extensions.Feature.Reduction.Soundness
40
+
import PackageCalculus.Extensions.Feature.Reduction.Completeness
41
+
import PackageCalculus.Extensions.Feature.Lifting.Definition
42
+
import PackageCalculus.Extensions.Feature.Lifting.Retraction
43
+
import PackageCalculus.Extensions.Feature.Lifting.Soundness
44
+
import PackageCalculus.Extensions.Feature.Lifting.Completeness
45
+
46
+
import PackageCalculus.Extensions.PackageFormula.Definition
47
+
import PackageCalculus.Extensions.PackageFormula.Reduction.Definition
48
+
import PackageCalculus.Extensions.PackageFormula.Reduction.Soundness
49
+
import PackageCalculus.Extensions.PackageFormula.Reduction.Completeness
50
+
import PackageCalculus.Extensions.PackageFormula.Lifting.Definition
51
+
import PackageCalculus.Extensions.PackageFormula.Lifting.Retraction
52
+
import PackageCalculus.Extensions.PackageFormula.Lifting.Soundness
53
+
import PackageCalculus.Extensions.PackageFormula.Lifting.Completeness
54
+
55
+
import PackageCalculus.Extensions.VariableFormula.Definition
56
+
import PackageCalculus.Extensions.VariableFormula.Reduction.Definition
57
+
import PackageCalculus.Extensions.VariableFormula.Reduction.Soundness
58
+
import PackageCalculus.Extensions.VariableFormula.Reduction.Completeness
59
+
import PackageCalculus.Extensions.VariableFormula.Lifting.Definition
60
+
import PackageCalculus.Extensions.VariableFormula.Lifting.Retraction
61
+
import PackageCalculus.Extensions.VariableFormula.Lifting.Soundness
62
+
import PackageCalculus.Extensions.VariableFormula.Lifting.Completeness
63
+
64
+
import PackageCalculus.Extensions.Virtual.Definition
65
+
import PackageCalculus.Extensions.Virtual.Reduction.Definition
66
+
import PackageCalculus.Extensions.Virtual.Reduction.Soundness
67
+
import PackageCalculus.Extensions.Virtual.Reduction.Completeness
68
+
import PackageCalculus.Extensions.Virtual.Lifting.Definition
69
+
import PackageCalculus.Extensions.Virtual.Lifting.Retraction
70
+
import PackageCalculus.Extensions.Virtual.Lifting.Soundness
71
+
import PackageCalculus.Extensions.Virtual.Lifting.Completeness
72
+
73
+
import PackageCalculus.Extensions.Singular
74
+
75
+
import PackageCalculus.Composition.FeatureConcurrent.Types
76
+
import PackageCalculus.Composition.FeatureConcurrent.Definition
77
+
import PackageCalculus.Composition.FeatureConcurrent.Reduction.Definition
78
+
import PackageCalculus.Composition.FeatureConcurrent.Reduction.Soundness
79
+
import PackageCalculus.Composition.FeatureConcurrent.Reduction.Completeness
80
+
81
+
import PackageCalculus.Complexity.ThreeSAT
82
+
import PackageCalculus.Complexity.NPHardness
83
+
import PackageCalculus.Complexity.SATEncoding
+286
PackageCalculus/Complexity/NPHardness.lean
+286
PackageCalculus/Complexity/NPHardness.lean
···
1
+
import PackageCalculus.Core.Definition
2
+
import PackageCalculus.Complexity.ThreeSAT
3
+
import Mathlib.Data.Finset.Image
4
+
import Mathlib.Data.Finset.Union
5
+
6
+
/-! # NP-hardness of dependency resolution
7
+
8
+
Polynomial-time reduction from 3SAT to the resolution problem: each 3SAT
9
+
instance is encoded as `(R, Δ, root)` such that a satisfying assignment
10
+
corresponds to a resolution. -/
11
+
12
+
namespace PackageCalculus.Complexity
13
+
14
+
open Classical
15
+
16
+
variable {Var : Type*} [DecidableEq Var] {Cls : Type*} [DecidableEq Cls]
17
+
18
+
/-! ## Extended types for the reduction -/
19
+
20
+
/-- Package names for the 3-SAT reduction: root, variable, or clause. -/
21
+
inductive SATRedName (Var Cls : Type*) where
22
+
| root : SATRedName Var Cls
23
+
| var : Var → SATRedName Var Cls
24
+
| clause : Cls → SATRedName Var Cls
25
+
deriving DecidableEq
26
+
27
+
/-- Package versions for the 3-SAT reduction: unit, boolean, or literal. -/
28
+
inductive SATRedVersion (Var : Type*) where
29
+
| unit : SATRedVersion Var
30
+
| bool : Bool → SATRedVersion Var
31
+
| lit : Literal Var → SATRedVersion Var
32
+
deriving DecidableEq
33
+
34
+
/-! ## Reduction construction -/
35
+
36
+
def satRedReal (φ : Cls → ThreeClause Var) (clauses : Finset Cls) :
37
+
Real (SATRedName Var Cls) (SATRedVersion Var) :=
38
+
{(SATRedName.root, SATRedVersion.unit)} ∪
39
+
Finset.biUnion clauses (fun j =>
40
+
Finset.biUnion ({(φ j).l₁, (φ j).l₂, (φ j).l₃} : Finset (Literal Var)) (fun l =>
41
+
{(SATRedName.var l.var, SATRedVersion.bool true),
42
+
(SATRedName.var l.var, SATRedVersion.bool false)})) ∪
43
+
Finset.biUnion clauses (fun j =>
44
+
{(SATRedName.clause j, SATRedVersion.lit (φ j).l₁),
45
+
(SATRedName.clause j, SATRedVersion.lit (φ j).l₂),
46
+
(SATRedName.clause j, SATRedVersion.lit (φ j).l₃)})
47
+
48
+
def satRedDeps (φ : Cls → ThreeClause Var) (clauses : Finset Cls) :
49
+
DepRel (SATRedName Var Cls) (SATRedVersion Var) :=
50
+
Finset.image (fun j =>
51
+
((SATRedName.root, SATRedVersion.unit), SATRedName.clause j,
52
+
({SATRedVersion.lit (φ j).l₁, SATRedVersion.lit (φ j).l₂,
53
+
SATRedVersion.lit (φ j).l₃} : Finset _))) clauses ∪
54
+
Finset.biUnion clauses (fun j =>
55
+
Finset.image (fun l =>
56
+
((SATRedName.clause j, SATRedVersion.lit l), SATRedName.var l.var,
57
+
({SATRedVersion.bool l.pos} : Finset _)))
58
+
({(φ j).l₁, (φ j).l₂, (φ j).l₃} : Finset (Literal Var)))
59
+
60
+
/-! ## Soundness helpers -/
61
+
62
+
/-- Select the first satisfied literal in a clause under assignment σ. -/
63
+
def selectLiteral (σ : Var → Bool) (c : ThreeClause Var) : Literal Var :=
64
+
if c.l₁.eval σ = true then c.l₁
65
+
else if c.l₂.eval σ = true then c.l₂
66
+
else c.l₃
67
+
68
+
omit [DecidableEq Cls] in
69
+
private theorem selectLiteral_mem (σ : Var → Bool) (c : ThreeClause Var) :
70
+
selectLiteral σ c ∈ ({c.l₁, c.l₂, c.l₃} : Finset (Literal Var)) := by
71
+
unfold selectLiteral
72
+
simp only [Finset.mem_insert, Finset.mem_singleton]
73
+
split_ifs
74
+
· left; rfl
75
+
· right; left; rfl
76
+
· right; right; rfl
77
+
78
+
omit [DecidableEq Var] [DecidableEq Cls] in
79
+
private theorem selectLiteral_eval {σ : Var → Bool} {c : ThreeClause Var}
80
+
(hsat : c.satisfiedBy σ) : (selectLiteral σ c).eval σ = true := by
81
+
unfold selectLiteral
82
+
split_ifs with h1 h2
83
+
· exact h1
84
+
· exact h2
85
+
· exact (hsat.elim (absurd · h1) (·.elim (absurd · h2) id))
86
+
87
+
def soundnessWitness (σ : Var → Bool) (φ : Cls → ThreeClause Var)
88
+
(clauses : Finset Cls) : Finset (Package (SATRedName Var Cls) (SATRedVersion Var)) :=
89
+
{(SATRedName.root, SATRedVersion.unit)} ∪
90
+
Finset.biUnion clauses (fun j =>
91
+
Finset.image (fun l =>
92
+
(SATRedName.var l.var, SATRedVersion.bool (σ l.var)))
93
+
({(φ j).l₁, (φ j).l₂, (φ j).l₃} : Finset (Literal Var))) ∪
94
+
Finset.image (fun j =>
95
+
(SATRedName.clause j, SATRedVersion.lit (selectLiteral σ (φ j)))) clauses
96
+
97
+
/-! ## Soundness -/
98
+
99
+
-- Paper Appendix A (3SAT reduction, soundness).
100
+
theorem satRed_soundness
101
+
(φ : Cls → ThreeClause Var) (clauses : Finset Cls) (σ : Var → Bool)
102
+
(hsat : ∀ j ∈ clauses, (φ j).satisfiedBy σ) :
103
+
IsResolution (satRedReal φ clauses) (satRedDeps φ clauses)
104
+
(SATRedName.root, SATRedVersion.unit) (soundnessWitness σ φ clauses) := by
105
+
constructor
106
+
· -- subset
107
+
intro p hp
108
+
simp only [soundnessWitness, Finset.mem_union, Finset.mem_singleton, Finset.mem_biUnion,
109
+
Finset.mem_image, Finset.mem_insert] at hp
110
+
rcases hp with ((hp | ⟨j, hj, l, hl, hp⟩) | ⟨j, hj, hp⟩)
111
+
· -- root: p = (root, unit)
112
+
rw [hp]
113
+
exact Finset.mem_union_left _
114
+
(Finset.mem_union_left _ (Finset.mem_singleton.mpr rfl))
115
+
· -- var: (var l.var, bool (σ l.var)) = p
116
+
rw [← hp]
117
+
apply Finset.mem_union_left
118
+
apply Finset.mem_union_right
119
+
rw [Finset.mem_biUnion]
120
+
exact ⟨j, hj, Finset.mem_biUnion.mpr ⟨l, by
121
+
simp only [Finset.mem_insert, Finset.mem_singleton]; exact hl,
122
+
by cases (σ l.var) <;> simp⟩⟩
123
+
· -- clause: (clause j, lit (selectLiteral ...)) = p
124
+
rw [← hp]
125
+
apply Finset.mem_union_right
126
+
rw [Finset.mem_biUnion]
127
+
refine ⟨j, hj, ?_⟩
128
+
have hmem := selectLiteral_mem σ (φ j)
129
+
simp only [Finset.mem_insert, Finset.mem_singleton] at hmem ⊢
130
+
rcases hmem with h | h | h <;> simp [h]
131
+
· -- root_mem
132
+
show (SATRedName.root, SATRedVersion.unit) ∈ soundnessWitness σ φ clauses
133
+
unfold soundnessWitness
134
+
exact Finset.mem_union_left _ (Finset.mem_union_left _ (Finset.mem_singleton.mpr rfl))
135
+
· -- dep_closure
136
+
intro p hp m vs hd
137
+
simp only [satRedDeps, Finset.mem_union, Finset.mem_image, Finset.mem_biUnion,
138
+
Finset.mem_insert, Finset.mem_singleton] at hd
139
+
rcases hd with ⟨j, hj, heq⟩ | ⟨j, hj, l, hl, heq⟩
140
+
· -- root → clause dependency
141
+
simp only [Prod.mk.injEq] at heq
142
+
obtain ⟨⟨rfl, rfl⟩, rfl, rfl⟩ := heq
143
+
refine ⟨SATRedVersion.lit (selectLiteral σ (φ j)), ?_, ?_⟩
144
+
· have hmem := selectLiteral_mem σ (φ j)
145
+
simp only [Finset.mem_insert, Finset.mem_singleton]
146
+
simp only [Finset.mem_insert, Finset.mem_singleton] at hmem
147
+
rcases hmem with h | h | h
148
+
· exact Or.inl (congrArg SATRedVersion.lit h)
149
+
· exact Or.inr (Or.inl (congrArg SATRedVersion.lit h))
150
+
· exact Or.inr (Or.inr (congrArg SATRedVersion.lit h))
151
+
· simp only [soundnessWitness, Finset.mem_union, Finset.mem_image, Finset.mem_singleton]
152
+
right; exact ⟨j, hj, rfl⟩
153
+
· -- clause → variable dependency
154
+
-- heq : ((clause j, lit l), var l.var, {bool l.pos}) = (p, m, vs)
155
+
-- after Prod.mk.injEq, obtain substitutes p, m, vs
156
+
simp only [Prod.mk.injEq] at heq
157
+
obtain ⟨⟨rfl, rfl⟩, rfl, rfl⟩ := heq
158
+
refine ⟨SATRedVersion.bool l.pos, Finset.mem_singleton.mpr rfl, ?_⟩
159
+
-- hp says (clause j, lit l) ∈ soundnessWitness
160
+
simp only [soundnessWitness, Finset.mem_union, Finset.mem_singleton, Finset.mem_biUnion,
161
+
Finset.mem_image, Finset.mem_insert] at hp
162
+
-- From mem_image, the clause case gives: ∃ j' ∈ clauses, (clause j', lit (sel σ (φ j'))) = (clause j, lit l)
163
+
rcases hp with ((h | ⟨_, _, _, _, h⟩) | ⟨j', hj', h⟩)
164
+
· exact nomatch congrArg (·.1) h
165
+
· exact nomatch congrArg (·.1) h
166
+
· -- h : (clause j', lit (selectLiteral σ (φ j'))) = (clause j, lit l)
167
+
have hj_eq : j' = j := SATRedName.clause.inj (congrArg (·.1) h)
168
+
have hl_eq : selectLiteral σ (φ j') = l := SATRedVersion.lit.inj (congrArg (·.2) h)
169
+
-- l.eval σ = true since l = selectLiteral σ (φ j') and clause j' is satisfied
170
+
have heval_l : l.eval σ = true := by
171
+
rw [← hl_eq]; exact selectLiteral_eval (hsat j' hj')
172
+
rw [Literal.eval_true_iff] at heval_l
173
+
-- Need to show (var l.var, bool l.pos) ∈ soundnessWitness
174
+
simp only [soundnessWitness, Finset.mem_union, Finset.mem_singleton, Finset.mem_biUnion,
175
+
Finset.mem_image, Finset.mem_insert]
176
+
left; right
177
+
-- Use j' (= j) and l, which is the selectLiteral, hence in the literal finset
178
+
have hl_mem : l ∈ ({(φ j').l₁, (φ j').l₂, (φ j').l₃} : Finset (Literal Var)) := by
179
+
rw [← hl_eq]; exact selectLiteral_mem σ (φ j')
180
+
simp only [Finset.mem_insert, Finset.mem_singleton] at hl_mem
181
+
exact ⟨j', hj', l, hl_mem, by rw [heval_l]⟩
182
+
· -- version_unique
183
+
intro n v v' hv hv'
184
+
simp only [soundnessWitness, Finset.mem_union, Finset.mem_singleton, Finset.mem_biUnion,
185
+
Finset.mem_image, Finset.mem_insert] at hv hv'
186
+
-- hv patterns:
187
+
-- root: (n, v) = (root, unit) [from mem_singleton]
188
+
-- var: ∃ j hj l hl, (var l.var, bool (σ l.var)) = (n, v) [from mem_image]
189
+
-- clause: ∃ j hj, (clause j, lit ...) = (n, v) [from mem_image]
190
+
rcases hv with ((hv | ⟨_, _, _, _, hv⟩) | ⟨_, _, hv⟩)
191
+
· -- (n,v) = (root, unit)
192
+
rcases hv' with ((hv' | ⟨_, _, _, _, hv'⟩) | ⟨_, _, hv'⟩)
193
+
· exact (congrArg (·.2) hv).trans (congrArg (·.2) hv').symm
194
+
· -- root = var: hv gives n = root, hv' gives var _ = n
195
+
exact nomatch (congrArg (·.1) hv').trans (congrArg (·.1) hv)
196
+
· -- root = clause: hv gives n = root, hv' gives clause _ = n
197
+
exact nomatch (congrArg (·.1) hv').trans (congrArg (·.1) hv)
198
+
· -- (var l.var, bool (σ l.var)) = (n, v)
199
+
rcases hv' with ((hv' | ⟨_, _, _, _, hv'⟩) | ⟨_, _, hv'⟩)
200
+
· -- var = root: hv gives var _ = n, hv' gives n = root
201
+
exact nomatch (congrArg (·.1) hv).trans (congrArg (·.1) hv')
202
+
· -- var = var: both have (var _, bool _) = (n, _)
203
+
have hv2 := congrArg (·.2) hv -- bool (σ w₁.var) = v
204
+
have hv2' := congrArg (·.2) hv' -- bool (σ w₂.var) = v'
205
+
have heq := SATRedName.var.inj ((congrArg (·.1) hv).trans (congrArg (·.1) hv').symm)
206
+
simp only [heq] at hv2
207
+
exact hv2.symm.trans hv2'
208
+
· -- var = clause
209
+
exact nomatch (congrArg (·.1) hv).trans (congrArg (·.1) hv').symm
210
+
· -- (clause j, lit ...) = (n, v)
211
+
rcases hv' with ((hv' | ⟨_, _, _, _, hv'⟩) | ⟨_, _, hv'⟩)
212
+
· -- clause = root
213
+
exact nomatch (congrArg (·.1) hv).trans (congrArg (·.1) hv')
214
+
· -- clause = var
215
+
exact nomatch (congrArg (·.1) hv).trans (congrArg (·.1) hv').symm
216
+
· -- clause = clause
217
+
have := SATRedName.clause.inj ((congrArg (·.1) hv).trans (congrArg (·.1) hv').symm)
218
+
subst this; exact (congrArg (·.2) hv).symm.trans (congrArg (·.2) hv')
219
+
220
+
/-! ## Completeness: resolution → satisfying assignment -/
221
+
222
+
noncomputable def extractAssignment
223
+
(S : Finset (Package (SATRedName Var Cls) (SATRedVersion Var))) (x : Var) : Bool :=
224
+
if h : ∃ b : Bool, (SATRedName.var x, SATRedVersion.bool b) ∈ S then h.choose else false
225
+
226
+
private theorem extractAssignment_spec
227
+
{S : Finset (Package (SATRedName Var Cls) (SATRedVersion Var))}
228
+
{x : Var} {b : Bool}
229
+
(hmem : (SATRedName.var x, SATRedVersion.bool b) ∈ S)
230
+
(huniq : ∀ (n : SATRedName Var Cls) (v v' : SATRedVersion Var),
231
+
(n, v) ∈ S → (n, v') ∈ S → v = v') :
232
+
extractAssignment S x = b := by
233
+
unfold extractAssignment
234
+
have hex : ∃ b : Bool, (SATRedName.var x, SATRedVersion.bool b) ∈ S := ⟨b, hmem⟩
235
+
rw [dif_pos hex]
236
+
exact SATRedVersion.bool.inj (huniq _ _ _ hex.choose_spec hmem)
237
+
238
+
-- Paper Appendix A (3SAT reduction, completeness).
239
+
theorem satRed_completeness
240
+
(φ : Cls → ThreeClause Var) (clauses : Finset Cls)
241
+
(S : Finset (Package (SATRedName Var Cls) (SATRedVersion Var)))
242
+
(hres : IsResolution (satRedReal φ clauses) (satRedDeps φ clauses)
243
+
(SATRedName.root, SATRedVersion.unit) S) :
244
+
∀ j ∈ clauses, (φ j).satisfiedBy (extractAssignment S) := by
245
+
intro j hj
246
+
have hdep_root : ((SATRedName.root, SATRedVersion.unit), SATRedName.clause j,
247
+
{SATRedVersion.lit (φ j).l₁, SATRedVersion.lit (φ j).l₂,
248
+
SATRedVersion.lit (φ j).l₃}) ∈ satRedDeps φ clauses := by
249
+
simp only [satRedDeps, Finset.mem_union, Finset.mem_image]
250
+
left; exact ⟨j, hj, rfl⟩
251
+
obtain ⟨cv, hcv_mem, hcv_S⟩ := hres.dep_closure _ hres.root_mem _ _ hdep_root
252
+
unfold ThreeClause.satisfiedBy
253
+
simp only [Finset.mem_insert, Finset.mem_singleton] at hcv_mem
254
+
rcases hcv_mem with heq | heq | heq
255
+
· left
256
+
have hdep_cl : ((SATRedName.clause j, SATRedVersion.lit (φ j).l₁),
257
+
SATRedName.var (φ j).l₁.var,
258
+
({SATRedVersion.bool (φ j).l₁.pos} : Finset _)) ∈ satRedDeps φ clauses := by
259
+
simp only [satRedDeps, Finset.mem_union, Finset.mem_biUnion, Finset.mem_image,
260
+
Finset.mem_insert, Finset.mem_singleton]
261
+
right; exact ⟨j, hj, (φ j).l₁, Or.inl rfl, rfl⟩
262
+
obtain ⟨vv, hvv_mem, hvv_S⟩ := hres.dep_closure _ (heq ▸ hcv_S) _ _ hdep_cl
263
+
rw [Literal.eval_true_iff]
264
+
exact extractAssignment_spec ((Finset.mem_singleton.mp hvv_mem) ▸ hvv_S) hres.version_unique
265
+
· right; left
266
+
have hdep_cl : ((SATRedName.clause j, SATRedVersion.lit (φ j).l₂),
267
+
SATRedName.var (φ j).l₂.var,
268
+
({SATRedVersion.bool (φ j).l₂.pos} : Finset _)) ∈ satRedDeps φ clauses := by
269
+
simp only [satRedDeps, Finset.mem_union, Finset.mem_biUnion, Finset.mem_image,
270
+
Finset.mem_insert, Finset.mem_singleton]
271
+
right; exact ⟨j, hj, (φ j).l₂, Or.inr (Or.inl rfl), rfl⟩
272
+
obtain ⟨vv, hvv_mem, hvv_S⟩ := hres.dep_closure _ (heq ▸ hcv_S) _ _ hdep_cl
273
+
rw [Literal.eval_true_iff]
274
+
exact extractAssignment_spec ((Finset.mem_singleton.mp hvv_mem) ▸ hvv_S) hres.version_unique
275
+
· right; right
276
+
have hdep_cl : ((SATRedName.clause j, SATRedVersion.lit (φ j).l₃),
277
+
SATRedName.var (φ j).l₃.var,
278
+
({SATRedVersion.bool (φ j).l₃.pos} : Finset _)) ∈ satRedDeps φ clauses := by
279
+
simp only [satRedDeps, Finset.mem_union, Finset.mem_biUnion, Finset.mem_image,
280
+
Finset.mem_insert, Finset.mem_singleton]
281
+
right; exact ⟨j, hj, (φ j).l₃, Or.inr (Or.inr rfl), rfl⟩
282
+
obtain ⟨vv, hvv_mem, hvv_S⟩ := hres.dep_closure _ (heq ▸ hcv_S) _ _ hdep_cl
283
+
rw [Literal.eval_true_iff]
284
+
exact extractAssignment_spec ((Finset.mem_singleton.mp hvv_mem) ▸ hvv_S) hres.version_unique
285
+
286
+
end PackageCalculus.Complexity
+58
PackageCalculus/Complexity/SATEncoding.lean
+58
PackageCalculus/Complexity/SATEncoding.lean
···
1
+
import PackageCalculus.Core.Definition
2
+
3
+
/-! # SAT encoding of resolutions
4
+
5
+
A propositional predicate `σ` on packages satisfies a resolution problem
6
+
`(R, Δ, r)` iff it picks the root, is closed under dependencies, and selects
7
+
at most one version per name. Soundness and completeness of the encoding link
8
+
this predicate to `IsResolution`. -/
9
+
10
+
namespace PackageCalculus.Complexity
11
+
12
+
variable {N : Type*} [DecidableEq N] {V : Type*} [DecidableEq V]
13
+
14
+
/-- σ satisfies the SAT encoding of (R, Δ, r): root selected, dependency closure, at-most-one. -/
15
+
def satisfiesEncoding (R : Real N V) (Δ : DepRel N V)
16
+
(r : Package N V) (σ : Package N V → Prop) : Prop :=
17
+
σ r ∧
18
+
(∀ p n vs, (p, n, vs) ∈ Δ → σ p → ∃ v ∈ vs, σ (n, v)) ∧
19
+
(∀ n v v', (n, v) ∈ R → (n, v') ∈ R → v ≠ v' → ¬(σ (n, v) ∧ σ (n, v')))
20
+
21
+
omit [DecidableEq N] in
22
+
-- Paper Thm B.2 (SAT encoding soundness).
23
+
theorem satEncoding_soundness
24
+
(R : Real N V) (Δ : DepRel N V) (r : Package N V)
25
+
(σ : Package N V → Prop) [DecidablePred σ]
26
+
(hr : r ∈ R)
27
+
(hwf : ∀ p n vs, (p, n, vs) ∈ Δ → ∀ v ∈ vs, (n, v) ∈ R)
28
+
(hsat : satisfiesEncoding R Δ r σ) :
29
+
IsResolution R Δ r (R.filter (fun p => σ p)) := by
30
+
obtain ⟨hroot, hdep, huniq⟩ := hsat
31
+
exact {
32
+
subset := fun _ hp => (Finset.mem_filter.mp hp).1
33
+
root_mem := Finset.mem_filter.mpr ⟨hr, hroot⟩
34
+
dep_closure := fun p hp m vs hd => by
35
+
rw [Finset.mem_filter] at hp
36
+
obtain ⟨_, hpσ⟩ := hp
37
+
obtain ⟨v, hv, hvσ⟩ := hdep p m vs hd hpσ
38
+
exact ⟨v, hv, Finset.mem_filter.mpr ⟨hwf p m vs hd v hv, hvσ⟩⟩
39
+
version_unique := fun n v v' hv hv' => by
40
+
rw [Finset.mem_filter] at hv hv'
41
+
obtain ⟨hvR, hvσ⟩ := hv
42
+
obtain ⟨hv'R, hv'σ⟩ := hv'
43
+
by_contra h
44
+
exact huniq n v v' hvR hv'R h ⟨hvσ, hv'σ⟩
45
+
}
46
+
47
+
omit [DecidableEq N] [DecidableEq V] in
48
+
-- Paper Thm B.3 (SAT encoding completeness).
49
+
theorem satEncoding_completeness
50
+
(R : Real N V) (Δ : DepRel N V) (r : Package N V)
51
+
(S : Finset (Package N V))
52
+
(hres : IsResolution R Δ r S) :
53
+
satisfiesEncoding R Δ r (· ∈ S) := by
54
+
refine ⟨hres.root_mem, fun p m vs hd hp => hres.dep_closure p hp m vs hd, ?_⟩
55
+
intro n v v' _ _ hne ⟨hv, hv'⟩
56
+
exact hne (hres.version_unique n v v' hv hv')
57
+
58
+
end PackageCalculus.Complexity
+35
PackageCalculus/Complexity/ThreeSAT.lean
+35
PackageCalculus/Complexity/ThreeSAT.lean
···
1
+
import Mathlib.Data.Set.Basic
2
+
3
+
/-! # 3SAT primitives
4
+
5
+
Literals, three-literal clauses, and satisfaction by a Boolean assignment.
6
+
Used as the source instance for the NP-hardness reduction. -/
7
+
8
+
namespace PackageCalculus.Complexity
9
+
10
+
variable {Var : Type*}
11
+
12
+
/-- A propositional literal: a variable with polarity. -/
13
+
structure Literal (Var : Type*) where
14
+
var : Var
15
+
/-- True for positive, false for negated. -/
16
+
pos : Bool
17
+
deriving DecidableEq
18
+
19
+
structure ThreeClause (Var : Type*) where
20
+
l₁ : Literal Var
21
+
l₂ : Literal Var
22
+
l₃ : Literal Var
23
+
24
+
def Literal.eval (σ : Var → Bool) (l : Literal Var) : Bool :=
25
+
if l.pos then σ l.var else !σ l.var
26
+
27
+
theorem Literal.eval_true_iff {σ : Var → Bool} {l : Literal Var} :
28
+
l.eval σ = true ↔ σ l.var = l.pos := by
29
+
unfold Literal.eval
30
+
cases l.pos <;> simp
31
+
32
+
def ThreeClause.satisfiedBy (σ : Var → Bool) (c : ThreeClause Var) : Prop :=
33
+
c.l₁.eval σ = true ∨ c.l₂.eval σ = true ∨ c.l₃.eval σ = true
34
+
35
+
end PackageCalculus.Complexity
+50
PackageCalculus/Composition/FeatureConcurrent/Definition.lean
+50
PackageCalculus/Composition/FeatureConcurrent/Definition.lean
···
1
+
import PackageCalculus.Composition.FeatureConcurrent.Types
2
+
import PackageCalculus.Extensions.Feature.Definition
3
+
import PackageCalculus.Extensions.Concurrent.Definition
4
+
5
+
/-! # Feature-concurrent composition: definitions
6
+
7
+
`IsConcurrentFeatureResolution` combines the per-package feature support with
8
+
concurrent version handling: a single shared intermediate per `(parent, name)`
9
+
plus per-feature secondary intermediates, all linked via π. -/
10
+
11
+
namespace PackageCalculus.Composition
12
+
13
+
open Classical
14
+
15
+
variable {N : Type*} [DecidableEq N] {V : Type*} [DecidableEq V]
16
+
{F : Type*} [DecidableEq F] {G : Type*} [DecidableEq G]
17
+
variable {N_FC : Type*} [DecidableEq N_FC] {V_FC : Type*} [DecidableEq V_FC]
18
+
variable [hcnm : Concurrent.HasConcurrentNames (Feature.FeatureName N F) V G N_FC]
19
+
variable [hcvr : Concurrent.HasConcurrentVersions V G V_FC]
20
+
variable [hcfi : HasConcurrentFeatureIntermediate N V F G N_FC]
21
+
22
+
set_option linter.unusedSectionVars false
23
+
24
+
/-! ### Target resolution predicate -/
25
+
26
+
structure IsConcurrentFeatureResolution
27
+
(R : Real N V)
28
+
(support : Feature.Support N V F)
29
+
(Δ_f : Feature.FeatDepRel N V F) (Δ_a : Feature.AddlDepRel N V F)
30
+
(g : V → G) (r : Package N V)
31
+
(S : Finset (Package N V × Finset F))
32
+
(π : Finset (Package N V × Package N V)) : Prop where
33
+
no_root_support : ∀ f, (r, f) ∉ support
34
+
subset : ∀ p fs, (p, fs) ∈ S → p ∈ R
35
+
root_mem : (r, ∅) ∈ S
36
+
feature_unification : ∀ n v fs fs',
37
+
((n, v), fs) ∈ S → ((n, v), fs') ∈ S → fs = fs'
38
+
parent_closure : ∀ p fs_p, (p, fs_p) ∈ S →
39
+
∀ n vs fs, (p, n, vs, fs) ∈ Δ_f →
40
+
∃! v, v ∈ vs ∧ (∃ fs', fs ⊆ fs' ∧ ((n, v), fs') ∈ S) ∧ ((n, v), p) ∈ π
41
+
parent_closure_addl : ∀ p fs_p, (p, fs_p) ∈ S →
42
+
∀ f ∈ fs_p, ∀ n vs fs, ((p, f), n, vs, fs) ∈ Δ_a →
43
+
∃! v, v ∈ vs ∧ (∃ fs', fs ⊆ fs' ∧ ((n, v), fs') ∈ S) ∧ ((n, v), p) ∈ π
44
+
π_functional : ∀ n v v' p,
45
+
((n, v), p) ∈ π → ((n, v'), p) ∈ π → v = v'
46
+
version_granularity : ∀ n v v' fs fs',
47
+
((n, v), fs) ∈ S → ((n, v'), fs') ∈ S → v ≠ v' → g v ≠ g v'
48
+
support_mem : ∀ n v fs f, ((n, v), fs) ∈ S → f ∈ fs → ((n, v), f) ∈ support
49
+
50
+
end PackageCalculus.Composition
+744
PackageCalculus/Composition/FeatureConcurrent/Reduction/Completeness.lean
+744
PackageCalculus/Composition/FeatureConcurrent/Reduction/Completeness.lean
···
1
+
import PackageCalculus.Composition.FeatureConcurrent.Types
2
+
import PackageCalculus.Composition.FeatureConcurrent.Definition
3
+
import PackageCalculus.Composition.FeatureConcurrent.Reduction.Definition
4
+
import PackageCalculus.Extensions.Feature.Definition
5
+
import PackageCalculus.Extensions.Feature.Reduction.Definition
6
+
import PackageCalculus.Extensions.Feature.Reduction.Completeness
7
+
import PackageCalculus.Extensions.Concurrent.Definition
8
+
import PackageCalculus.Extensions.Concurrent.Reduction.Definition
9
+
import PackageCalculus.Extensions.Concurrent.Reduction.Completeness
10
+
import Mathlib
11
+
12
+
/-! # Feature-concurrent composition: completeness
13
+
14
+
Any `IsConcurrentFeatureResolution` lifts to a core resolution of the
15
+
feature-concurrent encoding, including the back-edges that align secondary
16
+
intermediates with the shared one. -/
17
+
18
+
namespace PackageCalculus.Composition
19
+
20
+
open Classical
21
+
22
+
variable {N : Type*} [DecidableEq N] {V : Type*} [DecidableEq V]
23
+
{F : Type*} [DecidableEq F] {G : Type*} [DecidableEq G]
24
+
variable {N_FC : Type*} [DecidableEq N_FC] {V_FC : Type*} [DecidableEq V_FC]
25
+
variable [hcnm : Concurrent.HasConcurrentNames (Feature.FeatureName N F) V G N_FC]
26
+
variable [hcvr : Concurrent.HasConcurrentVersions V G V_FC]
27
+
variable [hcfi : HasConcurrentFeatureIntermediate N V F G N_FC]
28
+
29
+
set_option linter.unusedSectionVars false
30
+
31
+
/-- Completeness witness: builds the FC-level `S` from `(S_CF, π, Δ_f, Δ_a)`.
32
+
33
+
* Each `((n, v), fs) ∈ S_CF` contributes its base orig granular package and its feature
34
+
granular packages.
35
+
* Each dep entry in `Δ_f` or `Δ_a` with `v ∈ vs`, `((n, v), _) ∈ S_CF`, and
36
+
`((n, v), (p_n, p_v)) ∈ π` contributes the shared intermediate
37
+
`(cfIntermediate p_n p_v n, origV v)`. -/
38
+
noncomputable def cfCompletenessWitness
39
+
(S_CF : Finset (Package N V × Finset F))
40
+
(π : Finset (Package N V × Package N V))
41
+
(Δ_f : Feature.FeatDepRel N V F) (Δ_a : Feature.AddlDepRel N V F)
42
+
(g : V → G) : Finset (Package N_FC V_FC) :=
43
+
-- Part 1: base orig granular packages.
44
+
S_CF.image (fun ⟨⟨n, v⟩, _⟩ =>
45
+
(hcnm.granularN (Feature.FeatureName.orig n) (g v), hcvr.origV v)) ∪
46
+
-- Part 2: feature granular packages.
47
+
S_CF.biUnion (fun ⟨⟨n, v⟩, fs⟩ =>
48
+
fs.image (fun f =>
49
+
(hcnm.granularN (Feature.FeatureName.featured n f) (g v), hcvr.origV v))) ∪
50
+
-- Part 3: shared intermediates from Δ_f.
51
+
Δ_f.biUnion (fun ⟨⟨p_n, p_v⟩, n, vs, fs⟩ =>
52
+
(vs.filter (fun v =>
53
+
(∃ fs_p, ((p_n, p_v), fs_p) ∈ S_CF) ∧
54
+
(∃ fs', fs ⊆ fs' ∧ ((n, v), fs') ∈ S_CF) ∧
55
+
((n, v), (p_n, p_v)) ∈ π)).image
56
+
(fun v => (hcfi.cfIntermediateN p_n p_v n, hcvr.origV v))) ∪
57
+
-- Part 3b: shared intermediates from Δ_a.
58
+
Δ_a.biUnion (fun ⟨⟨⟨p_n, p_v⟩, _⟩, n, vs, fs⟩ =>
59
+
(vs.filter (fun v =>
60
+
(∃ fs_p, ((p_n, p_v), fs_p) ∈ S_CF) ∧
61
+
(∃ fs', fs ⊆ fs' ∧ ((n, v), fs') ∈ S_CF) ∧
62
+
((n, v), (p_n, p_v)) ∈ π)).image
63
+
(fun v => (hcfi.cfIntermediateN p_n p_v n, hcvr.origV v))) ∪
64
+
-- Part 4: per-feature Δ_f secondaries.
65
+
Δ_f.biUnion (fun ⟨⟨p_n, p_v⟩, n, vs, fs⟩ =>
66
+
fs.biUnion (fun f =>
67
+
(vs.filter (fun v =>
68
+
(∃ fs_p, ((p_n, p_v), fs_p) ∈ S_CF) ∧
69
+
(∃ fs', fs ⊆ fs' ∧ ((n, v), fs') ∈ S_CF) ∧
70
+
((n, v), (p_n, p_v)) ∈ π)).image
71
+
(fun v => (hcfi.cfIntermediateN_f p_n p_v n f, hcvr.origV v)))) ∪
72
+
-- Part 5: per-feature Δ_a secondaries.
73
+
Δ_a.biUnion (fun ⟨⟨⟨p_n, p_v⟩, f⟩, n, vs, fs⟩ =>
74
+
fs.biUnion (fun f' =>
75
+
(vs.filter (fun v =>
76
+
(∃ fs_p, ((p_n, p_v), fs_p) ∈ S_CF) ∧
77
+
(∃ fs', fs ⊆ fs' ∧ ((n, v), fs') ∈ S_CF) ∧
78
+
((n, v), (p_n, p_v)) ∈ π)).image
79
+
(fun v => (hcfi.cfIntermediateN_a p_n p_v f n f', hcvr.origV v))))
80
+
81
+
/-! ### Witness Membership Helpers -/
82
+
83
+
theorem cfCompletenessWitness_mem_cases
84
+
{S_CF : Finset (Package N V × Finset F)}
85
+
{π : Finset (Package N V × Package N V)}
86
+
{Δ_f : Feature.FeatDepRel N V F} {Δ_a : Feature.AddlDepRel N V F}
87
+
{g : V → G} {q : Package N_FC V_FC}
88
+
(hq : q ∈ cfCompletenessWitness (N_FC := N_FC) (V_FC := V_FC) S_CF π Δ_f Δ_a g) :
89
+
(∃ n v fs, ((n, v), fs) ∈ S_CF ∧
90
+
q = (hcnm.granularN (Feature.FeatureName.orig n) (g v), hcvr.origV v)) ∨
91
+
(∃ n v fs f, ((n, v), fs) ∈ S_CF ∧ f ∈ fs ∧
92
+
q = (hcnm.granularN (Feature.FeatureName.featured n f) (g v), hcvr.origV v)) ∨
93
+
(∃ p_n p_v n vs fs v, ((p_n, p_v), n, vs, fs) ∈ Δ_f ∧ v ∈ vs ∧
94
+
(∃ fs_p, ((p_n, p_v), fs_p) ∈ S_CF) ∧
95
+
(∃ fs', fs ⊆ fs' ∧ ((n, v), fs') ∈ S_CF) ∧ ((n, v), (p_n, p_v)) ∈ π ∧
96
+
q = (hcfi.cfIntermediateN p_n p_v n, hcvr.origV v)) ∨
97
+
(∃ p_n p_v f_dep n vs fs v, (((p_n, p_v), f_dep), n, vs, fs) ∈ Δ_a ∧ v ∈ vs ∧
98
+
(∃ fs_p, ((p_n, p_v), fs_p) ∈ S_CF) ∧
99
+
(∃ fs', fs ⊆ fs' ∧ ((n, v), fs') ∈ S_CF) ∧ ((n, v), (p_n, p_v)) ∈ π ∧
100
+
q = (hcfi.cfIntermediateN p_n p_v n, hcvr.origV v)) ∨
101
+
(∃ p_n p_v n vs fs v f, ((p_n, p_v), n, vs, fs) ∈ Δ_f ∧ v ∈ vs ∧ f ∈ fs ∧
102
+
(∃ fs_p, ((p_n, p_v), fs_p) ∈ S_CF) ∧
103
+
(∃ fs', fs ⊆ fs' ∧ ((n, v), fs') ∈ S_CF) ∧ ((n, v), (p_n, p_v)) ∈ π ∧
104
+
q = (hcfi.cfIntermediateN_f p_n p_v n f, hcvr.origV v)) ∨
105
+
(∃ p_n p_v f_dep n vs fs v f', (((p_n, p_v), f_dep), n, vs, fs) ∈ Δ_a ∧
106
+
v ∈ vs ∧ f' ∈ fs ∧
107
+
(∃ fs_p, ((p_n, p_v), fs_p) ∈ S_CF) ∧
108
+
(∃ fs', fs ⊆ fs' ∧ ((n, v), fs') ∈ S_CF) ∧ ((n, v), (p_n, p_v)) ∈ π ∧
109
+
q = (hcfi.cfIntermediateN_a p_n p_v f_dep n f', hcvr.origV v)) := by
110
+
rw [cfCompletenessWitness] at hq
111
+
rcases Finset.mem_union.mp hq with hq | hq
112
+
rcases Finset.mem_union.mp hq with hq | hq
113
+
rcases Finset.mem_union.mp hq with hq | hq
114
+
rcases Finset.mem_union.mp hq with hq | hq
115
+
rcases Finset.mem_union.mp hq with hq | hq
116
+
· left
117
+
simp only [Finset.mem_image] at hq
118
+
obtain ⟨⟨⟨n, v⟩, fs⟩, hmem, rfl⟩ := hq
119
+
exact ⟨n, v, fs, hmem, rfl⟩
120
+
· right; left
121
+
simp only [Finset.mem_biUnion, Finset.mem_image] at hq
122
+
obtain ⟨⟨⟨n, v⟩, fs⟩, hmem, f, hf, rfl⟩ := hq
123
+
exact ⟨n, v, fs, f, hmem, hf, rfl⟩
124
+
· right; right; left
125
+
simp only [Finset.mem_biUnion, Finset.mem_image, Finset.mem_filter] at hq
126
+
obtain ⟨⟨⟨p_n, p_v⟩, n, vs, fs⟩, hdep, v, ⟨hv, hp_S, hscf, hπ⟩, rfl⟩ := hq
127
+
exact ⟨p_n, p_v, n, vs, fs, v, hdep, hv, hp_S, hscf, hπ, rfl⟩
128
+
· right; right; right; left
129
+
simp only [Finset.mem_biUnion, Finset.mem_image, Finset.mem_filter] at hq
130
+
obtain ⟨⟨⟨⟨p_n, p_v⟩, f_dep⟩, n, vs, fs⟩, hdep, v, ⟨hv, hp_S, hscf, hπ⟩, rfl⟩ := hq
131
+
exact ⟨p_n, p_v, f_dep, n, vs, fs, v, hdep, hv, hp_S, hscf, hπ, rfl⟩
132
+
· right; right; right; right; left
133
+
simp only [Finset.mem_biUnion, Finset.mem_image, Finset.mem_filter] at hq
134
+
obtain ⟨⟨⟨p_n, p_v⟩, n, vs, fs⟩, hdep, f, hf, v, ⟨hv, hp_S, hscf, hπ⟩, rfl⟩ := hq
135
+
exact ⟨p_n, p_v, n, vs, fs, v, f, hdep, hv, hf, hp_S, hscf, hπ, rfl⟩
136
+
· right; right; right; right; right
137
+
simp only [Finset.mem_biUnion, Finset.mem_image, Finset.mem_filter] at hq
138
+
obtain ⟨⟨⟨⟨p_n, p_v⟩, f_dep⟩, n, vs, fs⟩, hdep, f', hf', v, ⟨hv, hp_S, hscf, hπ⟩, rfl⟩ := hq
139
+
exact ⟨p_n, p_v, f_dep, n, vs, fs, v, f', hdep, hv, hf', hp_S, hscf, hπ, rfl⟩
140
+
141
+
theorem cfCompletenessWitness_base_mem
142
+
{S_CF : Finset (Package N V × Finset F)}
143
+
{π : Finset (Package N V × Package N V)}
144
+
{Δ_f : Feature.FeatDepRel N V F} {Δ_a : Feature.AddlDepRel N V F}
145
+
{g : V → G} {n : N} {v : V} {fs : Finset F}
146
+
(h : ((n, v), fs) ∈ S_CF) :
147
+
(hcnm.granularN (Feature.FeatureName.orig n) (g v), hcvr.origV v) ∈
148
+
cfCompletenessWitness (N_FC := N_FC) (V_FC := V_FC) S_CF π Δ_f Δ_a g := by
149
+
apply Finset.mem_union_left; apply Finset.mem_union_left
150
+
apply Finset.mem_union_left; apply Finset.mem_union_left
151
+
apply Finset.mem_union_left
152
+
exact Finset.mem_image.mpr ⟨⟨(n, v), fs⟩, h, rfl⟩
153
+
154
+
theorem cfCompletenessWitness_feat_mem
155
+
{S_CF : Finset (Package N V × Finset F)}
156
+
{π : Finset (Package N V × Package N V)}
157
+
{Δ_f : Feature.FeatDepRel N V F} {Δ_a : Feature.AddlDepRel N V F}
158
+
{g : V → G} {n : N} {v : V} {fs : Finset F} {f : F}
159
+
(h : ((n, v), fs) ∈ S_CF) (hf : f ∈ fs) :
160
+
(hcnm.granularN (Feature.FeatureName.featured n f) (g v), hcvr.origV v) ∈
161
+
cfCompletenessWitness (N_FC := N_FC) (V_FC := V_FC) S_CF π Δ_f Δ_a g := by
162
+
apply Finset.mem_union_left; apply Finset.mem_union_left
163
+
apply Finset.mem_union_left; apply Finset.mem_union_left
164
+
apply Finset.mem_union_right
165
+
exact Finset.mem_biUnion.mpr ⟨⟨(n, v), fs⟩, h, Finset.mem_image.mpr ⟨f, hf, rfl⟩⟩
166
+
167
+
theorem cfCompletenessWitness_inter_mem_f
168
+
{S_CF : Finset (Package N V × Finset F)}
169
+
{π : Finset (Package N V × Package N V)}
170
+
{Δ_f : Feature.FeatDepRel N V F} {Δ_a : Feature.AddlDepRel N V F}
171
+
{g : V → G} {p_n : N} {p_v : V} {n : N} {vs : Finset V} {fs : Finset F} {v : V}
172
+
(hdep : ((p_n, p_v), n, vs, fs) ∈ Δ_f) (hv : v ∈ vs)
173
+
(hp_S : ∃ fs_p, ((p_n, p_v), fs_p) ∈ S_CF)
174
+
(hscf : ∃ fs', fs ⊆ fs' ∧ ((n, v), fs') ∈ S_CF) (hπ : ((n, v), (p_n, p_v)) ∈ π) :
175
+
(hcfi.cfIntermediateN p_n p_v n, hcvr.origV v) ∈
176
+
cfCompletenessWitness (N_FC := N_FC) (V_FC := V_FC) S_CF π Δ_f Δ_a g := by
177
+
apply Finset.mem_union_left; apply Finset.mem_union_left
178
+
apply Finset.mem_union_left
179
+
apply Finset.mem_union_right
180
+
exact Finset.mem_biUnion.mpr ⟨⟨(p_n, p_v), n, vs, fs⟩, hdep,
181
+
Finset.mem_image.mpr ⟨v, Finset.mem_filter.mpr ⟨hv, hp_S, hscf, hπ⟩, rfl⟩⟩
182
+
183
+
theorem cfCompletenessWitness_inter_mem_a
184
+
{S_CF : Finset (Package N V × Finset F)}
185
+
{π : Finset (Package N V × Package N V)}
186
+
{Δ_f : Feature.FeatDepRel N V F} {Δ_a : Feature.AddlDepRel N V F}
187
+
{g : V → G} {p_n : N} {p_v : V} {f_dep : F} {n : N} {vs : Finset V} {fs : Finset F} {v : V}
188
+
(hdep : (((p_n, p_v), f_dep), n, vs, fs) ∈ Δ_a) (hv : v ∈ vs)
189
+
(hp_S : ∃ fs_p, ((p_n, p_v), fs_p) ∈ S_CF)
190
+
(hscf : ∃ fs', fs ⊆ fs' ∧ ((n, v), fs') ∈ S_CF) (hπ : ((n, v), (p_n, p_v)) ∈ π) :
191
+
(hcfi.cfIntermediateN p_n p_v n, hcvr.origV v) ∈
192
+
cfCompletenessWitness (N_FC := N_FC) (V_FC := V_FC) S_CF π Δ_f Δ_a g := by
193
+
apply Finset.mem_union_left; apply Finset.mem_union_left
194
+
apply Finset.mem_union_right
195
+
exact Finset.mem_biUnion.mpr ⟨⟨((p_n, p_v), f_dep), n, vs, fs⟩, hdep,
196
+
Finset.mem_image.mpr ⟨v, Finset.mem_filter.mpr ⟨hv, hp_S, hscf, hπ⟩, rfl⟩⟩
197
+
198
+
theorem cfCompletenessWitness_inter_mem_f_feat
199
+
{S_CF : Finset (Package N V × Finset F)}
200
+
{π : Finset (Package N V × Package N V)}
201
+
{Δ_f : Feature.FeatDepRel N V F} {Δ_a : Feature.AddlDepRel N V F}
202
+
{g : V → G} {p_n : N} {p_v : V} {n : N} {vs : Finset V} {fs : Finset F}
203
+
{v : V} {f : F}
204
+
(hdep : ((p_n, p_v), n, vs, fs) ∈ Δ_f) (hv : v ∈ vs) (hf : f ∈ fs)
205
+
(hp_S : ∃ fs_p, ((p_n, p_v), fs_p) ∈ S_CF)
206
+
(hscf : ∃ fs', fs ⊆ fs' ∧ ((n, v), fs') ∈ S_CF) (hπ : ((n, v), (p_n, p_v)) ∈ π) :
207
+
(hcfi.cfIntermediateN_f p_n p_v n f, hcvr.origV v) ∈
208
+
cfCompletenessWitness (N_FC := N_FC) (V_FC := V_FC) S_CF π Δ_f Δ_a g := by
209
+
apply Finset.mem_union_left
210
+
apply Finset.mem_union_right
211
+
exact Finset.mem_biUnion.mpr ⟨⟨(p_n, p_v), n, vs, fs⟩, hdep,
212
+
Finset.mem_biUnion.mpr ⟨f, hf,
213
+
Finset.mem_image.mpr ⟨v, Finset.mem_filter.mpr ⟨hv, hp_S, hscf, hπ⟩, rfl⟩⟩⟩
214
+
215
+
theorem cfCompletenessWitness_inter_mem_a_feat
216
+
{S_CF : Finset (Package N V × Finset F)}
217
+
{π : Finset (Package N V × Package N V)}
218
+
{Δ_f : Feature.FeatDepRel N V F} {Δ_a : Feature.AddlDepRel N V F}
219
+
{g : V → G} {p_n : N} {p_v : V} {f_dep : F} {n : N} {vs : Finset V}
220
+
{fs : Finset F} {v : V} {f' : F}
221
+
(hdep : (((p_n, p_v), f_dep), n, vs, fs) ∈ Δ_a) (hv : v ∈ vs) (hf' : f' ∈ fs)
222
+
(hp_S : ∃ fs_p, ((p_n, p_v), fs_p) ∈ S_CF)
223
+
(hscf : ∃ fs', fs ⊆ fs' ∧ ((n, v), fs') ∈ S_CF) (hπ : ((n, v), (p_n, p_v)) ∈ π) :
224
+
(hcfi.cfIntermediateN_a p_n p_v f_dep n f', hcvr.origV v) ∈
225
+
cfCompletenessWitness (N_FC := N_FC) (V_FC := V_FC) S_CF π Δ_f Δ_a g := by
226
+
apply Finset.mem_union_right
227
+
exact Finset.mem_biUnion.mpr ⟨⟨((p_n, p_v), f_dep), n, vs, fs⟩, hdep,
228
+
Finset.mem_biUnion.mpr ⟨f', hf',
229
+
Finset.mem_image.mpr ⟨v, Finset.mem_filter.mpr ⟨hv, hp_S, hscf, hπ⟩, rfl⟩⟩⟩
230
+
231
+
/-! ### Completeness Field Lemmas -/
232
+
233
+
section CompletenessFields
234
+
235
+
variable (R : Real N V) (Δ_f : Feature.FeatDepRel N V F) (Δ_a : Feature.AddlDepRel N V F)
236
+
(support : Feature.Support N V F) (g : V → G) (r : Package N V)
237
+
(S_CF : Finset (Package N V × Finset F))
238
+
(π : Finset (Package N V × Package N V))
239
+
(hres : IsConcurrentFeatureResolution R support Δ_f Δ_a g r S_CF π)
240
+
241
+
include hres
242
+
243
+
theorem cfComplete_subset :
244
+
cfCompletenessWitness (N_FC := N_FC) (V_FC := V_FC) S_CF π Δ_f Δ_a g ⊆
245
+
concurrentFeatureReal R support Δ_f Δ_a g := by
246
+
intro q hq
247
+
rcases cfCompletenessWitness_mem_cases hq with
248
+
⟨n, v, fs, h, rfl⟩
249
+
| ⟨n, v, fs, f, h, hf, rfl⟩
250
+
| ⟨p_n, p_v, n, vs, fs, v, hdep, hv, _, _, _, rfl⟩
251
+
| ⟨p_n, p_v, f_dep, n, vs, fs, v, hdep, hv, _, _, _, rfl⟩
252
+
| ⟨p_n, p_v, n, vs, fs, v, f, hdep, hv, hf, _, _, _, rfl⟩
253
+
| ⟨p_n, p_v, f_dep, n, vs, fs, v, f, hdep, hv, hf, _, _, _, rfl⟩
254
+
· -- Part 1: base orig granular
255
+
have h_orig : (Feature.FeatureName.orig n, v) ∈ Feature.featureReal R support := by
256
+
have := hres.subset (n, v) fs h
257
+
simp_all +decide [Feature.featureReal]
258
+
exact Or.inl (Finset.mem_image.mpr ⟨(n, v), this, rfl⟩)
259
+
exact Finset.mem_union_left _ (Finset.mem_union_left _ (Finset.mem_union_left _
260
+
(Finset.mem_union_left _ (Finset.mem_image_of_mem _ (by simpa using h_orig)))))
261
+
· -- Part 2: feature granular
262
+
have h_support : ((n, v), f) ∈ support := hres.support_mem _ _ _ _ h hf
263
+
have h_R : (n, v) ∈ R := hres.subset _ _ h
264
+
have h_feat : (Feature.FeatureName.featured n f, v) ∈ Feature.featureReal R support := by
265
+
simp only [Feature.featureReal, Finset.mem_union]
266
+
right
267
+
exact Finset.mem_biUnion.mpr ⟨((n, v), f), h_support, by
268
+
simp only [if_pos h_R, Finset.mem_singleton]
269
+
rfl⟩
270
+
apply Finset.mem_union_left; apply Finset.mem_union_left
271
+
apply Finset.mem_union_left; apply Finset.mem_union_left
272
+
-- embedReal: (granularN (featured n f) (g v), origV v) is image of (featured n f, v).
273
+
exact Finset.mem_image.mpr ⟨(Feature.FeatureName.featured n f, v), h_feat, rfl⟩
274
+
· -- Part 3: shared intermediate from Δ_f
275
+
exact mem_cfReal_inter_f hdep hv
276
+
· -- Part 3b: shared intermediate from Δ_a
277
+
exact mem_cfReal_inter_a hdep hv
278
+
· -- Part 4: secondary intermediate from Δ_f
279
+
exact mem_cfReal_inter_f_feat hdep hv hf
280
+
· -- Part 5: secondary intermediate from Δ_a
281
+
exact mem_cfReal_inter_a_feat hdep hv hf
282
+
283
+
theorem cfComplete_root_mem :
284
+
Concurrent.embedPkg g (Feature.embedPkg F r) ∈
285
+
cfCompletenessWitness (N_FC := N_FC) (V_FC := V_FC) S_CF π Δ_f Δ_a g := by
286
+
exact cfCompletenessWitness_base_mem ( hres.root_mem )
287
+
288
+
private theorem cfComplete_vu_intermediate
289
+
{pn : N} {pv : V} {m : N} {w1 w2 : V}
290
+
(hπ1 : ((m, w1), (pn, pv)) ∈ π)
291
+
(hπ2 : ((m, w2), (pn, pv)) ∈ π) :
292
+
hcvr.origV w1 = hcvr.origV w2 :=
293
+
congrArg _ (hres.π_functional m w1 w2 (pn, pv) hπ1 hπ2)
294
+
295
+
set_option maxHeartbeats 3200000 in
296
+
private theorem cfComplete_dep_closure_aux
297
+
(p : Package N_FC V_FC)
298
+
(hp : p ∈ cfCompletenessWitness (N_FC := N_FC) (V_FC := V_FC) S_CF π Δ_f Δ_a g)
299
+
(m : N_FC) (vs : Finset V_FC)
300
+
(hdep : (p, m, vs) ∈ concurrentFeatureDeps R support Δ_f Δ_a g) :
301
+
∃ v ∈ vs, (m, v) ∈ cfCompletenessWitness (N_FC := N_FC) (V_FC := V_FC) S_CF π Δ_f Δ_a g := by
302
+
rcases concurrentFeatureDeps_mem_cases hdep with
303
+
⟨n, v, f, _, _, hp_eq, hm_eq, hvs_eq⟩
304
+
| ⟨p_n, p_v, n, vs_raw, fs, hdep_f, hp_eq, hm_eq, hvs_eq⟩
305
+
| ⟨p_n, p_v, n, vs_raw, fs, v, hdep_f, hv_raw, hp_eq, hm_eq, hvs_eq⟩
306
+
| ⟨p_n, p_v, n, vs_raw, fs, f, hdep_f, hf_fs, hp_eq, hm_eq, hvs_eq⟩
307
+
| ⟨p_n, p_v, n, vs_raw, fs, v, f, hdep_f, hv_raw, hf_fs, hp_eq, hm_eq, hvs_eq⟩
308
+
| ⟨p_n, p_v, n, vs_raw, fs, u, f, hdep_f, hu_raw, hf_fs, hp_eq, hm_eq, hvs_eq⟩
309
+
| ⟨p_n, p_v, f_dep, n, vs_raw, fs, hdep_a, hp_eq, hm_eq, hvs_eq⟩
310
+
| ⟨p_n, p_v, f_dep, n, vs_raw, fs, v, hdep_a, hv_raw, hp_eq, hm_eq, hvs_eq⟩
311
+
| ⟨p_n, p_v, f_dep, n, vs_raw, fs, f', hdep_a, hf'_fs, hp_eq, hm_eq, hvs_eq⟩
312
+
| ⟨p_n, p_v, f_dep, n, vs_raw, fs, v, f', hdep_a, hv_raw, hf'_fs, hp_eq, hm_eq, hvs_eq⟩
313
+
| ⟨p_n, p_v, f_dep, n, vs_raw, fs, u, f', hdep_a, hu_raw, hf'_fs, hp_eq, hm_eq, hvs_eq⟩
314
+
-- supp_back: p = featured granular, m = orig granular, vs = {origV v}.
315
+
· subst hp_eq; subst hm_eq; subst hvs_eq
316
+
rcases cfCompletenessWitness_mem_cases hp with
317
+
⟨_, _, _, _, hp_eq⟩
318
+
| ⟨n', v', fs', f', hS', _, hp_eq⟩
319
+
| ⟨_, _, _, _, _, _, _, _, _, _, _, hp_eq⟩
320
+
| ⟨_, _, _, _, _, _, _, _, _, _, _, _, hp_eq⟩
321
+
| ⟨_, _, _, _, _, _, _, _, _, _, _, _, _, hp_eq⟩
322
+
| ⟨_, _, _, _, _, _, _, _, _, _, _, _, _, _, hp_eq⟩
323
+
· exfalso
324
+
simp only [Prod.mk.injEq] at hp_eq
325
+
have hinj := hcnm.granularN_injective hp_eq.1
326
+
cases hinj.1
327
+
· simp only [Prod.mk.injEq] at hp_eq
328
+
obtain ⟨hgran, hver⟩ := hp_eq
329
+
obtain ⟨hfn_eq, _⟩ := hcnm.granularN_injective hgran
330
+
have hpair := Feature.FeatureName.featured.inj hfn_eq
331
+
have hv_eq : v = v' := hcvr.origV.injective hver
332
+
refine ⟨hcvr.origV v, ?_, ?_⟩
333
+
· exact Finset.mem_map.mpr ⟨v, Finset.mem_singleton.mpr rfl, rfl⟩
334
+
· have hS'' : ((n, v), fs') ∈ S_CF := by rw [hpair.1, hv_eq]; exact hS'
335
+
exact cfCompletenessWitness_base_mem hS''
336
+
all_goals
337
+
· exfalso
338
+
simp only [Prod.mk.injEq] at hp_eq
339
+
first
340
+
| exact (hcfi.cfIntermediateN_ne_granularN _ _ _ _ _) hp_eq.1.symm
341
+
| exact (hcfi.cfIntermediateN_f_ne_granularN _ _ _ _ _ _) hp_eq.1.symm
342
+
| exact (hcfi.cfIntermediateN_a_ne_granularN _ _ _ _ _ _ _) hp_eq.1.symm
343
+
-- f_depToInter: p = depender's orig granular, m = shared intermediate.
344
+
· subst hp_eq; subst hm_eq; subst hvs_eq
345
+
rcases cfCompletenessWitness_mem_cases hp with
346
+
⟨n', v', fs', hS', hp_eq⟩
347
+
| ⟨_, _, _, _, _, _, hp_eq⟩
348
+
| ⟨_, _, _, _, _, _, _, _, _, _, _, hp_eq⟩
349
+
| ⟨_, _, _, _, _, _, _, _, _, _, _, _, hp_eq⟩
350
+
| ⟨_, _, _, _, _, _, _, _, _, _, _, _, _, hp_eq⟩
351
+
| ⟨_, _, _, _, _, _, _, _, _, _, _, _, _, _, hp_eq⟩
352
+
· simp only [Prod.mk.injEq] at hp_eq
353
+
obtain ⟨hgran, hver⟩ := hp_eq
354
+
obtain ⟨hfn_eq, _⟩ := hcnm.granularN_injective hgran
355
+
have hn : p_n = n' := Feature.FeatureName.orig.inj hfn_eq
356
+
have hv_eq : p_v = v' := hcvr.origV.injective hver
357
+
have hS'' : ((p_n, p_v), fs') ∈ S_CF := by rw [hn, hv_eq]; exact hS'
358
+
have hpc := hres.parent_closure (p_n, p_v) fs' hS'' n vs_raw fs hdep_f
359
+
obtain ⟨u, ⟨hu_vs, hu_scf, hu_π⟩, _⟩ := hpc
360
+
refine ⟨hcvr.origV u, ?_, ?_⟩
361
+
· exact Finset.mem_map.mpr ⟨u, hu_vs, rfl⟩
362
+
· exact cfCompletenessWitness_inter_mem_f hdep_f hu_vs ⟨fs', hS''⟩ hu_scf hu_π
363
+
· exfalso
364
+
simp only [Prod.mk.injEq] at hp_eq
365
+
have hinj := hcnm.granularN_injective hp_eq.1
366
+
cases hinj.1
367
+
all_goals
368
+
· exfalso
369
+
simp only [Prod.mk.injEq] at hp_eq
370
+
first
371
+
| exact (hcfi.cfIntermediateN_ne_granularN _ _ _ _ _) hp_eq.1.symm
372
+
| exact (hcfi.cfIntermediateN_f_ne_granularN _ _ _ _ _ _) hp_eq.1.symm
373
+
| exact (hcfi.cfIntermediateN_a_ne_granularN _ _ _ _ _ _ _) hp_eq.1.symm
374
+
-- f_interToOrig: p = shared intermediate, m = orig granular.
375
+
· subst hp_eq; subst hm_eq; subst hvs_eq
376
+
rcases cfCompletenessWitness_mem_cases hp with
377
+
⟨_, _, _, _, hp_eq⟩
378
+
| ⟨_, _, _, _, _, _, hp_eq⟩
379
+
| ⟨p_n', p_v', n', _, _, v', _, _, _, hscf', _, hp_eq⟩
380
+
| ⟨p_n', p_v', _, n', _, _, v', _, _, _, hscf', _, hp_eq⟩
381
+
| ⟨_, _, _, _, _, _, _, _, _, _, _, _, _, hp_eq⟩
382
+
| ⟨_, _, _, _, _, _, _, _, _, _, _, _, _, _, hp_eq⟩
383
+
all_goals first
384
+
| (exfalso; simp only [Prod.mk.injEq] at hp_eq
385
+
first
386
+
| exact (hcfi.cfIntermediateN_ne_granularN _ _ _ _ _) hp_eq.1
387
+
| exact (hcfi.cfIntermediateN_f_ne_cfIntermediateN _ _ _ _ _ _ _) hp_eq.1.symm
388
+
| exact (hcfi.cfIntermediateN_a_ne_cfIntermediateN _ _ _ _ _ _ _ _) hp_eq.1.symm)
389
+
| (simp only [Prod.mk.injEq] at hp_eq
390
+
obtain ⟨hci, hver⟩ := hp_eq
391
+
have hinj := hcfi.cfIntermediateN_injective _ _ _ _ _ _ hci
392
+
have hv_eq : v = v' := hcvr.origV.injective hver
393
+
obtain ⟨fs'', _, hScf⟩ := hscf'
394
+
have hScf' : ((n, v), fs'') ∈ S_CF := by rw [hinj.2.2, hv_eq]; exact hScf
395
+
refine ⟨hcvr.origV v, ?_, ?_⟩
396
+
· exact Finset.mem_map.mpr ⟨v, Finset.mem_singleton.mpr rfl, rfl⟩
397
+
· exact cfCompletenessWitness_base_mem hScf')
398
+
-- f_depToInterFeat: p = depender's orig, m = secondary cfIntermediateN_f.
399
+
· subst hp_eq; subst hm_eq; subst hvs_eq
400
+
rcases cfCompletenessWitness_mem_cases hp with
401
+
⟨n', v', fs', hS', hp_eq⟩
402
+
| ⟨_, _, _, _, _, _, hp_eq⟩
403
+
| ⟨_, _, _, _, _, _, _, _, _, _, _, hp_eq⟩
404
+
| ⟨_, _, _, _, _, _, _, _, _, _, _, _, hp_eq⟩
405
+
| ⟨_, _, _, _, _, _, _, _, _, _, _, _, _, hp_eq⟩
406
+
| ⟨_, _, _, _, _, _, _, _, _, _, _, _, _, _, hp_eq⟩
407
+
· simp only [Prod.mk.injEq] at hp_eq
408
+
obtain ⟨hgran, hver⟩ := hp_eq
409
+
obtain ⟨hfn_eq, _⟩ := hcnm.granularN_injective hgran
410
+
have hn : p_n = n' := Feature.FeatureName.orig.inj hfn_eq
411
+
have hv_eq : p_v = v' := hcvr.origV.injective hver
412
+
have hS'' : ((p_n, p_v), fs') ∈ S_CF := by rw [hn, hv_eq]; exact hS'
413
+
have hpc := hres.parent_closure (p_n, p_v) fs' hS'' n vs_raw fs hdep_f
414
+
obtain ⟨u, ⟨hu_vs, hu_scf, hu_π⟩, _⟩ := hpc
415
+
refine ⟨hcvr.origV u, ?_, ?_⟩
416
+
· exact Finset.mem_map.mpr ⟨u, hu_vs, rfl⟩
417
+
· exact cfCompletenessWitness_inter_mem_f_feat hdep_f hu_vs hf_fs
418
+
⟨fs', hS''⟩ hu_scf hu_π
419
+
· exfalso
420
+
simp only [Prod.mk.injEq] at hp_eq
421
+
have hinj := hcnm.granularN_injective hp_eq.1
422
+
cases hinj.1
423
+
all_goals
424
+
· exfalso
425
+
simp only [Prod.mk.injEq] at hp_eq
426
+
first
427
+
| exact (hcfi.cfIntermediateN_ne_granularN _ _ _ _ _) hp_eq.1.symm
428
+
| exact (hcfi.cfIntermediateN_f_ne_granularN _ _ _ _ _ _) hp_eq.1.symm
429
+
| exact (hcfi.cfIntermediateN_a_ne_granularN _ _ _ _ _ _ _) hp_eq.1.symm
430
+
-- f_interToFeat: p = secondary cfIntermediateN_f at v, m = feature granular at g v.
431
+
· subst hp_eq; subst hm_eq; subst hvs_eq
432
+
rcases cfCompletenessWitness_mem_cases hp with
433
+
⟨_, _, _, _, hp_eq⟩
434
+
| ⟨_, _, _, _, _, _, hp_eq⟩
435
+
| ⟨_, _, _, _, _, _, _, _, _, _, _, hp_eq⟩
436
+
| ⟨_, _, _, _, _, _, _, _, _, _, _, _, hp_eq⟩
437
+
| ⟨p_n', p_v', n', vs_w, fs_w, v', f_w, hdep_w, hv_w_vs, hf_w, hp_S, hscf', hπ', hp_eq⟩
438
+
| ⟨_, _, _, _, _, _, _, _, _, _, _, _, _, _, hp_eq⟩
439
+
all_goals first
440
+
| (exfalso; simp only [Prod.mk.injEq] at hp_eq
441
+
first
442
+
| exact (hcfi.cfIntermediateN_f_ne_granularN _ _ _ _ _ _) hp_eq.1
443
+
| exact (hcfi.cfIntermediateN_f_ne_cfIntermediateN _ _ _ _ _ _ _) hp_eq.1
444
+
| exact (hcfi.cfIntermediateN_a_ne_cfIntermediateN_f _ _ _ _ _ _ _ _ _) hp_eq.1.symm)
445
+
| (-- Witness intermediate_f_feat. Match args.
446
+
simp only [Prod.mk.injEq] at hp_eq
447
+
obtain ⟨hci, hver⟩ := hp_eq
448
+
have hinj := hcfi.cfIntermediateN_f_injective _ _ _ _ _ _ _ _ hci
449
+
have hv_eq : v = v' := hcvr.origV.injective hver
450
+
have hf_eq : f = f_w := hinj.2.2.2
451
+
have hn_eq : n = n' := hinj.2.2.1
452
+
obtain ⟨fs'', hsub'', hScf⟩ := hscf'
453
+
have hScf' : ((n, v), fs'') ∈ S_CF := by rw [hn_eq, hv_eq]; exact hScf
454
+
have hf_in : f ∈ fs'' := by rw [hf_eq]; exact hsub'' hf_w
455
+
refine ⟨hcvr.origV v, ?_, ?_⟩
456
+
· exact Finset.mem_map.mpr ⟨v, Finset.mem_singleton.mpr rfl, rfl⟩
457
+
· exact cfCompletenessWitness_feat_mem hScf' hf_in)
458
+
-- f_interFeatToInter: p = secondary cfIntermediateN_f at u,
459
+
-- m = shared cfIntermediateN p_n p_v n, vs = {origV u}.
460
+
· subst hp_eq; subst hm_eq; subst hvs_eq
461
+
rcases cfCompletenessWitness_mem_cases hp with
462
+
⟨_, _, _, _, hp_eq⟩
463
+
| ⟨_, _, _, _, _, _, hp_eq⟩
464
+
| ⟨_, _, _, _, _, _, _, _, _, _, _, hp_eq⟩
465
+
| ⟨_, _, _, _, _, _, _, _, _, _, _, _, hp_eq⟩
466
+
| ⟨p_n', p_v', n', vs_w, fs_w, v', f_w, hdep_w, hv_w_vs, hf_w, hp_S, hscf', hπ', hp_eq⟩
467
+
| ⟨_, _, _, _, _, _, _, _, _, _, _, _, _, _, hp_eq⟩
468
+
all_goals first
469
+
| (exfalso; simp only [Prod.mk.injEq] at hp_eq
470
+
first
471
+
| exact (hcfi.cfIntermediateN_f_ne_granularN _ _ _ _ _ _) hp_eq.1
472
+
| exact (hcfi.cfIntermediateN_f_ne_cfIntermediateN _ _ _ _ _ _ _) hp_eq.1
473
+
| exact (hcfi.cfIntermediateN_a_ne_cfIntermediateN_f _ _ _ _ _ _ _ _ _) hp_eq.1.symm)
474
+
| (-- Witness case 5: secondary cfIntermediateN_f at v' from entry (vs_w, fs_w).
475
+
-- Place the shared cfIntermediateN at u in Part 3 using the SAME entry (vs_w, fs_w);
476
+
-- the Part 3 filter conditions are identical to the Part 4 filter conditions.
477
+
simp only [Prod.mk.injEq] at hp_eq
478
+
obtain ⟨hci, hver⟩ := hp_eq
479
+
have hinj := hcfi.cfIntermediateN_f_injective _ _ _ _ _ _ _ _ hci
480
+
have hu_eq : u = v' := hcvr.origV.injective hver
481
+
have hp_n_eq : p_n = p_n' := hinj.1
482
+
have hp_v_eq : p_v = p_v' := hinj.2.1
483
+
have hn_eq : n = n' := hinj.2.2.1
484
+
subst hp_n_eq; subst hp_v_eq; subst hn_eq; subst hu_eq
485
+
refine ⟨hcvr.origV u, ?_, ?_⟩
486
+
· exact Finset.mem_map.mpr ⟨u, Finset.mem_singleton.mpr rfl, rfl⟩
487
+
· exact cfCompletenessWitness_inter_mem_f hdep_w hv_w_vs hp_S hscf' hπ')
488
+
-- a_depToInter: p = depender's featured granular, m = shared intermediate.
489
+
· subst hp_eq; subst hm_eq; subst hvs_eq
490
+
rcases cfCompletenessWitness_mem_cases hp with
491
+
⟨_, _, _, _, hp_eq⟩
492
+
| ⟨n', v', fs', f', hS', hf', hp_eq⟩
493
+
| ⟨_, _, _, _, _, _, _, _, _, _, _, hp_eq⟩
494
+
| ⟨_, _, _, _, _, _, _, _, _, _, _, _, hp_eq⟩
495
+
| ⟨_, _, _, _, _, _, _, _, _, _, _, _, _, hp_eq⟩
496
+
| ⟨_, _, _, _, _, _, _, _, _, _, _, _, _, _, hp_eq⟩
497
+
· exfalso
498
+
simp only [Prod.mk.injEq] at hp_eq
499
+
have hinj := hcnm.granularN_injective hp_eq.1
500
+
cases hinj.1
501
+
· simp only [Prod.mk.injEq] at hp_eq
502
+
obtain ⟨hgran, hver⟩ := hp_eq
503
+
obtain ⟨hfn_eq, _⟩ := hcnm.granularN_injective hgran
504
+
have hpair := Feature.FeatureName.featured.inj hfn_eq
505
+
have hv_eq : p_v = v' := hcvr.origV.injective hver
506
+
have hS'' : ((p_n, p_v), fs') ∈ S_CF := by rw [hpair.1, hv_eq]; exact hS'
507
+
have hf_in : f_dep ∈ fs' := by rw [hpair.2]; exact hf'
508
+
have hpc := hres.parent_closure_addl (p_n, p_v) fs' hS'' f_dep hf_in n vs_raw fs hdep_a
509
+
obtain ⟨u, ⟨hu_vs, hu_scf, hu_π⟩, _⟩ := hpc
510
+
refine ⟨hcvr.origV u, ?_, ?_⟩
511
+
· exact Finset.mem_map.mpr ⟨u, hu_vs, rfl⟩
512
+
· exact cfCompletenessWitness_inter_mem_a hdep_a hu_vs ⟨fs', hS''⟩ hu_scf hu_π
513
+
all_goals
514
+
· exfalso
515
+
simp only [Prod.mk.injEq] at hp_eq
516
+
first
517
+
| exact (hcfi.cfIntermediateN_ne_granularN _ _ _ _ _) hp_eq.1.symm
518
+
| exact (hcfi.cfIntermediateN_f_ne_granularN _ _ _ _ _ _) hp_eq.1.symm
519
+
| exact (hcfi.cfIntermediateN_a_ne_granularN _ _ _ _ _ _ _) hp_eq.1.symm
520
+
-- a_interToOrig: p = shared intermediate, m = orig granular.
521
+
· subst hp_eq; subst hm_eq; subst hvs_eq
522
+
rcases cfCompletenessWitness_mem_cases hp with
523
+
⟨_, _, _, _, hp_eq⟩
524
+
| ⟨_, _, _, _, _, _, hp_eq⟩
525
+
| ⟨p_n', p_v', n', _, _, v', _, _, _, hscf', _, hp_eq⟩
526
+
| ⟨p_n', p_v', _, n', _, _, v', _, _, _, hscf', _, hp_eq⟩
527
+
| ⟨_, _, _, _, _, _, _, _, _, _, _, _, _, hp_eq⟩
528
+
| ⟨_, _, _, _, _, _, _, _, _, _, _, _, _, _, hp_eq⟩
529
+
all_goals first
530
+
| (exfalso; simp only [Prod.mk.injEq] at hp_eq
531
+
first
532
+
| exact (hcfi.cfIntermediateN_ne_granularN _ _ _ _ _) hp_eq.1
533
+
| exact (hcfi.cfIntermediateN_f_ne_cfIntermediateN _ _ _ _ _ _ _) hp_eq.1.symm
534
+
| exact (hcfi.cfIntermediateN_a_ne_cfIntermediateN _ _ _ _ _ _ _ _) hp_eq.1.symm)
535
+
| (simp only [Prod.mk.injEq] at hp_eq
536
+
obtain ⟨hci, hver⟩ := hp_eq
537
+
have hinj := hcfi.cfIntermediateN_injective _ _ _ _ _ _ hci
538
+
have hv_eq : v = v' := hcvr.origV.injective hver
539
+
obtain ⟨fs'', _, hScf⟩ := hscf'
540
+
have hScf' : ((n, v), fs'') ∈ S_CF := by rw [hinj.2.2, hv_eq]; exact hScf
541
+
refine ⟨hcvr.origV v, ?_, ?_⟩
542
+
· exact Finset.mem_map.mpr ⟨v, Finset.mem_singleton.mpr rfl, rfl⟩
543
+
· exact cfCompletenessWitness_base_mem hScf')
544
+
-- a_depToInterFeat: p = depender's featured granular, m = secondary cfIntermediateN_a.
545
+
· subst hp_eq; subst hm_eq; subst hvs_eq
546
+
rcases cfCompletenessWitness_mem_cases hp with
547
+
⟨_, _, _, _, hp_eq⟩
548
+
| ⟨n', v', fs', f', hS', hf', hp_eq⟩
549
+
| ⟨_, _, _, _, _, _, _, _, _, _, _, hp_eq⟩
550
+
| ⟨_, _, _, _, _, _, _, _, _, _, _, _, hp_eq⟩
551
+
| ⟨_, _, _, _, _, _, _, _, _, _, _, _, _, hp_eq⟩
552
+
| ⟨_, _, _, _, _, _, _, _, _, _, _, _, _, _, hp_eq⟩
553
+
· exfalso
554
+
simp only [Prod.mk.injEq] at hp_eq
555
+
have hinj := hcnm.granularN_injective hp_eq.1
556
+
cases hinj.1
557
+
· simp only [Prod.mk.injEq] at hp_eq
558
+
obtain ⟨hgran, hver⟩ := hp_eq
559
+
obtain ⟨hfn_eq, _⟩ := hcnm.granularN_injective hgran
560
+
have hpair := Feature.FeatureName.featured.inj hfn_eq
561
+
have hv_eq : p_v = v' := hcvr.origV.injective hver
562
+
have hS'' : ((p_n, p_v), fs') ∈ S_CF := by rw [hpair.1, hv_eq]; exact hS'
563
+
have hf_in : f_dep ∈ fs' := by rw [hpair.2]; exact hf'
564
+
have hpc := hres.parent_closure_addl (p_n, p_v) fs' hS'' f_dep hf_in n vs_raw fs hdep_a
565
+
obtain ⟨u, ⟨hu_vs, hu_scf, hu_π⟩, _⟩ := hpc
566
+
refine ⟨hcvr.origV u, ?_, ?_⟩
567
+
· exact Finset.mem_map.mpr ⟨u, hu_vs, rfl⟩
568
+
· exact cfCompletenessWitness_inter_mem_a_feat hdep_a hu_vs hf'_fs
569
+
⟨fs', hS''⟩ hu_scf hu_π
570
+
all_goals
571
+
· exfalso
572
+
simp only [Prod.mk.injEq] at hp_eq
573
+
first
574
+
| exact (hcfi.cfIntermediateN_ne_granularN _ _ _ _ _) hp_eq.1.symm
575
+
| exact (hcfi.cfIntermediateN_f_ne_granularN _ _ _ _ _ _) hp_eq.1.symm
576
+
| exact (hcfi.cfIntermediateN_a_ne_granularN _ _ _ _ _ _ _) hp_eq.1.symm
577
+
-- a_interToFeat: p = secondary cfIntermediateN_a at v, m = feature granular at g v.
578
+
· subst hp_eq; subst hm_eq; subst hvs_eq
579
+
rcases cfCompletenessWitness_mem_cases hp with
580
+
⟨_, _, _, _, hp_eq⟩
581
+
| ⟨_, _, _, _, _, _, hp_eq⟩
582
+
| ⟨_, _, _, _, _, _, _, _, _, _, _, hp_eq⟩
583
+
| ⟨_, _, _, _, _, _, _, _, _, _, _, _, hp_eq⟩
584
+
| ⟨_, _, _, _, _, _, _, _, _, _, _, _, _, hp_eq⟩
585
+
| ⟨p_n', p_v', f_dep', n', vs_w, fs_w, v', f_w, hdep_w, hv_w_vs, hf_w, hp_S, hscf', hπ', hp_eq⟩
586
+
all_goals first
587
+
| (exfalso; simp only [Prod.mk.injEq] at hp_eq
588
+
first
589
+
| exact (hcfi.cfIntermediateN_a_ne_granularN _ _ _ _ _ _ _) hp_eq.1
590
+
| exact (hcfi.cfIntermediateN_a_ne_cfIntermediateN _ _ _ _ _ _ _ _) hp_eq.1
591
+
| exact (hcfi.cfIntermediateN_a_ne_cfIntermediateN_f _ _ _ _ _ _ _ _ _) hp_eq.1)
592
+
| (simp only [Prod.mk.injEq] at hp_eq
593
+
obtain ⟨hci, hver⟩ := hp_eq
594
+
have hinj := hcfi.cfIntermediateN_a_injective _ _ _ _ _ _ _ _ _ _ hci
595
+
have hv_eq : v = v' := hcvr.origV.injective hver
596
+
have hf_eq : f' = f_w := hinj.2.2.2.2
597
+
have hn_eq : n = n' := hinj.2.2.2.1
598
+
obtain ⟨fs'', hsub'', hScf⟩ := hscf'
599
+
have hScf' : ((n, v), fs'') ∈ S_CF := by rw [hn_eq, hv_eq]; exact hScf
600
+
have hf_in : f' ∈ fs'' := by rw [hf_eq]; exact hsub'' hf_w
601
+
refine ⟨hcvr.origV v, ?_, ?_⟩
602
+
· exact Finset.mem_map.mpr ⟨v, Finset.mem_singleton.mpr rfl, rfl⟩
603
+
· exact cfCompletenessWitness_feat_mem hScf' hf_in)
604
+
-- a_interFeatToInter: p = secondary cfIntermediateN_a at u,
605
+
-- m = shared cfIntermediateN p_n p_v n, vs = {origV u}.
606
+
· subst hp_eq; subst hm_eq; subst hvs_eq
607
+
rcases cfCompletenessWitness_mem_cases hp with
608
+
⟨_, _, _, _, hp_eq⟩
609
+
| ⟨_, _, _, _, _, _, hp_eq⟩
610
+
| ⟨_, _, _, _, _, _, _, _, _, _, _, hp_eq⟩
611
+
| ⟨_, _, _, _, _, _, _, _, _, _, _, _, hp_eq⟩
612
+
| ⟨_, _, _, _, _, _, _, _, _, _, _, _, _, hp_eq⟩
613
+
| ⟨p_n', p_v', f_dep', n', vs_w, fs_w, v', f_w, hdep_w, hv_w_vs, hf_w, hp_S, hscf', hπ', hp_eq⟩
614
+
all_goals first
615
+
| (exfalso; simp only [Prod.mk.injEq] at hp_eq
616
+
first
617
+
| exact (hcfi.cfIntermediateN_a_ne_granularN _ _ _ _ _ _ _) hp_eq.1
618
+
| exact (hcfi.cfIntermediateN_a_ne_cfIntermediateN _ _ _ _ _ _ _ _) hp_eq.1
619
+
| exact (hcfi.cfIntermediateN_a_ne_cfIntermediateN_f _ _ _ _ _ _ _ _ _) hp_eq.1)
620
+
| (-- Witness case 6: secondary cfIntermediateN_a at v' from entry (vs_w, fs_w).
621
+
-- Place the shared cfIntermediateN at u in Part 3b using the SAME entry; the Part 3b
622
+
-- filter conditions are identical to the Part 5 filter conditions.
623
+
simp only [Prod.mk.injEq] at hp_eq
624
+
obtain ⟨hci, hver⟩ := hp_eq
625
+
have hinj := hcfi.cfIntermediateN_a_injective _ _ _ _ _ _ _ _ _ _ hci
626
+
have hu_eq : u = v' := hcvr.origV.injective hver
627
+
have hp_n_eq : p_n = p_n' := hinj.1
628
+
have hp_v_eq : p_v = p_v' := hinj.2.1
629
+
have hfd_eq : f_dep = f_dep' := hinj.2.2.1
630
+
have hn_eq : n = n' := hinj.2.2.2.1
631
+
subst hp_n_eq; subst hp_v_eq; subst hn_eq; subst hu_eq; subst hfd_eq
632
+
refine ⟨hcvr.origV u, ?_, ?_⟩
633
+
· exact Finset.mem_map.mpr ⟨u, Finset.mem_singleton.mpr rfl, rfl⟩
634
+
· exact cfCompletenessWitness_inter_mem_a hdep_w hv_w_vs hp_S hscf' hπ')
635
+
636
+
theorem cfComplete_dep_closure :
637
+
∀ p ∈ cfCompletenessWitness (N_FC := N_FC) (V_FC := V_FC) S_CF π Δ_f Δ_a g,
638
+
∀ m vs, (p, m, vs) ∈ concurrentFeatureDeps R support Δ_f Δ_a g →
639
+
∃ v ∈ vs, (m, v) ∈ cfCompletenessWitness (N_FC := N_FC) (V_FC := V_FC) S_CF π Δ_f Δ_a g :=
640
+
fun p hp m vs hdep => cfComplete_dep_closure_aux R Δ_f Δ_a support g r S_CF π hres p hp m vs hdep
641
+
642
+
-- Helper: same granular name, same g value, use version_granularity
643
+
private theorem cfComplete_vu_granular_same
644
+
{n : N} {w1 w2 : V} {fs1 fs2 : Finset F}
645
+
(hS1 : ((n, w1), fs1) ∈ S_CF) (hS2 : ((n, w2), fs2) ∈ S_CF)
646
+
(hg : g w1 = g w2) : hcvr.origV w1 = hcvr.origV w2 := by
647
+
by_contra h_ne
648
+
have hv_ne : w1 ≠ w2 := fun h => h_ne (congrArg hcvr.origV h)
649
+
exact absurd hg (hres.version_granularity n w1 w2 fs1 fs2 hS1 hS2 hv_ne)
650
+
651
+
set_option maxHeartbeats 6400000 in
652
+
theorem cfComplete_version_unique :
653
+
VersionUnique (cfCompletenessWitness (N_FC := N_FC) (V_FC := V_FC) S_CF π Δ_f Δ_a g) := by
654
+
intro nm cv₁ cv₂ h₁ h₂
655
+
rcases cfCompletenessWitness_mem_cases h₁ with
656
+
⟨n₁, v₁, fs₁, hS₁, heq₁⟩
657
+
| ⟨n₁, v₁, fs₁, f₁, hS₁, _, heq₁⟩
658
+
| ⟨p_n₁, p_v₁, n₁, vs_w₁, fs_w₁, v₁, hdep_w₁, hv_w_vs₁, hp_S₁, hscf₁, hπ₁, heq₁⟩
659
+
| ⟨p_n₁, p_v₁, fd_w₁, n₁, vs_w₁, fs_w₁, v₁, hdep_w₁, hv_w_vs₁, hp_S₁, hscf₁, hπ₁, heq₁⟩
660
+
| ⟨p_n₁, p_v₁, n₁, vs_w₁, fs_w₁, v₁, f_w₁, hdep_w₁, hv_w_vs₁, hf_w₁, hp_S₁, hscf₁, hπ₁, heq₁⟩
661
+
| ⟨p_n₁, p_v₁, fd_w₁, n₁, vs_w₁, fs_w₁, v₁, f_w₁, hdep_w₁, hv_w_vs₁, hf_w₁, hp_S₁, hscf₁, hπ₁, heq₁⟩ <;>
662
+
rcases cfCompletenessWitness_mem_cases h₂ with
663
+
⟨n₂, v₂, fs₂, hS₂, heq₂⟩
664
+
| ⟨n₂, v₂, fs₂, f₂, hS₂, _, heq₂⟩
665
+
| ⟨p_n₂, p_v₂, n₂, vs_w₂, fs_w₂, v₂, hdep_w₂, hv_w_vs₂, hp_S₂, hscf₂, hπ₂, heq₂⟩
666
+
| ⟨p_n₂, p_v₂, fd_w₂, n₂, vs_w₂, fs_w₂, v₂, hdep_w₂, hv_w_vs₂, hp_S₂, hscf₂, hπ₂, heq₂⟩
667
+
| ⟨p_n₂, p_v₂, n₂, vs_w₂, fs_w₂, v₂, f_w₂, hdep_w₂, hv_w_vs₂, hf_w₂, hp_S₂, hscf₂, hπ₂, heq₂⟩
668
+
| ⟨p_n₂, p_v₂, fd_w₂, n₂, vs_w₂, fs_w₂, v₂, f_w₂, hdep_w₂, hv_w_vs₂, hf_w₂, hp_S₂, hscf₂, hπ₂, heq₂⟩ <;>
669
+
simp only [Prod.mk.injEq] at heq₁ heq₂ <;>
670
+
obtain ⟨h1n, rfl⟩ := heq₁ <;>
671
+
obtain ⟨h2n, rfl⟩ := heq₂ <;>
672
+
(first
673
+
| (-- granular_orig × granular_orig (must come before featured)
674
+
have ⟨hfn_eq, hg_eq⟩ := hcnm.granularN_injective (h1n.symm.trans h2n)
675
+
have hn_eq : n₁ = n₂ := Feature.FeatureName.orig.inj hfn_eq
676
+
subst hn_eq
677
+
exact cfComplete_vu_granular_same (R := R) (Δ_f := Δ_f) (Δ_a := Δ_a)
678
+
(support := support) (g := g) (r := r) (S_CF := S_CF) (π := π) hres
679
+
hS₁ hS₂ hg_eq)
680
+
| (-- granular_featured × granular_featured
681
+
have ⟨hfn_eq, hg_eq⟩ := hcnm.granularN_injective (h1n.symm.trans h2n)
682
+
have ⟨hn_eq, _⟩ := Feature.FeatureName.featured.inj hfn_eq
683
+
subst hn_eq
684
+
exact cfComplete_vu_granular_same (R := R) (Δ_f := Δ_f) (Δ_a := Δ_a)
685
+
(support := support) (g := g) (r := r) (S_CF := S_CF) (π := π) hres
686
+
hS₁ hS₂ hg_eq)
687
+
| (-- granular_orig × granular_featured or vice versa: name clash
688
+
have h := h1n.symm.trans h2n
689
+
have hfn := hcnm.granularN_injective h
690
+
cases hfn.1)
691
+
| (have h := h1n.symm.trans h2n
692
+
first
693
+
| exact absurd h (by intro hh; exact hcfi.cfIntermediateN_ne_granularN _ _ _ _ _ hh.symm)
694
+
| exact absurd h (by intro hh; exact hcfi.cfIntermediateN_f_ne_granularN _ _ _ _ _ _ hh.symm)
695
+
| exact absurd h (by intro hh; exact hcfi.cfIntermediateN_a_ne_granularN _ _ _ _ _ _ _ hh.symm)
696
+
| exact absurd h (hcfi.cfIntermediateN_ne_granularN _ _ _ _ _)
697
+
| exact absurd h (hcfi.cfIntermediateN_f_ne_granularN _ _ _ _ _ _)
698
+
| exact absurd h (hcfi.cfIntermediateN_a_ne_granularN _ _ _ _ _ _ _)
699
+
| exact absurd h (by intro hh; exact hcfi.cfIntermediateN_f_ne_cfIntermediateN _ _ _ _ _ _ _ hh)
700
+
| exact absurd h (by intro hh; exact hcfi.cfIntermediateN_f_ne_cfIntermediateN _ _ _ _ _ _ _ hh.symm)
701
+
| exact absurd h (by intro hh; exact hcfi.cfIntermediateN_a_ne_cfIntermediateN _ _ _ _ _ _ _ _ hh)
702
+
| exact absurd h (by intro hh; exact hcfi.cfIntermediateN_a_ne_cfIntermediateN _ _ _ _ _ _ _ _ hh.symm)
703
+
| exact absurd h (hcfi.cfIntermediateN_a_ne_cfIntermediateN_f _ _ _ _ _ _ _ _ _)
704
+
| exact absurd h (by intro hh; exact hcfi.cfIntermediateN_a_ne_cfIntermediateN_f _ _ _ _ _ _ _ _ _ hh.symm))
705
+
| (have hinj := hcfi.cfIntermediateN_injective _ _ _ _ _ _ (h1n.symm.trans h2n)
706
+
obtain ⟨hp_n, hp_v, hn⟩ := hinj
707
+
subst hp_n; subst hp_v; subst hn
708
+
apply cfComplete_vu_intermediate (R := R) (Δ_f := Δ_f) (Δ_a := Δ_a) (support := support)
709
+
(g := g) (r := r) (S_CF := S_CF) (π := π) hres hπ₁ hπ₂)
710
+
| (have hinj := hcfi.cfIntermediateN_f_injective _ _ _ _ _ _ _ _ (h1n.symm.trans h2n)
711
+
obtain ⟨hp_n, hp_v, hn, _⟩ := hinj
712
+
subst hp_n; subst hp_v; subst hn
713
+
have h_eq : v₁ = v₂ := hres.π_functional _ _ _ _ hπ₁ hπ₂
714
+
subst h_eq; rfl)
715
+
| (have hinj := hcfi.cfIntermediateN_a_injective _ _ _ _ _ _ _ _ _ _ (h1n.symm.trans h2n)
716
+
obtain ⟨hp_n, hp_v, _, hn, _⟩ := hinj
717
+
subst hp_n; subst hp_v; subst hn
718
+
have h_eq : v₁ = v₂ := hres.π_functional _ _ _ _ hπ₁ hπ₂
719
+
subst h_eq; rfl))
720
+
721
+
end CompletenessFields
722
+
723
+
/-! ### Completeness -/
724
+
725
+
-- Paper Thm 5.1.4 (Concurrent Feature Reduction Completeness).
726
+
theorem concurrent_feature_completeness
727
+
(R : Real N V)
728
+
(Δ_f : Feature.FeatDepRel N V F) (Δ_a : Feature.AddlDepRel N V F)
729
+
(support : Feature.Support N V F)
730
+
(g : V → G) (r : Package N V)
731
+
(S_CF : Finset (Package N V × Finset F))
732
+
(π : Finset (Package N V × Package N V))
733
+
(hres : IsConcurrentFeatureResolution R support Δ_f Δ_a g r S_CF π) :
734
+
∃ S, IsResolution
735
+
(concurrentFeatureReal R support Δ_f Δ_a g)
736
+
(concurrentFeatureDeps R support Δ_f Δ_a g)
737
+
(Concurrent.embedPkg g (Feature.embedPkg F r)) S :=
738
+
⟨cfCompletenessWitness (N_FC := N_FC) (V_FC := V_FC) S_CF π Δ_f Δ_a g,
739
+
⟨cfComplete_subset R Δ_f Δ_a support g r S_CF π hres,
740
+
cfComplete_root_mem R Δ_f Δ_a support g r S_CF π hres,
741
+
cfComplete_dep_closure R Δ_f Δ_a support g r S_CF π hres,
742
+
cfComplete_version_unique R Δ_f Δ_a support g r S_CF π hres⟩⟩
743
+
744
+
end PackageCalculus.Composition
+512
PackageCalculus/Composition/FeatureConcurrent/Reduction/Definition.lean
+512
PackageCalculus/Composition/FeatureConcurrent/Reduction/Definition.lean
···
1
+
import PackageCalculus.Composition.FeatureConcurrent.Types
2
+
import PackageCalculus.Composition.FeatureConcurrent.Definition
3
+
import PackageCalculus.Extensions.Feature.Reduction.Definition
4
+
import PackageCalculus.Extensions.Concurrent.Reduction.Definition
5
+
import Mathlib
6
+
7
+
/-! # Feature-concurrent composition: reduction
8
+
9
+
`concurrentFeatureReal` and `concurrentFeatureDeps` encode the combined feature
10
+
and concurrent problem into a core resolution problem. The encoding emits a
11
+
shared intermediate plus per-feature secondaries linked by back-edges that
12
+
enforce version alignment. -/
13
+
14
+
namespace PackageCalculus.Composition
15
+
16
+
open Classical
17
+
18
+
variable {N : Type*} [DecidableEq N] {V : Type*} [DecidableEq V]
19
+
{F : Type*} [DecidableEq F] {G : Type*} [DecidableEq G]
20
+
variable {N_FC : Type*} [DecidableEq N_FC] {V_FC : Type*} [DecidableEq V_FC]
21
+
variable [hcnm : Concurrent.HasConcurrentNames (Feature.FeatureName N F) V G N_FC]
22
+
variable [hcvr : Concurrent.HasConcurrentVersions V G V_FC]
23
+
variable [hcfi : HasConcurrentFeatureIntermediate N V F G N_FC]
24
+
25
+
set_option linter.unusedSectionVars false
26
+
27
+
/-! ### Joint feature-concurrent reduction
28
+
29
+
For each base depender-dependee pair `((p_n, p_v), n)` arising in any `Δ_f` or
30
+
`Δ_a` entry, a single shared intermediate `cfIntermediate p_n p_v n` is
31
+
introduced. The intermediate carries the full version `v` (peer-style) rather
32
+
than the granularity bucket `g(v)`, so that version uniqueness on the
33
+
intermediate pins `v` to a single element of the intersection of the sharing
34
+
entries' version sets.
35
+
36
+
For each contributing entry with version set `vs` and feature set `fs`:
37
+
* `(i, origV v) ∈ R` for each `v ∈ vs`;
38
+
* `(granular ⟨p, p_v⟩, origV p_v) Δ (i, vs.map origV)` (depender → intermediate);
39
+
* `(i, origV v) Δ (granular ⟨n, g v⟩, {origV v})` (intermediate → orig dependee) for each `v ∈ vs`;
40
+
* `(i, origV v) Δ (granular ⟨⟨n, f⟩, g v⟩, {origV v})` (intermediate → feature dependee)
41
+
for each `(v, f) ∈ vs × fs`.
42
+
43
+
The bare Concurrent reduction's `intermediateN` packages are not used by this
44
+
encoding. -/
45
+
46
+
def concurrentFeatureReal
47
+
(R : Real N V) (support : Feature.Support N V F)
48
+
(Δ_f : Feature.FeatDepRel N V F) (Δ_a : Feature.AddlDepRel N V F)
49
+
(g : V → G) : Real N_FC V_FC :=
50
+
-- Granular packages: image of the feature-level real under the concurrent embedding.
51
+
Concurrent.embedReal (Feature.featureReal R support) g ∪
52
+
-- Shared concurrent-feature intermediates from Δ_f: `(cfIntermediate p_n p_v n, origV v)`
53
+
-- for each `v ∈ vs`.
54
+
(Δ_f.biUnion (fun ⟨⟨p_n, p_v⟩, n, vs, _⟩ =>
55
+
vs.image (fun v => (hcfi.cfIntermediateN p_n p_v n, hcvr.origV v)))) ∪
56
+
-- Per-feature secondary intermediates from Δ_f: `(cfIntermediateN_f p_n p_v n f, origV v)`
57
+
-- for each `(v, f) ∈ vs × fs`.
58
+
(Δ_f.biUnion (fun ⟨⟨p_n, p_v⟩, n, vs, fs⟩ =>
59
+
vs.biUnion (fun v =>
60
+
fs.image (fun f => (hcfi.cfIntermediateN_f p_n p_v n f, hcvr.origV v))))) ∪
61
+
-- Shared concurrent-feature intermediates from Δ_a: same shape; the feature annotation `f`
62
+
-- on the depender is irrelevant -- the shared intermediate keys only on `((p_n, p_v), n)`.
63
+
(Δ_a.biUnion (fun ⟨⟨⟨p_n, p_v⟩, _⟩, n, vs, _⟩ =>
64
+
vs.image (fun v => (hcfi.cfIntermediateN p_n p_v n, hcvr.origV v)))) ∪
65
+
-- Per-feature secondary intermediates from Δ_a:
66
+
-- `(cfIntermediateN_a p_n p_v f n f', origV v)` for each `(v, f') ∈ vs × fs`.
67
+
(Δ_a.biUnion (fun ⟨⟨⟨p_n, p_v⟩, f⟩, n, vs, fs⟩ =>
68
+
vs.biUnion (fun v =>
69
+
fs.image (fun f' => (hcfi.cfIntermediateN_a p_n p_v f n f', hcvr.origV v)))))
70
+
71
+
def concurrentFeatureDeps
72
+
(R : Real N V) (support : Feature.Support N V F)
73
+
(Δ_f : Feature.FeatDepRel N V F) (Δ_a : Feature.AddlDepRel N V F)
74
+
(g : V → G) : DepRel N_FC V_FC :=
75
+
-- Feature back-deps from support:
76
+
-- `(granularN (featured n f) (g v), origV v) Δ (granularN (orig n) (g v), {origV v})`.
77
+
(support.biUnion (fun ⟨⟨n, v⟩, f⟩ =>
78
+
if (n, v) ∈ R then
79
+
{((hcnm.granularN (Feature.FeatureName.featured n f) (g v), hcvr.origV v),
80
+
hcnm.granularN (Feature.FeatureName.orig n) (g v),
81
+
(({v} : Finset V).map hcvr.origV))}
82
+
else ∅)) ∪
83
+
-- Δ_f: depender → shared intermediate, one edge per `((p_n, p_v), n, vs)` entry.
84
+
(Δ_f.biUnion (fun ⟨⟨p_n, p_v⟩, n, vs, _⟩ =>
85
+
{((hcnm.granularN (Feature.FeatureName.orig p_n) (g p_v), hcvr.origV p_v),
86
+
hcfi.cfIntermediateN p_n p_v n,
87
+
vs.map hcvr.origV)})) ∪
88
+
-- Δ_f: shared intermediate → orig dependee, one per `v ∈ vs`.
89
+
(Δ_f.biUnion (fun ⟨⟨p_n, p_v⟩, n, vs, _⟩ =>
90
+
vs.image (fun v =>
91
+
((hcfi.cfIntermediateN p_n p_v n, hcvr.origV v),
92
+
hcnm.granularN (Feature.FeatureName.orig n) (g v),
93
+
(({v} : Finset V).map hcvr.origV))))) ∪
94
+
-- Δ_f: depender → per-feature secondary intermediate, one per `f ∈ fs`.
95
+
(Δ_f.biUnion (fun ⟨⟨p_n, p_v⟩, n, vs, fs⟩ =>
96
+
fs.image (fun f =>
97
+
((hcnm.granularN (Feature.FeatureName.orig p_n) (g p_v), hcvr.origV p_v),
98
+
hcfi.cfIntermediateN_f p_n p_v n f,
99
+
vs.map hcvr.origV)))) ∪
100
+
-- Δ_f: per-feature secondary intermediate → feature dependee, one per `(v, f) ∈ vs × fs`.
101
+
(Δ_f.biUnion (fun ⟨⟨p_n, p_v⟩, n, vs, fs⟩ =>
102
+
vs.biUnion (fun v =>
103
+
fs.image (fun f =>
104
+
((hcfi.cfIntermediateN_f p_n p_v n f, hcvr.origV v),
105
+
hcnm.granularN (Feature.FeatureName.featured n f) (g v),
106
+
(({v} : Finset V).map hcvr.origV)))))) ∪
107
+
-- Δ_f: per-feature secondary intermediate → shared intermediate (back-edge for
108
+
-- version alignment), one per `(v, f) ∈ vs × fs`.
109
+
(Δ_f.biUnion (fun ⟨⟨p_n, p_v⟩, n, vs, fs⟩ =>
110
+
fs.biUnion (fun f =>
111
+
vs.image (fun u =>
112
+
((hcfi.cfIntermediateN_f p_n p_v n f, hcvr.origV u),
113
+
hcfi.cfIntermediateN p_n p_v n,
114
+
(({u} : Finset V).map hcvr.origV)))))) ∪
115
+
-- Δ_a: depender → shared intermediate.
116
+
(Δ_a.biUnion (fun ⟨⟨⟨p_n, p_v⟩, f⟩, n, vs, _⟩ =>
117
+
{((hcnm.granularN (Feature.FeatureName.featured p_n f) (g p_v), hcvr.origV p_v),
118
+
hcfi.cfIntermediateN p_n p_v n,
119
+
vs.map hcvr.origV)})) ∪
120
+
-- Δ_a: shared intermediate → orig dependee, one per `v ∈ vs`.
121
+
(Δ_a.biUnion (fun ⟨⟨⟨p_n, p_v⟩, _⟩, n, vs, _⟩ =>
122
+
vs.image (fun v =>
123
+
((hcfi.cfIntermediateN p_n p_v n, hcvr.origV v),
124
+
hcnm.granularN (Feature.FeatureName.orig n) (g v),
125
+
(({v} : Finset V).map hcvr.origV))))) ∪
126
+
-- Δ_a: depender's featured package → per-feature secondary intermediate, one per `f' ∈ fs`.
127
+
(Δ_a.biUnion (fun ⟨⟨⟨p_n, p_v⟩, f⟩, n, vs, fs⟩ =>
128
+
fs.image (fun f' =>
129
+
((hcnm.granularN (Feature.FeatureName.featured p_n f) (g p_v), hcvr.origV p_v),
130
+
hcfi.cfIntermediateN_a p_n p_v f n f',
131
+
vs.map hcvr.origV)))) ∪
132
+
-- Δ_a: per-feature secondary intermediate → feature dependee.
133
+
(Δ_a.biUnion (fun ⟨⟨⟨p_n, p_v⟩, f⟩, n, vs, fs⟩ =>
134
+
vs.biUnion (fun v =>
135
+
fs.image (fun f' =>
136
+
((hcfi.cfIntermediateN_a p_n p_v f n f', hcvr.origV v),
137
+
hcnm.granularN (Feature.FeatureName.featured n f') (g v),
138
+
(({v} : Finset V).map hcvr.origV)))))) ∪
139
+
-- Δ_a: per-feature secondary intermediate → shared intermediate (back-edge for
140
+
-- version alignment), one per `(v, f') ∈ vs × fs`.
141
+
(Δ_a.biUnion (fun ⟨⟨⟨p_n, p_v⟩, f⟩, n, vs, fs⟩ =>
142
+
fs.biUnion (fun f' =>
143
+
vs.image (fun u =>
144
+
((hcfi.cfIntermediateN_a p_n p_v f n f', hcvr.origV u),
145
+
hcfi.cfIntermediateN p_n p_v n,
146
+
(({u} : Finset V).map hcvr.origV))))))
147
+
148
+
/-! ### Membership constructors for `concurrentFeatureDeps` -/
149
+
150
+
theorem mem_cfDeps_f_depToInter
151
+
{R : Real N V} {support : Feature.Support N V F}
152
+
{Δ_f : Feature.FeatDepRel N V F} {Δ_a : Feature.AddlDepRel N V F} {g : V → G}
153
+
{p_n : N} {p_v : V} {n : N} {vs : Finset V} {fs : Finset F}
154
+
(hdep : ((p_n, p_v), n, vs, fs) ∈ Δ_f) :
155
+
((hcnm.granularN (Feature.FeatureName.orig p_n) (g p_v), hcvr.origV p_v),
156
+
hcfi.cfIntermediateN p_n p_v n,
157
+
vs.map hcvr.origV) ∈ concurrentFeatureDeps R support Δ_f Δ_a g := by
158
+
apply Finset.mem_union_left; apply Finset.mem_union_left; apply Finset.mem_union_left
159
+
apply Finset.mem_union_left; apply Finset.mem_union_left; apply Finset.mem_union_left
160
+
apply Finset.mem_union_left; apply Finset.mem_union_left; apply Finset.mem_union_left
161
+
apply Finset.mem_union_right
162
+
refine Finset.mem_biUnion.mpr ⟨⟨(p_n, p_v), n, vs, fs⟩, hdep, ?_⟩
163
+
exact Finset.mem_singleton.mpr rfl
164
+
165
+
theorem mem_cfDeps_f_interToOrig
166
+
{R : Real N V} {support : Feature.Support N V F}
167
+
{Δ_f : Feature.FeatDepRel N V F} {Δ_a : Feature.AddlDepRel N V F} {g : V → G}
168
+
{p_n : N} {p_v : V} {n : N} {vs : Finset V} {fs : Finset F} {v : V}
169
+
(hdep : ((p_n, p_v), n, vs, fs) ∈ Δ_f) (hv : v ∈ vs) :
170
+
((hcfi.cfIntermediateN p_n p_v n, hcvr.origV v),
171
+
hcnm.granularN (Feature.FeatureName.orig n) (g v),
172
+
(({v} : Finset V).map hcvr.origV)) ∈ concurrentFeatureDeps R support Δ_f Δ_a g := by
173
+
apply Finset.mem_union_left; apply Finset.mem_union_left; apply Finset.mem_union_left
174
+
apply Finset.mem_union_left; apply Finset.mem_union_left; apply Finset.mem_union_left
175
+
apply Finset.mem_union_left; apply Finset.mem_union_left
176
+
apply Finset.mem_union_right
177
+
refine Finset.mem_biUnion.mpr ⟨⟨(p_n, p_v), n, vs, fs⟩, hdep, ?_⟩
178
+
exact Finset.mem_image.mpr ⟨v, hv, rfl⟩
179
+
180
+
/-- Δ_f: depender's orig granular → per-feature secondary intermediate
181
+
`cfIntermediateN_f p_n p_v n f` for each `f ∈ fs`. -/
182
+
theorem mem_cfDeps_f_depToInterFeat
183
+
{R : Real N V} {support : Feature.Support N V F}
184
+
{Δ_f : Feature.FeatDepRel N V F} {Δ_a : Feature.AddlDepRel N V F} {g : V → G}
185
+
{p_n : N} {p_v : V} {n : N} {vs : Finset V} {fs : Finset F} {f : F}
186
+
(hdep : ((p_n, p_v), n, vs, fs) ∈ Δ_f) (hf : f ∈ fs) :
187
+
((hcnm.granularN (Feature.FeatureName.orig p_n) (g p_v), hcvr.origV p_v),
188
+
hcfi.cfIntermediateN_f p_n p_v n f,
189
+
vs.map hcvr.origV) ∈ concurrentFeatureDeps R support Δ_f Δ_a g := by
190
+
apply Finset.mem_union_left; apply Finset.mem_union_left; apply Finset.mem_union_left
191
+
apply Finset.mem_union_left; apply Finset.mem_union_left; apply Finset.mem_union_left
192
+
apply Finset.mem_union_left
193
+
apply Finset.mem_union_right
194
+
refine Finset.mem_biUnion.mpr ⟨⟨(p_n, p_v), n, vs, fs⟩, hdep, ?_⟩
195
+
exact Finset.mem_image.mpr ⟨f, hf, rfl⟩
196
+
197
+
/-- Δ_f: per-feature secondary intermediate `cfIntermediateN_f p_n p_v n f`
198
+
at `origV v` → feature granular dependee `granularN (featured n f) (g v)`. -/
199
+
theorem mem_cfDeps_f_interToFeat
200
+
{R : Real N V} {support : Feature.Support N V F}
201
+
{Δ_f : Feature.FeatDepRel N V F} {Δ_a : Feature.AddlDepRel N V F} {g : V → G}
202
+
{p_n : N} {p_v : V} {n : N} {vs : Finset V} {fs : Finset F} {v : V} {f : F}
203
+
(hdep : ((p_n, p_v), n, vs, fs) ∈ Δ_f) (hv : v ∈ vs) (hf : f ∈ fs) :
204
+
((hcfi.cfIntermediateN_f p_n p_v n f, hcvr.origV v),
205
+
hcnm.granularN (Feature.FeatureName.featured n f) (g v),
206
+
(({v} : Finset V).map hcvr.origV)) ∈ concurrentFeatureDeps R support Δ_f Δ_a g := by
207
+
apply Finset.mem_union_left; apply Finset.mem_union_left; apply Finset.mem_union_left
208
+
apply Finset.mem_union_left; apply Finset.mem_union_left; apply Finset.mem_union_left
209
+
apply Finset.mem_union_right
210
+
refine Finset.mem_biUnion.mpr ⟨⟨(p_n, p_v), n, vs, fs⟩, hdep, ?_⟩
211
+
exact Finset.mem_biUnion.mpr ⟨v, hv, Finset.mem_image.mpr ⟨f, hf, rfl⟩⟩
212
+
213
+
/-- Δ_f: per-feature secondary intermediate `cfIntermediateN_f p_n p_v n f` at `origV u`
214
+
→ shared intermediate `cfIntermediateN p_n p_v n`. Back-edge enforcing version
215
+
alignment between secondary and shared. -/
216
+
theorem mem_cfDeps_f_interFeatToInter
217
+
{R : Real N V} {support : Feature.Support N V F}
218
+
{Δ_f : Feature.FeatDepRel N V F} {Δ_a : Feature.AddlDepRel N V F} {g : V → G}
219
+
{p_n : N} {p_v : V} {n : N} {vs : Finset V} {fs : Finset F} {u : V} {f : F}
220
+
(hdep : ((p_n, p_v), n, vs, fs) ∈ Δ_f) (hu : u ∈ vs) (hf : f ∈ fs) :
221
+
((hcfi.cfIntermediateN_f p_n p_v n f, hcvr.origV u),
222
+
hcfi.cfIntermediateN p_n p_v n,
223
+
(({u} : Finset V).map hcvr.origV)) ∈ concurrentFeatureDeps R support Δ_f Δ_a g := by
224
+
apply Finset.mem_union_left; apply Finset.mem_union_left; apply Finset.mem_union_left
225
+
apply Finset.mem_union_left; apply Finset.mem_union_left
226
+
apply Finset.mem_union_right
227
+
refine Finset.mem_biUnion.mpr ⟨⟨(p_n, p_v), n, vs, fs⟩, hdep, ?_⟩
228
+
exact Finset.mem_biUnion.mpr ⟨f, hf, Finset.mem_image.mpr ⟨u, hu, rfl⟩⟩
229
+
230
+
theorem mem_cfDeps_a_depToInter
231
+
{R : Real N V} {support : Feature.Support N V F}
232
+
{Δ_f : Feature.FeatDepRel N V F} {Δ_a : Feature.AddlDepRel N V F} {g : V → G}
233
+
{p_n : N} {p_v : V} {f : F} {n : N} {vs : Finset V} {fs : Finset F}
234
+
(hdep : (((p_n, p_v), f), n, vs, fs) ∈ Δ_a) :
235
+
((hcnm.granularN (Feature.FeatureName.featured p_n f) (g p_v), hcvr.origV p_v),
236
+
hcfi.cfIntermediateN p_n p_v n,
237
+
vs.map hcvr.origV) ∈ concurrentFeatureDeps R support Δ_f Δ_a g := by
238
+
apply Finset.mem_union_left; apply Finset.mem_union_left; apply Finset.mem_union_left
239
+
apply Finset.mem_union_left
240
+
apply Finset.mem_union_right
241
+
refine Finset.mem_biUnion.mpr ⟨⟨((p_n, p_v), f), n, vs, fs⟩, hdep, ?_⟩
242
+
exact Finset.mem_singleton.mpr rfl
243
+
244
+
theorem mem_cfDeps_a_interToOrig
245
+
{R : Real N V} {support : Feature.Support N V F}
246
+
{Δ_f : Feature.FeatDepRel N V F} {Δ_a : Feature.AddlDepRel N V F} {g : V → G}
247
+
{p_n : N} {p_v : V} {f : F} {n : N} {vs : Finset V} {fs : Finset F} {v : V}
248
+
(hdep : (((p_n, p_v), f), n, vs, fs) ∈ Δ_a) (hv : v ∈ vs) :
249
+
((hcfi.cfIntermediateN p_n p_v n, hcvr.origV v),
250
+
hcnm.granularN (Feature.FeatureName.orig n) (g v),
251
+
(({v} : Finset V).map hcvr.origV)) ∈ concurrentFeatureDeps R support Δ_f Δ_a g := by
252
+
apply Finset.mem_union_left; apply Finset.mem_union_left; apply Finset.mem_union_left
253
+
apply Finset.mem_union_right
254
+
refine Finset.mem_biUnion.mpr ⟨⟨((p_n, p_v), f), n, vs, fs⟩, hdep, ?_⟩
255
+
exact Finset.mem_image.mpr ⟨v, hv, rfl⟩
256
+
257
+
/-- Δ_a: depender's featured granular `(featured p_n f, g p_v)` → per-feature secondary
258
+
intermediate `cfIntermediateN_a p_n p_v f n f'` for each `f' ∈ fs`. -/
259
+
theorem mem_cfDeps_a_depToInterFeat
260
+
{R : Real N V} {support : Feature.Support N V F}
261
+
{Δ_f : Feature.FeatDepRel N V F} {Δ_a : Feature.AddlDepRel N V F} {g : V → G}
262
+
{p_n : N} {p_v : V} {f : F} {n : N} {vs : Finset V} {fs : Finset F} {f' : F}
263
+
(hdep : (((p_n, p_v), f), n, vs, fs) ∈ Δ_a) (hf' : f' ∈ fs) :
264
+
((hcnm.granularN (Feature.FeatureName.featured p_n f) (g p_v), hcvr.origV p_v),
265
+
hcfi.cfIntermediateN_a p_n p_v f n f',
266
+
vs.map hcvr.origV) ∈ concurrentFeatureDeps R support Δ_f Δ_a g := by
267
+
apply Finset.mem_union_left; apply Finset.mem_union_left
268
+
apply Finset.mem_union_right
269
+
refine Finset.mem_biUnion.mpr ⟨⟨((p_n, p_v), f), n, vs, fs⟩, hdep, ?_⟩
270
+
exact Finset.mem_image.mpr ⟨f', hf', rfl⟩
271
+
272
+
/-- Δ_a: per-feature secondary intermediate `cfIntermediateN_a p_n p_v f n f'` at `origV v`
273
+
→ feature granular dependee `granularN (featured n f') (g v)`. -/
274
+
theorem mem_cfDeps_a_interToFeat
275
+
{R : Real N V} {support : Feature.Support N V F}
276
+
{Δ_f : Feature.FeatDepRel N V F} {Δ_a : Feature.AddlDepRel N V F} {g : V → G}
277
+
{p_n : N} {p_v : V} {f : F} {n : N} {vs : Finset V} {fs : Finset F} {v : V} {f' : F}
278
+
(hdep : (((p_n, p_v), f), n, vs, fs) ∈ Δ_a) (hv : v ∈ vs) (hf' : f' ∈ fs) :
279
+
((hcfi.cfIntermediateN_a p_n p_v f n f', hcvr.origV v),
280
+
hcnm.granularN (Feature.FeatureName.featured n f') (g v),
281
+
(({v} : Finset V).map hcvr.origV)) ∈ concurrentFeatureDeps R support Δ_f Δ_a g := by
282
+
apply Finset.mem_union_left
283
+
apply Finset.mem_union_right
284
+
refine Finset.mem_biUnion.mpr ⟨⟨((p_n, p_v), f), n, vs, fs⟩, hdep, ?_⟩
285
+
exact Finset.mem_biUnion.mpr ⟨v, hv, Finset.mem_image.mpr ⟨f', hf', rfl⟩⟩
286
+
287
+
/-- Δ_a: per-feature secondary intermediate `cfIntermediateN_a p_n p_v f n f'` at `origV u`
288
+
→ shared intermediate `cfIntermediateN p_n p_v n`. Back-edge enforcing version
289
+
alignment between secondary and shared. -/
290
+
theorem mem_cfDeps_a_interFeatToInter
291
+
{R : Real N V} {support : Feature.Support N V F}
292
+
{Δ_f : Feature.FeatDepRel N V F} {Δ_a : Feature.AddlDepRel N V F} {g : V → G}
293
+
{p_n : N} {p_v : V} {f : F} {n : N} {vs : Finset V} {fs : Finset F} {u : V} {f' : F}
294
+
(hdep : (((p_n, p_v), f), n, vs, fs) ∈ Δ_a) (hu : u ∈ vs) (hf' : f' ∈ fs) :
295
+
((hcfi.cfIntermediateN_a p_n p_v f n f', hcvr.origV u),
296
+
hcfi.cfIntermediateN p_n p_v n,
297
+
(({u} : Finset V).map hcvr.origV)) ∈ concurrentFeatureDeps R support Δ_f Δ_a g := by
298
+
apply Finset.mem_union_right
299
+
refine Finset.mem_biUnion.mpr ⟨⟨((p_n, p_v), f), n, vs, fs⟩, hdep, ?_⟩
300
+
exact Finset.mem_biUnion.mpr ⟨f', hf', Finset.mem_image.mpr ⟨u, hu, rfl⟩⟩
301
+
302
+
/-! ### Membership constructors for `concurrentFeatureReal` -/
303
+
304
+
theorem mem_cfReal_inter_f
305
+
{R : Real N V} {support : Feature.Support N V F}
306
+
{Δ_f : Feature.FeatDepRel N V F} {Δ_a : Feature.AddlDepRel N V F} {g : V → G}
307
+
{p_n : N} {p_v : V} {n : N} {vs : Finset V} {fs : Finset F} {v : V}
308
+
(hdep : ((p_n, p_v), n, vs, fs) ∈ Δ_f) (hv : v ∈ vs) :
309
+
(hcfi.cfIntermediateN p_n p_v n, hcvr.origV v) ∈
310
+
concurrentFeatureReal R support Δ_f Δ_a g := by
311
+
apply Finset.mem_union_left; apply Finset.mem_union_left; apply Finset.mem_union_left
312
+
apply Finset.mem_union_right
313
+
refine Finset.mem_biUnion.mpr ⟨⟨(p_n, p_v), n, vs, fs⟩, hdep, ?_⟩
314
+
exact Finset.mem_image.mpr ⟨v, hv, rfl⟩
315
+
316
+
/-- Per-feature secondary intermediate `cfIntermediateN_f p_n p_v n f` is in `R` for each
317
+
`(v, f) ∈ vs × fs` of a Δ_f entry. -/
318
+
theorem mem_cfReal_inter_f_feat
319
+
{R : Real N V} {support : Feature.Support N V F}
320
+
{Δ_f : Feature.FeatDepRel N V F} {Δ_a : Feature.AddlDepRel N V F} {g : V → G}
321
+
{p_n : N} {p_v : V} {n : N} {vs : Finset V} {fs : Finset F} {v : V} {f : F}
322
+
(hdep : ((p_n, p_v), n, vs, fs) ∈ Δ_f) (hv : v ∈ vs) (hf : f ∈ fs) :
323
+
(hcfi.cfIntermediateN_f p_n p_v n f, hcvr.origV v) ∈
324
+
concurrentFeatureReal R support Δ_f Δ_a g := by
325
+
apply Finset.mem_union_left; apply Finset.mem_union_left
326
+
apply Finset.mem_union_right
327
+
refine Finset.mem_biUnion.mpr ⟨⟨(p_n, p_v), n, vs, fs⟩, hdep, ?_⟩
328
+
exact Finset.mem_biUnion.mpr ⟨v, hv, Finset.mem_image.mpr ⟨f, hf, rfl⟩⟩
329
+
330
+
theorem mem_cfReal_inter_a
331
+
{R : Real N V} {support : Feature.Support N V F}
332
+
{Δ_f : Feature.FeatDepRel N V F} {Δ_a : Feature.AddlDepRel N V F} {g : V → G}
333
+
{p_n : N} {p_v : V} {f : F} {n : N} {vs : Finset V} {fs : Finset F} {v : V}
334
+
(hdep : (((p_n, p_v), f), n, vs, fs) ∈ Δ_a) (hv : v ∈ vs) :
335
+
(hcfi.cfIntermediateN p_n p_v n, hcvr.origV v) ∈
336
+
concurrentFeatureReal R support Δ_f Δ_a g := by
337
+
apply Finset.mem_union_left
338
+
apply Finset.mem_union_right
339
+
refine Finset.mem_biUnion.mpr ⟨⟨((p_n, p_v), f), n, vs, fs⟩, hdep, ?_⟩
340
+
exact Finset.mem_image.mpr ⟨v, hv, rfl⟩
341
+
342
+
/-- Per-feature secondary intermediate `cfIntermediateN_a p_n p_v f n f'` is in `R` for each
343
+
`(v, f') ∈ vs × fs` of a Δ_a entry. -/
344
+
theorem mem_cfReal_inter_a_feat
345
+
{R : Real N V} {support : Feature.Support N V F}
346
+
{Δ_f : Feature.FeatDepRel N V F} {Δ_a : Feature.AddlDepRel N V F} {g : V → G}
347
+
{p_n : N} {p_v : V} {f : F} {n : N} {vs : Finset V} {fs : Finset F} {v : V} {f' : F}
348
+
(hdep : (((p_n, p_v), f), n, vs, fs) ∈ Δ_a) (hv : v ∈ vs) (hf' : f' ∈ fs) :
349
+
(hcfi.cfIntermediateN_a p_n p_v f n f', hcvr.origV v) ∈
350
+
concurrentFeatureReal R support Δ_f Δ_a g := by
351
+
apply Finset.mem_union_right
352
+
refine Finset.mem_biUnion.mpr ⟨⟨((p_n, p_v), f), n, vs, fs⟩, hdep, ?_⟩
353
+
exact Finset.mem_biUnion.mpr ⟨v, hv, Finset.mem_image.mpr ⟨f', hf', rfl⟩⟩
354
+
355
+
/-! ### Reverse membership for `concurrentFeatureDeps` -/
356
+
357
+
theorem concurrentFeatureDeps_mem_cases
358
+
{R : Real N V} {support : Feature.Support N V F}
359
+
{Δ_f : Feature.FeatDepRel N V F} {Δ_a : Feature.AddlDepRel N V F}
360
+
{g : V → G}
361
+
{p : Package N_FC V_FC} {m : N_FC} {vs : Finset V_FC}
362
+
(h : (p, m, vs) ∈ concurrentFeatureDeps R support Δ_f Δ_a g) :
363
+
-- supp_back
364
+
(∃ n v f, (n, v) ∈ R ∧ ((n, v), f) ∈ support ∧
365
+
p = (hcnm.granularN (Feature.FeatureName.featured n f) (g v), hcvr.origV v) ∧
366
+
m = hcnm.granularN (Feature.FeatureName.orig n) (g v) ∧
367
+
vs = ({v} : Finset V).map hcvr.origV) ∨
368
+
-- f_depToInter
369
+
(∃ p_n p_v n vs_raw fs, ((p_n, p_v), n, vs_raw, fs) ∈ Δ_f ∧
370
+
p = (hcnm.granularN (Feature.FeatureName.orig p_n) (g p_v), hcvr.origV p_v) ∧
371
+
m = hcfi.cfIntermediateN p_n p_v n ∧
372
+
vs = vs_raw.map hcvr.origV) ∨
373
+
-- f_interToOrig
374
+
(∃ p_n p_v n vs_raw fs v, ((p_n, p_v), n, vs_raw, fs) ∈ Δ_f ∧ v ∈ vs_raw ∧
375
+
p = (hcfi.cfIntermediateN p_n p_v n, hcvr.origV v) ∧
376
+
m = hcnm.granularN (Feature.FeatureName.orig n) (g v) ∧
377
+
vs = ({v} : Finset V).map hcvr.origV) ∨
378
+
-- f_depToInterFeat
379
+
(∃ p_n p_v n vs_raw fs f, ((p_n, p_v), n, vs_raw, fs) ∈ Δ_f ∧ f ∈ fs ∧
380
+
p = (hcnm.granularN (Feature.FeatureName.orig p_n) (g p_v), hcvr.origV p_v) ∧
381
+
m = hcfi.cfIntermediateN_f p_n p_v n f ∧
382
+
vs = vs_raw.map hcvr.origV) ∨
383
+
-- f_interToFeat
384
+
(∃ p_n p_v n vs_raw fs v f, ((p_n, p_v), n, vs_raw, fs) ∈ Δ_f ∧ v ∈ vs_raw ∧ f ∈ fs ∧
385
+
p = (hcfi.cfIntermediateN_f p_n p_v n f, hcvr.origV v) ∧
386
+
m = hcnm.granularN (Feature.FeatureName.featured n f) (g v) ∧
387
+
vs = ({v} : Finset V).map hcvr.origV) ∨
388
+
-- f_interFeatToInter (back-edge)
389
+
(∃ p_n p_v n vs_raw fs u f, ((p_n, p_v), n, vs_raw, fs) ∈ Δ_f ∧ u ∈ vs_raw ∧ f ∈ fs ∧
390
+
p = (hcfi.cfIntermediateN_f p_n p_v n f, hcvr.origV u) ∧
391
+
m = hcfi.cfIntermediateN p_n p_v n ∧
392
+
vs = ({u} : Finset V).map hcvr.origV) ∨
393
+
-- a_depToInter
394
+
(∃ p_n p_v f n vs_raw fs, (((p_n, p_v), f), n, vs_raw, fs) ∈ Δ_a ∧
395
+
p = (hcnm.granularN (Feature.FeatureName.featured p_n f) (g p_v), hcvr.origV p_v) ∧
396
+
m = hcfi.cfIntermediateN p_n p_v n ∧
397
+
vs = vs_raw.map hcvr.origV) ∨
398
+
-- a_interToOrig
399
+
(∃ p_n p_v f_dep n vs_raw fs v, (((p_n, p_v), f_dep), n, vs_raw, fs) ∈ Δ_a ∧ v ∈ vs_raw ∧
400
+
p = (hcfi.cfIntermediateN p_n p_v n, hcvr.origV v) ∧
401
+
m = hcnm.granularN (Feature.FeatureName.orig n) (g v) ∧
402
+
vs = ({v} : Finset V).map hcvr.origV) ∨
403
+
-- a_depToInterFeat
404
+
(∃ p_n p_v f_dep n vs_raw fs f', (((p_n, p_v), f_dep), n, vs_raw, fs) ∈ Δ_a ∧ f' ∈ fs ∧
405
+
p = (hcnm.granularN (Feature.FeatureName.featured p_n f_dep) (g p_v), hcvr.origV p_v) ∧
406
+
m = hcfi.cfIntermediateN_a p_n p_v f_dep n f' ∧
407
+
vs = vs_raw.map hcvr.origV) ∨
408
+
-- a_interToFeat
409
+
(∃ p_n p_v f_dep n vs_raw fs v f', (((p_n, p_v), f_dep), n, vs_raw, fs) ∈ Δ_a ∧
410
+
v ∈ vs_raw ∧ f' ∈ fs ∧
411
+
p = (hcfi.cfIntermediateN_a p_n p_v f_dep n f', hcvr.origV v) ∧
412
+
m = hcnm.granularN (Feature.FeatureName.featured n f') (g v) ∧
413
+
vs = ({v} : Finset V).map hcvr.origV) ∨
414
+
-- a_interFeatToInter (back-edge)
415
+
(∃ p_n p_v f_dep n vs_raw fs u f', (((p_n, p_v), f_dep), n, vs_raw, fs) ∈ Δ_a ∧
416
+
u ∈ vs_raw ∧ f' ∈ fs ∧
417
+
p = (hcfi.cfIntermediateN_a p_n p_v f_dep n f', hcvr.origV u) ∧
418
+
m = hcfi.cfIntermediateN p_n p_v n ∧
419
+
vs = ({u} : Finset V).map hcvr.origV) := by
420
+
simp only [concurrentFeatureDeps, Finset.mem_union, Finset.mem_biUnion, Finset.mem_image,
421
+
Finset.mem_singleton] at h
422
+
rcases h with (((((((((h | h) | h) | h) | h) | h) | h) | h) | h) | h) | h
423
+
· -- supp_back
424
+
left
425
+
obtain ⟨⟨⟨n, v⟩, f⟩, hsupp, hmem⟩ := h
426
+
simp only at hmem
427
+
split_ifs at hmem with hR
428
+
· simp only [Finset.mem_singleton, Prod.mk.injEq] at hmem
429
+
obtain ⟨hp, hm, hvs⟩ := hmem
430
+
subst hp; subst hm; subst hvs
431
+
exact ⟨n, v, f, hR, hsupp, rfl, rfl, rfl⟩
432
+
· exact absurd hmem (Finset.notMem_empty _)
433
+
· -- f_depToInter
434
+
right; left
435
+
obtain ⟨⟨⟨p_n, p_v⟩, n, vs_raw, fs⟩, hdep, heq⟩ := h
436
+
simp only [Prod.mk.injEq] at heq
437
+
obtain ⟨hp, hm, hvs⟩ := heq
438
+
subst hp; subst hm; subst hvs
439
+
exact ⟨p_n, p_v, n, vs_raw, fs, hdep, rfl, rfl, rfl⟩
440
+
· -- f_interToOrig
441
+
right; right; left
442
+
obtain ⟨⟨⟨p_n, p_v⟩, n, vs_raw, fs⟩, hdep, v, hv, heq⟩ := h
443
+
simp only at hv
444
+
simp only [Prod.mk.injEq] at heq
445
+
obtain ⟨hp, hm, hvs⟩ := heq
446
+
subst hp; subst hm; subst hvs
447
+
exact ⟨p_n, p_v, n, vs_raw, fs, v, hdep, hv, rfl, rfl, rfl⟩
448
+
· -- f_depToInterFeat
449
+
right; right; right; left
450
+
obtain ⟨⟨⟨p_n, p_v⟩, n, vs_raw, fs⟩, hdep, f, hf, heq⟩ := h
451
+
simp only at hf
452
+
simp only [Prod.mk.injEq] at heq
453
+
obtain ⟨hp, hm, hvs⟩ := heq
454
+
subst hp; subst hm; subst hvs
455
+
exact ⟨p_n, p_v, n, vs_raw, fs, f, hdep, hf, rfl, rfl, rfl⟩
456
+
· -- f_interToFeat
457
+
right; right; right; right; left
458
+
obtain ⟨⟨⟨p_n, p_v⟩, n, vs_raw, fs⟩, hdep, v, hv, f, hf, heq⟩ := h
459
+
simp only at hv hf
460
+
simp only [Prod.mk.injEq] at heq
461
+
obtain ⟨hp, hm, hvs⟩ := heq
462
+
subst hp; subst hm; subst hvs
463
+
exact ⟨p_n, p_v, n, vs_raw, fs, v, f, hdep, hv, hf, rfl, rfl, rfl⟩
464
+
· -- f_interFeatToInter
465
+
right; right; right; right; right; left
466
+
obtain ⟨⟨⟨p_n, p_v⟩, n, vs_raw, fs⟩, hdep, f, hf, u, hu, heq⟩ := h
467
+
simp only at hf hu
468
+
simp only [Prod.mk.injEq] at heq
469
+
obtain ⟨hp, hm, hvs⟩ := heq
470
+
subst hp; subst hm; subst hvs
471
+
exact ⟨p_n, p_v, n, vs_raw, fs, u, f, hdep, hu, hf, rfl, rfl, rfl⟩
472
+
· -- a_depToInter
473
+
right; right; right; right; right; right; left
474
+
obtain ⟨⟨⟨⟨p_n, p_v⟩, f⟩, n, vs_raw, fs⟩, hdep, heq⟩ := h
475
+
simp only [Prod.mk.injEq] at heq
476
+
obtain ⟨hp, hm, hvs⟩ := heq
477
+
subst hp; subst hm; subst hvs
478
+
exact ⟨p_n, p_v, f, n, vs_raw, fs, hdep, rfl, rfl, rfl⟩
479
+
· -- a_interToOrig
480
+
right; right; right; right; right; right; right; left
481
+
obtain ⟨⟨⟨⟨p_n, p_v⟩, f⟩, n, vs_raw, fs⟩, hdep, v, hv, heq⟩ := h
482
+
simp only at hv
483
+
simp only [Prod.mk.injEq] at heq
484
+
obtain ⟨hp, hm, hvs⟩ := heq
485
+
subst hp; subst hm; subst hvs
486
+
exact ⟨p_n, p_v, f, n, vs_raw, fs, v, hdep, hv, rfl, rfl, rfl⟩
487
+
· -- a_depToInterFeat
488
+
right; right; right; right; right; right; right; right; left
489
+
obtain ⟨⟨⟨⟨p_n, p_v⟩, f⟩, n, vs_raw, fs⟩, hdep, f', hf', heq⟩ := h
490
+
simp only at hf'
491
+
simp only [Prod.mk.injEq] at heq
492
+
obtain ⟨hp, hm, hvs⟩ := heq
493
+
subst hp; subst hm; subst hvs
494
+
exact ⟨p_n, p_v, f, n, vs_raw, fs, f', hdep, hf', rfl, rfl, rfl⟩
495
+
· -- a_interToFeat
496
+
right; right; right; right; right; right; right; right; right; left
497
+
obtain ⟨⟨⟨⟨p_n, p_v⟩, f⟩, n, vs_raw, fs⟩, hdep, v, hv, f', hf', heq⟩ := h
498
+
simp only at hv hf'
499
+
simp only [Prod.mk.injEq] at heq
500
+
obtain ⟨hp, hm, hvs⟩ := heq
501
+
subst hp; subst hm; subst hvs
502
+
exact ⟨p_n, p_v, f, n, vs_raw, fs, v, f', hdep, hv, hf', rfl, rfl, rfl⟩
503
+
· -- a_interFeatToInter
504
+
right; right; right; right; right; right; right; right; right; right
505
+
obtain ⟨⟨⟨⟨p_n, p_v⟩, f⟩, n, vs_raw, fs⟩, hdep, f', hf', u, hu, heq⟩ := h
506
+
simp only at hf' hu
507
+
simp only [Prod.mk.injEq] at heq
508
+
obtain ⟨hp, hm, hvs⟩ := heq
509
+
subst hp; subst hm; subst hvs
510
+
exact ⟨p_n, p_v, f, n, vs_raw, fs, u, f', hdep, hu, hf', rfl, rfl, rfl⟩
511
+
512
+
end PackageCalculus.Composition
+460
PackageCalculus/Composition/FeatureConcurrent/Reduction/Soundness.lean
+460
PackageCalculus/Composition/FeatureConcurrent/Reduction/Soundness.lean
···
1
+
import PackageCalculus.Composition.FeatureConcurrent.Types
2
+
import PackageCalculus.Composition.FeatureConcurrent.Definition
3
+
import PackageCalculus.Composition.FeatureConcurrent.Reduction.Definition
4
+
import PackageCalculus.Extensions.Feature.Definition
5
+
import PackageCalculus.Extensions.Feature.Reduction.Definition
6
+
import PackageCalculus.Extensions.Feature.Reduction.Soundness
7
+
import PackageCalculus.Extensions.Concurrent.Definition
8
+
import PackageCalculus.Extensions.Concurrent.Reduction.Definition
9
+
import PackageCalculus.Extensions.Concurrent.Reduction.Soundness
10
+
import Mathlib
11
+
12
+
/-! # Feature-concurrent composition: soundness
13
+
14
+
Any core resolution of the feature-concurrent encoding projects back to a
15
+
valid `IsConcurrentFeatureResolution` of the original problem. -/
16
+
17
+
namespace PackageCalculus.Composition
18
+
19
+
open Classical
20
+
21
+
variable {N : Type*} [DecidableEq N] {V : Type*} [DecidableEq V]
22
+
{F : Type*} [DecidableEq F] {G : Type*} [DecidableEq G]
23
+
variable {N_FC : Type*} [DecidableEq N_FC] {V_FC : Type*} [DecidableEq V_FC]
24
+
variable [hcnm : Concurrent.HasConcurrentNames (Feature.FeatureName N F) V G N_FC]
25
+
variable [hcvr : Concurrent.HasConcurrentVersions V G V_FC]
26
+
variable [hcfi : HasConcurrentFeatureIntermediate N V F G N_FC]
27
+
28
+
set_option linter.unusedSectionVars false
29
+
30
+
/-! ### Witness Constructions -/
31
+
32
+
/-- Combined embedding: maps `(n, v) : Package N V` to the granular origN package. -/
33
+
def cfEmbedOrigPkg (g : V → G) (p : Package N V) : Package N_FC V_FC :=
34
+
(hcnm.granularN (@Feature.FeatureName.orig N F p.1) (g p.2), hcvr.origV p.2)
35
+
36
+
theorem cfEmbedOrigPkg_injective (g : V → G) :
37
+
Function.Injective (cfEmbedOrigPkg (hcnm := hcnm) (hcvr := hcvr) g :
38
+
Package N V → Package N_FC V_FC) := by
39
+
intro ⟨n₁, v₁⟩ ⟨n₂, v₂⟩ h
40
+
simp only [cfEmbedOrigPkg, Prod.mk.injEq] at h
41
+
obtain ⟨h1, h2⟩ := h
42
+
have ⟨hfn, _⟩ := hcnm.granularN_injective h1
43
+
exact Prod.ext (Feature.FeatureName.orig.inj hfn) (hcvr.origV.injective h2)
44
+
45
+
/-- Soundness witness `S_CF`. Extracts `((n, v), fs)` entries by collecting orig granular
46
+
packages in `S` and gathering their feature companions. -/
47
+
noncomputable def cfSoundnessWitnessS [Fintype F] (g : V → G)
48
+
(S : Finset (Package N_FC V_FC)) : Finset (Package N V × Finset F) :=
49
+
(S.preimage (cfEmbedOrigPkg (F := F) g) (Set.InjOn.mono (Set.subset_univ _)
50
+
(cfEmbedOrigPkg_injective (F := F) g).injOn)).image
51
+
(fun ⟨n, v⟩ =>
52
+
((n, v), Finset.univ.filter (fun f =>
53
+
(hcnm.granularN (Feature.FeatureName.featured n f) (g v), hcvr.origV v) ∈ S)))
54
+
55
+
/-- Soundness witness `π`. Extracts `((n, v), (p_n, p_v))` entries from the shared
56
+
intermediate constructor: each cfIntermediate package present in `S` records a single
57
+
parent relationship `((n, v), (p_n, p_v))`. -/
58
+
def cfSoundnessWitnessπ
59
+
(Δ_f : Feature.FeatDepRel N V F) (Δ_a : Feature.AddlDepRel N V F)
60
+
(g : V → G) (S : Finset (Package N_FC V_FC)) :
61
+
Finset (Package N V × Package N V) :=
62
+
-- For each Δ_f entry, gather versions v ∈ vs where the shared intermediate witnesses S.
63
+
Δ_f.biUnion (fun ⟨⟨p_n, p_v⟩, n, vs, _⟩ =>
64
+
(vs.filter (fun v =>
65
+
(hcfi.cfIntermediateN p_n p_v n, hcvr.origV v) ∈ S ∧
66
+
(hcnm.granularN (Feature.FeatureName.orig n) (g v), hcvr.origV v) ∈ S)).image
67
+
(fun v => ((n, v), (p_n, p_v)))) ∪
68
+
Δ_a.biUnion (fun ⟨⟨⟨p_n, p_v⟩, _⟩, n, vs, _⟩ =>
69
+
(vs.filter (fun v =>
70
+
(hcfi.cfIntermediateN p_n p_v n, hcvr.origV v) ∈ S ∧
71
+
(hcnm.granularN (Feature.FeatureName.orig n) (g v), hcvr.origV v) ∈ S)).image
72
+
(fun v => ((n, v), (p_n, p_v))))
73
+
74
+
/-! ### Witness Membership Helpers -/
75
+
76
+
theorem mem_cfSoundnessWitnessS [Fintype F] {g : V → G}
77
+
{S : Finset (Package N_FC V_FC)} {p : Package N V × Finset F}
78
+
(h : p ∈ cfSoundnessWitnessS (N := N) (F := F) g S) :
79
+
∃ n v, (hcnm.granularN (Feature.FeatureName.orig n) (g v), hcvr.origV v) ∈ S ∧
80
+
p = ((n, v), Finset.univ.filter (fun f =>
81
+
(hcnm.granularN (Feature.FeatureName.featured n f) (g v), hcvr.origV v) ∈ S)) := by
82
+
simp only [cfSoundnessWitnessS, Finset.mem_image, Finset.mem_preimage, cfEmbedOrigPkg] at h
83
+
obtain ⟨⟨n, v⟩, hmem, rfl⟩ := h
84
+
exact ⟨n, v, hmem, rfl⟩
85
+
86
+
theorem mem_cfSoundnessWitnessS_of [Fintype F] {g : V → G}
87
+
{S : Finset (Package N_FC V_FC)} {n : N} {v : V}
88
+
(h : (hcnm.granularN (Feature.FeatureName.orig n) (g v), hcvr.origV v) ∈ S) :
89
+
((n, v), Finset.univ.filter (fun f =>
90
+
(hcnm.granularN (Feature.FeatureName.featured n f) (g v), hcvr.origV v) ∈ S)) ∈
91
+
cfSoundnessWitnessS (N := N) (F := F) g S := by
92
+
simp only [cfSoundnessWitnessS, Finset.mem_image, Finset.mem_preimage, cfEmbedOrigPkg]
93
+
exact ⟨(n, v), h, rfl⟩
94
+
95
+
theorem mem_cfSoundnessWitnessπ {Δ_f : Feature.FeatDepRel N V F}
96
+
{Δ_a : Feature.AddlDepRel N V F} {g : V → G}
97
+
{S : Finset (Package N_FC V_FC)} {pair : Package N V × Package N V}
98
+
(h : pair ∈ cfSoundnessWitnessπ Δ_f Δ_a g S) :
99
+
(∃ p_n p_v n vs fs v, ((p_n, p_v), n, vs, fs) ∈ Δ_f ∧ v ∈ vs ∧
100
+
(hcfi.cfIntermediateN p_n p_v n, hcvr.origV v) ∈ S ∧
101
+
(hcnm.granularN (Feature.FeatureName.orig n) (g v), hcvr.origV v) ∈ S ∧
102
+
pair = ((n, v), (p_n, p_v))) ∨
103
+
(∃ p_n p_v f n vs fs v, (((p_n, p_v), f), n, vs, fs) ∈ Δ_a ∧ v ∈ vs ∧
104
+
(hcfi.cfIntermediateN p_n p_v n, hcvr.origV v) ∈ S ∧
105
+
(hcnm.granularN (Feature.FeatureName.orig n) (g v), hcvr.origV v) ∈ S ∧
106
+
pair = ((n, v), (p_n, p_v))) := by
107
+
simp only [cfSoundnessWitnessπ, Finset.mem_union, Finset.mem_biUnion, Finset.mem_image,
108
+
Finset.mem_filter] at h
109
+
rcases h with ⟨⟨⟨p_n, p_v⟩, n, vs, fs⟩, hdep, v, ⟨hv, h1, h2⟩, rfl⟩ |
110
+
⟨⟨⟨⟨p_n, p_v⟩, f⟩, n, vs, fs⟩, hdep, v, ⟨hv, h1, h2⟩, rfl⟩
111
+
· left; exact ⟨p_n, p_v, n, vs, fs, v, hdep, hv, h1, h2, rfl⟩
112
+
· right; exact ⟨p_n, p_v, f, n, vs, fs, v, hdep, hv, h1, h2, rfl⟩
113
+
114
+
theorem mem_cfSoundnessWitnessπ_f {Δ_f : Feature.FeatDepRel N V F}
115
+
{Δ_a : Feature.AddlDepRel N V F} {g : V → G}
116
+
{S : Finset (Package N_FC V_FC)}
117
+
{p_n : N} {p_v : V} {n : N} {vs : Finset V} {fs : Finset F} {v : V}
118
+
(hdep : ((p_n, p_v), n, vs, fs) ∈ Δ_f) (hv : v ∈ vs)
119
+
(h1 : (hcfi.cfIntermediateN p_n p_v n, hcvr.origV v) ∈ S)
120
+
(h2 : (hcnm.granularN (Feature.FeatureName.orig n) (g v), hcvr.origV v) ∈ S) :
121
+
((n, v), (p_n, p_v)) ∈ cfSoundnessWitnessπ Δ_f Δ_a g S := by
122
+
simp only [cfSoundnessWitnessπ, Finset.mem_union, Finset.mem_biUnion, Finset.mem_image,
123
+
Finset.mem_filter]
124
+
left
125
+
exact ⟨⟨⟨p_n, p_v⟩, n, vs, fs⟩, hdep, v, ⟨hv, h1, h2⟩, rfl⟩
126
+
127
+
theorem mem_cfSoundnessWitnessπ_a {Δ_f : Feature.FeatDepRel N V F}
128
+
{Δ_a : Feature.AddlDepRel N V F} {g : V → G}
129
+
{S : Finset (Package N_FC V_FC)}
130
+
{p_n : N} {p_v : V} {f : F} {n : N} {vs : Finset V} {fs : Finset F} {v : V}
131
+
(hdep : (((p_n, p_v), f), n, vs, fs) ∈ Δ_a) (hv : v ∈ vs)
132
+
(h1 : (hcfi.cfIntermediateN p_n p_v n, hcvr.origV v) ∈ S)
133
+
(h2 : (hcnm.granularN (Feature.FeatureName.orig n) (g v), hcvr.origV v) ∈ S) :
134
+
((n, v), (p_n, p_v)) ∈ cfSoundnessWitnessπ Δ_f Δ_a g S := by
135
+
simp only [cfSoundnessWitnessπ, Finset.mem_union, Finset.mem_biUnion, Finset.mem_image,
136
+
Finset.mem_filter]
137
+
right
138
+
exact ⟨⟨⟨⟨p_n, p_v⟩, f⟩, n, vs, fs⟩, hdep, v, ⟨hv, h1, h2⟩, rfl⟩
139
+
140
+
/-! ### Soundness Field Lemmas -/
141
+
142
+
section SoundnessFields
143
+
144
+
variable [Fintype F]
145
+
variable (R : Real N V) (support : Feature.Support N V F)
146
+
(Δ_f : Feature.FeatDepRel N V F) (Δ_a : Feature.AddlDepRel N V F)
147
+
(g : V → G) (r : Package N V) (S : Finset (Package N_FC V_FC))
148
+
(hres : IsResolution
149
+
(concurrentFeatureReal R support Δ_f Δ_a g)
150
+
(concurrentFeatureDeps R support Δ_f Δ_a g)
151
+
(Concurrent.embedPkg g (Feature.embedPkg F r)) S)
152
+
(hroot_no_support : ∀ f, (r, f) ∉ support)
153
+
154
+
include hres hroot_no_support
155
+
156
+
omit hroot_no_support in
157
+
theorem cfSound_subset :
158
+
∀ p fs, (p, fs) ∈ cfSoundnessWitnessS (N := N) (F := F) g S → p ∈ R := by
159
+
intro p fs hp;
160
+
obtain ⟨ n, v, hnv, hp ⟩ := mem_cfSoundnessWitnessS hp;
161
+
have := hres.1 hnv; simp_all +decide [ concurrentFeatureReal ] ;
162
+
unfold Concurrent.embedReal at this; simp_all +decide [ Concurrent.embedPkg ] ;
163
+
obtain ⟨ a, ha, ha' ⟩ := this; have := hcnm.granularN_injective ha'; simp_all +decide [ Feature.featureReal ] ;
164
+
rcases ha with ( ha | ⟨ a, b, c, ha, hb ⟩ ) <;> simp_all +decide [ Feature.embedSet ] ;
165
+
· obtain ⟨ a, b, hab, h ⟩ := ha; simp_all +decide [ Feature.embedPkg ] ;
166
+
cases h.1 ; aesop ( simp_config := { singlePass := true } ) ;
167
+
· split_ifs at hb <;> simp_all +decide [ Feature.HasFeatureNames.featuredN ]
168
+
169
+
theorem cfSound_root_mem :
170
+
(r, ∅) ∈ cfSoundnessWitnessS (N := N) (F := F) g S := by
171
+
have h_filter_empty : ∀ f : F, (hcnm.granularN (Feature.FeatureName.featured r.1 f) (g r.2), hcvr.origV r.2) ∉ S := by
172
+
intro f hf
173
+
have h_in_concurrentFeatureReal : (hcnm.granularN (Feature.FeatureName.featured r.1 f) (g r.2), hcvr.origV r.2) ∈ concurrentFeatureReal R support Δ_f Δ_a g := by
174
+
grind +splitIndPred;
175
+
unfold concurrentFeatureReal at h_in_concurrentFeatureReal;
176
+
unfold Concurrent.embedReal at h_in_concurrentFeatureReal;
177
+
simp +decide [ Concurrent.embedPkg, Feature.featureReal ] at h_in_concurrentFeatureReal;
178
+
obtain ⟨ a, ha₁, ha₂ ⟩ := h_in_concurrentFeatureReal;
179
+
rcases ha₁ with ( ha₁ | ⟨ a, b, c, ha₁, ha₂ ⟩ );
180
+
· cases a <;> simp +decide [ hcnm.granularN_injective.eq_iff ] at ha₂ ⊢;
181
+
unfold Feature.embedSet at ha₁; simp +decide [ ha₂ ] at ha₁;
182
+
obtain ⟨ a, b, hab, h ⟩ := ha₁; cases h;
183
+
· split_ifs at ha₂ <;> simp_all +decide [ Feature.HasFeatureNames.featuredN ];
184
+
have := hcnm.granularN_injective; simp_all +decide [ Function.Injective2 ] ;
185
+
specialize this ‹_› ; aesop ( simp_config := { singlePass := true } ) ;
186
+
convert mem_cfSoundnessWitnessS_of _;
187
+
· exact Eq.symm ( Finset.eq_empty_of_forall_notMem fun f hf => h_filter_empty f <| Finset.mem_filter.mp hf |>.2 );
188
+
· convert hres.root_mem using 1
189
+
190
+
omit hres hroot_no_support in
191
+
theorem cfSound_feature_unification :
192
+
∀ n v fs fs',
193
+
((n, v), fs) ∈ cfSoundnessWitnessS (N := N) (F := F) g S →
194
+
((n, v), fs') ∈ cfSoundnessWitnessS (N := N) (F := F) g S → fs = fs' := by
195
+
unfold cfSoundnessWitnessS
196
+
grind
197
+
198
+
omit hroot_no_support in
199
+
theorem cfSound_parent_closure :
200
+
∀ p fs_p, (p, fs_p) ∈ cfSoundnessWitnessS (N := N) (F := F) g S →
201
+
∀ n vs fs, (p, n, vs, fs) ∈ Δ_f →
202
+
∃! v, v ∈ vs ∧
203
+
(∃ fs', fs ⊆ fs' ∧ ((n, v), fs') ∈ cfSoundnessWitnessS (N := N) (F := F) g S) ∧
204
+
((n, v), p) ∈ cfSoundnessWitnessπ Δ_f Δ_a g S := by
205
+
intro p fs_p hp n vs fs hdep
206
+
obtain ⟨p_n, p_v, h_p, h_pn⟩ :
207
+
∃ p_n p_v, p = (p_n, p_v) ∧
208
+
(hcnm.granularN (.orig p_n) (g p_v), hcvr.origV p_v) ∈ S := by
209
+
obtain ⟨pn, pv, hpn_S, hp_eq⟩ := mem_cfSoundnessWitnessS hp
210
+
simp only [Prod.mk.injEq] at hp_eq
211
+
exact ⟨pn, pv, hp_eq.1, hpn_S⟩
212
+
subst h_p
213
+
-- By hres.dep_closure on depender's orig → shared intermediate, get v_fc ∈ vs.map origV
214
+
-- with (cfIntermediateN p_n p_v n, v_fc) ∈ S.
215
+
obtain ⟨v_fc, hv_fc_mem, hv_fc_S⟩ :
216
+
∃ v_fc ∈ vs.map hcvr.origV,
217
+
(hcfi.cfIntermediateN p_n p_v n, v_fc) ∈ S :=
218
+
hres.dep_closure _ h_pn _ _ (mem_cfDeps_f_depToInter hdep)
219
+
obtain ⟨v₀, hv₀_vs, hv_fc_eq⟩ : ∃ v₀ ∈ vs, v_fc = hcvr.origV v₀ := by
220
+
obtain ⟨v₀, hv₀, heq⟩ := Finset.mem_map.mp hv_fc_mem
221
+
exact ⟨v₀, hv₀, heq.symm⟩
222
+
subst hv_fc_eq
223
+
-- Also need (granularN orig n (g v₀), origV v₀) ∈ S via intermediate→orig dep_closure.
224
+
have h_orig_S : (hcnm.granularN (Feature.FeatureName.orig n) (g v₀), hcvr.origV v₀) ∈ S := by
225
+
obtain ⟨w, hw_mem, hw_S⟩ :=
226
+
hres.dep_closure _ hv_fc_S _ _ (mem_cfDeps_f_interToOrig hdep hv₀_vs)
227
+
simp only [Finset.mem_map, Finset.mem_singleton] at hw_mem
228
+
obtain ⟨v', rfl, heq⟩ := hw_mem
229
+
rw [← heq] at hw_S
230
+
exact hw_S
231
+
refine ⟨v₀, ⟨hv₀_vs, ⟨_, ?_, mem_cfSoundnessWitnessS_of h_orig_S⟩,
232
+
mem_cfSoundnessWitnessπ_f hdep hv₀_vs hv_fc_S h_orig_S⟩, ?_⟩
233
+
· -- fs ⊆ filter showing each f ∈ fs has its feature granular in S at version v₀.
234
+
intro f hf
235
+
simp only [Finset.mem_filter, Finset.mem_univ, true_and]
236
+
-- depender → secondary: get the secondary at some v_f ∈ vs.
237
+
obtain ⟨v_f_fc, hv_f_mem, hv_f_S⟩ :=
238
+
hres.dep_closure _ h_pn _ _ (mem_cfDeps_f_depToInterFeat hdep hf)
239
+
obtain ⟨v_f, hv_f_vs, hv_f_eq⟩ : ∃ v_f ∈ vs, v_f_fc = hcvr.origV v_f := by
240
+
obtain ⟨v_f, hv_f, heq⟩ := Finset.mem_map.mp hv_f_mem
241
+
exact ⟨v_f, hv_f, heq.symm⟩
242
+
subst hv_f_eq
243
+
-- back-edge: secondary at v_f → shared at v_f.
244
+
have hshared_v_f_S : (hcfi.cfIntermediateN p_n p_v n, hcvr.origV v_f) ∈ S := by
245
+
obtain ⟨w_fc, hw_mem, hw_S⟩ :=
246
+
hres.dep_closure _ hv_f_S _ _ (mem_cfDeps_f_interFeatToInter hdep hv_f_vs hf)
247
+
simp only [Finset.mem_map, Finset.mem_singleton] at hw_mem
248
+
obtain ⟨w, hw_eq1, hw_eq2⟩ := hw_mem
249
+
subst hw_eq1
250
+
rw [← hw_eq2] at hw_S
251
+
exact hw_S
252
+
-- version_unique on shared intermediate: shared at v_f = shared at v₀.
253
+
have hver : hcvr.origV v_f = hcvr.origV v₀ :=
254
+
hres.version_unique _ _ _ hshared_v_f_S hv_fc_S
255
+
have hv_eq : v_f = v₀ := hcvr.origV.injective hver
256
+
subst hv_eq
257
+
-- secondary at v₀ → feature granular at v₀.
258
+
obtain ⟨w_fc2, hw2_mem, hw2_S⟩ :=
259
+
hres.dep_closure _ hv_f_S _ _ (mem_cfDeps_f_interToFeat hdep hv_f_vs hf)
260
+
simp only [Finset.mem_map, Finset.mem_singleton] at hw2_mem
261
+
obtain ⟨w2, hw2_eq1, hw2_eq2⟩ := hw2_mem
262
+
subst hw2_eq1
263
+
rw [← hw2_eq2] at hw2_S
264
+
exact hw2_S
265
+
· -- Uniqueness
266
+
rintro y ⟨hy_vs, _, hπ⟩
267
+
have hS_y : (hcfi.cfIntermediateN p_n p_v n, hcvr.origV y) ∈ S := by
268
+
rcases mem_cfSoundnessWitnessπ hπ with
269
+
⟨p_n', p_v', n', vs', fs', v', _, _, h_inter, _, h_eq⟩
270
+
| ⟨p_n', p_v', f, n', vs', fs', v', _, _, h_inter, _, h_eq⟩
271
+
all_goals
272
+
simp only [Prod.mk.injEq] at h_eq
273
+
obtain ⟨⟨hn, hv⟩, hpn, hpv⟩ := h_eq
274
+
subst hn; subst hv; subst hpn; subst hpv
275
+
exact h_inter
276
+
have hver : hcvr.origV y = hcvr.origV v₀ :=
277
+
hres.version_unique _ _ _ hS_y hv_fc_S
278
+
exact hcvr.origV.injective hver
279
+
280
+
omit hroot_no_support in
281
+
theorem cfSound_parent_closure_addl :
282
+
∀ p fs_p, (p, fs_p) ∈ cfSoundnessWitnessS (N := N) (F := F) g S →
283
+
∀ f ∈ fs_p, ∀ n vs fs, ((p, f), n, vs, fs) ∈ Δ_a →
284
+
∃! v, v ∈ vs ∧
285
+
(∃ fs', fs ⊆ fs' ∧ ((n, v), fs') ∈ cfSoundnessWitnessS (N := N) (F := F) g S) ∧
286
+
((n, v), p) ∈ cfSoundnessWitnessπ Δ_f Δ_a g S := by
287
+
intro p fs_p hp f hf n vs fs hdep
288
+
-- Extract p = (p_n, p_v) along with both orig and featured packages in S.
289
+
obtain ⟨p_n, p_v, h_p, h_orig_pn, h_feat_pn⟩ :
290
+
∃ p_n p_v, p = (p_n, p_v) ∧
291
+
(hcnm.granularN (Feature.FeatureName.orig p_n) (g p_v), hcvr.origV p_v) ∈ S ∧
292
+
(hcnm.granularN (Feature.FeatureName.featured p_n f) (g p_v), hcvr.origV p_v) ∈ S := by
293
+
obtain ⟨pn, pv, hpn_S, hp_eq⟩ := mem_cfSoundnessWitnessS hp
294
+
simp only [Prod.mk.injEq] at hp_eq
295
+
have h_f_filter : f ∈ Finset.univ.filter
296
+
(fun f' => (hcnm.granularN (Feature.FeatureName.featured pn f') (g pv),
297
+
hcvr.origV pv) ∈ S) := by rw [← hp_eq.2]; exact hf
298
+
have h_feat := (Finset.mem_filter.mp h_f_filter).2
299
+
exact ⟨pn, pv, hp_eq.1, hpn_S, h_feat⟩
300
+
subst h_p
301
+
-- By hres.dep_closure on featured depender → shared intermediate, get v₀.
302
+
obtain ⟨v_fc, hv_fc_mem, hv_fc_S⟩ :
303
+
∃ v_fc ∈ vs.map hcvr.origV,
304
+
(hcfi.cfIntermediateN p_n p_v n, v_fc) ∈ S :=
305
+
hres.dep_closure _ h_feat_pn _ _ (mem_cfDeps_a_depToInter hdep)
306
+
obtain ⟨v₀, hv₀_vs, hv_fc_eq⟩ : ∃ v₀ ∈ vs, v_fc = hcvr.origV v₀ := by
307
+
obtain ⟨v₀, hv₀, heq⟩ := Finset.mem_map.mp hv_fc_mem
308
+
exact ⟨v₀, hv₀, heq.symm⟩
309
+
subst hv_fc_eq
310
+
have h_orig_S : (hcnm.granularN (Feature.FeatureName.orig n) (g v₀), hcvr.origV v₀) ∈ S := by
311
+
obtain ⟨w, hw_mem, hw_S⟩ :=
312
+
hres.dep_closure _ hv_fc_S _ _ (mem_cfDeps_a_interToOrig hdep hv₀_vs)
313
+
simp only [Finset.mem_map, Finset.mem_singleton] at hw_mem
314
+
obtain ⟨v', rfl, heq⟩ := hw_mem
315
+
rw [← heq] at hw_S
316
+
exact hw_S
317
+
refine ⟨v₀, ⟨hv₀_vs, ⟨_, ?_, mem_cfSoundnessWitnessS_of h_orig_S⟩,
318
+
mem_cfSoundnessWitnessπ_a hdep hv₀_vs hv_fc_S h_orig_S⟩, ?_⟩
319
+
· -- fs ⊆ filter showing each f' ∈ fs has its feature granular in S at version v₀.
320
+
intro f' hf'
321
+
simp only [Finset.mem_filter, Finset.mem_univ, true_and]
322
+
-- depender (featured) → secondary: get the secondary at some v_f ∈ vs.
323
+
obtain ⟨v_f_fc, hv_f_mem, hv_f_S⟩ :=
324
+
hres.dep_closure _ h_feat_pn _ _ (mem_cfDeps_a_depToInterFeat hdep hf')
325
+
obtain ⟨v_f, hv_f_vs, hv_f_eq⟩ : ∃ v_f ∈ vs, v_f_fc = hcvr.origV v_f := by
326
+
obtain ⟨v_f, hv_f, heq⟩ := Finset.mem_map.mp hv_f_mem
327
+
exact ⟨v_f, hv_f, heq.symm⟩
328
+
subst hv_f_eq
329
+
-- back-edge: secondary at v_f → shared at v_f.
330
+
have hshared_v_f_S : (hcfi.cfIntermediateN p_n p_v n, hcvr.origV v_f) ∈ S := by
331
+
obtain ⟨w_fc, hw_mem, hw_S⟩ :=
332
+
hres.dep_closure _ hv_f_S _ _ (mem_cfDeps_a_interFeatToInter hdep hv_f_vs hf')
333
+
simp only [Finset.mem_map, Finset.mem_singleton] at hw_mem
334
+
obtain ⟨w, hw_eq1, hw_eq2⟩ := hw_mem
335
+
subst hw_eq1
336
+
rw [← hw_eq2] at hw_S
337
+
exact hw_S
338
+
-- version_unique on shared intermediate: shared at v_f = shared at v₀.
339
+
have hver : hcvr.origV v_f = hcvr.origV v₀ :=
340
+
hres.version_unique _ _ _ hshared_v_f_S hv_fc_S
341
+
have hv_eq : v_f = v₀ := hcvr.origV.injective hver
342
+
subst hv_eq
343
+
-- secondary at v₀ → feature granular at v₀.
344
+
obtain ⟨w_fc2, hw2_mem, hw2_S⟩ :=
345
+
hres.dep_closure _ hv_f_S _ _ (mem_cfDeps_a_interToFeat hdep hv_f_vs hf')
346
+
simp only [Finset.mem_map, Finset.mem_singleton] at hw2_mem
347
+
obtain ⟨w2, hw2_eq1, hw2_eq2⟩ := hw2_mem
348
+
subst hw2_eq1
349
+
rw [← hw2_eq2] at hw2_S
350
+
exact hw2_S
351
+
· rintro y ⟨hy_vs, _, hπ⟩
352
+
have hS_y : (hcfi.cfIntermediateN p_n p_v n, hcvr.origV y) ∈ S := by
353
+
rcases mem_cfSoundnessWitnessπ hπ with
354
+
⟨p_n', p_v', n', vs', fs', v', _, _, h_inter, _, h_eq⟩
355
+
| ⟨p_n', p_v', f'', n', vs', fs', v', _, _, h_inter, _, h_eq⟩
356
+
all_goals
357
+
simp only [Prod.mk.injEq] at h_eq
358
+
obtain ⟨⟨hn, hv⟩, hpn, hpv⟩ := h_eq
359
+
subst hn; subst hv; subst hpn; subst hpv
360
+
exact h_inter
361
+
have hver : hcvr.origV y = hcvr.origV v₀ :=
362
+
hres.version_unique _ _ _ hS_y hv_fc_S
363
+
exact hcvr.origV.injective hver
364
+
365
+
omit hroot_no_support in
366
+
theorem cfSound_π_functional :
367
+
∀ n v v' p,
368
+
((n, v), p) ∈ cfSoundnessWitnessπ Δ_f Δ_a g S →
369
+
((n, v'), p) ∈ cfSoundnessWitnessπ Δ_f Δ_a g S → v = v' := by
370
+
rintro n v v' ⟨p_n, p_v⟩ h1 h2
371
+
-- Each π edge implies the corresponding intermediate is in S.
372
+
have hS1 : (hcfi.cfIntermediateN p_n p_v n, hcvr.origV v) ∈ S := by
373
+
rcases mem_cfSoundnessWitnessπ h1 with
374
+
⟨p_n', p_v', n', vs, fs, v₀, _, _, h_inter, _, h_eq⟩
375
+
| ⟨p_n', p_v', f, n', vs, fs, v₀, _, _, h_inter, _, h_eq⟩
376
+
all_goals
377
+
simp only [Prod.mk.injEq] at h_eq
378
+
obtain ⟨⟨hn, hv⟩, hpn, hpv⟩ := h_eq
379
+
subst hn; subst hv; subst hpn; subst hpv
380
+
exact h_inter
381
+
have hS2 : (hcfi.cfIntermediateN p_n p_v n, hcvr.origV v') ∈ S := by
382
+
rcases mem_cfSoundnessWitnessπ h2 with
383
+
⟨p_n', p_v', n', vs, fs, v₀, _, _, h_inter, _, h_eq⟩
384
+
| ⟨p_n', p_v', f, n', vs, fs, v₀, _, _, h_inter, _, h_eq⟩
385
+
all_goals
386
+
simp only [Prod.mk.injEq] at h_eq
387
+
obtain ⟨⟨hn, hv⟩, hpn, hpv⟩ := h_eq
388
+
subst hn; subst hv; subst hpn; subst hpv
389
+
exact h_inter
390
+
have hver : hcvr.origV v = hcvr.origV v' :=
391
+
hres.version_unique (hcfi.cfIntermediateN p_n p_v n) (hcvr.origV v) (hcvr.origV v') hS1 hS2
392
+
exact hcvr.origV.injective hver
393
+
394
+
omit hroot_no_support in
395
+
theorem cfSound_version_granularity :
396
+
∀ n v v' fs fs',
397
+
((n, v), fs) ∈ cfSoundnessWitnessS (N := N) (F := F) g S →
398
+
((n, v'), fs') ∈ cfSoundnessWitnessS (N := N) (F := F) g S → v ≠ v' → g v ≠ g v' := by
399
+
intros n v v' fs fs' h1 h2 hv_ne hv_eq
400
+
have hgran_eq : hcnm.granularN (Feature.FeatureName.orig n) (g v) = hcnm.granularN (Feature.FeatureName.orig n) (g v') := by
401
+
rw [hv_eq];
402
+
have hgran_eq : hcvr.origV v = hcvr.origV v' := by
403
+
have := hres.version_unique;
404
+
apply this;
405
+
convert mem_cfSoundnessWitnessS h1 |> Classical.choose_spec |> Classical.choose_spec |> And.left using 1;
406
+
rotate_right;
407
+
exact hcnm.granularN ( Feature.FeatureName.orig n ) ( g v' );
408
+
· grind;
409
+
· convert mem_cfSoundnessWitnessS h2 |> Classical.choose_spec |> Classical.choose_spec |> And.left using 1;
410
+
grind;
411
+
exact hv_ne ( hcvr.origV.injective hgran_eq )
412
+
413
+
omit hroot_no_support in
414
+
theorem cfSound_support_mem :
415
+
∀ n v fs f, ((n, v), fs) ∈ cfSoundnessWitnessS (N := N) (F := F) g S →
416
+
f ∈ fs → ((n, v), f) ∈ support := by
417
+
intro n v fs f h₁ h₂;
418
+
have h_concurrent_feature_real : (hcnm.granularN (Feature.FeatureName.featured n f) (g v), hcvr.origV v) ∈ concurrentFeatureReal R support Δ_f Δ_a g := by
419
+
have h_concurrent_feature_real : (hcnm.granularN (Feature.FeatureName.featured n f) (g v), hcvr.origV v) ∈ S := by
420
+
unfold cfSoundnessWitnessS at h₁;
421
+
grind;
422
+
exact hres.1 h_concurrent_feature_real;
423
+
unfold concurrentFeatureReal at h_concurrent_feature_real;
424
+
simp +decide [ Concurrent.embedReal ] at h_concurrent_feature_real;
425
+
unfold Feature.featureReal at h_concurrent_feature_real; simp +decide [ Concurrent.embedPkg ] at h_concurrent_feature_real;
426
+
rcases h_concurrent_feature_real with ⟨ a, ha | ⟨ a', b, c, h₁, h₂ ⟩, h₃ ⟩ <;> simp +decide [ hcnm.granularN_injective.eq_iff ] at h₃ ⊢;
427
+
· unfold Feature.embedSet at ha; simp +decide [ h₃ ] at ha;
428
+
unfold Feature.embedPkg at ha; simp +decide at ha;
429
+
· split_ifs at h₂ <;> simp_all +decide [ Feature.HasFeatureNames.featuredN ]
430
+
431
+
end SoundnessFields
432
+
433
+
/-! ### Soundness -/
434
+
435
+
-- Paper Thm 5.1.3 (Concurrent Feature Reduction Soundness).
436
+
theorem concurrent_feature_soundness
437
+
[Fintype F]
438
+
(R : Real N V)
439
+
(support : Feature.Support N V F)
440
+
(Δ_f : Feature.FeatDepRel N V F) (Δ_a : Feature.AddlDepRel N V F)
441
+
(g : V → G) (r : Package N V)
442
+
(S : Finset (Package N_FC V_FC))
443
+
(hres : IsResolution
444
+
(concurrentFeatureReal R support Δ_f Δ_a g)
445
+
(concurrentFeatureDeps R support Δ_f Δ_a g)
446
+
(Concurrent.embedPkg g (Feature.embedPkg F r)) S)
447
+
(hroot_no_support : ∀ f, (r, f) ∉ support) :
448
+
∃ S_cf π, IsConcurrentFeatureResolution R support Δ_f Δ_a g r S_cf π :=
449
+
⟨cfSoundnessWitnessS (N := N) (F := F) g S, cfSoundnessWitnessπ Δ_f Δ_a g S,
450
+
⟨hroot_no_support,
451
+
cfSound_subset R support Δ_f Δ_a g r S hres,
452
+
cfSound_root_mem R support Δ_f Δ_a g r S hres hroot_no_support,
453
+
cfSound_feature_unification g S,
454
+
cfSound_parent_closure R support Δ_f Δ_a g r S hres,
455
+
cfSound_parent_closure_addl R support Δ_f Δ_a g r S hres,
456
+
cfSound_π_functional R support Δ_f Δ_a g r S hres,
457
+
cfSound_version_granularity R support Δ_f Δ_a g r S hres,
458
+
cfSound_support_mem R support Δ_f Δ_a g r S hres⟩⟩
459
+
460
+
end PackageCalculus.Composition
+227
PackageCalculus/Composition/FeatureConcurrent/Types.lean
+227
PackageCalculus/Composition/FeatureConcurrent/Types.lean
···
1
+
import PackageCalculus.Extensions.Concurrent.Definition
2
+
import PackageCalculus.Extensions.Feature.Reduction.Definition
3
+
4
+
/-! # Feature-concurrent composition: shared types
5
+
6
+
Flattened name and version types `N_FC`, `V_FC` that combine the concurrent
7
+
and feature embeddings, together with the typeclasses that introduce shared
8
+
and per-feature intermediate constructors. -/
9
+
10
+
namespace PackageCalculus.Composition
11
+
12
+
open Function
13
+
14
+
variable {N F V G : Type*}
15
+
16
+
/-- Flattened name type for the joint Concurrent Feature reduction.
17
+
18
+
The first six constructors (`granularOrig`, `granularFeatured`, and the four
19
+
`intermediate*` variants) provide the `Concurrent.HasConcurrentNames` instance for the
20
+
feature-level name type. The Concurrent Feature reduction itself does **not** use the
21
+
`intermediate*` constructors; they are present only so the underlying typeclass instance
22
+
can be defined. The new shared intermediate is `concurrentFeatureIntermediate p_n p_v n`,
23
+
corresponding to the paper's `⟨(p_n, p_v), n⟩`. It is parameterised by the depender's
24
+
base name, its full version, and the dependee's base name. -/
25
+
inductive FCName (N F V G : Type*) where
26
+
| granularOrig : N → G → FCName N F V G
27
+
| granularFeatured : N → F → G → FCName N F V G
28
+
| intermediateOrigOrig : N → V → N → FCName N F V G
29
+
| intermediateOrigFeatured : N → V → N → F → FCName N F V G
30
+
| intermediateFeaturedOrig : N → F → V → N → FCName N F V G
31
+
| intermediateFeaturedFeatured : N → F → V → N → F → FCName N F V G
32
+
/-- Shared intermediate `⟨(p_n, p_v), n⟩` for a Δ_f or Δ_a dep on the base
33
+
depender--dependee pair `((p_n, p_v), n)`. -/
34
+
| concurrentFeatureIntermediate : N → V → N → FCName N F V G
35
+
/-- Per-feature secondary intermediate `⟨(p_n, p_v), n, f⟩` for a Δ_f dep, used to route the
36
+
depender's orig package to each `f ∈ fs` feature granular of the dependee. -/
37
+
| concurrentFeatureIntermediate_f : N → V → N → F → FCName N F V G
38
+
/-- Per-feature secondary intermediate `⟨(p_n, p_v), f, n, f'⟩` for a Δ_a dep, used to
39
+
route the depender's featured (by `f`) package to each `f' ∈ fs` feature granular of the
40
+
dependee. -/
41
+
| concurrentFeatureIntermediate_a : N → V → F → N → F → FCName N F V G
42
+
43
+
instance : Concurrent.HasConcurrentNames (Feature.FeatureName N F) V G (FCName N F V G) where
44
+
granularN := fun fn g => match fn with
45
+
| .orig n => .granularOrig n g
46
+
| .featured n f => .granularFeatured n f g
47
+
intermediateN := fun fn v fm => match fn, fm with
48
+
| .orig n, .orig m => .intermediateOrigOrig n v m
49
+
| .orig n, .featured m f => .intermediateOrigFeatured n v m f
50
+
| .featured n f, .orig m => .intermediateFeaturedOrig n f v m
51
+
| .featured n f, .featured m f' => .intermediateFeaturedFeatured n f v m f'
52
+
granularN_injective := by
53
+
intro fn₁ fn₂ g₁ g₂ h
54
+
cases fn₁ with
55
+
| orig n₁ =>
56
+
cases fn₂ with
57
+
| orig n₂ =>
58
+
have h' := FCName.granularOrig.inj h
59
+
exact ⟨congrArg Feature.FeatureName.orig h'.1, h'.2⟩
60
+
| featured n₂ f₂ => exact nomatch h
61
+
| featured n₁ f₁ =>
62
+
cases fn₂ with
63
+
| orig n₂ => exact nomatch h
64
+
| featured n₂ f₂ =>
65
+
have h' := FCName.granularFeatured.inj h
66
+
exact ⟨h'.1 ▸ h'.2.1 ▸ rfl, h'.2.2⟩
67
+
intermediateN_injective := by
68
+
intro fn₁ v₁ fm₁ fn₂ v₂ fm₂ h
69
+
cases fn₁ with
70
+
| orig n₁ =>
71
+
cases fn₂ with
72
+
| orig n₂ =>
73
+
cases fm₁ with
74
+
| orig m₁ =>
75
+
cases fm₂ with
76
+
| orig m₂ =>
77
+
have h' := FCName.intermediateOrigOrig.inj h
78
+
exact ⟨congrArg Feature.FeatureName.orig h'.1, h'.2.1,
79
+
congrArg Feature.FeatureName.orig h'.2.2⟩
80
+
| featured m₂ f₂ => exact nomatch h
81
+
| featured m₁ f₁ =>
82
+
cases fm₂ with
83
+
| orig m₂ => exact nomatch h
84
+
| featured m₂ f₂ =>
85
+
have h' := FCName.intermediateOrigFeatured.inj h
86
+
exact ⟨congrArg Feature.FeatureName.orig h'.1, h'.2.1, h'.2.2.1 ▸ h'.2.2.2 ▸ rfl⟩
87
+
| featured n₂ f₂ =>
88
+
cases fm₁ with
89
+
| orig m₁ =>
90
+
cases fm₂ with
91
+
| orig m₂ => exact nomatch h
92
+
| featured m₂ f₂' => exact nomatch h
93
+
| featured m₁ f₁ =>
94
+
cases fm₂ with
95
+
| orig m₂ => exact nomatch h
96
+
| featured m₂ f₂' => exact nomatch h
97
+
| featured n₁ f₁ =>
98
+
cases fn₂ with
99
+
| orig n₂ =>
100
+
cases fm₁ with
101
+
| orig m₁ =>
102
+
cases fm₂ with
103
+
| orig m₂ => exact nomatch h
104
+
| featured m₂ f₂ => exact nomatch h
105
+
| featured m₁ f₁' =>
106
+
cases fm₂ with
107
+
| orig m₂ => exact nomatch h
108
+
| featured m₂ f₂ => exact nomatch h
109
+
| featured n₂ f₂ =>
110
+
cases fm₁ with
111
+
| orig m₁ =>
112
+
cases fm₂ with
113
+
| orig m₂ =>
114
+
have h' := FCName.intermediateFeaturedOrig.inj h
115
+
exact ⟨h'.1 ▸ h'.2.1 ▸ rfl, h'.2.2.1, congrArg Feature.FeatureName.orig h'.2.2.2⟩
116
+
| featured m₂ f₂' => exact nomatch h
117
+
| featured m₁ f₁' =>
118
+
cases fm₂ with
119
+
| orig m₂ => exact nomatch h
120
+
| featured m₂ f₂' =>
121
+
have h' := FCName.intermediateFeaturedFeatured.inj h
122
+
exact ⟨h'.1 ▸ h'.2.1 ▸ rfl, h'.2.2.1, h'.2.2.2.1 ▸ h'.2.2.2.2 ▸ rfl⟩
123
+
granularN_ne_intermediateN := fun fn g fn' v fm => by
124
+
cases fn <;> cases fn' <;> cases fm <;> nofun
125
+
intermediateN_ne_granularN := fun fn v fm fn' g => by
126
+
cases fn <;> cases fn' <;> cases fm <;> nofun
127
+
tryGranularN := fun
128
+
| .granularOrig n g => some (.orig n, g)
129
+
| .granularFeatured n f g => some (.featured n f, g)
130
+
| _ => none
131
+
tryGranularN_granularN := fun fn g => by cases fn <;> rfl
132
+
tryGranularN_some := fun n' p h => by
133
+
cases n' with
134
+
| granularOrig n g => simp at h; obtain ⟨rfl, rfl⟩ := h; rfl
135
+
| granularFeatured n f g => simp at h; obtain ⟨rfl, rfl⟩ := h; rfl
136
+
| _ => simp at h
137
+
138
+
/-- Typeclass providing the shared intermediate constructor used by the joint Concurrent
139
+
Feature reduction. The constructor takes the depender's base name, its full version,
140
+
and the dependee's base name. It must be distinct from all `granularN` and
141
+
`intermediateN` constructors of the underlying `HasConcurrentNames` instance. -/
142
+
class HasConcurrentFeatureIntermediate (N V F G : Type*) (N' : outParam Type*)
143
+
[hcnm : Concurrent.HasConcurrentNames (Feature.FeatureName N F) V G N'] where
144
+
/-- Shared intermediate `⟨(p_n, p_v), n⟩`. -/
145
+
cfIntermediateN : N → V → N → N'
146
+
/-- Per-feature secondary intermediate `⟨(p_n, p_v), n, f⟩` for Δ_f deps. -/
147
+
cfIntermediateN_f : N → V → N → F → N'
148
+
/-- Per-feature secondary intermediate `⟨(p_n, p_v), f, n, f'⟩` for Δ_a deps. -/
149
+
cfIntermediateN_a : N → V → F → N → F → N'
150
+
cfIntermediateN_injective :
151
+
∀ p_n₁ p_v₁ n₁ p_n₂ p_v₂ n₂,
152
+
cfIntermediateN p_n₁ p_v₁ n₁ = cfIntermediateN p_n₂ p_v₂ n₂ →
153
+
p_n₁ = p_n₂ ∧ p_v₁ = p_v₂ ∧ n₁ = n₂
154
+
cfIntermediateN_f_injective :
155
+
∀ p_n₁ p_v₁ n₁ f₁ p_n₂ p_v₂ n₂ f₂,
156
+
cfIntermediateN_f p_n₁ p_v₁ n₁ f₁ = cfIntermediateN_f p_n₂ p_v₂ n₂ f₂ →
157
+
p_n₁ = p_n₂ ∧ p_v₁ = p_v₂ ∧ n₁ = n₂ ∧ f₁ = f₂
158
+
cfIntermediateN_a_injective :
159
+
∀ p_n₁ p_v₁ f₁ n₁ f'₁ p_n₂ p_v₂ f₂ n₂ f'₂,
160
+
cfIntermediateN_a p_n₁ p_v₁ f₁ n₁ f'₁ = cfIntermediateN_a p_n₂ p_v₂ f₂ n₂ f'₂ →
161
+
p_n₁ = p_n₂ ∧ p_v₁ = p_v₂ ∧ f₁ = f₂ ∧ n₁ = n₂ ∧ f'₁ = f'₂
162
+
cfIntermediateN_ne_granularN :
163
+
∀ p_n p_v n fn g, cfIntermediateN p_n p_v n ≠ hcnm.granularN fn g
164
+
cfIntermediateN_ne_intermediateN :
165
+
∀ p_n p_v n fn v fm, cfIntermediateN p_n p_v n ≠ hcnm.intermediateN fn v fm
166
+
cfIntermediateN_f_ne_granularN :
167
+
∀ p_n p_v n f fn g, cfIntermediateN_f p_n p_v n f ≠ hcnm.granularN fn g
168
+
cfIntermediateN_f_ne_intermediateN :
169
+
∀ p_n p_v n f fn v fm, cfIntermediateN_f p_n p_v n f ≠ hcnm.intermediateN fn v fm
170
+
cfIntermediateN_f_ne_cfIntermediateN :
171
+
∀ p_n p_v n f p_n' p_v' n', cfIntermediateN_f p_n p_v n f ≠ cfIntermediateN p_n' p_v' n'
172
+
cfIntermediateN_a_ne_granularN :
173
+
∀ p_n p_v f n f' fn g, cfIntermediateN_a p_n p_v f n f' ≠ hcnm.granularN fn g
174
+
cfIntermediateN_a_ne_intermediateN :
175
+
∀ p_n p_v f n f' fn v fm, cfIntermediateN_a p_n p_v f n f' ≠ hcnm.intermediateN fn v fm
176
+
cfIntermediateN_a_ne_cfIntermediateN :
177
+
∀ p_n p_v f n f' p_n' p_v' n', cfIntermediateN_a p_n p_v f n f' ≠ cfIntermediateN p_n' p_v' n'
178
+
cfIntermediateN_a_ne_cfIntermediateN_f :
179
+
∀ p_n p_v f n f' p_n' p_v' n' f'', cfIntermediateN_a p_n p_v f n f' ≠ cfIntermediateN_f p_n' p_v' n' f''
180
+
181
+
attribute [simp]
182
+
HasConcurrentFeatureIntermediate.cfIntermediateN_ne_granularN
183
+
HasConcurrentFeatureIntermediate.cfIntermediateN_ne_intermediateN
184
+
HasConcurrentFeatureIntermediate.cfIntermediateN_f_ne_granularN
185
+
HasConcurrentFeatureIntermediate.cfIntermediateN_f_ne_intermediateN
186
+
HasConcurrentFeatureIntermediate.cfIntermediateN_f_ne_cfIntermediateN
187
+
HasConcurrentFeatureIntermediate.cfIntermediateN_a_ne_granularN
188
+
HasConcurrentFeatureIntermediate.cfIntermediateN_a_ne_intermediateN
189
+
HasConcurrentFeatureIntermediate.cfIntermediateN_a_ne_cfIntermediateN
190
+
HasConcurrentFeatureIntermediate.cfIntermediateN_a_ne_cfIntermediateN_f
191
+
192
+
instance : HasConcurrentFeatureIntermediate N V F G (FCName N F V G) where
193
+
cfIntermediateN := fun p_n p_v n => .concurrentFeatureIntermediate p_n p_v n
194
+
cfIntermediateN_f := fun p_n p_v n f => .concurrentFeatureIntermediate_f p_n p_v n f
195
+
cfIntermediateN_a := fun p_n p_v f n f' => .concurrentFeatureIntermediate_a p_n p_v f n f'
196
+
cfIntermediateN_injective := by
197
+
intro p_n₁ p_v₁ n₁ p_n₂ p_v₂ n₂ h
198
+
have h' := FCName.concurrentFeatureIntermediate.inj h
199
+
exact ⟨h'.1, h'.2.1, h'.2.2⟩
200
+
cfIntermediateN_f_injective := by
201
+
intro p_n₁ p_v₁ n₁ f₁ p_n₂ p_v₂ n₂ f₂ h
202
+
have h' := FCName.concurrentFeatureIntermediate_f.inj h
203
+
exact ⟨h'.1, h'.2.1, h'.2.2.1, h'.2.2.2⟩
204
+
cfIntermediateN_a_injective := by
205
+
intro p_n₁ p_v₁ f₁ n₁ f'₁ p_n₂ p_v₂ f₂ n₂ f'₂ h
206
+
have h' := FCName.concurrentFeatureIntermediate_a.inj h
207
+
exact ⟨h'.1, h'.2.1, h'.2.2.1, h'.2.2.2.1, h'.2.2.2.2⟩
208
+
cfIntermediateN_ne_granularN := by
209
+
intro p_n p_v n fn g; cases fn <;> nofun
210
+
cfIntermediateN_ne_intermediateN := by
211
+
intro p_n p_v n fn v fm; cases fn <;> cases fm <;> nofun
212
+
cfIntermediateN_f_ne_granularN := by
213
+
intro p_n p_v n f fn g; cases fn <;> nofun
214
+
cfIntermediateN_f_ne_intermediateN := by
215
+
intro p_n p_v n f fn v fm; cases fn <;> cases fm <;> nofun
216
+
cfIntermediateN_f_ne_cfIntermediateN := by
217
+
intro p_n p_v n f p_n' p_v' n'; nofun
218
+
cfIntermediateN_a_ne_granularN := by
219
+
intro p_n p_v f n f' fn g; cases fn <;> nofun
220
+
cfIntermediateN_a_ne_intermediateN := by
221
+
intro p_n p_v f n f' fn v fm; cases fn <;> cases fm <;> nofun
222
+
cfIntermediateN_a_ne_cfIntermediateN := by
223
+
intro p_n p_v f n f' p_n' p_v' n'; nofun
224
+
cfIntermediateN_a_ne_cfIntermediateN_f := by
225
+
intro p_n p_v f n f' p_n' p_v' n' f''; nofun
226
+
227
+
end PackageCalculus.Composition
+36
PackageCalculus/Core/Definition.lean
+36
PackageCalculus/Core/Definition.lean
···
1
+
import Mathlib.Data.Finset.Basic
2
+
3
+
/-! # Core dependency calculus
4
+
5
+
Defines the carriers of the calculus -- packages, the universe of available
6
+
packages (`Real`), and the dependency relation `DepRel` -- and what it means for
7
+
a finite set of packages to be a *resolution* for a dependency relation and root
8
+
package: a subset of the universe, closed under dependencies, with a unique
9
+
version per name. -/
10
+
11
+
namespace PackageCalculus
12
+
13
+
variable (N : Type*) [DecidableEq N] (V : Type*) [DecidableEq V]
14
+
15
+
abbrev Package := N × V
16
+
17
+
abbrev Real := Finset (Package N V)
18
+
19
+
/-- An element (p, m, vs) means package p depends on name m with compatible version set vs. -/
20
+
abbrev DepRel := Finset (Package N V × N × Finset V)
21
+
22
+
variable {N V}
23
+
24
+
def VersionUnique (S : Finset (Package N V)) : Prop :=
25
+
∀ n : N, ∀ v v' : V, (n, v) ∈ S → (n, v') ∈ S → v = v'
26
+
27
+
/-- S ∈ S(Δ, r): a resolution for dependencies Δ and root r within R. -/
28
+
structure IsResolution (R : Real N V) (Δ : DepRel N V)
29
+
(r : Package N V) (S : Finset (Package N V)) : Prop where
30
+
subset : S ⊆ R
31
+
root_mem : r ∈ S
32
+
dep_closure : ∀ p ∈ S, ∀ m : N, ∀ vs : Finset V,
33
+
(p, m, vs) ∈ Δ → ∃ v ∈ vs, (m, v) ∈ S
34
+
version_unique : VersionUnique S
35
+
36
+
end PackageCalculus
+57
PackageCalculus/Extensions/Concurrent/Definition.lean
+57
PackageCalculus/Extensions/Concurrent/Definition.lean
···
1
+
import PackageCalculus.Core.Definition
2
+
import Mathlib.Logic.Embedding.Basic
3
+
4
+
/-! # Concurrent extension: definitions
5
+
6
+
`IsConcurrentResolution` allows multiple versions per name as long as they
7
+
disagree only on a *granularity* labelling supplied by `g : V → G`. -/
8
+
9
+
namespace PackageCalculus.Concurrent
10
+
11
+
open Function
12
+
13
+
variable {N : Type*} [DecidableEq N] {V : Type*} [DecidableEq V] {G : Type*}
14
+
15
+
structure IsConcurrentResolution
16
+
(R : Real N V) (Δ : DepRel N V)
17
+
(g : V → G) (r : Package N V)
18
+
(S : Finset (Package N V)) (π : Finset (Package N V × Package N V)) : Prop where
19
+
subset : S ⊆ R
20
+
root_mem : r ∈ S
21
+
/-- Each dependency is satisfied by exactly one compatible version, witnessed by π. -/
22
+
parent_closure : ∀ p ∈ S, ∀ m : N, ∀ vs : Finset V,
23
+
(p, m, vs) ∈ Δ → ∃! v, v ∈ vs ∧ (m, v) ∈ S ∧ ((m, v), p) ∈ π
24
+
/-- Same name, different version implies different granularity. -/
25
+
version_granularity : ∀ n : N, ∀ v v' : V,
26
+
(n, v) ∈ S → (n, v') ∈ S → v ≠ v' → g v ≠ g v'
27
+
28
+
/-- No `orig` embedding: names are either `granular n g` or `intermediate n v m`. -/
29
+
class HasConcurrentNames (N V G : Type*) (N' : outParam Type*) where
30
+
granularN : N → G → N'
31
+
granularN_injective : Injective2 granularN
32
+
intermediateN : N → V → N → N'
33
+
intermediateN_injective : ∀ n₁ v₁ m₁ n₂ v₂ m₂,
34
+
intermediateN n₁ v₁ m₁ = intermediateN n₂ v₂ m₂ → n₁ = n₂ ∧ v₁ = v₂ ∧ m₁ = m₂
35
+
granularN_ne_intermediateN : ∀ n g n' v m, granularN n g ≠ intermediateN n' v m
36
+
intermediateN_ne_granularN : ∀ n v m n' g, intermediateN n v m ≠ granularN n' g
37
+
/-- Decidable partial inverse of `granularN`. -/
38
+
tryGranularN : N' → Option (N × G)
39
+
tryGranularN_granularN : ∀ n g, tryGranularN (granularN n g) = some (n, g)
40
+
tryGranularN_some : ∀ n' p, tryGranularN n' = some p → granularN p.1 p.2 = n'
41
+
42
+
attribute [simp] HasConcurrentNames.granularN_ne_intermediateN
43
+
HasConcurrentNames.intermediateN_ne_granularN
44
+
45
+
class HasConcurrentVersions (V G : Type*) (V' : outParam Type*) where
46
+
origV : V ↪ V'
47
+
granV : G ↪ V'
48
+
origV_ne_granV : ∀ v g, origV v ≠ granV g
49
+
granV_ne_origV : ∀ g v, granV g ≠ origV v
50
+
/-- Decidable partial inverse of `origV`. -/
51
+
tryOrigV : V' → Option V
52
+
tryOrigV_origV : ∀ v, tryOrigV (origV v) = some v
53
+
tryOrigV_some : ∀ v' v, tryOrigV v' = some v → origV v = v'
54
+
55
+
attribute [simp] HasConcurrentVersions.origV_ne_granV HasConcurrentVersions.granV_ne_origV
56
+
57
+
end PackageCalculus.Concurrent
+51
PackageCalculus/Extensions/Concurrent/Lifting/Completeness.lean
+51
PackageCalculus/Extensions/Concurrent/Lifting/Completeness.lean
···
1
+
import PackageCalculus.Extensions.Concurrent.Lifting.Definition
2
+
3
+
namespace PackageCalculus.Concurrent
4
+
5
+
set_option linter.unusedSectionVars false
6
+
7
+
variable {N : Type*} [DecidableEq N] {V : Type*} [DecidableEq V] {G : Type*} [DecidableEq G]
8
+
variable {N' : Type*} [DecidableEq N'] {V' : Type*} [DecidableEq V']
9
+
variable [hcnm : HasConcurrentNames N V G N'] [hcvr : HasConcurrentVersions V G V']
10
+
11
+
theorem liftResolution_completenessWitness (S_C : Finset (Package N V))
12
+
(π : Finset (Package N V × Package N V))
13
+
(Δ_C : DepRel N V) (g : V → G) :
14
+
liftResolution g (completenessWitness S_C π Δ_C g) = S_C := by
15
+
ext p
16
+
simp only [mem_liftResolution, completenessWitness, Finset.mem_union, Finset.mem_image,
17
+
Finset.mem_biUnion, embedPkg]
18
+
constructor
19
+
· intro h
20
+
rcases h with ⟨⟨n, v⟩, hqS, heq⟩ | ⟨a, haΔ, hmem⟩
21
+
· simp only [Prod.mk.injEq] at heq
22
+
obtain ⟨h1, h2⟩ := heq
23
+
have ⟨hn, _⟩ := hcnm.granularN_injective h1
24
+
have hv := hcvr.origV.injective h2
25
+
exact (Prod.ext hn hv : (n, v) = p) ▸ hqS
26
+
· obtain ⟨⟨n, v⟩, m, vs⟩ := a
27
+
simp only at hmem
28
+
split at hmem
29
+
case isTrue h =>
30
+
simp only [Finset.mem_image, Finset.mem_filter, Prod.mk.injEq] at hmem
31
+
obtain ⟨_, _, ⟨heq, _⟩⟩ := hmem
32
+
exact absurd heq.symm (hcnm.granularN_ne_intermediateN _ _ _ _ _)
33
+
case isFalse => exact (List.mem_nil_iff _ |>.mp hmem).elim
34
+
· intro hp
35
+
exact Or.inl ⟨p, hp, rfl⟩
36
+
37
+
theorem liftResolution_completeness
38
+
(R_C : Real N V) (Δ_C : DepRel N V)
39
+
(g : V → G) (r : Package N V)
40
+
(S_C : Finset (Package N V))
41
+
(π : Finset (Package N V × Package N V))
42
+
(hres : IsConcurrentResolution R_C Δ_C g r S_C π)
43
+
(hfunc : ∀ p m vs₁ vs₂, (p, m, vs₁) ∈ Δ_C → (p, m, vs₂) ∈ Δ_C → vs₁ = vs₂) :
44
+
∃ S', IsResolution (concurrentReal R_C Δ_C g) (concurrentDeps Δ_C g)
45
+
(embedPkg g r) S' ∧ liftResolution g S' = S_C :=
46
+
⟨completenessWitness S_C π Δ_C g,
47
+
concurrent_completeness R_C Δ_C g r S_C π hres hfunc,
48
+
liftResolution_completenessWitness S_C π Δ_C g⟩
49
+
50
+
51
+
end PackageCalculus.Concurrent
+90
PackageCalculus/Extensions/Concurrent/Lifting/Definition.lean
+90
PackageCalculus/Extensions/Concurrent/Lifting/Definition.lean
···
1
+
import PackageCalculus.Extensions.Concurrent.Reduction.Completeness
2
+
import PackageCalculus.Extensions.Concurrent.Reduction.Soundness
3
+
4
+
namespace PackageCalculus.Concurrent
5
+
6
+
set_option linter.unusedSectionVars false
7
+
8
+
variable {N : Type*} [DecidableEq N] {V : Type*} [DecidableEq V] {G : Type*} [DecidableEq G]
9
+
variable {N' : Type*} [DecidableEq N'] {V' : Type*} [DecidableEq V']
10
+
variable [hcnm : HasConcurrentNames N V G N'] [hcvr : HasConcurrentVersions V G V']
11
+
12
+
private def embedPkgFn (g : V → G) : Package N V → Package N' V' :=
13
+
fun p => (hcnm.granularN p.1 (g p.2), hcvr.origV p.2)
14
+
15
+
theorem embedPkgFn_injective (g : V → G) :
16
+
Function.Injective (embedPkgFn g : Package N V → Package N' V') := by
17
+
intro ⟨n₁, v₁⟩ ⟨n₂, v₂⟩ h
18
+
simp only [embedPkgFn, Prod.mk.injEq] at h
19
+
obtain ⟨h1, h2⟩ := h
20
+
have ⟨hn, _⟩ := hcnm.granularN_injective h1
21
+
exact Prod.ext hn (hcvr.origV.injective h2)
22
+
23
+
private def tryInvPkg (g : V → G) (p' : Package N' V') : Option (Package N V) :=
24
+
match hcvr.tryOrigV p'.2 with
25
+
| some v =>
26
+
match hcnm.tryGranularN p'.1 with
27
+
| some (n, g') => if g v = g' then some (n, v) else none
28
+
| none => none
29
+
| none => none
30
+
31
+
theorem tryInvPkg_embed (g : V → G) (p : Package N V) :
32
+
tryInvPkg g (embedPkg g p) = some p := by
33
+
simp only [tryInvPkg, embedPkg, hcvr.tryOrigV_origV, hcnm.tryGranularN_granularN, ite_true]
34
+
35
+
theorem tryInvPkg_some (g : V → G) {p' : Package N' V'} {p : Package N V}
36
+
(h : p ∈ tryInvPkg g p') : embedPkg g p = p' := by
37
+
obtain ⟨n, v⟩ := p; obtain ⟨n', v'⟩ := p'
38
+
simp only [tryInvPkg, Option.mem_def] at h
39
+
generalize hv : hcvr.tryOrigV v' = ov at h
40
+
generalize hg : hcnm.tryGranularN n' = og at h
41
+
match ov, og with
42
+
| some v₀, some ng =>
43
+
simp only at h
44
+
split at h
45
+
· rename_i heq_g
46
+
simp only [Option.some.injEq, Prod.mk.injEq] at h
47
+
obtain ⟨rfl, rfl⟩ := h
48
+
simp only [embedPkg, Prod.mk.injEq]
49
+
exact ⟨by rw [heq_g]; exact hcnm.tryGranularN_some _ _ hg,
50
+
hcvr.tryOrigV_some _ _ hv⟩
51
+
· simp at h
52
+
| some _, none => simp at h
53
+
| none, _ => simp at h
54
+
55
+
private theorem tryInvPkg_inj (g : V → G) :
56
+
∀ a a' (b : Package N V), b ∈ tryInvPkg g a → b ∈ tryInvPkg g a' → a = a' := by
57
+
intro a a' b ha ha'
58
+
exact (tryInvPkg_some g ha).symm.trans (tryInvPkg_some g ha')
59
+
60
+
/-! ## Lift functions -/
61
+
62
+
def liftReal (g : V → G) (R' : Real N' V') : Real N V :=
63
+
R'.filterMap (tryInvPkg g) (tryInvPkg_inj g)
64
+
65
+
def liftResolution (g : V → G) (S' : Finset (Package N' V')) :
66
+
Finset (Package N V) :=
67
+
S'.filterMap (tryInvPkg g) (tryInvPkg_inj g)
68
+
69
+
/-! ## Membership lemmas -/
70
+
71
+
theorem mem_liftReal {g : V → G} {R' : Real N' V'} {p : Package N V} :
72
+
p ∈ liftReal g R' ↔ embedPkg g p ∈ R' := by
73
+
simp only [liftReal, Finset.mem_filterMap]
74
+
constructor
75
+
· rintro ⟨p', hp', hinv⟩
76
+
have := tryInvPkg_some g (Option.mem_def.mpr hinv)
77
+
rwa [this]
78
+
· intro hp; exact ⟨embedPkg g p, hp, Option.mem_def.mpr (tryInvPkg_embed g p)⟩
79
+
80
+
theorem mem_liftResolution {g : V → G} {S' : Finset (Package N' V')} {p : Package N V} :
81
+
p ∈ liftResolution g S' ↔ embedPkg g p ∈ S' := by
82
+
simp only [liftResolution, Finset.mem_filterMap]
83
+
constructor
84
+
· rintro ⟨p', hp', hinv⟩
85
+
have := tryInvPkg_some g (Option.mem_def.mpr hinv)
86
+
rwa [this]
87
+
· intro hp; exact ⟨embedPkg g p, hp, Option.mem_def.mpr (tryInvPkg_embed g p)⟩
88
+
89
+
90
+
end PackageCalculus.Concurrent
+37
PackageCalculus/Extensions/Concurrent/Lifting/Retraction.lean
+37
PackageCalculus/Extensions/Concurrent/Lifting/Retraction.lean
···
1
+
import PackageCalculus.Extensions.Concurrent.Lifting.Definition
2
+
3
+
namespace PackageCalculus.Concurrent
4
+
5
+
set_option linter.unusedSectionVars false
6
+
7
+
variable {N : Type*} [DecidableEq N] {V : Type*} [DecidableEq V] {G : Type*} [DecidableEq G]
8
+
variable {N' : Type*} [DecidableEq N'] {V' : Type*} [DecidableEq V']
9
+
variable [hcnm : HasConcurrentNames N V G N'] [hcvr : HasConcurrentVersions V G V']
10
+
11
+
/-! ## Round-trip theorems -/
12
+
13
+
theorem liftReal_concurrentReal (R : Real N V) (Δ : DepRel N V) (g : V → G) :
14
+
liftReal g (concurrentReal (N' := N') (V' := V') R Δ g) = R := by
15
+
ext p
16
+
simp only [mem_liftReal, concurrentReal, embedReal, Finset.mem_union, Finset.mem_image,
17
+
Finset.mem_biUnion]
18
+
constructor
19
+
· intro h
20
+
rcases h with ⟨q, hqR, heq⟩ | ⟨a, haΔ, hmem⟩
21
+
· simp only [embedPkg, Prod.mk.injEq] at heq
22
+
obtain ⟨h1, h2⟩ := heq
23
+
have ⟨hn, _⟩ := hcnm.granularN_injective h1
24
+
have hv := hcvr.origV.injective h2
25
+
exact (Prod.ext hn hv : q = p) ▸ hqR
26
+
· obtain ⟨⟨n, v⟩, m, vs⟩ := a
27
+
simp only at hmem
28
+
split at hmem
29
+
· simp only [Finset.mem_image, embedPkg, Prod.mk.injEq] at hmem
30
+
obtain ⟨_, _, ⟨heq, _⟩⟩ := hmem
31
+
exact absurd heq.symm (hcnm.granularN_ne_intermediateN _ _ _ _ _)
32
+
· exact (List.mem_nil_iff _).mp hmem |>.elim
33
+
· intro hp
34
+
exact Or.inl ⟨p, hp, rfl⟩
35
+
36
+
37
+
end PackageCalculus.Concurrent
+36
PackageCalculus/Extensions/Concurrent/Lifting/Soundness.lean
+36
PackageCalculus/Extensions/Concurrent/Lifting/Soundness.lean
···
1
+
import PackageCalculus.Extensions.Concurrent.Lifting.Definition
2
+
3
+
namespace PackageCalculus.Concurrent
4
+
5
+
set_option linter.unusedSectionVars false
6
+
7
+
variable {N : Type*} [DecidableEq N] {V : Type*} [DecidableEq V] {G : Type*} [DecidableEq G]
8
+
variable {N' : Type*} [DecidableEq N'] {V' : Type*} [DecidableEq V']
9
+
variable [hcnm : HasConcurrentNames N V G N'] [hcvr : HasConcurrentVersions V G V']
10
+
11
+
/-! ## Lifting soundness & completeness -/
12
+
13
+
theorem liftResolution_soundness
14
+
(R_C : Real N V) (Δ_C : DepRel N V)
15
+
(g : V → G) (r : Package N V)
16
+
(S' : Finset (Package N' V'))
17
+
(hres : IsResolution (concurrentReal R_C Δ_C g) (concurrentDeps Δ_C g)
18
+
(embedPkg g r) S')
19
+
(hfunc : ∀ p m vs₁ vs₂, (p, m, vs₁) ∈ Δ_C → (p, m, vs₂) ∈ Δ_C → vs₁ = vs₂)
20
+
(hne_dep : ∀ p m vs, (p, m, vs) ∈ Δ_C → vs.Nonempty) :
21
+
∃ π, IsConcurrentResolution R_C Δ_C g r (liftResolution g S') π := by
22
+
have hsound := concurrent_soundness R_C Δ_C g r S' hres hfunc hne_dep
23
+
-- The preimageS used internally equals our liftResolution extensionally
24
+
suffices heq : liftResolution g S' = S'.preimage (embedPkg g)
25
+
(Set.InjOn.mono (Set.subset_univ _)
26
+
(Function.Injective.injOn (embedPkgFn_injective g))) by
27
+
rw [heq]; exact ⟨_, hsound⟩
28
+
ext p; simp only [liftResolution, Finset.mem_filterMap, Finset.mem_preimage]
29
+
constructor
30
+
· rintro ⟨p', hp', hinv⟩
31
+
have := tryInvPkg_some g (Option.mem_def.mpr hinv)
32
+
rwa [this]
33
+
· intro hp; exact ⟨embedPkg g p, hp, Option.mem_def.mpr (tryInvPkg_embed g p)⟩
34
+
35
+
36
+
end PackageCalculus.Concurrent
+207
PackageCalculus/Extensions/Concurrent/Reduction/Completeness.lean
+207
PackageCalculus/Extensions/Concurrent/Reduction/Completeness.lean
···
1
+
import PackageCalculus.Extensions.Concurrent.Reduction.Definition
2
+
3
+
/-! # Concurrent extension: completeness
4
+
5
+
Any concurrent resolution can be expanded into a core resolution of the
6
+
concurrent encoding. -/
7
+
8
+
namespace PackageCalculus.Concurrent
9
+
10
+
open Classical
11
+
12
+
set_option linter.unusedSectionVars false
13
+
14
+
variable {N : Type*} {V : Type*} {G : Type*}
15
+
variable {N' : Type*} {V' : Type*}
16
+
variable [DecidableEq N] [DecidableEq V] [DecidableEq G] [DecidableEq N'] [DecidableEq V']
17
+
variable [hcnm : HasConcurrentNames N V G N'] [hcvr : HasConcurrentVersions V G V']
18
+
19
+
def completenessWitness (S_C : Finset (Package N V))
20
+
(π : Finset (Package N V × Package N V))
21
+
(Δ_C : DepRel N V) (g : V → G) :
22
+
Finset (Package N' V') :=
23
+
-- Granular packages: (⟨n, g(v)⟩, orig v) for (n, v) ∈ S_C
24
+
S_C.image (fun ⟨n, v⟩ => (hcnm.granularN n (g v), hcvr.origV v)) ∪
25
+
-- Intermediate packages for split case:
26
+
-- (⟨n, v, m⟩, gran (g u)) where ((n,v),m,vs) ∈ Δ_C, isSplit, (n,v) ∈ S_C,
27
+
-- (m,u) ∈ S_C, u ∈ vs, ((m,u),(n,v)) ∈ π
28
+
(Δ_C.biUnion (fun ⟨⟨n, v⟩, m, vs⟩ =>
29
+
if isSplit g vs ∧ (n, v) ∈ S_C then
30
+
(vs.filter (fun u => (m, u) ∈ S_C ∧ ((m, u), (n, v)) ∈ π)).image
31
+
(fun u => (hcnm.intermediateN n v m, hcvr.granV (g u)))
32
+
else ∅))
33
+
34
+
private theorem mem_gran {S_C : Finset (Package N V)}
35
+
{π : Finset (Package N V × Package N V)}
36
+
{Δ_C : DepRel N V} {g : V → G}
37
+
{n : N} {v : V} (h : (n, v) ∈ S_C) :
38
+
(hcnm.granularN n (g v), hcvr.origV v) ∈
39
+
completenessWitness S_C π Δ_C g :=
40
+
Finset.mem_union.mpr (Or.inl (Finset.mem_image.mpr ⟨⟨n, v⟩, h, rfl⟩))
41
+
42
+
private theorem mem_inter {S_C : Finset (Package N V)}
43
+
{π : Finset (Package N V × Package N V)}
44
+
{Δ_C : DepRel N V} {g : V → G}
45
+
{n : N} {v : V} {m : N} {vs : Finset V} {u : V}
46
+
(hdep : ((n, v), m, vs) ∈ Δ_C) (hnv : (n, v) ∈ S_C)
47
+
(hspl : isSplit g vs) (hmu : (m, u) ∈ S_C) (hu : u ∈ vs)
48
+
(hπ : ((m, u), (n, v)) ∈ π) :
49
+
(hcnm.intermediateN n v m, hcvr.granV (g u)) ∈
50
+
completenessWitness S_C π Δ_C g := by
51
+
simp only [completenessWitness, Finset.mem_union, Finset.mem_biUnion]
52
+
right
53
+
refine ⟨⟨⟨n, v⟩, m, vs⟩, hdep, ?_⟩
54
+
simp only
55
+
rw [if_pos ⟨hspl, hnv⟩]
56
+
exact Finset.mem_image.mpr ⟨u, Finset.mem_filter.mpr ⟨hu, hmu, hπ⟩, rfl⟩
57
+
58
+
private theorem completenessWitness_mem_cases {S_C : Finset (Package N V)}
59
+
{π : Finset (Package N V × Package N V)}
60
+
{Δ_C : DepRel N V} {g : V → G}
61
+
{q : Package N' V'} (hq : q ∈ completenessWitness S_C π Δ_C g) :
62
+
(∃ n v, (n, v) ∈ S_C ∧ q = (hcnm.granularN n (g v), hcvr.origV v)) ∨
63
+
(∃ n v m vs u, ((n, v), m, vs) ∈ Δ_C ∧ (n, v) ∈ S_C ∧ isSplit g vs ∧
64
+
(m, u) ∈ S_C ∧ u ∈ vs ∧ ((m, u), (n, v)) ∈ π ∧
65
+
q = (hcnm.intermediateN n v m, hcvr.granV (g u))) := by
66
+
simp only [completenessWitness, Finset.mem_union, Finset.mem_image, Finset.mem_biUnion] at hq
67
+
rcases hq with ⟨⟨n, v⟩, hmem, rfl⟩ | ⟨⟨⟨n, v⟩, m, vs⟩, hdep, hmem⟩
68
+
· exact Or.inl ⟨n, v, hmem, rfl⟩
69
+
· right
70
+
simp only at hmem
71
+
split at hmem
72
+
case isTrue h =>
73
+
obtain ⟨hspl, hnv⟩ := h
74
+
simp only [Finset.mem_image, Finset.mem_filter] at hmem
75
+
obtain ⟨u, ⟨hu, hmu, hπ⟩, rfl⟩ := hmem
76
+
exact ⟨n, v, m, vs, u, hdep, hnv, hspl, hmu, hu, hπ, rfl⟩
77
+
case isFalse => exact (List.mem_nil_iff _ |>.mp hmem).elim
78
+
79
+
-- Paper Thm 4.2.5 (Concurrent Reduction Completeness).
80
+
theorem concurrent_completeness
81
+
(R_C : Real N V) (Δ_C : DepRel N V)
82
+
(g : V → G) (r : Package N V)
83
+
(S_C : Finset (Package N V))
84
+
(π : Finset (Package N V × Package N V))
85
+
(hres : IsConcurrentResolution R_C Δ_C g r S_C π)
86
+
(hfunc : ∀ p m vs₁ vs₂, (p, m, vs₁) ∈ Δ_C → (p, m, vs₂) ∈ Δ_C → vs₁ = vs₂) :
87
+
IsResolution (concurrentReal R_C Δ_C g) (concurrentDeps Δ_C g)
88
+
(embedPkg g r) (completenessWitness S_C π Δ_C g) := by
89
+
refine ⟨?_, ?_, ?_, ?_⟩
90
+
· -- subset
91
+
intro q hq
92
+
rcases completenessWitness_mem_cases hq with
93
+
⟨n, v, hmem, rfl⟩ | ⟨n, v, m, vs, u, hdep, hnv, hspl, hmu, hu, hπ, rfl⟩
94
+
· simp only [concurrentReal, embedReal, Finset.mem_union, Finset.mem_image, Finset.mem_biUnion]
95
+
left; exact ⟨⟨n, v⟩, hres.subset hmem, rfl⟩
96
+
· simp only [concurrentReal, embedReal, Finset.mem_union, Finset.mem_image, Finset.mem_biUnion]
97
+
right
98
+
refine ⟨⟨⟨n, v⟩, m, vs⟩, hdep, ?_⟩
99
+
simp only; rw [if_pos hspl]
100
+
exact Finset.mem_image.mpr ⟨u, hu, rfl⟩
101
+
· -- root_mem
102
+
obtain ⟨rn, rv⟩ := r
103
+
exact mem_gran hres.root_mem
104
+
· -- dep_closure
105
+
intro q hq m_dep dep_vs hd
106
+
rcases completenessWitness_mem_cases hq with
107
+
⟨n, v, hmem, rfl⟩ | ⟨n, v, m, vs, u, hdep, hnv, hspl, hmu, hu, hπ, rfl⟩
108
+
· -- granular package (granularN n (g v), origV v)
109
+
simp only [concurrentDeps, Finset.mem_union, Finset.mem_biUnion] at hd
110
+
rcases hd with ((⟨a, haΔ, hmem_d⟩ | ⟨a, haΔ, hmem_d⟩) | ⟨a, haΔ, hmem_d⟩)
111
+
· -- direct case
112
+
obtain ⟨⟨n', v'⟩, m', vs'⟩ := a
113
+
simp only at hmem_d; split at hmem_d
114
+
case isTrue hdir =>
115
+
simp only [Finset.mem_image, Prod.mk.injEq] at hmem_d
116
+
obtain ⟨u', hu', ⟨⟨h1, h2⟩, rfl, rfl⟩⟩ := hmem_d
117
+
have ⟨h1a, _⟩ := hcnm.granularN_injective h1; subst h1a
118
+
have h2' := hcvr.origV.injective h2; subst h2'
119
+
obtain ⟨u, ⟨huv, hmuS, _⟩, _⟩ := hres.parent_closure _ hmem _ _ haΔ
120
+
refine ⟨hcvr.origV u, Finset.mem_map.mpr ⟨u, huv, rfl⟩, ?_⟩
121
+
have hgu_eq : g u = g u' := hdir u u' huv hu'
122
+
exact hgu_eq ▸ mem_gran hmuS
123
+
case isFalse => exact (List.mem_nil_iff _ |>.mp hmem_d).elim
124
+
· -- split depender→intermediate
125
+
obtain ⟨⟨n', v'⟩, m', vs'⟩ := a
126
+
simp only at hmem_d; split at hmem_d
127
+
case isTrue hspl =>
128
+
simp only [Finset.mem_singleton, Prod.mk.injEq] at hmem_d
129
+
obtain ⟨⟨h1, h2⟩, rfl, rfl⟩ := hmem_d
130
+
have ⟨h1a, _⟩ := hcnm.granularN_injective h1; subst h1a
131
+
have h2' := hcvr.origV.injective h2; subst h2'
132
+
obtain ⟨u, ⟨huv, hmuS, hmuπ⟩, _⟩ := hres.parent_closure _ hmem _ _ haΔ
133
+
refine ⟨hcvr.granV (g u),
134
+
Finset.mem_map.mpr ⟨g u, Finset.mem_image.mpr ⟨u, huv, rfl⟩, rfl⟩,
135
+
mem_inter haΔ hmem hspl hmuS huv hmuπ⟩
136
+
case isFalse => exact (List.mem_nil_iff _ |>.mp hmem_d).elim
137
+
· -- split intermediate→dependee: source is granular, contradiction
138
+
obtain ⟨⟨n', v'⟩, m', vs'⟩ := a
139
+
simp only at hmem_d; split at hmem_d
140
+
case isTrue =>
141
+
simp only [Finset.mem_image, Prod.mk.injEq] at hmem_d
142
+
obtain ⟨_, _, ⟨⟨h1, _⟩, _, _⟩⟩ := hmem_d
143
+
exact absurd h1 (hcnm.intermediateN_ne_granularN _ _ _ _ _)
144
+
case isFalse => exact (List.mem_nil_iff _ |>.mp hmem_d).elim
145
+
· -- intermediate package (intermediateN n v m, granV (g u))
146
+
simp only [concurrentDeps, Finset.mem_union, Finset.mem_biUnion] at hd
147
+
rcases hd with ((⟨a, haΔ, hmem_d⟩ | ⟨a, haΔ, hmem_d⟩) | ⟨a, haΔ, hmem_d⟩)
148
+
· -- direct case: intermediateN = granularN, contradiction
149
+
obtain ⟨⟨n', v'⟩, m', vs'⟩ := a
150
+
simp only at hmem_d; split at hmem_d
151
+
case isTrue =>
152
+
simp only [Finset.mem_image, Prod.mk.injEq] at hmem_d
153
+
obtain ⟨_, _, ⟨⟨h1, _⟩, _, _⟩⟩ := hmem_d
154
+
exact absurd h1 (hcnm.granularN_ne_intermediateN _ _ _ _ _)
155
+
case isFalse => exact (List.mem_nil_iff _ |>.mp hmem_d).elim
156
+
· -- split depender→intermediate: intermediateN = granularN, contradiction
157
+
obtain ⟨⟨n', v'⟩, m', vs'⟩ := a
158
+
simp only at hmem_d; split at hmem_d
159
+
case isTrue =>
160
+
simp only [Finset.mem_singleton, Prod.mk.injEq] at hmem_d
161
+
obtain ⟨⟨h1, _⟩, _, _⟩ := hmem_d
162
+
exact absurd h1 (hcnm.intermediateN_ne_granularN _ _ _ _ _)
163
+
case isFalse => exact (List.mem_nil_iff _ |>.mp hmem_d).elim
164
+
· -- split intermediate→dependee
165
+
obtain ⟨⟨n', v'⟩, m', vs'⟩ := a
166
+
simp only at hmem_d; split at hmem_d
167
+
case isTrue hspl' =>
168
+
simp only [Finset.mem_image, Prod.mk.injEq] at hmem_d
169
+
obtain ⟨u', hu'vs, ⟨⟨h1, h2⟩, rfl, rfl⟩⟩ := hmem_d
170
+
-- h1 : intermediateN n' v' m' = intermediateN n v m
171
+
-- After injective: n' = n, v' = v, m' = m
172
+
obtain ⟨rfl, rfl, rfl⟩ := hcnm.intermediateN_injective _ _ _ _ _ _ h1.symm
173
+
have hgu := hcvr.granV.injective h2
174
+
have hvs := hfunc _ _ _ _ hdep haΔ; subst hvs
175
+
refine ⟨hcvr.origV u,
176
+
Finset.mem_map.mpr ⟨u, Finset.mem_filter.mpr ⟨hu, hgu.symm⟩, rfl⟩,
177
+
hgu.symm ▸ mem_gran hmu⟩
178
+
case isFalse => exact (List.mem_nil_iff _ |>.mp hmem_d).elim
179
+
· -- version_unique
180
+
intro nm cv₁ cv₂ hv₁ hv₂
181
+
rcases completenessWitness_mem_cases hv₁ with
182
+
⟨n₁, v₁, hmem₁, heq1⟩ | ⟨n₁, vp₁, m₁, vs₁, u₁, hd₁, hnv₁, _, hmu₁, hu₁, hπ₁, heq1⟩ <;>
183
+
rcases completenessWitness_mem_cases hv₂ with
184
+
⟨n₂, v₂, hmem₂, heq2⟩ | ⟨n₂, vp₂, m₂, vs₂, u₂, hd₂, hnv₂, _, hmu₂, hu₂, hπ₂, heq2⟩ <;>
185
+
simp only [Prod.mk.injEq] at heq1 heq2
186
+
· -- granular × granular
187
+
obtain ⟨h1n, rfl⟩ := heq1; obtain ⟨h2n, rfl⟩ := heq2
188
+
have ⟨rfl, h1g⟩ := hcnm.granularN_injective (h1n.symm.trans h2n)
189
+
by_contra hne
190
+
have hne' : v₁ ≠ v₂ := fun h => hne (congrArg hcvr.origV h)
191
+
exact hres.version_granularity _ _ _ hmem₁ hmem₂ hne' h1g
192
+
· -- granular × intermediate: name clash
193
+
obtain ⟨h1n, _⟩ := heq1; obtain ⟨h2n, _⟩ := heq2
194
+
exact absurd (h1n.symm.trans h2n) (hcnm.granularN_ne_intermediateN _ _ _ _ _)
195
+
· -- intermediate × granular: name clash
196
+
obtain ⟨h1n, _⟩ := heq1; obtain ⟨h2n, _⟩ := heq2
197
+
exact absurd (h1n.symm.trans h2n) (hcnm.intermediateN_ne_granularN _ _ _ _ _)
198
+
· -- intermediate × intermediate
199
+
obtain ⟨h1n, rfl⟩ := heq1; obtain ⟨h2n, rfl⟩ := heq2
200
+
obtain ⟨rfl, rfl, rfl⟩ := hcnm.intermediateN_injective _ _ _ _ _ _ (h1n.symm.trans h2n)
201
+
have hvs := hfunc (n₁, vp₁) m₁ vs₁ vs₂ hd₁ hd₂; subst hvs
202
+
obtain ⟨w, _, huniq⟩ := hres.parent_closure _ hnv₁ _ _ hd₁
203
+
have h1 := huniq u₁ ⟨hu₁, hmu₁, hπ₁⟩
204
+
have h2 := huniq u₂ ⟨hu₂, hmu₂, hπ₂⟩
205
+
exact congrArg hcvr.granV (congrArg g (h1.trans h2.symm))
206
+
207
+
end PackageCalculus.Concurrent
+136
PackageCalculus/Extensions/Concurrent/Reduction/Definition.lean
+136
PackageCalculus/Extensions/Concurrent/Reduction/Definition.lean
···
1
+
import PackageCalculus.Extensions.Concurrent.Definition
2
+
import Mathlib.Data.Finset.Image
3
+
import Mathlib.Data.Finset.Union
4
+
5
+
/-! # Concurrent extension: reduction
6
+
7
+
Encodes a concurrent dependency problem as a core resolution problem by
8
+
introducing intermediate packages that mediate version selection between
9
+
co-installed siblings. -/
10
+
11
+
namespace PackageCalculus.Concurrent
12
+
13
+
variable {N : Type*} {V : Type*} {G : Type*}
14
+
15
+
inductive ConcurrentName (N V G : Type*) where
16
+
| granular : N → G → ConcurrentName N V G
17
+
| intermediate : N → V → N → ConcurrentName N V G
18
+
deriving DecidableEq
19
+
20
+
inductive ConcurrentVersion (V G : Type*) where
21
+
| orig : V → ConcurrentVersion V G
22
+
| gran : G → ConcurrentVersion V G
23
+
deriving DecidableEq
24
+
25
+
variable {N' : Type*} {V' : Type*}
26
+
variable [hcnm : HasConcurrentNames N V G N'] [hcvr : HasConcurrentVersions V G V']
27
+
28
+
def embedPkg (g : V → G) (p : Package N V) : Package N' V' :=
29
+
(hcnm.granularN p.1 (g p.2), hcvr.origV p.2)
30
+
31
+
/-- A version set is split when it contains versions of different granularity. -/
32
+
def isSplit (g : V → G) (vs : Finset V) : Prop :=
33
+
∃ u₁ u₂, u₁ ∈ vs ∧ u₂ ∈ vs ∧ g u₁ ≠ g u₂
34
+
35
+
/-- A version set is direct when all versions have the same granularity. -/
36
+
def isDirect (g : V → G) (vs : Finset V) : Prop :=
37
+
∀ u₁ u₂, u₁ ∈ vs → u₂ ∈ vs → g u₁ = g u₂
38
+
39
+
variable [DecidableEq N] [DecidableEq V] [DecidableEq G] [DecidableEq N'] [DecidableEq V']
40
+
41
+
instance decidableIsSplit (g : V → G) (vs : Finset V) : Decidable (isSplit g vs) :=
42
+
decidable_of_iff (∃ u₁ ∈ vs, ∃ u₂ ∈ vs, g u₁ ≠ g u₂)
43
+
⟨fun ⟨u₁, h₁, u₂, h₂, hne⟩ => ⟨u₁, u₂, h₁, h₂, hne⟩,
44
+
fun ⟨u₁, u₂, h₁, h₂, hne⟩ => ⟨u₁, h₁, u₂, h₂, hne⟩⟩
45
+
46
+
instance decidableIsDirect (g : V → G) (vs : Finset V) : Decidable (isDirect g vs) :=
47
+
decidable_of_iff (∀ u₁ ∈ vs, ∀ u₂ ∈ vs, g u₁ = g u₂)
48
+
⟨fun h u₁ u₂ h₁ h₂ => h u₁ h₁ u₂ h₂,
49
+
fun h u₁ h₁ u₂ h₂ => h u₁ u₂ h₁ h₂⟩
50
+
51
+
def embedReal (R : Real N V) (g : V → G) : Real N' V' :=
52
+
R.image (embedPkg g)
53
+
54
+
def concurrentReal (R_C : Real N V) (Δ : DepRel N V) (g : V → G) :
55
+
Real N' V' :=
56
+
-- Granular packages: (⟨n, g(v)⟩, orig v)
57
+
embedReal R_C g ∪
58
+
-- Intermediate packages (for the split case): (⟨n, v, m⟩, gran (g u)) for u ∈ vs
59
+
(Δ.biUnion (fun ⟨⟨n, v⟩, m, vs⟩ =>
60
+
if isSplit g vs then
61
+
vs.image (fun u => (hcnm.intermediateN n v m, hcvr.granV (g u)))
62
+
else ∅))
63
+
64
+
def concurrentDeps (Δ_C : DepRel N V) (g : V → G) :
65
+
DepRel N' V' :=
66
+
-- Direct case: single granular version
67
+
(Δ_C.biUnion (fun ⟨⟨n, v⟩, m, vs⟩ =>
68
+
if isDirect g vs then
69
+
vs.image (fun u =>
70
+
((hcnm.granularN n (g v), hcvr.origV v),
71
+
hcnm.granularN m (g u),
72
+
vs.map hcvr.origV))
73
+
else ∅)) ∪
74
+
-- Split case: depender to intermediate
75
+
(Δ_C.biUnion (fun ⟨⟨n, v⟩, m, vs⟩ =>
76
+
if isSplit g vs then
77
+
{((hcnm.granularN n (g v), hcvr.origV v),
78
+
hcnm.intermediateN n v m,
79
+
(vs.image (fun u => g u)).map hcvr.granV)}
80
+
else ∅)) ∪
81
+
-- Split case: intermediate to dependee
82
+
(Δ_C.biUnion (fun ⟨⟨n, v⟩, m, vs⟩ =>
83
+
if isSplit g vs then
84
+
vs.image (fun u =>
85
+
((hcnm.intermediateN n v m, hcvr.granV (g u)),
86
+
hcnm.granularN m (g u),
87
+
(vs.filter (fun w => g w = g u)).map hcvr.origV))
88
+
else ∅))
89
+
90
+
end PackageCalculus.Concurrent
91
+
92
+
namespace PackageCalculus
93
+
94
+
open Function
95
+
96
+
variable {N V G : Type*}
97
+
98
+
instance : Concurrent.HasConcurrentNames N V G (Concurrent.ConcurrentName N V G) where
99
+
granularN := Concurrent.ConcurrentName.granular
100
+
granularN_injective := by
101
+
intro a₁ a₂ b₁ b₂ h
102
+
exact ⟨Concurrent.ConcurrentName.granular.inj h |>.1,
103
+
Concurrent.ConcurrentName.granular.inj h |>.2⟩
104
+
intermediateN := Concurrent.ConcurrentName.intermediate
105
+
intermediateN_injective := by
106
+
intro n₁ v₁ m₁ n₂ v₂ m₂ h
107
+
have := Concurrent.ConcurrentName.intermediate.inj h
108
+
exact ⟨this.1, this.2.1, this.2.2⟩
109
+
granularN_ne_intermediateN := fun _ _ _ _ _ => nofun
110
+
intermediateN_ne_granularN := fun _ _ _ _ _ => nofun
111
+
tryGranularN := fun
112
+
| .granular n g => some (n, g)
113
+
| _ => none
114
+
tryGranularN_granularN := fun _ _ => rfl
115
+
tryGranularN_some := fun n' p h => by
116
+
cases n' with
117
+
| granular n g => simp at h; obtain ⟨rfl, rfl⟩ := h; rfl
118
+
| intermediate _ _ _ => simp at h
119
+
120
+
instance : Concurrent.HasConcurrentVersions V G (Concurrent.ConcurrentVersion V G) where
121
+
origV := ⟨Concurrent.ConcurrentVersion.orig,
122
+
fun _ _ h => Concurrent.ConcurrentVersion.orig.inj h⟩
123
+
granV := ⟨Concurrent.ConcurrentVersion.gran,
124
+
fun _ _ h => Concurrent.ConcurrentVersion.gran.inj h⟩
125
+
origV_ne_granV := fun _ _ => nofun
126
+
granV_ne_origV := fun _ _ => nofun
127
+
tryOrigV := fun
128
+
| .orig v => some v
129
+
| _ => none
130
+
tryOrigV_origV := fun _ => rfl
131
+
tryOrigV_some := fun v' v h => by
132
+
cases v' with
133
+
| orig w => simp at h; subst h; rfl
134
+
| gran _ => simp at h
135
+
136
+
end PackageCalculus
+211
PackageCalculus/Extensions/Concurrent/Reduction/Soundness.lean
+211
PackageCalculus/Extensions/Concurrent/Reduction/Soundness.lean
···
1
+
import PackageCalculus.Extensions.Concurrent.Reduction.Definition
2
+
import Mathlib.Data.Finset.Preimage
3
+
4
+
/-! # Concurrent extension: soundness
5
+
6
+
Any core resolution of the concurrent encoding projects back to a valid
7
+
concurrent resolution of the original problem. -/
8
+
9
+
namespace PackageCalculus.Concurrent
10
+
11
+
open Classical
12
+
13
+
set_option linter.unusedSectionVars false
14
+
15
+
variable {N : Type*} {V : Type*} {G : Type*}
16
+
variable {N' : Type*} {V' : Type*}
17
+
variable [DecidableEq N] [DecidableEq V] [DecidableEq G] [DecidableEq N'] [DecidableEq V']
18
+
variable [hcnm : HasConcurrentNames N V G N'] [hcvr : HasConcurrentVersions V G V']
19
+
20
+
private theorem embedPkg_injective (g : V → G) :
21
+
Function.Injective (embedPkg (N := N) (N' := N') (V' := V') g) := by
22
+
intro ⟨n₁, v₁⟩ ⟨n₂, v₂⟩ h
23
+
simp only [embedPkg, Prod.mk.injEq] at h
24
+
obtain ⟨h1, h2⟩ := h
25
+
have ⟨hn, _⟩ := hcnm.granularN_injective h1
26
+
have hv := hcvr.origV.injective h2
27
+
exact Prod.ext hn hv
28
+
29
+
private noncomputable def preimageS (g : V → G) (S : Finset (Package N' V')) :
30
+
Finset (Package N V) :=
31
+
S.preimage (embedPkg g) (Set.InjOn.mono (Set.subset_univ _)
32
+
(Function.Injective.injOn (embedPkg_injective g)))
33
+
34
+
private theorem mem_preimageS {g : V → G} {S : Finset (Package N' V')} {p : Package N V} :
35
+
p ∈ preimageS g S ↔ embedPkg g p ∈ S := by
36
+
simp [preimageS, Finset.mem_preimage]
37
+
38
+
/-- Construct the parent-witness relation π as a Finset from Δ_C and S. -/
39
+
private def soundnessπ (Δ_C : DepRel N V) (g : V → G)
40
+
(S : Finset (Package N' V')) : Finset (Package N V × Package N V) :=
41
+
Δ_C.biUnion (fun ⟨⟨n, v⟩, m, vs⟩ =>
42
+
vs.filter (fun u =>
43
+
(hcnm.granularN m (g u), hcvr.origV u) ∈ S ∧
44
+
(hcnm.granularN n (g v), hcvr.origV v) ∈ S ∧
45
+
(isSplit g vs → ∃ u₀ ∈ vs,
46
+
(hcnm.intermediateN n v m, hcvr.granV (g u₀)) ∈ S ∧ g u = g u₀))
47
+
|>.image (fun u => ((m, u), (n, v))))
48
+
49
+
private theorem mem_soundnessπ {Δ_C : DepRel N V} {g : V → G}
50
+
{S : Finset (Package N' V')} {pair : Package N V × Package N V} :
51
+
pair ∈ soundnessπ Δ_C g S ↔
52
+
∃ n v m vs u, ((n, v), m, vs) ∈ Δ_C ∧
53
+
(hcnm.granularN n (g v), hcvr.origV v) ∈ S ∧
54
+
u ∈ vs ∧ (hcnm.granularN m (g u), hcvr.origV u) ∈ S ∧
55
+
(isSplit g vs → ∃ u₀ ∈ vs,
56
+
(hcnm.intermediateN n v m, hcvr.granV (g u₀)) ∈ S ∧ g u = g u₀) ∧
57
+
pair = ((m, u), (n, v)) := by
58
+
simp only [soundnessπ, Finset.mem_biUnion, Finset.mem_image, Finset.mem_filter]
59
+
constructor
60
+
· rintro ⟨⟨⟨n, v⟩, m, vs⟩, hdep, u, ⟨huv, huS, hvS, hspl⟩, rfl⟩
61
+
exact ⟨n, v, m, vs, u, hdep, hvS, huv, huS, hspl, rfl⟩
62
+
· rintro ⟨n, v, m, vs, u, hdep, hvS, huv, huS, hspl, rfl⟩
63
+
exact ⟨⟨⟨n, v⟩, m, vs⟩, hdep, u, ⟨huv, huS, hvS, hspl⟩, rfl⟩
64
+
65
+
private theorem embedPkg_mem_concurrentReal {g : V → G} {p : Package N V}
66
+
{R_C : Real N V} {Δ_C : DepRel N V}
67
+
(h : embedPkg g p ∈ concurrentReal (N' := N') (V' := V') R_C Δ_C g) : p ∈ R_C := by
68
+
simp only [concurrentReal, embedReal, Finset.mem_union, Finset.mem_image,
69
+
Finset.mem_biUnion] at h
70
+
rcases h with ⟨q, hqR, heq⟩ | ⟨a, haΔ, hmem⟩
71
+
· simp only [embedPkg, Prod.mk.injEq] at heq
72
+
obtain ⟨h1, h2⟩ := heq
73
+
have ⟨hn, _⟩ := hcnm.granularN_injective h1
74
+
have hv := hcvr.origV.injective h2
75
+
exact (Prod.ext hn hv : q = p) ▸ hqR
76
+
· obtain ⟨⟨n, v⟩, m, vs⟩ := a
77
+
simp only at hmem
78
+
split at hmem
79
+
· simp only [Finset.mem_image, embedPkg, Prod.mk.injEq] at hmem
80
+
obtain ⟨_, _, ⟨heq, _⟩⟩ := hmem
81
+
exact absurd heq.symm (hcnm.granularN_ne_intermediateN _ _ _ _ _)
82
+
· exact (List.mem_nil_iff _).mp hmem |>.elim
83
+
84
+
private theorem mem_concurrentDeps_direct {Δ_C : DepRel N V} {g : V → G}
85
+
{n : N} {v : V} {m : N} {vs : Finset V} {u₀ : V}
86
+
(hdep : ((n, v), m, vs) ∈ Δ_C) (hdir : isDirect g vs) (hu₀ : u₀ ∈ vs) :
87
+
((hcnm.granularN n (g v), hcvr.origV v),
88
+
hcnm.granularN m (g u₀),
89
+
vs.map hcvr.origV) ∈ concurrentDeps (N' := N') (V' := V') Δ_C g := by
90
+
simp only [concurrentDeps, Finset.mem_union, Finset.mem_biUnion]
91
+
left; left
92
+
refine ⟨⟨⟨n, v⟩, m, vs⟩, hdep, ?_⟩
93
+
simp only
94
+
rw [if_pos hdir]
95
+
exact Finset.mem_image.mpr ⟨u₀, hu₀, rfl⟩
96
+
97
+
private theorem mem_concurrentDeps_split1 {Δ_C : DepRel N V} {g : V → G}
98
+
{n : N} {v : V} {m : N} {vs : Finset V}
99
+
(hdep : ((n, v), m, vs) ∈ Δ_C) (hspl : isSplit g vs) :
100
+
((hcnm.granularN n (g v), hcvr.origV v),
101
+
hcnm.intermediateN n v m,
102
+
(vs.image (fun u => g u)).map hcvr.granV) ∈
103
+
concurrentDeps (N' := N') (V' := V') Δ_C g := by
104
+
simp only [concurrentDeps, Finset.mem_union, Finset.mem_biUnion]
105
+
left; right
106
+
refine ⟨⟨⟨n, v⟩, m, vs⟩, hdep, ?_⟩
107
+
simp only
108
+
rw [if_pos hspl]
109
+
exact Finset.mem_singleton.mpr rfl
110
+
111
+
private theorem mem_concurrentDeps_split2 {Δ_C : DepRel N V} {g : V → G}
112
+
{n : N} {v : V} {m : N} {vs : Finset V} {u₀ : V}
113
+
(hdep : ((n, v), m, vs) ∈ Δ_C) (hspl : isSplit g vs) (hu₀ : u₀ ∈ vs) :
114
+
((hcnm.intermediateN n v m, hcvr.granV (g u₀)),
115
+
hcnm.granularN m (g u₀),
116
+
(vs.filter (fun w => g w = g u₀)).map hcvr.origV) ∈
117
+
concurrentDeps (N' := N') (V' := V') Δ_C g := by
118
+
simp only [concurrentDeps, Finset.mem_union, Finset.mem_biUnion]
119
+
right
120
+
refine ⟨⟨⟨n, v⟩, m, vs⟩, hdep, ?_⟩
121
+
simp only
122
+
rw [if_pos hspl]
123
+
exact Finset.mem_image.mpr ⟨u₀, hu₀, rfl⟩
124
+
125
+
-- Paper Thm 4.2.4 (Concurrent Reduction Soundness).
126
+
theorem concurrent_soundness
127
+
(R_C : Real N V) (Δ_C : DepRel N V)
128
+
(g : V → G) (r : Package N V)
129
+
(S : Finset (Package N' V'))
130
+
(hres : IsResolution (concurrentReal R_C Δ_C g) (concurrentDeps Δ_C g)
131
+
(embedPkg g r) S)
132
+
(hfunc : ∀ p m vs₁ vs₂, (p, m, vs₁) ∈ Δ_C → (p, m, vs₂) ∈ Δ_C → vs₁ = vs₂)
133
+
(hne_dep : ∀ p m vs, (p, m, vs) ∈ Δ_C → vs.Nonempty) :
134
+
IsConcurrentResolution R_C Δ_C g r (preimageS g S) (soundnessπ Δ_C g S) := by
135
+
refine ⟨?_, ?_, ?_, ?_⟩
136
+
· -- subset
137
+
intro p hp
138
+
rw [mem_preimageS] at hp
139
+
exact embedPkg_mem_concurrentReal (hres.subset hp)
140
+
· -- root_mem
141
+
rw [mem_preimageS]
142
+
exact hres.root_mem
143
+
· -- parent_closure
144
+
intro ⟨pn, pv⟩ hp m vs hdep
145
+
rw [mem_preimageS] at hp
146
+
by_cases hdir : isDirect g vs
147
+
· -- DIRECT case
148
+
obtain ⟨u₀, hu₀⟩ := hne_dep _ _ _ hdep
149
+
have hd := mem_concurrentDeps_direct hdep hdir hu₀
150
+
obtain ⟨cv, hcvv, hcvS⟩ := hres.dep_closure _ hp _ _ hd
151
+
rw [Finset.mem_map] at hcvv
152
+
obtain ⟨u, huv, rfl⟩ := hcvv
153
+
have hgu : g u = g u₀ := hdir u u₀ huv hu₀
154
+
have huS : (hcnm.granularN m (g u), hcvr.origV u) ∈ S := by rwa [hgu]
155
+
refine ⟨u, ?_, ?_⟩
156
+
· refine ⟨huv, mem_preimageS.mpr huS, ?_⟩
157
+
rw [mem_soundnessπ]
158
+
exact ⟨pn, pv, m, vs, u, hdep, hp, huv, huS,
159
+
fun ⟨a, b, ha, hb, hne⟩ => absurd (hdir a b ha hb) hne, rfl⟩
160
+
· intro u' ⟨hu'v, hu'S_pre, hpi'⟩
161
+
rw [mem_preimageS] at hu'S_pre
162
+
rw [mem_soundnessπ] at hpi'
163
+
obtain ⟨_, _, _, _, _, _, _, _, _, _, heq⟩ := hpi'
164
+
simp only [Prod.mk.injEq] at heq
165
+
obtain ⟨⟨rfl, rfl⟩, rfl, rfl⟩ := heq
166
+
have hgu' : g u' = g u₀ := hdir u' u₀ hu'v hu₀
167
+
exact hcvr.origV.injective
168
+
(hres.version_unique _ _ _ (hgu' ▸ hu'S_pre) hcvS)
169
+
· -- SPLIT case
170
+
have hspl : isSplit g vs := by
171
+
unfold isDirect at hdir; push_neg at hdir
172
+
obtain ⟨u₁, u₂, hu₁, hu₂, hne⟩ := hdir
173
+
exact ⟨u₁, u₂, hu₁, hu₂, hne⟩
174
+
have hd1 := mem_concurrentDeps_split1 hdep hspl
175
+
obtain ⟨cv₀, hcv₀v, hcv₀S⟩ := hres.dep_closure _ hp _ _ hd1
176
+
rw [Finset.mem_map] at hcv₀v
177
+
obtain ⟨w₀, hw₀mem, rfl⟩ := hcv₀v
178
+
rw [Finset.mem_image] at hw₀mem
179
+
obtain ⟨u₀, hu₀v, rfl⟩ := hw₀mem
180
+
have hd2 := mem_concurrentDeps_split2 hdep hspl hu₀v
181
+
obtain ⟨cv, hcvv, hcvS⟩ := hres.dep_closure _ hcv₀S _ _ hd2
182
+
rw [Finset.mem_map] at hcvv
183
+
obtain ⟨u, humem, rfl⟩ := hcvv
184
+
rw [Finset.mem_filter] at humem
185
+
obtain ⟨huv, hgu⟩ := humem
186
+
have huS : (hcnm.granularN m (g u), hcvr.origV u) ∈ S := by rwa [hgu]
187
+
refine ⟨u, ?_, ?_⟩
188
+
· refine ⟨huv, mem_preimageS.mpr huS, ?_⟩
189
+
rw [mem_soundnessπ]
190
+
exact ⟨pn, pv, m, vs, u, hdep, hp, huv, huS,
191
+
fun _ => ⟨u₀, hu₀v, hcv₀S, hgu⟩, rfl⟩
192
+
· intro u' ⟨hu'v, hu'S_pre, hpi'⟩
193
+
rw [mem_preimageS] at hu'S_pre
194
+
rw [mem_soundnessπ] at hpi'
195
+
obtain ⟨_, _, _, vs', _, hdep', _, _, _, hspl_cond', heq⟩ := hpi'
196
+
simp only [Prod.mk.injEq] at heq
197
+
obtain ⟨⟨rfl, rfl⟩, rfl, rfl⟩ := heq
198
+
have hvs' := hfunc _ _ _ _ hdep' hdep; subst hvs'
199
+
obtain ⟨u₀', hu₀'v, hu₀'S, hgu'⟩ := hspl_cond' hspl
200
+
have huu := hcvr.granV.injective
201
+
(hres.version_unique _ _ _ hu₀'S hcv₀S)
202
+
rw [huu] at hgu'
203
+
have hu'S₀ : (hcnm.granularN m (g u₀), hcvr.origV u') ∈ S :=
204
+
hgu' ▸ hu'S_pre
205
+
exact hcvr.origV.injective (hres.version_unique _ _ _ hu'S₀ hcvS)
206
+
· -- version_granularity
207
+
intro n v v' hv hv' hne hge
208
+
rw [mem_preimageS] at hv hv'
209
+
exact hne (hcvr.origV.injective (hres.version_unique _ _ _ (hge ▸ hv) hv'))
210
+
211
+
end PackageCalculus.Concurrent
+80
PackageCalculus/Extensions/Conflict/Definition.lean
+80
PackageCalculus/Extensions/Conflict/Definition.lean
···
1
+
import PackageCalculus.Core.Definition
2
+
import Mathlib.Logic.Embedding.Basic
3
+
import Mathlib.Data.Finset.Image
4
+
5
+
/-! # Conflict extension: definitions
6
+
7
+
A `ConflictRel` records pairs `(p, n, vs)` where package `p` excludes name `n`
8
+
at versions `vs`. `IsConflictResolution` extends `IsResolution` with the
9
+
constraint that no excluded package may be present. -/
10
+
11
+
namespace PackageCalculus.Conflict
12
+
13
+
open Function
14
+
15
+
variable {N : Type*} [DecidableEq N] {V : Type*} [DecidableEq V]
16
+
17
+
/-- p Γ (n, vs) means package p conflicts with name n at versions vs. -/
18
+
abbrev ConflictRel (N V : Type*) := Finset (Package N V × N × Finset V)
19
+
20
+
structure IsConflictResolution (R : Real N V) (Δ : DepRel N V)
21
+
(Γ : ConflictRel N V) (r : Package N V) (S : Finset (Package N V)) : Prop where
22
+
core : IsResolution R Δ r S
23
+
conflict_avoidance : ∀ p ∈ S, ∀ n : N, ∀ vs : Finset V,
24
+
(p, n, vs) ∈ Γ → ¬∃ v ∈ vs, (n, v) ∈ S
25
+
26
+
/-! ## Extended type interfaces
27
+
28
+
Each reduction encodes extension-specific constraints by extending the name and
29
+
version types with synthetic constructors. These typeclasses abstract over the
30
+
extended types so that lifting functions (`liftReal`, `liftDeps`, etc.) only see
31
+
their own constructors and are agnostic to constructors added by other
32
+
extensions. This makes lifting modular under reduction composition: composing
33
+
multiple reductions produces a type with constructors from all of them, but each
34
+
extension's lift still works unchanged.
35
+
36
+
Crucially, this allows lifting a single extension out of a composed type without
37
+
unwrapping the others. A solver producing a core resolution over the
38
+
fully-composed type can be lifted directly by any extension whose constraints
39
+
the consumer cares about, ignoring unsupported extensions entirely. -/
40
+
41
+
class HasConflictNames (N V : Type*) (N' : outParam Type*) where
42
+
origN : N ↪ N'
43
+
/-- Synthetic conflict-witness name for a (name, version-set) pair. -/
44
+
syntheticN : N → Finset V → N'
45
+
syntheticN_injective : Injective2 syntheticN
46
+
origN_ne_syntheticN : ∀ n₁ n₂ (vs : Finset V), origN n₁ ≠ syntheticN n₂ vs
47
+
syntheticN_ne_origN : ∀ n₁ (vs : Finset V) n₂, syntheticN n₁ vs ≠ origN n₂
48
+
/-- Decidable partial inverse of `origN`. -/
49
+
tryOrigN : N' → Option N
50
+
tryOrigN_origN : ∀ n, tryOrigN (origN n) = some n
51
+
tryOrigN_some : ∀ n' n, tryOrigN n' = some n → origN n = n'
52
+
/-- Decidable partial inverse of `syntheticN`. -/
53
+
trySyntheticN : N' → Option (N × Finset V)
54
+
trySyntheticN_syntheticN : ∀ n vs, trySyntheticN (syntheticN n vs) = some (n, vs)
55
+
trySyntheticN_some : ∀ n' p, trySyntheticN n' = some p → syntheticN p.1 p.2 = n'
56
+
57
+
attribute [simp] HasConflictNames.origN_ne_syntheticN HasConflictNames.syntheticN_ne_origN
58
+
59
+
class HasConflictVersions (V : Type*) (V' : outParam Type*) where
60
+
origV : V ↪ V'
61
+
/-- Synthetic zero version for conflict witnesses. -/
62
+
zeroV : V'
63
+
/-- Synthetic one version for conflict witnesses. -/
64
+
oneV : V'
65
+
origV_ne_zeroV : ∀ v, origV v ≠ zeroV
66
+
zeroV_ne_origV : ∀ v, zeroV ≠ origV v
67
+
origV_ne_oneV : ∀ v, origV v ≠ oneV
68
+
oneV_ne_origV : ∀ v, oneV ≠ origV v
69
+
zeroV_ne_oneV : zeroV ≠ oneV
70
+
oneV_ne_zeroV : oneV ≠ zeroV
71
+
/-- Decidable partial inverse of `origV`. -/
72
+
tryOrigV : V' → Option V
73
+
tryOrigV_origV : ∀ v, tryOrigV (origV v) = some v
74
+
tryOrigV_some : ∀ v' v, tryOrigV v' = some v → origV v = v'
75
+
76
+
attribute [simp] HasConflictVersions.origV_ne_zeroV HasConflictVersions.zeroV_ne_origV
77
+
HasConflictVersions.origV_ne_oneV HasConflictVersions.oneV_ne_origV
78
+
HasConflictVersions.zeroV_ne_oneV HasConflictVersions.oneV_ne_zeroV
79
+
80
+
end PackageCalculus.Conflict
+40
PackageCalculus/Extensions/Conflict/Lifting/Completeness.lean
+40
PackageCalculus/Extensions/Conflict/Lifting/Completeness.lean
···
1
+
import PackageCalculus.Extensions.Conflict.Lifting.Definition
2
+
3
+
namespace PackageCalculus.Conflict
4
+
5
+
set_option linter.unusedSectionVars false
6
+
7
+
variable {N : Type*} [DecidableEq N] {V : Type*} [DecidableEq V]
8
+
variable {N' : Type*} [DecidableEq N'] {V' : Type*} [DecidableEq V']
9
+
variable [hcn : HasConflictNames N V N'] [hcv : HasConflictVersions V V']
10
+
11
+
theorem liftResolution_completenessWitness
12
+
(S_Γ : Finset (Package N V)) (Γ : ConflictRel N V) :
13
+
liftResolution (completenessWitness S_Γ Γ) = S_Γ := by
14
+
ext p
15
+
simp only [mem_liftResolution, completenessWitness, Finset.mem_union, Finset.mem_image,
16
+
Finset.mem_filter, embedSet, embedPkg]
17
+
constructor
18
+
· intro h
19
+
rcases h with ((⟨q, hqS, heq⟩ | ⟨⟨q, n, vs⟩, ⟨_, _⟩, heq⟩) |
20
+
⟨⟨q, n, vs⟩, ⟨_, _⟩, heq⟩)
21
+
· simp only [Prod.mk.injEq] at heq
22
+
have h1 := hcn.origN.injective heq.1; have h2 := hcv.origV.injective heq.2
23
+
exact (Prod.ext h1 h2 : q = p) ▸ hqS
24
+
· simp only [Prod.mk.injEq] at heq
25
+
exact absurd heq.1 (hcn.syntheticN_ne_origN _ _ _)
26
+
· simp only [Prod.mk.injEq] at heq
27
+
exact absurd heq.1 (hcn.syntheticN_ne_origN _ _ _)
28
+
· intro hp
29
+
exact Or.inl (Or.inl ⟨p, hp, rfl⟩)
30
+
31
+
theorem liftResolution_completeness
32
+
(R : Real N V) (Δ : DepRel N V) (Γ : ConflictRel N V)
33
+
(r : Package N V) (S_Γ : Finset (Package N V))
34
+
(hres : IsConflictResolution R Δ Γ r S_Γ) :
35
+
∃ S', IsResolution (conflictReal R Γ) (conflictDeps Δ Γ) (embedPkg r) S' ∧
36
+
liftResolution S' = S_Γ :=
37
+
⟨completenessWitness S_Γ Γ, conflict_completeness R Δ Γ r S_Γ hres,
38
+
liftResolution_completenessWitness S_Γ Γ⟩
39
+
40
+
end PackageCalculus.Conflict
+236
PackageCalculus/Extensions/Conflict/Lifting/Definition.lean
+236
PackageCalculus/Extensions/Conflict/Lifting/Definition.lean
···
1
+
import PackageCalculus.Extensions.Conflict.Reduction.Completeness
2
+
import PackageCalculus.Extensions.Conflict.Reduction.Soundness
3
+
4
+
namespace PackageCalculus.Conflict
5
+
6
+
set_option linter.unusedSectionVars false
7
+
8
+
variable {N : Type*} [DecidableEq N] {V : Type*} [DecidableEq V]
9
+
variable {N' : Type*} [DecidableEq N'] {V' : Type*} [DecidableEq V']
10
+
variable [hcn : HasConflictNames N V N'] [hcv : HasConflictVersions V V']
11
+
12
+
private def embedPkgFn : Package N V → Package N' V' :=
13
+
fun p => (hcn.origN p.1, hcv.origV p.2)
14
+
15
+
omit [DecidableEq N] [DecidableEq V] [DecidableEq N'] [DecidableEq V'] in
16
+
private theorem embedPkgFn_eq_embedPkg : (embedPkgFn : Package N V → Package N' V') = embedPkg :=
17
+
rfl
18
+
19
+
def embedDepFn : Package N V × N × Finset V → Package N' V' × N' × Finset V' :=
20
+
fun ⟨p, m, vs⟩ => ((hcn.origN p.1, hcv.origV p.2), hcn.origN m, vs.map hcv.origV)
21
+
22
+
def conflictDepFn : Package N V × N × Finset V → Package N' V' × N' × Finset V' :=
23
+
fun ⟨p, n, vs⟩ => ((hcn.origN p.1, hcv.origV p.2), hcn.syntheticN n vs, {hcv.oneV})
24
+
25
+
/-! ## Computable inverse helpers -/
26
+
27
+
/-- Try to invert `embedPkgFn` on a single element. -/
28
+
private def tryInvPkg (p : Package N' V') : Option (Package N V) :=
29
+
match hcn.tryOrigN p.1, hcv.tryOrigV p.2 with
30
+
| some n, some v => some (n, v)
31
+
| _, _ => none
32
+
33
+
omit [DecidableEq N] [DecidableEq V] [DecidableEq N'] [DecidableEq V'] in
34
+
private theorem tryInvPkg_inj :
35
+
∀ a a' (b : Package N V), b ∈ tryInvPkg a → b ∈ tryInvPkg a' → a = a' := by
36
+
intro a a' ⟨n, v⟩ h1 h2
37
+
simp only [tryInvPkg, Option.mem_def] at h1 h2
38
+
revert h1 h2
39
+
cases hn1 : hcn.tryOrigN a.1 <;> cases hv1 : hcv.tryOrigV a.2 <;> simp (config := { decide := false })
40
+
intro rfl rfl
41
+
cases hn2 : hcn.tryOrigN a'.1 <;> cases hv2 : hcv.tryOrigV a'.2 <;> simp (config := { decide := false })
42
+
intro rfl rfl
43
+
exact Prod.ext
44
+
((hcn.tryOrigN_some _ _ hn1).symm.trans (hcn.tryOrigN_some _ _ hn2))
45
+
((hcv.tryOrigV_some _ _ hv1).symm.trans (hcv.tryOrigV_some _ _ hv2))
46
+
47
+
omit [DecidableEq N] [DecidableEq V] [DecidableEq N'] [DecidableEq V'] in
48
+
private theorem tryInvPkg_embed (p : Package N V) :
49
+
tryInvPkg (embedPkgFn p) = some p := by
50
+
simp [tryInvPkg, embedPkgFn, hcn.tryOrigN_origN, hcv.tryOrigV_origV]
51
+
52
+
omit [DecidableEq N] [DecidableEq V] [DecidableEq N'] [DecidableEq V'] in
53
+
private theorem tryInvPkg_some {p' : Package N' V'} {p : Package N V}
54
+
(h : p ∈ tryInvPkg p') : embedPkgFn p = p' := by
55
+
obtain ⟨n', v'⟩ := p'
56
+
obtain ⟨n, v⟩ := p
57
+
simp only [tryInvPkg, Option.mem_def, embedPkgFn] at h ⊢
58
+
generalize htn : hcn.tryOrigN n' = on at h
59
+
generalize htv : hcv.tryOrigV v' = ov at h
60
+
match on, ov with
61
+
| some n₀, some v₀ =>
62
+
simp at h; obtain ⟨rfl, rfl⟩ := h
63
+
show (hcn.origN n₀, hcv.origV v₀) = (n', v')
64
+
rw [hcn.tryOrigN_some _ _ htn, hcv.tryOrigV_some _ _ htv]
65
+
| some _, none => simp at h
66
+
| none, _ => simp at h
67
+
68
+
/-- The injectivity side-condition for `filterMap`ing `tryOrigV`. -/
69
+
private theorem tryOrigV_filterMap_inj :
70
+
∀ (a a' : V') (b : V), b ∈ hcv.tryOrigV a → b ∈ hcv.tryOrigV a' → a = a' := by
71
+
intro a a' b ha ha'
72
+
have h1 := hcv.tryOrigV_some _ _ (Option.mem_def.mp ha)
73
+
have h2 := hcv.tryOrigV_some _ _ (Option.mem_def.mp ha')
74
+
exact h1.symm.trans h2
75
+
76
+
/-- `filterMap tryOrigV` is a left inverse of `map origV`. -/
77
+
private theorem filterMap_tryOrigV_map_origV (vs : Finset V) :
78
+
(vs.map hcv.origV).filterMap hcv.tryOrigV tryOrigV_filterMap_inj = vs := by
79
+
ext x
80
+
simp only [Finset.mem_filterMap, Finset.mem_map]
81
+
constructor
82
+
· rintro ⟨y, ⟨v, hv, rfl⟩, hxy⟩
83
+
rw [hcv.tryOrigV_origV] at hxy
84
+
obtain rfl := Option.some.inj hxy
85
+
exact hv
86
+
· intro hx
87
+
exact ⟨hcv.origV x, ⟨x, hx, rfl⟩, hcv.tryOrigV_origV x⟩
88
+
89
+
/-- Try to invert `embedDepFn` on a single element. -/
90
+
private def tryInvDep (d : Package N' V' × N' × Finset V') :
91
+
Option (Package N V × N × Finset V) :=
92
+
match hcn.tryOrigN d.1.1, hcv.tryOrigV d.1.2, hcn.tryOrigN d.2.1 with
93
+
| some pn, some pv, some m =>
94
+
let vs := d.2.2.filterMap hcv.tryOrigV tryOrigV_filterMap_inj
95
+
if vs.map hcv.origV = d.2.2 then
96
+
some ((pn, pv), m, vs)
97
+
else none
98
+
| _, _, _ => none
99
+
100
+
private theorem tryInvDep_some {d : Package N' V' × N' × Finset V'}
101
+
{c : Package N V × N × Finset V} (h : c ∈ tryInvDep d) : embedDepFn c = d := by
102
+
obtain ⟨⟨dn, dv⟩, dm, dvs⟩ := d
103
+
simp only [tryInvDep, Option.mem_def] at h
104
+
revert h
105
+
cases hn : hcn.tryOrigN dn <;> cases hv : hcv.tryOrigV dv <;> cases hm : hcn.tryOrigN dm <;>
106
+
simp only [reduceCtorEq, false_implies]
107
+
split
108
+
· rename_i hmap
109
+
intro h
110
+
obtain rfl := Option.some.inj h
111
+
simp only [embedDepFn]
112
+
rw [hcn.tryOrigN_some _ _ hn, hcv.tryOrigV_some _ _ hv, hcn.tryOrigN_some _ _ hm, hmap]
113
+
· simp
114
+
115
+
private theorem tryInvDep_embedDepFn (c : Package N V × N × Finset V) :
116
+
tryInvDep (embedDepFn c) = some c := by
117
+
obtain ⟨⟨pn, pv⟩, m, vs⟩ := c
118
+
simp only [tryInvDep, embedDepFn, hcn.tryOrigN_origN, hcv.tryOrigV_origV,
119
+
filterMap_tryOrigV_map_origV, if_pos]
120
+
121
+
private theorem tryInvDep_inj :
122
+
∀ a a' (b : Package N V × N × Finset V),
123
+
b ∈ tryInvDep a → b ∈ tryInvDep a' → a = a' := by
124
+
intro a a' b h1 h2
125
+
rw [← tryInvDep_some h1, ← tryInvDep_some h2]
126
+
127
+
/-- Try to invert `conflictDepFn` on a single element. -/
128
+
private def tryInvConflict (d : Package N' V' × N' × Finset V') :
129
+
Option (Package N V × N × Finset V) :=
130
+
match tryInvPkg d.1, hcn.trySyntheticN d.2.1 with
131
+
| some p, some (n, vs) => if d.2.2 = {hcv.oneV} then some (p, n, vs) else none
132
+
| _, _ => none
133
+
134
+
private theorem tryInvConflict_some {d : Package N' V' × N' × Finset V'}
135
+
{c : Package N V × N × Finset V} (h : c ∈ tryInvConflict d) : conflictDepFn c = d := by
136
+
obtain ⟨dp, dm, dvs⟩ := d
137
+
simp only [tryInvConflict, Option.mem_def] at h
138
+
revert h
139
+
cases hp : (tryInvPkg dp : Option (Package N V)) <;>
140
+
cases hm : (hcn.trySyntheticN dm : Option (N × Finset V)) <;>
141
+
simp only [reduceCtorEq, false_implies]
142
+
rename_i p nvs
143
+
obtain ⟨n, vs⟩ := nvs
144
+
split
145
+
· rename_i hone
146
+
intro h
147
+
obtain rfl := Option.some.inj h
148
+
simp only [conflictDepFn]
149
+
have hpeq := tryInvPkg_some (Option.mem_def.mpr hp)
150
+
rw [embedPkgFn_eq_embedPkg] at hpeq
151
+
have hmeq := hcn.trySyntheticN_some _ _ hm
152
+
exact Prod.ext hpeq (Prod.ext hmeq hone.symm)
153
+
· simp
154
+
155
+
private theorem tryInvConflict_conflictDepFn (c : Package N V × N × Finset V) :
156
+
tryInvConflict (conflictDepFn c) = some c := by
157
+
obtain ⟨⟨pn, pv⟩, n, vs⟩ := c
158
+
simp only [tryInvConflict, conflictDepFn, hcn.trySyntheticN_syntheticN, if_pos]
159
+
have : tryInvPkg ((hcn.origN pn, hcv.origV pv) : Package N' V') = some (pn, pv) := by
160
+
have := tryInvPkg_embed (pn, pv)
161
+
rwa [embedPkgFn] at this
162
+
rw [this]
163
+
164
+
private theorem tryInvConflict_inj :
165
+
∀ a a' (b : Package N V × N × Finset V),
166
+
b ∈ tryInvConflict a → b ∈ tryInvConflict a' → a = a' := by
167
+
intro a a' b h1 h2
168
+
rw [← tryInvConflict_some h1, ← tryInvConflict_some h2]
169
+
170
+
/-! ## Lift functions -/
171
+
172
+
def liftReal (R' : Real N' V') : Real N V :=
173
+
R'.filterMap tryInvPkg tryInvPkg_inj
174
+
175
+
def liftDeps (Δ' : DepRel N' V') : DepRel N V :=
176
+
Δ'.filterMap tryInvDep tryInvDep_inj
177
+
178
+
def liftConflicts (Δ' : DepRel N' V') : ConflictRel N V :=
179
+
Δ'.filterMap tryInvConflict tryInvConflict_inj
180
+
181
+
def liftResolution (S' : Finset (Package N' V')) : Finset (Package N V) :=
182
+
S'.filterMap tryInvPkg tryInvPkg_inj
183
+
184
+
def conflictLift (R' : Real N' V') (Δ' : DepRel N' V') :
185
+
Real N V × DepRel N V × ConflictRel N V :=
186
+
(liftReal R', liftDeps Δ', liftConflicts Δ')
187
+
188
+
/-! ## Membership lemmas -/
189
+
190
+
omit [DecidableEq N] [DecidableEq V] [DecidableEq N'] [DecidableEq V'] in
191
+
theorem mem_liftReal {R' : Real N' V'} {p : Package N V} :
192
+
p ∈ liftReal R' ↔ embedPkg p ∈ R' := by
193
+
simp only [liftReal, Finset.mem_filterMap]
194
+
constructor
195
+
· rintro ⟨p', hp', hinv⟩
196
+
have heq := tryInvPkg_some hinv
197
+
rw [embedPkgFn_eq_embedPkg] at heq
198
+
rwa [heq]
199
+
· intro hp
200
+
exact ⟨embedPkg p, hp, by
201
+
show p ∈ tryInvPkg (embedPkgFn p)
202
+
rw [tryInvPkg_embed]; exact rfl⟩
203
+
204
+
omit [DecidableEq N] [DecidableEq V] [DecidableEq N'] [DecidableEq V'] in
205
+
theorem mem_liftResolution {S' : Finset (Package N' V')} {p : Package N V} :
206
+
p ∈ liftResolution S' ↔ embedPkg p ∈ S' := by
207
+
simp only [liftResolution, Finset.mem_filterMap]
208
+
constructor
209
+
· rintro ⟨p', hp', hinv⟩
210
+
have heq := tryInvPkg_some hinv
211
+
rw [embedPkgFn_eq_embedPkg] at heq
212
+
rwa [heq]
213
+
· intro hp
214
+
exact ⟨embedPkg p, hp, by
215
+
show p ∈ tryInvPkg (embedPkgFn p)
216
+
rw [tryInvPkg_embed]; exact rfl⟩
217
+
218
+
theorem mem_liftDeps {Δ' : DepRel N' V'} {d : Package N V × N × Finset V} :
219
+
d ∈ liftDeps Δ' ↔ embedDepFn d ∈ Δ' := by
220
+
simp only [liftDeps, Finset.mem_filterMap]
221
+
constructor
222
+
· rintro ⟨e, he, hinv⟩
223
+
rw [tryInvDep_some hinv]; exact he
224
+
· intro h
225
+
exact ⟨embedDepFn d, h, tryInvDep_embedDepFn d⟩
226
+
227
+
theorem mem_liftConflicts {Δ' : DepRel N' V'} {c : Package N V × N × Finset V} :
228
+
c ∈ liftConflicts Δ' ↔ conflictDepFn c ∈ Δ' := by
229
+
simp only [liftConflicts, Finset.mem_filterMap]
230
+
constructor
231
+
· rintro ⟨e, he, hinv⟩
232
+
rw [tryInvConflict_some hinv]; exact he
233
+
· intro h
234
+
exact ⟨conflictDepFn c, h, tryInvConflict_conflictDepFn c⟩
235
+
236
+
end PackageCalculus.Conflict
+95
PackageCalculus/Extensions/Conflict/Lifting/Retraction.lean
+95
PackageCalculus/Extensions/Conflict/Lifting/Retraction.lean
···
1
+
import PackageCalculus.Extensions.Conflict.Lifting.Definition
2
+
3
+
namespace PackageCalculus.Conflict
4
+
5
+
set_option linter.unusedSectionVars false
6
+
7
+
variable {N : Type*} [DecidableEq N] {V : Type*} [DecidableEq V]
8
+
variable {N' : Type*} [DecidableEq N'] {V' : Type*} [DecidableEq V']
9
+
variable [hcn : HasConflictNames N V N'] [hcv : HasConflictVersions V V']
10
+
11
+
/-! ## Round-trip theorems -/
12
+
13
+
theorem liftReal_conflictReal (R : Real N V) (Γ : ConflictRel N V) :
14
+
liftReal (conflictReal R Γ) = R := by
15
+
ext p
16
+
simp only [mem_liftReal, conflictReal, embedSet, Finset.mem_union, Finset.mem_image,
17
+
Finset.mem_biUnion]
18
+
constructor
19
+
· intro h
20
+
rcases h with ⟨q, hqR, heq⟩ | ⟨a, haΓ, hmem⟩
21
+
· simp only [embedPkg, Prod.mk.injEq] at heq
22
+
have h1 := hcn.origN.injective heq.1; have h2 := hcv.origV.injective heq.2
23
+
exact (Prod.ext h1 h2 : q = p) ▸ hqR
24
+
· simp only [Finset.mem_insert, Finset.mem_singleton, embedPkg, Prod.mk.injEq] at hmem
25
+
rcases hmem with ⟨h1, _⟩ | ⟨h1, _⟩ <;> exact absurd h1 (hcn.origN_ne_syntheticN _ _ _)
26
+
· intro hp
27
+
exact Or.inl ⟨p, hp, rfl⟩
28
+
29
+
theorem liftDeps_conflictDeps (Δ : DepRel N V) (Γ : ConflictRel N V) :
30
+
liftDeps (conflictDeps Δ Γ) = Δ := by
31
+
ext ⟨p, m, vs⟩
32
+
simp only [mem_liftDeps, conflictDeps, embedDepFn, Finset.mem_union, Finset.mem_image,
33
+
Finset.mem_biUnion]
34
+
constructor
35
+
· intro h
36
+
rcases h with ((⟨a, hm, heq⟩ | ⟨a, hg, heq⟩) | ⟨a, hg, u, hu, heq⟩)
37
+
· simp only [embedPkg, embedVS, Prod.mk.injEq] at heq
38
+
obtain ⟨⟨h1, h2⟩, hm', hvs⟩ := heq
39
+
have hp1 := hcn.origN.injective h1
40
+
have hp2 := hcv.origV.injective h2
41
+
have hmm := hcn.origN.injective hm'
42
+
have hvs' : vs = a.2.2 := by
43
+
ext v; constructor
44
+
· intro hv
45
+
have : hcv.origV v ∈ a.2.2.map hcv.origV :=
46
+
hvs ▸ Finset.mem_map.mpr ⟨v, hv, rfl⟩
47
+
obtain ⟨w, hw, hweq⟩ := Finset.mem_map.mp this
48
+
exact hcv.origV.injective hweq ▸ hw
49
+
· intro hv
50
+
have : hcv.origV v ∈ vs.map hcv.origV :=
51
+
hvs.symm ▸ Finset.mem_map.mpr ⟨v, hv, rfl⟩
52
+
obtain ⟨w, hw, hweq⟩ := Finset.mem_map.mp this
53
+
exact hcv.origV.injective hweq ▸ hw
54
+
have hp := Prod.ext hp1 hp2
55
+
subst hp hmm hvs'
56
+
exact hm
57
+
· simp only [embedPkg, Prod.mk.injEq] at heq
58
+
exact absurd heq.2.1 (hcn.syntheticN_ne_origN _ _ _)
59
+
· simp only [Prod.mk.injEq] at heq
60
+
exact absurd heq.2.1 (hcn.syntheticN_ne_origN _ _ _)
61
+
· intro hmem
62
+
exact Or.inl (Or.inl ⟨⟨p, m, vs⟩, hmem, rfl⟩)
63
+
64
+
theorem liftConflicts_conflictDeps (Δ : DepRel N V) (Γ : ConflictRel N V) :
65
+
liftConflicts (conflictDeps Δ Γ) = Γ := by
66
+
ext ⟨p, n, vs⟩
67
+
simp only [mem_liftConflicts, conflictDeps, conflictDepFn, Finset.mem_union, Finset.mem_image,
68
+
Finset.mem_biUnion]
69
+
constructor
70
+
· intro h
71
+
rcases h with ((⟨a, hm, heq⟩ | ⟨a, hg, heq⟩) | ⟨a, hg, u, hu, heq⟩)
72
+
· simp only [embedPkg, Prod.mk.injEq] at heq
73
+
exact absurd heq.2.1 (hcn.origN_ne_syntheticN _ _ _)
74
+
· simp only [embedPkg, Prod.mk.injEq] at heq
75
+
obtain ⟨⟨h1, h2⟩, hsyn, _⟩ := heq
76
+
have hp1 := hcn.origN.injective h1
77
+
have hp2 := hcv.origV.injective h2
78
+
obtain ⟨hn, hvs⟩ := hcn.syntheticN_injective hsyn
79
+
have hp := Prod.ext hp1 hp2
80
+
subst hp hn hvs
81
+
exact hg
82
+
· simp only [Prod.mk.injEq] at heq
83
+
have hvs := heq.2.2
84
+
have : hcv.oneV ∈ ({hcv.zeroV} : Finset V') := by
85
+
rw [hvs]; exact Finset.mem_singleton.mpr rfl
86
+
exact absurd (Finset.mem_singleton.mp this) hcv.oneV_ne_zeroV
87
+
· intro hg
88
+
exact Or.inl (Or.inr ⟨⟨p, n, vs⟩, hg, rfl⟩)
89
+
90
+
theorem conflictLift_conflictReduce (R : Real N V) (Δ : DepRel N V) (Γ : ConflictRel N V) :
91
+
conflictLift (conflictReduce R Δ Γ).1 (conflictReduce R Δ Γ).2 = (R, Δ, Γ) := by
92
+
simp only [conflictLift, conflictReduce,
93
+
liftReal_conflictReal, liftDeps_conflictDeps, liftConflicts_conflictDeps]
94
+
95
+
end PackageCalculus.Conflict
+62
PackageCalculus/Extensions/Conflict/Lifting/Soundness.lean
+62
PackageCalculus/Extensions/Conflict/Lifting/Soundness.lean
···
1
+
import PackageCalculus.Extensions.Conflict.Lifting.Definition
2
+
3
+
namespace PackageCalculus.Conflict
4
+
5
+
set_option linter.unusedSectionVars false
6
+
7
+
variable {N : Type*} [DecidableEq N] {V : Type*} [DecidableEq V]
8
+
variable {N' : Type*} [DecidableEq N'] {V' : Type*} [DecidableEq V']
9
+
variable [hcn : HasConflictNames N V N'] [hcv : HasConflictVersions V V']
10
+
11
+
/-! ## Lifting soundness & completeness -/
12
+
13
+
theorem liftResolution_soundness
14
+
(R : Real N V) (Δ : DepRel N V) (Γ : ConflictRel N V)
15
+
(r : Package N V) (S' : Finset (Package N' V'))
16
+
(hres : IsResolution (conflictReal R Γ) (conflictDeps Δ Γ) (embedPkg r) S') :
17
+
IsConflictResolution R Δ Γ r (liftResolution S') := by
18
+
refine ⟨⟨?_, ?_, ?_, ?_⟩, ?_⟩
19
+
· -- subset
20
+
intro p hp
21
+
rw [mem_liftResolution] at hp
22
+
have := hres.subset hp
23
+
simp only [conflictReal, embedSet, Finset.mem_union, Finset.mem_image,
24
+
Finset.mem_biUnion] at this
25
+
rcases this with ⟨q, hqR, heq⟩ | ⟨a, _, hmem⟩
26
+
· simp only [embedPkg, Prod.mk.injEq] at heq
27
+
exact (Prod.ext (hcn.origN.injective heq.1) (hcv.origV.injective heq.2) : q = p) ▸ hqR
28
+
· simp only [Finset.mem_insert, Finset.mem_singleton, embedPkg, Prod.mk.injEq] at hmem
29
+
rcases hmem with ⟨h1, _⟩ | ⟨h1, _⟩ <;> exact absurd h1 (hcn.origN_ne_syntheticN _ _ _)
30
+
· -- root_mem
31
+
rw [mem_liftResolution]; exact hres.root_mem
32
+
· -- dep_closure
33
+
intro p hp m vs hmem
34
+
rw [mem_liftResolution] at hp
35
+
have hd : (embedPkg p, hcn.origN m, embedVS vs) ∈ conflictDeps Δ Γ := by
36
+
simp only [conflictDeps, Finset.mem_union, Finset.mem_image, Finset.mem_biUnion]
37
+
exact Or.inl (Or.inl ⟨⟨p, m, vs⟩, hmem, rfl⟩)
38
+
obtain ⟨v', hv'mem, hv'S⟩ := hres.dep_closure _ hp _ _ hd
39
+
simp only [embedVS, Finset.mem_map] at hv'mem
40
+
obtain ⟨v, hv, rfl⟩ := hv'mem
41
+
exact ⟨v, hv, mem_liftResolution.mpr hv'S⟩
42
+
· -- version_unique
43
+
intro n v v' hv hv'
44
+
rw [mem_liftResolution] at hv hv'
45
+
exact hcv.origV.injective (hres.version_unique _ _ _ hv hv')
46
+
· -- conflict_avoidance
47
+
intro p hp n vs hg ⟨u, hu, humem⟩
48
+
rw [mem_liftResolution] at hp humem
49
+
have hd1 : (embedPkg p, hcn.syntheticN n vs, {hcv.oneV}) ∈ conflictDeps Δ Γ := by
50
+
simp only [conflictDeps, Finset.mem_union, Finset.mem_image, Finset.mem_biUnion]
51
+
exact Or.inl (Or.inr ⟨⟨p, n, vs⟩, hg, rfl⟩)
52
+
obtain ⟨w, hw, hwS⟩ := hres.dep_closure _ hp _ _ hd1
53
+
rw [Finset.mem_singleton] at hw; subst hw
54
+
have hd2 : ((hcn.origN n, hcv.origV u), hcn.syntheticN n vs, {hcv.zeroV}) ∈ conflictDeps Δ Γ := by
55
+
simp only [conflictDeps, Finset.mem_union, Finset.mem_image, Finset.mem_biUnion]
56
+
exact Or.inr ⟨⟨_, n, vs⟩, hg, u, hu, rfl⟩
57
+
obtain ⟨w', hw', hw'S⟩ := hres.dep_closure _ humem _ _ hd2
58
+
rw [Finset.mem_singleton] at hw'; subst hw'
59
+
have := hres.version_unique _ _ _ hwS hw'S
60
+
exact absurd this hcv.oneV_ne_zeroV
61
+
62
+
end PackageCalculus.Conflict
+164
PackageCalculus/Extensions/Conflict/Reduction/Completeness.lean
+164
PackageCalculus/Extensions/Conflict/Reduction/Completeness.lean
···
1
+
import PackageCalculus.Extensions.Conflict.Reduction.Definition
2
+
3
+
/-! # Conflict extension: completeness
4
+
5
+
Any conflict resolution lifts to a core resolution of the conflict
6
+
encoding. -/
7
+
8
+
namespace PackageCalculus.Conflict
9
+
10
+
open Classical
11
+
12
+
variable {N : Type*} [DecidableEq N] {V : Type*} [DecidableEq V]
13
+
variable {N' : Type*} [DecidableEq N'] {V' : Type*} [DecidableEq V']
14
+
variable [hcn : HasConflictNames N V N'] [hcv : HasConflictVersions V V']
15
+
16
+
def completenessWitness (S_Γ : Finset (Package N V)) (Γ : ConflictRel N V) :
17
+
Finset (Package N' V') :=
18
+
embedSet S_Γ ∪
19
+
(Γ.filter (fun ⟨p, _, _⟩ => p ∈ S_Γ)).image (fun ⟨_, n, vs⟩ =>
20
+
(hcn.syntheticN n vs, hcv.oneV)) ∪
21
+
(Γ.filter (fun ⟨_, n, vs⟩ => ∃ u ∈ vs, (n, u) ∈ S_Γ)).image (fun ⟨_, n, vs⟩ =>
22
+
(hcn.syntheticN n vs, hcv.zeroV))
23
+
24
+
private theorem mem_completenessWitness_embed {S_Γ : Finset (Package N V)} {Γ : ConflictRel N V}
25
+
{p : Package N V} (hp : p ∈ S_Γ) :
26
+
(embedPkg (N' := N') (V' := V') p) ∈ completenessWitness S_Γ Γ :=
27
+
Finset.mem_union.mpr (Or.inl (Finset.mem_union.mpr (Or.inl
28
+
(Finset.mem_image_of_mem embedPkg hp))))
29
+
30
+
private theorem mem_completenessWitness_one {S_Γ : Finset (Package N V)} {Γ : ConflictRel N V}
31
+
{p : Package N V} {n : N} {vs : Finset V}
32
+
(hg : (p, n, vs) ∈ Γ) (hp : p ∈ S_Γ) :
33
+
(hcn.syntheticN n vs, hcv.oneV) ∈ completenessWitness S_Γ Γ := by
34
+
simp only [completenessWitness, Finset.mem_union, Finset.mem_image, Finset.mem_filter]
35
+
left; right
36
+
exact ⟨⟨p, n, vs⟩, ⟨hg, hp⟩, rfl⟩
37
+
38
+
private theorem mem_completenessWitness_zero {S_Γ : Finset (Package N V)} {Γ : ConflictRel N V}
39
+
{p : Package N V} {n : N} {vs : Finset V}
40
+
(hg : (p, n, vs) ∈ Γ) (hc : ∃ u ∈ vs, (n, u) ∈ S_Γ) :
41
+
(hcn.syntheticN n vs, hcv.zeroV) ∈ completenessWitness S_Γ Γ := by
42
+
simp only [completenessWitness, Finset.mem_union, Finset.mem_image, Finset.mem_filter]
43
+
right
44
+
exact ⟨⟨p, n, vs⟩, ⟨hg, hc⟩, rfl⟩
45
+
46
+
-- Helper: no element of conflictDeps has a syntheticN name as the package name component
47
+
omit [DecidableEq N] [DecidableEq V] in
48
+
private theorem no_synthetic_pkg_in_conflictDeps {Δ_Γ : DepRel N V} {Γ : ConflictRel N V}
49
+
{n₀ : N} {vs₀ : Finset V} {v₀ : V'} {m : N'} {ws : Finset V'}
50
+
(hd : ((hcn.syntheticN n₀ vs₀, v₀), m, ws) ∈ conflictDeps Δ_Γ Γ) : False := by
51
+
simp only [conflictDeps, Finset.mem_union, Finset.mem_image, Finset.mem_biUnion] at hd
52
+
rcases hd with ((⟨a, _, heq⟩ | ⟨a, _, heq⟩) | ⟨a, _, _, _, heq⟩)
53
+
all_goals simp only [embedPkg, Prod.mk.injEq] at heq
54
+
-- heq.1.1 : origN a._._ = syntheticN n₀ vs₀
55
+
· exact absurd heq.1.1 (hcn.origN_ne_syntheticN _ _ _)
56
+
· exact absurd heq.1.1 (hcn.origN_ne_syntheticN _ _ _)
57
+
· exact absurd heq.1.1 (hcn.origN_ne_syntheticN _ _ _)
58
+
59
+
-- Paper Thm 4.1.5 (Conflict Reduction Completeness).
60
+
theorem conflict_completeness
61
+
(R_Γ : Real N V) (Δ_Γ : DepRel N V) (Γ : ConflictRel N V)
62
+
(r : Package N V) (S_Γ : Finset (Package N V))
63
+
(hres : IsConflictResolution R_Γ Δ_Γ Γ r S_Γ) :
64
+
IsResolution (conflictReal R_Γ Γ) (conflictDeps Δ_Γ Γ) (embedPkg r)
65
+
(completenessWitness S_Γ Γ) := by
66
+
obtain ⟨⟨hsub, hroot, hdep, huniq⟩, havoid⟩ := hres
67
+
refine ⟨?_, mem_completenessWitness_embed hroot, ?_, ?_⟩
68
+
· -- subset
69
+
intro q hq
70
+
simp only [completenessWitness, Finset.mem_union, Finset.mem_image, Finset.mem_filter,
71
+
embedSet] at hq
72
+
simp only [conflictReal, Finset.mem_union, Finset.mem_image, Finset.mem_biUnion, embedSet]
73
+
rcases hq with ((⟨p, hp, rfl⟩ | ⟨⟨p, n, vs⟩, ⟨hg, _⟩, rfl⟩) |
74
+
⟨⟨p, n, vs⟩, ⟨hg, _⟩, rfl⟩)
75
+
· left; exact ⟨p, hsub hp, rfl⟩
76
+
· right; exact ⟨⟨p, n, vs⟩, hg, Finset.mem_insert.mpr (Or.inr (Finset.mem_singleton.mpr rfl))⟩
77
+
· right; exact ⟨⟨p, n, vs⟩, hg, Finset.mem_insert.mpr (Or.inl rfl)⟩
78
+
· -- dep_closure
79
+
intro q hq m ws hd
80
+
simp only [completenessWitness, Finset.mem_union, Finset.mem_image, Finset.mem_filter,
81
+
embedSet] at hq
82
+
rcases hq with ((⟨p, hp, rfl⟩ | ⟨⟨p₀, n₀, vs₀⟩, ⟨_, hpS₀⟩, rfl⟩) |
83
+
⟨⟨p₀, n₀, vs₀⟩, ⟨_, _⟩, rfl⟩)
84
+
· -- q = embedPkg p, p ∈ S_Γ
85
+
simp only [conflictDeps, Finset.mem_union, Finset.mem_image, Finset.mem_biUnion] at hd
86
+
rcases hd with ((⟨a, hm, heq⟩ | ⟨a, hg', heq⟩) | ⟨a, hg', u', hu', heq⟩)
87
+
· -- original dep
88
+
simp only [embedPkg, Prod.mk.injEq] at heq
89
+
obtain ⟨⟨h1, h2⟩, rfl, rfl⟩ := heq
90
+
have h1' := hcn.origN.injective h1; have h2' := hcv.origV.injective h2
91
+
have hp' : a.1 = p := Prod.ext h1' h2'
92
+
subst hp'
93
+
obtain ⟨v, hv, hvS⟩ := hdep _ hp _ _ hm
94
+
exact ⟨hcv.origV v, Finset.mem_map.mpr ⟨v, hv, rfl⟩, mem_completenessWitness_embed hvS⟩
95
+
· -- conflict dep
96
+
simp only [embedPkg, Prod.mk.injEq] at heq
97
+
obtain ⟨⟨h1, h2⟩, rfl, rfl⟩ := heq
98
+
have h1' := hcn.origN.injective h1; have h2' := hcv.origV.injective h2
99
+
have hp' : a.1 = p := Prod.ext h1' h2'
100
+
subst hp'
101
+
exact ⟨hcv.oneV, Finset.mem_singleton.mpr rfl, mem_completenessWitness_one hg' hp⟩
102
+
· -- conflictee dep: embedPkg (n, u) -> syntheticN n vs -> zeroV
103
+
-- heq : ((origN a.2.1, origV u'), syntheticN a.2.1 a.2.2, {zeroV}) = (embedPkg p, m, ws)
104
+
simp only [embedPkg, Prod.mk.injEq] at heq
105
+
obtain ⟨⟨h1, h2⟩, rfl, rfl⟩ := heq
106
+
have hn := hcn.origN.injective h1
107
+
have hv := hcv.origV.injective h2
108
+
-- hn : a.2.1 = p.1, hv : u' = p.2
109
+
-- Need: mem_completenessWitness_zero hg' ⟨p.2, _, hp⟩
110
+
-- where _ proves p.2 ∈ a.2.2
111
+
-- We have hu' : u' ∈ a.2.2
112
+
subst hv -- now u' is gone, replaced by p.2
113
+
have hp' : (a.2.1, p.2) ∈ S_Γ := hn ▸ hp
114
+
exact ⟨hcv.zeroV, Finset.mem_singleton.mpr rfl,
115
+
mem_completenessWitness_zero hg' ⟨p.2, hu', hp'⟩⟩
116
+
· exact absurd (no_synthetic_pkg_in_conflictDeps hd) False.elim
117
+
· exact absurd (no_synthetic_pkg_in_conflictDeps hd) False.elim
118
+
· -- version_unique
119
+
intro nm v1 v2 hv1 hv2
120
+
simp only [completenessWitness, Finset.mem_union, Finset.mem_image, Finset.mem_filter,
121
+
embedSet] at hv1 hv2
122
+
rcases hv1 with ((⟨p₁, hp₁, heq1⟩ | ⟨⟨q₁, n₁, vs₁⟩, ⟨hg₁, hpS₁⟩, heq1⟩) |
123
+
⟨⟨q₁, n₁, vs₁⟩, ⟨hg₁, hc₁⟩, heq1⟩) <;>
124
+
rcases hv2 with ((⟨p₂, hp₂, heq2⟩ | ⟨⟨q₂, n₂, vs₂⟩, ⟨hg₂, hpS₂⟩, heq2⟩) |
125
+
⟨⟨q₂, n₂, vs₂⟩, ⟨hg₂, hc₂⟩, heq2⟩)
126
+
· -- orig x orig
127
+
simp only [embedPkg, Prod.mk.injEq] at heq1 heq2
128
+
rw [← heq1.2, ← heq2.2]
129
+
exact congrArg _ (huniq p₁.1 p₁.2 p₂.2 hp₁
130
+
(hcn.origN.injective (heq1.1.trans heq2.1.symm) ▸ hp₂))
131
+
· -- orig x one
132
+
simp only [embedPkg, Prod.mk.injEq] at heq1
133
+
simp only [Prod.mk.injEq] at heq2
134
+
exact absurd (heq1.1.trans heq2.1.symm) (hcn.origN_ne_syntheticN _ _ _)
135
+
· -- orig x zero
136
+
simp only [embedPkg, Prod.mk.injEq] at heq1
137
+
simp only [Prod.mk.injEq] at heq2
138
+
exact absurd (heq1.1.trans heq2.1.symm) (hcn.origN_ne_syntheticN _ _ _)
139
+
· -- one x orig
140
+
simp only [Prod.mk.injEq] at heq1
141
+
simp only [embedPkg, Prod.mk.injEq] at heq2
142
+
exact absurd (heq2.1.trans heq1.1.symm) (hcn.origN_ne_syntheticN _ _ _)
143
+
· -- one x one
144
+
simp only [Prod.mk.injEq] at heq1 heq2
145
+
exact heq1.2.symm.trans heq2.2
146
+
· -- one x zero: conflict avoidance
147
+
simp only [Prod.mk.injEq] at heq1 heq2
148
+
exfalso
149
+
obtain ⟨rfl, rfl⟩ := hcn.syntheticN_injective (heq1.1.trans heq2.1.symm)
150
+
exact havoid _ hpS₁ _ _ hg₁ hc₂
151
+
· -- zero x orig
152
+
simp only [Prod.mk.injEq] at heq1
153
+
simp only [embedPkg, Prod.mk.injEq] at heq2
154
+
exact absurd (heq2.1.trans heq1.1.symm) (hcn.origN_ne_syntheticN _ _ _)
155
+
· -- zero x one: conflict avoidance
156
+
simp only [Prod.mk.injEq] at heq1 heq2
157
+
exfalso
158
+
obtain ⟨rfl, rfl⟩ := hcn.syntheticN_injective (heq1.1.trans heq2.1.symm)
159
+
exact havoid _ hpS₂ _ _ hg₂ hc₁
160
+
· -- zero x zero
161
+
simp only [Prod.mk.injEq] at heq1 heq2
162
+
exact heq1.2.symm.trans heq2.2
163
+
164
+
end PackageCalculus.Conflict
+110
PackageCalculus/Extensions/Conflict/Reduction/Definition.lean
+110
PackageCalculus/Extensions/Conflict/Reduction/Definition.lean
···
1
+
import PackageCalculus.Extensions.Conflict.Definition
2
+
import Mathlib.Data.Finset.Union
3
+
4
+
/-! # Conflict extension: reduction
5
+
6
+
Encodes a conflict relation as core dependencies using *synthetic* names whose
7
+
presence forbids the conflicting versions. -/
8
+
9
+
namespace PackageCalculus.Conflict
10
+
11
+
variable {N : Type*} [DecidableEq N] {V : Type*} [DecidableEq V]
12
+
13
+
inductive ConflictName (N V : Type*) where
14
+
| orig : N → ConflictName N V
15
+
| synthetic : N → Finset V → ConflictName N V
16
+
deriving DecidableEq
17
+
18
+
inductive ConflictVersion (V : Type*) where
19
+
| orig : V → ConflictVersion V
20
+
| zero : ConflictVersion V
21
+
| one : ConflictVersion V
22
+
deriving DecidableEq
23
+
24
+
variable {N' : Type*} [DecidableEq N'] {V' : Type*} [DecidableEq V']
25
+
variable [hcn : HasConflictNames N V N'] [hcv : HasConflictVersions V V']
26
+
27
+
def embedPkg (p : Package N V) : Package N' V' :=
28
+
(hcn.origN p.1, hcv.origV p.2)
29
+
30
+
def embedSet (S : Finset (Package N V)) : Finset (Package N' V') :=
31
+
S.image embedPkg
32
+
33
+
def embedVS (vs : Finset V) : Finset V' :=
34
+
vs.map hcv.origV
35
+
36
+
def conflictReal (R_Γ : Real N V) (Γ : ConflictRel N V) :
37
+
Real N' V' :=
38
+
embedSet R_Γ ∪
39
+
(Γ.biUnion (fun ⟨_, n, vs⟩ =>
40
+
{(hcn.syntheticN n vs, hcv.zeroV), (hcn.syntheticN n vs, hcv.oneV)}))
41
+
42
+
def conflictDeps (Δ_Γ : DepRel N V) (Γ : ConflictRel N V) :
43
+
DepRel N' V' :=
44
+
-- Original dependencies, embedded
45
+
(Δ_Γ.image (fun ⟨p, m, vs⟩ => (embedPkg p, hcn.origN m, embedVS vs))) ∪
46
+
-- Conflicter p depends on ⟨n, vs⟩ version 1
47
+
(Γ.image (fun ⟨p, n, vs⟩ => (embedPkg p, hcn.syntheticN n vs, {hcv.oneV}))) ∪
48
+
-- Conflictee (n, u) depends on ⟨n, vs⟩ version 0
49
+
(Γ.biUnion (fun ⟨_, n, vs⟩ =>
50
+
vs.image (fun u => ((hcn.origN n, hcv.origV u), hcn.syntheticN n vs, {hcv.zeroV}))))
51
+
52
+
def conflictReduce (R : Real N V) (Δ : DepRel N V) (Γ : ConflictRel N V) :
53
+
Real N' V' × DepRel N' V' :=
54
+
(conflictReal R Γ, conflictDeps Δ Γ)
55
+
56
+
end PackageCalculus.Conflict
57
+
58
+
namespace PackageCalculus
59
+
60
+
open Function
61
+
62
+
variable {N : Type*} [DecidableEq N] {V : Type*} [DecidableEq V]
63
+
64
+
instance : Conflict.HasConflictNames N V (Conflict.ConflictName N V) where
65
+
origN := ⟨Conflict.ConflictName.orig, fun _ _ h => Conflict.ConflictName.orig.inj h⟩
66
+
syntheticN := Conflict.ConflictName.synthetic
67
+
syntheticN_injective := by
68
+
intro a₁ a₂ b₁ b₂ h
69
+
exact ⟨Conflict.ConflictName.synthetic.inj h |>.1,
70
+
Conflict.ConflictName.synthetic.inj h |>.2⟩
71
+
origN_ne_syntheticN := fun _ _ _ => nofun
72
+
syntheticN_ne_origN := fun _ _ _ => nofun
73
+
tryOrigN := fun
74
+
| .orig n => some n
75
+
| _ => none
76
+
tryOrigN_origN := fun _ => rfl
77
+
tryOrigN_some := fun n' n h => by
78
+
cases n' with
79
+
| orig m => simp at h; subst h; rfl
80
+
| synthetic _ _ => simp at h
81
+
trySyntheticN := fun
82
+
| .synthetic n vs => some (n, vs)
83
+
| _ => none
84
+
trySyntheticN_syntheticN := fun _ _ => rfl
85
+
trySyntheticN_some := fun n' p h => by
86
+
cases n' with
87
+
| orig _ => simp at h
88
+
| synthetic n vs => simp at h; obtain ⟨rfl, rfl⟩ := h; rfl
89
+
90
+
instance : Conflict.HasConflictVersions V (Conflict.ConflictVersion V) where
91
+
origV := ⟨Conflict.ConflictVersion.orig, fun _ _ h => Conflict.ConflictVersion.orig.inj h⟩
92
+
zeroV := Conflict.ConflictVersion.zero
93
+
oneV := Conflict.ConflictVersion.one
94
+
origV_ne_zeroV := fun _ => nofun
95
+
zeroV_ne_origV := fun _ => nofun
96
+
origV_ne_oneV := fun _ => nofun
97
+
oneV_ne_origV := fun _ => nofun
98
+
zeroV_ne_oneV := nofun
99
+
oneV_ne_zeroV := nofun
100
+
tryOrigV := fun
101
+
| .orig v => some v
102
+
| _ => none
103
+
tryOrigV_origV := fun _ => rfl
104
+
tryOrigV_some := fun v' v h => by
105
+
cases v' with
106
+
| orig w => simp at h; subst h; rfl
107
+
| zero => simp at h
108
+
| one => simp at h
109
+
110
+
end PackageCalculus
+137
PackageCalculus/Extensions/Conflict/Reduction/Soundness.lean
+137
PackageCalculus/Extensions/Conflict/Reduction/Soundness.lean
···
1
+
import PackageCalculus.Extensions.Conflict.Reduction.Definition
2
+
import Mathlib.Data.Finset.Preimage
3
+
4
+
/-! # Conflict extension: soundness
5
+
6
+
Any core resolution of the conflict encoding induces a conflict resolution of
7
+
the original problem. -/
8
+
9
+
namespace PackageCalculus.Conflict
10
+
11
+
open Classical
12
+
13
+
variable {N : Type*} [DecidableEq N] {V : Type*} [DecidableEq V]
14
+
variable {N' : Type*} [DecidableEq N'] {V' : Type*} [DecidableEq V']
15
+
variable [hcn : HasConflictNames N V N'] [hcv : HasConflictVersions V V']
16
+
17
+
omit [DecidableEq N] [DecidableEq V] [DecidableEq N'] [DecidableEq V'] in
18
+
private theorem embedPkg_injective : Function.Injective (embedPkg : Package N V → Package N' V') := by
19
+
intro ⟨n₁, v₁⟩ ⟨n₂, v₂⟩ h
20
+
simp only [embedPkg, Prod.mk.injEq] at h
21
+
exact Prod.ext (hcn.origN.injective h.1) (hcv.origV.injective h.2)
22
+
23
+
/-- Computable partial inverse of `embedPkg` via `tryOrigN`/`tryOrigV`. -/
24
+
private def tryInvPkg (p : Package N' V') : Option (Package N V) :=
25
+
match hcn.tryOrigN p.1, hcv.tryOrigV p.2 with
26
+
| some n, some v => some (n, v)
27
+
| _, _ => none
28
+
29
+
omit [DecidableEq N] [DecidableEq V] [DecidableEq N'] [DecidableEq V'] in
30
+
private theorem tryInvPkg_inj :
31
+
∀ a a' (b : Package N V), b ∈ tryInvPkg a → b ∈ tryInvPkg a' → a = a' := by
32
+
intro a a' ⟨n, v⟩ h1 h2
33
+
simp only [tryInvPkg, Option.mem_def] at h1 h2
34
+
revert h1 h2
35
+
cases hn1 : hcn.tryOrigN a.1 <;> cases hv1 : hcv.tryOrigV a.2 <;> simp (config := { decide := false })
36
+
intro rfl rfl
37
+
cases hn2 : hcn.tryOrigN a'.1 <;> cases hv2 : hcv.tryOrigV a'.2 <;> simp (config := { decide := false })
38
+
intro rfl rfl
39
+
exact Prod.ext
40
+
((hcn.tryOrigN_some _ _ hn1).symm.trans (hcn.tryOrigN_some _ _ hn2))
41
+
((hcv.tryOrigV_some _ _ hv1).symm.trans (hcv.tryOrigV_some _ _ hv2))
42
+
43
+
omit [DecidableEq N] [DecidableEq V] [DecidableEq N'] [DecidableEq V'] in
44
+
private theorem tryInvPkg_embed (p : Package N V) :
45
+
tryInvPkg (embedPkg p) = some p := by
46
+
simp [tryInvPkg, embedPkg, hcn.tryOrigN_origN, hcv.tryOrigV_origV]
47
+
48
+
omit [DecidableEq N] [DecidableEq V] [DecidableEq N'] [DecidableEq V'] in
49
+
private theorem tryInvPkg_some {p' : Package N' V'} {p : Package N V}
50
+
(h : p ∈ tryInvPkg p') : embedPkg p = p' := by
51
+
obtain ⟨n', v'⟩ := p'
52
+
obtain ⟨n, v⟩ := p
53
+
simp only [tryInvPkg, Option.mem_def, embedPkg] at h ⊢
54
+
generalize htn : hcn.tryOrigN n' = on at h
55
+
generalize htv : hcv.tryOrigV v' = ov at h
56
+
match on, ov with
57
+
| some n₀, some v₀ =>
58
+
simp at h; obtain ⟨rfl, rfl⟩ := h
59
+
show (hcn.origN n₀, hcv.origV v₀) = (n', v')
60
+
rw [hcn.tryOrigN_some _ _ htn, hcv.tryOrigV_some _ _ htv]
61
+
| some _, none => simp at h
62
+
| none, _ => simp at h
63
+
64
+
private def preimageS (S : Finset (Package N' V')) : Finset (Package N V) :=
65
+
S.filterMap tryInvPkg tryInvPkg_inj
66
+
67
+
omit [DecidableEq N] [DecidableEq V] [DecidableEq N'] [DecidableEq V'] in
68
+
private theorem mem_preimageS {S : Finset (Package N' V')} {p : Package N V} :
69
+
p ∈ preimageS S ↔ embedPkg p ∈ S := by
70
+
simp only [preimageS, Finset.mem_filterMap]
71
+
constructor
72
+
· rintro ⟨p', hp', hinv⟩
73
+
rw [tryInvPkg_some hinv]; exact hp'
74
+
· intro hp
75
+
exact ⟨embedPkg p, hp, tryInvPkg_embed p⟩
76
+
77
+
omit [DecidableEq N] [DecidableEq V] in
78
+
private theorem embedPkg_mem_real {p : Package N V} {R_Γ : Real N V} {Γ : ConflictRel N V}
79
+
(h : embedPkg p ∈ conflictReal R_Γ Γ) : p ∈ R_Γ := by
80
+
simp only [conflictReal, embedSet, Finset.mem_union, Finset.mem_image, Finset.mem_biUnion] at h
81
+
rcases h with ⟨q, hqR, hqeq⟩ | ⟨a, haΓ, hmem⟩
82
+
· simp only [embedPkg, Prod.mk.injEq] at hqeq
83
+
obtain ⟨h1, h2⟩ := hqeq
84
+
have h1' := hcn.origN.injective h1; have h2' := hcv.origV.injective h2
85
+
have : q = p := Prod.ext h1' h2'
86
+
subst this; exact hqR
87
+
· -- embedPkg p is in the synthetic biUnion: contradiction
88
+
simp only [Finset.mem_insert, Finset.mem_singleton, embedPkg, Prod.mk.injEq] at hmem
89
+
rcases hmem with ⟨h1, _⟩ | ⟨h1, _⟩ <;> exact absurd h1 (hcn.origN_ne_syntheticN _ _ _)
90
+
91
+
omit [DecidableEq N] [DecidableEq V] in
92
+
-- Paper Thm 4.1.4 (Conflict Reduction Soundness).
93
+
theorem conflict_soundness
94
+
(R_Γ : Real N V) (Δ_Γ : DepRel N V) (Γ : ConflictRel N V)
95
+
(r : Package N V)
96
+
(S : Finset (Package N' V'))
97
+
(hres : IsResolution (conflictReal R_Γ Γ) (conflictDeps Δ_Γ Γ) (embedPkg r) S) :
98
+
IsConflictResolution R_Γ Δ_Γ Γ r (preimageS S) := by
99
+
refine ⟨⟨?_, ?_, ?_, ?_⟩, ?_⟩
100
+
· -- subset
101
+
intro p hp
102
+
rw [mem_preimageS] at hp
103
+
exact embedPkg_mem_real (hres.subset hp)
104
+
· -- root_mem
105
+
rw [mem_preimageS]
106
+
exact hres.root_mem
107
+
· -- dep_closure
108
+
intro p hp m vs hmem
109
+
rw [mem_preimageS] at hp
110
+
have hd : (embedPkg p, hcn.origN m, embedVS vs) ∈ conflictDeps Δ_Γ Γ := by
111
+
simp only [conflictDeps, Finset.mem_union, Finset.mem_image, Finset.mem_biUnion]
112
+
exact Or.inl (Or.inl ⟨⟨p, m, vs⟩, hmem, rfl⟩)
113
+
obtain ⟨v', hv', hv'S⟩ := hres.dep_closure _ hp _ _ hd
114
+
simp only [embedVS, Finset.mem_map] at hv'
115
+
obtain ⟨v, hv, rfl⟩ := hv'
116
+
exact ⟨v, hv, mem_preimageS.mpr hv'S⟩
117
+
· -- version_unique
118
+
intro n v v' hv hv'
119
+
rw [mem_preimageS] at hv hv'
120
+
exact hcv.origV.injective (hres.version_unique _ _ _ hv hv')
121
+
· -- conflict_avoidance
122
+
intro p hp n vs hg ⟨u, hu, humem⟩
123
+
rw [mem_preimageS] at hp humem
124
+
have hd1 : (embedPkg p, hcn.syntheticN n vs, {hcv.oneV}) ∈ conflictDeps Δ_Γ Γ := by
125
+
simp only [conflictDeps, Finset.mem_union, Finset.mem_image, Finset.mem_biUnion]
126
+
exact Or.inl (Or.inr ⟨⟨p, n, vs⟩, hg, rfl⟩)
127
+
obtain ⟨v₁, hv₁mem, hv1S⟩ := hres.dep_closure _ hp _ _ hd1
128
+
rw [Finset.mem_singleton.mp hv₁mem] at hv1S
129
+
have hd2 : (embedPkg (n, u), hcn.syntheticN n vs, {hcv.zeroV}) ∈ conflictDeps Δ_Γ Γ := by
130
+
simp only [conflictDeps, Finset.mem_union, Finset.mem_image, Finset.mem_biUnion]
131
+
right
132
+
exact ⟨⟨p, n, vs⟩, hg, u, hu, rfl⟩
133
+
obtain ⟨v₂, hv₂mem, hv2S⟩ := hres.dep_closure _ humem _ _ hd2
134
+
rw [Finset.mem_singleton.mp hv₂mem] at hv2S
135
+
exact absurd (hres.version_unique _ _ _ hv1S hv2S) hcv.oneV_ne_zeroV
136
+
137
+
end PackageCalculus.Conflict
+64
PackageCalculus/Extensions/Feature/Definition.lean
+64
PackageCalculus/Extensions/Feature/Definition.lean
···
1
+
import PackageCalculus.Core.Definition
2
+
import Mathlib.Logic.Embedding.Basic
3
+
import Mathlib.Data.Finset.Image
4
+
5
+
/-! # Feature extension: definitions
6
+
7
+
Per-package feature flags drawn from `F`, together with feature-level
8
+
dependency (`FeatDepRel`) and additional-dependency (`AddlDepRel`) relations
9
+
and the `IsFeatureResolution` structure. -/
10
+
11
+
namespace PackageCalculus.Feature
12
+
13
+
open Function
14
+
15
+
variable {N : Type*} [DecidableEq N] {V : Type*} [DecidableEq V] {F : Type*} [DecidableEq F]
16
+
17
+
/-- (p, f) in support means package p supports feature f. -/
18
+
abbrev Support (N V : Type*) [DecidableEq N] [DecidableEq V] (F : Type*) [DecidableEq F] :=
19
+
Finset (Package N V × F)
20
+
21
+
/-- Feature dependency relation: (package, name, versions, required-features). -/
22
+
abbrev FeatDepRel (N V : Type*) [DecidableEq N] [DecidableEq V] (F : Type*) [DecidableEq F] :=
23
+
Finset (Package N V × N × Finset V × Finset F)
24
+
25
+
/-- Additional dependency relation: ((package, feature), name, versions, required-features). -/
26
+
abbrev AddlDepRel (N V : Type*) [DecidableEq N] [DecidableEq V] (F : Type*) [DecidableEq F] :=
27
+
Finset ((Package N V × F) × N × Finset V × Finset F)
28
+
29
+
structure IsFeatureResolution
30
+
(R : Real N V)
31
+
(support : Support N V F)
32
+
(Δ_f : FeatDepRel N V F) (Δ_a : AddlDepRel N V F)
33
+
(r : Package N V)
34
+
(S : Finset (Package N V × Finset F)) : Prop where
35
+
no_root_support : ∀ f, (r, f) ∉ support
36
+
subset : ∀ p fs, (p, fs) ∈ S → p ∈ R
37
+
root_mem : (r, ∅) ∈ S
38
+
feat_dep_closure : ∀ p fs_p, (p, fs_p) ∈ S →
39
+
∀ n vs fs, (p, n, vs, fs) ∈ Δ_f →
40
+
∃ v ∈ vs, ∃ fs', fs ⊆ fs' ∧ ((n, v), fs') ∈ S
41
+
addl_dep_closure : ∀ p fs_p, (p, fs_p) ∈ S →
42
+
∀ f ∈ fs_p, ∀ n vs fs, ((p, f), n, vs, fs) ∈ Δ_a →
43
+
∃ v ∈ vs, ∃ fs', fs ⊆ fs' ∧ ((n, v), fs') ∈ S
44
+
feature_unification : ∀ n v v' fs fs',
45
+
((n, v), fs) ∈ S → ((n, v'), fs') ∈ S → fs = fs'
46
+
version_unique : ∀ n v v' fs fs',
47
+
((n, v), fs) ∈ S → ((n, v'), fs') ∈ S → v = v'
48
+
support_mem : ∀ n v fs f, ((n, v), fs) ∈ S → f ∈ fs → ((n, v), f) ∈ support
49
+
50
+
class HasFeatureNames (N F : Type*) (N' : outParam Type*) where
51
+
origN : N ↪ N'
52
+
/-- Synthetic name for a (name, feature) pair. -/
53
+
featuredN : N → F → N'
54
+
featuredN_injective : Injective2 featuredN
55
+
origN_ne_featuredN : ∀ n₁ n₂ f, origN n₁ ≠ featuredN n₂ f
56
+
featuredN_ne_origN : ∀ n₁ f n₂, featuredN n₁ f ≠ origN n₂
57
+
/-- Decidable partial inverse of `origN`. -/
58
+
tryOrigN : N' → Option N
59
+
tryOrigN_origN : ∀ n, tryOrigN (origN n) = some n
60
+
tryOrigN_some : ∀ n' n, tryOrigN n' = some n → origN n = n'
61
+
62
+
attribute [simp] HasFeatureNames.origN_ne_featuredN HasFeatureNames.featuredN_ne_origN
63
+
64
+
end PackageCalculus.Feature
+88
PackageCalculus/Extensions/Feature/Lifting/Completeness.lean
+88
PackageCalculus/Extensions/Feature/Lifting/Completeness.lean
···
1
+
import PackageCalculus.Extensions.Feature.Lifting.Definition
2
+
3
+
namespace PackageCalculus.Feature
4
+
5
+
variable {N : Type*} [DecidableEq N] {V : Type*} [DecidableEq V]
6
+
{F : Type*} [DecidableEq F] [Fintype F]
7
+
variable {N' : Type*} [DecidableEq N'] [hfn : HasFeatureNames N F N']
8
+
9
+
theorem liftResolution_completenessWitness
10
+
(S_f : Finset (Package N V × Finset F))
11
+
(hfu : ∀ n v v' fs fs', ((n, v), fs) ∈ S_f → ((n, v'), fs') ∈ S_f → fs = fs') :
12
+
liftResolution (hfn := hfn) (completenessWitness S_f) = S_f := by
13
+
ext ⟨⟨pn, pv⟩, fs⟩
14
+
constructor
15
+
· -- forward: ∈ liftResolution → ∈ S_f
16
+
intro h
17
+
obtain ⟨n, v, horig, heq⟩ := liftResolution_elim h
18
+
simp only [Prod.mk.injEq] at heq
19
+
obtain ⟨⟨rfl, rfl⟩, hfs_eq⟩ := heq
20
+
-- horig : (origN pn, pv) ∈ completenessWitness S_f
21
+
simp only [completenessWitness, Finset.mem_union, Finset.mem_image,
22
+
Finset.mem_biUnion] at horig
23
+
rcases horig with ⟨⟨⟨n', v'⟩, fs'⟩, hmem, heq'⟩ | ⟨⟨⟨n', v'⟩, fs'⟩, hmem', hfmem⟩
24
+
· simp only [Prod.mk.injEq] at heq'
25
+
obtain ⟨h1, h2⟩ := heq'
26
+
have hn := hfn.origN.injective h1
27
+
subst hn; subst h2
28
+
suffices hfs : fs = fs' by subst hfs; exact hmem
29
+
rw [hfs_eq]; ext f
30
+
simp only [Finset.mem_filter, Finset.mem_univ, true_and]
31
+
constructor
32
+
· intro hf
33
+
simp only [completenessWitness, Finset.mem_union, Finset.mem_image,
34
+
Finset.mem_biUnion] at hf
35
+
rcases hf with ⟨⟨⟨n₀, v₀⟩, fs₀⟩, _, heq''⟩ |
36
+
⟨⟨⟨n₀, v₀⟩, fs₀⟩, hmem₀, hfmem'⟩
37
+
· simp only [Prod.mk.injEq] at heq''
38
+
exact absurd heq''.1 (hfn.origN_ne_featuredN _ _ _)
39
+
· obtain ⟨f', hf', heq''⟩ := hfmem'
40
+
simp only [Prod.mk.injEq] at heq''
41
+
obtain ⟨h1, rfl⟩ := heq''
42
+
obtain ⟨rfl, rfl⟩ := hfn.featuredN_injective h1
43
+
exact hfu _ _ _ _ _ hmem hmem₀ ▸ hf'
44
+
· intro hf
45
+
exact Finset.mem_union.mpr (Or.inr (Finset.mem_biUnion.mpr
46
+
⟨⟨(n', v'), fs'⟩, hmem, Finset.mem_image.mpr ⟨f, hf, rfl⟩⟩))
47
+
· -- origN pn = featuredN ... contradiction
48
+
obtain ⟨f', _, heq'⟩ := hfmem
49
+
simp only [Prod.mk.injEq] at heq'
50
+
exact absurd heq'.1.symm (hfn.origN_ne_featuredN _ _ _)
51
+
· -- backward: ∈ S_f → ∈ liftResolution
52
+
intro hmem
53
+
have horig : (hfn.origN pn, pv) ∈ completenessWitness (N' := N') S_f :=
54
+
Finset.mem_union.mpr (Or.inl (Finset.mem_image.mpr ⟨⟨(pn, pv), fs⟩, hmem, rfl⟩))
55
+
have h := mem_liftResolution' horig
56
+
convert h using 1
57
+
simp only [Prod.mk.injEq, true_and]
58
+
ext f
59
+
simp only [Finset.mem_filter, Finset.mem_univ, true_and]
60
+
constructor
61
+
· intro hf
62
+
exact Finset.mem_union.mpr (Or.inr (Finset.mem_biUnion.mpr
63
+
⟨⟨(pn, pv), fs⟩, hmem, Finset.mem_image.mpr ⟨f, hf, rfl⟩⟩))
64
+
· intro hf
65
+
simp only [completenessWitness, Finset.mem_union, Finset.mem_image,
66
+
Finset.mem_biUnion] at hf
67
+
rcases hf with ⟨⟨⟨n₀, v₀⟩, fs₀⟩, _, heq'⟩ | ⟨⟨⟨n₀, v₀⟩, fs₀⟩, hmem', hfmem'⟩
68
+
· simp only [Prod.mk.injEq] at heq'
69
+
exact absurd heq'.1 (hfn.origN_ne_featuredN _ _ _)
70
+
· obtain ⟨f', hf', heq'⟩ := hfmem'
71
+
simp only [Prod.mk.injEq] at heq'
72
+
obtain ⟨h1, rfl⟩ := heq'
73
+
obtain ⟨rfl, rfl⟩ := hfn.featuredN_injective h1
74
+
exact hfu _ _ _ _ _ hmem hmem' ▸ hf'
75
+
76
+
theorem liftResolution_completeness
77
+
(R_f : Real N V) (support : Support N V F)
78
+
(Δ_f : FeatDepRel N V F) (Δ_a : AddlDepRel N V F)
79
+
(r : Package N V)
80
+
(S_f : Finset (Package N V × Finset F))
81
+
(hres : IsFeatureResolution R_f support Δ_f Δ_a r S_f) :
82
+
∃ S', IsResolution (featureReal R_f support) (featureDeps R_f support Δ_f Δ_a)
83
+
(embedPkg F r) S' ∧ liftResolution S' = S_f :=
84
+
⟨completenessWitness S_f, feature_completeness R_f support Δ_f Δ_a r S_f hres,
85
+
liftResolution_completenessWitness S_f hres.feature_unification⟩
86
+
87
+
88
+
end PackageCalculus.Feature
+94
PackageCalculus/Extensions/Feature/Lifting/Definition.lean
+94
PackageCalculus/Extensions/Feature/Lifting/Definition.lean
···
1
+
import PackageCalculus.Extensions.Feature.Reduction.Completeness
2
+
import PackageCalculus.Extensions.Feature.Reduction.Soundness
3
+
4
+
namespace PackageCalculus.Feature
5
+
6
+
variable {N : Type*} [DecidableEq N] {V : Type*} [DecidableEq V]
7
+
{F : Type*} [DecidableEq F] [Fintype F]
8
+
variable {N' : Type*} [DecidableEq N'] [hfn : HasFeatureNames N F N']
9
+
10
+
/-! ## Computable inverse helpers -/
11
+
12
+
def tryInvPkg (p : Package N' V) : Option (Package N V) :=
13
+
match hfn.tryOrigN p.1 with
14
+
| some n => some (n, p.2)
15
+
| none => none
16
+
17
+
attribute [local simp] HasFeatureNames.tryOrigN_origN
18
+
19
+
omit [DecidableEq N] [DecidableEq V] [DecidableEq F] [Fintype F] [DecidableEq N'] in
20
+
private theorem tryInvPkg_inj :
21
+
∀ a a' (b : Package N V), b ∈ tryInvPkg (hfn := hfn) a → b ∈ tryInvPkg (hfn := hfn) a' → a = a' := by
22
+
intro a a' ⟨n, v⟩ h1 h2
23
+
simp only [tryInvPkg, Option.mem_def] at h1 h2
24
+
revert h1 h2
25
+
cases hn1 : hfn.tryOrigN a.1 <;> simp (config := { decide := false })
26
+
intro rfl rfl
27
+
cases hn2 : hfn.tryOrigN a'.1 <;> simp (config := { decide := false })
28
+
intro rfl heq
29
+
exact Prod.ext ((hfn.tryOrigN_some _ _ hn1).symm.trans (hfn.tryOrigN_some _ _ hn2)) heq.symm
30
+
31
+
omit [DecidableEq N] [DecidableEq V] [DecidableEq F] [Fintype F] [DecidableEq N'] in
32
+
private theorem tryInvPkg_embed (p : Package N V) :
33
+
tryInvPkg (hfn := hfn) (embedPkg F p) = some p := by
34
+
simp [tryInvPkg, embedPkg, hfn.tryOrigN_origN]
35
+
36
+
omit [DecidableEq N] [DecidableEq V] [DecidableEq F] [Fintype F] [DecidableEq N'] in
37
+
theorem tryInvPkg_some {p' : Package N' V} {p : Package N V}
38
+
(h : p ∈ tryInvPkg (hfn := hfn) p') : embedPkg F p = p' := by
39
+
obtain ⟨n', v'⟩ := p'
40
+
obtain ⟨n, v⟩ := p
41
+
simp only [tryInvPkg, Option.mem_def, embedPkg] at h ⊢
42
+
generalize htn : hfn.tryOrigN n' = on at h
43
+
match on with
44
+
| some n₀ =>
45
+
simp at h; obtain ⟨rfl, rfl⟩ := h
46
+
show (hfn.origN n₀, v') = (n', v')
47
+
rw [hfn.tryOrigN_some _ _ htn]
48
+
| none => simp at h
49
+
50
+
/-! ## Lift functions -/
51
+
52
+
/-- Lift an extended-space repository back to the original space. -/
53
+
def liftReal (R' : Real N' V) : Real N V :=
54
+
R'.filterMap (tryInvPkg (hfn := hfn)) tryInvPkg_inj
55
+
56
+
/-- Lift an extended-space resolution back to a feature resolution.
57
+
Each original package is paired with the set of features active for it. -/
58
+
def liftResolution (S' : Finset (Package N' V)) :
59
+
Finset (Package N V × Finset F) :=
60
+
(S'.filterMap (tryInvPkg (hfn := hfn)) tryInvPkg_inj).image
61
+
(fun p => (p, Finset.univ.filter (fun f => (hfn.featuredN p.1 f, p.2) ∈ S')))
62
+
63
+
/-! ## Membership lemmas -/
64
+
65
+
omit [DecidableEq N] [DecidableEq V] [DecidableEq F] [Fintype F] [DecidableEq N'] in
66
+
theorem mem_liftReal {R' : Real N' V} {p : Package N V} :
67
+
p ∈ liftReal (hfn := hfn) R' ↔ embedPkg F p ∈ R' := by
68
+
simp only [liftReal, Finset.mem_filterMap]
69
+
constructor
70
+
· rintro ⟨p', hp', hinv⟩
71
+
exact (tryInvPkg_some hinv) ▸ hp'
72
+
· intro hp
73
+
exact ⟨embedPkg F p, hp, by rw [tryInvPkg_embed]⟩
74
+
75
+
theorem mem_liftResolution' {S' : Finset (Package N' V)}
76
+
{n : N} {v : V} (h : (hfn.origN n, v) ∈ S') :
77
+
((n, v), Finset.univ.filter (fun f => (hfn.featuredN n f, v) ∈ S')) ∈
78
+
liftResolution (hfn := hfn) S' := by
79
+
simp only [liftResolution, Finset.mem_image, Finset.mem_filterMap]
80
+
exact ⟨(n, v), ⟨(hfn.origN n, v), h, by simp [tryInvPkg, hfn.tryOrigN_origN]⟩, rfl⟩
81
+
82
+
theorem liftResolution_elim {S' : Finset (Package N' V)}
83
+
{pfs : Package N V × Finset F} (h : pfs ∈ liftResolution (hfn := hfn) S') :
84
+
∃ n v, (hfn.origN n, v) ∈ S' ∧
85
+
pfs = ((n, v), Finset.univ.filter (fun f => (hfn.featuredN n f, v) ∈ S')) := by
86
+
simp only [liftResolution, Finset.mem_image, Finset.mem_filterMap] at h
87
+
obtain ⟨⟨n, v⟩, ⟨p', hp', hinv⟩, rfl⟩ := h
88
+
have heq := tryInvPkg_some hinv
89
+
simp only [embedPkg] at heq
90
+
refine ⟨n, v, ?_, rfl⟩
91
+
exact heq ▸ hp'
92
+
93
+
94
+
end PackageCalculus.Feature
+33
PackageCalculus/Extensions/Feature/Lifting/Retraction.lean
+33
PackageCalculus/Extensions/Feature/Lifting/Retraction.lean
···
1
+
import PackageCalculus.Extensions.Feature.Lifting.Definition
2
+
3
+
namespace PackageCalculus.Feature
4
+
5
+
variable {N : Type*} [DecidableEq N] {V : Type*} [DecidableEq V]
6
+
{F : Type*} [DecidableEq F] [Fintype F]
7
+
variable {N' : Type*} [DecidableEq N'] [hfn : HasFeatureNames N F N']
8
+
9
+
/-! ## Round-trip theorem -/
10
+
11
+
omit [Fintype F] in
12
+
theorem liftReal_featureReal (R : Real N V) (support : Support N V F) :
13
+
liftReal (hfn := hfn) (featureReal R support) = R := by
14
+
ext p
15
+
rw [mem_liftReal]
16
+
simp only [featureReal, embedSet, embedPkg, Finset.mem_union, Finset.mem_image,
17
+
Finset.mem_biUnion]
18
+
constructor
19
+
· intro h
20
+
rcases h with ⟨⟨qn, qv⟩, hqR, heq⟩ | ⟨a, _, hmem_ite⟩
21
+
· simp only [Prod.mk.injEq] at heq
22
+
obtain ⟨h1, h2⟩ := heq
23
+
have := hfn.origN.injective h1; subst this; subst h2
24
+
exact hqR
25
+
· split at hmem_ite
26
+
· simp only [Finset.mem_singleton, Prod.mk.injEq] at hmem_ite
27
+
exact absurd hmem_ite.1 (hfn.origN_ne_featuredN _ _ _)
28
+
· simp at hmem_ite
29
+
· intro hp
30
+
exact Or.inl ⟨p, hp, rfl⟩
31
+
32
+
33
+
end PackageCalculus.Feature
+35
PackageCalculus/Extensions/Feature/Lifting/Soundness.lean
+35
PackageCalculus/Extensions/Feature/Lifting/Soundness.lean
···
1
+
import PackageCalculus.Extensions.Feature.Lifting.Definition
2
+
3
+
namespace PackageCalculus.Feature
4
+
5
+
variable {N : Type*} [DecidableEq N] {V : Type*} [DecidableEq V]
6
+
{F : Type*} [DecidableEq F] [Fintype F]
7
+
variable {N' : Type*} [DecidableEq N'] [hfn : HasFeatureNames N F N']
8
+
9
+
/-! ## Lifting soundness & completeness -/
10
+
11
+
theorem liftResolution_soundness
12
+
(R_f : Real N V) (support : Support N V F)
13
+
(Δ_f : FeatDepRel N V F) (Δ_a : AddlDepRel N V F)
14
+
(r : Package N V) (S' : Finset (Package N' V))
15
+
(hres : IsResolution (featureReal R_f support) (featureDeps R_f support Δ_f Δ_a)
16
+
(embedPkg F r) S')
17
+
(hroot_no_support : ∀ f, (r, f) ∉ support) :
18
+
IsFeatureResolution R_f support Δ_f Δ_a r (liftResolution S') := by
19
+
have h := feature_soundness R_f support Δ_f Δ_a r S' hres hroot_no_support
20
+
-- soundnessWitness and liftResolution agree extensionally
21
+
suffices heq : liftResolution S' = soundnessWitness S' by rw [heq]; exact h
22
+
simp only [liftResolution, soundnessWitness]
23
+
congr 1
24
+
ext ⟨n, v⟩
25
+
simp only [Finset.mem_filterMap, Finset.mem_preimage, embedPkg]
26
+
constructor
27
+
· rintro ⟨p', hp', hinv⟩
28
+
have heq := tryInvPkg_some hinv
29
+
simp only [embedPkg] at heq
30
+
exact heq ▸ hp'
31
+
· intro hp
32
+
exact ⟨(hfn.origN n, v), hp, by simp [tryInvPkg, hfn.tryOrigN_origN]⟩
33
+
34
+
35
+
end PackageCalculus.Feature
+159
PackageCalculus/Extensions/Feature/Reduction/Completeness.lean
+159
PackageCalculus/Extensions/Feature/Reduction/Completeness.lean
···
1
+
import PackageCalculus.Extensions.Feature.Reduction.Definition
2
+
3
+
/-! # Feature extension: completeness
4
+
5
+
Any feature resolution lifts to a core resolution of the feature encoding. -/
6
+
7
+
namespace PackageCalculus.Feature
8
+
9
+
open Classical
10
+
11
+
variable {N : Type*} [DecidableEq N] {V : Type*} [DecidableEq V]
12
+
{F : Type*} [DecidableEq F]
13
+
variable {N' : Type*} [DecidableEq N'] [hfn : HasFeatureNames N F N']
14
+
15
+
def completenessWitness (S_f : Finset (Package N V × Finset F)) :
16
+
Finset (Package N' V) :=
17
+
-- Base packages
18
+
S_f.image (fun ⟨⟨n, v⟩, _⟩ => (hfn.origN n, v)) ∪
19
+
-- Feature packages
20
+
S_f.biUnion (fun ⟨⟨n, v⟩, fs⟩ =>
21
+
fs.image (fun f => (hfn.featuredN n f, v)))
22
+
23
+
-- Paper Thm 4.4.6 (Feature Reduction Completeness).
24
+
theorem feature_completeness
25
+
(R_f : Real N V) (support : Support N V F)
26
+
(Δ_f : FeatDepRel N V F) (Δ_a : AddlDepRel N V F)
27
+
(r : Package N V)
28
+
(S_f : Finset (Package N V × Finset F))
29
+
(hres : IsFeatureResolution R_f support Δ_f Δ_a r S_f) :
30
+
IsResolution (featureReal R_f support) (featureDeps R_f support Δ_f Δ_a)
31
+
(embedPkg F r) (completenessWitness S_f) := by
32
+
have mem_base : ∀ n v fs, ((n, v), fs) ∈ S_f →
33
+
(hfn.origN n, v) ∈ completenessWitness S_f := by
34
+
intro n v fs h
35
+
exact Finset.mem_union.mpr (Or.inl (Finset.mem_image.mpr ⟨⟨(n, v), fs⟩, h, rfl⟩))
36
+
have mem_feat : ∀ n v fs f, ((n, v), fs) ∈ S_f → f ∈ fs →
37
+
(hfn.featuredN n f, v) ∈ completenessWitness S_f := by
38
+
intro n v fs f h hf
39
+
exact Finset.mem_union.mpr (Or.inr (Finset.mem_biUnion.mpr
40
+
⟨⟨(n, v), fs⟩, h, Finset.mem_image.mpr ⟨f, hf, rfl⟩⟩))
41
+
refine ⟨?_, ?_, ?_, ?_⟩
42
+
· -- subset
43
+
intro q hq
44
+
simp only [completenessWitness, Finset.mem_union, Finset.mem_image, Finset.mem_biUnion] at hq
45
+
simp only [featureReal, Finset.mem_union, Finset.mem_image, Finset.mem_biUnion, embedSet,
46
+
embedPkg]
47
+
rcases hq with (⟨⟨⟨n, v⟩, fs⟩, hmem, rfl⟩ | ⟨⟨⟨n, v⟩, fs⟩, hmem, hfmem⟩)
48
+
· left; exact ⟨(n, v), hres.subset (n, v) fs hmem, rfl⟩
49
+
· obtain ⟨f, hf, rfl⟩ := hfmem
50
+
right
51
+
refine ⟨⟨(n, v), f⟩, hres.support_mem n v fs f hmem hf, ?_⟩
52
+
simp [hres.subset (n, v) fs hmem]
53
+
· -- root_mem
54
+
exact mem_base r.1 r.2 ∅ hres.root_mem
55
+
· -- dep_closure
56
+
intro q hq m ws hd
57
+
simp only [completenessWitness, Finset.mem_union, Finset.mem_image, Finset.mem_biUnion] at hq
58
+
rcases hq with (⟨⟨⟨pn, pv⟩, fs⟩, hmem, rfl⟩ | ⟨⟨⟨pn, pv⟩, fs⟩, hmem, hfmem⟩)
59
+
· -- base package (origN pn, pv)
60
+
simp only [featureDeps, Finset.mem_union, Finset.mem_image, Finset.mem_biUnion,
61
+
Finset.mem_filter] at hd
62
+
rcases hd with ((((⟨⟨⟨n', v'⟩, f'⟩, _, ha_ite⟩ |
63
+
⟨⟨p, m', vs', fs₀⟩, ⟨hdf, hfs_eq⟩, heq⟩) |
64
+
⟨⟨p, m', vs', fs'⟩, ⟨hdf, _⟩, hfm⟩) |
65
+
⟨⟨⟨pnv, f'⟩, m', vs', _⟩, ⟨_, _⟩, heq⟩) |
66
+
⟨⟨⟨pnv, f'⟩, m', vs', fs'⟩, ⟨_, _⟩, hfm⟩)
67
+
· -- (4.4.4.2a): source is featuredN → contradiction
68
+
split at ha_ite
69
+
· simp only [Finset.mem_singleton, Prod.mk.injEq] at ha_ite
70
+
exact absurd ha_ite.1.1 (by simp)
71
+
· simp at ha_ite
72
+
· -- (4.4.4.2b) no features
73
+
simp only [embedPkg, Prod.mk.injEq] at heq
74
+
obtain ⟨⟨h1, h2⟩, rfl, rfl⟩ := heq
75
+
have h1' := hfn.origN.injective h1; subst h1'; subst h2
76
+
subst hfs_eq
77
+
obtain ⟨v', hv', fs', _, hfs'⟩ :=
78
+
hres.feat_dep_closure p fs hmem m' vs' ∅ hdf
79
+
exact ⟨v', hv', mem_base m' v' fs' hfs'⟩
80
+
· -- (4.4.4.2b) with features
81
+
obtain ⟨f', hf', heq⟩ := hfm
82
+
simp only [embedPkg, Prod.mk.injEq] at heq
83
+
obtain ⟨⟨h1, h2⟩, rfl, rfl⟩ := heq
84
+
have h1' := hfn.origN.injective h1; subst h1'; subst h2
85
+
obtain ⟨v', hv', fs'', hfs_sub, hfs''⟩ :=
86
+
hres.feat_dep_closure p fs hmem m' vs' fs' hdf
87
+
exact ⟨v', hv', mem_feat m' v' fs'' f' hfs'' (hfs_sub hf')⟩
88
+
· -- (4.4.4.2c) no features: source is featuredN → contradiction
89
+
simp only [Prod.mk.injEq] at heq; exact absurd heq.1.1 (by simp)
90
+
· -- (4.4.4.2c) with features: source is featuredN → contradiction
91
+
obtain ⟨f'', _, heq⟩ := hfm
92
+
simp only [Prod.mk.injEq] at heq; exact absurd heq.1.1 (by simp)
93
+
· -- featured package (featuredN pn f₀, pv)
94
+
obtain ⟨f₀, hf₀, rfl⟩ := hfmem
95
+
simp only [featureDeps, Finset.mem_union, Finset.mem_image, Finset.mem_biUnion,
96
+
Finset.mem_filter] at hd
97
+
rcases hd with ((((⟨⟨⟨n', v'⟩, f'⟩, _, ha_ite⟩ |
98
+
⟨⟨p, m', vs', _⟩, ⟨_, _⟩, heq⟩) |
99
+
⟨⟨p, m', vs', fs'⟩, ⟨_, _⟩, hfm⟩) |
100
+
⟨⟨⟨pnv, f'⟩, m', vs', fs₀⟩, ⟨hda, hfs_eq⟩, heq⟩) |
101
+
⟨⟨⟨pnv, f'⟩, m', vs', fs'⟩, ⟨hda, _⟩, hfm⟩)
102
+
· -- (4.4.4.2a): (featuredN n' f', v') → (origN n', {v'})
103
+
split at ha_ite
104
+
· simp only [Finset.mem_singleton, Prod.mk.injEq] at ha_ite
105
+
obtain ⟨⟨h1, h2⟩, rfl, rfl⟩ := ha_ite
106
+
obtain ⟨rfl, rfl⟩ := hfn.featuredN_injective h1; subst h2
107
+
exact ⟨pv, Finset.mem_singleton.mpr rfl, mem_base pn pv fs hmem⟩
108
+
· simp at ha_ite
109
+
· -- (4.4.4.2b): source is embedPkg = origN → contradiction
110
+
simp only [embedPkg, Prod.mk.injEq] at heq; exact absurd heq.1.1 (by simp)
111
+
· -- (4.4.4.2b) with features: source is embedPkg → contradiction
112
+
obtain ⟨f', _, heq⟩ := hfm
113
+
simp only [embedPkg, Prod.mk.injEq] at heq; exact absurd heq.1.1 (by simp)
114
+
· -- (4.4.4.2c) no features: (featuredN n' f', v') → (origN m', vs')
115
+
simp only [Prod.mk.injEq] at heq
116
+
obtain ⟨⟨h1, h2⟩, rfl, rfl⟩ := heq
117
+
obtain ⟨hn_eq, hf_eq⟩ := hfn.featuredN_injective h1
118
+
subst hn_eq; subst hf_eq; subst h2; subst hfs_eq
119
+
obtain ⟨v', hv', fs', _, hfs'⟩ :=
120
+
hres.addl_dep_closure (pnv.1, pnv.2) fs hmem f' hf₀ m' vs' ∅ hda
121
+
exact ⟨v', hv', mem_base m' v' fs' hfs'⟩
122
+
· -- (4.4.4.2c) with features: (featuredN n' f', v') → (featuredN m' f'', vs')
123
+
obtain ⟨f'', hf'', heq⟩ := hfm
124
+
simp only [Prod.mk.injEq] at heq
125
+
obtain ⟨⟨h1, h2⟩, rfl, rfl⟩ := heq
126
+
obtain ⟨hn_eq, hf_eq⟩ := hfn.featuredN_injective h1
127
+
subst hn_eq; subst hf_eq; subst h2
128
+
obtain ⟨v', hv', fs'', hfs_sub, hfs''⟩ :=
129
+
hres.addl_dep_closure (pnv.1, pnv.2) fs hmem f' hf₀ m' vs' fs' hda
130
+
exact ⟨v', hv', mem_feat m' v' fs'' f'' hfs'' (hfs_sub hf'')⟩
131
+
· -- version_unique
132
+
intro nm v1 v2 hv1 hv2
133
+
simp only [completenessWitness, Finset.mem_union, Finset.mem_image, Finset.mem_biUnion] at hv1 hv2
134
+
rcases hv1 with (⟨⟨⟨n₁, _⟩, fs₁⟩, hmem₁, heq1⟩ | ⟨⟨⟨n₁, _⟩, fs₁⟩, hmem₁, hfmem1⟩) <;>
135
+
rcases hv2 with (⟨⟨⟨n₂, _⟩, fs₂⟩, hmem₂, heq2⟩ | ⟨⟨⟨n₂, _⟩, fs₂⟩, hmem₂, hfmem2⟩)
136
+
· -- origN × origN
137
+
simp only [Prod.mk.injEq] at heq1 heq2
138
+
obtain ⟨h1n, rfl⟩ := heq1; obtain ⟨h2n, rfl⟩ := heq2
139
+
exact hres.version_unique n₁ _ _ fs₁ fs₂ hmem₁
140
+
(hfn.origN.injective (h1n.trans h2n.symm) ▸ hmem₂)
141
+
· -- origN × featuredN: name clash
142
+
simp only [Prod.mk.injEq] at heq1
143
+
obtain ⟨h1n, rfl⟩ := heq1
144
+
obtain ⟨f₂, _, heq2⟩ := hfmem2
145
+
simp only [Prod.mk.injEq] at heq2
146
+
exact absurd (h1n.trans heq2.1.symm) (by simp)
147
+
· -- featuredN × origN: name clash
148
+
obtain ⟨f₁, _, heq1⟩ := hfmem1
149
+
simp only [Prod.mk.injEq] at heq1 heq2
150
+
exact absurd (heq1.1.trans heq2.1.symm) (by simp)
151
+
· -- featuredN × featuredN
152
+
obtain ⟨f₁, _, heq1⟩ := hfmem1
153
+
obtain ⟨f₂, _, heq2⟩ := hfmem2
154
+
simp only [Prod.mk.injEq] at heq1 heq2
155
+
obtain ⟨h1n, rfl⟩ := heq1; obtain ⟨h2n, rfl⟩ := heq2
156
+
obtain ⟨rfl, rfl⟩ := hfn.featuredN_injective (h1n.trans h2n.symm)
157
+
exact hres.version_unique n₁ _ _ fs₁ fs₂ hmem₁ hmem₂
158
+
159
+
end PackageCalculus.Feature
+79
PackageCalculus/Extensions/Feature/Reduction/Definition.lean
+79
PackageCalculus/Extensions/Feature/Reduction/Definition.lean
···
1
+
import PackageCalculus.Extensions.Feature.Definition
2
+
import Mathlib.Data.Finset.Union
3
+
4
+
/-! # Feature extension: reduction
5
+
6
+
Encodes feature flags into the core calculus by splitting each package name
7
+
into an *origin* variant and per-feature variants, and translating feature
8
+
constraints into core dependencies. -/
9
+
10
+
namespace PackageCalculus.Feature
11
+
12
+
variable {N : Type*} [DecidableEq N] {V : Type*} [DecidableEq V] {F : Type*} [DecidableEq F]
13
+
14
+
inductive FeatureName (N F : Type*) where
15
+
| orig : N → FeatureName N F
16
+
| featured : N → F → FeatureName N F
17
+
deriving DecidableEq
18
+
19
+
variable {N' : Type*} [DecidableEq N'] [hfn : HasFeatureNames N F N']
20
+
21
+
def embedPkg (F : Type*) [hfn : HasFeatureNames N F N'] (p : Package N V) : Package N' V :=
22
+
(hfn.origN p.1, p.2)
23
+
24
+
def embedSet (F : Type*) [DecidableEq N'] [hfn : HasFeatureNames N F N'] (S : Finset (Package N V)) : Finset (Package N' V) :=
25
+
S.image (embedPkg F)
26
+
27
+
def featureReal (R_f : Real N V) (support : Support N V F) :
28
+
Real N' V :=
29
+
embedSet F R_f ∪
30
+
(support.biUnion (fun ⟨⟨n, v⟩, f⟩ =>
31
+
if (n, v) ∈ R_f then {(hfn.featuredN n f, v)} else ∅))
32
+
33
+
def featureDeps (R_f : Real N V) (support : Support N V F)
34
+
(Δ_f : FeatDepRel N V F) (Δ_a : AddlDepRel N V F) :
35
+
DepRel N' V :=
36
+
-- Feature packages depend on their base: (⟨n, f⟩, v) Δ (n, {v})
37
+
(support.biUnion (fun ⟨⟨n, v⟩, f⟩ =>
38
+
if (n, v) ∈ R_f then {((hfn.featuredN n f, v), hfn.origN n, {v})} else ∅)) ∪
39
+
-- Parameterised deps with no features: p Δ (n, vs)
40
+
((Δ_f.filter (fun ⟨_, _, _, fs⟩ => fs = ∅)).image
41
+
(fun ⟨p, n, vs, _⟩ => (embedPkg F p, hfn.origN n, vs))) ∪
42
+
-- Parameterised deps with features: ∀ f ∈ fs, p Δ (⟨n, f⟩, vs)
43
+
((Δ_f.filter (fun ⟨_, _, _, fs⟩ => fs.Nonempty)).biUnion
44
+
(fun ⟨p, n, vs, fs⟩ => fs.image (fun f => (embedPkg F p, hfn.featuredN n f, vs)))) ∪
45
+
-- Additional deps with no features: (⟨n, f⟩, v) Δ (m, vs)
46
+
((Δ_a.filter (fun ⟨_, _, _, fs⟩ => fs = ∅)).image
47
+
(fun ⟨⟨⟨n, v⟩, f⟩, m, vs, _⟩ => ((hfn.featuredN n f, v), hfn.origN m, vs))) ∪
48
+
-- Additional deps with features: (⟨n, f⟩, v) Δ (⟨m, f'⟩, vs)
49
+
((Δ_a.filter (fun ⟨_, _, _, fs⟩ => fs.Nonempty)).biUnion
50
+
(fun ⟨⟨⟨n, v⟩, f⟩, m, vs, fs⟩ =>
51
+
fs.image (fun f' => ((hfn.featuredN n f, v), hfn.featuredN m f', vs))))
52
+
53
+
end PackageCalculus.Feature
54
+
55
+
namespace PackageCalculus
56
+
57
+
open Function
58
+
59
+
variable {N F : Type*}
60
+
61
+
instance : Feature.HasFeatureNames N F (Feature.FeatureName N F) where
62
+
origN := ⟨Feature.FeatureName.orig, fun _ _ h => Feature.FeatureName.orig.inj h⟩
63
+
featuredN := Feature.FeatureName.featured
64
+
featuredN_injective := by
65
+
intro a₁ a₂ b₁ b₂ h
66
+
exact ⟨Feature.FeatureName.featured.inj h |>.1,
67
+
Feature.FeatureName.featured.inj h |>.2⟩
68
+
origN_ne_featuredN := fun _ _ _ => nofun
69
+
featuredN_ne_origN := fun _ _ _ => nofun
70
+
tryOrigN := fun
71
+
| .orig n => some n
72
+
| _ => none
73
+
tryOrigN_origN := fun _ => rfl
74
+
tryOrigN_some := fun n' n h => by
75
+
cases n' with
76
+
| orig m => simp at h; subst h; rfl
77
+
| featured _ _ => simp at h
78
+
79
+
end PackageCalculus
+228
PackageCalculus/Extensions/Feature/Reduction/Soundness.lean
+228
PackageCalculus/Extensions/Feature/Reduction/Soundness.lean
···
1
+
import PackageCalculus.Extensions.Feature.Reduction.Definition
2
+
import Mathlib.Data.Finset.Preimage
3
+
4
+
/-! # Feature extension: soundness
5
+
6
+
Any core resolution of the feature encoding induces a feature resolution of
7
+
the original problem. -/
8
+
9
+
namespace PackageCalculus.Feature
10
+
11
+
open Classical
12
+
13
+
variable {N : Type*} [DecidableEq N] {V : Type*} [DecidableEq V]
14
+
{F : Type*} [DecidableEq F] [Fintype F]
15
+
variable {N' : Type*} [DecidableEq N'] [hfn : HasFeatureNames N F N']
16
+
17
+
omit [DecidableEq N] [DecidableEq V] [DecidableEq F] [Fintype F]
18
+
[DecidableEq N'] in
19
+
private theorem embedPkg_F_injective :
20
+
Function.Injective (embedPkg F : Package N V → Package N' V) := by
21
+
intro ⟨n₁, v₁⟩ ⟨n₂, v₂⟩ h
22
+
simp only [embedPkg, Prod.mk.injEq] at h
23
+
exact Prod.ext (hfn.origN.injective h.1) h.2
24
+
25
+
noncomputable def soundnessWitness
26
+
(S : Finset (Package N' V)) : Finset (Package N V × Finset F) :=
27
+
(S.preimage (embedPkg F) (Set.InjOn.mono (Set.subset_univ _)
28
+
(Function.Injective.injOn embedPkg_F_injective))).image
29
+
(fun p => (p, Finset.univ.filter (fun f => (hfn.featuredN p.1 f, p.2) ∈ S)))
30
+
31
+
private theorem mem_soundnessWitness {S : Finset (Package N' V)}
32
+
{n : N} {v : V} (h : (hfn.origN n, v) ∈ S) :
33
+
((n, v), Finset.univ.filter (fun f => (hfn.featuredN n f, v) ∈ S)) ∈
34
+
soundnessWitness S := by
35
+
simp only [soundnessWitness, Finset.mem_image, Finset.mem_preimage, embedPkg]
36
+
exact ⟨(n, v), h, rfl⟩
37
+
38
+
private theorem soundnessWitness_elim {S : Finset (Package N' V)}
39
+
{pfs : Package N V × Finset F} (h : pfs ∈ soundnessWitness S) :
40
+
∃ n v, (hfn.origN n, v) ∈ S ∧
41
+
pfs = ((n, v), Finset.univ.filter (fun f => (hfn.featuredN n f, v) ∈ S)) := by
42
+
simp only [soundnessWitness, Finset.mem_image, Finset.mem_preimage, embedPkg] at h
43
+
obtain ⟨⟨n, v⟩, hmem, rfl⟩ := h
44
+
exact ⟨n, v, hmem, rfl⟩
45
+
46
+
-- Paper Thm 4.4.5 (Feature Reduction Soundness).
47
+
theorem feature_soundness
48
+
(R_f : Real N V) (support : Support N V F)
49
+
(Δ_f : FeatDepRel N V F) (Δ_a : AddlDepRel N V F)
50
+
(r : Package N V)
51
+
(S : Finset (Package N' V))
52
+
(hres : IsResolution (featureReal R_f support) (featureDeps R_f support Δ_f Δ_a)
53
+
(embedPkg F r) S)
54
+
(hroot_no_support : ∀ f, (r, f) ∉ support) :
55
+
IsFeatureResolution R_f support Δ_f Δ_a r (soundnessWitness S) := by
56
+
-- Derived: no feature package for the root is in S. Any such package would arise
57
+
-- from a support entry (r, f), excluded by hroot_no_support.
58
+
have hroot_no_feat : ∀ f, (hfn.featuredN r.1 f, r.2) ∉ S := by
59
+
intro f hmem
60
+
have hsub := hres.subset hmem
61
+
simp only [featureReal, embedSet, embedPkg, Finset.mem_union, Finset.mem_image,
62
+
Finset.mem_biUnion] at hsub
63
+
rcases hsub with ⟨⟨_, _⟩, _, heq⟩ | ⟨⟨⟨n', v'⟩, f'⟩, hsupp, hmem_ite⟩
64
+
· simp only [Prod.mk.injEq] at heq
65
+
exact absurd heq.1 (hfn.origN_ne_featuredN _ _ _)
66
+
· split at hmem_ite
67
+
· simp only [Finset.mem_singleton, Prod.mk.injEq] at hmem_ite
68
+
obtain ⟨h1, rfl⟩ := hmem_ite
69
+
obtain ⟨rfl, rfl⟩ := hfn.featuredN_injective h1
70
+
exact hroot_no_support f hsupp
71
+
· simp at hmem_ite
72
+
-- Helper: (origN n, v) ∈ S → (n, v) ∈ R_f
73
+
have orig_in_R : ∀ n v, (hfn.origN n, v) ∈ S → (n, v) ∈ R_f := by
74
+
intro n v h
75
+
have := hres.subset h
76
+
simp only [featureReal, embedSet, embedPkg, Finset.mem_union, Finset.mem_image,
77
+
Finset.mem_biUnion] at this
78
+
rcases this with ⟨⟨n', v'⟩, hR, heq⟩ | ⟨a, _, hmem_ite⟩
79
+
· simp only [Prod.mk.injEq] at heq
80
+
exact hfn.origN.injective heq.1 ▸ heq.2 ▸ hR
81
+
· split at hmem_ite
82
+
· simp only [Finset.mem_singleton, Prod.mk.injEq] at hmem_ite
83
+
exact absurd hmem_ite.1 (hfn.origN_ne_featuredN _ _ _)
84
+
· simp at hmem_ite
85
+
-- Helper: (featuredN n f, v) ∈ S → (origN n, v) ∈ S
86
+
have featured_orig : ∀ n f v, (hfn.featuredN n f, v) ∈ S →
87
+
(hfn.origN n, v) ∈ S := by
88
+
intro n f v h
89
+
have hsub := hres.subset h
90
+
simp only [featureReal, embedSet, embedPkg, Finset.mem_union, Finset.mem_image,
91
+
Finset.mem_biUnion] at hsub
92
+
rcases hsub with ⟨⟨_, _⟩, _, heq⟩ | ⟨⟨⟨n', v'⟩, f'⟩, hsupp, hmem_ite⟩
93
+
· simp only [Prod.mk.injEq] at heq; exact absurd heq.1 (hfn.origN_ne_featuredN _ _ _)
94
+
· split at hmem_ite
95
+
· rename_i hR
96
+
simp only [Finset.mem_singleton, Prod.mk.injEq] at hmem_ite
97
+
obtain ⟨h1, rfl⟩ := hmem_ite
98
+
obtain ⟨rfl, rfl⟩ := hfn.featuredN_injective h1
99
+
have hd : ((hfn.featuredN n f, v), hfn.origN n, ({v} : Finset V)) ∈
100
+
featureDeps R_f support Δ_f Δ_a := by
101
+
simp only [featureDeps, Finset.mem_union, Finset.mem_biUnion]
102
+
left; left; left; left
103
+
exact ⟨⟨(n, v), f⟩, hsupp, by simp [hR]⟩
104
+
obtain ⟨v', hv', hv'S⟩ := hres.dep_closure _ h _ _ hd
105
+
rw [Finset.mem_singleton.mp hv'] at hv'S
106
+
exact hv'S
107
+
· simp at hmem_ite
108
+
refine ⟨?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩
109
+
· -- no_root_support
110
+
exact hroot_no_support
111
+
· -- subset
112
+
intro ⟨pn, pv⟩ fs hmem
113
+
obtain ⟨n, v, horig, heq⟩ := soundnessWitness_elim hmem
114
+
simp only [Prod.mk.injEq] at heq
115
+
obtain ⟨⟨rfl, rfl⟩, _⟩ := heq
116
+
exact orig_in_R pn pv horig
117
+
· -- root_mem
118
+
have hroot_in := mem_soundnessWitness (n := r.1) (v := r.2) hres.root_mem
119
+
convert hroot_in using 1
120
+
simp only [Prod.mk.injEq, Prod.eta, true_and]
121
+
exact (Finset.filter_false_of_mem (fun f _ => hroot_no_feat f)).symm
122
+
· -- feat_dep_closure
123
+
intro ⟨pn, pv⟩ fs_p hmem_p n vs fs hdf
124
+
obtain ⟨_, _, horig, heq₀⟩ := soundnessWitness_elim hmem_p
125
+
simp only [Prod.mk.injEq] at heq₀
126
+
obtain ⟨⟨rfl, rfl⟩, _⟩ := heq₀
127
+
rcases Finset.eq_empty_or_nonempty fs with rfl | ⟨f₀, hf₀⟩
128
+
· -- fs = ∅
129
+
have hd : (embedPkg F (pn, pv), hfn.origN n, vs) ∈
130
+
featureDeps R_f support Δ_f Δ_a := by
131
+
simp only [featureDeps, Finset.mem_union, Finset.mem_image, Finset.mem_filter]
132
+
left; left; left; right
133
+
exact ⟨⟨(pn, pv), n, vs, ∅⟩, ⟨hdf, rfl⟩, rfl⟩
134
+
obtain ⟨v, hv, hvS⟩ := hres.dep_closure _ horig _ _ hd
135
+
exact ⟨v, hv, _, Finset.empty_subset _, mem_soundnessWitness hvS⟩
136
+
· -- fs nonempty
137
+
have hd₀ : (embedPkg F (pn, pv), hfn.featuredN n f₀, vs) ∈
138
+
featureDeps R_f support Δ_f Δ_a := by
139
+
simp only [featureDeps, Finset.mem_union, Finset.mem_biUnion, Finset.mem_filter,
140
+
Finset.mem_image]
141
+
left; left; right
142
+
exact ⟨⟨(pn, pv), n, vs, fs⟩, ⟨hdf, ⟨f₀, hf₀⟩⟩, f₀, hf₀, rfl⟩
143
+
obtain ⟨v, hv, hvS⟩ := hres.dep_closure _ horig _ _ hd₀
144
+
have hvOrig := featured_orig n f₀ v hvS
145
+
refine ⟨v, hv, _, ?_, mem_soundnessWitness hvOrig⟩
146
+
intro f' hf'
147
+
simp only [Finset.mem_filter, Finset.mem_univ, true_and]
148
+
have hd' : (embedPkg F (pn, pv), hfn.featuredN n f', vs) ∈
149
+
featureDeps R_f support Δ_f Δ_a := by
150
+
simp only [featureDeps, Finset.mem_union, Finset.mem_biUnion, Finset.mem_filter,
151
+
Finset.mem_image]
152
+
left; left; right
153
+
exact ⟨⟨(pn, pv), n, vs, fs⟩, ⟨hdf, ⟨f₀, hf₀⟩⟩, f', hf', rfl⟩
154
+
obtain ⟨v', _, hv'S⟩ := hres.dep_closure _ horig _ _ hd'
155
+
rwa [hres.version_unique _ _ _ hvOrig (featured_orig n f' v' hv'S)]
156
+
· -- addl_dep_closure
157
+
intro ⟨pn, pv⟩ fs_p hmem_p f hf n vs fs hda
158
+
obtain ⟨_, _, horig, heq₀⟩ := soundnessWitness_elim hmem_p
159
+
simp only [Prod.mk.injEq] at heq₀
160
+
obtain ⟨⟨rfl, rfl⟩, rfl⟩ := heq₀
161
+
simp only [Finset.mem_filter, Finset.mem_univ, true_and] at hf
162
+
change (hfn.featuredN pn f, pv) ∈ S at hf
163
+
rcases Finset.eq_empty_or_nonempty fs with rfl | ⟨f₀, hf₀⟩
164
+
· -- fs = ∅
165
+
have hd : ((hfn.featuredN pn f, pv), hfn.origN n, vs) ∈
166
+
featureDeps R_f support Δ_f Δ_a := by
167
+
simp only [featureDeps, Finset.mem_union, Finset.mem_image, Finset.mem_filter]
168
+
left; right
169
+
exact ⟨⟨⟨(pn, pv), f⟩, n, vs, ∅⟩, ⟨hda, rfl⟩, rfl⟩
170
+
obtain ⟨v, hv, hvS⟩ := hres.dep_closure _ hf _ _ hd
171
+
exact ⟨v, hv, _, Finset.empty_subset _, mem_soundnessWitness hvS⟩
172
+
· -- fs nonempty
173
+
have hd₀ : ((hfn.featuredN pn f, pv), hfn.featuredN n f₀, vs) ∈
174
+
featureDeps R_f support Δ_f Δ_a := by
175
+
simp only [featureDeps, Finset.mem_union, Finset.mem_biUnion, Finset.mem_filter,
176
+
Finset.mem_image]
177
+
right
178
+
exact ⟨⟨⟨(pn, pv), f⟩, n, vs, fs⟩, ⟨hda, ⟨f₀, hf₀⟩⟩, f₀, hf₀, rfl⟩
179
+
obtain ⟨v, hv, hvS⟩ := hres.dep_closure _ hf _ _ hd₀
180
+
have hvOrig := featured_orig n f₀ v hvS
181
+
refine ⟨v, hv, _, ?_, mem_soundnessWitness hvOrig⟩
182
+
intro f' hf'
183
+
simp only [Finset.mem_filter, Finset.mem_univ, true_and]
184
+
have hd' : ((hfn.featuredN pn f, pv), hfn.featuredN n f', vs) ∈
185
+
featureDeps R_f support Δ_f Δ_a := by
186
+
simp only [featureDeps, Finset.mem_union, Finset.mem_biUnion, Finset.mem_filter,
187
+
Finset.mem_image]
188
+
right
189
+
exact ⟨⟨⟨(pn, pv), f⟩, n, vs, fs⟩, ⟨hda, ⟨f₀, hf₀⟩⟩, f', hf', rfl⟩
190
+
obtain ⟨v', _, hv'S⟩ := hres.dep_closure _ hf _ _ hd'
191
+
rwa [hres.version_unique _ _ _ hvOrig (featured_orig n f' v' hv'S)]
192
+
· -- feature_unification
193
+
intro n v v' fs fs' hmem1 hmem2
194
+
obtain ⟨_, _, horig1, heq1⟩ := soundnessWitness_elim hmem1
195
+
obtain ⟨_, _, horig2, heq2⟩ := soundnessWitness_elim hmem2
196
+
simp only [Prod.mk.injEq] at heq1 heq2
197
+
obtain ⟨⟨rfl, rfl⟩, rfl⟩ := heq1
198
+
obtain ⟨⟨rfl, rfl⟩, rfl⟩ := heq2
199
+
have := hres.version_unique _ _ _ horig1 horig2
200
+
subst this; rfl
201
+
· -- version_unique
202
+
intro n v v' fs fs' hmem₁ hmem₂
203
+
obtain ⟨_, _, horig₁, heq1⟩ := soundnessWitness_elim hmem₁
204
+
obtain ⟨_, _, horig₂, heq2⟩ := soundnessWitness_elim hmem₂
205
+
simp only [Prod.mk.injEq] at heq1 heq2
206
+
obtain ⟨⟨rfl, rfl⟩, _⟩ := heq1
207
+
obtain ⟨⟨h2n, rfl⟩, _⟩ := heq2
208
+
exact hres.version_unique _ _ _ horig₁ (h2n ▸ horig₂)
209
+
· -- support_mem
210
+
intro n v fs f hmem hf
211
+
obtain ⟨_, _, horig, heq⟩ := soundnessWitness_elim hmem
212
+
simp only [Prod.mk.injEq] at heq
213
+
obtain ⟨⟨rfl, rfl⟩, rfl⟩ := heq
214
+
simp only [Finset.mem_filter, Finset.mem_univ, true_and] at hf
215
+
change (hfn.featuredN n f, v) ∈ S at hf
216
+
have hsub := hres.subset hf
217
+
simp only [featureReal, embedSet, embedPkg, Finset.mem_union, Finset.mem_image,
218
+
Finset.mem_biUnion] at hsub
219
+
rcases hsub with ⟨⟨_, _⟩, _, heq'⟩ | ⟨⟨⟨n', v'⟩, f'⟩, hsupp', hmem_ite⟩
220
+
· simp only [Prod.mk.injEq] at heq'; exact absurd heq'.1 (hfn.origN_ne_featuredN _ _ _)
221
+
· split at hmem_ite
222
+
· simp only [Finset.mem_singleton, Prod.mk.injEq] at hmem_ite
223
+
obtain ⟨h1, rfl⟩ := hmem_ite
224
+
obtain ⟨rfl, rfl⟩ := hfn.featuredN_injective h1
225
+
exact hsupp'
226
+
· simp at hmem_ite
227
+
228
+
end PackageCalculus.Feature
+74
PackageCalculus/Extensions/PackageFormula/Definition.lean
+74
PackageCalculus/Extensions/PackageFormula/Definition.lean
···
1
+
import PackageCalculus.Core.Definition
2
+
import PackageCalculus.Extensions.Conflict.Definition
3
+
import Mathlib.Logic.Embedding.Basic
4
+
5
+
/-! # Package-formula extension: definitions
6
+
7
+
Boolean formulae over package-version dependencies, satisfaction by a
8
+
resolution, and the `IsPFResolution` structure. -/
9
+
10
+
namespace PackageCalculus.PkgFormula
11
+
12
+
open Function
13
+
14
+
variable {N : Type*} [DecidableEq N] {V : Type*} [DecidableEq V]
15
+
16
+
/-- Boolean formula over package dependencies. -/
17
+
inductive Formula (N V : Type*) where
18
+
| dep : N → Finset V → Formula N V
19
+
| conj : Formula N V → Formula N V → Formula N V
20
+
| disj : Formula N V → Formula N V → Formula N V
21
+
| neg : Formula N V → Formula N V
22
+
deriving DecidableEq
23
+
24
+
def Formula.satisfies (S : Finset (Package N V)) : Formula N V → Prop
25
+
| .dep n vs => ∃ v ∈ vs, (n, v) ∈ S
26
+
| .conj ψ₁ ψ₂ => ψ₁.satisfies S ∧ ψ₂.satisfies S
27
+
| .disj ψ₁ ψ₂ => ψ₁.satisfies S ∨ ψ₂.satisfies S
28
+
| .neg ψ => ¬ψ.satisfies S
29
+
30
+
/-- Notation: `S ⊨ ψ` means the resolution set `S` satisfies formula `ψ`. -/
31
+
notation:50 S " ⊨ " ψ => Formula.satisfies S ψ
32
+
33
+
/-- Satisfaction is decidable: the formula is a finite Boolean combination of
34
+
bounded existentials over finite sets. -/
35
+
instance Formula.decidableSatisfies (S : Finset (Package N V)) :
36
+
∀ ψ : Formula N V, Decidable (Formula.satisfies S ψ)
37
+
| .dep n vs => inferInstanceAs (Decidable (∃ v ∈ vs, (n, v) ∈ S))
38
+
| .conj ψ₁ ψ₂ =>
39
+
haveI := Formula.decidableSatisfies S ψ₁
40
+
haveI := Formula.decidableSatisfies S ψ₂
41
+
inferInstanceAs (Decidable (Formula.satisfies S ψ₁ ∧ Formula.satisfies S ψ₂))
42
+
| .disj ψ₁ ψ₂ =>
43
+
haveI := Formula.decidableSatisfies S ψ₁
44
+
haveI := Formula.decidableSatisfies S ψ₂
45
+
inferInstanceAs (Decidable (Formula.satisfies S ψ₁ ∨ Formula.satisfies S ψ₂))
46
+
| .neg ψ =>
47
+
haveI := Formula.decidableSatisfies S ψ
48
+
inferInstanceAs (Decidable ¬ Formula.satisfies S ψ)
49
+
50
+
/-- Package-formula dependency relation: (package, formula). -/
51
+
abbrev PFDepRel (N V : Type*) [DecidableEq N] [DecidableEq V] :=
52
+
Finset (Package N V × Formula N V)
53
+
54
+
structure IsPFResolution (R : Real N V) (Δ_Ψ : PFDepRel N V)
55
+
(r : Package N V) (S : Finset (Package N V)) : Prop where
56
+
subset : S ⊆ R
57
+
root_mem : r ∈ S
58
+
formula_closure : ∀ p ∈ S, ∀ ψ : Formula N V,
59
+
(p, ψ) ∈ Δ_Ψ → S ⊨ ψ
60
+
version_unique : VersionUnique S
61
+
62
+
class HasPFNames (N V : Type*) (N' : outParam Type*) extends Conflict.HasConflictNames N V N' where
63
+
/-- Synthetic name for a disjunction witness. -/
64
+
disjunctN : Formula N V → Formula N V → N'
65
+
disjunctN_injective : Injective2 disjunctN
66
+
origN_ne_disjunctN : ∀ n ψ₁ ψ₂, origN n ≠ disjunctN ψ₁ ψ₂
67
+
disjunctN_ne_origN : ∀ ψ₁ ψ₂ n, disjunctN ψ₁ ψ₂ ≠ origN n
68
+
disjunctN_ne_syntheticN : ∀ ψ₁ ψ₂ m vs, disjunctN ψ₁ ψ₂ ≠ syntheticN m vs
69
+
syntheticN_ne_disjunctN : ∀ m vs ψ₁ ψ₂, syntheticN m vs ≠ disjunctN ψ₁ ψ₂
70
+
71
+
attribute [simp] HasPFNames.origN_ne_disjunctN HasPFNames.disjunctN_ne_origN
72
+
HasPFNames.disjunctN_ne_syntheticN HasPFNames.syntheticN_ne_disjunctN
73
+
74
+
end PackageCalculus.PkgFormula
+41
PackageCalculus/Extensions/PackageFormula/Lifting/Completeness.lean
+41
PackageCalculus/Extensions/PackageFormula/Lifting/Completeness.lean
···
1
+
import PackageCalculus.Extensions.PackageFormula.Lifting.Definition
2
+
3
+
namespace PackageCalculus.PkgFormula
4
+
5
+
set_option linter.unusedSectionVars false
6
+
7
+
variable {N : Type*} [DecidableEq N] {V : Type*} [DecidableEq V]
8
+
variable {N' : Type*} [DecidableEq N'] {V' : Type*} [DecidableEq V']
9
+
variable [hpn : HasPFNames N V N'] [hpv : Conflict.HasConflictVersions V V']
10
+
11
+
theorem liftResolution_completenessWitness
12
+
(S_Ψ : Finset (Package N V)) (Δ_Ψ : PFDepRel N V) :
13
+
liftResolution (completenessWitness S_Ψ Δ_Ψ) = S_Ψ := by
14
+
ext p
15
+
simp only [mem_liftResolution, completenessWitness, Finset.mem_union, Finset.mem_image,
16
+
Finset.mem_biUnion, embedPkg]
17
+
constructor
18
+
· intro h
19
+
rcases h with ⟨q, hqS, heq⟩ | ⟨⟨q, ψ⟩, _, hw⟩
20
+
· simp only [Prod.mk.injEq] at heq
21
+
have h1 := hpn.origN.injective heq.1; have h2 := hpv.origV.injective heq.2
22
+
exact (Prod.ext h1 h2 : q = p) ▸ hqS
23
+
· -- hw : (origN p.1, origV p.2) ∈ if q ∈ S_Ψ then witnessSetTaken S_Ψ ψ else witnessSetUntaken S_Ψ ψ
24
+
split at hw
25
+
· exact absurd hw (witnessSetTaken_not_orig S_Ψ ψ p.1 _)
26
+
· exact absurd hw (witnessSetUntaken_not_orig S_Ψ ψ p.1 _)
27
+
· intro hp
28
+
exact Or.inl ⟨p, hp, rfl⟩
29
+
30
+
theorem liftResolution_completeness
31
+
(R_Ψ : Real N V) (Δ_Ψ : PFDepRel N V)
32
+
(r : Package N V) (S_Ψ : Finset (Package N V))
33
+
(hres : IsPFResolution R_Ψ Δ_Ψ r S_Ψ) :
34
+
∃ S', IsResolution (pfReal R_Ψ Δ_Ψ) (pfDeps Δ_Ψ) (embedPkg r) S' ∧
35
+
liftResolution S' = S_Ψ :=
36
+
⟨completenessWitness S_Ψ Δ_Ψ,
37
+
pkgFormula_completeness R_Ψ Δ_Ψ r S_Ψ hres,
38
+
liftResolution_completenessWitness S_Ψ Δ_Ψ⟩
39
+
40
+
41
+
end PackageCalculus.PkgFormula
+96
PackageCalculus/Extensions/PackageFormula/Lifting/Definition.lean
+96
PackageCalculus/Extensions/PackageFormula/Lifting/Definition.lean
···
1
+
import PackageCalculus.Extensions.PackageFormula.Reduction.Completeness
2
+
import PackageCalculus.Extensions.PackageFormula.Reduction.Soundness
3
+
4
+
namespace PackageCalculus.PkgFormula
5
+
6
+
set_option linter.unusedSectionVars false
7
+
8
+
variable {N : Type*} [DecidableEq N] {V : Type*} [DecidableEq V]
9
+
variable {N' : Type*} [DecidableEq N'] {V' : Type*} [DecidableEq V']
10
+
variable [hpn : HasPFNames N V N'] [hpv : Conflict.HasConflictVersions V V']
11
+
12
+
def embedPkgFn : Package N V → Package N' V' :=
13
+
fun p => (hpn.origN p.1, hpv.origV p.2)
14
+
15
+
omit [DecidableEq N] [DecidableEq V] [DecidableEq N'] [DecidableEq V'] in
16
+
theorem embedPkgFn_eq_embedPkg : (embedPkgFn : Package N V → Package N' V') = embedPkg :=
17
+
rfl
18
+
19
+
omit [DecidableEq N] [DecidableEq V] [DecidableEq N'] [DecidableEq V'] in
20
+
theorem embedPkgFn_injective :
21
+
Function.Injective (embedPkgFn : Package N V → Package N' V') := by
22
+
intro ⟨n₁, v₁⟩ ⟨n₂, v₂⟩ h
23
+
simp only [embedPkgFn, Prod.mk.injEq] at h
24
+
exact Prod.ext (hpn.origN.injective h.1) (hpv.origV.injective h.2)
25
+
26
+
def tryInvPkg (p : Package N' V') : Option (Package N V) :=
27
+
match hpn.tryOrigN p.1, hpv.tryOrigV p.2 with
28
+
| some n, some v => some (n, v)
29
+
| _, _ => none
30
+
31
+
omit [DecidableEq N] [DecidableEq V] [DecidableEq N'] [DecidableEq V'] in
32
+
private theorem tryInvPkg_inj :
33
+
∀ a a' (b : Package N V), b ∈ tryInvPkg a → b ∈ tryInvPkg a' → a = a' := by
34
+
intro a a' ⟨n, v⟩ h1 h2
35
+
simp only [tryInvPkg, Option.mem_def] at h1 h2
36
+
revert h1 h2
37
+
cases hn1 : hpn.tryOrigN a.1 <;> cases hv1 : hpv.tryOrigV a.2 <;> simp (config := { decide := false })
38
+
intro rfl rfl
39
+
cases hn2 : hpn.tryOrigN a'.1 <;> cases hv2 : hpv.tryOrigV a'.2 <;> simp (config := { decide := false })
40
+
intro rfl rfl
41
+
exact Prod.ext
42
+
((hpn.tryOrigN_some _ _ hn1).symm.trans (hpn.tryOrigN_some _ _ hn2))
43
+
((hpv.tryOrigV_some _ _ hv1).symm.trans (hpv.tryOrigV_some _ _ hv2))
44
+
45
+
omit [DecidableEq N] [DecidableEq V] [DecidableEq N'] [DecidableEq V'] in
46
+
theorem tryInvPkg_embed (p : Package N V) :
47
+
tryInvPkg (embedPkgFn p) = some p := by
48
+
simp [tryInvPkg, embedPkgFn, hpn.tryOrigN_origN, hpv.tryOrigV_origV]
49
+
50
+
omit [DecidableEq N] [DecidableEq V] [DecidableEq N'] [DecidableEq V'] in
51
+
theorem tryInvPkg_some {p' : Package N' V'} {p : Package N V}
52
+
(h : p ∈ tryInvPkg p') : embedPkgFn p = p' := by
53
+
obtain ⟨n', v'⟩ := p'; obtain ⟨n, v⟩ := p
54
+
simp only [tryInvPkg, Option.mem_def, embedPkgFn] at h ⊢
55
+
generalize htn : hpn.tryOrigN n' = on at h
56
+
generalize htv : hpv.tryOrigV v' = ov at h
57
+
match on, ov with
58
+
| some n₀, some v₀ =>
59
+
simp at h; obtain ⟨rfl, rfl⟩ := h
60
+
show (hpn.origN n₀, hpv.origV v₀) = (n', v')
61
+
rw [hpn.tryOrigN_some _ _ htn, hpv.tryOrigV_some _ _ htv]
62
+
| some _, none => simp at h
63
+
| none, _ => simp at h
64
+
65
+
/-! ## Lift functions -/
66
+
67
+
def liftReal (R' : Real N' V') : Real N V :=
68
+
R'.filterMap tryInvPkg tryInvPkg_inj
69
+
70
+
def liftResolution (S' : Finset (Package N' V')) : Finset (Package N V) :=
71
+
S'.filterMap tryInvPkg tryInvPkg_inj
72
+
73
+
/-! ## Membership lemmas -/
74
+
75
+
omit [DecidableEq N] [DecidableEq V] [DecidableEq N'] [DecidableEq V'] in
76
+
theorem mem_liftReal {R' : Real N' V'} {p : Package N V} :
77
+
p ∈ liftReal R' ↔ embedPkg p ∈ R' := by
78
+
simp only [liftReal, Finset.mem_filterMap]
79
+
constructor
80
+
· rintro ⟨p', hp', hinv⟩
81
+
have heq := tryInvPkg_some hinv; rw [embedPkgFn_eq_embedPkg] at heq; rwa [heq]
82
+
· intro hp
83
+
exact ⟨embedPkg p, hp, by show p ∈ tryInvPkg (embedPkgFn p); rw [tryInvPkg_embed]; rfl⟩
84
+
85
+
omit [DecidableEq N] [DecidableEq V] [DecidableEq N'] [DecidableEq V'] in
86
+
theorem mem_liftResolution {S' : Finset (Package N' V')} {p : Package N V} :
87
+
p ∈ liftResolution S' ↔ embedPkg p ∈ S' := by
88
+
simp only [liftResolution, Finset.mem_filterMap]
89
+
constructor
90
+
· rintro ⟨p', hp', hinv⟩
91
+
have heq := tryInvPkg_some hinv; rw [embedPkgFn_eq_embedPkg] at heq; rwa [heq]
92
+
· intro hp
93
+
exact ⟨embedPkg p, hp, by show p ∈ tryInvPkg (embedPkgFn p); rw [tryInvPkg_embed]; rfl⟩
94
+
95
+
96
+
end PackageCalculus.PkgFormula
+30
PackageCalculus/Extensions/PackageFormula/Lifting/Retraction.lean
+30
PackageCalculus/Extensions/PackageFormula/Lifting/Retraction.lean
···
1
+
import PackageCalculus.Extensions.PackageFormula.Lifting.Definition
2
+
3
+
namespace PackageCalculus.PkgFormula
4
+
5
+
set_option linter.unusedSectionVars false
6
+
7
+
variable {N : Type*} [DecidableEq N] {V : Type*} [DecidableEq V]
8
+
variable {N' : Type*} [DecidableEq N'] {V' : Type*} [DecidableEq V']
9
+
variable [hpn : HasPFNames N V N'] [hpv : Conflict.HasConflictVersions V V']
10
+
11
+
/-! ## Round-trip theorems -/
12
+
13
+
theorem liftReal_pfReal (R : Real N V) (Δ_Ψ : PFDepRel N V) :
14
+
liftReal (pfReal R Δ_Ψ) = R := by
15
+
ext p
16
+
simp only [mem_liftReal, pfReal, Finset.mem_union, Finset.mem_image,
17
+
Finset.mem_biUnion]
18
+
constructor
19
+
· intro h
20
+
rcases h with ⟨q, hqR, heq⟩ | ⟨a, haΔ, hmem⟩
21
+
· simp only [embedPkg, Prod.mk.injEq] at heq
22
+
have h1 := hpn.origN.injective heq.1; have h2 := hpv.origV.injective heq.2
23
+
exact (Prod.ext h1 h2 : q = p) ▸ hqR
24
+
· exfalso
25
+
exact witnessPackages_not_orig (embedPkg a.1) a.2 p.1 (hpv.origV p.2) hmem
26
+
· intro hp
27
+
exact Or.inl ⟨p, hp, rfl⟩
28
+
29
+
30
+
end PackageCalculus.PkgFormula
+34
PackageCalculus/Extensions/PackageFormula/Lifting/Soundness.lean
+34
PackageCalculus/Extensions/PackageFormula/Lifting/Soundness.lean
···
1
+
import PackageCalculus.Extensions.PackageFormula.Lifting.Definition
2
+
3
+
namespace PackageCalculus.PkgFormula
4
+
5
+
set_option linter.unusedSectionVars false
6
+
7
+
variable {N : Type*} [DecidableEq N] {V : Type*} [DecidableEq V]
8
+
variable {N' : Type*} [DecidableEq N'] {V' : Type*} [DecidableEq V']
9
+
variable [hpn : HasPFNames N V N'] [hpv : Conflict.HasConflictVersions V V']
10
+
11
+
/-! ## Lifting soundness & completeness -/
12
+
13
+
theorem liftResolution_soundness
14
+
(R_Ψ : Real N V) (Δ_Ψ : PFDepRel N V)
15
+
(r : Package N V) (S' : Finset (Package N' V'))
16
+
(hres : IsResolution (pfReal R_Ψ Δ_Ψ) (pfDeps Δ_Ψ) (embedPkg r) S') :
17
+
IsPFResolution R_Ψ Δ_Ψ r (liftResolution S') := by
18
+
have h := pkgFormula_soundness R_Ψ Δ_Ψ r S' hres
19
+
suffices heq : liftResolution S' = S'.preimage embedPkg
20
+
(Set.InjOn.mono (Set.subset_univ _)
21
+
(Function.Injective.injOn embedPkgFn_injective)) by
22
+
rw [heq]; exact h
23
+
ext p; simp only [liftResolution, Finset.mem_filterMap, Finset.mem_preimage]
24
+
constructor
25
+
· rintro ⟨p', hp', hinv⟩
26
+
have heq := tryInvPkg_some hinv
27
+
rw [embedPkgFn_eq_embedPkg] at heq; rwa [heq]
28
+
· intro hp
29
+
exact ⟨embedPkg p, hp, by
30
+
show p ∈ tryInvPkg (embedPkgFn p)
31
+
rw [tryInvPkg_embed]; rfl⟩
32
+
33
+
34
+
end PackageCalculus.PkgFormula
+1234
PackageCalculus/Extensions/PackageFormula/Reduction/Completeness.lean
+1234
PackageCalculus/Extensions/PackageFormula/Reduction/Completeness.lean
···
1
+
import PackageCalculus.Extensions.PackageFormula.Reduction.Definition
2
+
3
+
namespace PackageCalculus.PkgFormula
4
+
5
+
open Classical
6
+
7
+
variable {N : Type*} {V : Type*} {N' : Type*} {V' : Type*}
8
+
variable [DecidableEq N'] [DecidableEq V']
9
+
variable [hpn : HasPFNames N V N'] [hpv : Conflict.HasConflictVersions V V']
10
+
11
+
/-! ## Dual-context witness construction (paper's W^⊤ / W^⊥)
12
+
13
+
We define two functions:
14
+
15
+
* `witnessSetTaken S_Ψ ψ` -- witnesses for `ψ` on a *taken* path (the wrapper
16
+
depender for the formula containing this subterm is in `S_Ψ`).
17
+
18
+
* `witnessSetUntaken S_Ψ ψ` -- witnesses for `ψ` on an *untaken* path (the
19
+
wrapper depender is absent, so the wrapper-issued edges do not fire; but the
20
+
*negation* edges fire from the original package `(n, u)` if `(n, u) ∈ S_Ψ`).
21
+
22
+
They are not mutually recursive -- `witnessSetTaken` calls `witnessSetUntaken`
23
+
in the disjunction case but not vice versa, so each is defined separately by
24
+
well-founded recursion on `Formula.weight`. -/
25
+
26
+
def witnessSetUntaken [DecidableEq N] [DecidableEq V]
27
+
(S_Ψ : Finset (Package N V)) :
28
+
Formula N V → Finset (Package N' V')
29
+
| .dep _ _ => ∅
30
+
| .conj ψ_L ψ_R => witnessSetUntaken S_Ψ ψ_L ∪ witnessSetUntaken S_Ψ ψ_R
31
+
| .disj ψ_L ψ_R => witnessSetUntaken S_Ψ ψ_L ∪ witnessSetUntaken S_Ψ ψ_R
32
+
| .neg (.dep n vs) =>
33
+
if ∃ u ∈ vs, ((n, u) : Package N V) ∈ S_Ψ
34
+
then {(hpn.syntheticN n vs, hpv.zeroV)}
35
+
else ∅
36
+
| .neg (.conj ψ_L ψ_R) =>
37
+
witnessSetUntaken S_Ψ (.disj (.neg ψ_L) (.neg ψ_R))
38
+
| .neg (.disj ψ_L ψ_R) =>
39
+
witnessSetUntaken S_Ψ (.conj (.neg ψ_L) (.neg ψ_R))
40
+
| .neg (.neg ψ) =>
41
+
witnessSetUntaken S_Ψ ψ
42
+
termination_by ψ => ψ.weight
43
+
decreasing_by all_goals simp only [Formula.weight]; omega
44
+
45
+
def witnessSetTaken [DecidableEq N] [DecidableEq V]
46
+
(S_Ψ : Finset (Package N V)) :
47
+
Formula N V → Finset (Package N' V')
48
+
| .dep _ _ => ∅
49
+
| .conj ψ_L ψ_R => witnessSetTaken S_Ψ ψ_L ∪ witnessSetTaken S_Ψ ψ_R
50
+
| .disj ψ_L ψ_R =>
51
+
if S_Ψ ⊨ ψ_L then
52
+
{(hpn.disjunctN ψ_L ψ_R, hpv.zeroV)} ∪
53
+
witnessSetTaken S_Ψ ψ_L ∪ witnessSetUntaken S_Ψ ψ_R
54
+
else
55
+
{(hpn.disjunctN ψ_L ψ_R, hpv.oneV)} ∪
56
+
witnessSetUntaken S_Ψ ψ_L ∪ witnessSetTaken S_Ψ ψ_R
57
+
| .neg (.dep n vs) => {(hpn.syntheticN n vs, hpv.oneV)}
58
+
| .neg (.conj ψ_L ψ_R) =>
59
+
witnessSetTaken S_Ψ (.disj (.neg ψ_L) (.neg ψ_R))
60
+
| .neg (.disj ψ_L ψ_R) =>
61
+
witnessSetTaken S_Ψ (.conj (.neg ψ_L) (.neg ψ_R))
62
+
| .neg (.neg ψ) =>
63
+
witnessSetTaken S_Ψ ψ
64
+
termination_by ψ => ψ.weight
65
+
decreasing_by all_goals simp only [Formula.weight]; omega
66
+
67
+
def completenessWitness [DecidableEq N] [DecidableEq V]
68
+
(S_Ψ : Finset (Package N V)) (Δ_Ψ : PFDepRel N V) :
69
+
Finset (Package N' V') :=
70
+
S_Ψ.image embedPkg ∪
71
+
Δ_Ψ.biUnion (fun ⟨p, ψ⟩ =>
72
+
if p ∈ S_Ψ then witnessSetTaken S_Ψ ψ else witnessSetUntaken S_Ψ ψ)
73
+
74
+
/-! ## Equational lemmas (auto-unfolds for `simp`) -/
75
+
76
+
section UnfoldEqs
77
+
variable [DecidableEq N] [DecidableEq V] (S_Ψ : Finset (Package N V))
78
+
79
+
@[simp] lemma witnessSetTaken_dep (n : N) (vs : Finset V) :
80
+
witnessSetTaken S_Ψ (.dep n vs) = (∅ : Finset (Package N' V')) :=
81
+
witnessSetTaken.eq_1 S_Ψ n vs
82
+
83
+
@[simp] lemma witnessSetTaken_conj (ψ_L ψ_R : Formula N V) :
84
+
(witnessSetTaken S_Ψ (.conj ψ_L ψ_R) : Finset (Package N' V')) =
85
+
witnessSetTaken S_Ψ ψ_L ∪ witnessSetTaken S_Ψ ψ_R :=
86
+
witnessSetTaken.eq_2 S_Ψ ψ_L ψ_R
87
+
88
+
@[simp] lemma witnessSetTaken_disj (ψ_L ψ_R : Formula N V) :
89
+
(witnessSetTaken S_Ψ (.disj ψ_L ψ_R) : Finset (Package N' V')) =
90
+
if S_Ψ ⊨ ψ_L then
91
+
{(hpn.disjunctN ψ_L ψ_R, hpv.zeroV)} ∪
92
+
witnessSetTaken S_Ψ ψ_L ∪ witnessSetUntaken S_Ψ ψ_R
93
+
else
94
+
{(hpn.disjunctN ψ_L ψ_R, hpv.oneV)} ∪
95
+
witnessSetUntaken S_Ψ ψ_L ∪ witnessSetTaken S_Ψ ψ_R :=
96
+
witnessSetTaken.eq_3 S_Ψ ψ_L ψ_R
97
+
98
+
@[simp] lemma witnessSetTaken_neg_dep (n : N) (vs : Finset V) :
99
+
(witnessSetTaken S_Ψ (.neg (.dep n vs)) : Finset (Package N' V')) =
100
+
{(hpn.syntheticN n vs, hpv.oneV)} :=
101
+
witnessSetTaken.eq_4 S_Ψ n vs
102
+
103
+
lemma witnessSetTaken_neg_conj (ψ_L ψ_R : Formula N V) :
104
+
(witnessSetTaken S_Ψ (.neg (.conj ψ_L ψ_R)) : Finset (Package N' V')) =
105
+
witnessSetTaken S_Ψ (.disj (.neg ψ_L) (.neg ψ_R)) :=
106
+
witnessSetTaken.eq_5 S_Ψ ψ_L ψ_R
107
+
108
+
lemma witnessSetTaken_neg_disj (ψ_L ψ_R : Formula N V) :
109
+
(witnessSetTaken S_Ψ (.neg (.disj ψ_L ψ_R)) : Finset (Package N' V')) =
110
+
witnessSetTaken S_Ψ (.conj (.neg ψ_L) (.neg ψ_R)) :=
111
+
witnessSetTaken.eq_6 S_Ψ ψ_L ψ_R
112
+
113
+
lemma witnessSetTaken_neg_neg (ψ : Formula N V) :
114
+
(witnessSetTaken S_Ψ (.neg (.neg ψ)) : Finset (Package N' V')) =
115
+
witnessSetTaken S_Ψ ψ :=
116
+
witnessSetTaken.eq_7 S_Ψ ψ
117
+
118
+
@[simp] lemma witnessSetUntaken_dep (n : N) (vs : Finset V) :
119
+
witnessSetUntaken S_Ψ (.dep n vs) = (∅ : Finset (Package N' V')) :=
120
+
witnessSetUntaken.eq_1 S_Ψ n vs
121
+
122
+
@[simp] lemma witnessSetUntaken_conj (ψ_L ψ_R : Formula N V) :
123
+
(witnessSetUntaken S_Ψ (.conj ψ_L ψ_R) : Finset (Package N' V')) =
124
+
witnessSetUntaken S_Ψ ψ_L ∪ witnessSetUntaken S_Ψ ψ_R :=
125
+
witnessSetUntaken.eq_2 S_Ψ ψ_L ψ_R
126
+
127
+
@[simp] lemma witnessSetUntaken_disj (ψ_L ψ_R : Formula N V) :
128
+
(witnessSetUntaken S_Ψ (.disj ψ_L ψ_R) : Finset (Package N' V')) =
129
+
witnessSetUntaken S_Ψ ψ_L ∪ witnessSetUntaken S_Ψ ψ_R :=
130
+
witnessSetUntaken.eq_3 S_Ψ ψ_L ψ_R
131
+
132
+
@[simp] lemma witnessSetUntaken_neg_dep (n : N) (vs : Finset V) :
133
+
(witnessSetUntaken S_Ψ (.neg (.dep n vs)) : Finset (Package N' V')) =
134
+
if ∃ u ∈ vs, ((n, u) : Package N V) ∈ S_Ψ
135
+
then {(hpn.syntheticN n vs, hpv.zeroV)}
136
+
else ∅ :=
137
+
witnessSetUntaken.eq_4 S_Ψ n vs
138
+
139
+
lemma witnessSetUntaken_neg_conj (ψ_L ψ_R : Formula N V) :
140
+
(witnessSetUntaken S_Ψ (.neg (.conj ψ_L ψ_R)) : Finset (Package N' V')) =
141
+
witnessSetUntaken S_Ψ (.disj (.neg ψ_L) (.neg ψ_R)) :=
142
+
witnessSetUntaken.eq_5 S_Ψ ψ_L ψ_R
143
+
144
+
lemma witnessSetUntaken_neg_disj (ψ_L ψ_R : Formula N V) :
145
+
(witnessSetUntaken S_Ψ (.neg (.disj ψ_L ψ_R)) : Finset (Package N' V')) =
146
+
witnessSetUntaken S_Ψ (.conj (.neg ψ_L) (.neg ψ_R)) :=
147
+
witnessSetUntaken.eq_6 S_Ψ ψ_L ψ_R
148
+
149
+
lemma witnessSetUntaken_neg_neg (ψ : Formula N V) :
150
+
(witnessSetUntaken S_Ψ (.neg (.neg ψ)) : Finset (Package N' V')) =
151
+
witnessSetUntaken S_Ψ ψ :=
152
+
witnessSetUntaken.eq_7 S_Ψ ψ
153
+
154
+
end UnfoldEqs
155
+
156
+
/-! ## No original-name witnesses -/
157
+
158
+
lemma witnessSetUntaken_not_orig [DecidableEq N] [DecidableEq V]
159
+
(S_Ψ : Finset (Package N V))
160
+
(ψ : Formula N V) (n : N) (v : V') :
161
+
(hpn.origN n, v) ∉ witnessSetUntaken S_Ψ ψ := by
162
+
match ψ with
163
+
| .dep _ _ => simp
164
+
| .conj ψ_L ψ_R =>
165
+
simp only [witnessSetUntaken_conj, Finset.mem_union, not_or]
166
+
exact ⟨witnessSetUntaken_not_orig S_Ψ ψ_L n v,
167
+
witnessSetUntaken_not_orig S_Ψ ψ_R n v⟩
168
+
| .disj ψ_L ψ_R =>
169
+
simp only [witnessSetUntaken_disj, Finset.mem_union, not_or]
170
+
exact ⟨witnessSetUntaken_not_orig S_Ψ ψ_L n v,
171
+
witnessSetUntaken_not_orig S_Ψ ψ_R n v⟩
172
+
| .neg (.dep _ _) =>
173
+
simp only [witnessSetUntaken_neg_dep]
174
+
split
175
+
· simp only [Finset.mem_singleton, Prod.mk.injEq, not_and]
176
+
intro h; exact absurd h (hpn.origN_ne_syntheticN _ _ _)
177
+
· simp
178
+
| .neg (.conj ψ_L ψ_R) =>
179
+
rw [witnessSetUntaken_neg_conj]
180
+
exact witnessSetUntaken_not_orig S_Ψ (.disj (.neg ψ_L) (.neg ψ_R)) n v
181
+
| .neg (.disj ψ_L ψ_R) =>
182
+
rw [witnessSetUntaken_neg_disj]
183
+
exact witnessSetUntaken_not_orig S_Ψ (.conj (.neg ψ_L) (.neg ψ_R)) n v
184
+
| .neg (.neg ψ') =>
185
+
rw [witnessSetUntaken_neg_neg]
186
+
exact witnessSetUntaken_not_orig S_Ψ ψ' n v
187
+
termination_by ψ.weight
188
+
decreasing_by all_goals simp only [Formula.weight]; omega
189
+
190
+
lemma witnessSetTaken_not_orig [DecidableEq N] [DecidableEq V]
191
+
(S_Ψ : Finset (Package N V))
192
+
(ψ : Formula N V) (n : N) (v : V') :
193
+
(hpn.origN n, v) ∉ witnessSetTaken S_Ψ ψ := by
194
+
match ψ with
195
+
| .dep _ _ => simp
196
+
| .conj ψ_L ψ_R =>
197
+
simp only [witnessSetTaken_conj, Finset.mem_union, not_or]
198
+
exact ⟨witnessSetTaken_not_orig S_Ψ ψ_L n v,
199
+
witnessSetTaken_not_orig S_Ψ ψ_R n v⟩
200
+
| .disj ψ_L ψ_R =>
201
+
simp only [witnessSetTaken_disj]
202
+
split
203
+
· simp only [Finset.mem_union, Finset.mem_singleton, not_or]
204
+
refine ⟨⟨?_, ?_⟩, ?_⟩
205
+
· intro hsing
206
+
have := (Prod.mk.injEq _ _ _ _).mp hsing
207
+
exact absurd this.1 (hpn.origN_ne_disjunctN _ _ _)
208
+
· exact witnessSetTaken_not_orig S_Ψ ψ_L n v
209
+
· exact witnessSetUntaken_not_orig S_Ψ ψ_R n v
210
+
· simp only [Finset.mem_union, Finset.mem_singleton, not_or]
211
+
refine ⟨⟨?_, ?_⟩, ?_⟩
212
+
· intro hsing
213
+
have := (Prod.mk.injEq _ _ _ _).mp hsing
214
+
exact absurd this.1 (hpn.origN_ne_disjunctN _ _ _)
215
+
· exact witnessSetUntaken_not_orig S_Ψ ψ_L n v
216
+
· exact witnessSetTaken_not_orig S_Ψ ψ_R n v
217
+
| .neg (.dep _ _) =>
218
+
simp only [witnessSetTaken_neg_dep, Finset.mem_singleton, Prod.mk.injEq, not_and]
219
+
intro h; exact absurd h (hpn.origN_ne_syntheticN _ _ _)
220
+
| .neg (.conj ψ_L ψ_R) =>
221
+
rw [witnessSetTaken_neg_conj]
222
+
exact witnessSetTaken_not_orig S_Ψ (.disj (.neg ψ_L) (.neg ψ_R)) n v
223
+
| .neg (.disj ψ_L ψ_R) =>
224
+
rw [witnessSetTaken_neg_disj]
225
+
exact witnessSetTaken_not_orig S_Ψ (.conj (.neg ψ_L) (.neg ψ_R)) n v
226
+
| .neg (.neg ψ') =>
227
+
rw [witnessSetTaken_neg_neg]
228
+
exact witnessSetTaken_not_orig S_Ψ ψ' n v
229
+
termination_by ψ.weight
230
+
decreasing_by all_goals simp only [Formula.weight]; omega
231
+
232
+
/-! ## Version determinism (untaken side: always zeroV)
233
+
234
+
The untaken side has a clean determinism: any synthetic-N witness has version
235
+
zeroV. Disjunct names never appear at all. -/
236
+
237
+
lemma witnessSetUntaken_negDep_det [DecidableEq N] [DecidableEq V]
238
+
(S_Ψ : Finset (Package N V))
239
+
(ψ : Formula N V) (n : N) (vs : Finset V) (v : V')
240
+
(h : (hpn.syntheticN n vs, v) ∈ witnessSetUntaken S_Ψ ψ) :
241
+
v = hpv.zeroV := by
242
+
match ψ with
243
+
| .dep _ _ => simp at h
244
+
| .conj ψ_L ψ_R =>
245
+
simp only [witnessSetUntaken_conj, Finset.mem_union] at h
246
+
exact h.elim
247
+
(witnessSetUntaken_negDep_det S_Ψ ψ_L n vs v)
248
+
(witnessSetUntaken_negDep_det S_Ψ ψ_R n vs v)
249
+
| .disj ψ_L ψ_R =>
250
+
simp only [witnessSetUntaken_disj, Finset.mem_union] at h
251
+
exact h.elim
252
+
(witnessSetUntaken_negDep_det S_Ψ ψ_L n vs v)
253
+
(witnessSetUntaken_negDep_det S_Ψ ψ_R n vs v)
254
+
| .neg (.dep n' vs') =>
255
+
simp only [witnessSetUntaken_neg_dep] at h
256
+
split at h
257
+
· simp only [Finset.mem_singleton, Prod.mk.injEq] at h
258
+
exact h.2
259
+
· simp at h
260
+
| .neg (.conj ψ_L ψ_R) =>
261
+
rw [witnessSetUntaken_neg_conj] at h
262
+
exact witnessSetUntaken_negDep_det S_Ψ (.disj (.neg ψ_L) (.neg ψ_R)) n vs v h
263
+
| .neg (.disj ψ_L ψ_R) =>
264
+
rw [witnessSetUntaken_neg_disj] at h
265
+
exact witnessSetUntaken_negDep_det S_Ψ (.conj (.neg ψ_L) (.neg ψ_R)) n vs v h
266
+
| .neg (.neg ψ') =>
267
+
rw [witnessSetUntaken_neg_neg] at h
268
+
exact witnessSetUntaken_negDep_det S_Ψ ψ' n vs v h
269
+
termination_by ψ.weight
270
+
decreasing_by all_goals simp only [Formula.weight]; omega
271
+
272
+
lemma witnessSetUntaken_disjunct_det [DecidableEq N] [DecidableEq V]
273
+
(S_Ψ : Finset (Package N V))
274
+
(ψ : Formula N V) (ψ_L ψ_R : Formula N V) (v : V')
275
+
(h : (hpn.disjunctN ψ_L ψ_R, v) ∈ witnessSetUntaken S_Ψ ψ) : False := by
276
+
match ψ with
277
+
| .dep _ _ => simp at h
278
+
| .conj ψ_a ψ_b =>
279
+
simp only [witnessSetUntaken_conj, Finset.mem_union] at h
280
+
exact h.elim
281
+
(witnessSetUntaken_disjunct_det S_Ψ ψ_a ψ_L ψ_R v)
282
+
(witnessSetUntaken_disjunct_det S_Ψ ψ_b ψ_L ψ_R v)
283
+
| .disj ψ_a ψ_b =>
284
+
simp only [witnessSetUntaken_disj, Finset.mem_union] at h
285
+
exact h.elim
286
+
(witnessSetUntaken_disjunct_det S_Ψ ψ_a ψ_L ψ_R v)
287
+
(witnessSetUntaken_disjunct_det S_Ψ ψ_b ψ_L ψ_R v)
288
+
| .neg (.dep _ _) =>
289
+
simp only [witnessSetUntaken_neg_dep] at h
290
+
split at h
291
+
· simp only [Finset.mem_singleton, Prod.mk.injEq] at h
292
+
exact absurd h.1 (hpn.disjunctN_ne_syntheticN _ _ _ _)
293
+
· simp at h
294
+
| .neg (.conj ψ_a ψ_b) =>
295
+
rw [witnessSetUntaken_neg_conj] at h
296
+
exact witnessSetUntaken_disjunct_det S_Ψ (.disj (.neg ψ_a) (.neg ψ_b)) ψ_L ψ_R v h
297
+
| .neg (.disj ψ_a ψ_b) =>
298
+
rw [witnessSetUntaken_neg_disj] at h
299
+
exact witnessSetUntaken_disjunct_det S_Ψ (.conj (.neg ψ_a) (.neg ψ_b)) ψ_L ψ_R v h
300
+
| .neg (.neg ψ') =>
301
+
rw [witnessSetUntaken_neg_neg] at h
302
+
exact witnessSetUntaken_disjunct_det S_Ψ ψ' ψ_L ψ_R v h
303
+
termination_by ψ.weight
304
+
decreasing_by all_goals simp only [Formula.weight]; omega
305
+
306
+
/-! ## Disjunct version determinism (taken side)
307
+
308
+
For the disjunct names, taken-side version is determined by satisfaction of
309
+
the left disjunct -- and untaken never produces disjunct names, so this is
310
+
unconditional. -/
311
+
312
+
lemma witnessSetTaken_disjunct_det [DecidableEq N] [DecidableEq V]
313
+
(S_Ψ : Finset (Package N V))
314
+
(ψ : Formula N V) (ψ_L ψ_R : Formula N V) (v : V')
315
+
(h : (hpn.disjunctN ψ_L ψ_R, v) ∈ witnessSetTaken S_Ψ ψ) :
316
+
v = if S_Ψ ⊨ ψ_L then hpv.zeroV else hpv.oneV := by
317
+
match ψ with
318
+
| .dep _ _ => simp at h
319
+
| .conj ψ_a ψ_b =>
320
+
simp only [witnessSetTaken_conj, Finset.mem_union] at h
321
+
exact h.elim
322
+
(witnessSetTaken_disjunct_det S_Ψ ψ_a ψ_L ψ_R v)
323
+
(witnessSetTaken_disjunct_det S_Ψ ψ_b ψ_L ψ_R v)
324
+
| .disj ψ_a ψ_b =>
325
+
simp only [witnessSetTaken_disj] at h
326
+
split at h
327
+
· rename_i hψa_sat
328
+
simp only [Finset.mem_union, Finset.mem_singleton] at h
329
+
rcases h with (hsing | hL) | hU
330
+
· have heq := (Prod.mk.injEq _ _ _ _).mp hsing
331
+
obtain ⟨rfl, rfl⟩ := hpn.disjunctN_injective heq.1
332
+
simp [hψa_sat, heq.2]
333
+
· exact witnessSetTaken_disjunct_det S_Ψ ψ_a ψ_L ψ_R v hL
334
+
· exact (witnessSetUntaken_disjunct_det S_Ψ ψ_b ψ_L ψ_R v hU).elim
335
+
· rename_i hψa_unsat
336
+
simp only [Finset.mem_union, Finset.mem_singleton] at h
337
+
rcases h with (hsing | hU) | hR
338
+
· have heq := (Prod.mk.injEq _ _ _ _).mp hsing
339
+
obtain ⟨rfl, rfl⟩ := hpn.disjunctN_injective heq.1
340
+
simp [hψa_unsat, heq.2]
341
+
· exact (witnessSetUntaken_disjunct_det S_Ψ ψ_a ψ_L ψ_R v hU).elim
342
+
· exact witnessSetTaken_disjunct_det S_Ψ ψ_b ψ_L ψ_R v hR
343
+
| .neg (.dep _ _) =>
344
+
simp only [witnessSetTaken_neg_dep, Finset.mem_singleton, Prod.mk.injEq] at h
345
+
exact absurd h.1 (hpn.disjunctN_ne_syntheticN _ _ _ _)
346
+
| .neg (.conj ψ_a ψ_b) =>
347
+
rw [witnessSetTaken_neg_conj] at h
348
+
exact witnessSetTaken_disjunct_det S_Ψ (.disj (.neg ψ_a) (.neg ψ_b)) ψ_L ψ_R v h
349
+
| .neg (.disj ψ_a ψ_b) =>
350
+
rw [witnessSetTaken_neg_disj] at h
351
+
exact witnessSetTaken_disjunct_det S_Ψ (.conj (.neg ψ_a) (.neg ψ_b)) ψ_L ψ_R v h
352
+
| .neg (.neg ψ') =>
353
+
rw [witnessSetTaken_neg_neg] at h
354
+
exact witnessSetTaken_disjunct_det S_Ψ ψ' ψ_L ψ_R v h
355
+
termination_by ψ.weight
356
+
decreasing_by all_goals simp only [Formula.weight]; omega
357
+
358
+
/-! ## Subset of `witnessPackages` -/
359
+
360
+
lemma witnessSetUntaken_subset_witnessPackages [DecidableEq N] [DecidableEq V]
361
+
(S_Ψ : Finset (Package N V)) (p : Package N' V')
362
+
(ψ : Formula N V) : witnessSetUntaken S_Ψ ψ ⊆ witnessPackages p ψ := by
363
+
intro q hq
364
+
match ψ with
365
+
| .dep _ _ => simp at hq
366
+
| .conj ψ_L ψ_R =>
367
+
simp only [witnessSetUntaken_conj, Finset.mem_union] at hq
368
+
simp only [witnessPackages, Finset.mem_union]
369
+
exact hq.elim
370
+
(fun h => Or.inl (witnessSetUntaken_subset_witnessPackages S_Ψ p ψ_L h))
371
+
(fun h => Or.inr (witnessSetUntaken_subset_witnessPackages S_Ψ p ψ_R h))
372
+
| .disj ψ_L ψ_R =>
373
+
simp only [witnessSetUntaken_disj, Finset.mem_union] at hq
374
+
have hunfold : witnessPackages p (.disj ψ_L ψ_R) =
375
+
{(hpn.disjunctN ψ_L ψ_R, hpv.zeroV), (hpn.disjunctN ψ_L ψ_R, hpv.oneV)} ∪
376
+
witnessPackages (hpn.disjunctN ψ_L ψ_R, hpv.zeroV) ψ_L ∪
377
+
witnessPackages (hpn.disjunctN ψ_L ψ_R, hpv.oneV) ψ_R := by
378
+
simp [witnessPackages]
379
+
rw [hunfold]
380
+
rcases hq with hL | hR
381
+
· exact Finset.mem_union.mpr (Or.inl (Finset.mem_union.mpr (Or.inr
382
+
(witnessSetUntaken_subset_witnessPackages S_Ψ _ ψ_L hL))))
383
+
· exact Finset.mem_union.mpr (Or.inr
384
+
(witnessSetUntaken_subset_witnessPackages S_Ψ _ ψ_R hR))
385
+
| .neg (.dep n vs) =>
386
+
simp only [witnessSetUntaken_neg_dep] at hq
387
+
simp only [witnessPackages, Finset.mem_insert, Finset.mem_singleton]
388
+
split at hq
389
+
· simp only [Finset.mem_singleton] at hq
390
+
exact Or.inl hq
391
+
· simp at hq
392
+
| .neg (.conj ψ_L ψ_R) =>
393
+
rw [witnessSetUntaken_neg_conj] at hq
394
+
have key : witnessPackages p (.neg (.conj ψ_L ψ_R)) =
395
+
witnessPackages p (.disj (.neg ψ_L) (.neg ψ_R)) := by simp [witnessPackages]
396
+
rw [key]
397
+
exact witnessSetUntaken_subset_witnessPackages S_Ψ p (.disj (.neg ψ_L) (.neg ψ_R)) hq
398
+
| .neg (.disj ψ_L ψ_R) =>
399
+
rw [witnessSetUntaken_neg_disj] at hq
400
+
have key : witnessPackages p (.neg (.disj ψ_L ψ_R)) =
401
+
witnessPackages p (.conj (.neg ψ_L) (.neg ψ_R)) := by simp [witnessPackages]
402
+
rw [key]
403
+
exact witnessSetUntaken_subset_witnessPackages S_Ψ p (.conj (.neg ψ_L) (.neg ψ_R)) hq
404
+
| .neg (.neg ψ') =>
405
+
rw [witnessSetUntaken_neg_neg] at hq
406
+
have key : witnessPackages p (.neg (.neg ψ')) = witnessPackages p ψ' := by
407
+
simp [witnessPackages]
408
+
rw [key]
409
+
exact witnessSetUntaken_subset_witnessPackages S_Ψ p ψ' hq
410
+
termination_by ψ.weight
411
+
decreasing_by all_goals simp only [Formula.weight]; omega
412
+
413
+
lemma witnessSetTaken_subset_witnessPackages [DecidableEq N] [DecidableEq V]
414
+
(S_Ψ : Finset (Package N V)) (p : Package N' V')
415
+
(ψ : Formula N V) : witnessSetTaken S_Ψ ψ ⊆ witnessPackages p ψ := by
416
+
intro q hq
417
+
match ψ with
418
+
| .dep _ _ => simp at hq
419
+
| .conj ψ_L ψ_R =>
420
+
simp only [witnessSetTaken_conj, Finset.mem_union] at hq
421
+
simp only [witnessPackages, Finset.mem_union]
422
+
exact hq.elim
423
+
(fun h => Or.inl (witnessSetTaken_subset_witnessPackages S_Ψ p ψ_L h))
424
+
(fun h => Or.inr (witnessSetTaken_subset_witnessPackages S_Ψ p ψ_R h))
425
+
| .disj ψ_L ψ_R =>
426
+
have hunfold : witnessPackages p (.disj ψ_L ψ_R) =
427
+
{(hpn.disjunctN ψ_L ψ_R, hpv.zeroV), (hpn.disjunctN ψ_L ψ_R, hpv.oneV)} ∪
428
+
witnessPackages (hpn.disjunctN ψ_L ψ_R, hpv.zeroV) ψ_L ∪
429
+
witnessPackages (hpn.disjunctN ψ_L ψ_R, hpv.oneV) ψ_R := by
430
+
simp [witnessPackages]
431
+
rw [hunfold]
432
+
simp only [witnessSetTaken_disj] at hq
433
+
split at hq
434
+
· simp only [Finset.mem_union, Finset.mem_singleton] at hq
435
+
rcases hq with (rfl | hL) | hU
436
+
· exact Finset.mem_union.mpr (Or.inl (Finset.mem_union.mpr (Or.inl
437
+
(Finset.mem_insert.mpr (Or.inl rfl)))))
438
+
· exact Finset.mem_union.mpr (Or.inl (Finset.mem_union.mpr (Or.inr
439
+
(witnessSetTaken_subset_witnessPackages S_Ψ _ ψ_L hL))))
440
+
· exact Finset.mem_union.mpr (Or.inr
441
+
(witnessSetUntaken_subset_witnessPackages S_Ψ _ ψ_R hU))
442
+
· simp only [Finset.mem_union, Finset.mem_singleton] at hq
443
+
rcases hq with (rfl | hU) | hR
444
+
· exact Finset.mem_union.mpr (Or.inl (Finset.mem_union.mpr (Or.inl
445
+
(Finset.mem_insert.mpr (Or.inr (Finset.mem_singleton.mpr rfl))))))
446
+
· exact Finset.mem_union.mpr (Or.inl (Finset.mem_union.mpr (Or.inr
447
+
(witnessSetUntaken_subset_witnessPackages S_Ψ _ ψ_L hU))))
448
+
· exact Finset.mem_union.mpr (Or.inr
449
+
(witnessSetTaken_subset_witnessPackages S_Ψ _ ψ_R hR))
450
+
| .neg (.dep n vs) =>
451
+
simp only [witnessSetTaken_neg_dep, Finset.mem_singleton] at hq
452
+
subst hq
453
+
simp [witnessPackages]
454
+
| .neg (.conj ψ_L ψ_R) =>
455
+
rw [witnessSetTaken_neg_conj] at hq
456
+
have key : witnessPackages p (.neg (.conj ψ_L ψ_R)) =
457
+
witnessPackages p (.disj (.neg ψ_L) (.neg ψ_R)) := by simp [witnessPackages]
458
+
rw [key]
459
+
exact witnessSetTaken_subset_witnessPackages S_Ψ p (.disj (.neg ψ_L) (.neg ψ_R)) hq
460
+
| .neg (.disj ψ_L ψ_R) =>
461
+
rw [witnessSetTaken_neg_disj] at hq
462
+
have key : witnessPackages p (.neg (.disj ψ_L ψ_R)) =
463
+
witnessPackages p (.conj (.neg ψ_L) (.neg ψ_R)) := by simp [witnessPackages]
464
+
rw [key]
465
+
exact witnessSetTaken_subset_witnessPackages S_Ψ p (.conj (.neg ψ_L) (.neg ψ_R)) hq
466
+
| .neg (.neg ψ') =>
467
+
rw [witnessSetTaken_neg_neg] at hq
468
+
have key : witnessPackages p (.neg (.neg ψ')) = witnessPackages p ψ' := by
469
+
simp [witnessPackages]
470
+
rw [key]
471
+
exact witnessSetTaken_subset_witnessPackages S_Ψ p ψ' hq
472
+
termination_by ψ.weight
473
+
decreasing_by all_goals simp only [Formula.weight]; omega
474
+
475
+
/-! ## Satisfaction-aware taken syntheticN witness invariant
476
+
477
+
Under the hypothesis `S_Ψ ⊨ ψ`, every `(syntheticN n vs, v)` in
478
+
`witnessSetTaken S_Ψ ψ` has version uniquely determined by `S_Ψ`:
479
+
- zeroV when ∃ u ∈ vs, (n, u) ∈ S_Ψ (from a recursed untaken-side path)
480
+
- oneV otherwise (from a taken-side path)
481
+
482
+
These cases are mutually exclusive, giving version uniqueness across the
483
+
whole `completenessWitness` set. -/
484
+
485
+
/-- Untaken-side synthetic witness implies some `(n, u) ∈ S_Ψ`. -/
486
+
lemma witnessSetUntaken_negDep_exists [DecidableEq N] [DecidableEq V]
487
+
(S_Ψ : Finset (Package N V))
488
+
(ψ : Formula N V) (n : N) (vs : Finset V) (v : V')
489
+
(h : (hpn.syntheticN n vs, v) ∈ witnessSetUntaken S_Ψ ψ) :
490
+
∃ u ∈ vs, ((n, u) : Package N V) ∈ S_Ψ := by
491
+
match ψ with
492
+
| .dep _ _ => simp at h
493
+
| .conj ψ_L ψ_R =>
494
+
simp only [witnessSetUntaken_conj, Finset.mem_union] at h
495
+
exact h.elim
496
+
(witnessSetUntaken_negDep_exists S_Ψ ψ_L n vs v)
497
+
(witnessSetUntaken_negDep_exists S_Ψ ψ_R n vs v)
498
+
| .disj ψ_L ψ_R =>
499
+
simp only [witnessSetUntaken_disj, Finset.mem_union] at h
500
+
exact h.elim
501
+
(witnessSetUntaken_negDep_exists S_Ψ ψ_L n vs v)
502
+
(witnessSetUntaken_negDep_exists S_Ψ ψ_R n vs v)
503
+
| .neg (.dep n' vs') =>
504
+
simp only [witnessSetUntaken_neg_dep] at h
505
+
split at h
506
+
· rename_i hex
507
+
simp only [Finset.mem_singleton] at h
508
+
have heq := (Prod.mk.injEq _ _ _ _).mp h
509
+
obtain ⟨rfl, rfl⟩ := hpn.syntheticN_injective heq.1
510
+
exact hex
511
+
· simp at h
512
+
| .neg (.conj ψ_L ψ_R) =>
513
+
rw [witnessSetUntaken_neg_conj] at h
514
+
exact witnessSetUntaken_negDep_exists S_Ψ (.disj (.neg ψ_L) (.neg ψ_R)) n vs v h
515
+
| .neg (.disj ψ_L ψ_R) =>
516
+
rw [witnessSetUntaken_neg_disj] at h
517
+
exact witnessSetUntaken_negDep_exists S_Ψ (.conj (.neg ψ_L) (.neg ψ_R)) n vs v h
518
+
| .neg (.neg ψ') =>
519
+
rw [witnessSetUntaken_neg_neg] at h
520
+
exact witnessSetUntaken_negDep_exists S_Ψ ψ' n vs v h
521
+
termination_by ψ.weight
522
+
decreasing_by all_goals simp only [Formula.weight]; omega
523
+
524
+
/-- **Master version determinism for taken-side syntheticN witnesses.**
525
+
526
+
Under `S_Ψ ⊨ ψ`, the version of any syntheticN witness in `witnessSetTaken S_Ψ ψ`
527
+
is uniquely determined by whether the original package family has a member in `S_Ψ`:
528
+
- if `∃ u ∈ vs, (n, u) ∈ S_Ψ`, the version is `zeroV` (from a cross-recursed
529
+
untaken-side `.neg (.dep n vs)`);
530
+
- otherwise, the version is `oneV` (from a taken-side `.neg (.dep n vs)` on the
531
+
satisfaction tree of `ψ`). -/
532
+
lemma witnessSetTaken_negDep_det [DecidableEq N] [DecidableEq V]
533
+
(S_Ψ : Finset (Package N V))
534
+
(ψ : Formula N V) (hsat : S_Ψ ⊨ ψ)
535
+
(n : N) (vs : Finset V) (v : V')
536
+
(h : (hpn.syntheticN n vs, v) ∈ witnessSetTaken S_Ψ ψ) :
537
+
v = if ∃ u ∈ vs, ((n, u) : Package N V) ∈ S_Ψ then hpv.zeroV else hpv.oneV := by
538
+
match ψ with
539
+
| .dep _ _ => simp at h
540
+
| .conj ψ_L ψ_R =>
541
+
simp only [witnessSetTaken_conj, Finset.mem_union] at h
542
+
rcases h with hL | hR
543
+
· exact witnessSetTaken_negDep_det S_Ψ ψ_L hsat.1 n vs v hL
544
+
· exact witnessSetTaken_negDep_det S_Ψ ψ_R hsat.2 n vs v hR
545
+
| .disj ψ_L ψ_R =>
546
+
simp only [witnessSetTaken_disj] at h
547
+
split at h
548
+
· rename_i hψL_sat
549
+
simp only [Finset.mem_union, Finset.mem_singleton] at h
550
+
rcases h with (hsing | hL) | hU
551
+
· have heq := (Prod.mk.injEq _ _ _ _).mp hsing
552
+
exact absurd heq.1 (hpn.syntheticN_ne_disjunctN _ _ _ _)
553
+
· exact witnessSetTaken_negDep_det S_Ψ ψ_L hψL_sat n vs v hL
554
+
· -- hU : (synth, v) ∈ wsU ψ_R. By untaken det, v = zeroV; by untaken_exists,
555
+
-- ∃ u ∈ vs, (n, u) ∈ S_Ψ.
556
+
have hv := witnessSetUntaken_negDep_det S_Ψ ψ_R n vs v hU
557
+
have hex := witnessSetUntaken_negDep_exists S_Ψ ψ_R n vs v hU
558
+
simp [hv, hex]
559
+
· rename_i hψL_unsat
560
+
simp only [Finset.mem_union, Finset.mem_singleton] at h
561
+
rcases h with (hsing | hU) | hR
562
+
· have heq := (Prod.mk.injEq _ _ _ _).mp hsing
563
+
exact absurd heq.1 (hpn.syntheticN_ne_disjunctN _ _ _ _)
564
+
· have hv := witnessSetUntaken_negDep_det S_Ψ ψ_L n vs v hU
565
+
have hex := witnessSetUntaken_negDep_exists S_Ψ ψ_L n vs v hU
566
+
simp [hv, hex]
567
+
· exact witnessSetTaken_negDep_det S_Ψ ψ_R (hsat.resolve_left hψL_unsat) n vs v hR
568
+
| .neg (.dep n' vs') =>
569
+
simp only [witnessSetTaken_neg_dep, Finset.mem_singleton] at h
570
+
have heq := (Prod.mk.injEq _ _ _ _).mp h
571
+
obtain ⟨rfl, rfl⟩ := hpn.syntheticN_injective heq.1
572
+
rw [heq.2]
573
+
-- Now need: oneV = if ∃ u ∈ vs, (n, u) ∈ S_Ψ then zeroV else oneV.
574
+
-- Since hsat : S_Ψ ⊨ ¬(.dep n vs), the existential is false, so RHS = oneV.
575
+
have : ¬ ∃ u ∈ vs, ((n, u) : Package N V) ∈ S_Ψ := hsat
576
+
simp [this]
577
+
| .neg (.conj ψ_L ψ_R) =>
578
+
rw [witnessSetTaken_neg_conj] at h
579
+
apply witnessSetTaken_negDep_det S_Ψ (.disj (.neg ψ_L) (.neg ψ_R)) _ n vs v h
580
+
simp only [Formula.satisfies] at hsat
581
+
exact (not_and_or.mp hsat)
582
+
| .neg (.disj ψ_L ψ_R) =>
583
+
rw [witnessSetTaken_neg_disj] at h
584
+
apply witnessSetTaken_negDep_det S_Ψ (.conj (.neg ψ_L) (.neg ψ_R)) _ n vs v h
585
+
simp only [Formula.satisfies] at hsat
586
+
exact (not_or.mp hsat)
587
+
| .neg (.neg ψ') =>
588
+
rw [witnessSetTaken_neg_neg] at h
589
+
apply witnessSetTaken_negDep_det S_Ψ ψ' _ n vs v h
590
+
simp only [Formula.satisfies] at hsat
591
+
exact not_not.mp hsat
592
+
termination_by ψ.weight
593
+
decreasing_by all_goals simp only [Formula.weight]; omega
594
+
595
+
/-- Every witness in `witnessSetUntaken` is a syntheticN or disjunctN
596
+
(in fact only syntheticN). -/
597
+
lemma witnessSetUntaken_name_classify [DecidableEq N] [DecidableEq V]
598
+
(S_Ψ : Finset (Package N V))
599
+
(ψ : Formula N V) (n : N') (v : V')
600
+
(h : (n, v) ∈ witnessSetUntaken S_Ψ ψ) :
601
+
(∃ n' vs, n = hpn.syntheticN n' vs) ∨ (∃ ψ_L ψ_R, n = hpn.disjunctN ψ_L ψ_R) := by
602
+
match ψ with
603
+
| .dep _ _ => simp at h
604
+
| .conj ψ_L ψ_R =>
605
+
simp only [witnessSetUntaken_conj, Finset.mem_union] at h
606
+
exact h.elim
607
+
(witnessSetUntaken_name_classify S_Ψ ψ_L n v)
608
+
(witnessSetUntaken_name_classify S_Ψ ψ_R n v)
609
+
| .disj ψ_L ψ_R =>
610
+
simp only [witnessSetUntaken_disj, Finset.mem_union] at h
611
+
exact h.elim
612
+
(witnessSetUntaken_name_classify S_Ψ ψ_L n v)
613
+
(witnessSetUntaken_name_classify S_Ψ ψ_R n v)
614
+
| .neg (.dep n' vs) =>
615
+
simp only [witnessSetUntaken_neg_dep] at h
616
+
split at h
617
+
· simp only [Finset.mem_singleton] at h
618
+
have heq := (Prod.mk.injEq _ _ _ _).mp h
619
+
exact Or.inl ⟨n', vs, heq.1⟩
620
+
· simp at h
621
+
| .neg (.conj ψ_L ψ_R) =>
622
+
rw [witnessSetUntaken_neg_conj] at h
623
+
exact witnessSetUntaken_name_classify S_Ψ (.disj (.neg ψ_L) (.neg ψ_R)) n v h
624
+
| .neg (.disj ψ_L ψ_R) =>
625
+
rw [witnessSetUntaken_neg_disj] at h
626
+
exact witnessSetUntaken_name_classify S_Ψ (.conj (.neg ψ_L) (.neg ψ_R)) n v h
627
+
| .neg (.neg ψ') =>
628
+
rw [witnessSetUntaken_neg_neg] at h
629
+
exact witnessSetUntaken_name_classify S_Ψ ψ' n v h
630
+
termination_by ψ.weight
631
+
decreasing_by all_goals simp only [Formula.weight]; omega
632
+
633
+
/-- Every witness in `witnessSetTaken` is either a syntheticN or a disjunctN. -/
634
+
lemma witnessSetTaken_name_classify [DecidableEq N] [DecidableEq V]
635
+
(S_Ψ : Finset (Package N V))
636
+
(ψ : Formula N V) (n : N') (v : V')
637
+
(h : (n, v) ∈ witnessSetTaken S_Ψ ψ) :
638
+
(∃ n' vs, n = hpn.syntheticN n' vs) ∨ (∃ ψ_L ψ_R, n = hpn.disjunctN ψ_L ψ_R) := by
639
+
match ψ with
640
+
| .dep _ _ => simp at h
641
+
| .conj ψ_L ψ_R =>
642
+
simp only [witnessSetTaken_conj, Finset.mem_union] at h
643
+
exact h.elim
644
+
(witnessSetTaken_name_classify S_Ψ ψ_L n v)
645
+
(witnessSetTaken_name_classify S_Ψ ψ_R n v)
646
+
| .disj ψ_L ψ_R =>
647
+
simp only [witnessSetTaken_disj] at h
648
+
split at h
649
+
· simp only [Finset.mem_union, Finset.mem_singleton] at h
650
+
rcases h with (hsing | hL) | hU
651
+
· have heq := (Prod.mk.injEq _ _ _ _).mp hsing
652
+
exact Or.inr ⟨ψ_L, ψ_R, heq.1⟩
653
+
· exact witnessSetTaken_name_classify S_Ψ ψ_L n v hL
654
+
· exact witnessSetUntaken_name_classify S_Ψ ψ_R n v hU
655
+
· simp only [Finset.mem_union, Finset.mem_singleton] at h
656
+
rcases h with (hsing | hU) | hR
657
+
· have heq := (Prod.mk.injEq _ _ _ _).mp hsing
658
+
exact Or.inr ⟨ψ_L, ψ_R, heq.1⟩
659
+
· exact witnessSetUntaken_name_classify S_Ψ ψ_L n v hU
660
+
· exact witnessSetTaken_name_classify S_Ψ ψ_R n v hR
661
+
| .neg (.dep n' vs) =>
662
+
simp only [witnessSetTaken_neg_dep, Finset.mem_singleton] at h
663
+
have heq := (Prod.mk.injEq _ _ _ _).mp h
664
+
exact Or.inl ⟨n', vs, heq.1⟩
665
+
| .neg (.conj ψ_L ψ_R) =>
666
+
rw [witnessSetTaken_neg_conj] at h
667
+
exact witnessSetTaken_name_classify S_Ψ (.disj (.neg ψ_L) (.neg ψ_R)) n v h
668
+
| .neg (.disj ψ_L ψ_R) =>
669
+
rw [witnessSetTaken_neg_disj] at h
670
+
exact witnessSetTaken_name_classify S_Ψ (.conj (.neg ψ_L) (.neg ψ_R)) n v h
671
+
| .neg (.neg ψ') =>
672
+
rw [witnessSetTaken_neg_neg] at h
673
+
exact witnessSetTaken_name_classify S_Ψ ψ' n v h
674
+
termination_by ψ.weight
675
+
decreasing_by all_goals simp only [Formula.weight]; omega
676
+
677
+
/-- For any witness `(n, v)` in a context-appropriate witness set, the version
678
+
`v` is uniquely determined by `n` and `S_Ψ` (independent of which formula
679
+
generated the witness). -/
680
+
private lemma witnessSet_version_pinning [DecidableEq N] [DecidableEq V]
681
+
{R_Ψ : Real N V} {Δ_Ψ : PFDepRel N V} {r : Package N V} {S_Ψ : Finset (Package N V)}
682
+
(hres : IsPFResolution R_Ψ Δ_Ψ r S_Ψ)
683
+
{n : N'} {v₁ v₂ : V'}
684
+
(h1 : ∃ p ψ, (p, ψ) ∈ Δ_Ψ ∧
685
+
(n, v₁) ∈ (if p ∈ S_Ψ then witnessSetTaken S_Ψ ψ else witnessSetUntaken S_Ψ ψ))
686
+
(h2 : ∃ p ψ, (p, ψ) ∈ Δ_Ψ ∧
687
+
(n, v₂) ∈ (if p ∈ S_Ψ then witnessSetTaken S_Ψ ψ else witnessSetUntaken S_Ψ ψ)) :
688
+
v₁ = v₂ := by
689
+
obtain ⟨p₁, ψ₁, hd₁, hw₁⟩ := h1
690
+
obtain ⟨p₂, ψ₂, hd₂, hw₂⟩ := h2
691
+
-- Use the discriminator `trySyntheticN` to test if `n` is a syntheticN.
692
+
match hsyn : hpn.trySyntheticN n with
693
+
| some (n', vs) =>
694
+
-- n = syntheticN n' vs (by trySyntheticN_some).
695
+
have hneq : n = hpn.syntheticN n' vs := (hpn.trySyntheticN_some _ _ hsyn).symm
696
+
subst hneq
697
+
-- Now compute v₁ and v₂ from each context.
698
+
have getv : ∀ {p ψ v}, (p, ψ) ∈ Δ_Ψ →
699
+
(hpn.syntheticN n' vs, v) ∈
700
+
(if p ∈ S_Ψ then witnessSetTaken S_Ψ ψ else witnessSetUntaken S_Ψ ψ) →
701
+
v = if ∃ u ∈ vs, ((n', u) : Package N V) ∈ S_Ψ then hpv.zeroV else hpv.oneV := by
702
+
intro p ψ v hd hmem
703
+
split at hmem
704
+
· rename_i hpS
705
+
have hsat : S_Ψ ⊨ ψ := hres.formula_closure p hpS ψ hd
706
+
exact witnessSetTaken_negDep_det S_Ψ ψ hsat n' vs v hmem
707
+
· have hv := witnessSetUntaken_negDep_det S_Ψ ψ n' vs v hmem
708
+
have hex := witnessSetUntaken_negDep_exists S_Ψ ψ n' vs v hmem
709
+
rw [hv, if_pos hex]
710
+
rw [getv hd₁ hw₁, getv hd₂ hw₂]
711
+
| none =>
712
+
-- n is not a syntheticN. Use the classify lemma to identify n as a disjunctN.
713
+
have hcls₁ : (∃ n' vs, n = hpn.syntheticN n' vs) ∨ (∃ ψ_L ψ_R, n = hpn.disjunctN ψ_L ψ_R) := by
714
+
split at hw₁
715
+
· exact witnessSetTaken_name_classify S_Ψ ψ₁ n v₁ hw₁
716
+
· exact witnessSetUntaken_name_classify S_Ψ ψ₁ n v₁ hw₁
717
+
rcases hcls₁ with ⟨n', vs, hn⟩ | ⟨ψ_L, ψ_R, hn⟩
718
+
· -- contradicts hsyn
719
+
subst hn
720
+
simp [hpn.trySyntheticN_syntheticN] at hsyn
721
+
· -- n = disjunctN ψ_L ψ_R.
722
+
subst hn
723
+
-- Both witnesses must be in witnessSetTaken (untaken can't produce disjunctN).
724
+
have getv : ∀ {p ψ v}, (p, ψ) ∈ Δ_Ψ →
725
+
(hpn.disjunctN ψ_L ψ_R, v) ∈
726
+
(if p ∈ S_Ψ then witnessSetTaken S_Ψ ψ else witnessSetUntaken S_Ψ ψ) →
727
+
v = if S_Ψ ⊨ ψ_L then hpv.zeroV else hpv.oneV := by
728
+
intro p ψ v hd hmem
729
+
split at hmem
730
+
· exact witnessSetTaken_disjunct_det S_Ψ ψ ψ_L ψ_R v hmem
731
+
· exact (witnessSetUntaken_disjunct_det S_Ψ ψ ψ_L ψ_R v hmem).elim
732
+
rw [getv hd₁ hw₁, getv hd₂ hw₂]
733
+
734
+
/-! ## Dep-closure helpers
735
+
736
+
For each encoded edge `(q, m, vs)` with `q ∈ CW`, find a witness. -/
737
+
738
+
/-- Combined dep-closure lemma handling both taken and untaken contexts.
739
+
740
+
The `hwit` parameter is an OR:
741
+
- `Or.inr ⟨hsat, hwit_taken⟩`: taken context (S_Ψ ⊨ ψ, witnessSetTaken ⊆ CW)
742
+
- `Or.inl ⟨hq₀, hwit_untaken⟩`: untaken context (q₀ ∉ CW, witnessSetUntaken ⊆ CW)
743
+
744
+
In the disjunction case, body sub-formulas may switch context: a sub-formula's
745
+
wrapper may be in CW (from a taken formula elsewhere), requiring the taken
746
+
approach even within an overall untaken context. The `hCW_disj_zero` and
747
+
`hCW_disj_one` hypotheses provide the necessary satisfaction and witness-set
748
+
information for such cross-context switches. -/
749
+
private lemma encodeNNF_dep_closure [DecidableEq N] [DecidableEq V]
750
+
(S_Ψ : Finset (Package N V))
751
+
(CW : Finset (Package N' V'))
752
+
(mem_embed : ∀ p, p ∈ S_Ψ → embedPkg p ∈ CW)
753
+
(hCW_orig : ∀ n v, (hpn.origN n, v) ∈ CW → ∃ p ∈ S_Ψ, embedPkg p = (hpn.origN n, v))
754
+
(hCW_disj_zero : ∀ ψ_L ψ_R, (hpn.disjunctN ψ_L ψ_R, hpv.zeroV) ∈ CW →
755
+
(S_Ψ ⊨ ψ_L) ∧ witnessSetTaken S_Ψ ψ_L ⊆ CW ∧ witnessSetUntaken S_Ψ ψ_R ⊆ CW)
756
+
(hCW_disj_one : ∀ ψ_L ψ_R, (hpn.disjunctN ψ_L ψ_R, hpv.oneV) ∈ CW →
757
+
(S_Ψ ⊨ ψ_R) ∧ witnessSetUntaken S_Ψ ψ_L ⊆ CW ∧ witnessSetTaken S_Ψ ψ_R ⊆ CW)
758
+
(q₀ : Package N' V')
759
+
(ψ : Formula N V)
760
+
(hwit : (q₀ ∉ CW ∧ witnessSetUntaken S_Ψ ψ ⊆ CW) ∨
761
+
((S_Ψ ⊨ ψ) ∧ witnessSetTaken S_Ψ ψ ⊆ CW))
762
+
(q : Package N' V')
763
+
(m : N') (vs : Finset V')
764
+
(henc : (q, m, vs) ∈ encodeNNF q₀ ψ)
765
+
(hq : q ∈ CW) :
766
+
∃ v ∈ vs, (m, v) ∈ CW := by
767
+
match ψ with
768
+
| .dep n dvs =>
769
+
simp only [encodeNNF, Finset.mem_singleton, Prod.mk.injEq] at henc
770
+
obtain ⟨rfl, rfl, rfl⟩ := henc
771
+
rcases hwit with ⟨hq₀, _⟩ | ⟨hsat, _⟩
772
+
· exact absurd hq hq₀
773
+
· obtain ⟨v, hv, hvS⟩ := hsat
774
+
exact ⟨hpv.origV v, Finset.mem_map.mpr ⟨v, hv, rfl⟩, mem_embed _ hvS⟩
775
+
| .conj ψ_L ψ_R =>
776
+
simp only [encodeNNF, Finset.mem_union] at henc
777
+
rcases henc with hL | hR
778
+
· have hwit' : (q₀ ∉ CW ∧ witnessSetUntaken S_Ψ ψ_L ⊆ CW) ∨
779
+
((S_Ψ ⊨ ψ_L) ∧ witnessSetTaken S_Ψ ψ_L ⊆ CW) := by
780
+
rcases hwit with ⟨hq₀, hu⟩ | ⟨hsat, ht⟩
781
+
· exact Or.inl ⟨hq₀, fun x hx => hu (by simp [witnessSetUntaken_conj]; exact Or.inl hx)⟩
782
+
· exact Or.inr ⟨hsat.1, fun x hx => ht (by simp [witnessSetTaken_conj]; exact Or.inl hx)⟩
783
+
exact encodeNNF_dep_closure S_Ψ CW mem_embed hCW_orig hCW_disj_zero hCW_disj_one
784
+
q₀ ψ_L hwit' q m vs hL hq
785
+
· have hwit' : (q₀ ∉ CW ∧ witnessSetUntaken S_Ψ ψ_R ⊆ CW) ∨
786
+
((S_Ψ ⊨ ψ_R) ∧ witnessSetTaken S_Ψ ψ_R ⊆ CW) := by
787
+
rcases hwit with ⟨hq₀, hu⟩ | ⟨hsat, ht⟩
788
+
· exact Or.inl ⟨hq₀, fun x hx => hu (by simp [witnessSetUntaken_conj]; exact Or.inr hx)⟩
789
+
· exact Or.inr ⟨hsat.2, fun x hx => ht (by simp [witnessSetTaken_conj]; exact Or.inr hx)⟩
790
+
exact encodeNNF_dep_closure S_Ψ CW mem_embed hCW_orig hCW_disj_zero hCW_disj_one
791
+
q₀ ψ_R hwit' q m vs hR hq
792
+
| .disj ψ_L ψ_R =>
793
+
rw [encodeNNF] at henc
794
+
rw [Finset.mem_union, Finset.mem_union] at henc
795
+
rcases henc with (hwrap | hbody) | hbody
796
+
· -- wrapper edge: q = q₀
797
+
simp only [Finset.mem_singleton, Prod.mk.injEq] at hwrap
798
+
obtain ⟨rfl, rfl, rfl⟩ := hwrap
799
+
rcases hwit with ⟨hq₀, _⟩ | ⟨hsat, hwit_t⟩
800
+
· exact absurd hq hq₀
801
+
· by_cases hψL_sat : S_Ψ ⊨ ψ_L
802
+
· refine ⟨hpv.zeroV, Finset.mem_insert_self _ _, ?_⟩
803
+
apply hwit_t; simp only [witnessSetTaken_disj, if_pos hψL_sat]
804
+
exact Finset.mem_union.mpr (Or.inl (Finset.mem_union.mpr (Or.inl
805
+
(Finset.mem_singleton.mpr rfl))))
806
+
· refine ⟨hpv.oneV, by simp [Finset.mem_insert], ?_⟩
807
+
apply hwit_t; simp only [witnessSetTaken_disj, if_neg hψL_sat]
808
+
exact Finset.mem_union.mpr (Or.inl (Finset.mem_union.mpr (Or.inl
809
+
(Finset.mem_singleton.mpr rfl))))
810
+
· -- body ψ_L: new q₀' = (disjunctN ψ_L ψ_R, zeroV)
811
+
by_cases hq₀' : (hpn.disjunctN ψ_L ψ_R, hpv.zeroV) ∈ CW
812
+
· -- new q₀' ∈ CW: use taken via hCW_disj_zero
813
+
obtain ⟨hsat_L, htL, _⟩ := hCW_disj_zero ψ_L ψ_R hq₀'
814
+
exact encodeNNF_dep_closure S_Ψ CW mem_embed hCW_orig hCW_disj_zero hCW_disj_one
815
+
_ ψ_L (Or.inr ⟨hsat_L, htL⟩) q m vs hbody hq
816
+
· -- new q₀' ∉ CW: derive untaken witnesses
817
+
have hwL : witnessSetUntaken S_Ψ ψ_L ⊆ CW := by
818
+
rcases hwit with ⟨_, hu⟩ | ⟨_, ht⟩
819
+
· exact fun x hx => hu (by simp [witnessSetUntaken_disj]; exact Or.inl hx)
820
+
· by_cases hψL_sat : S_Ψ ⊨ ψ_L
821
+
· -- sat ψ_L: (disjunctN, zeroV) ∈ witnessSetTaken (disj) ⊆ CW, contradiction
822
+
exfalso; apply hq₀'
823
+
apply ht; simp only [witnessSetTaken_disj, if_pos hψL_sat]
824
+
exact Finset.mem_union.mpr (Or.inl (Finset.mem_union.mpr (Or.inl
825
+
(Finset.mem_singleton.mpr rfl))))
826
+
· -- ¬sat ψ_L: witnessSetTaken (disj) = {oneV} ∪ untaken(ψ_L) ∪ taken(ψ_R)
827
+
exact fun x hx => ht (by
828
+
simp only [witnessSetTaken_disj, if_neg hψL_sat]
829
+
exact Finset.mem_union.mpr (Or.inl (Finset.mem_union.mpr (Or.inr hx))))
830
+
exact encodeNNF_dep_closure S_Ψ CW mem_embed hCW_orig hCW_disj_zero hCW_disj_one
831
+
_ ψ_L (Or.inl ⟨hq₀', hwL⟩) q m vs hbody hq
832
+
· -- body ψ_R: new q₀' = (disjunctN ψ_L ψ_R, oneV)
833
+
by_cases hq₀' : (hpn.disjunctN ψ_L ψ_R, hpv.oneV) ∈ CW
834
+
· obtain ⟨hsat_R, _, htR⟩ := hCW_disj_one ψ_L ψ_R hq₀'
835
+
exact encodeNNF_dep_closure S_Ψ CW mem_embed hCW_orig hCW_disj_zero hCW_disj_one
836
+
_ ψ_R (Or.inr ⟨hsat_R, htR⟩) q m vs hbody hq
837
+
· have hwR : witnessSetUntaken S_Ψ ψ_R ⊆ CW := by
838
+
rcases hwit with ⟨_, hu⟩ | ⟨_, ht⟩
839
+
· exact fun x hx => hu (by simp [witnessSetUntaken_disj]; exact Or.inr hx)
840
+
· by_cases hψL_sat : S_Ψ ⊨ ψ_L
841
+
· exact fun x hx => ht (by
842
+
simp only [witnessSetTaken_disj, if_pos hψL_sat]
843
+
exact Finset.mem_union.mpr (Or.inr hx))
844
+
· exfalso; apply hq₀'
845
+
apply ht; simp only [witnessSetTaken_disj, if_neg hψL_sat]
846
+
exact Finset.mem_union.mpr (Or.inl (Finset.mem_union.mpr (Or.inl
847
+
(Finset.mem_singleton.mpr rfl))))
848
+
exact encodeNNF_dep_closure S_Ψ CW mem_embed hCW_orig hCW_disj_zero hCW_disj_one
849
+
_ ψ_R (Or.inl ⟨hq₀', hwR⟩) q m vs hbody hq
850
+
| .neg (.dep n dvs) =>
851
+
simp only [encodeNNF, Finset.mem_union, Finset.mem_singleton, Finset.mem_image,
852
+
Prod.mk.injEq] at henc
853
+
rcases henc with ⟨rfl, rfl, rfl⟩ | ⟨u, hu, rfl, rfl, rfl⟩
854
+
· -- sentinel: q = q₀
855
+
rcases hwit with ⟨hq₀, _⟩ | ⟨_, hwit_t⟩
856
+
· exact absurd hq hq₀
857
+
· refine ⟨hpv.oneV, Finset.mem_singleton.mpr rfl, ?_⟩
858
+
apply hwit_t; simp only [witnessSetTaken_neg_dep]
859
+
exact Finset.mem_singleton.mpr rfl
860
+
· -- blocker: q = (origN n, origV u)
861
+
obtain ⟨⟨pn, pv⟩, hpS, hpeq⟩ := hCW_orig n (hpv.origV u) hq
862
+
simp only [embedPkg, Prod.mk.injEq] at hpeq
863
+
have h1 := hpn.origN.injective hpeq.1
864
+
have h2 := hpv.origV.injective hpeq.2
865
+
subst h1; subst h2
866
+
rcases hwit with ⟨_, hwit_u⟩ | ⟨hsat, _⟩
867
+
· -- untaken: (n, u) ∈ S_Ψ, so witnessSetUntaken adds (syntheticN, zeroV)
868
+
refine ⟨hpv.zeroV, Finset.mem_singleton.mpr rfl, ?_⟩
869
+
apply hwit_u; simp only [witnessSetUntaken_neg_dep]
870
+
rw [if_pos (⟨pv, hu, hpS⟩ : ∃ u ∈ dvs, ((pn, u) : Package N V) ∈ S_Ψ)]
871
+
exact Finset.mem_singleton.mpr rfl
872
+
· -- taken: S_Ψ ⊨ .neg(.dep n dvs) means no (n, u) ∈ S_Ψ. Contradiction.
873
+
exfalso; exact hsat ⟨pv, hu, hpS⟩
874
+
| .neg (.conj ψ_L ψ_R) =>
875
+
have keyE : encodeNNF q₀ (.neg (.conj ψ_L ψ_R)) =
876
+
encodeNNF q₀ (.disj (.neg ψ_L) (.neg ψ_R)) := by simp [encodeNNF]
877
+
rw [keyE] at henc
878
+
have hwit' : (q₀ ∉ CW ∧ witnessSetUntaken S_Ψ (.disj (.neg ψ_L) (.neg ψ_R)) ⊆ CW) ∨
879
+
((S_Ψ ⊨ Formula.disj (.neg ψ_L) (.neg ψ_R)) ∧
880
+
witnessSetTaken S_Ψ (.disj (.neg ψ_L) (.neg ψ_R)) ⊆ CW) := by
881
+
rcases hwit with ⟨hq₀, hu⟩ | ⟨hsat, ht⟩
882
+
· exact Or.inl ⟨hq₀, by rw [← witnessSetUntaken_neg_conj]; exact hu⟩
883
+
· exact Or.inr ⟨not_and_or.mp hsat, by rw [← witnessSetTaken_neg_conj]; exact ht⟩
884
+
exact encodeNNF_dep_closure S_Ψ CW mem_embed hCW_orig hCW_disj_zero hCW_disj_one
885
+
q₀ _ hwit' q m vs henc hq
886
+
| .neg (.disj ψ_L ψ_R) =>
887
+
have keyE : encodeNNF q₀ (.neg (.disj ψ_L ψ_R)) =
888
+
encodeNNF q₀ (.conj (.neg ψ_L) (.neg ψ_R)) := by simp [encodeNNF]
889
+
rw [keyE] at henc
890
+
have hwit' : (q₀ ∉ CW ∧ witnessSetUntaken S_Ψ (.conj (.neg ψ_L) (.neg ψ_R)) ⊆ CW) ∨
891
+
((S_Ψ ⊨ Formula.conj (.neg ψ_L) (.neg ψ_R)) ∧
892
+
witnessSetTaken S_Ψ (.conj (.neg ψ_L) (.neg ψ_R)) ⊆ CW) := by
893
+
rcases hwit with ⟨hq₀, hu⟩ | ⟨hsat, ht⟩
894
+
· exact Or.inl ⟨hq₀, by rw [← witnessSetUntaken_neg_disj]; exact hu⟩
895
+
· exact Or.inr ⟨not_or.mp hsat, by rw [← witnessSetTaken_neg_disj]; exact ht⟩
896
+
exact encodeNNF_dep_closure S_Ψ CW mem_embed hCW_orig hCW_disj_zero hCW_disj_one
897
+
q₀ _ hwit' q m vs henc hq
898
+
| .neg (.neg ψ') =>
899
+
have keyE : encodeNNF q₀ (.neg (.neg ψ')) = encodeNNF q₀ ψ' := by simp [encodeNNF]
900
+
rw [keyE] at henc
901
+
have hwit' : (q₀ ∉ CW ∧ witnessSetUntaken S_Ψ ψ' ⊆ CW) ∨
902
+
((S_Ψ ⊨ ψ') ∧ witnessSetTaken S_Ψ ψ' ⊆ CW) := by
903
+
rcases hwit with ⟨hq₀, hu⟩ | ⟨hsat, ht⟩
904
+
· exact Or.inl ⟨hq₀, by rw [← witnessSetUntaken_neg_neg]; exact hu⟩
905
+
· exact Or.inr ⟨not_not.mp hsat, by rw [← witnessSetTaken_neg_neg]; exact ht⟩
906
+
exact encodeNNF_dep_closure S_Ψ CW mem_embed hCW_orig hCW_disj_zero hCW_disj_one
907
+
q₀ ψ' hwit' q m vs henc hq
908
+
termination_by ψ.weight
909
+
decreasing_by all_goals (simp only [Formula.weight]; omega)
910
+
911
+
/-- Untaken-context dep-closure: when `q₀ ∉ CW` and `witnessSetUntaken S_Ψ ψ ⊆ CW`. -/
912
+
private lemma encodeNNF_dep_closure_untaken [DecidableEq N] [DecidableEq V]
913
+
(S_Ψ : Finset (Package N V))
914
+
(CW : Finset (Package N' V'))
915
+
(mem_embed : ∀ p, p ∈ S_Ψ → embedPkg p ∈ CW)
916
+
(hCW_orig : ∀ n v, (hpn.origN n, v) ∈ CW → ∃ p ∈ S_Ψ, embedPkg p = (hpn.origN n, v))
917
+
(hCW_disj_zero : ∀ ψ_L ψ_R, (hpn.disjunctN ψ_L ψ_R, hpv.zeroV) ∈ CW →
918
+
(S_Ψ ⊨ ψ_L) ∧ witnessSetTaken S_Ψ ψ_L ⊆ CW ∧ witnessSetUntaken S_Ψ ψ_R ⊆ CW)
919
+
(hCW_disj_one : ∀ ψ_L ψ_R, (hpn.disjunctN ψ_L ψ_R, hpv.oneV) ∈ CW →
920
+
(S_Ψ ⊨ ψ_R) ∧ witnessSetUntaken S_Ψ ψ_L ⊆ CW ∧ witnessSetTaken S_Ψ ψ_R ⊆ CW)
921
+
(q₀ : Package N' V')
922
+
(hq₀ : q₀ ∉ CW)
923
+
(ψ : Formula N V)
924
+
(hwit : witnessSetUntaken S_Ψ ψ ⊆ CW)
925
+
(q : Package N' V')
926
+
(m : N') (vs : Finset V')
927
+
(henc : (q, m, vs) ∈ encodeNNF q₀ ψ)
928
+
(hq : q ∈ CW) :
929
+
∃ v ∈ vs, (m, v) ∈ CW :=
930
+
encodeNNF_dep_closure S_Ψ CW mem_embed hCW_orig hCW_disj_zero hCW_disj_one
931
+
q₀ ψ (Or.inl ⟨hq₀, hwit⟩) q m vs henc hq
932
+
933
+
/-- Taken-context dep-closure: when `S_Ψ ⊨ ψ` and `witnessSetTaken S_Ψ ψ ⊆ CW`. -/
934
+
private lemma encodeNNF_dep_closure_taken [DecidableEq N] [DecidableEq V]
935
+
(S_Ψ : Finset (Package N V))
936
+
(CW : Finset (Package N' V'))
937
+
(mem_embed : ∀ p, p ∈ S_Ψ → embedPkg p ∈ CW)
938
+
(hCW_orig : ∀ n v, (hpn.origN n, v) ∈ CW → ∃ p ∈ S_Ψ, embedPkg p = (hpn.origN n, v))
939
+
(hCW_disj_zero : ∀ ψ_L ψ_R, (hpn.disjunctN ψ_L ψ_R, hpv.zeroV) ∈ CW →
940
+
(S_Ψ ⊨ ψ_L) ∧ witnessSetTaken S_Ψ ψ_L ⊆ CW ∧ witnessSetUntaken S_Ψ ψ_R ⊆ CW)
941
+
(hCW_disj_one : ∀ ψ_L ψ_R, (hpn.disjunctN ψ_L ψ_R, hpv.oneV) ∈ CW →
942
+
(S_Ψ ⊨ ψ_R) ∧ witnessSetUntaken S_Ψ ψ_L ⊆ CW ∧ witnessSetTaken S_Ψ ψ_R ⊆ CW)
943
+
(q₀ : Package N' V')
944
+
(ψ : Formula N V)
945
+
(hsat : S_Ψ ⊨ ψ)
946
+
(hwit : witnessSetTaken S_Ψ ψ ⊆ CW)
947
+
(q : Package N' V')
948
+
(m : N') (vs : Finset V')
949
+
(henc : (q, m, vs) ∈ encodeNNF q₀ ψ)
950
+
(hq : q ∈ CW) :
951
+
∃ v ∈ vs, (m, v) ∈ CW :=
952
+
encodeNNF_dep_closure S_Ψ CW mem_embed hCW_orig hCW_disj_zero hCW_disj_one
953
+
q₀ ψ (Or.inr ⟨hsat, hwit⟩) q m vs henc hq
954
+
955
+
/-! ## Monotonicity of witnessSetTaken for disjunct sub-formulas -/
956
+
957
+
private lemma witnessSetTaken_disj_zero_mono [DecidableEq N] [DecidableEq V]
958
+
(S_Ψ : Finset (Package N V))
959
+
(ψ : Formula N V)
960
+
(ψ_L ψ_R : Formula N V)
961
+
(hw : (hpn.disjunctN ψ_L ψ_R, hpv.zeroV) ∈ witnessSetTaken S_Ψ ψ) :
962
+
(S_Ψ ⊨ ψ_L) ∧ witnessSetTaken S_Ψ ψ_L ⊆ witnessSetTaken S_Ψ ψ ∧
963
+
witnessSetUntaken S_Ψ ψ_R ⊆ witnessSetTaken S_Ψ ψ := by
964
+
match ψ with
965
+
| .dep _ _ => exact absurd hw (by simp)
966
+
| .conj ψ_a ψ_b =>
967
+
simp only [witnessSetTaken_conj, Finset.mem_union] at hw
968
+
rcases hw with hL | hR
969
+
· obtain ⟨hs, h1, h2⟩ := witnessSetTaken_disj_zero_mono S_Ψ ψ_a ψ_L ψ_R hL
970
+
exact ⟨hs, fun x hx => by simp only [witnessSetTaken_conj]; exact Finset.mem_union.mpr (Or.inl (h1 hx)),
971
+
fun x hx => by simp only [witnessSetTaken_conj]; exact Finset.mem_union.mpr (Or.inl (h2 hx))⟩
972
+
· obtain ⟨hs, h1, h2⟩ := witnessSetTaken_disj_zero_mono S_Ψ ψ_b ψ_L ψ_R hR
973
+
exact ⟨hs, fun x hx => by simp only [witnessSetTaken_conj]; exact Finset.mem_union.mpr (Or.inr (h1 hx)),
974
+
fun x hx => by simp only [witnessSetTaken_conj]; exact Finset.mem_union.mpr (Or.inr (h2 hx))⟩
975
+
| .disj ψ_a ψ_b =>
976
+
simp only [witnessSetTaken_disj] at hw
977
+
split at hw
978
+
· rename_i hψa_sat
979
+
simp only [Finset.mem_union, Finset.mem_singleton] at hw
980
+
rcases hw with (hsing | hL) | hU
981
+
· have heq := (Prod.mk.injEq _ _ _ _).mp hsing
982
+
obtain ⟨rfl, rfl⟩ := hpn.disjunctN_injective heq.1
983
+
refine ⟨hψa_sat, ?_, ?_⟩
984
+
· intro x hx; simp only [witnessSetTaken_disj, if_pos hψa_sat, Finset.mem_union, Finset.mem_singleton]
985
+
exact Or.inl (Or.inr hx)
986
+
· intro x hx; simp only [witnessSetTaken_disj, if_pos hψa_sat, Finset.mem_union, Finset.mem_singleton]
987
+
exact Or.inr hx
988
+
· obtain ⟨hs, h1, h2⟩ := witnessSetTaken_disj_zero_mono S_Ψ ψ_a ψ_L ψ_R hL
989
+
refine ⟨hs, ?_, ?_⟩ <;> {
990
+
intro x hx; simp only [witnessSetTaken_disj, if_pos hψa_sat, Finset.mem_union, Finset.mem_singleton]
991
+
exact Or.inl (Or.inr (by first | exact h1 hx | exact h2 hx)) }
992
+
· exact absurd hU (witnessSetUntaken_disjunct_det S_Ψ ψ_b ψ_L ψ_R _)
993
+
· rename_i hψa_unsat
994
+
simp only [Finset.mem_union, Finset.mem_singleton] at hw
995
+
rcases hw with (hsing | hU) | hR
996
+
· have heq := (Prod.mk.injEq _ _ _ _).mp hsing
997
+
exact absurd heq.2 hpv.zeroV_ne_oneV
998
+
· exact absurd hU (witnessSetUntaken_disjunct_det S_Ψ ψ_a ψ_L ψ_R _)
999
+
· obtain ⟨hs, h1, h2⟩ := witnessSetTaken_disj_zero_mono S_Ψ ψ_b ψ_L ψ_R hR
1000
+
refine ⟨hs, ?_, ?_⟩ <;> {
1001
+
intro x hx; simp only [witnessSetTaken_disj, if_neg hψa_unsat, Finset.mem_union, Finset.mem_singleton]
1002
+
exact Or.inr (by first | exact h1 hx | exact h2 hx) }
1003
+
| .neg (.dep n vs) =>
1004
+
simp only [witnessSetTaken_neg_dep, Finset.mem_singleton, Prod.mk.injEq] at hw
1005
+
exact absurd hw.1 (hpn.disjunctN_ne_syntheticN ψ_L ψ_R n vs)
1006
+
| .neg (.conj ψ_a ψ_b) =>
1007
+
rw [witnessSetTaken_neg_conj] at hw ⊢
1008
+
exact witnessSetTaken_disj_zero_mono S_Ψ (.disj (.neg ψ_a) (.neg ψ_b)) ψ_L ψ_R hw
1009
+
| .neg (.disj ψ_a ψ_b) =>
1010
+
rw [witnessSetTaken_neg_disj] at hw ⊢
1011
+
exact witnessSetTaken_disj_zero_mono S_Ψ (.conj (.neg ψ_a) (.neg ψ_b)) ψ_L ψ_R hw
1012
+
| .neg (.neg ψ') =>
1013
+
rw [witnessSetTaken_neg_neg] at hw ⊢
1014
+
exact witnessSetTaken_disj_zero_mono S_Ψ ψ' ψ_L ψ_R hw
1015
+
termination_by ψ.weight
1016
+
decreasing_by all_goals (simp only [Formula.weight]; omega)
1017
+
1018
+
private lemma witnessSetTaken_disj_one_mono [DecidableEq N] [DecidableEq V]
1019
+
(S_Ψ : Finset (Package N V))
1020
+
(ψ : Formula N V)
1021
+
(hsat : S_Ψ ⊨ ψ)
1022
+
(ψ_L ψ_R : Formula N V)
1023
+
(hw : (hpn.disjunctN ψ_L ψ_R, hpv.oneV) ∈ witnessSetTaken S_Ψ ψ) :
1024
+
(S_Ψ ⊨ ψ_R) ∧ witnessSetUntaken S_Ψ ψ_L ⊆ witnessSetTaken S_Ψ ψ ∧
1025
+
witnessSetTaken S_Ψ ψ_R ⊆ witnessSetTaken S_Ψ ψ := by
1026
+
match ψ with
1027
+
| .dep _ _ => exact absurd hw (by simp)
1028
+
| .conj ψ_a ψ_b =>
1029
+
simp only [witnessSetTaken_conj, Finset.mem_union] at hw
1030
+
rcases hw with hL | hR
1031
+
· obtain ⟨hs, h1, h2⟩ := witnessSetTaken_disj_one_mono S_Ψ ψ_a hsat.1 ψ_L ψ_R hL
1032
+
exact ⟨hs, fun x hx => by simp only [witnessSetTaken_conj]; exact Finset.mem_union.mpr (Or.inl (h1 hx)),
1033
+
fun x hx => by simp only [witnessSetTaken_conj]; exact Finset.mem_union.mpr (Or.inl (h2 hx))⟩
1034
+
· obtain ⟨hs, h1, h2⟩ := witnessSetTaken_disj_one_mono S_Ψ ψ_b hsat.2 ψ_L ψ_R hR
1035
+
exact ⟨hs, fun x hx => by simp only [witnessSetTaken_conj]; exact Finset.mem_union.mpr (Or.inr (h1 hx)),
1036
+
fun x hx => by simp only [witnessSetTaken_conj]; exact Finset.mem_union.mpr (Or.inr (h2 hx))⟩
1037
+
| .disj ψ_a ψ_b =>
1038
+
simp only [witnessSetTaken_disj] at hw
1039
+
split at hw
1040
+
· rename_i hψa_sat
1041
+
simp only [Finset.mem_union, Finset.mem_singleton] at hw
1042
+
rcases hw with (hsing | hL) | hU
1043
+
· have heq := (Prod.mk.injEq _ _ _ _).mp hsing
1044
+
exact absurd heq.2.symm hpv.zeroV_ne_oneV
1045
+
· obtain ⟨hs, h1, h2⟩ := witnessSetTaken_disj_one_mono S_Ψ ψ_a hψa_sat ψ_L ψ_R hL
1046
+
refine ⟨hs, ?_, ?_⟩ <;> {
1047
+
intro x hx; simp only [witnessSetTaken_disj, if_pos hψa_sat, Finset.mem_union, Finset.mem_singleton]
1048
+
exact Or.inl (Or.inr (by first | exact h1 hx | exact h2 hx)) }
1049
+
· exact absurd hU (witnessSetUntaken_disjunct_det S_Ψ ψ_b ψ_L ψ_R _)
1050
+
· rename_i hψa_unsat
1051
+
simp only [Finset.mem_union, Finset.mem_singleton] at hw
1052
+
rcases hw with (hsing | hU) | hR
1053
+
· have heq := (Prod.mk.injEq _ _ _ _).mp hsing
1054
+
obtain ⟨rfl, rfl⟩ := hpn.disjunctN_injective heq.1
1055
+
refine ⟨hsat.resolve_left hψa_unsat, ?_, ?_⟩
1056
+
· intro x hx; simp only [witnessSetTaken_disj, if_neg hψa_unsat, Finset.mem_union, Finset.mem_singleton]
1057
+
exact Or.inl (Or.inr hx)
1058
+
· intro x hx; simp only [witnessSetTaken_disj, if_neg hψa_unsat, Finset.mem_union, Finset.mem_singleton]
1059
+
exact Or.inr hx
1060
+
· exact absurd hU (witnessSetUntaken_disjunct_det S_Ψ ψ_a ψ_L ψ_R _)
1061
+
· obtain ⟨hs, h1, h2⟩ := witnessSetTaken_disj_one_mono S_Ψ ψ_b (hsat.resolve_left hψa_unsat) ψ_L ψ_R hR
1062
+
refine ⟨hs, ?_, ?_⟩ <;> {
1063
+
intro x hx; simp only [witnessSetTaken_disj, if_neg hψa_unsat, Finset.mem_union, Finset.mem_singleton]
1064
+
exact Or.inr (by first | exact h1 hx | exact h2 hx) }
1065
+
| .neg (.dep n vs) =>
1066
+
simp only [witnessSetTaken_neg_dep, Finset.mem_singleton, Prod.mk.injEq] at hw
1067
+
exact absurd hw.1 (hpn.disjunctN_ne_syntheticN ψ_L ψ_R n vs)
1068
+
| .neg (.conj ψ_a ψ_b) =>
1069
+
rw [witnessSetTaken_neg_conj] at hw ⊢
1070
+
exact witnessSetTaken_disj_one_mono S_Ψ _ (by exact not_and_or.mp hsat) ψ_L ψ_R hw
1071
+
| .neg (.disj ψ_a ψ_b) =>
1072
+
rw [witnessSetTaken_neg_disj] at hw ⊢
1073
+
exact witnessSetTaken_disj_one_mono S_Ψ _ (by exact not_or.mp hsat) ψ_L ψ_R hw
1074
+
| .neg (.neg ψ') =>
1075
+
rw [witnessSetTaken_neg_neg] at hw ⊢
1076
+
exact witnessSetTaken_disj_one_mono S_Ψ ψ' (by exact not_not.mp hsat) ψ_L ψ_R hw
1077
+
termination_by ψ.weight
1078
+
decreasing_by all_goals (simp only [Formula.weight]; omega)
1079
+
1080
+
/-! ## CW disjunct structure lemmas -/
1081
+
1082
+
private lemma completenessWitness_disj_zero [DecidableEq N] [DecidableEq V]
1083
+
{S_Ψ : Finset (Package N V)} {Δ_Ψ : PFDepRel N V}
1084
+
(ψ_L ψ_R : Formula N V)
1085
+
(hmem : (hpn.disjunctN ψ_L ψ_R, hpv.zeroV) ∈ completenessWitness S_Ψ Δ_Ψ) :
1086
+
(S_Ψ ⊨ ψ_L) ∧ witnessSetTaken S_Ψ ψ_L ⊆ completenessWitness S_Ψ Δ_Ψ ∧
1087
+
witnessSetUntaken S_Ψ ψ_R ⊆ completenessWitness S_Ψ Δ_Ψ := by
1088
+
obtain ⟨⟨p, ψ⟩, hdep, hw⟩ : ∃ p ψ, (p, ψ) ∈ Δ_Ψ ∧ (hpn.disjunctN ψ_L ψ_R, hpv.zeroV) ∈ (if p ∈ S_Ψ then witnessSetTaken S_Ψ ψ else witnessSetUntaken S_Ψ ψ) := by
1089
+
unfold completenessWitness at hmem; simp_all +decide [ Finset.mem_union, Finset.mem_image ] ;
1090
+
rcases hmem with ( ⟨ a, b, hab, h ⟩ | ⟨ a, b, ψ, hdep, hmem ⟩ );
1091
+
· unfold embedPkg at h; simp_all +decide [ hpn.origN_ne_disjunctN ] ;
1092
+
· exact ⟨ a, b, ψ, hdep, hmem ⟩;
1093
+
split_ifs at hw <;> simp_all +decide [ completenessWitness ];
1094
+
· have := witnessSetTaken_disj_zero_mono S_Ψ hdep ψ_L ψ_R hw.2;
1095
+
exact ⟨ this.1, Finset.Subset.trans this.2.1 ( Finset.subset_iff.mpr fun x hx => Finset.mem_union_right _ ( Finset.mem_biUnion.mpr ⟨ _, hw.1, by aesop ⟩ ) ), Finset.Subset.trans this.2.2 ( Finset.subset_iff.mpr fun x hx => Finset.mem_union_right _ ( Finset.mem_biUnion.mpr ⟨ _, hw.1, by aesop ⟩ ) ) ⟩;
1096
+
· exact False.elim ( witnessSetUntaken_disjunct_det S_Ψ hdep ψ_L ψ_R _ hw.2 )
1097
+
1098
+
private lemma completenessWitness_disj_one [DecidableEq N] [DecidableEq V]
1099
+
{R_Ψ : Real N V} {S_Ψ : Finset (Package N V)} {Δ_Ψ : PFDepRel N V}
1100
+
{r : Package N V}
1101
+
(hres : IsPFResolution R_Ψ Δ_Ψ r S_Ψ)
1102
+
(ψ_L ψ_R : Formula N V)
1103
+
(hmem : (hpn.disjunctN ψ_L ψ_R, hpv.oneV) ∈ completenessWitness S_Ψ Δ_Ψ) :
1104
+
(S_Ψ ⊨ ψ_R) ∧ witnessSetUntaken S_Ψ ψ_L ⊆ completenessWitness S_Ψ Δ_Ψ ∧
1105
+
witnessSetTaken S_Ψ ψ_R ⊆ completenessWitness S_Ψ Δ_Ψ := by
1106
+
unfold completenessWitness at hmem;
1107
+
simp +zetaDelta at *;
1108
+
rcases hmem with ( ⟨ a, b, hab, h ⟩ | ⟨ a, b, c, h₁, h₂ ⟩ );
1109
+
· unfold embedPkg at h; simp_all +decide ;
1110
+
· split_ifs at h₂;
1111
+
· have := witnessSetTaken_disj_one_mono S_Ψ c ( hres.formula_closure ( a, b ) ‹_› c h₁ ) ψ_L ψ_R h₂;
1112
+
refine' ⟨ this.1, Finset.Subset.trans this.2.1 _, Finset.Subset.trans this.2.2 _ ⟩;
1113
+
· unfold completenessWitness;
1114
+
grind +revert;
1115
+
· unfold completenessWitness;
1116
+
grind;
1117
+
· exact False.elim ( witnessSetUntaken_disjunct_det S_Ψ c ψ_L ψ_R _ h₂ )
1118
+
1119
+
/-! ## `pkgFormula_completeness`
1120
+
1121
+
The proof structure:
1122
+
- `subset`: each witness package is in `pfReal` (via `witnessSet*_subset_witnessPackages`).
1123
+
- `root_mem`: trivial from `S_Ψ.image embedPkg`.
1124
+
- `version_unique`: combine the determinism lemmas across taken and untaken
1125
+
contexts using the satisfaction-aware `witnessSetTaken_negDep_det`.
1126
+
- `dep_closure`: the structurally hard case, proved by a helper inducting on
1127
+
the formula. See `encodeNNF_dep_closure` below. -/
1128
+
1129
+
-- Paper Thm 4.5.6 (Package Formula Reduction Completeness).
1130
+
theorem pkgFormula_completeness [DecidableEq N] [DecidableEq V]
1131
+
(R_Ψ : Real N V) (Δ_Ψ : PFDepRel N V)
1132
+
(r : Package N V)
1133
+
(S_Ψ : Finset (Package N V))
1134
+
(hres : IsPFResolution R_Ψ Δ_Ψ r S_Ψ) :
1135
+
IsResolution (pfReal R_Ψ Δ_Ψ) (pfDeps Δ_Ψ) (embedPkg r)
1136
+
(completenessWitness S_Ψ Δ_Ψ) := by
1137
+
-- Convenience facts
1138
+
have mem_embed : ∀ p, p ∈ S_Ψ → embedPkg p ∈ completenessWitness S_Ψ Δ_Ψ := by
1139
+
intro p hp
1140
+
simp only [completenessWitness, Finset.mem_union, Finset.mem_image]
1141
+
exact Or.inl ⟨p, hp, rfl⟩
1142
+
have hCW_orig : ∀ n v, (hpn.origN n, v) ∈ completenessWitness S_Ψ Δ_Ψ →
1143
+
∃ p ∈ S_Ψ, embedPkg p = (hpn.origN n, v) := by
1144
+
intro n v hv
1145
+
simp only [completenessWitness, Finset.mem_union, Finset.mem_image, Finset.mem_biUnion] at hv
1146
+
rcases hv with ⟨p, hp, hpe⟩ | ⟨⟨p, ψ⟩, _, hw⟩
1147
+
· exact ⟨p, hp, hpe⟩
1148
+
· split at hw
1149
+
· exact absurd hw (witnessSetTaken_not_orig S_Ψ ψ n _)
1150
+
· exact absurd hw (witnessSetUntaken_not_orig S_Ψ ψ n _)
1151
+
-- CW disjunct hypotheses
1152
+
have hCW_disj_zero : ∀ ψ_L ψ_R, (hpn.disjunctN ψ_L ψ_R, hpv.zeroV) ∈
1153
+
completenessWitness S_Ψ Δ_Ψ →
1154
+
(S_Ψ ⊨ ψ_L) ∧ witnessSetTaken S_Ψ ψ_L ⊆ completenessWitness S_Ψ Δ_Ψ ∧
1155
+
witnessSetUntaken S_Ψ ψ_R ⊆ completenessWitness S_Ψ Δ_Ψ :=
1156
+
fun ψ_L ψ_R h => completenessWitness_disj_zero ψ_L ψ_R h
1157
+
have hCW_disj_one : ∀ ψ_L ψ_R, (hpn.disjunctN ψ_L ψ_R, hpv.oneV) ∈
1158
+
completenessWitness S_Ψ Δ_Ψ →
1159
+
(S_Ψ ⊨ ψ_R) ∧ witnessSetUntaken S_Ψ ψ_L ⊆ completenessWitness S_Ψ Δ_Ψ ∧
1160
+
witnessSetTaken S_Ψ ψ_R ⊆ completenessWitness S_Ψ Δ_Ψ :=
1161
+
fun ψ_L ψ_R h => completenessWitness_disj_one hres ψ_L ψ_R h
1162
+
refine ⟨?_, ?_, ?_, ?_⟩
1163
+
· -- subset
1164
+
intro q hq
1165
+
simp only [completenessWitness, Finset.mem_union, Finset.mem_image, Finset.mem_biUnion] at hq
1166
+
rcases hq with ⟨p, hp, rfl⟩ | ⟨⟨p, ψ⟩, hdep, hw⟩
1167
+
· exact Finset.mem_union.mpr (Or.inl (Finset.mem_image.mpr ⟨p, hres.subset hp, rfl⟩))
1168
+
· simp only [pfReal, Finset.mem_union, Finset.mem_biUnion]
1169
+
refine Or.inr ⟨⟨p, ψ⟩, hdep, ?_⟩
1170
+
split at hw
1171
+
· exact witnessSetTaken_subset_witnessPackages S_Ψ (embedPkg p) ψ hw
1172
+
· exact witnessSetUntaken_subset_witnessPackages S_Ψ (embedPkg p) ψ hw
1173
+
· -- root_mem
1174
+
exact mem_embed r hres.root_mem
1175
+
· -- dep_closure
1176
+
intro q hq m vs' hd
1177
+
simp only [pfDeps, Finset.mem_biUnion] at hd
1178
+
obtain ⟨⟨p, ψ⟩, hdep, henc⟩ := hd
1179
+
by_cases hp : p ∈ S_Ψ
1180
+
· -- taken case: have S_Ψ ⊨ ψ, witnessSetTaken ψ ⊆ CW.
1181
+
have hsat : S_Ψ ⊨ ψ := hres.formula_closure p hp ψ hdep
1182
+
have hwit : witnessSetTaken S_Ψ ψ ⊆ completenessWitness S_Ψ Δ_Ψ := by
1183
+
intro x hx
1184
+
simp only [completenessWitness, Finset.mem_union, Finset.mem_biUnion]
1185
+
refine Or.inr ⟨⟨p, ψ⟩, hdep, ?_⟩
1186
+
rw [if_pos hp]; exact hx
1187
+
exact encodeNNF_dep_closure_taken S_Ψ _ mem_embed hCW_orig
1188
+
hCW_disj_zero hCW_disj_one (embedPkg p) ψ hsat hwit
1189
+
q m vs' henc hq
1190
+
· -- untaken case: just witnessSetUntaken ψ ⊆ CW.
1191
+
have hwit : witnessSetUntaken S_Ψ ψ ⊆ completenessWitness S_Ψ Δ_Ψ := by
1192
+
intro x hx
1193
+
simp only [completenessWitness, Finset.mem_union, Finset.mem_biUnion]
1194
+
refine Or.inr ⟨⟨p, ψ⟩, hdep, ?_⟩
1195
+
rw [if_neg hp]; exact hx
1196
+
have hq₀ : embedPkg p ∉ completenessWitness S_Ψ Δ_Ψ := by
1197
+
intro hmem
1198
+
apply hp
1199
+
have : (hpn.origN p.1, hpv.origV p.2) ∈ completenessWitness S_Ψ Δ_Ψ := by
1200
+
show embedPkg p ∈ _; exact hmem
1201
+
obtain ⟨p', hp', hpe⟩ := hCW_orig p.1 (hpv.origV p.2) this
1202
+
simp only [embedPkg, Prod.mk.injEq] at hpe
1203
+
have h1 := hpn.origN.injective hpe.1
1204
+
have h2 := hpv.origV.injective hpe.2
1205
+
cases p with | mk n v => cases p' with | mk n' v' =>
1206
+
simp at h1 h2; subst h1; subst h2; exact hp'
1207
+
exact encodeNNF_dep_closure_untaken S_Ψ _ mem_embed hCW_orig
1208
+
hCW_disj_zero hCW_disj_one (embedPkg p) hq₀ ψ hwit
1209
+
q m vs' henc hq
1210
+
· -- version_unique
1211
+
intro n v₁ v₂ hv₁ hv₂
1212
+
simp only [completenessWitness, Finset.mem_union, Finset.mem_image, Finset.mem_biUnion]
1213
+
at hv₁ hv₂
1214
+
rcases hv₁ with ⟨p₁, hp₁, heq1⟩ | ⟨⟨p₁, ψ₁⟩, hd₁, hw₁⟩ <;>
1215
+
rcases hv₂ with ⟨p₂, hp₂, heq2⟩ | ⟨⟨p₂, ψ₂⟩, hd₂, hw₂⟩
1216
+
· obtain ⟨n₁, w₁⟩ := p₁; obtain ⟨n₂, w₂⟩ := p₂
1217
+
simp only [embedPkg, Prod.mk.injEq] at heq1 heq2
1218
+
obtain ⟨h1n, rfl⟩ := heq1; obtain ⟨h2n, rfl⟩ := heq2
1219
+
have := hpn.origN.injective (h1n.trans h2n.symm); subst this
1220
+
exact congrArg hpv.origV (hres.version_unique _ _ _ hp₁ hp₂)
1221
+
· simp only [embedPkg, Prod.mk.injEq] at heq1
1222
+
obtain ⟨rfl, rfl⟩ := heq1
1223
+
split at hw₂
1224
+
· exact absurd hw₂ (witnessSetTaken_not_orig S_Ψ ψ₂ _ _)
1225
+
· exact absurd hw₂ (witnessSetUntaken_not_orig S_Ψ ψ₂ _ _)
1226
+
· simp only [embedPkg, Prod.mk.injEq] at heq2
1227
+
obtain ⟨rfl, rfl⟩ := heq2
1228
+
split at hw₁
1229
+
· exact absurd hw₁ (witnessSetTaken_not_orig S_Ψ ψ₁ _ _)
1230
+
· exact absurd hw₁ (witnessSetUntaken_not_orig S_Ψ ψ₁ _ _)
1231
+
· -- Both witnesses. See `witnessSet_version_pinning` below.
1232
+
exact witnessSet_version_pinning hres ⟨p₁, ψ₁, hd₁, hw₁⟩ ⟨p₂, ψ₂, hd₂, hw₂⟩
1233
+
1234
+
end PackageCalculus.PkgFormula
+139
PackageCalculus/Extensions/PackageFormula/Reduction/Definition.lean
+139
PackageCalculus/Extensions/PackageFormula/Reduction/Definition.lean
···
1
+
import PackageCalculus.Extensions.PackageFormula.Definition
2
+
import PackageCalculus.Extensions.Conflict.Reduction.Definition
3
+
4
+
/-! # Package-formula extension: reduction
5
+
6
+
Translates a package-level Boolean formula into core dependencies by walking
7
+
the formula tree and introducing fresh names for each conjunct, disjunct, and
8
+
negation. -/
9
+
10
+
namespace PackageCalculus.PkgFormula
11
+
12
+
variable {N : Type*} {V : Type*}
13
+
14
+
inductive PFName (N V : Type*) where
15
+
| orig : N → PFName N V
16
+
| disjunct : Formula N V → Formula N V → PFName N V
17
+
| negDep : N → Finset V → PFName N V
18
+
deriving DecidableEq
19
+
20
+
variable {N' : Type*} [DecidableEq N'] {V' : Type*} [DecidableEq V']
21
+
variable [hpn : HasPFNames N V N'] [hpv : Conflict.HasConflictVersions V V']
22
+
23
+
def embedPkg (p : Package N V) : Package N' V' :=
24
+
(hpn.origN p.1, hpv.origV p.2)
25
+
26
+
def embedVS (vs : Finset V) : Finset V' :=
27
+
vs.map hpv.origV
28
+
29
+
/-- Negation triples so De Morgan transformations strictly decrease weight. -/
30
+
def Formula.weight : Formula N V → Nat
31
+
| .dep _ _ => 0
32
+
| .conj ψ₁ ψ₂ => ψ₁.weight + ψ₂.weight + 2
33
+
| .disj ψ₁ ψ₂ => ψ₁.weight + ψ₂.weight + 2
34
+
| .neg ψ => 3 * (ψ.weight + 1)
35
+
36
+
/-- Encoding function E: negation handled by inlining De Morgan / double-negation cases. -/
37
+
def encodeNNF (p : Package N' V') :
38
+
(ψ : Formula N V) →
39
+
Finset (Package N' V' × N' × Finset V')
40
+
| .dep n vs =>
41
+
{ (p, hpn.origN n, embedVS vs) }
42
+
| .conj ψ_L ψ_R =>
43
+
encodeNNF p ψ_L ∪ encodeNNF p ψ_R
44
+
| .disj ψ_L ψ_R =>
45
+
{ (p, hpn.disjunctN ψ_L ψ_R, {hpv.zeroV, hpv.oneV}) } ∪
46
+
encodeNNF (hpn.disjunctN ψ_L ψ_R, hpv.zeroV) ψ_L ∪
47
+
encodeNNF (hpn.disjunctN ψ_L ψ_R, hpv.oneV) ψ_R
48
+
| .neg (.dep n vs) =>
49
+
{ (p, hpn.syntheticN n vs, ({hpv.oneV} : Finset V')) } ∪
50
+
vs.image (fun u => ((hpn.origN n, hpv.origV u),
51
+
hpn.syntheticN n vs, ({hpv.zeroV} : Finset V')))
52
+
| .neg (.conj ψ_L ψ_R) =>
53
+
encodeNNF p (.disj (.neg ψ_L) (.neg ψ_R))
54
+
| .neg (.disj ψ_L ψ_R) =>
55
+
encodeNNF p (.conj (.neg ψ_L) (.neg ψ_R))
56
+
| .neg (.neg ψ) =>
57
+
encodeNNF p ψ
58
+
termination_by ψ => ψ.weight
59
+
decreasing_by all_goals simp only [Formula.weight]; omega
60
+
61
+
def encode (p : Package N' V')
62
+
(ψ : Formula N V) :
63
+
Finset (Package N' V' × N' × Finset V') :=
64
+
encodeNNF p ψ
65
+
66
+
/-- Collect all witness packages generated by encoding a formula. -/
67
+
def witnessPackages (p : Package N' V') :
68
+
(ψ : Formula N V) → Finset (Package N' V')
69
+
| .dep _ _ => ∅
70
+
| .conj ψ_L ψ_R =>
71
+
witnessPackages p ψ_L ∪ witnessPackages p ψ_R
72
+
| .disj ψ_L ψ_R =>
73
+
{(hpn.disjunctN ψ_L ψ_R, hpv.zeroV), (hpn.disjunctN ψ_L ψ_R, hpv.oneV)} ∪
74
+
witnessPackages (hpn.disjunctN ψ_L ψ_R, hpv.zeroV) ψ_L ∪
75
+
witnessPackages (hpn.disjunctN ψ_L ψ_R, hpv.oneV) ψ_R
76
+
| .neg (.dep n vs) =>
77
+
{(hpn.syntheticN n vs, hpv.zeroV), (hpn.syntheticN n vs, hpv.oneV)}
78
+
| .neg (.conj ψ_L ψ_R) =>
79
+
witnessPackages p (.disj (.neg ψ_L) (.neg ψ_R))
80
+
| .neg (.disj ψ_L ψ_R) =>
81
+
witnessPackages p (.conj (.neg ψ_L) (.neg ψ_R))
82
+
| .neg (.neg ψ) =>
83
+
witnessPackages p ψ
84
+
termination_by ψ => ψ.weight
85
+
decreasing_by all_goals simp only [Formula.weight]; omega
86
+
87
+
variable [DecidableEq N] [DecidableEq V]
88
+
89
+
def pfReal (R_Ψ : Real N V) (Δ_Ψ : PFDepRel N V) : Real N' V' :=
90
+
R_Ψ.image embedPkg ∪
91
+
Δ_Ψ.biUnion (fun ⟨p, ψ⟩ => witnessPackages (embedPkg p) ψ)
92
+
93
+
def pfDeps (Δ_Ψ : PFDepRel N V) : DepRel N' V' :=
94
+
Δ_Ψ.biUnion (fun ⟨p, ψ⟩ => encode (embedPkg p) ψ)
95
+
96
+
end PackageCalculus.PkgFormula
97
+
98
+
namespace PackageCalculus
99
+
100
+
open Function
101
+
102
+
variable {N V : Type*}
103
+
104
+
instance : PkgFormula.HasPFNames N V (PkgFormula.PFName N V) where
105
+
origN := ⟨PkgFormula.PFName.orig, fun _ _ h => PkgFormula.PFName.orig.inj h⟩
106
+
syntheticN := PkgFormula.PFName.negDep
107
+
syntheticN_injective := by
108
+
intro a₁ a₂ b₁ b₂ h
109
+
exact ⟨PkgFormula.PFName.negDep.inj h |>.1,
110
+
PkgFormula.PFName.negDep.inj h |>.2⟩
111
+
origN_ne_syntheticN := fun _ _ _ => nofun
112
+
syntheticN_ne_origN := fun _ _ _ => nofun
113
+
tryOrigN := fun
114
+
| .orig n => some n
115
+
| _ => none
116
+
tryOrigN_origN := fun _ => rfl
117
+
tryOrigN_some := fun n' n h => by
118
+
cases n' with
119
+
| orig m => simp at h; subst h; rfl
120
+
| _ => simp at h
121
+
trySyntheticN := fun
122
+
| .negDep n vs => some (n, vs)
123
+
| _ => none
124
+
trySyntheticN_syntheticN := fun _ _ => rfl
125
+
trySyntheticN_some := fun n' p h => by
126
+
cases n' with
127
+
| negDep n vs => simp at h; obtain ⟨rfl, rfl⟩ := h; rfl
128
+
| _ => simp at h
129
+
disjunctN := PkgFormula.PFName.disjunct
130
+
disjunctN_injective := by
131
+
intro a₁ a₂ b₁ b₂ h
132
+
exact ⟨PkgFormula.PFName.disjunct.inj h |>.1,
133
+
PkgFormula.PFName.disjunct.inj h |>.2⟩
134
+
origN_ne_disjunctN := fun _ _ _ => nofun
135
+
disjunctN_ne_origN := fun _ _ _ => nofun
136
+
disjunctN_ne_syntheticN := fun _ _ _ _ => nofun
137
+
syntheticN_ne_disjunctN := fun _ _ _ _ => nofun
138
+
139
+
end PackageCalculus
+185
PackageCalculus/Extensions/PackageFormula/Reduction/Soundness.lean
+185
PackageCalculus/Extensions/PackageFormula/Reduction/Soundness.lean
···
1
+
import PackageCalculus.Extensions.PackageFormula.Reduction.Definition
2
+
import Mathlib.Data.Finset.Preimage
3
+
4
+
/-! # Package-formula extension: soundness
5
+
6
+
Any core resolution of the formula encoding induces a package-formula
7
+
resolution that satisfies the original formulae. -/
8
+
9
+
namespace PackageCalculus.PkgFormula
10
+
11
+
open Classical
12
+
13
+
variable {N : Type*} {V : Type*} {N' : Type*} {V' : Type*}
14
+
variable [DecidableEq N'] [DecidableEq V']
15
+
variable [hpn : HasPFNames N V N'] [hpv : Conflict.HasConflictVersions V V']
16
+
17
+
omit [DecidableEq N'] [DecidableEq V'] in
18
+
private theorem embedPkg_injective :
19
+
Function.Injective (embedPkg : Package N V → Package N' V') := by
20
+
intro ⟨n₁, v₁⟩ ⟨n₂, v₂⟩ h
21
+
simp only [embedPkg, Prod.mk.injEq] at h
22
+
exact Prod.ext (hpn.origN.injective h.1) (hpv.origV.injective h.2)
23
+
24
+
private noncomputable def preimageS [DecidableEq N] [DecidableEq V]
25
+
(S : Finset (Package N' V')) : Finset (Package N V) :=
26
+
S.preimage embedPkg (Set.InjOn.mono (Set.subset_univ _)
27
+
(Function.Injective.injOn embedPkg_injective))
28
+
29
+
omit [DecidableEq N'] [DecidableEq V'] in
30
+
private theorem mem_preimageS [DecidableEq N] [DecidableEq V]
31
+
{S : Finset (Package N' V')} {p : Package N V} :
32
+
p ∈ preimageS S ↔ embedPkg p ∈ S := by
33
+
simp [preimageS, Finset.mem_preimage]
34
+
35
+
theorem witnessPackages_not_orig
36
+
(p : Package N' V') (ψ : Formula N V) (n : N) (v : V') :
37
+
(hpn.origN n, v) ∉ witnessPackages p ψ := by
38
+
match ψ with
39
+
| .dep _ _ => simp [witnessPackages]
40
+
| .conj ψ_L ψ_R =>
41
+
simp only [witnessPackages, Finset.mem_union]
42
+
push_neg
43
+
exact ⟨witnessPackages_not_orig p ψ_L n v, witnessPackages_not_orig p ψ_R n v⟩
44
+
| .disj ψ_L ψ_R =>
45
+
simp only [witnessPackages, Finset.mem_union, Finset.mem_insert, Finset.mem_singleton,
46
+
Prod.mk.injEq]
47
+
push_neg
48
+
exact ⟨⟨⟨fun h => absurd h (hpn.origN_ne_disjunctN _ _ _),
49
+
fun h => absurd h (hpn.origN_ne_disjunctN _ _ _)⟩,
50
+
witnessPackages_not_orig _ ψ_L n v⟩,
51
+
witnessPackages_not_orig _ ψ_R n v⟩
52
+
| .neg (.dep n' vs) =>
53
+
simp only [witnessPackages, Finset.mem_insert, Finset.mem_singleton, Prod.mk.injEq]
54
+
push_neg
55
+
exact ⟨fun h => absurd h (hpn.origN_ne_syntheticN _ _ _),
56
+
fun h => absurd h (hpn.origN_ne_syntheticN _ _ _)⟩
57
+
| .neg (.conj ψ_L ψ_R) =>
58
+
have key : witnessPackages p (.neg (.conj ψ_L ψ_R)) =
59
+
witnessPackages p (.disj (.neg ψ_L) (.neg ψ_R)) := by simp [witnessPackages]
60
+
rw [key]; exact witnessPackages_not_orig p (.disj (.neg ψ_L) (.neg ψ_R)) n v
61
+
| .neg (.disj ψ_L ψ_R) =>
62
+
have key : witnessPackages p (.neg (.disj ψ_L ψ_R)) =
63
+
witnessPackages p (.conj (.neg ψ_L) (.neg ψ_R)) := by simp [witnessPackages]
64
+
rw [key]; exact witnessPackages_not_orig p (.conj (.neg ψ_L) (.neg ψ_R)) n v
65
+
| .neg (.neg ψ') =>
66
+
have key : witnessPackages p (.neg (.neg ψ')) = witnessPackages p ψ' := by
67
+
simp [witnessPackages]
68
+
rw [key]; exact witnessPackages_not_orig p ψ' n v
69
+
termination_by ψ.weight
70
+
decreasing_by all_goals simp only [Formula.weight]; omega
71
+
72
+
private theorem embedPkg_mem_pfReal [DecidableEq N] [DecidableEq V]
73
+
{p : Package N V} {R_Ψ : Real N V} {Δ_Ψ : PFDepRel N V}
74
+
(h : embedPkg p ∈ pfReal R_Ψ Δ_Ψ) : p ∈ R_Ψ := by
75
+
simp only [pfReal, Finset.mem_union, Finset.mem_image, Finset.mem_biUnion] at h
76
+
rcases h with ⟨q, hqR, hqeq⟩ | ⟨a, haΔ, hmem⟩
77
+
· have := embedPkg_injective hqeq; subst this; exact hqR
78
+
· exfalso
79
+
exact witnessPackages_not_orig (embedPkg a.1) a.2 p.1 (hpv.origV p.2) hmem
80
+
81
+
private def encode_satisfies [DecidableEq N] [DecidableEq V]
82
+
{R : Real N' V'}
83
+
{Δ : DepRel N' V'}
84
+
{r : Package N' V'}
85
+
{S : Finset (Package N' V')}
86
+
(hres : IsResolution R Δ r S)
87
+
(q : Package N' V')
88
+
(ψ : Formula N V)
89
+
(henc : ∀ d, d ∈ encodeNNF q ψ → d ∈ Δ) (hq : q ∈ S) :
90
+
(preimageS S) ⊨ ψ := by
91
+
match ψ with
92
+
| .dep n vs =>
93
+
simp only [encodeNNF] at henc
94
+
have hd := henc _ (Finset.mem_singleton.mpr rfl)
95
+
obtain ⟨w, hw, hwS⟩ := hres.dep_closure _ hq _ _ hd
96
+
rw [embedVS, Finset.mem_map] at hw
97
+
obtain ⟨v, hv, rfl⟩ := hw
98
+
exact ⟨v, hv, mem_preimageS.mpr hwS⟩
99
+
| .conj ψ_L ψ_R =>
100
+
simp only [encodeNNF] at henc
101
+
exact ⟨encode_satisfies hres q ψ_L
102
+
(fun d hd => henc d (Finset.mem_union.mpr (Or.inl hd))) hq,
103
+
encode_satisfies hres q ψ_R
104
+
(fun d hd => henc d (Finset.mem_union.mpr (Or.inr hd))) hq⟩
105
+
| .disj ψ_L ψ_R =>
106
+
simp only [encodeNNF] at henc
107
+
have hd : (q, hpn.disjunctN ψ_L ψ_R,
108
+
({hpv.zeroV, hpv.oneV} : Finset _)) ∈ Δ :=
109
+
henc _ (Finset.mem_union.mpr (Or.inl (Finset.mem_union.mpr (Or.inl
110
+
(Finset.mem_singleton.mpr rfl)))))
111
+
obtain ⟨w, hw, hwS⟩ := hres.dep_closure _ hq _ _ hd
112
+
simp only [Finset.mem_insert, Finset.mem_singleton] at hw
113
+
rcases hw with rfl | rfl
114
+
· left
115
+
exact encode_satisfies hres _ ψ_L
116
+
(fun d hd' => henc d (Finset.mem_union.mpr (Or.inl (Finset.mem_union.mpr (Or.inr hd'))))) hwS
117
+
· right
118
+
exact encode_satisfies hres _ ψ_R
119
+
(fun d hd' => henc d (Finset.mem_union.mpr (Or.inr hd'))) hwS
120
+
| .neg (.dep n vs) =>
121
+
simp only [encodeNNF] at henc
122
+
have hd : (q, hpn.syntheticN n vs,
123
+
({hpv.oneV} : Finset V')) ∈ Δ :=
124
+
henc _ (Finset.mem_union.mpr (Or.inl (Finset.mem_singleton.mpr rfl)))
125
+
obtain ⟨w, hw, hwS⟩ := hres.dep_closure _ hq _ _ hd
126
+
simp only [Finset.mem_singleton] at hw; subst hw
127
+
intro ⟨v, hv, hvS⟩
128
+
rw [mem_preimageS] at hvS
129
+
have hd2 : ((hpn.origN n, hpv.origV v),
130
+
hpn.syntheticN n vs, ({hpv.zeroV} : Finset V')) ∈ Δ :=
131
+
henc _ (Finset.mem_union.mpr (Or.inr (Finset.mem_image.mpr ⟨v, hv, rfl⟩)))
132
+
obtain ⟨w2, hw2, hw2S⟩ := hres.dep_closure _ hvS _ _ hd2
133
+
simp only [Finset.mem_singleton] at hw2; subst hw2
134
+
exact absurd (hres.version_unique _ _ _ hwS hw2S) hpv.oneV_ne_zeroV
135
+
| .neg (.conj ψ_L ψ_R) =>
136
+
have key : encodeNNF q (.neg (.conj ψ_L ψ_R)) = encodeNNF q (.disj (.neg ψ_L) (.neg ψ_R)) := by
137
+
simp [encodeNNF]
138
+
have h := encode_satisfies hres q (.disj (.neg ψ_L) (.neg ψ_R))
139
+
(fun d hd => henc d (key ▸ hd)) hq
140
+
simp only [Formula.satisfies] at h ⊢
141
+
exact not_and_or.mpr h
142
+
| .neg (.disj ψ_L ψ_R) =>
143
+
have key : encodeNNF q (.neg (.disj ψ_L ψ_R)) = encodeNNF q (.conj (.neg ψ_L) (.neg ψ_R)) := by
144
+
simp [encodeNNF]
145
+
have h := encode_satisfies hres q (.conj (.neg ψ_L) (.neg ψ_R))
146
+
(fun d hd => henc d (key ▸ hd)) hq
147
+
simp only [Formula.satisfies] at h ⊢
148
+
exact not_or.mpr h
149
+
| .neg (.neg ψ') =>
150
+
have key : encodeNNF q (.neg (.neg ψ')) = encodeNNF q ψ' := by
151
+
simp [encodeNNF]
152
+
have h := encode_satisfies hres q ψ' (fun d hd => henc d (key ▸ hd)) hq
153
+
simp only [Formula.satisfies]
154
+
exact not_not_intro h
155
+
termination_by ψ.weight
156
+
decreasing_by all_goals simp only [Formula.weight]; omega
157
+
158
+
-- Paper Thm 4.5.5 (Package Formula Reduction Soundness).
159
+
theorem pkgFormula_soundness [DecidableEq N] [DecidableEq V]
160
+
(R_Ψ : Real N V) (Δ_Ψ : PFDepRel N V)
161
+
(r : Package N V)
162
+
(S : Finset (Package N' V'))
163
+
(hres : IsResolution (pfReal R_Ψ Δ_Ψ) (pfDeps Δ_Ψ) (embedPkg r) S) :
164
+
IsPFResolution R_Ψ Δ_Ψ r (preimageS S) := by
165
+
refine ⟨?_, ?_, ?_, ?_⟩
166
+
· -- subset: orig-named packages in pfReal come only from R_Ψ
167
+
intro p hp
168
+
rw [mem_preimageS] at hp
169
+
exact embedPkg_mem_pfReal (hres.subset hp)
170
+
· -- root_mem
171
+
exact mem_preimageS.mpr hres.root_mem
172
+
· -- formula_closure: by encode_satisfies
173
+
intro p hp ψ hdep
174
+
rw [mem_preimageS] at hp
175
+
have henc : ∀ d, d ∈ encodeNNF (embedPkg p) ψ → d ∈ pfDeps Δ_Ψ := by
176
+
intro d hd
177
+
simp only [pfDeps, Finset.mem_biUnion]
178
+
exact ⟨⟨p, ψ⟩, hdep, hd⟩
179
+
exact encode_satisfies hres (embedPkg p) ψ henc hp
180
+
· -- version_unique
181
+
intro n v v' hv hv'
182
+
rw [mem_preimageS] at hv hv'
183
+
exact hpv.origV.injective (hres.version_unique _ _ _ hv hv')
184
+
185
+
end PackageCalculus.PkgFormula
+28
PackageCalculus/Extensions/PeerDependency/Definition.lean
+28
PackageCalculus/Extensions/PeerDependency/Definition.lean
···
1
+
import PackageCalculus.Extensions.Concurrent.Definition
2
+
3
+
/-! # Peer-dependency extension: definitions
4
+
5
+
A `PeerRel` lets a parent constrain which version of a peer name its children
6
+
may use. Builds on the concurrent extension via `IsPeerResolution`. -/
7
+
8
+
namespace PackageCalculus.PeerDep
9
+
10
+
variable {N : Type*} [DecidableEq N] {V : Type*} [DecidableEq V] {G : Type*}
11
+
12
+
/-- p Θ (n, vs) means a parent of p can only depend on peer n with a version in vs. -/
13
+
abbrev PeerRel (N V : Type*) [DecidableEq N] [DecidableEq V] :=
14
+
Finset (Package N V × N × Finset V)
15
+
16
+
structure IsPeerResolution
17
+
(R : Real N V) (Δ : DepRel N V)
18
+
(Θ : PeerRel N V) (g : V → G) (r : Package N V)
19
+
(S : Finset (Package N V)) (π : Finset (Package N V × Package N V)) : Prop where
20
+
concurrent : Concurrent.IsConcurrentResolution R Δ g r S π
21
+
/-- If p has peer dep on n, and p's parent q depends on n, the version selected by q via π
22
+
must be in the peer constraint. -/
23
+
peer_satisfaction : ∀ p ∈ S, ∀ n : N, ∀ vs : Finset V,
24
+
(p, n, vs) ∈ Θ →
25
+
∀ q, (p, q) ∈ π → ∀ us : Finset V, (q, n, us) ∈ Δ →
26
+
∀ w, w ∈ us → (n, w) ∈ S → ((n, w), q) ∈ π → w ∈ vs
27
+
28
+
end PackageCalculus.PeerDep
+53
PackageCalculus/Extensions/PeerDependency/Lifting/Completeness.lean
+53
PackageCalculus/Extensions/PeerDependency/Lifting/Completeness.lean
···
1
+
import PackageCalculus.Extensions.PeerDependency.Lifting.Definition
2
+
3
+
namespace PackageCalculus.PeerDep
4
+
5
+
open PackageCalculus Concurrent
6
+
7
+
set_option linter.unusedSectionVars false
8
+
9
+
variable {N : Type*} [DecidableEq N] {V : Type*} [DecidableEq V] {G : Type*} [DecidableEq G]
10
+
variable {N' : Type*} [DecidableEq N'] {V' : Type*} [DecidableEq V']
11
+
variable [hcnm : HasConcurrentNames N V G N'] [hcvr : HasConcurrentVersions V G V']
12
+
13
+
theorem liftResolution_completenessWitness (S_Θ : Finset (Package N V))
14
+
(π : Finset (Package N V × Package N V))
15
+
(Δ_C : DepRel N V) (g : V → G) :
16
+
liftResolution g (completenessWitness S_Θ π Δ_C g) = S_Θ := by
17
+
ext p
18
+
simp only [mem_liftResolution, completenessWitness, Finset.mem_union, Finset.mem_image,
19
+
Finset.mem_biUnion, Concurrent.embedPkg]
20
+
constructor
21
+
· intro h
22
+
rcases h with ⟨⟨n, v⟩, hqS, heq⟩ | ⟨a, haΔ, hmem⟩
23
+
· simp only [Prod.mk.injEq] at heq
24
+
obtain ⟨h1, h2⟩ := heq
25
+
have ⟨hn, _⟩ := hcnm.granularN_injective h1
26
+
have hv := hcvr.origV.injective h2
27
+
exact (Prod.ext hn hv : (n, v) = p) ▸ hqS
28
+
· obtain ⟨⟨n, v⟩, m, vs⟩ := a
29
+
simp only at hmem
30
+
split at hmem
31
+
case isTrue h =>
32
+
simp only [Finset.mem_image, Finset.mem_filter, Prod.mk.injEq] at hmem
33
+
obtain ⟨_, _, ⟨heq, _⟩⟩ := hmem
34
+
exact absurd heq.symm (hcnm.granularN_ne_intermediateN _ _ _ _ _)
35
+
case isFalse => exact (List.mem_nil_iff _ |>.mp hmem).elim
36
+
· intro hp
37
+
exact Or.inl ⟨p, hp, rfl⟩
38
+
39
+
theorem liftResolution_completeness
40
+
(R_C : Real N V) (Δ_C : DepRel N V) (Θ : PeerRel N V)
41
+
(g : V → G) (r : Package N V)
42
+
(S_Θ : Finset (Package N V))
43
+
(π : Finset (Package N V × Package N V))
44
+
(hres : IsPeerResolution R_C Δ_C Θ g r S_Θ π)
45
+
(hfunc : ∀ p m vs₁ vs₂, (p, m, vs₁) ∈ Δ_C → (p, m, vs₂) ∈ Δ_C → vs₁ = vs₂) :
46
+
∃ S', IsResolution (peerReal R_C Δ_C Θ g) (peerDeps Δ_C Θ g)
47
+
(Concurrent.embedPkg g r) S' ∧ liftResolution g S' = S_Θ :=
48
+
⟨completenessWitness S_Θ π Δ_C g,
49
+
peer_completeness R_C Δ_C Θ g r S_Θ π hres hfunc,
50
+
liftResolution_completenessWitness S_Θ π Δ_C g⟩
51
+
52
+
53
+
end PackageCalculus.PeerDep
+93
PackageCalculus/Extensions/PeerDependency/Lifting/Definition.lean
+93
PackageCalculus/Extensions/PeerDependency/Lifting/Definition.lean
···
1
+
import PackageCalculus.Extensions.PeerDependency.Reduction.Completeness
2
+
import PackageCalculus.Extensions.PeerDependency.Reduction.Soundness
3
+
4
+
namespace PackageCalculus.PeerDep
5
+
6
+
open PackageCalculus Concurrent
7
+
8
+
set_option linter.unusedSectionVars false
9
+
10
+
variable {N : Type*} [DecidableEq N] {V : Type*} [DecidableEq V] {G : Type*} [DecidableEq G]
11
+
variable {N' : Type*} [DecidableEq N'] {V' : Type*} [DecidableEq V']
12
+
variable [hcnm : HasConcurrentNames N V G N'] [hcvr : HasConcurrentVersions V G V']
13
+
14
+
/-! ## Lift functions -/
15
+
16
+
private def embedPkgFn (g : V → G) : Package N V → Package N' V' :=
17
+
fun p => (hcnm.granularN p.1 (g p.2), hcvr.origV p.2)
18
+
19
+
theorem embedPkgFn_injective (g : V → G) :
20
+
Function.Injective (embedPkgFn g : Package N V → Package N' V') := by
21
+
intro ⟨n₁, v₁⟩ ⟨n₂, v₂⟩ h
22
+
simp only [embedPkgFn, Prod.mk.injEq] at h
23
+
obtain ⟨h1, h2⟩ := h
24
+
have ⟨hn, _⟩ := hcnm.granularN_injective h1
25
+
exact Prod.ext hn (hcvr.origV.injective h2)
26
+
27
+
private def tryInvPkg (g : V → G) (p' : Package N' V') : Option (Package N V) :=
28
+
match hcvr.tryOrigV p'.2 with
29
+
| some v =>
30
+
match hcnm.tryGranularN p'.1 with
31
+
| some (n, g') => if g v = g' then some (n, v) else none
32
+
| none => none
33
+
| none => none
34
+
35
+
theorem tryInvPkg_embed (g : V → G) (p : Package N V) :
36
+
tryInvPkg g (Concurrent.embedPkg g p) = some p := by
37
+
simp only [tryInvPkg, Concurrent.embedPkg, hcvr.tryOrigV_origV, hcnm.tryGranularN_granularN,
38
+
ite_true]
39
+
40
+
theorem tryInvPkg_some (g : V → G) {p' : Package N' V'} {p : Package N V}
41
+
(h : p ∈ tryInvPkg g p') : Concurrent.embedPkg g p = p' := by
42
+
obtain ⟨n, v⟩ := p; obtain ⟨n', v'⟩ := p'
43
+
simp only [tryInvPkg, Option.mem_def] at h
44
+
generalize hv : hcvr.tryOrigV v' = ov at h
45
+
generalize hg : hcnm.tryGranularN n' = og at h
46
+
match ov, og with
47
+
| some v₀, some ng =>
48
+
simp only at h
49
+
split at h
50
+
· rename_i heq_g
51
+
simp only [Option.some.injEq, Prod.mk.injEq] at h
52
+
obtain ⟨rfl, rfl⟩ := h
53
+
simp only [Concurrent.embedPkg, Prod.mk.injEq]
54
+
exact ⟨by rw [heq_g]; exact hcnm.tryGranularN_some _ _ hg,
55
+
hcvr.tryOrigV_some _ _ hv⟩
56
+
· simp at h
57
+
| some _, none => simp at h
58
+
| none, _ => simp at h
59
+
60
+
private theorem tryInvPkg_inj (g : V → G) :
61
+
∀ a a' (b : Package N V), b ∈ tryInvPkg g a → b ∈ tryInvPkg g a' → a = a' := by
62
+
intro a a' b ha ha'
63
+
exact (tryInvPkg_some g ha).symm.trans (tryInvPkg_some g ha')
64
+
65
+
def liftReal (g : V → G) (R' : Real N' V') : Real N V :=
66
+
R'.filterMap (tryInvPkg g) (tryInvPkg_inj g)
67
+
68
+
def liftResolution (g : V → G) (S' : Finset (Package N' V')) :
69
+
Finset (Package N V) :=
70
+
S'.filterMap (tryInvPkg g) (tryInvPkg_inj g)
71
+
72
+
/-! ## Membership lemmas -/
73
+
74
+
theorem mem_liftReal {g : V → G} {R' : Real N' V'} {p : Package N V} :
75
+
p ∈ liftReal g R' ↔ Concurrent.embedPkg g p ∈ R' := by
76
+
simp only [liftReal, Finset.mem_filterMap]
77
+
constructor
78
+
· rintro ⟨p', hp', hinv⟩
79
+
have := tryInvPkg_some g (Option.mem_def.mpr hinv)
80
+
rwa [this]
81
+
· intro hp; exact ⟨Concurrent.embedPkg g p, hp, Option.mem_def.mpr (tryInvPkg_embed g p)⟩
82
+
83
+
theorem mem_liftResolution {g : V → G} {S' : Finset (Package N' V')} {p : Package N V} :
84
+
p ∈ liftResolution g S' ↔ Concurrent.embedPkg g p ∈ S' := by
85
+
simp only [liftResolution, Finset.mem_filterMap]
86
+
constructor
87
+
· rintro ⟨p', hp', hinv⟩
88
+
have := tryInvPkg_some g (Option.mem_def.mpr hinv)
89
+
rwa [this]
90
+
· intro hp; exact ⟨Concurrent.embedPkg g p, hp, Option.mem_def.mpr (tryInvPkg_embed g p)⟩
91
+
92
+
93
+
end PackageCalculus.PeerDep
+44
PackageCalculus/Extensions/PeerDependency/Lifting/Retraction.lean
+44
PackageCalculus/Extensions/PeerDependency/Lifting/Retraction.lean
···
1
+
import PackageCalculus.Extensions.PeerDependency.Lifting.Definition
2
+
3
+
namespace PackageCalculus.PeerDep
4
+
5
+
open PackageCalculus Concurrent
6
+
7
+
set_option linter.unusedSectionVars false
8
+
9
+
variable {N : Type*} [DecidableEq N] {V : Type*} [DecidableEq V] {G : Type*} [DecidableEq G]
10
+
variable {N' : Type*} [DecidableEq N'] {V' : Type*} [DecidableEq V']
11
+
variable [hcnm : HasConcurrentNames N V G N'] [hcvr : HasConcurrentVersions V G V']
12
+
13
+
/-! ## Round-trip theorems -/
14
+
15
+
theorem liftReal_peerReal (R : Real N V) (Δ : DepRel N V)
16
+
(Θ : PeerRel N V) (g : V → G) :
17
+
liftReal g (peerReal (N' := N') (V' := V') R Δ Θ g) = R := by
18
+
ext p
19
+
simp only [mem_liftReal, peerReal, Concurrent.embedReal, Finset.mem_union, Finset.mem_image,
20
+
Finset.mem_biUnion]
21
+
constructor
22
+
· intro h
23
+
rcases h with ((⟨q, hqR, heq⟩ | ⟨a, _, hmem⟩) | ⟨a, _, hmem⟩)
24
+
· simp only [Concurrent.embedPkg, Prod.mk.injEq] at heq
25
+
obtain ⟨h1, h2⟩ := heq
26
+
have ⟨hn, _⟩ := hcnm.granularN_injective h1
27
+
have hv := hcvr.origV.injective h2
28
+
exact (Prod.ext hn hv : q = p) ▸ hqR
29
+
· obtain ⟨⟨n, v⟩, m, vs⟩ := a
30
+
simp only [Concurrent.embedPkg, Prod.mk.injEq] at hmem
31
+
obtain ⟨_, _, ⟨h1, _⟩⟩ := hmem
32
+
exact absurd h1 (hcnm.intermediateN_ne_granularN _ _ _ _ _)
33
+
· obtain ⟨⟨n, v⟩, o, us⟩ := a
34
+
simp only [Finset.mem_filter] at hmem
35
+
obtain ⟨u_peer, _, theta_entry, ⟨_, _⟩, hmem'⟩ := hmem
36
+
obtain ⟨_, _, _⟩ := theta_entry
37
+
simp only [Concurrent.embedPkg, Prod.mk.injEq] at hmem'
38
+
obtain ⟨_, _, ⟨h1, _⟩⟩ := hmem'
39
+
exact absurd h1 (hcnm.intermediateN_ne_granularN _ _ _ _ _)
40
+
· intro hp
41
+
exact Or.inl (Or.inl ⟨p, hp, rfl⟩)
42
+
43
+
44
+
end PackageCalculus.PeerDep
+35
PackageCalculus/Extensions/PeerDependency/Lifting/Soundness.lean
+35
PackageCalculus/Extensions/PeerDependency/Lifting/Soundness.lean
···
1
+
import PackageCalculus.Extensions.PeerDependency.Lifting.Definition
2
+
3
+
namespace PackageCalculus.PeerDep
4
+
5
+
open PackageCalculus Concurrent
6
+
7
+
set_option linter.unusedSectionVars false
8
+
9
+
variable {N : Type*} [DecidableEq N] {V : Type*} [DecidableEq V] {G : Type*} [DecidableEq G]
10
+
variable {N' : Type*} [DecidableEq N'] {V' : Type*} [DecidableEq V']
11
+
variable [hcnm : HasConcurrentNames N V G N'] [hcvr : HasConcurrentVersions V G V']
12
+
13
+
/-! ## Lifting soundness & completeness -/
14
+
15
+
theorem liftResolution_soundness
16
+
(R_C : Real N V) (Δ_C : DepRel N V) (Θ : PeerRel N V)
17
+
(g : V → G) (r : Package N V)
18
+
(S' : Finset (Package N' V'))
19
+
(hres : IsResolution (peerReal R_C Δ_C Θ g) (peerDeps Δ_C Θ g)
20
+
(Concurrent.embedPkg g r) S') :
21
+
∃ π, IsPeerResolution R_C Δ_C Θ g r (liftResolution g S') π := by
22
+
have hsound := peer_soundness R_C Δ_C Θ g r S' hres
23
+
suffices heq : liftResolution g S' = S'.preimage (Concurrent.embedPkg g)
24
+
(Set.InjOn.mono (Set.subset_univ _)
25
+
(Function.Injective.injOn (embedPkgFn_injective g))) by
26
+
rw [heq]; exact ⟨_, hsound⟩
27
+
ext p; simp only [liftResolution, Finset.mem_filterMap, Finset.mem_preimage]
28
+
constructor
29
+
· rintro ⟨p', hp', hinv⟩
30
+
have := tryInvPkg_some g (Option.mem_def.mpr hinv)
31
+
rwa [this]
32
+
· intro hp; exact ⟨Concurrent.embedPkg g p, hp, Option.mem_def.mpr (tryInvPkg_embed g p)⟩
33
+
34
+
35
+
end PackageCalculus.PeerDep
+206
PackageCalculus/Extensions/PeerDependency/Reduction/Completeness.lean
+206
PackageCalculus/Extensions/PeerDependency/Reduction/Completeness.lean
···
1
+
import PackageCalculus.Extensions.PeerDependency.Reduction.Definition
2
+
3
+
/-! # Peer-dependency extension: completeness
4
+
5
+
Any peer resolution lifts to a core resolution of the peer-dependency
6
+
encoding. -/
7
+
8
+
namespace PackageCalculus.PeerDep
9
+
10
+
open Classical PackageCalculus
11
+
12
+
set_option linter.unusedSectionVars false
13
+
set_option linter.unusedSimpArgs false
14
+
15
+
variable {N : Type*} {V : Type*} {G : Type*}
16
+
variable {N' : Type*} {V' : Type*}
17
+
variable [DecidableEq N] [DecidableEq V] [DecidableEq G] [DecidableEq N'] [DecidableEq V']
18
+
variable [hcnm : Concurrent.HasConcurrentNames N V G N']
19
+
variable [hcvr : Concurrent.HasConcurrentVersions V G V']
20
+
21
+
def completenessWitness (S_Θ : Finset (Package N V))
22
+
(π : Finset (Package N V × Package N V))
23
+
(Δ_C : DepRel N V) (g : V → G) :
24
+
Finset (Package N' V') :=
25
+
-- Granular packages
26
+
S_Θ.image (fun ⟨n, v⟩ => (hcnm.granularN n (g v), hcvr.origV v)) ∪
27
+
-- Intermediate packages
28
+
(Δ_C.biUnion (fun ⟨⟨n, v⟩, m, vs⟩ =>
29
+
if (n, v) ∈ S_Θ then
30
+
(vs.filter (fun u => (m, u) ∈ S_Θ ∧ ((m, u), (n, v)) ∈ π)).image
31
+
(fun u => (hcnm.intermediateN n v m, hcvr.origV u))
32
+
else ∅))
33
+
34
+
private theorem mem_gran {S_Θ : Finset (Package N V)}
35
+
{π : Finset (Package N V × Package N V)}
36
+
{Δ_C : DepRel N V} {g : V → G}
37
+
{n : N} {v : V} (h : (n, v) ∈ S_Θ) :
38
+
(hcnm.granularN n (g v), hcvr.origV v) ∈
39
+
completenessWitness S_Θ π Δ_C g :=
40
+
Finset.mem_union.mpr (Or.inl (Finset.mem_image.mpr ⟨⟨n, v⟩, h, rfl⟩))
41
+
42
+
private theorem mem_inter {S_Θ : Finset (Package N V)}
43
+
{π : Finset (Package N V × Package N V)}
44
+
{Δ_C : DepRel N V} {g : V → G}
45
+
{n : N} {v : V} {m : N} {vs : Finset V} {u : V}
46
+
(hdep : ((n, v), m, vs) ∈ Δ_C) (hnv : (n, v) ∈ S_Θ)
47
+
(hmu : (m, u) ∈ S_Θ) (hu : u ∈ vs) (hπ : ((m, u), (n, v)) ∈ π) :
48
+
(hcnm.intermediateN n v m, hcvr.origV u) ∈
49
+
completenessWitness S_Θ π Δ_C g := by
50
+
simp only [completenessWitness, Finset.mem_union, Finset.mem_biUnion]
51
+
right
52
+
refine ⟨⟨⟨n, v⟩, m, vs⟩, hdep, ?_⟩
53
+
simp only; rw [if_pos hnv]
54
+
exact Finset.mem_image.mpr ⟨u, Finset.mem_filter.mpr ⟨hu, hmu, hπ⟩, rfl⟩
55
+
56
+
private theorem completenessWitness_mem_cases {S_Θ : Finset (Package N V)}
57
+
{π : Finset (Package N V × Package N V)}
58
+
{Δ_C : DepRel N V} {g : V → G}
59
+
{q : Package N' V'} (hq : q ∈ completenessWitness S_Θ π Δ_C g) :
60
+
(∃ n v, (n, v) ∈ S_Θ ∧ q = (hcnm.granularN n (g v), hcvr.origV v)) ∨
61
+
(∃ n v m vs u, ((n, v), m, vs) ∈ Δ_C ∧ (n, v) ∈ S_Θ ∧
62
+
(m, u) ∈ S_Θ ∧ u ∈ vs ∧ ((m, u), (n, v)) ∈ π ∧
63
+
q = (hcnm.intermediateN n v m, hcvr.origV u)) := by
64
+
simp only [completenessWitness, Finset.mem_union, Finset.mem_image, Finset.mem_biUnion] at hq
65
+
rcases hq with ⟨⟨n, v⟩, hmem, rfl⟩ | ⟨⟨⟨n, v⟩, m, vs⟩, hdep, hmem⟩
66
+
· exact Or.inl ⟨n, v, hmem, rfl⟩
67
+
· right
68
+
simp only at hmem; split at hmem
69
+
case isTrue hnv =>
70
+
simp only [Finset.mem_image, Finset.mem_filter] at hmem
71
+
obtain ⟨u, ⟨hu, hmu, hπ⟩, rfl⟩ := hmem
72
+
exact ⟨n, v, m, vs, u, hdep, hnv, hmu, hu, hπ, rfl⟩
73
+
case isFalse => exact (List.mem_nil_iff _ |>.mp hmem).elim
74
+
75
+
-- Paper Thm 4.3.5 (Peer Dependency Reduction Completeness).
76
+
theorem peer_completeness
77
+
(R_C : Real N V) (Δ_C : DepRel N V)
78
+
(Θ : PeerRel N V) (g : V → G) (r : Package N V)
79
+
(S_Θ : Finset (Package N V))
80
+
(π : Finset (Package N V × Package N V))
81
+
(hres : IsPeerResolution R_C Δ_C Θ g r S_Θ π)
82
+
(hfunc : ∀ p m vs₁ vs₂, (p, m, vs₁) ∈ Δ_C → (p, m, vs₂) ∈ Δ_C → vs₁ = vs₂) :
83
+
IsResolution (peerReal R_C Δ_C Θ g) (peerDeps Δ_C Θ g)
84
+
(Concurrent.embedPkg g r) (completenessWitness S_Θ π Δ_C g) := by
85
+
have hconc := hres.concurrent
86
+
refine ⟨?_, ?_, ?_, ?_⟩
87
+
· -- subset
88
+
intro q hq
89
+
rcases completenessWitness_mem_cases hq with
90
+
⟨n, v, hmem, rfl⟩ | ⟨n, v, m, vs, u, hdep, hnv, hmu, hu, _, rfl⟩
91
+
· simp only [peerReal, Concurrent.embedReal, Finset.mem_union, Finset.mem_image,
92
+
Finset.mem_biUnion]
93
+
left; left; exact ⟨⟨n, v⟩, hconc.subset hmem, rfl⟩
94
+
· simp only [peerReal, Concurrent.embedReal, Finset.mem_union, Finset.mem_image,
95
+
Finset.mem_biUnion]
96
+
left; right
97
+
refine ⟨⟨⟨n, v⟩, m, vs⟩, hdep, ?_⟩
98
+
exact ⟨u, hu, rfl⟩
99
+
· -- root_mem
100
+
obtain ⟨rn, rv⟩ := r
101
+
exact mem_gran hconc.root_mem
102
+
· -- dep_closure
103
+
intro q hq m_dep dep_vs hd
104
+
rcases completenessWitness_mem_cases hq with
105
+
⟨n, v, hmem, rfl⟩ | ⟨n, v, m, vs, u, hdep, hnv, hmu, hu, hπ, rfl⟩
106
+
· -- granular package (granular n (g v), orig v)
107
+
simp only [peerDeps, Finset.mem_union, Finset.mem_image, Finset.mem_biUnion] at hd
108
+
rcases hd with ((⟨a, haΔ, heq⟩ | ⟨a, haΔ, hmem_d⟩) | ⟨a, haΔ, hmem_d⟩)
109
+
· -- depender→intermediate
110
+
obtain ⟨⟨n', v'⟩, m', vs'⟩ := a
111
+
simp only [Prod.mk.injEq] at heq
112
+
obtain ⟨⟨h1, h2⟩, rfl, rfl⟩ := heq
113
+
obtain ⟨rfl, _⟩ := hcnm.granularN_injective h1
114
+
have h2' := hcvr.origV.injective h2; subst h2'
115
+
obtain ⟨u, ⟨huv, hmuS, hmuπ⟩, _⟩ := hconc.parent_closure _ hmem _ _ haΔ
116
+
exact ⟨hcvr.origV u, Finset.mem_map.mpr ⟨u, huv, rfl⟩,
117
+
mem_inter haΔ hmem hmuS huv hmuπ⟩
118
+
· -- intermediate→dependee: source is granular, contradiction
119
+
obtain ⟨⟨n', v'⟩, m', vs'⟩ := a
120
+
simp only [Finset.mem_image, Prod.mk.injEq] at hmem_d
121
+
obtain ⟨_, _, ⟨⟨h1, _⟩, _, _⟩⟩ := hmem_d
122
+
exact absurd h1 (hcnm.intermediateN_ne_granularN _ _ _ _ _)
123
+
· -- peer through intermediate: source is granular, contradiction
124
+
obtain ⟨⟨n', v'⟩, o', us'⟩ := a
125
+
simp only [Finset.mem_biUnion, Finset.mem_filter] at hmem_d
126
+
obtain ⟨u_peer, _, theta_entry, ⟨_, _⟩, hmem'⟩ := hmem_d
127
+
obtain ⟨_, m'', ws''⟩ := theta_entry
128
+
simp only at hmem'; split at hmem'
129
+
case isTrue =>
130
+
simp only [Finset.mem_singleton, Prod.mk.injEq] at hmem'
131
+
obtain ⟨⟨h1, _⟩, _, _⟩ := hmem'
132
+
exact absurd h1 (hcnm.granularN_ne_intermediateN _ _ _ _ _)
133
+
case isFalse => exact (List.mem_nil_iff _ |>.mp hmem').elim
134
+
· -- intermediate package (intermediate n v m, orig u)
135
+
simp only [peerDeps, Finset.mem_union, Finset.mem_image, Finset.mem_biUnion] at hd
136
+
rcases hd with ((⟨a, haΔ, heq⟩ | ⟨a, haΔ, hmem_d⟩) | ⟨a, haΔ, hmem_d⟩)
137
+
· -- depender→intermediate: source is intermediate, contradiction
138
+
obtain ⟨⟨n', v'⟩, m', vs'⟩ := a
139
+
simp only [Prod.mk.injEq] at heq
140
+
obtain ⟨⟨h1, _⟩, _, _⟩ := heq
141
+
exact absurd h1 (hcnm.granularN_ne_intermediateN _ _ _ _ _)
142
+
· -- intermediate→dependee
143
+
obtain ⟨⟨n', v'⟩, m', vs'⟩ := a
144
+
simp only [Finset.mem_image, Prod.mk.injEq] at hmem_d
145
+
obtain ⟨u', hu'v, ⟨⟨h1, h2⟩, rfl, rfl⟩⟩ := hmem_d
146
+
-- h1 : intermediateN n' v' m' = intermediateN n v m, h2 : origV u' = origV u
147
+
obtain ⟨rfl, rfl, rfl⟩ := hcnm.intermediateN_injective _ _ _ _ _ _ h1
148
+
have h2' := hcvr.origV.injective h2; subst h2'
149
+
have hvs := hfunc _ _ _ _ hdep haΔ; subst hvs
150
+
exact ⟨hcvr.origV u', Finset.mem_singleton.mpr rfl, mem_gran hmu⟩
151
+
· -- peer through intermediate
152
+
obtain ⟨⟨n', v'⟩, o', us'⟩ := a
153
+
simp only [Finset.mem_biUnion, Finset.mem_filter] at hmem_d
154
+
obtain ⟨u_peer, hu_peer, ⟨p_th, m_peer, ws_peer⟩, ⟨hΘ, heq_p⟩, hmem'⟩ := hmem_d
155
+
simp only at heq_p hmem'
156
+
subst heq_p
157
+
split at hmem'
158
+
case isTrue hne_cond =>
159
+
simp only [Finset.mem_singleton, Prod.mk.injEq] at hmem'
160
+
obtain ⟨⟨h1, h2⟩, hmdeq, hvseq⟩ := hmem'
161
+
obtain ⟨rfl, rfl, rfl⟩ := hcnm.intermediateN_injective _ _ _ _ _ _ h1
162
+
have h2' := hcvr.origV.injective h2; subst h2'
163
+
subst hmdeq; subst hvseq
164
+
obtain ⟨⟨p_ne, m_ne, vs_ne⟩, hmem_ne⟩ := hne_cond
165
+
rw [Finset.mem_filter] at hmem_ne
166
+
obtain ⟨hdep_ne, hp_eq, hm_eq⟩ := hmem_ne
167
+
simp only at hp_eq hm_eq
168
+
-- hp_eq : p_ne = (n, v), hm_eq : m_ne = m_peer
169
+
subst hp_eq; subst hm_eq
170
+
obtain ⟨w₀, ⟨hw₀v, hw₀S, hw₀π⟩, _⟩ :=
171
+
hconc.parent_closure _ hnv m_ne vs_ne hdep_ne
172
+
have hw₀_peer : w₀ ∈ ws_peer :=
173
+
hres.peer_satisfaction _ hmu m_ne ws_peer hΘ _ hπ vs_ne hdep_ne
174
+
w₀ hw₀v hw₀S hw₀π
175
+
exact ⟨hcvr.origV w₀, Finset.mem_map.mpr ⟨w₀, hw₀_peer, rfl⟩,
176
+
mem_inter hdep_ne hnv hw₀S hw₀v hw₀π⟩
177
+
case isFalse => exact (List.mem_nil_iff _ |>.mp hmem').elim
178
+
· -- version_unique
179
+
intro nm cv₁ cv₂ hv₁ hv₂
180
+
rcases completenessWitness_mem_cases hv₁ with
181
+
⟨n₁, v₁, hmem₁, heq1⟩ | ⟨n₁, vp₁, m₁, vs₁, u₁, hd₁, hnv₁, hmu₁, hu₁, hπ₁, heq1⟩ <;>
182
+
rcases completenessWitness_mem_cases hv₂ with
183
+
⟨n₂, v₂, hmem₂, heq2⟩ | ⟨n₂, vp₂, m₂, vs₂, u₂, hd₂, hnv₂, hmu₂, hu₂, hπ₂, heq2⟩ <;>
184
+
simp only [Prod.mk.injEq] at heq1 heq2
185
+
· -- granular × granular
186
+
obtain ⟨h1n, rfl⟩ := heq1; obtain ⟨h2n, rfl⟩ := heq2
187
+
obtain ⟨rfl, h1g⟩ := hcnm.granularN_injective (h1n.symm.trans h2n)
188
+
by_contra hne
189
+
have hne' : v₁ ≠ v₂ := fun h => hne (congrArg (⇑hcvr.origV) h)
190
+
exact hconc.version_granularity _ _ _ hmem₁ hmem₂ hne' h1g
191
+
· -- granular × intermediate: name clash
192
+
obtain ⟨h1n, _⟩ := heq1; obtain ⟨h2n, _⟩ := heq2
193
+
exact absurd (h1n.symm.trans h2n) (hcnm.granularN_ne_intermediateN _ _ _ _ _)
194
+
· -- intermediate × granular: name clash
195
+
obtain ⟨h1n, _⟩ := heq1; obtain ⟨h2n, _⟩ := heq2
196
+
exact absurd (h1n.symm.trans h2n) (hcnm.intermediateN_ne_granularN _ _ _ _ _)
197
+
· -- intermediate × intermediate
198
+
obtain ⟨h1n, rfl⟩ := heq1; obtain ⟨h2n, rfl⟩ := heq2
199
+
obtain ⟨rfl, rfl, rfl⟩ := hcnm.intermediateN_injective _ _ _ _ _ _ (h1n.symm.trans h2n)
200
+
have hvs := hfunc (n₁, vp₁) m₁ vs₁ vs₂ hd₁ hd₂; subst hvs
201
+
obtain ⟨w, _, huniq⟩ := hconc.parent_closure _ hnv₁ _ _ hd₁
202
+
have h1 := huniq u₁ ⟨hu₁, hmu₁, hπ₁⟩
203
+
have h2 := huniq u₂ ⟨hu₂, hmu₂, hπ₂⟩
204
+
exact congrArg (⇑hcvr.origV) (h1.trans h2.symm)
205
+
206
+
end PackageCalculus.PeerDep
+55
PackageCalculus/Extensions/PeerDependency/Reduction/Definition.lean
+55
PackageCalculus/Extensions/PeerDependency/Reduction/Definition.lean
···
1
+
import PackageCalculus.Extensions.PeerDependency.Definition
2
+
import PackageCalculus.Extensions.Concurrent.Reduction.Definition
3
+
4
+
/-! # Peer-dependency extension: reduction
5
+
6
+
Encodes peer constraints by chaining concurrent intermediates with extra
7
+
dependencies that propagate the parent's version choice. -/
8
+
9
+
namespace PackageCalculus.PeerDep
10
+
11
+
open PackageCalculus.Concurrent PackageCalculus
12
+
13
+
variable {N : Type*} {V : Type*} {G : Type*}
14
+
variable {N' : Type*} {V' : Type*}
15
+
variable [hcnm : HasConcurrentNames N V G N'] [hcvr : HasConcurrentVersions V G V']
16
+
variable [DecidableEq N] [DecidableEq V] [DecidableEq G] [DecidableEq N'] [DecidableEq V']
17
+
18
+
def peerReal (R_C : Real N V) (Delta : DepRel N V)
19
+
(Theta : PeerRel N V) (g : V → G) :
20
+
Real N' V' :=
21
+
-- Granular packages
22
+
embedReal R_C g ∪
23
+
-- Intermediate packages: one version per dependee version
24
+
(Delta.biUnion (fun ⟨⟨n, v⟩, m, vs⟩ =>
25
+
vs.image (fun u => (hcnm.intermediateN n v m, hcvr.origV u)))) ∪
26
+
-- Peer intermediate: versions from peer constraint
27
+
(Delta.biUnion (fun ⟨⟨n, v⟩, o, us⟩ =>
28
+
us.biUnion (fun u =>
29
+
(Theta.filter (fun ⟨p, _, _⟩ => p = (o, u))).biUnion (fun ⟨_, m, ws⟩ =>
30
+
ws.image (fun w => (hcnm.intermediateN n v m, hcvr.origV w))))))
31
+
32
+
def peerDeps (Delta_C : DepRel N V) (Theta : PeerRel N V) (g : V → G) :
33
+
DepRel N' V' :=
34
+
-- Depender to intermediate
35
+
(Delta_C.image (fun ⟨⟨n, v⟩, m, vs⟩ =>
36
+
((hcnm.granularN n (g v), hcvr.origV v),
37
+
hcnm.intermediateN n v m,
38
+
vs.map hcvr.origV))) ∪
39
+
-- Intermediate to dependee
40
+
(Delta_C.biUnion (fun ⟨⟨n, v⟩, m, vs⟩ =>
41
+
vs.image (fun u =>
42
+
((hcnm.intermediateN n v m, hcvr.origV u),
43
+
hcnm.granularN m (g u),
44
+
{hcvr.origV u})))) ∪
45
+
-- Peer dep through intermediate (only when parent has dep on peer target)
46
+
(Delta_C.biUnion (fun ⟨⟨n, v⟩, o, us⟩ =>
47
+
us.biUnion (fun u =>
48
+
(Theta.filter (fun ⟨p, _, _⟩ => p = (o, u))).biUnion (fun ⟨_, m, ws⟩ =>
49
+
if Delta_C.filter (fun ⟨p, m', _⟩ => p = (n, v) ∧ m' = m) |>.Nonempty then
50
+
{((hcnm.intermediateN n v o, hcvr.origV u),
51
+
hcnm.intermediateN n v m,
52
+
ws.map hcvr.origV)}
53
+
else ∅))))
54
+
55
+
end PackageCalculus.PeerDep
+193
PackageCalculus/Extensions/PeerDependency/Reduction/Soundness.lean
+193
PackageCalculus/Extensions/PeerDependency/Reduction/Soundness.lean
···
1
+
import PackageCalculus.Extensions.PeerDependency.Reduction.Definition
2
+
import Mathlib.Data.Finset.Preimage
3
+
4
+
/-! # Peer-dependency extension: soundness
5
+
6
+
Any core resolution of the peer-dependency encoding induces a peer
7
+
resolution of the original problem. -/
8
+
9
+
namespace PackageCalculus.PeerDep
10
+
11
+
open Classical PackageCalculus
12
+
13
+
set_option linter.unusedSectionVars false
14
+
15
+
variable {N : Type*} {V : Type*} {G : Type*}
16
+
variable {N' : Type*} {V' : Type*}
17
+
variable [DecidableEq N] [DecidableEq V] [DecidableEq G] [DecidableEq N'] [DecidableEq V']
18
+
variable [hcnm : Concurrent.HasConcurrentNames N V G N']
19
+
variable [hcvr : Concurrent.HasConcurrentVersions V G V']
20
+
21
+
private theorem embedPkg_injective (g : V → G) :
22
+
Function.Injective (Concurrent.embedPkg (N := N) (N' := N') (V' := V') g) := by
23
+
intro ⟨n₁, v₁⟩ ⟨n₂, v₂⟩ h
24
+
simp only [Concurrent.embedPkg, Prod.mk.injEq] at h
25
+
obtain ⟨h1, h2⟩ := h
26
+
have ⟨hn, _⟩ := hcnm.granularN_injective h1
27
+
have hv := hcvr.origV.injective h2
28
+
exact Prod.ext hn hv
29
+
30
+
private noncomputable def preimageS (g : V → G) (S : Finset (Package N' V')) :
31
+
Finset (Package N V) :=
32
+
S.preimage (Concurrent.embedPkg g) (Set.InjOn.mono (Set.subset_univ _)
33
+
(Function.Injective.injOn (embedPkg_injective g)))
34
+
35
+
private theorem mem_preimageS {g : V → G} {S : Finset (Package N' V')} {p : Package N V} :
36
+
p ∈ preimageS g S ↔ Concurrent.embedPkg g p ∈ S := by
37
+
simp [preimageS, Finset.mem_preimage]
38
+
39
+
/-- Construct the parent-witness relation π as a Finset from Δ_C and S. -/
40
+
private def soundnessπ (Δ_C : DepRel N V) (g : V → G)
41
+
(S : Finset (Package N' V')) : Finset (Package N V × Package N V) :=
42
+
Δ_C.biUnion (fun ⟨⟨n, v⟩, m, vs⟩ =>
43
+
vs.filter (fun u =>
44
+
(hcnm.intermediateN n v m, hcvr.origV u) ∈ S ∧
45
+
(hcnm.granularN n (g v), hcvr.origV v) ∈ S)
46
+
|>.image (fun u => ((m, u), (n, v))))
47
+
48
+
private theorem mem_soundnessπ {Δ_C : DepRel N V} {g : V → G}
49
+
{S : Finset (Package N' V')} {pair : Package N V × Package N V} :
50
+
pair ∈ soundnessπ Δ_C g S ↔
51
+
∃ n v m vs u, ((n, v), m, vs) ∈ Δ_C ∧
52
+
(hcnm.granularN n (g v), hcvr.origV v) ∈ S ∧
53
+
u ∈ vs ∧
54
+
(hcnm.intermediateN n v m, hcvr.origV u) ∈ S ∧
55
+
pair = ((m, u), (n, v)) := by
56
+
simp only [soundnessπ, Finset.mem_biUnion, Finset.mem_image, Finset.mem_filter]
57
+
constructor
58
+
· rintro ⟨⟨⟨n, v⟩, m, vs⟩, hdep, u, ⟨huv, hintS, hvS⟩, rfl⟩
59
+
exact ⟨n, v, m, vs, u, hdep, hvS, huv, hintS, rfl⟩
60
+
· rintro ⟨n, v, m, vs, u, hdep, hvS, huv, hintS, rfl⟩
61
+
exact ⟨⟨⟨n, v⟩, m, vs⟩, hdep, u, ⟨huv, hintS, hvS⟩, rfl⟩
62
+
63
+
private theorem embedPkg_mem_peerReal {g : V → G} {p : Package N V}
64
+
{R_C : Real N V} {Δ_C : DepRel N V} {Θ : PeerRel N V}
65
+
(h : Concurrent.embedPkg g p ∈ peerReal (N' := N') (V' := V') R_C Δ_C Θ g) : p ∈ R_C := by
66
+
simp only [peerReal, Concurrent.embedReal, Finset.mem_union, Finset.mem_image,
67
+
Finset.mem_biUnion] at h
68
+
rcases h with ((⟨q, hqR, heq⟩ | ⟨a, _, hmem⟩) | ⟨a, _, hmem⟩)
69
+
· simp only [Concurrent.embedPkg, Prod.mk.injEq] at heq
70
+
obtain ⟨h1, h2⟩ := heq
71
+
have ⟨hn, _⟩ := hcnm.granularN_injective h1
72
+
have hv := hcvr.origV.injective h2
73
+
exact (Prod.ext hn hv : q = p) ▸ hqR
74
+
· -- biUnion of intermediates
75
+
obtain ⟨⟨n, v⟩, m, vs⟩ := a
76
+
simp only [Concurrent.embedPkg, Prod.mk.injEq] at hmem
77
+
obtain ⟨_, _, ⟨h1, _⟩⟩ := hmem
78
+
exact absurd h1 (hcnm.intermediateN_ne_granularN _ _ _ _ _)
79
+
· -- peer biUnion of intermediates
80
+
obtain ⟨⟨n, v⟩, o, us⟩ := a
81
+
simp only [Finset.mem_filter] at hmem
82
+
obtain ⟨u_peer, _, ⟨theta_entry, ⟨hΘ, _⟩, hmem'⟩⟩ := hmem
83
+
obtain ⟨_, m_peer, ws_peer⟩ := theta_entry
84
+
simp only [Concurrent.embedPkg, Prod.mk.injEq] at hmem'
85
+
obtain ⟨_, _, ⟨h1, _⟩⟩ := hmem'
86
+
exact absurd h1 (hcnm.intermediateN_ne_granularN _ _ _ _ _)
87
+
88
+
private theorem mem_peerDeps_dep2int {Δ_C : DepRel N V} {Θ : PeerRel N V} {g : V → G}
89
+
{n : N} {v : V} {m : N} {vs : Finset V}
90
+
(hdep : ((n, v), m, vs) ∈ Δ_C) :
91
+
((hcnm.granularN n (g v), hcvr.origV v),
92
+
hcnm.intermediateN n v m,
93
+
vs.map hcvr.origV) ∈ peerDeps (N' := N') (V' := V') Δ_C Θ g := by
94
+
simp only [peerDeps, Finset.mem_union, Finset.mem_image]
95
+
left; left
96
+
exact ⟨⟨⟨n, v⟩, m, vs⟩, hdep, rfl⟩
97
+
98
+
private theorem mem_peerDeps_int2dep {Δ_C : DepRel N V} {Θ : PeerRel N V} {g : V → G}
99
+
{n : N} {v : V} {m : N} {vs : Finset V} {u₀ : V}
100
+
(hdep : ((n, v), m, vs) ∈ Δ_C) (hu₀ : u₀ ∈ vs) :
101
+
((hcnm.intermediateN n v m, hcvr.origV u₀),
102
+
hcnm.granularN m (g u₀),
103
+
{hcvr.origV u₀}) ∈ peerDeps (N' := N') (V' := V') Δ_C Θ g := by
104
+
simp only [peerDeps, Finset.mem_union, Finset.mem_biUnion, Finset.mem_image]
105
+
left; right
106
+
exact ⟨⟨⟨n, v⟩, m, vs⟩, hdep, u₀, hu₀, rfl⟩
107
+
108
+
private theorem mem_peerDeps_peer {Δ_C : DepRel N V} {Θ : PeerRel N V} {g : V → G}
109
+
{qn : N} {qv : V} {on : N} {vs₁ : Finset V} {m' : N} {ws' : Finset V} {ou : V}
110
+
(hdep₁ : ((qn, qv), on, vs₁) ∈ Δ_C)
111
+
(hu₁v : ou ∈ vs₁)
112
+
(hpeer : ((on, ou), m', ws') ∈ Θ)
113
+
(hparent : ∃ vs₂, ((qn, qv), m', vs₂) ∈ Δ_C) :
114
+
((hcnm.intermediateN qn qv on, hcvr.origV ou),
115
+
hcnm.intermediateN qn qv m',
116
+
ws'.map hcvr.origV) ∈ peerDeps (N' := N') (V' := V') Δ_C Θ g := by
117
+
simp only [peerDeps, Finset.mem_union, Finset.mem_biUnion, Finset.mem_filter, Finset.mem_image]
118
+
right
119
+
obtain ⟨vs₂, hdep₂⟩ := hparent
120
+
refine ⟨⟨⟨qn, qv⟩, on, vs₁⟩, hdep₁, ou, hu₁v,
121
+
⟨⟨(on, ou), m', ws'⟩, ⟨hpeer, rfl⟩, ?_⟩⟩
122
+
simp only
123
+
have hne : (Δ_C.filter (fun ⟨p, m'', _⟩ => p = (qn, qv) ∧ m'' = m')).Nonempty :=
124
+
⟨⟨(qn, qv), m', vs₂⟩, Finset.mem_filter.mpr ⟨hdep₂, rfl, rfl⟩⟩
125
+
rw [if_pos hne]
126
+
exact Finset.mem_singleton.mpr rfl
127
+
128
+
-- Paper Thm 4.3.4 (Peer Dependency Reduction Soundness).
129
+
theorem peer_soundness
130
+
(R_C : Real N V) (Δ_C : DepRel N V)
131
+
(Θ : PeerRel N V) (g : V → G) (r : Package N V)
132
+
(S : Finset (Package N' V'))
133
+
(hres : IsResolution (peerReal R_C Δ_C Θ g) (peerDeps Δ_C Θ g)
134
+
(Concurrent.embedPkg g r) S) :
135
+
IsPeerResolution R_C Δ_C Θ g r (preimageS g S) (soundnessπ Δ_C g S) := by
136
+
refine ⟨⟨?_, ?_, ?_, ?_⟩, ?_⟩
137
+
· -- subset
138
+
intro p hp
139
+
rw [mem_preimageS] at hp
140
+
exact embedPkg_mem_peerReal (hres.subset hp)
141
+
· -- root_mem
142
+
rw [mem_preimageS]
143
+
exact hres.root_mem
144
+
· -- parent_closure
145
+
intro ⟨pn, pv⟩ hp m vs hdep
146
+
rw [mem_preimageS] at hp
147
+
have hd1 := mem_peerDeps_dep2int (Θ := Θ) (g := g) hdep
148
+
obtain ⟨cv₀, hcv₀v, hcv₀S⟩ := hres.dep_closure _ hp _ _ hd1
149
+
rw [Finset.mem_map] at hcv₀v
150
+
obtain ⟨u₀, hu₀v, rfl⟩ := hcv₀v
151
+
-- (intermediate pn pv m, orig u₀) ∈ S
152
+
have hd2 := mem_peerDeps_int2dep (Θ := Θ) (g := g) hdep hu₀v
153
+
obtain ⟨w, hwu, hwS⟩ := hres.dep_closure _ hcv₀S _ _ hd2
154
+
rw [Finset.mem_singleton] at hwu; subst hwu
155
+
-- hwS : (granular m (g u₀), orig u₀) ∈ S
156
+
refine ⟨u₀, ?_, ?_⟩
157
+
· refine ⟨hu₀v, mem_preimageS.mpr hwS, ?_⟩
158
+
rw [mem_soundnessπ]
159
+
exact ⟨pn, pv, m, vs, u₀, hdep, hp, hu₀v, hcv₀S, rfl⟩
160
+
· intro u' ⟨_, _, hpi'⟩
161
+
rw [mem_soundnessπ] at hpi'
162
+
obtain ⟨_, _, _, _, _, _, _, _, hintS', heq⟩ := hpi'
163
+
simp only [Prod.mk.injEq] at heq
164
+
obtain ⟨⟨rfl, rfl⟩, rfl, rfl⟩ := heq
165
+
exact hcvr.origV.injective
166
+
(hres.version_unique _ _ _ hintS' hcv₀S)
167
+
· -- version_granularity
168
+
intro n v v' hv hv' hne hge
169
+
rw [mem_preimageS] at hv hv'
170
+
exact hne (hcvr.origV.injective
171
+
(hres.version_unique _ _ _ (hge ▸ hv) hv'))
172
+
· -- peer_satisfaction
173
+
intro ⟨on, ou⟩ hou m' ws' hpeer ⟨qn, qv⟩ hπ_mem us' hdep_q w hw_us hw_S hw_π
174
+
rw [mem_preimageS] at hou hw_S
175
+
rw [mem_soundnessπ] at hπ_mem hw_π
176
+
-- From ((on, ou), (qn, qv)) ∈ π
177
+
obtain ⟨_, _, _, vs₁, _, hdep₁, _, hu₁v, hintS₁, heq₁⟩ := hπ_mem
178
+
simp only [Prod.mk.injEq] at heq₁
179
+
obtain ⟨⟨rfl, rfl⟩, rfl, rfl⟩ := heq₁
180
+
-- From ((m', w), (qn, qv)) ∈ π
181
+
obtain ⟨_, _, _, vs₂, _, hdep₂, _, _, hintS₂, heq₂⟩ := hw_π
182
+
simp only [Prod.mk.injEq] at heq₂
183
+
obtain ⟨⟨rfl, rfl⟩, rfl, rfl⟩ := heq₂
184
+
-- Peer dep edge
185
+
have hd_peer := mem_peerDeps_peer (g := g) hdep₁ hu₁v hpeer ⟨vs₂, hdep₂⟩
186
+
obtain ⟨w₁, hw₁_ws, hw₁_S⟩ := hres.dep_closure _ hintS₁ _ _ hd_peer
187
+
rw [Finset.mem_map] at hw₁_ws
188
+
obtain ⟨w₁', hw₁'_ws, rfl⟩ := hw₁_ws
189
+
have hveq := hcvr.origV.injective
190
+
(hres.version_unique _ _ _ hintS₂ hw₁_S)
191
+
exact hveq ▸ hw₁'_ws
192
+
193
+
end PackageCalculus.PeerDep
+39
PackageCalculus/Extensions/Singular.lean
+39
PackageCalculus/Extensions/Singular.lean
···
1
+
import PackageCalculus.Core.Definition
2
+
import Mathlib.Data.Finset.Image
3
+
4
+
/-! # Singular dependencies
5
+
6
+
Dependencies pinned to a single `(package, required-package)` pair, together
7
+
with `IsSingularResolution` and a reduction to the core calculus. -/
8
+
9
+
namespace PackageCalculus.Singular
10
+
11
+
variable {N : Type*} [DecidableEq N] {V : Type*} [DecidableEq V]
12
+
13
+
/-- Singular dependency relation: (package, required-package). -/
14
+
abbrev SingularRel (N V : Type*) [DecidableEq N] [DecidableEq V] :=
15
+
Finset (Package N V × Package N V)
16
+
17
+
structure IsSingularResolution
18
+
(R : Real N V) (beta : SingularRel N V)
19
+
(r : Package N V) (S : Finset (Package N V)) : Prop where
20
+
subset : S ⊆ R
21
+
root_mem : r ∈ S
22
+
dep_closure : ∀ p ∈ S, ∀ d, (p, d) ∈ beta → d ∈ S
23
+
version_unique : VersionUnique S
24
+
25
+
def singularToCore (beta : SingularRel N V) : DepRel N V :=
26
+
beta.image fun ⟨p, q⟩ => (p, q.1, ({q.2} : Finset V))
27
+
28
+
theorem singular_is_core (R : Real N V) (beta : SingularRel N V)
29
+
(r : Package N V) (S : Finset (Package N V)) :
30
+
IsSingularResolution R beta r S → IsResolution R (singularToCore beta) r S := by
31
+
intro ⟨hsub, hroot, hdep, huniq⟩
32
+
refine ⟨hsub, hroot, fun p hp m vs hmem => ?_, huniq⟩
33
+
simp only [singularToCore, Finset.mem_image] at hmem
34
+
obtain ⟨⟨p', n, v⟩, hbeta, heq⟩ := hmem
35
+
simp only [Prod.mk.injEq] at heq
36
+
obtain ⟨rfl, rfl, rfl⟩ := heq
37
+
exact ⟨v, Finset.mem_singleton.mpr rfl, hdep _ hp (n, v) hbeta⟩
38
+
39
+
end PackageCalculus.Singular
+126
PackageCalculus/Extensions/VariableFormula/Definition.lean
+126
PackageCalculus/Extensions/VariableFormula/Definition.lean
···
1
+
import PackageCalculus.Extensions.PackageFormula.Definition
2
+
import PackageCalculus.Extensions.Conflict.Definition
3
+
import PackageCalculus.Versions.Formula
4
+
import Mathlib.Logic.Embedding.Basic
5
+
import Mathlib.Data.Finset.Image
6
+
7
+
/-! # Variable-formula extension: definitions
8
+
9
+
Formulae that quantify over package variables and version variables, including
10
+
comparison predicates `x ω y`. Defines `IsVFResolution` and the
11
+
companion notion of a satisfying assignment. -/
12
+
13
+
namespace PackageCalculus.VarFormula
14
+
15
+
open Function PackageCalculus
16
+
17
+
variable {N : Type*} [DecidableEq N] {V : Type*} [DecidableEq V]
18
+
{X : Type*} [DecidableEq X] {Y : Type*} [DecidableEq Y]
19
+
20
+
/-- Boolean formula over package dependencies and variable comparisons.
21
+
22
+
This mirrors `PkgFormula.Formula` with one additional production for variable
23
+
comparisons: `x ω y`. There is a single variable space `X` of variable names
24
+
and a single value space `Y`; package-local variables are obtained by
25
+
user-level namespacing of names in `X`. -/
26
+
inductive Formula (N V X Y : Type*) where
27
+
| dep : N → Finset V → Formula N V X Y
28
+
| conj : Formula N V X Y → Formula N V X Y → Formula N V X Y
29
+
| disj : Formula N V X Y → Formula N V X Y → Formula N V X Y
30
+
| neg : Formula N V X Y → Formula N V X Y
31
+
| varCmp : X → CmpOp → Y → Formula N V X Y
32
+
deriving DecidableEq
33
+
34
+
/-- Variable-formula dependency relation: (package, variable-formula). -/
35
+
abbrev VFDepRel (N V : Type*) [DecidableEq N] [DecidableEq V]
36
+
(X Y : Type*) [DecidableEq X] [DecidableEq Y] :=
37
+
Finset (Package N V × Formula N V X Y)
38
+
39
+
/-- Satisfaction relation `(S, σ) ⊨ ψ`. No depender context: variable
40
+
comparisons are evaluated using the global assignment `σ : X → Y`. -/
41
+
def Formula.satisfies [LT Y] [DecidableRel (· < · : Y → Y → Prop)]
42
+
(S : Finset (Package N V)) (σ : X → Y) : Formula N V X Y → Prop
43
+
| .dep n vs => ∃ v ∈ vs, (n, v) ∈ S
44
+
| .conj ψ₁ ψ₂ => ψ₁.satisfies S σ ∧ ψ₂.satisfies S σ
45
+
| .disj ψ₁ ψ₂ => ψ₁.satisfies S σ ∨ ψ₂.satisfies S σ
46
+
| .neg ψ => ¬ψ.satisfies S σ
47
+
| .varCmp x ω y => ω.eval (σ x) y
48
+
49
+
/-- Satisfaction is decidable: a finite Boolean combination of bounded
50
+
existentials over finite sets and decidable comparison evaluations. -/
51
+
instance Formula.decidableSatisfies [LT Y] [DecidableRel (· < · : Y → Y → Prop)]
52
+
(S : Finset (Package N V)) (σ : X → Y) :
53
+
∀ ψ : Formula N V X Y, Decidable (Formula.satisfies S σ ψ)
54
+
| .dep n vs => inferInstanceAs (Decidable (∃ v ∈ vs, (n, v) ∈ S))
55
+
| .conj ψ₁ ψ₂ =>
56
+
haveI := Formula.decidableSatisfies S σ ψ₁
57
+
haveI := Formula.decidableSatisfies S σ ψ₂
58
+
inferInstanceAs (Decidable (Formula.satisfies S σ ψ₁ ∧ Formula.satisfies S σ ψ₂))
59
+
| .disj ψ₁ ψ₂ =>
60
+
haveI := Formula.decidableSatisfies S σ ψ₁
61
+
haveI := Formula.decidableSatisfies S σ ψ₂
62
+
inferInstanceAs (Decidable (Formula.satisfies S σ ψ₁ ∨ Formula.satisfies S σ ψ₂))
63
+
| .neg ψ =>
64
+
haveI := Formula.decidableSatisfies S σ ψ
65
+
inferInstanceAs (Decidable ¬ Formula.satisfies S σ ψ)
66
+
| .varCmp x ω y => inferInstanceAs (Decidable (ω.eval (σ x) y = true))
67
+
68
+
structure IsVFResolution [LT Y] [DecidableRel (· < · : Y → Y → Prop)]
69
+
(R : Real N V) (Δ_Ψ : VFDepRel N V X Y)
70
+
(r : Package N V) (S : Finset (Package N V))
71
+
(σ : X → Y) : Prop where
72
+
subset : S ⊆ R
73
+
root_mem : r ∈ S
74
+
formula_closure : ∀ p ∈ S, ∀ ψ : Formula N V X Y,
75
+
(p, ψ) ∈ Δ_Ψ → ψ.satisfies S σ
76
+
version_unique : VersionUnique S
77
+
78
+
/-- Names structure for the Variable Formula extension. Single variable name
79
+
embedding `varN : X → N'` (no global/local split). Disjunction witness names
80
+
are per-formula, mirroring PF. -/
81
+
class HasVFNames (N V X Y : Type*) (N' : outParam Type*)
82
+
extends Conflict.HasConflictNames N V N' where
83
+
/-- Synthetic name for a variable `x ∈ X`. -/
84
+
varN : X ↪ N'
85
+
/-- Synthetic name for a disjunction witness (per-formula, inherited from PF). -/
86
+
disjunctN : Formula N V X Y → Formula N V X Y → N'
87
+
disjunctN_injective : Injective2 disjunctN
88
+
origN_ne_varN : ∀ n x, origN n ≠ varN x
89
+
varN_ne_origN : ∀ x n, varN x ≠ origN n
90
+
origN_ne_disjunctN : ∀ n (ψ₁ ψ₂ : Formula N V X Y), origN n ≠ disjunctN ψ₁ ψ₂
91
+
disjunctN_ne_origN : ∀ (ψ₁ ψ₂ : Formula N V X Y) n, disjunctN ψ₁ ψ₂ ≠ origN n
92
+
varN_ne_disjunctN : ∀ x (ψ₁ ψ₂ : Formula N V X Y), varN x ≠ disjunctN ψ₁ ψ₂
93
+
disjunctN_ne_varN : ∀ (ψ₁ ψ₂ : Formula N V X Y) x, disjunctN ψ₁ ψ₂ ≠ varN x
94
+
varN_ne_syntheticN : ∀ x m vs, varN x ≠ syntheticN m vs
95
+
syntheticN_ne_varN : ∀ m vs x, syntheticN m vs ≠ varN x
96
+
disjunctN_ne_syntheticN : ∀ (ψ₁ ψ₂ : Formula N V X Y) m vs,
97
+
disjunctN ψ₁ ψ₂ ≠ syntheticN m vs
98
+
syntheticN_ne_disjunctN : ∀ m vs (ψ₁ ψ₂ : Formula N V X Y),
99
+
syntheticN m vs ≠ disjunctN ψ₁ ψ₂
100
+
101
+
attribute [simp]
102
+
HasVFNames.origN_ne_varN HasVFNames.varN_ne_origN
103
+
HasVFNames.origN_ne_disjunctN HasVFNames.disjunctN_ne_origN
104
+
HasVFNames.varN_ne_disjunctN HasVFNames.disjunctN_ne_varN
105
+
HasVFNames.varN_ne_syntheticN HasVFNames.syntheticN_ne_varN
106
+
HasVFNames.disjunctN_ne_syntheticN HasVFNames.syntheticN_ne_disjunctN
107
+
108
+
/-- Versions structure: embeds variable values `Y` into the core version
109
+
type `V'`. -/
110
+
class HasVFVersions (V Y : Type*) (V' : outParam Type*)
111
+
extends Conflict.HasConflictVersions V V' where
112
+
/-- Embed a variable value into the core version space. -/
113
+
varValV : Y ↪ V'
114
+
origV_ne_varValV : ∀ v y, origV v ≠ varValV y
115
+
varValV_ne_origV : ∀ y v, varValV y ≠ origV v
116
+
zeroV_ne_varValV : ∀ y, zeroV ≠ varValV y
117
+
varValV_ne_zeroV : ∀ y, varValV y ≠ zeroV
118
+
oneV_ne_varValV : ∀ y, oneV ≠ varValV y
119
+
varValV_ne_oneV : ∀ y, varValV y ≠ oneV
120
+
121
+
attribute [simp]
122
+
HasVFVersions.origV_ne_varValV HasVFVersions.varValV_ne_origV
123
+
HasVFVersions.zeroV_ne_varValV HasVFVersions.varValV_ne_zeroV
124
+
HasVFVersions.oneV_ne_varValV HasVFVersions.varValV_ne_oneV
125
+
126
+
end PackageCalculus.VarFormula
+42
PackageCalculus/Extensions/VariableFormula/Lifting/Completeness.lean
+42
PackageCalculus/Extensions/VariableFormula/Lifting/Completeness.lean
···
1
+
import PackageCalculus.Extensions.VariableFormula.Lifting.Definition
2
+
3
+
namespace PackageCalculus.VarFormula
4
+
5
+
variable {N : Type*} [DecidableEq N] {V : Type*} [DecidableEq V]
6
+
{X : Type*} [DecidableEq X] {Y : Type*} [DecidableEq Y]
7
+
variable {N' : Type*} [DecidableEq N'] {V' : Type*} [DecidableEq V']
8
+
variable [hvn : HasVFNames N V X Y N'] [hvv : HasVFVersions V Y V']
9
+
10
+
theorem liftResolution_completenessWitness
11
+
[LT Y] [DecidableRel (· < · : Y → Y → Prop)] [Fintype X]
12
+
(S_Ψ : Finset (Package N V)) (Δ_Ψ : VFDepRel N V X Y)
13
+
(σ : X → Y) :
14
+
liftResolution (X := X) (Y := Y)
15
+
(completenessWitness (N' := N') (V' := V') S_Ψ Δ_Ψ σ) = S_Ψ := by
16
+
apply Finset.ext;
17
+
intro p
18
+
simp [mem_liftResolution, completenessWitness];
19
+
constructor <;> intro h
20
+
all_goals generalize_proofs at *;
21
+
· rcases h with ( ⟨ a, b, h, h' ⟩ | ⟨ a, b, c, h, h' ⟩ | ⟨ a, h ⟩ ) <;> simp_all +decide [ embedPkg ];
22
+
split_ifs at h' <;> [ exact False.elim ( witnessSetTaken_not_orig _ _ _ _ _ h' ) ; exact False.elim ( witnessSetUntaken_not_orig _ _ _ _ h' ) ];
23
+
· exact Or.inl ⟨ p.1, p.2, h, rfl ⟩
24
+
25
+
theorem liftResolution_completeness
26
+
[LT Y] [DecidableRel (· < · : Y → Y → Prop)] [Fintype X]
27
+
(Y_x : X → Finset Y)
28
+
(R_Ψ : Real N V) (Δ_Ψ : VFDepRel N V X Y)
29
+
(r : Package N V) (σ : X → Y)
30
+
(hσ_dom : ∀ x, σ x ∈ Y_x x)
31
+
(S_Ψ : Finset (Package N V))
32
+
(hres : IsVFResolution R_Ψ Δ_Ψ r S_Ψ σ) :
33
+
∃ S', IsResolution (vfReal (N' := N') (V' := V') Y_x R_Ψ Δ_Ψ)
34
+
(vfDeps (N' := N') (V' := V') Y_x Δ_Ψ)
35
+
(embedPkg (X := X) (Y := Y) r) S' ∧
36
+
liftResolution (X := X) (Y := Y) S' = S_Ψ :=
37
+
⟨completenessWitness (N' := N') (V' := V') S_Ψ Δ_Ψ σ,
38
+
varFormula_completeness Y_x R_Ψ Δ_Ψ r σ hσ_dom S_Ψ hres,
39
+
liftResolution_completenessWitness S_Ψ Δ_Ψ σ⟩
40
+
41
+
42
+
end PackageCalculus.VarFormula
+141
PackageCalculus/Extensions/VariableFormula/Lifting/Definition.lean
+141
PackageCalculus/Extensions/VariableFormula/Lifting/Definition.lean
···
1
+
import PackageCalculus.Extensions.VariableFormula.Reduction.Completeness
2
+
import PackageCalculus.Extensions.VariableFormula.Reduction.Soundness
3
+
import Mathlib
4
+
5
+
namespace PackageCalculus.VarFormula
6
+
7
+
variable {N : Type*} [DecidableEq N] {V : Type*} [DecidableEq V]
8
+
{X : Type*} [DecidableEq X] {Y : Type*} [DecidableEq Y]
9
+
variable {N' : Type*} [DecidableEq N'] {V' : Type*} [DecidableEq V']
10
+
variable [hvn : HasVFNames N V X Y N'] [hvv : HasVFVersions V Y V']
11
+
12
+
def embedPkgFn : Package N V → Package N' V' :=
13
+
fun p => (hvn.origN p.1, hvv.origV p.2)
14
+
15
+
omit [DecidableEq N] [DecidableEq V] [DecidableEq X] [DecidableEq Y]
16
+
[DecidableEq N'] [DecidableEq V'] in
17
+
theorem embedPkgFn_eq_embedPkg :
18
+
(embedPkgFn (X := X) (Y := Y) : Package N V → Package N' V') =
19
+
embedPkg (X := X) (Y := Y) :=
20
+
rfl
21
+
22
+
omit [DecidableEq N] [DecidableEq V] [DecidableEq X] [DecidableEq Y]
23
+
[DecidableEq N'] [DecidableEq V'] in
24
+
theorem embedPkgFn_injective :
25
+
Function.Injective (embedPkgFn (X := X) (Y := Y) :
26
+
Package N V → Package N' V') := by
27
+
intro ⟨n₁, v₁⟩ ⟨n₂, v₂⟩ h
28
+
simp only [embedPkgFn, Prod.mk.injEq] at h
29
+
exact Prod.ext (hvn.origN.injective h.1) (hvv.origV.injective h.2)
30
+
31
+
/-! ## Computable inverse helpers -/
32
+
33
+
def tryInvPkg (p : Package N' V') : Option (Package N V) :=
34
+
match hvn.tryOrigN p.1, hvv.tryOrigV p.2 with
35
+
| some n, some v => some (n, v)
36
+
| _, _ => none
37
+
38
+
omit [DecidableEq N] [DecidableEq V] [DecidableEq X] [DecidableEq Y]
39
+
[DecidableEq N'] [DecidableEq V'] in
40
+
private theorem tryInvPkg_inj :
41
+
∀ a a' (b : Package N V), b ∈ tryInvPkg (hvn := hvn) (hvv := hvv) a →
42
+
b ∈ tryInvPkg (hvn := hvn) (hvv := hvv) a' → a = a' := by
43
+
intro a a' ⟨n, v⟩ h1 h2
44
+
simp only [tryInvPkg, Option.mem_def] at h1 h2
45
+
revert h1 h2
46
+
cases hn1 : hvn.tryOrigN a.1 <;> cases hv1 : hvv.tryOrigV a.2 <;> simp (config := { decide := false })
47
+
intro rfl rfl
48
+
cases hn2 : hvn.tryOrigN a'.1 <;> cases hv2 : hvv.tryOrigV a'.2 <;> simp (config := { decide := false })
49
+
intro rfl rfl
50
+
exact Prod.ext
51
+
((hvn.tryOrigN_some _ _ hn1).symm.trans (hvn.tryOrigN_some _ _ hn2))
52
+
((hvv.tryOrigV_some _ _ hv1).symm.trans (hvv.tryOrigV_some _ _ hv2))
53
+
54
+
omit [DecidableEq N] [DecidableEq V] [DecidableEq X] [DecidableEq Y]
55
+
[DecidableEq N'] [DecidableEq V'] in
56
+
theorem tryInvPkg_embed (p : Package N V) :
57
+
tryInvPkg (hvn := hvn) (hvv := hvv) (embedPkgFn (X := X) (Y := Y) p) = some p := by
58
+
simp [tryInvPkg, embedPkgFn, hvn.tryOrigN_origN, hvv.tryOrigV_origV]
59
+
60
+
omit [DecidableEq N] [DecidableEq V] [DecidableEq X] [DecidableEq Y]
61
+
[DecidableEq N'] [DecidableEq V'] in
62
+
theorem tryInvPkg_some {p' : Package N' V'} {p : Package N V}
63
+
(h : p ∈ tryInvPkg (hvn := hvn) (hvv := hvv) p') :
64
+
embedPkgFn (X := X) (Y := Y) p = p' := by
65
+
obtain ⟨n', v'⟩ := p'; obtain ⟨n, v⟩ := p
66
+
simp only [tryInvPkg, Option.mem_def, embedPkgFn] at h ⊢
67
+
generalize htn : hvn.tryOrigN n' = on at h
68
+
generalize htv : hvv.tryOrigV v' = ov at h
69
+
match on, ov with
70
+
| some n₀, some v₀ =>
71
+
simp at h; obtain ⟨rfl, rfl⟩ := h
72
+
show (hvn.origN n₀, hvv.origV v₀) = (n', v')
73
+
rw [hvn.tryOrigN_some _ _ htn, hvv.tryOrigV_some _ _ htv]
74
+
| some _, none => simp at h
75
+
| none, _ => simp at h
76
+
77
+
/-! ## Lift functions -/
78
+
79
+
def liftReal (R' : Real N' V') : Real N V :=
80
+
R'.filterMap (tryInvPkg (X := X) (Y := Y) (hvn := hvn) (hvv := hvv)) tryInvPkg_inj
81
+
82
+
def liftResolution (S' : Finset (Package N' V')) : Finset (Package N V) :=
83
+
S'.filterMap (tryInvPkg (X := X) (Y := Y) (hvn := hvn) (hvv := hvv)) tryInvPkg_inj
84
+
85
+
/-! ## Membership lemmas -/
86
+
87
+
omit [DecidableEq N] [DecidableEq V] [DecidableEq X] [DecidableEq Y]
88
+
[DecidableEq N'] [DecidableEq V'] in
89
+
theorem mem_liftReal {R' : Real N' V'} {p : Package N V} :
90
+
p ∈ liftReal (X := X) (Y := Y) R' ↔ embedPkg (X := X) (Y := Y) p ∈ R' := by
91
+
simp only [liftReal, Finset.mem_filterMap]
92
+
constructor
93
+
· rintro ⟨p', hp', hinv⟩
94
+
have heq := tryInvPkg_some hinv
95
+
rw [embedPkgFn_eq_embedPkg] at heq; rwa [heq]
96
+
· intro hp
97
+
exact ⟨embedPkg (X := X) (Y := Y) p, hp, by
98
+
show p ∈ tryInvPkg (embedPkgFn (X := X) (Y := Y) p)
99
+
rw [tryInvPkg_embed]; rfl⟩
100
+
101
+
omit [DecidableEq N] [DecidableEq V] [DecidableEq X] [DecidableEq Y]
102
+
[DecidableEq N'] [DecidableEq V'] in
103
+
theorem mem_liftResolution {S' : Finset (Package N' V')} {p : Package N V} :
104
+
p ∈ liftResolution (X := X) (Y := Y) S' ↔ embedPkg (X := X) (Y := Y) p ∈ S' := by
105
+
simp only [liftResolution, Finset.mem_filterMap]
106
+
constructor
107
+
· rintro ⟨p', hp', hinv⟩
108
+
have heq := tryInvPkg_some hinv
109
+
rw [embedPkgFn_eq_embedPkg] at heq; rwa [heq]
110
+
· intro hp
111
+
exact ⟨embedPkg (X := X) (Y := Y) p, hp, by
112
+
show p ∈ tryInvPkg (embedPkgFn (X := X) (Y := Y) p)
113
+
rw [tryInvPkg_embed]; rfl⟩
114
+
115
+
/-! ## Auxiliary: witnessPackages and witnessSet produce non-orig names -/
116
+
117
+
omit [DecidableEq N] [DecidableEq V] [DecidableEq X] in
118
+
theorem witnessPackages_not_orig'
119
+
[LT Y] [DecidableRel (· < · : Y → Y → Prop)]
120
+
(p : Package N' V') (ψ : Formula N V X Y) (n : N) (v : V') :
121
+
(hvn.origN n, v) ∉ witnessPackages p ψ := by
122
+
by_contra h_contra;
123
+
induction' h : Formula.weight ψ using Nat.strong_induction_on with w hw generalizing ψ p;
124
+
rcases ψ with ( _ | ⟨ ψ_L, ψ_R ⟩ | ⟨ ψ_L, ψ_R ⟩ | ⟨ x, ω, y ⟩ | ⟨ n, vs ⟩ );
125
+
all_goals simp +decide [ witnessPackages ] at h_contra;
126
+
· rcases h_contra with ( h_contra | h_contra );
127
+
· exact hw _ ( by simp +decide [ Formula.weight ] at h ⊢; linarith ) _ _ h_contra rfl;
128
+
· exact hw _ ( by rw [ show ( ψ_L.conj ψ_R ).weight = ψ_L.weight + ψ_R.weight + 2 from rfl ] at h; linarith ) _ _ h_contra rfl;
129
+
· rcases h_contra with ( h_contra | h_contra );
130
+
· exact hw _ ( by simp +decide [ Formula.weight ] at h ⊢; linarith ) _ _ h_contra rfl;
131
+
· exact hw _ ( by simp +decide [ Formula.weight ] at h ⊢; linarith ) _ _ h_contra rfl;
132
+
· rcases h_contra with ( h_contra | h_contra );
133
+
· exact hw _ ( by simp +decide [ Formula.weight ] at h ⊢; linarith ) _ _ h_contra rfl;
134
+
· exact hw _ ( by simp +decide [ Formula.weight ] at h ⊢; linarith ) _ _ h_contra rfl;
135
+
· rcases h_contra with ( h_contra | h_contra );
136
+
· exact hw _ ( by simp +decide [ Formula.weight ] at h ⊢; linarith ) _ _ h_contra rfl;
137
+
· exact hw _ ( by simp +decide [ Formula.weight ] at h ⊢; linarith ) _ _ h_contra rfl;
138
+
· exact hw _ ( by linarith [ show Formula.weight ‹_› < w from by linarith [ show Formula.weight ( Formula.neg ( Formula.neg ‹_› ) ) = 3 * ( Formula.weight ( Formula.neg ‹_› ) + 1 ) from rfl, show Formula.weight ( Formula.neg ‹_› ) = 3 * ( Formula.weight ‹_› + 1 ) from rfl ] ] ) _ _ h_contra rfl
139
+
140
+
141
+
end PackageCalculus.VarFormula
+22
PackageCalculus/Extensions/VariableFormula/Lifting/Retraction.lean
+22
PackageCalculus/Extensions/VariableFormula/Lifting/Retraction.lean
···
1
+
import PackageCalculus.Extensions.VariableFormula.Lifting.Definition
2
+
3
+
namespace PackageCalculus.VarFormula
4
+
5
+
variable {N : Type*} [DecidableEq N] {V : Type*} [DecidableEq V]
6
+
{X : Type*} [DecidableEq X] {Y : Type*} [DecidableEq Y]
7
+
variable {N' : Type*} [DecidableEq N'] {V' : Type*} [DecidableEq V']
8
+
variable [hvn : HasVFNames N V X Y N'] [hvv : HasVFVersions V Y V']
9
+
10
+
/-! ## Round-trip theorems -/
11
+
12
+
theorem liftReal_vfReal [LT Y] [DecidableRel (· < · : Y → Y → Prop)] [Fintype X]
13
+
(Y_x : X → Finset Y) (R : Real N V) (Δ_Ψ : VFDepRel N V X Y) :
14
+
liftReal (X := X) (Y := Y) (vfReal (N' := N') (V' := V') Y_x R Δ_Ψ) = R := by
15
+
ext p;
16
+
convert mem_liftReal;
17
+
unfold vfReal;
18
+
simp +decide [ embedPkg ];
19
+
exact fun _ _ _ _ h => False.elim ( witnessPackages_not_orig' _ _ _ _ h )
20
+
21
+
22
+
end PackageCalculus.VarFormula
+39
PackageCalculus/Extensions/VariableFormula/Lifting/Soundness.lean
+39
PackageCalculus/Extensions/VariableFormula/Lifting/Soundness.lean
···
1
+
import PackageCalculus.Extensions.VariableFormula.Lifting.Definition
2
+
3
+
namespace PackageCalculus.VarFormula
4
+
5
+
variable {N : Type*} [DecidableEq N] {V : Type*} [DecidableEq V]
6
+
{X : Type*} [DecidableEq X] {Y : Type*} [DecidableEq Y]
7
+
variable {N' : Type*} [DecidableEq N'] {V' : Type*} [DecidableEq V']
8
+
variable [hvn : HasVFNames N V X Y N'] [hvv : HasVFVersions V Y V']
9
+
10
+
/-! ## Lifting soundness & completeness -/
11
+
12
+
theorem liftResolution_soundness
13
+
[LT Y] [DecidableRel (· < · : Y → Y → Prop)] [Fintype X] [Nonempty Y]
14
+
(Y_x : X → Finset Y)
15
+
(R_Ψ : Real N V) (Δ_Ψ : VFDepRel N V X Y)
16
+
(r : Package N V) (S' : Finset (Package N' V'))
17
+
(hres : IsResolution (vfReal Y_x R_Ψ Δ_Ψ) (vfDeps Y_x Δ_Ψ)
18
+
(embedPkg (X := X) (Y := Y) r) S') :
19
+
IsVFResolution R_Ψ Δ_Ψ r (liftResolution (X := X) (Y := Y) S')
20
+
(extractAssignment (N := N) (V := V) (X := X) (Y := Y) S') := by
21
+
have hsound := varFormula_soundness Y_x R_Ψ Δ_Ψ r S' hres
22
+
-- Show liftResolution and preimageS agree
23
+
suffices heq : liftResolution (X := X) (Y := Y) S' =
24
+
S'.preimage (embedPkg (X := X) (Y := Y))
25
+
(Set.InjOn.mono (Set.subset_univ _)
26
+
(Function.Injective.injOn (embedPkgFn_injective (X := X) (Y := Y)))) by
27
+
rw [heq]; exact hsound
28
+
ext p; simp only [liftResolution, Finset.mem_filterMap, Finset.mem_preimage]
29
+
constructor
30
+
· rintro ⟨p', hp', hinv⟩
31
+
have heq := tryInvPkg_some hinv
32
+
rw [embedPkgFn_eq_embedPkg] at heq; rwa [heq]
33
+
· intro hp
34
+
exact ⟨embedPkg (X := X) (Y := Y) p, hp, by
35
+
show p ∈ tryInvPkg (embedPkgFn (X := X) (Y := Y) p)
36
+
rw [tryInvPkg_embed]; rfl⟩
37
+
38
+
39
+
end PackageCalculus.VarFormula
+1409
PackageCalculus/Extensions/VariableFormula/Reduction/Completeness.lean
+1409
PackageCalculus/Extensions/VariableFormula/Reduction/Completeness.lean
···
1
+
import PackageCalculus.Extensions.VariableFormula.Reduction.Definition
2
+
import Mathlib
3
+
4
+
namespace PackageCalculus.VarFormula
5
+
6
+
open Classical
7
+
8
+
variable {N : Type*} {V : Type*} {X : Type*} {Y : Type*}
9
+
variable {N' : Type*} {V' : Type*}
10
+
variable [DecidableEq N'] [DecidableEq V']
11
+
variable [hvn : HasVFNames N V X Y N'] [hvv : HasVFVersions V Y V']
12
+
13
+
/-! ## Dual-context witness construction (paper's `W^⊤ / W^⊥`).
14
+
15
+
Mirrors PF directly. There is no per-depender threading -- disjunction names
16
+
are per-formula, and the variable-comparison case contributes no witnesses
17
+
(`W^c(x ω y) = ∅`). -/
18
+
19
+
def witnessSetUntaken [DecidableEq N] [DecidableEq V] [DecidableEq X]
20
+
[DecidableEq Y] [LT Y] [DecidableRel (· < · : Y → Y → Prop)]
21
+
(S_Ψ : Finset (Package N V)) :
22
+
Formula N V X Y → Finset (Package N' V')
23
+
| .dep _ _ => ∅
24
+
| .conj ψ_L ψ_R =>
25
+
witnessSetUntaken S_Ψ ψ_L ∪ witnessSetUntaken S_Ψ ψ_R
26
+
| .disj ψ_L ψ_R =>
27
+
witnessSetUntaken S_Ψ ψ_L ∪ witnessSetUntaken S_Ψ ψ_R
28
+
| .varCmp _ _ _ => ∅
29
+
| .neg (.dep n vs) =>
30
+
if ∃ u ∈ vs, ((n, u) : Package N V) ∈ S_Ψ
31
+
then {(hvn.syntheticN n vs, hvv.zeroV)}
32
+
else ∅
33
+
| .neg (.varCmp x ω y) =>
34
+
witnessSetUntaken S_Ψ (.varCmp x (CmpOp.complement ω) y)
35
+
| .neg (.conj ψ_L ψ_R) =>
36
+
witnessSetUntaken S_Ψ (.disj (.neg ψ_L) (.neg ψ_R))
37
+
| .neg (.disj ψ_L ψ_R) =>
38
+
witnessSetUntaken S_Ψ (.conj (.neg ψ_L) (.neg ψ_R))
39
+
| .neg (.neg ψ) =>
40
+
witnessSetUntaken S_Ψ ψ
41
+
termination_by ψ => ψ.weight
42
+
decreasing_by all_goals simp only [Formula.weight]; omega
43
+
44
+
def witnessSetTaken [DecidableEq N] [DecidableEq V] [DecidableEq X]
45
+
[DecidableEq Y] [LT Y] [DecidableRel (· < · : Y → Y → Prop)]
46
+
(S_Ψ : Finset (Package N V)) (σ : X → Y) :
47
+
Formula N V X Y → Finset (Package N' V')
48
+
| .dep _ _ => ∅
49
+
| .conj ψ_L ψ_R => witnessSetTaken S_Ψ σ ψ_L ∪ witnessSetTaken S_Ψ σ ψ_R
50
+
| .disj ψ_L ψ_R =>
51
+
if ψ_L.satisfies S_Ψ σ then
52
+
{(hvn.disjunctN ψ_L ψ_R, hvv.zeroV)} ∪
53
+
witnessSetTaken S_Ψ σ ψ_L ∪ witnessSetUntaken S_Ψ ψ_R
54
+
else
55
+
{(hvn.disjunctN ψ_L ψ_R, hvv.oneV)} ∪
56
+
witnessSetUntaken S_Ψ ψ_L ∪ witnessSetTaken S_Ψ σ ψ_R
57
+
| .varCmp _ _ _ => ∅
58
+
| .neg (.dep n vs) => {(hvn.syntheticN n vs, hvv.oneV)}
59
+
| .neg (.varCmp x ω y) =>
60
+
witnessSetTaken S_Ψ σ (.varCmp x (CmpOp.complement ω) y)
61
+
| .neg (.conj ψ_L ψ_R) =>
62
+
witnessSetTaken S_Ψ σ (.disj (.neg ψ_L) (.neg ψ_R))
63
+
| .neg (.disj ψ_L ψ_R) =>
64
+
witnessSetTaken S_Ψ σ (.conj (.neg ψ_L) (.neg ψ_R))
65
+
| .neg (.neg ψ) =>
66
+
witnessSetTaken S_Ψ σ ψ
67
+
termination_by ψ => ψ.weight
68
+
decreasing_by all_goals simp only [Formula.weight]; omega
69
+
70
+
/-- Completeness witness `S`: the original packages, plus formula witnesses
71
+
gated by whether the depender is in `S_Ψ`, plus the variable-assignment
72
+
packages `{(⟨x⟩, σ(x)) | x ∈ X}`. -/
73
+
def completenessWitness [DecidableEq N] [DecidableEq V] [DecidableEq X]
74
+
[DecidableEq Y] [LT Y] [DecidableRel (· < · : Y → Y → Prop)]
75
+
[Fintype X]
76
+
(S_Ψ : Finset (Package N V)) (Δ_Ψ : VFDepRel N V X Y)
77
+
(σ : X → Y) :
78
+
Finset (Package N' V') :=
79
+
S_Ψ.image (embedPkg (X := X) (Y := Y)) ∪
80
+
Δ_Ψ.biUnion (fun ⟨p, ψ⟩ =>
81
+
if p ∈ S_Ψ then witnessSetTaken (N' := N') (V' := V') S_Ψ σ ψ
82
+
else witnessSetUntaken (N' := N') (V' := V') S_Ψ ψ) ∪
83
+
Finset.univ.image (fun x : X => ((hvn.varN x, hvv.varValV (σ x)) : Package N' V'))
84
+
85
+
/-! ## No original-name witnesses (placeholders) -/
86
+
87
+
lemma witnessSetUntaken_not_orig [DecidableEq N] [DecidableEq V] [DecidableEq X]
88
+
[DecidableEq Y] [LT Y] [DecidableRel (· < · : Y → Y → Prop)]
89
+
(S_Ψ : Finset (Package N V)) (ψ : Formula N V X Y) (n : N) (v : V') :
90
+
(hvn.origN n, v) ∉ witnessSetUntaken S_Ψ ψ := by
91
+
induction' h : ψ.weight using Nat.strong_induction_on with w ih generalizing ψ;
92
+
rcases ψ with ( _ | ⟨ ψ₁, ψ₂ ⟩ | ⟨ ψ₁, ψ₂ ⟩ | _ | _ ) <;> simp_all +decide [ Formula.weight ];
93
+
· unfold witnessSetUntaken; simp +decide ;
94
+
· unfold witnessSetUntaken; simp +decide [ Finset.mem_union ] ;
95
+
exact ⟨ ih _ ( by linarith ) _ rfl, ih _ ( by linarith ) _ rfl ⟩;
96
+
· unfold witnessSetUntaken; simp +decide [ Finset.mem_union ] ;
97
+
exact ⟨ ih _ ( by linarith ) _ rfl, ih _ ( by linarith ) _ rfl ⟩;
98
+
· unfold witnessSetUntaken;
99
+
rename_i ψ;
100
+
rcases ψ with ( _ | ⟨ ψ₁, ψ₂ ⟩ | ⟨ ψ₁, ψ₂ ⟩ | _ | _ ) <;> simp_all +decide [ Formula.weight ];
101
+
· split_ifs <;> simp +decide [ hvn.origN_ne_syntheticN ];
102
+
· unfold witnessSetUntaken; simp +decide ;
103
+
constructor <;> apply ih _ _ _ rfl;
104
+
· unfold Formula.weight; simp +decide [ h.symm ] ; omega;
105
+
· unfold Formula.weight; simp +decide [ h.symm ] ; omega;
106
+
· unfold witnessSetUntaken; simp +decide ;
107
+
constructor <;> apply ih _ _ _ rfl;
108
+
· unfold Formula.weight; simp +decide [ h.symm ] ; omega;
109
+
· unfold Formula.weight; simp +decide [ h.symm ] ; omega;
110
+
· exact ih _ ( by linarith ) _ rfl;
111
+
· unfold witnessSetUntaken; simp +decide ;
112
+
· unfold witnessSetUntaken; simp +decide ;
113
+
114
+
lemma witnessSetTaken_not_orig [DecidableEq N] [DecidableEq V] [DecidableEq X]
115
+
[DecidableEq Y] [LT Y] [DecidableRel (· < · : Y → Y → Prop)]
116
+
(S_Ψ : Finset (Package N V)) (σ : X → Y) (ψ : Formula N V X Y) (n : N) (v : V') :
117
+
(hvn.origN n, v) ∉ witnessSetTaken S_Ψ σ ψ := by
118
+
by_contra h_contra;
119
+
induction' h : ψ.weight using Nat.strong_induction_on with w ih generalizing ψ;
120
+
rcases ψ with ( _ | ⟨ ψ_L, ψ_R ⟩ | ⟨ ψ_L, ψ_R ⟩ | xωy | _ );
121
+
· unfold witnessSetTaken at h_contra; simp +decide at h_contra;
122
+
· unfold witnessSetTaken at h_contra;
123
+
simp_all +decide [ Formula.weight ];
124
+
grind;
125
+
· unfold witnessSetTaken at h_contra;
126
+
split_ifs at h_contra <;> simp_all +decide [ Finset.mem_union ];
127
+
· rcases h_contra with ( h_contra | h_contra );
128
+
· exact ih _ ( by simp +decide [ Formula.weight ] at h ⊢; linarith ) _ h_contra rfl;
129
+
· exact witnessSetUntaken_not_orig S_Ψ ψ_R n v h_contra;
130
+
· rcases h_contra with ( h_contra | h_contra );
131
+
· exact absurd ( witnessSetUntaken_not_orig S_Ψ ψ_L n v h_contra ) ( by simp +decide );
132
+
· exact ih _ ( by rw [ show ( ψ_L.disj ψ_R ).weight = ψ_L.weight + ψ_R.weight + 2 by rfl ] at h; linarith ) _ h_contra rfl;
133
+
· rcases xωy with ( _ | ⟨ ψ_L, ψ_R ⟩ | ⟨ ψ_L, ψ_R ⟩ | xωy | _ );
134
+
· unfold witnessSetTaken at h_contra; simp_all +decide [ Formula.weight ] ;
135
+
· unfold witnessSetTaken at h_contra;
136
+
unfold witnessSetTaken at h_contra;
137
+
split_ifs at h_contra <;> simp_all +decide [ Finset.mem_union ];
138
+
· rcases h_contra with ( h_contra | h_contra );
139
+
· exact ih _ ( by simp +decide [ Formula.weight ] at h ⊢; linarith ) _ h_contra rfl;
140
+
· exact absurd h_contra ( witnessSetUntaken_not_orig _ _ _ _ );
141
+
· rcases h_contra with ( h_contra | h_contra );
142
+
· exact absurd h_contra ( witnessSetUntaken_not_orig _ _ _ _ );
143
+
· exact ih _ ( by simp +decide [ Formula.weight ] at h ⊢; linarith ) _ h_contra rfl;
144
+
· unfold witnessSetTaken at h_contra; simp_all +decide ;
145
+
unfold witnessSetTaken at h_contra; simp_all +decide [ Finset.mem_union ] ;
146
+
rcases h_contra with ( h_contra | h_contra ) <;> [ exact ih _ ( by simp +decide [ Formula.weight ] at h ⊢; linarith ) _ h_contra rfl; exact ih _ ( by simp +decide [ Formula.weight ] at h ⊢; linarith ) _ h_contra rfl ];
147
+
· unfold witnessSetTaken at h_contra;
148
+
exact ih _ ( by simp +decide [ Formula.weight ] at h ⊢; linarith ) _ h_contra rfl;
149
+
· unfold witnessSetTaken at h_contra; simp_all +decide ;
150
+
unfold witnessSetTaken at h_contra; simp_all +decide ;
151
+
· unfold witnessSetTaken at h_contra ; aesop
152
+
153
+
lemma witnessSetUntaken_not_varN [DecidableEq N] [DecidableEq V] [DecidableEq X]
154
+
[DecidableEq Y] [LT Y] [DecidableRel (· < · : Y → Y → Prop)]
155
+
(S_Ψ : Finset (Package N V)) (ψ : Formula N V X Y) (x : X) (v : V') :
156
+
(hvn.varN x, v) ∉ witnessSetUntaken S_Ψ ψ := by
157
+
have h_ind : ∀ ψ : Formula N V X Y, ∀ x : X, ∀ v : V', (hvn.varN x, v) ∉ witnessSetUntaken S_Ψ ψ := by
158
+
intro ψ;
159
+
induction' n : ψ.weight using Nat.strong_induction_on with n ih generalizing ψ;
160
+
rcases ψ with ( _ | _ | _ | _ | _ ) <;> simp +decide at ih ⊢;
161
+
· unfold witnessSetUntaken; simp +decide ;
162
+
· unfold witnessSetUntaken; simp +decide ;
163
+
exact fun x v => ⟨ ih _ ( by simp +decide [ Formula.weight ] at n ⊢; linarith ) _ rfl _ _, ih _ ( by simp +decide [ Formula.weight ] at n ⊢; linarith ) _ rfl _ _ ⟩;
164
+
· unfold witnessSetUntaken; simp +decide ;
165
+
exact fun x v => ⟨ ih _ ( by erw [ n.symm ] ; simp +decide [ Formula.weight ] ; linarith ) _ rfl _ _, ih _ ( by erw [ n.symm ] ; simp +decide [ Formula.weight ] ; linarith ) _ rfl _ _ ⟩;
166
+
· unfold witnessSetUntaken;
167
+
cases ‹Formula N V X Y› <;> simp +decide at ih ⊢;
168
+
· split_ifs <;> simp +decide [ hvn.varN_ne_syntheticN ];
169
+
· unfold witnessSetUntaken; simp +decide ;
170
+
exact fun x v => ⟨ ih _ ( by
171
+
simp +decide [ ← n, Formula.weight ];
172
+
exact Nat.le_succ_of_le ( Nat.le_add_right _ _ ) ) _ rfl _ _, ih _ ( by
173
+
simp +decide [ ← n, Formula.weight ];
174
+
exact Nat.le_succ_of_le ( Nat.le_add_left _ _ ) ) _ rfl _ _ ⟩;
175
+
· unfold witnessSetUntaken; simp +decide ;
176
+
exact fun x v => ⟨ ih _ ( by simp +decide [ Formula.weight ] at n ⊢; linarith ) _ rfl _ _, ih _ ( by simp +decide [ Formula.weight ] at n ⊢; linarith ) _ rfl _ _ ⟩;
177
+
· exact ih _ ( by simp +decide [ Formula.weight ] at n ⊢; linarith ) _ rfl;
178
+
· unfold witnessSetUntaken; simp +decide ;
179
+
· unfold witnessSetUntaken; simp +decide ;
180
+
exact h_ind ψ x v
181
+
182
+
lemma witnessSetTaken_not_varN [DecidableEq N] [DecidableEq V] [DecidableEq X]
183
+
[DecidableEq Y] [LT Y] [DecidableRel (· < · : Y → Y → Prop)]
184
+
(S_Ψ : Finset (Package N V)) (σ : X → Y) (ψ : Formula N V X Y) (x : X) (v : V') :
185
+
(hvn.varN x, v) ∉ witnessSetTaken S_Ψ σ ψ := by
186
+
by_contra h_contra;
187
+
induction' h : ψ.weight using Nat.strong_induction_on with w ih generalizing ψ;
188
+
rcases ψ with ( _ | ⟨ ψ_L, ψ_R ⟩ | ⟨ ψ_L, ψ_R ⟩ | xωy | _ );
189
+
· unfold witnessSetTaken at h_contra; simp_all +decide [ Formula.weight ] ;
190
+
· unfold witnessSetTaken at h_contra; simp_all +decide [ Formula.weight ] ;
191
+
rcases h_contra with ( h_contra | h_contra ) <;> [ exact ih _ ( by linarith ) _ h_contra rfl; exact ih _ ( by linarith ) _ h_contra rfl ];
192
+
· unfold witnessSetTaken at h_contra;
193
+
split_ifs at h_contra <;> simp_all +decide [ Finset.mem_union ];
194
+
· rcases h_contra with ( h_contra | h_contra );
195
+
· exact ih _ ( by simp +decide [ Formula.weight ] at h ⊢; linarith ) _ h_contra rfl;
196
+
· exact absurd ( witnessSetUntaken_not_varN S_Ψ ψ_R x v h_contra ) ( by simp +decide );
197
+
· rcases h_contra with ( h_contra | h_contra );
198
+
· exact absurd ( witnessSetUntaken_not_varN S_Ψ ψ_L x v h_contra ) ( by simp +decide );
199
+
· exact ih _ ( by simp +decide [ Formula.weight ] at h ⊢; linarith ) _ h_contra rfl;
200
+
· rcases xωy with ( _ | ⟨ ψ_L, ψ_R ⟩ | ⟨ ψ_L, ψ_R ⟩ | xωy | _ );
201
+
· unfold witnessSetTaken at h_contra; simp_all +decide [ Formula.weight ] ;
202
+
· unfold witnessSetTaken at h_contra; simp_all +decide ;
203
+
unfold witnessSetTaken at h_contra; simp_all +decide ;
204
+
split_ifs at h_contra <;> simp_all +decide [ Finset.mem_union ];
205
+
· rcases h_contra with ( h_contra | h_contra );
206
+
· exact ih _ ( by simp +decide [ Formula.weight ] at h ⊢; linarith ) _ h_contra rfl;
207
+
· exact absurd ( witnessSetUntaken_not_varN S_Ψ ψ_R.neg x v h_contra ) ( by simp +decide );
208
+
· rcases h_contra with ( h_contra | h_contra );
209
+
· exact absurd ( witnessSetUntaken_not_varN S_Ψ ψ_L.neg x v h_contra ) ( by simp +decide );
210
+
· exact ih _ ( by simp +decide [ Formula.weight ] at h ⊢; linarith ) _ h_contra rfl;
211
+
· unfold witnessSetTaken at h_contra; simp_all +decide ;
212
+
unfold witnessSetTaken at h_contra; simp_all +decide [ Finset.mem_union ] ;
213
+
rcases h_contra with ( h_contra | h_contra ) <;> [ exact ih _ ( by simp +decide [ Formula.weight ] at h ⊢; linarith ) _ h_contra rfl; exact ih _ ( by simp +decide [ Formula.weight ] at h ⊢; linarith ) _ h_contra rfl ];
214
+
· unfold witnessSetTaken at h_contra; simp_all +decide [ Formula.weight ] ;
215
+
exact ih _ ( by linarith ) _ h_contra rfl;
216
+
· unfold witnessSetTaken at h_contra; simp_all +decide [ Formula.weight ] ;
217
+
unfold witnessSetTaken at h_contra; simp_all +decide ;
218
+
· unfold witnessSetTaken at h_contra; simp +decide at h_contra;
219
+
220
+
/-! ## Subset of witnessPackages -/
221
+
222
+
lemma witnessSetUntaken_subset_witnessPackages [DecidableEq N] [DecidableEq V] [DecidableEq X]
223
+
[DecidableEq Y] [LT Y] [DecidableRel (· < · : Y → Y → Prop)]
224
+
(S_Ψ : Finset (Package N V)) (p : Package N' V') (ψ : Formula N V X Y) :
225
+
witnessSetUntaken (N' := N') (V' := V') S_Ψ ψ ⊆ witnessPackages p ψ := by
226
+
induction' n : ψ.weight using Nat.strong_induction_on with n ih generalizing ψ p S_Ψ;
227
+
rcases ψ with ( _ | ⟨ ψ₁, ψ₂ ⟩ | ⟨ ψ₁, ψ₂ ⟩ | ⟨ x, ω, y ⟩ | ⟨ n, vs ⟩ );
228
+
all_goals unfold witnessSetUntaken witnessPackages; simp +decide [ Finset.subset_iff ];
229
+
any_goals intro a b hab; exact ih _ ( by simp +decide [ Formula.weight ] at n ⊢; linarith ) _ _ _ rfl hab;
230
+
· rintro a b ( h | h ) <;> [ exact Or.inl ( ih _ ( by simp +decide [ Formula.weight ] at n ⊢; linarith ) _ _ _ rfl h ) ; exact Or.inr ( ih _ ( by simp +decide [ Formula.weight ] at n ⊢; linarith ) _ _ _ rfl h ) ];
231
+
· rintro a b ( h | h ) <;> [ exact Or.inr ( Or.inr ( Or.inl ( ih _ ( by simp +decide [ Formula.weight ] at n ⊢; linarith ) _ _ _ rfl h ) ) ) ; exact Or.inr ( Or.inr ( Or.inr ( ih _ ( by simp +decide [ Formula.weight ] at n ⊢; linarith ) _ _ _ rfl h ) ) ) ];
232
+
· split_ifs <;> simp_all +decide [ Finset.subset_iff ]
233
+
234
+
lemma witnessSetTaken_subset_witnessPackages [DecidableEq N] [DecidableEq V] [DecidableEq X]
235
+
[DecidableEq Y] [LT Y] [DecidableRel (· < · : Y → Y → Prop)]
236
+
(S_Ψ : Finset (Package N V)) (σ : X → Y) (p : Package N' V') (ψ : Formula N V X Y) :
237
+
witnessSetTaken (N' := N') (V' := V') S_Ψ σ ψ ⊆ witnessPackages p ψ := by
238
+
intro q hq
239
+
match ψ with
240
+
| .dep _ _ => simp [witnessSetTaken] at hq
241
+
| .conj ψ_L ψ_R =>
242
+
unfold witnessSetTaken at hq; unfold witnessPackages
243
+
simp only [Finset.mem_union] at hq ⊢
244
+
exact hq.elim
245
+
(fun h => Or.inl (witnessSetTaken_subset_witnessPackages S_Ψ σ p ψ_L h))
246
+
(fun h => Or.inr (witnessSetTaken_subset_witnessPackages S_Ψ σ p ψ_R h))
247
+
| .disj ψ_L ψ_R =>
248
+
show q ∈ witnessPackages p (.disj ψ_L ψ_R)
249
+
unfold witnessSetTaken at hq
250
+
split at hq
251
+
· simp only [Finset.mem_union, Finset.mem_singleton] at hq
252
+
rcases hq with (rfl | hL) | hU
253
+
· unfold witnessPackages; simp [Finset.mem_union, Finset.mem_insert]
254
+
· have h1 := witnessSetTaken_subset_witnessPackages S_Ψ σ
255
+
(hvn.disjunctN ψ_L ψ_R, hvv.zeroV) ψ_L hL
256
+
unfold witnessPackages
257
+
exact Finset.mem_union_left _ (Finset.mem_union_right _ h1)
258
+
· have h1 := witnessSetUntaken_subset_witnessPackages S_Ψ
259
+
(hvn.disjunctN ψ_L ψ_R, hvv.oneV) ψ_R hU
260
+
unfold witnessPackages
261
+
exact Finset.mem_union_right _ h1
262
+
· simp only [Finset.mem_union, Finset.mem_singleton] at hq
263
+
rcases hq with (rfl | hU) | hR
264
+
· unfold witnessPackages; simp [Finset.mem_union, Finset.mem_insert]
265
+
· have h1 := witnessSetUntaken_subset_witnessPackages S_Ψ
266
+
(hvn.disjunctN ψ_L ψ_R, hvv.zeroV) ψ_L hU
267
+
unfold witnessPackages
268
+
exact Finset.mem_union_left _ (Finset.mem_union_right _ h1)
269
+
· have h1 := witnessSetTaken_subset_witnessPackages S_Ψ σ
270
+
(hvn.disjunctN ψ_L ψ_R, hvv.oneV) ψ_R hR
271
+
unfold witnessPackages
272
+
exact Finset.mem_union_right _ h1
273
+
| .varCmp _ _ _ => simp [witnessSetTaken] at hq
274
+
| .neg (.dep n vs) =>
275
+
unfold witnessSetTaken at hq; unfold witnessPackages
276
+
simp only [Finset.mem_singleton] at hq; subst hq
277
+
simp [Finset.mem_insert]
278
+
| .neg (.varCmp x ω y) =>
279
+
have key_t : witnessSetTaken (N' := N') (V' := V') S_Ψ σ (.neg (.varCmp x ω y)) =
280
+
witnessSetTaken S_Ψ σ (.varCmp x (CmpOp.complement ω) y) := by
281
+
simp [witnessSetTaken]
282
+
have key_w : witnessPackages (hvn := hvn) (hvv := hvv) p
283
+
(Formula.neg (Formula.varCmp x ω y) : Formula N V X Y) =
284
+
witnessPackages p
285
+
(Formula.varCmp x (CmpOp.complement ω) y : Formula N V X Y) := by
286
+
simp [witnessPackages]
287
+
rw [key_t] at hq; rw [key_w]
288
+
exact witnessSetTaken_subset_witnessPackages S_Ψ σ p _ hq
289
+
| .neg (.conj ψ_L ψ_R) =>
290
+
have key_t : witnessSetTaken (N' := N') (V' := V') S_Ψ σ (.neg (.conj ψ_L ψ_R)) =
291
+
witnessSetTaken S_Ψ σ (.disj (.neg ψ_L) (.neg ψ_R)) := by
292
+
simp [witnessSetTaken]
293
+
have key_w : witnessPackages (hvn := hvn) (hvv := hvv) p (.neg (.conj ψ_L ψ_R)) =
294
+
witnessPackages p (.disj (.neg ψ_L) (.neg ψ_R)) := by
295
+
simp [witnessPackages]
296
+
rw [key_t] at hq; rw [key_w]
297
+
exact witnessSetTaken_subset_witnessPackages S_Ψ σ p _ hq
298
+
| .neg (.disj ψ_L ψ_R) =>
299
+
have key_t : witnessSetTaken (N' := N') (V' := V') S_Ψ σ (.neg (.disj ψ_L ψ_R)) =
300
+
witnessSetTaken S_Ψ σ (.conj (.neg ψ_L) (.neg ψ_R)) := by
301
+
simp [witnessSetTaken]
302
+
have key_w : witnessPackages (hvn := hvn) (hvv := hvv) p (.neg (.disj ψ_L ψ_R)) =
303
+
witnessPackages p (.conj (.neg ψ_L) (.neg ψ_R)) := by
304
+
simp [witnessPackages]
305
+
rw [key_t] at hq; rw [key_w]
306
+
exact witnessSetTaken_subset_witnessPackages S_Ψ σ p _ hq
307
+
| .neg (.neg ψ') =>
308
+
have key_t : witnessSetTaken (N' := N') (V' := V') S_Ψ σ (.neg (.neg ψ')) =
309
+
witnessSetTaken S_Ψ σ ψ' := by
310
+
simp [witnessSetTaken]
311
+
have key_w : witnessPackages (hvn := hvn) (hvv := hvv) p (.neg (.neg ψ')) =
312
+
witnessPackages p ψ' := by
313
+
simp [witnessPackages]
314
+
rw [key_t] at hq; rw [key_w]
315
+
exact witnessSetTaken_subset_witnessPackages S_Ψ σ p _ hq
316
+
termination_by ψ.weight
317
+
decreasing_by all_goals simp only [Formula.weight]; omega
318
+
319
+
/-! ## Equational lemmas for `witnessSetTaken` / `witnessSetUntaken` -/
320
+
321
+
section UnfoldEqs
322
+
323
+
set_option linter.unusedSectionVars false
324
+
325
+
variable [DecidableEq N] [DecidableEq V] [DecidableEq X] [DecidableEq Y]
326
+
[LT Y] [DecidableRel (· < · : Y → Y → Prop)]
327
+
[DecidableEq N'] [DecidableEq V']
328
+
[hvn : HasVFNames N V X Y N'] [hvv : HasVFVersions V Y V']
329
+
(S_Ψ : Finset (Package N V)) (σ : X → Y)
330
+
331
+
lemma witnessSetTaken_dep (n : N) (vs : Finset V) :
332
+
(witnessSetTaken S_Ψ σ (.dep n vs : Formula N V X Y) : Finset (Package N' V')) = ∅ :=
333
+
witnessSetTaken.eq_1 S_Ψ σ n vs
334
+
335
+
lemma witnessSetTaken_conj (ψ_L ψ_R : Formula N V X Y) :
336
+
(witnessSetTaken S_Ψ σ (.conj ψ_L ψ_R) : Finset (Package N' V')) =
337
+
witnessSetTaken S_Ψ σ ψ_L ∪ witnessSetTaken S_Ψ σ ψ_R :=
338
+
witnessSetTaken.eq_2 S_Ψ σ ψ_L ψ_R
339
+
340
+
lemma witnessSetTaken_disj (ψ_L ψ_R : Formula N V X Y) :
341
+
(witnessSetTaken S_Ψ σ (.disj ψ_L ψ_R) : Finset (Package N' V')) =
342
+
if ψ_L.satisfies S_Ψ σ then
343
+
{(hvn.disjunctN ψ_L ψ_R, hvv.zeroV)} ∪
344
+
witnessSetTaken S_Ψ σ ψ_L ∪ witnessSetUntaken S_Ψ ψ_R
345
+
else
346
+
{(hvn.disjunctN ψ_L ψ_R, hvv.oneV)} ∪
347
+
witnessSetUntaken S_Ψ ψ_L ∪ witnessSetTaken S_Ψ σ ψ_R :=
348
+
witnessSetTaken.eq_3 S_Ψ σ ψ_L ψ_R
349
+
350
+
lemma witnessSetTaken_varCmp (x : X) (ω : CmpOp) (y : Y) :
351
+
(witnessSetTaken S_Ψ σ (.varCmp x ω y) : Finset (Package N' V')) = ∅ :=
352
+
witnessSetTaken.eq_4 S_Ψ σ x ω y
353
+
354
+
lemma witnessSetTaken_neg_dep (n : N) (vs : Finset V) :
355
+
(witnessSetTaken S_Ψ σ (.neg (.dep n vs) : Formula N V X Y) : Finset (Package N' V')) =
356
+
{(hvn.syntheticN n vs, hvv.oneV)} :=
357
+
witnessSetTaken.eq_5 S_Ψ σ n vs
358
+
359
+
lemma witnessSetTaken_neg_varCmp (x : X) (ω : CmpOp) (y : Y) :
360
+
(witnessSetTaken S_Ψ σ (.neg (.varCmp x ω y)) : Finset (Package N' V')) =
361
+
witnessSetTaken S_Ψ σ (.varCmp x (CmpOp.complement ω) y) :=
362
+
witnessSetTaken.eq_6 S_Ψ σ x ω y
363
+
364
+
lemma witnessSetTaken_neg_conj (ψ_L ψ_R : Formula N V X Y) :
365
+
(witnessSetTaken S_Ψ σ (.neg (.conj ψ_L ψ_R)) : Finset (Package N' V')) =
366
+
witnessSetTaken S_Ψ σ (.disj (.neg ψ_L) (.neg ψ_R)) :=
367
+
witnessSetTaken.eq_7 S_Ψ σ ψ_L ψ_R
368
+
369
+
lemma witnessSetTaken_neg_disj (ψ_L ψ_R : Formula N V X Y) :
370
+
(witnessSetTaken S_Ψ σ (.neg (.disj ψ_L ψ_R)) : Finset (Package N' V')) =
371
+
witnessSetTaken S_Ψ σ (.conj (.neg ψ_L) (.neg ψ_R)) :=
372
+
witnessSetTaken.eq_8 S_Ψ σ ψ_L ψ_R
373
+
374
+
lemma witnessSetTaken_neg_neg (ψ : Formula N V X Y) :
375
+
(witnessSetTaken S_Ψ σ (.neg (.neg ψ)) : Finset (Package N' V')) =
376
+
witnessSetTaken S_Ψ σ ψ :=
377
+
witnessSetTaken.eq_9 S_Ψ σ ψ
378
+
379
+
lemma witnessSetUntaken_dep (n : N) (vs : Finset V) :
380
+
(witnessSetUntaken S_Ψ (.dep n vs : Formula N V X Y) : Finset (Package N' V')) = ∅ :=
381
+
witnessSetUntaken.eq_1 S_Ψ n vs
382
+
383
+
lemma witnessSetUntaken_conj (ψ_L ψ_R : Formula N V X Y) :
384
+
(witnessSetUntaken S_Ψ (.conj ψ_L ψ_R) : Finset (Package N' V')) =
385
+
witnessSetUntaken S_Ψ ψ_L ∪ witnessSetUntaken S_Ψ ψ_R :=
386
+
witnessSetUntaken.eq_2 S_Ψ ψ_L ψ_R
387
+
388
+
lemma witnessSetUntaken_disj (ψ_L ψ_R : Formula N V X Y) :
389
+
(witnessSetUntaken S_Ψ (.disj ψ_L ψ_R) : Finset (Package N' V')) =
390
+
witnessSetUntaken S_Ψ ψ_L ∪ witnessSetUntaken S_Ψ ψ_R :=
391
+
witnessSetUntaken.eq_3 S_Ψ ψ_L ψ_R
392
+
393
+
lemma witnessSetUntaken_varCmp (x : X) (ω : CmpOp) (y : Y) :
394
+
(witnessSetUntaken S_Ψ (.varCmp x ω y) : Finset (Package N' V')) = ∅ :=
395
+
witnessSetUntaken.eq_4 S_Ψ x ω y
396
+
397
+
lemma witnessSetUntaken_neg_dep (n : N) (vs : Finset V) :
398
+
(witnessSetUntaken S_Ψ (.neg (.dep n vs) : Formula N V X Y) : Finset (Package N' V')) =
399
+
if ∃ u ∈ vs, ((n, u) : Package N V) ∈ S_Ψ
400
+
then {(hvn.syntheticN n vs, hvv.zeroV)}
401
+
else ∅ :=
402
+
witnessSetUntaken.eq_5 S_Ψ n vs
403
+
404
+
lemma witnessSetUntaken_neg_varCmp (x : X) (ω : CmpOp) (y : Y) :
405
+
(witnessSetUntaken S_Ψ (.neg (.varCmp x ω y)) : Finset (Package N' V')) =
406
+
witnessSetUntaken S_Ψ (.varCmp x (CmpOp.complement ω) y) :=
407
+
witnessSetUntaken.eq_6 S_Ψ x ω y
408
+
409
+
lemma witnessSetUntaken_neg_conj (ψ_L ψ_R : Formula N V X Y) :
410
+
(witnessSetUntaken S_Ψ (.neg (.conj ψ_L ψ_R)) : Finset (Package N' V')) =
411
+
witnessSetUntaken S_Ψ (.disj (.neg ψ_L) (.neg ψ_R)) :=
412
+
witnessSetUntaken.eq_7 S_Ψ ψ_L ψ_R
413
+
414
+
lemma witnessSetUntaken_neg_disj (ψ_L ψ_R : Formula N V X Y) :
415
+
(witnessSetUntaken S_Ψ (.neg (.disj ψ_L ψ_R)) : Finset (Package N' V')) =
416
+
witnessSetUntaken S_Ψ (.conj (.neg ψ_L) (.neg ψ_R)) :=
417
+
witnessSetUntaken.eq_8 S_Ψ ψ_L ψ_R
418
+
419
+
lemma witnessSetUntaken_neg_neg (ψ : Formula N V X Y) :
420
+
(witnessSetUntaken S_Ψ (.neg (.neg ψ)) : Finset (Package N' V')) =
421
+
witnessSetUntaken S_Ψ ψ :=
422
+
witnessSetUntaken.eq_9 S_Ψ ψ
423
+
424
+
end UnfoldEqs
425
+
426
+
/-! ## Determinism lemmas on `witnessSetUntaken` -/
427
+
428
+
lemma witnessSetUntaken_negDep_det [DecidableEq N] [DecidableEq V] [DecidableEq X]
429
+
[DecidableEq Y] [LT Y] [DecidableRel (· < · : Y → Y → Prop)]
430
+
(S_Ψ : Finset (Package N V))
431
+
(ψ : Formula N V X Y) (n : N) (vs : Finset V) (v : V')
432
+
(h : (hvn.syntheticN n vs, v) ∈ witnessSetUntaken S_Ψ ψ) :
433
+
v = hvv.zeroV := by
434
+
match ψ with
435
+
| .dep _ _ => exact absurd h (by rw [witnessSetUntaken_dep]; exact Finset.notMem_empty _)
436
+
| .conj ψ_L ψ_R =>
437
+
simp only [witnessSetUntaken_conj, Finset.mem_union] at h
438
+
exact h.elim
439
+
(witnessSetUntaken_negDep_det S_Ψ ψ_L n vs v)
440
+
(witnessSetUntaken_negDep_det S_Ψ ψ_R n vs v)
441
+
| .disj ψ_L ψ_R =>
442
+
simp only [witnessSetUntaken_disj, Finset.mem_union] at h
443
+
exact h.elim
444
+
(witnessSetUntaken_negDep_det S_Ψ ψ_L n vs v)
445
+
(witnessSetUntaken_negDep_det S_Ψ ψ_R n vs v)
446
+
| .varCmp _ _ _ => exact absurd h (by rw [witnessSetUntaken_varCmp]; exact Finset.notMem_empty _)
447
+
| .neg (.dep n' vs') =>
448
+
rw [witnessSetUntaken_neg_dep] at h
449
+
split at h
450
+
· simp only [Finset.mem_singleton, Prod.mk.injEq] at h
451
+
exact h.2
452
+
· simp at h
453
+
| .neg (.varCmp x ω y) =>
454
+
rw [witnessSetUntaken_neg_varCmp] at h
455
+
exact witnessSetUntaken_negDep_det S_Ψ _ n vs v h
456
+
| .neg (.conj ψ_L ψ_R) =>
457
+
rw [witnessSetUntaken_neg_conj] at h
458
+
exact witnessSetUntaken_negDep_det S_Ψ (.disj (.neg ψ_L) (.neg ψ_R)) n vs v h
459
+
| .neg (.disj ψ_L ψ_R) =>
460
+
rw [witnessSetUntaken_neg_disj] at h
461
+
exact witnessSetUntaken_negDep_det S_Ψ (.conj (.neg ψ_L) (.neg ψ_R)) n vs v h
462
+
| .neg (.neg ψ') =>
463
+
rw [witnessSetUntaken_neg_neg] at h
464
+
exact witnessSetUntaken_negDep_det S_Ψ ψ' n vs v h
465
+
termination_by ψ.weight
466
+
decreasing_by all_goals simp only [Formula.weight]; omega
467
+
468
+
lemma witnessSetUntaken_negDep_exists [DecidableEq N] [DecidableEq V] [DecidableEq X]
469
+
[DecidableEq Y] [LT Y] [DecidableRel (· < · : Y → Y → Prop)]
470
+
(S_Ψ : Finset (Package N V))
471
+
(ψ : Formula N V X Y) (n : N) (vs : Finset V) (v : V')
472
+
(h : (hvn.syntheticN n vs, v) ∈ witnessSetUntaken S_Ψ ψ) :
473
+
∃ u ∈ vs, ((n, u) : Package N V) ∈ S_Ψ := by
474
+
match ψ with
475
+
| .dep _ _ => exact absurd h (by rw [witnessSetUntaken_dep]; exact Finset.notMem_empty _)
476
+
| .conj ψ_L ψ_R =>
477
+
simp only [witnessSetUntaken_conj, Finset.mem_union] at h
478
+
exact h.elim
479
+
(witnessSetUntaken_negDep_exists S_Ψ ψ_L n vs v)
480
+
(witnessSetUntaken_negDep_exists S_Ψ ψ_R n vs v)
481
+
| .disj ψ_L ψ_R =>
482
+
simp only [witnessSetUntaken_disj, Finset.mem_union] at h
483
+
exact h.elim
484
+
(witnessSetUntaken_negDep_exists S_Ψ ψ_L n vs v)
485
+
(witnessSetUntaken_negDep_exists S_Ψ ψ_R n vs v)
486
+
| .varCmp _ _ _ => exact absurd h (by rw [witnessSetUntaken_varCmp]; exact Finset.notMem_empty _)
487
+
| .neg (.dep n' vs') =>
488
+
rw [witnessSetUntaken_neg_dep] at h
489
+
split at h
490
+
· rename_i hex
491
+
simp only [Finset.mem_singleton] at h
492
+
have heq := (Prod.mk.injEq _ _ _ _).mp h
493
+
obtain ⟨rfl, rfl⟩ := hvn.syntheticN_injective heq.1
494
+
exact hex
495
+
· simp at h
496
+
| .neg (.varCmp x ω y) =>
497
+
rw [witnessSetUntaken_neg_varCmp] at h
498
+
exact witnessSetUntaken_negDep_exists S_Ψ _ n vs v h
499
+
| .neg (.conj ψ_L ψ_R) =>
500
+
rw [witnessSetUntaken_neg_conj] at h
501
+
exact witnessSetUntaken_negDep_exists S_Ψ (.disj (.neg ψ_L) (.neg ψ_R)) n vs v h
502
+
| .neg (.disj ψ_L ψ_R) =>
503
+
rw [witnessSetUntaken_neg_disj] at h
504
+
exact witnessSetUntaken_negDep_exists S_Ψ (.conj (.neg ψ_L) (.neg ψ_R)) n vs v h
505
+
| .neg (.neg ψ') =>
506
+
rw [witnessSetUntaken_neg_neg] at h
507
+
exact witnessSetUntaken_negDep_exists S_Ψ ψ' n vs v h
508
+
termination_by ψ.weight
509
+
decreasing_by all_goals simp only [Formula.weight]; omega
510
+
511
+
lemma witnessSetUntaken_disjunct_det [DecidableEq N] [DecidableEq V] [DecidableEq X]
512
+
[DecidableEq Y] [LT Y] [DecidableRel (· < · : Y → Y → Prop)]
513
+
(S_Ψ : Finset (Package N V))
514
+
(ψ : Formula N V X Y) (ψ_L ψ_R : Formula N V X Y) (v : V')
515
+
(h : (hvn.disjunctN ψ_L ψ_R, v) ∈ witnessSetUntaken (N' := N') S_Ψ ψ) : False := by
516
+
match ψ with
517
+
| .dep _ _ => exact absurd h (by rw [witnessSetUntaken_dep]; exact Finset.notMem_empty _)
518
+
| .conj ψ_a ψ_b =>
519
+
simp only [witnessSetUntaken_conj, Finset.mem_union] at h
520
+
exact h.elim
521
+
(witnessSetUntaken_disjunct_det S_Ψ ψ_a ψ_L ψ_R v)
522
+
(witnessSetUntaken_disjunct_det S_Ψ ψ_b ψ_L ψ_R v)
523
+
| .disj ψ_a ψ_b =>
524
+
simp only [witnessSetUntaken_disj, Finset.mem_union] at h
525
+
exact h.elim
526
+
(witnessSetUntaken_disjunct_det S_Ψ ψ_a ψ_L ψ_R v)
527
+
(witnessSetUntaken_disjunct_det S_Ψ ψ_b ψ_L ψ_R v)
528
+
| .varCmp _ _ _ => exact absurd h (by rw [witnessSetUntaken_varCmp]; exact Finset.notMem_empty _)
529
+
| .neg (.dep _ _) =>
530
+
rw [witnessSetUntaken_neg_dep] at h
531
+
split at h
532
+
· simp only [Finset.mem_singleton, Prod.mk.injEq] at h
533
+
exact absurd h.1 (hvn.disjunctN_ne_syntheticN _ _ _ _)
534
+
· simp at h
535
+
| .neg (.varCmp x ω y) =>
536
+
rw [witnessSetUntaken_neg_varCmp] at h
537
+
exact witnessSetUntaken_disjunct_det S_Ψ _ ψ_L ψ_R v h
538
+
| .neg (.conj ψ_a ψ_b) =>
539
+
rw [witnessSetUntaken_neg_conj] at h
540
+
exact witnessSetUntaken_disjunct_det S_Ψ (.disj (.neg ψ_a) (.neg ψ_b)) ψ_L ψ_R v h
541
+
| .neg (.disj ψ_a ψ_b) =>
542
+
rw [witnessSetUntaken_neg_disj] at h
543
+
exact witnessSetUntaken_disjunct_det S_Ψ (.conj (.neg ψ_a) (.neg ψ_b)) ψ_L ψ_R v h
544
+
| .neg (.neg ψ') =>
545
+
rw [witnessSetUntaken_neg_neg] at h
546
+
exact witnessSetUntaken_disjunct_det S_Ψ ψ' ψ_L ψ_R v h
547
+
termination_by ψ.weight
548
+
decreasing_by all_goals simp only [Formula.weight]; omega
549
+
550
+
/-! ## Taken-side disjunctN determinism -/
551
+
552
+
lemma witnessSetTaken_disjunct_det [DecidableEq N] [DecidableEq V] [DecidableEq X]
553
+
[DecidableEq Y] [LT Y] [DecidableRel (· < · : Y → Y → Prop)]
554
+
(S_Ψ : Finset (Package N V)) (σ : X → Y)
555
+
(ψ : Formula N V X Y) (ψ_L ψ_R : Formula N V X Y) (v : V')
556
+
(h : (hvn.disjunctN ψ_L ψ_R, v) ∈ witnessSetTaken (N' := N') S_Ψ σ ψ) :
557
+
v = if ψ_L.satisfies S_Ψ σ then hvv.zeroV else hvv.oneV := by
558
+
match ψ with
559
+
| .dep _ _ => exact absurd h (by rw [witnessSetTaken_dep]; exact Finset.notMem_empty _)
560
+
| .conj ψ_a ψ_b =>
561
+
simp only [witnessSetTaken_conj, Finset.mem_union] at h
562
+
exact h.elim
563
+
(witnessSetTaken_disjunct_det S_Ψ σ ψ_a ψ_L ψ_R v)
564
+
(witnessSetTaken_disjunct_det S_Ψ σ ψ_b ψ_L ψ_R v)
565
+
| .disj ψ_a ψ_b =>
566
+
simp only [witnessSetTaken_disj] at h
567
+
split at h
568
+
· rename_i hψa_sat
569
+
simp only [Finset.mem_union, Finset.mem_singleton] at h
570
+
rcases h with (hsing | hL) | hU
571
+
· have heq := (Prod.mk.injEq _ _ _ _).mp hsing
572
+
obtain ⟨rfl, rfl⟩ := hvn.disjunctN_injective heq.1
573
+
simp [hψa_sat, heq.2]
574
+
· exact witnessSetTaken_disjunct_det S_Ψ σ ψ_a ψ_L ψ_R v hL
575
+
· exact (witnessSetUntaken_disjunct_det S_Ψ ψ_b ψ_L ψ_R v hU).elim
576
+
· rename_i hψa_unsat
577
+
simp only [Finset.mem_union, Finset.mem_singleton] at h
578
+
rcases h with (hsing | hU) | hR
579
+
· have heq := (Prod.mk.injEq _ _ _ _).mp hsing
580
+
obtain ⟨rfl, rfl⟩ := hvn.disjunctN_injective heq.1
581
+
simp [hψa_unsat, heq.2]
582
+
· exact (witnessSetUntaken_disjunct_det S_Ψ ψ_a ψ_L ψ_R v hU).elim
583
+
· exact witnessSetTaken_disjunct_det S_Ψ σ ψ_b ψ_L ψ_R v hR
584
+
| .varCmp _ _ _ => exact absurd h (by rw [witnessSetTaken_varCmp]; exact Finset.notMem_empty _)
585
+
| .neg (.dep _ _) =>
586
+
simp only [witnessSetTaken_neg_dep, Finset.mem_singleton, Prod.mk.injEq] at h
587
+
exact absurd h.1 (hvn.disjunctN_ne_syntheticN _ _ _ _)
588
+
| .neg (.varCmp x ω y) =>
589
+
rw [witnessSetTaken_neg_varCmp] at h
590
+
exact witnessSetTaken_disjunct_det S_Ψ σ _ ψ_L ψ_R v h
591
+
| .neg (.conj ψ_a ψ_b) =>
592
+
rw [witnessSetTaken_neg_conj] at h
593
+
exact witnessSetTaken_disjunct_det S_Ψ σ (.disj (.neg ψ_a) (.neg ψ_b)) ψ_L ψ_R v h
594
+
| .neg (.disj ψ_a ψ_b) =>
595
+
rw [witnessSetTaken_neg_disj] at h
596
+
exact witnessSetTaken_disjunct_det S_Ψ σ (.conj (.neg ψ_a) (.neg ψ_b)) ψ_L ψ_R v h
597
+
| .neg (.neg ψ') =>
598
+
rw [witnessSetTaken_neg_neg] at h
599
+
exact witnessSetTaken_disjunct_det S_Ψ σ ψ' ψ_L ψ_R v h
600
+
termination_by ψ.weight
601
+
decreasing_by all_goals simp only [Formula.weight]; omega
602
+
603
+
/-! ## Taken-side syntheticN determinism (satisfaction-aware) -/
604
+
605
+
lemma witnessSetTaken_negDep_det [DecidableEq N] [DecidableEq V] [DecidableEq X]
606
+
[DecidableEq Y] [LT Y] [DecidableRel (· < · : Y → Y → Prop)]
607
+
(S_Ψ : Finset (Package N V)) (σ : X → Y)
608
+
(ψ : Formula N V X Y) (hsat : ψ.satisfies S_Ψ σ)
609
+
(n : N) (vs : Finset V) (v : V')
610
+
(h : (hvn.syntheticN n vs, v) ∈ witnessSetTaken (N' := N') S_Ψ σ ψ) :
611
+
v = if ∃ u ∈ vs, ((n, u) : Package N V) ∈ S_Ψ then hvv.zeroV else hvv.oneV := by
612
+
match ψ with
613
+
| .dep _ _ => exact absurd h (by rw [witnessSetTaken_dep]; exact Finset.notMem_empty _)
614
+
| .conj ψ_L ψ_R =>
615
+
simp only [witnessSetTaken_conj, Finset.mem_union] at h
616
+
rcases h with hL | hR
617
+
· exact witnessSetTaken_negDep_det S_Ψ σ ψ_L hsat.1 n vs v hL
618
+
· exact witnessSetTaken_negDep_det S_Ψ σ ψ_R hsat.2 n vs v hR
619
+
| .disj ψ_L ψ_R =>
620
+
simp only [witnessSetTaken_disj] at h
621
+
split at h
622
+
· rename_i hψL_sat
623
+
simp only [Finset.mem_union, Finset.mem_singleton] at h
624
+
rcases h with (hsing | hL) | hU
625
+
· have heq := (Prod.mk.injEq _ _ _ _).mp hsing
626
+
exact absurd heq.1 (hvn.syntheticN_ne_disjunctN _ _ _ _)
627
+
· exact witnessSetTaken_negDep_det S_Ψ σ ψ_L hψL_sat n vs v hL
628
+
· have hv := witnessSetUntaken_negDep_det S_Ψ ψ_R n vs v hU
629
+
have hex := witnessSetUntaken_negDep_exists S_Ψ ψ_R n vs v hU
630
+
simp [hv, hex]
631
+
· rename_i hψL_unsat
632
+
simp only [Finset.mem_union, Finset.mem_singleton] at h
633
+
rcases h with (hsing | hU) | hR
634
+
· have heq := (Prod.mk.injEq _ _ _ _).mp hsing
635
+
exact absurd heq.1 (hvn.syntheticN_ne_disjunctN _ _ _ _)
636
+
· have hv := witnessSetUntaken_negDep_det S_Ψ ψ_L n vs v hU
637
+
have hex := witnessSetUntaken_negDep_exists S_Ψ ψ_L n vs v hU
638
+
simp [hv, hex]
639
+
· exact witnessSetTaken_negDep_det S_Ψ σ ψ_R (hsat.resolve_left hψL_unsat) n vs v hR
640
+
| .varCmp _ _ _ => exact absurd h (by rw [witnessSetTaken_varCmp]; exact Finset.notMem_empty _)
641
+
| .neg (.dep n' vs') =>
642
+
simp only [witnessSetTaken_neg_dep, Finset.mem_singleton] at h
643
+
have heq := (Prod.mk.injEq _ _ _ _).mp h
644
+
obtain ⟨rfl, rfl⟩ := hvn.syntheticN_injective heq.1
645
+
rw [heq.2]
646
+
have : ¬ ∃ u ∈ vs, ((n, u) : Package N V) ∈ S_Ψ := hsat
647
+
simp [this]
648
+
| .neg (.varCmp x ω y) =>
649
+
rw [witnessSetTaken_neg_varCmp] at h
650
+
apply witnessSetTaken_negDep_det S_Ψ σ _ _ n vs v h
651
+
-- hsat : ¬(.varCmp x ω y).satisfies = ¬ω.eval (σ x) y
652
+
-- need: (.varCmp x (complement ω) y).satisfies = (complement ω).eval (σ x) y
653
+
show (CmpOp.complement ω).eval (σ x) y = true
654
+
exact (complement_eval ω _ _).mpr hsat
655
+
| .neg (.conj ψ_L ψ_R) =>
656
+
rw [witnessSetTaken_neg_conj] at h
657
+
apply witnessSetTaken_negDep_det S_Ψ σ (.disj (.neg ψ_L) (.neg ψ_R)) _ n vs v h
658
+
simp only [Formula.satisfies] at hsat
659
+
exact (not_and_or.mp hsat)
660
+
| .neg (.disj ψ_L ψ_R) =>
661
+
rw [witnessSetTaken_neg_disj] at h
662
+
apply witnessSetTaken_negDep_det S_Ψ σ (.conj (.neg ψ_L) (.neg ψ_R)) _ n vs v h
663
+
simp only [Formula.satisfies] at hsat
664
+
exact (not_or.mp hsat)
665
+
| .neg (.neg ψ') =>
666
+
rw [witnessSetTaken_neg_neg] at h
667
+
apply witnessSetTaken_negDep_det S_Ψ σ ψ' _ n vs v h
668
+
simp only [Formula.satisfies] at hsat
669
+
exact not_not.mp hsat
670
+
termination_by ψ.weight
671
+
decreasing_by all_goals simp only [Formula.weight]; omega
672
+
673
+
/-! ## Name classification: witnessSet only contains syntheticN / disjunctN -/
674
+
675
+
lemma witnessSetUntaken_name_classify [DecidableEq N] [DecidableEq V] [DecidableEq X]
676
+
[DecidableEq Y] [LT Y] [DecidableRel (· < · : Y → Y → Prop)]
677
+
(S_Ψ : Finset (Package N V))
678
+
(ψ : Formula N V X Y) (n : N') (v : V')
679
+
(h : (n, v) ∈ witnessSetUntaken S_Ψ ψ) :
680
+
(∃ n' vs, n = hvn.syntheticN n' vs) ∨ (∃ ψ_L ψ_R, n = hvn.disjunctN ψ_L ψ_R) := by
681
+
match ψ with
682
+
| .dep _ _ => exact absurd h (by rw [witnessSetUntaken_dep]; exact Finset.notMem_empty _)
683
+
| .conj ψ_L ψ_R =>
684
+
simp only [witnessSetUntaken_conj, Finset.mem_union] at h
685
+
exact h.elim
686
+
(witnessSetUntaken_name_classify S_Ψ ψ_L n v)
687
+
(witnessSetUntaken_name_classify S_Ψ ψ_R n v)
688
+
| .disj ψ_L ψ_R =>
689
+
simp only [witnessSetUntaken_disj, Finset.mem_union] at h
690
+
exact h.elim
691
+
(witnessSetUntaken_name_classify S_Ψ ψ_L n v)
692
+
(witnessSetUntaken_name_classify S_Ψ ψ_R n v)
693
+
| .varCmp _ _ _ => exact absurd h (by rw [witnessSetUntaken_varCmp]; exact Finset.notMem_empty _)
694
+
| .neg (.dep n' vs) =>
695
+
rw [witnessSetUntaken_neg_dep] at h
696
+
split at h
697
+
· simp only [Finset.mem_singleton] at h
698
+
have heq := (Prod.mk.injEq _ _ _ _).mp h
699
+
exact Or.inl ⟨n', vs, heq.1⟩
700
+
· simp at h
701
+
| .neg (.varCmp x ω y) =>
702
+
rw [witnessSetUntaken_neg_varCmp] at h
703
+
exact witnessSetUntaken_name_classify S_Ψ _ n v h
704
+
| .neg (.conj ψ_L ψ_R) =>
705
+
rw [witnessSetUntaken_neg_conj] at h
706
+
exact witnessSetUntaken_name_classify S_Ψ (.disj (.neg ψ_L) (.neg ψ_R)) n v h
707
+
| .neg (.disj ψ_L ψ_R) =>
708
+
rw [witnessSetUntaken_neg_disj] at h
709
+
exact witnessSetUntaken_name_classify S_Ψ (.conj (.neg ψ_L) (.neg ψ_R)) n v h
710
+
| .neg (.neg ψ') =>
711
+
rw [witnessSetUntaken_neg_neg] at h
712
+
exact witnessSetUntaken_name_classify S_Ψ ψ' n v h
713
+
termination_by ψ.weight
714
+
decreasing_by all_goals simp only [Formula.weight]; omega
715
+
716
+
lemma witnessSetTaken_name_classify [DecidableEq N] [DecidableEq V] [DecidableEq X]
717
+
[DecidableEq Y] [LT Y] [DecidableRel (· < · : Y → Y → Prop)]
718
+
(S_Ψ : Finset (Package N V)) (σ : X → Y)
719
+
(ψ : Formula N V X Y) (n : N') (v : V')
720
+
(h : (n, v) ∈ witnessSetTaken S_Ψ σ ψ) :
721
+
(∃ n' vs, n = hvn.syntheticN n' vs) ∨ (∃ ψ_L ψ_R, n = hvn.disjunctN ψ_L ψ_R) := by
722
+
match ψ with
723
+
| .dep _ _ => exact absurd h (by rw [witnessSetTaken_dep]; exact Finset.notMem_empty _)
724
+
| .conj ψ_L ψ_R =>
725
+
simp only [witnessSetTaken_conj, Finset.mem_union] at h
726
+
exact h.elim
727
+
(witnessSetTaken_name_classify S_Ψ σ ψ_L n v)
728
+
(witnessSetTaken_name_classify S_Ψ σ ψ_R n v)
729
+
| .disj ψ_L ψ_R =>
730
+
simp only [witnessSetTaken_disj] at h
731
+
split at h
732
+
· simp only [Finset.mem_union, Finset.mem_singleton] at h
733
+
rcases h with (hsing | hL) | hU
734
+
· have heq := (Prod.mk.injEq _ _ _ _).mp hsing
735
+
exact Or.inr ⟨ψ_L, ψ_R, heq.1⟩
736
+
· exact witnessSetTaken_name_classify S_Ψ σ ψ_L n v hL
737
+
· exact witnessSetUntaken_name_classify S_Ψ ψ_R n v hU
738
+
· simp only [Finset.mem_union, Finset.mem_singleton] at h
739
+
rcases h with (hsing | hU) | hR
740
+
· have heq := (Prod.mk.injEq _ _ _ _).mp hsing
741
+
exact Or.inr ⟨ψ_L, ψ_R, heq.1⟩
742
+
· exact witnessSetUntaken_name_classify S_Ψ ψ_L n v hU
743
+
· exact witnessSetTaken_name_classify S_Ψ σ ψ_R n v hR
744
+
| .varCmp _ _ _ => exact absurd h (by rw [witnessSetTaken_varCmp]; exact Finset.notMem_empty _)
745
+
| .neg (.dep n' vs) =>
746
+
simp only [witnessSetTaken_neg_dep, Finset.mem_singleton] at h
747
+
have heq := (Prod.mk.injEq _ _ _ _).mp h
748
+
exact Or.inl ⟨n', vs, heq.1⟩
749
+
| .neg (.varCmp x ω y) =>
750
+
rw [witnessSetTaken_neg_varCmp] at h
751
+
exact witnessSetTaken_name_classify S_Ψ σ _ n v h
752
+
| .neg (.conj ψ_L ψ_R) =>
753
+
rw [witnessSetTaken_neg_conj] at h
754
+
exact witnessSetTaken_name_classify S_Ψ σ (.disj (.neg ψ_L) (.neg ψ_R)) n v h
755
+
| .neg (.disj ψ_L ψ_R) =>
756
+
rw [witnessSetTaken_neg_disj] at h
757
+
exact witnessSetTaken_name_classify S_Ψ σ (.conj (.neg ψ_L) (.neg ψ_R)) n v h
758
+
| .neg (.neg ψ') =>
759
+
rw [witnessSetTaken_neg_neg] at h
760
+
exact witnessSetTaken_name_classify S_Ψ σ ψ' n v h
761
+
termination_by ψ.weight
762
+
decreasing_by all_goals simp only [Formula.weight]; omega
763
+
764
+
/-! ## Disjunct monotonicity (taken side) -/
765
+
766
+
private lemma witnessSetTaken_disj_zero_mono [DecidableEq N] [DecidableEq V] [DecidableEq X]
767
+
[DecidableEq Y] [LT Y] [DecidableRel (· < · : Y → Y → Prop)]
768
+
(S_Ψ : Finset (Package N V)) (σ : X → Y)
769
+
(ψ : Formula N V X Y)
770
+
(ψ_L ψ_R : Formula N V X Y)
771
+
(hw : (hvn.disjunctN ψ_L ψ_R, hvv.zeroV) ∈ witnessSetTaken (N' := N') S_Ψ σ ψ) :
772
+
(ψ_L.satisfies S_Ψ σ) ∧
773
+
witnessSetTaken (N' := N') (V' := V') S_Ψ σ ψ_L ⊆ witnessSetTaken S_Ψ σ ψ ∧
774
+
witnessSetUntaken (N' := N') (V' := V') S_Ψ ψ_R ⊆ witnessSetTaken S_Ψ σ ψ := by
775
+
match ψ with
776
+
| .dep _ _ => exact absurd hw (by rw [witnessSetTaken_dep]; exact Finset.notMem_empty _)
777
+
| .conj ψ_a ψ_b =>
778
+
simp only [witnessSetTaken_conj, Finset.mem_union] at hw
779
+
rcases hw with hL | hR
780
+
· obtain ⟨hs, h1, h2⟩ := witnessSetTaken_disj_zero_mono S_Ψ σ ψ_a ψ_L ψ_R hL
781
+
exact ⟨hs, fun x hx => by simp only [witnessSetTaken_conj]; exact Finset.mem_union.mpr (Or.inl (h1 hx)),
782
+
fun x hx => by simp only [witnessSetTaken_conj]; exact Finset.mem_union.mpr (Or.inl (h2 hx))⟩
783
+
· obtain ⟨hs, h1, h2⟩ := witnessSetTaken_disj_zero_mono S_Ψ σ ψ_b ψ_L ψ_R hR
784
+
exact ⟨hs, fun x hx => by simp only [witnessSetTaken_conj]; exact Finset.mem_union.mpr (Or.inr (h1 hx)),
785
+
fun x hx => by simp only [witnessSetTaken_conj]; exact Finset.mem_union.mpr (Or.inr (h2 hx))⟩
786
+
| .disj ψ_a ψ_b =>
787
+
simp only [witnessSetTaken_disj] at hw
788
+
split at hw
789
+
· rename_i hψa_sat
790
+
simp only [Finset.mem_union, Finset.mem_singleton] at hw
791
+
rcases hw with (hsing | hL) | hU
792
+
· have heq := (Prod.mk.injEq _ _ _ _).mp hsing
793
+
obtain ⟨rfl, rfl⟩ := hvn.disjunctN_injective heq.1
794
+
refine ⟨hψa_sat, ?_, ?_⟩
795
+
· intro x hx; simp only [witnessSetTaken_disj, if_pos hψa_sat, Finset.mem_union, Finset.mem_singleton]
796
+
exact Or.inl (Or.inr hx)
797
+
· intro x hx; simp only [witnessSetTaken_disj, if_pos hψa_sat, Finset.mem_union, Finset.mem_singleton]
798
+
exact Or.inr hx
799
+
· obtain ⟨hs, h1, h2⟩ := witnessSetTaken_disj_zero_mono S_Ψ σ ψ_a ψ_L ψ_R hL
800
+
refine ⟨hs, ?_, ?_⟩ <;> {
801
+
intro x hx; simp only [witnessSetTaken_disj, if_pos hψa_sat, Finset.mem_union, Finset.mem_singleton]
802
+
exact Or.inl (Or.inr (by first | exact h1 hx | exact h2 hx)) }
803
+
· exact absurd hU (witnessSetUntaken_disjunct_det S_Ψ ψ_b ψ_L ψ_R _)
804
+
· rename_i hψa_unsat
805
+
simp only [Finset.mem_union, Finset.mem_singleton] at hw
806
+
rcases hw with (hsing | hU) | hR
807
+
· have heq := (Prod.mk.injEq _ _ _ _).mp hsing
808
+
exact absurd heq.2 hvv.zeroV_ne_oneV
809
+
· exact absurd hU (witnessSetUntaken_disjunct_det S_Ψ ψ_a ψ_L ψ_R _)
810
+
· obtain ⟨hs, h1, h2⟩ := witnessSetTaken_disj_zero_mono S_Ψ σ ψ_b ψ_L ψ_R hR
811
+
refine ⟨hs, ?_, ?_⟩ <;> {
812
+
intro x hx; simp only [witnessSetTaken_disj, if_neg hψa_unsat, Finset.mem_union, Finset.mem_singleton]
813
+
exact Or.inr (by first | exact h1 hx | exact h2 hx) }
814
+
| .varCmp _ _ _ => exact absurd hw (by rw [witnessSetTaken_varCmp]; exact Finset.notMem_empty _)
815
+
| .neg (.dep n vs) =>
816
+
simp only [witnessSetTaken_neg_dep, Finset.mem_singleton, Prod.mk.injEq] at hw
817
+
exact absurd hw.1 (hvn.disjunctN_ne_syntheticN ψ_L ψ_R n vs)
818
+
| .neg (.varCmp x ω y) =>
819
+
rw [witnessSetTaken_neg_varCmp] at hw ⊢
820
+
exact witnessSetTaken_disj_zero_mono S_Ψ σ _ ψ_L ψ_R hw
821
+
| .neg (.conj ψ_a ψ_b) =>
822
+
rw [witnessSetTaken_neg_conj] at hw ⊢
823
+
exact witnessSetTaken_disj_zero_mono S_Ψ σ (.disj (.neg ψ_a) (.neg ψ_b)) ψ_L ψ_R hw
824
+
| .neg (.disj ψ_a ψ_b) =>
825
+
rw [witnessSetTaken_neg_disj] at hw ⊢
826
+
exact witnessSetTaken_disj_zero_mono S_Ψ σ (.conj (.neg ψ_a) (.neg ψ_b)) ψ_L ψ_R hw
827
+
| .neg (.neg ψ') =>
828
+
rw [witnessSetTaken_neg_neg] at hw ⊢
829
+
exact witnessSetTaken_disj_zero_mono S_Ψ σ ψ' ψ_L ψ_R hw
830
+
termination_by ψ.weight
831
+
decreasing_by all_goals (simp only [Formula.weight]; omega)
832
+
833
+
private lemma witnessSetTaken_disj_one_mono [DecidableEq N] [DecidableEq V] [DecidableEq X]
834
+
[DecidableEq Y] [LT Y] [DecidableRel (· < · : Y → Y → Prop)]
835
+
(S_Ψ : Finset (Package N V)) (σ : X → Y)
836
+
(ψ : Formula N V X Y) (hsat : ψ.satisfies S_Ψ σ)
837
+
(ψ_L ψ_R : Formula N V X Y)
838
+
(hw : (hvn.disjunctN ψ_L ψ_R, hvv.oneV) ∈ witnessSetTaken (N' := N') S_Ψ σ ψ) :
839
+
(ψ_R.satisfies S_Ψ σ) ∧
840
+
witnessSetUntaken (N' := N') (V' := V') S_Ψ ψ_L ⊆ witnessSetTaken S_Ψ σ ψ ∧
841
+
witnessSetTaken (N' := N') (V' := V') S_Ψ σ ψ_R ⊆ witnessSetTaken S_Ψ σ ψ := by
842
+
match ψ with
843
+
| .dep _ _ => exact absurd hw (by rw [witnessSetTaken_dep]; exact Finset.notMem_empty _)
844
+
| .conj ψ_a ψ_b =>
845
+
simp only [witnessSetTaken_conj, Finset.mem_union] at hw
846
+
rcases hw with hL | hR
847
+
· obtain ⟨hs, h1, h2⟩ := witnessSetTaken_disj_one_mono S_Ψ σ ψ_a hsat.1 ψ_L ψ_R hL
848
+
exact ⟨hs, fun x hx => by simp only [witnessSetTaken_conj]; exact Finset.mem_union.mpr (Or.inl (h1 hx)),
849
+
fun x hx => by simp only [witnessSetTaken_conj]; exact Finset.mem_union.mpr (Or.inl (h2 hx))⟩
850
+
· obtain ⟨hs, h1, h2⟩ := witnessSetTaken_disj_one_mono S_Ψ σ ψ_b hsat.2 ψ_L ψ_R hR
851
+
exact ⟨hs, fun x hx => by simp only [witnessSetTaken_conj]; exact Finset.mem_union.mpr (Or.inr (h1 hx)),
852
+
fun x hx => by simp only [witnessSetTaken_conj]; exact Finset.mem_union.mpr (Or.inr (h2 hx))⟩
853
+
| .disj ψ_a ψ_b =>
854
+
simp only [witnessSetTaken_disj] at hw
855
+
split at hw
856
+
· rename_i hψa_sat
857
+
simp only [Finset.mem_union, Finset.mem_singleton] at hw
858
+
rcases hw with (hsing | hL) | hU
859
+
· have heq := (Prod.mk.injEq _ _ _ _).mp hsing
860
+
exact absurd heq.2.symm hvv.zeroV_ne_oneV
861
+
· obtain ⟨hs, h1, h2⟩ := witnessSetTaken_disj_one_mono S_Ψ σ ψ_a hψa_sat ψ_L ψ_R hL
862
+
refine ⟨hs, ?_, ?_⟩ <;> {
863
+
intro x hx; simp only [witnessSetTaken_disj, if_pos hψa_sat, Finset.mem_union, Finset.mem_singleton]
864
+
exact Or.inl (Or.inr (by first | exact h1 hx | exact h2 hx)) }
865
+
· exact absurd hU (witnessSetUntaken_disjunct_det S_Ψ ψ_b ψ_L ψ_R _)
866
+
· rename_i hψa_unsat
867
+
simp only [Finset.mem_union, Finset.mem_singleton] at hw
868
+
rcases hw with (hsing | hU) | hR
869
+
· have heq := (Prod.mk.injEq _ _ _ _).mp hsing
870
+
obtain ⟨rfl, rfl⟩ := hvn.disjunctN_injective heq.1
871
+
refine ⟨hsat.resolve_left hψa_unsat, ?_, ?_⟩
872
+
· intro x hx; simp only [witnessSetTaken_disj, if_neg hψa_unsat, Finset.mem_union, Finset.mem_singleton]
873
+
exact Or.inl (Or.inr hx)
874
+
· intro x hx; simp only [witnessSetTaken_disj, if_neg hψa_unsat, Finset.mem_union, Finset.mem_singleton]
875
+
exact Or.inr hx
876
+
· exact absurd hU (witnessSetUntaken_disjunct_det S_Ψ ψ_a ψ_L ψ_R _)
877
+
· obtain ⟨hs, h1, h2⟩ := witnessSetTaken_disj_one_mono S_Ψ σ ψ_b (hsat.resolve_left hψa_unsat) ψ_L ψ_R hR
878
+
refine ⟨hs, ?_, ?_⟩ <;> {
879
+
intro x hx; simp only [witnessSetTaken_disj, if_neg hψa_unsat, Finset.mem_union, Finset.mem_singleton]
880
+
exact Or.inr (by first | exact h1 hx | exact h2 hx) }
881
+
| .varCmp _ _ _ => exact absurd hw (by rw [witnessSetTaken_varCmp]; exact Finset.notMem_empty _)
882
+
| .neg (.dep n vs) =>
883
+
simp only [witnessSetTaken_neg_dep, Finset.mem_singleton, Prod.mk.injEq] at hw
884
+
exact absurd hw.1 (hvn.disjunctN_ne_syntheticN ψ_L ψ_R n vs)
885
+
| .neg (.varCmp x ω y) =>
886
+
rw [witnessSetTaken_neg_varCmp] at hw ⊢
887
+
apply witnessSetTaken_disj_one_mono S_Ψ σ _ _ ψ_L ψ_R hw
888
+
show (CmpOp.complement ω).eval (σ x) y = true
889
+
exact (complement_eval ω _ _).mpr hsat
890
+
| .neg (.conj ψ_a ψ_b) =>
891
+
rw [witnessSetTaken_neg_conj] at hw ⊢
892
+
exact witnessSetTaken_disj_one_mono S_Ψ σ _ (by exact not_and_or.mp hsat) ψ_L ψ_R hw
893
+
| .neg (.disj ψ_a ψ_b) =>
894
+
rw [witnessSetTaken_neg_disj] at hw ⊢
895
+
exact witnessSetTaken_disj_one_mono S_Ψ σ _ (by exact not_or.mp hsat) ψ_L ψ_R hw
896
+
| .neg (.neg ψ') =>
897
+
rw [witnessSetTaken_neg_neg] at hw ⊢
898
+
exact witnessSetTaken_disj_one_mono S_Ψ σ ψ' (by exact not_not.mp hsat) ψ_L ψ_R hw
899
+
termination_by ψ.weight
900
+
decreasing_by all_goals (simp only [Formula.weight]; omega)
901
+
902
+
/-! ## Dep-closure helper -/
903
+
904
+
private lemma encodeNNF_dep_closure [DecidableEq N] [DecidableEq V] [DecidableEq X]
905
+
[DecidableEq Y] [LT Y] [DecidableRel (· < · : Y → Y → Prop)]
906
+
(Y_x : X → Finset Y)
907
+
(S_Ψ : Finset (Package N V)) (σ : X → Y)
908
+
(hσ_dom : ∀ x, σ x ∈ Y_x x)
909
+
(CW : Finset (Package N' V'))
910
+
(mem_embed : ∀ p, p ∈ S_Ψ → embedPkg (X := X) (Y := Y) p ∈ CW)
911
+
(mem_var : ∀ x, (hvn.varN x, hvv.varValV (σ x)) ∈ CW)
912
+
(hCW_orig : ∀ n v, (hvn.origN n, v) ∈ CW →
913
+
∃ p ∈ S_Ψ, embedPkg (X := X) (Y := Y) p = (hvn.origN n, v))
914
+
(hCW_disj_zero : ∀ ψ_L ψ_R, (hvn.disjunctN ψ_L ψ_R, hvv.zeroV) ∈ CW →
915
+
(ψ_L.satisfies S_Ψ σ) ∧
916
+
witnessSetTaken (N' := N') (V' := V') S_Ψ σ ψ_L ⊆ CW ∧
917
+
witnessSetUntaken S_Ψ ψ_R ⊆ CW)
918
+
(hCW_disj_one : ∀ ψ_L ψ_R, (hvn.disjunctN ψ_L ψ_R, hvv.oneV) ∈ CW →
919
+
(ψ_R.satisfies S_Ψ σ) ∧
920
+
witnessSetUntaken (N' := N') (V' := V') S_Ψ ψ_L ⊆ CW ∧
921
+
witnessSetTaken S_Ψ σ ψ_R ⊆ CW)
922
+
(q₀ : Package N' V')
923
+
(ψ : Formula N V X Y)
924
+
(hwit : (q₀ ∉ CW ∧ witnessSetUntaken (N' := N') (V' := V') S_Ψ ψ ⊆ CW) ∨
925
+
((ψ.satisfies S_Ψ σ) ∧ witnessSetTaken S_Ψ σ ψ ⊆ CW))
926
+
(q : Package N' V')
927
+
(m : N') (vs : Finset V')
928
+
(henc : (q, m, vs) ∈ encodeNNF Y_x q₀ ψ)
929
+
(hq : q ∈ CW) :
930
+
∃ v ∈ vs, (m, v) ∈ CW := by
931
+
match ψ with
932
+
| .dep n dvs =>
933
+
simp only [encodeNNF, Finset.mem_singleton, Prod.mk.injEq] at henc
934
+
obtain ⟨rfl, rfl, rfl⟩ := henc
935
+
rcases hwit with ⟨hq₀, _⟩ | ⟨hsat, _⟩
936
+
· exact absurd hq hq₀
937
+
· obtain ⟨v, hv, hvS⟩ := hsat
938
+
exact ⟨hvv.origV v, Finset.mem_map.mpr ⟨v, hv, rfl⟩, mem_embed _ hvS⟩
939
+
| .conj ψ_L ψ_R =>
940
+
simp only [encodeNNF, Finset.mem_union] at henc
941
+
rcases henc with hL | hR
942
+
· have hwit' : (q₀ ∉ CW ∧ witnessSetUntaken (N' := N') (V' := V') S_Ψ ψ_L ⊆ CW) ∨
943
+
((ψ_L.satisfies S_Ψ σ) ∧ witnessSetTaken S_Ψ σ ψ_L ⊆ CW) := by
944
+
rcases hwit with ⟨hq₀, hu⟩ | ⟨hsat, ht⟩
945
+
· exact Or.inl ⟨hq₀, fun x hx => hu (by simp [witnessSetUntaken_conj]; exact Or.inl hx)⟩
946
+
· exact Or.inr ⟨hsat.1, fun x hx => ht (by simp [witnessSetTaken_conj]; exact Or.inl hx)⟩
947
+
exact encodeNNF_dep_closure Y_x S_Ψ σ hσ_dom CW mem_embed mem_var hCW_orig hCW_disj_zero hCW_disj_one
948
+
q₀ ψ_L hwit' q m vs hL hq
949
+
· have hwit' : (q₀ ∉ CW ∧ witnessSetUntaken (N' := N') (V' := V') S_Ψ ψ_R ⊆ CW) ∨
950
+
((ψ_R.satisfies S_Ψ σ) ∧ witnessSetTaken S_Ψ σ ψ_R ⊆ CW) := by
951
+
rcases hwit with ⟨hq₀, hu⟩ | ⟨hsat, ht⟩
952
+
· exact Or.inl ⟨hq₀, fun x hx => hu (by simp [witnessSetUntaken_conj]; exact Or.inr hx)⟩
953
+
· exact Or.inr ⟨hsat.2, fun x hx => ht (by simp [witnessSetTaken_conj]; exact Or.inr hx)⟩
954
+
exact encodeNNF_dep_closure Y_x S_Ψ σ hσ_dom CW mem_embed mem_var hCW_orig hCW_disj_zero hCW_disj_one
955
+
q₀ ψ_R hwit' q m vs hR hq
956
+
| .disj ψ_L ψ_R =>
957
+
rw [encodeNNF] at henc
958
+
rw [Finset.mem_union, Finset.mem_union] at henc
959
+
rcases henc with (hwrap | hbody) | hbody
960
+
· -- wrapper edge
961
+
simp only [Finset.mem_singleton, Prod.mk.injEq] at hwrap
962
+
obtain ⟨rfl, rfl, rfl⟩ := hwrap
963
+
rcases hwit with ⟨hq₀, _⟩ | ⟨hsat, hwit_t⟩
964
+
· exact absurd hq hq₀
965
+
· by_cases hψL_sat : ψ_L.satisfies S_Ψ σ
966
+
· refine ⟨hvv.zeroV, Finset.mem_insert_self _ _, ?_⟩
967
+
apply hwit_t; simp only [witnessSetTaken_disj, if_pos hψL_sat]
968
+
exact Finset.mem_union.mpr (Or.inl (Finset.mem_union.mpr (Or.inl
969
+
(Finset.mem_singleton.mpr rfl))))
970
+
· refine ⟨hvv.oneV, by simp [Finset.mem_insert], ?_⟩
971
+
apply hwit_t; simp only [witnessSetTaken_disj, if_neg hψL_sat]
972
+
exact Finset.mem_union.mpr (Or.inl (Finset.mem_union.mpr (Or.inl
973
+
(Finset.mem_singleton.mpr rfl))))
974
+
· -- body ψ_L
975
+
by_cases hq₀' : (hvn.disjunctN ψ_L ψ_R, hvv.zeroV) ∈ CW
976
+
· obtain ⟨hsat_L, htL, _⟩ := hCW_disj_zero ψ_L ψ_R hq₀'
977
+
exact encodeNNF_dep_closure Y_x S_Ψ σ hσ_dom CW mem_embed mem_var hCW_orig hCW_disj_zero hCW_disj_one
978
+
_ ψ_L (Or.inr ⟨hsat_L, htL⟩) q m vs hbody hq
979
+
· have hwL : witnessSetUntaken (N' := N') (V' := V') S_Ψ ψ_L ⊆ CW := by
980
+
rcases hwit with ⟨_, hu⟩ | ⟨_, ht⟩
981
+
· exact fun x hx => hu (by simp [witnessSetUntaken_disj]; exact Or.inl hx)
982
+
· by_cases hψL_sat : ψ_L.satisfies S_Ψ σ
983
+
· exfalso; apply hq₀'
984
+
apply ht; simp only [witnessSetTaken_disj, if_pos hψL_sat]
985
+
exact Finset.mem_union.mpr (Or.inl (Finset.mem_union.mpr (Or.inl
986
+
(Finset.mem_singleton.mpr rfl))))
987
+
· exact fun x hx => ht (by
988
+
simp only [witnessSetTaken_disj, if_neg hψL_sat]
989
+
exact Finset.mem_union.mpr (Or.inl (Finset.mem_union.mpr (Or.inr hx))))
990
+
exact encodeNNF_dep_closure Y_x S_Ψ σ hσ_dom CW mem_embed mem_var hCW_orig hCW_disj_zero hCW_disj_one
991
+
_ ψ_L (Or.inl ⟨hq₀', hwL⟩) q m vs hbody hq
992
+
· -- body ψ_R
993
+
by_cases hq₀' : (hvn.disjunctN ψ_L ψ_R, hvv.oneV) ∈ CW
994
+
· obtain ⟨hsat_R, _, htR⟩ := hCW_disj_one ψ_L ψ_R hq₀'
995
+
exact encodeNNF_dep_closure Y_x S_Ψ σ hσ_dom CW mem_embed mem_var hCW_orig hCW_disj_zero hCW_disj_one
996
+
_ ψ_R (Or.inr ⟨hsat_R, htR⟩) q m vs hbody hq
997
+
· have hwR : witnessSetUntaken (N' := N') (V' := V') S_Ψ ψ_R ⊆ CW := by
998
+
rcases hwit with ⟨_, hu⟩ | ⟨_, ht⟩
999
+
· exact fun x hx => hu (by simp [witnessSetUntaken_disj]; exact Or.inr hx)
1000
+
· by_cases hψL_sat : ψ_L.satisfies S_Ψ σ
1001
+
· exact fun x hx => ht (by
1002
+
simp only [witnessSetTaken_disj, if_pos hψL_sat]
1003
+
exact Finset.mem_union.mpr (Or.inr hx))
1004
+
· exfalso; apply hq₀'
1005
+
apply ht; simp only [witnessSetTaken_disj, if_neg hψL_sat]
1006
+
exact Finset.mem_union.mpr (Or.inl (Finset.mem_union.mpr (Or.inl
1007
+
(Finset.mem_singleton.mpr rfl))))
1008
+
exact encodeNNF_dep_closure Y_x S_Ψ σ hσ_dom CW mem_embed mem_var hCW_orig hCW_disj_zero hCW_disj_one
1009
+
_ ψ_R (Or.inl ⟨hq₀', hwR⟩) q m vs hbody hq
1010
+
| .varCmp x ω y =>
1011
+
simp only [encodeNNF, Finset.mem_singleton, Prod.mk.injEq] at henc
1012
+
obtain ⟨rfl, rfl, rfl⟩ := henc
1013
+
-- The encoded dependency is (q₀, varN x, cmpVersionSet (Y_x x) ω y).
1014
+
-- Witness: use σ x -- by hwit (taken or untaken from variable's sat),
1015
+
-- we need σ x ∈ cmpVersionSet, which requires ω.eval (σ x) y.
1016
+
-- This is exactly what `Formula.varCmp x ω y` being satisfied means.
1017
+
rcases hwit with ⟨hq₀, _⟩ | ⟨hsat, _⟩
1018
+
· exact absurd hq hq₀
1019
+
· refine ⟨hvv.varValV (σ x), ?_, mem_var x⟩
1020
+
rw [mem_cmpVersionSet]
1021
+
exact ⟨hσ_dom x, hsat⟩
1022
+
| .neg (.dep n dvs) =>
1023
+
simp only [encodeNNF, Finset.mem_union, Finset.mem_singleton, Finset.mem_image,
1024
+
Prod.mk.injEq] at henc
1025
+
rcases henc with ⟨rfl, rfl, rfl⟩ | ⟨u, hu, rfl, rfl, rfl⟩
1026
+
· rcases hwit with ⟨hq₀, _⟩ | ⟨_, hwit_t⟩
1027
+
· exact absurd hq hq₀
1028
+
· refine ⟨hvv.oneV, Finset.mem_singleton.mpr rfl, ?_⟩
1029
+
apply hwit_t; simp only [witnessSetTaken_neg_dep]
1030
+
exact Finset.mem_singleton.mpr rfl
1031
+
· obtain ⟨⟨pn, pv⟩, hpS, hpeq⟩ := hCW_orig n (hvv.origV u) hq
1032
+
simp only [embedPkg, Prod.mk.injEq] at hpeq
1033
+
have h1 := hvn.origN.injective hpeq.1
1034
+
have h2 := hvv.origV.injective hpeq.2
1035
+
subst h1; subst h2
1036
+
rcases hwit with ⟨_, hwit_u⟩ | ⟨hsat, _⟩
1037
+
· refine ⟨hvv.zeroV, Finset.mem_singleton.mpr rfl, ?_⟩
1038
+
apply hwit_u; rw [witnessSetUntaken_neg_dep]
1039
+
rw [if_pos (⟨pv, hu, hpS⟩ : ∃ u ∈ dvs, ((pn, u) : Package N V) ∈ S_Ψ)]
1040
+
exact Finset.mem_singleton.mpr rfl
1041
+
· exfalso; exact hsat ⟨pv, hu, hpS⟩
1042
+
| .neg (.varCmp x ω y) =>
1043
+
have keyE : encodeNNF Y_x q₀ (Formula.neg (Formula.varCmp x ω y) : Formula N V X Y) =
1044
+
encodeNNF Y_x q₀ (.varCmp x (CmpOp.complement ω) y :
1045
+
Formula N V X Y) := encodeNNF.eq_6 Y_x q₀ x ω y
1046
+
rw [keyE] at henc
1047
+
have hwit' : (q₀ ∉ CW ∧ witnessSetUntaken (N' := N') (V' := V') S_Ψ
1048
+
(Formula.varCmp x (CmpOp.complement ω) y) ⊆ CW) ∨
1049
+
(((Formula.varCmp x (CmpOp.complement ω) y : Formula N V X Y).satisfies S_Ψ σ) ∧
1050
+
witnessSetTaken S_Ψ σ (Formula.varCmp x (CmpOp.complement ω) y) ⊆ CW) := by
1051
+
rcases hwit with ⟨hq₀, hu⟩ | ⟨hsat, ht⟩
1052
+
· exact Or.inl ⟨hq₀, by rw [← witnessSetUntaken_neg_varCmp]; exact hu⟩
1053
+
· refine Or.inr ⟨?_, by rw [← witnessSetTaken_neg_varCmp]; exact ht⟩
1054
+
show (CmpOp.complement ω).eval (σ x) y = true
1055
+
exact (complement_eval ω _ _).mpr hsat
1056
+
exact encodeNNF_dep_closure Y_x S_Ψ σ hσ_dom CW mem_embed mem_var hCW_orig hCW_disj_zero hCW_disj_one
1057
+
q₀ _ hwit' q m vs henc hq
1058
+
| .neg (.conj ψ_L ψ_R) =>
1059
+
have keyE : encodeNNF Y_x q₀ (.neg (.conj ψ_L ψ_R) : Formula N V X Y) =
1060
+
encodeNNF Y_x q₀ (.disj (.neg ψ_L) (.neg ψ_R)) := by simp [encodeNNF]
1061
+
rw [keyE] at henc
1062
+
have hwit' : (q₀ ∉ CW ∧ witnessSetUntaken (N' := N') (V' := V') S_Ψ
1063
+
(.disj (.neg ψ_L) (.neg ψ_R)) ⊆ CW) ∨
1064
+
(((Formula.disj (.neg ψ_L) (.neg ψ_R) : Formula N V X Y).satisfies S_Ψ σ) ∧
1065
+
witnessSetTaken S_Ψ σ (.disj (.neg ψ_L) (.neg ψ_R)) ⊆ CW) := by
1066
+
rcases hwit with ⟨hq₀, hu⟩ | ⟨hsat, ht⟩
1067
+
· exact Or.inl ⟨hq₀, by rw [← witnessSetUntaken_neg_conj]; exact hu⟩
1068
+
· exact Or.inr ⟨not_and_or.mp hsat, by rw [← witnessSetTaken_neg_conj]; exact ht⟩
1069
+
exact encodeNNF_dep_closure Y_x S_Ψ σ hσ_dom CW mem_embed mem_var hCW_orig hCW_disj_zero hCW_disj_one
1070
+
q₀ _ hwit' q m vs henc hq
1071
+
| .neg (.disj ψ_L ψ_R) =>
1072
+
have keyE : encodeNNF Y_x q₀ (.neg (.disj ψ_L ψ_R) : Formula N V X Y) =
1073
+
encodeNNF Y_x q₀ (.conj (.neg ψ_L) (.neg ψ_R)) := by simp [encodeNNF]
1074
+
rw [keyE] at henc
1075
+
have hwit' : (q₀ ∉ CW ∧ witnessSetUntaken (N' := N') (V' := V') S_Ψ
1076
+
(.conj (.neg ψ_L) (.neg ψ_R)) ⊆ CW) ∨
1077
+
(((Formula.conj (.neg ψ_L) (.neg ψ_R) : Formula N V X Y).satisfies S_Ψ σ) ∧
1078
+
witnessSetTaken S_Ψ σ (.conj (.neg ψ_L) (.neg ψ_R)) ⊆ CW) := by
1079
+
rcases hwit with ⟨hq₀, hu⟩ | ⟨hsat, ht⟩
1080
+
· exact Or.inl ⟨hq₀, by rw [← witnessSetUntaken_neg_disj]; exact hu⟩
1081
+
· exact Or.inr ⟨not_or.mp hsat, by rw [← witnessSetTaken_neg_disj]; exact ht⟩
1082
+
exact encodeNNF_dep_closure Y_x S_Ψ σ hσ_dom CW mem_embed mem_var hCW_orig hCW_disj_zero hCW_disj_one
1083
+
q₀ _ hwit' q m vs henc hq
1084
+
| .neg (.neg ψ') =>
1085
+
have keyE : encodeNNF Y_x q₀ (.neg (.neg ψ') : Formula N V X Y) =
1086
+
encodeNNF Y_x q₀ ψ' := by simp [encodeNNF]
1087
+
rw [keyE] at henc
1088
+
have hwit' : (q₀ ∉ CW ∧ witnessSetUntaken (N' := N') (V' := V') S_Ψ ψ' ⊆ CW) ∨
1089
+
((ψ'.satisfies S_Ψ σ) ∧ witnessSetTaken S_Ψ σ ψ' ⊆ CW) := by
1090
+
rcases hwit with ⟨hq₀, hu⟩ | ⟨hsat, ht⟩
1091
+
· exact Or.inl ⟨hq₀, by rw [← witnessSetUntaken_neg_neg]; exact hu⟩
1092
+
· exact Or.inr ⟨not_not.mp hsat, by rw [← witnessSetTaken_neg_neg]; exact ht⟩
1093
+
exact encodeNNF_dep_closure Y_x S_Ψ σ hσ_dom CW mem_embed mem_var hCW_orig hCW_disj_zero hCW_disj_one
1094
+
q₀ ψ' hwit' q m vs henc hq
1095
+
termination_by ψ.weight
1096
+
decreasing_by all_goals (simp only [Formula.weight]; omega)
1097
+
1098
+
/-! ## CW disjunct structure lemmas -/
1099
+
1100
+
private lemma completenessWitness_disj_zero [DecidableEq N] [DecidableEq V] [DecidableEq X]
1101
+
[DecidableEq Y] [LT Y] [DecidableRel (· < · : Y → Y → Prop)] [Fintype X]
1102
+
{S_Ψ : Finset (Package N V)} {Δ_Ψ : VFDepRel N V X Y} {σ : X → Y}
1103
+
(ψ_L ψ_R : Formula N V X Y)
1104
+
(hmem : (hvn.disjunctN ψ_L ψ_R, hvv.zeroV) ∈
1105
+
completenessWitness (N' := N') (V' := V') S_Ψ Δ_Ψ σ) :
1106
+
(ψ_L.satisfies S_Ψ σ) ∧
1107
+
witnessSetTaken (N' := N') (V' := V') S_Ψ σ ψ_L ⊆ completenessWitness S_Ψ Δ_Ψ σ ∧
1108
+
witnessSetUntaken S_Ψ ψ_R ⊆ completenessWitness S_Ψ Δ_Ψ σ := by
1109
+
-- Extract the formula witness producer
1110
+
unfold completenessWitness at hmem
1111
+
simp only [Finset.mem_union, Finset.mem_image, Finset.mem_biUnion] at hmem
1112
+
rcases hmem with (⟨p, _, hp⟩ | ⟨⟨p, ψ⟩, hdep, hw⟩) | ⟨x, _, heq⟩
1113
+
· -- from embedPkg
1114
+
simp only [embedPkg, Prod.mk.injEq] at hp
1115
+
exact absurd hp.1.symm (hvn.disjunctN_ne_origN _ _ _)
1116
+
· -- from witnessSet
1117
+
split_ifs at hw with hpS
1118
+
· -- taken
1119
+
obtain ⟨hsat, h1, h2⟩ := witnessSetTaken_disj_zero_mono S_Ψ σ ψ ψ_L ψ_R hw
1120
+
refine ⟨hsat, ?_, ?_⟩
1121
+
· intro x hx
1122
+
unfold completenessWitness
1123
+
apply Finset.mem_union_left
1124
+
apply Finset.mem_union_right
1125
+
exact Finset.mem_biUnion.mpr ⟨⟨p, ψ⟩, hdep, by
1126
+
show x ∈ (if p ∈ S_Ψ then _ else _)
1127
+
rw [if_pos hpS]; exact h1 hx⟩
1128
+
· intro x hx
1129
+
unfold completenessWitness
1130
+
apply Finset.mem_union_left
1131
+
apply Finset.mem_union_right
1132
+
exact Finset.mem_biUnion.mpr ⟨⟨p, ψ⟩, hdep, by
1133
+
show x ∈ (if p ∈ S_Ψ then _ else _)
1134
+
rw [if_pos hpS]; exact h2 hx⟩
1135
+
· exact (witnessSetUntaken_disjunct_det S_Ψ ψ ψ_L ψ_R _ hw).elim
1136
+
· -- from variable packages: contradicts disjunctN ≠ varN
1137
+
simp only [Prod.mk.injEq] at heq
1138
+
exact absurd heq.1.symm (hvn.disjunctN_ne_varN _ _ _)
1139
+
1140
+
private lemma completenessWitness_disj_one [DecidableEq N] [DecidableEq V] [DecidableEq X]
1141
+
[DecidableEq Y] [LT Y] [DecidableRel (· < · : Y → Y → Prop)] [Fintype X]
1142
+
{R_Ψ : Real N V} {S_Ψ : Finset (Package N V)} {Δ_Ψ : VFDepRel N V X Y}
1143
+
{r : Package N V} {σ : X → Y}
1144
+
(hres : IsVFResolution R_Ψ Δ_Ψ r S_Ψ σ)
1145
+
(ψ_L ψ_R : Formula N V X Y)
1146
+
(hmem : (hvn.disjunctN ψ_L ψ_R, hvv.oneV) ∈
1147
+
completenessWitness (N' := N') (V' := V') S_Ψ Δ_Ψ σ) :
1148
+
(ψ_R.satisfies S_Ψ σ) ∧
1149
+
witnessSetUntaken (N' := N') (V' := V') S_Ψ ψ_L ⊆ completenessWitness S_Ψ Δ_Ψ σ ∧
1150
+
witnessSetTaken S_Ψ σ ψ_R ⊆ completenessWitness S_Ψ Δ_Ψ σ := by
1151
+
unfold completenessWitness at hmem
1152
+
simp only [Finset.mem_union, Finset.mem_image, Finset.mem_biUnion] at hmem
1153
+
rcases hmem with (⟨p, _, hp⟩ | ⟨⟨p, ψ⟩, hdep, hw⟩) | ⟨x, _, heq⟩
1154
+
· simp only [embedPkg, Prod.mk.injEq] at hp
1155
+
exact absurd hp.1.symm (hvn.disjunctN_ne_origN _ _ _)
1156
+
· split_ifs at hw with hpS
1157
+
· have hsat : ψ.satisfies S_Ψ σ := hres.formula_closure p hpS ψ hdep
1158
+
obtain ⟨hsatR, h1, h2⟩ := witnessSetTaken_disj_one_mono S_Ψ σ ψ hsat ψ_L ψ_R hw
1159
+
refine ⟨hsatR, ?_, ?_⟩
1160
+
· intro x hx
1161
+
unfold completenessWitness
1162
+
apply Finset.mem_union_left
1163
+
apply Finset.mem_union_right
1164
+
exact Finset.mem_biUnion.mpr ⟨⟨p, ψ⟩, hdep, by
1165
+
show x ∈ (if p ∈ S_Ψ then _ else _)
1166
+
rw [if_pos hpS]; exact h1 hx⟩
1167
+
· intro x hx
1168
+
unfold completenessWitness
1169
+
apply Finset.mem_union_left
1170
+
apply Finset.mem_union_right
1171
+
exact Finset.mem_biUnion.mpr ⟨⟨p, ψ⟩, hdep, by
1172
+
show x ∈ (if p ∈ S_Ψ then _ else _)
1173
+
rw [if_pos hpS]; exact h2 hx⟩
1174
+
· exact (witnessSetUntaken_disjunct_det S_Ψ ψ ψ_L ψ_R _ hw).elim
1175
+
· simp only [Prod.mk.injEq] at heq
1176
+
exact absurd heq.1.symm (hvn.disjunctN_ne_varN _ _ _)
1177
+
1178
+
/-! ## Version pinning -/
1179
+
1180
+
private lemma witnessSet_version_pinning [DecidableEq N] [DecidableEq V] [DecidableEq X]
1181
+
[DecidableEq Y] [LT Y] [DecidableRel (· < · : Y → Y → Prop)]
1182
+
{R_Ψ : Real N V} {Δ_Ψ : VFDepRel N V X Y} {r : Package N V}
1183
+
{S_Ψ : Finset (Package N V)} {σ : X → Y}
1184
+
(hres : IsVFResolution R_Ψ Δ_Ψ r S_Ψ σ)
1185
+
{n : N'} {v₁ v₂ : V'}
1186
+
(h1 : ∃ p ψ, (p, ψ) ∈ Δ_Ψ ∧
1187
+
(n, v₁) ∈ (if p ∈ S_Ψ then witnessSetTaken (N' := N') (V' := V') S_Ψ σ ψ
1188
+
else witnessSetUntaken S_Ψ ψ))
1189
+
(h2 : ∃ p ψ, (p, ψ) ∈ Δ_Ψ ∧
1190
+
(n, v₂) ∈ (if p ∈ S_Ψ then witnessSetTaken (N' := N') (V' := V') S_Ψ σ ψ
1191
+
else witnessSetUntaken S_Ψ ψ)) :
1192
+
v₁ = v₂ := by
1193
+
obtain ⟨p₁, ψ₁, hd₁, hw₁⟩ := h1
1194
+
obtain ⟨p₂, ψ₂, hd₂, hw₂⟩ := h2
1195
+
match hsyn : hvn.trySyntheticN n with
1196
+
| some (n', vs) =>
1197
+
have hneq : n = hvn.syntheticN n' vs := (hvn.trySyntheticN_some _ _ hsyn).symm
1198
+
subst hneq
1199
+
have getv : ∀ {p ψ v}, (p, ψ) ∈ Δ_Ψ →
1200
+
(hvn.syntheticN n' vs, v) ∈
1201
+
(if p ∈ S_Ψ then witnessSetTaken (N' := N') (V' := V') S_Ψ σ ψ
1202
+
else witnessSetUntaken S_Ψ ψ) →
1203
+
v = if ∃ u ∈ vs, ((n', u) : Package N V) ∈ S_Ψ then hvv.zeroV else hvv.oneV := by
1204
+
intro p ψ v hd hmem
1205
+
split at hmem
1206
+
· rename_i hpS
1207
+
have hsat : ψ.satisfies S_Ψ σ := hres.formula_closure p hpS ψ hd
1208
+
exact witnessSetTaken_negDep_det S_Ψ σ ψ hsat n' vs v hmem
1209
+
· have hv := witnessSetUntaken_negDep_det S_Ψ ψ n' vs v hmem
1210
+
have hex := witnessSetUntaken_negDep_exists S_Ψ ψ n' vs v hmem
1211
+
rw [hv, if_pos hex]
1212
+
rw [getv hd₁ hw₁, getv hd₂ hw₂]
1213
+
| none =>
1214
+
have hcls₁ : (∃ n' vs, n = hvn.syntheticN n' vs) ∨ (∃ ψ_L ψ_R, n = hvn.disjunctN ψ_L ψ_R) := by
1215
+
split at hw₁
1216
+
· exact witnessSetTaken_name_classify S_Ψ σ ψ₁ n v₁ hw₁
1217
+
· exact witnessSetUntaken_name_classify S_Ψ ψ₁ n v₁ hw₁
1218
+
rcases hcls₁ with ⟨n', vs, hn⟩ | ⟨ψ_L, ψ_R, hn⟩
1219
+
· subst hn
1220
+
simp [hvn.trySyntheticN_syntheticN] at hsyn
1221
+
· subst hn
1222
+
have getv : ∀ {p ψ v}, (p, ψ) ∈ Δ_Ψ →
1223
+
(hvn.disjunctN ψ_L ψ_R, v) ∈
1224
+
(if p ∈ S_Ψ then witnessSetTaken (N' := N') (V' := V') S_Ψ σ ψ
1225
+
else witnessSetUntaken S_Ψ ψ) →
1226
+
v = if ψ_L.satisfies S_Ψ σ then hvv.zeroV else hvv.oneV := by
1227
+
intro p ψ v hd hmem
1228
+
split at hmem
1229
+
· exact witnessSetTaken_disjunct_det S_Ψ σ ψ ψ_L ψ_R v hmem
1230
+
· exact (witnessSetUntaken_disjunct_det S_Ψ ψ ψ_L ψ_R v hmem).elim
1231
+
rw [getv hd₁ hw₁, getv hd₂ hw₂]
1232
+
1233
+
/-! ## Main completeness theorem.
1234
+
1235
+
Mirrors PF: no `hΔ_cov`, no `hvu_wit`, no `p₀` plumbing -- just an
1236
+
`IsVFResolution` hypothesis. -/
1237
+
1238
+
-- Paper Thm 4.6.5 (Variable Formula Reduction Completeness).
1239
+
theorem varFormula_completeness
1240
+
[DecidableEq N] [DecidableEq V] [DecidableEq X] [DecidableEq Y]
1241
+
[LT Y] [DecidableRel (· < · : Y → Y → Prop)] [Fintype X]
1242
+
(Y_x : X → Finset Y)
1243
+
(R_Ψ : Real N V) (Δ_Ψ : VFDepRel N V X Y)
1244
+
(r : Package N V) (σ : X → Y)
1245
+
(hσ_dom : ∀ x, σ x ∈ Y_x x)
1246
+
(S_Ψ : Finset (Package N V))
1247
+
(hres : IsVFResolution R_Ψ Δ_Ψ r S_Ψ σ) :
1248
+
IsResolution (vfReal (N' := N') (V' := V') Y_x R_Ψ Δ_Ψ)
1249
+
(vfDeps (N' := N') (V' := V') Y_x Δ_Ψ)
1250
+
(embedPkg (X := X) (Y := Y) r)
1251
+
(completenessWitness S_Ψ Δ_Ψ σ) := by
1252
+
-- Abbreviation
1253
+
set CW := completenessWitness S_Ψ Δ_Ψ σ with hCW_def
1254
+
-- Convenience: embedPkg p is in CW when p ∈ S_Ψ
1255
+
have mem_embed : ∀ p, p ∈ S_Ψ → embedPkg (X := X) (Y := Y) p ∈ CW := by
1256
+
intro p hp; show _ ∈ completenessWitness _ _ _; unfold completenessWitness
1257
+
exact Finset.mem_union_left _ (Finset.mem_union_left _
1258
+
(Finset.mem_image_of_mem _ hp))
1259
+
-- Convenience: variable packages are in CW
1260
+
have mem_var : ∀ x, (hvn.varN x, hvv.varValV (σ x)) ∈ CW := by
1261
+
intro x; show _ ∈ completenessWitness _ _ _; unfold completenessWitness
1262
+
exact Finset.mem_union_right _
1263
+
(Finset.mem_image_of_mem _ (Finset.mem_univ _))
1264
+
refine ⟨?_, ?_, ?_, ?_⟩
1265
+
· -- subset
1266
+
intro q hq
1267
+
show q ∈ vfReal Y_x R_Ψ Δ_Ψ
1268
+
simp only [hCW_def, completenessWitness, Finset.mem_union, Finset.mem_image,
1269
+
Finset.mem_biUnion] at hq
1270
+
rcases hq with (⟨p, hp, rfl⟩ | ⟨⟨p, ψ⟩, hdep, hw⟩) | hmem
1271
+
· -- from S_Ψ.image embedPkg
1272
+
unfold vfReal
1273
+
exact Finset.mem_union_left _ (Finset.mem_union_left _
1274
+
(Finset.mem_image_of_mem _ (hres.subset hp)))
1275
+
· -- from witnessSet
1276
+
unfold vfReal
1277
+
apply Finset.mem_union_left
1278
+
apply Finset.mem_union_right
1279
+
exact Finset.mem_biUnion.mpr ⟨⟨p, ψ⟩, hdep, by
1280
+
split at hw
1281
+
· exact witnessSetTaken_subset_witnessPackages S_Ψ σ _ ψ hw
1282
+
· exact witnessSetUntaken_subset_witnessPackages S_Ψ _ ψ hw⟩
1283
+
· -- from variable packages
1284
+
obtain ⟨x, _, rfl⟩ := hmem
1285
+
unfold vfReal
1286
+
apply Finset.mem_union_right
1287
+
exact Finset.mem_biUnion.mpr ⟨x, Finset.mem_univ _,
1288
+
Finset.mem_image_of_mem _ (hσ_dom x)⟩
1289
+
· -- root_mem
1290
+
exact mem_embed r hres.root_mem
1291
+
· -- dep_closure
1292
+
have hCW_orig : ∀ n v, (hvn.origN n, v) ∈ CW →
1293
+
∃ p ∈ S_Ψ, embedPkg (X := X) (Y := Y) p = (hvn.origN n, v) := by
1294
+
intro n v hv
1295
+
simp only [hCW_def, completenessWitness, Finset.mem_union, Finset.mem_image,
1296
+
Finset.mem_biUnion] at hv
1297
+
rcases hv with (⟨p, hp, hpe⟩ | ⟨⟨p, ψ⟩, _, hw⟩) | ⟨x, _, heq⟩
1298
+
· exact ⟨p, hp, hpe⟩
1299
+
· split at hw
1300
+
· exact absurd hw (witnessSetTaken_not_orig S_Ψ σ ψ n _)
1301
+
· exact absurd hw (witnessSetUntaken_not_orig S_Ψ ψ n _)
1302
+
· simp only [Prod.mk.injEq] at heq
1303
+
exact absurd heq.1 (hvn.varN_ne_origN _ _)
1304
+
have hCW_disj_zero : ∀ ψ_L ψ_R, (hvn.disjunctN ψ_L ψ_R, hvv.zeroV) ∈ CW →
1305
+
(ψ_L.satisfies S_Ψ σ) ∧
1306
+
witnessSetTaken (N' := N') (V' := V') S_Ψ σ ψ_L ⊆ CW ∧
1307
+
witnessSetUntaken S_Ψ ψ_R ⊆ CW :=
1308
+
fun ψ_L ψ_R h => completenessWitness_disj_zero ψ_L ψ_R h
1309
+
have hCW_disj_one : ∀ ψ_L ψ_R, (hvn.disjunctN ψ_L ψ_R, hvv.oneV) ∈ CW →
1310
+
(ψ_R.satisfies S_Ψ σ) ∧
1311
+
witnessSetUntaken (N' := N') (V' := V') S_Ψ ψ_L ⊆ CW ∧
1312
+
witnessSetTaken S_Ψ σ ψ_R ⊆ CW :=
1313
+
fun ψ_L ψ_R h => completenessWitness_disj_one hres ψ_L ψ_R h
1314
+
intro q hq m vs' hd
1315
+
simp only [vfDeps, encode, Finset.mem_biUnion] at hd
1316
+
obtain ⟨⟨p, ψ⟩, hdep, henc⟩ := hd
1317
+
by_cases hp : p ∈ S_Ψ
1318
+
· have hsat : ψ.satisfies S_Ψ σ := hres.formula_closure p hp ψ hdep
1319
+
have hwit : witnessSetTaken (N' := N') (V' := V') S_Ψ σ ψ ⊆ CW := by
1320
+
intro x hx
1321
+
show x ∈ completenessWitness _ _ _
1322
+
unfold completenessWitness
1323
+
apply Finset.mem_union_left
1324
+
apply Finset.mem_union_right
1325
+
exact Finset.mem_biUnion.mpr ⟨⟨p, ψ⟩, hdep, by
1326
+
show x ∈ (if p ∈ S_Ψ then _ else _); rw [if_pos hp]; exact hx⟩
1327
+
exact encodeNNF_dep_closure Y_x S_Ψ σ hσ_dom CW mem_embed mem_var hCW_orig
1328
+
hCW_disj_zero hCW_disj_one (embedPkg p) ψ (Or.inr ⟨hsat, hwit⟩)
1329
+
q m vs' henc hq
1330
+
· have hwit : witnessSetUntaken (N' := N') (V' := V') S_Ψ ψ ⊆ CW := by
1331
+
intro x hx
1332
+
show x ∈ completenessWitness _ _ _
1333
+
unfold completenessWitness
1334
+
apply Finset.mem_union_left
1335
+
apply Finset.mem_union_right
1336
+
exact Finset.mem_biUnion.mpr ⟨⟨p, ψ⟩, hdep, by
1337
+
show x ∈ (if p ∈ S_Ψ then _ else _); rw [if_neg hp]; exact hx⟩
1338
+
have hq₀ : embedPkg (X := X) (Y := Y) p ∉ CW := by
1339
+
intro hmem
1340
+
apply hp
1341
+
have : (hvn.origN p.1, hvv.origV p.2) ∈ CW := by
1342
+
show embedPkg p ∈ _; exact hmem
1343
+
obtain ⟨p', hp', hpe⟩ := hCW_orig p.1 (hvv.origV p.2) this
1344
+
simp only [embedPkg, Prod.mk.injEq] at hpe
1345
+
have h1 := hvn.origN.injective hpe.1
1346
+
have h2 := hvv.origV.injective hpe.2
1347
+
cases p with | mk n v => cases p' with | mk n' v' =>
1348
+
simp at h1 h2; subst h1; subst h2; exact hp'
1349
+
exact encodeNNF_dep_closure Y_x S_Ψ σ hσ_dom CW mem_embed mem_var hCW_orig
1350
+
hCW_disj_zero hCW_disj_one (embedPkg p) ψ (Or.inl ⟨hq₀, hwit⟩)
1351
+
q m vs' henc hq
1352
+
· -- version_unique
1353
+
intro n v₁ v₂ hv₁ hv₂
1354
+
simp only [hCW_def, completenessWitness, Finset.mem_union, Finset.mem_image,
1355
+
Finset.mem_biUnion] at hv₁ hv₂
1356
+
-- Three cases for each: original embed, witnessSet, or variable package.
1357
+
rcases hv₁ with (⟨p₁, hp₁, heq1⟩ | ⟨⟨p₁, ψ₁⟩, hd₁, hw₁⟩) | ⟨x₁, _, heq1⟩ <;>
1358
+
rcases hv₂ with (⟨p₂, hp₂, heq2⟩ | ⟨⟨p₂, ψ₂⟩, hd₂, hw₂⟩) | ⟨x₂, _, heq2⟩
1359
+
· -- both original
1360
+
obtain ⟨n₁, w₁⟩ := p₁; obtain ⟨n₂, w₂⟩ := p₂
1361
+
simp only [embedPkg, Prod.mk.injEq] at heq1 heq2
1362
+
obtain ⟨h1n, rfl⟩ := heq1; obtain ⟨h2n, rfl⟩ := heq2
1363
+
have := hvn.origN.injective (h1n.trans h2n.symm); subst this
1364
+
exact congrArg hvv.origV (hres.version_unique _ _ _ hp₁ hp₂)
1365
+
· -- v₁ from embedPkg, v₂ from witnessSet
1366
+
simp only [embedPkg, Prod.mk.injEq] at heq1
1367
+
obtain ⟨rfl, rfl⟩ := heq1
1368
+
split at hw₂
1369
+
· exact absurd hw₂ (witnessSetTaken_not_orig S_Ψ σ ψ₂ _ _)
1370
+
· exact absurd hw₂ (witnessSetUntaken_not_orig S_Ψ ψ₂ _ _)
1371
+
· -- v₁ from embedPkg, v₂ from variable: origN ≠ varN
1372
+
simp only [embedPkg, Prod.mk.injEq] at heq1
1373
+
simp only [Prod.mk.injEq] at heq2
1374
+
have : hvn.origN p₁.1 = hvn.varN x₂ := heq1.1.trans heq2.1.symm
1375
+
exact absurd this (hvn.origN_ne_varN _ _)
1376
+
· -- v₁ from witnessSet, v₂ from embedPkg
1377
+
simp only [embedPkg, Prod.mk.injEq] at heq2
1378
+
obtain ⟨rfl, rfl⟩ := heq2
1379
+
split at hw₁
1380
+
· exact absurd hw₁ (witnessSetTaken_not_orig S_Ψ σ ψ₁ _ _)
1381
+
· exact absurd hw₁ (witnessSetUntaken_not_orig S_Ψ ψ₁ _ _)
1382
+
· -- both witnessSet: use witnessSet_version_pinning
1383
+
exact witnessSet_version_pinning hres ⟨p₁, ψ₁, hd₁, hw₁⟩ ⟨p₂, ψ₂, hd₂, hw₂⟩
1384
+
· -- v₁ from witnessSet, v₂ from variable: n = varN x₂; witnessSet doesn't produce varN
1385
+
simp only [Prod.mk.injEq] at heq2
1386
+
obtain ⟨hneq, rfl⟩ := heq2
1387
+
rw [← hneq] at hw₁
1388
+
split at hw₁
1389
+
· exact absurd hw₁ (witnessSetTaken_not_varN S_Ψ σ ψ₁ _ _)
1390
+
· exact absurd hw₁ (witnessSetUntaken_not_varN S_Ψ ψ₁ _ _)
1391
+
· -- v₁ from variable, v₂ from embedPkg
1392
+
simp only [embedPkg, Prod.mk.injEq] at heq2
1393
+
simp only [Prod.mk.injEq] at heq1
1394
+
have : hvn.origN p₂.1 = hvn.varN x₁ := heq2.1.trans heq1.1.symm
1395
+
exact absurd this (hvn.origN_ne_varN _ _)
1396
+
· -- v₁ from variable, v₂ from witnessSet
1397
+
simp only [Prod.mk.injEq] at heq1
1398
+
obtain ⟨hneq, rfl⟩ := heq1
1399
+
rw [← hneq] at hw₂
1400
+
split at hw₂
1401
+
· exact absurd hw₂ (witnessSetTaken_not_varN S_Ψ σ ψ₂ _ _)
1402
+
· exact absurd hw₂ (witnessSetUntaken_not_varN S_Ψ ψ₂ _ _)
1403
+
· -- both variable: same name forces same x, so same version
1404
+
simp only [Prod.mk.injEq] at heq1 heq2
1405
+
obtain ⟨hn1, rfl⟩ := heq1; obtain ⟨hn2, rfl⟩ := heq2
1406
+
have hx : x₁ = x₂ := hvn.varN.injective (hn1.trans hn2.symm)
1407
+
rw [hx]
1408
+
1409
+
end PackageCalculus.VarFormula
+252
PackageCalculus/Extensions/VariableFormula/Reduction/Definition.lean
+252
PackageCalculus/Extensions/VariableFormula/Reduction/Definition.lean
···
1
+
import PackageCalculus.Extensions.VariableFormula.Definition
2
+
import PackageCalculus.Extensions.Conflict.Reduction.Definition
3
+
4
+
/-! # Variable-formula extension: reduction
5
+
6
+
Encodes formulae with package and version variables into the core calculus by
7
+
materialising a candidate witness per literal and routing dependencies through
8
+
synthetic names. -/
9
+
10
+
namespace PackageCalculus.VarFormula
11
+
12
+
variable {N : Type*} {V : Type*} {X : Type*} {Y : Type*}
13
+
14
+
/-- Concrete name carrier for the Variable Formula calculus. Single
15
+
`var x` constructor (no global/local split). -/
16
+
inductive VFName (N V X Y : Type*) where
17
+
| orig : N → VFName N V X Y
18
+
| var : X → VFName N V X Y
19
+
| disjunct : Formula N V X Y → Formula N V X Y → VFName N V X Y
20
+
| negDep : N → Finset V → VFName N V X Y
21
+
22
+
inductive VFVersion (V Y : Type*) where
23
+
| orig : V → VFVersion V Y
24
+
| zero : VFVersion V Y
25
+
| one : VFVersion V Y
26
+
| varVal : Y → VFVersion V Y
27
+
28
+
variable {N' : Type*} [DecidableEq N'] {V' : Type*} [DecidableEq V']
29
+
variable [hvn : HasVFNames N V X Y N'] [hvv : HasVFVersions V Y V']
30
+
31
+
def embedPkg (p : Package N V) : Package N' V' :=
32
+
(hvn.origN p.1, hvv.origV p.2)
33
+
34
+
/-- The logical complement of a comparison operator. -/
35
+
def CmpOp.complement : PackageCalculus.CmpOp → PackageCalculus.CmpOp
36
+
| .ge => .lt
37
+
| .gt => .le
38
+
| .le => .gt
39
+
| .lt => .ge
40
+
| .eq => .ne
41
+
| .ne => .eq
42
+
43
+
def Formula.weight : Formula N V X Y → Nat
44
+
| .dep _ _ => 0
45
+
| .conj ψ₁ ψ₂ => ψ₁.weight + ψ₂.weight + 2
46
+
| .disj ψ₁ ψ₂ => ψ₁.weight + ψ₂.weight + 2
47
+
| .neg ψ => 3 * (ψ.weight + 1)
48
+
| .varCmp _ _ _ => 0
49
+
50
+
instance cmpOp_eval_decidable [inst_lt : LT Y] [DecidableEq Y]
51
+
[DecidableRel (inst_lt.lt : Y → Y → Prop)]
52
+
(ω : PackageCalculus.CmpOp) (y : Y) : DecidablePred (fun y' => ω.eval y' y = true) := by
53
+
intro y'
54
+
exact inferInstance
55
+
56
+
/-- Restrict the variable-domain `Y_x` of values satisfying `ω_y y` and embed
57
+
into `V'`. The domain `Y_x` is supplied as an argument. -/
58
+
def cmpVersionSet [LT Y] [DecidableEq Y] [DecidableRel (· < · : Y → Y → Prop)]
59
+
(Y_x : Finset Y) (ω : PackageCalculus.CmpOp) (y : Y) : Finset V' :=
60
+
(Y_x.filter (fun y' => ω.eval y' y)).map hvv.varValV
61
+
62
+
/-- Encoding function `E`, single depender argument (no `p₀` threading).
63
+
64
+
Takes the per-variable domain `Y_x : X → Finset Y`. -/
65
+
def encodeNNF [LT Y] [DecidableEq Y] [DecidableRel (· < · : Y → Y → Prop)]
66
+
(Y_x : X → Finset Y)
67
+
(p : Package N' V') :
68
+
(ψ : Formula N V X Y) →
69
+
Finset (Package N' V' × N' × Finset V')
70
+
| .dep n vs =>
71
+
{ (p, hvn.origN n, vs.map hvv.origV) }
72
+
| .conj ψ_L ψ_R =>
73
+
encodeNNF Y_x p ψ_L ∪ encodeNNF Y_x p ψ_R
74
+
| .disj ψ_L ψ_R =>
75
+
{ (p, hvn.disjunctN ψ_L ψ_R, {hvv.zeroV, hvv.oneV}) } ∪
76
+
encodeNNF Y_x (hvn.disjunctN ψ_L ψ_R, hvv.zeroV) ψ_L ∪
77
+
encodeNNF Y_x (hvn.disjunctN ψ_L ψ_R, hvv.oneV) ψ_R
78
+
| .varCmp x ω y =>
79
+
{ (p, hvn.varN x, cmpVersionSet (hvv := hvv) (Y_x x) ω y) }
80
+
| .neg (.dep n vs) =>
81
+
{ (p, hvn.syntheticN n vs, ({hvv.oneV} : Finset V')) } ∪
82
+
vs.image (fun u => ((hvn.origN n, hvv.origV u),
83
+
hvn.syntheticN n vs, ({hvv.zeroV} : Finset V')))
84
+
| .neg (.varCmp x ω y) =>
85
+
encodeNNF Y_x p (.varCmp x (VarFormula.CmpOp.complement ω) y)
86
+
| .neg (.conj ψ_L ψ_R) =>
87
+
encodeNNF Y_x p (.disj (.neg ψ_L) (.neg ψ_R))
88
+
| .neg (.disj ψ_L ψ_R) =>
89
+
encodeNNF Y_x p (.conj (.neg ψ_L) (.neg ψ_R))
90
+
| .neg (.neg ψ) =>
91
+
encodeNNF Y_x p ψ
92
+
termination_by ψ => ψ.weight
93
+
decreasing_by all_goals simp only [Formula.weight]; omega
94
+
95
+
def encode [LT Y] [DecidableEq Y] [DecidableRel (· < · : Y → Y → Prop)]
96
+
(Y_x : X → Finset Y)
97
+
(p : Package N' V')
98
+
(ψ : Formula N V X Y) :
99
+
Finset (Package N' V' × N' × Finset V') :=
100
+
encodeNNF Y_x p ψ
101
+
102
+
/-- Collect all witness packages generated by encoding a formula. -/
103
+
def witnessPackages [LT Y] [DecidableEq Y] [DecidableRel (· < · : Y → Y → Prop)]
104
+
(p : Package N' V') :
105
+
(ψ : Formula N V X Y) → Finset (Package N' V')
106
+
| .dep _ _ => ∅
107
+
| .conj ψ_L ψ_R =>
108
+
witnessPackages p ψ_L ∪ witnessPackages p ψ_R
109
+
| .disj ψ_L ψ_R =>
110
+
{(hvn.disjunctN ψ_L ψ_R, hvv.zeroV), (hvn.disjunctN ψ_L ψ_R, hvv.oneV)} ∪
111
+
witnessPackages (hvn.disjunctN ψ_L ψ_R, hvv.zeroV) ψ_L ∪
112
+
witnessPackages (hvn.disjunctN ψ_L ψ_R, hvv.oneV) ψ_R
113
+
| .varCmp _ _ _ => ∅
114
+
| .neg (.dep n vs) =>
115
+
{(hvn.syntheticN n vs, hvv.zeroV), (hvn.syntheticN n vs, hvv.oneV)}
116
+
| .neg (.varCmp x ω y) =>
117
+
witnessPackages p (.varCmp x (VarFormula.CmpOp.complement ω) y)
118
+
| .neg (.conj ψ_L ψ_R) =>
119
+
witnessPackages p (.disj (.neg ψ_L) (.neg ψ_R))
120
+
| .neg (.disj ψ_L ψ_R) =>
121
+
witnessPackages p (.conj (.neg ψ_L) (.neg ψ_R))
122
+
| .neg (.neg ψ) =>
123
+
witnessPackages p ψ
124
+
termination_by ψ => ψ.weight
125
+
decreasing_by all_goals simp only [Formula.weight]; omega
126
+
127
+
variable [DecidableEq N] [DecidableEq V] [DecidableEq X] [DecidableEq Y]
128
+
129
+
/-- Reduced real packages: original packages, formula witnesses, and one
130
+
package per (variable, value) pair in `Y_x`. -/
131
+
def vfReal [LT Y] [DecidableRel (· < · : Y → Y → Prop)]
132
+
(Y_x : X → Finset Y) [Fintype X]
133
+
(R_Ψ : Real N V) (Δ_Ψ : VFDepRel N V X Y) :
134
+
Real N' V' :=
135
+
R_Ψ.image (embedPkg (X := X) (Y := Y)) ∪
136
+
Δ_Ψ.biUnion (fun ⟨p, ψ⟩ => witnessPackages (embedPkg (X := X) (Y := Y) p) ψ) ∪
137
+
Finset.univ.biUnion (fun x : X =>
138
+
(Y_x x).image (fun y => ((hvn.varN x, hvv.varValV y) : Package N' V')))
139
+
140
+
def vfDeps [LT Y] [DecidableRel (· < · : Y → Y → Prop)]
141
+
(Y_x : X → Finset Y)
142
+
(Δ_Ψ : VFDepRel N V X Y) :
143
+
DepRel N' V' :=
144
+
Δ_Ψ.biUnion (fun ⟨p, ψ⟩ => encode Y_x (embedPkg (X := X) (Y := Y) p) ψ)
145
+
146
+
omit [DecidableEq Y] in
147
+
theorem complement_eval [LT Y] [DecidableEq Y] [DecidableRel (· < · : Y → Y → Prop)]
148
+
(ω : PackageCalculus.CmpOp) (x y : Y) :
149
+
((CmpOp.complement ω).eval x y = true) ↔ ¬(ω.eval x y = true) := by
150
+
cases ω <;> simp [CmpOp.complement, PackageCalculus.CmpOp.eval]
151
+
152
+
omit [DecidableEq N] [DecidableEq V] [DecidableEq X] [DecidableEq Y]
153
+
[DecidableEq N'] [DecidableEq V'] in
154
+
theorem mem_cmpVersionSet [LT Y] [DecidableEq Y]
155
+
[DecidableRel (· < · : Y → Y → Prop)]
156
+
(Y_x : Finset Y) (ω : PackageCalculus.CmpOp) (y y' : Y) :
157
+
hvv.varValV y' ∈ cmpVersionSet (hvv := hvv) Y_x ω y ↔ y' ∈ Y_x ∧ ω.eval y' y := by
158
+
simp [cmpVersionSet, Finset.mem_filter]
159
+
160
+
omit [DecidableEq N] [DecidableEq V] [DecidableEq X] [DecidableEq Y]
161
+
[DecidableEq N'] [DecidableEq V'] in
162
+
theorem mem_cmpVersionSet' [LT Y] [DecidableEq Y]
163
+
[DecidableRel (· < · : Y → Y → Prop)]
164
+
{Y_x : Finset Y} {ω : PackageCalculus.CmpOp} {y : Y} {w : V'} :
165
+
w ∈ cmpVersionSet (hvv := hvv) Y_x ω y →
166
+
∃ y', w = hvv.varValV y' ∧ y' ∈ Y_x ∧ ω.eval y' y := by
167
+
intro hw
168
+
unfold cmpVersionSet at hw
169
+
rw [Finset.mem_map] at hw
170
+
obtain ⟨y', hy'mem, rfl⟩ := hw
171
+
rw [Finset.mem_filter] at hy'mem
172
+
exact ⟨y', rfl, hy'mem.1, hy'mem.2⟩
173
+
174
+
end PackageCalculus.VarFormula
175
+
176
+
namespace PackageCalculus
177
+
178
+
open Function
179
+
180
+
variable {N V X Y : Type*}
181
+
182
+
instance : VarFormula.HasVFNames N V X Y (VarFormula.VFName N V X Y) where
183
+
toHasConflictNames :=
184
+
{ origN := ⟨VarFormula.VFName.orig, fun _ _ h => VarFormula.VFName.orig.inj h⟩
185
+
syntheticN := VarFormula.VFName.negDep
186
+
syntheticN_injective := by
187
+
intro a₁ a₂ b₁ b₂ h
188
+
exact ⟨VarFormula.VFName.negDep.inj h |>.1,
189
+
VarFormula.VFName.negDep.inj h |>.2⟩
190
+
origN_ne_syntheticN := fun _ _ _ => nofun
191
+
syntheticN_ne_origN := fun _ _ _ => nofun
192
+
tryOrigN := fun
193
+
| .orig n => some n
194
+
| _ => none
195
+
tryOrigN_origN := fun _ => rfl
196
+
tryOrigN_some := fun n' n h => by
197
+
cases n' with
198
+
| orig m => simp at h; subst h; rfl
199
+
| _ => simp at h
200
+
trySyntheticN := fun
201
+
| .negDep n vs => some (n, vs)
202
+
| _ => none
203
+
trySyntheticN_syntheticN := fun _ _ => rfl
204
+
trySyntheticN_some := fun n' p h => by
205
+
cases n' with
206
+
| negDep n vs => simp at h; obtain ⟨rfl, rfl⟩ := h; rfl
207
+
| _ => simp at h }
208
+
varN := ⟨VarFormula.VFName.var, fun _ _ h => VarFormula.VFName.var.inj h⟩
209
+
disjunctN := VarFormula.VFName.disjunct
210
+
disjunctN_injective := by
211
+
intro a₁ a₂ b₁ b₂ h
212
+
exact ⟨VarFormula.VFName.disjunct.inj h |>.1,
213
+
VarFormula.VFName.disjunct.inj h |>.2⟩
214
+
origN_ne_varN := fun _ _ => nofun
215
+
varN_ne_origN := fun _ _ => nofun
216
+
origN_ne_disjunctN := fun _ _ _ => nofun
217
+
disjunctN_ne_origN := fun _ _ _ => nofun
218
+
varN_ne_disjunctN := fun _ _ _ => nofun
219
+
disjunctN_ne_varN := fun _ _ _ => nofun
220
+
varN_ne_syntheticN := fun _ _ _ => nofun
221
+
syntheticN_ne_varN := fun _ _ _ => nofun
222
+
disjunctN_ne_syntheticN := fun _ _ _ _ => nofun
223
+
syntheticN_ne_disjunctN := fun _ _ _ _ => nofun
224
+
225
+
instance : VarFormula.HasVFVersions V Y (VarFormula.VFVersion V Y) where
226
+
toHasConflictVersions :=
227
+
{ origV := ⟨VarFormula.VFVersion.orig, fun _ _ h => VarFormula.VFVersion.orig.inj h⟩
228
+
zeroV := VarFormula.VFVersion.zero
229
+
oneV := VarFormula.VFVersion.one
230
+
origV_ne_zeroV := fun _ => nofun
231
+
zeroV_ne_origV := fun _ => nofun
232
+
origV_ne_oneV := fun _ => nofun
233
+
oneV_ne_origV := fun _ => nofun
234
+
zeroV_ne_oneV := nofun
235
+
oneV_ne_zeroV := nofun
236
+
tryOrigV := fun
237
+
| .orig v => some v
238
+
| _ => none
239
+
tryOrigV_origV := fun _ => rfl
240
+
tryOrigV_some := fun v' v h => by
241
+
cases v' with
242
+
| orig w => simp at h; subst h; rfl
243
+
| _ => simp at h }
244
+
varValV := ⟨VarFormula.VFVersion.varVal, fun _ _ h => VarFormula.VFVersion.varVal.inj h⟩
245
+
origV_ne_varValV := fun _ _ => nofun
246
+
varValV_ne_origV := fun _ _ => nofun
247
+
zeroV_ne_varValV := fun _ => nofun
248
+
varValV_ne_zeroV := fun _ => nofun
249
+
oneV_ne_varValV := fun _ => nofun
250
+
varValV_ne_oneV := fun _ => nofun
251
+
252
+
end PackageCalculus
+229
PackageCalculus/Extensions/VariableFormula/Reduction/Soundness.lean
+229
PackageCalculus/Extensions/VariableFormula/Reduction/Soundness.lean
···
1
+
import PackageCalculus.Extensions.VariableFormula.Reduction.Definition
2
+
import Mathlib
3
+
4
+
/-! # Variable-formula extension: soundness
5
+
6
+
Any core resolution of the variable-formula encoding induces a satisfying
7
+
assignment together with a valid variable-formula resolution. -/
8
+
9
+
namespace PackageCalculus.VarFormula
10
+
11
+
open Classical
12
+
13
+
variable {N : Type*} {V : Type*} {X : Type*} {Y : Type*}
14
+
variable {N' : Type*} {V' : Type*}
15
+
variable [DecidableEq N'] [DecidableEq V']
16
+
variable [hvn : HasVFNames N V X Y N'] [hvv : HasVFVersions V Y V']
17
+
18
+
omit [DecidableEq N'] [DecidableEq V'] in
19
+
private theorem embedPkg_injective :
20
+
Function.Injective (embedPkg (X := X) (Y := Y) : Package N V → Package N' V') := by
21
+
intro ⟨n₁, v₁⟩ ⟨n₂, v₂⟩ h
22
+
simp only [embedPkg, Prod.mk.injEq] at h
23
+
exact Prod.ext (hvn.origN.injective h.1) (hvv.origV.injective h.2)
24
+
25
+
private noncomputable def preimageS [DecidableEq N] [DecidableEq V]
26
+
(S : Finset (Package N' V')) : Finset (Package N V) :=
27
+
S.preimage (embedPkg (X := X) (Y := Y))
28
+
(Set.InjOn.mono (Set.subset_univ _)
29
+
(Function.Injective.injOn (embedPkg_injective (X := X) (Y := Y))))
30
+
31
+
omit [DecidableEq N'] [DecidableEq V'] in
32
+
private theorem mem_preimageS [DecidableEq N] [DecidableEq V]
33
+
{S : Finset (Package N' V')} {p : Package N V} :
34
+
p ∈ preimageS (X := X) (Y := Y) S ↔ embedPkg (X := X) (Y := Y) p ∈ S := by
35
+
simp [preimageS, Finset.mem_preimage]
36
+
37
+
/-- Recover the variable assignment `σ` from a core resolution `S`: paper
38
+
spec is `σ = {(x, y) | (⟨x⟩, y) ∈ S}`. We pick `y` via choice; if no such
39
+
package exists in `S`, fall back to `Classical.arbitrary Y`. -/
40
+
noncomputable def extractAssignment [Nonempty Y]
41
+
(S : Finset (Package N' V')) :
42
+
X → Y :=
43
+
fun x => if h : ∃ y, (hvn.varN x, hvv.varValV y) ∈ S
44
+
then h.choose else Classical.arbitrary Y
45
+
46
+
omit [DecidableEq N'] [DecidableEq V'] in
47
+
private lemma extractAssignment_var [Nonempty Y]
48
+
{R : Real N' V'}
49
+
{Δ : DepRel N' V'}
50
+
{r : Package N' V'}
51
+
{S : Finset (Package N' V')}
52
+
(hres : IsResolution R Δ r S)
53
+
(x : X) (y' : Y)
54
+
(hS : (hvn.varN x, hvv.varValV y') ∈ S) :
55
+
(extractAssignment (N := N) (V := V) (X := X) (Y := Y) S) x = y' := by
56
+
unfold extractAssignment
57
+
have hex : ∃ y₀, (hvn.varN x, hvv.varValV y₀) ∈ S := ⟨y', hS⟩
58
+
rw [dif_pos hex]
59
+
exact hvv.varValV.injective (hres.version_unique _ _ _ hex.choose_spec hS)
60
+
61
+
private theorem witnessPackages_not_orig
62
+
[LT Y] [DecidableEq Y] [DecidableRel (· < · : Y → Y → Prop)]
63
+
(p : Package N' V') (ψ : Formula N V X Y) (n : N) (v : V') :
64
+
(hvn.origN n, v) ∉ witnessPackages p ψ := by
65
+
by_contra h_contra;
66
+
induction' h : Formula.weight ψ using Nat.strong_induction_on with w hw generalizing ψ p;
67
+
rcases ψ with ( _ | ⟨ ψ_L, ψ_R ⟩ | ⟨ ψ_L, ψ_R ⟩ | ⟨ x, ω, y ⟩ | ⟨ n, vs ⟩ );
68
+
all_goals simp +decide [ witnessPackages ] at h_contra;
69
+
· rcases h_contra with ( h_contra | h_contra );
70
+
· exact hw _ ( by simp +decide [ Formula.weight ] at h ⊢; linarith ) _ _ h_contra rfl;
71
+
· exact hw _ ( by rw [ show ( ψ_L.conj ψ_R ).weight = ψ_L.weight + ψ_R.weight + 2 from rfl ] at h; linarith ) _ _ h_contra rfl;
72
+
· rcases h_contra with ( h_contra | h_contra );
73
+
· exact hw _ ( by simp +decide [ Formula.weight ] at h ⊢; linarith ) _ _ h_contra rfl;
74
+
· exact hw _ ( by simp +decide [ Formula.weight ] at h ⊢; linarith ) _ _ h_contra rfl;
75
+
· rcases h_contra with ( h_contra | h_contra );
76
+
· exact hw _ ( by simp +decide [ Formula.weight ] at h ⊢; linarith ) _ _ h_contra rfl;
77
+
· exact hw _ ( by simp +decide [ Formula.weight ] at h ⊢; linarith ) _ _ h_contra rfl;
78
+
· rcases h_contra with ( h_contra | h_contra );
79
+
· exact hw _ ( by simp +decide [ Formula.weight ] at h ⊢; linarith ) _ _ h_contra rfl;
80
+
· exact hw _ ( by simp +decide [ Formula.weight ] at h ⊢; linarith ) _ _ h_contra rfl;
81
+
· exact hw _ ( by linarith [ show Formula.weight ‹_› < w from by linarith [ show Formula.weight ( Formula.neg ( Formula.neg ‹_› ) ) = 3 * ( Formula.weight ( Formula.neg ‹_› ) + 1 ) from rfl, show Formula.weight ( Formula.neg ‹_› ) = 3 * ( Formula.weight ‹_› + 1 ) from rfl ] ] ) _ _ h_contra rfl
82
+
83
+
private theorem embedPkg_mem_vfReal
84
+
[DecidableEq N] [DecidableEq V] [DecidableEq X] [DecidableEq Y]
85
+
[LT Y] [DecidableRel (· < · : Y → Y → Prop)] [Fintype X]
86
+
(Y_x : X → Finset Y)
87
+
{p : Package N V} {R_Ψ : Real N V} {Δ_Ψ : VFDepRel N V X Y}
88
+
(h : embedPkg (X := X) (Y := Y) p ∈ vfReal Y_x R_Ψ Δ_Ψ) : p ∈ R_Ψ := by
89
+
unfold vfReal at h; simp_all +decide [ Finset.mem_biUnion, Finset.mem_image, Function.Injective.eq_iff ( show Function.Injective ( embedPkg : Package N V → Package N' V' ) from embedPkg_injective ) ] ;
90
+
rcases h with ( h | ⟨ a, b, c, h₁, h₂ ⟩ | ⟨ a, b, h₁, h₂ ⟩ ) <;> simp_all +decide [ embedPkg ];
91
+
exact False.elim ( witnessPackages_not_orig _ _ _ _ h₂ )
92
+
93
+
private def encode_satisfies [DecidableEq N] [DecidableEq V]
94
+
[DecidableEq X] [DecidableEq Y]
95
+
[LT Y] [DecidableRel (· < · : Y → Y → Prop)] [Nonempty Y]
96
+
{R : Real N' V'}
97
+
{Δ : DepRel N' V'}
98
+
{r : Package N' V'}
99
+
{S : Finset (Package N' V')}
100
+
(hres : IsResolution R Δ r S)
101
+
(Y_x : X → Finset Y)
102
+
(q : Package N' V')
103
+
(ψ : Formula N V X Y)
104
+
(henc : ∀ d, d ∈ encodeNNF Y_x q ψ → d ∈ Δ) (hq : q ∈ S) :
105
+
ψ.satisfies
106
+
(preimageS (X := X) (Y := Y) S)
107
+
(extractAssignment (N := N) (V := V) (X := X) (Y := Y) S) := by
108
+
match ψ with
109
+
| .dep n vs =>
110
+
simp only [encodeNNF] at henc
111
+
have hd := henc _ (Finset.mem_singleton.mpr rfl)
112
+
obtain ⟨w, hw, hwS⟩ := hres.dep_closure _ hq _ _ hd
113
+
simp only [Finset.mem_map] at hw
114
+
obtain ⟨v, hv, rfl⟩ := hw
115
+
exact ⟨v, hv, mem_preimageS.mpr hwS⟩
116
+
| .conj ψ_L ψ_R =>
117
+
simp only [encodeNNF] at henc
118
+
exact ⟨encode_satisfies hres Y_x q ψ_L
119
+
(fun d hd => henc d (Finset.mem_union.mpr (Or.inl hd))) hq,
120
+
encode_satisfies hres Y_x q ψ_R
121
+
(fun d hd => henc d (Finset.mem_union.mpr (Or.inr hd))) hq⟩
122
+
| .disj ψ_L ψ_R =>
123
+
simp only [encodeNNF] at henc
124
+
have hd : (q, hvn.disjunctN ψ_L ψ_R,
125
+
({hvv.zeroV, hvv.oneV} : Finset _)) ∈ Δ :=
126
+
henc _ (Finset.mem_union.mpr (Or.inl (Finset.mem_union.mpr (Or.inl
127
+
(Finset.mem_singleton.mpr rfl)))))
128
+
obtain ⟨w, hw, hwS⟩ := hres.dep_closure _ hq _ _ hd
129
+
simp only [Finset.mem_insert, Finset.mem_singleton] at hw
130
+
rcases hw with rfl | rfl
131
+
· left
132
+
exact encode_satisfies hres Y_x _ ψ_L
133
+
(fun d hd' => henc d (Finset.mem_union.mpr (Or.inl (Finset.mem_union.mpr (Or.inr hd'))))) hwS
134
+
· right
135
+
exact encode_satisfies hres Y_x _ ψ_R
136
+
(fun d hd' => henc d (Finset.mem_union.mpr (Or.inr hd'))) hwS
137
+
| .varCmp x ω y =>
138
+
simp only [encodeNNF] at henc
139
+
have hd := henc _ (Finset.mem_singleton.mpr rfl)
140
+
obtain ⟨w, hw, hwS⟩ := hres.dep_closure _ hq _ _ hd
141
+
obtain ⟨y', rfl, _, heval⟩ := mem_cmpVersionSet' hw
142
+
simp only [Formula.satisfies]
143
+
rw [extractAssignment_var hres x y' hwS]
144
+
exact heval
145
+
| .neg (.dep n vs) =>
146
+
simp only [encodeNNF] at henc
147
+
have hd : (q, hvn.syntheticN n vs,
148
+
({hvv.oneV} : Finset V')) ∈ Δ :=
149
+
henc _ (Finset.mem_union.mpr (Or.inl (Finset.mem_singleton.mpr rfl)))
150
+
obtain ⟨w, hw, hwS⟩ := hres.dep_closure _ hq _ _ hd
151
+
simp only [Finset.mem_singleton] at hw; subst hw
152
+
intro ⟨v, hv, hvS⟩
153
+
rw [mem_preimageS] at hvS
154
+
have hd2 : ((hvn.origN n, hvv.origV v),
155
+
hvn.syntheticN n vs, ({hvv.zeroV} : Finset V')) ∈ Δ :=
156
+
henc _ (Finset.mem_union.mpr (Or.inr (Finset.mem_image.mpr ⟨v, hv, rfl⟩)))
157
+
obtain ⟨w2, hw2, hw2S⟩ := hres.dep_closure _ hvS _ _ hd2
158
+
simp only [Finset.mem_singleton] at hw2; subst hw2
159
+
exact absurd (hres.version_unique _ _ _ hwS hw2S) hvv.oneV_ne_zeroV
160
+
| .neg (.varCmp x ω y) =>
161
+
show ¬ Formula.satisfies (preimageS S) (extractAssignment S) (.varCmp x ω y)
162
+
have key : encodeNNF (hvn := hvn) (hvv := hvv) Y_x q
163
+
(Formula.neg (Formula.varCmp x ω y) : Formula N V X Y) =
164
+
encodeNNF (hvn := hvn) (hvv := hvv) Y_x q
165
+
(Formula.varCmp x (CmpOp.complement ω) y : Formula N V X Y) := by
166
+
simp [encodeNNF]
167
+
have h := encode_satisfies hres Y_x q (Formula.varCmp x (CmpOp.complement ω) y)
168
+
(fun d hd => henc d (key ▸ hd)) hq
169
+
simp only [Formula.satisfies] at h ⊢
170
+
exact (complement_eval ω _ _).mp h
171
+
| .neg (.conj ψ_L ψ_R) =>
172
+
have key : encodeNNF Y_x q (.neg (.conj ψ_L ψ_R)) =
173
+
encodeNNF Y_x q (.disj (.neg ψ_L) (.neg ψ_R)) := by
174
+
simp [encodeNNF]
175
+
have h := encode_satisfies hres Y_x q (.disj (.neg ψ_L) (.neg ψ_R))
176
+
(fun d hd => henc d (key ▸ hd)) hq
177
+
simp only [Formula.satisfies] at h ⊢
178
+
exact not_and_or.mpr h
179
+
| .neg (.disj ψ_L ψ_R) =>
180
+
have key : encodeNNF Y_x q (.neg (.disj ψ_L ψ_R)) =
181
+
encodeNNF Y_x q (.conj (.neg ψ_L) (.neg ψ_R)) := by
182
+
simp [encodeNNF]
183
+
have h := encode_satisfies hres Y_x q (.conj (.neg ψ_L) (.neg ψ_R))
184
+
(fun d hd => henc d (key ▸ hd)) hq
185
+
simp only [Formula.satisfies] at h ⊢
186
+
exact not_or.mpr h
187
+
| .neg (.neg ψ') =>
188
+
have key : encodeNNF Y_x q (.neg (.neg ψ')) = encodeNNF Y_x q ψ' := by
189
+
simp [encodeNNF]
190
+
have h := encode_satisfies hres Y_x q ψ' (fun d hd => henc d (key ▸ hd)) hq
191
+
simp only [Formula.satisfies]
192
+
exact not_not_intro h
193
+
termination_by ψ.weight
194
+
decreasing_by all_goals simp only [Formula.weight]; omega
195
+
196
+
-- Paper Thm 4.6.4 (Variable Formula Reduction Soundness).
197
+
theorem varFormula_soundness
198
+
[DecidableEq N] [DecidableEq V] [DecidableEq X] [DecidableEq Y]
199
+
[LT Y] [DecidableRel (· < · : Y → Y → Prop)] [Fintype X] [Nonempty Y]
200
+
(Y_x : X → Finset Y)
201
+
(R_Ψ : Real N V) (Δ_Ψ : VFDepRel N V X Y)
202
+
(r : Package N V)
203
+
(S : Finset (Package N' V'))
204
+
(hres : IsResolution (vfReal Y_x R_Ψ Δ_Ψ) (vfDeps Y_x Δ_Ψ)
205
+
(embedPkg (X := X) (Y := Y) r) S) :
206
+
IsVFResolution R_Ψ Δ_Ψ r (preimageS (X := X) (Y := Y) S)
207
+
(extractAssignment (N := N) (V := V) (X := X) (Y := Y) S) := by
208
+
refine ⟨?_, ?_, ?_, ?_⟩
209
+
· -- subset
210
+
intro p hp
211
+
rw [mem_preimageS] at hp
212
+
exact embedPkg_mem_vfReal Y_x (hres.subset hp)
213
+
· -- root_mem
214
+
exact mem_preimageS.mpr hres.root_mem
215
+
· -- formula_closure
216
+
intro p hp ψ hdep
217
+
rw [mem_preimageS] at hp
218
+
have henc : ∀ d, d ∈ encodeNNF Y_x (embedPkg (X := X) (Y := Y) p) ψ →
219
+
d ∈ vfDeps Y_x Δ_Ψ := by
220
+
intro d hd
221
+
simp only [vfDeps, encode, Finset.mem_biUnion]
222
+
exact ⟨⟨p, ψ⟩, hdep, hd⟩
223
+
exact encode_satisfies hres Y_x (embedPkg (X := X) (Y := Y) p) ψ henc hp
224
+
· -- version_unique
225
+
intro n v v' hv hv'
226
+
rw [mem_preimageS] at hv hv'
227
+
exact hvv.origV.injective (hres.version_unique _ _ _ hv hv')
228
+
229
+
end PackageCalculus.VarFormula
+73
PackageCalculus/Extensions/Virtual/Definition.lean
+73
PackageCalculus/Extensions/Virtual/Definition.lean
···
1
+
import PackageCalculus.Core.Definition
2
+
import Mathlib.Logic.Embedding.Basic
3
+
4
+
/-! # Virtual extension: definitions
5
+
6
+
Virtual packages selecting concrete providers, encoded through a `provides`
7
+
relation and the `IsVirtualResolution` structure. -/
8
+
9
+
namespace PackageCalculus.Virtual
10
+
11
+
open Function
12
+
13
+
variable {N : Type*} [DecidableEq N] {V : Type*} [DecidableEq V]
14
+
15
+
/-- A version or top (wildcard). -/
16
+
inductive VTop (V : Type*) where
17
+
| val : V → VTop V
18
+
| top : VTop V
19
+
deriving DecidableEq
20
+
21
+
/-- Provides relation: (provider-package, virtual-name, version-or-top). -/
22
+
abbrev ProvidesRel (N V : Type*) [DecidableEq N] [DecidableEq V] :=
23
+
Finset (Package N V × N × VTop V)
24
+
25
+
/-- v matches vs; top matches anything. -/
26
+
def memTop (v : VTop V) (vs : Finset V) : Prop :=
27
+
match v with
28
+
| .top => True
29
+
| .val v' => v' ∈ vs
30
+
31
+
structure IsVirtualResolution
32
+
(R : Real N V) (Delta : DepRel N V)
33
+
(prov : ProvidesRel N V) (r : Package N V)
34
+
(S : Finset (Package N V))
35
+
(rho : Finset (Package N V × N × Package N V)) : Prop where
36
+
subset : S ⊆ R
37
+
root_mem : r ∈ S
38
+
/-- Either a direct version is selected, or exactly one provider satisfies the dep via rho. -/
39
+
virtual_dep_closure : ∀ p ∈ S, ∀ n : N, ∀ vs : Finset V,
40
+
(p, n, vs) ∈ Delta →
41
+
(∃ v ∈ vs, (n, v) ∈ S) ∨
42
+
(∃! q, q ∈ S ∧ ∃ v, memTop v vs ∧ (q, n, v) ∈ prov ∧ (q, n, p) ∈ rho)
43
+
version_unique : VersionUnique S
44
+
45
+
class HasVirtualNames (N V : Type*) (N' : outParam Type*) where
46
+
origN : N ↪ N'
47
+
/-- Synthetic selector name for a (package, dep-name) pair. -/
48
+
selectorN : Package N V → N → N'
49
+
selectorN_injective : Injective2 selectorN
50
+
origN_ne_selectorN : ∀ n p m, origN n ≠ selectorN p m
51
+
selectorN_ne_origN : ∀ p m n, selectorN p m ≠ origN n
52
+
/-- Decidable partial inverse of `origN`. -/
53
+
tryOrigN : N' → Option N
54
+
tryOrigN_origN : ∀ n, tryOrigN (origN n) = some n
55
+
tryOrigN_some : ∀ n' n, tryOrigN n' = some n → origN n = n'
56
+
57
+
attribute [simp] HasVirtualNames.origN_ne_selectorN HasVirtualNames.selectorN_ne_origN
58
+
59
+
class HasVirtualVersions (N V : Type*) (V' : outParam Type*) where
60
+
origV : V ↪ V'
61
+
/-- Synthetic provider version indexed by (name, version). -/
62
+
providerV : N → V → V'
63
+
providerV_injective : Injective2 providerV
64
+
origV_ne_providerV : ∀ v n w, origV v ≠ providerV n w
65
+
providerV_ne_origV : ∀ n w v, providerV n w ≠ origV v
66
+
/-- Decidable partial inverse of `origV`. -/
67
+
tryOrigV : V' → Option V
68
+
tryOrigV_origV : ∀ v, tryOrigV (origV v) = some v
69
+
tryOrigV_some : ∀ v' v, tryOrigV v' = some v → origV v = v'
70
+
71
+
attribute [simp] HasVirtualVersions.origV_ne_providerV HasVirtualVersions.providerV_ne_origV
72
+
73
+
end PackageCalculus.Virtual
+44
PackageCalculus/Extensions/Virtual/Lifting/Completeness.lean
+44
PackageCalculus/Extensions/Virtual/Lifting/Completeness.lean
···
1
+
import PackageCalculus.Extensions.Virtual.Lifting.Definition
2
+
3
+
namespace PackageCalculus.Virtual
4
+
5
+
variable {N : Type*} [DecidableEq N] {V : Type*} [DecidableEq V]
6
+
variable {N' : Type*} [DecidableEq N'] {V' : Type*} [DecidableEq V']
7
+
variable [hvn : HasVirtualNames N V N'] [hvv : HasVirtualVersions N V V']
8
+
9
+
theorem liftResolution_completenessWitness
10
+
(Delta_v : DepRel N V) (prov : ProvidesRel N V)
11
+
(S_v : Finset (Package N V))
12
+
(rho : Finset (Package N V × N × Package N V)) :
13
+
liftResolution (completenessWitness Delta_v prov S_v rho) = S_v := by
14
+
ext p
15
+
simp only [mem_liftResolution, completenessWitness, embedSet, Finset.mem_union,
16
+
Finset.mem_image, Finset.mem_biUnion, Finset.mem_filter, embedPkg]
17
+
constructor
18
+
· intro h
19
+
rcases h with ⟨q, hqS, heq⟩ | ⟨⟨p', n, vs⟩, ⟨_, _⟩, hmem⟩
20
+
· simp only [Prod.mk.injEq] at heq
21
+
exact (Prod.ext (hvn.origN.injective heq.1) (hvv.origV.injective heq.2) : q = p) ▸ hqS
22
+
· split at hmem
23
+
· rw [Finset.mem_singleton] at hmem
24
+
simp only [Prod.mk.injEq] at hmem
25
+
exact absurd hmem.1 (hvn.origN_ne_selectorN _ _ _)
26
+
· simp at hmem
27
+
· intro hp
28
+
exact Or.inl ⟨p, hp, rfl⟩
29
+
30
+
theorem liftResolution_completeness
31
+
(R_v : Real N V) (Delta_v : DepRel N V)
32
+
(prov : ProvidesRel N V) (r : Package N V)
33
+
(S_v : Finset (Package N V))
34
+
(rho : Finset (Package N V × N × Package N V))
35
+
(hres : IsVirtualResolution R_v Delta_v prov r S_v rho)
36
+
(hfunc : ∀ p n vs₁ vs₂, (p, n, vs₁) ∈ Delta_v → (p, n, vs₂) ∈ Delta_v → vs₁ = vs₂) :
37
+
∃ S', IsResolution (virtualReal R_v Delta_v prov) (virtualDeps Delta_v R_v prov)
38
+
(embedPkg r) S' ∧ liftResolution S' = S_v :=
39
+
⟨completenessWitness Delta_v prov S_v rho,
40
+
virtual_completeness R_v Delta_v prov r S_v rho hres hfunc,
41
+
liftResolution_completenessWitness Delta_v prov S_v rho⟩
42
+
43
+
44
+
end PackageCalculus.Virtual
+95
PackageCalculus/Extensions/Virtual/Lifting/Definition.lean
+95
PackageCalculus/Extensions/Virtual/Lifting/Definition.lean
···
1
+
import PackageCalculus.Extensions.Virtual.Reduction.Completeness
2
+
import PackageCalculus.Extensions.Virtual.Reduction.Soundness
3
+
4
+
namespace PackageCalculus.Virtual
5
+
6
+
variable {N : Type*} [DecidableEq N] {V : Type*} [DecidableEq V]
7
+
variable {N' : Type*} [DecidableEq N'] {V' : Type*} [DecidableEq V']
8
+
variable [hvn : HasVirtualNames N V N'] [hvv : HasVirtualVersions N V V']
9
+
10
+
/-! ## Lift functions -/
11
+
12
+
def embedPkgFn : Package N V → Package N' V' :=
13
+
fun p => (hvn.origN p.1, hvv.origV p.2)
14
+
15
+
omit [DecidableEq N] [DecidableEq V] [DecidableEq N'] [DecidableEq V'] in
16
+
theorem embedPkgFn_eq_embedPkg :
17
+
(embedPkgFn : Package N V → Package N' V') = embedPkg :=
18
+
rfl
19
+
20
+
omit [DecidableEq N] [DecidableEq V] [DecidableEq N'] [DecidableEq V'] in
21
+
theorem embedPkgFn_injective :
22
+
Function.Injective (embedPkgFn : Package N V → Package N' V') := by
23
+
intro ⟨n₁, v₁⟩ ⟨n₂, v₂⟩ h
24
+
simp only [embedPkgFn, Prod.mk.injEq] at h
25
+
exact Prod.ext (hvn.origN.injective h.1) (hvv.origV.injective h.2)
26
+
27
+
def tryInvPkg (p : Package N' V') : Option (Package N V) :=
28
+
match hvn.tryOrigN p.1, hvv.tryOrigV p.2 with
29
+
| some n, some v => some (n, v)
30
+
| _, _ => none
31
+
32
+
omit [DecidableEq N] [DecidableEq V] [DecidableEq N'] [DecidableEq V'] in
33
+
private theorem tryInvPkg_inj :
34
+
∀ a a' (b : Package N V), b ∈ tryInvPkg a → b ∈ tryInvPkg a' → a = a' := by
35
+
intro a a' ⟨n, v⟩ h1 h2
36
+
simp only [tryInvPkg, Option.mem_def] at h1 h2
37
+
revert h1 h2
38
+
cases hn1 : hvn.tryOrigN a.1 <;> cases hv1 : hvv.tryOrigV a.2 <;> simp (config := { decide := false })
39
+
intro rfl rfl
40
+
cases hn2 : hvn.tryOrigN a'.1 <;> cases hv2 : hvv.tryOrigV a'.2 <;> simp (config := { decide := false })
41
+
intro rfl rfl
42
+
exact Prod.ext
43
+
((hvn.tryOrigN_some _ _ hn1).symm.trans (hvn.tryOrigN_some _ _ hn2))
44
+
((hvv.tryOrigV_some _ _ hv1).symm.trans (hvv.tryOrigV_some _ _ hv2))
45
+
46
+
omit [DecidableEq N] [DecidableEq V] [DecidableEq N'] [DecidableEq V'] in
47
+
theorem tryInvPkg_embed (p : Package N V) :
48
+
tryInvPkg (embedPkgFn p) = some p := by
49
+
simp [tryInvPkg, embedPkgFn, hvn.tryOrigN_origN, hvv.tryOrigV_origV]
50
+
51
+
omit [DecidableEq N] [DecidableEq V] [DecidableEq N'] [DecidableEq V'] in
52
+
theorem tryInvPkg_some {p' : Package N' V'} {p : Package N V}
53
+
(h : p ∈ tryInvPkg p') : embedPkgFn p = p' := by
54
+
obtain ⟨n', v'⟩ := p'; obtain ⟨n, v⟩ := p
55
+
simp only [tryInvPkg, Option.mem_def, embedPkgFn] at h ⊢
56
+
generalize htn : hvn.tryOrigN n' = on at h
57
+
generalize htv : hvv.tryOrigV v' = ov at h
58
+
match on, ov with
59
+
| some n₀, some v₀ =>
60
+
simp at h; obtain ⟨rfl, rfl⟩ := h
61
+
show (hvn.origN n₀, hvv.origV v₀) = (n', v')
62
+
rw [hvn.tryOrigN_some _ _ htn, hvv.tryOrigV_some _ _ htv]
63
+
| some _, none => simp at h
64
+
| none, _ => simp at h
65
+
66
+
def liftReal (R' : Real N' V') : Real N V :=
67
+
R'.filterMap tryInvPkg tryInvPkg_inj
68
+
69
+
def liftResolution (S' : Finset (Package N' V')) : Finset (Package N V) :=
70
+
S'.filterMap tryInvPkg tryInvPkg_inj
71
+
72
+
/-! ## Membership lemmas -/
73
+
74
+
omit [DecidableEq N] [DecidableEq V] [DecidableEq N'] [DecidableEq V'] in
75
+
theorem mem_liftReal {R' : Real N' V'} {p : Package N V} :
76
+
p ∈ liftReal R' ↔ embedPkg p ∈ R' := by
77
+
simp only [liftReal, Finset.mem_filterMap]
78
+
constructor
79
+
· rintro ⟨p', hp', hinv⟩
80
+
have heq := tryInvPkg_some hinv; rw [embedPkgFn_eq_embedPkg] at heq; rwa [heq]
81
+
· intro hp
82
+
exact ⟨embedPkg p, hp, by show p ∈ tryInvPkg (embedPkgFn p); rw [tryInvPkg_embed]; rfl⟩
83
+
84
+
omit [DecidableEq N] [DecidableEq V] [DecidableEq N'] [DecidableEq V'] in
85
+
theorem mem_liftResolution {S' : Finset (Package N' V')} {p : Package N V} :
86
+
p ∈ liftResolution S' ↔ embedPkg p ∈ S' := by
87
+
simp only [liftResolution, Finset.mem_filterMap]
88
+
constructor
89
+
· rintro ⟨p', hp', hinv⟩
90
+
have heq := tryInvPkg_some hinv; rw [embedPkgFn_eq_embedPkg] at heq; rwa [heq]
91
+
· intro hp
92
+
exact ⟨embedPkg p, hp, by show p ∈ tryInvPkg (embedPkgFn p); rw [tryInvPkg_embed]; rfl⟩
93
+
94
+
95
+
end PackageCalculus.Virtual
+40
PackageCalculus/Extensions/Virtual/Lifting/Retraction.lean
+40
PackageCalculus/Extensions/Virtual/Lifting/Retraction.lean
···
1
+
import PackageCalculus.Extensions.Virtual.Lifting.Definition
2
+
3
+
namespace PackageCalculus.Virtual
4
+
5
+
variable {N : Type*} [DecidableEq N] {V : Type*} [DecidableEq V]
6
+
variable {N' : Type*} [DecidableEq N'] {V' : Type*} [DecidableEq V']
7
+
variable [hvn : HasVirtualNames N V N'] [hvv : HasVirtualVersions N V V']
8
+
9
+
/-! ## Round-trip theorems -/
10
+
11
+
theorem liftReal_virtualReal (R : Real N V) (Δ : DepRel N V)
12
+
(prov : ProvidesRel N V) :
13
+
liftReal (virtualReal (N' := N') (V' := V') R Δ prov) = R := by
14
+
ext p
15
+
simp only [mem_liftReal, virtualReal, embedSet, Finset.mem_union, Finset.mem_image,
16
+
Finset.mem_biUnion]
17
+
constructor
18
+
· intro h
19
+
rcases h with ((⟨q, hqR, heq⟩ | ⟨a, _, hmem⟩) | ⟨a, _, hmem⟩)
20
+
· exact (embedPkgFn_injective heq : q = p) ▸ hqR
21
+
· -- Selector from provider biUnion
22
+
exfalso
23
+
obtain ⟨b, _, hmem'⟩ := hmem
24
+
split at hmem'
25
+
· rw [Finset.mem_singleton] at hmem'
26
+
simp only [embedPkg, Prod.mk.injEq] at hmem'
27
+
exact absurd hmem'.1 (hvn.origN_ne_selectorN _ _ _)
28
+
· simp at hmem'
29
+
· -- Selector from direct biUnion
30
+
exfalso
31
+
split at hmem
32
+
· simp only [Finset.mem_image, Finset.mem_filter, embedPkg, Prod.mk.injEq] at hmem
33
+
obtain ⟨_, _, ⟨h1, _⟩⟩ := hmem
34
+
exact absurd h1 (hvn.selectorN_ne_origN _ _ _)
35
+
· simp at hmem
36
+
· intro hp
37
+
exact Or.inl (Or.inl ⟨p, hp, rfl⟩)
38
+
39
+
40
+
end PackageCalculus.Virtual
+34
PackageCalculus/Extensions/Virtual/Lifting/Soundness.lean
+34
PackageCalculus/Extensions/Virtual/Lifting/Soundness.lean
···
1
+
import PackageCalculus.Extensions.Virtual.Lifting.Definition
2
+
3
+
namespace PackageCalculus.Virtual
4
+
5
+
variable {N : Type*} [DecidableEq N] {V : Type*} [DecidableEq V]
6
+
variable {N' : Type*} [DecidableEq N'] {V' : Type*} [DecidableEq V']
7
+
variable [hvn : HasVirtualNames N V N'] [hvv : HasVirtualVersions N V V']
8
+
9
+
/-! ## Lifting soundness -/
10
+
11
+
theorem liftResolution_soundness
12
+
(R_v : Real N V) (Delta_v : DepRel N V)
13
+
(prov : ProvidesRel N V) (r : Package N V)
14
+
(S' : Finset (Package N' V'))
15
+
(hres : IsResolution (virtualReal R_v Delta_v prov) (virtualDeps Delta_v R_v prov)
16
+
(embedPkg r) S') :
17
+
∃ rho, IsVirtualResolution R_v Delta_v prov r (liftResolution S') rho := by
18
+
have hsound := virtual_soundness R_v Delta_v prov r S' hres
19
+
suffices heq : liftResolution S' = S'.preimage embedPkg
20
+
(Set.InjOn.mono (Set.subset_univ _)
21
+
(Function.Injective.injOn embedPkgFn_injective)) by
22
+
rw [heq]; exact ⟨_, hsound⟩
23
+
ext p; simp only [liftResolution, Finset.mem_filterMap, Finset.mem_preimage]
24
+
constructor
25
+
· rintro ⟨p', hp', hinv⟩
26
+
have heq := tryInvPkg_some hinv
27
+
rw [embedPkgFn_eq_embedPkg] at heq; rwa [heq]
28
+
· intro hp
29
+
exact ⟨embedPkg p, hp, by
30
+
show p ∈ tryInvPkg (embedPkgFn p)
31
+
rw [tryInvPkg_embed]; rfl⟩
32
+
33
+
34
+
end PackageCalculus.Virtual
+275
PackageCalculus/Extensions/Virtual/Reduction/Completeness.lean
+275
PackageCalculus/Extensions/Virtual/Reduction/Completeness.lean
···
1
+
import PackageCalculus.Extensions.Virtual.Reduction.Definition
2
+
3
+
/-! # Virtual extension: completeness
4
+
5
+
Any virtual resolution lifts to a core resolution of the virtual encoding. -/
6
+
7
+
namespace PackageCalculus.Virtual
8
+
9
+
open Classical
10
+
11
+
variable {N : Type*} [DecidableEq N] {V : Type*} [DecidableEq V]
12
+
variable {N' : Type*} [DecidableEq N'] {V' : Type*} [DecidableEq V']
13
+
variable [hvn : HasVirtualNames N V N'] [hvv : HasVirtualVersions N V V']
14
+
15
+
omit [DecidableEq N] [DecidableEq V] [DecidableEq N'] [DecidableEq V'] in
16
+
private theorem embedPkg_inj {p q : Package N V}
17
+
(h : @embedPkg N V N' V' _ _ p = embedPkg q) : p = q := by
18
+
obtain ⟨pn, pv⟩ := p; obtain ⟨qn, qv⟩ := q
19
+
simp only [embedPkg, Prod.mk.injEq] at h
20
+
exact Prod.ext (hvn.origN.injective h.1) (hvv.origV.injective h.2)
21
+
22
+
noncomputable def selectorVersion
23
+
(S_v : Finset (Package N V))
24
+
(rho : Finset (Package N V × N × Package N V))
25
+
(prov : ProvidesRel N V)
26
+
(p : Package N V) (n : N) (vs : Finset V)
27
+
(hp : hasProvider prov n vs) : V' :=
28
+
if h : ∃ q, q ∈ S_v ∧ ∃ v, memTop v vs ∧ (q, n, v) ∈ prov ∧ (q, n, p) ∈ rho then
29
+
hvv.providerV h.choose.1 h.choose.2
30
+
else if h : ∃ u ∈ vs, (n, u) ∈ S_v then
31
+
hvv.providerV n h.choose
32
+
else
33
+
hvv.providerV hp.choose.1 hp.choose.2
34
+
35
+
noncomputable def completenessWitness
36
+
(Delta_v : DepRel N V)
37
+
(prov : ProvidesRel N V)
38
+
(S_v : Finset (Package N V))
39
+
(rho : Finset (Package N V × N × Package N V)) :
40
+
Finset (Package N' V') :=
41
+
embedSet S_v ∪
42
+
(Delta_v.filter (fun ⟨p, _, _⟩ => p ∈ S_v)).biUnion (fun ⟨p, n, vs⟩ =>
43
+
if hp : hasProvider prov n vs then
44
+
{(hvn.selectorN p n, selectorVersion S_v rho prov p n vs hp)}
45
+
else ∅)
46
+
47
+
private theorem mem_cw_emb {Delta_v : DepRel N V} {prov : ProvidesRel N V}
48
+
{S_v : Finset (Package N V)} {rho : Finset (Package N V × N × Package N V)}
49
+
{p : Package N V} (hp : p ∈ S_v) :
50
+
embedPkg p ∈ completenessWitness Delta_v prov S_v rho :=
51
+
Finset.mem_union.mpr (Or.inl (Finset.mem_image.mpr ⟨p, hp, rfl⟩))
52
+
53
+
private theorem mem_cw_sel {Delta_v : DepRel N V} {prov : ProvidesRel N V}
54
+
{S_v : Finset (Package N V)} {rho : Finset (Package N V × N × Package N V)}
55
+
{p : Package N V} {n : N} {vs : Finset V}
56
+
(hp : p ∈ S_v) (hd : (p, n, vs) ∈ Delta_v) (hprov : hasProvider prov n vs) :
57
+
(hvn.selectorN p n, selectorVersion S_v rho prov p n vs hprov) ∈
58
+
completenessWitness Delta_v prov S_v rho := by
59
+
simp only [completenessWitness, Finset.mem_union, Finset.mem_biUnion,
60
+
Finset.mem_filter]
61
+
right
62
+
refine ⟨⟨p, n, vs⟩, ⟨hd, hp⟩, ?_⟩
63
+
simp [hprov]
64
+
65
+
-- Paper Thm 4.7.5 (Virtual Package Reduction Completeness).
66
+
theorem virtual_completeness
67
+
(R_v : Real N V) (Delta_v : DepRel N V)
68
+
(prov : ProvidesRel N V) (r : Package N V)
69
+
(S_v : Finset (Package N V))
70
+
(rho : Finset (Package N V × N × Package N V))
71
+
(hres : IsVirtualResolution R_v Delta_v prov r S_v rho)
72
+
(hfunc : ∀ p n vs₁ vs₂, (p, n, vs₁) ∈ Delta_v → (p, n, vs₂) ∈ Delta_v → vs₁ = vs₂) :
73
+
IsResolution (virtualReal R_v Delta_v prov) (virtualDeps Delta_v R_v prov)
74
+
(embedPkg r) (completenessWitness Delta_v prov S_v rho) := by
75
+
-- Helper: selectorVersion ∈ selectorVersions
76
+
have sel_in_svs : ∀ p ∈ S_v, ∀ n vs, (p, n, vs) ∈ Delta_v →
77
+
∀ hp : hasProvider prov n vs,
78
+
selectorVersion S_v rho prov p n vs hp ∈
79
+
selectorVersions R_v prov n vs := by
80
+
intro p hpS n vs hd hp
81
+
unfold selectorVersion
82
+
split
83
+
· rename_i hex
84
+
obtain ⟨hqS, v, hmem, hprov_mem, hρ⟩ := hex.choose_spec
85
+
simp only [selectorVersions, Finset.mem_union, Finset.mem_biUnion]
86
+
left
87
+
exact ⟨⟨hex.choose, n, v⟩, hprov_mem, by simp [hmem]⟩
88
+
· rename_i hno_prov
89
+
split
90
+
· rename_i hex
91
+
obtain ⟨hu_vs, hu_S⟩ := hex.choose_spec
92
+
simp only [selectorVersions, Finset.mem_union, Finset.mem_image, Finset.mem_filter]
93
+
right; exact ⟨hex.choose, ⟨hu_vs, hres.subset hu_S⟩, rfl⟩
94
+
· rename_i hno_dir
95
+
exfalso
96
+
rcases hres.virtual_dep_closure p hpS n vs hd with
97
+
⟨u, hu_vs, hu_S⟩ | ⟨q, ⟨hqS, v, hmem, hprov_q, hρ⟩, _⟩
98
+
· exact hno_dir ⟨u, hu_vs, hu_S⟩
99
+
· exact hno_prov ⟨q, hqS, v, hmem, hprov_q, hρ⟩
100
+
-- Helper: selectorVersion gives (providerV m w) with (m, w) ∈ S_v
101
+
have sel_mem_Sv : ∀ p ∈ S_v, ∀ n vs, (p, n, vs) ∈ Delta_v →
102
+
∀ hp : hasProvider prov n vs,
103
+
∃ m w, selectorVersion S_v rho prov p n vs hp = hvv.providerV m w ∧
104
+
(m, w) ∈ S_v := by
105
+
intro p hpS n vs hd hp
106
+
unfold selectorVersion
107
+
split
108
+
· rename_i hex; exact ⟨_, _, rfl, hex.choose_spec.1⟩
109
+
· rename_i hno_prov
110
+
split
111
+
· rename_i hex; exact ⟨n, hex.choose, rfl, hex.choose_spec.2⟩
112
+
· rename_i hno_dir
113
+
exfalso
114
+
rcases hres.virtual_dep_closure p hpS n vs hd with
115
+
⟨u, hu_vs, hu_S⟩ | ⟨q, ⟨hqS, v, hmem, hprov_q, hρ⟩, _⟩
116
+
· exact hno_dir ⟨u, hu_vs, hu_S⟩
117
+
· exact hno_prov ⟨q, hqS, v, hmem, hprov_q, hρ⟩
118
+
refine ⟨?_, ?_, ?_, ?_⟩
119
+
· -- subset
120
+
intro q hq
121
+
simp only [completenessWitness, Finset.mem_union, Finset.mem_biUnion,
122
+
Finset.mem_filter, Finset.mem_image, embedSet] at hq
123
+
rcases hq with ⟨p, hp, rfl⟩ | ⟨⟨p, n, vs⟩, ⟨hd, hpS⟩, hmem⟩
124
+
· -- embedPkg p
125
+
simp only [virtualReal, Finset.mem_union, Finset.mem_image, embedSet]
126
+
left; left; exact ⟨p, hres.subset hp, rfl⟩
127
+
· -- selector
128
+
split at hmem <;> [skip; simp at hmem]
129
+
rename_i hprov
130
+
rw [Finset.mem_singleton] at hmem
131
+
rw [hmem]
132
+
unfold selectorVersion
133
+
split
134
+
· rename_i hex
135
+
obtain ⟨hqS, v, hmem', hprov_mem, hρ⟩ := hex.choose_spec
136
+
simp only [virtualReal, Finset.mem_union, Finset.mem_biUnion, embedSet]
137
+
left; right
138
+
refine ⟨⟨p, n, vs⟩, hd, ⟨⟨hex.choose, n, v⟩, hprov_mem, ?_⟩⟩
139
+
simp [hmem']
140
+
· rename_i hno_prov
141
+
split
142
+
· rename_i hex
143
+
obtain ⟨hu_vs, hu_S⟩ := hex.choose_spec
144
+
simp only [virtualReal, Finset.mem_union, Finset.mem_biUnion,
145
+
Finset.mem_image, embedSet]
146
+
right
147
+
refine ⟨⟨p, n, vs⟩, hd, ?_⟩
148
+
simp only [hprov]
149
+
exact Finset.mem_image.mpr ⟨hex.choose, Finset.mem_filter.mpr ⟨hu_vs, hres.subset hu_S⟩, rfl⟩
150
+
· rename_i hno_dir
151
+
exfalso
152
+
rcases hres.virtual_dep_closure p hpS n vs hd with
153
+
⟨u, hu_vs, hu_S⟩ | ⟨q, ⟨hqS, v, hmem', hprov_q, hρ⟩, _⟩
154
+
· exact hno_dir ⟨u, hu_vs, hu_S⟩
155
+
· exact hno_prov ⟨q, hqS, v, hmem', hprov_q, hρ⟩
156
+
· -- root_mem
157
+
exact mem_cw_emb hres.root_mem
158
+
· -- dep_closure
159
+
intro q hq m_dep dep_vs hd
160
+
simp only [completenessWitness, Finset.mem_union, Finset.mem_biUnion,
161
+
Finset.mem_filter, Finset.mem_image, embedSet] at hq
162
+
rcases hq with ⟨p, hp, rfl⟩ | ⟨⟨p, nd, vsd⟩, ⟨hd_orig, hpS⟩, hmem_sel⟩
163
+
· -- Source is embedPkg p
164
+
simp only [virtualDeps, Finset.mem_union, Finset.mem_image, Finset.mem_filter,
165
+
Finset.mem_biUnion] at hd
166
+
rcases hd with (((⟨⟨p', n, vs⟩, ⟨hdep, hnp⟩, heq⟩ |
167
+
⟨⟨p', n, vs⟩, ⟨hdep, hprov⟩, heq⟩) |
168
+
⟨⟨p', n, vs⟩, hdep, ⟨⟨⟨m, w⟩, n'', v⟩, hprov_mem, hmem_if⟩⟩) |
169
+
⟨⟨p', n, vs⟩, hdep, hmem_if⟩)
170
+
· -- No-provider case
171
+
simp only [Prod.mk.injEq] at heq
172
+
obtain ⟨heq_pkg, rfl, rfl⟩ := heq
173
+
have hp_eq := embedPkg_inj heq_pkg
174
+
subst hp_eq
175
+
rcases hres.virtual_dep_closure p' hp n vs hdep with
176
+
⟨u, hu_vs, hu_S⟩ | ⟨q, ⟨hqS, vex, hmemtop, hpr, hρ⟩, _⟩
177
+
· exact ⟨hvv.origV u, Finset.mem_map.mpr ⟨u, hu_vs, rfl⟩, mem_cw_emb hu_S⟩
178
+
· exfalso; exact hnp ⟨q, vex, hpr, hmemtop⟩
179
+
· -- With-provider case
180
+
simp only [Prod.mk.injEq] at heq
181
+
obtain ⟨heq_pkg, rfl, rfl⟩ := heq
182
+
have hp_eq := embedPkg_inj heq_pkg
183
+
subst hp_eq
184
+
have hsel_in := sel_in_svs p' hp n vs hdep hprov
185
+
exact ⟨selectorVersion S_v rho prov p' n vs hprov,
186
+
hsel_in,
187
+
mem_cw_sel hp hdep hprov⟩
188
+
· -- Selector→provider: source is embedPkg → name contradiction
189
+
split at hmem_if <;> [skip; simp at hmem_if]
190
+
rw [Finset.mem_singleton] at hmem_if
191
+
have h1 := (Prod.mk.inj (Prod.mk.inj hmem_if).1).1
192
+
exact absurd h1 (hvn.origN_ne_selectorN _ _ _)
193
+
· -- Selector→direct: source is embedPkg → name contradiction
194
+
split at hmem_if <;> [skip; simp at hmem_if]
195
+
simp only [Finset.mem_image, Finset.mem_filter] at hmem_if
196
+
obtain ⟨_, _, hmem_eq⟩ := hmem_if
197
+
have h1 := (Prod.mk.inj (Prod.mk.inj hmem_eq).1).1
198
+
exact absurd h1 (hvn.selectorN_ne_origN _ _ _)
199
+
· -- Source is selector package
200
+
split at hmem_sel <;> [skip; simp at hmem_sel]
201
+
rename_i hprov_orig
202
+
rw [Finset.mem_singleton] at hmem_sel
203
+
-- hmem_sel : q = (selectorN p nd, selectorVersion ...)
204
+
rw [hmem_sel] at hd
205
+
simp only [virtualDeps, Finset.mem_union, Finset.mem_image, Finset.mem_filter,
206
+
Finset.mem_biUnion] at hd
207
+
rcases hd with (((⟨⟨p', n', vs'⟩, ⟨hdep', hnp'⟩, heq⟩ |
208
+
⟨⟨p', n', vs'⟩, ⟨hdep', hprov'⟩, heq⟩) |
209
+
⟨⟨p', n', vs'⟩, hdep', ⟨⟨⟨m, w⟩, n'', v⟩, hprov_mem, hmem_if⟩⟩) |
210
+
⟨⟨p', n', vs'⟩, hdep', hmem_if⟩)
211
+
· -- No-provider: source is embedPkg → name contradiction
212
+
simp only [embedPkg, Prod.mk.injEq] at heq
213
+
exact absurd heq.1.1.symm (hvn.selectorN_ne_origN _ _ _)
214
+
· -- With-provider: source is embedPkg → name contradiction
215
+
simp only [embedPkg, Prod.mk.injEq] at heq
216
+
exact absurd heq.1.1.symm (hvn.selectorN_ne_origN _ _ _)
217
+
· -- Selector→provider
218
+
split at hmem_if <;> [skip; simp at hmem_if]
219
+
rw [Finset.mem_singleton] at hmem_if
220
+
obtain ⟨h_src, rfl, rfl⟩ := Prod.mk.inj hmem_if
221
+
obtain ⟨h1, h2⟩ := Prod.mk.inj h_src
222
+
obtain ⟨hp_eq, hnd_eq⟩ := hvn.selectorN_injective h1
223
+
subst hp_eq; subst hnd_eq
224
+
-- Which variables survive?
225
+
obtain ⟨m_sel, w_sel, heqv, hmw⟩ := sel_mem_Sv _ hpS _ vsd hd_orig hprov_orig
226
+
rw [heqv] at h2
227
+
obtain ⟨rfl, rfl⟩ := hvv.providerV_injective h2
228
+
exact ⟨hvv.origV w_sel, Finset.mem_singleton.mpr rfl, mem_cw_emb hmw⟩
229
+
· -- Selector→direct
230
+
split at hmem_if <;> [skip; simp at hmem_if]
231
+
simp only [Finset.mem_image, Finset.mem_filter] at hmem_if
232
+
obtain ⟨u, _, hmem_eq⟩ := hmem_if
233
+
obtain ⟨h_src, rfl, rfl⟩ := Prod.mk.inj hmem_eq
234
+
obtain ⟨h1, h2⟩ := Prod.mk.inj h_src
235
+
obtain ⟨hp_eq, hnd_eq⟩ := hvn.selectorN_injective h1
236
+
subst hp_eq; subst hnd_eq
237
+
obtain ⟨m_sel, w_sel, heqv, hmw⟩ := sel_mem_Sv _ hpS _ vsd hd_orig hprov_orig
238
+
rw [heqv] at h2
239
+
obtain ⟨rfl, rfl⟩ := hvv.providerV_injective h2
240
+
exact ⟨hvv.origV _, Finset.mem_singleton.mpr rfl, mem_cw_emb hmw⟩
241
+
· -- version_unique
242
+
intro nm cv₁ cv₂ hv₁ hv₂
243
+
simp only [completenessWitness, Finset.mem_union, Finset.mem_biUnion,
244
+
Finset.mem_filter, Finset.mem_image, embedSet] at hv₁ hv₂
245
+
rcases hv₁ with ⟨p₁, hp₁, heq1⟩ | ⟨⟨p₁, n₁, vs₁⟩, ⟨hd₁, hpS₁⟩, hmem₁⟩ <;>
246
+
rcases hv₂ with ⟨p₂, hp₂, heq2⟩ | ⟨⟨p₂, n₂, vs₂⟩, ⟨hd₂, hpS₂⟩, hmem₂⟩
247
+
· -- embedPkg × embedPkg
248
+
obtain ⟨h1n, h1v⟩ := Prod.mk.inj heq1
249
+
obtain ⟨h2n, h2v⟩ := Prod.mk.inj heq2
250
+
have hname : p₁.1 = p₂.1 := hvn.origN.injective (h1n.trans h2n.symm)
251
+
have hvers := hres.version_unique p₁.1 p₁.2 p₂.2 hp₁ (hname ▸ hp₂)
252
+
exact h1v.symm.trans ((congrArg hvv.origV hvers).trans h2v)
253
+
· -- embedPkg × selector: name clash
254
+
split at hmem₂ <;> [skip; simp at hmem₂]
255
+
rw [Finset.mem_singleton] at hmem₂
256
+
obtain ⟨h1n, _⟩ := Prod.mk.inj heq1
257
+
obtain ⟨h2n, _⟩ := Prod.mk.inj hmem₂
258
+
exact absurd (h1n.trans h2n) (hvn.origN_ne_selectorN _ _ _)
259
+
· -- selector × embedPkg: name clash
260
+
split at hmem₁ <;> [skip; simp at hmem₁]
261
+
rw [Finset.mem_singleton] at hmem₁
262
+
obtain ⟨h1n, _⟩ := Prod.mk.inj hmem₁
263
+
obtain ⟨h2n, _⟩ := Prod.mk.inj heq2
264
+
exact absurd (h2n.trans h1n) (hvn.origN_ne_selectorN _ _ _)
265
+
· -- selector × selector: same (p, n) → same version (proof-irrelevant)
266
+
split at hmem₁ <;> [skip; simp at hmem₁]
267
+
split at hmem₂ <;> [skip; simp at hmem₂]
268
+
rw [Finset.mem_singleton] at hmem₁ hmem₂
269
+
obtain ⟨h1n, h1v⟩ := Prod.mk.inj hmem₁
270
+
obtain ⟨h2n, h2v⟩ := Prod.mk.inj hmem₂
271
+
obtain ⟨rfl, rfl⟩ := hvn.selectorN_injective (h1n.symm.trans h2n)
272
+
have hvs := hfunc p₁ n₁ vs₁ vs₂ hd₁ hd₂; subst hvs
273
+
exact h1v.trans h2v.symm
274
+
275
+
end PackageCalculus.Virtual
+136
PackageCalculus/Extensions/Virtual/Reduction/Definition.lean
+136
PackageCalculus/Extensions/Virtual/Reduction/Definition.lean
···
1
+
import PackageCalculus.Extensions.Virtual.Definition
2
+
import Mathlib.Data.Finset.Image
3
+
import Mathlib.Data.Finset.Union
4
+
5
+
/-! # Virtual extension: reduction
6
+
7
+
Encodes virtual packages by routing every dependency on a virtual name through
8
+
a synthetic *selector* that picks a concrete provider. -/
9
+
10
+
namespace PackageCalculus.Virtual
11
+
12
+
variable {N : Type*} [DecidableEq N] {V : Type*} [DecidableEq V]
13
+
14
+
inductive VirtualName (N V : Type*) where
15
+
| orig : N → VirtualName N V
16
+
| selector : Package N V → N → VirtualName N V
17
+
deriving DecidableEq
18
+
19
+
inductive VirtualVersion (N V : Type*) where
20
+
| orig : V → VirtualVersion N V
21
+
| provider : N → V → VirtualVersion N V
22
+
deriving DecidableEq
23
+
24
+
variable {N' : Type*} [DecidableEq N'] {V' : Type*} [DecidableEq V']
25
+
variable [hvn : HasVirtualNames N V N'] [hvv : HasVirtualVersions N V V']
26
+
27
+
def embedPkg (p : Package N V) : Package N' V' :=
28
+
(hvn.origN p.1, hvv.origV p.2)
29
+
30
+
def embedSet (S : Finset (Package N V)) : Finset (Package N' V') :=
31
+
S.image embedPkg
32
+
33
+
instance decidableMemTop (v : VTop V) (vs : Finset V) : Decidable (memTop v vs) :=
34
+
match v with
35
+
| .top => Decidable.isTrue trivial
36
+
| .val v' => Finset.decidableMem v' vs
37
+
38
+
def hasProvider (prov : ProvidesRel N V) (n : N) (vs : Finset V) : Prop :=
39
+
∃ q v, (q, n, v) ∈ prov ∧ memTop v vs
40
+
41
+
instance decidableHasProvider (prov : ProvidesRel N V) (n : N) (vs : Finset V) :
42
+
Decidable (hasProvider prov n vs) :=
43
+
if h : ∃ x ∈ prov, (x : Package N V × N × VTop V).2.1 = n ∧ memTop x.2.2 vs
44
+
then Decidable.isTrue (by
45
+
obtain ⟨⟨q, n', v⟩, hx, rfl, hv⟩ := h
46
+
exact ⟨q, v, hx, hv⟩)
47
+
else Decidable.isFalse (by
48
+
intro ⟨q, v, hqv, hm⟩
49
+
exact h ⟨(q, n, v), hqv, rfl, hm⟩)
50
+
51
+
def virtualReal (R_v : Real N V) (Delta : DepRel N V)
52
+
(prov : ProvidesRel N V) :
53
+
Real N' V' :=
54
+
embedSet R_v ∪
55
+
(Delta.biUnion (fun ⟨p, n, vs⟩ =>
56
+
prov.biUnion (fun ⟨⟨m, w⟩, n', v⟩ =>
57
+
if n' = n ∧ memTop v vs then {(hvn.selectorN p n, hvv.providerV m w)} else ∅))) ∪
58
+
(Delta.biUnion (fun ⟨p, n, vs⟩ =>
59
+
if hasProvider prov n vs then
60
+
(vs.filter (fun u => (n, u) ∈ R_v)).image (fun u => (hvn.selectorN p n, hvv.providerV n u))
61
+
else ∅))
62
+
63
+
def selectorVersions (R_v : Real N V)
64
+
(prov : ProvidesRel N V) (n : N) (vs : Finset V) :
65
+
Finset V' :=
66
+
(prov.biUnion (fun ⟨⟨m, u⟩, n', v⟩ =>
67
+
if n' = n ∧ memTop v vs then {hvv.providerV m u} else ∅)) ∪
68
+
((vs.filter (fun u => (n, u) ∈ R_v)).image (fun u => hvv.providerV n u))
69
+
70
+
def virtualDeps (Delta_v : DepRel N V) (R_v : Real N V)
71
+
(prov : ProvidesRel N V) :
72
+
DepRel N' V' :=
73
+
-- No-provider case
74
+
((Delta_v.filter (fun ⟨_, n, vs⟩ => ¬hasProvider prov n vs)).image
75
+
(fun ⟨p, n, vs⟩ => (embedPkg p, hvn.origN n, vs.map hvv.origV))) ∪
76
+
-- With-provider case: p to selector
77
+
((Delta_v.filter (fun ⟨_, n, vs⟩ => hasProvider prov n vs)).image
78
+
(fun ⟨p, n, vs⟩ => (embedPkg p, hvn.selectorN p n, selectorVersions R_v prov n vs))) ∪
79
+
-- Selector to provider
80
+
(Delta_v.biUnion (fun ⟨p, n, vs⟩ =>
81
+
prov.biUnion (fun ⟨⟨m, w⟩, n', v⟩ =>
82
+
if n' = n ∧ memTop v vs then
83
+
{((hvn.selectorN p n, hvv.providerV m w), hvn.origN m, {hvv.origV w})}
84
+
else ∅))) ∪
85
+
-- Selector to direct
86
+
(Delta_v.biUnion (fun ⟨p, n, vs⟩ =>
87
+
if hasProvider prov n vs then
88
+
(vs.filter (fun u => (n, u) ∈ R_v)).image
89
+
(fun u => ((hvn.selectorN p n, hvv.providerV n u), hvn.origN n, {hvv.origV u}))
90
+
else ∅))
91
+
92
+
end PackageCalculus.Virtual
93
+
94
+
namespace PackageCalculus
95
+
96
+
open Function
97
+
98
+
variable {N V : Type*}
99
+
100
+
instance : Virtual.HasVirtualNames N V (Virtual.VirtualName N V) where
101
+
origN := ⟨Virtual.VirtualName.orig, fun _ _ h => Virtual.VirtualName.orig.inj h⟩
102
+
selectorN := Virtual.VirtualName.selector
103
+
selectorN_injective := by
104
+
intro a₁ a₂ b₁ b₂ h
105
+
exact ⟨Virtual.VirtualName.selector.inj h |>.1,
106
+
Virtual.VirtualName.selector.inj h |>.2⟩
107
+
origN_ne_selectorN := fun _ _ _ => nofun
108
+
selectorN_ne_origN := fun _ _ _ => nofun
109
+
tryOrigN := fun
110
+
| .orig n => some n
111
+
| _ => none
112
+
tryOrigN_origN := fun _ => rfl
113
+
tryOrigN_some := fun n' n h => by
114
+
cases n' with
115
+
| orig m => simp at h; subst h; rfl
116
+
| selector _ _ => simp at h
117
+
118
+
instance : Virtual.HasVirtualVersions N V (Virtual.VirtualVersion N V) where
119
+
origV := ⟨Virtual.VirtualVersion.orig, fun _ _ h => Virtual.VirtualVersion.orig.inj h⟩
120
+
providerV := Virtual.VirtualVersion.provider
121
+
providerV_injective := by
122
+
intro a₁ a₂ b₁ b₂ h
123
+
exact ⟨Virtual.VirtualVersion.provider.inj h |>.1,
124
+
Virtual.VirtualVersion.provider.inj h |>.2⟩
125
+
origV_ne_providerV := fun _ _ _ => nofun
126
+
providerV_ne_origV := fun _ _ _ => nofun
127
+
tryOrigV := fun
128
+
| .orig v => some v
129
+
| _ => none
130
+
tryOrigV_origV := fun _ => rfl
131
+
tryOrigV_some := fun v' v h => by
132
+
cases v' with
133
+
| orig w => simp at h; subst h; rfl
134
+
| provider _ _ => simp at h
135
+
136
+
end PackageCalculus
+181
PackageCalculus/Extensions/Virtual/Reduction/Soundness.lean
+181
PackageCalculus/Extensions/Virtual/Reduction/Soundness.lean
···
1
+
import PackageCalculus.Extensions.Virtual.Reduction.Definition
2
+
import Mathlib.Data.Finset.Preimage
3
+
4
+
/-! # Virtual extension: soundness
5
+
6
+
Any core resolution of the virtual encoding induces a virtual resolution of
7
+
the original problem. -/
8
+
9
+
namespace PackageCalculus.Virtual
10
+
11
+
open Classical
12
+
13
+
variable {N : Type*} [DecidableEq N] {V : Type*} [DecidableEq V]
14
+
variable {N' : Type*} [DecidableEq N'] {V' : Type*} [DecidableEq V']
15
+
variable [hvn : HasVirtualNames N V N'] [hvv : HasVirtualVersions N V V']
16
+
17
+
omit [DecidableEq N] [DecidableEq V] [DecidableEq N'] [DecidableEq V'] in
18
+
private theorem embedPkg_injective :
19
+
Function.Injective (embedPkg : Package N V → Package N' V') := by
20
+
intro ⟨n₁, v₁⟩ ⟨n₂, v₂⟩ h
21
+
simp only [embedPkg, Prod.mk.injEq] at h
22
+
exact Prod.ext (hvn.origN.injective h.1) (hvv.origV.injective h.2)
23
+
24
+
private noncomputable def preimageS (S : Finset (Package N' V')) : Finset (Package N V) :=
25
+
S.preimage embedPkg (Set.InjOn.mono (Set.subset_univ _)
26
+
(Function.Injective.injOn embedPkg_injective))
27
+
28
+
omit [DecidableEq N] [DecidableEq V] [DecidableEq N'] [DecidableEq V'] in
29
+
private theorem mem_preimageS {S : Finset (Package N' V')} {p : Package N V} :
30
+
p ∈ preimageS S ↔ embedPkg p ∈ S := by
31
+
simp [preimageS, Finset.mem_preimage]
32
+
33
+
private theorem embedPkg_mem_real {p : Package N V}
34
+
{R_v : Real N V} {Delta_v : DepRel N V} {prov : ProvidesRel N V}
35
+
(h : embedPkg p ∈ virtualReal R_v Delta_v prov) : p ∈ R_v := by
36
+
have hemb : embedPkg p ∈ embedSet R_v := by
37
+
simp only [virtualReal, Finset.mem_union] at h
38
+
rcases h with (h1 | h2)
39
+
· rcases h1 with (h1a | h1b)
40
+
· exact h1a
41
+
· exfalso
42
+
simp only [Finset.mem_biUnion] at h1b
43
+
obtain ⟨⟨p', n', vs'⟩, _, h1b'⟩ := h1b
44
+
obtain ⟨⟨q', n'', v'⟩, _, h1b''⟩ := h1b'
45
+
split at h1b''
46
+
· rw [Finset.mem_singleton] at h1b''
47
+
simp only [embedPkg, Prod.mk.injEq] at h1b''
48
+
exact absurd h1b''.1 (hvn.origN_ne_selectorN p.1 p' n')
49
+
· simp at h1b''
50
+
· exfalso
51
+
simp only [Finset.mem_biUnion] at h2
52
+
obtain ⟨⟨p', n', vs'⟩, _, h2'⟩ := h2
53
+
split at h2'
54
+
· simp only [Finset.mem_image, Finset.mem_filter] at h2'
55
+
obtain ⟨_, _, heq⟩ := h2'
56
+
simp only [embedPkg, Prod.mk.injEq] at heq
57
+
exact absurd heq.1.symm (hvn.origN_ne_selectorN p.1 p' n')
58
+
· simp at h2'
59
+
simp only [embedSet, Finset.mem_image] at hemb
60
+
obtain ⟨q, hqR, hqeq⟩ := hemb
61
+
rwa [embedPkg_injective hqeq] at hqR
62
+
63
+
/-- The explicit provider relation witnessing virtual soundness. -/
64
+
noncomputable def soundnessRho (Delta_v : DepRel N V) (prov : ProvidesRel N V)
65
+
(S : Finset (Package N' V')) : Finset (Package N V × N × Package N V) :=
66
+
Delta_v.biUnion (fun ⟨p, n, vs⟩ =>
67
+
prov.biUnion (fun ⟨q, n', v⟩ =>
68
+
if n' = n ∧ memTop v vs ∧
69
+
(hvn.selectorN p n, hvv.providerV q.1 q.2) ∈ S
70
+
then {(q, n, p)} else ∅))
71
+
72
+
-- Paper Thm 4.7.4 (Virtual Package Reduction Soundness).
73
+
theorem virtual_soundness
74
+
(R_v : Real N V) (Delta_v : DepRel N V)
75
+
(prov : ProvidesRel N V) (r : Package N V)
76
+
(S : Finset (Package N' V'))
77
+
(hres : IsResolution (virtualReal R_v Delta_v prov) (virtualDeps Delta_v R_v prov)
78
+
(embedPkg r) S) :
79
+
IsVirtualResolution R_v Delta_v prov r (preimageS S) (soundnessRho Delta_v prov S) := by
80
+
refine ⟨?_, ?_, ?_, ?_⟩
81
+
· -- subset
82
+
intro p hp
83
+
rw [mem_preimageS] at hp
84
+
exact embedPkg_mem_real (hres.subset hp)
85
+
· -- root_mem
86
+
rw [mem_preimageS]
87
+
exact hres.root_mem
88
+
· -- virtual_dep_closure
89
+
intro ⟨pn, pv⟩ hp n vs hdep
90
+
rw [mem_preimageS] at hp
91
+
by_cases hprov : hasProvider prov n vs
92
+
· -- Case: dependency has providers
93
+
have hd_sel : (embedPkg (pn, pv), hvn.selectorN (pn, pv) n,
94
+
selectorVersions R_v prov n vs) ∈
95
+
virtualDeps Delta_v R_v prov := by
96
+
simp only [virtualDeps, Finset.mem_union, Finset.mem_image, Finset.mem_filter]
97
+
left; left; right
98
+
exact ⟨⟨(pn, pv), n, vs⟩, ⟨hdep, hprov⟩, rfl⟩
99
+
obtain ⟨sv, hsv_mem, hsv_S⟩ := hres.dep_closure _ hp _ _ hd_sel
100
+
simp only [selectorVersions, Finset.mem_union, Finset.mem_biUnion,
101
+
Finset.mem_image, Finset.mem_filter] at hsv_mem
102
+
rcases hsv_mem with ⟨⟨⟨m, u⟩, n', v⟩, hprov_mem, hmem_if⟩ |
103
+
⟨u, ⟨hu_vs, hu_R⟩, rfl⟩
104
+
· -- Provider case
105
+
split at hmem_if
106
+
· rename_i hcond
107
+
obtain ⟨hn'n, hmemtop⟩ := hcond
108
+
rw [Finset.mem_singleton] at hmem_if
109
+
rw [hmem_if] at hsv_S
110
+
have hprov_mem' : ((m, u), n, v) ∈ prov := hn'n ▸ hprov_mem
111
+
have hd_prov : ((hvn.selectorN (pn, pv) n, hvv.providerV m u),
112
+
hvn.origN m, ({hvv.origV u} : Finset _)) ∈
113
+
virtualDeps Delta_v R_v prov := by
114
+
simp only [virtualDeps, Finset.mem_union, Finset.mem_biUnion]
115
+
left; right
116
+
refine ⟨⟨(pn, pv), n, vs⟩, hdep, ⟨⟨(m, u), n, v⟩, hprov_mem', ?_⟩⟩
117
+
simp [hmemtop]
118
+
obtain ⟨w, hw_mem, hw_S⟩ := hres.dep_closure _ hsv_S _ _ hd_prov
119
+
rw [Finset.mem_singleton.mp hw_mem] at hw_S
120
+
have hrho_mem : (((m, u) : Package N V), n, ((pn, pv) : Package N V)) ∈
121
+
soundnessRho Delta_v prov S := by
122
+
simp only [soundnessRho, Finset.mem_biUnion]
123
+
refine ⟨⟨(pn, pv), n, vs⟩, hdep, ⟨⟨(m, u), n, v⟩, hprov_mem', ?_⟩⟩
124
+
simp [hmemtop, hsv_S]
125
+
right
126
+
refine ⟨(m, u), ⟨mem_preimageS.mpr hw_S, v, hmemtop, hprov_mem', hrho_mem⟩, ?_⟩
127
+
intro ⟨m', u'⟩ ⟨hq'S, v', _, hprov_out, hρ⟩
128
+
rw [mem_preimageS] at hq'S
129
+
simp only [soundnessRho] at hρ
130
+
have hρ' : _ ∈ Delta_v.biUnion _ := hρ
131
+
simp only [Finset.mem_biUnion] at hρ'
132
+
obtain ⟨⟨p', n_r, vs_r⟩, hdep_r, ⟨⟨q_r, n_r', v_r⟩, hprov_mem_r, hmem_if_r⟩⟩ := hρ'
133
+
split at hmem_if_r
134
+
· rename_i hcond_r
135
+
obtain ⟨hn_r', hmemtop_r, hsel_S'⟩ := hcond_r
136
+
rw [Finset.mem_singleton] at hmem_if_r
137
+
-- hmem_if_r : ((m', u'), n, (pn, pv)) = (q_r, n_r, p')
138
+
-- From the tagged rho element we extract equalities
139
+
have hq_eq : q_r = (m', u') := (Prod.mk.inj hmem_if_r).1.symm
140
+
have hn_tag : n_r = n := (Prod.mk.inj (Prod.mk.inj hmem_if_r).2).1.symm
141
+
have hp_eq : p' = (pn, pv) := (Prod.mk.inj (Prod.mk.inj hmem_if_r).2).2.symm
142
+
subst hq_eq; subst hp_eq
143
+
-- hsel_S' references n_r; rewrite to n using hn_tag
144
+
rw [hn_tag] at hsel_S'
145
+
-- Now hsel_S' : (selectorN (pn, pv) n, providerV m' u') ∈ S
146
+
have hveq := hres.version_unique (hvn.selectorN (pn, pv) n)
147
+
(hvv.providerV m u) (hvv.providerV m' u') hsv_S hsel_S'
148
+
obtain ⟨rfl, rfl⟩ := hvv.providerV_injective hveq
149
+
rfl
150
+
· simp at hmem_if_r
151
+
· simp at hmem_if
152
+
· -- Direct case
153
+
have hd_dir : ((hvn.selectorN (pn, pv) n, hvv.providerV n u),
154
+
hvn.origN n, ({hvv.origV u} : Finset _)) ∈
155
+
virtualDeps Delta_v R_v prov := by
156
+
simp only [virtualDeps, Finset.mem_union, Finset.mem_biUnion,
157
+
Finset.mem_image, Finset.mem_filter]
158
+
right
159
+
refine ⟨⟨(pn, pv), n, vs⟩, hdep, ?_⟩
160
+
simp [hprov, hu_vs, hu_R]
161
+
obtain ⟨w, hw_mem, hw_S⟩ := hres.dep_closure _ hsv_S _ _ hd_dir
162
+
rw [Finset.mem_singleton.mp hw_mem] at hw_S
163
+
left
164
+
exact ⟨u, hu_vs, mem_preimageS.mpr hw_S⟩
165
+
· -- Case: no providers
166
+
have hd : (embedPkg (pn, pv), hvn.origN n,
167
+
vs.map hvv.origV) ∈ virtualDeps Delta_v R_v prov := by
168
+
simp only [virtualDeps, Finset.mem_union, Finset.mem_image, Finset.mem_filter]
169
+
left; left; left
170
+
exact ⟨⟨(pn, pv), n, vs⟩, ⟨hdep, hprov⟩, rfl⟩
171
+
obtain ⟨v, hv_mem, hv_S⟩ := hres.dep_closure _ hp _ _ hd
172
+
simp only [Finset.mem_map] at hv_mem
173
+
obtain ⟨u, hu_vs, rfl⟩ := hv_mem
174
+
left
175
+
exact ⟨u, hu_vs, mem_preimageS.mpr hv_S⟩
176
+
· -- version_unique
177
+
intro n v v' hv hv'
178
+
rw [mem_preimageS] at hv hv'
179
+
exact hvv.origV.injective (hres.version_unique _ _ _ hv hv')
180
+
181
+
end PackageCalculus.Virtual
+57
PackageCalculus/Versions/Formula.lean
+57
PackageCalculus/Versions/Formula.lean
···
1
+
import PackageCalculus.Core.Definition
2
+
import Mathlib.Data.Finset.Image
3
+
4
+
namespace PackageCalculus
5
+
6
+
variable (V : Type*)
7
+
8
+
inductive CmpOp where | ge | gt | le | lt | eq | ne deriving DecidableEq
9
+
10
+
inductive VersionFormula (V : Type*) where
11
+
| top : VersionFormula V
12
+
| conj : VersionFormula V → VersionFormula V → VersionFormula V
13
+
| disj : VersionFormula V → VersionFormula V → VersionFormula V
14
+
| cmp : CmpOp → V → VersionFormula V
15
+
deriving DecidableEq
16
+
17
+
variable {V : Type*} [DecidableEq V] {N : Type*} [DecidableEq N]
18
+
19
+
def CmpOp.eval [LT V] [DecidableRel (· < · : V → V → Prop)]
20
+
(ω : CmpOp) (v c : V) : Bool :=
21
+
match ω with
22
+
| .ge => !decide (v < c)
23
+
| .gt => decide (c < v)
24
+
| .le => !decide (c < v)
25
+
| .lt => decide (v < c)
26
+
| .eq => decide (v = c)
27
+
| .ne => !decide (v = c)
28
+
29
+
/-- The versions in `Vn` that satisfy `φ`. -/
30
+
def VersionFormula.eval [LT V] [DecidableRel (· < · : V → V → Prop)]
31
+
(φ : VersionFormula V) (Vn : Finset V) : Finset V :=
32
+
match φ with
33
+
| .top => Vn
34
+
| .conj φ₁ φ₂ => φ₁.eval Vn ∩ φ₂.eval Vn
35
+
| .disj φ₁ φ₂ => φ₁.eval Vn ∪ φ₂.eval Vn
36
+
| .cmp ω c => Vn.filter (fun v => ω.eval v c)
37
+
38
+
abbrev VFDepRel (N V : Type*) [DecidableEq N] [DecidableEq V] :=
39
+
Finset (Package N V × N × VersionFormula V)
40
+
41
+
/-- The versions of name `m` available in `R`. -/
42
+
def repoVersions (R : Real N V) (m : N) : Finset V :=
43
+
(R.filter (fun p => p.1 = m)).image Prod.snd
44
+
45
+
/-- Like IsResolution but dependency closure uses formula semantics. -/
46
+
structure IsVFResolution [LT V] [DecidableRel (· < · : V → V → Prop)]
47
+
(R : Real N V)
48
+
(Δ_Φ : VFDepRel N V)
49
+
(r : Package N V)
50
+
(S : Finset (Package N V)) : Prop where
51
+
subset : S ⊆ R
52
+
root_mem : r ∈ S
53
+
dep_closure : ∀ p ∈ S, ∀ m : N, ∀ φ : VersionFormula V,
54
+
(p, m, φ) ∈ Δ_Φ → ∃ v ∈ φ.eval (repoVersions R m), (m, v) ∈ S
55
+
version_unique : VersionUnique S
56
+
57
+
end PackageCalculus
+23
PackageCalculus/Versions/Lifting/Completeness.lean
+23
PackageCalculus/Versions/Lifting/Completeness.lean
···
1
+
import PackageCalculus.Versions.Lifting.Definition
2
+
import PackageCalculus.Versions.Lifting.Retraction
3
+
import PackageCalculus.Versions.Reduction.Correctness
4
+
5
+
set_option linter.unusedSectionVars false
6
+
7
+
namespace PackageCalculus
8
+
9
+
variable {V : Type*} [DecidableEq V]
10
+
variable {N : Type*} [DecidableEq N]
11
+
12
+
/-- If `S` is a VF-resolution for the lifted deps, it is a resolution for
13
+
the original concrete `Δ`. -/
14
+
theorem liftVFDeps_completeness [LinearOrder V]
15
+
(R : Real N V) (Δ : DepRel N V) (r : Package N V) (S : Finset (Package N V))
16
+
(hne : ∀ p m vs, (p, m, vs) ∈ Δ → vs.Nonempty)
17
+
(hsub : ∀ p m vs, (p, m, vs) ∈ Δ → vs ⊆ repoVersions R m)
18
+
(hres : IsVFResolution R (liftVFDeps R Δ) r S) :
19
+
IsResolution R Δ r S := by
20
+
rw [← liftVFDeps_vfReduce R Δ hne hsub]
21
+
exact (vfReduction_correct R (liftVFDeps R Δ) r S).mpr hres
22
+
23
+
end PackageCalculus
+492
PackageCalculus/Versions/Lifting/Definition.lean
+492
PackageCalculus/Versions/Lifting/Definition.lean
···
1
+
import PackageCalculus.Versions.Formula
2
+
import PackageCalculus.Versions.Reduction.Definition
3
+
import Mathlib.Order.Defs.LinearOrder
4
+
import Mathlib.Data.Finset.Sort
5
+
import Mathlib.Data.List.Basic
6
+
7
+
set_option linter.unusedSectionVars false
8
+
9
+
namespace PackageCalculus
10
+
11
+
variable {V : Type*} [DecidableEq V]
12
+
13
+
/-! ## finsetToFormula: construct a VersionFormula from a target Finset -/
14
+
15
+
/-- Build a formula that is the disjunction of a non-empty list of formulas. -/
16
+
private def disjoinFormulas : List (VersionFormula V) → VersionFormula V
17
+
| [] => .top -- unreachable in practice
18
+
| [φ] => φ
19
+
| φ :: φs => .disj φ (disjoinFormulas φs)
20
+
21
+
/-- Build a formula for a contiguous range [lo, hi] (using ≥ lo ∧ ≤ hi),
22
+
or just = v for a singleton. -/
23
+
private def rangeFormula [LinearOrder V] (lo hi : V) : VersionFormula V :=
24
+
if lo = hi then .cmp .eq lo
25
+
else .conj (.cmp .ge lo) (.cmp .le hi)
26
+
27
+
/-- Extend a range: consume consecutive repo versions that are in the target set.
28
+
Returns the high end of the range and the remaining repo list. -/
29
+
private def extendRange [LinearOrder V] :
30
+
List V → Finset V → V → V × List V
31
+
| [], _, cur => (cur, [])
32
+
| v :: vs, target, cur =>
33
+
if v ∈ target then extendRange vs target v
34
+
else (cur, v :: vs)
35
+
36
+
private theorem extendRange_length_le [LinearOrder V]
37
+
(l : List V) (target : Finset V) (cur : V) :
38
+
(extendRange l target cur).2.length ≤ l.length := by
39
+
induction l generalizing cur with
40
+
| nil => simp [extendRange]
41
+
| cons v vs ih =>
42
+
simp only [extendRange]; split
43
+
· exact Nat.le_succ_of_le (ih v)
44
+
· exact Nat.le_refl _
45
+
46
+
/-- Given a sorted repo list and target set, identify contiguous ranges
47
+
in the target and build range formulas. -/
48
+
private def buildRanges [LinearOrder V] :
49
+
List V → Finset V → List (VersionFormula V)
50
+
| [], _ => []
51
+
| v :: vs, target =>
52
+
if v ∈ target then
53
+
let result := extendRange vs target v
54
+
rangeFormula v result.1 :: buildRanges result.2 target
55
+
else
56
+
buildRanges vs target
57
+
termination_by l => l.length
58
+
decreasing_by
59
+
all_goals simp_wf
60
+
all_goals (first | omega | (have := extendRange_length_le vs target v; omega))
61
+
62
+
/-- Convert a non-empty `Finset V` into a `VersionFormula V` that evaluates to
63
+
exactly that set against the repository, via contiguous-range detection on the
64
+
sorted repository. -/
65
+
def finsetToFormula [LinearOrder V]
66
+
(repo : Finset V) (target : Finset V) (h : target.Nonempty) : VersionFormula V :=
67
+
let sorted := repo.sort (· ≤ ·)
68
+
let ranges := buildRanges sorted target
69
+
match ranges with
70
+
| [] =>
71
+
-- fallback: pick an element from target
72
+
.cmp .eq (target.min' h)
73
+
| [φ] => φ
74
+
| φ :: φs => disjoinFormulas (φ :: φs)
75
+
76
+
/-! ## Helper lemmas for finsetToFormula correctness -/
77
+
78
+
/-! We define a Set-based evaluation locally for proof purposes. The public
79
+
theorem `finsetToFormula_eval` is stated in terms of the (Finset-based)
80
+
`VersionFormula.eval`. -/
81
+
82
+
/-- Set-based comparison operator evaluation (proof-internal). -/
83
+
private def CmpOp.evalProp [LT V] (ω : CmpOp) (v c : V) : Prop :=
84
+
match ω with
85
+
| .ge => ¬(v < c) -- v ≥ c
86
+
| .gt => c < v
87
+
| .le => ¬(c < v) -- v ≤ c
88
+
| .lt => v < c
89
+
| .eq => v = c
90
+
| .ne => v ≠ c
91
+
92
+
/-- Set-based formula evaluation (proof-internal). -/
93
+
private def VersionFormula.evalSet [LT V]
94
+
(φ : VersionFormula V) (Vn : Set V) : Set V :=
95
+
match φ with
96
+
| .top => Vn
97
+
| .conj φ₁ φ₂ => φ₁.evalSet Vn ∩ φ₂.evalSet Vn
98
+
| .disj φ₁ φ₂ => φ₁.evalSet Vn ∪ φ₂.evalSet Vn
99
+
| .cmp ω c => { v ∈ Vn | ω.evalProp v c }
100
+
101
+
/-- The Finset eval agrees with the Set eval when cast to Set. -/
102
+
private theorem eval_coe [LT V] [DecidableRel (· < · : V → V → Prop)]
103
+
(φ : VersionFormula V) (Vn : Finset V) :
104
+
↑(φ.eval Vn) = φ.evalSet ↑Vn := by
105
+
induction φ with
106
+
| top => simp [VersionFormula.eval, VersionFormula.evalSet]
107
+
| conj φ₁ φ₂ ih₁ ih₂ =>
108
+
simp only [VersionFormula.eval, VersionFormula.evalSet, Finset.coe_inter]
109
+
rw [ih₁, ih₂]
110
+
| disj φ₁ φ₂ ih₁ ih₂ =>
111
+
simp only [VersionFormula.eval, VersionFormula.evalSet, Finset.coe_union]
112
+
rw [ih₁, ih₂]
113
+
| cmp ω c =>
114
+
ext v
115
+
simp only [VersionFormula.eval, VersionFormula.evalSet, Finset.coe_filter,
116
+
Set.mem_setOf_eq, Finset.mem_coe]
117
+
constructor
118
+
· rintro ⟨hv, hb⟩
119
+
refine ⟨hv, ?_⟩
120
+
cases ω <;> simp [CmpOp.eval, CmpOp.evalProp, decide_eq_true_eq] at hb ⊢ <;> exact hb
121
+
· rintro ⟨hv, hp⟩
122
+
refine ⟨hv, ?_⟩
123
+
cases ω <;> simp [CmpOp.eval, CmpOp.evalProp, decide_eq_true_eq] at hp ⊢ <;> exact hp
124
+
125
+
/-- Every version formula evaluates to a subset of the input set. -/
126
+
private theorem evalSet_subset [LT V] (φ : VersionFormula V) (Vn : Set V) :
127
+
φ.evalSet Vn ⊆ Vn := by
128
+
induction φ with
129
+
| top => exact Set.Subset.refl _
130
+
| conj _ _ ih₁ _ => exact Set.inter_subset_left.trans ih₁
131
+
| disj _ _ ih₁ ih₂ => exact Set.union_subset ih₁ ih₂
132
+
| cmp _ _ => intro v hv; exact (Set.mem_sep_iff.mp hv).1
133
+
134
+
private theorem mem_rangeFormula_evalSet [LinearOrder V] (lo hi : V) (Vn : Set V) (hle : lo ≤ hi)
135
+
(v : V) : v ∈ (rangeFormula lo hi).evalSet Vn ↔ v ∈ Vn ∧ lo ≤ v ∧ v ≤ hi := by
136
+
by_cases heq : lo = hi
137
+
· subst heq; unfold rangeFormula; simp only [ite_true]
138
+
simp only [VersionFormula.evalSet, CmpOp.evalProp, Set.mem_sep_iff]
139
+
exact ⟨fun ⟨hv, rfl⟩ => ⟨hv, le_refl _, le_refl _⟩,
140
+
fun ⟨hv, hge, hle'⟩ => ⟨hv, le_antisymm hle' hge⟩⟩
141
+
· simp only [rangeFormula, if_neg heq, VersionFormula.evalSet, CmpOp.evalProp,
142
+
Set.mem_inter_iff, Set.mem_sep_iff]
143
+
exact ⟨fun ⟨⟨hv1, hge⟩, ⟨_, hle'⟩⟩ => ⟨hv1, not_lt.mp hge, not_lt.mp hle'⟩,
144
+
fun ⟨hv, hge, hle'⟩ => ⟨⟨hv, not_lt.mpr hge⟩, ⟨hv, not_lt.mpr hle'⟩⟩⟩
145
+
146
+
private theorem disjoinFormulas_mem [LT V] (Vn : Set V) (v : V) :
147
+
∀ (φ : VersionFormula V) (φs : List (VersionFormula V)),
148
+
v ∈ (disjoinFormulas (φ :: φs)).evalSet Vn ↔ ∃ ψ, ψ ∈ (φ :: φs) ∧ v ∈ ψ.evalSet Vn
149
+
| φ, [] => by
150
+
simp only [disjoinFormulas, List.mem_singleton]
151
+
exact ⟨fun h => ⟨φ, rfl, h⟩, fun ⟨ψ, hψ, hv⟩ => hψ ▸ hv⟩
152
+
| φ, ψ :: ψs => by
153
+
simp only [disjoinFormulas, VersionFormula.evalSet, Set.mem_union]
154
+
rw [disjoinFormulas_mem Vn v ψ ψs]
155
+
constructor
156
+
· rintro (h | ⟨ψ', hψ', hv⟩)
157
+
· exact ⟨φ, List.mem_cons_self, h⟩
158
+
· exact ⟨ψ', List.mem_cons_of_mem φ hψ', hv⟩
159
+
· rintro ⟨ψ', hψ', hv⟩
160
+
rcases List.mem_cons.mp hψ' with rfl | hψ'
161
+
· left; exact hv
162
+
· right; exact ⟨ψ', hψ', hv⟩
163
+
164
+
/-! ### extendRange properties -/
165
+
166
+
private theorem extendRange_fst_eq_or_mem [LinearOrder V]
167
+
(l : List V) (target : Finset V) (cur : V) :
168
+
(extendRange l target cur).1 = cur ∨ (extendRange l target cur).1 ∈ l := by
169
+
induction l generalizing cur with
170
+
| nil => left; simp [extendRange]
171
+
| cons w ws ih =>
172
+
simp only [extendRange]; split
173
+
· cases ih w with
174
+
| inl h => right; rw [h]; exact List.mem_cons_self
175
+
| inr h => right; exact List.mem_cons_of_mem w h
176
+
· left; trivial
177
+
178
+
private theorem extendRange_fst_ge [LinearOrder V]
179
+
(l : List V) (target : Finset V) (cur : V) (hge : ∀ x ∈ l, cur ≤ x) :
180
+
cur ≤ (extendRange l target cur).1 := by
181
+
cases extendRange_fst_eq_or_mem l target cur with
182
+
| inl h => rw [h]
183
+
| inr h => exact hge _ h
184
+
185
+
private theorem extendRange_snd_suffix [LinearOrder V]
186
+
(l : List V) (target : Finset V) (cur : V) :
187
+
(extendRange l target cur).2 <:+ l := by
188
+
induction l generalizing cur with
189
+
| nil => exact List.suffix_refl _
190
+
| cons v vs ih =>
191
+
simp only [extendRange]; split
192
+
· exact List.IsSuffix.trans (ih v) (List.suffix_cons v vs)
193
+
· exact List.suffix_refl _
194
+
195
+
private theorem extendRange_consumed_in_target [LinearOrder V]
196
+
(l : List V) (target : Finset V) (cur : V) (v : V)
197
+
(hv_in : v ∈ l) (hv_not_rest : v ∉ (extendRange l target cur).2) :
198
+
v ∈ target := by
199
+
induction l generalizing cur with
200
+
| nil => exact absurd hv_in List.not_mem_nil
201
+
| cons w ws ih =>
202
+
simp only [extendRange] at hv_not_rest
203
+
split at hv_not_rest
204
+
case isTrue hmem =>
205
+
rcases List.mem_cons.mp hv_in with rfl | hin
206
+
· exact hmem
207
+
· exact ih w hin hv_not_rest
208
+
case isFalse =>
209
+
rcases List.mem_cons.mp hv_in with rfl | hin
210
+
· exact absurd List.mem_cons_self hv_not_rest
211
+
· exact absurd (List.mem_cons_of_mem w hin) hv_not_rest
212
+
213
+
private theorem extendRange_not_target_in_rest [LinearOrder V]
214
+
(l : List V) (target : Finset V) (cur : V) (v : V)
215
+
(hv_in : v ∈ l) (hv_not_target : v ∉ target) :
216
+
v ∈ (extendRange l target cur).2 := by
217
+
induction l generalizing cur with
218
+
| nil => exact absurd hv_in List.not_mem_nil
219
+
| cons w ws ih =>
220
+
simp only [extendRange]
221
+
split
222
+
case isTrue hmem =>
223
+
rcases List.mem_cons.mp hv_in with rfl | hin
224
+
· exact absurd hmem hv_not_target
225
+
· exact ih w hin
226
+
case isFalse => exact hv_in
227
+
228
+
private theorem extendRange_consumed_le_fst [LinearOrder V]
229
+
(l : List V) (target : Finset V) (cur : V) (v : V)
230
+
(hpw : l.Pairwise (· ≤ ·)) (hv_in : v ∈ l)
231
+
(hv_not_rest : v ∉ (extendRange l target cur).2) :
232
+
v ≤ (extendRange l target cur).1 := by
233
+
induction l generalizing cur with
234
+
| nil => exact absurd hv_in List.not_mem_nil
235
+
| cons w ws ih =>
236
+
have hpw' := (List.pairwise_cons.mp hpw).2
237
+
have hwall := (List.pairwise_cons.mp hpw).1
238
+
by_cases hmem : w ∈ target
239
+
· -- w ∈ target: extendRange unfolds to recursive call
240
+
simp only [extendRange, if_pos hmem] at hv_not_rest ⊢
241
+
rcases List.mem_cons.mp hv_in with rfl | hin
242
+
· exact extendRange_fst_ge ws target _ hwall
243
+
· exact ih _ hpw' hin hv_not_rest
244
+
· -- w ∉ target: remainder is w :: ws
245
+
simp only [extendRange, if_neg hmem] at hv_not_rest
246
+
exfalso
247
+
rcases List.mem_cons.mp hv_in with rfl | hin
248
+
· exact hv_not_rest List.mem_cons_self
249
+
· exact hv_not_rest (List.mem_cons_of_mem w hin)
250
+
251
+
private theorem extendRange_rest_gt_fst [LinearOrder V]
252
+
(l : List V) (target : Finset V) (cur : V)
253
+
(hpw : l.Pairwise (· < ·)) (hgt_cur : ∀ x ∈ l, cur < x)
254
+
(v : V) (hv : v ∈ (extendRange l target cur).2) :
255
+
(extendRange l target cur).1 < v := by
256
+
induction l generalizing cur with
257
+
| nil => exact absurd hv List.not_mem_nil
258
+
| cons w ws ih =>
259
+
have hpw' := (List.pairwise_cons.mp hpw).2
260
+
have hwall := (List.pairwise_cons.mp hpw).1
261
+
simp only [extendRange] at hv
262
+
split at hv
263
+
case isTrue hmem =>
264
+
simp only [extendRange, if_pos hmem]
265
+
exact ih w hpw' (fun x hx => hwall x hx) hv
266
+
case isFalse hmem =>
267
+
simp only [extendRange, if_neg hmem]
268
+
rcases List.mem_cons.mp hv with rfl | hin
269
+
· exact hgt_cur v List.mem_cons_self
270
+
· exact hgt_cur v (List.mem_cons_of_mem w hin)
271
+
272
+
/-! ### buildRanges correctness (using n-indexed induction) -/
273
+
274
+
private theorem buildRanges_evalSet_lo [LinearOrder V]
275
+
(n : Nat) (l : List V) (hl : l.length ≤ n)
276
+
(target : Finset V) (Vn : Set V) (hpw : l.Pairwise (· ≤ ·))
277
+
(v : V) (φ : VersionFormula V) (hφ : φ ∈ buildRanges l target) (hv : v ∈ φ.evalSet Vn) :
278
+
∃ x ∈ l, x ≤ v := by
279
+
induction n generalizing l v φ with
280
+
| zero =>
281
+
have := List.eq_nil_of_length_eq_zero (Nat.eq_zero_of_le_zero hl)
282
+
subst this; simp [buildRanges] at hφ
283
+
| succ n ih =>
284
+
cases l with
285
+
| nil => simp [buildRanges] at hφ
286
+
| cons w ws =>
287
+
have hpw' := (List.pairwise_cons.mp hpw).2
288
+
have hwall := (List.pairwise_cons.mp hpw).1
289
+
have hlen_ws : ws.length ≤ n := by simp [List.length_cons] at hl; omega
290
+
simp only [buildRanges] at hφ
291
+
split at hφ
292
+
case isTrue hmem =>
293
+
set er := extendRange ws target w
294
+
have hle_er : w ≤ er.1 := extendRange_fst_ge ws target w hwall
295
+
have hlen_er : er.2.length ≤ n := by
296
+
have h1 : er.2.length ≤ ws.length := extendRange_length_le ws target w
297
+
omega
298
+
rcases List.mem_cons.mp hφ with rfl | hφ_rest
299
+
· exact ⟨w, List.mem_cons_self,
300
+
((mem_rangeFormula_evalSet w er.1 Vn hle_er v).mp hv).2.1⟩
301
+
· obtain ⟨x, hx, hle'⟩ := ih er.2 hlen_er
302
+
(List.Pairwise.sublist (extendRange_snd_suffix ws target w).sublist hpw')
303
+
v φ hφ_rest hv
304
+
exact ⟨x, List.mem_cons_of_mem w
305
+
((extendRange_snd_suffix ws target w).subset hx), hle'⟩
306
+
case isFalse =>
307
+
obtain ⟨x, hx, hle'⟩ := ih ws hlen_ws hpw' v φ hφ hv
308
+
exact ⟨x, List.mem_cons_of_mem w hx, hle'⟩
309
+
310
+
private theorem buildRanges_sound [LinearOrder V]
311
+
(n : Nat) (l : List V) (hl : l.length ≤ n)
312
+
(target : Finset V) (Vn : Set V) (hpw_lt : l.Pairwise (· < ·))
313
+
(v : V) (hv_in_l : v ∈ l)
314
+
(φ : VersionFormula V) (hφ : φ ∈ buildRanges l target) (hv_φ : v ∈ φ.evalSet Vn) :
315
+
v ∈ target := by
316
+
induction n generalizing l v φ with
317
+
| zero =>
318
+
have := List.eq_nil_of_length_eq_zero (Nat.eq_zero_of_le_zero hl)
319
+
subst this; exact absurd hv_in_l List.not_mem_nil
320
+
| succ n ih =>
321
+
cases l with
322
+
| nil => exact absurd hv_in_l List.not_mem_nil
323
+
| cons w ws =>
324
+
have hpw_lt' := (List.pairwise_cons.mp hpw_lt).2
325
+
have hwall_lt := (List.pairwise_cons.mp hpw_lt).1
326
+
have hpw_le' : ws.Pairwise (· ≤ ·) := hpw_lt'.imp (fun h => le_of_lt h)
327
+
have hwall_le : ∀ x ∈ ws, w ≤ x := fun x hx => le_of_lt (hwall_lt x hx)
328
+
have hlen_ws : ws.length ≤ n := by simp [List.length_cons] at hl; omega
329
+
simp only [buildRanges] at hφ
330
+
split at hφ
331
+
case isTrue hmem_target =>
332
+
set er := extendRange ws target w
333
+
have hle_er : w ≤ er.1 := extendRange_fst_ge ws target w hwall_le
334
+
have hlen_er : er.2.length ≤ n := by
335
+
have h1 : er.2.length ≤ ws.length := extendRange_length_le ws target w; omega
336
+
rcases List.mem_cons.mp hφ with rfl | hφ_rest
337
+
· -- v ∈ rangeFormula w er.1
338
+
rw [mem_rangeFormula_evalSet w er.1 Vn hle_er v] at hv_φ
339
+
obtain ⟨_, hv_ge, hv_le⟩ := hv_φ
340
+
rcases List.mem_cons.mp hv_in_l with rfl | hv_ws
341
+
· exact hmem_target
342
+
· by_contra hv_not_target
343
+
have hv_rest := extendRange_not_target_in_rest ws target w v hv_ws hv_not_target
344
+
exact absurd (lt_of_lt_of_le
345
+
(extendRange_rest_gt_fst ws target w hpw_lt' hwall_lt v hv_rest) hv_le)
346
+
(lt_irrefl _)
347
+
· -- φ ∈ buildRanges er.2 target
348
+
by_cases hv_rest : v ∈ er.2
349
+
· exact ih er.2 hlen_er
350
+
(List.Pairwise.sublist (extendRange_snd_suffix ws target w).sublist hpw_lt')
351
+
v hv_rest φ hφ_rest hv_φ
352
+
· rcases List.mem_cons.mp hv_in_l with rfl | hv_ws
353
+
· exact hmem_target
354
+
· exact extendRange_consumed_in_target ws target w v hv_ws hv_rest
355
+
case isFalse hnotmem =>
356
+
rcases List.mem_cons.mp hv_in_l with rfl | hv_ws
357
+
· -- v = w ∉ target, but v ∈ some formula from buildRanges ws
358
+
-- All formulas have lo from ws, and w < all ws elements
359
+
have ⟨x, hx, hle⟩ := buildRanges_evalSet_lo n ws hlen_ws target Vn hpw_le'
360
+
v φ hφ hv_φ
361
+
exact absurd (lt_of_lt_of_le (hwall_lt x hx) hle) (lt_irrefl _)
362
+
· exact ih ws hlen_ws hpw_lt' v hv_ws φ hφ hv_φ
363
+
364
+
private theorem buildRanges_complete [LinearOrder V]
365
+
(n : Nat) (l : List V) (hl : l.length ≤ n)
366
+
(target : Finset V) (Vn : Set V) (hpw_lt : l.Pairwise (· < ·))
367
+
(v : V) (hv_in_l : v ∈ l) (hv_target : v ∈ target) (hv_Vn : v ∈ Vn) :
368
+
∃ φ, φ ∈ buildRanges l target ∧ v ∈ φ.evalSet Vn := by
369
+
induction n generalizing l v with
370
+
| zero =>
371
+
have := List.eq_nil_of_length_eq_zero (Nat.eq_zero_of_le_zero hl)
372
+
subst this; exact absurd hv_in_l List.not_mem_nil
373
+
| succ n ih =>
374
+
cases l with
375
+
| nil => exact absurd hv_in_l List.not_mem_nil
376
+
| cons w ws =>
377
+
have hpw_lt' := (List.pairwise_cons.mp hpw_lt).2
378
+
have hwall_lt := (List.pairwise_cons.mp hpw_lt).1
379
+
have hpw_le' : ws.Pairwise (· ≤ ·) := hpw_lt'.imp (fun h => le_of_lt h)
380
+
have hwall_le : ∀ x ∈ ws, w ≤ x := fun x hx => le_of_lt (hwall_lt x hx)
381
+
have hlen_ws : ws.length ≤ n := by simp [List.length_cons] at hl; omega
382
+
simp only [buildRanges]
383
+
split
384
+
case isTrue hmem_target =>
385
+
set er := extendRange ws target w
386
+
have hle_er : w ≤ er.1 := extendRange_fst_ge ws target w hwall_le
387
+
have hlen_er : er.2.length ≤ n := by
388
+
have h1 : er.2.length ≤ ws.length := extendRange_length_le ws target w; omega
389
+
rcases List.mem_cons.mp hv_in_l with rfl | hv_ws
390
+
· -- v = w
391
+
exact ⟨rangeFormula v er.1, List.mem_cons_self,
392
+
(mem_rangeFormula_evalSet v er.1 Vn hle_er v).mpr ⟨hv_Vn, le_refl v, hle_er⟩⟩
393
+
· by_cases hv_rest : v ∈ er.2
394
+
· obtain ⟨φ, hφ, hv_φ⟩ := ih er.2 hlen_er
395
+
(List.Pairwise.sublist (extendRange_snd_suffix ws target w).sublist hpw_lt')
396
+
v hv_rest hv_target hv_Vn
397
+
exact ⟨φ, List.mem_cons_of_mem _ hφ, hv_φ⟩
398
+
· exact ⟨rangeFormula w er.1, List.mem_cons_self,
399
+
(mem_rangeFormula_evalSet w er.1 Vn hle_er v).mpr
400
+
⟨hv_Vn, le_of_lt (hwall_lt v hv_ws),
401
+
extendRange_consumed_le_fst ws target w v hpw_le' hv_ws hv_rest⟩⟩
402
+
case isFalse hmem_target =>
403
+
rcases List.mem_cons.mp hv_in_l with rfl | hv_ws
404
+
· exact absurd hv_target hmem_target
405
+
· exact ih ws hlen_ws hpw_lt' v hv_ws hv_target hv_Vn
406
+
407
+
/-! ## Correctness of finsetToFormula -/
408
+
409
+
private theorem sort_pairwise_lt [LinearOrder V] (s : Finset V) :
410
+
(s.sort (· ≤ ·)).Pairwise (· < ·) := by
411
+
rw [List.pairwise_iff_get]; intro i j hij; exact Finset.sortedLT_sort s hij
412
+
413
+
/-- Evaluating the constructed formula against the repository gives back exactly
414
+
the target set. -/
415
+
theorem finsetToFormula_eval [LinearOrder V]
416
+
(repo : Finset V) (target : Finset V) (h : target.Nonempty) (hsub : target ⊆ repo) :
417
+
(finsetToFormula repo target h).eval repo = target := by
418
+
-- We prove the Set-level statement and then transfer via coe injectivity
419
+
suffices hset : (finsetToFormula repo target h).evalSet (↑repo : Set V) = ↑target by
420
+
apply Finset.coe_injective
421
+
rw [eval_coe]
422
+
exact hset
423
+
set sorted := repo.sort (· ≤ ·) with hsorted_def
424
+
set Vn : Set V := ↑repo
425
+
have hpw_lt := sort_pairwise_lt repo
426
+
have hmem_sort : ∀ v, v ∈ sorted ↔ v ∈ repo := fun v => Finset.mem_sort (· ≤ ·)
427
+
-- Helper: extract formula membership from the match structure
428
+
have fwd_extract : ∀ v, v ∈ (finsetToFormula repo target h).evalSet Vn →
429
+
(∃ φ, φ ∈ buildRanges sorted target ∧ v ∈ φ.evalSet Vn) ∨ v ∈ target := by
430
+
intro v hv_eval
431
+
unfold finsetToFormula at hv_eval; simp only at hv_eval
432
+
revert hv_eval
433
+
match hm : buildRanges sorted target with
434
+
| [] =>
435
+
intro hv_eval
436
+
right
437
+
simp only [VersionFormula.evalSet, CmpOp.evalProp, Set.mem_sep_iff] at hv_eval
438
+
rw [hv_eval.2]; exact Finset.min'_mem target h
439
+
| [φ] =>
440
+
intro hv_eval
441
+
left; exact ⟨φ, List.mem_cons_self, hv_eval⟩
442
+
| φ :: ψ :: ψs =>
443
+
intro hv_eval
444
+
left
445
+
rw [disjoinFormulas_mem Vn v φ (ψ :: ψs)] at hv_eval
446
+
obtain ⟨ψ', hψ', hv'⟩ := hv_eval
447
+
exact ⟨ψ', hψ', hv'⟩
448
+
-- Main proof
449
+
ext v; simp only [Finset.mem_coe]
450
+
constructor
451
+
· -- Forward: v ∈ eval → v ∈ target
452
+
intro hv_eval
453
+
rcases fwd_extract v hv_eval with ⟨φ, hφ, hv_φ⟩ | hv_target
454
+
· have hv_repo : v ∈ Vn := evalSet_subset φ Vn hv_φ
455
+
have hv_sorted : v ∈ sorted := (hmem_sort v).mpr (Finset.mem_coe.mp hv_repo)
456
+
exact buildRanges_sound sorted.length sorted le_rfl target Vn hpw_lt
457
+
v hv_sorted φ hφ hv_φ
458
+
· exact hv_target
459
+
· -- Backward: v ∈ target → v ∈ eval
460
+
intro hv_target
461
+
have hv_repo : v ∈ repo := hsub hv_target
462
+
have hv_sorted : v ∈ sorted := (hmem_sort v).mpr hv_repo
463
+
have hv_Vn : v ∈ Vn := Finset.mem_coe.mpr hv_repo
464
+
obtain ⟨φ, hφ, hv_φ⟩ := buildRanges_complete sorted.length sorted le_rfl target
465
+
Vn hpw_lt v hv_sorted hv_target hv_Vn
466
+
-- Construct membership from formula
467
+
have hφ_ranges : φ ∈ buildRanges sorted target := hφ
468
+
unfold finsetToFormula; simp only
469
+
match hm : buildRanges sorted target, hφ_ranges with
470
+
| [], hφ_ranges => exact absurd hφ_ranges List.not_mem_nil
471
+
| [ψ], hφ_ranges =>
472
+
have heq := List.mem_singleton.mp hφ_ranges
473
+
subst heq; exact hv_φ
474
+
| ψ₁ :: ψ₂ :: ψs, hφ_ranges =>
475
+
exact (disjoinFormulas_mem Vn v ψ₁ (ψ₂ :: ψs)).mpr ⟨φ, hφ_ranges, hv_φ⟩
476
+
477
+
variable {N : Type*} [DecidableEq N]
478
+
479
+
/-! ## liftVFDeps: lift a core DepRel to VFDepRel -/
480
+
481
+
/-- Lift a concrete `DepRel` back to a `VFDepRel` by wrapping each version set
482
+
into a `VersionFormula` via `finsetToFormula`. Each `(p, m, vs)` becomes
483
+
`(p, m, φ)` where `φ` evaluates to `vs` against the repository. -/
484
+
def liftVFDeps [LinearOrder V] (R : Real N V) (Δ : DepRel N V) : VFDepRel N V :=
485
+
Δ.image (fun ⟨p, m, vs⟩ =>
486
+
if h : vs.Nonempty then
487
+
(p, m, finsetToFormula (repoVersions R m) vs h)
488
+
else
489
+
-- empty version set: use .top as a fallback (should not occur in practice)
490
+
(p, m, VersionFormula.top))
491
+
492
+
end PackageCalculus
+41
PackageCalculus/Versions/Lifting/Retraction.lean
+41
PackageCalculus/Versions/Lifting/Retraction.lean
···
1
+
import PackageCalculus.Versions.Lifting.Definition
2
+
import PackageCalculus.Versions.Reduction.Correctness
3
+
4
+
set_option linter.unusedSectionVars false
5
+
6
+
namespace PackageCalculus
7
+
8
+
variable {V : Type*} [DecidableEq V]
9
+
variable {N : Type*} [DecidableEq N]
10
+
11
+
/-! ## Round-trip theorem -/
12
+
13
+
/-- Reducing the lifted formulas gives back the original concrete deps.
14
+
Requires every version set to be nonempty and contained in the repository. -/
15
+
theorem liftVFDeps_vfReduce [LinearOrder V]
16
+
(R : Real N V) (Δ : DepRel N V)
17
+
(hne : ∀ p m vs, (p, m, vs) ∈ Δ → vs.Nonempty)
18
+
(hsub : ∀ p m vs, (p, m, vs) ∈ Δ → vs ⊆ repoVersions R m) :
19
+
vfReduce R (liftVFDeps R Δ) = Δ := by
20
+
ext ⟨p, m, vs⟩
21
+
simp only [vfReduce, liftVFDeps, Finset.mem_image]
22
+
constructor
23
+
· rintro ⟨⟨p', m', φ'⟩, ⟨⟨p'', m'', vs''⟩, hmem, hlift⟩, heq⟩
24
+
have hne' := hne p'' m'' vs'' hmem
25
+
have hsub' := hsub p'' m'' vs'' hmem
26
+
simp only [dif_pos hne', Prod.mk.injEq] at hlift
27
+
obtain ⟨rfl, rfl, rfl⟩ := hlift
28
+
simp only [Prod.mk.injEq] at heq
29
+
obtain ⟨rfl, rfl, hvs⟩ := heq
30
+
have heval := finsetToFormula_eval (repoVersions R m'') vs'' hne' hsub'
31
+
rw [heval] at hvs
32
+
rw [← hvs]; exact hmem
33
+
· intro hmem
34
+
have hne' := hne p m vs hmem
35
+
have hsub' := hsub p m vs hmem
36
+
refine ⟨(p, m, finsetToFormula (repoVersions R m) vs hne'), ?_, ?_⟩
37
+
· exact ⟨⟨p, m, vs⟩, hmem, by simp [dif_pos hne']⟩
38
+
· have heval := finsetToFormula_eval (repoVersions R m) vs hne' hsub'
39
+
rw [heval]
40
+
41
+
end PackageCalculus
+26
PackageCalculus/Versions/Lifting/Soundness.lean
+26
PackageCalculus/Versions/Lifting/Soundness.lean
···
1
+
import PackageCalculus.Versions.Lifting.Definition
2
+
import PackageCalculus.Versions.Lifting.Retraction
3
+
import PackageCalculus.Versions.Reduction.Correctness
4
+
5
+
set_option linter.unusedSectionVars false
6
+
7
+
namespace PackageCalculus
8
+
9
+
variable {V : Type*} [DecidableEq V]
10
+
variable {N : Type*} [DecidableEq N]
11
+
12
+
/-! ## Lifting soundness & completeness -/
13
+
14
+
/-- If `S` is a resolution for the concrete `Δ`, it is also a resolution for the
15
+
lifted `VFDepRel`. -/
16
+
theorem liftVFDeps_soundness [LinearOrder V]
17
+
(R : Real N V) (Δ : DepRel N V) (r : Package N V) (S : Finset (Package N V))
18
+
(hne : ∀ p m vs, (p, m, vs) ∈ Δ → vs.Nonempty)
19
+
(hsub : ∀ p m vs, (p, m, vs) ∈ Δ → vs ⊆ repoVersions R m)
20
+
(hres : IsResolution R Δ r S) :
21
+
IsVFResolution R (liftVFDeps R Δ) r S := by
22
+
rw [← vfReduction_correct]
23
+
rw [liftVFDeps_vfReduce R Δ hne hsub]
24
+
exact hres
25
+
26
+
end PackageCalculus
+25
PackageCalculus/Versions/Reduction/Correctness.lean
+25
PackageCalculus/Versions/Reduction/Correctness.lean
···
1
+
import PackageCalculus.Versions.Reduction.Definition
2
+
3
+
namespace PackageCalculus
4
+
5
+
variable {N : Type*} [DecidableEq N] {V : Type*} [LT V] [DecidableEq V]
6
+
[DecidableRel (· < · : V → V → Prop)]
7
+
8
+
-- Paper Thm 3.2.6 (Version Formula Reduction Correctness).
9
+
theorem vfReduction_correct (R : Real N V)
10
+
(Δ_Φ : VFDepRel N V) (r : Package N V) (S : Finset (Package N V)) :
11
+
IsResolution R (vfReduce R Δ_Φ) r S ↔ IsVFResolution R Δ_Φ r S := by
12
+
constructor
13
+
· rintro ⟨hsub, hroot, hdep, huniq⟩
14
+
exact ⟨hsub, hroot,
15
+
fun p hp m φ hφ =>
16
+
hdep p hp m (φ.eval (repoVersions R m))
17
+
(Finset.mem_image.mpr ⟨⟨p, m, φ⟩, hφ, rfl⟩),
18
+
huniq⟩
19
+
· rintro ⟨hsub, hroot, hdep, huniq⟩
20
+
refine ⟨hsub, hroot, fun p hp m vs hmem => ?_, huniq⟩
21
+
simp only [vfReduce, Finset.mem_image, Prod.mk.injEq] at hmem
22
+
obtain ⟨⟨p', m', φ⟩, hφ, rfl, rfl, rfl⟩ := hmem
23
+
exact hdep p' hp m' φ hφ
24
+
25
+
end PackageCalculus
+16
PackageCalculus/Versions/Reduction/Definition.lean
+16
PackageCalculus/Versions/Reduction/Definition.lean
···
1
+
import PackageCalculus.Versions.Formula
2
+
3
+
/-! # Reducing version-formula resolutions to base resolutions
4
+
5
+
`vfReduce` evaluates every `VersionFormula` in a `VFDepRel` against the
6
+
available versions in `R`, producing a plain `DepRel`. -/
7
+
8
+
namespace PackageCalculus
9
+
10
+
variable {N : Type*} [DecidableEq N] {V : Type*} [LT V] [DecidableEq V]
11
+
[DecidableRel (· < · : V → V → Prop)]
12
+
13
+
def vfReduce (R : Real N V) (Δ_Φ : VFDepRel N V) : DepRel N V :=
14
+
Δ_Φ.image (fun ⟨p, m, φ⟩ => (p, m, φ.eval (repoVersions R m)))
15
+
16
+
end PackageCalculus
+45
README.md
+45
README.md
···
1
+
This artifact accompanies the paper *Package Managers à la Carte: A Formal Model of Dependency Resolution*.
2
+
It should be evaluated against the revised version of the paper, which differs from the conditionally-accepted version.
3
+
4
+
This artifact is a Lean 4 mechanisation of the Package Calculus: a core calculus of dependency resolution, a family of extensions modelling features found in real-world package managers, a composition of two of those extensions, and the NP-completeness of dependency resolution (via a 3SAT reduction).
5
+
For a mapping of paper definitions and theorems see the ./paper-mapping.md file.
6
+
7
+
This is a proof-script artifact; there is no executable tool to run: the contribution is the machine-checked development itself.
8
+
9
+
## Requirements
10
+
11
+
- The Lean toolchain pinned in `lean-toolchain` (`leanprover/lean4:v4.28.0`).
12
+
This is installed automatically by [`elan`](https://github.com/leanprover/elan), and bundles the build tool `lake`.
13
+
- Mathlib, pinned to the revision in `lakefile.toml` and locked in `lake-manifest.json`.
14
+
15
+
The artifact has been tested on Linux.
16
+
The Lean toolchain also runs on macOS and Windows, so the build is expected to work there too.
17
+
These dependencies are pre-installed in the VM image.
18
+
19
+
## VM build
20
+
21
+
From the project root:
22
+
23
+
```sh
24
+
make build # build the whole development
25
+
make validate # build, then print the axioms behind every headline theorem
26
+
```
27
+
28
+
`make validate` executes scripts/axioms.lean to audit axioms.
29
+
A clean audit lists, for each headline theorem, only Lean's standard classical axioms -- `propext`, `Classical.choice`, and `Quot.sound`.
30
+
31
+
`make clean` drops only this development's `.olean`s, so `make build` recompiles just it against the cached Mathlib -- fast and offline.
32
+
33
+
## Source build
34
+
35
+
Install Lean via `elan` (its version manager) following the official instructions (<https://lean-lang.org/install/manual/>) with `curl https://elan.lean-lang.org/elan-init.sh -sSf | sh`, or via your operating system's package manager.
36
+
`elan` provides the `lake` build tool and installs the pinned toolchain automatically.
37
+
Then, from the project root:
38
+
39
+
```sh
40
+
make cache
41
+
make build
42
+
make validate
43
+
```
44
+
45
+
`make cache` fetches Mathlib's cached `.olean` files matching the pinned revision; without it, Mathlib is compiled from source, which can take a long time.
+95
lake-manifest.json
+95
lake-manifest.json
···
1
+
{"version": "1.1.0",
2
+
"packagesDir": ".lake/packages",
3
+
"packages":
4
+
[{"url": "https://github.com/leanprover-community/mathlib4",
5
+
"type": "git",
6
+
"subDir": null,
7
+
"scope": "leanprover-community",
8
+
"rev": "8f9d9cff6bd728b17a24e163c9402775d9e6a365",
9
+
"name": "mathlib",
10
+
"manifestFile": "lake-manifest.json",
11
+
"inputRev": "8f9d9cff6bd728b17a24e163c9402775d9e6a365",
12
+
"inherited": false,
13
+
"configFile": "lakefile.lean"},
14
+
{"url": "https://github.com/leanprover-community/plausible",
15
+
"type": "git",
16
+
"subDir": null,
17
+
"scope": "leanprover-community",
18
+
"rev": "55c8532eb21ec9f6d565d51d96b8ca50bd1fbef3",
19
+
"name": "plausible",
20
+
"manifestFile": "lake-manifest.json",
21
+
"inputRev": "main",
22
+
"inherited": true,
23
+
"configFile": "lakefile.toml"},
24
+
{"url": "https://github.com/leanprover-community/LeanSearchClient",
25
+
"type": "git",
26
+
"subDir": null,
27
+
"scope": "leanprover-community",
28
+
"rev": "c5d5b8fe6e5158def25cd28eb94e4141ad97c843",
29
+
"name": "LeanSearchClient",
30
+
"manifestFile": "lake-manifest.json",
31
+
"inputRev": "main",
32
+
"inherited": true,
33
+
"configFile": "lakefile.toml"},
34
+
{"url": "https://github.com/leanprover-community/import-graph",
35
+
"type": "git",
36
+
"subDir": null,
37
+
"scope": "leanprover-community",
38
+
"rev": "85b59af46828c029a9168f2f9c35119bd0721e6e",
39
+
"name": "importGraph",
40
+
"manifestFile": "lake-manifest.json",
41
+
"inputRev": "main",
42
+
"inherited": true,
43
+
"configFile": "lakefile.toml"},
44
+
{"url": "https://github.com/leanprover-community/ProofWidgets4",
45
+
"type": "git",
46
+
"subDir": null,
47
+
"scope": "leanprover-community",
48
+
"rev": "be3b2e63b1bbf496c478cef98b86972a37c1417d",
49
+
"name": "proofwidgets",
50
+
"manifestFile": "lake-manifest.json",
51
+
"inputRev": "v0.0.87",
52
+
"inherited": true,
53
+
"configFile": "lakefile.lean"},
54
+
{"url": "https://github.com/leanprover-community/aesop",
55
+
"type": "git",
56
+
"subDir": null,
57
+
"scope": "leanprover-community",
58
+
"rev": "f642a64c76df8ba9cb53dba3b919425a0c2aeaf1",
59
+
"name": "aesop",
60
+
"manifestFile": "lake-manifest.json",
61
+
"inputRev": "master",
62
+
"inherited": true,
63
+
"configFile": "lakefile.toml"},
64
+
{"url": "https://github.com/leanprover-community/quote4",
65
+
"type": "git",
66
+
"subDir": null,
67
+
"scope": "leanprover-community",
68
+
"rev": "b8f98e9087e02c8553945a2c5abf07cec8e798c3",
69
+
"name": "Qq",
70
+
"manifestFile": "lake-manifest.json",
71
+
"inputRev": "master",
72
+
"inherited": true,
73
+
"configFile": "lakefile.toml"},
74
+
{"url": "https://github.com/leanprover-community/batteries",
75
+
"type": "git",
76
+
"subDir": null,
77
+
"scope": "leanprover-community",
78
+
"rev": "495c008c3e3f4fb4256ff5582ddb3abf3198026f",
79
+
"name": "batteries",
80
+
"manifestFile": "lake-manifest.json",
81
+
"inputRev": "main",
82
+
"inherited": true,
83
+
"configFile": "lakefile.toml"},
84
+
{"url": "https://github.com/leanprover/lean4-cli",
85
+
"type": "git",
86
+
"subDir": null,
87
+
"scope": "leanprover",
88
+
"rev": "4f10f47646cb7d5748d6f423f4a07f98f7bbcc9e",
89
+
"name": "Cli",
90
+
"manifestFile": "lake-manifest.json",
91
+
"inputRev": "v4.28.0",
92
+
"inherited": true,
93
+
"configFile": "lakefile.toml"}],
94
+
"name": "PackageCalculus",
95
+
"lakeDir": ".lake"}
+10
lakefile.toml
+10
lakefile.toml
+1
lean-toolchain
+1
lean-toolchain
···
1
+
leanprover/lean4:v4.28.0
+15
makefile
+15
makefile
···
1
+
.PHONY: all build validate clean cache
2
+
3
+
all: build
4
+
5
+
cache:
6
+
lake exe cache get
7
+
8
+
build:
9
+
lake build PackageCalculus
10
+
11
+
validate: build
12
+
lake env lean scripts/axioms.lean
13
+
14
+
clean:
15
+
rm -rf .lake/build/lib/lean/PackageCalculus .lake/build/lib/lean/PackageCalculus.olean
+141
paper-mapping.md
+141
paper-mapping.md
···
1
+
These tables map each definition and theorem in the paper to its mechanised counterpart in this development.
2
+
All file paths are relative to the `PackageCalculus/` source directory.
3
+
4
+
Where the paper writes structured names like `⟨n, vs⟩ ∈ N` or `⟨n, f⟩`, the Lean uses dedicated inductive name/version types and `Has*Names` / `Has*Versions` typeclasses to inject them.
5
+
6
+
The paper states three standing conditions on every dependency relation (Def 3.1.2: Referents Exist, Functional in Name, Non-Empty).
7
+
In Lean these appear as explicit hypotheses on the theorems that consume them.
8
+
9
+
## 3. Modelling the Core
10
+
11
+
| Paper | Lean | File |
12
+
| -------------------------------------------- | ------------------------------------------------------ | ----------------------------------------|
13
+
| Def 3.1.1 Package | `Real`, `Package` | `Core/Definition.lean` |
14
+
| Def 3.1.2 Dependency | `DepRel` | `Core/Definition.lean` |
15
+
| Def 3.1.3 Resolution | `IsResolution` | `Core/Definition.lean` |
16
+
| Thm 3.1.4 `DependencyResolution` NP-complete | see Appendix A below (`satRed_*`) | `Complexity/` |
17
+
| Def 3.2.1 Version Ordering | the `[LT V]` / `[DecidableRel (· < ·)]` order on `V` | used throughout `Versions/Formula.lean` |
18
+
| Def 3.2.2 Version Formula | `VersionFormula`, `VersionFormula.eval` (`CmpOp.eval`) | `Versions/Formula.lean` |
19
+
| Def 3.2.3 Version Formula Dependency | `VFDepRel` | `Versions/Formula.lean` |
20
+
| Def 3.2.4 Version Formula Resolution | `IsVFResolution` | `Versions/Formula.lean` |
21
+
| Def 3.2.5 Version Formula Reduction | `vfReduce` | `Versions/Reduction/Definition.lean` |
22
+
| Thm 3.2.6 Correctness | `vfReduction_correct` | `Versions/Reduction/Correctness.lean` |
23
+
24
+
## 4. Extending the Calculus
25
+
26
+
### 4.1 Conflicts
27
+
28
+
| Paper | Lean | File |
29
+
| ----------------------------- | ------------------------------- | ------------------------------------------------- |
30
+
| Def 4.1.1 Conflict | `ConflictRel` | `Extensions/Conflict/Definition.lean` |
31
+
| Def 4.1.2 Conflict Resolution | `IsConflictResolution` | `Extensions/Conflict/Definition.lean` |
32
+
| Def 4.1.3 Conflict Reduction | `conflictReal` / `conflictDeps` | `Extensions/Conflict/Reduction/Definition.lean` |
33
+
| Thm 4.1.4 Soundness | `conflict_soundness` | `Extensions/Conflict/Reduction/Soundness.lean` |
34
+
| Thm 4.1.5 Completeness | `conflict_completeness` | `Extensions/Conflict/Reduction/Completeness.lean` |
35
+
36
+
### 4.2 Concurrent Versions
37
+
38
+
| Paper | Lean | File |
39
+
| ------------------------------- | ----------------------------------- | --------------------------------------------------- |
40
+
| Def 4.2.1 Granularity Function | `g : V → G` (parameter) | `Extensions/Concurrent/Definition.lean` |
41
+
| Def 4.2.2 Concurrent Resolution | `IsConcurrentResolution` | `Extensions/Concurrent/Definition.lean` |
42
+
| Def 4.2.3 Concurrent Reduction | `concurrentReal` / `concurrentDeps` | `Extensions/Concurrent/Reduction/Definition.lean` |
43
+
| Thm 4.2.4 Soundness | `concurrent_soundness` | `Extensions/Concurrent/Reduction/Soundness.lean` |
44
+
| Thm 4.2.5 Completeness | `concurrent_completeness` | `Extensions/Concurrent/Reduction/Completeness.lean` |
45
+
46
+
### 4.3 Peer Dependencies
47
+
48
+
| Paper | Lean | File |
49
+
| ------------------------------------ | ----------------------- | ------------------------------------------------------- |
50
+
| Def 4.3.1 Peer Dependency | `PeerRel` | `Extensions/PeerDependency/Definition.lean` |
51
+
| Def 4.3.2 Peer Dependency Resolution | `IsPeerResolution` | `Extensions/PeerDependency/Definition.lean` |
52
+
| Def 4.3.3 Peer Dependency Reduction | `peerReal` / `peerDeps` | `Extensions/PeerDependency/Reduction/Definition.lean` |
53
+
| Thm 4.3.4 Soundness | `peer_soundness` | `Extensions/PeerDependency/Reduction/Soundness.lean` |
54
+
| Thm 4.3.5 Completeness | `peer_completeness` | `Extensions/PeerDependency/Reduction/Completeness.lean` |
55
+
56
+
### 4.4 Features
57
+
58
+
| Paper | Lean | File |
59
+
| ---------------------------- | ----------------------------- | ------------------------------------------------ |
60
+
| Def 4.4.1 Feature | `Support` | `Extensions/Feature/Definition.lean` |
61
+
| Def 4.4.2 Feature Dependency | `FeatDepRel`, `AddlDepRel` | `Extensions/Feature/Definition.lean` |
62
+
| Def 4.4.3 Feature Resolution | `IsFeatureResolution` | `Extensions/Feature/Definition.lean` |
63
+
| Def 4.4.4 Feature Reduction | `featureReal` / `featureDeps` | `Extensions/Feature/Reduction/Definition.lean` |
64
+
| Thm 4.4.5 Soundness | `feature_soundness` | `Extensions/Feature/Reduction/Soundness.lean` |
65
+
| Thm 4.4.6 Completeness | `feature_completeness` | `Extensions/Feature/Reduction/Completeness.lean` |
66
+
67
+
### 4.5 Package Formulae
68
+
69
+
| Paper | Lean | File |
70
+
| ------------------------------------ | ------------------------------------------------ | ------------------------------------------------------- |
71
+
| Def 4.5.1 Package Formula | `Formula` (in namespace `PkgFormula`) | `Extensions/PackageFormula/Definition.lean` |
72
+
| Def 4.5.2 Package Formula Dependency | `PFDepRel` | `Extensions/PackageFormula/Definition.lean` |
73
+
| Def 4.5.3 Package Formula Resolution | `IsPFResolution` | `Extensions/PackageFormula/Definition.lean` |
74
+
| Def 4.5.4 Package Formula Reduction | `pfReal` / `pfDeps` (via `encode` / `encodeNNF`) | `Extensions/PackageFormula/Reduction/Definition.lean` |
75
+
| Thm 4.5.5 Soundness | `pkgFormula_soundness` | `Extensions/PackageFormula/Reduction/Soundness.lean` |
76
+
| Thm 4.5.6 Completeness | `pkgFormula_completeness` | `Extensions/PackageFormula/Reduction/Completeness.lean` |
77
+
78
+
### 4.6 Variable Formulae
79
+
80
+
| Paper | Lean | File |
81
+
| ------------------------------------- | ----------------------------------------------------------------------- | -------------------------------------------------------- |
82
+
| Def 4.6.1 Variable Formula | `Formula N V X Y` (in namespace `VarFormula`), dep. relation `VFDepRel` | `Extensions/VariableFormula/Definition.lean` |
83
+
| Def 4.6.2 Variable Formula Resolution | `IsVFResolution` | `Extensions/VariableFormula/Definition.lean` |
84
+
| Def 4.6.3 Variable Formula Reduction | `vfReal` / `vfDeps` | `Extensions/VariableFormula/Reduction/Definition.lean` |
85
+
| Thm 4.6.4 Soundness | `varFormula_soundness` | `Extensions/VariableFormula/Reduction/Soundness.lean` |
86
+
| Thm 4.6.5 Completeness | `varFormula_completeness` | `Extensions/VariableFormula/Reduction/Completeness.lean` |
87
+
88
+
### 4.7 Virtual Packages
89
+
90
+
| Paper | Lean | File |
91
+
| ------------------------------------ | ----------------------------- | ------------------------------------------------ |
92
+
| Def 4.7.1 Virtual Package Provides | `ProvidesRel` | `Extensions/Virtual/Definition.lean` |
93
+
| Def 4.7.2 Virtual Package Resolution | `IsVirtualResolution` | `Extensions/Virtual/Definition.lean` |
94
+
| Def 4.7.3 Virtual Package Reduction | `virtualReal` / `virtualDeps` | `Extensions/Virtual/Reduction/Definition.lean` |
95
+
| Thm 4.7.4 Soundness | `virtual_soundness` | `Extensions/Virtual/Reduction/Soundness.lean` |
96
+
| Thm 4.7.5 Completeness | `virtual_completeness` | `Extensions/Virtual/Reduction/Completeness.lean` |
97
+
98
+
### 4.8 Singular Dependencies
99
+
100
+
| Paper | Lean | File |
101
+
| ---------------------------------------- | ----------------------------------------------------------------------- | -------------------------- |
102
+
| Def 4.8.1 Singular Dependency | `SingularRel` | `Extensions/Singular.lean` |
103
+
| Def 4.8.2 Singular Dependency Resolution | `IsSingularResolution` (reduction `singularToCore`, `singular_is_core`) | `Extensions/Singular.lean` |
104
+
105
+
## 5. Interoperating Across Ecosystems
106
+
107
+
### 5.1 Composition of Extensions
108
+
109
+
| Paper | Lean | File |
110
+
| --------------------------------------- | ------------------------------------------------- | ----------------------------------------------------------- |
111
+
| Def 5.1.1 Concurrent Feature Resolution | `IsConcurrentFeatureResolution` | `Composition/FeatureConcurrent/Definition.lean` |
112
+
| Def 5.1.2 Concurrent Feature Reduction | `concurrentFeatureReal` / `concurrentFeatureDeps` | `Composition/FeatureConcurrent/Reduction/Definition.lean` |
113
+
| Thm 5.1.3 Soundness | `concurrent_feature_soundness` | `Composition/FeatureConcurrent/Reduction/Soundness.lean` |
114
+
| Thm 5.1.4 Completeness | `concurrent_feature_completeness` | `Composition/FeatureConcurrent/Reduction/Completeness.lean` |
115
+
116
+
### 5.2 Transpiling
117
+
118
+
The per-extension retraction `lift ∘ reduce = id` claimed in §5.2 is mechanised in each extension's `Lifting/` subdirectory.
119
+
`Lifting/Definition.lean` defines `lift`, `Lifting/Retraction.lean` proves the retraction, and `Lifting/{Soundness,Completeness}.lean` show `lift` carries core resolutions back to extension resolutions.
120
+
These live under `Extensions/<Extension>/Lifting/` and `Versions/Lifting/`.
121
+
122
+
## Appendix A -- `DependencyResolution` complexity
123
+
124
+
The paper's NP-completeness result (Thm 3.1.4) is witnessed by a polynomial-time reduction from 3SAT.
125
+
Membership in NP corresponds to the SAT encoding in Appendix B.
126
+
In Lean we mechanise the reduction's soundness and completeness (below); the polynomial-time bound and NP-membership are established by inspection, not formalised.
127
+
128
+
| Paper | Lean | File |
129
+
| --------------------------- | --------------------------- | ---------------------------- |
130
+
| 3SAT instance / clause | `ThreeClause`, `Literal` | `Complexity/ThreeSAT.lean` |
131
+
| 3SAT → resolution reduction | `satRedReal` / `satRedDeps` | `Complexity/NPHardness.lean` |
132
+
| Reduction soundness | `satRed_soundness` | `Complexity/NPHardness.lean` |
133
+
| Reduction completeness | `satRed_completeness` | `Complexity/NPHardness.lean` |
134
+
135
+
## Appendix B -- SAT-based resolution
136
+
137
+
| Paper | Lean | File |
138
+
| ----------------------------------------- | -------------------------- | ----------------------------- |
139
+
| Def B.1 Package Calculus Reduction to SAT | `satisfiesEncoding` | `Complexity/SATEncoding.lean` |
140
+
| Thm B.2 Soundness | `satEncoding_soundness` | `Complexity/SATEncoding.lean` |
141
+
| Thm B.3 Completeness | `satEncoding_completeness` | `Complexity/SATEncoding.lean` |
+33
scripts/axioms.lean
+33
scripts/axioms.lean
···
1
+
import PackageCalculus
2
+
3
+
#print axioms PackageCalculus.vfReduction_correct
4
+
5
+
#print axioms PackageCalculus.Conflict.conflict_soundness
6
+
#print axioms PackageCalculus.Conflict.conflict_completeness
7
+
8
+
#print axioms PackageCalculus.Concurrent.concurrent_soundness
9
+
#print axioms PackageCalculus.Concurrent.concurrent_completeness
10
+
11
+
#print axioms PackageCalculus.PeerDep.peer_soundness
12
+
#print axioms PackageCalculus.PeerDep.peer_completeness
13
+
14
+
#print axioms PackageCalculus.Feature.feature_soundness
15
+
#print axioms PackageCalculus.Feature.feature_completeness
16
+
17
+
#print axioms PackageCalculus.PkgFormula.pkgFormula_soundness
18
+
#print axioms PackageCalculus.PkgFormula.pkgFormula_completeness
19
+
20
+
#print axioms PackageCalculus.VarFormula.varFormula_soundness
21
+
#print axioms PackageCalculus.VarFormula.varFormula_completeness
22
+
23
+
#print axioms PackageCalculus.Virtual.virtual_soundness
24
+
#print axioms PackageCalculus.Virtual.virtual_completeness
25
+
26
+
#print axioms PackageCalculus.Composition.concurrent_feature_soundness
27
+
#print axioms PackageCalculus.Composition.concurrent_feature_completeness
28
+
29
+
#print axioms PackageCalculus.Complexity.satRed_soundness
30
+
#print axioms PackageCalculus.Complexity.satRed_completeness
31
+
32
+
#print axioms PackageCalculus.Complexity.satEncoding_soundness
33
+
#print axioms PackageCalculus.Complexity.satEncoding_completeness