/-
Copyright (c) 2020 Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot
-/
import topology.uniform_space.separation
import topology.uniform_space.uniform_convergence
/-!
# Compact separated uniform spaces

## Main statements

* `compact_space_uniformity`: On a separated compact uniform space, the topology determines the
  uniform structure, entourages are exactly the neighborhoods of the diagonal.
* `uniform_space_of_compact_t2`: every compact T2 topological structure is induced by a uniform
  structure. This uniform structure is described in the previous item.
* Heine-Cantor theorem: continuous functions on compact separated uniform spaces with values in
  uniform spaces are automatically uniformly continuous. There are several variations, the main one
  is `compact_space.uniform_continuous_of_continuous`.

## Implementation notes

The construction `uniform_space_of_compact_t2` is not declared as an instance, as it would badly
loop.

## tags

uniform space, uniform continuity, compact space
-/

open_locale classical uniformity topological_space filter
open filter uniform_space set

variables {α β γ : Type*} [uniform_space α] [uniform_space β]

/-!
### Uniformity on compact separated spaces
-/

/-- On a separated compact uniform space, the topology determines the uniform structure, entourages
are exactly the neighborhoods of the diagonal. -/
lemma compact_space_uniformity [compact_space α] [separated_space α] : 𝓤 α = ⨆ x : α, 𝓝 (x, x) :=
begin
  symmetry, refine le_antisymm supr_nhds_le_uniformity _,
  by_contra H,
  obtain ⟨V, hV, h⟩ : ∃ V : set (α × α), (∀ x : α, V ∈ 𝓝 (x, x)) ∧ 𝓤 α ⊓ 𝓟 Vᶜ ≠ ⊥,
  { simpa [le_iff_forall_inf_principal_compl] using H },
  let F := 𝓤 α ⊓ 𝓟 Vᶜ,
  haveI : ne_bot F := ⟨h⟩,
  obtain ⟨⟨x, y⟩, hx⟩ : ∃ (p : α × α), cluster_pt p F :=
    cluster_point_of_compact F,
  have : cluster_pt (x, y) (𝓤 α) :=
    hx.of_inf_left,
  have hxy : x = y := eq_of_uniformity_inf_nhds this,
  subst hxy,
  have : cluster_pt (x, x) (𝓟 Vᶜ) :=
   hx.of_inf_right,
  have : (x, x) ∉ interior V,
  { have : (x, x) ∈ closure Vᶜ, by rwa mem_closure_iff_cluster_pt,
    rwa closure_compl at this },
  have : (x, x) ∈ interior V,
  { rw mem_interior_iff_mem_nhds,
    exact hV x },
  contradiction
end

lemma unique_uniformity_of_compact_t2 [t : topological_space γ] [compact_space γ]
[t2_space γ] {u u' : uniform_space γ}
(h : u.to_topological_space = t) (h' : u'.to_topological_space = t) : u = u' :=
begin
  apply uniform_space_eq,
  change uniformity _ = uniformity _,
  haveI : @compact_space γ u.to_topological_space, { rw h ; assumption },
  haveI : @compact_space γ u'.to_topological_space, { rw h' ; assumption },
  haveI : @separated_space γ u, { rwa [separated_iff_t2, h] },
  haveI : @separated_space γ u', { rwa [separated_iff_t2, h'] },
  rw [compact_space_uniformity, compact_space_uniformity, h, h']
end

/-- The unique uniform structure inducing a given compact Hausdorff topological structure. -/
def uniform_space_of_compact_t2 [topological_space γ] [compact_space γ] [t2_space γ] :
  uniform_space γ :=
{ uniformity := ⨆ x, 𝓝 (x, x),
  refl := begin
    simp_rw [filter.principal_le_iff, mem_supr],
    rintros V V_in ⟨x, _⟩ ⟨⟩,
    exact mem_of_mem_nhds (V_in x),
  end,
  symm := begin
    refine le_of_eq _,
    rw map_supr,
    congr' with x : 1,
    erw [nhds_prod_eq, ← prod_comm],
  end,
  comp := begin
    /-
    This is the difficult part of the proof. We need to prove that, for each neighborhood W
    of the diagonal Δ, W ○ W is still a neighborhood of the diagonal.
    -/
    set 𝓝Δ := ⨆ x : γ, 𝓝 (x, x), -- The filter of neighborhoods of Δ
    set F := 𝓝Δ.lift' (λ (s : set (γ × γ)), s ○ s), -- Compositions of neighborhoods of Δ
    -- If this weren't true, then there would be V ∈ 𝓝Δ such that F ⊓ 𝓟 Vᶜ ≠ ⊥
    rw le_iff_forall_inf_principal_compl,
    intros V V_in,
    by_contra H,
    haveI : ne_bot (F ⊓ 𝓟 Vᶜ) := ⟨H⟩,
    -- Hence compactness would give us a cluster point (x, y) for F ⊓ 𝓟 Vᶜ
    obtain ⟨⟨x, y⟩, hxy⟩ : ∃ (p : γ × γ), cluster_pt p (F ⊓ 𝓟 Vᶜ) := cluster_point_of_compact _,
    -- In particular (x, y) is a cluster point of 𝓟 Vᶜ, hence is not in the interior of V,
    -- and a fortiori not in Δ, so x ≠ y
    have clV : cluster_pt (x, y) (𝓟 $ Vᶜ) := hxy.of_inf_right,
    have : (x, y) ∉ interior V,
    { have : (x, y) ∈ closure (Vᶜ), by rwa mem_closure_iff_cluster_pt,
      rwa closure_compl at this },
    have diag_subset : diagonal γ ⊆ interior V,
    { rw subset_interior_iff_nhds,
      rintros ⟨x, x⟩ ⟨⟩,
      exact (mem_supr.mp V_in : _) x },
    have x_ne_y : x ≠ y,
    { intro h,
      apply this,
      apply diag_subset,
      simp [h] },
    -- Since γ is compact and Hausdorff, it is normal, hence regular.
    haveI : normal_space γ := normal_of_compact_t2,
    -- So there are closed neighboords V₁ and V₂ of x and y contained in disjoint open neighborhoods
    -- U₁ and U₂.
    obtain
      ⟨U₁, V₁, U₁_in, V₁_in, U₂, V₂, U₂_in₂, V₂_in, V₁_cl, V₂_cl, U₁_op, U₂_op, VU₁, VU₂, hU₁₂⟩ :
        ∃ (U₁ V₁ ∈ 𝓝 x) (U₂ V₂ ∈ 𝓝 y),
          is_closed V₁ ∧ is_closed V₂ ∧ is_open U₁ ∧ is_open U₂ ∧ V₁ ⊆ U₁ ∧ V₂ ⊆ U₂ ∧ U₁ ∩ U₂ = ∅ :=
       disjoint_nested_nhds x_ne_y,
    -- We set U₃ := (V₁ ∪ V₂)ᶜ so that W := (U₁.prod U₁) ∪ (U₂.prod U₂) ∪ (U₃.prod U₃) is an open
    -- neighborhood of Δ.
    let U₃ := (V₁ ∪ V₂)ᶜ,
    have U₃_op : is_open U₃ :=
      is_open_compl_iff.mpr (is_closed.union V₁_cl V₂_cl),
    let W := (U₁.prod U₁) ∪ (U₂.prod U₂) ∪ (U₃.prod U₃),
    have W_in : W ∈ 𝓝Δ,
    { rw mem_supr,
      intros x,
      apply is_open.mem_nhds (is_open.union (is_open.union _ _) _),
      { by_cases hx : x ∈ V₁ ∪ V₂,
        { left,
          cases hx with hx hx ; [left, right] ; split ; tauto },
        { right,
          rw mem_prod,
          tauto }, },
      all_goals { simp only [is_open.prod, *] } },
    -- So W ○ W ∈ F by definition of F
    have : W ○ W ∈ F, by simpa only using mem_lift' W_in,
    -- And V₁.prod V₂ ∈ 𝓝 (x, y)
    have hV₁₂ : V₁.prod V₂ ∈ 𝓝 (x, y) := prod_is_open.mem_nhds V₁_in V₂_in,
    -- But (x, y) is also a cluster point of F so (V₁.prod V₂) ∩ (W ○ W) ≠ ∅
    have clF : cluster_pt (x, y) F := hxy.of_inf_left,
    obtain ⟨p, p_in⟩ : ∃ p, p ∈ (V₁.prod V₂) ∩ (W ○ W) :=
      cluster_pt_iff.mp clF hV₁₂ this,
    -- However the construction of W implies (V₁.prod V₂) ∩ (W ○ W) = ∅.
    -- Indeed assume for contradiction there is some (u, v) in the intersection.
    -- So u ∈ V₁, v ∈ V₂, and there exists some w such that (u, w) ∈ W and (w ,v) ∈ W.
    -- Because u is in V₁ which is disjoint from U₂ and U₃, (u, w) ∈ W forces (u, w) ∈ U₁.prod U₁.
    -- Similarly, because v ∈ V₂, (w ,v) ∈ W forces (w, v) ∈ U₂.prod U₂.
    -- Hence w ∈ U₁ ∩ U₂ which is empty.
    have inter_empty : (V₁.prod V₂) ∩ (W ○ W) = ∅,
    { rw eq_empty_iff_forall_not_mem,
      rintros ⟨u, v⟩ ⟨⟨u_in, v_in⟩, w, huw, hwv⟩,
      have uw_in : (u, w) ∈ U₁.prod U₁ :=
        set.mem_prod.2 ((huw.resolve_right (λ h, (h.1 $ or.inl u_in))).resolve_right
        (λ h, have u ∈ U₁ ∩ U₂, from ⟨VU₁ u_in, h.1⟩, by rwa hU₁₂ at this)),
      have wv_in : (w, v) ∈ U₂.prod U₂ :=
        set.mem_prod.2 ((hwv.resolve_right (λ h, (h.2 $ or.inr v_in))).resolve_left
        (λ h, have v ∈ U₁ ∩ U₂, from ⟨h.2, VU₂ v_in⟩, by rwa hU₁₂ at this)),
      have : w ∈ U₁ ∩ U₂ := ⟨uw_in.2, wv_in.1⟩,
      rwa hU₁₂ at this },
    -- So we have a contradiction
    rwa inter_empty at p_in,
  end,
  is_open_uniformity := begin
    -- Here we need to prove the topology induced by the constructed uniformity is the
    -- topology we started with.
    suffices : ∀ x : γ, filter.comap (prod.mk x) (⨆ y, 𝓝 (y ,y)) = 𝓝 x,
    { intros s,
      change is_open s ↔ _,
      simp_rw [is_open_iff_mem_nhds, nhds_eq_comap_uniformity_aux, this] },
    intros x,
    simp_rw [comap_supr, nhds_prod_eq, comap_prod,
             show prod.fst ∘ prod.mk x = λ y : γ, x, by ext ; simp,
             show prod.snd ∘ (prod.mk x) = (id : γ → γ), by ext ; refl, comap_id],
    rw [supr_split_single _ x, comap_const_of_mem (λ V, mem_of_mem_nhds)],
    suffices : ∀ y ≠ x, comap (λ (y : γ), x) (𝓝 y) ⊓ 𝓝 y ≤ 𝓝 x,
      by simpa,
    intros y hxy,
    simp [comap_const_of_not_mem (compl_singleton_mem_nhds hxy) (by simp)],
  end }

/-!
### Heine-Cantor theorem
-/

/-- Heine-Cantor: a continuous function on a compact separated uniform space is uniformly
continuous. -/
lemma compact_space.uniform_continuous_of_continuous [compact_space α] [separated_space α]
  {f : α → β} (h : continuous f) : uniform_continuous f :=
calc
map (prod.map f f) (𝓤 α) = map (prod.map f f) (⨆ x, 𝓝 (x, x))  : by rw compact_space_uniformity
                     ... =  ⨆ x, map (prod.map f f) (𝓝 (x, x)) : by rw map_supr
                     ... ≤ ⨆ x, 𝓝 (f x, f x)     : supr_le_supr (λ x, (h.prod_map h).continuous_at)
                     ... ≤ ⨆ y, 𝓝 (y, y)         : supr_comp_le (λ y, 𝓝 (y, y)) f
                     ... ≤ 𝓤 β                   : supr_nhds_le_uniformity

/-- Heine-Cantor: a continuous function on a compact separated set of a uniform space is
uniformly continuous. -/
lemma is_compact.uniform_continuous_on_of_continuous' {s : set α} {f : α → β}
  (hs : is_compact s) (hs' : is_separated s) (hf : continuous_on f s) : uniform_continuous_on f s :=
begin
  rw uniform_continuous_on_iff_restrict,
  rw is_separated_iff_induced at hs',
  rw is_compact_iff_compact_space at hs,
  rw continuous_on_iff_continuous_restrict at hf,
  resetI,
  exact compact_space.uniform_continuous_of_continuous hf,
end

/-- Heine-Cantor: a continuous function on a compact set of a separated uniform space
is uniformly continuous. -/
lemma is_compact.uniform_continuous_on_of_continuous [separated_space α] {s : set α} {f : α → β}
  (hs : is_compact s) (hf : continuous_on f s) : uniform_continuous_on f s :=
hs.uniform_continuous_on_of_continuous' (is_separated_of_separated_space s) hf

/-- A family of functions `α → β → γ` tends uniformly to its value at `x` if `α` is locally compact,
`β` is compact and separated and `f` is continuous on `U × (univ : set β)` for some separated
neighborhood `U` of `x`. -/
lemma continuous_on.tendsto_uniformly [locally_compact_space α] [compact_space β]
  [separated_space β] [uniform_space γ] {f : α → β → γ} {x : α} {U : set α}
  (hxU : U ∈ 𝓝 x) (hU : is_separated U) (h : continuous_on ↿f (U.prod univ)) :
  tendsto_uniformly f (f x) (𝓝 x) :=
begin
  rcases locally_compact_space.local_compact_nhds _ _ hxU with ⟨K, hxK, hKU, hK⟩,
  have : uniform_continuous_on ↿f (K.prod univ),
  { refine is_compact.uniform_continuous_on_of_continuous' (hK.prod compact_univ) _
      (h.mono $ prod_mono hKU subset.rfl),
    exact (hU.mono hKU).prod (is_separated_of_separated_space _) },
  exact this.tendsto_uniformly hxK
end

/-- A continuous family of functions `α → β → γ` tends uniformly to its value at `x` if `α` is
locally compact and `β` is compact and separated. -/
lemma continuous.tendsto_uniformly [separated_space α] [locally_compact_space α]
  [compact_space β] [separated_space β] [uniform_space γ]
  (f : α → β → γ) (h : continuous ↿f) (x : α) : tendsto_uniformly f (f x) (𝓝 x) :=
h.continuous_on.tendsto_uniformly univ_mem $ is_separated_of_separated_space _


/-
Copyright (c) 2019 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import Init.Data.Nat.Basic
import Init.Data.Nat.Div
import Init.Coe

namespace Nat

theorem bitwise_rec_lemma {n : Nat} (hNe : n ≠ 0) : n / 2 < n :=
  Nat.div_lt_self (Nat.zero_lt_of_ne_zero hNe) (Nat.lt_succ_self _)

def bitwise (f : Bool → Bool → Bool) (n m : Nat) : Nat :=
  if n = 0 then
    if f false true then m else 0
  else if m = 0 then
    if f true false then n else 0
  else
    let n' := n / 2
    let m' := m / 2
    let b₁ := n % 2 = 1
    let b₂ := m % 2 = 1
    let r  := bitwise f n' m'
    if f b₁ b₂ then
      r+r+1
    else
      r+r
decreasing_by apply bitwise_rec_lemma; assumption

@[extern "lean_nat_land"]
def land : @& Nat → @& Nat → Nat := bitwise and
@[extern "lean_nat_lor"]
def lor  : @& Nat → @& Nat → Nat := bitwise or
@[extern "lean_nat_lxor"]
def xor  : @& Nat → @& Nat → Nat := bitwise bne
@[extern "lean_nat_shiftl"]
def shiftLeft : @& Nat → @& Nat → Nat
  | n, 0 => n
  | n, succ m => shiftLeft (2*n) m
@[extern "lean_nat_shiftr"]
def shiftRight : @& Nat → @& Nat → Nat
  | n, 0 => n
  | n, succ m => shiftRight n m / 2

instance : AndOp Nat := ⟨Nat.land⟩
instance : OrOp Nat := ⟨Nat.lor⟩
instance : Xor Nat := ⟨Nat.xor⟩
instance : ShiftLeft Nat := ⟨Nat.shiftLeft⟩
instance : ShiftRight Nat := ⟨Nat.shiftRight⟩

end Nat


import data.set.basic -- hide

import kb_defs -- hide

namespace xena -- hide

open_locale classical -- hide

variable X : Type -- we will think of X as a set here

/-
# Chapter 1 : Sets

## Level 1 : Introduction to sets.

This chapter assumes you are familiar with the following tactics:
`rw`, `intro`, `apply`, `exact`, `cases`, `split`, `use`, `left`, `right` and `exfalso`.

(TODO (kmb) : check this list is exhaustive)
(We might need to add `ring`)

If you are not, try playing Function World and Proposition World of the Natural Number Game.

## Sets in Lean

In this world, there will be an ambient "big" set `X` (actually `X` will be a type),
and we will consider subsets of `X`. The type of subsets of `X` is called `set X`.
So if you see `A : set X` it means that `A` is a subset of `X`.

## subsets (⊆) and `subset_iff`

If `A B : set X` (i.e. `A` and `B` are subsets of `X`), then `A ⊆ B` is a
Proposition, i.e. a true/false statement. Lean knows the following fact:

```
subset_iff : A ⊆ B ↔ ∀ x : X, x ∈ A → x ∈ B
```

Let's see if you can prove `A ⊆ A` by rewriting `subset_iff`.
-/

/- Axiom : subset_iff :
A ⊆ B ↔ ∀ x : X, x ∈ A → x ∈ B
-/

/- Hint : Tactic tip
The `assumption` tactic will close a goal if it is equal to one of your
hypotheses. It's actually longer to type than `exact hx`, but it's easier to
use because you don't have to bother remembering what you called `hx`.

-/
/- Hint : Stuck? Here's a hint.
To make progress with a goal of form `∀ a : X, ...`, introduce a term of type `X` by using a familiar tactic.

In this example, using

`intro a,`

will introduce an arbitrary term of type `X`.

Note that this is the tactic we use to assume a hypothesis (when proving an implication), or to choose an arbitrary element of some domain (when defining a function).

Use the same tactic to introduce an appropriately named hypothesis for an implication, and close the goal with the `exact` tactic.
-/

/-
If you get stuck, you can click on the hints for more details!
-/

/- Lemma
If $A$ is a set of elements of type X, then $A \subseteq A$.
-/
lemma subset.refl (A : set X) : A ⊆ A :=
begin
  rw subset_iff,
  intros x h,
  exact h

end

end xena --hide


/-
Copyright (c) 2019 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Patrick Massot, Casper Putz, Anne Baanen
-/
import linear_algebra.matrix.determinant
import tactic.fin_cases

/-!
# Block matrices and their determinant

This file defines a predicate `matrix.block_triangular_matrix` saying a matrix
is block triangular, and proves the value of the determinant for various
matrices built out of blocks.

## Main definitions

 * `matrix.block_triangular_matrix` expresses that a `o` by `o` matrix is block triangular,
   if the rows and columns are ordered according to some order `b : o → ℕ`

## Main results
  * `det_of_block_triangular_matrix`: the determinant of a block triangular matrix
    is equal to the product of the determinants of all the blocks
  * `det_of_upper_triangular` and `det_of_lower_triangular`: the determinant of
    a triangular matrix is the product of the entries along the diagonal

## Tags

matrix, diagonal, det, block triangular

-/

open_locale big_operators

universes v

variables {m n : Type*} [decidable_eq n] [fintype n] [decidable_eq m] [fintype m]
variables {R : Type v} [comm_ring R]

namespace matrix

lemma det_to_block (M : matrix m m R) (p : m → Prop) [decidable_pred p] :
  M.det = (matrix.from_blocks (to_block M p p) (to_block M p (λ j, ¬p j))
    (to_block M (λ j, ¬p j) p) (to_block M (λ j, ¬p j) (λ j, ¬p j))).det :=
begin
  rw ← matrix.det_reindex_self (equiv.sum_compl p).symm M,
  rw [det_apply', det_apply'],
  congr, ext σ, congr, ext,
  generalize hy : σ x = y,
  cases x; cases y;
  simp only [matrix.reindex_apply, to_block_apply, equiv.symm_symm,
    equiv.sum_compl_apply_inr, equiv.sum_compl_apply_inl,
    from_blocks_apply₁₁, from_blocks_apply₁₂, from_blocks_apply₂₁, from_blocks_apply₂₂,
    matrix.minor_apply],
end

lemma det_to_square_block (M : matrix m m R) {n : nat} (b : m → fin n) (k : fin n) :
  (to_square_block M b k).det = (to_square_block_prop M (λ i, b i = k)).det :=
by simp

lemma det_to_square_block' (M : matrix m m R) (b : m → ℕ) (k : ℕ) :
  (to_square_block' M b k).det = (to_square_block_prop M (λ i, b i = k)).det :=
by simp

lemma two_block_triangular_det (M : matrix m m R) (p : m → Prop) [decidable_pred p]
  (h : ∀ i (h1 : ¬p i) j (h2 : p j), M i j = 0) :
  M.det = (to_square_block_prop M p).det * (to_square_block_prop M (λ i, ¬p i)).det :=
begin
  rw det_to_block M p,
  convert upper_two_block_triangular_det (to_block M p p) (to_block M p (λ j, ¬p j))
    (to_block M (λ j, ¬p j) (λ j, ¬p j)),
  ext,
  exact h ↑i i.2 ↑j j.2
end

lemma equiv_block_det (M : matrix m m R) {p q : m → Prop} [decidable_pred p] [decidable_pred q]
  (e : ∀x, q x ↔ p x) : (to_square_block_prop M p).det = (to_square_block_prop M q).det :=
by convert matrix.det_reindex_self (equiv.subtype_equiv_right e) (to_square_block_prop M q)

lemma to_square_block_det'' (M : matrix m m R) {n : nat} (b : m → fin n) (k : fin n) :
  (to_square_block M b k).det = (to_square_block' M (λ i, ↑(b i)) ↑k).det :=
begin
  rw [to_square_block_def', to_square_block_def],
  apply equiv_block_det,
  intro x,
  apply (fin.ext_iff _ _).symm
end

/-- Let `b` map rows and columns of a square matrix `M` to `n` blocks. Then
  `block_triangular_matrix' M n b` says the matrix is block triangular. -/
def block_triangular_matrix' {o : Type*} (M : matrix o o R) {n : ℕ}
  (b : o → fin n) : Prop :=
∀ i j, b j < b i → M i j = 0

lemma upper_two_block_triangular' {m n : Type*}
  (A : matrix m m R) (B : matrix m n R) (D : matrix n n R) :
  block_triangular_matrix' (from_blocks A B 0 D) (sum.elim (λ i, (0 : fin 2)) (λ j, 1)) :=
begin
  intros k1 k2 hk12,
  have h0 : ∀ (k : m ⊕ n), sum.elim (λ i, (0 : fin 2)) (λ j, 1) k = 0 → ∃ i, k = sum.inl i,
  { simp },
  have h1 : ∀ (k : m ⊕ n), sum.elim (λ i, (0 : fin 2)) (λ j, 1) k = 1 → ∃ j, k = sum.inr j,
  { simp },
  set mk1 := (sum.elim (λ i, (0 : fin 2)) (λ j, 1)) k1 with hmk1,
  set mk2 := (sum.elim (λ i, (0 : fin 2)) (λ j, 1)) k2 with hmk2,
  fin_cases mk1; fin_cases mk2; rw [h, h_1] at hk12,
  { exact absurd hk12 (nat.not_lt_zero 0) },
  { exact absurd hk12 (by norm_num) },
  { rw hmk1 at h,
    obtain ⟨i, hi⟩ := h1 k1 h,
    rw hmk2 at h_1,
    obtain ⟨j, hj⟩ := h0 k2 h_1,
    rw [hi, hj], simp },
  { exact absurd hk12 (irrefl 1) }
end

/-- Let `b` map rows and columns of a square matrix `M` to blocks indexed by `ℕ`s. Then
  `block_triangular_matrix M n b` says the matrix is block triangular. -/
def block_triangular_matrix {o : Type*} (M : matrix o o R) (b : o → ℕ) : Prop :=
∀ i j, b j < b i → M i j = 0

lemma upper_two_block_triangular {m n : Type*}
  (A : matrix m m R) (B : matrix m n R) (D : matrix n n R) :
  block_triangular_matrix (from_blocks A B 0 D) (sum.elim (λ i, 0) (λ j, 1)) :=
begin
  intros k1 k2 hk12,
  have h01 : ∀ (k : m ⊕ n), sum.elim (λ i, 0) (λ j, 1) k = 0 ∨ sum.elim (λ i, 0) (λ j, 1) k = 1,
  { simp },
  have h0 : ∀ (k : m ⊕ n), sum.elim (λ i, 0) (λ j, 1) k = 0 → ∃ i, k = sum.inl i, { simp },
  have h1 : ∀ (k : m ⊕ n), sum.elim (λ i, 0) (λ j, 1) k = 1 → ∃ j, k = sum.inr j, { simp },
  cases (h01 k1) with hk1 hk1; cases (h01 k2) with hk2 hk2; rw [hk1, hk2] at hk12,
  { exact absurd hk12 (nat.not_lt_zero 0) },
  { exact absurd hk12 (nat.not_lt_zero 1) },
  { obtain ⟨i, hi⟩ := h1 k1 hk1,
    obtain ⟨j, hj⟩ := h0 k2 hk2,
    rw [hi, hj], simp },
  { exact absurd hk12 (irrefl 1) }
end

lemma det_of_block_triangular_matrix (M : matrix m m R) (b : m → ℕ)
  (h : block_triangular_matrix M b) :
  ∀ (n : ℕ) (hn : ∀ i, b i < n), M.det = ∏ k in finset.range n, (to_square_block' M b k).det :=
begin
  intros n hn,
  tactic.unfreeze_local_instances,
  induction n with n hi generalizing m M b,
  { rw finset.prod_range_zero,
    apply det_eq_one_of_card_eq_zero,
    apply fintype.card_eq_zero_iff.mpr,
    exact ⟨λ i, nat.not_lt_zero (b i) (hn i)⟩ },
  { rw [finset.prod_range_succ_comm],
    have h2 : (M.to_square_block_prop (λ (i : m), b i = n.succ)).det =
      (M.to_square_block' b n.succ).det,
    { dunfold to_square_block', dunfold to_square_block_prop, refl },
    rw two_block_triangular_det M (λ i, ¬(b i = n)),
    { rw mul_comm,
      apply congr (congr_arg has_mul.mul _),
      { let m' := {a // ¬b a = n },
        let b' := (λ (i : m'), b ↑i),
        have h' :
          block_triangular_matrix (M.to_square_block_prop (λ (i : m), ¬b i = n)) b',
        { intros i j, apply h ↑i ↑j },
        have hni : ∀ (i : {a // ¬b a = n}), b' i < n,
        { exact λ i, (ne.le_iff_lt i.property).mp (nat.lt_succ_iff.mp (hn ↑i)) },
        have h1 := hi (M.to_square_block_prop (λ (i : m), ¬b i = n)) b' h' hni,
        rw ←fin.prod_univ_eq_prod_range at h1 ⊢,
        convert h1,
        ext k,
        simp only [to_square_block_def', to_square_block_def],
        let he : {a // b' a = ↑k} ≃ {a // b a = ↑k},
        { have hc : ∀ (i : m), (λ a, b a = ↑k) i → (λ a, ¬b a = n) i,
          { intros i hbi, rw hbi, exact ne_of_lt (fin.is_lt k) },
          exact equiv.subtype_subtype_equiv_subtype hc },
        exact matrix.det_reindex_self he (λ (i j : {a // b' a = ↑k}), M ↑i ↑j) },
      { rw det_to_square_block' M b n,
        have hh : ∀ a, b a = n ↔ ¬(λ (i : m), ¬b i = n) a,
        { intro i, simp only [not_not] },
        exact equiv_block_det M hh }},
    { intros i hi j hj,
      apply (h i), simp only [not_not] at hi,
      rw hi,
      exact (ne.le_iff_lt hj).mp (nat.lt_succ_iff.mp (hn j)) }}
end

lemma det_of_block_triangular_matrix'' (M : matrix m m R) (b : m → ℕ)
  (h : block_triangular_matrix M b) :
  M.det = ∏ k in finset.image b finset.univ, (to_square_block' M b k).det :=
begin
  let n : ℕ := (Sup (finset.image b finset.univ : set ℕ)).succ,
  have hn : ∀ i, b i < n,
  { have hbi : ∀ i, b i ∈ finset.image b finset.univ, { simp },
    intro i,
    dsimp only [n],
    apply nat.lt_succ_iff.mpr,
    exact le_cSup (finset.bdd_above _) (hbi i) },
  rw det_of_block_triangular_matrix M b h n hn,
  refine (finset.prod_subset _ _).symm,
  { intros a ha, apply finset.mem_range.mpr,
    obtain ⟨i, ⟨hi, hbi⟩⟩ := finset.mem_image.mp ha,
    rw ←hbi,
    exact hn i },
  { intros k hk hbk,
    apply det_eq_one_of_card_eq_zero,
    apply fintype.card_eq_zero_iff.mpr,
    constructor,
    simp only [subtype.forall],
    intros a hba, apply hbk,
    apply finset.mem_image.mpr,
    use a,
    exact ⟨finset.mem_univ a, hba⟩ }
end

lemma det_of_block_triangular_matrix' (M : matrix m m R) {n : ℕ} (b : m → fin n)
  (h : block_triangular_matrix' M b) :
  M.det = ∏ (k : fin n), (to_square_block M b k).det :=
begin
  let b2 : m → ℕ := λ i, ↑(b i),
  simp_rw to_square_block_det'',
  rw fin.prod_univ_eq_prod_range (λ (k : ℕ), (M.to_square_block' b2 k).det) n,
  apply det_of_block_triangular_matrix,
  { intros i j hij, exact h i j (fin.coe_fin_lt.mp hij) },
  { intro i, exact fin.is_lt (b i) }
end

lemma det_of_upper_triangular {n : ℕ} (M : matrix (fin n) (fin n) R)
  (h : ∀ (i j : fin n), j < i → M i j = 0) :
  M.det = ∏ i : (fin n), M i i :=
begin
  convert det_of_block_triangular_matrix' M id h,
  ext i,
  have h2 : ∀ (j : {a // id a = i}), j = ⟨i, rfl⟩ :=
    λ (j : {a // id a = i}), subtype.ext j.property,
  haveI : unique {a // id a = i} := ⟨⟨⟨i, rfl⟩⟩, h2⟩,
  simp [h2 (default {a // id a = i})]
end

lemma det_of_lower_triangular {n : ℕ} (M : matrix (fin n) (fin n) R)
  (h : ∀ (i j : fin n), i < j → M i j = 0) :
  M.det = ∏ i : (fin n), M i i :=
begin
  rw ← det_transpose,
  exact det_of_upper_triangular _ (λ (i j : fin n) (hji : j < i), h j i hji)
end

end matrix


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Shing Tak Lam, Mario Carneiro
-/
import data.int.modeq
import data.nat.bits
import data.nat.log
import data.list.indexes
import data.list.palindrome
import algebra.parity
import tactic.interval_cases
import tactic.linarith

/-!
# Digits of a natural number

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

This provides a basic API for extracting the digits of a natural number in a given base,
and reconstructing numbers from their digits.

We also prove some divisibility tests based on digits, in particular completing
Theorem #85 from https://www.cs.ru.nl/~freek/100/.

A basic `norm_digits` tactic is also provided for proving goals of the form
`nat.digits a b = l` where `a` and `b` are numerals.
-/

namespace nat
variables {n : ℕ}

/-- (Impl.) An auxiliary definition for `digits`, to help get the desired definitional unfolding. -/
def digits_aux_0 : ℕ → list ℕ
| 0 := []
| (n+1) := [n+1]

/-- (Impl.) An auxiliary definition for `digits`, to help get the desired definitional unfolding. -/
def digits_aux_1 (n : ℕ) : list ℕ := list.replicate n 1

/-- (Impl.) An auxiliary definition for `digits`, to help get the desired definitional unfolding. -/
def digits_aux (b : ℕ) (h : 2 ≤ b) : ℕ → list ℕ
| 0 := []
| (n+1) :=
  have (n+1)/b < n+1 := nat.div_lt_self (nat.succ_pos _) h,
  (n+1) % b :: digits_aux ((n+1)/b)

@[simp] lemma digits_aux_zero (b : ℕ) (h : 2 ≤ b) : digits_aux b h 0 = [] := by rw digits_aux

lemma digits_aux_def (b : ℕ) (h : 2 ≤ b) (n : ℕ) (w : 0 < n) :
  digits_aux b h n = n % b :: digits_aux b h (n/b) :=
begin
  cases n,
  { cases w, },
  { rw [digits_aux], }
end

/--
`digits b n` gives the digits, in little-endian order,
of a natural number `n` in a specified base `b`.

In any base, we have `of_digits b L = L.foldr (λ x y, x + b * y) 0`.
* For any `2 ≤ b`, we have `l < b` for any `l ∈ digits b n`,
  and the last digit is not zero.
  This uniquely specifies the behaviour of `digits b`.
* For `b = 1`, we define `digits 1 n = list.replicate n 1`.
* For `b = 0`, we define `digits 0 n = [n]`, except `digits 0 0 = []`.

Note this differs from the existing `nat.to_digits` in core, which is used for printing numerals.
In particular, `nat.to_digits b 0 = [0]`, while `digits b 0 = []`.
-/
def digits : ℕ → ℕ → list ℕ
| 0 := digits_aux_0
| 1 := digits_aux_1
| (b+2) := digits_aux (b+2) (by norm_num)

@[simp] lemma digits_zero (b : ℕ) : digits b 0 = [] :=
by rcases b with _|⟨_|⟨_⟩⟩; simp [digits, digits_aux_0, digits_aux_1]

@[simp] lemma digits_zero_zero : digits 0 0 = [] := rfl

@[simp] lemma digits_zero_succ (n : ℕ) : digits 0 (n.succ) = [n+1] := rfl

theorem digits_zero_succ' : ∀ {n : ℕ}, n ≠ 0 → digits 0 n = [n]
| 0 h := (h rfl).elim
| (n+1) _ := rfl

@[simp] lemma digits_one (n : ℕ) : digits 1 n = list.replicate n 1 := rfl

@[simp] lemma digits_one_succ (n : ℕ) : digits 1 (n + 1) = 1 :: digits 1 n := rfl

@[simp] lemma digits_add_two_add_one (b n : ℕ) :
  digits (b+2) (n+1) = (((n+1) % (b+2)) :: digits (b+2) ((n+1) / (b+2))) :=
by { rw [digits, digits_aux_def], exact succ_pos n }

theorem digits_def' : ∀ {b : ℕ} (h : 1 < b) {n : ℕ} (w : 0 < n),
  digits b n = n % b :: digits b (n/b)
| 0 h := absurd h dec_trivial
| 1 h := absurd h dec_trivial
| (b+2) h := digits_aux_def _ _

@[simp] lemma digits_of_lt (b x : ℕ) (hx : x ≠ 0) (hxb : x < b) : digits b x = [x] :=
begin
  rcases exists_eq_succ_of_ne_zero hx with ⟨x, rfl⟩,
  rcases exists_eq_add_of_le' ((nat.le_add_left 1 x).trans_lt hxb) with ⟨b, rfl⟩,
  rw [digits_add_two_add_one, div_eq_of_lt hxb, digits_zero, mod_eq_of_lt hxb]
end

lemma digits_add (b : ℕ) (h : 1 < b) (x y : ℕ) (hxb : x < b) (hxy : x ≠ 0 ∨ y ≠ 0) :
  digits b (x + b * y) = x :: digits b y :=
begin
  rcases exists_eq_add_of_le' h with ⟨b, rfl : _ = _ + 2⟩,
  cases y,
  { simp [hxb, hxy.resolve_right (absurd rfl)] },
  dsimp [digits],
  rw digits_aux_def,
  { congr,
    { simp [nat.add_mod, mod_eq_of_lt hxb], },
    { simp [add_mul_div_left, div_eq_of_lt hxb] } },
  { apply nat.succ_pos }
end

/--
`of_digits b L` takes a list `L` of natural numbers, and interprets them
as a number in semiring, as the little-endian digits in base `b`.
-/
-- If we had a function converting a list into a polynomial,
-- and appropriate lemmas about that function,
-- we could rewrite this in terms of that.
def of_digits {α : Type*} [semiring α] (b : α) : list ℕ → α
| [] := 0
| (h :: t) := h + b * of_digits t

lemma of_digits_eq_foldr {α : Type*} [semiring α] (b : α) (L : list ℕ) :
  of_digits b L = L.foldr (λ x y, x + b * y) 0 :=
begin
  induction L with d L ih,
  { refl, },
  { dsimp [of_digits], rw ih, },
end

lemma of_digits_eq_sum_map_with_index_aux (b : ℕ) (l : list ℕ) :
  ((list.range l.length).zip_with ((λ (i a : ℕ), a * b ^ i) ∘ succ) l).sum =
  b * ((list.range l.length).zip_with (λ i a, a * b ^ i) l).sum :=
begin
  suffices : (list.range l.length).zip_with (((λ (i a : ℕ), a * b ^ i) ∘ succ)) l =
      (list.range l.length).zip_with (λ i a, b * (a * b ^ i)) l,
  { simp [this] },
  congr,
  ext,
  simp [pow_succ],
  ring
end

lemma of_digits_eq_sum_map_with_index (b : ℕ) (L : list ℕ):
  of_digits b L = (L.map_with_index (λ i a, a * b ^ i)).sum :=
begin
  rw [list.map_with_index_eq_enum_map, list.enum_eq_zip_range,
      list.map_uncurry_zip_eq_zip_with, of_digits_eq_foldr],
  induction L with hd tl hl,
  { simp },
  { simpa [list.range_succ_eq_map, list.zip_with_map_left, of_digits_eq_sum_map_with_index_aux]
      using or.inl hl }
end

@[simp] lemma of_digits_singleton {b n : ℕ} : of_digits b [n] = n := by simp [of_digits]

@[simp] lemma of_digits_one_cons {α : Type*} [semiring α] (h : ℕ) (L : list ℕ) :
  of_digits (1 : α) (h :: L) = h + of_digits 1 L :=
by simp [of_digits]

lemma of_digits_append {b : ℕ} {l1 l2 : list ℕ} :
  of_digits b (l1 ++ l2) = of_digits b l1 + b^(l1.length) * of_digits b l2 :=
begin
  induction l1 with hd tl IH,
  { simp [of_digits] },
  { rw [of_digits, list.cons_append, of_digits, IH, list.length_cons, pow_succ'],
    ring }
end

@[norm_cast] lemma coe_of_digits (α : Type*) [semiring α] (b : ℕ) (L : list ℕ) :
  ((of_digits b L : ℕ) : α) = of_digits (b : α) L :=
begin
  induction L with d L ih,
  { simp [of_digits], },
  { dsimp [of_digits], push_cast, rw ih, }
end

@[norm_cast] lemma coe_int_of_digits (b : ℕ) (L : list ℕ) :
  ((of_digits b L : ℕ) : ℤ) = of_digits (b : ℤ) L :=
begin
  induction L with d L ih,
  { refl, },
  { dsimp [of_digits], push_cast }
end

lemma digits_zero_of_eq_zero {b : ℕ} (h : b ≠ 0) :
  ∀ {L : list ℕ} (h0 : of_digits b L = 0) (l ∈ L), l = 0
| (a :: L) h0 l (or.inl rfl) := nat.eq_zero_of_add_eq_zero_right h0
| (a :: L) h0 l (or.inr hL) :=
  digits_zero_of_eq_zero (mul_right_injective₀ h (nat.eq_zero_of_add_eq_zero_left h0)) _ hL

lemma digits_of_digits
  (b : ℕ) (h : 1 < b) (L : list ℕ)
  (w₁ : ∀ l ∈ L, l < b) (w₂ : ∀ (h : L ≠ []), L.last h ≠ 0) :
  digits b (of_digits b L) = L :=
begin
  induction L with d L ih,
  { dsimp [of_digits], simp },
  { dsimp [of_digits],
    replace w₂ := w₂ (by simp),
    rw digits_add b h,
    { rw ih,
      { intros l m, apply w₁, exact list.mem_cons_of_mem _ m, },
      { intro h,
        { rw [list.last_cons h] at w₂,
            convert w₂, }}},
    { exact w₁ d (list.mem_cons_self _ _) },
    { by_cases h' : L = [],
      { rcases h' with rfl,
        left,
        simpa using w₂ },
      { right,
        contrapose! w₂,
        refine digits_zero_of_eq_zero h.ne_bot w₂ _ _,
        rw list.last_cons h',
        exact list.last_mem h' } } }
end

lemma of_digits_digits (b n : ℕ) : of_digits b (digits b n) = n :=
begin
  cases b with b,
  { cases n with n,
    { refl, },
    { change of_digits 0 [n+1] = n+1,
      dsimp [of_digits],
      simp, } },
  { cases b with b,
    { induction n with n ih,
      { refl, },
      { simp only [ih, add_comm 1, of_digits_one_cons, nat.cast_id, digits_one_succ], } },
    { apply nat.strong_induction_on n _, clear n,
      intros n h,
      cases n,
      { rw digits_zero, refl, },
      { simp only [nat.succ_eq_add_one, digits_add_two_add_one],
        dsimp [of_digits],
        rw h _ (nat.div_lt_self' n b),
        rw [nat.mod_add_div], }, }, },
end

lemma of_digits_one (L : list ℕ) : of_digits 1 L = L.sum :=
begin
  induction L with d L ih,
  { refl, },
  { simp [of_digits, list.sum_cons, ih], }
end

/-!
### Properties

This section contains various lemmas of properties relating to `digits` and `of_digits`.
-/

lemma digits_eq_nil_iff_eq_zero {b n : ℕ} : digits b n = [] ↔ n = 0 :=
begin
  split,
  { intro h,
    have : of_digits b (digits b n) = of_digits b [], by rw h,
    convert this,
    rw of_digits_digits },
  { rintro rfl,
    simp }
end

lemma digits_ne_nil_iff_ne_zero {b n : ℕ} : digits b n ≠ [] ↔ n ≠ 0 :=
not_congr digits_eq_nil_iff_eq_zero

lemma digits_eq_cons_digits_div {b n : ℕ} (h : 1 < b) (w : n ≠ 0) :
  digits b n = ((n % b) :: digits b (n / b)) :=
begin
  rcases b with _|_|b,
  { rw [digits_zero_succ' w, nat.mod_zero, nat.div_zero, nat.digits_zero_zero] },
  { norm_num at h },
  rcases n with _|n,
  { norm_num at w },
  simp,
end

lemma digits_last {b : ℕ} (m : ℕ) (h : 1 < b) (p q) :
  (digits b m).last p = (digits b (m/b)).last q :=
begin
  by_cases hm : m = 0,
  { simp [hm], },
  simp only [digits_eq_cons_digits_div h hm],
  rw list.last_cons,
end

lemma digits.injective (b : ℕ) : function.injective b.digits :=
function.left_inverse.injective (of_digits_digits b)

@[simp] lemma digits_inj_iff {b n m : ℕ} :
  b.digits n = b.digits m ↔ n = m :=
(digits.injective b).eq_iff

lemma digits_len (b n : ℕ) (hb : 1 < b) (hn : n ≠ 0) :
  (b.digits n).length = b.log n + 1 :=
begin
  induction n using nat.strong_induction_on with n IH,
  rw [digits_eq_cons_digits_div hb hn, list.length],
  by_cases h : n / b = 0,
  { have hb0 : b ≠ 0 := (nat.succ_le_iff.1 hb).ne_bot,
    simp [h, log_eq_zero_iff, ← nat.div_eq_zero_iff hb0.bot_lt] },
  { have hb' : 1 < b := one_lt_two.trans_le hb,
    have : n / b < n := div_lt_self (nat.pos_of_ne_zero hn) hb',
    rw [IH _ this h, log_div_base, tsub_add_cancel_of_le],
    refine nat.succ_le_of_lt (log_pos hb' _),
    contrapose! h,
    exact div_eq_of_lt h }
end

lemma last_digit_ne_zero (b : ℕ) {m : ℕ} (hm : m ≠ 0) :
  (digits b m).last (digits_ne_nil_iff_ne_zero.mpr hm) ≠ 0 :=
begin
  rcases b with _|_|b,
  { cases m,
    { cases hm rfl },
    { simp } },
  { cases m, { cases hm rfl },
    simpa only [digits_one, list.last_replicate_succ m 1] using one_ne_zero },
  revert hm,
  apply nat.strong_induction_on m,
  intros n IH hn,
  by_cases hnb : n < b + 2,
  { simpa only [digits_of_lt (b + 2) n hn hnb] },
  { rw digits_last n (show 2 ≤ b + 2, from dec_trivial),
    refine IH _ (nat.div_lt_self hn.bot_lt dec_trivial) _,
    { rw ←pos_iff_ne_zero,
      exact nat.div_pos (le_of_not_lt hnb) dec_trivial } },
end

/-- The digits in the base b+2 expansion of n are all less than b+2 -/
lemma digits_lt_base' {b m : ℕ} : ∀ {d}, d ∈ digits (b+2) m → d < b+2 :=
begin
  apply nat.strong_induction_on m,
  intros n IH d hd,
  cases n with n,
  { rw digits_zero at hd, cases hd }, -- base b+2 expansion of 0 has no digits
  rw digits_add_two_add_one at hd,
  cases hd,
  { rw hd, exact n.succ.mod_lt (by linarith) },
  { exact IH _ (nat.div_lt_self (nat.succ_pos _) (by linarith)) hd }
end

/-- The digits in the base b expansion of n are all less than b, if b ≥ 2 -/
lemma digits_lt_base {b m d : ℕ} (hb : 1 < b) (hd : d ∈ digits b m) : d < b :=
begin
  rcases b with _ | _ | b; try {linarith},
  exact digits_lt_base' hd,
end

/-- an n-digit number in base b + 2 is less than (b + 2)^n -/
lemma of_digits_lt_base_pow_length' {b : ℕ} {l : list ℕ} (hl : ∀ x ∈ l, x < b+2) :
  of_digits (b+2) l < (b+2)^(l.length) :=
begin
  induction l with hd tl IH,
  { simp [of_digits], },
  { rw [of_digits, list.length_cons, pow_succ],
    have : (of_digits (b + 2) tl + 1) * (b+2) ≤ (b + 2) ^ tl.length * (b+2) :=
      mul_le_mul (IH (λ x hx, hl _ (list.mem_cons_of_mem _ hx)))
                 (by refl) dec_trivial (nat.zero_le _),
    suffices : ↑hd < b + 2,
    { linarith },
    norm_cast,
    exact hl hd (list.mem_cons_self _ _) }
end

/-- an n-digit number in base b is less than b^n if b > 1 -/
lemma of_digits_lt_base_pow_length {b : ℕ} {l : list ℕ} (hb : 1 < b) (hl : ∀ x ∈ l, x < b) :
  of_digits b l < b^l.length :=
begin
  rcases b with _ | _ | b; try { linarith },
  exact of_digits_lt_base_pow_length' hl,
end

/-- Any number m is less than (b+2)^(number of digits in the base b + 2 representation of m) -/
lemma lt_base_pow_length_digits' {b m : ℕ} : m < (b + 2) ^ (digits (b + 2) m).length :=
begin
  convert of_digits_lt_base_pow_length' (λ _, digits_lt_base'),
  rw of_digits_digits (b+2) m,
end

/-- Any number m is less than b^(number of digits in the base b representation of m) -/
lemma lt_base_pow_length_digits {b m : ℕ} (hb : 1 < b) : m < b^(digits b m).length :=
begin
  rcases b with _ | _ | b; try { linarith },
  exact lt_base_pow_length_digits',
end

lemma of_digits_digits_append_digits {b m n : ℕ} :
  of_digits b (digits b n ++ digits b m) = n + b ^ (digits b n).length * m:=
by rw [of_digits_append, of_digits_digits, of_digits_digits]

lemma digits_len_le_digits_len_succ (b n : ℕ) : (digits b n).length ≤ (digits b (n + 1)).length :=
begin
  rcases decidable.eq_or_ne n 0 with rfl|hn,
  { simp },
  cases le_or_lt b 1 with hb hb,
  { interval_cases b; simp [digits_zero_succ', hn] },
  simpa [digits_len, hb, hn] using log_mono_right (le_succ _)
end

lemma le_digits_len_le (b n m : ℕ) (h : n ≤ m) : (digits b n).length ≤ (digits b m).length :=
monotone_nat_of_le_succ (digits_len_le_digits_len_succ b) h

lemma pow_length_le_mul_of_digits {b : ℕ} {l : list ℕ} (hl : l ≠ []) (hl2 : l.last hl ≠ 0):
  (b + 2) ^ l.length ≤ (b + 2) * of_digits (b+2) l :=
begin
  rw [←list.init_append_last hl],
  simp only [list.length_append, list.length, zero_add, list.length_init, of_digits_append,
    list.length_init, of_digits_singleton, add_comm (l.length - 1), pow_add, pow_one],
  apply nat.mul_le_mul_left,
  refine le_trans _ (nat.le_add_left _ _),
  have : 0 < l.last hl, { rwa [pos_iff_ne_zero] },
  convert nat.mul_le_mul_left _ this, rw [mul_one]
end

/--
Any non-zero natural number `m` is greater than
(b+2)^((number of digits in the base (b+2) representation of m) - 1)
-/
lemma base_pow_length_digits_le' (b m : ℕ) (hm : m ≠ 0) :
  (b + 2) ^ ((digits (b + 2) m).length) ≤ (b + 2) * m :=
begin
  have : digits (b + 2) m ≠ [], from digits_ne_nil_iff_ne_zero.mpr hm,
  convert pow_length_le_mul_of_digits this (last_digit_ne_zero _ hm),
  rwa of_digits_digits,
end

/--
Any non-zero natural number `m` is greater than
b^((number of digits in the base b representation of m) - 1)
-/
lemma base_pow_length_digits_le (b m : ℕ) (hb : 1 < b): m ≠ 0 → b ^ ((digits b m).length) ≤ b * m :=
begin
  rcases b with _ | _ | b; try { linarith },
  exact base_pow_length_digits_le' b m,
end

/-! ### Binary -/
lemma digits_two_eq_bits (n : ℕ) : digits 2 n = n.bits.map (λ b, cond b 1 0) :=
begin
  induction n using nat.binary_rec_from_one with b n h ih,
  { simp, },
  { simp, },
  rw bits_append_bit _ _ (λ hn, absurd hn h),
  cases b,
  { rw digits_def' one_lt_two,
     { simpa [nat.bit, nat.bit0_val n], },
     { simpa [pos_iff_ne_zero, bit_eq_zero_iff], }, },
  { simpa [nat.bit, nat.bit1_val n, add_comm, digits_add 2 one_lt_two 1 n] },
end

/-! ### Modular Arithmetic -/

-- This is really a theorem about polynomials.
lemma dvd_of_digits_sub_of_digits {α : Type*} [comm_ring α]
  {a b k : α} (h : k ∣ a - b) (L : list ℕ) :
  k ∣ of_digits a L - of_digits b L :=
begin
  induction L with d L ih,
  { change k ∣ 0 - 0, simp, },
  { simp only [of_digits, add_sub_add_left_eq_sub],
    exact dvd_mul_sub_mul h ih, }
end

lemma of_digits_modeq' (b b' : ℕ) (k : ℕ) (h : b ≡ b' [MOD k]) (L : list ℕ) :
  of_digits b L ≡ of_digits b' L [MOD k] :=
begin
  induction L with d L ih,
  { refl, },
  { dsimp [of_digits],
    dsimp [nat.modeq] at *,
    conv_lhs { rw [nat.add_mod, nat.mul_mod, h, ih], },
    conv_rhs { rw [nat.add_mod, nat.mul_mod], }, }
end

lemma of_digits_modeq (b k : ℕ) (L : list ℕ) : of_digits b L ≡ of_digits (b % k) L [MOD k] :=
of_digits_modeq' b (b % k) k (b.mod_modeq k).symm L

lemma of_digits_mod (b k : ℕ) (L : list ℕ) : of_digits b L % k = of_digits (b % k) L % k :=
of_digits_modeq b k L

lemma of_digits_zmodeq' (b b' : ℤ) (k : ℕ) (h : b ≡ b' [ZMOD k]) (L : list ℕ) :
  of_digits b L ≡ of_digits b' L [ZMOD k] :=
begin
  induction L with d L ih,
  { refl, },
  { dsimp [of_digits],
    dsimp [int.modeq] at *,
    conv_lhs { rw [int.add_mod, int.mul_mod, h, ih], },
    conv_rhs { rw [int.add_mod, int.mul_mod], }, }
end

lemma of_digits_zmodeq (b : ℤ) (k : ℕ) (L : list ℕ) :
  of_digits b L ≡ of_digits (b % k) L [ZMOD k] :=
of_digits_zmodeq' b (b % k) k (b.mod_modeq  ↑k).symm L

lemma modeq_digits_sum (b b' : ℕ) (h : b' % b = 1) (n : ℕ) :
   n ≡ (digits b' n).sum [MOD b] :=
begin
  rw ←of_digits_one,
  conv { congr, skip, rw ←(of_digits_digits b' n) },
  convert of_digits_modeq _ _ _,
  exact h.symm,
end

lemma modeq_three_digits_sum (n : ℕ) : n ≡ (digits 10 n).sum [MOD 3] :=
modeq_digits_sum 3 10 (by norm_num) n

lemma modeq_nine_digits_sum (n : ℕ) : n ≡ (digits 10 n).sum [MOD 9] :=
modeq_digits_sum 9 10 (by norm_num) n

lemma zmodeq_of_digits_digits (b b' : ℕ) (c : ℤ) (h : b' ≡ c [ZMOD b]) (n : ℕ) :
  n ≡ of_digits c (digits b' n) [ZMOD b] :=
begin
  conv { congr, skip, rw ←(of_digits_digits b' n) },
  rw coe_int_of_digits,
  apply of_digits_zmodeq' _ _ _ h,
end

lemma of_digits_neg_one : Π (L : list ℕ),
  of_digits (-1 : ℤ) L = (L.map (λ n : ℕ, (n : ℤ))).alternating_sum
| [] := rfl
| [n] := by simp [of_digits, list.alternating_sum]
| (a :: b :: t) :=
  begin
    simp only [of_digits, list.alternating_sum, list.map_cons, of_digits_neg_one t],
    ring,
  end

lemma modeq_eleven_digits_sum (n : ℕ) :
  n ≡ ((digits 10 n).map (λ n : ℕ, (n : ℤ))).alternating_sum [ZMOD 11] :=
begin
  have t := zmodeq_of_digits_digits 11 10 (-1 : ℤ) (by unfold int.modeq; norm_num) n,
  rwa of_digits_neg_one at t
end

/-! ## Divisibility  -/

lemma dvd_iff_dvd_digits_sum (b b' : ℕ) (h : b' % b = 1) (n : ℕ) :
  b ∣ n ↔ b ∣ (digits b' n).sum :=
begin
  rw ←of_digits_one,
  conv_lhs { rw ←(of_digits_digits b' n) },
  rw [nat.dvd_iff_mod_eq_zero, nat.dvd_iff_mod_eq_zero, of_digits_mod, h],
end

/-- **Divisibility by 3 Rule** -/
lemma three_dvd_iff (n : ℕ) : 3 ∣ n ↔ 3 ∣ (digits 10 n).sum :=
dvd_iff_dvd_digits_sum 3 10 (by norm_num) n

lemma nine_dvd_iff (n : ℕ) : 9 ∣ n ↔ 9 ∣ (digits 10 n).sum :=
dvd_iff_dvd_digits_sum 9 10 (by norm_num) n

lemma dvd_iff_dvd_of_digits (b b' : ℕ) (c : ℤ) (h : (b : ℤ) ∣ (b' : ℤ) - c) (n : ℕ) :
  b ∣ n ↔ (b : ℤ) ∣ of_digits c (digits b' n) :=
begin
  rw ←int.coe_nat_dvd,
  exact dvd_iff_dvd_of_dvd_sub
    (zmodeq_of_digits_digits b b' c (int.modeq_iff_dvd.2 h).symm _).symm.dvd,
end

lemma eleven_dvd_iff : 11 ∣ n ↔ (11 : ℤ) ∣ ((digits 10 n).map (λ n : ℕ, (n : ℤ))).alternating_sum :=
begin
  have t := dvd_iff_dvd_of_digits 11 10 (-1 : ℤ) (by norm_num) n,
  rw of_digits_neg_one at t,
  exact t,
end

lemma eleven_dvd_of_palindrome (p : (digits 10 n).palindrome) (h : even (digits 10 n).length) :
  11 ∣ n :=
begin
  let dig := (digits 10 n).map (coe : ℕ → ℤ),
  replace h : even dig.length := by rwa list.length_map,
  refine eleven_dvd_iff.2 ⟨0, (_ : dig.alternating_sum = 0)⟩,
  have := dig.alternating_sum_reverse,
  rw [(p.map _).reverse_eq, pow_succ, h.neg_one_pow, mul_one, neg_one_zsmul] at this,
  exact eq_zero_of_neg_eq this.symm,
end

/-! ### `norm_digits` tactic -/

namespace norm_digits

theorem digits_succ
  (b n m r l)
  (e : r + b * m = n)
  (hr : r < b)
  (h : nat.digits b m = l ∧ 1 < b ∧ 0 < m) :
  nat.digits b n = r :: l ∧ 1 < b ∧ 0 < n :=
begin
  rcases h with ⟨h, b2, m0⟩,
  have b0 : 0 < b := by linarith,
  have n0 : 0 < n := by linarith [mul_pos b0 m0],
  refine ⟨_, b2, n0⟩,
  obtain ⟨rfl, rfl⟩ := (nat.div_mod_unique b0).2 ⟨e, hr⟩,
  subst h, exact nat.digits_def' b2 n0,
end

theorem digits_one
  (b n) (n0 : 0 < n) (nb : n < b) :
  nat.digits b n = [n] ∧ 1 < b ∧ 0 < n :=
begin
  have b2 : 1 < b := by linarith,
  refine ⟨_, b2, n0⟩,
  rw [nat.digits_def' b2 n0, nat.mod_eq_of_lt nb,
    (nat.div_eq_zero_iff ((zero_le n).trans_lt nb)).2 nb, nat.digits_zero],
end

open tactic

/-- Helper function for the `norm_digits` tactic. -/
meta def eval_aux (eb : expr) (b : ℕ) :
  expr → ℕ → instance_cache → tactic (instance_cache × expr × expr)
| en n ic := do
  let m := n / b,
  let r := n % b,
  (ic, er) ← ic.of_nat r,
  (ic, pr) ← norm_num.prove_lt_nat ic er eb,
  if m = 0 then do
    (_, pn0) ← norm_num.prove_pos ic en,
    return (ic, `([%%en] : list nat), `(digits_one %%eb %%en %%pn0 %%pr))
  else do
    em ← expr.of_nat `(ℕ) m,
    (_, pe) ← norm_num.derive `(%%er + %%eb * %%em : ℕ),
    (ic, el, p) ← eval_aux em m ic,
    return (ic, `(@list.cons ℕ %%er %%el),
      `(digits_succ %%eb %%en %%em %%er %%el %%pe %%pr %%p))

/--
A tactic for normalizing expressions of the form `nat.digits a b = l` where
`a` and `b` are numerals.

```
example : nat.digits 10 123 = [3,2,1] := by norm_num
```
-/
@[norm_num] meta def eval : expr → tactic (expr × expr)
| `(nat.digits %%eb %%en) := do
  b ← expr.to_nat eb,
  n ← expr.to_nat en,
  if n = 0 then return (`([] : list ℕ), `(nat.digits_zero %%eb))
  else if b = 0 then do
    ic ← mk_instance_cache `(ℕ),
    (_, pn0) ← norm_num.prove_ne_zero' ic en,
    return (`([%%en] : list ℕ), `(@nat.digits_zero_succ' %%en %%pn0))
  else if b = 1 then do
    ic ← mk_instance_cache `(ℕ),
    s ← simp_lemmas.add_simp simp_lemmas.mk `list.replicate,
    (rhs, p2, _) ← simplify s [] `(list.replicate %%en 1),
    p ← mk_eq_trans `(nat.digits_one %%en) p2,
    return (rhs, p)
  else do
    ic ← mk_instance_cache `(ℕ),
    (_, l, p) ← eval_aux eb b en n ic,
    p ← mk_app ``and.left [p],
    return (l, p)
| _ := failed

end norm_digits

end nat


import topology.theorems
import data.set.finite

open definitions set

variables {X : Type*}

namespace examples

-- The cofinite topology
def example_topology : topological_space X :=
{ is_open := λ U, U ∈ {∅} ∪ {U' : set X | finite U'ᶜ},
  is_open_univ :=
    by right; rw mem_set_of_eq; convert finite_empty; exact compl_top,
  is_open_inter := λ _ _ hS hT,
    begin
      cases hS, rw mem_singleton_iff.1 hS, simp,
      cases hT, rw mem_singleton_iff.1 hT, simp,
      right, rw mem_set_of_eq at *,
      rw compl_inter, exact finite.union hS hT,
    end,
  is_open_sUnion := λ s hs,
    begin
      cases classical.em (∀ t ∈ s, t = ∅),
        { left, rw mem_singleton_iff,
          ext, split,
            { intro ht, rw mem_sUnion at ht,
              rcases ht with ⟨t, hts, hmemt⟩,
              rw h t hts at hmemt, assumption },
            { intro hf, exfalso, exact hf }
        },
        { push_neg at h,
          rcases h with ⟨t, ht₀, ht₁⟩,
          right, rw [mem_set_of_eq, compl_sUnion],
          cases hs t ht₀, exfalso, exact ht₁ h,
          rw mem_set_of_eq at h,
          refine finite.subset h (sInter_subset_of_mem $ _),
          rw mem_image, exact ⟨t, ht₀, rfl⟩
        }
    end }

/-
TODO: Add some examples of topological spaces
-/

variables {Y : Type*} [topological_space X] [topological_space Y]

-- The identity map is continuous
example : is_continuous (@id X) := λ _ hU, hU

-- The constant map is continuous
example (y : Y) : is_continuous (λ x : X, y) := λ U hU,
begin
  cases (classical.em $ y ∈ U) with hinU hninU,
    { convert is_open_univ, ext, simp [hinU] },
    { convert is_open_empty, ext, simp [hninU] }
end

end examples


theorem succ_succ_inj {a b : mynat} (h : succ(succ(a)) = succ(succ(b))) :  a = b :=
begin
apply succ_inj,
apply succ_inj,
exact h,
end