/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Michael Howes
-/
import group_theory.quotient_group
import tactic.group

/-!
# The abelianization of a group

This file defines the commutator and the abelianization of a group. It furthermore prepares for the
result that the abelianization is left adjoint to the forgetful functor from abelian groups to
groups, which can be found in `algebra/category/Group/adjunctions`.

## Main definitions

* `commutator`: defines the commutator of a group `G` as a subgroup of `G`.
* `abelianization`: defines the abelianization of a group `G` as the quotient of a group by its
  commutator subgroup.
-/

universes u v

-- Let G be a group.
variables (G : Type u) [group G]

/-- The commutator subgroup of a group G is the normal subgroup
  generated by the commutators [p,q]=`p*q*p⁻¹*q⁻¹`. -/
@[derive subgroup.normal]
def commutator : subgroup G :=
subgroup.normal_closure {x | ∃ p q, p * q * p⁻¹ * q⁻¹ = x}

/-- The abelianization of G is the quotient of G by its commutator subgroup. -/
def abelianization : Type u :=
quotient_group.quotient (commutator G)

namespace abelianization

local attribute [instance] quotient_group.left_rel

instance : comm_group (abelianization G) :=
{ mul_comm := λ x y, quotient.induction_on₂' x y $ λ a b,
  begin
    apply quotient.sound,
    apply subgroup.subset_normal_closure,
    use b⁻¹, use a⁻¹,
    group,
  end,
.. quotient_group.quotient.group _ }

instance : inhabited (abelianization G) := ⟨1⟩

variable {G}

/-- `of` is the canonical projection from G to its abelianization. -/
def of : G →* abelianization G :=
{ to_fun := quotient_group.mk,
  map_one' := rfl,
  map_mul' := λ x y, rfl }

section lift
-- So far we have built Gᵃᵇ and proved it's an abelian group.
-- Furthremore we defined the canonical projection `of : G → Gᵃᵇ`

-- Let `A` be an abelian group and let `f` be a group homomorphism from `G` to `A`.
variables {A : Type v} [comm_group A] (f : G →* A)

lemma commutator_subset_ker : commutator G ≤ f.ker :=
begin
  apply subgroup.normal_closure_le_normal,
  rintros x ⟨p, q, rfl⟩,
  simp [monoid_hom.mem_ker, mul_right_comm (f p) (f q)],
end

/-- If `f : G → A` is a group homomorphism to an abelian group, then `lift f` is the unique map from
  the abelianization of a `G` to `A` that factors through `f`. -/
def lift : (G →* A) ≃ (abelianization G →* A) :=
{ to_fun := λ f, quotient_group.lift _ f (λ x h, f.mem_ker.2 $ commutator_subset_ker _ h),
  inv_fun := λ F, F.comp of,
  left_inv := λ f, monoid_hom.ext $ λ x, rfl,
  right_inv := λ F, monoid_hom.ext $ λ x, quotient_group.induction_on x $ λ z, rfl }

@[simp] lemma lift.of (x : G) : lift f (of x) = f x :=
rfl

theorem lift.unique
  (φ : abelianization G →* A)
  -- hφ : φ agrees with f on the image of G in Gᵃᵇ
  (hφ : ∀ (x : G), φ (of x) = f x)
  {x : abelianization G} :
  φ x = lift f x :=
quotient_group.induction_on x hφ

end lift

variables {A : Type v} [monoid A]

/-- See note [partially-applied ext lemmas]. -/
@[ext]
theorem hom_ext (φ ψ : abelianization G →* A)
  (h : φ.comp of = ψ.comp of) : φ = ψ :=
monoid_hom.ext $ λ x, quotient_group.induction_on x $ monoid_hom.congr_fun h

end abelianization


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Michael Howes
-/
import group_theory.quotient_group
import tactic.group

/-!
# The abelianization of a group

This file defines the commutator and the abelianization of a group. It furthermore prepares for the
result that the abelianization is left adjoint to the forgetful functor from abelian groups to
groups, which can be found in `algebra/category/Group/adjunctions`.

## Main definitions

* `commutator`: defines the commutator of a group `G` as a subgroup of `G`.
* `abelianization`: defines the abelianization of a group `G` as the quotient of a group by its
  commutator subgroup.
-/

universes u v

-- Let G be a group.
variables (G : Type u) [group G]

/-- The commutator subgroup of a group G is the normal subgroup
  generated by the commutators [p,q]=`p*q*p⁻¹*q⁻¹`. -/
@[derive subgroup.normal]
def commutator : subgroup G :=
subgroup.normal_closure {x | ∃ p q, p * q * p⁻¹ * q⁻¹ = x}

/-- The abelianization of G is the quotient of G by its commutator subgroup. -/
def abelianization : Type u :=
G ⧸ (commutator G)

namespace abelianization

local attribute [instance] quotient_group.left_rel

instance : comm_group (abelianization G) :=
{ mul_comm := λ x y, quotient.induction_on₂' x y $ λ a b,
  begin
    apply quotient.sound,
    apply subgroup.subset_normal_closure,
    use b⁻¹, use a⁻¹,
    group,
  end,
.. quotient_group.quotient.group _ }

instance : inhabited (abelianization G) := ⟨1⟩

variable {G}

/-- `of` is the canonical projection from G to its abelianization. -/
def of : G →* abelianization G :=
{ to_fun := quotient_group.mk,
  map_one' := rfl,
  map_mul' := λ x y, rfl }

section lift
-- So far we have built Gᵃᵇ and proved it's an abelian group.
-- Furthremore we defined the canonical projection `of : G → Gᵃᵇ`

-- Let `A` be an abelian group and let `f` be a group homomorphism from `G` to `A`.
variables {A : Type v} [comm_group A] (f : G →* A)

lemma commutator_subset_ker : commutator G ≤ f.ker :=
begin
  apply subgroup.normal_closure_le_normal,
  rintros x ⟨p, q, rfl⟩,
  simp [monoid_hom.mem_ker, mul_right_comm (f p) (f q)],
end

/-- If `f : G → A` is a group homomorphism to an abelian group, then `lift f` is the unique map from
  the abelianization of a `G` to `A` that factors through `f`. -/
def lift : (G →* A) ≃ (abelianization G →* A) :=
{ to_fun := λ f, quotient_group.lift _ f (λ x h, f.mem_ker.2 $ commutator_subset_ker _ h),
  inv_fun := λ F, F.comp of,
  left_inv := λ f, monoid_hom.ext $ λ x, rfl,
  right_inv := λ F, monoid_hom.ext $ λ x, quotient_group.induction_on x $ λ z, rfl }

@[simp] lemma lift.of (x : G) : lift f (of x) = f x :=
rfl

theorem lift.unique
  (φ : abelianization G →* A)
  -- hφ : φ agrees with f on the image of G in Gᵃᵇ
  (hφ : ∀ (x : G), φ (of x) = f x)
  {x : abelianization G} :
  φ x = lift f x :=
quotient_group.induction_on x hφ

end lift

variables {A : Type v} [monoid A]

/-- See note [partially-applied ext lemmas]. -/
@[ext]
theorem hom_ext (φ ψ : abelianization G →* A)
  (h : φ.comp of = ψ.comp of) : φ = ψ :=
monoid_hom.ext $ λ x, quotient_group.induction_on x $ monoid_hom.congr_fun h

end abelianization


import tactic.basic
import .uwyo_aux
import analysis.calculus.local_extr

noncomputable theory
open_locale classical topological_space
open filter

-- For examples, see mathlib/src/analysis/specific_limits.lean
-- Main business: Newton's method sequence of approximations
-- Working first with a sequence of rationals for the approximations themselves
def x : ℕ → ℚ
| 0     := (2 : ℚ)
| (n+1) := ( x n * x n + 2) / ( 2 * x n)
-- Now pretend otherwise
def s (n : ℕ) : ℝ := real.sqrt 2 - x n

lemma newton_seq_positive : ∀ n : ℕ, 0 < x n :=
begin
  intro n,
  induction n with d hd,
  { -- base case n = 0
    have h1 : x 0 = 2, refl,
    rw h1, linarith,
  },
  { -- induction step
    have h2 : x d.succ = ( x d * x d + 2) / ( 2 * x d), refl,
    set X := x d with hX,
    have h3 : 0 < X * X, nlinarith,
    have h4 : 0 < X * X + 2, linarith,
    have h5 : 0 < 2 * X, linarith,
    exact div_pos h4 h5,
  },
  done
end

lemma newton_seq_bounded_below : ∀ n : ℕ, 2 < (x n) * (x n) :=
begin
  intro n,
  induction n with d hd,
  { -- base case n= 0
    have h0 : x 0 =2 , refl,
    rw h0, linarith,
  },
  { -- induction step, kind of ugly so far
    have h1 : x d.succ = ( x d * x d + 2) / ( 2 * x d), refl,
    rw h1,
    have H := newton_seq_positive d,
    set X := x d with hX,
    have G : X ≠ 0, linarith,
    set Y := X * X with hY,
    have G1 : Y ≠ 0, nlinarith,
    have g1 : (Y + 2) * (Y + 2) = Y * Y + 4 * Y + 4, ring,
    set V := 2 * X with hV,
    have F : V ≠ 0, linarith,
    have E : V * V ≠ 0, nlinarith,
    have g2 :  (Y + 2) * (Y + 2) / ( V * V) = (Y + 2) / V * ((Y + 2) / V),
      field_simp,
    -- this needs some polishing
    have h21 := aux_1 X Y V G hY hV G1,
    have h201 : (1/4) * (4 * (Y + 2) / V * ((Y + 2) / (V))) = (1/4) * (Y + 2 * 2 + (2*2/(X * X)) ),
      rw h21,
    have h202 : (1/4) * (4 * (Y + 2) / V * ((Y + 2) / (V))) = (Y + 2) / V * ((Y + 2) / (V)),
      ring,
    have h2 : (Y + 2) / V * ((Y + 2) / (V)) = (1/4) * (Y + 2 * 2 + (2*2/(X * X)) ),
      rw h202 at h201, exact h201,
    have h3 :
      2 - (1/4) * ( X * X + 2 * 2 + (2*2/(X*X)) ) = (1/4) * ( - X * X + 2 * 2 - (2*2/(X*X)) ),
      ring,
    have h4 : (1/4) * ( - X * X + 2 * 2 - (2*2/(X*X)) ) = - (1/4) * ( 2 / X - X ) ^ 2,
      have h41 : ( 2 / X - X ) ^ 2 = ( 2 / X - X ) * ( 2 / X - X ), ring,
      rw h41,
      have h42 := aux_2 X G,
      rw h42, ring,
    have h51 : 0 ≤ ( 2 / X - X ) ^ 2, exact pow_two_nonneg _,
    have h52 : 0 ≠ ( 2 / X - X ), exact no_rat_sq_eq_two X G,
    have h53 : 0 ≠ ( 2 / X - X ) ^ 2, exact ne.symm (pow_ne_zero 2 (ne.symm h52)),
    have h54 : 0 < ( 2 / X - X ) ^ 2, exact lt_of_le_of_ne h51 h53,
    have h6 : - (1/4) * ( 2 / X - X ) ^ 2 < 0, linarith,
    rw h2,
    apply sub_lt_zero.mp,
    rw h3, rw h4, exact h6,
  },
  done
end

lemma newton_seq_decreasing : ∀ n : ℕ, x (n+1) < x n :=
begin
  intro n,
  have h1 : x (n+1) = ( x n * x n + 2) / ( 2 * x n), refl,
  have h2 : x (n+1) - x n = ( x n * x n + 2) / ( 2 * x n) - x n, rw h1,
  have h21 := newton_seq_positive n,
  set X := x n with hX,
  have h3 := aux_0 X h21,
  have h4 : 2 - X * X < 0,
    have h41 := newton_seq_bounded_below n,
    rw ← hX at h41,
    linarith,
  have h5 : 0 < 2 * X, linarith,
  have h6 := div_neg_of_neg_of_pos h4 h5,
  rw ← h3 at h6, rw ← h2 at h6, linarith,
  done
end

theorem sqrt_sub_newton_monotone : monotone s :=
begin
  apply monotone_of_monotone_nat,
  intro n,
  unfold s,
  have h1 := newton_seq_decreasing n,
  have h2 : ((x (n + 1)) : ℝ) ≤ ((x n) : ℝ),
    norm_cast, linarith,
  exact (sub_le_sub_iff_left (real.sqrt 2)).mpr h2,
  done
end

theorem sqrt_sub_newton_below_zero : ∀ n : ℕ, s n < (0 : ℝ) :=
begin
  unfold s,
  intro n,
  rw sub_lt, rw sub_zero,
  have h1 := newton_seq_bounded_below n,
  have h2 := newton_seq_positive n,
  set X := x n with hX,
  have h3 : 0 ≤ (2 : ℝ), linarith,
  have h4 : 0 ≤ X, linarith,
  have h41 : 0 ≤ ((X * X) : ℝ), nlinarith,
  have h42 : 2 < ((X * X) : ℝ), norm_cast, exact h1,
  have h5 := (real.sqrt_lt h3 h41).mpr h42,
  rw ← pow_two at h5,
  rw real.sqrt_sqr at h5, exact h5,
  norm_cast, exact h4,
end

lemma sqrt_sub_newton_range_subset : set.range s ⊆ set.Iic (0:ℝ) :=
begin
  unfold set.range,
  have h := sqrt_sub_newton_below_zero,
  intros x hx,
  cases hx with m hm,
  have h1 := h m,
  rw hm at h1,
  rw set.mem_Iic,
  linarith,
end

theorem sqrt_sub_newton_bounded_above : bdd_above (set.range s) :=
begin
  have h1 := sqrt_sub_newton_range_subset,
  have h2 : ∃ a : ℝ, (set.range s) ⊆ set.Iic a,
    use [0, h1],
  exact bdd_above_iff_subset_Iic.mpr h2,
end

theorem sqrt_sub_newton_tendsto_finite_limit : ∃ L0 : ℝ, tendsto s at_top (𝓝 L0) :=
begin
  have h1 := tendsto_of_monotone sqrt_sub_newton_monotone,
  cases h1 with hf ht,
  have h2 := unbounded_of_tendsto_at_top hf,
  have h3 := sqrt_sub_newton_bounded_above,
  exfalso,  -- this sequence doesn't go to infinity; it is bounded above
  exact h2 h3,
  exact ht, done
end

theorem sqrt_sub_newton_tendsto_finite_limit_v1 : ∃ L0 : ℝ, tendsto s at_top (𝓝 L0) :=
begin
  have h1 := tendsto_of_monotone sqrt_sub_newton_monotone,
  cases h1 with hf ht,
  have h2 := unbounded_of_tendsto_at_top hf,
  have h3 := sqrt_sub_newton_bounded_above,
  exfalso,  -- this sequence doesn't go to infinity; it is bounded above
  exact h2 h3,
  exact ht, done
end

-- This is due to Yuri Kudryashov
example (s : ℕ → ℝ) (L : ℝ) (h : ∀ n : ℕ, s n < L) : ¬ (tendsto s at_top at_top) :=
begin
  intro H,
  --have h0 := H.eventually,
  have h1 : ∃ n, L ≤ s n := (H.eventually (eventually_ge_at_top L)).exists,
  cases h1 with n hn,
  have h2 := h n,
  linarith, done
end

-- This is the sequence of Newton approximations, viewed as real numbers
def xR (n : ℕ) : ℝ := real.sqrt 2 - s n
-- We can actually prove `xR` and `x` generate the same values
theorem xR_same_as_x (n : ℕ) : ((x n): ℝ) = xR n :=
begin
  have h1 : xR n = real.sqrt 2 - s n, refl,
  have h2 : s n = real.sqrt 2 - x n, refl,
  rw h2 at h1,
  have h3 : real.sqrt 2 - (real.sqrt 2 - ↑(x n)) = ↑(x n),
    linarith,
  rw h3 at h1,
  exact h1.symm, done
end

-- Rewrite the recursive formula as a function application
--def f (x : ℝ) : ℝ := (1/2) * (x + 2 / x)
def f (x : ℝ) : ℝ := ( x * x + 2) / ( 2 * x)
-- This is needed in the limit calculation result
lemma rw_recursion : ∀ n : ℕ, xR (n+1) = f (xR n) :=
begin
  intro n,
  have h1 := xR_same_as_x n,
  have h2 := xR_same_as_x (n+1),
  rw [← h1, ← h2],
  unfold f,
  have h3 : x (n+1) = ( x n * x n + 2) / ( 2 * x n), refl,
  rw h3,
  norm_cast, done
end

lemma f_contin_at_L (L : ℝ) (h : L ≠ 0) : continuous_at f L :=
begin
  apply continuous_at.div,
  swap 3, { norm_num, exact h, },
  apply continuous_at.add,
  apply continuous_at.mul,
  apply continuous_at_id,
  apply continuous_at_id,
  apply continuous_at_const,
  apply continuous_at.mul,
  apply continuous_at_const,
  exact continuous_at_id, done
end

-- So now the final push
-- The sequence `xR` has a finite limit:
theorem newton_tendsto_finite_limit : ∃ L : ℝ, tendsto xR at_top (𝓝 L) :=
begin
  have h1 := sqrt_sub_newton_tendsto_finite_limit,
  cases h1 with l0 hl0,
  use real.sqrt 2 - l0,
  apply tendsto.sub,
  exact tendsto_const_nhds,
  exact hl0, done
end

-- The limit can't be zero:
theorem newton_tendsto_nonzero_limit (L : ℝ) : tendsto xR at_top (𝓝 L) → L ≠ 0 :=
begin
  have h2 := xR_same_as_x,
  have h0 : ∀ n : ℕ, 0 < xR n,
    intro n,
    have g0 := newton_seq_positive n,
    have h21 := h2 n,
    rw ← h21, norm_cast, exact g0,
  have h1 := newton_seq_bounded_below,
  have h3 : ∀ n : ℕ, real.sqrt 2 < xR n,
    intro n,
    have h30 := h1 n,
    have h31 := h2 n,
    have h00 := h0 n,
    have h32 : 0 ≤ (2:ℝ), linarith,
    have h33 : 0 ≤ (xR n) * (xR n), nlinarith,
    have h34 : 2 < (xR n) * (xR n), rw ← h31, norm_cast, exact h30,
    have h35 := (real.sqrt_lt h32 h33).mpr h34,
    have h01 : 0 ≤ xR n, linarith,
    have h36 : real.sqrt ((xR n) * (xR n)) = xR n, exact real.sqrt_mul_self h01,
    rw h36 at h35,
    exact h35,
  intros H hL,
  have G := aux_3 xR h3,
  rw hL at H,
  exact G H, done
end

-- And this limit satisfies a specific equation
theorem newton_limit_satisfies (L : ℝ) (H : tendsto xR at_top ((𝓝 L) )) :
  f L = L :=
begin
  have h1 : tendsto (xR ∘ nat.succ) at_top (𝓝 L) := (tendsto_add_at_top_iff_nat 1).mpr H,
  have h2 := (tendsto_add_at_top_iff_nat 1).mpr H,
  rw show xR ∘ nat.succ = f ∘ xR, from funext rw_recursion at h1,
  have hL : L ≠ 0, exact newton_tendsto_nonzero_limit L H,
  have hf : continuous_at f L, exact f_contin_at_L L hL,
  exact tendsto_nhds_unique (tendsto.comp hf H) h1,
  done
end

-- The equation for the limit `L` can be solved to get `L = real.sqrt 2`
-- Courtesy Patrick Massot
lemma solve_limit_eqn {L : ℝ} (h : L = (2 + L * L)/(2*L)) (hL : 0 < L) : L = real.sqrt 2 :=
begin
  apply_fun (λ x, 2*L*x) at h,
  simp_rw mul_div_cancel' _ (ne_of_gt (by linarith) : 2*L ≠ 0) at h,
  apply_fun (λ x, x - L*L) at h,
  ring at h,
  symmetry,
  rwa real.sqrt_eq_iff_sqr_eq; linarith,
end

--------- Scratch space below here:
-- This slick proof due to Patrick Massot:
lemma dan_limit {u : ℕ → ℝ} {L : ℝ} {f : ℝ → ℝ} (hu : tendsto u at_top $ 𝓝 L)
(hf : continuous_at f L) (huf : ∀ n, u (n+1) = f (u n)) : f L = L :=
begin
  have lim : tendsto (u ∘ nat.succ) at_top (𝓝 L) :=
    (tendsto_add_at_top_iff_nat 1).mpr hu,
  rw show u ∘ nat.succ = f ∘ u, from funext huf at lim,
  exact tendsto_nhds_unique (tendsto.comp hf hu) lim
end
-- This one is due to Mario Carneiro:
example (s : ℕ → ℝ) (hs : ∀ n : ℕ, 2 < s n) : ¬ (tendsto s at_top (𝓝 0)) :=
begin
  have : (0:ℝ) ∉ set.Ici (2 : ℝ), { simp, norm_num },
  rw ← closure_Ioi at this,
  exact λ h, this (mem_closure_of_tendsto h (eventually_of_forall hs)),
  done
end


open classical

variables p q r s : Prop

-- commutativity of ∧ and ∨
example : p ∧ q ↔ q ∧ p :=
   iff.intro
       (assume h: p ∧ q, show q ∧ p, from and.intro h.right h.left)
       (assume h: q ∧ p, show p ∧ q, from and.intro h.right h.left)

lemma swap_or: p ∨ q → q ∨ p :=
   assume hpq: p ∨ q,
   show q ∨ p, from or.elim hpq
       (assume hp: p, or.intro_right q hp)
       (assume hq: q, or.intro_left p hq)

example : p ∨ q ↔ q ∨ p :=
  iff.intro
      (assume h: p ∨ q, show q ∨ p, from swap_or p q h)
      (assume h: q ∨ p, show p ∨ q, from swap_or q p h)

-- associativity of ∧ and ∨
example : (p ∧ q) ∧ r ↔ p ∧ (q ∧ r) :=
  iff.intro
       (
           assume h: (p ∧ q) ∧ r,
           have hpq: (p ∧ q), from h.left,
           have hqr: (q ∧ r), from and.intro hpq.right h.right,
           and.intro hpq.left hqr
       )
       (
           assume h: p ∧ (q ∧ r),
           have hqr: (q ∧ r), from h.right,
           and.intro (and.intro h.left hqr.left) hqr.right
       )

-- distributivity
example : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
   have hlr: p ∧ (q ∨ r) → (p ∧ q) ∨ (p ∧ r), from (
       assume h: p ∧ (q ∨ r),
       or.elim
           h.right
           (
               assume hq: q,
               have hpq: p ∧ q, from and.intro h.left hq,
               or.intro_left (p ∧ r) hpq
           )
           (
               assume hr: r,
               have hpr: p ∧ r, from and.intro h.left hr,
               or.intro_right (p ∧ q) hpr
           )
   ),
   have hrl: (p ∧ q) ∨ (p ∧ r) →  p ∧ (q ∨ r), from (
       assume h: (p ∧ q) ∨ (p ∧ r),
       or.elim
           h
           (
               assume hpq: p ∧ q,
               have hqr: q ∨ r, from or.intro_left r hpq.right,
               and.intro hpq.left hqr
           )
           (
               assume hpr: p ∧ r,
               have hqr: q ∨ r, from or.intro_right q hpr.right,
               and.intro hpr.left hqr
           )
   ),
   iff.intro hlr hrl

example : p ∨ (q ∧ r) ↔ (p ∨ q) ∧ (p ∨ r) :=
   iff.intro
       (
           assume h: p ∨ (q ∧ r),
           or.elim
               h
               (
                   assume hp:p,
                   have hpq: p ∨ q, from or.intro_left q hp,
                   have hpr: p ∨ r, from or.intro_left r hp,
                   and.intro hpq hpr
               )
               (
                   assume hqr: q ∧ r,
                   have hpq: p ∨ q, from or.intro_right p hqr.left,
                   have hpr: p ∨ r, from or.intro_right p hqr.right,
                   and.intro hpq hpr
               )
       )
       (
           assume h: (p ∨ q) ∧ (p ∨ r),
           have hpq: p ∨ q, from h.left,
           have hpr: p ∨ r, from h.right,
           or.elim hpq
               (assume hp: p, or.intro_left (q ∧ r) hp)
               (
                   assume hq: q,
                   or.elim hpr
                       (assume hp: p, or.intro_left (q ∧ r) hp)
                       (
                           assume hr: r,
                           have hqr: q ∧ r, from and.intro hq hr,
                           or.intro_right p hqr
                       )
               )
       )

-- other properties
example : (p → (q → r)) ↔ (p ∧ q → r) :=
   have hlr: (p → (q → r)) →  (p ∧ q → r), from (
             assume h: p → q → r,
       assume hpq: p ∧ q,
       (h hpq.left) hpq.right
   ),
   have hrl: (p ∧ q → r) → (p → (q → r)), from (
       assume h: (p ∧ q → r),
       assume hp: p,
       assume hq: q,
       h (and.intro hp hq)
   ),
   iff.intro hlr hrl

example : ((p ∨ q) → r) ↔ (p → r) ∧ (q → r) :=
   have hlr: ((p ∨ q) → r) → (p → r) ∧ (q → r), from (
       assume h: ((p ∨ q) → r),
       have hpr: (p → r), from (
           assume hp: p,
           have hpq: p ∨ q, from or.intro_left q hp,
           h hpq
       ),
       have hqr: (q → r), from (
           assume hq: q,
           have hpq: p ∨ q, from or.intro_right p hq,
           h hpq
       ),
       and.intro hpr hqr
   ),
   have hrl: (p → r) ∧ (q → r) → ((p ∨ q) → r), from (
       assume hp: (p → r) ∧ (q → r),
       assume hpq: p ∨ q,
       or.elim hpq hp.left hp.right
   ),
   iff.intro hlr hrl

example : ¬(p ∨ q) ↔ ¬p ∧ ¬q :=
   iff.intro
       (
           assume h: ¬ (p ∨ q),
           have hnp: ¬ p, from (assume hp: p, absurd (or.intro_left q hp) h),
           have hnq: ¬ q, from (assume hq: q, absurd (or.intro_right p hq) h),
           and.intro hnp hnq
       )
       (
           assume h: ¬ p ∧ ¬ q,
           assume hpq: p ∨ q,
           or.elim hpq
               (assume hp: p, absurd hp h.left)
               (assume hq: q, absurd hq h.right)
       )

example : ¬p ∨ ¬q → ¬(p ∧ q) :=
   assume h: ¬ p ∨ ¬ q,
   assume hpq: p ∧ q,
   or.elim h
       (assume hnp: ¬ p, absurd hpq.left hnp)
       (assume hnq: ¬ q, absurd hpq.right hnq)

example : ¬(p ∧ ¬p) := assume h: p ∧ ¬ p, absurd h.left h.right
example : p ∧ ¬q → ¬(p → q) :=
   assume h: p ∧ ¬ q,
   assume hpq: p → q,
   absurd (hpq h.left) h.right

example : ¬p → (p → q) :=
   assume hnp: ¬ p,
   assume hp: p,
   absurd hp hnp

example : (¬p ∨ q) → (p → q) :=
   assume h: ¬ p ∨ q,
   or.elim h
       (assume hnp: ¬ p, assume hp: p, absurd hp hnp)
       (assume hq: q, assume hp: p, hq)
example : p ∨ false ↔ p := iff.intro
   (
       assume h: p ∨ false,
       or.elim h
           (assume hp: p, hp)
           (false.elim)
   )
   (assume p, or.intro_left false p)

example : p ∧ false ↔ false := iff.intro
   (assume h: p ∧ false, h.right)
   (false.elim)

example : ¬(p ↔ ¬p) :=
   assume h: (p ↔ ¬ p),
   have hnp: ¬ p, from (
       assume hp: p,
       absurd hp (h.mp hp)
   ),
   have hp: p, from h.mpr hnp,
   absurd hp (h.mp hp)
example : (p → q) → (¬q → ¬p) :=
   assume h: p → q,
   assume hnq: ¬ q,
   assume hp: p,
   absurd (h hp) hnq

-- these require classical reasoning
example : (p → r ∨ s) → ((p → r) ∨ (p → s)) :=
    assume h : p → r ∨ s,
    by_cases
        ( assume : p → r, or.intro_left (p → s) this )
        (
            assume : ¬ (p → r),
            have p → s, from (
                assume : p,
                show s, from by_contradiction (
                    assume : ¬ s,
                    have r ∨ s, from h ‹p›,
                    or.elim this
                        (
                            assume : r,
                            have p → r, from (assume : p, ‹r›),
                            absurd this ‹¬ (p → r)›
                        )
                        (
                            assume : s,
                            absurd this ‹¬ s›
                        )
                )
            ),
            or.intro_right (p → r) this
        )
example : ¬(p ∧ q) → ¬p ∨ ¬q :=
    assume h: ¬ (p ∧ q),
    by_cases
        (
            assume hp: p,
            have ¬ q, from (
                assume hq: q,
                absurd (and.intro hp hq) h
            ),
            or.intro_right (¬ p) this
        )
        (
            assume hnp: ¬ p,
            or.intro_left (¬ q) hnp
        )
example : ¬(p → q) → p ∧ ¬q :=
    assume h : ¬ (p → q),
    by_cases
        (
            assume : p,
            have ¬ q, from (
                assume : q,
                have p → q, from (
                    assume : p,
                    ‹ q ›
                ),
                absurd this h
            ),
            and.intro ‹p› this
        )
        (
            assume : ¬ p,
            have p → q, from (
                assume : p,
                absurd this ‹¬ p›
            ),
            absurd this h
        )
example : (p → q) → (¬p ∨ q) :=
    assume h : p → q,
    by_cases
        (assume : q, or.intro_right (¬ p) this)
        (
            assume : ¬ q,
            have ¬ p, from (
                assume : p,
                absurd (h this) ‹¬ q›
            ),
            or.intro_left q this
        )
example : (¬q → ¬p) → (p → q) :=
    assume h : ¬ q → ¬ p,
    assume hp : p,
    by_contradiction (
        assume : ¬ q,
        absurd hp (h this)
    )
example : p ∨ ¬p := em p
example : p ∨ ¬p :=
    by_cases
        (assume : p, or.intro_left (¬ p) this)
        (assume : ¬ p, or.intro_right p this)
example : (((p → q) → p) → p) :=
    assume h : (p → q) → p,
    by_cases
        (
            assume : p → q,
            show p, from h this
        )
        (
            assume : ¬ (p → q),
            show p, from by_contradiction (
                assume : ¬ p,
                have p → q, from (
                    assume : p,
                    absurd this ‹¬ p›
                ),
                absurd this ‹¬ (p → q)›
            )
        )


/-
Copyright (c) 2021 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import data.mv_polynomial.cardinal
import data.mv_polynomial.equiv
/-!
# Cardinality of Polynomial Ring

The reuslt in this file is that the cardinality of `polynomial R` is at most the maximum
of `#R` and `ω`.
-/
universe u

open_locale cardinal
open cardinal

namespace polynomial

lemma cardinal_mk_le_max {R : Type u} [comm_semiring R] : #(polynomial R) ≤ max (#R) ω :=
calc #(polynomial R) = #(mv_polynomial punit.{u + 1} R) :
  cardinal.eq.2 ⟨(mv_polynomial.punit_alg_equiv.{u u} R).to_equiv.symm⟩
... ≤ _ : mv_polynomial.cardinal_mk_le_max
... ≤ _ : begin
  have : #(punit.{u + 1}) ≤ ω, from le_of_lt (lt_omega_iff_fintype.2 ⟨infer_instance⟩),
  rw [max_assoc, max_eq_right this]
end

end polynomial


import MyNat.Definition
import MyNat.Power
import MyNat.Inequality -- LE
import InequalityWorld.Level4 -- zero_le
import InequalityWorld.Level5 -- le_trans
import InequalityWorld.Level17 -- lt, lt_iff_succ_le
import MultiplicationWorld.Level4 -- mul_add
import MultiplicationWorld.Level8 -- mul_comm
namespace MyNat
open MyNat

lemma lt_irrefl (a : MyNat) : ¬ (a < a) := by
  intro h
  cases h with
  | _ h1 h2 =>
    apply h2
    exact h1

lemma ne_of_lt (a b : MyNat) : a < b → a ≠ b := by
  intro h
  intro h1
  cases h with
  | _ h2 h3 =>
    apply h3
    rw [h1]

theorem not_lt_zero (a : MyNat) : ¬(a < 0) := by
  intro h
  cases h with
  | _ ha hna =>
    apply hna
    exact zero_le a

theorem lt_of_lt_of_le (a b c : MyNat) : a < b → b ≤ c → a < c := by
  intro hab
  intro hbc
  rw [lt_iff_succ_le] at hab ⊢
  cases hbc with
  | _ x hx =>
    cases hab with
    | _ y hy =>
      rw [hx]
      rw [hy]
      use y + x
      rw [add_assoc]

theorem lt_of_le_of_lt (a b c : MyNat) : a ≤ b → b < c → a < c := by
  intro hab
  intro hbc
  rw [lt_iff_succ_le] at hbc ⊢
  cases hbc with
  | _ x hx =>
    cases hab with
    | _ y hy =>
      rw [hx]
      rw [hy]
      use y + x
      rw [succ_add]
      rw [succ_add]
      rw [add_assoc]

theorem lt_trans (a b c : MyNat) : a < b → b < c → a < c := by
  intro hab
  intro hbc
  rw [lt_iff_succ_le] at hab hbc ⊢
  cases hbc with
  | _ x hx =>
    cases hab with
    | _ y hy =>
      rw [hx]
      rw [hy]
      use y + x + 1
      repeat rw [succ_add]
      repeat rw [succ_eq_add_one]
      simp

theorem lt_iff_le_and_ne (a b : MyNat) : a < b ↔ a ≤ b ∧ a ≠ b := by
  constructor
  {
    intro h
    cases h with
    | _ h1 h2 =>
      constructor
      assumption
      intro h
      apply h2
      rw [h]
  }
  {
    intro h
    cases h with
    | _ h1 h2 =>
    constructor
    exact h1
    intro h
    apply h2
    exact le_antisymm _ _ h1 h
  }

theorem lt_succ_self (n : MyNat) : n < succ n := by
  rw [lt_iff_le_and_ne]
  constructor
  {
    use 1
  }
  {
    intro h
    exact ne_succ_self n h
  }

lemma succ_le_succ_iff (m n : MyNat) : succ m ≤ succ n ↔ m ≤ n := by
  constructor
  {
    intro h
    cases h with
    | _ c hc =>
      use c
      apply succ_inj
      rw [hc]
      rw [succ_add]
  }
  {
    intro h
    cases h with
    | _ c hc =>
      use c
      rw [hc]
      rw [succ_add]
  }

lemma lt_succ_iff_le (m n : MyNat) : m < succ n ↔ m ≤ n := by
  rw [lt_iff_succ_le]
  exact succ_le_succ_iff m n

lemma le_of_add_le_add_left (a b c : MyNat) : a + b ≤ a + c → b ≤ c := by
  intro h
  cases h with
  | _ d hd =>
    use d
    apply add_left_cancel a
    rw [hd]
    rw [add_assoc]

lemma lt_of_add_lt_add_left (a b c : MyNat) : a + b < a + c → b < c := by
  repeat rw [lt_iff_succ_le]
  intro h
  apply le_of_add_le_add_left a
  rw [add_succ]
  assumption

lemma add_lt_add_right (a b : MyNat) : a < b → ∀ c : MyNat, a + c < b + c := by
  intro h
  intro c
  rw [lt_iff_succ_le] at h ⊢
  cases h with
  | _ d hd =>
    use d
    rw [hd]
    repeat rw [succ_add]
    rw [add_right_comm]

-- BUGBUG: collectibles
-- and now we get three achievements!
-- instance : ordered_comm_monoid MyNat :=
-- { add_le_add_left := λ _ _, add_le_add_left,
--   lt_of_add_lt_add_left := lt_of_add_lt_add_left,
--   ..MyNat.add_comm_monoid, ..MyNat.partial_order}
-- instance : canonically_ordered_monoid MyNat :=
-- { le_iff_exists_add := le_iff_exists_add,
--   bot := 0,
--   bot_le := zero_le,
--   ..MyNat.ordered_comm_monoid,
--   }
-- instance : ordered_cancel_comm_monoid MyNat :=
-- { add_left_cancel := add_left_cancel,
--   add_right_cancel := add_right_cancel,
--   le_of_add_le_add_left := le_of_add_le_add_left,
--   ..MyNat.ordered_comm_monoid}

def succ_lt_succ_iff (a b : MyNat) : succ a < succ b ↔ a < b := by
  repeat rw [lt_iff_succ_le]
  exact succ_le_succ_iff _ _

-- multiplication

theorem mul_le_mul_of_nonneg_left (a b c : MyNat) : a ≤ b → 0 ≤ c → c * a ≤ c * b := by
  intro hab
  intro h0
  cases hab with
  | _ d hd =>
    rw [hd]
    rw [mul_add]
    use c * d

theorem mul_le_mul_of_nonneg_right (a b c : MyNat) : a ≤ b → 0 ≤ c → a * c ≤ b * c := by
  intro hab
  intro h0
  rw [mul_comm]
  rw [mul_comm b]
  apply mul_le_mul_of_nonneg_left
  assumption
  assumption

theorem mul_lt_mul_of_pos_left (a b c : MyNat) : a < b → 0 < c → c * a < c * b := by
  intro hab
  intro hc
  cases c with
  | zero =>
    exfalso
    exact lt_irrefl 0 hc
  | succ d =>
    clear hc
    induction d with
    | zero =>
      rw [succ_mul, zero_is_0, zero_mul]
      rw [zero_add, succ_mul, zero_mul, zero_add]
      exact hab
    | succ e he =>
      rw [succ_mul]
      rw [succ_mul (succ e)]
      have h : succ e * a + a < succ e * b + a := by
        exact add_lt_add_right _ _ he _
      apply lt_trans _ _ _ h
      rw [add_comm]
      rw [add_comm _ b]
      apply add_lt_add_right
      assumption

theorem mul_lt_mul_of_pos_right (a b c : MyNat) : a < b → 0 < c → a * c < b * c := by
  intros ha h0
  rw [mul_comm]
  rw [mul_comm b]
  apply mul_lt_mul_of_pos_left
  assumption
  assumption

-- BUGBUG todo
-- And now another achievement! The naturals are an ordered semiring.
-- instance : ordered_semiring MyNat :=
-- { mul_le_mul_of_nonneg_left := mul_le_mul_of_nonneg_left,
--   mul_le_mul_of_nonneg_right := mul_le_mul_of_nonneg_right,
--   mul_lt_mul_of_pos_left := mul_lt_mul_of_pos_left,
--   mul_lt_mul_of_pos_right := mul_lt_mul_of_pos_right,
--   ..MyNat.semiring,
--   ..MyNat.ordered_cancel_comm_monoid
-- }

-- The Orderd semiring would give us this theorem, but we can do it manually instead.
lemma mul_le_mul {a b c d : MyNat} (hac : a ≤ c) (hbd : b ≤ d) (nn_b : 0 ≤ b) (nn_c : 0 ≤ c) : a * b ≤ c * d := by
  calc
    a * b ≤ c * b := mul_le_mul_of_nonneg_right _ _ _ hac nn_b
    _ ≤ c * d := mul_le_mul_of_nonneg_left _ _ _ hbd nn_c

lemma le_mul (a b c d : MyNat) : a ≤ b → c ≤ d → a * c ≤ b * d := by
  intros hab hcd
  induction a with
  | zero =>
    rw [zero_is_0, zero_mul]
    apply zero_le
  | succ t Ht =>
    have cz : 0 ≤ c := by
      apply zero_le
    have bz : 0 ≤ b := by
      apply zero_le
    apply mul_le_mul hab hcd cz bz

lemma pow_le (m n a : MyNat) : m ≤ n → m ^ a ≤ n ^ a := by
  intro h
  induction a with
  | zero =>
    rw [zero_is_0, pow_zero, pow_zero]
  | succ t Ht =>
    rw [pow_succ, pow_succ]
    apply le_mul
    assumption
    assumption

lemma strong_induction_aux (P : MyNat → Prop)
  (IH : ∀ m : MyNat, (∀ b : MyNat, b < m → P b) → P m)
  (n : MyNat) : ∀ c < n, P c := by
  induction n with
  | zero =>
    intro c
    intro hc
    exfalso
    revert hc
    exact not_lt_zero c
  | succ d hd =>
    intros e he
    rw [lt_succ_iff_le] at he
    apply IH
    intros b hb
    apply hd
    exact lt_of_lt_of_le _ _ _ hb he

theorem strong_induction (P : MyNat → Prop)
  (IH : ∀ m : MyNat, (∀ d : MyNat, d < m → P d) → P m) :
  ∀ n, P n := by
  intro n
  apply strong_induction_aux P IH (succ n)
  exact lt_succ_self n


import .love08_operational_semantics_exercise_sheet
import .love09_hoare_logic_demo

/-! # LoVe Homework 9: Hoare Logic

Homework must be done individually. -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/-! ## Question 1 (6 points): Hoare Logic for Dijkstra's Guarded Command Language

Recall the definition of GCL from exercise 8: -/

namespace gcl

#check stmt
#check big_step

/-! The definition of Hoare triples for partial correctness is unsurprising: -/

def partial_hoare (P : state → Prop) (S : stmt state) (Q : state → Prop) :
  Prop :=
∀s t, P s → (S, s) ⟹ t → Q t

local notation `{* ` P : 1 ` *} ` S : 1 ` {* ` Q : 1 ` *}` :=
partial_hoare P S Q

namespace partial_hoare

/-! 1.1 (4 points). Prove the following Hoare rules: -/

lemma consequence {P P' Q Q' : state → Prop} {S} (h : {* P *} S {* Q *})
    (hp : ∀s, P' s → P s) (hq : ∀s, Q s → Q' s) :
  {* P' *} S {* Q' *} :=
sorry

lemma assign_intro {P : state → Prop} {x} {a : state → ℕ}:
  {* λs, P (s{x ↦ a s}) *} stmt.assign x a {* P *} :=
sorry

lemma assert_intro {P Q : state → Prop} :
  {* λs, Q s → P s *} stmt.assert Q {* P *} :=
sorry

lemma seq_intro {P Q R S T} (hS : {* P *} S {* Q *}) (hT : {* Q *} T {* R *}) :
  {* P *} stmt.seq S T {* R *} :=
sorry

lemma choice_intro {P Q Ss}
    (h : ∀i (hi : i < list.length Ss), {* P *} list.nth_le Ss i hi {* Q *}) :
  {* P *} stmt.choice Ss {* Q *} :=
sorry

/-! 1.2 (2 points). Prove the rule for `loop`. Notice the similarity with the
rule for `while` in the WHILE language. -/

lemma loop_intro {P S} (h : {* P *} S {* P *}) :
  {* P *} stmt.loop S {* P *} :=
sorry

end partial_hoare

end gcl

/-! ## Question 2 (3 points): Factorial

The following WHILE program is intended to compute the factorial of `n`, leaving
the result in `r`. -/

def FACT : stmt :=
stmt.assign "r" (λs, 1) ;;
stmt.while (λs, s "n" ≠ 0)
  (stmt.assign "r" (λs, s "r" * s "n") ;;
   stmt.assign "n" (λs, s "n" - 1))

/-! 2.1 (1 point). Define the factorial function. -/

def fact : ℕ → ℕ :=
sorry

/-! 2.2 (2 points). Prove the correctness of `FACT` using `vcg`. -/

lemma FACT_correct (n₀ : ℕ) :
  {* λs, s "n" = n₀ *} FACT {* λs, s "r" = fact n₀ *} :=
sorry

end LoVe


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import algebra.big_operators data.nat.gcd

open finset

namespace nat

def totient (n : ℕ) : ℕ := ((range n).filter (nat.coprime n)).card

local notation `φ` := totient

lemma totient_le (n : ℕ) : φ n ≤ n :=
calc totient n ≤ (range n).card : card_le_of_subset (filter_subset _)
           ... = n              : card_range _

lemma totient_pos : ∀ {n : ℕ}, 0 < n → 0 < φ n
| 0 := dec_trivial
| 1 := dec_trivial
| (n+2) := λ h, card_pos.2 (mt eq_empty_iff_forall_not_mem.1
(not_forall_of_exists_not ⟨1, not_not.2 $ mem_filter.2 ⟨mem_range.2 dec_trivial, by simp [coprime]⟩⟩))

end nat


import DFA
import data.fintype.basic
import order.boolean_algebra
import data.quot

universes u v

def is_regular {α : Type u} [fintype α] (l : language α) : Prop :=
∃ (σ : Type v) [fintype σ] (A : DFA α σ), A.accepts = l

lemma is_regular_def {α : Type u} [fintype α] {l : language α} :
(is_regular.{u v}) l ↔ (∃ (σ : Type v) [fintype σ] (A : DFA α σ), A.accepts = l) :=
iff.refl _

namespace regular_language

open DFA

section basic
/--
Here we prove basic things on regular languages, such as the they form a boolean algebra
-/

variables {α : Type u} [fintype α]
variables {l l' : language α}

lemma inf_regular : (is_regular.{u v} l) → (is_regular.{u v} l') → is_regular.{u v} (l ⊓ l') :=
begin
  rintros ⟨σ, hσ, A, hA⟩,
  rintros ⟨τ, hτ, B, hB⟩,
  resetI,
  refine ⟨σ × τ, infer_instance, inter A B, _⟩,
  rw [inter_accepts, hA, hB],
end

lemma compl_regular : (is_regular.{u v} l) → (is_regular.{u v} lᶜ) :=
begin
  rintros ⟨Q, hQ, A, hA⟩,
  refine ⟨Q, hQ, A.compl, _⟩,
  rw [compl_accepts, hA]
end

lemma compl_regular_iff : (is_regular.{u v} lᶜ) ↔ (is_regular.{u v} l) :=
begin
  split,
  {
    intro h,
    rw ← compl_compl l,
    exact compl_regular h
  },
  { exact compl_regular },
end

lemma sup_regular : (is_regular.{u v} l) → (is_regular.{u v} l') → is_regular.{u v} (l ⊔ l') :=
begin
  intros hl hl',
  rw [←compl_compl (l ⊔ l'), compl_sup, compl_regular_iff],
  exact inf_regular (compl_regular hl) (compl_regular hl'),
end

end basic

section relation
/-!
### Myhill-Nerode theorem

Given `l`, we define an equivalence relation on `list α`.
The main theorem is that `l` is regular iff the number of
equivalence classes of this relation is finite.
-/

parameters {α : Type u} [fintype α]

section basic

parameters (l : language α)

/--
A relation on `list α`, identifying `x, y` if for all
`z : list α`, `(x ++ z ∈ l) ↔ (y ++ z ∈ l)`.
-/
def rel : list α → list α → Prop :=
λ x y, ∀ (z : list α), (x ++ z ∈ l) ↔ (y ++ z ∈ l)

parameter {l}

lemma iff_mem_language_of_equiv {x y : list α} (Rxy : rel x y) : x ∈ l ↔ y ∈ l :=
begin
  specialize Rxy [],
  repeat {rwa list.append_nil at Rxy},
end

parameter (l)

lemma rel_refl : reflexive (rel) := λ _ _, by refl
lemma rel_symm : symmetric (rel) := λ _ _ hxy z, iff.symm (hxy z)
lemma rel_trans : transitive (rel) := λ _ _ _ hxy hyz z, iff.trans (hxy z) (hyz z)
lemma rel_equiv : equivalence (rel) := ⟨rel_refl, rel_symm, rel_trans⟩

instance space.setoid : setoid (list α) := setoid.mk rel rel_equiv

definition space := quotient space.setoid

parameter {l}

definition mk (x : list α) : space := @quotient.mk _ space.setoid x

@[simp] lemma mk_def (x : list α) : mk x = @quotient.mk _ space.setoid x := rfl

end basic

section finite_class_space
/-!
### Myhill-Nerode, first direction

We build an automaton accepting `l` whose states are `space l`.
As a consequence, if `space l` is finite, then `l` is regular.
-/

parameters (l : language α)

def to_DFA : DFA α (space l) :=
{
  step := begin
    apply quot.lift (λ (z : list α) (σ : α), (mk (z ++ [σ]) : space l)),
    intros x y r,
    ext σ,
    simp only [regular_language.mk_def, quotient.eq],
    intro z,
    simp [r (σ :: z)],
  end,
  start := mk [],
  accept := begin
    apply quot.lift (∈ l),
    intros x y r,
    simp [iff_mem_language_of_equiv r],
  end
}

@[simp] lemma to_DFA_step (w : list α) (σ : α) : to_DFA.step (mk w) σ = mk (w ++ [σ]) := rfl
@[simp] lemma to_DFA_start : to_DFA.start = mk [] := rfl
@[simp] lemma to_DFA_accept (w : list α) : (mk w) ∈ to_DFA.accept ↔ w ∈ l := by refl

@[simp] lemma to_DFA_eval_from (x y : list α) : eval_from to_DFA (mk x) y = mk (x ++ y) :=
begin
  induction y with σ y generalizing x,
  {
    simp,
    exact rel_refl l _,
  },
  {
    specialize y_ih (x ++ [σ]),
    simp at *,
    exact y_ih,
  }
end

lemma to_DFA_accepts : accepts to_DFA = l :=
begin
  ext,
  rw [mem_accepts, to_DFA_start, to_DFA_eval_from, list.nil_append, to_DFA_accept],
end

theorem regular_of_fintype_language_space [fintype (space l)] : is_regular.{u u} l :=
  ⟨space l, infer_instance, to_DFA, to_DFA_accepts⟩

end finite_class_space

section regular
/-!
### Myhill-Nerode, the other direction.

Now we wish to prove that if `l` is regular then `space l` is finite.
We prove this using the canonical functions `Q ↩ DFA_space ↠ space l`,
the first of which we constructed in DFA.relation.
-/
parameters {Q : Type u} (A : DFA α Q)

private def l := A.accepts

@[simp] private lemma l_def : l = A.accepts := rfl

lemma language_rel_of_DFA_rel (x y : list α) : A.rel x y → rel l x y :=
begin
  intros r z,
  rw rel_def at r,
  rw [l_def, mem_accepts, mem_accepts, eval_from_of_append, eval_from_of_append,
  ← eval_def, ← eval_def, r],
end

definition language_space_of_DFA_space : A.space → space l :=
by exact quot.map id (language_rel_of_DFA_rel _)

@[simp] lemma language_space_of_DFA_space_def (w : list α) :
language_space_of_DFA_space (DFA.space.mk w) = mk w := rfl

lemma language_space_of_DFA_space_surjective : function.surjective language_space_of_DFA_space :=
begin
  apply quotient.ind,
  intro w,
  use DFA.space.mk w,
  rw language_space_of_DFA_space_def,
  refl
end

open classical
local attribute [instance] prop_decidable

noncomputable instance fintype_language_space_of_regular (l : language α) (r : is_regular l) :
fintype (space l) :=
begin
  choose Q fQ A hA using r,
  rw ← hA,
  resetI,
  haveI : fintype A.space := DFA.fintype_space_of_fintype_states _,
  exact fintype.of_surjective _ (language_space_of_DFA_space_surjective _),
end

end regular

end relation

end regular_language

variable (α : Type u)


variables p q r : Prop

namespace mth1001

section and_introduction

/-
In the previous section, we saw how to eliminate `∧`. That is, we saw how to take a premise
involving `∧` and derive a statement in which that occurrence of `∧` has been removed.

In this section, we do the opposite. We introduce `∧`.
-/

/-
The following can be read in standard maths as:

  Given `hp : p` and `hq : q`, `p ∧ q` follows by and introduction on `hp` and `hq`.

or:

  Given `p` and `q`, `p ∧ q` follows by and introduction on `p` and `q`.
-/
example (hp : p) (hq : q) : p ∧ q :=
and.intro hp hq

-- Below, the symbols `⟨` and `⟩` are entered as `\<` and `\>`.
example (hp : p) (hq : q) : p ∧ q :=
⟨hp, hq⟩

/-
Below, the `split` tactic decoposes the goal `p ∧ q` into two subgoals, `p`
and `q`. Compare this with the `cases` tactic that decomposes the premise.

We wrote write this in standard maths as:

  Given `hp : p` and `hq : q`, `p ∧ q` follows.
  Proof: It suffices to prove both `p` and `q`.
  `p` follows from `hp`.
  `q` follows from `hq`.

or:

  Given `p` and `q`, `p ∧ q` follows.
  Proof: It suffices to prove both `p` and `q`.
  `p` follows from `p`.
  `q` follows from `q`.
-/
example (hp : p) (hq : q) : p ∧ q :=
begin
  split,
    exact hp,
    exact hq,
end

-- It is considered good style to wrap braces around each new subgoal.
example (hp : p) (hq : q) : p ∧ q :=
begin
  split,
  { exact hp, },
  { exact hq, },
end

-- We can even combine tactic-style and term-style proofs.
example (hp : p) (hq : q) : p ∧ q :=
by exact and.intro hp hq

-- Exercise 016:
-- Use both `cases` and `split` to complete the following proof. Either write in Lean and convert
-- into standard maths or the other way round.
-- There isn't only one correct solution. Find as many essentially different solutions as you can.
example (h : p ∧ q) : q ∧ p :=
begin
  sorry
end

-- Exercise 017:
-- This time, use `cases`, but complete the proof using `and.intro` or `⟨` and `⟩`
example (h : p ∧ q) : q ∧ p :=
begin
  sorry
end

-- Exercise 018:
-- Give a one-line proof term.
example (h : p ∧ q) : q ∧ p :=
sorry

-- We'll prove one direction of associativity of `∧`. First using tactics.
example (h : p ∧ (q ∧ r)) : (p ∧ q) ∧ r :=
begin
  cases h with hp hqr,
  cases hqr with hq hr,
  split,
  { split,
    { exact hp, },
    { exact hq, }},
  { exact hr, },
end

-- Now as a purely term-style proof. Not very readable!
example (h : p ∧ (q ∧ r)) : (p ∧ q) ∧ r :=
⟨ ⟨h.1, h.2.1 ⟩, h.2.2 ⟩

-- To aid readability, we can introduce statements into the context using `have`.
-- In tactic mode, the `have` tactic must be followed by a tactic that closes the goal.
example (h : p ∧ q) : q ∧ p :=
begin
  have hp : p,
  { exact h.left, },
  have hq : q,
  { exact h.right, },
  exact ⟨hq, hp⟩, -- Here, `⟨hq, hp⟩` is a abbreviation of `and.intro hq hp`.
end

-- In a term-style proof, we use `have` … `from`.
example (h : p ∧ q) : q ∧ p :=
have hp : p, from h.left,
have hq : q, from h.right,
⟨hq, hp⟩

-- We can emulate the term-style `have` … `from` in tactic mode using either
example (h : p ∧ q) : q ∧ p :=
begin
  have hp : p, from h.left,
  have hq : q := h.right,
  exact and.intro hq hp, -- I could have written `⟨hq, hp⟩` instead of `and.intro hq hp`.
end

-- Exercise 019:
-- Fill in the `sorry`s below to give a proof of the goal introduced by the `have` tactic.
example (h : p ∧ (q ∧ r)) : (p ∧ q) ∧ r :=
begin
  cases h with hp hqr,
  have hpq : p ∧ q, -- Follow `have` by a tactic that closes the goal `p ∧ q`.
  { split,
    { sorry, },
    { sorry, }, },
  have hr : r, from -- `have` … `from` should be followed by a proof term for the goal `r`.
    sorry,
  exact ⟨hpq, hr⟩,
end

-- Exercise 020:
-- Complete the following term-style proof of the above result.
example (h : p ∧ (q ∧ r)) : (p ∧ q) ∧ r :=
have hp : p, from sorry,
have hqr : q ∧ r, from h.2,
have hpq : p ∧ q, from sorry,
have hr : r, from hqr.2,
⟨hpq, hr⟩

-- To further aid readability, `show` … `from` indicates what we are proving.
example (h : p ∧ (q ∧ r)) : (p ∧ q) ∧ r :=
have hp : p, from sorry,
have hqr : q ∧ r, from h.2,
have hpq : p ∧ q, from sorry,
have hr : r, from hqr.2,
show (p ∧ q) ∧ r, from ⟨hpq, hr⟩

-- Exercise 021:
/-
Prove the other direction of associativity of `∧`. Choose whatever proof style you like.
Add `begin` and `end` if you want to use a tactic-style proof.
-/
example (h : (p ∧ q) ∧ r) : p ∧ (q ∧ r) :=
sorry

end and_introduction

/-
SUMMARY

* And introduction.
* Term-style proof using `and.intro` or `⟨` and `⟩`.
* Tactic-sytyle and introduction using `split`.
* Proving intermediate steps with `have`.
* Using `show` to indicate what is being proved.
-/

end mth1001


import .lovelib

/-! # LoVe Homework 8: Operational Semantics

Homework must be done individually. -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/-! ## Question 1 (6 points + 1 bonus point): Semantics of the REPEAT Language

We introduce REPEAT, a programming language that resembles the WHILE language
but whose defining feature is a `repeat` loop.

The Lean definition of its abstract syntax tree follows: -/

inductive stmt : Type
| skip   : stmt
| assign : string → (state → ℕ) → stmt
| seq    : stmt → stmt → stmt
| unless : (state → Prop) → stmt → stmt
| repeat : ℕ → stmt → stmt

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

/-! The `skip`, `assign`, and `S ;; T` statements have the same syntax and
semantics as in the WHILE language.

The `unless b S` statement executes `S` unless `b` is true—i.e., it executes `S`
if `b` is false. Otherwise, `unless b S` does nothing. This construct is
inspired by the Perl language.

The `repeat n S` statement executes `S` exactly `n` times. Thus, `repeat 5 S`
has the same effect as `S ;; S ;; S ;; S ;; S` (as far as the big-step semantics
is concerned), and `repeat 0 S` has the same effect as `skip`.

1.1 (1.5 points). Complete the following definition of a big-step
semantics: -/

inductive big_step : stmt × state → state → Prop
| skip {s} :
  big_step (stmt.skip, s) s
-- enter the missing cases here

infix ` ⟹ ` : 110 := big_step

/-! 1.2 (1.5 points). Complete the following definition of a small-step
semantics: -/

inductive small_step : stmt × state → stmt × state → Prop
| assign {x a s} :
  small_step (stmt.assign x a, s) (stmt.skip, s{x ↦ a s})
-- enter the missing cases here

infixr ` ⇒ ` := small_step
infixr ` ⇒* ` : 100 := star small_step

/-! 1.3 (1 point). We will now attempt to prove termination of the REPEAT
language. More precisely, we will show that there cannot be infinite chains of
the form

    `(S₀, s₀) ⇒ (S₁, s₁) ⇒ (S₂, s₂) ⇒ ⋯`

Towards this goal, you are asked to define a __measure__ function: a function
`mess` that takes a statement `S` and that returns a natural number indicating
how "big" the statement is. The measure should be defined so that it strictly
decreases with each small-step transition. -/

def mess : stmt → ℕ
| stmt.skip         := 0
-- enter the missing cases here

/-! 1.4 (1 point). Consider the following program `S₀`: -/

def incr (x : string) : stmt :=
stmt.assign x (λs, s x + 1)

def S₀ : stmt :=
stmt.repeat 1 (incr "m" ;; incr "n")

/-! Check that `mess` strictly decreases with each step of its small-step
evaluation, by giving `S₀`, `S₁`, `S₂`, …, as well as the corresponding values
of `mess` (which you can obtain using `#eval`). -/

-- enter your answer here

/-! 1.5 (1 point). Prove that the measure decreases with each small-step
transition. If necessary, revise your answer to question 1.3. -/

lemma small_step_mess_decreases {Ss Tt : stmt × state} (h : Ss ⇒ Tt) :
  mess (prod.fst Ss) > mess (prod.fst Tt) :=
sorry

/-! 1.6 (1 bonus point). Prove that the inverse of the `⇒` relation is well
founded. The inverse is simply `λTt Ss, Ss ⇒ Tt`. A relation `≺` is well founded
if there exist no infinite left-descending chains of the form

    `⋯ ≺ x₂ ≺ x₁ ≺ x₀`

Proof strategy: The `measure` function from `mathlib` converts a function to `ℕ`
to a relation, using `<` to compare two numbers. Hence, start by proving that
`measure mess`, or rather `measure (mess ∘ prod.fst)`, is well founded. Here,
`library_search` can help, or just search manually in `wf.lean`, close to the
definition of `measure`. Then prove that `λTt Ss, Ss ⇒ Tt` is a subrelation of
`measure (mess ∘ prod.fst)` (using lemma `small_step_mess_decreases` from
question 1.5) and therefore (using another lemma from `wf.lean`) that it must be
well founded. -/

lemma small_step_wf :
  well_founded (λTt Ss, Ss ⇒ Tt) :=
sorry

/-! ## Question 2 (3 points): Inversion Rules

2.1 (1 point). Prove the following inversion rule for the big-step semantics
of `unless`. -/

lemma big_step_ite_iff {b S s t} :
  (stmt.unless b S, s) ⟹ t ↔ (b s ∧ s = t) ∨ (¬ b s ∧ (S, s) ⟹ t) :=
sorry

/-! 2.2 (2 points). Prove the following inversion rule for the big-step
semantics of `repeat`. -/

lemma big_step_repeat_iff {n S s u} :
  (stmt.repeat n S, s) ⟹ u ↔
  (n = 0 ∧ u = s)
  ∨ (∃m t, n = m + 1 ∧ (S, s) ⟹ t ∧ (stmt.repeat m S, t) ⟹ u) :=
sorry

end LoVe


import MyNat.Definition
namespace MyNat
open MyNat

/-!
# Function World

## Level 3: the `have` tactic.

Say you have a whole bunch of sets and functions between them,
and your goal is to build a certain element of a certain set.
If it helps, you can build intermediate elements of other sets
along the way, using the [have tactic](../Tactics/have.lean.md). `have` is the Lean analogue
of saying "let's define an element `q ∈ Q` by..." in the middle of a calculation.
It is often not logically necessary, but on the other hand
it is very convenient, for example it can save on notation, or
it can break proofs or calculations up into smaller steps.

In this level, we have an element of `P` and we want an element
of `U`; during the proof we will make several intermediate elements
of some of the other sets involved. The diagram of sets and
functions looks like this pictorially:

![diagram](../assets/function_diag.svg)

and so it's clear how to make the element of `U` from the element of `P.`
Indeed, we could solve this level in one move by typing

`exact l (j (h p))`

But let us instead stroll more lazily through the level.
We can start by using the `have` tactic to make an element of `Q`:

`have q := h p`

and then we note that `j q` is an element of `T`

`have t : T := j q`

(notice how on this occasion we explicitly told Lean what set we thought `t` was in, with
that `: T` thing before the `:=`) and we could even define `u` to be `l t`:

`have u : U := l t`

and then finish the level with `exact u`.

## Definition
Given an element of `P` we can define an element of `U`.

-/
example (P Q R S T U: Type)
(p : P)
(h : P → Q)
(i : Q → R)
(j : Q → T)
(k : S → T)
(l : T → U)
: U := by
  have q := h p
  have t : T := j q
  have u : U := l t
  exact u

/-!
Remember you can move your cursor around with the arrow keys and explore the various tactic states
in this proof in Visual Studio Code, and note that the tactic state at the beginning of `exact u` is
this mess:

```
P Q R S T U : Type,
p : P,
h : P → Q,
i : Q → R,
j : Q → T,
k : S → T,
l : T → U,
q : Q,
t : T,
u : U
⊢ U
```

It was already bad enough to start with, and we added three more
terms to it. In level 4 we will learn about the `apply` tactic
which solves the level using another technique, without leaving
so much junk behind.

Next up [Level 4](./Level4.lean.md)
-/


/-
Copyright (c) 2023 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/
import algebra.monoid_algebra.ideal
import data.mv_polynomial.division

/-!
# Lemmas about ideals of `mv_polynomial`

Notably this contains results about monomial ideals.

## Main results

* `mv_polynomial.mem_ideal_span_monomial_image`
* `mv_polynomial.mem_ideal_span_X_image`
-/

variables {σ R : Type*}

namespace mv_polynomial
variables [comm_semiring R]

/-- `x` is in a monomial ideal generated by `s` iff every element of of its support dominates one of
the generators. Note that `si ≤ xi` is analogous to saying that the monomial corresponding to `si`
divides the monomial corresponding to `xi`. -/
lemma mem_ideal_span_monomial_image
  {x : mv_polynomial σ R} {s : set (σ →₀ ℕ)} :
  x ∈ ideal.span ((λ s, monomial s (1 : R)) '' s) ↔ ∀ xi ∈ x.support, ∃ si ∈ s, si ≤ xi :=
begin
  refine add_monoid_algebra.mem_ideal_span_of'_image.trans _,
  simp_rw [le_iff_exists_add, add_comm],
  refl,
end

lemma mem_ideal_span_monomial_image_iff_dvd {x : mv_polynomial σ R} {s : set (σ →₀ ℕ)} :
  x ∈ ideal.span ((λ s, monomial s (1 : R)) '' s) ↔
    ∀ xi ∈ x.support, ∃ si ∈ s, monomial si 1 ∣ monomial xi (x.coeff xi) :=
begin
  refine mem_ideal_span_monomial_image.trans (forall₂_congr $ λ xi hxi, _),
  simp_rw [monomial_dvd_monomial, one_dvd, and_true, mem_support_iff.mp hxi, false_or],
end

/-- `x` is in a monomial ideal generated by variables `X` iff every element of of its support
has a component in `s`. -/
lemma mem_ideal_span_X_image {x : mv_polynomial σ R} {s : set σ} :
  x ∈ ideal.span (mv_polynomial.X '' s : set (mv_polynomial σ R)) ↔
    ∀ m ∈ x.support, ∃ i ∈ s, (m : σ →₀ ℕ) i ≠ 0 :=
begin
  have := @mem_ideal_span_monomial_image σ R _ _ ((λ i, finsupp.single i 1) '' s),
  rw set.image_image at this,
  refine this.trans _,
  simp [nat.one_le_iff_ne_zero],
end

end mv_polynomial


/-
Copyright (c) 2023 María Inés de Frutos-Fernández. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : María Inés de Frutos-Fernández
-/

import data.set.lattice -- para uniones e intersecciones arbitrarias

/-

# Conjuntos

Recordad que `set X` es el tipo de subconjuntos de `X`. Es decir, `S : set X`
indica que `S` es un conjunto de términos de `X`.

En la segunda sesión del curso, aprendimos a indicar pertenencia a
un conjunto (`x ∈ S`, donde `x : X`) y demostramos algunos lemas sobre
inclusión de conjuntos (`⊆`), uniones (`∪`) e intersecciones (`∩`).

## Detalle de implementación

Internamente, `set X` está implementado como una función de `X` a `Prop`.
Un `S : set X` está representado mediante la función que manda todos
los elementos de `S` a `true` y el resto de elementos de `X` a `false.`
El enunciado `a ∈ S` está representado por la proposición `S a`.

Sin embargo, para trabajar con conjuntos en Lean no es necesario conocer
este detalle de implementación, sino cuál es la API disponible (es decir,
qué resultados sobre conjuntos ya están demostrados en mathlib).

## Notación

Dados tipos `(X Y : Type)` y una función `f : X → Y`:

El conjunto vacío es `∅ : set X`.

El conjunto que contiene todos los elementos de `X` es `univ : set X`.

El complemento de `S : set X` es `Sᶜ : set X`.

Dado `S : set X`, la imagen de `S` bajo `f` se denota como `f '' S : set Y`.

Dado `T : set Y`, `f ⁻¹' T : set X` denota la preimagen de `T`.

El rango de `f` se puede escribir como `f '' univ` ó `range f`.

-/

variables (X Y Z : Type) (f : X → Y) (g : Y → Z) (S : set X) (y : Y)

open set

/-!

## Imagen

`y ∈ f '' S` es definicionalmente igual a `∃ x : X, x ∈ S ∧ f x = y`,
y el correspondiente lema de reescritura es
`mem_image f S y : y ∈ f '' S ↔ ∃ (x : X), x ∈ S ∧ f x = y`
-/

-- Vamos a ver cómo simplificar el siguiente ejemplo.
example : id '' S = S :=
begin
  ext x,
  split,
  { intro hx,
    rw mem_image at hx,
    obtain ⟨x', h, h'⟩ := hx,
    rw ← h',
    exact h, },
  { intro hx,
    rw mem_image,
    use x,
    use hx,
    refl, },
end

-- Aunque por supuesto ya lo tenemos en mathlib:
example : id '' S = S :=
begin
  apply image_id', -- por ejemplo, `simp` o `library_search` lo demostrarían
end

lemma image_comp (S : set X) : (g ∘ f) '' S = g '' (f '' S) :=
begin
  sorry
end

open function

-- Recordad que podéis usar `dsimp only` para simplificar las evaluaciones de lambdas.
lemma image_injective : injective f → injective (λ S, f '' S) :=
begin
  sorry
end

/-!

## Preimagen

Por definición, tenemos `x ∈ f ⁻¹' T ↔ f x ∈ T`. El correspondiente lema
de reescritura es `mem_preimage : x ∈ f ⁻¹' T ↔ f x ∈ T`.
-/

example (S : set X) : S = id ⁻¹' S :=
begin
  sorry
end

-- Una vez terminado este ejercicio, mirad la solución propuesta.
example (T : set Z) : (g ∘ f) ⁻¹' T = f ⁻¹' (g ⁻¹' T) :=
begin
  refl,
end

/-- `squeeze_simp` o ` library_search` encuentran la demostración de este lema
  y los dos siguientes en la librería, pero intentad demostrarlos a partir de
  las definiciones. -/
lemma preimage_injective (hf : surjective f) : injective (λ T, f ⁻¹' T) :=
begin
  sorry
end

lemma image_surjective (hf : surjective f) : surjective (λ S, f '' S) :=
begin
  sorry
end

lemma preimage_surjective (hf : injective f) : surjective (λ S, f ⁻¹' S) :=
begin
  sorry
end

/-!

## Uniones arbitrarias (`Union`)

Dado un tipo `(ι : Type)` y una función `(F : ι → set X)` , los
`F i` para `i : ι` son una familia de subconjuntos de `X`, y por
tanto podemos tomar su unión.
En Lean, esto se representa mediante `Union F` (la U mayúscula es
necesaria para uniones arbitrarias). También está disponible la
notación `⋃ (i : ι), F i`.

Podéis utilizar el siguiente lema, que dice que `x : X` pertenece
a `Union F` si y sólo si pertenece a uno de los conjuntos `F i`:
`mem_Union : (x ∈ ⋃ (i : ι), F i) ↔ ∃ j : ι, x ∈ F j`

-/

variables (ι : Type) (F : ι → set X) (x : X)

lemma image_Union (F : ι → set X) (f : X → Y) :
  f '' (⋃ (i : ι), F i) = ⋃ (i : ι), f '' (F i) :=
begin
  sorry
end

/-!

## bUnion

En ocasiones, dados `ι : Type` y `F : ι → set X`, no queremos tomar
la unión sobre todos los términos de `ι`, sino sólo sobre
aquéllos que pertenezcan a un subconjunto `Z : set ι`.
Para ello podemos utilizar la notación `⋃ (i ∈ Z), F i`.

Los lemas para este tipo de uniones tienen `bUnion` en el nombre.
Por ejemplo:
`mem_bUnion_iff : (x ∈ ⋃ (i ∈ J), F i) ↔ ∃ (j ∈ J), x ∈ F j`

-/

lemma preimage_bUnion (F : ι → set Y) (Z : set ι) :
  f ⁻¹' (⋃ (i ∈ Z), F i) = ⋃ (i ∈ Z), f ⁻¹' (F i) :=
begin
  sorry
end


/-
Copyright (c) 2021 Kexing Ying. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kexing Ying, Eric Wieser

! This file was ported from Lean 3 source module data.real.sign
! leanprover-community/mathlib commit 9003f28797c0664a49e4179487267c494477d853
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Real.Basic

/-!
# Real sign function

This file introduces and contains some results about `Real.sign` which maps negative
real numbers to -1, positive real numbers to 1, and 0 to 0.

## Main definitions

 * `Real.sign r` is $\begin{cases} -1 & \text{if } r < 0, \\
                               ~~\, 0 & \text{if } r = 0, \\
                               ~~\, 1 & \text{if } r > 0. \end{cases}$

## Tags

sign function
-/

namespace Real

/-- The sign function that maps negative real numbers to -1, positive numbers to 1, and 0
otherwise. -/
noncomputable def sign (r : ℝ) : ℝ :=
  if r < 0 then -1 else if 0 < r then 1 else 0
#align real.sign Real.sign

theorem sign_of_neg {r : ℝ} (hr : r < 0) : sign r = -1 := by rw [sign, if_pos hr]
#align real.sign_of_neg Real.sign_of_neg

theorem sign_of_pos {r : ℝ} (hr : 0 < r) : sign r = 1 := by rw [sign, if_pos hr, if_neg hr.not_lt]
#align real.sign_of_pos Real.sign_of_pos

@[simp]
theorem sign_zero : sign 0 = 0 := by rw [sign, if_neg (lt_irrefl _), if_neg (lt_irrefl _)]
#align real.sign_zero Real.sign_zero

@[simp]
theorem sign_one : sign 1 = 1 :=
  sign_of_pos <| by norm_num
#align real.sign_one Real.sign_one

theorem sign_apply_eq (r : ℝ) : sign r = -1 ∨ sign r = 0 ∨ sign r = 1 := by
  obtain hn | rfl | hp := lt_trichotomy r (0 : ℝ)
  · exact Or.inl <| sign_of_neg hn
  · exact Or.inr <| Or.inl <| sign_zero
  · exact Or.inr <| Or.inr <| sign_of_pos hp
#align real.sign_apply_eq Real.sign_apply_eq

/-- This lemma is useful for working with `ℝˣ` -/
theorem sign_apply_eq_of_ne_zero (r : ℝ) (h : r ≠ 0) : sign r = -1 ∨ sign r = 1 :=
  h.lt_or_lt.imp sign_of_neg sign_of_pos
#align real.sign_apply_eq_of_ne_zero Real.sign_apply_eq_of_ne_zero

@[simp]
theorem sign_eq_zero_iff {r : ℝ} : sign r = 0 ↔ r = 0 := by
  refine' ⟨fun h => _, fun h => h.symm ▸ sign_zero⟩
  obtain hn | rfl | hp := lt_trichotomy r (0 : ℝ)
  · rw [sign_of_neg hn, neg_eq_zero] at h
    exact (one_ne_zero h).elim
  · rfl
  · rw [sign_of_pos hp] at h
    exact (one_ne_zero h).elim
#align real.sign_eq_zero_iff Real.sign_eq_zero_iff

theorem sign_int_cast (z : ℤ) : sign (z : ℝ) = ↑(Int.sign z) := by
  obtain hn | rfl | hp := lt_trichotomy z (0 : ℤ)
  · rw [sign_of_neg (Int.cast_lt_zero.mpr hn), Int.sign_eq_neg_one_of_neg hn, Int.cast_neg,
      Int.cast_one]
  · rw [Int.cast_zero, sign_zero, Int.sign_zero, Int.cast_zero]
  · rw [sign_of_pos (Int.cast_pos.mpr hp), Int.sign_eq_one_of_pos hp, Int.cast_one]
#align real.sign_int_cast Real.sign_int_cast

theorem sign_neg {r : ℝ} : sign (-r) = -sign r := by
  obtain hn | rfl | hp := lt_trichotomy r (0 : ℝ)
  · rw [sign_of_neg hn, sign_of_pos (neg_pos.mpr hn), neg_neg]
  · rw [sign_zero, neg_zero, sign_zero]
  · rw [sign_of_pos hp, sign_of_neg (neg_lt_zero.mpr hp)]
#align real.sign_neg Real.sign_neg

theorem sign_mul_nonneg (r : ℝ) : 0 ≤ sign r * r := by
  obtain hn | rfl | hp := lt_trichotomy r (0 : ℝ)
  · rw [sign_of_neg hn]
    exact mul_nonneg_of_nonpos_of_nonpos (by norm_num) hn.le
  · rw [mul_zero]
  · rw [sign_of_pos hp, one_mul]
    exact hp.le
#align real.sign_mul_nonneg Real.sign_mul_nonneg

theorem sign_mul_pos_of_ne_zero (r : ℝ) (hr : r ≠ 0) : 0 < sign r * r := by
  refine' lt_of_le_of_ne (sign_mul_nonneg r) fun h => hr _
  have hs0 := (zero_eq_mul.mp h).resolve_right hr
  exact sign_eq_zero_iff.mp hs0
#align real.sign_mul_pos_of_ne_zero Real.sign_mul_pos_of_ne_zero

@[simp]
theorem inv_sign (r : ℝ) : (sign r)⁻¹ = sign r := by
  obtain hn | hz | hp := sign_apply_eq r
  · rw [hn]
    norm_num
  · rw [hz]
    exact inv_zero
  · rw [hp]
    exact inv_one
#align real.inv_sign Real.inv_sign

@[simp]
theorem sign_inv (r : ℝ) : sign r⁻¹ = sign r := by
  obtain hn | rfl | hp := lt_trichotomy r (0 : ℝ)
  · rw [sign_of_neg hn, sign_of_neg (inv_lt_zero.mpr hn)]
  · rw [sign_zero, inv_zero, sign_zero]
  · rw [sign_of_pos hp, sign_of_pos (inv_pos.mpr hp)]
#align real.sign_inv Real.sign_inv

end Real


import group.definitions -- definition of a group and a comm_group

/-
class group (G : Type) extends has_group_notation G :=
(mul_assoc : ∀ (a b c : G), a * b * c = a * (b * c))
(one_mul : ∀ (a : G), 1 * a = a)
(mul_left_inv : ∀ (a : G), a⁻¹ * a = 1)

and `comm_group G` has the extra axiom

`mul_comm : ∀ (x y : G), x * y = y * x`

You access these axioms with `group.mul_assoc`, `group.one_mul` etc.
-/

-- This entire project takes place in the mygroup namespace
namespace mygroup

/- Our goal is to prove the following theorems (in the order
  listed) :

`mul_left_cancel : ∀ (a b c : G), a * b = a * c → b = c`
`mul_eq_of_eq_inv_mul {a x y : G} : x = a⁻¹ * y → a * x = y`
`mul_one (a : G) : a * 1 = a`
`mul_right_inv (a : G) : a * a⁻¹ = 1`
`eq_mul_inv_of_mul_eq {a b c : G} (h : a * c = b) : a = b * c⁻¹`
`mul_left_eq_self {a b : G} : a * b = b ↔ a = 1`
`eq_inv_of_mul_eq_one {a b : G} (h : a * b = 1) : a = b⁻¹`
`inv_inv (a : G) : a ⁻¹ ⁻¹ = a`
`inv_eq_of_mul_eq_one {a b : G} (h : a * b = 1) : a⁻¹ = b`

and possibly more to come if we run into stuff we need.

We start with only `mul_assoc`, `one_mul` and `mul_left_inv`.

mul_assoc : ∀ (a b c : G), a * b * c = a * (b * c)
one_mul : ∀ (a : G), 1 * a = a
mul_left_inv : ∀ (a : G), a⁻¹ * a = 1

-/
namespace group

variables {G : Type} [group G]

lemma mul_left_cancel (a x y : G) (Habac : a * x = a * y) : x = y :=
begin
  sorry
end

lemma mul_eq_of_eq_inv_mul {a x y : G} (h : x = a⁻¹ * y) : a * x = y :=
begin
  sorry
end

theorem mul_one (a : G) : a * 1 = a :=
begin
  sorry
end

theorem mul_right_inv (a : G) : a * a⁻¹ = 1 :=
begin
  sorry
end

lemma eq_mul_inv_of_mul_eq {a b c : G} (h : a * c = b) : a = b * c⁻¹ :=
begin
  sorry
end

lemma mul_left_eq_self {a b : G} : a * b = b ↔ a = 1 :=
begin
  sorry
end

lemma eq_inv_of_mul_eq_one {a b : G} (h : a * b = 1) : a = b⁻¹ :=
begin
  sorry
end

lemma inv_inv (a : G) : a ⁻¹ ⁻¹ = a :=
begin
  sorry
end

lemma inv_eq_of_mul_eq_one {a b : G} (h : a * b = 1) : a⁻¹ = b :=
begin
  sorry
end

end group

end mygroup


/-
Copyright (c) 2014 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.

Module init.relation
Authors: Leonardo de Moura
-/
prelude
import init.logic

-- TODO(Leo): remove duplication between this file and algebra/relation.lean
-- We need some of the following definitions asap when "initializing" Lean.

variables {A B : Type} (R : B → B → Prop)
local infix `≺`:50 := R

definition reflexive := ∀x, x ≺ x

definition symmetric := ∀⦃x y⦄, x ≺ y → y ≺ x

definition transitive := ∀⦃x y z⦄, x ≺ y → y ≺ z → x ≺ z

definition equivalence := reflexive R ∧ symmetric R ∧ transitive R

definition total := ∀ x y, x ≺ y ∨ y ≺ x

definition mk_equivalence (r : reflexive R) (s : symmetric R) (t : transitive R) : equivalence R :=
and.intro r (and.intro s t)

definition irreflexive := ∀x, ¬ x ≺ x

definition anti_symmetric := ∀⦃x y⦄, x ≺ y → y ≺ x → x = y

definition empty_relation := λa₁ a₂ : A, false

definition subrelation (Q R : B → B → Prop) := ∀⦃x y⦄, Q x y → R x y

definition inv_image (f : A → B) : A → A → Prop :=
λa₁ a₂, f a₁ ≺ f a₂

theorem inv_image.trans (f : A → B) (H : transitive R) : transitive (inv_image R f) :=
λ (a₁ a₂ a₃ : A) (H₁ : inv_image R f a₁ a₂) (H₂ : inv_image R f a₂ a₃), H H₁ H₂

theorem inv_image.irreflexive (f : A → B) (H : irreflexive R) : irreflexive (inv_image R f) :=
λ (a : A) (H₁ : inv_image R f a a), H (f a) H₁

inductive tc {A : Type} (R : A → A → Prop) : A → A → Prop :=
| base  : ∀a b, R a b → tc R a b
| trans : ∀a b c, tc R a b → tc R b c → tc R a c


import tactic.ring
import data.real.basic
import algebra.parity

example (x y : ℕ) : x + y = y + x := by ring
example (x y : ℕ) : x + y + y = 2 * y + x := by ring
example (x y : ℕ) : x + id y = y + id x := by ring!
example {α} [comm_ring α] (x y : α) : x + y + y - x = 2 * y := by ring
example (x y : ℚ) : x / 2 + x / 2 = x := by ring
example (x y : ℚ) : (x + y) ^ 3 = x ^ 3 + y ^ 3 + 3 * (x * y ^ 2 + x ^ 2 * y) := by ring
example (x y : ℝ) : (x + y) ^ 3 = x ^ 3 + y ^ 3 + 3 * (x * y ^ 2 + x ^ 2 * y) := by ring
example {α} [comm_semiring α] (x : α) : (x + 1) ^ 6 = (1 + x) ^ 6 := by try_for 15000 {ring}
example (n : ℕ) : (n / 2) + (n / 2) = 2 * (n / 2) := by ring
example {α} [field α] [char_zero α] (a : α) : a / 2 = a / 2 := by ring
example {α} [linear_ordered_field α] (a b c : α) :
  a * (-c / b) * (-c / b) + -c + c = a * (c / b * (c / b)) := by ring
example {α} [linear_ordered_field α] (a b c : α) :
  b ^ 2 - 4 * c * a = -(4 * c * a) + b ^ 2 := by ring
example (x : ℚ) : x ^ (2 + 2) = x^4 := by ring_nf -- TODO: ring should work?
example {α} [comm_ring α] (x : α) : x ^ 2 = x * x := by ring
example {α} [linear_ordered_field α] (a b c : α) :
  b ^ 2 - 4 * c * a = -(4 * c * a) + b ^ 2 := by ring
example {α} [linear_ordered_field α] (a b c : α) :
  b ^ 2 - 4 * a * c = 4 * a * 0 + b * b - 4 * a * c := by ring
example {α} [comm_semiring α] (x y z : α) (n : ℕ) :
  (x + y) * (z * (y * y) + (x * x ^ n + (1 + ↑n) * x ^ n * y)) =
    x * (x * x ^ n) + ((2 + ↑n) * (x * x ^ n) * y + (x * z + (z * y + (1 + ↑n) * x ^ n)) * (y * y)) := by ring
example {α} [comm_ring α] (a b c d e : α) :
  (-(a * b) + c + d) * e = (c + (d + -a * b)) * e := by ring
example (a n s: ℕ) : a * (n - s) = (n - s) * a := by ring

example (x y z : ℚ) (hx : x ≠ 0) (hy : y ≠ 0) (hz : z ≠ 0) :
  x / (y / z) + y ⁻¹ + 1 / (y * -x) = -1/ (x * y) + (x * z + 1) / y :=
begin
  field_simp,
  ring
end

example {A : ℤ} (f : ℤ → ℤ) : f 0 = f (A - A) := by ring_nf
example {A : ℤ} (f : ℤ → ℤ) : f 0 = f (A + -A) := by ring_nf

example {a b c : ℝ} (h : 0 < a ^ 4 + b ^ 4 + c ^ 4) :
  a ^ 4 / (a ^ 4 + b ^ 4 + c ^ 4) +
  b ^ 4 / (b ^ 4 + c ^ 4 + a ^ 4) +
  c ^ 4 / (c ^ 4 + a ^ 4 + b ^ 4)
  = 1 :=
begin
  ring_nf at ⊢ h,
  field_simp [h.ne'],
end

example (a b c d x y : ℚ) (hx : x ≠ 0) (hy : y ≠ 0) :
  a + b / x - c / x^2 + d / x^3 = a + x⁻¹ * (y * b / y + (d / x - c) / x) :=
begin
  field_simp,
  ring
end

example : (876544 : ℤ) * -1 + (1000000 - 123456) = 0 := by ring

example (x y : ℝ) (hx : x ≠ 0) (hy : y ≠ 0) :
  2 * x ^ 3 * 2 / (24 * x) = x ^ 2 / 6 :=
begin
  field_simp,
  ring
end

-- this proof style is not recommended practice
example (A B : ℕ) (H : B * A = 2) : A * B = 2 := by {ring_nf, exact H}

example (a : ℤ) : odd ((2 * a + 1) ^ 2) :=
begin
  use 2 * a ^ 2 + 2 * a,
  ring_nf,
end

example {x y : ℝ}
  (hxy : -y ^ 2 + x ^ 2 = -(5 * y) + 5 * x) :
  x ^ 2 - y ^ 2 = 5 * x - 5 * y :=
begin
  ring_nf at hxy ⊢,
  exact hxy
end

example {α} [field α] {x y : α}
  (h : 0 = (1 - x) ^ 2 * (x * (2 ^ 2 * y ^ 2 + 4 * (1 - x) ^ 2))) :
  0 = x * ((2 ^ 2 * y ^ 2 + 4 * (1 - x) ^ 2) * (1 - x) ^ 2) :=
by transitivity; [exact h, ring]

-- `ring_nf` should descend into the subexpressions `x * -a` and `-a * x`:
example {a x : ℚ} : x * -a = - a * x := by ring_nf

example (f : ℤ → ℤ) (a b : ℤ) : f (2 * a + b) + b = b + f (b + a + a) :=
begin
  success_if_fail {{ ring_nf {recursive := ff} }},
  ring_nf
end

-- instances do not have to syntactically be `monoid.has_pow`
example {R} [comm_semiring R] (x : ℕ → R) : x ^ 2 = x * x := by ring

-- even if there's an instance we don't recognize, we treat it as an atom
example {R} [field R] (x : ℕ → R) :
  (x ^ (2 : ℤ)) ^ 2 = (x ^ (2 : ℤ)) * (x ^ (2 : ℤ)) := by ring


theorem le_of_succ_le_succ (a b : mynat) : succ a ≤ succ b → a ≤ b :=
begin
intro h,
cases h with c hc,
use c,
rw succ_add at hc,
rw succ_eq_succ_iff at hc,
exact hc,
end


import positive_nat.def
import data.nat.basic
import tactic.interactive
import tactic.rcases
import tactic.tidy
import tactic.wlog
import lib.tactics

universes u v

namespace positive_nat
namespace natural

lemma add_succ {a b : natural} : a + (b + 1) = (a + b) + 1 := rfl

lemma one_add_eq_succ {a : natural} : 1 + a = a + 1 :=
begin
  induction a with b ih,
  { refl },
  { rw add_succ, rw ih }
end

lemma mul_succ {a b : natural} : a * (b + 1) = a + a * b := rfl

lemma succ_add {a b : natural} : (a + 1) + b = (a + b) + 1 :=
begin
  induction b with b ih,
  { refl },
  { rw add_succ,
    rw ih,
    rw add_succ }
end

lemma add_comm {a b : natural} : a + b = b + a :=
begin
  induction b with b ih,
  { rw one_add_eq_succ },
  { rw add_succ,
    rw ih,
    rw succ_add }
end

instance add.commutative : is_commutative natural add := ⟨@add_comm⟩

@[simp]
lemma one_mul {a : natural} : 1 * a = a :=
begin
  induction a with b ih,
  { refl },
  { rw mul_succ, rw ih, exact add_comm }
end

@[simp]
lemma mul_one {a : natural} : a * 1 = a := rfl

lemma add_assoc {a b c : natural} : a + b + c = a + (b + c) :=
begin
  induction c with c ih,
  { rw add_comm,
    rw add_succ,
    rw add_comm },
  { rw add_succ,
    rw ih,
    rw add_succ,
    rw add_succ }
end

instance add.associative : is_associative natural add := ⟨@add_assoc⟩

lemma succ_mul {a b : natural} : (a + 1) * b = b + (a * b) :=
begin
  induction b with b ih,
  { rw mul_one,
    rw mul_one,
    rw add_comm },
  { rw mul_succ,
    rw ih,
    rw mul_succ,
    rw ←add_assoc,
    rw ←add_assoc,
    rw @add_comm a,
    rw @add_comm b,
    rw @add_assoc 1,
    rw @add_comm a,
    rw ←@add_assoc 1
    }
end

lemma mul_comm {a b : natural} : a * b = b * a :=
begin
  induction b with b ih,
  { rw one_mul, refl },
  { rw mul_succ, rw ih, rw succ_mul }
end

instance mul.commutative : is_commutative natural mul := ⟨@mul_comm⟩

lemma mul_add_dist {a b c: natural} : a * (b + c) = a * b + a * c :=
begin
  induction c with c ih,
  { rw mul_succ,
    rw mul_one,
    rw add_comm },
  { rw add_succ,
    rw mul_succ,
    rw ih,
    rw mul_succ,
    rw ← add_assoc,
    rw ← add_assoc,
    rw @add_comm a }
end

lemma mul_assoc {a b c : natural} : a * b * c = a * (b * c) :=
begin
  induction c with c ih,
  { rw mul_one, rw mul_one },
  { rw mul_succ,
    rw ih,
    rw mul_succ,
    rw mul_add_dist }
end

instance mul.associative : is_associative natural mul := ⟨@mul_assoc⟩

def one_ne_succ {a b : natural} : ¬(1 = a + b) :=
begin
  apply b.cases_on,
  { delta natural, apply type.no_confusion },
  { intro b, rw add_succ, delta natural at *, apply type.no_confusion }
end

lemma succ_ne_one {a : natural} : ¬(a + 1 = 1) := ne.symm one_ne_succ

lemma succ_inj {a b : natural} : a + 1 = b + 1 → a = b := begin
  delta natural at *,
  exact type.succ.inj
end

lemma succ_inj_eq {a b : natural} : (a + 1 = b + 1) = (a = b) :=
begin
  delta natural,
  apply type.succ.inj_eq
end

lemma add_ne_self {a b : natural} (h : a + b = a) : false :=
begin
  induction a with a ih,
  { revert h,
    rw add_comm,
    exact succ_ne_one },
  { rw succ_add at h,
    replace h := succ_inj h,
    exact ih h }
end

lemma eq_one_of_mul_eq {a b : natural} (h : a * b = b) : a = 1 :=
begin
  cases_on a,
  { refl },
  { rw [succ_mul] at h,
    exfalso,
    exact add_ne_self h }
end

lemma add_inj_left {a b c : natural} (h : a + b = a + c) : b = c :=
begin
  induction a with a ih,
  { repeat {rw one_add_eq_succ at h},
    exact succ_inj h },
  { repeat {rw succ_add at h},
    exact ih (succ_inj h) }
end

lemma add_inj_right {a b c : natural} (h : a + c = b + c) : a = b := begin
  rw @add_comm a at h,
  rw @add_comm b at h,
  exact add_inj_left h
end

lemma mul_inj {a b c : natural} (h : a * c = b * c) : a = b :=
begin
  revert a,
  induction b with b ih,
  { intros a h,
    rw one_mul at h,
    exact eq_one_of_mul_eq h },
  { intros a h,
    rw succ_mul at h,
    cases_on a,
    { rw [one_mul] at h,
      replace h := eq.symm h,
      exfalso,
      exact add_ne_self h },
    { rw [succ_mul] at h,
      replace h := add_inj_left h,
      congr,
      exact ih h } }
end

lemma lt_of_succ_lt_succ {a b : natural} (h : a + 1 < b + 1) : a < b :=
begin
  cases h with c h,
  use c,
  rw [add_assoc, @add_comm 1, ←add_assoc] at h,
  exact add_inj_right h
end

instance decidable_lt : Π {a b : natural}, decidable (a < b)
| 1 1 := is_false (by { rintro ⟨⟩, apply add_ne_self, assumption })
| 1 (a + 1) := is_true (by { split, rw @one_add_eq_succ a })
| (a + 1) 1 := is_false (by { rintro ⟨⟩, rw succ_add at *, apply succ_ne_one, assumption })
| (a + 1) (b + 1) := match @decidable_lt a b with
  | is_false h := is_false (by { intro hh, exact h (lt_of_succ_lt_succ hh) })
  | is_true h := is_true (by { cases h with c h, use c, rw succ_add, rw h })
end

lemma add_ne_one {a b : natural} (h : a + b = 1) : false :=
begin
  cases_on b,
  { rw add_comm at h, exact add_ne_self h },
  { rw [add_succ] at h, exact succ_ne_one h }
end

@[simp]
lemma succ_pred_eq_self {a : natural} {h} : (pred a) + 1 = a :=
begin
  cases_on a,
  { cases h,
    exfalso,
    apply add_ne_self,
    assumption },
  { refl }
end

lemma one_lt_succ {a : natural} : 1 < a + 1 :=
begin
  split,
  rw one_add_eq_succ
end

lemma one_lt_of_succ_lt {a b : natural} (h : a + 1 < b) : 1 < b :=
begin
  cases_on b,
  { exfalso,
    cases h with c h,
    rw [@add_comm a, add_assoc] at h,
    exact add_ne_self h },
  { exact one_lt_succ }
end

@[simp]
lemma pred_succ {a : natural} {h : 1 < a + 1} : pred (a + 1) h = a := rfl

set_option trace.check true

lemma eq_pred_of_succ_eq {n m : natural} (h : n + 1 = m) : n = pred m (by { use n, rwa add_comm }):=
begin
  cases_on m,
  { cases h },
  { revert h,
    intro h,
    rw pred_succ,
    exact add_inj_right h }
end

lemma lt_pred_of_succ_lt {a b : natural} (h : a + 1 < b) : a < pred b (one_lt_of_succ_lt h) :=
begin
  cases h with c h,
  use c,
  rw [succ_add] at h,
  apply eq_pred_of_succ_eq,
  assumption
end

lemma lt_of_succ_lt {a b : natural} (h : a + 1 < b) : a < b :=
begin
  cases h with c h,
  use c + 1,
  rw succ_add at h,
  rw add_succ,
  assumption
end

lemma sub_succ_eq_pred_sub {a b : natural} {h : b + 1 < a}: sub a (b + 1) h = sub (pred a (one_lt_of_succ_lt h)) b (lt_pred_of_succ_lt h) :=
begin
  unfold sub sub.total pred
end

lemma eq_sub_of_add_eq {a b c : natural} (h : a + b = c) : a = sub c b ⟨a, by {rw add_comm, assumption}⟩ :=
begin
  revert c,
  induction b with b ih,
  { intros c h,
    unfold sub sub.total,
    subst c,
    unfold pred.total },
  { intros c h,
    rw sub_succ_eq_pred_sub,
    have hh := h,
    rw add_succ at hh,
    exact ih (eq_pred_of_succ_eq hh) }
end

lemma sub_succ.pred {a b : natural} (h : b + 1 < a) : sub a b (lt_of_succ_lt h) > 1 :=
begin
  cases h with c h,
  split, swap, exact c,
  rw [add_assoc, add_comm] at h,
  apply eq_sub_of_add_eq,
  assumption
end

lemma sub_succ {a b : natural} {h : b + 1 < a} : sub a (b + 1) = pred (sub a b (lt_of_succ_lt h)) (sub_succ.pred h) :=
begin
  revert a,
  induction b with b ih,
  { intros a h, unfold sub sub.total, refl },
  { intros a h,
    rw sub_succ_eq_pred_sub,
    revert h,
    intro h,
    rw @ih _ (lt_pred_of_succ_lt h),
    congr }
end

@[simp]
lemma sub_add_eq {a b : natural} {h} : a.sub b + b = a :=
begin
  induction b with b ih,
  { cases_on a,
    { exfalso, cases h, apply add_ne_self, assumption },
    { unfold sub sub.total, refl } },
  { rw add_succ,
    rw sub_succ,
    rw ← succ_add,
    rw succ_pred_eq_self,
    apply ih }
end

lemma sub_lt_of_lt {a b : natural} (h : a < b) : sub b a < b :=
begin
  cases h with c h,
  split,
  exact sub_add_eq
end

lemma one_lt_add {a b : natural} : 1 < a + b :=
begin
  cases_on b; unfold has_add.add add; exact one_lt_succ
end

lemma add_eq_succ {a b : natural} : a + b = (pred (a + b) one_lt_add) + 1 :=
begin
  rw succ_pred_eq_self
end

lemma not_lt_one {a : natural} (h : a < 1) : false :=
begin
  cases h with c h,
  rw add_eq_succ at h,
  exact succ_ne_one h
end

lemma not_lt_of_eq {a : natural} : ¬ a < a :=
begin
  intro h,
  cases h with x h,
  apply add_ne_self h
end

lemma not_lt_and_lt_symm {a b : natural} : ¬ (a < b ∧ b < a) :=
begin
  intro h,
  cases h with hl hr,
  cases hl with x hx,
  cases hr with y hy,
  rw [←hy, add_assoc] at hx,
  exact add_ne_self hx
end

lemma le_of_lt_succ {a b : natural} (h : a < b + 1) : a ≤ b :=
begin
  cases h with c h,
  cases_on c,
  { left, exact add_inj_right h },
  { right,
    use m,
    rw ←add_assoc at h,
    exact add_inj_right h }
end

instance decidable_eq : decidable_eq natural
| 1 1 := decidable.is_true rfl
| (n + 1) (m + 1) := match decidable_eq n m with
  | decidable.is_true h := decidable.is_true (congr_arg (λ x, add x 1) h)
  | decidable.is_false h := decidable.is_false (h ∘ add_inj_right)
end
| 1 (m + 1) := decidable.is_false (succ_ne_one ∘ eq.symm)
| (n + 1) 1 := decidable.is_false succ_ne_one

@[elab_as_eliminator]
lemma strong_induction {p : natural → Sort u} (n : natural) (h : ∀ n, (∀ m, m < n → p m) → p n) : p n :=
begin
  suffices hh : ∀ n m, m < n → p m, { apply h, apply hh },
  intros n, induction n with n ih,
  { intros m hh, exfalso, apply not_lt_one, exact hh },
  { intros m hh,
    apply or.by_cases (le_of_lt_succ hh),
    { intros, subst m, apply h, apply ih },
    { intros, apply ih, assumption } }
end

lemma le_self {a : natural} : a ≤ a := or.inl rfl

@[simp]
lemma one_le {a : natural} : 1 ≤ a :=
begin
  cases_on a,
  { left, refl },
  { right, use m, rw add_comm }
end

lemma le_or_gt (a b : natural) : a ≤ b ∨ a > b :=
if h₁ : b < a then or.inr h₁ else
if h₂ : a = b then or.inl (or.inl h₂) else
if h₃ : a < b then or.inl (or.inr h₃) else begin
  exfalso,
  induction a with a ih,
  { cases_on b, exact h₂ rfl, exact h₃ one_lt_succ },
  { apply ih; intro h,
    { apply h₁, cases h with c h, use c + 1, rw ←add_assoc, congr, assumption },
    { subst a, apply h₁, constructor, refl },
    { cases h with c h, subst b, cases_on c,
      { apply h₂, refl },
      { apply h₃, constructor,
        rw @add_comm m,
        rw add_assoc } } }
end

lemma cases_le_or_gt {p : Prop} (a b : natural) (h₁ : a ≤ b → p) (h₂ : a > b → p) : p :=
begin
  have h := le_or_gt a b,
  cases h; cc
end

instance decidable_le {a b : natural} : decidable (a ≤ b) :=
if h₁ : a < b then decidable.is_true (or.inr h₁) else
if h₂ : a = b then decidable.is_true (or.inl h₂) else
decidable.is_false begin
  intro h, cases h, exact h₂ h, exact h₁ h
end

lemma succ_sub_succ {a b : natural} {h} : sub (a + 1) (b + 1) = sub a b (lt_of_succ_lt_succ h) :=
begin
  unfold sub,
  rw sub.total.equations._eqn_2,
  rw pred.total.equations._eqn_2
end

@[simp]
lemma add_sub_eq {a b : natural} {h} : sub (a + b) b h = a :=
begin
  induction b with b ih,
  { refl },
  { conv in (a + (b + 1)) { rw ← add_assoc },
    rwa succ_sub_succ, exact ih }
end

instance eq.decidable : Π {a b : natural}, decidable (a = b)
| 1 1 := is_true rfl
| 1 (_ + 1) := is_false (by { intro h, exact succ_ne_one (eq.symm h)})
| (_ + 1) 1 := is_false (by { intro h, exact succ_ne_one h})
| (a + 1) (b + 1) := match @eq.decidable a b with
  | is_true h := by { rw ← succ_inj_eq at h, exact is_true h }
  | is_false h := by { apply is_false, intro hh, exact h (succ_inj hh) }
end

lemma lt_of_add_lt_add {a b c : natural} (h : a + b < a + c) : b < c :=
begin
  induction a with a ih,
  { repeat { rw one_add_eq_succ at h },
    exact lt_of_succ_lt_succ h },
  { repeat { rw succ_add at h },
    exact ih (lt_of_succ_lt_succ h) }
end

lemma le_or_le_symm {x y : natural} : x ≤ y ∨ y ≤ x :=
begin
  have hh := le_or_gt x y, cases hh,
    { left, assumption },
    { right, exact or.inr hh }
end

lemma sub_lt_self {a b : natural} {h} : sub a b < a :=
begin
  constructor,
  exact sub_add_eq
end

lemma le_irrefl {a : natural} (h : a < a) : false :=
begin
  cases h,
  apply add_ne_self,
  assumption
end

lemma sub_dvd_of_dvd {a b: natural} (h : b ∣ a) {hle} : b ∣ sub a b :=
begin
  cases h with x h,
  cases_on x,
  { rw mul_one at h, subst a, exfalso, exact le_irrefl hle },
  { rw mul_succ at h,
    subst a,
    conv in (b + _) { rw add_comm },
    rw add_sub_eq,
    use m }
end

lemma dvd.rfl {a : natural} : a ∣ a :=
begin
  unfold has_dvd.dvd dvd, use 1, simp
end

lemma le_of_succ_le_succ {a b :natural} (h : a + 1 ≤ b + 1) : a ≤ b :=
begin
  cases h,
  { left, exact add_inj_right h },
  { right, cases h with x h, use x,
    rw [add_assoc, @add_comm 1, ← add_assoc] at h,
    exact add_inj_right h }
end

lemma ne_succ {a : natural} : a ≠ a + 1 :=
begin
  induction a with a ih,
  { intro h, cases h },
  { intro h, exact ih (add_inj_right h) }
end

lemma ne_add {a b : natural} : a ≠ a + b :=
begin
  induction a with a ih,
  { intro h, rw add_comm at h, exact one_ne_succ h },
  { intro h, rw [add_assoc, @add_comm 1, ← add_assoc] at h,
    exact ih (add_inj_right h) }
end

lemma le_trans {a b c : natural} (h : a ≤ b) (g : b ≤ c): a ≤ c :=
begin
    cases h,
    subst a, assumption,
    cases g,
    subst b, exact or.inr h,
    cases h with x, cases g with y,
    right, use x + y,
    subst b, subst c,
    rw ← add_assoc
end

lemma le_total {a b : natural} : a ≤ b ∨ b ≤ a := begin
    induction b with b ih,
    { right, cases_on a,
      left, refl,
      right, apply one_lt_succ },
    { cases_on a,
      { left, right,
        apply one_lt_succ },
      { cases ih,
        { left, right, cases ih,
          { rw ih, use 1 },
          { cases ih with x h,
            use x + 1,
            rw ← add_assoc,
            rw h } },
        { cases ih,
          { left, right, rw ← ih, use 1 },
          { right, cases ih with x h,
            cases_on x,
            { left, exact h },
            { right, use m_1, rw ← h,
              rw @add_comm m_1,
              rw ← add_assoc,
              } } } } }
end

lemma le_antisymm {a b : natural} (h₁ : a ≤ b) (h₂ : b ≤ a) : a = b := begin
    cases h₁, assumption,
    cases h₂, symmetry, assumption,
    cases h₁ with x h₁,
    subst b,
    cases h₂ with y h,
    exfalso,
    rw add_assoc at h,
    exact ne_add h.symm
end

lemma ge_of_not_lt {a b : natural} (h : ¬(a < b)) : a ≥ b :=
begin
  cases le_or_gt a b with h₂ h₂, cases h₂,
  { left, symmetry, assumption },
  { exfalso, exact h h₂ },
  { right, assumption }
end

instance has_well_founded : has_well_founded natural :=
begin
  use (<),
  constructor, intro x,
  induction x using positive_nat.natural.strong_induction with x ih,
  constructor, intros y h,
  apply ih, assumption
end

lemma not_add_lt {a b : natural} (h : a + b < a) : false :=
begin
  induction b with b ih,
  { cases h with _ h, rw add_assoc at h, exact add_ne_self h },
  { rw add_succ at h,
    apply ih,
    exact lt_of_succ_lt h }
end

lemma not_mul_lt {a b : natural} (h : a * b < a) : false :=
begin
  induction b with b ih,
  { exact not_lt_of_eq h },
  { rw mul_succ at h,
    exact not_add_lt h }
end

def sub_one {a : natural} {h₂} : sub a 1 h₂ = pred a :=
begin
  unfold sub sub.total,
  cases_on a,
  { cases h₂ with x h, exfalso, rw add_comm at h, exact succ_ne_one h },
  { unfold pred }
end

lemma succ_pred {a : natural} {h} : pred a + 1 = a :=
begin
  cases_on a;
  unfold pred pred.total,
  exfalso,
  exact not_lt_of_eq h
end

lemma eq_succ_of_pred_eq {a b : natural} {h₁} (h : pred a = b) : a = b + 1 :=
begin
  cases_on a,
  { exfalso, exact not_lt_of_eq h₁ },
  { congr, rw pred_succ at h, assumption }
end

lemma succ_sub {a b} (h : a > b) {h₁} : sub (a + 1) b h₁ = sub a b h + 1 :=
begin
  induction b with b ih,
  { rw sub_one, rw sub_one, simp },
  { rw sub_succ, rw sub_succ,
    rw succ_pred,
    symmetry,
    apply eq_pred_of_succ_eq,
    symmetry,
    have h₂ : a > b, { cases h with x h, use x + 1, subst a, ac_refl },
    exact ih h₂ }
end

lemma sub_step {a b : natural} {_} : sub (a + b) b = a :=
begin
  generalize h : a + b = x,
  conv in (a + b) { rw h },
  exact (eq_sub_of_add_eq h).symm
end

lemma not_le_sub {a b : natural} {h₁} (h : a ≤ sub a b h₁) : false :=
begin
  cases sub_lt_of_lt h₁ with x h₂,
  cases h,
  { conv at h₂ { to_rhs, rw h },
    exact add_ne_self h₂ },
  { cases h with y h,
    rw [← h, add_assoc] at h₂,
    exact add_ne_self h₂ }
end

lemma lt_of_le_lt {a b c : natural} (h₁ : a ≤ b) (h₂ : b < c) : a < c :=
begin
  cases h₁,
  { subst a, assumption },
  { cases h₁ with x, cases h₂ with y,
    subst c, subst b,
    use x + y,
    ac_refl }
end

end natural
end positive_nat


variables A B C D : Prop

-- A ∧ (A → B) → B
example : A ∧ (A → B) → B :=
    assume h : A ∧ (A → B),
    show B, from and.right h (and.left h)

-- A → ¬ (¬ A ∧ B)
example : A → ¬ (¬ A ∧ B) :=
    assume h1 : A,
    assume h2 : ¬ A ∧ B,
    show false, from and.left h2 h1

-- ¬ (A ∧ B) → (A → ¬ B)
example (A B : Prop): ¬ (A ∧ B) → (A → ¬ B) :=
assume h1: ¬ (A ∧ B),
assume h2: A,
assume h3: B,
show false, from h1 (and.intro h2 h3)

example (h1 : A ∨ B) (h2 : A → C) (h3 : B → D) : C ∨ D :=
show C ∨ D, from or.elim h1 (assume h4 : A, show C ∨ D , from or.inl (h2 h4))
                (assume h5 : B, show C ∨ D , from or.inr (h3 h5))

-- ¬ A ∧ ¬ B →  ¬ (A ∨ B)
example : ¬ A ∧ ¬ B →  ¬ (A ∨ B) :=
  assume h1 : ¬ A ∧ ¬ B,
  assume h2: A ∨ B,
  show false, from or.elim h2 (and.left h1) (and.right h1)

-- ¬ (A ↔ ¬ A)
variable h1 : ¬ A
variable h2 : A
example : ¬ (A ↔ ¬ A) :=
assume h: (A ↔ ¬ A),
show false, from (iff.elim_left h h2) (iff.elim_right h h1)


/-
Copyright (c) 2020 Gihan Marasingha. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Gihan Marasingha
-/
import .basic
import data.nat.modeq
import tactic.ring

/-!
# Decision procedure: necessary condition

We introduce a condition `decstr` and show that if a string `en` is `derivable`, then `decstr en`
holds.

Using this, we give a negative answer to the question: is `"MU"` derivable?

## Tags

miu, decision procedure
-/

namespace miu

open miu_atom nat list

/-!
### Numerical condition on the `I` count

Suppose `st : miustr`. Then `count I st` is the number of `I`s in `st`. We'll show, if
`derivable st`, then `count I st` must be 1 or 2 modulo 3. To do this, it suffices to show that if
the `en : miustr` is derived from `st`, then `count I en` moudulo 3 is either equal to or is twice
`count I st`, modulo 3.
-/

/--
Given `st en : miustr`, the relation `count_equiv_or_equiv_two_mul_mod3 st en` holds if `st` and
`en` either have equal `count I`, modulo 3, or `count I en` is twice `count I st`, modulo 3.
 -/
def count_equiv_or_equiv_two_mul_mod3 (st en : miustr) : Prop :=
let a := (count I st) in
let b := (count I en) in
b ≡ a [MOD 3] ∨ b ≡ 2*a [MOD 3]

example : count_equiv_or_equiv_two_mul_mod3 "II" "MIUI" :=
or.inl rfl

example : count_equiv_or_equiv_two_mul_mod3 "IUIM" "MI" :=
or.inr rfl

/--
If `a` is 1 or 2 mod 3 and if `b` is `a` or twice `a` mod 3, then `b` is 1 or 2 mod 3.
-/
lemma mod3_eq_1_or_mod3_eq_2 {a b : ℕ} (h1 : a % 3 = 1 ∨ a % 3 = 2)
  (h2 : b % 3 = a % 3 ∨  b % 3 = (2 * a % 3)) : b % 3 = 1 ∨ b % 3 = 2 :=
begin
  cases h2,
  { rw h2, exact h1, },
  { cases h1,
    { right, simpa [h2,mul_mod,h1], },
    { left, simpa [h2,mul_mod,h1], }, },
end

/--
`count_equiv_one_or_two_mod3_of_derivable` shows any derivable string must have a `count I` that
is 1 or 2 modulo 3.
-/
theorem count_equiv_one_or_two_mod3_of_derivable (en : miustr): derivable en →
  (count I en) % 3 = 1 ∨ (count I en) % 3 = 2:=
begin
  intro h,
  induction h,
  { left, apply mod_def, },
    any_goals {apply mod3_eq_1_or_mod3_eq_2 h_ih},
    { left, simp only [count_append], refl, },
    { right, simp only [count, countp, count_append, if_false,two_mul], },
    { left, simp only [count, count_append, countp, if_false, if_pos],
      rw [add_right_comm, add_mod_right], },
    { left, simp only [count ,countp, countp_append, if_false, add_zero], },
end

/--
Using the above theorem, we solve the MU puzzle, showing that `"MU"` is not derivable.
Once we have proved that `derivable` is an instance of `decidable_pred`, this will follow
immediately from `dec_trivial`.
-/
theorem not_derivable_mu : ¬(derivable "MU") :=
begin
  intro h,
  cases (count_equiv_one_or_two_mod3_of_derivable _ h);
    contradiction,
end

/-!
### Condition on `M`

That solves the MU puzzle, but we'll proceed by demonstrating the other necessary condition for a
string to be derivable, namely that the string must start with an M and contain no M in its tail.
-/

/--
`goodm xs` holds if `xs : miustr` begins with `M` and has no `M` in its tail.
-/
@[derive decidable_pred]
def goodm (xs : miustr) : Prop :=
list.head xs = M ∧ ¬(M ∈ list.tail xs)

/--
Demonstration that `"MI"` starts with `M` and has no `M` in its tail.
-/
lemma goodmi : goodm [M,I] :=
begin
  split,
  { refl },
  { rw [tail ,mem_singleton], trivial },
end

/-!
We'll show, for each `i` from 1 to 4, that if `en` follows by Rule `i` from `st` and if
`goodm st` holds, then so does `goodm en`.
-/

lemma goodm_of_rule1 (xs : miustr) (h₁ : derivable (xs ++ [I])) (h₂ : goodm (xs ++ [I]))
  : goodm (xs ++ [I,U]) :=
begin
  cases h₂ with mhead nmtail,
  have : xs ≠ nil,
  { intro h, rw h at *, rw [nil_append, head] at mhead, contradiction, },
  split,
  { rwa [head_append] at *; exact this, },
  { change [I,U] with [I] ++ [U],
    rw [←append_assoc, tail_append_singleton_of_ne_nil],
    { simp only [mem_append, nmtail, false_or, mem_singleton, not_false_iff], },
    { exact append_ne_nil_of_ne_nil_left _ _ this, }, },
end

lemma goodm_of_rule2 (xs : miustr) (h₁ : derivable (M :: xs))
  (h₂ : goodm (M :: xs)) : goodm (M :: xs ++ xs) :=
begin
  split,
  { refl, },
  { cases h₂ with mhead mtail,
    contrapose! mtail,
    rw cons_append at mtail,
    rw tail at *,
    exact (or_self _).mp (mem_append.mp mtail), },
end

lemma goodm_of_rule3  (as bs : miustr) (h₁ : derivable (as ++ [I,I,I] ++ bs))
  (h₂ : goodm (as ++ [I,I,I] ++ bs)) : goodm (as ++ U :: bs) :=
begin
  cases h₂ with mhead nmtail,
  have k : as ≠ nil ,
  { intro h, rw h at mhead, rw [nil_append] at mhead, contradiction, },
  split,
  { revert mhead, simp only [append_assoc,head_append _ k], exact id, },
  { contrapose! nmtail,
    rcases (exists_cons_of_ne_nil k) with ⟨x,xs,rfl⟩,
    simp only [cons_append, tail, mem_append, mem_cons_iff, false_or, mem_nil_iff, or_false] at *,
    exact nmtail, },
end

/-!
 The proof of the next lemma is identical, on the tactic level, to the previous proof.
-/

lemma goodm_of_rule4  (as bs : miustr) (h₁ : derivable (as ++ [U,U] ++ bs))
  (h₂ : goodm (as ++ [U,U] ++ bs)) : goodm (as ++ bs) :=
begin
  cases h₂ with mhead nmtail,
  have k : as ≠ nil ,
  { intro h, rw h at mhead, rw [nil_append] at mhead, contradiction, },
  split,
  { revert mhead, simp only [append_assoc,head_append _ k], exact id, },
  { contrapose! nmtail,
    rcases (exists_cons_of_ne_nil k) with ⟨x,xs,rfl⟩,
    simp only [cons_append, tail, mem_append, mem_cons_iff, false_or, mem_nil_iff, or_false] at *,
    exact nmtail, },
end

/--
Any derivable string must begin with `M` and have no `M` in its tail.
-/
theorem goodm_of_derivable (en : miustr): derivable en →
  goodm en:=
begin
  intro h,
  induction h,
  { exact goodmi, },
  { apply goodm_of_rule1; assumption, },
  { apply goodm_of_rule2; assumption, },
  { apply goodm_of_rule3; assumption, },
  { apply goodm_of_rule4; assumption, },
end

/-!
We put togther our two conditions to give one necessary condition `decstr` for an `miustr` to be
derivable.
-/

/--
`decstr en` is the condition that `count I en` is 1 or 2 modulo 3, that `en` starts with `M`, and
that `en` has no `M` in its tail. We automatically derive that this is a decidable predicate.
-/
@[derive decidable_pred]
def decstr (en : miustr) :=
goodm en ∧ ((count I en) % 3 = 1 ∨ (count I en) % 3 = 2)

/--
Suppose `en : miustr`. If `en` is `derivable`, then the condition `decstr en` holds.
-/
theorem decstr_of_der {en : miustr} : derivable en → decstr en :=
begin
  intro h,
  split,
  { exact goodm_of_derivable en h, },
  { exact count_equiv_one_or_two_mod3_of_derivable en h, },
end

end miu


import tutorial_world.level10_cases1_and --hide
open set IncidencePlane --hide

variables {Ω : Type} [IncidencePlane Ω] --hide

/-
# Tutorial World

## Level 11: the `cases` tactic (II).

Suppose now that your hypothesis says that `P` **or** `Q` holds. That is, you have `h : P ∨ Q`. Then `cases h` will create
two new goals; in the first place, `h : P ∨ Q` will be replaced by `h : P`, and, in the second case, it will be replaced by `h : Q`.

To solve this level, you may need to remember how to employ the `use` tactic. As a reminder, note that if the goal is of
the form `⊢ ∃ (R : Ω), R ∈ X`, then you can type `use ?,`, where `?` is any object that satisfies the property of R, so that it
turns the goal into `⊢ ? ∈ X`. The object you are looking for is either found in "Theorem statements" or in the hypotheses located
right above the goal of this level. [**Reminder:** if the goal breaks into two goals, remember that you can use curly braces to make
the look of the proof more visual.]
-/

/- Hint : Click here for a hint, in case you get stuck.
After typing `cases h,`, two goals will appear. Write curly braces to structure the proof. Then, start each goal by typing `use P`
and `use Q`, respectively. The line that closes the goal is the same for both cases. Still bewildered? Click on "View source" (located on the
top right corner of the game screen) to see the solution.
-/

/- Lemma : no-side-bar
If ℓ is any line in the plane Ω and either the point P or the point Q is in ℓ, then ℓ is not an empty line.
-/
lemma nonempty_example (P Q : Ω) (ℓ : Line Ω) (h : P ∈ ℓ ∨ Q ∈ ℓ) : ∃ R, R ∈ ℓ :=
begin

  cases h,
  {
    use P,
    exact h,
  },
  {
    use Q,
    exact h,
  },

end