import algebraic_geometry.prime_spectrum.basic
import for_mathlib.residue_field
import dimension_theory.artinian

open_locale filter topological_space

open ideal (is_jacobson)

variables {K A : Type*} [field K] [comm_ring A] [algebra K A] [algebra.finite_type K A]

lemma prime_spectrum.zero_locus_eq_iff {I J : ideal A} :
  prime_spectrum.zero_locus (I : set A) = prime_spectrum.zero_locus J ↔ I.radical = J.radical :=
begin
  split,
  { intro h, simp_rw [← prime_spectrum.vanishing_ideal_zero_locus_eq_radical, h] },
  { intro h, rw [← prime_spectrum.zero_locus_radical, h, prime_spectrum.zero_locus_radical] }
end

variable (K)

lemma ideal.exists_pow_le_of_fg {R : Type*} [comm_semiring R] (I J : ideal R) (h : I.fg)
  (h' : I ≤ J.radical) :
  ∃ n : ℕ, I ^ n ≤ J :=
begin
  revert h',
  refine submodule.fg_induction _ _ (λ I, I ≤ J.radical → ∃ n : ℕ, I ^ n ≤ J) _ _ _ h,
  { intros x hx, obtain ⟨n, hn⟩ := hx (ideal.subset_span (set.mem_singleton x)),
    exact ⟨n, by rwa [← ideal.span, ideal.span_singleton_pow, ideal.span_le, set.singleton_subset_iff]⟩ },
  { intros J K hJ hK hJK,
    obtain ⟨n, hn⟩ := hJ (λ x hx, hJK $ ideal.mem_sup_left hx),
    obtain ⟨m, hm⟩ := hK (λ x hx, hJK $ ideal.mem_sup_right hx),
    use n + m,
    rw [← ideal.add_eq_sup, add_pow, ideal.sum_eq_sup, finset.sup_le_iff],
    refine λ i hi, ideal.mul_le_right.trans _,
    obtain h | h := le_or_lt n i,
    { exact ideal.mul_le_right.trans ((ideal.pow_le_pow h).trans hn) },
    { refine ideal.mul_le_left.trans ((ideal.pow_le_pow _).trans hm),
      rw [add_comm, nat.add_sub_assoc h.le], apply nat.le_add_right } },
end

lemma ideal.exists_ne_zero_pow_le_of_fg {R : Type*} [comm_semiring R] (I J : ideal R) (h : I.fg)
  (h' : I ≤ J.radical) :
  ∃ n ≠ 0, I ^ n ≤ J :=
begin
  obtain ⟨n, hn⟩ := ideal.exists_pow_le_of_fg I J h h',
  exact ⟨n + 1, n.succ_ne_zero, (ideal.pow_le_pow n.le_succ).trans hn⟩,
end

lemma prime_spectrum.exists_closed_point_of_is_jacobson [is_jacobson A]
  (s : set $ prime_spectrum A) (hs : is_open s) (hs' : s.nonempty) :
  ∃ x ∈ s, is_closed ({x} : set $ prime_spectrum A) :=
begin
  simp_rw prime_spectrum.is_closed_singleton_iff_is_maximal,
  obtain ⟨I, hI, hI'⟩ :=
    (prime_spectrum.is_closed_iff_zero_locus_radical_ideal _).mp hs.is_closed_compl,
  simp_rw [← @set.not_mem_compl_iff _ s, hI', prime_spectrum.mem_zero_locus],
  have := hs'.ne_empty, contrapose! this, simp_rw [not_imp_not] at this,
  rw [← set.compl_univ, eq_compl_comm, hI', eq_comm, ← prime_spectrum.zero_locus_bot,
    prime_spectrum.zero_locus_eq_iff, ideal.radical_eq_jacobson, ideal.radical_eq_jacobson],
  refine le_antisymm (le_Inf _) (ideal.jacobson_mono bot_le),
  rintro x ⟨-, hx⟩,
  exact Inf_le ⟨this ⟨x, hx.is_prime⟩ hx, hx⟩,
end

lemma prime_spectrum.is_compact_open_iff {s : set $ prime_spectrum A} :
  is_compact s ∧ is_open s ↔
  ∃ I : ideal A, I.fg ∧ (prime_spectrum.zero_locus (I : set A))ᶜ = s :=
begin
  rw topological_space.opens.is_compact_open_iff_eq_finite_Union_of_is_basis _
    prime_spectrum.is_basis_basic_opens prime_spectrum.is_compact_basic_open,
  simp_rw [prime_spectrum.basic_open_eq_zero_locus_compl, ← set.compl_Inter₂,
    ← prime_spectrum.zero_locus_Union, set.bUnion_of_singleton, @eq_comm _ s],
  split,
  { rintro ⟨s, hs, rfl⟩,
    exact ⟨ideal.span s, ⟨hs.to_finset, by rw set.finite.coe_to_finset⟩,
      by rw prime_spectrum.zero_locus_span⟩ },
  { rintro ⟨_, ⟨s, rfl⟩, rfl⟩,
    exact ⟨s, s.finite_to_set, by rw [prime_spectrum.zero_locus_span]⟩ }
end

lemma prime_spectrum.exists_idempotent_basic_open_eq_of_is_clopen {s : set $ prime_spectrum A}
  (hs : is_clopen s) :
  ∃ e : A, is_idempotent_elem e ∧ s = prime_spectrum.basic_open e :=
begin
  obtain ⟨I, hI, hI'⟩ := prime_spectrum.is_compact_open_iff.mp
    ⟨is_compact_of_is_closed_subset is_compact_univ hs.2 s.subset_univ, hs.1⟩,
  obtain ⟨J, hJ, hJ'⟩ := prime_spectrum.is_compact_open_iff.mp ⟨is_compact_of_is_closed_subset
    is_compact_univ hs.1.is_closed_compl $ set.subset_univ _, hs.2.is_open_compl⟩,
  simp only [compl_eq_iff_is_compl, ← eq_compl_iff_is_compl, compl_compl] at hI' hJ',
  have : I * J ≤ ideal.radical (⊥ : ideal A),
  { refine ideal.radical_le_radical_iff.mp (eq.le _),
    rw [← prime_spectrum.zero_locus_eq_iff, prime_spectrum.zero_locus_bot,
      prime_spectrum.zero_locus_mul, hI', hJ', set.compl_union_self] },
  obtain ⟨n, hn, hn'⟩ := ideal.exists_ne_zero_pow_le_of_fg _ _ (submodule.fg.mul hI hJ) this,
  rw mul_pow at hn',
  have : I ^ n ⊔ J ^ n = ⊤,
  { rw [eq_top_iff, ← ideal.span_pow_eq_top (I ∪ J : set A) _ n, ideal.span_le, set.image_union,
      set.union_subset_iff],
    split,
    { rintro _ ⟨x, hx, rfl⟩, exact ideal.mem_sup_left (ideal.pow_mem_pow hx n) },
    { rintro _ ⟨x, hx, rfl⟩, exact ideal.mem_sup_right (ideal.pow_mem_pow hx n) },
    { rw [ideal.span_union, ideal.span_eq, ideal.span_eq,
        ← prime_spectrum.zero_locus_empty_iff_eq_top, prime_spectrum.zero_locus_sup, hI', hJ',
        set.compl_inter_self] } },
  rw [ideal.eq_top_iff_one, submodule.mem_sup] at this,
  obtain ⟨x, hx, y, hy, e⟩ := this,
  refine ⟨x, _, subset_antisymm _ _⟩,
  { have : x * y = 0 := hn' (ideal.mul_mem_mul hx hy),
    rw ← eq_sub_iff_add_eq' at e, rwa [e, mul_sub, sub_eq_zero, eq_comm, mul_one] at this },
  { rw [prime_spectrum.basic_open_eq_zero_locus_compl, set.subset_compl_iff_disjoint_left,
      set.disjoint_iff_inter_eq_empty, ← hJ', ← prime_spectrum.zero_locus_span,
      ← prime_spectrum.zero_locus_sup, prime_spectrum.zero_locus_empty_iff_eq_top,
      ideal.eq_top_iff_one, ← e],
    exact submodule.add_mem_sup (ideal.subset_span $ set.mem_singleton _)
      (ideal.pow_le_self hn hy) },
  { rw [prime_spectrum.basic_open_eq_zero_locus_compl, set.compl_subset_comm, ← hI'],
    exact prime_spectrum.zero_locus_anti_mono
      (set.singleton_subset_iff.mpr $ ideal.pow_le_self hn hx) }
end

lemma prime_spectrum.basic_open_eq_zero_locus_of_is_idempotent_elem
  (e : A) (he : is_idempotent_elem e) : ↑(prime_spectrum.basic_open e) =
    prime_spectrum.zero_locus ({1 - e} : set A) :=
begin
  ext p,
  suffices : e ∉ p.as_ideal ↔ 1 - e ∈ p.as_ideal, { simpa },
  split,
  { intro h,
    refine (p.2.mem_or_mem_of_mul_eq_zero _).resolve_left h,
    rw [mul_sub, mul_one, he.eq, sub_self] },
  { intros h₁ h₂, apply p.2.1,
    rw [ideal.eq_top_iff_one, ← sub_add_cancel 1 e], exact add_mem h₁ h₂ }
end

lemma prime_spectrum.zero_locus_eq_basic_open_of_is_idempotent_elem
  (e : A) (he : is_idempotent_elem e) :
    prime_spectrum.zero_locus ({e} : set A) = prime_spectrum.basic_open (1 - e) :=
by rw [prime_spectrum.basic_open_eq_zero_locus_of_is_idempotent_elem _ he.one_sub, sub_sub_cancel]

lemma prime_spectrum.is_clopen_iff {s : set (prime_spectrum A)} :
  is_clopen s ↔ ∃ e : A, is_idempotent_elem e ∧ s = prime_spectrum.basic_open e :=
begin
  refine ⟨prime_spectrum.exists_idempotent_basic_open_eq_of_is_clopen, _⟩,
  rintro ⟨e, he, rfl⟩,
  refine ⟨(prime_spectrum.basic_open e).prop, _⟩,
  rw [prime_spectrum.basic_open_eq_zero_locus_of_is_idempotent_elem e he],
  exact prime_spectrum.is_closed_zero_locus _
end

lemma is_isolated_point_iff {α : Type*} [topological_space α] {x : α} :
  𝓝[≠] x = ⊥ ↔ is_open ({x} : set α) :=
by rw [← is_closed_compl_iff, ← closure_subset_iff_is_closed, set.subset_compl_singleton_iff,
    mem_closure_iff_nhds_within_ne_bot, filter.not_ne_bot]

lemma is_localization.of_le_of_is_unit {R : Type*}
  [comm_ring R] (A : Type*) [comm_ring A] [algebra R A] (M N : submonoid R) [is_localization M A]
  (h : M ≤ N) (h' : ∀ x ∈ N, is_unit (algebra_map R A x)) : is_localization N A :=
begin
  refine ⟨λ x, h' _ x.2, λ x, _, _⟩,
  { obtain ⟨⟨r, ⟨m, hm⟩⟩, e⟩ := is_localization.surj M x,
    exact ⟨⟨r, ⟨m, h hm⟩⟩, e⟩ },
  { intros x y,
    split,
    { rw is_localization.eq_iff_exists M, rintros ⟨⟨c, hc⟩, e⟩, exact ⟨⟨c, h hc⟩, e⟩ },
    { rintros ⟨⟨c, hc⟩, e⟩,
      apply_fun algebra_map R A at e,
      simpa only [map_mul, subtype.coe_mk, is_unit.mul_left_inj (h' _ hc)] using e } }
end

def minimal_primes.to_prime_spectrum : minimal_primes A ↪ prime_spectrum A :=
⟨λ x, ⟨x.1, x.2.1.1⟩, by tidy⟩

lemma minimal_primes.is_min_to_prime_spectrum (x : minimal_primes A) :
  is_min (minimal_primes.to_prime_spectrum x) :=
λ y h, x.2.2 ⟨y.2, bot_le⟩ h

lemma minimal_primes.range_to_prime_spectrum :
  set.range (@minimal_primes.to_prime_spectrum A _) = set_of is_min :=
begin
  apply subset_antisymm,
  { rintro _ ⟨x, rfl⟩, exact minimal_primes.is_min_to_prime_spectrum _ },
  { exact λ x hx, ⟨⟨x.as_ideal, ⟨x.2, bot_le⟩,
      λ y hy hy', @hx ⟨y, hy.1⟩ hy'⟩, subtype.coe_injective rfl⟩ },
end

lemma prime_spectrum.is_max_iff {x : prime_spectrum A} :
  is_max x ↔ x.as_ideal.is_maximal :=
begin
  split,
  { intro hx,
    refine ⟨⟨x.2.ne_top, λ I hI, _⟩⟩,
    by_contra e,
    obtain ⟨m, hm, hm'⟩ := ideal.exists_le_maximal I e,
    exact hx.not_lt (show x < ⟨m, hm.is_prime⟩, from hI.trans_le hm') },
  { intros hx y e, rw subtype.coe_injective (hx.eq_of_le y.2.ne_top e), exact le_rfl }
end

variable (K)

-- move me
lemma ideal.residue_field_bijective_of_maximal (I : ideal A) [I.is_maximal] :
  function.bijective (algebra_map (A ⧸ I) I.residue_field) :=
begin
  letI : field (A ⧸ I) := I^.quotient.field,
  exact (is_localization.at_units (A ⧸ I) (non_zero_divisors _) I.residue_field
    (λ x, is_unit_iff_ne_zero.mpr (mem_non_zero_divisors_iff_ne_zero.mp x.2))).bijective,
end

lemma ideal.residue_field_surjective_of_maximal (I : ideal A) [I.is_maximal] :
  function.surjective (algebra_map A I.residue_field) :=
begin
  rw is_scalar_tower.algebra_map_eq A (A ⧸ I) I.residue_field,
  exact I^.residue_field_bijective_of_maximal^.surjective^.comp ideal.quotient.mk_surjective
end

lemma prime_spectrum.is_min_iff_stable_under_generalization {x : prime_spectrum A} :
  is_min x ↔ stable_under_generalization ({x} : set $ prime_spectrum A) :=
begin
  simp_rw [stable_under_generalization, ← prime_spectrum.le_iff_specializes],
    exact ⟨λ H x' y h (e : x' = x), le_antisymm (e ▸ h) (@H y (e ▸ h)), λ H y h, (H h rfl).ge⟩
end

lemma prime_spectrum.is_closed_singleton_tfae_of_finite_type_of_field (x : prime_spectrum A) :
  tfae [x.as_ideal.is_maximal,
    is_closed ({x} : set $ prime_spectrum A),
    stable_under_specialization ({x} : set $ prime_spectrum A),
    module.finite K x.as_ideal.residue_field,
    algebra.is_algebraic K x.as_ideal.residue_field] :=
begin
  tfae_have : 1 ↔ 2,
  { rw prime_spectrum.is_closed_singleton_iff_is_maximal },
  tfae_have : 1 ↔ 3,
  { simp_rw [← prime_spectrum.is_max_iff, stable_under_specialization,
      ← prime_spectrum.le_iff_specializes],
    exact ⟨λ H x' y h (e : x' = x), (@H y (e ▸ h)).antisymm (e ▸ h), λ H y h, (H h rfl).le⟩ },
  tfae_have : 1 → 4,
  { introI h,
    haveI : algebra.finite_type K x.as_ideal.residue_field :=
      ‹algebra.finite_type K A›.trans (algebra.finite_type.of_surjective infer_instance
      (algebra.of_id _ _) x.as_ideal.residue_field_surjective_of_maximal),
    exact finite_of_finite_type_of_is_jacobson_of_field K x.as_ideal.residue_field },
  tfae_have : 4 → 5,
  { introI h, exact algebra.is_algebraic_of_finite _ _ },
  tfae_have : 5 → 1,
  { introI h,
    refine ideal.quotient.maximal_of_is_field _ _,
    apply (alg_equiv.of_injective
      ((is_scalar_tower.to_alg_hom A (A ⧸ x.as_ideal) x.as_ideal.residue_field).restrict_scalars K)
      (is_fraction_ring.injective (A ⧸ x.as_ideal) x.as_ideal.residue_field)).symm
      .to_ring_equiv.is_field_of_is_field,
    exact subalgebra.is_field_of_algebraic _ h },
  tfae_finish
end

lemma prime_spectrum.is_closed_singleton_iff_finite (x : prime_spectrum A) :
  is_closed ({x} : set $ prime_spectrum A) ↔ module.finite K x.as_ideal.residue_field :=
(prime_spectrum.is_closed_singleton_tfae_of_finite_type_of_field K x).out 1 3

open ideal (is_jacobson)

lemma prime_spectrum.is_open_singleton_tfae_of_finite_type_of_is_jacobson [is_jacobson A]
  [is_noetherian_ring A] (x : prime_spectrum A) :
  tfae [is_open ({x} : set $ prime_spectrum A),
    is_clopen ({x} : set $ prime_spectrum A),
    is_closed ({x} : set $ prime_spectrum A) ∧ is_min x] :=
begin
  tfae_have : 1 → 2,
  { intro h, obtain ⟨y, rfl : y = x, h'⟩ := prime_spectrum.exists_closed_point_of_is_jacobson _ h
      ⟨x, set.mem_singleton x⟩, exact ⟨h, h'⟩ },
  tfae_have : 2 → 3,
  { rw prime_spectrum.is_min_iff_stable_under_generalization,
    exact λ h, ⟨h.is_closed, h.is_open.stable_under_generalization⟩ },
  tfae_have : 3 → 1,
  { rintros ⟨h₁, h₂⟩,
    rw [prime_spectrum.is_closed_singleton_iff_is_maximal, ← prime_spectrum.is_max_iff] at h₁,
    suffices : {x} = (⋃ p ∈ { p : prime_spectrum A | is_min p ∧ p ≠ x },
      closure {p} : set (prime_spectrum A))ᶜ,
    { rw [this, is_open_compl_iff],
      refine is_closed_bUnion _ (λ _ _, is_closed_closure),
      haveI := (@minimal_primes_finite A _ _).to_subtype,
      apply (set.range $ @minimal_primes.to_prime_spectrum A _).to_finite.subset,
      rw minimal_primes.range_to_prime_spectrum,
      exact λ x hx, hx.1 },
    ext p,
    simp only [set.mem_singleton_iff, set.compl_Union₂, set.mem_Inter₂,
      set.mem_compl_iff, ← specializes_iff_mem_closure, ← prime_spectrum.le_iff_specializes],
    split,
    { rintro rfl y hy h, exact hy.2 (h₂.eq_of_le h) },
    { intros hp,
      apply h₁.eq_of_ge,
      obtain ⟨q, hq, hq'⟩ := ideal.exists_minimal_primes_le (@bot_le _ _ _ p.as_ideal),
      have : minimal_primes.to_prime_spectrum ⟨q, hq⟩ = x,
      { by_contra h, exact hp _ ⟨minimal_primes.is_min_to_prime_spectrum _, h⟩ hq' },
      rw ← this, exact hq' } },
  tfae_finish
end

lemma prime_spectrum.is_open_singleton_iff_is_max_and_is_min [ideal.is_jacobson A]
  [is_noetherian_ring A]
  (x : prime_spectrum A) :
  is_open ({x} : set $ prime_spectrum A) ↔ is_max x ∧ is_min x :=
begin
  rw [(prime_spectrum.is_open_singleton_tfae_of_finite_type_of_is_jacobson x).out 0 2,
    prime_spectrum.is_closed_singleton_iff_is_maximal, prime_spectrum.is_max_iff],
end

lemma prime_spectrum.is_open_singleton_tfae_of_finite_type_of_field (x : prime_spectrum A) :
  tfae [is_open ({x} : set $ prime_spectrum A),
    is_clopen ({x} : set $ prime_spectrum A),
    module.finite K (localization.at_prime x.as_ideal),
    is_closed ({x} : set $ prime_spectrum A) ∧ is_min x] :=
begin
  haveI := is_jacobson_of_finite_type K A,
  haveI := algebra.finite_type.is_noetherian_ring K A,
  tfae_have : 1 ↔ 2,
  { exact (prime_spectrum.is_open_singleton_tfae_of_finite_type_of_is_jacobson x).out 0 1 },
  tfae_have : 1 ↔ 4,
  { exact (prime_spectrum.is_open_singleton_tfae_of_finite_type_of_is_jacobson x).out 0 2 },
  tfae_have : 2 → 3,
  { intro h,
    obtain ⟨e, he, he'⟩ := prime_spectrum.exists_idempotent_basic_open_eq_of_is_clopen h,
    have he'' : e ∈ x.as_ideal.prime_compl,
    { show x ∈ (prime_spectrum.basic_open e : set (prime_spectrum A)), rw ← he', exact rfl },
    haveI : is_localization.at_prime (localization.away e) x.as_ideal,
    { apply is_localization.of_le_of_is_unit _ (submonoid.powers e),
      { simpa only [set_like.mem_coe, submonoid.closure_le, set.singleton_subset_iff,
          submonoid.powers_eq_closure] },
      { intro a, dsimp [ideal.prime_compl], contrapose!, intro h,
        obtain ⟨I, hI₁, hI₂⟩ := exists_max_ideal_of_mem_nonunits h,
        suffices : prime_spectrum.comap (algebra_map A (localization.away e)) ⟨I, hI₁.is_prime⟩ = x,
        { rw ← this, exact hI₂ },
        rw [← set.mem_singleton_iff, he'],
        rintro (H : algebra_map A (localization.away e) e ∈ I),
        exact hI₁.ne_top (ideal.eq_top_of_is_unit_mem _ H
          (is_localization.map_units _ ⟨_, submonoid.mem_powers e⟩)) } },
    haveI : algebra.finite_type K (localization.at_prime x.as_ideal),
    { exact ‹algebra.finite_type K A›.trans ((algebra.finite_type.of_finite_presentation
        $ is_localization.away.finite_presentation e).equiv
        (is_localization.alg_equiv x.as_ideal.prime_compl (localization.away e)
        (localization.at_prime x.as_ideal))) },
    rw finite_iff_forall_prime_is_maximal_of_field,
    intros I hI,
    suffices : I = local_ring.maximal_ideal _, { rw this, apply_instance },
    refine (is_localization.order_embedding x.as_ideal.prime_compl _).injective _,
    dsimp [is_localization.order_embedding],
    rw localization.at_prime.comap_maximal_ideal,
    suffices : prime_spectrum.comap (algebra_map A (localization.at_prime x.as_ideal)) ⟨I, hI⟩ = x,
    { conv_rhs { rw ← this }, refl },
    rw [← set.mem_singleton_iff, he'],
    rintro (H : algebra_map A (localization.at_prime x.as_ideal) e ∈ I),
    exact hI.ne_top (ideal.eq_top_of_is_unit_mem _ H (is_localization.map_units _ ⟨_, he''⟩)) },
  tfae_have : 3 → 4,
  { introI h,
    rw prime_spectrum.is_closed_singleton_iff_finite K x,
    haveI : is_scalar_tower K (localization.at_prime x.as_ideal) x.as_ideal.residue_field :=
      ideal.residue_field.is_scalar_tower x.as_ideal,
    refine ⟨module.finite.of_surjective (is_scalar_tower.to_alg_hom K
      (localization.at_prime x.as_ideal) _).to_linear_map ideal.quotient.mk_surjective, _⟩,
    intros y hy,
    have : is_artinian_ring (localization.at_prime x.as_ideal) := is_artinian_of_tower K
      (((module.finite_length_tfae_of_field K (localization.at_prime x.as_ideal)).out 0 2).mp h),
    replace this := ((is_artinian_ring_iff_is_noetherian_ring _).mp this).2,
    have H : disjoint (x.as_ideal.prime_compl : set A) y.as_ideal,
    { show disjoint (x.as_idealᶜ : set A) y.as_ideal, rw disjoint_compl_left_iff, exact hy },
    show x.as_ideal ≤ y.as_ideal,
    rw [← @localization.at_prime.comap_maximal_ideal _ _ x.as_ideal,
      ← is_localization.comap_map_of_is_prime_disjoint _
        (localization.at_prime x.as_ideal) y.as_ideal y.2 H],
    refine ideal.comap_mono (local_ring.eq_maximal_ideal $ this _ _).ge,
    exact is_localization.is_prime_of_is_prime_disjoint x.as_ideal.prime_compl _ _ y.2 H },
  tfae_finish
end

.

lemma prime_spectrum.is_closed_singleton_iff_finite'
  {K A : Type*} [field K] [comm_ring A] (f : K →+* A) (hf : f.finite_type) (x : prime_spectrum A) :
  is_closed ({x} : set $ prime_spectrum A) ↔
    ((algebra_map A $ x.as_ideal.residue_field).comp f).finite :=
begin
  letI := f.to_algebra,
  haveI : algebra.finite_type K A := hf,
  exact prime_spectrum.is_closed_singleton_iff_finite K x
end

lemma _root_.list.tfae.of_subset {l₁ l₂ : list Prop} (e : l₁ ⊆ l₂) (h : tfae l₂) : tfae l₁ :=
λ a ha b hb, h _ (e ha) _ (e hb)

lemma prime_spectrum.is_closed_singleton_tfae_of_finite_type_of_field'
  {K A : Type*} [field K] [comm_ring A] (f : K →+* A) (hf : f.finite_type) (x : prime_spectrum A) :
  tfae [x.as_ideal.is_maximal,
    is_closed ({x} : set $ prime_spectrum A),
    stable_under_specialization ({x} : set $ prime_spectrum A),
    ((algebra_map A $ x.as_ideal.residue_field).comp f).finite] :=
begin
  letI := f.to_algebra,
  haveI : algebra.finite_type K A := hf,
  delta ring_hom.finite,
  refine (prime_spectrum.is_closed_singleton_tfae_of_finite_type_of_field K x).of_subset _,
  simp only [list.nil_subset, list.mem_cons_iff, true_or, or_true, list.mem_singleton,
    and_self, list.cons_subset, eq_self_iff_true],
end

lemma prime_spectrum.is_open_singleton_tfae_of_finite_type_of_field'
  {K A : Type*} [field K] [comm_ring A] (f : K →+* A) (hf : f.finite_type) (x : prime_spectrum A) :
  tfae [is_open ({x} : set $ prime_spectrum A),
    is_clopen ({x} : set $ prime_spectrum A),
    ((algebra_map A $ localization.at_prime x.as_ideal).comp f).finite,
    is_closed ({x} : set $ prime_spectrum A) ∧ is_min x] :=
begin
  letI := f.to_algebra,
  haveI : algebra.finite_type K A := hf,
  convert prime_spectrum.is_open_singleton_tfae_of_finite_type_of_field K x using 5,
  rw [← f.algebra_map_to_algebra, ← is_scalar_tower.algebra_map_eq],
  dsimp [ring_hom.finite],
  congr,
  exact (algebra.algebra_ext _ _ $ λ r, rfl),
end

open_locale tensor_product

universes u v w

lemma _root_.subalgebra.map_top {R S T : Type*} [comm_ring R] [comm_ring S] [comm_ring T]
  [algebra R S] [algebra R T] (f : S →ₐ[R] T) : (⊤ : subalgebra R S).map f = f.range :=
begin
  ext, simp,
end

instance {R S T : Type*}
  [comm_ring R] [comm_ring S] [comm_ring T] [algebra R S] [algebra R T]
  [algebra.finite_type R T] : algebra.finite_type S (S ⊗[R] T) :=
begin
  classical,
  unfreezingI { obtain ⟨⟨s, hs⟩⟩ := ‹algebra.finite_type R T› },
  refine ⟨⟨s.image algebra.tensor_product.include_right, _⟩⟩,
  rw [finset.coe_image, ← @algebra.adjoin_adjoin_of_tower R S (tensor_product R S T),
    algebra.adjoin_image, hs, subalgebra.map_top, eq_top_iff],
  rintro x -,
  induction x using tensor_product.induction_on with x y x y hx hy,
  { exact zero_mem _ },
  { convert_to x • ((1 : S) ⊗ₜ y) ∈ _,
    { rw [tensor_product.smul_tmul', ← algebra.algebra_map_eq_smul_one], refl },
    { exact subalgebra.smul_mem _ (algebra.subset_adjoin ⟨y, rfl⟩) _ } },
  { exact add_mem hx hy }
end


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

! This file was ported from Lean 3 source module data.polynomial.inductions
! leanprover-community/mathlib commit 57e09a1296bfb4330ddf6624f1028ba186117d82
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.MonoidAlgebra.Division
import Mathbin.Data.Nat.Interval
import Mathbin.Data.Polynomial.Degree.Definitions
import Mathbin.Data.Polynomial.Induction

/-!
# Induction on polynomials

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

This file contains lemmas dealing with different flavours of induction on polynomials.
-/

noncomputable section

open Classical BigOperators Polynomial

open Finset

namespace Polynomial

universe u v w z

variable {R : Type u} {S : Type v} {T : Type w} {A : Type z} {a b : R} {n : ℕ}

section Semiring

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

#print Polynomial.divX /-
/-- `div_X p` returns a polynomial `q` such that `q * X + C (p.coeff 0) = p`.
  It can be used in a semiring where the usual division algorithm is not possible -/
def divX (p : R[X]) : R[X] :=
  ⟨AddMonoidAlgebra.divOf p.toFinsupp 1⟩
#align polynomial.div_X Polynomial.divX
-/

#print Polynomial.coeff_divX /-
@[simp]
theorem coeff_divX : (divX p).coeff n = p.coeff (n + 1) :=
  by
  rw [add_comm]
  cases p
  rfl
#align polynomial.coeff_div_X Polynomial.coeff_divX
-/

/- warning: polynomial.div_X_mul_X_add -> Polynomial.divX_mul_X_add is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} [_inst_1 : Semiring.{u1} R] (p : Polynomial.{u1} R _inst_1), Eq.{succ u1} (Polynomial.{u1} R _inst_1) (HAdd.hAdd.{u1, u1, u1} (Polynomial.{u1} R _inst_1) (Polynomial.{u1} R _inst_1) (Polynomial.{u1} R _inst_1) (instHAdd.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.add'.{u1} R _inst_1)) (HMul.hMul.{u1, u1, u1} (Polynomial.{u1} R _inst_1) (Polynomial.{u1} R _inst_1) (Polynomial.{u1} R _inst_1) (instHMul.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.mul'.{u1} R _inst_1)) (Polynomial.divX.{u1} R _inst_1 p) (Polynomial.X.{u1} R _inst_1)) (coeFn.{succ u1, succ u1} (RingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) (fun (_x : RingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) => R -> (Polynomial.{u1} R _inst_1)) (RingHom.hasCoeToFun.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) (Polynomial.C.{u1} R _inst_1) (Polynomial.coeff.{u1} R _inst_1 p (OfNat.ofNat.{0} Nat 0 (OfNat.mk.{0} Nat 0 (Zero.zero.{0} Nat Nat.hasZero)))))) p
but is expected to have type
  forall {R : Type.{u1}} [_inst_1 : Semiring.{u1} R] (p : Polynomial.{u1} R _inst_1), Eq.{succ u1} (Polynomial.{u1} R _inst_1) (HAdd.hAdd.{u1, u1, u1} (Polynomial.{u1} R _inst_1) ((fun (x._@.Mathlib.Algebra.Hom.Group._hyg.2391 : R) => Polynomial.{u1} R _inst_1) (Polynomial.coeff.{u1} R _inst_1 p (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0)))) (Polynomial.{u1} R _inst_1) (instHAdd.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.add'.{u1} R _inst_1)) (HMul.hMul.{u1, u1, u1} (Polynomial.{u1} R _inst_1) (Polynomial.{u1} R _inst_1) (Polynomial.{u1} R _inst_1) (instHMul.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.mul'.{u1} R _inst_1)) (Polynomial.divX.{u1} R _inst_1 p) (Polynomial.X.{u1} R _inst_1)) (FunLike.coe.{succ u1, succ u1, succ u1} (RingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) R (fun (_x : R) => (fun (x._@.Mathlib.Algebra.Hom.Group._hyg.2391 : R) => Polynomial.{u1} R _inst_1) _x) (MulHomClass.toFunLike.{u1, u1, u1} (RingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) R (Polynomial.{u1} R _inst_1) (NonUnitalNonAssocSemiring.toMul.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))) (NonUnitalNonAssocSemiring.toMul.{u1} (Polynomial.{u1} R _inst_1) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1)))) (NonUnitalRingHomClass.toMulHomClass.{u1, u1, u1} (RingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) R (Polynomial.{u1} R _inst_1) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) (RingHomClass.toNonUnitalRingHomClass.{u1, u1, u1} (RingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1)) (RingHom.instRingHomClassRingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1)))))) (Polynomial.C.{u1} R _inst_1) (Polynomial.coeff.{u1} R _inst_1 p (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0))))) p
Case conversion may be inaccurate. Consider using '#align polynomial.div_X_mul_X_add Polynomial.divX_mul_X_addₓ'. -/
theorem divX_mul_X_add (p : R[X]) : divX p * X + C (p.coeff 0) = p :=
  ext <| by rintro ⟨_ | _⟩ <;> simp [coeff_C, Nat.succ_ne_zero, coeff_mul_X]
#align polynomial.div_X_mul_X_add Polynomial.divX_mul_X_add

/- warning: polynomial.div_X_C -> Polynomial.divX_C is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} [_inst_1 : Semiring.{u1} R] (a : R), Eq.{succ u1} (Polynomial.{u1} R _inst_1) (Polynomial.divX.{u1} R _inst_1 (coeFn.{succ u1, succ u1} (RingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) (fun (_x : RingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) => R -> (Polynomial.{u1} R _inst_1)) (RingHom.hasCoeToFun.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) (Polynomial.C.{u1} R _inst_1) a)) (OfNat.ofNat.{u1} (Polynomial.{u1} R _inst_1) 0 (OfNat.mk.{u1} (Polynomial.{u1} R _inst_1) 0 (Zero.zero.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.zero.{u1} R _inst_1))))
but is expected to have type
  forall {R : Type.{u1}} [_inst_1 : Semiring.{u1} R] (a : R), Eq.{succ u1} (Polynomial.{u1} R _inst_1) (Polynomial.divX.{u1} R _inst_1 (FunLike.coe.{succ u1, succ u1, succ u1} (RingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) R (fun (_x : R) => (fun (x._@.Mathlib.Algebra.Hom.Group._hyg.2391 : R) => Polynomial.{u1} R _inst_1) _x) (MulHomClass.toFunLike.{u1, u1, u1} (RingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) R (Polynomial.{u1} R _inst_1) (NonUnitalNonAssocSemiring.toMul.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))) (NonUnitalNonAssocSemiring.toMul.{u1} (Polynomial.{u1} R _inst_1) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1)))) (NonUnitalRingHomClass.toMulHomClass.{u1, u1, u1} (RingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) R (Polynomial.{u1} R _inst_1) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) (RingHomClass.toNonUnitalRingHomClass.{u1, u1, u1} (RingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1)) (RingHom.instRingHomClassRingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1)))))) (Polynomial.C.{u1} R _inst_1) a)) (OfNat.ofNat.{u1} (Polynomial.{u1} R _inst_1) 0 (Zero.toOfNat0.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.zero.{u1} R _inst_1)))
Case conversion may be inaccurate. Consider using '#align polynomial.div_X_C Polynomial.divX_Cₓ'. -/
@[simp]
theorem divX_C (a : R) : divX (C a) = 0 :=
  ext fun n => by simp [coeff_div_X, coeff_C, Finsupp.single_eq_of_ne _]
#align polynomial.div_X_C Polynomial.divX_C

/- warning: polynomial.div_X_eq_zero_iff -> Polynomial.divX_eq_zero_iff is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} [_inst_1 : Semiring.{u1} R] {p : Polynomial.{u1} R _inst_1}, Iff (Eq.{succ u1} (Polynomial.{u1} R _inst_1) (Polynomial.divX.{u1} R _inst_1 p) (OfNat.ofNat.{u1} (Polynomial.{u1} R _inst_1) 0 (OfNat.mk.{u1} (Polynomial.{u1} R _inst_1) 0 (Zero.zero.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.zero.{u1} R _inst_1))))) (Eq.{succ u1} (Polynomial.{u1} R _inst_1) p (coeFn.{succ u1, succ u1} (RingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) (fun (_x : RingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) => R -> (Polynomial.{u1} R _inst_1)) (RingHom.hasCoeToFun.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) (Polynomial.C.{u1} R _inst_1) (Polynomial.coeff.{u1} R _inst_1 p (OfNat.ofNat.{0} Nat 0 (OfNat.mk.{0} Nat 0 (Zero.zero.{0} Nat Nat.hasZero))))))
but is expected to have type
  forall {R : Type.{u1}} [_inst_1 : Semiring.{u1} R] {p : Polynomial.{u1} R _inst_1}, Iff (Eq.{succ u1} (Polynomial.{u1} R _inst_1) (Polynomial.divX.{u1} R _inst_1 p) (OfNat.ofNat.{u1} (Polynomial.{u1} R _inst_1) 0 (Zero.toOfNat0.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.zero.{u1} R _inst_1)))) (Eq.{succ u1} (Polynomial.{u1} R _inst_1) p (FunLike.coe.{succ u1, succ u1, succ u1} (RingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) R (fun (_x : R) => (fun (x._@.Mathlib.Algebra.Hom.Group._hyg.2391 : R) => Polynomial.{u1} R _inst_1) _x) (MulHomClass.toFunLike.{u1, u1, u1} (RingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) R (Polynomial.{u1} R _inst_1) (NonUnitalNonAssocSemiring.toMul.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))) (NonUnitalNonAssocSemiring.toMul.{u1} (Polynomial.{u1} R _inst_1) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1)))) (NonUnitalRingHomClass.toMulHomClass.{u1, u1, u1} (RingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) R (Polynomial.{u1} R _inst_1) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) (RingHomClass.toNonUnitalRingHomClass.{u1, u1, u1} (RingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1)) (RingHom.instRingHomClassRingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1)))))) (Polynomial.C.{u1} R _inst_1) (Polynomial.coeff.{u1} R _inst_1 p (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0)))))
Case conversion may be inaccurate. Consider using '#align polynomial.div_X_eq_zero_iff Polynomial.divX_eq_zero_iffₓ'. -/
theorem divX_eq_zero_iff : divX p = 0 ↔ p = C (p.coeff 0) :=
  ⟨fun h => by simpa [eq_comm, h] using div_X_mul_X_add p, fun h => by rw [h, div_X_C]⟩
#align polynomial.div_X_eq_zero_iff Polynomial.divX_eq_zero_iff

#print Polynomial.divX_add /-
theorem divX_add : divX (p + q) = divX p + divX q :=
  ext <| by simp
#align polynomial.div_X_add Polynomial.divX_add
-/

#print Polynomial.degree_divX_lt /-
theorem degree_divX_lt (hp0 : p ≠ 0) : (divX p).degree < p.degree := by
  haveI := nontrivial.of_polynomial_ne hp0 <;>
    calc
      (div_X p).degree < (div_X p * X + C (p.coeff 0)).degree :=
        if h : degree p ≤ 0 then
          by
          have h' : C (p.coeff 0) ≠ 0 := by rwa [← eq_C_of_degree_le_zero h]
          rw [eq_C_of_degree_le_zero h, div_X_C, degree_zero, MulZeroClass.zero_mul, zero_add]
          exact lt_of_le_of_ne bot_le (Ne.symm (mt degree_eq_bot.1 <| by simp [h']))
        else
          by
          have hXp0 : div_X p ≠ 0 := by
            simpa [div_X_eq_zero_iff, -not_le, degree_le_zero_iff] using h
          have : leading_coeff (div_X p) * leading_coeff X ≠ 0 := by simpa
          have : degree (C (p.coeff 0)) < degree (div_X p * X) :=
            calc
              degree (C (p.coeff 0)) ≤ 0 := degree_C_le
              _ < 1 := by decide
              _ = degree (X : R[X]) := degree_X.symm
              _ ≤ degree (div_X p * X) := by
                rw [← zero_add (degree X), degree_mul' this] <;>
                  exact
                    add_le_add
                      (by
                        rw [zero_le_degree_iff, Ne.def, div_X_eq_zero_iff] <;>
                          exact fun h0 => h (h0.symm ▸ degree_C_le))
                      le_rfl

          rw [degree_add_eq_left_of_degree_lt this] <;> exact degree_lt_degree_mul_X hXp0
      _ = p.degree := congr_arg _ (div_X_mul_X_add _)

#align polynomial.degree_div_X_lt Polynomial.degree_divX_lt
-/

/- warning: polynomial.rec_on_horner -> Polynomial.recOnHorner is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} [_inst_1 : Semiring.{u1} R] {M : (Polynomial.{u1} R _inst_1) -> Sort.{u2}} (p : Polynomial.{u1} R _inst_1), (M (OfNat.ofNat.{u1} (Polynomial.{u1} R _inst_1) 0 (OfNat.mk.{u1} (Polynomial.{u1} R _inst_1) 0 (Zero.zero.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.zero.{u1} R _inst_1))))) -> (forall (p : Polynomial.{u1} R _inst_1) (a : R), (Eq.{succ u1} R (Polynomial.coeff.{u1} R _inst_1 p (OfNat.ofNat.{0} Nat 0 (OfNat.mk.{0} Nat 0 (Zero.zero.{0} Nat Nat.hasZero)))) (OfNat.ofNat.{u1} R 0 (OfNat.mk.{u1} R 0 (Zero.zero.{u1} R (MulZeroClass.toHasZero.{u1} R (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)))))))) -> (Ne.{succ u1} R a (OfNat.ofNat.{u1} R 0 (OfNat.mk.{u1} R 0 (Zero.zero.{u1} R (MulZeroClass.toHasZero.{u1} R (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)))))))) -> (M p) -> (M (HAdd.hAdd.{u1, u1, u1} (Polynomial.{u1} R _inst_1) (Polynomial.{u1} R _inst_1) (Polynomial.{u1} R _inst_1) (instHAdd.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.add'.{u1} R _inst_1)) p (coeFn.{succ u1, succ u1} (RingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) (fun (_x : RingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) => R -> (Polynomial.{u1} R _inst_1)) (RingHom.hasCoeToFun.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) (Polynomial.C.{u1} R _inst_1) a)))) -> (forall (p : Polynomial.{u1} R _inst_1), (Ne.{succ u1} (Polynomial.{u1} R _inst_1) p (OfNat.ofNat.{u1} (Polynomial.{u1} R _inst_1) 0 (OfNat.mk.{u1} (Polynomial.{u1} R _inst_1) 0 (Zero.zero.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.zero.{u1} R _inst_1))))) -> (M p) -> (M (HMul.hMul.{u1, u1, u1} (Polynomial.{u1} R _inst_1) (Polynomial.{u1} R _inst_1) (Polynomial.{u1} R _inst_1) (instHMul.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.mul'.{u1} R _inst_1)) p (Polynomial.X.{u1} R _inst_1)))) -> (M p)
but is expected to have type
  forall {R : Type.{u1}} [_inst_1 : Semiring.{u1} R] {M : (Polynomial.{u1} R _inst_1) -> Sort.{u2}} (p : Polynomial.{u1} R _inst_1), (M (OfNat.ofNat.{u1} (Polynomial.{u1} R _inst_1) 0 (Zero.toOfNat0.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.zero.{u1} R _inst_1)))) -> (forall (p : Polynomial.{u1} R _inst_1) (a : R), (Eq.{succ u1} R (Polynomial.coeff.{u1} R _inst_1 p (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0))) (OfNat.ofNat.{u1} R 0 (Zero.toOfNat0.{u1} R (MonoidWithZero.toZero.{u1} R (Semiring.toMonoidWithZero.{u1} R _inst_1))))) -> (Ne.{succ u1} R a (OfNat.ofNat.{u1} R 0 (Zero.toOfNat0.{u1} R (MonoidWithZero.toZero.{u1} R (Semiring.toMonoidWithZero.{u1} R _inst_1))))) -> (M p) -> (M (HAdd.hAdd.{u1, u1, u1} (Polynomial.{u1} R _inst_1) ((fun (x._@.Mathlib.Algebra.Hom.Group._hyg.2391 : R) => Polynomial.{u1} R _inst_1) a) (Polynomial.{u1} R _inst_1) (instHAdd.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.add'.{u1} R _inst_1)) p (FunLike.coe.{succ u1, succ u1, succ u1} (RingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) R (fun (_x : R) => (fun (x._@.Mathlib.Algebra.Hom.Group._hyg.2391 : R) => Polynomial.{u1} R _inst_1) _x) (MulHomClass.toFunLike.{u1, u1, u1} (RingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) R (Polynomial.{u1} R _inst_1) (NonUnitalNonAssocSemiring.toMul.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))) (NonUnitalNonAssocSemiring.toMul.{u1} (Polynomial.{u1} R _inst_1) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1)))) (NonUnitalRingHomClass.toMulHomClass.{u1, u1, u1} (RingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) R (Polynomial.{u1} R _inst_1) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) (RingHomClass.toNonUnitalRingHomClass.{u1, u1, u1} (RingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1)) (RingHom.instRingHomClassRingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1)))))) (Polynomial.C.{u1} R _inst_1) a)))) -> (forall (p : Polynomial.{u1} R _inst_1), (Ne.{succ u1} (Polynomial.{u1} R _inst_1) p (OfNat.ofNat.{u1} (Polynomial.{u1} R _inst_1) 0 (Zero.toOfNat0.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.zero.{u1} R _inst_1)))) -> (M p) -> (M (HMul.hMul.{u1, u1, u1} (Polynomial.{u1} R _inst_1) (Polynomial.{u1} R _inst_1) (Polynomial.{u1} R _inst_1) (instHMul.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.mul'.{u1} R _inst_1)) p (Polynomial.X.{u1} R _inst_1)))) -> (M p)
Case conversion may be inaccurate. Consider using '#align polynomial.rec_on_horner Polynomial.recOnHornerₓ'. -/
/-- An induction principle for polynomials, valued in Sort* instead of Prop. -/
@[elab_as_elim]
noncomputable def recOnHorner {M : R[X] → Sort _} :
    ∀ p : R[X],
      M 0 →
        (∀ p a, coeff p 0 = 0 → a ≠ 0 → M p → M (p + C a)) → (∀ p, p ≠ 0 → M p → M (p * X)) → M p
  | p => fun M0 MC MX =>
    if hp : p = 0 then Eq.recOn hp.symm M0
    else by
      have wf : degree (divX p) < degree p := degree_divX_lt hp
      rw [← div_X_mul_X_add p] at * <;>
        exact
          if hcp0 : coeff p 0 = 0 then by
            rw [hcp0, C_0, add_zero] <;>
              exact
                MX _ (fun h : div_X p = 0 => by simpa [h, hcp0] using hp) (rec_on_horner _ M0 MC MX)
          else
            MC _ _ (coeff_mul_X_zero _) hcp0
              (if hpX0 : div_X p = 0 then
                show M (div_X p * X) by rw [hpX0, MulZeroClass.zero_mul] <;> exact M0
              else MX (div_X p) hpX0 (rec_on_horner _ M0 MC MX))
#align polynomial.rec_on_horner Polynomial.recOnHorner

/- warning: polynomial.degree_pos_induction_on -> Polynomial.degree_pos_induction_on is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} [_inst_1 : Semiring.{u1} R] {P : (Polynomial.{u1} R _inst_1) -> Prop} (p : Polynomial.{u1} R _inst_1), (LT.lt.{0} (WithBot.{0} Nat) (Preorder.toLT.{0} (WithBot.{0} Nat) (WithBot.preorder.{0} Nat (PartialOrder.toPreorder.{0} Nat (OrderedCancelAddCommMonoid.toPartialOrder.{0} Nat (StrictOrderedSemiring.toOrderedCancelAddCommMonoid.{0} Nat Nat.strictOrderedSemiring))))) (OfNat.ofNat.{0} (WithBot.{0} Nat) 0 (OfNat.mk.{0} (WithBot.{0} Nat) 0 (Zero.zero.{0} (WithBot.{0} Nat) (WithBot.hasZero.{0} Nat Nat.hasZero)))) (Polynomial.degree.{u1} R _inst_1 p)) -> (forall {a : R}, (Ne.{succ u1} R a (OfNat.ofNat.{u1} R 0 (OfNat.mk.{u1} R 0 (Zero.zero.{u1} R (MulZeroClass.toHasZero.{u1} R (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)))))))) -> (P (HMul.hMul.{u1, u1, u1} (Polynomial.{u1} R _inst_1) (Polynomial.{u1} R _inst_1) (Polynomial.{u1} R _inst_1) (instHMul.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.mul'.{u1} R _inst_1)) (coeFn.{succ u1, succ u1} (RingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) (fun (_x : RingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) => R -> (Polynomial.{u1} R _inst_1)) (RingHom.hasCoeToFun.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) (Polynomial.C.{u1} R _inst_1) a) (Polynomial.X.{u1} R _inst_1)))) -> (forall {p : Polynomial.{u1} R _inst_1}, (LT.lt.{0} (WithBot.{0} Nat) (Preorder.toLT.{0} (WithBot.{0} Nat) (WithBot.preorder.{0} Nat (PartialOrder.toPreorder.{0} Nat (OrderedCancelAddCommMonoid.toPartialOrder.{0} Nat (StrictOrderedSemiring.toOrderedCancelAddCommMonoid.{0} Nat Nat.strictOrderedSemiring))))) (OfNat.ofNat.{0} (WithBot.{0} Nat) 0 (OfNat.mk.{0} (WithBot.{0} Nat) 0 (Zero.zero.{0} (WithBot.{0} Nat) (WithBot.hasZero.{0} Nat Nat.hasZero)))) (Polynomial.degree.{u1} R _inst_1 p)) -> (P p) -> (P (HMul.hMul.{u1, u1, u1} (Polynomial.{u1} R _inst_1) (Polynomial.{u1} R _inst_1) (Polynomial.{u1} R _inst_1) (instHMul.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.mul'.{u1} R _inst_1)) p (Polynomial.X.{u1} R _inst_1)))) -> (forall {p : Polynomial.{u1} R _inst_1} {a : R}, (LT.lt.{0} (WithBot.{0} Nat) (Preorder.toLT.{0} (WithBot.{0} Nat) (WithBot.preorder.{0} Nat (PartialOrder.toPreorder.{0} Nat (OrderedCancelAddCommMonoid.toPartialOrder.{0} Nat (StrictOrderedSemiring.toOrderedCancelAddCommMonoid.{0} Nat Nat.strictOrderedSemiring))))) (OfNat.ofNat.{0} (WithBot.{0} Nat) 0 (OfNat.mk.{0} (WithBot.{0} Nat) 0 (Zero.zero.{0} (WithBot.{0} Nat) (WithBot.hasZero.{0} Nat Nat.hasZero)))) (Polynomial.degree.{u1} R _inst_1 p)) -> (P p) -> (P (HAdd.hAdd.{u1, u1, u1} (Polynomial.{u1} R _inst_1) (Polynomial.{u1} R _inst_1) (Polynomial.{u1} R _inst_1) (instHAdd.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.add'.{u1} R _inst_1)) p (coeFn.{succ u1, succ u1} (RingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) (fun (_x : RingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) => R -> (Polynomial.{u1} R _inst_1)) (RingHom.hasCoeToFun.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) (Polynomial.C.{u1} R _inst_1) a)))) -> (P p)
but is expected to have type
  forall {R : Type.{u1}} [_inst_1 : Semiring.{u1} R] {P : (Polynomial.{u1} R _inst_1) -> Prop} (p : Polynomial.{u1} R _inst_1), (LT.lt.{0} (WithBot.{0} Nat) (Preorder.toLT.{0} (WithBot.{0} Nat) (WithBot.preorder.{0} Nat (PartialOrder.toPreorder.{0} Nat (StrictOrderedSemiring.toPartialOrder.{0} Nat Nat.strictOrderedSemiring)))) (OfNat.ofNat.{0} (WithBot.{0} Nat) 0 (Zero.toOfNat0.{0} (WithBot.{0} Nat) (WithBot.zero.{0} Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)))) (Polynomial.degree.{u1} R _inst_1 p)) -> (forall {a : R}, (Ne.{succ u1} R a (OfNat.ofNat.{u1} R 0 (Zero.toOfNat0.{u1} R (MonoidWithZero.toZero.{u1} R (Semiring.toMonoidWithZero.{u1} R _inst_1))))) -> (P (HMul.hMul.{u1, u1, u1} ((fun (x._@.Mathlib.Algebra.Hom.Group._hyg.2391 : R) => Polynomial.{u1} R _inst_1) a) (Polynomial.{u1} R _inst_1) (Polynomial.{u1} R _inst_1) (instHMul.{u1} ((fun (x._@.Mathlib.Algebra.Hom.Group._hyg.2391 : R) => Polynomial.{u1} R _inst_1) a) (Polynomial.mul'.{u1} R _inst_1)) (FunLike.coe.{succ u1, succ u1, succ u1} (RingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) R (fun (_x : R) => (fun (x._@.Mathlib.Algebra.Hom.Group._hyg.2391 : R) => Polynomial.{u1} R _inst_1) _x) (MulHomClass.toFunLike.{u1, u1, u1} (RingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) R (Polynomial.{u1} R _inst_1) (NonUnitalNonAssocSemiring.toMul.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))) (NonUnitalNonAssocSemiring.toMul.{u1} (Polynomial.{u1} R _inst_1) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1)))) (NonUnitalRingHomClass.toMulHomClass.{u1, u1, u1} (RingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) R (Polynomial.{u1} R _inst_1) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) (RingHomClass.toNonUnitalRingHomClass.{u1, u1, u1} (RingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1)) (RingHom.instRingHomClassRingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1)))))) (Polynomial.C.{u1} R _inst_1) a) (Polynomial.X.{u1} R _inst_1)))) -> (forall {p : Polynomial.{u1} R _inst_1}, (LT.lt.{0} (WithBot.{0} Nat) (Preorder.toLT.{0} (WithBot.{0} Nat) (WithBot.preorder.{0} Nat (PartialOrder.toPreorder.{0} Nat (StrictOrderedSemiring.toPartialOrder.{0} Nat Nat.strictOrderedSemiring)))) (OfNat.ofNat.{0} (WithBot.{0} Nat) 0 (Zero.toOfNat0.{0} (WithBot.{0} Nat) (WithBot.zero.{0} Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)))) (Polynomial.degree.{u1} R _inst_1 p)) -> (P p) -> (P (HMul.hMul.{u1, u1, u1} (Polynomial.{u1} R _inst_1) (Polynomial.{u1} R _inst_1) (Polynomial.{u1} R _inst_1) (instHMul.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.mul'.{u1} R _inst_1)) p (Polynomial.X.{u1} R _inst_1)))) -> (forall {p : Polynomial.{u1} R _inst_1} {a : R}, (LT.lt.{0} (WithBot.{0} Nat) (Preorder.toLT.{0} (WithBot.{0} Nat) (WithBot.preorder.{0} Nat (PartialOrder.toPreorder.{0} Nat (StrictOrderedSemiring.toPartialOrder.{0} Nat Nat.strictOrderedSemiring)))) (OfNat.ofNat.{0} (WithBot.{0} Nat) 0 (Zero.toOfNat0.{0} (WithBot.{0} Nat) (WithBot.zero.{0} Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)))) (Polynomial.degree.{u1} R _inst_1 p)) -> (P p) -> (P (HAdd.hAdd.{u1, u1, u1} (Polynomial.{u1} R _inst_1) ((fun (x._@.Mathlib.Algebra.Hom.Group._hyg.2391 : R) => Polynomial.{u1} R _inst_1) a) (Polynomial.{u1} R _inst_1) (instHAdd.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.add'.{u1} R _inst_1)) p (FunLike.coe.{succ u1, succ u1, succ u1} (RingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) R (fun (_x : R) => (fun (x._@.Mathlib.Algebra.Hom.Group._hyg.2391 : R) => Polynomial.{u1} R _inst_1) _x) (MulHomClass.toFunLike.{u1, u1, u1} (RingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) R (Polynomial.{u1} R _inst_1) (NonUnitalNonAssocSemiring.toMul.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))) (NonUnitalNonAssocSemiring.toMul.{u1} (Polynomial.{u1} R _inst_1) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1)))) (NonUnitalRingHomClass.toMulHomClass.{u1, u1, u1} (RingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) R (Polynomial.{u1} R _inst_1) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) (RingHomClass.toNonUnitalRingHomClass.{u1, u1, u1} (RingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1)) (RingHom.instRingHomClassRingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1)))))) (Polynomial.C.{u1} R _inst_1) a)))) -> (P p)
Case conversion may be inaccurate. Consider using '#align polynomial.degree_pos_induction_on Polynomial.degree_pos_induction_onₓ'. -/
/-- A property holds for all polynomials of positive `degree` with coefficients in a semiring `R`
if it holds for
* `a * X`, with `a ∈ R`,
* `p * X`, with `p ∈ R[X]`,
* `p + a`, with `a ∈ R`, `p ∈ R[X]`,
with appropriate restrictions on each term.

See `nat_degree_ne_zero_induction_on` for a similar statement involving no explicit multiplication.
 -/
@[elab_as_elim]
theorem degree_pos_induction_on {P : R[X] → Prop} (p : R[X]) (h0 : 0 < degree p)
    (hC : ∀ {a}, a ≠ 0 → P (C a * X)) (hX : ∀ {p}, 0 < degree p → P p → P (p * X))
    (hadd : ∀ {p} {a}, 0 < degree p → P p → P (p + C a)) : P p :=
  recOnHorner p (fun h => by rw [degree_zero] at h <;> exact absurd h (by decide))
    (fun p a _ _ ih h0 =>
      have : 0 < degree p :=
        lt_of_not_ge fun h =>
          not_lt_of_ge degree_C_le <| by rwa [eq_C_of_degree_le_zero h, ← C_add] at h0
      hadd this (ih this))
    (fun p _ ih h0' =>
      if h0 : 0 < degree p then hX h0 (ih h0)
      else by
        rw [eq_C_of_degree_le_zero (le_of_not_gt h0)] at * <;>
          exact hC fun h : coeff p 0 = 0 => by simpa [h, Nat.not_lt_zero] using h0')
    h0
#align polynomial.degree_pos_induction_on Polynomial.degree_pos_induction_on

/- warning: polynomial.nat_degree_ne_zero_induction_on -> Polynomial.natDegree_ne_zero_induction_on is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} [_inst_1 : Semiring.{u1} R] {M : (Polynomial.{u1} R _inst_1) -> Prop} {f : Polynomial.{u1} R _inst_1}, (Ne.{1} Nat (Polynomial.natDegree.{u1} R _inst_1 f) (OfNat.ofNat.{0} Nat 0 (OfNat.mk.{0} Nat 0 (Zero.zero.{0} Nat Nat.hasZero)))) -> (forall {a : R} {p : Polynomial.{u1} R _inst_1}, (M p) -> (M (HAdd.hAdd.{u1, u1, u1} (Polynomial.{u1} R _inst_1) (Polynomial.{u1} R _inst_1) (Polynomial.{u1} R _inst_1) (instHAdd.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.add'.{u1} R _inst_1)) (coeFn.{succ u1, succ u1} (RingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) (fun (_x : RingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) => R -> (Polynomial.{u1} R _inst_1)) (RingHom.hasCoeToFun.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) (Polynomial.C.{u1} R _inst_1) a) p))) -> (forall {p : Polynomial.{u1} R _inst_1} {q : Polynomial.{u1} R _inst_1}, (M p) -> (M q) -> (M (HAdd.hAdd.{u1, u1, u1} (Polynomial.{u1} R _inst_1) (Polynomial.{u1} R _inst_1) (Polynomial.{u1} R _inst_1) (instHAdd.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.add'.{u1} R _inst_1)) p q))) -> (forall {n : Nat} {a : R}, (Ne.{succ u1} R a (OfNat.ofNat.{u1} R 0 (OfNat.mk.{u1} R 0 (Zero.zero.{u1} R (MulZeroClass.toHasZero.{u1} R (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)))))))) -> (Ne.{1} Nat n (OfNat.ofNat.{0} Nat 0 (OfNat.mk.{0} Nat 0 (Zero.zero.{0} Nat Nat.hasZero)))) -> (M (coeFn.{succ u1, succ u1} (LinearMap.{u1, u1, u1, u1} R R _inst_1 _inst_1 (RingHom.id.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)) R (Polynomial.{u1} R _inst_1) (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))) (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} (Polynomial.{u1} R _inst_1) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1)))) (Semiring.toModule.{u1} R _inst_1) (Polynomial.module.{u1, u1} R _inst_1 R _inst_1 (Semiring.toModule.{u1} R _inst_1))) (fun (_x : LinearMap.{u1, u1, u1, u1} R R _inst_1 _inst_1 (RingHom.id.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)) R (Polynomial.{u1} R _inst_1) (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))) (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} (Polynomial.{u1} R _inst_1) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1)))) (Semiring.toModule.{u1} R _inst_1) (Polynomial.module.{u1, u1} R _inst_1 R _inst_1 (Semiring.toModule.{u1} R _inst_1))) => R -> (Polynomial.{u1} R _inst_1)) (LinearMap.hasCoeToFun.{u1, u1, u1, u1} R R R (Polynomial.{u1} R _inst_1) _inst_1 _inst_1 (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))) (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} (Polynomial.{u1} R _inst_1) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1)))) (Semiring.toModule.{u1} R _inst_1) (Polynomial.module.{u1, u1} R _inst_1 R _inst_1 (Semiring.toModule.{u1} R _inst_1)) (RingHom.id.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))) (Polynomial.monomial.{u1} R _inst_1 n) a))) -> (M f)
but is expected to have type
  forall {R : Type.{u1}} [_inst_1 : Semiring.{u1} R] {M : (Polynomial.{u1} R _inst_1) -> Prop} {f : Polynomial.{u1} R _inst_1}, (Ne.{1} Nat (Polynomial.natDegree.{u1} R _inst_1 f) (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0))) -> (forall {a : R} {p : Polynomial.{u1} R _inst_1}, (M p) -> (M (HAdd.hAdd.{u1, u1, u1} ((fun (x._@.Mathlib.Algebra.Hom.Group._hyg.2391 : R) => Polynomial.{u1} R _inst_1) a) (Polynomial.{u1} R _inst_1) (Polynomial.{u1} R _inst_1) (instHAdd.{u1} ((fun (x._@.Mathlib.Algebra.Hom.Group._hyg.2391 : R) => Polynomial.{u1} R _inst_1) a) (Polynomial.add'.{u1} R _inst_1)) (FunLike.coe.{succ u1, succ u1, succ u1} (RingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) R (fun (_x : R) => (fun (x._@.Mathlib.Algebra.Hom.Group._hyg.2391 : R) => Polynomial.{u1} R _inst_1) _x) (MulHomClass.toFunLike.{u1, u1, u1} (RingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) R (Polynomial.{u1} R _inst_1) (NonUnitalNonAssocSemiring.toMul.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))) (NonUnitalNonAssocSemiring.toMul.{u1} (Polynomial.{u1} R _inst_1) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1)))) (NonUnitalRingHomClass.toMulHomClass.{u1, u1, u1} (RingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) R (Polynomial.{u1} R _inst_1) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) (RingHomClass.toNonUnitalRingHomClass.{u1, u1, u1} (RingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1)) (RingHom.instRingHomClassRingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1)))))) (Polynomial.C.{u1} R _inst_1) a) p))) -> (forall {p : Polynomial.{u1} R _inst_1} {q : Polynomial.{u1} R _inst_1}, (M p) -> (M q) -> (M (HAdd.hAdd.{u1, u1, u1} (Polynomial.{u1} R _inst_1) (Polynomial.{u1} R _inst_1) (Polynomial.{u1} R _inst_1) (instHAdd.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.add'.{u1} R _inst_1)) p q))) -> (forall {n : Nat} {a : R}, (Ne.{succ u1} R a (OfNat.ofNat.{u1} R 0 (Zero.toOfNat0.{u1} R (MonoidWithZero.toZero.{u1} R (Semiring.toMonoidWithZero.{u1} R _inst_1))))) -> (Ne.{1} Nat n (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0))) -> (M (FunLike.coe.{succ u1, succ u1, succ u1} (LinearMap.{u1, u1, u1, u1} R R _inst_1 _inst_1 (RingHom.id.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)) R (Polynomial.{u1} R _inst_1) (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))) (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} (Polynomial.{u1} R _inst_1) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1)))) (Semiring.toModule.{u1} R _inst_1) (Polynomial.module.{u1, u1} R _inst_1 R _inst_1 (Semiring.toModule.{u1} R _inst_1))) R (fun (_x : R) => (fun (x._@.Mathlib.Algebra.Module.LinearMap._hyg.6190 : R) => Polynomial.{u1} R _inst_1) _x) (LinearMap.instFunLikeLinearMap.{u1, u1, u1, u1} R R R (Polynomial.{u1} R _inst_1) _inst_1 _inst_1 (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))) (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} (Polynomial.{u1} R _inst_1) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1)))) (Semiring.toModule.{u1} R _inst_1) (Polynomial.module.{u1, u1} R _inst_1 R _inst_1 (Semiring.toModule.{u1} R _inst_1)) (RingHom.id.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))) (Polynomial.monomial.{u1} R _inst_1 n) a))) -> (M f)
Case conversion may be inaccurate. Consider using '#align polynomial.nat_degree_ne_zero_induction_on Polynomial.natDegree_ne_zero_induction_onₓ'. -/
/-- A property holds for all polynomials of non-zero `nat_degree` with coefficients in a
semiring `R` if it holds for
* `p + a`, with `a ∈ R`, `p ∈ R[X]`,
* `p + q`, with `p, q ∈ R[X]`,
* monomials with nonzero coefficient and non-zero exponent,
with appropriate restrictions on each term.
Note that multiplication is "hidden" in the assumption on monomials, so there is no explicit
multiplication in the statement.
See `degree_pos_induction_on` for a similar statement involving more explicit multiplications.
 -/
@[elab_as_elim]
theorem natDegree_ne_zero_induction_on {M : R[X] → Prop} {f : R[X]} (f0 : f.natDegree ≠ 0)
    (h_C_add : ∀ {a p}, M p → M (C a + p)) (h_add : ∀ {p q}, M p → M q → M (p + q))
    (h_monomial : ∀ {n : ℕ} {a : R}, a ≠ 0 → n ≠ 0 → M (monomial n a)) : M f :=
  by
  suffices f.natDegree = 0 ∨ M f from Or.dcases_on this (fun h => (f0 h).elim) id
  apply f.induction_on
  · exact fun a => Or.inl (nat_degree_C _)
  · rintro p q (hp | hp) (hq | hq)
    · refine' Or.inl _
      rw [eq_C_of_nat_degree_eq_zero hp, eq_C_of_nat_degree_eq_zero hq, ← C_add, nat_degree_C]
    · refine' Or.inr _
      rw [eq_C_of_nat_degree_eq_zero hp]
      exact h_C_add hq
    · refine' Or.inr _
      rw [eq_C_of_nat_degree_eq_zero hq, add_comm]
      exact h_C_add hp
    · exact Or.inr (h_add hp hq)
  · intro n a hi
    by_cases a0 : a = 0
    · exact Or.inl (by rw [a0, C_0, MulZeroClass.zero_mul, nat_degree_zero])
    · refine' Or.inr _
      rw [C_mul_X_pow_eq_monomial]
      exact h_monomial a0 n.succ_ne_zero
#align polynomial.nat_degree_ne_zero_induction_on Polynomial.natDegree_ne_zero_induction_on

end Semiring

end Polynomial


/-
Copyright (c) 2019 Seul Baek. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Seul Baek
-/

/-
Miscellaneous.
-/

import tactic.localized

variables {α β γ : Type}

namespace omega

lemma fun_mono_2 {p : α → β → γ} {a1 a2 : α} {b1 b2 : β} :
  a1 = a2 → b1 = b2 → (p a1 b1 = p a2 b2) :=
λ h1 h2, by rw [h1, h2]

lemma pred_mono_2 {p : α → β → Prop} {a1 a2 : α} {b1 b2 : β} :
  a1 = a2 → b1 = b2 → (p a1 b1 ↔ p a2 b2) :=
λ h1 h2, by rw [h1, h2]

lemma pred_mono_2' {c : Prop → Prop → Prop} {a1 a2 b1 b2 : Prop} :
  (a1 ↔ a2) → (b1 ↔ b2) → (c a1 b1 ↔ c a2 b2) :=
λ h1 h2, by rw [h1, h2]

/-- Update variable assignment for a specific variable
    and leave everything else unchanged -/
def update (m : nat) (a : α) (v : nat → α) : nat → α
| n := if n = m then a else v n

localized "notation v ` ⟨` m ` ↦ ` a `⟩` := omega.update m a v" in omega

lemma update_eq (m : nat) (a : α) (v : nat → α) : (v ⟨m ↦ a⟩) m = a :=
by simp only [update, if_pos rfl]

lemma update_eq_of_ne {m : nat} {a : α} {v : nat → α} (k : nat) :
  k ≠ m → update m a v k = v k :=
by {intro h1, unfold update, rw if_neg h1}

/-- Assign a new value to the zeroth variable, and push all
    other assignments up by 1 -/
def update_zero (a : α) (v : nat → α) : nat → α
| 0     := a
| (k+1) := v k

open tactic

/-- Intro with a fresh name -/
meta def intro_fresh : tactic unit :=
do n ← mk_fresh_name,
   intro n,
   skip

/-- Revert an expr if it passes the given test -/
meta def revert_cond (t : expr → tactic unit) (x : expr) : tactic unit :=
(t x >> revert x >> skip) <|> skip

/-- Revert all exprs in the context that pass the given test -/
meta def revert_cond_all (t : expr → tactic unit) : tactic unit :=
do hs ← local_context, mmap (revert_cond t) hs, skip

/-- Try applying a tactic to each of the element in a list
    until success, and return the first successful result -/
meta def app_first {α β : Type} (t : α → tactic β) : list α → tactic β
| [] := failed
| (a :: as) := t a <|> app_first as

end omega


/-
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

! This file was ported from Lean 3 source module data.finset.preimage
! leanprover-community/mathlib commit 2445c98ae4b87eabebdde552593519b9b6dc350c
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Set.Finite
import Mathlib.Algebra.BigOperators.Basic

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

open Set Function

open BigOperators

universe u v w x

variable {α : 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.InjOn f (f ⁻¹' ↑s)) : Finset α :=
  (s.finite_toSet.preimage hf).toFinset
#align finset.preimage Finset.preimage

@[simp]
theorem mem_preimage {f : α → β} {s : Finset β} {hf : Set.InjOn f (f ⁻¹' ↑s)} {x : α} :
    x ∈ preimage s f hf ↔ f x ∈ s :=
  Set.Finite.mem_toFinset _
#align finset.mem_preimage Finset.mem_preimage

@[simp, norm_cast]
theorem coe_preimage {f : α → β} (s : Finset β) (hf : Set.InjOn f (f ⁻¹' ↑s)) :
    (↑(preimage s f hf) : Set α) = f ⁻¹' ↑s :=
  Set.Finite.coe_toFinset _
#align finset.coe_preimage Finset.coe_preimage

@[simp]
theorem preimage_empty {f : α → β} : preimage ∅ f (by simp [InjOn]) = ∅ :=
  Finset.coe_injective (by simp)
#align finset.preimage_empty Finset.preimage_empty

@[simp]
theorem preimage_univ {f : α → β} [Fintype α] [Fintype β] (hf) : preimage univ f hf = univ :=
  Finset.coe_injective (by simp)
#align finset.preimage_univ Finset.preimage_univ

@[simp]
theorem preimage_inter [DecidableEq α] [DecidableEq β] {f : α → β} {s t : Finset β}
    (hs : Set.InjOn f (f ⁻¹' ↑s)) (ht : Set.InjOn f (f ⁻¹' ↑t)) :
    (preimage (s ∩ t) f fun 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)
#align finset.preimage_inter Finset.preimage_inter

@[simp]
theorem preimage_union [DecidableEq α] [DecidableEq β] {f : α → β} {s t : Finset β} (hst) :
    preimage (s ∪ t) f hst =
      (preimage s f fun x₁ hx₁ x₂ hx₂ => hst (mem_union_left _ hx₁) (mem_union_left _ hx₂)) ∪
        preimage t f fun x₁ hx₁ x₂ hx₂ => hst (mem_union_right _ hx₁) (mem_union_right _ hx₂) :=
  Finset.coe_injective (by simp)
#align finset.preimage_union Finset.preimage_union

@[simp, nolint simpNF] -- Porting note: linter complains that LHS doesn't simplify
theorem preimage_compl [DecidableEq α] [DecidableEq β] [Fintype α] [Fintype β] {f : α → β}
    (s : Finset β) (hf : Function.Injective f) :
    preimage (sᶜ) f (hf.injOn _) = preimage s f (hf.injOn _)ᶜ :=
  Finset.coe_injective (by simp)
#align finset.preimage_compl Finset.preimage_compl

theorem image_subset_iff_subset_preimage [DecidableEq β] {f : α → β} {s : Finset α} {t : Finset β}
    (hf : Set.InjOn f (f ⁻¹' ↑t)) : s.image f ⊆ t ↔ s ⊆ t.preimage f hf :=
  image_subset_iff.trans <| by simp only [subset_iff, mem_preimage]
#align finset.image_subset_iff_subset_preimage Finset.image_subset_iff_subset_preimage

theorem map_subset_iff_subset_preimage {f : α ↪ β} {s : Finset α} {t : Finset β} :
    s.map f ⊆ t ↔ s ⊆ t.preimage f (f.injective.injOn _) := by
  classical rw [map_eq_image, image_subset_iff_subset_preimage]
#align finset.map_subset_iff_subset_preimage Finset.map_subset_iff_subset_preimage

theorem image_preimage [DecidableEq β] (f : α → β) (s : Finset β) [∀ x, Decidable (x ∈ Set.range f)]
    (hf : Set.InjOn f (f ⁻¹' ↑s)) : image f (preimage s f hf) = s.filter fun 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]; rfl
#align finset.image_preimage Finset.image_preimage

theorem image_preimage_of_bij [DecidableEq β] (f : α → β) (s : Finset β)
    (hf : Set.BijOn f (f ⁻¹' ↑s) ↑s) : image f (preimage s f hf.injOn) = s :=
  Finset.coe_inj.1 <| by simpa using hf.image_eq
#align finset.image_preimage_of_bij Finset.image_preimage_of_bij

theorem preimage_subset {f : α ↪ β} {s : Finset β} {t : Finset α} (hs : s ⊆ t.map f) :
    s.preimage f (f.injective.injOn _) ⊆ t := fun _ h => (mem_map' f).1 (hs (mem_preimage.1 h))
#align finset.preimage_subset Finset.preimage_subset

theorem subset_map_iff {f : α ↪ β} {s : Finset β} {t : Finset α} :
    s ⊆ t.map f ↔ ∃ (u : _)(_ : u ⊆ t), s = u.map f := by
  classical
    refine' ⟨fun h => ⟨_, preimage_subset h, _⟩, _⟩
    · rw [map_eq_image, image_preimage, filter_true_of_mem]
      exact fun x hx ↦ coe_map_subset_range _ _ (h hx)
    · rintro ⟨u, hut, rfl⟩
      exact map_subset_map.2 hut
#align finset.subset_map_iff Finset.subset_map_iff

theorem sigma_preimage_mk {β : α → Type _} [DecidableEq α] (s : Finset (Σa, β a)) (t : Finset α) :
    (t.sigma fun a => s.preimage (Sigma.mk a) <| sigma_mk_injective.injOn _) =
      s.filter fun a => a.1 ∈ t := by
  ext x
  simp [and_comm]
#align finset.sigma_preimage_mk Finset.sigma_preimage_mk

theorem sigma_preimage_mk_of_subset {β : α → Type _} [DecidableEq α] (s : Finset (Σa, β a))
    {t : Finset α} (ht : s.image Sigma.fst ⊆ t) :
    (t.sigma fun a => s.preimage (Sigma.mk a) <| sigma_mk_injective.injOn _) = s := by
  rw [sigma_preimage_mk, filter_true_of_mem <| image_subset_iff.1 ht]
#align finset.sigma_preimage_mk_of_subset Finset.sigma_preimage_mk_of_subset

theorem sigma_image_fst_preimage_mk {β : α → Type _} [DecidableEq α] (s : Finset (Σa, β a)) :
    ((s.image Sigma.fst).sigma fun a => s.preimage (Sigma.mk a) <| sigma_mk_injective.injOn _) =
      s :=
  s.sigma_preimage_mk_of_subset (Subset.refl _)
#align finset.sigma_image_fst_preimage_mk Finset.sigma_image_fst_preimage_mk

end Preimage

@[to_additive]
theorem prod_preimage' [CommMonoid β] (f : α → γ) [DecidablePred fun x => x ∈ Set.range f]
    (s : Finset γ) (hf : Set.InjOn f (f ⁻¹' ↑s)) (g : γ → β) :
    (∏ x in s.preimage f hf, g (f x)) = ∏ x in s.filter fun x => x ∈ Set.range f, g x := by
  haveI := Classical.decEq γ
  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, InjOn] using hf
    _ = ∏ x in s.filter fun x => x ∈ Set.range f, g x := by rw [image_preimage]

#align finset.prod_preimage' Finset.prod_preimage'
#align finset.sum_preimage' Finset.sum_preimage'

@[to_additive]
theorem prod_preimage [CommMonoid β] (f : α → γ) (s : Finset γ) (hf : Set.InjOn f (f ⁻¹' ↑s))
    (g : γ → β) (hg : ∀ x ∈ s, x ∉ Set.range f → g x = 1) :
    (∏ x in s.preimage f hf, g (f x)) = ∏ x in s, g x := by
  classical
    rw [prod_preimage', prod_filter_of_ne]
    exact fun x hx => Not.imp_symm (hg x hx)
#align finset.prod_preimage Finset.prod_preimage
#align finset.sum_preimage Finset.sum_preimage

@[to_additive]
theorem prod_preimage_of_bij [CommMonoid β] (f : α → γ) (s : Finset γ)
    (hf : Set.BijOn f (f ⁻¹' ↑s) ↑s) (g : γ → β) :
    (∏ x in s.preimage f hf.injOn, g (f x)) = ∏ x in s, g x :=
  prod_preimage _ _ hf.injOn g fun _ hs h_f => (h_f <| hf.subset_range hs).elim
#align finset.prod_preimage_of_bij Finset.prod_preimage_of_bij
#align finset.sum_preimage_of_bij Finset.sum_preimage_of_bij

end Finset


import data.matrix.notation
import tactic.suggest
set_option trace.simplify.rewrite true

namespace and_intro_example
-- {a b : Prop} : implicit arguments
-- (a b : Prop) : explicit arguments
theorem swap_conj₁ {a b : Prop} (h : a ∧ b) : b ∧ a := ⟨h.right, h.left⟩
theorem swap_conj₂ {a b : Prop} (h : a ∧ b) : b ∧ a := and.intro h.right h.left
#print notation ∘

constants a b : Prop
constants (h : a ∧ b)
-- #check ⟨h.left, h.right⟩ -- invalid constructor ⟨...⟩, expected type must be known
#check and.intro h.left h.right -- ⟨h.left, h.right⟩ : a ∧ b
#check and.intro h.right h.left -- ⟨h.right, h.left⟩ : b ∧ a
end and_intro_example

def even (k : nat) : bool := k % 2 = 0

lemma even.zero : even 0 := sorry
lemma even.add_two : ∀ k : nat, even k → even (k + 2) := sorry
lemma even.next_not_even : ∀ k : nat, even k → ¬ even (k + 1) := sorry

lemma seven_is_not_even: ¬ even 7 :=
begin
  -- automatic bakward proof
  try { apply even.next_not_even }, -- ⊢ ↥(even 6)
  repeat { apply even.add_two }, -- ⊢ ↥(even 0)
  exact even.zero, -- goals accomplished
end

lemma seven_is_not_even₂: ¬ even 7 :=
begin
  -- automatic forward proof
  simp only [even.zero, even.add_two, even.next_not_even, not_false_iff],
  -- [even.zero]: ↥(even 0) ==> true
  -- [even.next_not_even]: ↥(even 1) ==> false
  -- [even.zero]: ↥(even 0) ==> true
  -- [even.add_two]: ↥(even 2) ==> true
  -- [even.next_not_even]: ↥(even 3) ==> false
  -- [even.zero]: ↥(even 0) ==> true
  -- [even.next_not_even]: ↥(even 1) ==> false
  -- [even.zero]: ↥(even 0) ==> true
  -- [even.add_two]: ↥(even 2) ==> true
  -- [even.add_two]: ↥(even 4) ==> true
  -- [even.next_not_even]: ↥(even 5) ==> false
  -- [even.zero]: ↥(even 0) ==> true
  -- [even.next_not_even]: ↥(even 1) ==> false
  -- [even.zero]: ↥(even 0) ==> true
  -- [even.add_two]: ↥(even 2) ==> true
  -- [even.next_not_even]: ↥(even 3) ==> false
  -- [even.zero]: ↥(even 0) ==> true
  -- [even.next_not_even]: ↥(even 1) ==> false
  -- [even.zero]: ↥(even 0) ==> true
  -- [even.add_two]: ↥(even 2) ==> true
  -- [even.add_two]: ↥(even 4) ==> true
  -- [even.add_two]: ↥(even 6) ==> true
  -- [even.next_not_even]: ↥(even 7) ==> false
  -- [not_false_iff]: ¬false ==> true
end

lemma repeat_example :
  even 4 ∧ even 7 ∧ even 3 ∧ even 0 :=
begin
  repeat { apply and.intro },
  repeat { apply even.add_two },
  -- 4 goals ⊢ ↥(even 0) ⊢ ↥(even 1) ⊢ ↥(even 1) ⊢ ↥(even 0)
  any_goals { apply even.zero },
  all_goals { sorry, },
end

lemma repeat_orelse_example :
  even 4 ∧ even 7 ∧ even 3 ∧ even 0 :=
begin
  repeat { apply and.intro },
  repeat {
    apply even.add_two <|> apply even.zero,
  },
  -- 2 goals ⊢ ↥(even 1) ⊢ ↥(even 1)
  all_goals { sorry, },
end

lemma iterate_orelse_example :
  even 4 ∧ even 7 ∧ even 3 ∧ even 0 :=
begin
  repeat { apply and.intro },
  iterate {
    apply even.add_two <|> apply even.zero,
  },
  -- 3 goals ⊢ ↥(even 1) ⊢ ↥(even 3) ⊢ ↥(even 0)
  all_goals { sorry, },
end

-- ...

lemma repeat_not_example :
  ¬ even 1 :=
begin
  apply not.intro, -- <=> do nothing
  apply not.intro,
  apply not.intro,
  apply not.intro,
  -- ...
  sorry,
end

-- tactic intro_and_even

-- meta def intro_and_even : tactic unit :=
-- do
--   tactic.repeat (tactic.applyc ``and.intro),
--   tactic.any_goals (tactic.solve1 (tactic.repeat
--     (tactic.applyc ``even.add_two <|> tactic.applyc ``even.zero)))

-- term
--   λ (_x : unit),
--     ((tactic.applyc (name.mk_string "add_two" (name.mk_string "even" name.anonymous))) <|>
--        (tactic.applyc (name.mk_string "zero" (name.mk_string "even" name.anonymous)))).repeat.solve1.any_goals
-- has type
--   unit → tactic (list (option unit))
-- but is expected to have type
--   unit → tactic unit

meta def hello : tactic unit :=
do
  tactic.trace ("Hello, " ++ "tactic")

meta def trace_goals : tactic unit :=
do
  tactic.trace "local context:",
  ctx ← tactic.local_context,
  tactic.trace ctx,
  tactic.trace "\ntarget:",
  P ← tactic.target,
  tactic.trace P,
  tactic.trace "\nall missing proofs:",
  Hs ← tactic.get_goals,
  tactic.trace Hs,
  τs ← list.mmap tactic.infer_type Hs,
  tactic.trace τs

/- Types of metafunctions:
  tactic.trace : α → tactic unit
  tactic.local_context : tactic (list expr)
  tactic.target : tactic expr
  tactic.get_goals : tactic (list expr)
  tactic.infer_type : expr → tactic expr
  list.mmap {α β : Type} : (α → m β) → list α → m (list β)
-/

-- tactic.assumption

lemma even_14 :
  even 14 :=
begin
  hello,
  have hfirst := even.zero,
  -- have hsecond := even.add_two 0 hfirst,
  trace_goals,
  -- simp at hsecond, -- [zero_add]: 0 + 2 ==> 2
  assumption,
end

-- Expressions

run_cmd do
  let e : expr := `(list.map (λn : ℕ, n + 1) [1, 2, 3]),
  tactic.trace e -- list.map (λ (n : ℕ), n + 1) [1, 2, 3]

run_cmd do
  let e1 : pexpr := ``(list.map (λn, n + 1) [1, 2, 3]),
  let e2 : pexpr := ``(list.map _ [1, 2, 3]),
  tactic.trace e1,
  tactic.trace e2

run_cmd tactic.trace `and.intro
run_cmd tactic.trace `intro_and_even
run_cmd tactic.trace `seattle.washington

run_cmd tactic.trace ``and.intro
run_cmd tactic.trace ``intro_and_even
-- run_cmd tactic.trace ``seattle.washington -- fails

-- get number of declarations
run_cmd do
  env ← tactic.get_env,
  tactic.trace (environment.fold env 0 (λdecl n, n + 1))

meta def destruct_and_helper : expr → tactic unit
| h :=
  do
    t ← tactic.infer_type h,
    tactic.trace t,
    match t with
    | `(%%a ∧ %%b) :=
      tactic.exact h
      <|>
      do {
        tactic.trace "go_left",
        ha ← tactic.to_expr ``(and.elim_left %%h),
        destruct_and_helper ha
      } <|>
      do {
        tactic.trace "go_right",
        hb ← tactic.to_expr ``(and.elim_right %%h),
        destruct_and_helper hb
      }
    | _     := do {
      tactic.exact h,
      tactic.trace "Solved with: ", -- trace must be after applying tactic.exact
      tactic.trace t
    }
    end

meta def destruct_and (_name : name) : tactic unit :=
do
  h ← tactic.get_local _name,
  destruct_and_helper h

example (a b c : Prop) (h : a ∧ (b ∨ c)) : b ∨ c :=
begin
  destruct_and `h,
end

lemma abc_c (a b c : Prop) (h : a ∧ b ∧ c) : c :=
begin
  trace_goals,
  trace_state,
  destruct_and `h, -- Unfortunately, we need to quote the name of the hypothesis with a backtick...
end

#print abc_c

namespace my

constant f : ℕ → Prop
axiom f.zero : f 0 ↔ true
axiom f.step (n) : (f n ∧ ¬ f n.succ ∧ f n.succ.succ) ∨ (f n ∧ f n.succ ∧ ¬ f n.succ.succ)

-- axiom f.one_eq_two : f 1 ↔ f 2

axiom prop.A (a : Prop) : (a ↔ true) ∨ (a ↔ false)

axiom not.A : ¬ true ↔ false
axiom not.B : ¬ false ↔ true
lemma not.C (a : Prop) : ¬ ¬ a ↔ a := by {
  have h : (a ↔ true) ∨ (a ↔ false) := prop.A a,
  cases h; rw h,
  { rw [not.A, not.B] },
  { rw [not.B, not.A] },
}
lemma not.B' : ¬ false ↔ true := by {
  -- apply @eq.to_iff (¬ false) true,
  have h : ¬ ¬ true ↔ ¬ false,
    apply eq.to_iff,
    apply congr_arg, -- refine congr rfl _,
    exact not.A.to_eq, -- exact propext not.A, -- ← library_search [not.A],
  rw ←h,
  exact not.C true,
}

axiom or.A (a : Prop) : a ∨ true ↔ true
axiom or.B (a : Prop) : a ∨ false ↔ a
axiom or.C (a b : Prop) : a ∨ b ↔ b ∨ a

axiom and.A (a : Prop) : a ∧ true ↔ a
axiom and.B (a : Prop) : a ∧ false ↔ false
axiom and.C (a b : Prop) : a ∧ b ↔ b ∧ a
lemma and.S (a : Prop) : a ∧ a ↔ a := by { cases prop.A a; rw h, {rw and.A}, {rw and.B} } -- rw [and.A, and.B], -- not works
lemma and.contra (a : Prop) : a ∧ ¬a ↔ false := by {
  cases prop.A a; rw h,
  repeat { rw and.A <|> rw and.B <|> rw or.A <|> rw or.B <|>
     rw imp.S <|> rw imp.T <|> rw imp.F <|> rw not.A <|> rw not.B <|> trivial },
}

lemma iff.A : (true ↔ false) ↔ false := true_iff false
lemma iff.C (a b : Prop) : (a ↔ b) ↔ (b ↔ a) := iff.comm
lemma iff.S (a : Prop) : (a ↔ a) ↔ true := iff_self a
lemma iff.T (a : Prop) : (a ↔ true) ↔ a := sorry
lemma iff.F (a : Prop) : (a ↔ false) ↔ ¬ a := sorry

lemma iff.not_self (a : Prop) : (a ↔ ¬ a) ↔ false := by {
  cases prop.A a; rw h,
  { rw [ not.A, iff.A ], },
  { rw [ not.B, iff.C false, iff.A ], },
}

lemma imp.F (a : Prop) : (false → a) ↔ true := false_implies_iff a
lemma imp.T (a : Prop) : (true → a) ↔ a := true_implies_iff a
lemma imp.S (a : Prop) : (a → a) ↔ true := by {
  cases prop.A a; rw h,
  { rw imp.T, },
  { rw imp.F, },
}

lemma or.D (a b : Prop) : a ∨ b ↔ ¬ (¬ a ∧ ¬ b) := by {
  cases (prop.A a); rw [h, or.C, and.C], {
    rw [ or.A, not.A, and.B, not.B ],
  }, {
    -- simp only [or.C, or.A, or.B, and.C, and.B, and.A, not.A, not.B, prop.A, not.C],
    -- without or.C and.C:
    -- [false_or]: false ∨ b ==> b
    -- [my.not.B]: ¬false ==> true
    -- [true_and]: true ∧ ¬b ==> ¬b
    -- [my.not.C]: ¬¬b ==> b
    -- [iff_self]: b ↔ b ==> true
    -- with or.C and.C:
    -- [my.or.B]: b ∨ false ==> b
    -- [my.not.B]: ¬false ==> true
    -- [my.and.A]: ¬b ∧ true ==> ¬b
    -- [my.not.C]: ¬¬b ==> b
    rw [ or.B, not.B, and.A, not.C ],
  },
}

lemma iff.apply_not (a b : Prop) : (a ↔ b) ↔ (¬ a ↔ ¬ b) := by {
  cases prop.A a; rw h,
  {
    cases prop.A b; rw h_1,
      { rw [ iff.S, iff.S ] },
      { rw [ iff.A, not.A, iff.not_self ] },
  },
  {
    cases prop.A b; rw h_1,
      { rw [ iff.C false, iff.A, not.B, iff.not_self ] },
      { rw [ iff.S, iff.S ] },
  },
}

lemma and.D (a b : Prop) : a ∧ b ↔ ¬ (¬ a ∨ ¬ b) := by {
  set c := ¬ a with hc,
  set d := ¬ b with hd,
  have h₁ : ¬ c ↔ a := by rw [hc, not.C],
  have h₂ : ¬ d ↔ b := by rw [hd, not.C],
  rw [←h₁, ←h₂],
  rw [iff.apply_not, ←or.D, not.C],
}

-- sudoku weak link and strong link
constant weak : Prop → Prop → Prop
constant strong : Prop → Prop → Prop

axiom weak.def (a b : Prop) : weak a b ↔ ¬ (a ∧ b)
axiom strong.def (a b : Prop) : strong a b ↔ ¬ a ∧ b ∨ a ∧ ¬ b
lemma weak.C (a b : Prop) : weak a b ↔ weak b a := by rw [ weak.def, weak.def, and.C ]
lemma strong.C (a b : Prop) : strong a b ↔ strong b a := by rw [ strong.def, strong.def, or.C, and.C, and.C ¬a ]

local attribute [instance] classical.prop_decidable -- for working by_contra h_left

lemma wrong_eliminate_right : ∃ (a b c : Prop), ¬ ((a ∧ c → b ∧ c) → (a → b)) := by {
  existsi true, -- backtracking order from true to false, using binary bits: 0 = true, 1 = false, example [000, 001, 010, ..., 111]
  existsi false,
  existsi false,
  iterate 7 { rw and.A <|> rw and.B <|> rw or.A <|> rw or.B <|>
     rw imp.S <|> rw imp.T <|> rw imp.F <|> rw not.A <|> rw not.B <|> trivial },
  -- solutions of backtracking: [011] = [true, false, false] (one solution)
}

lemma eliminate_right : ∀ (a b c : Prop), (a ∧ c → b ∧ c) → (a ∧ c → b) := by {
  introv,
  cases prop.A c; try {rw h},
  repeat { rw and.A <|> rw and.B <|> rw or.A <|> rw or.B },
  { assume h₂ : a → b, exact h₂ }, -- c ↔ true
  { -- c ↔ false
    rw [ imp.S, imp.T, imp.F ],
    exact true.intro,
  }
}

lemma eliminate_right_backward : ∀ (a b c : Prop), (a ∧ c → b) → (a ∧ c → b ∧ c) := by {
  introv,
  cases prop.A c; try {rw h},
  repeat { rw and.A <|> rw and.B <|> rw or.A <|> rw or.B },
  { assume h₂ : a → b, exact h₂ }, -- c ↔ true
  { -- c ↔ false
    repeat { rw imp.F <|> rw imp.T <|> rw imp.S <|> trivial },
  }
}

-- weak-strong-weak-strong loop ↔ strong-strong-strong-strong
lemma sudoku_simplest_loop (a b c d : Prop) :
    weak a b ∧ strong b c ∧   weak c d ∧ strong d a →
  strong a b ∧ strong b c ∧ strong c d ∧ strong d a :=
begin
  cases prop.A a; try {rw h, clear h},
  {
    -- if a = 1 then b = 0 by weak a b
    have h₁ : weak true b ↔ (b ↔ false) := by rw [ weak.def, and.C, and.A, iff.F ],
    rw h₁,
    assume h_left,
    rw h_left.1 at *,
    have h₃ : strong d true ↔ (d ↔ false) := by rw [ strong.def, and.A, not.A, and.B, or.B, iff.F ],
    rw h₃ at h_left,
    have b_false := h_left.1,
    have d_false := h_left.2.2.2,
    rw [b_false, d_false, iff.S, and.A, and.C, and.A] at h_left,
    have h₄ : weak c false := by { rw [weak.def, and.B, not.B], trivial },
    rw [(iff.T _).2 h₄, and.A] at h_left,
    have c_true : c ↔ true,
      by_contra h_contra,
      rw [iff.T, ←iff.F] at h_contra,
      rw h_contra at h_left,
      rw strong.def at h_left,
      rw [and.B, and.C, and.B, or.B] at h_left,
      exact h_left,
      -- rw strong.def at h_left,
      -- rw not.B at h_left,
      -- rw [and.C, and.C false] at h_left,
      -- rw [and.A, and.B] at h_left,
    rw c_true,
    rw [strong.C, strong.C true],
    rw ←and.assoc,
    repeat { rw and.S },
    rw [d_false, and.S],
    rw c_true at h_left,
    exact h_left,
    -- rw [strong.def, not.A, and.B, not.B, and.A, or.A, and.C, and.A],
    -- repeat { apply and.intro },
    -- rw [strong.def, not.A, not.B, and.A, and.B, or.A], trivial,
    -- have h₂ : strong b c := h_left.2.1,
    -- rw ←b_false,
    -- exact h₂,

  },
  {
    iterate 2 { rw [weak.def] },
    iterate 4 { rw [strong.def] },
    repeat {
      rw not.A <|> rw not.B <|> rw and.A <|> rw and.B <|> rw and.C false
      <|> rw and.C true <|> rw or.C false <|> rw or.A <|> rw or.B,
    },
    rw ←and.assoc,
    rw ←and.assoc,
    rw ←and.assoc,
    apply eliminate_right_backward _ _ d,
    cases prop.A d ; rw h,
    repeat {
      rw not.A <|> rw not.B <|> rw and.A <|> rw and.B <|> rw or.B <|> rw or.C false <|> rw imp.F <|> trivial,
    },
    rename h d_true,
    cases prop.A b; rw h,
    repeat {
      rw not.A <|> rw not.B <|> rw and.A <|> rw and.B <|> rw or.B <|> rw or.C false
      <|> rw and.C false <|> rw and.C true <|> rw and.S <|> rw imp.F <|> rw imp.S <|> trivial,
    },
    type_check (and.contra c).1, -- c ∧ ¬c → false
    have h₂ : c ∧ ¬c → false := (and.contra c).1,
    apply h₂,
  }
end

example : f 0 := by { rw [f.zero], exact true.intro, }
example : f 1 := by {
  -- simp [f.step, f.zero, f.one_eq_two] {fail_if_unchanged := ff},
  have h₀ := f.step 0,
  rw f.zero at h₀,
  have h_and : ∀ a, true ∧ a ↔ a, {
    assume a,
    rw and.C,
    exact and.A a,
  },
  rw h_and at h₀,
  rw h_and at h₀,
  cases (prop.A (f 1)); rw h, {
    exact true.intro,
  },
  {
    rw h at h₀,
    rw not.B at h₀,
    rw h_and at h₀,
    rw and.C at h₀,
    rw and.B at h₀,
    rw or.B at h₀, -- f 2 must be false for successing proof => (f 2 = false => f 1 = true)
    sorry, -- not provable?
  },
}

example : ¬ f 1 := by {
  have h₀ := f.step 0,
  rw f.zero at h₀,
  have h_and : ∀ a, true ∧ a ↔ a, {
    assume a,
    rw and.C,
    exact and.A a,
  },
  rw h_and at h₀,
  rw h_and at h₀,
  cases (prop.A (f 1)); rw h, {
    rw not.A,
    rw h at h₀,
    rw not.A at h₀,
    rw h_and at h₀,
    rw and.C at h₀,
    rw and.B at h₀,
    rw or.C at h₀,
    rw or.B at h₀,
    sorry,
  },
  {
    rw not.B,
    exact true.intro,
  },
}

end my
-- intro tactic:

-- TEST intro tactic

-- contrapose tactic:

-- TEST contrapose tactic:

-- contradiction tactic:
/--
The contradiction tactic attempts to find in the current local context a hypothesis that is equivalent to an empty inductive type (e.g. `false`), a hypothesis of the form `c_1 ... = c_2 ...` where `c_1` and `c_2` are distinct constructors, or two contradictory hypotheses.
-/

-- TEST contradiction tactic:

-- rewrite tactic:

-- TEST rewrite tactic: