/-
The goal of this file is to prove the following.  If S ⊆ ℂ^n is a subspace and L : S → V is
an isometry, then there exists an isometry M : ℂ^n → ℂ^n such that M(s) = L(s) for every s ∈ S.

In other words, every isometry on a subspace of ℂ^n extends to an isometry of ℂ^n.
-/

import analysis.inner_product_space.basic
import analysis.inner_product_space.pi_L2
import analysis.inner_product_space.spectrum
import analysis.normed_space.pi_Lp
import linear_algebra.basis
import .lemmas.ladr_7_lem
import .linear_independent

open_locale big_operators complex_conjugate matrix

variables {n : ℕ} (S : submodule ℂ (ℂ^n))

local attribute [instance] fact_one_le_two_real

/-
S is also a finite dimensional inner product space.
-/

noncomputable lemma hS_module : module ℂ S := submodule.module S

noncomputable lemma hS_ips : inner_product_space ℂ S := submodule.inner_product_space S

lemma hS_fd : finite_dimensional ℂ S := finite_dimensional.finite_dimensional_submodule S

/-
S has an orthonormal basis.
-/

noncomputable def onbasis := orthonormal_basis ℂ S

lemma hb_on : orthonormal ℂ (onbasis S) := orthonormal_basis_orthonormal ℂ S

/-
Extend the basis b for S to an orthonormal basis for ℂ^n.
-/

noncomputable def b_to_S : (orthonormal_basis_index ℂ S) → S := (onbasis S)

noncomputable def b_to_Cn : (orthonormal_basis_index ℂ S) → ℂ^n := function.comp S.subtype (b_to_S S)

def b_in_Cn : set ℂ^n := set.range (b_to_Cn S)

lemma b_still_on : orthonormal ℂ (b_to_Cn S) :=
begin
  rw orthonormal_iff_ite,
  intros i j,
  rw b_to_Cn,
  rw b_to_S,
  rw function.comp_app,
  rw function.comp_app,
  rw submodule.subtype_apply,
  rw submodule.subtype_apply,
  rw ← submodule.coe_inner,
  revert i j,
  rw ← orthonormal_iff_ite,
  apply orthonormal_basis_orthonormal ℂ,
end

lemma b_distinct (i j : (orthonormal_basis_index ℂ S)): (b_to_Cn S i) = (b_to_Cn S j) ↔ i = j :=
  linear_independent_distinct (b_still_on S).linear_independent

lemma hb_still_on : orthonormal ℂ (coe : (b_in_Cn S) → ℂ^n) :=
begin
  rw orthonormal_subtype_iff_ite,
  intros v hv w hw,
  rw b_in_Cn at hv hw,
  rw set.mem_range at hv hw,
  cases hv with i hi,
  cases hw with j hj,
  rw ← hi,
  rw ← hj,
  have hon : (orthonormal ℂ (b_to_Cn S)) := by apply b_still_on,
  rw orthonormal_iff_ite at hon,
  specialize hon i j,
  rw hon,
  have hji : ¬(i = j) ↔ ¬((b_to_Cn S i) = (b_to_Cn S j)) :=
  begin
    have hij : ((b_to_Cn S i) = (b_to_Cn S j)) ↔ (i = j) := by apply b_distinct,
    cases hij with lr rl,
    split,
    contrapose,
    push_neg,
    exact lr,
    contrapose,
    push_neg,
    exact rl,
  end,
  rw ite_eq_iff,
  by_cases (i = j),
  rw ← b_distinct,
  left,
  rw h,
  simp only [if_true, eq_self_iff_true, and_self],
  right,
  split,
  exact h,
  rw hji at h,
  symmetry,
  rw ite_eq_right_iff,
  contrapose,
  intro dumb,
  exact h,
end

noncomputable def f := S.subtype ∘ (onbasis S)

lemma extend_b_in_Cn : ∃ (u : set ℂ^n) (H : u ⊇ set.range (f S)) (b : basis u ℂ ℂ^n), orthonormal ℂ b ∧ ⇑b = coe :=
  exists_subset_is_orthonormal_basis (hb_still_on S)

/-
Let L : S → ℂ^n be an isometry.
-/

variable (L : S →ₗᵢ[ℂ] ℂ^n)

/-
Since L is an isometry, it maps the orthonormal basis to an orthonormal set.
-/

lemma hLb_on : orthonormal ℂ (L ∘ onbasis S) := (hb_on S).comp_linear_isometry L

/-
Extend the image of the orthonormal basis to an orthonormal basis.
-/

lemma Lb_distinct (i j : (orthonormal_basis_index ℂ S)): (L ∘ onbasis S) i = (L ∘ onbasis S) j ↔ i = j :=
  linear_independent_distinct (hLb_on S L).linear_independent

lemma hLb_still_on : orthonormal ℂ (coe : set.range (L ∘ onbasis S) → ℂ^n) :=
begin
  rw orthonormal_subtype_iff_ite,
  intros v hv w hw,
  rw set.mem_range at hv hw,
  cases hv with i hi,
  cases hw with j hj,
  have hon : orthonormal ℂ (L ∘ onbasis S) := by apply hLb_on,
  have hvw : ⟪v, w⟫_ℂ = ite (i = j) 1 0 :=
  begin
    rw ← hi,
    rw ← hj,
    rw orthonormal_iff_ite at hon,
    specialize hon i j,
    exact hon,
  end,
  rw hvw,
  have hij : ¬i = j → ¬v = w :=
  begin
    contrapose,
    push_neg,
    rw ← hi,
    rw ← hj,
    intro h,
    rw Lb_distinct at h,
    exact h,
  end,
  by_cases i = j,
  rw ← hi,
  rw ← hj,
  rw h,
  simp only [if_true, eq_self_iff_true, function.comp_app, linear_isometry.map_eq_iff],
  have hl : @ite ℂ (i = j) _ 1 0 = 0 :=
  begin
    rw ne.ite_eq_right_iff,
    exact h,
    simp only [ne.def, not_false_iff, one_ne_zero],
  end,
  have hr : @ite ℂ (v = w) _ 1 0 = 0 :=
  begin
    rw ne.ite_eq_right_iff,
    apply hij,
    exact h,
    simp only [ne.def, not_false_iff, one_ne_zero],
  end,
  rw hl,
  rw hr,
end

noncomputable def g := L ∘ (onbasis S)

lemma extend_Lb_in_Cn : ∃ (u : set ℂ^n) (H : u ⊇ set.range (g S L)) (b : basis u ℂ ℂ^n), orthonormal ℂ b ∧ ⇑b = coe :=
  exists_subset_is_orthonormal_basis (hLb_still_on S L)

lemma onbasis_injective : function.injective (onbasis S) :=
begin
  apply basis.injective,
end

lemma f_injective : function.injective (f S) :=
begin
  have h_sub_inj : function.injective ⇑(S.subtype) :=
  begin
    apply subtype.coe_injective,
  end,
  apply function.injective.comp h_sub_inj (onbasis_injective S),
end

lemma g_injective : function.injective (g S L) :=
begin
  simp only [g],
  apply function.injective.comp,
  apply linear_isometry.injective L,
  exact onbasis_injective S,
end

noncomputable lemma fintype_v : fintype (set.range (f S)) :=
begin
  apply set.fintype_range (f S),
end

lemma h_card_v : @fintype.card (set.range (f S)) (fintype_v S) = fintype.card (orthonormal_basis_index ℂ S) :=
begin
  rw set.card_range_of_injective,
  exact f_injective S,
end

noncomputable lemma fintype_Lv : fintype (set.range (g S L)) :=
begin
  apply set.fintype_range (g S L),
end

lemma h_card_Lv : @fintype.card (set.range (g S L)) (fintype_Lv S L) = fintype.card (orthonormal_basis_index ℂ S) :=
begin
  rw set.card_range_of_injective,
  exact g_injective S L,
end

lemma h_card_v_Lv :  @fintype.card (set.range (f S)) (fintype_v S) = @fintype.card (set.range (g S L)) (fintype_Lv S L) :=
begin
  rw h_card_v,
  rw h_card_Lv,
end

def u := classical.some (extend_b_in_Cn S)

noncomputable def b_u := (extend_b_in_Cn S).some_spec.some_spec.some

noncomputable lemma fintype_u : fintype (u S) := by apply finite_dimensional.fintype_basis_index (b_u S)

lemma h_v_u : (set.range (f S) ⊆ u S) := (extend_b_in_Cn S).some_spec.some

lemma h_f : ∀ (x : (orthonormal_basis_index ℂ S)), (f S x) ∈ (u S) :=
begin
  intro x,
  apply set.mem_of_subset_of_mem (h_v_u S),
  apply set.mem_range_self x,
end

def Mu := classical.some (extend_Lb_in_Cn S L)

noncomputable def b_Mu := (extend_Lb_in_Cn S L).some_spec.some_spec.some

noncomputable lemma fintype_Mu : fintype (Mu S L) := by apply finite_dimensional.fintype_basis_index (b_Mu S L)

lemma h_card_u_Mu : @fintype.card (u S) (fintype_u S) = @fintype.card (Mu S L) (fintype_Mu S L) :=
begin
  rw ← @finite_dimensional.finrank_eq_card_basis _ _ _ _ _ _ (fintype_u S) (b_u S),
  rw ← @finite_dimensional.finrank_eq_card_basis _ _ _ _ _ _ (fintype_Mu S L) (b_Mu S L),
end

lemma h_Lv_Mu : set.range (g S L) ⊆ (Mu S L) := (extend_Lb_in_Cn S L).some_spec.some

def h_Mu := classical.some_spec (extend_Lb_in_Cn S L)

noncomputable def f_to_u := set.cod_restrict (f S) (u S) (h_f S)

lemma L_to_M : ∃ (M : (ℂ^n) →ₗᵢ[ℂ] (ℂ^n)), (∀ (s : S), M s = L s) :=
begin

  let vc := (u S) \ set.range (f S),
  let Lvc := (Mu S L) \ set.range (g S L),

  have fintype_vc : fintype vc :=
  begin
    apply @set.fintype_subset _ (u S) _ (fintype_u S) _ _,
    exact classical.dec_pred (λ (_x : ℂ^n), _x ∈ vc),
    apply set.diff_subset,
  end,

  have fintype_Lvc : fintype Lvc :=
  begin
    apply @set.fintype_subset _ (Mu S L) _ (fintype_Mu S L) _ _,
    exact classical.dec_pred (λ (_x : ℂ^n), _x ∈ Lvc),
    apply set.diff_subset,
  end,

  have h_card_vc : @fintype.card vc fintype_vc = @fintype.card Lvc fintype_Lvc :=
  begin
    rw ← set.to_finset_card,
    rw ← set.to_finset_card,
    rw @set.to_finset_sdiff _ _ _ _ (fintype_u S) (fintype_v S) fintype_vc,
    rw @set.to_finset_sdiff _ _ _ _ (fintype_Mu S L) (fintype_Lv S L) fintype_Lvc,
    rw finset.card_sdiff,
    rw finset.card_sdiff,
    simp only [set.to_finset_card],
    rw h_card_v_Lv,
    rw h_card_u_Mu,
    rw set.to_finset_mono,
    exact h_Lv_Mu S L,
    rw set.to_finset_mono,
    exact h_v_u S,
  end,

  have h_e1 : ∃ (e1 : vc ≃ Lvc), true :=
  begin
    rw exists_true_iff_nonempty,
    rw ← @fintype.card_eq _ _ fintype_vc fintype_Lvc,
    exact h_card_vc,
  end,

  let e1 := classical.some h_e1,

  clear h_card_vc,
  clear fintype_vc,
  clear fintype_Lvc,

  let e2 := ⇑e1,

  have h_e2 : (function.bijective e2) := equiv.bijective e1,

  have h_Lvc_inc : Lvc ⊆ set.univ := set.subset_univ Lvc,

  let e := (equiv.set.univ (ℂ^n)) ∘ (set.inclusion h_Lvc_inc) ∘ e2,

  have h_e : (function.injective e) :=
  begin
    rw equiv.comp_injective,
    apply function.injective.comp,
    exact set.inclusion_injective h_Lvc_inc,
    exact equiv.injective e1,
  end,

  have h_vc : vc ⊆ (u S) := set.diff_subset (u S) _,

  let e' := function.extend (set.inclusion h_vc) e (0 : (u S) → (ℂ^n)),

  have h_e' : ∀ (x : vc), e' ((set.inclusion h_vc x)) = e x :=
  begin
    intro x,
    apply function.extend_apply,
    exact set.inclusion_injective h_vc,
  end,

  /-
  function.extend gives a map M : u → ℂ^n where for x = f i ∈ v,
    x = f i ↦ g i = L x,
  and for x ∈ vc,
    x ↦ e x.
  e is an arbitrary bijection between u ∖ v and Mu ∖ Lv
  -/

  let M1 := function.extend (f_to_u S) (g S L) e',

  let M2 := (basis.constr (b_u S) ℂ) M1,

  have h_f_to_u_injective : function.injective (f_to_u S) := sorry,

  have h_Mb_on : orthonormal ℂ (⇑M2 ∘ ⇑(b_u S)) :=
  begin
    rw orthonormal_iff_ite,
    intros i j,
    rw function.comp_app,
    rw function.comp_app,
    simp only [basis.constr_basis],
    by_cases hx: (∃ (x : (orthonormal_basis_index ℂ S)), (f_to_u S x) = i),
    by_cases hy: (∃ (y : (orthonormal_basis_index ℂ S)), (f_to_u S y) = j),
    let h_x_to_i := classical.some_spec hx,
    let h_y_to_j := classical.some_spec hy,
    rw ← h_x_to_i,
    rw ← h_y_to_j,
    simp only [M1],
    rw function.extend_apply,
    rw function.extend_apply,
    have : orthonormal ℂ (g S L) := sorry,
    rw orthonormal_iff_ite at this,
    specialize this (classical.some hx) (classical.some hy),
    rw this,
    by_cases h_xy : (classical.some hx) = (classical.some hy),
    rw h_xy,
    simp only [if_true, eq_self_iff_true],
    have : ite (classical.some hx = classical.some hy) (1 : ℂ) (0 : ℂ) = (0 : ℂ) :=
    begin
      rw ne.ite_eq_right_iff,
      exact h_xy,
      simp only [ne.def, not_false_iff, one_ne_zero],
    end,
    rw this,
    symmetry,
    rw ne.ite_eq_right_iff,
    apply function.injective.ne h_f_to_u_injective,
    exact h_xy,
    simp only [ne.def, not_false_iff, one_ne_zero],
    exact h_f_to_u_injective,
    exact h_f_to_u_injective,
    simp only [M1],
    rw function.extend_apply' _ _ _ hy,
    let h_x_to_i := classical.some_spec hx,
    rw ← h_x_to_i,
    rw function.extend_apply h_f_to_u_injective,
    sorry,
    sorry,
  end,

  let M := M2.isometry_of_orthonormal (hb_on S) h_Mb_on,
  use M,
  intro s,
  simp only [M],
  rw linear_map.coe_isometry_of_orthonormal,
  rw @basis.constr_apply_fintype _ _ _ _ _ _ _ _ _ fintype_u b_u ℂ _ _ _ M1 s,
  rw basis.equiv_fun_apply,
  sorry,
end


import combinatorics.simple_graph.basic
import combinatorics.simple_graph.clique

def k6:=complete_graph(fin 6)

--#check (k6.neighbor_finset 0).card

#check k6.is_clique{1,2}

def arrowing {α: Type} (G: simple_graph α )(s t : ℕ ):Prop :=
  (∃ S: finset α , S.card = s ∧ G.is_clique S) ∨ (∃ T: finset α , T.card = s ∧ Gᶜ .is_clique T)

theorem R33: ∀ G: simple_graph(fin 6), arrowing G 3 3 :=
begin

end


import game.sets.sets_level10
import data.real.basic

namespace xena -- hide

/-
# Chapter 2 : Order

## Level 1

This level aims to familiarize you with the use of the trichotomy property in
Lean, as it will come in handy in later levels.
This property is stated in Lean's mathlib is:

`lt_trichotomy : ∀ (a b : ?M_1), a < b ∨ a = b ∨ b < a`

and you can just use it to finish the proof below.
-/

/- Lemma
For any two real numbers $a$ and $b$, we have that
$$ a < b \lor a = b \lor b < a$$.
-/
theorem trichotomy' (a b : ℝ) : a < b ∨ a = b ∨ b < a :=
begin
    have j := lt_trichotomy a b,
    exact j,
end

end xena --hide


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import data.fintype.basic
import data.multiset.sort
import data.list.nodup_equiv_fin

/-!
# Construct a sorted list from a finset.
-/

namespace finset

open multiset nat
variables {α β : Type*}

/-! ### sort -/
section sort
variables (r : α → α → Prop) [decidable_rel r]
  [is_trans α r] [is_antisymm α r] [is_total α r]

/-- `sort s` constructs a sorted list from the unordered set `s`.
  (Uses merge sort algorithm.) -/
def sort (s : finset α) : list α := sort r s.1

@[simp] theorem sort_sorted (s : finset α) : list.sorted r (sort r s) :=
sort_sorted _ _

@[simp] theorem sort_eq (s : finset α) : ↑(sort r s) = s.1 :=
sort_eq _ _

@[simp] theorem sort_nodup (s : finset α) : (sort r s).nodup :=
(by rw sort_eq; exact s.2 : @multiset.nodup α (sort r s))

@[simp] theorem sort_to_finset [decidable_eq α] (s : finset α) : (sort r s).to_finset = s :=
list.to_finset_eq (sort_nodup r s) ▸ eq_of_veq (sort_eq r s)

@[simp] theorem mem_sort {s : finset α} {a : α} : a ∈ sort r s ↔ a ∈ s :=
multiset.mem_sort _

@[simp] theorem length_sort {s : finset α} : (sort r s).length = s.card :=
multiset.length_sort _

lemma sort_perm_to_list (s : finset α) : sort r s ~ s.to_list :=
by { rw ←multiset.coe_eq_coe, simp only [coe_to_list, sort_eq] }

end sort

section sort_linear_order

variables [linear_order α]

theorem sort_sorted_lt (s : finset α) : list.sorted (<) (sort (≤) s) :=
(sort_sorted _ _).imp₂ (@lt_of_le_of_ne _ _) (sort_nodup _ _)

lemma sorted_zero_eq_min'_aux (s : finset α) (h : 0 < (s.sort (≤)).length) (H : s.nonempty) :
  (s.sort (≤)).nth_le 0 h = s.min' H :=
begin
  let l := s.sort (≤),
  apply le_antisymm,
  { have : s.min' H ∈ l := (finset.mem_sort (≤)).mpr (s.min'_mem H),
    obtain ⟨i, i_lt, hi⟩ : ∃ i (hi : i < l.length), l.nth_le i hi = s.min' H :=
      list.mem_iff_nth_le.1 this,
    rw ← hi,
    exact (s.sort_sorted (≤)).rel_nth_le_of_le _ _ (nat.zero_le i) },
  { have : l.nth_le 0 h ∈ s := (finset.mem_sort (≤)).1 (list.nth_le_mem l 0 h),
    exact s.min'_le _ this }
end

lemma sorted_zero_eq_min' {s : finset α} {h : 0 < (s.sort (≤)).length} :
  (s.sort (≤)).nth_le 0 h = s.min' (card_pos.1 $ by rwa length_sort at h) :=
sorted_zero_eq_min'_aux _ _ _

lemma min'_eq_sorted_zero {s : finset α} {h : s.nonempty} :
  s.min' h = (s.sort (≤)).nth_le 0 (by { rw length_sort, exact card_pos.2 h }) :=
(sorted_zero_eq_min'_aux _ _ _).symm

lemma sorted_last_eq_max'_aux (s : finset α) (h : (s.sort (≤)).length - 1 < (s.sort (≤)).length)
  (H : s.nonempty) : (s.sort (≤)).nth_le ((s.sort (≤)).length - 1) h = s.max' H :=
begin
  let l := s.sort (≤),
  apply le_antisymm,
  { have : l.nth_le ((s.sort (≤)).length - 1) h ∈ s :=
      (finset.mem_sort (≤)).1 (list.nth_le_mem l _ h),
    exact s.le_max' _ this },
  { have : s.max' H ∈ l := (finset.mem_sort (≤)).mpr (s.max'_mem H),
    obtain ⟨i, i_lt, hi⟩ : ∃ i (hi : i < l.length), l.nth_le i hi = s.max' H :=
      list.mem_iff_nth_le.1 this,
    rw ← hi,
    have : i ≤ l.length - 1 := nat.le_pred_of_lt i_lt,
    exact (s.sort_sorted (≤)).rel_nth_le_of_le _ _ (nat.le_pred_of_lt i_lt) },
end

lemma sorted_last_eq_max' {s : finset α} {h : (s.sort (≤)).length - 1 < (s.sort (≤)).length} :
  (s.sort (≤)).nth_le ((s.sort (≤)).length - 1) h =
  s.max' (by { rw length_sort at h, exact card_pos.1 (lt_of_le_of_lt bot_le h) }) :=
sorted_last_eq_max'_aux _ _ _

lemma max'_eq_sorted_last {s : finset α} {h : s.nonempty} :
  s.max' h = (s.sort (≤)).nth_le ((s.sort (≤)).length - 1)
    (by simpa using nat.sub_lt (card_pos.mpr h) zero_lt_one) :=
(sorted_last_eq_max'_aux _ _ _).symm

/-- Given a finset `s` of cardinality `k` in a linear order `α`, the map `order_iso_of_fin s h`
is the increasing bijection between `fin k` and `s` as an `order_iso`. Here, `h` is a proof that
the cardinality of `s` is `k`. We use this instead of an iso `fin s.card ≃o s` to avoid
casting issues in further uses of this function. -/
def order_iso_of_fin (s : finset α) {k : ℕ} (h : s.card = k) : fin k ≃o s :=
order_iso.trans (fin.cast ((length_sort (≤)).trans h).symm) $
  (s.sort_sorted_lt.nth_le_iso _).trans $ order_iso.set_congr _ _ $
    set.ext $ λ x, mem_sort _

/-- Given a finset `s` of cardinality `k` in a linear order `α`, the map `order_emb_of_fin s h` is
the increasing bijection between `fin k` and `s` as an order embedding into `α`. Here, `h` is a
proof that the cardinality of `s` is `k`. We use this instead of an embedding `fin s.card ↪o α` to
avoid casting issues in further uses of this function. -/
def order_emb_of_fin (s : finset α) {k : ℕ} (h : s.card = k) : fin k ↪o α :=
(order_iso_of_fin s h).to_order_embedding.trans (order_embedding.subtype _)

@[simp] lemma coe_order_iso_of_fin_apply (s : finset α) {k : ℕ} (h : s.card = k) (i : fin k) :
  ↑(order_iso_of_fin s h i) = order_emb_of_fin s h i :=
rfl

lemma order_iso_of_fin_symm_apply (s : finset α) {k : ℕ} (h : s.card = k) (x : s) :
  ↑((s.order_iso_of_fin h).symm x) = (s.sort (≤)).index_of x :=
rfl

lemma order_emb_of_fin_apply (s : finset α) {k : ℕ} (h : s.card = k) (i : fin k) :
  s.order_emb_of_fin h i = (s.sort (≤)).nth_le i (by { rw [length_sort, h], exact i.2 }) :=
rfl

@[simp] lemma order_emb_of_fin_mem (s : finset α) {k : ℕ} (h : s.card = k) (i : fin k) :
  s.order_emb_of_fin h i ∈ s :=
(s.order_iso_of_fin h i).2

@[simp] lemma range_order_emb_of_fin (s : finset α) {k : ℕ} (h : s.card = k) :
  set.range (s.order_emb_of_fin h) = s :=
by simp [order_emb_of_fin, set.range_comp coe (s.order_iso_of_fin h)]

/-- The bijection `order_emb_of_fin s h` sends `0` to the minimum of `s`. -/
lemma order_emb_of_fin_zero {s : finset α} {k : ℕ} (h : s.card = k) (hz : 0 < k) :
  order_emb_of_fin s h ⟨0, hz⟩ = s.min' (card_pos.mp (h.symm ▸ hz)) :=
by simp only [order_emb_of_fin_apply, subtype.coe_mk, sorted_zero_eq_min']

/-- The bijection `order_emb_of_fin s h` sends `k-1` to the maximum of `s`. -/
lemma order_emb_of_fin_last {s : finset α} {k : ℕ} (h : s.card = k) (hz : 0 < k) :
  order_emb_of_fin s h ⟨k-1, buffer.lt_aux_2 hz⟩ = s.max' (card_pos.mp (h.symm ▸ hz)) :=
by simp [order_emb_of_fin_apply, max'_eq_sorted_last, h]

/-- `order_emb_of_fin {a} h` sends any argument to `a`. -/
@[simp] lemma order_emb_of_fin_singleton (a : α) (i : fin 1) :
  order_emb_of_fin {a} (card_singleton a) i = a :=
by rw [subsingleton.elim i ⟨0, zero_lt_one⟩, order_emb_of_fin_zero _ zero_lt_one, min'_singleton]

/-- Any increasing map `f` from `fin k` to a finset of cardinality `k` has to coincide with
the increasing bijection `order_emb_of_fin s h`. -/
lemma order_emb_of_fin_unique {s : finset α} {k : ℕ} (h : s.card = k) {f : fin k → α}
  (hfs : ∀ x, f x ∈ s) (hmono : strict_mono f) : f = s.order_emb_of_fin h :=
begin
  apply fin.strict_mono_unique hmono (s.order_emb_of_fin h).strict_mono,
  rw [range_order_emb_of_fin, ← set.image_univ, ← coe_fin_range, ← coe_image, coe_inj],
  refine eq_of_subset_of_card_le (λ x hx, _) _,
  { rcases mem_image.1 hx with ⟨x, hx, rfl⟩, exact hfs x },
  { rw [h, card_image_of_injective _ hmono.injective, fin_range_card] }
end

/-- An order embedding `f` from `fin k` to a finset of cardinality `k` has to coincide with
the increasing bijection `order_emb_of_fin s h`. -/
lemma order_emb_of_fin_unique' {s : finset α} {k : ℕ} (h : s.card = k) {f : fin k ↪o α}
  (hfs : ∀ x, f x ∈ s) : f = s.order_emb_of_fin h :=
rel_embedding.ext $ function.funext_iff.1 $ order_emb_of_fin_unique h hfs f.strict_mono

/-- Two parametrizations `order_emb_of_fin` of the same set take the same value on `i` and `j` if
and only if `i = j`. Since they can be defined on a priori not defeq types `fin k` and `fin l`
(although necessarily `k = l`), the conclusion is rather written `(i : ℕ) = (j : ℕ)`. -/
@[simp] lemma order_emb_of_fin_eq_order_emb_of_fin_iff
  {k l : ℕ} {s : finset α} {i : fin k} {j : fin l} {h : s.card = k} {h' : s.card = l} :
  s.order_emb_of_fin h i = s.order_emb_of_fin h' j ↔ (i : ℕ) = (j : ℕ) :=
begin
  substs k l,
  exact (s.order_emb_of_fin rfl).eq_iff_eq.trans (fin.ext_iff _ _)
end

lemma card_le_of_interleaved {s t : finset α} (h : ∀ x y ∈ s, x < y → ∃ z ∈ t, x < z ∧ z < y) :
  s.card ≤ t.card + 1 :=
begin
  have h1 : ∀ i : fin (s.card - 1), ↑i + 1 < (s.sort (≤)).length,
  { intro i,
    rw [finset.length_sort, ←lt_tsub_iff_right],
    exact i.2 },
  have h0 : ∀ i : fin (s.card - 1), ↑i < (s.sort (≤)).length :=
  λ i, lt_of_le_of_lt (nat.le_succ i) (h1 i),
  have p := λ i : fin (s.card - 1), h ((s.sort (≤)).nth_le i (h0 i))
    ((s.sort (≤)).nth_le (i + 1) (h1 i))
    ((finset.mem_sort (≤)).mp (list.nth_le_mem _ _ (h0 i)))
    ((finset.mem_sort (≤)).mp (list.nth_le_mem _ _ (h1 i)))
    (s.sort_sorted_lt.rel_nth_le_of_lt (h0 i) (h1 i) (nat.lt_succ_self i)),
  let f : fin (s.card - 1) → t :=
  λ i, ⟨classical.some (p i), (exists_prop.mp (classical.some_spec (p i))).1⟩,
  have hf : ∀ i j : fin (s.card - 1), i < j → f i < f j :=
  λ i j hij, subtype.coe_lt_coe.mp ((exists_prop.mp (classical.some_spec (p i))).2.2.trans
    (lt_of_le_of_lt ((s.sort_sorted (≤)).rel_nth_le_of_le (h1 i) (h0 j) (nat.succ_le_iff.mpr hij))
    (exists_prop.mp (classical.some_spec (p j))).2.1)),
  have key := fintype.card_le_of_embedding (function.embedding.mk f (λ i j hij, le_antisymm
    (not_lt.mp (mt (hf j i) (not_lt.mpr (le_of_eq hij))))
    (not_lt.mp (mt (hf i j) (not_lt.mpr (ge_of_eq hij)))))),
  rwa [fintype.card_fin, fintype.card_coe, tsub_le_iff_right] at key,
end

end sort_linear_order

instance [has_repr α] : has_repr (finset α) := ⟨λ s, repr s.1⟩

end finset


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Chris Hughes, Mario Carneiro
-/
import algebra.associated
import linear_algebra.basic
import order.zorn
import order.atoms
import order.compactly_generated
import tactic.abel
/-!

# Ideals over a ring

This file defines `ideal R`, the type of ideals over a commutative ring `R`.

## Implementation notes

`ideal R` is implemented using `submodule R R`, where `•` is interpreted as `*`.

## TODO

Support one-sided ideals, and ideals over non-commutative rings.
-/

universes u v w
variables {α : Type u} {β : Type v}
open set function

open_locale classical big_operators pointwise

/-- A (left) ideal in a semiring `R` is an additive submonoid `s` such that
`a * b ∈ s` whenever `b ∈ s`. If `R` is a ring, then `s` is an additive subgroup.  -/
@[reducible] def ideal (R : Type u) [semiring R] := submodule R R

section semiring

namespace ideal
variables [semiring α] (I : ideal α) {a b : α}

protected lemma zero_mem : (0 : α) ∈ I := I.zero_mem

protected lemma add_mem : a ∈ I → b ∈ I → a + b ∈ I := I.add_mem

variables (a)
lemma mul_mem_left : b ∈ I → a * b ∈ I := I.smul_mem a
variables {a}

@[ext] lemma ext {I J : ideal α} (h : ∀ x, x ∈ I ↔ x ∈ J) : I = J :=
submodule.ext h

theorem eq_top_of_unit_mem
  (x y : α) (hx : x ∈ I) (h : y * x = 1) : I = ⊤ :=
eq_top_iff.2 $ λ z _, calc
    z = z * (y * x) : by simp [h]
  ... = (z * y) * x : eq.symm $ mul_assoc z y x
  ... ∈ I : I.mul_mem_left _ hx

theorem eq_top_of_is_unit_mem {x} (hx : x ∈ I) (h : is_unit x) : I = ⊤ :=
let ⟨y, hy⟩ := h.exists_left_inv in eq_top_of_unit_mem I x y hx hy

theorem eq_top_iff_one : I = ⊤ ↔ (1:α) ∈ I :=
⟨by rintro rfl; trivial,
 λ h, eq_top_of_unit_mem _ _ 1 h (by simp)⟩

theorem ne_top_iff_one : I ≠ ⊤ ↔ (1:α) ∉ I :=
not_congr I.eq_top_iff_one

@[simp]
theorem unit_mul_mem_iff_mem {x y : α} (hy : is_unit y) : y * x ∈ I ↔ x ∈ I :=
begin
  refine ⟨λ h, _, λ h, I.mul_mem_left y h⟩,
  obtain ⟨y', hy'⟩ := hy.exists_left_inv,
  have := I.mul_mem_left y' h,
  rwa [← mul_assoc, hy', one_mul] at this,
end

/-- The ideal generated by a subset of a ring -/
def span (s : set α) : ideal α := submodule.span α s

@[simp] lemma submodule_span_eq {s : set α} :
  submodule.span α s = ideal.span s :=
rfl

lemma subset_span {s : set α} : s ⊆ span s := submodule.subset_span

lemma span_le {s : set α} {I} : span s ≤ I ↔ s ⊆ I := submodule.span_le

lemma span_mono {s t : set α} : s ⊆ t → span s ≤ span t := submodule.span_mono

@[simp] lemma span_eq : span (I : set α) = I := submodule.span_eq _

@[simp] lemma span_singleton_one : span ({1} : set α) = ⊤ :=
(eq_top_iff_one _).2 $ subset_span $ mem_singleton _

lemma mem_span_insert {s : set α} {x y} :
  x ∈ span (insert y s) ↔ ∃ a (z ∈ span s), x = a * y + z := submodule.mem_span_insert

lemma mem_span_singleton' {x y : α} :
  x ∈ span ({y} : set α) ↔ ∃ a, a * y = x := submodule.mem_span_singleton

lemma span_insert (x) (s : set α) : span (insert x s) = span ({x} : set α) ⊔ span s :=
submodule.span_insert x s

lemma span_eq_bot {s : set α} : span s = ⊥ ↔ ∀ x ∈ s, (x:α) = 0 := submodule.span_eq_bot

@[simp] lemma span_singleton_eq_bot {x} : span ({x} : set α) = ⊥ ↔ x = 0 :=
submodule.span_singleton_eq_bot

@[simp] lemma span_zero : span (0 : set α) = ⊥ := by rw [←set.singleton_zero, span_singleton_eq_bot]

@[simp] lemma span_one : span (1 : set α) = ⊤ := by rw [←set.singleton_one, span_singleton_one]

/--
The ideal generated by an arbitrary binary relation.
-/
def of_rel (r : α → α → Prop) : ideal α :=
submodule.span α { x | ∃ (a b) (h : r a b), x + b = a }

/-- An ideal `P` of a ring `R` is prime if `P ≠ R` and `xy ∈ P → x ∈ P ∨ y ∈ P` -/
class is_prime (I : ideal α) : Prop :=
(ne_top' : I ≠ ⊤)
(mem_or_mem' : ∀ {x y : α}, x * y ∈ I → x ∈ I ∨ y ∈ I)

theorem is_prime_iff {I : ideal α} :
  is_prime I ↔ I ≠ ⊤ ∧ ∀ {x y : α}, x * y ∈ I → x ∈ I ∨ y ∈ I :=
⟨λ h, ⟨h.1, h.2⟩, λ h, ⟨h.1, h.2⟩⟩

theorem is_prime.ne_top {I : ideal α} (hI : I.is_prime) : I ≠ ⊤ := hI.1

theorem is_prime.mem_or_mem {I : ideal α} (hI : I.is_prime) :
  ∀ {x y : α}, x * y ∈ I → x ∈ I ∨ y ∈ I := hI.2

theorem is_prime.mem_or_mem_of_mul_eq_zero {I : ideal α} (hI : I.is_prime)
  {x y : α} (h : x * y = 0) : x ∈ I ∨ y ∈ I :=
hI.mem_or_mem (h.symm ▸ I.zero_mem)

theorem is_prime.mem_of_pow_mem {I : ideal α} (hI : I.is_prime)
  {r : α} (n : ℕ) (H : r^n ∈ I) : r ∈ I :=
begin
  induction n with n ih,
  { rw pow_zero at H, exact (mt (eq_top_iff_one _).2 hI.1).elim H },
  { rw pow_succ at H, exact or.cases_on (hI.mem_or_mem H) id ih }
end

lemma not_is_prime_iff {I : ideal α} : ¬ I.is_prime ↔ I = ⊤ ∨ ∃ (x ∉ I) (y ∉ I), x * y ∈ I :=
begin
  simp_rw [ideal.is_prime_iff, not_and_distrib, ne.def, not_not, not_forall, not_or_distrib],
  exact or_congr iff.rfl
    ⟨λ ⟨x, y, hxy, hx, hy⟩, ⟨x, hx, y, hy, hxy⟩, λ ⟨x, hx, y, hy, hxy⟩, ⟨x, y, hxy, hx, hy⟩⟩
end

theorem zero_ne_one_of_proper {I : ideal α} (h : I ≠ ⊤) : (0:α) ≠ 1 :=
λ hz, I.ne_top_iff_one.1 h $ hz ▸ I.zero_mem

lemma bot_prime {R : Type*} [ring R] [is_domain R] : (⊥ : ideal R).is_prime :=
⟨λ h, one_ne_zero (by rwa [ideal.eq_top_iff_one, submodule.mem_bot] at h),
 λ x y h, mul_eq_zero.mp (by simpa only [submodule.mem_bot] using h)⟩

/-- An ideal is maximal if it is maximal in the collection of proper ideals. -/
class is_maximal (I : ideal α) : Prop := (out : is_coatom I)

theorem is_maximal_def {I : ideal α} : I.is_maximal ↔ is_coatom I := ⟨λ h, h.1, λ h, ⟨h⟩⟩

theorem is_maximal.ne_top {I : ideal α} (h : I.is_maximal) : I ≠ ⊤ := (is_maximal_def.1 h).1

theorem is_maximal_iff {I : ideal α} : I.is_maximal ↔
  (1:α) ∉ I ∧ ∀ (J : ideal α) x, I ≤ J → x ∉ I → x ∈ J → (1:α) ∈ J :=
is_maximal_def.trans $ and_congr I.ne_top_iff_one $ forall_congr $ λ J,
by rw [lt_iff_le_not_le]; exact
 ⟨λ H x h hx₁ hx₂, J.eq_top_iff_one.1 $
    H ⟨h, not_subset.2 ⟨_, hx₂, hx₁⟩⟩,
  λ H ⟨h₁, h₂⟩, let ⟨x, xJ, xI⟩ := not_subset.1 h₂ in
   J.eq_top_iff_one.2 $ H x h₁ xI xJ⟩

theorem is_maximal.eq_of_le {I J : ideal α}
  (hI : I.is_maximal) (hJ : J ≠ ⊤) (IJ : I ≤ J) : I = J :=
eq_iff_le_not_lt.2 ⟨IJ, λ h, hJ (hI.1.2 _ h)⟩

instance : is_coatomic (ideal α) :=
begin
  apply complete_lattice.coatomic_of_top_compact,
  rw ←span_singleton_one,
  exact submodule.singleton_span_is_compact_element 1,
end

/-- **Krull's theorem**: if `I` is an ideal that is not the whole ring, then it is included in some
    maximal ideal. -/
theorem exists_le_maximal (I : ideal α) (hI : I ≠ ⊤) :
  ∃ M : ideal α, M.is_maximal ∧ I ≤ M :=
let ⟨m, hm⟩ := (eq_top_or_exists_le_coatom I).resolve_left hI in ⟨m, ⟨⟨hm.1⟩, hm.2⟩⟩

variables (α)

/-- Krull's theorem: a nontrivial ring has a maximal ideal. -/
theorem exists_maximal [nontrivial α] : ∃ M : ideal α, M.is_maximal :=
let ⟨I, ⟨hI, _⟩⟩ := exists_le_maximal (⊥ : ideal α) bot_ne_top in ⟨I, hI⟩

variables {α}

instance [nontrivial α] : nontrivial (ideal α) :=
begin
  rcases @exists_maximal α _ _ with ⟨M, hM, _⟩,
  exact nontrivial_of_ne M ⊤ hM
end

/-- If P is not properly contained in any maximal ideal then it is not properly contained
  in any proper ideal -/
lemma maximal_of_no_maximal {R : Type u} [comm_semiring R] {P : ideal R}
(hmax : ∀ m : ideal R, P < m → ¬is_maximal m) (J : ideal R) (hPJ : P < J) : J = ⊤ :=
begin
  by_contradiction hnonmax,
  rcases exists_le_maximal J hnonmax with ⟨M, hM1, hM2⟩,
  exact hmax M (lt_of_lt_of_le hPJ hM2) hM1,
end

theorem mem_span_pair {x y z : α} :
  z ∈ span ({x, y} : set α) ↔ ∃ a b, a * x + b * y = z :=
by simp [mem_span_insert, mem_span_singleton', @eq_comm _ _ z]

theorem is_maximal.exists_inv {I : ideal α}
  (hI : I.is_maximal) {x} (hx : x ∉ I) : ∃ y, ∃ i ∈ I, y * x + i = 1 :=
begin
  cases is_maximal_iff.1 hI with H₁ H₂,
  rcases mem_span_insert.1 (H₂ (span (insert x I)) x
    (set.subset.trans (subset_insert _ _) subset_span)
    hx (subset_span (mem_insert _ _))) with ⟨y, z, hz, hy⟩,
  refine ⟨y, z, _, hy.symm⟩,
  rwa ← span_eq I,
end

section lattice
variables {R : Type u} [semiring R]

lemma mem_sup_left {S T : ideal R} : ∀ {x : R}, x ∈ S → x ∈ S ⊔ T :=
show S ≤ S ⊔ T, from le_sup_left

lemma mem_sup_right {S T : ideal R} : ∀ {x : R}, x ∈ T → x ∈ S ⊔ T :=
show T ≤ S ⊔ T, from le_sup_right

lemma mem_Sup_of_mem {S : set (ideal R)} {s : ideal R}
  (hs : s ∈ S) : ∀ {x : R}, x ∈ s → x ∈ Sup S :=
show s ≤ Sup S, from le_Sup hs

theorem mem_Inf {s : set (ideal R)} {x : R} :
  x ∈ Inf s ↔ ∀ ⦃I⦄, I ∈ s → x ∈ I :=
⟨λ hx I his, hx I ⟨I, infi_pos his⟩, λ H I ⟨J, hij⟩, hij ▸ λ S ⟨hj, hS⟩, hS ▸ H hj⟩

@[simp] lemma mem_inf {I J : ideal R} {x : R} : x ∈ I ⊓ J ↔ x ∈ I ∧ x ∈ J := iff.rfl

@[simp] lemma mem_infi {ι : Type*} {I : ι → ideal R} {x : R} : x ∈ infi I ↔ ∀ i, x ∈ I i :=
submodule.mem_infi _

@[simp] lemma mem_bot {x : R} : x ∈ (⊥ : ideal R) ↔ x = 0 :=
submodule.mem_bot _

end lattice

section pi
variables (ι : Type v)

/-- `I^n` as an ideal of `R^n`. -/
def pi : ideal (ι → α) :=
{ carrier := { x | ∀ i, x i ∈ I },
  zero_mem' := λ i, I.zero_mem,
  add_mem' := λ a b ha hb i, I.add_mem (ha i) (hb i),
  smul_mem' := λ a b hb i, I.mul_mem_left (a i) (hb i) }

lemma mem_pi (x : ι → α) : x ∈ I.pi ι ↔ ∀ i, x i ∈ I := iff.rfl

end pi

end ideal

end semiring

section comm_semiring

variables {a b : α}

-- A separate namespace definition is needed because the variables were historically in a different
-- order.
namespace ideal
variables [comm_semiring α] (I : ideal α)

@[simp]
theorem mul_unit_mem_iff_mem {x y : α} (hy : is_unit y) : x * y ∈ I ↔ x ∈ I :=
mul_comm y x ▸ unit_mul_mem_iff_mem I hy

lemma mem_span_singleton {x y : α} :
  x ∈ span ({y} : set α) ↔ y ∣ x :=
mem_span_singleton'.trans $ exists_congr $ λ _, by rw [eq_comm, mul_comm]

lemma span_singleton_le_span_singleton {x y : α} :
  span ({x} : set α) ≤ span ({y} : set α) ↔ y ∣ x :=
span_le.trans $ singleton_subset_iff.trans mem_span_singleton

lemma span_singleton_eq_span_singleton {α : Type u} [comm_ring α] [is_domain α] {x y : α} :
  span ({x} : set α) = span ({y} : set α) ↔ associated x y :=
begin
  rw [←dvd_dvd_iff_associated, le_antisymm_iff, and_comm],
  apply and_congr;
  rw span_singleton_le_span_singleton,
end

lemma span_singleton_mul_right_unit {a : α} (h2 : is_unit a) (x : α) :
  span ({x * a} : set α) = span {x} :=
begin
  apply le_antisymm,
  { rw span_singleton_le_span_singleton, use a},
  { rw span_singleton_le_span_singleton, rw is_unit.mul_right_dvd h2}
end

lemma span_singleton_mul_left_unit {a : α} (h2 : is_unit a) (x : α) :
  span ({a * x} : set α) = span {x} := by rw [mul_comm, span_singleton_mul_right_unit h2]

lemma span_singleton_eq_top {x} : span ({x} : set α) = ⊤ ↔ is_unit x :=
by rw [is_unit_iff_dvd_one, ← span_singleton_le_span_singleton, span_singleton_one,
  eq_top_iff]

theorem span_singleton_prime {p : α} (hp : p ≠ 0) :
  is_prime (span ({p} : set α)) ↔ prime p :=
by simp [is_prime_iff, prime, span_singleton_eq_top, hp, mem_span_singleton]

theorem is_maximal.is_prime {I : ideal α} (H : I.is_maximal) : I.is_prime :=
⟨H.1.1, λ x y hxy, or_iff_not_imp_left.2 $ λ hx, begin
  let J : ideal α := submodule.span α (insert x ↑I),
  have IJ : I ≤ J  := (set.subset.trans (subset_insert _ _) subset_span),
  have xJ : x ∈ J := ideal.subset_span (set.mem_insert x I),
  cases is_maximal_iff.1 H with _ oJ,
  specialize oJ J x IJ hx xJ,
  rcases submodule.mem_span_insert.mp oJ with ⟨a, b, h, oe⟩,
  obtain (F : y * 1 = y * (a • x + b)) := congr_arg (λ g : α, y * g) oe,
  rw [← mul_one y, F, mul_add, mul_comm, smul_eq_mul, mul_assoc],
  refine submodule.add_mem I (I.mul_mem_left a hxy) (submodule.smul_mem I y _),
  rwa submodule.span_eq at h,
end⟩

@[priority 100] -- see Note [lower instance priority]
instance is_maximal.is_prime' (I : ideal α) : ∀ [H : I.is_maximal], I.is_prime :=
is_maximal.is_prime

lemma span_singleton_lt_span_singleton [comm_ring β] [is_domain β] {x y : β} :
  span ({x} : set β) < span ({y} : set β) ↔ dvd_not_unit y x :=
by rw [lt_iff_le_not_le, span_singleton_le_span_singleton, span_singleton_le_span_singleton,
  dvd_and_not_dvd_iff]

lemma factors_decreasing [comm_ring β] [is_domain β]
  (b₁ b₂ : β) (h₁ : b₁ ≠ 0) (h₂ : ¬ is_unit b₂) :
  span ({b₁ * b₂} : set β) < span {b₁} :=
lt_of_le_not_le (ideal.span_le.2 $ singleton_subset_iff.2 $
  ideal.mem_span_singleton.2 ⟨b₂, rfl⟩) $ λ h,
h₂ $ is_unit_of_dvd_one _ $ (mul_dvd_mul_iff_left h₁).1 $
by rwa [mul_one, ← ideal.span_singleton_le_span_singleton]

variables (b)
lemma mul_mem_right (h : a ∈ I) : a * b ∈ I := mul_comm b a ▸ I.mul_mem_left b h
variables {b}

lemma pow_mem_of_mem (ha : a ∈ I) (n : ℕ) (hn : 0 < n) : a ^ n ∈ I :=
nat.cases_on n (not.elim dec_trivial) (λ m hm, (pow_succ a m).symm ▸ I.mul_mem_right (a^m) ha) hn

theorem is_prime.mul_mem_iff_mem_or_mem {I : ideal α} (hI : I.is_prime) :
  ∀ {x y : α}, x * y ∈ I ↔ x ∈ I ∨ y ∈ I :=
λ x y, ⟨hI.mem_or_mem, by { rintro (h | h), exacts [I.mul_mem_right y h, I.mul_mem_left x h] }⟩

theorem is_prime.pow_mem_iff_mem {I : ideal α} (hI : I.is_prime)
  {r : α} (n : ℕ) (hn : 0 < n) : r ^ n ∈ I ↔ r ∈ I :=
⟨hI.mem_of_pow_mem n, (λ hr, I.pow_mem_of_mem hr n hn)⟩

end ideal

end comm_semiring

section ring

namespace ideal

variables [ring α] (I : ideal α) {a b : α}

lemma neg_mem_iff : -a ∈ I ↔ a ∈ I := I.neg_mem_iff

lemma add_mem_iff_left : b ∈ I → (a + b ∈ I ↔ a ∈ I) := I.add_mem_iff_left

lemma add_mem_iff_right : a ∈ I → (a + b ∈ I ↔ b ∈ I) := I.add_mem_iff_right

protected lemma sub_mem : a ∈ I → b ∈ I → a - b ∈ I := I.sub_mem

lemma mem_span_insert' {s : set α} {x y} :
  x ∈ span (insert y s) ↔ ∃a, x + a * y ∈ span s := submodule.mem_span_insert'

end ideal

end ring

section division_ring
variables {K : Type u} [division_ring K] (I : ideal K)

namespace ideal

/-- All ideals in a division ring are trivial. -/
lemma eq_bot_or_top : I = ⊥ ∨ I = ⊤ :=
begin
  rw or_iff_not_imp_right,
  change _ ≠ _ → _,
  rw ideal.ne_top_iff_one,
  intro h1,
  rw eq_bot_iff,
  intros r hr,
  by_cases H : r = 0, {simpa},
  simpa [H, h1] using I.mul_mem_left r⁻¹ hr,
end

lemma eq_bot_of_prime [h : I.is_prime] : I = ⊥ :=
or_iff_not_imp_right.mp I.eq_bot_or_top h.1

lemma bot_is_maximal : is_maximal (⊥ : ideal K) :=
⟨⟨λ h, absurd ((eq_top_iff_one (⊤ : ideal K)).mp rfl) (by rw ← h; simp),
λ I hI, or_iff_not_imp_left.mp (eq_bot_or_top I) (ne_of_gt hI)⟩⟩

end ideal

end division_ring

section comm_ring

namespace ideal

theorem mul_sub_mul_mem {R : Type*} [comm_ring R] (I : ideal R) {a b c d : R}
  (h1 : a - b ∈ I) (h2 : c - d ∈ I) : a * c - b * d ∈ I :=
begin
  rw (show a * c - b * d = (a - b) * c + b * (c - d), by {rw [sub_mul, mul_sub], abel}),
  exact I.add_mem (I.mul_mem_right _ h1) (I.mul_mem_left _ h2),
end

end ideal

end comm_ring

namespace ring

variables {R : Type*} [comm_ring R]

lemma not_is_field_of_subsingleton {R : Type*} [ring R] [subsingleton R] : ¬ is_field R :=
λ ⟨⟨x, y, hxy⟩, _, _⟩, hxy (subsingleton.elim x y)

lemma exists_not_is_unit_of_not_is_field [nontrivial R] (hf : ¬ is_field R) :
  ∃ x ≠ (0 : R), ¬ is_unit x :=
begin
  have : ¬ _ := λ h, hf ⟨exists_pair_ne R, mul_comm, h⟩,
  simp_rw is_unit_iff_exists_inv,
  push_neg at ⊢ this,
  obtain ⟨x, hx, not_unit⟩ := this,
  exact ⟨x, hx, not_unit⟩
end

lemma not_is_field_iff_exists_ideal_bot_lt_and_lt_top [nontrivial R] :
  ¬ is_field R ↔ ∃ I : ideal R, ⊥ < I ∧ I < ⊤ :=
begin
  split,
  { intro h,
    obtain ⟨x, nz, nu⟩ := exists_not_is_unit_of_not_is_field h,
    use ideal.span {x},
    rw [bot_lt_iff_ne_bot, lt_top_iff_ne_top],
    exact ⟨mt ideal.span_singleton_eq_bot.mp nz, mt ideal.span_singleton_eq_top.mp nu⟩ },
  { rintros ⟨I, bot_lt, lt_top⟩ hf,
    obtain ⟨x, mem, ne_zero⟩ := set_like.exists_of_lt bot_lt,
    rw submodule.mem_bot at ne_zero,
    obtain ⟨y, hy⟩ := hf.mul_inv_cancel ne_zero,
    rw [lt_top_iff_ne_top, ne.def, ideal.eq_top_iff_one, ← hy] at lt_top,
    exact lt_top (I.mul_mem_right _ mem), }
end

lemma not_is_field_iff_exists_prime [nontrivial R] :
  ¬ is_field R ↔ ∃ p : ideal R, p ≠ ⊥ ∧ p.is_prime :=
not_is_field_iff_exists_ideal_bot_lt_and_lt_top.trans
  ⟨λ ⟨I, bot_lt, lt_top⟩, let ⟨p, hp, le_p⟩ := I.exists_le_maximal (lt_top_iff_ne_top.mp lt_top) in
    ⟨p, bot_lt_iff_ne_bot.mp (lt_of_lt_of_le bot_lt le_p), hp.is_prime⟩,
   λ ⟨p, ne_bot, prime⟩, ⟨p, bot_lt_iff_ne_bot.mpr ne_bot, lt_top_iff_ne_top.mpr prime.1⟩⟩

/-- When a ring is not a field, the maximal ideals are nontrivial. -/
lemma ne_bot_of_is_maximal_of_not_is_field [nontrivial R] {M : ideal R} (max : M.is_maximal)
  (not_field : ¬ is_field R) : M ≠ ⊥ :=
begin
  rintros h,
  rw h at max,
  rcases max with ⟨⟨h1, h2⟩⟩,
  obtain ⟨I, hIbot, hItop⟩ := not_is_field_iff_exists_ideal_bot_lt_and_lt_top.mp not_field,
  exact ne_of_lt hItop (h2 I hIbot),
end

end ring

namespace ideal

/-- Maximal ideals in a non-field are nontrivial. -/
variables {R : Type u} [comm_ring R] [nontrivial R]
lemma bot_lt_of_maximal (M : ideal R) [hm : M.is_maximal] (non_field : ¬ is_field R) : ⊥ < M :=
begin
  rcases (ring.not_is_field_iff_exists_ideal_bot_lt_and_lt_top.1 non_field)
    with ⟨I, Ibot, Itop⟩,
  split, finish,
  intro mle,
  apply @irrefl _ (<) _ (⊤ : ideal R),
  have : M = ⊥ := eq_bot_iff.mpr mle,
  rw this at *,
  rwa hm.1.2 I Ibot at Itop,
end

end ideal

variables {a b : α}

/-- The set of non-invertible elements of a monoid. -/
def nonunits (α : Type u) [monoid α] : set α := { a | ¬is_unit a }

@[simp] theorem mem_nonunits_iff [monoid α] : a ∈ nonunits α ↔ ¬ is_unit a := iff.rfl

theorem mul_mem_nonunits_right [comm_monoid α] :
  b ∈ nonunits α → a * b ∈ nonunits α :=
mt is_unit_of_mul_is_unit_right

theorem mul_mem_nonunits_left [comm_monoid α] :
  a ∈ nonunits α → a * b ∈ nonunits α :=
mt is_unit_of_mul_is_unit_left

theorem zero_mem_nonunits [semiring α] : 0 ∈ nonunits α ↔ (0:α) ≠ 1 :=
not_congr is_unit_zero_iff

@[simp] theorem one_not_mem_nonunits [monoid α] : (1:α) ∉ nonunits α :=
not_not_intro is_unit_one

theorem coe_subset_nonunits [semiring α] {I : ideal α} (h : I ≠ ⊤) :
  (I : set α) ⊆ nonunits α :=
λ x hx hu, h $ I.eq_top_of_is_unit_mem hx hu

lemma exists_max_ideal_of_mem_nonunits [comm_semiring α] (h : a ∈ nonunits α) :
  ∃ I : ideal α, I.is_maximal ∧ a ∈ I :=
begin
  have : ideal.span ({a} : set α) ≠ ⊤,
  { intro H, rw ideal.span_singleton_eq_top at H, contradiction },
  rcases ideal.exists_le_maximal _ this with ⟨I, Imax, H⟩,
  use [I, Imax], apply H, apply ideal.subset_span, exact set.mem_singleton a
end


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import data.fintype.basic
import data.multiset.sort
import data.list.nodup_equiv_fin

/-!
# Construct a sorted list from a finset.
-/

namespace finset

open multiset nat
variables {α β : Type*}

/-! ### sort -/
section sort
variables (r : α → α → Prop) [decidable_rel r]
  [is_trans α r] [is_antisymm α r] [is_total α r]

/-- `sort s` constructs a sorted list from the unordered set `s`.
  (Uses merge sort algorithm.) -/
def sort (s : finset α) : list α := sort r s.1

@[simp] theorem sort_sorted (s : finset α) : list.sorted r (sort r s) :=
sort_sorted _ _

@[simp] theorem sort_eq (s : finset α) : ↑(sort r s) = s.1 :=
sort_eq _ _

@[simp] theorem sort_nodup (s : finset α) : (sort r s).nodup :=
(by rw sort_eq; exact s.2 : @multiset.nodup α (sort r s))

@[simp] theorem sort_to_finset [decidable_eq α] (s : finset α) : (sort r s).to_finset = s :=
list.to_finset_eq (sort_nodup r s) ▸ eq_of_veq (sort_eq r s)

@[simp] theorem mem_sort {s : finset α} {a : α} : a ∈ sort r s ↔ a ∈ s :=
multiset.mem_sort _

@[simp] theorem length_sort {s : finset α} : (sort r s).length = s.card :=
multiset.length_sort _

@[simp] theorem sort_empty : sort r ∅ = [] :=
multiset.sort_zero r

@[simp] theorem sort_singleton (a : α) : sort r {a} = [a] :=
multiset.sort_singleton r a

lemma sort_perm_to_list (s : finset α) : sort r s ~ s.to_list :=
by { rw ←multiset.coe_eq_coe, simp only [coe_to_list, sort_eq] }

end sort

section sort_linear_order

variables [linear_order α]

theorem sort_sorted_lt (s : finset α) : list.sorted (<) (sort (≤) s) :=
(sort_sorted _ _).imp₂ (@lt_of_le_of_ne _ _) (sort_nodup _ _)

lemma sorted_zero_eq_min'_aux (s : finset α) (h : 0 < (s.sort (≤)).length) (H : s.nonempty) :
  (s.sort (≤)).nth_le 0 h = s.min' H :=
begin
  let l := s.sort (≤),
  apply le_antisymm,
  { have : s.min' H ∈ l := (finset.mem_sort (≤)).mpr (s.min'_mem H),
    obtain ⟨i, i_lt, hi⟩ : ∃ i (hi : i < l.length), l.nth_le i hi = s.min' H :=
      list.mem_iff_nth_le.1 this,
    rw ← hi,
    exact (s.sort_sorted (≤)).rel_nth_le_of_le _ _ (nat.zero_le i) },
  { have : l.nth_le 0 h ∈ s := (finset.mem_sort (≤)).1 (list.nth_le_mem l 0 h),
    exact s.min'_le _ this }
end

lemma sorted_zero_eq_min' {s : finset α} {h : 0 < (s.sort (≤)).length} :
  (s.sort (≤)).nth_le 0 h = s.min' (card_pos.1 $ by rwa length_sort at h) :=
sorted_zero_eq_min'_aux _ _ _

lemma min'_eq_sorted_zero {s : finset α} {h : s.nonempty} :
  s.min' h = (s.sort (≤)).nth_le 0 (by { rw length_sort, exact card_pos.2 h }) :=
(sorted_zero_eq_min'_aux _ _ _).symm

lemma sorted_last_eq_max'_aux (s : finset α) (h : (s.sort (≤)).length - 1 < (s.sort (≤)).length)
  (H : s.nonempty) : (s.sort (≤)).nth_le ((s.sort (≤)).length - 1) h = s.max' H :=
begin
  let l := s.sort (≤),
  apply le_antisymm,
  { have : l.nth_le ((s.sort (≤)).length - 1) h ∈ s :=
      (finset.mem_sort (≤)).1 (list.nth_le_mem l _ h),
    exact s.le_max' _ this },
  { have : s.max' H ∈ l := (finset.mem_sort (≤)).mpr (s.max'_mem H),
    obtain ⟨i, i_lt, hi⟩ : ∃ i (hi : i < l.length), l.nth_le i hi = s.max' H :=
      list.mem_iff_nth_le.1 this,
    rw ← hi,
    have : i ≤ l.length - 1 := nat.le_pred_of_lt i_lt,
    exact (s.sort_sorted (≤)).rel_nth_le_of_le _ _ (nat.le_pred_of_lt i_lt) },
end

lemma sorted_last_eq_max' {s : finset α} {h : (s.sort (≤)).length - 1 < (s.sort (≤)).length} :
  (s.sort (≤)).nth_le ((s.sort (≤)).length - 1) h =
  s.max' (by { rw length_sort at h, exact card_pos.1 (lt_of_le_of_lt bot_le h) }) :=
sorted_last_eq_max'_aux _ _ _

lemma max'_eq_sorted_last {s : finset α} {h : s.nonempty} :
  s.max' h = (s.sort (≤)).nth_le ((s.sort (≤)).length - 1)
    (by simpa using nat.sub_lt (card_pos.mpr h) zero_lt_one) :=
(sorted_last_eq_max'_aux _ _ _).symm

/-- Given a finset `s` of cardinality `k` in a linear order `α`, the map `order_iso_of_fin s h`
is the increasing bijection between `fin k` and `s` as an `order_iso`. Here, `h` is a proof that
the cardinality of `s` is `k`. We use this instead of an iso `fin s.card ≃o s` to avoid
casting issues in further uses of this function. -/
def order_iso_of_fin (s : finset α) {k : ℕ} (h : s.card = k) : fin k ≃o s :=
order_iso.trans (fin.cast ((length_sort (≤)).trans h).symm) $
  (s.sort_sorted_lt.nth_le_iso _).trans $ order_iso.set_congr _ _ $
    set.ext $ λ x, mem_sort _

/-- Given a finset `s` of cardinality `k` in a linear order `α`, the map `order_emb_of_fin s h` is
the increasing bijection between `fin k` and `s` as an order embedding into `α`. Here, `h` is a
proof that the cardinality of `s` is `k`. We use this instead of an embedding `fin s.card ↪o α` to
avoid casting issues in further uses of this function. -/
def order_emb_of_fin (s : finset α) {k : ℕ} (h : s.card = k) : fin k ↪o α :=
(order_iso_of_fin s h).to_order_embedding.trans (order_embedding.subtype _)

@[simp] lemma coe_order_iso_of_fin_apply (s : finset α) {k : ℕ} (h : s.card = k) (i : fin k) :
  ↑(order_iso_of_fin s h i) = order_emb_of_fin s h i :=
rfl

lemma order_iso_of_fin_symm_apply (s : finset α) {k : ℕ} (h : s.card = k) (x : s) :
  ↑((s.order_iso_of_fin h).symm x) = (s.sort (≤)).index_of x :=
rfl

lemma order_emb_of_fin_apply (s : finset α) {k : ℕ} (h : s.card = k) (i : fin k) :
  s.order_emb_of_fin h i = (s.sort (≤)).nth_le i (by { rw [length_sort, h], exact i.2 }) :=
rfl

@[simp] lemma order_emb_of_fin_mem (s : finset α) {k : ℕ} (h : s.card = k) (i : fin k) :
  s.order_emb_of_fin h i ∈ s :=
(s.order_iso_of_fin h i).2

@[simp] lemma range_order_emb_of_fin (s : finset α) {k : ℕ} (h : s.card = k) :
  set.range (s.order_emb_of_fin h) = s :=
by simp [order_emb_of_fin, set.range_comp coe (s.order_iso_of_fin h)]

/-- The bijection `order_emb_of_fin s h` sends `0` to the minimum of `s`. -/
lemma order_emb_of_fin_zero {s : finset α} {k : ℕ} (h : s.card = k) (hz : 0 < k) :
  order_emb_of_fin s h ⟨0, hz⟩ = s.min' (card_pos.mp (h.symm ▸ hz)) :=
by simp only [order_emb_of_fin_apply, subtype.coe_mk, sorted_zero_eq_min']

/-- The bijection `order_emb_of_fin s h` sends `k-1` to the maximum of `s`. -/
lemma order_emb_of_fin_last {s : finset α} {k : ℕ} (h : s.card = k) (hz : 0 < k) :
  order_emb_of_fin s h ⟨k-1, buffer.lt_aux_2 hz⟩ = s.max' (card_pos.mp (h.symm ▸ hz)) :=
by simp [order_emb_of_fin_apply, max'_eq_sorted_last, h]

/-- `order_emb_of_fin {a} h` sends any argument to `a`. -/
@[simp] lemma order_emb_of_fin_singleton (a : α) (i : fin 1) :
  order_emb_of_fin {a} (card_singleton a) i = a :=
by rw [subsingleton.elim i ⟨0, zero_lt_one⟩, order_emb_of_fin_zero _ zero_lt_one, min'_singleton]

/-- Any increasing map `f` from `fin k` to a finset of cardinality `k` has to coincide with
the increasing bijection `order_emb_of_fin s h`. -/
lemma order_emb_of_fin_unique {s : finset α} {k : ℕ} (h : s.card = k) {f : fin k → α}
  (hfs : ∀ x, f x ∈ s) (hmono : strict_mono f) : f = s.order_emb_of_fin h :=
begin
  apply fin.strict_mono_unique hmono (s.order_emb_of_fin h).strict_mono,
  rw [range_order_emb_of_fin, ← set.image_univ, ← coe_fin_range, ← coe_image, coe_inj],
  refine eq_of_subset_of_card_le (λ x hx, _) _,
  { rcases mem_image.1 hx with ⟨x, hx, rfl⟩, exact hfs x },
  { rw [h, card_image_of_injective _ hmono.injective, fin_range_card] }
end

/-- An order embedding `f` from `fin k` to a finset of cardinality `k` has to coincide with
the increasing bijection `order_emb_of_fin s h`. -/
lemma order_emb_of_fin_unique' {s : finset α} {k : ℕ} (h : s.card = k) {f : fin k ↪o α}
  (hfs : ∀ x, f x ∈ s) : f = s.order_emb_of_fin h :=
rel_embedding.ext $ function.funext_iff.1 $ order_emb_of_fin_unique h hfs f.strict_mono

/-- Two parametrizations `order_emb_of_fin` of the same set take the same value on `i` and `j` if
and only if `i = j`. Since they can be defined on a priori not defeq types `fin k` and `fin l`
(although necessarily `k = l`), the conclusion is rather written `(i : ℕ) = (j : ℕ)`. -/
@[simp] lemma order_emb_of_fin_eq_order_emb_of_fin_iff
  {k l : ℕ} {s : finset α} {i : fin k} {j : fin l} {h : s.card = k} {h' : s.card = l} :
  s.order_emb_of_fin h i = s.order_emb_of_fin h' j ↔ (i : ℕ) = (j : ℕ) :=
begin
  substs k l,
  exact (s.order_emb_of_fin rfl).eq_iff_eq.trans (fin.ext_iff _ _)
end

/-- Given a finset `s` of size at least `k` in a linear order `α`, the map `order_emb_of_card_le`
is an order embedding from `fin k` to `α` whose image is contained in `s`. Specifically, it maps
`fin k` to an initial segment of `s`. -/
def order_emb_of_card_le (s : finset α) {k : ℕ} (h : k ≤ s.card) : fin k ↪o α :=
(fin.cast_le h).trans (s.order_emb_of_fin rfl)

lemma order_emb_of_card_le_mem (s : finset α) {k : ℕ} (h : k ≤ s.card) (a) :
  order_emb_of_card_le s h a ∈ s :=
by simp only [order_emb_of_card_le, rel_embedding.coe_trans, finset.order_emb_of_fin_mem]

lemma card_le_of_interleaved {s t : finset α} (h : ∀ x y ∈ s, x < y → ∃ z ∈ t, x < z ∧ z < y) :
  s.card ≤ t.card + 1 :=
begin
  have h1 : ∀ i : fin (s.card - 1), ↑i + 1 < (s.sort (≤)).length,
  { intro i,
    rw [finset.length_sort, ←lt_tsub_iff_right],
    exact i.2 },
  have h0 : ∀ i : fin (s.card - 1), ↑i < (s.sort (≤)).length :=
  λ i, lt_of_le_of_lt (nat.le_succ i) (h1 i),
  have p := λ i : fin (s.card - 1), h ((s.sort (≤)).nth_le i (h0 i))
    ((finset.mem_sort (≤)).mp (list.nth_le_mem _ _ (h0 i)))
    ((s.sort (≤)).nth_le (i + 1) (h1 i))
    ((finset.mem_sort (≤)).mp (list.nth_le_mem _ _ (h1 i)))
    (s.sort_sorted_lt.rel_nth_le_of_lt (h0 i) (h1 i) (nat.lt_succ_self i)),
  let f : fin (s.card - 1) → t :=
  λ i, ⟨classical.some (p i), (exists_prop.mp (classical.some_spec (p i))).1⟩,
  have hf : ∀ i j : fin (s.card - 1), i < j → f i < f j :=
  λ i j hij, subtype.coe_lt_coe.mp ((exists_prop.mp (classical.some_spec (p i))).2.2.trans
    (lt_of_le_of_lt ((s.sort_sorted (≤)).rel_nth_le_of_le (h1 i) (h0 j) (nat.succ_le_iff.mpr hij))
    (exists_prop.mp (classical.some_spec (p j))).2.1)),
  have key := fintype.card_le_of_embedding (function.embedding.mk f (λ i j hij, le_antisymm
    (not_lt.mp (mt (hf j i) (not_lt.mpr (le_of_eq hij))))
    (not_lt.mp (mt (hf i j) (not_lt.mpr (ge_of_eq hij)))))),
  rwa [fintype.card_fin, fintype.card_coe, tsub_le_iff_right] at key,
end

end sort_linear_order

instance [has_repr α] : has_repr (finset α) := ⟨λ s, repr s.1⟩

end finset


/-
Copyright (c) 2021 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anne Baanen

! This file was ported from Lean 3 source module data.int.absolute_value
! leanprover-community/mathlib commit 9aba7801eeecebb61f58a5763c2b6dd1b47dc6ef
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Module.Basic
import Mathlib.Algebra.Order.AbsoluteValue
import Mathlib.Data.Int.Cast.Lemmas
import Mathlib.Data.Int.Units
import Mathlib.GroupTheory.GroupAction.Units

/-!
# Absolute values and the integers

This file contains some results on absolute values applied to integers.

## Main results

 * `AbsoluteValue.map_units_int`: an absolute value sends all units of `ℤ` to `1`
 * `Int.natAbsHom`: `Int.natAbs` bundled as a `MonoidWithZeroHom`
-/

variable {R S : Type _} [Ring R] [LinearOrderedCommRing S]

@[simp]
theorem AbsoluteValue.map_units_int (abv : AbsoluteValue ℤ S) (x : ℤˣ) : abv x = 1 := by
  rcases Int.units_eq_one_or x with (rfl | rfl) <;> simp
#align absolute_value.map_units_int AbsoluteValue.map_units_int

@[simp]
theorem AbsoluteValue.map_units_int_cast [Nontrivial R] (abv : AbsoluteValue R S) (x : ℤˣ) :
    abv ((x : ℤ) : R) = 1 := by rcases Int.units_eq_one_or x with (rfl | rfl) <;> simp
#align absolute_value.map_units_int_cast AbsoluteValue.map_units_int_cast

@[simp]
theorem AbsoluteValue.map_units_int_smul (abv : AbsoluteValue R S) (x : ℤˣ) (y : R) :
    abv (x • y) = abv y := by rcases Int.units_eq_one_or x with (rfl | rfl) <;> simp
#align absolute_value.map_units_int_smul AbsoluteValue.map_units_int_smul

/-- `Int.natAbs` as a bundled monoid with zero hom. -/
@[simps]
def Int.natAbsHom : ℤ →*₀ ℕ where
  toFun := Int.natAbs
  map_mul' := Int.natAbs_mul
  map_one' := Int.natAbs_one
  map_zero' := Int.natAbs_zero
#align int.nat_abs_hom Int.natAbsHom
#align int.nat_abs_hom_apply Int.natAbsHom_apply


import .bool
import .arith_lang

namespace arith

open arith

-- DATA TYPE

/-
inductive bool_var
| X
| Y
| Z
-/

inductive bool_var
| V (n : ℕ)

open bool_var

-- Test
def X := V 0
def Y := V 1
def Z := V 2

inductive bool_lang : Type
| TT : bool_lang
| FF : bool_lang
| var (v : bool_var) : bool_lang
| conj (e1 e2 : bool_lang) : bool_lang
| disj (e1 e2 : bool_lang) : bool_lang
| neg (e : bool_lang)
| eql (e1 e2 : nt_lang)

-- REFACTOR INTO TEST FILE
open bool_lang
def be1 := TT
def be2 := FF
def ve1 := var X
def be3 := conj be1 be2
def be4 := neg be3

def var_interp_1 : bool_var → boo
| v := boo.tt

/-
def var_interp_2 : bool_var → boo
| X := tt
| Y := ff
| Z := tt
-/

def var_interp_2 : bool_var → boo
| (V 0) := tt
| (V 1) := ff
| (V 2) := tt
| _ := tt

-- OPERATIONS
def eval : bool_lang → (bool_var → boo) → boo
| TT _ := tt
| FF _ := ff
| (var v) i := i v
| (conj e1 e2) i := and (eval e1 i) (eval e2 i)
| (disj e1 e2) i := or (eval e1 i) (eval e2 i)
| (neg e) i := not (eval e i)
| (eql e1 e2) := _ -- evaluate e1, e2, and return boo.tt if equal else boo.ff

-- NOTATIONS
notation b1 * b2 := conj b1 b2
notation b1 + b2 := disj b1 b2
prefix ! := neg

-- REFACTOR INTO TEST FILE
#reduce eval be4
#reduce eval (conj (disj be2 be4) be3)
#check X
#check (var X)
#reduce eval ((var X) * (var Y)) var_interp_1
#reduce eval ((var X) * (var Y)) var_interp_2

-- REFACTOR INTO TEST FILE
#reduce eval ((be2 + be4) * be3)

/-
How do we know that eval terminates?
-/

-- Non-terminating functions would be fatal
def bad : ℕ → false
| n := bad n    -- non-terminating recursion
#check (bad 3)  -- Yikes, a proof of false!

-- PROPERTIES?

/-
A property of an expression, e, is that e
evaluates to true. Let's call this property
evaluates_to_true.
-/
def evaluates_to_true : bool_lang → Prop
| e := eval e = boo.tt
/-
This definition broke when we added an interpretation,
i, as a second argument to eval.
-/

example : evaluates_to_true TT :=
begin
  unfold evaluates_to_true,
  trivial,
end
--ditto last comment

example : evaluates_to_true (TT * FF) :=
begin
  unfold evaluates_to_true,
  simp [eval],
  apply rfl,  -- false
end
--ditto last comment

-- Property of an individual expression
example : evaluates_to_true (TT * TT) :=
begin
  unfold evaluates_to_true,
  simp [eval],
  apply rfl,  -- false
end
--ditto last comment

-- Property of the language as a whole:
-- evaluation is deterministic.

-- HOMEWORK

/-
What deterministic means is that if you evaluate the same
expression twice (in the same environment) that you'll get
the same answer. A language with a statement that returns
a truly random number wouldn't have this property. Show that
evaluation is deterministic for our "Bool" language.
-/

def eval_is_deterministic :
  ∀ (e : bool_lang) (i : bool_var → boo) (b1 b2 : boo),
  b1 = (eval e i) →
  b2 = (eval e i) →
  b1 = b2 :=
begin
  intros e i b1 b2 h1 h2,
  rw h1,
  rw h2,
end

def nat_eq : ℕ → ℕ → bool
| nat.zero nat.zero := bool.tt
| nat.zero _ := bool.ff
| _ nat.zero := bool.ff
| (nat.succ n') (nat.succ m') := nat_eq n' m'

#reduce nat_eq 0 0
#reduce nat_eq 0 1
#reduce nat_eq 1 0
#reduce nat_eq 1 1

def var_eq : bool_var → bool_var → bool
| (V n1) (V n2) := nat_eq n1 n2

#reduce var_eq X X
#reduce var_eq X Y
#reduce var_eq X Z
#reduce var_eq Y X
#reduce var_eq Z X
#reduce  var_eq Z Y
#reduce var_eq Z Z

def override : (bool_var → boo) → bool_var → boo → (bool_var → boo) :=
λ i v' b,
  λ v, if (var_eq v v') then b else (i v)

/-
def var_interp_1 : bool_var → boo
| v := boo.tt
-/

def init := var_interp_1

#reduce init X
#reduce init Y
#reduce init Z

def st_1 := override init X ff

#reduce st_1 X
#reduce st_1 Y
#reduce st_1 Z

def st_2 := override (st_1) Z ff

#reduce st_2 X
#reduce st_2 Y
#reduce st_2 Z

end arith


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

! This file was ported from Lean 3 source module ring_theory.polynomial.pochhammer
! leanprover-community/mathlib commit 53b216bcc1146df1c4a0a86877890ea9f1f01589
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Tactic.Abel
import Mathlib.Data.Polynomial.Eval

/-!
# The Pochhammer polynomials

We define and prove some basic relations about
`pochhammer S n : S[X] := X * (X + 1) * ... * (X + n - 1)`
which is also known as the rising factorial. A version of this definition
that is focused on `nat` can be found in `data.nat.factorial` as `nat.asc_factorial`.

## Implementation

As with many other families of polynomials, even though the coefficients are always in `ℕ`,
we define the polynomial with coefficients in any `[semiring S]`.

## TODO

There is lots more in this direction:
* q-factorials, q-binomials, q-Pochhammer.
-/

universe u v

open Polynomial

open Polynomial

section Semiring

variable (S : Type u) [Semiring S]

/-- `pochhammer S n` is the polynomial `X * (X+1) * ... * (X + n - 1)`,
with coefficients in the semiring `S`.
-/
noncomputable def pochhammer : ℕ → S[X]
  | 0 => 1
  | n + 1 => X * (pochhammer n).comp (X + 1)
#align pochhammer pochhammer

@[simp]
theorem pochhammer_zero : pochhammer S 0 = 1 :=
  rfl
#align pochhammer_zero pochhammer_zero

@[simp]
theorem pochhammer_one : pochhammer S 1 = X := by simp [pochhammer]
#align pochhammer_one pochhammer_one

theorem pochhammer_succ_left (n : ℕ) : pochhammer S (n + 1) = X * (pochhammer S n).comp (X + 1) :=
  by rw [pochhammer]
#align pochhammer_succ_left pochhammer_succ_left

section

variable {S} {T : Type v} [Semiring T]

@[simp]
theorem pochhammer_map (f : S →+* T) (n : ℕ) : (pochhammer S n).map f = pochhammer T n := by
  induction' n with n ih
  · simp
  · simp [ih, pochhammer_succ_left, map_comp]
#align pochhammer_map pochhammer_map

end

@[simp, norm_cast]
theorem pochhammer_eval_cast (n k : ℕ) :
    (((pochhammer ℕ n).eval k : ℕ) : S) = ((pochhammer S n).eval k : S):=
  by
  rw [← pochhammer_map (algebraMap ℕ S), eval_map, ← eq_natCast (algebraMap ℕ S), eval₂_at_nat_cast,
    Nat.cast_id, eq_natCast]
#align pochhammer_eval_cast pochhammer_eval_cast

theorem pochhammer_eval_zero {n : ℕ} : (pochhammer S n).eval 0 = if n = 0 then 1 else 0 := by
  cases n
  · simp
  · simp [X_mul, Nat.succ_ne_zero, pochhammer_succ_left]
#align pochhammer_eval_zero pochhammer_eval_zero

theorem pochhammer_zero_eval_zero : (pochhammer S 0).eval 0 = 1 := by simp
#align pochhammer_zero_eval_zero pochhammer_zero_eval_zero

@[simp]
theorem pochhammer_ne_zero_eval_zero {n : ℕ} (h : n ≠ 0) : (pochhammer S n).eval 0 = 0 := by
  simp [pochhammer_eval_zero, h]
#align pochhammer_ne_zero_eval_zero pochhammer_ne_zero_eval_zero

theorem pochhammer_succ_right (n : ℕ) : pochhammer S (n + 1) = pochhammer S n * (X + (n : S[X])) :=
  by
  suffices h : pochhammer ℕ (n + 1) = pochhammer ℕ n * (X + (n : ℕ[X]))
  · apply_fun Polynomial.map (algebraMap ℕ S) at h
    simpa only [pochhammer_map, Polynomial.map_mul, Polynomial.map_add, map_X,
      Polynomial.map_nat_cast] using h
  induction' n with n ih
  · simp
  · conv_lhs =>
      rw [pochhammer_succ_left, ih, mul_comp, ← mul_assoc, ← pochhammer_succ_left, add_comp, X_comp,
        nat_cast_comp, add_assoc, add_comm (1 : ℕ[X]), ← Nat.cast_succ]
#align pochhammer_succ_right pochhammer_succ_right

theorem pochhammer_succ_eval {S : Type _} [Semiring S] (n : ℕ) (k : S) :
    (pochhammer S (n + 1)).eval k = (pochhammer S n).eval k * (k + n) := by
  rw [pochhammer_succ_right, mul_add, eval_add, eval_mul_X, ← Nat.cast_comm, ← C_eq_nat_cast,
    eval_C_mul, Nat.cast_comm, ← mul_add]
#align pochhammer_succ_eval pochhammer_succ_eval

theorem pochhammer_succ_comp_x_add_one (n : ℕ) :
    (pochhammer S (n + 1)).comp (X + 1) =
      pochhammer S (n + 1) + (n + 1) • (pochhammer S n).comp (X + 1) := by
  suffices (pochhammer ℕ (n + 1)).comp (X + 1) =
      pochhammer ℕ (n + 1) + (n + 1) * (pochhammer ℕ n).comp (X + 1)
    by simpa [map_comp] using congr_arg (Polynomial.map (Nat.castRingHom S)) this
  nth_rw 2 [pochhammer_succ_left]
  simp only
  rw [← add_mul, pochhammer_succ_right ℕ n, mul_comp, mul_comm, add_comp, X_comp, nat_cast_comp,
    add_comm, ← add_assoc]
  ring
set_option linter.uppercaseLean3 false in
#align pochhammer_succ_comp_X_add_one pochhammer_succ_comp_x_add_one

theorem Polynomial.mul_x_add_nat_cast_comp {p q : S[X]} {n : ℕ} :
    (p * (X + (n : S[X]))).comp q = p.comp q * (q + n) := by
  rw [mul_add, add_comp, mul_X_comp, ← Nat.cast_comm, nat_cast_mul_comp, Nat.cast_comm, mul_add]
set_option linter.uppercaseLean3 false in
#align polynomial.mul_X_add_nat_cast_comp Polynomial.mul_x_add_nat_cast_comp

theorem pochhammer_mul (n m : ℕ) :
    pochhammer S n * (pochhammer S m).comp (X + (n : S[X])) = pochhammer S (n + m) := by
  induction' m with m ih
  · simp
  · rw [pochhammer_succ_right, Polynomial.mul_x_add_nat_cast_comp, ← mul_assoc, ih,
      Nat.succ_eq_add_one, ← add_assoc, pochhammer_succ_right, Nat.cast_add, add_assoc]
#align pochhammer_mul pochhammer_mul

theorem pochhammer_nat_eq_ascFactorial (n : ℕ):
    ∀ k, (pochhammer ℕ k).eval (n + 1) = n.ascFactorial k
  | 0 => (by erw [eval_one]; rfl)
  | t + 1 => by
    rw [pochhammer_succ_right, eval_mul, pochhammer_nat_eq_ascFactorial n t]
    suffices n.ascFactorial t * (n + 1 + t) = n.ascFactorial (t + 1) by simpa
    rw [Nat.ascFactorial_succ, add_right_comm, mul_comm]
#align pochhammer_nat_eq_asc_factorial pochhammer_nat_eq_ascFactorial

theorem pochhammer_nat_eq_descFactorial (a b : ℕ) :
    (pochhammer ℕ b).eval a = (a + b - 1).descFactorial b := by
  cases' b with b
  · rw [Nat.descFactorial_zero, pochhammer_zero, Polynomial.eval_one]
  rw [Nat.add_succ, Nat.succ_sub_succ, tsub_zero]
  cases a
  · simp only [Nat.zero_eq, ne_eq, Nat.succ_ne_zero, not_false_iff, pochhammer_ne_zero_eval_zero,
    zero_add, Nat.descFactorial_succ, le_refl, tsub_eq_zero_of_le, zero_mul]
  · rw [Nat.succ_add, ← Nat.add_succ, Nat.add_descFactorial_eq_ascFactorial,
      pochhammer_nat_eq_ascFactorial]
#align pochhammer_nat_eq_desc_factorial pochhammer_nat_eq_descFactorial

end Semiring

section StrictOrderedSemiring

variable {S : Type _} [StrictOrderedSemiring S]

theorem pochhammer_pos (n : ℕ) (s : S) (h : 0 < s) : 0 < (pochhammer S n).eval s := by
  induction' n with n ih
  · simp only [Nat.zero_eq, pochhammer_zero, eval_one]
    exact zero_lt_one
  · rw [pochhammer_succ_right, mul_add, eval_add, ← Nat.cast_comm, eval_nat_cast_mul, eval_mul_X,
      Nat.cast_comm, ← mul_add]
    exact mul_pos ih (lt_of_lt_of_le h ((le_add_iff_nonneg_right _).mpr (Nat.cast_nonneg n)))
#align pochhammer_pos pochhammer_pos

end StrictOrderedSemiring

section Factorial

open Nat

variable (S : Type _) [Semiring S] (r n : ℕ)

@[simp]
theorem pochhammer_eval_one (S : Type _) [Semiring S] (n : ℕ) :
    (pochhammer S n).eval (1 : S) = (n ! : S) := by
  rw_mod_cast [pochhammer_nat_eq_ascFactorial, Nat.zero_ascFactorial]
#align pochhammer_eval_one pochhammer_eval_one

theorem factorial_mul_pochhammer (S : Type _) [Semiring S] (r n : ℕ) :
    (r ! : S) * (pochhammer S n).eval (r + 1 : S) = (r + n)! := by
  rw_mod_cast [pochhammer_nat_eq_ascFactorial, Nat.factorial_mul_ascFactorial]
#align factorial_mul_pochhammer factorial_mul_pochhammer

theorem pochhammer_nat_eval_succ (r : ℕ) :
    ∀ n : ℕ, n * (pochhammer ℕ r).eval (n + 1) = (n + r) * (pochhammer ℕ r).eval n
  | 0 => by
    by_cases h : r = 0
    · simp only [h, zero_mul, zero_add]
    · simp only [pochhammer_eval_zero, zero_mul, if_neg h, mul_zero]
  | k + 1 => by simp only [pochhammer_nat_eq_ascFactorial, Nat.succ_ascFactorial, add_right_comm]
#align pochhammer_nat_eval_succ pochhammer_nat_eval_succ

theorem pochhammer_eval_succ (r n : ℕ) :
    (n : S) * (pochhammer S r).eval (n + 1 : S) = (n + r) * (pochhammer S r).eval (n : S) := by
  exact_mod_cast congr_arg Nat.cast (pochhammer_nat_eval_succ r n)
#align pochhammer_eval_succ pochhammer_eval_succ

end Factorial


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import data.finsupp.defs
import algebra.ring.pi

/-!
# The pointwise product on `finsupp`.

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

For the convolution product on `finsupp` when the domain has a binary operation,
see the type synonyms `add_monoid_algebra`
(which is in turn used to define `polynomial` and `mv_polynomial`)
and `monoid_algebra`.
-/

noncomputable theory

open finset

universes u₁ u₂ u₃ u₄ u₅
variables {α : Type u₁} {β : Type u₂} {γ : Type u₃} {δ : Type u₄} {ι : Type u₅}

namespace finsupp

/-! ### Declarations about the pointwise product on `finsupp`s -/

section
variables [mul_zero_class β]

/-- The product of `f g : α →₀ β` is the finitely supported function
  whose value at `a` is `f a * g a`. -/
instance : has_mul (α →₀ β) := ⟨zip_with (*) (mul_zero 0)⟩

lemma coe_mul (g₁ g₂ : α →₀ β) : ⇑(g₁ * g₂) = g₁ * g₂ := rfl

@[simp] lemma mul_apply {g₁ g₂ : α →₀ β} {a : α} : (g₁ * g₂) a = g₁ a * g₂ a :=
rfl

lemma support_mul [decidable_eq α] {g₁ g₂ : α →₀ β} : (g₁ * g₂).support ⊆ g₁.support ∩ g₂.support :=
begin
  intros a h,
  simp only [mul_apply, mem_support_iff] at h,
  simp only [mem_support_iff, mem_inter, ne.def],
  rw ←not_or_distrib,
  intro w,
  apply h,
  cases w; { rw w, simp },
end

instance : mul_zero_class (α →₀ β) :=
finsupp.coe_fn_injective.mul_zero_class _ coe_zero coe_mul

end

instance [semigroup_with_zero β] : semigroup_with_zero (α →₀ β) :=
finsupp.coe_fn_injective.semigroup_with_zero _ coe_zero coe_mul

instance [non_unital_non_assoc_semiring β] : non_unital_non_assoc_semiring (α →₀ β) :=
finsupp.coe_fn_injective.non_unital_non_assoc_semiring _ coe_zero coe_add coe_mul (λ _ _, rfl)

instance [non_unital_semiring β] : non_unital_semiring (α →₀ β) :=
finsupp.coe_fn_injective.non_unital_semiring _ coe_zero coe_add coe_mul (λ _ _, rfl)

instance [non_unital_comm_semiring β] : non_unital_comm_semiring (α →₀ β) :=
finsupp.coe_fn_injective.non_unital_comm_semiring _ coe_zero coe_add coe_mul (λ _ _, rfl)

instance [non_unital_non_assoc_ring β] : non_unital_non_assoc_ring (α →₀ β) :=
finsupp.coe_fn_injective.non_unital_non_assoc_ring _
  coe_zero coe_add coe_mul coe_neg coe_sub (λ _ _, rfl) (λ _ _, rfl)

instance [non_unital_ring β] : non_unital_ring (α →₀ β) :=
finsupp.coe_fn_injective.non_unital_ring _
  coe_zero coe_add coe_mul coe_neg coe_sub (λ _ _, rfl) (λ _ _, rfl)

instance [non_unital_comm_ring β] : non_unital_comm_ring (α →₀ β) :=
finsupp.coe_fn_injective.non_unital_comm_ring _
  coe_zero coe_add coe_mul coe_neg coe_sub (λ _ _, rfl) (λ _ _, rfl)

-- TODO can this be generalized in the direction of `pi.has_smul'`
-- (i.e. dependent functions and finsupps)
-- TODO in theory this could be generalised, we only really need `smul_zero` for the definition
instance pointwise_scalar [semiring β] : has_smul (α → β) (α →₀ β) :=
{ smul := λ f g, finsupp.of_support_finite (λ a, f a • g a) begin
    apply set.finite.subset g.finite_support,
    simp only [function.support_subset_iff, finsupp.mem_support_iff, ne.def,
      finsupp.fun_support_eq, finset.mem_coe],
    intros x hx h,
    apply hx,
    rw [h, smul_zero],
  end }

@[simp]
lemma coe_pointwise_smul [semiring β] (f : α → β) (g : α →₀ β) :
  ⇑(f • g) = f • g := rfl

/-- The pointwise multiplicative action of functions on finitely supported functions -/
instance pointwise_module [semiring β] : module (α → β) (α →₀ β) :=
function.injective.module _ coe_fn_add_hom coe_fn_injective coe_pointwise_smul

end finsupp


/-
Copyright (c) 2020 Pim Spelier, Daan van Gent. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Pim Spelier, Daan van Gent
-/

import data.fintype.basic
import data.num.lemmas
import tactic.derive_fintype

/-!
# Encodings

This file contains the definition of a (finite) encoding, a map from a type to
strings in an alphabet, used in defining computability by Turing machines.
It also contains several examples:

## Examples

- `fin_encoding_nat_bool`   : a binary encoding of ℕ in a simple alphabet.
- `fin_encoding_nat_Γ'`    : a binary encoding of ℕ in the alphabet used for TM's.
- `unary_fin_encoding_nat` : a unary encoding of ℕ
- `fin_encoding_bool_bool`  : an encoding of bool.
-/

namespace computability

/-- An encoding of a type in a certain alphabet, together with a decoding. -/
structure encoding (α : Type) :=
(Γ : Type)
(encode : α → list Γ)
(decode : list Γ → option α)
(decode_encode : ∀ x, decode (encode x) = some x)

/-- An encoding plus a guarantee of finiteness of the alphabet. -/
structure fin_encoding (α : Type) extends encoding α :=
(Γ_fin : fintype Γ)

/-- A standard Turing machine alphabet, consisting of blank,bit0,bit1,bra,ket,comma. -/
@[derive [decidable_eq,fintype]]
inductive Γ'
| blank | bit (b : bool) | bra | ket | comma

instance inhabited_Γ' : inhabited Γ' := ⟨Γ'.blank⟩

/-- The natural inclusion of bool in Γ'. -/
def inclusion_bool_Γ' : bool → Γ' := Γ'.bit

/-- An arbitrary section of the natural inclusion of bool in Γ'. -/
def section_Γ'_bool : Γ' → bool
| (Γ'.bit b) := b
| _ := arbitrary bool

lemma left_inverse_section_inclusion : function.left_inverse section_Γ'_bool inclusion_bool_Γ' :=
λ x, bool.cases_on x rfl rfl

lemma inclusion_bool_Γ'_injective : function.injective inclusion_bool_Γ' :=
function.has_left_inverse.injective (Exists.intro section_Γ'_bool left_inverse_section_inclusion)

/-- An encoding function of the positive binary numbers in bool. -/
def encode_pos_num : pos_num → list bool
| pos_num.one := [tt]
| (pos_num.bit0 n) := ff :: encode_pos_num n
| (pos_num.bit1 n) := tt :: encode_pos_num n

/-- An encoding function of the binary numbers in bool. -/
def encode_num : num → list bool
| num.zero := []
| (num.pos n) := encode_pos_num n

/-- An encoding function of ℕ in bool. -/
def encode_nat (n : ℕ) : list bool := encode_num n

/-- A decoding function from `list bool` to the positive binary numbers. -/
def decode_pos_num : list bool → pos_num
| (ff :: l) := (pos_num.bit0 (decode_pos_num l))
| (tt :: l) := ite (l = []) pos_num.one (pos_num.bit1 (decode_pos_num l))
| _ := pos_num.one

/-- A decoding function from `list bool` to the binary numbers. -/
def decode_num : list bool → num := λ l, ite (l = []) num.zero $ decode_pos_num l

/-- A decoding function from `list bool` to ℕ. -/
def decode_nat : list bool → nat := λ l, decode_num l

lemma encode_pos_num_nonempty (n : pos_num) : (encode_pos_num n) ≠ [] :=
pos_num.cases_on n (list.cons_ne_nil _ _) (λ m, list.cons_ne_nil _ _) (λ m, list.cons_ne_nil _ _)

lemma decode_encode_pos_num : ∀ n, decode_pos_num(encode_pos_num n) = n :=
begin
  intros n,
  induction n with m hm m hm; unfold encode_pos_num decode_pos_num,
  { refl },
  { rw hm,
    exact if_neg (encode_pos_num_nonempty m) },
  { exact congr_arg pos_num.bit0 hm }
end

lemma decode_encode_num : ∀ n, decode_num(encode_num n) = n :=
begin
  intros n,
  cases n; unfold encode_num decode_num,
  { refl },
  rw decode_encode_pos_num n,
  rw pos_num.cast_to_num,
  exact if_neg (encode_pos_num_nonempty n),
end

lemma decode_encode_nat : ∀ n, decode_nat(encode_nat n) = n :=
begin
  intro n,
  conv_rhs {rw ← num.to_of_nat n},
  exact congr_arg coe (decode_encode_num ↑n),
end

/-- A binary encoding of ℕ in bool. -/
def encoding_nat_bool : encoding ℕ :=
{ Γ := bool,
  encode := encode_nat,
  decode := λ n, some (decode_nat n),
  decode_encode := λ n, congr_arg _ (decode_encode_nat n) }

/-- A binary fin_encoding of ℕ in bool. -/
def fin_encoding_nat_bool : fin_encoding ℕ := ⟨encoding_nat_bool, bool.fintype⟩

/-- A binary encoding of ℕ in Γ'. -/
def encoding_nat_Γ' : encoding ℕ :=
{ Γ := Γ',
  encode := λ x, list.map inclusion_bool_Γ' (encode_nat x),
  decode := λ x, some (decode_nat (list.map section_Γ'_bool x)),
  decode_encode := λ x, congr_arg _ $
    by rw [list.map_map, list.map_id' left_inverse_section_inclusion, decode_encode_nat] }

/-- A binary fin_encoding of ℕ in Γ'. -/
def fin_encoding_nat_Γ' : fin_encoding ℕ := ⟨encoding_nat_Γ', Γ'.fintype⟩

/-- A unary encoding function of ℕ in bool. -/
def unary_encode_nat : nat → list bool
| 0 := []
| (n+1) := tt :: (unary_encode_nat n)

/-- A unary decoding function from `list bool` to ℕ. -/
def unary_decode_nat : list bool → nat := list.length

lemma unary_decode_encode_nat : ∀ n, unary_decode_nat (unary_encode_nat n) = n :=
λ n, nat.rec rfl (λ (m : ℕ) hm, (congr_arg nat.succ hm.symm).symm) n

/-- A unary fin_encoding of ℕ. -/
def unary_fin_encoding_nat : fin_encoding ℕ :=
{ Γ := bool,
  encode := unary_encode_nat,
  decode := λ n, some (unary_decode_nat n),
  decode_encode := λ n, congr_arg _ (unary_decode_encode_nat n),
  Γ_fin := bool.fintype}

/-- An encoding function of bool in bool. -/
def encode_bool : bool → list bool := list.ret

/-- A decoding function from `list bool` to bool. -/
def decode_bool : list bool → bool
| (b :: _) := b
| _ := arbitrary bool

lemma decode_encode_bool : ∀ b, decode_bool(encode_bool b) = b := λ b, bool.cases_on b rfl rfl

/-- A fin_encoding of bool in bool. -/
def fin_encoding_bool_bool : fin_encoding bool :=
{ Γ := bool,
  encode := encode_bool,
  decode := λ x, some (decode_bool x),
  decode_encode := λ x, congr_arg _ (decode_encode_bool x),
  Γ_fin := bool.fintype }

instance inhabited_fin_encoding : inhabited (fin_encoding bool) := ⟨fin_encoding_bool_bool⟩

instance inhabited_encoding : inhabited (encoding bool) := ⟨fin_encoding_bool_bool.to_encoding⟩

end computability


/-
Copyright (c) 2020 Kevin Kappelmann. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Kappelmann
-/
import algebra.continued_fractions.computation.basic
import algebra.continued_fractions.translations
/-!
# Basic Translation Lemmas Between Structures Defined for Computing Continued Fractions

## Summary

This is a collection of simple lemmas between the different structures used for the computation
of continued fractions defined in `algebra.continued_fractions.computation.basic`. The file consists
of three sections:
1. Recurrences and inversion lemmas for `int_fract_pair.stream`: these lemmas give us inversion
   rules and recurrences for the computation of the stream of integer and fractional parts of
   a value.
2. Translation lemmas for the head term: these lemmas show us that the head term of the computed
   continued fraction of a value `v` is `⌊v⌋` and how this head term is moved along the structures
   used in the computation process.
3. Translation lemmas for the sequence: these lemmas show how the sequences of the involved
   structures (`int_fract_pair.stream`, `int_fract_pair.seq1`, and
   `generalized_continued_fraction.of`) are connected, i.e. how the values are moved along the
   structures and the termination of one sequence implies the termination of another sequence.

## Main Theorems

- `succ_nth_stream_eq_some_iff` gives as a recurrence to compute the `n + 1`th value of the sequence
  of integer and fractional parts of a value in case of non-termination.
- `succ_nth_stream_eq_none_iff` gives as a recurrence to compute the `n + 1`th value of the sequence
  of integer and fractional parts of a value in case of termination.
- `nth_of_eq_some_of_succ_nth_int_fract_pair_stream` and
  `nth_of_eq_some_of_nth_int_fract_pair_stream_fr_ne_zero` show how the entries of the sequence
  of the computed continued fraction can be obtained from the stream of integer and fractional
  parts.
-/

namespace generalized_continued_fraction
open generalized_continued_fraction (of)
open stream.seq as seq

/- Fix a discrete linear ordered floor field and a value `v`. -/
variables {K : Type*} [linear_ordered_field K] [floor_ring K] {v : K}

namespace int_fract_pair
/-!
### Recurrences and Inversion Lemmas for `int_fract_pair.stream`

Here we state some lemmas that give us inversion rules and recurrences for the computation of the
stream of integer and fractional parts of a value.
-/

lemma stream_zero (v : K) : int_fract_pair.stream v 0 = some (int_fract_pair.of v) := rfl

variable {n : ℕ}

lemma stream_eq_none_of_fr_eq_zero {ifp_n : int_fract_pair K}
  (stream_nth_eq : int_fract_pair.stream v n = some ifp_n) (nth_fr_eq_zero : ifp_n.fr = 0) :
  int_fract_pair.stream v (n + 1) = none :=
begin
  cases ifp_n with _ fr,
  change fr = 0 at nth_fr_eq_zero,
  simp [int_fract_pair.stream, stream_nth_eq, nth_fr_eq_zero]
end

/--
Gives a recurrence to compute the `n + 1`th value of the sequence of integer and fractional
parts of a value in case of termination.
-/
lemma succ_nth_stream_eq_none_iff : int_fract_pair.stream v (n + 1) = none
  ↔ (int_fract_pair.stream v n = none ∨ ∃ ifp, int_fract_pair.stream v n = some ifp ∧ ifp.fr = 0) :=
begin
  rw [int_fract_pair.stream],
  cases int_fract_pair.stream v n; simp [imp_false]
end

/--
Gives a recurrence to compute the `n + 1`th value of the sequence of integer and fractional
parts of a value in case of non-termination.
-/
lemma succ_nth_stream_eq_some_iff {ifp_succ_n : int_fract_pair K} :
    int_fract_pair.stream v (n + 1) = some ifp_succ_n
  ↔ ∃ (ifp_n : int_fract_pair K), int_fract_pair.stream v n = some ifp_n
      ∧ ifp_n.fr ≠ 0
      ∧ int_fract_pair.of ifp_n.fr⁻¹ = ifp_succ_n :=
by simp [int_fract_pair.stream, ite_eq_iff]

/--
An easier to use version of one direction of
`generalized_continued_fraction.int_fract_pair.succ_nth_stream_eq_some_iff`.
-/
lemma stream_succ_of_some {p : int_fract_pair K}
  (h : int_fract_pair.stream v n = some p) (h' : p.fr ≠ 0) :
  int_fract_pair.stream v (n + 1) = some (int_fract_pair.of (p.fr)⁻¹) :=
succ_nth_stream_eq_some_iff.mpr ⟨p, h, h', rfl⟩

/--
The stream of `int_fract_pair`s of an integer stops after the first term.
-/
lemma stream_succ_of_int (a : ℤ) (n : ℕ) : int_fract_pair.stream (a : K) (n + 1) = none :=
begin
  induction n with n ih,
  { refine int_fract_pair.stream_eq_none_of_fr_eq_zero (int_fract_pair.stream_zero (a : K)) _,
    simp only [int_fract_pair.of, int.fract_int_cast], },
  { exact int_fract_pair.succ_nth_stream_eq_none_iff.mpr (or.inl ih), }
end

lemma exists_succ_nth_stream_of_fr_zero {ifp_succ_n : int_fract_pair K}
  (stream_succ_nth_eq : int_fract_pair.stream v (n + 1) = some ifp_succ_n)
  (succ_nth_fr_eq_zero : ifp_succ_n.fr = 0) :
  ∃ ifp_n : int_fract_pair K, int_fract_pair.stream v n = some ifp_n ∧ ifp_n.fr⁻¹ = ⌊ifp_n.fr⁻¹⌋ :=
begin
  -- get the witness from `succ_nth_stream_eq_some_iff` and prove that it has the additional
  -- properties
  rcases (succ_nth_stream_eq_some_iff.mp stream_succ_nth_eq) with
    ⟨ifp_n, seq_nth_eq, nth_fr_ne_zero, rfl⟩,
  refine ⟨ifp_n, seq_nth_eq, _⟩,
  simpa only [int_fract_pair.of, int.fract, sub_eq_zero] using succ_nth_fr_eq_zero
end

/--
A recurrence relation that expresses the `(n+1)`th term of the stream of `int_fract_pair`s
of `v` for non-integer `v` in terms of the `n`th term of the stream associated to
the inverse of the fractional part of `v`.
-/
lemma stream_succ  (h : int.fract v ≠ 0) (n : ℕ) :
  int_fract_pair.stream v (n + 1) = int_fract_pair.stream (int.fract v)⁻¹ n :=
begin
  induction n with n ih,
  { have H : (int_fract_pair.of v).fr = int.fract v := rfl,
    rw [stream_zero, stream_succ_of_some (stream_zero v) (ne_of_eq_of_ne H h), H], },
  { cases eq_or_ne (int_fract_pair.stream (int.fract v)⁻¹ n) none with hnone hsome,
    { rw hnone at ih,
      rw [succ_nth_stream_eq_none_iff.mpr (or.inl hnone),
          succ_nth_stream_eq_none_iff.mpr (or.inl ih)], },
    { obtain ⟨p, hp⟩ := option.ne_none_iff_exists'.mp hsome,
      rw hp at ih,
      cases eq_or_ne p.fr 0 with hz hnz,
      { rw [stream_eq_none_of_fr_eq_zero hp hz, stream_eq_none_of_fr_eq_zero ih hz], },
      { rw [stream_succ_of_some hp hnz, stream_succ_of_some ih hnz], } } }
end

end int_fract_pair

section head
/-!
### Translation of the Head Term

Here we state some lemmas that show us that the head term of the computed continued fraction of a
value `v` is `⌊v⌋` and how this head term is moved along the structures used in the computation
process.
-/

/-- The head term of the sequence with head of `v` is just the integer part of `v`. -/
@[simp]

lemma of_h_eq_int_fract_pair_seq1_fst_b : (of v).h = (int_fract_pair.seq1 v).fst.b :=
by { cases aux_seq_eq : (int_fract_pair.seq1 v), simp [of, aux_seq_eq] }

/-- The head term of the gcf of `v` is `⌊v⌋`. -/
@[simp]
lemma of_h_eq_floor : (of v).h = ⌊v⌋ :=
by simp [of_h_eq_int_fract_pair_seq1_fst_b, int_fract_pair.of]

end head

section sequence
/-!
### Translation of the Sequences

Here we state some lemmas that show how the sequences of the involved structures
(`int_fract_pair.stream`, `int_fract_pair.seq1`, and `generalized_continued_fraction.of`) are
connected, i.e. how the values are moved along the structures and how the termination of one
sequence implies the termination of another sequence.
-/

variable {n : ℕ}

lemma int_fract_pair.nth_seq1_eq_succ_nth_stream :
  (int_fract_pair.seq1 v).snd.nth n = (int_fract_pair.stream v) (n + 1) := rfl

section termination
/-!
#### Translation of the Termination of the Sequences

Let's first show how the termination of one sequence implies the termination of another sequence.
-/

lemma of_terminated_at_iff_int_fract_pair_seq1_terminated_at :
  (of v).terminated_at n ↔ (int_fract_pair.seq1 v).snd.terminated_at n :=
option.map_eq_none

lemma of_terminated_at_n_iff_succ_nth_int_fract_pair_stream_eq_none :
  (of v).terminated_at n ↔ int_fract_pair.stream v (n + 1) = none :=
by rw [of_terminated_at_iff_int_fract_pair_seq1_terminated_at, stream.seq.terminated_at,
  int_fract_pair.nth_seq1_eq_succ_nth_stream]

end termination

section values
/-!
#### Translation of the Values of the Sequence

Now let's show how the values of the sequences correspond to one another.
-/

lemma int_fract_pair.exists_succ_nth_stream_of_gcf_of_nth_eq_some {gp_n : pair K}
  (s_nth_eq : (of v).s.nth n = some gp_n) :
  ∃ (ifp : int_fract_pair K), int_fract_pair.stream v (n + 1) = some ifp ∧ (ifp.b : K) = gp_n.b :=
begin
  obtain ⟨ifp, stream_succ_nth_eq, gp_n_eq⟩ :
    ∃ ifp, int_fract_pair.stream v (n + 1) = some ifp ∧ pair.mk 1 (ifp.b : K) = gp_n, by
    { unfold of int_fract_pair.seq1 at s_nth_eq,
      rwa [seq.map_tail, seq.nth_tail, seq.map_nth, option.map_eq_some'] at s_nth_eq },
  cases gp_n_eq,
  injection gp_n_eq with _ ifp_b_eq_gp_n_b,
  existsi ifp,
  exact ⟨stream_succ_nth_eq, ifp_b_eq_gp_n_b⟩
end

/--
Shows how the entries of the sequence of the computed continued fraction can be obtained by the
integer parts of the stream of integer and fractional parts.
-/
lemma nth_of_eq_some_of_succ_nth_int_fract_pair_stream {ifp_succ_n : int_fract_pair K}
  (stream_succ_nth_eq : int_fract_pair.stream v (n + 1) = some ifp_succ_n) :
  (of v).s.nth n = some ⟨1, ifp_succ_n.b⟩ :=
begin
  unfold of int_fract_pair.seq1,
  rw [seq.map_tail, seq.nth_tail, seq.map_nth],
  simp [seq.nth, stream_succ_nth_eq]
end

/--
Shows how the entries of the sequence of the computed continued fraction can be obtained by the
fractional parts of the stream of integer and fractional parts.
-/
lemma nth_of_eq_some_of_nth_int_fract_pair_stream_fr_ne_zero {ifp_n : int_fract_pair K}
  (stream_nth_eq : int_fract_pair.stream v n = some ifp_n) (nth_fr_ne_zero : ifp_n.fr ≠ 0) :
  (of v).s.nth n = some ⟨1, (int_fract_pair.of ifp_n.fr⁻¹).b⟩ :=
have int_fract_pair.stream v (n + 1) = some (int_fract_pair.of ifp_n.fr⁻¹), by
  { cases ifp_n, simp [int_fract_pair.stream, stream_nth_eq, nth_fr_ne_zero] },
nth_of_eq_some_of_succ_nth_int_fract_pair_stream this

open int int_fract_pair

lemma of_s_head_aux (v : K) :
  (of v).s.nth 0 = (int_fract_pair.stream v 1).bind (some ∘ λ p, {a := 1, b := p.b}) :=
begin
  rw [of, int_fract_pair.seq1, of._match_1],
  simp only [seq.map_tail, seq.map, seq.tail, seq.head, seq.nth, stream.map],
  rw [← stream.nth_succ, stream.nth, option.map],
end

/--
This gives the first pair of coefficients of the continued fraction of a non-integer `v`.
-/
lemma of_s_head (h : fract v ≠ 0) : (of v).s.head = some ⟨1, ⌊(fract v)⁻¹⌋⟩ :=
begin
  change (of v).s.nth 0 = _,
  rw [of_s_head_aux, stream_succ_of_some (stream_zero v) h, option.bind],
  refl,
end

variables (K)

/--
If `a` is an integer, then the coefficient sequence of its continued fraction is empty.
-/
lemma of_s_of_int (a : ℤ) : (of (a : K)).s = seq.nil :=
begin
  have h : ∀ n, (of (a : K)).s.nth n = none,
  { intro n,
    induction n with n ih,
    { rw [of_s_head_aux, stream_succ_of_int, option.bind], },
    { exact (of (a : K)).s.prop ih, } },
  exact seq.ext (λ n, (h n).trans (seq.nth_nil n).symm),
end

variables {K} (v)

/--
Recurrence for the `generalized_continued_fraction.of` an element `v` of `K` in terms of
that of the inverse of the fractional part of `v`.
-/
lemma of_s_succ (n : ℕ) : (of v).s.nth (n + 1) = (of (fract v)⁻¹).s.nth n :=
begin
  cases eq_or_ne (fract v) 0 with h h,
  { obtain ⟨a, rfl⟩ : ∃ a : ℤ, v = a := ⟨⌊v⌋,  eq_of_sub_eq_zero h⟩,
    rw [fract_int_cast, inv_zero, of_s_of_int, ← cast_zero, of_s_of_int, seq.nth_nil,
        seq.nth_nil], },
  cases eq_or_ne ((of (fract v)⁻¹).s.nth n) none with h₁ h₁,
  { rwa [h₁, ← terminated_at_iff_s_none,
         of_terminated_at_n_iff_succ_nth_int_fract_pair_stream_eq_none, stream_succ h,
         ← of_terminated_at_n_iff_succ_nth_int_fract_pair_stream_eq_none,
         terminated_at_iff_s_none], },
  { obtain ⟨p, hp⟩ := option.ne_none_iff_exists'.mp h₁,
    obtain ⟨p', hp'₁, _⟩ := exists_succ_nth_stream_of_gcf_of_nth_eq_some hp,
    have Hp := nth_of_eq_some_of_succ_nth_int_fract_pair_stream hp'₁,
    rw [← stream_succ h] at hp'₁,
    rw [Hp, nth_of_eq_some_of_succ_nth_int_fract_pair_stream hp'₁], }
end

/--
This expresses the tail of the coefficient sequence of the `generalized_continued_fraction.of`
an element `v` of `K` as the coefficient sequence of that of the inverse of the
fractional part of `v`.
-/
lemma of_s_tail : (of v).s.tail = (of (fract v)⁻¹).s :=
seq.ext $ λ n, seq.nth_tail (of v).s n ▸ of_s_succ v n

variables (K) (n)

/--
If `a` is an integer, then the `convergents'` of its continued fraction expansion
are all equal to `a`.
-/
lemma convergents'_of_int (a : ℤ) : (of (a : K)).convergents' n = a :=
begin
  induction n with n ih,
  { simp only [zeroth_convergent'_eq_h, of_h_eq_floor, floor_int_cast], },
  { rw [convergents', of_h_eq_floor, floor_int_cast, add_right_eq_self],
    exact convergents'_aux_succ_none ((of_s_of_int K a).symm ▸ seq.nth_nil 0) _, }
end

variables {K} (v)

/--
The recurrence relation for the `convergents'` of the continued fraction expansion
of an element `v` of `K` in terms of the convergents of the inverse of its fractional part.
-/
lemma convergents'_succ :
  (of v).convergents' (n + 1) = ⌊v⌋ + 1 / (of (fract v)⁻¹).convergents' n :=
begin
  cases eq_or_ne (fract v) 0 with h h,
  { obtain ⟨a, rfl⟩ : ∃ a : ℤ, v = a := ⟨⌊v⌋, eq_of_sub_eq_zero h⟩,
    rw [convergents'_of_int, fract_int_cast, inv_zero, ← cast_zero,
        convergents'_of_int, cast_zero, div_zero, add_zero, floor_int_cast], },
  { rw [convergents', of_h_eq_floor, add_right_inj, convergents'_aux_succ_some (of_s_head h)],
    exact congr_arg ((/) 1) (by rw [convergents', of_h_eq_floor, add_right_inj, of_s_tail]), }
end

end values
end sequence
end generalized_continued_fraction


/-
Copyright (c) 2022 Praneeth Kolichala. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Praneeth Kolichala
-/
-- import data.num.to_bits
import to_bits
import data.list.basic
import lists
import tactic

/-!
# Efficient Pairing

One issue with the standard `nat.mkpair` is that it isn't suitable for polytime encoding.
While the pairing function itself runs in polynomial time, repeated applications of it
(even only polynomially many) can cause the result to blow up exponentially. Therefore, we cannot
e.g. create lists by encoding `[a, b, c, ...] = (a, (b, (c, ...)))` in polynomial time.

This file defines an efficient pairing function. We first define a pairing function
on lists which take `list bool`'s of `a` and `b`, and outputs an encoding of `(a, b)`,
which has size `a.length + b.length + O(log a.length)` (so only logarithmic overhead in the first
argument). We then extend this to `nat`'s using `encode_num`.

## Main definitions

### List pairing
  - `list.mkpair'` - Encodes a pair of `list bool`'s with linear overhead i.e.
      `|(a, b)| = O(|a|) + |b|`, where `|a|` denotes the size of list `a`.
  - `list.mkpair` - Encodes a pair of `list bool`'s with logarithmic overhead i.e.
      `|(a, b)| = |a| + |b| + O(log |a|)`

### Nat pairing
  - `nat.mkpair'` Encodes a pair of natural numbers with logarithmic overhead i.e.
      `log₂ (nat.mkpair a b) = log₂ a + log₂ b + O(log log a)`
-/

namespace list

/-- A preliminary pairing function.
This encodes (a, b) as a unary encoding of the length of `a` followed by `a ++ b`. -/
def mkpair' (a b : list bool) : list bool :=
(repeat ff a.length) ++ (tt :: (a ++ b))

/-- Left inverse to `list.mkpair'` -/
def unpair' (x : list bool) : list bool × list bool :=
(x.after (=tt)).split_at (x.take_while (=ff)).length

@[simp] lemma unpair'_mkpair' (a b : list bool) : unpair' (mkpair' a b) = (a, b) :=
begin
  have h₁ : (mkpair' a b).after (=tt) = a ++ b,
  { apply after_spec, { simp [mem_repeat], }, { refl, }, },
  have h₂ : ((mkpair' a b).take_while (=ff)).length = a.length,
  { erw take_while_spec, { apply length_repeat, }, { simp [mem_repeat], }, trivial, },
  simp [unpair', h₁, h₂],
end

/-- Size bound for `mkpair'`: `|(a, b)| = O(|a|) + |b|` -/
@[simp] lemma mkpair'_length (a b : list bool) : (mkpair' a b).length = 2*a.length + b.length + 1 :=
by { simp [mkpair'], ring, }

/-- The efficient pairing function on `list bool`'s.
This function encodes (a, b) as a unary encoding of the number of bits in `a.length`, followed
by `a.length`, followed by `a ++ b`. -/
def mkpair (a b : list bool) : list bool :=
mkpair' (num.to_bits a.length) (a ++ b)

/-- Left inverse to `list.mkpair` -/
def unpair (ls : list bool) : list bool × list bool :=
(unpair' ls).2.split_at (num.of_bits (unpair' ls).1)

@[simp] lemma unpair_mkpair (a b : list bool) : unpair (mkpair a b) = (a, b) :=
by simp [unpair, mkpair]

lemma mkpair_length (a b : list bool) : (mkpair a b).length =
  if a.length = 0 then b.length + 1 else 2*(nat.log 2 a.length) + a.length + b.length + 3 :=
by { split_ifs with h; simp [mkpair, num.to_bits_len, h], ring, }

/-- Size bound for `mkpair'`: `|(a, b)| = |a| + |b| + O(log |a|)` -/
lemma mkpair_length_le (a b : list bool) :
  (mkpair a b).length ≤ 2*(nat.log 2 a.length) + a.length + b.length + 3 :=
by { rw mkpair_length, split_ifs; linarith, }

/-- A nice coincidence in our choice of pairing function: if `a` and `b` have most significant
bit `1`, then so does `mkpair' a b`. This allows for easy encoding of nat's in the standard way -/
lemma mkpair_mem_num_encode_range {a b : list bool}
  (h₁ : b ∈ set.range num.to_bits) (h₂ : b = [] → a ∈ set.range num.to_bits) :
  a.mkpair b ∈ set.range num.to_bits :=
begin
  simp only [mkpair, mkpair', num.mem_to_bits_range_iff] at ⊢ h₁ h₂,
  induction b using list.reverse_cases_on with st lt, swap,
  { simpa [last'_eq_head'_reverse] using h₁, },
  induction a using list.reverse_cases_on with st lt, swap,
  { simpa [last'_eq_head'_reverse] using h₂, },
  right, simp,
end

lemma unpair_fst_len_lt (a : list bool) (ha : a ≠ []) : a.unpair.1.length < a.length :=
begin
  simp only [unpair, unpair', drop_drop, length_drop, length_take, split_at_eq_take_drop],
  rcases a with _|_|_, { simp at ha, contradiction, }, all_goals { clear ha },
  { simp only [min_lt_iff], right, apply nat.lt_of_le_of_lt (nat.sub_le _ _),
    simpa [after, nat.lt_succ_iff] using length_le_of_sublist (after_sublist _ _), },
  { simp only [min_lt_iff], left, simp [take_while], },
end

lemma unpair_snd_len_lt (a : list bool) (ha : a ≠ []) : a.unpair.2.length < a.length :=
begin
  simp only [unpair, unpair', drop_drop, split_at_eq_take_drop, length_drop],
  apply lt_of_le_of_lt (nat.sub_le _ _),
  rwa [after_length_lt, length_pos_iff_ne_nil],
end

end list

namespace nat
open num (to_bits of_bits)

/-- Efficient pairing function on ℕ, where result has size log(a) + log(b) + O(log log a) bits -/
def mkpair' (a b : ℕ) : ℕ :=
of_bits (list.mkpair (to_bits a) (to_bits b))

/-- Unpairing function for `mkpair'` -/
def unpair' (n : ℕ) : ℕ × ℕ :=
(of_bits (list.unpair (to_bits n)).1, of_bits (list.unpair (to_bits n)).2)

@[simp] lemma unpair'_mkpair' (a b : ℕ) : unpair' (mkpair' a b) = (a, b) :=
begin
  simp only [unpair', mkpair', num.of_to_nat],
  rw num.to_bits_of_bits_valid, { simp, },
  exact list.mkpair_mem_num_encode_range (set.mem_range_self _) (λ _, set.mem_range_self _),
end

lemma mkpair'_zero (a : ℕ) : mkpair' 0 a = bit1 a :=
by simp [mkpair', list.mkpair, list.mkpair']

lemma mkpair'_one (a : ℕ) : mkpair' 1 a = bit0 (bit1 (bit1 (bit1 a))) :=
by { simp [mkpair', list.mkpair, list.mkpair', to_bits, (show 1 = num.pos 1, from rfl)], }

lemma mkpair'_ne_zero (a b : ℕ) : mkpair' a b ≠ 0 :=
by { simp only [mkpair', list.mkpair, list.mkpair'], norm_cast, simp, }

lemma unpair'_fst_lt (n : ℕ) : (unpair' n.succ).1 < n.succ :=
begin
  convert_to (unpair' n.succ).1 < of_bits (to_bits n.succ), { simp, },
  apply num.of_bits_strict_mono,
  apply list.unpair_fst_len_lt, simp, norm_cast, simp,
end

lemma unpair'_fst_le (n : ℕ) : (unpair' n).1 ≤ n := by { cases n, { refl, }, exact le_of_lt (unpair'_fst_lt _), }

lemma unpair'_snd_lt (n : ℕ) : (unpair' n.succ).2 < n.succ :=
begin
  convert_to (unpair' n.succ).2 < of_bits (to_bits n.succ), { simp, },
  apply num.of_bits_strict_mono,
  apply list.unpair_snd_len_lt, simp, norm_cast, simp,
end

lemma unpair'_snd_le (n : ℕ) : (unpair' n).2 ≤ n := by { cases n, { refl, }, exact le_of_lt (unpair'_snd_lt _), }

/-- Size bound for `mkpair'`: `log₂ (mkpair' a b) = log₂ a + log₂ b + O(log log a) `-/
lemma mkpair'_le (a b : ℕ) : log 2 (mkpair' a b) ≤
  log 2 a + log 2 b + 2 * log 2 (log 2 a + 1) + 5 :=
calc log 2 (of_bits (list.mkpair (to_bits a) (to_bits b)))
    ≤ log 2 (2^((list.mkpair (to_bits a) (to_bits b)).length) - 1) :
      by { apply log_monotone, apply le_pred_of_lt, apply num.of_bits_lt, }
... ≤ (list.mkpair (to_bits a) (to_bits b)).length :
      by { conv_rhs { rw ← log_pow (show 1 < 2, by norm_num) (list.mkpair _ _).length },
           apply log_monotone, exact tsub_le_self, }
... ≤ 2*(log 2 (to_bits a).length) + (to_bits a).length + (to_bits b).length + 3 :
      list.mkpair_length_le _ _
... ≤ 2*(log 2 (log 2 a + 1)) + (log 2 a + 1) + (log 2 b + 1) + 3 :
      by { mono*, all_goals { try { apply log_monotone }, try { exact zero_le _, }, },
           all_goals { convert num.to_bits_len_le _, simp, }, }
... = _ : by ring_nf

end nat


import tactic -- hide

/-Lemma
Let $P,Q$ be logical statement and assume $Q$ is true, then $P$ implies $Q$.
-/
lemma lemma_1 (P Q : Prop) (hQ : Q) : P → Q :=
begin
  intro fish,
  exact hQ,

end

/-Hint : Why is this true?
This works because the implication `P → Q` is true unless `Q` is false and `P` is true. In this case
we are given that `Q` is always true, so the implication holds regardless of the truth value of `P`.
-/