import neater_proof.ideal_algebra

local infixr ` + ` : 80 := plus
local infixr ` * ` : 80 := mult
local infixr ` ⨁ ` : 80 := Ideal_plus
local infixr ` ⨂ ` : 80 := Ideal_mult

/-- See, e.g. here: https://en.wikipedia.org/wiki/Semiring -/
structure is_idempotent_semiring (X : Type _) :=
(plus : X → X → X)
(mult : X → X → X)
(zero' : X)
(one'  : X)
(plus_assoc : ∀ x y z : X, plus x (plus y z) = plus (plus x y) z)
(plus_comm  : ∀ x y   : X, plus x y = plus y x)
(plus_iden  : ∀ x     : X, plus x zero' = x)
(mult_assoc : ∀ x y z : X, mult x (mult y z) = mult (mult x y) z)
(mult_liden : ∀ x     : X, mult one' x = x)
(mult_riden : ∀ x     : X, mult x one' = x)
(lm_distrib : ∀ x y z : X, mult x (plus y z) = plus (mult x y) (mult x z))
(rm_distrib : ∀ x y z : X, mult (plus x y) z = plus (mult x z) (mult y z))
(zero_lanni : ∀ x     : X, mult zero' x = zero')
(zero_ranni : ∀ x     : X, mult x zero' = zero')
(plus_idemp : ∀ x     : X, plus x x = x)

theorem ring_ideals_form_an_idempotent_semiring {R : Ring} :
is_idempotent_semiring (Ideal R) :=
{ plus  := Ideal_plus,
  mult  := Ideal_mult,
  zero' := Ideal_zero,
  one'  := Ideal_one,
  plus_assoc :=
  begin -- addition of Ideals is associative!
   intros w x y,
   apply ideal_equality_condition,
   funext,
   apply propext,
   split,  -- we now see that the two ideals are equal if, for an arbitrary element of the ring,
           -- it is an element of one of the ideals iff it is an element of the other, we
           -- split, to consider the two directions of the biconditional is turn
   { intro hz,
     cases hz with x' hz,
     cases hz with y' hz,
     cases hz with hx' hz,
     cases hz with hy' hz,
     cases hy' with x'' hy',
     cases hy' with y'' hy',
     cases hy' with hx'' hy',
     cases hy' with hy'' hy',
     rw hy' at hz,
     -- we are required to show that z is an element of (w ⨁ x) ⨁ y, we know that:
     -- z = x' + x'' + y', that x' is an element of w, that x'' is an element of x and that y' is
     -- an element of y, by associativity z = (x' + x'') + y', and then there isn't much more work
     -- to do.
     existsi x' + x'',
     existsi y'',
     split,
     { existsi x',
       existsi x'',
       split,
       { exact hx', },
       { split,
         { exact hx'', },
         { exact rfl, }, }, }, -- and we have succesfully shown that x' + x'' ∈ w ⨁ x
     { split,
       { exact hy'' }, -- and y' ∈ y
       { calc
          z     = x' + x'' + y'' : by exact hz
            ... = (x' + x'') + y'' : by exact plus_assoc x' x'' y'', }, }, },
          -- so, z = (x' + x'') + y'' ∈ (w ⨁ x) ⨁ y as required
   { intro hz,
     cases hz with x' hz, -- the second part of this proof proceeds in substantially the same way,
     cases hz with y' hz, -- only the associativity runs in the other direction
     cases hz with hx' hz,-- in a sense, the type of Ideals inherits its associativity from the
     cases hz with hy' hz,-- associativity of the corresponding ring
     cases hx' with x'' hx',
     cases hx' with y'' hx',
     cases hx' with hx'' hx',
     cases hx' with hy'' hx',
     rw hx' at hz,
     existsi x'',
     existsi y'' + y',
     split,
     { exact hx'', },
     { split,
       { existsi y'',
         existsi y',
         split,
         { exact hy'' },
         { split,
           { exact hy', },
           { exact rfl, }, }, },
       { calc
          z     = (x'' + y'') + y' : by exact hz
            ... = x'' + y'' + y'   : by { symmetry, exact plus_assoc x'' y'' y' } }, }, },
  end,
  plus_comm  :=
  begin -- addition of Ideals is commutative!
   intros x y,
   apply ideal_equality_condition,
   funext,
   apply propext,
   split, -- these few lines will appear in most sections of the proof of this theorem,
          -- we demonstrate that the biconditional about membership of our Ideals is sufficient
          -- for equality of those Ideals, and then we split and prove each direction in turn
   { intro hz,
     cases hz with x' hz,
     cases hz with y' hz,
     cases hz with hx' hz,
     cases hz with hy' hz,
     existsi y',
     existsi x',
     split,          -- we must show that z ∈ y ⨁ x, we know that z = x' + y', x' ∈ x, y' ∈ y
     { exact hy', }, -- so we can use commutativity of addition in the ring
     { split,
       { exact hx', },
       { calc
          z     = x' + y' : by exact hz
            ... = y' + x' : by exact plus_comm x' y', }, }, },
   { intro hz,
     cases hz with x' hz,
     cases hz with y' hz,
     cases hz with hx' hz,
     cases hz with hy' hz,
     existsi y',
     existsi x',
     split,
     { exact hy', },
     { split,
       { exact hx', },
       { calc
          z     = x' + y' : by exact hz
            ... = y' + x' : by exact plus_comm x' y',  }, }, },
  end,
  plus_iden  :=
  begin -- zero Ideal is additive identity!
   intro x,
   apply ideal_equality_condition,
   funext,
   apply propext,
   split, -- see, here it is again, same as in the last two sections
   { intro hz,
     cases hz with x' hz,
     cases hz with y' hz,
     cases hz with hx' hz,
     cases hz with hy' hz,
     -- now, we want to show that z ∈ x, we know that z = x' + y', that y' ∈ Ideal_zero and that
     -- x' ∈ x, we now show that y' can only be zero, so x' must be equal to z, so z ∈ x.
     have h : y' = zero,
     { exact Ideal_zero_mems_are_zero y' hy', },
     rw h at hz,
     have h' : z = x',
     { calc
        z     = x' + zero : by exact hz
          ... = x'        : by exact zero_plus_neutral x',  },
     rw h',
     exact hx', },
   { intro hz,
     -- we must show that z ∈ x ⨁ Ideal_zero, we know that z ∈ x, and showing that
     -- zero ∈ Ideal_zero would be trivial, and z + zero = z, therefore z ∈ x ⨁ Ideal_zero
     existsi z,
     existsi zero,
     split,
     { exact hz, },
     { split,
       { exact zero_mem_Ideal Ideal_zero },
       { calc
          z     = z + zero : by { symmetry, exact zero_plus_neutral z, }, }, }, },
  end,
  mult_assoc :=
  begin -- multiplication of Ideals is associative!
   -- all of the material on finite sums really comes into play here
   intros w y z,
   apply ideal_equality_condition,
   funext,
   apply propext,
   split,
   { intro hx,
     -- we know that x ∈ w ⨂ y ⨂ z and we want to show that it is in (w ⨂ y) ⨂ z, from the
     -- material on finite sums in the ideal_algebra file, we know that elements of the product
     -- ideal are finite sums of multiples of products of elements of the component ideals of the
     -- product, and then we can use what we know about the conditions for finite sums being
     -- elements of ideals to proceed.
     specialize hx (fin_sum_ideal (set_ideal_mult w (y ⨂ z)) (nonempty_set_ideal_mult w (y ⨂ z)))
                   (set_ideal_mult_in_mult_set w (y ⨂ z)),
     cases hx with nx hx,
     cases hx with fx hx,
     cases hx with eqx hx,
     rw eqx, -- eqx is the premise telling us that x is a finite sum of elements of the ring
     apply fin_sum_member_condition ((w ⨂ y) ⨂ z) fx nx,
     intro n, -- we consider an arbitrary value of the function fx, to show that the finite sum
     specialize hx n, -- membership condition holds for x.
     intros I hI,
     cases hx with x' hx,
     cases hx with hx' hx,
     cases hx' with y' hx',
     cases hx' with hy' hx',
     cases hx' with y'' hx',
     cases hx' with hy'' hx',
     specialize hy'' (fin_sum_ideal (set_ideal_mult y z) (nonempty_set_ideal_mult y z))
                     (set_ideal_mult_in_mult_set y z),
     cases hx with q hx,
     cases hx with p hx,
     rw hx, -- we know that each term of these finite sums is a multiple of products of terms in
     apply (multiplication_conditions I).2, -- w and terms in (y ⨂ z), by definition of ideals
     apply (multiplication_conditions I).1, -- we only need to show that those products are in
                                            -- the set we are interested in.
     cases hy'' with ny'' hy'', -- A term in y ⨂ z is a finite sum, so the product of such a term
     cases hy'' with fy'' hy'', -- and a term in w is a multiple of a finite sum, and we know that
     cases hy'' with eqy'' hy'',-- multiples of finite sums are finite sums, so after a little
     have h : x' = fin_sum (mul_fun y' fy'') ny'', -- rewriting we can apply our membership
     { calc                                        -- condition again.
        x'     = y' * y'' : by exact hx'
           ... = y' * (fin_sum fy'' ny'') : by rw eqy''
           ... = fin_sum (mul_fun y' fy'') ny'' : by
                                                  exact mul_fin_sum.mul_fin_sum y' fy'' ny'' },
     rw h,
     apply fin_sum_member_condition I (mul_fun y' fy'') ny'',
     intro n',
     specialize hy'' n',
     cases hy'' with x'' hy'',
     cases hy'' with hx'' hy'',
     cases hy'' with y''' hy'',
     cases hy'' with z'' hy'',
     have h' : mul_fun y' fy'' n' = y' * (fy'' n'),
     { exact rfl, },
     have h'' : mul_fun y' fy'' n' = y' * y''' * x'' * z'',
     { calc
        mul_fun y' fy'' n'     = y' * fy'' n' : by exact h'
                           ... = y' * y''' * x'' * z'' : by rw hy'', },
     rw h'',
     cases hx'' with x''' hx'',
     cases hx'' with hx''' hx'',
     cases hx'' with z''' hx'',
     cases hx'' with hz''' hx'',
     have h''' : (y' * y''') * x''' ∈ (w ⨂ y).I,
     { intros I' hI',
       specialize hI' (y' * y''') x''',
       apply hI',
       { apply (multiplication_conditions w).1,
         exact hy', },
       { exact hx''', }, },
     have h'''' : y' * y''' * x'' * z''  -- we break up and rewrite our product so that its
                = ((y' * y''') * x''') * (z''' * z''), -- membership in the mult-set can be proved
     { calc                                            -- directly.
        y' * y''' * x'' * z''     = y' * y''' * (x''' * z''') * z'' : by rw hx''
                              ... = y' * y''' * x''' * z''' * z'' : by
                                                                    rw ← mult_assoc x''' z''' z''
                              ... = (y' * y''') * x''' * z''' * z'' : by rw mult_assoc
                              ... = ((y' * y''') * x''') * z''' * z'' : by rw mult_assoc, },
     rw h'''',
     apply hI,
     { exact h''', },
     { apply (multiplication_conditions z).1,
       exact hz''', }, }, -- so ends the first part of the proof of multiplication's associativity
   {intro hx,
    specialize hx (fin_sum_ideal (set_ideal_mult (w ⨂ y) z) (nonempty_set_ideal_mult (w ⨂ y) z))
                  (set_ideal_mult_in_mult_set (w ⨂ y) z),
    cases hx with nx hx,
    cases hx with fx hx,
    cases hx with eqx hx,
    rw eqx,
    apply fin_sum_member_condition (w ⨂ y ⨂ z) fx nx,
    intro n,
    specialize hx n,
    intros I hI,
    cases hx with x' hx,
    cases hx with hx' hx,
    cases hx' with y' hx',
    cases hx' with hy' hx',
    cases hx' with y'' hx',
    cases hx' with hy'' hx',
    specialize hy' (fin_sum_ideal (set_ideal_mult w y) (nonempty_set_ideal_mult w y))
                    (set_ideal_mult_in_mult_set w y),
    cases hx with q hx,
    cases hx with p hx,
    rw hx,
    apply (multiplication_conditions I).2,
    apply (multiplication_conditions I).1,
    cases hy' with ny' hy',
    cases hy' with fy' hy',
    cases hy' with eqy' hy',
    have h : x' = fin_sum (mul_fun' y'' fy') ny',
    { calc
       x'     = y' * y'' : by exact hx'
          ... = (fin_sum fy' ny') * y'' : by rw eqy'
          ... = fin_sum (mul_fun' y'' fy') ny' : by
                                                 exact mul_fin_sum.mul_fin_sum' y'' fy' ny' },
    rw h,
    apply fin_sum_member_condition I (mul_fun' y'' fy') ny',
    intro n',
    specialize hy' n',
    cases hy' with x'' hy',
    cases hy' with hx'' hy',
    cases hy' with y''' hy',
    cases hy' with z'' hy',
    have h' : mul_fun' y'' fy' n' = (fy' n') * y'',
    { exact rfl, },
    have h'' : mul_fun' y'' fy' n' = y''' * x'' * z'' * y'',
    { calc
       mul_fun' y'' fy' n'     = (fy' n') * y'' : by exact h'
                           ... = (y''' * x'' * z'') * y'' : by rw hy'
                           ... = y''' * (x'' * z'') * y'' : by rw ← mult_assoc
                           ... = y''' * x'' * z'' * y''   : by rw ← mult_assoc x'' z'' y'', },
    rw h'',
    cases hx'' with x''' hx'',
    cases hx'' with hx''' hx'',
    cases hx'' with z''' hx'',
    cases hx'' with hz''' hx'',
    have h''' : z''' * z'' * y'' ∈ (y ⨂ z).I,
    { intros I' hI',
      specialize hI' z''' (z'' * y''),
      apply hI',
      { exact hz''', },
      { apply (multiplication_conditions z).2,
        exact hy'', }, },
    have h'''' : y''' * x'' * z'' * y''
               = (y''' * x''') * (z''' * z'' * y''),
    { calc
       y''' * x'' * z'' * y''     = y''' * (x''' * z''') * z'' * y'' : by rw hx''
                              ... = y''' * x''' * z''' * z'' * y'' : by
                                                                     rw ← mult_assoc x''' z'''
                                                                                (z'' * y'')
                              ... = (y''' * x''') * z''' * z'' * y'' : by rw mult_assoc, },
    rw h'''',
    apply hI,
    { apply (multiplication_conditions w).2,
      exact hx''', },
    { exact h''', }, },
  /- The proof of associativity is essentially the same is both directions, the basic idea is that
     an element is contained in an Ideal product if it is contained in every Ideal which contains
     all of the products of elements of the Ideals that make up the product, amongst those Ideals
     (the Ideals containing the products of elements) is the Ideal which contains only finite sums
     of multiples of products of elements of those Ideals, so each element of any ideal product is
     expressable as a finite sum. A finite sum is contained in an Ideal if each one of its terms
     is contained in that Ideal, and the terms of the finite sums expressing elements of our Ideal
     product are long multiples of elements of our ring. We are considering Ideal products where
     one of the terms is itself an Ideal product, so the terms of the finite sum contain,
     themselves, a finite sum, in fact, each term is re-expressible as a finite sum itself, but
     this is no problem, since we can then use the same machinery to show that the term is in the
     Ideal product, by showing that each term of this new finite sum we have expressed it as is
     so. We know that an element of the Ring is in our Ideal product if it's a product of elements
     of the Ring whose terms are in the terms of our Ideal product, so we use associativity of
     multiplication in the Ring to rewrite our term of our finite sum as such a product, then we
     can complete the proof that the element is contained in the other Ideal product. -/
  end,
  mult_liden :=
  begin -- one Ideal is multiplicative identity from the left!
   intro w,
   apply ideal_equality_condition,
   funext,
   apply propext,
   split,
   { intro hx,
     specialize hx w, -- x ∈ w if w contains all products of a term in w and a term in Ideal_one
     apply hx,
     exact mult_set_self_right w Ideal_one, /- and w does -/ },
   { intros hx I hI,
     specialize hI one x, -- x ∈ Ideal_one ⨂ w if, for arbitrary I, I contains all products of
                          -- an element of Ideal_one and an element of w, implies I contains x,
                          -- the antecedant implies that I contains one * x, and we're done.
     rw ← one_mult_neutral_left x,
     apply hI,
     { have t : true,
       { cc, },
       exact t, }, -- silly trivial proof that one ∈ Ideal_one
     { exact hx, }, },
  end,
  mult_riden :=
  begin -- one Ideal is multiplicative identity from the right!
   intro w,
   apply ideal_equality_condition,
   funext,
   apply propext,
   split, -- the body of this proof is almost identical to that above
   { intro hx,
     exact hx w (mult_set_self_left w Ideal_one), },
   { intros hx I hI,
     rw ← one_mult_neutral_right x,
     apply hI,
     { exact hx, },
     { have t : true,
       { cc, },
       exact t, }, },
  end,
  lm_distrib :=
  begin -- Ideal multiplication is distributive from the left!
   intros w y z,
   apply ideal_equality_condition,
   funext,
   apply propext,
   split,
   { intro hx,
     specialize hx ((w ⨂ y) ⨁ (w ⨂ z)), -- we proceed by showing that, for all x' ∈ w, for all
     apply hx,                             -- y' ∈ (y ⨁ z), x' * y' ∈ (w ⨂ y) ⨁ (w ⨂ z)
     intros x' y' hx' hy',
     cases hy' with x'' hy',
     cases hy' with y'' hy',
     cases hy' with hx'' hy', -- we have that, for some x'' ∈ y, for some y'' ∈ z, y' = x'' + y''
     cases hy' with hy'' hy',
     have h : x' * y' = (x' * x'') + (x' * y''),
     { calc
        x' * y'     = x' * x'' + y'' : by rw hy'
                ... = (x' * x'') + x' * y'' : by exact left_distributivity x' x'' y'', },
     rw h,
     existsi x' * x'', -- to show that a sum is in a sum Ideal, we can show that its first term is
     existsi x' * y'', -- in the first Ideal, and it's second in the second Ideal
     split,
     { intros I hI,
       specialize hI x' x'',
       apply hI,
       { exact hx', },
       { exact hx'', }, },
     { split,
       { intros I hI,
         specialize hI x' y'',
         apply hI,
         { exact hx', },
         { exact hy'', }, },
       { exact rfl, }, }, },
   { intro hx,
     cases hx with x' hx,   -- because x is an element a sum Ideal, it itself can be written as a
     cases hx with y' hx,   -- sum, and we can prove that a sum is an element of an Ideal by
     cases hx with hx' hx,  -- proving that each one of its terms is an element of the Ideal
     cases hx with hy' hx,
     specialize hx' (w ⨂ y ⨁ z),
     specialize hy' (w ⨂ y ⨁ z),
     rw hx,
     apply (subgroup_under_addition(w ⨂ y ⨁ z)).2.1 x' y',
     { apply hx', -- all elements in the mult_set of w and y contain x'
       intros x'' y'' hx'' hy'' I hI,
       apply hI,
       { exact hx'' },
       { existsi y'',
         existsi zero,
         split,
         { exact hy'' },
         { split,
           { exact zero_mem_Ideal z, },
           { calc
              y''     = y'' + zero : by { symmetry, exact zero_plus_neutral y'', }, }, }, }, },
     { apply hy', -- similarly for y'
       intros x'' y'' hx'' hy'' I hI,
       apply hI,
       { exact hx'', },
       { existsi zero,
         existsi y'',
         split,
         { exact zero_mem_Ideal y, },
         { split,
           { exact hy'', },
           { calc
              y''     = y'' + zero : by { symmetry, exact zero_plus_neutral y'' }
                  ... = zero + y'' : by exact plus_comm y'' zero, }, }, }, }, },
  end,
  rm_distrib :=
  begin -- Ideal multiplication is distributive from the right!
   -- this proof is substantially the same as the one above
   intros w y z,
   apply ideal_equality_condition,
   funext,
   apply propext,
   split,
   { intro hx,
     specialize hx ((w ⨂ z) ⨁ (y ⨂ z)),
     apply hx,
     intros x' y' hx' hy',
     cases hx' with x'' hx',
     cases hx' with y'' hx',
     cases hx' with hx'' hx',
     cases hx' with hy'' hx',
     have h : x' * y' = (x'' * y') + (y'' * y'),
     { calc
        x' * y'     = (x'' + y'') * y' : by rw hx'
                ... = (x'' * y') + y'' * y' : by exact right_distributivity x'' y'' y' },
     rw h,
     existsi (x'' * y'),
     existsi (y'' * y'),
     split,
     { intros I hI,
       apply hI x'' y',
       { exact hx'', },
       { exact hy', }, },
     { split,
       { intros I hI,
         apply hI y'' y',
         { exact hy'', },
         { exact hy', }, },
       { exact rfl, }, }, },
   { intro hx,
     cases hx with x' hx,
     cases hx with y' hx,
     cases hx with hx' hx,
     cases hx with hy' hx,
     specialize hx' ((w ⨁ y) ⨂ z),
     specialize hy' ((w ⨁ y) ⨂ z),
     rw hx,
     apply (subgroup_under_addition ((w ⨁ y) ⨂ z)).2.1,
     { apply hx',
       intros x'' y'' hx'' hy'' I hI,
       apply hI,
       { existsi x'',
         existsi zero,
         split,
         { exact hx'', },
         { split,
           { exact zero_mem_Ideal y, },
           { calc
              x'' = x'' + zero : by { symmetry, exact zero_plus_neutral x'', }, }, }, },
       { exact hy'' }, },
     { apply hy',
       intros x'' y'' hx'' hy'' I hI,
       apply hI,
       { existsi zero,
         existsi x'',
         split,
         { exact zero_mem_Ideal w, },
         { split,
           { exact hx'', },
           { calc
              x''     = x'' + zero : by { symmetry, exact zero_plus_neutral x'' }
                  ... = zero + x'' : by exact plus_comm x'' zero, }, }, },
       { exact hy'', }, }, },
  end,
  zero_lanni :=
  begin -- zero Ideal annihilates in multiplication from the left!
   intro w,
   apply ideal_equality_condition,
   funext,
   apply propext,
   split,
   { intro hx, -- first we prove that if x ∈ Ideal_zero ⨂ w then x ∈ Ideal_zero, this is easy,
     exact hx Ideal_zero (mult_set_self_left Ideal_zero w), }, -- since the antecedant implies
                                                               -- that x is in all elements of the
                                                               -- the mult_set of Ideal_zero and
                                                               -- w, which includes Ideal_zero.
   { intro hx, -- next we prove that if x ∈ Ideal_zero, then x ∈ Ideal_zero ⨂ w, again easy,
     have h : x = zero, -- since the antecedant implies that x = zero, and all Ideals contain zero
     { exact hx },
     rw h,
     exact zero_mem_Ideal (Ideal_zero ⨂ w), },
  end,
  zero_ranni :=
  begin -- zero Ideal annihilates in multiplication from the right!
   -- this proof is substantially the same as the above.
   intro w,
   apply ideal_equality_condition,
   funext,
   apply propext,
   split,
   { intro hx,
     exact hx Ideal_zero (mult_set_self_right Ideal_zero w), },
   { intro hx,
     have h : x = zero,
     { exact hx, },
     rw h,
     exact zero_mem_Ideal (w ⨂ Ideal_zero), },
  end,
  plus_idemp :=
  begin -- Ideal addition is idempotent!
   intro x,
   apply ideal_equality_condition,
   funext,
   apply propext,
   split,
   { intro hz, -- if z ∈  x ⨁ x, then there is an x' ∈ x and a y ∈ x st. z = x' + y', and then
     cases hz with x' hz, -- we must have z ∈ x, since Ideals are closed under addition.
     cases hz with y' hz,
     cases hz with hx' hz,
     cases hz with hy' hz,
     rw hz,
     exact (subgroup_under_addition x).2.1 x' y' hx' hy', },
   { intro hz, -- conversely if z ∈ x then there exists an element of x and an element of x st.
     existsi z, -- their sum is z, namely z itself, and zero.
     existsi zero,
     split,
     { exact hz, },
     { split,
       { exact zero_mem_Ideal x, },
       { calc
          z = z + zero : by { symmetry, exact zero_plus_neutral z, }, }, }, },
  end } -- Ring Ideals form an Idempotent Semiring.


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Alexander Bentkamp, Yury Kudryashov
-/
import analysis.convex.jensen
import analysis.convex.topology
import analysis.normed.group.pointwise
import analysis.normed_space.ray

/-!
# Topological and metric properties of convex sets in normed spaces

We prove the following facts:

* `convex_on_norm`, `convex_on_dist` : norm and distance to a fixed point is convex on any convex
  set;
* `convex_on_univ_norm`, `convex_on_univ_dist` : norm and distance to a fixed point is convex on
  the whole space;
* `convex_hull_ediam`, `convex_hull_diam` : convex hull of a set has the same (e)metric diameter
  as the original set;
* `bounded_convex_hull` : convex hull of a set is bounded if and only if the original set
  is bounded.
* `bounded_std_simplex`, `is_closed_std_simplex`, `compact_std_simplex`: topological properties
  of the standard simplex.
-/

variables {ι : Type*} {E : Type*}

open metric set
open_locale pointwise convex

variables [seminormed_add_comm_group E] [normed_space ℝ E] {s t : set E}

/-- The norm on a real normed space is convex on any convex set. See also `seminorm.convex_on`
and `convex_on_univ_norm`. -/
lemma convex_on_norm (hs : convex ℝ s) : convex_on ℝ s norm :=
⟨hs, λ x hx y hy a b ha hb hab,
  calc ‖a • x + b • y‖ ≤ ‖a • x‖ + ‖b • y‖ : norm_add_le _ _
    ... = a * ‖x‖ + b * ‖y‖
        : by rw [norm_smul, norm_smul, real.norm_of_nonneg ha, real.norm_of_nonneg hb]⟩

/-- The norm on a real normed space is convex on the whole space. See also `seminorm.convex_on`
and `convex_on_norm`. -/
lemma convex_on_univ_norm : convex_on ℝ univ (norm : E → ℝ) := convex_on_norm convex_univ

lemma convex_on_dist (z : E) (hs : convex ℝ s) : convex_on ℝ s (λ z', dist z' z) :=
by simpa [dist_eq_norm, preimage_preimage]
  using (convex_on_norm (hs.translate (-z))).comp_affine_map
    (affine_map.id ℝ E - affine_map.const ℝ E z)

lemma convex_on_univ_dist (z : E) : convex_on ℝ univ (λz', dist z' z) :=
convex_on_dist z convex_univ

lemma convex_ball (a : E) (r : ℝ) : convex ℝ (metric.ball a r) :=
by simpa only [metric.ball, sep_univ] using (convex_on_univ_dist a).convex_lt r

lemma convex_closed_ball (a : E) (r : ℝ) : convex ℝ (metric.closed_ball a r) :=
by simpa only [metric.closed_ball, sep_univ] using (convex_on_univ_dist a).convex_le r

lemma convex.thickening (hs : convex ℝ s) (δ : ℝ) : convex ℝ (thickening δ s) :=
by { rw ←add_ball_zero, exact hs.add (convex_ball 0 _) }

lemma convex.cthickening (hs : convex ℝ s) (δ : ℝ) : convex ℝ (cthickening δ s) :=
begin
  obtain hδ | hδ := le_total 0 δ,
  { rw cthickening_eq_Inter_thickening hδ,
    exact convex_Inter₂ (λ _ _, hs.thickening _) },
  { rw cthickening_of_nonpos hδ,
    exact hs.closure }
end

/-- Given a point `x` in the convex hull of `s` and a point `y`, there exists a point
of `s` at distance at least `dist x y` from `y`. -/
lemma convex_hull_exists_dist_ge {s : set E} {x : E} (hx : x ∈ convex_hull ℝ s) (y : E) :
  ∃ x' ∈ s, dist x y ≤ dist x' y :=
(convex_on_dist y (convex_convex_hull ℝ _)).exists_ge_of_mem_convex_hull hx

/-- Given a point `x` in the convex hull of `s` and a point `y` in the convex hull of `t`,
there exist points `x' ∈ s` and `y' ∈ t` at distance at least `dist x y`. -/
lemma convex_hull_exists_dist_ge2 {s t : set E} {x y : E}
  (hx : x ∈ convex_hull ℝ s) (hy : y ∈ convex_hull ℝ t) :
  ∃ (x' ∈ s) (y' ∈ t), dist x y ≤ dist x' y' :=
begin
  rcases convex_hull_exists_dist_ge hx y with ⟨x', hx', Hx'⟩,
  rcases convex_hull_exists_dist_ge hy x' with ⟨y', hy', Hy'⟩,
  use [x', hx', y', hy'],
  exact le_trans Hx' (dist_comm y x' ▸ dist_comm y' x' ▸ Hy')
end

/-- Emetric diameter of the convex hull of a set `s` equals the emetric diameter of `s. -/
@[simp] lemma convex_hull_ediam (s : set E) :
  emetric.diam (convex_hull ℝ s) = emetric.diam s :=
begin
  refine (emetric.diam_le $ λ x hx y hy, _).antisymm (emetric.diam_mono $ subset_convex_hull ℝ s),
  rcases convex_hull_exists_dist_ge2 hx hy with ⟨x', hx', y', hy', H⟩,
  rw edist_dist,
  apply le_trans (ennreal.of_real_le_of_real H),
  rw ← edist_dist,
  exact emetric.edist_le_diam_of_mem hx' hy'
end

/-- Diameter of the convex hull of a set `s` equals the emetric diameter of `s. -/
@[simp] lemma convex_hull_diam (s : set E) :
  metric.diam (convex_hull ℝ s) = metric.diam s :=
by simp only [metric.diam, convex_hull_ediam]

/-- Convex hull of `s` is bounded if and only if `s` is bounded. -/
@[simp] lemma bounded_convex_hull {s : set E} :
  metric.bounded (convex_hull ℝ s) ↔ metric.bounded s :=
by simp only [metric.bounded_iff_ediam_ne_top, convex_hull_ediam]

@[priority 100]
instance normed_space.path_connected : path_connected_space E :=
topological_add_group.path_connected

@[priority 100]
instance normed_space.loc_path_connected : loc_path_connected_space E :=
loc_path_connected_of_bases (λ x, metric.nhds_basis_ball)
  (λ x r r_pos, (convex_ball x r).is_path_connected $ by simp [r_pos])

lemma dist_add_dist_of_mem_segment {x y z : E} (h : y ∈ [x -[ℝ] z]) :
  dist x y + dist y z = dist x z :=
begin
  simp only [dist_eq_norm, mem_segment_iff_same_ray] at *,
  simpa only [sub_add_sub_cancel', norm_sub_rev] using h.norm_add.symm
end

/-- The set of vectors in the same ray as `x` is connected. -/
lemma is_connected_set_of_same_ray (x : E) : is_connected {y | same_ray ℝ x y} :=
begin
  by_cases hx : x = 0, { simpa [hx] using is_connected_univ },
  simp_rw ←exists_nonneg_left_iff_same_ray hx,
  exact is_connected_Ici.image _ ((continuous_id.smul continuous_const).continuous_on)
end

/-- The set of nonzero vectors in the same ray as the nonzero vector `x` is connected. -/
lemma is_connected_set_of_same_ray_and_ne_zero {x : E} (hx : x ≠ 0) :
  is_connected {y | same_ray ℝ x y ∧ y ≠ 0} :=
begin
  simp_rw ←exists_pos_left_iff_same_ray_and_ne_zero hx,
  exact is_connected_Ioi.image _ ((continuous_id.smul continuous_const).continuous_on)
end


import mynat.definition -- hide
import mynat.add -- hide
import game.world8.level10 -- hide
namespace mynat -- hide

/-

# Advanced Addition World

## Level 11: `add_right_eq_zero`

We just proved `add_left_eq_zero (a b : mynat) : a + b = 0 → b = 0`.
Hopefully `add_right_eq_zero` shouldn't be too hard now.
-/

/- Lemma
If $a$ and $b$ are natural numbers such that
$$ a + b = 0, $$
then $a = 0$.
-/
lemma add_right_eq_zero {a b : mynat} : a + b = 0 → a = 0 :=
begin [nat_num_game]
  intro H,
  rw add_comm at H,
  exact add_left_eq_zero H,
end

end mynat -- hide


import data.set
import tactic

-- dEAduction imports
import logics
import structures
import definitions

lemma definition.iff {P Q : Prop} : ( P ↔ Q ) ↔ (P → Q) ∧ (Q → P) :=
iff_def

namespace set_theory -- Course title
/- dEAduction
Section
    Set theory
-/

variables {X : Type} {Y : Type}

lemma definition.inclusion (A B : set X) : A ⊆ B ↔ ∀ {{x:X}}, x ∈ A → x ∈ B :=
iff.rfl

lemma definition.equality_two_sets {A A' : set X} : (A = A') ↔ ( ∀ x, x ∈ A ↔ x ∈ A' ) :=
/- dEAduction
PrettyName
    Equality of two sets
-/
by exact set.ext_iff

lemma theorem.double_inclusion {A A' : set X} : (A = A') ↔ (A ⊆ A' ∧ A' ⊆ A) :=
begin
    exact le_antisymm_iff
end

namespace unions_and_intersections -- Section 1

lemma definition.intersection_two_sets (A B : set X) (x : X) :  x ∈ A ∩ B ↔ ( x ∈ A ∧ x ∈ B) :=
iff.rfl
/- dEAduction
PrettyName
    Intersection of two sets
-/

lemma theorem.included_in_intersection_iff  (A B C : set X) : C ⊆ A ∩ B ↔ C ⊆ A ∧ C ⊆ B :=
begin
    exact ball_and_distrib
end

lemma definition.intersection_arbitrary_sets (I : Type) (O : I → set X)  (x : X) : (x ∈ set.Inter O) ↔ (∀ i:I, x ∈ O i) :=
set.mem_Inter
/- dEAduction
PrettyName
    Intersection of an arbitrary family of sets
-/

lemma definition.union_two_sets  (A : set X) (B : set X) (x : X) :  x ∈ A ∪ B ↔ ( x ∈ A ∨ x ∈ B) :=
iff.rfl
/- dEAduction
PrettyName
    Union of two sets
-/

lemma definition.union_arbitrary_sets (I : Type) (O : I → set X)  (x : X) : (x ∈ set.Union O) ↔ (∃ i:I, x ∈ O i) :=
set.mem_Union
/- dEAduction
PrettyName
    Union of an arbitrary family of sets
-/

lemma exercise.intersection_dist_over_union (X : Type) (A B C : set X) : A ∩ (B ∪ C)  = (A ∩ B) ∪ (A ∩ C) :=
/- dEAduction
PrettyName
    Intersection distributes over union
Description
    The intersection of sets distributes over the union of sets.
Tools->Logic
    $ALL -implicate -negate
Tools->ProofTechniques
    $ALL -contradiction
Tools->Definitions
    $UNTIL_NOW
Tools->Theorems
    double_inclusion
ExpectedVarsNumber
    X=3, A=1, B=1
-/
begin
    defi set_theory.definition.equality_two_sets,
    intro x,
    defi definition.iff,
    split,
    intro H,
    defi set_theory.unions_and_intersections.definition.intersection_two_sets at H,
    ET H,
    defi set_theory.unions_and_intersections.definition.union_two_sets at HB,
    OU HB,
    ET HA HA_1,
    defi set_theory.unions_and_intersections.definition.intersection_two_sets at H,
    defi set_theory.unions_and_intersections.definition.union_two_sets,
    OU gauche,
    assumption,
end

variables {A B C : set X}

lemma exercise.union_dist_over_union : A ∪ (B ∩ C)  = (A ∪ B) ∩ (A ∪ C) :=
/- dEAduction
PrettyName
    Union distributes over intersection
Description
    The union of sets distributes over the intersection of sets.
Tools->Logic
    $ALL
Tools->ProofTechniques
    $ALL -choice
Tools->Statements
    $UNTIL_NOW
-/
begin
    sorry
end

end unions_and_intersections

namespace complements -- section 2
/- dEAduction
Section
    Complements
-/

lemma definition.complement {A : set X} {x : X} : x ∈ set.univ \ A ↔ x ∉ A :=
by finish

lemma definition.complement_1 {A : set X} {x : X} : x ∈ set.compl A ↔ x ∉ A :=
by finish

lemma definition.complement_2 {A B : set X} {x : X} : x ∈ B \ A ↔ (x ∈ B ∧ x ∉ A) :=
iff.rfl

lemma exercise.complement_of_complement {A : set X} : - - A = A :=
/- dEAduction
PrettyName
    Complement of complement
Description
    Every set equals the complement of its complement.
-/
begin
    sorry
end

end complements
end set_theory


-- Suma_de_fila_del_triangulo_de_Pascal.lean
-- Suma de fila del triángulo de Pascal
-- José A. Alonso Jiménez
-- Sevilla, 25 de julio de 2021
-- ---------------------------------------------------------------------

import tactic
import data.finset.basic
open finset nat
open_locale big_operators

theorem sum_pascal_row (n : ℕ) :
  ∑ (m : ℕ) in range (n + 1), (choose n m) = 2 ^ n :=
begin
  induction n with d hd,
  { refl },
  { calc ∑ i in range (d + 2), choose (d + 1) i
        = ∑ i in range (d + 1), choose (d + 1) (i + 1) + 1
          : by simp [sum_range_succ']
    ... = ∑ i in range (d + 1), (choose d i + choose d (i+1)) + 1
          : rfl
    ... = ∑ i in range (d + 1), choose d i +
          ∑ i in range (d + 1), choose d (i+1) + 1
          : by rw sum_add_distrib
    ... = 2^d + ∑ i in range (d + 1), choose d (i+1) + 1
          : by rw hd
    ... = 2^d + ∑ i in range d, choose d (i+1) + 1
          : by simp [sum_range_succ]
    ... = 2^d + ∑ i in range (d + 1), choose d i
          : by simp [sum_range_succ', add_assoc]
    ... = 2^d + 2^d
          : by rw hd
    ... = 2*2^d
          : by ring,
  }
end


open nat

def double : nat → nat := fun x, x + x
def do_twice : (nat → nat) → nat → nat := fun f x, f (f x)

#eval do_twice double 2

-- Define Do_Twice : ((ℕ → ℕ) → (ℕ → ℕ)) → (ℕ → ℕ) → (ℕ → ℕ) which applies
-- its argument twice, so that Do_Twice do_twice is a function that applies its
-- input four times.
def Do_Twice : ((nat → nat) -> (nat → nat)) → (nat → nat) → (nat → nat) :=
  fun metaFun ordFun, metaFun (metaFun ordFun)

#eval Do_Twice do_twice double 2

def curry (a b c : Type*) (f : a × b → c) : a → b → c :=
  fun a1 b1, f (a1,b1)

def uncurry (a b c : Type*) (f : a → b → c) : a × b → c :=
  fun pair, f pair.fst pair.snd

universe u
constant vec : Type u -> nat -> Type u

namespace vec
constant empty : Π {α : Type u}, vec α 0
constant cons : Π {α : Type u} {n : ℕ}, α → vec α n → vec α (succ n)
constant append : Π (α : Type u) (n m : ℕ), vec α m -> vec α n -> vec α (m + n)
-- Above, we used the example vec α n for vectors of elements of type α of
-- length n. Declare a constant vec_add that could represent a function that
-- adds two vectors of natural numbers of the same length, and a constant
-- vec_reverse that can represent a function that reverses its argument. Use
-- implicit arguments for parameters that can be inferred. Declare some
-- variables and check some expressions involving the constants that you have
--  declared.
constant vec_add : Π {α : Type u}  {n : ℕ}, vec α n -> vec α n -> vec α n
constant vec_reverse : Π {α : Type u}  {n : ℕ}, vec α n -> vec α n
#check vec_add empty empty

end vec

constant matrix : Type u → ℕ → ℕ → Type u

namespace matrix
constant empty :  Π {α : Type u}, matrix α 0 0
constant matrix_add : Π {α : Type u} {n : ℕ} {m : ℕ},
  matrix α n m → matrix α n m → matrix α n m
constant matrix_mult : Π {α : Type u} {n : ℕ} {m : ℕ} {p : ℕ},
  matrix α n m → matrix α m p → matrix α n p
constant vec_mult :  Π {α : Type u} {n : ℕ} {m : ℕ},
  matrix α n m → vec α m → vec α n

#check vec_mult
#check vec_mult empty vec.empty
end matrix


import data.nat.prime data.nat.parity

open nat

-- BEGIN
variable (s : set ℕ)

example (h : ∃ x ∈ s, ¬ even x ∧ nat.prime x) :
  ∃ x ∈ s, nat.prime x :=
begin
  rcases h with ⟨x, xs, _, prime_x⟩,
  use [x, xs, prime_x],
end
-- END


-- Stuff that's not there yet

class One (α : Type u) where
  one : α

instance [One α] : OfNat α (natLit! 1) where
  ofNat := One.one

class Inv (α : Type u) where
  inv : α → α

postfix:max "⁻¹" => Inv.inv

-- where is `u` coming from?
def Function.injective {α : Sort u} {β : Sort v} (f : α → β) : Prop :=
  ∀ a₁ a₂ : α, f a₁ = f a₂ → a₁ = a₂

theorem Function.injective.eqIff {α : Sort u} {β : Sort v} {f : α → β} (I : Function.injective f) {a b : α} :
  f a = f b ↔ a = b :=
⟨I a b, λ h => congrArg _ h⟩

-- Actual File from mathlib

universe u

section Mul

variables {G : Type u} [Mul G]

def leftMul : G → G → G := λ g : G => λ x : G => g * x

def rightMul : G → G → G := λ g : G => λ x : G => x * g

end Mul

class Semigroup (G : Type u) extends Mul G where
  mulAssoc : ∀ a b c : G, (a * b) * c = a * (b * c)

section Semigroup

variables {G : Type u} [Semigroup G]

theorem mulAssoc : ∀ a b c : G, (a * b) * c = a * (b * c) := Semigroup.mulAssoc

end Semigroup

class CommSemigroup (G : Type u) extends Semigroup G where
  mulComm : ∀ a b : G, a * b = b * a

section CommSemigroup

variables {G : Type u} [CommSemigroup G]

theorem mulComm : ∀ a b : G, a * b = b * a := CommSemigroup.mulComm

end CommSemigroup

class LeftCancelSemigroup (G : Type u) extends Semigroup G where
  mulLeftCancel : ∀ a b c : G, a * b = a * c → b = c

section LeftCancelSemigroup

variables {G : Type u} [LeftCancelSemigroup G] {a b c : G}

theorem mulLeftCancel : a * b = a * c → b = c := LeftCancelSemigroup.mulLeftCancel a b c

theorem mulLeftCancelIff : a * b = a * c ↔ b = c :=
⟨mulLeftCancel, congrArg _⟩

-- It's \centerdot
theorem mulRightInjective (a : G) : Function.injective ((a * ·)) :=
λ b c => mulLeftCancel

theorem mulRightInj (a : G) {b c : G} : a * b = a * c ↔ b = c :=
(mulRightInjective a).eqIff

end LeftCancelSemigroup

class RightCancelSemigroup (G : Type u) extends Semigroup G where
  mulRightCancel : ∀ a b c : G, a * b = c * b → a = c

section RightCancelSemigroup

variables {G : Type u} [RightCancelSemigroup G] {a b c : G}

theorem mulRightCancel : a * b = c * b → a = c := RightCancelSemigroup.mulRightCancel a b c

theorem mulRightCancelIff : a * b = c * b ↔ a = c :=
⟨mulRightCancel, congrArg (· * b)⟩ -- mathlib Lean 3 proof is ⟨mul_right_cancel, congr_arg _⟩

theorem mulLeftInjective (a : G) : Function.injective (· * a) :=
λ b c => mulRightCancel

theorem mulLeftInj (a : G) {b c : G} : b * a = c * a ↔ b = c :=
(mulLeftInjective a).eqIff

end RightCancelSemigroup

class Monoid (M : Type u) extends Semigroup M, One M where
  oneMul : ∀ a : M, 1 * a = a
  mulOne : ∀ a : M, a * 1 = a

section Monoid

variables {M : Type u} [Monoid M]

theorem oneMul : ∀ a : M, 1 * a = a := Monoid.oneMul

theorem mulOne : ∀ a : M, a * 1 = a := Monoid.mulOne

theorem leftInvEqRightInv {a b c : M} (hba : b * a = 1) (hac : a * c = 1) : b = c := by
  rw [←oneMul c, ←hba, mulAssoc, hac, mulOne]

end Monoid

-- This no longer `extends` `CommSemigroup`
class CommMonoid (M : Type u) extends Monoid M where
  mulComm : ∀ a b : M, a * b = b * a

-- Instead, we have an instance going from `CommMonoid` to `CommSemigroup`
instance {M : Type u} [CommMonoid M] : CommSemigroup M where
  mulComm := CommMonoid.mulComm

section LeftCancelMonoid

-- Again, we only extend one `class` and we provide an instance to the other
class LeftCancelMonoid (M : Type u) extends Monoid M where
  mulLeftCancel : ∀ a b c : M, a * b = a * c → b = c

instance {M : Type u} [LeftCancelMonoid M] : LeftCancelSemigroup M where
  mulLeftCancel := LeftCancelMonoid.mulLeftCancel

class LeftCancelCommMonoid (M : Type u) extends LeftCancelMonoid M where
  mulComm : ∀ a b : M, a * b = b * a

instance {M : Type u} [LeftCancelCommMonoid M] : CommMonoid M where
  mulComm := LeftCancelCommMonoid.mulComm

end LeftCancelMonoid

section RightCancelMonoid

class RightCancelMonoid (M : Type u) extends Monoid M where
  mulRightCancel : ∀ a b c : M, a * b = c * b → a = c

instance {M : Type u} [RightCancelMonoid M] : RightCancelSemigroup M where
  mulRightCancel := RightCancelMonoid.mulRightCancel

class RightCancelCommMonoid (M : Type u) extends RightCancelMonoid M where
  mulComm : ∀ a b : M, a * b = b * a

instance {M : Type u} [RightCancelCommMonoid M] : CommMonoid M where
  mulComm := RightCancelCommMonoid.mulComm

end RightCancelMonoid

section CancelMonoid

class CancelMonoid (M : Type u) extends LeftCancelMonoid M where
  mulRightCancel : ∀ a b c : M, a * b = c * b → a = c

instance {M : Type u} [CancelMonoid M] : RightCancelMonoid M where
  mulRightCancel := CancelMonoid.mulRightCancel

class CancelCommMonoid (M : Type u) extends LeftCancelCommMonoid M where
  mulRightCancel : ∀ a b c : M, a * b = c * b → a = c

instance {M : Type u} [CancelCommMonoid M] : RightCancelCommMonoid M where
  mulRightCancel := CancelCommMonoid.mulRightCancel
  mulComm := λ a b => mulComm a b -- why is the λ necessary?

end CancelMonoid

class DivInvMonoid (G : Type u) extends Monoid G, Inv G, Div G where
  div := λ a b => a * b⁻¹
  divEqMulInv : ∀ a b : G, a / b = a * b⁻¹

theorem divEqMulInv {G : Type u} [DivInvMonoid G] :
  ∀ a b : G, a / b = a * b⁻¹ :=
DivInvMonoid.divEqMulInv

class Group (G : Type u) extends DivInvMonoid G where
  mulLeftInv : ∀ a : G, a⁻¹ * a = 1

def Group.toMonoid (G : Type u) [Group G] : Monoid G :=
  (Group.toDivInvMonoid (G := G)).toMonoid -- no more underscores!

section Group

variables {G : Type u} [Group G] {a b c : G}

@[simp]
theorem mulLeftInv : ∀ a : G, a⁻¹ * a = 1 := Group.mulLeftInv

@[simp]
theorem invMulCancelLeft (a b : G) : a⁻¹ * (a * b) = b := by
  rw [←mulAssoc, mulLeftInv, oneMul]

@[simp]
theorem invEqOfMulEqOne (h : a * b = 1) : a⁻¹ = b :=
  leftInvEqRightInv (mulLeftInv _) h

@[simp]
theorem invInv (a : G) : a⁻¹⁻¹ = a :=
  invEqOfMulEqOne (mulLeftInv _)

@[simp]
theorem mulRightInv (a : G) : a * a⁻¹ = 1 :=
  have a⁻¹⁻¹ * a⁻¹ = 1 := mulLeftInv a⁻¹
  by rw invInv at this
     assumption

theorem mulInv (a b : G) : (a * b)⁻¹ = b⁻¹ * a⁻¹ := by
  apply invEqOfMulEqOne
  rw [← mulAssoc, mulAssoc _ b, mulRightInv, mulOne, mulRightInv]

theorem invMulInvEqInvMul (a b : G) : (a⁻¹ * b)⁻¹ = b⁻¹ * a := by
  rw [mulInv, invInv]

theorem mulInvSelf (a : G) : a * a⁻¹ = 1 := mulRightInv a

@[simp]
theorem mulInvCancelRight (a b : G) : a * b * b⁻¹ = a := by
  rw [mulAssoc, mulRightInv, mulOne]

instance : CancelMonoid G where
  mulLeftCancel := λ a b c h => by rw [←invMulCancelLeft a b, h, invMulCancelLeft]
  mulRightCancel := λ a b c h => by rw [←mulInvCancelRight a b, h, mulInvCancelRight]

end Group

class CommGroup (G : Type u) extends Group G where
  mulComm : ∀ a b : G, a * b = b * a

instance (G : Type u) [CommGroup G] : CommMonoid G where
  mulComm := CommGroup.mulComm

def Set (α : Type u) := α → Prop

namespace Set

variables {α : Type u} {s : Set α}

def mem (a : α) (s : Set α) := s a

infix:50 " ∈ " => Set.mem

instance : CoeSort (Set α) (Type u) where
  coe s := Subtype s

theorem ext {s t : Set α} (h : ∀ x, x ∈ s ↔ x ∈ t) : s = t :=
  funext <| λ x => propext <| h x

-- instance : Coe (Set α) α := ⟨ λ a => a.1 ⟩

end Set

structure Subgroup (G : Type u) [Group G] :=
(carrier : Set G)
(oneMem' : 1 ∈ carrier)
(mulMem' {x y} : x ∈ carrier → y ∈ carrier → (x * y) ∈ carrier)
(invMem' {x} : x ∈ carrier → x⁻¹ ∈ carrier)

-- We try out the suggestion about membership where we do not make a membership
-- relation for subgroups

namespace Subgroup

variables {G : Type u} [Group G] {H : Subgroup G}

theorem oneMem : 1 ∈ H.carrier := H.oneMem'

theorem mulMem {x y : G} (hx : x ∈ H.carrier) (hy : y ∈ H.carrier.mem) :
  H.carrier.mem (x * y) := H.mulMem' hx hy

theorem invMem {x : G} (hx : x ∈ H.carrier) : x⁻¹ ∈ H.carrier :=
  H.invMem' hx

theorem mkInj (s t : Set G) (hs₁ : 1 ∈ s) (ht₁ : 1 ∈ t)
  (hs₂ : ∀ {x y}, x ∈ s → y ∈ s → (x * y) ∈ s)
  (ht₂ : ∀ {x y}, x ∈ t → y ∈ t → (x * y) ∈ t)
  (hs₃ : ∀ {x}, x ∈ s → x⁻¹ ∈ s)
  (ht₃ : ∀ {x}, x ∈ t → x⁻¹ ∈ t) (hst : s = t) :
  Subgroup.mk s hs₁ hs₂ hs₃ = Subgroup.mk t ht₁ ht₂ ht₃ := by subst hst; rfl

theorem ext' {H K : Subgroup G} (h : H.carrier = K.carrier) : H = K := by
  cases H; cases K
  apply mkInj; allGoals { assumption }

theorem invMemIff {x : G} : x⁻¹ ∈ H.carrier ↔ x ∈ H.carrier := by
  apply Iff.intro
  { intro hx; rw ← invInv x;
    exact invMem hx }
  { exact invMem }

instance : Coe (Subgroup G) (Set G) := ⟨ Subgroup.carrier ⟩

instance : CoeSort (Subgroup G) (Type u) where
  coe s := Subtype s.carrier

instance ofSubgroup (H : Subgroup G) : Group (coeSort H) where
  mul := λ x y => ⟨ x.1 * y.1, H.mulMem x.2 y.2 ⟩
  one := ⟨ 1, H.oneMem ⟩
  inv := λ x => ⟨ x.1⁻¹, H.invMem x.2 ⟩
  oneMul := λ x => by { cases x; apply Subtype.eq; exact oneMul _ }
  mulOne := λ x => by { cases x; apply Subtype.eq; exact mulOne _ }
  mulAssoc := λ x y z => by
    { cases x; cases y; cases z; apply Subtype.eq;
      exact mulAssoc _ _ _ }
  divEqMulInv := λ x y => rfl
  mulLeftInv := λ x => by { cases x; apply Subtype.eq; exact mulLeftInv _ }

@[simp] theorem coeMul (a b : G) (ha : a ∈ H.carrier) (hb : b ∈ H.carrier) :
  (⟨a, ha⟩ * ⟨b, hb⟩ : H).1 = a * b := rfl

def LCoset (g : G) (H : Subgroup G) : Set G :=
  (λ s => ∃ k, ∃ (h : k ∈ H.carrier), s = g * k)

infix:70 " ⋆ " => LCoset

theorem selfMemLCoset (x : G) (H : Subgroup G): x ∈ x ⋆ H :=
  ⟨ 1, ⟨ H.oneMem, (mulOne x).symm ⟩ ⟩

theorem LCosetEq {x y : G} : x ⋆ H = y ⋆ H ↔ x⁻¹ * y ∈ H := by
  apply Iff.intro
  { intro h;
    have h' : x ∈ y ⋆ H := by
    { rw ← h;
      exact selfMemLCoset _ _ };
    cases h' with | intro k hk =>
    cases hk with | intro hk hk' =>
    { rw [hk', mulInv, mulAssoc, mulLeftInv, mulOne];
      exact invMem hk  } }
  { intro h;
    apply Set.ext;
    intro t;
    apply Iff.intro;
    { intro ht;
      cases ht with | intro g hg =>
      cases hg with | intro hg₀ hg₁ =>
      { rw hg₁;
        apply Exists.intro (y⁻¹ * x * g);
        apply Exists.intro <| H.mulMem _ hg₀;
        rw [← mulAssoc, ← mulAssoc, mulRightInv, oneMul];
        rw [← invMulInvEqInvMul];
        exact H.invMem h } }
    { intro ht;
      cases ht with | intro g hg =>
      cases hg with | intro hg₀ hg₁ =>
      { rw hg₁;
        apply Exists.intro (x⁻¹ * y * g);
        apply Exists.intro <| H.mulMem h hg₀;
        rw [← mulAssoc, ← mulAssoc, mulRightInv, oneMul] } } }

theorem oneLCosetEqSelf : 1 ⋆ H = H := by
  apply Set.ext;
  intro x;
  apply Iff.intro;
  { intro hx;
    cases hx with | intro h hh =>
    cases hh with | intro hh₀ hh₁ =>
    { rw [hh₁, oneMul]; assumption } }
  { intro hx;
    apply Exists.intro x;
    apply Exists.intro hx;
    rw oneMul }

theorem memSubgroupIff (x : G) : x ∈ H.carrier ↔ x ∈ H := Iff.rfl

theorem lcoset_of_mem {a : G} :
  a ⋆ H = H ↔ a ∈ H := by
  rw [← oneLCosetEqSelf, LCosetEq, mulOne, oneLCosetEqSelf,
      ← memSubgroupIff, invMemIff]; exact Iff.rfl

theorem lcoset_digj {a b c : G} (ha : c ∈ a ⋆ H) (hb : c ∈ b ⋆ H) :
  a ⋆ H = b ⋆ H := by
  { let ⟨g₀, ⟨hg₀, hca⟩⟩ := ha; let ⟨g₁, ⟨hg₁, hcb⟩⟩ := hb;
    rw [LCosetEq, show b = c * g₁⁻¹ by simp [hcb]];
    rw (show a⁻¹ = g₀ * c⁻¹ by rw [(show a = c * g₀⁻¹ by
      rw [hca, mulAssoc, mulRightInv, mulOne]), mulInv, invInv]);
    rw [← mulAssoc, mulAssoc _ _ c, mulLeftInv, mulOne];
    exact H.mulMem hg₀ (H.invMem hg₁) }

end Subgroup


import game.sup_inf.level01

namespace xena -- hide
-- World name : Sup and Inf

/-
# Chapter 6 : Sup and Inf

## Level 4

-/

/-
The completeness axiom on the reals states that any non-empty subset
$X \subseteq \mathbb{R}$ that is bounded above has a least upper bound.
Here we explore the converse statement: any set of reals that has a supremum is non-empty and
has an upper bound. The second part of the result is trivial, but showing that the
set is non-empty will ask you to use techniques learned in the first world.
-/

-- definition is_upper_bound' (S : set ℝ) (x : ℝ) := x ∈ upper_bounds S
-- (Definition above deprecated? GT)

definition is_lub (S : set ℝ) (x : ℝ) := is_upper_bound S x ∧
∀ y : ℝ, is_upper_bound S y → x ≤ y

definition has_lub (S : set ℝ) := ∃ x, is_lub S x

local attribute [instance] classical.prop_decidable --hide

/- Lemma
Any set of reals that has a supremum is non-empty and bounded above.
-/
theorem nonempty_and_bounded_of_has_LUB (S : set ℝ) (H : has_lub S) :
  (S ≠ ∅) ∧ (∃ x, is_upper_bound S x) :=
begin
  cases H with b Hb,
  split,
  intro t,
  have H1 : (b-1) ∈ upper_bounds S,
  change ∀ x ∈ S, x ≤ (b-1),
  by_contradiction hn,
  push_neg at hn,
  cases hn with d hd,
  cases hd with y hy,
  rw t at y,
  exact y,
  unfold is_lub at Hb,
  have HH := Hb.2 (b-1) H1,
  linarith,

  existsi b,
  exact Hb.1,

end

end xena -- hide

/-
cases H with b Hb,
  -- b is LUB, Hb is proof it's LUB
  split,
  { -- first prove S is not empty, by contradiction as usual with empty sets
    intro Hempty,
    have H1 : (b-1) ∈ upper_bounds S,
    change ∀ x ∈ S, x ≤ (b-1),
    by_contradiction hn,
    push_neg at hn,
    cases hn with x h1,
    cases h1 with h11 h12,
    rw Hempty at h11,
    exact h11,
    unfold is_lub at Hb,
    have HH := Hb.2 (b-1) H1, -- b - 1 is an upper bound
    linarith,
  },
  {
     existsi b,
     exact Hb.1,
  },
  done
-/


/-
Copyright (c) 2020 Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot, Scott Morrison
-/
import topology.instances.real
import topology.algebra.field

/-!
# The unit interval, as a topological space

Use `open_locale unit_interval` to turn on the notation `I := set.Icc (0 : ℝ) (1 : ℝ)`.

We provide basic instances, as well as a custom tactic for discharging
`0 ≤ x`, `0 ≤ 1 - x`, `x ≤ 1`, and `1 - x ≤ 1` when `x : I`.

-/

noncomputable theory
open_locale classical topological_space filter
open set

/-! ### The unit interval -/

/-- The unit interval `[0,1]` in ℝ. -/
abbreviation unit_interval : set ℝ := set.Icc 0 1

localized "notation `I` := unit_interval" in unit_interval

namespace unit_interval

lemma mem_iff_one_sub_mem {t : ℝ} : t ∈ I ↔ 1 - t ∈ I :=
begin
  rw [mem_Icc, mem_Icc],
  split ; intro ; split ; linarith
end

instance has_zero : has_zero I := ⟨⟨0, by split ; norm_num⟩⟩

@[simp, norm_cast] lemma coe_zero : ((0 : I) : ℝ) = 0 := rfl

instance has_one : has_one I := ⟨⟨1, by split ; norm_num⟩⟩

@[simp, norm_cast] lemma coe_one : ((1 : I) : ℝ) = 1 := rfl

instance : nonempty I := ⟨0⟩

/-- Unit interval central symmetry. -/
def symm : I → I := λ t, ⟨1 - t.val, mem_iff_one_sub_mem.mp t.property⟩

localized "notation `σ` := unit_interval.symm" in unit_interval

@[simp] lemma symm_zero : σ 0 = 1 :=
subtype.ext $ by simp [symm]

@[simp] lemma symm_one : σ 1 = 0 :=
subtype.ext $ by simp [symm]

@[continuity]
lemma continuous_symm : continuous σ :=
by continuity!

instance : connected_space I :=
subtype.connected_space ⟨nonempty_Icc.mpr zero_le_one, is_preconnected_Icc⟩

/-- Verify there is an instance for `compact_space I`. -/
example : compact_space I := by apply_instance

lemma nonneg (x : I) : 0 ≤ (x : ℝ) := x.2.1
lemma one_minus_nonneg (x : I) : 0 ≤ 1 - (x : ℝ) := by simpa using x.2.2
lemma le_one (x : I) : (x : ℝ) ≤ 1 := x.2.2
lemma one_minus_le_one (x : I) : 1 - (x : ℝ) ≤ 1 := by simpa using x.2.1

end unit_interval

namespace tactic.interactive

/-- A tactic that solves `0 ≤ x`, `0 ≤ 1 - x`, `x ≤ 1`, and `1 - x ≤ 1` for `x : I`. -/
meta def unit_interval : tactic unit :=
`[apply unit_interval.nonneg] <|> `[apply unit_interval.one_minus_nonneg] <|>
`[apply unit_interval.le_one] <|> `[apply unit_interval.one_minus_le_one]

end tactic.interactive

section
variables {𝕜 : Type*} [linear_ordered_field 𝕜] [topological_space 𝕜] [topological_ring 𝕜]

/--
The image of `[0,1]` under the homeomorphism `λ x, a * x + b` is `[b, a+b]`.
-/
-- We only need the ordering on `𝕜` here to avoid talking about flipping the interval over.
-- At the end of the day I only care about `ℝ`, so I'm hesitant to put work into generalizing.
lemma affine_homeomorph_image_I (a b : 𝕜) (h : 0 < a) :
  affine_homeomorph a b h.ne.symm '' set.Icc 0 1 = set.Icc b (a + b) :=
by simp [h]

/--
The affine homeomorphism from a nontrivial interval `[a,b]` to `[0,1]`.
-/
def Icc_homeo_I (a b : 𝕜) (h : a < b) : set.Icc a b ≃ₜ set.Icc (0 : 𝕜) (1 : 𝕜) :=
begin
  let e := homeomorph.image (affine_homeomorph (b-a) a (sub_pos.mpr h).ne.symm) (set.Icc 0 1),
  refine (e.trans _).symm,
  apply homeomorph.set_congr,
  simp [sub_pos.mpr h],
end

@[simp] lemma Icc_homeo_I_apply_coe (a b : 𝕜) (h : a < b) (x : set.Icc a b) :
  ((Icc_homeo_I a b h) x : 𝕜) = (x - a) / (b - a) :=
rfl

@[simp] lemma Icc_homeo_I_symm_apply_coe (a b : 𝕜) (h : a < b) (x : set.Icc (0 : 𝕜) (1 : 𝕜)) :
  ((Icc_homeo_I a b h).symm x : 𝕜) = (b - a) * x + a :=
rfl

end


/-
Copyright (c) 2022 Julian Kuelshammer. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Julian Kuelshammer
-/

import solutions.sheet07

/-

# A general way to produce equivalence relations

There is some general way to produce an equivalence relation from a function: Given a
function `f : X → Y`, one can define `x_1 ≈ x_2` iff `f (x_1) = f(x_2)`. One can even
assume the function `f` to be surjective, i.e. there exists a `Z` and a surjective
function `g : X → Z` such that `x_1 ≈ x_2` iff `g (x_1) = g(x_2)`. Let's try to prove
this in Lean.

-/

def function.to_rel {X Y : Type} (f : X → Y) (x_1 x_2 : X) : Prop :=
f x_1 = f x_2

lemma function.to_rel_def {X Y : Type} (f : X → Y) (x_1 x_2 : X) :
(function.to_rel f) x_1 x_2 ↔ f x_1 = f x_2 :=
begin
  refl,
end

lemma function.to_rel_refl {X Y : Type} (f : X → Y) : reflexive (function.to_rel f) :=
begin
  intro x,
  rw function.to_rel_def,
end

lemma function.to_rel_symm {X Y : Type} (f : X → Y) : symmetric (function.to_rel f) :=
begin
  intros x x' hxx',
  rw function.to_rel_def at *,
  symmetry,
  exact hxx',
end

lemma function.to_rel_trans {X Y : Type} (f : X → Y) : transitive (function.to_rel f) :=
begin
  intros x x' x'' hxx' hx'x'',
  rw function.to_rel_def at *,
  rw [hxx', hx'x''],
end

lemma function.to_rel_equiv {X Y : Type} (f : X → Y) : equivalence (function.to_rel f) :=
begin
  exact ⟨function.to_rel_refl f, function.to_rel_symm f, function.to_rel_trans f⟩,
end

instance function.to_setoid {X Y : Type} (f : X → Y) : setoid X :=
{ r := function.to_rel f,
  iseqv := function.to_rel_equiv f }

lemma exists_surjective {X Y : Type} (f : X → Y) : ∃ (Z : Type) (g : X → Z),
function.surjective g ∧ ∀ x x' : X, f x = f x' ↔ g x = g x' :=
begin
  use set.range f,
  use set.range_factorization f,
  split,
  { exact set.surjective_onto_range, },
  { intros x x',
    split,
    { intro h,
      exact subtype.coe_inj.mp h },
    { intro h,
      exact subtype.mk.inj h, } }
end

/-

If you need a bit more practice, here is a slightly more general situation. Given an
equivalence relation on a type Y and a function f : X → Y, there is an equivalence relation
on X, pulled back from Y, given by two elements of X being related iff there images under
f are related. What we did up until now on this sheet is a special case where the equivalence
relation on Y is given by equality.

-/

def fun_rel.to_rel {X Y : Type} (S : Y → Y → Prop) (f : X → Y)
  (x1 x2 : X) : Prop :=
S (f x1) (f x2)

lemma fun_rel.to_rel_def {X Y : Type} (S : Y → Y → Prop) (f : X → Y)
(x_1 x_2 : X) : (fun_rel.to_rel S f) x_1 x_2 ↔ S (f x_1) (f x_2) :=
begin
  refl,
end

lemma fun_rel.to_rel_refl {X Y : Type} {S : Y → Y → Prop} (hS : reflexive S) (f : X → Y) :
  reflexive (fun_rel.to_rel S f) :=
begin
  intro x,
  rw fun_rel.to_rel_def,
  exact hS (f x),
end

lemma fun_rel.to_rel_symm {X Y : Type} {S : Y → Y → Prop} (hS : symmetric S) (f : X → Y) :
  symmetric (fun_rel.to_rel S f) :=
begin
  intros x x' hxx',
  rw fun_rel.to_rel_def at *,
  exact hS hxx',
end

lemma fun_rel.to_rel_trans {X Y : Type} {S : Y → Y → Prop} (hS : transitive S) (f : X → Y) :
  transitive (fun_rel.to_rel S f) :=
begin
  intros x x' x'' hxx' hx'x'',
  rw fun_rel.to_rel_def at *,
  exact hS hxx' hx'x'',
end

lemma fun_rel.to_rel_equiv {X Y : Type} {S : Y → Y → Prop} (hS : equivalence S) (f : X → Y) :
  equivalence (fun_rel.to_rel S f) :=
begin
  exact ⟨fun_rel.to_rel_refl hS.1 f, fun_rel.to_rel_symm hS.2.1 f, fun_rel.to_rel_trans hS.2.2 f⟩,
end

instance fun_rel.to_setoid {X Y : Type} {S : Y → Y → Prop} (hS : equivalence S) (f : X → Y) :
  setoid X :=
{ r := fun_rel.to_rel S f,
  iseqv := fun_rel.to_rel_equiv hS f }

/-

And here is another situation which we will encounter soon. Given an equivalence relation R on
X and an equivalence relation S on Y, there is an equivalence relation on X × Y in which
two pairs are related if and only if there first and second entry are related.

-/

def prod_rel {X Y : Type} (R : X → X → Prop) (S : Y → Y → Prop)
  (u v : X × Y) : Prop :=
R u.1 v.1 ∧ S u.2 v.2

lemma prod_rel_def {X Y : Type} {R : X → X → Prop} {S : Y → Y → Prop} (u v : X × Y) :
  prod_rel R S u v ↔ R u.1 v.1 ∧ S u.2 v.2 := by refl

lemma prod_rel_refl {X Y : Type} {R : X → X → Prop} {S : Y → Y → Prop} (hR : reflexive R)
  (hS : reflexive S) : reflexive (prod_rel R S) :=
begin
  intro x,
  rw prod_rel_def,
  exact ⟨hR x.1, hS x.2⟩,
end

lemma prod_rel_symm {X Y : Type} {R : X → X → Prop} {S : Y → Y → Prop} (hR : symmetric R)
  (hS : symmetric S) : symmetric (prod_rel R S) :=
begin
  intros u v huv,
  exact ⟨hR huv.1, hS huv.2⟩,
end

lemma prod_rel_trans {X Y : Type} {R : X → X → Prop} {S : Y → Y → Prop} (hR : transitive R)
  (hS : transitive S) : transitive (prod_rel R S) :=
begin
  intros u v w huv hvw,
  exact ⟨hR huv.1 hvw.1, hS huv.2 hvw.2⟩,
end

lemma prod_rel_equiv {X Y : Type} {R : X → X → Prop} {S : Y → Y → Prop} (hR : equivalence R)
  (hS : equivalence S) : equivalence (prod_rel R S) :=
begin
  exact ⟨prod_rel_refl hR.1 hS.1, prod_rel_symm hR.2.1 hS.2.1, prod_rel_trans hR.2.2 hS.2.2⟩
end


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
  -- $\dfrac a {b + c} + \dfrac b {a + c} + \dfrac c {a + b} \ge \dfrac 3 2$
  have h1 : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2), from by auto [arith_mean_harm_mean, add_pos_of_pos_of_pos, add_pos_of_pos_of_pos, add_pos_of_pos_of_pos, div_pos_of_pos_of_pos, div_pos_of_pos_of_pos, div_pos_of_pos_of_pos, ha, hb, hc],
  show (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2), from h1,
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
  -- $\dfrac a {b + c} + \dfrac b {a + c} + \dfrac c {a + b} \ge \dfrac 3 2$
  have h1 : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2), from by auto [arithmetic_mean_ge_harmonic_mean],
  show (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2), from by auto [h1],
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
  -- $\dfrac a {b + c} + \dfrac b {a + c} + \dfrac c {a + b} \ge \dfrac 3 2$
  have h1 : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2), from by auto [arith_mean_harm_mean],
  show (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2), from by auto [h1],
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
  -- $A$ and $B$ are sets. $A$ and $B$ belong to power set of $S$
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  -- Then $A ⊆ S$ and $B ⊆ S$, by power set definition
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from by auto [set.subset_of_mem_powerset, set.subset_of_mem_powerset],
  -- Then $(A ∩ B) ⊆ A$, by intersection of set is a subset
  have h2 : (A ∩ B) ⊆ A, from by auto [set.inter_subset_left],
  -- Then $(A ∩ B) ⊆ S$, by subset relation is transitive
  have h3 : (A ∩ B) ⊆ S, from by auto [set.subset.trans],
  -- Hence $(A ∩ B) ∈  𝒫 S$, by power set definition
  show (A ∩ B) ∈  𝒫 S, from by auto [set.mem_powerset],
end

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

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  -- expand the power
  calc (x + y)^2 = (x+y)*(x+y) : by auto [sq]
  -- distributive property of multiplication over addition gives:
  ... = x*(x+y) + y*(x+y) : by auto [add_mul]
  -- applying the above property further gives:
  ... = x*x + x*y + y*x + y*y : by auto [mul_comm, add_mul] using [ring]
  -- rearranging the terms using commutativity and adding gives:
  ... = x^2 + 2*x*y + y^2 : by auto [sq, mul_comm] using [ring]
end

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

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

Setting $b = a$, this becomes:

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

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

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

  -- Setting $b = a$, this becomes:
  have h3 : ∀ a : G, ∃! x : G, a * x = a, from by auto [h1],
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from by auto [h2],

  -- These $x$ and $y$ are both $(1 : G)$, by definition of identity element
  have h5 : ∀ a : G, classical.some (h3 a).exists = (1 : G), from by auto [exists_unique.unique, h3, classical.some_spec, exists_unique.exists, mul_one],
  have h6 : ∀ a : G, classical.some (h4 a).exists = (1 : G), from by auto [exists_unique.unique, h4, classical.some_spec, exists_unique.exists, one_mul],

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

/--`theorem`
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)-/


theorem same{P: Prop}: (¬P) = (P → false) := rfl

theorem zneqo : 0 ≠ 1.
#check zneqo

theorem zneqoeqzneqo : (0 ≠ 1) = ¬(0 = 1) := rfl

theorem zneqo' : 0 = 1 → false :=
    λ h : (0 = 1),
        nat.no_confusion h

theorem zneqo'' : ¬ 0 = 1 :=
begin
    assume h : (0 = 1),
    show false,
    from nat.no_confusion h
end

#reduce nat.add_zero
#check nat.zero
#reduce nat.succ(nat.zero)
#reduce nat.succ(nat.succ(nat.zero))
#reduce nat.succ(4)

theorem ttneqff : ¬tt = ff :=
begin
    assume h : (tt = ff),
    show false,
    from bool.no_confusion h
end

theorem ttneqff' : tt ≠ ff.

theorem ex2 : 2 ≠ 1.

theorem proof_by_negation : ∀(P : Prop),
    (P → false) → ¬P :=
        λ P p, p

theorem proof_by_negation' : ∀(P : Prop),
    (P → false) → ¬P :=
begin
  assume P,
  assume pf_P_to_f,
  assume pf_P,
  exact pf_P_to_f pf_P,
end

lemma zneqo''': ¬(0 = 1) :=
begin
    apply proof_by_negation,
    assume h: (0 = 1),
    show false,
    from (nat.no_confusion h)
end

theorem qAndNotQfalse{Q: Prop}
  (pf: Q ∧ ¬Q): false :=
    pf.right pf.left

example: ∀(Q: Prop), Q ∧ ¬Q → false :=
begin
  assume Q,
  assume pf_Q_and_not_Q,
  have pf_Q := pf_Q_and_not_Q.left,
  have pf_not_Q := pf_Q_and_not_Q.right,
  contradiction,
end

theorem no_contra :
∀(Q: Prop), ¬(Q ∧ ¬Q) :=
    λ (Q : Prop) (pf : Q ∧ ¬Q),
        pf.right pf.left

theorem ncab{a b: nat}: ¬((a = b) ∧ (a ≠ b)) :=
begin
    apply no_contra,
end

theorem ncab'{a b: nat}: ¬((a = b) ∧ (a ≠ b)) :=
begin
  assume c : ((a = b) ∧ (a ≠ b)),
  have pf_eq := c.left,
  have pf_neq := c.right,
  have f := pf_neq pf_eq,
  assumption
end

-- classical logic
axiom em: ∀(P: Prop), P ∨ ¬P

example: ¬¬true :=
begin
  assume pf_not_true,
  have pf_true := true.intro,
  contradiction,
end

theorem double_neg_elim: ∀{P: Prop}, ¬¬P → P :=
begin
  assume P : Prop,
  assume pfNotNotP : ¬¬P,
  cases (em P) with pf_P pf_not_P,
    show P, from pf_P,

    have f: false := pfNotNotP pf_not_P,
    exact false.elim f
end

theorem prove_P: ∀{P: Prop}, ¬¬P → P :=
  λ(P)(pf_not_not_P),
    double_neg_elim pf_not_not_P

theorem proof_by_contradiction : ∀(P : Prop),
  (¬P → false) → P :=
    @double_neg_elim

theorem zeqz : 0 = 0 :=
begin
  apply proof_by_contradiction,
  assume pf: 0 = 0 → false,
  show false,
  from pf (eq.refl 0)
end

example{P Q: Prop}
  (pf: ¬P → (Q ∧ ¬ Q)): P :=
begin
  apply proof_by_contradiction,
  assume notP: ¬P,
  have contra := (pf notP),
  show false,
  from no_contra Q contra
end

theorem proof_by_contrapositive:
  ∀(P Q : Prop), (¬Q → ¬P) → (P → Q) :=
begin
  assume P Q: Prop,
  assume pf_not_Q_to_not_P: (¬Q → ¬P),
  assume pf_P : P,
  have pf_not_Q_to_false: ¬Q → false :=
    λ(pf_not_Q: ¬Q),
      no_contra P (and.intro pf_P (pf_not_Q_to_not_P pf_not_Q)),
  have pf_not_not_Q: ¬¬Q := pf_not_Q_to_false,
  show Q,
  from double_neg_elim pf_not_not_Q
end

theorem proof_by_contrapositive':
  ∀(P Q : Prop), (¬Q → ¬P) → (P → Q) :=
begin
  assume P Q,
  assume pf_not_Q_to_not_P: (¬Q → ¬P),
  assume pf_P : P,
  have pf_not_Q_to_false: ¬Q → false :=
    begin
      assume pf_not_Q,
      have pf_not_P := pf_not_Q_to_not_P pf_not_Q,
      exact pf_not_P pf_P
    end,
  have pf_not_not_Q: ¬¬Q := pf_not_Q_to_false,
  show Q,
  from double_neg_elim pf_not_not_Q
end

theorem proof_by_contrapositive'':
  ∀(P Q : Prop), (¬Q → ¬P) → (P → Q) :=
begin
  assume P Q,
  assume pf_not_Q_to_not_P: (¬Q → ¬P),
  assume pf_P : P,
  cases (em Q) with pf_Q pf_not_Q,
    -- Q
    assumption,
    -- ¬Q
    have pf_not_P := pf_not_Q_to_not_P pf_not_Q,
    contradiction,
end

theorem zeqz' : 0 = 0 → true :=
begin
  apply proof_by_contrapositive,
  assume nt : ¬true,
  have pff := nt true.intro,
  show ¬ 0 = 0,
  from false.elim pff
end


/-
Copyright (c) 2021 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import data.nat.parity
import order.filter.at_top_bot

/-!
# Numbers are frequently modeq to fixed numbers

In this file we prove that `m ≡ d [MOD n]` frequently as `m → ∞`.
-/

open filter

namespace nat

/-- Infinitely many natural numbers are equal to `d` mod `n`. -/
lemma frequently_modeq {n : ℕ} (h : n ≠ 0) (d : ℕ) : ∃ᶠ m in at_top, m ≡ d [MOD n] :=
((tendsto_add_at_top_nat d).comp (tendsto_id.nsmul_at_top h.bot_lt)).frequently $
  frequently_of_forall $ λ m, by { simp [nat.modeq_iff_dvd, ← sub_sub] }

lemma frequently_mod_eq {d n : ℕ} (h : d < n) : ∃ᶠ m in at_top, m % n = d :=
by simpa only [nat.modeq, mod_eq_of_lt h] using frequently_modeq h.ne_bot d

lemma frequently_even : ∃ᶠ m : ℕ in at_top, even m :=
by simpa only [even_iff] using frequently_mod_eq zero_lt_two

lemma frequently_odd : ∃ᶠ m : ℕ in at_top, odd m :=
by simpa only [odd_iff] using frequently_mod_eq one_lt_two

end nat


/-
Copyright (c) 2020 Fox Thomson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Fox Thomson
-/
import computability.DFA
import data.set.functor

/-!
# Nondeterministic Finite Automata
This file contains the definition of a Nondeterministic Finite Automaton (NFA), a state machine
which determines whether a string (implemented as a list over an arbitrary alphabet) is in a regular
set by evaluating the string over every possible path.
We show that DFA's are equivalent to NFA's however the construction from NFA to DFA uses an
exponential number of states.
Note that this definition allows for Automaton with infinite states, a `fintype` instance must be
supplied for true NFA's.
-/

universes u v

/-- An NFA is a set of states (`σ`), a transition function from state to state labelled by the
  alphabet (`step`), a starting state (`start`) and a set of acceptance states (`accept`).
  Note the transition function sends a state to a `set` of states. These are the states that it
  may be sent to. -/
structure NFA (α : Type u) (σ : Type v) :=
(step : σ → α → set σ)
(start : set σ)
(accept : set σ)

variables {α : Type u} {σ σ' : Type v} (M : NFA α σ)

namespace NFA

instance : inhabited (NFA α σ) := ⟨ NFA.mk (λ _ _, ∅) ∅ ∅ ⟩

/-- `M.step_set S a` is the union of `M.step s a` for all `s ∈ S`. -/
def step_set : set σ → α → set σ :=
λ Ss a, Ss >>= (λ S, (M.step S a))

/-- `M.eval_from S x` computes all possible paths though `M` with input `x` starting at an element
  of `S`. -/
def eval_from (start : set σ) : list α → set σ :=
list.foldl M.step_set start

/-- `M.eval x` computes all possible paths though `M` with input `x` starting at an element of
  `M.start`. -/
def eval := M.eval_from M.start

/-- `M.accepts` is the language of `x` such that there is an accept state in `M.eval x`. -/
def accepts : language α :=
λ x, ∃ S ∈ M.accept, S ∈ M.eval x

/-- `M.to_DFA` is an `DFA` constructed from a `NFA` `M` using the subset construction. The
  states is the type of `set`s of `M.state` and the step function is `M.step_set`. -/
def to_DFA : DFA α (set σ) :=
{ step := M.step_set,
  start := M.start,
  accept := {S | ∃ s ∈ S, s ∈ M.accept} }

@[simp] lemma to_DFA_correct :
  M.to_DFA.accepts = M.accepts :=
begin
  ext x,
  rw [accepts, DFA.accepts, eval, DFA.eval],
  change list.foldl _ _ _ ∈ {S | _} ↔ _,
  split; { exact λ ⟨w, h2, h3⟩, ⟨w, h3, h2⟩ },
end

lemma pumping_lemma [fintype σ] {x : list α} (hx : x ∈ M.accepts)
  (hlen : fintype.card (set σ) ≤ list.length x) :
  ∃ a b c, x = a ++ b ++ c ∧ a.length + b.length ≤ fintype.card (set σ) ∧ b ≠ [] ∧
  {a} * language.star {b} * {c} ≤ M.accepts :=
begin
  rw ←to_DFA_correct at hx ⊢,
  exact M.to_DFA.pumping_lemma hx hlen
end

end NFA

namespace DFA

/-- `M.to_NFA` is an `NFA` constructed from a `DFA` `M` by using the same start and accept
  states and a transition function which sends `s` with input `a` to the singleton `M.step s a`. -/
def to_NFA (M : DFA α σ') : NFA α σ' :=
{ step := λ s a, {M.step s a},
  start := {M.start},
  accept := M.accept }

@[simp] lemma to_NFA_eval_from_match (M : DFA α σ) (start : σ) (s : list α) :
  M.to_NFA.eval_from {start} s = {M.eval_from start s} :=
begin
  change list.foldl M.to_NFA.step_set {start} s = {list.foldl M.step start s},
  induction s with a s ih generalizing start,
  { tauto },
  { rw [list.foldl, list.foldl,
        show M.to_NFA.step_set {start} a = {M.step start a}, by simpa [NFA.step_set]],
    tauto }
end

@[simp] lemma to_NFA_correct (M : DFA α σ) :
  M.to_NFA.accepts = M.accepts :=
begin
  ext x,
  change (∃ S H, S ∈ M.to_NFA.eval_from {M.start} x) ↔ _,
  rw to_NFA_eval_from_match,
  split,
  { rintro ⟨ S, hS₁, hS₂ ⟩,
    rwa set.mem_singleton_iff.mp hS₂ at hS₁ },
  { exact λ h, ⟨M.eval x, h, rfl⟩ }
end

end DFA


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

! This file was ported from Lean 3 source module field_theory.finite.trace
! leanprover-community/mathlib commit 70fd9563a21e7b963887c9360bd29b2393e6225a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.RingTheory.Trace
import Mathbin.FieldTheory.Finite.GaloisField

/-!
# The trace map for finite fields

We state the fact that the trace map from a finite field of
characteristic `p` to `zmod p` is nondegenerate.

## Tags
finite field, trace
-/

namespace FiniteField

/-- The trace map from a finite field to its prime field is nongedenerate. -/
theorem trace_to_zMod_nondegenerate (F : Type _) [Field F] [Finite F] {a : F} (ha : a ≠ 0) :
    ∃ b : F, Algebra.trace (ZMod (ringChar F)) F (a * b) ≠ 0 :=
  by
  haveI : Fact (ringChar F).Prime := ⟨CharP.char_is_prime F _⟩
  have htr := traceFormNondegenerate (ZMod (ringChar F)) F a
  simp_rw [Algebra.traceForm_apply] at htr
  by_contra' hf
  exact ha (htr hf)
#align finite_field.trace_to_zmod_nondegenerate FiniteField.trace_to_zMod_nondegenerate

end FiniteField


/-
Copyright (c) 2022 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel

! This file was ported from Lean 3 source module measure_theory.measure.haar_of_inner
! leanprover-community/mathlib commit 46b633fd842bef9469441c0209906f6dddd2b4f5
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.InnerProductSpace.Orientation
import Mathbin.MeasureTheory.Measure.HaarLebesgue

/-!
# Volume forms and measures on inner product spaces

A volume form induces a Lebesgue measure on general finite-dimensional real vector spaces. In this
file, we discuss the specific situation of inner product spaces, where an orientation gives
rise to a canonical volume form. We show that the measure coming from this volume form gives
measure `1` to the parallelepiped spanned by any orthonormal basis, and that it coincides with
the canonical `volume` from the `measure_space` instance.
-/

open FiniteDimensional MeasureTheory MeasureTheory.Measure Set

variable {ι F : Type _}

variable [Fintype ι] [NormedAddCommGroup F] [InnerProductSpace ℝ F] [FiniteDimensional ℝ F]
  [MeasurableSpace F] [BorelSpace F]

section

variable {m n : ℕ} [_i : Fact (finrank ℝ F = n)]

include _i

/-- The volume form coming from an orientation in an inner product space gives measure `1` to the
parallelepiped associated to any orthonormal basis. This is a rephrasing of
`abs_volume_form_apply_of_orthonormal` in terms of measures. -/
theorem Orientation.measure_orthonormalBasis (o : Orientation ℝ F (Fin n))
    (b : OrthonormalBasis ι ℝ F) : o.volumeForm.Measure (parallelepiped b) = 1 :=
  by
  have e : ι ≃ Fin n := by
    refine' Fintype.equivFinOfCardEq _
    rw [← _i.out, finrank_eq_card_basis b.to_basis]
  have A : ⇑b = b.reindex e ∘ e := by
    ext x
    simp only [OrthonormalBasis.coe_reindex, Function.comp_apply, Equiv.symm_apply_apply]
  rw [A, parallelepiped_comp_equiv, AlternatingMap.measure_parallelepiped,
    o.abs_volume_form_apply_of_orthonormal, ENNReal.ofReal_one]
#align orientation.measure_orthonormal_basis Orientation.measure_orthonormalBasis

/-- In an oriented inner product space, the measure coming from the canonical volume form
associated to an orientation coincides with the volume. -/
theorem Orientation.measure_eq_volume (o : Orientation ℝ F (Fin n)) :
    o.volumeForm.Measure = volume :=
  by
  have A : o.volume_form.measure (stdOrthonormalBasis ℝ F).toBasis.parallelepiped = 1 :=
    Orientation.measure_orthonormalBasis o (stdOrthonormalBasis ℝ F)
  rw [add_haar_measure_unique o.volume_form.measure
      (stdOrthonormalBasis ℝ F).toBasis.parallelepiped,
    A, one_smul]
  simp only [volume, Basis.addHaar]
#align orientation.measure_eq_volume Orientation.measure_eq_volume

end

/-- The volume measure in a finite-dimensional inner product space gives measure `1` to the
parallelepiped spanned by any orthonormal basis. -/
theorem OrthonormalBasis.volume_parallelepiped (b : OrthonormalBasis ι ℝ F) :
    volume (parallelepiped b) = 1 :=
  by
  haveI : Fact (finrank ℝ F = finrank ℝ F) := ⟨rfl⟩
  let o := (stdOrthonormalBasis ℝ F).toBasis.Orientation
  rw [← o.measure_eq_volume]
  exact o.measure_orthonormal_basis b
#align orthonormal_basis.volume_parallelepiped OrthonormalBasis.volume_parallelepiped


lemma {u} FOIL {R : Type u} [ring R] : ∀ a b c d : R, (a + b) * (c + d) = a*c + a*d + b*c + b*d :=
by { intros, rw [left_distrib, right_distrib, right_distrib], ac_refl }

lemma {u} FOIL_neg_square {R : Type u} [comm_ring R] : ∀ a b : R, (a - b) * (a - b) = a*a + (-(a*b)+ -(a*b)) + b*b :=
by { intros, rw sub_eq_add_neg, rw FOIL,
     rw neg_mul_neg, repeat { rw add_assoc }, congr,
     rw neg_mul_eq_mul_neg, rw [mul_comm a b, neg_mul_eq_neg_mul] }

lemma {u} FOIL_sub {R : Type u} [ring R] : ∀ a b c d : R, (a - b) * (c - d) = a*c - a*d - b*c + b*d :=
by { intros, repeat { rw sub_eq_add_neg }, rw FOIL, rw neg_mul_eq_mul_neg, rw neg_mul_eq_neg_mul,
     apply congr_arg, rw [← neg_mul_eq_mul_neg, ← neg_mul_eq_neg_mul, neg_neg] }

lemma difference_of_squares {R} [comm_ring R] : ∀ x y : R, x * x - y*y = (x - y)*(x + y) :=
begin
  intros, rw sub_eq_add_neg, rw sub_eq_add_neg,
  rw FOIL, rw add_assoc (x*x), rw mul_comm (-y) x,
  rw ← neg_mul_eq_mul_neg, rw ← sub_eq_add_neg (x*y),
  rw sub_self, rw add_zero, congr, rw neg_mul_eq_mul_neg,
  rw mul_comm
end

lemma div_of_div_eq_self {F} [field F] : ∀ x y : F, x ≠ 0 → y ≠ 0 → x/(x/y) = y :=
begin
  intros, rw div_eq_mul_one_div x y,
  rw field.div_mul_eq_div_mul_one_div _ a,
  rw div_self a, rw one_mul,
  rw [one_div_eq_inv, one_div_eq_inv],
  rw division_ring.inv_inv a_1,
  apply one_div_ne_zero a_1,
end

lemma square_neg_one {R} [ring R] : (-1)*(-1) = (1 : R) :=
begin
  apply eq_of_sub_eq_zero, rw sub_eq_add_neg,
  transitivity (-1)*(-1) + (-1)*(1:R), rw mul_one,
  rw ← left_distrib, rw neg_add_self, rw mul_zero
end

lemma weird_analysis_trick {R} [ring R]
  : ∀ a b c d : R, a * c = (a - b) * (c - d) + a * d + b * c - b * d :=
begin
  intros, rw [sub_eq_add_neg a, sub_eq_add_neg c],
  rw FOIL, rw [← neg_mul_eq_neg_mul b (-d), mul_neg_eq_neg_mul_symm b d, neg_neg],
  rw add_right_comm _ (b*d), rw add_right_comm _ (b*d), rw add_sub_assoc,
  rw [sub_self, add_zero], rw add_right_comm _ (-b*c),
  rw [← neg_mul_eq_neg_mul, add_assoc, neg_add_self, add_zero],
  rw [add_assoc, mul_neg_eq_neg_mul_symm, neg_add_self, add_zero]
end

lemma eq_zero_of_sqr_eq_zero {F} [division_ring F] [decidable_eq F]
  : ∀ {x : F}, x * x = 0 → x = 0 :=
begin
  intros x h, by_contra h', refine (_ : x * x ≠ 0) h,
  apply division_ring.mul_ne_zero h' h'
end

lemma classical.l_or_r_eq_zero_of_mul_eq_zero {F} [division_ring F]
  : ∀ {x y : F}, x * y = 0 → x = 0 ∨ y = 0 :=
begin
  intros x y h, apply classical.by_contradiction,
  rw @decidable.not_or_iff_and_not _ _ (classical.prop_decidable _) (classical.prop_decidable _),
  intro h', apply division_ring.mul_ne_zero h'.left h'.right, assumption
end

lemma eq_sub_implies_sub_zero {G} [add_comm_group G]
  : ∀ x y : G, x = x - y → y = 0 :=
begin
  intros,
  transitivity x - (x - y), { rw sub_sub_self x y },
  rw ← a, apply sub_self
end


/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Leonardo de Moura
-/
import data.encodable
open nat encodable

/-
In mathematics, the axiom of dependent choice is a weak form of the axiom of choice that is
sufficient to develop most of real analysis. See http://en.wikipedia.org/wiki/Axiom_of_dependent_choice.
We can state it as follows:
-/
definition dependent_choice {A : Type} (R : A → A → Prop) :=
(∀ a : A, ∃ b : A, R a b) → (∀ a : A, ∃ f : nat → A, f 0 = a ∧ ∀ n, R (f n) (f (n+1)))

/-
If A is an encodable type, and R is a decidable relation, we can prove (dependent_choice R) using the
constructive choice function "choose"
-/
section depchoice
  parameters {A : Type} {R : A → A → Prop}
  parameters [encA : encodable A] [decR : decidable_rel R]
  include encA decR

  local infix `~` := R

  private definition f_aux (a : A) (H : ∀ a, ∃ b, a ~ b) : nat → A
  | 0     := a
  | (n+1) := choose (H (f_aux n))

  theorem dependent_choice_of_encodable_of_decidable : dependent_choice R :=
  assume H : ∀ a, ∃ b, a ~ b,
  take   a : A,
  let    f : nat → A := f_aux a H in
  have   f_zero : f 0 = a,            from rfl,
  have   R_seq  : ∀ n, f n ~ f (n+1), from
    take n, show f n ~ choose (H (f n)), from !choose_spec,
  exists.intro f (and.intro f_zero R_seq)

  /-
  The following slightly stronger version can be proved, where we also "return" the constructed function f.
  We just have to use Σ instead of ∃, and use Σ-constructor instead of exists.intro.
  Recall that ⟨f, H⟩ is notation for (sigma.mk f H)
  -/
  theorem stronger_dependent_choice_of_encodable_of_decidable
          : (∀ a, ∃ b, R a b) → (∀ a, Σ f, f (0:nat) = a ∧ ∀ n, f n ~ f (n+1))  :=
  assume H : ∀ a, ∃ b, a ~ b,
  take   a : A,
  let    f : nat → A := f_aux a H in
  have   f_zero : f 0 = a,            from rfl,
  have   R_seq  : ∀ n, f n ~ f (n+1), from
    take n, show f n ~ choose (H (f n)), from !choose_spec,
  ⟨f, and.intro f_zero R_seq⟩

end depchoice

/-
If we encode dependent_choice using Σ instead of ∃.
Then, we can prove this version without using any extra hypothesis (e.g., A is encodable or R is decidable).
The function f can be constructed directly from the hypothesis: ∀ a : A, Σ b : A, R a b
because Σ "carries" the witness 'b'. That is, we don't have to search for anything using "choose".
-/
open sigma.ops

section sigma_depchoice
  parameters {A : Type} {R : A → A → Prop}
  local infix `~` := R

  private definition f_aux (a : A) (H : ∀ a, Σ b, a ~ b) : nat → A
  | 0     := a
  | (n+1) := (H (f_aux n)).1

  theorem sigma_dependent_choice : (∀ a, Σ b, R a b) → (∀ a, Σ f, f (0:nat) = a ∧ ∀ n, f n ~ f (n+1)) :=
  assume H : ∀ a, Σ b, a ~ b,
  take   a : A,
  let    f : nat → A := f_aux a H in
  have   f_zero : f 0 = a,            from rfl,
  have   R_seq  : ∀ n, f n ~ f (n+1), from take n, (H (f n)).2,
  ⟨f, and.intro f_zero R_seq⟩
end sigma_depchoice


/-
Copyright (c) 2020 Oliver Nash. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Oliver Nash
-/
import linear_algebra.dual

/-!
# Contractions

Given modules $M, N$ over a commutative ring $R$, this file defines the natural linear maps:
$M^* \otimes M \to R$, $M \otimes M^* \to R$, and $M^* \otimes N → Hom(M, N)$, as well as proving
some basic properties of these maps.

## Tags

contraction, dual module, tensor product
-/

universes u v

section contraction
open tensor_product
open_locale tensor_product

variables (R : Type u) (M N : Type v)
variables [comm_ring R] [add_comm_group M] [add_comm_group N] [module R M] [module R N]

/-- The natural left-handed pairing between a module and its dual. -/
def contract_left : (module.dual R M) ⊗ M →ₗ[R] R := (uncurry _ _ _ _).to_fun linear_map.id

/-- The natural right-handed pairing between a module and its dual. -/
def contract_right : M ⊗ (module.dual R M) →ₗ[R] R :=
(uncurry _ _ _ _).to_fun (linear_map.flip linear_map.id)

/-- The natural map associating a linear map to the tensor product of two modules. -/
def dual_tensor_hom : (module.dual R M) ⊗ N →ₗ M →ₗ N :=
  let M' := module.dual R M in
  (uncurry R M' N (M →ₗ[R] N) : _ → M' ⊗ N →ₗ M →ₗ N) linear_map.smul_rightₗ

variables {R M N}

@[simp] lemma contract_left_apply (f : module.dual R M) (m : M) :
  contract_left R M (f ⊗ₜ m) = f m := by apply uncurry_apply

@[simp] lemma contract_right_apply (f : module.dual R M) (m : M) :
  contract_right R M (m ⊗ₜ f) = f m := by apply uncurry_apply

@[simp] lemma dual_tensor_hom_apply (f : module.dual R M) (m : M) (n : N) :
  dual_tensor_hom R M N (f ⊗ₜ n) m = (f m) • n :=
by { dunfold dual_tensor_hom, rw uncurry_apply, refl, }

end contraction


/-
Copyright (c) 2019 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Benjamin Davidson
-/
import data.nat.modeq
import algebra.parity

/-!
# Parity of natural numbers

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

This file contains theorems about the `even` and `odd` predicates on the natural numbers.

## Tags

even, odd
-/

namespace nat

variables {m n : ℕ}

@[simp] theorem mod_two_ne_one : ¬ n % 2 = 1 ↔ n % 2 = 0 :=
by cases mod_two_eq_zero_or_one n with h h; simp [h]

@[simp] theorem mod_two_ne_zero : ¬ n % 2 = 0 ↔ n % 2 = 1 :=
by cases mod_two_eq_zero_or_one n with h h; simp [h]

theorem even_iff : even n ↔ n % 2 = 0 :=
⟨λ ⟨m, hm⟩, by simp [← two_mul, hm],
  λ h, ⟨n / 2, (mod_add_div n 2).symm.trans (by simp [← two_mul, h])⟩⟩

theorem odd_iff : odd n ↔ n % 2 = 1 :=
⟨λ ⟨m, hm⟩, by norm_num [hm, add_mod],
 λ h, ⟨n / 2, (mod_add_div n 2).symm.trans (by rw [h, add_comm])⟩⟩

lemma not_even_iff : ¬ even n ↔ n % 2 = 1 :=
by rw [even_iff, mod_two_ne_zero]

lemma not_odd_iff : ¬ odd n ↔ n % 2 = 0 :=
by rw [odd_iff, mod_two_ne_one]

lemma even_iff_not_odd : even n ↔ ¬ odd n :=
by rw [not_odd_iff, even_iff]

@[simp] lemma odd_iff_not_even : odd n ↔ ¬ even n :=
by rw [not_even_iff, odd_iff]

lemma is_compl_even_odd : is_compl {n : ℕ | even n} {n | odd n} :=
by simp only [←set.compl_set_of, is_compl_compl, odd_iff_not_even]

lemma even_or_odd (n : ℕ) : even n ∨ odd n :=
or.imp_right odd_iff_not_even.2 $ em $ even n

lemma even_or_odd' (n : ℕ) : ∃ k, n = 2 * k ∨ n = 2 * k + 1 :=
by simpa only [← two_mul, exists_or_distrib, ← odd, ← even] using even_or_odd n

lemma even_xor_odd (n : ℕ) : xor (even n) (odd n) :=
begin
  cases even_or_odd n with h,
  { exact or.inl ⟨h, even_iff_not_odd.mp h⟩ },
  { exact or.inr ⟨h, odd_iff_not_even.mp h⟩ },
end

lemma even_xor_odd' (n : ℕ) : ∃ k, xor (n = 2 * k) (n = 2 * k + 1) :=
begin
  rcases even_or_odd n with ⟨k, rfl⟩ | ⟨k, rfl⟩;
  use k,
  { simpa only [← two_mul, xor, true_and, eq_self_iff_true, not_true, or_false, and_false]
      using (succ_ne_self (2*k)).symm },
  { simp only [xor, add_right_eq_self, false_or, eq_self_iff_true, not_true, not_false_iff,
              one_ne_zero, and_self] },
end

@[simp] theorem two_dvd_ne_zero : ¬ 2 ∣ n ↔ n % 2 = 1 :=
even_iff_two_dvd.symm.not.trans not_even_iff

instance : decidable_pred (even : ℕ → Prop) := λ n, decidable_of_iff _ even_iff.symm
instance : decidable_pred (odd : ℕ → Prop) := λ n, decidable_of_iff _ odd_iff_not_even.symm

theorem mod_two_add_add_odd_mod_two (m : ℕ) {n : ℕ} (hn : odd n) : m % 2 + (m + n) % 2 = 1 :=
(even_or_odd m).elim (λ hm, by rw [even_iff.1 hm, odd_iff.1 (hm.add_odd hn)]) $
  λ hm, by rw [odd_iff.1 hm, even_iff.1 (hm.add_odd hn)]

@[simp] theorem mod_two_add_succ_mod_two (m : ℕ) : m % 2 + (m + 1) % 2 = 1 :=
mod_two_add_add_odd_mod_two m odd_one

@[simp] theorem succ_mod_two_add_mod_two (m : ℕ) : (m + 1) % 2 + m % 2 = 1 :=
by rw [add_comm, mod_two_add_succ_mod_two]

mk_simp_attribute parity_simps "Simp attribute for lemmas about `even`"

@[simp] theorem not_even_one : ¬ even 1 :=
by rw even_iff; norm_num

@[parity_simps] theorem even_add : even (m + n) ↔ (even m ↔ even n) :=
by cases mod_two_eq_zero_or_one m with h₁ h₁;
   cases mod_two_eq_zero_or_one n with h₂ h₂;
   simp [even_iff, h₁, h₂, nat.add_mod];
   norm_num

theorem even_add' : even (m + n) ↔ (odd m ↔ odd n) :=
by rw [even_add, even_iff_not_odd, even_iff_not_odd, not_iff_not]

@[parity_simps] theorem even_add_one : even (n + 1) ↔ ¬ even n :=
by simp [even_add]

@[simp] theorem not_even_bit1 (n : ℕ) : ¬ even (bit1 n) :=
by simp [bit1] with parity_simps

lemma two_not_dvd_two_mul_add_one (n : ℕ) : ¬(2 ∣ 2 * n + 1) :=
by simp [add_mod]

lemma two_not_dvd_two_mul_sub_one : Π {n} (w : 0 < n), ¬(2 ∣ 2 * n - 1)
| (n + 1) _ := two_not_dvd_two_mul_add_one n

@[parity_simps] theorem even_sub (h : n ≤ m) : even (m - n) ↔ (even m ↔ even n) :=
begin
  conv { to_rhs, rw [←tsub_add_cancel_of_le h, even_add] },
  by_cases h : even n; simp [h]
end

theorem even_sub' (h : n ≤ m) : even (m - n) ↔ (odd m ↔ odd n) :=
by rw [even_sub h, even_iff_not_odd, even_iff_not_odd, not_iff_not]

theorem odd.sub_odd (hm : odd m) (hn : odd n) : even (m - n) :=
(le_total n m).elim
  (λ h, by simp only [even_sub' h, *])
  (λ h, by simp only [tsub_eq_zero_iff_le.mpr h, even_zero])

@[parity_simps] theorem even_mul : even (m * n) ↔ even m ∨ even n :=
by cases mod_two_eq_zero_or_one m with h₁ h₁;
   cases mod_two_eq_zero_or_one n with h₂ h₂;
   simp [even_iff, h₁, h₂, nat.mul_mod];
   norm_num

theorem odd_mul : odd (m * n) ↔ odd m ∧ odd n :=
by simp [not_or_distrib] with parity_simps

theorem odd.of_mul_left (h : odd (m * n)) : odd m :=
(odd_mul.mp h).1

theorem odd.of_mul_right (h : odd (m * n)) : odd n :=
(odd_mul.mp h).2

/-- If `m` and `n` are natural numbers, then the natural number `m^n` is even
if and only if `m` is even and `n` is positive. -/
@[parity_simps] theorem even_pow : even (m ^ n) ↔ even m ∧ n ≠ 0 :=
by { induction n with n ih; simp [*, pow_succ', even_mul], tauto }

theorem even_pow' (h : n ≠ 0) : even (m ^ n) ↔ even m :=
even_pow.trans $ and_iff_left h

theorem even_div : even (m / n) ↔ m % (2 * n) / n = 0 :=
by rw [even_iff_two_dvd, dvd_iff_mod_eq_zero, nat.div_mod_eq_mod_mul_div, mul_comm]

@[parity_simps] theorem odd_add : odd (m + n) ↔ (odd m ↔ even n) :=
by rw [odd_iff_not_even, even_add, not_iff, odd_iff_not_even]

theorem odd_add' : odd (m + n) ↔ (odd n ↔ even m) :=
by rw [add_comm, odd_add]

lemma ne_of_odd_add (h : odd (m + n)) : m ≠ n :=
λ hnot, by simpa [hnot] with parity_simps using h

@[parity_simps] theorem odd_sub (h : n ≤ m) : odd (m - n) ↔ (odd m ↔ even n) :=
by rw [odd_iff_not_even, even_sub h, not_iff, odd_iff_not_even]

theorem odd.sub_even (h : n ≤ m) (hm : odd m) (hn : even n) : odd (m - n) :=
(odd_sub h).mpr $ iff_of_true hm hn

theorem odd_sub' (h : n ≤ m) : odd (m - n) ↔ (odd n ↔ even m) :=
by rw [odd_iff_not_even, even_sub h, not_iff, not_iff_comm, odd_iff_not_even]

theorem even.sub_odd (h : n ≤ m) (hm : even m) (hn : odd n) : odd (m - n) :=
(odd_sub' h).mpr $ iff_of_true hn hm

lemma even_mul_succ_self (n : ℕ) : even (n * (n + 1)) :=
begin
  rw even_mul,
  convert n.even_or_odd,
  simp with parity_simps
end

lemma even_mul_self_pred (n : ℕ) : even (n * (n - 1)) :=
begin
  cases n,
  { exact even_zero },
  { rw mul_comm,
    apply even_mul_succ_self }
end

lemma two_mul_div_two_of_even : even n → 2 * (n / 2) = n :=
 λ h, nat.mul_div_cancel_left' (even_iff_two_dvd.mp h)

lemma div_two_mul_two_of_even : even n → n / 2 * 2 = n :=
λ h, nat.div_mul_cancel (even_iff_two_dvd.mp h)

lemma two_mul_div_two_add_one_of_odd (h : odd n) : 2 * (n / 2) + 1 = n :=
by { rw mul_comm, convert nat.div_add_mod' n 2, rw odd_iff.mp h }

lemma div_two_mul_two_add_one_of_odd (h : odd n) : n / 2 * 2 + 1 = n :=
by { convert nat.div_add_mod' n 2, rw odd_iff.mp h }

lemma one_add_div_two_mul_two_of_odd (h : odd n) : 1 + n / 2 * 2 = n :=
by { rw add_comm, convert nat.div_add_mod' n 2, rw odd_iff.mp h }

lemma bit0_div_two : bit0 n / 2 = n :=
by rw [←nat.bit0_eq_bit0, bit0_eq_two_mul, two_mul_div_two_of_even (even_bit0 n)]

@[simp] lemma bit0_div_bit0 : bit0 n / bit0 m = n / m :=
by rw [bit0_eq_two_mul m, ←nat.div_div_eq_div_mul, bit0_div_two]

@[simp] lemma bit1_div_bit0 : bit1 n / bit0 m = n / m :=
by rw [bit0_eq_two_mul, ←nat.div_div_eq_div_mul, bit1_div_two]

@[simp] lemma bit0_mod_bit0 : bit0 n % bit0 m = bit0 (n % m) :=
by rw [bit0_eq_two_mul n, bit0_eq_two_mul m, bit0_eq_two_mul (n % m), nat.mul_mod_mul_left]

@[simp] lemma bit1_mod_bit0 : bit1 n % bit0 m = bit1 (n % m) :=
begin
  have h₁ := congr_arg bit1 (nat.div_add_mod n m),
  -- `∀ m n : ℕ, bit0 m * n = bit0 (m * n)` seems to be missing...
  rw [bit1_add, bit0_eq_two_mul, ← mul_assoc, ← bit0_eq_two_mul] at h₁,
  have h₂ := nat.div_add_mod (bit1 n) (bit0 m),
  rw [bit1_div_bit0] at h₂,
  exact add_left_cancel (h₂.trans h₁.symm),
end

-- Here are examples of how `parity_simps` can be used with `nat`.

example (m n : ℕ) (h : even m) : ¬ even (n + 3) ↔ even (m^2 + m + n) :=
by simp [*, (dec_trivial : ¬ 2 = 0)] with parity_simps

example : ¬ even 25394535 :=
by simp

end nat

open nat

namespace function
namespace involutive

variables {α : Type*} {f : α → α} {n : ℕ}

theorem iterate_bit0 (hf : involutive f) (n : ℕ) : f^[bit0 n] = id :=
by rw [bit0, ← two_mul, iterate_mul, involutive_iff_iter_2_eq_id.1 hf, iterate_id]

theorem iterate_bit1 (hf : involutive f) (n : ℕ) : f^[bit1 n] = f :=
by rw [bit1, iterate_succ, hf.iterate_bit0, comp.left_id]

theorem iterate_even (hf : involutive f) (hn : even n) : f^[n] = id :=
let ⟨m, hm⟩ := hn in hm.symm ▸ hf.iterate_bit0 m

theorem iterate_odd (hf : involutive f) (hn : odd n) : f^[n] = f :=
let ⟨m, hm⟩ := odd_iff_exists_bit1.mp hn in hm.symm ▸ hf.iterate_bit1 m

theorem iterate_eq_self (hf : involutive f) (hne : f ≠ id) : f^[n] = f ↔ odd n :=
⟨λ H, odd_iff_not_even.2 $ λ hn, hne $ by rwa [hf.iterate_even hn, eq_comm] at H, hf.iterate_odd⟩

theorem iterate_eq_id (hf : involutive f) (hne : f ≠ id) : f^[n] = id ↔ even n :=
⟨λ H, even_iff_not_odd.2 $ λ hn, hne $ by rwa [hf.iterate_odd hn] at H, hf.iterate_even⟩

end involutive
end function

variables {R : Type*} [monoid R] [has_distrib_neg R] {n : ℕ}

lemma neg_one_pow_eq_one_iff_even (h : (-1 : R) ≠ 1) : (-1 : R) ^ n = 1 ↔ even n :=
⟨λ h', of_not_not $ λ hn, h $ (odd.neg_one_pow $ odd_iff_not_even.mpr hn).symm.trans h',
  even.neg_one_pow⟩

/-- If `a` is even, then `n` is odd iff `n % a` is odd. -/
lemma odd.mod_even_iff {n a : ℕ} (ha : even a) : odd (n % a) ↔ odd n :=
((even_sub' $ mod_le n a).mp $ even_iff_two_dvd.mpr $ (even_iff_two_dvd.mp ha).trans $
   dvd_sub_mod n).symm

/-- If `a` is even, then `n` is even iff `n % a` is even. -/
lemma even.mod_even_iff {n a : ℕ} (ha : even a) : even (n % a) ↔ even n :=
((even_sub $ mod_le n a).mp $ even_iff_two_dvd.mpr $ (even_iff_two_dvd.mp ha).trans $
   dvd_sub_mod n).symm

/-- If `n` is odd and `a` is even, then `n % a` is odd. -/
lemma odd.mod_even {n a : ℕ} (hn : odd n) (ha : even a) : odd (n % a) :=
(odd.mod_even_iff ha).mpr hn

/-- If `n` is even and `a` is even, then `n % a` is even. -/
lemma even.mod_even {n a : ℕ} (hn : even n) (ha : even a) : even (n % a) :=
(even.mod_even_iff ha).mpr hn

theorem odd.of_dvd_nat {m n : ℕ} (hn : odd n) (hm : m ∣ n) : odd m :=
odd_iff_not_even.2 $ mt hm.even (odd_iff_not_even.1 hn)

/-- `2` is not a factor of an odd natural number. -/
theorem odd.ne_two_of_dvd_nat {m n : ℕ} (hn : odd n) (hm : m ∣ n) : m ≠ 2 :=
begin
  rintro rfl,
  exact absurd (hn.of_dvd_nat hm) dec_trivial
end


import .list data.int.basic .logic

namespace int

lemma add_div {a b c : int} :
c ∣ a → c ∣ b → (a + b) / c = a / c + b / c :=
begin
  intros h1 h2,
  by_cases h3 : c = 0,
  { rw [h3, zero_dvd_iff] at *,
    rw [h1, h2, h3], refl },
  { apply eq_of_mul_eq_mul_right h3,
    rw add_mul, repeat {rw [int.div_mul_cancel]};
    try {apply dvd_add}; assumption }
end

end int

def ints.gcd : list int → nat
| []      := 0
| (i::is) := nat.gcd i.nat_abs (ints.gcd is)

lemma forall_mem_nil_eq_zero : ∀ x : int, x ∈ ([] : list int) → x = (0 : int) :=
begin intros x h1, cases h1 end

lemma forall_mem_cons_eq_zero (i : int) (is : list int) :
  (i = (0 : int)) →
  (∀ x : int, x ∈ is → x = (0 : int)) →
  (∀ x : int, x ∈ (i::is) → x = (0 : int)) :=
begin
  intros h1 h2, rw list.forall_mem_cons,
  constructor; assumption
end

meta instance int.has_reflect : has_reflect int := by tactic.mk_has_reflect_instance

def symdiv (i j : int) : int :=
if (2 * (i % j)) < j
then i / j
else (i / j) + 1

def symmod (i j : int) : int :=
if (2 * (i % j)) < j
then i % j
else (i % j) - j

lemma symmod_add_one {i} :
  0 < i → symmod i (i+1) = -1 :=
begin
  intro h1,
  simp only [symmod],
  rw int.mod_eq_of_lt (le_of_lt h1) (lt_add_one _),
  rw if_neg, simp,
  have h2 : 2 * i = (1 + 1) * i := rfl,
  simp [h2, add_mul], apply h1
end

lemma mul_symdiv_eq {i j} :
j * (symdiv i j) = i - (symmod i j) :=
begin
  simp only [symdiv, symmod],
  by_cases h1 : (2 * (i % j)) < j,
  { repeat {rw if_pos h1},
    rw [int.mod_def, sub_sub_cancel] },
  { repeat {rw if_neg h1},
    rw [int.mod_def, sub_sub, sub_sub_cancel,
      mul_add, mul_one] }
end

lemma symmod_eq {i j} :
  symmod i j = i - j * (symdiv i j) :=
by rw [mul_symdiv_eq, sub_sub_cancel]