/-
Copyright (c) 2020 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Mario Carneiro

! This file was ported from Lean 3 source module order.well_founded
! leanprover-community/mathlib commit 448144f7ae193a8990cb7473c9e9a01990f64ac7
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Tactic.ByContra
import Mathbin.Data.Set.Image

/-!
# Well-founded relations

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

A relation is well-founded if it can be used for induction: for each `x`, `(∀ y, r y x → P y) → P x`
implies `P x`. Well-founded relations can be used for induction and recursion, including
construction of fixed points in the space of dependent functions `Π x : α , β x`.

The predicate `well_founded` is defined in the core library. In this file we prove some extra lemmas
and provide a few new definitions: `well_founded.min`, `well_founded.sup`, and `well_founded.succ`,
and an induction principle `well_founded.induction_bot`.
-/

variable {α : Type _}

namespace WellFounded

#print WellFounded.isAsymm /-
protected theorem isAsymm {α : Sort _} {r : α → α → Prop} (h : WellFounded r) : IsAsymm α r :=
  ⟨h.asymmetric⟩
#align well_founded.is_asymm WellFounded.isAsymm
-/

instance {α : Sort _} [WellFoundedRelation α] : IsAsymm α WellFoundedRelation.R :=
  WellFoundedRelation.wf.IsAsymm

#print WellFounded.isIrrefl /-
protected theorem isIrrefl {α : Sort _} {r : α → α → Prop} (h : WellFounded r) : IsIrrefl α r :=
  @IsAsymm.isIrrefl α r h.IsAsymm
#align well_founded.is_irrefl WellFounded.isIrrefl
-/

instance {α : Sort _} [WellFoundedRelation α] : IsIrrefl α WellFoundedRelation.R :=
  IsAsymm.isIrrefl

/- warning: well_founded.has_min -> WellFounded.has_min is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {r : α -> α -> Prop}, (WellFounded.{succ u1} α r) -> (forall (s : Set.{u1} α), (Set.Nonempty.{u1} α s) -> (Exists.{succ u1} α (fun (a : α) => Exists.{0} (Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) a s) (fun (H : Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) a s) => forall (x : α), (Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x s) -> (Not (r x a))))))
but is expected to have type
  forall {α : Type.{u1}} {r : α -> α -> Prop}, (WellFounded.{succ u1} α r) -> (forall (s : Set.{u1} α), (Set.Nonempty.{u1} α s) -> (Exists.{succ u1} α (fun (a : α) => And (Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) a s) (forall (x : α), (Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) x s) -> (Not (r x a))))))
Case conversion may be inaccurate. Consider using '#align well_founded.has_min WellFounded.has_minₓ'. -/
/-- If `r` is a well-founded relation, then any nonempty set has a minimal element
with respect to `r`. -/
theorem has_min {α} {r : α → α → Prop} (H : WellFounded r) (s : Set α) :
    s.Nonempty → ∃ a ∈ s, ∀ x ∈ s, ¬r x a
  | ⟨a, ha⟩ =>
    (Acc.recOn (H.apply a) fun x _ IH =>
        not_imp_not.1 fun hne hx => hne <| ⟨x, hx, fun y hy hyx => hne <| IH y hyx hy⟩)
      ha
#align well_founded.has_min WellFounded.has_min

#print WellFounded.min /-
/-- A minimal element of a nonempty set in a well-founded order.

If you're working with a nonempty linear order, consider defining a
`conditionally_complete_linear_order_bot` instance via
`well_founded.conditionally_complete_linear_order_with_bot` and using `Inf` instead. -/
noncomputable def min {r : α → α → Prop} (H : WellFounded r) (s : Set α) (h : s.Nonempty) : α :=
  Classical.choose (H.has_min s h)
#align well_founded.min WellFounded.min
-/

#print WellFounded.min_mem /-
theorem min_mem {r : α → α → Prop} (H : WellFounded r) (s : Set α) (h : s.Nonempty) :
    H.min s h ∈ s :=
  let ⟨h, _⟩ := Classical.choose_spec (H.has_min s h)
  h
#align well_founded.min_mem WellFounded.min_mem
-/

#print WellFounded.not_lt_min /-
theorem not_lt_min {r : α → α → Prop} (H : WellFounded r) (s : Set α) (h : s.Nonempty) {x}
    (hx : x ∈ s) : ¬r x (H.min s h) :=
  let ⟨_, h'⟩ := Classical.choose_spec (H.has_min s h)
  h' _ hx
#align well_founded.not_lt_min WellFounded.not_lt_min
-/

/- warning: well_founded.well_founded_iff_has_min -> WellFounded.wellFounded_iff_has_min is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {r : α -> α -> Prop}, Iff (WellFounded.{succ u1} α r) (forall (s : Set.{u1} α), (Set.Nonempty.{u1} α s) -> (Exists.{succ u1} α (fun (m : α) => Exists.{0} (Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) m s) (fun (H : Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) m s) => forall (x : α), (Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x s) -> (Not (r x m))))))
but is expected to have type
  forall {α : Type.{u1}} {r : α -> α -> Prop}, Iff (WellFounded.{succ u1} α r) (forall (s : Set.{u1} α), (Set.Nonempty.{u1} α s) -> (Exists.{succ u1} α (fun (m : α) => And (Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) m s) (forall (x : α), (Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) x s) -> (Not (r x m))))))
Case conversion may be inaccurate. Consider using '#align well_founded.well_founded_iff_has_min WellFounded.wellFounded_iff_has_minₓ'. -/
theorem wellFounded_iff_has_min {r : α → α → Prop} :
    WellFounded r ↔ ∀ s : Set α, s.Nonempty → ∃ m ∈ s, ∀ x ∈ s, ¬r x m :=
  by
  refine' ⟨fun h => h.has_min, fun h => ⟨fun x => _⟩⟩
  by_contra hx
  obtain ⟨m, hm, hm'⟩ := h _ ⟨x, hx⟩
  refine' hm ⟨_, fun y hy => _⟩
  by_contra hy'
  exact hm' y hy' hy
#align well_founded.well_founded_iff_has_min WellFounded.wellFounded_iff_has_min

#print WellFounded.eq_iff_not_lt_of_le /-
theorem eq_iff_not_lt_of_le {α} [PartialOrder α] {x y : α} : x ≤ y → y = x ↔ ¬x < y :=
  by
  constructor
  · intro xle nge
    cases le_not_le_of_lt nge
    rw [xle left] at nge
    exact lt_irrefl x nge
  · intro ngt xle
    contrapose! ngt
    exact lt_of_le_of_ne xle (Ne.symm ngt)
#align well_founded.eq_iff_not_lt_of_le WellFounded.eq_iff_not_lt_of_le
-/

/- warning: well_founded.well_founded_iff_has_max' -> WellFounded.wellFounded_iff_has_max' is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : PartialOrder.{u1} α], Iff (WellFounded.{succ u1} α (GT.gt.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α _inst_1)))) (forall (p : Set.{u1} α), (Set.Nonempty.{u1} α p) -> (Exists.{succ u1} α (fun (m : α) => Exists.{0} (Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) m p) (fun (H : Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) m p) => forall (x : α), (Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x p) -> (LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α _inst_1)) m x) -> (Eq.{succ u1} α x m)))))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : PartialOrder.{u1} α], Iff (WellFounded.{succ u1} α (fun (x._@.Mathlib.Order.WellFounded._hyg.641 : α) (x._@.Mathlib.Order.WellFounded._hyg.643 : α) => GT.gt.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α _inst_1)) x._@.Mathlib.Order.WellFounded._hyg.641 x._@.Mathlib.Order.WellFounded._hyg.643)) (forall (p : Set.{u1} α), (Set.Nonempty.{u1} α p) -> (Exists.{succ u1} α (fun (m : α) => And (Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) m p) (forall (x : α), (Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) x p) -> (LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α _inst_1)) m x) -> (Eq.{succ u1} α x m)))))
Case conversion may be inaccurate. Consider using '#align well_founded.well_founded_iff_has_max' WellFounded.wellFounded_iff_has_max'ₓ'. -/
theorem wellFounded_iff_has_max' [PartialOrder α] :
    WellFounded ((· > ·) : α → α → Prop) ↔
      ∀ p : Set α, p.Nonempty → ∃ m ∈ p, ∀ x ∈ p, m ≤ x → x = m :=
  by simp only [eq_iff_not_lt_of_le, well_founded_iff_has_min]
#align well_founded.well_founded_iff_has_max' WellFounded.wellFounded_iff_has_max'

/- warning: well_founded.well_founded_iff_has_min' -> WellFounded.wellFounded_iff_has_min' is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : PartialOrder.{u1} α], Iff (WellFounded.{succ u1} α (LT.lt.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α _inst_1)))) (forall (p : Set.{u1} α), (Set.Nonempty.{u1} α p) -> (Exists.{succ u1} α (fun (m : α) => Exists.{0} (Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) m p) (fun (H : Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) m p) => forall (x : α), (Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x p) -> (LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α _inst_1)) x m) -> (Eq.{succ u1} α x m)))))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : PartialOrder.{u1} α], Iff (WellFounded.{succ u1} α (LT.lt.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α _inst_1)))) (forall (p : Set.{u1} α), (Set.Nonempty.{u1} α p) -> (Exists.{succ u1} α (fun (m : α) => And (Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) m p) (forall (x : α), (Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) x p) -> (LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α _inst_1)) x m) -> (Eq.{succ u1} α x m)))))
Case conversion may be inaccurate. Consider using '#align well_founded.well_founded_iff_has_min' WellFounded.wellFounded_iff_has_min'ₓ'. -/
theorem wellFounded_iff_has_min' [PartialOrder α] :
    WellFounded (LT.lt : α → α → Prop) ↔
      ∀ p : Set α, p.Nonempty → ∃ m ∈ p, ∀ x ∈ p, x ≤ m → x = m :=
  @wellFounded_iff_has_max' αᵒᵈ _
#align well_founded.well_founded_iff_has_min' WellFounded.wellFounded_iff_has_min'

open Set

#print WellFounded.sup /-
/-- The supremum of a bounded, well-founded order -/
protected noncomputable def sup {r : α → α → Prop} (wf : WellFounded r) (s : Set α)
    (h : Bounded r s) : α :=
  wf.min { x | ∀ a ∈ s, r a x } h
#align well_founded.sup WellFounded.sup
-/

#print WellFounded.lt_sup /-
protected theorem lt_sup {r : α → α → Prop} (wf : WellFounded r) {s : Set α} (h : Bounded r s) {x}
    (hx : x ∈ s) : r x (wf.sup s h) :=
  min_mem wf { x | ∀ a ∈ s, r a x } h x hx
#align well_founded.lt_sup WellFounded.lt_sup
-/

section

open Classical

#print WellFounded.succ /-
/-- A successor of an element `x` in a well-founded order is a minimal element `y` such that
`x < y` if one exists. Otherwise it is `x` itself. -/
protected noncomputable def succ {r : α → α → Prop} (wf : WellFounded r) (x : α) : α :=
  if h : ∃ y, r x y then wf.min { y | r x y } h else x
#align well_founded.succ WellFounded.succ
-/

#print WellFounded.lt_succ /-
protected theorem lt_succ {r : α → α → Prop} (wf : WellFounded r) {x : α} (h : ∃ y, r x y) :
    r x (wf.succ x) := by
  rw [WellFounded.succ, dif_pos h]
  apply min_mem
#align well_founded.lt_succ WellFounded.lt_succ
-/

end

#print WellFounded.lt_succ_iff /-
protected theorem lt_succ_iff {r : α → α → Prop} [wo : IsWellOrder α r] {x : α} (h : ∃ y, r x y)
    (y : α) : r y (wo.wf.succ x) ↔ r y x ∨ y = x :=
  by
  constructor
  · intro h'
    have : ¬r x y := by
      intro hy
      rw [WellFounded.succ, dif_pos] at h'
      exact wo.wf.not_lt_min _ h hy h'
    rcases trichotomous_of r x y with (hy | hy | hy)
    exfalso
    exact this hy
    right
    exact hy.symm
    left
    exact hy
  rintro (hy | rfl); exact trans hy (wo.wf.lt_succ h); exact wo.wf.lt_succ h
#align well_founded.lt_succ_iff WellFounded.lt_succ_iff
-/

section LinearOrder

variable {β : Type _} [LinearOrder β] (h : WellFounded ((· < ·) : β → β → Prop)) {γ : Type _}
  [PartialOrder γ]

#print WellFounded.min_le /-
theorem min_le {x : β} {s : Set β} (hx : x ∈ s) (hne : s.Nonempty := ⟨x, hx⟩) : h.min s hne ≤ x :=
  not_lt.1 <| h.not_lt_min _ _ hx
#align well_founded.min_le WellFounded.min_le
-/

private theorem eq_strict_mono_iff_eq_range_aux {f g : β → γ} (hf : StrictMono f)
    (hg : StrictMono g) (hfg : Set.range f = Set.range g) {b : β} (H : ∀ a < b, f a = g a) :
    f b ≤ g b :=
  by
  obtain ⟨c, hc⟩ : g b ∈ Set.range f := by
    rw [hfg]
    exact Set.mem_range_self b
  cases' lt_or_le c b with hcb hbc
  · rw [H c hcb] at hc
    rw [hg.injective hc] at hcb
    exact hcb.false.elim
  · rw [← hc]
    exact hf.monotone hbc
#align well_founded.eq_strict_mono_iff_eq_range_aux well_founded.eq_strict_mono_iff_eq_range_aux

include h

/- warning: well_founded.eq_strict_mono_iff_eq_range -> WellFounded.eq_strictMono_iff_eq_range is a dubious translation:
lean 3 declaration is
  forall {β : Type.{u1}} [_inst_1 : LinearOrder.{u1} β], (WellFounded.{succ u1} β (LT.lt.{u1} β (Preorder.toLT.{u1} β (PartialOrder.toPreorder.{u1} β (SemilatticeInf.toPartialOrder.{u1} β (Lattice.toSemilatticeInf.{u1} β (LinearOrder.toLattice.{u1} β _inst_1))))))) -> (forall {γ : Type.{u2}} [_inst_2 : PartialOrder.{u2} γ] {f : β -> γ} {g : β -> γ}, (StrictMono.{u1, u2} β γ (PartialOrder.toPreorder.{u1} β (SemilatticeInf.toPartialOrder.{u1} β (Lattice.toSemilatticeInf.{u1} β (LinearOrder.toLattice.{u1} β _inst_1)))) (PartialOrder.toPreorder.{u2} γ _inst_2) f) -> (StrictMono.{u1, u2} β γ (PartialOrder.toPreorder.{u1} β (SemilatticeInf.toPartialOrder.{u1} β (Lattice.toSemilatticeInf.{u1} β (LinearOrder.toLattice.{u1} β _inst_1)))) (PartialOrder.toPreorder.{u2} γ _inst_2) g) -> (Iff (Eq.{succ u2} (Set.{u2} γ) (Set.range.{u2, succ u1} γ β f) (Set.range.{u2, succ u1} γ β g)) (Eq.{max (succ u1) (succ u2)} (β -> γ) f g)))
but is expected to have type
  forall {β : Type.{u2}} [_inst_1 : LinearOrder.{u2} β], (WellFounded.{succ u2} β (fun (x._@.Mathlib.Order.WellFounded._hyg.1491 : β) (x._@.Mathlib.Order.WellFounded._hyg.1493 : β) => LT.lt.{u2} β (Preorder.toLT.{u2} β (PartialOrder.toPreorder.{u2} β (SemilatticeInf.toPartialOrder.{u2} β (Lattice.toSemilatticeInf.{u2} β (DistribLattice.toLattice.{u2} β (instDistribLattice.{u2} β _inst_1)))))) x._@.Mathlib.Order.WellFounded._hyg.1491 x._@.Mathlib.Order.WellFounded._hyg.1493)) -> (forall {γ : Type.{u1}} [_inst_2 : PartialOrder.{u1} γ] {f : β -> γ} {g : β -> γ}, (StrictMono.{u2, u1} β γ (PartialOrder.toPreorder.{u2} β (SemilatticeInf.toPartialOrder.{u2} β (Lattice.toSemilatticeInf.{u2} β (DistribLattice.toLattice.{u2} β (instDistribLattice.{u2} β _inst_1))))) (PartialOrder.toPreorder.{u1} γ _inst_2) f) -> (StrictMono.{u2, u1} β γ (PartialOrder.toPreorder.{u2} β (SemilatticeInf.toPartialOrder.{u2} β (Lattice.toSemilatticeInf.{u2} β (DistribLattice.toLattice.{u2} β (instDistribLattice.{u2} β _inst_1))))) (PartialOrder.toPreorder.{u1} γ _inst_2) g) -> (Iff (Eq.{succ u1} (Set.{u1} γ) (Set.range.{u1, succ u2} γ β f) (Set.range.{u1, succ u2} γ β g)) (Eq.{max (succ u2) (succ u1)} (β -> γ) f g)))
Case conversion may be inaccurate. Consider using '#align well_founded.eq_strict_mono_iff_eq_range WellFounded.eq_strictMono_iff_eq_rangeₓ'. -/
theorem eq_strictMono_iff_eq_range {f g : β → γ} (hf : StrictMono f) (hg : StrictMono g) :
    Set.range f = Set.range g ↔ f = g :=
  ⟨fun hfg => by
    funext a
    apply h.induction a
    exact fun b H =>
      le_antisymm (eq_strict_mono_iff_eq_range_aux hf hg hfg H)
        (eq_strict_mono_iff_eq_range_aux hg hf hfg.symm fun a hab => (H a hab).symm),
    congr_arg _⟩
#align well_founded.eq_strict_mono_iff_eq_range WellFounded.eq_strictMono_iff_eq_range

#print WellFounded.self_le_of_strictMono /-
theorem self_le_of_strictMono {f : β → β} (hf : StrictMono f) : ∀ n, n ≤ f n :=
  by
  by_contra' h₁
  have h₂ := h.min_mem _ h₁
  exact h.not_lt_min _ h₁ (hf h₂) h₂
#align well_founded.self_le_of_strict_mono WellFounded.self_le_of_strictMono
-/

end LinearOrder

end WellFounded

namespace Function

variable {β : Type _} (f : α → β)

section LT

variable [LT β] (h : WellFounded ((· < ·) : β → β → Prop))

#print Function.argmin /-
/-- Given a function `f : α → β` where `β` carries a well-founded `<`, this is an element of `α`
whose image under `f` is minimal in the sense of `function.not_lt_argmin`. -/
noncomputable def argmin [Nonempty α] : α :=
  WellFounded.min (InvImage.wf f h) Set.univ Set.univ_nonempty
#align function.argmin Function.argmin
-/

/- warning: function.not_lt_argmin -> Function.not_lt_argmin is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} (f : α -> β) [_inst_1 : LT.{u2} β] (h : WellFounded.{succ u2} β (LT.lt.{u2} β _inst_1)) [_inst_2 : Nonempty.{succ u1} α] (a : α), Not (LT.lt.{u2} β _inst_1 (f a) (f (Function.argmin.{u1, u2} α β f _inst_1 h _inst_2)))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} (f : α -> β) [_inst_1 : LT.{u1} β] (h : WellFounded.{succ u1} β (fun (x._@.Mathlib.Order.WellFounded._hyg.1797 : β) (x._@.Mathlib.Order.WellFounded._hyg.1799 : β) => LT.lt.{u1} β _inst_1 x._@.Mathlib.Order.WellFounded._hyg.1797 x._@.Mathlib.Order.WellFounded._hyg.1799)) [_inst_2 : Nonempty.{succ u2} α] (a : α), Not (LT.lt.{u1} β _inst_1 (f a) (f (Function.argmin.{u2, u1} α β f _inst_1 h _inst_2)))
Case conversion may be inaccurate. Consider using '#align function.not_lt_argmin Function.not_lt_argminₓ'. -/
theorem not_lt_argmin [Nonempty α] (a : α) : ¬f a < f (argmin f h) :=
  WellFounded.not_lt_min (InvImage.wf f h) _ _ (Set.mem_univ a)
#align function.not_lt_argmin Function.not_lt_argmin

#print Function.argminOn /-
/-- Given a function `f : α → β` where `β` carries a well-founded `<`, and a non-empty subset `s`
of `α`, this is an element of `s` whose image under `f` is minimal in the sense of
`function.not_lt_argmin_on`. -/
noncomputable def argminOn (s : Set α) (hs : s.Nonempty) : α :=
  WellFounded.min (InvImage.wf f h) s hs
#align function.argmin_on Function.argminOn
-/

/- warning: function.argmin_on_mem -> Function.argminOn_mem is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} (f : α -> β) [_inst_1 : LT.{u2} β] (h : WellFounded.{succ u2} β (LT.lt.{u2} β _inst_1)) (s : Set.{u1} α) (hs : Set.Nonempty.{u1} α s), Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) (Function.argminOn.{u1, u2} α β f _inst_1 h s hs) s
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} (f : α -> β) [_inst_1 : LT.{u1} β] (h : WellFounded.{succ u1} β (fun (x._@.Mathlib.Order.WellFounded._hyg.1905 : β) (x._@.Mathlib.Order.WellFounded._hyg.1907 : β) => LT.lt.{u1} β _inst_1 x._@.Mathlib.Order.WellFounded._hyg.1905 x._@.Mathlib.Order.WellFounded._hyg.1907)) (s : Set.{u2} α) (hs : Set.Nonempty.{u2} α s), Membership.mem.{u2, u2} α (Set.{u2} α) (Set.instMembershipSet.{u2} α) (Function.argminOn.{u2, u1} α β f _inst_1 h s hs) s
Case conversion may be inaccurate. Consider using '#align function.argmin_on_mem Function.argminOn_memₓ'. -/
@[simp]
theorem argminOn_mem (s : Set α) (hs : s.Nonempty) : argminOn f h s hs ∈ s :=
  WellFounded.min_mem _ _ _
#align function.argmin_on_mem Function.argminOn_mem

/- warning: function.not_lt_argmin_on -> Function.not_lt_argminOn is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} (f : α -> β) [_inst_1 : LT.{u2} β] (h : WellFounded.{succ u2} β (LT.lt.{u2} β _inst_1)) (s : Set.{u1} α) {a : α} (ha : Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) a s) (hs : optParam.{0} (Set.Nonempty.{u1} α s) (Set.nonempty_of_mem.{u1} α s a ha)), Not (LT.lt.{u2} β _inst_1 (f a) (f (Function.argminOn.{u1, u2} α β f _inst_1 h s hs)))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} (f : α -> β) [_inst_1 : LT.{u1} β] (h : WellFounded.{succ u1} β (fun (x._@.Mathlib.Order.WellFounded._hyg.1954 : β) (x._@.Mathlib.Order.WellFounded._hyg.1956 : β) => LT.lt.{u1} β _inst_1 x._@.Mathlib.Order.WellFounded._hyg.1954 x._@.Mathlib.Order.WellFounded._hyg.1956)) (s : Set.{u2} α) {a : α} (ha : Membership.mem.{u2, u2} α (Set.{u2} α) (Set.instMembershipSet.{u2} α) a s) (hs : optParam.{0} (Set.Nonempty.{u2} α s) (Set.nonempty_of_mem.{u2} α s a ha)), Not (LT.lt.{u1} β _inst_1 (f a) (f (Function.argminOn.{u2, u1} α β f _inst_1 h s hs)))
Case conversion may be inaccurate. Consider using '#align function.not_lt_argmin_on Function.not_lt_argminOnₓ'. -/
@[simp]
theorem not_lt_argminOn (s : Set α) {a : α} (ha : a ∈ s)
    (hs : s.Nonempty := Set.nonempty_of_mem ha) : ¬f a < f (argminOn f h s hs) :=
  WellFounded.not_lt_min (InvImage.wf f h) s hs ha
#align function.not_lt_argmin_on Function.not_lt_argminOn

end LT

section LinearOrder

variable [LinearOrder β] (h : WellFounded ((· < ·) : β → β → Prop))

/- warning: function.argmin_le -> Function.argmin_le is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} (f : α -> β) [_inst_1 : LinearOrder.{u2} β] (h : WellFounded.{succ u2} β (LT.lt.{u2} β (Preorder.toLT.{u2} β (PartialOrder.toPreorder.{u2} β (SemilatticeInf.toPartialOrder.{u2} β (Lattice.toSemilatticeInf.{u2} β (LinearOrder.toLattice.{u2} β _inst_1))))))) (a : α) [_inst_2 : Nonempty.{succ u1} α], LE.le.{u2} β (Preorder.toLE.{u2} β (PartialOrder.toPreorder.{u2} β (SemilatticeInf.toPartialOrder.{u2} β (Lattice.toSemilatticeInf.{u2} β (LinearOrder.toLattice.{u2} β _inst_1))))) (f (Function.argmin.{u1, u2} α β f (Preorder.toLT.{u2} β (PartialOrder.toPreorder.{u2} β (SemilatticeInf.toPartialOrder.{u2} β (Lattice.toSemilatticeInf.{u2} β (LinearOrder.toLattice.{u2} β _inst_1))))) h _inst_2)) (f a)
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} (f : α -> β) [_inst_1 : LinearOrder.{u1} β] (h : WellFounded.{succ u1} β (fun (x._@.Mathlib.Order.WellFounded._hyg.2060 : β) (x._@.Mathlib.Order.WellFounded._hyg.2062 : β) => LT.lt.{u1} β (Preorder.toLT.{u1} β (PartialOrder.toPreorder.{u1} β (SemilatticeInf.toPartialOrder.{u1} β (Lattice.toSemilatticeInf.{u1} β (DistribLattice.toLattice.{u1} β (instDistribLattice.{u1} β _inst_1)))))) x._@.Mathlib.Order.WellFounded._hyg.2060 x._@.Mathlib.Order.WellFounded._hyg.2062)) (a : α) [_inst_2 : Nonempty.{succ u2} α], LE.le.{u1} β (Preorder.toLE.{u1} β (PartialOrder.toPreorder.{u1} β (SemilatticeInf.toPartialOrder.{u1} β (Lattice.toSemilatticeInf.{u1} β (DistribLattice.toLattice.{u1} β (instDistribLattice.{u1} β _inst_1)))))) (f (Function.argmin.{u2, u1} α β f (Preorder.toLT.{u1} β (PartialOrder.toPreorder.{u1} β (SemilatticeInf.toPartialOrder.{u1} β (Lattice.toSemilatticeInf.{u1} β (DistribLattice.toLattice.{u1} β (instDistribLattice.{u1} β _inst_1)))))) h _inst_2)) (f a)
Case conversion may be inaccurate. Consider using '#align function.argmin_le Function.argmin_leₓ'. -/
@[simp]
theorem argmin_le (a : α) [Nonempty α] : f (argmin f h) ≤ f a :=
  not_lt.mp <| not_lt_argmin f h a
#align function.argmin_le Function.argmin_le

/- warning: function.argmin_on_le -> Function.argminOn_le is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} (f : α -> β) [_inst_1 : LinearOrder.{u2} β] (h : WellFounded.{succ u2} β (LT.lt.{u2} β (Preorder.toLT.{u2} β (PartialOrder.toPreorder.{u2} β (SemilatticeInf.toPartialOrder.{u2} β (Lattice.toSemilatticeInf.{u2} β (LinearOrder.toLattice.{u2} β _inst_1))))))) (s : Set.{u1} α) {a : α} (ha : Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) a s) (hs : optParam.{0} (Set.Nonempty.{u1} α s) (Set.nonempty_of_mem.{u1} α s a ha)), LE.le.{u2} β (Preorder.toLE.{u2} β (PartialOrder.toPreorder.{u2} β (SemilatticeInf.toPartialOrder.{u2} β (Lattice.toSemilatticeInf.{u2} β (LinearOrder.toLattice.{u2} β _inst_1))))) (f (Function.argminOn.{u1, u2} α β f (Preorder.toLT.{u2} β (PartialOrder.toPreorder.{u2} β (SemilatticeInf.toPartialOrder.{u2} β (Lattice.toSemilatticeInf.{u2} β (LinearOrder.toLattice.{u2} β _inst_1))))) h s hs)) (f a)
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} (f : α -> β) [_inst_1 : LinearOrder.{u1} β] (h : WellFounded.{succ u1} β (fun (x._@.Mathlib.Order.WellFounded._hyg.2115 : β) (x._@.Mathlib.Order.WellFounded._hyg.2117 : β) => LT.lt.{u1} β (Preorder.toLT.{u1} β (PartialOrder.toPreorder.{u1} β (SemilatticeInf.toPartialOrder.{u1} β (Lattice.toSemilatticeInf.{u1} β (DistribLattice.toLattice.{u1} β (instDistribLattice.{u1} β _inst_1)))))) x._@.Mathlib.Order.WellFounded._hyg.2115 x._@.Mathlib.Order.WellFounded._hyg.2117)) (s : Set.{u2} α) {a : α} (ha : Membership.mem.{u2, u2} α (Set.{u2} α) (Set.instMembershipSet.{u2} α) a s) (hs : optParam.{0} (Set.Nonempty.{u2} α s) (Set.nonempty_of_mem.{u2} α s a ha)), LE.le.{u1} β (Preorder.toLE.{u1} β (PartialOrder.toPreorder.{u1} β (SemilatticeInf.toPartialOrder.{u1} β (Lattice.toSemilatticeInf.{u1} β (DistribLattice.toLattice.{u1} β (instDistribLattice.{u1} β _inst_1)))))) (f (Function.argminOn.{u2, u1} α β f (Preorder.toLT.{u1} β (PartialOrder.toPreorder.{u1} β (SemilatticeInf.toPartialOrder.{u1} β (Lattice.toSemilatticeInf.{u1} β (DistribLattice.toLattice.{u1} β (instDistribLattice.{u1} β _inst_1)))))) h s hs)) (f a)
Case conversion may be inaccurate. Consider using '#align function.argmin_on_le Function.argminOn_leₓ'. -/
@[simp]
theorem argminOn_le (s : Set α) {a : α} (ha : a ∈ s) (hs : s.Nonempty := Set.nonempty_of_mem ha) :
    f (argminOn f h s hs) ≤ f a :=
  not_lt.mp <| not_lt_argminOn f h s ha hs
#align function.argmin_on_le Function.argminOn_le

end LinearOrder

end Function

section Induction

/- warning: acc.induction_bot' -> Acc.induction_bot' is a dubious translation:
lean 3 declaration is
  forall {α : Sort.{u1}} {β : Sort.{u2}} {r : α -> α -> Prop} {a : α} {bot : α}, (Acc.{u1} α r a) -> (forall {C : β -> Prop} {f : α -> β}, (forall (b : α), (Ne.{u2} β (f b) (f bot)) -> (C (f b)) -> (Exists.{u1} α (fun (c : α) => And (r c b) (C (f c))))) -> (C (f a)) -> (C (f bot)))
but is expected to have type
  forall {α : Sort.{u2}} {β : Sort.{u1}} {r : α -> α -> Prop} {a : α} {bot : α}, (Acc.{u2} α r a) -> (forall {C : β -> Prop} {f : α -> β}, (forall (b : α), (Ne.{u1} β (f b) (f bot)) -> (C (f b)) -> (Exists.{u2} α (fun (c : α) => And (r c b) (C (f c))))) -> (C (f a)) -> (C (f bot)))
Case conversion may be inaccurate. Consider using '#align acc.induction_bot' Acc.induction_bot'ₓ'. -/
/-- Let `r` be a relation on `α`, let `f : α → β` be a function, let `C : β → Prop`, and
let `bot : α`. This induction principle shows that `C (f bot)` holds, given that
* some `a` that is accessible by `r` satisfies `C (f a)`, and
* for each `b` such that `f b ≠ f bot` and `C (f b)` holds, there is `c`
  satisfying `r c b` and `C (f c)`. -/
theorem Acc.induction_bot' {α β} {r : α → α → Prop} {a bot : α} (ha : Acc r a) {C : β → Prop}
    {f : α → β} (ih : ∀ b, f b ≠ f bot → C (f b) → ∃ c, r c b ∧ C (f c)) : C (f a) → C (f bot) :=
  @Acc.recOn _ _ (fun x => C (f x) → C (f bot)) _ ha fun x ac ih' hC =>
    (eq_or_ne (f x) (f bot)).elim (fun h => h ▸ hC) fun h =>
      let ⟨y, hy₁, hy₂⟩ := ih x h hC
      ih' y hy₁ hy₂
#align acc.induction_bot' Acc.induction_bot'

#print Acc.induction_bot /-
/-- Let `r` be a relation on `α`, let `C : α → Prop` and let `bot : α`.
This induction principle shows that `C bot` holds, given that
* some `a` that is accessible by `r` satisfies `C a`, and
* for each `b ≠ bot` such that `C b` holds, there is `c` satisfying `r c b` and `C c`. -/
theorem Acc.induction_bot {α} {r : α → α → Prop} {a bot : α} (ha : Acc r a) {C : α → Prop}
    (ih : ∀ b, b ≠ bot → C b → ∃ c, r c b ∧ C c) : C a → C bot :=
  ha.induction_bot' ih
#align acc.induction_bot Acc.induction_bot
-/

/- warning: well_founded.induction_bot' -> WellFounded.induction_bot' is a dubious translation:
lean 3 declaration is
  forall {α : Sort.{u1}} {β : Sort.{u2}} {r : α -> α -> Prop}, (WellFounded.{u1} α r) -> (forall {a : α} {bot : α} {C : β -> Prop} {f : α -> β}, (forall (b : α), (Ne.{u2} β (f b) (f bot)) -> (C (f b)) -> (Exists.{u1} α (fun (c : α) => And (r c b) (C (f c))))) -> (C (f a)) -> (C (f bot)))
but is expected to have type
  forall {α : Sort.{u2}} {β : Sort.{u1}} {r : α -> α -> Prop}, (WellFounded.{u2} α r) -> (forall {a : α} {bot : α} {C : β -> Prop} {f : α -> β}, (forall (b : α), (Ne.{u1} β (f b) (f bot)) -> (C (f b)) -> (Exists.{u2} α (fun (c : α) => And (r c b) (C (f c))))) -> (C (f a)) -> (C (f bot)))
Case conversion may be inaccurate. Consider using '#align well_founded.induction_bot' WellFounded.induction_bot'ₓ'. -/
/-- Let `r` be a well-founded relation on `α`, let `f : α → β` be a function,
let `C : β → Prop`, and  let `bot : α`.
This induction principle shows that `C (f bot)` holds, given that
* some `a` satisfies `C (f a)`, and
* for each `b` such that `f b ≠ f bot` and `C (f b)` holds, there is `c`
  satisfying `r c b` and `C (f c)`. -/
theorem WellFounded.induction_bot' {α β} {r : α → α → Prop} (hwf : WellFounded r) {a bot : α}
    {C : β → Prop} {f : α → β} (ih : ∀ b, f b ≠ f bot → C (f b) → ∃ c, r c b ∧ C (f c)) :
    C (f a) → C (f bot) :=
  (hwf.apply a).induction_bot' ih
#align well_founded.induction_bot' WellFounded.induction_bot'

#print WellFounded.induction_bot /-
/-- Let `r` be a well-founded relation on `α`, let `C : α → Prop`, and let `bot : α`.
This induction principle shows that `C bot` holds, given that
* some `a` satisfies `C a`, and
* for each `b` that satisfies `C b`, there is `c` satisfying `r c b` and `C c`.

The naming is inspired by the fact that when `r` is transitive, it follows that `bot` is
the smallest element w.r.t. `r` that satisfies `C`. -/
theorem WellFounded.induction_bot {α} {r : α → α → Prop} (hwf : WellFounded r) {a bot : α}
    {C : α → Prop} (ih : ∀ b, b ≠ bot → C b → ∃ c, r c b ∧ C c) : C a → C bot :=
  hwf.induction_bot' ih
#align well_founded.induction_bot WellFounded.induction_bot
-/

end Induction


/-
Copyright (c) 2020 Heather Macbeth. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Heather Macbeth, Yury Kudryashov, Frédéric Dupuis
-/
import topology.algebra.infinite_sum.basic
import topology.algebra.module.basic

/-! # Infinite sums in topological vector spaces -/

variables {ι R R₂ M M₂ : Type*}

section smul_const
variables [semiring R] [topological_space R] [topological_space M] [add_comm_monoid M] [module R M]
  [has_continuous_smul R M] {f : ι → R}

lemma has_sum.smul_const {r : R} (hf : has_sum f r) (a : M) : has_sum (λ z, f z • a) (r • a) :=
hf.map ((smul_add_hom R M).flip a) (continuous_id.smul continuous_const)

lemma summable.smul_const (hf : summable f) (a : M) : summable (λ z, f z • a) :=
(hf.has_sum.smul_const _).summable

lemma tsum_smul_const [t2_space M] (hf : summable f) (a : M) : ∑' z, f z • a = (∑' z, f z) • a :=
(hf.has_sum.smul_const _).tsum_eq

end smul_const

section has_sum

-- Results in this section hold for continuous additive monoid homomorphisms or equivalences but we
-- don't have bundled continuous additive homomorphisms.

variables [semiring R] [semiring R₂] [add_comm_monoid M] [module R M]
  [add_comm_monoid M₂] [module R₂ M₂] [topological_space M] [topological_space M₂]
  {σ : R →+* R₂} {σ' : R₂ →+* R} [ring_hom_inv_pair σ σ'] [ring_hom_inv_pair σ' σ]

/-- Applying a continuous linear map commutes with taking an (infinite) sum. -/
protected lemma continuous_linear_map.has_sum {f : ι → M} (φ : M →SL[σ] M₂) {x : M}
  (hf : has_sum f x) :
  has_sum (λ (b:ι), φ (f b)) (φ x) :=
by simpa only using hf.map φ.to_linear_map.to_add_monoid_hom φ.continuous

alias continuous_linear_map.has_sum ← has_sum.mapL

protected lemma continuous_linear_map.summable {f : ι → M} (φ : M →SL[σ] M₂) (hf : summable f) :
  summable (λ b:ι, φ (f b)) :=
(hf.has_sum.mapL φ).summable

alias continuous_linear_map.summable ← summable.mapL

protected lemma continuous_linear_map.map_tsum [t2_space M₂] {f : ι → M}
  (φ : M →SL[σ] M₂) (hf : summable f) : φ (∑' z, f z) = ∑' z, φ (f z) :=
(hf.has_sum.mapL φ).tsum_eq.symm

include σ'
/-- Applying a continuous linear map commutes with taking an (infinite) sum. -/
protected lemma continuous_linear_equiv.has_sum {f : ι → M} (e : M ≃SL[σ] M₂) {y : M₂} :
  has_sum (λ (b:ι), e (f b)) y ↔ has_sum f (e.symm y) :=
⟨λ h, by simpa only [e.symm.coe_coe, e.symm_apply_apply] using h.mapL (e.symm : M₂ →SL[σ'] M),
  λ h, by simpa only [e.coe_coe, e.apply_symm_apply] using (e : M →SL[σ] M₂).has_sum h⟩

/-- Applying a continuous linear map commutes with taking an (infinite) sum. -/
protected lemma continuous_linear_equiv.has_sum' {f : ι → M} (e : M ≃SL[σ] M₂) {x : M} :
  has_sum (λ (b:ι), e (f b)) (e x) ↔ has_sum f x :=
by rw [e.has_sum, continuous_linear_equiv.symm_apply_apply]

protected lemma continuous_linear_equiv.summable {f : ι → M} (e : M ≃SL[σ] M₂) :
  summable (λ b:ι, e (f b)) ↔ summable f :=
⟨λ hf, (e.has_sum.1 hf.has_sum).summable, (e : M →SL[σ] M₂).summable⟩

lemma continuous_linear_equiv.tsum_eq_iff [t2_space M] [t2_space M₂] {f : ι → M}
  (e : M ≃SL[σ] M₂) {y : M₂} : ∑' z, e (f z) = y ↔ ∑' z, f z = e.symm y :=
begin
  by_cases hf : summable f,
  { exact ⟨λ h, (e.has_sum.mp ((e.summable.mpr hf).has_sum_iff.mpr h)).tsum_eq,
      λ h, (e.has_sum.mpr (hf.has_sum_iff.mpr h)).tsum_eq⟩ },
  { have hf' : ¬summable (λ z, e (f z)) := λ h, hf (e.summable.mp h),
    rw [tsum_eq_zero_of_not_summable hf, tsum_eq_zero_of_not_summable hf'],
    exact ⟨by { rintro rfl, simp }, λ H, by simpa using (congr_arg (λ z, e z) H)⟩ }
end

protected lemma continuous_linear_equiv.map_tsum [t2_space M] [t2_space M₂] {f : ι → M}
  (e : M ≃SL[σ] M₂) : e (∑' z, f z) = ∑' z, e (f z) :=
by { refine symm (e.tsum_eq_iff.mpr _), rw e.symm_apply_apply _ }

end has_sum


/-
Copyright (c) 2018 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad

! This file was ported from Lean 3 source module data.pfunctor.univariate.basic
! leanprover-community/mathlib commit a11f9106a169dd302a285019e5165f8ab32ff433
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.W.Basic

/-!
# Polynomial functors

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

This file defines polynomial functors and the W-type construction as a
polynomial functor.  (For the M-type construction, see
pfunctor/M.lean.)
-/

universe u

#print PFunctor /-
/-- A polynomial functor `P` is given by a type `A` and a family `B` of types over `A`. `P` maps
any type `α` to a new type `P.obj α`, which is defined as the sigma type `Σ x, P.B x → α`.

An element of `P.obj α` is a pair `⟨a, f⟩`, where `a` is an element of a type `A` and
`f : B a → α`. Think of `a` as the shape of the object and `f` as an index to the relevant
elements of `α`.
-/
structure PFunctor where
  A : Type u
  B : A → Type u
#align pfunctor PFunctor
-/

namespace PFunctor

instance : Inhabited PFunctor :=
  ⟨⟨default, default⟩⟩

variable (P : PFunctor) {α β : Type u}

#print PFunctor.Obj /-
/-- Applying `P` to an object of `Type` -/
def Obj (α : Type _) :=
  Σx : P.A, P.B x → α
#align pfunctor.obj PFunctor.Obj
-/

#print PFunctor.map /-
/-- Applying `P` to a morphism of `Type` -/
def map {α β : Type _} (f : α → β) : P.Obj α → P.Obj β := fun ⟨a, g⟩ => ⟨a, f ∘ g⟩
#align pfunctor.map PFunctor.map
-/

#print PFunctor.Obj.inhabited /-
instance Obj.inhabited [Inhabited P.A] [Inhabited α] : Inhabited (P.Obj α) :=
  ⟨⟨default, default⟩⟩
#align pfunctor.obj.inhabited PFunctor.Obj.inhabited
-/

instance : Functor P.Obj where map := @map P

#print PFunctor.map_eq /-
protected theorem map_eq {α β : Type _} (f : α → β) (a : P.A) (g : P.B a → α) :
    @Functor.map P.Obj _ _ _ f ⟨a, g⟩ = ⟨a, f ∘ g⟩ :=
  rfl
#align pfunctor.map_eq PFunctor.map_eq
-/

#print PFunctor.id_map /-
protected theorem id_map {α : Type _} : ∀ x : P.Obj α, id <$> x = id x := fun ⟨a, b⟩ => rfl
#align pfunctor.id_map PFunctor.id_map
-/

#print PFunctor.comp_map /-
protected theorem comp_map {α β γ : Type _} (f : α → β) (g : β → γ) :
    ∀ x : P.Obj α, (g ∘ f) <$> x = g <$> f <$> x := fun ⟨a, b⟩ => rfl
#align pfunctor.comp_map PFunctor.comp_map
-/

instance : LawfulFunctor P.Obj where
  id_map := @PFunctor.id_map P
  comp_map := @PFunctor.comp_map P

#print PFunctor.W /-
/-- re-export existing definition of W-types and
adapt it to a packaged definition of polynomial functor -/
def W :=
  WType P.B
#align pfunctor.W PFunctor.W
-/

/- inhabitants of W types is awkward to encode as an instance
assumption because there needs to be a value `a : P.A`
such that `P.B a` is empty to yield a finite tree -/
attribute [nolint has_nonempty_instance] W

variable {P}

#print PFunctor.W.head /-
/-- root element  of a W tree -/
def W.head : W P → P.A
  | ⟨a, f⟩ => a
#align pfunctor.W.head PFunctor.W.head
-/

#print PFunctor.W.children /-
/-- children of the root of a W tree -/
def W.children : ∀ x : W P, P.B (W.head x) → W P
  | ⟨a, f⟩ => f
#align pfunctor.W.children PFunctor.W.children
-/

#print PFunctor.W.dest /-
/-- destructor for W-types -/
def W.dest : W P → P.Obj (W P)
  | ⟨a, f⟩ => ⟨a, f⟩
#align pfunctor.W.dest PFunctor.W.dest
-/

#print PFunctor.W.mk /-
/-- constructor for W-types -/
def W.mk : P.Obj (W P) → W P
  | ⟨a, f⟩ => ⟨a, f⟩
#align pfunctor.W.mk PFunctor.W.mk
-/

#print PFunctor.W.dest_mk /-
@[simp]
theorem W.dest_mk (p : P.Obj (W P)) : W.dest (W.mk p) = p := by cases p <;> rfl
#align pfunctor.W.dest_mk PFunctor.W.dest_mk
-/

#print PFunctor.W.mk_dest /-
@[simp]
theorem W.mk_dest (p : W P) : W.mk (W.dest p) = p := by cases p <;> rfl
#align pfunctor.W.mk_dest PFunctor.W.mk_dest
-/

variable (P)

#print PFunctor.IdxCat /-
/-- `Idx` identifies a location inside the application of a pfunctor.
For `F : pfunctor`, `x : F.obj α` and `i : F.Idx`, `i` can designate
one part of `x` or is invalid, if `i.1 ≠ x.1` -/
def IdxCat :=
  Σx : P.A, P.B x
#align pfunctor.Idx PFunctor.IdxCat
-/

#print PFunctor.IdxCat.inhabited /-
instance IdxCat.inhabited [Inhabited P.A] [Inhabited (P.B default)] : Inhabited P.IdxCat :=
  ⟨⟨default, default⟩⟩
#align pfunctor.Idx.inhabited PFunctor.IdxCat.inhabited
-/

variable {P}

#print PFunctor.Obj.iget /-
/-- `x.iget i` takes the component of `x` designated by `i` if any is or returns
a default value -/
def Obj.iget [DecidableEq P.A] {α} [Inhabited α] (x : P.Obj α) (i : P.IdxCat) : α :=
  if h : i.1 = x.1 then x.2 (cast (congr_arg _ h) i.2) else default
#align pfunctor.obj.iget PFunctor.Obj.iget
-/

/- warning: pfunctor.fst_map -> PFunctor.fst_map is a dubious translation:
lean 3 declaration is
  forall {P : PFunctor.{u2}} {α : Type.{u1}} {β : Type.{u1}} (x : PFunctor.Obj.{u2, u1} P α) (f : α -> β), Eq.{succ u2} (PFunctor.A.{u2} P) (Sigma.fst.{u2, max u2 u1} (PFunctor.A.{u2} P) (fun (x : PFunctor.A.{u2} P) => (PFunctor.B.{u2} P x) -> β) (Functor.map.{u1, max u2 u1} (fun {α : Type.{u1}} => PFunctor.Obj.{u2, u1} P α) (PFunctor.Obj.functor.{u2, u1} P) α β f x)) (Sigma.fst.{u2, max u2 u1} (PFunctor.A.{u2} P) (fun (x : PFunctor.A.{u2} P) => (PFunctor.B.{u2} P x) -> α) x)
but is expected to have type
  forall {P : PFunctor.{u1}} {α : Type.{u2}} {β : Type.{u2}} (x : PFunctor.Obj.{u1, u2} P α) (f : α -> β), Eq.{succ u1} (PFunctor.A.{u1} P) (Sigma.fst.{u1, max u2 u1} (PFunctor.A.{u1} P) (fun (x : PFunctor.A.{u1} P) => (PFunctor.B.{u1} P x) -> β) (Functor.map.{u2, max u2 u1} (PFunctor.Obj.{u1, u2} P) (PFunctor.instFunctorObj.{u1, u2} P) α β f x)) (Sigma.fst.{u1, max u2 u1} (PFunctor.A.{u1} P) (fun (x : PFunctor.A.{u1} P) => (PFunctor.B.{u1} P x) -> α) x)
Case conversion may be inaccurate. Consider using '#align pfunctor.fst_map PFunctor.fst_mapₓ'. -/
@[simp]
theorem fst_map {α β : Type u} (x : P.Obj α) (f : α → β) : (f <$> x).1 = x.1 := by cases x <;> rfl
#align pfunctor.fst_map PFunctor.fst_map

/- warning: pfunctor.iget_map -> PFunctor.iget_map is a dubious translation:
lean 3 declaration is
  forall {P : PFunctor.{u2}} [_inst_1 : DecidableEq.{succ u2} (PFunctor.A.{u2} P)] {α : Type.{u1}} {β : Type.{u1}} [_inst_2 : Inhabited.{succ u1} α] [_inst_3 : Inhabited.{succ u1} β] (x : PFunctor.Obj.{u2, u1} P α) (f : α -> β) (i : PFunctor.IdxCat.{u2} P), (Eq.{succ u2} (PFunctor.A.{u2} P) (Sigma.fst.{u2, u2} (PFunctor.A.{u2} P) (fun (x : PFunctor.A.{u2} P) => PFunctor.B.{u2} P x) i) (Sigma.fst.{u2, max u2 u1} (PFunctor.A.{u2} P) (fun (x : PFunctor.A.{u2} P) => (PFunctor.B.{u2} P x) -> α) x)) -> (Eq.{succ u1} β (PFunctor.Obj.iget.{u2, u1} P (fun (a : PFunctor.A.{u2} P) (b : PFunctor.A.{u2} P) => _inst_1 a b) β _inst_3 (Functor.map.{u1, max u2 u1} (fun {α : Type.{u1}} => PFunctor.Obj.{u2, u1} P α) (PFunctor.Obj.functor.{u2, u1} P) α β f x) i) (f (PFunctor.Obj.iget.{u2, u1} P (fun (a : PFunctor.A.{u2} P) (b : PFunctor.A.{u2} P) => _inst_1 a b) α _inst_2 x i)))
but is expected to have type
  forall {P : PFunctor.{u1}} [_inst_1 : DecidableEq.{succ u1} (PFunctor.A.{u1} P)] {α : Type.{u2}} {β : Type.{u2}} [_inst_2 : Inhabited.{succ u2} α] [_inst_3 : Inhabited.{succ u2} β] (x : PFunctor.Obj.{u1, u2} P α) (f : α -> β) (i : PFunctor.IdxCat.{u1} P), (Eq.{succ u1} (PFunctor.A.{u1} P) (Sigma.fst.{u1, u1} (PFunctor.A.{u1} P) (fun (x : PFunctor.A.{u1} P) => PFunctor.B.{u1} P x) i) (Sigma.fst.{u1, max u2 u1} (PFunctor.A.{u1} P) (fun (x : PFunctor.A.{u1} P) => (PFunctor.B.{u1} P x) -> α) x)) -> (Eq.{succ u2} β (PFunctor.Obj.iget.{u1, u2} P (fun (a : PFunctor.A.{u1} P) (b : PFunctor.A.{u1} P) => _inst_1 a b) β _inst_3 (Functor.map.{u2, max u2 u1} (PFunctor.Obj.{u1, u2} P) (PFunctor.instFunctorObj.{u1, u2} P) α β f x) i) (f (PFunctor.Obj.iget.{u1, u2} P (fun (a : PFunctor.A.{u1} P) (b : PFunctor.A.{u1} P) => _inst_1 a b) α _inst_2 x i)))
Case conversion may be inaccurate. Consider using '#align pfunctor.iget_map PFunctor.iget_mapₓ'. -/
@[simp]
theorem iget_map [DecidableEq P.A] {α β : Type u} [Inhabited α] [Inhabited β] (x : P.Obj α)
    (f : α → β) (i : P.IdxCat) (h : i.1 = x.1) : (f <$> x).iget i = f (x.iget i) :=
  by
  simp only [obj.iget, fst_map, *, dif_pos, eq_self_iff_true]
  cases x
  rfl
#align pfunctor.iget_map PFunctor.iget_map

end PFunctor

/-
Composition of polynomial functors.
-/
namespace PFunctor

#print PFunctor.comp /-
/-- functor composition for polynomial functors -/
def comp (P₂ P₁ : PFunctor.{u}) : PFunctor.{u} :=
  ⟨Σa₂ : P₂.1, P₂.2 a₂ → P₁.1, fun a₂a₁ => Σu : P₂.2 a₂a₁.1, P₁.2 (a₂a₁.2 u)⟩
#align pfunctor.comp PFunctor.comp
-/

#print PFunctor.comp.mk /-
/-- constructor for composition -/
def comp.mk (P₂ P₁ : PFunctor.{u}) {α : Type} (x : P₂.Obj (P₁.Obj α)) : (comp P₂ P₁).Obj α :=
  ⟨⟨x.1, Sigma.fst ∘ x.2⟩, fun a₂a₁ => (x.2 a₂a₁.1).2 a₂a₁.2⟩
#align pfunctor.comp.mk PFunctor.comp.mk
-/

#print PFunctor.comp.get /-
/-- destructor for composition -/
def comp.get (P₂ P₁ : PFunctor.{u}) {α : Type} (x : (comp P₂ P₁).Obj α) : P₂.Obj (P₁.Obj α) :=
  ⟨x.1.1, fun a₂ => ⟨x.1.2 a₂, fun a₁ => x.2 ⟨a₂, a₁⟩⟩⟩
#align pfunctor.comp.get PFunctor.comp.get
-/

end PFunctor

/-
Lifting predicates and relations.
-/
namespace PFunctor

variable {P : PFunctor.{u}}

open Functor

#print PFunctor.liftp_iff /-
theorem liftp_iff {α : Type u} (p : α → Prop) (x : P.Obj α) :
    Liftp p x ↔ ∃ a f, x = ⟨a, f⟩ ∧ ∀ i, p (f i) :=
  by
  constructor
  · rintro ⟨y, hy⟩
    cases' h : y with a f
    refine' ⟨a, fun i => (f i).val, _, fun i => (f i).property⟩
    rw [← hy, h, PFunctor.map_eq]
  rintro ⟨a, f, xeq, pf⟩
  use ⟨a, fun i => ⟨f i, pf i⟩⟩
  rw [xeq]; rfl
#align pfunctor.liftp_iff PFunctor.liftp_iff
-/

#print PFunctor.liftp_iff' /-
theorem liftp_iff' {α : Type u} (p : α → Prop) (a : P.A) (f : P.B a → α) :
    @Liftp.{u} P.Obj _ α p ⟨a, f⟩ ↔ ∀ i, p (f i) :=
  by
  simp only [liftp_iff, Sigma.mk.inj_iff] <;> constructor <;> intro
  · casesm*Exists _, _ ∧ _
    subst_vars
    assumption
  repeat' first |constructor|assumption
#align pfunctor.liftp_iff' PFunctor.liftp_iff'
-/

#print PFunctor.liftr_iff /-
theorem liftr_iff {α : Type u} (r : α → α → Prop) (x y : P.Obj α) :
    Liftr r x y ↔ ∃ a f₀ f₁, x = ⟨a, f₀⟩ ∧ y = ⟨a, f₁⟩ ∧ ∀ i, r (f₀ i) (f₁ i) :=
  by
  constructor
  · rintro ⟨u, xeq, yeq⟩
    cases' h : u with a f
    use a, fun i => (f i).val.fst, fun i => (f i).val.snd
    constructor
    · rw [← xeq, h]
      rfl
    constructor
    · rw [← yeq, h]
      rfl
    intro i
    exact (f i).property
  rintro ⟨a, f₀, f₁, xeq, yeq, h⟩
  use ⟨a, fun i => ⟨(f₀ i, f₁ i), h i⟩⟩
  constructor
  · rw [xeq]
    rfl
  rw [yeq]; rfl
#align pfunctor.liftr_iff PFunctor.liftr_iff
-/

open Set

#print PFunctor.supp_eq /-
theorem supp_eq {α : Type u} (a : P.A) (f : P.B a → α) :
    @supp.{u} P.Obj _ α (⟨a, f⟩ : P.Obj α) = f '' univ :=
  by
  ext; simp only [supp, image_univ, mem_range, mem_set_of_eq]
  constructor <;> intro h
  · apply @h fun x => ∃ y : P.B a, f y = x
    rw [liftp_iff']
    intro
    refine' ⟨_, rfl⟩
  · simp only [liftp_iff']
    cases h
    subst x
    tauto
#align pfunctor.supp_eq PFunctor.supp_eq
-/

end PFunctor


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

import group_theory.group_action.sub_mul_action

/-!
# Pointwise monoid structures on sub_mul_action

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

This file provides `sub_mul_action.monoid` and weaker typeclasses, which show that `sub_mul_action`s
inherit the same pointwise multiplications as sets.

To match `submodule.idem_semiring`, we do not put these in the `pointwise` locale.

-/

open_locale pointwise

variables {R M : Type*}

namespace sub_mul_action

section has_one
variables [monoid R] [mul_action R M] [has_one M]

instance : has_one (sub_mul_action R M) :=
{ one := { carrier := set.range (λ r : R, r • (1 : M)),
           smul_mem' := λ r m ⟨r', hr'⟩, hr' ▸ ⟨r * r', mul_smul _ _ _⟩ } }

lemma coe_one : ↑(1 : sub_mul_action R M) = set.range (λ r : R, r • (1 : M)) := rfl

@[simp] lemma mem_one {x : M} : x ∈ (1 : sub_mul_action R M) ↔ ∃ r : R, r • 1 = x := iff.rfl

lemma subset_coe_one : (1 : set M) ⊆ (1 : sub_mul_action R M) :=
λ x hx, ⟨1, (one_smul _ _).trans hx.symm⟩

end has_one

section has_mul
variables [monoid R] [mul_action R M] [has_mul M] [is_scalar_tower R M M]

instance : has_mul (sub_mul_action R M) :=
{ mul := λ p q, { carrier := set.image2 (*) p q,
                  smul_mem' := λ r m ⟨m₁, m₂, hm₁, hm₂, h⟩,
                    h ▸ smul_mul_assoc r m₁ m₂ ▸ set.mul_mem_mul (p.smul_mem _ hm₁) hm₂ } }

@[norm_cast] lemma coe_mul (p q : sub_mul_action R M) : ↑(p * q) = (p * q : set M) := rfl

lemma mem_mul {p q : sub_mul_action R M} {x : M} : x ∈ p * q ↔ ∃ y z, y ∈ p ∧ z ∈ q ∧ y * z = x :=
set.mem_mul

end has_mul

section mul_one_class
variables [monoid R] [mul_action R M] [mul_one_class M] [is_scalar_tower R M M]
  [smul_comm_class R M M]

instance : mul_one_class (sub_mul_action R M) :=
{ mul := (*),
  one := 1,
  mul_one := λ a, begin
    ext,
    simp only [mem_mul, mem_one, mul_smul_comm, exists_and_distrib_left, exists_exists_eq_and,
      mul_one],
    split,
    { rintros ⟨y, hy, r, rfl⟩,
      exact smul_mem _ _ hy },
    { intro hx,
      exact ⟨x, hx, 1, one_smul _ _⟩ },
  end,
  one_mul := λ a, begin
    ext,
    simp only [mem_mul, mem_one, smul_mul_assoc, exists_and_distrib_left, exists_exists_eq_and,
      one_mul],
    refine ⟨_, λ hx, ⟨1, x, hx, one_smul _ _⟩⟩,
    rintro ⟨r, y, hy, rfl⟩,
    exact smul_mem _ _ hy,
  end, }

end mul_one_class

section semigroup
variables [monoid R] [mul_action R M] [semigroup M] [is_scalar_tower R M M]

instance : semigroup (sub_mul_action R M) :=
{ mul := (*),
  mul_assoc := λ a b c, set_like.coe_injective (mul_assoc (_ : set _) _ _), }

end semigroup

section monoid
variables [monoid R] [mul_action R M] [monoid M] [is_scalar_tower R M M] [smul_comm_class R M M]

instance : monoid (sub_mul_action R M) :=
{ mul := (*),
  one := 1,
  ..sub_mul_action.semigroup,
  ..sub_mul_action.mul_one_class }

lemma coe_pow (p : sub_mul_action R M) : ∀ {n : ℕ} (hn : n ≠ 0), ↑(p ^ n) = (p ^ n : set M)
| 0 hn := (hn rfl).elim
| 1 hn := by rw [pow_one, pow_one]
| (n + 2) hn := by rw [pow_succ _ (n + 1), pow_succ _ (n + 1), coe_mul, coe_pow (n.succ_ne_zero)]

lemma subset_coe_pow (p : sub_mul_action R M) : ∀ {n : ℕ},
   (p ^ n : set M) ⊆ ↑(p ^ n)
| 0 := by { rw [pow_zero, pow_zero], exact subset_coe_one }
| (n + 1) := (coe_pow p n.succ_ne_zero).superset

end monoid

end sub_mul_action


inductive PList (α : Type) : Prop
| nil
| cons : α → PList α → PList α

infixr:67 " ::: " => PList.cons

def map {α β} (f : α → β) : List α → List β
| []    => []
| a::as => f a :: map f as

def pmap {α β} (f : α → β) : PList α → PList β
| PList.nil => PList.nil
| a:::as => f a ::: pmap f as

theorem ex1 : map Nat.succ [1] = [2] :=
rfl

theorem ex2 : map Nat.succ [] = [] :=
rfl

theorem ex3 (a : Nat) : map Nat.succ [a] = [Nat.succ a] :=
rfl

theorem ex4 {α β} (f : α → β) (a : α) (as : List α) : map f (a::as) = (f a) :: map f as :=
rfl

theorem ex5 {α β} (f : α → β) : map f [] = [] :=
rfl

def map2 {α β} (f : α → β) (as : List α) : List β :=
let rec loop : List α → List β
 | []    => []
 | a::as => f a :: loop as;
loop as

def pmap2 {α β} (f : α → β) (as : PList α) : PList β :=
let rec loop : PList α → PList β
 | PList.nil    => PList.nil
 | a:::as => f a ::: loop as;
loop as

theorem ex6 {α β} (f : α → β) (a : α) (as : List α) : map2 f (a::as) = (f a) :: map2 f as :=
rfl

def foo (xs : List Nat) : List Nat :=
match xs with
| []    => []
| x::xs =>
  let y := 2 * x;
  match xs with
  | []    => []
  | x::xs => (y + x) :: foo xs

def pfoo (xs : PList Nat) : PList Nat :=
match xs with
| PList.nil   => PList.nil
| x:::xs =>
  let y := 2 * x;
  match xs with
  | PList.nil    => PList.nil
  | x:::xs => (y + x) ::: pfoo xs

#eval foo [1, 2, 3, 4]

theorem fooEq (x y : Nat) (xs : List Nat) : foo (x::y::xs) = (2*x + y) :: foo xs :=
rfl

def bla (x : Nat) (ys : List Nat) : List Nat :=
if x % 2 == 0 then
  match ys with
  | []    => []
  | y::ys => (y + x/2) :: bla (x/2) ys
else
  match ys with
  | []    => []
  | y::ys => (y + x/2 + 1) :: bla (x/2) ys

def pbla (x : Nat) (ys : PList Nat) : PList Nat :=
if x % 2 == 0 then
  match ys with
  | PList.nil    => PList.nil
  | y:::ys => (y + x/2) ::: pbla (x/2) ys
else
  match ys with
  | PList.nil    => PList.nil
  | y:::ys => (y + x/2 + 1) ::: pbla (x/2) ys

theorem blaEq (y : Nat) (ys : List Nat) : bla 4 (y::ys) = (y+2) :: bla 2 ys :=
rfl

inductive PNat : Prop
| zero
| succ : PNat → PNat

def f : Nat → Nat → Nat
 | 0, y   => y
 | x+1, y =>
   match f x y with
   | 0 => f x y
   | v => f x v + 1

def pf : PNat → PNat → PNat
 | PNat.zero, y   => y
 | PNat.succ x, y =>
   match pf x y with
   | PNat.zero => pf x y
   | v => PNat.succ $ pf x v

def g (xs : List Nat) : Nat :=
  match xs with
  | [] => 0
  | y::ys =>
    match ys with
    | [] => 1
    | _ => g ys + 1

def pg (xs : PList Nat) : True :=
  match xs with
  | PList.nil => True.intro
  | y:::ys =>
    match ys with
    | PList.nil => True.intro
    | _ => pg ys

def aux : Nat → Nat → Nat
 | 0, y   => y
 | x+1, y =>
   match f x y with
   | 0 => f x y
   | v => f x v + 1

def paux : PNat → PNat → PNat
 | PNat.zero, y   => y
 | PNat.succ x, y =>
   match pf x y with
   | PNat.zero => pf x y
   | v => PNat.succ (pf x v)

theorem ex (x y : Nat) : f x y = aux x y := by
  cases x
  rfl
  rfl

axiom F : Nat → Nat

inductive is_nat : Nat -> Prop
| Z : is_nat 0
| S {n} : is_nat n → is_nat (F n)

inductive is_nat_T : Nat -> Type
| Z : is_nat_T 0
| S {n} : is_nat_T n → is_nat_T (F n)

axiom P : Nat → Prop
axiom F0 : P 0
axiom F1 : P (F 0)
axiom FS {n : Nat} : P n → P (F (F n))

axiom T : Nat → Type
axiom TF0 : T 0
axiom TF1 : T (F 0)
axiom TFS {n : Nat} : T n → T (F (F n))

-- set_option trace.Elab.definition.structural true in
theorem «nested recursion» : ∀ {n}, is_nat n → P n
| _, is_nat.Z => F0
| _, is_nat.S is_nat.Z => F1
| _, is_nat.S (is_nat.S h) => FS («nested recursion» h)

/-- forbidding this, because it shouldn't exist in the first place.
    We don't expect this kind of inconsistent inaccessible patterns. -/
-- theorem «nested recursion, inaccessible» : ∀ {n}, is_nat n → P n
-- | _, .(is_nat.Z) => F0
-- | _, is_nat.S .(is_nat.Z) => F1
-- | _, is_nat.S (is_nat.S h) => FS («nested recursion, inaccessible» h)

theorem «reordered discriminants, type» : ∀ n, is_nat_T n → Nat → T n := fun n hn m =>
match n, m, hn with
| _, _, is_nat_T.Z => TF0
| _, _, is_nat_T.S is_nat_T.Z => TF1
| _, m, is_nat_T.S (is_nat_T.S h) => TFS («reordered discriminants, type» _ h m)

theorem «reordered discriminants» : ∀ n, is_nat n → Nat → P n := fun n hn m =>
match n, m, hn with
| _, _, is_nat.Z => F0
| _, _, is_nat.S is_nat.Z => F1
| _, m, is_nat.S (is_nat.S h) => FS («reordered discriminants» _ h m)

/-- known unsupported case for types, just here for reference. -/
-- def «unsupported nesting» (xs : List Nat) : True :=
--   match xs with
--   | List.nil => True.intro
--   | y::ys =>
--     match ys with
--     | List.nil      => True.intro
--     | _::_::zs      => «unsupported nesting» zs
--     | zs            => «unsupported nesting» ys

def «unsupported nesting, predicate» (xs : PList Nat) : True :=
  match xs with
  | PList.nil => True.intro
  | y:::ys =>
    match ys with
    | PList.nil      => True.intro
    | _:::_:::zs     => «unsupported nesting, predicate» zs
    | zs             => «unsupported nesting, predicate» ys

def f1 (xs : List Nat) : Nat :=
match xs with
| [] => 0
| x::xs =>
  match xs with
  | []  => 0
  | _ => f1 xs + 1

def pf1 (xs : PList Nat) : True :=
match xs with
| PList.nil => True.intro
| x:::xs =>
  match xs with
  | PList.nil  => True.intro
  | _ => pf1 xs


/-
Copyright (c) 2014 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Leonardo de Moura, Jeremy Avigad, Haitao Zhang

General operations on functions.
-/
prelude
import init.prod init.funext init.logic

namespace function

variables {A : Type} {B : Type} {C : Type} {D : Type} {E : Type}

definition comp [reducible] [unfold_full] (f : B → C) (g : A → B) : A → C :=
λx, f (g x)

definition comp_right [reducible] [unfold_full] (f : B → B → B) (g : A → B) : B → A → B :=
λ b a, f b (g a)

definition comp_left [reducible] [unfold_full] (f : B → B → B) (g : A → B) : A → B → B :=
λ a b, f (g a) b

definition on_fun [reducible] [unfold_full] (f : B → B → C) (g : A → B) : A → A → C :=
λx y, f (g x) (g y)

definition combine [reducible] [unfold_full] (f : A → B → C) (op : C → D → E) (g : A → B → D)
  : A → B → E :=
λx y, op (f x y) (g x y)

definition const [reducible] [unfold_full] (B : Type) (a : A) : B → A :=
λx, a

definition dcomp [reducible] [unfold_full] {B : A → Type} {C : Π {x : A}, B x → Type}
  (f : Π {x : A} (y : B x), C y) (g : Πx, B x) : Πx, C (g x) :=
λx, f (g x)

definition swap [reducible] [unfold_full] {C : A → B → Type} (f : Πx y, C x y) : Πy x, C x y :=
λy x, f x y

definition app [reducible] {B : A → Type} (f : Πx, B x) (x : A) : B x :=
f x

definition curry [reducible] [unfold_full] : (A × B → C) → A → B → C :=
λ f a b, f (a, b)

definition uncurry [reducible] [unfold 5] : (A → B → C) → (A × B → C) :=
λ f p, match p with (a, b) := f a b end

theorem curry_uncurry (f : A → B → C) : curry (uncurry f) = f :=
rfl

theorem uncurry_curry (f : A × B → C) : uncurry (curry f) = f :=
funext (λ p, match p with (a, b) := rfl end)

infixr  ` ∘ `            := comp
infixr  ` ∘' `:60        := dcomp
infixl  ` on `:1         := on_fun
infixr  ` $ `:1          := app
notation f ` -[` op `]- ` g  := combine f op g

lemma left_id (f : A → B) : id ∘ f = f := rfl

lemma right_id (f : A → B) : f ∘ id = f := rfl

theorem comp.assoc (f : C → D) (g : B → C) (h : A → B) : (f ∘ g) ∘ h = f ∘ (g ∘ h) := rfl

theorem comp.left_id (f : A → B) : id ∘ f = f := rfl

theorem comp.right_id (f : A → B) : f ∘ id = f := rfl

theorem comp_const_right (f : B → C) (b : B) : f ∘ (const A b) = const A (f b) := rfl

definition injective [reducible] (f : A → B) : Prop := ∀ ⦃a₁ a₂⦄, f a₁ = f a₂ → a₁ = a₂

theorem injective_comp {g : B → C} {f : A → B} (Hg : injective g) (Hf : injective f) :
  injective (g ∘ f) :=
take a₁ a₂, assume Heq, Hf (Hg Heq)

definition surjective [reducible] (f : A → B) : Prop := ∀ b, ∃ a, f a = b

theorem surjective_comp {g : B → C} {f : A → B} (Hg : surjective g) (Hf : surjective f) :
  surjective (g ∘ f) :=
take c,
  obtain b (Hb : g b = c), from Hg c,
  obtain a (Ha : f a = b), from Hf b,
  exists.intro a (eq.trans (congr_arg g Ha) Hb)

definition bijective (f : A → B) := injective f ∧ surjective f

theorem bijective_comp {g : B → C} {f : A → B} (Hg : bijective g) (Hf : bijective f) :
  bijective (g ∘ f) :=
obtain Hginj Hgsurj, from Hg,
obtain Hfinj Hfsurj, from Hf,
and.intro (injective_comp Hginj Hfinj) (surjective_comp Hgsurj Hfsurj)

-- g is a left inverse to f
definition left_inverse (g : B → A) (f : A → B) : Prop := ∀x, g (f x) = x

definition id_of_left_inverse {g : B → A} {f : A → B} : left_inverse g f → g ∘ f = id :=
assume h, funext h

definition has_left_inverse (f : A → B) : Prop := ∃ finv : B → A, left_inverse finv f

-- g is a right inverse to f
definition right_inverse (g : B → A) (f : A → B) : Prop := left_inverse f g

definition id_of_right_inverse {g : B → A} {f : A → B} : right_inverse g f → f ∘ g = id :=
assume h, funext h

definition has_right_inverse (f : A → B) : Prop := ∃ finv : B → A, right_inverse finv f

theorem injective_of_left_inverse {g : B → A} {f : A → B} : left_inverse g f → injective f :=
assume h, take a b, assume faeqfb,
calc a = g (f a) : by rewrite h
   ... = g (f b) : faeqfb
   ... = b       : by rewrite h

theorem injective_of_has_left_inverse {f : A → B} : has_left_inverse f → injective f :=
assume h, obtain (finv : B → A) (inv : left_inverse finv f), from h,
injective_of_left_inverse inv

theorem right_inverse_of_injective_of_left_inverse {f : A → B} {g : B → A}
    (injf : injective f) (lfg : left_inverse f g) :
  right_inverse f g :=
take x,
have H : f (g (f x)) = f x, from lfg (f x),
injf H

theorem surjective_of_has_right_inverse {f : A → B} : has_right_inverse f → surjective f :=
assume h, take b,
obtain (finv : B → A) (inv : right_inverse finv f), from h,
let  a : A := finv b in
have h : f a = b, from calc
  f a  = (f ∘ finv) b : rfl
   ... = id b         : by rewrite inv
   ... = b            : rfl,
exists.intro a h

theorem left_inverse_of_surjective_of_right_inverse {f : A → B} {g : B → A}
    (surjf : surjective f) (rfg : right_inverse f g) :
  left_inverse f g :=
take y,
obtain x (Hx : f x = y), from surjf y,
calc
  f (g y) = f (g (f x)) : Hx
      ... = f x         : rfg
      ... = y           : Hx

theorem injective_id : injective (@id A) := take a₁ a₂ H, H

theorem surjective_id : surjective (@id A) := take a, exists.intro a rfl

theorem bijective_id : bijective (@id A) := and.intro injective_id surjective_id

end function

-- copy reducible annotations to top-level
export [reducible] [unfold] function


/-
Copyright (c) 2020 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin, Robert Y. Lewis
-/

import field_theory.finite.polynomial
import number_theory.basic
import ring_theory.witt_vector.witt_polynomial

/-!
# Witt structure polynomials

In this file we prove the main theorem that makes the whole theory of Witt vectors work.
Briefly, consider a polynomial `Φ : mv_polynomial idx ℤ` over the integers,
with polynomials variables indexed by an arbitrary type `idx`.

Then there exists a unique family of polynomials `φ : ℕ → mv_polynomial (idx × ℕ) Φ`
such that for all `n : ℕ` we have (`witt_structure_int_exists_unique`)
```
bind₁ φ (witt_polynomial p ℤ n) = bind₁ (λ i, (rename (prod.mk i) (witt_polynomial p ℤ n))) Φ
```
In other words: evaluating the `n`-th Witt polynomial on the family `φ`
is the same as evaluating `Φ` on the (appropriately renamed) `n`-th Witt polynomials.

N.b.: As far as we know, these polynomials do not have a name in the literature,
so we have decided to call them the “Witt structure polynomials”. See `witt_structure_int`.

## Special cases

With the main result of this file in place, we apply it to certain special polynomials.
For example, by taking `Φ = X tt + X ff` resp. `Φ = X tt * X ff`
we obtain families of polynomials `witt_add` resp. `witt_mul`
(with type `ℕ → mv_polynomial (bool × ℕ) ℤ`) that will be used in later files to define the
addition and multiplication on the ring of Witt vectors.

## Outline of the proof

The proof of `witt_structure_int_exists_unique` is rather technical, and takes up most of this file.

We start by proving the analogous version for polynomials with rational coefficients,
instead of integer coefficients.
In this case, the solution is rather easy,
since the Witt polynomials form a faithful change of coordinates
in the polynomial ring `mv_polynomial ℕ ℚ`.
We therefore obtain a family of polynomials `witt_structure_rat Φ`
for every `Φ : mv_polynomial idx ℚ`.

If `Φ` has integer coefficients, then the polynomials `witt_structure_rat Φ n` do so as well.
Proving this claim is the essential core of this file, and culminates in
`map_witt_structure_int`, which proves that upon mapping the coefficients
of `witt_structure_int Φ n` from the integers to the rationals,
one obtains `witt_structure_rat Φ n`.
Ultimately, the proof of `map_witt_structure_int` relies on
```
dvd_sub_pow_of_dvd_sub {R : Type*} [comm_ring R] {p : ℕ} {a b : R} :
    (p : R) ∣ a - b → ∀ (k : ℕ), (p : R) ^ (k + 1) ∣ a ^ p ^ k - b ^ p ^ k
```

## Main results

* `witt_structure_rat Φ`: the family of polynomials `ℕ → mv_polynomial (idx × ℕ) ℚ`
  associated with `Φ : mv_polynomial idx ℚ` and satisfying the property explained above.
* `witt_structure_rat_prop`: the proof that `witt_structure_rat` indeed satisfies the property.
* `witt_structure_int Φ`: the family of polynomials `ℕ → mv_polynomial (idx × ℕ) ℤ`
  associated with `Φ : mv_polynomial idx ℤ` and satisfying the property explained above.
* `map_witt_structure_int`: the proof that the integral polynomials `with_structure_int Φ`
  are equal to `witt_structure_rat Φ` when mapped to polynomials with rational coefficients.
* `witt_structure_int_prop`: the proof that `witt_structure_int` indeed satisfies the property.
* Five families of polynomials that will be used to define the ring structure
  on the ring of Witt vectors:
  - `witt_vector.witt_zero`
  - `witt_vector.witt_one`
  - `witt_vector.witt_add`
  - `witt_vector.witt_mul`
  - `witt_vector.witt_neg`
  (We also define `witt_vector.witt_sub`, and later we will prove that it describes subtraction,
  which is defined as `λ a b, a + -b`. See `witt_vector.sub_coeff` for this proof.)

## References

* [Hazewinkel, *Witt Vectors*][Haze09]

* [Commelin and Lewis, *Formalizing the Ring of Witt Vectors*][CL21]
-/

open mv_polynomial
open set
open finset (range)
open finsupp (single)

-- This lemma reduces a bundled morphism to a "mere" function,
-- and consequently the simplifier cannot use a lot of powerful simp-lemmas.
-- We disable this locally, and probably it should be disabled globally in mathlib.
local attribute [-simp] coe_eval₂_hom

variables {p : ℕ} {R : Type*} {idx : Type*} [comm_ring R]

open_locale witt
open_locale big_operators

section p_prime

variables (p) [hp : fact p.prime]
include hp

/-- `witt_structure_rat Φ` is a family of polynomials `ℕ → mv_polynomial (idx × ℕ) ℚ`
that are uniquely characterised by the property that
```
bind₁ (witt_structure_rat p Φ) (witt_polynomial p ℚ n) =
bind₁ (λ i, (rename (prod.mk i) (witt_polynomial p ℚ n))) Φ
```
In other words: evaluating the `n`-th Witt polynomial on the family `witt_structure_rat Φ`
is the same as evaluating `Φ` on the (appropriately renamed) `n`-th Witt polynomials.

See `witt_structure_rat_prop` for this property,
and `witt_structure_rat_exists_unique` for the fact that `witt_structure_rat`
gives the unique family of polynomials with this property.

These polynomials turn out to have integral coefficients,
but it requires some effort to show this.
See `witt_structure_int` for the version with integral coefficients,
and `map_witt_structure_int` for the fact that it is equal to `witt_structure_rat`
when mapped to polynomials over the rationals. -/
noncomputable def witt_structure_rat (Φ : mv_polynomial idx ℚ) (n : ℕ) :
  mv_polynomial (idx × ℕ) ℚ :=
bind₁ (λ k, bind₁ (λ i, rename (prod.mk i) (W_ ℚ k)) Φ) (X_in_terms_of_W p ℚ n)

theorem witt_structure_rat_prop (Φ : mv_polynomial idx ℚ) (n : ℕ) :
  bind₁ (witt_structure_rat p Φ) (W_ ℚ n) =
    bind₁ (λ i, (rename (prod.mk i) (W_ ℚ n))) Φ :=
calc bind₁ (witt_structure_rat p Φ) (W_ ℚ n)
    = bind₁ (λ k, bind₁ (λ i, (rename (prod.mk i)) (W_ ℚ k)) Φ)
        (bind₁ (X_in_terms_of_W p ℚ) (W_ ℚ n)) :
      by { rw bind₁_bind₁, exact eval₂_hom_congr (ring_hom.ext_rat _ _) rfl rfl }
... = bind₁ (λ i, (rename (prod.mk i) (W_ ℚ n))) Φ :
      by rw [bind₁_X_in_terms_of_W_witt_polynomial p _ n, bind₁_X_right]

theorem witt_structure_rat_exists_unique (Φ : mv_polynomial idx ℚ) :
  ∃! (φ : ℕ → mv_polynomial (idx × ℕ) ℚ),
    ∀ (n : ℕ), bind₁ φ (W_ ℚ n) = bind₁ (λ i, (rename (prod.mk i) (W_ ℚ n))) Φ :=
begin
  refine ⟨witt_structure_rat p Φ, _, _⟩,
  { intro n, apply witt_structure_rat_prop },
  { intros φ H,
    funext n,
    rw show φ n = bind₁ φ (bind₁ (W_ ℚ) (X_in_terms_of_W p ℚ n)),
    { rw [bind₁_witt_polynomial_X_in_terms_of_W p, bind₁_X_right] },
    rw [bind₁_bind₁],
        exact eval₂_hom_congr (ring_hom.ext_rat _ _) (funext H) rfl },
end

lemma witt_structure_rat_rec_aux (Φ : mv_polynomial idx ℚ) (n : ℕ) :
  witt_structure_rat p Φ n * C (p ^ n : ℚ) =
    bind₁ (λ b, rename (λ i, (b, i)) (W_ ℚ n)) Φ -
      ∑ i in range n, C (p ^ i : ℚ) * (witt_structure_rat p Φ i) ^ p ^ (n - i) :=
begin
  have := X_in_terms_of_W_aux p ℚ n,
  replace := congr_arg (bind₁ (λ k : ℕ, bind₁ (λ i, rename (prod.mk i) (W_ ℚ k)) Φ)) this,
  rw [alg_hom.map_mul, bind₁_C_right] at this,
  rw [witt_structure_rat, this], clear this,
  conv_lhs { simp only [alg_hom.map_sub, bind₁_X_right] },
  rw sub_right_inj,
  simp only [alg_hom.map_sum, alg_hom.map_mul, bind₁_C_right, alg_hom.map_pow],
  refl
end

/-- Write `witt_structure_rat p φ n` in terms of `witt_structure_rat p φ i` for `i < n`. -/
lemma witt_structure_rat_rec (Φ : mv_polynomial idx ℚ) (n : ℕ) :
  (witt_structure_rat p Φ n) = C (1 / p ^ n : ℚ) *
  (bind₁ (λ b, (rename (λ i, (b, i)) (W_ ℚ n))) Φ -
  ∑ i in range n, C (p ^ i : ℚ) * (witt_structure_rat p Φ i) ^ p ^ (n - i)) :=
begin
  calc witt_structure_rat p Φ n
      = C (1 / p ^ n : ℚ) * (witt_structure_rat p Φ n * C (p ^ n : ℚ)) : _
  ... = _ : by rw witt_structure_rat_rec_aux,
  rw [mul_left_comm, ← C_mul, div_mul_cancel, C_1, mul_one],
  exact pow_ne_zero _ (nat.cast_ne_zero.2 hp.1.ne_zero),
end

/-- `witt_structure_int Φ` is a family of polynomials `ℕ → mv_polynomial (idx × ℕ) ℤ`
that are uniquely characterised by the property that
```
bind₁ (witt_structure_int p Φ) (witt_polynomial p ℤ n) =
bind₁ (λ i, (rename (prod.mk i) (witt_polynomial p ℤ n))) Φ
```
In other words: evaluating the `n`-th Witt polynomial on the family `witt_structure_int Φ`
is the same as evaluating `Φ` on the (appropriately renamed) `n`-th Witt polynomials.

See `witt_structure_int_prop` for this property,
and `witt_structure_int_exists_unique` for the fact that `witt_structure_int`
gives the unique family of polynomials with this property. -/
noncomputable def witt_structure_int (Φ : mv_polynomial idx ℤ) (n : ℕ) :
  mv_polynomial (idx × ℕ) ℤ :=
finsupp.map_range rat.num (rat.coe_int_num 0)
  (witt_structure_rat p (map (int.cast_ring_hom ℚ) Φ) n)

variable {p}

lemma bind₁_rename_expand_witt_polynomial (Φ : mv_polynomial idx ℤ) (n : ℕ)
  (IH : ∀ m : ℕ, m < (n + 1) →
    map (int.cast_ring_hom ℚ) (witt_structure_int p Φ m) =
      witt_structure_rat p (map (int.cast_ring_hom ℚ) Φ) m) :
  bind₁ (λ b, rename (λ i, (b, i)) (expand p (W_ ℤ n))) Φ =
    bind₁ (λ i, expand p (witt_structure_int p Φ i)) (W_ ℤ n) :=
begin
  apply mv_polynomial.map_injective (int.cast_ring_hom ℚ) int.cast_injective,
  simp only [map_bind₁, map_rename, map_expand, rename_expand, map_witt_polynomial],
  have key := (witt_structure_rat_prop p (map (int.cast_ring_hom ℚ) Φ) n).symm,
  apply_fun expand p at key,
  simp only [expand_bind₁] at key,
  rw key, clear key,
  apply eval₂_hom_congr' rfl _ rfl,
  rintro i hi -,
  rw [witt_polynomial_vars, finset.mem_range] at hi,
  simp only [IH i hi],
end

lemma C_p_pow_dvd_bind₁_rename_witt_polynomial_sub_sum (Φ : mv_polynomial idx ℤ) (n : ℕ)
  (IH : ∀ m : ℕ, m < n →
    map (int.cast_ring_hom ℚ) (witt_structure_int p Φ m) =
      witt_structure_rat p (map (int.cast_ring_hom ℚ) Φ) m) :
  C ↑(p ^ n) ∣
    (bind₁ (λ (b : idx), rename (λ i, (b, i)) (witt_polynomial p ℤ n)) Φ -
      ∑ i in range n, C (↑p ^ i) * witt_structure_int p Φ i ^ p ^ (n - i)) :=
begin
  cases n,
  { simp only [is_unit_one, int.coe_nat_zero, int.coe_nat_succ,
      zero_add, pow_zero, C_1, is_unit.dvd] },

  -- prepare a useful equation for rewriting
  have key := bind₁_rename_expand_witt_polynomial Φ n IH,
  apply_fun (map (int.cast_ring_hom (zmod (p ^ (n + 1))))) at key,
  conv_lhs at key { simp only [map_bind₁, map_rename, map_expand, map_witt_polynomial] },

  -- clean up and massage
  rw [nat.succ_eq_add_one, C_dvd_iff_zmod, ring_hom.map_sub, sub_eq_zero, map_bind₁],
  simp only [map_rename, map_witt_polynomial, witt_polynomial_zmod_self],
  rw key, clear key IH,
  rw [bind₁, aeval_witt_polynomial, ring_hom.map_sum, ring_hom.map_sum, finset.sum_congr rfl],
  intros k hk,
  rw [finset.mem_range, nat.lt_succ_iff] at hk,
  simp only [← sub_eq_zero, ← ring_hom.map_sub, ← C_dvd_iff_zmod, C_eq_coe_nat, ← mul_sub,
    ← nat.cast_pow],
  rw show p ^ (n + 1) = p ^ k * p ^ (n - k + 1),
  { rw [← pow_add, ←add_assoc], congr' 2, rw [add_comm, ←tsub_eq_iff_eq_add_of_le hk] },
  rw [nat.cast_mul, nat.cast_pow, nat.cast_pow],
  apply mul_dvd_mul_left,
  rw show p ^ (n + 1 - k) = p * p ^ (n - k),
  { rw [← pow_succ, ← tsub_add_eq_add_tsub hk] },
  rw [pow_mul],
  -- the machine!
  apply dvd_sub_pow_of_dvd_sub,
  rw [← C_eq_coe_nat, C_dvd_iff_zmod, ring_hom.map_sub,
      sub_eq_zero, map_expand, ring_hom.map_pow, mv_polynomial.expand_zmod],
end

variables (p)

@[simp] lemma map_witt_structure_int (Φ : mv_polynomial idx ℤ) (n : ℕ) :
  map (int.cast_ring_hom ℚ) (witt_structure_int p Φ n) =
    witt_structure_rat p (map (int.cast_ring_hom ℚ) Φ) n :=
begin
  apply nat.strong_induction_on n, clear n,
  intros n IH,
  rw [witt_structure_int, map_map_range_eq_iff, int.coe_cast_ring_hom],
  intro c,
  rw [witt_structure_rat_rec, coeff_C_mul, mul_comm, mul_div_assoc', mul_one],
  have sum_induction_steps : map (int.cast_ring_hom ℚ)
   (∑ i in range n, C (p ^ i : ℤ) *
     (witt_structure_int p Φ i) ^ p ^ (n - i)) =
    ∑ i in range n, C (p ^ i : ℚ) *
      (witt_structure_rat p (map (int.cast_ring_hom ℚ) Φ) i) ^ p ^ (n - i),
  { rw [ring_hom.map_sum],
    apply finset.sum_congr rfl,
    intros i hi,
    rw finset.mem_range at hi,
    simp only [IH i hi, ring_hom.map_mul, ring_hom.map_pow, map_C],
    refl },
  simp only [← sum_induction_steps, ← map_witt_polynomial p (int.cast_ring_hom ℚ),
    ← map_rename, ← map_bind₁, ← ring_hom.map_sub, coeff_map],
  rw show (p : ℚ)^n = ((p^n : ℕ) : ℤ), by norm_cast,
  rw [← rat.denom_eq_one_iff, eq_int_cast, rat.denom_div_cast_eq_one_iff],
  swap, { exact_mod_cast pow_ne_zero n hp.1.ne_zero },
  revert c, rw [← C_dvd_iff_dvd_coeff],
  exact C_p_pow_dvd_bind₁_rename_witt_polynomial_sub_sum Φ n IH,
end

variables (p)

theorem witt_structure_int_prop (Φ : mv_polynomial idx ℤ) (n) :
  bind₁ (witt_structure_int p Φ) (witt_polynomial p ℤ n) =
    bind₁ (λ i, rename (prod.mk i) (W_ ℤ n)) Φ :=
begin
  apply mv_polynomial.map_injective (int.cast_ring_hom ℚ) int.cast_injective,
  have := witt_structure_rat_prop p (map (int.cast_ring_hom ℚ) Φ) n,
  simpa only [map_bind₁, ← eval₂_hom_map_hom, eval₂_hom_C_left, map_rename,
    map_witt_polynomial, alg_hom.coe_to_ring_hom, map_witt_structure_int],
end

lemma eq_witt_structure_int (Φ : mv_polynomial idx ℤ) (φ : ℕ → mv_polynomial (idx × ℕ) ℤ)
  (h : ∀ n, bind₁ φ (witt_polynomial p ℤ n) = bind₁ (λ i, rename (prod.mk i) (W_ ℤ n)) Φ) :
  φ = witt_structure_int p Φ :=
begin
  funext k,
  apply mv_polynomial.map_injective (int.cast_ring_hom ℚ) int.cast_injective,
  rw map_witt_structure_int,
  refine congr_fun _ k,
  apply unique_of_exists_unique (witt_structure_rat_exists_unique p (map (int.cast_ring_hom ℚ) Φ)),
  { intro n,
    specialize h n,
    apply_fun map (int.cast_ring_hom ℚ) at h,
    simpa only [map_bind₁, ← eval₂_hom_map_hom, eval₂_hom_C_left, map_rename,
      map_witt_polynomial, alg_hom.coe_to_ring_hom] using h, },
  { intro n, apply witt_structure_rat_prop }
end

theorem witt_structure_int_exists_unique (Φ : mv_polynomial idx ℤ) :
  ∃! (φ : ℕ → mv_polynomial (idx × ℕ) ℤ),
  ∀ (n : ℕ), bind₁ φ (witt_polynomial p ℤ n) = bind₁ (λ i : idx, (rename (prod.mk i) (W_ ℤ n))) Φ :=
⟨witt_structure_int p Φ, witt_structure_int_prop _ _, eq_witt_structure_int _ _⟩

theorem witt_structure_prop (Φ : mv_polynomial idx ℤ) (n) :
  aeval (λ i, map (int.cast_ring_hom R) (witt_structure_int p Φ i)) (witt_polynomial p ℤ n) =
  aeval (λ i, rename (prod.mk i) (W n)) Φ :=
begin
  convert congr_arg (map (int.cast_ring_hom R)) (witt_structure_int_prop p Φ n) using 1;
    rw hom_bind₁; apply eval₂_hom_congr (ring_hom.ext_int _ _) _ rfl,
  { refl },
  { simp only [map_rename, map_witt_polynomial] }
end

lemma witt_structure_int_rename {σ : Type*} (Φ : mv_polynomial idx ℤ) (f : idx → σ) (n : ℕ) :
  witt_structure_int p (rename f Φ) n = rename (prod.map f id) (witt_structure_int p Φ n) :=
begin
  apply mv_polynomial.map_injective (int.cast_ring_hom ℚ) int.cast_injective,
  simp only [map_rename, map_witt_structure_int, witt_structure_rat, rename_bind₁, rename_rename,
    bind₁_rename],
  refl
end

@[simp]
lemma constant_coeff_witt_structure_rat_zero (Φ : mv_polynomial idx ℚ) :
  constant_coeff (witt_structure_rat p Φ 0) = constant_coeff Φ :=
by simp only [witt_structure_rat, bind₁, map_aeval, X_in_terms_of_W_zero, constant_coeff_rename,
  constant_coeff_witt_polynomial, aeval_X, constant_coeff_comp_algebra_map,
  eval₂_hom_zero'_apply, ring_hom.id_apply]

lemma constant_coeff_witt_structure_rat (Φ : mv_polynomial idx ℚ)
  (h : constant_coeff Φ = 0) (n : ℕ) :
  constant_coeff (witt_structure_rat p Φ n) = 0 :=
by simp only [witt_structure_rat, eval₂_hom_zero'_apply, h, bind₁, map_aeval, constant_coeff_rename,
  constant_coeff_witt_polynomial, constant_coeff_comp_algebra_map, ring_hom.id_apply,
  constant_coeff_X_in_terms_of_W]

@[simp]
lemma constant_coeff_witt_structure_int_zero (Φ : mv_polynomial idx ℤ) :
  constant_coeff (witt_structure_int p Φ 0) = constant_coeff Φ :=
begin
  have inj : function.injective (int.cast_ring_hom ℚ),
  { intros m n, exact int.cast_inj.mp, },
  apply inj,
  rw [← constant_coeff_map, map_witt_structure_int,
      constant_coeff_witt_structure_rat_zero, constant_coeff_map],
end

lemma constant_coeff_witt_structure_int (Φ : mv_polynomial idx ℤ)
  (h : constant_coeff Φ = 0) (n : ℕ) :
  constant_coeff (witt_structure_int p Φ n) = 0 :=
begin
  have inj : function.injective (int.cast_ring_hom ℚ),
  { intros m n, exact int.cast_inj.mp, },
  apply inj,
  rw [← constant_coeff_map, map_witt_structure_int,
      constant_coeff_witt_structure_rat, ring_hom.map_zero],
  rw [constant_coeff_map, h, ring_hom.map_zero],
end

variable (R)

-- we could relax the fintype on `idx`, but then we need to cast from finset to set.
-- for our applications `idx` is always finite.
lemma witt_structure_rat_vars [fintype idx] (Φ : mv_polynomial idx ℚ) (n : ℕ) :
  (witt_structure_rat p Φ n).vars ⊆ finset.univ ×ˢ finset.range (n + 1) :=
begin
  rw witt_structure_rat,
  intros x hx,
  simp only [finset.mem_product, true_and, finset.mem_univ, finset.mem_range],
  obtain ⟨k, hk, hx'⟩ := mem_vars_bind₁ _ _ hx,
  obtain ⟨i, -, hx''⟩ := mem_vars_bind₁ _ _ hx',
  obtain ⟨j, hj, rfl⟩ := mem_vars_rename _ _ hx'',
  rw [witt_polynomial_vars, finset.mem_range] at hj,
  replace hk := X_in_terms_of_W_vars_subset p _ hk,
  rw finset.mem_range at hk,
  exact lt_of_lt_of_le hj hk,
end

-- we could relax the fintype on `idx`, but then we need to cast from finset to set.
-- for our applications `idx` is always finite.
lemma witt_structure_int_vars [fintype idx] (Φ : mv_polynomial idx ℤ) (n : ℕ) :
  (witt_structure_int p Φ n).vars ⊆ finset.univ ×ˢ finset.range (n + 1) :=
begin
  have : function.injective (int.cast_ring_hom ℚ) := int.cast_injective,
  rw [← vars_map_of_injective _ this, map_witt_structure_int],
  apply witt_structure_rat_vars,
end

end p_prime


/-
Copyright (c) 2022 Yaël Dillies, Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies, Bhavik Mehta

! This file was ported from Lean 3 source module combinatorics.simple_graph.triangle.basic
! leanprover-community/mathlib commit cd7f0626a0b04be1dda223a26123313514a55fb4
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Combinatorics.SimpleGraph.Clique

/-!
# Triangles in graphs

A *triangle* in a simple graph is a `3`-clique, namely a set of three vertices that are
pairwise adjacent.

This module defines and proves properties about triangles in simple graphs.

## Main declarations

* `SimpleGraph.farFromTriangleFree`: Predicate for a graph to have enough triangles that, to
  remove all of them, one must one must remove a lot of edges. This is the crux of the Triangle
  Removal lemma.

## TODO

* Generalise `farFromTriangleFree` to other graphs, to state and prove the Graph Removal Lemma.
* Find a better name for `farFromTriangleFree`. Added 4/26/2022. Remove this TODO if it gets old.
-/

open Finset Fintype Nat

open Classical

namespace SimpleGraph

variable {α 𝕜 : Type _} [Fintype α] [LinearOrderedField 𝕜] {G H : SimpleGraph α} {ε δ : 𝕜} {n : ℕ}
  {s : Finset α}

/-- A simple graph is *`ε`-triangle-free far* if one must remove at least `ε * (card α)^2` edges to
make it triangle-free. -/
def FarFromTriangleFree (G : SimpleGraph α) (ε : 𝕜) : Prop :=
  (G.DeleteFar fun H => H.CliqueFree 3) <| ε * (card α ^ 2 : ℕ)
#align simple_graph.far_from_triangle_free SimpleGraph.FarFromTriangleFree

theorem farFromTriangleFree_iff : G.FarFromTriangleFree ε ↔ ∀ ⦃H⦄, H ≤ G → H.CliqueFree 3 →
  ε * (card α ^ 2 : ℕ) ≤ G.edgeFinset.card - H.edgeFinset.card := deleteFar_iff
#align simple_graph.far_from_triangle_free_iff SimpleGraph.farFromTriangleFree_iff

alias farFromTriangleFree_iff ↔ farFromTriangleFree.le_card_sub_card _
#align simple_graph.far_from_triangle_free.le_card_sub_card SimpleGraph.farFromTriangleFree.le_card_sub_card

theorem farFromTriangleFree.mono (hε : G.FarFromTriangleFree ε) (h : δ ≤ ε) :
    G.FarFromTriangleFree δ := hε.mono <| mul_le_mul_of_nonneg_right h <| cast_nonneg _
#align simple_graph.far_from_triangle_free.mono SimpleGraph.farFromTriangleFree.mono

theorem FarFromTriangleFree.cliqueFinset_nonempty' (hH : H ≤ G) (hG : G.FarFromTriangleFree ε)
    (hcard : (G.edgeFinset.card - H.edgeFinset.card : 𝕜) < ε * (card α ^ 2 : ℕ)) :
    (H.cliqueFinset 3).Nonempty :=
  nonempty_of_ne_empty <|
    H.cliqueFinset_eq_empty_iff.not.2 fun hH' => (hG.le_card_sub_card hH hH').not_lt hcard
#align simple_graph.far_from_triangle_free.clique_finset_nonempty' SimpleGraph.FarFromTriangleFree.cliqueFinset_nonempty'

variable [Nonempty α]

theorem FarFromTriangleFree.nonpos (h₀ : G.FarFromTriangleFree ε) (h₁ : G.CliqueFree 3) : ε ≤ 0 :=
  by
  have := h₀ (empty_subset _)
  rw [coe_empty, Finset.card_empty, cast_zero, deleteEdges_empty_eq] at this
  exact nonpos_of_mul_nonpos_left (this h₁) (cast_pos.2 <| sq_pos_of_pos Fintype.card_pos)
#align simple_graph.far_from_triangle_free.nonpos SimpleGraph.FarFromTriangleFree.nonpos

theorem CliqueFree.not_farFromTriangleFree (hG : G.CliqueFree 3) (hε : 0 < ε) :
    ¬G.FarFromTriangleFree ε := fun h => (h.nonpos hG).not_lt hε
#align simple_graph.clique_free.not_far_from_triangle_free SimpleGraph.CliqueFree.not_farFromTriangleFree

theorem FarFromTriangleFree.not_cliqueFree (hG : G.FarFromTriangleFree ε) (hε : 0 < ε) :
    ¬G.CliqueFree 3 := fun h => (hG.nonpos h).not_lt hε
#align simple_graph.far_from_triangle_free.not_clique_free SimpleGraph.FarFromTriangleFree.not_cliqueFree

theorem FarFromTriangleFree.cliqueFinset_nonempty (hG : G.FarFromTriangleFree ε) (hε : 0 < ε) :
    (G.cliqueFinset 3).Nonempty :=
  nonempty_of_ne_empty <| G.cliqueFinset_eq_empty_iff.not.2 <| hG.not_cliqueFree hε
#align simple_graph.far_from_triangle_free.clique_finset_nonempty SimpleGraph.FarFromTriangleFree.cliqueFinset_nonempty

end SimpleGraph


import data.real.basic tactic.find
variables {Ω : Type*} {α : Type*}
open set
local attribute [instance] classical.prop_decidable
noncomputable theory

lemma union_diff_eq_union (s t : set α)
    : s ∪ (t \ s) = s ∪ t := set.ext $ λ x,
or.by_cases (classical.em (x ∈ s)) (λ h, by simp [h]) (λ h, by simp [h])

@[simp] lemma diff_disjoint (s t : set α) : disjoint (s \ t) t :=
show (s ∩ -t) ∩ t = ∅, from (inter_assoc s (-t) t).symm ▸
(compl_inter_self t).symm ▸ inter_empty s

@[simp] lemma disjoint_diff (s t : set α) : disjoint s (t \ s) :=
disjoint_symm (diff_disjoint _ _)

variables [iα : discrete_linear_ordered_field α] (P : set Ω → α)
include iα

class prob : Prop :=
(prob_nonneg : ∀ E : set Ω, 0 ≤ P E)
(prob_univ : P univ = 1)
(prob_add : ∀ {E₁ E₂ : set Ω}, disjoint E₁ E₂ → P (E₁ ∪ E₂) = P E₁ + P E₂)

attribute [simp] prob.prob_univ

namespace prob
variables [hP : prob P]
include hP

@[simp] lemma union_compl_self (E : set Ω) : P (E ∪ -E) = 1 :=
eq.symm (set.union_compl_self E) ▸ prob_univ _

@[simp] lemma compl_union_self (E : set Ω) : P (-E ∪ E) = 1 :=
(set.compl_union_self E).symm ▸ prob_univ _

lemma subset_le {E₁ E₂ : set Ω} (h : E₁ ⊆ E₂) : P E₁ ≤ P E₂ :=
union_diff_cancel h ▸ (prob_add P (disjoint_diff E₁ E₂)).symm ▸
le_add_of_nonneg_right (prob_nonneg _ _)

lemma le_union_left (E₁ E₂ : set Ω) : P E₁ ≤ P (E₁ ∪ E₂) :=
subset_le P (subset_union_left _ _)

lemma le_union_right (E₁ E₂ : set Ω) : P E₂ ≤ P (E₁ ∪ E₂) :=
subset_le P (subset_union_right _ _)

lemma le_one (E : set Ω) : P E ≤ 1 :=
prob_univ P ▸ subset_le P (subset_univ _)

lemma inter_le_left (E₁ E₂ : set Ω) : P (E₁ ∩ E₂) ≤ P E₁ :=
subset_le P (inter_subset_left _ _)

lemma inter_le_right (E₁ E₂ : set Ω) : P (E₁ ∩ E₂) ≤ P E₂ :=
subset_le P (inter_subset_right _ _)

@[simp] lemma empty : P ∅ = 0 :=
have h : P (univ ∪ ∅) = P univ + P ∅ := prob_add P (inter_empty univ),
by rwa [union_empty, prob_univ P, ← add_zero (1 : α),
      add_assoc, add_left_cancel_iff, zero_add, eq_comm] at h

def given (E₁ E₂ : set Ω) := P (E₁ ∩ E₂) / P E₂

#print mul_comm
end


import algebra
import tactic.linarith

-- set_option trace.simplify.rewrite true
-- set_option trace.simp_lemmas true
-- set_option trace.linarith true

def nonneg_rat : Type :=
  {q : ℚ // q.nonneg}

notation `ℚ*` := nonneg_rat

-- ℚ* is a comm-semi-ring with multiplicative inverse
-- Equivalent: a field without an additive inverse.
-- Additionally it has a decidable linear order matching the operations.

namespace nonneg_rat

instance : has_repr ℚ* := ⟨rat.repr ∘ subtype.val⟩
instance : has_to_string ℚ* := ⟨rat.repr ∘ subtype.val⟩

def of_rat (q : ℚ) (h : q.nonneg) : ℚ* := subtype.mk q h

lemma zero_def : (0:ℚ) = (rat.mk 0 1) := begin refl, end
lemma one_def : (1:ℚ) = (rat.mk 1 1) := begin refl, end
lemma unpack_rat (q : ℚ) : q = (rat.mk q.num q.denom) := rat.num_denom.symm

instance : has_zero ℚ* := ⟨of_rat 0 (refl 0)⟩
instance : has_one ℚ* := ⟨of_rat 1 (begin rw one_def, rw rat.mk_nonneg, exact int.one_nonneg, exact int.one_pos, end)⟩
instance : inhabited ℚ* := ⟨0⟩
-- instance : nontrivial ℚ* := ⟨⟨0, 1, begin exact ne_of_lt _ end⟩⟩

def add (q q' : ℚ*) : ℚ* := of_rat (q.val + q'.val) (rat.nonneg_add q.property q'.property)
instance : has_add ℚ* := ⟨add⟩

def mul (q q' : ℚ*) : ℚ* := of_rat (q.val * q'.val) (rat.nonneg_mul q.property q'.property)
instance : has_mul ℚ* := ⟨mul⟩

def inv (q : ℚ*) : ℚ* := of_rat (q.val⁻¹) begin
  by_cases zero : q.val = 0,
  rw [zero, zero_def, rat.inv_def, rat.mk_zero, zero_def, rat.mk_nonneg], exact int.one_pos,
  rw eq.symm (ne.def _ _) at zero,
  have h : 0 ≤ q.val, exact rat.nonneg_iff_zero_le.elim_left q.property,
  generalize val : q.val = q_val, rw val at *,

  have nonzero : q_val.num ≠ 0, exact by_contradiction begin
    intros n_zero,
    rw [ne.def, not_not] at n_zero,
    rw [unpack_rat q_val, n_zero, rat.zero_mk] at zero,
    exact ne.irrefl zero,
  end,

  rw [unpack_rat q_val, rat.inv_def, rat.mk_nonneg],
  exact int.coe_nat_nonneg q_val.denom,
  exact rat.num_pos_iff_pos.elim_right (lt_of_le_of_ne h (ne.symm zero)),
end

instance : has_inv ℚ* := ⟨inv⟩

def div (q q' : ℚ*) : ℚ* := q * q'⁻¹
instance : has_div ℚ* := ⟨div⟩

def le (q q' : ℚ*) : Prop := q.val.le q'.val
instance : has_le ℚ* := ⟨le⟩

@[simp] lemma subtype_val (q : ℚ*) : (⟨q.val, q.property⟩ : ℚ*).val = q.val := begin exact rfl, end
lemma expand (q : ℚ*) : q = ⟨q.val, q.property⟩ := by exact subtype.eq rfl
@[simp] theorem eq_val (q q' : ℚ*) : q = q' ↔ q.val = q'.val := by rw [expand q, expand q']; exact subtype.mk_eq_mk
@[simp] theorem add_val (q q' : ℚ*) : (q + q').val = q.val + q'.val := by cc
@[simp] theorem mul_val (q q' : ℚ*) : (q * q').val = q.val * q'.val := by cc
@[simp] theorem inv_val (q : ℚ*) : (q⁻¹).val = q.val⁻¹ := by cc
theorem le_val (q q' : ℚ*) : q ≤ q' ↔ q.val ≤ q'.val := by simp

theorem add_assoc (a b c : ℚ*) : a + b + c = a + (b + c) := by simp; exact rat.add_assoc _ _ _
theorem add_comm (a b : ℚ*) : a + b = b + a := by simp; exact rat.add_comm _ _
theorem mul_assoc (a b c : ℚ*) : a * b * c = a * (b * c) := by simp; exact rat.mul_assoc _ _ _
theorem mul_comm (a b : ℚ*) : a * b = b * a := by simp; exact rat.mul_comm _ _

theorem zero_add (q : ℚ*) : 0 + q = q := by simp; refl
theorem add_zero (q : ℚ*) : q + 0 = q := by simp; refl

theorem one_mul (q : ℚ*) : 1 * q = q := by simp; exact rat.one_mul _
theorem mul_one (q : ℚ*) : q * 1 = q := by simp; exact rat.mul_one _

theorem left_distrib (a b c : ℚ*) : a * (b + c) = a*b + a*c := by simp; exact rat.mul_add _ _ _
theorem right_distrib (a b c : ℚ*) : (a + b) * c = a*c + b*c := by simp; exact rat.add_mul _ _ _

theorem mul_inv_cancel (a : ℚ*) : a ≠ 0 → a * a⁻¹ = 1 := by simp; exact rat.mul_inv_cancel _

theorem add_left_cancel (l a b : ℚ*) : l + a = l + b → a = b := by simp
theorem add_right_cancel (a r b : ℚ*) : a + r = b + r → a = b := by simp

theorem mul_zero (q : ℚ*) : q * 0 = 0 :=
  have q0 : q*0 + q*0 = q*0 + 0,
  by calc q*0 + q*0
      = q * (0+0) :
    by rw ←left_distrib
  ... = q * 0 :
    by rw zero_add
  ... = q*0 + 0 :
    by rw add_zero,

  show q * 0 = 0, from add_left_cancel _ _ _ q0

theorem zero_mul [mul_zero_class ℚ] (q : ℚ*) : 0 * q = 0 :=
  eq.trans (mul_comm 0 q) (mul_zero q)

theorem le_refl (q : ℚ*) : q ≤ q := by rw le_val
theorem le_trans (a b c : ℚ*) : a ≤ b → b ≤ c → a ≤ c := by simp only [le_val]; exact rat.le_trans
theorem le_antisymm (a b : ℚ*) : a ≤ b → b ≤ a → a = b := by simp only [le_val, eq_val]; exact rat.le_antisymm
theorem le_total (a b : ℚ*) : a ≤ b ∨ b ≤ a := by simp only [le_val]; exact rat.le_total _ _

theorem add_le_add_left (q q' : ℚ*) : q ≤ q' → ∀l, l + q ≤ l + q' := by simp only [le_val]; simp
theorem le_of_add_le_add_left (l a b : ℚ*) : l + a ≤ l + b → a ≤ b := by simp only [le_val]; simp

instance decidable_le : decidable_rel ((≤) : ℚ* → ℚ* → Prop)
| a b := show decidable (a.val ≤ b.val), by apply_instance

instance : comm_semiring ℚ* :=
{
  zero := 0,
  one := 1,
  add := add,
  mul := mul,

  add_assoc := add_assoc,
  add_comm := add_comm,
  mul_assoc := mul_assoc,
  mul_comm := mul_comm,

  zero_add := zero_add,
  add_zero := add_zero,

  one_mul := one_mul,
  mul_one := mul_one,

  zero_mul := zero_mul,
  mul_zero := mul_zero,

  left_distrib := left_distrib,
  right_distrib := right_distrib,
  /-
  Missing, because it is not a field:
  - neg
  - add_left_neg
  - exists_pair_ne (to define)
  - inv (defined)
  - mul_inv_cancel (to define)
  -/
}

instance : add_left_cancel_semigroup ℚ* :=
{
  add_left_cancel := add_left_cancel,
  add := add,
  add_assoc := add_assoc,
}
instance : add_right_cancel_semigroup ℚ* :=
{
  add_right_cancel := add_right_cancel,
  add := add,
  add_assoc := add_assoc,
}

instance : decidable_linear_order ℚ* :=
{
  le := le,
  le_refl := le_refl,
  le_trans := le_trans,
  le_antisymm := le_antisymm,
  le_total := le_total,
  decidable_le := assume a b, rat.decidable_le a.val b.val,
}

instance : ordered_semiring ℚ* :=
{
  zero := 0,
  one := 1,
  add := add,
  mul := mul,

  add_assoc := add_assoc,
  add_comm := add_comm,
  mul_assoc := mul_assoc,

  zero_add := zero_add,
  add_zero := add_zero,

  one_mul := one_mul,
  mul_one := mul_one,

  zero_mul := zero_mul,
  mul_zero := mul_zero,

  left_distrib := left_distrib,
  right_distrib := right_distrib,

  le := le,
  le_refl := le_refl,
  le_trans := le_trans,
  le_antisymm := le_antisymm,

  add_left_cancel := add_left_cancel,
  add_right_cancel := add_right_cancel,
  add_le_add_left := add_le_add_left,
  le_of_add_le_add_left := le_of_add_le_add_left,
  zero_lt_one := dec_trivial,
  mul_lt_mul_of_pos_left := begin
    intros m m' l,
    simp only [lt_iff_le_not_le, le_val],
    simp only [←lt_iff_le_not_le],
    exact mul_lt_mul_of_pos_left,
  end,
  mul_lt_mul_of_pos_right := begin
    intros m m' l,
    simp only [lt_iff_le_not_le, le_val],
    simp only [←lt_iff_le_not_le],
    exact mul_lt_mul_of_pos_right,
  end,
}

end nonneg_rat


/-
• Show and Tell by dude named Jason to boost his ego.
-/

/-
Introducing
True and False
-/

#check true
#check false

inductive True : Prop
| True.intro : true

/-
java's void is same as Lean's empty
-/

#check empty -- no constructors

/-
False is the empty or uninhabited type. There are no proofs of it, so it is not true
-/

#check unit
#print unit -- #print prints the type to lean messages.

theorem trueisTrue : true := true.intro -- proof of true

theorem falseIsTrue : false := _ -- can't finish this, why? no proof of false

def falseImpliesCrazy (f: false) : 0 = 1 :=
false.elim f
-- if false is true, then everything and anything is true

example : false → 0 = 1  :=
λ (f :false),
    false.elim f

example : ∀ (P:Prop), false → P :=
λ (P : Prop),
    λ (f : false),
        false.elim f

def x : bool → bool
| tt := _
| ff := _

def y: unit → bool
| punit := _

def z: false → bool
| (f:false) := false.elim f

/-
defining not operator
-/

#print not -- defined as a function that takes prop a and returns a → false

axiom P : Prop

#check ¬ P
#reduce ¬ P -- not P simply means P → false

/-
if not p is true, that is saying that it is true that p → false. this means there is a proof of this implication. a proof of an implication is a function that takes an argument of type P → false .
-/
/-
Proof by negation:
-/

example: ¬ P :=
λ (p : P),
    _

example: P → ¬ P → false :=
λ (p:P),
    λ (np : ¬ P),
        (np p)

example: P → ¬ P → false :=
begin
    assume (p : P),
    assume (np : P → false),
    exact (np p),
end

/-
If p is true and if not p is true then false is true. (Prove this)

Assumpe P is true and that ¬ P is also true and show that false is true. Apply ¬P to P to get false. QED.
-/

example: P → ¬ P → 0 = 1 :=
begin
assume (p : P),
assume (np : ¬ P),
exact false.elim (np p),
end

axiom Q : Prop

axiom q : Q

example : P ∨ Q :=
or.inr q

axiom em: ∀ (P : Prop), P ∨ ¬ P

example : P ∨ ¬ P :=
em P

example : Q ∨ ¬ Q :=
em Q

example : P ∨ Q → (P → R) → (Q → R) → R :=
_


import data.nat.basic
import Rings.ToMathlib.list
-- import Rings.ToMathlib

namespace nat

variables {A B : Type*}

@[simp] def natlist : Π (n : ℕ) (as : ℕ → list A), list A
| nat.zero := λ as, []
| (nat.succ n) := λ as, (as n) ++ (natlist n as)

section mul_one_class

variables [has_mul A] [has_one A] [mul_one_class B]

-- def sum [has_add A] [has_zero A] : Π (n : ℕ) (as : fin n → A), A
-- | nat.zero := λ as, 0
-- | (nat.succ n) := λ as, sum n (λ n, as n) + as n

@[simp] def non_comm_prod [has_mul A] [has_one A] :
  Π (n : ℕ) (as : fin n → A), A
| nat.zero := λ as, 1
| (nat.succ n) := λ as, non_comm_prod n (λ n, as n) * as n

lemma map_non_comm_prod (f : mul_one_hom A B) : Π {n : ℕ} {as : fin n → A},
f.to_fun (non_comm_prod n as) = non_comm_prod n (f.to_fun ∘ as)
| nat.zero as := f.map_one
| (nat.succ n) as :=
begin
  simp only [non_comm_prod, f.map_mul],
  rw map_non_comm_prod,
end

end mul_one_class

section comm_monoid

variables [comm_monoid B]

lemma non_comm_prod_eq_prod {n : ℕ} {as : fin n → B} :
  n.non_comm_prod as = finset.univ.prod as :=
begin
  induction n with n hn,
  {simp},
  {
    simp only [fin.coe_eq_cast_succ, non_comm_prod, fin.univ_cast_succ],
    rw finset.prod_insert,
    {
      rw mul_comm,
      congr,
      {
        apply fin.eq_of_veq,
        simp only [fin.val_eq_coe, fin.coe_last, fin.coe_of_nat_eq_mod],
        apply mod_eq_of_lt (lt_succ_self _),
      },
      {
        rw hn,
        simp only [imp_self, implies_true_iff,
          order_embedding.eq_iff_eq, finset.prod_image],
      },
    },
    {
      simp only [not_exists, finset.mem_univ, finset.mem_image,
        forall_true_left],
      intro i,
      apply ne_of_lt,
      apply fin.cast_succ_lt_last,
    },
  }
end

end comm_monoid

end nat


/- Tactic : refl

## Summary

`refl` is a tactic which proves goals of the form `X = X`.

## Details

The `refl` tactic will close any goal of the form `A = B`
where `A` and `B` are *exactly the same thing*.

### Example:
If it looks like this in the top right hand box:
```
A B : set X
⊢ A ∪ B = A ∪ B
```

then

`refl,`

will close the goal and solve the level. Don't forget the comma.

-/

/-
We will start by practising with the simplest tactic, namely *refl*. This just proves goals
of the form $A = A$, no matter how complicated $A$ is. Let's see it in action!
-/

/- Hint : Click here for a hint, in case you get stuck.
Just delete `sorry` and type `refl,` (don't forget the comma!).
-/

variables {X : Type} -- hide

/- Lemma : no-side-bar
If A and B are sets, then A ∪ B = A ∪ B.
-/
lemma union_is_union (A B : set X) : A ∪ B = A ∪ B :=
begin
  refl,

end