import analysis.normed_space.conformal_linear_map
import complex_conformal_prep

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

/-!
# Complex Conformal Maps

We prove the sufficient and necessary conditions for a complex function to be conformal.

## Main results

* `is_complex_or_conj_complex_linear_iff_is_conformal_map`: the main theorem for linear maps.
* `conformal_at_iff_holomorphic_or_antiholomorphic_at`: the main theorem for complex functions.

## Warning

Antiholomorphic functions such as the complex conjugate are considered as conformal functions in
this file.
-/

noncomputable theory

open complex linear_isometry linear_isometry_equiv continuous_linear_map
     finite_dimensional linear_map

section complex_normed_space

variables {E : Type*} [normed_group E] [normed_space ℝ E] [normed_space ℂ E]
  [is_scalar_tower ℝ ℂ E] {z : ℂ} {g : ℂ →L[ℝ] E} {f : ℂ → E}

lemma is_conformal_map_of_eq_complex_linear (nonzero : g ≠ 0)
  (H : ∃ (map : ℂ →L[ℂ] E), map.restrict_scalars ℝ = g) : is_conformal_map g :=
begin
  rcases H with ⟨map, h⟩,
  have minor₀ : ∀ x, g x = x • g 1,
  { intro x,
    nth_rewrite 0 ← mul_one x,
    rw [← smul_eq_mul, ← h, coe_restrict_scalars', map.map_smul], },
  have minor₁ : ∥g 1∥ ≠ 0,
  { contrapose! nonzero with w,
    ext1 x,
    rw [continuous_linear_map.zero_apply, minor₀ x, norm_eq_zero.mp w, smul_zero], },
  refine ⟨∥g 1∥, minor₁, _⟩,
  let li' := ∥g 1∥⁻¹ • g,
  have key : ∀ (x : ℂ), ∥li' x∥ = ∥x∥,
  { intros x,
    simp only [li', continuous_linear_map.smul_apply, minor₀ x,
               norm_smul, normed_field.norm_inv, norm_norm],
    field_simp [minor₁], },
  let li : ℂ →ₗᵢ[ℝ] E := ⟨li', key⟩,
  have minor₂ : (li : ℂ → E) = li' := rfl,
  refine ⟨li, _⟩,
  ext1,
  simp only [minor₂, li', pi.smul_apply, continuous_linear_map.smul_apply, smul_smul],
  field_simp [minor₁],
end

lemma is_conformal_map_of_eq_linear_conj (nonzero : g ≠ 0)
  (h : ∃ (map : ℂ →L[ℂ] E), map.restrict_scalars ℝ = g.comp conj_cle.to_continuous_linear_map) :
  is_conformal_map g :=
begin
  have nonzero' : g.comp conj_cle.to_continuous_linear_map ≠ 0,
  { contrapose! nonzero with w,
    simp only [continuous_linear_map.ext_iff, continuous_linear_map.zero_apply,
               continuous_linear_map.coe_comp', function.comp_app,
               continuous_linear_equiv.coe_def_rev, continuous_linear_equiv.coe_apply,
               conj_cle_apply] at w,
    ext1,
    rw [← conj_conj x, w, continuous_linear_map.zero_apply], },
  rcases is_conformal_map_of_eq_complex_linear nonzero' h with ⟨c, hc, li, hg'⟩,
  refine ⟨c, hc, li.comp conj_lie.to_linear_isometry, _⟩,
  have key : (g : ℂ → E) = (c • li) ∘ conj_lie,
  { rw ← hg',
    funext,
    simp only [continuous_linear_map.coe_comp',function.comp_app,
               continuous_linear_equiv.coe_def_rev, continuous_linear_equiv.coe_apply,
               conj_lie_apply, conj_cle_apply, conj_conj], },
  funext,
  simp only [conj_cle_apply, pi.smul_apply,
             linear_isometry.coe_comp, coe_to_linear_isometry],
  rw [key, function.comp_app, pi.smul_apply],
end

/-- A real differentiable function of the complex plane into some complex normed space `E` is
    conformal at a point `z` if it is holomorphic or antiholomorphic at that point -/
lemma conformal_at_of_holomorph_or_antiholomorph_at_aux
  (hf : differentiable_at ℝ f z) (hf' : fderiv ℝ f z ≠ 0)
  (h : differentiable_at ℂ f z ∨ differentiable_at ℂ (f ∘ conj) (conj z)) :
  conformal_at f z :=
begin
  rw [conformal_at_iff_is_conformal_map_fderiv],
  rw [differentiable_at_iff_exists_linear_map hf,
      antiholomorph_at_iff_exists_complex_linear_conj hf] at h,
  cases h,
  { exact is_conformal_map_of_eq_complex_linear hf' h, },
  { exact is_conformal_map_of_eq_linear_conj hf' h, },
end

end complex_normed_space

section complex_conformal_linear_map

variables {f : ℂ → ℂ} {z : ℂ} {g : ℂ →L[ℝ] ℂ}

lemma is_complex_or_conj_complex_linear (h : is_conformal_map g) :
  (∃ (map : ℂ →L[ℂ] ℂ), map.restrict_scalars ℝ = g) ∨
  (∃ (map : ℂ →L[ℂ] ℂ), map.restrict_scalars ℝ = g.comp conj_cle.to_continuous_linear_map) :=
begin
  rcases h with ⟨c, hc, li, hg⟩,
  rcases linear_isometry_complex (li.to_linear_isometry_equiv rfl) with ⟨a, ha⟩,
  cases ha,
  { refine or.intro_left _ ⟨c • rotation_clm a, _⟩,
    ext1,
    simp only [coe_restrict_scalars', continuous_linear_map.smul_apply, coe_rotation_clm, ← ha,
               li.coe_to_linear_isometry_equiv, hg, pi.smul_apply], },
  { let map := c • (rotation_clm a),
    refine or.intro_right _ ⟨map, _⟩,
    ext1,
    rw [continuous_linear_map.coe_comp', hg, ← li.coe_to_linear_isometry_equiv, ha],
    simp only [coe_restrict_scalars', function.comp_app, pi.smul_apply,
               linear_isometry_equiv.coe_trans, conj_lie_apply,
               rotation_apply, map, continuous_linear_equiv.coe_def_rev,
               continuous_linear_equiv.coe_apply, conj_cle_apply],
    simp only [smul_coe, smul_eq_mul, function.comp_app, continuous_linear_map.smul_apply,
               rotation_clm_apply, linear_map.coe_to_continuous_linear_map',
               rotation_apply, conj.map_mul, conj_conj], },
end

/-- A real continuous linear map on the complex plane is conformal if and only if the map or its
    conjugate is complex linear, and the map is nonvanishing. -/
lemma is_complex_or_conj_complex_linear_iff_is_conformal_map :
  ((∃ (map : ℂ →L[ℂ] ℂ), map.restrict_scalars ℝ = g) ∨
   (∃ (map : ℂ →L[ℂ] ℂ), map.restrict_scalars ℝ = g.comp conj_cle.to_continuous_linear_map))
  ∧ g ≠ 0 ↔ is_conformal_map g :=
iff.intro
  (λ h, h.1.rec_on
    (is_conformal_map_of_eq_complex_linear h.2)
    $ is_conformal_map_of_eq_linear_conj h.2)
  (λ h, ⟨is_complex_or_conj_complex_linear h, h.ne_zero⟩)

end complex_conformal_linear_map

section complex_conformal_map

variables {f : ℂ → ℂ} {z : ℂ}

lemma conformal_at_iff_holomorphic_or_antiholomorph_at_aux (hf : differentiable_at ℝ f z) :
  conformal_at f z ↔
  (differentiable_at ℂ f z ∨ differentiable_at ℂ (f ∘ conj) (conj z)) ∧ fderiv ℝ f z ≠ 0 :=
by rw [conformal_at_iff_is_conformal_map_fderiv,
       ← is_complex_or_conj_complex_linear_iff_is_conformal_map,
       differentiable_at_iff_exists_linear_map hf,
       antiholomorph_at_iff_exists_complex_linear_conj hf]

/-- A complex function is conformal if and only if the function is holomorphic or antiholomorphic
    with a nonvanishing differential. -/
lemma conformal_at_iff_holomorphic_or_antiholomorphic_at :
  conformal_at f z ↔
  (differentiable_at ℂ f z ∨ differentiable_at ℂ (f ∘ conj) (conj z)) ∧ fderiv ℝ f z ≠ 0 :=
iff.intro
  (λ h, (conformal_at_iff_holomorphic_or_antiholomorph_at_aux h.differentiable_at).mp h)
  (λ h, by
    { have : differentiable_at ℝ f z :=
        by_contra (λ w, h.2 $ fderiv_zero_of_not_differentiable_at w),
      exact (conformal_at_iff_holomorphic_or_antiholomorph_at_aux this).mpr h, } )

end complex_conformal_map


-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    (λ x y : ℝ, (x + y)^2) = (λ x y : ℝ, x^2 + 2*x*y + y^2)
-- ----------------------------------------------------------------------

import data.real.basic

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

example : (λ x y : ℝ, (x + y)^2) = (λ x y : ℝ, x^2 + 2*x*y + y^2) :=
begin
  ext,
  ring,
end

-- Prueba
-- ======

/-
⊢ (λ (x y : ℝ), (x + y) ^ 2) = λ (x y : ℝ), x ^ 2 + 2 * x * y + y ^ 2
  >> ext,
⊢ (x + x_1) ^ 2 = x ^ 2 + 2 * x * x_1 + x_1 ^ 2
  >> ring,
no goals
-/

-- Comentario: La táctica ext transforma las conclusiones de la forma
-- (λ x, f x) = (λ x, g x) en f x = g x.

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

example : (λ x y : ℝ, (x + y)^2) = (λ x y : ℝ, x^2 + 2*x*y + y^2) :=
by { ext, ring }

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

example : (λ x y : ℝ, (x + y)^2) = (λ x y : ℝ, x^2 + 2*x*y + y^2) :=
by ring


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

! This file was ported from Lean 3 source module measure_theory.function.strongly_measurable.lp
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.MeasureTheory.Function.SimpleFuncDenseLp
import Mathbin.MeasureTheory.Function.StronglyMeasurable.Basic

/-!
# Finitely strongly measurable functions in `Lp`

Functions in `Lp` for `0 < p < ∞` are finitely strongly measurable.

## Main statements

* `mem_ℒp.ae_fin_strongly_measurable`: if `mem_ℒp f p μ` with `0 < p < ∞`, then
  `ae_fin_strongly_measurable f μ`.
* `Lp.fin_strongly_measurable`: for `0 < p < ∞`, `Lp` functions are finitely strongly measurable.

## References

* Hytönen, Tuomas, Jan Van Neerven, Mark Veraar, and Lutz Weis. Analysis in Banach spaces.
Springer, 2016.
-/

open MeasureTheory Filter TopologicalSpace Function

open ENNReal Topology MeasureTheory

namespace MeasureTheory

-- mathport name: «expr →ₛ »
local infixr:25 " →ₛ " => SimpleFunc

variable {α G : Type _} {p : ℝ≥0∞} {m m0 : MeasurableSpace α} {μ : Measure α} [NormedAddCommGroup G]
  {f : α → G}

theorem Memℒp.finStronglyMeasurableOfStronglyMeasurable (hf : Memℒp f p μ)
    (hf_meas : StronglyMeasurable f) (hp_ne_zero : p ≠ 0) (hp_ne_top : p ≠ ∞) :
    FinStronglyMeasurable f μ := by
  borelize G
  haveI : separable_space (Set.range f ∪ {0} : Set G) :=
    hf_meas.separable_space_range_union_singleton
  let fs := simple_func.approx_on f hf_meas.measurable (Set.range f ∪ {0}) 0 (by simp)
  refine' ⟨fs, _, _⟩
  · have h_fs_Lp : ∀ n, mem_ℒp (fs n) p μ :=
      simple_func.mem_ℒp_approx_on_range hf_meas.measurable hf
    exact fun n => (fs n).measure_support_lt_top_of_memℒp (h_fs_Lp n) hp_ne_zero hp_ne_top
  · intro x
    apply simple_func.tendsto_approx_on
    apply subset_closure
    simp
#align measure_theory.mem_ℒp.fin_strongly_measurable_of_strongly_measurable MeasureTheory.Memℒp.finStronglyMeasurableOfStronglyMeasurable

theorem Memℒp.aeFinStronglyMeasurable (hf : Memℒp f p μ) (hp_ne_zero : p ≠ 0) (hp_ne_top : p ≠ ∞) :
    AeFinStronglyMeasurable f μ :=
  ⟨hf.AeStronglyMeasurable.mk f,
    ((memℒp_congr_ae hf.AeStronglyMeasurable.ae_eq_mk).mp
          hf).finStronglyMeasurableOfStronglyMeasurable
      hf.AeStronglyMeasurable.stronglyMeasurable_mk hp_ne_zero hp_ne_top,
    hf.AeStronglyMeasurable.ae_eq_mk⟩
#align measure_theory.mem_ℒp.ae_fin_strongly_measurable MeasureTheory.Memℒp.aeFinStronglyMeasurable

theorem Integrable.aeFinStronglyMeasurable (hf : Integrable f μ) : AeFinStronglyMeasurable f μ :=
  (memℒp_one_iff_integrable.mpr hf).AeFinStronglyMeasurable one_ne_zero ENNReal.coe_ne_top
#align measure_theory.integrable.ae_fin_strongly_measurable MeasureTheory.Integrable.aeFinStronglyMeasurable

theorem lp.finStronglyMeasurable (f : lp G p μ) (hp_ne_zero : p ≠ 0) (hp_ne_top : p ≠ ∞) :
    FinStronglyMeasurable f μ :=
  (lp.memℒp f).finStronglyMeasurableOfStronglyMeasurable (lp.stronglyMeasurable f) hp_ne_zero
    hp_ne_top
#align measure_theory.Lp.fin_strongly_measurable MeasureTheory.lp.finStronglyMeasurable

end MeasureTheory


import Mathlib.Data.Nat.Basic
import Mathlib.Algebra.Ring.Basic
import Mathlib.Data.Nat.Parity
import Mathlib.Data.Nat.Pow
import Mathlib.Tactic.Ring

def f (n : Nat) : Nat :=
  if n = 0 then 0
  else if Odd n then f (n - 1) + 1
  else f (n / 2)
  termination_by f n => n
  decreasing_by
      simp_wf
      have h : n ≠ 0 := by assumption
      first | apply Nat.pred_lt h
          | apply Nat.div_lt_self (Nat.zero_lt_of_ne_zero h)
            simp

def g (n : Nat) : Nat :=
  if n = 0 then 0
  else g (n - 2 ^ (Nat.log2 n)) + 1
  termination_by g n => n
  decreasing_by
      simp_wf
      have h : n ≠ 0 := by assumption
      apply Nat.sub_lt (Nat.zero_lt_of_ne_zero h)
      apply Nat.pos_pow_of_pos
      simp

lemma log2_of_2kj (k : ℕ) (j : ℕ) (h : j<2^k): Nat.log2 (2 ^ k+j) = k := by
  revert j
  induction k with
  | zero =>
    intros j h
    simp at h
    rw [h]
    simp
  | succ k ih =>
    intros j h
    unfold Nat.log2
    split_ifs
    simp [Nat.pow_succ]
    have _ : Even (2^k*2) := by
      simp [Nat.even_pow]
    have twopos : 2>0 := by simp
    have h2 : (2^k*2+j)/2=(2^k+(j/2)) := by
      match (Nat.even_or_odd j) with
      | Or.inl a =>
        have _ : Even (2^k*2+j) := by
          rw [Nat.even_add]
          tauto
          rw [← mul_right_cancel_iff_of_pos twopos,Nat.div_two_mul_two_of_even, add_mul, Nat.div_two_mul_two_of_even]
          assumption
          assumption
      | Or.inr a =>
        have _ : Odd (2^k*2+j) := by
          rw [add_comm, Nat.odd_add]
          tauto
        rw [← mul_right_cancel_iff_of_pos twopos, ← add_left_inj 1, Nat.div_two_mul_two_add_one_of_odd, add_mul, add_assoc, Nat.div_two_mul_two_add_one_of_odd]
          assumption
          assumption
    rw [h2]
    apply ih
    rw [Nat.pow_succ] at h
    apply by_contradiction
    simp
    intro h3
    have h4: j/2*2≥2^k*2 := by
      simp
      assumption
    have h5: j/2*2≤ j := by
      match (Nat.even_or_odd j) with
      | Or.inl a =>
        rw [Nat.div_two_mul_two_of_even]
        simp
        apply a
      | Or.inr a =>
        have b := Nat.div_two_mul_two_add_one_of_odd a
        have c := Nat.le_succ j
        conv at c =>
          lhs
          rw [← b]
        rw [Nat.succ_eq_add_one] at c
        simp at c
        apply c
    have _ := Nat.lt_of_le_of_lt (Nat.le_trans h4 h5) h
    have _ := Nat.lt_irrefl (2^k*2)
    contradiction
    have h2: 2≤2^Nat.succ k := by
      rw [Nat.pow_succ]
      simp
      apply Nat.pos_pow_of_pos
      simp
    have _ := Nat.le_trans h2 (Nat.le_add_right (2^Nat.succ k) j)
    contradiction

theorem can_split (n:ℕ): (∃ k:ℕ, ∃j:ℕ, j<2^k∧ Nat.succ n=2^k+j):= by
  induction n with
  | zero =>
    apply Exists.intro 0
    apply Exists.intro 0
    simp
  | succ n ih =>
    match ih with
    | ⟨k,j,lhs,rhs⟩ =>
      have j1leq2k : j+1≤2^k := by
        apply Nat.le_of_lt_succ
        rw [Nat.succ_eq_add_one]
        simp
        apply lhs
      have mycases : j+1<2^k ∨ j+1=2^k := by
        rw [← le_iff_lt_or_eq]
        apply j1leq2k
      match mycases with
      | Or.inl lt =>
        apply Exists.intro k
        apply Exists.intro (j+1)
        apply And.intro lt
        rw [rhs]
        rw [Nat.succ_eq_add_one]
        rw [add_assoc]
      | Or.inr eq =>
        apply Exists.intro (Nat.succ k)
        apply Exists.intro 0
        apply And.intro
        simp
        rw [Nat.pow_succ, Nat.add_zero]
        have two_eq_one_plus_one : 2=1+1 := by simp
        conv =>
          rhs
          congr
          rfl
          rw [two_eq_one_plus_one]
        rw [Nat.mul_add, Nat.mul_one]
        conv =>
          rhs
          congr
          rfl
          rw [← eq]
        rw [rhs]
        rw [Nat.succ_eq_add_one]
        rw [add_assoc]

lemma pow2_inc (n m : ℕ) (h : 2 ^ n < 2^m) : n < m := by
  apply by_contradiction
  simp
  intro h2
  have h3:2^n≥2^m := by
    match (Nat.le.dest h2) with
    | Exists.intro k hk =>
      rw [← hk]
      rw [pow_add]
      simp
      apply Nat.pos_pow_of_pos
      simp
  have _:= Nat.lt_irrefl (2^m)
  have _:= Nat.lt_of_le_of_lt h3 h
  contradiction

lemma pow2_nz (n : ℕ) : 2^n ≠ 0 := by
  apply Nat.ne_of_gt
  apply Nat.pos_pow_of_pos n
  simp

lemma pow2p_nz (n j : ℕ) : 2^n+j ≠ 0 := by
  apply Nat.ne_of_gt
  apply Nat.lt_of_lt_of_le _ (Nat.le_add_right (2^n) j)
  apply Nat.pos_pow_of_pos n
  simp

theorem q6 (n : ℕ) : f n = g n := by
  apply Nat.strong_rec_on n
  intro n ih
  cases n with
  | zero => simp
  | succ n =>
    have x := can_split n
    match x with
    | ⟨k, j, lhs, rhs⟩ =>
      rw [rhs]
      match k with
      | Nat.zero =>
        simp at lhs
        rw [lhs]
        rw [f, g]
        simp
      | Nat.succ k =>
        match (Nat.even_or_odd j) with
        | Or.inl je =>
          have x : Even (2^Nat.succ k) := by
              simp [Nat.even_pow]
          have ne : Even (2^Nat.succ k+j) := by
            rw [Nat.even_add]
            tauto
          rw [f]
          simp
          split_ifs
          . rw [ih ((2 ^ Nat.succ k + j) / 2)]
            have twopos : 2>0:=by simp
            have div: (2 ^ Nat.succ k + j) / 2  = (2 ^ Nat.succ k/2 + j/2) := by
              rw [← mul_right_cancel_iff_of_pos twopos]
              rw [Nat.div_two_mul_two_of_even, add_mul, Nat.div_two_mul_two_of_even, Nat.div_two_mul_two_of_even]
              assumption
              assumption
              assumption
            conv at div =>
              rhs
              rw [Nat.pow_succ]
            rw [div]
            rw [g]
            have _ := pow2_nz (k)
            simp
            split_ifs
            tauto
            have lt: j/2*2<2^k*2:= by
              rw [Nat.div_two_mul_two_of_even]
              rw [← Nat.pow_succ]
              assumption
              assumption
            simp at lt
            have reduce := log2_of_2kj k (j / 2) lt
            rw [reduce]
            simp
            apply Eq.symm
            rw [g]
            simp
            have reduce := log2_of_2kj (Nat.succ k) (j) lhs
            rw [reduce]
            simp
            rw [← ih j]
            rw [f]
            split_ifs
            have j0 :j=0:= by assumption
            rw [j0]
            simp
            have jo :Odd j:= by assumption
            rw [Nat.even_iff_not_odd] at je
            contradiction
            have lt1:2^k<2^Nat.succ k + j:= by
              rw [Nat.pow_succ]
              have x:2 ^ k < 2 ^ k * 2:= by
                simp
              apply Nat.lt_of_lt_of_le x (Nat.le_add_right (2^k*2) j)
            rw [← rhs] at lt1
            rw [ih (j/2) (Nat.lt_trans lt lt1)]
            rw [rhs]
            simp
            rw [← rhs]
            apply Nat.div_lt_self
            simp
            simp
          . contradiction
        | Or.inr jo =>
          rw [f]
          simp
          have k2 :(2^Nat.succ k)>1:= by simp
          have ke: Even (2^Nat.succ k) := by
            simp [Nat.even_pow]
          have kjo : Odd (2^Nat.succ k+j):= by
            rw [add_comm]
            rw [Nat.odd_add]
            tauto
          split_ifs
          rw [Nat.odd_iff_not_even] at kjo
          contradiction
          rw [f]
          have jg0:j>0:= by
            apply by_contradiction
            simp
            intro jz
            rw [jz] at jo
            contradiction
          have oo : Odd 1:= by simp
          have jm1e : Even (j-1) := by
            rw [Nat.even_sub']
            tauto
            have x := Nat.succ_lt_succ jg0
            rw [Nat.succ_eq_add_one] at x
            simp at x
            apply Nat.le_of_lt_succ x
          split_ifs
          have wrong:2 ^ Nat.succ k + j - 1 = 0:=by assumption
          simp at wrong
          have right:=Nat.lt_of_lt_of_le k2 (Nat.le_add_right (2^Nat.succ k) j)
          have _ := Nat.not_le_of_gt right
          contradiction
          have kj1e : Even (2^Nat.succ k+j-1):= by
            rw [Nat.even_sub']
            tauto
            apply Nat.le_trans (Nat.le_of_lt k2) (Nat.le_add_right (2^Nat.succ k) j)
          rw [Nat.even_iff_not_odd] at kj1e
          contradiction
          have reduce : (2 ^ Nat.succ k + j - 1) / 2*2 = (2 ^ Nat.succ k / 2 + (j-1)/2)*2:=by
            rw [Nat.div_two_mul_two_of_even, add_mul, Nat.div_two_mul_two_of_even, Nat.div_two_mul_two_of_even]
            have jsp:j-1+1=j:= by
              apply Nat.succ_pred
              simp
              apply Nat.ne_of_gt
              apply jg0
            have t : 2 ^ Nat.succ k + j - 1+1 = 2 ^ Nat.succ k + (j - 1)+1:= by
              rw [add_assoc]
              rw [jsp]
              apply Nat.succ_pred
              simp
            simp at t
            apply t
            rw [Nat.even_sub']
            tauto
            apply (Nat.succ_le_of_lt jg0)
            assumption
            have x : ¬Odd (2 ^ Nat.succ k + j - 1):= by assumption
            rw [← Nat.even_iff_not_odd] at x
            apply x
          simp at reduce
          conv at reduce =>
            rhs
            rw [Nat.pow_succ]
            simp
          rw [reduce]
          rw [ih (2^k+(j-1)/2)]
          rw [g]
          split_ifs
          have _:= pow2p_nz k ((j-1)/2)
          contradiction
          have j1lt2k : (j-1)/2*2<2^k*2:= by
            rw [Nat.div_two_mul_two_of_even]
            rw [← Nat.pow_succ]
            have x:j-1≤ j:= by simp
            apply Nat.lt_of_le_of_lt x lhs
            assumption
          simp at j1lt2k
          have l2 := log2_of_2kj k ((j-1)/2) j1lt2k
          rw [l2]
          simp
          apply Eq.symm
          rw [g]
          simp
          have l2 := log2_of_2kj (Nat.succ k) (j) lhs
          rw [l2]
          simp
          rw [← ih j]
          rw [f]
          split_ifs
          have jn0 :¬ j=0:= Nat.ne_of_gt jg0
          contradiction
          rw [f]
          split_ifs
          have j1e0: j-1=0:= by assumption
          rw [j1e0]
          simp
          rw [Nat.even_iff_not_odd] at jm1e
          contradiction
          rw [ih ((j-1)/2)]
          have x:2^k<Nat.succ n:= by
            have x:2^k<2^Nat.succ k:= by
              rw [Nat.pow_succ]
              simp
            apply Nat.lt_of_lt_of_le x (Nat.le.intro (Eq.symm rhs))
          apply Nat.lt_trans j1lt2k x
          apply Nat.lt_of_lt_of_le lhs (Nat.le.intro (Eq.symm rhs))
          have p1: 2 ^ k + (j - 1) / 2< 2 ^ Nat.succ k + j:= by
            rw [Nat.pow_succ]
            simp
            have x:2 ^ k < 2 ^ k * 2:= by simp
            have y:(j-1)/2*2 < j*2 := by
              rw [Nat.div_two_mul_two_of_even]
              have tg0: 2>1:= by simp
              have jj2:= lt_mul_right jg0 tg0
              apply Nat.lt_of_le_of_lt (Nat.pred_le j) jj2
              assumption
            simp at y
            apply Nat.add_lt_add x y
          rw [← rhs] at p1
          apply p1


import tactic

/- Tactic : split
When given a goal that is an `∧` (and) of two propositions, the `split` tactic
will produce two goals, one for each side. That can be solved individually.
-/

/- Axiom : nat.lt_succ_self : ∀ (n : ℕ), n < n.succ
-/
/- Lemma :
-/
lemma split : 4 < 5 ∧ 5 < 6 :=
begin
  split,
  exact nat.lt_succ_self 4,
  exact nat.lt_succ_self 5,
end


/-
Copyright (c) 2019 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau
-/
import algebra.algebra.bilinear
import algebra.algebra.equiv
import algebra.module.submodule.pointwise
import algebra.module.submodule.bilinear
import algebra.module.opposites
import algebra.order.kleene
import data.finset.pointwise
import data.set.semiring
import data.set.pointwise.big_operators
import group_theory.group_action.sub_mul_action.pointwise

/-!
# Multiplication and division of submodules of an algebra.

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

An interface for multiplication and division of sub-R-modules of an R-algebra A is developed.

## Main definitions

Let `R` be a commutative ring (or semiring) and let `A` be an `R`-algebra.

* `1 : submodule R A`       : the R-submodule R of the R-algebra A
* `has_mul (submodule R A)` : multiplication of two sub-R-modules M and N of A is defined to be
                              the smallest submodule containing all the products `m * n`.
* `has_div (submodule R A)` : `I / J` is defined to be the submodule consisting of all `a : A` such
                              that `a • J ⊆ I`

It is proved that `submodule R A` is a semiring, and also an algebra over `set A`.

Additionally, in the `pointwise` locale we promote `submodule.pointwise_distrib_mul_action` to a
`mul_semiring_action` as `submodule.pointwise_mul_semiring_action`.

## Tags

multiplication of submodules, division of submodules, submodule semiring
-/

universes uι u v

open algebra set mul_opposite
open_locale big_operators
open_locale pointwise

namespace sub_mul_action
variables {R : Type u}  {A : Type v} [comm_semiring R] [semiring A] [algebra R A]

lemma algebra_map_mem (r : R) : algebra_map R A r ∈ (1 : sub_mul_action R A) :=
⟨r, (algebra_map_eq_smul_one r).symm⟩

lemma mem_one' {x : A} : x ∈ (1 : sub_mul_action R A) ↔ ∃ y, algebra_map R A y = x :=
exists_congr $ λ r, by rw algebra_map_eq_smul_one

end sub_mul_action

namespace submodule

variables {ι : Sort uι}
variables {R : Type u} [comm_semiring R]

section ring

variables {A : Type v} [semiring A] [algebra R A]
variables (S T : set A) {M N P Q : submodule R A} {m n : A}

/-- `1 : submodule R A` is the submodule R of A. -/
instance : has_one (submodule R A) :=
⟨(algebra.linear_map R A).range⟩

theorem one_eq_range :
  (1 : submodule R A) = (algebra.linear_map R A).range := rfl

lemma le_one_to_add_submonoid :
  1 ≤ (1 : submodule R A).to_add_submonoid :=
begin
  rintros x ⟨n, rfl⟩,
  exact ⟨n, map_nat_cast (algebra_map R A) n⟩,
end

lemma algebra_map_mem (r : R) : algebra_map R A r ∈ (1 : submodule R A) :=
linear_map.mem_range_self _ _

@[simp] lemma mem_one {x : A} : x ∈ (1 : submodule R A) ↔ ∃ y, algebra_map R A y = x :=
iff.rfl

@[simp] lemma to_sub_mul_action_one : (1 : submodule R A).to_sub_mul_action = 1 :=
set_like.ext $ λ x, mem_one.trans sub_mul_action.mem_one'.symm

theorem one_eq_span : (1 : submodule R A) = R ∙ 1 :=
begin
  apply submodule.ext,
  intro a,
  simp only [mem_one, mem_span_singleton, algebra.smul_def, mul_one]
end

theorem one_eq_span_one_set : (1 : submodule R A) = span R 1 := one_eq_span

theorem one_le : (1 : submodule R A) ≤ P ↔ (1 : A) ∈ P :=
by simpa only [one_eq_span, span_le, set.singleton_subset_iff]

protected lemma map_one {A'} [semiring A'] [algebra R A'] (f : A →ₐ[R] A') :
  map f.to_linear_map (1 : submodule R A) = 1 :=
by { ext, simp }

@[simp] lemma map_op_one :
  map (↑(op_linear_equiv R : A ≃ₗ[R] Aᵐᵒᵖ) : A →ₗ[R] Aᵐᵒᵖ) (1 : submodule R A) = 1 :=
by { ext, induction x using mul_opposite.rec, simp }

@[simp] lemma comap_op_one :
  comap (↑(op_linear_equiv R : A ≃ₗ[R] Aᵐᵒᵖ) : A →ₗ[R] Aᵐᵒᵖ) (1 : submodule R Aᵐᵒᵖ) = 1 :=
by { ext, simp }

@[simp] lemma map_unop_one :
  map (↑(op_linear_equiv R : A ≃ₗ[R] Aᵐᵒᵖ).symm : Aᵐᵒᵖ →ₗ[R] A) (1 : submodule R Aᵐᵒᵖ) = 1 :=
by rw [←comap_equiv_eq_map_symm, comap_op_one]

@[simp] lemma comap_unop_one :
  comap (↑(op_linear_equiv R : A ≃ₗ[R] Aᵐᵒᵖ).symm : Aᵐᵒᵖ →ₗ[R] A) (1 : submodule R A) = 1 :=
by rw [←map_equiv_eq_comap_symm, map_op_one]

/-- Multiplication of sub-R-modules of an R-algebra A. The submodule `M * N` is the
smallest R-submodule of `A` containing the elements `m * n` for `m ∈ M` and `n ∈ N`. -/
instance : has_mul (submodule R A) := ⟨submodule.map₂ $ linear_map.mul R A⟩

theorem mul_mem_mul (hm : m ∈ M) (hn : n ∈ N) : m * n ∈ M * N := apply_mem_map₂ _ hm hn

theorem mul_le : M * N ≤ P ↔ ∀ (m ∈ M) (n ∈ N), m * n ∈ P := map₂_le

lemma mul_to_add_submonoid (M N : submodule R A) :
  (M * N).to_add_submonoid = M.to_add_submonoid * N.to_add_submonoid :=
begin
  dsimp [has_mul.mul],
  simp_rw [←linear_map.mul_left_to_add_monoid_hom R, linear_map.mul_left, ←map_to_add_submonoid _ N,
    map₂],
  rw supr_to_add_submonoid,
  refl,
end

@[elab_as_eliminator] protected theorem mul_induction_on
  {C : A → Prop} {r : A} (hr : r ∈ M * N)
  (hm : ∀ (m ∈ M) (n ∈ N), C (m * n)) (ha : ∀ x y, C x → C y → C (x + y)) : C r :=
begin
  rw [←mem_to_add_submonoid, mul_to_add_submonoid] at hr,
  exact add_submonoid.mul_induction_on hr hm ha,
end

/-- A dependent version of `mul_induction_on`. -/
@[elab_as_eliminator] protected theorem mul_induction_on'
  {C : Π r, r ∈ M * N → Prop}
  (hm : ∀ (m ∈ M) (n ∈ N), C (m * n) (mul_mem_mul ‹_› ‹_›))
  (ha : ∀ x hx y hy, C x hx → C y hy → C (x + y) (add_mem ‹_› ‹_›))
  {r : A} (hr : r ∈ M * N) : C r hr :=
begin
  refine exists.elim _ (λ (hr : r ∈ M * N) (hc : C r hr), hc),
  exact submodule.mul_induction_on hr
    (λ x hx y hy, ⟨_, hm _ hx _ hy⟩) (λ x y ⟨_, hx⟩ ⟨_, hy⟩, ⟨_, ha _ _ _ _ hx hy⟩),
end

variables R
theorem span_mul_span : span R S * span R T = span R (S * T) := map₂_span_span _ _ _ _
variables {R}

variables (M N P Q)

@[simp] theorem mul_bot : M * ⊥ = ⊥ := map₂_bot_right _ _

@[simp] theorem bot_mul : ⊥ * M = ⊥ := map₂_bot_left _ _

@[simp] protected theorem one_mul : (1 : submodule R A) * M = M :=
by { conv_lhs { rw [one_eq_span, ← span_eq M] }, erw [span_mul_span, one_mul, span_eq] }

@[simp] protected theorem mul_one : M * 1 = M :=
by { conv_lhs { rw [one_eq_span, ← span_eq M] }, erw [span_mul_span, mul_one, span_eq] }

variables {M N P Q}

@[mono] theorem mul_le_mul (hmp : M ≤ P) (hnq : N ≤ Q) : M * N ≤ P * Q := map₂_le_map₂ hmp hnq

theorem mul_le_mul_left (h : M ≤ N) : M * P ≤ N * P := map₂_le_map₂_left h

theorem mul_le_mul_right (h : N ≤ P) : M * N ≤ M * P := map₂_le_map₂_right h

variables (M N P)

theorem sup_mul : (M ⊔ N) * P = M * P ⊔ N * P := map₂_sup_left _ _ _ _

lemma mul_subset_mul : (↑M : set A) * (↑N : set A) ⊆ (↑(M * N) : set A) :=
image2_subset_map₂ (algebra.lmul R A).to_linear_map M N

protected lemma map_mul {A'} [semiring A'] [algebra R A'] (f : A →ₐ[R] A') :
  map f.to_linear_map (M * N) = map f.to_linear_map M * map f.to_linear_map N :=
calc map f.to_linear_map (M * N)
    = ⨆ (i : M), (N.map (linear_map.mul R A i)).map f.to_linear_map : map_supr _ _
... = map f.to_linear_map M * map f.to_linear_map N  :
  begin
    apply congr_arg Sup,
    ext S,
    split; rintros ⟨y, hy⟩,
    { use [f y, mem_map.mpr ⟨y.1, y.2, rfl⟩],
      refine trans _ hy,
      ext,
      simp },
    { obtain ⟨y', hy', fy_eq⟩ := mem_map.mp y.2,
      use [y', hy'],
      refine trans _ hy,
      rw f.to_linear_map_apply at fy_eq,
      ext,
      simp [fy_eq] }
end

lemma map_op_mul :
  map (↑(op_linear_equiv R : A ≃ₗ[R] Aᵐᵒᵖ) : A →ₗ[R] Aᵐᵒᵖ) (M * N) =
    map (↑(op_linear_equiv R : A ≃ₗ[R] Aᵐᵒᵖ) : A →ₗ[R] Aᵐᵒᵖ) N *
      map (↑(op_linear_equiv R : A ≃ₗ[R] Aᵐᵒᵖ) : A →ₗ[R] Aᵐᵒᵖ) M :=
begin
  apply le_antisymm,
  { simp_rw map_le_iff_le_comap,
    refine mul_le.2 (λ m hm n hn, _),
    rw [mem_comap, map_equiv_eq_comap_symm, map_equiv_eq_comap_symm],
    show op n * op m ∈ _,
    exact mul_mem_mul hn hm },
  { refine mul_le.2 (mul_opposite.rec $ λ m hm, mul_opposite.rec $ λ n hn, _),
    rw submodule.mem_map_equiv at ⊢ hm hn,
    exact mul_mem_mul hn hm, }
end

lemma comap_unop_mul :
  comap (↑(op_linear_equiv R : A ≃ₗ[R] Aᵐᵒᵖ).symm : Aᵐᵒᵖ →ₗ[R] A) (M * N) =
    comap (↑(op_linear_equiv R : A ≃ₗ[R] Aᵐᵒᵖ).symm : Aᵐᵒᵖ →ₗ[R] A) N *
      comap (↑(op_linear_equiv R : A ≃ₗ[R] Aᵐᵒᵖ).symm : Aᵐᵒᵖ →ₗ[R] A) M :=
by simp_rw [←map_equiv_eq_comap_symm, map_op_mul]

lemma map_unop_mul (M N : submodule R Aᵐᵒᵖ) :
  map (↑(op_linear_equiv R : A ≃ₗ[R] Aᵐᵒᵖ).symm : Aᵐᵒᵖ →ₗ[R] A) (M * N) =
    map (↑(op_linear_equiv R : A ≃ₗ[R] Aᵐᵒᵖ).symm : Aᵐᵒᵖ →ₗ[R] A) N *
      map (↑(op_linear_equiv R : A ≃ₗ[R] Aᵐᵒᵖ).symm : Aᵐᵒᵖ →ₗ[R] A) M :=
have function.injective (↑(op_linear_equiv R : A ≃ₗ[R] Aᵐᵒᵖ) : A →ₗ[R] Aᵐᵒᵖ) :=
  linear_equiv.injective _,
map_injective_of_injective this $
  by rw [← map_comp, map_op_mul, ←map_comp, ←map_comp, linear_equiv.comp_coe,
         linear_equiv.symm_trans_self, linear_equiv.refl_to_linear_map, map_id, map_id, map_id]

lemma comap_op_mul (M N : submodule R Aᵐᵒᵖ) :
  comap (↑(op_linear_equiv R : A ≃ₗ[R] Aᵐᵒᵖ) : A →ₗ[R] Aᵐᵒᵖ) (M * N) =
    comap (↑(op_linear_equiv R : A ≃ₗ[R] Aᵐᵒᵖ) : A →ₗ[R] Aᵐᵒᵖ) N *
      comap (↑(op_linear_equiv R : A ≃ₗ[R] Aᵐᵒᵖ) : A →ₗ[R] Aᵐᵒᵖ) M :=
by simp_rw [comap_equiv_eq_map_symm, map_unop_mul]

section
open_locale pointwise

/-- `submodule.has_pointwise_neg` distributes over multiplication.

This is available as an instance in the `pointwise` locale. -/
protected def has_distrib_pointwise_neg {A} [ring A] [algebra R A] :
  has_distrib_neg (submodule R A) :=
to_add_submonoid_injective.has_distrib_neg _ neg_to_add_submonoid mul_to_add_submonoid

localized "attribute [instance] submodule.has_distrib_pointwise_neg" in pointwise

end

section decidable_eq

open_locale classical

lemma mem_span_mul_finite_of_mem_span_mul
  {R A} [semiring R] [add_comm_monoid A] [has_mul A] [module R A]
  {S : set A} {S' : set A} {x : A} (hx : x ∈ span R (S * S')) :
  ∃ (T T' : finset A), ↑T ⊆ S ∧ ↑T' ⊆ S' ∧ x ∈ span R (T * T' : set A) :=
begin
  obtain ⟨U, h, hU⟩ := mem_span_finite_of_mem_span hx,
  obtain ⟨T, T', hS, hS', h⟩ := finset.subset_mul h,
  use [T, T', hS, hS'],
  have h' : (U : set A) ⊆ T * T', { assumption_mod_cast, },
  have h'' := span_mono h' hU,
  assumption,
end

end decidable_eq

lemma mul_eq_span_mul_set (s t : submodule R A) : s * t = span R ((s : set A) * (t : set A)) :=
map₂_eq_span_image2 _ s t

lemma supr_mul (s : ι → submodule R A) (t : submodule R A) : (⨆ i, s i) * t = ⨆ i, s i * t :=
map₂_supr_left _ s t

lemma mul_supr (t : submodule R A) (s : ι → submodule R A) : t * (⨆ i, s i) = ⨆ i, t * s i :=
map₂_supr_right _ t s

lemma mem_span_mul_finite_of_mem_mul {P Q : submodule R A} {x : A} (hx : x ∈ P * Q) :
  ∃ (T T' : finset A), (T : set A) ⊆ P ∧ (T' : set A) ⊆ Q ∧ x ∈ span R (T * T' : set A) :=
submodule.mem_span_mul_finite_of_mem_span_mul
  (by rwa [← submodule.span_eq P, ← submodule.span_eq Q, submodule.span_mul_span] at hx)

variables {M N P}

lemma mem_span_singleton_mul {x y : A} : x ∈ span R {y} * P ↔ ∃ z ∈ P, y * z = x :=
by { simp_rw [(*), map₂_span_singleton_eq_map, exists_prop], refl }

lemma mem_mul_span_singleton {x y : A} : x ∈ P * span R {y} ↔ ∃ z ∈ P, z * y = x :=
by { simp_rw [(*), map₂_span_singleton_eq_map_flip, exists_prop], refl }

/-- Sub-R-modules of an R-algebra form an idempotent semiring. -/
instance : idem_semiring (submodule R A) :=
{ one_mul       := submodule.one_mul,
  mul_one       := submodule.mul_one,
  zero_mul      := bot_mul,
  mul_zero      := mul_bot,
  left_distrib  := mul_sup,
  right_distrib := sup_mul,
  ..to_add_submonoid_injective.semigroup _ (λ m n : submodule R A, mul_to_add_submonoid m n),
  ..add_monoid_with_one.unary,
  ..submodule.pointwise_add_comm_monoid,
  ..submodule.has_one,
  ..submodule.has_mul,
  ..(by apply_instance : order_bot (submodule R A)),
  ..(by apply_instance : lattice (submodule R A)) }

variables (M)

lemma span_pow (s : set A) : ∀ n : ℕ, span R s ^ n = span R (s ^ n)
| 0 := by rw [pow_zero, pow_zero, one_eq_span_one_set]
| (n + 1) := by rw [pow_succ, pow_succ, span_pow, span_mul_span]

lemma pow_eq_span_pow_set (n : ℕ) : M ^ n = span R ((M : set A) ^ n) := by rw [←span_pow, span_eq]

lemma pow_subset_pow {n : ℕ} : (↑M : set A)^n ⊆ ↑(M^n : submodule R A) :=
(pow_eq_span_pow_set M n).symm ▸ subset_span

lemma pow_mem_pow {x : A} (hx : x ∈ M) (n : ℕ) : x ^ n ∈ M ^ n :=
pow_subset_pow _ $ set.pow_mem_pow hx _

lemma pow_to_add_submonoid {n : ℕ} (h : n ≠ 0) :
  (M ^ n).to_add_submonoid = M.to_add_submonoid ^ n :=
begin
  induction n with n ih,
  { exact (h rfl).elim },
  { rw [pow_succ, pow_succ, mul_to_add_submonoid],
    cases n,
    { rw [pow_zero, pow_zero, mul_one, ←mul_to_add_submonoid, mul_one] },
    { rw ih n.succ_ne_zero } },
end

lemma le_pow_to_add_submonoid {n : ℕ} :
  M.to_add_submonoid ^ n ≤ (M ^ n).to_add_submonoid :=
begin
  obtain rfl | hn := decidable.eq_or_ne n 0,
  { rw [pow_zero, pow_zero], exact le_one_to_add_submonoid },
  { exact (pow_to_add_submonoid M hn).ge }
end

/-- Dependent version of `submodule.pow_induction_on_left`. -/
@[elab_as_eliminator] protected theorem pow_induction_on_left'
  {C : Π (n : ℕ) x, x ∈ M ^ n → Prop}
  (hr : ∀ r : R, C 0 (algebra_map _ _ r) (algebra_map_mem r))
  (hadd : ∀ x y i hx hy, C i x hx → C i y hy → C i (x + y) (add_mem ‹_› ‹_›))
  (hmul : ∀ (m ∈ M) i x hx, C i x hx → C (i.succ) (m * x) (mul_mem_mul H hx))
  {x : A} {n : ℕ} (hx : x ∈ M ^ n) : C n x hx :=
begin
  induction n with n n_ih generalizing x,
  { rw pow_zero at hx,
    obtain ⟨r, rfl⟩ := hx,
    exact hr r, },
  exact submodule.mul_induction_on'
    (λ m hm x ih, hmul _ hm _ _ _ (n_ih ih))
    (λ x hx y hy Cx Cy, hadd _ _ _ _ _ Cx Cy) hx,
end

/-- Dependent version of `submodule.pow_induction_on_right`. -/
@[elab_as_eliminator] protected theorem pow_induction_on_right'
  {C : Π (n : ℕ) x, x ∈ M ^ n → Prop}
  (hr : ∀ r : R, C 0 (algebra_map _ _ r) (algebra_map_mem r))
  (hadd : ∀ x y i hx hy, C i x hx → C i y hy → C i (x + y) (add_mem ‹_› ‹_›))
  (hmul : ∀ i x hx, C i x hx → ∀ m ∈ M,
    C (i.succ) (x * m) ((pow_succ' M i).symm ▸ mul_mem_mul hx H))
  {x : A} {n : ℕ} (hx : x ∈ M ^ n) : C n x hx :=
begin
  induction n with n n_ih generalizing x,
  { rw pow_zero at hx,
    obtain ⟨r, rfl⟩ := hx,
    exact hr r, },
  revert hx,
  simp_rw pow_succ',
  intro hx,
  exact submodule.mul_induction_on'
    (λ m hm x ih, hmul _ _ hm (n_ih _) _ ih)
    (λ x hx y hy Cx Cy, hadd _ _ _ _ _ Cx Cy) hx,
end

/-- To show a property on elements of `M ^ n` holds, it suffices to show that it holds for scalars,
is closed under addition, and holds for `m * x` where `m ∈ M` and it holds for `x` -/
@[elab_as_eliminator] protected theorem pow_induction_on_left
  {C : A → Prop}
  (hr : ∀ r : R, C (algebra_map _ _ r))
  (hadd : ∀ x y, C x → C y → C (x + y))
  (hmul : ∀ (m ∈ M) x, C x → C (m * x))
  {x : A} {n : ℕ} (hx : x ∈ M ^ n) : C x :=
submodule.pow_induction_on_left' M
  (by exact hr) (λ x y i hx hy, hadd x y) (λ m hm i x hx, hmul _ hm _) hx

/-- To show a property on elements of `M ^ n` holds, it suffices to show that it holds for scalars,
is closed under addition, and holds for `x * m` where `m ∈ M` and it holds for `x` -/
@[elab_as_eliminator] protected theorem pow_induction_on_right
  {C : A → Prop}
  (hr : ∀ r : R, C (algebra_map _ _ r))
  (hadd : ∀ x y, C x → C y → C (x + y))
  (hmul : ∀ x, C x → ∀ (m ∈ M), C (x * m))
  {x : A} {n : ℕ} (hx : x ∈ M ^ n) : C x :=
submodule.pow_induction_on_right' M
  (by exact hr) (λ x y i hx hy, hadd x y) (λ i x hx, hmul _) hx

/-- `submonoid.map` as a `monoid_with_zero_hom`, when applied to `alg_hom`s. -/
@[simps]
def map_hom {A'} [semiring A'] [algebra R A'] (f : A →ₐ[R] A') :
  submodule R A →*₀ submodule R A' :=
{ to_fun := map f.to_linear_map,
  map_zero' := submodule.map_bot _,
  map_one' := submodule.map_one _,
  map_mul' := λ _ _, submodule.map_mul _ _ _}

/-- The ring of submodules of the opposite algebra is isomorphic to the opposite ring of
submodules. -/
@[simps apply symm_apply]
def equiv_opposite : submodule R Aᵐᵒᵖ ≃+* (submodule R A)ᵐᵒᵖ :=
{ to_fun := λ p, op $ p.comap (↑(op_linear_equiv R : A ≃ₗ[R] Aᵐᵒᵖ) : A →ₗ[R] Aᵐᵒᵖ),
  inv_fun := λ p, p.unop.comap (↑(op_linear_equiv R : A ≃ₗ[R] Aᵐᵒᵖ).symm : Aᵐᵒᵖ →ₗ[R] A),
  left_inv := λ p, set_like.coe_injective $ rfl,
  right_inv := λ p, unop_injective $ set_like.coe_injective rfl,
  map_add' := λ p q, by simp [comap_equiv_eq_map_symm, ←op_add],
  map_mul' := λ p q, congr_arg op $ comap_op_mul _ _ }

protected lemma map_pow {A'} [semiring A'] [algebra R A'] (f : A →ₐ[R] A') (n : ℕ) :
  map f.to_linear_map (M ^ n) = map f.to_linear_map M ^ n :=
map_pow (map_hom f) M n

lemma comap_unop_pow (n : ℕ) :
  comap (↑(op_linear_equiv R : A ≃ₗ[R] Aᵐᵒᵖ).symm : Aᵐᵒᵖ →ₗ[R] A) (M ^ n) =
    comap (↑(op_linear_equiv R : A ≃ₗ[R] Aᵐᵒᵖ).symm : Aᵐᵒᵖ →ₗ[R] A) M ^ n :=
(equiv_opposite : submodule R Aᵐᵒᵖ ≃+* _).symm.map_pow (op M) n

lemma comap_op_pow (n : ℕ) (M : submodule R Aᵐᵒᵖ) :
  comap (↑(op_linear_equiv R : A ≃ₗ[R] Aᵐᵒᵖ) : A →ₗ[R] Aᵐᵒᵖ) (M ^ n) =
    comap (↑(op_linear_equiv R : A ≃ₗ[R] Aᵐᵒᵖ) : A →ₗ[R] Aᵐᵒᵖ) M ^ n :=
op_injective $ (equiv_opposite : submodule R Aᵐᵒᵖ ≃+* _).map_pow M n

lemma map_op_pow (n : ℕ) :
  map (↑(op_linear_equiv R : A ≃ₗ[R] Aᵐᵒᵖ) : A →ₗ[R] Aᵐᵒᵖ) (M ^ n) =
    map (↑(op_linear_equiv R : A ≃ₗ[R] Aᵐᵒᵖ) : A →ₗ[R] Aᵐᵒᵖ) M ^ n :=
by rw [map_equiv_eq_comap_symm, map_equiv_eq_comap_symm, comap_unop_pow]

lemma map_unop_pow (n : ℕ) (M : submodule R Aᵐᵒᵖ) :
  map (↑(op_linear_equiv R : A ≃ₗ[R] Aᵐᵒᵖ).symm : Aᵐᵒᵖ →ₗ[R] A) (M ^ n) =
    map (↑(op_linear_equiv R : A ≃ₗ[R] Aᵐᵒᵖ).symm : Aᵐᵒᵖ →ₗ[R] A) M ^ n :=
by rw [←comap_equiv_eq_map_symm, ←comap_equiv_eq_map_symm, comap_op_pow]

/-- `span` is a semiring homomorphism (recall multiplication is pointwise multiplication of subsets
on either side). -/
@[simps]
def span.ring_hom : set_semiring A →+* submodule R A :=
{ to_fun := λ s, submodule.span R s.down,
  map_zero' := span_empty,
  map_one' := one_eq_span.symm,
  map_add' := span_union,
  map_mul' := λ s t, by rw [set_semiring.down_mul, span_mul_span, ← image_mul_prod] }

section
variables {α : Type*} [monoid α] [mul_semiring_action α A] [smul_comm_class α R A]

/-- The action on a submodule corresponding to applying the action to every element.

This is available as an instance in the `pointwise` locale.

This is a stronger version of `submodule.pointwise_distrib_mul_action`. -/
protected def pointwise_mul_semiring_action : mul_semiring_action α (submodule R A) :=
{ smul_mul := λ r x y, submodule.map_mul x y $ mul_semiring_action.to_alg_hom R A r,
  smul_one := λ r, submodule.map_one $ mul_semiring_action.to_alg_hom R A r,
  ..submodule.pointwise_distrib_mul_action }

localized "attribute [instance] submodule.pointwise_mul_semiring_action" in pointwise

end

end ring

section comm_ring

variables {A : Type v} [comm_semiring A] [algebra R A]
variables {M N : submodule R A} {m n : A}

theorem mul_mem_mul_rev (hm : m ∈ M) (hn : n ∈ N) : n * m ∈ M * N :=
mul_comm m n ▸ mul_mem_mul hm hn

variables (M N)
protected theorem mul_comm : M * N = N * M :=
le_antisymm (mul_le.2 $ λ r hrm s hsn, mul_mem_mul_rev hsn hrm)
(mul_le.2 $ λ r hrn s hsm, mul_mem_mul_rev hsm hrn)

/-- Sub-R-modules of an R-algebra A form a semiring. -/
instance : idem_comm_semiring (submodule R A) :=
{ mul_comm := submodule.mul_comm,
  .. submodule.idem_semiring }

lemma prod_span {ι : Type*} (s : finset ι) (M : ι → set A) :
  (∏ i in s, submodule.span R (M i)) = submodule.span R (∏ i in s, M i) :=
begin
  letI := classical.dec_eq ι,
  refine finset.induction_on s _ _,
  { simp [one_eq_span, set.singleton_one] },
  { intros _ _ H ih,
    rw [finset.prod_insert H, finset.prod_insert H, ih, span_mul_span] }
end

lemma prod_span_singleton {ι : Type*} (s : finset ι) (x : ι → A) :
  (∏ i in s, span R ({x i} : set A)) = span R {∏ i in s, x i} :=
by rw [prod_span, set.finset_prod_singleton]

variables (R A)

/-- R-submodules of the R-algebra A are a module over `set A`. -/
instance module_set : module (set_semiring A) (submodule R A) :=
{ smul := λ s P, span R s.down * P,
  smul_add := λ _ _ _, mul_add _ _ _,
  add_smul := λ s t P,
    by simp_rw [has_smul.smul, set_semiring.down_add, span_union, sup_mul, add_eq_sup],
  mul_smul := λ s t P,
    by simp_rw [has_smul.smul, set_semiring.down_mul, ← mul_assoc, span_mul_span],
  one_smul := λ P,
    by simp_rw [has_smul.smul, set_semiring.down_one, ←one_eq_span_one_set, one_mul],
  zero_smul := λ P,
    by simp_rw [has_smul.smul, set_semiring.down_zero, span_empty, bot_mul, bot_eq_zero],
  smul_zero := λ _, mul_bot _ }

variables {R A}

lemma smul_def (s : set_semiring A) (P : submodule R A) : s • P = span R s.down * P := rfl

lemma smul_le_smul {s t : set_semiring A} {M N : submodule R A} (h₁ : s.down ⊆ t.down)
  (h₂ : M ≤ N) : s • M ≤ t • N :=
mul_le_mul (span_mono h₁) h₂

lemma smul_singleton (a : A) (M : submodule R A) :
  ({a} : set A).up • M = M.map (linear_map.mul_left R a) :=
begin
  conv_lhs {rw ← span_eq M},
  change span _ _ * span _ _ = _,
  rw [span_mul_span],
  apply le_antisymm,
  { rw span_le,
    rintros _ ⟨b, m, hb, hm, rfl⟩,
    rw [set_like.mem_coe, mem_map, set.mem_singleton_iff.mp hb],
    exact ⟨m, hm, rfl⟩ },
  { rintros _ ⟨m, hm, rfl⟩, exact subset_span ⟨a, m, set.mem_singleton a, hm, rfl⟩ }
end

section quotient

/-- The elements of `I / J` are the `x` such that `x • J ⊆ I`.

In fact, we define `x ∈ I / J` to be `∀ y ∈ J, x * y ∈ I` (see `mem_div_iff_forall_mul_mem`),
which is equivalent to `x • J ⊆ I` (see `mem_div_iff_smul_subset`), but nicer to use in proofs.

This is the general form of the ideal quotient, traditionally written $I : J$.
-/
instance : has_div (submodule R A) :=
⟨ λ I J,
{ carrier   := { x | ∀ y ∈ J, x * y ∈ I },
  zero_mem' := λ y hy, by { rw zero_mul, apply submodule.zero_mem },
  add_mem'  := λ a b ha hb y hy, by { rw add_mul, exact submodule.add_mem _ (ha _ hy) (hb _ hy) },
  smul_mem' := λ r x hx y hy, by { rw algebra.smul_mul_assoc,
    exact submodule.smul_mem _ _ (hx _ hy) } } ⟩

lemma mem_div_iff_forall_mul_mem {x : A} {I J : submodule R A} :
  x ∈ I / J ↔ ∀ y ∈ J, x * y ∈ I :=
iff.refl _

lemma mem_div_iff_smul_subset {x : A} {I J : submodule R A} : x ∈ I / J ↔ x • (J : set A) ⊆ I :=
⟨ λ h y ⟨y', hy', xy'_eq_y⟩, by { rw ← xy'_eq_y, apply h, assumption },
  λ h y hy, h (set.smul_mem_smul_set hy) ⟩

lemma le_div_iff {I J K : submodule R A} : I ≤ J / K ↔ ∀ (x ∈ I) (z ∈ K), x * z ∈ J := iff.refl _

lemma le_div_iff_mul_le {I J K : submodule R A} : I ≤ J / K ↔ I * K ≤ J :=
by rw [le_div_iff, mul_le]

@[simp] lemma one_le_one_div {I : submodule R A} :
  1 ≤ 1 / I ↔ I ≤ 1 :=
begin
  split, all_goals {intro hI},
  {rwa [le_div_iff_mul_le, one_mul] at hI},
  {rwa [le_div_iff_mul_le, one_mul]},
end

lemma le_self_mul_one_div {I : submodule R A} (hI : I ≤ 1) :
  I ≤ I * (1 / I) :=
begin
  rw [← mul_one I] {occs := occurrences.pos [1]},
  apply mul_le_mul_right (one_le_one_div.mpr hI),
end

lemma mul_one_div_le_one {I : submodule R A} : I * (1 / I) ≤ 1 :=
begin
  rw submodule.mul_le,
  intros m hm n hn,
  rw [submodule.mem_div_iff_forall_mul_mem] at hn,
  rw mul_comm,
  exact hn m hm,
end

@[simp] protected lemma map_div {B : Type*} [comm_semiring B] [algebra R B]
  (I J : submodule R A) (h : A ≃ₐ[R] B) :
  (I / J).map h.to_linear_map = I.map h.to_linear_map / J.map h.to_linear_map :=
begin
  ext x,
  simp only [mem_map, mem_div_iff_forall_mul_mem],
  split,
  { rintro ⟨x, hx, rfl⟩ _ ⟨y, hy, rfl⟩,
    exact ⟨x * y, hx _ hy, h.map_mul x y⟩ },
  { rintro hx,
    refine ⟨h.symm x, λ z hz, _, h.apply_symm_apply x⟩,
    obtain ⟨xz, xz_mem, hxz⟩ := hx (h z) ⟨z, hz, rfl⟩,
    convert xz_mem,
    apply h.injective,
    erw [h.map_mul, h.apply_symm_apply, hxz] }
end

end quotient

end comm_ring

end submodule


namespace mono_epi

variables {A B: Type}

def is_inj (f: A -> B) :=
  forall x1 x2, f x1 = f x2 -> x1 = x2

def is_surj (f: A -> B) :=
  forall y, exists x, y = f x

def is_mono (f: A -> B) :=
  forall (X: Type) (g1 g2: X -> A), f ∘ g1 = f ∘ g2 -> g1 = g2

def is_epi (f: A -> B) :=
  forall (X: Type) (g1 g2: B -> X), g1 ∘ f = g2 ∘ f -> g1 = g2

lemma inj_iff_mono: forall (f: A -> B), is_inj f <-> is_mono f :=
begin
  intro f,
  split,
  {
    intros finj X g1 g2 fg,
    apply funext,
    intro x,
    apply finj,
    change (f ∘ g1) x = (f ∘ g2) x,
    rw fg,
  },
  {
    intros fmono x1 x2 feq,
    change (fun _, x1) unit.star = (fun _, x2) unit.star,
    apply congr_fun,
    apply fmono,
    apply funext,
    intro x,
    exact feq,
  },
end

lemma surj_iff_epi: forall (f: A -> B), is_surj f <-> is_epi f :=
begin
  intro f,
  split,
  {
    intros fsurj X g1 g2 gf,
    apply funext,
    intro y,
    cases (fsurj y) with x eq,
    rw eq,
    change (g1 ∘ f) x = (g2 ∘ f) x,
    rw gf,
  },
  {
    intros fepi y,
    let g1: B -> set B := λx, {y: B | y = x /\ exists x, y = f x},
    let g2: B -> set B := λx, {x},
    have h1 := fepi (set B) g1 g2,
    have : g1 ∘ f = g2 ∘ f,
    {
      apply funext,
      intro x,
      change g1 (f x) = g2 (f x),
      simp [g1, g2],
      apply funext,
      intro y,
      apply iff.to_eq,
      split,
      {
        intro h,
        cases h with h1 h2,
        exact h1,
      },
      {
        intro h,
        split,
        {
          exact h,
        },
        {
          existsi x,
          exact h,
        }
      },
    },
    have h1 := congr_fun (h1 this) y,
    simp [g1, g2] at h1,
    have : y ∈ {y_1 : B | y_1 = y /\ ∃ (x : A), y_1 = f x},
    {
      rw h1,
      simp [singleton],
    },
    simp at this,
    exact this,
  },
end

end mono_epi


/-
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, Johan Commelin, Mario Carneiro
-/

import data.mv_polynomial.basic

/-!
# Renaming variables of polynomials

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

This file establishes the `rename` operation on multivariate polynomials,
which modifies the set of variables.

## Main declarations

* `mv_polynomial.rename`
* `mv_polynomial.rename_equiv`

## Notation

As in other polynomial files, we typically use the notation:

+ `σ τ α : Type*` (indexing the variables)

+ `R S : Type*` `[comm_semiring R]` `[comm_semiring S]` (the coefficients)

+ `s : σ →₀ ℕ`, a function from `σ` to `ℕ` which is zero away from a finite set.
This will give rise to a monomial in `mv_polynomial σ R` which mathematicians might call `X^s`

+ `r : R` elements of the coefficient ring

+ `i : σ`, with corresponding monomial `X i`, often denoted `X_i` by mathematicians

+ `p : mv_polynomial σ α`

-/

noncomputable theory

open_locale classical big_operators

open set function finsupp add_monoid_algebra
open_locale big_operators

variables {σ τ α R S : Type*} [comm_semiring R] [comm_semiring S]

namespace mv_polynomial

section rename

/-- Rename all the variables in a multivariable polynomial. -/
def rename (f : σ → τ) : mv_polynomial σ R →ₐ[R] mv_polynomial τ R :=
aeval (X ∘ f)

@[simp] lemma rename_C (f : σ → τ) (r : R) : rename f (C r) = C r :=
eval₂_C _ _ _

@[simp] lemma rename_X (f : σ → τ) (i : σ) : rename f (X i : mv_polynomial σ R) = X (f i) :=
eval₂_X _ _ _

lemma map_rename (f : R →+* S) (g : σ → τ) (p : mv_polynomial σ R) :
  map f (rename g p) = rename g (map f p) :=
mv_polynomial.induction_on p
  (λ a, by simp only [map_C, rename_C])
  (λ p q hp hq, by simp only [hp, hq, alg_hom.map_add, ring_hom.map_add])
  (λ p n hp, by simp only [hp, rename_X, map_X, ring_hom.map_mul, alg_hom.map_mul])

@[simp] lemma rename_rename (f : σ → τ) (g : τ → α) (p : mv_polynomial σ R) :
  rename g (rename f p) = rename (g ∘ f) p :=
show rename g (eval₂ C (X ∘ f) p) = _,
begin
  simp only [rename, aeval_eq_eval₂_hom],
  simp [eval₂_comp_left _ C (X ∘ f) p, (∘), eval₂_C, eval_X],
  apply eval₂_hom_congr _ rfl rfl,
  ext1, simp only [comp_app, ring_hom.coe_comp, eval₂_hom_C],
end

@[simp] lemma rename_id (p : mv_polynomial σ R) : rename id p = p :=
eval₂_eta p

lemma rename_monomial (f : σ → τ) (d : σ →₀ ℕ) (r : R) :
  rename f (monomial d r) = monomial (d.map_domain f) r :=
begin
  rw [rename, aeval_monomial, monomial_eq, finsupp.prod_map_domain_index],
  { refl },
  { exact assume n, pow_zero _ },
  { exact assume n i₁ i₂, pow_add _ _ _ }
end

lemma rename_eq (f : σ → τ) (p : mv_polynomial σ R) :
  rename f p = finsupp.map_domain (finsupp.map_domain f) p :=
begin
  simp only [rename, aeval_def, eval₂, finsupp.map_domain, algebra_map_eq, X_pow_eq_monomial,
     ← monomial_finsupp_sum_index],
  refl
end

lemma rename_injective (f : σ → τ) (hf : function.injective f) :
  function.injective (rename f : mv_polynomial σ R → mv_polynomial τ R) :=
have (rename f : mv_polynomial σ R → mv_polynomial τ R) =
  finsupp.map_domain (finsupp.map_domain f) := funext (rename_eq f),
begin
  rw this,
  exact finsupp.map_domain_injective (finsupp.map_domain_injective hf)
end

section
variables {f : σ → τ} (hf : function.injective f)
open_locale classical

/-- Given a function between sets of variables `f : σ → τ` that is injective with proof `hf`,
  `kill_compl hf` is the `alg_hom` from `R[τ]` to `R[σ]` that is left inverse to
  `rename f : R[σ] → R[τ]` and sends the variables in the complement of the range of `f` to `0`. -/
def kill_compl : mv_polynomial τ R →ₐ[R] mv_polynomial σ R :=
aeval (λ i, if h : i ∈ set.range f then X $ (equiv.of_injective f hf).symm ⟨i,h⟩ else 0)

lemma kill_compl_comp_rename : (kill_compl hf).comp (rename f) = alg_hom.id R _ := alg_hom_ext $
λ i, by { dsimp, rw [rename, kill_compl, aeval_X, aeval_X, dif_pos, equiv.of_injective_symm_apply] }

@[simp] lemma kill_compl_rename_app (p : mv_polynomial σ R) : kill_compl hf (rename f p) = p :=
alg_hom.congr_fun (kill_compl_comp_rename hf) p

end

section
variables (R)

/-- `mv_polynomial.rename e` is an equivalence when `e` is. -/
@[simps apply]
def rename_equiv (f : σ ≃ τ) : mv_polynomial σ R ≃ₐ[R] mv_polynomial τ R :=
{ to_fun := rename f,
  inv_fun := rename f.symm,
  left_inv := λ p, by rw [rename_rename, f.symm_comp_self, rename_id],
  right_inv := λ p, by rw [rename_rename, f.self_comp_symm, rename_id],
  ..rename f}

@[simp] lemma rename_equiv_refl :
  rename_equiv R (equiv.refl σ) = alg_equiv.refl :=
alg_equiv.ext rename_id

@[simp] lemma rename_equiv_symm (f : σ ≃ τ) :
  (rename_equiv R f).symm = rename_equiv R f.symm := rfl

@[simp] lemma rename_equiv_trans (e : σ ≃ τ) (f : τ ≃ α):
  (rename_equiv R e).trans (rename_equiv R f) = rename_equiv R (e.trans f) :=
alg_equiv.ext (rename_rename e f)

end

section
variables (f : R →+* S) (k : σ → τ) (g : τ → S) (p : mv_polynomial σ R)

lemma eval₂_rename : (rename k p).eval₂ f g = p.eval₂ f (g ∘ k) :=
by apply mv_polynomial.induction_on p; { intros, simp [*] }

lemma eval₂_hom_rename : eval₂_hom f g (rename k p) = eval₂_hom f (g ∘ k) p :=
eval₂_rename _ _ _ _

lemma aeval_rename [algebra R S] : aeval g (rename k p) = aeval (g ∘ k) p :=
eval₂_hom_rename _ _ _ _

lemma rename_eval₂ (g : τ → mv_polynomial σ R) :
  rename k (p.eval₂ C (g ∘ k)) = (rename k p).eval₂ C (rename k ∘ g) :=
by apply mv_polynomial.induction_on p; { intros, simp [*] }

lemma rename_prodmk_eval₂ (j : τ) (g : σ → mv_polynomial σ R) :
  rename (prod.mk j) (p.eval₂ C g) = p.eval₂ C (λ x, rename (prod.mk j) (g x)) :=
by apply mv_polynomial.induction_on p; { intros, simp [*] }

lemma eval₂_rename_prodmk (g : σ × τ → S) (i : σ) (p : mv_polynomial τ R) :
  (rename (prod.mk i) p).eval₂ f g = eval₂ f (λ j, g (i, j)) p :=
by apply mv_polynomial.induction_on p; { intros, simp [*] }

lemma eval_rename_prodmk (g : σ × τ → R) (i : σ) (p : mv_polynomial τ R) :
  eval g (rename (prod.mk i) p) = eval (λ j, g (i, j)) p :=
eval₂_rename_prodmk (ring_hom.id _) _ _ _

end

/-- Every polynomial is a polynomial in finitely many variables. -/
theorem exists_finset_rename (p : mv_polynomial σ R) :
  ∃ (s : finset σ) (q : mv_polynomial {x // x ∈ s} R), p = rename coe q :=
begin
  apply induction_on p,
  { intro r, exact ⟨∅, C r, by rw rename_C⟩ },
  { rintro p q ⟨s, p, rfl⟩ ⟨t, q, rfl⟩,
    refine ⟨s ∪ t, ⟨_, _⟩⟩,
    { refine rename (subtype.map id _) p + rename (subtype.map id _) q;
      simp only [id.def, true_or, or_true, finset.mem_union, forall_true_iff] {contextual := tt}, },
    { simp only [rename_rename, alg_hom.map_add], refl, }, },
  { rintro p n ⟨s, p, rfl⟩,
    refine ⟨insert n s, ⟨_, _⟩⟩,
    { refine rename (subtype.map id _) p * X ⟨n, s.mem_insert_self n⟩,
      simp only [id.def, or_true, finset.mem_insert, forall_true_iff] {contextual := tt}, },
    { simp only [rename_rename, rename_X, subtype.coe_mk, alg_hom.map_mul], refl, }, },
end

/-- `exists_finset_rename` for two polyonomials at once: for any two polynomials `p₁`, `p₂` in a
  polynomial semiring `R[σ]` of possibly infinitely many variables, `exists_finset_rename₂` yields
  a finite subset `s` of `σ` such that both `p₁` and `p₂` are contained in the polynomial semiring
  `R[s]` of finitely many variables. -/
lemma exists_finset_rename₂ (p₁ p₂ : mv_polynomial σ R) :
  ∃ (s : finset σ) (q₁ q₂ : mv_polynomial s R), p₁ = rename coe q₁ ∧ p₂ = rename coe q₂ :=
begin
  obtain ⟨s₁,q₁,rfl⟩ := exists_finset_rename p₁,
  obtain ⟨s₂,q₂,rfl⟩ := exists_finset_rename p₂,
  classical, use s₁ ∪ s₂,
  use rename (set.inclusion $ s₁.subset_union_left s₂) q₁,
  use rename (set.inclusion $ s₁.subset_union_right s₂) q₂,
  split; simpa,
end

/-- Every polynomial is a polynomial in finitely many variables. -/
theorem exists_fin_rename (p : mv_polynomial σ R) :
  ∃ (n : ℕ) (f : fin n → σ) (hf : injective f) (q : mv_polynomial (fin n) R), p = rename f q :=
begin
  obtain ⟨s, q, rfl⟩ := exists_finset_rename p,
  let n := fintype.card {x // x ∈ s},
  let e := fintype.equiv_fin {x // x ∈ s},
  refine ⟨n, coe ∘ e.symm, subtype.val_injective.comp e.symm.injective, rename e q, _⟩,
  rw [← rename_rename, rename_rename e],
  simp only [function.comp, equiv.symm_apply_apply, rename_rename]
end

end rename

lemma eval₂_cast_comp (f : σ → τ) (c : ℤ →+* R) (g : τ → R) (p : mv_polynomial σ ℤ) :
  eval₂ c (g ∘ f) p = eval₂ c g (rename f p) :=
mv_polynomial.induction_on p
(λ n, by simp only [eval₂_C, rename_C])
(λ p q hp hq, by simp only [hp, hq, rename, eval₂_add, alg_hom.map_add])
(λ p n hp, by simp only [hp, rename, aeval_def, eval₂_X, eval₂_mul])

section coeff

@[simp]
lemma coeff_rename_map_domain (f : σ → τ) (hf : injective f) (φ : mv_polynomial σ R) (d : σ →₀ ℕ) :
  (rename f φ).coeff (d.map_domain f) = φ.coeff d :=
begin
  apply induction_on' φ,
  { intros u r,
    rw [rename_monomial, coeff_monomial, coeff_monomial],
    simp only [(finsupp.map_domain_injective hf).eq_iff] },
  { intros, simp only [*, alg_hom.map_add, coeff_add], }
end

lemma coeff_rename_eq_zero (f : σ → τ) (φ : mv_polynomial σ R) (d : τ →₀ ℕ)
  (h : ∀ u : σ →₀ ℕ, u.map_domain f = d → φ.coeff u = 0) :
  (rename f φ).coeff d = 0 :=
begin
  rw [rename_eq, ← not_mem_support_iff],
  intro H,
  replace H := map_domain_support H,
  rw [finset.mem_image] at H,
  obtain ⟨u, hu, rfl⟩ := H,
  specialize h u rfl,
  simp at h hu,
  contradiction
end

lemma coeff_rename_ne_zero (f : σ → τ) (φ : mv_polynomial σ R) (d : τ →₀ ℕ)
  (h : (rename f φ).coeff d ≠ 0) :
  ∃ u : σ →₀ ℕ, u.map_domain f = d ∧ φ.coeff u ≠ 0 :=
by { contrapose! h, apply coeff_rename_eq_zero _ _ _ h }

@[simp] lemma constant_coeff_rename {τ : Type*} (f : σ → τ) (φ : mv_polynomial σ R) :
  constant_coeff (rename f φ) = constant_coeff φ :=
begin
  apply φ.induction_on,
  { intro a, simp only [constant_coeff_C, rename_C]},
  { intros p q hp hq, simp only [hp, hq, ring_hom.map_add, alg_hom.map_add] },
  { intros p n hp, simp only [hp, rename_X, constant_coeff_X, ring_hom.map_mul, alg_hom.map_mul] }
end

end coeff

section support

lemma support_rename_of_injective {p : mv_polynomial σ R} {f : σ → τ} (h : function.injective f) :
  (rename f p).support = finset.image (map_domain f) p.support :=
begin
  rw rename_eq,
  exact finsupp.map_domain_support_of_injective (map_domain_injective h) _,
end

end support

end mv_polynomial