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

/-!
# Preimage of a `finset` under an injective map.
-/

open set function

open_locale big_operators

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

namespace finset

section preimage

/-- Preimage of `s : finset β` under a map `f` injective of `f ⁻¹' s` as a `finset`.  -/
noncomputable def preimage (s : finset β) (f : α → β)
  (hf : set.inj_on f (f ⁻¹' ↑s)) : finset α :=
(s.finite_to_set.preimage hf).to_finset

@[simp] lemma mem_preimage {f : α → β} {s : finset β} {hf : set.inj_on f (f ⁻¹' ↑s)} {x : α} :
  x ∈ preimage s f hf ↔ f x ∈ s :=
set.finite.mem_to_finset _

@[simp, norm_cast] lemma coe_preimage {f : α → β} (s : finset β)
  (hf : set.inj_on f (f ⁻¹' ↑s)) : (↑(preimage s f hf) : set α) = f ⁻¹' ↑s :=
set.finite.coe_to_finset _

@[simp] lemma preimage_empty {f : α → β} : preimage ∅ f (by simp [inj_on]) = ∅ :=
finset.coe_injective (by simp)

@[simp] lemma preimage_univ {f : α → β} [fintype α] [fintype β] (hf) :
  preimage univ f hf = univ :=
finset.coe_injective (by simp)

@[simp] lemma preimage_inter [decidable_eq α] [decidable_eq β] {f : α → β} {s t : finset β}
  (hs : set.inj_on f (f ⁻¹' ↑s)) (ht : set.inj_on f (f ⁻¹' ↑t)) :
  preimage (s ∩ t) f (λ x₁ hx₁ x₂ hx₂, hs (mem_of_mem_inter_left hx₁) (mem_of_mem_inter_left hx₂))
    = preimage s f hs ∩ preimage t f ht :=
finset.coe_injective (by simp)

@[simp] lemma preimage_union [decidable_eq α] [decidable_eq β] {f : α → β} {s t : finset β} (hst) :
  preimage (s ∪ t) f hst
    = preimage s f (λ x₁ hx₁ x₂ hx₂, hst (mem_union_left _ hx₁) (mem_union_left _ hx₂))
    ∪ preimage t f (λ x₁ hx₁ x₂ hx₂, hst (mem_union_right _ hx₁) (mem_union_right _ hx₂)) :=
finset.coe_injective (by simp)

@[simp] lemma preimage_compl [decidable_eq α] [decidable_eq β] [fintype α] [fintype β]
  {f : α → β} (s : finset β) (hf : function.injective f) :
  preimage sᶜ f (hf.inj_on _) = (preimage s f (hf.inj_on _))ᶜ :=
finset.coe_injective (by simp)

lemma monotone_preimage {f : α → β} (h : injective f) :
  monotone (λ s, preimage s f (h.inj_on _)) :=
λ s t hst x hx, mem_preimage.2 (hst $ mem_preimage.1 hx)

lemma image_subset_iff_subset_preimage [decidable_eq β] {f : α → β} {s : finset α} {t : finset β}
  (hf : set.inj_on f (f ⁻¹' ↑t)) :
  s.image f ⊆ t ↔ s ⊆ t.preimage f hf :=
image_subset_iff.trans $ by simp only [subset_iff, mem_preimage]

lemma map_subset_iff_subset_preimage {f : α ↪ β} {s : finset α} {t : finset β} :
  s.map f ⊆ t ↔ s ⊆ t.preimage f (f.injective.inj_on _) :=
by classical; rw [map_eq_image, image_subset_iff_subset_preimage]

lemma image_preimage [decidable_eq β] (f : α → β) (s : finset β) [Π x, decidable (x ∈ set.range f)]
  (hf : set.inj_on f (f ⁻¹' ↑s)) :
  image f (preimage s f hf) = s.filter (λ x, x ∈ set.range f) :=
finset.coe_inj.1 $ by simp only [coe_image, coe_preimage, coe_filter,
  set.image_preimage_eq_inter_range, set.sep_mem_eq]

lemma image_preimage_of_bij [decidable_eq β] (f : α → β) (s : finset β)
  (hf : set.bij_on f (f ⁻¹' ↑s) ↑s) :
  image f (preimage s f hf.inj_on) = s :=
finset.coe_inj.1 $ by simpa using hf.image_eq

lemma sigma_preimage_mk {β : α → Type*} [decidable_eq α] (s : finset (Σ a, β a)) (t : finset α) :
  t.sigma (λ a, s.preimage (sigma.mk a) $ sigma_mk_injective.inj_on _) = s.filter (λ a, a.1 ∈ t) :=
by { ext x, simp [and_comm] }

lemma sigma_preimage_mk_of_subset {β : α → Type*} [decidable_eq α] (s : finset (Σ a, β a))
  {t : finset α} (ht : s.image sigma.fst ⊆ t) :
  t.sigma (λ a, s.preimage (sigma.mk a) $ sigma_mk_injective.inj_on _) = s :=
by rw [sigma_preimage_mk, filter_true_of_mem $ image_subset_iff.1 ht]

lemma sigma_image_fst_preimage_mk {β : α → Type*} [decidable_eq α] (s : finset (Σ a, β a)) :
  (s.image sigma.fst).sigma (λ a, s.preimage (sigma.mk a) $ sigma_mk_injective.inj_on _) = s :=
s.sigma_preimage_mk_of_subset (subset.refl _)

end preimage

@[to_additive]
lemma prod_preimage' [comm_monoid β] (f : α → γ) [decidable_pred $ λ x, x ∈ set.range f]
  (s : finset γ) (hf : set.inj_on f (f ⁻¹' ↑s)) (g : γ → β) :
  ∏ x in s.preimage f hf, g (f x) = ∏ x in s.filter (λ x, x ∈ set.range f), g x :=
by haveI := classical.dec_eq γ;
calc ∏ x in preimage s f hf, g (f x) = ∏ x in image f (preimage s f hf), g x :
  eq.symm $ prod_image $ by simpa only [mem_preimage, inj_on] using hf
  ... = ∏ x in s.filter (λ x, x ∈ set.range f), g x : by rw [image_preimage]

@[to_additive]

@[to_additive]
lemma prod_preimage_of_bij [comm_monoid β] (f : α → γ) (s : finset γ)
  (hf : set.bij_on f (f ⁻¹' ↑s) ↑s) (g : γ → β) :
  ∏ x in s.preimage f hf.inj_on, g (f x) = ∏ x in s, g x :=
prod_preimage _ _ hf.inj_on g $ λ x hxs hxf, (hxf $ hf.subset_range hxs).elim

end finset


-- Propiedad: ∀ a b : ℝ, a = a * b → a = 0 ∨ b = 1
-- ===============================================

import data.real.basic

variables (a b : ℝ)

-- ----------------------------------------------------
-- Ejercicio 1. Demostrar que para todo a y b, números
-- reales, se tiene
--    a = a * b → a = 0 ∨ b = 1
-- ----------------------------------------------------

-- 1ª demostración
example :
  a = a * b → a = 0 ∨ b = 1 :=
begin
  intro h1,
  have h2 : a * (1 - b) = 0,
    calc a * (1 - b)
         = a * 1 - a * b : mul_sub a 1 b
     ... = a - a * b     : by simp
     ... = 0             : by linarith,
  rw mul_eq_zero at h2,
  cases h2 with ha hb,
    { left,
      exact ha, },
    { right,
      linarith, },
end

-- 2ª demostración
example :
  a = a * b → a = 0 ∨ b = 1 :=
begin
  intro h1,
  have h2 : a * (1 - b) = 0,
    { calc a * (1 - b)
           = a - a * b     : by ring
       ... = 0             : by linarith, },
  rw mul_eq_zero at h2,
  cases h2 with ha hb,
    { left,
      exact ha, },
    { right,
      linarith, },
end

-- 3ª demostración
example :
  a = a * b → a = 0 ∨ b = 1 :=
begin
  intro h1,
  have h2 : a * (1 - b) = 0,
    { by linarith, },
  rw mul_eq_zero at h2,
  cases h2 with ha hb,
    { left,
      exact ha, },
    { right,
      linarith, },
end

-- 4ª demostración
example :
  a = a * b → a = 0 ∨ b = 1 :=
assume h1: a = a * b,
have h2 : a * (1 - b) = 0,
  by linarith,
have h3 : a = 0 ∨ 1 - b = 0,
  from mul_eq_zero.mp h2,
or.elim h3
  ( assume h3a : a = 0,
    show a = 0 ∨ b = 1,
      from or.inl h3a)
  ( assume h3b : 1 - b = 0,
    have h4 : b = 1,
      from by linarith,
    show a = 0 ∨ b = 1,
      from or.inr h4)


theorem le_total (a b : mynat) : a ≤ b ∨ b ≤ a :=
begin
revert a,
induction b with d hd,
intro a,
right,
exact zero_le _,
intro a,
cases a,
left,
exact zero_le _,
cases hd a,
left,
exact succ_le_succ _ _ h,
right,
exact succ_le_succ _ _ h,
end


import mynat.definition

namespace mynat

theorem succ_succ_inj (a b : mynat) (h : succ(succ(a)) = succ(succ(b))) : a = b :=
begin
    apply succ_inj,
    apply succ_inj,
    exact h,
end

end mynat


/-
Copyright (c) 2022 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov, Heather Macbeth

! This file was ported from Lean 3 source module analysis.normed_space.ball_action
! leanprover-community/mathlib commit 3339976e2bcae9f1c81e620836d1eb736e3c4700
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.Normed.Field.UnitBall
import Mathbin.Analysis.NormedSpace.Basic

/-!
# Multiplicative actions of/on balls and spheres

Let `E` be a normed vector space over a normed field `𝕜`. In this file we define the following
multiplicative actions.

- The closed unit ball in `𝕜` acts on open balls and closed balls centered at `0` in `E`.
- The unit sphere in `𝕜` acts on open balls, closed balls, and spheres centered at `0` in `E`.
-/

open Metric Set

variable {𝕜 𝕜' E : Type _} [NormedField 𝕜] [NormedField 𝕜'] [SeminormedAddCommGroup E]
  [NormedSpace 𝕜 E] [NormedSpace 𝕜' E] {r : ℝ}

section ClosedBall

instance mulActionClosedBallBall : MulAction (closedBall (0 : 𝕜) 1) (ball (0 : E) r)
    where
  smul c x :=
    ⟨(c : 𝕜) • x,
      mem_ball_zero_iff.2 <| by
        simpa only [norm_smul, one_mul] using
          mul_lt_mul' (mem_closedBall_zero_iff.1 c.2) (mem_ball_zero_iff.1 x.2) (norm_nonneg _)
            one_pos⟩
  one_smul x := Subtype.ext <| one_smul 𝕜 _
  mul_smul c₁ c₂ x := Subtype.ext <| mul_smul _ _ _
#align mul_action_closed_ball_ball mulActionClosedBallBall

instance continuousSMul_closedBall_ball : ContinuousSMul (closedBall (0 : 𝕜) 1) (ball (0 : E) r) :=
  ⟨(continuous_subtype_val.fst'.smul continuous_subtype_val.snd').subtype_mk _⟩
#align has_continuous_smul_closed_ball_ball continuousSMul_closedBall_ball

instance mulActionClosedBallClosedBall : MulAction (closedBall (0 : 𝕜) 1) (closedBall (0 : E) r)
    where
  smul c x :=
    ⟨(c : 𝕜) • x,
      mem_closedBall_zero_iff.2 <| by
        simpa only [norm_smul, one_mul] using
          mul_le_mul (mem_closedBall_zero_iff.1 c.2) (mem_closedBall_zero_iff.1 x.2) (norm_nonneg _)
            zero_le_one⟩
  one_smul x := Subtype.ext <| one_smul 𝕜 _
  mul_smul c₁ c₂ x := Subtype.ext <| mul_smul _ _ _
#align mul_action_closed_ball_closed_ball mulActionClosedBallClosedBall

instance continuousSMul_closedBall_closedBall :
    ContinuousSMul (closedBall (0 : 𝕜) 1) (closedBall (0 : E) r) :=
  ⟨(continuous_subtype_val.fst'.smul continuous_subtype_val.snd').subtype_mk _⟩
#align has_continuous_smul_closed_ball_closed_ball continuousSMul_closedBall_closedBall

end ClosedBall

section Sphere

instance mulActionSphereBall : MulAction (sphere (0 : 𝕜) 1) (ball (0 : E) r)
    where
  smul c x := inclusion sphere_subset_closedBall c • x
  one_smul x := Subtype.ext <| one_smul _ _
  mul_smul c₁ c₂ x := Subtype.ext <| mul_smul _ _ _
#align mul_action_sphere_ball mulActionSphereBall

instance continuousSMul_sphere_ball : ContinuousSMul (sphere (0 : 𝕜) 1) (ball (0 : E) r) :=
  ⟨(continuous_subtype_val.fst'.smul continuous_subtype_val.snd').subtype_mk _⟩
#align has_continuous_smul_sphere_ball continuousSMul_sphere_ball

instance mulActionSphereClosedBall : MulAction (sphere (0 : 𝕜) 1) (closedBall (0 : E) r)
    where
  smul c x := inclusion sphere_subset_closedBall c • x
  one_smul x := Subtype.ext <| one_smul _ _
  mul_smul c₁ c₂ x := Subtype.ext <| mul_smul _ _ _
#align mul_action_sphere_closed_ball mulActionSphereClosedBall

instance continuousSMul_sphere_closedBall :
    ContinuousSMul (sphere (0 : 𝕜) 1) (closedBall (0 : E) r) :=
  ⟨(continuous_subtype_val.fst'.smul continuous_subtype_val.snd').subtype_mk _⟩
#align has_continuous_smul_sphere_closed_ball continuousSMul_sphere_closedBall

instance mulActionSphereSphere : MulAction (sphere (0 : 𝕜) 1) (sphere (0 : E) r)
    where
  smul c x :=
    ⟨(c : 𝕜) • x,
      mem_sphere_zero_iff_norm.2 <| by
        rw [norm_smul, mem_sphere_zero_iff_norm.1 c.coe_prop, mem_sphere_zero_iff_norm.1 x.coe_prop,
          one_mul]⟩
  one_smul x := Subtype.ext <| one_smul _ _
  mul_smul c₁ c₂ x := Subtype.ext <| mul_smul _ _ _
#align mul_action_sphere_sphere mulActionSphereSphere

instance continuousSMul_sphere_sphere : ContinuousSMul (sphere (0 : 𝕜) 1) (sphere (0 : E) r) :=
  ⟨(continuous_subtype_val.fst'.smul continuous_subtype_val.snd').subtype_mk _⟩
#align has_continuous_smul_sphere_sphere continuousSMul_sphere_sphere

end Sphere

section IsScalarTower

variable [NormedAlgebra 𝕜 𝕜'] [IsScalarTower 𝕜 𝕜' E]

instance isScalarTower_closedBall_closedBall_closedBall :
    IsScalarTower (closedBall (0 : 𝕜) 1) (closedBall (0 : 𝕜') 1) (closedBall (0 : E) r) :=
  ⟨fun a b c => Subtype.ext <| smul_assoc (a : 𝕜) (b : 𝕜') (c : E)⟩
#align is_scalar_tower_closed_ball_closed_ball_closed_ball isScalarTower_closedBall_closedBall_closedBall

instance isScalarTower_closedBall_closedBall_ball :
    IsScalarTower (closedBall (0 : 𝕜) 1) (closedBall (0 : 𝕜') 1) (ball (0 : E) r) :=
  ⟨fun a b c => Subtype.ext <| smul_assoc (a : 𝕜) (b : 𝕜') (c : E)⟩
#align is_scalar_tower_closed_ball_closed_ball_ball isScalarTower_closedBall_closedBall_ball

instance isScalarTower_sphere_closedBall_closedBall :
    IsScalarTower (sphere (0 : 𝕜) 1) (closedBall (0 : 𝕜') 1) (closedBall (0 : E) r) :=
  ⟨fun a b c => Subtype.ext <| smul_assoc (a : 𝕜) (b : 𝕜') (c : E)⟩
#align is_scalar_tower_sphere_closed_ball_closed_ball isScalarTower_sphere_closedBall_closedBall

instance isScalarTower_sphere_closedBall_ball :
    IsScalarTower (sphere (0 : 𝕜) 1) (closedBall (0 : 𝕜') 1) (ball (0 : E) r) :=
  ⟨fun a b c => Subtype.ext <| smul_assoc (a : 𝕜) (b : 𝕜') (c : E)⟩
#align is_scalar_tower_sphere_closed_ball_ball isScalarTower_sphere_closedBall_ball

instance isScalarTower_sphere_sphere_closedBall :
    IsScalarTower (sphere (0 : 𝕜) 1) (sphere (0 : 𝕜') 1) (closedBall (0 : E) r) :=
  ⟨fun a b c => Subtype.ext <| smul_assoc (a : 𝕜) (b : 𝕜') (c : E)⟩
#align is_scalar_tower_sphere_sphere_closed_ball isScalarTower_sphere_sphere_closedBall

instance isScalarTower_sphere_sphere_ball :
    IsScalarTower (sphere (0 : 𝕜) 1) (sphere (0 : 𝕜') 1) (ball (0 : E) r) :=
  ⟨fun a b c => Subtype.ext <| smul_assoc (a : 𝕜) (b : 𝕜') (c : E)⟩
#align is_scalar_tower_sphere_sphere_ball isScalarTower_sphere_sphere_ball

instance isScalarTower_sphere_sphere_sphere :
    IsScalarTower (sphere (0 : 𝕜) 1) (sphere (0 : 𝕜') 1) (sphere (0 : E) r) :=
  ⟨fun a b c => Subtype.ext <| smul_assoc (a : 𝕜) (b : 𝕜') (c : E)⟩
#align is_scalar_tower_sphere_sphere_sphere isScalarTower_sphere_sphere_sphere

instance isScalarTower_sphere_ball_ball :
    IsScalarTower (sphere (0 : 𝕜) 1) (ball (0 : 𝕜') 1) (ball (0 : 𝕜') 1) :=
  ⟨fun a b c => Subtype.ext <| smul_assoc (a : 𝕜) (b : 𝕜') (c : 𝕜')⟩
#align is_scalar_tower_sphere_ball_ball isScalarTower_sphere_ball_ball

instance isScalarTower_closedBall_ball_ball :
    IsScalarTower (closedBall (0 : 𝕜) 1) (ball (0 : 𝕜') 1) (ball (0 : 𝕜') 1) :=
  ⟨fun a b c => Subtype.ext <| smul_assoc (a : 𝕜) (b : 𝕜') (c : 𝕜')⟩
#align is_scalar_tower_closed_ball_ball_ball isScalarTower_closedBall_ball_ball

end IsScalarTower

section SMulCommClass

variable [SMulCommClass 𝕜 𝕜' E]

instance sMulCommClass_closedBall_closedBall_closedBall :
    SMulCommClass (closedBall (0 : 𝕜) 1) (closedBall (0 : 𝕜') 1) (closedBall (0 : E) r) :=
  ⟨fun a b c => Subtype.ext <| smul_comm (a : 𝕜) (b : 𝕜') (c : E)⟩
#align smul_comm_class_closed_ball_closed_ball_closed_ball sMulCommClass_closedBall_closedBall_closedBall

instance sMulCommClass_closedBall_closedBall_ball :
    SMulCommClass (closedBall (0 : 𝕜) 1) (closedBall (0 : 𝕜') 1) (ball (0 : E) r) :=
  ⟨fun a b c => Subtype.ext <| smul_comm (a : 𝕜) (b : 𝕜') (c : E)⟩
#align smul_comm_class_closed_ball_closed_ball_ball sMulCommClass_closedBall_closedBall_ball

instance sMulCommClass_sphere_closedBall_closedBall :
    SMulCommClass (sphere (0 : 𝕜) 1) (closedBall (0 : 𝕜') 1) (closedBall (0 : E) r) :=
  ⟨fun a b c => Subtype.ext <| smul_comm (a : 𝕜) (b : 𝕜') (c : E)⟩
#align smul_comm_class_sphere_closed_ball_closed_ball sMulCommClass_sphere_closedBall_closedBall

instance sMulCommClass_sphere_closedBall_ball :
    SMulCommClass (sphere (0 : 𝕜) 1) (closedBall (0 : 𝕜') 1) (ball (0 : E) r) :=
  ⟨fun a b c => Subtype.ext <| smul_comm (a : 𝕜) (b : 𝕜') (c : E)⟩
#align smul_comm_class_sphere_closed_ball_ball sMulCommClass_sphere_closedBall_ball

instance sMulCommClass_sphere_ball_ball [NormedAlgebra 𝕜 𝕜'] :
    SMulCommClass (sphere (0 : 𝕜) 1) (ball (0 : 𝕜') 1) (ball (0 : 𝕜') 1) :=
  ⟨fun a b c => Subtype.ext <| smul_comm (a : 𝕜) (b : 𝕜') (c : 𝕜')⟩
#align smul_comm_class_sphere_ball_ball sMulCommClass_sphere_ball_ball

instance sMulCommClass_sphere_sphere_closedBall :
    SMulCommClass (sphere (0 : 𝕜) 1) (sphere (0 : 𝕜') 1) (closedBall (0 : E) r) :=
  ⟨fun a b c => Subtype.ext <| smul_comm (a : 𝕜) (b : 𝕜') (c : E)⟩
#align smul_comm_class_sphere_sphere_closed_ball sMulCommClass_sphere_sphere_closedBall

instance sMulCommClass_sphere_sphere_ball :
    SMulCommClass (sphere (0 : 𝕜) 1) (sphere (0 : 𝕜') 1) (ball (0 : E) r) :=
  ⟨fun a b c => Subtype.ext <| smul_comm (a : 𝕜) (b : 𝕜') (c : E)⟩
#align smul_comm_class_sphere_sphere_ball sMulCommClass_sphere_sphere_ball

instance sMulCommClass_sphere_sphere_sphere :
    SMulCommClass (sphere (0 : 𝕜) 1) (sphere (0 : 𝕜') 1) (sphere (0 : E) r) :=
  ⟨fun a b c => Subtype.ext <| smul_comm (a : 𝕜) (b : 𝕜') (c : E)⟩
#align smul_comm_class_sphere_sphere_sphere sMulCommClass_sphere_sphere_sphere

end SMulCommClass

variable (𝕜) [CharZero 𝕜]

theorem ne_neg_of_mem_sphere {r : ℝ} (hr : r ≠ 0) (x : sphere (0 : E) r) : x ≠ -x := fun h =>
  ne_zero_of_mem_sphere hr x
    ((self_eq_neg 𝕜 _).mp
      (by
        conv_lhs => rw [h]
        simp))
#align ne_neg_of_mem_sphere ne_neg_of_mem_sphere

theorem ne_neg_of_mem_unit_sphere (x : sphere (0 : E) 1) : x ≠ -x :=
  ne_neg_of_mem_sphere 𝕜 one_ne_zero x
#align ne_neg_of_mem_unit_sphere ne_neg_of_mem_unit_sphere


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Floris van Doorn, Sébastien Gouëzel, Alex J. Best
-/
import data.int.order.basic
import data.list.forall2

/-!
# Sums and products from lists

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

This file provides basic results about `list.prod`, `list.sum`, which calculate the product and sum
of elements of a list and `list.alternating_prod`, `list.alternating_sum`, their alternating
counterparts. These are defined in [`data.list.defs`](./defs).
-/

variables {ι α M N P M₀ G R : Type*}

namespace list
section monoid
variables [monoid M] [monoid N] [monoid P] {l l₁ l₂ : list M} {a : M}

@[simp, to_additive]
lemma prod_nil : ([] : list M).prod = 1 := rfl

@[to_additive]
lemma prod_singleton : [a].prod = a := one_mul a

@[simp, to_additive]
lemma prod_cons : (a :: l).prod = a * l.prod :=
calc (a :: l).prod = foldl (*) (a * 1) l : by simp only [list.prod, foldl_cons, one_mul, mul_one]
  ... = _ : foldl_assoc

@[simp, to_additive]
lemma prod_append : (l₁ ++ l₂).prod = l₁.prod * l₂.prod :=
calc (l₁ ++ l₂).prod = foldl (*) (foldl (*) 1 l₁ * 1) l₂ : by simp [list.prod]
  ... = l₁.prod * l₂.prod : foldl_assoc

@[to_additive]
lemma prod_concat : (l.concat a).prod = l.prod * a :=
by rw [concat_eq_append, prod_append, prod_singleton]

@[simp, to_additive]
lemma prod_join {l : list (list M)} : l.join.prod = (l.map list.prod).prod :=
by induction l; [refl, simp only [*, list.join, map, prod_append, prod_cons]]

@[to_additive]
lemma prod_eq_foldr : l.prod = foldr (*) 1 l :=
list.rec_on l rfl $ λ a l ihl, by rw [prod_cons, foldr_cons, ihl]

@[simp, priority 500, to_additive]
theorem prod_replicate (n : ℕ) (a : M) : (replicate n a).prod = a ^ n :=
begin
  induction n with n ih,
  { rw pow_zero, refl },
  { rw [list.replicate_succ, list.prod_cons, ih, pow_succ] }
end

@[to_additive sum_eq_card_nsmul]
lemma prod_eq_pow_card (l : list M) (m : M) (h : ∀ (x ∈ l), x = m) :
  l.prod = m ^ l.length :=
by rw [← prod_replicate, ← eq_replicate_length.2 h]

@[to_additive]
lemma prod_hom_rel (l : list ι) {r : M → N → Prop} {f : ι → M} {g : ι → N} (h₁ : r 1 1)
  (h₂ : ∀ ⦃i a b⦄, r a b → r (f i * a) (g i * b)) :
  r (l.map f).prod (l.map g).prod :=
list.rec_on l h₁ (λ a l hl, by simp only [map_cons, prod_cons, h₂ hl])

@[to_additive]
lemma prod_hom (l : list M) {F : Type*} [monoid_hom_class F M N] (f : F) :
  (l.map f).prod = f l.prod :=
by { simp only [prod, foldl_map, ← map_one f],
  exact l.foldl_hom _ _ _ 1 (map_mul f) }

@[to_additive]
lemma prod_hom₂ (l : list ι) (f : M → N → P)
  (hf : ∀ a b c d, f (a * b) (c * d) = f a c * f b d) (hf' : f 1 1 = 1) (f₁ : ι → M) (f₂ : ι → N) :
  (l.map $ λ i, f (f₁ i) (f₂ i)).prod = f (l.map f₁).prod (l.map f₂).prod :=
begin
  simp only [prod, foldl_map],
  convert l.foldl_hom₂ (λ a b, f a b) _ _ _ _ _ (λ a b i, _),
  { exact hf'.symm },
  { exact hf _ _ _ _ }
end

@[simp, to_additive]
lemma prod_map_mul {α : Type*} [comm_monoid α] {l : list ι} {f g : ι → α} :
  (l.map $ λ i, f i * g i).prod = (l.map f).prod * (l.map g).prod :=
l.prod_hom₂ (*) mul_mul_mul_comm (mul_one _) _ _

@[simp]
lemma prod_map_neg {α} [comm_monoid α] [has_distrib_neg α] (l : list α) :
  (l.map has_neg.neg).prod = (-1) ^ l.length * l.prod :=
by simpa only [id, neg_mul, one_mul, map_const', prod_replicate, map_id]
    using @prod_map_mul α α _ l (λ _, -1) id

@[to_additive]
lemma prod_map_hom (L : list ι) (f : ι → M) {G : Type*} [monoid_hom_class G M N] (g : G) :
  (L.map (g ∘ f)).prod = g ((L.map f).prod) :=
by rw [← prod_hom, map_map]

@[to_additive]
lemma prod_is_unit : Π {L : list M} (u : ∀ m ∈ L, is_unit m), is_unit L.prod
| [] _ := by simp
| (h :: t) u :=
begin
  simp only [list.prod_cons],
  exact is_unit.mul (u h (mem_cons_self h t)) (prod_is_unit (λ m mt, u m (mem_cons_of_mem h mt)))
end

@[to_additive]
lemma prod_is_unit_iff {α : Type*} [comm_monoid α] {L : list α} :
  is_unit L.prod ↔ ∀ m ∈ L, is_unit m :=
begin
  refine ⟨λ h, _, prod_is_unit⟩,
  induction L with m L ih,
  { exact λ m' h', false.elim (not_mem_nil m' h'), },
  rw [prod_cons, is_unit.mul_iff] at h,
  exact λ m' h', or.elim (eq_or_mem_of_mem_cons h') (λ H, H.substr h.1) (λ H, ih h.2 _ H),
end

@[simp, to_additive]
lemma prod_take_mul_prod_drop :
  ∀ (L : list M) (i : ℕ), (L.take i).prod * (L.drop i).prod = L.prod
| [] i := by simp [nat.zero_le]
| L 0 := by simp
| (h :: t) (n+1) := by { dsimp, rw [prod_cons, prod_cons, mul_assoc, prod_take_mul_prod_drop] }

@[simp, to_additive]
lemma prod_take_succ :
  ∀ (L : list M) (i : ℕ) (p), (L.take (i + 1)).prod = (L.take i).prod * L.nth_le i p
| [] i p := by cases p
| (h :: t) 0 _ := by simp
| (h :: t) (n+1) _ := by { dsimp, rw [prod_cons, prod_cons, prod_take_succ, mul_assoc] }

/-- A list with product not one must have positive length. -/
@[to_additive "A list with sum not zero must have positive length."]
lemma length_pos_of_prod_ne_one (L : list M) (h : L.prod ≠ 1) : 0 < L.length :=
by { cases L, { contrapose h, simp }, { simp } }

/-- A list with product greater than one must have positive length. -/
@[to_additive length_pos_of_sum_pos "A list with positive sum must have positive length."]
lemma length_pos_of_one_lt_prod [preorder M] (L : list M) (h : 1 < L.prod) :
  0 < L.length :=
length_pos_of_prod_ne_one L h.ne'

/-- A list with product less than one must have positive length. -/
@[to_additive "A list with negative sum must have positive length."]
lemma length_pos_of_prod_lt_one [preorder M] (L : list M) (h : L.prod < 1) :
  0 < L.length :=
length_pos_of_prod_ne_one L h.ne

@[to_additive]
lemma prod_update_nth : ∀ (L : list M) (n : ℕ) (a : M),
  (L.update_nth n a).prod =
    (L.take n).prod * (if n < L.length then a else 1) * (L.drop (n + 1)).prod
| (x :: xs) 0     a := by simp [update_nth]
| (x :: xs) (i+1) a := by simp [update_nth, prod_update_nth xs i a, mul_assoc]
| []      _     _ := by simp [update_nth, (nat.zero_le _).not_lt, nat.zero_le]

open mul_opposite

/-- We'd like to state this as `L.head * L.tail.prod = L.prod`, but because `L.head` relies on an
inhabited instance to return a garbage value on the empty list, this is not possible.
Instead, we write the statement in terms of `(L.nth 0).get_or_else 1`.
-/
@[to_additive "We'd like to state this as `L.head + L.tail.sum = L.sum`, but because `L.head`
relies on an inhabited instance to return a garbage value on the empty list, this is not possible.
Instead, we write the statement in terms of `(L.nth 0).get_or_else 0`."]
lemma nth_zero_mul_tail_prod (l : list M) : (l.nth 0).get_or_else 1 * l.tail.prod = l.prod :=
by cases l; simp

/-- Same as `nth_zero_mul_tail_prod`, but avoiding the `list.head` garbage complication by requiring
the list to be nonempty. -/
@[to_additive "Same as `nth_zero_add_tail_sum`, but avoiding the `list.head` garbage complication
by requiring the list to be nonempty."]
lemma head_mul_tail_prod_of_ne_nil [inhabited M] (l : list M) (h : l ≠ []) :
  l.head * l.tail.prod = l.prod :=
by cases l; [contradiction, simp]

@[to_additive]
lemma _root_.commute.list_prod_right (l : list M) (y : M) (h : ∀ (x ∈ l), commute y x) :
  commute y l.prod :=
begin
  induction l with z l IH,
  { simp },
  { rw list.ball_cons at h,
    rw list.prod_cons,
    exact commute.mul_right h.1 (IH h.2), }
end

@[to_additive]
lemma _root_.commute.list_prod_left (l : list M) (y : M) (h : ∀ (x ∈ l), commute x y) :
  commute l.prod y  :=
(commute.list_prod_right _ _ $ λ x hx, (h _ hx).symm).symm

@[to_additive sum_le_sum] lemma forall₂.prod_le_prod' [preorder M]
  [covariant_class M M (function.swap (*)) (≤)] [covariant_class M M (*) (≤)]
  {l₁ l₂ : list M} (h : forall₂ (≤) l₁ l₂) : l₁.prod ≤ l₂.prod :=
begin
  induction h with a b la lb hab ih ih',
  { refl },
  { simpa only [prod_cons] using mul_le_mul' hab ih' }
end

/-- If `l₁` is a sublist of `l₂` and all elements of `l₂` are greater than or equal to one, then
`l₁.prod ≤ l₂.prod`. One can prove a stronger version assuming `∀ a ∈ l₂.diff l₁, 1 ≤ a` instead
of `∀ a ∈ l₂, 1 ≤ a` but this lemma is not yet in `mathlib`. -/
@[to_additive sum_le_sum "If `l₁` is a sublist of `l₂` and all elements of `l₂` are nonnegative,
then `l₁.sum ≤ l₂.sum`. One can prove a stronger version assuming `∀ a ∈ l₂.diff l₁, 0 ≤ a` instead
of `∀ a ∈ l₂, 0 ≤ a` but this lemma is not yet in `mathlib`."]
lemma sublist.prod_le_prod' [preorder M] [covariant_class M M (function.swap (*)) (≤)]
  [covariant_class M M (*) (≤)] {l₁ l₂ : list M} (h : l₁ <+ l₂) (h₁ : ∀ a ∈ l₂, (1 : M) ≤ a) :
  l₁.prod ≤ l₂.prod :=
begin
  induction h, { refl },
  case cons : l₁ l₂ a ih ih'
  { simp only [prod_cons, forall_mem_cons] at h₁ ⊢,
    exact (ih' h₁.2).trans (le_mul_of_one_le_left' h₁.1) },
  case cons2 : l₁ l₂ a ih ih'
  { simp only [prod_cons, forall_mem_cons] at h₁ ⊢,
    exact mul_le_mul_left' (ih' h₁.2) _ }
end

@[to_additive sum_le_sum] lemma sublist_forall₂.prod_le_prod' [preorder M]
  [covariant_class M M (function.swap (*)) (≤)] [covariant_class M M (*) (≤)]
  {l₁ l₂ : list M} (h : sublist_forall₂ (≤) l₁ l₂) (h₁ : ∀ a ∈ l₂, (1 : M) ≤ a) :
  l₁.prod ≤ l₂.prod :=
let ⟨l, hall, hsub⟩ := sublist_forall₂_iff.1 h
in hall.prod_le_prod'.trans $ hsub.prod_le_prod' h₁

@[to_additive sum_le_sum] lemma prod_le_prod' [preorder M]
  [covariant_class M M (function.swap (*)) (≤)] [covariant_class M M (*) (≤)]
  {l : list ι} {f g : ι → M} (h : ∀ i ∈ l, f i ≤ g i) :
  (l.map f).prod ≤ (l.map g).prod :=
forall₂.prod_le_prod' $ by simpa

@[to_additive sum_lt_sum] lemma prod_lt_prod'
  [preorder M] [covariant_class M M (*) (<)] [covariant_class M M (*) (≤)]
  [covariant_class M M (function.swap (*)) (<)] [covariant_class M M (function.swap (*)) (≤)]
  {l : list ι} (f g : ι → M) (h₁ : ∀ i ∈ l, f i ≤ g i) (h₂ : ∃ i ∈ l, f i < g i) :
  (l.map f).prod < (l.map g).prod :=
begin
  induction l with i l ihl, { rcases h₂ with ⟨_, ⟨⟩, _⟩ },
  simp only [ball_cons, bex_cons, map_cons, prod_cons] at h₁ h₂ ⊢,
  cases h₂,
  exacts [mul_lt_mul_of_lt_of_le h₂ (prod_le_prod' h₁.2),
    mul_lt_mul_of_le_of_lt h₁.1 $ ihl h₁.2 h₂]
end

@[to_additive] lemma prod_lt_prod_of_ne_nil
  [preorder M] [covariant_class M M (*) (<)] [covariant_class M M (*) (≤)]
  [covariant_class M M (function.swap (*)) (<)] [covariant_class M M (function.swap (*)) (≤)]
  {l : list ι} (hl : l ≠ []) (f g : ι → M) (hlt : ∀ i ∈ l, f i < g i) :
  (l.map f).prod < (l.map g).prod :=
prod_lt_prod' f g (λ i hi, (hlt i hi).le) $ (exists_mem_of_ne_nil l hl).imp $ λ i hi, ⟨hi, hlt i hi⟩

@[to_additive sum_le_card_nsmul]
lemma prod_le_pow_card [preorder M]
  [covariant_class M M (function.swap (*)) (≤)] [covariant_class M M (*) (≤)]
  (l : list M) (n : M) (h : ∀ (x ∈ l), x ≤ n) :
  l.prod ≤ n ^ l.length :=
by simpa only [map_id'', map_const, prod_replicate] using prod_le_prod' h

@[to_additive exists_lt_of_sum_lt] lemma exists_lt_of_prod_lt' [linear_order M]
  [covariant_class M M (function.swap (*)) (≤)] [covariant_class M M (*) (≤)] {l : list ι}
  (f g : ι → M) (h : (l.map f).prod < (l.map g).prod) :
  ∃ i ∈ l, f i < g i :=
by { contrapose! h, exact prod_le_prod' h }

@[to_additive exists_le_of_sum_le]
lemma exists_le_of_prod_le' [linear_order M] [covariant_class M M (*) (<)]
  [covariant_class M M (*) (≤)] [covariant_class M M (function.swap (*)) (<)]
  [covariant_class M M (function.swap (*)) (≤)] {l : list ι} (hl : l ≠ [])
  (f g : ι → M) (h : (l.map f).prod ≤ (l.map g).prod) :
  ∃ x ∈ l, f x ≤ g x :=
by { contrapose! h, exact prod_lt_prod_of_ne_nil hl _ _ h }

@[to_additive sum_nonneg]
lemma one_le_prod_of_one_le [preorder M] [covariant_class M M (*) (≤)] {l : list M}
  (hl₁ : ∀ x ∈ l, (1 : M) ≤ x) :
  1 ≤ l.prod :=
begin
  -- We don't use `pow_card_le_prod` to avoid assumption
  -- [covariant_class M M (function.swap (*)) (≤)]
  induction l with hd tl ih, { refl },
  rw prod_cons,
  exact one_le_mul (hl₁ hd (mem_cons_self hd tl)) (ih (λ x h, hl₁ x (mem_cons_of_mem hd h)))
end

end monoid

section monoid_with_zero

variables [monoid_with_zero M₀]

/-- If zero is an element of a list `L`, then `list.prod L = 0`. If the domain is a nontrivial
monoid with zero with no divisors, then this implication becomes an `iff`, see
`list.prod_eq_zero_iff`. -/
lemma prod_eq_zero {L : list M₀} (h : (0 : M₀) ∈ L) : L.prod = 0 :=
begin
  induction L with a L ihL,
  { exact absurd h (not_mem_nil _) },
  { rw prod_cons,
    cases (mem_cons_iff _ _ _).1 h with ha hL,
    exacts [mul_eq_zero_of_left ha.symm _, mul_eq_zero_of_right _ (ihL hL)] }
end

/-- Product of elements of a list `L` equals zero if and only if `0 ∈ L`. See also
`list.prod_eq_zero` for an implication that needs weaker typeclass assumptions. -/
@[simp]

lemma prod_ne_zero [nontrivial M₀] [no_zero_divisors M₀] {L : list M₀} (hL : (0 : M₀) ∉ L) :
  L.prod ≠ 0 :=
mt prod_eq_zero_iff.1 hL

end monoid_with_zero

section group
variables [group G]

/-- This is the `list.prod` version of `mul_inv_rev` -/
@[to_additive "This is the `list.sum` version of `add_neg_rev`"]
lemma prod_inv_reverse : ∀ (L : list G), L.prod⁻¹ = (L.map (λ x, x⁻¹)).reverse.prod
| [] := by simp
| (x :: xs) := by simp [prod_inv_reverse xs]

/-- A non-commutative variant of `list.prod_reverse` -/
@[to_additive "A non-commutative variant of `list.sum_reverse`"]
lemma prod_reverse_noncomm : ∀ (L : list G), L.reverse.prod = (L.map (λ x, x⁻¹)).prod⁻¹ :=
by simp [prod_inv_reverse]

/-- Counterpart to `list.prod_take_succ` when we have an inverse operation -/
@[simp, to_additive /-"Counterpart to `list.sum_take_succ` when we have an negation operation"-/]
lemma prod_drop_succ :
  ∀ (L : list G) (i : ℕ) (p), (L.drop (i + 1)).prod = (L.nth_le i p)⁻¹ * (L.drop i).prod
| [] i p := false.elim (nat.not_lt_zero _ p)
| (x :: xs) 0 p := by simp
| (x :: xs) (i + 1) p := prod_drop_succ xs i _

end group

section comm_group
variables [comm_group G]

/-- This is the `list.prod` version of `mul_inv` -/
@[to_additive "This is the `list.sum` version of `add_neg`"]
lemma prod_inv : ∀ (L : list G), L.prod⁻¹ = (L.map (λ x, x⁻¹)).prod
| [] := by simp
| (x :: xs) := by simp [mul_comm, prod_inv xs]

/-- Alternative version of `list.prod_update_nth` when the list is over a group -/
@[to_additive /-"Alternative version of `list.sum_update_nth` when the list is over a group"-/]
lemma prod_update_nth' (L : list G) (n : ℕ) (a : G) :
  (L.update_nth n a).prod =
    L.prod * (if hn : n < L.length then (L.nth_le n hn)⁻¹ * a else 1) :=
begin
  refine (prod_update_nth L n a).trans _,
  split_ifs with hn hn,
  { rw [mul_comm _ a, mul_assoc a, prod_drop_succ L n hn, mul_comm _ (drop n L).prod,
      ← mul_assoc (take n L).prod, prod_take_mul_prod_drop, mul_comm a, mul_assoc] },
  { simp only [take_all_of_le (le_of_not_lt hn), prod_nil, mul_one,
      drop_eq_nil_of_le ((le_of_not_lt hn).trans n.le_succ)] }
end

end comm_group

@[to_additive]
lemma eq_of_prod_take_eq [left_cancel_monoid M] {L L' : list M} (h : L.length = L'.length)
  (h' : ∀ i ≤ L.length, (L.take i).prod = (L'.take i).prod) : L = L' :=
begin
  apply ext_le h (λ i h₁ h₂, _),
  have : (L.take (i + 1)).prod = (L'.take (i + 1)).prod := h' _ (nat.succ_le_of_lt h₁),
  rw [prod_take_succ L i h₁, prod_take_succ L' i h₂, h' i (le_of_lt h₁)] at this,
  convert mul_left_cancel this
end

@[to_additive]
lemma monotone_prod_take [canonically_ordered_monoid M] (L : list M) :
  monotone (λ i, (L.take i).prod) :=
begin
  apply monotone_nat_of_le_succ (λ n, _),
  cases lt_or_le n L.length with h h,
  { rw prod_take_succ _ _ h,
    exact le_self_mul },
  { simp [take_all_of_le h, take_all_of_le (le_trans h (nat.le_succ _))] }
end

@[to_additive sum_pos]
lemma one_lt_prod_of_one_lt [ordered_comm_monoid M] :
  ∀ (l : list M) (hl : ∀ x ∈ l, (1 : M) < x) (hl₂ : l ≠ []), 1 < l.prod
| [] _ h := (h rfl).elim
| [b] h _ := by simpa using h
| (a :: b :: l) hl₁ hl₂ :=
begin
  simp only [forall_eq_or_imp, list.mem_cons_iff _ a] at hl₁,
  rw list.prod_cons,
  apply one_lt_mul_of_lt_of_le' hl₁.1,
  apply le_of_lt ((b :: l).one_lt_prod_of_one_lt hl₁.2 (l.cons_ne_nil b)),
end

@[to_additive]
lemma single_le_prod [ordered_comm_monoid M] {l : list M} (hl₁ : ∀ x ∈ l, (1 : M) ≤ x) :
  ∀ x ∈ l, x ≤ l.prod :=
begin
  induction l,
  { simp },
  simp_rw [prod_cons, forall_mem_cons] at ⊢ hl₁,
  split,
  { exact le_mul_of_one_le_right' (one_le_prod_of_one_le hl₁.2) },
  { exact λ x H, le_mul_of_one_le_of_le hl₁.1 (l_ih hl₁.right x H) },
end

@[to_additive all_zero_of_le_zero_le_of_sum_eq_zero]
lemma all_one_of_le_one_le_of_prod_eq_one [ordered_comm_monoid M]
  {l : list M} (hl₁ : ∀ x ∈ l, (1 : M) ≤ x) (hl₂ : l.prod = 1) {x : M} (hx : x ∈ l) :
  x = 1 :=
le_antisymm (hl₂ ▸ single_le_prod hl₁ _ hx) (hl₁ x hx)

/-- Slightly more general version of `list.prod_eq_one_iff` for a non-ordered `monoid` -/
@[to_additive "Slightly more general version of `list.sum_eq_zero_iff`
  for a non-ordered `add_monoid`"]
lemma prod_eq_one [monoid M] {l : list M} (hl : ∀ (x ∈ l), x = (1 : M)) : l.prod = 1 :=
begin
  induction l with i l hil,
  { refl },
  rw [list.prod_cons, hil (λ x hx, hl _ (mem_cons_of_mem i hx)), hl _ (mem_cons_self i l), one_mul]
end

@[to_additive]
lemma exists_mem_ne_one_of_prod_ne_one [monoid M] {l : list M} (h : l.prod ≠ 1) :
  ∃ (x ∈ l), x ≠ (1 : M) :=
by simpa only [not_forall] using mt prod_eq_one h

-- TODO: develop theory of tropical rings
lemma sum_le_foldr_max [add_monoid M] [add_monoid N] [linear_order N] (f : M → N)
  (h0 : f 0 ≤ 0) (hadd : ∀ x y, f (x + y) ≤ max (f x) (f y)) (l : list M) :
  f l.sum ≤ (l.map f).foldr max 0 :=
begin
  induction l with hd tl IH,
  { simpa using h0 },
  simp only [list.sum_cons, list.foldr_map, list.foldr] at IH ⊢,
  exact (hadd _ _).trans (max_le_max le_rfl IH)
end

@[simp, to_additive]
lemma prod_erase [decidable_eq M] [comm_monoid M] {a} :
  ∀ {l : list M}, a ∈ l → a * (l.erase a).prod = l.prod
| (b :: l) h :=
  begin
    obtain rfl | ⟨ne, h⟩ := decidable.list.eq_or_ne_mem_of_mem h,
    { simp only [list.erase, if_pos, prod_cons] },
    { simp only [list.erase, if_neg (mt eq.symm ne), prod_cons, prod_erase h, mul_left_comm a b] }
  end

@[simp, to_additive]
lemma prod_map_erase [decidable_eq ι] [comm_monoid M] (f : ι → M) {a} :
  ∀ {l : list ι}, a ∈ l → f a * ((l.erase a).map f).prod = (l.map f).prod
| (b :: l) h :=
  begin
    obtain rfl | ⟨ne, h⟩ := decidable.list.eq_or_ne_mem_of_mem h,
    { simp only [map, erase_cons_head, prod_cons] },
    { simp only [map, erase_cons_tail _ ne.symm, prod_cons, prod_map_erase h,
        mul_left_comm (f a) (f b)], }
  end

lemma sum_const_nat (m n : ℕ) : sum (replicate m n) = m * n :=
by rw [sum_replicate, smul_eq_mul]

/-- The product of a list of positive natural numbers is positive,
and likewise for any nontrivial ordered semiring. -/
lemma prod_pos [strict_ordered_semiring R] (l : list R) (h : ∀ a ∈ l, (0 : R) < a) : 0 < l.prod :=
begin
  induction l with a l ih,
  { simp },
  { rw prod_cons,
    exact mul_pos (h _ $ mem_cons_self _ _) (ih $ λ a ha, h a $ mem_cons_of_mem _ ha) }
end

/-- A variant of `list.prod_pos` for `canonically_ordered_comm_semiring`. -/
@[simp]
lemma _root_.canonically_ordered_comm_semiring.list_prod_pos
  {α : Type*} [canonically_ordered_comm_semiring α] [nontrivial α] :
    Π {l : list α}, 0 < l.prod ↔ (∀ x ∈ l, (0 : α) < x)
| [] := ⟨λ h x hx, hx.elim, λ _, zero_lt_one⟩
| (x :: xs) := by simp_rw [prod_cons, mem_cons_iff, forall_eq_or_imp,
    canonically_ordered_comm_semiring.mul_pos,
    _root_.canonically_ordered_comm_semiring.list_prod_pos]

/-!
Several lemmas about sum/head/tail for `list ℕ`.
These are hard to generalize well, as they rely on the fact that `default ℕ = 0`.
If desired, we could add a class stating that `default = 0`.
-/

/-- This relies on `default ℕ = 0`. -/
lemma head_add_tail_sum (L : list ℕ) : L.head + L.tail.sum = L.sum :=
by { cases L, { simp, refl }, { simp } }

/-- This relies on `default ℕ = 0`. -/
lemma head_le_sum (L : list ℕ) : L.head ≤ L.sum := nat.le.intro (head_add_tail_sum L)

/-- This relies on `default ℕ = 0`. -/
lemma tail_sum (L : list ℕ) : L.tail.sum = L.sum - L.head :=
by rw [← head_add_tail_sum L, add_comm, add_tsub_cancel_right]

section alternating
section
variables [has_one α] [has_mul α] [has_inv α]

@[simp, to_additive] lemma alternating_prod_nil : alternating_prod ([] : list α) = 1 := rfl
@[simp, to_additive] lemma alternating_prod_singleton (a : α) : alternating_prod [a] = a := rfl

@[to_additive] lemma alternating_prod_cons_cons' (a b : α) (l : list α) :
  alternating_prod (a :: b :: l) = a * b⁻¹ * alternating_prod l := rfl

end

@[to_additive] lemma alternating_prod_cons_cons [div_inv_monoid α] (a b : α) (l : list α) :
  alternating_prod (a :: b :: l) = a / b * alternating_prod l :=
by rw [div_eq_mul_inv, alternating_prod_cons_cons']

variables [comm_group α]

@[to_additive] lemma alternating_prod_cons' :
  ∀ (a : α) (l : list α), alternating_prod (a :: l) = a * (alternating_prod l)⁻¹
| a [] := by rw [alternating_prod_nil, inv_one, mul_one, alternating_prod_singleton]
| a (b :: l) :=
by rw [alternating_prod_cons_cons', alternating_prod_cons' b l, mul_inv, inv_inv, mul_assoc]

@[simp, to_additive] lemma alternating_prod_cons (a : α) (l : list α) :
  alternating_prod (a :: l) = a / alternating_prod l :=
by rw [div_eq_mul_inv, alternating_prod_cons']

end alternating

lemma sum_nat_mod (l : list ℕ) (n : ℕ) : l.sum % n = (l.map (% n)).sum % n :=
by induction l; simp [nat.add_mod, *]

lemma prod_nat_mod (l : list ℕ) (n : ℕ) : l.prod % n = (l.map (% n)).prod % n :=
by induction l; simp [nat.mul_mod, *]

lemma sum_int_mod (l : list ℤ) (n : ℤ) : l.sum % n = (l.map (% n)).sum % n :=
by induction l; simp [int.add_mod, *]

lemma prod_int_mod (l : list ℤ) (n : ℤ) : l.prod % n = (l.map (% n)).prod % n :=
by induction l; simp [int.mul_mod, *]

end list

section monoid_hom

variables [monoid M] [monoid N]

@[to_additive]
lemma map_list_prod {F : Type*} [monoid_hom_class F M N] (f : F)
  (l : list M) : f l.prod = (l.map f).prod :=
(l.prod_hom f).symm

namespace monoid_hom

/-- Deprecated, use `_root_.map_list_prod` instead. -/
@[to_additive "Deprecated, use `_root_.map_list_sum` instead."]
protected lemma map_list_prod (f : M →* N) (l : list M) :
  f l.prod = (l.map f).prod :=
map_list_prod f l

end monoid_hom

end monoid_hom


-- Asociatividad_de_la_concatenacion_de_listas.lean
-- Asociatividad de la concatenación de listas
-- José A. Alonso Jiménez
-- Sevilla, 8 de septiembre de 2021
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- En Lean la operación de concatenación de listas se representa por
-- (++) y está caracterizada por los siguientes lemas
--    nil_append  : [] ++ ys = ys
--    cons_append : (x :: xs) ++ y = x :: (xs ++ ys)
--
-- Demostrar que la concatenación es asociativa; es decir,
--    xs ++ (ys ++ zs) = (xs ++ ys) ++ zs
-- ---------------------------------------------------------------------

import data.list.basic
import tactic
open list

variable  {α : Type}
variable  (x : α)
variables (xs ys zs : list α)

-- 1ª demostración
example :
  xs ++ (ys ++ zs) = (xs ++ ys) ++ zs :=
begin
  induction xs with a as HI,
  { calc [] ++ (ys ++ zs)
         = ys ++ zs                : append.equations._eqn_1 (ys ++ zs)
     ... = ([] ++ ys) ++ zs        : congr_arg2 (++) (append.equations._eqn_1 ys) rfl, },
  { calc (a :: as) ++ (ys ++ zs)
         = a :: (as ++ (ys ++ zs)) : append.equations._eqn_2 a as (ys ++ zs)
     ... = a :: ((as ++ ys) ++ zs) : congr_arg2 (::) rfl HI
     ... = (a :: (as ++ ys)) ++ zs : (append.equations._eqn_2 a (as ++ ys) zs).symm
     ... = ((a :: as) ++ ys) ++ zs : congr_arg2 (++) (append.equations._eqn_2 a as ys).symm rfl, },
end

-- 2ª demostración
example :
  xs ++ (ys ++ zs) = (xs ++ ys) ++ zs :=
begin
  induction xs with a as HI,
  { calc [] ++ (ys ++ zs)
         = ys ++ zs                : nil_append (ys ++ zs)
     ... = ([] ++ ys) ++ zs        : congr_arg2 (++) (nil_append ys) rfl, },
  { calc (a :: as) ++ (ys ++ zs)
         = a :: (as ++ (ys ++ zs)) : cons_append a as (ys ++ zs)
     ... = a :: ((as ++ ys) ++ zs) : congr_arg2 (::) rfl HI
     ... = (a :: (as ++ ys)) ++ zs : (cons_append a (as ++ ys) zs).symm
     ... = ((a :: as) ++ ys) ++ zs : congr_arg2 (++) (cons_append a as ys).symm rfl, },
end

-- 3ª demostración
example :
  xs ++ (ys ++ zs) = (xs ++ ys) ++ zs :=
begin
  induction xs with a as HI,
  { calc [] ++ (ys ++ zs)
         = ys ++ zs                : by rw nil_append
     ... = ([] ++ ys) ++ zs        : by rw nil_append, },
  { calc (a :: as) ++ (ys ++ zs)
         = a :: (as ++ (ys ++ zs)) : by rw cons_append
     ... = a :: ((as ++ ys) ++ zs) : by rw HI
     ... = (a :: (as ++ ys)) ++ zs : by rw cons_append
     ... = ((a :: as) ++ ys) ++ zs : by rw ← cons_append, },
end

-- 4ª demostración
example :
  xs ++ (ys ++ zs) = (xs ++ ys) ++ zs :=
begin
  induction xs with a as HI,
  { calc [] ++ (ys ++ zs)
         = ys ++ zs                : rfl
     ... = ([] ++ ys) ++ zs        : rfl, },
  { calc (a :: as) ++ (ys ++ zs)
         = a :: (as ++ (ys ++ zs)) : rfl
     ... = a :: ((as ++ ys) ++ zs) : by rw HI
     ... = (a :: (as ++ ys)) ++ zs : rfl
     ... = ((a :: as) ++ ys) ++ zs : rfl, },
end

-- 5ª demostración
example :
  xs ++ (ys ++ zs) = (xs ++ ys) ++ zs :=
begin
  induction xs with a as HI,
  { calc [] ++ (ys ++ zs)
         = ys ++ zs                : by simp
     ... = ([] ++ ys) ++ zs        : by simp, },
  { calc (a :: as) ++ (ys ++ zs)
         = a :: (as ++ (ys ++ zs)) : by simp
     ... = a :: ((as ++ ys) ++ zs) : congr_arg (cons a) HI
     ... = (a :: (as ++ ys)) ++ zs : by simp
     ... = ((a :: as) ++ ys) ++ zs : by simp, },
end

-- 6ª demostración
example :
  xs ++ (ys ++ zs) = (xs ++ ys) ++ zs :=
begin
  induction xs with a as HI,
  { by simp, },
  { by exact (cons_inj a).mpr HI, },
end

-- 7ª demostración
example :
  xs ++ (ys ++ zs) = (xs ++ ys) ++ zs :=
begin
  induction xs with a as HI,
  { rw nil_append,
    rw nil_append, },
  { rw cons_append,
    rw HI,
    rw cons_append,
    rw cons_append, },
end

-- 8ª demostración
example :
  xs ++ (ys ++ zs) = (xs ++ ys) ++ zs :=
list.rec_on xs
  ( show [] ++ (ys ++ zs) = ([] ++ ys) ++ zs,
      from calc
        [] ++ (ys ++ zs)
            = ys ++ zs         : by rw nil_append
        ... = ([] ++ ys) ++ zs : by rw nil_append )
  ( assume a as,
    assume HI : as ++ (ys ++ zs) = (as ++ ys) ++ zs,
    show (a :: as) ++ (ys  ++ zs) = ((a :: as) ++ ys) ++ zs,
      from calc
        (a :: as) ++ (ys ++ zs)
            = a :: (as ++ (ys ++ zs)) : by rw cons_append
        ... = a :: ((as ++ ys) ++ zs) : by rw HI
        ... = (a :: (as ++ ys)) ++ zs : by rw cons_append
        ... = ((a :: as) ++ ys) ++ zs : by rw ← cons_append)

-- 9ª demostración
example :
  xs ++ (ys ++ zs) = (xs ++ ys) ++ zs :=
list.rec_on xs
  (by simp)
  (by simp [*])

-- 10ª demostración
lemma conc_asoc_1 :
  ∀ xs, xs ++ (ys ++ zs) = (xs ++ ys) ++ zs
| [] := by calc
    [] ++ (ys ++ zs)
        = ys ++ zs         : by rw nil_append
    ... = ([] ++ ys) ++ zs : by rw nil_append
| (a :: as) := by calc
    (a :: as) ++ (ys ++ zs)
        = a :: (as ++ (ys ++ zs)) : by rw cons_append
    ... = a :: ((as ++ ys) ++ zs) : by rw conc_asoc_1
    ... = (a :: (as ++ ys)) ++ zs : by rw cons_append
    ... = ((a :: as) ++ ys) ++ zs : by rw ← cons_append

-- 11ª demostración
example :
  (xs ++ ys) ++ zs = xs ++ (ys ++ zs) :=
-- by library_search
append_assoc xs ys zs

-- 12ª demostración
example :
  (xs ++ ys) ++ zs = xs ++ (ys ++ zs) :=
by induction xs ; simp [*]

-- 13ª demostración
example :
  (xs ++ ys) ++ zs = xs ++ (ys ++ zs) :=
by simp


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

! This file was ported from Lean 3 source module order.prime_ideal
! leanprover-community/mathlib commit 740acc0e6f9adf4423f92a485d0456fc271482da
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Order.Ideal
import Mathlib.Order.PFilter

/-!
# Prime ideals

## Main definitions

Throughout this file, `P` is at least a preorder, but some sections require more
structure, such as a bottom element, a top element, or a join-semilattice structure.

- `Order.Ideal.PrimePair`: A pair of an `ideal` and a `pfilter` which form a partition of `P`.
  This is useful as giving the data of a prime ideal is the same as giving the data of a prime
  filter.
- `Order.Ideal.IsPrime`: a predicate for prime ideals. Dual to the notion of a prime filter.
- `Order.PFilter.IsPrime`: a predicate for prime filters. Dual to the notion of a prime ideal.

## References

- <https://en.wikipedia.org/wiki/Ideal_(order_theory)>

## Tags

ideal, prime

-/

open Order.PFilter

namespace Order

variable {P : Type _}

namespace Ideal

/-- A pair of an `ideal` and a `pfilter` which form a partition of `P`.
-/
-- porting note: no attr @[nolint has_nonempty_instance]
structure PrimePair (P : Type _) [Preorder P] where
  I : Ideal P
  F : PFilter P
  isCompl_I_F : IsCompl (I : Set P) F
#align order.ideal.prime_pair Order.Ideal.PrimePair

namespace PrimePair

variable [Preorder P] (IF : PrimePair P)

theorem compl_F_eq_I : (IF.F : Set P)ᶜ = IF.I :=
  IF.isCompl_I_F.eq_compl.symm
set_option linter.uppercaseLean3 false in
#align order.ideal.prime_pair.compl_F_eq_I Order.Ideal.PrimePair.compl_F_eq_I

theorem I_isProper : IsProper IF.I := by
  cases' IF.F.nonempty with w h
  apply isProper_of_not_mem (_ : w ∉ IF.I)
  rwa [← IF.compl_I_eq_F] at h
set_option linter.uppercaseLean3 false in
#align order.ideal.prime_pair.I_is_proper Order.Ideal.PrimePair.I_isProper

protected theorem disjoint : Disjoint (IF.I : Set P) IF.F :=
  IF.isCompl_I_F.Disjoint
#align order.ideal.prime_pair.disjoint Order.Ideal.PrimePair.disjoint

theorem I_union_F : (IF.I : Set P) ∪ IF.F = Set.univ :=
  IF.isCompl_I_F.sup_eq_top
set_option linter.uppercaseLean3 false in
#align order.ideal.prime_pair.I_union_F Order.Ideal.PrimePair.I_union_F

theorem F_union_I : (IF.F : Set P) ∪ IF.I = Set.univ :=
  IF.isCompl_I_F.symm.sup_eq_top
set_option linter.uppercaseLean3 false in
#align order.ideal.prime_pair.F_union_I Order.Ideal.PrimePair.F_union_I

end PrimePair

/-- An ideal `I` is prime if its complement is a filter.
-/
@[mk_iff]
class IsPrime [Preorder P] (I : Ideal P) extends IsProper I : Prop where
  compl_filter : IsPFilter ((I : Set P)ᶜ)
#align order.ideal.is_prime Order.Ideal.IsPrime

section Preorder

variable [Preorder P]

/-- Create an element of type `Order.Ideal.PrimePair` from an ideal satisfying the predicate
`Order.Ideal.IsPrime`. -/
def IsPrime.toPrimePair {I : Ideal P} (h : IsPrime I) : PrimePair P :=
  { I
    F := h.compl_filter.toPFilter
    isCompl_I_F := isCompl_compl }
#align order.ideal.is_prime.to_prime_pair Order.Ideal.IsPrime.toPrimePair

theorem PrimePair.I_isPrime (IF : PrimePair P) : IsPrime IF.I :=
  { IF.I_isProper with
    compl_filter := by
      rw [IF.compl_I_eq_F]
      exact IF.F.isPFilter }
set_option linter.uppercaseLean3 false in
#align order.ideal.prime_pair.I_is_prime Order.Ideal.PrimePair.I_isPrime

end Preorder

section SemilatticeInf

variable [SemilatticeInf P] {x y : P} {I : Ideal P}

theorem IsPrime.mem_or_mem (hI : IsPrime I) {x y : P} : x ⊓ y ∈ I → x ∈ I ∨ y ∈ I := by
  contrapose!
  let F := hI.compl_filter.toPFilter
  show x ∈ F ∧ y ∈ F → x ⊓ y ∈ F
  exact fun h => inf_mem h.1 h.2
#align order.ideal.is_prime.mem_or_mem Order.Ideal.IsPrime.mem_or_mem

theorem IsPrime.of_mem_or_mem [IsProper I] (hI : ∀ {x y : P}, x ⊓ y ∈ I → x ∈ I ∨ y ∈ I) :
    IsPrime I := by
  rw [IsPrime_iff]
  use ‹_›
  refine .of_def ?_ ?_ ?_
  · exact Set.nonempty_compl.2 (I.IsProper_iff.1 ‹_›)
  · intro x hx y hy
    exact ⟨x ⊓ y, fun h => (hI h).elim hx hy, inf_le_left, inf_le_right⟩
  · exact @mem_compl_of_ge _ _ _
#align order.ideal.is_prime.of_mem_or_mem Order.Ideal.IsPrime.of_mem_or_mem

theorem isPrime_iff_mem_or_mem [IsProper I] : IsPrime I ↔ ∀ {x y : P}, x ⊓ y ∈ I → x ∈ I ∨ y ∈ I :=
  ⟨IsPrime.mem_or_mem, IsPrime.of_mem_or_mem⟩
#align order.ideal.is_prime_iff_mem_or_mem Order.Ideal.isPrime_iff_mem_or_mem

end SemilatticeInf

section DistribLattice

variable [DistribLattice P] {I : Ideal P}

instance (priority := 100) IsMaximal.isPrime [IsMaximal I] : IsPrime I := by
  rw [isPrime_iff_mem_or_mem]
  intro x y
  contrapose!
  rintro ⟨hx, hynI⟩ hxy
  apply hynI
  let J := I ⊔ principal x
  have hJuniv : (J : Set P) = Set.univ :=
    IsMaximal.maximal_proper (lt_sup_principal_of_not_mem ‹_›)
  have hyJ : y ∈ ↑J := Set.eq_univ_iff_forall.mp hJuniv y
  rw [coe_sup_eq] at hyJ
  rcases hyJ with ⟨a, ha, b, hb, hy⟩
  rw [hy]
  refine' sup_mem ha (I.lower (le_inf hb _) hxy)
  rw [hy]
  exact le_sup_right
#align order.ideal.is_maximal.is_prime Order.Ideal.IsMaximal.isPrime

end DistribLattice

section BooleanAlgebra

variable [BooleanAlgebra P] {x : P} {I : Ideal P}

theorem IsPrime.mem_or_compl_mem (hI : IsPrime I) : x ∈ I ∨ xᶜ ∈ I := by
  apply hI.mem_or_mem
  rw [inf_compl_eq_bot]
  exact I.bot_mem
#align order.ideal.is_prime.mem_or_compl_mem Order.Ideal.IsPrime.mem_or_compl_mem

theorem IsPrime.mem_compl_of_not_mem (hI : IsPrime I) (hxnI : x ∉ I) : xᶜ ∈ I :=
  hI.mem_or_compl_mem.resolve_left hxnI
#align order.ideal.is_prime.mem_compl_of_not_mem Order.Ideal.IsPrime.mem_compl_of_not_mem

theorem isPrime_of_mem_or_compl_mem [IsProper I] (h : ∀ {x : P}, x ∈ I ∨ xᶜ ∈ I) : IsPrime I := by
  simp only [isPrime_iff_mem_or_mem, or_iff_not_imp_left]
  intro x y hxy hxI
  have hxcI : xᶜ ∈ I := h.resolve_left hxI
  have ass : x ⊓ y ⊔ y ⊓ xᶜ ∈ I := sup_mem hxy (I.lower inf_le_right hxcI)
  rwa [inf_comm, sup_inf_inf_compl] at ass
#align order.ideal.is_prime_of_mem_or_compl_mem Order.Ideal.isPrime_of_mem_or_compl_mem

theorem isPrime_iff_mem_or_compl_mem [IsProper I] : IsPrime I ↔ ∀ {x : P}, x ∈ I ∨ xᶜ ∈ I :=
  ⟨fun h _ => h.mem_or_compl_mem, isPrime_of_mem_or_compl_mem⟩
#align order.ideal.is_prime_iff_mem_or_compl_mem Order.Ideal.isPrime_iff_mem_or_compl_mem

instance (priority := 100) IsPrime.isMaximal [IsPrime I] : IsMaximal I := by
  simp only [IsMaximal_iff, Set.eq_univ_iff_forall, IsPrime.toIsProper, true_and]
  intro J hIJ x
  rcases Set.exists_of_ssubset hIJ with ⟨y, hyJ, hyI⟩
  suffices ass : x ⊓ y ⊔ x ⊓ yᶜ ∈ J
  · rwa [sup_inf_inf_compl] at ass
  exact
    sup_mem (J.lower inf_le_right hyJ)
      (hIJ.le <| I.lower inf_le_right <| IsPrime.mem_compl_of_not_mem ‹_› hyI)
#align order.ideal.is_prime.is_maximal Order.Ideal.IsPrime.isMaximal

end BooleanAlgebra

end Ideal

namespace PFilter

variable [Preorder P]

/-- A filter `F` is prime if its complement is an ideal.
-/
@[mk_iff]
class IsPrime (F : PFilter P) : Prop where
  compl_ideal : IsIdeal ((F : Set P)ᶜ)
#align order.pfilter.is_prime Order.PFilter.IsPrime

/-- Create an element of type `Order.Ideal.PrimePair` from a filter satisfying the predicate
`Order.PFilter.IsPrime`. -/
def IsPrime.toPrimePair {F : PFilter P} (h : IsPrime F) : Ideal.PrimePair P :=
  { I := h.compl_ideal.toIdeal
    F
    isCompl_I_F := isCompl_compl.symm }
#align order.pfilter.is_prime.to_prime_pair Order.PFilter.IsPrime.toPrimePair

theorem _root_.Order.Ideal.PrimePair.F_isPrime (IF : Ideal.PrimePair P) : IsPrime IF.F :=
  {
    compl_ideal := by
      rw [IF.compl_F_eq_I]
      exact IF.I.isIdeal }
set_option linter.uppercaseLean3 false in
#align order.ideal.prime_pair.F_is_prime Order.Ideal.PrimePair.F_isPrime

end PFilter

end Order


import game.sets.sets_level02 -- hide

namespace xena -- hide

open_locale classical -- hide

variable X : Type -- hide

/-
# Chapter 1 : Sets

## Level 3 : intersection (∩)
-/

/-
Now prove that for any two sets $A$ and $B$, $A ∩ B ⊆ A$.

You will need to rewrite the following term:

```
mem_inter_iff : x ∈ A ∩ B ↔ x ∈ A ∧ x ∈ B
```
-/

/- Axiom : mem_inter_iff :
x ∈ A ∩ B ↔ x ∈ A ∧ x ∈ B
-/

/- Hint : Stuck?
You need to start the same way as in the previous levels.
Try and get yourself into a situation where you have a
*hypothesis* `hAB : x ∈ A ∩ B` and then use `rw mem_inter_iff at hAB`.
-/

/- Hint: A note on `x ∈ A ∧ x ∈ B → x ∈ A`
By convention, ∧ binds more tightly than →
(i.e. `x ∈ A ∧ x ∈ B → x ∈ A` means `(x ∈ A ∧ x ∈ B) → x ∈ A`)
-/

/- Hint : Reminder about `cases`
The `cases h with hP hQ` tactic turns `h : P ∧ Q` into `hP : P` and `hQ : Q`
-/

/- Hint : The `tauto!` tactic
The `tauto!` tactic solves goals in propositional logic (i.e. problems where
the relevant hypotheses and goal just involve `∧`, `∨`, `¬` and `→` and
propositions -- for example it could easily solve this goal:

```
h : P ∧ Q
⊢ P
```
-/

/- Lemma
If $A$ and $B$ are sets of any type $X$, then
$$ A \cap B \subseteq A.$$
-/
theorem intersection_subset (A B : set X) : A ∩ B ⊆ A  :=
begin
  rw subset_iff,
  intro h, -- or cases, assumption
  intro j,
  rw mem_inter_iff at j,
  cases j with h,
  exact h,

end

end xena -- hide


import game.order.level07
import data.real.irrational

open real

namespace xena -- hide

/-
# Chapter 2 : Order

## Level 8

Prove by example that there exist pairs of real numbers
$a$ and $b$ such that $a \in \mathbb{R} \setminus \mathbb{Q}$,
$b \in \mathbb{R} \setminus \mathbb{Q}$,
but their product $a \cdot b$ is a rational number, $(a \cdot b) \in \mathbb{Q}$.
You may use this result in the Lean mathlib library:

`irrational_sqrt_two : irrational (sqrt 2)
-/

/- Lemma
Not true that for any $a$, $b$, irrational numbers, the product is
also an irrational number.
-/
theorem not_prod_irrational :
    ¬ ( ∀ (a b : ℝ), irrational a →  irrational b → irrational (a*b) ) :=
begin
  intro H,
  have H2 := H (sqrt 2) (sqrt 2),
  have H3 := H2 irrational_sqrt_two irrational_sqrt_two,
  apply H3,
  existsi (2 : ℚ),
  simp, norm_num, done
end

end xena -- hide


/-
Copyright (c) 2020 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson
-/
import order.rel_iso
import order.lattice_intervals
import order.galois_connection

/-!
# Modular Lattices
This file defines Modular Lattices, a kind of lattice useful in algebra.
For examples, look to the subobject lattices of abelian groups, submodules, and ideals, or consider
any distributive lattice.

## Main Definitions
- `is_modular_lattice` defines a modular lattice to be one such that
  `x ≤ z → (x ⊔ y) ⊓ z ≤ x ⊔ (y ⊓ z)`
- `inf_Icc_order_iso_Icc_sup` gives an order isomorphism between the intervals
  `[a ⊓ b, a]` and `[b, a ⊔ b]`.
  This corresponds to the diamond (or second) isomorphism theorems of algebra.

## Main Results
- `is_modular_lattice_iff_inf_sup_inf_assoc`:
  Modularity is equivalent to the `inf_sup_inf_assoc`: `(x ⊓ z) ⊔ (y ⊓ z) = ((x ⊓ z) ⊔ y) ⊓ z`
- `distrib_lattice.is_modular_lattice`: Distributive lattices are modular.

## To do
- Relate atoms and coatoms in modular lattices

-/

variable {α : Type*}

/-- A modular lattice is one with a limited associativity between `⊓` and `⊔`. -/
class is_modular_lattice α [lattice α] : Prop :=
(sup_inf_le_assoc_of_le : ∀ {x : α} (y : α) {z : α}, x ≤ z → (x ⊔ y) ⊓ z ≤ x ⊔ (y ⊓ z))

section is_modular_lattice
variables [lattice α] [is_modular_lattice α]

theorem sup_inf_assoc_of_le {x : α} (y : α) {z : α} (h : x ≤ z) :
  (x ⊔ y) ⊓ z = x ⊔ (y ⊓ z) :=
le_antisymm (is_modular_lattice.sup_inf_le_assoc_of_le y h)
  (le_inf (sup_le_sup_left inf_le_left _) (sup_le h inf_le_right))

theorem is_modular_lattice.inf_sup_inf_assoc {x y z : α} :
  (x ⊓ z) ⊔ (y ⊓ z) = ((x ⊓ z) ⊔ y) ⊓ z :=
(sup_inf_assoc_of_le y inf_le_right).symm

lemma inf_sup_assoc_of_le {x : α} (y : α) {z : α} (h : z ≤ x) :
  (x ⊓ y) ⊔ z = x ⊓ (y ⊔ z) :=
by rw [inf_comm, sup_comm, ← sup_inf_assoc_of_le y h, inf_comm, sup_comm]

instance : is_modular_lattice αᵒᵈ :=
⟨λ x y z xz, le_of_eq (by { rw [inf_comm, sup_comm, eq_comm, inf_comm, sup_comm],
  convert sup_inf_assoc_of_le (order_dual.of_dual y) (order_dual.dual_le.2 xz) })⟩

variables {x y z : α}

theorem is_modular_lattice.sup_inf_sup_assoc :
  (x ⊔ z) ⊓ (y ⊔ z) = ((x ⊔ z) ⊓ y) ⊔ z :=
@is_modular_lattice.inf_sup_inf_assoc αᵒᵈ _ _ _ _ _

theorem eq_of_le_of_inf_le_of_sup_le (hxy : x ≤ y) (hinf : y ⊓ z ≤ x ⊓ z) (hsup : y ⊔ z ≤ x ⊔ z) :
  x = y :=
le_antisymm hxy $
  have h : y ≤ x ⊔ z,
    from calc y ≤ y ⊔ z : le_sup_left
      ... ≤ x ⊔ z : hsup,
  calc y ≤ (x ⊔ z) ⊓ y : le_inf h le_rfl
    ... = x ⊔ (z ⊓ y) : sup_inf_assoc_of_le _ hxy
    ... ≤ x ⊔ (z ⊓ x) : sup_le_sup_left
      (by rw [inf_comm, @inf_comm _ _ z]; exact hinf) _
    ... ≤ x : sup_le le_rfl inf_le_right

theorem sup_lt_sup_of_lt_of_inf_le_inf (hxy : x < y) (hinf : y ⊓ z ≤ x ⊓ z) : x ⊔ z < y ⊔ z :=
lt_of_le_of_ne
  (sup_le_sup_right (le_of_lt hxy) _)
  (λ hsup, ne_of_lt hxy $ eq_of_le_of_inf_le_of_sup_le (le_of_lt hxy) hinf
    (le_of_eq hsup.symm))

theorem inf_lt_inf_of_lt_of_sup_le_sup (hxy : x < y) (hinf : y ⊔ z ≤ x ⊔ z) : x ⊓ z < y ⊓ z :=
@sup_lt_sup_of_lt_of_inf_le_inf αᵒᵈ _ _ _ _ _ hxy hinf

/-- A generalization of the theorem that if `N` is a submodule of `M` and
  `N` and `M / N` are both Artinian, then `M` is Artinian. -/
theorem well_founded_lt_exact_sequence
  {β γ : Type*} [partial_order β] [preorder γ]
  (h₁ : well_founded ((<) : β → β → Prop))
  (h₂ : well_founded ((<) : γ → γ → Prop))
  (K : α) (f₁ : β → α) (f₂ : α → β) (g₁ : γ → α) (g₂ : α → γ)
  (gci : galois_coinsertion f₁ f₂)
  (gi : galois_insertion g₂ g₁)
  (hf : ∀ a, f₁ (f₂ a) = a ⊓ K)
  (hg : ∀ a, g₁ (g₂ a) = a ⊔ K) :
  well_founded ((<) : α → α → Prop) :=
subrelation.wf
  (λ A B hAB, show prod.lex (<) (<) (f₂ A, g₂ A) (f₂ B, g₂ B),
    begin
      simp only [prod.lex_def, lt_iff_le_not_le, ← gci.l_le_l_iff,
        ← gi.u_le_u_iff, hf, hg, le_antisymm_iff],
      simp only [gci.l_le_l_iff, gi.u_le_u_iff, ← lt_iff_le_not_le, ← le_antisymm_iff],
      cases lt_or_eq_of_le (inf_le_inf_right K (le_of_lt hAB)) with h h,
      { exact or.inl h },
      { exact or.inr ⟨h, sup_lt_sup_of_lt_of_inf_le_inf hAB (le_of_eq h.symm)⟩ }
    end)
  (inv_image.wf _ (prod.lex_wf h₁ h₂))

/-- A generalization of the theorem that if `N` is a submodule of `M` and
  `N` and `M / N` are both Noetherian, then `M` is Noetherian.  -/
theorem well_founded_gt_exact_sequence
  {β γ : Type*} [preorder β] [partial_order γ]
  (h₁ : well_founded ((>) : β → β → Prop))
  (h₂ : well_founded ((>) : γ → γ → Prop))
  (K : α) (f₁ : β → α) (f₂ : α → β) (g₁ : γ → α) (g₂ : α → γ)
  (gci : galois_coinsertion f₁ f₂)
  (gi : galois_insertion g₂ g₁)
  (hf : ∀ a, f₁ (f₂ a) = a ⊓ K)
  (hg : ∀ a, g₁ (g₂ a) = a ⊔ K) :
  well_founded ((>) : α → α → Prop) :=
@well_founded_lt_exact_sequence αᵒᵈ _ _ γᵒᵈ βᵒᵈ _ _ h₂ h₁ K g₁ g₂ f₁ f₂ gi.dual gci.dual hg hf

/-- The diamond isomorphism between the intervals `[a ⊓ b, a]` and `[b, a ⊔ b]` -/
def inf_Icc_order_iso_Icc_sup (a b : α) : set.Icc (a ⊓ b) a ≃o set.Icc b (a ⊔ b) :=
{ to_fun := λ x, ⟨x ⊔ b, ⟨le_sup_right, sup_le_sup_right x.prop.2 b⟩⟩,
  inv_fun := λ x, ⟨a ⊓ x, ⟨inf_le_inf_left a x.prop.1, inf_le_left⟩⟩,
  left_inv := λ x, subtype.ext (by { change a ⊓ (↑x ⊔ b) = ↑x,
    rw [sup_comm, ← inf_sup_assoc_of_le _ x.prop.2, sup_eq_right.2 x.prop.1] }),
  right_inv := λ x, subtype.ext (by { change a ⊓ ↑x ⊔ b = ↑x,
    rw [inf_comm, inf_sup_assoc_of_le _ x.prop.1, inf_eq_left.2 x.prop.2] }),
  map_rel_iff' := λ x y, begin
    simp only [subtype.mk_le_mk, equiv.coe_fn_mk, and_true, le_sup_right],
    rw [← subtype.coe_le_coe],
    refine ⟨λ h, _, λ h, sup_le_sup_right h _⟩,
    rw [← sup_eq_right.2 x.prop.1, inf_sup_assoc_of_le _ x.prop.2, sup_comm,
      ← sup_eq_right.2 y.prop.1, inf_sup_assoc_of_le _ y.prop.2, @sup_comm _ _ b],
    exact inf_le_inf_left _ h
  end }
end is_modular_lattice

namespace is_compl
variables [lattice α] [bounded_order α] [is_modular_lattice α]

/-- The diamond isomorphism between the intervals `set.Iic a` and `set.Ici b`. -/
def Iic_order_iso_Ici {a b : α} (h : is_compl a b) : set.Iic a ≃o set.Ici b :=
(order_iso.set_congr (set.Iic a) (set.Icc (a ⊓ b) a) (h.inf_eq_bot.symm ▸ set.Icc_bot.symm)).trans $
  (inf_Icc_order_iso_Icc_sup a b).trans
  (order_iso.set_congr (set.Icc b (a ⊔ b)) (set.Ici b) (h.sup_eq_top.symm ▸ set.Icc_top))

end is_compl

theorem is_modular_lattice_iff_inf_sup_inf_assoc [lattice α] :
  is_modular_lattice α ↔ ∀ (x y z : α), (x ⊓ z) ⊔ (y ⊓ z) = ((x ⊓ z) ⊔ y) ⊓ z :=
⟨λ h, @is_modular_lattice.inf_sup_inf_assoc _ _ h, λ h, ⟨λ x y z xz, by rw [← inf_eq_left.2 xz, h]⟩⟩

namespace distrib_lattice

@[priority 100]
instance [distrib_lattice α] : is_modular_lattice α :=
⟨λ x y z xz, by rw [inf_sup_right, inf_eq_left.2 xz]⟩

end distrib_lattice

theorem disjoint.disjoint_sup_right_of_disjoint_sup_left
  [lattice α] [order_bot α] [is_modular_lattice α] {a b c : α}
  (h : disjoint a b) (hsup : disjoint (a ⊔ b) c) :
  disjoint a (b ⊔ c) :=
begin
  rw [disjoint, ← h.eq_bot, sup_comm],
  apply le_inf inf_le_left,
  apply (inf_le_inf_right (c ⊔ b) le_sup_right).trans,
  rw [sup_comm, is_modular_lattice.sup_inf_sup_assoc, hsup.eq_bot, bot_sup_eq]
end

theorem disjoint.disjoint_sup_left_of_disjoint_sup_right
  [lattice α] [order_bot α] [is_modular_lattice α] {a b c : α}
  (h : disjoint b c) (hsup : disjoint a (b ⊔ c)) :
  disjoint (a ⊔ b) c :=
begin
  rw [disjoint.comm, sup_comm],
  apply disjoint.disjoint_sup_right_of_disjoint_sup_left h.symm,
  rwa [sup_comm, disjoint.comm] at hsup,
end

namespace is_modular_lattice

variables [lattice α] [is_modular_lattice α] {a : α}

instance is_modular_lattice_Iic : is_modular_lattice (set.Iic a) :=
⟨λ x y z xz, (sup_inf_le_assoc_of_le (y : α) xz : (↑x ⊔ ↑y) ⊓ ↑z ≤ ↑x ⊔ ↑y ⊓ ↑z)⟩

instance is_modular_lattice_Ici : is_modular_lattice (set.Ici a) :=
⟨λ x y z xz, (sup_inf_le_assoc_of_le (y : α) xz : (↑x ⊔ ↑y) ⊓ ↑z ≤ ↑x ⊔ ↑y ⊓ ↑z)⟩

section is_complemented
variables [bounded_order α] [is_complemented α]

instance is_complemented_Iic : is_complemented (set.Iic a) :=
⟨λ ⟨x, hx⟩, let ⟨y, hy⟩ := exists_is_compl x in
  ⟨⟨y ⊓ a, set.mem_Iic.2 inf_le_right⟩, begin
    split,
    { change x ⊓ (y ⊓ a) ≤ ⊥, -- improve lattice subtype API
      rw ← inf_assoc,
      exact le_trans inf_le_left hy.1 },
    { change a ≤ x ⊔ (y ⊓ a), -- improve lattice subtype API
      rw [← sup_inf_assoc_of_le _ (set.mem_Iic.1 hx), top_le_iff.1 hy.2, top_inf_eq] }
  end⟩⟩

instance is_complemented_Ici : is_complemented (set.Ici a) :=
⟨λ ⟨x, hx⟩, let ⟨y, hy⟩ := exists_is_compl x in
  ⟨⟨y ⊔ a, set.mem_Ici.2 le_sup_right⟩, begin
    split,
    { change x ⊓ (y ⊔ a) ≤ a, -- improve lattice subtype API
      rw [← inf_sup_assoc_of_le _ (set.mem_Ici.1 hx),  le_bot_iff.1 hy.1, bot_sup_eq] },
    { change ⊤ ≤ x ⊔ (y ⊔ a), -- improve lattice subtype API
      rw ← sup_assoc,
      exact le_trans hy.2 le_sup_left }
  end⟩⟩

end is_complemented

end is_modular_lattice


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov, Sébastien Gouëzel
-/
import analysis.calculus.mean_value
import data.nat.parity
import analysis.special_functions.pow

/-!
# Collection of convex functions

In this file we prove that the following functions are convex:

* `convex_on_exp` : the exponential function is convex on $(-∞, +∞)$;
* `convex_on_pow_of_even` : given an even natural number $n$, the function $f(x)=x^n$
  is convex on $(-∞, +∞)$;
* `convex_on_pow` : for a natural $n$, the function $f(x)=x^n$ is convex on $[0, +∞)$;
* `convex_on_fpow` : for an integer $m$, the function $f(x)=x^m$ is convex on $(0, +∞)$.
* `convex_on_rpow : ∀ p : ℝ, 1 ≤ p → convex_on (Ici 0) (λ x, x ^ p)`
* `concave_on_log_Ioi` and `concave_on_log_Iio`: log is concave on `Ioi 0` and `Iio 0` respectively.
-/

open real set
open_locale big_operators

/-- `exp` is convex on the whole real line -/
lemma convex_on_exp : convex_on univ exp :=
convex_on_univ_of_deriv2_nonneg differentiable_exp (by simp)
  (assume x, (iter_deriv_exp 2).symm ▸ le_of_lt (exp_pos x))

/-- `x^n`, `n : ℕ` is convex on the whole real line whenever `n` is even -/
lemma convex_on_pow_of_even {n : ℕ} (hn : even n) : convex_on set.univ (λ x : ℝ, x^n) :=
begin
  apply convex_on_univ_of_deriv2_nonneg differentiable_pow,
  { simp only [deriv_pow', differentiable.mul, differentiable_const, differentiable_pow] },
  { intro x,
    rcases nat.even.sub_even hn (nat.even_bit0 1) with ⟨k, hk⟩,
    simp only [iter_deriv_pow, finset.prod_range_succ, finset.prod_range_zero, nat.sub_zero,
      mul_one, hk, pow_mul', sq],
    exact mul_nonneg (nat.cast_nonneg _) (mul_self_nonneg _) }
end

/-- `x^n`, `n : ℕ` is convex on `[0, +∞)` for all `n` -/
lemma convex_on_pow (n : ℕ) : convex_on (Ici 0) (λ x : ℝ, x^n) :=
begin
  apply convex_on_of_deriv2_nonneg (convex_Ici _) (continuous_pow n).continuous_on;
    simp only [interior_Ici, differentiable_on_pow, deriv_pow',
      differentiable_on_const, differentiable_on.mul, iter_deriv_pow],
  intros x hx,
  exact mul_nonneg (nat.cast_nonneg _) (pow_nonneg (le_of_lt hx) _)
end

lemma finset.prod_nonneg_of_card_nonpos_even
  {α β : Type*} [linear_ordered_comm_ring β]
  {f : α → β} [decidable_pred (λ x, f x ≤ 0)]
  {s : finset α} (h0 : even (s.filter (λ x, f x ≤ 0)).card) :
  0 ≤ ∏ x in s, f x :=
calc 0 ≤ (∏ x in s, ((if f x ≤ 0 then (-1:β) else 1) * f x)) :
  finset.prod_nonneg (λ x _, by
    { split_ifs with hx hx, by simp [hx], simp at hx ⊢, exact le_of_lt hx })
... = _ : by rw [finset.prod_mul_distrib, finset.prod_ite, finset.prod_const_one,
  mul_one, finset.prod_const, neg_one_pow_eq_pow_mod_two, nat.even_iff.1 h0, pow_zero, one_mul]

lemma int_prod_range_nonneg (m : ℤ) (n : ℕ) (hn : even n) :
  0 ≤ ∏ k in finset.range n, (m - k) :=
begin
  cases (le_or_lt ↑n m) with hnm hmn,
  { exact finset.prod_nonneg (λ k hk, sub_nonneg.2 (le_trans
      (int.coe_nat_le.2 $ le_of_lt $ finset.mem_range.1 hk) hnm)) },
  cases le_or_lt 0 m with hm hm,
  { lift m to ℕ using hm,
    exact le_of_eq (eq.symm $ finset.prod_eq_zero
      (finset.mem_range.2 $ int.coe_nat_lt.1 hmn) (sub_self _)) },
  clear hmn,
  apply finset.prod_nonneg_of_card_nonpos_even,
  convert hn,
  convert finset.card_range n,
  ext k,
  simp only [finset.mem_filter, finset.mem_range],
  refine ⟨and.left, λ hk, ⟨hk, sub_nonpos.2 $ le_trans (le_of_lt hm) _⟩⟩,
  exact int.coe_nat_nonneg k
end

/-- `x^m`, `m : ℤ` is convex on `(0, +∞)` for all `m` -/
lemma convex_on_fpow (m : ℤ) : convex_on (Ioi 0) (λ x : ℝ, x^m) :=
begin
  apply convex_on_of_deriv2_nonneg (convex_Ioi 0); try { rw [interior_Ioi] },
  { exact (differentiable_on_fpow $ lt_irrefl _).continuous_on },
  { exact differentiable_on_fpow (lt_irrefl _) },
  { have : eq_on (deriv (λx:ℝ, x^m)) (λx, ↑m * x^(m-1)) (Ioi 0),
      from λ x hx, deriv_fpow (ne_of_gt hx),
    refine (differentiable_on_congr this).2 _,
    exact (differentiable_on_fpow (lt_irrefl _)).const_mul _ },
  { intros x hx,
    simp only [iter_deriv_fpow (ne_of_gt hx)],
    refine mul_nonneg (int.cast_nonneg.2 _) (fpow_nonneg (le_of_lt hx) _),
    exact int_prod_range_nonneg _ _ (nat.even_bit0 1) }
end

lemma convex_on_rpow {p : ℝ} (hp : 1 ≤ p) : convex_on (Ici 0) (λ x : ℝ, x^p) :=
begin
  have A : deriv (λ (x : ℝ), x ^ p) = λ x, p * x^(p-1), by { ext x, simp [hp] },
  apply convex_on_of_deriv2_nonneg (convex_Ici 0),
  { apply (continuous_rpow_of_pos (λ _, lt_of_lt_of_le zero_lt_one hp)
      continuous_id continuous_const).continuous_on },
  { apply differentiable.differentiable_on, simp [hp] },
  { rw A,
    assume x hx,
    replace hx : x ≠ 0, by { simp at hx, exact ne_of_gt hx },
    simp [differentiable_at.differentiable_within_at, hx] },
  { assume x hx,
    replace hx : 0 < x, by simpa using hx,
    suffices : 0 ≤ p * ((p - 1) * x ^ (p - 1 - 1)), by simpa [ne_of_gt hx, A],
    apply mul_nonneg (le_trans zero_le_one hp),
    exact mul_nonneg (sub_nonneg_of_le hp) (rpow_nonneg_of_nonneg (le_of_lt hx) _) }
end

lemma concave_on_log_Ioi : concave_on (Ioi 0) log :=
begin
  have h₁ : Ioi 0 ⊆ ({0} : set ℝ)ᶜ,
  { intros x hx hx',
    rw [mem_singleton_iff] at hx',
    rw [hx'] at hx,
    exact lt_irrefl 0 hx },
  refine concave_on_open_of_deriv2_nonpos (convex_Ioi 0) is_open_Ioi _ _ _,
  { exact differentiable_on_log.mono h₁ },
  { refine ((times_cont_diff_on_log.deriv_of_open _ le_top).differentiable_on le_top).mono h₁,
    exact is_open_compl_singleton },
  { intros x hx,
    rw [function.iterate_succ, function.iterate_one],
    change (deriv (deriv log)) x ≤ 0,
    rw [deriv_log', deriv_inv (show x ≠ 0, by {rintro rfl, exact lt_irrefl 0 hx})],
    exact neg_nonpos.mpr (inv_nonneg.mpr (sq_nonneg x)) }
end

lemma concave_on_log_Iio : concave_on (Iio 0) log :=
begin
  have h₁ : Iio 0 ⊆ ({0} : set ℝ)ᶜ,
  { intros x hx hx',
    rw [mem_singleton_iff] at hx',
    rw [hx'] at hx,
    exact lt_irrefl 0 hx },
  refine concave_on_open_of_deriv2_nonpos (convex_Iio 0) is_open_Iio _ _ _,
  { exact differentiable_on_log.mono h₁ },
  { refine ((times_cont_diff_on_log.deriv_of_open _ le_top).differentiable_on le_top).mono h₁,
    exact is_open_compl_singleton },
  { intros x hx,
    rw [function.iterate_succ, function.iterate_one],
    change (deriv (deriv log)) x ≤ 0,
    rw [deriv_log', deriv_inv (show x ≠ 0, by {rintro rfl, exact lt_irrefl 0 hx})],
    exact neg_nonpos.mpr (inv_nonneg.mpr (sq_nonneg x)) }
end


import data.set.lattice

open set function

universes u1 u2 u3
variable  {α : Type u1}
variable  {β : Type u2}
variable  {I : Type u3}
variable  f : α → β
variable  A : I → set α
variable  B : I → set β

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    f '' (⋃ i, A i) = ⋃ i, f '' A i
-- ----------------------------------------------------------------------

example : f '' (⋃ i, A i) = ⋃ i, f '' A i :=
begin
  ext y,
  simp,
  split,
  { rintros ⟨x, ⟨i, xAi⟩, fxeq⟩,
    use [i, x, xAi, fxeq] },
  { rintros ⟨i, x, xAi, fxeq⟩,
    exact ⟨x, ⟨i, xAi⟩, fxeq⟩ },
end

-- Prueba
-- ======

/-
α : Type u1,
β : Type u2,
I : Type u3,
f : α → β,
A : I → set α
⊢ (f '' ⋃ (i : I), A i) = ⋃ (i : I), f '' A i
  >> ext y,
y : β
⊢ (y ∈ f '' ⋃ (i : I), A i) ↔ y ∈ ⋃ (i : I), f '' A i
  >> simp,
⊢ (∃ (x : α), (∃ (i : I), x ∈ A i) ∧ f x = y) ↔
  ∃ (i : I) (x : α), x ∈ A i ∧ f x = y
  >> split,
| ⊢ (∃ (x : α), (∃ (i : I), x ∈ A i) ∧ f x = y) →
|   (∃ (i : I) (x : α), x ∈ A i ∧ f x = y)
|   >> { rintros ⟨x, ⟨i, xAi⟩, fxeq⟩,
| x : α,
| fxeq : f x = y,
| i : I,
| xAi : x ∈ A i
| ⊢ ∃ (i : I) (x : α), x ∈ A i ∧ f x = y
|   >>   use [i, x, xAi, fxeq] },
⊢ (∃ (i : I) (x : α), x ∈ A i ∧ f x = y) →
  (∃ (x : α), (∃ (i : I), x ∈ A i) ∧ f x = y)
  >> { rintros ⟨i, x, xAi, fxeq⟩,
i : I,
x : α,
xAi : x ∈ A i,
fxeq : f x = y
⊢ ∃ (x : α), (∃ (i : I), x ∈ A i) ∧ f x = y
  >>   exact ⟨x, ⟨i, xAi⟩, fxeq⟩ },
no goals
-/

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    f '' (⋂ i, A i) ⊆ ⋂ i, f '' A i
-- ----------------------------------------------------------------------

example : f '' (⋂ i, A i) ⊆ ⋂ i, f '' A i :=
begin
  intro y,
  simp,
  intros x h fxeq i,
  use [x, h i, fxeq],
end

-- Prueba
-- ======

/-
α : Type u1,
β : Type u2,
I : Type u3,
f : α → β,
A : I → set α
⊢ (f '' ⋂ (i : I), A i) ⊆ ⋂ (i : I), f '' A i
  >> intro y,
y : β
⊢ (y ∈ f '' ⋂ (i : I), A i) → (y ∈ ⋂ (i : I), f '' A i)
  >> simp,
⊢ ∀ (x : α), (∀ (i : I), x ∈ A i) → f x = y →
  ∀ (i : I), ∃ (x : α), x ∈ A i ∧ f x = y
  >> intros x h fxeq i,
x : α,
h : ∀ (i : I), x ∈ A i,
fxeq : f x = y,
i : I
⊢ ∃ (x : α), x ∈ A i ∧ f x = y
  >> use [x, h i, fxeq],
no goals
-/

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que si f es inyectiva e I no vacío, entonces
--    (⋂ i, f '' A i) ⊆ f '' (⋂ i, A i)
-- ----------------------------------------------------------------------

example
  (i : I)
  (injf : injective f)
  : (⋂ i, f '' A i) ⊆ f '' (⋂ i, A i) :=
begin
  intro y,
  simp,
  intro h,
  rcases h i with ⟨x, xAi, fxeq⟩,
  use x,
  split,
  { intro i',
    rcases h i' with ⟨x', x'Ai, fx'eq⟩,
    have : f x = f x', by rw [fxeq, fx'eq],
    have : x = x', from injf this,
    rw this,
    exact x'Ai },
  { exact fxeq },
end

-- Prueba
-- ======

/-
α : Type u1,
β : Type u2,
I : Type u3,
f : α → β,
A : I → set α,
i : I,
injf : injective f
⊢ (⋂ (i : I), f '' A i) ⊆ f '' ⋂ (i : I), A i
  >> intro y,
y : β
⊢ (y ∈ ⋂ (i : I), f '' A i) → (y ∈ f '' ⋂ (i : I), A i)
  >> simp,
⊢ (∀ (i : I), ∃ (x : α), x ∈ A i ∧ f x = y) →
  (∃ (x : α), (∀ (i : I), x ∈ A i) ∧ f x = y)
  >> intro h,
h : ∀ (i : I), ∃ (x : α), x ∈ A i ∧ f x = y
⊢ ∃ (x : α), (∀ (i : I), x ∈ A i) ∧ f x = y
  >> rcases h i with ⟨x, xAi, fxeq⟩,
x : α,
xAi : x ∈ A i,
fxeq : f x = y
⊢ ∃ (x : α), (∀ (i : I), x ∈ A i) ∧ f x = y
  >> use x,
⊢ (∀ (i : I), x ∈ A i) ∧ f x = y
  >> split,
| ⊢ ∀ (i : I), x ∈ A i
|   >> { intro i',
| i' : I
| ⊢ x ∈ A i'
|   >>   rcases h i' with ⟨x', x'Ai, fx'eq⟩,
| i' : I,
| x' : α,
| x'Ai : x' ∈ A i',
| fx'eq : f x' = y
| ⊢ x ∈ A i'
|   >>   have : f x = f x', by rw [fxeq, fx'eq],
| this : f x = f x'
| ⊢ x ∈ A i'
|   >>   have : x = x', from injf this,
| this : x = x'
| ⊢ x ∈ A i'
|   >>   rw this,
| ⊢ x' ∈ A i'
|   >>   exact x'Ai },
⊢ f x = y
  >> { exact fxeq },
no goals
-/

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    f ⁻¹' (⋃ i, B i) = ⋃ i, f ⁻¹' (B i)
-- ----------------------------------------------------------------------

example : f ⁻¹' (⋃ i, B i) = ⋃ i, f ⁻¹' (B i) :=
by { ext x, simp }

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    f ⁻¹' (⋂ i, B i) = ⋂ i, f ⁻¹' (B i)
-- ----------------------------------------------------------------------

example : f ⁻¹' (⋂ i, B i) = ⋂ i, f ⁻¹' (B i) :=
by { ext x, simp }


/-
Copyright (c) 2020 Zhouhang Zhou. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Zhouhang Zhou
-/
import order.bounds
import data.set.intervals.image_preimage
import tactic.linarith

/-!
# Intervals without endpoints ordering
In any decidable linear order `α`, we define the set of elements lying between two elements `a` and
`b` as `Icc (min a b) (max a b)`.
`Icc a b` requires the assumption `a ≤ b` to be meaningful, which is sometimes inconvenient. The
interval as defined in this file is always the set of things lying between `a` and `b`, regardless
of the relative order of `a` and `b`.
For real numbers, `Icc (min a b) (max a b)` is the same as `segment a b`.
## Notation
We use the localized notation `[a, b]` for `interval a b`. One can open the locale `interval` to
make the notation available.
-/

universe u

namespace set

section linear_order

variables {α : Type u} [linear_order α] {a a₁ a₂ b b₁ b₂ x : α}

/-- `interval a b` is the set of elements lying between `a` and `b`, with `a` and `b` included. -/
def interval (a b : α) := Icc (min a b) (max a b)

localized "notation `[`a `, ` b `]` := interval a b" in interval

@[simp] lemma interval_of_le (h : a ≤ b) : [a, b] = Icc a b :=
by rw [interval, min_eq_left h, max_eq_right h]

@[simp] lemma interval_of_ge (h : b ≤ a) : [a, b] = Icc b a :=
by { rw [interval, min_eq_right h, max_eq_left h] }

lemma interval_swap (a b : α) : [a, b] = [b, a] :=
or.elim (le_total a b) (by simp {contextual := tt}) (by simp {contextual := tt})

lemma interval_of_lt (h : a < b) : [a, b] = Icc a b :=
interval_of_le (le_of_lt h)

lemma interval_of_gt (h : b < a) : [a, b] = Icc b a :=
interval_of_ge (le_of_lt h)

lemma interval_of_not_le (h : ¬ a ≤ b) : [a, b] = Icc b a :=
interval_of_gt (lt_of_not_ge h)

lemma interval_of_not_ge (h : ¬ b ≤ a) : [a, b] = Icc a b :=
interval_of_lt (lt_of_not_ge h)

@[simp] lemma interval_self : [a, a] = {a} :=
set.ext $ by simp [le_antisymm_iff, and_comm]

@[simp] lemma nonempty_interval : set.nonempty [a, b] :=
by { simp only [interval, min_le_iff, le_max_iff, nonempty_Icc], left, left, refl }

@[simp] lemma left_mem_interval : a ∈ [a, b] :=
by { rw [interval, mem_Icc], exact ⟨min_le_left _ _, le_max_left _ _⟩ }

@[simp] lemma right_mem_interval : b ∈ [a, b] :=
by { rw interval_swap, exact left_mem_interval }

lemma Icc_subset_interval : Icc a b ⊆ [a, b] :=
by { assume x h, rwa interval_of_le, exact le_trans h.1 h.2 }

lemma Icc_subset_interval' : Icc b a ⊆ [a, b] :=
by { rw interval_swap, apply Icc_subset_interval }

lemma mem_interval_of_le (ha : a ≤ x) (hb : x ≤ b) : x ∈ [a, b] :=
Icc_subset_interval ⟨ha, hb⟩

lemma mem_interval_of_ge (hb : b ≤ x) (ha : x ≤ a) : x ∈ [a, b] :=
Icc_subset_interval' ⟨hb, ha⟩

lemma interval_subset_interval (h₁ : a₁ ∈ [a₂, b₂]) (h₂ : b₁ ∈ [a₂, b₂]) : [a₁, b₁] ⊆ [a₂, b₂] :=
Icc_subset_Icc (le_min h₁.1 h₂.1) (max_le h₁.2 h₂.2)

lemma interval_subset_interval_iff_mem : [a₁, b₁] ⊆ [a₂, b₂] ↔ a₁ ∈ [a₂, b₂] ∧ b₁ ∈ [a₂, b₂] :=
iff.intro (λh, ⟨h left_mem_interval, h right_mem_interval⟩) (λ h, interval_subset_interval h.1 h.2)

lemma interval_subset_interval_iff_le :
  [a₁, b₁] ⊆ [a₂, b₂] ↔ min a₂ b₂ ≤ min a₁ b₁ ∧ max a₁ b₁ ≤ max a₂ b₂ :=
by { rw [interval, interval, Icc_subset_Icc_iff], exact min_le_max }

lemma interval_subset_interval_right (h : x ∈ [a, b]) : [x, b] ⊆ [a, b] :=
interval_subset_interval h right_mem_interval

lemma interval_subset_interval_left (h : x ∈ [a, b]) : [a, x] ⊆ [a, b] :=
interval_subset_interval left_mem_interval h

lemma bdd_below_bdd_above_iff_subset_interval (s : set α) :
  bdd_below s ∧ bdd_above s ↔ ∃ a b, s ⊆ [a, b] :=
begin
  rw [bdd_below_bdd_above_iff_subset_Icc],
  split,
  { rintro ⟨a, b, h⟩, exact ⟨a, b, λ x hx, Icc_subset_interval (h hx)⟩ },
  { rintro ⟨a, b, h⟩, exact ⟨min a b, max a b, h⟩ }
end

end linear_order

open_locale interval

section ordered_add_comm_group

variables {α : Type u} [linear_ordered_add_comm_group α] (a b c x y : α)

@[simp] lemma preimage_const_add_interval : (λ x, a + x) ⁻¹' [b, c] = [b - a, c - a] :=
by simp only [interval, preimage_const_add_Icc, min_sub_sub_right, max_sub_sub_right]

@[simp] lemma preimage_add_const_interval : (λ x, x + a) ⁻¹' [b, c] = [b - a, c - a] :=
by simpa only [add_comm] using preimage_const_add_interval a b c

@[simp] lemma preimage_neg_interval : -([a, b]) = [-a, -b] :=
by simp only [interval, preimage_neg_Icc, min_neg_neg, max_neg_neg]

@[simp] lemma preimage_sub_const_interval : (λ x, x - a) ⁻¹' [b, c] = [b + a, c + a] :=
by simp [sub_eq_add_neg]

@[simp] lemma preimage_const_sub_interval : (λ x, a - x) ⁻¹' [b, c] = [a - b, a - c] :=
by { rw [interval, interval, preimage_const_sub_Icc],
  simp only [sub_eq_add_neg, min_add_add_left, max_add_add_left, min_neg_neg, max_neg_neg], }

@[simp] lemma image_const_add_interval : (λ x, a + x) '' [b, c] = [a + b, a + c] :=
by simp [add_comm]

@[simp] lemma image_add_const_interval : (λ x, x + a) '' [b, c] = [b + a, c + a] :=
by simp

@[simp] lemma image_const_sub_interval : (λ x, a - x) '' [b, c] = [a - b, a - c] :=
by simp [sub_eq_add_neg, image_comp (λ x, a + x) (λ x, -x)]

@[simp] lemma image_sub_const_interval : (λ x, x - a) '' [b, c] = [b - a, c - a] :=
by simp [sub_eq_add_neg, add_comm]

lemma image_neg_interval : has_neg.neg '' [a, b] = [-a, -b] := by simp

variables {a b c x y}

/-- If `[x, y]` is a subinterval of `[a, b]`, then the distance between `x` and `y`
is less than or equal to that of `a` and `b` -/
lemma abs_sub_le_of_subinterval (h : [x, y] ⊆ [a, b]) : abs (y - x) ≤ abs (b - a) :=
begin
  rw [← max_sub_min_eq_abs, ← max_sub_min_eq_abs],
  rw [interval_subset_interval_iff_le] at h,
  exact sub_le_sub h.2 h.1,
end

/-- If `x ∈ [a, b]`, then the distance between `a` and `x` is less than or equal to
that of `a` and `b`  -/
lemma abs_sub_left_of_mem_interval (h : x ∈ [a, b]) : abs (x - a) ≤ abs (b - a) :=
abs_sub_le_of_subinterval (interval_subset_interval_left h)

/-- If `x ∈ [a, b]`, then the distance between `x` and `b` is less than or equal to
that of `a` and `b`  -/
lemma abs_sub_right_of_mem_interval (h : x ∈ [a, b]) : abs (b - x) ≤ abs (b - a) :=
abs_sub_le_of_subinterval (interval_subset_interval_right h)

end ordered_add_comm_group

section linear_ordered_field

variables {k : Type u} [linear_ordered_field k] {a : k}

@[simp] lemma preimage_mul_const_interval (ha : a ≠ 0) (b c : k) :
  (λ x, x * a) ⁻¹' [b, c] = [b / a, c / a] :=
(lt_or_gt_of_ne ha).elim
  (λ ha, by simp [interval, ha, ha.le, min_div_div_right_of_nonpos, max_div_div_right_of_nonpos])
  (λ (ha : 0 < a), by simp [interval, ha, ha.le, min_div_div_right, max_div_div_right])

@[simp] lemma preimage_const_mul_interval (ha : a ≠ 0) (b c : k) :
  (λ x, a * x) ⁻¹' [b, c] = [b / a, c / a] :=
by simp only [← preimage_mul_const_interval ha, mul_comm]

@[simp] lemma preimage_div_const_interval (ha : a ≠ 0) (b c : k) :
  (λ x, x / a) ⁻¹' [b, c] = [b * a, c * a] :=
(preimage_mul_const_interval (inv_ne_zero ha) _ _).trans $ by simp [div_eq_mul_inv]

@[simp] lemma image_mul_const_interval (a b c : k) : (λ x, x * a) '' [b, c] = [b * a, c * a] :=
if ha : a = 0 then by simp [ha] else
calc (λ x, x * a) '' [b, c] = (λ x, x / a) ⁻¹' [b, c] :
  (units.mk0 a ha).mul_right.image_eq_preimage _
... = [b * a, c * a] : preimage_div_const_interval ha _ _

@[simp] lemma image_const_mul_interval (a b c : k) : (λ x, a * x) '' [b, c] = [a * b, a * c] :=
by simpa only [mul_comm] using image_mul_const_interval a b c

@[simp] lemma image_div_const_interval (a b c : k) : (λ x, x / a) '' [b, c] = [b / a, c / a] :=
image_mul_const_interval _ _ _

end linear_ordered_field

section intervals

variables (α : Type u) [linear_ordered_field α]

@[reducible] def intervals := { I // ∃ (a b : α), a < b ∧ I = [a, b] }
-- Should be ≤.

section ordered_add_comm_group

variable {α}

lemma mem_Icc_iff_exists_affine_form (a b : α) (h : a < b)
: ∀ x, x ∈ Icc a b ↔
  ∃ γ ∈ (Icc (-1) 1 : set α), x = ((a + b) / 2) + γ * ((b - a) / 2) :=
begin
  replace h := sub_pos.2 h,
  have h2 : 0 < (b - a) / 2 := div_pos h (by linarith),
  intros x, split,
  { rintros ⟨hax, hxb⟩,
    use [(2*x - a - b) / (b - a)], refine ⟨⟨_, _⟩, _⟩,
      { simp [le_div_iff h], linarith, },
      { simp [div_le_iff h], linarith, },
      { simp [mul_comm, ←mul_div_assoc, mul_div_cancel_left _ (ne_of_gt h)], ring, }, },
  { rintros ⟨γ, ⟨hγlb, hγub⟩, hx⟩, rw hx, split,
    { apply le_add_of_sub_left_le,
      refine le_trans _ ((mul_le_mul_right h2).2 hγlb),
      linarith, },
    { apply add_le_of_le_sub_left,
      refine le_trans ((mul_le_mul_right h2).2 hγub) _,
      linarith, }, },
end

lemma add_intervals (a b c d : α) (h1 : a < b) (h2 : c < d)
: Icc a b + Icc c d = Icc (a + c) (b + d) :=
begin
  have h3 : a + c < b + d := add_lt_add h1 h2,
  ext x, split,
  { rintros ⟨y, z, ⟨hay, hyb⟩, ⟨hcz, hzd⟩, hx⟩,
    rw ←hx, exact ⟨add_le_add hay hcz, add_le_add hyb hzd⟩, },
  { intros hx, replace hx := (mem_Icc_iff_exists_affine_form _ _ h3 x).1 hx,
    rcases hx with ⟨γ, hγ, hx⟩,
    use [((a + b) / 2) + γ * ((b - a) / 2)],
    use [((c + d) / 2) + γ * ((d - c) / 2)],
    refine ⟨_, _, _⟩,
    { rw mem_Icc_iff_exists_affine_form _ _ h1, use [γ, hγ], },
    { rw mem_Icc_iff_exists_affine_form _ _ h2, use [γ, hγ], },
    { rw hx, ring, }, },
end

lemma add_intervals' (a b c d : α) (h1 : a < b) (h2 : c < d)
: [a, b] + [c, d] = [a + c, b + d] :=
begin
  rw [interval_of_lt h1, interval_of_lt h2, interval_of_lt (add_lt_add h1 h2)],
  exact add_intervals a b c d h1 h2,
end

set_option trace.eqn_compiler.elim_match true

instance : has_add (intervals α) := {
  add := λ I J, ⟨I.1 + J.1,
    begin
      rcases I.2 with ⟨a, b, hab, hI⟩,
      rcases J.2 with ⟨c, d, hcd, hJ⟩,
      have hacbd := add_lt_add hab hcd,
      use [a + c, b + d, hacbd], rw [hI, hJ],
      exact add_intervals' a b c d hab hcd,
    end⟩
}

instance : linear_ordered_add_comm_group (intervals α) := {
  add := has_add.add,
  add_assoc := sorry,
  zero := sorry,
  zero_add := sorry,
  add_zero := sorry,
  neg := sorry,
  add_left_neg := sorry,
  add_comm := sorry,
  le := sorry,
  le_refl := sorry,
  le_trans := sorry,
  le_antisymm := sorry,
  le_total := sorry,
  decidable_le := sorry,
  add_le_add_left := sorry,
}

end ordered_add_comm_group

end intervals

end set


-- ---------------------------------------------------------------------
-- Ejercicio. Realizar las siguientes acciones
-- 1. Importar la librería tactic
-- 2. Abrir el espacio de nombres set
-- 3. Declarar u y v como variables de universos.
-- 4. Declarar α como una variable de tipos en u.
-- 5. Declarar I como una variable de tipos en v.
-- 6. Declarar A y B como variables sobre funciones de I en α.
-- 7. Declarar s como variable sobre conjuntos de elementos de α.
-- ----------------------------------------------------------------------

import tactic                 -- 1
open set                      -- 2
universes u v                 -- 3
variable (α : Type u)         -- 4
variable (I : Type v)         -- 5
variables (A B : I → set α)   -- 6
variable  s : set α           -- 7

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    s ∩ (⋃ i, A i) = ⋃ i, (A i ∩ s)
-- ----------------------------------------------------------------------

example : s ∩ (⋃ i, A i) = ⋃ i, (A i ∩ s) :=
begin
  ext x,
  simp only [mem_inter_eq, mem_Union],
  split,
  { rintros ⟨xs, ⟨i, xAi⟩⟩,
    exact ⟨i, xAi, xs⟩ },
  { rintros ⟨i, xAi, xs⟩,
    exact ⟨xs, ⟨i, xAi⟩⟩ },
end

-- Prueba
-- ======

/-
α : Type u,
I : Type v,
A : I → set α,
s : set α
⊢ (s ∩ ⋃ (i : I), A i) = ⋃ (i : I), A i ∩ s
  >> ext x,
x : α
⊢ (x ∈ s ∩ ⋃ (i : I), A i) ↔ x ∈ ⋃ (i : I), A i ∩ s
  >> simp only [mem_inter_eq, mem_Union],
⊢ (x ∈ s ∧ ∃ (i : I), x ∈ A i) ↔ ∃ (i : I), x ∈ A i ∧ x ∈ s
  >> split,
| ⊢ (x ∈ s ∧ ∃ (i : I), x ∈ A i) → (∃ (i : I), x ∈ A i ∧ x ∈ s)
|   >> { rintros ⟨xs, ⟨i, xAi⟩⟩,
| x : α,
| xs : x ∈ s,
| i : I,
| xAi : x ∈ A i
| ⊢ ∃ (i : I), x ∈ A i ∧ x ∈ s
|   >>   exact ⟨i, xAi, xs⟩ },
⊢ (∃ (i : I), x ∈ A i ∧ x ∈ s) → (x ∈ s ∧ ∃ (i : I), x ∈ A i)
  >> { rintros ⟨i, xAi, xs⟩,
x : α,
i : I,
xAi : x ∈ A i,
xs : x ∈ s
⊢ x ∈ s ∧ ∃ (i : I), x ∈ A i
  >>   exact ⟨xs, ⟨i, xAi⟩⟩ },
no goals
-/

-- Comentario: Se han usado los lemas
-- + mem_inter_eq: x ∈ a ∩ b = (x ∈ a ∧ x ∈ b)
-- + mem_Union : x ∈ Union A ↔ ∃ (i : I), x ∈ A i

-- Comprobación
variable x : α
variables (a b : set α)
-- #check @mem_inter_eq _ x a b
-- #check @mem_Union α I x A

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    (⋂ i, A i ∩ B i) = (⋂ i, A i) ∩ (⋂ i, B i)
-- ----------------------------------------------------------------------

example : (⋂ i, A i ∩ B i) = (⋂ i, A i) ∩ (⋂ i, B i) :=
begin
  ext x,
  simp only [mem_inter_eq, mem_Inter],
  split,
  { intro h,
    split,
    { intro i,
      exact (h i).1 },
    { intro i,
      exact (h i).2 }},
  { rintros ⟨h1, h2⟩ i,
    split,
    { exact h1 i },
    { exact h2 i }},
end

-- Prueba
-- ======

/-
α : Type u,
I : Type v,
A B : I → set α
⊢ (⋂ (i : I), A i ∩ B i) = (⋂ (i : I), A i) ∩ ⋂ (i : I), B i
  >> ext x,
x : α
⊢ (x ∈ ⋂ (i : I), A i ∩ B i) ↔ x ∈ (⋂ (i : I), A i) ∩ ⋂ (i : I), B i
  >> simp only [mem_inter_eq, mem_Inter],
⊢ (∀ (i : I), x ∈ A i ∧ x ∈ B i) ↔ (∀ (i : I), x ∈ A i) ∧ ∀ (i : I), x ∈ B i
  >> split,
| ⊢ (∀ (i : I), x ∈ A i ∧ x ∈ B i) → ((∀ (i : I), x ∈ A i) ∧ ∀ (i : I), x ∈ B i)
|   >> { intro h,
| h : ∀ (i : I), x ∈ A i ∧ x ∈ B i
| ⊢ (∀ (i : I), x ∈ A i) ∧ ∀ (i : I), x ∈ B i
|   >>   split,
| | ⊢ ∀ (i : I), x ∈ A i
| |   >>   { intro i,
| | i : I
| | ⊢ x ∈ A i
| |   >>     exact (h i).1 },
| ⊢ ∀ (i : I), x ∈ B i
|   >>   { intro i,
| i : I
| ⊢ x ∈ B i
|   >>     exact (h i).2 }},
⊢ ((∀ (i : I), x ∈ A i) ∧ ∀ (i : I), x ∈ B i) → ∀ (i : I), x ∈ A i ∧ x ∈ B i
  >> { rintros ⟨h1, h2⟩ i,
i : I,
h1 : ∀ (i : I), x ∈ A i,
h2 : ∀ (i : I), x ∈ B i
⊢ x ∈ A i ∧ x ∈ B i
  >>   split,
| ⊢ x ∈ A i
|   >>   { exact h1 i },
⊢ x ∈ B i
  >>   { exact h2 i }},
no goals
-/

-- Comentario: Se han usado los lemas
-- + mem_inter_eq: x ∈ a ∩ b = (x ∈ a ∧ x ∈ b)
-- + mem_Inter : x ∈ Inter A ↔ ∀ (i : I), x ∈ A i

-- Comprobación
-- #check @mem_inter_eq _ x a b
-- #check @mem_Inter α I x A


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Johannes Hölzl, Scott Morrison, Jens Wagemaker

! This file was ported from Lean 3 source module data.polynomial.induction
! leanprover-community/mathlib commit 63417e01fbc711beaf25fa73b6edb395c0cfddd0
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.RingTheory.Ideal.Basic
import Mathlib.Data.Polynomial.Basic

/-!
# Induction on polynomials

This file contains lemmas dealing with different flavours of induction on polynomials.
See also `Data/Polynomial/Inductions.lean` (with an `s`!).

The main result is `Polynomial.induction_on`.
-/

noncomputable section

open Finsupp Finset

namespace Polynomial

open Polynomial

universe u v w x y z

variable {R : Type u} {S : Type v} {T : Type w} {ι : Type x} {k : Type y} {A : Type z} {a b : R}
  {m n : ℕ}

section Semiring

variable [Semiring R] {p q r : R[X]}

@[elab_as_elim]
protected theorem induction_on {M : R[X] → Prop} (p : R[X]) (h_C : ∀ a, M (C a))
    (h_add : ∀ p q, M p → M q → M (p + q))
    (h_monomial : ∀ (n : ℕ) (a : R), M (C a * X ^ n) → M (C a * X ^ (n + 1))) : M p := by
  have A : ∀ {n : ℕ} {a}, M (C a * X ^ n) := by
    intro n a
    induction' n with n ih
    · rw [pow_zero, mul_one]; exact h_C a
    · exact h_monomial _ _ ih
  have B : ∀ s : Finset ℕ, M (s.sum fun n : ℕ => C (p.coeff n) * X ^ n) := by
    apply Finset.induction
    · convert h_C 0
      exact C_0.symm
    · intro n s ns ih
      rw [sum_insert ns]
      exact h_add _ _ A ih
  rw [← sum_C_mul_X_pow_eq p, Polynomial.sum]
  exact B (support p)
#align polynomial.induction_on Polynomial.induction_on

/-- To prove something about polynomials,
it suffices to show the condition is closed under taking sums,
and it holds for monomials.
-/
@[elab_as_elim]
protected theorem induction_on' {M : R[X] → Prop} (p : R[X]) (h_add : ∀ p q, M p → M q → M (p + q))
    (h_monomial : ∀ (n : ℕ) (a : R), M (monomial n a)) : M p :=
  Polynomial.induction_on p (h_monomial 0) h_add fun n a _h =>
    by rw [C_mul_X_pow_eq_monomial]; exact h_monomial _ _
#align polynomial.induction_on' Polynomial.induction_on'

open Submodule Polynomial Set

variable {f : R[X]} {I : Ideal R[X]}

/-- If the coefficients of a polynomial belong to an ideal, then that ideal contains
the ideal spanned by the coefficients of the polynomial. -/
theorem span_le_of_C_coeff_mem (cf : ∀ i : ℕ, C (f.coeff i) ∈ I) :
    Ideal.span { g | ∃ i, g = C (f.coeff i) } ≤ I := by
  simp (config := { singlePass := true }) only [@eq_comm _ _ (C _)]
  exact (Ideal.span_le.trans range_subset_iff).mpr cf
set_option linter.uppercaseLean3 false in
#align polynomial.span_le_of_C_coeff_mem Polynomial.span_le_of_C_coeff_mem

theorem mem_span_C_coeff : f ∈ Ideal.span { g : R[X] | ∃ i : ℕ, g = C (coeff f i) } := by
  let p := Ideal.span { g : R[X] | ∃ i : ℕ, g = C (coeff f i) }
  nth_rw 1 [(sum_C_mul_X_pow_eq f).symm]
  refine' Submodule.sum_mem _ fun n _hn => _
  dsimp
  have : C (coeff f n) ∈ p := by
    apply subset_span
    rw [mem_setOf_eq]
    use n
  have : monomial n (1 : R) • C (coeff f n) ∈ p := p.smul_mem _ this
  convert this using 1
  simp only [monomial_mul_C, one_mul, smul_eq_mul]
  rw [← C_mul_X_pow_eq_monomial]
set_option linter.uppercaseLean3 false in
#align polynomial.mem_span_C_coeff Polynomial.mem_span_C_coeff

theorem exists_C_coeff_not_mem : f ∉ I → ∃ i : ℕ, C (coeff f i) ∉ I :=
  Not.imp_symm fun cf => span_le_of_C_coeff_mem (not_exists_not.mp cf) mem_span_C_coeff
set_option linter.uppercaseLean3 false in
#align polynomial.exists_C_coeff_not_mem Polynomial.exists_C_coeff_not_mem

end Semiring

end Polynomial