/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Abhimanyu Pallavi Sudhir, Jean Lo, Calle Sönne, Benjamin Davidson
-/
import analysis.special_functions.trigonometric.inverse
import analysis.special_functions.trigonometric.deriv

/-!
# derivatives of the inverse trigonometric functions

Derivatives of `arcsin` and `arccos`.
-/

noncomputable theory
open_locale classical topological_space filter
open set filter

open_locale real

namespace real

section arcsin

lemma deriv_arcsin_aux {x : ℝ} (h₁ : x ≠ -1) (h₂ : x ≠ 1) :
  has_strict_deriv_at arcsin (1 / sqrt (1 - x ^ 2)) x ∧ cont_diff_at ℝ ⊤ arcsin x :=
begin
  cases h₁.lt_or_lt with h₁ h₁,
  { have : 1 - x ^ 2 < 0, by nlinarith [h₁],
    rw [sqrt_eq_zero'.2 this.le, div_zero],
    have : arcsin =ᶠ[𝓝 x] λ _, -(π / 2) :=
      (gt_mem_nhds h₁).mono (λ y hy, arcsin_of_le_neg_one hy.le),
    exact ⟨(has_strict_deriv_at_const _ _).congr_of_eventually_eq this.symm,
      cont_diff_at_const.congr_of_eventually_eq this⟩ },
  cases h₂.lt_or_lt with h₂ h₂,
  { have : 0 < sqrt (1 - x ^ 2) := sqrt_pos.2 (by nlinarith [h₁, h₂]),
    simp only [← cos_arcsin h₁.le h₂.le, one_div] at this ⊢,
    exact ⟨sin_local_homeomorph.has_strict_deriv_at_symm ⟨h₁, h₂⟩ this.ne'
      (has_strict_deriv_at_sin _),
      sin_local_homeomorph.cont_diff_at_symm_deriv this.ne' ⟨h₁, h₂⟩
        (has_deriv_at_sin _) cont_diff_sin.cont_diff_at⟩ },
  { have : 1 - x ^ 2 < 0, by nlinarith [h₂],
    rw [sqrt_eq_zero'.2 this.le, div_zero],
    have : arcsin =ᶠ[𝓝 x] λ _, π / 2 := (lt_mem_nhds h₂).mono (λ y hy, arcsin_of_one_le hy.le),
    exact ⟨(has_strict_deriv_at_const _ _).congr_of_eventually_eq this.symm,
      cont_diff_at_const.congr_of_eventually_eq this⟩ }
end

lemma has_strict_deriv_at_arcsin {x : ℝ} (h₁ : x ≠ -1) (h₂ : x ≠ 1) :
  has_strict_deriv_at arcsin (1 / sqrt (1 - x ^ 2)) x :=
(deriv_arcsin_aux h₁ h₂).1

lemma has_deriv_at_arcsin {x : ℝ} (h₁ : x ≠ -1) (h₂ : x ≠ 1) :
  has_deriv_at arcsin (1 / sqrt (1 - x ^ 2)) x :=
(has_strict_deriv_at_arcsin h₁ h₂).has_deriv_at

lemma cont_diff_at_arcsin {x : ℝ} (h₁ : x ≠ -1) (h₂ : x ≠ 1) {n : with_top ℕ} :
  cont_diff_at ℝ n arcsin x :=
(deriv_arcsin_aux h₁ h₂).2.of_le le_top

lemma has_deriv_within_at_arcsin_Ici {x : ℝ} (h : x ≠ -1) :
  has_deriv_within_at arcsin (1 / sqrt (1 - x ^ 2)) (Ici x) x :=
begin
  rcases em (x = 1) with (rfl|h'),
  { convert (has_deriv_within_at_const _ _ (π / 2)).congr _ _;
      simp [arcsin_of_one_le] { contextual := tt } },
  { exact (has_deriv_at_arcsin h h').has_deriv_within_at }
end

lemma has_deriv_within_at_arcsin_Iic {x : ℝ} (h : x ≠ 1) :
  has_deriv_within_at arcsin (1 / sqrt (1 - x ^ 2)) (Iic x) x :=
begin
  rcases em (x = -1) with (rfl|h'),
  { convert (has_deriv_within_at_const _ _ (-(π / 2))).congr _ _;
      simp [arcsin_of_le_neg_one] { contextual := tt } },
  { exact (has_deriv_at_arcsin h' h).has_deriv_within_at }
end

lemma differentiable_within_at_arcsin_Ici {x : ℝ} :
  differentiable_within_at ℝ arcsin (Ici x) x ↔ x ≠ -1 :=
begin
  refine ⟨_, λ h, (has_deriv_within_at_arcsin_Ici h).differentiable_within_at⟩,
  rintro h rfl,
  have : sin ∘ arcsin =ᶠ[𝓝[≥] (-1 : ℝ)] id,
  { filter_upwards [Icc_mem_nhds_within_Ici ⟨le_rfl, neg_lt_self (@zero_lt_one ℝ _ _)⟩]
      with x using sin_arcsin', },
  have := h.has_deriv_within_at.sin.congr_of_eventually_eq this.symm (by simp),
  simpa using (unique_diff_on_Ici _ _ left_mem_Ici).eq_deriv _ this (has_deriv_within_at_id _ _)
end

lemma differentiable_within_at_arcsin_Iic {x : ℝ} :
  differentiable_within_at ℝ arcsin (Iic x) x ↔ x ≠ 1 :=
begin
  refine ⟨λ h, _, λ h, (has_deriv_within_at_arcsin_Iic h).differentiable_within_at⟩,
  rw [← neg_neg x, ← image_neg_Ici] at h,
  have := (h.comp (-x) differentiable_within_at_id.neg (maps_to_image _ _)).neg,
  simpa [(∘), differentiable_within_at_arcsin_Ici] using this
end

lemma differentiable_at_arcsin {x : ℝ} :
  differentiable_at ℝ arcsin x ↔ x ≠ -1 ∧ x ≠ 1 :=
⟨λ h, ⟨differentiable_within_at_arcsin_Ici.1 h.differentiable_within_at,
  differentiable_within_at_arcsin_Iic.1 h.differentiable_within_at⟩,
  λ h, (has_deriv_at_arcsin h.1 h.2).differentiable_at⟩

@[simp] lemma deriv_arcsin : deriv arcsin = λ x, 1 / sqrt (1 - x ^ 2) :=
begin
  funext x,
  by_cases h : x ≠ -1 ∧ x ≠ 1,
  { exact (has_deriv_at_arcsin h.1 h.2).deriv },
  { rw [deriv_zero_of_not_differentiable_at (mt differentiable_at_arcsin.1 h)],
    simp only [not_and_distrib, ne.def, not_not] at h,
    rcases h with (rfl|rfl); simp }
end

lemma differentiable_on_arcsin : differentiable_on ℝ arcsin {-1, 1}ᶜ :=
λ x hx, (differentiable_at_arcsin.2
  ⟨λ h, hx (or.inl h), λ h, hx (or.inr h)⟩).differentiable_within_at

lemma cont_diff_on_arcsin {n : with_top ℕ} :
  cont_diff_on ℝ n arcsin {-1, 1}ᶜ :=
λ x hx, (cont_diff_at_arcsin (mt or.inl hx) (mt or.inr hx)).cont_diff_within_at

lemma cont_diff_at_arcsin_iff {x : ℝ} {n : with_top ℕ} :
  cont_diff_at ℝ n arcsin x ↔ n = 0 ∨ (x ≠ -1 ∧ x ≠ 1) :=
⟨λ h, or_iff_not_imp_left.2 $ λ hn, differentiable_at_arcsin.1 $ h.differentiable_at $
  with_top.one_le_iff_pos.2 (pos_iff_ne_zero.2 hn),
  λ h, h.elim (λ hn, hn.symm ▸ (cont_diff_zero.2 continuous_arcsin).cont_diff_at) $
    λ hx, cont_diff_at_arcsin hx.1 hx.2⟩

end arcsin

section arccos

lemma has_strict_deriv_at_arccos {x : ℝ} (h₁ : x ≠ -1) (h₂ : x ≠ 1) :
  has_strict_deriv_at arccos (-(1 / sqrt (1 - x ^ 2))) x :=
(has_strict_deriv_at_arcsin h₁ h₂).const_sub (π / 2)

lemma has_deriv_at_arccos {x : ℝ} (h₁ : x ≠ -1) (h₂ : x ≠ 1) :
  has_deriv_at arccos (-(1 / sqrt (1 - x ^ 2))) x :=
(has_deriv_at_arcsin h₁ h₂).const_sub (π / 2)

lemma cont_diff_at_arccos {x : ℝ} (h₁ : x ≠ -1) (h₂ : x ≠ 1) {n : with_top ℕ} :
  cont_diff_at ℝ n arccos x :=
cont_diff_at_const.sub (cont_diff_at_arcsin h₁ h₂)

lemma has_deriv_within_at_arccos_Ici {x : ℝ} (h : x ≠ -1) :
  has_deriv_within_at arccos (-(1 / sqrt (1 - x ^ 2))) (Ici x) x :=
(has_deriv_within_at_arcsin_Ici h).const_sub _

lemma has_deriv_within_at_arccos_Iic {x : ℝ} (h : x ≠ 1) :
  has_deriv_within_at arccos (-(1 / sqrt (1 - x ^ 2))) (Iic x) x :=
(has_deriv_within_at_arcsin_Iic h).const_sub _

lemma differentiable_within_at_arccos_Ici {x : ℝ} :
  differentiable_within_at ℝ arccos (Ici x) x ↔ x ≠ -1 :=
(differentiable_within_at_const_sub_iff _).trans differentiable_within_at_arcsin_Ici

lemma differentiable_within_at_arccos_Iic {x : ℝ} :
  differentiable_within_at ℝ arccos (Iic x) x ↔ x ≠ 1 :=
(differentiable_within_at_const_sub_iff _).trans differentiable_within_at_arcsin_Iic

lemma differentiable_at_arccos {x : ℝ} :
  differentiable_at ℝ arccos x ↔ x ≠ -1 ∧ x ≠ 1 :=
(differentiable_at_const_sub_iff _).trans differentiable_at_arcsin

@[simp] lemma deriv_arccos : deriv arccos = λ x, -(1 / sqrt (1 - x ^ 2)) :=
funext $ λ x, (deriv_const_sub _).trans $ by simp only [deriv_arcsin]

lemma differentiable_on_arccos : differentiable_on ℝ arccos {-1, 1}ᶜ :=
differentiable_on_arcsin.const_sub _

lemma cont_diff_on_arccos {n : with_top ℕ} :
  cont_diff_on ℝ n arccos {-1, 1}ᶜ :=
cont_diff_on_const.sub cont_diff_on_arcsin

lemma cont_diff_at_arccos_iff {x : ℝ} {n : with_top ℕ} :
  cont_diff_at ℝ n arccos x ↔ n = 0 ∨ (x ≠ -1 ∧ x ≠ 1) :=
by refine iff.trans ⟨λ h, _, λ h, _⟩ cont_diff_at_arcsin_iff;
  simpa [arccos] using (@cont_diff_at_const _ _ _ _ _ _ _ _ _ _ (π / 2)).sub h

end arccos

end real


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

! This file was ported from Lean 3 source module order.game_add
! leanprover-community/mathlib commit fee218fb033b2fd390c447f8be27754bc9093be9
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Sym.Sym2
import Mathbin.Logic.Relation

/-!
# Game addition relation

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

This file defines, given relations `rα : α → α → Prop` and `rβ : β → β → Prop`, a relation
`prod.game_add` on pairs, such that `game_add rα rβ x y` iff `x` can be reached from `y` by
decreasing either entry (with respect to `rα` and `rβ`). It is so called since it models the
subsequency relation on the addition of combinatorial games.

We also define `sym2.game_add`, which is the unordered pair analog of `prod.game_add`.

## Main definitions and results

- `prod.game_add`: the game addition relation on ordered pairs.
- `well_founded.prod_game_add`: formalizes induction on ordered pairs, where exactly one entry
  decreases at a time.

- `sym2.game_add`: the game addition relation on unordered pairs.
- `well_founded.sym2_game_add`: formalizes induction on unordered pairs, where exactly one entry
  decreases at a time.
-/

variable {α β : Type _} {rα : α → α → Prop} {rβ : β → β → Prop}

/-! ### `prod.game_add` -/

namespace Prod

variable (rα rβ)

#print Prod.GameAdd /-
/-- `prod.game_add rα rβ x y` means that `x` can be reached from `y` by decreasing either entry with
  respect to the relations `rα` and `rβ`.

  It is so called, as it models game addition within combinatorial game theory. If `rα a₁ a₂` means
  that `a₂ ⟶ a₁` is a valid move in game `α`, and `rβ b₁ b₂` means that `b₂ ⟶ b₁` is a valid move
  in game `β`, then `game_add rα rβ` specifies the valid moves in the juxtaposition of `α` and `β`:
  the player is free to choose one of the games and make a move in it, while leaving the other game
  unchanged.

  See `sym2.game_add` for the unordered pair analog. -/
inductive GameAdd : α × β → α × β → Prop
  | fst {a₁ a₂ b} : rα a₁ a₂ → game_add (a₁, b) (a₂, b)
  | snd {a b₁ b₂} : rβ b₁ b₂ → game_add (a, b₁) (a, b₂)
#align prod.game_add Prod.GameAdd
-/

/- warning: prod.game_add_iff -> Prod.gameAdd_iff is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {rα : α -> α -> Prop} {rβ : β -> β -> Prop} {x : Prod.{u1, u2} α β} {y : Prod.{u1, u2} α β}, Iff (Prod.GameAdd.{u1, u2} α β rα rβ x y) (Or (And (rα (Prod.fst.{u1, u2} α β x) (Prod.fst.{u1, u2} α β y)) (Eq.{succ u2} β (Prod.snd.{u1, u2} α β x) (Prod.snd.{u1, u2} α β y))) (And (rβ (Prod.snd.{u1, u2} α β x) (Prod.snd.{u1, u2} α β y)) (Eq.{succ u1} α (Prod.fst.{u1, u2} α β x) (Prod.fst.{u1, u2} α β y))))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} {rα : α -> α -> Prop} {rβ : β -> β -> Prop} {x : Prod.{u2, u1} α β} {y : Prod.{u2, u1} α β}, Iff (Prod.GameAdd.{u2, u1} α β rα rβ x y) (Or (And (rα (Prod.fst.{u2, u1} α β x) (Prod.fst.{u2, u1} α β y)) (Eq.{succ u1} β (Prod.snd.{u2, u1} α β x) (Prod.snd.{u2, u1} α β y))) (And (rβ (Prod.snd.{u2, u1} α β x) (Prod.snd.{u2, u1} α β y)) (Eq.{succ u2} α (Prod.fst.{u2, u1} α β x) (Prod.fst.{u2, u1} α β y))))
Case conversion may be inaccurate. Consider using '#align prod.game_add_iff Prod.gameAdd_iffₓ'. -/
theorem gameAdd_iff {rα rβ} {x y : α × β} :
    GameAdd rα rβ x y ↔ rα x.1 y.1 ∧ x.2 = y.2 ∨ rβ x.2 y.2 ∧ x.1 = y.1 :=
  by
  constructor
  · rintro (@⟨a₁, a₂, b, h⟩ | @⟨a, b₁, b₂, h⟩)
    exacts[Or.inl ⟨h, rfl⟩, Or.inr ⟨h, rfl⟩]
  · revert x y
    rintro ⟨a₁, b₁⟩ ⟨a₂, b₂⟩ (⟨h, rfl : b₁ = b₂⟩ | ⟨h, rfl : a₁ = a₂⟩)
    exacts[game_add.fst h, game_add.snd h]
#align prod.game_add_iff Prod.gameAdd_iff

/- warning: prod.game_add_mk_iff -> Prod.gameAdd_mk_iff is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {rα : α -> α -> Prop} {rβ : β -> β -> Prop} {a₁ : α} {a₂ : α} {b₁ : β} {b₂ : β}, Iff (Prod.GameAdd.{u1, u2} α β rα rβ (Prod.mk.{u1, u2} α β a₁ b₁) (Prod.mk.{u1, u2} α β a₂ b₂)) (Or (And (rα a₁ a₂) (Eq.{succ u2} β b₁ b₂)) (And (rβ b₁ b₂) (Eq.{succ u1} α a₁ a₂)))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} {rα : α -> α -> Prop} {rβ : β -> β -> Prop} {a₁ : α} {a₂ : α} {b₁ : β} {b₂ : β}, Iff (Prod.GameAdd.{u2, u1} α β rα rβ (Prod.mk.{u2, u1} α β a₁ b₁) (Prod.mk.{u2, u1} α β a₂ b₂)) (Or (And (rα a₁ a₂) (Eq.{succ u1} β b₁ b₂)) (And (rβ b₁ b₂) (Eq.{succ u2} α a₁ a₂)))
Case conversion may be inaccurate. Consider using '#align prod.game_add_mk_iff Prod.gameAdd_mk_iffₓ'. -/
theorem gameAdd_mk_iff {rα rβ} {a₁ a₂ : α} {b₁ b₂ : β} :
    GameAdd rα rβ (a₁, b₁) (a₂, b₂) ↔ rα a₁ a₂ ∧ b₁ = b₂ ∨ rβ b₁ b₂ ∧ a₁ = a₂ :=
  gameAdd_iff
#align prod.game_add_mk_iff Prod.gameAdd_mk_iff

/- warning: prod.game_add_swap_swap -> Prod.gameAdd_swap_swap is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} (rα : α -> α -> Prop) (rβ : β -> β -> Prop) (a : Prod.{u1, u2} α β) (b : Prod.{u1, u2} α β), Iff (Prod.GameAdd.{u2, u1} β α rβ rα (Prod.swap.{u1, u2} α β a) (Prod.swap.{u1, u2} α β b)) (Prod.GameAdd.{u1, u2} α β rα rβ a b)
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} (rα : α -> α -> Prop) (rβ : β -> β -> Prop) (a : Prod.{u2, u1} α β) (b : Prod.{u2, u1} α β), Iff (Prod.GameAdd.{u1, u2} β α rβ rα (Prod.swap.{u2, u1} α β a) (Prod.swap.{u2, u1} α β b)) (Prod.GameAdd.{u2, u1} α β rα rβ a b)
Case conversion may be inaccurate. Consider using '#align prod.game_add_swap_swap Prod.gameAdd_swap_swapₓ'. -/
@[simp]
theorem gameAdd_swap_swap : ∀ a b : α × β, GameAdd rβ rα a.symm b.symm ↔ GameAdd rα rβ a b :=
  fun ⟨a₁, b₁⟩ ⟨a₂, b₂⟩ => by rw [Prod.swap, game_add_mk_iff, game_add_mk_iff, or_comm']
#align prod.game_add_swap_swap Prod.gameAdd_swap_swap

/- warning: prod.game_add_swap_swap_mk -> Prod.gameAdd_swap_swap_mk is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} (rα : α -> α -> Prop) (rβ : β -> β -> Prop) (a₁ : α) (a₂ : α) (b₁ : β) (b₂ : β), Iff (Prod.GameAdd.{u1, u2} α β rα rβ (Prod.mk.{u1, u2} α β a₁ b₁) (Prod.mk.{u1, u2} α β a₂ b₂)) (Prod.GameAdd.{u2, u1} β α rβ rα (Prod.mk.{u2, u1} β α b₁ a₁) (Prod.mk.{u2, u1} β α b₂ a₂))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} (rα : α -> α -> Prop) (rβ : β -> β -> Prop) (a₁ : α) (a₂ : α) (b₁ : β) (b₂ : β), Iff (Prod.GameAdd.{u2, u1} α β rα rβ (Prod.mk.{u2, u1} α β a₁ b₁) (Prod.mk.{u2, u1} α β a₂ b₂)) (Prod.GameAdd.{u1, u2} β α rβ rα (Prod.mk.{u1, u2} β α b₁ a₁) (Prod.mk.{u1, u2} β α b₂ a₂))
Case conversion may be inaccurate. Consider using '#align prod.game_add_swap_swap_mk Prod.gameAdd_swap_swap_mkₓ'. -/
theorem gameAdd_swap_swap_mk (a₁ a₂ : α) (b₁ b₂ : β) :
    GameAdd rα rβ (a₁, b₁) (a₂, b₂) ↔ GameAdd rβ rα (b₁, a₁) (b₂, a₂) :=
  gameAdd_swap_swap rβ rα (b₁, a₁) (b₂, a₂)
#align prod.game_add_swap_swap_mk Prod.gameAdd_swap_swap_mk

/- warning: prod.game_add_le_lex -> Prod.gameAdd_le_lex is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} (rα : α -> α -> Prop) (rβ : β -> β -> Prop), LE.le.{max u1 u2} ((Prod.{u1, u2} α β) -> (Prod.{u1, u2} α β) -> Prop) (Pi.hasLe.{max u1 u2, max u1 u2} (Prod.{u1, u2} α β) (fun (ᾰ : Prod.{u1, u2} α β) => (Prod.{u1, u2} α β) -> Prop) (fun (i : Prod.{u1, u2} α β) => Pi.hasLe.{max u1 u2, 0} (Prod.{u1, u2} α β) (fun (ᾰ : Prod.{u1, u2} α β) => Prop) (fun (i : Prod.{u1, u2} α β) => Prop.le))) (Prod.GameAdd.{u1, u2} α β rα rβ) (Prod.Lex.{u1, u2} α β rα rβ)
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} (rα : α -> α -> Prop) (rβ : β -> β -> Prop), LE.le.{max u2 u1} ((Prod.{u2, u1} α β) -> (Prod.{u2, u1} α β) -> Prop) (Pi.hasLe.{max u2 u1, max u2 u1} (Prod.{u2, u1} α β) (fun (ᾰ : Prod.{u2, u1} α β) => (Prod.{u2, u1} α β) -> Prop) (fun (i : Prod.{u2, u1} α β) => Pi.hasLe.{max u2 u1, 0} (Prod.{u2, u1} α β) (fun (ᾰ : Prod.{u2, u1} α β) => Prop) (fun (i : Prod.{u2, u1} α β) => Prop.le))) (Prod.GameAdd.{u2, u1} α β rα rβ) (Prod.Lex.{u2, u1} α β rα rβ)
Case conversion may be inaccurate. Consider using '#align prod.game_add_le_lex Prod.gameAdd_le_lexₓ'. -/
/-- `prod.game_add` is a `subrelation` of `prod.lex`. -/
theorem gameAdd_le_lex : GameAdd rα rβ ≤ Prod.Lex rα rβ := fun _ _ h =>
  h.rec (fun _ _ b => Prod.Lex.left b b) fun a _ _ => Prod.Lex.right a
#align prod.game_add_le_lex Prod.gameAdd_le_lex

/- warning: prod.rprod_le_trans_gen_game_add -> Prod.rprod_le_transGen_gameAdd is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} (rα : α -> α -> Prop) (rβ : β -> β -> Prop), LE.le.{max u1 u2} ((Prod.{u1, u2} α β) -> (Prod.{u1, u2} α β) -> Prop) (Pi.hasLe.{max u1 u2, max u1 u2} (Prod.{u1, u2} α β) (fun (ᾰ : Prod.{u1, u2} α β) => (Prod.{u1, u2} α β) -> Prop) (fun (i : Prod.{u1, u2} α β) => Pi.hasLe.{max u1 u2, 0} (Prod.{u1, u2} α β) (fun (ᾰ : Prod.{u1, u2} α β) => Prop) (fun (i : Prod.{u1, u2} α β) => Prop.le))) (Prod.RProd.{u1, u2} α β rα rβ) (Relation.TransGen.{max u1 u2} (Prod.{u1, u2} α β) (Prod.GameAdd.{u1, u2} α β rα rβ))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} (rα : α -> α -> Prop) (rβ : β -> β -> Prop), LE.le.{max u2 u1} ((Prod.{u2, u1} α β) -> (Prod.{u2, u1} α β) -> Prop) (Pi.hasLe.{max u2 u1, max u2 u1} (Prod.{u2, u1} α β) (fun (ᾰ : Prod.{u2, u1} α β) => (Prod.{u2, u1} α β) -> Prop) (fun (i : Prod.{u2, u1} α β) => Pi.hasLe.{max u2 u1, 0} (Prod.{u2, u1} α β) (fun (ᾰ : Prod.{u2, u1} α β) => Prop) (fun (i : Prod.{u2, u1} α β) => Prop.le))) (Prod.RProd.{u2, u1} α β rα rβ) (Relation.TransGen.{max u1 u2} (Prod.{u2, u1} α β) (Prod.GameAdd.{u2, u1} α β rα rβ))
Case conversion may be inaccurate. Consider using '#align prod.rprod_le_trans_gen_game_add Prod.rprod_le_transGen_gameAddₓ'. -/
/-- `prod.rprod` is a subrelation of the transitive closure of `prod.game_add`. -/
theorem rprod_le_transGen_gameAdd : RProd rα rβ ≤ Relation.TransGen (GameAdd rα rβ) := fun _ _ h =>
  h.rec
    (by
      intro _ _ _ _ hα hβ
      exact Relation.TransGen.tail (Relation.TransGen.single <| game_add.fst hα) (game_add.snd hβ))
#align prod.rprod_le_trans_gen_game_add Prod.rprod_le_transGen_gameAdd

end Prod

/- warning: acc.prod_game_add -> Acc.prod_gameAdd is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {rα : α -> α -> Prop} {rβ : β -> β -> Prop} {a : α} {b : β}, (Acc.{succ u1} α rα a) -> (Acc.{succ u2} β rβ b) -> (Acc.{max (succ u1) (succ u2)} (Prod.{u1, u2} α β) (Prod.GameAdd.{u1, u2} α β rα rβ) (Prod.mk.{u1, u2} α β a b))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} {rα : α -> α -> Prop} {rβ : β -> β -> Prop} {a : α} {b : β}, (Acc.{succ u2} α rα a) -> (Acc.{succ u1} β rβ b) -> (Acc.{max (succ u1) (succ u2)} (Prod.{u2, u1} α β) (Prod.GameAdd.{u2, u1} α β rα rβ) (Prod.mk.{u2, u1} α β a b))
Case conversion may be inaccurate. Consider using '#align acc.prod_game_add Acc.prod_gameAddₓ'. -/
/-- If `a` is accessible under `rα` and `b` is accessible under `rβ`, then `(a, b)` is
  accessible under `prod.game_add rα rβ`. Notice that `prod.lex_accessible` requires the
  stronger condition `∀ b, acc rβ b`. -/
theorem Acc.prod_gameAdd {a b} (ha : Acc rα a) (hb : Acc rβ b) : Acc (Prod.GameAdd rα rβ) (a, b) :=
  by
  induction' ha with a ha iha generalizing b
  induction' hb with b hb ihb
  refine' Acc.intro _ fun h => _
  rintro (⟨ra⟩ | ⟨rb⟩)
  exacts[iha _ ra (Acc.intro b hb), ihb _ rb]
#align acc.prod_game_add Acc.prod_gameAdd

/- warning: well_founded.prod_game_add -> WellFounded.prod_gameAdd is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {rα : α -> α -> Prop} {rβ : β -> β -> Prop}, (WellFounded.{succ u1} α rα) -> (WellFounded.{succ u2} β rβ) -> (WellFounded.{max (succ u1) (succ u2)} (Prod.{u1, u2} α β) (Prod.GameAdd.{u1, u2} α β rα rβ))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} {rα : α -> α -> Prop} {rβ : β -> β -> Prop}, (WellFounded.{succ u2} α rα) -> (WellFounded.{succ u1} β rβ) -> (WellFounded.{max (succ u1) (succ u2)} (Prod.{u2, u1} α β) (Prod.GameAdd.{u2, u1} α β rα rβ))
Case conversion may be inaccurate. Consider using '#align well_founded.prod_game_add WellFounded.prod_gameAddₓ'. -/
/-- The `prod.game_add` relation on well-founded inputs is well-founded.

  In particular, the sum of two well-founded games is well-founded. -/
theorem WellFounded.prod_gameAdd (hα : WellFounded rα) (hβ : WellFounded rβ) :
    WellFounded (Prod.GameAdd rα rβ) :=
  ⟨fun ⟨a, b⟩ => (hα.apply a).prod_gameAdd (hβ.apply b)⟩
#align well_founded.prod_game_add WellFounded.prod_gameAdd

namespace Prod

#print Prod.GameAdd.fix /-
/-- Recursion on the well-founded `prod.game_add` relation.

  Note that it's strictly more general to recurse on the lexicographic order instead. -/
def GameAdd.fix {C : α → β → Sort _} (hα : WellFounded rα) (hβ : WellFounded rβ)
    (IH : ∀ a₁ b₁, (∀ a₂ b₂, GameAdd rα rβ (a₂, b₂) (a₁, b₁) → C a₂ b₂) → C a₁ b₁) (a : α) (b : β) :
    C a b :=
  @WellFounded.fix (α × β) (fun x => C x.1 x.2) _ (hα.prod_gameAdd hβ)
    (fun ⟨x₁, x₂⟩ IH' => IH x₁ x₂ fun a' b' => IH' ⟨a', b'⟩) ⟨a, b⟩
#align prod.game_add.fix Prod.GameAdd.fix
-/

/- warning: prod.game_add.fix_eq -> Prod.GameAdd.fix_eq is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {rα : α -> α -> Prop} {rβ : β -> β -> Prop} {C : α -> β -> Sort.{u3}} (hα : WellFounded.{succ u1} α rα) (hβ : WellFounded.{succ u2} β rβ) (IH : forall (a₁ : α) (b₁ : β), (forall (a₂ : α) (b₂ : β), (Prod.GameAdd.{u1, u2} α β rα rβ (Prod.mk.{u1, u2} α β a₂ b₂) (Prod.mk.{u1, u2} α β a₁ b₁)) -> (C a₂ b₂)) -> (C a₁ b₁)) (a : α) (b : β), Eq.{u3} (C a b) (Prod.GameAdd.fix.{u1, u2, u3} α β rα rβ (fun (a₂ : α) (b₂ : β) => C a₂ b₂) hα hβ IH a b) (IH a b (fun (a' : α) (b' : β) (h : Prod.GameAdd.{u1, u2} α β rα rβ (Prod.mk.{u1, u2} α β a' b') (Prod.mk.{u1, u2} α β a b)) => Prod.GameAdd.fix.{u1, u2, u3} α β rα rβ C hα hβ IH a' b'))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} {rα : α -> α -> Prop} {rβ : β -> β -> Prop} {C : α -> β -> Sort.{u3}} (hα : WellFounded.{succ u2} α rα) (hβ : WellFounded.{succ u1} β rβ) (IH : forall (a₁ : α) (b₁ : β), (forall (a₂ : α) (b₂ : β), (Prod.GameAdd.{u2, u1} α β rα rβ (Prod.mk.{u2, u1} α β a₂ b₂) (Prod.mk.{u2, u1} α β a₁ b₁)) -> (C a₂ b₂)) -> (C a₁ b₁)) (a : α) (b : β), Eq.{u3} (C a b) (Prod.GameAdd.fix.{u2, u1, u3} α β rα rβ (fun (a₂ : α) (b₂ : β) => C a₂ b₂) hα hβ IH a b) (IH a b (fun (a' : α) (b' : β) (h : Prod.GameAdd.{u2, u1} α β rα rβ (Prod.mk.{u2, u1} α β a' b') (Prod.mk.{u2, u1} α β a b)) => Prod.GameAdd.fix.{u2, u1, u3} α β rα rβ (fun (a₂ : α) (b₂ : β) => C a₂ b₂) hα hβ IH a' b'))
Case conversion may be inaccurate. Consider using '#align prod.game_add.fix_eq Prod.GameAdd.fix_eqₓ'. -/
theorem GameAdd.fix_eq {C : α → β → Sort _} (hα : WellFounded rα) (hβ : WellFounded rβ)
    (IH : ∀ a₁ b₁, (∀ a₂ b₂, GameAdd rα rβ (a₂, b₂) (a₁, b₁) → C a₂ b₂) → C a₁ b₁) (a : α) (b : β) :
    GameAdd.fix hα hβ IH a b = IH a b fun a' b' h => GameAdd.fix hα hβ IH a' b' :=
  WellFounded.fix_eq _ _ _
#align prod.game_add.fix_eq Prod.GameAdd.fix_eq

/- warning: prod.game_add.induction -> Prod.GameAdd.induction is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {rα : α -> α -> Prop} {rβ : β -> β -> Prop} {C : α -> β -> Prop}, (WellFounded.{succ u1} α rα) -> (WellFounded.{succ u2} β rβ) -> (forall (a₁ : α) (b₁ : β), (forall (a₂ : α) (b₂ : β), (Prod.GameAdd.{u1, u2} α β rα rβ (Prod.mk.{u1, u2} α β a₂ b₂) (Prod.mk.{u1, u2} α β a₁ b₁)) -> (C a₂ b₂)) -> (C a₁ b₁)) -> (forall (a : α) (b : β), C a b)
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} {rα : α -> α -> Prop} {rβ : β -> β -> Prop} {C : α -> β -> Prop}, (WellFounded.{succ u2} α rα) -> (WellFounded.{succ u1} β rβ) -> (forall (a₁ : α) (b₁ : β), (forall (a₂ : α) (b₂ : β), (Prod.GameAdd.{u2, u1} α β rα rβ (Prod.mk.{u2, u1} α β a₂ b₂) (Prod.mk.{u2, u1} α β a₁ b₁)) -> (C a₂ b₂)) -> (C a₁ b₁)) -> (forall (a : α) (b : β), C a b)
Case conversion may be inaccurate. Consider using '#align prod.game_add.induction Prod.GameAdd.inductionₓ'. -/
/-- Induction on the well-founded `prod.game_add` relation.

  Note that it's strictly more general to induct on the lexicographic order instead. -/
theorem GameAdd.induction {C : α → β → Prop} :
    WellFounded rα →
      WellFounded rβ →
        (∀ a₁ b₁, (∀ a₂ b₂, GameAdd rα rβ (a₂, b₂) (a₁, b₁) → C a₂ b₂) → C a₁ b₁) → ∀ a b, C a b :=
  GameAdd.fix
#align prod.game_add.induction Prod.GameAdd.induction

end Prod

/-! ### `sym2.game_add` -/

namespace Sym2

#print Sym2.GameAdd /-
/-- `sym2.game_add rα x y` means that `x` can be reached from `y` by decreasing either entry with
  respect to the relation `rα`.

  See `prod.game_add` for the ordered pair analog. -/
def GameAdd (rα : α → α → Prop) : Sym2 α → Sym2 α → Prop :=
  Sym2.lift₂
    ⟨fun a₁ b₁ a₂ b₂ => Prod.GameAdd rα rα (a₁, b₁) (a₂, b₂) ∨ Prod.GameAdd rα rα (b₁, a₁) (a₂, b₂),
      fun a₁ b₁ a₂ b₂ =>
      by
      rw [Prod.gameAdd_swap_swap_mk _ _ b₁ b₂ a₁ a₂, Prod.gameAdd_swap_swap_mk _ _ a₁ b₂ b₁ a₂]
      simp [or_comm']⟩
#align sym2.game_add Sym2.GameAdd
-/

variable {rα}

#print Sym2.gameAdd_iff /-
theorem gameAdd_iff :
    ∀ {x y : α × α}, GameAdd rα ⟦x⟧ ⟦y⟧ ↔ Prod.GameAdd rα rα x y ∨ Prod.GameAdd rα rα x.symm y :=
  by
  rintro ⟨_, _⟩ ⟨_, _⟩
  rfl
#align sym2.game_add_iff Sym2.gameAdd_iff
-/

#print Sym2.gameAdd_mk'_iff /-
theorem gameAdd_mk'_iff {a₁ a₂ b₁ b₂ : α} :
    GameAdd rα ⟦(a₁, b₁)⟧ ⟦(a₂, b₂)⟧ ↔
      Prod.GameAdd rα rα (a₁, b₁) (a₂, b₂) ∨ Prod.GameAdd rα rα (b₁, a₁) (a₂, b₂) :=
  Iff.rfl
#align sym2.game_add_mk_iff Sym2.gameAdd_mk'_iff
-/

#print Prod.GameAdd.to_sym2 /-
theorem Prod.GameAdd.to_sym2 {a₁ a₂ b₁ b₂ : α} (h : Prod.GameAdd rα rα (a₁, b₁) (a₂, b₂)) :
    Sym2.GameAdd rα ⟦(a₁, b₁)⟧ ⟦(a₂, b₂)⟧ :=
  gameAdd_mk'_iff.2 <| Or.inl <| h
#align prod.game_add.to_sym2 Prod.GameAdd.to_sym2
-/

#print Sym2.GameAdd.fst /-
theorem GameAdd.fst {a₁ a₂ b : α} (h : rα a₁ a₂) : GameAdd rα ⟦(a₁, b)⟧ ⟦(a₂, b)⟧ :=
  (Prod.GameAdd.fst h).to_sym2
#align sym2.game_add.fst Sym2.GameAdd.fst
-/

#print Sym2.GameAdd.snd /-
theorem GameAdd.snd {a b₁ b₂ : α} (h : rα b₁ b₂) : GameAdd rα ⟦(a, b₁)⟧ ⟦(a, b₂)⟧ :=
  (Prod.GameAdd.snd h).to_sym2
#align sym2.game_add.snd Sym2.GameAdd.snd
-/

#print Sym2.GameAdd.fst_snd /-
theorem GameAdd.fst_snd {a₁ a₂ b : α} (h : rα a₁ a₂) : GameAdd rα ⟦(a₁, b)⟧ ⟦(b, a₂)⟧ :=
  by
  rw [Sym2.eq_swap]
  exact game_add.snd h
#align sym2.game_add.fst_snd Sym2.GameAdd.fst_snd
-/

#print Sym2.GameAdd.snd_fst /-
theorem GameAdd.snd_fst {a₁ a₂ b : α} (h : rα a₁ a₂) : GameAdd rα ⟦(b, a₁)⟧ ⟦(a₂, b)⟧ :=
  by
  rw [Sym2.eq_swap]
  exact game_add.fst h
#align sym2.game_add.snd_fst Sym2.GameAdd.snd_fst
-/

end Sym2

#print Acc.sym2_gameAdd /-
theorem Acc.sym2_gameAdd {a b} (ha : Acc rα a) (hb : Acc rα b) : Acc (Sym2.GameAdd rα) ⟦(a, b)⟧ :=
  by
  induction' ha with a ha iha generalizing b
  induction' hb with b hb ihb
  refine' Acc.intro _ fun s => _
  induction' s using Sym2.inductionOn with c d
  rintro ((rc | rd) | (rd | rc))
  · exact iha c rc ⟨b, hb⟩
  · exact ihb d rd
  · rw [Sym2.eq_swap]
    exact iha d rd ⟨b, hb⟩
  · rw [Sym2.eq_swap]
    exact ihb c rc
#align acc.sym2_game_add Acc.sym2_gameAdd
-/

#print WellFounded.sym2_gameAdd /-
/-- The `sym2.game_add` relation on well-founded inputs is well-founded. -/
theorem WellFounded.sym2_gameAdd (h : WellFounded rα) : WellFounded (Sym2.GameAdd rα) :=
  ⟨fun i => Sym2.inductionOn i fun x y => (h.apply x).sym2_gameAdd (h.apply y)⟩
#align well_founded.sym2_game_add WellFounded.sym2_gameAdd
-/

namespace Sym2

#print Sym2.GameAdd.fix /-
/-- Recursion on the well-founded `sym2.game_add` relation. -/
def GameAdd.fix {C : α → α → Sort _} (hr : WellFounded rα)
    (IH : ∀ a₁ b₁, (∀ a₂ b₂, Sym2.GameAdd rα ⟦(a₂, b₂)⟧ ⟦(a₁, b₁)⟧ → C a₂ b₂) → C a₁ b₁) (a b : α) :
    C a b :=
  @WellFounded.fix (α × α) (fun x => C x.1 x.2) _ hr.sym2_gameAdd.of_quotient_lift₂
    (fun ⟨x₁, x₂⟩ IH' => IH x₁ x₂ fun a' b' => IH' ⟨a', b'⟩) (a, b)
#align sym2.game_add.fix Sym2.GameAdd.fix
-/

#print Sym2.GameAdd.fix_eq /-
theorem GameAdd.fix_eq {C : α → α → Sort _} (hr : WellFounded rα)
    (IH : ∀ a₁ b₁, (∀ a₂ b₂, Sym2.GameAdd rα ⟦(a₂, b₂)⟧ ⟦(a₁, b₁)⟧ → C a₂ b₂) → C a₁ b₁) (a b : α) :
    GameAdd.fix hr IH a b = IH a b fun a' b' h => GameAdd.fix hr IH a' b' :=
  WellFounded.fix_eq _ _ _
#align sym2.game_add.fix_eq Sym2.GameAdd.fix_eq
-/

#print Sym2.GameAdd.induction /-
/-- Induction on the well-founded `sym2.game_add` relation. -/
theorem GameAdd.induction {C : α → α → Prop} :
    WellFounded rα →
      (∀ a₁ b₁, (∀ a₂ b₂, Sym2.GameAdd rα ⟦(a₂, b₂)⟧ ⟦(a₁, b₁)⟧ → C a₂ b₂) → C a₁ b₁) →
        ∀ a b, C a b :=
  GameAdd.fix
#align sym2.game_add.induction Sym2.GameAdd.induction
-/

end Sym2


/-
Copyright (c) 2020 Adam Topaz. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Adam Topaz
-/

import tactic
import data.finset.basic

/-!
# Constructions involving sets of sets.

## Finite Intersections

We define a structure `has_finite_inter` which asserts that a set `S` of subsets of `α` is
closed under finite intersections.

We define `finite_inter_closure` which, given a set `S` of subsets of `α`, is the smallest
set of subsets of `α` which is closed under finite intersections.

`finite_inter_closure S` is endowed with a term of type `has_finite_inter` using
`finite_inter_closure_has_finite_inter`.

-/

variables {α : Type*} (S : set (set α))

/-- A structure encapsulating the fact that a set of sets is closed under finite intersection. -/
structure has_finite_inter :=
(univ_mem : set.univ ∈ S)
(inter_mem {s t} : s ∈ S → t ∈ S → s ∩ t ∈ S)

namespace has_finite_inter

-- Satisfying the inhabited linter...
instance : inhabited (has_finite_inter ({set.univ} : set (set α))) :=
⟨⟨by tauto, λ _ _ h1 h2, by finish⟩⟩

/-- The smallest set of sets containing `S` which is closed under finite intersections. -/
inductive finite_inter_closure : set (set α)
| basic {s} : s ∈ S → finite_inter_closure s
| univ : finite_inter_closure set.univ
| inter {s t} : finite_inter_closure s → finite_inter_closure t → finite_inter_closure (s ∩ t)

/-- Defines `has_finite_inter` for `finite_inter_closure S`. -/
def finite_inter_closure_has_finite_inter : has_finite_inter (finite_inter_closure S) :=
{ univ_mem := finite_inter_closure.univ,
  inter_mem := λ _ _, finite_inter_closure.inter }

variable {S}
lemma finite_inter_mem (cond : has_finite_inter S) (F : finset (set α)) :
  ↑F ⊆ S → ⋂₀ (↑F : set (set α)) ∈ S :=
begin
  classical,
  refine finset.induction_on F (λ _, _) _,
  { simp [cond.univ_mem] },
  { intros a s h1 h2 h3,
    suffices : a ∩ ⋂₀ ↑s ∈ S, by simpa,
    exact cond.inter_mem (h3 (finset.mem_insert_self a s))
                         (h2 $ λ x hx, h3 $ finset.mem_insert_of_mem hx) }
end

lemma finite_inter_closure_insert {A : set α} (cond : has_finite_inter S)
  (P ∈ finite_inter_closure (insert A S)) : P ∈ S ∨ ∃ Q ∈ S, P = A ∩ Q :=
begin
  induction H with S h T1 T2 _ _ h1 h2,
  { cases h,
    { exact or.inr ⟨set.univ, cond.univ_mem, by simpa⟩ },
    { exact or.inl h } },
  { exact or.inl cond.univ_mem },
  { rcases h1 with (h | ⟨Q, hQ, rfl⟩); rcases h2 with (i | ⟨R, hR, rfl⟩),
    { exact or.inl (cond.inter_mem h i) },
    { exact or.inr ⟨T1 ∩ R, cond.inter_mem h hR, by finish⟩ },
    { exact or.inr ⟨Q ∩ T2, cond.inter_mem hQ i, by finish⟩ },
    { exact or.inr ⟨Q ∩ R, cond.inter_mem hQ hR , by tidy⟩ } }
end

end has_finite_inter


inductive Foo where
  | text : String → Foo
  | element : List Foo → Foo

namespace Foo

mutual
  @[simp] def textLengthList : List Foo → Nat
    | [] => 0
    | f::fs => textLength f + textLengthList fs

  @[simp] def textLength : Foo → Nat
    | text s => s.length
    | element children => textLengthList children
end

def concat (f₁ f₂ : Foo) : Foo :=
  Foo.element [f₁, f₂]

theorem textLength_concat (f₁ f₂ : Foo) : textLength (concat f₁ f₂) = textLength f₁ + textLength f₂ := by
  simp [concat]

mutual
  @[simp] def flatList : List Foo → List String
    | [] => []
    | f :: fs => flat f ++ flatList fs

  @[simp] def flat : Foo → List String
    | text s => [s]
    | element children => flatList children
end

def listStringLen (xs : List String) : Nat :=
  xs.foldl (init := 0) fun sum s => sum + s.length

attribute [simp] List.foldl

theorem foldl_init (s : Nat) (xs : List String) :  (xs.foldl (init := s) fun sum s => sum + s.length) = s + (xs.foldl (init := 0) fun sum s => sum + s.length) := by
  induction xs generalizing s with
  | nil => simp
  | cons x xs ih => simp_arith [ih x.length, ih (s + x.length)]

theorem listStringLen_append (xs ys : List String) : listStringLen (xs ++ ys) = listStringLen xs + listStringLen ys := by
  simp [listStringLen]
  induction xs with
  | nil => simp
  | cons x xs ih => simp_arith [foldl_init x.length, ih]

mutual
  theorem listStringLen_flat (f : Foo) : listStringLen (flat f) = textLength f := by
    match f with
    | text s => simp [listStringLen]
    | element cs => simp [listStringLen_flatList cs]

  theorem listStringLen_flatList (cs : List Foo) : listStringLen (flatList cs) = textLengthList cs := by
    match cs with
    | [] => simp
    | f :: fs => simp [listStringLen_append, listStringLen_flatList fs, listStringLen_flat f]
end

end Foo


/-
Copyright (c) 2022 Moritz Doll. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Moritz Doll, Mario Carneiro, Robert Y. Lewis
-/
import Mathlib.Tactic.Basic
import Mathlib.Tactic.NormCast
import Mathlib.Tactic.Zify.Attr
import Mathlib.Data.Int.Basic

/-!
# `zify` tactic

The `zify` tactic is used to shift propositions from `ℕ` to `ℤ`.
This is often useful since `ℤ` has well-behaved subtraction.
```
example (a b c x y z : ℕ) (h : ¬ x*y*z < 0) : c < a + 3*b := by
  zify
  zify at h
  /-
  h : ¬↑x * ↑y * ↑z < 0
  ⊢ ↑c < ↑a + 3 * ↑b
  -/
```
-/

namespace Mathlib.Tactic.Zify

open Lean
open Lean.Meta
open Lean.Parser.Tactic
open Lean.Elab.Tactic

/--
The `zify` tactic is used to shift propositions from `ℕ` to `ℤ`.
This is often useful since `ℤ` has well-behaved subtraction.
```
example (a b c x y z : ℕ) (h : ¬ x*y*z < 0) : c < a + 3*b := by
  zify
  zify at h
  /-
  h : ¬↑x * ↑y * ↑z < 0
  ⊢ ↑c < ↑a + 3 * ↑b
  -/
```
`zify` can be given extra lemmas to use in simplification. This is especially useful in the
presence of nat subtraction: passing `≤` arguments will allow `push_cast` to do more work.
```
example (a b c : ℕ) (h : a - b < c) (hab : b ≤ a) : false := by
  zify [hab] at h
  /- h : ↑a - ↑b < ↑c -/
```
`zify` makes use of the `@[zify_simps]` attribute to move propositions,
and the `push_cast` tactic to simplify the `ℤ`-valued expressions.
`zify` is in some sense dual to the `lift` tactic. `lift (z : ℤ) to ℕ` will change the type of an
integer `z` (in the supertype) to `ℕ` (the subtype), given a proof that `z ≥ 0`;
propositions concerning `z` will still be over `ℤ`. `zify` changes propositions about `ℕ` (the
subtype) to propositions about `ℤ` (the supertype), without changing the type of any variable.
-/
syntax (name := zify) "zify" (simpArgs)? (ppSpace location)? : tactic

macro_rules
| `(tactic| zify $[[$simpArgs,*]]? $[at $location]?) =>
  let args := simpArgs.map (·.getElems) |>.getD #[]
  `(tactic|
    simp (config := {decide := false}) only [zify_simps, push_cast, $args,*] $[at $location]?)

/-- The `Simp.Context` generated by `zify`. -/
def mkZifyContext (simpArgs : Option (Syntax.TSepArray `Lean.Parser.Tactic.simpStar ",")) :
    TacticM MkSimpContextResult := do
  let args := simpArgs.map (·.getElems) |>.getD #[]
  mkSimpContext
    (← `(tactic| simp (config := {decide := false}) only [zify_simps, push_cast, $args,*])) false

/-- A variant of `applySimpResultToProp` that cannot close the goal, but does not need a meta
variable and returns a tuple of a proof and the corresponding simplified proposition. -/
def applySimpResultToProp' (proof : Expr) (prop : Expr) (r : Simp.Result) : MetaM (Expr × Expr) :=
  do
  match r.proof? with
  | some eqProof => return (← mkExpectedTypeHint (← mkEqMP eqProof proof) r.expr, r.expr)
  | none =>
    if r.expr != prop then
      return (← mkExpectedTypeHint proof r.expr, r.expr)
    else
      return (proof, r.expr)

/-- Translate a proof and the proposition into a zified form. -/
def zifyProof (simpArgs : Option (Syntax.TSepArray `Lean.Parser.Tactic.simpStar ","))
  (proof : Expr) (prop : Expr) : TacticM (Expr × Expr) := do
  let ctx_result ← mkZifyContext simpArgs
  let (r, _) ← simp prop ctx_result.ctx
  applySimpResultToProp' proof prop r

@[zify_simps] lemma nat_cast_eq (a b : ℕ) : a = b ↔ (a : ℤ) = (b : ℤ) := Int.ofNat_inj.symm
@[zify_simps] lemma nat_cast_le (a b : ℕ) : a ≤ b ↔ (a : ℤ) ≤ (b : ℤ) := Int.ofNat_le.symm
@[zify_simps] lemma nat_cast_lt (a b : ℕ) : a < b ↔ (a : ℤ) < (b : ℤ) := Int.ofNat_lt.symm
@[zify_simps] lemma nat_cast_ne (a b : ℕ) : a ≠ b ↔ (a : ℤ) ≠ (b : ℤ) := by
  simp only [ne_eq, Int.cast_eq_cast_iff_Nat]


/-
Copyright (c) 2020 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau
-/

import algebra.algebra.tower
import data.polynomial.algebra_map

/-!
# Algebra towers for polynomial

This file proves some basic results about the algebra tower structure for the type `polynomial R`.

This structure itself is provided elsewhere as `polynomial.is_scalar_tower`
-/

universes u v w u₁

variables (R : Type u) (S : Type v) (A : Type w) (B : Type u₁)

namespace is_scalar_tower

section semiring
variables [comm_semiring R] [comm_semiring S] [semiring A] [semiring B]
variables [algebra R S] [algebra S A] [algebra S B] [algebra R A] [algebra R B]
variables [is_scalar_tower R S A] [is_scalar_tower R S B]

variables (R S A) {B}
theorem aeval_apply (x : A) (p : polynomial R) : polynomial.aeval x p =
  polynomial.aeval x (polynomial.map (algebra_map R S) p) :=
by rw [polynomial.aeval_def, polynomial.aeval_def, polynomial.eval₂_map, algebra_map_eq R S A]

end semiring

section comm_semiring
variables [comm_semiring R] [comm_semiring A] [comm_semiring B]
variables [algebra R A] [algebra A B] [algebra R B] [is_scalar_tower R A B]

lemma algebra_map_aeval (x : A) (p : polynomial R) :
  algebra_map A B (polynomial.aeval x p) = polynomial.aeval (algebra_map A B x) p :=
by rw [polynomial.aeval_def, polynomial.aeval_def, polynomial.hom_eval₂,
  ←is_scalar_tower.algebra_map_eq]

lemma aeval_eq_zero_of_aeval_algebra_map_eq_zero {x : A} {p : polynomial R}
  (h : function.injective (algebra_map A B)) (hp : polynomial.aeval (algebra_map A B x) p = 0) :
  polynomial.aeval x p = 0 :=
begin
  rw [← algebra_map_aeval, ← (algebra_map A B).map_zero] at hp,
  exact h hp,
end

lemma aeval_eq_zero_of_aeval_algebra_map_eq_zero_field {R A B : Type*} [comm_semiring R] [field A]
  [comm_semiring B] [nontrivial B] [algebra R A] [algebra R B] [algebra A B] [is_scalar_tower R A B]
  {x : A} {p : polynomial R} (h : polynomial.aeval (algebra_map A B x) p = 0) :
  polynomial.aeval x p = 0 :=
aeval_eq_zero_of_aeval_algebra_map_eq_zero R A B (algebra_map A B).injective h

end comm_semiring

end is_scalar_tower

namespace subalgebra

open is_scalar_tower

section comm_semiring

variables (R) {S A} [comm_semiring R] [comm_semiring S] [comm_semiring A]
variables [algebra R S] [algebra S A] [algebra R A] [is_scalar_tower R S A]

@[simp]

end comm_semiring

end subalgebra


-- Conmutatividad_de_la_interseccion.lean
-- Conmutatividad de la intersección.
-- José A. Alonso Jiménez
-- Sevilla, 24 de mayo de 2021
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Demostrar que
--    s ∩ t = t ∩ s
-- ----------------------------------------------------------------------

import data.set.basic
open set

variable {α : Type}
variables s t u : set α

-- 1ª demostración
-- ===============

example : s ∩ t = t ∩ s :=
begin
  ext x,
  simp only [mem_inter_eq],
  split,
  { intro h,
    split,
    { exact h.2, },
    { exact h.1, }},
  { intro h,
    split,
    { exact h.2, },
    { exact h.1, }},
end

-- 2ª demostración
-- ===============

example : s ∩ t = t ∩ s :=
begin
  ext,
  simp only [mem_inter_eq],
  exact ⟨λ h, ⟨h.2, h.1⟩,
         λ h, ⟨h.2, h.1⟩⟩,
end

-- 3ª demostración
-- ===============

example : s ∩ t = t ∩ s :=
begin
  ext,
  exact ⟨λ h, ⟨h.2, h.1⟩,
         λ h, ⟨h.2, h.1⟩⟩,
end

-- 4ª demostración
-- ===============

example : s ∩ t = t ∩ s :=
begin
  ext x,
  simp only [mem_inter_eq],
  split,
  { rintros ⟨xs, xt⟩,
    exact ⟨xt, xs⟩ },
  { rintros ⟨xt, xs⟩,
    exact ⟨xs, xt⟩ },
end

-- 5ª demostración
-- ===============

example : s ∩ t = t ∩ s :=
begin
  ext x,
  exact and.comm,
end

-- 6ª demostración
-- ===============

example : s ∩ t = t ∩ s :=
ext (λ x, and.comm)

-- 7ª demostración
-- ===============

example : s ∩ t = t ∩ s :=
by ext x; simp [and.comm]

-- 8ª demostración
-- ===============

example : s ∩ t = t ∩ s :=
inter_comm s t

-- 9ª demostración
-- ===============

example : s ∩ t = t ∩ s :=
by finish


import tactic.suggest
import tactic.basic

import algebra.group

def sum_simple (f : ℕ → ℕ) : ℕ → ℕ
| 0       := f 0
| n@(m+1) := f n + sum_simple m

def sum_aux : ℕ → (ℕ → ℕ) → ℕ → ℕ
| a f 0       := f 0 + a
| a f n@(m+1) := sum_aux (f n + a) f m

def sum_tail := sum_aux 0

-- def sum_tail₂ : (ℕ → ℕ) → ℕ → ℕ
-- | f 0       := f 0
-- | f n@(m+1) := sum_aux (f n) f m

def idf (x : ℕ) : ℕ := x

#reduce sum_simple idf 4

#print notation @

-- lemma sum_aux_eq (a f n) :
-- sum_aux a f n = a + sum_aux 0 f n :=
-- begin
-- induction n,
-- case nat.zero {
--     rw sum_aux,
--     rw sum_aux,
--     simp,
--     apply add_comm
-- },
-- case nat.succ : m ih {

--     -- simp [ih],

--     sorry
-- }
-- -- induction a,
-- -- case nat.zero {
-- --     simp
-- -- },
-- -- case nat.succ : b ib {
-- --     apply eq.symm,
-- --     rw nat.succ_add,
-- --     rw <-ib,

-- -- }
-- end

theorem sum_eq (f n) : sum_tail f n = sum_simple f n :=
begin
induction n,
case nat.zero {
    refl
},
case nat.succ : m ih {
    rw sum_simple,

    -- apply eq.symm, -- f (m + 1) + sum_simple f m = sum_tail f (nat.succ m)
    -- rw <- ih,
    -- rw sum_tail,
    -- apply eq.symm, -- sum_aux 0 f (nat.succ m) = f (m + 1) + sum_aux 0 f m
    -- rw sum_aux,
    -- rw add_zero, -- sum_aux (f (m + 1)) f m = f (m + 1) + sum_aux 0 f m
    -- simp only [add_zero], --squeez_simp

    conv_rhs {
        rw <- ih,
    },
    rw sum_tail,
    rw sum_aux,
    rw add_zero,

    --tidy?,

    -- trace_simp_set,

    -- suggest
    -- hint
    -- library_search
    -- rw <- sum_tail,
    -- rw ih,
    -- rw <- sum_simple,
    -- conv {
    --     to_rhs,
    --     congr,
    --     skip,

    -- },

    -- simp [sum_simple, sum_tail, ih, sum_aux],
    -- -- rw sum_simple,
    -- -- apply eq.symm,
    -- -- rw <- ih,
    -- -- rw sum_tail,
    -- -- simp [sum_aux],
    -- -- apply eq.symm,

    -- rw sum_tail,
    -- rw sum_aux,
    -- simp,
    -- rw sum_simple,

    -- rw sum_aux,
    -- simp,
    -- rw add_comm,
    -- apply eq.symm,

    sorry
    -- rw <- sum_aux_eq,
}
end
-- | f 0 := sorry
-- | f n@(m+1) := sorry


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

import group_theory.quotient_group
import ring_theory.dedekind_domain

/-!
# The ideal class group

This file defines the ideal class group `class_group R K` of fractional ideals of `R`
inside `A`'s field of fractions `K`.

## Main definitions
 - `to_principal_ideal` sends an invertible `x : K` to an invertible fractional ideal
 - `class_group` is the quotient of invertible fractional ideals modulo `to_principal_ideal.range`
 - `class_group.mk0` sends a nonzero integral ideal in a Dedekind domain to its class

## Main results
 - `class_group.mk0_eq_mk0_iff` shows the equivalence with the "classical" definition,
   where `I ~ J` iff `x I = y J` for `x y ≠ (0 : R)`
-/

variables {R K L : Type*} [comm_ring R]
variables [field K] [field L] [decidable_eq L]
variables [algebra R K] [is_fraction_ring R K]
variables [algebra K L] [finite_dimensional K L]
variables [algebra R L] [is_scalar_tower R K L]

open_locale non_zero_divisors

open is_localization is_fraction_ring fractional_ideal units

section

variables (R K)

/-- `to_principal_ideal R K x` sends `x ≠ 0 : K` to the fractional `R`-ideal generated by `x` -/
@[irreducible]
def to_principal_ideal : Kˣ →* (fractional_ideal R⁰ K)ˣ :=
{ to_fun := λ x,
  ⟨span_singleton _ x,
   span_singleton _ x⁻¹,
   by simp only [span_singleton_one, units.mul_inv', span_singleton_mul_span_singleton],
   by simp only [span_singleton_one, units.inv_mul', span_singleton_mul_span_singleton]⟩,
  map_mul' := λ x y, ext
    (by simp only [units.coe_mk, units.coe_mul, span_singleton_mul_span_singleton]),
  map_one' := ext (by simp only [span_singleton_one, units.coe_mk, units.coe_one]) }

local attribute [semireducible] to_principal_ideal

variables {R K}

@[simp] lemma coe_to_principal_ideal (x : Kˣ) :
  (to_principal_ideal R K x : fractional_ideal R⁰ K) = span_singleton _ x :=
rfl

@[simp] lemma to_principal_ideal_eq_iff {I : (fractional_ideal R⁰ K)ˣ} {x : Kˣ} :
  to_principal_ideal R K x = I ↔ span_singleton R⁰ (x : K) = I :=
units.ext_iff

end

instance principal_ideals.normal : (to_principal_ideal R K).range.normal :=
subgroup.normal_of_comm _

section

variables (R K)

/-- The ideal class group of `R` in a field of fractions `K`
is the group of invertible fractional ideals modulo the principal ideals. -/
@[derive(comm_group)]
def class_group := (fractional_ideal R⁰ K)ˣ ⧸ (to_principal_ideal R K).range

instance : inhabited (class_group R K) := ⟨1⟩

variables {R} [is_domain R]

/-- Send a nonzero integral ideal to an invertible fractional ideal. -/
@[simps]
noncomputable def fractional_ideal.mk0 [is_dedekind_domain R] :
  (ideal R)⁰ →* (fractional_ideal R⁰ K)ˣ :=
{ to_fun := λ I, units.mk0 I ((fractional_ideal.coe_to_fractional_ideal_ne_zero (le_refl R⁰)).mpr
    (mem_non_zero_divisors_iff_ne_zero.mp I.2)),
  map_one' := by simp,
  map_mul' := λ x y, by simp }

/-- Send a nonzero ideal to the corresponding class in the class group. -/
@[simps]
noncomputable def class_group.mk0 [is_dedekind_domain R] :
  (ideal R)⁰ →* class_group R K :=
(quotient_group.mk' _).comp (fractional_ideal.mk0 K)

variables {K}

lemma quotient_group.mk'_eq_mk' {G : Type*} [group G] {N : subgroup G} [hN : N.normal] {x y : G} :
  quotient_group.mk' N x = quotient_group.mk' N y ↔ ∃ z ∈ N, x * z = y :=
(@quotient.eq _ (quotient_group.left_rel _) _ _).trans
  ⟨λ (h : x⁻¹ * y ∈ N), ⟨_, h, by rw [← mul_assoc, mul_right_inv, one_mul]⟩,
   λ ⟨z, z_mem, eq_y⟩,
     by { rw ← eq_y, show x⁻¹ * (x * z) ∈ N, rwa [← mul_assoc, mul_left_inv, one_mul] }⟩

lemma class_group.mk0_eq_mk0_iff_exists_fraction_ring [is_dedekind_domain R] {I J : (ideal R)⁰} :
  class_group.mk0 K I = class_group.mk0 K J ↔
    ∃ (x ≠ (0 : K)), span_singleton R⁰ x * I = J :=
begin
  simp only [class_group.mk0, monoid_hom.comp_apply, quotient_group.mk'_eq_mk'],
  split,
  { rintros ⟨_, ⟨x, rfl⟩, hx⟩,
    refine ⟨x, x.ne_zero, _⟩,
    simpa only [mul_comm, coe_mk0, monoid_hom.to_fun_eq_coe, coe_to_principal_ideal, units.coe_mul]
      using congr_arg (coe : _ → fractional_ideal R⁰ K) hx },
  { rintros ⟨x, hx, eq_J⟩,
    refine ⟨_, ⟨units.mk0 x hx, rfl⟩, units.ext _⟩,
    simpa only [fractional_ideal.mk0_apply, units.coe_mk0, mul_comm, coe_to_principal_ideal,
        coe_coe, units.coe_mul] using eq_J }
end

lemma class_group.mk0_eq_mk0_iff [is_dedekind_domain R] {I J : (ideal R)⁰} :
  class_group.mk0 K I = class_group.mk0 K J ↔
    ∃ (x y : R) (hx : x ≠ 0) (hy : y ≠ 0), ideal.span {x} * (I : ideal R) = ideal.span {y} * J :=
begin
  refine class_group.mk0_eq_mk0_iff_exists_fraction_ring.trans ⟨_, _⟩,
  { rintros ⟨z, hz, h⟩,
    obtain ⟨x, ⟨y, hy⟩, rfl⟩ := is_localization.mk'_surjective R⁰ z,
    refine ⟨x, y, _, mem_non_zero_divisors_iff_ne_zero.mp hy, _⟩,
    { rintro hx, apply hz,
      rw [hx, is_fraction_ring.mk'_eq_div, (algebra_map R K).map_zero, zero_div] },
    { exact (fractional_ideal.mk'_mul_coe_ideal_eq_coe_ideal K hy).mp h } },
  { rintros ⟨x, y, hx, hy, h⟩,
    have hy' : y ∈ R⁰ := mem_non_zero_divisors_iff_ne_zero.mpr hy,
    refine ⟨is_localization.mk' K x ⟨y, hy'⟩, _, _⟩,
    { contrapose! hx,
      rwa [is_localization.mk'_eq_iff_eq_mul, zero_mul, ← (algebra_map R K).map_zero,
           (is_fraction_ring.injective R K).eq_iff] at hx },
    { exact (fractional_ideal.mk'_mul_coe_ideal_eq_coe_ideal K hy').mpr h } },
end

lemma class_group.mk0_surjective [is_dedekind_domain R] :
  function.surjective (class_group.mk0 K : (ideal R)⁰ → class_group R K) :=
begin
  rintros ⟨I⟩,
  obtain ⟨a, a_ne_zero', ha⟩ := I.1.2,
  have a_ne_zero := mem_non_zero_divisors_iff_ne_zero.mp a_ne_zero',
  have fa_ne_zero : (algebra_map R K) a ≠ 0 :=
    is_fraction_ring.to_map_ne_zero_of_mem_non_zero_divisors a_ne_zero',
  refine ⟨⟨{ carrier := { x | (algebra_map R K a)⁻¹ * algebra_map R K x ∈ I.1 }, .. }, _⟩, _⟩,
  { simp only [ring_hom.map_zero, set.mem_set_of_eq, mul_zero, ring_hom.map_mul],
    exact submodule.zero_mem I },
  { simp only [ring_hom.map_add, set.mem_set_of_eq, mul_zero, ring_hom.map_mul, mul_add],
    exact λ _ _ ha hb, submodule.add_mem I ha hb },
  { intros c _ hb,
    simp only [smul_eq_mul, set.mem_set_of_eq, mul_zero, ring_hom.map_mul, mul_add,
               mul_left_comm ((algebra_map R K) a)⁻¹],
    rw ← algebra.smul_def c,
    exact submodule.smul_mem I c hb },
  { rw [mem_non_zero_divisors_iff_ne_zero, submodule.zero_eq_bot, submodule.ne_bot_iff],
    obtain ⟨x, x_ne, x_mem⟩ := exists_ne_zero_mem_is_integer I.ne_zero,
    refine ⟨a * x, _, mul_ne_zero a_ne_zero x_ne⟩,
    change ((algebra_map R K) a)⁻¹ * (algebra_map R K) (a * x) ∈ I.1,
    rwa [ring_hom.map_mul, ← mul_assoc, inv_mul_cancel fa_ne_zero, one_mul] },
  { symmetry,
    apply quotient.sound,
    refine ⟨units.mk0 (algebra_map R K a) fa_ne_zero, _⟩,
    apply @mul_left_cancel _ _ I,
    rw [← mul_assoc, mul_right_inv, one_mul, eq_comm, mul_comm I],
    apply units.ext,
    simp only [monoid_hom.coe_mk, subtype.coe_mk, ring_hom.map_mul, coe_coe,
               units.coe_mul, coe_to_principal_ideal, coe_mk0,
               fractional_ideal.eq_span_singleton_mul],
    split,
    { intros zJ' hzJ',
      obtain ⟨zJ, hzJ : (algebra_map R K a)⁻¹ * algebra_map R K zJ ∈ ↑I, rfl⟩ :=
        (mem_coe_ideal R⁰).mp hzJ',
      refine ⟨_, hzJ, _⟩,
      rw [← mul_assoc, mul_inv_cancel fa_ne_zero, one_mul] },
    { intros zI' hzI',
      obtain ⟨y, hy⟩ := ha zI' hzI',
      rw [← algebra.smul_def, fractional_ideal.mk0_apply, coe_mk0, coe_coe, mem_coe_ideal],
      refine ⟨y, _, hy⟩,
      show (algebra_map R K a)⁻¹ * algebra_map R K y ∈ (I : fractional_ideal R⁰ K),
      rwa [hy, algebra.smul_def, ← mul_assoc, inv_mul_cancel fa_ne_zero, one_mul] } }
end

end

lemma class_group.mk_eq_one_iff
  {I : (fractional_ideal R⁰ K)ˣ} :
  quotient_group.mk' (to_principal_ideal R K).range I = 1 ↔
    (I : submodule R K).is_principal :=
begin
  rw [← (quotient_group.mk' _).map_one, eq_comm, quotient_group.mk'_eq_mk'],
  simp only [exists_prop, one_mul, exists_eq_right, to_principal_ideal_eq_iff,
             monoid_hom.mem_range, coe_coe],
  refine ⟨λ ⟨x, hx⟩, ⟨⟨x, by rw [← hx, coe_span_singleton]⟩⟩, _⟩,
  unfreezingI { intros hI },
  obtain ⟨x, hx⟩ := @submodule.is_principal.principal _ _ _ _ _ _ hI,
  have hx' : (I : fractional_ideal R⁰ K) = span_singleton R⁰ x,
  { apply subtype.coe_injective, rw [hx, coe_span_singleton] },
  refine ⟨units.mk0 x _, _⟩,
  { intro x_eq, apply units.ne_zero I, simp [hx', x_eq] },
  simp [hx']
end

variables [is_domain R]

lemma class_group.mk0_eq_one_iff [is_dedekind_domain R]
  {I : ideal R} (hI : I ∈ (ideal R)⁰) :
  class_group.mk0 K ⟨I, hI⟩ = 1 ↔ I.is_principal :=
class_group.mk_eq_one_iff.trans (coe_submodule_is_principal R K)

/-- The class group of principal ideal domain is finite (in fact a singleton).
TODO: generalize to Dedekind domains -/
instance [is_principal_ideal_ring R] :
  fintype (class_group R K) :=
{ elems := {1},
  complete :=
  begin
    rintros ⟨I⟩,
    rw [finset.mem_singleton],
    exact class_group.mk_eq_one_iff.mpr (I : fractional_ideal R⁰ K).is_principal
  end }

/-- The class number of a principal ideal domain is `1`. -/
lemma card_class_group_eq_one [is_principal_ideal_ring R] :
  fintype.card (class_group R K) = 1 :=
begin
  rw fintype.card_eq_one_iff,
  use 1,
  rintros ⟨I⟩,
  exact class_group.mk_eq_one_iff.mpr (I : fractional_ideal R⁰ K).is_principal
end

/-- The class number is `1` iff the ring of integers is a principal ideal domain. -/
lemma card_class_group_eq_one_iff [is_dedekind_domain R] [fintype (class_group R K)] :
  fintype.card (class_group R K) = 1 ↔ is_principal_ideal_ring R :=
begin
  split, swap, { introsI, convert card_class_group_eq_one, assumption, assumption, },
  rw fintype.card_eq_one_iff,
  rintros ⟨I, hI⟩,
  have eq_one : ∀ J : class_group R K, J = 1 := λ J, trans (hI J) (hI 1).symm,
  refine ⟨λ I, _⟩,
  by_cases hI : I = ⊥,
  { rw hI, exact bot_is_principal },
  exact (class_group.mk0_eq_one_iff (mem_non_zero_divisors_iff_ne_zero.mpr hI)).mp (eq_one _),
end


variable U: Type
variable P: U -> Prop
variable z: U

premise P1 : forall x, P(x)

example : exists y, P(y) :=
have H: P(z), from P1 z,
exists.intro z H.


import algebra.continued_fractions
import data.real.basic
import algebra.continued_fractions.convergents_equiv
import tactic.unfold_cases

open generalized_continued_fraction as gcf

-- 1. Skriv ut theorem för \R
--     1. använd convergents'

-- `sum_prod a_k n` = ∑_{i=1}^{n} (∏_{j=1}^{i} a_j)
def sum_prod {K : Type*} [semiring K] (A : seq K) (n : ℕ) : K := ((list.range n).map (λ (i : ℕ), (A.take (i+1)).prod ) ).sum

theorem cons_take_eq_take_cons
{X : Type*}
(a : X)
(A : seq X)
(i : ℕ)
: (A.cons a).take (i+1) = (A.take i).cons a
:= begin
	unfold seq.take,
	rw seq.destruct_cons a,
	have hue : seq.take._match_1 (seq.take i) (some (a, A)) = list.cons a (seq.take i A) := rfl,
	rw hue,
end

/-
  Extract the first value from a sum of products
  Σ_{i=0}^{A.length-1} Π_{j=0}^{i} A.nth j
-/
theorem sum_prod_list_tail
{K : Type*} [semiring K]
(a : K)
(A : list K)
: ((list.range (a :: A).length).map (λ (i : ℕ), ((a :: A).take (i+1)).prod ) ).sum = a + a * ((list.range A.length).map (λ (i : ℕ), (A.take (i+1)).prod )).sum
:= begin
	let f := (λ i, (A.take i).prod ),
	calc  ((list.range (a :: A).length).map (λ i, ((a :: A).take (i+1)).prod ) ).sum
      = ((list.range (a :: A).length).map (λ i, a * f i ) ).sum                     : by finish
  ... = a * ((list.range (a :: A).length).map f ).sum                               : list.sum_map_mul_left (list.range (a :: A).length) f a
  ... = a * ((list.range (A.length + 1) ).map f ).sum                               : rfl
	... = a * ((list.cons 0 ((list.range A.length).map (nat.succ))).map f).sum        : by rw list.range_succ_eq_map A.length
	... = a * (list.cons (f 0) (((list.range A.length).map (nat.succ)).map f)).sum    : rfl
	... = a * (list.cons (f 0) ((list.range A.length).map (λ i, f (i+1) ))).sum       : by rw list.map_map f nat.succ (list.range A.length)
	... = a * (list.cons 1 ((list.range A.length).map (λ i, f (i+1) ))).sum           : rfl
	... = a*1 + a*(((list.range A.length).map (λ i, f (i+1) ))).sum                   : by { rw list.sum_cons, exact mul_add a 1 _}
	... = a   + a*(((list.range A.length).map (λ i, f (i+1) ))).sum                   : by rw mul_one a
end

theorem sum_prod_tail
{K : Type*} [semiring  K]
(A : seq K)
(a : K)
(n : ℕ)
: sum_prod (seq.cons a A) (n+1) = a + a * sum_prod A n
:= begin
	let f := (λ i, (A.take i).prod ),
	calc sum_prod (A.cons a) (n+1)
		= ((list.range (n+1)).map (λ i, ((A.cons a).take (i+1)).prod ) ).sum    : rfl
	... = ((list.range (n+1)).map (λ i, ((A.take i).cons a).prod ) ).sum        : by {  congr,
																						refine funext _,
																						intro nn,
																						exact congr rfl (cons_take_eq_take_cons a A nn), }
	... = ((list.range (n+1)).map (λ i, a * f i)).sum                           : by {  congr,
																						refine funext _,
																						intro _,
																						exact list.prod_cons, }
	... = a * ((list.range (n+1)).map f).sum                                    : list.sum_map_mul_left (list.range (n+1)) f a
	... = a * ((list.cons 0 ((list.range n).map (nat.succ))).map f).sum         : by rw list.range_succ_eq_map n
	... = a * (list.cons (f 0) (((list.range n).map (nat.succ)).map f) ).sum    : rfl
	... = a * (list.cons (f 0) (((list.range n)).map (λ i, f (i+1) )) ).sum     : by rw (list.map_map f nat.succ (list.range n))
	... = a * (list.cons 1 (((list.range n)).map (λ i, f (i+1) )) ).sum         : rfl
	... = a * (1 + (((list.range n)).map (λ i, f (i+1) ) ).sum)                 : by rw list.sum_cons
	... = a*1 + (a * (((list.range n)).map (λ i, f (i+1) ) ).sum)               : mul_add a 1 ((list.range n).map (λ i, (A.take (i+1)).prod)).sum
	... = a +   (a * (((list.range n)).map (λ i, f (i+1) ) ).sum)               : by rw mul_one a
end

def simple_part
{X : Type*} [division_ring X]
(A : seq X)
: gcf X
:= ⟨0, A.map (λ ai, ⟨-ai, 1 + ai⟩ )⟩

@[simp]
theorem simple_part_h
{X : Type*} [division_ring X]
(A : seq X)
: (simple_part A).h = 0
:= rfl

@[simp]
theorem simple_part_s
{X : Type*} [division_ring X]
(A : seq X)
: (simple_part A).s = A.map (λ ai, ⟨-ai, 1 + ai⟩ )
:= rfl

def gcf_cons
{X : Type*}
(p : gcf.pair X)
(A : gcf X)
: gcf X := ⟨A.h, seq.cons p A.s⟩

theorem gcf_cons_def
{X : Type*}
(p : gcf.pair X)
(A : gcf X)
: gcf_cons p A = ⟨A.h, seq.cons p A.s⟩
:= rfl

@[simp]
theorem gcf_cons_ignore_int
{X : Type*}
(p : gcf.pair X)
(A : gcf X)
: (gcf_cons p A).h = A.h
:= rfl

@[simp]
theorem gcf_cons_eq_seq_cons
{X : Type*}
(p : gcf.pair X)
(A : gcf X)
: (gcf_cons p A).s = seq.cons p A.s
:= rfl

-- TODO: Är det här rätt definition? Vad händer om det är en väldigt kort sekvens?
-- ⟨a0, 1⟩ ⟨-a1, 1+a1⟩ ⟨-a2, 1+a2⟩...
def rhs_euler
{X : Type*} [division_ring X]
(A : seq X) : gcf X
:= begin
	let splitted := seq.split_at 1 A,
	let head     := splitted.1.map (λ (a0 : X), gcf.pair.mk a0 1),
	let head_seq := seq.of_list head,
	let tail     := splitted.2.map (λ (ai : X), gcf.pair.mk (-ai) (1+ai)),
	let joined   := seq.append head_seq tail,
	exact ⟨0,joined⟩,
end

-- def map_head
-- {X Y : Type*}
-- (f_head f : X → Y)
-- (A : seq X)
-- : seq Y
-- := seq.zip_with (λ(n : ℕ) (x : X), ite (n = 0) (f_head x) (f x)) seq.nats A

/- Apply one function to the head of the list and one function to the rest-/
def map_head
{X Y : Type*}
(f_head f : X → Y)
(A : seq X)
: seq Y
:= option.get_or_else (option.map ((λ (a : seq1 X), seq1.to_seq ((f_head a.1, a.2.map f)))) (seq.destruct A)) seq.nil

theorem option_get_or_else_dist
{X Y: Type*}
(e : X)
(t : option X)
(f : X → Y)
: f (option.get_or_else t e) = option.get_or_else (t.map f) (f e)
:= begin
  cases t,
  rw option.map_none',
  exact rfl,
  simp only [option.get_or_else_some, option.map_some', eq_self_iff_true],
end

theorem seq_1_to_seq_tail
{X : Type*}
(a : X)
(A : seq X)
: (seq1.to_seq (a, A)).tail = A
:= seq.tail_cons a A

@[simp]
theorem map_head_tail_eq_map'
{X Y : Type*}
(f_head f : X → Y)
(A : seq X)
: (map_head f_head f A).tail = A.tail.map f
:= begin
  unfold map_head,
  rw option_get_or_else_dist seq.nil _ seq.tail,
  simp only [option.map_map, seq.map_tail, seq.tail_nil],
  rw function.comp,
  conv in (λ (a : seq1 X), (seq1.to_seq (f_head a.fst, seq.map f a.snd)).tail)
  { funext, rw seq_1_to_seq_tail _ _, skip, },
  classical,
  cases decidable.em (A.destruct = none) with hn hs,
  { rw hn,
    rw seq.destruct_eq_nil hn,
    simp only [seq.map_nil, seq.tail_nil, option.map_none'],
    exact rfl, },
  { have a_tail_zero_some : ↥(option.is_some (A.destruct)) := option.ne_none_iff_is_some.mp hs,
    let dest := option.get a_tail_zero_some,
    have A_destruct_eq_some_dest : A.destruct = some dest := (option.some_get a_tail_zero_some).symm,
    rw A_destruct_eq_some_dest,
    have huehue : option.map (λ (a : seq1 X), seq.map f a.snd) (some dest) = some ((λ (a : seq1 X), seq.map f a.snd) dest) := rfl,
    rw huehue,
    simp,
    have A_destruct_split : A.destruct = some (dest.1, dest.2) := by {rw A_destruct_eq_some_dest, refine congr rfl _, exact prod.ext rfl rfl},
    have A_tail_eq_dest := congr_arg seq.tail (seq.destruct_eq_cons A_destruct_split),
    simp at A_tail_eq_dest,
    rw A_tail_eq_dest.symm,
    exact seq.map_tail f A, }
end

@[simp]
theorem map_head_head_eq_map'
{X Y : Type*}
(f_head f : X → Y)
(A : seq X)
: (map_head f_head f A).head = A.head.map f_head
:= begin
  unfold map_head,
  rw option_get_or_else_dist seq.nil _ seq.head,
  simp,
  sorry,
end

/-- Extracts the first term of a continued fraction -/
@[simp]
theorem cons_convergents'_eq_div_plus_convergents'
{K : Type*} [division_ring K]
(a b : K)
(A : gcf K)
{h : A.h = 0}
(n : ℕ)
: (gcf_cons (gcf.pair.mk a b) A).convergents' (n+1) = (a / (b + A.convergents' n))
:= begin
	unfold gcf_cons at *,
	unfold gcf.convergents' at *,
	rw h,
	simp,
	unfold gcf.convergents'_aux,
	simp,
	unfold gcf.convergents'_aux._match_1,
end

@[simp]
theorem nilling
(X : Type*)
: seq.split_at 1 seq.nil = ⟨[], (seq.nil : seq X)⟩
:= rfl

theorem split_at_one_cons_snd_eq_id
{X : Type*} [division_ring X]
(A : seq X)
(a : X)
: (seq.split_at 1 (seq.cons a A)).snd = A
:= begin
	unfold seq.split_at,
	rw seq.destruct_cons,
	exact rfl,
end

theorem split_at_one_cons_fst_eq_cons
{X : Type*} [division_ring X]
(A : seq X)
(a : X)
: (seq.split_at 1 (seq.cons a A)).fst = [a]
:= begin
	unfold seq.split_at,
	rw seq.destruct_cons,
	exact rfl,
end

theorem rhs_euler_eq
{X : Type*} [division_ring X]
(A : seq X)
(a : X)
(n : ℕ)
: (rhs_euler (seq.cons a A)).convergents' n.succ = a / ( 1 + (simple_part A).convergents' n)
:= begin
	rw ←cons_convergents'_eq_div_plus_convergents',
	rw gcf_cons_def,
	congr,
	unfold rhs_euler,
	simp only [],
	split,
	exact rfl,
	rw simple_part_s,
	rw split_at_one_cons_snd_eq_id,
	rw split_at_one_cons_fst_eq_cons,
	simp,
	exact simple_part_h A,
end

theorem rhs_euler_nil
{X : Type*} [division_ring X]
: rhs_euler (seq.nil : seq X) = ⟨0, seq.nil⟩
:= begin
	unfold rhs_euler,
	simp only [seq.append_nil, list.map_nil, nilling, eq_self_iff_true, seq.map_nil, and_self, seq.of_list_nil],
end

@[simp]
theorem seq_map_head
{A B : Type*}
(S : seq A)
(f : A → B)
(nth_zero_some:  (↥((S.nth 0).is_some) : Prop))
: option.map f S.head = some (f (option.get nth_zero_some))
:= begin
	have nth_zero_eq_head : S.nth 0 = S.head := rfl,
	rw nth_zero_eq_head at nth_zero_some,
	have dkkdk  : S.head = some (option.get nth_zero_some) := by norm_num,
	have duedue : option.map f (some (option.get nth_zero_some)) = some (f (option.get nth_zero_some)) := rfl,
	rw dkkdk,
	exact duedue,
end

theorem sub_div_suc_ne_sub_one
{X : Type*} [division_ring X] (a : X)
: -a / (1 + a) ≠ -1 := begin
	classical,
	rw neg_div (1 + a) a,
	refine function.injective.ne neg_injective _,
	by_contra h,
	simp only [not_not, ne.def] at h,
	have gkgk : a - a = 1 + a - a := congr (congr_arg has_sub.sub (eq_of_div_eq_one h)) rfl,
	rw [add_sub_assoc 1 a a, sub_self a, add_zero (1 : X)] at gkgk,
	exact zero_ne_one gkgk,
end

theorem jdjdjd
{X : Type*} [division_ring X]
: (0 : X) ≠ 1
:= zero_ne_one

theorem hueheeuh2
{X : Type*} [division_ring X]
(a b : X)
: a ≠ b → -a ≠ -b
:= begin
	intro k,
	exact function.injective.ne neg_injective k,
end

theorem add_to_denom_of_succ_ne_sub_one
{X : Type*} [division_ring X]
(a b : X)
(h : b ≠ -1)
: -a / (1 + a + b) ≠ -1
:= begin
	rw neg_div (1 + a + b) a,
	apply hueheeuh2,
	classical,
	cases decidable.em ((1 + a + b) = 0),
	rw [h_1, div_zero a],
	exact zero_ne_one,
	by_contradiction wack,
	rw not_not at wack,
	have huehu := (div_eq_one_iff_eq h_1).mp wack,
	rw [add_comm 1 a, add_assoc a 1 b] at huehu,
	have nexter : (1 + b) = 0 := self_eq_add_right.mp huehu,
	rw [add_comm 1 b, ←sub_neg_eq_add b 1] at nexter,
	exact h (sub_eq_zero.mp nexter),
end

--theorem rhs_euler_eq

theorem simple_convergents_ne_sub_one
{X : Type*} [division_ring X]
(A : seq X)
(n : ℕ)
(h_in : A.nth n ≠ none)
: (simple_part A).convergents' n ≠ -1
:= begin
	induction n with h hd generalizing A,
	{ unfold simple_part,
		simp only [ gcf.zeroth_convergent'_eq_h,
					ne.def,
					not_false_iff,
					one_ne_zero,
					zero_eq_neg ], },
	{ have a_zero_some : ↥(option.is_some (A.nth 0)) := option.ne_none_iff_is_some.mp (mt (seq.le_stable A bot_le) h_in),
		let a0 := option.get a_zero_some,
		have cons_adder := seq.destruct_eq_cons (seq_map_head A (λ a', (a', A.tail)) a_zero_some),
		unfold simple_part,
		rw cons_adder,
		simp only [seq.map_tail, seq.map_cons],
		let f := (λ (ai : X), gcf.pair.mk (-ai) (1 + ai)),
		let thing : gcf X := ⟨0, (seq.map f A).tail⟩,
		rw ←gcf_cons_def (gcf.pair.mk (-a0) (1 + a0)) thing,
		have kkkk: thing.h = 0 := rfl,
		rw @cons_convergents'_eq_div_plus_convergents' _ _ _ _ _ kkkk _,
		have back_again : thing = simple_part A.tail := by { unfold simple_part, rw (seq.map_tail f A), },
		rw back_again,
		have A_tail_nth_ne_none : A.tail.nth h ≠ none := by {rw (seq.nth_tail A h), exact h_in},
		exact add_to_denom_of_succ_ne_sub_one a0 ((simple_part A.tail).convergents' h) (hd A.tail A_tail_nth_ne_none), }
end

-- gcf.convergents'_aux._match_1 0 (seq.map (λ (ai : ℝ), {a := -ai, b := 1 + ai}) A).head

#check gcf.convergents'_aux._match_1

theorem seq_map_eq_list_map
(X Y : Type*) [division_ring X]
(f : X -> Y)
(A : seq ( gcf.pair X))
(n : ℕ)
(h1 : (A.nth 0) ≠ none )
(h2 : (A.nth 1) ≠ none )
: gcf.convergents'_aux A 1 = (option.get (option.ne_none_iff_is_some.mp h1)).a / (option.get (option.ne_none_iff_is_some.mp h1)).b
:= sorry
-- theorem test1
-- (a b : Prop)
-- : (a -> b) -> (¬b -> ¬a)
-- := begin
--     library_search,
-- end

-- theorem euler_b
-- (A : seq ℝ)
-- (n : ℕ)
-- (h : A.nth n ≠ none)
-- :  ≠ -1
-- := begin
--     induction n with h hd,
--     unfold rhs_euler,
--     simp,
--     induction h with h2 hd2,
--     unfold rhs_euler,
--     simp,

-- end

-- The rhs has a singularity at x = -1 -a. If it was set to 0 at that point, both sides would be equal then x ≠ -1
theorem move_divs
{X : Type*} [division_ring X]
(a x : X)
(h1 : x ≠ -1)
(h2 : x ≠ -1 - a)
: (1 / (1 + (-a / (1 + a + x)))) = 1 + (a / (1 + x))
:= begin
	classical,
	have yepp : (1 + a + x) ≠ 0 := begin
		by_contradiction,
		rw not_not at h,
		have mumu: x = -(1+a) := (neg_eq_of_add_eq_zero h).symm,
		rw neg_add' 1 a at mumu,
		exact h1 (absurd mumu h2),
	end,
	have yepp2 : 1 + x ≠ 0 := begin
		by_contradiction,
		rw not_not at h,
		have mumu: x = -1 := (neg_eq_of_add_eq_zero h).symm,
		exact h1 mumu,
	end,
	calc 1 / (1 + (-a / (1 + a + x)))
		= 1 / ((1 + a + x)/(1 + a + x) + (-a / (1 + a + x))) : by {congr, exact (div_self yepp).symm,}
	... = 1 / ((1 + a + x + -a) / (1 + a + x))             : by rw div_add_div_same (1 + a + x) (-a) (1 + a + x)
	... = 1 / ((1 + a + -a + x) / (1 + a + x))             : by rw add_right_comm (1 + a) x (-a)
	... = 1 / ((1 + x) / (1 + a + x))                      : by rw add_neg_eq_of_eq_add rfl
	... = (1 + a + x) / (1 + x)                            : one_div_div (1 + x) (1 + a + x)
	... = (1 + x + a) / (1 + x)                            : by rw add_right_comm 1 x a
	... = ((1 + x) / (1 + x)) + (a / (1 + x))              : add_div (1 + x) a (1 + x)
	... = 1 + (a / (1 + x))                                : by rw div_self yepp2
end

/-
This is **Euler's Continued Fraction Formula**.
We have `h2` to avoid division in the continued fraction. These are normally
ignored. If you treat the continued fraction as a function then it can be
extended to ignore the singularities. These issues can't be ignored when
formalizing.
-/

theorem euler_cff
{X : Type*} [division_ring X]
(A : seq X)
(n : ℕ)
(h : A.nth n ≠ none)
(h2 : ∀ n1, n1 < n → 1 ≤ n1 → some ((simple_part (A.drop n1.succ)).convergents' (n-(n1.succ))) ≠ (A.nth n1).map (λ an1, -(1 + an1)) )
: sum_prod A n = (rhs_euler A).convergents' n
:= begin
	induction n with hi hdi generalizing A,
	{ unfold sum_prod,
		unfold rhs_euler,
		simp only [ list.sum_nil,
					nat.nat_zero_eq_zero,
					list.map_nil,
					eq_self_iff_true,
					gcf.zeroth_convergent'_eq_h,
					list.range_zero ], },
	{ have A_tail_nth_ne_none      : A.tail.nth hi ≠ none             := by { rw seq.nth_tail A hi, exact h, },
		have A_tail_nth_zero_ne_none : A.tail.nth 0 ≠ none              := mt (seq.le_stable A.tail (bot_le)) A_tail_nth_ne_none,
		have a_tail_zero_some        : ↥(option.is_some (A.tail.nth 0)) := option.ne_none_iff_is_some.mp A_tail_nth_zero_ne_none,
		have thingy3                 : A.nth 0 ≠ none                   := mt (seq.le_stable A (bot_le)) h,
		have a_zero_some             : ↥(option.is_some (A.nth 0))      := option.ne_none_iff_is_some.mp thingy3,
		have cons_adder                                                 := seq.destruct_eq_cons (seq_map_head A (λ a', (a', A.tail)) a_zero_some),
		set a0 := option.get a_zero_some,
		set a1 := option.get a_tail_zero_some,
		induction hi with hi hi2,
		{
			unfold sum_prod,
			unfold rhs_euler,
			have yepp: list.range 1 = [0] := rfl,
			rw yepp,
			simp,
			rw cons_adder,
			rw split_at_one_cons_fst_eq_cons,
			rw split_at_one_cons_snd_eq_id,
			have yepping : seq.take 1 (seq.cons a0 A.tail) = [a0] := begin
				rw cons_take_eq_take_cons a0 A.tail 0,
				simp only [true_and, eq_self_iff_true],
				exact rfl,
			end,
			rw yepping,
			simp only [ seq.nil_append,
						mul_one,
						list.map.equations._eqn_2,
						seq.map_tail,
						seq.cons_append,
						list.map_nil,
						list.prod_cons,
						list.prod_nil,
						seq.of_list_nil,
						seq.of_list_cons    ],
			rw ←gcf_cons_def ⟨a0, 1⟩ ⟨0, (seq.map (λ (ai : X), gcf.pair.mk (-ai) (1 + ai)) A).tail⟩,
			rw cons_convergents'_eq_div_plus_convergents' _ _ _,
			simp only [add_zero, eq_self_iff_true, generalized_continued_fraction.zeroth_convergent'_eq_h, div_one],
		},
		{

			have cons_adder_two : A.tail = (seq.cons a1 A.tail.tail) := seq.destruct_eq_cons (seq_map_head A.tail (λ a', (a', A.tail.tail)) a_tail_zero_some),

			have gotem := hdi A.tail A_tail_nth_ne_none _,

			have fkfkfk : A.tail.tail.nth hi ≠ none := by {rw seq.nth_tail _ _, exact A_tail_nth_ne_none,},

			calc sum_prod A hi.succ.succ
				= sum_prod (A.tail.cons a0) hi.succ.succ                                          : by nth_rewrite 0 cons_adder
			... = a0 + a0 * sum_prod A.tail hi.succ                                             : sum_prod_tail (A.tail) a0 hi.succ
			... = a0 + a0 * ((rhs_euler A.tail).convergents' hi.succ)                           : by rw gotem
			... = a0 * 1 + a0 * ((rhs_euler A.tail).convergents' hi.succ)                       : by rw mul_one a0
			... = a0 * (1 + ((rhs_euler A.tail).convergents' hi.succ))                          : by rw (mul_add a0 1 _).symm
			... = a0 * (1 + ((rhs_euler (seq.cons a1 A.tail.tail)).convergents' hi.succ))       : by {  congr,  exact cons_adder_two, }
			... = a0 * (1 + (a1 / ( 1 + (simple_part A.tail.tail).convergents' hi)))            : by {  congr, exact (rhs_euler_eq A.tail.tail a1 hi),}
			... = a0 * (1 /(1 + (-a1 / ( 1 + a1 + (simple_part A.tail.tail).convergents' hi)))) : by {  congr,
                                                                                have kdkdkdk := (move_divs a1 ((simple_part A.tail.tail).convergents' hi) _ _).symm,
                                                                                exact kdkdkdk,
                                                                                have kkkkk := simple_convergents_ne_sub_one A.tail.tail hi,
                                                                                exact kkkkk fkfkfk,
                                                                                simp only [ nat.succ_sub_succ_eq_sub,
                                                                                seq.drop.equations._eqn_1,
                                                                                ne.def,
                                                                                nat.sub_zero,
                                                                                seq.drop.equations._eqn_2],
                                                                                have from_hyp : some ((simple_part A.tail.tail).convergents' hi) ≠ option.map (λ (an1 : X), -(1 + an1)) (A.nth 1) := h2 1 _ rfl.ge,
                                                                                have to_tail: (A.nth 1) = A.tail.nth 0 := (seq.nth_tail A 0).symm,
                                                                                have a1er : option.get a_tail_zero_some = a1 := rfl,
                                                                                rw [  to_tail,
                                                                                (option.some_get a_tail_zero_some).symm,
                                                                                a1er,
                                                                                option.map_some',
                                                                                neg_add] at from_hyp,
                                                                                apply ne_of_apply_ne some,
                                                                                rw (sub_eq_add_neg (-1) a1).symm at from_hyp,
                                                                                exact from_hyp,
                                                                                exact (cmp_eq_lt_iff 1 (nat.succ hi).succ).mp rfl, }
			... = a0 * (1 / (1 + (simple_part A.tail).convergents' hi.succ))                    : by {  congr,
                                                                                have kdkdkd := (cons_convergents'_eq_div_plus_convergents' (-a1) (1 + a1) (simple_part A.tail.tail) hi).symm,
                                                                                unfold simple_part at kdkdkd,
                                                                                rw gcf_cons_def _ _ at kdkdkd,
                                                                                simp at kdkdkd,
                                                                                set f := (λ (ai : X), (⟨-ai, 1 + ai⟩  : gcf.pair X)),
                                                                                have bring_in_tail := eq.symm (seq.map_tail f A),
                                                                                rw (seq.map_tail f A     ).symm at kdkdkd,
                                                                                rw (seq.map_tail f A.tail).symm at kdkdkd,
                                                                                rw (seq.map_cons f a1 A.tail.tail).symm at kdkdkd,
                                                                                rw cons_adder_two.symm at kdkdkd,
                                                                                exact kdkdkd,
                                                                                exact rfl, }
			... = (a0*1) / (1 + (simple_part A.tail).convergents' hi.succ)                      : by rw mul_div_assoc' a0 1 _
			... = a0 / (1 + (simple_part A.tail).convergents' hi.succ)                          : by rw mul_one a0
			... = (rhs_euler (seq.cons a0 A.tail)).convergents' hi.succ.succ                    : (rhs_euler_eq A.tail a0 hi.succ).symm
			... = (rhs_euler A).convergents' hi.succ.succ                                       : by rw eq.symm cons_adder,
			{ intros nn nn_lt_hi_succ nn_le_one,
        have fone : nn + 1 < hi.succ.succ := nat.lt_succ_iff.mpr nn_lt_hi_succ,
        have ftwo : 1 ≤ nn + 1 := nat.lt.step nn_le_one,
        have nicer := h2 (nn + 1) fone ftwo,
        rw (seq.dropn_tail A (nn+1)).symm at nicer,
        have kdkdkdk : hi.succ.succ - (nn + 1).succ = hi.succ - nn.succ := by norm_num,
        rw kdkdkdk at nicer,
        rw (seq.nth_tail A nn).symm at nicer,
        exact nicer,  } },},

end

def map_head_list
{X Y: Type*}
(f_head f : X → Y)
(A : list X)
: list Y
:= A.map_with_index (λ i x, ite (i = 0) (f_head x) (f x))

@[simp]
theorem map_head_list_tail_eq_map
{X Y : Type*}
(f_head f : X → Y)
(A : list X)
: (map_head_list f_head f A).tail = A.tail.map f
:= sorry

theorem euler_cff_list
{X : Type*} [division_ring X]
(A : list X)
(h2 : ∀ n1 (h : n1 < A.length), 1 ≤ n1
  → ((⟨0, (A.drop n1.succ).map (λ (ai : X), gcf.pair.mk (-ai) (1+ai)) ⟩ : gcf X ).convergents' (A.length-(n1.succ)))
      ≠ (λ (an1 : X), -(1 + an1)) (A.nth_le n1 h))
: ((list.range A.length).map (λ (i : ℕ), (A.take (i+1)).prod ) ).sum = (⟨0, (map_head_list (λ (a0 : X), gcf.pair.mk a0 1) (λ ai, gcf.pair.mk (-ai) (1 + ai) ) A)⟩ : gcf X ).convergents' A.length
:= sorry

-- This should be the easiest to work with. Most lists are longer than 1.
-- TODO: Should you just have a hypothesis of `0 < A.length`?
theorem euler_cff_list_cons
{X : Type*} [division_ring X]
(A : list X)
(a : X)
(h2 : ∀ n1 (h : n1 < (a :: A).length), 1 ≤ n1
  → ((⟨0, ((a :: A).drop n1.succ).map (λ (ai : X), gcf.pair.mk (-ai) (1+ai)) ⟩ : gcf X ).convergents' ((a :: A).length-(n1.succ)))
      ≠ (λ (an1 : X), -(1 + an1)) ((a :: A).nth_le n1 h))
: ((list.range (a :: A).length).map (λ (i : ℕ), ((a :: A).take (i+1)).prod ) ).sum = (⟨0, (list.cons (gcf.pair.mk a 1) (A.map (λ ai, gcf.pair.mk (-ai) (1 + ai) )))⟩ : gcf X ).convergents' (a :: A).length
:= sorry

theorem dkdkdk
(X : Type*)
(hi : ℕ)
(nn : ℕ)
(A : seq X)
: A.nth (nn + 1) = A.tail.nth nn
:= by { refine eq.symm _, exact seq.nth_tail A nn}

-- theorem hueheuhe
-- (a : ℝ)
-- : (1 / (1 / a)) = a
-- := one_div_one_div a,

-- 2. Skriv ut de olika delarna av induktionbeviset och bevisa dem
--     1. Bevisa "bla bla \neq -1" som ett separat lemma, fortfarande med induktion.
--     2. Bevisa det vi bryr oss om.
-- 3. Sätt ihop dem.
--     1. Man kanske kommer behöva göra något smart för att visa att det gäller i det oändliga fallet
-- 4. Generalisera till komplexa tal.
-- 5. Generalisera till något annat?


/-
Copyright (c) 2021 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.real.sqrt
import Mathlib.data.zsqrtd.basic
import Mathlib.PostPort

namespace Mathlib

/-!
# Image of `zsqrtd` in `ℝ`

This file defines `zsqrtd.to_real` and related lemmas.
It is in a separate file to avoid pulling in all of `data.real` into `data.zsqrtd`.
-/

namespace zsqrtd

/-- The image of `zsqrtd` in `ℝ`, using `real.sqrt` which takes the positive root of `d`.

If the negative root is desired, use `to_real h a.conj`. -/
@[simp] theorem to_real_apply {d : ℤ} (h : 0 ≤ d) (a : ℤ√d) : coe_fn (to_real h) a = ↑(re a) + ↑(im a) * real.sqrt ↑d :=
  Eq.refl (↑(re a) + ↑(im a) * real.sqrt ↑d)

theorem to_real_injective {d : ℤ} (h0d : 0 ≤ d) (hd : ∀ (n : ℤ), d ≠ n * n) : function.injective ⇑(to_real h0d) :=
  lift_injective { val := real.sqrt ↑d, property := to_real._proof_1 h0d } hd