/-
Copyright (c) 2021 Yakov Pechersky. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yakov Pechersky

! This file was ported from Lean 3 source module algebra.tropical.big_operators
! leanprover-community/mathlib commit 63f84d91dd847f50bae04a01071f3a5491934e36
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.BigOperators.Basic
import Mathbin.Data.List.MinMax
import Mathbin.Algebra.Tropical.Basic
import Mathbin.Order.ConditionallyCompleteLattice.Finset

/-!

# Tropicalization of finitary operations

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

This file provides the "big-op" or notation-based finitary operations on tropicalized types.
This allows easy conversion between sums to Infs and prods to sums. Results here are important
for expressing that evaluation of tropical polynomials are the minimum over a finite piecewise
collection of linear functions.

## Main declarations

* `untrop_sum`

## Implementation notes

No concrete (semi)ring is used here, only ones with inferrable order/lattice structure, to support
real, rat, ereal, and others (erat is not yet defined).

Minima over `list α` are defined as producing a value in `with_top α` so proofs about lists do not
directly transfer to minima over multisets or finsets.

-/

open BigOperators

variable {R S : Type _}

open Tropical Finset

/- warning: list.trop_sum -> List.trop_sum is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} [_inst_1 : AddMonoid.{u1} R] (l : List.{u1} R), Eq.{succ u1} (Tropical.{u1} R) (Tropical.trop.{u1} R (List.sum.{u1} R (AddZeroClass.toHasAdd.{u1} R (AddMonoid.toAddZeroClass.{u1} R _inst_1)) (AddZeroClass.toHasZero.{u1} R (AddMonoid.toAddZeroClass.{u1} R _inst_1)) l)) (List.prod.{u1} (Tropical.{u1} R) (Tropical.hasMul.{u1} R (AddZeroClass.toHasAdd.{u1} R (AddMonoid.toAddZeroClass.{u1} R _inst_1))) (Tropical.hasOne.{u1} R (AddZeroClass.toHasZero.{u1} R (AddMonoid.toAddZeroClass.{u1} R _inst_1))) (List.map.{u1, u1} R (Tropical.{u1} R) (Tropical.trop.{u1} R) l))
but is expected to have type
  forall {R : Type.{u1}} [_inst_1 : AddMonoid.{u1} R] (l : List.{u1} R), Eq.{succ u1} (Tropical.{u1} R) (Tropical.trop.{u1} R (List.sum.{u1} R (AddZeroClass.toAdd.{u1} R (AddMonoid.toAddZeroClass.{u1} R _inst_1)) (AddMonoid.toZero.{u1} R _inst_1) l)) (List.prod.{u1} (Tropical.{u1} R) (Tropical.instMulTropical.{u1} R (AddZeroClass.toAdd.{u1} R (AddMonoid.toAddZeroClass.{u1} R _inst_1))) (Tropical.instOneTropical.{u1} R (AddMonoid.toZero.{u1} R _inst_1)) (List.map.{u1, u1} R (Tropical.{u1} R) (Tropical.trop.{u1} R) l))
Case conversion may be inaccurate. Consider using '#align list.trop_sum List.trop_sumₓ'. -/
theorem List.trop_sum [AddMonoid R] (l : List R) : trop l.Sum = List.prod (l.map trop) :=
  by
  induction' l with hd tl IH
  · simp
  · simp [← IH]
#align list.trop_sum List.trop_sum

/- warning: multiset.trop_sum -> Multiset.trop_sum is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} [_inst_1 : AddCommMonoid.{u1} R] (s : Multiset.{u1} R), Eq.{succ u1} (Tropical.{u1} R) (Tropical.trop.{u1} R (Multiset.sum.{u1} R _inst_1 s)) (Multiset.prod.{u1} (Tropical.{u1} R) (Tropical.commMonoid.{u1} R _inst_1) (Multiset.map.{u1, u1} R (Tropical.{u1} R) (Tropical.trop.{u1} R) s))
but is expected to have type
  forall {R : Type.{u1}} [_inst_1 : AddCommMonoid.{u1} R] (s : Multiset.{u1} R), Eq.{succ u1} (Tropical.{u1} R) (Tropical.trop.{u1} R (Multiset.sum.{u1} R _inst_1 s)) (Multiset.prod.{u1} (Tropical.{u1} R) (Tropical.instCommMonoidTropical.{u1} R _inst_1) (Multiset.map.{u1, u1} R (Tropical.{u1} R) (Tropical.trop.{u1} R) s))
Case conversion may be inaccurate. Consider using '#align multiset.trop_sum Multiset.trop_sumₓ'. -/
theorem Multiset.trop_sum [AddCommMonoid R] (s : Multiset R) :
    trop s.Sum = Multiset.prod (s.map trop) :=
  Quotient.inductionOn s (by simpa using List.trop_sum)
#align multiset.trop_sum Multiset.trop_sum

/- warning: trop_sum -> trop_sum is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} {S : Type.{u2}} [_inst_1 : AddCommMonoid.{u1} R] (s : Finset.{u2} S) (f : S -> R), Eq.{succ u1} (Tropical.{u1} R) (Tropical.trop.{u1} R (Finset.sum.{u1, u2} R S _inst_1 s (fun (i : S) => f i))) (Finset.prod.{u1, u2} (Tropical.{u1} R) S (Tropical.commMonoid.{u1} R _inst_1) s (fun (i : S) => Tropical.trop.{u1} R (f i)))
but is expected to have type
  forall {R : Type.{u2}} {S : Type.{u1}} [_inst_1 : AddCommMonoid.{u2} R] (s : Finset.{u1} S) (f : S -> R), Eq.{succ u2} (Tropical.{u2} R) (Tropical.trop.{u2} R (Finset.sum.{u2, u1} R S _inst_1 s (fun (i : S) => f i))) (Finset.prod.{u2, u1} (Tropical.{u2} R) S (Tropical.instCommMonoidTropical.{u2} R _inst_1) s (fun (i : S) => Tropical.trop.{u2} R (f i)))
Case conversion may be inaccurate. Consider using '#align trop_sum trop_sumₓ'. -/
theorem trop_sum [AddCommMonoid R] (s : Finset S) (f : S → R) :
    trop (∑ i in s, f i) = ∏ i in s, trop (f i) :=
  by
  cases s
  convert Multiset.trop_sum _
  simp
#align trop_sum trop_sum

/- warning: list.untrop_prod -> List.untrop_prod is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} [_inst_1 : AddMonoid.{u1} R] (l : List.{u1} (Tropical.{u1} R)), Eq.{succ u1} R (Tropical.untrop.{u1} R (List.prod.{u1} (Tropical.{u1} R) (Tropical.hasMul.{u1} R (AddZeroClass.toHasAdd.{u1} R (AddMonoid.toAddZeroClass.{u1} R _inst_1))) (Tropical.hasOne.{u1} R (AddZeroClass.toHasZero.{u1} R (AddMonoid.toAddZeroClass.{u1} R _inst_1))) l)) (List.sum.{u1} R (AddZeroClass.toHasAdd.{u1} R (AddMonoid.toAddZeroClass.{u1} R _inst_1)) (AddZeroClass.toHasZero.{u1} R (AddMonoid.toAddZeroClass.{u1} R _inst_1)) (List.map.{u1, u1} (Tropical.{u1} R) R (Tropical.untrop.{u1} R) l))
but is expected to have type
  forall {R : Type.{u1}} [_inst_1 : AddMonoid.{u1} R] (l : List.{u1} (Tropical.{u1} R)), Eq.{succ u1} R (Tropical.untrop.{u1} R (List.prod.{u1} (Tropical.{u1} R) (Tropical.instMulTropical.{u1} R (AddZeroClass.toAdd.{u1} R (AddMonoid.toAddZeroClass.{u1} R _inst_1))) (Tropical.instOneTropical.{u1} R (AddMonoid.toZero.{u1} R _inst_1)) l)) (List.sum.{u1} R (AddZeroClass.toAdd.{u1} R (AddMonoid.toAddZeroClass.{u1} R _inst_1)) (AddMonoid.toZero.{u1} R _inst_1) (List.map.{u1, u1} (Tropical.{u1} R) R (Tropical.untrop.{u1} R) l))
Case conversion may be inaccurate. Consider using '#align list.untrop_prod List.untrop_prodₓ'. -/
theorem List.untrop_prod [AddMonoid R] (l : List (Tropical R)) :
    untrop l.Prod = List.sum (l.map untrop) :=
  by
  induction' l with hd tl IH
  · simp
  · simp [← IH]
#align list.untrop_prod List.untrop_prod

/- warning: multiset.untrop_prod -> Multiset.untrop_prod is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} [_inst_1 : AddCommMonoid.{u1} R] (s : Multiset.{u1} (Tropical.{u1} R)), Eq.{succ u1} R (Tropical.untrop.{u1} R (Multiset.prod.{u1} (Tropical.{u1} R) (Tropical.commMonoid.{u1} R _inst_1) s)) (Multiset.sum.{u1} R _inst_1 (Multiset.map.{u1, u1} (Tropical.{u1} R) R (Tropical.untrop.{u1} R) s))
but is expected to have type
  forall {R : Type.{u1}} [_inst_1 : AddCommMonoid.{u1} R] (s : Multiset.{u1} (Tropical.{u1} R)), Eq.{succ u1} R (Tropical.untrop.{u1} R (Multiset.prod.{u1} (Tropical.{u1} R) (Tropical.instCommMonoidTropical.{u1} R _inst_1) s)) (Multiset.sum.{u1} R _inst_1 (Multiset.map.{u1, u1} (Tropical.{u1} R) R (Tropical.untrop.{u1} R) s))
Case conversion may be inaccurate. Consider using '#align multiset.untrop_prod Multiset.untrop_prodₓ'. -/
theorem Multiset.untrop_prod [AddCommMonoid R] (s : Multiset (Tropical R)) :
    untrop s.Prod = Multiset.sum (s.map untrop) :=
  Quotient.inductionOn s (by simpa using List.untrop_prod)
#align multiset.untrop_prod Multiset.untrop_prod

/- warning: untrop_prod -> untrop_prod is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} {S : Type.{u2}} [_inst_1 : AddCommMonoid.{u1} R] (s : Finset.{u2} S) (f : S -> (Tropical.{u1} R)), Eq.{succ u1} R (Tropical.untrop.{u1} R (Finset.prod.{u1, u2} (Tropical.{u1} R) S (Tropical.commMonoid.{u1} R _inst_1) s (fun (i : S) => f i))) (Finset.sum.{u1, u2} R S _inst_1 s (fun (i : S) => Tropical.untrop.{u1} R (f i)))
but is expected to have type
  forall {R : Type.{u2}} {S : Type.{u1}} [_inst_1 : AddCommMonoid.{u2} R] (s : Finset.{u1} S) (f : S -> (Tropical.{u2} R)), Eq.{succ u2} R (Tropical.untrop.{u2} R (Finset.prod.{u2, u1} (Tropical.{u2} R) S (Tropical.instCommMonoidTropical.{u2} R _inst_1) s (fun (i : S) => f i))) (Finset.sum.{u2, u1} R S _inst_1 s (fun (i : S) => Tropical.untrop.{u2} R (f i)))
Case conversion may be inaccurate. Consider using '#align untrop_prod untrop_prodₓ'. -/
theorem untrop_prod [AddCommMonoid R] (s : Finset S) (f : S → Tropical R) :
    untrop (∏ i in s, f i) = ∑ i in s, untrop (f i) :=
  by
  cases s
  convert Multiset.untrop_prod _
  simp
#align untrop_prod untrop_prod

#print List.trop_minimum /-
theorem List.trop_minimum [LinearOrder R] (l : List R) :
    trop l.minimum = List.sum (l.map (trop ∘ coe)) :=
  by
  induction' l with hd tl IH
  · simp
  · simp [List.minimum_cons, ← IH]
#align list.trop_minimum List.trop_minimum
-/

/- warning: multiset.trop_inf -> Multiset.trop_inf is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} [_inst_1 : LinearOrder.{u1} R] [_inst_2 : OrderTop.{u1} R (Preorder.toLE.{u1} R (PartialOrder.toPreorder.{u1} R (SemilatticeInf.toPartialOrder.{u1} R (Lattice.toSemilatticeInf.{u1} R (LinearOrder.toLattice.{u1} R _inst_1)))))] (s : Multiset.{u1} R), Eq.{succ u1} (Tropical.{u1} R) (Tropical.trop.{u1} R (Multiset.inf.{u1} R (Lattice.toSemilatticeInf.{u1} R (LinearOrder.toLattice.{u1} R _inst_1)) _inst_2 s)) (Multiset.sum.{u1} (Tropical.{u1} R) (Tropical.addCommMonoid.{u1} R _inst_1 _inst_2) (Multiset.map.{u1, u1} R (Tropical.{u1} R) (Tropical.trop.{u1} R) s))
but is expected to have type
  forall {R : Type.{u1}} [_inst_1 : LinearOrder.{u1} R] [_inst_2 : OrderTop.{u1} R (Preorder.toLE.{u1} R (PartialOrder.toPreorder.{u1} R (SemilatticeInf.toPartialOrder.{u1} R (Lattice.toSemilatticeInf.{u1} R (DistribLattice.toLattice.{u1} R (instDistribLattice.{u1} R _inst_1))))))] (s : Multiset.{u1} R), Eq.{succ u1} (Tropical.{u1} R) (Tropical.trop.{u1} R (Multiset.inf.{u1} R (Lattice.toSemilatticeInf.{u1} R (DistribLattice.toLattice.{u1} R (instDistribLattice.{u1} R _inst_1))) _inst_2 s)) (Multiset.sum.{u1} (Tropical.{u1} R) (Tropical.instAddCommMonoidTropical.{u1} R _inst_1 _inst_2) (Multiset.map.{u1, u1} R (Tropical.{u1} R) (Tropical.trop.{u1} R) s))
Case conversion may be inaccurate. Consider using '#align multiset.trop_inf Multiset.trop_infₓ'. -/
theorem Multiset.trop_inf [LinearOrder R] [OrderTop R] (s : Multiset R) :
    trop s.inf = Multiset.sum (s.map trop) :=
  by
  induction' s using Multiset.induction with s x IH
  · simp
  · simp [← IH]
#align multiset.trop_inf Multiset.trop_inf

/- warning: finset.trop_inf -> Finset.trop_inf is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} {S : Type.{u2}} [_inst_1 : LinearOrder.{u1} R] [_inst_2 : OrderTop.{u1} R (Preorder.toLE.{u1} R (PartialOrder.toPreorder.{u1} R (SemilatticeInf.toPartialOrder.{u1} R (Lattice.toSemilatticeInf.{u1} R (LinearOrder.toLattice.{u1} R _inst_1)))))] (s : Finset.{u2} S) (f : S -> R), Eq.{succ u1} (Tropical.{u1} R) (Tropical.trop.{u1} R (Finset.inf.{u1, u2} R S (Lattice.toSemilatticeInf.{u1} R (LinearOrder.toLattice.{u1} R _inst_1)) _inst_2 s f)) (Finset.sum.{u1, u2} (Tropical.{u1} R) S (Tropical.addCommMonoid.{u1} R _inst_1 _inst_2) s (fun (i : S) => Tropical.trop.{u1} R (f i)))
but is expected to have type
  forall {R : Type.{u2}} {S : Type.{u1}} [_inst_1 : LinearOrder.{u2} R] [_inst_2 : OrderTop.{u2} R (Preorder.toLE.{u2} R (PartialOrder.toPreorder.{u2} R (SemilatticeInf.toPartialOrder.{u2} R (Lattice.toSemilatticeInf.{u2} R (DistribLattice.toLattice.{u2} R (instDistribLattice.{u2} R _inst_1))))))] (s : Finset.{u1} S) (f : S -> R), Eq.{succ u2} (Tropical.{u2} R) (Tropical.trop.{u2} R (Finset.inf.{u2, u1} R S (Lattice.toSemilatticeInf.{u2} R (DistribLattice.toLattice.{u2} R (instDistribLattice.{u2} R _inst_1))) _inst_2 s f)) (Finset.sum.{u2, u1} (Tropical.{u2} R) S (Tropical.instAddCommMonoidTropical.{u2} R _inst_1 _inst_2) s (fun (i : S) => Tropical.trop.{u2} R (f i)))
Case conversion may be inaccurate. Consider using '#align finset.trop_inf Finset.trop_infₓ'. -/
theorem Finset.trop_inf [LinearOrder R] [OrderTop R] (s : Finset S) (f : S → R) :
    trop (s.inf f) = ∑ i in s, trop (f i) := by
  cases s
  convert Multiset.trop_inf _
  simp
#align finset.trop_inf Finset.trop_inf

/- warning: trop_Inf_image -> trop_infₛ_image is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} {S : Type.{u2}} [_inst_1 : ConditionallyCompleteLinearOrder.{u1} R] (s : Finset.{u2} S) (f : S -> (WithTop.{u1} R)), Eq.{succ u1} (Tropical.{u1} (WithTop.{u1} R)) (Tropical.trop.{u1} (WithTop.{u1} R) (InfSet.infₛ.{u1} (WithTop.{u1} R) (WithTop.hasInf.{u1} R (ConditionallyCompleteLattice.toHasInf.{u1} R (ConditionallyCompleteLinearOrder.toConditionallyCompleteLattice.{u1} R _inst_1))) (Set.image.{u2, u1} S (WithTop.{u1} R) f ((fun (a : Type.{u2}) (b : Type.{u2}) [self : HasLiftT.{succ u2, succ u2} a b] => self.0) (Finset.{u2} S) (Set.{u2} S) (HasLiftT.mk.{succ u2, succ u2} (Finset.{u2} S) (Set.{u2} S) (CoeTCₓ.coe.{succ u2, succ u2} (Finset.{u2} S) (Set.{u2} S) (Finset.Set.hasCoeT.{u2} S))) s)))) (Finset.sum.{u1, u2} (Tropical.{u1} (WithTop.{u1} R)) S (Tropical.addCommMonoid.{u1} (WithTop.{u1} R) (WithTop.linearOrder.{u1} R (ConditionallyCompleteLinearOrder.toLinearOrder.{u1} R _inst_1)) (WithTop.orderTop.{u1} R (Preorder.toLE.{u1} R (PartialOrder.toPreorder.{u1} R (SemilatticeInf.toPartialOrder.{u1} R (Lattice.toSemilatticeInf.{u1} R (ConditionallyCompleteLattice.toLattice.{u1} R (ConditionallyCompleteLinearOrder.toConditionallyCompleteLattice.{u1} R _inst_1)))))))) s (fun (i : S) => Tropical.trop.{u1} (WithTop.{u1} R) (f i)))
but is expected to have type
  forall {R : Type.{u2}} {S : Type.{u1}} [_inst_1 : ConditionallyCompleteLinearOrder.{u2} R] (s : Finset.{u1} S) (f : S -> (WithTop.{u2} R)), Eq.{succ u2} (Tropical.{u2} (WithTop.{u2} R)) (Tropical.trop.{u2} (WithTop.{u2} R) (InfSet.infₛ.{u2} (WithTop.{u2} R) (instInfSetWithTop.{u2} R (ConditionallyCompleteLattice.toInfSet.{u2} R (ConditionallyCompleteLinearOrder.toConditionallyCompleteLattice.{u2} R _inst_1))) (Set.image.{u1, u2} S (WithTop.{u2} R) f (Finset.toSet.{u1} S s)))) (Finset.sum.{u2, u1} (Tropical.{u2} (WithTop.{u2} R)) S (Tropical.instAddCommMonoidTropical.{u2} (WithTop.{u2} R) (WithTop.linearOrder.{u2} R (instLinearOrder.{u2} R _inst_1)) (WithTop.orderTop.{u2} R (Preorder.toLE.{u2} R (PartialOrder.toPreorder.{u2} R (SemilatticeSup.toPartialOrder.{u2} R (Lattice.toSemilatticeSup.{u2} R (DistribLattice.toLattice.{u2} R (instDistribLattice.{u2} R (instLinearOrder.{u2} R _inst_1))))))))) s (fun (i : S) => Tropical.trop.{u2} (WithTop.{u2} R) (f i)))
Case conversion may be inaccurate. Consider using '#align trop_Inf_image trop_infₛ_imageₓ'. -/
theorem trop_infₛ_image [ConditionallyCompleteLinearOrder R] (s : Finset S) (f : S → WithTop R) :
    trop (infₛ (f '' s)) = ∑ i in s, trop (f i) :=
  by
  rcases s.eq_empty_or_nonempty with (rfl | h)
  · simp only [Set.image_empty, coe_empty, sum_empty, WithTop.infₛ_empty, trop_top]
  rw [← inf'_eq_cInf_image _ h, inf'_eq_inf, s.trop_inf]
#align trop_Inf_image trop_infₛ_image

/- warning: trop_infi -> trop_infᵢ is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} {S : Type.{u2}} [_inst_1 : ConditionallyCompleteLinearOrder.{u1} R] [_inst_2 : Fintype.{u2} S] (f : S -> (WithTop.{u1} R)), Eq.{succ u1} (Tropical.{u1} (WithTop.{u1} R)) (Tropical.trop.{u1} (WithTop.{u1} R) (infᵢ.{u1, succ u2} (WithTop.{u1} R) (WithTop.hasInf.{u1} R (ConditionallyCompleteLattice.toHasInf.{u1} R (ConditionallyCompleteLinearOrder.toConditionallyCompleteLattice.{u1} R _inst_1))) S (fun (i : S) => f i))) (Finset.sum.{u1, u2} (Tropical.{u1} (WithTop.{u1} R)) S (Tropical.addCommMonoid.{u1} (WithTop.{u1} R) (WithTop.linearOrder.{u1} R (ConditionallyCompleteLinearOrder.toLinearOrder.{u1} R _inst_1)) (WithTop.orderTop.{u1} R (Preorder.toLE.{u1} R (PartialOrder.toPreorder.{u1} R (SemilatticeInf.toPartialOrder.{u1} R (Lattice.toSemilatticeInf.{u1} R (ConditionallyCompleteLattice.toLattice.{u1} R (ConditionallyCompleteLinearOrder.toConditionallyCompleteLattice.{u1} R _inst_1)))))))) (Finset.univ.{u2} S _inst_2) (fun (i : S) => Tropical.trop.{u1} (WithTop.{u1} R) (f i)))
but is expected to have type
  forall {R : Type.{u2}} {S : Type.{u1}} [_inst_1 : ConditionallyCompleteLinearOrder.{u2} R] [_inst_2 : Fintype.{u1} S] (f : S -> (WithTop.{u2} R)), Eq.{succ u2} (Tropical.{u2} (WithTop.{u2} R)) (Tropical.trop.{u2} (WithTop.{u2} R) (infᵢ.{u2, succ u1} (WithTop.{u2} R) (instInfSetWithTop.{u2} R (ConditionallyCompleteLattice.toInfSet.{u2} R (ConditionallyCompleteLinearOrder.toConditionallyCompleteLattice.{u2} R _inst_1))) S (fun (i : S) => f i))) (Finset.sum.{u2, u1} (Tropical.{u2} (WithTop.{u2} R)) S (Tropical.instAddCommMonoidTropical.{u2} (WithTop.{u2} R) (WithTop.linearOrder.{u2} R (instLinearOrder.{u2} R _inst_1)) (WithTop.orderTop.{u2} R (Preorder.toLE.{u2} R (PartialOrder.toPreorder.{u2} R (SemilatticeSup.toPartialOrder.{u2} R (Lattice.toSemilatticeSup.{u2} R (DistribLattice.toLattice.{u2} R (instDistribLattice.{u2} R (instLinearOrder.{u2} R _inst_1))))))))) (Finset.univ.{u1} S _inst_2) (fun (i : S) => Tropical.trop.{u2} (WithTop.{u2} R) (f i)))
Case conversion may be inaccurate. Consider using '#align trop_infi trop_infᵢₓ'. -/
theorem trop_infᵢ [ConditionallyCompleteLinearOrder R] [Fintype S] (f : S → WithTop R) :
    trop (⨅ i : S, f i) = ∑ i : S, trop (f i) := by
  rw [infᵢ, ← Set.image_univ, ← coe_univ, trop_infₛ_image]
#align trop_infi trop_infᵢ

/- warning: multiset.untrop_sum -> Multiset.untrop_sum is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} [_inst_1 : LinearOrder.{u1} R] [_inst_2 : OrderTop.{u1} R (Preorder.toLE.{u1} R (PartialOrder.toPreorder.{u1} R (SemilatticeInf.toPartialOrder.{u1} R (Lattice.toSemilatticeInf.{u1} R (LinearOrder.toLattice.{u1} R _inst_1)))))] (s : Multiset.{u1} (Tropical.{u1} R)), Eq.{succ u1} R (Tropical.untrop.{u1} R (Multiset.sum.{u1} (Tropical.{u1} R) (Tropical.addCommMonoid.{u1} R _inst_1 _inst_2) s)) (Multiset.inf.{u1} R (Lattice.toSemilatticeInf.{u1} R (LinearOrder.toLattice.{u1} R _inst_1)) _inst_2 (Multiset.map.{u1, u1} (Tropical.{u1} R) R (Tropical.untrop.{u1} R) s))
but is expected to have type
  forall {R : Type.{u1}} [_inst_1 : LinearOrder.{u1} R] [_inst_2 : OrderTop.{u1} R (Preorder.toLE.{u1} R (PartialOrder.toPreorder.{u1} R (SemilatticeInf.toPartialOrder.{u1} R (Lattice.toSemilatticeInf.{u1} R (DistribLattice.toLattice.{u1} R (instDistribLattice.{u1} R _inst_1))))))] (s : Multiset.{u1} (Tropical.{u1} R)), Eq.{succ u1} R (Tropical.untrop.{u1} R (Multiset.sum.{u1} (Tropical.{u1} R) (Tropical.instAddCommMonoidTropical.{u1} R _inst_1 _inst_2) s)) (Multiset.inf.{u1} R (Lattice.toSemilatticeInf.{u1} R (DistribLattice.toLattice.{u1} R (instDistribLattice.{u1} R _inst_1))) _inst_2 (Multiset.map.{u1, u1} (Tropical.{u1} R) R (Tropical.untrop.{u1} R) s))
Case conversion may be inaccurate. Consider using '#align multiset.untrop_sum Multiset.untrop_sumₓ'. -/
theorem Multiset.untrop_sum [LinearOrder R] [OrderTop R] (s : Multiset (Tropical R)) :
    untrop s.Sum = Multiset.inf (s.map untrop) :=
  by
  induction' s using Multiset.induction with s x IH
  · simp
  · simpa [← IH]
#align multiset.untrop_sum Multiset.untrop_sum

/- warning: finset.untrop_sum' -> Finset.untrop_sum' is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} {S : Type.{u2}} [_inst_1 : LinearOrder.{u1} R] [_inst_2 : OrderTop.{u1} R (Preorder.toLE.{u1} R (PartialOrder.toPreorder.{u1} R (SemilatticeInf.toPartialOrder.{u1} R (Lattice.toSemilatticeInf.{u1} R (LinearOrder.toLattice.{u1} R _inst_1)))))] (s : Finset.{u2} S) (f : S -> (Tropical.{u1} R)), Eq.{succ u1} R (Tropical.untrop.{u1} R (Finset.sum.{u1, u2} (Tropical.{u1} R) S (Tropical.addCommMonoid.{u1} R _inst_1 _inst_2) s (fun (i : S) => f i))) (Finset.inf.{u1, u2} R S (Lattice.toSemilatticeInf.{u1} R (LinearOrder.toLattice.{u1} R _inst_1)) _inst_2 s (Function.comp.{succ u2, succ u1, succ u1} S (Tropical.{u1} R) R (Tropical.untrop.{u1} R) f))
but is expected to have type
  forall {R : Type.{u2}} {S : Type.{u1}} [_inst_1 : LinearOrder.{u2} R] [_inst_2 : OrderTop.{u2} R (Preorder.toLE.{u2} R (PartialOrder.toPreorder.{u2} R (SemilatticeInf.toPartialOrder.{u2} R (Lattice.toSemilatticeInf.{u2} R (DistribLattice.toLattice.{u2} R (instDistribLattice.{u2} R _inst_1))))))] (s : Finset.{u1} S) (f : S -> (Tropical.{u2} R)), Eq.{succ u2} R (Tropical.untrop.{u2} R (Finset.sum.{u2, u1} (Tropical.{u2} R) S (Tropical.instAddCommMonoidTropical.{u2} R _inst_1 _inst_2) s (fun (i : S) => f i))) (Finset.inf.{u2, u1} R S (Lattice.toSemilatticeInf.{u2} R (DistribLattice.toLattice.{u2} R (instDistribLattice.{u2} R _inst_1))) _inst_2 s (Function.comp.{succ u1, succ u2, succ u2} S (Tropical.{u2} R) R (Tropical.untrop.{u2} R) f))
Case conversion may be inaccurate. Consider using '#align finset.untrop_sum' Finset.untrop_sum'ₓ'. -/
theorem Finset.untrop_sum' [LinearOrder R] [OrderTop R] (s : Finset S) (f : S → Tropical R) :
    untrop (∑ i in s, f i) = s.inf (untrop ∘ f) :=
  by
  cases s
  convert Multiset.untrop_sum _
  simpa
#align finset.untrop_sum' Finset.untrop_sum'

/- warning: untrop_sum_eq_Inf_image -> untrop_sum_eq_infₛ_image is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} {S : Type.{u2}} [_inst_1 : ConditionallyCompleteLinearOrder.{u1} R] (s : Finset.{u2} S) (f : S -> (Tropical.{u1} (WithTop.{u1} R))), Eq.{succ u1} (WithTop.{u1} R) (Tropical.untrop.{u1} (WithTop.{u1} R) (Finset.sum.{u1, u2} (Tropical.{u1} (WithTop.{u1} R)) S (Tropical.addCommMonoid.{u1} (WithTop.{u1} R) (WithTop.linearOrder.{u1} R (ConditionallyCompleteLinearOrder.toLinearOrder.{u1} R _inst_1)) (WithTop.orderTop.{u1} R (Preorder.toLE.{u1} R (PartialOrder.toPreorder.{u1} R (SemilatticeInf.toPartialOrder.{u1} R (Lattice.toSemilatticeInf.{u1} R (ConditionallyCompleteLattice.toLattice.{u1} R (ConditionallyCompleteLinearOrder.toConditionallyCompleteLattice.{u1} R _inst_1)))))))) s (fun (i : S) => f i))) (InfSet.infₛ.{u1} (WithTop.{u1} R) (WithTop.hasInf.{u1} R (ConditionallyCompleteLattice.toHasInf.{u1} R (ConditionallyCompleteLinearOrder.toConditionallyCompleteLattice.{u1} R _inst_1))) (Set.image.{u2, u1} S (WithTop.{u1} R) (Function.comp.{succ u2, succ u1, succ u1} S (Tropical.{u1} (WithTop.{u1} R)) (WithTop.{u1} R) (Tropical.untrop.{u1} (WithTop.{u1} R)) f) ((fun (a : Type.{u2}) (b : Type.{u2}) [self : HasLiftT.{succ u2, succ u2} a b] => self.0) (Finset.{u2} S) (Set.{u2} S) (HasLiftT.mk.{succ u2, succ u2} (Finset.{u2} S) (Set.{u2} S) (CoeTCₓ.coe.{succ u2, succ u2} (Finset.{u2} S) (Set.{u2} S) (Finset.Set.hasCoeT.{u2} S))) s)))
but is expected to have type
  forall {R : Type.{u2}} {S : Type.{u1}} [_inst_1 : ConditionallyCompleteLinearOrder.{u2} R] (s : Finset.{u1} S) (f : S -> (Tropical.{u2} (WithTop.{u2} R))), Eq.{succ u2} (WithTop.{u2} R) (Tropical.untrop.{u2} (WithTop.{u2} R) (Finset.sum.{u2, u1} (Tropical.{u2} (WithTop.{u2} R)) S (Tropical.instAddCommMonoidTropical.{u2} (WithTop.{u2} R) (WithTop.linearOrder.{u2} R (instLinearOrder.{u2} R _inst_1)) (WithTop.orderTop.{u2} R (Preorder.toLE.{u2} R (PartialOrder.toPreorder.{u2} R (SemilatticeSup.toPartialOrder.{u2} R (Lattice.toSemilatticeSup.{u2} R (DistribLattice.toLattice.{u2} R (instDistribLattice.{u2} R (instLinearOrder.{u2} R _inst_1))))))))) s (fun (i : S) => f i))) (InfSet.infₛ.{u2} (WithTop.{u2} R) (instInfSetWithTop.{u2} R (ConditionallyCompleteLattice.toInfSet.{u2} R (ConditionallyCompleteLinearOrder.toConditionallyCompleteLattice.{u2} R _inst_1))) (Set.image.{u1, u2} S (WithTop.{u2} R) (Function.comp.{succ u1, succ u2, succ u2} S (Tropical.{u2} (WithTop.{u2} R)) (WithTop.{u2} R) (Tropical.untrop.{u2} (WithTop.{u2} R)) f) (Finset.toSet.{u1} S s)))
Case conversion may be inaccurate. Consider using '#align untrop_sum_eq_Inf_image untrop_sum_eq_infₛ_imageₓ'. -/
theorem untrop_sum_eq_infₛ_image [ConditionallyCompleteLinearOrder R] (s : Finset S)
    (f : S → Tropical (WithTop R)) : untrop (∑ i in s, f i) = infₛ (untrop ∘ f '' s) :=
  by
  rcases s.eq_empty_or_nonempty with (rfl | h)
  · simp only [Set.image_empty, coe_empty, sum_empty, WithTop.infₛ_empty, untrop_zero]
  rw [← inf'_eq_cInf_image _ h, inf'_eq_inf, Finset.untrop_sum']
#align untrop_sum_eq_Inf_image untrop_sum_eq_infₛ_image

/- warning: untrop_sum -> untrop_sum is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} {S : Type.{u2}} [_inst_1 : ConditionallyCompleteLinearOrder.{u1} R] [_inst_2 : Fintype.{u2} S] (f : S -> (Tropical.{u1} (WithTop.{u1} R))), Eq.{succ u1} (WithTop.{u1} R) (Tropical.untrop.{u1} (WithTop.{u1} R) (Finset.sum.{u1, u2} (Tropical.{u1} (WithTop.{u1} R)) S (Tropical.addCommMonoid.{u1} (WithTop.{u1} R) (WithTop.linearOrder.{u1} R (ConditionallyCompleteLinearOrder.toLinearOrder.{u1} R _inst_1)) (WithTop.orderTop.{u1} R (Preorder.toLE.{u1} R (PartialOrder.toPreorder.{u1} R (SemilatticeInf.toPartialOrder.{u1} R (Lattice.toSemilatticeInf.{u1} R (ConditionallyCompleteLattice.toLattice.{u1} R (ConditionallyCompleteLinearOrder.toConditionallyCompleteLattice.{u1} R _inst_1)))))))) (Finset.univ.{u2} S _inst_2) (fun (i : S) => f i))) (infᵢ.{u1, succ u2} (WithTop.{u1} R) (WithTop.hasInf.{u1} R (ConditionallyCompleteLattice.toHasInf.{u1} R (ConditionallyCompleteLinearOrder.toConditionallyCompleteLattice.{u1} R _inst_1))) S (fun (i : S) => Tropical.untrop.{u1} (WithTop.{u1} R) (f i)))
but is expected to have type
  forall {R : Type.{u2}} {S : Type.{u1}} [_inst_1 : ConditionallyCompleteLinearOrder.{u2} R] [_inst_2 : Fintype.{u1} S] (f : S -> (Tropical.{u2} (WithTop.{u2} R))), Eq.{succ u2} (WithTop.{u2} R) (Tropical.untrop.{u2} (WithTop.{u2} R) (Finset.sum.{u2, u1} (Tropical.{u2} (WithTop.{u2} R)) S (Tropical.instAddCommMonoidTropical.{u2} (WithTop.{u2} R) (WithTop.linearOrder.{u2} R (instLinearOrder.{u2} R _inst_1)) (WithTop.orderTop.{u2} R (Preorder.toLE.{u2} R (PartialOrder.toPreorder.{u2} R (SemilatticeSup.toPartialOrder.{u2} R (Lattice.toSemilatticeSup.{u2} R (DistribLattice.toLattice.{u2} R (instDistribLattice.{u2} R (instLinearOrder.{u2} R _inst_1))))))))) (Finset.univ.{u1} S _inst_2) (fun (i : S) => f i))) (infᵢ.{u2, succ u1} (WithTop.{u2} R) (instInfSetWithTop.{u2} R (ConditionallyCompleteLattice.toInfSet.{u2} R (ConditionallyCompleteLinearOrder.toConditionallyCompleteLattice.{u2} R _inst_1))) S (fun (i : S) => Tropical.untrop.{u2} (WithTop.{u2} R) (f i)))
Case conversion may be inaccurate. Consider using '#align untrop_sum untrop_sumₓ'. -/
theorem untrop_sum [ConditionallyCompleteLinearOrder R] [Fintype S] (f : S → Tropical (WithTop R)) :
    untrop (∑ i : S, f i) = ⨅ i : S, untrop (f i) := by
  rw [infᵢ, ← Set.image_univ, ← coe_univ, untrop_sum_eq_infₛ_image]
#align untrop_sum untrop_sum

/- warning: finset.untrop_sum -> Finset.untrop_sum is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} {S : Type.{u2}} [_inst_1 : ConditionallyCompleteLinearOrder.{u1} R] (s : Finset.{u2} S) (f : S -> (Tropical.{u1} (WithTop.{u1} R))), Eq.{succ u1} (WithTop.{u1} R) (Tropical.untrop.{u1} (WithTop.{u1} R) (Finset.sum.{u1, u2} (Tropical.{u1} (WithTop.{u1} R)) S (Tropical.addCommMonoid.{u1} (WithTop.{u1} R) (WithTop.linearOrder.{u1} R (ConditionallyCompleteLinearOrder.toLinearOrder.{u1} R _inst_1)) (WithTop.orderTop.{u1} R (Preorder.toLE.{u1} R (PartialOrder.toPreorder.{u1} R (SemilatticeInf.toPartialOrder.{u1} R (Lattice.toSemilatticeInf.{u1} R (ConditionallyCompleteLattice.toLattice.{u1} R (ConditionallyCompleteLinearOrder.toConditionallyCompleteLattice.{u1} R _inst_1)))))))) s (fun (i : S) => f i))) (infᵢ.{u1, succ u2} (WithTop.{u1} R) (WithTop.hasInf.{u1} R (ConditionallyCompleteLattice.toHasInf.{u1} R (ConditionallyCompleteLinearOrder.toConditionallyCompleteLattice.{u1} R _inst_1))) (coeSort.{succ u2, succ (succ u2)} (Finset.{u2} S) Type.{u2} (Finset.hasCoeToSort.{u2} S) s) (fun (i : coeSort.{succ u2, succ (succ u2)} (Finset.{u2} S) Type.{u2} (Finset.hasCoeToSort.{u2} S) s) => Tropical.untrop.{u1} (WithTop.{u1} R) (f ((fun (a : Type.{u2}) (b : Type.{u2}) [self : HasLiftT.{succ u2, succ u2} a b] => self.0) (coeSort.{succ u2, succ (succ u2)} (Finset.{u2} S) Type.{u2} (Finset.hasCoeToSort.{u2} S) s) S (HasLiftT.mk.{succ u2, succ u2} (coeSort.{succ u2, succ (succ u2)} (Finset.{u2} S) Type.{u2} (Finset.hasCoeToSort.{u2} S) s) S (CoeTCₓ.coe.{succ u2, succ u2} (coeSort.{succ u2, succ (succ u2)} (Finset.{u2} S) Type.{u2} (Finset.hasCoeToSort.{u2} S) s) S (coeBase.{succ u2, succ u2} (coeSort.{succ u2, succ (succ u2)} (Finset.{u2} S) Type.{u2} (Finset.hasCoeToSort.{u2} S) s) S (coeSubtype.{succ u2} S (fun (x : S) => Membership.Mem.{u2, u2} S (Finset.{u2} S) (Finset.hasMem.{u2} S) x s))))) i))))
but is expected to have type
  forall {R : Type.{u2}} {S : Type.{u1}} [_inst_1 : ConditionallyCompleteLinearOrder.{u2} R] (s : Finset.{u1} S) (f : S -> (Tropical.{u2} (WithTop.{u2} R))), Eq.{succ u2} (WithTop.{u2} R) (Tropical.untrop.{u2} (WithTop.{u2} R) (Finset.sum.{u2, u1} (Tropical.{u2} (WithTop.{u2} R)) S (Tropical.instAddCommMonoidTropical.{u2} (WithTop.{u2} R) (WithTop.linearOrder.{u2} R (instLinearOrder.{u2} R _inst_1)) (WithTop.orderTop.{u2} R (Preorder.toLE.{u2} R (PartialOrder.toPreorder.{u2} R (SemilatticeSup.toPartialOrder.{u2} R (Lattice.toSemilatticeSup.{u2} R (DistribLattice.toLattice.{u2} R (instDistribLattice.{u2} R (instLinearOrder.{u2} R _inst_1))))))))) s (fun (i : S) => f i))) (infᵢ.{u2, succ u1} (WithTop.{u2} R) (instInfSetWithTop.{u2} R (ConditionallyCompleteLattice.toInfSet.{u2} R (ConditionallyCompleteLinearOrder.toConditionallyCompleteLattice.{u2} R _inst_1))) (Subtype.{succ u1} S (fun (x : S) => Membership.mem.{u1, u1} S (Finset.{u1} S) (Finset.instMembershipFinset.{u1} S) x s)) (fun (i : Subtype.{succ u1} S (fun (x : S) => Membership.mem.{u1, u1} S (Finset.{u1} S) (Finset.instMembershipFinset.{u1} S) x s)) => Tropical.untrop.{u2} (WithTop.{u2} R) (f (Subtype.val.{succ u1} S (fun (x : S) => Membership.mem.{u1, u1} S (Finset.{u1} S) (Finset.instMembershipFinset.{u1} S) x s) i))))
Case conversion may be inaccurate. Consider using '#align finset.untrop_sum Finset.untrop_sumₓ'. -/
/-- Note we cannot use `i ∈ s` instead of `i : s` here
as it is simply not true on conditionally complete lattices! -/
theorem Finset.untrop_sum [ConditionallyCompleteLinearOrder R] (s : Finset S)
    (f : S → Tropical (WithTop R)) : untrop (∑ i in s, f i) = ⨅ i : s, untrop (f i) := by
  simpa [← untrop_sum] using sum_attach.symm
#align finset.untrop_sum Finset.untrop_sum


import tactic

namespace oculto

-- 1ª demostración de supr_split
lemma supr_split
  {α ι : Type*}
  [complete_lattice α]
  (f : ι → α)
  (p : ι → Prop)
  : (⨆ i, f i) = (⨆ i (h : p i), f i) ⊔ (⨆ i (h : ¬ p i), f i) :=
begin
  have := @supr_union _ _ _ f {i | p i} {i | ¬ p i},
  dsimp at this,
  rw ← this,
  clear this,
  have : ∀ x, (p x ∨ ¬ p x) ↔ true,
    { tauto! },
  congr,
  dsimp,
  ext,
  rw this,
  simp,
end

-- 2ª demostración de supr_split
lemma supr_split_2
  {α ι : Type*}
  [complete_lattice α]
  (f : ι → α)
  (p : ι → Prop)
  : (⨆ i, f i) = (⨆ i (h : p i), f i) ⊔ (⨆ i (h : ¬ p i), f i) :=
by simpa [classical.em] using @supr_union _ _ _ f {i | p i} {i | ¬ p i}

-- 1ª demostración de supr_split_single
lemma supr_split_single
  {α ι : Type*}
  [complete_lattice α]
  (f : ι → α)
  (i₀ : ι)
  : (⨆ i, f i) = f i₀ ⊔ (⨆ i (h : i ≠ i₀), f i) :=
begin
  rw supr_split,
  swap,
    { exact (λ x, x = i₀) },
  congr,
  simp,
end

-- 2ª demostración de supr_split_single
lemma supr_split_single_2
  {α ι : Type*}
  [complete_lattice α]
  (f : ι → α)
  (i₀ : ι) :
  (⨆ i, f i) = f i₀ ⊔ (⨆ i (h : i ≠ i₀), f i) :=
begin
  by convert supr_split _ _; simp
end

end oculto


/-
Copyright (c) 2022 Moritz Doll. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Moritz Doll

! This file was ported from Lean 3 source module analysis.locally_convex.abs_convex
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.LocallyConvex.BalancedCoreHull
import Mathbin.Analysis.LocallyConvex.WithSeminorms
import Mathbin.Analysis.Convex.Gauge

/-!
# Absolutely convex sets

A set is called absolutely convex or disked if it is convex and balanced.
The importance of absolutely convex sets comes from the fact that every locally convex
topological vector space has a basis consisting of absolutely convex sets.

## Main definitions

* `gauge_seminorm_family`: the seminorm family induced by all open absolutely convex neighborhoods
of zero.

## Main statements

* `with_gauge_seminorm_family`: the topology of a locally convex space is induced by the family
`gauge_seminorm_family`.

## Todo

* Define the disked hull

## Tags

disks, convex, balanced
-/

open NormedField Set

open BigOperators NNReal Pointwise Topology

variable {𝕜 E F G ι : Type _}

section NontriviallyNormedField

variable (𝕜 E) {s : Set E}

variable [NontriviallyNormedField 𝕜] [AddCommGroup E] [Module 𝕜 E]

variable [Module ℝ E] [SMulCommClass ℝ 𝕜 E]

variable [TopologicalSpace E] [LocallyConvexSpace ℝ E] [ContinuousSMul 𝕜 E]

theorem nhds_basis_abs_convex :
    (𝓝 (0 : E)).HasBasis (fun s : Set E => s ∈ 𝓝 (0 : E) ∧ Balanced 𝕜 s ∧ Convex ℝ s) id :=
  by
  refine'
    (LocallyConvexSpace.convex_basis_zero ℝ E).to_hasBasis (fun s hs => _) fun s hs =>
      ⟨s, ⟨hs.1, hs.2.2⟩, rfl.subset⟩
  refine' ⟨convexHull ℝ (balancedCore 𝕜 s), _, convexHull_min (balancedCore_subset s) hs.2⟩
  refine' ⟨Filter.mem_of_superset (balancedCore_mem_nhds_zero hs.1) (subset_convexHull ℝ _), _⟩
  refine' ⟨balanced_convexHull_of_balanced (balancedCore_balanced s), _⟩
  exact convex_convexHull ℝ (balancedCore 𝕜 s)
#align nhds_basis_abs_convex nhds_basis_abs_convex

variable [ContinuousSMul ℝ E] [TopologicalAddGroup E]

theorem nhds_basis_abs_convex_open :
    (𝓝 (0 : E)).HasBasis (fun s : Set E => (0 : E) ∈ s ∧ IsOpen s ∧ Balanced 𝕜 s ∧ Convex ℝ s) id :=
  by
  refine' (nhds_basis_abs_convex 𝕜 E).to_hasBasis _ _
  · rintro s ⟨hs_nhds, hs_balanced, hs_convex⟩
    refine' ⟨interior s, _, interior_subset⟩
    exact
      ⟨mem_interior_iff_mem_nhds.mpr hs_nhds, isOpen_interior,
        hs_balanced.interior (mem_interior_iff_mem_nhds.mpr hs_nhds), hs_convex.interior⟩
  rintro s ⟨hs_zero, hs_open, hs_balanced, hs_convex⟩
  exact ⟨s, ⟨hs_open.mem_nhds hs_zero, hs_balanced, hs_convex⟩, rfl.subset⟩
#align nhds_basis_abs_convex_open nhds_basis_abs_convex_open

end NontriviallyNormedField

section AbsolutelyConvexSets

variable [TopologicalSpace E] [AddCommMonoid E] [Zero E] [SeminormedRing 𝕜]

variable [SMul 𝕜 E] [SMul ℝ E]

variable (𝕜 E)

/-- The type of absolutely convex open sets. -/
def AbsConvexOpenSets :=
  { s : Set E // (0 : E) ∈ s ∧ IsOpen s ∧ Balanced 𝕜 s ∧ Convex ℝ s }
#align abs_convex_open_sets AbsConvexOpenSets

instance AbsConvexOpenSets.hasCoe : Coe (AbsConvexOpenSets 𝕜 E) (Set E) :=
  ⟨Subtype.val⟩
#align abs_convex_open_sets.has_coe AbsConvexOpenSets.hasCoe

namespace AbsConvexOpenSets

variable {𝕜 E}

theorem coe_zero_mem (s : AbsConvexOpenSets 𝕜 E) : (0 : E) ∈ (s : Set E) :=
  s.2.1
#align abs_convex_open_sets.coe_zero_mem AbsConvexOpenSets.coe_zero_mem

theorem coe_isOpen (s : AbsConvexOpenSets 𝕜 E) : IsOpen (s : Set E) :=
  s.2.2.1
#align abs_convex_open_sets.coe_is_open AbsConvexOpenSets.coe_isOpen

theorem coe_nhds (s : AbsConvexOpenSets 𝕜 E) : (s : Set E) ∈ 𝓝 (0 : E) :=
  s.coe_isOpen.mem_nhds s.coe_zero_mem
#align abs_convex_open_sets.coe_nhds AbsConvexOpenSets.coe_nhds

theorem coe_balanced (s : AbsConvexOpenSets 𝕜 E) : Balanced 𝕜 (s : Set E) :=
  s.2.2.2.1
#align abs_convex_open_sets.coe_balanced AbsConvexOpenSets.coe_balanced

theorem coe_convex (s : AbsConvexOpenSets 𝕜 E) : Convex ℝ (s : Set E) :=
  s.2.2.2.2
#align abs_convex_open_sets.coe_convex AbsConvexOpenSets.coe_convex

end AbsConvexOpenSets

instance : Nonempty (AbsConvexOpenSets 𝕜 E) :=
  by
  rw [← exists_true_iff_nonempty]
  dsimp only [AbsConvexOpenSets]
  rw [Subtype.exists]
  exact ⟨Set.univ, ⟨mem_univ 0, isOpen_univ, balanced_univ, convex_univ⟩, trivial⟩

end AbsolutelyConvexSets

variable [IsROrC 𝕜]

variable [AddCommGroup E] [TopologicalSpace E]

variable [Module 𝕜 E] [Module ℝ E] [IsScalarTower ℝ 𝕜 E]

variable [ContinuousSMul ℝ E]

variable (𝕜 E)

/-- The family of seminorms defined by the gauges of absolute convex open sets. -/
noncomputable def gaugeSeminormFamily : SeminormFamily 𝕜 E (AbsConvexOpenSets 𝕜 E) := fun s =>
  gaugeSeminorm s.coe_balanced s.coe_convex (absorbent_nhds_zero s.coe_nhds)
#align gauge_seminorm_family gaugeSeminormFamily

variable {𝕜 E}

theorem gaugeSeminormFamily_ball (s : AbsConvexOpenSets 𝕜 E) :
    (gaugeSeminormFamily 𝕜 E s).ball 0 1 = (s : Set E) :=
  by
  dsimp only [gaugeSeminormFamily]
  rw [Seminorm.ball_zero_eq]
  simp_rw [gaugeSeminorm_to_fun]
  exact gauge_lt_one_eq_self_of_open s.coe_convex s.coe_zero_mem s.coe_is_open
#align gauge_seminorm_family_ball gaugeSeminormFamily_ball

variable [TopologicalAddGroup E] [ContinuousSMul 𝕜 E]

variable [SMulCommClass ℝ 𝕜 E] [LocallyConvexSpace ℝ E]

/-- The topology of a locally convex space is induced by the gauge seminorm family. -/
theorem withGaugeSeminormFamily : WithSeminorms (gaugeSeminormFamily 𝕜 E) :=
  by
  refine' SeminormFamily.withSeminormsOfHasBasis _ _
  refine' (nhds_basis_abs_convex_open 𝕜 E).to_hasBasis (fun s hs => _) fun s hs => _
  · refine' ⟨s, ⟨_, rfl.subset⟩⟩
    convert(gaugeSeminormFamily _ _).basisSets_singleton_mem ⟨s, hs⟩ one_pos
    rw [gaugeSeminormFamily_ball, Subtype.coe_mk]
  refine' ⟨s, ⟨_, rfl.subset⟩⟩
  rw [SeminormFamily.basisSets_iff] at hs
  rcases hs with ⟨t, r, hr, rfl⟩
  rw [Seminorm.ball_finset_sup_eq_interᵢ _ _ _ hr]
  -- We have to show that the intersection contains zero, is open, balanced, and convex
  refine'
    ⟨mem_Inter₂.mpr fun _ _ => by simp [Seminorm.mem_ball_zero, hr],
      isOpen_binterᵢ (to_finite _) fun S _ => _,
      balanced_Inter₂ fun _ _ => Seminorm.balanced_ball_zero _ _,
      convex_interᵢ₂ fun _ _ => Seminorm.convex_ball _ _ _⟩
  -- The only nontrivial part is to show that the ball is open
  have hr' : r = ‖(r : 𝕜)‖ * 1 := by simp [abs_of_pos hr]
  have hr'' : (r : 𝕜) ≠ 0 := by simp [hr.ne']
  rw [hr', ← Seminorm.smul_ball_zero hr'', gaugeSeminormFamily_ball]
  exact S.coe_is_open.smul₀ hr''
#align with_gauge_seminorm_family withGaugeSeminormFamily


/-
Copyright (c) 2023 Devon Tuma. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Devon Tuma
-/
import computational_monads.distribution_semantics.defs.independence

/-!
# Distributional Equivalence Between Oracle Computations

This file defines a notion of distributional equivalence between computations.
`dist_equiv oa oa'` (or `oa ≃ₚ oa`) represents two computations for which all values have
the same probability under the denotational semantics provided by `eval_dist`.
Such an equivalence implies equality of `support`, `fin_support`, `eval_dist`, and `prob_event`.
This is especially usefull when it's necessary to avoid "leaving" computations,
as regular probability lemmas will move into the realm of `pmf`, which is sometimes not preferable.

As an example, distribution-wise we have that `⁅g <$> f <$> oa⁆ = ⁅oa⁆.map (g ∘ f)`,
while the equivalence would give `g <$> f <$> oa ≃ₚ (g ∘ f) <$> oa`.
While the former is more specific, it can cause problems when other parts of the proof rely on
using induction on the computation, as this doesn't translate well into `pmf`.
Additionally using the former to talk about e.g. `support` requires additional rewrites to
get the necessary equivalences in terms of sets and not computations.

Note that distributional equivalence is not preserved under simulation via `oracle_comp.simulate`,
as computations with the same distribution may make different oracle calls that are simulated
differently, in term giving computations that behave differently.

TODO: It should be possible to write a tactic similar to `rw` that works for this relation.
As of now, situations requiring `rw` behavior will usually have to apply `dist_equiv.ext` first.
-/

namespace oracle_comp

open oracle_spec
open_locale big_operators ennreal

variables {α β γ : Type} {spec spec' spec'' : oracle_spec}

/-- Equivalence between computations in terms of the associated probability distribution.
Note that the behavior of equivalent computations may still differ in their oracle queries,
and so this equivalence is not in general preserved under `oracle_comp.simulate`. -/
def dist_equiv (oa : oracle_comp spec α) (oa' : oracle_comp spec' α) : Prop := ⁅oa⁆ = ⁅oa'⁆

variables {oa : oracle_comp spec α} {oa' : oracle_comp spec' α} {oa'' : oracle_comp spec'' α}

infix ` ≃ₚ ` : 50 := dist_equiv

lemma dist_equiv.def : oa ≃ₚ oa' ↔ ⁅oa⁆ = ⁅oa'⁆ := iff.rfl

/-- Show that two computations are equivalent by showing every output has the same probability. -/
lemma dist_equiv.ext (h : ∀ x, ⁅= x | oa⁆ = ⁅= x | oa'⁆) : oa ≃ₚ oa' := pmf.ext h

lemma dist_equiv.ext_iff (oa : oracle_comp spec α) (oa' : oracle_comp spec' α) :
  oa ≃ₚ oa' ↔ ∀ x, ⁅= x | oa⁆ = ⁅= x | oa'⁆ :=
⟨λ h x, congr_fun (congr_arg _ h) x, dist_equiv.ext⟩

@[refl] instance dist_equiv.is_refl : is_refl (oracle_comp spec α) dist_equiv := ⟨λ x, rfl⟩

/-- More general than regular `symm`, the two computations may have different `oracle_spec`. -/
lemma dist_equiv.symm (h : oa ≃ₚ oa') : oa' ≃ₚ oa := h.symm

instance dist_equiv.is_symm : is_symm (oracle_comp spec α) dist_equiv := ⟨λ oa oa' h, h.symm⟩

/-- More general than regular `trans`, the three computations may have different `oracle_spec`. -/
@[trans] lemma dist_equiv.trans (h : oa ≃ₚ oa') (h' : oa' ≃ₚ oa'') : oa ≃ₚ oa'' := h.trans h'

instance dist_equiv.is_trans : is_trans (oracle_comp spec α) dist_equiv :=
⟨λ oa oa' oa'' h h', h.trans h'⟩

lemma dist_equiv.support_eq (h : oa ≃ₚ oa') : oa.support = oa'.support :=
(oa.support_eval_dist).symm.trans ((congr_arg pmf.support h).trans oa'.support_eval_dist)

lemma dist_equiv.fin_support_eq [oa.decidable] [oa'.decidable] (h : oa ≃ₚ oa') :
  oa.fin_support = oa'.fin_support :=
(fin_support_eq_fin_support_iff_support_eq_support oa oa').2 h.support_eq

lemma dist_equiv.eval_dist_eq (h : oa ≃ₚ oa') : ⁅oa⁆ = ⁅oa'⁆ := h

lemma dist_equiv.eval_dist_apply_eq (h : oa ≃ₚ oa') (x : α) : ⁅= x | oa⁆ = ⁅= x | oa'⁆ :=
congr_fun (congr_arg _ h) x

lemma dist_equiv.prob_event_eq (h : oa ≃ₚ oa') (e : set α) : ⁅e | oa⁆ = ⁅e | oa'⁆ :=
prob_event_eq_of_eval_dist_eq h.eval_dist_eq e

lemma dist_equiv.indep_events_iff (h : oa ≃ₚ oa') (es es' : set (set α)) :
  oa.indep_events es es' ↔ oa'.indep_events es es' :=
indep_events_iff_of_eval_dist_eq oa oa' es es' h

lemma dist_equiv.indep_event_iff (h : oa ≃ₚ oa') (e e' : set α) :
  oa.indep_event e e' ↔ oa'.indep_event e e' :=
indep_event_iff_of_eval_dist_eq oa oa' e e' h

end oracle_comp


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro, Kevin Buzzard, Yury Kudryashov
-/
import algebra.module.submodule.basic
import algebra.punit_instances

/-!
# The lattice structure on `submodule`s

This file defines the lattice structure on submodules, `submodule.complete_lattice`, with `⊥`
defined as `{0}` and `⊓` defined as intersection of the underlying carrier.
If `p` and `q` are submodules of a module, `p ≤ q` means that `p ⊆ q`.

Many results about operations on this lattice structure are defined in `linear_algebra/basic.lean`,
most notably those which use `span`.

## Implementation notes

This structure should match the `add_submonoid.complete_lattice` structure, and we should try
to unify the APIs where possible.

-/

variables {R S M : Type*}

section add_comm_monoid
variables [semiring R] [semiring S] [add_comm_monoid M] [module R M] [module S M]
variables [has_scalar S R] [is_scalar_tower S R M]
variables {p q : submodule R M}

namespace submodule

/-- The set `{0}` is the bottom element of the lattice of submodules. -/
instance : has_bot (submodule R M) :=
⟨{ carrier := {0}, smul_mem' := by simp { contextual := tt }, .. (⊥ : add_submonoid M)}⟩

instance inhabited' : inhabited (submodule R M) := ⟨⊥⟩

@[simp] lemma bot_coe : ((⊥ : submodule R M) : set M) = {0} := rfl
@[simp] lemma bot_to_add_submonoid : (⊥ : submodule R M).to_add_submonoid = ⊥ := rfl

section
variables (R)
@[simp] lemma restrict_scalars_bot : restrict_scalars S (⊥ : submodule R M) = ⊥ := rfl

@[simp] lemma mem_bot {x : M} : x ∈ (⊥ : submodule R M) ↔ x = 0 := set.mem_singleton_iff
end

@[simp] lemma restrict_scalars_eq_bot_iff {p : submodule R M} :
  restrict_scalars S p = ⊥ ↔ p = ⊥ :=
by simp [set_like.ext_iff]

instance unique_bot : unique (⊥ : submodule R M) :=
⟨infer_instance, λ x, subtype.ext $ (mem_bot R).1 x.mem⟩

instance : order_bot (submodule R M) :=
{ bot := ⊥,
  bot_le := λ p x, by simp [zero_mem] {contextual := tt} }

protected lemma eq_bot_iff (p : submodule R M) : p = ⊥ ↔ ∀ x ∈ p, x = (0 : M) :=
⟨ λ h, h.symm ▸ λ x hx, (mem_bot R).mp hx,
  λ h, eq_bot_iff.mpr (λ x hx, (mem_bot R).mpr (h x hx)) ⟩

@[ext] protected lemma bot_ext (x y : (⊥ : submodule R M)) : x = y :=
begin
  rcases x with ⟨x, xm⟩, rcases y with ⟨y, ym⟩, congr,
  rw (submodule.eq_bot_iff _).mp rfl x xm,
  rw (submodule.eq_bot_iff _).mp rfl y ym,
end

protected lemma ne_bot_iff (p : submodule R M) : p ≠ ⊥ ↔ ∃ x ∈ p, x ≠ (0 : M) :=
by { haveI := classical.prop_decidable, simp_rw [ne.def, p.eq_bot_iff, not_forall] }

lemma nonzero_mem_of_bot_lt {p : submodule R M} (bot_lt : ⊥ < p) : ∃ a : p, a ≠ 0 :=
let ⟨b, hb₁, hb₂⟩ := p.ne_bot_iff.mp bot_lt.ne' in ⟨⟨b, hb₁⟩, hb₂ ∘ (congr_arg coe)⟩

lemma exists_mem_ne_zero_of_ne_bot {p : submodule R M} (h : p ≠ ⊥) : ∃ b : M, b ∈ p ∧ b ≠ 0 :=
let ⟨b, hb₁, hb₂⟩ := p.ne_bot_iff.mp h in ⟨b, hb₁, hb₂⟩

/-- The bottom submodule is linearly equivalent to punit as an `R`-module. -/
@[simps] def bot_equiv_punit : (⊥ : submodule R M) ≃ₗ[R] punit :=
{ to_fun := λ x, punit.star,
  inv_fun := λ x, 0,
  map_add' := by { intros, ext, },
  map_smul' := by { intros, ext, },
  left_inv := by { intro x, ext, },
  right_inv := by { intro x, ext, }, }

lemma eq_bot_of_subsingleton (p : submodule R M) [subsingleton p] : p = ⊥ :=
begin
  rw eq_bot_iff,
  intros v hv,
  exact congr_arg coe (subsingleton.elim (⟨v, hv⟩ : p) 0)
end

/-- The universal set is the top element of the lattice of submodules. -/
instance : has_top (submodule R M) :=
⟨{ carrier := set.univ, smul_mem' := λ _ _ _, trivial, .. (⊤ : add_submonoid M)}⟩

@[simp] lemma top_coe : ((⊤ : submodule R M) : set M) = set.univ := rfl

@[simp] lemma top_to_add_submonoid : (⊤ : submodule R M).to_add_submonoid = ⊤ := rfl

@[simp] lemma mem_top {x : M} : x ∈ (⊤ : submodule R M) := trivial

section
variables (R)
@[simp] lemma restrict_scalars_top : restrict_scalars S (⊤ : submodule R M) = ⊤ := rfl
end

@[simp] lemma restrict_scalars_eq_top_iff {p : submodule R M} :
  restrict_scalars S p = ⊤ ↔ p = ⊤ :=
by simp [set_like.ext_iff]

instance : order_top (submodule R M) :=
{ top := ⊤,
  le_top := λ p x _, trivial }

lemma eq_top_iff' {p : submodule R M} : p = ⊤ ↔ ∀ x, x ∈ p :=
eq_top_iff.trans ⟨λ h x, h trivial, λ h x _, h x⟩

/-- The top submodule is linearly equivalent to the module.

This is the module version of `add_submonoid.top_equiv`. -/
@[simps] def top_equiv : (⊤ : submodule R M) ≃ₗ[R] M :=
{ to_fun := λ x, x,
  inv_fun := λ x, ⟨x, by simp⟩,
  map_add' := by { intros, refl, },
  map_smul' := by { intros, refl, },
  left_inv := by { intro x, ext, refl, },
  right_inv := by { intro x, refl, }, }

instance : has_Inf (submodule R M) :=
⟨λ S,
{ carrier   := ⋂ s ∈ S, (s : set M),
  zero_mem' := by simp [zero_mem],
  add_mem'  := by simp [add_mem] {contextual := tt},
  smul_mem' := by simp [smul_mem] {contextual := tt} }⟩

private lemma Inf_le' {S : set (submodule R M)} {p} : p ∈ S → Inf S ≤ p :=
set.bInter_subset_of_mem

private lemma le_Inf' {S : set (submodule R M)} {p} : (∀q ∈ S, p ≤ q) → p ≤ Inf S :=
set.subset_Inter₂

instance : has_inf (submodule R M) :=
⟨λ p q,
{ carrier   := p ∩ q,
  zero_mem' := by simp [zero_mem],
  add_mem'  := by simp [add_mem] {contextual := tt},
  smul_mem' := by simp [smul_mem] {contextual := tt} }⟩

instance : complete_lattice (submodule R M) :=
{ sup          := λ a b, Inf {x | a ≤ x ∧ b ≤ x},
  le_sup_left  := λ a b, le_Inf' $ λ x ⟨ha, hb⟩, ha,
  le_sup_right := λ a b, le_Inf' $ λ x ⟨ha, hb⟩, hb,
  sup_le       := λ a b c h₁ h₂, Inf_le' ⟨h₁, h₂⟩,
  inf          := (⊓),
  le_inf       := λ a b c, set.subset_inter,
  inf_le_left  := λ a b, set.inter_subset_left _ _,
  inf_le_right := λ a b, set.inter_subset_right _ _,
  Sup          := λtt, Inf {t | ∀t'∈tt, t' ≤ t},
  le_Sup       := λ s p hs, le_Inf' $ λ q hq, hq _ hs,
  Sup_le       := λ s p hs, Inf_le' hs,
  Inf          := Inf,
  le_Inf       := λ s a, le_Inf',
  Inf_le       := λ s a, Inf_le',
  ..submodule.order_top,
  ..submodule.order_bot,
  ..set_like.partial_order }

@[simp] theorem inf_coe : ↑(p ⊓ q) = (p ∩ q : set M) := rfl

@[simp] theorem mem_inf {p q : submodule R M} {x : M} :
  x ∈ p ⊓ q ↔ x ∈ p ∧ x ∈ q := iff.rfl

@[simp]

@[simp] theorem finset_inf_coe {ι} (s : finset ι) (p : ι → submodule R M) :
  (↑(s.inf p) : set M) = ⋂ i ∈ s, ↑(p i) :=
begin
  letI := classical.dec_eq ι,
  refine s.induction_on _ (λ i s hi ih, _),
  { simp },
  { rw [finset.inf_insert, inf_coe, ih],
    simp },
end

@[simp] theorem infi_coe {ι} (p : ι → submodule R M) :
  (↑⨅ i, p i : set M) = ⋂ i, ↑(p i) :=
by rw [infi, Inf_coe]; ext a; simp; exact
⟨λ h i, h _ i rfl, λ h i x e, e ▸ h _⟩

@[simp] lemma mem_Inf {S : set (submodule R M)} {x : M} : x ∈ Inf S ↔ ∀ p ∈ S, x ∈ p :=
set.mem_Inter₂

@[simp] theorem mem_infi {ι} (p : ι → submodule R M) {x} :
  x ∈ (⨅ i, p i) ↔ ∀ i, x ∈ p i :=
by rw [← set_like.mem_coe, infi_coe, set.mem_Inter]; refl

@[simp] theorem mem_finset_inf {ι} {s : finset ι} {p : ι → submodule R M} {x : M} :
  x ∈ s.inf p ↔ ∀ i ∈ s, x ∈ p i :=
by simp only [← set_like.mem_coe, finset_inf_coe, set.mem_Inter]

lemma mem_sup_left {S T : submodule R M} : ∀ {x : M}, x ∈ S → x ∈ S ⊔ T :=
show S ≤ S ⊔ T, from le_sup_left

lemma mem_sup_right {S T : submodule R M} : ∀ {x : M}, x ∈ T → x ∈ S ⊔ T :=
show T ≤ S ⊔ T, from le_sup_right

lemma add_mem_sup {S T : submodule R M} {s t : M} (hs : s ∈ S) (ht : t ∈ T) : s + t ∈ S ⊔ T :=
add_mem (mem_sup_left hs) (mem_sup_right ht)

lemma mem_supr_of_mem {ι : Sort*} {b : M} {p : ι → submodule R M} (i : ι) (h : b ∈ p i) :
  b ∈ (⨆i, p i) :=
have p i ≤ (⨆i, p i) := le_supr p i,
@this b h

open_locale big_operators

lemma sum_mem_supr {ι : Type*} [fintype ι] {f : ι → M} {p : ι → submodule R M}
  (h : ∀ i, f i ∈ p i) :
  ∑ i, f i ∈ ⨆ i, p i :=
sum_mem $ λ i hi, mem_supr_of_mem i (h i)

lemma sum_mem_bsupr {ι : Type*} {s : finset ι} {f : ι → M} {p : ι → submodule R M}
  (h : ∀ i ∈ s, f i ∈ p i) :
  ∑ i in s, f i ∈ ⨆ i ∈ s, p i :=
sum_mem $ λ i hi, mem_supr_of_mem i $ mem_supr_of_mem hi (h i hi)

/-! Note that `submodule.mem_supr` is provided in `linear_algebra/basic.lean`. -/

lemma mem_Sup_of_mem {S : set (submodule R M)} {s : submodule R M}
  (hs : s ∈ S) : ∀ {x : M}, x ∈ s → x ∈ Sup S :=
show s ≤ Sup S, from le_Sup hs

theorem disjoint_def {p p' : submodule R M} :
  disjoint p p' ↔ ∀ x ∈ p, x ∈ p' → x = (0:M) :=
show (∀ x, x ∈ p ∧ x ∈ p' → x ∈ ({0} : set M)) ↔ _, by simp

theorem disjoint_def' {p p' : submodule R M} :
  disjoint p p' ↔ ∀ (x ∈ p) (y ∈ p'), x = y → x = (0:M) :=
disjoint_def.trans ⟨λ h x hx y hy hxy, h x hx $ hxy.symm ▸ hy,
  λ h x hx hx', h _ hx x hx' rfl⟩

lemma eq_zero_of_coe_mem_of_disjoint (hpq : disjoint p q) {a : p} (ha : (a : M) ∈ q) :
  a = 0 :=
by exact_mod_cast disjoint_def.mp hpq a (coe_mem a) ha

end submodule

section nat_submodule

/-- An additive submonoid is equivalent to a ℕ-submodule. -/
def add_submonoid.to_nat_submodule : add_submonoid M ≃o submodule ℕ M :=
{ to_fun := λ S,
  { smul_mem' := λ r s hs, show r • s ∈ S, from nsmul_mem hs _, ..S },
  inv_fun := submodule.to_add_submonoid,
  left_inv := λ ⟨S, _, _⟩, rfl,
  right_inv := λ ⟨S, _, _, _⟩, rfl,
  map_rel_iff' := λ a b, iff.rfl }

@[simp]
lemma add_submonoid.to_nat_submodule_symm :
  ⇑(add_submonoid.to_nat_submodule.symm : _ ≃o add_submonoid M) = submodule.to_add_submonoid := rfl

@[simp]
lemma add_submonoid.coe_to_nat_submodule (S : add_submonoid M) :
  (S.to_nat_submodule : set M) = S := rfl

@[simp]
lemma add_submonoid.to_nat_submodule_to_add_submonoid (S : add_submonoid M) :
  S.to_nat_submodule.to_add_submonoid = S :=
add_submonoid.to_nat_submodule.symm_apply_apply S

@[simp]
lemma submodule.to_add_submonoid_to_nat_submodule (S : submodule ℕ M) :
  S.to_add_submonoid.to_nat_submodule = S :=
add_submonoid.to_nat_submodule.apply_symm_apply S

end nat_submodule

end add_comm_monoid

section int_submodule

variables [add_comm_group M]

/-- An additive subgroup is equivalent to a ℤ-submodule. -/
def add_subgroup.to_int_submodule : add_subgroup M ≃o submodule ℤ M :=
{ to_fun := λ S,
  { smul_mem' := λ r s hs, S.zsmul_mem hs _, ..S},
  inv_fun := submodule.to_add_subgroup,
  left_inv := λ ⟨S, _, _, _⟩, rfl,
  right_inv := λ ⟨S, _, _, _⟩, rfl,
  map_rel_iff' := λ a b, iff.rfl }

@[simp]
lemma add_subgroup.to_int_submodule_symm :
  ⇑(add_subgroup.to_int_submodule.symm : _ ≃o add_subgroup M) = submodule.to_add_subgroup := rfl

@[simp]
lemma add_subgroup.coe_to_int_submodule (S : add_subgroup M) :
  (S.to_int_submodule : set M) = S := rfl

@[simp]
lemma add_subgroup.to_int_submodule_to_add_subgroup (S : add_subgroup M) :
  S.to_int_submodule.to_add_subgroup = S :=
add_subgroup.to_int_submodule.symm_apply_apply S

@[simp]
lemma submodule.to_add_subgroup_to_int_submodule (S : submodule ℤ M) :
  S.to_add_subgroup.to_int_submodule = S :=
add_subgroup.to_int_submodule.apply_symm_apply S

end int_submodule


/-
Copyright (c) 2014 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Jeremy Avigad, Andrew Zipperer

Functions between subsets of finite types, bundled with the domain and range.
-/
import data.set.function
open eq.ops

namespace set

record map {X Y : Type} (a : set X) (b : set Y) := (func : X → Y) (mapsto : maps_to func a b)
attribute map.func [coercion]

namespace map

variables {X Y Z: Type}
variables {a : set X} {b : set Y} {c : set Z}

/- the equivalence relation -/

protected definition equiv [reducible] (f1 f2 : map a b) : Prop := eq_on f1 f2 a

namespace equiv_notation
  infix `~` := map.equiv
end equiv_notation
open equiv_notation

protected theorem equiv.refl (f : map a b) : f ~ f := take x, assume H, rfl

protected theorem equiv.symm {f₁ f₂ : map a b} : f₁ ~ f₂ → f₂ ~ f₁ :=
assume H : f₁ ~ f₂,
take x, assume Ha : x ∈ a, eq.symm (H Ha)

protected theorem equiv.trans {f₁ f₂ f₃ : map a b} : f₁ ~ f₂ → f₂ ~ f₃ → f₁ ~ f₃ :=
assume H₁ : f₁ ~ f₂, assume H₂ : f₂ ~ f₃,
take x, assume Ha : x ∈ a, eq.trans (H₁ Ha) (H₂ Ha)

protected theorem equiv.is_equivalence {X Y : Type} (a : set X) (b : set Y) :
  equivalence (@map.equiv X Y a b) :=
mk_equivalence (@map.equiv X Y a b) (@equiv.refl X Y a b) (@equiv.symm X Y a b)
    (@equiv.trans X Y a b)

/- compose -/

protected definition comp (g : map b c) (f : map a b) : map a c :=
map.mk (#function g ∘ f) (maps_to_comp (mapsto g) (mapsto f))

notation g ∘ f := map.comp g f

/- range -/

protected definition range (f : map a b) : set Y := image f a

theorem range_eq_range_of_equiv {f1 f2 : map a b} (H : f1 ~ f2) : map.range f1 = map.range f2 :=
image_eq_image_of_eq_on H

/- injective -/

protected definition injective (f : map a b) : Prop := inj_on f a

theorem injective_of_equiv {f1 f2 : map a b} (H1 : f1 ~ f2) (H2 : map.injective f1) :
  map.injective f2 :=
inj_on_of_eq_on H1 H2

theorem injective_comp {g : map b c} {f : map a b} (Hg : map.injective g) (Hf: map.injective f) :
  map.injective (g ∘ f) :=
inj_on_comp (mapsto f) Hg Hf

/- surjective -/

protected definition surjective (f : map a b) : Prop := surj_on f a b

theorem surjective_of_equiv {f1 f2 : map a b} (H1 : f1 ~ f2) (H2 : map.surjective f1) :
  map.surjective f2 :=
surj_on_of_eq_on H1 H2

theorem surjective_comp {g : map b c} {f : map a b} (Hg : map.surjective g)
    (Hf: map.surjective f) :
  map.surjective (g ∘ f) :=
surj_on_comp Hg Hf

theorem image_eq_of_surjective {f : map a b} (H : map.surjective f) : f ' a = b :=
image_eq_of_maps_to_of_surj_on (map.mapsto f) H

/- bijective -/

protected definition bijective (f : map a b) : Prop := map.injective f ∧ map.surjective f

theorem bijective_of_equiv {f1 f2 : map a b} (H1 : f1 ~ f2) (H2 : map.bijective f1) :
  map.bijective f2 :=
and.intro (injective_of_equiv H1 (and.left H2)) (surjective_of_equiv H1 (and.right H2))

theorem bijective_comp {g : map b c} {f : map a b} (Hg : map.bijective g) (Hf: map.bijective f) :
  map.bijective (g ∘ f) :=
obtain Hg₁ Hg₂, from Hg,
obtain Hf₁ Hf₂, from Hf,
and.intro (injective_comp Hg₁ Hf₁) (surjective_comp Hg₂ Hf₂)

theorem image_eq_of_bijective {f : map a b} (H : map.bijective f) : f ' a = b :=
image_eq_of_surjective (proof and.right H qed)

/- left inverse -/

-- g is a left inverse to f
protected definition left_inverse (g : map b a) (f : map a b) : Prop := left_inv_on g f a

theorem left_inverse_of_equiv_left {g1 g2 : map b a} {f : map a b} (eqg : g1 ~ g2)
  (H : map.left_inverse g1 f) : map.left_inverse g2 f :=
left_inv_on_of_eq_on_left (mapsto f) eqg H

theorem left_inverse_of_equiv_right {g : map b a} {f1 f2 : map a b} (eqf : f1 ~ f2)
  (H : map.left_inverse g f1) : map.left_inverse g f2 :=
left_inv_on_of_eq_on_right eqf H

theorem injective_of_left_inverse {g : map b a} {f : map a b} (H : map.left_inverse g f) :
  map.injective f :=
inj_on_of_left_inv_on H

theorem left_inverse_comp {f' : map b a} {g' : map c b} {g : map b c} {f : map a b}
    (Hf : map.left_inverse f' f) (Hg : map.left_inverse g' g) :
  map.left_inverse (f' ∘ g') (g ∘ f) :=
begin
  unfold map.left_inverse,
  exact left_inv_on_comp (mapsto f) Hf Hg
end
/- right inverse -/

-- g is a right inverse to f
protected definition right_inverse (g : map b a) (f : map a b) : Prop := map.left_inverse f g

theorem right_inverse_of_equiv_left {g1 g2 : map b a} {f : map a b} (eqg : g1 ~ g2)
  (H : map.right_inverse g1 f) : map.right_inverse g2 f :=
map.left_inverse_of_equiv_right eqg H

theorem right_inverse_of_equiv_right {g : map b a} {f1 f2 : map a b} (eqf : f1 ~ f2)
  (H : map.right_inverse g f1) : map.right_inverse g f2 :=
map.left_inverse_of_equiv_left eqf H

theorem right_inverse_of_injective_of_left_inverse {f : map a b} {g : map b a}
    (injf : map.injective f) (lfg : map.left_inverse f g) :
  map.right_inverse f g :=
right_inv_on_of_inj_on_of_left_inv_on (mapsto f) (mapsto g) injf lfg

theorem surjective_of_right_inverse {g : map b a} {f : map a b} (H : map.right_inverse g f) :
  map.surjective f :=
surj_on_of_right_inv_on (mapsto g) H

theorem left_inverse_of_surjective_of_right_inverse {f : map a b} {g : map b a}
    (surjf : map.surjective f) (rfg : map.right_inverse f g) :
  map.left_inverse f g :=
left_inv_on_of_surj_on_right_inv_on surjf rfg

theorem right_inverse_comp {f' : map b a} {g' : map c b} {g : map b c} {f : map a b}
    (Hf : map.right_inverse f' f) (Hg : map.right_inverse g' g) :
  map.right_inverse (f' ∘ g') (g ∘ f) :=
map.left_inverse_comp Hg Hf

theorem equiv_of_map.left_inverse_of_right_inverse {g1 g2 : map b a} {f : map a b}
  (H1 : map.left_inverse g1 f) (H2 : map.right_inverse g2 f) : g1 ~ g2 :=
eq_on_of_left_inv_of_right_inv (mapsto g2) H1 H2

/- inverse -/

-- g is an inverse to f
protected definition is_inverse (g : map b a) (f : map a b) : Prop :=
map.left_inverse g f ∧ map.right_inverse g f

theorem bijective_of_is_inverse {g : map b a} {f : map a b} (H : map.is_inverse g f) :
  map.bijective f :=
and.intro
  (injective_of_left_inverse (and.left H))
  (surjective_of_right_inverse (and.right H))

end map
end set


/-
Copyright (c) 2022 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser, Jujian Zhang
-/
import algebra.direct_sum.module
import algebra.module.submodule.basic

/-!
# Decompositions of additive monoids, groups, and modules into direct sums

## Main definitions

* `direct_sum.decomposition ℳ`: A typeclass to provide a constructive decomposition from
  an additive monoid `M` into a family of additive submonoids `ℳ`
* `direct_sum.decompose ℳ`: The canonical equivalence provided by the above typeclass

## Main statements

* `direct_sum.decomposition.is_internal`: The link to `direct_sum.is_internal`.

## Implementation details

As we want to talk about different types of decomposition (additive monoids, modules, rings, ...),
we choose to avoid heavily bundling `direct_sum.decompose`, instead making copies for the
`add_equiv`, `linear_equiv`, etc. This means we have to repeat statements that follow from these
bundled homs, but means we don't have to repeat statements for different types of decomposition.
-/

variables {ι R M σ : Type*}
open_locale direct_sum big_operators
namespace direct_sum

section add_comm_monoid
variables [decidable_eq ι] [add_comm_monoid M]
variables [set_like σ M] [add_submonoid_class σ M] (ℳ : ι → σ)

/-- A decomposition is an equivalence between an additive monoid `M` and a direct sum of additive
submonoids `ℳ i` of that `M`, such that the "recomposition" is canonical. This definition also
works for additive groups and modules.

This is a version of `direct_sum.is_internal` which comes with a constructive inverse to the
canonical "recomposition" rather than just a proof that the "recomposition" is bijective. -/
class decomposition :=
(decompose' : M → ⨁ i, ℳ i)
(left_inv : function.left_inverse (direct_sum.coe_add_monoid_hom ℳ) decompose' )
(right_inv : function.right_inverse (direct_sum.coe_add_monoid_hom ℳ) decompose')

include M

/-- `direct_sum.decomposition` instances, while carrying data, are always equal. -/
instance : subsingleton (decomposition ℳ) :=
⟨λ x y, begin
  cases x with x xl xr,
  cases y with y yl yr,
  congr',
  exact function.left_inverse.eq_right_inverse xr yl,
end⟩

variables [decomposition ℳ]

protected lemma decomposition.is_internal : direct_sum.is_internal ℳ :=
⟨decomposition.right_inv.injective, decomposition.left_inv.surjective⟩

/-- If `M` is graded by `ι` with degree `i` component `ℳ i`, then it is isomorphic as
to a direct sum of components. This is the canonical spelling of the `decompose'` field. -/
def decompose : M ≃ ⨁ i, ℳ i :=
{ to_fun := decomposition.decompose',
  inv_fun := direct_sum.coe_add_monoid_hom ℳ,
  left_inv := decomposition.left_inv,
  right_inv := decomposition.right_inv }

protected lemma decomposition.induction_on {p : M → Prop}
  (h_zero : p 0) (h_homogeneous : ∀ {i} (m : ℳ i), p (m : M))
  (h_add : ∀ (m m' : M), p m → p m' → p (m + m')) : ∀ m, p m :=
begin
  let ℳ' : ι → add_submonoid M :=
    λ i, (⟨ℳ i, λ _ _, add_mem_class.add_mem, zero_mem_class.zero_mem _⟩ : add_submonoid M),
  haveI t : direct_sum.decomposition ℳ' :=
  { decompose' := direct_sum.decompose ℳ,
    left_inv := λ _, (decompose ℳ).left_inv _,
    right_inv := λ _, (decompose ℳ).right_inv _, },
  have mem : ∀ m, m ∈ supr ℳ' :=
    λ m, (direct_sum.is_internal.add_submonoid_supr_eq_top ℳ'
      (decomposition.is_internal ℳ')).symm ▸ trivial,
  exact λ m, add_submonoid.supr_induction ℳ' (mem m) (λ i m h, h_homogeneous ⟨m, h⟩) h_zero h_add,
end

@[simp] lemma decomposition.decompose'_eq : decomposition.decompose' = decompose ℳ := rfl

@[simp] lemma decompose_symm_of {i : ι} (x : ℳ i) :
  (decompose ℳ).symm (direct_sum.of _ i x) = x :=
direct_sum.coe_add_monoid_hom_of ℳ _ _

@[simp] lemma decompose_coe {i : ι} (x : ℳ i) :
  decompose ℳ (x : M) = direct_sum.of _ i x :=
by rw [←decompose_symm_of, equiv.apply_symm_apply]

lemma decompose_of_mem {x : M} {i : ι} (hx : x ∈ ℳ i) :
  decompose ℳ x = direct_sum.of (λ i, ℳ i) i ⟨x, hx⟩ :=
decompose_coe _ ⟨x, hx⟩

lemma decompose_of_mem_same {x : M} {i : ι} (hx : x ∈ ℳ i) :
  (decompose ℳ x i : M) = x :=
by rw [decompose_of_mem _ hx, direct_sum.of_eq_same, subtype.coe_mk]

lemma decompose_of_mem_ne {x : M} {i j : ι} (hx : x ∈ ℳ i) (hij : i ≠ j):
  (decompose ℳ x j : M) = 0 :=
by rw [decompose_of_mem _ hx, direct_sum.of_eq_of_ne _ _ _ _ hij,
  zero_mem_class.coe_zero]

/-- If `M` is graded by `ι` with degree `i` component `ℳ i`, then it is isomorphic as
an additive monoid to a direct sum of components. -/
@[simps {fully_applied := ff}]
def decompose_add_equiv : M ≃+ ⨁ i, ℳ i := add_equiv.symm
{ map_add' := map_add (direct_sum.coe_add_monoid_hom ℳ),
  ..(decompose ℳ).symm }

@[simp] lemma decompose_zero : decompose ℳ (0 : M) = 0 := map_zero (decompose_add_equiv ℳ)
@[simp] lemma decompose_symm_zero : (decompose ℳ).symm 0 = (0 : M) :=
map_zero (decompose_add_equiv ℳ).symm

@[simp] lemma decompose_add (x y : M) : decompose ℳ (x + y) = decompose ℳ x + decompose ℳ y :=
map_add (decompose_add_equiv ℳ) x y
@[simp] lemma decompose_symm_add (x y : ⨁ i, ℳ i) :
  (decompose ℳ).symm (x + y) = (decompose ℳ).symm x + (decompose ℳ).symm y :=
map_add (decompose_add_equiv ℳ).symm x y

@[simp] lemma decompose_sum {ι'} (s : finset ι') (f : ι' → M) :
  decompose ℳ (∑ i in s, f i) = ∑ i in s, decompose ℳ (f i) :=
map_sum (decompose_add_equiv ℳ) f s
@[simp] lemma decompose_symm_sum {ι'} (s : finset ι') (f : ι' → ⨁ i, ℳ i) :
  (decompose ℳ).symm (∑ i in s, f i) = ∑ i in s, (decompose ℳ).symm (f i) :=
map_sum (decompose_add_equiv ℳ).symm f s

lemma sum_support_decompose [Π i (x : ℳ i), decidable (x ≠ 0)] (r : M) :
  ∑ i in (decompose ℳ r).support, (decompose ℳ r i : M) = r :=
begin
  conv_rhs { rw [←(decompose ℳ).symm_apply_apply r,
    ←sum_support_of (λ i, (ℳ i)) (decompose ℳ r)] },
  rw [decompose_symm_sum],
  simp_rw decompose_symm_of,
end

end add_comm_monoid

/-- The `-` in the statements below doesn't resolve without this line.

This seems to a be a problem of synthesized vs inferred typeclasses disagreeing. If we replace
the statement of `decompose_neg` with `@eq (⨁ i, ℳ i) (decompose ℳ (-x)) (-decompose ℳ x)`
instead of `decompose ℳ (-x) = -decompose ℳ x`, which forces the typeclasses needed by `⨁ i, ℳ i` to
be found by unification rather than synthesis, then everything works fine without this instance. -/
instance add_comm_group_set_like [add_comm_group M] [set_like σ M] [add_subgroup_class σ M]
  (ℳ : ι → σ) : add_comm_group (⨁ i, ℳ i) := by apply_instance

section add_comm_group
variables [decidable_eq ι] [add_comm_group M]
variables [set_like σ M] [add_subgroup_class σ M] (ℳ : ι → σ)
variables [decomposition ℳ]
include M

@[simp] lemma decompose_neg (x : M) : decompose ℳ (-x) = -decompose ℳ x :=
map_neg (decompose_add_equiv ℳ) x
@[simp] lemma decompose_symm_neg (x : ⨁ i, ℳ i) :
  (decompose ℳ).symm (-x) = -(decompose ℳ).symm x :=
map_neg (decompose_add_equiv ℳ).symm x

@[simp] lemma decompose_sub (x y : M) : decompose ℳ (x - y) = decompose ℳ x - decompose ℳ y :=
map_sub (decompose_add_equiv ℳ) x y
@[simp] lemma decompose_symm_sub (x y : ⨁ i, ℳ i) :
  (decompose ℳ).symm (x - y) = (decompose ℳ).symm x - (decompose ℳ).symm y :=
map_sub (decompose_add_equiv ℳ).symm x y

end add_comm_group

section module
variables [decidable_eq ι] [semiring R] [add_comm_monoid M] [module R M]
variables (ℳ : ι → submodule R M)
variables [decomposition ℳ]
include M

/-- If `M` is graded by `ι` with degree `i` component `ℳ i`, then it is isomorphic as
a module to a direct sum of components. -/
@[simps {fully_applied := ff}]
def decompose_linear_equiv : M ≃ₗ[R] ⨁ i, ℳ i := linear_equiv.symm
{ map_smul' := map_smul (direct_sum.coe_linear_map ℳ),
  ..(decompose_add_equiv ℳ).symm }

@[simp] lemma decompose_smul (r : R) (x : M) : decompose ℳ (r • x) = r • decompose ℳ x :=
map_smul (decompose_linear_equiv ℳ) r x

end module

end direct_sum


/-
Copyright (c) 2021 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn
-/
import logic.function.basic
import tactic.protected
/-!
# Types that are empty

In this file we define a typeclass `is_empty`, which expresses that a type has no elements.

## Main declaration

* `is_empty`: a typeclass that expresses that a type is empty.
-/

variables {α β γ : Sort*}

/-- `is_empty α` expresses that `α` is empty. -/
@[protect_proj]
class is_empty (α : Sort*) : Prop :=
(false : α → false)

instance : is_empty empty   := ⟨empty.elim⟩
instance : is_empty pempty  := ⟨pempty.elim⟩
instance : is_empty false   := ⟨id⟩
instance : is_empty (fin 0) := ⟨λ n, nat.not_lt_zero n.1 n.2⟩

protected lemma function.is_empty [is_empty β] (f : α → β) : is_empty α :=
⟨λ x, is_empty.false (f x)⟩

instance {p : α → Sort*} [h : nonempty α] [∀ x, is_empty (p x)] : is_empty (Π x, p x) :=
h.elim $ λ x, function.is_empty $ function.eval x
instance pprod.is_empty_left [is_empty α] : is_empty (pprod α β) :=
function.is_empty pprod.fst
instance pprod.is_empty_right [is_empty β] : is_empty (pprod α β) :=
function.is_empty pprod.snd
instance prod.is_empty_left {α β} [is_empty α] : is_empty (α × β) :=
function.is_empty prod.fst
instance prod.is_empty_right {α β} [is_empty β] : is_empty (α × β) :=
function.is_empty prod.snd
instance [is_empty α] [is_empty β] : is_empty (psum α β) :=
⟨λ x, psum.rec is_empty.false is_empty.false x⟩
instance {α β} [is_empty α] [is_empty β] : is_empty (α ⊕ β) :=
⟨λ x, sum.rec is_empty.false is_empty.false x⟩
/-- subtypes of an empty type are empty -/
instance [is_empty α] (p : α → Prop) : is_empty (subtype p) :=
⟨λ x, is_empty.false x.1⟩
/-- subtypes by an all-false predicate are false. -/
lemma subtype.is_empty_of_false {p : α → Prop} (hp : ∀ a, ¬(p a)) : is_empty (subtype p) :=
⟨λ x, hp _ x.2⟩
/-- subtypes by false are false. -/
instance subtype.is_empty_false : is_empty {a : α // false} :=
subtype.is_empty_of_false (λ a, id)

instance sigma.is_empty_left {α} [is_empty α] {E : α → Type*} : is_empty (sigma E) :=
function.is_empty sigma.fst

/- Test that `pi.is_empty` finds this instance. -/
example [h : nonempty α] [is_empty β] : is_empty (α → β) := by apply_instance

/-- Eliminate out of a type that `is_empty` (without using projection notation). -/
@[elab_as_eliminator]
def is_empty_elim [is_empty α] {p : α → Sort*} (a : α) : p a :=
(is_empty.false a).elim

lemma is_empty_iff : is_empty α ↔ α → false :=
⟨@is_empty.false α, is_empty.mk⟩

namespace is_empty
open function
/-- Eliminate out of a type that `is_empty` (using projection notation). -/
protected def elim (h : is_empty α) {p : α → Sort*} (a : α) : p a :=
is_empty_elim a

/-- Non-dependent version of `is_empty.elim`. Helpful if the elaborator cannot elaborate `h.elim a`
  correctly. -/
protected def elim' {β : Sort*} (h : is_empty α) (a : α) : β :=
h.elim a

protected lemma prop_iff {p : Prop} : is_empty p ↔ ¬ p :=
is_empty_iff

variables [is_empty α]

lemma forall_iff {p : α → Prop} : (∀ a, p a) ↔ true :=
iff_true_intro is_empty_elim

lemma exists_iff {p : α → Prop} : (∃ a, p a) ↔ false :=
iff_false_intro $ λ ⟨x, hx⟩, is_empty.false x

@[priority 100] -- see Note [lower instance priority]
instance : subsingleton α := ⟨is_empty_elim⟩

end is_empty

@[simp] lemma not_nonempty_iff : ¬ nonempty α ↔ is_empty α :=
⟨λ h, ⟨λ x, h ⟨x⟩⟩, λ h1 h2, h2.elim h1.elim⟩

@[simp] lemma not_is_empty_iff : ¬ is_empty α ↔ nonempty α :=
not_iff_comm.mp not_nonempty_iff

@[simp] lemma is_empty_pi {π : α → Sort*} : is_empty (Π a, π a) ↔ ∃ a, is_empty (π a) :=
by simp only [← not_nonempty_iff, classical.nonempty_pi, not_forall]

@[simp] lemma is_empty_prod {α β : Type*} : is_empty (α × β) ↔ is_empty α ∨ is_empty β :=
by simp only [← not_nonempty_iff, nonempty_prod, not_and_distrib]

@[simp] lemma is_empty_pprod : is_empty (pprod α β) ↔ is_empty α ∨ is_empty β :=
by simp only [← not_nonempty_iff, nonempty_pprod, not_and_distrib]

@[simp] lemma is_empty_sum {α β} : is_empty (α ⊕ β) ↔ is_empty α ∧ is_empty β :=
by simp only [← not_nonempty_iff, nonempty_sum, not_or_distrib]

@[simp] lemma is_empty_psum {α β} : is_empty (psum α β) ↔ is_empty α ∧ is_empty β :=
by simp only [← not_nonempty_iff, nonempty_psum, not_or_distrib]

lemma well_founded_of_empty {α} [is_empty α] (r : α → α → Prop) : well_founded r :=
⟨is_empty_elim⟩

variables (α)

lemma is_empty_or_nonempty : is_empty α ∨ nonempty α :=
(em $ is_empty α).elim or.inl $ or.inr ∘ not_is_empty_iff.mp

@[simp] lemma not_is_empty_of_nonempty [h : nonempty α] : ¬ is_empty α :=
not_is_empty_iff.mpr h

variable {α}

lemma function.extend_of_empty [is_empty α] (f : α → β) (g : α → γ) (h : β → γ) :
  function.extend f g h = h :=
funext $ λ x, function.extend_apply' _ _ _ $ λ ⟨a, h⟩, is_empty_elim a


import .imp
import .var_test

-- a little program: X gets overwritten
def program : cmd :=
  X = [7];
  Y = [8];
  Z = [9];
  X = [10]

-- verify that post state is as expected
def post_env := c_eval program init_env
example : post_env.nat_var_interp X = 10 := rfl
example : post_env.nat_var_interp Y = 8 := rfl
example : post_env.nat_var_interp Z = 9 := rfl

/-
Claim and prove logically that in "program"
post state, X = 10.
-/
  theorem t1 :
    ∀ (post : env), c_sem program init_env post → post.nat_var_interp X = 10 :=
  begin
    assume post,
    assume h,
    cases h,
    cases h_ᾰ_1,
    rw <- h_ᾰ_1_ᾰ,
    cases h_is,
    apply rfl,
  end

-- Exam: fix this proof
  example :
    ∀ (post : env), c_sem program init_env post → post.nat_var_interp Z = 9 :=
  begin
    assume post,
    assume h,
    unfold program at h,
    cases h,
    cases h_ᾰ,
    cases h_ᾰ_ᾰ_1,
    cases h_ᾰ_1,
    rw <- h_ᾰ_1_ᾰ,
    rw <- h_ᾰ_ᾰ_1_ᾰ,
    unfold Z,
    apply rfl,      -- YOU FIX
  end

--

open cmd

def p2 : cmd := ifelse [tt] (X=[1]) (X=[2])
def p3 : cmd := ifelse [ff] (X=[1]) (X=[2])

-- computational testing
example : (c_eval p2 init_env).nat_var_interp X = 1 := rfl
example : (c_eval p3 init_env).nat_var_interp X = 2 := rfl

-- logical verification

example :
  ∀ (e e' : env), c_sem p2 e e' → e'.nat_var_interp X = 1 :=
begin
  unfold p2,
  intros,
  cases ᾰ,
  cases ᾰ_ᾰ,  -- impossible case
  cases ᾰ_ᾰ_1,
  rw <- ᾰ_ᾰ_1_ᾰ,
  cases e,
  exact rfl,
end


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import order.conditionally_complete_lattice
import algebra.big_operators.basic
import algebra.group.prod
import algebra.group.pi
import algebra.module.pi

/-!
# Support of a function

In this file we define `function.support f = {x | f x ≠ 0}` and prove its basic properties.
We also define `function.mul_support f = {x | f x ≠ 1}`.
-/

open set
open_locale big_operators
namespace function

variables {α β A B M N P R S G M₀ G₀ : Type*} {ι : Sort*}

section has_one

variables [has_one M] [has_one N] [has_one P]

/-- `support` of a function is the set of points `x` such that `f x ≠ 0`. -/
def support [has_zero A] (f : α → A) : set α := {x | f x ≠ 0}

/-- `mul_support` of a function is the set of points `x` such that `f x ≠ 1`. -/
@[to_additive] def mul_support (f : α → M) : set α := {x | f x ≠ 1}

@[to_additive] lemma mul_support_eq_preimage (f : α → M) : mul_support f = f ⁻¹' {1}ᶜ := rfl

@[to_additive] lemma nmem_mul_support {f : α → M} {x : α} :
  x ∉ mul_support f ↔ f x = 1 :=
not_not

@[to_additive] lemma compl_mul_support {f : α → M} :
  (mul_support f)ᶜ = {x | f x = 1} :=
ext $ λ x, nmem_mul_support

@[simp, to_additive] lemma mem_mul_support {f : α → M} {x : α} :
  x ∈ mul_support f ↔ f x ≠ 1 :=
iff.rfl

@[simp, to_additive] lemma mul_support_subset_iff {f : α → M} {s : set α} :
  mul_support f ⊆ s ↔ ∀ x, f x ≠ 1 → x ∈ s :=
iff.rfl

@[to_additive] lemma mul_support_subset_iff' {f : α → M} {s : set α} :
  mul_support f ⊆ s ↔ ∀ x ∉ s, f x = 1 :=
forall_congr $ λ x, not_imp_comm

@[simp, to_additive] lemma mul_support_eq_empty_iff {f : α → M} :
  mul_support f = ∅ ↔ f = 1 :=
by { simp_rw [← subset_empty_iff, mul_support_subset_iff', funext_iff], simp }

@[simp, to_additive] lemma mul_support_nonempty_iff {f : α → M} :
  (mul_support f).nonempty ↔ f ≠ 1 :=
by rw [← ne_empty_iff_nonempty, ne.def, mul_support_eq_empty_iff]

@[simp, to_additive] lemma mul_support_one' : mul_support (1 : α → M) = ∅ :=
mul_support_eq_empty_iff.2 rfl

@[simp, to_additive] lemma mul_support_one : mul_support (λ x : α, (1 : M)) = ∅ :=
mul_support_one'

@[to_additive]

@[to_additive] lemma mul_support_binop_subset (op : M → N → P) (op1 : op 1 1 = 1)
  (f : α → M) (g : α → N) :
  mul_support (λ x, op (f x) (g x)) ⊆ mul_support f ∪ mul_support g :=
λ x hx, classical.by_cases
  (λ hf : f x = 1, or.inr $ λ hg, hx $ by simp only [hf, hg, op1])
  or.inl

@[to_additive] lemma mul_support_sup [semilattice_sup M] (f g : α → M) :
  mul_support (λ x, f x ⊔ g x) ⊆ mul_support f ∪ mul_support g :=
mul_support_binop_subset (⊔) sup_idem f g

@[to_additive] lemma mul_support_inf [semilattice_inf M] (f g : α → M) :
  mul_support (λ x, f x ⊓ g x) ⊆ mul_support f ∪ mul_support g :=
mul_support_binop_subset (⊓) inf_idem f g

@[to_additive] lemma mul_support_max [linear_order M] (f g : α → M) :
  mul_support (λ x, max (f x) (g x)) ⊆ mul_support f ∪ mul_support g :=
mul_support_sup f g

@[to_additive] lemma mul_support_min [linear_order M] (f g : α → M) :
  mul_support (λ x, min (f x) (g x)) ⊆ mul_support f ∪ mul_support g :=
mul_support_inf f g

@[to_additive] lemma mul_support_supr [conditionally_complete_lattice M] [nonempty ι]
  (f : ι → α → M) :
  mul_support (λ x, ⨆ i, f i x) ⊆ ⋃ i, mul_support (f i) :=
begin
  rw mul_support_subset_iff',
  simp only [mem_Union, not_exists, nmem_mul_support],
  intros x hx,
  simp only [hx, csupr_const]
end

@[to_additive] lemma mul_support_infi [conditionally_complete_lattice M] [nonempty ι]
  (f : ι → α → M) :
  mul_support (λ x, ⨅ i, f i x) ⊆ ⋃ i, mul_support (f i) :=
@mul_support_supr _ (order_dual M) ι ⟨(1:M)⟩ _ _ f

@[to_additive] lemma mul_support_comp_subset {g : M → N} (hg : g 1 = 1) (f : α → M) :
  mul_support (g ∘ f) ⊆ mul_support f :=
λ x, mt $ λ h, by simp only [(∘), *]

@[to_additive] lemma mul_support_subset_comp {g : M → N} (hg : ∀ {x}, g x = 1 → x = 1)
  (f : α → M) :
  mul_support f ⊆ mul_support (g ∘ f) :=
λ x, mt hg

@[to_additive] lemma mul_support_comp_eq (g : M → N) (hg : ∀ {x}, g x = 1 ↔ x = 1)
  (f : α → M) :
  mul_support (g ∘ f) = mul_support f :=
set.ext $ λ x, not_congr hg

@[to_additive] lemma mul_support_comp_eq_preimage (g : β → M) (f : α → β) :
  mul_support (g ∘ f) = f ⁻¹' mul_support g :=
rfl

@[to_additive support_prod_mk] lemma mul_support_prod_mk (f : α → M) (g : α → N) :
  mul_support (λ x, (f x, g x)) = mul_support f ∪ mul_support g :=
set.ext $ λ x, by simp only [mul_support, not_and_distrib, mem_union_eq, mem_set_of_eq,
  prod.mk_eq_one, ne.def]

@[to_additive support_prod_mk'] lemma mul_support_prod_mk' (f : α → M × N) :
  mul_support f = mul_support (λ x, (f x).1) ∪ mul_support (λ x, (f x).2) :=
by simp only [← mul_support_prod_mk, prod.mk.eta]

@[to_additive] lemma mul_support_along_fiber_subset (f : α × β → M) (a : α) :
  mul_support (λ b, f (a, b)) ⊆ (mul_support f).image prod.snd :=
by tidy

@[simp, to_additive] lemma mul_support_along_fiber_finite_of_finite
  (f : α × β → M) (a : α) (h : (mul_support f).finite) :
  (mul_support (λ b, f (a, b))).finite :=
(h.image prod.snd).subset (mul_support_along_fiber_subset f a)

end has_one

@[to_additive] lemma mul_support_mul [monoid M] (f g : α → M) :
  mul_support (λ x, f x * g x) ⊆ mul_support f ∪ mul_support g :=
mul_support_binop_subset (*) (one_mul _) f g

@[simp, to_additive] lemma mul_support_inv [group G] (f : α → G) :
  mul_support (λ x, (f x)⁻¹) = mul_support f :=
set.ext $ λ x, not_congr inv_eq_one

@[simp, to_additive] lemma mul_support_inv' [group G] (f : α → G) :
  mul_support (f⁻¹) = mul_support f :=
mul_support_inv f

@[simp] lemma mul_support_inv₀ [group_with_zero G₀] (f : α → G₀) :
  mul_support (λ x, (f x)⁻¹) = mul_support f :=
set.ext $ λ x, not_congr inv_eq_one₀

@[to_additive] lemma mul_support_mul_inv [group G] (f g : α → G) :
  mul_support (λ x, f x * (g x)⁻¹) ⊆ mul_support f ∪ mul_support g :=
mul_support_binop_subset (λ a b, a * b⁻¹) (by simp) f g

@[to_additive support_sub] lemma mul_support_group_div [group G] (f g : α → G) :
  mul_support (λ x, f x / g x) ⊆ mul_support f ∪ mul_support g :=
mul_support_binop_subset (/) (by simp only [one_div, one_inv]) f g

lemma mul_support_div [group_with_zero G₀] (f g : α → G₀) :
  mul_support (λ x, f x / g x) ⊆ mul_support f ∪ mul_support g :=
mul_support_binop_subset (/) (by simp only [div_one]) f g

@[simp] lemma support_mul [mul_zero_class R] [no_zero_divisors R] (f g : α → R) :
  support (λ x, f x * g x) = support f ∩ support g :=
set.ext $ λ x, by simp only [mem_support, mul_ne_zero_iff, mem_inter_eq, not_or_distrib]

lemma support_smul_subset_right [add_monoid A] [monoid B] [distrib_mul_action B A]
  (b : B) (f : α → A) :
  support (b • f) ⊆ support f :=
λ x hbf hf, hbf $ by rw [pi.smul_apply, hf, smul_zero]

lemma support_smul_subset_left [semiring R] [add_comm_monoid M] [module R M]
  (f : α → R) (g : α → M) :
  support (f • g) ⊆ support f :=
λ x hfg hf, hfg $ by rw [pi.smul_apply', hf, zero_smul]

lemma support_smul [semiring R] [add_comm_monoid M] [module R M]
  [no_zero_smul_divisors R M] (f : α → R) (g : α → M) :
  support (f • g) = support f ∩ support g :=
ext $ λ x, smul_ne_zero

@[simp] lemma support_inv [group_with_zero G₀] (f : α → G₀) :
  support (λ x, (f x)⁻¹) = support f :=
set.ext $ λ x, not_congr inv_eq_zero

@[simp] lemma support_div [group_with_zero G₀] (f g : α → G₀) :
  support (λ x, f x / g x) = support f ∩ support g :=
by simp [div_eq_mul_inv]

@[to_additive] lemma mul_support_prod [comm_monoid M] (s : finset α) (f : α → β → M) :
  mul_support (λ x, ∏ i in s, f i x) ⊆ ⋃ i ∈ s, mul_support (f i) :=
begin
  rw mul_support_subset_iff',
  simp only [mem_Union, not_exists, nmem_mul_support],
  exact λ x, finset.prod_eq_one
end

lemma support_prod_subset [comm_monoid_with_zero A] (s : finset α) (f : α → β → A) :
  support (λ x, ∏ i in s, f i x) ⊆ ⋂ i ∈ s, support (f i) :=
λ x hx, mem_Inter₂.2 $ λ i hi H, hx $ finset.prod_eq_zero hi H

lemma support_prod [comm_monoid_with_zero A] [no_zero_divisors A] [nontrivial A]
  (s : finset α) (f : α → β → A) :
  support (λ x, ∏ i in s, f i x) = ⋂ i ∈ s, support (f i) :=
set.ext $ λ x, by
  simp only [support, ne.def, finset.prod_eq_zero_iff, mem_set_of_eq, set.mem_Inter, not_exists]

lemma mul_support_one_add [has_one R] [add_left_cancel_monoid R] (f : α → R) :
  mul_support (λ x, 1 + f x) = support f :=
set.ext $ λ x, not_congr add_right_eq_self

lemma mul_support_one_add' [has_one R] [add_left_cancel_monoid R] (f : α → R) :
  mul_support (1 + f) = support f :=
mul_support_one_add f

lemma mul_support_add_one [has_one R] [add_right_cancel_monoid R] (f : α → R) :
  mul_support (λ x, f x + 1) = support f :=
set.ext $ λ x, not_congr add_left_eq_self

lemma mul_support_add_one' [has_one R] [add_right_cancel_monoid R] (f : α → R) :
  mul_support (f + 1) = support f :=
mul_support_add_one f

lemma mul_support_one_sub' [has_one R] [add_group R] (f : α → R) :
  mul_support (1 - f) = support f :=
by rw [sub_eq_add_neg, mul_support_one_add', support_neg']

lemma mul_support_one_sub [has_one R] [add_group R] (f : α → R) :
  mul_support (λ x, 1 - f x) = support f :=
mul_support_one_sub' f

end function

namespace set

open function

variables {α β M : Type*} [has_one M] {f : α → M}

@[to_additive] lemma image_inter_mul_support_eq {s : set β} {g : β → α} :
  (g '' s ∩ mul_support f) = g '' (s ∩ mul_support (f ∘ g)) :=
by rw [mul_support_comp_eq_preimage f g, image_inter_preimage]

end set

namespace pi
variables {A : Type*} {B : Type*} [decidable_eq A] [has_zero B] {a : A} {b : B}

lemma support_single_zero : function.support (pi.single a (0 : B)) = ∅ := by simp

@[simp] lemma support_single_of_ne (h : b ≠ 0) :
  function.support (pi.single a b) = {a} :=
begin
  ext,
  simp only [mem_singleton_iff, ne.def, function.mem_support],
  split,
  { contrapose!,
    exact λ h', single_eq_of_ne h' b },
  { rintro rfl,
    rw single_eq_same,
    exact h }
end

lemma support_single [decidable_eq B] :
  function.support (pi.single a b) = if b = 0 then ∅ else {a} := by { split_ifs with h; simp [h] }

lemma support_single_subset : function.support (pi.single a b) ⊆ {a} :=
begin
  classical,
  rw support_single,
  split_ifs; simp
end

lemma support_single_disjoint {b' : B} (hb : b ≠ 0) (hb' : b' ≠ 0) {i j : A} :
  disjoint (function.support (single i b)) (function.support (single j b')) ↔ i ≠ j :=
by rw [support_single_of_ne hb, support_single_of_ne hb', disjoint_singleton]

end pi


inductive Vec (α : Type u) : Nat → Type u
  | nil  : Vec α 0
  | cons : α → Vec α n → Vec α (n+1)

def Vec.map (xs : Vec α n) (f : α → β) : Vec β n :=
  match xs with
  | nil       => nil
  | cons a as => cons (f a) (map as f)

def Vec.map' (f : α → β) : Vec α n → Vec β n
  | nil       => nil
  | cons a as => cons (f a) (map' f as)

def Vec.map2 (f : α → α → β) : Vec α n → Vec α n → Vec β n
  | nil,       nil       => nil
  | cons a as, cons b bs => cons (f a b) (map2 f as bs)

def Vec.head (xs : Vec α (n+1)) : α :=
  match xs with
  | cons x _ => x

theorem ex1 (xs ys : Vec α (n+1)) (h : xs = ys) : xs.head = ys.head := by
  induction xs -- error, use cases

theorem ex2 (xs ys : Vec α (n+1)) (h : xs = ys) : xs.head = ys.head := by
  cases xs with
  | cons x xs =>
    trace_state -- `h` has been refined
    repeat admit

inductive ExprType where
  | bool  : ExprType
  | nat   : ExprType

inductive Expr : ExprType → Type
  | natVal : Nat → Expr ExprType.nat
  | boolVal : Bool → Expr ExprType.bool
  | eq : Expr α → Expr α → Expr ExprType.bool
  | add : Expr ExprType.nat → Expr ExprType.nat → Expr ExprType.nat

def constProp : Expr α → Expr α
  | Expr.add a b =>
    match constProp a, constProp b with
   | Expr.natVal v, Expr.natVal w => Expr.natVal (v + w)
   | a, b => Expr.add a b
  | e => e

abbrev denoteType : ExprType → Type
  | ExprType.bool => Bool
  | ExprType.nat  => Nat

instance : BEq (denoteType α) where
  beq a b :=
    match α, a, b with
    | ExprType.bool, a, b => a == b
    | ExprType.nat,  a, b => a == b

def eval : Expr α → denoteType α
  | Expr.natVal v  => v
  | Expr.boolVal b => b
  | Expr.eq a b    => eval a == eval b
  | Expr.add a b   => eval a + eval b

theorem ex3 (a b : Expr α) (h : a = b) : eval (constProp a) = eval b := by
  set_option trace.Meta.debug true in
  induction a
  trace_state -- b's type must have been refined, `h` too
  repeat admit