import .lovelib

/-! # LoVe Demo 4: Functional Programming

We take a closer look at the basics of typed functional programming: inductive
types, proofs by induction, recursive functions, pattern matching, structures
(records), and type classes. -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/-! ## Inductive Types

Recall the definition of type `nat` (= `ℕ`): -/

#print nat

/-! Mottos:

* **No junk**: The type contains no values beyond those expressible using the
  constructors.

* **No confusion**: Values built in a different ways are different.

For `nat` (= `ℕ`):

* "No junk" means that there are no special values, say, `–1` or `ε`, that
  cannot be expressed using a finite combination of `zero` and `succ`.

* "No confusion" is what ensures that `zero` ≠ `succ x`.

In addition, inductive types are always finite. `succ (succ (succ …))` is not a
value.

## Structural Induction

__Structural induction__ is a generalization of mathematical induction to
inductive types. To prove a property `P[n]` for all natural numbers `n`, it
suffices to prove the base case

    `P[0]`

and the induction step

    `∀k, P[k] → P[k + 1]`

For lists, the base case is

    `P[[]]`

and the induction step is

    `∀y ys, P[ys] → P[y :: ys]`

In general, there is one subgoal per constructor, and induction hypotheses are
available for all constructor arguments of the type we are doing the induction
on. -/

lemma nat.succ_neq_self (n : ℕ) :
  nat.succ n ≠ n :=
begin
  induction' n,
  { simp },
  { simp [ih] }
end

/-! The `case` tactic can be used to supply custom names, and potentially
reorder the cases. -/

lemma nat.succ_neq_self₂ (n : ℕ) :
  nat.succ n ≠ n :=
begin
  induction' n,
  case succ : m IH {
    simp [IH] },
  case zero {
    simp }
end

/-! ## Structural Recursion

__Structural recursion__ is a form of recursion that allows us to peel off
one or more constructors from the value on which we recurse. Such functions are
guaranteed to call themselves only finitely many times before the recursion
stops. This is a prerequisite for establishing that the function terminates. -/

def fact : ℕ → ℕ
| 0       := 1
| (n + 1) := (n + 1) * fact n

def fact₂ : ℕ → ℕ
| 0       := 1
| 1       := 1
| (n + 1) := (n + 1) * fact₂ n

/-! For structurally recursive functions, Lean can automatically prove
termination. For more general recursive schemes, the termination check may fail.
Sometimes it does so for a good reason, as in the following example: -/

-- fails
def illegal : ℕ → ℕ
| n := illegal n + 1

constant immoral : ℕ → ℕ

axiom immoral_eq (n : ℕ) :
  immoral n = immoral n + 1

lemma proof_of_false :
  false :=
have immoral 0 = immoral 0 + 1 :=
  immoral_eq 0,
have immoral 0 - immoral 0 = immoral 0 + 1 - immoral 0 :=
  by cc,
have 0 = 1 :=
  by simp [*] at *,
show false, from
  by cc

/-! ## Pattern Matching Expressions

    `match` _term₁_, …, _termM_ `with`
    | _pattern₁₁_, …, _pattern₁M_ := _result₁_
        ⋮
    | _patternN₁_, …, _patternNM_ := _resultN_
    `end`

`match` allows nonrecursive pattern matching within terms.

In contrast to pattern matching after `lemma` or `def`, the patterns are
separated by commas, so parentheses are optional. -/

def bcount {α : Type} (p : α → bool) : list α → ℕ
| []        := 0
| (x :: xs) :=
  match p x with
  | tt := bcount xs + 1
  | ff := bcount xs
  end

def min (a b : ℕ) : ℕ :=
if a ≤ b then a else b

/-! ## Structures

Lean provides a convenient syntax for defining records, or structures. These are
essentially nonrecursive, single-constructor inductive types. -/

structure rgb :=
(red green blue : ℕ)

#check rgb.mk
#check rgb.red
#check rgb.green
#check rgb.blue

namespace rgb_as_inductive

inductive rgb : Type
| mk : ℕ → ℕ → ℕ → rgb

def rgb.red : rgb → ℕ
| (rgb.mk r _ _) := r

def rgb.green : rgb → ℕ
| (rgb.mk _ g _) := g

def rgb.blue : rgb → ℕ
| (rgb.mk _ _ b) := b

end rgb_as_inductive

structure rgba extends rgb :=
(alpha : ℕ)

#print rgba

def pure_red : rgb :=
{ red   := 0xff,
  green := 0x00,
  blue  := 0x00 }

def semitransparent_red : rgba :=
{ alpha := 0x7f,
  ..pure_red }

#print pure_red
#print semitransparent_red

def shuffle (c : rgb) : rgb :=
{ red   := rgb.green c,
  green := rgb.blue c,
  blue  := rgb.red c }

/-! `cases'` performs a case distinction on the specified term. This gives rise
to as many subgoals as there are constructors in the definition of the term's
type. The tactic behaves the same as `induction'` except that it does not
produce induction hypotheses. -/

lemma shuffle_shuffle_shuffle (c : rgb) :
  shuffle (shuffle (shuffle c)) = c :=
begin
  cases' c,
  refl
end

lemma shuffle_shuffle_shuffle₂ (c : rgb) :
  shuffle (shuffle (shuffle c)) = c :=
match c with
| rgb.mk _ _ _ := eq.refl _
end

/-! ## Type Classes

A __type class__ is a structure type combining abstract constants and their
properties. A type can be declared an instance of a type class by providing
concrete definitions for the constants and proving that the properties hold.
Based on the type, Lean retrieves the relevant instance. -/

#print inhabited

@[instance] def nat.inhabited : inhabited ℕ :=
{ default := 0 }

@[instance] def list.inhabited {α : Type} :
  inhabited (list α) :=
{ default := [] }

#eval inhabited.default ℕ          -- result: 0
#eval inhabited.default (list ℤ)   -- result: []

def head {α : Type} [inhabited α] : list α → α
| []       := inhabited.default α
| (x :: _) := x

lemma head_head {α : Type} [inhabited α] (xs : list α) :
  head [head xs] = head xs :=
begin
  cases' xs,
  { refl },
  { refl }
end

#eval head ([] : list ℕ)   -- result: 0

#check list.head

@[instance] def fun.inhabited {α β : Type} [inhabited β] :
  inhabited (α → β) :=
{ default := λa : α, inhabited.default β }

inductive empty : Type

@[instance] def fun_empty.inhabited {β : Type} :
  inhabited (empty → β) :=
{ default := λa : empty, match a with end }

@[instance] def prod.inhabited {α β : Type}
    [inhabited α] [inhabited β] :
  inhabited (α × β) :=
{ default := (inhabited.default α, inhabited.default β) }

/-! Here are other type classes without properties: -/

#check has_zero
#check has_neg
#check has_add
#check has_one
#check has_inv
#check has_mul

#check (1 : ℕ)
#check (1 : ℤ)
#check (1 : ℝ)

/-! We encountered these type classes in lecture 2: -/

#print is_commutative
#print is_associative

/-! ## Lists

`list` is an inductive polymorphic type constructed from `nil` and `cons`: -/

#print list

/-! `cases'` can also be used on a hypothesis of the form `l = r`. It matches `r`
against `l` and replaces all occurrences of the variables occurring in `r` with
the corresponding terms in `l` everywhere in the goal. -/

lemma injection_example {α : Type} (x y : α) (xs ys : list α)
    (h : list.cons x xs = list.cons y ys) :
  x = y ∧ xs = ys :=
begin
  cases' h,
  cc
end

/-! If `r` fails to match `l`, no subgoals emerge; the proof is complete. -/

lemma distinctness_example {α : Type} (y : α) (ys : list α)
    (h : [] = y :: ys) :
  false :=
by cases' h

def map {α β : Type} (f : α → β) : list α → list β
| []        := []
| (x :: xs) := f x :: map xs

def map₂ {α β : Type} : (α → β) → list α → list β
| _ []        := []
| f (x :: xs) := f x :: map₂ f xs

#check list.map

lemma map_ident {α : Type} (xs : list α) :
  map (λx, x) xs = xs :=
begin
  induction' xs,
  case nil {
    refl },
  case cons : y ys {
    simp [map, ih] }
end

lemma map_comp {α β γ : Type} (f : α → β) (g : β → γ)
    (xs : list α) :
  map g (map f xs) = map (λx, g (f x)) xs :=
begin
  induction' xs,
  case nil {
    refl },
  case cons : y ys {
    simp [map, ih] }
end

lemma map_append {α β : Type} (f : α → β) (xs ys : list α) :
  map f (xs ++ ys) = map f xs ++ map f ys :=
begin
  induction' xs,
  case nil {
    refl },
  case cons : y ys {
    simp [map, ih] }
end

def tail {α : Type} : list α → list α
| []        := []
| (_ :: xs) := xs

#check list.tail

def head_opt {α : Type} : list α → option α
| []       := option.none
| (x :: _) := option.some x

def head_pre {α : Type} : ∀xs : list α, xs ≠ [] → α
| []       hxs := by cc
| (x :: _) _   := x

#eval head_opt [3, 1, 4]
#eval head_pre [3, 1, 4] (by simp)
-- fails
#eval head_pre ([] : list ℕ) sorry

def zip {α β : Type} : list α → list β → list (α × β)
| (x :: xs) (y :: ys) := (x, y) :: zip xs ys
| []        _         := []
| (_ :: _)  []        := []

#check list.zip

def length {α : Type} : list α → ℕ
| []        := 0
| (x :: xs) := length xs + 1

#check list.length

/-! `cases'` can also be used to perform a case distinction on a proposition, in
conjunction with `classical.em`. Two cases emerge: one in which the proposition
is true and one in which it is false. -/

#check classical.em

lemma min_add_add (l m n : ℕ) :
  min (m + l) (n + l) = min m n + l :=
begin
  cases' classical.em (m ≤ n),
  case inl {
    simp [min, h] },
  case inr {
    simp [min, h] }
end

lemma min_add_add₂ (l m n : ℕ) :
  min (m + l) (n + l) = min m n + l :=
match classical.em (m ≤ n) with
| or.inl h := by simp [min, h]
| or.inr h := by simp [min, h]
end

lemma min_add_add₃ (l m n : ℕ) :
  min (m + l) (n + l) = min m n + l :=
if h : m ≤ n then
  by simp [min, h]
else
  by simp [min, h]

lemma length_zip {α β : Type} (xs : list α) (ys : list β) :
  length (zip xs ys) = min (length xs) (length ys) :=
begin
  induction' xs,
  case nil {
    refl },
  case cons : x xs' {
    cases' ys,
    case nil {
      refl },
    case cons : y ys' {
      simp [zip, length, ih ys', min_add_add] } }
end

lemma map_zip {α α' β β' : Type} (f : α → α') (g : β → β') :
  ∀xs ys,
    map (λab : α × β, (f (prod.fst ab), g (prod.snd ab)))
      (zip xs ys) =
    zip (map f xs) (map g ys)
| (x :: xs) (y :: ys) := by simp [zip, map, map_zip xs ys]
| []        _         := by refl
| (_ :: _)  []        := by refl

/-! ## Binary Trees

Inductive types with constructors taking several recursive arguments define
tree-like objects. __Binary trees__ have nodes with at most two children. -/

inductive btree (α : Type) : Type
| empty {} : btree
| node     : α → btree → btree → btree

/-! The type `aexp` of arithmetic expressions was also an example of a tree data
structure.

The nodes of a tree, whether inner nodes or leaf nodes, often carry labels or
other annotations.

Inductive trees contain no infinite branches, not even cycles. This is less
expressive than pointer- or reference-based data structures (in imperative
languages) but easier to reason about.

Recursive definitions (and proofs by induction) work roughly as for lists, but
we may need to recurse (or invoke the induction hypothesis) on several child
nodes. -/

def mirror {α : Type} : btree α → btree α
| btree.empty        := btree.empty
| (btree.node a l r) := btree.node a (mirror r) (mirror l)

lemma mirror_mirror {α : Type} (t : btree α) :
  mirror (mirror t) = t :=
begin
  induction' t,
  case empty {
    refl },
  case node : a l r ih_l ih_r {
    simp [mirror, ih_l, ih_r] }
end

lemma mirror_mirror₂ {α : Type} :
  ∀t : btree α, mirror (mirror t) = t
| btree.empty        := by refl
| (btree.node a l r) :=
  calc  mirror (mirror (btree.node a l r))
      = mirror (btree.node a (mirror r) (mirror l)) :
    by refl
  ... = btree.node a (mirror (mirror l)) (mirror (mirror r)) :
    by refl
  ... = btree.node a l (mirror (mirror r)) :
    by rw mirror_mirror₂ l
  ... = btree.node a l r :
    by rw mirror_mirror₂ r

lemma mirror_eq_empty_iff {α : Type} :
  ∀t : btree α, mirror t = btree.empty ↔ t = btree.empty
| btree.empty        := by refl
| (btree.node _ _ _) := by simp [mirror]

/-! ## Dependent Inductive Types (**optional**) -/

#check vector

inductive vec (α : Type) : ℕ → Type
| nil {}                           : vec 0
| cons (a : α) {n : ℕ} (v : vec n) : vec (n + 1)

#check vec.nil
#check vec.cons

def list_of_vec {α : Type} : ∀{n : ℕ}, vec α n → list α
| _ vec.nil        := []
| _ (vec.cons a v) := a :: list_of_vec v

def vec_of_list {α : Type} :
  ∀xs : list α, vec α (list.length xs)
| []        := vec.nil
| (x :: xs) := vec.cons x (vec_of_list xs)

lemma length_list_of_vec {α : Type} :
  ∀{n : ℕ} (v : vec α n), list.length (list_of_vec v) = n
| _ vec.nil        := by refl
| _ (vec.cons a v) :=
  by simp [list_of_vec, length_list_of_vec v]

end LoVe


/-
Copyright (c) 2016 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro
Ported by: Scott Morrison

! This file was ported from Lean 3 source module algebra.order.ring.canonical
! leanprover-community/mathlib commit 824f9ae93a4f5174d2ea948e2d75843dd83447bb
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Order.Ring.Defs
import Mathlib.Algebra.Order.Sub.Canonical
import Mathlib.GroupTheory.GroupAction.Defs

/-!
# Canoncially ordered rings and semirings.

* `CanonicallyOrderedCommSemiring`
  - `CanonicallyOrderedAddMonoid` & multiplication & `*` respects `≤` & no zero divisors
  - `CommSemiring` & `a ≤ b ↔ ∃ c, b = a + c` & no zero divisors

## TODO

We're still missing some typeclasses, like
* `CanonicallyOrderedSemiring`
They have yet to come up in practice.
-/

open Function

universe u

variable {α : Type u} {β : Type _}

/-- A canonically ordered commutative semiring is an ordered, commutative semiring in which `a ≤ b`
iff there exists `c` with `b = a + c`. This is satisfied by the natural numbers, for example, but
not the integers or other ordered groups. -/
class CanonicallyOrderedCommSemiring (α : Type _) extends CanonicallyOrderedAddMonoid α,
    CommSemiring α where
  /-- No zero divisors. -/
  protected eq_zero_or_eq_zero_of_mul_eq_zero : ∀ {a b : α}, a * b = 0 → a = 0 ∨ b = 0
#align canonically_ordered_comm_semiring CanonicallyOrderedCommSemiring

section StrictOrderedSemiring

variable [StrictOrderedSemiring α] {a b c d : α}

section ExistsAddOfLE

variable [ExistsAddOfLE α]

/-- Binary **rearrangement inequality**. -/
theorem mul_add_mul_le_mul_add_mul (hab : a ≤ b) (hcd : c ≤ d) : a * d + b * c ≤ a * c + b * d := by
  obtain ⟨b, rfl⟩ := exists_add_of_le hab
  obtain ⟨d, rfl⟩ := exists_add_of_le hcd
  rw [mul_add, add_right_comm, mul_add, ← add_assoc]
  exact add_le_add_left (mul_le_mul_of_nonneg_right hab <| (le_add_iff_nonneg_right _).1 hcd) _
#align mul_add_mul_le_mul_add_mul mul_add_mul_le_mul_add_mul

/-- Binary **rearrangement inequality**. -/
theorem mul_add_mul_le_mul_add_mul' (hba : b ≤ a) (hdc : d ≤ c) :
    a • d + b • c ≤ a • c + b • d := by
  rw [add_comm (a • d), add_comm (a • c)]
  exact mul_add_mul_le_mul_add_mul hba hdc
#align mul_add_mul_le_mul_add_mul' mul_add_mul_le_mul_add_mul'

/-- Binary strict **rearrangement inequality**. -/
theorem mul_add_mul_lt_mul_add_mul (hab : a < b) (hcd : c < d) : a * d + b * c < a * c + b * d := by
  obtain ⟨b, rfl⟩ := exists_add_of_le hab.le
  obtain ⟨d, rfl⟩ := exists_add_of_le hcd.le
  rw [mul_add, add_right_comm, mul_add, ← add_assoc]
  exact add_lt_add_left (mul_lt_mul_of_pos_right hab <| (lt_add_iff_pos_right _).1 hcd) _
#align mul_add_mul_lt_mul_add_mul mul_add_mul_lt_mul_add_mul

/-- Binary **rearrangement inequality**. -/
theorem mul_add_mul_lt_mul_add_mul' (hba : b < a) (hdc : d < c) :
    a • d + b • c < a • c + b • d := by
  rw [add_comm (a • d), add_comm (a • c)]
  exact mul_add_mul_lt_mul_add_mul hba hdc
#align mul_add_mul_lt_mul_add_mul' mul_add_mul_lt_mul_add_mul'

end ExistsAddOfLE

end StrictOrderedSemiring

namespace CanonicallyOrderedCommSemiring

variable [CanonicallyOrderedCommSemiring α] {a b : α}

-- see Note [lower instance priority]
instance (priority := 100) toNoZeroDivisors : NoZeroDivisors α :=
  ⟨CanonicallyOrderedCommSemiring.eq_zero_or_eq_zero_of_mul_eq_zero⟩
#align canonically_ordered_comm_semiring.to_no_zero_divisors CanonicallyOrderedCommSemiring.toNoZeroDivisors

-- see Note [lower instance priority]
instance (priority := 100) toCovariantClassMulLE : CovariantClass α α (· * ·) (· ≤ ·) := by
  refine' ⟨fun a b c h => _⟩
  rcases exists_add_of_le h with ⟨c, rfl⟩
  rw [mul_add]
  apply self_le_add_right
#align canonically_ordered_comm_semiring.to_covariant_mul_le CanonicallyOrderedCommSemiring.toCovariantClassMulLE

-- see Note [lower instance priority]
instance (priority := 100) toOrderedCommMonoid : OrderedCommMonoid α where
  mul_le_mul_left := fun _ _ => mul_le_mul_left'
#align canonically_ordered_comm_semiring.to_ordered_comm_monoid CanonicallyOrderedCommSemiring.toOrderedCommMonoid

-- see Note [lower instance priority]
instance (priority := 100) toOrderedCommSemiring : OrderedCommSemiring α :=
  { ‹CanonicallyOrderedCommSemiring α› with
    zero_le_one := zero_le _,
    mul_le_mul_of_nonneg_left := fun a b c h _ => mul_le_mul_left' h _,
    mul_le_mul_of_nonneg_right := fun a b c h _ => mul_le_mul_right' h _ }
#align canonically_ordered_comm_semiring.to_ordered_comm_semiring CanonicallyOrderedCommSemiring.toOrderedCommSemiring

@[simp]
theorem mul_pos : 0 < a * b ↔ 0 < a ∧ 0 < b := by
  simp only [pos_iff_ne_zero, ne_eq, mul_eq_zero, not_or]
#align canonically_ordered_comm_semiring.mul_pos CanonicallyOrderedCommSemiring.mul_pos

end CanonicallyOrderedCommSemiring

section Sub

variable [CanonicallyOrderedCommSemiring α] {a b c : α}

variable [Sub α] [OrderedSub α]

variable [IsTotal α (· ≤ ·)]

namespace AddLECancellable

protected theorem mul_tsub (h : AddLECancellable (a * c)) : a * (b - c) = a * b - a * c := by
  cases' total_of (· ≤ ·) b c with hbc hcb
  · rw [tsub_eq_zero_iff_le.2 hbc, mul_zero, tsub_eq_zero_iff_le.2 (mul_le_mul_left' hbc a)]
  · apply h.eq_tsub_of_add_eq
    rw [← mul_add, tsub_add_cancel_of_le hcb]
#align add_le_cancellable.mul_tsub AddLECancellable.mul_tsub

protected theorem tsub_mul (h : AddLECancellable (b * c)) : (a - b) * c = a * c - b * c := by
  simp only [mul_comm _ c] at *
  exact h.mul_tsub
#align add_le_cancellable.tsub_mul AddLECancellable.tsub_mul

end AddLECancellable

variable [ContravariantClass α α (· + ·) (· ≤ ·)]

theorem mul_tsub (a b c : α) : a * (b - c) = a * b - a * c :=
  Contravariant.AddLECancellable.mul_tsub
#align mul_tsub mul_tsub

theorem tsub_mul (a b c : α) : (a - b) * c = a * c - b * c :=
  Contravariant.AddLECancellable.tsub_mul
#align tsub_mul tsub_mul

end Sub


import MyNat.Addition -- imports addition.
namespace MyNat
open MyNat
/-!
# Addition world

## Level 2: `add_assoc` -- associativity of addition.

It's well-known that (1 + 2) + 3 = 1 + (2 + 3) -- if you have three numbers
to add up, it doesn't matter which of the additions you do first. This fact
is called *associativity of addition* by mathematicians, and it is *not*
obvious. For example, subtraction really is not associative: `(6 - 2) - 1`
is really not equal to `6 - (2 - 1)`. We are going to have to prove
that addition, as defined the way we've defined it, is associative.

To prove associativity of addition it is handy to recall that addition was defined
by recursion on the right-most variable. This means you can use induction on the right-most
variable (try other variables at your peril!). Note that when Lean writes `a + b + c`,
it means `(a + b) + c`. If it wants to talk about `a + (b + c)` it will put the brackets
in explicitly.

Reminder: you are done when you see "Goals accomplished 🎉" in the InfoView, and no
errors in the VS Code Problems list.

**Lemma**

On the set of natural numbers, addition is associative.
In other words, for all natural numbers `a, b` and `c`, we have
` (a + b) + c = a + (b + c). `
-/

lemma add_assoc (a b c : MyNat) : (a + b) + c = a + (b + c) := by
  induction c with
  | zero =>
    -- ⊢ a + b + 0 = a + (b + 0)
    rw [zero_is_0]
    rw [add_zero]
    rw [add_zero]
  | succ c ih =>
    -- ⊢ (a + b) + succ d = a + (b + succ d)
    rw [add_succ]
    rw [add_succ]
    rw [add_succ]
    rw [ih]

/-!
On to [Level 3](./Level3.lean.md).
-/


import mynat.definition
import mynat.mul
import world3.level4

namespace mynat

lemma mul_assoc (a b c : mynat) : (a * b) * c = a * (b * c) :=
begin [nat_num_game]
    induction c with d hd,
    {
        repeat {rw mul_zero},
    },
    {
        rw mul_succ,
        rw mul_succ,
        rw mul_add,
        rw ← hd,
        refl,
    },
end

end mynat


/-
Copyright (c) 2021 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson
-/
import analysis.p_series
import number_theory.arithmetic_function
import topology.algebra.infinite_sum

/-!
# L-series

Given an arithmetic function, we define the corresponding L-series.

## Main Definitions
 * `nat.arithmetic_function.l_series` is the `l_series` with a given arithmetic function as its
  coefficients. This is not the analytic continuation, just the infinite series.
 * `nat.arithmetic_function.l_series_summable` indicates that the `l_series`
  converges at a given point.

## Main Results
 * `nat.arithmetic_function.l_series_summable_of_bounded_of_one_lt_re`: the `l_series` of a bounded
  arithmetic function converges when `1 < z.re`.
 * `nat.arithmetic_function.zeta_l_series_summable_iff_one_lt_re`: the `l_series` of `ζ`
  (whose analytic continuation is the Riemann ζ) converges iff `1 < z.re`.

-/

noncomputable theory
open_locale big_operators

namespace nat
namespace arithmetic_function

/-- The L-series of an `arithmetic_function`. -/
def l_series (f : arithmetic_function ℂ) (z : ℂ) : ℂ := ∑'n, (f n) / (n ^ z)

/-- `f.l_series_summable z` indicates that the L-series of `f` converges at `z`. -/
def l_series_summable (f : arithmetic_function ℂ) (z : ℂ) : Prop := summable (λ n, (f n) / (n ^ z))

lemma l_series_eq_zero_of_not_l_series_summable (f : arithmetic_function ℂ) (z : ℂ) :
  ¬ f.l_series_summable z → f.l_series z = 0 :=
tsum_eq_zero_of_not_summable

@[simp]
lemma l_series_summable_zero {z : ℂ} : l_series_summable 0 z :=
by simp [l_series_summable, summable_zero]

theorem l_series_summable_of_bounded_of_one_lt_real {f : arithmetic_function ℂ} {m : ℝ}
  (h : ∀ (n : ℕ), complex.abs (f n) ≤ m) {z : ℝ} (hz : 1 < z) :
  f.l_series_summable z :=
begin
  by_cases h0 : m = 0,
  { subst h0,
    have hf : f = 0 := arithmetic_function.ext (λ n, complex.abs_eq_zero.1
        (le_antisymm (h n) (complex.abs_nonneg _))),
    simp [hf] },
  refine summable_of_norm_bounded (λ (n : ℕ), m / (n ^ z)) _ _,
  { simp_rw [div_eq_mul_inv],
    exact (summable_mul_left_iff h0).1 (real.summable_nat_rpow_inv.2 hz) },
  { intro n,
    have hm : 0 ≤ m := le_trans (complex.abs_nonneg _) (h 0),
    cases n,
    { simp [hm, real.zero_rpow (ne_of_gt (lt_trans real.zero_lt_one hz))] },
    simp only [complex.abs_div, complex.norm_eq_abs],
    apply div_le_div hm (h _) (real.rpow_pos_of_pos (nat.cast_pos.2 n.succ_pos) _) (le_of_eq _),
    rw [complex.abs_cpow_real, complex.abs_cast_nat] }
end

theorem l_series_summable_of_bounded_of_one_lt_re {f : arithmetic_function ℂ} {m : ℝ}
  (h : ∀ (n : ℕ), complex.abs (f n) ≤ m) {z : ℂ} (hz : 1 < z.re) :
  f.l_series_summable z :=
begin
  rw ← l_series_summable_iff_of_re_eq_re (complex.of_real_re z.re),
  apply l_series_summable_of_bounded_of_one_lt_real h,
  exact hz,
end

open_locale arithmetic_function

theorem zeta_l_series_summable_iff_one_lt_re {z : ℂ} :
  l_series_summable ζ z ↔ 1 < z.re :=
begin
  rw [← l_series_summable_iff_of_re_eq_re (complex.of_real_re z.re), l_series_summable,
    ← summable_norm_iff, ← real.summable_one_div_nat_rpow, iff_iff_eq],
  by_cases h0 : z.re = 0,
  { rw [h0, ← summable_nat_add_iff 1],
    swap, { apply_instance },
    apply congr rfl,
    ext n,
    simp [n.succ_ne_zero] },
  { apply congr rfl,
    ext n,
    cases n, { simp [h0] },
    simp only [n.succ_ne_zero, one_div, cast_one, nat_coe_apply, complex.abs_cpow_real, inv_inj₀,
      complex.abs_inv, if_false, zeta_apply, complex.norm_eq_abs, complex.abs_of_nat] }
end

@[simp] theorem l_series_add {f g : arithmetic_function ℂ} {z : ℂ}
  (hf : f.l_series_summable z) (hg : g.l_series_summable z) :
  (f + g).l_series z = f.l_series z + g.l_series z :=
begin
  simp only [l_series, add_apply],
  rw ← tsum_add hf hg,
  apply congr rfl (funext (λ n, _)),
  apply _root_.add_div,
end

end arithmetic_function
end nat


import Mathlib
import PnP2023.Lec_02_03.InductiveTypes

/-!
Vectors, i.e., lists of a fixed length, can be defined in (at least) two ways. One way is as an indexed inductive type `Vec`, as we saw in lecture and is in the file `InductiveTypes.lean`.

A different definition is as a subtype `Vector` of lists consisting of those of a fixed length. This is the definition used in `mathlib` and is recalled below.

```lean
/-- `Vector α n` is the type of lists of length `n` with elements of type `α`. -/
def Vector (α : Type u) (n : ℕ) :=
  { l : List α // l.length = n }
```

In this lab, you will relate the two definitions by constructing functions that convert between the two definitions and prove that these functions are inverses of each other.
-/
universe u

/-- Convert a `Vector` to a `Vec` -/
def Vec.ofVector {α : Type u}: (n : ℕ) →  Vector α n → Vec α n
| 0, _ => Vec.nil
| k + 1, Vector.cons head tail => by

/-- Convert a `Vec` to a `Vector`
def Vec.toVector {α : Type u}: (n : ℕ) →  Vec α n → Vector α n
| _, _ => sorry --/

def vector1 : Vector ℕ 1 := ⟨ [2] , rfl ⟩
def vector0 : Vector ℕ 0 := ⟨ [], rfl ⟩

#eval vector1

/-- Convert a `Vec` to a `Vector` -/
def Vec.toVector {α : Type u}: (n : ℕ) →  Vec α n → Vector α n
| 0, _ => ⟨ [], rfl ⟩
| k + 1, Vec.cons head tail => by
  let vectorTail : Vector α k := Vec.toVector k tail
  let ⟨a, b⟩ := vectorTail
  have lem5 : (head :: a).length = k + 1 := by
    simp [List.length, b]
  let vec3 : Vector α (k+1) := ⟨head :: a, lem5⟩
  assumption

/--  Vec.to_list {α : Type u} {n : ℕ} : Vec α n → List α
| Vec.nil => []
| Vec.cons head tail => head :: tail.to_list
-/

-- Mapping a `Vec` to a `Vector` and back gives the original `Vec` -/
theorem Vec.ofVector.toVector {α : Type u} (n : ℕ) (v : Vec α n) :
  Vec.ofVector n (Vec.toVector n v) = v := sorry

/-- Mapping a `Vector` to a `Vec` and back gives the original `Vector` -/
theorem Vec.toVector.ofVector {α : Type u} (n : ℕ) (v : Vector α n) :
  Vec.toVector n (Vec.ofVector n v) = v := sorry


import mynat.definition -- hide
import mynat.add -- hide
import game.world8.level8 -- hide
namespace mynat -- hide

/- Axiom : zero_ne_succ (a : mynat) :
0 ≠ succ(a)
-/

/- Tactic : symmetry

## Summary

`symmetry` turns goals of the form `⊢ A = B` to `⊢ B = A`.
Also works with `≠`. Also works on hypotheses: if `h : a ≠ b`
then `symmetry at h` gives `h : b ≠ a`.

## Details

`symmetry` works on both goals and hypotheses. By default it
works on the goal. It will turn a goal of the form `⊢ A = B`
to `⊢ B = A`. More generally it will work with any symmetric
binary relation (for example `≠`, or more generally any
binary relation whose proof of symmetry has been tagged
with the `symm` attribute).

To get `symmetry` working on a hypothesis, use `symmetry at h`.

## Examples

If the tactic state is
```
h : a = b
⊢ c ≠ d
```

then `symmetry` changes the goal to `⊢ d ≠ c` and
`symmetry at h` changes `h` to `h : b = a`.
-/

/-

# Advanced Addition World

## Level 9: `succ_ne_zero`

Levels 9 to 13 introduce the last axiom of Peano, namely
that $0\not=\operatorname{succ}(a)$. The proof of this is called `zero_ne_succ a`.

`zero_ne_succ (a : mynat) : 0 ≠ succ(a)`

The `symmetry` tactic will turn any goal of the form `R x y` into `R y x`,
if `R` is a symmetric binary relation (for example `=` or `≠`).
In particular, you can prove `succ_ne_zero` below by first using
`symmetry` and then `exact zero_ne_succ a`.
-/

/- Theorem
Zero is not the successor of any natural number.
-/
theorem succ_ne_zero (a : mynat) : succ a ≠ 0 :=
begin [nat_num_game]
  symmetry,
  exact zero_ne_succ a,

end

end mynat


/-
Copyright (c) 2018 Luca Gerolla. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Luca Gerolla, Kevin Buzzard
Prove basic results of real continuous functions and closed intervals
-/
import analysis.topology.continuity
import analysis.topology.topological_space
import analysis.topology.infinite_sum
import analysis.topology.topological_structures
import analysis.topology.uniform_space
import analysis.real
import data.real.basic tactic.norm_num
import data.set.basic

universe u

open set filter lattice classical

noncomputable theory

-- Useful continuity results for functions ℝ → ℝ

theorem real.continuous_add_const (r : ℝ) : continuous (λ x : ℝ, x + r) :=
begin
  have H₁ : continuous (λ x, (x,r) : ℝ → ℝ × ℝ),
    exact continuous.prod_mk continuous_id continuous_const,
  exact continuous.comp H₁ continuous_add',
end

theorem real.continuous_sub_const (r : ℝ) : continuous (λ x : ℝ, x - r) :=
continuous_sub continuous_id continuous_const

theorem real.continuous_mul_const (r : ℝ) : continuous (λ x : ℝ, r*x) :=
begin
  have H₁ : continuous (λ x, (r,x) : ℝ → ℝ × ℝ),
    exact continuous.prod_mk continuous_const continuous_id,
  show continuous ( (λ p : ℝ × ℝ , p.1 * p.2)  ∘  (λ (x : ℝ), (r,x))),
  refine continuous.comp H₁  continuous_mul' ,
end

theorem real.continuous_mul_const_right (r : ℝ) : continuous (λ x : ℝ, x*r) :=
begin
  have H₁ : continuous (λ x, (x,r) : ℝ → ℝ × ℝ),
    exact continuous.prod_mk continuous_id continuous_const,
  refine continuous.comp H₁ continuous_mul' ,
end

theorem real.continuous_div_const (r : ℝ) : continuous (λ x : ℝ, x / r) :=
begin
  conv in (_ / r) begin
    rw div_eq_mul_inv,
  end,
  have H₁ : continuous (λ x, (x,r⁻¹) : ℝ → ℝ × ℝ),
    exact continuous.prod_mk continuous_id continuous_const,
  exact continuous.comp H₁ continuous_mul',
end

theorem real.continuous_scale (a b : ℝ) : continuous (λ x : ℝ, (x + a) / b) :=
  continuous.comp (real.continuous_add_const a) (real.continuous_div_const b)

theorem real.continuous_linear (m q : ℝ) : continuous (λ x : ℝ, m * x + q) :=
  continuous.comp (real.continuous_mul_const m) (real.continuous_add_const q)

--- Definition of closed intervals in ℝ

def int_clos { r s : ℝ } ( Hrs : r < s ) : set ℝ := {x : ℝ  | r ≤ x ∧ x ≤ s}

theorem is_closed_int_clos { r s : ℝ } ( Hrs : r < s ) : is_closed (int_clos Hrs) :=
  is_closed_inter (is_closed_ge' r) (is_closed_le' s)


def is_even (x: ℕ) : bool := x % 2 = 0
def positive (n: ℕ) : bool := n > 0
def uint32 (n: ℕ) : bool := n >= 0 ∧ n < 2^32

def positive' : ℕ → bool := λ n, n > 0
#check positive'
#check λ n : ℕ, n > 0
#reduce is_even 1
#reduce positive 0

theorem ttt {a b : ℕ}: a=b→ b=a := λ f, eq.symm f


/-
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
import Std.Tactic.Basic -- imports by_contra
import Mathlib.Tactic.Basic -- imports change, by_cases

/-!

# Logic in Lean, example sheet 3 : "not" (`¬`)

We learn about how to manipulate `¬ P` in Lean.

# Important : the definition of `¬ P`

In Lean, `¬ P` is *defined* to mean `P → False`. So `¬ P` and `P → False`
are *definitionally equal*. Check out the explanation of definitional
equality in the "equality" section of Part B of the course notes.

## Tactics

You'll need to know about the tactics from the previous sheets,
and the following tactics may also be useful:

* `change`
* `by_contra`
* `by_cases`

-/

-- Throughout this sheet, `P`, `Q` and `R` will denote propositions.

variable (P Q R : Prop)

example : ¬ True → False := by
  sorry

example : False → ¬ True := by
  sorry

example : ¬ False → True := by
  sorry

example : True → ¬ False := by
  sorry

example : False → ¬ P := by
  sorry

example : P → ¬ P → False := by
  sorry

example : P → ¬ (¬ P) := by
  sorry

example : (P → Q) → (¬ Q → ¬ P) := by
  sorry

example : ¬ ¬ False → False := by
  sorry

example : ¬ ¬ P → P := by
  sorry

example : (¬ Q → ¬ P) → (P → Q) := by
  sorry


-- based on Lean Tutorial / 05_sequence_limits.lean
import resources

/-
Useful lemmata:

`le_max_left  p q` says `p ≤ max p q`
`le_max_right p q` says `q ≤ max p q`

`eq_of_abs_sub_le_all_pos x y` says `(∀ ε > 0, |x - y| ≤ ε) → x = y`
-/

-- This is the definition of limit we will work with in all exercises here.
def seq_limit (s : ℕ → ℝ) (a : ℝ) : Prop :=
∀ ε : ℝ, ε > 0 → ∃ n₀ : ℕ, ∀ n : ℕ, n ≥ n₀ → |s n - a| ≤ ε

-- Arithmetic of limits ... the sum law:
-- If [`u` approaches `a`] and [`v` approaches `b`],
-- then [`u + v` approaches `a + b`].
example (u v : ℕ → ℝ) (a b : ℝ) (hu : seq_limit u a) (hv : seq_limit v b) :
  seq_limit (u + v) (a + b) :=
begin
  sorry,
end

-- Squeeze theorem (a.k.a. "Sandwich rule" or "Two policemen and a drunk"):
-- If [`u` approaches `z`] and [`v` approaches `z`],
-- then [`w` such that `u ≤ w ≤ v` approaches `z` as well].
example (u v w : ℕ → ℝ) (z : ℝ) (hu : seq_limit u z) (hv : seq_limit v z)
        (below : ∀ n, u n ≤ w n) (above : ∀ n, w n ≤ v n) :
  seq_limit w z :=
begin
  sorry,
end

-- A sequence admits at most one limit.
example (w : ℕ → ℝ) (a b : ℝ) (ha : seq_limit w a) (hb : seq_limit w b) :
  a = b :=
begin
  sorry,
end


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

import section14polynomials.sheet02noetherian

/-!

# An auxiliary construction

I haven't talked about which proof of the Hilbert Basis Theorem we'll
be formalising, so let me say a bit about this here. The theorem
states that if `R` is a Noetherian (commutative) ring then so is
the polynomial ring `R[X]`. So, given an ideal `I` of `R[X]` we need
to come up with a finite set of generators, and the only tool we have
is that any ideal of `R` has a finite set of generators. So, however
this proof goes, we are going to probably be wanting to construct
ideals of `R` given an ideal of `R[X]`.

The `aux_ideal` construction is of this nature. An ideal of `R[X]`
is by definition an `R[X]`-submodule of `R[X]` so it's also
an `R`-submodule of `R[X]` (this is a bit like saying that a complex
vector space is obviously also a real vector space). The `lcoeff`
maps, taking a polynomial to its coefficient of `X^n`,  are `R`-linear
maps from `R[X]` to `R`, so we can push `R`-submodules of `R[X]` along
these maps (i.e. look at their images) to get `R`-submodules of `R`,
which is the same thing as ideals of `R`. The submodules we will push
forward are the following: given an ideal `I` of `R[X]`, and a natural
number `n`, we will consider `I` as an `R`-submodule of `R[X]`, we will
intersect it with `M R n` (the `R`-submodule of polynomials of degree
at most `n`), and we will then look at its image under `lcoeff R n`.
By definition then, the elements of `aux_ideal I n` will be the
coeficients of `X^n` of the polynomials in `I` which have degree
at most `n`, and this abstract way of describing this set shows that
it is an ideal of `R`.

Again, more briefly: if `I` is an ideal of `R[X]` and `n` is a natural,
then `aux_ideal I n` is the ideal of `R` consisting of the coefficients
of `X^n` of the elements of `I` with `nat_degree` at most `n`.

The first result we are aiming for in this file is that
`aux_ideal I n` is monotone as a function of `n`, that is, if `n ≤ m`
then `aux_ideal I n ≤ aux_ideal I m`.

-/

variables {R : Type} [comm_ring R] (I : ideal (polynomial R))

open polynomial

/-

`I.restrict_scalars R` means the ideal `I`, regarded as an `R`-submodule
of `R[X]`. The `⊓` is just intersection of submodules. The `map`
is `submodule.map` which is the function which eats a linear map
(in this case `lcoeff R n`) and outputs a function sending submodules
of the domain of the map to submodules of the codomain; the function
itself is just "image of the submodule under the linear map".

-/

/-- If `I` is an ideal of `polynomial R` then `aux_ideal I n` is the ideal of `R`
obtained by pushing forward `I ∩ {polynomials of degree ≤ n}` along the linear map `lcoeff n`
sending a polynomial to its coefficient of `X^n`.

One can imagine `aux_ideal I n` as the ideal consisting of `0` and the coefficient of `X^n`
in all of the degree `n` polynomials in `I`, but this case split definition is harder
to work with in practice. -/
noncomputable def aux_ideal (n : ℕ) :=
(I.restrict_scalars R ⊓ M R n).map (lcoeff R n)

namespace aux_ideal

/-

We're going to prove that `aux_ideal I n` is monotone for fixed `I`, i.e. it gets
bigger as `n` gets bigger.

Make sure you know a maths proof before embarking on this.

Useful API:

`I.mul_mem_right r : p ∈ I → p * r ∈ I`
`polynomial.nat_degree_mul_le : (p * q).nat_degree ≤ p.nat_degree + q.nat_degree`
`p.coeff_mul_X : (n : ℕ), (p * X).coeff (n + 1) = p.coeff n`

and note that `lcoeff R n f` is definitionally `f.coeff n`.

-/

lemma mono_aux (n : ℕ) :
  aux_ideal I n ≤ aux_ideal I (n + 1) :=
begin
  sorry,
end

-- this is now a one-liner
lemma mono : monotone (aux_ideal I) :=
begin
  sorry
end

/- Given an ideal `I` and a natural number `n`, we have been
considering the map from `I ∩ {degree ≤ n}` to `R` defined by
"take coefficient of `X^n`". The `lift` function below is
a one-sided inverse to this map. Given an element of `R`,
if it's in the image then we send it to a random preimage
in `I ∩ (degree ≤ n)` and if it's not then we just send it to 0.
Note the use of `exists.some`; the statement "I am in the image"
is definitionally equal to "there exists something in the domain
which maps to me", and `exists.some` chooses a random thing in the
image with this property.

-/

noncomputable def lift (n : ℕ) (r : R) [decidable (r ∈ aux_ideal I n)] : polynomial R :=
if hr : r ∈ aux_ideal I n then (submodule.mem_map.1 hr).some else 0

variables {n : ℕ} {r : R} [decidable (r ∈ aux_ideal I n)]

lemma lift_def (n : ℕ) (r : R) [decidable (r ∈ aux_ideal I n)] :
lift I n r = if hr : r ∈ aux_ideal I n then (submodule.mem_map.1 hr).some else 0 :=
begin
  sorry,
end

variable {I}

-- you can use `dif_neg` to prove this lemma.
lemma lift_eq_zero_of_ne (hr : ¬ r ∈ aux_ideal I n) : lift I n r = 0 :=
begin
  sorry,
end

-- you need to do a case split for this one. The definition of `lift`
-- used ` (submodule.mem_map.1 hr).some` so this proof will need
-- ` (submodule.mem_map.1 hr).some_spec` somewhere. Note also `dif_pos` :-)
lemma lift_mem :
  (lift I n r) ∈ submodule.restrict_scalars R I ⊓ M R n :=
begin
  sorry,
end

-- this is a one-liner
lemma lift_mem_I : lift I n r ∈ I :=
begin
  sorry,
end

-- this is a one-liner too (thanks to definitional equality abuse)
lemma lift_nat_degree_le :
  (lift I n r).nat_degree ≤ n :=
begin
  sorry,
end

lemma lift_spec (hr : r ∈ aux_ideal I n) :
  lcoeff R n (lift I n r) = r :=
begin
  sorry,
end

end aux_ideal


/-

In lean we represent: (1) propositions as

types and (2) predicates as parameterized

propositions.

A parameterized type gives rise to a whole

family of proposition, once for each value

of each parameter.

We can think of one-parameter predicates

as specifying *properties* of objects. As

an example, as defined, is_even : ℕ → Prop

expresses the property of a natural number

(an argument value) "being even". We define

the constructors to ensure that there is a

proof of (is_even n) if and only if (n : ℕ)

is (a term that represents) an even number.

One-parameter predicates thus also specify

*sets* of objects: namely all and only those

values of a given argument type that have the

specified property as shown by the existence

of a proof that such a value "satisfies the

predicate" (makes the resulting proposition

true).

The is_even predicate thus specifies the

set of all even natural numbers, which we

can write as {0, 2, 4, 6, ...} or, better,

as { n : ℕ | is_even n }.

We can think of two-parameter predicates as

specifying binary relations, that is, sets of

*pairs* of argument values that make a given

proposition true.

The most commonplace example of a two-argument

predicate is equals. We can write (_ = _) to

make it clear that equals takes two values and

yields a proposition that the first equals the

second. For example, if a and b are of type ℕ,

then (a = b) is a proposition that has a proof

if and only if the two terms really are equal

(when reduced). So, for example, 4 = 2 + 2 is

true, there is a proof of it, because reducing

2 + 2 to 4 reduces the whole proposition to

4 = 4, and there is a proof of this proposition.

The proposition, a = b, in Lean is just a nice

shorthand notation for (eq a b). The two-place

predicate, eq, implements the equality relation.

It's polymorphic: it takes a *type parameter*, α,

implicitly. It then explicitly takes two values,

a and b, of type α, and yields the proposition,

a = b (which is of course itself a type).

The eq "type builder" (taking α and two values,

a and b of type α) and yielding the proposition

(a type), a = b, provides a single constructor

with which to build proofs. It's called refl,

and it establishes the "reflexive" property of

the eq relation, by taking *any* value, a : α,

for any type, α, and by returning a proof of

(eq a a), that is, of a = a. So, by applying

eq.refl to any value, a, of any type, we get

a proof of (a = a), and those are the *only*

proofs of equality that can be constructed.

There's thus no way to prove that 0 = 1, for

example, because those terms don't reduce to

the same values, and we can only use eq.refl

to construct proofs that two terms are equal

if they really do reduce to exactly the same

value.

Finally, we will represent some, but no all,

of the logical connetives, including "and",

"or", and "iff", as polymorphic propositions.

Whereas a predicate, such as eq, will take

values of arbitrary types as arguments (e.g.,

eq can take values of type ℕ), connectives

are like polymorphic types: they take types

as arguments, but in this case the types are

of type Prop.

Consider "and" for example. If P and Q are

any two pre-existing propositions (types of

type Prop), then we can form the proposition,

P ∧ Q, and it, too, will be a proposition (a

type of type, Prop). The type of "and" is thus

Prop → Prop → Prop: it takes two propositions

(types of type Prop) as arguments and yields

a new proposition (a new type of type Prop).

To enforce the logical meaning of "and", we

define the "and" type builder to have just

one constructor, which we call "intro", that

if applied to a proof, p, of P and to a proof,

q, of Q yields a term, (and.intro p q), that

is axiomatically accepted as being a "proof"

of (and P Q), which we write using an infix

notation as (P ∧ Q).

Finally, we note that if we're given a term,

(and.intro p q), of type (P ∧ Q), that is, if

we're given a proof of (P ∧ Q), we can get a

proof of P from it, by "destructuring" the

term using pattern matching. For example, we

can obtain "p" (the proof of P "contained

inside" the proof of P ∧ Q) with the following

rule: | (and.intro p _) := p. This is how we

implement the two "elimination rules" for and.

-/

/-

Here's a statement of the proposition that

2 + 2 = 4 and a proof of it.

-/

lemma proof_of_two_plus_two_eq_four : 2 + 2 = 4 :=

    eq.refl 4

/-

1. State and prove the proposition that the

string,"Lean!", appended to the string, "Hello, "

is equal to the string, "Hello, Lean!". You may

and should use the Lean library-provided string

append operator, ++, as an infix notation for

append.

-/

-- string append example

#eval "Hi " ++ "There!"

-- fill in the blanks

lemma proof1 : (("Hi "++ "There!") = "Hi There!") := eq.refl "Hi There!"

/-

2.  Sometimes we want to state and prove a

proposition without binding a name to the proof.

For that, instead of using def, theorem, or

lemma, we can use "example." Here's an example.

-/

example : 1 = 1 := eq.refl _    -- Fill blank with proof.

/-

Note that we can use example for ordinary types

as well.

-/

example : ℕ := 5

/-

2. State and prove the proposition that 3 * 4 = 12,

using "example."

-/

-- Answer Here
example : 3*4 = 12 := eq.refl _

/-

3. Use example to formally state and prove the

proposition that 1 = 1 ∧ 0 = 0.

-/

-- Here
example : 1 = 1 ∧ 0 = 0 :=
begin
    apply and.intro,
    apply eq.refl,
    apply eq.refl
end

/-

4. Complete the following program to show that

if P and Q are arbitrary propositions, and *if*

you're given a proof of P and Q, then you can

obtain and return a proof of P.

Hint: In Lean, and.intro is the one introduction

(proof creating) rule for and, and and.elim_left

and and.elim_right are the two elimination rules.

They are functions. Use one of them!

-/

theorem P_and_Q_imp_P {P Q : Prop} (pq : P ∧ Q) : P :=
begin
    apply and.elim_left pq,
end


import subgroup.basic

/-
Let G be a group. The type of subgroups of G is `subgroup G`.
In other words, if `H : subgroup G` then H is a subgroup of G.
The three basic facts you need to know about H are:

H.one_mem : (1 : G) ∈ H
H.mul_mem {x y : G} : x ∈ H → y ∈ H → x * y ∈ H
H.inv_mem {x : G} : x ∈ H → x⁻¹ ∈ H

Subgroups of a group form what is known as a *lattice*.
This is a partially ordered set with a sensible notion of
max and min (and even sup and inf).

We will prove this here.
-/

open_locale classical

namespace mygroup

open group set

variables {G : Type} [group G]
variables {H K : subgroup G}

namespace subgroup

-- The intersect of two subgroups is also a subgroup
def inf (H K : subgroup G) : subgroup G :=
{ carrier := H.carrier ∩ K.carrier,
  one_mem' := ⟨H.one_mem, K.one_mem⟩,
  mul_mem' := λ _ _ ⟨hhx, hkx⟩ ⟨hhy, hky⟩,
  ⟨H.mul_mem hhx hhy, K.mul_mem hkx hky⟩,
  inv_mem' := λ x ⟨hhx, hhy⟩,
  ⟨H.inv_mem hhx, K.inv_mem hhy⟩}

lemma inf_def (H K : subgroup G) : (inf H K : set G) = (H : set G) ∩ K := rfl

/-
We will consider the closure of a set as the intersect of all subgroups
containing the set
-/
instance : has_Inf (subgroup G) :=
⟨λ s, {
  carrier := ⋂ t ∈ s, (t : set G),
  one_mem' := mem_bInter $ λ i h, i.one_mem,
  mul_mem' := λ x y hx hy, mem_bInter $ λ i h,
    i.mul_mem (by apply mem_bInter_iff.1 hx i h)
    (by apply mem_bInter_iff.1 hy i h),
  inv_mem' := λ x hx, mem_bInter $ λ i h,
    i.inv_mem (by apply mem_bInter_iff.1 hx i h) }⟩

variable {ι : Type*}

-- The intersect of a set of subgroups is a subgroup
def infi (H : ι → subgroup G) : subgroup G :=
{ carrier := ⋂ i, H i,
  one_mem' := mem_Inter.mpr $ λ i, (H i).one_mem,
  mul_mem' := λ _ _ hx hy, mem_Inter.mpr $ λ i,
  by {rw mem_Inter at *, from mul_mem (H i) (hx i) (hy i)},
  inv_mem' := λ x hx, mem_Inter.mpr $ λ i, (H i).inv_mem $ by apply mem_Inter.mp hx }

def closure (S : set G) : subgroup G := Inf {H | S ⊆ H}

lemma mem_closure_iff {S : set G} {x : G} :
  x ∈ closure S ↔ ∀ H : subgroup G, S ⊆ H → x ∈ H := mem_bInter_iff

/- We will now prove some lemmas that are helpful in proving subgroups
form a galois_insertion with the coercion to set-/

lemma le_closure (S : set G) : S ≤ closure S :=
λ s hs H ⟨y, hy⟩, by rw ←hy; simp; exact λ hS, hS hs

lemma closure_le (S : set G) (H : subgroup G) : closure S ≤ H ↔ S ≤ H :=
begin
  split,
    { intro h, refine subset.trans (le_closure _) h },
    { intros h y,
      unfold closure, unfold Inf,
      rw mem_bInter_iff, intro hy,
      exact hy H h }
end

lemma closure_le' (S : set G) (H : subgroup G) :
  (closure S : set G) ⊆ H ↔ S ⊆ H := closure_le S H

lemma closure_le'' (S : set G) (H : subgroup G) :
  (∀ x, x ∈ closure S → x ∈ H) ↔ (∀ x, x ∈ S → x ∈ H) := closure_le S H

lemma closure_self {H : subgroup G} : closure (H : set G) = H :=
begin
  rw ←subgroup.ext'_iff, ext,
  split; intro hx,
    { apply subset.trans _ ((closure_le (H : set G) H).2 (subset.refl H)),
      exact hx, exact subset.refl _ },
    { apply subset.trans (le_closure (H : set G)),
      intros g hg, assumption, assumption }
end

lemma closure_induction {p : G → Prop} {x} {k : set G} (h : x ∈ closure k)
  (Hk : ∀ x ∈ k, p x) (H1 : p 1)
  (Hmul : ∀ x y, p x → p y → p (x * y))
  (Hinv : ∀ x, p x → p x⁻¹) : p x :=
(@closure_le _ _ _ ⟨p, H1, Hmul, Hinv⟩).2 Hk h

/-
Now, by considering the coercion between subgroup G → set G, we cheat a bit
by transfering the partial order on set to the partial order on subgroups.

We do this because galois_insertion requires preorders and partial orders
extends preoders.
-/
instance : partial_order (subgroup G) :=
{.. partial_order.lift (coe : subgroup G → set G) (λ x y, subgroup.ext')}

/-
Finially we prove that subgroups form a galois_insertion with the coercion
to set.
-/
def gi : @galois_insertion (set G) (subgroup G) _ _ closure (λ H, H.carrier) :=
{ choice := λ S _, closure S,
  gc := λ H K,
    begin
      split; intro h,
        { exact subset.trans (le_closure H) h },
        { exact (closure_le _ _).2 h },
    end,
  le_l_u := λ H, le_closure (H : set G),
  choice_eq := λ _ _, rfl }

/-
With that it follows that subgroups form a complete lattice!
-/
instance : complete_lattice (subgroup G) :=
{.. galois_insertion.lift_complete_lattice gi}

def trivial : subgroup G :=
  ⟨{(1 : G)}, set.mem_singleton 1,
    λ _ _ hx hy, by rw set.mem_singleton_iff at *; simp [hx, hy],
    λ _ hx, by rw set.mem_singleton_iff at *; rw hx; exact group.one_inv⟩

lemma mem_trivial_iff (g : G) : g ∈ (trivial : subgroup G) ↔ g = 1 := iff.rfl

lemma mem_trivial_carrier_iff (g : G) : g ∈ (trivial : subgroup G).carrier ↔ g = 1 := iff.rfl

lemma bot_eq_trivial : (⊥ : subgroup G) = trivial :=
begin
  apply le_antisymm,
    { change closure (∅ : set G) ≤ _,
      rw closure_le, finish },
    { intros x hx,
      change x ∈ {(1 : G)} at hx,
      rw set.mem_singleton_iff at hx,
      subst hx, unfold_coes, rw mem_coe,
      exact one_mem ⊥ }
end

lemma bot_eq_singleton_one : ((⊥ : subgroup G) : set G) = {1} :=
by rw bot_eq_trivial; refl

lemma mem_bot_iff {x : G} : x ∈ (⊥ : subgroup G) ↔ x = 1 :=
begin
  split; intro h,
    rw [← mem_singleton_iff, ← bot_eq_singleton_one], exact h,
    rw [bot_eq_trivial], exact h
end

lemma fincard_bot : fincard (⊥ : subgroup G) = 1 :=
by rw [← @fincard.card_singleton_eq_one _ (1 : G), ← bot_eq_singleton_one]; refl

lemma eq_top_iff' (H : subgroup G) : H = ⊤ ↔ ∀ g, g ∈ H :=
begin
  split,
  { rintro rfl,
    intro g,
    show g ∈ ((⊤ : subgroup G) : set G),
    rw ←singleton_subset_iff,
    show ({g} : set G) ≤ _,
    rw ←closure_le, simp },
  { intro h,
    rw eq_top_iff,
    intros g hg,
    apply h  }
end

-- scary example!
-- SL₂(ℝ) acts on the upper half plane {z : ℂ | Im(z) > 0}
-- (a b; c d) sends z to (az+b)/(cz+d)
-- check this is an action
-- so SL₂(ℤ) acts on the upper half plane
-- and H, the stabilizer of i ,is cyclic order 4
-- generated by (0 -1; 1 0)
-- and K, the stabilizer of e^{2 pi i/6}, is cyclic order 6
-- generated by something like (1 1; -1 0) maybe
-- Turns out that the smallest subgroup of SL₂(ℤ)
-- containing H and K is all of SL₂(ℤ)!
-- In particular if H and K are finite, but neither of
-- them are normal, then H ⊔ K can be huge

example (H K : subgroup G) : subgroup G := H ⊔ K

-- theorem: if K is normal in G then H ⊔ K is just
-- literally {hk : h ∈ H, k ∈ K}

variables {H K}

open normal

/-- The supremum of two subgroups induced by the Galois insertion is the closure
  of the union of their carriers -/
lemma sup_def : H ⊔ K = closure (H.carrier ⊔ K.carrier) := rfl

/-- The supremum of two subgroups is larger then their union -/
lemma mem_sup_of_mem {x} (hx : x ∈ H ∨ x ∈ K) : x ∈ H ⊔ K :=
begin
  rw sup_def,
  change x ∈ ⋂ (t : subgroup G) (H : H.carrier ∪ K.carrier ⊆ t), ↑t,
  refine mem_bInter (λ S hS, hS hx)
end

lemma mem_sup_of_mem_left {x} (hx : x ∈ H) : x ∈ H ⊔ K :=
by { apply mem_sup_of_mem, left, assumption }

lemma mem_sup_of_mem_right {x} (hx : x ∈ K) : x ∈ H ⊔ K :=
by { apply mem_sup_of_mem, right, assumption }

lemma mem_inf {H K : subgroup G} {g : G} :
  g ∈ H ⊓ K ↔ g ∈ H ∧ g ∈ K :=
begin
  change g ∈ closure ((H : set G) ∩ K) ↔ _,
  rw [←inf_def H K, closure_self], refl
end

namespace product

/-- The product of a subgroup and a normal subgroup forms a subgroup -/
def prod (H : subgroup G) (K : normal G) : subgroup G :=
{ carrier := { g | ∃ h ∈ H, ∃ k ∈ K, g = h * k },
  one_mem' := ⟨1, one_mem H, 1, one_mem K, (group.one_mul _).symm⟩,
  mul_mem' := λ x y ⟨h₀, hh₀, k₀, hk₀, hx⟩ ⟨h₁, hh₁, k₁, hk₁, hy⟩,
    begin
      rw [hx, hy],
      refine ⟨h₀ * h₁, mul_mem H hh₀ hh₁, h₁⁻¹ * k₀ * h₁ * k₁, _, _⟩,
        { refine mul_mem K (mem_normal'.2 ⟨h₁, k₀, hk₀, rfl⟩) hk₁ },
        { simp [group.mul_assoc] }
    end,
  inv_mem' := λ x ⟨h, hh, k, hk, hx⟩,
    begin
      rw [hx, group.inv_mul],
      rw (show k⁻¹ * h⁻¹ = h⁻¹ * (h * k⁻¹ * h⁻¹), by simp [group.mul_assoc]),
      refine ⟨h⁻¹, inv_mem H hh, h * k⁻¹ * h⁻¹,
        mem_normal.2 ⟨h, k⁻¹, inv_mem K hk, rfl⟩, by simp [group.mul_assoc]⟩
    end }

infix ` ⨯ `:70 := prod

lemma mem_product {H : subgroup G} {K : normal G} {x} :
  x ∈ H ⨯ K ↔ ∃ (h ∈ H) (k ∈ K), x = h * k := iff.rfl

theorem product_eq_sup (H : subgroup G) (K : normal G) : H ⨯ K = H ⊔ K :=
begin
  ext, split,
    { intro hx, rcases mem_product.1 hx with ⟨h, hh, k, hk, rfl⟩,
      exact mul_mem _ (mem_sup_of_mem_left hh) (mem_sup_of_mem_right hk) },
    { revert x,
      simp_rw [sup_def, closure_le'', mem_product],
      intros x hx, cases hx,
        exact ⟨x, hx, 1, one_mem K, (group.mul_one x).symm⟩,
        exact ⟨1, one_mem H, x, hx, (group.one_mul x).symm⟩ }
end

end product

-- We make a inductive type `subgroup_ge G H` which is the the type whose terms
-- are subgroups of `G` greater than `H : subgroup G` (this makes sense since we
-- created a lattice structure on subgroups).

/-- `subgroup_ge G H` is the inductive type of subgroups of `G` thats greater
  than `H`-/
inductive subgroup_ge (G : Type) [group G] (K : subgroup G)
| mk (H : subgroup G) : (K ≤ H) → subgroup_ge

namespace ge

open subgroup_ge

-- We will show that the set of subgroups greater than some subgroup form a
-- complete lattice. To do this we will use the fact that the subgroups forms
-- a complete lattice and we will create a Galois insertion from subgroups
-- inducing a complete lattice

@[simp] lemma subgroup_ge_eq (A B : subgroup G) {hA : H ≤ A} {hB : H ≤ B} :
  subgroup_ge.mk A hA = subgroup_ge.mk B hB ↔ A = B := ⟨subgroup_ge.mk.inj, by cc⟩

instance : has_coe (subgroup_ge G H) (set G) := ⟨λ ⟨K, _⟩, (K : set G)⟩

@[simp] lemma ext' {A B : subgroup_ge G H} :
  A = B ↔ (A : set G) = B :=
begin
  cases A, cases B,
  rw subgroup_ge_eq,
  exact ⟨by cc, λ h, ext' h⟩,
end

instance : has_mem G (subgroup_ge G H) := ⟨λ g K, g ∈ (K : set G)⟩

@[ext] theorem ext {A B : subgroup_ge G H}
  (h : ∀ x, x ∈ A ↔ x ∈ B) : A = B := ext'.2 $ set.ext h

instance has_coe_to_subgroup : has_coe (subgroup_ge G H) (subgroup G) :=
  ⟨λ ⟨K, _⟩, K⟩

@[simp] lemma subgroup_ge_eq' (A B : subgroup_ge G H) :
  A = B ↔ (A : subgroup G) = B := by { cases A, cases B, exact subgroup_ge_eq _ _ }

-- We borrow the partital order structure from subgroups
instance : partial_order (subgroup_ge G H) :=
{ .. partial_order.lift (coe : subgroup_ge G H → subgroup G) $ λ x y hxy, by simp [hxy] }

instance : has_bot (subgroup_ge G H) := ⟨⟨H, le_refl _⟩⟩

instance : has_Inf (subgroup_ge G H) :=
⟨ λ s, subgroup_ge.mk (Inf { A | ∃ t ∈ s, (t : subgroup G) = A }) $ λ h hh,
  begin
    suffices : ∀ (i : subgroup G) (x : subgroup_ge G H), x ∈ s → ↑x = i → h ∈ ↑i,
      simpa [Inf],
    rintros _ ⟨t, ht⟩ _ rfl,
    exact ht hh
  end ⟩

lemma le_Inf (s : set (subgroup_ge G H)) : ∀ t ∈ s, Inf s ≤ t :=
begin
  rintros ⟨t, ht⟩ hst a ha,
  change a ∈ ⋂ t _, ↑t at ha,
  rw mem_bInter_iff at ha,
  exact ha t ⟨⟨t, ht⟩, hst, rfl⟩,
end

def closure (A : subgroup G) : subgroup_ge G H := Inf { B | A ≤ B }

lemma closure_le (A : subgroup G) (B : subgroup_ge G H) :
  closure A ≤ B ↔ A ≤ B :=
begin
  split,
    { intro h, cases B with B hB,
      exact le_trans
        (show A ≤ _, by exact (λ _ ha, mem_bInter (λ _ ⟨⟨_, _⟩, ht', rfl⟩, ht' ha))) h },
    { intro h, exact le_Inf _ _ h }
end

lemma le_closure (A : subgroup_ge G H) : A = closure A :=
begin
  cases A with A hA,
  ext, split,
  { intro hx,
    refine mem_bInter (λ B hB, _),
    rcases hB with ⟨t, ht, rfl⟩,
    exact ht hx },
  { suffices : closure A ≤ ⟨A, hA⟩,
      intro hx, exact this hx,
    apply le_Inf,
    rw mem_set_of_eq,
    exact le_of_eq rfl }
end

def gi : @galois_insertion (subgroup G) (subgroup_ge G H) _ _ closure (coe) :=
{ choice := λ x _, closure x,
  gc := λ A B, closure_le _ _,
  le_l_u := λ x, le_of_eq $ le_closure x,
  choice_eq := λ _ _, rfl }

instance : complete_lattice (subgroup_ge G H) :=
{.. @galois_insertion.lift_complete_lattice (subgroup G) (subgroup_ge G H) _ _ _ _ gi }

-- We can see easily that subgroup G is the same as subgroup_ge G ⊥

def subgroup_ge_bot_equiv : subgroup G ≃ subgroup_ge G ⊥ :=
{ to_fun := λ H, ⟨H, bot_le⟩,
  inv_fun := λ ⟨H, _⟩, H,
  left_inv := λ _, rfl,
  right_inv := λ ⟨_, _⟩, rfl }

def subgroup_ge_bot_order_iso :
  let A := subgroup G in let B := subgroup_ge G ⊥ in
  ((≤) : A → A → Prop) ≃o ((≤) : B → B → Prop) :=
{ ord' := λ _ _, iff.rfl,
  .. subgroup_ge_bot_equiv }

end ge

end subgroup

namespace lattice

/-- Given an equivalence `e` on preorders `A` and `B`, and a Galois connection
  using `e`, there is an induced `order_iso` between `A` and `B`  -/
def order_iso_of_equiv_gi {A B : Type} [preorder A] [preorder B]
   (e : A ≃ B) (g : galois_connection e.to_fun e.inv_fun) :
  ((≤) : A → A → Prop) ≃o ((≤) : B → B → Prop) :=
{ ord' := λ a b, let h := g a (e.to_fun b) in
    by { rw e.left_inv at h, rw ←h, refl}, .. e }

open order_iso

/-- Given a `lattice`, `A`, there is an induced `lattice` on the `partial_order`,
  `B` given that they are order isomorphic -/
def lattice_of_order_iso {A B : Type} [lattice A] [partial_order B]
  (e : ((≤) : A → A → Prop) ≃o ((≤) : B → B → Prop)) : lattice B :=
{ .. galois_insertion.lift_lattice e.to_galois_insertion }

/-- Given a `lattice`, `B` and an `order_iso` to the `distrib_lattice`, `A`,
  there is an induced `distrib_lattice` on `B` -/
def distrib_lattice_of_order_iso {A B : Type} [hA : distrib_lattice A] [lattice B]
  (e : ((≤) : B → B → Prop) ≃o ((≤) : A → A → Prop)) : distrib_lattice B :=
{ le_sup_inf :=
    begin
      intros x y z, rw e.ord',
      change e ((x ⊔ y) ⊓ (x ⊔ z)) ≤ e (x ⊔ y ⊓ z),
      rw [map_inf, map_sup, map_sup, map_sup, map_inf],
      apply hA.le_sup_inf
    end
  .. show lattice B, by apply_instance }

def distrib_lattice_of_order_iso' {A B : Type} [distrib_lattice A] [lattice B]
  (e : ((≤) : A → A → Prop) ≃o ((≤) : B → B → Prop)) : distrib_lattice B :=
distrib_lattice_of_order_iso $ order_iso.symm e

/-- Given a `distrib_lattice`, `A`, there is an induced `distrib_lattice` on the
  `partial_order`, `B` given that they are order isomorphic -/
def distrib_lattice_of_order_iso'' {A B : Type} [distrib_lattice A] [partial_order B]
  (e : ((≤) : A → A → Prop) ≃o ((≤) : B → B → Prop)) : distrib_lattice B :=
@distrib_lattice_of_order_iso' _ _ _
  (@lattice_of_order_iso _ _ (distrib_lattice.to_lattice A) _ e) e

end lattice

namespace normal

instance : partial_order (normal G) :=
{.. partial_order.lift (normal.to_subgroup) (λ x y, normal.ext')}

instance : has_Inf (normal G) :=
⟨λ s, {
  carrier := ⋂ t ∈ s, (t : set G),
  one_mem' := mem_bInter $ λ i h, i.one_mem',
  mul_mem' := λ x y hx hy, mem_bInter $ λ i h,
    i.mul_mem' (by apply mem_bInter_iff.1 hx i h)
    (by apply mem_bInter_iff.1 hy i h),
  inv_mem' := λ x hx, mem_bInter $ λ i h,
    i.inv_mem' (by apply mem_bInter_iff.1 hx i h),
  conj_mem' :=
    begin
      simp_rw mem_bInter_iff,
      intros n hn g N hNs,
      exact N.conj_mem _ (hn N hNs) _,
    end }⟩

@[simp] lemma mem_Inf (x : G) (s : set (normal G)) :
  x ∈ Inf s ↔ x ∈ ⋂ t ∈ s, (t : set G) := iff.rfl

def closure (S : set G) : normal G := Inf {H | S ⊆ H}

lemma mem_closure_iff {S : set G} {x : G} :
  x ∈ closure S ↔ ∀ H : normal G, S ⊆ H → x ∈ H := mem_bInter_iff

lemma le_closure (S : set G) : S ≤ closure S :=
λ s hs H ⟨y, hy⟩, by rw ←hy; simp; exact λ hS, hS hs

lemma closure_le (S : set G) (H : normal G) : closure S ≤ H ↔ S ≤ H :=
begin
  split,
    { intro h, refine subset.trans (le_closure _) h },
    { intros h y hy,
      change y ∈ (_ : normal G) at hy,
      unfold closure at hy,
      rw [mem_Inf, mem_bInter_iff] at hy,
      exact hy H h }
end

lemma closure_le' (S : set G) (H : normal G) :
  (closure S : set G) ⊆ H ↔ S ⊆ H := closure_le S H

lemma closure_le'' (S : set G) (H : normal G) :
  (∀ x, x ∈ closure S → x ∈ H) ↔ (∀ x, x ∈ S → x ∈ H) := closure_le S H

lemma closure_self {H : normal G} : closure (H : set G) = H :=
begin
  ext, split; intro hx,
    { apply subset.trans _ ((closure_le (H : set G) H).2 (subset.refl H)),
      exact hx, exact subset.refl _ },
    { rw ← mem_carrier,
      apply subset.trans (le_closure (H : set G)),
      intros g hg, assumption, assumption }
end

-- lemma closure_induction {p : G → Prop} {x} {k : set G} (h : x ∈ closure k)
--   (Hk : ∀ x ∈ k, p x) (H1 : p 1)
--   (Hmul : ∀ x y, p x → p y → p (x * y))
--   (Hinv : ∀ x, p x → p x⁻¹) : p x :=
-- (@closure_le _ _ _ ⟨p, H1, Hmul, Hinv⟩).2 Hk h

def gi : @galois_insertion (set G) (normal G) _ _ closure (λ H, H.carrier) :=
{ choice := λ S _, closure S,
  gc := λ H K,
    begin
      split; intro h,
        { exact subset.trans (le_closure H) h },
        { exact (closure_le _ _).2 h },
    end,
  le_l_u := λ H, le_closure (H : set G),
  choice_eq := λ _ _, rfl }

instance : complete_lattice (normal G) :=
{.. galois_insertion.lift_complete_lattice gi}

end normal

end mygroup


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

import number_theory.cyclotomic.primitive_roots
import field_theory.polynomial_galois_group

/-!
# Galois group of cyclotomic extensions

In this file, we show the relationship between the Galois group of `K(ζₙ)` and `(zmod n)ˣ`;
it is always a subgroup, and if the `n`th cyclotomic polynomial is irreducible, they are isomorphic.

## Main results

* `is_primitive_root.aut_to_pow_injective`: `is_primitive_root.aut_to_pow` is injective
  in the case that it's considered over a cyclotomic field extension.
* `is_cyclotomic_extension.aut_equiv_pow`: If the `n`th cyclotomic polynomial is irreducible in `K`,
  then `is_primitive_root.aut_to_pow` is a `mul_equiv` (for example, in `ℚ` and certain `𝔽ₚ`).
* `gal_X_pow_equiv_units_zmod`, `gal_cyclotomic_equiv_units_zmod`: Repackage
  `is_cyclotomic_extension.aut_equiv_pow` in terms of `polynomial.gal`.
* `is_cyclotomic_extension.aut.comm_group`: Cyclotomic extensions are abelian.

## References

* https://kconrad.math.uconn.edu/blurbs/galoistheory/cyclotomic.pdf

## TODO

* We currently can get away with the fact that the power of a primitive root is a primitive root,
  but the correct long-term solution for computing other explicit Galois groups is creating
  `power_basis.map_conjugate`; but figuring out the exact correct assumptions + proof for this is
  mathematically nontrivial. (Current thoughts: the correct condition is that the annihilating
  ideal of both elements is equal. This may not hold in an ID, and definitely holds in an ICD.)

-/

variables {n : ℕ+} (K : Type*) [field K] {L : Type*} {μ : L}

open polynomial is_cyclotomic_extension

open_locale cyclotomic

namespace is_primitive_root

variables [comm_ring L] [is_domain L] (hμ : is_primitive_root μ n) [algebra K L]
          [is_cyclotomic_extension {n} K L]

/-- `is_primitive_root.aut_to_pow` is injective in the case that it's considered over a cyclotomic
field extension. -/
lemma aut_to_pow_injective : function.injective $ hμ.aut_to_pow K :=
begin
  intros f g hfg,
  apply_fun units.val at hfg,
  simp only [is_primitive_root.coe_aut_to_pow_apply, units.val_eq_coe] at hfg,
  generalize_proofs hf' hg' at hfg,
  have hf := hf'.some_spec,
  have hg := hg'.some_spec,
  generalize_proofs hζ at hf hg,
  suffices : f hμ.to_roots_of_unity = g hμ.to_roots_of_unity,
  { apply alg_equiv.coe_alg_hom_injective,
    apply (hμ.power_basis K).alg_hom_ext,
    exact this },
  rw zmod.eq_iff_modeq_nat at hfg,
  refine (hf.trans _).trans hg.symm,
  rw [←roots_of_unity.coe_pow _ hf'.some, ←roots_of_unity.coe_pow _ hg'.some],
  congr' 1,
  rw [pow_eq_pow_iff_modeq],
  convert hfg,
  rw [hμ.eq_order_of],
  rw [←hμ.coe_to_roots_of_unity_coe] {occs := occurrences.pos [2]},
  rw [order_of_units, order_of_subgroup]
end

end is_primitive_root

namespace is_cyclotomic_extension

variables [comm_ring L] [is_domain L] (hμ : is_primitive_root μ n) [algebra K L]
          [is_cyclotomic_extension {n} K L]

/-- Cyclotomic extensions are abelian. -/
noncomputable def aut.comm_group : comm_group (L ≃ₐ[K] L) :=
((zeta_spec n K L).aut_to_pow_injective K).comm_group _
  (map_one _) (map_mul _) (map_inv _) (map_div _) (map_pow _) (map_zpow _)

variables (h : irreducible (cyclotomic n K)) {K} (L)

include h

/-- The `mul_equiv` that takes an automorphism `f` to the element `k : (zmod n)ˣ` such that
  `f μ = μ ^ k` for any root of unity `μ`. A  strengthening of `is_primitive_root.aut_to_pow`. -/
@[simps] noncomputable def aut_equiv_pow : (L ≃ₐ[K] L) ≃* (zmod n)ˣ :=
let hζ := zeta_spec n K L,
    hμ := λ t, hζ.pow_of_coprime _ (zmod.val_coe_unit_coprime t) in
{ inv_fun := λ t, (hζ.power_basis K).equiv_of_minpoly ((hμ t).power_basis K)
  begin
    haveI := is_cyclotomic_extension.ne_zero' n K L,
    simp only [is_primitive_root.power_basis_gen],
    have hr := is_primitive_root.minpoly_eq_cyclotomic_of_irreducible
               ((zeta_spec n K L).pow_of_coprime _ (zmod.val_coe_unit_coprime t)) h,
    exact ((zeta_spec n K L).minpoly_eq_cyclotomic_of_irreducible h).symm.trans hr
  end,
  left_inv := λ f, begin
    simp only [monoid_hom.to_fun_eq_coe],
    apply alg_equiv.coe_alg_hom_injective,
    apply (hζ.power_basis K).alg_hom_ext,
    simp only [alg_equiv.coe_alg_hom, alg_equiv.map_pow],
    rw power_basis.equiv_of_minpoly_gen,
    simp only [is_primitive_root.power_basis_gen, is_primitive_root.aut_to_pow_spec],
  end,
  right_inv := λ x, begin
    simp only [monoid_hom.to_fun_eq_coe],
    generalize_proofs _ h,
    have key := hζ.aut_to_pow_spec K ((hζ.power_basis K).equiv_of_minpoly ((hμ x).power_basis K) h),
    have := (hζ.power_basis K).equiv_of_minpoly_gen ((hμ x).power_basis K) h,
    rw hζ.power_basis_gen K at this,
    rw [this, is_primitive_root.power_basis_gen] at key,
    rw ← hζ.coe_to_roots_of_unity_coe at key {occs := occurrences.pos [1, 5]},
    simp only [←coe_coe, ←roots_of_unity.coe_pow] at key,
    replace key := roots_of_unity.coe_injective key,
    rw [pow_eq_pow_iff_modeq, ←order_of_subgroup, ←order_of_units, hζ.coe_to_roots_of_unity_coe,
        ←(zeta_spec n K L).eq_order_of, ←zmod.eq_iff_modeq_nat] at key,
    simp only [zmod.nat_cast_val, zmod.cast_id', id.def] at key,
    exact units.ext key
  end,
  .. (zeta_spec n K L).aut_to_pow K }

include hμ

variables {L}

/-- Maps `μ` to the `alg_equiv` that sends `is_cyclotomic_extension.zeta` to `μ`. -/
noncomputable def from_zeta_aut : L ≃ₐ[K] L :=
let hζ := (zeta_spec n K L).eq_pow_of_pow_eq_one hμ.pow_eq_one n.pos in
(aut_equiv_pow L h).symm $ zmod.unit_of_coprime hζ.some $
((zeta_spec n K L).pow_iff_coprime n.pos hζ.some).mp $ hζ.some_spec.some_spec.symm ▸ hμ

lemma from_zeta_aut_spec : from_zeta_aut hμ h (zeta n K L) = μ :=
begin
  simp_rw [from_zeta_aut, aut_equiv_pow_symm_apply],
  generalize_proofs hζ h _ hμ _,
  rw [←hζ.power_basis_gen K] {occs := occurrences.pos [4]},
  rw [power_basis.equiv_of_minpoly_gen, hμ.power_basis_gen K],
  convert h.some_spec.some_spec,
  exact zmod.val_cast_of_lt h.some_spec.some
end

end is_cyclotomic_extension

section gal

variables [field L] (hμ : is_primitive_root μ n) [algebra K L]
          [is_cyclotomic_extension {n} K L] (h : irreducible (cyclotomic n K)) {K}

/-- `is_cyclotomic_extension.aut_equiv_pow` repackaged in terms of `gal`.
Asserts that the Galois group of `cyclotomic n K` is equivalent to `(zmod n)ˣ`
if `cyclotomic n K` is irreducible in the base field. -/
noncomputable def gal_cyclotomic_equiv_units_zmod :
  (cyclotomic n K).gal ≃* (zmod n)ˣ :=
(alg_equiv.aut_congr (is_splitting_field.alg_equiv _ _)).symm.trans
(is_cyclotomic_extension.aut_equiv_pow L h)

/-- `is_cyclotomic_extension.aut_equiv_pow` repackaged in terms of `gal`.
Asserts that the Galois group of `X ^ n - 1` is equivalent to `(zmod n)ˣ`
if `cyclotomic n K` is irreducible in the base field. -/
noncomputable def gal_X_pow_equiv_units_zmod :
  (X ^ (n : ℕ) - 1).gal ≃* (zmod n)ˣ :=
(alg_equiv.aut_congr (is_splitting_field.alg_equiv _ _)).symm.trans
(is_cyclotomic_extension.aut_equiv_pow L h)

end gal


import data.real.basic

variables (a b : ℝ)

include a b
example : (a + b) ^ 3 = a ^ 3 + 3 * (a ^ 2) * b + 3 * a * b ^ 2 + b ^ 3 :=
by calc
    (a + b) ^ 3 = (a + b) ^ (2 + 1) : rfl
    ... = (a + b) ^ 2 * (a + b) : by rw pow_succ'
    ... = (a + b) * (a + b) * (a + b) : by rw pow_two
    ... = ((a + b) * a + (a + b) * b) * (a + b) : by rw mul_add (a + b) a b
    ... = ((a * a + b * a) + (a * b + b * b)) * (a + b) :
    by rw [add_mul a b a, add_mul a b b]
    ... = (a * a + b * a + a * b + b * b) * (a + b) :
    by rw [add_assoc (a * a + b * a) (a * b) (b * b)]
    ... = (a ^ 2 + a * b + a * b + b ^ 2) * (a + b) :
    by rw [mul_comm b a, pow_two, pow_two]
    ... = (a ^ 2 + 1 * a * b + 1 * a * b + b ^ 2) * (a + b) : by rw one_mul
    ... = (a ^ 2 + (1 * a * b + 1 * a * b) + b ^ 2) * (a + b) :
    by rw add_assoc (a ^ 2) (1 * a * b) (1 * a * b)
    ... = (a ^ 2 + (1 * (a * b) + 1 * (a * b)) + b ^ 2) * (a + b) :
    by rw mul_assoc
    ... = (a ^ 2 + (1 + 1) * (a * b) + b ^ 2) * (a + b) : by rw add_mul 1 1 (a * b)
    ... = (a ^ 2 + 2 * (a * b) + b ^ 2) * (a + b) : rfl
    ... = (a ^ 2 + 2 * a * b + b ^ 2) * (a + b) : by rw mul_assoc
    ... = (a ^ 2 + 2 * a * b + b ^ 2) * a + (a ^ 2 + 2 * a * b + b ^ 2) * b :
    by rw mul_add
    ... = (a ^ 2 + 2 * a * b) * a + b ^ 2 * a +
    ((a ^ 2 + 2 * a * b) * b + b ^ 2 * b) :
    by rw [add_mul (a ^ 2 + 2 * a * b) (b ^ 2) a,
    add_mul (a ^ 2 + 2 * a * b) (b ^ 2) b]
    ... = a ^ 2 * a + 2 * a * b * a + a * b ^ 2 +
    (a ^ 2 * b + 2 * a * b * b + b ^ 3) :
    by rw [add_mul, add_mul, mul_comm (b ^ 2) a, pow_succ' b 2]
    ... = a ^ 3 + 2 * a * (b * a) + a * b ^ 2 +
    (a ^ 2 * b + 2 * a * (b * b) + b ^ 3) :
    by rw [pow_succ' a 2, mul_assoc, mul_assoc (2 * a) b b]
    ... = a ^ 3 + 2 * a * (a * b) + a * b ^ 2 +
    (a ^ 2 * b + 2 * a * b ^ 2 + b ^ 3) :
    by rw [mul_comm b a, pow_two]
    ... = a ^ 3 + 2 * a * a * b + a * b ^ 2 +
    (a ^ 2 * b + 2 * a * b ^ 2 + b ^ 3) :
    by rw [mul_assoc (2 * a) a b]
    ... = a ^ 3 + 2 * (a * a) * b + 1 * a * b ^ 2 +
    (1 * a ^ 2 * b + 2 * a * b ^ 2 + b ^ 3) :
    by rw [mul_assoc 2 a a, one_mul, one_mul]
    ... = a ^ 3 + 2 * a ^ 2 * b + 1 * a * b ^ 2 +
    (1 * a ^ 2 * b + 2 * a * b ^ 2 + b ^ 3) :
    by rw [pow_two a]
    ... = a ^ 3 + 2 * a ^ 2 * b + 1 * a * b ^ 2 +
    (1 * a ^ 2 * b + 2 * a * b ^ 2) + b ^ 3 :
    by rw [add_assoc (a ^ 3 + 2 * a ^ 2 * b + 1 * a * b ^ 2)
    (1 * a ^ 2 * b + 2 * a * b ^ 2) (b ^ 3)]
    ... = a ^ 3 + 2 * a ^ 2 * b + 1 * a * b ^ 2 +
    1 * a ^ 2 * b + 2 * a * b ^ 2 + b ^ 3 :
    by rw [add_assoc (a ^ 3 + 2 * a ^ 2 * b + 1 * a * b ^ 2) (1 * a ^ 2 * b)
    (2 * a * b ^ 2)]
    ... = a ^ 3 + 2 * a ^ 2 * b + (1 * a * b ^ 2 +
    1 * a ^ 2 * b) + 2 * a * b ^ 2 + b ^ 3 :
    by rw [add_assoc (a ^ 3 + 2 * a ^ 2 * b) (1 * a * b ^ 2) (1 * a ^ 2 * b)]
    ... = a ^ 3 + 2 * a ^ 2 * b + (1 * a ^ 2 * b + 1 * a * b ^ 2) +
    2 * a * b ^ 2 + b ^ 3 :
    by rw [add_comm (1 * a ^ 2 * b) (1 * a * b ^ 2)]
    ... = a ^ 3 + 2 * a ^ 2 * b + 1 * a ^ 2 * b + 1 * a * b ^ 2 +
    2 * a * b ^ 2 + b ^ 3 :
    by rw [add_assoc (a ^ 3 + 2 * a ^ 2 * b) (1 * a ^ 2 * b) (1 * a * b ^ 2)]
    ... = a ^ 3 + (2 * a ^ 2 * b + 1 * a ^ 2 * b) + (1 * a * b ^ 2 +
    2 * a * b ^ 2) + b ^ 3 :
    by rw [add_assoc (a ^ 3) (2 * a ^ 2 * b) (1 * a ^ 2 * b),
    add_assoc (a ^ 3 + (2 * a ^ 2 * b + 1 * a ^ 2 * b)) (1 * a * b ^ 2)
    (2 * a * b ^ 2)]
    ... = a ^ 3 + (2 + 1) * (a ^ 2 * b) + (1 + 2) * (a * b ^ 2) + b ^ 3 :
    by rw [mul_assoc 2 (a ^ 2) b, mul_assoc 1 (a ^ 2) b, mul_assoc 1 a (b ^ 2),
    mul_assoc 2 a (b ^ 2), add_mul 2 1 (a ^ 2 * b), add_mul 1 2 (a * b ^ 2)]
    ... = a ^ 3 + 3 * (a ^ 2 * b) + 3 * (a * b ^ 2) + b ^ 3 : rfl
    ... = a ^ 3 + 3 * a ^ 2 * b + 3 * a * b ^ 2 + b ^ 3 :
    by rw [mul_assoc 3 (a ^ 2) b, mul_assoc 3 a (b ^ 2)]


import .love05_inductive_predicates_demo
import .love13_rational_and_real_numbers_demo

/-! # LoVe Exercise 13: Rational and Real Numbers -/

set_option pp.beta true

namespace LoVe

/-! ## Question 1: Rationals

1.1. Prove the following lemma.

Hint: The lemma `fraction.mk.inj_eq` might be useful. -/

#check fraction.mk.inj_eq

lemma fraction.ext (a b : fraction) (hnum : fraction.num a = fraction.num b)
    (hdenom : fraction.denom a = fraction.denom b) :
  a = b :=
sorry

/-! 1.2. Extending the `fraction.has_mul` instance from the lecture, declare
`fraction` as an instance of `semigroup`.

Hint: Use the lemma `fraction.ext` above, and possibly `fraction.mul_num`, and
`fraction.mul_denom`. -/

#check fraction.ext
#check fraction.mul_num
#check fraction.mul_denom

@[instance] def fraction.semigroup : semigroup fraction :=
{ mul_assoc :=
    sorry,
  ..fraction.has_mul }

/-! 1.3. Extending the `rat.has_mul` instance from the lecture, declare `rat` as
an instance of `semigroup`. -/

@[instance] def rat.semigroup : semigroup rat :=
{ mul_assoc :=
    sorry,
  ..rat.has_mul }

end LoVe

-- lemma rat_test : ℚ
-- #eval  0 0   -- expected: 0


import data.list
import tactic.norm_num
import .common .tree_sort .list

local attribute [simp, reducible] nat.factors

@[simp, reducible]
def list.zip_with_count {α: Type*} [decidable_eq α] (l: list α): list (α × ℕ) :=
  list.map (λ x, (x, list.count x l)) l

@[simp, reducible]
def factorize (n: ℕ) : list (ℕ × ℕ) :=
  list.erase_dup (nat.factors n).zip_with_count

#eval factorize (2*2*3*5*5)
example: (factorize (2*2*3)) ~ [(2, 2), (3, 1)] := by norm_num; reflexivity

theorem factors_ge_2 {n p m: ℕ}: (p, m) ∈ (factorize n) -> p ≥ 2 := begin
intro h,
simp at h,
cases h with a w,
  rw w.right.left.symm,
  have: nat.prime a, by apply nat.mem_factors w.left,
  apply nat.prime.two_le,
  assumption,
end

theorem factors_are_nat_factors {n p m: ℕ}: (p, m) ∈ (factorize n) -> p ∈ (nat.factors n) := begin
intro h,
simp at h,
cases h with a w,
  rw w.right.left.symm,
  apply w.left,
end

theorem factors_are_prime {n p m: ℕ}: (p, m) ∈ (factorize n) -> nat.prime p := begin
intro h,
simp at h,
cases h with a w,
  rw w.right.left.symm,
  apply nat.mem_factors w.left,
end

@[simp, reducible]
def Prod: list ℕ -> ℕ := list.prod
theorem prod_singleton_id {x}: Prod [x] = x := by simp
theorem prod_singleton_of_lift_id {x}: (Prod ∘ (λ x, [x])) x = x := by simp

@[simp, reducible]
def divisors_aux: list (ℕ × ℕ) -> list ℕ
| [] := [1]
| (p::ps) := (<| p |>) <*> (divisors_aux ps)

#eval divisors_aux (factorize (2*2*3*5*5))

@[simp, reducible]
def divisors (n: ℕ) := divisors_aux (factorize n)

#eval divisors (2*2*3*5*5)
#eval divisors (2*2*3)
example: tree_sort.sort (λ a b, to_bool (a < b)) (divisors (2*2*3)) = [1, 2, 3, 4, 6, 12] := by norm_num; reflexivity


import affine_algebraic_set.Zariski -- Zariski topology
import affine_algebraic_set.V_and_I -- 𝕍 and 𝕀 basics
import for_mathlib.topological_space -- silly fact about closed sets I couldn't find

open affine_algebraic_set

open_locale classical -- classical logic

variables (σ : Type*) (k : Type*) [integral_domain k]

local notation `𝔸ⁿ` := σ → k

-- Question: Let A be any subset of 𝔸ⁿ.
-- Prove that 𝕍(𝕀(A)) is the Zariski closure of A.

lemma sheet_1.question_1 (A : set 𝔸ⁿ) : 𝕍 (𝕀 A) = closure A :=
begin
  -- we prove both inclusions separately.
  apply set.subset.antisymm,
  { -- Here we prove 𝕍 (𝕀 A) ⊆ closure A
    -- say x ∈ 𝕍 (𝕀 A)
    intros x hx,
    change 𝔸ⁿ at x,
    -- it suffices to prove that x is in every closed set containing A,
    rw mem_closure_iff',
    -- so let C be a closed set containing A
    intros C hC hAC,
    -- Because C is closed, it's 𝕍(S) for some S
    rw is_closed_iff at hC,
    cases hC with S hS,
    rw hS at hAC ⊢, clear hS C,
    -- Our goal is to prove x ∈ 𝕍 S,
    -- or in other words that f(x) = 0 for all f ∈ S
    rw mem_𝕍_iff,
    -- so say g ∈ S
    intros g hg,
    -- now x ∈ 𝕍 (𝕀 A) by assumption, so f(x) = 0 forall f ∈ 𝕀 A,
    rw mem_𝕍_iff at hx,
    -- so it suffices to prove g ∈ 𝕀 A
    apply hx, clear hx,
    -- i.e. that f(y) = 0 for all y ∈ A
    rw mem_𝕀_iff,
    -- so say y ∈ A
    intros y hy,
    -- then y ∈ 𝕍 S,
    replace hy := hAC hy,
    -- so f(y) = 0 for all f ∈ S
    rw mem_𝕍_iff at hy,
    -- and this is what we needed
    apply hy,
    assumption},
  { -- to prove the closure of A is a subset of 𝕍 (𝕀 A), it suffices
    -- to prove that 𝕍 (𝕀 A) is closed and contains A
    rw closure_subset_iff_subset_of_is_closed,
    { -- The fact that A ⊆ 𝕍 (𝕀 A) is straightforward
      intros x hx, rw mem_𝕍_iff, intros f hf, rw mem_𝕀_iff at hf,
      apply hf, assumption
    },
    { -- and the fact that 𝕍 (𝕀 A) is closed follows straight from
      -- the definition, because it's in the image of 𝕍.
      rw is_closed_iff, use 𝕀 A}
  }
end

-- computer science version:
lemma sheet_1.question_1' (A : set 𝔸ⁿ) : 𝕍 (𝕀 A) = closure A :=
set.subset.antisymm
  (λ x hx, mem_closure_iff'.2 $ λ C hC hAC, begin
    cases (is_closed_iff _).1 hC with S hS,
    rw hS at hAC ⊢,
    exact λ g hg, hx _ (λ y hy, hAC hy _ hg),
  end)
  ((closure_subset_iff_subset_of_is_closed $ (is_closed_iff _).2 ⟨_, rfl⟩).2
  (λ x hx f hf, hf _ hx))