import neater_proof.ideal_definitions
import neater_proof.ring_finite_sums

local infixr ` + ` : 80 := plus
local infixr ` * ` : 80 := mult

/-- Definitions and lemmas we will need for proving that the Ideals of a Ring form a Semi-Ring -/

def Ideal_one {R : Ring} : Ideal R :=
{ I := λ x, true, -- every element of the ring is in this ideal
  ideal_axioms :=
  begin
   unfold set.mem,
   simp,
   cc,
  end
}

def Ideal_zero {R : Ring} : Ideal R :=
{ I := {x | x = zero}, -- this ideal has only one element, zero
  ideal_axioms :=
  begin
   unfold set.mem,
   split,
   { split,
     { exact rfl, },
     { split,
       { intros x y hx hy,
         calc
          x + y = zero : by { cases hx, cases hy, exact zero_plus_neutral zero },
        },
        { intros x x' hxx' hx,
          apply plus_inv_unique zero,
          cases hx,
          split,
          { exact hxx', },
          { exact zero_plus_neutral zero, }, }, }, },
     { split,
       { intros x y hx,
         cases hx,
         exact zero_annihilates_left y, },
       { intros x y hx,
         cases hx,
         exact zero_annihilates_right y, }, },
  end /- should i have done more calcs in here? -/ }

/- Apparently i found this saved some work in full_proof, using the ∈ symbol in the type
   specification meant that the system couldn't follow what the implicit Ring was  -/
lemma Ideal_zero_mems_are_zero {R : Ring} : ∀ x : R.R, Ideal_zero.I x → x = zero :=
begin
 intros x hx,
 exact hx,
end

-- more or less: the total intersection of all members of a set of ideals is also an ideal
def min_ideal {R : Ring} (IS : set (Ideal R)) : Ideal R :=
{ I := {x | ∀ (Id : Ideal R), Id ∈ IS → x ∈ Id.I},
  ideal_axioms :=
  begin
   split,
   { split,
     { intros Id hId,
       exact zero_mem_Ideal Id, },
     { split,
       { intros x y hx hy Id hId,
         specialize hx Id hId,
         specialize hy Id hId,
         exact (subgroup_under_addition Id).2.1 x y hx hy, },
       { intros x x' hxx' hx Id hId,
         specialize hx Id hId,
         exact (subgroup_under_addition Id).2.2 x x' hxx' hx }, }, },
   { split,
     { intros x y hx Id hId,
       specialize hx Id hId,
       exact (multiplication_conditions Id).1 x y hx, },
     { intros x y hx Id hId,
       specialize hx Id hId,
       exact (multiplication_conditions Id).2 x y hx, }, },
  end }

-- the set of all ideals that contain (left) products of elements of two given ideals
def mult_set {R : Ring} (I I' : Ideal R) : set (Ideal R) :=
{Id | ∀ x y : R.R, x ∈ I.I → y ∈ I'.I → x * y ∈ Id.I}

/-- Ideals are always in their own mult sets -/

lemma mult_set_self_left {R : Ring} (I : Ideal R) : ∀ I' : Ideal R, I ∈ mult_set I I' :=
begin
 intros I' x y hx hy,
 exact (multiplication_conditions I).1 x y hx,
end

lemma mult_set_self_right {R : Ring} (I : Ideal R) : ∀ I' : Ideal R, I ∈ mult_set I' I :=
begin
 intros I' x y hx hy,
 exact (multiplication_conditions I).2 y x hy
end

/- Here is where we begin to make use of the finite sum file -/

-- gives a sufficient condition for the value of a finite sum to be in an Ideal
lemma fin_sum_member_condition {R : Ring} (I : Ideal R) (f : ℕ → R.R) (m : ℕ) :
(∀ n : ℕ, f n ∈ I.I) → fin_sum f m ∈ I.I :=
begin
 intro hn,
 induction m with m indh,
 { specialize hn 0,
   exact hn, },
 { rw fin_sum,
   apply (subgroup_under_addition I).2.1, -- if two elements are in an ideal, their sum is as well
   { exact hn (nat.succ m), },
   { exact indh }, },
end

-- the set of finite sums of multiples of elements of a nonempty subset of a Ring forms an Ideal
def fin_sum_ideal {R : Ring} (X : set R.R) (H : ∃ x : R.R, x ∈ X) : Ideal R :=
{ I := {p | ∃ n : ℕ, ∃ f : ℕ → R.R,
            p = fin_sum f n ∧ ∀ n : ℕ, ∃ x ∈ X, ∃ y z : R.R, f n = y * x * z},
  ideal_axioms :=
  begin
   unfold set.mem,
   split,
   { split,
     { existsi 0,
       existsi λ n, zero,
       split,
       { exact rfl, },
       { intro n,
         cases H with x hx,
         existsi x,
         existsi hx,
         existsi zero,
         existsi zero,
         symmetry,
         calc
          zero * x * zero = zero : by { rw zero_annihilates_right, rw zero_annihilates_left },
       }, },
     { split,
       { intros x y hx hy,
         cases hx with nx hx,
         cases hx with fx hx,
         cases hx with eqx hx,
         cases hy with ny hy,
         cases hy with fy hy,
         cases hy with eqy hy,
         existsi nat.succ (nat.add nx ny),
         existsi add_fun nx fx fy,
         split,
         { calc
            x + y = (fin_sum fx nx) + fin_sum fy ny : by { rw eqx, rw eqy }
              ... = (fin_sum_sum nx fx fy) (nat.succ (nat.add nx ny))
                                                    : by rw ← add_fin_sum.sum_is_sum
              ... = fin_sum (add_fun nx fx fy) (nat.succ (nat.add nx ny))
                                                    : by { symmetry,
                                                           exact add_fin_sum.add_fin_sum nx fx fy
                                                                  (nat.succ (nat.add nx ny)) },
         },
         {intro n,
          induction n with n indh,
          { specialize hx 0,
            exact hx, },
          { have dec := lt_decidable nx n,
            have h : add_fun nx fx fy (nat.succ n) = ite (n < nx) (fx (nat.succ n))
                                                         (fy (nat.succ n - nat.succ nx)),
            { exact rfl, },
            cases dec,
            { specialize hx (nat.succ n),
              cases hx with x' hx,
              cases hx with hx' hx,
              cases hx with xl hx,
              cases hx with xr hx,
              existsi x',
              existsi hx',
              existsi xl,
              existsi xr,
              calc
               add_fun nx fx fy (nat.succ n) = fx (nat.succ n) : by simp [h, dec]
                                         ... = xl * x' * xr    : by exact hx, },
            { specialize hy (nat.succ n - nat.succ nx),
              have h' : add_fun nx fx fy (nat.succ n) = fy (nat.succ n - nat.succ nx),
              { simp [h, dec] },
              rw h',
              exact hy, -- these last two blocks essentially shows two different methods for
                        -- arriving at the same result: that the terms of the sum of finite sums
                        -- of multiples of elements of X are multiples of elements of X
                        -- themselves, one might be clearer, the other is definitely shorter
            }, }, }, },
       { intros x x' hxx' hx,
         cases hx with nx hx,
         cases hx with fx hx,
         cases hx with eqx hx,
         have n_one : ∃ neg_one : R.R, one + neg_one = zero,
         { exact plus_inv one, },
         cases n_one with neg_one n_one,
         existsi nx,
         existsi mul_fun neg_one fx,
         split,
         { apply plus_inv_unique x,
           split,
           { exact hxx' },
           { calc
              x + fin_sum (mul_fun neg_one fx) nx
                  = x + neg_one * (fin_sum fx nx) : by rw ← mul_fin_sum.mul_fin_sum neg_one fx nx
              ... = x + neg_one * x               : by rw ← eqx
              ... = zero                          : by exact negative_one neg_one x n_one, }, },
         { intro n,
           specialize hx n,
           cases hx with x' hx,
           cases hx with hx' hx,
           cases hx with xl hx,
           cases hx with xr hx,
           existsi x',
           existsi hx',
           existsi neg_one * xl,
           existsi xr,
           calc
            mul_fun neg_one fx n = neg_one * fx n : by exact rfl
                             ... = neg_one * xl * x' * xr : by rw hx
                             ... = (neg_one * xl) * x' * xr
                                                  : by exact mult_assoc neg_one xl (x' * xr) },
   }, }, },
   { split,
     { intros x y hx,
       cases hx with nx hx,
       cases hx with fx hx,
       cases hx with eqx hx,
       existsi nx,
       existsi mul_fun' y fx,
       split,
       { calc
          x * y = (fin_sum fx nx) * y : by rw eqx
            ... = fin_sum (mul_fun' y fx) nx : by exact mul_fin_sum.mul_fin_sum' y fx nx, },
       { intro n,
         specialize hx n,
         cases hx with x' hx,
         cases hx with hx' hx,
         cases hx with xl hx,
         cases hx with xr hx,
         existsi x',
         existsi hx',
         existsi xl,
         existsi xr * y,
         calc
          mul_fun' y fx n = (fx n) * y : by exact rfl
                      ... = (xl * x' * xr) * y : by rw hx
                      ... = xl * (x' * xr) * y : by { symmetry, exact mult_assoc xl (x' * xr) y }
                      ... = xl * x' * xr * y   : by rw ← mult_assoc x' xr y, }, },
     { intros x y hx,
       cases hx with nx hx,
       cases hx with fx hx,
       cases hx with eqx hx,
       existsi nx,
       existsi mul_fun y fx,
       split,
       { calc
          y * x = y * fin_sum fx nx : by rw eqx
            ... = fin_sum (mul_fun y fx) nx : by exact mul_fin_sum.mul_fin_sum y fx nx, },
       { intro n,
         specialize hx n,
         cases hx with x' hx,
         cases hx with hx' hx,
         cases hx with xl hx,
         cases hx with xr hx,
         existsi x',
         existsi hx',
         existsi y * xl,
         existsi xr,
         calc
          mul_fun y fx n = y * fx n : by exact rfl
                     ... = y * (xl * x' * xr) : by rw hx
                     ... = (y * xl) * x' * xr : by exact mult_assoc y xl (x' * xr), }, }, },
  end }

-- every element of the set is in the ideal of finite sums of multiples of its elements
lemma set_in_fin_sum_ideal {R : Ring} (X : set R.R) (H : ∃ x : R.R, x ∈ X) :
∀ x : R.R, x ∈ X → x ∈ (fin_sum_ideal X H).I :=
begin
 intros x hx,
 existsi 0,
 existsi λ n, x,
 split,
 { exact rfl, },
 { intro n,
   existsi x,
   existsi hx,
   existsi one,
   existsi one,
   symmetry,
   calc
    one * x * one = x : by { rw one_mult_neutral_right, exact one_mult_neutral_left x }, },
end

-- these next two terms may be out of place here

def set_ideal_mult {R : Ring} (I I' : Ideal R) : set R.R :=
{z | ∃ x ∈ I.I, ∃ y ∈ I'.I, z = x * y} -- the set of products whose first element in one ideal,
                                        -- second element in the other.
-- and this set is not empty
lemma nonempty_set_ideal_mult {R : Ring} (I I' : Ideal R) : ∃ x : R.R, x ∈ set_ideal_mult I I' :=
begin
 existsi zero,
 existsi zero,
 existsi zero_mem_Ideal I,
 existsi zero,
 existsi zero_mem_Ideal I',
 symmetry,
 exact zero_annihilates_left zero,
end

/- since the set of those products is not empty, we can talk about the ideal of finite sums of
   multiples of its elements, and, in particular, we can prove that this ideal is in the mult_set
   from above -/
lemma set_ideal_mult_in_mult_set {R : Ring} (I I' : Ideal R) :
(fin_sum_ideal (set_ideal_mult I I') (nonempty_set_ideal_mult I I')) ∈ mult_set I I' :=
begin
 intros x y hx hy,
 apply set_in_fin_sum_ideal (set_ideal_mult I I') (nonempty_set_ideal_mult I I') (x * y),
 existsi x,
 existsi hx,
 existsi y,
 existsi hy,
 exact rfl,
end

-- this will be used, as mentioned in ring_finite_sums, when we prove that Ideal multiplication
-- is associative

/-- Next come the operations, they can be found on the wikipedia page, another important source
   for me was this webpage: https://equatorialmaths.wordpress.com/2008/04/04/operations-on-ideals/
-/

def Ideal_plus {R : Ring} (I I' : Ideal R) : Ideal R :=
{ I := {z | ∃ (x y : R.R), x ∈ I.I ∧ y ∈ I'.I ∧ z = x + y},
  ideal_axioms :=
  begin
   split,
   { split,
     { existsi zero,
       existsi zero,
       split,
       { exact zero_mem_Ideal I, },
       { split,
         { exact zero_mem_Ideal I', },
         { calc
            zero = zero + zero : by { symmetry, exact zero_plus_neutral zero, }, }, }, },
     split,
     { intros x y hx hy,
       -- the last time i tried to import tactics i ran out of memory, and i'm not sure how to
       -- more specifically just import rcases
       cases hx with x' hx,
       cases hx with x'' hx,
       cases hx with hx' hx,
       cases hx with hx'' hx,
       cases hy with y' hy,
       cases hy with y'' hy,
       cases hy with hy' hy,
       cases hy with hy'' hy,
       existsi (x' + y'),
       existsi (x'' + y''),
       split,
       { exact (subgroup_under_addition I).2.1 x' y' hx' hy' },
       { split,
         { exact (subgroup_under_addition I').2.1 x'' y'' hx'' hy'' },
         { calc
            x + y    = (x' + x'') + (y' + y'') : by { rw hx, rw hy }
                 ... = x' + x'' + y' + y''     : by rw ← plus_assoc
                 ... = x' + (y' + y'') + x''   : by rw plus_comm x'' (y' + y'')
                 ... = x' + y' + y'' + x''     : by rw ← plus_assoc
                 ... = (x' + y') + x'' + y''   : by { rw plus_assoc, rw plus_comm y'' x'' },
         }, }, },
     intros x x' hxx' hx,
     cases hx with y' hx,
     cases hx with y'' hx,
     cases hx with hy' hx,
     cases hx with hy'' hx,
     have H : ∃ a' : R.R, y' + a' = zero,
     { exact plus_inv y', },
     cases H with a' ha',
     have H : ∃ a'' : R.R, y'' + a'' = zero,
     { exact plus_inv y'', },
     cases H with a'' ha'',
     have h : x + a' + a'' = zero,
     { calc
        x + a' + a''     = y' + y'' + a' + a''   : by { rw hx, rw ← plus_assoc }
                     ... = y' + (y'' + a'') + a' : by { rw plus_comm a' a'',
                                                        rw plus_assoc y'' a'' a' }
                     ... = y' + zero + a'        : by rw ha''
                     ... = y' + a' + zero        : by rw plus_comm zero a'
                     ... = (y' + a') + zero      : by exact plus_assoc y' a' zero
                     ... = zero + zero           : by rw ha'
                     ... = zero                  : by exact zero_plus_neutral zero, },
     existsi a',
     existsi a'',
     split,
     { exact (subgroup_under_addition I).2.2 y' a' ha' hy', },
     split,
     { exact (subgroup_under_addition I').2.2 y'' a'' ha'' hy'', },
     apply plus_inv_unique x,
     exact ⟨hxx', h⟩, },
   { split,
     { intros x y hx,
       cases hx with x' hx,
       cases hx with x'' hx,
       cases hx with hx' hx,
       cases hx with hx'' hx,
       existsi x' * y,
       existsi x'' * y,
       split,
       { exact (multiplication_conditions I).1 x' y hx', },
       { split,
         { exact (multiplication_conditions I').1 x'' y hx'', },
         { calc
            x * y     = (x' + x'') * y : by rw hx
                  ... = (x' * y) + x'' * y : by exact right_distributivity x' x'' y }, }, },
     { intros x y hx,
       cases hx with x' hx,
       cases hx with x'' hx,
       cases hx with hx' hx,
       cases hx with hx'' hx,
       existsi (y * x'),
       existsi (y * x''),
       split,
       { exact (multiplication_conditions I).2 x' y hx', },
       { split,
         { exact (multiplication_conditions I').2 x'' y hx'', },
         { calc
            y * x     = y * (x' + x'') : by rw hx
                  ... = (y * x') + y * x'' : by exact left_distributivity y x' x'', }, }, }, },
  end }
local infixr ` ⨁ ` : 80 := Ideal_plus

def Ideal_mult {R : Ring} (I I' : Ideal R) : Ideal R := min_ideal (mult_set I I')
local infixr ` ⨂ ` : 80 := Ideal_mult


/-
Copyright (c) 2018 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Callum Sutton, Yury Kudryashov

! This file was ported from Lean 3 source module algebra.hom.equiv.units.group_with_zero
! leanprover-community/mathlib commit 655994e298904d7e5bbd1e18c95defd7b543eb94
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Hom.Equiv.Units.Basic
import Mathlib.Algebra.GroupWithZero.Units.Basic

/-!
# Multiplication by a nonzero element in a `GroupWithZero` is a permutation.
-/

variable {G : Type _}

namespace Equiv

section GroupWithZero

variable [GroupWithZero G]

/-- Left multiplication by a nonzero element in a `GroupWithZero` is a permutation of the
underlying type. -/
@[simps! (config := { fullyApplied := false })]
protected def mulLeft₀ (a : G) (ha : a ≠ 0) : Perm G :=
  (Units.mk0 a ha).mulLeft
#align equiv.mul_left₀ Equiv.mulLeft₀
#align equiv.mul_left₀_symm_apply Equiv.mulLeft₀_symm_apply
#align equiv.mul_left₀_apply Equiv.mulLeft₀_apply

theorem mulLeft_bijective₀ (a : G) (ha : a ≠ 0) : Function.Bijective ((· * ·) a : G → G) :=
  (Equiv.mulLeft₀ a ha).bijective
#align mul_left_bijective₀ Equiv.mulLeft_bijective₀

/-- Right multiplication by a nonzero element in a `GroupWithZero` is a permutation of the
underlying type. -/
@[simps! (config := { fullyApplied := false })]
protected def mulRight₀ (a : G) (ha : a ≠ 0) : Perm G :=
  (Units.mk0 a ha).mulRight
#align equiv.mul_right₀ Equiv.mulRight₀
#align equiv.mul_right₀_symm_apply Equiv.mulRight₀_symm_apply
#align equiv.mul_right₀_apply Equiv.mulRight₀_apply

theorem mulRight_bijective₀ (a : G) (ha : a ≠ 0) : Function.Bijective ((· * a) : G → G) :=
  (Equiv.mulRight₀ a ha).bijective
#align mul_right_bijective₀ Equiv.mulRight_bijective₀

end GroupWithZero

end Equiv


universe u

inductive Vec (α : Type u) : Nat → Type u
| nil  : Vec α 0
| cons : α → {n : Nat} → Vec α n → Vec α (n+1)

def Vec.append1 {α} : {m n : Nat} → Vec α m → Vec α n → Vec α (n + m)
| _, m,  nil,      ys => ys
| _, m, cons x xs, ys => cons x (append1 xs ys)

def Vec.append2 {α} : {m n : Nat} → Vec α m → Vec α n → Vec α (n + m)
| _, _,  nil,      ys => ys
| _, _, cons x xs, ys => cons x (append2 xs ys)

def Vec.append3 {α} : {m n : Nat} → Vec α m → Vec α n → Vec α (n + m)
| .(_), m,  nil,      ys => ys
| .(_), m, cons x xs, ys => cons x (append3 xs ys)

inductive F : Nat → Type
| fzero : {n : Nat} → F (n+1)

namespace F

def fmin1 : {n : Nat} → (x y : F n) → F n
| .(_), fzero, fzero => fzero

def fmin2 : {n : Nat} → (x y : F n) → F n
| _, fzero, fzero => fzero

-- TODO: uncomment after we implement smart unfolding
-- def fmin3 : {n : Nat} → (x y : F n) → F n
-- | n+1, fzero, fzero => fzero

def fmin4 : {n : Nat} → (x y : F n) → F n
| .(n+1), @fzero n, @fzero .(n) => fzero

def fmin5 : {n : Nat} → (x y : F n) → F n
| .(Nat.succ n), @fzero .(n), @fzero n => fzero

def fmin6 : {n : Nat} → (x y : F n) → F n
| .(Nat.succ _), fzero, fzero => fzero

theorem ex1 (n : Nat) (x y : F n) : fmin1 x y = fmin2 x y :=
rfl

-- TODO: see comment above
-- theorem ex2 (n : Nat) (x y : F n) : fmin1 x y = fmin3 x y := by
-- cases x; exact rfl

theorem ex3 (n : Nat) (x y : F n) : fmin1 x y = fmin4 x y :=
rfl

theorem ex4 (n : Nat) (x y : F n) : fmin1 x y = fmin4 x y :=
rfl

theorem ex5 (n : Nat) (x y : F n) : fmin1 x y = fmin5 x y :=
rfl

theorem ex6 (n : Nat) (x y : F n) : fmin1 x y = fmin6 x y :=
rfl


import data.real.basic

--OUTPUT 1
theorem nesbitt_inequality {a b c : ℝ} (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) :=
begin
  calc
    (a / (b + c)) + (b / (a + c)) + (c / (a + b))
      ≥ ⟨(a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b), by sorry⟩ : by sorry
  ... ≥ ⟨9 / 2, by sorry⟩ : by sorry,
end

--OUTPUT 2
theorem nesbitt_inequality {a b c : ℝ} (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) :=
begin
  calc (a / (b + c)) + (b / (a + c)) + (c / (a + b)) = (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) : by sorry ...
  ... = (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) : by sorry ...
  ... = (a + b + c) / ((b + c) + (a + c) + (a + b)) : by sorry ...
  ... = 9 / ((b + c) + (a + c) + (a + b)) : by sorry ...
  ... = 9 / ((b + c) + (a + c) + (a + b)) : by sorry ...
  ... = 9 / ((b + c) + (a + c) + (a + b)) : by sorry ...
  ... = 9 / ((b + c) + (a + c) + (a + b)) : by sorry ...
  ... = 9 / ((b + c) + (a + c) + (a + b)) : by sorry ...
  ... = 9 / ((b + c) + (a + c) + (a + b)) : by sorry ...
  ... = 9 / ((b + c) + (a + c) + (a + b)) : by sorry ...
  ... = 9 / ((b + c) + (a + c) + (a + b)) : by sorry ...
  ... = 9 / ((b + c) + (a + c) + (a + b)) : by sorry ...
  ... = 9 / ((b + c) + (a + c) + (a + b)) : by sorry ...
  ... = 9 / ((b + c) + (a + c) + (a + b)) : by sorry ...
  ... = 9 / ((b + c) + (a + c) + (a + b)) : by sorry ...
  ... = 9 / ((b + c) + (a + c) + (a + b)) : by sorry ...
  ... = 9 / ((b + c) + (a + c) + (a + b)) : by sorry ...
  ... = 9 / ((b + c) + (a + c) + (a + b)) : by sorry ...
  ... = 9 / ((b + c) + (a + c) + (a + b)) : by sorry ...
  ... = 9 / ((b + c) + (a + c) + (a + b)) : by sorry ...
  ... = 9 / ((b + c) + (a + c) + (a + b)) : by sorry ...
  ... = 9 / ((b + c) + (a + c) + (a + b)) : by sorry,
end

--OUTPUT 3
theorem nesbitt_inequality {a b c : ℝ} (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) :=
begin
  calc (a / (b + c)) + (b / (a + c)) + (c / (a + b)) = ((a / (b + c)) + (b / (a + c)) + (c / (a + b))) + (3 : ℝ) : by sorry
  ... = ((a / (b + c)) + (b / (a + c)) + (c / (a + b)) + (3 : ℝ)) + ((3 : ℝ)) : by sorry
  ... ≥ (9 : ℝ) / (2 : ℝ) + ((3 : ℝ)) : by sorry
  ... = (9 : ℝ) / (2 : ℝ) + (3 : ℝ) / (2 : ℝ) : by sorry
  ... = (3 : ℝ) * (3 : ℝ) / (2 : ℝ) : by sorry
  ... = (3 : ℝ) * ((3 : ℝ) / (2 : ℝ)) : by sorry
  ... = (3 : ℝ) * (3 / 2) : by sorry
  ... = (3 : ℝ) * (3 / 2) : by sorry
  ... = (3 : ℝ) * (3 / 2) : by sorry
  ... = 3 / 2 : by sorry,
end

--OUTPUT 4
theorem nesbitt_inequality {a b c : ℝ} (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) :=
begin
  show (a/(b+c)) + (b/(a+c)) + (c/(a+b)) ≥ 3/2, from by {
    calc (a/(b+c)) + (b/(a+c)) + (c/(a+b)) ≥ (a/(b+c)) + (b/(a+c)) + (c/(a+b)) + 3 : by sorry
    ... = (a/(b+c) + b/(a+c) + c/(a+b)) + 3 : by sorry
    ... = (a + b + c)/(b+c) + (a + b + c)/(a+c) + (a + b + c)/(a+b) + 3 : by sorry
    ... = 3*(a + b + c)/(b+c) + (a + b + c)/(a+c) + (a + b + c)/(a+b) + 3 : by sorry
    ... = 3*(a + b + c)/(b+c) + 3*(a + b + c)/(a+c) + 3*(a + b + c)/(a+b) : by sorry
    ... = (a + b + c)/(b+c + a+c + a+b) + (a + b + c)/(a+c + b+c + a+b) + (a + b + c)/(a+b + b+c + a+c) + 9 : by sorry
    ... = 3*(a + b + c)/(b+c + a+c + a+b) : by sorry
    ... ≥ 3*1/(1/(b+c) + 1/(a+c) + 1/(a+b)) : by sorry
    ... = 3*1/(1/3) : by sorry
    ... = 3/2 : by sorry
  },
end

--OUTPUT 5
theorem nesbitt_inequality {a b c : ℝ} (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) :=
begin
  have h1 : (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) ≥ (9 / 2), from sorry,
  have h2 : (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) ≥ (3 * (a + b + c)) / ((b + c) + (a + c) + (a + b)), from sorry,
  have h3 : (1 / (b + c) + 1 / (a + c) + 1 / (a + b)) / 3 ≥ (3 / ((b + c) + (a + c) + (a + b))), from sorry,
  --show (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2), from sorry,
end

--OUTPUT 6
theorem nesbitt_inequality {a b c : ℝ} (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) :=
begin
  calc a / (b + c) + b / (a + c) + c / (a + b) ≥ 3/2 : sorry,
end

--OUTPUT 7
theorem nesbitt_inequality {a b c : ℝ} (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) :=
begin
  have h1 : a + b + c > 0, from sorry,

  calc (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) : by {
    have h2 : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) = ((a + b + c) / (b + c)) + ((a + b + c) / (a + c)) + ((a + b + c) / (a + b)), from sorry,
    rw h2,
    have h3 : (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) ≥ (9 / 2), from sorry,
    have h4 : (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) ≥ (9 / 2) * ((b + c) + (a + c) + (a + b)) / (b + c) + (a + c) + (a + b), from sorry,
    have h5 : ((a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b)) * (2 / (b + c) + (a + c) + (a + b))  ≥ (9 / 2) * ((b + c) + (a + c) + (a + b)), from sorry,
    have h6 : ((a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b)) * (2 / (b + c) + (a + c) + (a + b))  ≥ (9 / 2) * (2), from sorry,
    exact sorry,
  },
end

--OUTPUT 8
theorem nesbitt_inequality {a b c : ℝ} (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) :=
begin
  calc (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) : by sorry
end

--OUTPUT 9
theorem nesbitt_inequality {a b c : ℝ} (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) :=
begin
  calc ((a / (b + c)) + (b / (a + c)) + (c / (a + b))) ≥ ... : by {
    calc ((a / (b + c)) + (b / (a + c)) + (c / (a + b))) ≥ ((a + b + c) / (b + c)) + ((a + b + c) / (a + c)) + ((a + b + c) / (a + b)) : by {sorry},
    calc ... ≥ (9 / (2 * ((b + c) + (a + c) + (a + b)))) : by sorry,
    calc ... ≥ (3 / ((b + c) + (a + c) + (a + b))) : by sorry,
  },
  show ((a / (b + c)) + (b / (a + c)) + (c / (a + b))) ≥ (3 / 2), from sorry,
end

--OUTPUT 10
theorem nesbitt_inequality {a b c : ℝ} (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) :=
begin
  calc (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (a / (b + c)) + (b / (a + c)) + (c / (a + b)) + (3 / (a + b + c)) : sorry
  ... ≥ (3 / (b + c)) + (3 / (a + c)) + (3 / (a + b)) : sorry
  ... ≥ (9 / (b + c + a + c + a + b)) : sorry,
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 sorry,
  have h2 : (A ∩ B) ⊆ A, from sorry,
  have h3 : (A ∩ B) ⊆ S, from sorry,
  show (A ∩ B) ∈  𝒫 S, from sorry,
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 sorry
  ... = x*(x+y) + y*(x+y) : by sorry
  ... = x*x + x*y + y*x + y*y : by sorry
  ... = x^2 + 2*x*y + y^2 : by sorry,
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 sorry,
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from sorry,

  have h3 : ∀ a : G, ∃! x : G, a * x = a, from sorry,
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from sorry,

  have h5 : ∀ a : G, classical.some (h3 a) = (1 : G), from sorry,
  have h6 : ∀ a : G, classical.some (h4 a) = (1 : G), from sorry,

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by {
    use (1 : G),
    have h7 : ∀ e : G, (∀ a : G, e * a = a ∧ a * e = a) → e = 1, from by {
      assume (e : G) (h7 : ∀ a : G, e * a = a ∧ a * e = a),
      have h8 : ∀ a : G, e = classical.some (h3 a), from sorry,
      have h9 : ∀ a : G, e = classical.some (h4 a), from sorry,
      show e = (1 : G), from sorry,
    },
    sorry,
  }
end

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

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

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

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

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

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


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

! This file was ported from Lean 3 source module group_theory.subgroup.actions
! leanprover-community/mathlib commit f93c11933efbc3c2f0299e47b8ff83e9b539cbf6
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.GroupTheory.Subgroup.Basic

/-!
# Actions by `Subgroup`s

These are just copies of the definitions about `Submonoid` starting from `Submonoid.mulAction`.

## Tags
subgroup, subgroups

-/

namespace Subgroup

variable {G : Type _} [Group G]

variable {α β : Type _}

/-- The action by a subgroup is the action by the underlying group. -/
@[to_additive "The additive action by an add_subgroup is the action by the underlying `AddGroup`. "]
instance [MulAction G α] (S : Subgroup G) : MulAction S α :=
  inferInstanceAs (MulAction S.toSubmonoid α)

@[to_additive]
theorem smul_def [MulAction G α] {S : Subgroup G} (g : S) (m : α) : g • m = (g : G) • m :=
  rfl
#align subgroup.smul_def Subgroup.smul_def
#align add_subgroup.vadd_def AddSubgroup.vadd_def

@[to_additive]
instance smulCommClass_left [MulAction G β] [SMul α β] [SMulCommClass G α β] (S : Subgroup G) :
    SMulCommClass S α β :=
  S.toSubmonoid.smulCommClass_left
#align subgroup.smul_comm_class_left Subgroup.smulCommClass_left
#align add_subgroup.vadd_comm_class_left AddSubgroup.vaddCommClass_left

@[to_additive]
instance smulCommClass_right [SMul α β] [MulAction G β] [SMulCommClass α G β] (S : Subgroup G) :
    SMulCommClass α S β :=
  S.toSubmonoid.smulCommClass_right
#align subgroup.smul_comm_class_right Subgroup.smulCommClass_right
#align add_subgroup.vadd_comm_class_right AddSubgroup.vaddCommClass_right

/-- Note that this provides `IsScalarTower S G G` which is needed by `smul_mul_assoc`. -/
instance [SMul α β] [MulAction G α] [MulAction G β] [IsScalarTower G α β] (S : Subgroup G) :
    IsScalarTower S α β :=
  inferInstanceAs (IsScalarTower S.toSubmonoid α β)

instance [MulAction G α] [FaithfulSMul G α] (S : Subgroup G) : FaithfulSMul S α :=
  inferInstanceAs (FaithfulSMul S.toSubmonoid α)

/-- The action by a subgroup is the action by the underlying group. -/
instance [AddMonoid α] [DistribMulAction G α] (S : Subgroup G) : DistribMulAction S α :=
  inferInstanceAs (DistribMulAction S.toSubmonoid α)

/-- The action by a subgroup is the action by the underlying group. -/
instance [Monoid α] [MulDistribMulAction G α] (S : Subgroup G) : MulDistribMulAction S α :=
  inferInstanceAs (MulDistribMulAction S.toSubmonoid α)

/-- The center of a group acts commutatively on that group. -/
instance center.smulCommClass_left : SMulCommClass (center G) G G :=
  Submonoid.center.smulCommClass_left
#align subgroup.center.smul_comm_class_left Subgroup.center.smulCommClass_left

/-- The center of a group acts commutatively on that group. -/
instance center.smulCommClass_right : SMulCommClass G (center G) G :=
  Submonoid.center.smulCommClass_right
#align subgroup.center.smul_comm_class_right Subgroup.center.smulCommClass_right

end Subgroup


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

! This file was ported from Lean 3 source module group_theory.eckmann_hilton
! leanprover-community/mathlib commit 41cf0cc2f528dd40a8f2db167ea4fb37b8fde7f3
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Group.Defs

/-!
# Eckmann-Hilton argument

The Eckmann-Hilton argument says that if a type carries two monoid structures that distribute
over one another, then they are equal, and in addition commutative.
The main application lies in proving that higher homotopy groups (`πₙ` for `n ≥ 2`) are commutative.

## Main declarations

* `EckmannHilton.commMonoid`: If a type carries a unital magma structure that distributes
  over a unital binary operation, then the magma is a commutative monoid.
* `EckmannHilton.commGroup`: If a type carries a group structure that distributes
  over a unital binary operation, then the group is commutative.

-/

universe u

namespace EckmannHilton

variable {X : Type u}

/-- Local notation for `m a b`. -/
local notation a " <" m:51 "> " b => m a b

/-- `IsUnital m e` expresses that `e : X` is a left and right unit
for the binary operation `m : X → X → X`. -/
structure IsUnital (m : X → X → X) (e : X) extends IsLeftId _ m e, IsRightId _ m e : Prop
#align eckmann_hilton.is_unital EckmannHilton.IsUnital

@[to_additive EckmannHilton.AddZeroClass.IsUnital]
theorem MulOneClass.isUnital [_G : MulOneClass X] : IsUnital (· * ·) (1 : X) :=
  IsUnital.mk ⟨MulOneClass.one_mul⟩ ⟨MulOneClass.mul_one⟩

#align eckmann_hilton.mul_one_class.is_unital EckmannHilton.MulOneClass.isUnital
#align eckmann_hilton.add_zero_class.is_unital EckmannHilton.AddZeroClass.IsUnital

variable {m₁ m₂ : X → X → X} {e₁ e₂ : X}

variable (h₁ : IsUnital m₁ e₁) (h₂ : IsUnital m₂ e₂)

variable (distrib : ∀ a b c d, ((a <m₂> b) <m₁> c <m₂> d) = (a <m₁> c) <m₂> b <m₁> d)

/-- If a type carries two unital binary operations that distribute over each other,
then they have the same unit elements.

In fact, the two operations are the same, and give a commutative monoid structure,
see `eckmann_hilton.CommMonoid`. -/
theorem one : e₁ = e₂ := by
  simpa only [h₁.left_id, h₁.right_id, h₂.left_id, h₂.right_id] using distrib e₂ e₁ e₁ e₂
#align eckmann_hilton.one EckmannHilton.one

/-- If a type carries two unital binary operations that distribute over each other,
then these operations are equal.

In fact, they give a commutative monoid structure, see `eckmann_hilton.CommMonoid`. -/
theorem mul : m₁ = m₂ := by
  funext a b
  calc
    m₁ a b = m₁ (m₂ a e₁) (m₂ e₁ b) := by
      { simp only [one h₁ h₂ distrib, h₁.left_id, h₁.right_id, h₂.left_id, h₂.right_id] }
    _ = m₂ a b := by simp only [distrib, h₁.left_id, h₁.right_id, h₂.left_id, h₂.right_id]
#align eckmann_hilton.mul EckmannHilton.mul

/-- If a type carries two unital binary operations that distribute over each other,
then these operations are commutative.

In fact, they give a commutative monoid structure, see `eckmann_hilton.CommMonoid`. -/

/-- If a type carries two unital binary operations that distribute over each other,
then these operations are associative.

In fact, they give a commutative monoid structure, see `eckmann_hilton.CommMonoid`. -/
theorem mul_assoc : IsAssociative _ m₂ :=
  ⟨fun a b c => by simpa [mul h₁ h₂ distrib, h₂.left_id, h₂.right_id] using distrib a b e₂ c⟩
#align eckmann_hilton.mul_assoc EckmannHilton.mul_assoc

/-- If a type carries a unital magma structure that distributes over a unital binary
operation, then the magma structure is a commutative monoid. -/
@[to_additive (attr := reducible)
      "If a type carries a unital additive magma structure that distributes over a unital binary
      operation, then the additive magma structure is a commutative additive monoid."]
def commMonoid [h : MulOneClass X]
    (distrib : ∀ a b c d, ((a * b) <m₁> c * d) = (a <m₁> c) * b <m₁> d) : CommMonoid X :=
  { h with
      mul := (· * ·), one := 1, mul_comm := (mul_comm h₁ MulOneClass.isUnital distrib).comm,
      mul_assoc := (mul_assoc h₁ MulOneClass.isUnital distrib).assoc }
#align eckmann_hilton.comm_monoid EckmannHilton.commMonoid
#align eckmann_hilton.add_comm_monoid EckmannHilton.addCommMonoid

/-- If a type carries a group structure that distributes over a unital binary operation,
then the group is commutative. -/
@[to_additive (attr := reducible)
      "If a type carries an additive group structure that distributes over a unital binary
      operation, then the additive group is commutative."]
def commGroup [G : Group X]
    (distrib : ∀ a b c d, ((a * b) <m₁> c * d) = (a <m₁> c) * b <m₁> d) : CommGroup X :=
  { EckmannHilton.commMonoid h₁ distrib, G with .. }
#align eckmann_hilton.comm_group EckmannHilton.commGroup
#align eckmann_hilton.add_comm_group EckmannHilton.addCommGroup

end EckmannHilton


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

import algebra.group.defs
import order.basic

/-!

# Covariants and contravariants

This file contains general lemmas and instances to work with the interactions between a relation and
an action on a Type.

The intended application is the splitting of the ordering from the algebraic assumptions on the
operations in the `ordered_[...]` hierarchy.

The strategy is to introduce two more flexible typeclasses, `covariant_class` and
`contravariant_class`:

* `covariant_class` models the implication `a ≤ b → c * a ≤ c * b` (multiplication is monotone),
* `contravariant_class` models the implication `a * b < a * c → b < c`.

Since `co(ntra)variant_class` takes as input the operation (typically `(+)` or `(*)`) and the order
relation (typically `(≤)` or `(<)`), these are the only two typeclasses that I have used.

The general approach is to formulate the lemma that you are interested in and prove it, with the
`ordered_[...]` typeclass of your liking.  After that, you convert the single typeclass,
say `[ordered_cancel_monoid M]`, into three typeclasses, e.g.
`[left_cancel_semigroup M] [partial_order M] [covariant_class M M (function.swap (*)) (≤)]`
and have a go at seeing if the proof still works!

Note that it is possible to combine several co(ntra)variant_class assumptions together.
Indeed, the usual ordered typeclasses arise from assuming the pair
`[covariant_class M M (*) (≤)] [contravariant_class M M (*) (<)]`
on top of order/algebraic assumptions.

A formal remark is that normally `covariant_class` uses the `(≤)`-relation, while
`contravariant_class` uses the `(<)`-relation. This need not be the case in general, but seems to be
the most common usage. In the opposite direction, the implication
```lean
[semigroup α] [partial_order α] [contravariant_class α α (*) (≤)] => left_cancel_semigroup α
```
holds -- note the `co*ntra*` assumption on the `(≤)`-relation.

# Formalization notes

We stick to the convention of using `function.swap (*)` (or `function.swap (+)`), for the
typeclass assumptions, since `function.swap` is slightly better behaved than `flip`.
However, sometimes as a **non-typeclass** assumption, we prefer `flip (*)` (or `flip (+)`),
as it is easier to use. -/

-- TODO: convert `has_exists_mul_of_le`, `has_exists_add_of_le`?
-- TODO: relationship with `con/add_con`
-- TODO: include equivalence of `left_cancel_semigroup` with
-- `semigroup partial_order contravariant_class α α (*) (≤)`?
-- TODO : use ⇒, as per Eric's suggestion?  See
-- https://leanprover.zulipchat.com/#narrow/stream/116395-maths/topic/ordered.20stuff/near/236148738
-- for a discussion.

open function

section variants
variables {M N : Type*} (μ : M → N → N) (r : N → N → Prop)

variables (M N)
/-- `covariant` is useful to formulate succintly statements about the interactions between an
action of a Type on another one and a relation on the acted-upon Type.

See the `covariant_class` doc-string for its meaning. -/
def covariant     : Prop := ∀ (m) {n₁ n₂}, r n₁ n₂ → r (μ m n₁) (μ m n₂)

/-- `contravariant` is useful to formulate succintly statements about the interactions between an
action of a Type on another one and a relation on the acted-upon Type.

See the `contravariant_class` doc-string for its meaning. -/
def contravariant : Prop := ∀ (m) {n₁ n₂}, r (μ m n₁) (μ m n₂) → r n₁ n₂

/--  Given an action `μ` of a Type `M` on a Type `N` and a relation `r` on `N`, informally, the
`covariant_class` says that "the action `μ` preserves the relation `r`.

More precisely, the `covariant_class` is a class taking two Types `M N`, together with an "action"
`μ : M → N → N` and a relation `r : N → N → Prop`.  Its unique field `elim` is the assertion that
for all `m ∈ M` and all elements `n₁, n₂ ∈ N`, if the relation `r` holds for the pair
`(n₁, n₂)`, then, the relation `r` also holds for the pair `(μ m n₁, μ m n₂)`,
obtained from `(n₁, n₂)` by "acting upon it by `m`".

If `m : M` and `h : r n₁ n₂`, then `covariant_class.elim m h : r (μ m n₁) (μ m n₂)`.
-/
@[protect_proj] class covariant_class : Prop :=
(elim :  covariant M N μ r)

/--  Given an action `μ` of a Type `M` on a Type `N` and a relation `r` on `N`, informally, the
`contravariant_class` says that "if the result of the action `μ` on a pair satisfies the
relation `r`, then the initial pair satisfied the relation `r`.

More precisely, the `contravariant_class` is a class taking two Types `M N`, together with an
"action" `μ : M → N → N` and a relation `r : N → N → Prop`.  Its unique field `elim` is the
assertion that for all `m ∈ M` and all elements `n₁, n₂ ∈ N`, if the relation `r` holds for the
pair `(μ m n₁, μ m n₂)` obtained from `(n₁, n₂)` by "acting upon it by `m`"", then, the relation
`r` also holds for the pair `(n₁, n₂)`.

If `m : M` and `h : r (μ m n₁) (μ m n₂)`, then `contravariant_class.elim m h : r n₁ n₂`.
-/
@[protect_proj] class contravariant_class : Prop :=
(elim : contravariant M N μ r)

lemma rel_iff_cov [covariant_class M N μ r] [contravariant_class M N μ r] (m : M) {a b : N} :
  r (μ m a) (μ m b) ↔ r a b :=
⟨contravariant_class.elim _, covariant_class.elim _⟩

section flip

variables {M N μ r}

lemma covariant.flip (h : covariant M N μ r) : covariant M N μ (flip r) :=
λ a b c hbc, h a hbc

lemma contravariant.flip (h : contravariant M N μ r) : contravariant M N μ (flip r) :=
λ a b c hbc, h a hbc

end flip

section covariant
variables {M N μ r} [covariant_class M N μ r]

lemma act_rel_act_of_rel (m : M) {a b : N} (ab : r a b) :
  r (μ m a) (μ m b) :=
covariant_class.elim _ ab

@[to_additive]
lemma group.covariant_iff_contravariant [group N] :
  covariant N N (*) r ↔ contravariant N N (*) r :=
begin
  refine ⟨λ h a b c bc, _, λ h a b c bc, _⟩,
  { rw [← inv_mul_cancel_left a b, ← inv_mul_cancel_left a c],
    exact h a⁻¹ bc },
  { rw [← inv_mul_cancel_left a b, ← inv_mul_cancel_left a c] at bc,
    exact h a⁻¹ bc }
end

@[to_additive]
lemma group.covconv [group N] [covariant_class N N (*) r] :
  contravariant_class N N (*) r :=
⟨group.covariant_iff_contravariant.mp covariant_class.elim⟩

section is_trans
variables [is_trans N r] (m n : M) {a b c d : N}

/-  Lemmas with 3 elements. -/
lemma act_rel_of_rel_of_act_rel (ab : r a b) (rl : r (μ m b) c) :
  r (μ m a) c :=
trans (act_rel_act_of_rel m ab) rl

lemma rel_act_of_rel_of_rel_act (ab : r a b) (rr : r c (μ m a)) :
  r c (μ m b) :=
trans rr (act_rel_act_of_rel _ ab)

end is_trans

end covariant

/-  Lemma with 4 elements. -/
section M_eq_N
variables {M N μ r} {mu : N → N → N} [is_trans N r]
  [covariant_class N N mu r] [covariant_class N N (swap mu) r] {a b c d : N}

lemma act_rel_act_of_rel_of_rel (ab : r a b) (cd : r c d) :
  r (mu a c) (mu b d) :=
trans (act_rel_act_of_rel c ab : _) (act_rel_act_of_rel b cd)

end M_eq_N

section contravariant
variables {M N μ r} [contravariant_class M N μ r]

lemma rel_of_act_rel_act (m : M) {a b : N} (ab : r (μ m a) (μ m b)) :
  r a b :=
contravariant_class.elim _ ab

section is_trans
variables [is_trans N r] (m n : M) {a b c d : N}

/-  Lemmas with 3 elements. -/
lemma act_rel_of_act_rel_of_rel_act_rel (ab : r (μ m a) b) (rl : r (μ m b) (μ m c)) :
  r (μ m a) c :=
trans ab (rel_of_act_rel_act m rl)

lemma rel_act_of_act_rel_act_of_rel_act (ab : r (μ m a) (μ m b)) (rr : r b (μ m c)) :
  r a (μ m c) :=
trans (rel_of_act_rel_act m ab) rr

end is_trans

end contravariant

lemma covariant_le_of_covariant_lt [partial_order N] :
  covariant M N μ (<) → covariant M N μ (≤) :=
begin
  refine λ h a b c bc, _,
  rcases le_iff_eq_or_lt.mp bc with rfl | bc,
  { exact rfl.le },
  { exact (h _ bc).le }
end

lemma contravariant_lt_of_contravariant_le [partial_order N] :
  contravariant M N μ (≤) → contravariant M N μ (<) :=
begin
  refine λ h a b c bc, lt_iff_le_and_ne.mpr ⟨h a bc.le, _⟩,
  rintro rfl,
  exact lt_irrefl _ bc,
end

lemma covariant_le_iff_contravariant_lt [linear_order N] :
  covariant M N μ (≤) ↔ contravariant M N μ (<) :=
⟨ λ h a b c bc, not_le.mp (λ k, not_le.mpr bc (h _ k)),
  λ h a b c bc, not_lt.mp (λ k, not_lt.mpr bc (h _ k))⟩

lemma covariant_lt_iff_contravariant_le [linear_order N] :
  covariant M N μ (<) ↔ contravariant M N μ (≤) :=
⟨ λ h a b c bc, not_lt.mp (λ k, not_lt.mpr bc (h _ k)),
  λ h a b c bc, not_le.mp (λ k, not_le.mpr bc (h _ k))⟩

@[to_additive]
lemma covariant_flip_mul_iff [comm_semigroup N] :
  covariant N N (flip (*)) (r) ↔ covariant N N (*) (r) :=
by rw is_symm_op.flip_eq

@[to_additive]
lemma contravariant_flip_mul_iff [comm_semigroup N] :
  contravariant N N (flip (*)) (r) ↔ contravariant N N (*) (r) :=
by rw is_symm_op.flip_eq

@[to_additive]
instance contravariant_mul_lt_of_covariant_mul_le [has_mul N] [linear_order N]
  [covariant_class N N (*) (≤)] : contravariant_class N N (*) (<) :=
{ elim := (covariant_le_iff_contravariant_lt N N (*)).mp covariant_class.elim }

@[to_additive]
instance covariant_mul_lt_of_contravariant_mul_le [has_mul N] [linear_order N]
  [contravariant_class N N (*) (≤)] : covariant_class N N (*) (<) :=
{ elim := (covariant_lt_iff_contravariant_le N N (*)).mpr contravariant_class.elim }

@[to_additive]
instance covariant_swap_mul_le_of_covariant_mul_le [comm_semigroup N] [has_le N]
  [covariant_class N N (*) (≤)] : covariant_class N N (swap (*)) (≤) :=
{ elim := (covariant_flip_mul_iff N (≤)).mpr covariant_class.elim }

@[to_additive]
instance contravariant_swap_mul_le_of_contravariant_mul_le [comm_semigroup N] [has_le N]
  [contravariant_class N N (*) (≤)] : contravariant_class N N (swap (*)) (≤) :=
{ elim := (contravariant_flip_mul_iff N (≤)).mpr contravariant_class.elim }

@[to_additive]
instance contravariant_swap_mul_lt_of_contravariant_mul_lt [comm_semigroup N] [has_lt N]
  [contravariant_class N N (*) (<)] : contravariant_class N N (swap (*)) (<) :=
{ elim := (contravariant_flip_mul_iff N (<)).mpr contravariant_class.elim }

@[to_additive]
instance covariant_swap_mul_lt_of_covariant_mul_lt [comm_semigroup N] [has_lt N]
  [covariant_class N N (*) (<)] : covariant_class N N (swap (*)) (<) :=
{ elim := (covariant_flip_mul_iff N (<)).mpr covariant_class.elim }

@[to_additive]
instance left_cancel_semigroup.covariant_mul_lt_of_covariant_mul_le
  [left_cancel_semigroup N] [partial_order N] [covariant_class N N (*) (≤)] :
  covariant_class N N (*) (<) :=
{ elim := λ a b c bc, by { cases lt_iff_le_and_ne.mp bc with bc cb,
    exact lt_iff_le_and_ne.mpr ⟨covariant_class.elim a bc, (mul_ne_mul_right a).mpr cb⟩ } }

@[to_additive]
instance right_cancel_semigroup.covariant_swap_mul_lt_of_covariant_swap_mul_le
  [right_cancel_semigroup N] [partial_order N] [covariant_class N N (swap (*)) (≤)] :
  covariant_class N N (swap (*)) (<) :=
{ elim := λ a b c bc, by { cases lt_iff_le_and_ne.mp bc with bc cb,
    exact lt_iff_le_and_ne.mpr ⟨covariant_class.elim a bc, (mul_ne_mul_left a).mpr cb⟩ } }

@[to_additive]
instance left_cancel_semigroup.contravariant_mul_le_of_contravariant_mul_lt
  [left_cancel_semigroup N] [partial_order N] [contravariant_class N N (*) (<)] :
  contravariant_class N N (*) (≤) :=
{ elim := λ a b c bc, by { cases le_iff_eq_or_lt.mp bc with h h,
    { exact ((mul_right_inj a).mp h).le },
    { exact (contravariant_class.elim _ h).le } } }

@[to_additive]
instance right_cancel_semigroup.contravariant_swap_mul_le_of_contravariant_swap_mul_lt
  [right_cancel_semigroup N] [partial_order N] [contravariant_class N N (swap (*)) (<)] :
  contravariant_class N N (swap (*)) (≤) :=
{ elim := λ a b c bc, by { cases le_iff_eq_or_lt.mp bc with h h,
    { exact ((mul_left_inj a).mp h).le },
    { exact (contravariant_class.elim _ h).le } } }

end variants


/-
Copyright (c) 2021 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn
-/
import order.conditionally_complete_lattice
import data.int.least_greatest

/-!
## `ℤ` forms a conditionally complete linear order

The integers form a conditionally complete linear order.
-/

open int
open_locale classical
noncomputable theory

instance : conditionally_complete_linear_order ℤ :=
{ Sup := λ s, if h : s.nonempty ∧ bdd_above s then
    greatest_of_bdd (classical.some h.2) (classical.some_spec h.2) h.1 else 0,
  Inf := λ s, if h : s.nonempty ∧ bdd_below s then
    least_of_bdd (classical.some h.2) (classical.some_spec h.2) h.1 else 0,
  le_cSup := begin
    intros s n hs hns,
    have : s.nonempty ∧ bdd_above s := ⟨⟨n, hns⟩, hs⟩,
    rw [dif_pos this],
    exact (greatest_of_bdd _ _ _).2.2 n hns
  end,
  cSup_le := begin
    intros s n hs hns,
    have : s.nonempty ∧ bdd_above s := ⟨hs, ⟨n, hns⟩⟩,
    rw [dif_pos this],
    exact hns (greatest_of_bdd _ (classical.some_spec this.2) _).2.1
  end,
  cInf_le := begin
    intros s n hs hns,
    have : s.nonempty ∧ bdd_below s := ⟨⟨n, hns⟩, hs⟩,
    rw [dif_pos this],
    exact (least_of_bdd _ _ _).2.2 n hns
  end,
  le_cInf := begin
    intros s n hs hns,
    have : s.nonempty ∧ bdd_below s := ⟨hs, ⟨n, hns⟩⟩,
    rw [dif_pos this],
    exact hns (least_of_bdd _ (classical.some_spec this.2) _).2.1
  end,
  .. int.linear_order, ..linear_order.to_lattice }

namespace int

lemma cSup_eq_greatest_of_bdd {s : set ℤ} [decidable_pred (∈ s)]
  (b : ℤ) (Hb : ∀ z ∈ s, z ≤ b) (Hinh : ∃ z : ℤ, z ∈ s) :
  Sup s = greatest_of_bdd b Hb Hinh :=
begin
  convert dif_pos _ using 1,
  { convert coe_greatest_of_bdd_eq _ (classical.some_spec (⟨b, Hb⟩ : bdd_above s)) _ },
  { exact ⟨Hinh, b, Hb⟩, }
end

@[simp]
lemma cSup_empty : Sup (∅ : set ℤ) = 0 := dif_neg (by simp)

lemma cSup_of_not_bdd_above {s : set ℤ} (h : ¬ bdd_above s) : Sup s = 0 := dif_neg (by simp [h])

lemma cInf_eq_least_of_bdd {s : set ℤ} [decidable_pred (∈ s)]
  (b : ℤ) (Hb : ∀ z ∈ s, b ≤ z) (Hinh : ∃ z : ℤ, z ∈ s) :
  Inf s = least_of_bdd b Hb Hinh :=
begin
  convert dif_pos _ using 1,
  { convert coe_least_of_bdd_eq _ (classical.some_spec (⟨b, Hb⟩ : bdd_below s)) _ },
  { exact ⟨Hinh, b, Hb⟩, }
end

@[simp]
lemma cInf_empty : Inf (∅ : set ℤ) = 0 := dif_neg (by simp)

lemma cInf_of_not_bdd_below {s : set ℤ} (h : ¬ bdd_below s) : Inf s = 0 := dif_neg (by simp [h])

lemma cSup_mem {s : set ℤ} (h1 : s.nonempty) (h2 : bdd_above s) : Sup s ∈ s :=
begin
  convert (greatest_of_bdd _ (classical.some_spec h2) h1).2.1,
  exact dif_pos ⟨h1, h2⟩,
end

lemma cInf_mem {s : set ℤ} (h1 : s.nonempty) (h2 : bdd_below s) : Inf s ∈ s :=
begin
  convert (least_of_bdd _ (classical.some_spec h2) h1).2.1,
  exact dif_pos ⟨h1, h2⟩,
end

end int


import Std.Tactic.Ext

@[ext] structure Foo (α β : Type) where
  a : α
  b : β

variable {α β : Type}
variable (z w : Foo α β)

theorem bar (h : z.a = w.a) (h' : z.b = w.b) : z = w := by
  ext
  exact h
  exact h'

theorem comp_assoc (f g h : α → α) : (f∘g)∘h=f∘(g∘h) := by
  exact rfl

@[ext] structure group (G : Type) where
  mul : G→G→G
  e : G
  assoc : ∀ (a b c : G), mul (mul a b) c = mul a (mul b c)
  is_ident : ∀g : G, mul e g = g ∧ mul g e = g
  Ex_inv : ∀g : G, ∃g_inv, mul (g_inv) g = e ∧ mul g (g_inv) = e

@[ext] structure permutation (α : Type) where
  to_fun : α → α
  IsInv : ∃ g, g ∘ to_fun = id ∧ to_fun ∘ g = id

def comp (a b : permutation α) : permutation α where
  to_fun := a.to_fun ∘ b.to_fun
  IsInv := by
    have ⟨a', l1⟩ := a.IsInv
    have ⟨b', l2⟩ := b.IsInv
    apply Exists.intro (b'∘a')
    apply And.intro
    --left
    have thatpart : (b'∘a')∘ a.to_fun ∘ b.to_fun = b' ∘ (a'∘ a.to_fun) ∘ b.to_fun := rfl
    rw[thatpart]
    have thatpart2 : a'∘a.to_fun = id := l1.left
    rw[thatpart2]
    have l3 : b'∘id = b' := rfl
    have h : b'∘ id ∘ b.to_fun = (b'∘ id)∘ b.to_fun := rfl
    rw[h, l3]
    exact l2.left
    --right
    have thatpart : (a.to_fun∘b.to_fun)∘b'∘ a' = a.to_fun∘(b.to_fun∘b')∘ a' := rfl
    rw[thatpart]
    rw[l2.right]
    have thatpart2 : a.to_fun∘id = a.to_fun := rfl
    have h : a.to_fun∘id∘a' = (a.to_fun∘id)∘a' := rfl
    rw[h, thatpart2]
    exact l1.right

def eIden : (permutation α) where
  to_fun := id
  IsInv := by
    apply Exists.intro id
    apply And.intro
    exact rfl
    exact rfl

theorem eIdent {a: permutation α} : comp eIden a = a ∧ comp a eIden = a := by
  apply And.intro
  have l1 : (comp eIden a).to_fun = a.to_fun := by
    have sl1 : (comp eIden a).to_fun = eIden.to_fun ∘ a.to_fun := rfl
    rw[sl1]
    have that : eIden.to_fun = @id α := by rfl
    rw[that]
    rfl

  have ⟨c', l5⟩ := (comp eIden a).IsInv
  rw[l1] at l5
  ext n
  have partext : permutation.to_fun (comp eIden a) = permutation.to_fun a := l1
  rw[partext]
  rfl

theorem exists_inv {h : permutation α} : (∃j, comp j h = eIden ∧ comp h j = eIden) := by
  have ⟨b, l1⟩ := h
  have ⟨k, l2⟩ := l1
  let g : permutation α := by
    have sl1 : _ := And.intro l2.right l2.left
    have kinv : ∃g, g ∘ k = id ∧ k ∘ g = id := Exists.intro b sl1
    exact ⟨k, kinv⟩
  apply Exists.intro g
  apply And.intro
  simp [comp,eIden]
  exact l2.left

  simp[comp,eIden]
  exact l2.right

theorem associat {a b c : permutation α} : comp (comp a b) c = comp a (comp b c) := rfl

theorem perms_grp (α : Type) : (group (permutation α)) := by
  have assoc (a b c : permutation α) : comp (comp a b) c = comp a (comp b c) := associat
  have is_ident (g : permutation α) : comp eIden g = g ∧ comp g eIden = g := eIdent
  have ex_inv (g : permutation α) : ∃j, comp (j) g = eIden ∧ comp g (j) = eIden := exists_inv
  exact ⟨comp, eIden, assoc, is_ident, ex_inv⟩


/-
Copyright (c) 2019 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Patrick Massot, Casper Putz, Anne Baanen
-/
import linear_algebra.matrix.to_lin

/-!
# Diagonal matrices

This file contains some results on the linear map corresponding to a
diagonal matrix (`range`, `ker` and `rank`).

## Tags

matrix, diagonal, linear_map
-/

noncomputable theory

open linear_map matrix set submodule
open_locale big_operators
open_locale matrix

universes u v w

namespace matrix

section comm_ring

variables {n : Type*} [fintype n] [decidable_eq n] {R : Type v} [comm_ring R]

lemma proj_diagonal (i : n) (w : n → R) :
  (proj i).comp (to_lin' (diagonal w)) = (w i) • proj i :=
linear_map.ext $ λ j, mul_vec_diagonal _ _ _

lemma diagonal_comp_std_basis (w : n → R) (i : n) :
  (diagonal w).to_lin'.comp (linear_map.std_basis R (λ_:n, R) i) =
  (w i) • linear_map.std_basis R (λ_:n, R) i :=
linear_map.ext $ λ x, (diagonal_mul_vec_single w _ _).trans (pi.single_smul' i (w i) _)

lemma diagonal_to_lin' (w : n → R) :
  (diagonal w).to_lin' = linear_map.pi (λi, w i • linear_map.proj i) :=
linear_map.ext $ λ v, funext $ λ i, mul_vec_diagonal _ _ _

end comm_ring

section field

variables {m n : Type*} [fintype m] [fintype n]
variables {K : Type u} [field K] -- maybe try to relax the universe constraint

lemma ker_diagonal_to_lin' [decidable_eq m] (w : m → K) :
  ker (diagonal w).to_lin' = (⨆i∈{i | w i = 0 }, range (linear_map.std_basis K (λi, K) i)) :=
begin
  rw [← comap_bot, ← infi_ker_proj, comap_infi],
  have := λ i : m, ker_comp (to_lin' (diagonal w)) (proj i),
  simp only [comap_infi, ← this, proj_diagonal, ker_smul'],
  have : univ ⊆ {i : m | w i = 0} ∪ {i : m | w i = 0}ᶜ, { rw set.union_compl_self },
  exact (supr_range_std_basis_eq_infi_ker_proj K (λi:m, K)
    disjoint_compl_right this (set.finite.of_fintype _)).symm
end

lemma range_diagonal [decidable_eq m] (w : m → K) :
  (diagonal w).to_lin'.range = (⨆ i ∈ {i | w i ≠ 0}, (linear_map.std_basis K (λi, K) i).range) :=
begin
  dsimp only [mem_set_of_eq],
  rw [← map_top, ← supr_range_std_basis, map_supr],
  congr, funext i,
  rw [← linear_map.range_comp, diagonal_comp_std_basis, ← range_smul']
end

lemma rank_diagonal [decidable_eq m] [decidable_eq K] (w : m → K) :
  rank (diagonal w).to_lin' = fintype.card { i // w i ≠ 0 } :=
begin
  have hu : univ ⊆ {i : m | w i = 0}ᶜ ∪ {i : m | w i = 0}, { rw set.compl_union_self },
  have hd : disjoint {i : m | w i ≠ 0} {i : m | w i = 0} := disjoint_compl_left,
  have B₁ := supr_range_std_basis_eq_infi_ker_proj K (λi:m, K) hd hu (set.finite.of_fintype _),
  have B₂ := @infi_ker_proj_equiv K _ _ (λi:m, K) _ _ _ _ (by simp; apply_instance) hd hu,
  rw [rank, range_diagonal, B₁, ←@dim_fun' K],
  apply linear_equiv.dim_eq,
  apply B₂,
end

end field

end matrix


import data.nat.prime
import tactic.linarith

theorem infinitude_of_primes : ∀ N : ℕ, ∃ p ≥ N, nat.prime p :=
begin
  intro N,

  let M := nat.factorial N + 1,
  let p := nat.min_fac M,

  have pp : nat.prime p :=
  begin
    refine nat.min_fac_prime _,
    have : nat.factorial N > 0 := nat.factorial_pos N,
    linarith,
  end,

  use p,
  split,
  { by_contradiction,
    have h₁ : p ∣ nat.factorial N + 1 := nat.min_fac_dvd M,
    have h₂ : p ∣ nat.factorial N :=
    begin
      refine nat.dvd_factorial _ _,
      exact nat.prime.pos pp,
      exact le_of_not_ge h
    end,
    have h : p ∣ 1 := (nat.dvd_add_right h₂).mp h₁,
    exact nat.prime.not_dvd_one pp h, },
  { exact pp, },
end


inductive xnat : Type
| zero : xnat
| succ : xnat → xnat
namespace xnat
  axiom succ_ne_zero : ∀ n : xnat, xnat.succ n ≠ xnat.zero
  axiom succ_inj : ∀ {n m: xnat}, xnat.succ n = xnat.succ m → n = m

  def add : xnat → xnat → xnat
  | zero m := m
  | (succ n) m := succ (add n m)

  -- Lemma 2.2.2
  theorem add_zero : ∀ {n: xnat}, add n zero = n
    | zero := by refl
    | (succ n) := begin
      have : add (succ n) zero = succ (add n zero), by refl,
      show add (succ n) zero = succ n, by rw [this, add_zero],
    end

  -- Lemma 2.2.3
  theorem add_succ : ∀ {n m : xnat}, add n (succ m) = succ (add n m) := begin
    intros n m,
    induction n, {
      refl,
    }, {
      calc
        add (succ n_a) (succ m) = succ (add n_a (succ m)) : by refl
        ...                     = succ (succ (add n_a m)) : by rw n_ih
        ...                     = succ (add (succ n_a) m): by refl
    }
  end

  theorem add_succ' : ∀ n m : xnat, add n (succ m) = succ (add n m)
  | zero m := by refl
  | (succ n) m := begin
    have h1 : add (succ n) (succ m) = succ (add n (succ m)), by refl,
    have h2 : succ (succ (add n m)) = succ (add (succ n) m), by refl,
    rw [h1, add_succ', h2]
  end

  -- Lemma 2.2.4
  theorem add_comm : ∀ n m : xnat, add n m = add m n
  | zero m := by {rw add_zero, refl}
  | (succ n) m := begin
    have : add (succ n) m = succ (add n m), by refl,
    show add (succ n) m = add m (succ n), by rw [
      this, add_comm, add_succ
     ],
  end

  -- Proposition 2.2.5
  theorem add_assoc : ∀ a b c : xnat, add a (add b c) = add (add a b) c :=
  begin
    intros a b c,
    induction a, {
      refl
    }, {
      calc
        add (succ a_a) (add b c) = succ (add a_a (add b c)) : by refl
        ...                      = succ (add (add a_a b) c) : by rw a_ih
        ...                      = add (add (succ a_a) b) c : by refl
    }
  end

  -- Proposition 2.2.6
  theorem add_left_cancel : ∀ {a b c: xnat}, add a b = add a c → b = c :=
  begin
    intros a b c,
    intro h,
    induction a, {
      calc
        b = add zero b : by refl
        ... = add zero c : h
        ... = c : by refl
    }, {
      have : add (succ a_a) b = succ (add a_a b), by refl,
      rw this at h,
      have : add (succ a_a) c = succ (add a_a c), by refl,
      rw this at h,
      have : add a_a b = add a_a c, from succ_inj h,
      from a_ih this
    }
  end

  def pos (n: xnat) : Prop := n ≠ zero

  -- Proposition 2.2.8
  theorem add_pos: ∀ a b : xnat, pos a → pos (add a b) := begin
    intros a b,
    intros pa,
    induction a, {
      have : zero = zero, by refl,
      contradiction
    }, {
      have : add (succ a_a) b = succ (add a_a b), by refl,
      rw this,
      from succ_ne_zero (add a_a b)
    }
  end

  -- colloary 2.2.9
  theorem eq_zero_of_add_eq_zero:
    ∀ {a b : xnat}, (add a b) = zero → (a = zero ∧ b = zero) :=
  begin
    intros a b h,
    induction a, {
      split,
        show zero = zero, by refl,
        show b = zero, {
          have : add zero b = b, by refl,
          rw this at h,
          assumption
        }
    }, {
      have : succ (add a_a b) = zero, from (
        calc
          succ (add a_a b) = add (succ a_a) b : by refl
          ... = zero : h
      ),
      have : succ (add a_a b) ≠ zero, from succ_ne_zero _,
      contradiction
    }
  end

  -- Lemma 2.2.10
  theorem exists_eq_succ_of_ne_zero:
    ∀ a: xnat, a ≠ zero → ∃ b: xnat, a = succ b
  | zero := by {intro, contradiction}
  | (succ a) := begin
    intro,
    existsi a, refl
  end

  theorem exists_unique_pred:
    ∀ a b c: xnat, (succ a = c) → (succ b = c) → (a = b) :=
  begin
    intros a b c sac sbc,
    have : succ a = succ b, {
      transitivity,
        assumption,
        symmetry, assumption,
    },
    show a = b, from succ_inj this
  end

  def le (n m: xnat) := ∃ a : xnat, add n a = m
  def lt (n m: xnat) := (le n m) ∧ n ≠ m

  -- Proposition 2.2.12
  theorem le_refl: ∀ n : xnat, le n n := begin
    intro n,
    existsi zero, from add_zero
  end
  theorem le_trans: ∀ {a b c : xnat}, le a b → le b c → le a c := begin
    intros a b c gab gbc,
    cases gab with n pan,
    cases gbc with m pbm,
    existsi (add n m),
    show (add a (add n m )) = c, by rw [add_assoc, pan, pbm]
  end

  lemma add_eq_zero: ∀ {n m: xnat}, add n m = n → m = zero := begin
    intros n m h,
    have : add n zero = n, from add_zero,
    have : add n m = add n zero, by {
      transitivity n, assumption,
      symmetry, assumption,
    },
    show m = zero, from add_left_cancel this
  end
  theorem le_anti_symm: ∀ {a b : xnat}, le a b → le b a → a = b := begin
    intros a b gab gba,
    cases gab with n pan, cases gba with m pbm,
    have : add n m = zero, by {
      have : a = add zero a, by refl,
      rw [←pan, ←add_assoc] at pbm,
      from add_eq_zero pbm,
    },
    have : n = zero ∧ m = zero, from eq_zero_of_add_eq_zero this,
    cases this with nz _,
    have pan: add a zero = b, by {rw ←nz, assumption},
    show a = b, {
      have : add a zero = a, from add_zero,
      rw this at pan, assumption
    }
  end

  lemma add_succ_eq_succ_add :
    ∀ {a b : xnat}, add (succ a) b = add a (succ b) := λ a b, calc
      add (succ a) b = succ (add a b) : by refl
      ...            = add a (succ b) : by {symmetry, from add_succ}

  theorem lt_succ_le: ∀ {a b : xnat}, lt a b ↔ le (succ a) b := begin
    intros a b,
    split; intro h,
    show le (succ a) b, by {
      cases h with a_le_b a_ne_b,
      cases a_le_b with n a_plus_n_eq_b,
      cases n, {
        have : a = b, from (calc
          a    = add a zero : by { symmetry, from add_zero}
          ...  = b          : a_plus_n_eq_b
        ),
        contradiction -- a ≠ b ∧ a = b
      }, {
        existsi n, from (calc
          add (succ a) n = succ (add a n) : by refl
          ...            = add a (succ n) : by rw ←add_succ
          ...            = b              : a_plus_n_eq_b
        )
      }
    },
    show lt a b, by {
      cases h with n ap1_plus_n_eq_b,
      split,
      show le a b, by {
        existsi (succ n),
        show add a (succ n) = b, {from calc
          add a (succ n) = succ (add a n) : add_succ
          ...            = add (succ a) n : by {symmetry, refl}
          ...            = b : ap1_plus_n_eq_b
        }
      },
      show a ≠ b, by {
        intro a_eq_b,
        have : add b (succ n) = b, {from calc
          add b (succ n) = add (succ b) n : by rw add_succ_eq_succ_add
          ...            = add (succ a) n : by rw a_eq_b
          ...            = b : ap1_plus_n_eq_b
        },
        have : succ n = zero, from add_eq_zero this,
        have : succ n ≠ zero, from succ_ne_zero _,
        contradiction
      },
    }
  end

  theorem lt_eq_add :
    ∀ {a b: xnat}, lt a b ↔ ∃ d: xnat, pos d ∧ b = add a d :=
  begin
    intros a b,
    split, {
      intro lt_a_b,
      have : le (succ a) b, from iff.mp lt_succ_le lt_a_b,
      cases this with n add_succ_a_n_eq_b,
      existsi (succ n),
        split,
        show pos (succ n), from succ_ne_zero n,
        show b = add a (succ n), {from calc
          b   = add (succ a) n : eq.symm add_succ_a_n_eq_b
          ... = add a (succ n) : add_succ_eq_succ_add
        }
    }, {
      intro h,
      cases h with n h1,
      cases h1 with pos_n b_eq_add_a_n,
      split,
      show le a b, by { existsi n, from eq.symm b_eq_add_a_n },
      show a ≠ b, by {
        intro a_eq_b,
        have : add b n = b, by { symmetry, rwa a_eq_b at b_eq_add_a_n},
        have : n = zero, from add_eq_zero this,
        contradiction -- n = zero, but n is positive
      }
    }
  end

  lemma lt_succ: ∀ {a b: xnat}, lt a b → lt (succ a) (succ b) := begin
    intros a b lt_a_b,
    split,
    show (le (succ a) (succ b)), by {
      cases lt_a_b.left with n _,
      existsi n, {from calc
        add (succ a) n = succ (add a n) : by refl
        ...            = succ b : by rw h
      }
    },
    show (succ a ≠ succ b), by {
      intro h,
      have: a = b, from xnat.succ_inj h,
      have: a ≠ b, from lt_a_b.right,
      contradiction
    }
  end
  theorem trichotomy: ∀ {a b: xnat}, lt a b ∨ a = b ∨ lt b a
  | zero zero := or.inr (or.inl (eq.refl zero))
  | (succ a) zero := begin
    right, right, show lt zero (succ a), by {
      split,
      show le zero (succ a), by { existsi (succ a), refl },
      show zero ≠ succ a, by trivial
    },
  end
  | zero (succ b) := begin
    left,
    show lt zero (succ b), by {
      split,
      show le zero (succ b), by { existsi (succ b), refl },
      show zero ≠ succ b, by trivial
    }
  end
  | (succ a) (succ b) := begin
    have : lt a b ∨ a = b ∨ lt b a, from trichotomy,
    cases this with lt_a_b h,
    any_goals { cases h with a_eq_b lt_b_a }, {
      -- a < b
      left, from lt_succ lt_a_b,
    }, {
      -- a = b
      right, left,
      show succ a = succ b, by rw a_eq_b,
    }, {
      -- a > b
      right, right, from lt_succ lt_b_a,
    }
  end
end xnat

example : 4 ≠ 0 := nat.succ_ne_zero 3

example : 6 ≠ 2 := begin
  intro h,
  have : 5 = 1, from nat.succ_inj h,
  have : 4 = 0, from nat.succ_inj this,
  have : 4 ≠ 0, from nat.succ_ne_zero 3,
  contradiction
end


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

import data.real.sqrt
import tactic.interval_cases
import tactic.linarith
import tactic.norm_cast
import tactic.norm_num
import tactic.ring_exp

/-!
# IMO 2021 Q1

Let `n≥100` be an integer. Ivan writes the numbers `n, n+1,..., 2n` each on different cards.
He then shuffles these `n+1` cards, and divides them into two piles. Prove that at least one
of the piles contains two cards such that the sum of their numbers is a perfect square.

# Solution

We show there exists a triplet `a, b, c ∈ [n , 2n]` with `a < b < c` and each of the sums `(a + b)`,
`(b + c)`, `(a + c)` being a perfect square. Specifically, we consider the linear system of
equations

    a + b = (2 * l - 1) ^ 2
    a + c = (2 * l) ^ 2
    b + c = (2 * l + 1) ^ 2

which can be solved to give

    a = 2 * l * l - 4 * l
    b = 2 * l * l + 1
    c = 2 * l * l + 4 * l

Therefore, it is enough to show that there exists a natural number l such that
`n ≤ 2 * l * l - 4 * l` and `2 * l * l + 4 * l ≤ 2 * n` for `n ≥ 100`.

Then, by the Pigeonhole principle, at least two numbers in the triplet must lie in the same pile,
which finishes the proof.
-/

open real

lemma lower_bound (n l : ℕ) (hl : 2 + sqrt (4 + 2 * n) ≤ 2 * l) :
  n + 4 * l ≤ 2 * l * l :=
begin
  suffices : 2 * ((n : ℝ) + 4 * l) - 8 * l + 4 ≤ 2 * (2 * l * l) - 8 * l + 4,
  { simp only [mul_le_mul_left, sub_le_sub_iff_right, add_le_add_iff_right, zero_lt_two] at this,
    exact_mod_cast this, },
  rw [← le_sub_iff_add_le', sqrt_le_iff, pow_two] at hl,
  convert hl.2 using 1; ring,
end

lemma upper_bound (n l : ℕ) (hl : (l : ℝ) ≤ sqrt (1 + n) - 1) :
  2 * l * l + 4 * l ≤ 2 * n :=
begin
  have h1 : ∀ n : ℕ, 0 ≤ 1 + (n : ℝ), by { intro n, exact_mod_cast nat.zero_le (1 + n) },
  rw [le_sub_iff_add_le', le_sqrt (h1 l) (h1 n), pow_two] at hl,
  rw [← add_le_add_iff_right 2, ← @nat.cast_le ℝ],
  simp only [nat.cast_bit0, nat.cast_add, nat.cast_one, nat.cast_mul],
  convert (mul_le_mul_left zero_lt_two).mpr hl using 1; ring,
end

lemma radical_inequality {n : ℕ} (h : 107 ≤ n) : sqrt (4 + 2 * n) ≤ 2 * (sqrt (1 + n) - 3) :=
begin
  have h1n : 0 ≤ 1 + (n : ℝ), by { norm_cast, exact nat.zero_le _ },
  rw sqrt_le_iff,
  split,
  { simp only [sub_nonneg, zero_le_mul_left, zero_lt_two, le_sqrt zero_lt_three.le h1n],
    norm_cast, linarith only [h] },
  ring_exp,
  rw [pow_two, ← sqrt_mul h1n, sqrt_mul_self h1n],
  suffices : 24 * sqrt (1 + n) ≤ 2 * n + 36, by linarith,
  rw mul_self_le_mul_self_iff,
  swap, { norm_num, apply sqrt_nonneg },
  swap, { norm_cast, linarith },
  ring_exp,
  rw [pow_two, ← sqrt_mul h1n, sqrt_mul_self h1n],
  -- Not splitting into cases lead to a deterministic timeout on my machine
  obtain ⟨rfl, h'⟩ : 107 = n ∨ 107 < n := eq_or_lt_of_le h,
  { norm_num },
  { norm_cast,
    nlinarith },
end

-- We will later make use of the fact that there exists (l : ℕ) such that
-- n ≤ 2 * l * l - 4 * l and 2 * l * l + 4 * l ≤ 2 * n for n ≥ 107.
lemma exists_numbers_in_interval (n : ℕ) (hn : 107 ≤ n) :
  ∃ (l : ℕ), (n + 4 * l ≤ 2 * l * l ∧ 2 * l * l + 4 * l ≤ 2 * n) :=
begin
  rsuffices ⟨l, t⟩ : ∃ (l : ℕ), 2 + sqrt (4 + 2 * n) ≤ 2 * (l : ℝ) ∧ (l : ℝ) ≤ sqrt (1 + n) - 1,
  { exact ⟨l, lower_bound n l t.1, upper_bound n l t.2⟩ },
  let x := sqrt (1 + n) - 1,
  refine ⟨⌊x⌋₊, _, _⟩,
  { transitivity 2 * (x - 1),
    { dsimp only [x], linarith only [radical_inequality hn] },
    { simp only [mul_le_mul_left, zero_lt_two], linarith only [(nat.lt_floor_add_one x).le], } },
  { apply nat.floor_le, rw [sub_nonneg, le_sqrt],
    all_goals { norm_cast, simp only [one_pow, le_add_iff_nonneg_right, zero_le'], } },
end

lemma exists_triplet_summing_to_squares (n : ℕ) (hn : 100 ≤ n) :
  (∃ (a b c : ℕ), n ≤ a ∧ a < b ∧ b < c ∧ c ≤ 2 * n ∧ (∃ (k : ℕ), a + b = k * k) ∧
  (∃ (l : ℕ), c + a = l * l) ∧ (∃ (m : ℕ), b + c = m * m)) :=
begin
  -- If n ≥ 107, we do not explicitly construct the triplet but use an existence
  -- argument from lemma above.
  obtain p|p : 107 ≤ n ∨ n < 107 := le_or_lt 107 n,
  { obtain ⟨l, hl1, hl2⟩ := exists_numbers_in_interval n p,
    have p : 1 < l, { contrapose! hl1, interval_cases l; linarith },
    have h₁ : 4 * l ≤ 2 * l * l, { linarith },
    have h₂ : 1 ≤ 2 * l, { linarith },
    refine ⟨2 * l * l - 4 * l, 2 * l * l + 1, 2 * l * l + 4 * l,
      _, _, _, ⟨_, ⟨2 * l - 1, _⟩, ⟨2 * l, _⟩, 2 * l + 1, _⟩⟩,
    all_goals { zify [h₁, h₂], linarith } },
  -- Otherwise, if 100 ≤ n < 107, then it suffices to consider explicit
  -- construction of a triplet {a, b, c}, which is constructed by setting l=9
  -- in the argument at the start of the file.
  { refine ⟨126, 163, 198, p.le.trans _, _, _, _, ⟨17, _⟩, ⟨18, _⟩, 19, _⟩,
    swap 4, { linarith },
    all_goals { norm_num } },
end

-- Since it will be more convenient to work with sets later on, we will translate the above claim
-- to state that there always exists a set B ⊆ [n, 2n] of cardinality at least 3, such that each
-- pair of pairwise unequal elements of B sums to a perfect square.
lemma exists_finset_3_le_card_with_pairs_summing_to_squares (n : ℕ) (hn : 100 ≤ n) :
  ∃ B : finset ℕ,
    (2 * 1 + 1 ≤ B.card) ∧
    (∀ (a b ∈ B), a ≠ b → ∃ k, a + b = k * k) ∧
    (∀ (c ∈ B), n ≤ c ∧ c ≤ 2 * n) :=
begin
  obtain ⟨a, b, c, hna, hab, hbc, hcn, h₁, h₂, h₃⟩ := exists_triplet_summing_to_squares n hn,
  refine ⟨{a, b, c}, _, _, _⟩,
  { suffices : ({a, b, c} : finset ℕ).card = 3, { rw this, exact le_rfl },
    suffices : a ∉ {b, c} ∧ b ∉ {c},
    { rw [finset.card_insert_of_not_mem this.1, finset.card_insert_of_not_mem this.2,
        finset.card_singleton], },
    { rw [finset.mem_insert, finset.mem_singleton, finset.mem_singleton],
      push_neg,
      exact ⟨⟨hab.ne, (hab.trans hbc).ne⟩, hbc.ne⟩ } },
  { intros x hx y hy hxy,
    simp only [finset.mem_insert, finset.mem_singleton] at hx hy,
    rcases hx with rfl|rfl|rfl; rcases hy with rfl|rfl|rfl,
    all_goals { contradiction <|> assumption <|> simpa only [add_comm x y], } },
  { simp only [finset.mem_insert, finset.mem_singleton],
    rintros d (rfl|rfl|rfl); split; linarith only [hna, hab, hbc, hcn], },
end

theorem IMO_2021_Q1 : ∀ (n : ℕ), 100 ≤ n → ∀ (A ⊆ finset.Icc n (2 * n)),
  (∃ (a b ∈ A), a ≠ b ∧ ∃ (k : ℕ), a + b = k * k) ∨
  (∃ (a b ∈ finset.Icc n (2 * n) \ A), a ≠ b ∧ ∃ (k : ℕ), a + b = k * k) :=
begin
  intros n hn A hA,
  -- For each n ∈ ℕ such that 100 ≤ n, there exists a pairwise unequal triplet {a, b, c} ⊆ [n, 2n]
  -- such that all pairwise sums are perfect squares. In practice, it will be easier to use
  -- a finite set B ⊆ [n, 2n] such that all pairwise unequal pairs of B sum to a perfect square
  -- noting that B has cardinality greater or equal to 3, by the explicit construction of the
  -- triplet {a, b, c} before.
  obtain ⟨B, hB, h₁, h₂⟩ := exists_finset_3_le_card_with_pairs_summing_to_squares n hn,
  have hBsub : B ⊆ finset.Icc n (2 * n),
  { intros c hcB, simpa only [finset.mem_Icc] using h₂ c hcB },
  have hB' : 2 * 1 < ((B ∩ (finset.Icc n (2 * n) \ A)) ∪ (B ∩ A)).card,
  { rw [← finset.inter_distrib_left, finset.sdiff_union_self_eq_union,
      finset.union_eq_left_iff_subset.mpr hA, (finset.inter_eq_left_iff_subset _ _).mpr hBsub],
    exact nat.succ_le_iff.mp hB },
  -- Since B has cardinality greater or equal to 3, there must exist a subset C ⊆ B such that
  -- for any A ⊆ [n, 2n], either C ⊆ A or C ⊆ [n, 2n] \ A and C has cardinality greater
  -- or equal to 2.
  obtain ⟨C, hC, hCA⟩ := finset.exists_subset_or_subset_of_two_mul_lt_card hB',
  rw finset.one_lt_card at hC,
  rcases hC with ⟨a, ha, b, hb, hab⟩,
  simp only [finset.subset_iff, finset.mem_inter] at hCA,
  -- Now we split into the two cases C ⊆ [n, 2n] \ A and C ⊆ A, which can be dealt with identically.
  cases hCA; [right, left];
  exact ⟨a, (hCA ha).2, b, (hCA hb).2, hab, h₁ a (hCA ha).1 b (hCA hb).1 hab⟩,
end