/-
Copyright (c) 2019 Michael Howes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Michael Howes
-/
import group_theory.free_group
import group_theory.quotient_group

/-!
# Defining a group given by generators and relations

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

Given a subset `rels` of relations of the free group on a type `α`, this file constructs the group
given by generators `x : α` and relations `r ∈ rels`.

## Main definitions

* `presented_group rels`: the quotient group of the free group on a type `α` by a subset `rels` of
  relations of the free group on `α`.
* `of`: The canonical map from `α` to a presented group with generators `α`.
* `to_group f`: the canonical group homomorphism `presented_group rels → G`, given a function
  `f : α → G` from a type `α` to a group `G` which satisfies the relations `rels`.

## Tags

generators, relations, group presentations
-/

variables {α : Type*}

/-- Given a set of relations, rels, over a type `α`, presented_group constructs the group with
generators `x : α` and relations `rels` as a quotient of free_group `α`.-/
def presented_group (rels : set (free_group α)) :=
free_group α ⧸ subgroup.normal_closure rels

namespace presented_group

instance (rels : set (free_group α)) : group (presented_group (rels)) :=
quotient_group.quotient.group _

/-- `of` is the canonical map from `α` to a presented group with generators `x : α`. The term `x` is
mapped to the equivalence class of the image of `x` in `free_group α`. -/
def of {rels : set (free_group α)} (x : α) : presented_group rels :=
quotient_group.mk (free_group.of x)

section to_group

/-
Presented groups satisfy a universal property. If `G` is a group and `f : α → G` is a map such that
the images of `f` satisfy all the given relations, then `f` extends uniquely to a group homomorphism
from `presented_group rels` to `G`.
-/

variables {G : Type*} [group G] {f : α → G} {rels : set (free_group α)}

local notation `F` := free_group.lift f

variable (h : ∀ r ∈ rels, F r = 1)

lemma closure_rels_subset_ker : subgroup.normal_closure rels ≤ monoid_hom.ker F :=
subgroup.normal_closure_le_normal (λ x w, (monoid_hom.mem_ker _).2 (h x w))

lemma to_group_eq_one_of_mem_closure : ∀ x ∈ subgroup.normal_closure rels, F x = 1 :=
λ x w, (monoid_hom.mem_ker _).1 $ closure_rels_subset_ker h w

/-- The extension of a map `f : α → G` that satisfies the given relations to a group homomorphism
from `presented_group rels → G`. -/
def to_group : presented_group rels →* G :=
quotient_group.lift (subgroup.normal_closure rels) F (to_group_eq_one_of_mem_closure h)

@[simp] lemma to_group.of {x : α} : to_group h (of x) = f x := free_group.lift.of

theorem to_group.unique (g : presented_group rels →* G)
  (hg : ∀ x : α, g (of x) = f x) : ∀ {x}, g x = to_group h x :=
λ x, quotient_group.induction_on x
    (λ _, free_group.lift.unique (g.comp (quotient_group.mk' _)) hg)

end to_group

instance (rels : set (free_group α)) : inhabited (presented_group rels) := ⟨1⟩

end presented_group


/-
Copyright (c) 2022 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Kevin Buzzard
-/

import tactic -- imports all the Lean tactics

/-

# More on functions

Another question on the Imperial introduction to proof problem sheet on functions
is "If `f : X → Y` and `g : Y → Z` and `g ∘ f` is injective, is it true that `g` is injective?"
This is not true. A counterexample could be made by letting `X` and `Z` have one element,
and letting `Y` have two elements; `f` and `g` are then not hard to write down. Let's
see how to do this in Lean by making inductive types `X`, `Y` and `Z` and functions
`f` and `g` which give an explicit counterexample.

-/

-- Let X be {a}
inductive X : Type
| a : X

-- in fact the term of type X is called `X.a`.

-- Let Y be {b,c}
inductive Y : Type
| b : Y
| c : Y

inductive Z : Type
| d : Z

-- Define f by f(X.a)=Y.b
def f : X → Y
| X.a := Y.b

-- define g by g(Y.b)=g(Y.c)=Z.d
def g : Y → Z
| Y.b := Z.d
| Y.c := Z.d

-- Here `Z` only has one term, so if `z : Z` then `cases z` only produces one goal,
-- namely "what you get if you change `z` to `Z.d`".
example (z : Z) : z = Z.d :=
begin
  cases z,
  refl,
end

lemma Yb_ne_Yc : Y.b ≠ Y.c :=
begin
  intro h, -- x ≠ y is definitionally equal to (x = y) → false
  cases h, -- no cases when they're equal!
end

-- The above and the below show that `g` is not injective
lemma gYb_eq_gYc : g Y.b = g Y.c :=
begin
  refl,
  -- they're both definitionally `Z.d` so which tactic solves this goal?
end

open function

lemma gf_injective : injective (g ∘ f) :=
begin
  rw [injective, comp],
  dsimp only,
  intros a1 a2,
  cases a1;
  cases a2;
  -- intros h,
  -- rw f at h, -- also works
  rw [f, g],
  intro h,
  refl,
end

-- This is a question on the IUM (Imperial introduction to proof course) function problem sheet.
-- Recall that if you have a hypothesis of the form `h : ∀ A, ...`, then `specialize h X`
-- will specialize `h` to the specific case `A = X`.
example : ¬ (∀ A B C : Type, ∀ (φ : A → B) (ψ : B → C), injective (ψ ∘ φ) → injective ψ) :=
begin
  intros h,
  have h1 : ¬ injective g, {
    intros h2,
    exact Yb_ne_Yc (h2 gYb_eq_gYc), },
  exact h1 ((h X Y Z f g) gf_injective),
end

lemma gf_surjective : surjective (g ∘ f) :=
begin
  rw surjective,
  intro b,
  cases b,
  use X.a,
  rw comp, -- god please there must be a better way
  dsimp,
  rw [f, g],
end

lemma f_not_surjective : ¬ surjective f :=
begin
  intro h,
  specialize h Y.c,
  cases h with a h,
  cases a,
  exact Yb_ne_Yc h,
end

-- This is another one. You might want to make some sublemmas first.
example : ¬ (∀ A B C : Type, ∀ (φ : A → B) (ψ : B → C), surjective (ψ ∘ φ) → surjective φ) :=
begin
  intros h,
  exact f_not_surjective (h _ _ _ _ _ gf_surjective),
end


import ..exercises.love02_backward_proofs_exercise_sheet

/-! # LoVe Homework 2: Backward Proofs

Homework must be done individually. -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

namespace backward_proofs

/-! ## Question 1 (4 points): Connectives and Quantifiers

1.1 (3 points). Complete the following proofs using basic tactics such as
`intro`, `apply`, and `exact`. -/

lemma B (a b c : Prop) :
  (a → b) → (c → a) → c → b :=
sorry

lemma S (a b c : Prop) :
  (a → b → c) → (a → b) → a → c :=
sorry

lemma more_nonsense (a b c d : Prop) :
  ((a → b) → c → d) → c → b → d :=
sorry

lemma even_more_nonsense (a b c : Prop) :
  (a → b) → (a → c) → a → b → c :=
sorry

/-! 1.2 (1 point). Prove the following lemma using basic tactics. -/

lemma weak_peirce (a b : Prop) :
  ((((a → b) → a) → a) → b) → b :=
sorry

/-! ## Question 2 (5 points): Logical Connectives

2.1 (1 point). Prove the following property about double negation using basic
tactics. You should not use the rules in the `classical` namespace like
`classical.em` and `classical.by_contradiction`.

Fun note: to prove the inner formula `¬¬ a → a` on its own, you would need
to use classical logic. `herman` is a nice example of "double negation translation":
https://en.wikipedia.org/wiki/Double-negation_translation

Hints:

* Keep in mind that `¬ a` is the same as `a → false`. You can start by
  invoking `rw not_def` four times if this helps you.

* You will need to apply the elimination rule for `false` at a key point in the
  proof. -/

lemma herman (a : Prop) :
  ¬¬ (¬¬ a → a) :=
sorry

/-! 2.2 (2 points). Prove the missing link in our chain of classical axiom
implications.

Hints:

* One way to find the definitions of `double_negation` and `excluded_middle`
  quickly is to

  1. hold the Control (on Linux and Windows) or Command (on macOS) key pressed;
  2. move the cursor to the identifier `double_negation` or `excluded_middle`;
  3. click the identifier.

* You can use `rw double_negation` to unfold the definition of
  `double_negation`, and similarly for the other definitions.

* You will need to apply the double negation hypothesis for `a ∨ ¬ a`. You will
  also need the left and right introduction rules for `∨` at some point. -/

#check double_negation
#check excluded_middle

lemma em_of_dn :
  double_negation → excluded_middle :=
sorry

/-! 2.3 (2 points). We have proved three of the six possible implications between
`excluded_middle`, `peirce`, and `double_negation`. State and prove the
three missing implications, exploiting the three theorems we already have. -/

#check peirce_of_em
#check dn_of_peirce
#check em_of_dn

-- enter your solution here

end backward_proofs

end LoVe


/-
Copyright (c) 2018 Mitchell Rowett. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mitchell Rowett, Scott Morrison
-/

import group_theory.subgroup

/-!
# Cosets

This file develops the basic theory of left and right cosets.

## Main definitions

* `left_coset a s`: the left coset `a * s` for an element `a : α` and a subset `s ⊆ α`, for an
  `add_group` this is `left_add_coset a s`.
* `right_coset s a`: the right coset `s * a` for an element `a : α` and a subset `s ⊆ α`, for an
  `add_group` this is `right_add_coset s a`.
* `quotient_group.quotient s`: the quotient type representing the left cosets with respect to a
  subgroup `s`, for an `add_group` this is `quotient_add_group.quotient s`.
* `quotient_group.mk`: the canonical map from `α` to `α/s` for a subgroup `s` of `α`, for an
  `add_group` this is `quotient_add_group.mk`.
* `subgroup.left_coset_equiv_subgroup`: the natural bijection between a left coset and the subgroup,
  for an `add_group` this is `add_subgroup.left_coset_equiv_add_subgroup`.

## Notation

* `a *l s`: for `left_coset a s`.
* `a +l s`: for `left_add_coset a s`.
* `s *r a`: for `right_coset s a`.
* `s +r a`: for `right_add_coset s a`.

## TODO

Add `to_additive` to `preimage_mk_equiv_subgroup_times_set`.
-/

open set function

variable {α : Type*}

/-- The left coset `a * s` for an element `a : α` and a subset `s : set α` -/
@[to_additive left_add_coset "The left coset `a+s` for an element `a : α`
and a subset `s : set α`"]
def left_coset [has_mul α] (a : α) (s : set α) : set α := (λ x, a * x) '' s

/-- The right coset `s * a` for an element `a : α` and a subset `s : set α` -/
@[to_additive right_add_coset "The right coset `s+a` for an element `a : α`
and a subset `s : set α`"]
def right_coset [has_mul α] (s : set α) (a : α) : set α := (λ x, x * a) '' s

localized "infix ` *l `:70 := left_coset" in coset
localized "infix ` +l `:70 := left_add_coset" in coset
localized "infix ` *r `:70 := right_coset" in coset
localized "infix ` +r `:70 := right_add_coset" in coset

section coset_mul
variable [has_mul α]

@[to_additive mem_left_add_coset]
lemma mem_left_coset {s : set α} {x : α} (a : α) (hxS : x ∈ s) : a * x ∈ a *l s :=
mem_image_of_mem (λ b : α, a * b) hxS

@[to_additive mem_right_add_coset]
lemma mem_right_coset {s : set α} {x : α} (a : α) (hxS : x ∈ s) : x * a ∈ s *r a :=
mem_image_of_mem (λ b : α, b * a) hxS

/-- Equality of two left cosets `a * s` and `b * s`. -/
@[to_additive left_add_coset_equivalence "Equality of two left cosets `a + s` and `b + s`."]
def left_coset_equivalence (s : set α) (a b : α) := a *l s = b *l s

@[to_additive left_add_coset_equivalence_rel]
lemma left_coset_equivalence_rel (s : set α) : equivalence (left_coset_equivalence s) :=
mk_equivalence (left_coset_equivalence s) (λ a, rfl) (λ a b, eq.symm) (λ a b c, eq.trans)

/-- Equality of two right cosets `s * a` and `s * b`. -/
@[to_additive right_add_coset_equivalence "Equality of two right cosets `s + a` and `s + b`."]
def right_coset_equivalence (s : set α) (a b : α) := s *r a = s *r b

@[to_additive right_add_coset_equivalence_rel]
lemma right_coset_equivalence_rel (s : set α) : equivalence (right_coset_equivalence s) :=
mk_equivalence (right_coset_equivalence s) (λ a, rfl) (λ a b, eq.symm) (λ a b c, eq.trans)

end coset_mul

section coset_semigroup
variable [semigroup α]

@[simp] lemma left_coset_assoc (s : set α) (a b : α) : a *l (b *l s) = (a * b) *l s :=
by simp [left_coset, right_coset, (image_comp _ _ _).symm, function.comp, mul_assoc]
attribute [to_additive left_add_coset_assoc] left_coset_assoc

@[simp] lemma right_coset_assoc (s : set α) (a b : α) : s *r a *r b = s *r (a * b) :=
by simp [left_coset, right_coset, (image_comp _ _ _).symm, function.comp, mul_assoc]
attribute [to_additive right_add_coset_assoc] right_coset_assoc

@[to_additive left_add_coset_right_add_coset]
lemma left_coset_right_coset (s : set α) (a b : α) : a *l s *r b = a *l (s *r b) :=
by simp [left_coset, right_coset, (image_comp _ _ _).symm, function.comp, mul_assoc]

end coset_semigroup

section coset_monoid
variables [monoid α] (s : set α)

@[simp] lemma one_left_coset : 1 *l s = s :=
set.ext $ by simp [left_coset]
attribute [to_additive zero_left_add_coset] one_left_coset

@[simp] lemma right_coset_one : s *r 1 = s :=
set.ext $ by simp [right_coset]
attribute [to_additive right_add_coset_zero] right_coset_one

end coset_monoid

section coset_submonoid
open submonoid
variables [monoid α] (s : submonoid α)

@[to_additive mem_own_left_add_coset]
lemma mem_own_left_coset (a : α) : a ∈ a *l s :=
suffices a * 1 ∈ a *l s, by simpa,
mem_left_coset a (one_mem s)

@[to_additive mem_own_right_add_coset]
lemma mem_own_right_coset (a : α) : a ∈ (s : set α) *r a :=
suffices 1 * a ∈ (s : set α) *r a, by simpa,
mem_right_coset a (one_mem s)

@[to_additive mem_left_add_coset_left_add_coset]
lemma mem_left_coset_left_coset {a : α} (ha : a *l s = s) : a ∈ s :=
by rw [←set_like.mem_coe, ←ha]; exact mem_own_left_coset s a

@[to_additive mem_right_add_coset_right_add_coset]
lemma mem_right_coset_right_coset {a : α} (ha : (s : set α) *r a = s) : a ∈ s :=
by rw [←set_like.mem_coe, ←ha]; exact mem_own_right_coset s a

end coset_submonoid

section coset_group
variables [group α] {s : set α} {x : α}

@[to_additive mem_left_add_coset_iff]
lemma mem_left_coset_iff (a : α) : x ∈ a *l s ↔ a⁻¹ * x ∈ s :=
iff.intro
  (assume ⟨b, hb, eq⟩, by simp [eq.symm, hb])
  (assume h, ⟨a⁻¹ * x, h, by simp⟩)

@[to_additive mem_right_add_coset_iff]
lemma mem_right_coset_iff (a : α) : x ∈ s *r a ↔ x * a⁻¹ ∈ s :=
iff.intro
  (assume ⟨b, hb, eq⟩, by simp [eq.symm, hb])
  (assume h, ⟨x * a⁻¹, h, by simp⟩)

end coset_group

section coset_subgroup
open subgroup

variables [group α] (s : subgroup α)

@[to_additive left_add_coset_mem_left_add_coset]
lemma left_coset_mem_left_coset {a : α} (ha : a ∈ s) : a *l s = s :=
set.ext $ by simp [mem_left_coset_iff, mul_mem_cancel_left s (s.inv_mem ha)]

@[to_additive right_add_coset_mem_right_add_coset]
lemma right_coset_mem_right_coset {a : α} (ha : a ∈ s) : (s : set α) *r a = s :=
set.ext $ assume b, by simp [mem_right_coset_iff, mul_mem_cancel_right s (s.inv_mem ha)]

@[to_additive eq_add_cosets_of_normal]
theorem eq_cosets_of_normal (N : s.normal) (g : α) : g *l s = s *r g :=
set.ext $ assume a, by simp [mem_left_coset_iff, mem_right_coset_iff]; rw [N.mem_comm_iff]

@[to_additive normal_of_eq_add_cosets]
theorem normal_of_eq_cosets (h : ∀ g : α, g *l s = s *r g) : s.normal :=
⟨assume a ha g, show g * a * g⁻¹ ∈ (s : set α),
  by rw [← mem_right_coset_iff, ← h]; exact mem_left_coset g ha⟩

@[to_additive normal_iff_eq_add_cosets]
theorem normal_iff_eq_cosets : s.normal ↔ ∀ g : α, g *l s = s *r g :=
⟨@eq_cosets_of_normal _ _ s, normal_of_eq_cosets s⟩

end coset_subgroup

run_cmd to_additive.map_namespace `quotient_group `quotient_add_group

namespace quotient_group

/-- The equivalence relation corresponding to the partition of a group by left cosets
of a subgroup.-/
@[to_additive "The equivalence relation corresponding to the partition of a group by left cosets
of a subgroup."]
def left_rel [group α] (s : subgroup α) : setoid α :=
⟨λ x y, x⁻¹ * y ∈ s,
  assume x, by simp [s.one_mem],
  assume x y hxy,
    have (x⁻¹ * y)⁻¹ ∈ s, from s.inv_mem hxy,
    by simpa using this,
  assume x y z hxy hyz,
    have x⁻¹ * y * (y⁻¹ * z) ∈ s, from s.mul_mem hxy hyz,
    by simpa [mul_assoc] using this⟩

@[to_additive]
instance left_rel_decidable [group α] (s : subgroup α) [d : decidable_pred (λ a, a ∈ s)] :
  decidable_rel (left_rel s).r := λ _ _, d _

/-- `quotient s` is the quotient type representing the left cosets of `s`.
  If `s` is a normal subgroup, `quotient s` is a group -/
def quotient [group α] (s : subgroup α) : Type* := quotient (left_rel s)

/-- The equivalence relation corresponding to the partition of a group by right cosets of a
subgroup. -/
@[to_additive "The equivalence relation corresponding to the partition of a group by right cosets of
a subgroup."]
def right_rel [group α] (s : subgroup α) : setoid α :=
⟨λ x y, y * x⁻¹ ∈ s,
  assume x, by simp [s.one_mem],
  assume x y hxy,
    have (y * x⁻¹)⁻¹ ∈ s, from s.inv_mem hxy,
    by simpa using this,
  assume x y z hxy hyz,
    have (z * y⁻¹) * (y * x⁻¹) ∈ s, from s.mul_mem hyz hxy,
    by simpa [mul_assoc] using this⟩

@[to_additive]
instance right_rel_decidable [group α] (s : subgroup α) [d : decidable_pred (λ a, a ∈ s)] :
  decidable_rel (left_rel s).r := λ _ _, d _

end quotient_group

namespace quotient_add_group

/-- `quotient s` is the quotient type representing the left cosets of `s`.
  If `s` is a normal subgroup, `quotient s` is a group -/
def quotient [add_group α] (s : add_subgroup α) : Type* := quotient (left_rel s)

end quotient_add_group

attribute [to_additive quotient_add_group.quotient] quotient_group.quotient

namespace quotient_group

variables [group α] {s : subgroup α}

@[to_additive]
instance fintype [fintype α] (s : subgroup α) [decidable_rel (left_rel s).r] :
  fintype (quotient_group.quotient s) :=
quotient.fintype (left_rel s)

/-- The canonical map from a group `α` to the quotient `α/s`. -/
@[to_additive "The canonical map from an `add_group` `α` to the quotient `α/s`."]
abbreviation mk (a : α) : quotient s :=
quotient.mk' a

@[elab_as_eliminator, to_additive]
lemma induction_on {C : quotient s → Prop} (x : quotient s)
  (H : ∀ z, C (quotient_group.mk z)) : C x :=
quotient.induction_on' x H

@[to_additive]
instance : has_coe_t α (quotient s) := ⟨mk⟩ -- note [use has_coe_t]

@[elab_as_eliminator, to_additive]
lemma induction_on' {C : quotient s → Prop} (x : quotient s)
  (H : ∀ z : α, C z) : C x :=
quotient.induction_on' x H

@[to_additive]
instance (s : subgroup α) : inhabited (quotient s) :=
⟨((1 : α) : quotient s)⟩

@[to_additive quotient_add_group.eq]
protected lemma eq {a b : α} : (a : quotient s) = b ↔ a⁻¹ * b ∈ s :=
quotient.eq'

@[to_additive]
lemma eq_class_eq_left_coset (s : subgroup α) (g : α) :
  {x : α | (x : quotient s) = g} = left_coset g s :=
set.ext $ λ z, by { rw [mem_left_coset_iff, set.mem_set_of_eq, eq_comm, quotient_group.eq], simp }

@[to_additive]
lemma preimage_image_coe (N : subgroup α) (s : set α) :
  coe ⁻¹' ((coe : α → quotient N) '' s) = ⋃ x : N, (λ y : α, y * x) '' s :=
begin
  ext x,
  simp only [quotient_group.eq, set_like.exists, exists_prop, set.mem_preimage, set.mem_Union,
    set.mem_image, subgroup.coe_mk, ← eq_inv_mul_iff_mul_eq],
  exact ⟨λ ⟨y, hs, hN⟩, ⟨_, hN, y, hs, rfl⟩, λ ⟨z, hN, y, hs, hyz⟩, ⟨y, hs, hyz ▸ hN⟩⟩
end

end quotient_group

namespace subgroup
open quotient_group
variables [group α] {s : subgroup α}

/-- The natural bijection between a left coset `g * s` and `s`. -/
@[to_additive "The natural bijection between the cosets `g + s` and `s`."]
def left_coset_equiv_subgroup (g : α) : left_coset g s ≃ s :=
⟨λ x, ⟨g⁻¹ * x.1, (mem_left_coset_iff _).1 x.2⟩,
 λ x, ⟨g * x.1, x.1, x.2, rfl⟩,
 λ ⟨x, hx⟩, subtype.eq $ by simp,
 λ ⟨g, hg⟩, subtype.eq $ by simp⟩

/-- The natural bijection between a right coset `s * g` and `s`. -/
@[to_additive "The natural bijection between the cosets `s + g` and `s`."]
def right_coset_equiv_subgroup (g : α) : right_coset ↑s g ≃ s :=
⟨λ x, ⟨x.1 * g⁻¹, (mem_right_coset_iff _).1 x.2⟩,
 λ x, ⟨x.1 * g, x.1, x.2, rfl⟩,
 λ ⟨x, hx⟩, subtype.eq $ by simp,
 λ ⟨g, hg⟩, subtype.eq $ by simp⟩

/-- A (non-canonical) bijection between a group `α` and the product `(α/s) × s` -/
@[to_additive "A (non-canonical) bijection between an add_group `α` and the product `(α/s) × s`"]
noncomputable def group_equiv_quotient_times_subgroup :
  α ≃ quotient s × s :=
calc α ≃ Σ L : quotient s, {x : α // (x : quotient s) = L} :
  (equiv.sigma_preimage_equiv quotient_group.mk).symm
    ... ≃ Σ L : quotient s, left_coset (quotient.out' L) s :
  equiv.sigma_congr_right (λ L,
    begin
      rw ← eq_class_eq_left_coset,
      show _root_.subtype (λ x : α, quotient.mk' x = L) ≃
        _root_.subtype (λ x : α, quotient.mk' x = quotient.mk' _),
      simp [-quotient.eq'],
    end)
    ... ≃ Σ L : quotient s, s :
  equiv.sigma_congr_right (λ L, left_coset_equiv_subgroup _)
    ... ≃ quotient s × s :
  equiv.sigma_equiv_prod _ _

lemma card_eq_card_quotient_mul_card_subgroup [fintype α] (s : subgroup α) [fintype s]
  [decidable_pred (λ a, a ∈ s)] : fintype.card α = fintype.card (quotient s) * fintype.card s :=
by rw ← fintype.card_prod;
  exact fintype.card_congr (subgroup.group_equiv_quotient_times_subgroup)

lemma card_subgroup_dvd_card [fintype α] (s : subgroup α) [fintype s] :
  fintype.card s ∣ fintype.card α :=
by haveI := classical.prop_decidable; simp [card_eq_card_quotient_mul_card_subgroup s]

lemma card_quotient_dvd_card [fintype α] (s : subgroup α) [decidable_pred (λ a, a ∈ s)]
  [fintype s] : fintype.card (quotient s) ∣ fintype.card α :=
by simp [card_eq_card_quotient_mul_card_subgroup s]

end subgroup

namespace quotient_group

variables [group α]

-- FIXME -- why is there no `to_additive`?

/-- If `s` is a subgroup of the group `α`, and `t` is a subset of `α/s`, then
there is a (typically non-canonical) bijection between the preimage of `t` in
`α` and the product `s × t`. -/
noncomputable def preimage_mk_equiv_subgroup_times_set
  (s : subgroup α) (t : set (quotient s)) : quotient_group.mk ⁻¹' t ≃ s × t :=
have h : ∀ {x : quotient s} {a : α}, x ∈ t → a ∈ s →
  (quotient.mk' (quotient.out' x * a) : quotient s) = quotient.mk' (quotient.out' x) :=
    λ x a hx ha, quotient.sound' (show (quotient.out' x * a)⁻¹ * quotient.out' x ∈ s,
      from (s.inv_mem_iff).1 $
        by rwa [mul_inv_rev, inv_inv, ← mul_assoc, inv_mul_self, one_mul]),
{ to_fun := λ ⟨a, ha⟩, ⟨⟨(quotient.out' (quotient.mk' a))⁻¹ * a,
    @quotient.exact' _ (left_rel s) _ _ $ (quotient.out_eq' _)⟩,
      ⟨quotient.mk' a, ha⟩⟩,
  inv_fun := λ ⟨⟨a, ha⟩, ⟨x, hx⟩⟩, ⟨quotient.out' x * a, show quotient.mk' _ ∈ t,
    by simp [h hx ha, hx]⟩,
  left_inv := λ ⟨a, ha⟩, subtype.eq $ show _ * _ = a, by simp,
  right_inv := λ ⟨⟨a, ha⟩, ⟨x, hx⟩⟩, show (_, _) = _, by simp [h hx ha] }

end quotient_group

/--
We use the class `has_coe_t` instead of `has_coe` if the first argument is a variable,
or if the second argument is a variable not occurring in the first.
Using `has_coe` would cause looping of type-class inference. See
<https://leanprover.zulipchat.com/#narrow/stream/113488-general/topic/remove.20all.20instances.20with.20variable.20domain>
-/
library_note "use has_coe_t"


namespace my_bool

inductive mybool : Type
| mytt : mybool
| myff : mybool

#check mybool.mytt

/-
We declare mybool to be an
inductively defined type:
a value of type, Type.

The set of values of this
type that can be constructed
is defined by the available
constructors.

Here there are just two,
mytt and myff, neither having
any arguments, so these are
the only two values of this
type: mytt and myff.
-/

-- We open the mybool namespace
open mybool

#check mytt

/-
With this data type in hand,
we can now define an "algebra"
involving such values. This will
be out little implementation of
Boolean algebra.

First we'll define the unary
functions involving values of
this type only. Then we'll do
a few binary functions, leaving
you a few more as exercises.
-/

/- Unary Operations -/

-- id_mybool returns what it's given
def id_mybool (b: mybool) : mybool := b

-- true_mybool always returns true
def true_mybool (b: mybool) := mytt

-- false_mybool always returns false
def false_mybool (b: mybool) := myff

-- not_mybool returns the other value
def not_mybool (b: mybool) :=
    match b with
    | mytt := myff
    | myff := mytt
    end

#reduce not_mybool mytt
#reduce not_mybool myff

/-
The match command does a kind of case
analysis on b. b, being of type, mybool,
can only have been "built" by the mytt
or myff constructors. In the first case,
the function returns myff. In the latter
case, it returns mytt.
-/

-- look, it works
#reduce id_mybool myff
#reduce id_mybool mytt
#reduce not_mybool myff
#reduce not_mybool mytt

/-
EXERCISE: use #reduce to test the other
two functions (false_ and true_mybool).
-/

/-
So we've just defined a data type and
some operations on values of this type.
Do our operations capture what we want,
which is to implement Boolean algebra?
Let's "verify" our software by proving
a proposition that we think should be
true: that if you apply not_mybool to
a value, b, of type mybool and apply it
again to the result, we should get back
to b.
-/

theorem not_inverse :
    ∀ b : mybool,
        not_mybool (not_mybool b) = b :=
begin
    intro b,
    cases b,
    apply rfl,
    apply rfl,
end

/-
That's amazing. We didn't "test" our
software by running it with various
inputs. Rather we proved a fact about
its behavior on *all* possible values
of its inputs using logic.
-/

/-
Here's a binary function, and_mybool,
taking two mybools and returning one
as a result. We intend this function
to implement the Boolean and operator.
-/

def and_mybool' (b1 b2 : mybool) : mybool :=
match b1, b2 with
    | mytt, mytt := mytt
    | mytt, myff := myff
    | myff, mytt := myff
    | myff, myff := myff
end

#reduce and_mybool' mytt myff

/-
The new concept here is that we can match
on several arguments.
-/

/-
We notice that all of the combinations of
input values after mytt and mytt return
myff. We can use "wildcards" in matches to
match any value. Matches are attempted in
the order in which rules appear in code.
(It's important to try to match mytt, mytt
before applying the wildcarded rule! Why?)
-/

def and_mybool (b1 b2 : mybool) : mybool :=
match b1, b2 with
    | mytt, mytt := mytt
    | _, _ := myff
end

/-
EXERCISE: Now you should implement each of
the following Boolean operators:

- or, as or_mybool
- implies, as implies_mybool
-/

def or_mybool (b1 b2: mybool) : mybool :=
match b1, b2 with
| myff, myff := myff
| _, _ := mytt
end

/-
EXERCISE: To test that you have given
valid implementations, state and prove
the propositon that for any values, b1
and b2, not_mybool (and_mybool b1 b2) =
or_mybool (not_mybool b1) (not_mybool b2).
-/

theorem demorgan1 : ∀ b1 b2 : mybool,
    not_mybool
        (and_mybool b1 b2)
    =
    or_mybool
        (not_mybool b1)
        (not_mybool b2) :=
 begin
 intros b1 b2,
 cases b1,
 cases b2,
 apply rfl,
 apply rfl,
 cases b2,
 apply rfl,
 apply rfl,
 end

 theorem demorgan2 :
    ∀ b1 b2 : mybool, not_mybool (or_mybool b1 b2) = and_mybool (not_mybool b1) (not_mybool b2) :=
begin
intros b1 b2,
cases b1,
cases b2,
sorry
end

/-
EXERCISE: State and prove the other
DeMorgan Law for Boolean algebra.
-/

end my_bool


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

! This file was ported from Lean 3 source module data.list.sort
! leanprover-community/mathlib commit f694c7dead66f5d4c80f446c796a5aad14707f0e
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.List.OfFn
import Mathlib.Data.List.Perm

/-!
# Sorting algorithms on lists

In this file we define `List.Sorted r l` to be an alias for `Pairwise r l`. This alias is preferred
in the case that `r` is a `<` or `≤`-like relation. Then we define two sorting algorithms:
`List.insertionSort` and `List.mergeSort`, and prove their correctness.
-/

open List.Perm

universe uu

namespace List

/-!
### The predicate `List.Sorted`
-/

section Sorted

variable {α : Type uu} {r : α → α → Prop} {a : α} {l : List α}

/-- `Sorted r l` is the same as `Pairwise r l`, preferred in the case that `r`
  is a `<` or `≤`-like relation (transitive and antisymmetric or asymmetric) -/
def Sorted :=
  @Pairwise
#align list.sorted List.Sorted

instance decidableSorted [DecidableRel r] (l : List α) : Decidable (Sorted r l) :=
  List.instDecidablePairwise _
#align list.decidable_sorted List.decidableSorted

protected theorem Sorted.le_of_lt [Preorder α] {l : List α} (h : l.Sorted (· < ·)) :
    l.Sorted (· ≤ ·) :=
  h.imp le_of_lt

protected theorem Sorted.lt_of_le [PartialOrder α] {l : List α} (h₁ : l.Sorted (· ≤ ·))
    (h₂ : l.Nodup) : l.Sorted (· < ·) :=
  h₁.imp₂ (fun _ _ => lt_of_le_of_ne)  h₂

@[simp]
theorem sorted_nil : Sorted r [] :=
  Pairwise.nil
#align list.sorted_nil List.sorted_nil

theorem Sorted.of_cons : Sorted r (a :: l) → Sorted r l :=
  Pairwise.of_cons
#align list.sorted.of_cons List.Sorted.of_cons

theorem Sorted.tail {r : α → α → Prop} {l : List α} (h : Sorted r l) : Sorted r l.tail :=
  Pairwise.tail h
#align list.sorted.tail List.Sorted.tail

theorem rel_of_sorted_cons {a : α} {l : List α} : Sorted r (a :: l) → ∀ b ∈ l, r a b :=
  rel_of_pairwise_cons
#align list.rel_of_sorted_cons List.rel_of_sorted_cons

@[simp]
theorem sorted_cons {a : α} {l : List α} : Sorted r (a :: l) ↔ (∀ b ∈ l, r a b) ∧ Sorted r l :=
  pairwise_cons
#align list.sorted_cons List.sorted_cons

protected theorem Sorted.nodup {r : α → α → Prop} [IsIrrefl α r] {l : List α} (h : Sorted r l) :
    Nodup l :=
  Pairwise.nodup h
#align list.sorted.nodup List.Sorted.nodup

theorem eq_of_perm_of_sorted [IsAntisymm α r] {l₁ l₂ : List α} (p : l₁ ~ l₂) (s₁ : Sorted r l₁)
    (s₂ : Sorted r l₂) : l₁ = l₂ := by
  induction' s₁ with a l₁ h₁ s₁ IH generalizing l₂
  · exact p.nil_eq
  · have : a ∈ l₂ := p.subset (mem_cons_self _ _)
    rcases mem_split this with ⟨u₂, v₂, rfl⟩
    have p' := (perm_cons a).1 (p.trans perm_middle)
    obtain rfl := IH p' (s₂.sublist <| by simp)
    change a :: u₂ ++ v₂ = u₂ ++ ([a] ++ v₂)
    rw [← append_assoc]
    congr
    have : ∀ (x : α) (_ : x ∈ u₂), x = a := fun x m =>
      antisymm ((pairwise_append.1 s₂).2.2 _ m a (mem_cons_self _ _)) (h₁ _ (by simp [m]))
    rw [(@eq_replicate _ a (length u₂ + 1) (a :: u₂)).2,
          (@eq_replicate _ a (length u₂ + 1) (u₂ ++ [a])).2] <;>
        constructor <;>
      simp [iff_true_intro this, or_comm]
#align list.eq_of_perm_of_sorted List.eq_of_perm_of_sorted

theorem sublist_of_subperm_of_sorted [IsAntisymm α r] {l₁ l₂ : List α} (p : l₁ <+~ l₂)
    (s₁ : l₁.Sorted r) (s₂ : l₂.Sorted r) : l₁ <+ l₂ := by
  let ⟨_, h, h'⟩ := p
  rwa [← eq_of_perm_of_sorted h (s₂.sublist h') s₁]
#align list.sublist_of_subperm_of_sorted List.sublist_of_subperm_of_sorted

@[simp 1100] --Porting note: higher priority for linter
theorem sorted_singleton (a : α) : Sorted r [a] :=
  pairwise_singleton _ _
#align list.sorted_singleton List.sorted_singleton

theorem Sorted.rel_get_of_lt {l : List α} (h : l.Sorted r) {a b : Fin l.length} (hab : a < b) :
    r (l.get a) (l.get b) :=
  List.pairwise_iff_get.1 h _ _ hab

theorem Sorted.rel_nthLe_of_lt {l : List α} (h : l.Sorted r) {a b : ℕ} (ha : a < l.length)
    (hb : b < l.length) (hab : a < b) : r (l.nthLe a ha) (l.nthLe b hb) :=
  List.pairwise_iff_get.1 h ⟨a, ha⟩ ⟨b, hb⟩ hab
#align list.sorted.rel_nth_le_of_lt List.Sorted.rel_nthLe_of_lt

theorem Sorted.rel_get_of_le [IsRefl α r] {l : List α} (h : l.Sorted r) {a b : Fin l.length}
    (hab : a ≤ b) : r (l.get a) (l.get b) := by
  rcases hab.eq_or_lt with (rfl | hlt)
  exacts [refl _, h.rel_get_of_lt hlt]

theorem Sorted.rel_nthLe_of_le [IsRefl α r] {l : List α} (h : l.Sorted r) {a b : ℕ}
    (ha : a < l.length) (hb : b < l.length) (hab : a ≤ b) : r (l.nthLe a ha) (l.nthLe b hb) :=
  h.rel_get_of_le hab
#align list.sorted.rel_nth_le_of_le List.Sorted.rel_nthLe_of_le

theorem Sorted.rel_of_mem_take_of_mem_drop {l : List α} (h : List.Sorted r l) {k : ℕ} {x y : α}
    (hx : x ∈ List.take k l) (hy : y ∈ List.drop k l) : r x y := by
  obtain ⟨⟨iy, hiy⟩, rfl⟩ := get_of_mem hy
  obtain ⟨⟨ix, hix⟩, rfl⟩ := get_of_mem hx
  rw [get_take', get_drop']
  rw [length_take] at hix
  exact h.rel_nthLe_of_lt _ _ (ix.lt_add_right _ _ (lt_min_iff.mp hix).left)
#align list.sorted.rel_of_mem_take_of_mem_drop List.Sorted.rel_of_mem_take_of_mem_drop

end Sorted

section Monotone

variable {n : ℕ} {α : Type uu} [Preorder α] {f : Fin n → α}

theorem sorted_ofFn_iff {r : α → α → Prop} : (ofFn f).Sorted r ↔ ((· < ·) ⇒ r) f f := by
  simp_rw [Sorted, pairwise_iff_get, length_ofFn, get_ofFn, Relator.LiftFun]
  exact Iff.symm (Fin.cast _).surjective.forall₂

/-- The list `List.ofFn f` is strictly sorted with respect to `(· ≤ ·)` if and only if `f` is
strictly monotone. -/
@[simp] theorem sorted_lt_ofFn_iff : (ofFn f).Sorted (· < ·) ↔ StrictMono f := sorted_ofFn_iff

/-- The list `List.ofFn f` is sorted with respect to `(· ≤ ·)` if and only if `f` is monotone. -/
@[simp] theorem sorted_le_ofFn_iff : (ofFn f).Sorted (· ≤ ·) ↔ Monotone f :=
  sorted_ofFn_iff.trans monotone_iff_forall_lt.symm

/-- A tuple is monotone if and only if the list obtained from it is sorted. -/
@[deprecated sorted_le_ofFn_iff]
theorem monotone_iff_ofFn_sorted : Monotone f ↔ (ofFn f).Sorted (· ≤ ·) := sorted_le_ofFn_iff.symm
#align list.monotone_iff_of_fn_sorted List.monotone_iff_ofFn_sorted

/-- The list obtained from a monotone tuple is sorted. -/
alias sorted_le_ofFn_iff ↔ _ _root_.Monotone.ofFn_sorted
#align list.monotone.of_fn_sorted Monotone.ofFn_sorted

end Monotone

section sort

variable {α : Type uu} (r : α → α → Prop) [DecidableRel r]

local infixl:50 " ≼ " => r

/-! ### Insertion sort -/

section InsertionSort

/-- `orderedInsert a l` inserts `a` into `l` at such that
  `orderedInsert a l` is sorted if `l` is. -/
@[simp]
def orderedInsert (a : α) : List α → List α
  | [] => [a]
  | b :: l => if a ≼ b then a :: b :: l else b :: orderedInsert a l
#align list.ordered_insert List.orderedInsert

/-- `insertionSort l` returns `l` sorted using the insertion sort algorithm. -/
@[simp]
def insertionSort : List α → List α
  | [] => []
  | b :: l => orderedInsert r b (insertionSort l)
#align list.insertion_sort List.insertionSort

@[simp]
theorem orderedInsert_nil (a : α) : [].orderedInsert r a = [a] :=
  rfl
#align list.ordered_insert_nil List.orderedInsert_nil

theorem orderedInsert_length : ∀ (L : List α) (a : α), (L.orderedInsert r a).length = L.length + 1
  | [], a => rfl
  | hd :: tl, a => by
    dsimp [orderedInsert]
    split_ifs <;> simp [orderedInsert_length tl]
#align list.ordered_insert_length List.orderedInsert_length

/-- An alternative definition of `orderedInsert` using `takeWhile` and `dropWhile`. -/
theorem orderedInsert_eq_take_drop (a : α) :
    ∀ l : List α,
      l.orderedInsert r a = (l.takeWhile fun b => ¬a ≼ b) ++ a :: l.dropWhile fun b => ¬a ≼ b
  | [] => rfl
  | b :: l => by
    dsimp only [orderedInsert]
    split_ifs with h <;> simp [takeWhile, dropWhile, *, orderedInsert_eq_take_drop a l]
#align list.ordered_insert_eq_take_drop List.orderedInsert_eq_take_drop

theorem insertionSort_cons_eq_take_drop (a : α) (l : List α) :
    insertionSort r (a :: l) =
      ((insertionSort r l).takeWhile fun b => ¬a ≼ b) ++
        a :: (insertionSort r l).dropWhile fun b => ¬a ≼ b :=
  orderedInsert_eq_take_drop r a _
#align list.insertion_sort_cons_eq_take_drop List.insertionSort_cons_eq_take_drop

section Correctness

open Perm

theorem orderedInsert_count [DecidableEq α] (L : List α) (a b : α) :
    count a (L.orderedInsert r b) = count a L + if a = b then 1 else 0 := by
  rw [(L.perm_orderedInsert r b).count_eq, count_cons]
  split_ifs <;> simp only [Nat.succ_eq_add_one, add_zero]
#align list.ordered_insert_count List.orderedInsert_count

theorem perm_insertionSort : ∀ l : List α, insertionSort r l ~ l
  | [] => Perm.nil
  | b :: l => by
    simpa [insertionSort] using (perm_orderedInsert _ _ _).trans ((perm_insertionSort l).cons b)
#align list.perm_insertion_sort List.perm_insertionSort

variable {r}

/-- If `l` is already `List.Sorted` with respect to `r`, then `insertionSort` does not change
it. -/
theorem Sorted.insertionSort_eq : ∀ {l : List α} (_ : Sorted r l), insertionSort r l = l
  | [], _ => rfl
  | [a], _ => rfl
  | a :: b :: l, h => by
    rw [insertionSort, Sorted.insertionSort_eq, orderedInsert, if_pos]
    exacts[rel_of_sorted_cons h _ (mem_cons_self _ _), h.tail]
#align list.sorted.insertion_sort_eq List.Sorted.insertionSort_eq

section TotalAndTransitive

variable [IsTotal α r] [IsTrans α r]

theorem Sorted.orderedInsert (a : α) : ∀ l, Sorted r l → Sorted r (orderedInsert r a l)
  | [], _ => sorted_singleton a
  | b :: l, h => by
    by_cases h' : a ≼ b
    · -- Porting note: was
      -- `simpa [orderedInsert, h', h] using fun b' bm => trans h' (rel_of_sorted_cons h _ bm)`
      rw [List.orderedInsert, if_pos h', sorted_cons]
      exact ⟨forall_mem_cons.2 ⟨h', fun c hc => _root_.trans h' (rel_of_sorted_cons h _ hc)⟩, h⟩
    · suffices ∀ b' : α, b' ∈ List.orderedInsert r a l → r b b' by
        simpa [orderedInsert, h', h.of_cons.orderedInsert a l]
      intro b' bm
      cases' show b' = a ∨ b' ∈ l by simpa using (perm_orderedInsert _ _ _).subset bm with be bm
      · subst b'
        exact (total_of r _ _).resolve_left h'
      · exact rel_of_sorted_cons h _ bm
#align list.sorted.ordered_insert List.Sorted.orderedInsert

variable (r)

/-- The list `List.insertionSort r l` is `List.Sorted` with respect to `r`. -/
theorem sorted_insertionSort : ∀ l, Sorted r (insertionSort r l)
  | [] => sorted_nil
  | a :: l => (sorted_insertionSort l).orderedInsert a _
#align list.sorted_insertion_sort List.sorted_insertionSort

end TotalAndTransitive

end Correctness

end InsertionSort

/-! ### Merge sort -/

section MergeSort

-- TODO(Jeremy): observation: if instead we write (a :: (split l).1, b :: (split l).2), the
-- equation compiler can't prove the third equation
/-- Split `l` into two lists of approximately equal length.

     split [1, 2, 3, 4, 5] = ([1, 3, 5], [2, 4]) -/
@[simp]
def split : List α → List α × List α
  | [] => ([], [])
  | a :: l =>
    let (l₁, l₂) := split l
    (a :: l₂, l₁)
#align list.split List.split

theorem split_cons_of_eq (a : α) {l l₁ l₂ : List α} (h : split l = (l₁, l₂)) :
    split (a :: l) = (a :: l₂, l₁) := by rw [split, h]
#align list.split_cons_of_eq List.split_cons_of_eq

theorem length_split_le :
    ∀ {l l₁ l₂ : List α}, split l = (l₁, l₂) → length l₁ ≤ length l ∧ length l₂ ≤ length l
  | [], _, _, rfl => ⟨Nat.le_refl 0, Nat.le_refl 0⟩
  | a :: l, l₁', l₂', h => by
    cases' e : split l with l₁ l₂
    injection (split_cons_of_eq _ e).symm.trans h; substs l₁' l₂'
    cases' length_split_le e with h₁ h₂
    exact ⟨Nat.succ_le_succ h₂, Nat.le_succ_of_le h₁⟩
#align list.length_split_le List.length_split_le

theorem length_split_lt {a b} {l l₁ l₂ : List α} (h : split (a :: b :: l) = (l₁, l₂)) :
    length l₁ < length (a :: b :: l) ∧ length l₂ < length (a :: b :: l) := by
  cases' e : split l with l₁' l₂'
  injection (split_cons_of_eq _ (split_cons_of_eq _ e)).symm.trans h; substs l₁ l₂
  cases' length_split_le e with h₁ h₂
  exact ⟨Nat.succ_le_succ (Nat.succ_le_succ h₁), Nat.succ_le_succ (Nat.succ_le_succ h₂)⟩
#align list.length_split_lt List.length_split_lt

theorem perm_split : ∀ {l l₁ l₂ : List α}, split l = (l₁, l₂) → l ~ l₁ ++ l₂
  | [], _, _, rfl => Perm.refl _
  | a :: l, l₁', l₂', h => by
    cases' e : split l with l₁ l₂
    injection (split_cons_of_eq _ e).symm.trans h; substs l₁' l₂'
    exact ((perm_split e).trans perm_append_comm).cons a
#align list.perm_split List.perm_split

/-- Merge two sorted lists into one in linear time.

     merge [1, 2, 4, 5] [0, 1, 3, 4] = [0, 1, 1, 2, 3, 4, 4, 5] -/
def merge : List α → List α → List α
  | [], l' => l'
  | l, [] => l
  | a :: l, b :: l' => if a ≼ b then a :: merge l (b :: l') else b :: merge (a :: l) l'
  termination_by merge l₁ l₂ => length l₁ + length l₂
#align list.merge List.merge

/-- Implementation of a merge sort algorithm to sort a list. -/
def mergeSort : List α → List α
  | [] => []
  | [a] => [a]
  | a :: b :: l => by
    -- Porting note: rewrote to make `mergeSort_cons_cons` proof easier
    let ls := (split (a :: b :: l))
    have e : split (a :: b :: l) = ⟨ls.1, ls.2⟩ := rfl
    have h := length_split_lt e
    have := h.1
    have := h.2
    exact merge r (mergeSort ls.1) (mergeSort ls.2)
  termination_by mergeSort l => length l
#align list.merge_sort List.mergeSort

@[nolint unusedHavesSuffices] --Porting note: false positive
theorem mergeSort_cons_cons {a b} {l l₁ l₂ : List α} (h : split (a :: b :: l) = (l₁, l₂)) :
    mergeSort r (a :: b :: l) = merge r (mergeSort r l₁) (mergeSort r l₂) := by
  simp only [mergeSort, h]
#align list.merge_sort_cons_cons List.mergeSort_cons_cons

section Correctness

theorem perm_merge : ∀ l l' : List α, merge r l l' ~ l ++ l'
  | [], [] => by simp [merge]
  | [], b :: l' => by simp [merge]
  | a :: l, [] => by simp [merge]
  | a :: l, b :: l' => by
    by_cases h : a ≼ b
    · simpa [merge, h] using perm_merge _ _
    · suffices b :: merge r (a :: l) l' ~ a :: (l ++ b :: l') by simpa [merge, h]
      exact ((perm_merge _ _).cons _).trans ((swap _ _ _).trans (perm_middle.symm.cons _))
  termination_by perm_merge l₁ l₂ => length l₁ + length l₂
#align list.perm_merge List.perm_merge

theorem perm_mergeSort : ∀ l : List α, mergeSort r l ~ l
  | [] => by simp [mergeSort]
  | [a] => by simp [mergeSort]
  | a :: b :: l => by
    cases' e : split (a :: b :: l) with l₁ l₂
    cases' length_split_lt e with h₁ h₂
    rw [mergeSort_cons_cons r e]
    apply (perm_merge r _ _).trans
    exact
      ((perm_mergeSort l₁).append (perm_mergeSort l₂)).trans (perm_split e).symm
  termination_by perm_mergeSort l => length l
#align list.perm_merge_sort List.perm_mergeSort

@[simp]
theorem length_mergeSort (l : List α) : (mergeSort r l).length = l.length :=
  (perm_mergeSort r _).length_eq
#align list.length_merge_sort List.length_mergeSort

section TotalAndTransitive

variable {r} [IsTotal α r] [IsTrans α r]

theorem Sorted.merge : ∀ {l l' : List α}, Sorted r l → Sorted r l' → Sorted r (merge r l l')
  | [], [], _, _ => by simp [List.merge]
  | [], b :: l', _, h₂ => by simpa [List.merge] using h₂
  | a :: l, [], h₁, _ => by simpa [List.merge] using h₁
  | a :: l, b :: l', h₁, h₂ => by
    by_cases h : a ≼ b
    · suffices ∀ (b' : α) (_ : b' ∈ List.merge r l (b :: l')), r a b' by
        simpa [List.merge, h, h₁.of_cons.merge h₂]
      intro b' bm
      rcases show b' = b ∨ b' ∈ l ∨ b' ∈ l' by
          simpa [or_left_comm] using (perm_merge _ _ _).subset bm with
        (be | bl | bl')
      · subst b'
        assumption
      · exact rel_of_sorted_cons h₁ _ bl
      · exact _root_.trans h (rel_of_sorted_cons h₂ _ bl')
    · suffices ∀ (b' : α) (_ : b' ∈ List.merge r (a :: l) l'), r b b' by
        simpa [List.merge, h, h₁.merge h₂.of_cons]
      intro b' bm
      have ba : b ≼ a := (total_of r _ _).resolve_left h
      have : b' = a ∨ b' ∈ l ∨ b' ∈ l' := by simpa using (perm_merge _ _ _).subset bm
      rcases this with (be | bl | bl')
      · subst b'
        assumption
      · exact _root_.trans ba (rel_of_sorted_cons h₁ _ bl)
      · exact rel_of_sorted_cons h₂ _ bl'
  termination_by Sorted.merge l₁ l₂ _ _ => length l₁ + length l₂

#align list.sorted.merge List.Sorted.merge

variable (r)

theorem sorted_mergeSort : ∀ l : List α, Sorted r (mergeSort r l)
  | [] => by simp [mergeSort]
  | [a] => by simp [mergeSort]
  | a :: b :: l => by
    cases' e : split (a :: b :: l) with l₁ l₂
    cases' length_split_lt e with h₁ h₂
    rw [mergeSort_cons_cons r e]
    exact (sorted_mergeSort l₁).merge (sorted_mergeSort l₂)
  termination_by sorted_mergeSort l => length l
#align list.sorted_merge_sort List.sorted_mergeSort

theorem mergeSort_eq_self [IsAntisymm α r] {l : List α} : Sorted r l → mergeSort r l = l :=
  eq_of_perm_of_sorted (perm_mergeSort _ _) (sorted_mergeSort _ _)
#align list.merge_sort_eq_self List.mergeSort_eq_self

theorem mergeSort_eq_insertionSort [IsAntisymm α r] (l : List α) :
    mergeSort r l = insertionSort r l :=
  eq_of_perm_of_sorted ((perm_mergeSort r l).trans (perm_insertionSort r l).symm)
    (sorted_mergeSort r l) (sorted_insertionSort r l)
#align list.merge_sort_eq_insertion_sort List.mergeSort_eq_insertionSort

end TotalAndTransitive

end Correctness

@[simp]
theorem mergeSort_nil : [].mergeSort r = [] := by rw [List.mergeSort]
#align list.merge_sort_nil List.mergeSort_nil

@[simp]
theorem mergeSort_singleton (a : α) : [a].mergeSort r = [a] := by rw [List.mergeSort]
#align list.merge_sort_singleton List.mergeSort_singleton

end MergeSort

end sort

-- try them out!
--#eval insertionSort (fun m n : ℕ => m ≤ n) [5, 27, 221, 95, 17, 43, 7, 2, 98, 567, 23, 12]
--#eval mergeSort     (fun m n : ℕ => m ≤ n) [5, 27, 221, 95, 17, 43, 7, 2, 98, 567, 23, 12]
end List


-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que en los reales, si
--    x ≤ y ∧ x ≠ y
-- entonces
--    ¬ y ≤ x
-- ----------------------------------------------------------------------

import data.real.basic

variables {x y : ℝ}

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

example
  (h : x ≤ y ∧ x ≠ y)
  : ¬ y ≤ x :=
begin
  cases h with h₀ h₁,
  contrapose! h₁,
  exact le_antisymm h₀ h₁,
end

-- Prueba
-- ======

/-
x y : ℝ,
h : x ≤ y ∧ x ≠ y
⊢ ¬y ≤ x
  >> cases h with h₀ h₁,
h₀ : x ≤ y,
h₁ : x ≠ y
⊢ ¬y ≤ x
  >> contrapose! h₁,
h₀ : x ≤ y,
h₁ : y ≤ x
⊢ x = y
  >> exact le_antisymm h₀ h₁,
no goals
-/

-- Comentario: La táctica (cases h with h₀ h₁,) si la hipótesis h es una
-- conjunción (P ∧ Q), aplica la regla de eliminación de la conjunción;
-- es decir, sustituy h por las hipótesis (h₀ : P) y (h₁ : Q).

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

example : x ≤ y ∧ x ≠ y → ¬ y ≤ x :=
begin
  rintros ⟨h₀, h₁⟩ h',
  exact h₁ (le_antisymm h₀ h'),
end

-- Prueba
-- ======

/-
x y : ℝ
⊢ x ≤ y ∧ x ≠ y → ¬y ≤ x
  >> rintros ⟨h₀, h₁⟩ h',
h' : y ≤ x,
h₀ : x ≤ y,
h₁ : x ≠ y
⊢ false
  >> exact h₁ (le_antisymm h₀ h'),
no goals
-/

-- Comentario: La táctica (rintros ⟨h₀, h₁⟩ h')
-- + si el objetivo es de la forma (P ∧ Q → (R → S)) añade las hipótesis
--   (h₀ : P), (h₁ : Q), (h' : R) y sustituye el objetivo por S.
-- + si el objetivo es de la forma (P ∧ Q → ¬R) añade las hipótesis
--   (h₀ : P), (h₁ : Q), (h' : R) y sustituye el objetivo por false.

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

example : x ≤ y ∧ x ≠ y → ¬ y ≤ x :=
λ ⟨h₀, h₁⟩ h', h₁ (le_antisymm h₀ h')

-- 4ª demostración
-- ===============

example
  (h : x ≤ y ∧ x ≠ y)
  : ¬ y ≤ x :=
begin
  intro h',
  apply h.right,
  exact le_antisymm h.left h',
end

-- Prueba
-- ======

/-
x y : ℝ,
h : x ≤ y ∧ x ≠ y
⊢ ¬y ≤ x
  >> intro h',
h' : y ≤ x
⊢ false
  >> apply h.right,
h' : y ≤ x
⊢ x = y
  >> exact le_antisymm h.left h',
no goals
-/

-- Comentario: Si h es una conjunción (P ∧ Q), entonces h.left es P y
-- h.right es Q.

-- 5ª demostración
-- ===============

example {x y : ℝ} (h : x ≤ y ∧ x ≠ y) : ¬ y ≤ x :=
λ h', h.right (le_antisymm h.left h')


/-
Lemma 10.16.4. Suppose that φ:R→R′ is a ring homomorphism. The induced map
Spec(φ):Spec(R′)⟶Spec(R),𝔭′⟼φ−1(𝔭′)
is continuous for the Zariski topologies. In fact, for any element f∈R we have Spec(φ)−1(D(f))=D(φ(f)).

Proof. It is tag 00BV that 𝔭:=φ−1(𝔭′) is indeed a prime ideal of R. The last assertion of the lemma follows directly from the definitions, and implies the first.
-/

import Kenny_comm_alg.Zariski analysis.topology.continuity

universes u v

variables {α : Type u} {β : Type v} [comm_ring α] [comm_ring β]
variables (f : α → β) [is_ring_hom f]

def Zariski.induced : X β → X α :=
λ p, ⟨f ⁻¹' p.1, @@is_prime_ideal.hom_preimage _ _ f _ p.1 p.2⟩

instance zariski.open := Zariski α

theorem Zariski.induced.continuous : continuous (Zariski.induced f) :=
λ A ⟨E, ha⟩, ⟨f '' E, set.ext $ λ z,
⟨λ h hz, suffices (⟨f ⁻¹' z.val, _⟩ : X α) ∈ Spec.V E, by rw ha at this; exact this hz,
   λ x hx, h ⟨x, hx, rfl⟩,
 λ h x ⟨w, H, hw⟩, have (⟨f ⁻¹' z.val, _⟩ : X α) ∈ Spec.V E, by rw ha; exact h,
   by rw ← hw; exact this H⟩⟩

theorem Zariski.induced.preimage_D (x : α) : Zariski.induced f ⁻¹' (Spec.D' x) = Spec.D' (f x) :=
set.ext $ λ z, by simp [Spec.D', Zariski.induced, Spec.V']


import data.real.basic

/- TEXT:
.. _disjunction:

Disjunction
-----------

.. index:: left, right, tactics ; left, tactics ; right

The canonical way to prove a disjunction ``A ∨ B`` is to prove
``A`` or to prove ``B``.
The ``left`` tactic chooses ``A``,
and the ``right`` tactic chooses ``B``.
TEXT. -/
-- BOTH:
section
-- QUOTE:
variables {x y : ℝ}

-- EXAMPLES:
example (h : y > x^2) : y > 0 ∨ y < -1 :=
by { left, linarith [pow_two_nonneg x] }

example (h : -y > x^2 + 1) : y > 0 ∨ y < -1 :=
by { right, linarith [pow_two_nonneg x] }
-- QUOTE.

/- TEXT:
We cannot use an anonymous constructor to construct a proof
of an "or" because Lean would have to guess
which disjunct we are trying to prove.
When we write proof terms we can use
``or.inl`` and ``or.inr`` instead
to make the choice explicitly.
Here, ``inl`` is short for "introduction left" and
``inr`` is short for "introduction right."
TEXT. -/
-- QUOTE:
example (h : y > 0) : y > 0 ∨ y < -1 :=
or.inl h

example (h : y < -1) : y > 0 ∨ y < -1 :=
or.inr h
-- QUOTE.

/- TEXT:
It may seem strange to prove a disjunction by proving one side
or the other.
In practice, which case holds usually depends a case distinction
that is implicit or explicit in the assumptions and the data.
The ``cases`` tactic allows us to make use of a hypothesis
of the form ``A ∨ B``.
In contrast to the use of ``cases`` with conjunction or an
existential quantifier,
here the ``cases`` tactic produces *two* goals.
Both have the same conclusion, but in the first case,
``A`` is assumed to be true,
and in the second case,
``B`` is assumed to be true.
In other words, as the name suggests,
the ``cases`` tactic carries out a proof by cases.
As usual, we can tell Lean what names to use for the hypotheses.
In the next example, we tell Lean
to use the name ``h`` on each branch.
TEXT. -/
-- QUOTE:
example : x < abs y → x < y ∨ x < -y :=
begin
  cases le_or_gt 0 y with h h,
  { rw abs_of_nonneg h,
    intro h, left, exact h },
  rw abs_of_neg h,
  intro h, right, exact h
end
-- QUOTE.

/- TEXT:
The absolute value function is defined in such a way
that we can immediately prove that
``x ≥ 0`` implies ``abs x = x``
(this is the theorem ``abs_of_nonneg``)
and ``x < 0`` implies ``abs x = -x`` (this is ``abs_of_neg``).
The expression ``le_or_gt 0 x`` establishes ``0 ≤ x ∨ x < 0``,
allowing us to split on those two cases.
Try proving the triangle inequality using the two
first two theorems in the next snippet.
They are given the same names they have in mathlib.
TEXT. -/
-- BOTH:
-- QUOTE:
namespace my_abs

-- EXAMPLES:
theorem le_abs_self (x : ℝ) : x ≤ abs x :=
sorry

theorem neg_le_abs_self (x : ℝ) : -x ≤ abs x :=
sorry

theorem abs_add (x y : ℝ) : abs (x + y) ≤ abs x + abs y :=
sorry
-- QUOTE.

-- SOLUTIONS:
theorem le_abs_selfαα (x : ℝ) : x ≤ abs x :=
begin
  cases le_or_gt 0 x with h h,
  { rw abs_of_nonneg h },
  rw abs_of_neg h,
  linarith
end

theorem neg_le_abs_selfαα (x : ℝ) : -x ≤ abs x :=
begin
  cases le_or_gt 0 x with h h,
  { rw abs_of_nonneg h,
    linarith },
  rw abs_of_neg h
end

theorem abs_addαα (x y : ℝ) : abs (x + y) ≤ abs x + abs y :=
begin
  cases le_or_gt 0 (x + y) with h h,
  { rw abs_of_nonneg h,
    linarith [le_abs_self x, le_abs_self y] },
  rw abs_of_neg h,
  linarith [neg_le_abs_self x, neg_le_abs_self y]
end

/- TEXT:
In case you enjoyed these (pun intended) and
you want more practice with disjunction,
try these.
TEXT. -/
-- QUOTE:
theorem lt_abs : x < abs y ↔ x < y ∨ x < -y :=
sorry

theorem abs_lt : abs x < y ↔ - y < x ∧ x < y :=
sorry
-- QUOTE.

-- SOLUTIONS:
theorem lt_absαα : x < abs y ↔ x < y ∨ x < -y :=
begin
  cases le_or_gt 0 y with h h,
  { rw abs_of_nonneg h,
    split,
    { intro h', left, exact h' },
    intro h',
    cases h' with h' h',
    { exact h' },
    linarith },
  rw abs_of_neg h,
  split,
  { intro h', right, exact h' },
  intro h',
  cases h' with h' h',
  { linarith },
  exact h'
end

theorem abs_ltαα : abs x < y ↔ - y < x ∧ x < y :=
begin
  cases le_or_gt 0 x with h h,
  { rw abs_of_nonneg h,
    split,
    { intro h',
      split,
      { linarith },
      exact h' },
    intro h',
    cases h' with h1 h2,
    exact h2 },
  rw abs_of_neg h,
  split,
  { intro h',
    split,
    { linarith },
    linarith },
  intro h',
  linarith
end

-- BOTH:
end my_abs
end

/- TEXT:
You can also use ``rcases`` and ``rintros`` with disjunctions.
When these result in a genuine case split with multiple goals,
the patterns for each new goal are separated by a vertical bar.
TEXT. -/
-- QUOTE:
example {x : ℝ} (h : x ≠ 0) : x < 0 ∨ x > 0 :=
begin
  rcases lt_trichotomy x 0 with xlt | xeq | xgt,
  { left, exact xlt },
  { contradiction },
  right, exact xgt
end
-- QUOTE.

/- TEXT:
You can still nest patterns and use the ``rfl`` keyword
to substitute equations:
TEXT. -/
-- QUOTE:
example {m n k : ℕ} (h : m ∣ n ∨ m ∣ k) : m ∣ n * k :=
begin
  rcases h with ⟨a, rfl⟩ | ⟨b, rfl⟩,
  { rw [mul_assoc],
    apply dvd_mul_right },
  rw [mul_comm, mul_assoc],
  apply dvd_mul_right
end
-- QUOTE.

/- TEXT:
See if you can prove the following with a single (long) line.
Use ``rcases`` to unpack the hypotheses and split on cases,
and use a semicolon and ``linarith`` to solve each branch.
TEXT. -/
-- QUOTE:
example {z : ℝ} (h : ∃ x y, z = x^2 + y^2 ∨ z = x^2 + y^2 + 1) :
  z ≥ 0 :=
sorry
-- QUOTE.

-- SOLUTIONS:
example {z : ℝ} (h : ∃ x y, z = x^2 + y^2 ∨ z = x^2 + y^2 + 1) :
  z ≥ 0 :=
by { rcases h with ⟨x, y, rfl | rfl⟩; linarith [sq_nonneg x, sq_nonneg y] }

/- TEXT:
On the real numbers, an equation ``x * y = 0``
tells us that ``x = 0`` or ``y = 0``.
In mathlib, this fact is known as ``eq_zero_or_eq_zero_of_mul_eq_zero``,
and it is another nice example of how a disjunction can arise.
See if you can use it to prove the following:
TEXT. -/
-- QUOTE:
example {x : ℝ} (h : x^2 = 1) : x = 1 ∨ x = -1 :=
sorry

example {x y : ℝ} (h : x^2 = y^2) : x = y ∨ x = -y :=
sorry
-- QUOTE.

-- SOLUTIONS:
example {x : ℝ} (h : x^2 = 1) : x = 1 ∨ x = -1 :=
begin
  have h' : x^2 - 1 = 0,
  { rw [h, sub_self] },
  have h'' : (x + 1) * (x - 1) = 0,
  { rw ← h',
    ring },
  cases eq_zero_or_eq_zero_of_mul_eq_zero h'' with h1 h1,
  { right,
    exact eq_neg_iff_add_eq_zero.mpr h1 },
  left,
  exact eq_of_sub_eq_zero h1
end

example {x y : ℝ} (h : x^2 = y^2) : x = y ∨ x = -y :=
begin
  have h' : x^2 - y^2 = 0,
  { rw [h, sub_self] },
  have h'' : (x + y) * (x - y) = 0,
  { rw ← h',
    ring },
  cases eq_zero_or_eq_zero_of_mul_eq_zero h'' with h1 h1,
  { right,
    exact eq_neg_iff_add_eq_zero.mpr h1 },
  left,
  exact eq_of_sub_eq_zero h1
end

/- TEXT:
Remember that you can use the ``ring`` tactic to help
with calculations.

In an arbitrary ring :math:`R`, an element :math:`x` such
that :math:`x y = 0` for some nonzero :math:`y` is called
a *left zero divisor*,
an element :math:`x` such
that :math:`y x = 0` for some nonzero :math:`y` is called
a *right zero divisor*,
and an element that is either a left or right zero divisor
is called simply a *zero divisor*.
The theorem ``eq_zero_or_eq_zero_of_mul_eq_zero``
says that the real numbers have no nontrivial zero divisors.
A commutative ring with this property is called an *integral domain*.
Your proofs of the two theorems above should work equally well
in any integral domain:
TEXT. -/
-- BOTH:
section
-- QUOTE:
variables {R : Type*} [comm_ring R] [is_domain R]
variables (x y : R)

-- EXAMPLES:
example (h : x^2 = 1) : x = 1 ∨ x = -1 :=
sorry

example (h : x^2 = y^2) : x = y ∨ x = -y :=
sorry
-- QUOTE.

-- SOLUTIONS:
example (h : x^2 = 1) : x = 1 ∨ x = -1 :=
begin
  have h' : x^2 - 1 = 0,
  { rw [h, sub_self] },
  have h'' : (x + 1) * (x - 1) = 0,
  { rw ← h',
    ring },
  cases eq_zero_or_eq_zero_of_mul_eq_zero h'' with h1 h1,
  { right,
    exact eq_neg_iff_add_eq_zero.mpr h1 },
  left,
  exact eq_of_sub_eq_zero h1
end

example (h : x^2 = y^2) : x = y ∨ x = -y :=
begin
  have h' : x^2 - y^2 = 0,
  { rw [h, sub_self] },
  have h'' : (x + y) * (x - y) = 0,
  { rw ← h',
    ring },
  cases eq_zero_or_eq_zero_of_mul_eq_zero h'' with h1 h1,
  { right,
    exact eq_neg_iff_add_eq_zero.mpr h1 },
  left,
  exact eq_of_sub_eq_zero h1
end

-- BOTH:
end

/- TEXT:
In fact, if you are careful, you can prove the first
theorem without using commutativity of multiplication.
In that case, it suffices to assume that ``R`` is
a ``domain`` instead of an ``integral_domain``.

.. index:: excluded middle

Sometimes in a proof we want to split on cases
depending on whether some statement is true or not.
For any proposition ``P``, we can use
``classical.em P : P ∨ ¬ P``.
The name ``em`` is short for "excluded middle."
TEXT. -/
-- QUOTE:
example (P : Prop) : ¬ ¬ P → P :=
begin
  intro h,
  cases classical.em P,
  { assumption },
  contradiction
end
-- QUOTE.

/- TEXT:
.. index:: by_cases, tactics ; by_cases

You can shorten ``classical.em`` to ``em``
by opening the ``classical`` namespace with the command
``open classical``.
Alternatively, you can use the ``by_cases`` tactic.
The ``open_locale classical`` command guarantees that Lean can
make implicit use of the law of the excluded middle.
TEXT. -/
-- BOTH:
section
-- QUOTE:
open_locale classical

-- EXAMPLES:
example (P : Prop) : ¬ ¬ P → P :=
begin
  intro h,
  by_cases h' : P,
  { assumption },
  contradiction
end
-- QUOTE.

/- TEXT:
Notice that the ``by_cases`` tactic lets you
specify a label for the hypothesis that is
introduced in each branch,
in this case, ``h' : P`` in one and ``h' : ¬ P``
in the other.
If you leave out the label,
Lean uses ``h`` by default.
Try proving the following equivalence,
using ``by_cases`` to establish one direction.
TEXT. -/
-- QUOTE:
example (P Q : Prop) : (P → Q) ↔ ¬ P ∨ Q :=
sorry
-- QUOTE.

-- SOLUTIONS:
example (P Q : Prop) : (P → Q) ↔ ¬ P ∨ Q :=
begin
  split,
  { intro h,
    by_cases h' : P,
    { right,
      exact h h'},
    left,
    exact h' },
  rintros (h | h),
  { intro h',
    exact absurd h' h },
  intro _,
  exact h
end

-- BOTH:
end


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import tactic.apply_fun
import algebra.field.opposite
import algebra.field_power
import data.equiv.ring_aut
import group_theory.group_action.units
import group_theory.group_action.opposite
import algebra.ring.comp_typeclasses

/-!
# Star monoids, rings, and modules

We introduce the basic algebraic notions of star monoids, star rings, and star modules.
A star algebra is simply a star ring that is also a star module.

These are implemented as "mixin" typeclasses, so to summon a star ring (for example)
one needs to write `(R : Type) [ring R] [star_ring R]`.
This avoids difficulties with diamond inheritance.

We also define the class `star_ordered_ring R`, which says that the order on `R` respects the
star operation, i.e. an element `r` is nonnegative iff there exists an `s` such that
`r = star s * s`.

For now we simply do not introduce notations,
as different users are expected to feel strongly about the relative merits of
`r^*`, `r†`, `rᘁ`, and so on.

Our star rings are actually star semirings, but of course we can prove
`star_neg : star (-r) = - star r` when the underlying semiring is a ring.

## TODO

* In a Banach star algebra without a well-defined square root, the natural ordering is given by the
positive cone which is the closure of the sums of elements `star r * r`. A weaker version of
`star_ordered_ring` could be defined for this case. Note that the current definition has the
advantage of not requiring a topology.
-/

universes u v

open mul_opposite

/--
Notation typeclass (with no default notation!) for an algebraic structure with a star operation.
-/
class has_star (R : Type u) :=
(star : R → R)

variables {R : Type u}

export has_star (star)

/--
A star operation (e.g. complex conjugate).
-/
add_decl_doc star

/--
Typeclass for a star operation with is involutive.
-/
class has_involutive_star (R : Type u) extends has_star R :=
(star_involutive : function.involutive star)

export has_involutive_star (star_involutive)

@[simp] lemma star_star [has_involutive_star R] (r : R) : star (star r) = r :=
star_involutive _

lemma star_injective [has_involutive_star R] : function.injective (star : R → R) :=
star_involutive.injective

/--
Typeclass for a trivial star operation. This is mostly meant for `ℝ`.
-/
class has_trivial_star (R : Type u) [has_star R] :=
(star_trivial : ∀ (r : R), star r = r)

export has_trivial_star (star_trivial)
attribute [simp] star_trivial

/--
A `*`-monoid is a monoid `R` with an involutive operations `star`
so `star (r * s) = star s * star r`.
-/
class star_monoid (R : Type u) [monoid R] extends has_involutive_star R :=
(star_mul : ∀ r s : R, star (r * s) = star s * star r)

export star_monoid (star_mul)
attribute [simp] star_mul

/-- In a commutative ring, make `simp` prefer leaving the order unchanged. -/
@[simp] lemma star_mul' [comm_monoid R] [star_monoid R] (x y : R) :
  star (x * y) = star x * star y :=
(star_mul x y).trans (mul_comm _ _)

/-- `star` as an `mul_equiv` from `R` to `Rᵐᵒᵖ` -/
@[simps apply]
def star_mul_equiv [monoid R] [star_monoid R] : R ≃* Rᵐᵒᵖ :=
{ to_fun := λ x, mul_opposite.op (star x),
  map_mul' := λ x y, (star_mul x y).symm ▸ (mul_opposite.op_mul _ _),
  ..(has_involutive_star.star_involutive.to_equiv star).trans op_equiv}

/-- `star` as a `mul_aut` for commutative `R`. -/
@[simps apply]
def star_mul_aut [comm_monoid R] [star_monoid R] : mul_aut R :=
{ to_fun := star,
  map_mul' := star_mul',
  ..(has_involutive_star.star_involutive.to_equiv star) }

variables (R)

@[simp] lemma star_one [monoid R] [star_monoid R] : star (1 : R) = 1 :=
op_injective $ (star_mul_equiv : R ≃* Rᵐᵒᵖ).map_one.trans (op_one _).symm

variables {R}

@[simp] lemma star_pow [monoid R] [star_monoid R] (x : R) (n : ℕ) : star (x ^ n) = star x ^ n :=
op_injective $
  ((star_mul_equiv : R ≃* Rᵐᵒᵖ).to_monoid_hom.map_pow x n).trans (op_pow (star x) n).symm

@[simp] lemma star_inv [group R] [star_monoid R] (x : R) : star (x⁻¹) = (star x)⁻¹ :=
op_injective $
  ((star_mul_equiv : R ≃* Rᵐᵒᵖ).to_monoid_hom.map_inv x).trans (op_inv (star x)).symm

@[simp] lemma star_zpow [group R] [star_monoid R] (x : R) (z : ℤ) : star (x ^ z) = star x ^ z :=
op_injective $
  ((star_mul_equiv : R ≃* Rᵐᵒᵖ).to_monoid_hom.map_zpow x z).trans (op_zpow (star x) z).symm

/-- When multiplication is commutative, `star` preserves division. -/
@[simp] lemma star_div [comm_group R] [star_monoid R] (x y : R) : star (x / y) = star x / star y :=
(star_mul_aut : R ≃* R).to_monoid_hom.map_div _ _

section
open_locale big_operators

@[simp] lemma star_prod [comm_monoid R] [star_monoid R] {α : Type*}
  (s : finset α) (f : α → R):
  star (∏ x in s, f x) = ∏ x in s, star (f x) :=
(star_mul_aut : R ≃* R).map_prod _ _

end

/--
Any commutative monoid admits the trivial `*`-structure.

See note [reducible non-instances].
-/
@[reducible]
def star_monoid_of_comm {R : Type*} [comm_monoid R] : star_monoid R :=
{ star := id,
  star_involutive := λ x, rfl,
  star_mul := mul_comm }

section
local attribute [instance] star_monoid_of_comm

/-- Note that since `star_monoid_of_comm` is reducible, `simp` can already prove this. --/
lemma star_id_of_comm {R : Type*} [comm_semiring R] {x : R} : star x = x := rfl

end

/--
A `*`-additive monoid `R` is an additive monoid with an involutive `star` operation which
preserves addition.
-/
class star_add_monoid (R : Type u) [add_monoid R] extends has_involutive_star R :=
(star_add : ∀ r s : R, star (r + s) = star r + star s)

export star_add_monoid (star_add)
attribute [simp] star_add

/-- `star` as an `add_equiv` -/
@[simps apply]
def star_add_equiv [add_monoid R] [star_add_monoid R] : R ≃+ R :=
{ to_fun := star,
  map_add' := star_add,
  ..(has_involutive_star.star_involutive.to_equiv star)}

variables (R)

@[simp] lemma star_zero [add_monoid R] [star_add_monoid R] : star (0 : R) = 0 :=
(star_add_equiv : R ≃+ R).map_zero

variables {R}

@[simp] lemma star_neg [add_group R] [star_add_monoid R] (r : R) : star (-r) = - star r :=
(star_add_equiv : R ≃+ R).map_neg _

@[simp] lemma star_sub [add_group R] [star_add_monoid R] (r s : R) :
  star (r - s) = star r - star s :=
(star_add_equiv : R ≃+ R).map_sub _ _

@[simp] lemma star_nsmul [add_comm_monoid R] [star_add_monoid R] (x : R) (n : ℕ) :
  star (n • x) = n • star x :=
(star_add_equiv : R ≃+ R).to_add_monoid_hom.map_nsmul _ _

@[simp] lemma star_zsmul [add_comm_group R] [star_add_monoid R] (x : R) (n : ℤ) :
  star (n • x) = n • star x :=
(star_add_equiv : R ≃+ R).to_add_monoid_hom.map_zsmul _ _

section
open_locale big_operators

@[simp] lemma star_sum [add_comm_monoid R] [star_add_monoid R] {α : Type*}
  (s : finset α) (f : α → R):
  star (∑ x in s, f x) = ∑ x in s, star (f x) :=
(star_add_equiv : R ≃+ R).map_sum _ _

end

/--
A `*`-ring `R` is a (semi)ring with an involutive `star` operation which is additive
which makes `R` with its multiplicative structure into a `*`-monoid
(i.e. `star (r * s) = star s * star r`).
-/
class star_ring (R : Type u) [semiring R] extends star_monoid R :=
(star_add : ∀ r s : R, star (r + s) = star r + star s)

@[priority 100]
instance star_ring.to_star_add_monoid [semiring R] [star_ring R] : star_add_monoid R :=
{ star_add := star_ring.star_add }

/-- `star` as an `ring_equiv` from `R` to `Rᵐᵒᵖ` -/
@[simps apply]
def star_ring_equiv [semiring R] [star_ring R] : R ≃+* Rᵐᵒᵖ :=
{ to_fun := λ x, mul_opposite.op (star x),
  ..star_add_equiv.trans (mul_opposite.op_add_equiv : R ≃+ Rᵐᵒᵖ),
  ..star_mul_equiv }

/-- `star` as a ring automorphism, for commutative `R`. -/
@[simps apply]
def star_ring_aut [comm_semiring R] [star_ring R] : ring_aut R :=
{ to_fun := star,
  ..star_add_equiv,
  ..star_mul_aut }

variables (R)
/-- `star` as a ring endomorphism, for commutative `R`. This is used to denote complex
conjugation, and is available under the notation `conj` in the locale `complex_conjugate`.

Note that this is the preferred form (over `star_ring_aut`, available under the same hypotheses)
because the notation `E →ₗ⋆[R] F` for an `R`-conjugate-linear map (short for
`E →ₛₗ[star_ring_end R] F`) does not pretty-print if there is a coercion involved, as would be the
case for `(↑star_ring_aut : R →* R)`. -/
def star_ring_end [comm_semiring R] [star_ring R] : R →+* R := @star_ring_aut R _ _
variables {R}

localized "notation `conj` := star_ring_end _" in complex_conjugate

/-- This is not a simp lemma, since we usually want simp to keep `star_ring_end` bundled.
 For example, for complex conjugation, we don't want simp to turn `conj x`
 into the bare function `star x` automatically since most lemmas are about `conj x`. -/
lemma star_ring_end_apply [comm_semiring R] [star_ring R] {x : R} :
  star_ring_end R x = star x := rfl

@[simp] lemma star_ring_end_self_apply [comm_semiring R] [star_ring R] (x : R) :
  star_ring_end R (star_ring_end R x) = x := star_star x

-- A more convenient name for complex conjugation
alias star_ring_end_self_apply ← complex.conj_conj
alias star_ring_end_self_apply ← is_R_or_C.conj_conj

@[simp] lemma star_inv' [division_ring R] [star_ring R] (x : R) : star (x⁻¹) = (star x)⁻¹ :=
op_injective $
  ((star_ring_equiv : R ≃+* Rᵐᵒᵖ).to_ring_hom.map_inv x).trans (op_inv (star x)).symm

@[simp] lemma star_zpow₀ [division_ring R] [star_ring R] (x : R) (z : ℤ) :
  star (x ^ z) = star x ^ z :=
op_injective $
  ((star_ring_equiv : R ≃+* Rᵐᵒᵖ).to_ring_hom.map_zpow x z).trans (op_zpow (star x) z).symm

/-- When multiplication is commutative, `star` preserves division. -/
@[simp] lemma star_div' [field R] [star_ring R] (x y : R) : star (x / y) = star x / star y :=
(star_ring_end R).map_div _ _

@[simp] lemma star_bit0 [ring R] [star_ring R] (r : R) : star (bit0 r) = bit0 (star r) :=
by simp [bit0]

@[simp] lemma star_bit1 [ring R] [star_ring R] (r : R) : star (bit1 r) = bit1 (star r) :=
by simp [bit1]

/--
Any commutative semiring admits the trivial `*`-structure.

See note [reducible non-instances].
-/
@[reducible]
def star_ring_of_comm {R : Type*} [comm_semiring R] : star_ring R :=
{ star := id,
  star_add := λ x y, rfl,
  ..star_monoid_of_comm }

/--
An ordered `*`-ring is a ring which is both an `ordered_add_comm_group` and a `*`-ring,
and `0 ≤ r ↔ ∃ s, r = star s * s`.
-/
class star_ordered_ring (R : Type u) [ring R] [partial_order R] extends star_ring R :=
(add_le_add_left       : ∀ a b : R, a ≤ b → ∀ c : R, c + a ≤ c + b)
(nonneg_iff            : ∀ r : R, 0 ≤ r ↔ ∃ s, r = star s * s)

namespace star_ordered_ring

variables [ring R] [partial_order R] [star_ordered_ring R]

@[priority 100] -- see note [lower instance priority]
instance : ordered_add_comm_group R :=
{ ..show ring R, by apply_instance,
  ..show partial_order R, by apply_instance,
  ..show star_ordered_ring R, by apply_instance }

end star_ordered_ring

lemma star_mul_self_nonneg [ring R] [partial_order R] [star_ordered_ring R] {r : R} :
  0 ≤ star r * r :=
(star_ordered_ring.nonneg_iff _).mpr ⟨r, rfl⟩

lemma star_mul_self_nonneg' [ring R] [partial_order R] [star_ordered_ring R] {r : R} :
  0 ≤ r * star r :=
by { nth_rewrite_rhs 0 [←star_star r], exact star_mul_self_nonneg }

/--
A star module `A` over a star ring `R` is a module which is a star add monoid,
and the two star structures are compatible in the sense
`star (r • a) = star r • star a`.

Note that it is up to the user of this typeclass to enforce
`[semiring R] [star_ring R] [add_comm_monoid A] [star_add_monoid A] [module R A]`, and that
the statement only requires `[has_star R] [has_star A] [has_scalar R A]`.

If used as `[comm_ring R] [star_ring R] [semiring A] [star_ring A] [algebra R A]`, this represents a
star algebra.
-/
class star_module (R : Type u) (A : Type v) [has_star R] [has_star A] [has_scalar R A] :=
(star_smul : ∀ (r : R) (a : A), star (r • a) = star r • star a)

export star_module (star_smul)
attribute [simp] star_smul

/-- A commutative star monoid is a star module over itself via `monoid.to_mul_action`. -/
instance star_monoid.to_star_module [comm_monoid R] [star_monoid R] : star_module R R :=
⟨star_mul'⟩

namespace ring_hom_inv_pair

/-- Instance needed to define star-linear maps over a commutative star ring
(ex: conjugate-linear maps when R = ℂ).  -/
instance [comm_semiring R] [star_ring R] :
  ring_hom_inv_pair (star_ring_end R) (star_ring_end R) :=
⟨ring_hom.ext star_star, ring_hom.ext star_star⟩

end ring_hom_inv_pair

/-! ### Instances -/

namespace units

variables [monoid R] [star_monoid R]

instance : star_monoid Rˣ :=
{ star := λ u,
  { val := star u,
    inv := star ↑u⁻¹,
    val_inv := (star_mul _ _).symm.trans $ (congr_arg star u.inv_val).trans $ star_one _,
    inv_val := (star_mul _ _).symm.trans $ (congr_arg star u.val_inv).trans $ star_one _ },
  star_involutive := λ u, units.ext (star_involutive _),
  star_mul := λ u v, units.ext (star_mul _ _) }

@[simp] lemma coe_star (u : Rˣ) : ↑(star u) = (star ↑u : R) := rfl
@[simp] lemma coe_star_inv (u : Rˣ) : ↑(star u)⁻¹ = (star ↑u⁻¹ : R) := rfl

instance {A : Type*} [has_star A] [has_scalar R A] [star_module R A] : star_module Rˣ A :=
⟨λ u a, (star_smul ↑u a : _)⟩

end units

lemma is_unit.star [monoid R] [star_monoid R] {a : R} : is_unit a → is_unit (star a)
| ⟨u, hu⟩ := ⟨star u, hu ▸ rfl⟩

@[simp] lemma is_unit_star [monoid R] [star_monoid R] {a : R} : is_unit (star a) ↔ is_unit a :=
⟨λ h, star_star a ▸ h.star, is_unit.star⟩

lemma ring.inverse_star [semiring R] [star_ring R] (a : R) :
  ring.inverse (star a) = star (ring.inverse a) :=
begin
  by_cases ha : is_unit a,
  { obtain ⟨u, rfl⟩ := ha,
    rw [ring.inverse_unit, ←units.coe_star, ring.inverse_unit, ←units.coe_star_inv], },
  rw [ring.inverse_non_unit _ ha, ring.inverse_non_unit _ (mt is_unit_star.mp ha), star_zero],
end

namespace mul_opposite

/-- The opposite type carries the same star operation. -/
instance [has_star R] : has_star (Rᵐᵒᵖ) :=
{ star := λ r, op (star (r.unop)) }

@[simp] lemma unop_star [has_star R] (r : Rᵐᵒᵖ) : unop (star r) = star (unop r) := rfl
@[simp] lemma op_star [has_star R] (r : R) : op (star r) = star (op r) := rfl

instance [has_involutive_star R] : has_involutive_star (Rᵐᵒᵖ) :=
{ star_involutive := λ r, unop_injective (star_star r.unop) }

instance [monoid R] [star_monoid R] : star_monoid (Rᵐᵒᵖ) :=
{ star_mul := λ x y, unop_injective (star_mul y.unop x.unop) }

instance [add_monoid R] [star_add_monoid R] : star_add_monoid (Rᵐᵒᵖ) :=
{ star_add := λ x y, unop_injective (star_add x.unop y.unop) }

instance [semiring R] [star_ring R] : star_ring (Rᵐᵒᵖ) :=
{ .. mul_opposite.star_add_monoid }

end mul_opposite

/-- A commutative star monoid is a star module over its opposite via
`monoid.to_opposite_mul_action`. -/
instance star_monoid.to_opposite_star_module [comm_monoid R] [star_monoid R] : star_module Rᵐᵒᵖ R :=
⟨λ r s, star_mul' s r.unop⟩


import data.nat.modeq
import data.nat.basic
import data.int.basic
import data.nat.prime
import data.nat.gcd
import data.zmod.quadratic_reciprocity

#check zmodp.fermat_little

#check zmodp.eq_zero_iff_dvd_nat

lemma lcm_property (e d p q: ℕ) : (e*d = 1 % (nat.lcm p q)) → e*d -1 = 0 ∨ (∃ h: ℕ, e*d - 1 = h*(p - 1)) :=
begin
intro h,
sorry
end

/- These are the two major helper theorems for the RSA_correctness theorem -/
theorem RSA_lemma_modp (e d m p q: ℕ): ((nat.prime p ∧ nat.prime q ∧ p ≠ q) ∧ (e*d = 1 % (nat.lcm p q))) → (m^e)^d ≡ m [MOD p] :=
begin
    intro hyp,
    by_cases (m = 0 % p),
    {sorry},
    sorry
end

theorem RSA_lemma_modq (e d m p q: ℕ): ((nat.prime p ∧ nat.prime q ∧ p ≠ q) ∧ (e*d = 1 % (nat.lcm p q))) → (m^e)^d ≡ m [MOD q] :=
begin
    intro hyp,
    by_cases (m = 0 % p),
    {sorry},
    sorry
end

/- This is a small lemma that says that if you have two different primes, they are coprime. -/
#check nat.prime.coprime_iff_not_dvd
lemma coprime_prime_and_prime {p q : ℕ}: nat.prime p ∧ nat.prime q ∧ p ≠ q → nat.coprime p q :=
begin
intro hyp,
have h1: nat.prime p, from hyp.left,
have h2: nat.prime q, from (hyp.right).left,
have h3: p ≠ q, from (hyp.right).right,
have iff_conc: (nat.coprime p q ↔ ¬ p | q), from nat.prime.coprime_iff_not_dvd h1,
sorry
end

/- Technically you can get this theorem for all m in Z but to avoid casting we state it for nats -/
#check nat.modeq.modeq_and_modeq_iff_modeq_mul
theorem RSA_correctness (e d m p q: ℕ): ((nat.prime p ∧ nat.prime q ∧ p ≠ q) ∧ (e*d = 1 % (nat.lcm p q))) → (m^e)^d ≡ m [MOD (p*q)] :=
begin
    intro hyp,
    have hyp1: nat.prime p ∧ nat.prime q ∧ p ≠ q, from hyp.left,
    have h1: (m^e)^d ≡ m [MOD p], from RSA_lemma_modp e d m p q hyp,
    have h2: (m^e)^d ≡ m [MOD q], from RSA_lemma_modq e d m p q hyp,
     have h1andh2: (m^e)^d ≡ m [MOD p] ∧ (m^e)^d ≡ m [MOD q], from and.intro h1 h2,
    have h3: nat.coprime p q, from coprime_prime_and_prime hyp.left,
    have h4: ((m^e)^d ≡ m [MOD p] ∧ (m^e)^d ≡ m [MOD q]) ↔ (m^e)^d ≡ m [MOD p*q], from nat.modeq.modeq_and_modeq_iff_modeq_mul h3,
    have h5: (m^e)^d ≡ m [MOD p*q], from (iff.elim_left h4) h1andh2,
    exact h5
end
/-    intros e d m p q,
    or.elim (em (m = 0 % p))
    {sorry},
    sorry-/


import algebra.big_operators.intervals
import algebra.big_operators.order
import data.nat.basic
import data.nat.factorization.basic
import data.nat.factors
import data.nat.interval
import data.nat.log
import data.real.basic
import data.fintype.basic
import data.finset.basic
import data.set.intervals.basic
import order.with_bot  -- with_bot.decidable_le

open_locale big_operators

-- def is_prime_le (n p : ℕ) : Prop := p ≤ n ∧ p.prime
--
-- -- Is this necessary? Feels redundant?
-- instance decidable_is_prime_le (n p : ℕ) : decidable (is_prime_le n p) :=
-- begin
--   apply decidable_of_iff (p ≤ n ∧ p.prime),
--   rw is_prime_le,
-- end

-- Could define all_factors_le using k.factors.maximum ≤ n?
-- However, it's difficult to work with (list.maximum ≤ n).
-- Instead define with for-all statement; use list.maximum to prove decidable.
-- TODO: Consider k in ℕ+ rather than ℕ?
def all_factors_le (n k : ℕ) : Prop := ∀ (p : ℕ), p ∈ k.factors → p ≤ n

lemma all_factors_le_one (n : ℕ) : all_factors_le n 1 := by simp [all_factors_le]

lemma all_factors_le_of_le {n : ℕ} {k : ℕ} (hk : k ≤ n) : all_factors_le n k :=
begin
  rw all_factors_le,
  intros p hp,
  apply le_trans _ hk,
  exact nat.le_of_mem_factors hp,
end

-- Prove decidable.

lemma exists_maximum_eq_coe_iff {l : list ℕ} : (∃ x : ℕ, l.maximum = ↑x) ↔ l ≠ list.nil :=
begin
  apply iff.intro,
  { intro h,
    cases h with x hx,
    rw list.maximum_eq_coe_iff at hx,
    exact list.ne_nil_of_mem hx.left, },
  { intro h,
    replace h := list.foldr_max_of_ne_nil h,
    rw ← h,
    simp, },
end

-- This feels too fundamental? Doesn't exist in mathlib?
lemma maximum_le_iff_forall_le {l : list ℕ} {m : ℕ} :
  l.maximum ≤ ↑m ↔ ∀ (x : ℕ), x ∈ l → x ≤ m :=
begin
  cases decidable.em (l = list.nil),
  { rw h, simp, },
  { rw (by simp : ¬l = list.nil ↔ l ≠ list.nil) at h,
    -- Get the actual maximum.
    rw ← exists_maximum_eq_coe_iff at h,
    cases h with c hc,
    rw hc,
    simp,
    rw list.maximum_eq_coe_iff at hc,
    apply iff.intro,
    { intros h x hx,
      apply le_trans _ h,
      exact hc.right x hx, },
    { intro h,
      exact h c hc.left, }, },
end

-- These two types are equal? Why do we need to define this?
def convert (x : option ℕ) : with_bot ℕ := x

-- This feels like a more natural way to write maximum?
lemma maximum_eq_foldr {l : list ℕ} : l.maximum = list.foldr (max ∘ coe) ⊥ l :=
begin
  rw list.maximum,
  rw list.argmax,
  rw ← list.foldr_map,
  rw ← list.foldl_eq_foldr max_commutative max_associative,
  rw list.foldl_map,
  -- Need list.foldl_hom because lhs uses (option ℕ) and rhs uses (with_bot ℕ).
  have h : (∀ (x : option ℕ), x = convert x) := by { intro x, rw convert, },
  rw h (list.foldl _ none _),
  -- rw (h none : ⊥ = convert none),  -- Doesn't work like this?
  have h_none : ⊥ = convert none := h none,
  rw h_none,
  rw list.foldl_hom,
  intros x y,
  rw [convert, convert],
  simp,
  rw list.arg_aux,
  cases x,
  { trivial, },
  { simp,
    rw [option.some_eq_coe, option.some_eq_coe],
    rw ite_eq_iff,
    rw [eq_comm, max_eq_right_iff],
    rw [eq_comm, max_eq_left_iff],
    simp,
    cases lt_or_le x y with hxy hyx,
    { left, exact and.intro hxy (le_of_lt hxy), },
    { right, exact hyx, }, },
end

-- Prove using foldr instead.
lemma maximum_le_iff_forall_le' {l : list ℕ} {m : ℕ} :
  l.maximum ≤ ↑m ↔ ∀ (x : ℕ), x ∈ l → x ≤ m :=
begin
  rw maximum_eq_foldr,
  apply iff.intro,
  { induction l with a l' hl', simp,
    simp,
    intros ha h,
    exact and.intro ha (hl' h), },
  { intro h,
    rw ← list.foldr_map,
    -- Use `max_le_of_forall_le` instead of induction.
    -- (Induction might be cleaner?)
    apply list.max_le_of_forall_le _ _ _,
    intro x,
    cases x, simp,
    rw option.some_eq_coe,
    have h_inj : function.injective (coe : ℕ → option ℕ) := by
    { rw function.injective,
      simp [← option.some_eq_coe], },
    rw list.mem_map_of_injective h_inj,
    simp,
    apply h, },
end

-- Do we need to prove this?
instance all_factors_le_decidable {n k : ℕ} : decidable (all_factors_le n k) :=
begin
  rw all_factors_le,
  rw ← maximum_le_iff_forall_le,
  apply with_bot.decidable_le,
end


import tactic.push_neg
import data.int.basic

example (h : ∃ p: ℕ, ¬ ∀ n : ℕ, n > p) (h' : ∃ p: ℕ, ¬ ∃ n : ℕ, n < p) : ¬ ∀ n : ℕ, n = 0 :=
begin
  push_neg at *,
  guard_target_strict ∃ (n : ℕ), n ≠ 0,
  guard_hyp_strict h : ∃ (p n : ℕ), n ≤ p,
  guard_hyp_strict h' : ∃ (p : ℕ), ∀ (n : ℕ), p ≤ n,
  use 1,
end

-- In the next example, ℤ should be ℝ in maths, but I don't want to import real numbers
-- for testing only
local notation `|` x `|` := abs x

example (a : ℕ → ℤ) (l : ℤ) (h : ¬ ∀ ε > 0, ∃ N, ∀ n ≥ N, | a n - l | < ε) : true :=
begin
  push_neg at h,
  guard_hyp_strict h : ∃ (ε : ℤ), ε > 0 ∧ ∀ (N : ℕ), ∃ (n : ℕ), n ≥ N ∧ ε ≤ |a n - l|,
  trivial
end

example (f : ℤ → ℤ) (x₀ y₀) (h : ¬ ∀ ε > 0, ∃ δ > 0, ∀ x, |x - x₀| ≤ δ → |f x - y₀| ≤ ε) : true :=
begin
  push_neg at h,
  guard_hyp_strict h : ∃ (ε : ℤ), ε > 0 ∧ ∀ δ > 0, (∃ (x : ℤ), |x - x₀| ≤ δ ∧ ε < |f x - y₀| ),
  trivial
end

example (n) : n*n ≠ 1 → n ≠ 1 :=
begin
  contrapose,
  rw [not_not, not_not],
  intro h,
  rw [h, one_mul]
end

example (n) : n*n ≠ 1 → n ≠ 1 :=
begin
  contrapose!,
  intro h,
  rw [h, one_mul]
end

example (n) (h : n*n ≠ 1) : n ≠ 1 :=
begin
  contrapose h,
  rw not_not at *,
  rw [h, one_mul]
end

example (n) (h : n*n ≠ 1) : n ≠ 1 :=
begin
  contrapose! h,
  rw [h, one_mul]
end

example (n) (h : n*n ≠ 1) : n ≠ 1 :=
begin
  contrapose! h with newh,
  rw [newh, one_mul]
end

example : 0 = 0 :=
begin
  success_if_fail_with_msg { contrapose }
    "The goal is not an implication, and you didn't specify an assumption",
  refl
end

-- Remember that ∀ is the same as Π which is a generalization of → so we need to make sure
-- `contrapose` fails with a helpful error message in the next example.
example : ∀ x : ℕ, x = x :=
begin
  success_if_fail_with_msg { contrapose }
    "contrapose only applies to nondependent arrows between props",
  intro, refl
end

open tactic
example (X : Type) (f : X → ℕ) (h : ¬∀ x, f x = 0) (hf : false) : false :=
begin
  have h1 := h,
  -- h h1: ¬∀ (x : X), f x = 0
  push_neg at h,
  push_neg at h1,
  (do ht ← get_local `h >>= infer_type,
      h1t ← get_local `h1 >>= infer_type,
      guard (ht = h1t) ),
  exact hf
end


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

import probability.variance

/-!
# Moments and moment generating function

## Main definitions

* `moment X p μ`: `p`th moment of a real random variable `X` with respect to measure `μ`, `μ[X^p]`
* `central_moment X p μ`:`p`th central moment of `X` with respect to measure `μ`, `μ[(X - μ[X])^p]`
* `mgf X μ t`: moment generating function of `X` with respect to measure `μ`, `μ[exp(t*X)]`
* `cgf X μ t`: cumulant generating function, logarithm of the moment generating function

## Main results

* `indep_fun.mgf_add`: if two real random variables `X` and `Y` are independent and their mgf are
  defined at `t`, then `mgf (X + Y) μ t = mgf X μ t * mgf Y μ t`
* `indep_fun.cgf_add`: if two real random variables `X` and `Y` are independent and their mgf are
  defined at `t`, then `cgf (X + Y) μ t = cgf X μ t + cgf Y μ t`

-/

open measure_theory filter finset

noncomputable theory

open_locale big_operators measure_theory probability_theory ennreal nnreal

namespace probability_theory

variables {Ω : Type*} {m : measurable_space Ω} {X : Ω → ℝ} {p : ℕ} {μ : measure Ω}

include m

/-- Moment of a real random variable, `μ[X ^ p]`. -/
def moment (X : Ω → ℝ) (p : ℕ) (μ : measure Ω) : ℝ := μ[X ^ p]

/-- Central moment of a real random variable, `μ[(X - μ[X]) ^ p]`. -/
def central_moment (X : Ω → ℝ) (p : ℕ) (μ : measure Ω) : ℝ := μ[(X - (λ x, μ[X])) ^ p]

@[simp] lemma moment_zero (hp : p ≠ 0) : moment 0 p μ = 0 :=
by simp only [moment, hp, zero_pow', ne.def, not_false_iff, pi.zero_apply, integral_const,
  algebra.id.smul_eq_mul, mul_zero]

@[simp] lemma central_moment_zero (hp : p ≠ 0) : central_moment 0 p μ = 0 :=
by simp only [central_moment, hp, pi.zero_apply, integral_const, algebra.id.smul_eq_mul,
  mul_zero, zero_sub, pi.pow_apply, pi.neg_apply, neg_zero', zero_pow', ne.def, not_false_iff]

lemma central_moment_one' [is_finite_measure μ] (h_int : integrable X μ) :
  central_moment X 1 μ = (1 - (μ set.univ).to_real) * μ[X] :=
begin
  simp only [central_moment, pi.sub_apply, pow_one],
  rw integral_sub h_int (integrable_const _),
  simp only [sub_mul, integral_const, algebra.id.smul_eq_mul, one_mul],
end

@[simp] lemma central_moment_one [is_probability_measure μ] : central_moment X 1 μ = 0 :=
begin
  by_cases h_int : integrable X μ,
  { rw central_moment_one' h_int,
    simp only [measure_univ, ennreal.one_to_real, sub_self, zero_mul], },
  { simp only [central_moment, pi.sub_apply, pow_one],
    have : ¬ integrable (λ x, X x - integral μ X) μ,
    { refine λ h_sub, h_int _,
      have h_add : X = (λ x, X x - integral μ X) + (λ x, integral μ X),
      { ext1 x, simp, },
      rw h_add,
      exact h_sub.add (integrable_const _), },
    rw integral_undef this, },
end

@[simp] lemma central_moment_two_eq_variance : central_moment X 2 μ = variance X μ := rfl

section moment_generating_function

variables {t : ℝ}

/-- Moment generating function of a real random variable `X`: `λ t, μ[exp(t*X)]`. -/
def mgf (X : Ω → ℝ) (μ : measure Ω) (t : ℝ) : ℝ := μ[λ ω, real.exp (t * X ω)]

/-- Cumulant generating function of a real random variable `X`: `λ t, log μ[exp(t*X)]`. -/
def cgf (X : Ω → ℝ) (μ : measure Ω) (t : ℝ) : ℝ := real.log (mgf X μ t)

@[simp] lemma mgf_zero_fun : mgf 0 μ t = (μ set.univ).to_real :=
by simp only [mgf, pi.zero_apply, mul_zero, real.exp_zero, integral_const, algebra.id.smul_eq_mul,
  mul_one]

@[simp] lemma cgf_zero_fun : cgf 0 μ t = real.log (μ set.univ).to_real :=
by simp only [cgf, mgf_zero_fun]

@[simp] lemma mgf_zero_measure : mgf X (0 : measure Ω) t = 0 :=
by simp only [mgf, integral_zero_measure]

@[simp] lemma cgf_zero_measure : cgf X (0 : measure Ω) t = 0 :=
by simp only [cgf, real.log_zero, mgf_zero_measure]

@[simp] lemma mgf_const' (c : ℝ) : mgf (λ _, c) μ t = (μ set.univ).to_real * real.exp (t * c) :=
by simp only [mgf, integral_const, algebra.id.smul_eq_mul]

@[simp] lemma mgf_const (c : ℝ) [is_probability_measure μ] : mgf (λ _, c) μ t = real.exp (t * c) :=
by simp only [mgf_const', measure_univ, ennreal.one_to_real, one_mul]

@[simp] lemma cgf_const' [is_finite_measure μ] (hμ : μ ≠ 0) (c : ℝ) :
  cgf (λ _, c) μ t = real.log (μ set.univ).to_real + t * c :=
begin
  simp only [cgf, mgf_const'],
  rw real.log_mul _ (real.exp_pos _).ne',
  { rw real.log_exp _, },
  { rw [ne.def, ennreal.to_real_eq_zero_iff, measure.measure_univ_eq_zero],
    simp only [hμ, measure_ne_top μ set.univ, or_self, not_false_iff], },
end

@[simp] lemma cgf_const [is_probability_measure μ] (c : ℝ) : cgf (λ _, c) μ t = t * c :=
by simp only [cgf, mgf_const, real.log_exp]

@[simp] lemma mgf_zero' : mgf X μ 0 = (μ set.univ).to_real :=
by simp only [mgf, zero_mul, real.exp_zero, integral_const, algebra.id.smul_eq_mul, mul_one]

@[simp] lemma mgf_zero [is_probability_measure μ] : mgf X μ 0 = 1 :=
by simp only [mgf_zero', measure_univ, ennreal.one_to_real]

@[simp] lemma cgf_zero' : cgf X μ 0 = real.log (μ set.univ).to_real :=
by simp only [cgf, mgf_zero']

@[simp] lemma cgf_zero [is_probability_measure μ] : cgf X μ 0 = 0 :=
by simp only [cgf_zero', measure_univ, ennreal.one_to_real, real.log_one]

lemma mgf_undef (hX : ¬ integrable (λ ω, real.exp (t * X ω)) μ) : mgf X μ t = 0 :=
by simp only [mgf, integral_undef hX]

lemma cgf_undef (hX : ¬ integrable (λ ω, real.exp (t * X ω)) μ) : cgf X μ t = 0 :=
by simp only [cgf, mgf_undef hX, real.log_zero]

lemma mgf_nonneg : 0 ≤ mgf X μ t :=
begin
  refine integral_nonneg _,
  intro ω,
  simp only [pi.zero_apply],
  exact (real.exp_pos _).le,
end

lemma mgf_pos' (hμ : μ ≠ 0) (h_int_X : integrable (λ ω, real.exp (t * X ω)) μ) : 0 < mgf X μ t :=
begin
  simp_rw mgf,
  have : ∫ (x : Ω), real.exp (t * X x) ∂μ = ∫ (x : Ω) in set.univ, real.exp (t * X x) ∂μ,
  { simp only [measure.restrict_univ], },
  rw [this, set_integral_pos_iff_support_of_nonneg_ae _ _],
  { have h_eq_univ : function.support (λ (x : Ω), real.exp (t * X x)) = set.univ,
    { ext1 x,
      simp only [function.mem_support, set.mem_univ, iff_true],
      exact (real.exp_pos _).ne', },
    rw [h_eq_univ, set.inter_univ _],
    refine ne.bot_lt _,
    simp only [hμ, ennreal.bot_eq_zero, ne.def, measure.measure_univ_eq_zero, not_false_iff], },
  { refine eventually_of_forall (λ x, _),
    rw pi.zero_apply,
    exact (real.exp_pos _).le, },
  { rwa integrable_on_univ, },
end

lemma mgf_pos [is_probability_measure μ] (h_int_X : integrable (λ ω, real.exp (t * X ω)) μ) :
  0 < mgf X μ t :=
mgf_pos' (is_probability_measure.ne_zero μ) h_int_X

lemma indep_fun.cgf_add {X Y : Ω → ℝ} (h_indep : indep_fun X Y μ)
  (h_int_X : integrable (λ ω, real.exp (t * X ω)) μ)
  (h_int_Y : integrable (λ ω, real.exp (t * Y ω)) μ) :
  cgf (X + Y) μ t = cgf X μ t + cgf Y μ t :=
begin
  by_cases hμ : μ = 0,
  { simp [hμ], },
  simp only [cgf, h_indep.mgf_add h_int_X h_int_Y],
  exact real.log_mul (mgf_pos' hμ h_int_X).ne' (mgf_pos' hμ h_int_Y).ne',
end

end moment_generating_function

end probability_theory


import tactic

namespace vilnius

/- ### implication -/

example (P Q : Prop) : P → Q → P :=
begin
  intros hP HQ,
  exact hP,
end

/- ### not -/

example (P Q : Prop) : (P → ¬ Q) → (Q → ¬ P) :=
begin
  intros hPnQ hQ hP,
  apply hPnQ,
  exact hP,
  exact hQ,
end

/- ### and -/

example (P Q : Prop) : P ∧ Q → Q :=
begin
  intro hPQ,
  cases hPQ with hP hQ,
  exact hQ,
end

example (P Q : Prop) : P → Q → P ∧ Q :=
begin
  intros hP hQ,
  split,
  exact hP,
  exact hQ,
end

example (P Q : Prop) : P ∧ Q → Q ∧ P :=
begin
  intro hPQ,
  cases hPQ with hP hQ,
  split,
  exact hQ,
  exact hP,
end

example (P : Prop) : P ∧ ¬ P → false :=
begin
  intro hPnP,
  cases hPnP with hP hnP,
  apply hnP,
  exact hP,
end

/- ## Or -/

example (P Q : Prop) : ¬ P ∨ Q → P → Q :=
begin
  intros hnPQ hP,
  cases hnPQ with hnP hQ,
  by_contradiction,
  apply hnP,
  exact hP,
  exact hQ,
end

example (P Q R : Prop) : P ∨ (Q ∧ R) → ¬ P → ¬ Q → false :=
begin
  intros hPQR hnP hnQ,
  cases hPQR with hP hQR,
  apply hnP,
  exact hP,

  cases hQR with hQ hR,
  apply hnQ,
  exact hQ,
end

end vilnius


/-
Copyright (c) 2023 Jujian Zhang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Jujian Zhang
-/

import ring_theory.ideal.operations
import topology.algebra.polynomial
import topology.bases

/-!
# Prime spectrum of a ring and its Zariski topology

This files contains the following:
- Zariski topology on the set of all prime ideals of any ring `R`.
- a basis for Zariski topology
- if `f : R →+* S` is a ring homomorphism, then `𝔭 ↦ f⁻¹ 𝔭` is continuous.
- for integral domains, there is a unique generic point.
-/

open topological_space
open_locale pointwise

universe u

variables (R S : Type u) [comm_ring R] [comm_ring S]

/--
`Spec R` is the set of prime ideals of `R`
-/
@[ext]
structure Spec : Type u :=
(as_ideal : ideal R)
(is_prime : as_ideal.is_prime)

attribute [instance] Spec.is_prime -- making sure class inference knows term of `Spec R` is prime

section

variable {R}

/--
zero locus of a set `s ⊆ R` is the set of all prime ideals larger than `s`.

if `f : R`, then it defines a function `𝔭 ↦ ([f] : R ⧸ 𝔭)`.

So `V s` is exactly those primes
vanishing for all `f ∈ s`.
-/
def V (s : set R) : set (Spec R) :=
{ I : Spec R | s ⊆ I.as_ideal }

lemma mem_V (s : set R) {p : Spec R} : p ∈ V s ↔ s ⊆ p.as_ideal :=
iff.rfl

/--
empty set is zero locus of `R`
-/
lemma V_univ : V (set.univ : set R) = ∅ :=
sorry

/--
R is zero locus of `∅`
-/
lemma V_empty : V (∅ : set R) = set.univ :=
sorry

/--
union of zero loci is zero locus of pointwise product
-/
lemma V_union (s t : set R) : V s ∪ V t = V (s * t) :=
sorry

/--
intersection of zero loci is zero locus of union
-/
lemma V_inter {ι : Sort*} (s : ι → set R) :
  (⋂ i : ι, V (s i)) = V (⋃ i, (s i)) :=
sorry

end

instance Zariski_topology : topological_space (Spec R) := sorry

/--
open sets of Zariski topology are complement of zero loci
-/
lemma zt_is_open (s : set (Spec R)) : is_open s ↔ ∃ (t : set R), s = (V t)ᶜ := sorry

section

variables {R S}

/--
Basic open sets
-/
def D (f : R) : set (Spec R) := (V {f})ᶜ

lemma mem_D (f : R) (p : Spec R) : p ∈ D f ↔ f ∉ p.as_ideal := sorry
lemma open_D (f : R) : is_open (D f) := sorry

/--
Basic open sets form a basis
-/
lemma D_is_basis : is_topological_basis (set.range (D : R → set (Spec R))) :=
sorry

/--
Ring homomorphisms induces continuous map (contravariantly).
-/
def comap (f : R →+* S) : Spec S → Spec R :=
sorry

lemma comap_as_ideal (f : R →+* S) (p : Spec S) :
  (comap f p).as_ideal = p.as_ideal.comap f :=
sorry

lemma continuous_comap (f : R →+* S) : continuous (comap f) :=
sorry

local notation `ℤ[X]` := (polynomial ℤ)
-- every thing from this points work for a generic integral domain
/--
the point corresponding to the zero ideal.
-/
@[simps]
def η : Spec ℤ[X] :=
{ as_ideal := sorry,
  is_prime := sorry }

/--
this is a generic point.
-/
lemma generic_η : closure {η} = (set.univ : set (Spec ℤ[X])) :=
sorry

/--
Generic points is unique.
-/
lemma generic_point_uniq (x : Spec ℤ[X]) (hx : closure {x} = (set.univ : set (Spec ℤ[X]))) :
  x = η :=
sorry

end


/-
Copyright (c) 2021 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Kevin Buzzard
-/

import tactic -- imports all the Lean tactics

/-!

# Sets in Lean, sheet 6 : equality of sets

Sets are extensional objects to mathematicians, which means that
if two sets have the same elements, then they are equal.

## Tactics

Tactics you will need to know for this sheet:

* `ext`

### The `ext` tactic

If the goal is `⊢ A = B` where `A` and `B` are subsets of `X`, then
the tactic `ext x,` will create a hypothesis `x : X` and change
the goal to `x ∈ A ↔ x ∈ B`.

-/

open set

variables
  (X : Type) -- Everything will be a subset of `X`
  (A B C D E : set X) -- A,B,C,D,E are subsets of `X`
  (x y z : X) -- x,y,z are elements of `X` or, more precisely, terms of type `X`

example : A ⊆ B → B ⊆ A → A = B :=
begin
  sorry
end

example : A ∪ A = A :=
begin
  sorry
end

example : A ∩ A = A :=
begin
  sorry
end

example : A ∩ B = B ∩ A :=
begin
  sorry
end

example : A ∩ (B ∩ C) = (A ∩ B) ∩ C :=
begin
  sorry
end

example : A ∪ (B ∪ C) = (A ∪ B) ∪ C :=
begin
  sorry
end