/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import data.finset.fold
import data.multiset.lattice
import order.order_dual
import order.complete_lattice

/-!
# Lattice operations on finsets
-/

variables {α β γ : Type*}

namespace finset
open multiset order_dual

/-! ### sup -/
section sup
variables [semilattice_sup_bot α]

/-- Supremum of a finite set: `sup {a, b, c} f = f a ⊔ f b ⊔ f c` -/
def sup (s : finset β) (f : β → α) : α := s.fold (⊔) ⊥ f

variables {s s₁ s₂ : finset β} {f : β → α}

lemma sup_def : s.sup f = (s.1.map f).sup := rfl

@[simp] lemma sup_empty : (∅ : finset β).sup f = ⊥ :=
fold_empty

@[simp] lemma sup_cons {b : β} (h : b ∉ s) : (cons b s h).sup f = f b ⊔ s.sup f :=
fold_cons h

@[simp] lemma sup_insert [decidable_eq β] {b : β} : (insert b s : finset β).sup f = f b ⊔ s.sup f :=
fold_insert_idem

lemma sup_image [decidable_eq β] (s : finset γ) (f : γ → β) (g : β → α):
  (s.image f).sup g = s.sup (g ∘ f) :=
fold_image_idem

@[simp] lemma sup_map (s : finset γ) (f : γ ↪ β) (g : β → α) :
  (s.map f).sup g = s.sup (g ∘ f) :=
fold_map

@[simp] lemma sup_singleton {b : β} : ({b} : finset β).sup f = f b :=
sup_singleton

lemma sup_union [decidable_eq β] : (s₁ ∪ s₂).sup f = s₁.sup f ⊔ s₂.sup f :=
finset.induction_on s₁ (by rw [empty_union, sup_empty, bot_sup_eq]) $ λ a s has ih,
by rw [insert_union, sup_insert, sup_insert, ih, sup_assoc]

theorem sup_congr {f g : β → α} (hs : s₁ = s₂) (hfg : ∀a∈s₂, f a = g a) : s₁.sup f = s₂.sup g :=
by subst hs; exact finset.fold_congr hfg

@[simp] lemma sup_le_iff {a : α} : s.sup f ≤ a ↔ (∀b ∈ s, f b ≤ a) :=
begin
  apply iff.trans multiset.sup_le,
  simp only [multiset.mem_map, and_imp, exists_imp_distrib],
  exact ⟨λ k b hb, k _ _ hb rfl, λ k a' b hb h, h ▸ k _ hb⟩,
end

lemma sup_const {s : finset β} (h : s.nonempty) (c : α) : s.sup (λ _, c) = c :=
eq_of_forall_ge_iff $ λ b, sup_le_iff.trans h.forall_const

lemma sup_le {a : α} : (∀b ∈ s, f b ≤ a) → s.sup f ≤ a :=
sup_le_iff.2

lemma le_sup {b : β} (hb : b ∈ s) : f b ≤ s.sup f :=
sup_le_iff.1 (le_refl _) _ hb

lemma sup_mono_fun {g : β → α} (h : ∀b∈s, f b ≤ g b) : s.sup f ≤ s.sup g :=
sup_le (λ b hb, le_trans (h b hb) (le_sup hb))

lemma sup_mono (h : s₁ ⊆ s₂) : s₁.sup f ≤ s₂.sup f :=
sup_le $ assume b hb, le_sup (h hb)

@[simp] lemma sup_lt_iff [is_total α (≤)] {a : α} (ha : ⊥ < a) : s.sup f < a ↔ (∀ b ∈ s, f b < a) :=
⟨(λ hs b hb, lt_of_le_of_lt (le_sup hb) hs), finset.cons_induction_on s (λ _, ha)
  (λ c t hc, by simpa only [sup_cons, sup_lt_iff, mem_cons, forall_eq_or_imp] using and.imp_right)⟩

@[simp] lemma le_sup_iff [is_total α (≤)] {a : α} (ha : ⊥ < a) : a ≤ s.sup f ↔ (∃ b ∈ s, a ≤ f b) :=
by { rw [←not_iff_not, not_bex], simp only [@not_le (as_linear_order α), sup_lt_iff ha], }

@[simp] lemma lt_sup_iff [is_total α (≤)] {a : α} : a < s.sup f ↔ (∃ b ∈ s, a < f b) :=
by { rw [←not_iff_not, not_bex], simp only [@not_lt (as_linear_order α), sup_le_iff], }

lemma comp_sup_eq_sup_comp [semilattice_sup_bot γ] {s : finset β}
  {f : β → α} (g : α → γ) (g_sup : ∀ x y, g (x ⊔ y) = g x ⊔ g y) (bot : g ⊥ = ⊥) :
  g (s.sup f) = s.sup (g ∘ f) :=
finset.cons_induction_on s bot (λ c t hc ih, by rw [sup_cons, sup_cons, g_sup, ih])

lemma comp_sup_eq_sup_comp_of_is_total [is_total α (≤)] {γ : Type} [semilattice_sup_bot γ]
  (g : α → γ) (mono_g : monotone g) (bot : g ⊥ = ⊥) : g (s.sup f) = s.sup (g ∘ f) :=
comp_sup_eq_sup_comp g mono_g.map_sup bot

/-- Computating `sup` in a subtype (closed under `sup`) is the same as computing it in `α`. -/
lemma sup_coe {P : α → Prop}
  {Pbot : P ⊥} {Psup : ∀{{x y}}, P x → P y → P (x ⊔ y)}
  (t : finset β) (f : β → {x : α // P x}) :
  (@sup _ _ (subtype.semilattice_sup_bot Pbot Psup) t f : α) = t.sup (λ x, f x) :=
by { rw [comp_sup_eq_sup_comp coe]; intros; refl }

@[simp] lemma sup_to_finset {α β} [decidable_eq β]
  (s : finset α) (f : α → multiset β) :
  (s.sup f).to_finset = s.sup (λ x, (f x).to_finset) :=
comp_sup_eq_sup_comp multiset.to_finset to_finset_union rfl

theorem subset_range_sup_succ (s : finset ℕ) : s ⊆ range (s.sup id).succ :=
λ n hn, mem_range.2 $ nat.lt_succ_of_le $ le_sup hn

theorem exists_nat_subset_range (s : finset ℕ) : ∃n : ℕ, s ⊆ range n :=
⟨_, s.subset_range_sup_succ⟩

lemma sup_induction {p : α → Prop} (hb : p ⊥) (hp : ∀ (a₁ a₂ : α), p a₁ → p a₂ → p (a₁ ⊔ a₂))
  (hs : ∀ b ∈ s, p (f b)) : p (s.sup f) :=
begin
  induction s using finset.cons_induction with c s hc ih,
  { exact hb, },
  { rw sup_cons,
    apply hp,
    { exact hs c (mem_cons.2 (or.inl rfl)), },
    { exact ih (λ b h, hs b (mem_cons.2 (or.inr h))), }, },
end

lemma sup_le_of_le_directed {α : Type*} [semilattice_sup_bot α] (s : set α)
  (hs : s.nonempty) (hdir : directed_on (≤) s) (t : finset α):
  (∀ x ∈ t, ∃ y ∈ s, x ≤ y) → ∃ x, x ∈ s ∧ t.sup id ≤ x :=
begin
  classical,
  apply finset.induction_on t,
  { simpa only [forall_prop_of_true, and_true, forall_prop_of_false, bot_le, not_false_iff,
      sup_empty, forall_true_iff, not_mem_empty], },
  { intros a r har ih h,
    have incs : ↑r ⊆ ↑(insert a r), by { rw finset.coe_subset, apply finset.subset_insert, },
    -- x ∈ s is above the sup of r
    obtain ⟨x, ⟨hxs, hsx_sup⟩⟩ := ih (λ x hx, h x $ incs hx),
    -- y ∈ s is above a
    obtain ⟨y, hys, hay⟩ := h a (finset.mem_insert_self a r),
    -- z ∈ s is above x and y
    obtain ⟨z, hzs, ⟨hxz, hyz⟩⟩ := hdir x hxs y hys,
    use [z, hzs],
    rw [sup_insert, id.def, _root_.sup_le_iff],
    exact ⟨le_trans hay hyz, le_trans hsx_sup hxz⟩, },
end

-- If we acquire sublattices
-- the hypotheses should be reformulated as `s : subsemilattice_sup_bot`
lemma sup_mem
  (s : set α) (w₁ : ⊥ ∈ s) (w₂ : ∀ x y ∈ s, x ⊔ y ∈ s)
  {ι : Type*} (t : finset ι) (p : ι → α) (h : ∀ i ∈ t, p i ∈ s) :
  t.sup p ∈ s :=
@sup_induction _ _ _ _ _ (∈ s) w₁ w₂ h

end sup

lemma sup_eq_supr [complete_lattice β] (s : finset α) (f : α → β) : s.sup f = (⨆a∈s, f a) :=
le_antisymm
  (finset.sup_le $ assume a ha, le_supr_of_le a $ le_supr _ ha)
  (supr_le $ assume a, supr_le $ assume ha, le_sup ha)

lemma sup_eq_Sup [complete_lattice α] (s : finset α) : s.sup id = Sup s :=
by simp [Sup_eq_supr, sup_eq_supr]

/-! ### inf -/
section inf
variables [semilattice_inf_top α]

/-- Infimum of a finite set: `inf {a, b, c} f = f a ⊓ f b ⊓ f c` -/
def inf (s : finset β) (f : β → α) : α := s.fold (⊓) ⊤ f

variables {s s₁ s₂ : finset β} {f : β → α}

lemma inf_def : s.inf f = (s.1.map f).inf := rfl

@[simp] lemma inf_empty : (∅ : finset β).inf f = ⊤ :=
fold_empty

@[simp] lemma inf_cons {b : β} (h : b ∉ s) : (cons b s h).inf f = f b ⊓ s.inf f :=
@sup_cons (order_dual α) _ _ _ _ _ h

@[simp] lemma inf_insert [decidable_eq β] {b : β} : (insert b s : finset β).inf f = f b ⊓ s.inf f :=
fold_insert_idem

lemma inf_image [decidable_eq β] (s : finset γ) (f : γ → β) (g : β → α):
  (s.image f).inf g = s.inf (g ∘ f) :=
fold_image_idem

@[simp] lemma inf_map (s : finset γ) (f : γ ↪ β) (g : β → α) :
  (s.map f).inf g = s.inf (g ∘ f) :=
fold_map

@[simp] lemma inf_singleton {b : β} : ({b} : finset β).inf f = f b :=
inf_singleton

lemma inf_union [decidable_eq β] : (s₁ ∪ s₂).inf f = s₁.inf f ⊓ s₂.inf f :=
@sup_union (order_dual α) _ _ _ _ _ _

theorem inf_congr {f g : β → α} (hs : s₁ = s₂) (hfg : ∀a∈s₂, f a = g a) : s₁.inf f = s₂.inf g :=
by subst hs; exact finset.fold_congr hfg

lemma le_inf_iff {a : α} : a ≤ s.inf f ↔ ∀ b ∈ s, a ≤ f b :=
@sup_le_iff (order_dual α) _ _ _ _ _

lemma inf_le {b : β} (hb : b ∈ s) : s.inf f ≤ f b :=
le_inf_iff.1 (le_refl _) _ hb

lemma le_inf {a : α} : (∀b ∈ s, a ≤ f b) → a ≤ s.inf f :=
le_inf_iff.2

lemma inf_mono_fun {g : β → α} (h : ∀b∈s, f b ≤ g b) : s.inf f ≤ s.inf g :=
le_inf (λ b hb, le_trans (inf_le hb) (h b hb))

lemma inf_mono (h : s₁ ⊆ s₂) : s₂.inf f ≤ s₁.inf f :=
le_inf $ assume b hb, inf_le (h hb)

@[simp] lemma lt_inf_iff [is_total α (≤)] {a : α} (ha : a < ⊤) : a < s.inf f ↔ (∀ b ∈ s, a < f b) :=
@sup_lt_iff (order_dual α) _ _ _ _ _ _ ha

@[simp] lemma inf_le_iff [is_total α (≤)] {a : α} (ha : a < ⊤) : s.inf f ≤ a ↔ (∃ b ∈ s, f b ≤ a) :=
@le_sup_iff (order_dual α) _ _ _ _ _ _ ha

@[simp] lemma inf_lt_iff [is_total α (≤)] {a : α} : s.inf f < a ↔ (∃ b ∈ s, f b < a) :=
@lt_sup_iff (order_dual α) _ _ _ _ _ _

lemma comp_inf_eq_inf_comp [semilattice_inf_top γ] {s : finset β}
  {f : β → α} (g : α → γ) (g_inf : ∀ x y, g (x ⊓ y) = g x ⊓ g y) (top : g ⊤ = ⊤) :
  g (s.inf f) = s.inf (g ∘ f) :=
@comp_sup_eq_sup_comp (order_dual α) _ (order_dual γ) _ _ _ _ _ g_inf top

lemma comp_inf_eq_inf_comp_of_is_total [h : is_total α (≤)] {γ : Type} [semilattice_inf_top γ]
  (g : α → γ) (mono_g : monotone g) (top : g ⊤ = ⊤) : g (s.inf f) = s.inf (g ∘ f) :=
comp_inf_eq_inf_comp g mono_g.map_inf top

/-- Computating `inf` in a subtype (closed under `inf`) is the same as computing it in `α`. -/
lemma inf_coe {P : α → Prop}
  {Ptop : P ⊤} {Pinf : ∀{{x y}}, P x → P y → P (x ⊓ y)}
  (t : finset β) (f : β → {x : α // P x}) :
  (@inf _ _ (subtype.semilattice_inf_top Ptop Pinf) t f : α) = t.inf (λ x, f x) :=
@sup_coe (order_dual α) _ _ _ Ptop Pinf t f

lemma inf_induction {p : α → Prop} (ht : p ⊤) (hp : ∀ (a₁ a₂ : α), p a₁ → p a₂ → p (a₁ ⊓ a₂))
  (hs : ∀ b ∈ s, p (f b)) : p (s.inf f) :=
@sup_induction (order_dual α) _ _ _ _ _ ht hp hs

lemma inf_mem
  (s : set α) (w₁ : ⊤ ∈ s) (w₂ : ∀ x y ∈ s, x ⊓ y ∈ s)
  {ι : Type*} (t : finset ι) (p : ι → α) (h : ∀ i ∈ t, p i ∈ s) :
  t.inf p ∈ s :=
@inf_induction _ _ _ _ _ (∈ s) w₁ w₂ h

end inf

lemma inf_eq_infi [complete_lattice β] (s : finset α) (f : α → β) : s.inf f = (⨅a∈s, f a) :=
@sup_eq_supr _ (order_dual β) _ _ _

lemma inf_eq_Inf [complete_lattice α] (s : finset α) : s.inf id = Inf s :=
by simp [Inf_eq_infi, inf_eq_infi]

section sup'
variables [semilattice_sup α]

lemma sup_of_mem {s : finset β} (f : β → α) {b : β} (h : b ∈ s) :
  ∃ (a : α), s.sup (coe ∘ f : β → with_bot α) = ↑a :=
Exists.imp (λ a, Exists.fst) (@le_sup (with_bot α) _ _ _ _ _ h (f b) rfl)

/-- Given nonempty finset `s` then `s.sup' H f` is the supremum of its image under `f` in (possibly
unbounded) join-semilattice `α`, where `H` is a proof of nonemptiness. If `α` has a bottom element
you may instead use `finset.sup` which does not require `s` nonempty. -/
def sup' (s : finset β) (H : s.nonempty) (f : β → α) : α :=
option.get $ let ⟨b, hb⟩ := H in option.is_some_iff_exists.2 (sup_of_mem f hb)

variables {s : finset β} (H : s.nonempty) (f : β → α)

@[simp] lemma coe_sup' : ((s.sup' H f : α) : with_bot α) = s.sup (coe ∘ f) :=
by rw [sup', ←with_bot.some_eq_coe, option.some_get]

@[simp] lemma sup'_cons {b : β} {hb : b ∉ s} {h : (cons b s hb).nonempty} :
  (cons b s hb).sup' h f = f b ⊔ s.sup' H f :=
by { rw ←with_bot.coe_eq_coe, simp only [coe_sup', sup_cons, with_bot.coe_sup], }

@[simp] lemma sup'_insert [decidable_eq β] {b : β} {h : (insert b s).nonempty} :
  (insert b s).sup' h f = f b ⊔ s.sup' H f :=
by { rw ←with_bot.coe_eq_coe, simp only [coe_sup', sup_insert, with_bot.coe_sup], }

@[simp] lemma sup'_singleton {b : β} {h : ({b} : finset β).nonempty} :
  ({b} : finset β).sup' h f = f b := rfl

lemma sup'_le {a : α} (hs : ∀ b ∈ s, f b ≤ a) : s.sup' H f ≤ a :=
by { rw [←with_bot.coe_le_coe, coe_sup'], exact sup_le (λ b h, with_bot.coe_le_coe.2 $ hs b h), }

lemma le_sup' {b : β} (h : b ∈ s) : f b ≤ s.sup' ⟨b, h⟩ f :=
by { rw [←with_bot.coe_le_coe, coe_sup'], exact le_sup h, }

@[simp] lemma sup'_const (a : α) : s.sup' H (λ b, a) = a :=
begin
  apply le_antisymm,
  { apply sup'_le, intros, apply le_refl, },
  { apply le_sup' (λ b, a) H.some_spec, }
end

@[simp] lemma sup'_le_iff {a : α} : s.sup' H f ≤ a ↔ ∀ b ∈ s, f b ≤ a :=
iff.intro (λ h b hb, trans (le_sup' f hb) h) (sup'_le H f)

@[simp] lemma sup'_lt_iff [is_total α (≤)] {a : α} : s.sup' H f < a ↔ (∀ b ∈ s, f b < a) :=
begin
  rw [←with_bot.coe_lt_coe, coe_sup', sup_lt_iff (with_bot.bot_lt_coe a)],
  exact ball_congr (λ b hb, with_bot.coe_lt_coe),
end

@[simp] lemma le_sup'_iff [is_total α (≤)] {a : α} : a ≤ s.sup' H f ↔ (∃ b ∈ s, a ≤ f b) :=
begin
  rw [←with_bot.coe_le_coe, coe_sup', le_sup_iff (with_bot.bot_lt_coe a)],
  exact bex_congr (λ b hb, with_bot.coe_le_coe),
end

@[simp] lemma lt_sup'_iff [is_total α (≤)] {a : α} : a < s.sup' H f ↔ (∃ b ∈ s, a < f b) :=
begin
  rw [←with_bot.coe_lt_coe, coe_sup', lt_sup_iff],
  exact bex_congr (λ b hb, with_bot.coe_lt_coe),
end

lemma comp_sup'_eq_sup'_comp [semilattice_sup γ] {s : finset β} (H : s.nonempty)
  {f : β → α} (g : α → γ) (g_sup : ∀ x y, g (x ⊔ y) = g x ⊔ g y) :
  g (s.sup' H f) = s.sup' H (g ∘ f) :=
begin
  rw [←with_bot.coe_eq_coe, coe_sup'],
  let g' : with_bot α → with_bot γ := with_bot.rec_bot_coe ⊥ (λ x, ↑(g x)),
  show g' ↑(s.sup' H f) = s.sup (λ a, g' ↑(f a)),
  rw coe_sup',
  refine comp_sup_eq_sup_comp g' _ rfl,
  intros f₁ f₂,
  cases f₁,
  { rw [with_bot.none_eq_bot, bot_sup_eq], exact bot_sup_eq.symm, },
  { cases f₂, refl,
    exact congr_arg coe (g_sup f₁ f₂), },
end

lemma sup'_induction {p : α → Prop} (hp : ∀ (a₁ a₂ : α), p a₁ → p a₂ → p (a₁ ⊔ a₂))
  (hs : ∀ b ∈ s, p (f b)) : p (s.sup' H f) :=
begin
  show @with_bot.rec_bot_coe α (λ _, Prop) true p ↑(s.sup' H f),
  rw coe_sup',
  refine sup_induction trivial _ hs,
  intros a₁ a₂ h₁ h₂,
  cases a₁,
  { rw [with_bot.none_eq_bot, bot_sup_eq], exact h₂, },
  { cases a₂, exact h₁, exact hp a₁ a₂ h₁ h₂, },
end

lemma exists_mem_eq_sup' [is_total α (≤)] : ∃ b, b ∈ s ∧ s.sup' H f = f b :=
begin
  induction s using finset.cons_induction with c s hc ih,
  { exact false.elim (not_nonempty_empty H), },
  { rcases s.eq_empty_or_nonempty with rfl | hs,
    { exact ⟨c, mem_singleton_self c, rfl⟩, },
    { rcases ih hs with ⟨b, hb, h'⟩,
      rw [sup'_cons hs, h'],
      cases total_of (≤) (f b) (f c) with h h,
      { exact ⟨c, mem_cons.2 (or.inl rfl), sup_eq_left.2 h⟩, },
      { exact ⟨b, mem_cons.2 (or.inr hb), sup_eq_right.2 h⟩, }, }, },
end

lemma sup'_mem
  (s : set α) (w : ∀ x y ∈ s, x ⊔ y ∈ s)
  {ι : Type*} (t : finset ι) (H : t.nonempty) (p : ι → α) (h : ∀ i ∈ t, p i ∈ s) :
  t.sup' H p ∈ s :=
sup'_induction H p w h

end sup'

section inf'
variables [semilattice_inf α]

lemma inf_of_mem {s : finset β} (f : β → α) {b : β} (h : b ∈ s) :
  ∃ (a : α), s.inf (coe ∘ f : β → with_top α) = ↑a :=
@sup_of_mem (order_dual α) _ _ _ f _ h

/-- Given nonempty finset `s` then `s.inf' H f` is the infimum of its image under `f` in (possibly
unbounded) meet-semilattice `α`, where `H` is a proof of nonemptiness. If `α` has a top element you
may instead use `finset.inf` which does not require `s` nonempty. -/
def inf' (s : finset β) (H : s.nonempty) (f : β → α) : α :=
@sup' (order_dual α) _ _ s H f

variables {s : finset β} (H : s.nonempty) (f : β → α)

@[simp] lemma coe_inf' : ((s.inf' H f : α) : with_top α) = s.inf (coe ∘ f) :=
@coe_sup' (order_dual α) _ _ _ H f

@[simp] lemma inf'_cons {b : β} {hb : b ∉ s} {h : (cons b s hb).nonempty} :
  (cons b s hb).inf' h f = f b ⊓ s.inf' H f :=
@sup'_cons (order_dual α) _ _ _ H f _ _ _

@[simp] lemma inf'_insert [decidable_eq β] {b : β} {h : (insert b s).nonempty} :
  (insert b s).inf' h f = f b ⊓ s.inf' H f :=
@sup'_insert (order_dual α) _ _ _ H f _ _ _

@[simp] lemma inf'_singleton {b : β} {h : ({b} : finset β).nonempty} :
  ({b} : finset β).inf' h f = f b := rfl

lemma le_inf' {a : α} (hs : ∀ b ∈ s, a ≤ f b) : a ≤ s.inf' H f :=
@sup'_le (order_dual α) _ _ _ H f _ hs

lemma inf'_le {b : β} (h : b ∈ s) : s.inf' ⟨b, h⟩ f ≤ f b :=
@le_sup' (order_dual α) _ _ _ f _ h

@[simp] lemma inf'_const (a : α) : s.inf' H (λ b, a) = a :=
@sup'_const (order_dual α) _ _ _ _ _

@[simp] lemma le_inf'_iff {a : α} : a ≤ s.inf' H f ↔ ∀ b ∈ s, a ≤ f b :=
@sup'_le_iff (order_dual α) _ _ _ H f _

@[simp] lemma lt_inf'_iff [is_total α (≤)] {a : α} : a < s.inf' H f ↔ (∀ b ∈ s, a < f b) :=
@sup'_lt_iff (order_dual α) _ _ _ H f _ _

@[simp] lemma inf'_le_iff [is_total α (≤)] {a : α} : s.inf' H f ≤ a ↔ (∃ b ∈ s, f b ≤ a) :=
@le_sup'_iff (order_dual α) _ _ _ H f _ _

@[simp] lemma inf'_lt_iff [is_total α (≤)] {a : α} : s.inf' H f < a ↔ (∃ b ∈ s, f b < a) :=
@lt_sup'_iff (order_dual α) _ _ _ H f _ _

lemma comp_inf'_eq_inf'_comp [semilattice_inf γ] {s : finset β} (H : s.nonempty)
  {f : β → α} (g : α → γ) (g_inf : ∀ x y, g (x ⊓ y) = g x ⊓ g y) :
  g (s.inf' H f) = s.inf' H (g ∘ f) :=
@comp_sup'_eq_sup'_comp (order_dual α) _ (order_dual γ) _ _ _ H f g g_inf

lemma inf'_induction {p : α → Prop} (hp : ∀ (a₁ a₂ : α), p a₁ → p a₂ → p (a₁ ⊓ a₂))
  (hs : ∀ b ∈ s, p (f b)) : p (s.inf' H f) :=
@sup'_induction (order_dual α) _ _ _ H f _ hp hs

lemma exists_mem_eq_inf' [is_total α (≤)] : ∃ b, b ∈ s ∧ s.inf' H f = f b :=
@exists_mem_eq_sup' (order_dual α) _ _ _ H f _

lemma inf'_mem (s : set α) (w : ∀ x y ∈ s, x ⊓ y ∈ s)
  {ι : Type*} (t : finset ι) (H : t.nonempty) (p : ι → α) (h : ∀ i ∈ t, p i ∈ s) :
  t.inf' H p ∈ s :=
inf'_induction H p w h

end inf'

section sup
variable [semilattice_sup_bot α]

lemma sup'_eq_sup {s : finset β} (H : s.nonempty) (f : β → α) : s.sup' H f = s.sup f :=
le_antisymm (sup'_le H f (λ b, le_sup)) (sup_le (λ b, le_sup' f))

lemma sup_closed_of_sup_closed {s : set α} (t : finset α) (htne : t.nonempty) (h_subset : ↑t ⊆ s)
  (h : ∀⦃a b⦄, a ∈ s → b ∈ s → a ⊔ b ∈ s) : t.sup id ∈ s :=
sup'_eq_sup htne id ▸ sup'_induction _ _ h h_subset

lemma exists_mem_eq_sup [is_total α (≤)] (s : finset β) (h : s.nonempty) (f : β → α) :
  ∃ b, b ∈ s ∧ s.sup f = f b :=
sup'_eq_sup h f ▸ exists_mem_eq_sup' h f

end sup

section inf
variable [semilattice_inf_top α]

lemma inf'_eq_inf {s : finset β} (H : s.nonempty) (f : β → α) : s.inf' H f = s.inf f :=
@sup'_eq_sup (order_dual α) _ _ _ H f

lemma inf_closed_of_inf_closed {s : set α} (t : finset α) (htne : t.nonempty) (h_subset : ↑t ⊆ s)
  (h : ∀⦃a b⦄, a ∈ s → b ∈ s → a ⊓ b ∈ s) : t.inf id ∈ s :=
@sup_closed_of_sup_closed (order_dual α) _ _ t htne h_subset h

lemma exists_mem_eq_inf [is_total α (≤)] (s : finset β) (h : s.nonempty) (f : β → α) :
  ∃ a, a ∈ s ∧ s.inf f = f a :=
@exists_mem_eq_sup (order_dual α) _ _ _ _ h f

end inf

section sup
variables {C : β → Type*} [Π (b : β), semilattice_sup_bot (C b)]

@[simp]
protected lemma sup_apply (s : finset α) (f : α → Π (b : β), C b) (b : β) :
  s.sup f b = s.sup (λ a, f a b) :=
comp_sup_eq_sup_comp (λ x : Π b : β, C b, x b) (λ i j, rfl) rfl

end sup

section inf
variables {C : β → Type*} [Π (b : β), semilattice_inf_top (C b)]

@[simp]
protected lemma inf_apply (s : finset α) (f : α → Π (b : β), C b) (b : β) :
  s.inf f b = s.inf (λ a, f a b) :=
@finset.sup_apply _ _ (λ b, order_dual (C b)) _ s f b

end inf

section sup'
variables {C : β → Type*} [Π (b : β), semilattice_sup (C b)]

@[simp]
protected lemma sup'_apply {s : finset α} (H : s.nonempty) (f : α → Π (b : β), C b) (b : β) :
  s.sup' H f b = s.sup' H (λ a, f a b) :=
comp_sup'_eq_sup'_comp H (λ x : Π b : β, C b, x b) (λ i j, rfl)

end sup'

section inf'
variables {C : β → Type*} [Π (b : β), semilattice_inf (C b)]

@[simp]
protected lemma inf'_apply {s : finset α} (H : s.nonempty) (f : α → Π (b : β), C b) (b : β) :
  s.inf' H f b = s.inf' H (λ a, f a b) :=
@finset.sup'_apply _ _ (λ b, order_dual (C b)) _ _ H f b

end inf'

/-! ### max and min of finite sets -/
section max_min
variables [linear_order α]

/-- Let `s` be a finset in a linear order. Then `s.max` is the maximum of `s` if `s` is not empty,
and `none` otherwise. It belongs to `option α`. If you want to get an element of `α`, see
`s.max'`. -/
protected def max : finset α → option α :=
fold (option.lift_or_get max) none some

theorem max_eq_sup_with_bot (s : finset α) :
  s.max = @sup (with_bot α) α _ s some := rfl

@[simp] theorem max_empty : (∅ : finset α).max = none := rfl

@[simp] theorem max_insert {a : α} {s : finset α} :
  (insert a s).max = option.lift_or_get max (some a) s.max := fold_insert_idem

@[simp] theorem max_singleton {a : α} : finset.max {a} = some a :=
by { rw [← insert_emptyc_eq], exact max_insert }

theorem max_of_mem {s : finset α} {a : α} (h : a ∈ s) : ∃ b, b ∈ s.max :=
(@le_sup (with_bot α) _ _ _ _ _ h _ rfl).imp $ λ b, Exists.fst

theorem max_of_nonempty {s : finset α} (h : s.nonempty) : ∃ a, a ∈ s.max :=
let ⟨a, ha⟩ := h in max_of_mem ha

theorem max_eq_none {s : finset α} : s.max = none ↔ s = ∅ :=
⟨λ h, s.eq_empty_or_nonempty.elim id
  (λ H, let ⟨a, ha⟩ := max_of_nonempty H in by rw h at ha; cases ha),
  λ h, h.symm ▸ max_empty⟩

theorem mem_of_max {s : finset α} : ∀ {a : α}, a ∈ s.max → a ∈ s :=
finset.induction_on s (λ _ H, by cases H)
  (λ b s _ (ih : ∀ {a}, a ∈ s.max → a ∈ s) a (h : a ∈ (insert b s).max),
  begin
    by_cases p : b = a,
    { induction p, exact mem_insert_self b s },
    { cases option.lift_or_get_choice max_choice (some b) s.max with q q;
      rw [max_insert, q] at h,
      { cases h, cases p rfl },
      { exact mem_insert_of_mem (ih h) } }
  end)

theorem le_max_of_mem {s : finset α} {a b : α} (h₁ : a ∈ s) (h₂ : b ∈ s.max) : a ≤ b :=
by rcases @le_sup (with_bot α) _ _ _ _ _ h₁ _ rfl with ⟨b', hb, ab⟩;
   cases h₂.symm.trans hb; assumption

/-- Let `s` be a finset in a linear order. Then `s.min` is the minimum of `s` if `s` is not empty,
and `none` otherwise. It belongs to `option α`. If you want to get an element of `α`, see
`s.min'`. -/
protected def min : finset α → option α :=
fold (option.lift_or_get min) none some

theorem min_eq_inf_with_top (s : finset α) :
  s.min = @inf (with_top α) α _ s some := rfl

@[simp] theorem min_empty : (∅ : finset α).min = none := rfl

@[simp] theorem min_insert {a : α} {s : finset α} :
  (insert a s).min = option.lift_or_get min (some a) s.min :=
fold_insert_idem

@[simp] theorem min_singleton {a : α} : finset.min {a} = some a :=
by { rw ← insert_emptyc_eq, exact min_insert }

theorem min_of_mem {s : finset α} {a : α} (h : a ∈ s) : ∃ b, b ∈ s.min :=
(@inf_le (with_top α) _ _ _ _ _ h _ rfl).imp $ λ b, Exists.fst

theorem min_of_nonempty {s : finset α} (h : s.nonempty) : ∃ a, a ∈ s.min :=
let ⟨a, ha⟩ := h in min_of_mem ha

theorem min_eq_none {s : finset α} : s.min = none ↔ s = ∅ :=
⟨λ h, s.eq_empty_or_nonempty.elim id
  (λ H, let ⟨a, ha⟩ := min_of_nonempty H in by rw h at ha; cases ha),
  λ h, h.symm ▸ min_empty⟩

theorem mem_of_min {s : finset α} : ∀ {a : α}, a ∈ s.min → a ∈ s :=
@mem_of_max (order_dual α) _ s

theorem min_le_of_mem {s : finset α} {a b : α} (h₁ : b ∈ s) (h₂ : a ∈ s.min) : a ≤ b :=
by rcases @inf_le (with_top α) _ _ _ _ _ h₁ _ rfl with ⟨b', hb, ab⟩;
   cases h₂.symm.trans hb; assumption

/-- Given a nonempty finset `s` in a linear order `α `, then `s.min' h` is its minimum, as an
element of `α`, where `h` is a proof of nonemptiness. Without this assumption, use instead `s.min`,
taking values in `option α`. -/
def min' (s : finset α) (H : s.nonempty) : α :=
@option.get _ s.min $
  let ⟨k, hk⟩ := H in
  let ⟨b, hb⟩ := min_of_mem hk in by simp at hb; simp [hb]

/-- Given a nonempty finset `s` in a linear order `α `, then `s.max' h` is its maximum, as an
element of `α`, where `h` is a proof of nonemptiness. Without this assumption, use instead `s.max`,
taking values in `option α`. -/
def max' (s : finset α) (H : s.nonempty) : α :=
@option.get _ s.max $
  let ⟨k, hk⟩ := H in
  let ⟨b, hb⟩ := max_of_mem hk in by simp at hb; simp [hb]

variables (s : finset α) (H : s.nonempty)

theorem min'_mem : s.min' H ∈ s := mem_of_min $ by simp [min']

theorem min'_le (x) (H2 : x ∈ s) : s.min' ⟨x, H2⟩ ≤ x := min_le_of_mem H2 $ option.get_mem _

theorem le_min' (x) (H2 : ∀ y ∈ s, x ≤ y) : x ≤ s.min' H := H2 _ $ min'_mem _ _

theorem is_least_min' : is_least ↑s (s.min' H) := ⟨min'_mem _ _, min'_le _⟩

@[simp] lemma le_min'_iff {x} : x ≤ s.min' H ↔ ∀ y ∈ s, x ≤ y :=
le_is_glb_iff (is_least_min' s H).is_glb

/-- `{a}.min' _` is `a`. -/
@[simp] lemma min'_singleton (a : α) :
  ({a} : finset α).min' (singleton_nonempty _) = a :=
by simp [min']

theorem max'_mem : s.max' H ∈ s := mem_of_max $ by simp [max']

theorem le_max' (x) (H2 : x ∈ s) : x ≤ s.max' ⟨x, H2⟩ := le_max_of_mem H2 $ option.get_mem _

theorem max'_le (x) (H2 : ∀ y ∈ s, y ≤ x) : s.max' H ≤ x := H2 _ $ max'_mem _ _

theorem is_greatest_max' : is_greatest ↑s (s.max' H) := ⟨max'_mem _ _, le_max' _⟩

@[simp] lemma max'_le_iff {x} : s.max' H ≤ x ↔ ∀ y ∈ s, y ≤ x :=
is_lub_le_iff (is_greatest_max' s H).is_lub

/-- `{a}.max' _` is `a`. -/
@[simp] lemma max'_singleton (a : α) :
  ({a} : finset α).max' (singleton_nonempty _) = a :=
by simp [max']

theorem min'_lt_max' {i j} (H1 : i ∈ s) (H2 : j ∈ s) (H3 : i ≠ j) :
  s.min' ⟨i, H1⟩ < s.max' ⟨i, H1⟩ :=
is_glb_lt_is_lub_of_ne (s.is_least_min' _).is_glb (s.is_greatest_max' _).is_lub H1 H2 H3

/--
If there's more than 1 element, the min' is less than the max'. An alternate version of
`min'_lt_max'` which is sometimes more convenient.
-/
lemma min'_lt_max'_of_card (h₂ : 1 < card s) :
  s.min' (finset.card_pos.mp $ lt_trans zero_lt_one h₂) <
  s.max' (finset.card_pos.mp $ lt_trans zero_lt_one h₂) :=
begin
  rcases one_lt_card.1 h₂ with ⟨a, ha, b, hb, hab⟩,
  exact s.min'_lt_max' ha hb hab
end

lemma max'_eq_of_dual_min' {s : finset α} (hs : s.nonempty) :
  max' s hs = of_dual (min' (image to_dual s) (nonempty.image hs to_dual)) :=
begin
  rw [of_dual, to_dual, equiv.coe_fn_mk, equiv.coe_fn_symm_mk, id.def],
  simp_rw (@image_id (order_dual α) (s : finset (order_dual α))),
  refl,
end

lemma min'_eq_of_dual_max' {s : finset α} (hs : s.nonempty) :
  min' s hs = of_dual (max' (image to_dual s) (nonempty.image hs to_dual)) :=
begin
  rw [of_dual, to_dual, equiv.coe_fn_mk, equiv.coe_fn_symm_mk, id.def],
  simp_rw (@image_id (order_dual α) (s : finset (order_dual α))),
  refl,
end

@[simp] lemma of_dual_max_eq_min_of_dual {a b : α} :
  of_dual (max a b) = min (of_dual a) (of_dual b) := rfl

@[simp] lemma of_dual_min_eq_max_of_dual {a b : α} :
  of_dual (min a b) = max (of_dual a) (of_dual b) := rfl

lemma max'_subset {s t : finset α} (H : s.nonempty) (hst : s ⊆ t) :
  s.max' H ≤ t.max' (H.mono hst) :=
le_max' _ _ (hst (s.max'_mem H))

lemma min'_subset {s t : finset α} (H : s.nonempty) (hst : s ⊆ t) :
  t.min' (H.mono hst) ≤ s.min' H :=
min'_le _ _ (hst (s.min'_mem H))

lemma max'_insert (a : α) (s : finset α) (H : s.nonempty) :
  (insert a s).max' (s.insert_nonempty a) = max (s.max' H) a :=
(is_greatest_max' _ _).unique $
  by { rw [coe_insert, max_comm], exact (is_greatest_max' _ _).insert _ }

lemma min'_insert (a : α) (s : finset α) (H : s.nonempty) :
  (insert a s).min' (s.insert_nonempty a) = min (s.min' H) a :=
(is_least_min' _ _).unique $
  by { rw [coe_insert, min_comm], exact (is_least_min' _ _).insert _ }

/-- Induction principle for `finset`s in a linearly ordered type: a predicate is true on all
`s : finset α` provided that:

* it is true on the empty `finset`,
* for every `s : finset α` and an element `a` strictly greater than all elements of `s`, `p s`
  implies `p (insert a s)`. -/
@[elab_as_eliminator]
lemma induction_on_max [decidable_eq α] {p : finset α → Prop} (s : finset α) (h0 : p ∅)
  (step : ∀ a s, (∀ x ∈ s, x < a) → p s → p (insert a s)) : p s :=
begin
  induction hn : s.card with n ihn generalizing s,
  { rwa [card_eq_zero.1 hn] },
  { have A : s.nonempty, from card_pos.1 (hn.symm ▸ n.succ_pos),
    have B : s.max' A ∈ s, from max'_mem s A,
    rw [← insert_erase B],
    refine step _ _ (λ x hx, _) (ihn _ _),
    { rw [mem_erase] at hx, exact (le_max' s x hx.2).lt_of_ne hx.1 },
    { rw [card_erase_of_mem B, hn, nat.pred_succ] } }
end

/-- Induction principle for `finset`s in a linearly ordered type: a predicate is true on all
`s : finset α` provided that:

* it is true on the empty `finset`,
* for every `s : finset α` and an element `a` strictly less than all elements of `s`, `p s`
  implies `p (insert a s)`. -/
@[elab_as_eliminator]
lemma induction_on_min [decidable_eq α] {p : finset α → Prop} (s : finset α) (h0 : p ∅)
  (step : ∀ a s, (∀ x ∈ s, a < x) → p s → p (insert a s)) : p s :=
@induction_on_max (order_dual α) _ _ _ s h0 step

end max_min

section exists_max_min

variables [linear_order α]
lemma exists_max_image (s : finset β) (f : β → α) (h : s.nonempty) :
  ∃ x ∈ s, ∀ x' ∈ s, f x' ≤ f x :=
begin
  cases max_of_nonempty (h.image f) with y hy,
  rcases mem_image.mp (mem_of_max hy) with ⟨x, hx, rfl⟩,
  exact ⟨x, hx, λ x' hx', le_max_of_mem (mem_image_of_mem f hx') hy⟩,
end

lemma exists_min_image (s : finset β) (f : β → α) (h : s.nonempty) :
  ∃ x ∈ s, ∀ x' ∈ s, f x ≤ f x' :=
@exists_max_image (order_dual α) β _ s f h

end exists_max_min
end finset

namespace multiset

lemma count_sup [decidable_eq β] (s : finset α) (f : α → multiset β) (b : β) :
  count b (s.sup f) = s.sup (λa, count b (f a)) :=
begin
  letI := classical.dec_eq α,
  refine s.induction _ _,
  { exact count_zero _ },
  { assume i s his ih,
    rw [finset.sup_insert, sup_eq_union, count_union, finset.sup_insert, ih],
    refl }
end

lemma mem_sup {α β} [decidable_eq β] {s : finset α} {f : α → multiset β}
  {x : β} : x ∈ s.sup f ↔ ∃ v ∈ s, x ∈ f v :=
begin
  classical,
  apply s.induction_on,
  { simp },
  { intros a s has hxs,
    rw [finset.sup_insert, multiset.sup_eq_union, multiset.mem_union],
    split,
    { intro hxi,
      cases hxi with hf hf,
      { refine ⟨a, _, hf⟩,
        simp only [true_or, eq_self_iff_true, finset.mem_insert] },
      { rcases hxs.mp hf with ⟨v, hv, hfv⟩,
        refine ⟨v, _, hfv⟩,
        simp only [hv, or_true, finset.mem_insert] } },
    { rintros ⟨v, hv, hfv⟩,
      rw [finset.mem_insert] at hv,
      rcases hv with rfl | hv,
      { exact or.inl hfv },
      { refine or.inr (hxs.mpr ⟨v, hv, hfv⟩) } } },
end

end multiset

namespace finset

lemma mem_sup {α β} [decidable_eq β] {s : finset α} {f : α → finset β}
  {x : β} : x ∈ s.sup f ↔ ∃ v ∈ s, x ∈ f v :=
begin
  change _ ↔ ∃ v ∈ s, x ∈ (f v).val,
  rw [←multiset.mem_sup, ←multiset.mem_to_finset, sup_to_finset],
  simp_rw [val_to_finset],
end

lemma sup_eq_bUnion {α β} [decidable_eq β] (s : finset α) (t : α → finset β) :
  s.sup t = s.bUnion t :=
by { ext, rw [mem_sup, mem_bUnion], }

end finset

section lattice
variables {ι : Type*} {ι' : Sort*} [complete_lattice α]

/-- Supremum of `s i`, `i : ι`, is equal to the supremum over `t : finset ι` of suprema
`⨆ i ∈ t, s i`. This version assumes `ι` is a `Type*`. See `supr_eq_supr_finset'` for a version
that works for `ι : Sort*`. -/
lemma supr_eq_supr_finset (s : ι → α) :
  (⨆i, s i) = (⨆t:finset ι, ⨆i∈t, s i) :=
begin
  classical,
  exact le_antisymm
    (supr_le $ assume b, le_supr_of_le {b} $ le_supr_of_le b $ le_supr_of_le
      (by simp) $ le_refl _)
    (supr_le $ assume t, supr_le $ assume b, supr_le $ assume hb, le_supr _ _)
end

/-- Supremum of `s i`, `i : ι`, is equal to the supremum over `t : finset ι` of suprema
`⨆ i ∈ t, s i`. This version works for `ι : Sort*`. See `supr_eq_supr_finset` for a version
that assumes `ι : Type*` but has no `plift`s. -/
lemma supr_eq_supr_finset' (s : ι' → α) :
  (⨆i, s i) = (⨆t:finset (plift ι'), ⨆i∈t, s (plift.down i)) :=
by rw [← supr_eq_supr_finset, ← equiv.plift.surjective.supr_comp]; refl

/-- Infimum of `s i`, `i : ι`, is equal to the infimum over `t : finset ι` of infima
`⨆ i ∈ t, s i`. This version assumes `ι` is a `Type*`. See `infi_eq_infi_finset'` for a version
that works for `ι : Sort*`. -/
lemma infi_eq_infi_finset (s : ι → α) :
  (⨅i, s i) = (⨅t:finset ι, ⨅i∈t, s i) :=
@supr_eq_supr_finset (order_dual α) _ _ _

/-- Infimum of `s i`, `i : ι`, is equal to the infimum over `t : finset ι` of infima
`⨆ i ∈ t, s i`. This version works for `ι : Sort*`. See `infi_eq_infi_finset` for a version
that assumes `ι : Type*` but has no `plift`s. -/
lemma infi_eq_infi_finset' (s : ι' → α) :
  (⨅i, s i) = (⨅t:finset (plift ι'), ⨅i∈t, s (plift.down i)) :=
@supr_eq_supr_finset' (order_dual α) _ _ _

end lattice

namespace set
variables {ι : Type*} {ι' : Sort*}

/-- Union of an indexed family of sets `s : ι → set α` is equal to the union of the unions
of finite subfamilies. This version assumes `ι : Type*`. See also `Union_eq_Union_finset'` for
a version that works for `ι : Sort*`. -/
lemma Union_eq_Union_finset (s : ι → set α) :
  (⋃i, s i) = (⋃t:finset ι, ⋃i∈t, s i) :=
supr_eq_supr_finset s

/-- Union of an indexed family of sets `s : ι → set α` is equal to the union of the unions
of finite subfamilies. This version works for `ι : Sort*`. See also `Union_eq_Union_finset` for
a version that assumes `ι : Type*` but avoids `plift`s in the right hand side. -/
lemma Union_eq_Union_finset' (s : ι' → set α) :
  (⋃i, s i) = (⋃t:finset (plift ι'), ⋃i∈t, s (plift.down i)) :=
supr_eq_supr_finset' s

/-- Intersection of an indexed family of sets `s : ι → set α` is equal to the intersection of the
intersections of finite subfamilies. This version assumes `ι : Type*`. See also
`Inter_eq_Inter_finset'` for a version that works for `ι : Sort*`. -/
lemma Inter_eq_Inter_finset (s : ι → set α) :
  (⋂i, s i) = (⋂t:finset ι, ⋂i∈t, s i) :=
infi_eq_infi_finset s

/-- Intersection of an indexed family of sets `s : ι → set α` is equal to the intersection of the
intersections of finite subfamilies. This version works for `ι : Sort*`. See also
`Inter_eq_Inter_finset` for a version that assumes `ι : Type*` but avoids `plift`s in the right
hand side. -/
lemma Inter_eq_Inter_finset' (s : ι' → set α) :
  (⋂i, s i) = (⋂t:finset (plift ι'), ⋂i∈t, s (plift.down i)) :=
infi_eq_infi_finset' s

end set

namespace finset

open function

/-! ### Interaction with big lattice/set operations -/

section lattice

lemma supr_coe [has_Sup β] (f : α → β) (s : finset α) :
  (⨆ x ∈ (↑s : set α), f x) = ⨆ x ∈ s, f x :=
rfl

lemma infi_coe [has_Inf β] (f : α → β) (s : finset α) :
  (⨅ x ∈ (↑s : set α), f x) = ⨅ x ∈ s, f x :=
rfl

variables [complete_lattice β]

theorem supr_singleton (a : α) (s : α → β) : (⨆ x ∈ ({a} : finset α), s x) = s a :=
by simp

theorem infi_singleton (a : α) (s : α → β) : (⨅ x ∈ ({a} : finset α), s x) = s a :=
by simp

lemma supr_option_to_finset (o : option α) (f : α → β) :
  (⨆ x ∈ o.to_finset, f x) = ⨆ x ∈ o, f x :=
by { congr, ext, rw [option.mem_to_finset] }

lemma infi_option_to_finset (o : option α) (f : α → β) :
  (⨅ x ∈ o.to_finset, f x) = ⨅ x ∈ o, f x :=
@supr_option_to_finset _ (order_dual β) _ _ _

variables [decidable_eq α]

theorem supr_union {f : α → β} {s t : finset α} :
  (⨆ x ∈ s ∪ t, f x) = (⨆x∈s, f x) ⊔ (⨆x∈t, f x) :=
by simp [supr_or, supr_sup_eq]

theorem infi_union {f : α → β} {s t : finset α} :
  (⨅ x ∈ s ∪ t, f x) = (⨅ x ∈ s, f x) ⊓ (⨅ x ∈ t, f x) :=
by simp [infi_or, infi_inf_eq]

lemma supr_insert (a : α) (s : finset α) (t : α → β) :
  (⨆ x ∈ insert a s, t x) = t a ⊔ (⨆ x ∈ s, t x) :=
by { rw insert_eq, simp only [supr_union, finset.supr_singleton] }

lemma infi_insert (a : α) (s : finset α) (t : α → β) :
  (⨅ x ∈ insert a s, t x) = t a ⊓ (⨅ x ∈ s, t x) :=
by { rw insert_eq, simp only [infi_union, finset.infi_singleton] }

lemma supr_finset_image {f : γ → α} {g : α → β} {s : finset γ} :
  (⨆ x ∈ s.image f, g x) = (⨆ y ∈ s, g (f y)) :=
by rw [← supr_coe, coe_image, supr_image, supr_coe]

lemma sup_finset_image {β γ : Type*} [semilattice_sup_bot β]
  (f : γ → α) (g : α → β) (s : finset γ) :
  (s.image f).sup g = s.sup (g ∘ f) :=
begin
  classical,
  apply finset.induction_on s,
  { simp },
  { intros a s' ha ih,
    rw [sup_insert, image_insert, sup_insert, ih] }
end

lemma infi_finset_image {f : γ → α} {g : α → β} {s : finset γ} :
  (⨅ x ∈ s.image f, g x) = (⨅ y ∈ s, g (f y)) :=
by rw [← infi_coe, coe_image, infi_image, infi_coe]

lemma supr_insert_update {x : α} {t : finset α} (f : α → β) {s : β} (hx : x ∉ t) :
  (⨆ (i ∈ insert x t), function.update f x s i) = (s ⊔ ⨆ (i ∈ t), f i) :=
begin
  simp only [finset.supr_insert, update_same],
  rcongr i hi, apply update_noteq, rintro rfl, exact hx hi
end

lemma infi_insert_update {x : α} {t : finset α} (f : α → β) {s : β} (hx : x ∉ t) :
  (⨅ (i ∈ insert x t), update f x s i) = (s ⊓ ⨅ (i ∈ t), f i) :=
@supr_insert_update α (order_dual β) _ _ _ _ f _ hx

lemma supr_bUnion (s : finset γ) (t : γ → finset α) (f : α → β) :
  (⨆ y ∈ s.bUnion t, f y) = ⨆ (x ∈ s) (y ∈ t x), f y :=
calc (⨆ y ∈ s.bUnion t, f y) = ⨆ y (hy : ∃ x ∈ s, y ∈ t x), f y :
  congr_arg _ $ funext $ λ y, by rw [mem_bUnion]
... = _ : by simp only [supr_exists, @supr_comm _ α]

lemma infi_bUnion (s : finset γ) (t : γ → finset α) (f : α → β) :
  (⨅ y ∈ s.bUnion t, f y) = ⨅ (x ∈ s) (y ∈ t x), f y :=
@supr_bUnion _ (order_dual β) _ _ _ _ _ _

end lattice

@[simp] theorem set_bUnion_coe (s : finset α) (t : α → set β) :
  (⋃ x ∈ (↑s : set α), t x) = ⋃ x ∈ s, t x :=
rfl

@[simp] theorem set_bInter_coe (s : finset α) (t : α → set β) :
  (⋂ x ∈ (↑s : set α), t x) = ⋂ x ∈ s, t x :=
rfl

@[simp] theorem set_bUnion_singleton (a : α) (s : α → set β) :
  (⋃ x ∈ ({a} : finset α), s x) = s a :=
supr_singleton a s

@[simp] theorem set_bInter_singleton (a : α) (s : α → set β) :
  (⋂ x ∈ ({a} : finset α), s x) = s a :=
infi_singleton a s

@[simp] lemma set_bUnion_preimage_singleton (f : α → β) (s : finset β) :
  (⋃ y ∈ s, f ⁻¹' {y}) = f ⁻¹' ↑s :=
set.bUnion_preimage_singleton f ↑s

@[simp] lemma set_bUnion_option_to_finset (o : option α) (f : α → set β) :
  (⋃ x ∈ o.to_finset, f x) = ⋃ x ∈ o, f x :=
supr_option_to_finset o f

@[simp] lemma set_bInter_option_to_finset (o : option α) (f : α → set β) :
  (⋂ x ∈ o.to_finset, f x) = ⋂ x ∈ o, f x :=
infi_option_to_finset o f

variables [decidable_eq α]

lemma set_bUnion_union (s t : finset α) (u : α → set β) :
  (⋃ x ∈ s ∪ t, u x) = (⋃ x ∈ s, u x) ∪ (⋃ x ∈ t, u x) :=
supr_union

lemma set_bInter_inter (s t : finset α) (u : α → set β) :
  (⋂ x ∈ s ∪ t, u x) = (⋂ x ∈ s, u x) ∩ (⋂ x ∈ t, u x) :=
infi_union

@[simp] lemma set_bUnion_insert (a : α) (s : finset α) (t : α → set β) :
  (⋃ x ∈ insert a s, t x) = t a ∪ (⋃ x ∈ s, t x) :=
supr_insert a s t

@[simp] lemma set_bInter_insert (a : α) (s : finset α) (t : α → set β) :
  (⋂ x ∈ insert a s, t x) = t a ∩ (⋂ x ∈ s, t x) :=
infi_insert a s t

@[simp] lemma set_bUnion_finset_image {f : γ → α} {g : α → set β} {s : finset γ} :
  (⋃x ∈ s.image f, g x) = (⋃y ∈ s, g (f y)) :=
supr_finset_image

@[simp] lemma set_bInter_finset_image {f : γ → α} {g : α → set β} {s : finset γ} :
  (⋂ x ∈ s.image f, g x) = (⋂ y ∈ s, g (f y)) :=
infi_finset_image

lemma set_bUnion_insert_update {x : α} {t : finset α} (f : α → set β) {s : set β} (hx : x ∉ t) :
  (⋃ (i ∈ insert x t), @update _ _ _ f x s i) = (s ∪ ⋃ (i ∈ t), f i) :=
supr_insert_update f hx

lemma set_bInter_insert_update {x : α} {t : finset α} (f : α → set β) {s : set β} (hx : x ∉ t) :
  (⋂ (i ∈ insert x t), @update _ _ _ f x s i) = (s ∩ ⋂ (i ∈ t), f i) :=
infi_insert_update f hx

@[simp] lemma set_bUnion_bUnion (s : finset γ) (t : γ → finset α) (f : α → set β) :
  (⋃ y ∈ s.bUnion t, f y) = ⋃ (x ∈ s) (y ∈ t x), f y :=
supr_bUnion s t f

@[simp] lemma set_bInter_bUnion (s : finset γ) (t : γ → finset α) (f : α → set β) :
  (⋂ y ∈ s.bUnion t, f y) = ⋂ (x ∈ s) (y ∈ t x), f y :=
infi_bUnion s t f

end finset


import data.real.basic

--OUTPUT 1
theorem nesbitt_inequality {a b c : ℝ} (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) :=
begin
  have h1 : a + b + c ≠ 0, from by {rw add_zero at hb,rw add_zero at hc, exfalso, exact lt_irrefl 0 (begin linarith, end)},
  have h2 : a + b ≠ 0 ∧ a + c ≠ 0 ∧ b + c ≠ 0, from by {
    have h3 : ¬ (a + b + c = 0), from h1,
    have h4 : ¬ (a + b = 0 ∧ a + c = 0 ∧ b + c = 0), from decidable.finset.le_zero_iff_eq_zero.mp h3,
    have h5 : ¬ (a + b = 0), from h4.imp (λ h6, h6.left),
    have h6 : ¬ (a + c = 0), from h4.imp (λ h7, h7.right.left),
    have h7 : ¬ (b + c = 0), from h4.imp (λ h8, h8.right.right),
    have h8 : ¬ (a + b = 0 ∧ a + c = 0), from and.rec_on h4 (λ h9 h10, h9.symm ▸ h10.symm ▸ h6),
    have h9 : ¬ (a + b = 0), from h8.imp h5,
    have h10 : ¬ (a + c = 0), from h8.imp h6,
    have h11 : ¬ (a + b = 0 ∧ b + c = 0), from and.rec_on h8 (λ h12 h13, h12.symm ▸ h13.symm ▸ h7),
    have h12 : ¬ (a + b = 0), from h11.imp h9,
    have h13 : ¬ (b + c = 0), from h11.imp h7,
    have h14 : ¬ (a + c = 0 ∧ b + c = 0), from and.rec_on h11 (λ h15 h16, h15.symm ▸ h16.symm ▸ h10),
    have h15 : ¬ (a + c = 0), from h14.imp h13,
    have h16 : ¬ (b + c = 0), from h14.imp h7,
    have h17 : ¬ (a + b = 0 ∧ a + c = 0 ∧ b + c = 0), from (λ h18, h18.symm ▸ h12),
    show ¬ (a + b = 0), from by {assume h18, exact h17 ⟨h18,h15,h16⟩},
    show ¬ (a + c = 0), from by {assume h18, exact h17 ⟨h9,h18,h16⟩},
    show ¬ (b + c = 0), from by {assume h18, exact h17 ⟨h9,h15,h18⟩},
  },
  have h3 : (3 / 2) * (a + b + c) = (3 / 2) * a + (3 / 2) * b + (3 / 2) * c, from by rw ← mul_assoc,
  have h4 : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) =
      (a / (b + c)) + (((b + c) / (a + c)) * (b / (b + c))) +
      (c / (a + b)) + (((a + b) / (a + c)) * (c / (c + b))) +
      (((b + c) / (a + c)) * (c / (c + b))) + (((a + c) / (a + b)) * (a / (a + c))) +
      (((a + c) / (a + b)) * (a / (a + c))) + (((a + b) / (a + c)) * (b / (b + c))) +
      (((a + b) / (a + c)) * (c / (c + b))) + (((a + c) / (a + b)) * (b / (b + c))) := by ring,
  have h5: 0 < a + b ∧ 0 < a + c ∧ 0 < b + c, from
    by {split, apply lt_add_of_pos_left ha, apply lt_add_of_pos_right hb, apply lt_add_of_pos_right hc},
  have h6 : (a + b) / (b + c) = 1, from by rw [add_comm (a + b) c, sub_self, div_zero],
  have h7 : (a + c) / (b + c) = ((a + c) * (b + c)) / ((b + c) * (b + c)),
    from by rw [mul_comm (a + c) (b + c)],
  have h8 : 0 < (a + c) * (b + c), from by {rw ← (mul_two_pos h5.left h5.right), linarith},
  have h9 : ((a + c) * (b + c)) / ((b + c) * (b + c)) = 1, from by rw div_mul_cancel h8,
  have h10 : (a + b) / (a + c) = 1, from by rw [add_comm a b, sub_self, div_zero],
  have h11 : (b + c) / (a + c) = ((b + c) * (a + c)) / ((a + c) * (a + c)),
    from by rw mul_comm (b + c) (a + c),
  have h12 : 0 < (b + c) * (a + c), from by {rw ← (mul_two_pos h5.right h5.left), linarith},
  have h13 : ((b + c) * (a + c)) / ((a + c) * (a + c)) = 1, from by rw div_mul_cancel h12,
  have h14 : (a + c) / (a + b) = 1, from by rw [add_comm a c, sub_self, div_zero],
  have h15 : (b + c) / (a + b) = ((b + c) * (a + b)) / ((a + b) * (a + b)),
    from by rw mul_comm (b + c) (a + b),
  have h16 : 0 < (b + c) * (a + b), from by {rw ← (mul_two_pos h5.right h5.left), linarith},
  have h17 : ((b + c) * (a + b)) / ((a + b) * (a + b)) = 1, from by rw div_mul_cancel h16,
  have h18 : a / (a + c) = 1, from by rw [add_comm a c, sub_self, div_zero],
  have h19 : (b + c) / (a + c) = ((b + c) * (a + c)) / ((a + c) * (a + c)),
    from by rw mul_comm (b + c) (a + c),
  have h20 : 0 < (b + c) * (a + c), from by {rw ← (mul_two_pos h5.right h5.left), linarith},
  have h21 : ((b + c) * (a + c)) / ((a + c) * (a + c)) = 1, from by rw div_mul_cancel h20,
  have h22 : (a + b) / (a + c) = 1, from by rw [add_comm a b, sub_self, div_zero],
  have h23 : (b + c) / (a + c) = ((b + c) * (a + c)) / ((a + c) * (a + c)),
    from by rw mul_comm (b + c) (a + c),
  have h24 : 0 < (b + c) * (a + c), from by {rw ← (mul_two_pos h5.right h5.left), linarith
end --Needs more than 2000 tokens!

--OUTPUT 2
theorem nesbitt_inequality {a b c : ℝ} (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) :=
begin
  rw ← add_three,
  rw ← add_mul, rw ← add_mul, rw ← add_mul,
  rw ← add_halves, rw add_halves, rw add_halves,
  show (a/ (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ 3 / 2,
  apply arithmetic_harmonic_mean,
  simp,
end

--OUTPUT 3
theorem nesbitt_inequality {a b c : ℝ} (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) :=
begin
  calc (a / (b + c)) + (b / (a + c)) + (c / (a + b)) = (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) : by ring
  ... = 9 * ((a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b)) : by rw [← mul_three, mul_comm]
  ... ≥ 9 * (1 / (b + c) + 1 / (a + c) + 1 / (a + b)) / 3 : by rw [← mul_three, mul_comm, div_mul_eq_mul_div, div_self ha]
  ... = 3 / ((b + c) + (a + c) + (a + b)) : by {rw add_mul, rw div_mul_eq_mul_div, ring}
  ... ≥ 3 / (2 * (a + b + c)) : by apply harmonic_mean_le_arithmetic_mean
  ... = 3 / (2 * (a + b)) : by rw add_assoc a b c
  ... = 3 / (2 * a) : by rw add_comm a b
  ... ≥ 3 / (2 * (a + c)) : by apply real.lt_of_add_lt_add_right hc
  ... ≥ 3 / (2 * (b + c)) : by apply real.lt_of_add_lt_add_right ha
  ... = 3 / (2 * b) : by rw add_comm b c
  ... ≥ 3 / (2 * (b + c)) : by apply real.lt_of_add_lt_add_right hc
  ... ≥ 3 / (2 * (a + c)) : by apply real.lt_of_add_lt_add_right hb
  ... = 3 / (2 * a) : by rw add_comm a c
  ... ≥ 3 / (2 * a) : by apply real.lt_of_add_lt_add_right ha
  ... = (3 / 2) : rfl,
end

--OUTPUT 4
theorem nesbitt_inequality {a b c : ℝ} (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) :=
begin
  calc
  (a / (b + c)) +  (b / (a + c)) + (c / (a + b)) ≥
  (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) : by linarith
  ... ≥ (9 * (a + b + c)) / ((b + c) + (a + c) + (a + b)) : by linarith
  ... ≥ (3 / ((1 / (b + c)) + (1 / (a + c)) + (1 / (a + b)))) : by {
    rw [mul_comm (3:ℝ),mul_comm (a + b + c),mul_assoc,mul_assoc,mul_inv_cancel (a + b + c),mul_one],
    rw [mul_comm a,mul_assoc,mul_inv_cancel (a:ℝ),mul_one,←add_mul,←add_mul,←mul_add,←mul_add,←mul_add,←mul_add,←mul_add,←mul_add],
    rw [←mul_assoc,←mul_assoc,mul_inv_cancel (a:ℝ),mul_one,←add_mul,←add_mul,←mul_add,←mul_add,←mul_add,←mul_add,←mul_add,←mul_add],
    rw [←mul_assoc,←mul_assoc,mul_inv_cancel (a:ℝ),mul_one,←add_mul,←add_mul,←mul_add,←mul_add,←mul_add,←mul_add,←mul_add,←mul_add],
    rw [←mul_assoc,←mul_assoc,mul_inv_cancel (a:ℝ),mul_one,←add_mul,←add_mul,←mul_add,←mul_add,←mul_add,←mul_add,←mul_add,←mul_add],
    rw [←mul_assoc,←mul_assoc,mul_inv_cancel (b:ℝ),mul_one,←add_mul,←add_mul,←mul_add,←mul_add,←mul_add,←mul_add,←mul_add,←mul_add],
    rw [←mul_assoc,←mul_assoc,mul_inv_cancel (b:ℝ),mul_one,←add_mul,←add_mul,←mul_add,←mul_add,←mul_add,←mul_add,←mul_add,←mul_add],
    rw [←mul_assoc,←mul_assoc,mul_inv_cancel (b:ℝ),mul_one,←add_mul,←add_mul,←mul_add,←mul_add,←mul_add,←mul_add,←mul_add,←mul_add],
    rw [←mul_assoc,←mul_assoc,mul_inv_cancel (b:ℝ),mul_one,←add_mul,←add_mul,←mul_add,←mul_add,←mul_add,←mul_add,←mul_add,←mul_add],
    rw [←mul_assoc,←mul_assoc,mul_inv_cancel (c:ℝ),mul_one,←add_mul,←add_mul,←mul_add,←mul_add,←mul_add,←mul_add,←mul_add,←mul_add],
    rw [←mul_assoc,←mul_assoc,mul_inv_cancel (c:ℝ),mul_one,←add_mul,←add_mul,←mul_add,←mul_add,←mul_add,←mul_add,←mul_add,←mul_add],
    rw [←mul_assoc,←mul_assoc,mul_inv_cancel (c:ℝ),mul_one,←add_mul,←add_mul,←mul_add,←mul_add,←mul_add,←mul_add,←mul_add,←mul_add],
    rw [←mul_assoc,←mul_assoc,mul_inv_cancel (c:ℝ),mul_one,←add_mul,←add_mul,←mul_add,←mul_add,←mul_add,←mul_add,←mul_add,←mul_add],
    rw [←mul_add,←mul_add,←mul_add,←mul_add,←mul_add,←mul_add],
    rw [←mul_assoc,←mul_assoc,mul_inv_cancel (9:ℝ),mul_one],
    have h1 : ((c + a) + b)⁻¹ = (c + a)⁻¹ + b⁻¹, from calc
                ((c + a) + b)⁻¹ = ((c + a)⁻¹ + b⁻¹) : by {rw add_mul, rw ←mul_assoc, rw ←mul_assoc, rw ←mul_assoc, rw mul_inv_cancel, rw one_mul, rw [mul_comm,add_mul,mul_assoc,mul_assoc,mul_comm b,mul_assoc,mul_assoc,mul_comm]},
          rw h1,
          have h2 : b⁻¹ * (c + a)⁻¹ = (c + a)⁻¹ * b⁻¹, from mul_comm _ _,
          rw h2,
          rw add_mul,
          have h3 : (c + a) + b = a + (b + c), from calc (c + a) + b = (c * 1 + a * 1) + b : by repeat {rw mul_one}
          ... = (c + a) + b : by repeat {rw add_mul},
          rw h3,
          ring,
    rw mul_comm 3,
    have h4 : (3 : ℝ)⁻¹ = (1 : ℝ) / 3, from calc (3 : ℝ)⁻¹ = (1 : ℝ) / (1 * 3) : by rw one_mul
    ... = (1 : ℝ) / 3 : by rw mul_comm,
    rw h4,
    rw ←mul_inv_cancel,
    rw ←mul_assoc,
    rw ←mul_assoc,
    rw ←mul_assoc,
    rw mul_inv_cancel,
    rw mul_one,
    rw mul_comm 3,
    rw ←mul_assoc,
    rw ←mul_assoc,
    rw ←mul_assoc,
    rw ←mul_assoc
end --Needs more than 2000 tokens!

--OUTPUT 5
theorem nesbitt_inequality {a b c : ℝ} (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) :=
begin
  have h1 : (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) ≥ 9 / 2, from arithmetic_mean_harmonic_mean (b + c) (a + c) (a + b) 3 ha hb hc,
  have h2 :  (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) ≥ 3 / (2 * (a + b + c)), from by {rw mul_comm, show _ ≥ _, from by linarith},
  have h3 : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ 3 / (2 * (a + b + c)), from by {rw [ha,hb,hc], linarith},
  have h4 : (a + b + c) > 0, from by {linarith},
  show _ ≥ _, from by {rw [mul_comm (3 / 2) (a + b + c),div_mul_cancel _ h4], exact h3},
end

--OUTPUT 6
theorem nesbitt_inequality {a b c : ℝ} (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) :=
begin
  have h1 : (3 : ℝ) / 2 ≤ a / (b + c) + b / (a + c) + c / (a + b), from by {
    have h2 : (a : ℝ) / 2 ≤ a / (b + c) + b / (a + c) + c / (a + b), from by {
      have h3 : ((a + b + c) : ℝ) / 2 ≤ a / (b + c) + b / (a + c) + c / (a + b), from by {
        have h4 : ((a + b + c) : ℝ) / 2 ≥ (a : ℝ) / ((b + c) + (a + c) + (a + b)), from by {
          have h5 : 1/(b + c) + 1/(a + c) + 1/(a + b) ≥ 3 * (1/(b + c) + 1/(a + c) + 1/(a + b)) / ((b + c) + (a + c) + (a + b)),
            from by {exact harmonic_mean_arithmetic_mean_inequality (1 / (b + c)) (1 / (a + c)) (1 / (a + b))},
          rw ← mul_assoc,
          rw ← ← one_div_mul_cancel (a + b + c),
          rw one_div_eq_inv,
          rw mul_comm,
          rw mul_assoc,
          rw ← div_eq_mul_one_div,
          rw ← mul_assoc,
          rw ← div_eq_mul_one_div,
          apply mul_le_mul h5 ha,
          apply add_pos,
          rw mul_comm (a + b + c),
          exact zero_add _,
          intros x hx,
          exact hc,
          intros x hx,
          exact hb,
        },
        rw ← add_assoc,
        rw ← add_assoc,
        rw ← add_assoc,
        rw add_comm (a + b),
        rw add_comm (a + c),
        rw add_comm (b + c),
        rw add_assoc,
        rw add_assoc,
        rw ← add_assoc (a + b),
        rw ← add_assoc,
        apply add_le_add_right (b / (a + c)),
        apply add_le_add_left (c / (a + b)),
        exact h4,
        apply lt_of_le_of_lt h3,
        rw ← add_assoc,
        rw ← add_assoc,
        rw ← add_assoc,
        rw ← add_assoc,
        rw ← add_assoc,
        rw ← div_eq_mul_one_div,
        rw ← div_eq_mul_one_div,
        rw ← div_eq_mul_one_div,
        rw ← mul_assoc,
        rw ← mul_assoc,
        rw ← mul_assoc,
        rw mul_comm (3 : ℝ),
        rw ← mul_assoc,
        rw ← mul_assoc,
        apply mul_lt_mul ha,
        exact add_pos hc hb,
        exact add_pos hc ha,
        exact add_pos hb ha,
        intros x hx,
        exact hc,
        intros x hx,
        exact hb,
        intros x hx,
        exact ha,
      },
      rw ← add_assoc,
      rw ← add_assoc,
      rw ← add_assoc,
      rw ← add_assoc,
      rw ← add_assoc,
      rw ← add_assoc,
      rw ← add_assoc,
      rw ← add_assoc,
      rw ← add_assoc,
      rw ← add_assoc,
      rw add_comm (b + c),
      rw add_comm (a + c),
      rw add_comm (a + b),
      rw ← add_assoc,
      rw ← add_assoc,
      rw ← add_assoc,
      rw ← add_assoc,
      rw ← add_assoc,
      rw ← add_assoc,
      rw add_assoc (a + b),
      rw add_assoc,
      rw add_comm (a + b),
      rw add_assoc,
      rw ← add_assoc (a + b + c),
      rw add_comm (a + b + c),
      apply add_le_add_right (c / (a + b)),
      apply add_le_add_right (b / (a + c)),
      apply add_le_add_left (a / (b + c)),
      exact h3,
      apply lt_of_le_of_lt h2,
      rw ← add_assoc,
      rw ← add_assoc,
      rw ← add_assoc,
      rw ← add_assoc,
      rw ← add_assoc,
      rw ← add_assoc,
      rw ← add_assoc,
      rw ← add_assoc,
      rw ← add_assoc,
      rw ← add_assoc,
      rw ← add_assoc,
      rw ← add_assoc,
      rw add_comm (b + c),
      rw add_comm (a + c),
      rw add_comm (a + b),
      rw ← add_assoc,
      rw ← add_assoc,
      rw ← add_assoc,
      rw ← add_assoc,
      rw ← add_assoc,
      rw ← add_assoc,
      rw ← add_assoc,
      rw ← add_assoc,
      rw ← add_assoc,
      rw ← add_assoc,
      rw ← add_assoc,
      rw ← add_assoc,
      rw ← add_assoc,
      rw ← add_assoc,
      rw ← add_assoc,
      rw ← add_assoc,
      rw ← add_assoc,
      rw ← add_assoc,
      rw ← mul_assoc,
      rw ← mul_assoc,
      rw ← mul_assoc,
      rw ← mul_assoc,
      rw ← mul_assoc,
      rw ← mul_assoc,
      rw ← div_eq_mul_one_div,
      rw ← div_eq_mul_one_div,
      rw ← div_eq_mul_one_div,
      rw ← div_eq_mul_one_div,
      rw ← div_eq_mul_one_div,
      rw ← div_eq_mul_one_div,
      rw ← div_eq_mul_one_div,
      rw ← mul_assoc,
      rw ← mul_assoc,
      rw ← mul_assoc,
      rw ← mul_assoc,
      rw ← mul_assoc,
      rw ← mul_assoc,
      rw ← mul_assoc,
      rw ← mul_assoc,
      rw mul_comm (3 : ℝ),
      rw mul_assoc,
      rw mul_assoc,
      rw mul_assoc,
      rw mul_assoc,
      rw mul_comm (3 : ℝ),
      apply mul_lt_mul ha,
      exact add_pos hb hc,
      exact add_pos
end --Needs more than 2000 tokens!

--OUTPUT 7
theorem nesbitt_inequality {a b c : ℝ} (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) :=
begin
  have h1 : (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) ≥ 9 / 2, from
    arith_mean_never_less_than_harmonic_mean _ _ _,
  calc
     (a / (b + c)) + (b / (a + c)) + (c / (a + b)) = 3 * ((a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b)) / (a + b + c) : by ring
  ... = (9 / 2) / (a + b + c) : by rw [mul_comm 3,mul_assoc, mul_div_cancel _ (by apply add_pos ha hb; linarith), ←mul_div_cancel' _ (by linarith),h1]
  ... = (3 / 2) * ((a + b + c) / (a + b + c) : by rw [mul_div_cancel _ (by linarith), ←div_div_cancel, mul_comm 3,←mul_div_cancel' _ (by linarith)])
  ... = (3 / 2) * (1 : ℝ) : by rw [div_self ha, one_mul]
  ... = (3 / 2) : rfl,
end

--OUTPUT 8
theorem nesbitt_inequality {a b c : ℝ} (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) :=
begin
  have h1 : (a + b + c) / (b+c) ≥ (9 * (a + b + c)) / ((b + c) + (a + c) + (a + b)), from by {
    rw ← inv_inv' (hb + hc),
    have h1 : b + c ≠ 0, from assume h, by { rw h at hb, simp at hb },
    have h2 : a + c ≠ 0, from assume h, by { rw h at hc, simp at hc },
    have h3 : a + b ≠ 0, from assume h, by { have h4 : b ≠ 0, from assume h5, by { rw h5 at hb, simp at hb },
    have h5 : a ≠ 0, from assume h6, by { rw h6 at ha, simp at ha },
    have h6 : b = 0, from eq_zero_of_add_eq_zero (h h4 h5) ,
    rw h6 at hb, simp at hb },
    have h4 : b + c + (a + c) + (a + b) ≠ 0, from assume h5, by {
      rw h5 at h1 h2 h3, simp at h1 h2 h3, },
    have h5 : (3 : ℝ) ≠ 0, from assume h6, by { rw h6, simp, },
    have h6 : (a + b + c) ≠ 0, from assume h7, by { rw h7 at ha hb hc, simp at ha hb hc },
    calc 9 * (a + b + c) / ((b + c) + (a + c) + (a + b)) = (3 * 3) * (a + b + c) / ((b + c) + (a + c) + (a + b))
      : by rw mul_comm (3 : ℝ) (3 : ℝ)
    ... = 3 * 3 * (a + b + c) / ((b + c) + (a + c) + (a + b)) : by rw mul_comm (3 : ℝ) (a + b + c)
    ... = 3 * (3 * (a + b + c)) / ((b + c) + (a + c) + (a + b)) : by simp
    ... = 3 * ((a + b + c) / (b + c) + (a + c) + (a + b)) : by rw add_mul
    ... = 3 * ((a + b + c) / (b + c)) + 3 * ((a + c) + (a + b)) : by rw add_mul
    ... = 3 * ((a + b + c) / (b + c) + (a + c)) + 3 * (a + b) : by rw add_assoc
    ... = 3 * ((a + b + c) / (b + c) + (a + c)) + 3 * a + 3 * b : by rw add_mul
    ... = (a + b + c) * ((a + b + c) / (b + c)) + 3 * ((a + c) + a + b) : by rw mul_comm (a + b + c) 3
    ... = (a + b + c) * ((a + b + c) / (b + c)) + 3 * ((a + c) + (b + a)) : by rw add_comm a b
    ... = (a + b + c) * ((a + b + c) / (b + c)) + 3 * ((a + c) + b + a) : by rw add_assoc
    ... = (a + b + c) * ((a + b + c) / (b + c)) + 3 * (b + a + (a + c)) : by rw add_comm b a
    ... = (a + b + c) * ((a + b + c) / (b + c)) + 3 * (b + (a + a + c)) : by rw add_assoc
    ... = (a + b + c) * ((a + b + c) / (b + c)) + 3 * (b + a + a + c) : by rw add_assoc a a c
    ... = (a + b + c) * ((a + b + c) / (b + c)) + 3 * (a + a + b + c) : by rw add_comm b a
    ... = (a + b + c) * ((a + b + c) / (b + c)) + 3 * (a + (a + b) + c) : by rw add_assoc
    ... = (a + b + c) * (a + b + c) / (b + c) + 3 * ((a + b) + c) : by rw add_mul
    ... = (a + b + c) * a / (b + c) + (a + b + c) * b / (b + c) + (a + b + c) * c / (b + c) + 3 * ((a + b) + c) : by rw add_mul
    ... = (a * (a + b + c)) / (b + c) + (b * (a + b + c)) / (b + c) + (c * (a + b + c)) / (b + c) + 3 * ((a + b) + c) : by rw mul_comm (a + b + c)
    ... = a * a / (b + c) + b * a / (b + c) + c * a / (b + c) + a * b / (b + c) + b * b / (b + c) + c * b / (b + c) + a * c / (b + c) + b * c / (b + c) + c * c / (b + c) + 3 * ((a + b) + c) : by rw add_mul
    ... = a * a / (b + c) + b * a / (b + c) + c * a / (b + c) + b * a / (b + c) + a * b / (b + c) + c * b / (b + c) + b * c / (b + c) + a * c / (b + c) + c * c / (b + c) + 3 * ((a + b) + c) : by rw add_mul
    ... = a * a / (b + c) + b * a / (b + c) + c * a / (b + c) + a * b / (b + c) + b * b / (b + c) + c * b / (b + c) + a * c / (b + c) + b * c / (b + c) + c * c / (b + c) + 3 * ((a + b) + c) : by rw add_mul
    ... = a / (b + c) * a + b / (b + c) * a + c / (b + c) * a + a / (b + c) * b + b / (b + c) * b + c / (b + c) * b + a / (b + c) * c + b / (b + c) * c + c / (b + c) * c + 3 * (a + b + c) : by rw mul_comm
    ... = a / (b + c) * a + a / (b + c) * b + a / (b + c) * c + b / (b + c) * a + b / (b + c) * b + b / (b + c) * c + c / (b + c) * a + c / (b + c) * b + c / (b + c) * c + 3 * (a + b + c) : by rw add_mul
    ... = a / (b + c) * a + a / (b + c) * b + a / (b + c) * c + a / (b + c) * b + b / (b + c) * b + b / (b + c) * c + a / (b + c) * c + b / (b + c) * c + c / (b + c) * c + 3 * (a + b + c) : by rw add_mul
    ... = a / (b + c) * a + b / (b + c) * b + a
end --Needs more than 2000 tokens!

--OUTPUT 9
theorem nesbitt_inequality {a b c : ℝ} (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) :=
begin
  calc (a / (b + c)) + (b / (a + c)) + (c / (a + b)) = 3 * (a / (b + c)) + 3 * (b / (a + c)) + 3 * (c / (a + b)) : by ring
  ... = 3 * ((a / (b + c)) + (b / (a + c)) + (c / (a + b))) : by {simp only [mul_add], rw [← add_assoc], simp only [three_mul],}
  ... ≥ 3 * (3 / (b + c) + (a + c) + (a + b))⁻¹ : by {apply mul_le_mul_of_nonneg_right (by norm_num), apply arithmetic_ge_harmonic,}
  ... = 3 / (3 * (3 / (b + c) + (a + c) + (a + b))) : by {rw div_mul_div_assoc, rw div_self (by norm_num), simp [three_mul],}
  ... = 3 / ((b + c) + (a + c) + (a + b)) : by ring
  ... ≥ 2.5 : by {apply div_le_of_le_mul, norm_num, rw [← add_assoc,add_comm (a + b) c,add_assoc],simp [add_assoc], exact add_nonneg (add_nonneg ha hb) hc,}
  ... = 3 / 2 : by norm_num,
end

--OUTPUT 10
theorem nesbitt_inequality {a b c : ℝ} (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) :=
begin
  apply le_of_eq,
  have h1 : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) = (a + b + c) / (b + c) +
    (a + b + c) / (a + c) + (a + b + c) / (a + b), from by ring,
  have h2 : (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) =
    (9 / 2) * (a + b + c), from by {rw ← div_mul_cancel, simp, ring},
  rw [h1,h2],
  have h3 : (9 / 2) * (a + b + c) ≥ (3 / 2) * (1 / ((b + c) + (a + c) + (a + b))), from
    mul_le_mul (arithmetic_mean_ge_harmonic_mean (1 / (b + c)) (1 / (a + c)) (1 / (a + b)))
    (zero_lt_one) (zero_lt_one),
  have h4 : (a + b + c) ≠ 0, from lt_of_le_of_lt (by apply le_of_lt; apply add_three_nonneg; apply ha;apply hb;apply hc) one_add_one,
  have h5 : (3 / 2) * (1 / ((b + c) + (a + c) + (a + b))) = ((3 / 2) * (1 / (b + c) + 1 / (a + c) + 1 / (a + b))) / ((b + c) + (a + c) + (a + b)), from by ring,
  rw [div_mul_cancel h4, h5] at h3,
  convert h3,
  have h6 : (1 / (b + c) + 1 / (a + c) + 1 / (a + b)) ≠ 0, from
    by {apply add_ne_zero, apply inv_pos, apply add_pos,
    apply hb, apply hc, apply ha, apply hc, apply hb, apply ha},
  have h7 : (3 / 2) * (1 / (b + c) + 1 / (a + c) + 1 / (a + b)) =
    (a / (b + c)) + (b / (a + c)) + (c / (a + b)), from by ring,
  rw [div_mul_cancel h6, h7],
end

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from by {split,apply set.subset_of_mem_powerset,exact hA,apply set.subset_of_mem_powerset,exact hB},
  have h2 : (A ∩ B) ⊆ A, from by apply set.inter_subset_left,
  have h3 : (A ∩ B) ⊆ S, from by {apply set.subset.trans h2 h1.left},
  show (A ∩ B) ∈  𝒫 S, from by {apply set.mem_powerset h3},
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  calc (x + y)^2 = (x+y)*(x+y) : by rw sq
  ... = x*(x+y) + y*(x+y) : by rw add_mul
  ... = x*x + x*y + y*x + y*y : by {rw [mul_comm x (x+y),mul_comm y (x+y)], rw [add_mul,add_mul], ring}
  ... = x^2 + 2*x*y + y^2 : by {repeat {rw ← sq}, rw mul_comm y x, ring}
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from by {
    assume a b : G, use a⁻¹ * b, obviously, },
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from by {
    assume a b : G, use b * a⁻¹, obviously, },

  have h3 : ∀ a : G, ∃! x : G, a * x = a, from
    assume a : G, h1 a a,
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from
    assume a : G, h2 a a,

  have h5 : ∀ a : G, classical.some (h3 a).exists = (1 : G), from assume a :G,
    exists_unique.unique (h3 a) (classical.some_spec (exists_unique.exists (h3 a)))
    (mul_one a),
  have h6 : ∀ a : G, classical.some (h4 a).exists = (1 : G), from assume a : G,
    exists_unique.unique (h4 a) (classical.some_spec (exists_unique.exists (h4 a))) (one_mul a),

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by {
    use (1 : G),
    have h7 : ∀ e : G, (∀ a : G, e * a = a ∧ a * e = a) → e = 1, from by {
      assume (e : G) (hident : ∀ a : G, e * a = a ∧ a * e = a),
      have h8 : ∀ a : G, e = classical.some (h3 a).exists, from assume (a : G),
        exists_unique.unique (h3 a) (hident a).right
        (classical.some_spec (exists_unique.exists (h3 a))),
      have h9 : ∀ a : G, e = classical.some (h4 a).exists, from assume (a : G),
        exists_unique.unique (h4 a) (hident a).left
        (classical.some_spec (exists_unique.exists (h4 a))),
      show e = (1 : G), from eq.trans (h9 e) (h6 _),
    },
    exact ⟨by obviously, h7⟩,
  }
end

/--`theorem`
Nesbitt's inequality
Let $a$, $b$ and $c$ be positive real numbers.

Then:
:$\dfrac a {b + c} + \dfrac b {a + c} + \dfrac c {a + b} \ge \dfrac 3 2$

`proof`
{{begin-eqn}}
{{eqn | l = \frac a {b + c} + \frac b {a + c} + \frac c {a + b}
      | o = \ge
      | r = \dfrac 3 2
}}
{{eqn | ll= \leadstoandfrom
      | l = \frac {a + b + c} {b + c} + \frac {a + b + c} {a + c} + \frac {a + b + c} {a + b}
      | o = \ge
      | r = \frac 9 2
      | c = by adding $3$
}}
{{eqn | ll= \leadstoandfrom
      | l = \frac {a + b + c} {b + c} + \frac {a + b + c} {a + c} + \frac {a + b + c} {a + b}
      | o = \ge
      | r = \frac {9 \paren {a + b + c} } {\paren {b + c} + \paren {a + c} + \paren {a + b} }
      | c = as $\dfrac {a + b + c} {\paren {b + c} + \paren {a + c} + \paren {a + b} } = \dfrac 1 2$
}}
{{eqn | ll= \leadstoandfrom
      | l = \frac {\frac 1 {b + c} + \frac 1 {a + c} + \frac 1 {a + b} } 3
      | o = \ge
      | r = \frac 3 {\paren {b + c} + \paren {a + c} + \paren {a + b} }
      | c = dividing by $3 \paren {a + b + c}$
}}
{{end-eqn}}
These are the arithmetic mean and the harmonic mean of $\dfrac 1 {b + c}$, $\dfrac 1 {a + c}$ and $\dfrac 1 {a + b}$.

From Arithmetic Mean is Never Less than Harmonic Mean the last inequality is true.

Thus Nesbitt's Inequality holds.
{{qed}}

-/
theorem  nesbitt_inequality {a b c : ℝ} (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) :=
FEW SHOT PROMPTS TO CODEX(END)-/


-- Math 52: Quiz 3
-- Open this file in a folder that contains 'utils'.

import utils.int_refl

definition is_even (n : ℤ) : Prop := ∃ (k : ℤ), n = 2 * k

definition is_odd (n : ℤ) : Prop := ∃ (k : ℤ), n = 2 * k + 1

axiom even_or_odd (n : ℤ) : is_even n ∨ is_odd n

theorem main : ∀ (n : ℤ), is_even (n * n + 3 * n + 2) :=
begin
intro n,
have H := even_or_odd n,
cases H,
{ unfold is_even at H,
  unfold is_even,
  cases H with i Hi,
  existsi (2 * i * i + 3 * i + 1 : ℤ),
  rw Hi,
  int_refl [i],
},
{ unfold is_odd at H,
  unfold is_even,
  cases H with j Hj,
  existsi (2 * j * j + 5 * j + 3 : ℤ),
  rw Hj,
  int_refl [j],
},
end


lemma iff_trans (P Q R : Prop) : (P ↔ Q) → (Q ↔ R) → (P ↔ R) :=
begin
intro h1,
cases h1,
intro h2,
cases h2,
split,
intro p,
exact h2_mp(h1_mp(p)),
intro r,
exact h1_mpr(h2_mpr(r)),
end


/-
Copyright (c) 2022 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import data.finset.pointwise
import data.finsupp.indicator
import data.fintype.card

/-!
# Finitely supported product of finsets

This file defines the finitely supported product of finsets as a `finset (ι →₀ α)`.

## Main declarations

* `finset.finsupp`: Finitely supported product of finsets. `s.finset t` is the product of the `t i`
  over all `i ∈ s`.
* `finsupp.pi`: `f.pi` is the finset of `finsupp`s whose `i`-th value lies in `f i`. This is the
  special case of `finset.finsupp` where we take the product of the `f i` over the support of `f`.

## Implementation notes

We make heavy use of the fact that `0 : finset α` is `{0}`. This scalar actions convention turns out
to be precisely what we want here too.
-/

noncomputable theory

open finsupp
open_locale big_operators classical pointwise

variables {ι α : Type*} [has_zero α] {s : finset ι} {f : ι →₀ α}

namespace finset

/-- Finitely supported product of finsets. -/
protected def finsupp (s : finset ι) (t : ι → finset α) : finset (ι →₀ α) :=
(s.pi t).map ⟨indicator s, indicator_injective s⟩

lemma mem_finsupp_iff {t : ι → finset α} : f ∈ s.finsupp t ↔ f.support ⊆ s ∧ ∀ i ∈ s, f i ∈ t i :=
begin
  refine mem_map.trans ⟨_, _⟩,
  { rintro ⟨f, hf, rfl⟩,
    refine ⟨support_indicator_subset _ _, λ i hi, _⟩,
    convert mem_pi.1 hf i hi,
    exact indicator_of_mem hi _ },
  { refine λ h, ⟨λ i _, f i, mem_pi.2 h.2, _⟩,
    ext i,
    exact ite_eq_left_iff.2 (λ hi, (not_mem_support_iff.1 $ λ H, hi $ h.1 H).symm) }
end

/-- When `t` is supported on `s`, `f ∈ s.finsupp t` precisely means that `f` is pointwise in `t`. -/
@[simp] lemma mem_finsupp_iff_of_support_subset {t : ι →₀ finset α} (ht : t.support ⊆ s) :
  f ∈ s.finsupp t ↔ ∀ i, f i ∈ t i :=
begin
  refine mem_finsupp_iff.trans (forall_and_distrib.symm.trans $ forall_congr $ λ i, ⟨λ h, _,
    λ h, ⟨λ hi, ht $ mem_support_iff.2 $ λ H, mem_support_iff.1 hi _, λ _, h⟩⟩),
  { by_cases hi : i ∈ s,
    { exact h.2 hi },
    { rw [not_mem_support_iff.1 (mt h.1 hi), not_mem_support_iff.1 (λ H, hi $ ht H)],
      exact zero_mem_zero } },
  { rwa [H, mem_zero] at h }
end

@[simp] lemma card_finsupp (s : finset ι) (t : ι → finset α) :
  (s.finsupp t).card = ∏ i in s, (t i).card :=
(card_map _).trans $ card_pi _ _

end finset

open finset

namespace finsupp

/-- Given a finitely supported function `f : ι →₀ finset α`, one can define the finset
`f.pi` of all finitely supported functions whose value at `i` is in `f i` for all `i`. -/
def pi (f : ι →₀ finset α) : finset (ι →₀ α) := f.support.finsupp f

@[simp] lemma mem_pi {f : ι →₀ finset α} {g : ι →₀ α} : g ∈ f.pi ↔ ∀ i, g i ∈ f i :=
mem_finsupp_iff_of_support_subset $ subset.refl _

@[simp] lemma card_pi (f : ι →₀ finset α) : f.pi.card = f.prod (λ i, (f i).card) :=
begin
  rw [pi, card_finsupp],
  exact finset.prod_congr rfl (λ i _, by simp only [pi.nat_apply, nat.cast_id]),
end

end finsupp


/-
Copyright (c) 2022 David Loeffler. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: David Loeffler
-/
import analysis.special_functions.trigonometric.basic
import analysis.special_functions.trigonometric.deriv
import analysis.special_functions.trigonometric.arctan_deriv
/-!
# Polynomial bounds for trigonometric functions

## Main statements

This file contains upper and lower bounds for real trigonometric functions in terms
of polynomials. See `trigonometric.basic` for more elementary inequalities, establishing
the ranges of these functions, and their monotonicity in suitable intervals.

Here we prove the following:

* `sin_lt`: for `x > 0` we have `sin x < x`.
* `sin_gt_sub_cube`: For `0 < x ≤ 1` we have `x - x ^ 3 / 4 < sin x`.
* `lt_tan`: for `0 < x < π/2` we have `x < tan x`.

## Tags

sin, cos, tan, angle
-/

noncomputable theory
open set

namespace real
open_locale real

/-- For 0 < x, we have sin x < x. -/
lemma sin_lt {x : ℝ} (h : 0 < x) : sin x < x :=
begin
  cases lt_or_le 1 x with h' h',
  { exact (sin_le_one x).trans_lt h' },
  have hx : |x| = x := abs_of_nonneg h.le,
  have := le_of_abs_le (sin_bound $ show |x| ≤ 1, by rwa [hx]),
  rw [sub_le_iff_le_add', hx] at this,
  apply this.trans_lt,
  rw [sub_add, sub_lt_self_iff, sub_pos, div_eq_mul_inv (x ^ 3)],
  refine mul_lt_mul' _ (by norm_num) (by norm_num) (pow_pos h 3),
  apply pow_le_pow_of_le_one h.le h',
  norm_num
end

/-- For 0 < x ≤ 1 we have x - x ^ 3 / 4 < sin x.

This is also true for x > 1, but it's nontrivial for x just above 1. This inequality is not
tight; the tighter inequality is sin x > x - x ^ 3 / 6 for all x > 0, but this inequality has
a simpler proof. -/
lemma sin_gt_sub_cube {x : ℝ} (h : 0 < x) (h' : x ≤ 1) : x - x ^ 3 / 4 < sin x :=
begin
  have hx : |x| = x := abs_of_nonneg h.le,
  have := neg_le_of_abs_le (sin_bound $ show |x| ≤ 1, by rwa [hx]),
  rw [le_sub_iff_add_le, hx] at this,
  refine lt_of_lt_of_le _ this,
  have : x ^ 3 / 4 - x ^ 3 / 6 = x ^ 3 * 12⁻¹ := by norm_num [div_eq_mul_inv, ← mul_sub],
  rw [add_comm, sub_add, sub_neg_eq_add, sub_lt_sub_iff_left, ←lt_sub_iff_add_lt', this],
  refine mul_lt_mul' _ (by norm_num) (by norm_num) (pow_pos h 3),
  apply pow_le_pow_of_le_one h.le h',
  norm_num
end

/-- The derivative of `tan x - x` is `1/(cos x)^2 - 1` away from the zeroes of cos. -/
lemma deriv_tan_sub_id (x : ℝ) (h : cos x ≠ 0) :
    deriv (λ y : ℝ, tan y - y) x = 1 / cos x ^ 2 - 1 :=
has_deriv_at.deriv $ by simpa using (has_deriv_at_tan h).add (has_deriv_at_id x).neg

/-- For all `0 ≤ x < π/2` we have `x < tan x`.

This is proved by checking that the function `tan x - x` vanishes
at zero and has non-negative derivative. -/
theorem lt_tan (x : ℝ) (h1 : 0 < x) (h2 : x < π / 2) : x < tan x :=
begin
  let U := Ico 0 (π / 2),

  have intU : interior U = Ioo 0 (π / 2) := interior_Ico,

  have half_pi_pos : 0 < π / 2 := div_pos pi_pos two_pos,

  have cos_pos : ∀ {y : ℝ}, y ∈ U → 0 < cos y,
  { intros y hy,
    exact cos_pos_of_mem_Ioo (Ico_subset_Ioo_left (neg_lt_zero.mpr half_pi_pos) hy) },

  have sin_pos : ∀ {y : ℝ}, y ∈ interior U → 0 < sin y,
  { intros y hy,
    rw intU at hy,
    exact sin_pos_of_mem_Ioo (Ioo_subset_Ioo_right (div_le_self pi_pos.le one_le_two) hy) },

  have tan_cts_U : continuous_on tan U,
  { apply continuous_on.mono continuous_on_tan,
    intros z hz,
    simp only [mem_set_of_eq],
    exact (cos_pos hz).ne' },

  have tan_minus_id_cts : continuous_on (λ y : ℝ, tan y - y) U :=
    tan_cts_U.sub continuous_on_id,

  have deriv_pos : ∀ y : ℝ, y ∈ interior U → 0 < deriv (λ y' : ℝ, tan y' - y') y,
  { intros y hy,
    have := cos_pos (interior_subset hy),
    simp only [deriv_tan_sub_id y this.ne', one_div, gt_iff_lt, sub_pos],
    have bd2 : cos y ^ 2 < 1,
    { apply lt_of_le_of_ne y.cos_sq_le_one,
      rw cos_sq',
      simpa only [ne.def, sub_eq_self, pow_eq_zero_iff, nat.succ_pos']
        using (sin_pos hy).ne' },
    rwa [lt_inv, inv_one],
    { exact zero_lt_one },
    simpa only [sq, mul_self_pos] using this.ne' },

  have mono := convex.strict_mono_on_of_deriv_pos (convex_Ico 0 (π / 2)) tan_minus_id_cts deriv_pos,
  have zero_in_U : (0 : ℝ) ∈ U,
  { rwa left_mem_Ico },
  have x_in_U : x ∈ U := ⟨h1.le, h2⟩,
  simpa only [tan_zero, sub_zero, sub_pos] using mono zero_in_U x_in_U h1
end

end real


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

! This file was ported from Lean 3 source module data.nat.factorization.prime_pow
! leanprover-community/mathlib commit 6ca1a09bc9aa75824bf97388c9e3b441fc4ccf3f
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.IsPrimePow
import Mathlib.Data.Nat.Factorization.Basic

/-!
# Prime powers and factorizations

This file deals with factorizations of prime powers.
-/

variable {R : Type _} [CommMonoidWithZero R] (n p : R) (k : ℕ)

theorem IsPrimePow.minFac_pow_factorization_eq {n : ℕ} (hn : IsPrimePow n) :
    n.minFac ^ n.factorization n.minFac = n := by
  obtain ⟨p, k, hp, hk, rfl⟩ := hn
  rw [← Nat.prime_iff] at hp
  rw [hp.pow_minFac hk.ne', hp.factorization_pow, Finsupp.single_eq_same]
#align is_prime_pow.min_fac_pow_factorization_eq IsPrimePow.minFac_pow_factorization_eq

theorem isPrimePow_of_minFac_pow_factorization_eq {n : ℕ}
    (h : n.minFac ^ n.factorization n.minFac = n) (hn : n ≠ 1) : IsPrimePow n := by
  rcases eq_or_ne n 0 with (rfl | hn')
  · simp_all
  refine' ⟨_, _, (Nat.minFac_prime hn).prime, _, h⟩
  rw [pos_iff_ne_zero, ← Finsupp.mem_support_iff, Nat.factor_iff_mem_factorization,
    Nat.mem_factors_iff_dvd hn' (Nat.minFac_prime hn)]
  apply Nat.minFac_dvd
#align is_prime_pow_of_min_fac_pow_factorization_eq isPrimePow_of_minFac_pow_factorization_eq

theorem isPrimePow_iff_minFac_pow_factorization_eq {n : ℕ} (hn : n ≠ 1) :
    IsPrimePow n ↔ n.minFac ^ n.factorization n.minFac = n :=
  ⟨fun h => h.minFac_pow_factorization_eq, fun h => isPrimePow_of_minFac_pow_factorization_eq h hn⟩
#align is_prime_pow_iff_min_fac_pow_factorization_eq isPrimePow_iff_minFac_pow_factorization_eq

theorem isPrimePow_iff_factorization_eq_single {n : ℕ} :
    IsPrimePow n ↔ ∃ p k : ℕ, 0 < k ∧ n.factorization = Finsupp.single p k := by
  rw [isPrimePow_nat_iff]
  refine' exists₂_congr fun p k => _
  constructor
  · rintro ⟨hp, hk, hn⟩
    exact ⟨hk, by rw [← hn, Nat.Prime.factorization_pow hp]⟩
  · rintro ⟨hk, hn⟩
    have hn0 : n ≠ 0 := by
      rintro rfl
      simp_all only [Finsupp.single_eq_zero, eq_comm, Nat.factorization_zero, hk.ne']
    rw [Nat.eq_pow_of_factorization_eq_single hn0 hn]
    exact
      ⟨Nat.prime_of_mem_factorization (by simp [hn, hk.ne'] : p ∈ n.factorization.support), hk, rfl⟩
#align is_prime_pow_iff_factorization_eq_single isPrimePow_iff_factorization_eq_single

theorem isPrimePow_iff_card_support_factorization_eq_one {n : ℕ} :
    IsPrimePow n ↔ n.factorization.support.card = 1 := by
  simp_rw [isPrimePow_iff_factorization_eq_single, Finsupp.card_support_eq_one', exists_prop,
    pos_iff_ne_zero]
#align is_prime_pow_iff_card_support_factorization_eq_one isPrimePow_iff_card_support_factorization_eq_one

theorem IsPrimePow.exists_ord_compl_eq_one {n : ℕ} (h : IsPrimePow n) :
    ∃ p : ℕ, p.Prime ∧ ord_compl[p] n = 1 := by
  rcases eq_or_ne n 0 with (rfl | hn0); · cases not_isPrimePow_zero h
  rcases isPrimePow_iff_factorization_eq_single.mp h with ⟨p, k, hk0, h1⟩
  rcases em' p.Prime with (pp | pp)
  · refine' absurd _ hk0.ne'
    simp [← Nat.factorization_eq_zero_of_non_prime n pp, h1]
  refine' ⟨p, pp, _⟩
  refine' Nat.eq_of_factorization_eq (Nat.ord_compl_pos p hn0).ne' (by simp) fun q => _
  rw [Nat.factorization_ord_compl n p, h1]
  simp
#align is_prime_pow.exists_ord_compl_eq_one IsPrimePow.exists_ord_compl_eq_one

theorem exists_ord_compl_eq_one_iff_isPrimePow {n : ℕ} (hn : n ≠ 1) :
    IsPrimePow n ↔ ∃ p : ℕ, p.Prime ∧ ord_compl[p] n = 1 := by
  refine' ⟨fun h => IsPrimePow.exists_ord_compl_eq_one h, fun h => _⟩
  rcases h with ⟨p, pp, h⟩
  rw [isPrimePow_nat_iff]
  rw [← Nat.eq_of_dvd_of_div_eq_one (Nat.ord_proj_dvd n p) h] at hn⊢
  refine' ⟨p, n.factorization p, pp, _, by simp⟩
  contrapose! hn
  simp [le_zero_iff.1 hn]
#align exists_ord_compl_eq_one_iff_is_prime_pow exists_ord_compl_eq_one_iff_isPrimePow

/-- An equivalent definition for prime powers: `n` is a prime power iff there is a unique prime
dividing it. -/
theorem isPrimePow_iff_unique_prime_dvd {n : ℕ} : IsPrimePow n ↔ ∃! p : ℕ, p.Prime ∧ p ∣ n := by
  rw [isPrimePow_nat_iff]
  constructor
  · rintro ⟨p, k, hp, hk, rfl⟩
    refine' ⟨p, ⟨hp, dvd_pow_self _ hk.ne'⟩, _⟩
    rintro q ⟨hq, hq'⟩
    exact (Nat.prime_dvd_prime_iff_eq hq hp).1 (hq.dvd_of_dvd_pow hq')
  rintro ⟨p, ⟨hp, hn⟩, hq⟩
  rcases eq_or_ne n 0 with (rfl | hn₀)
  · cases (hq 2 ⟨Nat.prime_two, dvd_zero 2⟩).trans (hq 3 ⟨Nat.prime_three, dvd_zero 3⟩).symm
  refine' ⟨p, n.factorization p, hp, hp.factorization_pos_of_dvd hn₀ hn, _⟩
  simp only [and_imp] at hq
  apply Nat.dvd_antisymm (Nat.ord_proj_dvd _ _)
  -- We need to show n ∣ p ^ n.factorization p
  apply Nat.dvd_of_factors_subperm hn₀
  rw [hp.factors_pow, List.subperm_ext_iff]
  intro q hq'
  rw [Nat.mem_factors hn₀] at hq'
  cases hq _ hq'.1 hq'.2
  simp
#align is_prime_pow_iff_unique_prime_dvd isPrimePow_iff_unique_prime_dvd

theorem isPrimePow_pow_iff {n k : ℕ} (hk : k ≠ 0) : IsPrimePow (n ^ k) ↔ IsPrimePow n := by
  simp only [isPrimePow_iff_unique_prime_dvd]
  apply exists_unique_congr
  simp only [and_congr_right_iff]
  intro p hp
  exact ⟨hp.dvd_of_dvd_pow, fun t => t.trans (dvd_pow_self _ hk)⟩
#align is_prime_pow_pow_iff isPrimePow_pow_iff

theorem Nat.coprime.isPrimePow_dvd_mul {n a b : ℕ} (hab : Nat.coprime a b) (hn : IsPrimePow n) :
    n ∣ a * b ↔ n ∣ a ∨ n ∣ b := by
  rcases eq_or_ne a 0 with (rfl | ha)
  · simp only [Nat.coprime_zero_left] at hab
    simp [hab, Finset.filter_singleton, not_isPrimePow_one]
  rcases eq_or_ne b 0 with (rfl | hb)
  · simp only [Nat.coprime_zero_right] at hab
    simp [hab, Finset.filter_singleton, not_isPrimePow_one]
  refine'
    ⟨_, fun h =>
      Or.elim h (fun i => i.trans ((@dvd_mul_right a b a hab).mpr (dvd_refl a)))
          fun i => i.trans ((@dvd_mul_left a b b hab.symm).mpr (dvd_refl b))⟩
  obtain ⟨p, k, hp, _, rfl⟩ := (isPrimePow_nat_iff _).1 hn
  simp only [hp.pow_dvd_iff_le_factorization (mul_ne_zero ha hb), Nat.factorization_mul ha hb,
    hp.pow_dvd_iff_le_factorization ha, hp.pow_dvd_iff_le_factorization hb, Pi.add_apply,
    Finsupp.coe_add]
  have : a.factorization p = 0 ∨ b.factorization p = 0 := by
    rw [← Finsupp.not_mem_support_iff, ← Finsupp.not_mem_support_iff, ← not_and_or, ←
      Finset.mem_inter]
    intro t -- porting note: used to be `exact` below, but the definition of `∈` has changed.
    simpa using (Nat.factorization_disjoint_of_coprime hab).le_bot t
  cases' this with h h <;> simp [h, imp_or]
#align nat.coprime.is_prime_pow_dvd_mul Nat.coprime.isPrimePow_dvd_mul

theorem Nat.mul_divisors_filter_prime_pow {a b : ℕ} (hab : a.coprime b) :
    (a * b).divisors.filter IsPrimePow = (a.divisors ∪ b.divisors).filter IsPrimePow := by
  rcases eq_or_ne a 0 with (rfl | ha)
  · simp only [Nat.coprime_zero_left] at hab
    simp [hab, Finset.filter_singleton, not_isPrimePow_one]
  rcases eq_or_ne b 0 with (rfl | hb)
  · simp only [Nat.coprime_zero_right] at hab
    simp [hab, Finset.filter_singleton, not_isPrimePow_one]
  ext n
  simp only [ha, hb, Finset.mem_union, Finset.mem_filter, Nat.mul_eq_zero, and_true_iff, Ne.def,
    and_congr_left_iff, not_false_iff, Nat.mem_divisors, or_self_iff]
  apply hab.isPrimePow_dvd_mul
#align nat.mul_divisors_filter_prime_pow Nat.mul_divisors_filter_prime_pow


/-
Copyright (c) 2018 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Kenny Lau, Johan Commelin, Mario Carneiro, Kevin Buzzard,
Amelia Livingston, Yury Kudryashov, Yakov Pechersky
-/
import data.set.lattice
import data.set_like.basic

/-!
# Subsemigroups: definition and `complete_lattice` structure

This file defines bundled multiplicative and additive subsemigrousp. We also define
a `complete_lattice` structure on `subsemigroups`s,
and define the closure of a set as the minimal subsemigroup that includes this set.

## Main definitions

* `subsemigroup M`: the type of bundled subsemigroup of a magma `M`; the underlying set is given in
  the `carrier` field of the structure, and should be accessed through coercion as in `(S : set M)`.
* `add_subsemigroup M` : the type of bundled subsemigroups of an additive magma `M`.

For each of the following definitions in the `subsemigroup` namespace, there is a corresponding
definition in the `add_subsemigroup` namespace.

* `subsemigroup.copy` : copy of a subsemigroup with `carrier` replaced by a set that is equal but
  possibly not definitionally equal to the carrier of the original `subsemigroup`.
* `subsemigroup.closure` :  semigroup closure of a set, i.e.,
  the least subsemigroup that includes the set.
* `subsemigroup.gi` : `closure : set M → subsemigroup M` and coercion `coe : subsemigroup M → set M`
  form a `galois_insertion`;

## Implementation notes

Subsemigroup inclusion is denoted `≤` rather than `⊆`, although `∈` is defined as
membership of a subsemigroup's underlying set.

Note that `subsemigroup M` does not actually require `semigroup M`,
instead requiring only the weaker `has_mul M`.

This file is designed to have very few dependencies. In particular, it should not use natural
numbers.

## Tags
subsemigroup, subsemigroups
-/

variables {M : Type*} {N : Type*}
variables {A : Type*}

section non_assoc
variables [has_mul M] {s : set M}
variables [has_add A] {t : set A}

/-- A subsemigroup of a magma `M` is a subset closed under multiplication. -/
structure subsemigroup (M : Type*) [has_mul M] :=
(carrier : set M)
(mul_mem' {a b} : a ∈ carrier → b ∈ carrier → a * b ∈ carrier)

/-- An additive subsemigroup of an additive magma `M` is a subset closed under addition. -/
structure add_subsemigroup (M : Type*) [has_add M] :=
(carrier : set M)
(add_mem' {a b} : a ∈ carrier → b ∈ carrier → a + b ∈ carrier)

attribute [to_additive add_subsemigroup] subsemigroup

namespace subsemigroup

@[to_additive]
instance : set_like (subsemigroup M) M :=
⟨subsemigroup.carrier, λ p q h, by cases p; cases q; congr'⟩

/-- See Note [custom simps projection] -/
@[to_additive " See Note [custom simps projection]"]
def simps.coe (S : subsemigroup M) : set M := S

initialize_simps_projections subsemigroup (carrier → coe)
initialize_simps_projections add_subsemigroup (carrier → coe)

@[simp, to_additive]
lemma mem_carrier {s : subsemigroup M} {x : M} : x ∈ s.carrier ↔ x ∈ s := iff.rfl

@[simp, to_additive]
lemma mem_mk {s : set M} {x : M} (h_mul) : x ∈ mk s h_mul ↔ x ∈ s := iff.rfl

@[simp, to_additive]
lemma coe_set_mk {s : set M} (h_mul) : (mk s h_mul : set M) = s := rfl

@[simp, to_additive]
lemma mk_le_mk {s t : set M} (h_mul) (h_mul') :
  mk s h_mul ≤ mk t h_mul' ↔ s ⊆ t := iff.rfl

/-- Two subsemigroups are equal if they have the same elements. -/
@[ext, to_additive "Two `add_subsemigroup`s are equal if they have the same elements."]
theorem ext {S T : subsemigroup M}
  (h : ∀ x, x ∈ S ↔ x ∈ T) : S = T := set_like.ext h

/-- Copy a subsemigroup replacing `carrier` with a set that is equal to it. -/
@[to_additive "Copy an additive subsemigroup replacing `carrier` with a set that is equal to
it."]
protected def copy (S : subsemigroup M) (s : set M) (hs : s = S) : subsemigroup M :=
{ carrier := s,
  mul_mem' := hs.symm ▸ S.mul_mem' }

variable {S : subsemigroup M}

@[simp, to_additive] lemma coe_copy {s : set M} (hs : s = S) :
  (S.copy s hs : set M) = s := rfl

@[to_additive] lemma copy_eq {s : set M} (hs : s = S) : S.copy s hs = S :=
set_like.coe_injective hs

variable (S)

/-- A subsemigroup is closed under multiplication. -/
@[to_additive "An `add_subsemigroup` is closed under addition."]
theorem mul_mem {x y : M} : x ∈ S → y ∈ S → x * y ∈ S := subsemigroup.mul_mem' S

/-- The subsemigroup `M` of the magma `M`. -/
@[to_additive "The additive subsemigroup `M` of the magma `M`."]
instance : has_top (subsemigroup M) :=
⟨{ carrier := set.univ,
   mul_mem' := λ _ _ _ _, set.mem_univ _ }⟩

/-- The trivial subsemigroup `∅` of a magma `M`. -/
@[to_additive "The trivial `add_subsemigroup` `∅` of an additive magma `M`."]
instance : has_bot (subsemigroup M) :=
⟨{ carrier := ∅,
   mul_mem' := λ a b, by simp }⟩

@[to_additive]
instance : inhabited (subsemigroup M) := ⟨⊥⟩

@[to_additive] lemma not_mem_bot {x : M} : x ∉ (⊥ : subsemigroup M) := set.not_mem_empty x

@[simp, to_additive] lemma mem_top (x : M) : x ∈ (⊤ : subsemigroup M) := set.mem_univ x

@[simp, to_additive] lemma coe_top : ((⊤ : subsemigroup M) : set M) = set.univ := rfl

@[simp, to_additive] lemma coe_bot : ((⊥ : subsemigroup M) : set M) = ∅ := rfl

/-- The inf of two subsemigroups is their intersection. -/
@[to_additive "The inf of two `add_subsemigroup`s is their intersection."]
instance : has_inf (subsemigroup M) :=
⟨λ S₁ S₂,
  { carrier := S₁ ∩ S₂,
    mul_mem' := λ _ _ ⟨hx, hx'⟩ ⟨hy, hy'⟩,
      ⟨S₁.mul_mem hx hy, S₂.mul_mem hx' hy'⟩ }⟩

@[simp, to_additive]
lemma coe_inf (p p' : subsemigroup M) : ((p ⊓ p' : subsemigroup M) : set M) = p ∩ p' := rfl

@[simp, to_additive]
lemma mem_inf {p p' : subsemigroup M} {x : M} : x ∈ p ⊓ p' ↔ x ∈ p ∧ x ∈ p' := iff.rfl

@[to_additive]
instance : has_Inf (subsemigroup M) :=
⟨λ s,
{ carrier := ⋂ t ∈ s, ↑t,
  mul_mem' := λ x y hx hy, set.mem_bInter $ λ i h,
    i.mul_mem (by apply set.mem_Inter₂.1 hx i h) (by apply set.mem_Inter₂.1 hy i h) }⟩

@[simp, norm_cast, to_additive]
lemma coe_Inf (S : set (subsemigroup M)) : ((Inf S : subsemigroup M) : set M) = ⋂ s ∈ S, ↑s := rfl

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

@[to_additive]
lemma mem_infi {ι : Sort*} {S : ι → subsemigroup M} {x : M} : (x ∈ ⨅ i, S i) ↔ ∀ i, x ∈ S i :=
by simp only [infi, mem_Inf, set.forall_range_iff]

@[simp, norm_cast, to_additive]
lemma coe_infi {ι : Sort*} {S : ι → subsemigroup M} : (↑(⨅ i, S i) : set M) = ⋂ i, S i :=
by simp only [infi, coe_Inf, set.bInter_range]

/-- subsemigroups of a monoid form a complete lattice. -/
@[to_additive "The `add_subsemigroup`s of an `add_monoid` form a complete lattice."]
instance : complete_lattice (subsemigroup M) :=
{ le           := (≤),
  lt           := (<),
  bot          := (⊥),
  bot_le       := λ S x hx, (not_mem_bot hx).elim,
  top          := (⊤),
  le_top       := λ S x hx, mem_top x,
  inf          := (⊓),
  Inf          := has_Inf.Inf,
  le_inf       := λ a b c ha hb x hx, ⟨ha hx, hb hx⟩,
  inf_le_left  := λ a b x, and.left,
  inf_le_right := λ a b x, and.right,
  .. complete_lattice_of_Inf (subsemigroup M) $ λ s,
    is_glb.of_image (λ S T,
      show (S : set M) ≤ T ↔ S ≤ T, from set_like.coe_subset_coe) is_glb_binfi }

@[simp, to_additive]
lemma subsingleton_of_subsingleton [subsingleton (subsemigroup M)] : subsingleton M :=
begin
  constructor; intros x y,
  have : ∀ a : M, a ∈ (⊥ : subsemigroup M),
  { simp [subsingleton.elim (⊥ : subsemigroup M) ⊤] },
  exact absurd (this x) not_mem_bot
end

@[to_additive]
instance [hn : nonempty M] : nontrivial (subsemigroup M) :=
⟨⟨⊥, ⊤, λ h, by { obtain ⟨x⟩ := id hn, refine absurd (_ : x ∈ ⊥) not_mem_bot, simp [h] }⟩⟩

/-- The `subsemigroup` generated by a set. -/
@[to_additive "The `add_subsemigroup` generated by a set"]
def closure (s : set M) : subsemigroup M := Inf {S | s ⊆ S}

@[to_additive]
lemma mem_closure {x : M} : x ∈ closure s ↔ ∀ S : subsemigroup M, s ⊆ S → x ∈ S :=
mem_Inf

/-- The subsemigroup generated by a set includes the set. -/
@[simp, to_additive "The `add_subsemigroup` generated by a set includes the set."]
lemma subset_closure : s ⊆ closure s := λ x hx, mem_closure.2 $ λ S hS, hS hx

@[to_additive]
lemma not_mem_of_not_mem_closure {P : M} (hP : P ∉ closure s) : P ∉ s := λ h, hP (subset_closure h)

variable {S}
open set

/-- A subsemigroup `S` includes `closure s` if and only if it includes `s`. -/
@[simp, to_additive "An additive subsemigroup `S` includes `closure s`
if and only if it includes `s`"]
lemma closure_le : closure s ≤ S ↔ s ⊆ S :=
⟨subset.trans subset_closure, λ h, Inf_le h⟩

/-- subsemigroup closure of a set is monotone in its argument: if `s ⊆ t`,
then `closure s ≤ closure t`. -/
@[to_additive "Additive subsemigroup closure of a set is monotone in its argument: if `s ⊆ t`,
then `closure s ≤ closure t`"]
lemma closure_mono ⦃s t : set M⦄ (h : s ⊆ t) : closure s ≤ closure t :=
closure_le.2 $ subset.trans h subset_closure

@[to_additive]
lemma closure_eq_of_le (h₁ : s ⊆ S) (h₂ : S ≤ closure s) : closure s = S :=
le_antisymm (closure_le.2 h₁) h₂

variable (S)

/-- An induction principle for closure membership. If `p` holds for all elements of `s`, and
is preserved under multiplication, then `p` holds for all elements of the closure of `s`. -/
@[elab_as_eliminator, to_additive "An induction principle for additive closure membership. If `p`
holds for all elements of `s`, and is preserved under addition, then `p` holds for all
elements of the additive closure of `s`."]
lemma closure_induction {p : M → Prop} {x} (h : x ∈ closure s)
  (Hs : ∀ x ∈ s, p x)
  (Hmul : ∀ x y, p x → p y → p (x * y)) : p x :=
(@closure_le _ _ _ ⟨p, Hmul⟩).2 Hs h

/-- A dependent version of `subsemigroup.closure_induction`.  -/
@[elab_as_eliminator, to_additive "A dependent version of `add_subsemigroup.closure_induction`. "]
lemma closure_induction' (s : set M) {p : Π x, x ∈ closure s → Prop}
  (Hs : ∀ x (h : x ∈ s), p x (subset_closure h))
  (Hmul : ∀ x hx y hy, p x hx → p y hy → p (x * y) (mul_mem _ hx hy))
  {x} (hx : x ∈ closure s) :
  p x hx :=
begin
  refine exists.elim _ (λ (hx : x ∈ closure s) (hc : p x hx), hc),
  exact closure_induction hx
    (λ x hx, ⟨_, Hs x hx⟩) (λ x y ⟨hx', hx⟩ ⟨hy', hy⟩, ⟨_, Hmul _ _ _ _ hx hy⟩),
end

/-- If `s` is a dense set in a magma `M`, `subsemigroup.closure s = ⊤`, then in order to prove that
some predicate `p` holds for all `x : M` it suffices to verify `p x` for `x ∈ s`,
and verify that `p x` and `p y` imply `p (x * y)`. -/
@[elab_as_eliminator, to_additive "If `s` is a dense set in an additive monoid `M`,
`add_subsemigroup.closure s = ⊤`, then in order to prove that some predicate `p` holds
for all `x : M` it suffices to verify `p x` for `x ∈ s`, and verify that `p x` and `p y` imply
`p (x + y)`."]
lemma dense_induction {p : M → Prop} (x : M) {s : set M} (hs : closure s = ⊤)
  (Hs : ∀ x ∈ s, p x)
  (Hmul : ∀ x y, p x → p y → p (x * y)) : p x :=
have ∀ x ∈ closure s, p x, from λ x hx, closure_induction hx Hs Hmul,
by simpa [hs] using this x

variable (M)

/-- `closure` forms a Galois insertion with the coercion to set. -/
@[to_additive "`closure` forms a Galois insertion with the coercion to set."]
protected def gi : galois_insertion (@closure M _) coe :=
{ choice := λ s _, closure s,
  gc := λ s t, closure_le,
  le_l_u := λ s, subset_closure,
  choice_eq := λ s h, rfl }

variable {M}

/-- Closure of a subsemigroup `S` equals `S`. -/
@[simp, to_additive "Additive closure of an additive subsemigroup `S` equals `S`"]
lemma closure_eq : closure (S : set M) = S := (subsemigroup.gi M).l_u_eq S

@[simp, to_additive] lemma closure_empty : closure (∅ : set M) = ⊥ :=
(subsemigroup.gi M).gc.l_bot

@[simp, to_additive] lemma closure_univ : closure (univ : set M) = ⊤ :=
@coe_top M _ ▸ closure_eq ⊤

@[to_additive]
lemma closure_union (s t : set M) : closure (s ∪ t) = closure s ⊔ closure t :=
(subsemigroup.gi M).gc.l_sup

@[to_additive]
lemma closure_Union {ι} (s : ι → set M) : closure (⋃ i, s i) = ⨆ i, closure (s i) :=
(subsemigroup.gi M).gc.l_supr

@[simp, to_additive]
lemma closure_singleton_le_iff_mem (m : M) (p : subsemigroup M) :
  closure {m} ≤ p ↔ m ∈ p :=
by rw [closure_le, singleton_subset_iff, set_like.mem_coe]

@[to_additive]
lemma mem_supr {ι : Sort*} (p : ι → subsemigroup M) {m : M} :
  (m ∈ ⨆ i, p i) ↔ (∀ N, (∀ i, p i ≤ N) → m ∈ N) :=
begin
  rw [← closure_singleton_le_iff_mem, le_supr_iff],
  simp only [closure_singleton_le_iff_mem],
end

@[to_additive]
lemma supr_eq_closure {ι : Sort*} (p : ι → subsemigroup M) :
  (⨆ i, p i) = subsemigroup.closure (⋃ i, (p i : set M)) :=
by simp_rw [subsemigroup.closure_Union, subsemigroup.closure_eq]

end subsemigroup

namespace mul_hom

variables [mul_one_class N]

open subsemigroup

/-- The subsemigroup of elements `x : M` such that `f x = g x` -/
@[to_additive "The additive subsemigroup of elements `x : M` such that `f x = g x`"]
def eq_mlocus (f g : mul_hom M N) : subsemigroup M :=
{ carrier := {x | f x = g x},
  mul_mem' := λ x y (hx : _ = _) (hy : _ = _), by simp [*] }

/-- If two mul homomorphisms are equal on a set, then they are equal on its subsemigroup closure. -/
@[to_additive "If two add homomorphisms are equal on a set,
then they are equal on its additive subsemigroup closure."]
lemma eq_on_mclosure {f g : mul_hom M N} {s : set M} (h : set.eq_on f g s) :
  set.eq_on f g (closure s) :=
show closure s ≤ f.eq_mlocus g, from closure_le.2 h

@[to_additive]
lemma eq_of_eq_on_mtop {f g : mul_hom M N} (h : set.eq_on f g (⊤ : subsemigroup M)) :
  f = g :=
ext $ λ x, h trivial

@[to_additive]

end mul_hom

end non_assoc

section assoc

namespace mul_hom

open subsemigroup

/-- Let `s` be a subset of a semigroup `M` such that the closure of `s` is the whole semigroup.
Then `mul_hom.of_mdense` defines a mul homomorphism from `M` asking for a proof
of `f (x * y) = f x * f y` only for `y ∈ s`. -/
@[to_additive]
def of_mdense {M N} [semigroup M] [semigroup N] {s : set M} (f : M → N) (hs : closure s = ⊤)
  (hmul : ∀ x (y ∈ s), f (x * y) = f x * f y) :
  mul_hom M N :=
{ to_fun := f,
  map_mul' := λ x y, dense_induction y hs (λ y hy x, hmul x y hy)
    (λ y₁ y₂ h₁ h₂ x, by simp only [← mul_assoc, h₁, h₂]) x }

/-- Let `s` be a subset of an additive semigroup `M` such that the closure of `s` is the whole
semigroup.  Then `add_hom.of_mdense` defines an additive homomorphism from `M` asking for a proof
of `f (x + y) = f x + f y` only for `y ∈ s`. -/
add_decl_doc add_hom.of_mdense

@[simp, norm_cast, to_additive] lemma coe_of_mdense [semigroup M] [semigroup N] {s : set M}
  (f : M → N) (hs : closure s = ⊤) (hmul) :
  (of_mdense f hs hmul : M → N) = f := rfl

end mul_hom

end assoc