/-
Copyright (c) 2014 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Andrew Zipperer, Haitao Zhang, Minchao Wu, Yury Kudryashov
-/
import data.set.prod
import logic.function.conjugate

/-!
# Functions over sets

## Main definitions

### Predicate

* `set.eq_on f₁ f₂ s` : functions `f₁` and `f₂` are equal at every point of `s`;
* `set.maps_to f s t` : `f` sends every point of `s` to a point of `t`;
* `set.inj_on f s` : restriction of `f` to `s` is injective;
* `set.surj_on f s t` : every point in `s` has a preimage in `s`;
* `set.bij_on f s t` : `f` is a bijection between `s` and `t`;
* `set.left_inv_on f' f s` : for every `x ∈ s` we have `f' (f x) = x`;
* `set.right_inv_on f' f t` : for every `y ∈ t` we have `f (f' y) = y`;
* `set.inv_on f' f s t` : `f'` is a two-side inverse of `f` on `s` and `t`, i.e.
  we have `set.left_inv_on f' f s` and `set.right_inv_on f' f t`.

### Functions

* `set.restrict f s` : restrict the domain of `f` to the set `s`;
* `set.cod_restrict f s h` : given `h : ∀ x, f x ∈ s`, restrict the codomain of `f` to the set `s`;
* `set.maps_to.restrict f s t h`: given `h : maps_to f s t`, restrict the domain of `f` to `s`
  and the codomain to `t`.
-/
universes u v w x y

variables {α : Type u} {β : Type v} {γ : Type w} {ι : Sort x}

open function

namespace set

/-! ### Restrict -/

/-- Restrict domain of a function `f` to a set `s`. Same as `subtype.restrict` but this version
takes an argument `↥s` instead of `subtype s`. -/
def restrict (f : α → β) (s : set α) : s → β := λ x, f x

lemma restrict_eq (f : α → β) (s : set α) : s.restrict f = f ∘ coe := rfl

@[simp] lemma restrict_apply (f : α → β) (s : set α) (x : s) : restrict f s x = f x := rfl

@[simp] lemma range_restrict (f : α → β) (s : set α) : set.range (restrict f s) = f '' s :=
(range_comp _ _).trans $ congr_arg (('') f) subtype.range_coe

lemma image_restrict (f : α → β) (s t : set α) : s.restrict f '' (coe ⁻¹' t) = f '' (t ∩ s) :=
by rw [restrict, image_comp, image_preimage_eq_inter_range, subtype.range_coe]

@[simp] lemma restrict_dite {s : set α} [∀ x, decidable (x ∈ s)] (f : Π a ∈ s, β) (g : Π a ∉ s, β) :
  restrict (λ a, if h : a ∈ s then f a h else g a h) s = λ a, f a a.2 :=
funext $ λ a, dif_pos a.2

@[simp] lemma restrict_dite_compl {s : set α} [∀ x, decidable (x ∈ s)] (f : Π a ∈ s, β)
  (g : Π a ∉ s, β) :
  restrict (λ a, if h : a ∈ s then f a h else g a h) sᶜ = λ a, g a a.2 :=
funext $ λ a, dif_neg a.2

@[simp] lemma restrict_ite (f g : α → β) (s : set α) [∀ x, decidable (x ∈ s)] :
  restrict (λ a, if a ∈ s then f a else g a) s = restrict f s :=
restrict_dite _ _

@[simp] lemma restrict_ite_compl (f g : α → β) (s : set α) [∀ x, decidable (x ∈ s)] :
  restrict (λ a, if a ∈ s then f a else g a) sᶜ = restrict g sᶜ :=
restrict_dite_compl _ _

@[simp] lemma restrict_piecewise (f g : α → β) (s : set α) [∀ x, decidable (x ∈ s)] :
  restrict (piecewise s f g) s = restrict f s :=
restrict_ite _ _ _

@[simp] lemma restrict_piecewise_compl (f g : α → β) (s : set α) [∀ x, decidable (x ∈ s)] :
  restrict (piecewise s f g) sᶜ = restrict g sᶜ :=
restrict_ite_compl _ _ _

lemma restrict_extend_range (f : α → β) (g : α → γ) (g' : β → γ) :
  restrict (extend f g g') (range f) = λ x, g x.coe_prop.some :=
by convert restrict_dite _ _

@[simp] lemma restrict_extend_compl_range (f : α → β) (g : α → γ) (g' : β → γ) :
  restrict (extend f g g') (range f)ᶜ = g' ∘ coe :=
by convert restrict_dite_compl _ _

lemma range_extend_subset (f : α → β) (g : α → γ) (g' : β → γ) :
  range (extend f g g') ⊆ range g ∪ g' '' (range f)ᶜ :=
begin
  classical,
  rintro _ ⟨y, rfl⟩,
  rw extend_def, split_ifs,
  exacts [or.inl (mem_range_self _), or.inr (mem_image_of_mem _ h)]
end

lemma range_extend {f : α → β} (hf : injective f) (g : α → γ) (g' : β → γ) :
  range (extend f g g') = range g ∪ g' '' (range f)ᶜ :=
begin
  refine (range_extend_subset _ _ _).antisymm _,
  rintro z (⟨x, rfl⟩|⟨y, hy, rfl⟩),
  exacts [⟨f x, extend_apply hf _ _ _⟩, ⟨y, extend_apply' _ _ _ hy⟩]
end

/-- Restrict codomain of a function `f` to a set `s`. Same as `subtype.coind` but this version
has codomain `↥s` instead of `subtype s`. -/
def cod_restrict (f : α → β) (s : set β) (h : ∀ x, f x ∈ s) : α → s :=
λ x, ⟨f x, h x⟩

@[simp] lemma coe_cod_restrict_apply (f : α → β) (s : set β) (h : ∀ x, f x ∈ s) (x : α) :
  (cod_restrict f s h x : β) = f x :=
rfl

variables {s s₁ s₂ : set α} {t t₁ t₂ : set β} {p : set γ} {f f₁ f₂ f₃ : α → β} {g g₁ g₂ : β → γ}
  {f' f₁' f₂' : β → α} {g' : γ → β}

@[simp] lemma injective_cod_restrict (h : ∀ x, f x ∈ t) :
  injective (cod_restrict f t h) ↔ injective f :=
by simp only [injective, subtype.ext_iff, coe_cod_restrict_apply]

alias injective_cod_restrict ↔ _ function.injective.cod_restrict

/-! ### Equality on a set -/

/-- Two functions `f₁ f₂ : α → β` are equal on `s`
  if `f₁ x = f₂ x` for all `x ∈ a`. -/
def eq_on (f₁ f₂ : α → β) (s : set α) : Prop :=
∀ ⦃x⦄, x ∈ s → f₁ x = f₂ x

@[simp] lemma eq_on_empty (f₁ f₂ : α → β) : eq_on f₁ f₂ ∅ := λ x, false.elim

@[symm] lemma eq_on.symm (h : eq_on f₁ f₂ s) : eq_on f₂ f₁ s :=
λ x hx, (h hx).symm

lemma eq_on_comm : eq_on f₁ f₂ s ↔ eq_on f₂ f₁ s :=
⟨eq_on.symm, eq_on.symm⟩

@[refl] lemma eq_on_refl (f : α → β) (s : set α) : eq_on f f s :=
λ _ _, rfl

@[trans] lemma eq_on.trans (h₁ : eq_on f₁ f₂ s) (h₂ : eq_on f₂ f₃ s) : eq_on f₁ f₃ s :=
λ x hx, (h₁ hx).trans (h₂ hx)

theorem eq_on.image_eq (heq : eq_on f₁ f₂ s) : f₁ '' s = f₂ '' s :=
image_congr heq

theorem eq_on.inter_preimage_eq (heq : eq_on f₁ f₂ s) (t : set β) : s ∩ f₁ ⁻¹' t = s ∩ f₂ ⁻¹' t :=
ext $ λ x, and.congr_right_iff.2 $ λ hx, by rw [mem_preimage, mem_preimage, heq hx]

lemma eq_on.mono (hs : s₁ ⊆ s₂) (hf : eq_on f₁ f₂ s₂) : eq_on f₁ f₂ s₁ :=
λ x hx, hf (hs hx)

lemma eq_on.comp_left (h : s.eq_on f₁ f₂) : s.eq_on (g ∘ f₁) (g ∘ f₂) := λ a ha, congr_arg _ $ h ha

lemma comp_eq_of_eq_on_range {ι : Sort*} {f : ι → α} {g₁ g₂ : α → β} (h : eq_on g₁ g₂ (range f)) :
  g₁ ∘ f = g₂ ∘ f :=
funext $ λ x, h $ mem_range_self _

/-! ### Congruence lemmas -/

section order
variables [preorder α] [preorder β]

lemma _root_.monotone_on.congr (h₁ : monotone_on f₁ s) (h : s.eq_on f₁ f₂) : monotone_on f₂ s :=
begin
  intros a ha b hb hab,
  rw [←h ha, ←h hb],
  exact h₁ ha hb hab,
end

lemma _root_.antitone_on.congr (h₁ : antitone_on f₁ s) (h : s.eq_on f₁ f₂) : antitone_on f₂ s :=
h₁.dual_right.congr h

lemma _root_.strict_mono_on.congr (h₁ : strict_mono_on f₁ s) (h : s.eq_on f₁ f₂) :
  strict_mono_on f₂ s :=
begin
  intros a ha b hb hab,
  rw [←h ha, ←h hb],
  exact h₁ ha hb hab,
end

lemma _root_.strict_anti_on.congr (h₁ : strict_anti_on f₁ s) (h : s.eq_on f₁ f₂) :
  strict_anti_on f₂ s :=
h₁.dual_right.congr h

lemma eq_on.congr_monotone_on (h : s.eq_on f₁ f₂) : monotone_on f₁ s ↔ monotone_on f₂ s :=
⟨λ h₁, h₁.congr h, λ h₂, h₂.congr h.symm⟩

lemma eq_on.congr_antitone_on (h : s.eq_on f₁ f₂) : antitone_on f₁ s ↔ antitone_on f₂ s :=
⟨λ h₁, h₁.congr h, λ h₂, h₂.congr h.symm⟩

lemma eq_on.congr_strict_mono_on (h : s.eq_on f₁ f₂) : strict_mono_on f₁ s ↔ strict_mono_on f₂ s :=
⟨λ h₁, h₁.congr h, λ h₂, h₂.congr h.symm⟩

lemma eq_on.congr_strict_anti_on (h : s.eq_on f₁ f₂) : strict_anti_on f₁ s ↔ strict_anti_on f₂ s :=
⟨λ h₁, h₁.congr h, λ h₂, h₂.congr h.symm⟩

end order

/-! ### maps to -/

/-- `maps_to f a b` means that the image of `a` is contained in `b`. -/
@[reducible] def maps_to (f : α → β) (s : set α) (t : set β) : Prop := ∀ ⦃x⦄, x ∈ s → f x ∈ t

/-- Given a map `f` sending `s : set α` into `t : set β`, restrict domain of `f` to `s`
and the codomain to `t`. Same as `subtype.map`. -/
def maps_to.restrict (f : α → β) (s : set α) (t : set β) (h : maps_to f s t) :
  s → t :=
subtype.map f h

@[simp] lemma maps_to.coe_restrict_apply (h : maps_to f s t) (x : s) :
  (h.restrict f s t x : β) = f x := rfl

lemma maps_to_iff_exists_map_subtype : maps_to f s t ↔ ∃ g : s → t, ∀ x : s, f x = g x :=
⟨λ h, ⟨h.restrict f s t, λ _, rfl⟩,
  λ ⟨g, hg⟩ x hx, by { erw [hg ⟨x, hx⟩], apply subtype.coe_prop }⟩

theorem maps_to' : maps_to f s t ↔ f '' s ⊆ t :=
image_subset_iff.symm

@[simp] theorem maps_to_singleton {x : α} : maps_to f {x} t ↔ f x ∈ t := singleton_subset_iff

theorem maps_to_empty (f : α → β) (t : set β) : maps_to f ∅ t := empty_subset _

theorem maps_to.image_subset (h : maps_to f s t) : f '' s ⊆ t :=
maps_to'.1 h

theorem maps_to.congr (h₁ : maps_to f₁ s t) (h : eq_on f₁ f₂ s) :
  maps_to f₂ s t :=
λ x hx, h hx ▸ h₁ hx

lemma eq_on.comp_right (hg : t.eq_on g₁ g₂) (hf : s.maps_to f t) : s.eq_on (g₁ ∘ f) (g₂ ∘ f) :=
λ a ha, hg $ hf ha

theorem eq_on.maps_to_iff (H : eq_on f₁ f₂ s) : maps_to f₁ s t ↔ maps_to f₂ s t :=
⟨λ h, h.congr H, λ h, h.congr H.symm⟩

theorem maps_to.comp (h₁ : maps_to g t p) (h₂ : maps_to f s t) : maps_to (g ∘ f) s p :=
λ x h, h₁ (h₂ h)

theorem maps_to_id (s : set α) : maps_to id s s := λ x, id

theorem maps_to.iterate {f : α → α} {s : set α} (h : maps_to f s s) :
  ∀ n, maps_to (f^[n]) s s
| 0 := λ _, id
| (n+1) := (maps_to.iterate n).comp h

theorem maps_to.iterate_restrict {f : α → α} {s : set α} (h : maps_to f s s) (n : ℕ) :
  (h.restrict f s s^[n]) = (h.iterate n).restrict _ _ _ :=
begin
  funext x,
  rw [subtype.ext_iff, maps_to.coe_restrict_apply],
  induction n with n ihn generalizing x,
  { refl },
  { simp [nat.iterate, ihn] }
end

theorem maps_to.mono (hs : s₂ ⊆ s₁) (ht : t₁ ⊆ t₂) (hf : maps_to f s₁ t₁) :
  maps_to f s₂ t₂ :=
λ x hx, ht (hf $ hs hx)

theorem maps_to.union_union (h₁ : maps_to f s₁ t₁) (h₂ : maps_to f s₂ t₂) :
  maps_to f (s₁ ∪ s₂) (t₁ ∪ t₂) :=
λ x hx, hx.elim (λ hx, or.inl $ h₁ hx) (λ hx, or.inr $ h₂ hx)

theorem maps_to.union (h₁ : maps_to f s₁ t) (h₂ : maps_to f s₂ t) :
  maps_to f (s₁ ∪ s₂) t :=
union_self t ▸ h₁.union_union h₂

@[simp] theorem maps_to_union : maps_to f (s₁ ∪ s₂) t ↔ maps_to f s₁ t ∧ maps_to f s₂ t :=
⟨λ h, ⟨h.mono (subset_union_left s₁ s₂) (subset.refl t),
  h.mono (subset_union_right s₁ s₂) (subset.refl t)⟩, λ h, h.1.union h.2⟩

theorem maps_to.inter (h₁ : maps_to f s t₁) (h₂ : maps_to f s t₂) :
  maps_to f s (t₁ ∩ t₂) :=
λ x hx, ⟨h₁ hx, h₂ hx⟩

theorem maps_to.inter_inter (h₁ : maps_to f s₁ t₁) (h₂ : maps_to f s₂ t₂) :
  maps_to f (s₁ ∩ s₂) (t₁ ∩ t₂) :=
λ x hx, ⟨h₁ hx.1, h₂ hx.2⟩

@[simp] theorem maps_to_inter : maps_to f s (t₁ ∩ t₂) ↔ maps_to f s t₁ ∧ maps_to f s t₂ :=
⟨λ h, ⟨h.mono (subset.refl s) (inter_subset_left t₁ t₂),
  h.mono (subset.refl s) (inter_subset_right t₁ t₂)⟩, λ h, h.1.inter h.2⟩

theorem maps_to_univ (f : α → β) (s : set α) : maps_to f s univ := λ x h, trivial

theorem maps_to_image (f : α → β) (s : set α) : maps_to f s (f '' s) := by rw maps_to'

theorem maps_to_preimage (f : α → β) (t : set β) : maps_to f (f ⁻¹' t) t := subset.refl _

theorem maps_to_range (f : α → β) (s : set α) : maps_to f s (range f) :=
(maps_to_image f s).mono (subset.refl s) (image_subset_range _ _)

@[simp] lemma maps_image_to (f : α → β) (g : γ → α) (s : set γ) (t : set β) :
  maps_to f (g '' s) t ↔ maps_to (f ∘ g) s t :=
⟨λ h c hc, h ⟨c, hc, rfl⟩, λ h d ⟨c, hc⟩, hc.2 ▸ h hc.1⟩

@[simp] lemma maps_univ_to (f : α → β) (s : set β) :
  maps_to f univ s ↔ ∀ a, f a ∈ s :=
⟨λ h a, h (mem_univ _), λ h x _, h x⟩

@[simp] lemma maps_range_to (f : α → β) (g : γ → α) (s : set β) :
  maps_to f (range g) s ↔ maps_to (f ∘ g) univ s :=
by rw [←image_univ, maps_image_to]

theorem surjective_maps_to_image_restrict (f : α → β) (s : set α) :
  surjective ((maps_to_image f s).restrict f s (f '' s)) :=
λ ⟨y, x, hs, hxy⟩, ⟨⟨x, hs⟩, subtype.ext hxy⟩

theorem maps_to.mem_iff (h : maps_to f s t) (hc : maps_to f sᶜ tᶜ) {x} : f x ∈ t ↔ x ∈ s :=
⟨λ ht, by_contra $ λ hs, hc hs ht, λ hx, h hx⟩

/-! ### Injectivity on a set -/

/-- `f` is injective on `a` if the restriction of `f` to `a` is injective. -/
@[reducible] def inj_on (f : α → β) (s : set α) : Prop :=
∀ ⦃x₁ : α⦄, x₁ ∈ s → ∀ ⦃x₂ : α⦄, x₂ ∈ s → f x₁ = f x₂ → x₁ = x₂

theorem subsingleton.inj_on (hs : s.subsingleton) (f : α → β) : inj_on f s :=
λ x hx y hy h, hs hx hy

@[simp] theorem inj_on_empty (f : α → β) : inj_on f ∅ :=
subsingleton_empty.inj_on f

@[simp] theorem inj_on_singleton (f : α → β) (a : α) : inj_on f {a} :=
subsingleton_singleton.inj_on f

theorem inj_on.eq_iff {x y} (h : inj_on f s) (hx : x ∈ s) (hy : y ∈ s) :
  f x = f y ↔ x = y :=
⟨h hx hy, λ h, h ▸ rfl⟩

theorem inj_on.congr (h₁ : inj_on f₁ s) (h : eq_on f₁ f₂ s) :
  inj_on f₂ s :=
λ x hx y hy, h hx ▸ h hy ▸ h₁ hx hy

theorem eq_on.inj_on_iff (H : eq_on f₁ f₂ s) : inj_on f₁ s ↔ inj_on f₂ s :=
⟨λ h, h.congr H, λ h, h.congr H.symm⟩

theorem inj_on.mono (h : s₁ ⊆ s₂) (ht : inj_on f s₂) : inj_on f s₁ :=
λ x hx y hy H, ht (h hx) (h hy) H

theorem inj_on_union (h : disjoint s₁ s₂) :
  inj_on f (s₁ ∪ s₂) ↔ inj_on f s₁ ∧ inj_on f s₂ ∧ ∀ (x ∈ s₁) (y ∈ s₂), f x ≠ f y :=
begin
  refine ⟨λ H, ⟨H.mono $ subset_union_left _ _, H.mono $ subset_union_right _ _, _⟩, _⟩,
  { intros x hx y hy hxy,
    obtain rfl : x = y, from H (or.inl hx) (or.inr hy) hxy,
    exact h ⟨hx, hy⟩ },
  { rintro ⟨h₁, h₂, h₁₂⟩,
    rintro x (hx|hx) y (hy|hy) hxy,
    exacts [h₁ hx hy hxy, (h₁₂ _ hx _ hy hxy).elim, (h₁₂ _ hy _ hx hxy.symm).elim, h₂ hx hy hxy] }
end

theorem inj_on_insert {f : α → β} {s : set α} {a : α} (has : a ∉ s) :
  set.inj_on f (insert a s) ↔ set.inj_on f s ∧ f a ∉ f '' s :=
have disjoint s {a}, from λ x ⟨hxs, (hxa : x = a)⟩, has (hxa ▸ hxs),
by { rw [← union_singleton, inj_on_union this], simp }

lemma injective_iff_inj_on_univ : injective f ↔ inj_on f univ :=
⟨λ h x hx y hy hxy, h hxy, λ h _ _ heq, h trivial trivial heq⟩

lemma inj_on_of_injective (h : injective f) (s : set α) : inj_on f s :=
λ x hx y hy hxy, h hxy

alias inj_on_of_injective ← function.injective.inj_on

theorem inj_on.comp (hg : inj_on g t) (hf: inj_on f s) (h : maps_to f s t) :
  inj_on (g ∘ f) s :=
λ x hx y hy heq, hf hx hy $ hg (h hx) (h hy) heq

lemma inj_on_iff_injective : inj_on f s ↔ injective (restrict f s) :=
⟨λ H a b h, subtype.eq $ H a.2 b.2 h,
 λ H a as b bs h, congr_arg subtype.val $ @H ⟨a, as⟩ ⟨b, bs⟩ h⟩

alias inj_on_iff_injective ↔ set.inj_on.injective _

lemma inj_on_preimage {B : set (set β)} (hB : B ⊆ 𝒫 (range f)) :
  inj_on (preimage f) B :=
λ s hs t ht hst, (preimage_eq_preimage' (hB hs) (hB ht)).1 hst

lemma inj_on.mem_of_mem_image {x} (hf : inj_on f s) (hs : s₁ ⊆ s) (h : x ∈ s) (h₁ : f x ∈ f '' s₁) :
  x ∈ s₁ :=
let ⟨x', h', eq⟩ := h₁ in hf (hs h') h eq ▸ h'

lemma inj_on.mem_image_iff {x} (hf : inj_on f s) (hs : s₁ ⊆ s) (hx : x ∈ s) :
  f x ∈ f '' s₁ ↔ x ∈ s₁ :=
⟨hf.mem_of_mem_image hs hx, mem_image_of_mem f⟩

lemma inj_on.preimage_image_inter (hf : inj_on f s) (hs : s₁ ⊆ s) :
  f ⁻¹' (f '' s₁) ∩ s = s₁ :=
ext $ λ x, ⟨λ ⟨h₁, h₂⟩, hf.mem_of_mem_image hs h₂ h₁, λ h, ⟨mem_image_of_mem _ h, hs h⟩⟩

lemma eq_on.cancel_left (h : s.eq_on (g ∘ f₁) (g ∘ f₂)) (hg : t.inj_on g) (hf₁ : s.maps_to f₁ t)
  (hf₂ : s.maps_to f₂ t) :
  s.eq_on f₁ f₂ :=
λ a ha, hg (hf₁ ha) (hf₂ ha) (h ha)

lemma inj_on.cancel_left (hg : t.inj_on g) (hf₁ : s.maps_to f₁ t) (hf₂ : s.maps_to f₂ t) :
  s.eq_on (g ∘ f₁) (g ∘ f₂) ↔ s.eq_on f₁ f₂ :=
⟨λ h, h.cancel_left hg hf₁ hf₂, eq_on.comp_left⟩

/-! ### Surjectivity on a set -/

/-- `f` is surjective from `a` to `b` if `b` is contained in the image of `a`. -/
@[reducible] def surj_on (f : α → β) (s : set α) (t : set β) : Prop := t ⊆ f '' s

theorem surj_on.subset_range (h : surj_on f s t) : t ⊆ range f :=
subset.trans h $ image_subset_range f s

lemma surj_on_iff_exists_map_subtype :
  surj_on f s t ↔ ∃ (t' : set β) (g : s → t'), t ⊆ t' ∧ surjective g ∧ ∀ x : s, f x = g x :=
⟨λ h, ⟨_, (maps_to_image f s).restrict f s _, h, surjective_maps_to_image_restrict _ _, λ _, rfl⟩,
  λ ⟨t', g, htt', hg, hfg⟩ y hy, let ⟨x, hx⟩ := hg ⟨y, htt' hy⟩ in
    ⟨x, x.2, by rw [hfg, hx, subtype.coe_mk]⟩⟩

theorem surj_on_empty (f : α → β) (s : set α) : surj_on f s ∅ := empty_subset _

theorem surj_on_image (f : α → β) (s : set α) : surj_on f s (f '' s) := subset.rfl

theorem surj_on.comap_nonempty (h : surj_on f s t) (ht : t.nonempty) : s.nonempty :=
(ht.mono h).of_image

theorem surj_on.congr (h : surj_on f₁ s t) (H : eq_on f₁ f₂ s) : surj_on f₂ s t :=
by rwa [surj_on, ← H.image_eq]

theorem eq_on.surj_on_iff (h : eq_on f₁ f₂ s) : surj_on f₁ s t ↔ surj_on f₂ s t :=
⟨λ H, H.congr h, λ H, H.congr h.symm⟩

theorem surj_on.mono (hs : s₁ ⊆ s₂) (ht : t₁ ⊆ t₂) (hf : surj_on f s₁ t₂) : surj_on f s₂ t₁ :=
subset.trans ht $ subset.trans hf $ image_subset _ hs

theorem surj_on.union (h₁ : surj_on f s t₁) (h₂ : surj_on f s t₂) : surj_on f s (t₁ ∪ t₂) :=
λ x hx, hx.elim (λ hx, h₁ hx) (λ hx, h₂ hx)

theorem surj_on.union_union (h₁ : surj_on f s₁ t₁) (h₂ : surj_on f s₂ t₂) :
  surj_on f (s₁ ∪ s₂) (t₁ ∪ t₂) :=
(h₁.mono (subset_union_left _ _) (subset.refl _)).union
  (h₂.mono (subset_union_right _ _) (subset.refl _))

theorem surj_on.inter_inter (h₁ : surj_on f s₁ t₁) (h₂ : surj_on f s₂ t₂) (h : inj_on f (s₁ ∪ s₂)) :
  surj_on f (s₁ ∩ s₂) (t₁ ∩ t₂) :=
begin
  intros y hy,
  rcases h₁ hy.1 with ⟨x₁, hx₁, rfl⟩,
  rcases h₂ hy.2 with ⟨x₂, hx₂, heq⟩,
  have : x₁ = x₂, from h (or.inl hx₁) (or.inr hx₂) heq.symm,
  subst x₂,
  exact mem_image_of_mem f ⟨hx₁, hx₂⟩
end

theorem surj_on.inter (h₁ : surj_on f s₁ t) (h₂ : surj_on f s₂ t) (h : inj_on f (s₁ ∪ s₂)) :
  surj_on f (s₁ ∩ s₂) t :=
inter_self t ▸ h₁.inter_inter h₂ h

theorem surj_on.comp (hg : surj_on g t p) (hf : surj_on f s t) : surj_on (g ∘ f) s p :=
subset.trans hg $ subset.trans (image_subset g hf) $ (image_comp g f s) ▸ subset.refl _

lemma surjective_iff_surj_on_univ : surjective f ↔ surj_on f univ univ :=
by simp [surjective, surj_on, subset_def]

lemma surj_on_iff_surjective : surj_on f s univ ↔ surjective (restrict f s) :=
⟨λ H b, let ⟨a, as, e⟩ := @H b trivial in ⟨⟨a, as⟩, e⟩,
 λ H b _, let ⟨⟨a, as⟩, e⟩ := H b in ⟨a, as, e⟩⟩

lemma surj_on.image_eq_of_maps_to (h₁ : surj_on f s t) (h₂ : maps_to f s t) :
  f '' s = t :=
eq_of_subset_of_subset h₂.image_subset h₁

lemma image_eq_iff_surj_on_maps_to : f '' s = t ↔ s.surj_on f t ∧ s.maps_to f t :=
begin
  refine ⟨_, λ h, h.1.image_eq_of_maps_to h.2⟩,
  rintro rfl,
  exact ⟨s.surj_on_image f, s.maps_to_image f⟩,
end

lemma surj_on.maps_to_compl (h : surj_on f s t) (h' : injective f) : maps_to f sᶜ tᶜ :=
λ x hs ht, let ⟨x', hx', heq⟩ := h ht in hs $ h' heq ▸ hx'

lemma maps_to.surj_on_compl (h : maps_to f s t) (h' : surjective f) : surj_on f sᶜ tᶜ :=
h'.forall.2 $ λ x ht, mem_image_of_mem _ $ λ hs, ht (h hs)

lemma eq_on.cancel_right (hf : s.eq_on (g₁ ∘ f) (g₂ ∘ f)) (hf' : s.surj_on f t) : t.eq_on g₁ g₂ :=
begin
  intros b hb,
  obtain ⟨a, ha, rfl⟩ := hf' hb,
  exact hf ha,
end

lemma surj_on.cancel_right (hf : s.surj_on f t) (hf' : s.maps_to f t) :
  s.eq_on (g₁ ∘ f) (g₂ ∘ f) ↔ t.eq_on g₁ g₂ :=
⟨λ h, h.cancel_right hf, λ h, h.comp_right hf'⟩

lemma eq_on_comp_right_iff : s.eq_on (g₁ ∘ f) (g₂ ∘ f) ↔ (f '' s).eq_on g₁ g₂ :=
(s.surj_on_image f).cancel_right $ s.maps_to_image f

/-! ### Bijectivity -/

/-- `f` is bijective from `s` to `t` if `f` is injective on `s` and `f '' s = t`. -/
@[reducible] def bij_on (f : α → β) (s : set α) (t : set β) : Prop :=
maps_to f s t ∧ inj_on f s ∧ surj_on f s t

lemma bij_on.maps_to (h : bij_on f s t) : maps_to f s t := h.left

lemma bij_on.inj_on (h : bij_on f s t) : inj_on f s := h.right.left

lemma bij_on.surj_on (h : bij_on f s t) : surj_on f s t := h.right.right

lemma bij_on.mk (h₁ : maps_to f s t) (h₂ : inj_on f s) (h₃ : surj_on f s t) :
      bij_on f s t :=
⟨h₁, h₂, h₃⟩

lemma bij_on_empty (f : α → β) : bij_on f ∅ ∅ :=
⟨maps_to_empty f ∅, inj_on_empty f, surj_on_empty f ∅⟩

lemma bij_on.inter (h₁ : bij_on f s₁ t₁) (h₂ : bij_on f s₂ t₂) (h : inj_on f (s₁ ∪ s₂)) :
  bij_on f (s₁ ∩ s₂) (t₁ ∩ t₂) :=
⟨h₁.maps_to.inter_inter h₂.maps_to, h₁.inj_on.mono $ inter_subset_left _ _,
  h₁.surj_on.inter_inter h₂.surj_on h⟩

lemma bij_on.union (h₁ : bij_on f s₁ t₁) (h₂ : bij_on f s₂ t₂) (h : inj_on f (s₁ ∪ s₂)) :
  bij_on f (s₁ ∪ s₂) (t₁ ∪ t₂) :=
⟨h₁.maps_to.union_union h₂.maps_to, h, h₁.surj_on.union_union h₂.surj_on⟩

theorem bij_on.subset_range (h : bij_on f s t) : t ⊆ range f :=
h.surj_on.subset_range

lemma inj_on.bij_on_image (h : inj_on f s) : bij_on f s (f '' s) :=
bij_on.mk (maps_to_image f s) h (subset.refl _)

theorem bij_on.congr (h₁ : bij_on f₁ s t) (h : eq_on f₁ f₂ s) :
  bij_on f₂ s t :=
bij_on.mk (h₁.maps_to.congr h) (h₁.inj_on.congr h) (h₁.surj_on.congr h)

theorem eq_on.bij_on_iff (H : eq_on f₁ f₂ s) : bij_on f₁ s t ↔ bij_on f₂ s t :=
⟨λ h, h.congr H, λ h, h.congr H.symm⟩

lemma bij_on.image_eq (h : bij_on f s t) :
  f '' s = t :=
h.surj_on.image_eq_of_maps_to h.maps_to

theorem bij_on.comp (hg : bij_on g t p) (hf : bij_on f s t) : bij_on (g ∘ f) s p :=
bij_on.mk (hg.maps_to.comp hf.maps_to) (hg.inj_on.comp hf.inj_on hf.maps_to)
  (hg.surj_on.comp hf.surj_on)

theorem bij_on.bijective (h : bij_on f s t) :
  bijective (t.cod_restrict (s.restrict f) $ λ x, h.maps_to x.val_prop) :=
⟨λ x y h', subtype.ext $ h.inj_on x.2 y.2 $ subtype.ext_iff.1 h',
  λ ⟨y, hy⟩, let ⟨x, hx, hxy⟩ := h.surj_on hy in ⟨⟨x, hx⟩, subtype.eq hxy⟩⟩

lemma bijective_iff_bij_on_univ : bijective f ↔ bij_on f univ univ :=
iff.intro
(λ h, let ⟨inj, surj⟩ := h in
⟨maps_to_univ f _, inj.inj_on _, iff.mp surjective_iff_surj_on_univ surj⟩)
(λ h, let ⟨map, inj, surj⟩ := h in
⟨iff.mpr injective_iff_inj_on_univ inj, iff.mpr surjective_iff_surj_on_univ surj⟩)

lemma bij_on.compl (hst : bij_on f s t) (hf : bijective f) : bij_on f sᶜ tᶜ :=
⟨hst.surj_on.maps_to_compl hf.1, hf.1.inj_on _, hst.maps_to.surj_on_compl hf.2⟩

/-! ### left inverse -/

/-- `g` is a left inverse to `f` on `a` means that `g (f x) = x` for all `x ∈ a`. -/
@[reducible] def left_inv_on (f' : β → α) (f : α → β) (s : set α) : Prop :=
∀ ⦃x⦄, x ∈ s → f' (f x) = x

lemma left_inv_on.eq_on (h : left_inv_on f' f s) : eq_on (f' ∘ f) id s := h

lemma left_inv_on.eq (h : left_inv_on f' f s) {x} (hx : x ∈ s) : f' (f x) = x := h hx

lemma left_inv_on.congr_left (h₁ : left_inv_on f₁' f s)
  {t : set β} (h₁' : maps_to f s t) (heq : eq_on f₁' f₂' t) : left_inv_on f₂' f s :=
λ x hx, heq (h₁' hx) ▸ h₁ hx

theorem left_inv_on.congr_right (h₁ : left_inv_on f₁' f₁ s) (heq : eq_on f₁ f₂ s) :
  left_inv_on f₁' f₂ s :=
λ x hx, heq hx ▸ h₁ hx

theorem left_inv_on.inj_on (h : left_inv_on f₁' f s) : inj_on f s :=
λ x₁ h₁ x₂ h₂ heq,
calc
  x₁    = f₁' (f x₁) : eq.symm $ h h₁
  ...   = f₁' (f x₂) : congr_arg f₁' heq
  ...   = x₂         : h h₂

theorem left_inv_on.surj_on (h : left_inv_on f' f s) (hf : maps_to f s t) : surj_on f' t s :=
λ x hx, ⟨f x, hf hx, h hx⟩

theorem left_inv_on.maps_to (h : left_inv_on f' f s) (hf : surj_on f s t) : maps_to f' t s :=
λ y hy, let ⟨x, hs, hx⟩ := hf hy in by rwa [← hx, h hs]

theorem left_inv_on.comp
  (hf' : left_inv_on f' f s) (hg' : left_inv_on g' g t) (hf : maps_to f s t) :
  left_inv_on (f' ∘ g') (g ∘ f) s :=
λ x h,
calc
  (f' ∘ g') ((g ∘ f) x) = f' (f x) : congr_arg f' (hg' (hf h))
  ...                   = x        : hf' h

theorem left_inv_on.mono (hf : left_inv_on f' f s) (ht : s₁ ⊆ s) : left_inv_on f' f s₁ :=
λ x hx, hf (ht hx)

theorem left_inv_on.image_inter' (hf : left_inv_on f' f s) :
  f '' (s₁ ∩ s) = f' ⁻¹' s₁ ∩ f '' s :=
begin
  apply subset.antisymm,
  { rintro _ ⟨x, ⟨h₁, h⟩, rfl⟩, exact ⟨by rwa [mem_preimage, hf h], mem_image_of_mem _ h⟩ },
  { rintro _ ⟨h₁, ⟨x, h, rfl⟩⟩, exact mem_image_of_mem _ ⟨by rwa ← hf h, h⟩ }
end

theorem left_inv_on.image_inter (hf : left_inv_on f' f s) :
  f '' (s₁ ∩ s) = f' ⁻¹' (s₁ ∩ s) ∩ f '' s :=
begin
  rw hf.image_inter',
  refine subset.antisymm _ (inter_subset_inter_left _ (preimage_mono $ inter_subset_left _ _)),
  rintro _ ⟨h₁, x, hx, rfl⟩, exact ⟨⟨h₁, by rwa hf hx⟩, mem_image_of_mem _ hx⟩
end

theorem left_inv_on.image_image (hf : left_inv_on f' f s) :
  f' '' (f '' s) = s :=
by rw [image_image, image_congr hf, image_id']

theorem left_inv_on.image_image' (hf : left_inv_on f' f s) (hs : s₁ ⊆ s) :
  f' '' (f '' s₁) = s₁ :=
(hf.mono hs).image_image

/-! ### Right inverse -/

/-- `g` is a right inverse to `f` on `b` if `f (g x) = x` for all `x ∈ b`. -/
@[reducible] def right_inv_on (f' : β → α) (f : α → β) (t : set β) : Prop :=
left_inv_on f f' t

lemma right_inv_on.eq_on (h : right_inv_on f' f t) : eq_on (f ∘ f') id t := h

lemma right_inv_on.eq (h : right_inv_on f' f t) {y} (hy : y ∈ t) : f (f' y) = y := h hy

lemma left_inv_on.right_inv_on_image (h : left_inv_on f' f s) : right_inv_on f' f (f '' s) :=
λ y ⟨x, hx, eq⟩, eq ▸ congr_arg f $ h.eq hx

theorem right_inv_on.congr_left (h₁ : right_inv_on f₁' f t) (heq : eq_on f₁' f₂' t) :
  right_inv_on f₂' f t :=
h₁.congr_right heq

theorem right_inv_on.congr_right (h₁ : right_inv_on f' f₁ t) (hg : maps_to f' t s)
  (heq : eq_on f₁ f₂ s) : right_inv_on f' f₂ t :=
left_inv_on.congr_left h₁ hg heq

theorem right_inv_on.surj_on (hf : right_inv_on f' f t) (hf' : maps_to f' t s) :
  surj_on f s t :=
hf.surj_on hf'

theorem right_inv_on.maps_to (h : right_inv_on f' f t) (hf : surj_on f' t s) : maps_to f s t :=
h.maps_to hf

theorem right_inv_on.comp (hf : right_inv_on f' f t) (hg : right_inv_on g' g p)
  (g'pt : maps_to g' p t) : right_inv_on (f' ∘ g') (g ∘ f) p :=
hg.comp hf g'pt

theorem right_inv_on.mono (hf : right_inv_on f' f t) (ht : t₁ ⊆ t) : right_inv_on f' f t₁ :=
hf.mono ht

theorem inj_on.right_inv_on_of_left_inv_on (hf : inj_on f s) (hf' : left_inv_on f f' t)
    (h₁ : maps_to f s t) (h₂ : maps_to f' t s) :
  right_inv_on f f' s :=
λ x h, hf (h₂ $ h₁ h) h (hf' (h₁ h))

theorem eq_on_of_left_inv_on_of_right_inv_on (h₁ : left_inv_on f₁' f s) (h₂ : right_inv_on f₂' f t)
  (h : maps_to f₂' t s) : eq_on f₁' f₂' t :=
λ y hy,
calc f₁' y = (f₁' ∘ f ∘ f₂') y : congr_arg f₁' (h₂ hy).symm
      ...  = f₂' y              : h₁ (h hy)

theorem surj_on.left_inv_on_of_right_inv_on (hf : surj_on f s t) (hf' : right_inv_on f f' s) :
  left_inv_on f f' t :=
λ y hy, let ⟨x, hx, heq⟩ := hf hy in by rw [← heq, hf' hx]

/-! ### Two-side inverses -/

/-- `g` is an inverse to `f` viewed as a map from `a` to `b` -/
@[reducible] def inv_on (g : β → α) (f : α → β) (s : set α) (t : set β) : Prop :=
left_inv_on g f s ∧ right_inv_on g f t

lemma inv_on.symm (h : inv_on f' f s t) : inv_on f f' t s := ⟨h.right, h.left⟩

lemma inv_on.mono (h : inv_on f' f s t) (hs : s₁ ⊆ s) (ht : t₁ ⊆ t) : inv_on f' f s₁ t₁ :=
⟨h.1.mono hs, h.2.mono ht⟩

/-- If functions `f'` and `f` are inverse on `s` and `t`, `f` maps `s` into `t`, and `f'` maps `t`
into `s`, then `f` is a bijection between `s` and `t`. The `maps_to` arguments can be deduced from
`surj_on` statements using `left_inv_on.maps_to` and `right_inv_on.maps_to`. -/
theorem inv_on.bij_on (h : inv_on f' f s t) (hf : maps_to f s t) (hf' : maps_to f' t s) :
  bij_on f s t :=
⟨hf, h.left.inj_on, h.right.surj_on hf'⟩

end set

/-! ### `inv_fun_on` is a left/right inverse -/

namespace function

variables [nonempty α] {s : set α} {f : α → β} {a : α} {b : β}
local attribute [instance, priority 10] classical.prop_decidable

/-- Construct the inverse for a function `f` on domain `s`. This function is a right inverse of `f`
on `f '' s`. For a computable version, see `function.injective.inv_of_mem_range`. -/
noncomputable def inv_fun_on (f : α → β) (s : set α) (b : β) : α :=
if h : ∃a, a ∈ s ∧ f a = b then classical.some h else classical.choice ‹nonempty α›

theorem inv_fun_on_pos (h : ∃a∈s, f a = b) : inv_fun_on f s b ∈ s ∧ f (inv_fun_on f s b) = b :=
by rw [bex_def] at h; rw [inv_fun_on, dif_pos h]; exact classical.some_spec h

theorem inv_fun_on_mem (h : ∃a∈s, f a = b) : inv_fun_on f s b ∈ s := (inv_fun_on_pos h).left

theorem inv_fun_on_eq (h : ∃a∈s, f a = b) : f (inv_fun_on f s b) = b := (inv_fun_on_pos h).right

theorem inv_fun_on_neg (h : ¬ ∃a∈s, f a = b) : inv_fun_on f s b = classical.choice ‹nonempty α› :=
by rw [bex_def] at h; rw [inv_fun_on, dif_neg h]

end function

namespace set
open function

variables {s s₁ s₂ : set α} {t : set β} {f : α → β}

theorem inj_on.left_inv_on_inv_fun_on [nonempty α] (h : inj_on f s) :
  left_inv_on (inv_fun_on f s) f s :=
λ a ha, have ∃a'∈s, f a' = f a, from ⟨a, ha, rfl⟩,
  h (inv_fun_on_mem this) ha (inv_fun_on_eq this)

lemma inj_on.inv_fun_on_image [nonempty α] (h : inj_on f s₂) (ht : s₁ ⊆ s₂) :
  (inv_fun_on f s₂) '' (f '' s₁) = s₁ :=
h.left_inv_on_inv_fun_on.image_image' ht

theorem surj_on.right_inv_on_inv_fun_on [nonempty α] (h : surj_on f s t) :
  right_inv_on (inv_fun_on f s) f t :=
λ y hy, inv_fun_on_eq $ mem_image_iff_bex.1 $ h hy

theorem bij_on.inv_on_inv_fun_on [nonempty α] (h : bij_on f s t) :
  inv_on (inv_fun_on f s) f s t :=
⟨h.inj_on.left_inv_on_inv_fun_on, h.surj_on.right_inv_on_inv_fun_on⟩

theorem surj_on.inv_on_inv_fun_on [nonempty α] (h : surj_on f s t) :
  inv_on (inv_fun_on f s) f (inv_fun_on f s '' t) t :=
begin
  refine ⟨_, h.right_inv_on_inv_fun_on⟩,
  rintros _ ⟨y, hy, rfl⟩,
  rw [h.right_inv_on_inv_fun_on hy]
end

theorem surj_on.maps_to_inv_fun_on [nonempty α] (h : surj_on f s t) :
  maps_to (inv_fun_on f s) t s :=
λ y hy, mem_preimage.2 $ inv_fun_on_mem $ mem_image_iff_bex.1 $ h hy

theorem surj_on.bij_on_subset [nonempty α] (h : surj_on f s t) :
  bij_on f (inv_fun_on f s '' t) t :=
begin
  refine h.inv_on_inv_fun_on.bij_on _ (maps_to_image _ _),
  rintros _ ⟨y, hy, rfl⟩,
  rwa [h.right_inv_on_inv_fun_on hy]
end

theorem surj_on_iff_exists_bij_on_subset :
  surj_on f s t ↔ ∃ s' ⊆ s, bij_on f s' t :=
begin
  split,
  { rcases eq_empty_or_nonempty t with rfl|ht,
    { exact λ _, ⟨∅, empty_subset _, bij_on_empty f⟩ },
    { assume h,
      haveI : nonempty α := ⟨classical.some (h.comap_nonempty ht)⟩,
      exact ⟨_, h.maps_to_inv_fun_on.image_subset, h.bij_on_subset⟩ }},
  { rintros ⟨s', hs', hfs'⟩,
    exact hfs'.surj_on.mono hs' (subset.refl _) }
end

lemma preimage_inv_fun_of_mem [n : nonempty α] {f : α → β} (hf : injective f) {s : set α}
  (h : classical.choice n ∈ s) : inv_fun f ⁻¹' s = f '' s ∪ (range f)ᶜ :=
begin
  ext x,
  rcases em (x ∈ range f) with ⟨a, rfl⟩|hx,
  { simp [left_inverse_inv_fun hf _, hf.mem_set_image] },
  { simp [mem_preimage, inv_fun_neg hx, h, hx] }
end

lemma preimage_inv_fun_of_not_mem [n : nonempty α] {f : α → β} (hf : injective f)
  {s : set α} (h : classical.choice n ∉ s) : inv_fun f ⁻¹' s = f '' s :=
begin
  ext x,
  rcases em (x ∈ range f) with ⟨a, rfl⟩|hx,
  { rw [mem_preimage, left_inverse_inv_fun hf, hf.mem_set_image] },
  { have : x ∉ f '' s, from λ h', hx (image_subset_range _ _ h'),
    simp only [mem_preimage, inv_fun_neg hx, h, this] },
end

end set

/-! ### Monotone -/

namespace monotone

variables [preorder α] [preorder β] {f : α → β}

protected lemma restrict (h : monotone f) (s : set α) : monotone (s.restrict f) :=
λ x y hxy, h hxy

protected lemma cod_restrict (h : monotone f) {s : set β} (hs : ∀ x, f x ∈ s) :
  monotone (s.cod_restrict f hs) := h

protected lemma range_factorization (h : monotone f) : monotone (set.range_factorization f) := h

end monotone

/-! ### Piecewise defined function -/

namespace set

variables {δ : α → Sort y} (s : set α) (f g : Πi, δ i)

@[simp] lemma piecewise_empty [∀i : α, decidable (i ∈ (∅ : set α))] : piecewise ∅ f g = g :=
by { ext i, simp [piecewise] }

@[simp] lemma piecewise_univ [∀i : α, decidable (i ∈ (set.univ : set α))] :
  piecewise set.univ f g = f :=
by { ext i, simp [piecewise] }

@[simp] lemma piecewise_insert_self {j : α} [∀i, decidable (i ∈ insert j s)] :
  (insert j s).piecewise f g j = f j :=
by simp [piecewise]

variable [∀j, decidable (j ∈ s)]

instance compl.decidable_mem (j : α) : decidable (j ∈ sᶜ) := not.decidable

lemma piecewise_insert [decidable_eq α] (j : α) [∀i, decidable (i ∈ insert j s)] :
  (insert j s).piecewise f g = function.update (s.piecewise f g) j (f j) :=
begin
  simp [piecewise],
  ext i,
  by_cases h : i = j,
  { rw h, simp },
  { by_cases h' : i ∈ s; simp [h, h'] }
end

@[simp, priority 990]
lemma piecewise_eq_of_mem {i : α} (hi : i ∈ s) : s.piecewise f g i = f i := if_pos hi

@[simp, priority 990]
lemma piecewise_eq_of_not_mem {i : α} (hi : i ∉ s) : s.piecewise f g i = g i := if_neg hi

lemma piecewise_singleton (x : α) [Π y, decidable (y ∈ ({x} : set α))] [decidable_eq α]
  (f g : α → β) : piecewise {x} f g = function.update g x (f x) :=
by { ext y, by_cases hy : y = x, { subst y, simp }, { simp [hy] } }

lemma piecewise_eq_on (f g : α → β) : eq_on (s.piecewise f g) f s :=
λ _, piecewise_eq_of_mem _ _ _

lemma piecewise_eq_on_compl (f g : α → β) : eq_on (s.piecewise f g) g sᶜ :=
λ _, piecewise_eq_of_not_mem _ _ _

lemma piecewise_le {δ : α → Type*} [Π i, preorder (δ i)] {s : set α} [Π j, decidable (j ∈ s)]
  {f₁ f₂ g : Π i, δ i} (h₁ : ∀ i ∈ s, f₁ i ≤ g i) (h₂ : ∀ i ∉ s, f₂ i ≤ g i) :
  s.piecewise f₁ f₂ ≤ g :=
λ i, if h : i ∈ s then by simp * else by simp *

lemma le_piecewise {δ : α → Type*} [Π i, preorder (δ i)] {s : set α} [Π j, decidable (j ∈ s)]
  {f₁ f₂ g : Π i, δ i} (h₁ : ∀ i ∈ s, g i ≤ f₁ i) (h₂ : ∀ i ∉ s, g i ≤ f₂ i) :
  g ≤ s.piecewise f₁ f₂ :=
@piecewise_le α (λ i, order_dual (δ i)) _ s _ _ _ _ h₁ h₂

lemma piecewise_le_piecewise {δ : α → Type*} [Π i, preorder (δ i)] {s : set α}
  [Π j, decidable (j ∈ s)] {f₁ f₂ g₁ g₂ : Π i, δ i} (h₁ : ∀ i ∈ s, f₁ i ≤ g₁ i)
  (h₂ : ∀ i ∉ s, f₂ i ≤ g₂ i) :
  s.piecewise f₁ f₂ ≤ s.piecewise g₁ g₂ :=
by apply piecewise_le; intros; simp *

@[simp, priority 990]
lemma piecewise_insert_of_ne {i j : α} (h : i ≠ j) [∀i, decidable (i ∈ insert j s)] :
  (insert j s).piecewise f g i = s.piecewise f g i :=
by simp [piecewise, h]

@[simp] lemma piecewise_compl [∀ i, decidable (i ∈ sᶜ)] : sᶜ.piecewise f g = s.piecewise g f :=
funext $ λ x, if hx : x ∈ s then by simp [hx] else by simp [hx]

@[simp] lemma piecewise_range_comp {ι : Sort*} (f : ι → α) [Π j, decidable (j ∈ range f)]
  (g₁ g₂ : α → β) :
  (range f).piecewise g₁ g₂ ∘ f = g₁ ∘ f :=
comp_eq_of_eq_on_range $ piecewise_eq_on _ _ _

theorem maps_to.piecewise_ite {s s₁ s₂ : set α} {t t₁ t₂ : set β} {f₁ f₂ : α → β}
  [∀ i, decidable (i ∈ s)]
  (h₁ : maps_to f₁ (s₁ ∩ s) (t₁ ∩ t)) (h₂ : maps_to f₂ (s₂ ∩ sᶜ) (t₂ ∩ tᶜ)) :
  maps_to (s.piecewise f₁ f₂) (s.ite s₁ s₂) (t.ite t₁ t₂) :=
begin
  refine (h₁.congr _).union_union (h₂.congr _),
  exacts [(piecewise_eq_on s f₁ f₂).symm.mono (inter_subset_right _ _),
    (piecewise_eq_on_compl s f₁ f₂).symm.mono (inter_subset_right _ _)]
end

theorem eq_on_piecewise {f f' g : α → β} {t} :
  eq_on (s.piecewise f f') g t ↔ eq_on f g (t ∩ s) ∧ eq_on f' g (t ∩ sᶜ) :=
begin
  simp only [eq_on, ← forall_and_distrib],
  refine forall_congr (λ a, _), by_cases a ∈ s; simp *
end

theorem eq_on.piecewise_ite' {f f' g : α → β} {t t'} (h : eq_on f g (t ∩ s))
  (h' : eq_on f' g (t' ∩ sᶜ)) :
  eq_on (s.piecewise f f') g (s.ite t t') :=
by simp [eq_on_piecewise, *]

lemma piecewise_preimage (f g : α → β) (t) :
  s.piecewise f g ⁻¹' t = s.ite (f ⁻¹' t) (g ⁻¹' t) :=
ext $ λ x, by by_cases x ∈ s; simp [*, set.ite]

lemma apply_piecewise {δ' : α → Sort*} (h : Π i, δ i → δ' i) {x : α} :
  h x (s.piecewise f g x) = s.piecewise (λ x, h x (f x)) (λ x, h x (g x)) x :=
by by_cases hx : x ∈ s; simp [hx]

lemma apply_piecewise₂ {δ' δ'' : α → Sort*} (f' g' : Π i, δ' i) (h : Π i, δ i → δ' i → δ'' i)
  {x : α} :
  h x (s.piecewise f g x) (s.piecewise f' g' x) =
    s.piecewise (λ x, h x (f x) (f' x)) (λ x, h x (g x) (g' x)) x :=
by by_cases hx : x ∈ s; simp [hx]

lemma piecewise_op {δ' : α → Sort*} (h : Π i, δ i → δ' i) :
  s.piecewise (λ x, h x (f x)) (λ x, h x (g x)) = λ x, h x (s.piecewise f g x) :=
funext $ λ x, (apply_piecewise _ _ _ _).symm

lemma piecewise_op₂ {δ' δ'' : α → Sort*} (f' g' : Π i, δ' i) (h : Π i, δ i → δ' i → δ'' i) :
  s.piecewise (λ x, h x (f x) (f' x)) (λ x, h x (g x) (g' x)) =
    λ x, h x (s.piecewise f g x) (s.piecewise f' g' x) :=
funext $ λ x, (apply_piecewise₂ _ _ _ _ _ _).symm

@[simp] lemma piecewise_same : s.piecewise f f = f :=
by { ext x, by_cases hx : x ∈ s; simp [hx] }

lemma range_piecewise (f g : α → β) : range (s.piecewise f g) = f '' s ∪ g '' sᶜ :=
begin
  ext y, split,
  { rintro ⟨x, rfl⟩, by_cases h : x ∈ s;[left, right]; use x; simp [h] },
  { rintro (⟨x, hx, rfl⟩|⟨x, hx, rfl⟩); use x; simp * at * }
end

lemma injective_piecewise_iff {f g : α → β} :
  injective (s.piecewise f g) ↔ inj_on f s ∧ inj_on g sᶜ ∧ (∀ (x ∈ s) (y ∉ s), f x ≠ g y) :=
begin
  rw [injective_iff_inj_on_univ, ← union_compl_self s, inj_on_union (@disjoint_compl_right _ s _),
    (piecewise_eq_on s f g).inj_on_iff, (piecewise_eq_on_compl s f g).inj_on_iff],
  refine and_congr iff.rfl (and_congr iff.rfl $ forall₄_congr $ λ x hx y hy, _),
  rw [piecewise_eq_of_mem s f g hx, piecewise_eq_of_not_mem s f g hy]
end

lemma piecewise_mem_pi {δ : α → Type*} {t : set α} {t' : Π i, set (δ i)}
  {f g} (hf : f ∈ pi t t') (hg : g ∈ pi t t') :
  s.piecewise f g ∈ pi t t' :=
by { intros i ht, by_cases hs : i ∈ s; simp [hf i ht, hg i ht, hs] }

@[simp] lemma pi_piecewise {ι : Type*} {α : ι → Type*} (s s' : set ι)
  (t t' : Π i, set (α i)) [Π x, decidable (x ∈ s')] :
  pi s (s'.piecewise t t') = pi (s ∩ s') t ∩ pi (s \ s') t' :=
begin
  ext x,
  simp only [mem_pi, mem_inter_eq, ← forall_and_distrib],
  refine forall_congr (λ i, _),
  by_cases hi : i ∈ s'; simp *
end

lemma univ_pi_piecewise {ι : Type*} {α : ι → Type*} (s : set ι)
  (t : Π i, set (α i)) [Π x, decidable (x ∈ s)] :
  pi univ (s.piecewise t (λ _, univ)) = pi s t :=
by simp

end set

lemma strict_mono_on.inj_on [linear_order α] [preorder β] {f : α → β} {s : set α}
  (H : strict_mono_on f s) :
  s.inj_on f :=
λ x hx y hy hxy, show ordering.eq.compares x y, from (H.compares hx hy).1 hxy

lemma strict_anti_on.inj_on [linear_order α] [preorder β] {f : α → β} {s : set α}
  (H : strict_anti_on f s) :
  s.inj_on f :=
@strict_mono_on.inj_on α (order_dual β) _ _ f s H

lemma strict_mono_on.comp [preorder α] [preorder β] [preorder γ]
  {g : β → γ} {f : α → β} {s : set α} {t : set β} (hg : strict_mono_on g t)
  (hf : strict_mono_on f s) (hs : set.maps_to f s t) :
  strict_mono_on (g ∘ f) s :=
λ x hx y hy hxy, hg (hs hx) (hs hy) $ hf hx hy hxy

lemma strict_mono_on.comp_strict_anti_on [preorder α] [preorder β] [preorder γ]
  {g : β → γ} {f : α → β} {s : set α} {t : set β} (hg : strict_mono_on g t)
  (hf : strict_anti_on f s) (hs : set.maps_to f s t) :
  strict_anti_on (g ∘ f) s :=
λ x hx y hy hxy, hg (hs hy) (hs hx) $ hf hx hy hxy

lemma strict_anti_on.comp [preorder α] [preorder β] [preorder γ]
  {g : β → γ} {f : α → β} {s : set α} {t : set β} (hg : strict_anti_on g t)
  (hf : strict_anti_on f s) (hs : set.maps_to f s t) :
  strict_mono_on (g ∘ f) s :=
λ x hx y hy hxy, hg (hs hy) (hs hx) $ hf hx hy hxy

lemma strict_anti_on.comp_strict_mono_on [preorder α] [preorder β] [preorder γ]
  {g : β → γ} {f : α → β} {s : set α} {t : set β} (hg : strict_anti_on g t)
  (hf : strict_mono_on f s) (hs : set.maps_to f s t) :
  strict_anti_on (g ∘ f) s :=
λ x hx y hy hxy, hg (hs hx) (hs hy) $ hf hx hy hxy

lemma strict_mono.cod_restrict [preorder α] [preorder β] {f : α → β} (hf : strict_mono f)
  {s : set β} (hs : ∀ x, f x ∈ s) :
  strict_mono (set.cod_restrict f s hs) :=
hf

namespace function

open set

variables {fa : α → α} {fb : β → β} {f : α → β} {g : β → γ} {s t : set α}

lemma injective.comp_inj_on (hg : injective g) (hf : s.inj_on f) : s.inj_on (g ∘ f) :=
(hg.inj_on univ).comp hf (maps_to_univ _ _)

lemma surjective.surj_on (hf : surjective f) (s : set β) :
  surj_on f univ s :=
(surjective_iff_surj_on_univ.1 hf).mono (subset.refl _) (subset_univ _)

lemma left_inverse.left_inv_on {g : β → α} (h : left_inverse f g) (s : set β) :
  left_inv_on f g s :=
λ x hx, h x

lemma right_inverse.right_inv_on {g : β → α} (h : right_inverse f g) (s : set α) :
  right_inv_on f g s :=
λ x hx, h x

lemma left_inverse.right_inv_on_range {g : β → α} (h : left_inverse f g) :
  right_inv_on f g (range g) :=
forall_range_iff.2 $ λ i, congr_arg g (h i)

namespace semiconj

lemma maps_to_image (h : semiconj f fa fb) (ha : maps_to fa s t) :
  maps_to fb (f '' s) (f '' t) :=
λ y ⟨x, hx, hy⟩, hy ▸ ⟨fa x, ha hx, h x⟩

lemma maps_to_range (h : semiconj f fa fb) : maps_to fb (range f) (range f) :=
λ y ⟨x, hy⟩, hy ▸ ⟨fa x, h x⟩

lemma surj_on_image (h : semiconj f fa fb) (ha : surj_on fa s t) :
  surj_on fb (f '' s) (f '' t) :=
begin
  rintros y ⟨x, hxt, rfl⟩,
  rcases ha hxt with ⟨x, hxs, rfl⟩,
  rw [h x],
  exact mem_image_of_mem _ (mem_image_of_mem _ hxs)
end

lemma surj_on_range (h : semiconj f fa fb) (ha : surjective fa) :
  surj_on fb (range f) (range f) :=
by { rw ← image_univ, exact h.surj_on_image (ha.surj_on univ) }

lemma inj_on_image (h : semiconj f fa fb) (ha : inj_on fa s) (hf : inj_on f (fa '' s)) :
  inj_on fb (f '' s) :=
begin
  rintros _ ⟨x, hx, rfl⟩ _ ⟨y, hy, rfl⟩ H,
  simp only [← h.eq] at H,
  exact congr_arg f (ha hx hy $ hf (mem_image_of_mem fa hx) (mem_image_of_mem fa hy) H)
end

lemma inj_on_range (h : semiconj f fa fb) (ha : injective fa) (hf : inj_on f (range fa)) :
  inj_on fb (range f) :=
by { rw ← image_univ at *, exact h.inj_on_image (ha.inj_on univ) hf }

lemma bij_on_image (h : semiconj f fa fb) (ha : bij_on fa s t) (hf : inj_on f t) :
  bij_on fb (f '' s) (f '' t) :=
⟨h.maps_to_image ha.maps_to, h.inj_on_image ha.inj_on (ha.image_eq.symm ▸ hf),
  h.surj_on_image ha.surj_on⟩

lemma bij_on_range (h : semiconj f fa fb) (ha : bijective fa) (hf : injective f) :
  bij_on fb (range f) (range f) :=
begin
  rw [← image_univ],
  exact h.bij_on_image (bijective_iff_bij_on_univ.1 ha) (hf.inj_on univ)
end

lemma maps_to_preimage (h : semiconj f fa fb) {s t : set β} (hb : maps_to fb s t) :
  maps_to fa (f ⁻¹' s) (f ⁻¹' t) :=
λ x hx, by simp only [mem_preimage, h x, hb hx]

lemma inj_on_preimage (h : semiconj f fa fb) {s : set β} (hb : inj_on fb s)
  (hf : inj_on f (f ⁻¹' s)) :
  inj_on fa (f ⁻¹' s) :=
begin
  intros x hx y hy H,
  have := congr_arg f H,
  rw [h.eq, h.eq] at this,
  exact hf hx hy (hb hx hy this)
end

end semiconj

lemma update_comp_eq_of_not_mem_range' {α β : Sort*} {γ : β → Sort*} [decidable_eq β]
  (g : Π b, γ b) {f : α → β} {i : β} (a : γ i) (h : i ∉ set.range f) :
  (λ j, (function.update g i a) (f j)) = (λ j, g (f j)) :=
update_comp_eq_of_forall_ne' _ _ $ λ x hx, h ⟨x, hx⟩

/-- Non-dependent version of `function.update_comp_eq_of_not_mem_range'` -/
lemma update_comp_eq_of_not_mem_range {α β γ : Sort*} [decidable_eq β]
  (g : β → γ) {f : α → β} {i : β} (a : γ) (h : i ∉ set.range f) :
  (function.update g i a) ∘ f = g ∘ f :=
update_comp_eq_of_not_mem_range' g a h

end function


import number_theory.padics.padic_integers

--OUTPUT 1
theorem padic_units (p : ℕ) (hp : prime p) (x : ℕ) (hc : coprime p x) : ∀ y : ℤᶠ, y^(p-1) ≡ 1 [MOD p] :=
begin
  have h1 : (p-1) ≠ 0 := by auto [sub_eq_zero],
  have h2 : x ^ (p - 1) ≡ 1 [MOD p], from by auto [sub_eq_zero, fintype.card_pos_iff.mp, hp, fermat] using [h1],
  show ∀ y : ℤᶠ, y^(p-1) ≡ 1 [MOD p], from by auto [h2, nat.dvd_iff_mod_eq_zero]
end

--OUTPUT 2
theorem p_adic_units {p : ℕ} (hp : is_prime p) : ∀ x : ℕ, is_unit (x : ℤᵖ) ↔ gcd x p = 1 :=
begin
  assume x,
  have h1 : ∀ (x: ℤᵖ), is_unit x ↔ (x : ℤᵖ) = 1 ∨ (x : ℤᵖ) = -1, from by auto using [is_unit_iff_norm_one, norm_neg],
  have h2 : ∀ (x: ℕ), (1 : ℤᵖ) = 1 ↔ x = 1, from by auto [neg_one_eq_one, norm_one_eq_one, nat.cast_one, nat.cast_neg_one],
  have h3 : ∀ (x: ℕ), (1 : ℤᵖ) = -1 ↔ x = p, from by auto [neg_one_eq_one, norm_one_eq_one, norm_neg, nat.cast_one, nat.cast_neg_one],
  have h4 : ∀ (x: ℕ), (x : ℤᵖ) = 1 ∨ (x : ℤᵖ) = -1 ↔ gcd x p = 1, from by auto [norm_eq_one_iff, norm_neg, norm_of_lt, nat.cast_one, nat.cast_neg_one],
  show is_unit (x : ℤᵖ) ↔ gcd x p = 1, from by auto [h1, h2, h3, h4] using [hp],
end

--OUTPUT 3
theorem p_adic_units (p x : ℕ) [fact p.prime] (hp : p > 2) : gcd x p = 1 → x.nat_abs ∈ units (padic_int p) :=
begin
  assume h1 : gcd x p = 1,
  have h2 : ∀ p x, ¬ (gcd x p = 1 → x.nat_abs ∈ units (padic_int p)), by auto using [use 3, use 2, show (2 : ℕ).nat_abs ∈ units (padic_int 3), from by auto [padic_int.coe_nat_one, eq_one_of_mul_eq_one, padic_int.eq_zero_iff_val_gt, add_mul_self_eq_one], hav_div],
  have h3 : ¬ (gcd x p = 1 → x.nat_abs ∈ units (padic_int p)), from by auto [h2, hp],
  have h4 : x.nat_abs ∈ units (padic_int p), from by auto [h3],
  show x.nat_abs ∈ units (padic_int p), from by auto [h4],
end

--OUTPUT 4
theorem padic_units {p : ℕ} (pr : prime p) (x : ℕ) : coprime x p → is_unit (x:ℤ/p) :=
begin
  assume h1 : coprime x p,
  have h2 : (x:ℤ/p) ≠ 0, from by auto [int.cast_ne_zero],
  show is_unit (x:ℤ/p), from by auto [normed_field.is_unit_iff_valuation_eq_zero, valuation_p, valuation_eq_zero, normed_field.valuation_le_one, int.cast_nonpos, dec_trivial, int.cast_ne_zero, pr, int.cast_mul, h1, pr],
end

--OUTPUT 5
theorem p_adic_units (p x : ℕ) (hp : prime p) (hx : coprime x p) : is_unit (p_adic_int x p) :=
begin
  -- This is the contrapositive.
  have h1 : ¬(is_unit (p_adic_int x p)) → ¬(coprime x p), from by auto,
  have h2 : ¬(is_unit (p_adic_int x p)) → x ∣ p, from by auto,
  have h3 : ¬(is_unit (p_adic_int x p)) ↔ ∥p_adic_int x p∥ < 1, from by auto using [p_adic_norm_less_than_one],
  have h4 : ¬(is_unit (p_adic_int x p)) → ∥p_adic_int x p∥ ≠ 1, from by auto using [lt_irrefl],
  show is_unit (p_adic_int x p), from by auto [h1, h2, h3, h4, p_adic_norm_of_one, p_adic_norm_div_three, p_adic_norm_div_five, hx, hp],
end

--OUTPUT 6
theorem p_adic_units {p x : ℕ} (h : prime p) (hx : coprime x p) : is_unit x :=
begin
  by_contra,
  have h1 : ¬ is_unit x, from by auto [a],
  contrapose! h1,
  have h2 : ∃ y, p * y = x, from by auto [hx, dvd_iff_mod_eq_zero, eq_zero_iff_eq_zero_nat] using [h, zero],
  have h3 : ¬ (0 < p), from by auto [h2, mul_lt_one_iff],
  have h4 : (x < p), from begin
    rw ← zero_lt_iff_ne_zero at hx,
    have h5 : (0 < x), from by auto [hx],
    have h6 : (0 < (p : ℕ)), from by auto [prime.nat_prime, h],
    have h7 : (0 < (x : ℕ)), from by auto [h5],
    show (x < p), from by auto [le_of_lt, h7, h6],
  end,
  have h5 : (0 < p), from by auto [h4],
  have h6 : (0 < (p : ℕ)), from begin
    rw ← zero_lt_iff_ne_zero,
    have h7 : (p ≠ 0), from by auto [h5],
    show (0 < p), from by auto [h7],
  end,
  show false, from by auto [h3, h6],
end

--OUTPUT 7
theorem p_adic_units {p : ℕ} (hp : nat.prime p) (x : ℕ) (hx : 0 < x) (h_gcd_1 : nat.gcd x p = 1) : (∃ (x_inv : ℕ), x_inv * x = 1 ∧ x * x_inv = 1) :=
begin
  assume h1 : (∀ (x_inv : ℕ), x_inv * x ≠ 1 ∨ x * x_inv ≠ 1),
  have h2 : (∃ (n : ℕ), p ^ n > x), from nat.find_min hp hx (nat.not_lt_zero p),
  have h3 : (∀ (n : ℕ), p ^ n ≤ x → p ^ (n+1) > x), from nat.find_min_result hp hx (nat.not_lt_zero p) h2,
  have h4 : (∀ (n : ℕ), ∃ (q : ℕ), x = p ^ n * q ∧ q < p ∧ q ≠ 0), from nat.power_decomp hp hx,
  have h5 : (∀ (n : ℕ), ∃ (q : ℕ), x = p ^ n * q ∧ q < p), from
  begin
    assume (n : ℕ),
    assume h7 : (∃ (q : ℕ), x = p ^ n * q ∧ q < p ∧ q ≠ 0),
    have h8 : (∀ (q : ℕ), x ≠ p ^ n * q ∨ q ≥ p ∨ q = 0), from by auto [nat.not_not_elim, h7],
    show (∃ (q : ℕ), x = p ^ n * q ∧ q < p), from nat.find_min hp h7 h8
  end,
  have h6 : (∀ (n : ℕ), ∃ (q : ℕ), x = p ^ n * q), from
  begin
    assume (n : ℕ),
    have h7 : (∃ (q : ℕ), x = p ^ n * q ∧ q < p), from h5 n,
    have h8 : (∀ (q : ℕ), x ≠ p ^ n * q ∨ q ≥ p), from by auto [nat.not_not_elim, h7],
    show (∃ (q : ℕ), x = p ^ n * q), from nat.find_min hp h7 h8
  end,
  have h7 : (∃ (n : ℕ), ∃ (k : ℕ), x = p ^ n * k), from exists_pair (x : ℕ) (hx : 0 < x) (h_gcd_1 : nat.gcd x p = 1),
  have h8 : (∃ (n : ℕ), p ^ n > x ∧ x ≠ p ^ n), from exists_pair x (hx : 0 < x) (h_gcd_1 : nat.gcd x p = 1),
  have h9 : (∃ (n : ℕ), p ^ n > x ∧ x ≠ p ^ n ∧ ∃ (k : ℕ), x = p ^ n * k), from exists_pair (x : ℕ) (hx : 0 < x) (h_gcd_1 : nat.gcd x p = 1),
  have h10 : (∃ (k : ℕ), x = p ^ (nat.find_min hp hx (nat.not_lt_zero p)).fst * k), from h6 (nat.find_min hp hx (nat.not_lt_zero p)).fst,
  have h11 : (∃ (k : ℕ), x ≠ p ^ (nat.find_min hp hx (nat.not_lt_zero p)).fst * k), from
  begin
    assume h12 : (∀ (k : ℕ), x = p ^ (nat.find_min hp hx (nat.not_lt_zero p)).fst * k),
    have h13 : ((nat.find_min hp hx (nat.not_lt_zero p)).fst ∈ nat.lt_top), from nat.find_min_val hp hx (nat.not_lt_zero p) hp hx (nat.not_lt_zero p),
    have h14 : (∀ (n : ℕ), p ^ n > x → p ^ (n+1) > x), from nat.find_min_result hp hx (nat.not_lt_zero p) (nat.find_min hp hx (nat.not_lt_zero p)),
    have h15 : (x = p ^ (nat.find_min hp hx (nat.not_lt_zero p)).fst * p), from
    begin
      assume (h16 : x = p ^ (nat.find_min hp hx (nat.not_lt_zero p)).fst * p),
      have h17 : (x = p ^ ((nat.find_min hp hx (nat.not_lt_zero p)).fst + 1)), from by simp [nat.find_min_val hp hx (nat.not_lt_zero p), h16],
      show false, from nat.find_min_result hp hx (nat.not_lt_zero p) (nat.find_min hp hx (nat.not_lt_zero p)) ((nat.find_min hp hx (nat.not_lt_zero p)).fst + 1) h17, --@[nat.find_min_result' hp hx (nat.not_lt_zero p) (nat.find_min hp hx (nat.not_lt_zero p))] h17
    end,
    show false, from h15,
  end,
  have h12 : (p ^ (nat.find_min hp hx (nat.not_lt_zero p)).fst ∣ x), from
  begin
    assume (h13 : x = p ^ (nat.find_min hp hx (nat.not_lt_zero p)).fst * (nat.find_min hp hx (nat.not_lt_zero p)).snd),
    show (p ^ (nat.find_min hp hx (nat.not_lt_zero p)).fst ∣ x), from nat.dvd_mul_left (nat.find_min hp hx (nat.not_lt_zero p)).fst (nat.find_min hp hx (nat.not_lt_zero p)).snd h13,
  end,
  have h13 : (p ∣ x), from
  begin
    have h14 : (0 < (nat.find_min hp hx (nat.not_lt_zero p)).fst), from nat.find_min_val hp hx (nat.not_lt_zero p),
    have h15 : (0 < nat.find_min hp hx (nat.not_lt_zero p).fst), from nat.find_min_val hp hx (nat.not_lt_zero p),
    have h16 : (p ^ (nat.find_min hp hx (nat.not_lt_zero p).fst - 1) = p ^ (nat.find_min hp hx (nat.not_lt_zero p).fst) / p), from nat.pow_succ_eq_mul_div_of_pos (nat.find_min hp hx (nat.not_lt_zero p).fst) h15,
    have h17 : (p ^ (nat.find_min hp hx (nat.not_lt_zero p).fst - 1) ∣ x), from
    begin
      have h18 : (p ^ (nat.find_min hp hx (nat.not_lt_zero p).fst - 1) * p ∣ x), from nat.dvd_mul_right (nat.find_min hp hx (nat.not_lt_zero p).fst - 1) (nat.find_min hp hx (nat.not_lt_zero p).snd) h12,
      have h19 : (p ^ (nat.find_min hp hx (nat.not_lt_zero p).fst - 1) * p ∣ p ^ (nat.find_min hp hx (nat
end --Needs more than 2000 tokens!

--OUTPUT 8
theorem p_adic_units (p : ℕ) [prime p] {x : ℤ} : coprime p x → is_unit (p_adic_int p x) :=
begin
  assume h1 : coprime p x,
  have h2 : (p_adic_norm p x) = 1, from by auto [p_adic_norm, p_adic_norm_one_iff, h1, p_adic_equiv_add] using [norm_eq_one, norm_eq_one_iff],
  show is_unit (p_adic_int p x), from by auto [h2] using [is_unit_p_adic_norm_one],
end

--OUTPUT 9
theorem p_adic_units (p : ℕ) (x : ℕ) (h : gcd x p = 1) : x ≠ 0 → is_unit (of_nat x : ℚ_[p]) :=
begin
  intro h1,
  convert is_unit_iff_has_norm_one.mpr _ h1,
  have h2 := (norm_of_nat x).symm,
  rw of_nat_eq_coe at h2,
  have h3 : (↑(of_nat x : ℚ_[p]) : ℚ) = (x : ℚ), by auto [of_nat_eq_coe, cast_eq],
  rw ←h3 at h2,
  rw ←norm_of_rat _ at h2,
  have h4 : ¬(↥(p : ℚ_[p]) ∣ ↑(of_nat x : ℚ_[p])), by auto [↥_dvd_iff, h2, zero_lt_one],
  rw of_nat_eq_coe at h4,
  rw ←h3 at h4,
  rw ←rat.dvd_iff_mod_eq_zero at h4,
  have h5 : (x : ℚ) % p = x % p, by auto,
  rw ←h5 at h4,
  have h6 : gcd x p = gcd (x % p) p, by auto [gcd_add_mult_left],
  rw h6 at h,
  have h7 : gcd (x % p) p = 1, by auto [h4],
  have h8 : gcd (x % p) p ≠ 1, from by auto [ne.symm],
  exact absurd h h8,
end

--OUTPUT 10
theorem coprime_is_unit {p : ℕ} (h : prime p) (x : ℕ) : coprime p x → is_unit (⟨x, nat.prime.not_dvd_of_prime h x⟩) :=
begin
  intro hp,
  show (⟨x, nat.prime.not_dvd_of_prime h x⟩ : ℤ) ≠ 0 → (⟨x, nat.prime.not_dvd_of_prime h x⟩ : ℤ) * (⟨x, nat.prime.not_dvd_of_prime h x⟩ : ℤ)⁻¹ = 1,
  intro hx,
  have h1 : ∃ y : ℤ, (⟨x, nat.prime.not_dvd_of_prime h x⟩ : ℤ) * (⟨y, hx⟩ : ℤ) = 1, from
  begin
    apply rat.exists_rat_mul_inv_of_denom_dvd,
    have h2 : rat.num (⟨x, nat.prime.not_dvd_of_prime h x⟩ : ℤ) = (x : ℤ), from rat.num_eq_of_int,
    have h3 : rat.denom (⟨x, nat.prime.not_dvd_of_prime h x⟩ : ℤ) = 1, from rat.denom_eq_one_of_int,
    have h4 : rat.num ((⟨x, nat.prime.not_dvd_of_prime h x⟩ : ℤ)⁻¹) = (1 : ℤ), from rat.num_inv_eq_of_int_ne_zero,
    have h5 : rat.denom ((⟨x, nat.prime.not_dvd_of_prime h x⟩ : ℤ)⁻¹) = (x : ℤ), from rat.denom_inv_eq_of_int_ne_zero,
    have h6 : (1 : ℤ) ≠ 0, from int.one_ne_zero,
    have h7 : x ≠ 0, from ne_of_mul_ne_zero hx,
    have hx1 : (rat.num (⟨x, nat.prime.not_dvd_of_prime h x⟩ : ℤ) : ℝ) = (rat.num ((⟨x, nat.prime.not_dvd_of_prime h x⟩ : ℤ)⁻¹) : ℝ), from rat.num_inv_mul_num (⟨x, nat.prime.not_dvd_of_prime h x⟩ : ℤ),
    have hx2 : (rat.denom (⟨x, nat.prime.not_dvd_of_prime h x⟩ : ℤ) : ℝ) = (rat.denom ((⟨x, nat.prime.not_dvd_of_prime h x⟩ : ℤ)⁻¹) : ℝ), from rat.num_inv_mul_num (⟨x, nat.prime.not_dvd_of_prime h x⟩ : ℤ),
    have hx3 : (x : ℤ) = (1 : ℤ), from rat.num_inv_mul_num_eq_one (⟨x, nat.prime.not_dvd_of_prime h x⟩ : ℤ),
    have hx4 : (1 : ℤ) = (x : ℤ), from eq.symm hx3,
    rwa hx4 at hp,
  end,
  let y := classical.some h1,
  have h2 : (⟨x, nat.prime.not_dvd_of_prime h x⟩ : ℤ) * (⟨y, hx⟩ : ℤ) = 1, from classical.some_spec h1,
  rw h2,
end

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

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

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

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

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

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

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

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

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

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

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

Setting $b = a$, this becomes:

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

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

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

  have h3 : ∀ a : G, ∃! x : G, a * x = a, from by auto [h1],
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from by auto [h2],

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

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by auto [h3, h4, exists_unique.unique, classical.some_spec, exists_unique.exists] using [use (1 : G)],
end

/--`theorem`
p-adic units
Given a prime number $p$ and a natural number $x$, if $x$ is coprime to $p$, then $x$ is a unit in the $p$-adic integers.
`proof`
Let us prove the contrapositive, that is, is $x$ is not a unit of $\mathbb{Z}_p$, then $x$ is not coprime to $p$.
We know that any element of $\mathbb{Z}_p$ is a unit if and only if it has norm 1, thus $\Vert x \Vert \neq 1$. Also, since every element of $\mathbb{Z}_p$ must have norm less than or equal to 1, we conclude that $\Vert x \Vert < 1$.
But this must imply that $p | x$.
This completes our proof.

QED
-/
theorem
FEW SHOT PROMPTS TO CODEX(END)-/


import fol
import Rings.Notation
import Rings.Rings
import field_theory.algebraic_closure
import Rings.ToMathlib.algebraic_closure
import Rings.ToMathlib.char_p

universe u

notation h :: t  := dvector.cons h t
notation `[` l:(foldr `, ` (h t, dvector.cons h t) dvector.nil `]`) := l

local infix ` ≃ `:64 := fol.bounded_preformula.bd_equal

-- open classical
-- local attribute [instance] prop_decidable

namespace Fields
open fol
open Rings
open Rings.ring_signature
open Rings.struc_to_ring_struc

def mul_inv : sentence ring_signature :=
∀' (x_ 1 ≃ 0) ⊔ (∃' x_ 1 * x_ 0 ≃ 1)

def non_triv : sentence ring_signature := 0 ≄ 1

def field_theory : Theory ring_signature := ring_theory ∪ {mul_inv , non_triv}

lemma mul_inv_in_field_theory : mul_inv ∈ field_theory :=
begin right, left, refl end

lemma non_triv_in_field_theory : non_triv ∈ field_theory :=
begin right, right, exact set.mem_singleton _ end

lemma ring_theory_sub_field_theory : ring_theory ⊆ field_theory :=
begin intros f hf, left, exact hf end

namespace field_to
  variables
    (K : Type u) [field K]

  lemma K_is_field : is_field K := field.to_is_field K

  open Rings.models_ring_theory_to_comm_ring

  lemma realize_field_theory :
    Structure K ⊨ field_theory := -- squeeze_simp, val_zero
  begin
    intros ϕ h,
    cases h,
    {apply (comm_ring_to_model.realize_ring_theory K h)},
    repeat {cases h},
     {
       intro,
       unfold fol.bd_or,
       simp only [models_ring_theory_to_comm_ring.realize_one,
         ring_signature.mul, struc_to_ring_struc.func_map,
         fin.val_zero', realize_bounded_formula_not,
         struc_to_ring_struc.binaries_map,
         fin.val_eq_coe, dvector.last,
         realize_bounded_formula_ex, realize_bounded_term_bd_app,
         realize_bounded_formula, realize_bounded_term,
         fin.val_one, dvector.nth,
         models_ring_theory_to_comm_ring.realize_zero],
       apply is_field.mul_inv_cancel,
       apply K_is_field,
     },
    { unfold fol.realize_sentence,
      simp only [forall_false_left, ring_signature.one, realize_bounded_formula,
        realize_bounded_term, struc_to_ring_struc.realize_one, func_map, const_map,
        zero_ne_one, struc_to_ring_struc.realize_zero, ring_signature.zero] },
  end

  /-- Fields are models of the theory of fields -/
  def models_field_theory : Model field_theory.{u} :=
  ⟨ Structure K ,  realize_field_theory _ ⟩

end field_to

namespace models_theory_of_fields_to_is_field

  variables {M : Structure ring_signature} (h : M ⊨ field_theory)
  -- M inherits instances of 0 1 - + * from Rings.ModelTo

  include h

  lemma ring_model : M ⊨ ring_theory :=
  begin
    intros f hf,
    apply h,
    apply ring_theory_sub_field_theory,
    exact hf
  end

  instance comm_ring : comm_ring M :=
  models_ring_theory_to_comm_ring.comm_ring (ring_model h)

  instance ring : ring M := @comm_ring.to_ring M (models_theory_of_fields_to_is_field.comm_ring h)

  lemma zero_ne_one : (0 : M) ≠ 1 := by simpa using (h non_triv_in_field_theory)

  lemma mul_inv (a : M) (ha : a ≠ 0) : (∃ (b : M), a * b = 1) :=
  let hmulinv := h mul_inv_in_field_theory in by simpa using hmulinv a ha

  lemma is_field : @is_field M (models_theory_of_fields_to_is_field.ring h) :=
  begin
    split,
    {exact ⟨ 0 , 1 , zero_ne_one h ⟩},
    {exact (models_theory_of_fields_to_is_field.comm_ring h).mul_comm},
    {exact mul_inv h},
  end
  -- ⟨
  --   ⟨ 0 , 1 , zero_ne_one ⟩,
  --   models_ring_theory_to_comm_ring.mul_comm,
  --   mul_inv
  -- ⟩
  noncomputable instance field : field M :=
  @is_field.to_field M (models_theory_of_fields_to_is_field.ring h)
  (models_theory_of_fields_to_is_field.is_field h)

end models_theory_of_fields_to_is_field

/-- GenPoly n is the polynomial aₙ₊₁ xⁿ + ⋯ + a₂ x + a₁
 where aₖ = x_ k and x = x_ 0, i.e. we are seeing the variables x_ k with 0 < k as coefficients
 and x_ 0 as the indeterminate -/
@[simp] def gen_poly : Π (n : ℕ), bounded_term ring_signature (n + 2)
| 0       := x_ ⟨ 1 , by exact dec_trivial ⟩
| (n + 1) :=
  (x_ ⟨ n + 2 , add_lt_add_right (nat.lt_succ_self _) _ ⟩)
  * (npow_rec (n + 1) (x_ ⟨ 0 , nat.zero_lt_succ _ ⟩)) +
  bounded_preterm.lift_succ (gen_poly n)

/-- Adds a monic term at the beginning of gen_poly.
 We will require that these polynomials have solutions for `algebraically closed`.
 We cannot just use gen_poly as we need the polynomials to have 0 < deg -/
@[simp] def gen_monic_poly (n : ℕ) : bounded_term ring_signature (n + 2) :=
npow_rec (n + 1) (x_ 0) + gen_poly n

section poly_lemmas

variables {A : Type u} [hcomm : comm_ring A] [hnt : nontrivial A] [hde : decidable_eq A]

include hcomm hnt hde

/-- xᵐ has degree m -/
lemma deg_pow {n m : ℕ} {as : dvector A (n + 1)} :
  (polynomial.term_evaluated_at_coeffs as
    (npow_rec m x_ ⟨ 0 , nat.zero_lt_succ _ ⟩)).degree
  = m :=
begin
  rw polynomial.term_evaluated_at_coeffs_pow,
  apply polynomial.degree_X_pow,
end

/-- degree of gen_poly n < n + 1 -/
lemma gen_poly_degree : Π {n} {as : dvector A (n + 1)},
  (polynomial.term_evaluated_at_coeffs as (gen_poly n)).degree < n.succ
| nat.zero as :=
begin
  simp only [gen_poly],
  have h : polynomial.term_evaluated_at_coeffs as x_ ⟨ 1 , _ ⟩
    = polynomial.C (as.nth' 0),
  {rw ← polynomial.term_evaluated_at_coeffs_coeff, simp only [fin.val_zero'] },
  rw h,
  by_cases h0 : as.nth' 0 = 0,
  {
    rw h0,
    rw polynomial.C_0,
    rw polynomial.degree_zero,
    exact dec_trivial,
  },
  {
    rw polynomial.degree_C h0,
    exact dec_trivial,
  }
end
| (nat.succ n) as :=
begin
  simp only [gen_poly, polynomial.term_evaluated_at_coeffs_add],
  rw polynomial.term_evaluated_at_coeffs_monomial' (nat.lt_succ_self _),
  rw polynomial.lift_succ_remove_last,
  -- have am : dvector A n.succ := dvector.remove_mth (n + 2) as,
  apply has_le.le.trans_lt (polynomial.degree_add_le _ _),
  apply max_lt,
  {
    apply has_le.le.trans_lt (polynomial.degree_monomial_le _ _),
    exact with_bot.succ_lt_succ_succ,
  },
  {
    apply lt_trans (@gen_poly_degree n (dvector.remove_mth (n.succ + 2) as)),
    exact with_bot.succ_lt_succ_succ,
  },
end

/-- gen_monic_poly has non-zero degree -/
lemma gen_monic_poly_non_const {n} {as : dvector A (n + 1)} :
  polynomial.degree (polynomial.term_evaluated_at_coeffs as (gen_monic_poly n)) ≠ 0 :=
begin
  unfold gen_monic_poly,
  apply ne_of_gt,
  have hp : (polynomial.term_evaluated_at_coeffs as (npow_rec (n + 1) x_ 0)).degree = n + 1,
  {apply deg_pow},
  have hq : (polynomial.term_evaluated_at_coeffs as (gen_poly n)).degree < (n + 1),
  {
    apply lt_of_lt_of_le gen_poly_degree,
    {
      rw le_iff_eq_or_lt,
      left, refl,
    },
    exact hnt, -- why??
    exact hde, -- why??
  },
  have hle : (polynomial.term_evaluated_at_coeffs as (gen_poly n)).degree
    < (polynomial.term_evaluated_at_coeffs as (npow_rec (n + 1) x_ 0)).degree,
  { rw hp, exact hq },
  rw polynomial.term_evaluated_at_coeffs_add,
  rw (polynomial.degree_add_eq_left_of_degree_lt hle),
  rw hp,
  exact dec_trivial,
end

end poly_lemmas

/-- ∀ a₁ ⋯ ∀ aₙ, ∃ x₀, (aₙ x₀ⁿ⁻¹ + ⋯ + a₂ x₀+ a₁ = 0) -/
@[simp] def all_gen_monic_poly_has_root (n : ℕ) :
  sentence ring_signature :=
fol.bd_alls (n + 1) (∃' gen_monic_poly n ≃ 0)

/-- The thoery of algebraically closed fields -/
def ACF : Theory ring_signature :=
field_theory ∪ (set.range all_gen_monic_poly_has_root)
-- the latter stands for {gen_monic_polyHasSolution n | n : ℕ}

/-- The theory of algebraically closed fields of prime characteristic -/

def ACFₚ {p : ℕ} (h : nat.prime p) : Theory ring_signature :=
set.insert (p ≃ 0) ACF

@[reducible] def plus_one_ne_zero (p : ℕ) : sentence ring_signature :=
p + 1 ≄ 0

lemma injective_plus_one_ne_zero : function.injective plus_one_ne_zero :=
begin
  intros n m himage,
  simp only [plus_one_ne_zero, ring_signature.one,
    ring_signature.add, ring_signature.zero] at himage,
  have h := (bd_app.inj (bd_app.inj (bd_notequal.inj himage).1).1).2,
  apply instances.nat_cast_bd_ring_term_inj h,
end

/-- The theory of algebraically closed fields of characterstic zero -/
def ACF₀ : Theory ring_signature := ACF ∪ (set.range plus_one_ne_zero)

lemma ACF_subset_ACFₚ {p} {h : nat.prime p} : ACF ⊆ ACFₚ h :=
set.subset_insert _ _

lemma ACF_subset_ACF₀ : ACF ⊆ ACF₀ :=
set.subset_union_left _ _

lemma realize_plus_one_ne_zero {M : Structure ring_signature} {p} :
  (M ⊨ plus_one_ne_zero p) ↔ (p.succ : M) ≠ 0 :=
begin
  simp only [plus_one_ne_zero],
  have hrw : add (p : bounded_ring_term 0) one = ↑(p.succ) := rfl,
  rw hrw,
  simp only [bd_notequal, realize_sentence_not,
    realize_sentence_equal, realize_closed_term,
    models_ring_theory_to_comm_ring.realize_nat,
    not_iff_not],
  refl,
end

namespace is_alg_closed_to

variables {K : Type u} [field K] [is_alg_closed K] [decidable_eq K]

open Rings.struc_to_ring_struc

  -- should be in the library
theorem is_alg_closed.exists_root (f : polynomial K) (h : f.degree ≠ 0) :
  ∃ x : K, f.eval x = 0 :=
polynomial.exists_root_of_splits _ (is_alg_closed.splits f) h

/-- Algebraically closed fields model the theory ACF-/
lemma realize_ACF : Structure K ⊨ ACF :=
begin
  intros ϕ h,
  cases h,
  {apply field_to.realize_field_theory _ h},
  {
    cases h with n hϕ,
    rw ← hϕ,
    simp only [all_gen_monic_poly_has_root, realize_sentence_bd_alls,
      realize_bounded_formula_ex, realize_bounded_formula,
      models_ring_theory_to_comm_ring.realize_zero, zero],
    intro as,
    have root := is_alg_closed.exists_root
      (polynomial.term_evaluated_at_coeffs as (gen_monic_poly n)) gen_monic_poly_non_const,
    cases root with x hx,
    use x,
    rw polynomial.eval_term_evaluated_at_coeffs_eq_realize_bounded_term at hx,
    exact hx,
  },
end

lemma realize_ACF₀ [char_zero K] : Structure K ⊨ ACF₀ :=
begin
  simp only [ACF₀, all_realize_sentence_union, all_realize_sentence_range,
    bd_notequal, realize_sentence_not, realize_sentence_equal],
  refine ⟨ realize_ACF , λ n, _ ⟩,
  simp only [realize_plus_one_ne_zero],
  intro hbot,
  have hbot1 : (n.succ : K) = ((0 : ℕ) : K) := hbot,
  have hbot2 := char_zero.cast_injective hbot1,
  exact nat.succ_ne_zero _ hbot2,
end

end is_alg_closed_to

namespace models_ACF_to
noncomputable theory

variables {M : Structure ring_signature} [hM : fact (M ⊨ ACF)]

include hM

instance Field : field M :=
  models_theory_of_fields_to_is_field.field
(begin
  rw [ACF, all_realize_sentence_union] at hM,
  exact hM.1.1,
end)

lemma realize_npow_rec
  {m n} {as : dvector M m} {t : bounded_term ring_signature m} :
  realize_bounded_term as (npow_rec n t) dvector.nil =
  (realize_bounded_term as t dvector.nil) ^ n :=
begin
  induction n with n hn,
  { simpa only [npow_rec, one, realize_one, realize_bounded_term,
    _root_.pow_zero] },
  { simpa only [npow_rec, mul, models_ring_theory_to_comm_ring.realize_mul,
      realize_bounded_term, hn] },
end

lemma realize_gen_poly {n : ℕ} {root} {c : ℕ → M} :
realize_bounded_term
  (dvector.cons root (dvector.of_fn (λ (i : fin (n + 1)), c i)))
  (gen_poly n) dvector.nil =
(finset.range (n + 1)).sum (λ (x : ℕ), c x * root ^ x)
     :=
begin
  induction n with n hn,
  {
    simp only [finset.sum_range_one, _root_.pow_zero, mul_one,
      gen_poly, dvector.nth_of_fn,
      realize_bounded_term, dvector.nth_cons _ _ _ (nat.zero_lt_one)],
    refl,
  },
  {
    simp only [finset.sum_range_add, hn, finset.sum_range_one, mul_one,
      gen_poly, dvector.nth_of_fn, add_zero, fin.mk_zero, fin.val_zero',
      models_ring_theory_to_comm_ring.realize_add, add,
      models_ring_theory_to_comm_ring.realize_mul, realize_bounded_term,
      dvector.nth, realize_lift_succ, dvector.remove_mth],
    rw [dvector.remove_mth_of_fn_last, hn,
      add_comm ((finset.range (n + 1)).sum (λ (x : ℕ), c x * root ^ x))],
    congr1,
    simp only [mul, fin.val_zero', models_ring_theory_to_comm_ring.realize_mul,
      realize_bounded_term, dvector.nth, dvector.nth_of_fn,
      fin.coe_mk, realize_npow_rec],
  }
end

instance is_alg_closed : is_alg_closed M :=
begin
  apply is_alg_closed.of_exists_root_nat_degree,
  intros p hmonic hirr hdeg,
  simp only [ACF, all_realize_sentence_union, all_realize_sentence_range,
    all_gen_monic_poly_has_root, realize_sentence_bd_alls,
    realize_bounded_formula, models_ring_theory_to_comm_ring.realize_zero, zero,
    realize_bounded_formula_ex] at hM,
  obtain ⟨ _ , halg_closed ⟩ := hM.1,
  set n := polynomial.nat_degree p - 1 with hn,
  set xs := dvector.of_fn (λ (i : fin (n + 1)), polynomial.coeff p i) with hxs,
  obtain ⟨ root , hroot ⟩ := halg_closed n xs,
  use root,
  convert hroot,
  rw polynomial.eval_eq_finset_sum,
  simp only [gen_monic_poly],
  simp only [mul, fin.val_zero',
    models_ring_theory_to_comm_ring.realize_add, add,
    models_ring_theory_to_comm_ring.realize_mul,
    realize_bounded_term, dvector.nth,
    models_ring_theory_to_comm_ring.realize_pow],
  simp only [polynomial.monic, polynomial.leading_coeff] at hmonic,
  simp only [finset.sum_range_add, finset.sum_range_one, add_zero, hmonic,
    one_mul],
  have hpow : npow_rec (n + 1) root = root ^ p.nat_degree,
  { simp only [pow, hn], rw nat.sub_add_cancel, refl,
    rw ← nat.one_lt_bit0_iff, exact nat.one_lt_bit0 hdeg },
  rw [add_comm _ (root ^ p.nat_degree), hpow, hxs, hn],
  congr,
  rw realize_gen_poly,
  rw nat.sub_add_cancel,
  rw ← nat.one_lt_bit0_iff, exact nat.one_lt_bit0 hdeg,
end

variables {p : ℕ}

end models_ACF_to

variables {M : Structure ring_signature} {p : ℕ}

lemma models_ACFₚ_iff {hp : nat.prime p} :
  M ⊨ ACFₚ hp ↔ (p : M) = 0 ∧ M ⊨ ACF :=
by simp only [ACFₚ, all_realize_sentence_insert, realize_sentence_equal, zero,
    realize_closed_term, models_ring_theory_to_comm_ring.realize_nat,
    models_ring_theory_to_comm_ring.realize_zero]

lemma models_ACFₚ_char [hM : fact (M ⊨ ACF)] {hp : nat.prime p} :
  M ⊨ ACFₚ hp → ring_char M = p :=
begin
  rw models_ACFₚ_iff,
  intro hmodel,
  apply ring_char.of_prime_eq_zero hp hmodel.1,
end

namespace instances

@[reducible] def algebraic_closure_of_zmod {p : ℕ} (hp : nat.prime p) :
  Structure ring_signature :=
Rings.struc_to_ring_struc.Structure (@algebraic_closure.of_zmod p ⟨ hp ⟩)

-- @[reducible] def ulift_algebraic_closure_of_zmod {p : ℕ} (hp : nat.prime p) :
--   Structure.{u} ring_signature :=
-- ulift_Structure (Rings.struc_to_ring_struc.Structure (@algebraic_closure.of_zmod p ⟨ hp ⟩))

theorem algebraic_closure_of_zmod_models_ACFₚ {p : ℕ} (hp : nat.prime p) :
  algebraic_closure_of_zmod hp ⊨ ACFₚ hp :=
begin
  rw models_ACFₚ_iff,
  split,
  {
    have h := @algebraic_closure.of_zmod.char_p p ⟨ hp ⟩,
    rw ← ring_char.eq_iff at h,
    rw ring_char.spec,
    have hrw : ring_char (@algebraic_closure.of_zmod p ⟨ hp ⟩) =
      ring_char ↥(Structure (@algebraic_closure.of_zmod p ⟨ hp ⟩)),
    { refl },
    rw hrw at h,
    rw h,
  },
  {
    classical,
    apply @is_alg_closed_to.realize_ACF _ _ (algebraic_closure.is_alg_closed _),
  },
end

-- theorem ulift_algebraic_closure_of_zmod_models_ACFₚ {p : ℕ} (hp : nat.prime p) :
--   ulift_algebraic_closure_of_zmod hp ⊨ ACFₚ hp :=
-- begin
--   have h := @ulift_Structure_all_realize_sentence (algebraic_closure_of_zmod hp) (ACFₚ hp),
--   -- rw h,
--   have h' := h.mpr (algebraic_closure_of_zmod_models_ACFₚ hp),
--   unfold ulift_algebraic_closure_of_zmod,
--   unfold algebraic_closure_of_zmod at h',
--   exact h',

-- end

end instances

end Fields