/-
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 computability.primrec
import tactic.linarith

/-!
# Ackermann function

In this file, we define the two-argument Ackermann function `ack`. Despite having a recursive
definition, we show that this isn't a primitive recursive function.

## Main results

- `exists_lt_ack_of_primrec`: any primitive recursive function is pointwise bounded above by `ack m`
  for some `m`.
- `not_primrec₂_ack`: the two-argument Ackermann function is not primitive recursive.

## Proof approach

We very broadly adapt the proof idea from
https://www.planetmath.org/ackermannfunctionisnotprimitiverecursive. Namely, we prove that for any
primitive recursive `f : ℕ → ℕ`, there exists `m` such that `f n < ack m n` for all `n`. This then
implies that `λ n, ack n n` can't be primitive recursive, and so neither can `ack`. We aren't able
to use the same bounds as in that proof though, since our approach of using pairing functions
differs from their approach of using multivariate functions.

The important bounds we show during the main inductive proof (`exists_lt_ack_of_primrec`) are the
following. Assuming `∀ n, f n < ack a n` and `∀ n, g n < ack b n`, we have:

- `∀ n, nat.mkpair (f n) (g n) < ack (max a b + 3) n`.
- `∀ n, g (f n) < ack (max a b + 2) n`.
- `∀ n, nat.elim (f n.unpair.1) (λ (y IH : ℕ), g (nat.mkpair n.unpair.1 (nat.mkpair y IH)))
  n.unpair.2 < ack (max a b + 9) n`.

The last one is evidently the hardest. Using `nat.unpair_add_le`, we reduce it to the more
manageable

- `∀ m n, elim (f m) (λ (y IH : ℕ), g (nat.mkpair m (nat.mkpair y IH))) n <
  ack (max a b + 9) (m + n)`.

We then prove this by induction on `n`. Our proof crucially depends on `ack_mkpair_lt`, which is
applied twice, giving us a constant of `4 + 4`. The rest of the proof consists of simpler bounds
which bump up our constant to `9`.
-/

open nat

/-- The two-argument Ackermann function, defined so that

- `ack 0 n = n + 1`
- `ack (m + 1) 0 = ack m 1`
- `ack (m + 1) (n + 1) = ack m (ack (m + 1) n)`.

This is of interest as both a fast-growing function, and as an example of a recursive function that
isn't primitive recursive. -/
def ack : ℕ → ℕ → ℕ
| 0       n       := n + 1
| (m + 1) 0       := ack m 1
| (m + 1) (n + 1) := ack m (ack (m + 1) n)

@[simp] theorem ack_zero (n : ℕ) : ack 0 n = n + 1 := by rw ack
@[simp] theorem ack_succ_zero (m : ℕ) : ack (m + 1) 0 = ack m 1 := by rw ack
@[simp] theorem ack_succ_succ (m n : ℕ) : ack (m + 1) (n + 1) = ack m (ack (m + 1) n) := by rw ack

@[simp] theorem ack_one (n : ℕ) : ack 1 n = n + 2 :=
begin
  induction n with n IH,
  { simp },
  { simp [IH] }
end

@[simp] theorem ack_two (n : ℕ) : ack 2 n = 2 * n + 3 :=
begin
  induction n with n IH,
  { simp },
  { simp [IH, mul_succ] }
end

private theorem ack_three_aux (n : ℕ) : (ack 3 n : ℤ) = 2 ^ (n + 3) - 3 :=
begin
  induction n with n IH,
  { simp, norm_num },
  { simp [IH, pow_succ],
    rw [mul_sub, sub_add],
    norm_num }
end

@[simp] theorem ack_three (n : ℕ) : ack 3 n = 2 ^ (n + 3) - 3 :=
begin
  zify,
  rw cast_sub,
  { exact_mod_cast ack_three_aux n },
  { have H : 3 ≤ 2 ^ 3 := by norm_num,
    exact H.trans (pow_mono one_le_two $ le_add_left le_rfl) }
end

theorem ack_pos : ∀ m n, 0 < ack m n
| 0       n       := by simp
| (m + 1) 0       := by { rw ack_succ_zero, apply ack_pos }
| (m + 1) (n + 1) := by { rw ack_succ_succ, apply ack_pos }

theorem one_lt_ack_succ_left : ∀ m n, 1 < ack (m + 1) n
| 0       n       := by simp
| (m + 1) 0       := by { rw ack_succ_zero, apply one_lt_ack_succ_left }
| (m + 1) (n + 1) := by { rw ack_succ_succ, apply one_lt_ack_succ_left }

theorem one_lt_ack_succ_right : ∀ m n, 1 < ack m (n + 1)
| 0       n := by simp
| (m + 1) n := begin
  rw ack_succ_succ,
  cases exists_eq_succ_of_ne_zero (ack_pos (m + 1) n).ne',
  rw h,
  apply one_lt_ack_succ_right
end

theorem ack_strict_mono_right : ∀ m, strict_mono (ack m)
| 0 n₁ n₂ h := by simpa using h
| (m + 1) 0 (n + 1) h := begin
  rw [ack_succ_zero, ack_succ_succ],
  exact ack_strict_mono_right _ (one_lt_ack_succ_left m n)
end
| (m + 1) (n₁ + 1) (n₂ + 1) h := begin
  rw [ack_succ_succ, ack_succ_succ],
  apply ack_strict_mono_right _ (ack_strict_mono_right _ _),
  rwa add_lt_add_iff_right at h
end

theorem ack_mono_right (m : ℕ) : monotone (ack m) := (ack_strict_mono_right m).monotone

theorem ack_injective_right (m : ℕ) : function.injective (ack m) :=
(ack_strict_mono_right m).injective

@[simp] theorem ack_lt_iff_right {m n₁ n₂ : ℕ} : ack m n₁ < ack m n₂ ↔ n₁ < n₂ :=
(ack_strict_mono_right m).lt_iff_lt

@[simp] theorem ack_le_iff_right {m n₁ n₂ : ℕ} : ack m n₁ ≤ ack m n₂ ↔ n₁ ≤ n₂ :=
(ack_strict_mono_right m).le_iff_le

@[simp] theorem ack_inj_right {m n₁ n₂ : ℕ} : ack m n₁ = ack m n₂ ↔ n₁ = n₂ :=
(ack_injective_right m).eq_iff

theorem max_ack_right (m n₁ n₂ : ℕ) : ack m (max n₁ n₂) = max (ack m n₁) (ack m n₂) :=
(ack_mono_right m).map_max

theorem add_lt_ack : ∀ m n, m + n < ack m n
| 0       n       := by simp
| (m + 1) 0       := by simpa using add_lt_ack m 1
| (m + 1) (n + 1) :=
calc (m + 1) + n + 1
      ≤ m + (m + n + 2) : by linarith
  ... < ack m (m + n + 2) : add_lt_ack _ _
  ... ≤ ack m (ack (m + 1) n) : ack_mono_right m $
          le_of_eq_of_le (by ring_nf) $ succ_le_of_lt $ add_lt_ack (m + 1) n
  ... = ack (m + 1) (n + 1) : (ack_succ_succ m n).symm

theorem add_add_one_le_ack (m n : ℕ) : m + n + 1 ≤ ack m n := succ_le_of_lt (add_lt_ack m n)

theorem lt_ack_left (m n : ℕ) : m < ack m n := (self_le_add_right m n).trans_lt $ add_lt_ack m n
theorem lt_ack_right (m n : ℕ) : n < ack m n := (self_le_add_left n m).trans_lt $ add_lt_ack m n

-- we reorder the arguments to appease the equation compiler
private theorem ack_strict_mono_left' : ∀ {m₁ m₂} n, m₁ < m₂ → ack m₁ n < ack m₂ n
| m 0 n := λ h, (nat.not_lt_zero m h).elim
| 0 (m + 1) 0 := λ h, by simpa using one_lt_ack_succ_right m 0
| 0 (m + 1) (n + 1) := λ h, begin
  rw [ack_zero, ack_succ_succ],
  apply lt_of_le_of_lt (le_trans _ $ add_le_add_left (add_add_one_le_ack _ _) m) (add_lt_ack _ _),
  linarith
end
| (m₁ + 1) (m₂ + 1) 0 := λ h, by simpa using ack_strict_mono_left' 1 ((add_lt_add_iff_right 1).1 h)
| (m₁ + 1) (m₂ + 1) (n + 1) := λ h, begin
  rw [ack_succ_succ, ack_succ_succ],
  exact (ack_strict_mono_left' _ $ (add_lt_add_iff_right 1).1 h).trans
    (ack_strict_mono_right _ $ ack_strict_mono_left' n h)
end

theorem ack_strict_mono_left (n : ℕ) : strict_mono (λ m, ack m n) :=
λ m₁ m₂, ack_strict_mono_left' n

theorem ack_mono_left (n : ℕ) : monotone (λ m, ack m n) := (ack_strict_mono_left n).monotone

theorem ack_injective_left (n : ℕ) : function.injective (λ m, ack m n) :=
(ack_strict_mono_left n).injective

@[simp] theorem ack_lt_iff_left {m₁ m₂ n : ℕ} : ack m₁ n < ack m₂ n ↔ m₁ < m₂ :=
(ack_strict_mono_left n).lt_iff_lt

@[simp] theorem ack_le_iff_left {m₁ m₂ n : ℕ} : ack m₁ n ≤ ack m₂ n ↔ m₁ ≤ m₂ :=
(ack_strict_mono_left n).le_iff_le

@[simp] theorem ack_inj_left {m₁ m₂ n : ℕ} : ack m₁ n = ack m₂ n ↔ m₁ = m₂ :=
(ack_injective_left n).eq_iff

theorem max_ack_left (m₁ m₂ n : ℕ) : ack (max m₁ m₂) n = max (ack m₁ n) (ack m₂ n) :=
(ack_mono_left n).map_max

theorem ack_le_ack {m₁ m₂ n₁ n₂ : ℕ} (hm : m₁ ≤ m₂) (hn : n₁ ≤ n₂) : ack m₁ n₁ ≤ ack m₂ n₂ :=
(ack_mono_left n₁ hm).trans $ ack_mono_right m₂ hn

theorem ack_succ_right_le_ack_succ_left (m n : ℕ) : ack m (n + 1) ≤ ack (m + 1) n :=
begin
  cases n,
  { simp },
  { rw [ack_succ_succ, succ_eq_add_one],
    apply ack_mono_right m (le_trans _ $ add_add_one_le_ack _ n),
    linarith }
end

-- All the inequalities from this point onwards are specific to the main proof.

private theorem sq_le_two_pow_add_one_minus_three (n : ℕ) : n ^ 2 ≤ 2 ^ (n + 1) - 3 :=
begin
  induction n with k hk,
  { norm_num },
  { cases k,
    { norm_num },
    { rw [succ_eq_add_one, add_sq, pow_succ 2, two_mul (2 ^ _), add_tsub_assoc_of_le,
        add_comm (2 ^ _), add_assoc],
      { apply add_le_add hk,
        norm_num,
        apply succ_le_of_lt,
        rw [pow_succ, mul_lt_mul_left (zero_lt_two' ℕ)],
        apply lt_two_pow },
      { rw [pow_succ, pow_succ],
        linarith [one_le_pow k 2 zero_lt_two] } } }
end

theorem ack_add_one_sq_lt_ack_add_three : ∀ m n, (ack m n + 1) ^ 2 ≤ ack (m + 3) n
| 0       n       := by simpa using sq_le_two_pow_add_one_minus_three (n + 2)
| (m + 1) 0       := by { rw [ack_succ_zero, ack_succ_zero], apply ack_add_one_sq_lt_ack_add_three }
| (m + 1) (n + 1) := begin
  rw [ack_succ_succ, ack_succ_succ],
  apply (ack_add_one_sq_lt_ack_add_three _ _).trans (ack_mono_right _ $ ack_mono_left _ _),
  linarith
end

theorem ack_ack_lt_ack_max_add_two (m n k : ℕ) : ack m (ack n k) < ack (max m n + 2) k :=
calc ack m (ack n k)
      ≤ ack (max m n) (ack n k) : ack_mono_left _ (le_max_left _ _)
  ... < ack (max m n) (ack (max m n + 1) k) : ack_strict_mono_right _ $ ack_strict_mono_left k $
          lt_succ_of_le $ le_max_right m n
  ... = ack (max m n + 1) (k + 1) : (ack_succ_succ _ _).symm
  ... ≤ ack (max m n + 2) k : ack_succ_right_le_ack_succ_left _ _

theorem ack_add_one_sq_lt_ack_add_four (m n : ℕ) : ack m ((n + 1) ^ 2) < ack (m + 4) n :=
calc ack m ((n + 1) ^ 2)
      < ack m ((ack m n + 1) ^ 2) : ack_strict_mono_right m $
          pow_lt_pow_of_lt_left (succ_lt_succ $ lt_ack_right m n) zero_lt_two
  ... ≤ ack m (ack (m + 3) n) : ack_mono_right m $ ack_add_one_sq_lt_ack_add_three m n
  ... ≤ ack (m + 2) (ack (m + 3) n) : ack_mono_left _ $ by linarith
  ... = ack (m + 3) (n + 1) : (ack_succ_succ _ n).symm
  ... ≤ ack (m + 4) n : ack_succ_right_le_ack_succ_left _ n

theorem ack_mkpair_lt (m n k : ℕ) : ack m (mkpair n k) < ack (m + 4) (max n k) :=
(ack_strict_mono_right m $ mkpair_lt_max_add_one_sq n k).trans $ ack_add_one_sq_lt_ack_add_four _ _

/-- If `f` is primitive recursive, there exists `m` such that `f n < ack m n` for all `n`. -/
theorem exists_lt_ack_of_nat_primrec {f : ℕ → ℕ} (hf : nat.primrec f) : ∃ m, ∀ n, f n < ack m n :=
begin
  induction hf with f g hf hg IHf IHg f g hf hg IHf IHg f g hf hg IHf IHg,
  -- Zero function:
  { exact ⟨0, ack_pos 0⟩ },
  -- Successor function:
  { refine ⟨1, λ n, _⟩,
    rw succ_eq_one_add,
    apply add_lt_ack },
  -- Left projection:
  { refine ⟨0, λ n, _⟩,
    rw [ack_zero, lt_succ_iff],
    exact unpair_left_le n },
  -- Right projection:
  { refine ⟨0, λ n, _⟩,
    rw [ack_zero, lt_succ_iff],
    exact unpair_right_le n },
  all_goals { cases IHf with a ha, cases IHg with b hb },
  -- Pairing:
  { refine ⟨max a b + 3, λ n, (mkpair_lt_max_add_one_sq _ _).trans_le $
      (nat.pow_le_pow_of_le_left (add_le_add_right _ _) 2).trans $
        ack_add_one_sq_lt_ack_add_three _ _⟩,
    rw max_ack_left,
    exact max_le_max (ha n).le (hb n).le },
  -- Composition:
  { exact ⟨max a b + 2, λ n,
      (ha _).trans $ (ack_strict_mono_right a $ hb n).trans $ ack_ack_lt_ack_max_add_two a b n⟩ },
  -- Primitive recursion operator:
  { -- We prove this simpler inequality first.
    have : ∀ {m n}, elim (f m) (λ y IH, g $ mkpair m $ mkpair y IH) n < ack (max a b + 9) (m + n),
    { intros m n,
      -- We induct on n.
      induction n with n IH,
      -- The base case is easy.
      { apply (ha m).trans (ack_strict_mono_left m $ (le_max_left a b).trans_lt _),
        linarith },
      { -- We get rid of the first `mkpair`.
        rw elim_succ,
        apply (hb _).trans ((ack_mkpair_lt _ _ _).trans_le _),
        -- If m is the maximum, we get a very weak inequality.
        cases lt_or_le _ m with h₁ h₁,
        { rw max_eq_left h₁.le,
          exact ack_le_ack (add_le_add (le_max_right a b) $ by norm_num) (self_le_add_right m _) },
        rw max_eq_right h₁,
        -- We get rid of the second `mkpair`.
        apply (ack_mkpair_lt _ _ _).le.trans,
        -- If n is the maximum, we get a very weak inequality.
        cases lt_or_le _ n with h₂ h₂,
        { rw [max_eq_left h₂.le, add_assoc],
          exact ack_le_ack (add_le_add (le_max_right a b) $ by norm_num)
            ((le_succ n).trans $ self_le_add_left _ _) },
        rw max_eq_right h₂,
        -- We now use the inductive hypothesis, and some simple algebraic manipulation.
        apply (ack_strict_mono_right _ IH).le.trans,
        rw [add_succ m, add_succ _ 8, ack_succ_succ (_ + 8), add_assoc],
        exact ack_mono_left _ (add_le_add (le_max_right a b) le_rfl) } },
    -- The proof is now simple.
    exact ⟨max a b + 9, λ n, this.trans_le $ ack_mono_right _ $ unpair_add_le n⟩ }
end

theorem not_nat_primrec_ack_self : ¬ nat.primrec (λ n, ack n n) :=
λ h, by { cases exists_lt_ack_of_nat_primrec h with m hm, exact (hm m).false }

theorem not_primrec_ack_self : ¬ _root_.primrec (λ n, ack n n) :=
by { rw primrec.nat_iff, exact not_nat_primrec_ack_self }

/-- The Ackermann function is not primitive recursive. -/
theorem not_primrec₂_ack : ¬ primrec₂ ack :=
λ h, not_primrec_ack_self $ h.comp primrec.id primrec.id


/-
© 2021 by the Rector and Visitors of the University of Virginia
-/

import algebra.module.basic
import linear_algebra.affine_space.affine_equiv

-- Let K be a non-empty field
universes u
variables (K : Type u) [field K] [inhabited K]

lemma add_smul_l2 : ∀ (r s : K) (x : K × K), (r + s) • x = r • x + s • x :=
begin
  intros,
  ext,
  simp *,
  exact right_distrib r s _,
  simp *,
  exact right_distrib r s _,
end
lemma zero_smul_l2 : ∀ (x : K × K), (0 : K) • x = 0 :=
begin
  intros,
  ext,
  simp *,
  simp *,
end

instance module_K_KxK : module K (K × K) :=
⟨ add_smul_l2 K, zero_smul_l2 K ⟩


/-
Copyright (c) 2022 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import data.set.intervals.ord_connected
import tactic.wlog

/-!
# Order connected components of a set

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

In this file we define `set.ord_connected_component s x` to be the set of `y` such that
`set.uIcc x y ⊆ s` and prove some basic facts about this definition. At the moment of writing,
this construction is used only to prove that any linear order with order topology is a T₅ space,
so we only add API needed for this lemma.
-/

open function order_dual
open_locale interval

namespace set

variables {α : Type*} [linear_order α] {s t : set α} {x y z : α}

/-- Order-connected component of a point `x` in a set `s`. It is defined as the set of `y` such that
`set.uIcc x y ⊆ s`. Note that it is empty if and only if `x ∉ s`. -/
def ord_connected_component (s : set α) (x : α) : set α := {y | [x, y] ⊆ s}

lemma mem_ord_connected_component : y ∈ ord_connected_component s x ↔ [x, y] ⊆ s := iff.rfl

lemma dual_ord_connected_component :
  ord_connected_component (of_dual ⁻¹' s) (to_dual x) = of_dual ⁻¹' (ord_connected_component s x) :=
ext $ to_dual.surjective.forall.2 $ λ x,
  by { rw [mem_ord_connected_component, dual_uIcc], refl }

lemma ord_connected_component_subset : ord_connected_component s x ⊆ s := λ y hy, hy right_mem_uIcc

lemma subset_ord_connected_component {t} [h : ord_connected s] (hs : x ∈ s) (ht : s ⊆ t) :
  s ⊆ ord_connected_component t x :=
λ y hy, (h.uIcc_subset hs hy).trans ht

@[simp] lemma self_mem_ord_connected_component : x ∈ ord_connected_component s x ↔ x ∈ s :=
by rw [mem_ord_connected_component, uIcc_self, singleton_subset_iff]

@[simp] lemma nonempty_ord_connected_component : (ord_connected_component s x).nonempty ↔ x ∈ s :=
⟨λ ⟨y, hy⟩, hy $ left_mem_uIcc, λ h, ⟨x, self_mem_ord_connected_component.2 h⟩⟩

@[simp] lemma ord_connected_component_eq_empty : ord_connected_component s x = ∅ ↔ x ∉ s :=
by rw [← not_nonempty_iff_eq_empty, nonempty_ord_connected_component]

@[simp] lemma ord_connected_component_empty : ord_connected_component ∅ x = ∅ :=
ord_connected_component_eq_empty.2 (not_mem_empty x)

@[simp] lemma ord_connected_component_univ : ord_connected_component univ x = univ :=
by simp [ord_connected_component]

lemma ord_connected_component_inter (s t : set α) (x : α) :
  ord_connected_component (s ∩ t) x = ord_connected_component s x ∩ ord_connected_component t x :=
by simp [ord_connected_component, set_of_and]

lemma mem_ord_connected_component_comm :
  y ∈ ord_connected_component s x ↔ x ∈ ord_connected_component s y :=
by rw [mem_ord_connected_component, mem_ord_connected_component, uIcc_comm]

lemma mem_ord_connected_component_trans (hxy : y ∈ ord_connected_component s x)
  (hyz : z ∈ ord_connected_component s y) : z ∈ ord_connected_component s x :=
calc [x, z] ⊆ [x, y] ∪ [y, z] : uIcc_subset_uIcc_union_uIcc
... ⊆ s : union_subset hxy hyz

lemma ord_connected_component_eq (h : [x, y] ⊆ s) :
  ord_connected_component s x = ord_connected_component s y :=
ext $ λ z, ⟨mem_ord_connected_component_trans (mem_ord_connected_component_comm.2 h),
  mem_ord_connected_component_trans h⟩

instance : ord_connected (ord_connected_component s x) :=
ord_connected_of_uIcc_subset_left $ λ y hy z hz, (uIcc_subset_uIcc_left hz).trans hy

/-- Projection from `s : set α` to `α` sending each order connected component of `s` to a single
point of this component. -/
noncomputable def ord_connected_proj (s : set α) : s → α :=
λ x : s, (nonempty_ord_connected_component.2 x.prop).some

lemma ord_connected_proj_mem_ord_connected_component (s : set α) (x : s) :
  ord_connected_proj s x ∈ ord_connected_component s x :=
nonempty.some_mem _

lemma mem_ord_connected_component_ord_connected_proj (s : set α) (x : s) :
  ↑x ∈ ord_connected_component s (ord_connected_proj s x) :=
mem_ord_connected_component_comm.2 $ ord_connected_proj_mem_ord_connected_component s x

@[simp] lemma ord_connected_component_ord_connected_proj (s : set α) (x : s) :
  ord_connected_component s (ord_connected_proj s x) = ord_connected_component s x :=
ord_connected_component_eq $ mem_ord_connected_component_ord_connected_proj _ _

@[simp] lemma ord_connected_proj_eq {x y : s} :
  ord_connected_proj s x = ord_connected_proj s y ↔ [(x : α), y] ⊆ s :=
begin
  split; intro h,
  { rw [← mem_ord_connected_component, ← ord_connected_component_ord_connected_proj, h,
      ord_connected_component_ord_connected_proj, self_mem_ord_connected_component],
    exact y.2 },
  { simp only [ord_connected_proj],
    congr' 1,
    exact ord_connected_component_eq h }
end

/-- A set that intersects each order connected component of a set by a single point. Defined as the
range of `set.ord_connected_proj s`. -/
def ord_connected_section (s : set α) : set α := range $ ord_connected_proj s

lemma dual_ord_connected_section (s : set α) :
  ord_connected_section (of_dual ⁻¹' s) = of_dual ⁻¹' (ord_connected_section s) :=
begin
  simp only [ord_connected_section, ord_connected_proj],
  congr' 1 with x, simp only, congr' 1,
  exact dual_ord_connected_component
end

lemma ord_connected_section_subset : ord_connected_section s ⊆ s :=
range_subset_iff.2 $ λ x, ord_connected_component_subset $ nonempty.some_mem _

lemma eq_of_mem_ord_connected_section_of_uIcc_subset (hx : x ∈ ord_connected_section s)
  (hy : y ∈ ord_connected_section s) (h : [x, y] ⊆ s) : x = y :=
begin
  rcases hx with ⟨x, rfl⟩, rcases hy with ⟨y, rfl⟩,
  exact ord_connected_proj_eq.2 (mem_ord_connected_component_trans
    (mem_ord_connected_component_trans (ord_connected_proj_mem_ord_connected_component _ _) h)
    (mem_ord_connected_component_ord_connected_proj _ _))
end

/-- Given two sets `s t : set α`, the set `set.order_separating_set s t` is the set of points that
belong both to some `set.ord_connected_component tᶜ x`, `x ∈ s`, and to some
`set.ord_connected_component sᶜ x`, `x ∈ t`. In the case of two disjoint closed sets, this is the
union of all open intervals $(a, b)$ such that their endpoints belong to different sets. -/
def ord_separating_set (s t : set α) : set α :=
(⋃ x ∈ s, ord_connected_component tᶜ x) ∩ (⋃ x ∈ t, ord_connected_component sᶜ x)

lemma ord_separating_set_comm (s t : set α) :
  ord_separating_set s t = ord_separating_set t s :=
inter_comm _ _

lemma disjoint_left_ord_separating_set : disjoint s (ord_separating_set s t) :=
disjoint.inter_right' _ $ disjoint_Union₂_right.2 $ λ x hx, disjoint_compl_right.mono_right $
  ord_connected_component_subset

lemma disjoint_right_ord_separating_set : disjoint t (ord_separating_set s t) :=
ord_separating_set_comm t s ▸ disjoint_left_ord_separating_set

lemma dual_ord_separating_set :
  ord_separating_set (of_dual ⁻¹' s) (of_dual ⁻¹' t) = of_dual ⁻¹' (ord_separating_set s t) :=
by simp only [ord_separating_set, mem_preimage, ← to_dual.surjective.Union_comp, of_dual_to_dual,
  dual_ord_connected_component, ← preimage_compl, preimage_inter, preimage_Union]

/-- An auxiliary neighborhood that will be used in the proof of `order_topology.t5_space`. -/
def ord_t5_nhd (s t : set α) : set α :=
⋃ x ∈ s, ord_connected_component (tᶜ ∩ (ord_connected_section $ ord_separating_set s t)ᶜ) x

lemma disjoint_ord_t5_nhd : disjoint (ord_t5_nhd s t) (ord_t5_nhd t s) :=
begin
  rw disjoint_iff_inf_le,
  rintro x ⟨hx₁, hx₂⟩,
  rcases mem_Union₂.1 hx₁ with ⟨a, has, ha⟩, clear hx₁,
  rcases mem_Union₂.1 hx₂ with ⟨b, hbt, hb⟩, clear hx₂,
  rw [mem_ord_connected_component, subset_inter_iff] at ha hb,
  wlog hab : a ≤ b,
  { exact this b hbt a has ha hb (le_of_not_le hab) },
  cases ha with ha ha', cases hb with hb hb',
  have hsub : [a, b] ⊆ (ord_separating_set s t).ord_connected_sectionᶜ,
  { rw [ord_separating_set_comm, uIcc_comm] at hb',
    calc [a, b] ⊆ [a, x] ∪ [x, b] : uIcc_subset_uIcc_union_uIcc
    ... ⊆ (ord_separating_set s t).ord_connected_sectionᶜ : union_subset ha' hb' },
  clear ha' hb',
  cases le_total x a with hxa hax,
  { exact hb (Icc_subset_uIcc' ⟨hxa, hab⟩) has },
  cases le_total b x with hbx hxb,
  { exact ha (Icc_subset_uIcc ⟨hab, hbx⟩) hbt },
  have : x ∈ ord_separating_set s t,
  { exact ⟨mem_Union₂.2 ⟨a, has, ha⟩, mem_Union₂.2 ⟨b, hbt, hb⟩⟩ },
  lift x to ord_separating_set s t using this,
  suffices : ord_connected_component (ord_separating_set s t) x ⊆ [a, b],
    from hsub (this $ ord_connected_proj_mem_ord_connected_component _ _) (mem_range_self _),
  rintros y (hy : [↑x, y] ⊆ ord_separating_set s t),
  rw [uIcc_of_le hab, mem_Icc, ← not_lt, ← not_lt],
  exact ⟨λ hya, disjoint_left.1 disjoint_left_ord_separating_set has
    (hy $ Icc_subset_uIcc' ⟨hya.le, hax⟩),
    λ hyb, disjoint_left.1 disjoint_right_ord_separating_set hbt
      (hy $ Icc_subset_uIcc ⟨hxb, hyb.le⟩)⟩
end

end set


import tactic --hide

/-
`split` can also be used for if and only if statements. For example, if you have `⊢ P ↔ Q` and apply
`split`, then your goal will change from

```
⊢ P ↔ Q
```
to two goals, `⊢ P → Q` and `⊢ Q → P`.
-/

/- Lemma
Let $P$ be a logical statement, then $P$ is true if and only if $P$ is true.
-/
lemma split_examle_two (P : Prop) : P ↔ P :=
begin
  split,
  intro p,
  exact p,
  intro p,
  exact p,
end

/- Tactic : split

If your lemma has the goal:

```
⊢ P ∧ Q
```

then the  `split` tactic will turn it into *two* goals `⊢ P` and `⊢ Q`.

Moreover, if you have an iff `P ↔ Q` then splitting it will give you two goals, `P → Q`
(i.e "`P` only if `Q`") and `P ← Q ` (i.e "`P` if `Q`") to prove.

-/


import .term

@[reducible] def clause := (list term) × (list term)

namespace clause

def weaker : clause → clause → Prop
| ⟨eqs1,les1⟩ ⟨eqs2,les2⟩ := eqs1 ⊆ eqs2 ∧ les1 ⊆ les2

def holds (v) : clause → Prop
| (eqs,les) :=
  ( (∀ t : term, t ∈ eqs → 0 = term.val v t)
    ∧ (∀ t : term, t ∈ les → 0 ≤ term.val v t) )

lemma holds_of_weaker {v c1 c2} :
  weaker c1 c2 → holds v c2 → holds v c1 :=
begin
  intros h1 h2,
  cases c1 with eqs1 les1,
  cases c2 with eqs2 les2,
  constructor,
  { apply list.forall_mem_of_subset h1.left h2.left },
  { apply list.forall_mem_of_subset h1.right h2.right },
end

def sat (c : clause) : Prop :=
  ∃ v : nat → int, holds v c

lemma sat_of_weaker { c1 c2} :
  weaker c1 c2 → sat c2 → sat c1 :=
begin
  intros h1 h2, cases h2 with v h2,
  refine ⟨v,holds_of_weaker h1 h2⟩,
end

def unsat (c : clause) : Prop := ¬ c.sat

def append (c1 c2 : clause) : clause :=
(c1.fst ++ c2.fst, c1.snd ++ c2.snd)

def holds_append {v c1 c2} :
holds v c1 → holds v c2 → holds v (append c1 c2) :=
begin
  intros h1 h2,
  cases c1 with eqs1 les1,
  cases c2 with eqs2 les2,
  cases h1, cases h2,
  constructor; rw list.forall_mem_append;
  constructor; assumption,
end

end clause

def clauses.sat (ps : list clause) : Prop :=
∃ c ∈ ps, clause.sat c

def clauses.unsat (ps) : Prop := ¬ clauses.sat ps

lemma clauses.unsat_nil : clauses.unsat [] :=
begin intro h1, rcases h1 with ⟨c,h1,h2⟩, cases h1 end

lemma clauses.unsat_cons (p ps) :
  clause.unsat p → clauses.unsat ps →
  clauses.unsat (p::ps) | h1 h2 h3 :=
begin
  simp only [clauses.sat] at h3,
  rw list.exists_mem_cons_iff at h3,
  cases h3; contradiction,
end


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov, Johannes Hölzl

! This file was ported from Lean 3 source module dynamics.fixed_points.topology
! leanprover-community/mathlib commit 4c19a16e4b705bf135cf9a80ac18fcc99c438514
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Dynamics.FixedPoints.Basic
import Mathbin.Topology.Separation

/-!
# Topological properties of fixed points

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

Currently this file contains two lemmas:

- `is_fixed_pt_of_tendsto_iterate`: if `f^n(x) → y` and `f` is continuous at `y`, then `f y = y`;
- `is_closed_fixed_points`: the set of fixed points of a continuous map is a closed set.

## TODO

fixed points, iterates
-/

variable {α : Type _} [TopologicalSpace α] [T2Space α] {f : α → α}

open Function Filter

open Topology

#print isFixedPt_of_tendsto_iterate /-
/-- If the iterates `f^[n] x` converge to `y` and `f` is continuous at `y`,
then `y` is a fixed point for `f`. -/
theorem isFixedPt_of_tendsto_iterate {x y : α} (hy : Tendsto (fun n => (f^[n]) x) atTop (𝓝 y))
    (hf : ContinuousAt f y) : IsFixedPt f y :=
  by
  refine' tendsto_nhds_unique ((tendsto_add_at_top_iff_nat 1).1 _) hy
  simp only [iterate_succ' f]
  exact hf.tendsto.comp hy
#align is_fixed_pt_of_tendsto_iterate isFixedPt_of_tendsto_iterate
-/

#print isClosed_fixedPoints /-
/-- The set of fixed points of a continuous map is a closed set. -/
theorem isClosed_fixedPoints (hf : Continuous f) : IsClosed (fixedPoints f) :=
  isClosed_eq hf continuous_id
#align is_closed_fixed_points isClosed_fixedPoints
-/


import tactic
import group_theory.subgroup.basic

open subgroup

variables {G : Type} [group G]

namespace pullback

variables {H K : Type} [group H] [group K]
  (i : H →* G) (j : K →* G)

def pullback : subgroup (H × K) :=
{ carrier := {x | i x.1 = j x.2},
  one_mem' := by simp,
  mul_mem' := by simp {contextual := tt},
  inv_mem' := by simp {contextual := tt} }

def fst : pullback i j →* H :=
{ to_fun := λ x, x.1.1,
  map_one' := rfl,
  map_mul' := λ _ _, rfl }

def snd : pullback i j →* K :=
{ to_fun := λ x, x.1.2,
  map_one' := rfl,
  map_mul' := λ _ _, rfl }

lemma comp_fst_eq_comp_snd : i.comp (fst i j) = j.comp (snd i j) :=
monoid_hom.ext $ λ x, x.2

def restrict {L : Type} [group L] (f : L →* H) (g : L →* K)
  (hfg : i.comp f = j.comp g) : L →* pullback i j :=
{ to_fun := λ x, ⟨⟨f x, g x⟩, monoid_hom.congr_fun hfg x⟩,
  map_one' := subtype.ext (prod.ext (map_one f) (map_one g)),
  map_mul' := λ a b, subtype.ext (prod.ext (map_mul f _ _) (map_mul g _ _)) }

@[simp] lemma fst_comp_restrict {L : Type} [group L] (f : L →* H) (g : L →* K)
  (hfg : i.comp f = j.comp g) :
  (fst i j).comp (restrict i j f g hfg) = f :=
monoid_hom.ext (λ _, rfl)

@[simp] lemma snd_comp_restrict {L : Type} [group L] (f : L →* H) (g : L →* K)
  (hfg : i.comp f = j.comp g) :
  (snd i j).comp (restrict i j f g hfg) = g :=
monoid_hom.ext (λ _, rfl)

@[simp] lemma fst_restrict {L : Type} [group L] (f : L →* H) (g : L →* K)
  (hfg : i.comp f = j.comp g) (x : L) :
  fst i j (restrict i j f g hfg x) = f x :=
rfl

@[simp] lemma snd_restrict {L : Type} [group L] (f : L →* H) (g : L →* K)
  (hfg : i.comp f = j.comp g) (x : L) :
  snd i j (restrict i j f g hfg x) = g x :=
rfl

@[ext] lemma hom_ext {L : Type} [group L] {f g : L →* pullback i j}
  (h1 : (fst i j).comp f = (fst i j).comp g)
  (h2 : (snd i j).comp f = (snd i j).comp g) :
  f = g :=
monoid_hom.ext (λ x, subtype.ext (prod.ext
  (monoid_hom.congr_fun h1 x)
  (monoid_hom.congr_fun h2 x)))

end pullback


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

import analysis.normed.group.basic

/-!
# Hamming spaces

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

The Hamming metric counts the number of places two members of a (finite) Pi type
differ. The Hamming norm is the same as the Hamming metric over additive groups, and
counts the number of places a member of a (finite) Pi type differs from zero.

This is a useful notion in various applications, but in particular it is relevant
in coding theory, in which it is fundamental for defining the minimum distance of a
code.

## Main definitions
* `hamming_dist x y`: the Hamming distance between `x` and `y`, the number of entries which differ.
* `hamming_norm x`: the Hamming norm of `x`, the number of non-zero entries.
* `hamming β`: a type synonym for `Π i, β i` with `dist` and `norm` provided by the above.
* `hamming.to_hamming`, `hamming.of_hamming`: functions for casting between `hamming β` and
`Π i, β i`.
* `hamming.normed_add_comm_group`: the Hamming norm forms a normed group on `hamming β`.
-/
section hamming_dist_norm

open finset function

variables {α ι : Type*} {β : ι → Type*} [fintype ι] [Π i, decidable_eq (β i)]
variables {γ : ι → Type*} [Π i, decidable_eq (γ i)]

/-- The Hamming distance function to the naturals. -/
def hamming_dist (x y : Π i, β i) : ℕ := (univ.filter (λ i, x i ≠ y i)).card

/-- Corresponds to `dist_self`. -/
@[simp] lemma hamming_dist_self (x : Π i, β i) : hamming_dist x x = 0 :=
by { rw [hamming_dist, card_eq_zero, filter_eq_empty_iff], exact λ _ _ H, H rfl }

/-- Corresponds to `dist_nonneg`. -/
lemma hamming_dist_nonneg {x y : Π i, β i} : 0 ≤ hamming_dist x y := zero_le _

/-- Corresponds to `dist_comm`. -/
lemma hamming_dist_comm (x y : Π i, β i) : hamming_dist x y = hamming_dist y x :=
by simp_rw [hamming_dist, ne_comm]

/-- Corresponds to `dist_triangle`. -/
lemma hamming_dist_triangle (x y z : Π i, β i) :
  hamming_dist x z ≤ hamming_dist x y + hamming_dist y z :=
begin
  classical, simp_rw hamming_dist, refine le_trans (card_mono _) (card_union_le _ _),
  rw ← filter_or, refine monotone_filter_right _ _, intros i h,
  by_contra' H, exact h (eq.trans H.1 H.2)
end

/-- Corresponds to `dist_triangle_left`. -/
lemma hamming_dist_triangle_left (x y z : Π i, β i) :
  hamming_dist x y ≤ hamming_dist z x + hamming_dist z y :=
by { rw hamming_dist_comm z, exact hamming_dist_triangle _ _ _ }

/-- Corresponds to `dist_triangle_right`. -/
lemma hamming_dist_triangle_right (x y z : Π i, β i) :
  hamming_dist x y ≤ hamming_dist x z + hamming_dist y z :=
by { rw hamming_dist_comm y, exact hamming_dist_triangle _ _ _ }

/-- Corresponds to `swap_dist`. -/
theorem swap_hamming_dist : swap (@hamming_dist _ β _ _) = hamming_dist :=
by { funext x y, exact hamming_dist_comm _ _ }

/-- Corresponds to `eq_of_dist_eq_zero`. -/
lemma eq_of_hamming_dist_eq_zero {x y : Π i, β i} : hamming_dist x y = 0 → x = y :=
by simp_rw [hamming_dist, card_eq_zero, filter_eq_empty_iff, not_not,
            funext_iff,  mem_univ, forall_true_left, imp_self]

/-- Corresponds to `dist_eq_zero`. -/
@[simp] lemma hamming_dist_eq_zero {x y : Π i, β i} : hamming_dist x y = 0 ↔ x = y :=
⟨eq_of_hamming_dist_eq_zero, (λ H, by {rw H, exact hamming_dist_self _})⟩

/-- Corresponds to `zero_eq_dist`. -/
@[simp] lemma hamming_zero_eq_dist {x y : Π i, β i} : 0 = hamming_dist x y ↔ x = y :=
by rw [eq_comm, hamming_dist_eq_zero]

/-- Corresponds to `dist_ne_zero`. -/
lemma hamming_dist_ne_zero {x y : Π i, β i} : hamming_dist x y ≠ 0 ↔ x ≠ y :=
hamming_dist_eq_zero.not

/-- Corresponds to `dist_pos`. -/
@[simp] lemma hamming_dist_pos {x y : Π i, β i} : 0 < hamming_dist x y ↔ x ≠ y :=
by rw [←hamming_dist_ne_zero, iff_not_comm, not_lt, le_zero_iff]

@[simp] lemma hamming_dist_lt_one {x y : Π i, β i} : hamming_dist x y < 1 ↔ x = y :=
by rw [nat.lt_one_iff, hamming_dist_eq_zero]

lemma hamming_dist_le_card_fintype {x y : Π i, β i} :
  hamming_dist x y ≤ fintype.card ι := card_le_univ _

lemma hamming_dist_comp_le_hamming_dist (f : Π i, γ i → β i) {x y : Π i, γ i} :
  hamming_dist (λ i, f i (x i)) (λ i, f i (y i)) ≤ hamming_dist x y :=
card_mono (monotone_filter_right _ $ λ i H1 H2, H1 $ congr_arg (f i) H2)

lemma hamming_dist_comp (f : Π i, γ i → β i) {x y : Π i, γ i} (hf : Π i, injective (f i)) :
  hamming_dist (λ i, f i (x i)) (λ i, f i (y i)) = hamming_dist x y :=
begin
  refine le_antisymm (hamming_dist_comp_le_hamming_dist _) _,
  exact card_mono (monotone_filter_right _ $ λ i H1 H2, H1 $ hf i H2)
end

lemma hamming_dist_smul_le_hamming_dist [Π i, has_smul α (β i)] {k : α} {x y : Π i, β i} :
  hamming_dist (k • x) (k • y) ≤ hamming_dist x y :=
hamming_dist_comp_le_hamming_dist $ λ i, (•) k

/-- Corresponds to `dist_smul` with the discrete norm on `α`. -/
lemma hamming_dist_smul [Π i, has_smul α (β i)] {k : α} {x y : Π i, β i}
  (hk : Π i, is_smul_regular (β i) k) : hamming_dist (k • x) (k • y) = hamming_dist x y :=
hamming_dist_comp (λ i, (•) k) hk

section has_zero

variables [Π i, has_zero (β i)] [Π i, has_zero (γ i)]

/-- The Hamming weight function to the naturals. -/
def hamming_norm (x : Π i, β i) : ℕ := (univ.filter (λ i, x i ≠ 0)).card

/-- Corresponds to `dist_zero_right`. -/
@[simp] lemma hamming_dist_zero_right (x : Π i, β i) : hamming_dist x 0 = hamming_norm x := rfl

/-- Corresponds to `dist_zero_left`. -/
@[simp] lemma hamming_dist_zero_left : hamming_dist (0 : Π i, β i) = hamming_norm :=
funext $ λ x, by rw [hamming_dist_comm, hamming_dist_zero_right]

/-- Corresponds to `norm_nonneg`. -/
@[simp] lemma hamming_norm_nonneg {x : Π i, β i} : 0 ≤ hamming_norm x := zero_le _

/-- Corresponds to `norm_zero`. -/
@[simp] lemma hamming_norm_zero : hamming_norm (0 : Π i, β i) = 0 := hamming_dist_self _

/-- Corresponds to `norm_eq_zero`. -/
@[simp] lemma hamming_norm_eq_zero {x : Π i, β i} : hamming_norm x = 0 ↔ x = 0 :=
hamming_dist_eq_zero

/-- Corresponds to `norm_ne_zero_iff`. -/
lemma hamming_norm_ne_zero_iff {x : Π i, β i} : hamming_norm x ≠ 0 ↔ x ≠ 0 :=
hamming_norm_eq_zero.not

/-- Corresponds to `norm_pos_iff`. -/
@[simp] lemma hamming_norm_pos_iff {x : Π i, β i} : 0 < hamming_norm x ↔ x ≠ 0 := hamming_dist_pos

@[simp] lemma hamming_norm_lt_one {x : Π i, β i} : hamming_norm x < 1 ↔ x = 0 := hamming_dist_lt_one

lemma hamming_norm_le_card_fintype {x : Π i, β i} : hamming_norm x ≤ fintype.card ι :=
hamming_dist_le_card_fintype

lemma hamming_norm_comp_le_hamming_norm (f : Π i, γ i → β i) {x : Π i, γ i} (hf : Π i, f i 0 = 0) :
  hamming_norm (λ i, f i (x i)) ≤ hamming_norm x :=
by {convert hamming_dist_comp_le_hamming_dist f, simp_rw hf, refl}

lemma hamming_norm_comp (f : Π i, γ i → β i) {x : Π i, γ i} (hf₁ : Π i, injective (f i))
  (hf₂ : Π i, f i 0 = 0) : hamming_norm (λ i, f i (x i)) = hamming_norm x :=
by {convert hamming_dist_comp f hf₁, simp_rw hf₂, refl}

lemma hamming_norm_smul_le_hamming_norm [has_zero α] [Π i, smul_with_zero α (β i)] {k : α}
  {x : Π i, β i} : hamming_norm (k • x) ≤ hamming_norm x :=
hamming_norm_comp_le_hamming_norm (λ i (c : β i), k • c) (λ i, by simp_rw smul_zero)

lemma hamming_norm_smul [has_zero α] [Π i, smul_with_zero α (β i)] {k : α}
  (hk : ∀ i, is_smul_regular (β i) k) (x : Π i, β i) : hamming_norm (k • x) = hamming_norm x :=
hamming_norm_comp (λ i (c : β i), k • c) hk (λ i, by simp_rw smul_zero)

end has_zero

/-- Corresponds to `dist_eq_norm`. -/
lemma hamming_dist_eq_hamming_norm [Π i, add_group (β i)] (x y : Π i, β i) :
  hamming_dist x y = hamming_norm (x - y) :=
by simp_rw [hamming_norm, hamming_dist, pi.sub_apply, sub_ne_zero]

end hamming_dist_norm

/-! ### The `hamming` type synonym -/

/-- Type synonym for a Pi type which inherits the usual algebraic instances, but is equipped with
the Hamming metric and norm, instead of `pi.normed_add_comm_group` which uses the sup norm. -/
def hamming {ι : Type*} (β : ι → Type*) : Type* := Π i, β i

namespace hamming

variables {α ι : Type*} {β : ι → Type*}

/-! Instances inherited from normal Pi types. -/

instance [Π i, inhabited (β i)] : inhabited (hamming β) := ⟨λ i, default⟩
instance [decidable_eq ι] [fintype ι] [Π i, fintype (β i)] : fintype (hamming β) := pi.fintype
instance [inhabited ι] [∀ i, nonempty (β i)] [nontrivial (β default)] :
  nontrivial (hamming β) := pi.nontrivial
instance [fintype ι] [Π i, decidable_eq (β i)] : decidable_eq (hamming β) :=
fintype.decidable_pi_fintype

instance [Π i, has_zero (β i)]    : has_zero (hamming β) := pi.has_zero
instance [Π i, has_neg (β i)]     : has_neg (hamming β) := pi.has_neg
instance [Π i, has_add (β i)]     : has_add (hamming β) := pi.has_add
instance [Π i, has_sub (β i)]     : has_sub (hamming β) := pi.has_sub
instance [Π i, has_smul α (β i)]  : has_smul α (hamming β) := pi.has_smul

instance [has_zero α] [Π i, has_zero (β i)] [Π i, smul_with_zero α (β i)] :
  smul_with_zero α (hamming β) := pi.smul_with_zero _
instance [Π i, add_monoid (β i)] : add_monoid (hamming β) := pi.add_monoid
instance [Π i, add_comm_monoid (β i)] : add_comm_monoid (hamming β) := pi.add_comm_monoid
instance [Π i, add_comm_group (β i)] : add_comm_group (hamming β) := pi.add_comm_group
instance (α) [semiring α] (β : ι → Type*) [Π i, add_comm_monoid (β i)]
  [Π i, module α (β i)] : module α (hamming β) := pi.module _ _ _

/-! API to/from the type synonym. -/

/-- `to_hamming` is the identity function to the `hamming` of a type.  -/
@[pattern] def to_hamming : (Π i, β i) ≃ hamming β := equiv.refl _

/-- `of_hamming` is the identity function from the `hamming` of a type.  -/
@[pattern] def of_hamming : hamming β ≃ Π i, β i := equiv.refl _

@[simp] lemma to_hamming_symm_eq : (@to_hamming _ β).symm = of_hamming := rfl
@[simp] lemma of_hamming_symm_eq : (@of_hamming _ β).symm = to_hamming := rfl
@[simp] lemma to_hamming_of_hamming (x : hamming β) : to_hamming (of_hamming x) = x := rfl
@[simp] lemma of_hamming_to_hamming (x : Π i, β i) : of_hamming (to_hamming x) = x := rfl
@[simp] lemma to_hamming_inj {x y : Π i, β i} : to_hamming x = to_hamming y ↔ x = y := iff.rfl
@[simp] lemma of_hamming_inj {x y : hamming β} : of_hamming x = of_hamming y ↔ x = y := iff.rfl

@[simp] lemma to_hamming_zero [Π i, has_zero (β i)] : to_hamming (0 : Π i, β i) = 0 := rfl
@[simp] lemma of_hamming_zero [Π i, has_zero (β i)] : of_hamming (0 : hamming β) = 0 := rfl
@[simp] lemma to_hamming_neg [Π i, has_neg (β i)] {x : Π i, β i} :
  to_hamming (-x) = - to_hamming x := rfl
@[simp] lemma of_hamming_neg [Π i, has_neg (β i)] {x : hamming β} :
  of_hamming (-x)  = - of_hamming x := rfl
@[simp] lemma to_hamming_add [Π i, has_add (β i)] {x y : Π i, β i} :
  to_hamming (x + y) = to_hamming x + to_hamming y := rfl
@[simp] lemma of_hamming_add [Π i, has_add (β i)] {x y : hamming β} :
  of_hamming (x + y) = of_hamming x + of_hamming y := rfl
@[simp] lemma to_hamming_sub [Π i, has_sub (β i)] {x y : Π i, β i} :
  to_hamming (x - y) = to_hamming x - to_hamming y := rfl
@[simp] lemma of_hamming_sub [Π i, has_sub (β i)] {x y : hamming β} :
  of_hamming (x - y) = of_hamming x - of_hamming y := rfl
@[simp] lemma to_hamming_smul [Π i, has_smul α (β i)] {r : α} {x : Π i, β i} :
  to_hamming (r • x) = r • to_hamming x := rfl
@[simp] lemma of_hamming_smul [Π i, has_smul α (β i)] {r : α} {x : hamming β} :
  of_hamming (r • x) = r • of_hamming x := rfl

section

/-! Instances equipping `hamming` with `hamming_norm` and `hamming_dist`. -/

variables [fintype ι] [Π i, decidable_eq (β i)]

instance : has_dist (hamming β) := ⟨λ x y, hamming_dist (of_hamming x) (of_hamming y)⟩

@[simp, push_cast]

instance : pseudo_metric_space (hamming β) :=
{ dist_self        := by { push_cast, exact_mod_cast hamming_dist_self },
  dist_comm        := by { push_cast, exact_mod_cast hamming_dist_comm },
  dist_triangle    := by { push_cast, exact_mod_cast hamming_dist_triangle },
  to_uniform_space := ⊥,
  uniformity_dist  := uniformity_dist_of_mem_uniformity _ _ $ λ s, begin
    push_cast,
    split,
    { refine λ hs, ⟨1, zero_lt_one, λ _ _ hab, _⟩,
      rw_mod_cast [hamming_dist_lt_one] at hab,
      rw [of_hamming_inj, ← mem_id_rel] at hab,
      exact hs hab },
    { rintros ⟨_, hε, hs⟩ ⟨_, _⟩ hab,
      rw mem_id_rel at hab,
      rw hab,
      refine hs (lt_of_eq_of_lt _ hε),
      exact_mod_cast hamming_dist_self _ }
  end,
  to_bornology     := ⟨⊥, bot_le⟩,
  cobounded_sets   := begin
    ext,
    push_cast,
    refine iff_of_true (filter.mem_sets.mpr filter.mem_bot) ⟨fintype.card ι, λ _ _ _ _, _⟩,
    exact_mod_cast hamming_dist_le_card_fintype
  end,
  ..hamming.has_dist }

@[simp, push_cast] lemma nndist_eq_hamming_dist (x y : hamming β) :
  nndist x y = hamming_dist (of_hamming x) (of_hamming y) := rfl

instance : metric_space (hamming β) :=
{ eq_of_dist_eq_zero  :=
  by { push_cast, exact_mod_cast @eq_of_hamming_dist_eq_zero _ _ _ _ },
  ..hamming.pseudo_metric_space }

instance [Π i, has_zero (β i)] : has_norm (hamming β) := ⟨λ x, hamming_norm (of_hamming x)⟩

@[simp, push_cast] lemma norm_eq_hamming_norm [Π i, has_zero (β i)] (x : hamming β) :
  ‖x‖ = hamming_norm (of_hamming x) := rfl

instance [Π i, add_comm_group (β i)] : seminormed_add_comm_group (hamming β) :=
{ dist_eq := by { push_cast, exact_mod_cast hamming_dist_eq_hamming_norm }, ..pi.add_comm_group }

@[simp, push_cast] lemma nnnorm_eq_hamming_norm [Π i, add_comm_group (β i)] (x : hamming β) :
  ‖x‖₊ = hamming_norm (of_hamming x) := rfl

instance [Π i, add_comm_group (β i)] : normed_add_comm_group (hamming β) :=
{ ..hamming.seminormed_add_comm_group }

end

end hamming


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

! This file was ported from Lean 3 source module combinatorics.catalan
! leanprover-community/mathlib commit 26b40791e4a5772a4e53d0e28e4df092119dc7da
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.BigOperators.Fin
import Mathlib.Algebra.BigOperators.NatAntidiagonal
import Mathlib.Algebra.CharZero.Lemmas
import Mathlib.Data.Finset.NatAntidiagonal
import Mathlib.Data.Nat.Choose.Central
import Mathlib.Data.Tree
import Mathlib.Tactic.FieldSimp

/-!
# Catalan numbers

The Catalan numbers (http://oeis.org/A000108) are probably the most ubiquitous sequence of integers
in mathematics. They enumerate several important objects like binary trees, Dyck paths, and
triangulations of convex polygons.

## Main definitions

* `catalan n`: the `n`th Catalan number, defined recursively as
  `catalan (n + 1) = ∑ i : Fin n.succ, catalan i * catalan (n - i)`.

## Main results

* `catalan_eq_centralBinom_div `: The explicit formula for the Catalan number using the central
  binomial coefficient, `catalan n = Nat.centralBinom n / (n + 1)`.

* `treesOfNodesEq_card_eq_catalan`: The number of binary trees with `n` internal nodes
  is `catalan n`

## Implementation details

The proof of `catalan_eq_centralBinom_div` follows https://math.stackexchange.com/questions/3304415

## TODO

* Prove that the Catalan numbers enumerate many interesting objects.
* Provide the many variants of Catalan numbers, e.g. associated to complex reflection groups,
  Fuss-Catalan, etc.

-/

open BigOperators

open Finset

open Finset.Nat.antidiagonal (fst_le snd_le)

/-- The recursive definition of the sequence of Catalan numbers:
`catalan (n + 1) = ∑ i : Fin n.succ, catalan i * catalan (n - i)` -/
def catalan : ℕ → ℕ
  | 0 => 1
  | n + 1 =>
    ∑ i : Fin n.succ,
      catalan i * catalan (n - i)
#align catalan catalan

@[simp]
theorem catalan_zero : catalan 0 = 1 := by rw [catalan]
#align catalan_zero catalan_zero

theorem catalan_succ (n : ℕ) : catalan (n + 1) = ∑ i : Fin n.succ, catalan i * catalan (n - i) := by
  rw [catalan]
#align catalan_succ catalan_succ

theorem catalan_succ' (n : ℕ) :
    catalan (n + 1) = ∑ ij in Nat.antidiagonal n, catalan ij.1 * catalan ij.2 := by
  rw [catalan_succ, Nat.sum_antidiagonal_eq_sum_range_succ (fun x y => catalan x * catalan y) n,
    sum_range]
#align catalan_succ' catalan_succ'

@[simp]
theorem catalan_one : catalan 1 = 1 := by simp [catalan_succ]
#align catalan_one catalan_one

/-- A helper sequence that can be used to prove the equality of the recursive and the explicit
definition using a telescoping sum argument. -/
private def gosperCatalan (n j : ℕ) : ℚ :=
  Nat.centralBinom j * Nat.centralBinom (n - j) * (2 * j - n) / (2 * n * (n + 1))

private theorem gosper_trick {n i : ℕ} (h : i ≤ n) :
    gosperCatalan (n + 1) (i + 1) - gosperCatalan (n + 1) i =
      Nat.centralBinom i / (i + 1) * Nat.centralBinom (n - i) / (n - i + 1) := by
  have l₁ : (n : ℚ) + 1 ≠ 0 := by norm_cast; exact n.succ_ne_zero
  have l₂ : (n : ℚ) + 1 + 1 ≠ 0 := by norm_cast; exact (n + 1).succ_ne_zero
  have l₃ : (i : ℚ) + 1 ≠ 0 := by norm_cast; exact i.succ_ne_zero
  have l₄ : (n : ℚ) - i + 1 ≠ 0 := by norm_cast; exact (n - i).succ_ne_zero
  have h₁ := (mul_div_cancel_left (↑(Nat.centralBinom (i + 1))) l₃).symm
  have h₂ := (mul_div_cancel_left (↑(Nat.centralBinom (n - i + 1))) l₄).symm
  have h₃ : ((i : ℚ) + 1) * (i + 1).centralBinom = 2 * (2 * i + 1) * i.centralBinom := by
    exact_mod_cast Nat.succ_mul_centralBinom_succ i
  have h₄ :
    ((n : ℚ) - i + 1) * (n - i + 1).centralBinom = 2 * (2 * (n - i) + 1) * (n - i).centralBinom :=
    by exact_mod_cast Nat.succ_mul_centralBinom_succ (n - i)
  simp only [gosperCatalan]
  push_cast
  rw [show n + 1 - i = n - i + 1 by rw [Nat.add_comm (n - i) 1, ←(Nat.add_sub_assoc h 1), add_comm]]
  rw [h₁, h₂, h₃, h₄]
  field_simp
  ring_nf

private theorem gosper_catalan_sub_eq_central_binom_div (n : ℕ) :
    gosperCatalan (n + 1) (n + 1) - gosperCatalan (n + 1) 0 = Nat.centralBinom (n + 1) / (n + 2) :=
  by
  have : (n : ℚ) + 1 ≠ 0 := by norm_cast; exact n.succ_ne_zero
  have : (n : ℚ) + 1 + 1 ≠ 0 := by norm_cast; exact (n + 1).succ_ne_zero
  have h : (n : ℚ) + 2 ≠ 0 := by norm_cast; exact (n + 1).succ_ne_zero
  simp only [gosperCatalan, Nat.sub_zero, Nat.centralBinom_zero, Nat.sub_self]
  field_simp
  ring_nf

theorem catalan_eq_centralBinom_div (n : ℕ) : catalan n = n.centralBinom / (n + 1) := by
  suffices (catalan n : ℚ) = Nat.centralBinom n / (n + 1) by
    have h := Nat.succ_dvd_centralBinom n
    exact_mod_cast this
  induction' n using Nat.case_strong_induction_on with d hd
  · simp
  · simp_rw [catalan_succ, Nat.cast_sum, Nat.cast_mul]
    trans (∑ i : Fin d.succ, Nat.centralBinom i / (i + 1) *
                             (Nat.centralBinom (d - i) / (d - i + 1)) : ℚ)
    · congr
      ext1 x
      have m_le_d : x.val ≤ d := by apply Nat.le_of_lt_succ; apply x.2
      have d_minus_x_le_d : (d - x.val) ≤ d := tsub_le_self
      rw [hd _ m_le_d, hd _ d_minus_x_le_d]
      norm_cast
    · trans (∑ i : Fin d.succ, (gosperCatalan (d + 1) (i + 1) - gosperCatalan (d + 1) i))
      · refine' sum_congr rfl fun i _ => _
        rw [gosper_trick i.is_le, mul_div]
      · rw [← sum_range fun i => gosperCatalan (d + 1) (i + 1) - gosperCatalan (d + 1) i,
            sum_range_sub, Nat.succ_eq_add_one]
        rw [gosper_catalan_sub_eq_central_binom_div d]
        norm_cast
#align catalan_eq_central_binom_div catalan_eq_centralBinom_div

theorem succ_mul_catalan_eq_centralBinom (n : ℕ) : (n + 1) * catalan n = n.centralBinom :=
  (Nat.eq_mul_of_div_eq_right n.succ_dvd_centralBinom (catalan_eq_centralBinom_div n).symm).symm
#align succ_mul_catalan_eq_central_binom succ_mul_catalan_eq_centralBinom

theorem catalan_two : catalan 2 = 2 := by unfold catalan; rfl
#align catalan_two catalan_two

theorem catalan_three : catalan 3 = 5 := by unfold catalan; rfl
#align catalan_three catalan_three

namespace Tree

open Tree

/-- Given two finsets, find all trees that can be formed with
  left child in `a` and right child in `b` -/
@[reducible]
def pairwiseNode (a b : Finset (Tree Unit)) : Finset (Tree Unit) :=
  (a ×ᶠ b).map ⟨fun x => x.1 △ x.2, fun ⟨x₁, x₂⟩ ⟨y₁, y₂⟩ => fun h => by simpa using h⟩
#align tree.pairwise_node Tree.pairwiseNode

/-- A Finset of all trees with `n` nodes. See `mem_treesOfNodesEq` -/
def treesOfNumNodesEq : ℕ → Finset (Tree Unit)
  | 0 => {nil}
  | n + 1 =>
    (Finset.Nat.antidiagonal n).attach.bunionᵢ fun ijh =>
      -- Porting note: `unusedHavesSuffices` linter is not happy with this. Commented out.
      -- have := Nat.lt_succ_of_le (fst_le ijh.2)
      -- have := Nat.lt_succ_of_le (snd_le ijh.2)
      pairwiseNode (treesOfNumNodesEq ijh.1.1) (treesOfNumNodesEq ijh.1.2)
  -- Porting note: Add this to satisfy the linter.
  decreasing_by
      simp_wf
      try exact Nat.lt_succ_of_le (fst_le ijh.2)
      try exact Nat.lt_succ_of_le (snd_le ijh.2)
#align tree.trees_of_num_nodes_eq Tree.treesOfNumNodesEq

@[simp]
theorem treesOfNumNodesEq_zero : treesOfNumNodesEq 0 = {nil} := by rw [treesOfNumNodesEq]
#align tree.trees_of_nodes_eq_zero Tree.treesOfNumNodesEq_zero

theorem treesOfNumNodesEq_succ (n : ℕ) :
    treesOfNumNodesEq (n + 1) =
      (Nat.antidiagonal n).bunionᵢ fun ij =>
        pairwiseNode (treesOfNumNodesEq ij.1) (treesOfNumNodesEq ij.2) := by
  rw [treesOfNumNodesEq]
  ext
  simp
#align tree.trees_of_nodes_eq_succ Tree.treesOfNumNodesEq_succ

@[simp]
theorem mem_treesOfNumNodesEq {x : Tree Unit} {n : ℕ} : x ∈ treesOfNumNodesEq n ↔ x.numNodes = n :=
  by
  induction x using Tree.unitRecOn generalizing n <;> cases n <;>
    simp [treesOfNumNodesEq_succ, Nat.succ_eq_add_one, *]
  exact (Nat.succ_ne_zero _).symm
#align tree.mem_trees_of_nodes_eq Tree.mem_treesOfNumNodesEq

theorem mem_treesOfNumNodesEq_numNodes (x : Tree Unit) : x ∈ treesOfNumNodesEq x.numNodes :=
  mem_treesOfNumNodesEq.mpr rfl
#align tree.mem_trees_of_nodes_eq_num_nodes Tree.mem_treesOfNumNodesEq_numNodes

@[simp, norm_cast]
theorem coe_treesOfNumNodesEq (n : ℕ) :
    ↑(treesOfNumNodesEq n) = { x : Tree Unit | x.numNodes = n } :=
  Set.ext (by simp)
#align tree.coe_trees_of_nodes_eq Tree.coe_treesOfNumNodesEq

theorem treesOfNumNodesEq_card_eq_catalan (n : ℕ) : (treesOfNumNodesEq n).card = catalan n := by
  induction' n using Nat.case_strong_induction_on with n ih
  · simp
  rw [treesOfNumNodesEq_succ, card_bunionᵢ, catalan_succ']
  · apply sum_congr rfl
    rintro ⟨i, j⟩ H
    rw [card_map, card_product, ih _ (fst_le H), ih _ (snd_le H)]
  · simp_rw [disjoint_left]
    rintro ⟨i, j⟩ _ ⟨i', j'⟩ _
    -- Porting note: was clear * -; tidy
    intros h a
    cases' a with a l r
    · intro h; simp at h
    · intro h1 h2
      apply h
      trans (numNodes l, numNodes r)
      · simp at h1; simp [h1]
      · simp at h2; simp [h2]
#align tree.trees_of_nodes_eq_card_eq_catalan Tree.treesOfNumNodesEq_card_eq_catalan

end Tree


namespace calcc
variables (a b c d e : ℕ)
variable h1 : a = b
variable h2 : b = c + 1
variable h3 : c = d
variable h4 : e = 1 + d

theorem T : a = e :=
calc
  a     = b : h1
    ... = c + 1 : h2
    ... = d + 1 : congr_arg _ h3
    ... = 1 + d : add_comm d (1 : ℕ)
    ... = e : h4.symm
end calcc

namespace tactics
variables (a b c d e : ℕ)
variable h1 : a = b
variable h2 : b = c + 1
variable h3 : c = d
variable h4 : e = 1 + d

include h1 h2 h3 h4
theorem T : a = e :=
calc
  a     = b : by rw h1
    ... = c + 1 : by rw h2
    ... = d + 1 : by rw h3
    ... = 1 + d : by rw add_comm
    ... = e     : by rw h4

theorem T₁ : a = e :=
calc
  a     = d + 1 : by rw [h1, h2, h3]
    ... = 1 + d : by rw add_comm
    ... = e     : by rw h4

theorem T₂ : a = e :=
by rw [h1, h2, h3, add_comm, h4]
#print T₂
#check T₂

theorem T₃ : a = e :=
by simp [h1, h2, h3, h4]

example (x y : ℕ) :
  (x + y) * (x + y) = x * x + y * x + x * y + y * y :=
calc
  (x + y) * (x + y) = (x + y) * x + (x + y) * y : by rw left_distrib
    ... = x * x + y * x + (x + y) * y           : by rw add_mul
    ... = x * x + y * x + (x * y + y * y)       : by rw add_mul
    ... = x * x + y * x + x * y + y * y         : by rw ← add_assoc

example (x y : ℕ) :
  (x + y) * (x + y) = x * x + y * x + x * y + y * y :=
by rw [mul_add, add_mul, add_mul, ← add_assoc]

example (x y : ℕ) :
  (x + y) * (x + y) = x * x + y * x + x * y + y * y :=
by simp [left_distrib, right_distrib]

end tactics


theorem ex1 : (fun y => y + 0) = (fun x => 0 + x) := by
  funext x
  simp

theorem ex2 : (fun y x => y + x + 0) = (fun x y => y + x) := by
  funext x y
  rw [Nat.add_zero, Nat.add_comm]

theorem ex3 : (fun (x : Nat × Nat) => x.1 + x.2) = (fun (x : Nat × Nat) => x.2 + x.1) := by
  funext (a, b)
  show a + b = b + a
  rw [Nat.add_comm]

theorem ex4 : (fun (x : Nat × Nat) (y : Nat × Nat) => x.1 + y.2) = (fun (x : Nat × Nat) (z : Nat × Nat) => z.2 + x.1) := by
  funext (a, b) (c, d)
  show a + d = d + a
  rw [Nat.add_comm]

theorem ex5 : (fun (x : Id Nat) => x.succ + 0) = (fun (x : Id Nat) => 0 + x.succ) := by
  funext (x : Nat)
  have y := x + 1 -- if `(x : Nat)` is not used at `funext`, then `x+1` would fail to be elaborated since we don't have the instance `Add (Id Nat)`
  rw [Nat.add_comm]


/-
Give a natural deduction proof of 𝐴→((𝐴∧𝐵)∨(𝐴∧¬𝐵)).
You may use the law of the excluded middle.
-/

open classical

example (A B: Prop):  A → ((A ∧ B)∨(A ∧ ¬B)) :=
  λ hA: A,
  or.elim(em(B))(
    λ hB: B,
    have hAB: A ∧ B, from ⟨hA, hB⟩,
    show (A ∧ B)∨(A ∧ ¬B), from  or.inl hAB
  )(
    λ hnB: ¬ B,
    have hAnB: A ∧ ¬B, from ⟨hA, hnB⟩,
    show (A ∧ B)∨(A ∧ ¬B), from  or.inr hAnB
  )


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

import tactic -- imports all the Lean tactics

/-!

# Sets in Lean, example sheet 3 : not in (`∉`)

The definition in Lean of `x ∉ A` is `¬ (x ∈ A)`. In other words,
`x ∉ A`, `¬ (x ∈ A)` and `(x ∈ A) → false` are all equal *by definition*
in Lean. This means that they are all interchangeable, and you can
change between them using the `change` tactic, or you can just keep this
in mind. For example, if you have a hypothesis `h : x ∉ A` and your goal
is `false`, then `apply h` will work and will change the goal to `x ∈ A`.

## Tactics

You can do all these levels just with `intros`, `apply` and `exact`!

-/

open set

variables
  (X : Type) -- Everything will be a subset of `X`
  (A B C D E : set X) -- A,B,C,D,E are subsets of `X`
  (x y z : X) -- x,y,z are elements of `X` or, more precisely, terms of type `X`

example : x ∉ A → (x ∈ A → false) :=
begin
  intro h,
  exact h,
end

example : x ∈ A → (x ∉ A → false) :=     /-attention!-/
begin
  intro h,
  intro h1,
  apply h1,
  exact h,
end

example : (∀ t, t ∈ A → t ∈ B) → x ∉ B → x ∉ A :=
begin
  intros h2 h1,
  specialize h2 x,
  by_cases (x ∈ A),
  have h3: x ∈ B, by exact h2 h,
  trivial,
  exact h,
end

example : x ∉ (∅ : set X) :=
begin
  change x ∈ ∅ → false,
  intro h,
  exact h,
end


/-
Copyright (c) 2020 Jujian Zhang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jujian Zhang
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.polynomial.derivative
import Mathlib.logic.function.iterate
import Mathlib.data.finset.intervals
import Mathlib.tactic.ring
import Mathlib.tactic.linarith.default
import Mathlib.PostPort

universes u

namespace Mathlib

/-!
# Theory of iterated derivative
We define and prove some lemmas about iterated (formal) derivative for polynomials over a semiring.
-/

namespace polynomial

/-- `iterated_deriv f n` is the `n`-th formal derivative of the polynomial `f` -/
def iterated_deriv {R : Type u} [semiring R] (f : polynomial R) (n : ℕ) : polynomial R :=
  nat.iterate (⇑derivative) n f

@[simp] theorem iterated_deriv_zero_right {R : Type u} [semiring R] (f : polynomial R) : iterated_deriv f 0 = f :=
  rfl

theorem iterated_deriv_succ {R : Type u} [semiring R] (f : polynomial R) (n : ℕ) : iterated_deriv f (n + 1) = coe_fn derivative (iterated_deriv f n) := sorry

@[simp] theorem iterated_deriv_zero_left {R : Type u} [semiring R] (n : ℕ) : iterated_deriv 0 n = 0 := sorry

@[simp] theorem iterated_deriv_add {R : Type u} [semiring R] (p : polynomial R) (q : polynomial R) (n : ℕ) : iterated_deriv (p + q) n = iterated_deriv p n + iterated_deriv q n := sorry

@[simp] theorem iterated_deriv_smul {R : Type u} [semiring R] (r : R) (p : polynomial R) (n : ℕ) : iterated_deriv (r • p) n = r • iterated_deriv p n := sorry

@[simp] theorem iterated_deriv_X_zero {R : Type u} [semiring R] : iterated_deriv X 0 = X := sorry

@[simp] theorem iterated_deriv_X_one {R : Type u} [semiring R] : iterated_deriv X 1 = 1 := sorry

@[simp] theorem iterated_deriv_X {R : Type u} [semiring R] (n : ℕ) (h : 1 < n) : iterated_deriv X n = 0 := sorry

@[simp] theorem iterated_deriv_C_zero {R : Type u} [semiring R] (r : R) : iterated_deriv (coe_fn C r) 0 = coe_fn C r := sorry

@[simp] theorem iterated_deriv_C {R : Type u} [semiring R] (r : R) (n : ℕ) (h : 0 < n) : iterated_deriv (coe_fn C r) n = 0 := sorry

@[simp] theorem iterated_deriv_one_zero {R : Type u} [semiring R] : iterated_deriv 1 0 = 1 := sorry

@[simp] theorem iterated_deriv_one {R : Type u} [semiring R] (n : ℕ) : 0 < n → iterated_deriv 1 n = 0 := sorry

@[simp] theorem iterated_deriv_neg {R : Type u} [ring R] (p : polynomial R) (n : ℕ) : iterated_deriv (-p) n = -iterated_deriv p n := sorry

@[simp] theorem iterated_deriv_sub {R : Type u} [ring R] (p : polynomial R) (q : polynomial R) (n : ℕ) : iterated_deriv (p - q) n = iterated_deriv p n - iterated_deriv q n := sorry

theorem coeff_iterated_deriv_as_prod_Ico {R : Type u} [comm_semiring R] (f : polynomial R) (k : ℕ) (m : ℕ) : coeff (iterated_deriv f k) m =
  (finset.prod (finset.Ico (Nat.succ m) (m + Nat.succ k)) fun (i : ℕ) => ↑i) * coeff f (m + k) := sorry

theorem coeff_iterated_deriv_as_prod_range {R : Type u} [comm_semiring R] (f : polynomial R) (k : ℕ) (m : ℕ) : coeff (iterated_deriv f k) m = coeff f (m + k) * finset.prod (finset.range k) fun (i : ℕ) => ↑(m + k - i) := sorry

theorem iterated_deriv_eq_zero_of_nat_degree_lt {R : Type u} [comm_semiring R] (f : polynomial R) (n : ℕ) (h : nat_degree f < n) : iterated_deriv f n = 0 := sorry

theorem iterated_deriv_mul {R : Type u} [comm_semiring R] (p : polynomial R) (q : polynomial R) (n : ℕ) : iterated_deriv (p * q) n =
  finset.sum (finset.range (Nat.succ n))
    fun (k : ℕ) => coe_fn C ↑(nat.choose n k) * iterated_deriv p (n - k) * iterated_deriv q k := sorry


/-
Prove the following in Lean:

variables A B C D : Prop

example : A ∧ (A → B) → B :=
sorry

example : A → ¬ (¬ A ∧ B) :=
sorry

example : ¬ (A ∧ B) → (A → ¬ B) :=
sorry

example (h₁ : A ∨ B) (h₂ : A → C) (h₃ : B → D) : C ∨ D :=
sorry

example (h : ¬ A ∧ ¬ B) : ¬ (A ∨ B) :=
sorry

example : ¬ (A ↔ ¬ A) :=
sorry
-/

variables A B C D : Prop

example : A ∧ (A → B) → B :=
λ h: A ∧ (A → B),
have hA: A, from and.elim_left h,
have A → B, from and.elim_right h,
show B, from this hA

example : A → ¬ (¬ A ∧ B) :=
assume hA: A,
assume hnAB: ¬ A ∧ B,
show false, from (
  have hnA: ¬ A, from and.elim_left hnAB,
  hnA(hA)
)

example : ¬ (A ∧ B) → (A → ¬ B) :=
  assume h:  ¬ (A ∧ B),
  assume hA: A,
  assume hB: B,
  show false, from (
    have hAB: A ∧ B, from ⟨ hA, hB ⟩,
    h(hAB)
  )

example (h₁ : A ∨ B) (h₂ : A → C) (h₃ : B → D) : C ∨ D :=
or.elim(h₁)(
  assume hA, or.inl(h₂(hA))
)(
  assume hB, or.inr(h₃(hB))
)

example (h : ¬ A ∧ ¬ B) : ¬ (A ∨ B) :=
have hnA: ¬ A, from and.elim_left(h),
have hnB: ¬ B, from and.elim_right(h),
assume hAoB: A ∨ B,
show false, from (
  or.elim(hAoB)(
    assume hA, hnA(hA)
  )(
    assume hB, hnB(hB)
  )
)

example : ¬ (A ↔ ¬ A) :=
assume h: A ↔ ¬ A,
show false, from (
  have hAtnA: A → ¬ A, from  iff.mp(h),
  have hnAtA: ¬ A → A, from  iff.mpr(h),
  have hnA: ¬ A, from (
    assume hA: A,
    show false, from hAtnA(hA)(hA)
  )
  have hA: A, from hnAtA(hnA),
  hnA(hA)
)


import MyNat.Power
import MyNat.Addition -- add_zero
import MultiplicationWorld.Level2 -- mul_one
import MultiplicationWorld.Level5 -- mul_assoc
namespace MyNat
open MyNat

/-!
# Power World

## Level 5: `pow_add`

## Lemma
For all naturals `a`, `m`, `n`, we have `a^(m + n) = a ^ m  a ^ n`.
-/
lemma pow_add (a m n : MyNat) : a ^ (m + n) = a ^ m * a ^ n := by
  induction n with
  | zero =>
    rw [zero_is_0]
    rw [add_zero]
    rw [pow_zero]
    rw [mul_one]
  | succ n ih =>
    rw [add_succ]
    rw [pow_succ]
    rw [pow_succ]
    rw [ih]
    rw [mul_assoc]

/-!
Remember you can combine all the `rw` rules into one with
`rw [add_succ, pow_succ, pow_succ, ih, mul_assoc]` but we have
broken it out here so you can more easily see all the intermediate
goal states.

Next up [Level 6](./Level6.lean.md)
-/


-- La función duplicadora no es par
-- ================================

import data.real.basic

variable (f : ℝ → ℝ)

-- ----------------------------------------------------
-- Ejercicio 1. Definir la función
--    par : (ℝ → ℝ) → Prop
-- tal que (par f) expresa que f es par.
-- ----------------------------------------------------

def par : (ℝ → ℝ) → Prop
| f := ∀ x, f (-x) = f x

-- ----------------------------------------------------
-- Ejercicio 2. Demostrar que la función que a cada x
-- le asigna 2*x no es par.
-- ----------------------------------------------------

example :
  ¬par (λ x, 2*x) :=
begin
  unfold par,
  push_neg,
  use 42,
  linarith,
end


/-
Copyright (c) 2022 Damiano Testa. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Damiano Testa
-/
import algebra.monoid_algebra.support

/-!
# Variations on non-zero divisors in `add_monoid_algebra`s

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

This file studies the interaction between typeclass assumptions on two Types `R` and `A` and
whether `add_monoid_algebra R A` has non-zero zero-divisors.  For some background on related
questions, see [Kaplansky's Conjectures](https://en.wikipedia.org/wiki/Kaplansky%27s_conjectures),
especially the *zero divisor conjecture*.

_Conjecture._
Let `K` be a field, and `G` a torsion-free group. The group ring `K[G]` does not contain
nontrivial zero divisors, that is, it is a domain.

We formalize in this file the well-known result that if `R` is a field and `A` is a left-ordered
group, then `R[A]` contains no non-zero zero-divisors.  Some of these assumptions can be trivially
weakened: below we mention what assumptions are sufficient for the proofs in this file.

##  Main results

* `no_zero_divisors.of_left_ordered` shows that if `R` is a semiring with no non-zero
  zero-divisors, `A` is a linearly ordered, add right cancel semigroup with strictly monotone
  left addition, then `add_monoid_algebra R A` has no non-zero zero-divisors.
* `no_zero_divisors.of_right_ordered` shows that if `R` is a semiring with no non-zero
  zero-divisors, `A` is a linearly ordered, add left cancel semigroup with strictly monotone
  right addition, then `add_monoid_algebra R A` has no non-zero zero-divisors.

The conditions on `A` imposed in `no_zero_divisors.of_left_ordered` are sometimes referred to as
`left-ordered`.
The conditions on `A` imposed in `no_zero_divisors.of_right_ordered` are sometimes referred to as
`right-ordered`.

These conditions are sufficient, but not necessary.  As mentioned above, *Kaplansky's Conjecture*
asserts that `A` being torsion-free may be enough.
-/

namespace add_monoid_algebra
open finsupp

variables {R A : Type*} [semiring R]

/--  The coefficient of a monomial in a product `f * g` that can be reached in at most one way
as a product of monomials in the supports of `f` and `g` is a product. -/
lemma mul_apply_add_eq_mul_of_forall_ne [has_add A] {f g : add_monoid_algebra R A} {a0 b0 : A}
  (h : ∀ {a b : A}, a ∈ f.support → b ∈ g.support → (a ≠ a0 ∨ b ≠ b0) → a + b ≠ a0 + b0) :
  (f * g) (a0 + b0) = f a0 * g b0 :=
begin
  classical,
  rw mul_apply,
  refine (finset.sum_eq_single a0 _ _).trans _,
  { exact λ b H hb, finset.sum_eq_zero (λ x H1, if_neg (h H H1 (or.inl hb))) },
  { exact λ af0, by simp [not_mem_support_iff.mp af0] },
  { refine (finset.sum_eq_single b0 (λ b bg b0, _) _).trans (if_pos rfl),
    { by_cases af : a0 ∈ f.support,
      { exact if_neg (h af bg (or.inr b0)) },
      { simp only [not_mem_support_iff.mp af, zero_mul, if_t_t] } },
    { exact λ bf0, by simp [not_mem_support_iff.mp bf0] } },
end

section left_or_right_orderability

lemma left.exists_add_of_mem_support_single_mul [add_left_cancel_semigroup A]
  {g : add_monoid_algebra R A} (a x : A)
  (hx : x ∈ (single a 1 * g : add_monoid_algebra R A).support) :
  ∃ b ∈ g.support, a + b = x :=
by rwa [support_single_mul _ _ (λ y, by rw one_mul : ∀ y : R, 1 * y = 0 ↔ _), finset.mem_map] at hx

lemma right.exists_add_of_mem_support_single_mul [add_right_cancel_semigroup A]
  {f : add_monoid_algebra R A} (b x : A)
  (hx : x ∈ (f * single b 1 : add_monoid_algebra R A).support) :
  ∃ a ∈ f.support, a + b = x :=
by rwa [support_mul_single _ _ (λ y, by rw mul_one : ∀ y : R, y * 1 = 0 ↔ _), finset.mem_map] at hx

/--  If `R` is a semiring with no non-trivial zero-divisors and `A` is a left-ordered add right
cancel semigroup, then `add_monoid_algebra R A` also contains no non-zero zero-divisors. -/
lemma no_zero_divisors.of_left_ordered [no_zero_divisors R]
  [add_right_cancel_semigroup A] [linear_order A] [covariant_class A A (+) (<)] :
  no_zero_divisors (add_monoid_algebra R A) :=
⟨λ f g fg, begin
  contrapose! fg,
  let gmin : A := g.support.min' (support_nonempty_iff.mpr fg.2),
  refine support_nonempty_iff.mp _,
  obtain ⟨a, ha, H⟩ := right.exists_add_of_mem_support_single_mul gmin
    ((f * single gmin 1 : add_monoid_algebra R A).support.min'
      (by rw support_mul_single; simp [support_nonempty_iff.mpr fg.1])) (finset.min'_mem _ _),
  refine ⟨a + gmin, mem_support_iff.mpr _⟩,
  rw mul_apply_add_eq_mul_of_forall_ne _,
  { refine mul_ne_zero _ _,
    exacts [mem_support_iff.mp ha, mem_support_iff.mp (finset.min'_mem _ _)] },
  { rw H,
    rintro b c bf cg (hb | hc); refine ne_of_gt _,
    { refine lt_of_lt_of_le (_ : _ < b + gmin ) _,
      { apply finset.min'_lt_of_mem_erase_min',
        rw ← H,
        apply finset.mem_erase_of_ne_of_mem,
        { simpa only [ne.def, add_left_inj] },
        { rw support_mul_single _ _ (λ y, by rw mul_one : ∀ y : R, y * 1 = 0 ↔ _),
          simpa only [finset.mem_map, add_right_embedding_apply, add_left_inj, exists_prop,
            exists_eq_right] } },
      { haveI : covariant_class A A (+) (≤) := has_add.to_covariant_class_left A,
        exact add_le_add_left (finset.min'_le _ _ cg) _ } },
    { refine lt_of_le_of_lt (_ : _ ≤ b + gmin) _,
      { apply finset.min'_le,
        rw support_mul_single _ _ (λ y, by rw mul_one : ∀ y : R, y * 1 = 0 ↔ _),
        simp only [bf, finset.mem_map, add_right_embedding_apply, add_left_inj, exists_prop,
          exists_eq_right] },
      { refine add_lt_add_left _ _,
        exact finset.min'_lt_of_mem_erase_min' _ _ (finset.mem_erase.mpr ⟨hc, cg⟩) } } }
end⟩

/--  If `R` is a semiring with no non-trivial zero-divisors and `A` is a right-ordered add left
cancel semigroup, then `add_monoid_algebra R A` also contains no non-zero zero-divisors. -/
lemma no_zero_divisors.of_right_ordered [no_zero_divisors R]
  [add_left_cancel_semigroup A] [linear_order A] [covariant_class A A (function.swap (+)) (<)] :
  no_zero_divisors (add_monoid_algebra R A) :=
⟨λ f g fg, begin
  contrapose! fg,
  let fmin : A := f.support.min' (support_nonempty_iff.mpr fg.1),
  refine support_nonempty_iff.mp _,
  obtain ⟨a, ha, H⟩ := left.exists_add_of_mem_support_single_mul fmin
    ((single fmin 1 * g : add_monoid_algebra R A).support.min'
      (by rw support_single_mul; simp [support_nonempty_iff.mpr fg.2])) (finset.min'_mem _ _),
  refine ⟨fmin + a, mem_support_iff.mpr _⟩,
  rw mul_apply_add_eq_mul_of_forall_ne _,
  { refine mul_ne_zero _ _,
    exacts [mem_support_iff.mp (finset.min'_mem _ _), mem_support_iff.mp ha] },
  { rw H,
    rintro b c bf cg (hb | hc); refine ne_of_gt _,
    { refine lt_of_le_of_lt (_ : _ ≤ fmin + c) _,
      { apply finset.min'_le,
        rw support_single_mul _ _ (λ y, by rw one_mul : ∀ y : R, 1 * y = 0 ↔ _),
        simp only [cg, finset.mem_map, add_left_embedding_apply, add_right_inj, exists_prop,
          exists_eq_right] },
      { refine add_lt_add_right _ _,
        exact finset.min'_lt_of_mem_erase_min' _ _ (finset.mem_erase.mpr ⟨hb, bf⟩) } },
    { refine lt_of_lt_of_le (_ : _ < fmin + c) _,
      { apply finset.min'_lt_of_mem_erase_min',
        rw ← H,
        apply finset.mem_erase_of_ne_of_mem,
        { simpa only [ne.def, add_right_inj] },
        { rw support_single_mul _ _ (λ y, by rw one_mul : ∀ y : R, 1 * y = 0 ↔ _),
          simpa only [finset.mem_map, add_left_embedding_apply, add_right_inj, exists_prop,
            exists_eq_right]} },
      { haveI : covariant_class A A (function.swap (+)) (≤) := has_add.to_covariant_class_right A,
        exact add_le_add_right (finset.min'_le _ _ bf) _ } } }
end⟩

end left_or_right_orderability

end add_monoid_algebra


import data.list.basic tactic.linarith
import tactic.omega tactic.apply

open list

/- cons -/

/-- (a::L) is the same as [a] ++ L-/
lemma cons_eq_sing_append {α : Type*} {L : list α } (a : α ):
(a::L) = [a] ++ L := by refl -- true by definition of append

/- bind -/

/--list.bind of two lists is the second appended to the first-/
theorem list.bind_fin2 {α : Type*} (f : fin 2 → list α) :
  list.bind [0, 1] f = f 0 ++ f 1 :=
begin
  show f 0 ++ (f 1 ++ nil) = f 0 ++ f 1, -- by definition of list.bind
  rw append_nil,
end

/- tail -/

/--the tail of a list with the first m elements dropped is that
list with the first m+1 elements dropped-/
lemma tail_drop (α : Type*) {A:list α} {m : ℕ} :
tail (drop m A) = drop (nat.succ m) A :=
by rw [← drop_one, drop_drop, add_comm]
/-
begin
rw ← drop_one, -- drop 1 L = tail L (here L is drop m A)
rw drop_drop,  -- drop 1 (drop m) A = drop (1 + m) A
rw add_comm,   -- commutativity of + (nat.succ n is defined as n + 1)
end
-/

/- drop -/

/-- dropping no elements from a list gives the list-/
lemma drop_zero {α : Type*} {L : list α}: drop 0 L = L := by refl --by def of drop

/--If one drops the first n elements of two lists appended to each other and
   the fist list has length l no longer than n, then this is the same as
   dropping the first n-l elements from the second list-/
lemma drop_append_of_length_le {α : Type*} {l₁ l₂ : list α} {n : ℕ} :
  length l₁ ≤ n → drop n (l₁ ++ l₂) = drop (n - l₁.length) l₂ :=
begin
  revert n, -- revert n so the inductive hyothesis holds for any value of n
  induction l₁ with c L H,
  -- base case: l₁ = nil
  { intros n h,
    rw nil_append, -- nil ++ l₂ = l₂
    rw length, -- length nil = nil
    rw nat.sub_zero}, -- n-0 = n
  -- inductive step: l_1 = (c :: L), c of type α and L of type list α
  { intros n h,
    rw length_cons, -- length (c :: L) = length L + 1
    rw cons_append, -- (c :: L) ++ l₂ = (c :: (L ++ l₂))
    cases n,
      -- n = 0,  contradicts length (c :: L) ≤ n (hypothesis h)
      exfalso,
      rw length_cons at h,
      exact nat.not_succ_le_zero (length L) h,
    -- nat.succ n
    rw drop, -- drop (nat.succ n) (c :: (L ++ l₂)) = drop n (L ++ l₂) by def of drop
    rw nat.succ_eq_add_one,
    rw [length_cons, nat.succ_eq_add_one] at h,
    rw ← nat.sub_le_right_iff_le_add at h, -- (length L + 1) - 1 ≤ n ↔ (length L + 1) ≤ n + 1
    rw nat.add_sub_cancel (length L) 1 at h,
    rw H h, -- use inductive hypothesis
    rw nat.succ_sub_succ n (length L)} /- nat.succ n - nat.succ (length L) = n - (length L)
                                          nat.succ x defined as x + 1 -/
end

/--summary of drop_append_of_le_length and drop_append_of_length_le-/
lemma drop_append {α : Type*} {l₁ l₂ : list α} {n : ℕ} :
  drop n (l₁ ++ l₂) = if n ≤ l₁.length then drop n l₁ ++ l₂ else drop (n - l₁.length) l₂ :=
begin
  split_ifs with ite, -- split if-then-else-condition into cases true or not)
    /- if-case (named ite) : n ≤ length l₁-/
    exact drop_append_of_le_length ite, -- existing lemma in mathlib
  /- else-case (named ite) : ¬ (n ≤ length l₁)-/
  apply drop_append_of_length_le, -- lemma above
  --goal : length l₁ ≤ n    necessary hypothesis for drop_append_of_length_le
  linarith, -- lean can do this much by itself
end

/- take -/

/--If one takes the first n elements of two lists appended to each other and
   the fist list has length l no longer than n, then this is the same as
   taking all of the first list and appending the first n-l elements from
   the second list-/
lemma take_append_of_length_le {α : Type*} {l₁ l₂ : list α} {n : ℕ} :
 length l₁ ≤ n →
  take n (l₁ ++ l₂) = l₁ ++ take (n - l₁.length) l₂ :=
begin
  revert n, -- revert n so the inductive hyothesis holds for any value of n
  induction l₁ with c L H,
  -- base case: l₁ = nil
  { intros n h,
    rw nil_append, -- nil ++ l₂ = l₂
    rw nil_append, -- nil ++ take (n - length nil) l₂ = take (n - length nil) l₂
    refl, -- n - length nil = n - 0 = n
  },
  -- inductive step: l₁ = (c :: L), with c of type α and L of type list α
  intros n h,
  cases n with m,
    cases h, -- kill n = 0 case (h is ength (c :: L) ≤ 0)
  -- nat.succ n
  rw cons_append, -- ((c :: L) ++ l₂) = (c :: (L ++ l₂))
  rw take_cons, -- take (nat.succ m) (c :: (L ++ l₂)) =  c :: take m (L ++ l₂)
  rw cons_append, /- c :: L ++ take (nat.succ m - length (c :: L)) l₂ =
                     c :: (L ++ take (nat.succ m - length (c :: L)) l₂)-/
  congr', -- eliminates the c at the start on both sides
  rw H, -- use inductive hypothesis
  { congr' 2, -- focused goal becomes : m - length L = nat.succ m - length (c :: L)
    rw length_cons, -- length (c :: L) = ength L + 1
    generalize : length L = d, -- replaces length L by d
    simp, -- Lean can solve the goal by itself now
  },
  -- necessary hypothesis for inductive hypothesis: length L ≤ m
  rw length_cons at h,
  revert h,
  exact nat.pred_le_iff.mpr -- solves goal : length L + 1 ≤ nat.succ m → length L ≤ m
end

/--summary of  take_append_of_le_length and take_append_of_length_le-/
lemma take_append {α : Type*} {l₁ l₂ : list α} {n : ℕ} :
  take n (l₁ ++ l₂) =
  if ( n ≤ length l₁) then take n l₁ else l₁ ++ take (n - l₁.length) l₂ :=
begin
    split_ifs with ite, -- split if-then-else-condition into cases true or not)
    /- if-case (named ite) : n ≤ length l₁-/
    exact take_append_of_le_length ite, -- existing lemma in mathlib
  /- else-case (named ite) : ¬ (n ≤ length l₁)-/
  apply take_append_of_length_le, -- lemma above
  --goal : length l₁ ≤ n    necessary hypothesis for drop_append_of_length_le
  linarith, -- lean can do this much by itself
end

/- remove_nth -/

/--removing only the 0th element gives the tail-/
lemma remove_nth_zero {α : Type*} (L : list α) : remove_nth L 0 = tail L :=
--proof in term mode
by cases L; refl

/--removing the (n+1)th element gives the 'tail' of the list with
   the nth element removed, concatenated to the first element   -/
lemma remove_nth_succ {α : Type*}  {n : ℕ} ( L : list α) ( l : α ):
remove_nth (l::L) (nat.succ n) = l :: remove_nth L n:=
begin
cases L with a L1,
-- L = nil
refl, -- by def of remove_nth
-- L = (a :: L1)
refl, -- by def of remove_nth
end

/--If we try to remove an entry outside of the list, we get the unchanged list-/
lemma remove_nth_large_n {α : Type*} {n : ℕ} (L : list α) (h : length L ≤ n):
remove_nth L n = L :=
begin
revert L, -- so the inductive hypothesis holds for any list of length ≤ n
induction n with d hd,
-- base case : n = 0
  {intros L h,
  have p : L = nil, -- because of h, as the only list of length 0 is nil
    {rw ←  length_eq_zero, -- length L = 0 ↔ L = nil
    exact le_zero_iff_eq.mp h},
  rw p,
  refl}, -- by def of remove_nth
-- inductive step : n = nat.succ d
{intros L h,
cases L with l Lt,
  -- L = nil
  {refl}, -- by def of remove_nth
-- L = (l :: Lt), with l of type α and Lt of type list α
{rw remove_nth_succ Lt l,
rw length_cons at h,
rw hd Lt (nat.le_of_succ_le_succ h)},}, -- use inductive hypothesis
end

/- nth_le -/

/--the zeroth element of the list is its head-/
lemma nth_le_zero {α : Type*} [inhabited α] (l : list α) (h : _) :
  nth_le l 0 h = head l :=
begin
  cases l with m M,
    -- l = nil     contradicts (h : 0 < length l)
    {exfalso,
    revert h,
    exact dec_trivial},
  -- L = (m :: M), with m of type α and M of type list α
  refl, -- by def of nth_le
end

/-- the ith element of the reverted list is the (length l - 1 - i)th element of the list-/
@[simp] theorem nth_le_reverse' {α : Type*} (l : list α) (i : nat) (h1 h2) :
  nth_le (reverse l) i h1 = nth_le l (length l - 1 - i) h2 :=
begin
  /- this lemma is just a slightly different version of nth_le_reverse, which says
     for any ist l , natural number i
     nth_le (reverse l) (length l - 1 - i) h1 = nth_le l i h2
     where h1,h2 are the respective proofs that the lists have an element
     of the index asked for-/

  convert nth_le_reverse l _ _ _, -- convert the goal using nth_le_reverse

  -- first goal : i = length l - 1 - (length l - 1 - i)
  rw length_reverse at h1, -- length (reverse l) = length l
  { generalize hL : length l = x, -- create hyothesis length l = x for some x ∈ ℕ
    rw hL at h1,
    clear hL h2 l α, -- working around bugs in old mathlib
    omega -- let Lean solve this by itself (using linear integer and natural number arithmetic)
  },

  /- other goal : length l - 1 - (length l - 1 - i) < length (reverse l)
     (needed as argument for nth_le) -/
  { generalize hL : length l = x, -- create hyothesis length l = x for some x ∈ ℕ
    rw  length_reverse  at *, -- rewrite using length_reverse everywhere
    rw hL at *,

    -- now the goal is equivalent to h1 after getting rid of cancelling terms

    clear hL l α, -- working around bugs in old mathlib
    omega, -- let Lean solve this by itself (using linear integer and natural number arithmetic)
  }
end

/--the nth element of the first m elements is the nth element if n < m-/
lemma nth_le_take {α : Type*} (l : list α) (n m : ℕ) (h1) (h2) :
nth_le (take m l) n h1 = nth_le l n h2 :=
begin
  rw length_take at h1, /- length (take m l) = min m length l
                           creates duplicate of h1, as h1 in its exact old form
                           is needed as an argument for nth_le-/
  rename h1 h3, -- this line renames the new version of h1
  rw lt_min_iff at h3, -- n < min m (length l) ↔ n < m ∧ n < length l
  cases h3 with H1 H2, -- now H1 : n < m , and H2 : n < length l

  revert m n, -- so the inductive hypothesis holds for any choices of m and n
  induction l with k Lk IH,

    -- base case : l = nil
    { intros m n h1 h2 H1 H2, -- now l = nil contradicts H2, saying n < length l
      exfalso,
      rw length at H2, -- length nil = 0 by def of length
      cases H2}, -- both cases killed immediately

    -- inductive step : l = (k :: kL)
    intros m n h1 h2 H1 H2,
    cases m with m',

      -- m = 0
      { simp only [take_zero], -- take 0 (k :: Lk) = nil    (simp only because of nth_le)
          cases H1}, -- both cases killed immediately

      -- m = nat.succ m'  for some natural number m'
      { simp only [take], /- take (nat.succ m') (k :: Lk) = (k :: take m' Lk)
                             (simp only because of nth_le) -/
        cases n with n',

          -- n = 0
          {refl}, -- by def of nth_le

          -- n = nat.succ n'  for some natural number n'
          {rw nth_le, /- nth_le (k :: take m' Lk) (nat.succ n') _ = nth_le (take m' Lk) n' _
                         by def of nth_le-/
          rw nth_le,  /- nth_le (k :: Lk) (nat.succ n') h2 = nth_le Lk n' _
                         by def of nth_le-/
          apply IH, -- apply inductive hypothesis

          /- IH was ∀ (m n : ℕ) (h1 : n < length (take m Lk)) (h2 : n < length Lk),
             n < m → n < length Lk → nth_le (take m Lk) n h1 = nth_le Lk n h2,

             we used it for m' and n'
             h1 and h2 Lean can infer itself, so only need to prove n' < m' and n' < length Lk-/
            {apply nat.lt_of_succ_lt_succ,
            assumption}, -- true by some assumption (here h1)

            apply nat.lt_of_succ_lt_succ,
            assumption}, -- true by h2
      }
end

/--the ith element of of_fn f (if it is in the list) is f(i)-/
@[simp] theorem nth_le_of_fn' {α : Type*} {n : ℕ} (f : fin n → α)
  (i : ℕ) (hi : i < n) :
  nth_le (of_fn f) i ((length_of_fn f).symm ▸ hi) = f ⟨i, hi⟩ :=
  -- the following proof is in term mode
option.some.inj $ by rw [← nth_le_nth];
  simp only [list.nth_of_fn, of_fn_nth_val, fin.eta, dif_pos hi]

/- head -/

/--if two lists are equal, their heads are equal-/
lemma head_eq_of_list_eq {α : Type*} [inhabited α] {L1 L2 : list α}:
L1 = L2 → list.head L1 = list.head L2:=
begin
intro h, -- h is L1 = L2
rw h,
end

/--The head of a list with its first m element dropped is
   its (m+1)th element-/
lemma head_drop (α : Type*) [inhabited α] (L : list α) (m : ℕ) (hm : m < L.length):
  head (drop m L) = nth_le L m hm :=
begin
  revert L, -- so the inductive hyothesis holds for any list of lenght greater m
  induction m with d hd,
    -- base case :  m = 0
    { intros L hL,
      rw drop_zero, -- drop 0 L = L
      rw nth_le_zero,
    },
    -- inductive step : n = nat.succ d
    intros L hm,
    cases L with a M,
        -- L = nil
        {cases hm}, -- does it as hm is equivalent to nat.succ d < 0
      --  L = (a :: M)
      exact hd M _, /- true by inductive hypothesis
                       that d < length M can be inferred from hm -/
  end

/- sum -/

/--the sum of a two-element list is the sum of its two elements-/
theorem sum_list2 (α : Type*) [add_monoid α] (x y : α) : list.sum [x, y] = x + y :=
begin
  -- [x,y] is interpreted as (x :: (y :: nil))
  rw list.sum_cons, -- sum (x :: [y]) = x + sum [y]
  rw list.sum_cons, -- sum (y :: nil) = y + sum nil
  rw list.sum_nil, -- sum nil = 0
  rw add_zero, -- y + 0 = 0
end


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

import combinatorics.composition
import data.nat.parity
import tactic.apply_fun

/-!
# Partitions

A partition of a natural number `n` is a way of writing `n` as a sum of positive integers, where the
order does not matter: two sums that differ only in the order of their summands are considered the
same partition. This notion is closely related to that of a composition of `n`, but in a composition
of `n` the order does matter.
A summand of the partition is called a part.

## Main functions

* `p : partition n` is a structure, made of a multiset of integers which are all positive and
  add up to `n`.

## Implementation details

The main motivation for this structure and its API is to show Euler's partition theorem, and
related results.

The representation of a partition as a multiset is very handy as multisets are very flexible and
already have a well-developed API.

## Tags

Partition

## References

<https://en.wikipedia.org/wiki/Partition_(number_theory)>
-/

variables {α : Type*}

open multiset nat
open_locale big_operators

/-- A partition of `n` is a multiset of positive integers summing to `n`. -/
@[ext, derive decidable_eq] structure partition (n : ℕ) :=
(parts : multiset ℕ)
(parts_pos : ∀ {i}, i ∈ parts → 0 < i)
(parts_sum : parts.sum = n)

namespace partition

/-- A composition induces a partition (just convert the list to a multiset). -/
def of_composition (n : ℕ) (c : composition n) : partition n :=
{ parts := c.blocks,
  parts_pos := λ i hi, c.blocks_pos hi,
  parts_sum := by rw [multiset.coe_sum, c.blocks_sum] }

lemma of_composition_surj {n : ℕ} : function.surjective (of_composition n) :=
begin
  rintro ⟨b, hb₁, hb₂⟩,
  rcases quotient.exists_rep b with ⟨b, rfl⟩,
  refine ⟨⟨b, λ i hi, hb₁ hi, _⟩, partition.ext _ _ rfl⟩,
  simpa using hb₂
end

/--
Given a multiset which sums to `n`, construct a partition of `n` with the same multiset, but
without the zeros.
-/
-- The argument `n` is kept explicit here since it is useful in tactic mode proofs to generate the
-- proof obligation `l.sum = n`.
def of_sums (n : ℕ) (l : multiset ℕ) (hl : l.sum = n) : partition n :=
{ parts := l.filter (≠ 0),
  parts_pos := λ i hi, nat.pos_of_ne_zero $ by apply of_mem_filter hi,
  parts_sum :=
  begin
    have lt : l.filter (= 0) + l.filter (≠ 0) = l := filter_add_not _ l,
    apply_fun multiset.sum at lt,
    have lz : (l.filter (= 0)).sum = 0,
    { rw multiset.sum_eq_zero_iff,
      simp },
    simpa [lz, hl] using lt,
  end }

/-- A `multiset ℕ` induces a partition on its sum. -/
def of_multiset (l : multiset ℕ) : partition l.sum :=
of_sums _ l rfl

/-- The partition of exactly one part. -/
def indiscrete_partition (n : ℕ) : partition n :=
of_sums n {n} rfl

instance {n : ℕ} : inhabited (partition n) := ⟨indiscrete_partition n⟩

/--
The number of times a positive integer `i` appears in the partition `of_sums n l hl` is the same
as the number of times it appears in the multiset `l`.
(For `i = 0`, `partition.non_zero` combined with `multiset.count_eq_zero_of_not_mem` gives that
this is `0` instead.)
-/
lemma count_of_sums_of_ne_zero {n : ℕ} {l : multiset ℕ} (hl : l.sum = n) {i : ℕ} (hi : i ≠ 0) :
  (of_sums n l hl).parts.count i = l.count i :=
count_filter_of_pos hi

lemma count_of_sums_zero {n : ℕ} {l : multiset ℕ} (hl : l.sum = n) :
  (of_sums n l hl).parts.count 0 = 0 :=
count_filter_of_neg (λ h, h rfl)

/--
Show there are finitely many partitions by considering the surjection from compositions to
partitions.
-/
instance (n : ℕ) : fintype (partition n) :=
fintype.of_surjective (of_composition n) of_composition_surj

/-- The finset of those partitions in which every part is odd. -/
def odds (n : ℕ) : finset (partition n) :=
finset.univ.filter (λ c, ∀ i ∈ c.parts, ¬ even i)

/-- The finset of those partitions in which each part is used at most once. -/
def distincts (n : ℕ) : finset (partition n) :=
finset.univ.filter (λ c, c.parts.nodup)

/-- The finset of those partitions in which every part is odd and used at most once. -/
def odd_distincts (n : ℕ) : finset (partition n) := odds n ∩ distincts n

end partition


import data.nat.gcd data.nat.prime
import tactic.tauto tactic.squeeze tactic.find

/- --------------------------------------------------------------- -/
-- Section 2.1.1

#check 3 = 3
#check (ff && tt = ff)
#check (false ∧ true = false)

#print notation `=`
#print eq

-- #check (3 = [3]) -- ERROR
#check 3 = 4

lemma my_first_lemma : 3 = 3 := rfl
#check my_first_lemma

/- --------------------------------------------------------------- -/
-- Section 2.1.2

lemma my_add_assoc (n m k : ℕ) : m + (n + k) = (m + n) + k :=
 (nat.add_assoc _ _ _).symm

lemma my_bor_tt (b : bool) : b || tt = tt :=
 by { cases b; refl }

lemma my_bor_assoc (b1 b2 b3) : b1 || (b2 || b3) = (b1 || b2) || b3 :=
 by { cases b1; cases b2; cases b3; refl, }

-- Next example skipped because bool implication is not predefined in Lean

lemma my_bnot_and (a b : bool) : bnot (a && b) = (bnot a) || (bnot b) :=
 by { cases a; cases b; refl }

/- --------------------------------------------------------------- -/
-- Section 2.1.3

lemma my_zero_le (n : ℕ) :  0 ≤ n :=
begin
 induction n with n ih,
 exact nat.less_than_or_equal.refl,
 exact nat.less_than_or_equal.step ih,
end

def odd' (n : ℕ) : Prop := (n % 2 = 1)

lemma eq_leq (m n : ℕ) : m = n ↔ ((m ≤ n) ∧ (n ≤ m)) := sorry
lemma ne_lt (m n : ℕ) : m ≠ n ↔ ((m < n) ∨ (n < m)) := sorry
lemma le_zero (n : ℕ) : n ≤ 0 ↔ n = 0 := sorry
lemma dvd_one (d : ℕ) : (d ∣ 1) ↔ (d = 1) := sorry
lemma odd_mul (m n : ℕ) : odd' (m * n) ↔ (odd' n) ∧ (odd' m) := sorry

/- --------------------------------------------------------------- -/
-- Section 2.1.4

lemma leq_pmull (m n : ℕ) : (n > 0) → m ≤ n * m := sorry
lemma odd_gt_zero (n : ℕ) : odd' n → n > 0 := sorry

lemma dvd_mul (d1 d2 m1 m2 : ℕ) : (d1 ∣ m1) → (d2 ∣ m2) → d1 * d2 ∣ m1 * m2 := sorry

/- --------------------------------------------------------------- -/
-- Section 2.2.1

lemma my_first_lemma' : 3 = 3 := by refl

lemma my_second_lemma : 2 + 1 = 3 := rfl

lemma add_succ (m n : ℕ) : m + (nat.succ n) = nat.succ (m + n) := rfl

lemma my_bnot_bnot (b : bool) : bnot (bnot b) = b := by {cases b; refl,}

lemma le_zero' (n : ℕ) : n ≤ 0 ↔ n = 0 :=
by { cases n with k; simp, }

lemma my_mul_eq_zero (m n : ℕ) : (m * n = 0) ↔ (m = 0) ∨ (n = 0) :=
begin
 cases n; cases m;
 try {simp [-nat.mul_eq_zero]}
end

/- --------------------------------------------------------------- -/
-- Section 2.3.1

def is_zero : ℕ → bool
| 0 := tt
| _ := ff

def my_le (n m : ℕ) : bool := is_zero (n - m)

lemma le_zero'' (n m : ℕ) : (my_le n 0) = is_zero n :=
begin
 cases n; dsimp[my_le]; refl,
end

lemma list_ext (s₁ s₂ : list ℕ) :
 s₁.length = s₂.length → ∀ i, s₁.nth i = s₂.nth i → s₁ = s₂ := sorry

lemma map_length {α β : Type} (f : α → β) (s : list α) :
 list.length (list.map f s) = list.length s := sorry

def my_commutative {α β : Type} (op : α → α → β) :=
 ∀ a₁ a₂ : α, op a₁ a₂ = op a₂ a₁

lemma my_add_comm : my_commutative nat.add := nat.add_comm

#print associative
#print right_distrib
#print left_distrib
#print left_identity
#print function.injective
#print function.left_inverse

/- --------------------------------------------------------------- -/
-- Section 2.3.2

section chinese

variables m₁ m₂ : ℕ
variable co_n12 : nat.coprime m₁ m₂

lemma chinese_remainder (x y : ℕ) :
 x % (m₁ * m₂) = y % (m₁ * m₂) ↔ x % m₁ = y % m₁ ∧ x % m₂ = y % m₂ := sorry

end chinese

/- --------------------------------------------------------------- -/
-- Section 2.3.3

lemma my_le_refl (n : ℕ) : n ≤ n := le_refl n

example (a b : ℕ) : a + b ≤ a + b := my_le_refl (a + b)

example (a b : ℕ) : a + (nat.succ b) ≤ nat.succ (a + b) :=
begin
 apply my_le_refl,
end

attribute [simp] my_le_refl

example (a b : ℕ) : a + (nat.succ b) ≤ nat.succ (a + b) := sorry

lemma contra (c b : Prop) : (¬ c → ¬ b) → (b → c) :=
begin
 intros h hb,
 cases classical.em c with hc hnc,
 {exact hc},
 {exact false.elim (h hnc hb)}
end

example (m p : ℕ) : nat.prime p → p ∣ ((nat.factorial m) + 1) → m < p :=
begin
 intro prime_p,
 apply contra,
 intro h0,
 have leq_p_m : p ≤ m := le_of_not_gt h0,
 rw[← (@nat.dvd_add_iff_right p (nat.factorial m) 1)],
 {exact nat.prime.not_dvd_one prime_p},
 {exact nat.dvd_factorial (nat.prime.pos prime_p) leq_p_m}
end

example (m p : ℕ) : nat.prime p → p ∣ ((nat.factorial m) + 1) → m < p :=
begin
 intros prime_p d1,
 cases lt_or_ge m p, assumption, exfalso,
 rw[← (@nat.dvd_add_iff_right p (nat.factorial m) 1)] at d1,
 exact nat.prime.not_dvd_one prime_p d1,
 exact nat.dvd_factorial (nat.prime.pos prime_p) h,
end

/- --------------------------------------------------------------- -/
-- Section 2.3.4

#check @nat.rec
#check @list.rec

lemma my_add_zero (m : ℕ) : m + 0 = m := rfl
lemma my_zero_add (m : ℕ) : 0 + m = m :=
begin
 induction m with m ih,refl,exact congr_arg nat.succ ih,
end

lemma last_ind (α : Type) (P : list α → Prop) :
 (P list.nil) → (∀ s x, P s → P (s.concat x)) → ∀ s, P s :=
begin
 intros P_nil P_step,
 let C : (list α) → Prop := λ s,
  (∀ (Q : list α → Prop) (Q_nil : Q list.nil)
   (Q_step : ∀ t x, Q t → Q (t.concat x)), Q s),
 have h : ∀ s : list α, C s,
 {intro s,
  induction s with w s ih,
  {intros Q Q_nil Q_step,exact Q_nil},
  {intros Q Q_nil Q_step,
   let R := λ t, Q (w :: t),
   let R_nil : R list.nil := Q_step list.nil w Q_nil,
   let R_step : ∀ t x, R t → R (t.concat x) :=
    λ t x R_t, Q_step (w :: t) x R_t,
   exact ih R R_nil R_step,
  }
 },
 intro s,
 exact h s P P_nil P_step,
end

lemma foldl_rev (α β : Type) (f : α → β → α) (z : α) (s : list β) :
 list.foldl f z s.reverse = list.foldr (λ x z, f z x) z s :=
begin
 revert z,
 refine last_ind β _ _ _ s,
 {intro z,simp,},
 {intros t x h0 z,
  have h1 : list.reverse (list.concat t x) = x :: (list.reverse t) := by simp,
  have h2 : t.concat x = t ++ [x] := by simp,
  rw[h1,h2,list.foldl,h0 (f z x),list.foldr_append,list.foldr,list.foldr],
 }
end

/- --------------------------------------------------------------- -/
-- Section 2.4

example (m p : ℕ) : nat.prime p → p ∣ ((nat.factorial m) + 1) → m < p :=
begin
 intros prime_p,apply contra,intros h0 d1,
 exact nat.prime.not_dvd_one prime_p
  ((@nat.dvd_add_iff_right p (nat.factorial m) 1 (nat.dvd_factorial (nat.prime.pos prime_p) (le_of_not_gt h0))).mpr d1),
end

/- --------------------------------------------------------------- -/
-- Section 2.5

-- #find nat.bodd
-- #find (_ ∣ nat.fact _)
-- #find nat.coprime
-- #find (_ * _ = _ * _)

/- --------------------------------------------------------------- -/
-- Exercises for Chapter 2

example (b1 b2 b3 : bool) : b1 || (b2 || b3) = (b1 || b2) || b3 :=
 by {cases b1; cases b2; cases b3; refl,}

-- Next example skipped as boolean implication is not predefined in Lean

example (a b : bool) : bnot (a && b) = (bnot a) || (bnot b) :=
 by {cases a; cases b; refl,}

lemma nat.sub_add : ∀ (n m k : ℕ), n - (m + k) = (n - m) - k
| n m 0 := by {rw[add_zero,nat.sub_zero],}
| n m (nat.succ k) := by {rw[nat.add_succ,nat.sub_succ,nat.sub_add,nat.sub_succ]}

lemma nat.mul_pred (n m : ℕ) : n * (nat.pred m) = n * m - n :=
begin
 cases m,
 {rw[nat.pred_zero,mul_zero,nat.zero_sub],},
 {rw[nat.pred_succ,nat.mul_succ,nat.add_sub_cancel],}
end

lemma nat.pred_mul (n m : ℕ) : (nat.pred n) * m = n * m - m :=
 by { rw[nat.mul_comm,nat.mul_pred,nat.mul_comm], }

lemma nat.mul_sub : ∀ (n m k : ℕ), n * (m - k) = n * m - n * k
| n m 0 := by { rw[mul_zero,nat.sub_zero,nat.sub_zero],}
| n m (k + 1) :=
   by {rw[nat.sub_succ,nat.mul_pred,nat.mul_sub,nat.mul_succ,nat.sub_add],}

lemma nat.sub_mul (n m k : ℕ) : (n - m) * k = n * k - m * k :=
 by {rw[nat.mul_comm,nat.mul_sub],congr' 1;apply nat.mul_comm}

example (n m : ℕ) : m ^ 2 - n ^ 2 = (m - n) * (m + n) :=
 begin
  rw[pow_two,pow_two,nat.sub_mul,mul_add,mul_add,nat.mul_comm m n],
  rw[nat.sub_add,nat.add_sub_cancel],
 end

lemma bodd_exp (m n : ℕ) : nat.bodd (m ^ n) = (n = 0) || nat.bodd m :=
begin
 induction n with n ih,
 {refl,},
 {rw[to_bool_ff (nat.succ_ne_zero n),ff_bor,pow_succ,nat.bodd_mul,ih],
  cases (nat.bodd m); cases (to_bool (n = 0)); refl
 }
end

def flatten {α : Type} (l : list (list α)) : list α :=
 list.foldr list.append list.nil l

lemma flatten_length {α : Type} : ∀ (l : list (list α)),
 (flatten l).length = list.sum (l.map list.length)
| list.nil := rfl
| (list.cons u l) := by {
   erw[list.length_append,flatten_length l,list.map_cons,list.sum_cons],
   }

def all_words {α : Type} : ∀ (n : ℕ) (alphabet : list α), list (list α)
| 0 _ := [list.nil]
| (nat.succ n) alphabet :=
   flatten (list.map (λ a,list.map (list.cons a) (all_words n alphabet)) alphabet)

lemma all_words_length {α : Type} (n : ℕ) (alphabet : list α) :
 (all_words n alphabet).length = alphabet.length ^ n :=
begin
 induction n with n ih,
 {refl,},
 {erw[all_words,flatten_length],
  rw[pow_succ,mul_comm],
  let f : α → list (list α) :=
   λ a, list.map (list.cons a) (all_words n alphabet),
  let g : α → ℕ := λ a, (f a).length,
  let l := alphabet.map f,
  let m := l.map list.length,
  have h0 : ∀ a : α, g a = alphabet.length ^ n :=
    λ a, (list.length_map _ _).trans ih,
  have h1 : m.length = alphabet.length :=
    (list.length_map list.length l).trans (list.length_map f alphabet),
  have h2 : ∀ i : ℕ, i ∈ m → i = alphabet.length ^ n :=
   begin
    intros i i_in_m,
    rcases list.mem_map.mp i_in_m with ⟨l0,⟨l0_in_l,l0_length⟩⟩,
    rcases list.mem_map.mp l0_in_l with ⟨a,⟨a_in_alphabet,fa_eq_l0⟩⟩,
    exact ((h0 a).symm.trans
              ((congr_arg list.length fa_eq_l0).trans l0_length)).symm,
   end,
  let h3 := (@list.eq_repeat ℕ (alphabet.length ^ n) alphabet.length
   (l.map list.length)).mpr ⟨h1,h2⟩,
  exact ((congr_arg list.sum h3).trans
   (list.sum_const_nat (alphabet.length ^ n) alphabet.length)),
 }
end