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


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}