lean4-htt/src/Init/Data/Nat/Linear.lean
2024-07-29 08:58:49 +10:00

721 lines
29 KiB
Text
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

/-
Copyright (c) 2022 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import Init.ByCases
import Init.Data.Prod
namespace Nat.Linear
/-!
Helper definitions and theorems for constructing linear arithmetic proofs.
-/
abbrev Var := Nat
abbrev Context := List Nat
/--
When encoding polynomials. We use `fixedVar` for encoding numerals.
The denotation of `fixedVar` is always `1`. -/
def fixedVar := 100000000 -- Any big number should work here
def Var.denote (ctx : Context) (v : Var) : Nat :=
bif v == fixedVar then 1 else go ctx v
where
go : List Nat → Nat → Nat
| [], _ => 0
| a::_, 0 => a
| _::as, i+1 => go as i
inductive Expr where
| num (v : Nat)
| var (i : Var)
| add (a b : Expr)
| mulL (k : Nat) (a : Expr)
| mulR (a : Expr) (k : Nat)
deriving Inhabited
def Expr.denote (ctx : Context) : Expr → Nat
| Expr.add a b => Nat.add (denote ctx a) (denote ctx b)
| Expr.num k => k
| Expr.var v => v.denote ctx
| Expr.mulL k e => Nat.mul k (denote ctx e)
| Expr.mulR e k => Nat.mul (denote ctx e) k
abbrev Poly := List (Nat × Var)
def Poly.denote (ctx : Context) (p : Poly) : Nat :=
match p with
| [] => 0
| (k, v) :: p => Nat.add (Nat.mul k (v.denote ctx)) (denote ctx p)
def Poly.insertSorted (k : Nat) (v : Var) (p : Poly) : Poly :=
match p with
| [] => [(k, v)]
| (k', v') :: p => bif Nat.blt v v' then (k, v) :: (k', v') :: p else (k', v') :: insertSorted k v p
def Poly.sort (p : Poly) : Poly :=
let rec go (p : Poly) (r : Poly) : Poly :=
match p with
| [] => r
| (k, v) :: p => go p (r.insertSorted k v)
go p []
def Poly.fuse (p : Poly) : Poly :=
match p with
| [] => []
| (k, v) :: p =>
match fuse p with
| [] => [(k, v)]
| (k', v') :: p' => bif v == v' then (Nat.add k k', v)::p' else (k, v) :: (k', v') :: p'
def Poly.mul (k : Nat) (p : Poly) : Poly :=
bif k == 0 then
[]
else bif k == 1 then
p
else
go p
where
go : Poly → Poly
| [] => []
| (k', v) :: p => (Nat.mul k k', v) :: go p
def Poly.cancelAux (fuel : Nat) (m₁ m₂ r₁ r₂ : Poly) : Poly × Poly :=
match fuel with
| 0 => (r₁.reverse ++ m₁, r₂.reverse ++ m₂)
| fuel + 1 =>
match m₁, m₂ with
| m₁, [] => (r₁.reverse ++ m₁, r₂.reverse)
| [], m₂ => (r₁.reverse, r₂.reverse ++ m₂)
| (k₁, v₁) :: m₁, (k₂, v₂) :: m₂ =>
bif Nat.blt v₁ v₂ then
cancelAux fuel m₁ ((k₂, v₂) :: m₂) ((k₁, v₁) :: r₁) r₂
else bif Nat.blt v₂ v₁ then
cancelAux fuel ((k₁, v₁) :: m₁) m₂ r₁ ((k₂, v₂) :: r₂)
else bif Nat.blt k₁ k₂ then
cancelAux fuel m₁ m₂ r₁ ((Nat.sub k₂ k₁, v₁) :: r₂)
else bif Nat.blt k₂ k₁ then
cancelAux fuel m₁ m₂ ((Nat.sub k₁ k₂, v₁) :: r₁) r₂
else
cancelAux fuel m₁ m₂ r₁ r₂
def hugeFuel := 1000000 -- any big number should work
def Poly.cancel (p₁ p₂ : Poly) : Poly × Poly :=
cancelAux hugeFuel p₁ p₂ [] []
def Poly.isNum? (p : Poly) : Option Nat :=
match p with
| [] => some 0
| [(k, v)] => bif v == fixedVar then some k else none
| _ => none
def Poly.isZero (p : Poly) : Bool :=
match p with
| [] => true
| _ => false
def Poly.isNonZero (p : Poly) : Bool :=
match p with
| [] => false
| (k, v) :: p => bif v == fixedVar then k > 0 else isNonZero p
def Poly.denote_eq (ctx : Context) (mp : Poly × Poly) : Prop := mp.1.denote ctx = mp.2.denote ctx
def Poly.denote_le (ctx : Context) (mp : Poly × Poly) : Prop := mp.1.denote ctx ≤ mp.2.denote ctx
def Poly.combineAux (fuel : Nat) (p₁ p₂ : Poly) : Poly :=
match fuel with
| 0 => p₁ ++ p₂
| fuel + 1 =>
match p₁, p₂ with
| p₁, [] => p₁
| [], p₂ => p₂
| (k₁, v₁) :: p₁, (k₂, v₂) :: p₂ =>
bif Nat.blt v₁ v₂ then
(k₁, v₁) :: combineAux fuel p₁ ((k₂, v₂) :: p₂)
else bif Nat.blt v₂ v₁ then
(k₂, v₂) :: combineAux fuel ((k₁, v₁) :: p₁) p₂
else
(Nat.add k₁ k₂, v₁) :: combineAux fuel p₁ p₂
def Poly.combine (p₁ p₂ : Poly) : Poly :=
combineAux hugeFuel p₁ p₂
def Expr.toPoly : Expr → Poly
| Expr.num k => bif k == 0 then [] else [ (k, fixedVar) ]
| Expr.var i => [(1, i)]
| Expr.add a b => a.toPoly ++ b.toPoly
| Expr.mulL k a => a.toPoly.mul k
| Expr.mulR a k => a.toPoly.mul k
def Poly.norm (p : Poly) : Poly :=
p.sort.fuse
def Expr.toNormPoly (e : Expr) : Poly :=
e.toPoly.norm
def Expr.inc (e : Expr) : Expr :=
Expr.add e (Expr.num 1)
structure PolyCnstr where
eq : Bool
lhs : Poly
rhs : Poly
deriving BEq
-- TODO: implement LawfulBEq generator companion for BEq
instance : LawfulBEq PolyCnstr where
eq_of_beq {a b} h := by
cases a; rename_i eq₁ lhs₁ rhs₁
cases b; rename_i eq₂ lhs₂ rhs₂
have h : eq₁ == eq₂ && (lhs₁ == lhs₂ && rhs₁ == rhs₂) := h
simp at h
have ⟨h₁, h₂, h₃⟩ := h
rw [h₁, h₂, h₃]
rfl {a} := by
cases a; rename_i eq lhs rhs
show (eq == eq && (lhs == lhs && rhs == rhs)) = true
simp [LawfulBEq.rfl]
def PolyCnstr.mul (k : Nat) (c : PolyCnstr) : PolyCnstr :=
{ c with lhs := c.lhs.mul k, rhs := c.rhs.mul k }
def PolyCnstr.combine (c₁ c₂ : PolyCnstr) : PolyCnstr :=
let (lhs, rhs) := Poly.cancel (c₁.lhs.combine c₂.lhs) (c₁.rhs.combine c₂.rhs)
{ eq := c₁.eq && c₂.eq, lhs, rhs }
structure ExprCnstr where
eq : Bool
lhs : Expr
rhs : Expr
def PolyCnstr.denote (ctx : Context) (c : PolyCnstr) : Prop :=
bif c.eq then
Poly.denote_eq ctx (c.lhs, c.rhs)
else
Poly.denote_le ctx (c.lhs, c.rhs)
def PolyCnstr.norm (c : PolyCnstr) : PolyCnstr :=
let (lhs, rhs) := Poly.cancel c.lhs.sort.fuse c.rhs.sort.fuse
{ eq := c.eq, lhs, rhs }
def PolyCnstr.isUnsat (c : PolyCnstr) : Bool :=
bif c.eq then
(c.lhs.isZero && c.rhs.isNonZero) || (c.lhs.isNonZero && c.rhs.isZero)
else
c.lhs.isNonZero && c.rhs.isZero
def PolyCnstr.isValid (c : PolyCnstr) : Bool :=
bif c.eq then
c.lhs.isZero && c.rhs.isZero
else
c.lhs.isZero
def ExprCnstr.denote (ctx : Context) (c : ExprCnstr) : Prop :=
bif c.eq then
c.lhs.denote ctx = c.rhs.denote ctx
else
c.lhs.denote ctx ≤ c.rhs.denote ctx
def ExprCnstr.toPoly (c : ExprCnstr) : PolyCnstr :=
{ c with lhs := c.lhs.toPoly, rhs := c.rhs.toPoly }
def ExprCnstr.toNormPoly (c : ExprCnstr) : PolyCnstr :=
let (lhs, rhs) := Poly.cancel c.lhs.toNormPoly c.rhs.toNormPoly
{ c with lhs, rhs }
abbrev Certificate := List (Nat × ExprCnstr)
def Certificate.combineHyps (c : PolyCnstr) (hs : Certificate) : PolyCnstr :=
match hs with
| [] => c
| (k, c') :: hs => combineHyps (PolyCnstr.combine c (c'.toNormPoly.mul (Nat.add k 1))) hs
def Certificate.combine (hs : Certificate) : PolyCnstr :=
match hs with
| [] => { eq := true, lhs := [], rhs := [] }
| (k, c) :: hs => combineHyps (c.toNormPoly.mul (Nat.add k 1)) hs
def Certificate.denote (ctx : Context) (c : Certificate) : Prop :=
match c with
| [] => False
| (_, c)::hs => c.denote ctx → denote ctx hs
def monomialToExpr (k : Nat) (v : Var) : Expr :=
bif v == fixedVar then
Expr.num k
else bif k == 1 then
Expr.var v
else
Expr.mulL k (Expr.var v)
def Poly.toExpr (p : Poly) : Expr :=
match p with
| [] => Expr.num 0
| (k, v) :: p => go (monomialToExpr k v) p
where
go (e : Expr) (p : Poly) : Expr :=
match p with
| [] => e
| (k, v) :: p => go (Expr.add e (monomialToExpr k v)) p
def PolyCnstr.toExpr (c : PolyCnstr) : ExprCnstr :=
{ c with lhs := c.lhs.toExpr, rhs := c.rhs.toExpr }
attribute [local simp] Nat.add_comm Nat.add_assoc Nat.add_left_comm Nat.right_distrib Nat.left_distrib Nat.mul_assoc Nat.mul_comm
attribute [local simp] Poly.denote Expr.denote Poly.insertSorted Poly.sort Poly.sort.go Poly.fuse Poly.cancelAux
attribute [local simp] Poly.mul Poly.mul.go
theorem Poly.denote_insertSorted (ctx : Context) (k : Nat) (v : Var) (p : Poly) : (p.insertSorted k v).denote ctx = p.denote ctx + k * v.denote ctx := by
match p with
| [] => simp
| (k', v') :: p => by_cases h : Nat.blt v v' <;> simp [h, denote_insertSorted]
attribute [local simp] Poly.denote_insertSorted
theorem Poly.denote_sort_go (ctx : Context) (p : Poly) (r : Poly) : (sort.go p r).denote ctx = p.denote ctx + r.denote ctx := by
match p with
| [] => simp
| (k, v):: p => simp [denote_sort_go]
attribute [local simp] Poly.denote_sort_go
theorem Poly.denote_sort (ctx : Context) (m : Poly) : m.sort.denote ctx = m.denote ctx := by
simp
attribute [local simp] Poly.denote_sort
theorem Poly.denote_append (ctx : Context) (p q : Poly) : (p ++ q).denote ctx = p.denote ctx + q.denote ctx := by
match p with
| [] => simp
| (k, v) :: p => simp [denote_append]
attribute [local simp] Poly.denote_append
theorem Poly.denote_cons (ctx : Context) (k : Nat) (v : Var) (p : Poly) : denote ctx ((k, v) :: p) = k * v.denote ctx + p.denote ctx := by
match p with
| [] => simp
| _ :: m => simp [denote_cons]
attribute [local simp] Poly.denote_cons
theorem Poly.denote_reverseAux (ctx : Context) (p q : Poly) : denote ctx (List.reverseAux p q) = denote ctx (p ++ q) := by
match p with
| [] => simp [List.reverseAux]
| (k, v) :: p => simp [List.reverseAux, denote_reverseAux]
attribute [local simp] Poly.denote_reverseAux
theorem Poly.denote_reverse (ctx : Context) (p : Poly) : denote ctx (List.reverse p) = denote ctx p := by
simp [List.reverse]
attribute [local simp] Poly.denote_reverse
theorem Poly.denote_fuse (ctx : Context) (p : Poly) : p.fuse.denote ctx = p.denote ctx := by
match p with
| [] => rfl
| (k, v) :: p =>
have ih := denote_fuse ctx p
simp
split
case _ h => simp [← ih, h]
case _ k' v' p' h => by_cases he : v == v' <;> simp [he, ← ih, h]; rw [eq_of_beq he]
attribute [local simp] Poly.denote_fuse
theorem Poly.denote_mul (ctx : Context) (k : Nat) (p : Poly) : (p.mul k).denote ctx = k * p.denote ctx := by
simp
by_cases h : k == 0 <;> simp [h]; simp [eq_of_beq h]
by_cases h : k == 1 <;> simp [h]; simp [eq_of_beq h]
induction p with
| nil => simp
| cons kv m ih => cases kv with | _ k' v => simp [ih]
private theorem eq_of_not_blt_eq_true (h₁ : ¬ (Nat.blt x y = true)) (h₂ : ¬ (Nat.blt y x = true)) : x = y :=
have h₁ : ¬ x < y := fun h => h₁ (Nat.blt_eq.mpr h)
have h₂ : ¬ y < x := fun h => h₂ (Nat.blt_eq.mpr h)
Nat.le_antisymm (Nat.ge_of_not_lt h₂) (Nat.ge_of_not_lt h₁)
attribute [local simp] Poly.denote_mul
theorem Poly.denote_eq_cancelAux (ctx : Context) (fuel : Nat) (m₁ m₂ r₁ r₂ : Poly)
(h : denote_eq ctx (r₁.reverse ++ m₁, r₂.reverse ++ m₂)) : denote_eq ctx (cancelAux fuel m₁ m₂ r₁ r₂) := by
induction fuel generalizing m₁ m₂ r₁ r₂ with
| zero => assumption
| succ fuel ih =>
simp
split <;> try (simp at h; try assumption)
rename_i k₁ v₁ m₁ k₂ v₂ m₂
by_cases hltv : Nat.blt v₁ v₂ <;> simp [hltv]
· apply ih; simp [denote_eq] at h |-; assumption
· by_cases hgtv : Nat.blt v₂ v₁ <;> simp [hgtv]
· apply ih; simp [denote_eq] at h |-; assumption
· have heqv : v₁ = v₂ := eq_of_not_blt_eq_true hltv hgtv; subst heqv
by_cases hltk : Nat.blt k₁ k₂ <;> simp [hltk]
· apply ih
simp [denote_eq] at h |-
have haux : k₁ * Var.denote ctx v₁ ≤ k₂ * Var.denote ctx v₁ := Nat.mul_le_mul_right _ (Nat.le_of_lt (Nat.blt_eq.mp hltk))
rw [Nat.mul_sub_right_distrib, ← Nat.add_assoc, ← Nat.add_sub_assoc haux]
apply Eq.symm
apply Nat.sub_eq_of_eq_add
simp [h]
· by_cases hgtk : Nat.blt k₂ k₁ <;> simp [hgtk]
· apply ih
simp [denote_eq] at h |-
have haux : k₂ * Var.denote ctx v₁ ≤ k₁ * Var.denote ctx v₁ := Nat.mul_le_mul_right _ (Nat.le_of_lt (Nat.blt_eq.mp hgtk))
rw [Nat.mul_sub_right_distrib, ← Nat.add_assoc, ← Nat.add_sub_assoc haux]
apply Nat.sub_eq_of_eq_add
simp [h]
· have heqk : k₁ = k₂ := eq_of_not_blt_eq_true hltk hgtk; subst heqk
apply ih
simp [denote_eq] at h |-
rw [← Nat.add_assoc, ← Nat.add_assoc] at h
exact Nat.add_right_cancel h
theorem Poly.of_denote_eq_cancelAux (ctx : Context) (fuel : Nat) (m₁ m₂ r₁ r₂ : Poly)
(h : denote_eq ctx (cancelAux fuel m₁ m₂ r₁ r₂)) : denote_eq ctx (r₁.reverse ++ m₁, r₂.reverse ++ m₂) := by
induction fuel generalizing m₁ m₂ r₁ r₂ with
| zero => assumption
| succ fuel ih =>
simp at h
split at h <;> (try simp; assumption)
rename_i k₁ v₁ m₁ k₂ v₂ m₂
by_cases hltv : Nat.blt v₁ v₂ <;> simp [hltv] at h
· have ih := ih (h := h); simp [denote_eq] at ih ⊢; assumption
· by_cases hgtv : Nat.blt v₂ v₁ <;> simp [hgtv] at h
· have ih := ih (h := h); simp [denote_eq] at ih ⊢; assumption
· have heqv : v₁ = v₂ := eq_of_not_blt_eq_true hltv hgtv; subst heqv
by_cases hltk : Nat.blt k₁ k₂ <;> simp [hltk] at h
· have ih := ih (h := h); simp [denote_eq] at ih ⊢
have haux : k₁ * Var.denote ctx v₁ ≤ k₂ * Var.denote ctx v₁ := Nat.mul_le_mul_right _ (Nat.le_of_lt (Nat.blt_eq.mp hltk))
rw [Nat.mul_sub_right_distrib, ← Nat.add_assoc, ← Nat.add_sub_assoc haux] at ih
have ih := Nat.eq_add_of_sub_eq (Nat.le_trans haux (Nat.le_add_left ..)) ih.symm
simp at ih
rw [ih]
· by_cases hgtk : Nat.blt k₂ k₁ <;> simp [hgtk] at h
· have ih := ih (h := h); simp [denote_eq] at ih ⊢
have haux : k₂ * Var.denote ctx v₁ ≤ k₁ * Var.denote ctx v₁ := Nat.mul_le_mul_right _ (Nat.le_of_lt (Nat.blt_eq.mp hgtk))
rw [Nat.mul_sub_right_distrib, ← Nat.add_assoc, ← Nat.add_sub_assoc haux] at ih
have ih := Nat.eq_add_of_sub_eq (Nat.le_trans haux (Nat.le_add_left ..)) ih
simp at ih
rw [ih]
· have heqk : k₁ = k₂ := eq_of_not_blt_eq_true hltk hgtk; subst heqk
have ih := ih (h := h); simp [denote_eq] at ih ⊢
rw [← Nat.add_assoc, ih, Nat.add_assoc]
theorem Poly.denote_eq_cancel {ctx : Context} {m₁ m₂ : Poly} (h : denote_eq ctx (m₁, m₂)) : denote_eq ctx (cancel m₁ m₂) := by
apply denote_eq_cancelAux; simp [h]
theorem Poly.of_denote_eq_cancel {ctx : Context} {m₁ m₂ : Poly} (h : denote_eq ctx (cancel m₁ m₂)) : denote_eq ctx (m₁, m₂) := by
have := Poly.of_denote_eq_cancelAux (h := h)
simp at this
assumption
theorem Poly.denote_eq_cancel_eq (ctx : Context) (m₁ m₂ : Poly) : denote_eq ctx (cancel m₁ m₂) = denote_eq ctx (m₁, m₂) :=
propext <| Iff.intro (fun h => of_denote_eq_cancel h) (fun h => denote_eq_cancel h)
attribute [local simp] Poly.denote_eq_cancel_eq
theorem Poly.denote_le_cancelAux (ctx : Context) (fuel : Nat) (m₁ m₂ r₁ r₂ : Poly)
(h : denote_le ctx (r₁.reverse ++ m₁, r₂.reverse ++ m₂)) : denote_le ctx (cancelAux fuel m₁ m₂ r₁ r₂) := by
induction fuel generalizing m₁ m₂ r₁ r₂ with
| zero => assumption
| succ fuel ih =>
simp
split <;> try (simp at h; assumption)
rename_i k₁ v₁ m₁ k₂ v₂ m₂
by_cases hltv : Nat.blt v₁ v₂ <;> simp [hltv]
· apply ih; simp [denote_le] at h |-; assumption
· by_cases hgtv : Nat.blt v₂ v₁ <;> simp [hgtv]
· apply ih; simp [denote_le] at h |-; assumption
· have heqv : v₁ = v₂ := eq_of_not_blt_eq_true hltv hgtv; subst heqv
by_cases hltk : Nat.blt k₁ k₂ <;> simp [hltk]
· apply ih
simp [denote_le] at h |-
have haux : k₁ * Var.denote ctx v₁ ≤ k₂ * Var.denote ctx v₁ := Nat.mul_le_mul_right _ (Nat.le_of_lt (Nat.blt_eq.mp hltk))
rw [Nat.mul_sub_right_distrib, ← Nat.add_assoc, ← Nat.add_sub_assoc haux]
apply Nat.le_sub_of_add_le
simp [h]
· by_cases hgtk : Nat.blt k₂ k₁ <;> simp [hgtk]
· apply ih
simp [denote_le] at h |-
have haux : k₂ * Var.denote ctx v₁ ≤ k₁ * Var.denote ctx v₁ := Nat.mul_le_mul_right _ (Nat.le_of_lt (Nat.blt_eq.mp hgtk))
rw [Nat.mul_sub_right_distrib, ← Nat.add_assoc, ← Nat.add_sub_assoc haux]
apply Nat.sub_le_of_le_add
simp [h]
· have heqk : k₁ = k₂ := eq_of_not_blt_eq_true hltk hgtk; subst heqk
apply ih
simp [denote_le] at h |-
rw [← Nat.add_assoc, ← Nat.add_assoc] at h
apply Nat.le_of_add_le_add_right h
done
theorem Poly.of_denote_le_cancelAux (ctx : Context) (fuel : Nat) (m₁ m₂ r₁ r₂ : Poly)
(h : denote_le ctx (cancelAux fuel m₁ m₂ r₁ r₂)) : denote_le ctx (r₁.reverse ++ m₁, r₂.reverse ++ m₂) := by
induction fuel generalizing m₁ m₂ r₁ r₂ with
| zero => assumption
| succ fuel ih =>
simp at h
split at h <;> try (simp; assumption)
rename_i k₁ v₁ m₁ k₂ v₂ m₂
by_cases hltv : Nat.blt v₁ v₂ <;> simp [hltv] at h
· have ih := ih (h := h); simp [denote_le] at ih ⊢; assumption
· by_cases hgtv : Nat.blt v₂ v₁ <;> simp [hgtv] at h
· have ih := ih (h := h); simp [denote_le] at ih ⊢; assumption
· have heqv : v₁ = v₂ := eq_of_not_blt_eq_true hltv hgtv; subst heqv
by_cases hltk : Nat.blt k₁ k₂ <;> simp [hltk] at h
· have ih := ih (h := h); simp [denote_le] at ih ⊢
have haux : k₁ * Var.denote ctx v₁ ≤ k₂ * Var.denote ctx v₁ := Nat.mul_le_mul_right _ (Nat.le_of_lt (Nat.blt_eq.mp hltk))
rw [Nat.mul_sub_right_distrib, ← Nat.add_assoc, ← Nat.add_sub_assoc haux] at ih
have := Nat.add_le_of_le_sub (Nat.le_trans haux (Nat.le_add_left ..)) ih
simp at this
exact this
· by_cases hgtk : Nat.blt k₂ k₁ <;> simp [hgtk] at h
· have ih := ih (h := h); simp [denote_le] at ih ⊢
have haux : k₂ * Var.denote ctx v₁ ≤ k₁ * Var.denote ctx v₁ := Nat.mul_le_mul_right _ (Nat.le_of_lt (Nat.blt_eq.mp hgtk))
rw [Nat.mul_sub_right_distrib, ← Nat.add_assoc, ← Nat.add_sub_assoc haux] at ih
have := Nat.le_add_of_sub_le ih
simp at this
exact this
· have heqk : k₁ = k₂ := eq_of_not_blt_eq_true hltk hgtk; subst heqk
have ih := ih (h := h); simp [denote_le] at ih ⊢
have := Nat.add_le_add_right ih (k₁ * Var.denote ctx v₁)
simp at this
exact this
theorem Poly.denote_le_cancel {ctx : Context} {m₁ m₂ : Poly} (h : denote_le ctx (m₁, m₂)) : denote_le ctx (cancel m₁ m₂) := by
apply denote_le_cancelAux; simp [h]
theorem Poly.of_denote_le_cancel {ctx : Context} {m₁ m₂ : Poly} (h : denote_le ctx (cancel m₁ m₂)) : denote_le ctx (m₁, m₂) := by
have := Poly.of_denote_le_cancelAux (h := h)
simp at this
assumption
theorem Poly.denote_le_cancel_eq (ctx : Context) (m₁ m₂ : Poly) : denote_le ctx (cancel m₁ m₂) = denote_le ctx (m₁, m₂) :=
propext <| Iff.intro (fun h => of_denote_le_cancel h) (fun h => denote_le_cancel h)
attribute [local simp] Poly.denote_le_cancel_eq
theorem Poly.denote_combineAux (ctx : Context) (fuel : Nat) (p₁ p₂ : Poly) : (p₁.combineAux fuel p₂).denote ctx = p₁.denote ctx + p₂.denote ctx := by
induction fuel generalizing p₁ p₂ with simp [combineAux]
| succ fuel ih =>
split <;> simp
rename_i k₁ v₁ p₁ k₂ v₂ p₂
by_cases hltv : Nat.blt v₁ v₂ <;> simp [hltv, ih]
by_cases hgtv : Nat.blt v₂ v₁ <;> simp [hgtv, ih]
have heqv : v₁ = v₂ := eq_of_not_blt_eq_true hltv hgtv
simp [heqv]
theorem Poly.denote_combine (ctx : Context) (p₁ p₂ : Poly) : (p₁.combine p₂).denote ctx = p₁.denote ctx + p₂.denote ctx := by
simp [combine, denote_combineAux]
attribute [local simp] Poly.denote_combine
theorem Expr.denote_toPoly (ctx : Context) (e : Expr) : e.toPoly.denote ctx = e.denote ctx := by
induction e with
| num k => by_cases h : k == 0 <;> simp [toPoly, h, Var.denote]; simp [eq_of_beq h]
| var i => simp [toPoly]
| add a b iha ihb => simp [toPoly, iha, ihb]
| mulL k a ih => simp [toPoly, ih, -Poly.mul]
| mulR k a ih => simp [toPoly, ih, -Poly.mul]
attribute [local simp] Expr.denote_toPoly
theorem Expr.eq_of_toNormPoly (ctx : Context) (a b : Expr) (h : a.toNormPoly = b.toNormPoly) : a.denote ctx = b.denote ctx := by
simp [toNormPoly, Poly.norm] at h
have h := congrArg (Poly.denote ctx) h
simp at h
assumption
theorem Expr.of_cancel_eq (ctx : Context) (a b c d : Expr) (h : Poly.cancel a.toNormPoly b.toNormPoly = (c.toPoly, d.toPoly)) : (a.denote ctx = b.denote ctx) = (c.denote ctx = d.denote ctx) := by
have := Poly.denote_eq_cancel_eq ctx a.toNormPoly b.toNormPoly
rw [h] at this
simp [toNormPoly, Poly.norm, Poly.denote_eq, -eq_iff_iff] at this
exact this.symm
theorem Expr.of_cancel_le (ctx : Context) (a b c d : Expr) (h : Poly.cancel a.toNormPoly b.toNormPoly = (c.toPoly, d.toPoly)) : (a.denote ctx ≤ b.denote ctx) = (c.denote ctx ≤ d.denote ctx) := by
have := Poly.denote_le_cancel_eq ctx a.toNormPoly b.toNormPoly
rw [h] at this
simp [toNormPoly, Poly.norm,Poly.denote_le, -eq_iff_iff] at this
exact this.symm
theorem Expr.of_cancel_lt (ctx : Context) (a b c d : Expr) (h : Poly.cancel a.inc.toNormPoly b.toNormPoly = (c.inc.toPoly, d.toPoly)) : (a.denote ctx < b.denote ctx) = (c.denote ctx < d.denote ctx) :=
of_cancel_le ctx a.inc b c.inc d h
theorem ExprCnstr.toPoly_norm_eq (c : ExprCnstr) : c.toPoly.norm = c.toNormPoly :=
rfl
theorem ExprCnstr.denote_toPoly (ctx : Context) (c : ExprCnstr) : c.toPoly.denote ctx = c.denote ctx := by
cases c; rename_i eq lhs rhs
simp [ExprCnstr.denote, PolyCnstr.denote, ExprCnstr.toPoly];
by_cases h : eq = true <;> simp [h]
· simp [Poly.denote_eq, Expr.toPoly]
· simp [Poly.denote_le, Expr.toPoly]
attribute [local simp] ExprCnstr.denote_toPoly
theorem ExprCnstr.denote_toNormPoly (ctx : Context) (c : ExprCnstr) : c.toNormPoly.denote ctx = c.denote ctx := by
cases c; rename_i eq lhs rhs
simp [ExprCnstr.denote, PolyCnstr.denote, ExprCnstr.toNormPoly]
by_cases h : eq = true <;> simp [h]
· rw [Poly.denote_eq_cancel_eq]; simp [Poly.denote_eq, Expr.toNormPoly, Poly.norm]
· rw [Poly.denote_le_cancel_eq]; simp [Poly.denote_le, Expr.toNormPoly, Poly.norm]
attribute [local simp] ExprCnstr.denote_toNormPoly
theorem Poly.mul.go_denote (ctx : Context) (k : Nat) (p : Poly) : (Poly.mul.go k p).denote ctx = k * p.denote ctx := by
match p with
| [] => rfl
| (k', v) :: p => simp [Poly.mul.go, go_denote]
attribute [local simp] Poly.mul.go_denote
section
attribute [-simp] Nat.right_distrib Nat.left_distrib
theorem PolyCnstr.denote_mul (ctx : Context) (k : Nat) (c : PolyCnstr) : (c.mul (k+1)).denote ctx = c.denote ctx := by
cases c; rename_i eq lhs rhs
have : k ≠ 0 → k + 1 ≠ 1 := by intro h; match k with | 0 => contradiction | k+1 => simp [Nat.succ.injEq]
have : ¬ (k == 0) → (k + 1 == 1) = false := fun h => beq_false_of_ne (this (ne_of_beq_false (Bool.of_not_eq_true h)))
have : ¬ ((k + 1 == 0) = true) := fun h => absurd (eq_of_beq h) (Nat.succ_ne_zero k)
by_cases he : eq = true <;> simp [he, PolyCnstr.mul, PolyCnstr.denote, Poly.denote_le, Poly.denote_eq]
<;> by_cases hk : k == 0 <;> (try simp [eq_of_beq hk]) <;> simp [*] <;> apply Iff.intro <;> intro h
· exact Nat.eq_of_mul_eq_mul_left (Nat.zero_lt_succ _) h
· rw [h]
· exact Nat.le_of_mul_le_mul_left h (Nat.zero_lt_succ _)
· apply Nat.mul_le_mul_left _ h
end
attribute [local simp] PolyCnstr.denote_mul
theorem PolyCnstr.denote_combine {ctx : Context} {c₁ c₂ : PolyCnstr} (h₁ : c₁.denote ctx) (h₂ : c₂.denote ctx) : (c₁.combine c₂).denote ctx := by
cases c₁; cases c₂; rename_i eq₁ lhs₁ rhs₁ eq₂ lhs₂ rhs₂
simp [denote] at h₁ h₂
simp [PolyCnstr.combine, denote]
by_cases he₁ : eq₁ = true <;> by_cases he₂ : eq₂ = true <;> simp [he₁, he₂] at h₁ h₂ |-
· rw [Poly.denote_eq_cancel_eq]; simp [Poly.denote_eq] at h₁ h₂ |-; simp [h₁, h₂]
· rw [Poly.denote_le_cancel_eq]; simp [Poly.denote_eq, Poly.denote_le] at h₁ h₂ |-; rw [h₁]; apply Nat.add_le_add_left h₂
· rw [Poly.denote_le_cancel_eq]; simp [Poly.denote_eq, Poly.denote_le] at h₁ h₂ |-; rw [h₂]; apply Nat.add_le_add_right h₁
· rw [Poly.denote_le_cancel_eq]; simp [Poly.denote_eq, Poly.denote_le] at h₁ h₂ |-; apply Nat.add_le_add h₁ h₂
attribute [local simp] PolyCnstr.denote_combine
theorem Poly.isNum?_eq_some (ctx : Context) {p : Poly} {k : Nat} : p.isNum? = some k → p.denote ctx = k := by
simp [isNum?]
split
next => intro h; injection h
next k v => by_cases h : v == fixedVar <;> simp [h]; intros; simp [Var.denote, eq_of_beq h]; assumption
next => intros; contradiction
theorem Poly.of_isZero (ctx : Context) {p : Poly} (h : isZero p = true) : p.denote ctx = 0 := by
simp [isZero] at h
split at h
· simp
· contradiction
theorem Poly.of_isNonZero (ctx : Context) {p : Poly} (h : isNonZero p = true) : p.denote ctx > 0 := by
match p with
| [] => contradiction
| (k, v) :: p =>
by_cases he : v == fixedVar <;> simp [he, isNonZero] at h ⊢
· simp [eq_of_beq he, Var.denote]; apply Nat.lt_of_succ_le; exact Nat.le_trans h (Nat.le_add_right ..)
· have ih := of_isNonZero ctx h
exact Nat.le_trans ih (Nat.le_add_right ..)
theorem PolyCnstr.eq_false_of_isUnsat (ctx : Context) {c : PolyCnstr} : c.isUnsat → c.denote ctx = False := by
cases c; rename_i eq lhs rhs
simp [isUnsat]
by_cases he : eq = true <;> simp [he, denote, Poly.denote_eq, Poly.denote_le, -and_imp]
· intro
| Or.inl ⟨h₁, h₂⟩ => simp [Poly.of_isZero, h₁]; have := Nat.not_eq_zero_of_lt (Poly.of_isNonZero ctx h₂); simp [this.symm]
| Or.inr ⟨h₁, h₂⟩ => simp [Poly.of_isZero, h₂]; have := Nat.not_eq_zero_of_lt (Poly.of_isNonZero ctx h₁); simp [this]
· intro ⟨h₁, h₂⟩
simp [Poly.of_isZero, h₂]
exact Poly.of_isNonZero ctx h₁
theorem PolyCnstr.eq_true_of_isValid (ctx : Context) {c : PolyCnstr} : c.isValid → c.denote ctx = True := by
cases c; rename_i eq lhs rhs
simp [isValid]
by_cases he : eq = true <;> simp [he, denote, Poly.denote_eq, Poly.denote_le, -and_imp]
· intro ⟨h₁, h₂⟩
simp [Poly.of_isZero, h₁, h₂]
· intro h
simp [Poly.of_isZero, h]
theorem ExprCnstr.eq_false_of_isUnsat (ctx : Context) (c : ExprCnstr) (h : c.toNormPoly.isUnsat) : c.denote ctx = False := by
have := PolyCnstr.eq_false_of_isUnsat ctx h
simp [-eq_iff_iff] at this
assumption
theorem ExprCnstr.eq_true_of_isValid (ctx : Context) (c : ExprCnstr) (h : c.toNormPoly.isValid) : c.denote ctx = True := by
have := PolyCnstr.eq_true_of_isValid ctx h
simp [-eq_iff_iff] at this
assumption
theorem Certificate.of_combineHyps (ctx : Context) (c : PolyCnstr) (cs : Certificate) (h : (combineHyps c cs).denote ctx → False) : c.denote ctx → cs.denote ctx := by
match cs with
| [] => simp [combineHyps, denote] at *; exact h
| (k, c')::cs =>
intro h₁ h₂
have := PolyCnstr.denote_combine (ctx := ctx) (c₂ := PolyCnstr.mul (k + 1) (ExprCnstr.toNormPoly c')) h₁
simp at this
have := this h₂
have ih := of_combineHyps ctx (PolyCnstr.combine c (PolyCnstr.mul (k + 1) (ExprCnstr.toNormPoly c'))) cs
exact ih h this
theorem Certificate.of_combine (ctx : Context) (cs : Certificate) (h : cs.combine.denote ctx → False) : cs.denote ctx := by
match cs with
| [] => simp [combine, PolyCnstr.denote, Poly.denote_eq] at h
| (k, c)::cs =>
simp [denote, combine] at *
intro h'
apply of_combineHyps (h := h)
simp [h']
theorem Certificate.of_combine_isUnsat (ctx : Context) (cs : Certificate) (h : cs.combine.isUnsat) : cs.denote ctx :=
have h := PolyCnstr.eq_false_of_isUnsat ctx h
of_combine ctx cs (fun h' => Eq.mp h h')
theorem denote_monomialToExpr (ctx : Context) (k : Nat) (v : Var) : (monomialToExpr k v).denote ctx = k * v.denote ctx := by
simp [monomialToExpr]
by_cases h : v == fixedVar <;> simp [h, Expr.denote]
· simp [eq_of_beq h, Var.denote]
· by_cases h : k == 1 <;> simp [h, Expr.denote]; simp [eq_of_beq h]
attribute [local simp] denote_monomialToExpr
theorem Poly.denote_toExpr_go (ctx : Context) (e : Expr) (p : Poly) : (toExpr.go e p).denote ctx = e.denote ctx + p.denote ctx := by
induction p generalizing e with
| nil => simp [toExpr.go, Poly.denote]
| cons kv p ih => cases kv; simp [toExpr.go, ih, Expr.denote, Poly.denote]
attribute [local simp] Poly.denote_toExpr_go
theorem Poly.denote_toExpr (ctx : Context) (p : Poly) : p.toExpr.denote ctx = p.denote ctx := by
match p with
| [] => simp [toExpr, Expr.denote, Poly.denote]
| (k, v) :: p => simp [toExpr, Expr.denote, Poly.denote]
theorem ExprCnstr.eq_of_toNormPoly_eq (ctx : Context) (c d : ExprCnstr) (h : c.toNormPoly == d.toPoly) : c.denote ctx = d.denote ctx := by
have h := congrArg (PolyCnstr.denote ctx) (eq_of_beq h)
simp [-eq_iff_iff] at h
assumption
theorem Expr.eq_of_toNormPoly_eq (ctx : Context) (e e' : Expr) (h : e.toNormPoly == e'.toPoly) : e.denote ctx = e'.denote ctx := by
have h := congrArg (Poly.denote ctx) (eq_of_beq h)
simp [Expr.toNormPoly, Poly.norm] at h
assumption
end Linear
def elimOffset {α : Sort u} (a b k : Nat) (h₁ : a + k = b + k) (h₂ : a = b → α) : α := by
simp_arith at h₁
exact h₂ h₁
end Nat