/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import computability.partrec_code

/-!
# Computability theory and the halting problem

A universal partial recursive function, Rice's theorem, and the halting problem.

## References

* [Mario Carneiro, *Formalizing computability theory via partial recursive functions*][carneiro2019]
-/

open encodable denumerable

namespace nat.partrec
open computable roption

theorem merge' {f g}
  (hf : nat.partrec f) (hg : nat.partrec g) :
  ∃ h, nat.partrec h ∧ ∀ a,
    (∀ x ∈ h a, x ∈ f a ∨ x ∈ g a) ∧
    ((h a).dom ↔ (f a).dom ∨ (g a).dom) :=
begin
  rcases code.exists_code.1 hf with ⟨cf, rfl⟩,
  rcases code.exists_code.1 hg with ⟨cg, rfl⟩,
  have : nat.partrec (λ n,
    (nat.rfind_opt (λ k, cf.evaln k n <|> cg.evaln k n))) :=
  partrec.nat_iff.1 (partrec.rfind_opt $
    primrec.option_orelse.to_comp.comp
      (code.evaln_prim.to_comp.comp $ (snd.pair (const cf)).pair fst)
      (code.evaln_prim.to_comp.comp $ (snd.pair (const cg)).pair fst)),
  refine ⟨_, this, λ n, _⟩,
  suffices, refine ⟨this,
    ⟨λ h, (this _ ⟨h, rfl⟩).imp Exists.fst Exists.fst, _⟩⟩,
  { intro h, rw nat.rfind_opt_dom,
    simp [dom_iff_mem, code.evaln_complete] at h,
    rcases h with ⟨x, k, e⟩ | ⟨x, k, e⟩,
    { refine ⟨k, x, _⟩, simp [e] },
    { refine ⟨k, _⟩,
      cases cf.evaln k n with y,
      { exact ⟨x, by simp [e]⟩ },
      { exact ⟨y, by simp⟩ } } },
  { intros x h,
    rcases nat.rfind_opt_spec h with ⟨k, e⟩,
    revert e,
    simp; cases e' : cf.evaln k n with y; simp; intro,
    { exact or.inr (code.evaln_sound e) },
    { subst y,
        exact or.inl (code.evaln_sound e') } }
end

end nat.partrec

namespace partrec
variables {α : Type*} {β : Type*} {γ : Type*} {σ : Type*}
variables [primcodable α] [primcodable β] [primcodable γ] [primcodable σ]

open computable roption nat.partrec (code) nat.partrec.code

theorem merge' {f g : α →. σ}
  (hf : partrec f) (hg : partrec g) :
  ∃ k : α →. σ, partrec k ∧ ∀ a,
    (∀ x ∈ k a, x ∈ f a ∨ x ∈ g a) ∧
    ((k a).dom ↔ (f a).dom ∨ (g a).dom) :=
let ⟨k, hk, H⟩ :=
  nat.partrec.merge' (bind_decode2_iff.1 hf) (bind_decode2_iff.1 hg) in
begin
  let k' := λ a, (k (encode a)).bind (λ n, decode σ n),
  refine ⟨k', ((nat_iff.2 hk).comp computable.encode).bind
    (computable.decode.of_option.comp snd).to₂, λ a, _⟩,
  suffices, refine ⟨this,
    ⟨λ h, (this _ ⟨h, rfl⟩).imp Exists.fst Exists.fst, _⟩⟩,
  { intro h, simp [k'],
    have hk : (k (encode a)).dom :=
      (H _).2.2 (by simpa [encodek2] using h),
    existsi hk,
    cases (H _).1 _ ⟨hk, rfl⟩ with h h;
    { simp at h,
      rcases h with ⟨a', ha', y, hy, e⟩,
      simp [e.symm, encodek] } },
  { intros x h', simp [k'] at h',
    rcases h' with ⟨n, hn, hx⟩,
    have := (H _).1 _ hn,
    simp [mem_decode2, encode_injective.eq_iff] at this,
    cases this with h h;
    { rcases h with ⟨a', ha, rfl⟩,
      simp [encodek] at hx, subst a',
      simp [ha] } },
end

theorem merge {f g : α →. σ}
  (hf : partrec f) (hg : partrec g)
  (H : ∀ a (x ∈ f a) (y ∈ g a), x = y) :
  ∃ k : α →. σ, partrec k ∧ ∀ a x, x ∈ k a ↔ x ∈ f a ∨ x ∈ g a :=
let ⟨k, hk, K⟩ := merge' hf hg in
⟨k, hk, λ a x, ⟨(K _).1 _, λ h, begin
  have : (k a).dom := (K _).2.2 (h.imp Exists.fst Exists.fst),
  refine ⟨this, _⟩,
  cases h with h h; cases (K _).1 _ ⟨this, rfl⟩ with h' h',
  { exact mem_unique h' h },
  { exact (H _ _ h _ h').symm },
  { exact H _ _ h' _ h },
  { exact mem_unique h' h }
end⟩⟩

theorem cond {c : α → bool} {f : α →. σ} {g : α →. σ}
  (hc : computable c) (hf : partrec f) (hg : partrec g) :
  partrec (λ a, cond (c a) (f a) (g a)) :=
let ⟨cf, ef⟩ := exists_code.1 hf,
    ⟨cg, eg⟩ := exists_code.1 hg in
((eval_part.comp
    (computable.cond hc (const cf) (const cg)) computable.id).bind
  ((@computable.decode σ _).comp snd).of_option.to₂).of_eq $
λ a, by cases c a; simp [ef, eg, encodek]

theorem sum_cases
  {f : α → β ⊕ γ} {g : α → β →. σ} {h : α → γ →. σ}
  (hf : computable f) (hg : partrec₂ g) (hh : partrec₂ h) :
  @partrec _ σ _ _ (λ a, sum.cases_on (f a) (g a) (h a)) :=
option_some_iff.1 $ (cond
  (sum_cases hf (const tt).to₂ (const ff).to₂)
  (sum_cases_left hf (option_some_iff.2 hg).to₂ (const option.none).to₂)
  (sum_cases_right hf (const option.none).to₂ (option_some_iff.2 hh).to₂))
.of_eq $ λ a, by cases f a; simp

end partrec

/-- A computable predicate is one whose indicator function is computable. -/
def computable_pred {α} [primcodable α] (p : α → Prop) :=
∃ [D : decidable_pred p],
by exactI computable (λ a, to_bool (p a))

/-- A recursively enumerable predicate is one which is the domain of a computable partial function.
 -/
def re_pred {α} [primcodable α] (p : α → Prop) :=
partrec (λ a, roption.assert (p a) (λ _, roption.some ()))

theorem computable_pred.of_eq {α} [primcodable α]
  {p q : α → Prop}
  (hp : computable_pred p) (H : ∀ a, p a ↔ q a) : computable_pred q :=
(funext (λ a, propext (H a)) : p = q) ▸ hp

namespace computable_pred
variables {α : Type*} {σ : Type*}
variables [primcodable α] [primcodable σ]
open nat.partrec (code) nat.partrec.code computable

theorem computable_iff {p : α → Prop} :
  computable_pred p ↔ ∃ f : α → bool, computable f ∧ p = λ a, f a :=
⟨λ ⟨D, h⟩, by exactI ⟨_, h, funext $ λ a, propext (to_bool_iff _).symm⟩,
 by rintro ⟨f, h, rfl⟩; exact ⟨by apply_instance, by simpa using h⟩⟩

protected theorem not {p : α → Prop}
  (hp : computable_pred p) : computable_pred (λ a, ¬ p a) :=
by rcases computable_iff.1 hp with ⟨f, hf, rfl⟩; exact
  ⟨by apply_instance,
    (cond hf (const ff) (const tt)).of_eq
      (λ n, by {dsimp, cases f n; refl})⟩

theorem to_re {p : α → Prop} (hp : computable_pred p) : re_pred p :=
begin
  rcases computable_iff.1 hp with ⟨f, hf, rfl⟩,
  unfold re_pred,
  refine (partrec.cond hf (partrec.const' (roption.some ())) partrec.none).of_eq
    (λ n, roption.ext $ λ a, _),
  cases a, cases f n; simp
end

theorem rice₂ (C : set code)
  (H : ∀ cf cg, eval cf = eval cg → (cf ∈ C ↔ cg ∈ C)) :
  computable_pred (λ c, c ∈ C) ↔ C = ∅ ∨ C = set.univ :=
by haveI := classical.dec; exact
have hC : ∀ f, f ∈ C ↔ eval f ∈ eval '' C,
from λ f, ⟨set.mem_image_of_mem _, λ ⟨g, hg, e⟩, (H _ _ e).1 hg⟩,
⟨λ h, or_iff_not_imp_left.2 $ λ C0,
  set.eq_univ_of_forall $ λ cg,
  let ⟨cf, fC⟩ := set.ne_empty_iff_nonempty.1 C0 in
  (hC _).2 $ rice (eval '' C) (h.of_eq hC)
    (partrec.nat_iff.1 $ eval_part.comp (const cf) computable.id)
    (partrec.nat_iff.1 $ eval_part.comp (const cg) computable.id)
    ((hC _).1 fC),
λ h, by rcases h with rfl | rfl; simp [computable_pred];
  exact ⟨by apply_instance, computable.const _⟩⟩

theorem halting_problem (n) : ¬ computable_pred (λ c, (eval c n).dom)
| h := rice {f | (f n).dom} h nat.partrec.zero nat.partrec.none trivial

-- Post's theorem on the equivalence of r.e., co-r.e. sets and
-- computable sets. The assumption that p is decidable is required
-- unless we assume Markov's principle or LEM.
@[nolint decidable_classical]
theorem computable_iff_re_compl_re {p : α → Prop} [decidable_pred p] :
  computable_pred p ↔ re_pred p ∧ re_pred (λ a, ¬ p a) :=
⟨λ h, ⟨h.to_re, h.not.to_re⟩, λ ⟨h₁, h₂⟩, ⟨‹_›, begin
  rcases partrec.merge
    (h₁.map (computable.const tt).to₂)
    (h₂.map (computable.const ff).to₂) _ with ⟨k, pk, hk⟩,
  { refine partrec.of_eq pk (λ n, roption.eq_some_iff.2 _),
    rw hk, simp, apply decidable.em },
  { intros a x hx y hy, simp at hx hy, cases hy.1 hx.1 }
end⟩⟩

end computable_pred

namespace nat
open vector roption

/-- A simplified basis for `partrec`. -/
inductive partrec' : ∀ {n}, (vector ℕ n →. ℕ) → Prop
| prim {n f} : @primrec' n f → @partrec' n f
| comp {m n f} (g : fin n → vector ℕ m →. ℕ) :
  partrec' f → (∀ i, partrec' (g i)) →
  partrec' (λ v, m_of_fn (λ i, g i v) >>= f)
| rfind {n} {f : vector ℕ (n+1) → ℕ} : @partrec' (n+1) f →
  partrec' (λ v, rfind (λ n, some (f (n ::ᵥ v) = 0)))

end nat

namespace nat.partrec'
open vector partrec computable nat (partrec') nat.partrec'

theorem to_part {n f} (pf : @partrec' n f) : partrec f :=
begin
  induction pf,
  case nat.partrec'.prim : n f hf { exact hf.to_prim.to_comp },
  case nat.partrec'.comp : m n f g _ _ hf hg {
    exact (vector_m_of_fn (λ i, hg i)).bind (hf.comp snd) },
  case nat.partrec'.rfind : n f _ hf {
    have := ((primrec.eq.comp primrec.id (primrec.const 0)).to_comp.comp
      (hf.comp (vector_cons.comp snd fst))).to₂.part,
    exact this.rfind },
end

theorem of_eq {n} {f g : vector ℕ n →. ℕ}
  (hf : partrec' f) (H : ∀ i, f i = g i) : partrec' g :=
(funext H : f = g) ▸ hf

theorem of_prim {n} {f : vector ℕ n → ℕ} (hf : primrec f) : @partrec' n f :=
prim (nat.primrec'.of_prim hf)

theorem head {n : ℕ} : @partrec' n.succ (@head ℕ n) :=
prim nat.primrec'.head

theorem tail {n f} (hf : @partrec' n f) : @partrec' n.succ (λ v, f v.tail) :=
(hf.comp _ (λ i, @prim _ _ $ nat.primrec'.nth i.succ)).of_eq $
λ v, by simp; rw [← of_fn_nth v.tail]; congr; funext i; simp

protected theorem bind {n f g}
  (hf : @partrec' n f) (hg : @partrec' (n+1) g) :
  @partrec' n (λ v, (f v).bind (λ a, g (a ::ᵥ v))) :=
(@comp n (n+1) g
  (λ i, fin.cases f (λ i v, some (v.nth i)) i) hg
  (λ i, begin
    refine fin.cases _ (λ i, _) i; simp *,
    exact prim (nat.primrec'.nth _)
  end)).of_eq $
λ v, by simp [m_of_fn, roption.bind_assoc, pure]

protected theorem map {n f} {g : vector ℕ (n+1) → ℕ}
  (hf : @partrec' n f) (hg : @partrec' (n+1) g) :
  @partrec' n (λ v, (f v).map (λ a, g (a ::ᵥ v))) :=
by simp [(roption.bind_some_eq_map _ _).symm];
   exact hf.bind hg

/-- Analogous to `nat.partrec'` for `ℕ`-valued functions, a predicate for partial recursive
  vector-valued functions.-/
def vec {n m} (f : vector ℕ n → vector ℕ m) :=
∀ i, partrec' (λ v, (f v).nth i)

theorem vec.prim {n m f} (hf : @nat.primrec'.vec n m f) : vec f :=
λ i, prim $ hf i

protected theorem nil {n} : @vec n 0 (λ _, nil) := λ i, i.elim0

protected theorem cons {n m} {f : vector ℕ n → ℕ} {g}
  (hf : @partrec' n f) (hg : @vec n m g) :
  vec (λ v, f v ::ᵥ g v) :=
λ i, fin.cases (by simp *) (λ i, by simp [hg i]) i

theorem idv {n} : @vec n n id := vec.prim nat.primrec'.idv

theorem comp' {n m f g} (hf : @partrec' m f) (hg : @vec n m g) :
  partrec' (λ v, f (g v)) :=
(hf.comp _ hg).of_eq $ λ v, by simp

theorem comp₁ {n} (f : ℕ →. ℕ) {g : vector ℕ n → ℕ}
  (hf : @partrec' 1 (λ v, f v.head)) (hg : @partrec' n g) :
  @partrec' n (λ v, f (g v)) :=
by simpa using hf.comp' (partrec'.cons hg partrec'.nil)

theorem rfind_opt {n} {f : vector ℕ (n+1) → ℕ}
  (hf : @partrec' (n+1) f) :
  @partrec' n (λ v, nat.rfind_opt (λ a, of_nat (option ℕ) (f (a ::ᵥ v)))) :=
((rfind $ (of_prim (primrec.nat_sub.comp (primrec.const 1) primrec.vector_head))
   .comp₁ (λ n, roption.some (1 - n)) hf)
   .bind ((prim nat.primrec'.pred).comp₁ nat.pred hf)).of_eq $
λ v, roption.ext $ λ b, begin
  simp [nat.rfind_opt, -nat.mem_rfind],
  refine exists_congr (λ a,
    (and_congr (iff_of_eq _) iff.rfl).trans (and_congr_right (λ h, _))),
  { congr; funext n,
    simp, cases f (n ::ᵥ v); simp [nat.succ_ne_zero]; refl },
  { have := nat.rfind_spec h,
    simp at this,
    cases f (a ::ᵥ v) with c, {cases this},
    rw [← option.some_inj, eq_comm], refl }
end

open nat.partrec.code
theorem of_part : ∀ {n f}, partrec f → @partrec' n f :=
suffices ∀ f, nat.partrec f → @partrec' 1 (λ v, f v.head), from
λ n f hf, begin
  let g, swap,
  exact (comp₁ g (this g hf) (prim nat.primrec'.encode)).of_eq
    (λ i, by dsimp [g]; simp [encodek, roption.map_id']),
end,
λ f hf, begin
  rcases exists_code.1 hf with ⟨c, rfl⟩,
  simpa [eval_eq_rfind_opt] using
    (rfind_opt $ of_prim $ primrec.encode_iff.2 $ evaln_prim.comp $
      (primrec.vector_head.pair (primrec.const c)).pair $
      primrec.vector_head.comp primrec.vector_tail)
end

theorem part_iff {n f} : @partrec' n f ↔ partrec f := ⟨to_part, of_part⟩

theorem part_iff₁ {f : ℕ →. ℕ} :
  @partrec' 1 (λ v, f v.head) ↔ partrec f :=
part_iff.trans ⟨
  λ h, (h.comp $ (primrec.vector_of_fn $
    λ i, primrec.id).to_comp).of_eq (λ v, by simp),
  λ h, h.comp vector_head⟩

theorem part_iff₂ {f : ℕ → ℕ →. ℕ} :
  @partrec' 2 (λ v, f v.head v.tail.head) ↔ partrec₂ f :=
part_iff.trans ⟨
  λ h, (h.comp $ vector_cons.comp fst $
    vector_cons.comp snd (const nil)).of_eq (λ v, by simp),
  λ h, h.comp vector_head (vector_head.comp vector_tail)⟩

theorem vec_iff {m n f} : @vec m n f ↔ computable f :=
⟨λ h, by simpa using vector_of_fn (λ i, to_part (h i)),
 λ h i, of_part $ vector_nth.comp h (const i)⟩

end nat.partrec'


/-
Copyright (c) 2020 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.group_power.default
import Mathlib.PostPort

universes u_1 u_2

namespace Mathlib

/-!
# Powers of elements of groups with an adjoined zero element

In this file we define integer power functions for groups with an adjoined zero element.
This generalises the integer power function on a division ring.
-/

@[simp] theorem zero_pow' {M : Type u_1} [monoid_with_zero M] (n : ℕ) : n ≠ 0 → 0 ^ n = 0 := sorry

theorem ne_zero_pow {M : Type u_1} [monoid_with_zero M] {a : M} {n : ℕ} (hn : n ≠ 0) : a ^ n ≠ 0 → a ≠ 0 :=
  imp_of_not_imp_not (a ^ n ≠ 0) (a ≠ 0)
    (eq.mpr (id (imp_congr_eq (push_neg.not_not_eq (a = 0)) (push_neg.not_not_eq (a ^ n = 0))))
      fun (ᾰ : a = 0) => Eq._oldrec (zero_pow' n hn) (Eq.symm ᾰ))

@[simp] theorem zero_pow_eq_zero {M : Type u_1} [monoid_with_zero M] [nontrivial M] {n : ℕ} : 0 ^ n = 0 ↔ 0 < n := sorry

@[simp] theorem inv_pow' {G₀ : Type u_1} [group_with_zero G₀] (a : G₀) (n : ℕ) : a⁻¹ ^ n = (a ^ n⁻¹) := sorry

theorem pow_sub' {G₀ : Type u_1} [group_with_zero G₀] (a : G₀) {m : ℕ} {n : ℕ} (ha : a ≠ 0) (h : n ≤ m) : a ^ (m - n) = a ^ m * (a ^ n⁻¹) := sorry

theorem pow_inv_comm' {G₀ : Type u_1} [group_with_zero G₀] (a : G₀) (m : ℕ) (n : ℕ) : a⁻¹ ^ m * a ^ n = a ^ n * a⁻¹ ^ m :=
  commute.pow_pow (commute.inv_left' (commute.refl a)) m n

/--
The power operation in a group with zero.
This extends `monoid.pow` to negative integers
with the definition `a ^ (-n) = (a ^ n)⁻¹`.
-/
def fpow {G₀ : Type u_1} [group_with_zero G₀] (a : G₀) : ℤ → G₀ :=
  sorry

protected instance int.has_pow {G₀ : Type u_1} [group_with_zero G₀] : has_pow G₀ ℤ :=
  has_pow.mk fpow

@[simp] theorem fpow_coe_nat {G₀ : Type u_1} [group_with_zero G₀] (a : G₀) (n : ℕ) : a ^ ↑n = a ^ n :=
  rfl

theorem fpow_of_nat {G₀ : Type u_1} [group_with_zero G₀] (a : G₀) (n : ℕ) : a ^ Int.ofNat n = a ^ n :=
  rfl

@[simp] theorem fpow_neg_succ_of_nat {G₀ : Type u_1} [group_with_zero G₀] (a : G₀) (n : ℕ) : a ^ Int.negSucc n = (a ^ Nat.succ n⁻¹) :=
  rfl

@[simp] theorem fpow_zero {G₀ : Type u_1} [group_with_zero G₀] (a : G₀) : a ^ 0 = 1 :=
  rfl

@[simp] theorem fpow_one {G₀ : Type u_1} [group_with_zero G₀] (a : G₀) : a ^ 1 = a :=
  mul_one a

@[simp] theorem one_fpow {G₀ : Type u_1} [group_with_zero G₀] (n : ℤ) : 1 ^ n = 1 := sorry

theorem zero_fpow {G₀ : Type u_1} [group_with_zero G₀] (z : ℤ) : z ≠ 0 → 0 ^ z = 0 := sorry

@[simp] theorem fpow_neg {G₀ : Type u_1} [group_with_zero G₀] (a : G₀) (n : ℤ) : a ^ (-n) = (a ^ n⁻¹) := sorry

theorem fpow_neg_one {G₀ : Type u_1} [group_with_zero G₀] (x : G₀) : x ^ (-1) = (x⁻¹) :=
  congr_arg has_inv.inv (pow_one x)

theorem inv_fpow {G₀ : Type u_1} [group_with_zero G₀] (a : G₀) (n : ℤ) : a⁻¹ ^ n = (a ^ n⁻¹) :=
  int.cases_on n (fun (n : ℕ) => idRhs (a⁻¹ ^ n = (a ^ n⁻¹)) (inv_pow' a n))
    fun (n : ℕ) => idRhs (a⁻¹ ^ (n + 1)⁻¹ = (a ^ (n + 1)⁻¹⁻¹)) (congr_arg has_inv.inv (inv_pow' a (n + 1)))

theorem fpow_add_one {G₀ : Type u_1} [group_with_zero G₀] {a : G₀} (ha : a ≠ 0) (n : ℤ) : a ^ (n + 1) = a ^ n * a := sorry

theorem fpow_sub_one {G₀ : Type u_1} [group_with_zero G₀] {a : G₀} (ha : a ≠ 0) (n : ℤ) : a ^ (n - 1) = a ^ n * (a⁻¹) := sorry

theorem fpow_add {G₀ : Type u_1} [group_with_zero G₀] {a : G₀} (ha : a ≠ 0) (m : ℤ) (n : ℤ) : a ^ (m + n) = a ^ m * a ^ n := sorry

theorem fpow_add' {G₀ : Type u_1} [group_with_zero G₀] {a : G₀} {m : ℤ} {n : ℤ} (h : a ≠ 0 ∨ m + n ≠ 0 ∨ m = 0 ∧ n = 0) : a ^ (m + n) = a ^ m * a ^ n := sorry

theorem fpow_one_add {G₀ : Type u_1} [group_with_zero G₀] {a : G₀} (h : a ≠ 0) (i : ℤ) : a ^ (1 + i) = a * a ^ i :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a ^ (1 + i) = a * a ^ i)) (fpow_add h 1 i)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a ^ 1 * a ^ i = a * a ^ i)) (fpow_one a))) (Eq.refl (a * a ^ i)))

theorem semiconj_by.fpow_right {G₀ : Type u_1} [group_with_zero G₀] {a : G₀} {x : G₀} {y : G₀} (h : semiconj_by a x y) (m : ℤ) : semiconj_by a (x ^ m) (y ^ m) :=
  int.cases_on m (fun (m : ℕ) => idRhs (semiconj_by a (x ^ m) (y ^ m)) (semiconj_by.pow_right h m))
    fun (m : ℕ) =>
      idRhs (semiconj_by a (x ^ (m + 1)⁻¹) (y ^ (m + 1)⁻¹)) (semiconj_by.inv_right' (semiconj_by.pow_right h (m + 1)))

theorem commute.fpow_right {G₀ : Type u_1} [group_with_zero G₀] {a : G₀} {b : G₀} (h : commute a b) (m : ℤ) : commute a (b ^ m) :=
  semiconj_by.fpow_right h

theorem commute.fpow_left {G₀ : Type u_1} [group_with_zero G₀] {a : G₀} {b : G₀} (h : commute a b) (m : ℤ) : commute (a ^ m) b :=
  commute.symm (commute.fpow_right (commute.symm h) m)

theorem commute.fpow_fpow {G₀ : Type u_1} [group_with_zero G₀] {a : G₀} {b : G₀} (h : commute a b) (m : ℤ) (n : ℤ) : commute (a ^ m) (b ^ n) :=
  commute.fpow_right (commute.fpow_left h m) n

theorem commute.fpow_self {G₀ : Type u_1} [group_with_zero G₀] (a : G₀) (n : ℤ) : commute (a ^ n) a :=
  commute.fpow_left (commute.refl a) n

theorem commute.self_fpow {G₀ : Type u_1} [group_with_zero G₀] (a : G₀) (n : ℤ) : commute a (a ^ n) :=
  commute.fpow_right (commute.refl a) n

theorem commute.fpow_fpow_self {G₀ : Type u_1} [group_with_zero G₀] (a : G₀) (m : ℤ) (n : ℤ) : commute (a ^ m) (a ^ n) :=
  commute.fpow_fpow (commute.refl a) m n

theorem fpow_bit0 {G₀ : Type u_1} [group_with_zero G₀] (a : G₀) (n : ℤ) : a ^ bit0 n = a ^ n * a ^ n := sorry

theorem fpow_bit1 {G₀ : Type u_1} [group_with_zero G₀] (a : G₀) (n : ℤ) : a ^ bit1 n = a ^ n * a ^ n * a := sorry

theorem fpow_mul {G₀ : Type u_1} [group_with_zero G₀] (a : G₀) (m : ℤ) (n : ℤ) : a ^ (m * n) = (a ^ m) ^ n := sorry

theorem fpow_mul' {G₀ : Type u_1} [group_with_zero G₀] (a : G₀) (m : ℤ) (n : ℤ) : a ^ (m * n) = (a ^ n) ^ m :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a ^ (m * n) = (a ^ n) ^ m)) (mul_comm m n)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a ^ (n * m) = (a ^ n) ^ m)) (fpow_mul a n m))) (Eq.refl ((a ^ n) ^ m)))

@[simp] theorem units.coe_gpow' {G₀ : Type u_1} [group_with_zero G₀] (u : units G₀) (n : ℤ) : ↑(u ^ n) = ↑u ^ n := sorry

theorem fpow_ne_zero_of_ne_zero {G₀ : Type u_1} [group_with_zero G₀] {a : G₀} (ha : a ≠ 0) (z : ℤ) : a ^ z ≠ 0 :=
  int.cases_on z (fun (z : ℕ) => idRhs (a ^ z ≠ 0) (pow_ne_zero z ha))
    fun (z : ℕ) => idRhs (a ^ Nat.succ z⁻¹ ≠ 0) (inv_ne_zero (pow_ne_zero (Nat.succ z) ha))

theorem fpow_sub {G₀ : Type u_1} [group_with_zero G₀] {a : G₀} (ha : a ≠ 0) (z1 : ℤ) (z2 : ℤ) : a ^ (z1 - z2) = a ^ z1 / a ^ z2 := sorry

theorem commute.mul_fpow {G₀ : Type u_1} [group_with_zero G₀] {a : G₀} {b : G₀} (h : commute a b) (i : ℤ) : (a * b) ^ i = a ^ i * b ^ i := sorry

theorem mul_fpow {G₀ : Type u_1} [comm_group_with_zero G₀] (a : G₀) (b : G₀) (m : ℤ) : (a * b) ^ m = a ^ m * b ^ m :=
  commute.mul_fpow (commute.all a b) m

theorem fpow_bit0' {G₀ : Type u_1} [group_with_zero G₀] (a : G₀) (n : ℤ) : a ^ bit0 n = (a * a) ^ n :=
  Eq.trans (fpow_bit0 a n) (Eq.symm (commute.mul_fpow (commute.refl a) n))

theorem fpow_bit1' {G₀ : Type u_1} [group_with_zero G₀] (a : G₀) (n : ℤ) : a ^ bit1 n = (a * a) ^ n * a :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a ^ bit1 n = (a * a) ^ n * a)) (fpow_bit1 a n)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a ^ n * a ^ n * a = (a * a) ^ n * a)) (commute.mul_fpow (commute.refl a) n)))
      (Eq.refl (a ^ n * a ^ n * a)))

theorem fpow_eq_zero {G₀ : Type u_1} [group_with_zero G₀] {x : G₀} {n : ℤ} (h : x ^ n = 0) : x = 0 :=
  classical.by_contradiction fun (hx : ¬x = 0) => fpow_ne_zero_of_ne_zero hx n h

theorem fpow_ne_zero {G₀ : Type u_1} [group_with_zero G₀] {x : G₀} (n : ℤ) : x ≠ 0 → x ^ n ≠ 0 :=
  mt fpow_eq_zero

theorem fpow_neg_mul_fpow_self {G₀ : Type u_1} [group_with_zero G₀] (n : ℤ) {x : G₀} (h : x ≠ 0) : x ^ (-n) * x ^ n = 1 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (x ^ (-n) * x ^ n = 1)) (fpow_neg x n))) (inv_mul_cancel (fpow_ne_zero n h))

theorem one_div_pow {G₀ : Type u_1} [group_with_zero G₀] {a : G₀} (n : ℕ) : (1 / a) ^ n = 1 / a ^ n := sorry

theorem one_div_fpow {G₀ : Type u_1} [group_with_zero G₀] {a : G₀} (n : ℤ) : (1 / a) ^ n = 1 / a ^ n := sorry

@[simp] theorem inv_fpow' {G₀ : Type u_1} [group_with_zero G₀] {a : G₀} (n : ℤ) : a⁻¹ ^ n = a ^ (-n) := sorry

@[simp] theorem div_pow {G₀ : Type u_1} [comm_group_with_zero G₀] (a : G₀) (b : G₀) (n : ℕ) : (a / b) ^ n = a ^ n / b ^ n := sorry

@[simp] theorem div_fpow {G₀ : Type u_1} [comm_group_with_zero G₀] (a : G₀) {b : G₀} (n : ℤ) : (a / b) ^ n = a ^ n / b ^ n := sorry

theorem div_sq_cancel {G₀ : Type u_1} [comm_group_with_zero G₀] {a : G₀} (ha : a ≠ 0) (b : G₀) : a ^ bit0 1 * b / a = a * b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a ^ bit0 1 * b / a = a * b)) (pow_two a)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a * a * b / a = a * b)) (mul_assoc a a b)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (a * (a * b) / a = a * b)) (mul_div_cancel_left (a * b) ha))) (Eq.refl (a * b))))

/-- If a monoid homomorphism `f` between two `group_with_zero`s maps `0` to `0`, then it maps `x^n`,
`n : ℤ`, to `(f x)^n`. -/
theorem monoid_with_zero_hom.map_fpow {G₀ : Type u_1} {G₀' : Type u_2} [group_with_zero G₀] [group_with_zero G₀'] (f : monoid_with_zero_hom G₀ G₀') (x : G₀) (n : ℤ) : coe_fn f (x ^ n) = coe_fn f x ^ n := sorry


/-
Copyright (c) 2017 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.Lean3Lib.data.rbtree.basic

universes u

namespace Mathlib

namespace rbnode

theorem find.induction {α : Type u} {p : rbnode α → Prop} (lt : α → α → Prop) [DecidableRel lt]
    (t : rbnode α) (x : α) (h₁ : p leaf)
    (h₂ :
      ∀ (l : rbnode α) (y : α) (r : rbnode α),
        cmp_using lt x y = ordering.lt → p l → p (red_node l y r))
    (h₃ :
      ∀ (l : rbnode α) (y : α) (r : rbnode α), cmp_using lt x y = ordering.eq → p (red_node l y r))
    (h₄ :
      ∀ (l : rbnode α) (y : α) (r : rbnode α),
        cmp_using lt x y = ordering.gt → p r → p (red_node l y r))
    (h₅ :
      ∀ (l : rbnode α) (y : α) (r : rbnode α),
        cmp_using lt x y = ordering.lt → p l → p (black_node l y r))
    (h₆ :
      ∀ (l : rbnode α) (y : α) (r : rbnode α),
        cmp_using lt x y = ordering.eq → p (black_node l y r))
    (h₇ :
      ∀ (l : rbnode α) (y : α) (r : rbnode α),
        cmp_using lt x y = ordering.gt → p r → p (black_node l y r)) :
    p t :=
  sorry

theorem find_correct {α : Type u} {t : rbnode α} {lt : α → α → Prop} {x : α} [DecidableRel lt]
    [is_strict_weak_order α lt] {lo : Option α} {hi : Option α} (hs : is_searchable lt t lo hi) :
    mem lt x t ↔ ∃ (y : α), find lt t x = some y ∧ strict_weak_order.equiv x y :=
  sorry

theorem mem_of_mem_exact {α : Type u} {lt : α → α → Prop} [is_irrefl α lt] {x : α} {t : rbnode α} :
    mem_exact x t → mem lt x t :=
  sorry

theorem find_correct_exact {α : Type u} {t : rbnode α} {lt : α → α → Prop} {x : α} [DecidableRel lt]
    [is_strict_weak_order α lt] {lo : Option α} {hi : Option α} (hs : is_searchable lt t lo hi) :
    mem_exact x t ↔ find lt t x = some x :=
  sorry

theorem eqv_of_find_some {α : Type u} {t : rbnode α} {lt : α → α → Prop} {x : α} {y : α}
    [DecidableRel lt] [is_strict_weak_order α lt] {lo : Option α} {hi : Option α}
    (hs : is_searchable lt t lo hi) (he : find lt t x = some y) : strict_weak_order.equiv x y :=
  sorry

theorem find_eq_find_of_eqv {α : Type u} {lt : α → α → Prop} {a : α} {b : α} [DecidableRel lt]
    [is_strict_weak_order α lt] {t : rbnode α} {lo : Option α} {hi : Option α}
    (hs : is_searchable lt t lo hi) (heqv : strict_weak_order.equiv a b) :
    find lt t a = find lt t b :=
  sorry

end Mathlib


-- Formalization of cellular automata defined over two-dimensional orthogonal geometric lattices.

-- The structure 'cell_automaton' represents a cellular automaton.

-- The function 'step_n a n' represents the 'n'th generation of the CA 'a'.
-- The function 'make_canonical' computes the canonical form of an automaton.

-- Most theorems present are properties related to this functionality.

import grid utils data.vector

open utils

namespace grid

attribute [simp, reducible]
def Q (α : Type*) [grid α] := relative_grid.carrier α

end grid

open grid

section cell_automatons

structure cell_automaton (α : Type) [decidable_eq α] :=
  (g     : vec_grid₀ α)
  (empty : α)
  (neigh : point → list point)
  (f     : α → list α → α)
  (ext   : bounding_box → bounding_box)

end cell_automatons

section cell_automaton_instances

variables {α : Type} [decidable_eq α] [has_to_string α] (a : cell_automaton α)

open grid

def cell_automaton_to_str := grid_str a.g

instance : has_to_string (cell_automaton α) := ⟨cell_automaton_to_str⟩

instance : has_repr (cell_automaton α) := ⟨cell_automaton_to_str⟩

end cell_automaton_instances

section cell_automaton_quot_setoid_eq

variables {α : Type} [decidable_eq α] (a a₁ a₂ a₃ : cell_automaton α)

end cell_automaton_quot_setoid_eq

namespace cell_automaton

end cell_automaton

namespace cell_automatons

open cell_automaton grid

def neumann : point → list point
  | ⟨x, y⟩ :=
  [            ⟨x, y - 1⟩,
   ⟨x - 1, y⟩,             ⟨x + 1, y⟩,
               ⟨x, y + 1⟩             ]

def moore : point → list point
  | ⟨x, y⟩ :=
  [ ⟨x - 1, y - 1⟩, ⟨x, y - 1⟩, ⟨x + 1, y - 1⟩,
    ⟨x - 1, y    ⟩,             ⟨x + 1, y    ⟩,
    ⟨x - 1, y + 1⟩, ⟨x, y + 1⟩, ⟨x + 1, y + 1⟩ ]

def bounded_neigh {α} [grid α] (g : α)
  (f : point → list point) (p : grid_point g) : list point := f p

instance neigh_gridpoint_coe {α} [grid α] (g : α) :
  has_coe (point → list point)
          (grid_point g → list point) := ⟨bounded_neigh g⟩

def ext_id : bounding_box → bounding_box := id

def ext_one : bounding_box → bounding_box
  | ⟨⟨x₁, y₁⟩, ⟨x₂, y₂⟩, h⟩ := ⟨⟨x₁ - 1, y₁ - 1⟩, ⟨x₂ + 1, y₂ + 1⟩,
                                ⟨(add_lt_add h.1 dec_trivial),
                                 (add_lt_add h.2 dec_trivial)⟩⟩

end cell_automatons

section cell_automaton_props

variables {α : Type} [decidable_eq α] (a : cell_automaton α)

end cell_automaton_props

section cell_automaton_ops

open function list prod relative_grid

variables variables {α : Type} [decidable_eq α] (a : cell_automaton α)

def asize := size a.g

def bbox_of_caut := bbox_of_grid a.g

theorem caut_eq_iff {a₁ a₂ : cell_automaton α}
  (hempty : a₁.empty = a₂.empty)
  (hneigh : a₁.neigh = a₂.neigh)
  (hf : a₁.f = a₂.f)
  (hext : a₁.ext = a₂.ext) : a₁ = a₂ ↔ a₁.g = a₂.g :=
  ⟨λh, by simp [h], λh, by cases a₁; cases a₂; congr; cc⟩

private lemma pres_nonempty {α β : Type} {f} {filtered : list (α × β)}
  {l : list ℤ}
  (h : ¬empty_list filtered) (h₁ : l = map f ((fst ∘ unzip) filtered)) :
  ¬empty_list l :=
  by simp [h₁, map_empty_iff_l_empty, unzip_fst_empty_iff_l_empty, h]

def compute_bounds {α : Type} [decidable_eq α]
                   (a : cell_automaton α) : bounding_box :=
  let bounded  := gip_g a.g in
  let mapped   := ℘ a.g in
  let zipped   := zip bounded mapped in
  let filtered := filter (λx, snd x ≠ a.empty) zipped in
  if h : empty_list filtered
  then ⟨gbl a.g, gtr a.g, grid_is_bounding_box⟩ else
  let unzipped := fst ∘ unzip $ filtered in
  let xs       := map point.x unzipped in
  let ys       := map point.y unzipped in
  let min_x    := min_element xs (pres_nonempty h $ by simp) in
  let max_x    := max_element xs (pres_nonempty h $ by simp) in
  let min_y    := min_element ys (pres_nonempty h $ by simp) in
  let max_y    := max_element ys (pres_nonempty h $ by simp) in
  ⟨⟨min_x, min_y⟩, ⟨max_x + 1, max_y + 1⟩,
  begin
    simp [(↗), min_x, max_x, min_y, max_y];
    split; rw add_comm; exact int.lt_add_one_of_le (min_elem_le_max_elem _ _)
  end⟩

lemma compute_bounds_pres_overlaid
  : overlaid_by (compute_bounds a) ⟨gbl a.g, gtr a.g, grid_is_bounding_box⟩
  :=
begin
  simp [overlaid_by, compute_bounds],
  generalize h₂ : gip_g a.g = indices,
  by_cases h : empty_list (filter (λ (x : point × α), x.snd ≠ a.empty)
                                  (zip indices ℘ (a.g))); simp [h₂, h],
  {exact ⟨⟨le_refl _, le_refl _⟩, ⟨le_refl _, le_refl _⟩⟩},
  {
    split; split,
    {
      apply le_min_elem_of_all _ _ _ (λx, λh₁, _),
      simp at h₁, rcases h₁ with ⟨y₁, rest, h₃⟩, subst h₃,
      apply (zunzip_filter_first_irrel rest),
      rw ← h₂, intros y h₄,
      have h₅ := gip_g_in_grid h₄,
      simp [flip, is_in_grid, bbox_of_grid] at h₅,
      exact h₅.2.1
    },
    {
      rw [add_comm, ← sub_le_sub_iff_right (1 : ℤ), add_sub_assoc],
      have : 1 - 1 = (0 : ℤ), from dec_trivial, rw this, rw add_zero,
      apply max_le_elem_of_all _ _ _ (λx, λh₁, _),
      simp at h₁, rcases h₁ with ⟨y₁, rest, h₃⟩, subst h₃,
      apply (zunzip_filter_first_irrel rest), rw ← h₂, intros y h₄,
      have h₅ := gip_g_in_grid h₄,
      simp [flip, is_in_grid, bbox_of_grid] at h₅,
      simp [gtr],
      rw [add_comm (-1 : ℤ), ← sub_eq_add_neg, int.le_sub_one_iff],
      exact h₅.2.2
    },
    {
      rw [add_comm, ← sub_le_sub_iff_right (1 : ℤ), add_sub_assoc],
      have : 1 - 1 = (0 : ℤ), from dec_trivial, rw [this, add_zero],
      apply max_le_elem_of_all _ _ _ (λx, λh₁, _),
      simp at h₁, rcases h₁ with ⟨y₁, rest, h₃⟩, subst h₃,
      apply (zunzip_filter_first_irrel rest),
      rw ← h₂, intros y h₄,
      have h₅ := gip_g_in_grid h₄,
      simp [flip, is_in_grid, bbox_of_grid] at h₅,
      rw int.le_sub_one_iff,
      exact h₅.1.2
    },
    {
      apply le_min_elem_of_all _ _ _ (λx, λh₁, _),
      simp at h₁, rcases h₁ with ⟨y₁, rest, h₃⟩, subst h₃,
      simp [expand_gtr, point.x, point.y],
      apply (zunzip_filter_first_irrel rest),
      rw ← h₂, intros y h₄,
      have h₅ := gip_g_in_grid h₄,
      simp [flip, is_in_grid, bbox_of_grid, expand_gtr, point.x] at h₅,
      rcases h₅ with ⟨⟨h₅, h₆⟩, ⟨h₇, h₈⟩⟩,
      linarith
    }
  }
end

lemma compute_bounds_pres_grid :
    uncurry (↗) (points_of_box $ compute_bounds a) :=
begin
  generalize h : compute_bounds a = bounds,
  simp [points_of_box, uncurry, bounds.h]
end

def canonical_grid :=
  compute_bounds a = ⟨gbl a.g, gtr a.g, grid_is_bounding_box⟩

def make_canonical : cell_automaton α :=
  {a with g := ↑(subgrid a.g (compute_bounds a) (compute_bounds_pres_overlaid _))}

def is_canonical := make_canonical a = a

def aut_eq (a₁ a₂ : cell_automaton α) : Prop :=
  (band : bool → bool → bool) (℘(make_canonical a₁).g = ℘(make_canonical a₂).g)
  $ (band : bool → bool → bool)
    ((make_canonical a₁).g.r = (make_canonical a₂).g.r)
    ((make_canonical a₁).g.c = (make_canonical a₂).g.c)

infix ` ~ₐ `:100 := aut_eq

instance decidable_aut_eq {α} [decidable_eq α] {a₁ a₂} :
  decidable (@aut_eq α _ a₁ a₂) := by simp [(~ₐ)]; apply_instance

def ext_aut (a : cell_automaton α) : cell_automaton α :=
  let new_bb := a.ext (grid_bounds a.g) in
  let new_grid :=
    fgrid₀.mk
      (rows_of_box new_bb)
      (cols_of_box new_bb)
      (mul_pos rows_of_box_pos cols_of_box_pos)
      new_bb.p₁
      (λx y, if h : (⟨y, x⟩ : point) ∈ a.g
             then abs_data a.g $ grid_point_of_prod'
                     ((make_bounded h.1), (make_bounded h.2))
             else a.empty) in
  ⟨new_grid, a.empty, a.neigh, a.f, a.ext⟩

def default_if_nex {α : Type*} [grid α] (empty : carrier α)
  (g : α) (p : point) : carrier α :=
  if h : p ∈ g
  then abs_data g (grid_point_of_prod' (in_grid_bounded g p h))
  else empty

def next_gen (a : cell_automaton α) : cell_automaton α :=
  let new_grid := (ext_aut a).g in
  let cells := ℘ new_grid in
  let neighs := map a.neigh (gip_g new_grid) in
  let defaulted := @default_if_nex (vec_grid₀ α) _ a.empty new_grid in
  let neigh_cells := map (list.map defaulted) neighs in
  let new_cells := zip_with a.f cells neigh_cells in
  let grid :=
    @vec_grid₀.mk _
      ⟨grid_rows new_grid, grid_cols new_grid,
       mul_pos rows_of_box_pos cols_of_box_pos,
      ⟨new_cells, by simp [
                       zip_with_len_l,
                       length_generate_eq_size,
                       size,
                       rows_eq_try_sub_bly,
                       cols_eq_trx_sub_blx,
                       length_gip_g,
                       length_gip,
                       grid_is_bounding_box
                     ]
                  ⟩⟩ new_grid.o in
    make_canonical ⟨grid, a.empty, a.neigh, a.f, a.ext⟩

attribute [simp]
lemma next_gen_empty : (next_gen a).empty = a.empty := rfl

attribute [simp]
lemma next_gen_neigh : (next_gen a).neigh = a.neigh := rfl

attribute [simp]
lemma next_gen_f : (next_gen a).f = a.f := rfl

attribute [simp]
lemma next_gen_ext : (next_gen a).ext = a.ext := rfl

attribute [simp]
lemma iterate_next_gen_empty {n} : (iterate next_gen a n).empty = a.empty :=
  by induction n with n ih; simp [iterate_zero, *, iterate_one]

attribute [simp]
lemma iterate_next_gen_neigh {n} : (iterate next_gen a n).neigh = a.neigh :=
  by induction n with n ih; simp [iterate_zero, *, iterate_one]

attribute [simp]
lemma iterate_next_gen_f {n} : (iterate next_gen a n).f = a.f :=
  by induction n with n ih; simp [iterate_zero, *, iterate_one]

attribute [simp]
lemma iterate_next_gen_ext {n} : (iterate next_gen a n).ext = a.ext :=
  by induction n with n ih; simp [iterate_zero, *, iterate_one]

def step_n (n : ℕ) := iterate next_gen a n

def periodic := {n // n ≠ 0 ∧ step_n a n = a}

def count_at_single {α : Type} [decidable_eq α] (neigh : list α) (valid : α) :=
  list.sum ∘ map (λc, if c = valid then 1 else 0) $ neigh

def yield_at_if_in_neigh {α : Type} [decidable_eq α]
  (a : cell_automaton α) (p : point) :=
  if p ∈ a.neigh p
  then some $ @default_if_nex (vec_grid₀ α) _ a.empty a.g p
  else none

def yield_at (p : point) : α := @default_if_nex (vec_grid₀ α) _ a.empty a.g p

def mod_at (p : point) (x : α) (a : cell_automaton α) : cell_automaton α :=
  ⟨modify_at p x a.g, a.empty, a.neigh, a.f, a.ext⟩

def mod_many (l : list (point × α)) (a : cell_automaton α) : cell_automaton α :=
  ⟨modify_many l a.g, a.empty, a.neigh, a.f, a.ext⟩

end cell_automaton_ops

section counting

variables {α : Type} [decidable_eq α] (a : cell_automaton α)

def count (c : α) : ℕ := count_grid a.g c

lemma count_grid_eq_count {x} : count a x = count_grid a.g x := rfl

lemma count_cast_foa (a : vec_grid₀ α) {x} : count_grid ↑a x = count_grid a x :=
  by unfold_coes; simp [count_grid, gen_aof_eq_gen, gen_foa_eq_gen]

lemma count_cast_aof (a : fgrid₀ α) {x} : count_grid ↑a x = count_grid a x :=
  by unfold_coes; simp [count_grid, gen_aof_eq_gen, gen_foa_eq_gen]

lemma yield_at_nonempty {p} {a : cell_automaton α}
  (h : yield_at a p ≠ a.empty) : p ∈ a.g :=
begin
  by_contradiction contra,
  unfold yield_at default_if_nex at h,
  rw dif_neg contra at h,
  contradiction
end

end counting

namespace cardinals

section cardinals

variables {α : Type} [decidable_eq α] (a : cell_automaton α) (p : point)
          (neigh : point → list point)

def neigh_with_NW := ∀p : point, point.mk (p.x - 1) (p.y - 1) ∈ neigh p

def neigh_with_N  := ∀p : point, point.mk p.x       (p.y - 1) ∈ neigh p

def neigh_with_NE := ∀p : point, point.mk (p.x + 1) (p.y - 1) ∈ neigh p

def neigh_with_W  := ∀p : point, point.mk (p.x - 1) p.y       ∈ neigh p

def neigh_with_E  := ∀p : point, point.mk (p.x + 1) p.y       ∈ neigh p

def neigh_with_SW := ∀p : point, point.mk (p.x - 1) (p.y + 1) ∈ neigh p

def neigh_with_S  := ∀p : point, point.mk p.x       (p.y + 1) ∈ neigh p

def neigh_with_SE := ∀p : point, point.mk (p.x + 1) (p.y + 1) ∈ neigh p

open cell_automatons

lemma neumann_N : neigh_with_N neumann :=
  λ⟨x, y⟩, by simp [neumann]

lemma neumann_W : neigh_with_W neumann :=
  λ⟨x, y⟩, by simp [neumann]

lemma neumann_E : neigh_with_E neumann :=
  λ⟨x, y⟩, by simp [neumann]

lemma neumann_S : neigh_with_S neumann :=
  λ⟨x, y⟩, by simp [neumann]

lemma moore_NW : neigh_with_NW moore :=
  λ⟨x, y⟩, by simp [moore]

lemma moore_N : neigh_with_N moore :=
  λ⟨x, y⟩, by simp [moore]

lemma moore_NE : neigh_with_NE moore :=
  λ⟨x, y⟩, by simp [moore]

lemma moore_W : neigh_with_W moore :=
  λ⟨x, y⟩, by simp [moore]

lemma moore_E : neigh_with_E moore :=
  λ⟨x, y⟩, by simp [moore]

lemma moore_SW : neigh_with_SW moore :=
  λ⟨x, y⟩, by simp [moore]

lemma moore_S : neigh_with_S moore :=
  λ⟨x, y⟩, by simp [moore]

lemma moore_SE : neigh_with_SE moore :=
  λ⟨x, y⟩, by simp [moore]

def NW (h : neigh_with_NW a.neigh) := yield_at a ⟨p.x - 1, p.y - 1⟩

def N (h : neigh_with_N a.neigh) := yield_at a ⟨p.x, p.y - 1⟩

def NE (h : neigh_with_NE a.neigh) := yield_at a ⟨p.x + 1, p.y - 1⟩

def W (h : neigh_with_W a.neigh) := yield_at a ⟨p.x - 1, p.y⟩

def E (h : neigh_with_E a.neigh) := yield_at a ⟨p.x + 1, p.y⟩

def SW (h : neigh_with_SW a.neigh) := yield_at a ⟨p.x - 1, p.y + 1⟩

def S (h : neigh_with_S a.neigh) := yield_at a ⟨p.x, p.y + 1⟩

def SE (h : neigh_with_SE a.neigh) := yield_at a ⟨p.x + 1, p.y + 1⟩

end cardinals

end cardinals