/-
Copyright (c) 2022 Devon Tuma. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Devon Tuma
-/
import computational_monads.distribution_semantics.defs.eval_dist

/-!
# Probability of Events

This file defines the probability of some event holding after running a computation.
The definition is in terms of the `measure` associated to the `pmf` given by `eval_dist`.
We also introduce the notation `⁅e | oa⁆` for the probability of the output of `oa` being in `e`.
It also allows for writing `⁅λ x, p x | oa⁆` for the probability of `p` holding on the output.

This definition is equivalent to one in terms of summations, in particular an infinite `tsum`.
If the support or event is a `finset`, we can also write it in terms of `finset.sum`.
In the extreme cases of the probability being `0` or `1`, we can also work purely in terms
of `support`, with it being either disjoint from or a subset of the event respectively.
-/

namespace oracle_comp

open oracle_spec
open_locale big_operators ennreal

variables {α β γ : Type} {spec spec' : oracle_spec}

/-- Probability of a predicate holding after running a particular experiment.
Defined in terms of the outer measure associated to the corresponding `pmf` by `eval_dist`. -/
noncomputable def prob_event (oa : oracle_comp spec α) (event : set α) : ℝ≥0∞ :=
⁅oa⁆.to_outer_measure event

notation `⁅` event `|` oa `⁆` := prob_event oa event

lemma prob_event.def (oa : oracle_comp spec α) (event : set α) :
  ⁅event | oa⁆ = ⁅oa⁆.to_outer_measure event := rfl

lemma prob_event_eq_to_measure_apply (oa : oracle_comp spec α) (event : set α) :
  ⁅event | oa⁆ = (@pmf.to_measure α ⊤ ⁅oa⁆ event) :=
(@pmf.to_measure_apply_eq_to_outer_measure_apply α ⊤ ⁅oa⁆ event
  measurable_space.measurable_set_top).symm

lemma prob_event_empty (oa : oracle_comp spec α) : ⁅∅ | oa⁆ = 0 :=
⁅oa⁆.to_outer_measure.empty

@[simp] lemma prob_event_singleton_eq_eval_dist (oa : oracle_comp spec α) (x : α) :
  ⁅{x} | oa⁆ = ⁅oa⁆ x := by rw [prob_event.def, pmf.to_outer_measure_apply_singleton]

@[simp] lemma prob_event_eq_eq_eval_dist (oa : oracle_comp spec α) (x : α) :
  ⁅(=) x | oa⁆ = ⁅oa⁆ x :=
trans (congr_arg (λ s, ⁅s | oa⁆) (set.ext $ λ y, eq_comm)) (prob_event_singleton_eq_eval_dist oa x)

section sums

variables (oa : oracle_comp spec α) (e : set α)

/-- Probability of an event in terms of non-decidable `set.indicator` sum -/
lemma prob_event_eq_tsum_indicator : ⁅e | oa⁆ = ∑' x, e.indicator ⁅oa⁆ x :=
pmf.to_outer_measure_apply ⁅oa⁆ e

lemma prob_event_eq_sum_indicator [fintype α] : ⁅e | oa⁆ = ∑ x, e.indicator ⁅oa⁆ x :=
(prob_event_eq_tsum_indicator oa e).trans (tsum_eq_sum (λ x hx, (hx $ finset.mem_univ x).elim))

lemma prob_event_eq_sum_fin_support_indicator [oa.decidable] :
  ⁅e | oa⁆ = ∑ x in oa.fin_support, e.indicator ⁅oa⁆ x :=
(prob_event_eq_tsum_indicator oa e).trans (tsum_eq_sum $
  λ a ha, set.indicator_apply_eq_zero.2 (λ _, eval_dist_eq_zero' ha))

/-- Probability of an event in terms of a decidable `ite` sum-/
lemma prob_event_eq_tsum_ite [decidable_pred e] : ⁅e | oa⁆ = ∑' x, ite (x ∈ e) (⁅oa⁆ x) 0 :=
trans (prob_event_eq_tsum_indicator oa e) (tsum_congr $ λ _, by { rw set.indicator, congr} )

lemma prob_event_eq_sum_ite [fintype α] [decidable_pred e] :
  ⁅e | oa⁆ = ∑ x, ite (x ∈ e) (⁅oa⁆ x) 0 :=
trans (prob_event_eq_sum_indicator oa e) (finset.sum_congr rfl $
  λ _ _, by {rw set.indicator, congr})

lemma prob_event_eq_sum_fin_support_ite [decidable_pred e] [oa.decidable] :
  ⁅e | oa⁆ = ∑ x in oa.fin_support, ite (x ∈ e) (⁅oa⁆ x) 0 :=
trans (prob_event_eq_sum_fin_support_indicator oa e) (finset.sum_congr rfl $
  λ _ _, by {rw set.indicator, congr})

lemma prob_event_coe_finset_eq_sum (e : finset α) : ⁅↑e | oa⁆ = ∑ x in e, ⁅oa⁆ x :=
by rw [prob_event_eq_tsum_indicator, sum_eq_tsum_indicator]

end sums

lemma prob_event_diff (oa : oracle_comp spec α) (e e' : set α) :
  ⁅e \ e' | oa⁆ = ⁅e | oa⁆ - ⁅e ∩ e' | oa⁆ :=
by simp only [prob_event.def, pmf.to_outer_measure_apply_diff]

@[simp] lemma prob_event_insert (oa : oracle_comp spec α) (x : α) (e : set α) :
  ⁅insert x e | oa⁆ = ⁅= x | oa⁆ + ⁅e \ {x} | oa⁆ :=
by simp only [prob_event.def, pmf.to_outer_measure_apply_insert]

section order

variables (oa : oracle_comp spec α) (oa' : oracle_comp spec' α) (e e' : set α)

lemma prob_event_le_one : ⁅e | oa⁆ ≤ 1 :=
(⁅oa⁆.to_outer_measure.mono (set.subset_univ e)).trans
  (le_of_eq $ (⁅oa⁆.to_outer_measure_apply_eq_one_iff _).2 (set.subset_univ ⁅oa⁆.support))

/-- If the a set `e'` contains all elements of `e` that have non-zero
probability under `⁅oa⁆` then the probability of `e'` is at least as big as that of `e`. -/
lemma prob_event_mono {e e'} (h : (e ∩ oa.support) ⊆ e') : ⁅e | oa⁆ ≤ ⁅e' | oa⁆ :=
pmf.to_outer_measure_mono ⁅oa⁆ (by simpa only [support_eval_dist])

/-- Weaker version of `prob_event_mono` when the subset holds without intersection `support`. -/
lemma prob_event_mono' {e e'} (h : e ⊆ e') : ⁅e | oa⁆ ≤ ⁅e' | oa⁆ :=
prob_event_mono oa (trans (set.inter_subset_left _ _) h)

lemma prob_event_le_of_eval_dist_apply_le {oa : oracle_comp spec α} {oa' : oracle_comp spec' α}
  (h : ∀ x ∈ oa.support, ⁅oa⁆ x ≤ ⁅oa'⁆ x) (e : set α) : ⁅e | oa⁆ ≤ ⁅e | oa'⁆ :=
begin
  simp only [prob_event_eq_tsum_indicator],
  refine ennreal.tsum_le_tsum (λ x, _),
  refine set.indicator_apply_le (λ hxe, _),
  by_cases hx : x ∈ oa.support,
  { rw [(set.indicator_apply_eq_self.2 $ λ hxe', (hxe' hxe).elim)],
    exact h x hx },
  { simp only [eval_dist_eq_zero hx, zero_le'] }
end

/-- If the `eval_dist` agrees on all elements of the support, then `prob_event` agrees as well. -/
lemma prob_event_eq_of_eval_dist_apply_eq {oa : oracle_comp spec α} {oa' : oracle_comp spec' α}
  (h : ∀ x ∈ oa.support ∪ oa'.support, ⁅oa⁆ x = ⁅oa'⁆ x) (e : set α) : ⁅e | oa⁆ = ⁅e | oa'⁆ :=
antisymm (prob_event_le_of_eval_dist_apply_le (λ x hx, le_of_eq (h x $ or.inl hx)) e)
  (prob_event_le_of_eval_dist_apply_le (λ x hx, le_of_eq (h x $ or.inr hx).symm) e)

lemma prob_event_eq_of_eval_dist_eq {oa : oracle_comp spec α} {oa' : oracle_comp spec' α}
  (h : ⁅oa⁆ = ⁅oa'⁆) (e : set α) : ⁅e | oa⁆ = ⁅e | oa'⁆ :=
prob_event_eq_of_eval_dist_apply_eq (λ x _, by rw [h]) e

end order

section return

variables (a : α) (e : set α)

@[simp] lemma prob_event_return [decidable_pred e] :
  ⁅e | (return a : oracle_comp spec α)⁆ = ite (a ∈ e) 1 0 :=
by { simp only [prob_event.def, eval_dist_return, pmf.to_outer_measure_pure_apply], congr }

-- TODO: there's some simp issues with decidability
@[simp] lemma prob_event_return_eq_indicator :
  ⁅e | (return a : oracle_comp spec α)⁆ = e.indicator (λ _, 1) a :=
by rw [prob_event.def, eval_dist_return, pmf.to_outer_measure_pure_apply, set.indicator]

lemma prob_event_pure' [decidable_pred e] :
  ⁅e | (pure' α a : oracle_comp spec α)⁆ = ite (a ∈ e) 1 0 :=
by { simp only [pure'_eq_return, prob_event.def, eval_dist_return,
  pmf.to_outer_measure_pure_apply], congr }

lemma prob_event_pure'_eq_indicator [decidable_pred e] : ⁅e | (pure' α a : oracle_comp spec α)⁆ =
  e.indicator (λ _, 1) a := by simp only [pure'_eq_return, prob_event_return, set.indicator_apply]

lemma prob_event_pure [decidable_pred e] : ⁅e | (pure a : oracle_comp spec α)⁆ = ite (a ∈ e) 1 0 :=
by { simp only [prob_event.def, eval_dist_return, pmf.to_outer_measure_pure_apply], congr }

lemma prob_event_pure_eq_indicator [decidable_pred e] : ⁅e | (pure a : oracle_comp spec α)⁆ =
  e.indicator (λ _, 1) a := by simp only [prob_event_return, set.indicator_apply]

end return

section bind

variables (a : α) (oa : oracle_comp spec α) (ob : α → oracle_comp spec β)
  (f : α → β) (e : set α) (e' : set β)

@[simp] lemma prob_event_bind_eq_tsum : ⁅e' | oa >>= ob⁆ = ∑' x, ⁅oa⁆ x * ⁅e' | ob x⁆ :=
by simp only [prob_event.def, eval_dist_bind, pmf.to_outer_measure_bind_apply]

lemma prob_event_bind_eq_sum [fintype α] : ⁅e' | oa >>= ob⁆ = ∑ x, ⁅oa⁆ x * ⁅e' | ob x⁆ :=
by simpa only [prob_event_bind_eq_tsum] using tsum_eq_sum (λ x hx, (hx $ finset.mem_univ x).elim)

lemma prob_event_bind_eq_sum_fin_support [oa.decidable] :
  ⁅e' | oa >>= ob⁆ = ∑ x in oa.fin_support, ⁅oa⁆ x * ⁅e' | ob x⁆ :=
(prob_event_bind_eq_tsum _ _ _).trans (tsum_eq_sum (λ x h, by rw [eval_dist_eq_zero' h, zero_mul]))

@[simp] lemma prob_event_bind'_eq_tsum : ⁅e' | bind' α β oa ob⁆ = ∑' x, ⁅oa⁆ x * ⁅e' | ob x⁆ :=
prob_event_bind_eq_tsum oa ob e'

lemma prob_event_bind'_eq_sum [fintype α] : ⁅e' | bind' α β oa ob⁆ = ∑ x, ⁅oa⁆ x * ⁅e' | ob x⁆ :=
prob_event_bind_eq_sum oa ob e'

lemma prob_event_bind'_eq_sum_fin_support [oa.decidable] :
  ⁅e' | bind' α β oa ob⁆ = ∑ x in oa.fin_support, ⁅oa⁆ x * ⁅e' | ob x⁆ :=
prob_event_bind_eq_sum_fin_support oa ob e'

@[simp] lemma prob_event_return_bind : ⁅e' | return a >>= ob⁆ = ⁅e' | ob a⁆ :=
sorry --prob_event_eq_of_eval_dist_eq (eval_dist_return_bind a ob) e'

@[simp] lemma prob_event_bind_return : ⁅e' | oa >>= λ a, return (f a)⁆ = ⁅f ⁻¹' e' | oa⁆ :=
show ⁅e' | f <$> oa⁆ = ⁅f ⁻¹' e' | oa⁆,
by sorry --by simp only [prob_event.def, eval_dist_map, pmf.to_outer_measure_map_apply]

@[simp] lemma prob_event_bind_return_id : ⁅e | oa >>= return⁆ = ⁅e | oa⁆ :=
sorry --prob_event_eq_of_eval_dist_eq (eval_dist_bind_return_id oa) e

end bind

section query

variables (i : spec.ι) (t : spec.domain i) (u : spec.range i)
  (oa : spec.range i → oracle_comp spec α) (e : set (spec.range i)) (e' : set α)

@[simp] lemma prob_event_query [decidable_pred e] :
  ⁅e | query i t⁆ = fintype.card e / fintype.card (spec.range i) :=
by simp only [prob_event.def, eval_dist_query, pmf.to_outer_measure_uniform_of_fintype_apply,
  fintype.card_of_finset, finset.filter_congr_decidable]

lemma prob_event_query_bind_eq_tsum :
  ⁅e' | query i t >>= oa⁆ = (∑' x, ⁅e' | oa x⁆) / fintype.card (spec.range i) :=
by simp only [prob_event_bind_eq_tsum, eval_dist_query_apply, div_eq_mul_inv,
  ← ennreal.tsum_mul_right, one_mul, mul_comm]

lemma prob_event_query_bind_eq_sum :
  ⁅e' | query i t >>= oa⁆ = (∑ x, ⁅e' | oa x⁆) / fintype.card (spec.range i) :=
by simp only [prob_event_bind_eq_sum, eval_dist_query_apply, div_eq_mul_inv,
  finset.mul_sum, one_mul, mul_comm]

end query

section map

variables (a : α) (oa : oracle_comp spec α) (ob : α → oracle_comp spec β)
  (f : α → β) (g : β → γ) (e : set β) (e' : set γ)

@[simp] lemma prob_event_map : ⁅e | f <$> oa⁆ = ⁅f ⁻¹' e | oa⁆ :=
sorry --by simp only [prob_event.def, eval_dist_map, pmf.to_outer_measure_map_apply]

lemma prob_event_map_return : ⁅e | f <$> (return a : oracle_comp spec α)⁆ =
  ⁅e | (return (f a) : oracle_comp spec β)⁆ :=
sorry --prob_event_eq_of_eval_dist_eq (by rw [eval_dist_map_return, eval_dist_return]) e

lemma prob_event_map_bind : ⁅e' | g <$> (oa >>= ob)⁆ = ⁅e' | oa >>= λ x, g <$> (ob x)⁆ :=
begin
  refine prob_event_eq_of_eval_dist_apply_eq _ _,
  intros x hx, sorry
  -- rw [eval_dist_map_bind'],

end

end map

section support

variables (oa : oracle_comp spec α) (ob : α → oracle_comp spec β) (e e' : set α)

/-- If two sets have the same intersection with the support of a computation,
then they both have the same probability under `prob_event` -/
lemma prob_event_eq_prob_event_of_inter_support_eq {e e'}
  (h : e ∩ oa.support = e' ∩ oa.support) : ⁅e | oa⁆ = ⁅e' | oa⁆ :=
pmf.to_outer_measure_apply_eq_of_inter_support_eq ⁅oa⁆ (by simpa only [support_eval_dist])

/-- Probability can be calculated on only the intersection of the set with the support. -/
lemma prob_event_eq_prob_event_inter_support : ⁅e | oa⁆ = ⁅e ∩ oa.support | oa⁆ :=
prob_event_eq_prob_event_of_inter_support_eq oa (by rw [set.inter_assoc, set.inter_self])

/-- Given a `finset` containing the `support` of some `oracle_comp`,
  it suffices to take `finset.sum` over that instead of a `tsum` -/
theorem prob_event_eq_sum_of_support_subset [decidable_pred e] (s : finset α)
  (hs : oa.support ⊆ s) : ⁅e | oa⁆ = ∑ x in s, ite (x ∈ e) (⁅oa⁆ x) 0 :=
trans (prob_event_eq_tsum_ite oa e) (tsum_eq_sum (λ x hx,
  by rw [eval_dist_eq_zero (λ hx', hx $ finset.mem_coe.1 (hs hx')), if_t_t]))

theorem prob_event_bind_eq_sum_of_support_subset (e : set β) (s : finset α) (hs : oa.support ⊆ s) :
  ⁅e | oa >>= ob⁆ = ∑ x in s, ⁅oa⁆ x * ⁅e | ob x⁆ :=
trans (prob_event_bind_eq_tsum oa ob e) (tsum_eq_sum (λ x hx,
  by rw [eval_dist_eq_zero (λ h, hx (hs h)), zero_mul]))

@[simp] lemma prob_event_eq_zero_iff_disjoint_support : ⁅e | oa⁆ = 0 ↔ disjoint oa.support e :=
by rw [prob_event.def, pmf.to_outer_measure_apply_eq_zero_iff, support_eval_dist]

lemma prob_event_eq_zero_of_dijoint_support (h : disjoint oa.support e) : ⁅e | oa⁆ = 0 :=
(oa.prob_event_eq_zero_iff_disjoint_support e).2 h

@[simp] lemma prob_event_eq_one_iff_support_subset : ⁅e | oa⁆ = 1 ↔ oa.support ⊆ e :=
by rw [prob_event.def, pmf.to_outer_measure_apply_eq_one_iff, support_eval_dist]

lemma prob_event_eq_one_of_support_subset (h : oa.support ⊆ e) : ⁅e | oa⁆ = 1 :=
(oa.prob_event_eq_one_iff_support_subset e).2 h

end support

section fin_support

variables (oa : oracle_comp spec α) [decidable oa]
  (ob : α → oracle_comp spec β) (e e' : set α)

lemma prob_event_eq_sum_fin_support [decidable_pred e] :
  ⁅e | oa⁆ = ∑ x in oa.fin_support, ite (x ∈ e) (⁅oa⁆ x) 0 :=
(prob_event_eq_sum_of_support_subset _ e oa.fin_support $ support_subset_coe_fin_support oa)

end fin_support

section sets

variables (oa : oracle_comp spec α) (e : set α)

lemma prob_event_eq_eval_dist {x} (hx : x ∈ e)
  (h : ∀ y ≠ x, y ∈ e → y ∉ oa.support) : ⁅e | oa⁆ = ⁅oa⁆ x :=
begin
  refine (prob_event_eq_tsum_indicator oa e).trans (trans (tsum_eq_single x $ λ y hy, _) _),
  { simpa only [set.indicator_apply_eq_zero, eval_dist_eq_zero_iff] using h y hy },
  { simp only [set.indicator_apply_eq_self, hx, not_true, false_implies_iff] }
end

lemma prob_event_Union_eq_of_pairwise_disjoint (es : ℕ → set α) (h : pairwise (disjoint on es)) :
  ⁅⋃ i, es i | oa⁆ = ∑' i, ⁅es i | oa⁆ :=
by simp only [prob_event.def, pmf.to_outer_measure_apply_Union ⁅oa⁆ h]

lemma prob_event_union_eq_of_disjoint {e e' : set α}
  (h : disjoint e e') : ⁅e ∪ e' | oa⁆ = ⁅e | oa⁆ + ⁅e' | oa⁆ :=
by simpa only [prob_event_eq_to_measure_apply] using
  @measure_theory.measure_union α ⊤ _ e e' h measurable_space.measurable_set_top

lemma prob_event_eq_prob_event_inter_add_prob_event_diff {e s : set α} :
  ⁅e | oa⁆ = ⁅e ∩ s | oa⁆ + ⁅e \ s | oa⁆ :=
trans (by rw [set.inter_union_diff]) (prob_event_union_eq_of_disjoint oa $
  set.disjoint_of_subset_left (set.inter_subset_right _ _)
    (by rw [set.disjoint_iff, set.inter_diff_self]))

end sets

end oracle_comp


open classical

variables p q r s : Prop

example : (p → r ∨ s) → ((p → r) ∨ (p → s)) := begin
intro h, apply by_cases, {
  assume hp: p,
  cases (h hp),
    left, intro, assumption,
    right, intro, assumption,
}, {
  assume hnp: ¬ p,
  exact (or.inl $ λ hp:p, absurd hp hnp)
}
end

example : ¬(p ∧ q) → ¬p ∨ ¬q := begin
intro h, apply by_cases, {
  assume hp: p,
  right, intro hq, exact (h ⟨hp, hq⟩)
}, {
  assume hnp: ¬ p, left, assumption
}
end

lemma dne {p: Prop} (h: ¬ ¬ p) : p :=
or.elim (em p)
  (assume hp: p, hp)
  (assume hnp: ¬ p, absurd hnp h)

example : ¬(p → q) → p ∧ ¬q := begin
intro h, apply by_contradiction, {
  intro hc,
  have hcc: p -> ¬ q -> false, from λ x y, hc ⟨x, y⟩,
  have: p -> q, {
    intro hp,
    have: ¬ ¬ q, from hcc hp, apply dne this
  }, contradiction
}
end

example : (p → q) → (¬p ∨ q) := begin
intro h, apply by_cases, {
  assume: p, right, exact (h this)
}, {
  assume: ¬ p, left, assumption
}
end

example : (¬q → ¬p) → (p → q) := begin
intro h, intro hp, apply by_cases, {
  assume: q, assumption
}, {
  assume:  ¬ q, have: ¬ p, from h this, contradiction
}
end

example : p ∨ ¬p := begin
apply em p
end

example : (((p → q) → p) → p) := begin
intro h, apply by_contradiction, {
  intro hnp,
  have: p -> q, from λ hp, absurd hp hnp,
  have: p, from h this, contradiction
}
end


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

theorem algebra_others_exirrpowirrrat :
  ∃ a b, irrational a ∧ irrational b ∧ ¬ irrational (a^b) :=
begin
  let sqrt_2 :=  real.sqrt 2,
  by_cases irrational (sqrt_2^sqrt_2),
  {
    have h': ¬ irrational ((sqrt_2^sqrt_2)^sqrt_2),
    {
     intro h,
     rw ← (real.rpow_mul (real.sqrt_nonneg 2) (real.sqrt 2) (real.sqrt 2)) at h,
     have zlet : 0 ≤ (2 : ℝ), by norm_num,
     rw ← (real.sqrt_mul zlet 2) at h,
     rw real.sqrt_mul_self zlet at h,
     have x : (real.sqrt 2)^(2 : ℕ) = (real.sqrt 2)^(2 : ℝ), by norm_cast,
     rw ← x at h,
     rw real.sq_sqrt zlet at h,
     have tnotira : ¬ irrational 2,
     {
        convert rat.not_irrational 2,
        norm_cast,
     },
     exact tnotira h,
    },
    exact ⟨(sqrt_2^sqrt_2), sqrt_2, h, irrational_sqrt_two, h'⟩,
  },
  {
     exact ⟨sqrt_2, sqrt_2, irrational_sqrt_two, irrational_sqrt_two, h⟩,
  }
end


namespace hidden

def divides (m n : ℕ) : Prop := ∃ k, m * k = n

instance : has_dvd nat := ⟨divides⟩

def even (n : ℕ) : Prop := 2 ∣ n -- You can enter the '∣' character by typing \mid

section
  variables m n : ℕ

  #check m ∣ n
  #check m^n
  #check even (m^n +3)
end

end hidden

def prime (n : ℕ) : Prop := ∀ m: ℕ, m ∣ n -> m = 1 ∨ m = n

def infinitely_many_primes : Prop := ∀ n: ℕ, prime n -> ∃ n': ℕ, n' > n ∧ prime n'

def Fermat_prime (n : ℕ) : Prop := prime n ∧ ∃ m: ℕ, n = 2^2^m

def infinitely_many_Fermat_primes : Prop := ∀ n: ℕ, Fermat_prime n -> ∃ n': ℕ, n' > n ∧ Fermat_prime n'

def goldbach_conjecture : Prop := ∀ n: ℕ, 2 ∣ n -> ∃ (m m': ℕ), n = m + m' ∧ prime m ∧ prime m'

def Goldbach's_weak_conjecture : Prop := ∀ n: ℕ, n > 5 ∧ ¬ (2 ∣ n) ->
  ∃ (p1 p2 p3: ℕ), prime p1 ∧ prime p2 ∧ prime p3 ∧ n = p1 + p2 + p3

def Fermat's_last_theorem : Prop := ∀ (a b c n: ℕ), n > 2 -> a^n + b^n ≠ c^n


import data.matrix.basic
import data.matrix.notation
import data.complex.basic
import wheel

noncomputable def non_zero : submonoid ℂ :=
{ carrier := (≠ 0),
  one_mem' := by {unfold has_mem.mem set.mem, norm_num},
  mul_mem' :=
  begin unfold has_mem.mem set.mem, intros a b a0 b0 ab0
  , have h : a = 0 ∨ b = 0
  , {apply eq_zero_or_eq_zero_of_mul_eq_zero ab0}
  , cases h; contradiction
  end
}

-- the Reimann sphere with an addition point to represent 0/0.
-- The term wheel is inspired by the topological picture ⊙ of the projective line together with an extra point ⊥ = 0/0.

inductive ReimannWheel
| mk : ℂ → ReimannWheel
| inf : ReimannWheel
| bot : ReimannWheel

notation `ℂ∞` := ReimannWheel

open ReimannWheel

def add : ℂ∞ → ℂ∞ → ℂ∞
| (mk z₀) (mk z₁) := mk (z₀ + z₁)
| bot _ := bot
| _ bot := bot
| inf _ := inf
| _ inf := inf

lemma ReimannWheel.add_assoc : associative add :=
  begin intros x y z
  , cases x; cases y; cases z; unfold add
  , rw add_assoc
  end

instance ReimannWheel.has_zero : has_zero ReimannWheel := ⟨mk 0⟩

lemma mk_0_eq_0 : mk 0 = 0 := by {unfold has_zero.zero}

lemma ReimannWheel.add_zero : ∀ x, add x 0 = x
| (mk z) := by {rw ← mk_0_eq_0, unfold add, rw add_zero}
| inf := by {rw ← mk_0_eq_0, unfold add}
| bot := by {rw ← mk_0_eq_0, unfold add}

lemma ReimannWheel.zero_add : ∀ x, add 0 x = x
| (mk z) := by {rw ← mk_0_eq_0, unfold add, rw zero_add}
| inf := by {rw ← mk_0_eq_0, unfold add}
| bot := by {rw ← mk_0_eq_0, unfold add}

lemma ReimannWheel.add_comm : ∀ x y, add x y = add y x
| x y := by {cases x; cases y; unfold add; rw add_comm}

noncomputable def mul : ℂ∞ → ℂ∞ → ℂ∞
| (mk z₀) (mk z₁) := mk (z₀ * z₁)
| bot _ := bot
| _ bot := bot
| inf (mk z) := if z = 0 then bot else inf
| (mk z) inf := if z = 0 then bot else inf
| inf inf := inf

lemma ReimannWheel.mul_assoc : associative mul :=
  begin intros x y z
  , cases x; cases y; cases z; unfold mul
  , {rw mul_assoc}
  end

instance ReimannWheelIsWheel : wheel ReimannWheel :=
{ add := add,
  add_assoc := by {unfold has_add.add, apply ReimannWheel.add_assoc},
  zero_add := by {unfold has_add.add, apply ReimannWheel.zero_add},
  add_zero := by {unfold has_add.add, apply ReimannWheel.add_zero},
  add_comm := by {unfold has_add.add, apply ReimannWheel.add_comm},
  mul := mul,
  mul_assoc := by {unfold has_mul.mul, apply ReimannWheel.mul_assoc},
  one := mk 1,
  one_mul := _,
  mul_one := _,
  mul_comm := _,
  inv := _,
  inv_involution := _,
  inv_mult := _,
  left_distrib := _,
  left_distrib_cancel := _,
  zero_mult_zero := _,
  pull_out_zero := _,
  bot_absorbsive := _ }

notation `M2` T := matrix (fin 2) (fin 2) T


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

! This file was ported from Lean 3 source module algebra.order.upper_lower
! leanprover-community/mathlib commit d90e4e186f1d18e375dcd4e5b5f6364b01cb3e46
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Order.Group.Defs
import Mathlib.Data.Set.Pointwise.SMul
import Mathlib.Order.UpperLower.Basic
/-!
# Algebraic operations on upper/lower sets

Upper/lower sets are preserved under pointwise algebraic operations in ordered groups.
-/

open Function Set

open Pointwise

section OrderedCommMonoid

variable {α : Type _} [OrderedCommMonoid α] {s : Set α} {x : α}

@[to_additive]
theorem IsUpperSet.smul_subset (hs : IsUpperSet s) (hx : 1 ≤ x) : x • s ⊆ s :=
  smul_set_subset_iff.2 fun _ ↦ hs <| le_mul_of_one_le_left' hx
#align is_upper_set.smul_subset IsUpperSet.smul_subset
#align is_upper_set.vadd_subset IsUpperSet.vadd_subset

@[to_additive]
theorem IsLowerSet.smul_subset (hs : IsLowerSet s) (hx : x ≤ 1) : x • s ⊆ s :=
  smul_set_subset_iff.2 fun _ ↦ hs <| mul_le_of_le_one_left' hx
#align is_lower_set.smul_subset IsLowerSet.smul_subset
#align is_lower_set.vadd_subset IsLowerSet.vadd_subset

end OrderedCommMonoid

section OrderedCommGroup

variable {α : Type _} [OrderedCommGroup α] {s t : Set α} {a : α}

@[to_additive]
theorem IsUpperSet.smul (hs : IsUpperSet s) : IsUpperSet (a • s) :=
  by
  rintro _ y hxy ⟨x, hx, rfl⟩
  exact mem_smul_set_iff_inv_smul_mem.2 (hs (le_inv_mul_iff_mul_le.2 hxy) hx)
#align is_upper_set.smul IsUpperSet.smul
#align is_upper_set.vadd IsUpperSet.vadd

@[to_additive]
theorem IsLowerSet.smul (hs : IsLowerSet s) : IsLowerSet (a • s) :=
  hs.ofDual.smul
#align is_lower_set.smul IsLowerSet.smul
#align is_lower_set.vadd IsLowerSet.vadd

@[to_additive]
theorem Set.OrdConnected.smul (hs : s.OrdConnected) : (a • s).OrdConnected :=
  by
  rw [← hs.upperClosure_inter_lowerClosure, smul_set_inter]
  exact (upperClosure _).upper.smul.ordConnected.inter (lowerClosure _).lower.smul.ordConnected
#align set.ord_connected.smul Set.OrdConnected.smul
#align set.ord_connected.vadd Set.OrdConnected.vadd

@[to_additive]
theorem IsUpperSet.mul_left (ht : IsUpperSet t) : IsUpperSet (s * t) :=
  by
  rw [← smul_eq_mul, ← Set.unionᵢ_smul_set]
  exact isUpperSet_unionᵢ₂ fun x _ ↦ ht.smul
#align is_upper_set.mul_left IsUpperSet.mul_left
#align is_upper_set.add_left IsUpperSet.add_left

@[to_additive]
theorem IsUpperSet.mul_right (hs : IsUpperSet s) : IsUpperSet (s * t) :=
  by
  rw [mul_comm]
  exact hs.mul_left
#align is_upper_set.mul_right IsUpperSet.mul_right
#align is_upper_set.add_right IsUpperSet.add_right

@[to_additive]
theorem IsLowerSet.mul_left (ht : IsLowerSet t) : IsLowerSet (s * t) :=
  ht.ofDual.mul_left
#align is_lower_set.mul_left IsLowerSet.mul_left
#align is_lower_set.add_left IsLowerSet.add_left

@[to_additive]
theorem IsLowerSet.mul_right (hs : IsLowerSet s) : IsLowerSet (s * t) :=
  hs.ofDual.mul_right
#align is_lower_set.mul_right IsLowerSet.mul_right
#align is_lower_set.add_right IsLowerSet.add_right

@[to_additive]
theorem IsUpperSet.inv (hs : IsUpperSet s) : IsLowerSet s⁻¹ := fun _ _ h ↦ hs <| inv_le_inv' h
#align is_upper_set.inv IsUpperSet.inv
#align is_upper_set.neg IsUpperSet.neg

@[to_additive]
theorem IsLowerSet.inv (hs : IsLowerSet s) : IsUpperSet s⁻¹ := fun _ _ h ↦ hs <| inv_le_inv' h
#align is_lower_set.inv IsLowerSet.inv
#align is_lower_set.neg IsLowerSet.neg

@[to_additive]
theorem IsUpperSet.div_left (ht : IsUpperSet t) : IsLowerSet (s / t) :=
  by
  rw [div_eq_mul_inv]
  exact ht.inv.mul_left
#align is_upper_set.div_left IsUpperSet.div_left
#align is_upper_set.sub_left IsUpperSet.sub_left

@[to_additive]
theorem IsUpperSet.div_right (hs : IsUpperSet s) : IsUpperSet (s / t) :=
  by
  rw [div_eq_mul_inv]
  exact hs.mul_right
#align is_upper_set.div_right IsUpperSet.div_right
#align is_upper_set.sub_right IsUpperSet.sub_right

@[to_additive]
theorem IsLowerSet.div_left (ht : IsLowerSet t) : IsUpperSet (s / t) :=
  ht.ofDual.div_left
#align is_lower_set.div_left IsLowerSet.div_left
#align is_lower_set.sub_left IsLowerSet.sub_left

@[to_additive]
theorem IsLowerSet.div_right (hs : IsLowerSet s) : IsLowerSet (s / t) :=
  hs.ofDual.div_right
#align is_lower_set.div_right IsLowerSet.div_right
#align is_lower_set.sub_right IsLowerSet.sub_right

namespace UpperSet

@[to_additive]
instance : One (UpperSet α) :=
  ⟨Ici 1⟩

@[to_additive]
instance : Mul (UpperSet α) :=
  ⟨fun s t ↦ ⟨image2 (· * ·) s t, s.2.mul_right⟩⟩

@[to_additive]
instance : Div (UpperSet α) :=
  ⟨fun s t ↦ ⟨image2 (· / ·) s t, s.2.div_right⟩⟩

@[to_additive]
instance : SMul α (UpperSet α) :=
  ⟨fun a s ↦ ⟨(· • ·) a '' s, s.2.smul⟩⟩

@[to_additive (attr := simp,norm_cast)]
theorem coe_one : ((1 : UpperSet α) : Set α) = Set.Ici 1 :=
  rfl
#align upper_set.coe_one UpperSet.coe_one
#align upper_set.coe_zero UpperSet.coe_zero

@[to_additive (attr := simp,norm_cast)]
theorem coe_mul (s t : UpperSet α) : (↑(s * t) : Set α) = s * t :=
  rfl
#align upper_set.coe_mul UpperSet.coe_mul
#align upper_set.coe_add UpperSet.coe_add

@[to_additive (attr := simp,norm_cast)]
theorem coe_div (s t : UpperSet α) : (↑(s / t) : Set α) = s / t :=
  rfl
#align upper_set.coe_div UpperSet.coe_div
#align upper_set.coe_sub UpperSet.coe_sub

@[to_additive (attr := simp)]
theorem Ici_one : Ici (1 : α) = 1 :=
  rfl
#align upper_set.Ici_one UpperSet.Ici_one
#align upper_set.Ici_zero UpperSet.Ici_zero

@[to_additive]
instance : MulAction α (UpperSet α) :=
  SetLike.coe_injective.mulAction _ (λ _ _ => rfl)

@[to_additive]
instance commSemigroup : CommSemigroup (UpperSet α) :=
  { (SetLike.coe_injective.commSemigroup _ coe_mul : CommSemigroup (UpperSet α)) with
    mul := (· * ·) }

@[to_additive]
private theorem one_mul (s : UpperSet α) : 1 * s = s :=
  SetLike.coe_injective <|
    (subset_mul_right _ left_mem_Ici).antisymm' <|
      by
      rw [← smul_eq_mul, ← Set.unionᵢ_smul_set]
      exact Set.unionᵢ₂_subset fun _ ↦ s.upper.smul_subset

@[to_additive]
instance : CommMonoid (UpperSet α) :=
  { UpperSet.commSemigroup with
    one := 1
    one_mul := one_mul
    mul_one := fun s ↦ by
      rw [mul_comm]
      exact one_mul _ }

end UpperSet

namespace LowerSet

@[to_additive]
instance : One (LowerSet α) :=
  ⟨Iic 1⟩

@[to_additive]
instance : Mul (LowerSet α) :=
  ⟨fun s t ↦ ⟨image2 (· * ·) s t, s.2.mul_right⟩⟩

@[to_additive]
instance : Div (LowerSet α) :=
  ⟨fun s t ↦ ⟨image2 (· / ·) s t, s.2.div_right⟩⟩

@[to_additive]
instance : SMul α (LowerSet α) :=
  ⟨fun a s ↦ ⟨(· • ·) a '' s, s.2.smul⟩⟩

@[to_additive (attr := simp,norm_cast)]
theorem coe_mul (s t : LowerSet α) : (↑(s * t) : Set α) = s * t :=
  rfl
#align lower_set.coe_mul LowerSet.coe_mul
#align lower_set.coe_add LowerSet.coe_add

@[to_additive (attr := simp,norm_cast)]
theorem coe_div (s t : LowerSet α) : (↑(s / t) : Set α) = s / t :=
  rfl
#align lower_set.coe_div LowerSet.coe_div
#align lower_set.coe_sub LowerSet.coe_sub

@[to_additive (attr := simp)]
theorem Iic_one : Iic (1 : α) = 1 :=
  rfl
#align lower_set.Iic_one LowerSet.Iic_one
#align lower_set.Iic_zero LowerSet.Iic_zero

@[to_additive]
instance : MulAction α (LowerSet α) :=
  SetLike.coe_injective.mulAction _ (λ _ _ => rfl)

@[to_additive]
instance commSemigroup : CommSemigroup (LowerSet α) :=
  { (SetLike.coe_injective.commSemigroup _ coe_mul : CommSemigroup (LowerSet α)) with
    mul := (· * ·) }

@[to_additive]
private theorem one_mul (s : LowerSet α) : 1 * s = s :=
  SetLike.coe_injective <|
    (subset_mul_right _ right_mem_Iic).antisymm' <|
      by
      rw [← smul_eq_mul, ← Set.unionᵢ_smul_set]
      exact Set.unionᵢ₂_subset fun _ ↦ s.lower.smul_subset

@[to_additive]
instance : CommMonoid (LowerSet α) :=
  { LowerSet.commSemigroup with
    one := 1
    one_mul := one_mul
    mul_one := fun s ↦ by
      rw [mul_comm]
      exact one_mul _ }

end LowerSet

variable (a s t)

@[to_additive (attr := simp)]
theorem upperClosure_one : upperClosure (1 : Set α) = 1 :=
  upperClosure_singleton _
#align upper_closure_one upperClosure_one
#align upper_closure_zero upperClosure_zero

@[to_additive (attr := simp)]
theorem lowerClosure_one : lowerClosure (1 : Set α) = 1 :=
  lowerClosure_singleton _
#align lower_closure_one lowerClosure_one
#align lower_closure_zero lowerClosure_zero

@[to_additive (attr := simp)]
theorem upperClosure_smul : upperClosure (a • s) = a • upperClosure s :=
  upperClosure_image <| OrderIso.mulLeft a
#align upper_closure_smul upperClosure_smul
#align upper_closure_vadd upperClosure_vadd

@[to_additive (attr := simp)]
theorem lowerClosure_smul : lowerClosure (a • s) = a • lowerClosure s :=
  lowerClosure_image <| OrderIso.mulLeft a
#align lower_closure_smul lowerClosure_smul
#align lower_closure_vadd lowerClosure_vadd

@[to_additive]
theorem mul_upperClosure : s * upperClosure t = upperClosure (s * t) := by
  simp_rw [← smul_eq_mul, ← Set.unionᵢ_smul_set, upperClosure_unionᵢ, upperClosure_smul,
    UpperSet.coe_infᵢ₂]
  rfl
#align mul_upper_closure mul_upperClosure
#align add_upper_closure add_upperClosure

@[to_additive]
theorem mul_lowerClosure : s * lowerClosure t = lowerClosure (s * t) := by
  simp_rw [← smul_eq_mul, ← Set.unionᵢ_smul_set, lowerClosure_unionᵢ, lowerClosure_smul,
    LowerSet.coe_supᵢ₂]
  rfl
#align mul_lower_closure mul_lowerClosure
#align add_lower_closure add_lowerClosure

@[to_additive]
theorem upperClosure_mul : ↑(upperClosure s) * t = upperClosure (s * t) :=
  by
  simp_rw [mul_comm _ t]
  exact mul_upperClosure _ _
#align upper_closure_mul upperClosure_mul
#align upper_closure_add upperClosure_add

@[to_additive]
theorem lowerClosure_mul : ↑(lowerClosure s) * t = lowerClosure (s * t) :=
  by
  simp_rw [mul_comm _ t]
  exact mul_lowerClosure _ _
#align lower_closure_mul lowerClosure_mul
#align lower_closure_add lowerClosure_add

@[to_additive (attr := simp)]
theorem upperClosure_mul_distrib : upperClosure (s * t) = upperClosure s * upperClosure t :=
  SetLike.coe_injective <| by
    rw [UpperSet.coe_mul, mul_upperClosure, upperClosure_mul, UpperSet.upperClosure]
#align upper_closure_mul_distrib upperClosure_mul_distrib
#align upper_closure_add_distrib upperClosure_add_distrib

@[to_additive (attr := simp)]
theorem lowerClosure_mul_distrib : lowerClosure (s * t) = lowerClosure s * lowerClosure t :=
  SetLike.coe_injective <| by
    rw [LowerSet.coe_mul, mul_lowerClosure, lowerClosure_mul, LowerSet.lowerClosure]
#align lower_closure_mul_distrib lowerClosure_mul_distrib
#align lower_closure_add_distrib lowerClosure_add_distrib

end OrderedCommGroup


/-
Copyright (c) 2019 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Johan Commelin
-/
import data.polynomial.field_division
import ring_theory.integral_closure

/-!
# Minimal polynomials

This file defines the minimal polynomial of an element `x` of an `A`-algebra `B`,
under the assumption that x is integral over `A`, and derives some basic properties
such as ireducibility under the assumption `B` is a domain.

-/

open_locale classical polynomial
open polynomial set function

variables {A B : Type*}

section min_poly_def
variables (A) [comm_ring A] [ring B] [algebra A B]

/--
Suppose `x : B`, where `B` is an `A`-algebra.

The minimal polynomial `minpoly A x` of `x`
is a monic polynomial with coefficients in `A` of smallest degree that has `x` as its root,
if such exists (`is_integral A x`) or zero otherwise.

For example, if `V` is a `𝕜`-vector space for some field `𝕜` and `f : V →ₗ[𝕜] V` then
the minimal polynomial of `f` is `minpoly 𝕜 f`.
-/
noncomputable def minpoly (x : B) : A[X] :=
if hx : is_integral A x then degree_lt_wf.min _ hx else 0

end min_poly_def

namespace minpoly

section ring
variables [comm_ring A] [ring B] [algebra A B]
variables {x : B}

/-- A minimal polynomial is monic. -/
lemma monic (hx : is_integral A x) : monic (minpoly A x) :=
by { delta minpoly, rw dif_pos hx, exact (degree_lt_wf.min_mem _ hx).1 }

/-- A minimal polynomial is nonzero. -/
lemma ne_zero [nontrivial A] (hx : is_integral A x) : minpoly A x ≠ 0 :=
(monic hx).ne_zero

lemma eq_zero (hx : ¬ is_integral A x) : minpoly A x = 0 :=
dif_neg hx

variables (A x)

/-- An element is a root of its minimal polynomial. -/
@[simp] lemma aeval : aeval x (minpoly A x) = 0 :=
begin
  delta minpoly, split_ifs with hx,
  { exact (degree_lt_wf.min_mem _ hx).2 },
  { exact aeval_zero _ }
end

/-- A minimal polynomial is not `1`. -/
lemma ne_one [nontrivial B] : minpoly A x ≠ 1 :=
begin
  intro h,
  refine (one_ne_zero : (1 : B) ≠ 0) _,
  simpa using congr_arg (polynomial.aeval x) h
end

lemma map_ne_one [nontrivial B] {R : Type*} [semiring R] [nontrivial R] (f : A →+* R) :
  (minpoly A x).map f ≠ 1 :=
begin
  by_cases hx : is_integral A x,
  { exact mt ((monic hx).eq_one_of_map_eq_one f) (ne_one A x) },
  { rw [eq_zero hx, polynomial.map_zero], exact zero_ne_one },
end

/-- A minimal polynomial is not a unit. -/

lemma mem_range_of_degree_eq_one (hx : (minpoly A x).degree = 1) : x ∈ (algebra_map A B).range :=
begin
  have h : is_integral A x,
  { by_contra h,
    rw [eq_zero h, degree_zero, ←with_bot.coe_one] at hx,
    exact (ne_of_lt (show ⊥ < ↑1, from with_bot.bot_lt_coe 1) hx) },
  have key := minpoly.aeval A x,
  rw [eq_X_add_C_of_degree_eq_one hx, (minpoly.monic h).leading_coeff, C_1, one_mul, aeval_add,
      aeval_C, aeval_X, ←eq_neg_iff_add_eq_zero, ←ring_hom.map_neg] at key,
  exact ⟨-(minpoly A x).coeff 0, key.symm⟩,
end

/-- The defining property of the minimal polynomial of an element `x`:
it is the monic polynomial with smallest degree that has `x` as its root. -/
lemma min {p : A[X]} (pmonic : p.monic) (hp : polynomial.aeval x p = 0) :
  degree (minpoly A x) ≤ degree p :=
begin
  delta minpoly, split_ifs with hx,
  { exact le_of_not_lt (degree_lt_wf.not_lt_min _ hx ⟨pmonic, hp⟩) },
  { simp only [degree_zero, bot_le] }
end

lemma unique' {p : A[X]} (hm : p.monic) (hp : polynomial.aeval x p = 0)
  (hl : ∀ q : A[X], degree q < degree p → q = 0 ∨ polynomial.aeval x q ≠ 0) :
  p = minpoly A x :=
begin
  nontriviality A,
  have hx : is_integral A x := ⟨p, hm, hp⟩,
  obtain h | h := hl _ ((minpoly A x).degree_mod_by_monic_lt hm), swap,
  { exact (h $ (aeval_mod_by_monic_eq_self_of_root hm hp).trans $ aeval A x).elim },
  obtain ⟨r, hr⟩ := (dvd_iff_mod_by_monic_eq_zero hm).1 h,
  rw hr, have hlead := congr_arg leading_coeff hr,
  rw [mul_comm, leading_coeff_mul_monic hm, (monic hx).leading_coeff] at hlead,
  have : nat_degree r ≤ 0,
  { have hr0 : r ≠ 0 := by { rintro rfl, exact ne_zero hx (mul_zero p ▸ hr) },
    apply_fun nat_degree at hr,
    rw hm.nat_degree_mul' hr0 at hr,
    apply nat.le_of_add_le_add_left,
    rw add_zero,
    exact hr.symm.trans_le (nat_degree_le_nat_degree $ min A x hm hp) },
  rw [eq_C_of_nat_degree_le_zero this, ← nat.eq_zero_of_le_zero this,
      ← leading_coeff, ← hlead, C_1, mul_one],
end

@[nontriviality] lemma subsingleton [subsingleton B] : minpoly A x = 1 :=
begin
  nontriviality A,
  have := minpoly.min A x monic_one (subsingleton.elim _ _),
  rw degree_one at this,
  cases le_or_lt (minpoly A x).degree 0 with h h,
  { rwa (monic ⟨1, monic_one, by simp⟩ : (minpoly A x).monic).degree_le_zero_iff_eq_one at h },
  { exact (this.not_lt h).elim },
end

end ring

section comm_ring

variables [comm_ring A]

section ring

variables [ring B] [algebra A B]
variables {x : B}

/-- The degree of a minimal polynomial, as a natural number, is positive. -/
lemma nat_degree_pos [nontrivial B] (hx : is_integral A x) : 0 < nat_degree (minpoly A x) :=
begin
  rw pos_iff_ne_zero,
  intro ndeg_eq_zero,
  have eq_one : minpoly A x = 1,
  { rw eq_C_of_nat_degree_eq_zero ndeg_eq_zero, convert C_1,
    simpa only [ndeg_eq_zero.symm] using (monic hx).leading_coeff },
  simpa only [eq_one, alg_hom.map_one, one_ne_zero] using aeval A x
end

/-- The degree of a minimal polynomial is positive. -/
lemma degree_pos [nontrivial B] (hx : is_integral A x) : 0 < degree (minpoly A x) :=
nat_degree_pos_iff_degree_pos.mp (nat_degree_pos hx)

/-- If `B/A` is an injective ring extension, and `a` is an element of `A`,
then the minimal polynomial of `algebra_map A B a` is `X - C a`. -/
lemma eq_X_sub_C_of_algebra_map_inj
  (a : A) (hf : function.injective (algebra_map A B)) :
  minpoly A (algebra_map A B a) = X - C a :=
begin
  nontriviality A,
  refine (unique' A _ (monic_X_sub_C a) _ _).symm,
  { rw [map_sub, aeval_C, aeval_X, sub_self] },
  simp_rw or_iff_not_imp_left,
  intros q hl h0,
  rw [← nat_degree_lt_nat_degree_iff h0, nat_degree_X_sub_C, nat.lt_one_iff] at hl,
  rw eq_C_of_nat_degree_eq_zero hl at h0 ⊢,
  rwa [aeval_C, map_ne_zero_iff _ hf, ← C_ne_zero],
end

end ring

section is_domain

variables [ring B] [algebra A B]
variables {x : B}

/-- If `a` strictly divides the minimal polynomial of `x`, then `x` cannot be a root for `a`. -/
lemma aeval_ne_zero_of_dvd_not_unit_minpoly {a : A[X]} (hx : is_integral A x)
  (hamonic : a.monic) (hdvd : dvd_not_unit a (minpoly A x)) :
  polynomial.aeval x a ≠ 0 :=
begin
  refine λ ha, (min A x hamonic ha).not_lt (degree_lt_degree _),
  obtain ⟨b, c, hu, he⟩ := hdvd,
  have hcm := hamonic.of_mul_monic_left (he.subst $ monic hx),
  rw [he, hamonic.nat_degree_mul hcm],
  apply nat.lt_add_of_zero_lt_left _ _ (lt_of_not_le $ λ h, hu _),
  rw [eq_C_of_nat_degree_le_zero h, ← nat.eq_zero_of_le_zero h,
      ← leading_coeff, hcm.leading_coeff, C_1],
  exact is_unit_one,
end

variables [is_domain A] [is_domain B]

/-- A minimal polynomial is irreducible. -/
lemma irreducible (hx : is_integral A x) : irreducible (minpoly A x) :=
begin
  refine (irreducible_of_monic (monic hx) $ ne_one A x).2 (λ f g hf hg he, _),
  rw [← hf.is_unit_iff, ← hg.is_unit_iff],
  by_contra' h,
  have heval := congr_arg (polynomial.aeval x) he,
  rw [aeval A x, aeval_mul, mul_eq_zero] at heval,
  cases heval,
  { exact aeval_ne_zero_of_dvd_not_unit_minpoly hx hf ⟨hf.ne_zero, g, h.2, he.symm⟩ heval },
  { refine aeval_ne_zero_of_dvd_not_unit_minpoly hx hg ⟨hg.ne_zero, f, h.1, _⟩ heval,
    rw [mul_comm, he] },
end

end is_domain

end comm_ring

end minpoly


/-
Copyright (c) 2022 Bhavik Mehta All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta, Yaël Dillies
-/
import analysis.convex.cone.basic
import analysis.convex.gauge
import topology.algebra.module.locally_convex

/-!
# Separation Hahn-Banach theorem

In this file we prove the geometric Hahn-Banach theorem. For any two disjoint convex sets, there
exists a continuous linear functional separating them, geometrically meaning that we can intercalate
a plane between them.

We provide many variations to stricten the result under more assumptions on the convex sets:
* `geometric_hahn_banach_open`: One set is open. Weak separation.
* `geometric_hahn_banach_open_point`, `geometric_hahn_banach_point_open`: One set is open, the
  other is a singleton. Weak separation.
* `geometric_hahn_banach_open_open`: Both sets are open. Semistrict separation.
* `geometric_hahn_banach_compact_closed`, `geometric_hahn_banach_closed_compact`: One set is closed,
  the other one is compact. Strict separation.
* `geometric_hahn_banach_point_closed`, `geometric_hahn_banach_closed_point`: One set is closed, the
  other one is a singleton. Strict separation.
* `geometric_hahn_banach_point_point`: Both sets are singletons. Strict separation.

## TODO

* Eidelheit's theorem
* `convex ℝ s → interior (closure s) ⊆ s`
-/

open set
open_locale pointwise

variables {𝕜 E : Type*}

/-- Given a set `s` which is a convex neighbourhood of `0` and a point `x₀` outside of it, there is
a continuous linear functional `f` separating `x₀` and `s`, in the sense that it sends `x₀` to 1 and
all of `s` to values strictly below `1`. -/
lemma separate_convex_open_set [topological_space E] [add_comm_group E] [topological_add_group E]
  [module ℝ E] [has_continuous_smul ℝ E] {s : set E}
  (hs₀ : (0 : E) ∈ s) (hs₁ : convex ℝ s) (hs₂ : is_open s) {x₀ : E} (hx₀ : x₀ ∉ s) :
  ∃ f : E →L[ℝ] ℝ, f x₀ = 1 ∧ ∀ x ∈ s, f x < 1 :=
begin
  let f : E →ₗ.[ℝ] ℝ :=
    linear_pmap.mk_span_singleton x₀ 1 (ne_of_mem_of_not_mem hs₀ hx₀).symm,
  obtain ⟨φ, hφ₁, hφ₂⟩ := exists_extension_of_le_sublinear f (gauge s)
    (λ c hc, gauge_smul_of_nonneg hc.le)
    (gauge_add_le hs₁ $ absorbent_nhds_zero $ hs₂.mem_nhds hs₀) _,
  have hφ₃ : φ x₀ = 1,
  { rw [←submodule.coe_mk x₀ (submodule.mem_span_singleton_self _), hφ₁,
      linear_pmap.mk_span_singleton'_apply_self] },
  have hφ₄ : ∀ x ∈ s, φ x < 1,
  { exact λ x hx, (hφ₂ x).trans_lt (gauge_lt_one_of_mem_of_open hs₁ hs₀ hs₂ hx) },
  { refine ⟨⟨φ, _⟩, hφ₃, hφ₄⟩,
    refine φ.continuous_of_nonzero_on_open _ (hs₂.vadd (-x₀)) (nonempty.vadd_set ⟨0, hs₀⟩)
      (vadd_set_subset_iff.mpr $ λ x hx, _),
    change φ (-x₀ + x) ≠ 0,
    rw [map_add, map_neg],
    specialize hφ₄ x hx,
    linarith },
  rintro ⟨x, hx⟩,
  obtain ⟨y, rfl⟩ := submodule.mem_span_singleton.1 hx,
  rw linear_pmap.mk_span_singleton'_apply,
  simp only [mul_one, algebra.id.smul_eq_mul, submodule.coe_mk],
  obtain h | h := le_or_lt y 0,
  { exact h.trans (gauge_nonneg _) },
  { rw [gauge_smul_of_nonneg h.le, smul_eq_mul, le_mul_iff_one_le_right h],
    exact one_le_gauge_of_not_mem (hs₁.star_convex hs₀)
      (absorbent_nhds_zero $ hs₂.mem_nhds hs₀).absorbs hx₀,
    apply_instance }
end

variables [topological_space E] [add_comm_group E] [topological_add_group E] [module ℝ E]
  [has_continuous_smul ℝ E] {s t : set E} {x y : E}

/-- A version of the **Hahn-Banach theorem**: given disjoint convex sets `s`, `t` where `s` is open,
there is a continuous linear functional which separates them. -/
theorem geometric_hahn_banach_open (hs₁ : convex ℝ s) (hs₂ : is_open s) (ht : convex ℝ t)
  (disj : disjoint s t) :
  ∃ (f : E →L[ℝ] ℝ) (u : ℝ), (∀ a ∈ s, f a < u) ∧ ∀ b ∈ t, u ≤ f b :=
begin
  obtain rfl | ⟨a₀, ha₀⟩ := s.eq_empty_or_nonempty,
  { exact ⟨0, 0, by simp, λ b hb, le_rfl⟩ },
  obtain rfl | ⟨b₀, hb₀⟩ := t.eq_empty_or_nonempty,
  { exact ⟨0, 1, λ a ha, zero_lt_one, by simp⟩ },
  let x₀ := b₀ - a₀,
  let C := x₀ +ᵥ (s - t),
  have : (0:E) ∈ C := ⟨a₀ - b₀, sub_mem_sub ha₀ hb₀,
    by rw [vadd_eq_add, sub_add_sub_cancel', sub_self]⟩,
  have : convex ℝ C := (hs₁.sub ht).vadd _,
  have : x₀ ∉ C,
  { intro hx₀,
    rw ←add_zero x₀ at hx₀,
    exact disj.zero_not_mem_sub_set (vadd_mem_vadd_set_iff.1 hx₀) },
  obtain ⟨f, hf₁, hf₂⟩ := separate_convex_open_set ‹0 ∈ C› ‹_› (hs₂.sub_right.vadd _) ‹x₀ ∉ C›,
  have : f b₀ = f a₀ + 1 := by simp [←hf₁],
  have forall_le : ∀ (a ∈ s) (b ∈ t), f a ≤ f b,
  { intros a ha b hb,
    have := hf₂ (x₀ + (a - b)) (vadd_mem_vadd_set $ sub_mem_sub ha hb),
    simp only [f.map_add, f.map_sub, hf₁] at this,
    linarith },
  refine ⟨f, Inf (f '' t), image_subset_iff.1 (_ : f '' s ⊆ Iio (Inf (f '' t))), λ b hb, _⟩,
  { rw ←interior_Iic,
    refine interior_maximal (image_subset_iff.2 $ λ a ha, _) (f.is_open_map_of_ne_zero _ _ hs₂),
    { exact le_cInf (nonempty.image _ ⟨_, hb₀⟩) (ball_image_of_ball $ forall_le _ ha) },
    { rintro rfl,
      simpa using hf₁ } },
  { exact cInf_le ⟨f a₀, ball_image_of_ball $ forall_le _ ha₀⟩ (mem_image_of_mem _ hb) }
end

theorem geometric_hahn_banach_open_point (hs₁ : convex ℝ s) (hs₂ : is_open s) (disj : x ∉ s) :
  ∃ f : E →L[ℝ] ℝ, ∀ a ∈ s, f a < f x :=
let ⟨f, s, hs, hx⟩ := geometric_hahn_banach_open hs₁ hs₂ (convex_singleton x)
  (disjoint_singleton_right.2 disj)
  in ⟨f, λ a ha, lt_of_lt_of_le (hs a ha) (hx x (mem_singleton _))⟩

theorem geometric_hahn_banach_point_open (ht₁ : convex ℝ t) (ht₂ : is_open t) (disj : x ∉ t) :
  ∃ f : E →L[ℝ] ℝ, ∀ b ∈ t, f x < f b :=
let ⟨f, hf⟩ := geometric_hahn_banach_open_point ht₁ ht₂ disj in ⟨-f, by simpa⟩

theorem geometric_hahn_banach_open_open (hs₁ : convex ℝ s) (hs₂ : is_open s) (ht₁ : convex ℝ t)
  (ht₃ : is_open t) (disj : disjoint s t) :
  ∃ (f : E →L[ℝ] ℝ) (u : ℝ), (∀ a ∈ s, f a < u) ∧ ∀ b ∈ t, u < f b :=
begin
  obtain (rfl | ⟨a₀, ha₀⟩) := s.eq_empty_or_nonempty,
  { exact ⟨0, -1, by simp, λ b hb, by norm_num⟩ },
  obtain (rfl | ⟨b₀, hb₀⟩) := t.eq_empty_or_nonempty,
  { exact ⟨0, 1, λ a ha, by norm_num, by simp⟩ },
  obtain ⟨f, s, hf₁, hf₂⟩ := geometric_hahn_banach_open hs₁ hs₂ ht₁ disj,
  have hf : is_open_map f,
  { refine f.is_open_map_of_ne_zero _,
    rintro rfl,
    exact (hf₁ _ ha₀).not_le (hf₂ _ hb₀) },
  refine ⟨f, s, hf₁, image_subset_iff.1 (_ : f '' t ⊆ Ioi s)⟩,
  rw ←interior_Ici,
  refine interior_maximal (image_subset_iff.2 hf₂) (f.is_open_map_of_ne_zero _ _ ht₃),
  rintro rfl,
  exact (hf₁ _ ha₀).not_le (hf₂ _ hb₀),
end

variables [locally_convex_space ℝ E]

/-- A version of the **Hahn-Banach theorem**: given disjoint convex sets `s`, `t` where `s` is
compact and `t` is closed, there is a continuous linear functional which strongly separates them. -/
theorem geometric_hahn_banach_compact_closed (hs₁ : convex ℝ s) (hs₂ : is_compact s)
  (ht₁ : convex ℝ t) (ht₂ : is_closed t) (disj : disjoint s t) :
  ∃ (f : E →L[ℝ] ℝ) (u v : ℝ), (∀ a ∈ s, f a < u) ∧ u < v ∧ ∀ b ∈ t, v < f b :=
begin
  obtain rfl | hs := s.eq_empty_or_nonempty,
  { exact ⟨0, -2, -1, by simp, by norm_num, λ b hb, by norm_num⟩ },
  unfreezingI { obtain rfl | ht := t.eq_empty_or_nonempty },
  { exact ⟨0, 1, 2, λ a ha, by norm_num, by norm_num, by simp⟩ },
  obtain ⟨U, V, hU, hV, hU₁, hV₁, sU, tV, disj'⟩ := disj.exists_open_convexes hs₁ hs₂ ht₁ ht₂,
  obtain ⟨f, u, hf₁, hf₂⟩ := geometric_hahn_banach_open_open hU₁ hU hV₁ hV disj',
  obtain ⟨x, hx₁, hx₂⟩ := hs₂.exists_forall_ge hs f.continuous.continuous_on,
  have : f x < u := hf₁ x (sU hx₁),
  exact ⟨f, (f x + u)/2, u, λ a ha, by linarith [hx₂ a ha], by linarith, λ b hb, hf₂ b (tV hb)⟩,
end

/-- A version of the **Hahn-Banach theorem**: given disjoint convex sets `s`, `t` where `s` is
closed, and `t` is compact, there is a continuous linear functional which strongly separates them.
-/
theorem geometric_hahn_banach_closed_compact (hs₁ : convex ℝ s) (hs₂ : is_closed s)
  (ht₁ : convex ℝ t) (ht₂ : is_compact t) (disj : disjoint s t) :
  ∃ (f : E →L[ℝ] ℝ) (u v : ℝ), (∀ a ∈ s, f a < u) ∧ u < v ∧ ∀ b ∈ t, v < f b :=
let ⟨f, s, t, hs, st, ht⟩ := geometric_hahn_banach_compact_closed ht₁ ht₂ hs₁ hs₂ disj.symm in
⟨-f, -t, -s, by simpa using ht, by simpa using st, by simpa using hs⟩

theorem geometric_hahn_banach_point_closed (ht₁ : convex ℝ t) (ht₂ : is_closed t) (disj : x ∉ t) :
  ∃ (f : E →L[ℝ] ℝ) (u : ℝ), f x < u ∧ ∀ b ∈ t, u < f b :=
let ⟨f, u, v, ha, hst, hb⟩ := geometric_hahn_banach_compact_closed (convex_singleton x)
  is_compact_singleton ht₁ ht₂ (disjoint_singleton_left.2 disj)
  in ⟨f, v, hst.trans' $ ha x $ mem_singleton _, hb⟩

theorem geometric_hahn_banach_closed_point (hs₁ : convex ℝ s) (hs₂ : is_closed s) (disj : x ∉ s) :
  ∃ (f : E →L[ℝ] ℝ) (u : ℝ), (∀ a ∈ s, f a < u) ∧ u < f x :=
let ⟨f, s, t, ha, hst, hb⟩ := geometric_hahn_banach_closed_compact hs₁ hs₂ (convex_singleton x)
  is_compact_singleton (disjoint_singleton_right.2 disj)
  in ⟨f, s, ha, hst.trans $ hb x $ mem_singleton _⟩

/-- See also `normed_space.eq_iff_forall_dual_eq`. -/
theorem geometric_hahn_banach_point_point [t1_space E] (hxy : x ≠ y) :
  ∃ (f : E →L[ℝ] ℝ), f x < f y :=
begin
  obtain ⟨f, s, t, hs, st, ht⟩ :=
    geometric_hahn_banach_compact_closed (convex_singleton x) is_compact_singleton
      (convex_singleton y) is_closed_singleton (disjoint_singleton.2 hxy),
  exact ⟨f, by linarith [hs x rfl, ht y rfl]⟩,
end

/-- A closed convex set is the intersection of the halfspaces containing it. -/
lemma Inter_halfspaces_eq (hs₁ : convex ℝ s) (hs₂ : is_closed s) :
  (⋂ (l : E →L[ℝ] ℝ), {x | ∃ y ∈ s, l x ≤ l y}) = s :=
begin
  rw set.Inter_set_of,
  refine set.subset.antisymm (λ x hx, _) (λ x hx l, ⟨x, hx, le_rfl⟩),
  by_contra,
  obtain ⟨l, s, hlA, hl⟩ := geometric_hahn_banach_closed_point hs₁ hs₂ h,
  obtain ⟨y, hy, hxy⟩ := hx l,
  exact ((hxy.trans_lt (hlA y hy)).trans hl).not_le le_rfl,
end


/-
Copyright (c) 2014 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Jeremy Avigad

Weak orders "≤", strict orders "<", and structures that include both.
-/
import logic.eq logic.connectives algebra.binary algebra.priority
open eq eq.ops function

variables {A : Type}

/- weak orders -/

structure weak_order [class] (A : Type) extends has_le A :=
(le_refl : ∀a, le a a)
(le_trans : ∀a b c, le a b → le b c → le a c)
(le_antisymm : ∀a b, le a b → le b a → a = b)

section
  variables [weak_order A]

  theorem le.refl [refl] (a : A) : a ≤ a := !weak_order.le_refl

  theorem le_of_eq {a b : A} (H : a = b) : a ≤ b := H ▸ le.refl a

  theorem le.trans [trans] {a b c : A} : a ≤ b → b ≤ c → a ≤ c := !weak_order.le_trans

  theorem ge.trans [trans] {a b c : A} (H1 : a ≥ b) (H2: b ≥ c) : a ≥ c := le.trans H2 H1

  theorem le.antisymm {a b : A} : a ≤ b → b ≤ a → a = b := !weak_order.le_antisymm

  -- Alternate syntax. (Abbreviations do not migrate well.)
  theorem eq_of_le_of_ge {a b : A} : a ≤ b → b ≤ a → a = b := !le.antisymm
end

structure linear_weak_order [class] (A : Type) extends weak_order A :=
(le_total : ∀a b, le a b ∨ le b a)

section
  variables [linear_weak_order A]

  theorem le.total (a b : A) : a ≤ b ∨ b ≤ a := !linear_weak_order.le_total

  theorem le_of_not_ge {a b : A} (H : ¬ a ≥ b) : a ≤ b := or.resolve_left !le.total H

  theorem le_by_cases (a b : A) {P : Prop} (H1 : a ≤ b → P) (H2 : b ≤ a → P) : P :=
  begin
    cases (le.total a b) with H H,
    { exact H1 H},
    { exact H2 H}
  end
end

/- strict orders -/

structure strict_order [class] (A : Type) extends has_lt A :=
(lt_irrefl : ∀a, ¬ lt a a)
(lt_trans : ∀a b c, lt a b → lt b c → lt a c)

section
  variable [strict_order A]

  theorem lt.irrefl (a : A) : ¬ a < a := !strict_order.lt_irrefl
  theorem not_lt_self (a : A) : ¬ a < a := !lt.irrefl   -- alternate syntax

  theorem lt_self_iff_false (a : A) : a < a ↔ false :=
  iff_false_intro (lt.irrefl a)

  theorem lt.trans [trans] {a b c : A} : a < b → b < c → a < c := !strict_order.lt_trans

  theorem gt.trans [trans] {a b c : A} (H1 : a > b) (H2: b > c) : a > c := lt.trans H2 H1

  theorem ne_of_lt {a b : A} (lt_ab : a < b) : a ≠ b :=
  assume eq_ab : a = b,
  show false, from lt.irrefl b (eq_ab ▸ lt_ab)

  theorem ne_of_gt {a b : A} (gt_ab : a > b) : a ≠ b :=
  ne.symm (ne_of_lt gt_ab)

  theorem lt.asymm {a b : A} (H : a < b) : ¬ b < a :=
  assume H1 : b < a, lt.irrefl _ (lt.trans H H1)

  theorem not_lt_of_gt {a b : A} (H : a > b) : ¬ a < b := !lt.asymm H    -- alternate syntax
end

/- well-founded orders -/

structure wf_strict_order [class] (A : Type) extends strict_order A :=
(wf_rec : ∀P : A → Type, (∀x, (∀y, lt y x → P y) → P x) → ∀x, P x)

definition wf.rec_on {A : Type} [s : wf_strict_order A] {P : A → Type}
    (x : A) (H : ∀x, (∀y, wf_strict_order.lt y x → P y) → P x) : P x :=
wf_strict_order.wf_rec P H x

theorem wf.ind_on.{u v} {A : Type.{u}} [s : wf_strict_order.{u 0} A] {P : A → Prop}
    (x : A) (H : ∀x, (∀y, wf_strict_order.lt y x → P y) → P x) : P x :=
wf.rec_on x H

/- structures with a weak and a strict order -/

structure order_pair [class] (A : Type) extends weak_order A, has_lt A :=
(le_of_lt : ∀ a b, lt a b → le a b)
(lt_of_lt_of_le : ∀ a b c, lt a b → le b c → lt a c)
(lt_of_le_of_lt : ∀ a b c, le a b → lt b c → lt a c)
(lt_irrefl : ∀ a, ¬ lt a a)

section
  variable [s : order_pair A]
  variables {a b c : A}
  include s

  theorem le_of_lt : a < b → a ≤ b := !order_pair.le_of_lt

  theorem lt_of_lt_of_le [trans] : a < b → b ≤ c → a < c := !order_pair.lt_of_lt_of_le

  theorem lt_of_le_of_lt [trans] : a ≤ b → b < c → a < c := !order_pair.lt_of_le_of_lt

  private theorem lt_irrefl (s' : order_pair A) (a : A) : ¬ a < a := !order_pair.lt_irrefl

  private theorem lt_trans (s' : order_pair A) (a b c: A) (lt_ab : a < b) (lt_bc : b < c) : a < c :=
    lt_of_lt_of_le lt_ab (le_of_lt lt_bc)

  definition order_pair.to_strict_order [trans_instance] : strict_order A :=
  ⦃ strict_order, s, lt_irrefl := lt_irrefl s, lt_trans := lt_trans s ⦄

  theorem gt_of_gt_of_ge [trans] (H1 : a > b) (H2 : b ≥ c) : a > c := lt_of_le_of_lt H2 H1

  theorem gt_of_ge_of_gt [trans] (H1 : a ≥ b) (H2 : b > c) : a > c := lt_of_lt_of_le H2 H1

  theorem not_le_of_gt (H : a > b) : ¬ a ≤ b :=
  assume H1 : a ≤ b,
  lt.irrefl _ (lt_of_lt_of_le H H1)

  theorem not_lt_of_ge (H : a ≥ b) : ¬ a < b :=
  assume H1 : a < b,
  lt.irrefl _ (lt_of_le_of_lt H H1)

end

structure strong_order_pair [class] (A : Type) extends weak_order A, has_lt A :=
(le_iff_lt_or_eq : ∀a b, le a b ↔ lt a b ∨ a = b)
(lt_irrefl : ∀ a, ¬ lt a a)

section strong_order_pair
  variable [strong_order_pair A]

  theorem le_iff_lt_or_eq {a b : A} : a ≤ b ↔ a < b ∨ a = b :=
  !strong_order_pair.le_iff_lt_or_eq

  theorem lt_or_eq_of_le {a b : A} (le_ab : a ≤ b) : a < b ∨ a = b :=
  iff.mp le_iff_lt_or_eq le_ab

  theorem le_of_lt_or_eq {a b : A} (lt_or_eq : a < b ∨ a = b) : a ≤ b :=
  iff.mpr le_iff_lt_or_eq lt_or_eq

  private theorem lt_irrefl' (a : A) : ¬ a < a :=
  !strong_order_pair.lt_irrefl

  private theorem le_of_lt' (a b : A) : a < b → a ≤ b :=
  take Hlt, le_of_lt_or_eq (or.inl Hlt)

  private theorem lt_iff_le_and_ne {a b : A} : a < b ↔ (a ≤ b ∧ a ≠ b) :=
  iff.intro
    (take Hlt, and.intro (le_of_lt_or_eq (or.inl Hlt)) (take Hab, absurd (Hab ▸ Hlt) !lt_irrefl'))
    (take Hand,
     have Hor : a < b ∨ a = b, from lt_or_eq_of_le (and.left Hand),
     or_resolve_left Hor (and.right Hand))

  theorem lt_of_le_of_ne {a b : A} : a ≤ b → a ≠ b → a < b :=
  take H1 H2, iff.mpr lt_iff_le_and_ne (and.intro H1 H2)

  private theorem ne_of_lt' {a b : A} (H : a < b) : a ≠ b :=
  and.right ((iff.mp lt_iff_le_and_ne) H)

  private theorem lt_of_lt_of_le' (a b c : A) : a < b → b ≤ c → a < c :=
  assume lt_ab : a < b,
  assume le_bc : b ≤ c,
  have le_ac : a ≤ c, from le.trans (le_of_lt' _ _ lt_ab) le_bc,
  have ne_ac : a ≠ c, from
    assume eq_ac : a = c,
    have le_ba : b ≤ a, from eq_ac⁻¹ ▸ le_bc,
    have eq_ab : a = b, from le.antisymm  (le_of_lt' _ _ lt_ab) le_ba,
    show false, from ne_of_lt' lt_ab eq_ab,
  show a < c, from iff.mpr (lt_iff_le_and_ne) (and.intro le_ac ne_ac)

  theorem lt_of_le_of_lt' (a b c : A) : a ≤ b → b < c → a < c :=
  assume le_ab : a ≤ b,
  assume lt_bc : b < c,
  have le_ac : a ≤ c, from le.trans le_ab (le_of_lt' _ _ lt_bc),
  have ne_ac : a ≠ c, from
    assume eq_ac : a = c,
    have le_cb : c ≤ b, from eq_ac ▸ le_ab,
    have eq_bc : b = c, from le.antisymm  (le_of_lt' _ _ lt_bc) le_cb,
    show false, from ne_of_lt' lt_bc eq_bc,
  show a < c, from iff.mpr (lt_iff_le_and_ne) (and.intro le_ac ne_ac)
end strong_order_pair

definition strong_order_pair.to_order_pair [trans_instance]
    [s : strong_order_pair A] : order_pair A :=
⦃ order_pair, s,
  lt_irrefl := lt_irrefl',
  le_of_lt := le_of_lt',
  lt_of_le_of_lt := lt_of_le_of_lt',
  lt_of_lt_of_le := lt_of_lt_of_le' ⦄

/- linear orders -/

structure linear_order_pair [class] (A : Type) extends order_pair A, linear_weak_order A

structure linear_strong_order_pair [class] (A : Type) extends strong_order_pair A,
    linear_weak_order A

definition linear_strong_order_pair.to_linear_order_pair [trans_instance]
    [s : linear_strong_order_pair A] : linear_order_pair A :=
⦃ linear_order_pair, s, strong_order_pair.to_order_pair ⦄

section
  variable [linear_strong_order_pair A]
  variables (a b c : A)

  theorem lt.trichotomy : a < b ∨ a = b ∨ b < a :=
  or.elim (le.total a b)
    (assume H : a ≤ b,
      or.elim (iff.mp !le_iff_lt_or_eq H) (assume H1, or.inl H1) (assume H1, or.inr (or.inl H1)))
    (assume H : b ≤ a,
      or.elim (iff.mp !le_iff_lt_or_eq H)
        (assume H1, or.inr (or.inr H1))
        (assume H1, or.inr (or.inl (H1⁻¹))))

  theorem lt.by_cases {a b : A} {P : Prop}
    (H1 : a < b → P) (H2 : a = b → P) (H3 : b < a → P) : P :=
  or.elim !lt.trichotomy
    (assume H, H1 H)
    (assume H, or.elim H (assume H', H2 H') (assume H', H3 H'))

  definition lt_ge_by_cases {a b : A} {P : Prop} (H1 : a < b → P) (H2 : a ≥ b → P) : P :=
  lt.by_cases H1 (λH, H2 (H ▸ le.refl a)) (λH, H2 (le_of_lt H))

  theorem le_of_not_gt {a b : A} (H : ¬ a > b) : a ≤ b :=
  lt.by_cases (assume H', absurd H' H) (assume H', H' ▸ !le.refl) (assume H', le_of_lt H')

  theorem lt_of_not_ge {a b : A} (H : ¬ a ≥ b) : a < b :=
  lt.by_cases
    (assume H', absurd (le_of_lt H') H)
    (assume H', absurd (H' ▸ !le.refl) H)
    (assume H', H')

  theorem lt_iff_not_ge : a < b ↔ ¬ a ≥ b :=
  iff.intro
    (suppose a < b, not_le_of_gt this)
    (suppose ¬ a ≥ b, lt_of_not_ge this)

  theorem le_iff_not_gt : a ≤ b ↔ ¬ a > b :=
  iff.intro
    (suppose a ≤ b, not_lt_of_ge this)
    (suppose ¬ a > b, le_of_not_gt this)

  theorem gt_iff_not_le : a > b ↔ ¬ a ≤ b :=
  iff.intro
    (suppose a > b, not_le_of_gt this)
    (suppose ¬ a ≤ b, lt_of_not_ge this)

  theorem ge_iff_not_lt : a ≥ b ↔ ¬ a < b :=
  iff.intro
    (suppose a ≥ b, not_lt_of_ge this)
    (suppose ¬ a < b, le_of_not_gt this)

  theorem lt_or_ge : a < b ∨ a ≥ b :=
  lt.by_cases
    (assume H1 : a < b, or.inl H1)
    (assume H1 : a = b, or.inr (H1 ▸ le.refl a))
    (assume H1 : a > b, or.inr (le_of_lt H1))

  theorem le_or_gt : a ≤ b ∨ a > b :=
  !or.swap (lt_or_ge b a)

  theorem lt_or_gt_of_ne {a b : A} (H : a ≠ b) : a < b ∨ a > b :=
  lt.by_cases (assume H1, or.inl H1) (assume H1, absurd H1 H) (assume H1, or.inr H1)
end

open decidable

structure decidable_linear_order [class] (A : Type) extends linear_strong_order_pair A :=
(decidable_lt : decidable_rel lt)

section
  variable [s : decidable_linear_order A]
  variables (a b c d : A)
  include s
  open decidable

  definition decidable_lt [instance] : decidable (a < b) :=
    @decidable_linear_order.decidable_lt _ _ _ _

  definition decidable_le [instance] : decidable (a ≤ b) :=
  by_cases
    (assume H : a < b, inl (le_of_lt H))
    (assume H : ¬ a < b,
      have H1 : b ≤ a, from le_of_not_gt H,
      by_cases
        (assume H2 : b < a, inr (not_le_of_gt H2))
        (assume H2 : ¬ b < a, inl (le_of_not_gt H2)))

  variables {a b c d}

  definition has_decidable_eq [instance] : decidable (a = b) :=
  by_cases
    (assume H : a ≤ b,
      by_cases
        (assume H1 : b ≤ a, inl (le.antisymm H H1))
        (assume H1 : ¬ b ≤ a, inr (assume H2 : a = b, H1 (H2 ▸ le.refl a))))
    (assume H : ¬ a ≤ b,
      (inr (assume H1 : a = b, H (H1 ▸ !le.refl))))

  theorem eq_or_lt_of_not_lt {a b : A} (H : ¬ a < b) : a = b ∨ b < a :=
    if Heq : a = b then or.inl Heq else or.inr (lt_of_not_ge (λ Hge, H (lt_of_le_of_ne Hge Heq)))

  theorem eq_or_lt_of_le {a b : A} (H : a ≤ b) : a = b ∨ a < b :=
    begin
      cases eq_or_lt_of_not_lt (not_lt_of_ge H),
      exact or.inl a_1⁻¹,
      exact or.inr a_1
    end

  -- testing equality first may result in more definitional equalities
  definition lt.cases {B : Type} (a b : A) (t_lt t_eq t_gt : B) : B :=
  if a = b then t_eq else (if a < b then t_lt else t_gt)

  theorem lt.cases_of_eq {B : Type} {a b : A} {t_lt t_eq t_gt : B} (H : a = b) :
    lt.cases a b t_lt t_eq t_gt = t_eq := if_pos H

  theorem lt.cases_of_lt {B : Type} {a b : A} {t_lt t_eq t_gt : B} (H : a < b) :
    lt.cases a b t_lt t_eq t_gt = t_lt :=
  if_neg (ne_of_lt H) ⬝ if_pos H

  theorem lt.cases_of_gt {B : Type} {a b : A} {t_lt t_eq t_gt : B} (H : a > b) :
    lt.cases a b t_lt t_eq t_gt = t_gt :=
  if_neg (ne.symm (ne_of_lt H)) ⬝ if_neg (lt.asymm H)

  definition min (a b : A) : A := if a ≤ b then a else b
  definition max (a b : A) : A := if a ≤ b then b else a

  /- these show min and max form a lattice -/

  theorem min_le_left (a b : A) : min a b ≤ a :=
  by_cases
    (assume H : a ≤ b, by rewrite [↑min, if_pos H])
    (assume H : ¬ a ≤ b, by rewrite [↑min, if_neg H]; apply le_of_lt (lt_of_not_ge H))

  theorem min_le_right (a b : A) : min a b ≤ b :=
  by_cases
    (assume H : a ≤ b, by rewrite [↑min, if_pos H]; apply H)
    (assume H : ¬ a ≤ b, by rewrite [↑min, if_neg H])

  theorem le_min {a b c : A} (H₁ : c ≤ a) (H₂ : c ≤ b) : c ≤ min a b :=
  by_cases
    (assume H : a ≤ b, by rewrite [↑min, if_pos H]; apply H₁)
    (assume H : ¬ a ≤ b, by rewrite [↑min, if_neg H]; apply H₂)

  theorem le_max_left (a b : A) : a ≤ max a b :=
  by_cases
    (assume H : a ≤ b, by rewrite [↑max, if_pos H]; apply H)
    (assume H : ¬ a ≤ b, by rewrite [↑max, if_neg H])

  theorem le_max_right (a b : A) : b ≤ max a b :=
  by_cases
    (assume H : a ≤ b, by rewrite [↑max, if_pos H])
    (assume H : ¬ a ≤ b, by rewrite [↑max, if_neg H]; apply le_of_lt (lt_of_not_ge H))

  theorem max_le {a b c : A} (H₁ : a ≤ c) (H₂ : b ≤ c) : max a b ≤ c :=
  by_cases
    (assume H : a ≤ b, by rewrite [↑max, if_pos H]; apply H₂)
    (assume H : ¬ a ≤ b, by rewrite [↑max, if_neg H]; apply H₁)

  theorem le_max_left_iff_true (a b : A) : a ≤ max a b ↔ true :=
  iff_true_intro (le_max_left a b)

  theorem le_max_right_iff_true (a b : A) : b ≤ max a b ↔ true :=
  iff_true_intro (le_max_right a b)

  /- these are also proved for lattices, but with inf and sup in place of min and max -/

  theorem eq_min {a b c : A} (H₁ : c ≤ a) (H₂ : c ≤ b) (H₃ : ∀{d}, d ≤ a → d ≤ b → d ≤ c) :
    c = min a b :=
  le.antisymm (le_min H₁ H₂) (H₃ !min_le_left !min_le_right)

  theorem min.comm (a b : A) : min a b = min b a :=
  eq_min !min_le_right !min_le_left (λ c H₁ H₂, le_min H₂ H₁)

  theorem min.assoc (a b c : A) : min (min a b) c = min a (min b c) :=
  begin
    apply eq_min,
    { apply le.trans, apply min_le_left, apply min_le_left },
    { apply le_min, apply le.trans, apply min_le_left, apply min_le_right, apply min_le_right },
    { intros [d, H₁, H₂], apply le_min, apply le_min H₁, apply le.trans H₂, apply min_le_left,
      apply le.trans H₂, apply min_le_right }
  end

  theorem min.left_comm (a b c : A) : min a (min b c) = min b (min a c) :=
  binary.left_comm (@min.comm A s) (@min.assoc A s) a b c

  theorem min.right_comm (a b c : A) : min (min a b) c = min (min a c) b :=
  binary.right_comm (@min.comm A s) (@min.assoc A s) a b c

  theorem min_self (a : A) : min a a = a :=
  by apply eq.symm; apply eq_min (le.refl a) !le.refl; intros; assumption

  theorem min_eq_left {a b : A} (H : a ≤ b) : min a b = a :=
  by apply eq.symm; apply eq_min !le.refl H; intros; assumption

  theorem min_eq_right {a b : A} (H : b ≤ a) : min a b = b :=
  eq.subst !min.comm (min_eq_left H)

  theorem eq_max {a b c : A} (H₁ : a ≤ c) (H₂ : b ≤ c) (H₃ : ∀{d}, a ≤ d → b ≤ d → c ≤ d) :
    c = max a b :=
  le.antisymm (H₃ !le_max_left !le_max_right) (max_le H₁ H₂)

  theorem max.comm (a b : A) : max a b = max b a :=
  eq_max !le_max_right !le_max_left (λ c H₁ H₂, max_le H₂ H₁)

  theorem max.assoc (a b c : A) : max (max a b) c = max a (max b c) :=
  begin
    apply eq_max,
    { apply le.trans, apply le_max_left a b, apply le_max_left },
    { apply max_le, apply le.trans, apply le_max_right a b, apply le_max_left, apply le_max_right },
    { intros [d, H₁, H₂], apply max_le, apply max_le H₁, apply le.trans !le_max_left H₂,
      apply le.trans !le_max_right H₂}
  end

  theorem max.left_comm (a b c : A) : max a (max b c) = max b (max a c) :=
  binary.left_comm (@max.comm A s) (@max.assoc A s) a b c

  theorem max.right_comm (a b c : A) : max (max a b) c = max (max a c) b :=
  binary.right_comm (@max.comm A s) (@max.assoc A s) a b c

  theorem max_self (a : A) : max a a = a :=
  by apply eq.symm; apply eq_max (le.refl a) !le.refl; intros; assumption

  theorem max_eq_left {a b : A} (H : b ≤ a) : max a b = a :=
  by apply eq.symm; apply eq_max !le.refl H; intros; assumption

  theorem max_eq_right {a b : A} (H : a ≤ b) : max a b = b :=
  eq.subst !max.comm (max_eq_left H)

  /- these rely on lt_of_lt -/

  theorem min_eq_left_of_lt {a b : A} (H : a < b) : min a b = a :=
  min_eq_left (le_of_lt H)

  theorem min_eq_right_of_lt {a b : A} (H : b < a) : min a b = b :=
  min_eq_right (le_of_lt H)

  theorem max_eq_left_of_lt {a b : A} (H : b < a) : max a b = a :=
  max_eq_left (le_of_lt H)

  theorem max_eq_right_of_lt {a b : A} (H : a < b) : max a b = b :=
  max_eq_right (le_of_lt H)

  /- these use the fact that it is a linear ordering -/

  theorem lt_min {a b c : A} (H₁ : a < b) (H₂ : a < c) : a < min b c :=
  or.elim !le_or_gt
    (assume H : b ≤ c, by rewrite (min_eq_left H); apply H₁)
    (assume H : b > c, by rewrite (min_eq_right_of_lt H); apply H₂)

  theorem max_lt {a b c : A} (H₁ : a < c) (H₂ : b < c) : max a b < c :=
  or.elim !le_or_gt
    (assume H : a ≤ b, by rewrite (max_eq_right H); apply H₂)
    (assume H : a > b, by rewrite (max_eq_left_of_lt H); apply H₁)
end

/- order instances -/

definition weak_order_Prop [instance] : weak_order Prop :=
⦃ weak_order,
  le           := λx y, x → y,
  le_refl      := λx, id,
  le_trans     := λa b c H1 H2 x, H2 (H1 x),
  le_antisymm  := λf g H1 H2, propext (and.intro H1 H2)
⦄

definition weak_order_fun [instance] (A B : Type) [weak_order B] : weak_order (A → B) :=
⦃ weak_order,
  le := λx y, ∀b, x b ≤ y b,
  le_refl := λf b, !le.refl,
  le_trans := λf g h H1 H2 b, !le.trans (H1 b) (H2 b),
  le_antisymm := λf g H1 H2, funext (λb, !le.antisymm (H1 b) (H2 b))
⦄

definition weak_order_dual {A : Type} (wo : weak_order A) : weak_order A :=
⦃ weak_order,
  le := λx y, y ≤ x,
  le_refl := le.refl,
  le_trans := take a b c `b ≤ a` `c ≤ b`, le.trans `c ≤ b` `b ≤ a`,
  le_antisymm := take a b `b ≤ a` `a ≤ b`, le.antisymm `a ≤ b` `b ≤ a` ⦄

lemma le_dual_eq_le {A : Type} (wo : weak_order A) (a b : A) :
  @le _ (@weak_order.to_has_le _ (weak_order_dual wo)) a b =
  @le _ (@weak_order.to_has_le _ wo) b a :=
rfl

-- what to do with the strict variants?


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Johannes Hölzl
-/
import algebra.category.CommRing.basic
import data.mv_polynomial

/-!
Multivariable polynomials on a type is the left adjoint of the
forgetful functor from commutative rings to types.
-/

noncomputable theory

universe u

open mv_polynomial
open category_theory

namespace CommRing

open_locale classical

/--
The free functor `Type u ⥤ CommRing` sending a type `X` to the multivariable (commutative)
polynomials with variables `x : X`.
-/
def free : Type u ⥤ CommRing :=
{ obj := λ α, of (mv_polynomial α ℤ),
  map := λ X Y f,
    (↑(rename f : _ →ₐ[ℤ] _) : (mv_polynomial X ℤ →+* mv_polynomial Y ℤ)),
  -- TODO these next two fields can be done by `tidy`, but the calls in `dsimp` and `simp` it
  -- generates are too slow.
  map_id' := λ X, ring_hom.ext $ rename_id,
  map_comp' := λ X Y Z f g, ring_hom.ext $ λ p, (rename_rename f g p).symm }

@[simp] lemma free_obj_coe {α : Type u} :
  (free.obj α : Type u) = mv_polynomial α ℤ := rfl

@[simp] lemma free_map_coe {α β : Type u} {f : α → β} :
  ⇑(free.map f) = rename f := rfl

/--
The free-forgetful adjunction for commutative rings.
-/
def adj : free ⊣ forget CommRing :=
adjunction.mk_of_hom_equiv
{ hom_equiv := λ X R, hom_equiv,
  hom_equiv_naturality_left_symm' :=
    λ _ _ Y f g, ring_hom.ext $ λ x, eval₂_cast_comp f (int.cast_ring_hom Y) g x }

end CommRing


/-
Copyright (c) 2021 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import analysis.normed.field.basic

/-!
# The integers as normed ring

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

This file contains basic facts about the integers as normed ring.

Recall that `‖n‖` denotes the norm of `n` as real number.
This norm is always nonnegative, so we can bundle the norm together with this fact,
to obtain a term of type `nnreal` (the nonnegative real numbers).
The resulting nonnegative real number is denoted by `‖n‖₊`.
-/

open_locale big_operators

namespace int

lemma norm_coe_units (e : ℤˣ) : ‖(e : ℤ)‖ = 1 :=
by rw [← coe_nnnorm, int.nnnorm_coe_units, nnreal.coe_one]

@[simp] lemma nnnorm_coe_nat (n : ℕ) : ‖(n : ℤ)‖₊ = n := real.nnnorm_coe_nat _

@[simp] lemma to_nat_add_to_nat_neg_eq_nnnorm (n : ℤ) : ↑(n.to_nat) + ↑((-n).to_nat) = ‖n‖₊ :=
by rw [← nat.cast_add, to_nat_add_to_nat_neg_eq_nat_abs, nnreal.coe_nat_abs]

@[simp] lemma to_nat_add_to_nat_neg_eq_norm (n : ℤ) : ↑(n.to_nat) + ↑((-n).to_nat) = ‖n‖ :=
by simpa only [nnreal.coe_nat_cast, nnreal.coe_add]
  using congr_arg (coe : _ → ℝ) (to_nat_add_to_nat_neg_eq_nnnorm n)

end int


/-
Copyright (c) 2020 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anne Baanen

! This file was ported from Lean 3 source module algebra.char_p.invertible
! leanprover-community/mathlib commit 10bf4f825ad729c5653adc039dafa3622e7f93c9
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Invertible
import Mathbin.Algebra.CharP.Basic

/-!
# Invertibility of elements given a characteristic

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

This file includes some instances of `invertible` for specific numbers in
characteristic zero. Some more cases are given as a `def`, to be included only
when needed. To construct instances for concrete numbers,
`invertible_of_nonzero` is a useful definition.
-/

variable {K : Type _}

section Field

variable [Field K]

/- warning: invertible_of_ring_char_not_dvd -> invertibleOfRingCharNotDvd is a dubious translation:
lean 3 declaration is
  forall {K : Type.{u1}} [_inst_1 : Field.{u1} K] {t : Nat}, (Not (Dvd.Dvd.{0} Nat Nat.hasDvd (ringChar.{u1} K (NonAssocRing.toNonAssocSemiring.{u1} K (Ring.toNonAssocRing.{u1} K (DivisionRing.toRing.{u1} K (Field.toDivisionRing.{u1} K _inst_1))))) t)) -> (Invertible.{u1} K (MulZeroClass.toHasMul.{u1} K (MulZeroOneClass.toMulZeroClass.{u1} K (MonoidWithZero.toMulZeroOneClass.{u1} K (GroupWithZero.toMonoidWithZero.{u1} K (DivisionSemiring.toGroupWithZero.{u1} K (Semifield.toDivisionSemiring.{u1} K (Field.toSemifield.{u1} K _inst_1))))))) (MulOneClass.toHasOne.{u1} K (MulZeroOneClass.toMulOneClass.{u1} K (MonoidWithZero.toMulZeroOneClass.{u1} K (GroupWithZero.toMonoidWithZero.{u1} K (DivisionSemiring.toGroupWithZero.{u1} K (Semifield.toDivisionSemiring.{u1} K (Field.toSemifield.{u1} K _inst_1))))))) ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Nat K (HasLiftT.mk.{1, succ u1} Nat K (CoeTCₓ.coe.{1, succ u1} Nat K (Nat.castCoe.{u1} K (AddMonoidWithOne.toNatCast.{u1} K (AddGroupWithOne.toAddMonoidWithOne.{u1} K (AddCommGroupWithOne.toAddGroupWithOne.{u1} K (Ring.toAddCommGroupWithOne.{u1} K (DivisionRing.toRing.{u1} K (Field.toDivisionRing.{u1} K _inst_1))))))))) t))
but is expected to have type
  forall {K : Type.{u1}} [_inst_1 : Field.{u1} K] {t : Nat}, (Not (Dvd.dvd.{0} Nat Nat.instDvdNat (ringChar.{u1} K (NonAssocRing.toNonAssocSemiring.{u1} K (Ring.toNonAssocRing.{u1} K (DivisionRing.toRing.{u1} K (Field.toDivisionRing.{u1} K _inst_1))))) t)) -> (Invertible.{u1} K (NonUnitalNonAssocRing.toMul.{u1} K (NonAssocRing.toNonUnitalNonAssocRing.{u1} K (Ring.toNonAssocRing.{u1} K (DivisionRing.toRing.{u1} K (Field.toDivisionRing.{u1} K _inst_1))))) (NonAssocRing.toOne.{u1} K (Ring.toNonAssocRing.{u1} K (DivisionRing.toRing.{u1} K (Field.toDivisionRing.{u1} K _inst_1)))) (Nat.cast.{u1} K (NonAssocRing.toNatCast.{u1} K (Ring.toNonAssocRing.{u1} K (DivisionRing.toRing.{u1} K (Field.toDivisionRing.{u1} K _inst_1)))) t))
Case conversion may be inaccurate. Consider using '#align invertible_of_ring_char_not_dvd invertibleOfRingCharNotDvdₓ'. -/
/-- A natural number `t` is invertible in a field `K` if the charactistic of `K` does not divide
`t`. -/
def invertibleOfRingCharNotDvd {t : ℕ} (not_dvd : ¬ringChar K ∣ t) : Invertible (t : K) :=
  invertibleOfNonzero fun h => not_dvd ((ringChar.spec K t).mp h)
#align invertible_of_ring_char_not_dvd invertibleOfRingCharNotDvd

/- warning: not_ring_char_dvd_of_invertible -> not_ringChar_dvd_of_invertible is a dubious translation:
lean 3 declaration is
  forall {K : Type.{u1}} [_inst_1 : Field.{u1} K] {t : Nat} [_inst_2 : Invertible.{u1} K (Distrib.toHasMul.{u1} K (Ring.toDistrib.{u1} K (DivisionRing.toRing.{u1} K (Field.toDivisionRing.{u1} K _inst_1)))) (AddMonoidWithOne.toOne.{u1} K (AddGroupWithOne.toAddMonoidWithOne.{u1} K (AddCommGroupWithOne.toAddGroupWithOne.{u1} K (Ring.toAddCommGroupWithOne.{u1} K (DivisionRing.toRing.{u1} K (Field.toDivisionRing.{u1} K _inst_1)))))) ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Nat K (HasLiftT.mk.{1, succ u1} Nat K (CoeTCₓ.coe.{1, succ u1} Nat K (Nat.castCoe.{u1} K (AddMonoidWithOne.toNatCast.{u1} K (AddGroupWithOne.toAddMonoidWithOne.{u1} K (AddCommGroupWithOne.toAddGroupWithOne.{u1} K (Ring.toAddCommGroupWithOne.{u1} K (DivisionRing.toRing.{u1} K (Field.toDivisionRing.{u1} K _inst_1))))))))) t)], Not (Dvd.Dvd.{0} Nat Nat.hasDvd (ringChar.{u1} K (NonAssocRing.toNonAssocSemiring.{u1} K (Ring.toNonAssocRing.{u1} K (DivisionRing.toRing.{u1} K (Field.toDivisionRing.{u1} K _inst_1))))) t)
but is expected to have type
  forall {K : Type.{u1}} [_inst_1 : Field.{u1} K] {t : Nat} [_inst_2 : Invertible.{u1} K (NonUnitalNonAssocRing.toMul.{u1} K (NonAssocRing.toNonUnitalNonAssocRing.{u1} K (Ring.toNonAssocRing.{u1} K (DivisionRing.toRing.{u1} K (Field.toDivisionRing.{u1} K _inst_1))))) (NonAssocRing.toOne.{u1} K (Ring.toNonAssocRing.{u1} K (DivisionRing.toRing.{u1} K (Field.toDivisionRing.{u1} K _inst_1)))) (Nat.cast.{u1} K (NonAssocRing.toNatCast.{u1} K (Ring.toNonAssocRing.{u1} K (DivisionRing.toRing.{u1} K (Field.toDivisionRing.{u1} K _inst_1)))) t)], Not (Dvd.dvd.{0} Nat Nat.instDvdNat (ringChar.{u1} K (NonAssocRing.toNonAssocSemiring.{u1} K (Ring.toNonAssocRing.{u1} K (DivisionRing.toRing.{u1} K (Field.toDivisionRing.{u1} K _inst_1))))) t)
Case conversion may be inaccurate. Consider using '#align not_ring_char_dvd_of_invertible not_ringChar_dvd_of_invertibleₓ'. -/
theorem not_ringChar_dvd_of_invertible {t : ℕ} [Invertible (t : K)] : ¬ringChar K ∣ t :=
  by
  rw [← ringChar.spec, ← Ne.def]
  exact nonzero_of_invertible (t : K)
#align not_ring_char_dvd_of_invertible not_ringChar_dvd_of_invertible

/- warning: invertible_of_char_p_not_dvd -> invertibleOfCharPNotDvd is a dubious translation:
lean 3 declaration is
  forall {K : Type.{u1}} [_inst_1 : Field.{u1} K] {p : Nat} [_inst_2 : CharP.{u1} K (AddGroupWithOne.toAddMonoidWithOne.{u1} K (AddCommGroupWithOne.toAddGroupWithOne.{u1} K (Ring.toAddCommGroupWithOne.{u1} K (DivisionRing.toRing.{u1} K (Field.toDivisionRing.{u1} K _inst_1))))) p] {t : Nat}, (Not (Dvd.Dvd.{0} Nat Nat.hasDvd p t)) -> (Invertible.{u1} K (MulZeroClass.toHasMul.{u1} K (MulZeroOneClass.toMulZeroClass.{u1} K (MonoidWithZero.toMulZeroOneClass.{u1} K (GroupWithZero.toMonoidWithZero.{u1} K (DivisionSemiring.toGroupWithZero.{u1} K (Semifield.toDivisionSemiring.{u1} K (Field.toSemifield.{u1} K _inst_1))))))) (MulOneClass.toHasOne.{u1} K (MulZeroOneClass.toMulOneClass.{u1} K (MonoidWithZero.toMulZeroOneClass.{u1} K (GroupWithZero.toMonoidWithZero.{u1} K (DivisionSemiring.toGroupWithZero.{u1} K (Semifield.toDivisionSemiring.{u1} K (Field.toSemifield.{u1} K _inst_1))))))) ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Nat K (HasLiftT.mk.{1, succ u1} Nat K (CoeTCₓ.coe.{1, succ u1} Nat K (Nat.castCoe.{u1} K (AddMonoidWithOne.toNatCast.{u1} K (AddGroupWithOne.toAddMonoidWithOne.{u1} K (AddCommGroupWithOne.toAddGroupWithOne.{u1} K (Ring.toAddCommGroupWithOne.{u1} K (DivisionRing.toRing.{u1} K (Field.toDivisionRing.{u1} K _inst_1))))))))) t))
but is expected to have type
  forall {K : Type.{u1}} [_inst_1 : Field.{u1} K] {p : Nat} [_inst_2 : CharP.{u1} K (AddGroupWithOne.toAddMonoidWithOne.{u1} K (Ring.toAddGroupWithOne.{u1} K (DivisionRing.toRing.{u1} K (Field.toDivisionRing.{u1} K _inst_1)))) p] {t : Nat}, (Not (Dvd.dvd.{0} Nat Nat.instDvdNat p t)) -> (Invertible.{u1} K (NonUnitalNonAssocRing.toMul.{u1} K (NonAssocRing.toNonUnitalNonAssocRing.{u1} K (Ring.toNonAssocRing.{u1} K (DivisionRing.toRing.{u1} K (Field.toDivisionRing.{u1} K _inst_1))))) (NonAssocRing.toOne.{u1} K (Ring.toNonAssocRing.{u1} K (DivisionRing.toRing.{u1} K (Field.toDivisionRing.{u1} K _inst_1)))) (Nat.cast.{u1} K (NonAssocRing.toNatCast.{u1} K (Ring.toNonAssocRing.{u1} K (DivisionRing.toRing.{u1} K (Field.toDivisionRing.{u1} K _inst_1)))) t))
Case conversion may be inaccurate. Consider using '#align invertible_of_char_p_not_dvd invertibleOfCharPNotDvdₓ'. -/
/-- A natural number `t` is invertible in a field `K` of charactistic `p` if `p` does not divide
`t`. -/
def invertibleOfCharPNotDvd {p : ℕ} [CharP K p] {t : ℕ} (not_dvd : ¬p ∣ t) : Invertible (t : K) :=
  invertibleOfNonzero fun h => not_dvd ((CharP.cast_eq_zero_iff K p t).mp h)
#align invertible_of_char_p_not_dvd invertibleOfCharPNotDvd

/- warning: invertible_of_pos -> invertibleOfPos is a dubious translation:
lean 3 declaration is
  forall {K : Type.{u1}} [_inst_1 : Field.{u1} K] [_inst_2 : CharZero.{u1} K (AddGroupWithOne.toAddMonoidWithOne.{u1} K (AddCommGroupWithOne.toAddGroupWithOne.{u1} K (Ring.toAddCommGroupWithOne.{u1} K (DivisionRing.toRing.{u1} K (Field.toDivisionRing.{u1} K _inst_1)))))] (n : Nat) [_inst_3 : NeZero.{0} Nat Nat.hasZero n], Invertible.{u1} K (MulZeroClass.toHasMul.{u1} K (MulZeroOneClass.toMulZeroClass.{u1} K (MonoidWithZero.toMulZeroOneClass.{u1} K (GroupWithZero.toMonoidWithZero.{u1} K (DivisionSemiring.toGroupWithZero.{u1} K (Semifield.toDivisionSemiring.{u1} K (Field.toSemifield.{u1} K _inst_1))))))) (MulOneClass.toHasOne.{u1} K (MulZeroOneClass.toMulOneClass.{u1} K (MonoidWithZero.toMulZeroOneClass.{u1} K (GroupWithZero.toMonoidWithZero.{u1} K (DivisionSemiring.toGroupWithZero.{u1} K (Semifield.toDivisionSemiring.{u1} K (Field.toSemifield.{u1} K _inst_1))))))) ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Nat K (HasLiftT.mk.{1, succ u1} Nat K (CoeTCₓ.coe.{1, succ u1} Nat K (Nat.castCoe.{u1} K (AddMonoidWithOne.toNatCast.{u1} K (AddGroupWithOne.toAddMonoidWithOne.{u1} K (AddCommGroupWithOne.toAddGroupWithOne.{u1} K (Ring.toAddCommGroupWithOne.{u1} K (DivisionRing.toRing.{u1} K (Field.toDivisionRing.{u1} K _inst_1))))))))) n)
but is expected to have type
  forall {K : Type.{u1}} [_inst_1 : Field.{u1} K] [_inst_2 : CharZero.{u1} K (AddGroupWithOne.toAddMonoidWithOne.{u1} K (Ring.toAddGroupWithOne.{u1} K (DivisionRing.toRing.{u1} K (Field.toDivisionRing.{u1} K _inst_1))))] (n : Nat) [_inst_3 : NeZero.{0} Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero) n], Invertible.{u1} K (NonUnitalNonAssocRing.toMul.{u1} K (NonAssocRing.toNonUnitalNonAssocRing.{u1} K (Ring.toNonAssocRing.{u1} K (DivisionRing.toRing.{u1} K (Field.toDivisionRing.{u1} K _inst_1))))) (NonAssocRing.toOne.{u1} K (Ring.toNonAssocRing.{u1} K (DivisionRing.toRing.{u1} K (Field.toDivisionRing.{u1} K _inst_1)))) (Nat.cast.{u1} K (NonAssocRing.toNatCast.{u1} K (Ring.toNonAssocRing.{u1} K (DivisionRing.toRing.{u1} K (Field.toDivisionRing.{u1} K _inst_1)))) n)
Case conversion may be inaccurate. Consider using '#align invertible_of_pos invertibleOfPosₓ'. -/
-- warning: this could potentially loop with `ne_zero.invertible` - if there is weird type-class
-- loops, watch out for that.
instance invertibleOfPos [CharZero K] (n : ℕ) [NeZero n] : Invertible (n : K) :=
  invertibleOfNonzero <| NeZero.out
#align invertible_of_pos invertibleOfPos

end Field

section DivisionRing

variable [DivisionRing K] [CharZero K]

/- warning: invertible_succ -> invertibleSucc is a dubious translation:
lean 3 declaration is
  forall {K : Type.{u1}} [_inst_1 : DivisionRing.{u1} K] [_inst_2 : CharZero.{u1} K (AddGroupWithOne.toAddMonoidWithOne.{u1} K (AddCommGroupWithOne.toAddGroupWithOne.{u1} K (Ring.toAddCommGroupWithOne.{u1} K (DivisionRing.toRing.{u1} K _inst_1))))] (n : Nat), Invertible.{u1} K (MulZeroClass.toHasMul.{u1} K (MulZeroOneClass.toMulZeroClass.{u1} K (MonoidWithZero.toMulZeroOneClass.{u1} K (GroupWithZero.toMonoidWithZero.{u1} K (DivisionSemiring.toGroupWithZero.{u1} K (DivisionRing.toDivisionSemiring.{u1} K _inst_1)))))) (MulOneClass.toHasOne.{u1} K (MulZeroOneClass.toMulOneClass.{u1} K (MonoidWithZero.toMulZeroOneClass.{u1} K (GroupWithZero.toMonoidWithZero.{u1} K (DivisionSemiring.toGroupWithZero.{u1} K (DivisionRing.toDivisionSemiring.{u1} K _inst_1)))))) ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Nat K (HasLiftT.mk.{1, succ u1} Nat K (CoeTCₓ.coe.{1, succ u1} Nat K (Nat.castCoe.{u1} K (AddMonoidWithOne.toNatCast.{u1} K (AddGroupWithOne.toAddMonoidWithOne.{u1} K (AddCommGroupWithOne.toAddGroupWithOne.{u1} K (Ring.toAddCommGroupWithOne.{u1} K (DivisionRing.toRing.{u1} K _inst_1)))))))) (Nat.succ n))
but is expected to have type
  forall {K : Type.{u1}} [_inst_1 : DivisionRing.{u1} K] [_inst_2 : CharZero.{u1} K (AddGroupWithOne.toAddMonoidWithOne.{u1} K (Ring.toAddGroupWithOne.{u1} K (DivisionRing.toRing.{u1} K _inst_1)))] (n : Nat), Invertible.{u1} K (NonUnitalNonAssocRing.toMul.{u1} K (NonAssocRing.toNonUnitalNonAssocRing.{u1} K (Ring.toNonAssocRing.{u1} K (DivisionRing.toRing.{u1} K _inst_1)))) (NonAssocRing.toOne.{u1} K (Ring.toNonAssocRing.{u1} K (DivisionRing.toRing.{u1} K _inst_1))) (Nat.cast.{u1} K (NonAssocRing.toNatCast.{u1} K (Ring.toNonAssocRing.{u1} K (DivisionRing.toRing.{u1} K _inst_1))) (Nat.succ n))
Case conversion may be inaccurate. Consider using '#align invertible_succ invertibleSuccₓ'. -/
instance invertibleSucc (n : ℕ) : Invertible (n.succ : K) :=
  invertibleOfNonzero (Nat.cast_ne_zero.mpr (Nat.succ_ne_zero _))
#align invertible_succ invertibleSucc

/-!
A few `invertible n` instances for small numerals `n`. Feel free to add your own
number when you need its inverse.
-/

/- warning: invertible_two -> invertibleTwo is a dubious translation:
lean 3 declaration is
  forall {K : Type.{u1}} [_inst_1 : DivisionRing.{u1} K] [_inst_2 : CharZero.{u1} K (AddGroupWithOne.toAddMonoidWithOne.{u1} K (AddCommGroupWithOne.toAddGroupWithOne.{u1} K (Ring.toAddCommGroupWithOne.{u1} K (DivisionRing.toRing.{u1} K _inst_1))))], Invertible.{u1} K (MulZeroClass.toHasMul.{u1} K (MulZeroOneClass.toMulZeroClass.{u1} K (MonoidWithZero.toMulZeroOneClass.{u1} K (GroupWithZero.toMonoidWithZero.{u1} K (DivisionSemiring.toGroupWithZero.{u1} K (DivisionRing.toDivisionSemiring.{u1} K _inst_1)))))) (MulOneClass.toHasOne.{u1} K (MulZeroOneClass.toMulOneClass.{u1} K (MonoidWithZero.toMulZeroOneClass.{u1} K (GroupWithZero.toMonoidWithZero.{u1} K (DivisionSemiring.toGroupWithZero.{u1} K (DivisionRing.toDivisionSemiring.{u1} K _inst_1)))))) (OfNat.ofNat.{u1} K 2 (OfNat.mk.{u1} K 2 (bit0.{u1} K (Distrib.toHasAdd.{u1} K (Ring.toDistrib.{u1} K (DivisionRing.toRing.{u1} K _inst_1))) (One.one.{u1} K (AddMonoidWithOne.toOne.{u1} K (AddGroupWithOne.toAddMonoidWithOne.{u1} K (AddCommGroupWithOne.toAddGroupWithOne.{u1} K (Ring.toAddCommGroupWithOne.{u1} K (DivisionRing.toRing.{u1} K _inst_1)))))))))
but is expected to have type
  forall {K : Type.{u1}} [_inst_1 : DivisionRing.{u1} K] [_inst_2 : CharZero.{u1} K (AddGroupWithOne.toAddMonoidWithOne.{u1} K (Ring.toAddGroupWithOne.{u1} K (DivisionRing.toRing.{u1} K _inst_1)))], Invertible.{u1} K (NonUnitalNonAssocRing.toMul.{u1} K (NonAssocRing.toNonUnitalNonAssocRing.{u1} K (Ring.toNonAssocRing.{u1} K (DivisionRing.toRing.{u1} K _inst_1)))) (NonAssocRing.toOne.{u1} K (Ring.toNonAssocRing.{u1} K (DivisionRing.toRing.{u1} K _inst_1))) (OfNat.ofNat.{u1} K 2 (instOfNat.{u1} K 2 (NonAssocRing.toNatCast.{u1} K (Ring.toNonAssocRing.{u1} K (DivisionRing.toRing.{u1} K _inst_1))) (instAtLeastTwoHAddNatInstHAddInstAddNatOfNat (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0)))))
Case conversion may be inaccurate. Consider using '#align invertible_two invertibleTwoₓ'. -/
instance invertibleTwo : Invertible (2 : K) :=
  invertibleOfNonzero (by exact_mod_cast (by decide : 2 ≠ 0))
#align invertible_two invertibleTwo

/- warning: invertible_three -> invertibleThree is a dubious translation:
lean 3 declaration is
  forall {K : Type.{u1}} [_inst_1 : DivisionRing.{u1} K] [_inst_2 : CharZero.{u1} K (AddGroupWithOne.toAddMonoidWithOne.{u1} K (AddCommGroupWithOne.toAddGroupWithOne.{u1} K (Ring.toAddCommGroupWithOne.{u1} K (DivisionRing.toRing.{u1} K _inst_1))))], Invertible.{u1} K (MulZeroClass.toHasMul.{u1} K (MulZeroOneClass.toMulZeroClass.{u1} K (MonoidWithZero.toMulZeroOneClass.{u1} K (GroupWithZero.toMonoidWithZero.{u1} K (DivisionSemiring.toGroupWithZero.{u1} K (DivisionRing.toDivisionSemiring.{u1} K _inst_1)))))) (MulOneClass.toHasOne.{u1} K (MulZeroOneClass.toMulOneClass.{u1} K (MonoidWithZero.toMulZeroOneClass.{u1} K (GroupWithZero.toMonoidWithZero.{u1} K (DivisionSemiring.toGroupWithZero.{u1} K (DivisionRing.toDivisionSemiring.{u1} K _inst_1)))))) (OfNat.ofNat.{u1} K 3 (OfNat.mk.{u1} K 3 (bit1.{u1} K (AddMonoidWithOne.toOne.{u1} K (AddGroupWithOne.toAddMonoidWithOne.{u1} K (AddCommGroupWithOne.toAddGroupWithOne.{u1} K (Ring.toAddCommGroupWithOne.{u1} K (DivisionRing.toRing.{u1} K _inst_1))))) (Distrib.toHasAdd.{u1} K (Ring.toDistrib.{u1} K (DivisionRing.toRing.{u1} K _inst_1))) (One.one.{u1} K (AddMonoidWithOne.toOne.{u1} K (AddGroupWithOne.toAddMonoidWithOne.{u1} K (AddCommGroupWithOne.toAddGroupWithOne.{u1} K (Ring.toAddCommGroupWithOne.{u1} K (DivisionRing.toRing.{u1} K _inst_1)))))))))
but is expected to have type
  forall {K : Type.{u1}} [_inst_1 : DivisionRing.{u1} K] [_inst_2 : CharZero.{u1} K (AddGroupWithOne.toAddMonoidWithOne.{u1} K (Ring.toAddGroupWithOne.{u1} K (DivisionRing.toRing.{u1} K _inst_1)))], Invertible.{u1} K (NonUnitalNonAssocRing.toMul.{u1} K (NonAssocRing.toNonUnitalNonAssocRing.{u1} K (Ring.toNonAssocRing.{u1} K (DivisionRing.toRing.{u1} K _inst_1)))) (NonAssocRing.toOne.{u1} K (Ring.toNonAssocRing.{u1} K (DivisionRing.toRing.{u1} K _inst_1))) (OfNat.ofNat.{u1} K 3 (instOfNat.{u1} K 3 (NonAssocRing.toNatCast.{u1} K (Ring.toNonAssocRing.{u1} K (DivisionRing.toRing.{u1} K _inst_1))) (instAtLeastTwoHAddNatInstHAddInstAddNatOfNat (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))))
Case conversion may be inaccurate. Consider using '#align invertible_three invertibleThreeₓ'. -/
instance invertibleThree : Invertible (3 : K) :=
  invertibleOfNonzero (by exact_mod_cast (by decide : 3 ≠ 0))
#align invertible_three invertibleThree

end DivisionRing


/-
# The Euclid Game, version 1.0.0.

## Where the past and the future of mathematics meet...

# What is this game?

Welcome to The Euclid Game! In this game, you will learn the basics of **axiomatic geometry** and
how a program called **Lean** is used to formalize some mathematical results.
What does this mean? Instead of writing down proofs in English or any other human language, we will
explain the steps of the proof to this **proof assistant** by using a precise language, similar to a
programming language in some aspects.
The advantage of doing this is that the computer can keep track of the proof for us, and tell
us if we make any steps that aren't logically valid; computers are very good at understanding logic
after all!

What makes *proof assistants* unique is the fact that they allow us to step through and
understand individual steps in a proof. A mathematician would remark that we are providing **computer-assisted proofs**.
Later we will see how the proof assistant can do more than just follow our instructions; it can also
search for useful facts we might want to use. Lean can even complete some moderately
difficult statements on its own, using proof methods based on pre-defined rules.
This saves us time thinking about details in some situations, without losing any confidence in the
correctness of the result, and in some cases we can even learn from the proofs Lean finds!

To get started, click on the first world, the blue circle labelled "Tutorial World", on the right.
Once you complete all the levels of the Tutorial World, hit "Main Menu" in the top left corner of the screen to get back here.
In this way, you will see that the first blue circle has turned into green, which
will give you access to the following world.
You can use this menu to navigate as you try more of the problems.

Have fun!

# Thanks

The Euclid Game was created as part of the BIYSC project on "Can computers do math?" at Universitat Autònoma de Barcelona.

Some of the explanations are taken/adapted from the original Natural Number Game.

Lean is a computer theorem prover being developed at Microsoft Research.

# Contact

You can contribute with more levels and suggestions to The Euclid Game by sharing your thoughts
here.

You can visit my GitHub Repository here.

-/


import .love08_operational_semantics_demo

/- # LoVe Exercise 8: Operational Semantics -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/- ## Question 1: Program Equivalence

For this question, we introduce the notion of program equivalence: `S₁ ≈ S₂`. -/

def big_step_equiv (S₁ S₂ : stmt) : Prop :=
∀s t, (S₁, s) ⟹ t ↔ (S₂, s) ⟹ t

infix ` ≈ ` := big_step_equiv

/- Program equivalence is a equivalence relation, i.e., it is reflexive,
symmetric, and transitive. -/

@[refl] lemma big_step_equiv.refl {S : stmt} :
  S ≈ S :=
fix s t,
show (S, s) ⟹ t ↔ (S, s) ⟹ t, from
  by refl

@[symm] lemma big_step_equiv.symm {S₁ S₂ : stmt}:
  S₁ ≈ S₂ → S₂ ≈ S₁ :=
assume h : S₁ ≈ S₂,
fix s t,
show (S₂, s) ⟹ t ↔ (S₁, s) ⟹ t, from
  iff.symm (h s t)

@[trans] lemma big_step_equiv.trans {S₁ S₂ S₃ : stmt} (h₁₂ : S₁ ≈ S₂)
    (h₂₃ : S₂ ≈ S₃) :
  S₁ ≈ S₃ :=
fix s t,
show (S₁, s) ⟹ t ↔ (S₃, s) ⟹ t, from
  iff.trans (h₁₂ s t) (h₂₃ s t)

/- 1.1. Prove the following program equivalences. -/

lemma big_step_equiv.skip_assign_id {x} :
  stmt.assign x (λs, s x) ≈ stmt.skip :=
sorry

lemma big_step_equiv.seq_skip_left {S : stmt} :
  stmt.skip ;; S ≈ S :=
sorry

lemma big_step_equiv.seq_skip_right {S : stmt} :
  S ;; stmt.skip ≈ S :=
sorry

lemma big_step_equiv.ite_seq_while {b} {S : stmt} :
  stmt.ite b (S ;; stmt.while b S) stmt.skip ≈ stmt.while b S :=
sorry

/- 1.2. Program equivalence can be used to replace subprograms by other
subprograms with the same semantics. Prove the following so-called congruence
rules: -/

lemma big_step_equiv.seq_congr {S₁ S₂ T₁ T₂ : stmt} (hS : S₁ ≈ S₂)
    (hT : T₁ ≈ T₂) :
  S₁ ;; T₁ ≈ S₂ ;; T₂ :=
sorry

lemma big_step_equiv.ite_congr {b} {S₁ S₂ T₁ T₂ : stmt} (hS : S₁ ≈ S₂)
    (hT : T₁ ≈ T₂) :
  stmt.ite b S₁ T₁ ≈ stmt.ite b S₂ T₂ :=
sorry

/- 1.3 (**optional**): Prove one more congruence rule. This one is more
difficult. -/

lemma denote_equiv.while_congr {b} {S₁ S₂ : stmt} (hS : S₁ ≈ S₂) :
  stmt.while b S₁ ≈ stmt.while b S₂ :=
sorry

/- ## Question 2: Guarded Command Language (GCL)

In 1976, E. W. Dijkstra introduced the guarded command language, a
minimalistic imperative language with built-in nondeterminism. A grammar for one
of its variants is given below:

    S  ::=  x := e       -- assignment
         |  assert b     -- assertion
         |  S ; S        -- sequential composition
         |  S | ⋯ | S    -- nondeterministic choice
         |  loop S       -- nondeterministic iteration

Assignment and sequential composition are as in the WHILE language. The other
statements have the following semantics:

* `assert b` aborts if `b` evaluates to false; otherwise, the command is a
  no-op.

* `S | ⋯ | S` chooses any of the branches and executes it, ignoring the other
  branches.

* `loop S` executes `S` any number of times.

In Lean, GCL is captured by the following inductive type: -/

namespace gcl

inductive stmt (σ : Type) : Type
| assign : string → (σ → ℕ) → stmt
| assert : (σ → Prop) → stmt
| seq    : stmt → stmt → stmt
| choice : list stmt → stmt
| loop   : stmt → stmt

infixr ` ;; ` : 90 := stmt.seq

/- The parameter `σ` abstracts over the state type. It is necessary as a work
around for a Lean bug.

The big-step semantics is defined as follows: -/

inductive big_step : (stmt state × state) → state → Prop
| assign {x a s} :
  big_step (stmt.assign x a, s) (s{x ↦ a s})
| assert {b : state → Prop} {s} (hcond : b s) :
  big_step (stmt.assert b, s) s
| seq {S T s t u} (h₁ : big_step (S, s) t) (h₂ : big_step (T, t) u) :
  big_step (S ;; T, s) u
| choice {Ss s t} (i) (hless : i < list.length Ss)
    (hbody : big_step (list.nth_le Ss i hless, s) t) :
  big_step (stmt.choice Ss, s) t
| loop_base {S s} :
  big_step (stmt.loop S, s) s
| loop_step {S s u} (t) (hbody : big_step (S, s) t)
    (hrest : big_step (stmt.loop S, t) u) :
  big_step (stmt.loop S, s) u

infix ` ⟹ ` : 110 := big_step

/- 2.1. Prove the following inversion rules, as we did in the lecture for the
WHILE language. -/

@[simp] lemma big_step_assign_iff {x a s t} :
  (stmt.assign x a, s) ⟹ t ↔ t = s{x ↦ a s} :=
sorry

@[simp] lemma big_step_assert {b s t} :
  (stmt.assert b, s) ⟹ t ↔ t = s ∧ b s :=
sorry

@[simp] lemma big_step_seq_iff {S₁ S₂ s t} :
  (stmt.seq S₁ S₂, s) ⟹ t ↔ (∃u, (S₁, s) ⟹ u ∧ (S₂, u) ⟹ t) :=
sorry

lemma big_step_loop {S s u} :
  (stmt.loop S, s) ⟹ u ↔
  (s = u ∨ (∃t, (S, s) ⟹ t ∧ (stmt.loop S, t) ⟹ u)) :=
sorry

@[simp] lemma big_step_choice {Ss s t} :
  (stmt.choice Ss, s) ⟹ t ↔
  (∃(i : ℕ) (hless : i < list.length Ss),
     (list.nth_le Ss i hless, s) ⟹ t) :=
sorry

end gcl

/- 2.2. Complete the translation below of a deterministic program to a GCL
program, by filling in the `sorry` placeholders below. -/

def gcl_of : stmt → gcl.stmt state
| stmt.skip         := gcl.stmt.assert (λ_, true)
| (stmt.assign x a) :=
  sorry
| (S ;; T)          :=
  sorry
| (stmt.ite b S T)  :=
  sorry
| (stmt.while b S)  :=
  sorry

/- 2.3. In the definition of `gcl_of` above, `skip` is translated to
`assert (λ_, true)`. Looking at the big-step semantics of both constructs, we
can convince ourselves that it makes sense. Can you think of other correct ways
to define the `skip` case? -/

-- enter your answer here

end LoVe


import data.real.basic analysis.special_functions.pow

/- From Shing-/
lemma BernoulliInequality (x : ℝ) (hx : 0 ≤ x) (r : ℝ) (hr0 : 0 ≤ r) (hr1 : r ≤ 1) :
  (1 + x)^r ≤ 1 + r * x :=
begin
  let f := λ x, 1 + r * x - (1 + x)^r,
  have h1 : ∀ x > -1, has_deriv_at f (r - r * (1 + x)^(r - 1) * 1) x,
  { intros x hx,
    change f with λ x, 1 + r * x - (1 + x)^r,
    apply has_deriv_at.sub,
    { apply has_deriv_at.const_add,
      nth_rewrite 0 ←mul_one r,
      apply has_deriv_at.const_mul,
      exact has_deriv_at_id _ },
    { change λ x : ℝ, (1 + x)^r with (λ t, t^r) ∘ (λ x, 1 + x),
      convert has_deriv_at.comp _ _ _ using 1,
      { apply real.has_deriv_at_rpow,
        linarith },
      { apply has_deriv_at.const_add,
        exact has_deriv_at_id _ } } },
  have h2 : ∀ x : ℝ, 0 ≤ x → (1 + x)^(r - 1) ≤ 1,
  { intros x hx,
    apply real.rpow_le_one_of_one_le_of_nonpos;
    linarith },
  have h3 : ∀ x : ℝ, 0 ≤ x → 0 ≤ deriv f x,
  { intros x hx,
    rw (h1 x (by linarith)).deriv,
    nlinarith [h2 x hx] },
  have h4 : f 0 = 0,
  { change f with λ x, 1 + r * x - (1 + x)^r,
    simp only [add_zero, real.one_rpow, mul_zero, sub_self]},
  have h5 : 0 ≤ f x,
  { rcases lt_or_eq_of_le hx with (hx|rfl),
    { rcases exists_deriv_eq_slope f hx _ _ with ⟨c, hc₁, hc₂⟩,
      rw [h4, sub_zero, sub_zero, eq_div_iff] at hc₂,
      rw ←hc₂,
      apply mul_nonneg,
      { exact h3 _ hc₁.1.le },
      { exact hx.le },
      { exact hx.ne.symm },
      { intros t ht,
        exact (h1 t (by linarith [ht.1])).continuous_at.continuous_within_at },
      { intros t ht,
        exact (h1 t (by linarith [ht.1])).differentiable_at.differentiable_within_at } },
    rw h4 },
  change f x with 1 + r * x - (1 + x)^r at h5,
  linarith,
end


-- the result of trials by Ameena Hassan, 15th November 2018

import data.real.basic
-- not import data.complex.basic
import tactic.ring

structure complex : Type :=
(re : ℝ) (im : ℝ)
notation `∁` := complex

definition z : ∁ := ⟨5, 6⟩

definition z2: ∁ := {re := 5, im := 6}
--example : z = z2 := rfl

namespace complex

theorem ext (z w : ∁) : z.re = w.re ∧ z.im = w.im → z = w :=
begin
  cases z,
  cases w,
  intros,
  simp * at *,
end

instance : has_coe ℝ ∁ := ⟨λ x, {re := x, im := 0}⟩

definition I : ∁ := ⟨0, 1⟩

definition add : ∁ → ∁ → ∁ :=
λ z w, ⟨z.re + w.re, z.im + w.im⟩

instance : has_add ∁ := ⟨complex.add⟩

@[simp] theorem add_re (z w : ∁) : (z + w).re = z.re + w.re := rfl
@[simp] theorem add_im (z w : ∁) : (z + w).im = z.im + w.im := rfl

theorem add_comm : ∀ z w : ∁, z + w = w + z :=
begin
  intros,
  apply ext,
  split,
  all_goals {simp},
end

theorem add_assoc : ∀ a b c : ∁, a + (b + c) = (a + b) + c :=
begin
  intros,
  apply ext,
  split,
  all_goals {simp},
end

definition neg : ∁ → ∁ :=
λ z, ⟨-z.re, -z.im⟩

instance : has_neg ∁ := ⟨complex.neg⟩

@[simp] theorem neg_re (z : ∁) : (-z).re = -z.re := rfl
@[simp] theorem neg_im (z : ∁) : (-z).im = -z.im := rfl

definition mul : ∁ → ∁ → ∁ :=
λ z w, ⟨z.re * w.re - z.im * w.im, z.re * w.im + z.im * w.re⟩

instance : has_mul ∁ := ⟨complex.mul⟩

@[simp] lemma mul_re (z w : ∁) : (z * w).re = (z.re * w.re - z.im * w.im) := rfl
@[simp] lemma mul_im (z w : ∁) : (z * w).im = (z.re * w.im + z.im * w.re) := rfl

theorem mul_assoc : ∀ a b c : ∁, a * (b * c) = (a * b) * c :=
begin
  intros,
  apply ext,
  split,
  all_goals {simp},
  all_goals {ring},
end

meta def CORIP : tactic unit := do
`[intros],
`[apply ext],
`[split],
`[all_goals {simp}],
`[all_goals {ring}]

theorem mul_assoc' (a b c : ∁) : a * (b * c) = (a * b) * c := by CORIP
theorem left_distrib (a b c : ∁) : a * (b + c) = a * b + a * c := by CORIP

@[simp] definition one : ∁ := ⟨1, 0⟩
@[simp] definition zero : ∁ := ⟨0, 0⟩

theorem one_mul (a : ∁) : complex.one * a = a := by CORIP
theorem zero_mul (a : ∁) : complex.zero * a = zero := by CORIP

-- instance : comm_ring ∁ :=
-- by refine { mul := (*),
--   add := (+),
--   .. -- finilaize this part of mult one and mult zero
-- }

end complex

-- theorem mul_assoc' (a b c : ∁) : a * (b*c) = (a*b)*c := by CORIP
-- theorem left_distrib (a b c : ∁) : a *(b+c) = a*b + a*c := by CORIP

-- @[simp] definition one : ∁ := (1, 0)
-- @[simp] definition zero : ∁ := (0, 0)

-- theorem one_mul (a : ∁) : complex.one * a = a := by CORIP
-- theorem zero_mul (a: ∁) : complex.zero * a = 0 := by CORIP

-- instance : comm_ring ∁ :=
-- by refine { mul := (*),
--   add := (+),
--   ..

-- }; {by CORIP}