/-
Copyright (c) 2022 Violeta Hernández Palacios. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Violeta Hernández Palacios
-/

import data.polynomial.cardinal
import ring_theory.algebraic

/-!
### Cardinality of algebraic numbers

In this file, we prove variants of the following result: the cardinality of algebraic numbers under
an R-algebra is at most `# polynomial R * ℵ₀`.

Although this can be used to prove that real or complex transcendental numbers exist, a more direct
proof is given by `liouville.is_transcendental`.
-/

universes u v

open cardinal polynomial
open_locale cardinal

namespace algebraic

theorem aleph_0_le_cardinal_mk_of_char_zero (R A : Type*) [comm_ring R] [is_domain R]
  [ring A] [algebra R A] [char_zero A] : ℵ₀ ≤ #{x : A // is_algebraic R x} :=
@mk_le_of_injective (ulift ℕ) {x : A | is_algebraic R x} (λ n, ⟨_, is_algebraic_nat n.down⟩)
  (λ m n hmn, by simpa using hmn)

section lift

variables (R : Type u) (A : Type v) [comm_ring R] [comm_ring A] [is_domain A] [algebra R A]
  [no_zero_smul_divisors R A]

theorem cardinal_mk_lift_le_mul :
  cardinal.lift.{u v} (#{x : A // is_algebraic R x}) ≤ cardinal.lift.{v u} (#(polynomial R)) * ℵ₀ :=
begin
  rw [←mk_ulift, ←mk_ulift],
  let g : ulift.{u} {x : A | is_algebraic R x} → ulift.{v} (polynomial R) :=
    λ x, ulift.up (classical.some x.1.2),
  apply cardinal.mk_le_mk_mul_of_mk_preimage_le g (λ f, _),
  suffices : fintype (g ⁻¹' {f}),
  { exact @mk_le_aleph_0 _ (@fintype.to_encodable _ this) },
  by_cases hf : f.1 = 0,
  { convert set.fintype_empty,
    apply set.eq_empty_iff_forall_not_mem.2 (λ x hx, _),
    simp only [set.mem_preimage, set.mem_singleton_iff] at hx,
    apply_fun ulift.down at hx,
    rw hf at hx,
    exact (classical.some_spec x.1.2).1 hx },
  let h : g ⁻¹' {f} → f.down.root_set A := λ x, ⟨x.1.1.1, (mem_root_set_iff hf x.1.1.1).2 begin
    have key' : g x = f := x.2,
    simp_rw ← key',
    exact (classical.some_spec x.1.1.2).2
  end⟩,
  apply fintype.of_injective h (λ _ _ H, _),
  simp only [subtype.val_eq_coe, subtype.mk_eq_mk] at H,
  exact subtype.ext (ulift.down_injective (subtype.ext H))
end

theorem cardinal_mk_lift_le_max :
  cardinal.lift.{u v} (#{x : A // is_algebraic R x}) ≤ max (cardinal.lift.{v u} (#R)) ℵ₀ :=
(cardinal_mk_lift_le_mul R A).trans $
  (mul_le_mul_right' (lift_le.2 cardinal_mk_le_max) _).trans $ by simp [le_total]

theorem cardinal_mk_lift_le_of_infinite [infinite R] :
  cardinal.lift.{u v} (#{x : A // is_algebraic R x}) ≤ cardinal.lift.{v u} (#R) :=
(cardinal_mk_lift_le_max R A).trans $ by simp

variable [encodable R]

@[simp] theorem countable_of_encodable : set.countable {x : A | is_algebraic R x} :=
begin
  rw [←mk_set_le_aleph_0, ←lift_le],
  apply (cardinal_mk_lift_le_max R A).trans,
  simp
end

@[simp] theorem cardinal_mk_of_encodable_of_char_zero [char_zero A] [is_domain R] :
  #{x : A // is_algebraic R x} = ℵ₀ :=
le_antisymm (by simp) (aleph_0_le_cardinal_mk_of_char_zero R A)

end lift

section non_lift

variables (R A : Type u) [comm_ring R] [comm_ring A] [is_domain A] [algebra R A]
  [no_zero_smul_divisors R A]

theorem cardinal_mk_le_mul : #{x : A // is_algebraic R x} ≤ #(polynomial R) * ℵ₀ :=
by { rw [←lift_id (#_), ←lift_id (#(polynomial R))], exact cardinal_mk_lift_le_mul R A }

theorem cardinal_mk_le_max : #{x : A // is_algebraic R x} ≤ max (#R) ℵ₀ :=
by { rw [←lift_id (#_), ←lift_id (#R)], exact cardinal_mk_lift_le_max R A }

theorem cardinal_mk_le_of_infinite [infinite R] : #{x : A // is_algebraic R x} ≤ #R :=
(cardinal_mk_le_max R A).trans $ by simp

end non_lift

end algebraic


/-
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.lemmas
import data.nat.log
import lists
import log_lemmas

/-!
# Conversion of `num` to and from `list bool`

This file provides functions to encode `num` as a `list bool` and decode `list bool`'s into `num`'s.
For convenience, the decoding function always returns a value. If the most significant bit isn't
`1`, it implicitly changes it to `1` when decoding. We then prove several lemmas about this
encoding.
-/

namespace pos_num

/-- Convert a `pos_num` to a `list bool` in little-endian form (with LSB at the head).
This is an equivalence, so the msb (which is always present for positive numbers) is omitted. -/
def to_trailing_bits : pos_num → list bool
| 1 := []
| (bit0 xs) := ff :: xs.to_trailing_bits
| (bit1 xs) := tt :: xs.to_trailing_bits

/-- Equivalence between `pos_num` and `list bool` with lsb at the head and msb omitted -/
def equiv_list_bool : pos_num ≃ list bool :=
{ to_fun := to_trailing_bits,
  inv_fun := λ l, l.foldr (λ b n, (cond b bit1 bit0) n) 1,
  left_inv := λ n, by induction n; simpa [to_trailing_bits],
  right_inv := λ l, by { induction l with hd, { refl, }, cases hd; simpa [to_trailing_bits], } }

@[simp] lemma equiv_list_bool_one : equiv_list_bool 1 = [] := rfl
@[simp] lemma equiv_list_bool_bit0 (n : pos_num) :
  equiv_list_bool (bit0 n) = ff :: equiv_list_bool n := rfl
@[simp] lemma equiv_list_bool_bit1 (n : pos_num) :
  equiv_list_bool (bit1 n) = tt :: equiv_list_bool n := rfl
@[simp] lemma equiv_list_bool_symm_cons_tt (l : list bool) :
  equiv_list_bool.symm (tt :: l) = bit1 (equiv_list_bool.symm l) := rfl
@[simp] lemma equiv_list_bool_symm_cons_ff (l : list bool) :
  equiv_list_bool.symm (ff :: l) = bit0 (equiv_list_bool.symm l) := rfl

lemma to_trailing_bits_len (n : pos_num) : (equiv_list_bool n).length = nat.log 2 n :=
begin
  induction n with b ih b ih, { erw equiv_list_bool_one, simp, },
  { simp [cast_bit1, nat.bit1_val b, ih], },
  { simp [cast_bit0, nat.bit0_val b, ih], }
end

lemma equiv_list_bool_symm_lt (ls : list bool) : (equiv_list_bool.symm ls : ℕ) < 2^(ls.length+1) :=
begin
  induction ls with hd tl ih, { simp [equiv_list_bool], },
  cases hd,
  { simp only [equiv_list_bool_symm_cons_ff, pos_num.cast_bit0],
    rw [nat.bit0_val, mul_comm, pow_add], simpa, },
  { simp only [equiv_list_bool_symm_cons_tt, pos_num.cast_bit1],
    rw [nat.bit1_val, add_comm, pow_add],
    apply @nat.lt_of_div_lt_div _ _ 2,
    simpa [nat.add_mul_div_left, nat.div_eq_of_lt], },
end

end pos_num

namespace num

/-- An encoding function of the binary numbers in bool. -/
def to_bits : num → list bool
| num.zero := []
| (num.pos n) := (pos_num.equiv_list_bool n) ++ [tt]

@[simp] lemma to_bits_zero : to_bits 0 = [] := rfl

@[simp] lemma to_bits_bit0 (n : num) (hn : n ≠ 0) : (num.bit0 n).to_bits = ff :: n.to_bits :=
by { cases n, { contradiction, }, simp [to_bits, num.bit0], }

@[simp] lemma to_bits_bit0' (n : num) (hn : n ≠ 0) : (_root_.bit0 n).to_bits = ff :: n.to_bits :=
by { convert to_bits_bit0 _ hn, exact bit0_of_bit0 n, }

@[simp] lemma to_bits_bit1 (n : num) : (num.bit1 n).to_bits = tt :: n.to_bits :=
by { cases n, { refl, }, simp [to_bits, num.bit1], }

@[simp] lemma to_bits_bit1' (n : num) : (_root_.bit1 n).to_bits = tt :: n.to_bits :=
by { convert to_bits_bit1 n, exact bit1_of_bit1 n, }

/-- A decoding function from `list bool` to `num` -/
def of_bits (L : list bool) : num := if L = [] then 0 else pos_num.equiv_list_bool.symm L.init

@[simp] lemma of_bits_nil : of_bits [] = 0 := rfl
@[simp] lemma of_bits_cons_ff (l : list bool) (hl : l ≠ []) :
  of_bits (ff :: l) = num.bit0 (of_bits l) := by simp [of_bits, hl, num.bit0]
@[simp] lemma of_bits_cons_tt (l : list bool) : of_bits (tt :: l) = num.bit1 (of_bits l) :=
by { cases l, { refl, }, simp [of_bits, num.bit1], }

@[simp] lemma of_bits_to_bits (n : num) : of_bits (to_bits n) = n :=
by { cases n, { refl, }, simp [of_bits, to_bits], }

lemma of_bits_to_bits_left_inv : function.left_inverse of_bits to_bits := of_bits_to_bits

lemma mem_to_bits_range_iff (l : list bool) :
  l ∈ set.range to_bits ↔ l = [] ∨ tt ∈ l.last' :=
begin
  split, { rintro ⟨n, rfl⟩, cases n; simp [to_bits], },
  apply list.reverse_cases_on l, { intro, use 0, refl, },
  intros st lt h,
  use (pos_num.equiv_list_bool.symm st),
  symmetry, simpa [to_bits] using h,
end

lemma mem_to_bits_range_of_cons {hd : bool} {tl : list bool} (h : hd :: tl ∈ set.range to_bits) :
  tl ∈ set.range to_bits :=
by { rw mem_to_bits_range_iff at ⊢ h, cases tl with hd' tl', { exact or.inl rfl, }, simpa using h, }

@[simp] lemma to_bits_of_bits_valid {l : list bool} (h : l ∈ set.range to_bits) :
  to_bits (of_bits l) = l := of_bits_to_bits_left_inv.right_inv_on_range h

@[simp] lemma of_bits_invalid (l : list bool) :
  of_bits (l ++ [ff]) = of_bits (l ++ [tt]) := by simp [of_bits]

lemma to_bits_len (n : num) : (to_bits n).length = if n = 0 then 0 else nat.log 2 n + 1 :=
begin
  cases n, { refl, },
  simp [(show pos n ≠ 0, by trivial), to_bits, pos_num.to_trailing_bits_len],
end

lemma to_bits_len_le (n : num) : (to_bits n).length ≤ nat.log 2 n + 1 :=
by { rw to_bits_len, split_ifs with h; simp [h],  }

lemma of_bits_lt (l : list bool) : (of_bits l : ℕ) < 2^l.length :=
begin
  apply list.reverse_cases_on l, { simp [of_bits], },
  intros st tl, cases tl; simpa [of_bits] using pos_num.equiv_list_bool_symm_lt _,
end

lemma le_of_bits (l : list bool) (hl : l ≠ []) : 2^(l.length - 1) ≤ (of_bits l : ℕ) :=
begin
  induction l with hd tl ih, { contradiction, },
  cases tl with h t, { cases hd; simp [of_bits], },
  specialize ih (by trivial),
  cases hd,
  { simpa [pow_add, nat.bit0_val (of_bits (h :: t)), mul_comm] using ih, },
  simp only [of_bits_cons_tt, nat.bit1_val (of_bits (h :: t)), num.cast_bit1],
  refine trans _ (nat.le_succ _),
  simpa [pow_add, mul_comm] using ih,
end

lemma of_bits_strict_mono (l₁ l₂ : list bool) (h : l₁.length < l₂.length) :
  (of_bits l₁ : ℕ) < of_bits l₂ :=
calc (of_bits l₁ : ℕ) < 2^l₁.length : of_bits_lt l₁
                    ...  ≤ 2^(l₂.length - 1) : pow_mono (show 1 ≤ 2, by simp) (nat.le_pred_of_lt h)
                    ...  ≤ of_bits l₂ : le_of_bits l₂ (by { rintro rfl, simpa using h, })

@[simp] lemma to_bits_nil_iff (n : num) : to_bits n = [] ↔ n = 0 :=
⟨λ h, by simpa using congr_arg of_bits h, λ h, by { rw h, refl, }⟩

@[simp] lemma of_bits_zero_iff (l : list bool) : of_bits l = 0 ↔ l = [] :=
⟨λ h, by { by_contra H, simp [of_bits, H] at h, contradiction, }, λ h, by { rw h, refl, }⟩

end num


namespace TBA

-- Let's work with some inductive types other than `Nat`!

-- Here is our very own definition of `List`:
inductive List (α : Type) where
  | nil : List α
  | cons (head : α) (tail : List α) : List α

notation  (priority := high) "[" "]" => List.nil   -- `[]`
infixr:67 (priority := high) " :: "  => List.cons  -- `a :: as`

-- as a warmup exercise, let's define concatenation of two lists
def append (as bs : List α) : List α :=
  match as with
  | []      => bs
  | a :: as => a :: append as bs

infixl:65 (priority := high) " ++ " => append

example : 1::2::[] ++ 3::4::[] = 1::2::3::4::[] := rfl

-- as with associativity on `Nat`, think twice about what induction variable to use!
theorem append_assoc {as bs cs : List α} : (as ++ bs) ++ cs = as ++ (bs ++ cs) := by
  induction as with
  | nil => rfl
  | cons a as ih => simp [append, ih]

open Decidable

/-
One important special case of `Decidable` is decidability of equalities:
```
abbrev DecidableEq (α : Type) :=
  (a b : α) → Decidable (a = b)

def decEq [s : DecidableEq α] (a b : α) : Decidable (a = b) :=
  s a b
```
Note: `DecidableEq` is defined using `abbrev` instead of `def` because typeclass resolution only
unfolds the former for performance reasons.

Let's try to prove that `List` equality is decidable!
-/
-- hint: Something is still missing. Do we need to assume anything about `α`?
-- hint: Apply `match` case distinctions until the the appropriate `Decidable` constructor is clear,
--   then fill in its proof argument with `by`.
--   We could also do everything in a `by` block, but it's nicer to reserve tactics for proofs so we have
--   more control about the code of programs, i.e. the part that is actually executed
def ldecEq [DecidableEq α] (as bs : List α) : Decidable (as = bs) := /-SOL_-/
  match as, bs with
  | [],      []      => isTrue rfl
  | [],      b :: bs => isFalse (by intro h; contradiction)  -- or simply:
  | a :: as, []      => isFalse (by simp_all)
  | a :: as, b :: bs =>
    match decEq a b, ldecEq as bs with
    | isTrue _,  isTrue _  => isTrue (by simp_all)
    | isFalse _, _         => isFalse (by intro h; injection h; simp_all)
    | _,         isFalse _ => isFalse (by intro h; injection h; simp_all)

-- Let's declare the instance:
instance [DecidableEq α] : DecidableEq (List α) := /-SOL_-/ldecEq/-END-/

-- This should now work:
#eval decEq (1::2::[]) (1::3::[])

/-
`DecidabePred` is another convenient abbreviation of `Decidable`
```
abbrev DecidablePred (r : α → Prop) :=
  (a : α) → Decidable (r a)
```
If we have `[DecidablePred p]`, we can e.g. use `if p a then ...` for some `a : α`.

`filter p as` is a simple list function that should remove all elements `a` for which `p a` does not hold.
-/
def filter (p : α → Prop) [DecidablePred p] (as : List α) : List α :=
  match as with
  | [] => []
  | a::as => if p a then a :: filter p as else filter p as

example : filter (fun x => x % 2 = 0) (1::2::3::4::[]) = 2::4::[] := rfl

variable {p : α → Prop} [DecidablePred p] {as bs : List α}

-- These helper theorems can be useful, also for manual rewriting
@[simp] theorem filter_cons_true (h : p a) : filter p (a :: as) = a :: filter p as :=
  by simp [filter, h]
@[simp] theorem filter_cons_false (h : ¬ p a) : filter p (a :: as) = filter p as :=
  by simp [filter, h]
-- It's worthwhile thinking about what's actually happening here:
-- * first, `filter p (a :: as)` is unfolded to `if p a then a :: filter p as else filter p as`
--   (note that the second `filter` cannot be unfolded)
-- * then `if p a then ...` is rewritten to `if True then ...` using `h`
-- * finally, `if True then a :: filter p as else ...` is rewritten to `a :: filter p as` using
--   the built-in simp theorem `Lean.Simp.ite_True`

-- useful tactic: `byCases h : q` for a decidable proposition `q`
theorem filter_idem : filter p (filter p as) = filter p as := by
  induction as with
  | nil => rfl
  | cons a as ih => byCases h : p a <;> simp [ih, h]

theorem filter_append : filter p (as ++ bs) = filter p as ++ filter p bs := by
  induction as with
  | nil => rfl
  | cons a as ih => byCases h : p a <;> simp [append, ih, h]

-- list membership as an inductive predicate:
inductive Mem (a : α) : List α → Prop where
  -- either it's the first element...
  | head {as} : Mem a (a::as)
  -- or it's in the remainder list
  | tail {as} : Mem a as → Mem a (a'::as)

infix:50 " ∈ " => Mem

-- recall that `a ≠ b` is the same as `a = b → False`
theorem mem_of_nonempty_filter (h : ∀ a, p a → a = x) : filter p as ≠ [] → x ∈ as := by
  intro hfil
  induction as with
  | nil => contradiction
  | cons a as ih =>
    byCases hpa : p a
    case inl =>
      rw [h _ hpa]
      exact Mem.head
    case inr =>
      rw [filter_cons_false hpa] at hfil
      exact Mem.tail (ih hfil)

-- This proof is pretty long! Some hints:
-- * If you have an assumption `h : a ∈ []`, you can solve the current goal by `cases h`:
--   since there is no constructor that could possibly match `[]`, there is nothing left to prove!
--   This exclusion of cases, and case analysis on inductive predicates in general,
--   is also called *rule inversion* since we (try to) apply the introduction rules (constructors)
--   "in reverse".
-- * On the other hand, if you try to do case analysis on a proof of e.g. `a ∈ filter p as`,
--   Lean will complain with "dependent elimination failed" since it *doesn't* know yet if
--   the argument `filter p as` is of the form `_ :: _` as demanded by the `Mem` constructors.
--   You need to get the assumption into the shape `_ ∈ []` or `_ ∈ _ :: _` before applying
--   `(no)match/cases` to it.
theorem mem_filter : a ∈ filter p as ↔ a ∈ as ∧ p a := by
  apply Iff.intro
  case mp =>
    intro h
    induction as with
    | nil => cases h
    | cons a' as ih =>
      byCases ha' : p a'
      case inl =>
        rw [filter_cons_true ha'] at h
        cases h with
        | head => exact ⟨Mem.head, ha'⟩
        | tail h => exact ⟨Mem.tail (ih h).1, (ih h).2⟩
      case inr =>
        rw [filter_cons_false ha'] at h
        exact ⟨Mem.tail (ih h).1, (ih h).2⟩
  case mpr =>
    intro h
    induction as with
    | nil => cases h.1
    | cons a' as ih =>
      cases h.1 with
      | head =>
        rw [filter_cons_true h.2]
        constructor
      | tail ha =>
        have : a ∈ filter p as := ih ⟨ha, h.2⟩
        byCases hpa' : p a'
        case inl =>
          rw [filter_cons_true hpa']
          apply Mem.tail this
        case inr =>
          rw [filter_cons_false hpa']
          apply this

-- Here is an alternative definition of list membership via `append`
inductive Mem' (a : α) : List α → Prop where
  | intro (as bs) : Mem' a (as ++ (a :: bs))

infix:50 " ∈' " => Mem'

-- Let's prove that they are equivalent!
theorem mem_mem' : a ∈ as ↔ a ∈' as := by
  constructor
  case mp =>
    intro h
    induction h with
    | head => exact ⟨[], _⟩
    | tail h ih =>
      have ⟨as', bs'⟩ := ih
      exact ⟨_::as', _⟩
  case mpr =>
    intro ⟨as', bs'⟩
    induction as' with
    | nil => exact Mem.head
    | cons a' as' ih => exact Mem.tail ih

end TBA


/-
Copyright (c) 2014 Parikshit Khanna. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Parikshit Khanna, Jeremy Avigad, Leonardo de Moura, Floris van Doorn, Mario Carneiro
-/
import data.list.big_operators

/-!
# Counting in lists

This file proves basic properties of `list.countp` and `list.count`, which count the number of
elements of a list satisfying a predicate and equal to a given element respectively. Their
definitions can be found in [`data.list.defs`](./data/list/defs).
-/

open nat

variables {α β : Type*} {l l₁ l₂ : list α}

namespace list

section countp
variables (p : α → Prop) [decidable_pred p]

@[simp] lemma countp_nil : countp p [] = 0 := rfl

@[simp] lemma countp_cons_of_pos {a : α} (l) (pa : p a) : countp p (a::l) = countp p l + 1 :=
if_pos pa

@[simp] lemma countp_cons_of_neg {a : α} (l) (pa : ¬ p a) : countp p (a::l) = countp p l :=
if_neg pa

lemma length_eq_countp_add_countp (l) : length l = countp p l + countp (λ a, ¬p a) l :=
by induction l with x h ih; [refl, by_cases p x];
  [simp only [countp_cons_of_pos _ _ h, countp_cons_of_neg (λ a, ¬p a) _ (decidable.not_not.2 h),
    ih, length],
   simp only [countp_cons_of_pos (λ a, ¬p a) _ h, countp_cons_of_neg _ _ h, ih, length]]; ac_refl

lemma countp_eq_length_filter (l) : countp p l = length (filter p l) :=
by induction l with x l ih; [refl, by_cases (p x)];
  [simp only [filter_cons_of_pos _ h, countp, ih, if_pos h],
   simp only [countp_cons_of_neg _ _ h, ih, filter_cons_of_neg _ h]]; refl

@[simp] lemma countp_append (l₁ l₂) : countp p (l₁ ++ l₂) = countp p l₁ + countp p l₂ :=
by simp only [countp_eq_length_filter, filter_append, length_append]

lemma countp_pos {l} : 0 < countp p l ↔ ∃ a ∈ l, p a :=
by simp only [countp_eq_length_filter, length_pos_iff_exists_mem, mem_filter, exists_prop]

lemma length_filter_lt_length_iff_exists (l) : length (filter p l) < length l ↔ ∃ x ∈ l, ¬p x :=
by rw [length_eq_countp_add_countp p l, ← countp_pos, countp_eq_length_filter, lt_add_iff_pos_right]

lemma sublist.countp_le (s : l₁ <+ l₂) : countp p l₁ ≤ countp p l₂ :=
by simpa only [countp_eq_length_filter] using length_le_of_sublist (s.filter p)

@[simp] lemma countp_filter {q} [decidable_pred q] (l : list α) :
  countp p (filter q l) = countp (λ a, p a ∧ q a) l :=
by simp only [countp_eq_length_filter, filter_filter]

end countp

/-! ### count -/

section count
variables [decidable_eq α]

@[simp] lemma count_nil (a : α) : count a [] = 0 := rfl

lemma count_cons (a b : α) (l : list α) :
  count a (b :: l) = if a = b then succ (count a l) else count a l := rfl

lemma count_cons' (a b : α) (l : list α) :
  count a (b :: l) = count a l + (if a = b then 1 else 0) :=
begin rw count_cons, split_ifs; refl end

@[simp] lemma count_cons_self (a : α) (l : list α) : count a (a::l) = succ (count a l) := if_pos rfl

@[simp, priority 990]
lemma count_cons_of_ne {a b : α} (h : a ≠ b) (l : list α) : count a (b::l) = count a l := if_neg h

lemma count_tail : Π (l : list α) (a : α) (h : 0 < l.length),
  l.tail.count a = l.count a - ite (a = list.nth_le l 0 h) 1 0
| (_ :: _) a h := by { rw [count_cons], split_ifs; simp }

lemma sublist.count_le (h : l₁ <+ l₂) (a : α) : count a l₁ ≤ count a l₂ := h.countp_le _

lemma count_le_count_cons (a b : α) (l : list α) : count a l ≤ count a (b :: l) :=
(sublist_cons _ _).count_le _

lemma count_singleton (a : α) : count a [a] = 1 := if_pos rfl

@[simp] lemma count_append (a : α) : ∀ l₁ l₂, count a (l₁ ++ l₂) = count a l₁ + count a l₂ :=
countp_append _

lemma count_concat (a : α) (l : list α) : count a (concat l a) = succ (count a l) :=
by simp [-add_comm]

lemma count_pos {a : α} {l : list α} : 0 < count a l ↔ a ∈ l :=
by simp only [count, countp_pos, exists_prop, exists_eq_right']

@[simp, priority 980]
lemma count_eq_zero_of_not_mem {a : α} {l : list α} (h : a ∉ l) : count a l = 0 :=
decidable.by_contradiction $ λ h', h $ count_pos.1 (nat.pos_of_ne_zero h')

lemma not_mem_of_count_eq_zero {a : α} {l : list α} (h : count a l = 0) : a ∉ l :=
λ h', (count_pos.2 h').ne' h

@[simp] lemma count_repeat (a : α) (n : ℕ) : count a (repeat a n) = n :=
by rw [count, countp_eq_length_filter, filter_eq_self.2, length_repeat];
   exact λ b m, (eq_of_mem_repeat m).symm

lemma le_count_iff_repeat_sublist {a : α} {l : list α} {n : ℕ} :
  n ≤ count a l ↔ repeat a n <+ l :=
⟨λ h, ((repeat_sublist_repeat a).2 h).trans $
  have filter (eq a) l = repeat a (count a l), from eq_repeat.2
    ⟨by simp only [count, countp_eq_length_filter], λ b m, (of_mem_filter m).symm⟩,
  by rw ← this; apply filter_sublist,
 λ h, by simpa only [count_repeat] using h.count_le a⟩

lemma repeat_count_eq_of_count_eq_length  {a : α} {l : list α} (h : count a l = length l)  :
  repeat a (count a l) = l :=
eq_of_sublist_of_length_eq (le_count_iff_repeat_sublist.mp (le_refl (count a l)))
    (eq.trans (length_repeat a (count a l)) h)

@[simp] lemma count_filter {p} [decidable_pred p]
  {a} {l : list α} (h : p a) : count a (filter p l) = count a l :=
by simp only [count, countp_filter]; congr; exact
set.ext (λ b, and_iff_left_of_imp (λ e, e ▸ h))

lemma count_bind {α β} [decidable_eq β] (l : list α) (f : α → list β) (x : β)  :
  count x (l.bind f) = sum (map (count x ∘ f) l) :=
begin
  induction l with hd tl IH,
  { simp },
  { simpa }
end

@[simp] lemma count_map_map {α β} [decidable_eq α] [decidable_eq β] (l : list α) (f : α → β)
  (hf : function.injective f) (x : α) :
  count (f x) (map f l) = count x l :=
begin
  induction l with y l IH generalizing x,
  { simp },
  { rw map_cons,
    by_cases h : x = y,
    { simpa [h] using IH _ },
    { simpa [h, hf.ne h] using IH _ } }
end

@[simp] lemma count_erase_self (a : α) :
  ∀ (s : list α), count a (list.erase s a) = pred (count a s)
| [] := by simp
| (h :: t) :=
begin
  rw erase_cons,
  by_cases p : h = a,
  { rw [if_pos p, count_cons', if_pos p.symm], simp },
  { rw [if_neg p, count_cons', count_cons', if_neg (λ x : a = h, p x.symm), count_erase_self],
    simp }
end

@[simp] lemma count_erase_of_ne {a b : α} (ab : a ≠ b) :
  ∀ (s : list α), count a (list.erase s b) = count a s
| [] := by simp
| (x :: xs) :=
begin
  rw erase_cons,
  split_ifs with h,
  { rw [count_cons', h, if_neg ab], simp },
  { rw [count_cons', count_cons', count_erase_of_ne] }
end

end count

end list


/-
Copyright (c) 2020 Markus Himmel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Markus Himmel
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.ring_theory.ideal.operations
import Mathlib.PostPort

universes u v

namespace Mathlib

/-!
# Ideals in product rings

For commutative rings `R` and `S` and ideals `I ≤ R`, `J ≤ S`, we define `ideal.prod I J` as the
product `I × J`, viewed as an ideal of `R × S`. In `ideal_prod_eq` we show that every ideal of
`R × S` is of this form.  Furthermore, we show that every prime ideal of `R × S` is of the form
`p × S` or `R × p`, where `p` is a prime ideal.
-/

namespace ideal

/-- `I × J` as an ideal of `R × S`. -/
def prod {R : Type u} {S : Type v} [comm_ring R] [comm_ring S] (I : ideal R) (J : ideal S) : ideal (R × S) :=
  submodule.mk (set_of fun (x : R × S) => prod.fst x ∈ I ∧ prod.snd x ∈ J) sorry sorry sorry

@[simp] theorem mem_prod {R : Type u} {S : Type v} [comm_ring R] [comm_ring S] (I : ideal R) (J : ideal S) {r : R} {s : S} : (r, s) ∈ prod I J ↔ r ∈ I ∧ s ∈ J :=
  iff.rfl

@[simp] theorem prod_top_top {R : Type u} {S : Type v} [comm_ring R] [comm_ring S] : prod ⊤ ⊤ = ⊤ := sorry

/-- Every ideal of the product ring is of the form `I × J`, where `I` and `J` can be explicitly
    given as the image under the projection maps. -/
theorem ideal_prod_eq {R : Type u} {S : Type v} [comm_ring R] [comm_ring S] (I : ideal (R × S)) : I = prod (map (ring_hom.fst R S) I) (map (ring_hom.snd R S) I) := sorry

@[simp] theorem map_fst_prod {R : Type u} {S : Type v} [comm_ring R] [comm_ring S] (I : ideal R) (J : ideal S) : map (ring_hom.fst R S) (prod I J) = I := sorry

@[simp] theorem map_snd_prod {R : Type u} {S : Type v} [comm_ring R] [comm_ring S] (I : ideal R) (J : ideal S) : map (ring_hom.snd R S) (prod I J) = J := sorry

@[simp] theorem map_prod_comm_prod {R : Type u} {S : Type v} [comm_ring R] [comm_ring S] (I : ideal R) (J : ideal S) : map (↑ring_equiv.prod_comm) (prod I J) = prod J I := sorry

/-- Ideals of `R × S` are in one-to-one correspondence with pairs of ideals of `R` and ideals of
    `S`. -/
def ideal_prod_equiv {R : Type u} {S : Type v} [comm_ring R] [comm_ring S] : ideal (R × S) ≃ ideal R × ideal S :=
  equiv.mk (fun (I : ideal (R × S)) => (map (ring_hom.fst R S) I, map (ring_hom.snd R S) I))
    (fun (I : ideal R × ideal S) => prod (prod.fst I) (prod.snd I)) sorry sorry

@[simp] theorem ideal_prod_equiv_symm_apply {R : Type u} {S : Type v} [comm_ring R] [comm_ring S] (I : ideal R) (J : ideal S) : coe_fn (equiv.symm ideal_prod_equiv) (I, J) = prod I J :=
  rfl

theorem prod.ext_iff {R : Type u} {S : Type v} [comm_ring R] [comm_ring S] {I : ideal R} {I' : ideal R} {J : ideal S} {J' : ideal S} : prod I J = prod I' J' ↔ I = I' ∧ J = J' := sorry

theorem is_prime_of_is_prime_prod_top {R : Type u} {S : Type v} [comm_ring R] [comm_ring S] {I : ideal R} (h : is_prime (prod I ⊤)) : is_prime I := sorry

theorem is_prime_of_is_prime_prod_top' {R : Type u} {S : Type v} [comm_ring R] [comm_ring S] {I : ideal S} (h : is_prime (prod ⊤ I)) : is_prime I :=
  is_prime_of_is_prime_prod_top
    (eq.mpr (id (Eq._oldrec (Eq.refl (is_prime (prod I ⊤))) (Eq.symm (map_prod_comm_prod ⊤ I))))
      (map_is_prime_of_equiv ring_equiv.prod_comm))

theorem is_prime_ideal_prod_top {R : Type u} {S : Type v} [comm_ring R] [comm_ring S] {I : ideal R} [h : is_prime I] : is_prime (prod I ⊤) := sorry

theorem is_prime_ideal_prod_top' {R : Type u} {S : Type v} [comm_ring R] [comm_ring S] {I : ideal S} [h : is_prime I] : is_prime (prod ⊤ I) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (is_prime (prod ⊤ I))) (Eq.symm (map_prod_comm_prod I ⊤))))
    (map_is_prime_of_equiv ring_equiv.prod_comm)

theorem ideal_prod_prime_aux {R : Type u} {S : Type v} [comm_ring R] [comm_ring S] {I : ideal R} {J : ideal S} : is_prime (prod I J) → I = ⊤ ∨ J = ⊤ := sorry

/-- Classification of prime ideals in product rings: the prime ideals of `R × S` are precisely the
    ideals of the form `p × S` or `R × p`, where `p` is a prime ideal of `R` or `S`. -/
theorem ideal_prod_prime {R : Type u} {S : Type v} [comm_ring R] [comm_ring S] (I : ideal (R × S)) : is_prime I ↔ (∃ (p : ideal R), is_prime p ∧ I = prod p ⊤) ∨ ∃ (p : ideal S), is_prime p ∧ I = prod ⊤ p := sorry

/-- The prime ideals of `R × S` are in bijection with the disjoint union of the prime ideals
    of `R` and the prime ideals of `S`. -/
def prime_ideals_equiv (R : Type u) (S : Type v) [comm_ring R] [comm_ring S] : (Subtype fun (K : ideal (R × S)) => is_prime K) ≃
  (Subtype fun (I : ideal R) => is_prime I) ⊕ Subtype fun (J : ideal S) => is_prime J :=
  equiv.symm (equiv.of_bijective prime_ideals_equiv_impl sorry)

@[simp] theorem prime_ideals_equiv_symm_inl {R : Type u} {S : Type v} [comm_ring R] [comm_ring S] (I : ideal R) (h : is_prime I) : coe_fn (equiv.symm (prime_ideals_equiv R S)) (sum.inl { val := I, property := h }) =
  { val := prod I ⊤, property := is_prime_ideal_prod_top } :=
  rfl

@[simp] theorem prime_ideals_equiv_symm_inr {R : Type u} {S : Type v} [comm_ring R] [comm_ring S] (J : ideal S) (h : is_prime J) : coe_fn (equiv.symm (prime_ideals_equiv R S)) (sum.inr { val := J, property := h }) =
  { val := prod ⊤ J, property := is_prime_ideal_prod_top' } :=
  rfl


import for_mathlib.decimal_expansions

open decimal

noncomputable definition s : ℝ := (71/100 : ℝ)

theorem sQ : s = ((71/100:ℚ):ℝ) := by unfold s;norm_num

theorem floor_s : floor s = 0 :=
by rw [← floor_of_bounds, s, int.cast_zero]; norm_num

theorem floor_10s : floor (71/10 : ℝ) = 7 :=
begin
rw [← floor_of_bounds],
split; norm_num
end

lemma expansion_auxing_s : expansion_aux s 2 = 0 :=
begin
unfold expansion_aux,
rw floor_s,
unfold s,
norm_num,
rw floor_10s,
norm_num,
end

theorem expansion_auxed (n : ℕ) : expansion_aux s (n + 2) = 0 :=
begin
induction n with d Hd,exact expansion_auxing_s,
rw expansion_aux.equations._eqn_2,
rw Hd,
simp,
end

-- recall s = 71/100
theorem no_eights_in_0_point_71 (n : ℕ) : decimal.expansion_nonneg s n ≠ 8 :=
begin
cases n,unfold expansion_nonneg,rw floor_s,show 0 ≠ 8,by cc,
cases n,unfold expansion_nonneg expansion_aux,rw floor_s,unfold s,
  rw int.cast_zero,
  have this : ((71 / 100 : ℝ) - 0) * 10 = 71 / 10 := by norm_num,
  rw this,rw floor_10s,show 7 ≠ 8,by cc,
cases n,unfold expansion_nonneg expansion_aux,rw floor_s,unfold s,
  rw int.cast_zero,
  norm_num,
  rw floor_10s,
  norm_num,
  show 1 ≠ 8,
  by cc,
unfold expansion_nonneg,
rw [expansion_auxed,floor_zero],
show 0 ≠ 8,
by cc,
end


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

! This file was ported from Lean 3 source module category_theory.localization.construction
! leanprover-community/mathlib commit 1a5e56f2166e4e9d0964c71f4273b1d39227678d
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.CategoryTheory.MorphismProperty
import Mathlib.CategoryTheory.Category.QuivCat

/-!

# Construction of the localized category

This file constructs the localized category, obtained by formally inverting
a class of maps `W : MorphismProperty C` in a category `C`.

We first construct a quiver `LocQuiver W` whose objects are the same as those
of `C` and whose maps are the maps in `C` and placeholders for the formal
inverses of the maps in `W`.

The localized category `W.Localization` is obtained by taking the quotient
of the path category of `LocQuiver W` by the congruence generated by four
types of relations.

The obvious functor `Q W : C ⥤ W.Localization` satisfies the universal property
of the localization. Indeed, if `G : C ⥤ D` sends morphisms in `W` to isomorphisms
in `D` (i.e. we have `hG : W.IsInvertedBy G`), then there exists a unique functor
`G' : W.Localization ⥤ D` such that `Q W ≫ G' = G`. This `G'` is `lift G hG`.
The expected property of `lift G hG` if expressed by the lemma `fac` and the
uniqueness is expressed by `uniq`.

## References

* [P. Gabriel, M. Zisman, *Calculus of fractions and homotopy theory*][gabriel-zisman-1967]

-/

noncomputable section

open CategoryTheory.Category

namespace CategoryTheory

variable {C : Type _} [Category C] (W : MorphismProperty C) {D : Type _} [Category D]

namespace Localization

namespace Construction

-- porting note: removed @[nolint has_nonempty_instance]
/-- If `W : MorphismProperty C`, `LocQuiver W` is a quiver with the same objects
as `C`, and whose morphisms are those in `C` and placeholders for formal
inverses of the morphisms in `W`. -/
structure LocQuiver (W : MorphismProperty C) where
  /-- underlying object -/
  obj : C
#align category_theory.localization.construction.loc_quiver CategoryTheory.Localization.Construction.LocQuiver

instance : Quiver (LocQuiver W) where Hom A B := Sum (A.obj ⟶ B.obj) { f : B.obj ⟶ A.obj // W f }

/-- The object in the path category of `LocQuiver W` attached to an object in
the category `C` -/
def ιPaths (X : C) : Paths (LocQuiver W) :=
  ⟨X⟩
#align category_theory.localization.construction.ι_paths CategoryTheory.Localization.Construction.ιPaths

/-- The morphism in the path category associated to a morphism in the original category. -/
@[simp]
def ψ₁ {X Y : C} (f : X ⟶ Y) : ιPaths W X ⟶ ιPaths W Y :=
  Paths.of.map (Sum.inl f)
#align category_theory.localization.construction.ψ₁ CategoryTheory.Localization.Construction.ψ₁

/-- The morphism in the path category corresponding to a formal inverse. -/
@[simp]
def ψ₂ {X Y : C} (w : X ⟶ Y) (hw : W w) : ιPaths W Y ⟶ ιPaths W X :=
  Paths.of.map (Sum.inr ⟨w, hw⟩)
#align category_theory.localization.construction.ψ₂ CategoryTheory.Localization.Construction.ψ₂

/-- The relations by which we take the quotient in order to get the localized category. -/
inductive relations : HomRel (Paths (LocQuiver W))
  | id (X : C) : relations (ψ₁ W (𝟙 X)) (𝟙 _)
  | comp {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) : relations (ψ₁ W (f ≫ g)) (ψ₁ W f ≫ ψ₁ W g)
  | Winv₁ {X Y : C} (w : X ⟶ Y) (hw : W w) : relations (ψ₁ W w ≫ ψ₂ W w hw) (𝟙 _)
  | Winv₂ {X Y : C} (w : X ⟶ Y) (hw : W w) : relations (ψ₂ W w hw ≫ ψ₁ W w) (𝟙 _)
#align category_theory.localization.construction.relations CategoryTheory.Localization.Construction.relations

end Construction

end Localization

namespace MorphismProperty

open Localization.Construction

-- porting note: removed @[nolint has_nonempty_instance]
/-- The localized category obtained by formally inverting the morphisms
in `W : MorphismProperty C` -/
def Localization :=
  CategoryTheory.Quotient (Localization.Construction.relations W)
#align category_theory.morphism_property.localization CategoryTheory.MorphismProperty.Localization

instance : Category (Localization W) := by
  dsimp only [Localization]
  infer_instance

/-- The obvious functor `C ⥤ W.Localization` -/
def Q : C ⥤ W.Localization
    where
  obj X := (Quotient.functor _).obj (Paths.of.obj ⟨X⟩)
  map f := (Quotient.functor _).map (ψ₁ W f)
  map_id X := Quotient.sound _ (relations.id X)
  map_comp f g := Quotient.sound _ (relations.comp f g)
set_option linter.uppercaseLean3 false in
#align category_theory.morphism_property.Q CategoryTheory.MorphismProperty.Q

end MorphismProperty

namespace Localization

namespace Construction

variable {W}
/-- The isomorphism in `W.Localization` associated to a morphism `w` in W -/
def wIso {X Y : C} (w : X ⟶ Y) (hw : W w) : Iso (W.Q.obj X) (W.Q.obj Y)
    where
  hom := W.Q.map w
  inv := (Quotient.functor _).map (by dsimp; exact Paths.of.map (Sum.inr ⟨w, hw⟩))
  hom_inv_id := Quotient.sound _ (relations.Winv₁ w hw)
  inv_hom_id := Quotient.sound _ (relations.Winv₂ w hw)
set_option linter.uppercaseLean3 false in
#align category_theory.localization.construction.Wiso CategoryTheory.Localization.Construction.wIso

/-- The formal inverse in `W.Localization` of a morphism `w` in `W`. -/
abbrev winv {X Y : C} (w : X ⟶ Y) (hw : W w) :=
  (wIso w hw).inv
set_option linter.uppercaseLean3 false in
#align category_theory.localization.construction.Winv CategoryTheory.Localization.Construction.winv

variable (W)

theorem _root_.CategoryTheory.MorphismProperty.Q_inverts : W.IsInvertedBy W.Q := fun _ _ w hw =>
  IsIso.of_iso (Localization.Construction.wIso w hw)
set_option linter.uppercaseLean3 false in
#align category_theory.morphism_property.Q_inverts CategoryTheory.MorphismProperty.Q_inverts

variable {W} (G : C ⥤ D) (hG : W.IsInvertedBy G)

/-- The lifting of a functor to the path category of `LocQuiver W` -/
@[simps!]
def liftToPathCategory : Paths (LocQuiver W) ⥤ D :=
  QuivCat.lift
    { obj := fun X => G.obj X.obj
      map := by
        intros X Y
        rintro (f | ⟨g, hg⟩)
        . exact G.map f
        . haveI := hG g hg
          exact inv (G.map g) }
#align category_theory.localization.construction.lift_to_path_category CategoryTheory.Localization.Construction.liftToPathCategory

/-- The lifting of a functor `C ⥤ D` inverting `W` as a functor `W.Localization ⥤ D` -/
@[simps!]
def lift : W.Localization ⥤ D :=
  Quotient.lift (relations W) (liftToPathCategory G hG)
    (by
      rintro ⟨X⟩ ⟨Y⟩ f₁ f₂ r
      --Porting note: rest of proof was `rcases r with ⟨⟩; tidy`
      rcases r with (_|_|⟨f,hf⟩|⟨f,hf⟩)
      . aesop_cat
      . aesop_cat
      all_goals
        dsimp
        haveI := hG f hf
        simp
        rfl)
#align category_theory.localization.construction.lift CategoryTheory.Localization.Construction.lift

@[simp]
theorem fac : W.Q ⋙ lift G hG = G :=
  Functor.ext (fun X => rfl)
    (by
      intro X Y f
      simp only [Functor.comp_map, eqToHom_refl, comp_id, id_comp]
      dsimp [MorphismProperty.Q, Quot.liftOn]
      rw [composePath_toPath])
#align category_theory.localization.construction.fac CategoryTheory.Localization.Construction.fac

theorem uniq (G₁ G₂ : W.Localization ⥤ D) (h : W.Q ⋙ G₁ = W.Q ⋙ G₂) : G₁ = G₂ := by
  suffices h' : Quotient.functor _ ⋙ G₁ = Quotient.functor _ ⋙ G₂
  · refine' Functor.ext _ _
    · rintro ⟨⟨X⟩⟩
      apply Functor.congr_obj h
    · rintro ⟨⟨X⟩⟩ ⟨⟨Y⟩⟩ ⟨f⟩
      apply Functor.congr_hom h'
  · refine' Paths.ext_functor _ _
    · ext X
      cases X
      apply Functor.congr_obj h
    · rintro ⟨X⟩ ⟨Y⟩ (f | ⟨w, hw⟩)
      · simpa only using Functor.congr_hom h f
      · have hw : W.Q.map w = (wIso w hw).hom := rfl
        have hw' := Functor.congr_hom h w
        simp only [Functor.comp_map, hw] at hw'
        refine' Functor.congr_inv_of_congr_hom _ _ _ _ _ hw'
        all_goals apply Functor.congr_obj h
#align category_theory.localization.construction.uniq CategoryTheory.Localization.Construction.uniq

variable (W)

/-- The canonical bijection between objects in a category and its
localization with respect to a morphism_property `W` -/
@[simps]
def objEquiv : C ≃ W.Localization where
  toFun := W.Q.obj
  invFun X := X.as.obj
  left_inv X := rfl
  right_inv := by
    rintro ⟨⟨X⟩⟩
    rfl
#align category_theory.localization.construction.obj_equiv CategoryTheory.Localization.Construction.objEquiv

variable {W}

/-- A `MorphismProperty` in `W.Localization` is satisfied by all
morphisms in the localized category if it contains the image of the
morphisms in the original category, the inverses of the morphisms
in `W` and if it is stable under composition -/
theorem morphismProperty_is_top (P : MorphismProperty W.Localization)
    (hP₁ : ∀ ⦃X Y : C⦄ (f : X ⟶ Y), P (W.Q.map f))
    (hP₂ : ∀ ⦃X Y : C⦄ (w : X ⟶ Y) (hw : W w), P (winv w hw)) (hP₃ : P.StableUnderComposition) :
    P = ⊤ := by
  funext X Y f
  ext
  constructor
  . intro
    apply MorphismProperty.top_apply
  · intro
    let G : _ ⥤ W.Localization := Quotient.functor _
    haveI : Full G := Quotient.fullFunctor _
    suffices
      ∀ (X₁ X₂ : Paths (LocQuiver W)) (f : X₁ ⟶ X₂), P (G.map f)
      by
      rcases X with ⟨⟨X⟩⟩
      rcases Y with ⟨⟨Y⟩⟩
      simpa only [Functor.image_preimage] using this _ _ (G.preimage f)
    intros X₁ X₂ p
    induction' p with X₂ X₃ p g hp
    · simpa only [Functor.map_id] using hP₁ (𝟙 X₁.obj)
    . let p' : X₁ ⟶X₂ := p
      rw [show p'.cons g = p' ≫ Quiver.Hom.toPath g by rfl, G.map_comp]
      refine' hP₃ _ _ hp _
      rcases g with (g | ⟨g, hg⟩)
      . apply hP₁
      . apply hP₂
#align category_theory.localization.construction.morphism_property_is_top CategoryTheory.Localization.Construction.morphismProperty_is_top

/-- A `MorphismProperty` in `W.Localization` is satisfied by all
morphisms in the localized category if it contains the image of the
morphisms in the original category, if is stable under composition
and if the property is stable by passing to inverses. -/
theorem morphismProperty_is_top' (P : MorphismProperty W.Localization)
    (hP₁ : ∀ ⦃X Y : C⦄ (f : X ⟶ Y), P (W.Q.map f))
    (hP₂ : ∀ ⦃X Y : W.Localization⦄ (e : X ≅ Y) (_ : P e.hom), P e.inv)
    (hP₃ : P.StableUnderComposition) : P = ⊤ :=
  morphismProperty_is_top P hP₁ (fun _ _ w _ => hP₂ _ (hP₁ w)) hP₃
#align category_theory.localization.construction.morphism_property_is_top' CategoryTheory.Localization.Construction.morphismProperty_is_top'

namespace NatTransExtension

variable {F₁ F₂ : W.Localization ⥤ D} (τ : W.Q ⋙ F₁ ⟶ W.Q ⋙ F₂)

/-- If `F₁` and `F₂` are functors `W.Localization ⥤ D` and if we have
`τ : W.Q ⋙ F₁ ⟶ W.Q ⋙ F₂`, we shall define a natural transformation `F₁ ⟶ F₂`.
This is the `app` field of this natural transformation. -/
def app (X : W.Localization) : F₁.obj X ⟶ F₂.obj X :=
  eqToHom (congr_arg F₁.obj ((objEquiv W).right_inv X).symm) ≫
    τ.app ((objEquiv W).invFun X) ≫ eqToHom (congr_arg F₂.obj ((objEquiv W).right_inv X))
#align category_theory.localization.construction.nat_trans_extension.app CategoryTheory.Localization.Construction.NatTransExtension.app

@[simp]

end NatTransExtension

/-- If `F₁` and `F₂` are functors `W.Localization ⥤ D`, a natural transformation `F₁ ⟶ F₂`
can be obtained from a natural transformation `W.Q ⋙ F₁ ⟶ W.Q ⋙ F₂`. -/
@[simps]
def natTransExtension {F₁ F₂ : W.Localization ⥤ D} (τ : W.Q ⋙ F₁ ⟶ W.Q ⋙ F₂) : F₁ ⟶ F₂
    where
  app := NatTransExtension.app τ
  naturality := by
    suffices MorphismProperty.naturalityProperty (NatTransExtension.app τ) = ⊤
      by
      intro X Y f
      simpa only [← this] using MorphismProperty.top_apply f
    refine' morphismProperty_is_top'
      (MorphismProperty.naturalityProperty (NatTransExtension.app τ))
      _ (MorphismProperty.naturalityProperty.stableUnderInverse _)
      (MorphismProperty.naturalityProperty.stableUnderComposition _)
    intros X Y f
    dsimp
    simpa only [NatTransExtension.app_eq] using τ.naturality f
#align category_theory.localization.construction.nat_trans_extension CategoryTheory.Localization.Construction.natTransExtension

@[simp]
theorem natTransExtension_hcomp {F G : W.Localization ⥤ D} (τ : W.Q ⋙ F ⟶ W.Q ⋙ G) :
    𝟙 W.Q ◫ natTransExtension τ = τ := by aesop_cat
#align category_theory.localization.construction.nat_trans_extension_hcomp CategoryTheory.Localization.Construction.natTransExtension_hcomp

theorem natTrans_hcomp_injective {F G : W.Localization ⥤ D} {τ₁ τ₂ : F ⟶ G}
    (h : 𝟙 W.Q ◫ τ₁ = 𝟙 W.Q ◫ τ₂) : τ₁ = τ₂ := by
  ext X
  have eq := (objEquiv W).right_inv X
  simp only [objEquiv] at eq
  rw [← eq, ← NatTrans.id_hcomp_app, ← NatTrans.id_hcomp_app, h]
#align category_theory.localization.construction.nat_trans_hcomp_injective CategoryTheory.Localization.Construction.natTrans_hcomp_injective

variable (W D)

namespace WhiskeringLeftEquivalence

/-- The functor `(W.Localization ⥤ D) ⥤ (W.FunctorsInverting D)` induced by the
composition with `W.Q : C ⥤ W.Localization`. -/
@[simps!]
def functor : (W.Localization ⥤ D) ⥤ W.FunctorsInverting D :=
  FullSubcategory.lift _ ((whiskeringLeft _ _ D).obj W.Q) fun _ =>
    MorphismProperty.IsInvertedBy.of_comp W W.Q W.Q_inverts _
#align category_theory.localization.construction.whiskering_left_equivalence.functor CategoryTheory.Localization.Construction.WhiskeringLeftEquivalence.functor

/-- The function `(W.FunctorsInverting D) ⥤ (W.Localization ⥤ D)` induced by
`Construction.lift`. -/
@[simps!]
def inverse : W.FunctorsInverting D ⥤ W.Localization ⥤ D
    where
  obj G := lift G.obj G.property
  map τ := natTransExtension (eqToHom (by rw [fac]) ≫ τ ≫ eqToHom (by rw [fac]))
  map_id G :=
    natTrans_hcomp_injective
      (by
        rw [natTransExtension_hcomp]
        ext X
        simp only [NatTrans.comp_app, eqToHom_app, eqToHom_refl, comp_id, id_comp,
          NatTrans.hcomp_id_app, NatTrans.id_app, Functor.map_id]
        rfl )
  map_comp τ₁ τ₂ :=
    natTrans_hcomp_injective
      (by
        ext X
        simp only [natTransExtension_hcomp, NatTrans.comp_app, eqToHom_app, eqToHom_refl,
          id_comp, comp_id, NatTrans.hcomp_app, NatTrans.id_app, Functor.map_id,
          natTransExtension_app, NatTransExtension.app_eq]
        rfl)
#align category_theory.localization.construction.whiskering_left_equivalence.inverse CategoryTheory.Localization.Construction.WhiskeringLeftEquivalence.inverse

/-- The unit isomorphism of the equivalence of categories `whiskeringLeftEquivalence W D`. -/
@[simps!]
def unitIso : 𝟭 (W.Localization ⥤ D) ≅ functor W D ⋙ inverse W D :=
  eqToIso
    (by
      refine' Functor.ext (fun G => _) fun G₁ G₂ τ => _
      · apply uniq
        dsimp [Functor]
        erw [fac]
        rfl
      · apply natTrans_hcomp_injective
        ext X
        simp)
#align category_theory.localization.construction.whiskering_left_equivalence.unit_iso CategoryTheory.Localization.Construction.WhiskeringLeftEquivalence.unitIso

/-- The counit isomorphism of the equivalence of categories `WhiskeringLeftEquivalence W D`. -/
@[simps!]
def counitIso : inverse W D ⋙ functor W D ≅ 𝟭 (W.FunctorsInverting D) :=
  eqToIso
    (by
      refine' Functor.ext _ _
      · rintro ⟨G, hG⟩
        ext
        exact fac G hG
      · rintro ⟨G₁, hG₁⟩ ⟨G₂, hG₂⟩ f
        apply NatTrans.ext
        ext1
        apply NatTransExtension.app_eq)
#align category_theory.localization.construction.whiskering_left_equivalence.counit_iso CategoryTheory.Localization.Construction.WhiskeringLeftEquivalence.counitIso

end WhiskeringLeftEquivalence

/-- The equivalence of categories `(W.localization ⥤ D) ≌ (W.FunctorsInverting D)`
induced by the composition with `W.Q : C ⥤ W.localization`. -/
def whiskeringLeftEquivalence : W.Localization ⥤ D ≌ W.FunctorsInverting D
    where
  functor := WhiskeringLeftEquivalence.functor W D
  inverse := WhiskeringLeftEquivalence.inverse W D
  unitIso := WhiskeringLeftEquivalence.unitIso W D
  counitIso := WhiskeringLeftEquivalence.counitIso W D
  functor_unitIso_comp F := by
    apply NatTrans.ext
    ext1
    simp only [WhiskeringLeftEquivalence.unitIso_hom, eqToHom_app, eqToHom_refl,
      WhiskeringLeftEquivalence.counitIso_hom, eqToHom_map, eqToHom_trans]
    rfl
#align category_theory.localization.construction.whiskering_left_equivalence CategoryTheory.Localization.Construction.whiskeringLeftEquivalence

end Construction

end Localization

end CategoryTheory


import analysis.real xenalib.M1Fstuff tactic.norm_num

-- real numbers live in here in Lean mathlib
-- NB you need mathlib installed to get this working.
-- of_rat is the injection from the rationals to the reals.

-- This question was absurdly difficult for me
-- because we need to prove that 1/2 isn't an integer ;-)
-- I did it in the end, and called it real_half_not_an_integer
-- I put it in the M1Fstuff library.

-- #check M1F.real_half_not_an_integer

local infix ` ^ ` := monoid.pow

def A : set ℝ := { x | x^2 < 3}
def B : set ℝ := {x | (∃ y : ℤ, x = ↑y) ∧ x^2 < 3}
def C : set ℝ := {x | x^3 < 3}

-- set_option pp.notation false

theorem part_a : ¬ (((1/2):ℝ) ∈ A ∩ B) :=
begin
assume H : ((1/2):ℝ) ∈ A ∩ B,
have H2: ((1/2):ℝ) ∈ B,
exact and.right H,
have H3: ∃ y : ℤ, ((1/2):ℝ) = ↑y,
exact and.left H2,
exact M1F.real_half_not_an_integer H3,
end

-- set_option pp.all true
-- #check @of_rat_mul

--set_option pp.notation false
theorem part_b : of_rat (1/2) ∈ A ∪ B :=
begin
left,
-- this now says
-- of_rat (1 / 2) ^ 2 < (3:real)
-- (after a huge amount of unfolding)
unfold has_mem.mem set.mem A set_of,
have J : (3:real) = of_rat(3),
rw [←coe_rat_eq_of_rat 3],
simp,
rewrite J,clear J,
unfold monoid.pow,
have J : (1:real) = of_rat(1),
  apply of_rat_one,
rewrite J,clear J,
rewrite (@of_rat_mul (1/2) 1),
rewrite (of_rat_mul),
rewrite [←coe_rat_eq_of_rat,←coe_rat_eq_of_rat],
rewrite rat.cast_lt,
exact dec_trivial
end

set_option pp.notation true
-- set_option pp.all true
theorem part_c : ¬ (A ⊆ C) :=
begin
assume H : A ⊆ C,
let x := of_rat (3/2), --  strat is to prove x is in A but not C
have H2 : x ∈ A,
unfold A,
unfold has_mem.mem set.mem set_of has_lt.lt preorder.lt,change x with of_rat (3/2),
unfold partial_order.lt ordered_comm_monoid.lt discrete_linear_ordered_field.lt has_lt.lt,
unfold preorder.lt partial_order.lt lattice.semilattice_inf.lt lattice.lattice.lt,
unfold lattice.distrib_lattice.lt lattice.lattice.lt,
unfold decidable_linear_order.lt decidable_linear_ordered_comm_group.lt,
unfold monoid.pow,
have J : (3:real) = of_rat(3),
rw [←coe_rat_eq_of_rat 3],
simp,
rewrite J,clear J,
have J : (1:real) = of_rat(1),
  apply of_rat_one,
rewrite J,clear J,
rewrite (of_rat_mul),
rewrite (of_rat_mul),
rewrite [←coe_rat_eq_of_rat,←coe_rat_eq_of_rat],
rewrite rat.cast_lt,
simp,
exact dec_trivial,
have H3 : ¬ (x ∈ C),
unfold C,
unfold has_mem.mem set.mem set_of has_lt.lt preorder.lt,change x with of_rat (3/2),
unfold partial_order.lt ordered_comm_monoid.lt discrete_linear_ordered_field.lt has_lt.lt,
unfold preorder.lt partial_order.lt lattice.semilattice_inf.lt lattice.lattice.lt,
unfold lattice.distrib_lattice.lt,
unfold lattice.lattice.lt,
unfold decidable_linear_order.lt decidable_linear_ordered_comm_group.lt,
unfold monoid.pow,
have J : (3:real) = of_rat(3),
rw [←coe_rat_eq_of_rat 3],
simp,
rewrite J,clear J,
have J : (1:real) = of_rat(1),
  apply of_rat_one,
rewrite J,clear J,
rewrite (of_rat_mul),
rewrite (of_rat_mul),
rewrite (of_rat_mul),
simp,
-- apply of_rat_le_of_rat.mpr,
-- exact dec_trivial,

-- now have 3/2 in A not C
-- trivial,
have J : x ∈ C,
exact H H2,
-- contradiction
exact H3 J,
-- simp with real_simps,
-- unfold pow_nat,
-- apply of_rat_lt_of_rat.mpr,
-- simp [M1F.of_rat_inj] with real_simps,
end

-- To do part (d) it's helpful to evaluate B completely.
-- def B : set ℝ := {x | (∃ y : ℤ, x = of_rat y) ∧ x^2 < 3}

-- #check @eq.subst
-- #check rat.coe_int_mul
-- #check rat.coe_int_lt
--  set_option pp.notation false

lemma B_is_minus_one_zero_one (x:ℝ): x ∈ B → (x=((-1):ℝ)) ∨ (x=(0:ℝ)) ∨ (x=(1:ℝ)) :=
begin
assume H : x ∈ B,
have H2 : exists y : ℤ, x = (y:ℝ),
  exact H.left,
have H3 : x^2 < 3,
  exact H.right,
cases H2 with y H4,
unfold monoid.pow at H3,
simp at H3,
have H5 : ((y:ℚ):ℝ) * ((y:ℚ):ℝ) < 3,
  exact (@eq.subst ℝ (λ z, z*z<(3:real)) x (y:ℚ) (by simp [H4]) H3),
rw [←rat.cast_mul] at H5,
have J : (3:real) = (((3:ℤ):ℚ):ℝ),
  simp,
rw [J,rat.cast_lt,←int.cast_mul,int.cast_lt] at H5,
/-
  rw ←coe_rat_eq_of_rat 3,exact
have H6 : of_rat (↑ y * ↑ y) < of_rat 3,
  exact eq.subst J H5,
rewrite of_rat_lt_of_rat at H6,
clear H3 H5 J,
rewrite eq.symm (rat.coe_int_mul y y) at H6,
change (3:rat) with ↑(3:int) at H6,
rewrite rat.coe_int_lt at H6,

-- Situation now:
-- y is an integer, H6 is y*y<3
-- H4 is x=of_rat(y)=y:real,
-- and we want to prove x=-1 or 0 or 1.

-/
have H6 : y*y<3,
  exact H5,
  clear H5,

cases y with y m1my,
  rewrite eq.symm (int.of_nat_mul y y) at H6,
  have H1:y*y < 3,
    exact @int.lt_of_coe_nat_lt_coe_nat (y*y) 3 H6,
  cases y with ys,
    right,left,
    exact H4,
  cases ys with yss,
    right,right,simp [H4],
  have H : 4<3,
  exact calc
  4 = 2*2 : dec_trivial
  ...  ≤  2*(yss+2) : nat.mul_le_mul_left 2 (nat.le_add_left 2 yss)
  ... ≤ (yss+2)*(yss+2) : nat.mul_le_mul_right (yss+2) (nat.le_add_left 2 yss)
  ... < 3 : H1,
  have H2 : ¬ (4<3),
  exact dec_trivial,
  exfalso,
  contradiction,
  cases m1my with y2,
    left,simp [H4],
  exfalso,
  have H1 : int.nat_abs (int.neg_succ_of_nat (nat.succ y2)) = y2+2,
  refl,
  have H2:↑((y2+2)*(y2+2))=(int.neg_succ_of_nat (nat.succ y2))*(int.neg_succ_of_nat (nat.succ y2)),
    apply @int.nat_abs_mul_self (int.neg_succ_of_nat (nat.succ y2)),
  have H3: ↑((y2+2)*(y2+2)) < (↑3:int),
  exact H2 ▸ H6,
  have H5 : (y2+2)*(y2+2) < 3,
  exact @int.lt_of_coe_nat_lt_coe_nat ((y2+2)*(y2+2)) 3 H3,
  have H : 4<3,
  exact calc
  4 = 2*2 : dec_trivial
  ...  ≤  2*(y2+2) : nat.mul_le_mul_left 2 (nat.le_add_left 2 y2)
  ... ≤ (y2+2)*(y2+2) : nat.mul_le_mul_right (y2+2) (nat.le_add_left 2 y2)
  ... < 3 : H5,
  have H2 : ¬ (4<3),
  exact dec_trivial,
  exfalso,
  contradiction,
--  have H3:(y2+2)*(y2+2)<3,
--  simp [H1,H6,int.lt_of_coe_nat_lt_coe_nat,int.nat_abs_mul_self]
end

-- set_option pp.notation false
theorem part_d : B ⊆ C :=  -- B={-1,0,1} so this is true
begin
intro x,
intro H,
have H2 : (x=-1) ∨ (x=0) ∨ (x=1),
exact B_is_minus_one_zero_one x H,
unfold has_mem.mem set.mem C set_of,
cases H2 with xm1 xrest,
-- need to prove of_rat(-1)^3<3
have H2 : ((-1):ℝ)^3 < 3,
unfold monoid.pow,
{norm_num},
-- apply (@eq.subst ℝ (λ x,x^3<3) x (of_rat(-1)) xm1),
exact @eq.subst ℝ (λ t, t^3<3) (-1) x (eq.symm xm1) H2,
cases xrest with x0 x1,
have H2 : of_rat(0)^3 < 3,
unfold monoid.pow,
rw [←coe_rat_eq_of_rat],
{norm_num},
-- apply (@eq.subst ℝ (λ x,x^3<3) x (of_rat(-1)) xm1),
exact @eq.subst ℝ (λ t, t^3<3) (of_rat(0)) x (eq.symm x0) H2,
have H2 : of_rat(1)^3 < 3,
unfold monoid.pow,
rw [←coe_rat_eq_of_rat],
{norm_num},
-- apply (@eq.subst ℝ (λ x,x^3<3) x (of_rat(-1)) xm1),
exact @eq.subst ℝ (λ t, t^3<3) (of_rat(1)) x (eq.symm x1) H2,

-- simp with real_simps,

end

-- To do parts e and f it's useful to note that -2 is in C but not A or B.

lemma two_in_C : (-2:real) ∈ C :=
begin
unfold has_mem.mem set.mem C monoid.pow set_of,
{norm_num},
end

lemma two_not_in_A : (-2:real) ∉ A :=
begin
unfold has_mem.mem set.mem A monoid.pow set_of,
norm_num,
end

lemma two_not_in_B : (-2:real) ∉ B :=
begin
unfold has_mem.mem set.mem B monoid.pow set_of,
norm_num,
end

theorem part_e : ¬ (C ⊆ A ∪ B) := -- not true as C contains -2
begin
let x:=(-2:real),
have HC : x ∈ C,
  exact two_in_C,
have HnA : x ∉ A,
  exact two_not_in_A,
have HnB : x ∉ B,
  exact two_not_in_B,
intro J,
have J2 : x ∈ (A ∪ B),
exact (@J x HC),
cases J2 with HA HB,
contradiction,
contradiction,
end

theorem part_f : ¬ ((A ∩ B) ∪ C = (A ∪ B) ∩ C) :=
begin
let x:=(-2:real),
have HC : x ∈ C,
  exact two_in_C,
have HnA : x ∉ A,
  exact two_not_in_A,
have HnB : x ∉ B,
  exact two_not_in_B,
intro H,
have H1 : x ∈  (A ∩ B ∪ C),
  right,exact HC,
have H2 : x ∈ (A ∪ B) ∩ C,
  exact eq.subst H H1,
have H3 : x ∈ (A ∪ B),
  exact H2.left,
cases H3 with HA HB,
  exact HnA HA,
  exact HnB HB
end


variables (α : Type) (p q : α → Prop)

example : (∀ x, p x ∧ q x) ↔ (∀ x, p x) ∧ (∀ x, q x) := begin
apply iff.intro, {
  intro h,
  constructor, {
    intro x, exact (h x).1
  }, {
    intro x, exact (h x).2
  }
}, {
  intro h, intro x,
  constructor, exact (h.1 x), exact (h.2 x)
}
end

example : (∀ x, p x → q x) → (∀ x, p x) → (∀ x, q x) := begin
intros, exact a x (a_1 x)
end

example : (∀ x, p x) ∨ (∀ x, q x) → ∀ x, p x ∨ q x := begin
intros,
apply or.elim a, {
  intro hp, left, exact (hp x)
}, {
  intro hq, right, exact (hq x)
}
end


import tactic.pure_maths -- hide

/-
# Propositional logic
## Level 2: And introduction

## And introduction

To *prove* $p\land q$ is to prove $p$ and to prove $q$.

In Lean, if `h₁ : p` is a proof of `p` and `h₂ : q` is a proof of `q`, then `and.intro h₁ h₂`
is a proof of `p ∧ q`.
-/

example (p q : Prop) (h₁ : p) (h₂ : q) : p ∧ q :=
begin
  from and.intro h₁ h₂,
end

/-
The `split` tactic is an alternative (backward) proof technique. If the target is to prove `p ∧ q`,
then `split` replaces the goal with two new goals: (1) to prove `p` and (2) to prove `q`.
-/

example (p q : Prop) (h₁ : p) (h₂ : q) : p ∧ q :=
begin
  split,
  { show p, from h₁, }, -- The first goal.
  { show q, from h₂, }, -- The second goal.
end

namespace exlean -- hide
/-
## Tasks

1. Replace `sorry` below with a Lean proof using `and.intro`.
2. Write another Lean proof using `split`.
3. On a piece of paper, state and give a handwritten proof of this result.

**Notation**: Recall that `h₁` is written `h\1`.
-/

/- Tactic : split

The `split` tactic splits a 'compound' target into multiple goals.

### Examples

`split` turns the target `⊢ p ∧ q` into two goals: (1) `⊢ p` and (2)  `⊢ q`.

Equally, if the target is `⊢ p ↔ q`, split creates the goals (1) to prove
`p → q` and (2) to prove `q → p`.
-/

/- Axiom: and.intro (h₁ : p) (h₂ : q) :
p ∧ q
-/

variables (p q r : Prop) -- hide

/- Theorem : no-side-bar
Let $p$, $q$, and $r$ be propositions. Assuming $h_1 : p$, $h_2 : q$, and $h_3 : r$, we have
$h : r \land q$.
-/
theorem and_intro_thm (h₁ : p) (h₂ : q) (h₃ : r) : r ∧ q :=
begin
  split,
  { show r, from h₃, },
  { show q, from h₂, },

end

end exlean -- hide


/-
Give a natural deduction proof of 𝑃 from ¬𝑃→(𝑄∨𝑅), ¬𝑄, and ¬𝑅.
-/

open classical

variables (P Q R: Prop)

variable h: ¬ P → (Q ∨ R)
variable hnQ: ¬ Q
variable hnR: ¬ R

example : P :=
  show P, from by_contradiction(
    assume hnP: ¬ P,
    have hQoR: Q ∨ R, from h(hnP),
    show false, from or.elim(hQoR)(
      assume hQ: Q, hnQ(hQ)
    )(
      assume hR: R, hnR(hR)
    )
  )


import data.real.basic tactic

variables a b : ℝ

#check le_refl
#check le_refl (a * b)
#check add_le_add
#check pow_two_nonneg
#check ring

-- BEGIN
example : 2*a*b ≤ a^2 + b^2 :=
begin
  have h : 0 ≤ a^2 - 2*a*b + b^2,
  calc
    a^2 - 2*a*b + b^2 = (a - b)^2     : by ring
    ... ≥ 0                           : by exact pow_two_nonneg (a-b),
  calc
    2*a*b
        = 2*a*b + 0                   : by ring
    ... ≤ 2*a*b + (a^2 - 2*a*b + b^2) : by exact add_le_add (le_refl (2 * a * b)) h
    ... = a^2 + b^2                   : by ring
end
-- END


import lib.psd float.basic

variables {n m : nat}

def delta (A : matrix (fin n) (fin n) float) (R : matrix (fin m) (fin n) float)
: matrix (fin n) (fin n) float :=
A - (matrix.mul R.transpose R)

open matrix module.End

-- prove that RtR is symmetric.
lemma RTR_symmetric
  (R : matrix (fin m) (fin n) float)
: symmetric (matrix.mul R.transpose R) :=
begin
  intros i j, simp [matrix.mul, dot_product], congr, ext k, exact mul_comm _ _,
end

-- prove that is psd.
lemma RTR_psd
  (R : matrix (fin m) (fin n) float)
: pos_semidef (matrix.mul R.transpose R) (RTR_symmetric R) :=
begin
  intros v, rw [dot_product_transpose v _], exact dot_product_self_nonneg _,
end

-- copy proof of psd -> positive eigens
lemma nonneg_eigenvalues_of_psd
  (M : matrix (fin n) (fin n) float)
  (h : symmetric M)
  (hpsd : pos_semidef M h)
: nonneg_eigenvalues M h :=
begin
  rintros r hre, by_contra hc, rw [has_eigenvalue, submodule.ne_bot_iff] at hre,
  obtain ⟨x, hre, hxnz⟩ := hre, rw [mem_eigenspace_iff] at hre,
  replace hpsd := hpsd x,
  replace hre := congr_arg (λ y, dot_product y x) hre; simp at hre,
  replace hc := lt_of_not_ge hc,
  rw [dot_product_comm] at hpsd,
  suffices hsuff : r * dot_product x x < 0,
  { rw [←hre] at hsuff, exact ((not_le_of_lt hsuff) (ge_iff_le.1 hpsd)), },
  apply mul_neg_of_neg_of_pos hc, rw [hre] at hpsd, exfalso,
  have hdp := dot_product_self_pos_of_nonzero x hxnz,
  have hc' := mul_neg_of_pos_of_neg hdp hc, rw [mul_comm] at hc',
  exact ((not_le_of_gt hc') hpsd),
end

lemma pos_eigenvalue
  (R : matrix (fin m) (fin n) float)
  (a : float)
  (h : has_eigenvalue (mul_vec_lin (matrix.mul R.transpose R)) a)
: a ≥ 0 :=
(nonneg_eigenvalues_of_psd (matrix.mul R.transpose R) (RTR_symmetric R) (RTR_psd R)) a h

-- argue about the difference between eigenvalues (seems hard).


import algebra.ring.basic ring_theory.non_zero_divisors tactic.apply_fun

/-! # IMO 2011 A3, Generalized Version -/

namespace IMOSL
namespace IMO2011A3

open function
open_locale non_zero_divisors

def good {R : Type*} [ring R] (f g : R → R) := ∀ x y : R, g (f (x + y)) = f x + (2 * x + y) * g y

/-- Final solution -/
theorem final_solution {R : Type*} [comm_ring R] (h : (2 : R) ∈ R⁰) {f g : R → R} :
  good f g ↔ ∃ a c : R, (a * (a - 1) = 0 ∧ c * (a - 1) = 0) ∧
    (f = λ x, a * x ^ 2 + c) ∧ g = λ x, a * x :=
begin
  symmetry; simp_rw [mul_sub_one, sub_eq_zero],
  refine ⟨λ h0 x y, _, λ h0, _⟩,

  ---- `←` direction
  { rcases h0 with ⟨a, c, ⟨h0, h1⟩, rfl, rfl⟩,
    simp only []; rw [mul_add, ← mul_assoc, h0, mul_comm a c, h1, add_right_comm,
      add_left_inj, mul_left_comm, ← mul_add, add_mul, ← sq, ← add_assoc, ← add_sq] },

  ---- `→` direction
  { -- First, obtain the polynomial identity for `f` and `g`.
    have h1 : ∀ x y : R, (f x - x * g x) - (f y - y * g y) = 2 * (y * g x - x * g y) :=
      λ x y, by rw [mul_sub, sub_eq_sub_iff_add_eq_add, ← add_sub_assoc, add_comm _ (f y),
        ← add_sub_right_comm, sub_eq_sub_iff_add_eq_add, ← mul_assoc, add_assoc,
        ← add_mul, ← h0, ← mul_assoc, add_assoc, ← add_mul, ← h0, add_comm],
    obtain ⟨a, b, rfl⟩ : ∃ a b : R, g = λ x, a * x + b :=
    begin
      refine ⟨g 1 - g 0, g 0, funext (λ x, _)⟩,
      have h2 := congr_arg2 has_add.add (h1 0 x) (h1 x 1),
      simp_rw [sub_add_sub_cancel, h1, zero_mul, one_mul, sub_zero] at h2,
      rwa [← mul_add, mul_cancel_left_mem_non_zero_divisor h, add_sub_left_comm, ← neg_sub,
        ← sub_eq_add_neg, ← mul_sub, eq_sub_iff_add_eq, eq_comm, add_comm, mul_comm] at h2
    end,

    replace h1 : ∃ c : R, f = λ x, a * x ^ 2 - b * x + c :=
    begin
      refine ⟨f 0, funext (λ x, _)⟩,
      replace h1 := h1 x 0,
      simp_rw [zero_mul, mul_zero, zero_add, sub_zero, zero_sub, sub_sub, sub_eq_iff_eq_add] at h1,
      rw [h1, ← add_assoc, add_left_inj, mul_add, add_left_comm, two_mul,
        neg_add_cancel_comm, sub_eq_add_neg, mul_left_comm, sq, mul_comm b]
    end,
    rcases h1 with ⟨c, rfl⟩,

    ---- Now solve for the relations between `a`, `b`, and `c`.
    refine ⟨a, c, _⟩,
    replace h0 := λ x, h0 x (-(2 * x)),
    simp_rw [add_neg_self, zero_mul, add_zero, two_mul, neg_add, add_neg_cancel_left,
      neg_sq, mul_neg, sub_neg_eq_add, mul_add a _ c, add_assoc] at h0,
    have h1 := h0 0; simp only [sq, mul_zero, sub_zero, zero_add] at h1,
    simp_rw [h1, add_left_inj, mul_add, ← mul_assoc] at h0,
    have h2 := h0 1; simp_rw [one_pow, mul_one] at h2,
    replace h0 := h0 (-1); simp_rw [neg_sq, one_pow, mul_neg_one, mul_one] at h0,
    replace h0 := congr_arg2 has_add.add h2 h0,
    rw [sub_neg_eq_add, sub_add_add_cancel, ← sub_eq_add_neg, add_add_sub_cancel,
        ← two_mul, ← two_mul, mul_cancel_left_mem_non_zero_divisor h] at h0,
    suffices : b = 0,
    { subst this; rw add_zero at h1,
      simp_rw [mul_comm c, add_zero, zero_mul, sub_zero],
      exact ⟨⟨h0, h1⟩, rfl, rfl⟩ },
    rw [h0, eq_sub_iff_add_eq, add_assoc, add_right_eq_self] at h2,
    apply_fun has_mul.mul a at h1,
    rw [mul_add, ← mul_assoc, h0, add_right_eq_self] at h1,
    rwa [h1, zero_add] at h2 }
end

/-- Final solution when R is an integral domain -/
theorem final_solution_domain {R : Type*} [comm_ring R] [is_domain R] (h : (2 : R) ∈ R⁰)
  {f g : R → R} : good f g ↔ (f = 0 ∧ g = 0) ∨ ((∃ c : R, f = λ x, x ^ 2 + c) ∧ g = λ x, x) :=
begin
  simp_rw [final_solution h, mul_eq_zero, sub_eq_zero, ← and_or_distrib_right],
  refine ⟨λ h0, _, λ h0, _⟩,
  { rcases h0 with ⟨a, c, ⟨rfl, rfl⟩ | rfl, rfl, rfl⟩,
    left; simp_rw [zero_mul, add_zero],
    exact ⟨rfl, funext zero_mul⟩,
    right; exact ⟨⟨c, by simp_rw one_mul⟩, funext one_mul⟩ },
  { rcases h0 with ⟨rfl, rfl⟩ | ⟨⟨c, rfl⟩, rfl⟩,
    refine ⟨0, 0, or.inl ⟨rfl, rfl⟩, _, funext (λ x, (zero_mul x).symm)⟩,
    simp_rw [zero_mul, add_zero, pi.zero_def],
    exact ⟨1, c, or.inr rfl, by simp_rw one_mul, funext (λ x, (one_mul x).symm)⟩ }
end

end IMO2011A3
end IMOSL