/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro

! This file was ported from Lean 3 source module data.multiset.nodup
! leanprover-community/mathlib commit f2f413b9d4be3a02840d0663dace76e8fe3da053
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.List.Nodup
import Mathbin.Data.Multiset.Bind
import Mathbin.Data.Multiset.Range

/-!
# The `nodup` predicate for multisets without duplicate elements.

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

namespace Multiset

open Function List

variable {α β γ : Type _} {r : α → α → Prop} {s t : Multiset α} {a : α}

#print Multiset.Nodup /-
-- nodup
/-- `nodup s` means that `s` has no duplicates, i.e. the multiplicity of
  any element is at most 1. -/
def Nodup (s : Multiset α) : Prop :=
  Quot.liftOn s Nodup fun s t p => propext p.nodup_iff
#align multiset.nodup Multiset.Nodup
-/

#print Multiset.coe_nodup /-
@[simp]
theorem coe_nodup {l : List α} : @Nodup α l ↔ l.Nodup :=
  Iff.rfl
#align multiset.coe_nodup Multiset.coe_nodup
-/

#print Multiset.nodup_zero /-
@[simp]
theorem nodup_zero : @Nodup α 0 :=
  Pairwise.nil
#align multiset.nodup_zero Multiset.nodup_zero
-/

#print Multiset.nodup_cons /-
@[simp]
theorem nodup_cons {a : α} {s : Multiset α} : Nodup (a ::ₘ s) ↔ a ∉ s ∧ Nodup s :=
  Quot.inductionOn s fun l => nodup_cons
#align multiset.nodup_cons Multiset.nodup_cons
-/

#print Multiset.Nodup.cons /-
theorem Nodup.cons (m : a ∉ s) (n : Nodup s) : Nodup (a ::ₘ s) :=
  nodup_cons.2 ⟨m, n⟩
#align multiset.nodup.cons Multiset.Nodup.cons
-/

#print Multiset.nodup_singleton /-
@[simp]
theorem nodup_singleton : ∀ a : α, Nodup ({a} : Multiset α) :=
  nodup_singleton
#align multiset.nodup_singleton Multiset.nodup_singleton
-/

#print Multiset.Nodup.of_cons /-
theorem Nodup.of_cons (h : Nodup (a ::ₘ s)) : Nodup s :=
  (nodup_cons.1 h).2
#align multiset.nodup.of_cons Multiset.Nodup.of_cons
-/

#print Multiset.Nodup.not_mem /-
theorem Nodup.not_mem (h : Nodup (a ::ₘ s)) : a ∉ s :=
  (nodup_cons.1 h).1
#align multiset.nodup.not_mem Multiset.Nodup.not_mem
-/

/- warning: multiset.nodup_of_le -> Multiset.nodup_of_le is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {s : Multiset.{u1} α} {t : Multiset.{u1} α}, (LE.le.{u1} (Multiset.{u1} α) (Preorder.toLE.{u1} (Multiset.{u1} α) (PartialOrder.toPreorder.{u1} (Multiset.{u1} α) (Multiset.partialOrder.{u1} α))) s t) -> (Multiset.Nodup.{u1} α t) -> (Multiset.Nodup.{u1} α s)
but is expected to have type
  forall {α : Type.{u1}} {s : Multiset.{u1} α} {t : Multiset.{u1} α}, (LE.le.{u1} (Multiset.{u1} α) (Preorder.toLE.{u1} (Multiset.{u1} α) (PartialOrder.toPreorder.{u1} (Multiset.{u1} α) (Multiset.instPartialOrderMultiset.{u1} α))) s t) -> (Multiset.Nodup.{u1} α t) -> (Multiset.Nodup.{u1} α s)
Case conversion may be inaccurate. Consider using '#align multiset.nodup_of_le Multiset.nodup_of_leₓ'. -/
theorem nodup_of_le {s t : Multiset α} (h : s ≤ t) : Nodup t → Nodup s :=
  leInductionOn h fun l₁ l₂ => Nodup.sublist
#align multiset.nodup_of_le Multiset.nodup_of_le

#print Multiset.not_nodup_pair /-
theorem not_nodup_pair : ∀ a : α, ¬Nodup (a ::ₘ a ::ₘ 0) :=
  not_nodup_pair
#align multiset.not_nodup_pair Multiset.not_nodup_pair
-/

/- warning: multiset.nodup_iff_le -> Multiset.nodup_iff_le is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {s : Multiset.{u1} α}, Iff (Multiset.Nodup.{u1} α s) (forall (a : α), Not (LE.le.{u1} (Multiset.{u1} α) (Preorder.toLE.{u1} (Multiset.{u1} α) (PartialOrder.toPreorder.{u1} (Multiset.{u1} α) (Multiset.partialOrder.{u1} α))) (Multiset.cons.{u1} α a (Multiset.cons.{u1} α a (OfNat.ofNat.{u1} (Multiset.{u1} α) 0 (OfNat.mk.{u1} (Multiset.{u1} α) 0 (Zero.zero.{u1} (Multiset.{u1} α) (Multiset.hasZero.{u1} α)))))) s))
but is expected to have type
  forall {α : Type.{u1}} {s : Multiset.{u1} α}, Iff (Multiset.Nodup.{u1} α s) (forall (a : α), Not (LE.le.{u1} (Multiset.{u1} α) (Preorder.toLE.{u1} (Multiset.{u1} α) (PartialOrder.toPreorder.{u1} (Multiset.{u1} α) (Multiset.instPartialOrderMultiset.{u1} α))) (Multiset.cons.{u1} α a (Multiset.cons.{u1} α a (OfNat.ofNat.{u1} (Multiset.{u1} α) 0 (Zero.toOfNat0.{u1} (Multiset.{u1} α) (Multiset.instZeroMultiset.{u1} α))))) s))
Case conversion may be inaccurate. Consider using '#align multiset.nodup_iff_le Multiset.nodup_iff_leₓ'. -/
theorem nodup_iff_le {s : Multiset α} : Nodup s ↔ ∀ a : α, ¬a ::ₘ a ::ₘ 0 ≤ s :=
  Quot.inductionOn s fun l =>
    nodup_iff_sublist.trans <| forall_congr' fun a => (@replicate_le_coe _ a 2 _).symm.Not
#align multiset.nodup_iff_le Multiset.nodup_iff_le

#print Multiset.nodup_iff_ne_cons_cons /-
theorem nodup_iff_ne_cons_cons {s : Multiset α} : s.Nodup ↔ ∀ a t, s ≠ a ::ₘ a ::ₘ t :=
  nodup_iff_le.trans
    ⟨fun h a t s_eq => h a (s_eq.symm ▸ cons_le_cons a (cons_le_cons a (zero_le _))), fun h a le =>
      let ⟨t, s_eq⟩ := le_iff_exists_add.mp le
      h a t (by rwa [cons_add, cons_add, zero_add] at s_eq)⟩
#align multiset.nodup_iff_ne_cons_cons Multiset.nodup_iff_ne_cons_cons
-/

#print Multiset.nodup_iff_count_le_one /-
theorem nodup_iff_count_le_one [DecidableEq α] {s : Multiset α} : Nodup s ↔ ∀ a, count a s ≤ 1 :=
  Quot.inductionOn s fun l => nodup_iff_count_le_one
#align multiset.nodup_iff_count_le_one Multiset.nodup_iff_count_le_one
-/

#print Multiset.count_eq_one_of_mem /-
@[simp]
theorem count_eq_one_of_mem [DecidableEq α] {a : α} {s : Multiset α} (d : Nodup s) (h : a ∈ s) :
    count a s = 1 :=
  le_antisymm (nodup_iff_count_le_one.1 d a) (count_pos.2 h)
#align multiset.count_eq_one_of_mem Multiset.count_eq_one_of_mem
-/

#print Multiset.count_eq_of_nodup /-
theorem count_eq_of_nodup [DecidableEq α] {a : α} {s : Multiset α} (d : Nodup s) :
    count a s = if a ∈ s then 1 else 0 :=
  by
  split_ifs with h
  · exact count_eq_one_of_mem d h
  · exact count_eq_zero_of_not_mem h
#align multiset.count_eq_of_nodup Multiset.count_eq_of_nodup
-/

#print Multiset.nodup_iff_pairwise /-
theorem nodup_iff_pairwise {α} {s : Multiset α} : Nodup s ↔ Pairwise (· ≠ ·) s :=
  Quotient.inductionOn s fun l => (pairwise_coe_iff_pairwise fun a b => Ne.symm).symm
#align multiset.nodup_iff_pairwise Multiset.nodup_iff_pairwise
-/

#print Multiset.Nodup.pairwise /-
protected theorem Nodup.pairwise : (∀ a ∈ s, ∀ b ∈ s, a ≠ b → r a b) → Nodup s → Pairwise r s :=
  Quotient.inductionOn s fun l h hl => ⟨l, rfl, hl.imp_of_mem fun a b ha hb => h a ha b hb⟩
#align multiset.nodup.pairwise Multiset.Nodup.pairwise
-/

#print Multiset.Pairwise.forall /-
theorem Pairwise.forall (H : Symmetric r) (hs : Pairwise r s) :
    ∀ ⦃a⦄, a ∈ s → ∀ ⦃b⦄, b ∈ s → a ≠ b → r a b :=
  let ⟨l, hl₁, hl₂⟩ := hs
  hl₁.symm ▸ hl₂.forall H
#align multiset.pairwise.forall Multiset.Pairwise.forall
-/

#print Multiset.nodup_add /-
theorem nodup_add {s t : Multiset α} : Nodup (s + t) ↔ Nodup s ∧ Nodup t ∧ Disjoint s t :=
  Quotient.induction_on₂ s t fun l₁ l₂ => nodup_append
#align multiset.nodup_add Multiset.nodup_add
-/

#print Multiset.disjoint_of_nodup_add /-
theorem disjoint_of_nodup_add {s t : Multiset α} (d : Nodup (s + t)) : Disjoint s t :=
  (nodup_add.1 d).2.2
#align multiset.disjoint_of_nodup_add Multiset.disjoint_of_nodup_add
-/

#print Multiset.Nodup.add_iff /-
theorem Nodup.add_iff (d₁ : Nodup s) (d₂ : Nodup t) : Nodup (s + t) ↔ Disjoint s t := by
  simp [nodup_add, d₁, d₂]
#align multiset.nodup.add_iff Multiset.Nodup.add_iff
-/

#print Multiset.Nodup.of_map /-
theorem Nodup.of_map (f : α → β) : Nodup (map f s) → Nodup s :=
  Quot.inductionOn s fun l => Nodup.of_map f
#align multiset.nodup.of_map Multiset.Nodup.of_map
-/

/- warning: multiset.nodup.map_on -> Multiset.Nodup.map_on is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {s : Multiset.{u1} α} {f : α -> β}, (forall (x : α), (Membership.Mem.{u1, u1} α (Multiset.{u1} α) (Multiset.hasMem.{u1} α) x s) -> (forall (y : α), (Membership.Mem.{u1, u1} α (Multiset.{u1} α) (Multiset.hasMem.{u1} α) y s) -> (Eq.{succ u2} β (f x) (f y)) -> (Eq.{succ u1} α x y))) -> (Multiset.Nodup.{u1} α s) -> (Multiset.Nodup.{u2} β (Multiset.map.{u1, u2} α β f s))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} {s : Multiset.{u2} α} {f : α -> β}, (forall (x : α), (Membership.mem.{u2, u2} α (Multiset.{u2} α) (Multiset.instMembershipMultiset.{u2} α) x s) -> (forall (y : α), (Membership.mem.{u2, u2} α (Multiset.{u2} α) (Multiset.instMembershipMultiset.{u2} α) y s) -> (Eq.{succ u1} β (f x) (f y)) -> (Eq.{succ u2} α x y))) -> (Multiset.Nodup.{u2} α s) -> (Multiset.Nodup.{u1} β (Multiset.map.{u2, u1} α β f s))
Case conversion may be inaccurate. Consider using '#align multiset.nodup.map_on Multiset.Nodup.map_onₓ'. -/
theorem Nodup.map_on {f : α → β} :
    (∀ x ∈ s, ∀ y ∈ s, f x = f y → x = y) → Nodup s → Nodup (map f s) :=
  Quot.inductionOn s fun l => Nodup.map_on
#align multiset.nodup.map_on Multiset.Nodup.map_on

/- warning: multiset.nodup.map -> Multiset.Nodup.map is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {f : α -> β} {s : Multiset.{u1} α}, (Function.Injective.{succ u1, succ u2} α β f) -> (Multiset.Nodup.{u1} α s) -> (Multiset.Nodup.{u2} β (Multiset.map.{u1, u2} α β f s))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} {f : α -> β} {s : Multiset.{u2} α}, (Function.Injective.{succ u2, succ u1} α β f) -> (Multiset.Nodup.{u2} α s) -> (Multiset.Nodup.{u1} β (Multiset.map.{u2, u1} α β f s))
Case conversion may be inaccurate. Consider using '#align multiset.nodup.map Multiset.Nodup.mapₓ'. -/
theorem Nodup.map {f : α → β} {s : Multiset α} (hf : Injective f) : Nodup s → Nodup (map f s) :=
  Nodup.map_on fun x _ y _ h => hf h
#align multiset.nodup.map Multiset.Nodup.map

/- warning: multiset.inj_on_of_nodup_map -> Multiset.inj_on_of_nodup_map is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {f : α -> β} {s : Multiset.{u1} α}, (Multiset.Nodup.{u2} β (Multiset.map.{u1, u2} α β f s)) -> (forall (x : α), (Membership.Mem.{u1, u1} α (Multiset.{u1} α) (Multiset.hasMem.{u1} α) x s) -> (forall (y : α), (Membership.Mem.{u1, u1} α (Multiset.{u1} α) (Multiset.hasMem.{u1} α) y s) -> (Eq.{succ u2} β (f x) (f y)) -> (Eq.{succ u1} α x y)))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} {f : α -> β} {s : Multiset.{u2} α}, (Multiset.Nodup.{u1} β (Multiset.map.{u2, u1} α β f s)) -> (forall (x : α), (Membership.mem.{u2, u2} α (Multiset.{u2} α) (Multiset.instMembershipMultiset.{u2} α) x s) -> (forall (y : α), (Membership.mem.{u2, u2} α (Multiset.{u2} α) (Multiset.instMembershipMultiset.{u2} α) y s) -> (Eq.{succ u1} β (f x) (f y)) -> (Eq.{succ u2} α x y)))
Case conversion may be inaccurate. Consider using '#align multiset.inj_on_of_nodup_map Multiset.inj_on_of_nodup_mapₓ'. -/
theorem inj_on_of_nodup_map {f : α → β} {s : Multiset α} :
    Nodup (map f s) → ∀ x ∈ s, ∀ y ∈ s, f x = f y → x = y :=
  Quot.inductionOn s fun l => inj_on_of_nodup_map
#align multiset.inj_on_of_nodup_map Multiset.inj_on_of_nodup_map

/- warning: multiset.nodup_map_iff_inj_on -> Multiset.nodup_map_iff_inj_on is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {f : α -> β} {s : Multiset.{u1} α}, (Multiset.Nodup.{u1} α s) -> (Iff (Multiset.Nodup.{u2} β (Multiset.map.{u1, u2} α β f s)) (forall (x : α), (Membership.Mem.{u1, u1} α (Multiset.{u1} α) (Multiset.hasMem.{u1} α) x s) -> (forall (y : α), (Membership.Mem.{u1, u1} α (Multiset.{u1} α) (Multiset.hasMem.{u1} α) y s) -> (Eq.{succ u2} β (f x) (f y)) -> (Eq.{succ u1} α x y))))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} {f : α -> β} {s : Multiset.{u2} α}, (Multiset.Nodup.{u2} α s) -> (Iff (Multiset.Nodup.{u1} β (Multiset.map.{u2, u1} α β f s)) (forall (x : α), (Membership.mem.{u2, u2} α (Multiset.{u2} α) (Multiset.instMembershipMultiset.{u2} α) x s) -> (forall (y : α), (Membership.mem.{u2, u2} α (Multiset.{u2} α) (Multiset.instMembershipMultiset.{u2} α) y s) -> (Eq.{succ u1} β (f x) (f y)) -> (Eq.{succ u2} α x y))))
Case conversion may be inaccurate. Consider using '#align multiset.nodup_map_iff_inj_on Multiset.nodup_map_iff_inj_onₓ'. -/
theorem nodup_map_iff_inj_on {f : α → β} {s : Multiset α} (d : Nodup s) :
    Nodup (map f s) ↔ ∀ x ∈ s, ∀ y ∈ s, f x = f y → x = y :=
  ⟨inj_on_of_nodup_map, fun h => d.map_onₓ h⟩
#align multiset.nodup_map_iff_inj_on Multiset.nodup_map_iff_inj_on

#print Multiset.Nodup.filter /-
theorem Nodup.filter (p : α → Prop) [DecidablePred p] {s} : Nodup s → Nodup (filter p s) :=
  Quot.inductionOn s fun l => Nodup.filter p
#align multiset.nodup.filter Multiset.Nodup.filter
-/

#print Multiset.nodup_attach /-
@[simp]
theorem nodup_attach {s : Multiset α} : Nodup (attach s) ↔ Nodup s :=
  Quot.inductionOn s fun l => nodup_attach
#align multiset.nodup_attach Multiset.nodup_attach
-/

/- warning: multiset.nodup.pmap -> Multiset.Nodup.pmap is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {p : α -> Prop} {f : forall (a : α), (p a) -> β} {s : Multiset.{u1} α} {H : forall (a : α), (Membership.Mem.{u1, u1} α (Multiset.{u1} α) (Multiset.hasMem.{u1} α) a s) -> (p a)}, (forall (a : α) (ha : p a) (b : α) (hb : p b), (Eq.{succ u2} β (f a ha) (f b hb)) -> (Eq.{succ u1} α a b)) -> (Multiset.Nodup.{u1} α s) -> (Multiset.Nodup.{u2} β (Multiset.pmap.{u1, u2} α β (fun (a : α) => p a) f s H))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} {p : α -> Prop} {f : forall (a : α), (p a) -> β} {s : Multiset.{u2} α} {H : forall (a : α), (Membership.mem.{u2, u2} α (Multiset.{u2} α) (Multiset.instMembershipMultiset.{u2} α) a s) -> (p a)}, (forall (a : α) (ha : p a) (b : α) (hb : p b), (Eq.{succ u1} β (f a ha) (f b hb)) -> (Eq.{succ u2} α a b)) -> (Multiset.Nodup.{u2} α s) -> (Multiset.Nodup.{u1} β (Multiset.pmap.{u2, u1} α β (fun (a : α) => p a) f s H))
Case conversion may be inaccurate. Consider using '#align multiset.nodup.pmap Multiset.Nodup.pmapₓ'. -/
theorem Nodup.pmap {p : α → Prop} {f : ∀ a, p a → β} {s : Multiset α} {H}
    (hf : ∀ a ha b hb, f a ha = f b hb → a = b) : Nodup s → Nodup (pmap f s H) :=
  Quot.inductionOn s (fun l H => Nodup.pmap hf) H
#align multiset.nodup.pmap Multiset.Nodup.pmap

#print Multiset.nodupDecidable /-
instance nodupDecidable [DecidableEq α] (s : Multiset α) : Decidable (Nodup s) :=
  Quotient.recOnSubsingleton s fun l => l.nodupDecidable
#align multiset.nodup_decidable Multiset.nodupDecidable
-/

#print Multiset.Nodup.erase_eq_filter /-
theorem Nodup.erase_eq_filter [DecidableEq α] (a : α) {s} :
    Nodup s → s.eraseₓ a = filter (· ≠ a) s :=
  Quot.inductionOn s fun l d => congr_arg coe <| d.erase_eq_filter a
#align multiset.nodup.erase_eq_filter Multiset.Nodup.erase_eq_filter
-/

#print Multiset.Nodup.erase /-
theorem Nodup.erase [DecidableEq α] (a : α) {l} : Nodup l → Nodup (l.eraseₓ a) :=
  nodup_of_le (erase_le _ _)
#align multiset.nodup.erase Multiset.Nodup.erase
-/

#print Multiset.Nodup.mem_erase_iff /-
theorem Nodup.mem_erase_iff [DecidableEq α] {a b : α} {l} (d : Nodup l) :
    a ∈ l.eraseₓ b ↔ a ≠ b ∧ a ∈ l := by rw [d.erase_eq_filter b, mem_filter, and_comm']
#align multiset.nodup.mem_erase_iff Multiset.Nodup.mem_erase_iff
-/

#print Multiset.Nodup.not_mem_erase /-
theorem Nodup.not_mem_erase [DecidableEq α] {a : α} {s} (h : Nodup s) : a ∉ s.eraseₓ a := fun ha =>
  (h.mem_erase_iff.1 ha).1 rfl
#align multiset.nodup.not_mem_erase Multiset.Nodup.not_mem_erase
-/

#print Multiset.Nodup.product /-
protected theorem Nodup.product {t : Multiset β} : Nodup s → Nodup t → Nodup (product s t) :=
  Quotient.induction_on₂ s t fun l₁ l₂ d₁ d₂ => by simp [d₁.product d₂]
#align multiset.nodup.product Multiset.Nodup.product
-/

#print Multiset.Nodup.sigma /-
protected theorem Nodup.sigma {σ : α → Type _} {t : ∀ a, Multiset (σ a)} :
    Nodup s → (∀ a, Nodup (t a)) → Nodup (s.Sigma t) :=
  Quot.inductionOn s fun l₁ =>
    by
    choose f hf using fun a => Quotient.exists_rep (t a)
    rw [show t = fun a => f a from Eq.symm <| funext fun a => hf a]
    simpa using nodup.sigma
#align multiset.nodup.sigma Multiset.Nodup.sigma
-/

#print Multiset.Nodup.filterMap /-
protected theorem Nodup.filterMap (f : α → Option β) (H : ∀ a a' b, b ∈ f a → b ∈ f a' → a = a') :
    Nodup s → Nodup (filterMap f s) :=
  Quot.inductionOn s fun l => Nodup.filterMap H
#align multiset.nodup.filter_map Multiset.Nodup.filterMap
-/

#print Multiset.nodup_range /-
theorem nodup_range (n : ℕ) : Nodup (range n) :=
  nodup_range _
#align multiset.nodup_range Multiset.nodup_range
-/

#print Multiset.Nodup.inter_left /-
theorem Nodup.inter_left [DecidableEq α] (t) : Nodup s → Nodup (s ∩ t) :=
  nodup_of_le <| inter_le_left _ _
#align multiset.nodup.inter_left Multiset.Nodup.inter_left
-/

#print Multiset.Nodup.inter_right /-
theorem Nodup.inter_right [DecidableEq α] (s) : Nodup t → Nodup (s ∩ t) :=
  nodup_of_le <| inter_le_right _ _
#align multiset.nodup.inter_right Multiset.Nodup.inter_right
-/

#print Multiset.nodup_union /-
@[simp]
theorem nodup_union [DecidableEq α] {s t : Multiset α} : Nodup (s ∪ t) ↔ Nodup s ∧ Nodup t :=
  ⟨fun h => ⟨nodup_of_le (le_union_left _ _) h, nodup_of_le (le_union_right _ _) h⟩, fun ⟨h₁, h₂⟩ =>
    nodup_iff_count_le_one.2 fun a => by
      rw [count_union] <;>
        exact max_le (nodup_iff_count_le_one.1 h₁ a) (nodup_iff_count_le_one.1 h₂ a)⟩
#align multiset.nodup_union Multiset.nodup_union
-/

/- warning: multiset.nodup_bind -> Multiset.nodup_bind is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {s : Multiset.{u1} α} {t : α -> (Multiset.{u2} β)}, Iff (Multiset.Nodup.{u2} β (Multiset.bind.{u1, u2} α β s t)) (And (forall (a : α), (Membership.Mem.{u1, u1} α (Multiset.{u1} α) (Multiset.hasMem.{u1} α) a s) -> (Multiset.Nodup.{u2} β (t a))) (Multiset.Pairwise.{u1} α (fun (a : α) (b : α) => Multiset.Disjoint.{u2} β (t a) (t b)) s))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} {s : Multiset.{u2} α} {t : α -> (Multiset.{u1} β)}, Iff (Multiset.Nodup.{u1} β (Multiset.bind.{u2, u1} α β s t)) (And (forall (a : α), (Membership.mem.{u2, u2} α (Multiset.{u2} α) (Multiset.instMembershipMultiset.{u2} α) a s) -> (Multiset.Nodup.{u1} β (t a))) (Multiset.Pairwise.{u2} α (fun (a : α) (b : α) => Multiset.Disjoint.{u1} β (t a) (t b)) s))
Case conversion may be inaccurate. Consider using '#align multiset.nodup_bind Multiset.nodup_bindₓ'. -/
@[simp]
theorem nodup_bind {s : Multiset α} {t : α → Multiset β} :
    Nodup (bind s t) ↔ (∀ a ∈ s, Nodup (t a)) ∧ s.Pairwise fun a b => Disjoint (t a) (t b) :=
  have h₁ : ∀ a, ∃ l : List β, t a = l := fun a => Quot.inductionOn (t a) fun l => ⟨l, rfl⟩
  let ⟨t', h'⟩ := Classical.axiom_of_choice h₁
  have : t = fun a => t' a := funext h'
  have hd : Symmetric fun a b => List.Disjoint (t' a) (t' b) := fun a b h => h.symm
  Quot.inductionOn s <| by simp [this, List.nodup_bind, pairwise_coe_iff_pairwise hd]
#align multiset.nodup_bind Multiset.nodup_bind

#print Multiset.Nodup.ext /-
theorem Nodup.ext {s t : Multiset α} : Nodup s → Nodup t → (s = t ↔ ∀ a, a ∈ s ↔ a ∈ t) :=
  Quotient.induction_on₂ s t fun l₁ l₂ d₁ d₂ => Quotient.eq'.trans <| perm_ext d₁ d₂
#align multiset.nodup.ext Multiset.Nodup.ext
-/

/- warning: multiset.le_iff_subset -> Multiset.le_iff_subset is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {s : Multiset.{u1} α} {t : Multiset.{u1} α}, (Multiset.Nodup.{u1} α s) -> (Iff (LE.le.{u1} (Multiset.{u1} α) (Preorder.toLE.{u1} (Multiset.{u1} α) (PartialOrder.toPreorder.{u1} (Multiset.{u1} α) (Multiset.partialOrder.{u1} α))) s t) (HasSubset.Subset.{u1} (Multiset.{u1} α) (Multiset.hasSubset.{u1} α) s t))
but is expected to have type
  forall {α : Type.{u1}} {s : Multiset.{u1} α} {t : Multiset.{u1} α}, (Multiset.Nodup.{u1} α s) -> (Iff (LE.le.{u1} (Multiset.{u1} α) (Preorder.toLE.{u1} (Multiset.{u1} α) (PartialOrder.toPreorder.{u1} (Multiset.{u1} α) (Multiset.instPartialOrderMultiset.{u1} α))) s t) (HasSubset.Subset.{u1} (Multiset.{u1} α) (Multiset.instHasSubsetMultiset.{u1} α) s t))
Case conversion may be inaccurate. Consider using '#align multiset.le_iff_subset Multiset.le_iff_subsetₓ'. -/
theorem le_iff_subset {s t : Multiset α} : Nodup s → (s ≤ t ↔ s ⊆ t) :=
  Quotient.induction_on₂ s t fun l₁ l₂ d => ⟨subset_of_le, d.Subperm⟩
#align multiset.le_iff_subset Multiset.le_iff_subset

/- warning: multiset.range_le -> Multiset.range_le is a dubious translation:
lean 3 declaration is
  forall {m : Nat} {n : Nat}, Iff (LE.le.{0} (Multiset.{0} Nat) (Preorder.toLE.{0} (Multiset.{0} Nat) (PartialOrder.toPreorder.{0} (Multiset.{0} Nat) (Multiset.partialOrder.{0} Nat))) (Multiset.range m) (Multiset.range n)) (LE.le.{0} Nat Nat.hasLe m n)
but is expected to have type
  forall {m : Nat} {n : Nat}, Iff (LE.le.{0} (Multiset.{0} Nat) (Preorder.toLE.{0} (Multiset.{0} Nat) (PartialOrder.toPreorder.{0} (Multiset.{0} Nat) (Multiset.instPartialOrderMultiset.{0} Nat))) (Multiset.range m) (Multiset.range n)) (LE.le.{0} Nat instLENat m n)
Case conversion may be inaccurate. Consider using '#align multiset.range_le Multiset.range_leₓ'. -/
theorem range_le {m n : ℕ} : range m ≤ range n ↔ m ≤ n :=
  (le_iff_subset (nodup_range _)).trans range_subset
#align multiset.range_le Multiset.range_le

#print Multiset.mem_sub_of_nodup /-
theorem mem_sub_of_nodup [DecidableEq α] {a : α} {s t : Multiset α} (d : Nodup s) :
    a ∈ s - t ↔ a ∈ s ∧ a ∉ t :=
  ⟨fun h =>
    ⟨mem_of_le tsub_le_self h, fun h' => by
      refine' count_eq_zero.1 _ h <;> rw [count_sub a s t, tsub_eq_zero_iff_le] <;>
        exact le_trans (nodup_iff_count_le_one.1 d _) (count_pos.2 h')⟩,
    fun ⟨h₁, h₂⟩ => Or.resolve_right (mem_add.1 <| mem_of_le le_tsub_add h₁) h₂⟩
#align multiset.mem_sub_of_nodup Multiset.mem_sub_of_nodup
-/

/- warning: multiset.map_eq_map_of_bij_of_nodup -> Multiset.map_eq_map_of_bij_of_nodup is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {γ : Type.{u3}} (f : α -> γ) (g : β -> γ) {s : Multiset.{u1} α} {t : Multiset.{u2} β}, (Multiset.Nodup.{u1} α s) -> (Multiset.Nodup.{u2} β t) -> (forall (i : forall (a : α), (Membership.Mem.{u1, u1} α (Multiset.{u1} α) (Multiset.hasMem.{u1} α) a s) -> β), (forall (a : α) (ha : Membership.Mem.{u1, u1} α (Multiset.{u1} α) (Multiset.hasMem.{u1} α) a s), Membership.Mem.{u2, u2} β (Multiset.{u2} β) (Multiset.hasMem.{u2} β) (i a ha) t) -> (forall (a : α) (ha : Membership.Mem.{u1, u1} α (Multiset.{u1} α) (Multiset.hasMem.{u1} α) a s), Eq.{succ u3} γ (f a) (g (i a ha))) -> (forall (a₁ : α) (a₂ : α) (ha₁ : Membership.Mem.{u1, u1} α (Multiset.{u1} α) (Multiset.hasMem.{u1} α) a₁ s) (ha₂ : Membership.Mem.{u1, u1} α (Multiset.{u1} α) (Multiset.hasMem.{u1} α) a₂ s), (Eq.{succ u2} β (i a₁ ha₁) (i a₂ ha₂)) -> (Eq.{succ u1} α a₁ a₂)) -> (forall (b : β), (Membership.Mem.{u2, u2} β (Multiset.{u2} β) (Multiset.hasMem.{u2} β) b t) -> (Exists.{succ u1} α (fun (a : α) => Exists.{0} (Membership.Mem.{u1, u1} α (Multiset.{u1} α) (Multiset.hasMem.{u1} α) a s) (fun (ha : Membership.Mem.{u1, u1} α (Multiset.{u1} α) (Multiset.hasMem.{u1} α) a s) => Eq.{succ u2} β b (i a ha))))) -> (Eq.{succ u3} (Multiset.{u3} γ) (Multiset.map.{u1, u3} α γ f s) (Multiset.map.{u2, u3} β γ g t)))
but is expected to have type
  forall {α : Type.{u3}} {β : Type.{u2}} {γ : Type.{u1}} (f : α -> γ) (g : β -> γ) {s : Multiset.{u3} α} {t : Multiset.{u2} β}, (Multiset.Nodup.{u3} α s) -> (Multiset.Nodup.{u2} β t) -> (forall (i : forall (a : α), (Membership.mem.{u3, u3} α (Multiset.{u3} α) (Multiset.instMembershipMultiset.{u3} α) a s) -> β), (forall (a : α) (ha : Membership.mem.{u3, u3} α (Multiset.{u3} α) (Multiset.instMembershipMultiset.{u3} α) a s), Membership.mem.{u2, u2} β (Multiset.{u2} β) (Multiset.instMembershipMultiset.{u2} β) (i a ha) t) -> (forall (a : α) (ha : Membership.mem.{u3, u3} α (Multiset.{u3} α) (Multiset.instMembershipMultiset.{u3} α) a s), Eq.{succ u1} γ (f a) (g (i a ha))) -> (forall (a₁ : α) (a₂ : α) (ha₁ : Membership.mem.{u3, u3} α (Multiset.{u3} α) (Multiset.instMembershipMultiset.{u3} α) a₁ s) (ha₂ : Membership.mem.{u3, u3} α (Multiset.{u3} α) (Multiset.instMembershipMultiset.{u3} α) a₂ s), (Eq.{succ u2} β (i a₁ ha₁) (i a₂ ha₂)) -> (Eq.{succ u3} α a₁ a₂)) -> (forall (b : β), (Membership.mem.{u2, u2} β (Multiset.{u2} β) (Multiset.instMembershipMultiset.{u2} β) b t) -> (Exists.{succ u3} α (fun (a : α) => Exists.{0} (Membership.mem.{u3, u3} α (Multiset.{u3} α) (Multiset.instMembershipMultiset.{u3} α) a s) (fun (ha : Membership.mem.{u3, u3} α (Multiset.{u3} α) (Multiset.instMembershipMultiset.{u3} α) a s) => Eq.{succ u2} β b (i a ha))))) -> (Eq.{succ u1} (Multiset.{u1} γ) (Multiset.map.{u3, u1} α γ f s) (Multiset.map.{u2, u1} β γ g t)))
Case conversion may be inaccurate. Consider using '#align multiset.map_eq_map_of_bij_of_nodup Multiset.map_eq_map_of_bij_of_nodupₓ'. -/
theorem map_eq_map_of_bij_of_nodup (f : α → γ) (g : β → γ) {s : Multiset α} {t : Multiset β}
    (hs : s.Nodup) (ht : t.Nodup) (i : ∀ a ∈ s, β) (hi : ∀ a ha, i a ha ∈ t)
    (h : ∀ a ha, f a = g (i a ha)) (i_inj : ∀ a₁ a₂ ha₁ ha₂, i a₁ ha₁ = i a₂ ha₂ → a₁ = a₂)
    (i_surj : ∀ b ∈ t, ∃ a ha, b = i a ha) : s.map f = t.map g :=
  have : t = s.attach.map fun x => i x x.2 :=
    (ht.ext <|
          (nodup_attach.2 hs).map <|
            show Injective fun x : { x // x ∈ s } => i x x.2 from fun x y hxy =>
              Subtype.ext <| i_inj x y x.2 y.2 hxy).2
      fun x => by
      simp only [mem_map, true_and_iff, Subtype.exists, eq_comm, mem_attach] <;>
        exact ⟨i_surj _, fun ⟨y, hy⟩ => hy.snd.symm ▸ hi _ _⟩
  calc
    s.map f = s.pmap (fun x _ => f x) fun _ => id := by rw [pmap_eq_map]
    _ = s.attach.map fun x => f x := by rw [pmap_eq_map_attach]
    _ = t.map g := by rw [this, Multiset.map_map] <;> exact map_congr rfl fun x _ => h _ _

#align multiset.map_eq_map_of_bij_of_nodup Multiset.map_eq_map_of_bij_of_nodup

end Multiset


/-
Copyright 2020 Google LLC

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

      http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
 -/
import measure_theory.measurable_space

import measure_theory.measure_space
import measure_theory.outer_measure
import measure_theory.lebesgue_measure
import measure_theory.integration
import measure_theory.set_integral
import measure_theory.borel_space
import data.set.countable
import formal_ml.nnreal
import formal_ml.sum
import formal_ml.core
import formal_ml.measurable_space
import formal_ml.semiring
import formal_ml.real_measurable_space
import formal_ml.set
import formal_ml.filter_util
import topology.instances.ennreal
import formal_ml.int
import formal_ml.lattice
import formal_ml.rat

--import formal_ml.with_density_compose_eq_multiply_part_one
/-
  The simple way to think about a continuous random variable is as a
  continuous function (a density function). Formally, this is the Radon-Nikodym derivative.
  Using the operation with_density, one can transform this Radon-Nikodym derivative into
  a measure using measure_theory.with_density, which is provided in measure_theory.integration
  in mathlib. Specifically, one can write:
  μ.with_density f
  where μ is normally the Lebesgue measure on the real number line, and generate a probability
  measure for a continuous density function.

  In this file,
  measure_theory.with_density.compose_eq_multiply connects the integration (or expectation) of
  a function with respect to the probability measure derived from the density function with the
  integral using the original base measure. So, if μ is again the base measure, f is the density
  function, and g is the function we want to take the expectation of, then:
  (μ.with_density f).integral g = μ.integral (f * g)

  This is the familiar connection that we use to integrate functions of real random variables on
  a regular basis.
 -/

------------------------Theorems of ennreal -------------------------------------------

--Unnecessary
lemma le_coe_ne_top {x:nnreal} {y:ennreal}:y≤(x:ennreal) → y≠ ⊤ :=
begin
  intro A1,
  have A2:(x:ennreal)< ⊤,
  {
    apply with_top.coe_lt_top,
  },
  have A3:y < ⊤,
  {
    apply lt_of_le_of_lt,
    apply A1,
    apply A2,
  },
  rw ← lt_top_iff_ne_top,
  apply A3,
end

--Unnecessary
lemma upper_bounds_nnreal (s : set ennreal) {x:nnreal} {y:ennreal}:
  (x:ennreal) ∈ upper_bounds s →  (y∈ s) →  y≠ ⊤:=
begin
  intros A1 A2,
  rw mem_upper_bounds at A1,
  have A3 := A1 y A2,
  apply le_coe_ne_top A3,
end

--Unnecessary
lemma upper_bounds_nnreal_fn {α:Type*} {f:α → ennreal} {x:nnreal}:
  (x:ennreal) ∈ upper_bounds (set.range f)  → (∃ g:α → nnreal,
  f = (λ a:α, (g a:ennreal))) :=
begin
  intro A1,
  let g:α → nnreal := λ a:α, ((f a).to_nnreal),
  begin
    have A2:g = λ a:α, ((f a).to_nnreal) := rfl,
    apply exists.intro g,
    rw A2,
    ext a,
    split;intro A3,
    {
      simp,
      simp at A3,
      rw A3,
      rw ennreal.to_nnreal_coe,
    },
    {
      simp,
      simp at A3,
      rw ← A3,
      symmetry,
      apply ennreal.coe_to_nnreal,
      apply upper_bounds_nnreal,
      apply A1,
      simp,
    },
  end
end

------ Measure theory --------------------------------------------------------------------------

--Used EVERYWHERE.
lemma measure.apply {Ω:Type*} [M:measurable_space Ω] (μ:measure_theory.measure Ω)  (S:set Ω):
    μ S = μ.to_outer_measure.measure_of S :=
begin
  refl
end

--Use in hahn.lean
--TODO: Can this be replaced with measure_theory.lintegral_supr?
--Look more closely: this is using supr_apply, which means it is more
--than just measure_theory.lintegral_supr.
lemma  measure_theory.lintegral_supr2 {α : Type*}
    [N:measurable_space α]
    {μ:measure_theory.measure α}
     {f : ℕ → α → ennreal}:
    (∀ (n : ℕ), measurable (f n)) →
    monotone f →
    ((∫⁻ a:α,  (⨆ (n : ℕ), f n) a ∂ μ) =
    ⨆ (n : ℕ), (∫⁻ a:α, (f n) a ∂ μ)) :=
begin
  intros A1 A2,
  have A3:(λ a, (⨆ (n : ℕ), f n a)) = (⨆ (n : ℕ), f n),
  {
    apply funext,
    intro a,
    rw supr_apply,
  },
  rw ← A3,
  apply measure_theory.lintegral_supr,
  apply A1,
  apply A2,
end

--Used in hahn.lean
lemma supr_indicator {Ω:Type*} (g:ℕ → Ω → ennreal) (S:set Ω):
     (set.indicator S (supr g)) =
     (⨆ (n : ℕ), (set.indicator S (g n))) :=
begin
  apply funext,
  intro ω,
  rw (@supr_apply Ω (λ ω:Ω, ennreal) ℕ _ (λ n:ℕ, set.indicator S (g n)) ),
  have A0:(λ (i : ℕ), (λ (n : ℕ), set.indicator S (g n)) i ω) =
      (λ (i : ℕ), set.indicator S (g i) ω),
  {
    apply funext,
    intro i,
    simp,
  },
  rw A0,
  have A1:ω ∈ S ∨ ω ∉ S ,
  {
    apply classical.em,
  },
  cases A1,
  {
    rw set.indicator_of_mem A1,
    have B1A:(λ (i : ℕ), set.indicator S (g i) ω) =
        (λ (i : ℕ), g i ω),
    {
      apply funext,
      intro i,
      rw set.indicator_of_mem A1,
    },
    rw B1A,
    rw supr_apply,
  },
  {
    rw set.indicator_of_not_mem A1,
    have B1A:(λ (i : ℕ), set.indicator S (g i) ω) = (λ (i:ℕ), 0),
    {
      apply funext,
      intro i,
      rw set.indicator_of_not_mem A1,
    },
    rw B1A,
    rw @supr_const ennreal ℕ _ _ 0,
  },
end

--Used all over.
--Prefer measure_theory.with_density_apply
lemma measure_theory.with_density_apply2' {Ω:Type*} [M:measurable_space Ω] (μ:measure_theory.measure Ω) (f:Ω → ennreal) (S:set Ω):(measurable_set S) →
    (μ.with_density f) S = (∫⁻ a:Ω, (set.indicator S f) a ∂ μ) :=
begin
  intro A1,
  rw measure_theory.with_density_apply f A1,
  rw measure_theory.lintegral_indicator,
  apply A1,
end

--Move to Radon-Nikodym (?)
lemma with_density.zero {Ω:Type*} [M:measurable_space Ω] (μ:measure_theory.measure Ω):
    (μ.with_density 0) = 0 :=
begin
  apply measure_theory.measure.ext,
  intros S A1,
  rw measure_theory.with_density_apply2',
  {
    simp,
  },
  {
    apply A1,
  }
end


/-
Copyright (c) 2022 Anatole Dedecker. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anatole Dedecker
-/
import analysis.convex.topology
/-!
# Locally convex topological modules

A `locally_convex_space` is a topological semimodule over an ordered semiring in which any point
admits a neighborhood basis made of convex sets, or equivalently, in which convex neighborhoods of
a point form a neighborhood basis at that point.

In a module, this is equivalent to `0` satisfying such properties.

## Main results

- `locally_convex_space_iff_zero` : in a module, local convexity at zero gives
  local convexity everywhere
- `seminorm.locally_convex_space` : a topology generated by a family of seminorms is locally convex
- `normed_space.locally_convex_space` : a normed space is locally convex

## TODO

- define a structure `locally_convex_filter_basis`, extending `module_filter_basis`, for filter
  bases generating a locally convex topology
- show that any locally convex topology is generated by a family of seminorms

-/

open topological_space filter set

open_locale topological_space

section semimodule

/-- A `locally_convex_space` is a topological semimodule over an ordered semiring in which convex
neighborhoods of a point form a neighborhood basis at that point. -/
class locally_convex_space (𝕜 E : Type*) [ordered_semiring 𝕜] [add_comm_monoid E] [module 𝕜 E]
  [topological_space E] : Prop :=
(convex_basis : ∀ x : E, (𝓝 x).has_basis (λ (s : set E), s ∈ 𝓝 x ∧ convex 𝕜 s) id)

variables (𝕜 E : Type*) [ordered_semiring 𝕜] [add_comm_monoid E] [module 𝕜 E] [topological_space E]

lemma locally_convex_space_iff :
  locally_convex_space 𝕜 E ↔
  ∀ x : E, (𝓝 x).has_basis (λ (s : set E), s ∈ 𝓝 x ∧ convex 𝕜 s) id :=
⟨@locally_convex_space.convex_basis _ _ _ _ _ _, locally_convex_space.mk⟩

lemma locally_convex_space.of_bases {ι : Type*} (b : E → ι → set E) (p : E → ι → Prop)
  (hbasis : ∀ x : E, (𝓝 x).has_basis (p x) (b x)) (hconvex : ∀ x i, p x i → convex 𝕜 (b x i)) :
  locally_convex_space 𝕜 E :=
⟨λ x, (hbasis x).to_has_basis
  (λ i hi, ⟨b x i, ⟨⟨(hbasis x).mem_of_mem hi, hconvex x i hi⟩, le_refl (b x i)⟩⟩)
  (λ s hs, ⟨(hbasis x).index s hs.1,
    ⟨(hbasis x).property_index hs.1, (hbasis x).set_index_subset hs.1⟩⟩)⟩

lemma locally_convex_space.convex_basis_zero [locally_convex_space 𝕜 E] :
  (𝓝 0 : filter E).has_basis (λ s, s ∈ (𝓝 0 : filter E) ∧ convex 𝕜 s) id :=
locally_convex_space.convex_basis 0

lemma locally_convex_space_iff_exists_convex_subset :
  locally_convex_space 𝕜 E ↔ ∀ x : E, ∀ U ∈ 𝓝 x, ∃ S ∈ 𝓝 x, convex 𝕜 S ∧ S ⊆ U :=
(locally_convex_space_iff 𝕜 E).trans (forall_congr $ λ x, has_basis_self)

end semimodule

section module

variables (𝕜 E : Type*) [ordered_semiring 𝕜] [add_comm_group E] [module 𝕜 E] [topological_space E]
  [topological_add_group E]

lemma locally_convex_space.of_basis_zero {ι : Type*} (b : ι → set E) (p : ι → Prop)
  (hbasis : (𝓝 0).has_basis p b) (hconvex : ∀ i, p i → convex 𝕜 (b i)) :
  locally_convex_space 𝕜 E :=
begin
  refine locally_convex_space.of_bases 𝕜 E (λ (x : E) (i : ι), ((+) x) '' b i) (λ _, p) (λ x, _)
    (λ x i hi, (hconvex i hi).translate x),
  rw ← map_add_left_nhds_zero,
  exact hbasis.map _
end

lemma locally_convex_space_iff_zero :
  locally_convex_space 𝕜 E ↔
  (𝓝 0 : filter E).has_basis (λ (s : set E), s ∈ (𝓝 0 : filter E) ∧ convex 𝕜 s) id :=
⟨λ h, @locally_convex_space.convex_basis _ _ _ _ _ _ h 0,
 λ h, locally_convex_space.of_basis_zero 𝕜 E _ _ h (λ s, and.right)⟩

lemma locally_convex_space_iff_exists_convex_subset_zero :
  locally_convex_space 𝕜 E ↔
  ∀ U ∈ (𝓝 0 : filter E), ∃ S ∈ (𝓝 0 : filter E), convex 𝕜 S ∧ S ⊆ U :=
(locally_convex_space_iff_zero 𝕜 E).trans has_basis_self

end module

section lattice_ops

variables {ι : Sort*} {𝕜 E F : Type*} [ordered_semiring 𝕜] [add_comm_monoid E]
  [module 𝕜 E] [add_comm_monoid F] [module 𝕜 F]

lemma locally_convex_space_Inf {ts : set (topological_space E)}
  (h : ∀ t ∈ ts, @locally_convex_space 𝕜 E  _ _ _ t) :
  @locally_convex_space 𝕜 E _ _ _ (Inf ts) :=
begin
  letI : topological_space E := Inf ts,
  refine locally_convex_space.of_bases 𝕜 E
    (λ x, λ If : set ts × (ts → set E), ⋂ i ∈ If.1, If.2 i)
    (λ x, λ If : set ts × (ts → set E), If.1.finite ∧ ∀ i ∈ If.1,
      ((If.2 i) ∈ @nhds _ ↑i x ∧ convex 𝕜 (If.2 i)))
    (λ x, _) (λ x If hif, convex_Inter $ λ i, convex_Inter $ λ hi, (hif.2 i hi).2),
  rw [nhds_Inf, ← infi_subtype''],
  exact has_basis_infi (λ i : ts, (@locally_convex_space_iff 𝕜 E _ _ _ ↑i).mp (h ↑i i.2) x),
end

lemma locally_convex_space_infi {ts' : ι → topological_space E}
  (h' : ∀ i, @locally_convex_space 𝕜 E  _ _ _ (ts' i)) :
  @locally_convex_space 𝕜 E _ _ _ (⨅ i, ts' i) :=
begin
  refine locally_convex_space_Inf _,
  rwa forall_range_iff
end

lemma locally_convex_space_inf {t₁ t₂ : topological_space E}
  (h₁ : @locally_convex_space 𝕜 E _ _ _ t₁) (h₂ : @locally_convex_space 𝕜 E _ _ _ t₂) :
  @locally_convex_space 𝕜 E _ _ _ (t₁ ⊓ t₂) :=
by {rw inf_eq_infi, refine locally_convex_space_infi (λ b, _), cases b; assumption}

lemma locally_convex_space_induced {t : topological_space F} [locally_convex_space 𝕜 F]
  (f : E →ₗ[𝕜] F) :
  @locally_convex_space 𝕜 E _ _ _ (t.induced f) :=
begin
  letI : topological_space E := t.induced f,
  refine locally_convex_space.of_bases 𝕜 E (λ x, preimage f)
    (λ x, λ (s : set F), s ∈ 𝓝 (f x) ∧ convex 𝕜 s) (λ x, _)
    (λ x s ⟨_, hs⟩, hs.linear_preimage f),
  rw nhds_induced,
  exact (locally_convex_space.convex_basis $ f x).comap f
end

instance {ι : Type*} {X : ι → Type*} [Π i, add_comm_monoid (X i)] [Π i, topological_space (X i)]
  [Π i, module 𝕜 (X i)] [Π i, locally_convex_space 𝕜 (X i)] :
  locally_convex_space 𝕜 (Π i, X i) :=
locally_convex_space_infi (λ i, locally_convex_space_induced (linear_map.proj i))

instance [topological_space E] [topological_space F] [locally_convex_space 𝕜 E]
  [locally_convex_space 𝕜 F] :
  locally_convex_space 𝕜 (E × F) :=
locally_convex_space_inf
  (locally_convex_space_induced (linear_map.fst _ _ _))
  (locally_convex_space_induced (linear_map.snd _ _ _))

end lattice_ops


/-
Copyright (c) 2022 James Gallicchio.

Authors: James Gallicchio
-/

import LeanColls.Classes
import LeanColls.FoldableOps
import LeanColls.FoldableCorrect
import LeanColls.List

namespace LeanColls

/-! # View

Isomorphic to a `(Foldable C τ) × C`; a fold instantiated
at a specific collection. Used to implement inline transformations
which are only evaluated when the collection is folded into a result.
-/
structure View.{u,v} (τ : Type u) where
  fold : {β : Type v} → (β → τ → β) → β → β

namespace View

@[inline]
instance : Foldable.{max u (v+1),u,v} (View.{u,v} τ) τ where
  fold v f acc := v.fold f acc

@[inline, simp]
instance : FoldableOps (View τ) τ := FoldableOps.defaultImpl (View τ) τ

@[inline]
def view {F τ} (c : F) [Foldable F τ] : View τ where
  fold := λ f acc => Foldable.fold c f acc

@[inline]
def view' [Foldable' C τ M] (c : C) : View {x // M.mem x c} where
  fold foldF foldAcc :=
    Foldable'.fold' c (fun acc x i => foldF acc ⟨x,i⟩) foldAcc

@[inline]
def map {τ : Type u} {τ' : Type v} (f : τ → τ') (v : View τ) : View τ' where
  fold := λ foldF foldAcc => v.fold (λ acc t => foldF acc (f t)) foldAcc

@[inline]
def filter (f : τ → Bool) (v : View τ) : View τ where
  fold := λ foldF foldAcc =>
    v.fold (λ a x =>
      if f x then foldF a x else a
    ) foldAcc

@[inline]
def filterMap (f : τ → Option τ') (v : View τ) : View τ' where
  fold := λ foldF foldAcc =>
    v.fold (λ a x =>
      match f x with
      | none    => a
      | some x' => foldF a x'
    ) foldAcc

@[inline]
def flatten (v : View C) [Foldable C τ] : View τ where
  fold := λ foldF foldAcc =>
    v.fold (λ a c =>
      Foldable.fold c foldF a)
      foldAcc

@[inline]
def flatMap (f : τ → C) (v : View τ) [Foldable C τ'] : View τ' where
  fold := λ foldF foldAcc =>
    v.fold (λ a t =>
      Foldable.fold (f t) foldF a)
      foldAcc

@[inline]
def append (v : View τ) (v2 : View τ) : View τ where
  fold := λ foldF foldAcc =>
    v2.fold foldF
      (v.fold foldF foldAcc)

instance : Append (View τ) where
  append := append

/-! # Theorems -/

theorem view_eq_view_canonicalToList [Foldable.Correct C τ] (c : C)
  : View.view c = View.view (canonicalToList (Foldable.fold c))
  := by
  simp [view]
  funext β f acc
  simp [Foldable.fold]
  apply Foldable.Correct.foldCorrect

@[simp]
theorem map_eq_list_map (L : List τ) (f : τ → τ')
  : ((View.view L).map f)
    = View.view (List.map f L)
  := by
  simp [map, view, Foldable.fold, List.foldl_map]

@[simp]
theorem filter_eq_list_filter (L : List τ) (f : τ → Bool)
  : (View.view L).filter f
    = View.view (List.filter f L)
  := by
  simp [filter, view, Foldable.fold, List.foldl_filter]

@[simp]
theorem sum_eq_list_sum [AddMonoid τ] (L : List τ)
  : FoldableOps.sum (View.view L) = L.sum
  := by
  suffices _ by
    rw [FoldableOps.default_sum_pred_fold (view L) L this]
    apply FoldableOps.default_sum_list_eq_list_sum
  simp [view, Foldable.fold]


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro
-/
import logic.embedding.basic
import data.set.image

/-!
# Interactions between embeddings and sets.

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

-/

universes u v w x

section equiv

variables {α : Sort u} {β : Sort v} (f : α ≃ β)

@[simp]
lemma equiv.as_embedding_range {α β : Sort*} {p : β → Prop} (e : α ≃ subtype p) :
  set.range e.as_embedding = set_of p :=
set.ext $ λ x, ⟨λ ⟨y, h⟩, h ▸ subtype.coe_prop (e y), λ hs, ⟨e.symm ⟨x, hs⟩, by simp⟩⟩

end equiv

namespace function
namespace embedding

/-- Embedding into `with_top α`. -/
@[simps]
def coe_with_top {α} : α ↪ with_top α := { to_fun := coe, ..embedding.some}

/-- Given an embedding `f : α ↪ β` and a point outside of `set.range f`, construct an embedding
`option α ↪ β`. -/
@[simps] def option_elim {α β} (f : α ↪ β) (x : β) (h : x ∉ set.range f) :
  option α ↪ β :=
⟨option.elim x f, option.injective_iff.2 ⟨f.2, h⟩⟩

/-- Equivalence between embeddings of `option α` and a sigma type over the embeddings of `α`. -/
@[simps]
def option_embedding_equiv (α β) : (option α ↪ β) ≃ Σ f : α ↪ β, ↥(set.range f)ᶜ :=
{ to_fun := λ f, ⟨coe_option.trans f, f none, λ ⟨x, hx⟩, option.some_ne_none x $ f.injective hx⟩,
  inv_fun := λ f, f.1.option_elim f.2 f.2.2,
  left_inv := λ f, ext $ by { rintro (_|_); simp [option.coe_def] },
  right_inv := λ ⟨f, y, hy⟩, by { ext; simp [option.coe_def] } }

/-- Restrict the codomain of an embedding. -/
def cod_restrict {α β} (p : set β) (f : α ↪ β) (H : ∀ a, f a ∈ p) : α ↪ p :=
⟨λ a, ⟨f a, H a⟩, λ a b h, f.injective (@congr_arg _ _ _ _ subtype.val h)⟩

@[simp] theorem cod_restrict_apply {α β} (p) (f : α ↪ β) (H a) :
  cod_restrict p f H a = ⟨f a, H a⟩ := rfl

open set

/-- `set.image` as an embedding `set α ↪ set β`. -/
@[simps apply] protected def image {α β} (f : α ↪ β) : set α ↪ set β :=
⟨image f, f.2.image_injective⟩

end embedding
end function

namespace set

/-- The injection map is an embedding between subsets. -/
@[simps apply] def embedding_of_subset {α} (s t : set α) (h : s ⊆ t) : s ↪ t :=
⟨λ x, ⟨x.1, h x.2⟩, λ ⟨x, hx⟩ ⟨y, hy⟩ h, by { congr, injection h }⟩

end set

section subtype

variable {α : Type*}

/-- A subtype `{x // p x ∨ q x}` over a disjunction of `p q : α → Prop` is equivalent to a sum of
subtypes `{x // p x} ⊕ {x // q x}` such that `¬ p x` is sent to the right, when
`disjoint p q`.

See also `equiv.sum_compl`, for when `is_compl p q`.  -/
@[simps apply] def subtype_or_equiv (p q : α → Prop) [decidable_pred p] (h : disjoint p q) :
  {x // p x ∨ q x} ≃ {x // p x} ⊕ {x // q x} :=
{ to_fun := subtype_or_left_embedding p q,
  inv_fun := sum.elim
    (subtype.imp_embedding _ _ (λ x hx, (or.inl hx : p x ∨ q x)))
    (subtype.imp_embedding _ _ (λ x hx, (or.inr hx : p x ∨ q x))),
  left_inv := λ x, begin
    by_cases hx : p x,
    { rw subtype_or_left_embedding_apply_left _ hx,
      simp [subtype.ext_iff] },
    { rw subtype_or_left_embedding_apply_right _ hx,
      simp [subtype.ext_iff] },
  end,
  right_inv := λ x, begin
    cases x,
    { simp only [sum.elim_inl],
      rw subtype_or_left_embedding_apply_left,
      { simp },
      { simpa using x.prop } },
    { simp only [sum.elim_inr],
      rw subtype_or_left_embedding_apply_right,
      { simp },
      { suffices : ¬ p x,
        { simpa },
        intro hp,
        simpa using h.le_bot x ⟨hp, x.prop⟩ } }
  end }

@[simp] lemma subtype_or_equiv_symm_inl (p q : α → Prop) [decidable_pred p] (h : disjoint p q)
  (x : {x // p x}) : (subtype_or_equiv p q h).symm (sum.inl x) = ⟨x, or.inl x.prop⟩ :=
rfl

@[simp] lemma subtype_or_equiv_symm_inr (p q : α → Prop) [decidable_pred p] (h : disjoint p q)
  (x : {x // q x}) : (subtype_or_equiv p q h).symm (sum.inr x) = ⟨x, or.inr x.prop⟩ :=
rfl

end subtype


import categoryTheory.thin
universes v u u₂ v₂
open category_theory

namespace specialCats

set_option pp.structure_projections false

class FP_cat (C : Type u) extends category C :=
  -- Terminal object
  (unit : C)
  (term : ∀ X : C, X ⟶ unit)
  (unit_η : ∀ (X : C) (f : X ⟶ unit), f = term X)
  -- Binary products
  (prod : C → C → C)
  (pr1 : ∀ {X Y : C}, (prod X Y) ⟶ X)
  (pr2 : ∀ {X Y : C}, (prod X Y) ⟶ Y)
  (pair : ∀ {X Y Z : C} (f : Z ⟶ X) (g : Z ⟶ Y), Z ⟶ (prod X Y))
  (prod_β1 : ∀ {X Y Z : C} {f : Z ⟶ X} {g : Z ⟶ Y}, (pair f g) ≫ pr1 = f)
  (prod_β2 : ∀ {X Y Z : C} {f : Z ⟶ X} {g : Z ⟶ Y}, (pair f g) ≫ pr2 = g)
  (prod_η : ∀ {X Y : C}, pair pr1 pr2 = 𝟙 (prod X Y))

instance {C : Type u} [FP_cat C] : has_one C :=
{
    one := FP_cat.unit
}
instance {C : Type u} [FP_cat C] : has_mul C :=
{
    mul := λ X Y, FP_cat.prod X Y
}

def homprod {C : Type u} [FP_cat C] {W X Y Z : C}
   (f : W ⟶ X) (g : Y ⟶ Z) : W * Y ⟶ X * Z :=
   FP_cat.pair (FP_cat.pr1 ≫ f) (FP_cat.pr2 ≫ g)
notation (name:=homprod) f `***` g := homprod f g

-- #check category

class CC_cat (C : Type u) extends FP_cat C :=
  (exp : C → C → C)
  (eval : ∀ {Y Z : C}, (exp Y Z) * Y ⟶ Z)
  (curry : ∀ {X Y Z : C}, (X * Y ⟶ Z) → (X ⟶ (exp Y Z)))
  (curry_β : ∀ {X Y Z : C} (u : X * Y ⟶ Z), ((curry u) *** 𝟙 Y) ≫ eval = u)
  (curry_η : ∀ {X Y Z : C} (v : X ⟶ (exp Y Z)), curry((v *** 𝟙 Y) ≫ eval) = v)

notation (name:=exp) X `⟹` Y := CC_cat.exp X Y

end specialCats

namespace downsetCCC

open specialCats

class downsets (P : Type) [partial_order P] : Type :=
  (X : set P)
  (down_closed : ∀ (x x' : P), x ≤ x' → x' ∈ X → x ∈ X)

instance {P : Type}[partial_order P] : has_subset (downsets P) :=
{
  subset := λ A B, ∀ (x ∈ A.X), x ∈ B.X
}

theorem downset_ext {P : Type} [partial_order P] : ∀ {A B : downsets P}, A.X = B.X → A=B
| ⟨_,_⟩ ⟨_,_⟩ rfl := rfl

instance {P : Type}[partial_order P] : has_mem P (downsets P) :=
{
 mem := λ x ⟨A,A_down⟩, x ∈ A
}
def down_closed_external {P : Type}[partial_order P] :
  ∀ (X : downsets P) (x x' : P), x ≤ x' → x' ∈ X → x ∈ X :=
begin
  assume X x x' xlex' x'inX,
  cases X with A A_down,
  apply A_down,
  exact xlex',
  exact x'inX,
end

instance {P : Type}[partial_order P] : has_inter (downsets P) :=
{
  inter := λ ⟨ A, A_down ⟩ ⟨ B, B_down ⟩, ⟨ A ∩ B ,
  begin
      assume x x' h x'inboth,
      cases x'inboth with inA inB,
      constructor,
      apply A_down,
      exact h,
      exact inA,
      apply B_down,
      exact h,
      exact inB,
  end ⟩
}

#check downset_ext
def down {P : Type} (P_struct : partial_order P) : partial_order (downsets P) :=
{
  le := (⊆),
  le_refl := λ A x h, h,
  le_antisymm := begin
                  assume A B h1 h2,
                  apply downset_ext,
                  apply set.ext,
                  assume x,
                  constructor,
                  apply h1,
                  apply h2,
                 end,
  le_trans := λ ⟨A,_⟩ ⟨B,_⟩ ⟨C,_⟩ h1 h2 x h,
            begin apply h2, apply h1, exact h end
}
def down_pre {P : Type} [P_struct : partial_order P] : preorder (downsets P) :=
(@partial_order.to_preorder (downsets P) (down P_struct))

instance {P : Type} [partial_order P] : thin_cat (downsets P) :=
  thin_cat.from_preorder down_pre

def downset_embed {P : Type} [P_struct : partial_order P]: P → downsets P :=
λ p, ⟨ { x ∈ set.univ | x ≤ p } ,
  begin
    assume x x' xlex' h',
    dsimp,
    constructor, constructor,
    dsimp at h', cases h' with _ h,
    apply le_trans,
    exact xlex',
    exact h,
  end
 ⟩

def down_exp{P : Type} [P_struct : partial_order P] (X Y : downsets P) : downsets P :=
⟨{ x ∈ set.univ | ∀ (z : P), z≤x ∧ z∈X → z∈Y },
  begin
    assume x x' xlex' h',
    dsimp at h', cases h' with _ h',
    dsimp, constructor, constructor,
    assume z h,
    cases h with zlex zinX,
    apply h',
    constructor,
    apply le_trans, exact zlex, exact xlex',
    exact zinX,
  end
⟩

instance {P : Type} [P_struct : partial_order P] : CC_cat (downsets P) :=
{
  unit := ⟨ set.univ , λ x x' _ _, true.intro ⟩ ,
  term :=
    begin
      assume X,
      induction X with A A_down,
      apply hom_of_le,
      assume x,
      assume h,
      constructor,
    end,
  unit_η := λ X f, by apply thin_cat.K,
  prod := (∩),
  pr1 :=
    begin
      assume X Y,
      cases X with A A_down,
      cases Y with B B_down,
      apply hom_of_le,
      assume x h,
      cases h,
      exact h_left,
    end,
  pr2 :=
    begin
      assume X Y,
      cases X with A A_down,
      cases Y with B B_down,
      apply hom_of_le,
      assume x h,
      cases h,
      exact h_right,
    end,
  pair :=
    begin
      assume X Y Z,
      assume F G,
      have k : @partial_order.le (downsets P) (down P_struct) Z X,
      apply @le_of_hom (downsets P) (down_pre) Z X,
      exact F,
      have l : @partial_order.le (downsets P) (down P_struct) Z Y,
      apply @le_of_hom (downsets P) (down_pre) Z Y,
      exact G,
      cases X with A A_down,
      cases Y with B B_down,
      cases Z with C C_down,
      apply hom_of_le,
      assume z h,
      constructor,
      apply k, assumption,
      apply l, assumption,
    end,
  prod_β1 := λ X Y Z f g, by apply thin_cat.K,
  prod_β2 := λ X Y Z f g, by apply thin_cat.K,
  prod_η := λ X Y, by apply thin_cat.K,
  exp := down_exp,
  eval :=
    begin
      assume X Y,
      cases X with A A_down,
      cases Y with B B_down,
      apply hom_of_le,
      assume z h,
      cases h with zin_exp zin_A,
      dsimp at zin_exp,
      cases zin_exp with _ property,
      apply property,
      constructor,
      apply le_refl,
      exact zin_A,
    end,
  curry :=
    begin
      assume X Y Z XYleZ,
      suffices betterXYleZ : X ∩ Y ⊆ Z,
      cases X with A A_down,
      cases Y with B B_down,
      cases Z with C C_down,
      apply hom_of_le,
      assume z zinA,
      dsimp[down_exp], constructor, constructor,
      assume z',
      assume h, cases h with z'lez z'inB,
      have z'inA : z'∈A,
      apply A_down,
      exact z'lez,
      exact zinA,
      suffices ABleC : A ∩ B ⊆ C,
      apply ABleC,
      constructor,
      exact z'inA, exact z'inB,
      apply betterXYleZ,
      apply @le_of_hom (downsets P) (down_pre),
      exact XYleZ,
    end,
  curry_β := λ X Y Z u, by apply thin_cat.K,
  curry_η := λ X Y Z v, by apply thin_cat.K
}

end downsetCCC


/-
Copyright (c) 2019 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel
-/
import topology.metric_space.baire
import analysis.normed_space.operator_norm
import analysis.normed_space.affine_isometry

/-!
# Banach open mapping theorem

This file contains the Banach open mapping theorem, i.e., the fact that a bijective
bounded linear map between Banach spaces has a bounded inverse.
-/

open function metric set filter finset linear_map (range ker)
open_locale classical topology big_operators nnreal

variables {𝕜 : Type*} [nontrivially_normed_field 𝕜]
{E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E]
{F : Type*} [normed_add_comm_group F] [normed_space 𝕜 F]
(f : E →L[𝕜] F)
include 𝕜

namespace continuous_linear_map

/-- A (possibly nonlinear) right inverse to a continuous linear map, which doesn't have to be
linear itself but which satisfies a bound `‖inverse x‖ ≤ C * ‖x‖`. A surjective continuous linear
map doesn't always have a continuous linear right inverse, but it always has a nonlinear inverse
in this sense, by Banach's open mapping theorem. -/
structure nonlinear_right_inverse :=
(to_fun : F → E)
(nnnorm : ℝ≥0)
(bound' : ∀ y, ‖to_fun y‖ ≤ nnnorm * ‖y‖)
(right_inv' : ∀ y, f (to_fun y) = y)

instance : has_coe_to_fun (nonlinear_right_inverse f) (λ _, F → E) := ⟨λ fsymm, fsymm.to_fun⟩

@[simp] lemma nonlinear_right_inverse.right_inv {f : E →L[𝕜] F} (fsymm : nonlinear_right_inverse f)
  (y : F) : f (fsymm y) = y :=
fsymm.right_inv' y

lemma nonlinear_right_inverse.bound {f : E →L[𝕜] F} (fsymm : nonlinear_right_inverse f) (y : F) :
  ‖fsymm y‖ ≤ fsymm.nnnorm * ‖y‖ :=
fsymm.bound' y

end continuous_linear_map

/-- Given a continuous linear equivalence, the inverse is in particular an instance of
`nonlinear_right_inverse` (which turns out to be linear). -/
noncomputable def continuous_linear_equiv.to_nonlinear_right_inverse (f : E ≃L[𝕜] F) :
  continuous_linear_map.nonlinear_right_inverse (f : E →L[𝕜] F) :=
{ to_fun := f.inv_fun,
  nnnorm := ‖(f.symm : F →L[𝕜] E)‖₊,
  bound' := λ y, continuous_linear_map.le_op_norm (f.symm : F →L[𝕜] E) _,
  right_inv' := f.apply_symm_apply }

noncomputable instance (f : E ≃L[𝕜] F) :
  inhabited (continuous_linear_map.nonlinear_right_inverse (f : E →L[𝕜] F)) :=
⟨f.to_nonlinear_right_inverse⟩

/-! ### Proof of the Banach open mapping theorem -/

variable [complete_space F]

namespace continuous_linear_map
/--
First step of the proof of the Banach open mapping theorem (using completeness of `F`):
by Baire's theorem, there exists a ball in `E` whose image closure has nonempty interior.
Rescaling everything, it follows that any `y ∈ F` is arbitrarily well approached by
images of elements of norm at most `C * ‖y‖`.
For further use, we will only need such an element whose image
is within distance `‖y‖/2` of `y`, to apply an iterative process. -/
lemma exists_approx_preimage_norm_le (surj : surjective f) :
  ∃C ≥ 0, ∀y, ∃x, dist (f x) y ≤ 1/2 * ‖y‖ ∧ ‖x‖ ≤ C * ‖y‖ :=
begin
  have A : (⋃n:ℕ, closure (f '' (ball 0 n))) = univ,
  { refine subset.antisymm (subset_univ _) (λy hy, _),
    rcases surj y with ⟨x, hx⟩,
    rcases exists_nat_gt (‖x‖) with ⟨n, hn⟩,
    refine mem_Union.2 ⟨n, subset_closure _⟩,
    refine (mem_image _ _ _).2 ⟨x, ⟨_, hx⟩⟩,
    rwa [mem_ball, dist_eq_norm, sub_zero] },
  have : ∃ (n : ℕ) x, x ∈ interior (closure (f '' (ball 0 n))) :=
    nonempty_interior_of_Union_of_closed (λn, is_closed_closure) A,
  simp only [mem_interior_iff_mem_nhds, metric.mem_nhds_iff] at this,
  rcases this with ⟨n, a, ε, ⟨εpos, H⟩⟩,
  rcases normed_field.exists_one_lt_norm 𝕜 with ⟨c, hc⟩,
  refine ⟨(ε/2)⁻¹ * ‖c‖ * 2 * n, _, λy, _⟩,
  { refine mul_nonneg (mul_nonneg (mul_nonneg _ (norm_nonneg _)) (by norm_num)) _,
    exacts [inv_nonneg.2 (div_nonneg (le_of_lt εpos) (by norm_num)), n.cast_nonneg] },
  { by_cases hy : y = 0,
    { use 0, simp [hy] },
    { rcases rescale_to_shell hc (half_pos εpos) hy with ⟨d, hd, ydlt, leyd, dinv⟩,
      let δ := ‖d‖ * ‖y‖/4,
      have δpos : 0 < δ :=
        div_pos (mul_pos (norm_pos_iff.2 hd) (norm_pos_iff.2 hy)) (by norm_num),
      have : a + d • y ∈ ball a ε,
        by simp [dist_eq_norm, lt_of_le_of_lt ydlt.le (half_lt_self εpos)],
      rcases metric.mem_closure_iff.1 (H this) _ δpos with ⟨z₁, z₁im, h₁⟩,
      rcases (mem_image _ _ _).1 z₁im with ⟨x₁, hx₁, xz₁⟩,
      rw ← xz₁ at h₁,
      rw [mem_ball, dist_eq_norm, sub_zero] at hx₁,
      have : a ∈ ball a ε, by { simp, exact εpos },
      rcases metric.mem_closure_iff.1 (H this) _ δpos with ⟨z₂, z₂im, h₂⟩,
      rcases (mem_image _ _ _).1 z₂im with ⟨x₂, hx₂, xz₂⟩,
      rw ← xz₂ at h₂,
      rw [mem_ball, dist_eq_norm, sub_zero] at hx₂,
      let x := x₁ - x₂,
      have I : ‖f x - d • y‖ ≤ 2 * δ := calc
        ‖f x - d • y‖ = ‖f x₁ - (a + d • y) - (f x₂ - a)‖ :
          by { congr' 1, simp only [x, f.map_sub], abel }
        ... ≤ ‖f x₁ - (a + d • y)‖ + ‖f x₂ - a‖ :
          norm_sub_le _ _
        ... ≤ δ + δ : begin
            apply add_le_add,
            { rw [← dist_eq_norm, dist_comm], exact le_of_lt h₁ },
            { rw [← dist_eq_norm, dist_comm], exact le_of_lt h₂ }
          end
        ... = 2 * δ : (two_mul _).symm,
      have J : ‖f (d⁻¹ • x) - y‖ ≤ 1/2 * ‖y‖ := calc
        ‖f (d⁻¹ • x) - y‖ = ‖d⁻¹ • f x - (d⁻¹ * d) • y‖ :
          by rwa [f.map_smul _, inv_mul_cancel, one_smul]
        ... = ‖d⁻¹ • (f x - d • y)‖ : by rw [mul_smul, smul_sub]
        ... = ‖d‖⁻¹ * ‖f x - d • y‖ : by rw [norm_smul, norm_inv]
        ... ≤ ‖d‖⁻¹ * (2 * δ) : begin
            apply mul_le_mul_of_nonneg_left I,
            rw inv_nonneg,
            exact norm_nonneg _
          end
        ... = (‖d‖⁻¹ * ‖d‖) * ‖y‖ /2 : by { simp only [δ], ring }
        ... = ‖y‖/2 : by { rw [inv_mul_cancel, one_mul],  simp [norm_eq_zero, hd] }
        ... = (1/2) * ‖y‖ : by ring,
      rw ← dist_eq_norm at J,
      have K : ‖d⁻¹ • x‖ ≤ (ε / 2)⁻¹ * ‖c‖ * 2 * ↑n * ‖y‖ := calc
        ‖d⁻¹ • x‖ = ‖d‖⁻¹ * ‖x₁ - x₂‖ : by rw [norm_smul, norm_inv]
        ... ≤ ((ε / 2)⁻¹ * ‖c‖ * ‖y‖) * (n + n) : begin
            refine mul_le_mul dinv _ (norm_nonneg _) _,
            { exact le_trans (norm_sub_le _ _) (add_le_add (le_of_lt hx₁) (le_of_lt hx₂)) },
            { apply mul_nonneg (mul_nonneg _ (norm_nonneg _)) (norm_nonneg _),
              exact inv_nonneg.2 (le_of_lt (half_pos εpos)) }
          end
        ... = (ε / 2)⁻¹ * ‖c‖ * 2 * ↑n * ‖y‖ : by ring,
      exact ⟨d⁻¹ • x, J, K⟩ } },
end

variable [complete_space E]

/-- The Banach open mapping theorem: if a bounded linear map between Banach spaces is onto, then
any point has a preimage with controlled norm. -/
theorem exists_preimage_norm_le (surj : surjective f) :
  ∃C > 0, ∀y, ∃x, f x = y ∧ ‖x‖ ≤ C * ‖y‖ :=
begin
  obtain ⟨C, C0, hC⟩ := exists_approx_preimage_norm_le f surj,
  /- Second step of the proof: starting from `y`, we want an exact preimage of `y`. Let `g y` be
  the approximate preimage of `y` given by the first step, and `h y = y - f(g y)` the part that
  has no preimage yet. We will iterate this process, taking the approximate preimage of `h y`,
  leaving only `h^2 y` without preimage yet, and so on. Let `u n` be the approximate preimage
  of `h^n y`. Then `u` is a converging series, and by design the sum of the series is a
  preimage of `y`. This uses completeness of `E`. -/
  choose g hg using hC,
  let h := λy, y - f (g y),
  have hle : ∀y, ‖h y‖ ≤ (1/2) * ‖y‖,
  { assume y,
    rw [← dist_eq_norm, dist_comm],
    exact (hg y).1 },
  refine ⟨2 * C + 1, by linarith, λy, _⟩,
  have hnle : ∀n:ℕ, ‖(h^[n]) y‖ ≤ (1/2)^n * ‖y‖,
  { assume n,
    induction n with n IH,
    { simp only [one_div, nat.nat_zero_eq_zero, one_mul, iterate_zero_apply,
        pow_zero] },
    { rw [iterate_succ'],
      apply le_trans (hle _) _,
      rw [pow_succ, mul_assoc],
      apply mul_le_mul_of_nonneg_left IH,
      norm_num } },
  let u := λn, g((h^[n]) y),
  have ule : ∀n, ‖u n‖ ≤ (1/2)^n * (C * ‖y‖),
  { assume n,
    apply le_trans (hg _).2 _,
    calc C * ‖(h^[n]) y‖ ≤ C * ((1/2)^n * ‖y‖) : mul_le_mul_of_nonneg_left (hnle n) C0
         ... = (1 / 2) ^ n * (C * ‖y‖) : by ring },
  have sNu : summable (λn, ‖u n‖),
  { refine summable_of_nonneg_of_le (λn, norm_nonneg _) ule _,
    exact summable.mul_right _ (summable_geometric_of_lt_1 (by norm_num) (by norm_num)) },
  have su : summable u := summable_of_summable_norm sNu,
  let x := tsum u,
  have x_ineq : ‖x‖ ≤ (2 * C + 1) * ‖y‖ := calc
    ‖x‖ ≤ ∑'n, ‖u n‖ : norm_tsum_le_tsum_norm sNu
    ... ≤ ∑'n, (1/2)^n * (C * ‖y‖) :
      tsum_le_tsum ule sNu (summable.mul_right _ summable_geometric_two)
    ... = (∑'n, (1/2)^n) * (C * ‖y‖) : tsum_mul_right
    ... = 2 * C * ‖y‖ : by rw [tsum_geometric_two, mul_assoc]
    ... ≤ 2 * C * ‖y‖ + ‖y‖ : le_add_of_nonneg_right (norm_nonneg y)
    ... = (2 * C + 1) * ‖y‖ : by ring,
  have fsumeq : ∀n:ℕ, f (∑ i in finset.range n, u i) = y - (h^[n]) y,
  { assume n,
    induction n with n IH,
    { simp [f.map_zero] },
    { rw [sum_range_succ, f.map_add, IH, iterate_succ', sub_add] } },
  have : tendsto (λn, ∑ i in finset.range n, u i) at_top (𝓝 x) :=
    su.has_sum.tendsto_sum_nat,
  have L₁ : tendsto (λn, f (∑ i in finset.range n, u i)) at_top (𝓝 (f x)) :=
    (f.continuous.tendsto _).comp this,
  simp only [fsumeq] at L₁,
  have L₂ : tendsto (λn, y - (h^[n]) y) at_top (𝓝 (y - 0)),
  { refine tendsto_const_nhds.sub _,
    rw tendsto_iff_norm_tendsto_zero,
    simp only [sub_zero],
    refine squeeze_zero (λ_, norm_nonneg _) hnle _,
    rw [← zero_mul ‖y‖],
    refine (tendsto_pow_at_top_nhds_0_of_lt_1 _ _).mul tendsto_const_nhds; norm_num },
  have feq : f x = y - 0 := tendsto_nhds_unique L₁ L₂,
  rw sub_zero at feq,
  exact ⟨x, feq, x_ineq⟩
end

/-- The Banach open mapping theorem: a surjective bounded linear map between Banach spaces is
open. -/
protected theorem is_open_map (surj : surjective f) : is_open_map f :=
begin
  assume s hs,
  rcases exists_preimage_norm_le f surj with ⟨C, Cpos, hC⟩,
  refine is_open_iff.2 (λy yfs, _),
  rcases mem_image_iff_bex.1 yfs with ⟨x, xs, fxy⟩,
  rcases is_open_iff.1 hs x xs with ⟨ε, εpos, hε⟩,
  refine ⟨ε/C, div_pos εpos Cpos, λz hz, _⟩,
  rcases hC (z-y) with ⟨w, wim, wnorm⟩,
  have : f (x + w) = z, by { rw [f.map_add, wim, fxy, add_sub_cancel'_right] },
  rw ← this,
  have : x + w ∈ ball x ε := calc
    dist (x+w) x = ‖w‖ : by { rw dist_eq_norm, simp }
    ... ≤ C * ‖z - y‖ : wnorm
    ... < C * (ε/C) : begin
        apply mul_lt_mul_of_pos_left _ Cpos,
        rwa [mem_ball, dist_eq_norm] at hz,
      end
    ... = ε : mul_div_cancel' _ (ne_of_gt Cpos),
  exact set.mem_image_of_mem _ (hε this)
end

protected theorem quotient_map (surj : surjective f) : quotient_map f :=
(f.is_open_map surj).to_quotient_map f.continuous surj

lemma _root_.affine_map.is_open_map {P Q : Type*}
  [metric_space P] [normed_add_torsor E P] [metric_space Q] [normed_add_torsor F Q]
  (f : P →ᵃ[𝕜] Q) (hf : continuous f) (surj : surjective f) :
  is_open_map f :=
affine_map.is_open_map_linear_iff.mp $ continuous_linear_map.is_open_map
  { cont := affine_map.continuous_linear_iff.mpr hf, .. f.linear }
  (f.linear_surjective_iff.mpr surj)

/-! ### Applications of the Banach open mapping theorem -/

lemma interior_preimage (hsurj : surjective f) (s : set F) :
  interior (f ⁻¹' s) = f ⁻¹' (interior s) :=
((f.is_open_map hsurj).preimage_interior_eq_interior_preimage f.continuous s).symm

lemma closure_preimage (hsurj : surjective f) (s : set F) :
  closure (f ⁻¹' s) = f ⁻¹' (closure s) :=
((f.is_open_map hsurj).preimage_closure_eq_closure_preimage f.continuous s).symm

lemma frontier_preimage (hsurj : surjective f) (s : set F) :
  frontier (f ⁻¹' s) = f ⁻¹' (frontier s) :=
((f.is_open_map hsurj).preimage_frontier_eq_frontier_preimage f.continuous s).symm

lemma exists_nonlinear_right_inverse_of_surjective (f : E →L[𝕜] F)
  (hsurj : linear_map.range f = ⊤) : ∃ (fsymm : nonlinear_right_inverse f), 0 < fsymm.nnnorm :=
begin
  choose C hC fsymm h using exists_preimage_norm_le _ (linear_map.range_eq_top.mp hsurj),
  use { to_fun := fsymm,
        nnnorm := ⟨C, hC.lt.le⟩,
        bound' := λ y, (h y).2,
        right_inv' := λ y, (h y).1 },
  exact hC
end

/-- A surjective continuous linear map between Banach spaces admits a (possibly nonlinear)
controlled right inverse. In general, it is not possible to ensure that such a right inverse
is linear (take for instance the map from `E` to `E/F` where `F` is a closed subspace of `E`
without a closed complement. Then it doesn't have a continuous linear right inverse.) -/
@[irreducible] noncomputable def nonlinear_right_inverse_of_surjective
  (f : E →L[𝕜] F) (hsurj : linear_map.range f = ⊤) : nonlinear_right_inverse f :=
classical.some (exists_nonlinear_right_inverse_of_surjective f hsurj)

lemma nonlinear_right_inverse_of_surjective_nnnorm_pos (f : E →L[𝕜] F)
  (hsurj : linear_map.range f = ⊤) : 0 < (nonlinear_right_inverse_of_surjective f hsurj).nnnorm :=
begin
  rw nonlinear_right_inverse_of_surjective,
  exact classical.some_spec (exists_nonlinear_right_inverse_of_surjective f hsurj)
end

end continuous_linear_map

namespace linear_equiv

variables [complete_space E]

/-- If a bounded linear map is a bijection, then its inverse is also a bounded linear map. -/
@[continuity]
theorem continuous_symm (e : E ≃ₗ[𝕜] F) (h : continuous e) :
  continuous e.symm :=
begin
  rw continuous_def,
  intros s hs,
  rw [← e.image_eq_preimage],
  rw [← e.coe_coe] at h ⊢,
  exact continuous_linear_map.is_open_map ⟨↑e, h⟩ e.surjective s hs
end

/-- Associating to a linear equivalence between Banach spaces a continuous linear equivalence when
the direct map is continuous, thanks to the Banach open mapping theorem that ensures that the
inverse map is also continuous. -/
def to_continuous_linear_equiv_of_continuous (e : E ≃ₗ[𝕜] F) (h : continuous e) :
  E ≃L[𝕜] F :=
{ continuous_to_fun := h,
  continuous_inv_fun := e.continuous_symm h,
  ..e }

@[simp] lemma coe_fn_to_continuous_linear_equiv_of_continuous (e : E ≃ₗ[𝕜] F) (h : continuous e) :
  ⇑(e.to_continuous_linear_equiv_of_continuous h) = e := rfl

@[simp] lemma coe_fn_to_continuous_linear_equiv_of_continuous_symm (e : E ≃ₗ[𝕜] F)
  (h : continuous e) :
  ⇑(e.to_continuous_linear_equiv_of_continuous h).symm = e.symm := rfl

end linear_equiv

namespace continuous_linear_equiv

variables [complete_space E]

/-- Convert a bijective continuous linear map `f : E →L[𝕜] F` from a Banach space to a normed space
to a continuous linear equivalence. -/
noncomputable def of_bijective (f : E →L[𝕜] F) (hinj : ker f = ⊥)
  (hsurj : linear_map.range f = ⊤) : E ≃L[𝕜] F :=
(linear_equiv.of_bijective ↑f ⟨linear_map.ker_eq_bot.mp hinj, linear_map.range_eq_top.mp hsurj⟩)
.to_continuous_linear_equiv_of_continuous f.continuous

@[simp] lemma coe_fn_of_bijective (f : E →L[𝕜] F) (hinj : ker f = ⊥)
  (hsurj : linear_map.range f = ⊤) : ⇑(of_bijective f hinj hsurj) = f := rfl

lemma coe_of_bijective (f : E →L[𝕜] F) (hinj : ker f = ⊥) (hsurj : linear_map.range f = ⊤) :
  ↑(of_bijective f hinj hsurj) = f := by { ext, refl }

@[simp] lemma of_bijective_symm_apply_apply (f : E →L[𝕜] F) (hinj : ker f = ⊥)
  (hsurj : linear_map.range f = ⊤) (x : E) :
  (of_bijective f hinj hsurj).symm (f x) = x :=
(of_bijective f hinj hsurj).symm_apply_apply x

@[simp] lemma of_bijective_apply_symm_apply (f : E →L[𝕜] F) (hinj : ker f = ⊥)
  (hsurj : linear_map.range f = ⊤) (y : F) :
  f ((of_bijective f hinj hsurj).symm y) = y :=
(of_bijective f hinj hsurj).apply_symm_apply y

end continuous_linear_equiv

namespace continuous_linear_map

variables [complete_space E]

/-- Intermediate definition used to show
`continuous_linear_map.closed_complemented_range_of_is_compl_of_ker_eq_bot`.

This is `f.coprod G.subtypeL` as an `continuous_linear_equiv`. -/
noncomputable def coprod_subtypeL_equiv_of_is_compl
  (f : E →L[𝕜] F) {G : submodule 𝕜 F}
  (h : is_compl (linear_map.range f) G) [complete_space G] (hker : ker f = ⊥) : (E × G) ≃L[𝕜] F :=
continuous_linear_equiv.of_bijective (f.coprod G.subtypeL)
  (begin
    rw ker_coprod_of_disjoint_range,
    { rw [hker, submodule.ker_subtypeL, submodule.prod_bot] },
    { rw submodule.range_subtypeL,
      exact h.disjoint }
  end)
  (by simp only [range_coprod, h.sup_eq_top, submodule.range_subtypeL])

lemma range_eq_map_coprod_subtypeL_equiv_of_is_compl
  (f : E →L[𝕜] F) {G : submodule 𝕜 F}
  (h : is_compl (linear_map.range f) G) [complete_space G] (hker : ker f = ⊥) :
    linear_map.range f = ((⊤ : submodule 𝕜 E).prod (⊥ : submodule 𝕜 G)).map
      (f.coprod_subtypeL_equiv_of_is_compl h hker : E × G →ₗ[𝕜] F) :=
begin
  rw [coprod_subtypeL_equiv_of_is_compl, _root_.coe_coe, continuous_linear_equiv.coe_of_bijective,
         coe_coprod, linear_map.coprod_map_prod, submodule.map_bot, sup_bot_eq, submodule.map_top],
  refl
end

/- TODO: remove the assumption `f.ker = ⊥` in the next lemma, by using the map induced by `f` on
`E / f.ker`, once we have quotient normed spaces. -/
lemma closed_complemented_range_of_is_compl_of_ker_eq_bot (f : E →L[𝕜] F) (G : submodule 𝕜 F)
  (h : is_compl (linear_map.range f) G) (hG : is_closed (G : set F)) (hker : ker f = ⊥) :
  is_closed (linear_map.range f : set F) :=
begin
  haveI : complete_space G := hG.complete_space_coe,
  let g := coprod_subtypeL_equiv_of_is_compl f h hker,
  rw congr_arg coe (range_eq_map_coprod_subtypeL_equiv_of_is_compl f h hker ),
  apply g.to_homeomorph.is_closed_image.2,
  exact is_closed_univ.prod is_closed_singleton,
end

end continuous_linear_map

section closed_graph_thm

variables [complete_space E] (g : E →ₗ[𝕜] F)

/-- The **closed graph theorem** : a linear map between two Banach spaces whose graph is closed
is continuous. -/
theorem linear_map.continuous_of_is_closed_graph (hg : is_closed (g.graph : set $ E × F)) :
  continuous g :=
begin
  letI : complete_space g.graph := complete_space_coe_iff_is_complete.mpr hg.is_complete,
  let φ₀ : E →ₗ[𝕜] E × F := linear_map.id.prod g,
  have : function.left_inverse prod.fst φ₀ := λ x, rfl,
  let φ : E ≃ₗ[𝕜] g.graph :=
    (linear_equiv.of_left_inverse this).trans
    (linear_equiv.of_eq _ _ g.graph_eq_range_prod.symm),
  let ψ : g.graph ≃L[𝕜] E := φ.symm.to_continuous_linear_equiv_of_continuous
    continuous_subtype_coe.fst,
  exact (continuous_subtype_coe.comp ψ.symm.continuous).snd
end

/-- A useful form of the **closed graph theorem** : let `f` be a linear map between two Banach
spaces. To show that `f` is continuous, it suffices to show that for any convergent sequence
`uₙ ⟶ x`, if `f(uₙ) ⟶ y` then `y = f(x)`. -/
theorem linear_map.continuous_of_seq_closed_graph
  (hg : ∀ (u : ℕ → E) x y, tendsto u at_top (𝓝 x) → tendsto (g ∘ u) at_top (𝓝 y) → y = g x) :
  continuous g :=
begin
  refine g.continuous_of_is_closed_graph (is_seq_closed.is_closed _),
  rintros φ ⟨x, y⟩ hφg hφ,
  refine hg (prod.fst ∘ φ) x y ((continuous_fst.tendsto _).comp hφ) _,
  have : g ∘ prod.fst ∘ φ = prod.snd ∘ φ,
  { ext n,
    exact (hφg n).symm },
  rw this,
  exact (continuous_snd.tendsto _).comp hφ
end

variable {g}

namespace continuous_linear_map

/-- Upgrade a `linear_map` to a `continuous_linear_map` using the **closed graph theorem**. -/
def of_is_closed_graph (hg : is_closed (g.graph : set $ E × F)) :
  E →L[𝕜] F :=
{ to_linear_map := g,
  cont := g.continuous_of_is_closed_graph hg }

@[simp] lemma coe_fn_of_is_closed_graph (hg : is_closed (g.graph : set $ E × F)) :
  ⇑(continuous_linear_map.of_is_closed_graph hg) = g := rfl

lemma coe_of_is_closed_graph (hg : is_closed (g.graph : set $ E × F)) :
  ↑(continuous_linear_map.of_is_closed_graph hg) = g := by { ext, refl }

/-- Upgrade a `linear_map` to a `continuous_linear_map` using a variation on the
**closed graph theorem**. -/
def of_seq_closed_graph
  (hg : ∀ (u : ℕ → E) x y, tendsto u at_top (𝓝 x) → tendsto (g ∘ u) at_top (𝓝 y) → y = g x) :
  E →L[𝕜] F :=
{ to_linear_map := g,
  cont := g.continuous_of_seq_closed_graph hg }

@[simp] lemma coe_fn_of_seq_closed_graph
  (hg : ∀ (u : ℕ → E) x y, tendsto u at_top (𝓝 x) → tendsto (g ∘ u) at_top (𝓝 y) → y = g x) :
  ⇑(continuous_linear_map.of_seq_closed_graph hg) = g := rfl

lemma coe_of_seq_closed_graph
  (hg : ∀ (u : ℕ → E) x y, tendsto u at_top (𝓝 x) → tendsto (g ∘ u) at_top (𝓝 y) → y = g x) :
  ↑(continuous_linear_map.of_seq_closed_graph hg) = g := by { ext, refl }

end continuous_linear_map

end closed_graph_thm


/-
Copyright (c) 2019 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.rat.order
import Mathlib.data.int.char_zero
import Mathlib.PostPort

universes u_1 u_2

namespace Mathlib

/-!
# Casts for Rational Numbers

## Summary

We define the canonical injection from ℚ into an arbitrary division ring and prove various
casting lemmas showing the well-behavedness of this injection.

## Notations

- `/.` is infix notation for `rat.mk`.

## Tags

rat, rationals, field, ℚ, numerator, denominator, num, denom, cast, coercion, casting
-/

namespace rat

/-- Construct the canonical injection from `ℚ` into an arbitrary
  division ring. If the field has positive characteristic `p`,
  we define `1 / p = 1 / 0 = 0` for consistency with our
  division by zero convention. -/
-- see Note [coercion into rings]

protected instance cast_coe {α : Type u_1} [division_ring α] : has_coe_t ℚ α :=
  has_coe_t.mk fun (r : ℚ) => ↑(num r) / ↑(denom r)

@[simp] theorem cast_of_int {α : Type u_1} [division_ring α] (n : ℤ) : ↑(of_int n) = ↑n :=
  (fun (this : ↑n / ↑1 = ↑n) => this)
    (eq.mpr (id (Eq._oldrec (Eq.refl (↑n / ↑1 = ↑n)) nat.cast_one))
      (eq.mpr (id (Eq._oldrec (Eq.refl (↑n / 1 = ↑n)) (div_one ↑n))) (Eq.refl ↑n)))

@[simp] theorem cast_coe_int {α : Type u_1} [division_ring α] (n : ℤ) : ↑↑n = ↑n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (↑↑n = ↑n)) (coe_int_eq_of_int n)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (↑(of_int n) = ↑n)) (cast_of_int n))) (Eq.refl ↑n))

@[simp] theorem cast_coe_nat {α : Type u_1} [division_ring α] (n : ℕ) : ↑↑n = ↑n :=
  cast_coe_int ↑n

@[simp] theorem cast_zero {α : Type u_1} [division_ring α] : ↑0 = 0 :=
  Eq.trans (cast_of_int 0) int.cast_zero

@[simp] theorem cast_one {α : Type u_1} [division_ring α] : ↑1 = 1 :=
  Eq.trans (cast_of_int 1) int.cast_one

theorem cast_commute {α : Type u_1} [division_ring α] (r : ℚ) (a : α) : commute (↑r) a :=
  commute.div_left (int.cast_commute (num r) a) (nat.cast_commute (denom r) a)

theorem commute_cast {α : Type u_1} [division_ring α] (a : α) (r : ℚ) : commute a ↑r :=
  commute.symm (cast_commute r a)

theorem cast_mk_of_ne_zero {α : Type u_1} [division_ring α] (a : ℤ) (b : ℤ) (b0 : ↑b ≠ 0) : ↑(mk a b) = ↑a / ↑b := sorry

theorem cast_add_of_ne_zero {α : Type u_1} [division_ring α] {m : ℚ} {n : ℚ} : ↑(denom m) ≠ 0 → ↑(denom n) ≠ 0 → ↑(m + n) = ↑m + ↑n := sorry

@[simp] theorem cast_neg {α : Type u_1} [division_ring α] (n : ℚ) : ↑(-n) = -↑n := sorry

theorem cast_sub_of_ne_zero {α : Type u_1} [division_ring α] {m : ℚ} {n : ℚ} (m0 : ↑(denom m) ≠ 0) (n0 : ↑(denom n) ≠ 0) : ↑(m - n) = ↑m - ↑n := sorry

theorem cast_mul_of_ne_zero {α : Type u_1} [division_ring α] {m : ℚ} {n : ℚ} : ↑(denom m) ≠ 0 → ↑(denom n) ≠ 0 → ↑(m * n) = ↑m * ↑n := sorry

theorem cast_inv_of_ne_zero {α : Type u_1} [division_ring α] {n : ℚ} : ↑(num n) ≠ 0 → ↑(denom n) ≠ 0 → ↑(n⁻¹) = (↑n⁻¹) := sorry

theorem cast_div_of_ne_zero {α : Type u_1} [division_ring α] {m : ℚ} {n : ℚ} (md : ↑(denom m) ≠ 0) (nn : ↑(num n) ≠ 0) (nd : ↑(denom n) ≠ 0) : ↑(m / n) = ↑m / ↑n := sorry

@[simp] theorem cast_inj {α : Type u_1} [division_ring α] [char_zero α] {m : ℚ} {n : ℚ} : ↑m = ↑n ↔ m = n := sorry

theorem cast_injective {α : Type u_1} [division_ring α] [char_zero α] : function.injective coe :=
  fun {a₁ a₂ : ℚ} => idRhs (↑a₁ = ↑a₂ → a₁ = a₂) (iff.mp cast_inj)

@[simp] theorem cast_eq_zero {α : Type u_1} [division_ring α] [char_zero α] {n : ℚ} : ↑n = 0 ↔ n = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (↑n = 0 ↔ n = 0)) (Eq.symm cast_zero)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (↑n = ↑0 ↔ n = 0)) (propext cast_inj))) (iff.refl (n = 0)))

theorem cast_ne_zero {α : Type u_1} [division_ring α] [char_zero α] {n : ℚ} : ↑n ≠ 0 ↔ n ≠ 0 :=
  not_congr cast_eq_zero

@[simp] theorem cast_add {α : Type u_1} [division_ring α] [char_zero α] (m : ℚ) (n : ℚ) : ↑(m + n) = ↑m + ↑n :=
  cast_add_of_ne_zero (iff.mpr nat.cast_ne_zero (ne_of_gt (pos m))) (iff.mpr nat.cast_ne_zero (ne_of_gt (pos n)))

@[simp] theorem cast_sub {α : Type u_1} [division_ring α] [char_zero α] (m : ℚ) (n : ℚ) : ↑(m - n) = ↑m - ↑n :=
  cast_sub_of_ne_zero (iff.mpr nat.cast_ne_zero (ne_of_gt (pos m))) (iff.mpr nat.cast_ne_zero (ne_of_gt (pos n)))

@[simp] theorem cast_mul {α : Type u_1} [division_ring α] [char_zero α] (m : ℚ) (n : ℚ) : ↑(m * n) = ↑m * ↑n :=
  cast_mul_of_ne_zero (iff.mpr nat.cast_ne_zero (ne_of_gt (pos m))) (iff.mpr nat.cast_ne_zero (ne_of_gt (pos n)))

@[simp] theorem cast_bit0 {α : Type u_1} [division_ring α] [char_zero α] (n : ℚ) : ↑(bit0 n) = bit0 ↑n :=
  cast_add n n

@[simp] theorem cast_bit1 {α : Type u_1} [division_ring α] [char_zero α] (n : ℚ) : ↑(bit1 n) = bit1 ↑n := sorry

/-- Coercion `ℚ → α` as a `ring_hom`. -/
def cast_hom (α : Type u_1) [division_ring α] [char_zero α] : ℚ →+* α :=
  ring_hom.mk coe cast_one cast_mul cast_zero cast_add

@[simp] theorem coe_cast_hom {α : Type u_1} [division_ring α] [char_zero α] : ⇑(cast_hom α) = coe :=
  rfl

@[simp] theorem cast_inv {α : Type u_1} [division_ring α] [char_zero α] (n : ℚ) : ↑(n⁻¹) = (↑n⁻¹) :=
  ring_hom.map_inv (cast_hom α) n

@[simp] theorem cast_div {α : Type u_1} [division_ring α] [char_zero α] (m : ℚ) (n : ℚ) : ↑(m / n) = ↑m / ↑n :=
  ring_hom.map_div (cast_hom α) m n

theorem cast_mk {α : Type u_1} [division_ring α] [char_zero α] (a : ℤ) (b : ℤ) : ↑(mk a b) = ↑a / ↑b := sorry

@[simp] theorem cast_pow {α : Type u_1} [division_ring α] [char_zero α] (q : ℚ) (k : ℕ) : ↑(q ^ k) = ↑q ^ k :=
  ring_hom.map_pow (cast_hom α) q k

@[simp] theorem cast_nonneg {α : Type u_1} [linear_ordered_field α] {n : ℚ} : 0 ≤ ↑n ↔ 0 ≤ n := sorry

@[simp] theorem cast_le {α : Type u_1} [linear_ordered_field α] {m : ℚ} {n : ℚ} : ↑m ≤ ↑n ↔ m ≤ n := sorry

@[simp] theorem cast_lt {α : Type u_1} [linear_ordered_field α] {m : ℚ} {n : ℚ} : ↑m < ↑n ↔ m < n := sorry

@[simp] theorem cast_nonpos {α : Type u_1} [linear_ordered_field α] {n : ℚ} : ↑n ≤ 0 ↔ n ≤ 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (↑n ≤ 0 ↔ n ≤ 0)) (Eq.symm cast_zero)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (↑n ≤ ↑0 ↔ n ≤ 0)) (propext cast_le))) (iff.refl (n ≤ 0)))

@[simp] theorem cast_pos {α : Type u_1} [linear_ordered_field α] {n : ℚ} : 0 < ↑n ↔ 0 < n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (0 < ↑n ↔ 0 < n)) (Eq.symm cast_zero)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (↑0 < ↑n ↔ 0 < n)) (propext cast_lt))) (iff.refl (0 < n)))

@[simp] theorem cast_lt_zero {α : Type u_1} [linear_ordered_field α] {n : ℚ} : ↑n < 0 ↔ n < 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (↑n < 0 ↔ n < 0)) (Eq.symm cast_zero)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (↑n < ↑0 ↔ n < 0)) (propext cast_lt))) (iff.refl (n < 0)))

@[simp] theorem cast_id (n : ℚ) : ↑n = n := sorry

@[simp] theorem cast_min {α : Type u_1} [linear_ordered_field α] {a : ℚ} {b : ℚ} : ↑(min a b) = min ↑a ↑b := sorry

@[simp] theorem cast_max {α : Type u_1} [linear_ordered_field α] {a : ℚ} {b : ℚ} : ↑(max a b) = max ↑a ↑b := sorry

@[simp] theorem cast_abs {α : Type u_1} [linear_ordered_field α] {q : ℚ} : ↑(abs q) = abs ↑q := sorry

end rat

theorem ring_hom.eq_rat_cast {k : Type u_1} [division_ring k] (f : ℚ →+* k) (r : ℚ) : coe_fn f r = ↑r := sorry

-- This seems to be true for a `[char_p k]` too because `k'` must have the same characteristic

-- but the proof would be much longer

theorem ring_hom.map_rat_cast {k : Type u_1} {k' : Type u_2} [division_ring k] [char_zero k] [division_ring k'] (f : k →+* k') (r : ℚ) : coe_fn f ↑r = ↑r :=
  ring_hom.eq_rat_cast (ring_hom.comp f (rat.cast_hom k)) r

theorem ring_hom.ext_rat {R : Type u_1} [semiring R] (f : ℚ →+* R) (g : ℚ →+* R) : f = g := sorry

protected instance rat.subsingleton_ring_hom {R : Type u_1} [semiring R] : subsingleton (ℚ →+* R) :=
  subsingleton.intro ring_hom.ext_rat


import tactic
open expr tactic
open interactive (parse)
open lean.parser (ident)

--------------------  TACTIC: APPLY A THEOREM TO THE GOAL --------------------

meta def apply_theorem (thm_name : name) : tactic unit :=
  applyc thm_name

example : 1+2=2+1:=
begin
  --apply add_comm,
  apply_theorem `add_comm,
end

--------------------  TACTIC: REWRITE THE GOAL USING A THEOREM --------------------

-- tries to rewrite using theorem.  if it fails to make progress, tactic fails.
meta def rewrite_using_theorem (thm_name : name) : tactic unit := do {
  e ← get_env,
  --simp_set ← simp_lemmas.mk_default, -- allow it to use the usual simplifying lemmas
  let simp_set := simp_lemmas.mk, -- don't give it access to the usual simplifying lemmas
  simp_set ← simp_set.add_simp thm_name,
  thms_used ← simp_target simp_set, -- does the simp, and returns the names of the simplifying lemmas used
  -- trace thms_used,
  skip -- return tactic.unit
}

example : 1+3=nat.succ(2)+1:=
begin
  --rw nat.add_one,
  rewrite_using_theorem `nat.add_one,
  trivial
end

--------------------  TACTIC: REWRITE THE GOAL USING A THEOREM --------------------

meta def simp_goal : tactic unit := do {
  simp_set ← simp_lemmas.mk_default, -- allow it to use the usual simplifying lemmas
  thms_used ← simp_target simp_set, -- does the simp, and returns the names of the simplifying lemmas used
  -- trace thms_used,
  skip -- return tactic.unit
}

example : 1+3=nat.succ(2)+1:=
begin
  simp_goal,
  triv
end

--------------------  TACTIC: TRY BOTH --------------------
meta def use_theorem (thm_name : name) : tactic unit := do {
  -- apply the theorem, and if that fails, rewrite it
  apply_theorem thm_name <|> rewrite_using_theorem thm_name
}

example : 3* (2 * 7) = 3*(7 + 7):=
begin
  -- in interactive mode
  -- apply two_mul,
  -- rw two_mul,

  -- using tactics
  -- apply_theorem `two_mul,
  -- rewrite_using_theorem `two_mul,
  -- trivial

  use_theorem `two_mul,
  trivial

end


import combinatorics.simple_graph.basic
import mathlib.logic.basic

variables {α : Type*} {G H : simple_graph α} {s : set (sym2 α)}

namespace simple_graph

@[simp] lemma disjoint_edge_set : disjoint G.edge_set H.edge_set ↔ disjoint G H :=
by rw [set.disjoint_iff, disjoint_iff_inf_le, ←edge_set_inf, ←edge_set_bot, ←set.le_iff_subset,
  order_embedding.le_iff_le]

@[simp] lemma nonempty_edge_set : G.edge_set.nonempty ↔ G ≠ ⊥ :=
by rw [set.nonempty_iff_ne_empty, ←edge_set_bot, edge_set_inj.ne]

@[simp] lemma disjoint_from_edge_set : disjoint G (from_edge_set s) ↔ disjoint G.edge_set s :=
begin
  conv_rhs { rw ←set.diff_union_inter s {e : sym2 α | e.is_diag} },
  rw [←disjoint_edge_set, edge_set_from_edge_set, set.disjoint_union_right, and_iff_left],
  exact set.disjoint_left.2 (λ e he he', not_is_diag_of_mem_edge_set _ he he'.2),
end

@[simp] lemma from_edge_set_disjoint : disjoint (from_edge_set s) G ↔ disjoint s G.edge_set :=
by rw [disjoint.comm, disjoint_from_edge_set, disjoint.comm]

@[simp] lemma delete_edges_eq : G.delete_edges s = G ↔ disjoint G.edge_set s :=
by rw [delete_edges_eq_sdiff_from_edge_set, sdiff_eq_left, disjoint_from_edge_set]

namespace hom

@[simp, norm_cast] lemma coe_id : ⇑(id : G →g G) = _root_.id := rfl

end hom

/-- The graph homomorphism from a smaller graph to a bigger one. -/
def hom_of_le (h : G ≤ H) : G →g H := ⟨id, h⟩

@[simp, norm_cast] lemma coe_hom_of_le (h : G ≤ H) : ⇑(hom_of_le h) = id := rfl

end simple_graph


import Lean
import Std
import Lean.Elab.Command

-- set_option max_re
abbrev Matrix α := Array (Array α)

structure FinRange (n: Nat)

def finRange (n: Nat): FinRange n := {}

def FinRange.forIn [Monad m] (rng: FinRange n) (b: β) (f: Fin n -> β -> m (ForInStep β)) (i: Nat): m β :=
  if p: i < n then do
      match (<- f ⟨i, p⟩ b) with
      | .done b' => pure b'
      | .yield b'=> forIn rng b' f (i + 1)
  else pure b
termination_by forIn _ _ _ i => n - i

instance {n: Nat}: ForIn m (FinRange n) (Fin n) where
  forIn rng b f := FinRange.forIn rng b f 0

namespace Array

theorem modify_stable_size(arr: Array α) (f: α -> α) (n: Nat): arr.size = (arr.modify n f).size := by
  simp [modify, modifyM, dite]
  generalize Nat.decLt n (size arr) = q
  cases q <;> simp [Id.run]

namespace ZipWithN
variable (as: Array α) (bs: Array β) (f: α -> β -> γ) (p: as.size = bs.size)

def go (arr: Array γ) (i: Nat): Array γ   :=
  if q : i < as.size then
    let a := as[i]'q
    let b := bs[i]'(by rw [<-p]; exact q)
    go (arr.push <| f a b) (i + 1)
  else arr
  termination_by go _ i => as.size - i

def zipWithN: Array γ := go as bs f p Array.empty 0

theorem zipWithNSizeGo (ip: i <= as.size) (ap: i = arr.size): (go as bs f p arr i).size = as.size := by
  unfold go
  split
  . apply zipWithNSizeGo
    . apply Nat.succ_le_of_lt
      assumption
    . rw [Array.size_push]
      simp
      assumption
  . rw [<-ap]
    apply Nat.le_antisymm
    . assumption
    . apply Nat.le_of_not_lt
      assumption
termination_by zipWithNSizeGo => as.size - i

theorem zipWithNSize: (zipWithN as bs f p).size = as.size := by
  apply zipWithNSizeGo
  . apply Nat.zero_le
  . simp [Array.size, List.length]

end ZipWithN

def zipWithN as bs (f: α -> β -> γ) := ZipWithN.zipWithN as bs f

def uniques [Ord α] [Inhabited α] [BEq α] (arr: Array α) : Id (Array α) := do
  if arr.isEmpty then return arr
  let arr := arr.qsort (compare · · == Ordering.lt)
  let mut res := #[arr[0]!]
  for i in [1:arr.size] do
    if arr[i]! != arr[i - 1]! then
      res := res.push arr[i]!
  return res

open Lean (HashMap)

def groupBy [Hashable β] [BEq β] (f: α -> β) (arr: Array α): Id (HashMap β (List α)) := do
  let mut res := HashMap.empty
  for a in arr do
    let g := f a
    res := res.insert g <|
      if let some lst := res.find? g
      then a :: lst
      else [a]

  return res

def autoGrow (p: Array α) (n: Nat) (elem: α): Array α :=
  if p.size < n then p.append (Array.mkArray (n - p.size) elem) else p

def zipWithGrow (xs: Array α) (ys: Array β) (f: α -> β -> γ) (x: α) (y: β): Array γ :=
  let xs := xs.autoGrow ys.size x
  let ys := ys.autoGrow xs.size y
  xs.zipWith ys f

-- TODO proof of indexing
def transpose [Inhabited α] (arr: Array (Array α)): Array (Array α) :=
  let m := arr.size
  let n := arr.foldl (min · ·.size) (arr[0]?.elim 0 (·.size))
  let res := Array.mkArray n <| Array.mkArray m default
  (fill res).2
where
  fill: StateM _ _ := fun res => do
    let res <- res.mapIdxM <| fun i row =>
        row.mapIdxM <| fun j _ => arr[j]![i]!
    ((), res)

end Array

structure Matr (α: Type) where
  data: Array (Array α)
  n: Nat
  m: Nat
  ns: data.size = n
  ms (i: Fin n): (data.get ⟨i.val, by rw [ns] ; exact i.isLt⟩).size = m

namespace Matr
  variable (mat: Matr α)
  def get (i: Fin mat.n) (j: Fin mat.m): α :=
    let row := mat.data.get ⟨i.val, by rw[mat.ns] ; exact i.isLt⟩
    row[j]'(by rw [mat.ms i]; exact j.isLt)

  instance {α}: GetElem (Matr α) (Nat × Nat) α fun mat (i, j) => i < mat.n ∧ j < mat.m where
    getElem mat := fun (i, j) ⟨pi, pj⟩ => mat.get ⟨i, pi⟩ ⟨j, pj⟩

  structure Indices {α : Type} (mat: Matr α) where

  instance {mat: Matr α} : ForIn w (Indices mat) (Fin mat.n × Fin mat.m) where
    forIn _ b f := do
      let mut b := b
      for i in finRange mat.n do
        for j in finRange mat.m do
          match (<- f (i, j) b) with
          | .yield b' => b := b'
          | .done b'  => return b'
      return b

  -- def happend (mat': Matr α) (p: mat.n = mat'.n): { m: Matr α // m.n = mat.n ∧ m.m = (mat.m + mat'.m) } :=
  --   let ⟨data, q⟩ := mat.data.zipWithN mat'.data (· ++ ·) <| by rw [mat.ns, mat'.ns, p]
  --   let m := {
  --       data
  --       n := mat.n
  --       m := mat.m + mat'.m
  --       ns := by rw [q, mat.ns]
  --       ms := by intro i; admit
  --   }
  --   ⟨m, by simp⟩
  def happend (mat': Matr α) (p: mat.n = mat'.n): Matr α :=
    let data := mat.data.zipWithN mat'.data (· ++ ·) <| by rw [mat.ns, mat'.ns, p]
    have q: data.size = mat.data.size := by apply Array.ZipWithN.zipWithNSize
    {
        data
        n := mat.n
        m := mat.m + mat'.m
        ns := by rw [q, mat.ns]
        ms := by intro i; admit
    }
end Matr


/-
Copyright (c) 2018 Johan Commelin All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin, Chris Hughes, Kevin Buzzard
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.group.hom
import Mathlib.PostPort

universes u v w u_1 u_2

namespace Mathlib

/-!
# Lift monoid homomorphisms to group homomorphisms of their units subgroups.
-/

namespace units

/-- The group homomorphism on units induced by a `monoid_hom`. -/
def map {M : Type u} {N : Type v} [monoid M] [monoid N] (f : M →* N) : units M →* units N :=
  monoid_hom.mk' (fun (u : units M) => mk (coe_fn f (val u)) (coe_fn f (inv u)) sorry sorry) sorry

@[simp] theorem coe_map {M : Type u} {N : Type v} [monoid M] [monoid N] (f : M →* N) (x : units M) : ↑(coe_fn (map f) x) = coe_fn f ↑x :=
  rfl

@[simp] theorem Mathlib.add_units.coe_map_neg {M : Type u} {N : Type v} [add_monoid M] [add_monoid N] (f : M →+ N) (u : add_units M) : ↑(-coe_fn (add_units.map f) u) = coe_fn f ↑(-u) :=
  rfl

@[simp] theorem map_comp {M : Type u} {N : Type v} {P : Type w} [monoid M] [monoid N] [monoid P] (f : M →* N) (g : N →* P) : map (monoid_hom.comp g f) = monoid_hom.comp (map g) (map f) :=
  rfl

@[simp] theorem map_id (M : Type u) [monoid M] : map (monoid_hom.id M) = monoid_hom.id (units M) :=
  monoid_hom.ext fun (x : units M) => ext (Eq.refl ↑(coe_fn (map (monoid_hom.id M)) x))

/-- Coercion `units M → M` as a monoid homomorphism. -/
def coe_hom (M : Type u) [monoid M] : units M →* M :=
  monoid_hom.mk coe coe_one coe_mul

@[simp] theorem coe_hom_apply {M : Type u} [monoid M] (x : units M) : coe_fn (coe_hom M) x = ↑x :=
  rfl

/-- If a map `g : M → units N` agrees with a homomorphism `f : M →* N`, then
this map is a monoid homomorphism too. -/
def lift_right {M : Type u} {N : Type v} [monoid M] [monoid N] (f : M →* N) (g : M → units N) (h : ∀ (x : M), ↑(g x) = coe_fn f x) : M →* units N :=
  monoid_hom.mk g sorry sorry

@[simp] theorem coe_lift_right {M : Type u} {N : Type v} [monoid M] [monoid N] {f : M →* N} {g : M → units N} (h : ∀ (x : M), ↑(g x) = coe_fn f x) (x : M) : ↑(coe_fn (lift_right f g h) x) = coe_fn f x :=
  h x

@[simp] theorem mul_lift_right_inv {M : Type u} {N : Type v} [monoid M] [monoid N] {f : M →* N} {g : M → units N} (h : ∀ (x : M), ↑(g x) = coe_fn f x) (x : M) : coe_fn f x * ↑(coe_fn (lift_right f g h) x⁻¹) = 1 := sorry

@[simp] theorem lift_right_inv_mul {M : Type u} {N : Type v} [monoid M] [monoid N] {f : M →* N} {g : M → units N} (h : ∀ (x : M), ↑(g x) = coe_fn f x) (x : M) : ↑(coe_fn (lift_right f g h) x⁻¹) * coe_fn f x = 1 := sorry

end units

namespace monoid_hom

/-- If `f` is a homomorphism from a group `G` to a monoid `M`,
then its image lies in the units of `M`,
and `f.to_hom_units` is the corresponding monoid homomorphism from `G` to `units M`. -/
def Mathlib.add_monoid_hom.to_hom_units {G : Type u_1} {M : Type u_2} [add_group G] [add_monoid M] (f : G →+ M) : G →+ add_units M :=
  add_monoid_hom.mk (fun (g : G) => add_units.mk (coe_fn f g) (coe_fn f (-g)) sorry sorry) sorry sorry

@[simp] theorem coe_to_hom_units {G : Type u_1} {M : Type u_2} [group G] [monoid M] (f : G →* M) (g : G) : ↑(coe_fn (to_hom_units f) g) = coe_fn f g :=
  rfl

end monoid_hom

theorem is_unit.map {M : Type u_1} {N : Type u_2} [monoid M] [monoid N] (f : M →* N) {x : M} (h : is_unit x) : is_unit (coe_fn f x) :=
  Exists.dcases_on h fun (y : units M) (h_h : ↑y = x) => Eq._oldrec (is_unit_unit (coe_fn (units.map f) y)) h_h

/-- If a homomorphism `f : M →* N` sends each element to an `is_unit`, then it can be lifted
to `f : M →* units N`. See also `units.lift_right` for a computable version. -/
def is_unit.lift_right {M : Type u_1} {N : Type u_2} [monoid M] [monoid N] (f : M →* N) (hf : ∀ (x : M), is_unit (coe_fn f x)) : M →* units N :=
  units.lift_right f (fun (x : M) => classical.some (hf x)) sorry

theorem is_add_unit.coe_lift_right {M : Type u_1} {N : Type u_2} [add_monoid M] [add_monoid N] (f : M →+ N) (hf : ∀ (x : M), is_add_unit (coe_fn f x)) (x : M) : ↑(coe_fn (is_add_unit.lift_right f hf) x) = coe_fn f x :=
  add_units.coe_lift_right (is_add_unit.lift_right._proof_1 f hf) x

@[simp] theorem is_add_unit.add_lift_right_neg {M : Type u_1} {N : Type u_2} [add_monoid M] [add_monoid N] (f : M →+ N) (h : ∀ (x : M), is_add_unit (coe_fn f x)) (x : M) : coe_fn f x + ↑(-coe_fn (is_add_unit.lift_right f h) x) = 0 :=
  add_units.add_lift_right_neg (fun (y : M) => classical.some_spec (h y)) x

@[simp] theorem is_add_unit.lift_right_neg_add {M : Type u_1} {N : Type u_2} [add_monoid M] [add_monoid N] (f : M →+ N) (h : ∀ (x : M), is_add_unit (coe_fn f x)) (x : M) : ↑(-coe_fn (is_add_unit.lift_right f h) x) + coe_fn f x = 0 :=
  add_units.lift_right_neg_add (fun (y : M) => classical.some_spec (h y)) x