/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro
-/
import data.set.countable
import logic.encodable.lattice
import order.conditionally_complete_lattice
import order.disjointed
import order.symm_diff

/-!
# Measurable spaces and measurable functions

This file defines measurable spaces and measurable functions.

A measurable space is a set equipped with a σ-algebra, a collection of
subsets closed under complementation and countable union. A function
between measurable spaces is measurable if the preimage of each
measurable subset is measurable.

σ-algebras on a fixed set `α` form a complete lattice. Here we order
σ-algebras by writing `m₁ ≤ m₂` if every set which is `m₁`-measurable is
also `m₂`-measurable (that is, `m₁` is a subset of `m₂`). In particular, any
collection of subsets of `α` generates a smallest σ-algebra which
contains all of them.

Do not add measurability lemmas (which could be tagged with
@[measurability]) to this file, since the measurability tactic is downstream
from here. Use `measure_theory.measurable_space` instead.

## References

* <https://en.wikipedia.org/wiki/Measurable_space>
* <https://en.wikipedia.org/wiki/Sigma-algebra>
* <https://en.wikipedia.org/wiki/Dynkin_system>

## Tags

measurable space, σ-algebra, measurable function
-/

open set encodable function equiv
open_locale classical

variables {α β γ δ δ' : Type*} {ι : Sort*} {s t u : set α}

/-- A measurable space is a space equipped with a σ-algebra. -/
structure measurable_space (α : Type*) :=
(measurable_set' : set α → Prop)
(measurable_set_empty : measurable_set' ∅)
(measurable_set_compl : ∀ s, measurable_set' s → measurable_set' sᶜ)
(measurable_set_Union : ∀ f : ℕ → set α, (∀ i, measurable_set' (f i)) → measurable_set' (⋃ i, f i))

attribute [class] measurable_space

instance [h : measurable_space α] : measurable_space (order_dual α) := h

section

/-- `measurable_set s` means that `s` is measurable (in the ambient measure space on `α`) -/
def measurable_set [measurable_space α] : set α → Prop := ‹measurable_space α›.measurable_set'

localized "notation `measurable_set[` m `]` := @measurable_set _ m" in measure_theory

@[simp] lemma measurable_set.empty [measurable_space α] : measurable_set (∅ : set α) :=
‹measurable_space α›.measurable_set_empty

variable {m : measurable_space α}

include m

lemma measurable_set.compl : measurable_set s → measurable_set sᶜ :=
‹measurable_space α›.measurable_set_compl s

lemma measurable_set.of_compl (h : measurable_set sᶜ) : measurable_set s :=
compl_compl s ▸ h.compl

@[simp] lemma measurable_set.compl_iff : measurable_set sᶜ ↔ measurable_set s :=
⟨measurable_set.of_compl, measurable_set.compl⟩

@[simp] lemma measurable_set.univ : measurable_set (univ : set α) :=
by simpa using (@measurable_set.empty α _).compl

@[nontriviality] lemma subsingleton.measurable_set [subsingleton α] {s : set α} :
  measurable_set s :=
subsingleton.set_cases measurable_set.empty measurable_set.univ s

lemma measurable_set.congr {s t : set α} (hs : measurable_set s) (h : s = t) :
  measurable_set t :=
by rwa ← h

lemma measurable_set.bUnion_decode₂ [encodable β] ⦃f : β → set α⦄ (h : ∀ b, measurable_set (f b))
  (n : ℕ) : measurable_set (⋃ b ∈ decode₂ β n, f b) :=
encodable.Union_decode₂_cases measurable_set.empty h

lemma measurable_set.Union [encodable β] ⦃f : β → set α⦄ (h : ∀ b, measurable_set (f b)) :
  measurable_set (⋃ b, f b) :=
begin
  rw ← encodable.Union_decode₂,
  exact ‹measurable_space α›.measurable_set_Union _ (measurable_set.bUnion_decode₂ h)
end

lemma measurable_set.bUnion {f : β → set α} {s : set β} (hs : countable s)
  (h : ∀ b ∈ s, measurable_set (f b)) : measurable_set (⋃ b ∈ s, f b) :=
begin
  rw bUnion_eq_Union,
  haveI := hs.to_encodable,
  exact measurable_set.Union (by simpa using h)
end

lemma set.finite.measurable_set_bUnion {f : β → set α} {s : set β} (hs : finite s)
  (h : ∀ b ∈ s, measurable_set (f b)) :
  measurable_set (⋃ b ∈ s, f b) :=
measurable_set.bUnion hs.countable h

lemma finset.measurable_set_bUnion {f : β → set α} (s : finset β)
  (h : ∀ b ∈ s, measurable_set (f b)) :
  measurable_set (⋃ b ∈ s, f b) :=
s.finite_to_set.measurable_set_bUnion h

lemma measurable_set.sUnion {s : set (set α)} (hs : countable s) (h : ∀ t ∈ s, measurable_set t) :
  measurable_set (⋃₀ s) :=
by { rw sUnion_eq_bUnion, exact measurable_set.bUnion hs h }

lemma set.finite.measurable_set_sUnion {s : set (set α)} (hs : finite s)
  (h : ∀ t ∈ s, measurable_set t) :
  measurable_set (⋃₀ s) :=
measurable_set.sUnion hs.countable h

lemma measurable_set.Union_Prop {p : Prop} {f : p → set α} (hf : ∀ b, measurable_set (f b)) :
  measurable_set (⋃ b, f b) :=
by { by_cases p; simp [h, hf, measurable_set.empty] }

lemma measurable_set.Inter [encodable β] {f : β → set α} (h : ∀ b, measurable_set (f b)) :
  measurable_set (⋂ b, f b) :=
measurable_set.compl_iff.1 $
by { rw compl_Inter, exact measurable_set.Union (λ b, (h b).compl) }

section fintype

local attribute [instance] fintype.encodable

lemma measurable_set.Union_fintype [fintype β] {f : β → set α} (h : ∀ b, measurable_set (f b)) :
  measurable_set (⋃ b, f b) :=
measurable_set.Union h

lemma measurable_set.Inter_fintype [fintype β] {f : β → set α} (h : ∀ b, measurable_set (f b)) :
  measurable_set (⋂ b, f b) :=
measurable_set.Inter h

end fintype

lemma measurable_set.bInter {f : β → set α} {s : set β} (hs : countable s)
  (h : ∀ b ∈ s, measurable_set (f b)) : measurable_set (⋂ b ∈ s, f b) :=
measurable_set.compl_iff.1 $
by { rw compl_Inter₂, exact measurable_set.bUnion hs (λ b hb, (h b hb).compl) }

lemma set.finite.measurable_set_bInter {f : β → set α} {s : set β} (hs : finite s)
  (h : ∀ b ∈ s, measurable_set (f b)) : measurable_set (⋂ b ∈ s, f b) :=
measurable_set.bInter hs.countable h

lemma finset.measurable_set_bInter {f : β → set α} (s : finset β)
  (h : ∀ b ∈ s, measurable_set (f b)) : measurable_set (⋂ b ∈ s, f b) :=
s.finite_to_set.measurable_set_bInter h

lemma measurable_set.sInter {s : set (set α)} (hs : countable s) (h : ∀ t ∈ s, measurable_set t) :
  measurable_set (⋂₀ s) :=
by { rw sInter_eq_bInter, exact measurable_set.bInter hs h }

lemma set.finite.measurable_set_sInter {s : set (set α)} (hs : finite s)
  (h : ∀ t ∈ s, measurable_set t) : measurable_set (⋂₀ s) :=
measurable_set.sInter hs.countable h

lemma measurable_set.Inter_Prop {p : Prop} {f : p → set α} (hf : ∀ b, measurable_set (f b)) :
  measurable_set (⋂ b, f b) :=
by { by_cases p; simp [h, hf, measurable_set.univ] }

@[simp] lemma measurable_set.union {s₁ s₂ : set α} (h₁ : measurable_set s₁)
  (h₂ : measurable_set s₂) :
  measurable_set (s₁ ∪ s₂) :=
by { rw union_eq_Union, exact measurable_set.Union (bool.forall_bool.2 ⟨h₂, h₁⟩) }

@[simp] lemma measurable_set.inter {s₁ s₂ : set α} (h₁ : measurable_set s₁)
  (h₂ : measurable_set s₂) :
  measurable_set (s₁ ∩ s₂) :=
by { rw inter_eq_compl_compl_union_compl, exact (h₁.compl.union h₂.compl).compl }

@[simp] lemma measurable_set.diff {s₁ s₂ : set α} (h₁ : measurable_set s₁)
  (h₂ : measurable_set s₂) :
  measurable_set (s₁ \ s₂) :=
h₁.inter h₂.compl

@[simp] lemma measurable_set.symm_diff {s₁ s₂ : set α}
  (h₁ : measurable_set s₁) (h₂ : measurable_set s₂) :
  measurable_set (s₁ ∆ s₂) :=
(h₁.diff h₂).union (h₂.diff h₁)

@[simp] lemma measurable_set.ite {t s₁ s₂ : set α} (ht : measurable_set t) (h₁ : measurable_set s₁)
  (h₂ : measurable_set s₂) :
  measurable_set (t.ite s₁ s₂) :=
(h₁.inter ht).union (h₂.diff ht)

@[simp] lemma measurable_set.cond {s₁ s₂ : set α} (h₁ : measurable_set s₁) (h₂ : measurable_set s₂)
  {i : bool} : measurable_set (cond i s₁ s₂) :=
by { cases i, exacts [h₂, h₁] }

@[simp] lemma measurable_set.disjointed {f : ℕ → set α} (h : ∀ i, measurable_set (f i)) (n) :
  measurable_set (disjointed f n) :=
disjointed_rec (λ t i ht, measurable_set.diff ht $ h _) (h n)

@[simp] lemma measurable_set.const (p : Prop) : measurable_set {a : α | p} :=
by { by_cases p; simp [h, measurable_set.empty]; apply measurable_set.univ }

/-- Every set has a measurable superset. Declare this as local instance as needed. -/
lemma nonempty_measurable_superset (s : set α) : nonempty { t // s ⊆ t ∧ measurable_set t} :=
⟨⟨univ, subset_univ s, measurable_set.univ⟩⟩

end

@[ext] lemma measurable_space.ext : ∀ {m₁ m₂ : measurable_space α},
  (∀ s : set α, m₁.measurable_set' s ↔ m₂.measurable_set' s) → m₁ = m₂
| ⟨s₁, _, _, _⟩ ⟨s₂, _, _, _⟩ h :=
  have s₁ = s₂, from funext $ assume x, propext $ h x,
  by subst this

@[ext] lemma measurable_space.ext_iff {m₁ m₂ : measurable_space α} :
  m₁ = m₂ ↔ (∀ s : set α, m₁.measurable_set' s ↔ m₂.measurable_set' s) :=
⟨by { unfreezingI {rintro rfl}, intro s, refl }, measurable_space.ext⟩

/-- A typeclass mixin for `measurable_space`s such that each singleton is measurable. -/
class measurable_singleton_class (α : Type*) [measurable_space α] : Prop :=
(measurable_set_singleton : ∀ x, measurable_set ({x} : set α))

export measurable_singleton_class (measurable_set_singleton)

attribute [simp] measurable_set_singleton

section measurable_singleton_class

variables [measurable_space α] [measurable_singleton_class α]

lemma measurable_set_eq {a : α} : measurable_set {x | x = a} :=
measurable_set_singleton a

lemma measurable_set.insert {s : set α} (hs : measurable_set s) (a : α) :
  measurable_set (insert a s) :=
(measurable_set_singleton a).union hs

@[simp] lemma measurable_set_insert {a : α} {s : set α} :
  measurable_set (insert a s) ↔ measurable_set s :=
⟨λ h, if ha : a ∈ s then by rwa ← insert_eq_of_mem ha
  else insert_diff_self_of_not_mem ha ▸ h.diff (measurable_set_singleton _),
  λ h, h.insert a⟩

lemma set.subsingleton.measurable_set {s : set α} (hs : s.subsingleton) : measurable_set s :=
hs.induction_on measurable_set.empty measurable_set_singleton

lemma set.finite.measurable_set {s : set α} (hs : finite s) : measurable_set s :=
finite.induction_on hs measurable_set.empty $ λ a s ha hsf hsm, hsm.insert _

protected lemma finset.measurable_set (s : finset α) : measurable_set (↑s : set α) :=
s.finite_to_set.measurable_set

lemma set.countable.measurable_set {s : set α} (hs : countable s) : measurable_set s :=
begin
  rw [← bUnion_of_singleton s],
  exact measurable_set.bUnion hs (λ b hb, measurable_set_singleton b)
end

end measurable_singleton_class

namespace measurable_space

section complete_lattice

instance : has_le (measurable_space α) :=
{ le          := λ m₁ m₂, m₁.measurable_set' ≤ m₂.measurable_set' }

lemma le_def {α} {a b : measurable_space α} :
  a ≤ b ↔ a.measurable_set' ≤ b.measurable_set' := iff.rfl

instance : partial_order (measurable_space α) :=
{ le_refl     := assume a b, le_rfl,
  le_trans    := assume a b c hab hbc, le_def.mpr (le_trans hab hbc),
  le_antisymm := assume a b h₁ h₂, measurable_space.ext $ assume s, ⟨h₁ s, h₂ s⟩,
  ..measurable_space.has_le }

/-- The smallest σ-algebra containing a collection `s` of basic sets -/
inductive generate_measurable (s : set (set α)) : set α → Prop
| basic : ∀ u ∈ s, generate_measurable u
| empty : generate_measurable ∅
| compl : ∀ s, generate_measurable s → generate_measurable sᶜ
| union : ∀ f : ℕ → set α, (∀ n, generate_measurable (f n)) → generate_measurable (⋃ i, f i)

/-- Construct the smallest measure space containing a collection of basic sets -/
def generate_from (s : set (set α)) : measurable_space α :=
{ measurable_set'      := generate_measurable s,
  measurable_set_empty := generate_measurable.empty,
  measurable_set_compl := generate_measurable.compl,
  measurable_set_Union := generate_measurable.union }

lemma measurable_set_generate_from {s : set (set α)} {t : set α} (ht : t ∈ s) :
  @measurable_set _ (generate_from s) t :=
generate_measurable.basic t ht

lemma generate_from_le {s : set (set α)} {m : measurable_space α}
  (h : ∀ t ∈ s, m.measurable_set' t) : generate_from s ≤ m :=
assume t (ht : generate_measurable s t), ht.rec_on h
  (measurable_set_empty m)
  (assume s _ hs, measurable_set_compl m s hs)
  (assume f _ hf, measurable_set_Union m f hf)

lemma generate_from_le_iff {s : set (set α)} (m : measurable_space α) :
  generate_from s ≤ m ↔ s ⊆ {t | m.measurable_set' t} :=
iff.intro
  (assume h u hu, h _ $ measurable_set_generate_from hu)
  (assume h, generate_from_le h)

@[simp] lemma generate_from_measurable_set [measurable_space α] :
  generate_from {s : set α | measurable_set s} = ‹_› :=
le_antisymm (generate_from_le $ λ _, id) $ λ s, measurable_set_generate_from

/-- If `g` is a collection of subsets of `α` such that the `σ`-algebra generated from `g` contains
the same sets as `g`, then `g` was already a `σ`-algebra. -/
protected def mk_of_closure (g : set (set α)) (hg : {t | (generate_from g).measurable_set' t} = g) :
  measurable_space α :=
{ measurable_set'      := λ s, s ∈ g,
  measurable_set_empty := hg ▸ measurable_set_empty _,
  measurable_set_compl := hg ▸ measurable_set_compl _,
  measurable_set_Union := hg ▸ measurable_set_Union _ }

lemma mk_of_closure_sets {s : set (set α)}
  {hs : {t | (generate_from s).measurable_set' t} = s} :
  measurable_space.mk_of_closure s hs = generate_from s :=
measurable_space.ext $ assume t, show t ∈ s ↔ _, by { conv_lhs { rw [← hs] }, refl }

/-- We get a Galois insertion between `σ`-algebras on `α` and `set (set α)` by using `generate_from`
  on one side and the collection of measurable sets on the other side. -/
def gi_generate_from : galois_insertion (@generate_from α) (λ m, {t | @measurable_set α m t}) :=
{ gc        := assume s, generate_from_le_iff,
  le_l_u    := assume m s, measurable_set_generate_from,
  choice    :=
    λ g hg, measurable_space.mk_of_closure g $ le_antisymm hg $ (generate_from_le_iff _).1 le_rfl,
  choice_eq := assume g hg, mk_of_closure_sets }

instance : complete_lattice (measurable_space α) :=
gi_generate_from.lift_complete_lattice

instance : inhabited (measurable_space α) := ⟨⊤⟩

lemma measurable_set_bot_iff {s : set α} : @measurable_set α ⊥ s ↔ (s = ∅ ∨ s = univ) :=
let b : measurable_space α :=
{ measurable_set'      := λ s, s = ∅ ∨ s = univ,
  measurable_set_empty := or.inl rfl,
  measurable_set_compl := by simp [or_imp_distrib] {contextual := tt},
  measurable_set_Union := assume f hf, classical.by_cases
    (assume h : ∃i, f i = univ,
      let ⟨i, hi⟩ := h in
      or.inr $ eq_univ_of_univ_subset $ hi ▸ le_supr f i)
    (assume h : ¬ ∃i, f i = univ,
      or.inl $ eq_empty_of_subset_empty $ Union_subset $ assume i,
        (hf i).elim (by simp {contextual := tt}) (assume hi, false.elim $ h ⟨i, hi⟩)) } in
have b = ⊥, from bot_unique $ assume s hs,
  hs.elim (λ s, s.symm ▸ @measurable_set_empty _ ⊥) (λ s, s.symm ▸ @measurable_set.univ _ ⊥),
this ▸ iff.rfl

@[simp] theorem measurable_set_top {s : set α} : @measurable_set _ ⊤ s := trivial

@[simp] theorem measurable_set_inf {m₁ m₂ : measurable_space α} {s : set α} :
  @measurable_set _ (m₁ ⊓ m₂) s ↔ @measurable_set _ m₁ s ∧ @measurable_set _ m₂ s :=
iff.rfl

@[simp] theorem measurable_set_Inf {ms : set (measurable_space α)} {s : set α} :
  @measurable_set _ (Inf ms) s ↔ ∀ m ∈ ms, @measurable_set _ m s :=
show s ∈ (⋂₀ _) ↔ _, by simp

@[simp] theorem measurable_set_infi {ι} {m : ι → measurable_space α} {s : set α} :
  @measurable_set _ (infi m) s ↔ ∀ i, @measurable_set _ (m i) s :=
by rw [infi, measurable_set_Inf, forall_range_iff]

theorem measurable_set_sup {m₁ m₂ : measurable_space α} {s : set α} :
  @measurable_set _ (m₁ ⊔ m₂) s ↔ generate_measurable (m₁.measurable_set' ∪ m₂.measurable_set') s :=
iff.refl _

theorem measurable_set_Sup {ms : set (measurable_space α)} {s : set α} :
  @measurable_set _ (Sup ms) s ↔
    generate_measurable {s : set α | ∃ m ∈ ms, @measurable_set _ m s} s :=
begin
  change @measurable_set' _ (generate_from $ ⋃₀ _) _ ↔ _,
  simp [generate_from, ← set_of_exists]
end

theorem measurable_set_supr {ι} {m : ι → measurable_space α} {s : set α} :
  @measurable_set _ (supr m) s ↔
    generate_measurable {s : set α | ∃ i, @measurable_set _ (m i) s} s :=
by simp only [supr, measurable_set_Sup, exists_range_iff]

end complete_lattice

end measurable_space

section measurable_functions
open measurable_space

/-- A function `f` between measurable spaces is measurable if the preimage of every
  measurable set is measurable. -/
def measurable [measurable_space α] [measurable_space β] (f : α → β) : Prop :=
∀ ⦃t : set β⦄, measurable_set t → measurable_set (f ⁻¹' t)

localized "notation `measurable[` m `]` := @measurable _ _ m _" in measure_theory

variables [measurable_space α] [measurable_space β] [measurable_space γ]

lemma measurable_id : measurable (@id α) := λ t, id

lemma measurable_id' : measurable (λ a : α, a) := measurable_id

lemma measurable.comp {α β γ} {mα : measurable_space α} {mβ : measurable_space β}
  {mγ : measurable_space γ} {g : β → γ} {f : α → β} (hg : measurable g) (hf : measurable f) :
  measurable (g ∘ f) :=
λ t ht, hf (hg ht)

@[simp] lemma measurable_const {a : α} : measurable (λ b : β, a) :=
assume s hs, measurable_set.const (a ∈ s)

lemma measurable.le {α} {m m0 : measurable_space α} (hm : m ≤ m0) {f : α → β}
  (hf : measurable[m] f) : measurable[m0] f :=
λ s hs, hm _ (hf hs)

end measurable_functions


import Aesop
import Mathlib.Algebra.IsPrimePow
import Mathlib.Data.Nat.ModEq
import Mathlib.Data.Nat.Prime
import Mathlib.Tactic.LibrarySearch
import Mathlib.Tactic.Ring

/-!
# International Mathematical Olympiad 1989, Problem 5

Prove that for each positive integer n there exist n consecutive positive
integers, none of which is an integral power of a prime number.
-/

namespace Imo1989Q5

lemma coprime_of_product (n : ℕ) (lst : List ℕ) (h : ∀ y ∈ lst, n.coprime y) :
    n.coprime lst.prod := by
  induction lst with
  | nil => simp
  | cons x xs ih =>
    have hy : ∀ (y : ℕ), y ∈ xs → Nat.coprime n y := by
      intro y hy
      aesop
    have h1 := h x (by simp)
    rw[List.prod_cons]
    exact Nat.coprime.mul_right h1 (ih hy)

lemma modulus_of_product {a b : ℕ} {xs : List ℕ}
    (h : a ≡ b [MOD xs.prod])
    (x : ℕ)
    (hx : x ∈ xs)
    : a ≡ b [MOD x] := by
  induction xs with
  | nil => aesop
  | cons y ys ih =>
    rw[ List.prod_cons] at h
    cases hx with
    | head => exact Nat.ModEq.of_mul_right _ h
    | tail w hw =>
      exact ih (Nat.ModEq.of_mul_left _ h) hw

structure ChinesePair where
  modulus : ℕ
  remainder : ℕ

lemma general_chinese_remainder (xs : List ChinesePair)
    (x_coprime : xs.Pairwise (fun x y ↦ Nat.coprime x.modulus y.modulus)) :
    ∃ m : ℕ, ∀ x ∈ xs, m ≡ x.remainder [MOD x.modulus] := by
  induction xs with
  | nil => use 0; simp only
  | cons x xs ih =>
    obtain ⟨b, hb⟩ := ih x_coprime.tail
    clear ih
    -- then we use Nat.chineseRemainder on x and ⟨List.prod(xs.map modulus), b⟩
    rw[List.pairwise_cons] at x_coprime
    -- need that `Nat.Coprime x.modulus y`
    have h1 := coprime_of_product x.modulus (xs.map (·.modulus))
      (by intros z hz; aesop)
    obtain ⟨k, hk1, hk2⟩ := Nat.chineseRemainder h1 x.remainder b
    use k
    intros z hz
    cases hz with
    | head => exact hk1
    | tail w hw =>
      have h2 := hb z hw
      have h3 : z.modulus ∈ (List.map (fun x => x.modulus) xs) := by aesop
      have h4 := modulus_of_product hk2 _ h3
      exact Nat.ModEq.trans h4 h2

#check Nat.exists_infinite_primes
#check List.maximum
#check WithBot

theorem get_primes (n : ℕ) :
    ∃ lst : List ℕ, lst.length = n ∧ lst.Nodup ∧ ∀ x ∈ lst, x.Prime := by
  induction n with
  | zero => use ∅; simp
  | succ n ih =>
    obtain ⟨l', hl', hlnd, hlp⟩ := ih
    have := l'.maximum
--    use (l'.maximum + 1)::l'
    sorry

theorem imo1989_q5 (n : ℕ) : ∃ m > 0, ∀ j < n, ¬IsPrimePow (m + j) := by
  -- (informal solution from https://artofproblemsolving.com)
  -- Let p₁,p₂,...pₙ,q₁,q₂,...,qₙ be distinct primes.
  -- By the Chinese Remainder theorem, there exists x such that
  --   x ≡ -1 mod p₁q₁
  --   x ≡ -2 mod p₂q₂
  --   ...
  --   x ≡ -n mod pₙqₙ
  -- The n consecutive numbers x+1, x+2, ..., x+n each have at least
  -- two prime factors, so none of them can be expressed as an integral
  -- power of a prime.
  sorry


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

! This file was ported from Lean 3 source module data.bitvec.basic
! leanprover-community/mathlib commit 008af8bb14b3ebef7e04ec3b0d63b947dee4d26a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Bitvec.Core
import Mathbin.Data.Fin.Basic
import Mathbin.Tactic.Monotonicity.Default
import Mathbin.Tactic.NormNum

namespace Bitvec

instance (n : ℕ) : Preorder (Bitvec n) :=
  Preorder.lift Bitvec.toNat

/-- convert `fin` to `bitvec` -/
def ofFin {n : ℕ} (i : Fin <| 2 ^ n) : Bitvec n :=
  Bitvec.ofNat _ i.val
#align bitvec.of_fin Bitvec.ofFin

theorem ofFin_val {n : ℕ} (i : Fin <| 2 ^ n) : (ofFin i).toNat = i.val := by
  rw [of_fin, to_nat_of_nat, Nat.mod_eq_of_lt] <;> apply i.is_lt
#align bitvec.of_fin_val Bitvec.ofFin_val

/-- convert `bitvec` to `fin` -/
def toFin {n : ℕ} (i : Bitvec n) : Fin <| 2 ^ n :=
  i.toNat
#align bitvec.to_fin Bitvec.toFin

theorem addLsb_eq_twice_add_one {x b} : addLsb x b = 2 * x + cond b 1 0 := by
  simp [add_lsb, two_mul]
#align bitvec.add_lsb_eq_twice_add_one Bitvec.addLsb_eq_twice_add_one

theorem toNat_eq_foldr_reverse {n : ℕ} (v : Bitvec n) :
    v.toNat = v.toList.reverse.foldr (flip addLsb) 0 := by rw [List.foldr_reverse, flip] <;> rfl
#align bitvec.to_nat_eq_foldr_reverse Bitvec.toNat_eq_foldr_reverse

theorem toNat_lt {n : ℕ} (v : Bitvec n) : v.toNat < 2 ^ n :=
  by
  suffices v.to_nat + 1 ≤ 2 ^ n by simpa
  rw [to_nat_eq_foldr_reverse]
  cases' v with xs h
  dsimp [Bitvec.toNat, bits_to_nat]
  rw [← List.length_reverse] at h
  generalize xs.reverse = ys at h⊢
  clear xs
  induction ys generalizing n
  · simp [← h]
  · simp only [← h, pow_add, flip, List.length, List.foldr, pow_one]
    rw [add_lsb_eq_twice_add_one]
    trans 2 * List.foldr (fun (x : Bool) (y : ℕ) => add_lsb y x) 0 ys_tl + 2 * 1
    · ac_mono
      rw [two_mul]
      mono
      cases ys_hd <;> simp
    · rw [← left_distrib]
      ac_mono
      exact ys_ih rfl
      norm_num
#align bitvec.to_nat_lt Bitvec.toNat_lt

theorem addLsb_div_two {x b} : addLsb x b / 2 = x := by
  cases b <;>
      simp only [Nat.add_mul_div_left, add_lsb, ← two_mul, add_comm, Nat.succ_pos',
        Nat.mul_div_right, gt_iff_lt, zero_add, cond] <;>
    norm_num
#align bitvec.add_lsb_div_two Bitvec.addLsb_div_two

theorem decide_addLsb_mod_two {x b} : decide (addLsb x b % 2 = 1) = b := by
  cases b <;>
      simp only [Bool.decide_iff, Nat.add_mul_mod_self_left, add_lsb, ← two_mul, add_comm,
        Bool.decide_False, Nat.mul_mod_right, zero_add, cond, zero_ne_one] <;>
    norm_num
#align bitvec.to_bool_add_lsb_mod_two Bitvec.decide_addLsb_mod_two

theorem ofNat_toNat {n : ℕ} (v : Bitvec n) : Bitvec.ofNat _ v.toNat = v :=
  by
  cases' v with xs h
  ext1
  change Vector.toList _ = xs
  dsimp [Bitvec.toNat, bits_to_nat]
  rw [← List.length_reverse] at h
  rw [← List.reverse_reverse xs, List.foldl_reverse]
  generalize xs.reverse = ys at h⊢; clear xs
  induction ys generalizing n
  · cases h
    simp [Bitvec.ofNat]
  · simp only [← Nat.succ_eq_add_one, List.length] at h
    subst n
    simp only [Bitvec.ofNat, Vector.toList_cons, Vector.toList_nil, List.reverse_cons,
      Vector.toList_append, List.foldr]
    erw [add_lsb_div_two, to_bool_add_lsb_mod_two]
    congr
    apply ys_ih
    rfl
#align bitvec.of_nat_to_nat Bitvec.ofNat_toNat

theorem toFin_val {n : ℕ} (v : Bitvec n) : (toFin v : ℕ) = v.toNat := by
  rw [to_fin, Fin.coe_ofNat_eq_mod, Nat.mod_eq_of_lt] <;> apply to_nat_lt
#align bitvec.to_fin_val Bitvec.toFin_val

theorem toFin_le_toFin_of_le {n} {v₀ v₁ : Bitvec n} (h : v₀ ≤ v₁) : v₀.toFin ≤ v₁.toFin :=
  show (v₀.toFin : ℕ) ≤ v₁.toFin by rw [to_fin_val, to_fin_val] <;> exact h
#align bitvec.to_fin_le_to_fin_of_le Bitvec.toFin_le_toFin_of_le

theorem ofFin_le_ofFin_of_le {n : ℕ} {i j : Fin (2 ^ n)} (h : i ≤ j) : ofFin i ≤ ofFin j :=
  show (Bitvec.ofNat n i).toNat ≤ (Bitvec.ofNat n j).toNat
    by
    simp only [to_nat_of_nat, Nat.mod_eq_of_lt, Fin.is_lt]
    exact h
#align bitvec.of_fin_le_of_fin_of_le Bitvec.ofFin_le_ofFin_of_le

theorem toFin_ofFin {n} (i : Fin <| 2 ^ n) : (ofFin i).toFin = i :=
  Fin.eq_of_veq (by simp [to_fin_val, of_fin, to_nat_of_nat, Nat.mod_eq_of_lt, i.is_lt])
#align bitvec.to_fin_of_fin Bitvec.toFin_ofFin

theorem ofFin_toFin {n} (v : Bitvec n) : ofFin (toFin v) = v := by
  dsimp [of_fin] <;> rw [to_fin_val, of_nat_to_nat]
#align bitvec.of_fin_to_fin Bitvec.ofFin_toFin

end Bitvec


/-
===================================================
Inductive types, functions, properties, and proofs.
====================================================
-/

/-
Simple inductive types.
-----------------------
-/

/-
1.

Define a new type called day having
these seven constant constructors:
sunday, monday, tuesday, wednesday,
thursday, friday, saturday. We will
interpret these constructors as
representing the actual days of the
week. Write your code below here now.
-/

inductive day : Type
| sunday
| monday
| tuesday
| wednesday
| thursday
| friday
| saturday

-- We suggest you open the day namespace

open day

/-
2.

Define a function, nextday : day → day,
that, when given a value, d : day, returns
the day value that represents the next day
of the week. Hint: either write a function
using a match d with ... end, or, if you
can use a tactic script (to write code!).
Use cases d and for each possible case of
d, specify the exact day to be returned in
that case. For extra credit do it both ways
and write a single sentence to describe how
these two representations correspond.
-/

def nextday (d : day) : day :=
begin
cases d,
exact monday,
exact tuesday,
exact wednesday,
exact thursday,
exact friday,
exact saturday,
exact sunday,
end

def nextday' (d : day) :=
match d with
| sunday := monday
| monday := tuesday
| tuesday := wednesday
| wednesday := thursday
| thursday := friday
| friday := saturday
| saturday := sunday
end

/-
3.

Formalize and prove the proposition that
for any day, d, if you apply nextday to d
then nextday to the result, seven times,
the result is that very same d.
-/

example : ∀ d : day,
nextday ( nextday ( nextday (nextday (nextday (nextday (nextday d)))))) = d :=
begin
assume d,
cases d,
repeat { apply rfl }, -- don't write it 7 times!
end

/-
Recursive (nested) inductive types.
-----------------------------------
-/

/-
4.

Give an inductive type definition for nat_list,
so that values of this type represent lists of
values of type ℕ.

While there's an infinity of such lists, we can
cleverly define the set inductively with just two
rules.

First, there is an empty list of natural numbers. We will represent it with the constant constructor,
nil_nat. Make it one of the nat_list constructors.

Second, if we are given a nat_list value, l, and
a ℕ value, e : ℕ, we can always construct a list
that is one longer than by prepending e to l. To
do this, define a constructor called nat_cons. It take arguments, e : ℕ and l : ₤st_nat, and yield a
nat_list.
-/

inductive nat_list : Type
| nat_nil : nat_list
| nat_cons : ℕ → nat_list → nat_list

-- we suggest you open the nat_list namespace

open nat_list

/-
5.

Define X to be the nat_list value that we
interpret as representing the empty list of
natural numbers, []; Y to be the nat_list
value that represents the list, [1]; and
finally Z to represent the list, [2, 1].
-/

def X := nat_nil
def Y := (nat_cons 1 nat_nil)
def Z := (nat_cons 2 Y)

/-
6.

Define a function (it will be recursive)
that takes any nat_list value and that
returns its length (a natural number that
indicates how many values are in the list).
Call the function, length.

The challenge is to see the recursion in
the definition of the length of a list.
Hint questions: What is the length of the
empty list? What is the length of a list
that is not empty, and that thus must be
of the form (nat_cons h t), where h is the
value at the head of the list and t is the
rest of the list.
-/

def length : nat_list → ℕ
| nat_nil := 0
| (nat_cons h t) := 1 + length t

/-
The stuff that follows is challenging
Get solid on the basic stuff before
going here.
-/

/-
7.

Define a function, app, that take two
nat_list values as arguments and that then
returns the nat_list that is the first one
followed by the second one. Let's call the
arguments l1 and l2.

Consider the possible forms of l1. It can
only be either nat_nil or (nat_cons h t),
where, once again, h would be the first
element in l1, and t would be the rest of
the list. Write the function recursively
accordingly.
-/

def app : nat_list → nat_list → nat_list
| nat_nil l2 := l2
| (nat_cons h t) l2 := nat_cons h (app t l2)

/-
8.

Prove the following

∀ l1 l2 : nat_list,
    (length l1 + length l2) = length (append l1 l2)

Hint: use proof by induction on l1. There will be
two cases. In the first, l1 will be nat_nil, and
its length will reduce directly to 0. In the second
case, you will show that the property is true for a
next bigger list: one in the form of (nat_cons h t).
-/

example : ∀ l1 l2 : nat_list,
            (length l1 + length l2) =
            length (app l1 l2) :=
begin
intros l1 l2,
induction l1 with l1' n h,
-- base case
-- simplify using rules in app and length defs
simp [app],
simp [length],

-- inductive case
-- simplify using app and length rules in one line
simp [app,length],

-- now use induction hypothesis to rewrite goal
rw <-h,

-- and the rest is simple arithmetic manipulation
simp,
--rw
end


/-
Copyright (c) 2020 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov
-/
import data.fin.basic
import data.list.sort
import data.list.duplicate

/-!
# Equivalence between `fin (length l)` and elements of a list

Given a list `l`,

* if `l` has no duplicates, then `list.nodup.nth_le_equiv` is the equivalence between
  `fin (length l)` and `{x // x ∈ l}` sending `⟨i, hi⟩` to `⟨nth_le l i hi, _⟩` with the inverse
  sending `⟨x, hx⟩` to `⟨index_of x l, _⟩`;

* if `l` has no duplicates and contains every element of a type `α`, then
  `list.nodup.nth_le_equiv_of_forall_mem_list` defines an equivalence between
  `fin (length l)` and `α`;  if `α` does not have decidable equality, then
  there is a bijection `list.nodup.nth_le_bijection_of_forall_mem_list`;

* if `l` is sorted w.r.t. `(<)`, then `list.sorted.nth_le_iso` is the same bijection reinterpreted
  as an `order_iso`.

-/

namespace list

variable {α : Type*}

namespace nodup

/-- If `l` lists all the elements of `α` without duplicates, then `list.nth_le` defines
a bijection `fin l.length → α`.  See `list.nodup.nth_le_equiv_of_forall_mem_list`
for a version giving an equivalence when there is decidable equality. -/
@[simps]
def nth_le_bijection_of_forall_mem_list (l : list α) (nd : l.nodup) (h : ∀ (x : α), x ∈ l) :
  {f : fin l.length → α // function.bijective f} :=
⟨λ i, l.nth_le i i.property, λ i j h, fin.ext $ (nd.nth_le_inj_iff _ _).1 h,
 λ x, let ⟨i, hi, hl⟩ := list.mem_iff_nth_le.1 (h x) in ⟨⟨i, hi⟩, hl⟩⟩

variable [decidable_eq α]

/-- If `l` has no duplicates, then `list.nth_le` defines an equivalence between `fin (length l)` and
the set of elements of `l`. -/
@[simps]
def nth_le_equiv (l : list α) (H : nodup l) : fin (length l) ≃ {x // x ∈ l} :=
{ to_fun := λ i, ⟨nth_le l i i.2, nth_le_mem l i i.2⟩,
  inv_fun := λ x, ⟨index_of ↑x l, index_of_lt_length.2 x.2⟩,
  left_inv := λ i, by simp [H],
  right_inv := λ x, by simp }

/-- If `l` lists all the elements of `α` without duplicates, then `list.nth_le` defines
an equivalence between `fin l.length` and `α`.

See `list.nodup.nth_le_bijection_of_forall_mem_list` for a version without
decidable equality. -/
@[simps]
def nth_le_equiv_of_forall_mem_list (l : list α) (nd : l.nodup) (h : ∀ (x : α), x ∈ l) :
  fin l.length ≃ α :=
{ to_fun := λ i, l.nth_le i i.2,
  inv_fun := λ a, ⟨_, index_of_lt_length.2 (h a)⟩,
  left_inv := λ i, by simp [nd],
  right_inv := λ a, by simp }

end nodup

namespace sorted

variables [preorder α] {l : list α}

lemma nth_le_mono (h : l.sorted (≤)) :
  monotone (λ i : fin l.length, l.nth_le i i.2) :=
λ i j, h.rel_nth_le_of_le _ _

lemma nth_le_strict_mono (h : l.sorted (<)) :
  strict_mono (λ i : fin l.length, l.nth_le i i.2) :=
λ i j, h.rel_nth_le_of_lt _ _

variable [decidable_eq α]

/-- If `l` is a list sorted w.r.t. `(<)`, then `list.nth_le` defines an order isomorphism between
`fin (length l)` and the set of elements of `l`. -/
def nth_le_iso (l : list α) (H : sorted (<) l) : fin (length l) ≃o {x // x ∈ l} :=
{ to_equiv := H.nodup.nth_le_equiv l,
  map_rel_iff' := λ i j, H.nth_le_strict_mono.le_iff_le }

variables (H : sorted (<) l) {x : {x // x ∈ l}} {i : fin l.length}

@[simp] lemma coe_nth_le_iso_apply : (H.nth_le_iso l i : α) = nth_le l i i.2 := rfl
@[simp] lemma coe_nth_le_iso_symm_apply : ((H.nth_le_iso l).symm x : ℕ) = index_of ↑x l := rfl

end sorted

section sublist

/--
If there is `f`, an order-preserving embedding of `ℕ` into `ℕ` such that
any element of `l` found at index `ix` can be found at index `f ix` in `l'`,
then `sublist l l'`.
-/

/--
A `l : list α` is `sublist l l'` for `l' : list α` iff
there is `f`, an order-preserving embedding of `ℕ` into `ℕ` such that
any element of `l` found at index `ix` can be found at index `f ix` in `l'`.
-/
lemma sublist_iff_exists_order_embedding_nth_eq {l l' : list α} :
  l <+ l' ↔ ∃ (f : ℕ ↪o ℕ), ∀ (ix : ℕ), l.nth ix = l'.nth (f ix) :=
begin
  split,
  { intro H,
    induction H with xs ys y H IH xs ys x H IH,
    { simp },
    { obtain ⟨f, hf⟩ := IH,
      refine ⟨f.trans (order_embedding.of_strict_mono (+ 1) (λ _, by simp)), _⟩,
      simpa using hf },
    { obtain ⟨f, hf⟩ := IH,
      refine ⟨order_embedding.of_map_le_iff
        (λ (ix : ℕ), if ix = 0 then 0 else (f ix.pred).succ) _, _⟩,
      { rintro ⟨_|a⟩ ⟨_|b⟩;
        simp [nat.succ_le_succ_iff] },
      { rintro ⟨_|i⟩,
        { simp },
        { simpa using hf _ } } } },
  { rintro ⟨f, hf⟩,
    exact sublist_of_order_embedding_nth_eq f hf }
end

/--
A `l : list α` is `sublist l l'` for `l' : list α` iff
there is `f`, an order-preserving embedding of `fin l.length` into `fin l'.length` such that
any element of `l` found at index `ix` can be found at index `f ix` in `l'`.
-/
lemma sublist_iff_exists_fin_order_embedding_nth_le_eq {l l' : list α} :
  l <+ l' ↔ ∃ (f : fin l.length ↪o fin l'.length),
    ∀ (ix : fin l.length), l.nth_le ix ix.is_lt = l'.nth_le (f ix) (f ix).is_lt :=
begin
  rw sublist_iff_exists_order_embedding_nth_eq,
  split,
  { rintro ⟨f, hf⟩,
    have h : ∀ {i : ℕ} (h : i < l.length), f i < l'.length,
    { intros i hi,
      specialize hf i,
      rw [nth_le_nth hi, eq_comm, nth_eq_some] at hf,
      obtain ⟨h, -⟩ := hf,
      exact h },
    refine ⟨order_embedding.of_map_le_iff (λ ix, ⟨f ix, h ix.is_lt⟩) _, _⟩,
    { simp },
    { intro i,
      apply option.some_injective,
      simpa [←nth_le_nth] using hf _ } },
  { rintro ⟨f, hf⟩,
    refine ⟨order_embedding.of_strict_mono
      (λ i, if hi : i < l.length then f ⟨i, hi⟩ else i + l'.length) _, _⟩,
    { intros i j h,
      dsimp only,
      split_ifs with hi hj hj hi,
      { simpa using h },
      { rw add_comm,
        exact lt_add_of_lt_of_pos (fin.is_lt _) (i.zero_le.trans_lt h) },
      { exact absurd (h.trans hj) hi },
      { simpa using h } },
    { intro i,
      simp only [order_embedding.coe_of_strict_mono],
      split_ifs with hi,
      { rw [nth_le_nth hi, nth_le_nth, ←hf],
        simp },
      { rw [nth_len_le, nth_len_le],
        { simp },
        { simpa using hi } } } }
end

/--
An element `x : α` of `l : list α` is a duplicate iff it can be found
at two distinct indices `n m : ℕ` inside the list `l`.
-/
lemma duplicate_iff_exists_distinct_nth_le {l : list α} {x : α} :
  l.duplicate x ↔ ∃ (n : ℕ) (hn : n < l.length) (m : ℕ) (hm : m < l.length) (h : n < m),
    x = l.nth_le n hn ∧ x = l.nth_le m hm :=
begin
  classical,
  rw [duplicate_iff_two_le_count, le_count_iff_repeat_sublist,
      sublist_iff_exists_fin_order_embedding_nth_le_eq],
  split,
  { rintro ⟨f, hf⟩,
    refine ⟨f ⟨0, by simp⟩, fin.is_lt _, f ⟨1, by simp⟩, fin.is_lt _, by simp, _, _⟩,
    { simpa using hf ⟨0, by simp⟩ },
    { simpa using hf ⟨1, by simp⟩ } },
  { rintro ⟨n, hn, m, hm, hnm, h, h'⟩,
    refine ⟨order_embedding.of_strict_mono (λ i, if (i : ℕ) = 0 then ⟨n, hn⟩ else ⟨m, hm⟩) _, _⟩,
    { rintros ⟨⟨_|i⟩, hi⟩ ⟨⟨_|j⟩, hj⟩,
      { simp },
      { simp [hnm] },
      { simp },
      { simp only [nat.lt_succ_iff, nat.succ_le_succ_iff, repeat, length, nonpos_iff_eq_zero]
          at hi hj,
        simp [hi, hj] } },
    { rintros ⟨⟨_|i⟩, hi⟩,
      { simpa using h },
      { simpa using h' } } }
end

end sublist

end list


/-
Copyright (c) 2021 Yakov Pechersky. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yakov Pechersky
-/
import data.fintype.card
import algebra.hom.commute
import algebra.big_operators.basic

/-!
# Products (respectively, sums) over a finset or a multiset.

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

The regular `finset.prod` and `multiset.prod` require `[comm_monoid α]`.
Often, there are collections `s : finset α` where `[monoid α]` and we know,
in a dependent fashion, that for all the terms `∀ (x ∈ s) (y ∈ s), commute x y`.
This allows to still have a well-defined product over `s`.

## Main definitions

- `finset.noncomm_prod`, requiring a proof of commutativity of held terms
- `multiset.noncomm_prod`, requiring a proof of commutativity of held terms

## Implementation details

While `list.prod` is defined via `list.foldl`, `noncomm_prod` is defined via
`multiset.foldr` for neater proofs and definitions. By the commutativity assumption,
the two must be equal.

-/

variables {F ι α β γ : Type*} (f : α → β → β) (op : α → α → α)

namespace multiset

/-- Fold of a `s : multiset α` with `f : α → β → β`, given a proof that `left_commutative f`
on all elements `x ∈ s`. -/
def noncomm_foldr (s : multiset α)
  (comm : {x | x ∈ s}.pairwise $ λ x y, ∀ b, f x (f y b) = f y (f x b)) (b : β) :
  β :=
s.attach.foldr (f ∘ subtype.val) (λ ⟨x, hx⟩ ⟨y, hy⟩, begin
    haveI : is_refl α (λ x y, ∀ b, f x (f y b) = f y (f x b)) := ⟨λ x b, rfl⟩,
    exact comm.of_refl hx hy,
  end) b

@[simp] lemma noncomm_foldr_coe (l : list α) (comm) (b : β) :
  noncomm_foldr f (l : multiset α) comm b = l.foldr f b :=
begin
  simp only [noncomm_foldr, coe_foldr, coe_attach, list.attach],
  rw ←list.foldr_map,
  simp [list.map_pmap, list.pmap_eq_map]
end

@[simp] lemma noncomm_foldr_empty (h) (b : β) : noncomm_foldr f (0 : multiset α) h b = b := rfl

lemma noncomm_foldr_cons (s : multiset α) (a : α) (h h') (b : β) :
  noncomm_foldr f (a ::ₘ s) h b = f a (noncomm_foldr f s h' b) :=
begin
  induction s using quotient.induction_on,
  simp
end

lemma noncomm_foldr_eq_foldr (s : multiset α) (h : left_commutative f) (b : β) :
  noncomm_foldr f s (λ x _ y _ _, h x y) b = foldr f h b s :=
begin
  induction s using quotient.induction_on,
  simp
end

variables [assoc : is_associative α op]
include assoc

/-- Fold of a `s : multiset α` with an associative `op : α → α → α`, given a proofs that `op`
is commutative on all elements `x ∈ s`. -/
def noncomm_fold (s : multiset α) (comm : {x | x ∈ s}.pairwise $ λ x y, op x y = op y x) : α → α :=
noncomm_foldr op s (λ x hx y hy h b, by rw [←assoc.assoc, comm hx hy h, assoc.assoc])

@[simp] lemma noncomm_fold_coe (l : list α) (comm) (a : α) :
  noncomm_fold op (l : multiset α) comm a = l.foldr op a :=
by simp [noncomm_fold]

@[simp] lemma noncomm_fold_empty (h) (a : α) : noncomm_fold op (0 : multiset α) h a = a := rfl

lemma noncomm_fold_cons (s : multiset α) (a : α) (h h') (x : α) :
  noncomm_fold op (a ::ₘ s) h x = op a (noncomm_fold op s h' x) :=
begin
  induction s using quotient.induction_on,
  simp
end

lemma noncomm_fold_eq_fold (s : multiset α) [is_commutative α op] (a : α) :
  noncomm_fold op s (λ x _ y _ _, is_commutative.comm x y) a = fold op a s :=
begin
  induction s using quotient.induction_on,
  simp
end

omit assoc
variables [monoid α] [monoid β]

/-- Product of a `s : multiset α` with `[monoid α]`, given a proof that `*` commutes
on all elements `x ∈ s`. -/
@[to_additive "Sum of a `s : multiset α` with `[add_monoid α]`, given a proof that `+` commutes
on all elements `x ∈ s`." ]
def noncomm_prod (s : multiset α) (comm : {x | x ∈ s}.pairwise commute) : α :=
s.noncomm_fold (*) comm 1

@[simp, to_additive] lemma noncomm_prod_coe (l : list α) (comm) :
  noncomm_prod (l : multiset α) comm = l.prod :=
begin
  rw [noncomm_prod],
  simp only [noncomm_fold_coe],
  induction l with hd tl hl,
  { simp },
  { rw [list.prod_cons, list.foldr, hl],
    intros x hx y hy,
    exact comm (list.mem_cons_of_mem _ hx) (list.mem_cons_of_mem _ hy) }
end

@[simp, to_additive] lemma noncomm_prod_empty (h) : noncomm_prod (0 : multiset α) h = 1 := rfl

@[simp, to_additive] lemma noncomm_prod_cons (s : multiset α) (a : α) (comm) :
  noncomm_prod (a ::ₘ s) comm = a * noncomm_prod s (comm.mono $ λ _, mem_cons_of_mem) :=
by { induction s using quotient.induction_on, simp }

@[to_additive] lemma noncomm_prod_cons' (s : multiset α) (a : α) (comm) :
  noncomm_prod (a ::ₘ s) comm = noncomm_prod s (comm.mono $ λ _, mem_cons_of_mem) * a :=
begin
  induction s using quotient.induction_on with s,
  simp only [quot_mk_to_coe, cons_coe, noncomm_prod_coe, list.prod_cons],
  induction s with hd tl IH,
  { simp },
  { rw [list.prod_cons, mul_assoc, ←IH, ←mul_assoc, ←mul_assoc],
    { congr' 1,
      apply comm.of_refl;
      simp },
    { intros x hx y hy,
      simp only [quot_mk_to_coe, list.mem_cons_iff, mem_coe, cons_coe] at hx hy,
      apply comm,
      { cases hx;
        simp [hx] },
      { cases hy;
        simp [hy] } } }
end

@[to_additive] lemma noncomm_prod_add (s t : multiset α) (comm) :
  noncomm_prod (s + t) comm =
  noncomm_prod s (comm.mono $ subset_of_le $ s.le_add_right t) *
  noncomm_prod t (comm.mono $ subset_of_le $ t.le_add_left s) :=
by { rcases s, rcases t, simp }

@[protected, to_additive]
lemma noncomm_prod_map_aux [monoid_hom_class F α β] (s : multiset α)
  (comm : {x | x ∈ s}.pairwise commute) (f : F) :
  {x | x ∈ s.map f}.pairwise commute :=
begin
  simp only [multiset.mem_map],
  rintros _ ⟨x, hx, rfl⟩ _ ⟨y, hy, rfl⟩ _,
  exact (comm.of_refl hx hy).map f,
end

@[to_additive]
lemma noncomm_prod_map [monoid_hom_class F α β] (s : multiset α) (comm) (f : F) :
  f (s.noncomm_prod comm) = (s.map f).noncomm_prod (noncomm_prod_map_aux s comm f) :=
begin
  induction s using quotient.induction_on,
  simpa using map_list_prod f _,
end

@[to_additive noncomm_sum_eq_card_nsmul]
lemma noncomm_prod_eq_pow_card (s : multiset α) (comm) (m : α) (h : ∀ x ∈ s, x = m) :
  s.noncomm_prod comm = m ^ s.card :=
begin
  induction s using quotient.induction_on,
  simp only [quot_mk_to_coe, noncomm_prod_coe, coe_card, mem_coe] at *,
  exact list.prod_eq_pow_card _ m h,
end

@[to_additive]

@[to_additive noncomm_sum_add_commute]
lemma noncomm_prod_commute (s : multiset α) (comm) (y : α) (h : ∀ x ∈ s, commute y x) :
  commute y (s.noncomm_prod comm) :=
begin
  induction s using quotient.induction_on,
  simp only [quot_mk_to_coe, noncomm_prod_coe],
  exact commute.list_prod_right _ _ h,
end

end multiset

namespace finset

variables [monoid β] [monoid γ]

/-- Product of a `s : finset α` mapped with `f : α → β` with `[monoid β]`,
given a proof that `*` commutes on all elements `f x` for `x ∈ s`. -/
@[to_additive "Sum of a `s : finset α` mapped with `f : α → β` with `[add_monoid β]`,
given a proof that `+` commutes on all elements `f x` for `x ∈ s`."]
def noncomm_prod (s : finset α) (f : α → β)
  (comm : (s : set α).pairwise (λ a b, commute (f a) (f b))) : β :=
(s.1.map f).noncomm_prod $
  by { simp_rw multiset.mem_map, rintro _ ⟨a, ha, rfl⟩ _ ⟨b, hb, rfl⟩ _, exact comm.of_refl ha hb }

@[congr, to_additive]
lemma noncomm_prod_congr {s₁ s₂ : finset α} {f g : α → β} (h₁ : s₁ = s₂)
  (h₂ : ∀ (x ∈ s₂), f x = g x) (comm) :
  noncomm_prod s₁ f comm = noncomm_prod s₂ g
    (λ x hx y hy h, by { rw [←h₂ _ hx, ←h₂ _ hy], subst h₁, exact comm hx hy h }) :=
by simp_rw [noncomm_prod, multiset.map_congr (congr_arg _ h₁) h₂]

@[simp, to_additive] lemma noncomm_prod_to_finset [decidable_eq α] (l : list α) (f : α → β) (comm)
  (hl : l.nodup) :
  noncomm_prod l.to_finset f comm = (l.map f).prod :=
begin
  rw ←list.dedup_eq_self at hl,
  simp [noncomm_prod, hl]
end

@[simp, to_additive] lemma noncomm_prod_empty (f : α → β) (h) :
  noncomm_prod (∅ : finset α) f h = 1 := rfl

@[simp, to_additive] lemma noncomm_prod_insert_of_not_mem [decidable_eq α] (s : finset α) (a : α)
  (f : α → β) (comm) (ha : a ∉ s) :
  noncomm_prod (insert a s) f comm = f a * noncomm_prod s f (comm.mono $ λ _, mem_insert_of_mem) :=
by simp [insert_val_of_not_mem ha, noncomm_prod]

@[to_additive] lemma noncomm_prod_insert_of_not_mem' [decidable_eq α] (s : finset α) (a : α)
  (f : α → β) (comm) (ha : a ∉ s) :
  noncomm_prod (insert a s) f comm = noncomm_prod s f (comm.mono $ λ _, mem_insert_of_mem) * f a :=
by simp [noncomm_prod, insert_val_of_not_mem ha, multiset.noncomm_prod_cons']

@[simp, to_additive] lemma noncomm_prod_singleton (a : α) (f : α → β) :
  noncomm_prod ({a} : finset α) f (by { norm_cast, exact set.pairwise_singleton _ _ }) = f a :=
by simp [noncomm_prod, ←multiset.cons_zero]

@[to_additive]
lemma noncomm_prod_map [monoid_hom_class F β γ] (s : finset α) (f : α → β) (comm) (g : F) :
  g (s.noncomm_prod f comm) = s.noncomm_prod (λ i, g (f i))
  (λ x hx y hy h, (comm.of_refl hx hy).map g)  :=
by simp [noncomm_prod, multiset.noncomm_prod_map]

@[to_additive noncomm_sum_eq_card_nsmul]
lemma noncomm_prod_eq_pow_card (s : finset α) (f : α → β) (comm) (m : β) (h : ∀ x ∈ s, f x = m) :
  s.noncomm_prod f comm = m ^ s.card :=
begin
  rw [noncomm_prod, multiset.noncomm_prod_eq_pow_card _ _ m],
  simp only [finset.card_def, multiset.card_map],
  simpa using h,
end

@[to_additive noncomm_sum_add_commute]
lemma noncomm_prod_commute (s : finset α) (f : α → β) (comm) (y : β)
  (h : ∀ x ∈ s, commute y (f x)) : commute y (s.noncomm_prod f comm) :=
begin
  apply multiset.noncomm_prod_commute,
  intro y,
  rw multiset.mem_map,
  rintros ⟨x, ⟨hx, rfl⟩⟩,
  exact h x hx,
end

@[to_additive] lemma noncomm_prod_eq_prod {β : Type*} [comm_monoid β] (s : finset α) (f : α → β) :
  noncomm_prod s f (λ _ _ _ _ _, commute.all _ _) = s.prod f :=
begin
  classical,
  induction s using finset.induction_on with a s ha IH,
  { simp },
  { simp [ha, IH] }
end

/-- The non-commutative version of `finset.prod_union` -/
@[to_additive "The non-commutative version of `finset.sum_union`"]
lemma noncomm_prod_union_of_disjoint [decidable_eq α] {s t : finset α}
  (h : disjoint s t) (f : α → β) (comm : {x | x ∈ s ∪ t}.pairwise $ λ a b, commute (f a) (f b)) :
  noncomm_prod (s ∪ t) f comm = noncomm_prod s f (comm.mono $ coe_subset.2 $ subset_union_left _ _)
    * noncomm_prod t f (comm.mono $ coe_subset.2 $ subset_union_right _ _) :=
begin
  obtain ⟨sl, sl', rfl⟩ := exists_list_nodup_eq s,
  obtain ⟨tl, tl', rfl⟩ := exists_list_nodup_eq t,
  rw list.disjoint_to_finset_iff_disjoint at h,
  simp [sl', tl', noncomm_prod_to_finset, ←list.prod_append, ←list.to_finset_append,
    sl'.append tl' h]
end

@[protected, to_additive]
lemma noncomm_prod_mul_distrib_aux {s : finset α} {f : α → β} {g : α → β}
  (comm_ff : (s : set α).pairwise $ λ x y, commute (f x) (f y))
  (comm_gg : (s : set α).pairwise $ λ x y, commute (g x) (g y))
  (comm_gf : (s : set α).pairwise $ λ x y, commute (g x) (f y)) :
  (s : set α).pairwise $ λ x y, commute ((f * g) x) ((f * g) y) :=
begin
  intros x hx y hy h,
  apply commute.mul_left; apply commute.mul_right,
  { exact comm_ff.of_refl hx hy },
  { exact (comm_gf hy hx h.symm).symm },
  { exact comm_gf hx hy h },
  { exact comm_gg.of_refl hx hy }
end

/-- The non-commutative version of `finset.prod_mul_distrib` -/
@[to_additive "The non-commutative version of `finset.sum_add_distrib`"]
lemma noncomm_prod_mul_distrib {s : finset α} (f : α → β) (g : α → β) (comm_ff comm_gg comm_gf) :
  noncomm_prod s (f * g) (noncomm_prod_mul_distrib_aux comm_ff comm_gg comm_gf)
    = noncomm_prod s f comm_ff * noncomm_prod s g comm_gg :=
begin
  classical,
  induction s using finset.induction_on with x s hnmem ih,
  { simp, },
  simp only [finset.noncomm_prod_insert_of_not_mem _ _ _ _ hnmem],
  specialize ih (comm_ff.mono $ λ _, mem_insert_of_mem) (comm_gg.mono $ λ _, mem_insert_of_mem)
    (comm_gf.mono $ λ _, mem_insert_of_mem),
  rw [ih, pi.mul_apply],
  simp only [mul_assoc],
  congr' 1,
  simp only [← mul_assoc],
  congr' 1,
  refine noncomm_prod_commute _ _ _ _ (λ y hy, _),
  exact comm_gf (mem_insert_self x s) (mem_insert_of_mem hy) (ne_of_mem_of_not_mem hy hnmem).symm,
end

section finite_pi
variables {M : ι → Type*} [Π i, monoid (M i)]

@[to_additive]
lemma noncomm_prod_mul_single [fintype ι] [decidable_eq ι] (x : Π i, M i) :
  univ.noncomm_prod (λ i, pi.mul_single i (x i)) (λ i _ j _ _, pi.mul_single_apply_commute x i j)
  = x :=
begin
  ext i,
  apply (univ.noncomm_prod_map (λ i, monoid_hom.single M i (x i)) _
    (pi.eval_monoid_hom M i)).trans,
  rw [ ← insert_erase (mem_univ i),
    noncomm_prod_insert_of_not_mem' _ _ _ _ (not_mem_erase _ _),
    noncomm_prod_eq_pow_card,
    one_pow],
  { simp, },
  { intros i h, simp at h, simp [h], },
end

@[to_additive]
lemma _root_.monoid_hom.pi_ext [finite ι] [decidable_eq ι] {f g : (Π i, M i) →* γ}
  (h : ∀ i x, f (pi.mul_single i x) = g (pi.mul_single i x)) :
  f = g :=
begin
  casesI nonempty_fintype ι,
  ext x,
  rw [← noncomm_prod_mul_single x, univ.noncomm_prod_map, univ.noncomm_prod_map],
  congr' 1 with i, exact h i (x i),
end

end finite_pi

end finset


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

! This file was ported from Lean 3 source module algebra.gcd_monoid.multiset
! 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.Algebra.GCDMonoid.Basic
import Mathlib.Data.Multiset.FinsetOps
import Mathlib.Data.Multiset.Fold

/-!
# GCD and LCM operations on multisets

## Main definitions

- `Multiset.gcd` - the greatest common denominator of a `Multiset` of elements of a `GCDMonoid`
- `Multiset.lcm` - the least common multiple of a `Multiset` of elements of a `GCDMonoid`

## Implementation notes

TODO: simplify with a tactic and `Data.Multiset.Lattice`

## Tags

multiset, gcd
-/

namespace Multiset

variable {α : Type _} [CancelCommMonoidWithZero α] [NormalizedGCDMonoid α]

/-! ### LCM -/

section lcm

/-- Least common multiple of a multiset -/
def lcm (s : Multiset α) : α :=
  s.fold GCDMonoid.lcm 1
#align multiset.lcm Multiset.lcm

@[simp]
theorem lcm_zero : (0 : Multiset α).lcm = 1 :=
  fold_zero _ _
#align multiset.lcm_zero Multiset.lcm_zero

@[simp]
theorem lcm_cons (a : α) (s : Multiset α) : (a ::ₘ s).lcm = GCDMonoid.lcm a s.lcm :=
  fold_cons_left _ _ _ _
#align multiset.lcm_cons Multiset.lcm_cons

@[simp]
theorem lcm_singleton {a : α} : ({a} : Multiset α).lcm = normalize a :=
  (fold_singleton _ _ _).trans <| lcm_one_right _
#align multiset.lcm_singleton Multiset.lcm_singleton

@[simp]
theorem lcm_add (s₁ s₂ : Multiset α) : (s₁ + s₂).lcm = GCDMonoid.lcm s₁.lcm s₂.lcm :=
  Eq.trans (by simp [lcm]) (fold_add _ _ _ _ _)
#align multiset.lcm_add Multiset.lcm_add

theorem lcm_dvd {s : Multiset α} {a : α} : s.lcm ∣ a ↔ ∀ b ∈ s, b ∣ a :=
  Multiset.induction_on s (by simp)
    (by simp (config := { contextual := true }) [or_imp, forall_and, lcm_dvd_iff])
#align multiset.lcm_dvd Multiset.lcm_dvd

theorem dvd_lcm {s : Multiset α} {a : α} (h : a ∈ s) : a ∣ s.lcm :=
  lcm_dvd.1 dvd_rfl _ h
#align multiset.dvd_lcm Multiset.dvd_lcm

theorem lcm_mono {s₁ s₂ : Multiset α} (h : s₁ ⊆ s₂) : s₁.lcm ∣ s₂.lcm :=
  lcm_dvd.2 fun _ hb ↦ dvd_lcm (h hb)
#align multiset.lcm_mono Multiset.lcm_mono

/- Porting note: Following `Algebra.GCDMonoid.Basic`'s version of `normalize_gcd`, I'm giving
this lower priority to avoid linter complaints about simp-normal form -/
/- Porting note: Mathport seems to be replacing `Multiset.induction_on s $` with
`(Multiset.induction_on s)`, when it should be `Multiset.induction_on s <|`. -/
@[simp 1100]
theorem normalize_lcm (s : Multiset α) : normalize s.lcm = s.lcm :=
  Multiset.induction_on s (by simp) <| fun a s _ ↦ by simp
#align multiset.normalize_lcm Multiset.normalize_lcm

@[simp]
nonrec theorem lcm_eq_zero_iff [Nontrivial α] (s : Multiset α) : s.lcm = 0 ↔ (0 : α) ∈ s := by
  induction' s using Multiset.induction_on with a s ihs
  · simp only [lcm_zero, one_ne_zero, not_mem_zero]
  · simp only [mem_cons, lcm_cons, lcm_eq_zero_iff, ihs, @eq_comm _ a]
#align multiset.lcm_eq_zero_iff Multiset.lcm_eq_zero_iff

variable [DecidableEq α]

@[simp]
theorem lcm_dedup (s : Multiset α) : (dedup s).lcm = s.lcm :=
  Multiset.induction_on s (by simp) <| fun a s IH ↦ by
    by_cases h : a ∈ s <;> simp [IH, h]
    unfold lcm
    rw [← cons_erase h, fold_cons_left, ← lcm_assoc, lcm_same]
    apply lcm_eq_of_associated_left (associated_normalize _)
#align multiset.lcm_dedup Multiset.lcm_dedup

@[simp]
theorem lcm_ndunion (s₁ s₂ : Multiset α) : (ndunion s₁ s₂).lcm = GCDMonoid.lcm s₁.lcm s₂.lcm := by
  rw [← lcm_dedup, dedup_ext.2, lcm_dedup, lcm_add]
  simp
#align multiset.lcm_ndunion Multiset.lcm_ndunion

@[simp]
theorem lcm_union (s₁ s₂ : Multiset α) : (s₁ ∪ s₂).lcm = GCDMonoid.lcm s₁.lcm s₂.lcm := by
  rw [← lcm_dedup, dedup_ext.2, lcm_dedup, lcm_add]
  simp
#align multiset.lcm_union Multiset.lcm_union

@[simp]
theorem lcm_ndinsert (a : α) (s : Multiset α) : (ndinsert a s).lcm = GCDMonoid.lcm a s.lcm := by
  rw [← lcm_dedup, dedup_ext.2, lcm_dedup, lcm_cons]
  simp
#align multiset.lcm_ndinsert Multiset.lcm_ndinsert

end lcm

/-! ### GCD -/

section gcd

/-- Greatest common divisor of a multiset -/
def gcd (s : Multiset α) : α :=
  s.fold GCDMonoid.gcd 0
#align multiset.gcd Multiset.gcd

@[simp]
theorem gcd_zero : (0 : Multiset α).gcd = 0 :=
  fold_zero _ _
#align multiset.gcd_zero Multiset.gcd_zero

@[simp]
theorem gcd_cons (a : α) (s : Multiset α) : (a ::ₘ s).gcd = GCDMonoid.gcd a s.gcd :=
  fold_cons_left _ _ _ _
#align multiset.gcd_cons Multiset.gcd_cons

@[simp]
theorem gcd_singleton {a : α} : ({a} : Multiset α).gcd = normalize a :=
  (fold_singleton _ _ _).trans <| gcd_zero_right _
#align multiset.gcd_singleton Multiset.gcd_singleton

@[simp]
theorem gcd_add (s₁ s₂ : Multiset α) : (s₁ + s₂).gcd = GCDMonoid.gcd s₁.gcd s₂.gcd :=
  Eq.trans (by simp [gcd]) (fold_add _ _ _ _ _)
#align multiset.gcd_add Multiset.gcd_add

theorem dvd_gcd {s : Multiset α} {a : α} : a ∣ s.gcd ↔ ∀ b ∈ s, a ∣ b :=
  Multiset.induction_on s (by simp)
    (by simp (config := { contextual := true }) [or_imp, forall_and, dvd_gcd_iff])
#align multiset.dvd_gcd Multiset.dvd_gcd

theorem gcd_dvd {s : Multiset α} {a : α} (h : a ∈ s) : s.gcd ∣ a :=
  dvd_gcd.1 dvd_rfl _ h
#align multiset.gcd_dvd Multiset.gcd_dvd

theorem gcd_mono {s₁ s₂ : Multiset α} (h : s₁ ⊆ s₂) : s₂.gcd ∣ s₁.gcd :=
  dvd_gcd.2 fun _ hb ↦ gcd_dvd (h hb)
#align multiset.gcd_mono Multiset.gcd_mono

/- Porting note: Following `Algebra.GCDMonoid.Basic`'s version of `normalize_gcd`, I'm giving
this lower priority to avoid linter complaints about simp-normal form -/
@[simp 1100]
theorem normalize_gcd (s : Multiset α) : normalize s.gcd = s.gcd :=
  Multiset.induction_on s (by simp) <| fun a s _ ↦ by simp
#align multiset.normalize_gcd Multiset.normalize_gcd

theorem gcd_eq_zero_iff (s : Multiset α) : s.gcd = 0 ↔ ∀ x : α, x ∈ s → x = 0 := by
  constructor
  · intro h x hx
    apply eq_zero_of_zero_dvd
    rw [← h]
    apply gcd_dvd hx
  · refine' s.induction_on _ _
    · simp
    intro a s sgcd h
    simp [h a (mem_cons_self a s), sgcd fun x hx ↦ h x (mem_cons_of_mem hx)]
#align multiset.gcd_eq_zero_iff Multiset.gcd_eq_zero_iff

theorem gcd_map_mul (a : α) (s : Multiset α) : (s.map ((· * ·) a)).gcd = normalize a * s.gcd := by
  refine' s.induction_on _ fun b s ih ↦ _
  · simp_rw [map_zero, gcd_zero, mul_zero]
  · simp_rw [map_cons, gcd_cons, ← gcd_mul_left]
    rw [ih]
    apply ((normalize_associated a).mul_right _).gcd_eq_right
#align multiset.gcd_map_mul Multiset.gcd_map_mul

section

variable [DecidableEq α]

@[simp]
theorem gcd_dedup (s : Multiset α) : (dedup s).gcd = s.gcd :=
  Multiset.induction_on s (by simp) <| fun a s IH ↦ by
    by_cases h : a ∈ s <;> simp [IH, h]
    unfold gcd
    rw [← cons_erase h, fold_cons_left, ← gcd_assoc, gcd_same]
    apply (associated_normalize _).gcd_eq_left
#align multiset.gcd_dedup Multiset.gcd_dedup

@[simp]
theorem gcd_ndunion (s₁ s₂ : Multiset α) : (ndunion s₁ s₂).gcd = GCDMonoid.gcd s₁.gcd s₂.gcd := by
  rw [← gcd_dedup, dedup_ext.2, gcd_dedup, gcd_add]
  simp
#align multiset.gcd_ndunion Multiset.gcd_ndunion

@[simp]
theorem gcd_union (s₁ s₂ : Multiset α) : (s₁ ∪ s₂).gcd = GCDMonoid.gcd s₁.gcd s₂.gcd := by
  rw [← gcd_dedup, dedup_ext.2, gcd_dedup, gcd_add]
  simp
#align multiset.gcd_union Multiset.gcd_union

@[simp]

end

theorem extract_gcd' (s t : Multiset α) (hs : ∃ x, x ∈ s ∧ x ≠ (0 : α))
    (ht : s = t.map ((· * ·) s.gcd)) : t.gcd = 1 :=
  ((@mul_right_eq_self₀ _ _ s.gcd _).1 <| by
        conv_lhs => rw [← normalize_gcd, ← gcd_map_mul, ← ht]).resolve_right <| by
    contrapose! hs
    exact s.gcd_eq_zero_iff.1 hs
#align multiset.extract_gcd' Multiset.extract_gcd'

/- Porting note: Deprecated lemmas like `map_repeat` and `eq_repeat` weren't "officially"
converted to `Multiset.replicate` format yet, so I made some ad hoc ones in `Data.Multiset.Basic`
using the originals. -/
/- Porting note: The old proof used a strange form
`have := _, refine ⟨s.pmap @f (λ _, id), this, extract_gcd' s _ h this⟩,`
so I rearranged the proof slightly. -/
theorem extract_gcd (s : Multiset α) (hs : s ≠ 0) :
    ∃ t : Multiset α, s = t.map ((· * ·) s.gcd) ∧ t.gcd = 1 := by
  classical
    by_cases h : ∀ x ∈ s, x = (0 : α)
    · use replicate (card s) 1
      simp only
      rw [map_replicate, eq_replicate, mul_one, s.gcd_eq_zero_iff.2 h, ← nsmul_singleton,
    ← gcd_dedup, dedup_nsmul (card_pos.2 hs).ne', dedup_singleton, gcd_singleton]
      exact ⟨⟨rfl, h⟩, normalize_one⟩
    · choose f hf using @gcd_dvd _ _ _ s
      push_neg  at h
      refine' ⟨s.pmap @f fun _ ↦ id, _, extract_gcd' s _ h _⟩ <;>
      · rw [map_pmap]
        conv_lhs => rw [← s.map_id, ← s.pmap_eq_map _ _ fun _ ↦ id]
        congr with (x hx)
        simp only
        rw [id]
        rw [← hf hx]
#align multiset.extract_gcd Multiset.extract_gcd

end gcd

end Multiset


/-
Copyright (c) 2017 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Neil Strickland
-/
import data.nat.prime
import data.pnat.basic

/-!
# Primality and GCD on pnat

This file extends the theory of `ℕ+` with `gcd`, `lcm` and `prime` functions, analogous to those on
`nat`.
-/

namespace nat.primes

instance coe_pnat : has_coe nat.primes ℕ+ := ⟨λ p, ⟨(p : ℕ), p.property.pos⟩⟩
theorem coe_pnat_nat (p : nat.primes) : ((p : ℕ+) : ℕ) = p := rfl

theorem coe_pnat_inj (p q : nat.primes) : (p : ℕ+) = (q : ℕ+) → p = q := λ h,
begin
  replace h : ((p : ℕ+) : ℕ) = ((q : ℕ+) : ℕ) := congr_arg subtype.val h,
  rw [coe_pnat_nat, coe_pnat_nat] at h,
  exact subtype.eq h,
end

end nat.primes

namespace pnat
open nat

/-- The greatest common divisor (gcd) of two positive natural numbers,
  viewed as positive natural number. -/
def gcd (n m : ℕ+) : ℕ+ :=
 ⟨nat.gcd (n : ℕ) (m : ℕ), nat.gcd_pos_of_pos_left (m : ℕ) n.pos⟩

/-- The least common multiple (lcm) of two positive natural numbers,
  viewed as positive natural number. -/
def lcm (n m : ℕ+) : ℕ+ :=
 ⟨nat.lcm (n : ℕ) (m : ℕ),
  by { let h := mul_pos n.pos m.pos,
       rw [← gcd_mul_lcm (n : ℕ) (m : ℕ), mul_comm] at h,
       exact pos_of_dvd_of_pos (dvd.intro (nat.gcd (n : ℕ) (m : ℕ)) rfl) h }⟩

@[simp] theorem gcd_coe (n m : ℕ+) : ((gcd n m) : ℕ) = nat.gcd n m := rfl

@[simp] theorem lcm_coe (n m : ℕ+) : ((lcm n m) : ℕ) = nat.lcm n m := rfl

theorem gcd_dvd_left (n m : ℕ+) : (gcd n m) ∣ n := dvd_iff.2 (nat.gcd_dvd_left (n : ℕ) (m : ℕ))

theorem gcd_dvd_right (n m : ℕ+) : (gcd n m) ∣ m := dvd_iff.2 (nat.gcd_dvd_right (n : ℕ) (m : ℕ))

theorem dvd_gcd {m n k : ℕ+} (hm : k ∣ m) (hn : k ∣ n) : k ∣ gcd m n :=
 dvd_iff.2 (@nat.dvd_gcd (m : ℕ) (n : ℕ) (k : ℕ) (dvd_iff.1 hm) (dvd_iff.1 hn))

theorem dvd_lcm_left  (n m : ℕ+) : n ∣ lcm n m := dvd_iff.2 (nat.dvd_lcm_left  (n : ℕ) (m : ℕ))

theorem dvd_lcm_right (n m : ℕ+) : m ∣ lcm n m := dvd_iff.2 (nat.dvd_lcm_right (n : ℕ) (m : ℕ))

theorem lcm_dvd {m n k : ℕ+} (hm : m ∣ k) (hn : n ∣ k) : lcm m n ∣ k :=
  dvd_iff.2 (@nat.lcm_dvd (m : ℕ) (n : ℕ) (k : ℕ) (dvd_iff.1 hm) (dvd_iff.1 hn))

theorem gcd_mul_lcm (n m : ℕ+) : (gcd n m) * (lcm n m) = n * m :=
 subtype.eq (nat.gcd_mul_lcm (n : ℕ) (m : ℕ))

lemma eq_one_of_lt_two {n : ℕ+} : n < 2 → n = 1 :=
begin
  intro h, apply le_antisymm, swap, apply pnat.one_le,
  change n < 1 + 1 at h, rw pnat.lt_add_one_iff at h, apply h
end

section prime
/-! ### Prime numbers -/

/-- Primality predicate for `ℕ+`, defined in terms of `nat.prime`. -/
def prime (p : ℕ+) : Prop := (p : ℕ).prime

lemma prime.one_lt {p : ℕ+} : p.prime → 1 < p := nat.prime.one_lt

lemma prime_two : (2 : ℕ+).prime := nat.prime_two

lemma dvd_prime {p m : ℕ+} (pp : p.prime) :
(m ∣ p ↔ m = 1 ∨ m = p) := by { rw pnat.dvd_iff, rw nat.dvd_prime pp, simp }

lemma prime.ne_one {p : ℕ+} : p.prime → p ≠ 1 :=
by { intro pp, intro contra, apply nat.prime.ne_one pp, rw pnat.coe_eq_one_iff, apply contra }

@[simp]
lemma not_prime_one : ¬ (1: ℕ+).prime :=  nat.not_prime_one

lemma prime.not_dvd_one {p : ℕ+} :
p.prime →  ¬ p ∣ 1 := λ pp : p.prime, by {rw dvd_iff, apply nat.prime.not_dvd_one pp}

lemma exists_prime_and_dvd {n : ℕ+} : 2 ≤ n → (∃ (p : ℕ+), p.prime ∧ p ∣ n) :=
begin
  intro h, cases nat.exists_prime_and_dvd h with p hp,
  existsi (⟨p, nat.prime.pos hp.left⟩ : ℕ+), rw dvd_iff, apply hp
end

end prime

section coprime
/-! ### Coprime numbers and gcd -/

/-- Two pnats are coprime if their gcd is 1. -/
def coprime (m n : ℕ+) : Prop := m.gcd n = 1

@[simp]
lemma coprime_coe {m n : ℕ+} : nat.coprime ↑m ↑n ↔ m.coprime n :=
by { unfold coprime, unfold nat.coprime, rw ← coe_inj, simp }

lemma coprime.mul {k m n : ℕ+} : m.coprime k → n.coprime k → (m * n).coprime k :=
by { repeat {rw ← coprime_coe}, rw mul_coe, apply nat.coprime.mul }

lemma coprime.mul_right {k m n : ℕ+} : k.coprime m → k.coprime n → k.coprime (m * n) :=
by { repeat {rw ← coprime_coe}, rw mul_coe, apply nat.coprime.mul_right }

lemma gcd_comm {m n : ℕ+} : m.gcd n = n.gcd m :=
by { apply eq, simp only [gcd_coe], apply nat.gcd_comm }

lemma gcd_eq_left_iff_dvd {m n : ℕ+} : m ∣ n ↔ m.gcd n = m :=
by { rw dvd_iff, rw nat.gcd_eq_left_iff_dvd, rw ← coe_inj, simp }

lemma gcd_eq_right_iff_dvd {m n : ℕ+} : m ∣ n ↔ n.gcd m = m :=
by { rw gcd_comm, apply gcd_eq_left_iff_dvd, }

lemma coprime.gcd_mul_left_cancel (m : ℕ+) {n k : ℕ+} :
  k.coprime n → (k * m).gcd n = m.gcd n :=
begin
  intro h, apply eq, simp only [gcd_coe, mul_coe],
  apply nat.coprime.gcd_mul_left_cancel, simpa
end

lemma coprime.gcd_mul_right_cancel (m : ℕ+) {n k : ℕ+} :
  k.coprime n → (m * k).gcd n = m.gcd n :=
begin
  rw mul_comm, apply coprime.gcd_mul_left_cancel,
end

lemma coprime.gcd_mul_left_cancel_right (m : ℕ+) {n k : ℕ+} :
  k.coprime m → m.gcd (k * n) = m.gcd n :=
begin
  intro h, iterate 2 {rw gcd_comm, symmetry}, apply coprime.gcd_mul_left_cancel _ h,
end

lemma coprime.gcd_mul_right_cancel_right (m : ℕ+) {n k : ℕ+} :
  k.coprime m → m.gcd (n * k) = m.gcd n :=
begin
  rw mul_comm, apply coprime.gcd_mul_left_cancel_right,
end

@[simp]
lemma one_gcd {n : ℕ+} : gcd 1 n = 1 :=
by { rw ← gcd_eq_left_iff_dvd, apply one_dvd }

@[simp]

@[symm]
lemma coprime.symm {m n : ℕ+} : m.coprime n → n.coprime m :=
by { unfold coprime, rw gcd_comm, simp }

@[simp]
lemma one_coprime {n : ℕ+} : (1 : ℕ+).coprime n := one_gcd

@[simp]
lemma coprime_one {n : ℕ+} : n.coprime 1 := coprime.symm one_coprime

lemma coprime.coprime_dvd_left {m k n : ℕ+} :
  m ∣ k → k.coprime n → m.coprime n :=
by { rw dvd_iff, repeat {rw ← coprime_coe}, apply nat.coprime.coprime_dvd_left }

lemma coprime.factor_eq_gcd_left {a b m n : ℕ+} (cop : m.coprime n) (am : a ∣ m) (bn : b ∣ n) :
  a = (a * b).gcd m :=
begin
  rw gcd_eq_left_iff_dvd at am,
  conv_lhs {rw ← am}, symmetry,
  apply coprime.gcd_mul_right_cancel a,
  apply coprime.coprime_dvd_left bn cop.symm,
end

lemma coprime.factor_eq_gcd_right {a b m n : ℕ+} (cop : m.coprime n) (am : a ∣ m) (bn : b ∣ n) :
  a = (b * a).gcd m :=
begin
  rw mul_comm, apply coprime.factor_eq_gcd_left cop am bn,
end

lemma coprime.factor_eq_gcd_left_right {a b m n : ℕ+}
  (cop : m.coprime n) (am : a ∣ m) (bn : b ∣ n) : a = m.gcd (a * b) :=
begin
  rw gcd_comm, apply coprime.factor_eq_gcd_left cop am bn,
end

lemma coprime.factor_eq_gcd_right_right {a b m n : ℕ+}
  (cop : m.coprime n) (am : a ∣ m) (bn : b ∣ n) : a = m.gcd (b * a) :=
begin
  rw gcd_comm, apply coprime.factor_eq_gcd_right cop am bn,
end

lemma coprime.gcd_mul (k : ℕ+) {m n : ℕ+} (h: m.coprime n) :
  k.gcd (m * n) = k.gcd m * k.gcd n :=
begin
  rw ← coprime_coe at h, apply eq,
  simp only [gcd_coe, mul_coe], apply nat.coprime.gcd_mul k h
end

lemma gcd_eq_left {m n : ℕ+} : m ∣ n → m.gcd n = m :=
by { rw dvd_iff, intro h, apply eq, simp only [gcd_coe], apply nat.gcd_eq_left h }

lemma coprime.pow {m n : ℕ+} (k l : ℕ) (h : m.coprime n) : (m ^ k).coprime (n ^ l) :=
begin
  rw ← coprime_coe at *, simp only [pow_coe], apply nat.coprime.pow, apply h
end

end coprime

end pnat


-- Límite exponencial
-- ==================

-- ----------------------------------------------------
-- Ejercicio. Demostrar que si C > 0, entonces
--    lim (C^(1/n)) = 1
-- ----------------------------------------------------

import analysis.special_functions.pow

lemma tendsto_root_at_top_nhds_1_of_pos
  {C: ℝ}
  (c_pos: C > 0)
  : filter.tendsto (λ (n : ℕ), C^((1 : ℝ) / n)) filter.at_top (nhds 1) :=
begin
  have h_exp_form: (λ (n : ℕ), C^((1 : ℝ) / n)) = (λ (n: ℕ), real.exp((real.log C) / n)),
  { ext,
    simp,
    rw div_eq_mul_inv,
    rw real.exp_mul,
    rw real.exp_log c_pos, },
  { rw h_exp_form,
    apply filter.tendsto.comp,
    apply real.tendsto_exp_nhds_0_nhds_1,
    apply tendsto_const_div_at_top_nhds_0_nat, }
end


import Std

inductive Expr where
  | var (i : Nat)
  | op  (lhs rhs : Expr)

def List.getIdx : List α → Nat → α → α
  | [],    i,   u => u
  | a::as, 0,   u => a
  | a::as, i+1, u => getIdx as i u

structure Context (α : Type u) where
  op    : α → α → α
  unit  : α
  assoc : (a b c : α) → op (op a b) c = op a (op b c)
  vars  : List α

def Expr.denote (ctx : Context α) : Expr → α
  | Expr.op a b => ctx.op (denote ctx a) (denote ctx b)
  | Expr.var i  => ctx.vars.getIdx i ctx.unit

theorem Expr.denote_op (ctx : Context α) (a b : Expr) : denote ctx (Expr.op a b) = ctx.op (denote ctx a) (denote ctx b) :=
  rfl

theorem Expr.denote_var (ctx : Context α) (i : Nat) : denote ctx (Expr.var i) = ctx.vars.getIdx i ctx.unit :=
  rfl

def Expr.concat : Expr → Expr → Expr
  | Expr.op a b, c => Expr.op a (concat b c)
  | Expr.var i, c  => Expr.op (Expr.var i) c

theorem Expr.concat_op (a b c : Expr) : concat (Expr.op a b) c = Expr.op a (concat b c) :=
  rfl

theorem Expr.concat_var (i : Nat) (c : Expr) : concat (Expr.var i) c = Expr.op (Expr.var i) c :=
  rfl

theorem Expr.denote_concat (ctx : Context α) (a b : Expr) : denote ctx (concat a b) = denote ctx (Expr.op a b) := by
  induction a with
  | var i => rfl
  | op _ _ _ ih => rw [concat_op, denote_op, ih, denote_op, denote_op, denote_op, ctx.assoc]

def Expr.flat : Expr → Expr
  | Expr.op a b => concat (flat a) (flat b)
  | Expr.var i  => Expr.var i

theorem Expr.flat_op (a b : Expr) : flat (Expr.op a b) = concat (flat a) (flat b) :=
  rfl

theorem Expr.denote_flat (ctx : Context α) (a : Expr) : denote ctx (flat a) = denote ctx a := by
  induction a with
  | var i => rfl
  | op a b ih₁ ih₂ => rw [flat_op, denote_concat, denote_op, denote_op, ih₁, ih₂]

theorem Expr.eq_of_flat (ctx : Context α) (a b : Expr) (h : flat a = flat b) : denote ctx a = denote ctx b := by
  rw [← Expr.denote_flat _ a, ← Expr.denote_flat _ b, h]

theorem test (x₁ x₂ x₃ x₄ : Nat) : (x₁ + x₂) + (x₃ + x₄) = x₁ + x₂ + x₃ + x₄ :=
  Expr.eq_of_flat
    { op    := Nat.add
      assoc := Nat.add_assoc
      unit  := Nat.zero
      vars  := [x₁, x₂, x₃, x₄] }
    (Expr.op (Expr.op (Expr.var 0) (Expr.var 1)) (Expr.op (Expr.var 2) (Expr.var 3)))
    (Expr.op (Expr.op (Expr.op (Expr.var 0) (Expr.var 1)) (Expr.var 2)) (Expr.var 3))
    rfl


/-
Copyright (c) 2022 Adam Topaz. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Adam Topaz, Junyan Xu

! This file was ported from Lean 3 source module ring_theory.localization.as_subring
! leanprover-community/mathlib commit 649ca66bf4d62796b5eefef966e622d91aa471f3
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.RingTheory.Localization.LocalizationLocalization

/-!

# Localizations of domains as subalgebras of the fraction field.

Given a domain `A` with fraction field `K`, and a submonoid `S` of `A` which
does not contain zero, this file constructs the localization of `A` at `S`
as a subalgebra of the field `K` over `A`.

-/

namespace Localization

open nonZeroDivisors

variable {A : Type _} (K : Type _) [CommRing A] (S : Submonoid A) (hS : S ≤ A⁰)

section CommRing

variable [CommRing K] [Algebra A K] [IsFractionRing A K]

theorem map_isUnit_of_le (hS : S ≤ A⁰) (s : S) : IsUnit (algebraMap A K s) := by
  apply IsLocalization.map_units K (⟨s.1, hS s.2⟩ : A⁰)
#align localization.map_is_unit_of_le Localization.map_isUnit_of_le

/-- The canonical map from a localization of `A` at `S` to the fraction ring
  of `A`, given that `S ≤ A⁰`. -/
noncomputable def mapToFractionRing (B : Type _) [CommRing B] [Algebra A B] [IsLocalization S B]
    (hS : S ≤ A⁰) : B →ₐ[A] K :=
  { IsLocalization.lift (map_isUnit_of_le K S hS) with commutes' := fun a => by simp }
#align localization.map_to_fraction_ring Localization.mapToFractionRing

@[simp]
theorem mapToFractionRing_apply {B : Type _} [CommRing B] [Algebra A B] [IsLocalization S B]
    (hS : S ≤ A⁰) (b : B) :
    mapToFractionRing K S B hS b = IsLocalization.lift (map_isUnit_of_le K S hS) b :=
  rfl
#align localization.map_to_fraction_ring_apply Localization.mapToFractionRing_apply

theorem mem_range_mapToFractionRing_iff (B : Type _) [CommRing B] [Algebra A B] [IsLocalization S B]
    (hS : S ≤ A⁰) (x : K) :
    x ∈ (mapToFractionRing K S B hS).range ↔
      ∃ (a s : A)(hs : s ∈ S), x = IsLocalization.mk' K a ⟨s, hS hs⟩ :=
  ⟨by
    rintro ⟨x, rfl⟩
    obtain ⟨a, s, rfl⟩ := IsLocalization.mk'_surjective S x
    use a, s, s.2
    apply IsLocalization.lift_mk', by
    rintro ⟨a, s, hs, rfl⟩
    use IsLocalization.mk' _ a ⟨s, hs⟩
    apply IsLocalization.lift_mk'⟩
#align localization.mem_range_map_to_fraction_ring_iff Localization.mem_range_mapToFractionRing_iff

instance isLocalization_range_mapToFractionRing (B : Type _) [CommRing B] [Algebra A B]
    [IsLocalization S B] (hS : S ≤ A⁰) : IsLocalization S (mapToFractionRing K S B hS).range :=
  IsLocalization.isLocalization_of_algEquiv S <|
    show B ≃ₐ[A] _ from
      AlgEquiv.ofBijective (mapToFractionRing K S B hS).range_restrict
        (by
          refine' ⟨fun a b h => _, Set.surjective_onto_range⟩
          refine' (IsLocalization.lift_injective_iff _).2 (fun a b => _) (Subtype.ext_iff.1 h)
          exact
            ⟨fun h => congr_arg _ (IsLocalization.injective _ hS h), fun h =>
              congr_arg _ (IsFractionRing.injective A K h)⟩)
#align localization.is_localization_range_map_to_fraction_ring Localization.isLocalization_range_mapToFractionRing

instance isFractionRing_range_mapToFractionRing (B : Type _) [CommRing B] [Algebra A B]
    [IsLocalization S B] (hS : S ≤ A⁰) : IsFractionRing (mapToFractionRing K S B hS).range K :=
  IsFractionRing.isFractionRing_of_isLocalization S _ _ hS
#align localization.is_fraction_ring_range_map_to_fraction_ring Localization.isFractionRing_range_mapToFractionRing

/-- Given a commutative ring `A` with fraction ring `K`, and a submonoid `S` of `A` which
contains no zero divisor, this is the localization of `A` at `S`, considered as
a subalgebra of `K` over `A`.

The carrier of this subalgebra is defined as the set of all `x : K` of the form
`is_localization.mk' K a ⟨s, _⟩`, where `s ∈ S`.
-/
noncomputable def subalgebra (hS : S ≤ A⁰) : Subalgebra A K :=
  (mapToFractionRing K S (Localization S) hS).range.copy
      { x | ∃ (a s : A)(hs : s ∈ S), x = IsLocalization.mk' K a ⟨s, hS hs⟩ } <|
    by
    ext
    symm
    apply mem_range_map_to_fraction_ring_iff
#align localization.subalgebra Localization.subalgebra

namespace Subalgebra

instance isLocalization_subalgebra : IsLocalization S (subalgebra K S hS) :=
  by
  dsimp only [Localization.subalgebra]
  rw [Subalgebra.copy_eq]
  infer_instance
#align localization.subalgebra.is_localization_subalgebra Localization.subalgebra.isLocalization_subalgebra

instance isFractionRing : IsFractionRing (subalgebra K S hS) K :=
  IsFractionRing.isFractionRing_of_isLocalization S _ _ hS
#align localization.subalgebra.is_fraction_ring Localization.subalgebra.isFractionRing

end Subalgebra

end CommRing

section Field

variable [Field K] [Algebra A K] [IsFractionRing A K]

namespace Subalgebra

theorem mem_range_mapToFractionRing_iff_of_field (B : Type _) [CommRing B] [Algebra A B]
    [IsLocalization S B] (x : K) :
    x ∈ (mapToFractionRing K S B hS).range ↔
      ∃ (a s : A)(hs : s ∈ S), x = algebraMap A K a * (algebraMap A K s)⁻¹ :=
  by
  rw [mem_range_map_to_fraction_ring_iff]
  iterate 3 congr with ; convert Iff.rfl; rw [Units.val_inv_eq_inv_val]; rfl
#align localization.subalgebra.mem_range_map_to_fraction_ring_iff_of_field Localization.subalgebra.mem_range_mapToFractionRing_iff_of_field

/-- Given a domain `A` with fraction field `K`, and a submonoid `S` of `A` which
contains no zero divisor, this is the localization of `A` at `S`, considered as
a subalgebra of `K` over `A`.

The carrier of this subalgebra is defined as the set of all `x : K` of the form
`algebra_map A K a * (algebra_map A K s)⁻¹` where `a s : A` and `s ∈ S`.
-/
noncomputable def ofField : Subalgebra A K :=
  (mapToFractionRing K S (Localization S) hS).range.copy
      { x | ∃ (a s : A)(hs : s ∈ S), x = algebraMap A K a * (algebraMap A K s)⁻¹ } <|
    by
    ext
    symm
    apply mem_range_map_to_fraction_ring_iff_of_field
#align localization.subalgebra.of_field Localization.subalgebra.ofField

instance isLocalization_ofField : IsLocalization S (subalgebra.ofField K S hS) :=
  by
  dsimp only [Localization.subalgebra.ofField]
  rw [Subalgebra.copy_eq]
  infer_instance
#align localization.subalgebra.is_localization_of_field Localization.subalgebra.isLocalization_ofField

instance isFractionRing_ofField : IsFractionRing (subalgebra.ofField K S hS) K :=
  IsFractionRing.isFractionRing_of_isLocalization S _ _ hS
#align localization.subalgebra.is_fraction_ring_of_field Localization.subalgebra.isFractionRing_ofField

end Subalgebra

end Field

end Localization


import data.nat.prime
import data.rat.basic
import data.real.basic
import tactic
import game.basic.level01

namespace uwyo -- hide

/-
# Chapter 1 : Basic facts

## Level 2

In this level you need to prove a slightly different statement
of the fact that `sqrt 2` is irrational. This will require you to work more closely
with Lean's tools for handling rationals.
-/

-- begin hide
lemma rat_times_rat (r : ℚ) : r * r * ↑(r.denom) ^ 2 = ↑(r.num) ^ 2 :=
begin
    have h1 := @rat.mul_denom_eq_num r,
    rw pow_two,
    rw mul_assoc, rw ← mul_assoc r r.denom r.denom,
    rw h1, rw ← mul_assoc, rw mul_comm, rw ← mul_assoc,
    rw mul_comm ↑r.denom r, rw h1, rw pow_two, done
end
-- end hide

/- Lemma
There doesn't exist a rational number `r` such that `r ^ 2 = 2`.
-/
theorem rational_not_sqrt_two : ¬ ∃ r : ℚ, r ^ 2 = (2:ℚ)  :=
begin
    intro h,
    cases h with r H,
    let num := r.num, set den := r.denom with hden,
    --explicitly build the hypothetical rational number r
    have hr := @rat.num_denom r,
    rw ← hr at H, -- use it in the main assumption
    -- now we can figure out some properties of r.num and r.denom
    -- first off, the denominator is not zero; this is encoded in r.
    have hdenom := r.pos,  -- the denom is actually positive
    have hdne : r.denom ≠ 0, linarith, -- so it is non zero; linarith can handle that
    set n := int.nat_abs num with hn1, -- give it a new name to type less
    have hn : (n ^2 : ℤ) = num ^ 2,
        norm_cast, rw ← int.nat_abs_pow_two num, rw ← int.coe_nat_pow,
    have G : (2:ℚ) * (r.denom ^2) = (r.num ^ 2),
        rw ← H, norm_cast, simp,
        rw pow_two r, simp * at *,
        exact rat_times_rat r,
    norm_cast at G,
    rw ← hn at G,
    have g1 : nat.gcd n den = 1,
        have g11 := r.cop,
        unfold nat.coprime at g11,
        have g12 := nat.coprime.pow_left 2 g11,
        have g13 := nat.coprime.coprime_mul_left g12,
        rw ← hn1 at g13, exact g13,
    have E := sqrt_two_irrational g1,
    have g2 := G.symm,
    norm_cast at g2,
    done
end

end uwyo -- hide


/-
The functor typeclass enables us to change the behavior
of (what amounts to) *function application* In particular,
the functor.map operation (<$>) lifts any pure function,
h : α → β, to a "structure-preserving" function on data
values containing α and β values: e.g., mapping options,
lists, or trees of α values into structurally identical
trees of β values. Preservation of structure is assured
by the functor laws.
-/

/-
The applicative functor typeclass enables us to change
the behavior of *multi-argument* function application.
The pure function takes a function and lifts it into
one that can then serve as a first argument to the seq
function, which then "applies" that function to a data
structure containing first arguments to that function.
The result is then a data structure holding partially
evaluated functions that is then "applied" to the next
data structure containing argument values. Overriding
the definitions of pure and seq in particular ways for
different data structures, such as option and list,
has given us nice ways to implement "non-deterministic"
function application as well as error propagation over
applications of functions to multiple arguments. Note:
an applicative functor *is a kind of functor,* so we
can assume that the map function is availabel when we
define pure and seq.
-/

/-
We can now explain the purpose of the monad typeclass.
It provides us with a way to override the behavior of
ordinary function *composition*. So, to begin, we will
review this essential concept.
-/

/-
Suppose we have three sets: dogs = {Benji, ChewChew};
breeds = {poodle, husky}; and messy = { true, false };
as well as two functions, breedOf : dogs → breeds;
and messy : breed → sheds. For each dog, breedOf returns
its breed; and for each breed, sheds returns true or
false reflecting whether that breed of dog sheds or not.

In this context, we can apply the composition operator
to sheds and breedOf, to derive a new function, isMessy :
from dog → bool.
-/

/-
axioms
  (dogs breeds messy : Type)
  (breed : dogs → breeds)
  (sheds : breeds → messy)
noncomputable def isMessy : dogs → messy := (sheds ∘ breed)
-/

/-
Next we confirm that (1) isMessy is a function that takes
a dog and returns its messiness, and (2) that when applied
to an argument (dog), x, it works by first computing the
value of (breed x), yielding a breed, and then applying the
sheds function to that result of that first operation.
-/

namespace hidden

inductive dogs | fido | polly
inductive breeds | poodle | husky
inductive coats | fur | hair
inductive yesno | yes | no

open dogs breeds coats yesno

def breed : dogs → breeds
| polly := poodle
| fido := husky

def coat : breeds → coats
| poodle := hair
| husky := fur

def sheds : coats → yesno
| fur := yes
| hair := no

def messy : dogs → yesno :=
  sheds ∘ coat ∘ breed

#check messy  -- isMessy : dogs → messy
#reduce messy -- λ (x : dogs), sheds (breed x)

#reduce messy polly
#reduce messy fido

/-
We pronounce (sheds ∘ coat ∘ breed) as "sheds after
coat after breed." It is defined to be the function
obtained by taking a dog as an argument and returning
the value obtained by first applying breed to the dog,
yielding its breed, then applying coat to that breed,
to obtain whether it's fur or hair, and then finally
applying sheds to that value to get a yes/no answer
to the question of whether that partiular dog is messy
(because it sheds).#check

Function composition is associative.
-/

/-
Let's unpack one of these examples. We know now that
(messy polly) reduces to no. We also know it reduces
to (λ d, (messy (coat (breed d)))). We see again that
to get a final answer we apply "messy *after* applying
coat after applying breed to the given dog, d.

This is a sort of "backwards" sequential notation, in
the sense that the last operation to be applied is the
leftmost one in the expression. The argument d "flows"
into the breed function from the right; the result comes
out and "flows" left into coat function; the result of
that emerges and flows to the left into sheds function;
yielding a final result.

English is read from left to right and top to bottom,
and so English speakers expect temporal sequences to
be organized in that style. By a simple notation change
we can express the same composition of functions.
-/

def isPollyMessy :=
  (let
    b := (breed polly) in let
    c  := (coat b) in let
    m := (sheds c) in
    m
  )

/-
Of course, even though our new code looks sequential,
it's still purely functional. In the first line we
*bind* the result of the first application to b. We
use this value as an argument in the second line and
bind its result to c. Next in this context in which
b and c are thus bound, we evaluate (sheds c) and bind
its result to m; and in the very last line we "return"
(reduce to) the value of m.

If we generalize the choice of polly as the dog in
this case (replacing it with a parameter) then we
get our messy function back.
-/

def messy' (d : dogs) :=
(
  let b := (breed d) in   -- bind b, call rest
    let c := (coat b)  in   -- bind c, call rest
      let m := (sheds c) in   -- bind m, call rest
        m                       -- "return" m
)

/-
Some form of bind here
-/

-- It desugars to just what we expect
#reduce messy'

/-
As a conceptual step without being formal, we can
easily imagine a new notation that allows us to
write that program in a more sequential style.
-/

/-
Note that we can see a sequential chain of function
applications in this code: sheds ∘ coat ∘ breed means
  - apply sheds after (to the result of)
  - apply coat after (to the result of)
  - apply breed to polly.

But in this style of presentation, the applications
appear in the reserse order in which they occur. We
can reasily develop a new notation in which functions
appear in our code in the same order in which they
are actually applied. The easy trick is to define a
notation for function application where the argument
is on the left and the function to be applied is on
the right. We'll use >> as an infix operator. So, for
example 0 >> nat.succ would evaluate to 1, because
it means nothing other than nat.succ 0.

-/

local notation v ` >> ` f :120 := f v

example : 0 >> nat.succ = 1 := rfl
example : 0 >> (λ n, n + 1) = 1 := rfl

/-
Study the second example. What it means if we desugar
the >> is ((λ n, n + 1) 0); and what this means is to
first *bind* n to the incoming argument, then in this
context evaluate the expression, n + 1. We'll return
to this perspective later in these notes.
-/

#reduce
  polly >>  -- a pure argument bound as argument of rest
  breed >>  -- apply bread to incoing, pass result to rest
  coat >>   -- apply coat to incoming, pass result to rest
  sheds     -- apply sheds to incoming, return final result

/-
So now we have an abstraction of a sequential pipeline
that works by taking a pure argument (like polly), or in
general the result of a preceding computation, and passes
that value as the argument to the function that implements
the rest of the pipeline.
-/

-- Example: the following programs pairs are equivalent
#reduce polly >> breed  -- feed polly as argument into breed
#reduce
  (λ d, breed d)         -- bind d and apply breed to it
    polly                -- argument to be bound

#reduce polly >> breed >> coat
#reduce
  (λ b, coat b)     -- function
    ((λ d, breed d) -- argument (rest)
      polly
    )

#reduce polly >> breed >> coat >> sheds
#reduce
  (λ c, sheds c)  -- function
    ((λ b, coat b) -- argument (rest)
      ((λ d, breed d)
          polly
      )
  )

/-
========================
-/

/-
So what does a monad do? The answe: it gives us a
more powerful version of >>, in the form of a generic
function call bind, denoted >=>, that enables one to
add hidden processing of metadata to the evaluation
of pipelines like the ones we've just seen. Monads
give us *function composition with effects*.

Let's start to illustrate this idea by continuing
to develop our dog examle above. Evaluating messy
applied to a dog will result in three function
application operations. What if we wanted a way
to have application of compositions of functions
return both the expected pure answer along with a
natural number count of the number of pure function
applications were performed to produce the final
result.

For example, now we'd expect the result of evaluating
(messy fido) to return not just "yes" but the pair,
"(yes, 3)," meaning yes fido's messy and oh by the
way, computing this answer took three ordinary
function applications.
-/

/-
Clearly the types of the functions that we need to
"compose" changes. Each function in the "chain"
needs to return not just the correct "pure" result
but also a natural number accounting for the call
to this function and to any other functions it might
have called. Focus especially on the types of these
functions. Remember if S and T are types then S × T
is a type, the type of (S value, T value) pairs.
Note that each of these functions takes a pure
argument but returns a result embedded in a larger
context object, here in a pair that also contains
a natural number.
-/

universe u

def prof_result (α : Type u) := α × ℕ

def m_breed : dogs → prof_result breeds :=
  λ d, (breed d, 1)

def m_coat : breeds → prof_result coats :=
  λ b, (coat b, 1)

def m_sheds : coats → prof_result yesno :=
  λ c, (sheds c, 1)

/-
The operation of pure function composition will not
work here as it did before, because it requires that
the argument type of the next function to be applied
is the same as the return type of the function most
recently applied. For example, breed takes a dog and
returns a breed, coat takes a breed and returns what
kind of coat it has, and messy takes a kind of coat
and returns a yesno as the final answer.
-/
#check coat ∘ breed

/-
But our extended functions won't compose this way.
The m_breed function takes a dog and returns a pair
containing it's breed and the value 1. But we can'
feed this pair to m_coat because takes a pure breed
value. We need a new kind of composition operator
for our "effectful" functions.
-/

#check m_coat ∘ m_breed   -- type error!

/-
Clearly we need to define a new form of function
composition: one that handles any pure applications
that are needed but that also handles the metadata
returned along with a pure result value.

Let's just write a concrete implementation of the
our desired pipeline. Then we can study it as a
basis from which to generalize.
-/

def messy'' : dogs → yesno × ℕ :=
λ d,
  let
    (b, n1) := m_breed d in let -- use d, get b, n1
    (c, n2) := m_coat b in let  -- use b, get  c, n2
    (s, n3) := m_sheds c in     -- use c, get s, n3
    (s, n1+n2+n3)               -- produce final result

-- Let's compute whether polly is messy''
#reduce messy'' polly
-- No! And that took 3 operations to compute

/-
Let's rewrite messy'' applied to polly once again,
but put it in the style using lambda to bind a variable
to the result of running the rest of the computation and
returning the result of performing some operation on it.
We'll do it in steps, as we did before.
-/

/-
this is a function application: bind d to polly, and
then in this context, compute and return (m_breed d).
-/

#reduce
  (λ d, m_breed d)  -- bind d to polly, apply breed to d
    polly

/-
So far so good, but that's the end of our good luck. In
retrospect it should be clar that we won't be able to chain
our effectful functions using plain old function composition.
-/

#reduce m_coat ∘ m_breed

/-
Here the problem is that m_breed returns a breed along with
a count, while m_coat just expects to receive a breed value
as an argument. Somehow what we need is a novel composition
operator: one that can (1) "reach into" the data structure
that m_breed returns, to pull out the "breed" value that it
contains, and pass it on to m_coat, while also combining the
counts from both function applications to return as part of
the final result. Let's denote this new composition operator
as >>=, an infix notation for a function we can call "bind'."

Now let's think about types:

- m_breed : dogs → (breeds × ℕ)
- m_coat : breeds → (coats × ℕ)
- m_coat >>= m_breed : dog → (coats × ℕ)
-/

def compose_coat_breed :
  (dogs → (breeds × ℕ)) → (breeds → (coats × ℕ)) → (dogs → (coats × ℕ))
| db bc :=
  λ (d : dogs),
    let (b, c1) := db d in
    let (c, c2) := bc b in
    (c, c1+c2)

/-
We can now see that the composition of m_breed and m_coat using our
new, special case, compose-like function does two things: it computes
the desired composition of the pure functions, breed and coat, while
also combining the effects of m_breed and m_coat in an effect that is
returned along with the pure result.
-/
#reduce compose_coat_breed m_breed m_coat
#reduce (compose_coat_breed m_breed m_coat) polly

/-
Now the question is, can we somehow generalize the approach we've
taken here to the special case of composing m_coat and m_breed. A
first step is to recognize that the arguments to this function are
all similar in an important way: each is of a pair type, combining
a pure value and an effect in the form of a natural number. Let's
start by factoring out the common structure  of these pairs.
-/

#check prof_result

def compose_coat_breed' :
  (dogs → (prof_result breeds)) →
  (breeds → (prof_result coats)) →
  (dogs → prof_result coats)
| db bc :=
  λ (d : dogs),
    let (b, c1) := db d in
    let (c, c2) := bc b in
    (c, c1+c2)

/-
Now let's simply generalize the pure argument and result types.
-/

def prof_compose {α β γ : Type} :
  (α → (prof_result β)) → (β → (prof_result γ)) → (α → prof_result γ)
| f g :=
  λ (a : α),
    let (b, c1) := f a in
    let (c, c2) := g b in
    (c, c1+c2)

/-
Finally, let's think about generalizing prof_result to any kind
of object possibly containing values of type α. Note that in a
strong sense, prof_result is analogous to list, option, tree,
etc: a data structure that can contain values of type α. We've
seen how to do this kind of generalization before.
-/

def m_compose'
  {α β γ : Type} (m : Type → Type):  (α → m β) → (β → m γ) → (α → m γ)
| f g :=
  λ (a : α),
    let (b, c1) := f a in   -- we don't know that m is a pair!
    let (c, c2) := g b in
    (c, c1+c2)

/-
The problem is that we can no longer rely on a value of type
(m α) to be a pair, which is what we have assumed in the let
expressions up to now. So this is not going to work as is. We
can see that if m is, say, list or option, an implementation
of composition for pairs isn't going to work at all. We will
need a different implementation for option, a different one,
again, for list, and so forth. Indeed, for each type builder,
m, we'll need a different implementation of the binding code,
where we bind b to the "pure" result of applying f to a then
then treat b as an argument to the rest of the computation.
-/

/-
That is, we need an overloaded definition of m_compose for
each "context-imposing" type, m. And central to this goal
is an operation that takes an effectful value, m α, and a
function from α → m β. That is, we're going to need what
we call a overloaded bind operation, as follows.
-/

class has_bind' (m : Type → Type) :=
(bind : ∀ {α β : Type}, m α → (α → m β) → m β)

/-
Here's the standard infix notation for bind.
Note that it takes an α-monadic argument value
and "feeds" it to a function that takes a pure
α value in and produces β-monadic value out. To
obtain this result it will usually "reach into"
the monadic value and behave subsequently based
on what it finds. In many cases it will "apply"
its α → m β function to α values, if any, that
it obtains from the monadic m α argument.
-/

local infixl ` >>= `:55 := has_bind'.bind

/-
We now have enough machinery to cobble together
a definition of bind for the prof_result monad.
-/
instance bind_prof_result : has_bind' (prof_result) :=
⟨
  λ {α β : Type } (ma : prof_result α) a2mb,
    let (a, c1) := ma in
    let (b, c2) := a2mb a in
    (b, c1+c2)
⟩

def m_comp'
  {α β γ : Type}
  {m : Type → Type} [has_bind' m]
  (f : α → m β)
  (g : β → m γ) :
  (α → m γ) :=
λ a : α,
  let mb := f a in mb >>= g

#reduce m_comp' m_breed m_coat

local infixl ` >=> `:60 := m_comp'

def is_messy_prof := (m_breed >=> m_coat >=> m_sheds)

#reduce is_messy_prof fido
#reduce is_messy_prof polly

/-
So the fish operator supports the feeding of
a monadic value into a composition of monadic
functions. What is doesn't support is feeding
of a pure value into such a pipeline, as the
following example shows.
-/

/-
The problem is that polly is pure but >=> expects
a monadic value. The solution is to define a new
function, one that will have to be overloaded for
each monadic type) that takes a pure value as its
argument "lifts" it to a monadic value. Then we
can use >=> to feed it into a pipeline composed
of monadic functions.
-/

class has_return' (m : Type → Type) :=
(return' : ∀ {α : Type}, α → m α)

open has_return'

instance : has_return' (prof_result) :=
⟨
  λ α a, (a, 0)
⟩

/-
Now we can write a complete pipeline with
input fed in "from the left."
-/

#reduce (return' polly) >>= (m_breed >=> m_coat >=> m_sheds)

/-
-/

instance bind_option : has_bind' (option) :=
⟨
  λ {α β : Type } (ma : option α) a2mb,
    match ma with
    | none := none
    | (some a) := a2mb a
    end
⟩

instance : has_return' (option) :=
⟨
  λ α a, some a
⟩

end hidden

-- We can now recommend that you use Lean's monad definitions

#check @monad


import algebra.euclidean_domain

-- Greatest Common Divisor Algorithm

universe u

open euclidean_domain

#check dvd_gcd

theorem t069 {α : Type u} [euclidean_domain α] [decidable_eq α] (a b : α) :
∃ c, c ∣ a ∧ c ∣ b ∧ (∀ x : α, x ∣ a → x ∣ b → x ∣ c)
:= begin
  use gcd a b,
  rw ← and_assoc,
  split,
  { exact gcd_dvd a b },
  { intro, exact dvd_gcd }
end


import mam.Cislo1
import mam.Cislo2
import mam.Cislo3
import Mathlib.Data.Real.Sqrt
import Mathlib.Tactic.Cases
import Mathlib.Tactic.LibrarySearch

lemma soucet_prvnich_n_lichych_sestupne (n : ℕ) : soucet (prvnich_n_lichych_sestupne n) = n * n :=
by
  induction' n with m ih
  · rfl
  rw [Nat.succ_mul, Nat.mul_succ]
  unfold prvnich_n_lichych_sestupne
  unfold soucet
  rw [ih, dva_krat]
  rw [add_comm, add_assoc, add_assoc]

lemma soucet_dvou_seznamu (x y : List ℕ) : soucet (x ++ y) = soucet x + soucet y :=
by
  induction' x with x₀ xs ih
  · simp
  convert_to x₀ + soucet (xs ++ y) = x₀ + soucet xs + soucet y
  rw [ih, add_assoc]

lemma obrat_zachovava_soucet (l : List ℕ) : soucet (obrat l) = soucet l :=
by
  induction' l with hlava zbytek indukcni
  · rfl
  unfold obrat
  rw [soucet_dvou_seznamu, indukcni, add_comm]
  rfl

theorem soucet_prvnich_N_lichych (n : ℕ) : soucet (prvnich_n_lichych n) = n * n :=
by
  simp [prvnich_n_lichych]
  rw [obrat_zachovava_soucet]
  apply soucet_prvnich_n_lichych_sestupne

lemma dva_na_vs_na_druhou_aux (n : ℕ) : 2 ^ (n+5) > (n+5) ^ 2 :=
by
  induction' n with m ih
  · decide
  rw [Nat.succ_add, Nat.pow_succ]
  have : (m+5) * (m+5) > 3 * (m+5)
  · nlinarith
  linarith

theorem dva_na_vs_na_druhou (n : ℕ) (aspon_pet : n ≥ 5) : 2^n > n^2 :=
by
  have minus5_plus5 : n = n - 5 + 5
  · exact Nat.eq_add_of_sub_eq aspon_pet rfl
  rw [minus5_plus5]
  exact dva_na_vs_na_druhou_aux (n - 5)

lemma binetuv_aux {x : ℝ} (predpoklad : x * x = x + 1) (m : ℕ) :
  x ^ (m+1) = x * fibonacci (m+1) + fibonacci m :=
by
  induction' m with n ih
  · simp [fibonacci]
  convert_to x * x ^ (n+1) = x * (fibonacci n + fibonacci (n+1)) + fibonacci (n+1)
  · simp [fibonacci]
  rw [ih]
  convert_to x * x * fibonacci (n+1) + x * fibonacci n = x * (fibonacci n + fibonacci (n+1)) + fibonacci (n+1)
  · ring
  rw [predpoklad]
  ring

theorem binetuv_vzorec (n : ℕ) :
  fibonacci n = (1 / Real.sqrt 5) * (((1 + Real.sqrt 5) / 2) ^ n - ((1 - Real.sqrt 5) / 2) ^ n) :=
by
  have odm5nd : Real.sqrt 5 * Real.sqrt 5 = (5 : ℝ)
  · have pet_nz : 0 ≤ (5 : ℝ)
    · linarith
    exact Real.mul_self_sqrt pet_nz
  have odm5nn : Real.sqrt 5 ≠ 0
  · intro pro_spor
    have spor : Real.sqrt 5 * Real.sqrt 5 = 0 * Real.sqrt 5
    · exact congrFun (congrArg HMul.hMul pro_spor) (Real.sqrt 5)
    linarith
  cases' n with m ih
  · simp [fibonacci]
  rw [binetuv_aux, binetuv_aux]
  ring
  convert_to (fibonacci (Nat.succ m)) = (1 : ℝ) * (fibonacci (1 + m))
  · exact CommGroupWithZero.mul_inv_cancel (Real.sqrt 5) odm5nn
  convert_to (fibonacci (Nat.succ m) : ℝ) = (fibonacci (m + 1) : ℝ)
  · ring
  rfl
  · have uprava : ((1 - Real.sqrt 5) / 2) * ((1 - Real.sqrt 5) / 2) =
                  (1 - 2 * Real.sqrt 5 + Real.sqrt 5 * Real.sqrt 5) / 2 / 2
    · ring
    rw [uprava, odm5nd]
    ring
  · have uprava : ((1 + Real.sqrt 5) / 2) * ((1 + Real.sqrt 5) / 2) =
                  (1 + 2 * Real.sqrt 5 + Real.sqrt 5 * Real.sqrt 5) / 2 / 2
    · ring
    rw [uprava, odm5nd]
    ring