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

Infinite sum over a topological monoid

This sum is known as unconditionally convergent, as it sums to the same value under all possible
permutations. For Euclidean spaces (finite dimensional Banach spaces) this is equivalent to absolute
convergence.

Note: There are summable sequences which are not unconditionally convergent! The other way holds
generally, see `tendsto_sum_nat_of_is_sum`.

Reference:
* Bourbaki: General Topology (1995), Chapter 3 §5 (Infinite sums in commutative groups)

-/
import logic.function algebra.big_operators data.set data.finset
       topology.metric_space.basic topology.algebra.uniform_group topology.algebra.ring
       topology.algebra.ordered topology.instances.real

noncomputable theory
open lattice finset filter function classical
local attribute [instance] prop_decidable

def option.cases_on' {α β} : option α → β → (α → β) → β
| none     n s := n
| (some a) n s := s a

variables {α : Type*} {β : Type*} {γ : Type*}

section is_sum
variables [add_comm_monoid α] [topological_space α] [topological_add_monoid α]

/-- Infinite sum on a topological monoid
The `at_top` filter on `finset α` is the limit of all finite sets towards the entire type. So we sum
up bigger and bigger sets. This sum operation is still invariant under reordering, and a absolute
sum operator.

This is based on Mario Carneiro's infinite sum in Metamath.
-/
def is_sum (f : β → α) (a : α) : Prop := tendsto (λs:finset β, s.sum f) at_top (nhds a)

/-- `has_sum f` means that `f` has some (infinite) sum. Use `tsum` to get the value. -/
def has_sum (f : β → α) : Prop := ∃a, is_sum f a

/-- `tsum f` is the sum of `f` it exists, or 0 otherwise -/
def tsum (f : β → α) := if h : has_sum f then classical.some h else 0

notation `∑` binders `, ` r:(scoped f, tsum f) := r

variables {f g : β → α} {a b : α} {s : finset β}

lemma is_sum_tsum (ha : has_sum f) : is_sum f (∑b, f b) :=
by simp [ha, tsum]; exact some_spec ha

lemma has_sum_spec (ha : is_sum f a) : has_sum f := ⟨a, ha⟩

lemma is_sum_zero : is_sum (λb, 0 : β → α) 0 :=
by simp [is_sum, tendsto_const_nhds]

lemma has_sum_zero : has_sum (λb, 0 : β → α) := has_sum_spec is_sum_zero

lemma is_sum_add (hf : is_sum f a) (hg : is_sum g b) : is_sum (λb, f b + g b) (a + b) :=
by simp [is_sum, sum_add_distrib]; exact tendsto_add hf hg

lemma has_sum_add (hf : has_sum f) (hg : has_sum g) : has_sum (λb, f b + g b) :=
has_sum_spec $ is_sum_add (is_sum_tsum hf)(is_sum_tsum hg)

lemma is_sum_sum {f : γ → β → α} {a : γ → α} {s : finset γ} :
  (∀i∈s, is_sum (f i) (a i)) → is_sum (λb, s.sum $ λi, f i b) (s.sum a) :=
finset.induction_on s (by simp [is_sum_zero]) (by simp [is_sum_add] {contextual := tt})

lemma has_sum_sum {f : γ → β → α} {s : finset γ} (hf : ∀i∈s, has_sum (f i)) :
  has_sum (λb, s.sum $ λi, f i b) :=
has_sum_spec $ is_sum_sum $ assume i hi, is_sum_tsum $ hf i hi

lemma is_sum_sum_of_ne_finset_zero (hf : ∀b∉s, f b = 0) : is_sum f (s.sum f) :=
tendsto_infi' s $ tendsto.congr'
  (assume t (ht : s ⊆ t), show s.sum f = t.sum f, from sum_subset ht $ assume x _, hf _)
  tendsto_const_nhds

lemma has_sum_sum_of_ne_finset_zero (hf : ∀b∉s, f b = 0) : has_sum f :=
has_sum_spec $ is_sum_sum_of_ne_finset_zero hf

lemma is_sum_ite_eq (b : β) (a : α) : is_sum (λb', if b' = b then a else 0) a :=
suffices
  is_sum (λb', if b' = b then a else 0) (({b} : finset β).sum (λb', if b' = b then a else 0)), from
  by simpa,
is_sum_sum_of_ne_finset_zero $ assume b' hb,
  have b' ≠ b, by simpa using hb,
  by rw [if_neg this]

lemma is_sum_of_iso {j : γ → β} {i : β → γ}
  (hf : is_sum f a) (h₁ : ∀x, i (j x) = x) (h₂ : ∀x, j (i x) = x) : is_sum (f ∘ j) a :=
have ∀x y, j x = j y → x = y,
  from assume x y h,
  have i (j x) = i (j y), by rw [h],
  by rwa [h₁, h₁] at this,
have (λs:finset γ, s.sum (f ∘ j)) = (λs:finset β, s.sum f) ∘ (λs:finset γ, s.image j),
  from funext $ assume s, (sum_image $ assume x _ y _, this x y).symm,
show tendsto (λs:finset γ, s.sum (f ∘ j)) at_top (nhds a),
   by rw [this]; apply (tendsto_finset_image_at_top_at_top h₂).comp hf

lemma is_sum_iff_is_sum_of_iso {j : γ → β} (i : β → γ)
  (h₁ : ∀x, i (j x) = x) (h₂ : ∀x, j (i x) = x) :
  is_sum (f ∘ j) a ↔ is_sum f a :=
iff.intro
  (assume hfj,
    have is_sum ((f ∘ j) ∘ i) a, from is_sum_of_iso hfj h₂ h₁,
    by simp [(∘), h₂] at this; assumption)
  (assume hf, is_sum_of_iso hf h₁ h₂)

lemma is_sum_hom (g : α → γ) [add_comm_monoid γ] [topological_space γ] [topological_add_monoid γ]
  [is_add_monoid_hom g] (h₃ : continuous g) (hf : is_sum f a) :
  is_sum (g ∘ f) (g a) :=
have (λs:finset β, s.sum (g ∘ f)) = g ∘ (λs:finset β, s.sum f),
  from funext $ assume s, sum_hom g,
show tendsto (λs:finset β, s.sum (g ∘ f)) at_top (nhds (g a)),
  by rw [this]; exact hf.comp (continuous_iff_continuous_at.mp h₃ a)

lemma tendsto_sum_nat_of_is_sum {f : ℕ → α} (h : is_sum f a) :
  tendsto (λn:ℕ, (range n).sum f) at_top (nhds a) :=
suffices map (λ (n : ℕ), sum (range n) f) at_top ≤ map (λ (s : finset ℕ), sum s f) at_top,
  from le_trans this h,
assume s (hs : {t : finset ℕ | t.sum f ∈ s} ∈ at_top),
let ⟨t, ht⟩ := mem_at_top_sets.mp hs, ⟨n, hn⟩ := @exists_nat_subset_range t in
mem_at_top_sets.mpr ⟨n, assume n' hn', ht _ $ finset.subset.trans hn $ range_subset.mpr hn'⟩

lemma is_sum_sigma [regular_space α] {γ : β → Type*} {f : (Σ b:β, γ b) → α} {g : β → α} {a : α}
  (hf : ∀b, is_sum (λc, f ⟨b, c⟩) (g b)) (ha : is_sum f a) : is_sum g a :=
assume s' hs',
let
  ⟨s, hs, hss', hsc⟩ := nhds_is_closed hs',
  ⟨u, hu⟩ := mem_at_top_sets.mp $ ha $ hs,
  fsts := u.image sigma.fst,
  snds := λb, u.bind (λp, (if h : p.1 = b then {cast (congr_arg γ h) p.2} else ∅ : finset (γ b)))
in
have u_subset : u ⊆ fsts.sigma snds,
  from subset_iff.mpr $ assume ⟨b, c⟩ hu,
  have hb : b ∈ fsts, from finset.mem_image.mpr ⟨_, hu, rfl⟩,
  have hc : c ∈ snds b, from mem_bind.mpr ⟨_, hu, by simp; refl⟩,
  by simp [mem_sigma, hb, hc] ,
mem_at_top_sets.mpr $ exists.intro fsts $ assume bs (hbs : fsts ⊆ bs),
  have h : ∀cs : Π b ∈ bs, finset (γ b),
      (⋂b (hb : b ∈ bs), (λp:Πb, finset (γ b), p b) ⁻¹' {cs' | cs b hb ⊆ cs' }) ∩
      (λp, bs.sum (λb, (p b).sum (λc, f ⟨b, c⟩))) ⁻¹' s ≠ ∅,
    from assume cs,
    let cs' := λb, (if h : b ∈ bs then cs b h else ∅) ∪ snds b in
    have sum_eq : bs.sum (λb, (cs' b).sum (λc, f ⟨b, c⟩)) = (bs.sigma cs').sum f,
      from sum_sigma.symm,
    have (bs.sigma cs').sum f ∈ s,
      from hu _ $ finset.subset.trans u_subset $ sigma_mono hbs $
        assume b, @finset.subset_union_right (γ b) _ _ _,
    set.ne_empty_iff_exists_mem.mpr $ exists.intro cs' $
    by simp [sum_eq, this]; { intros b hb, simp [cs', hb, finset.subset_union_right] },
  have tendsto (λp:(Πb:β, finset (γ b)), bs.sum (λb, (p b).sum (λc, f ⟨b, c⟩)))
      (⨅b (h : b ∈ bs), at_top.comap (λp, p b)) (nhds (bs.sum g)),
    from tendsto_finset_sum bs $
      assume c hc, tendsto_infi' c $ tendsto_infi' hc $ tendsto_comap.comp (hf c),
  have bs.sum g ∈ s,
    from mem_of_closed_of_tendsto' this hsc $ forall_sets_neq_empty_iff_neq_bot.mp $
      by simp [mem_inf_sets, exists_imp_distrib, and_imp, forall_and_distrib,
               filter.mem_infi_sets_finset, mem_comap_sets, skolem, mem_at_top_sets,
               and_comm];
      from
        assume s₁ s₂ s₃ hs₁ hs₃ p hs₂ p' hp cs hp',
        have (⋂b (h : b ∈ bs), (λp:(Πb, finset (γ b)), p b) ⁻¹' {cs' | cs b h ⊆ cs' }) ≤ (⨅b∈bs, p b),
          from infi_le_infi $ assume b, infi_le_infi $ assume hb,
            le_trans (set.preimage_mono $ hp' b hb) (hp b hb),
        neq_bot_of_le_neq_bot (h _) (le_trans (set.inter_subset_inter (le_trans this hs₂) hs₃) hs₁),
  hss' this

lemma has_sum_sigma [regular_space α] {γ : β → Type*} {f : (Σb:β, γ b) → α}
  (hf : ∀b, has_sum (λc, f ⟨b, c⟩)) (ha : has_sum f) : has_sum (λb, ∑c, f ⟨b, c⟩):=
has_sum_spec $ is_sum_sigma (assume b, is_sum_tsum $ hf b) (is_sum_tsum ha)

end is_sum

section is_sum_iff_is_sum_of_iso_ne_zero
variables [add_comm_monoid α] [topological_space α] [topological_add_monoid α]
variables {f : β → α} {g : γ → α} {a : α}

lemma is_sum_of_is_sum
  (h_eq : ∀u:finset γ, ∃v:finset β, ∀v', v ⊆ v' → ∃u', u ⊆ u' ∧ u'.sum g = v'.sum f)
  (hf : is_sum g a) : is_sum f a :=
suffices at_top.map (λs:finset β, s.sum f) ≤ at_top.map (λs:finset γ, s.sum g),
  from le_trans this hf,
by rw [map_at_top_eq, map_at_top_eq];
from (le_infi $ assume b, let ⟨v, hv⟩ := h_eq b in infi_le_of_le v $
  by simp [set.image_subset_iff]; exact hv)

lemma is_sum_iff_is_sum
  (h₁ : ∀u:finset γ, ∃v:finset β, ∀v', v ⊆ v' → ∃u', u ⊆ u' ∧ u'.sum g = v'.sum f)
  (h₂ : ∀v:finset β, ∃u:finset γ, ∀u', u ⊆ u' → ∃v', v ⊆ v' ∧ v'.sum f = u'.sum g) :
  is_sum f a ↔ is_sum g a :=
⟨is_sum_of_is_sum h₂, is_sum_of_is_sum h₁⟩

variables
  (i : Π⦃c⦄, g c ≠ 0 → β) (hi : ∀⦃c⦄ (h : g c ≠ 0), f (i h) ≠ 0)
  (j : Π⦃b⦄, f b ≠ 0 → γ) (hj : ∀⦃b⦄ (h : f b ≠ 0), g (j h) ≠ 0)
  (hji : ∀⦃c⦄ (h : g c ≠ 0), j (hi h) = c)
  (hij : ∀⦃b⦄ (h : f b ≠ 0), i (hj h) = b)
  (hgj : ∀⦃b⦄ (h : f b ≠ 0), g (j h) = f b)
include hi hj hji hij hgj

lemma is_sum_of_is_sum_ne_zero : is_sum g a → is_sum f a :=
have j_inj : ∀x y (hx : f x ≠ 0) (hy : f y ≠ 0), (j hx = j hy ↔ x = y),
  from assume x y hx hy,
  ⟨assume h,
    have i (hj hx) = i (hj hy), by simp [h],
    by rwa [hij, hij] at this; assumption,
  by simp {contextual := tt}⟩,
let ii : finset γ → finset β := λu, u.bind $ λc, if h : g c = 0 then ∅ else {i h} in
let jj : finset β → finset γ := λv, v.bind $ λb, if h : f b = 0 then ∅ else {j h} in
is_sum_of_is_sum $ assume u, exists.intro (ii u) $
  assume v hv, exists.intro (u ∪ jj v) $ and.intro (subset_union_left _ _) $
  have ∀c:γ, c ∈ u ∪ jj v → c ∉ jj v → g c = 0,
    from assume c hc hnc, classical.by_contradiction $ assume h : g c ≠ 0,
    have c ∈ u,
      from (finset.mem_union.1 hc).resolve_right hnc,
    have i h ∈ v,
      from hv $ by simp [mem_bind]; existsi c; simp [h, this],
    have j (hi h) ∈ jj v,
      by simp [mem_bind]; existsi i h; simp [h, hi, this],
    by rw [hji h] at this; exact hnc this,
  calc (u ∪ jj v).sum g = (jj v).sum g : (sum_subset (subset_union_right _ _) this).symm
    ... = v.sum _ : sum_bind $ by intros x hx y hy hxy; by_cases f x = 0; by_cases f y = 0; simp [*]
    ... = v.sum f : sum_congr rfl $ by intros x hx; by_cases f x = 0; simp [*]

lemma is_sum_iff_is_sum_of_ne_zero : is_sum f a ↔ is_sum g a :=
iff.intro
  (is_sum_of_is_sum_ne_zero j hj i hi hij hji $ assume b hb, by rw [←hgj (hi _), hji])
  (is_sum_of_is_sum_ne_zero i hi j hj hji hij hgj)

lemma has_sum_iff_has_sum_ne_zero : has_sum g ↔ has_sum f :=
exists_congr $
  assume a, is_sum_iff_is_sum_of_ne_zero j hj i hi hij hji $
    assume b hb, by rw [←hgj (hi _), hji]

end is_sum_iff_is_sum_of_iso_ne_zero

section is_sum_iff_is_sum_of_bij_ne_zero
variables [add_comm_monoid α] [topological_space α] [topological_add_monoid α]
variables {f : β → α} {g : γ → α} {a : α}
  (i : Π⦃c⦄, g c ≠ 0 → β)
  (h₁ : ∀⦃c₁ c₂⦄ (h₁ : g c₁ ≠ 0) (h₂ : g c₂ ≠ 0), i h₁ = i h₂ → c₁ = c₂)
  (h₂ : ∀⦃b⦄, f b ≠ 0 → ∃c (h : g c ≠ 0), i h = b)
  (h₃ : ∀⦃c⦄ (h : g c ≠ 0), f (i h) = g c)
include i h₁ h₂ h₃

lemma is_sum_iff_is_sum_of_ne_zero_bij : is_sum f a ↔ is_sum g a :=
have hi : ∀⦃c⦄ (h : g c ≠ 0), f (i h) ≠ 0,
  from assume c h, by simp [h₃, h],
let j : Π⦃b⦄, f b ≠ 0 → γ := λb h, some $ h₂ h in
have hj : ∀⦃b⦄ (h : f b ≠ 0), ∃(h : g (j h) ≠ 0), i h = b,
  from assume b h, some_spec $ h₂ h,
have hj₁ : ∀⦃b⦄ (h : f b ≠ 0), g (j h) ≠ 0,
  from assume b h, let ⟨h₁, _⟩ := hj h in h₁,
have hj₂ : ∀⦃b⦄ (h : f b ≠ 0), i (hj₁ h) = b,
  from assume b h, let ⟨h₁, h₂⟩ := hj h in h₂,
is_sum_iff_is_sum_of_ne_zero i hi j hj₁
  (assume c h, h₁ (hj₁ _) h $ hj₂ _) hj₂ (assume b h, by rw [←h₃ (hj₁ _), hj₂])

lemma has_sum_iff_has_sum_ne_zero_bij : has_sum f ↔ has_sum g :=
exists_congr $
  assume a, is_sum_iff_is_sum_of_ne_zero_bij @i h₁ h₂ h₃

end is_sum_iff_is_sum_of_bij_ne_zero

section tsum
variables [add_comm_monoid α] [topological_space α] [topological_add_monoid α] [t2_space α]
variables {f g : β → α} {a a₁ a₂ : α}

lemma is_sum_unique : is_sum f a₁ → is_sum f a₂ → a₁ = a₂ := tendsto_nhds_unique at_top_ne_bot

lemma tsum_eq_is_sum (ha : is_sum f a) : (∑b, f b) = a := is_sum_unique (is_sum_tsum ⟨a, ha⟩) ha

lemma is_sum_iff_of_has_sum (h : has_sum f) : is_sum f a ↔ (∑b, f b) = a :=
iff.intro tsum_eq_is_sum (assume eq, eq ▸ is_sum_tsum h)

@[simp] lemma tsum_zero : (∑b:β, 0:α) = 0 := tsum_eq_is_sum is_sum_zero

lemma tsum_add (hf : has_sum f) (hg : has_sum g) : (∑b, f b + g b) = (∑b, f b) + (∑b, g b) :=
tsum_eq_is_sum $ is_sum_add (is_sum_tsum hf) (is_sum_tsum hg)

lemma tsum_sum {f : γ → β → α} {s : finset γ} (hf : ∀i∈s, has_sum (f i)) :
  (∑b, s.sum (λi, f i b)) = s.sum (λi, ∑b, f i b) :=
tsum_eq_is_sum $ is_sum_sum $ assume i hi, is_sum_tsum $ hf i hi

lemma tsum_eq_sum {f : β → α} {s : finset β} (hf : ∀b∉s, f b = 0)  :
  (∑b, f b) = s.sum f :=
tsum_eq_is_sum $ is_sum_sum_of_ne_finset_zero hf

lemma tsum_fintype [fintype β] (f : β → α) : (∑b, f b) = finset.univ.sum f :=
tsum_eq_sum $ λ a h, h.elim (mem_univ _)

lemma tsum_eq_single {f : β → α} (b : β) (hf : ∀b' ≠ b, f b' = 0)  :
  (∑b, f b) = f b :=
calc (∑b, f b) = (finset.singleton b).sum f : tsum_eq_sum $ by simp [hf] {contextual := tt}
  ... = f b : by simp

lemma tsum_sigma [regular_space α] {γ : β → Type*} {f : (Σb:β, γ b) → α}
  (h₁ : ∀b, has_sum (λc, f ⟨b, c⟩)) (h₂ : has_sum f) : (∑p, f p) = (∑b c, f ⟨b, c⟩):=
(tsum_eq_is_sum $ is_sum_sigma (assume b, is_sum_tsum $ h₁ b) $ is_sum_tsum h₂).symm

@[simp] lemma tsum_ite_eq (b : β) (a : α) : (∑b', if b' = b then a else 0) = a :=
tsum_eq_is_sum (is_sum_ite_eq b a)

lemma tsum_eq_tsum_of_is_sum_iff_is_sum {f : β → α} {g : γ → α}
  (h : ∀{a}, is_sum f a ↔ is_sum g a) : (∑b, f b) = (∑c, g c) :=
by_cases
  (assume : ∃a, is_sum f a,
    let ⟨a, hfa⟩ := this in
    have hga : is_sum g a, from h.mp hfa,
    by rw [tsum_eq_is_sum hfa, tsum_eq_is_sum hga])
  (assume hf : ¬ has_sum f,
    have hg : ¬ has_sum g, from assume ⟨a, hga⟩, hf ⟨a, h.mpr hga⟩,
    by simp [tsum, hf, hg])

lemma tsum_eq_tsum_of_ne_zero {f : β → α} {g : γ → α}
  (i : Π⦃c⦄, g c ≠ 0 → β) (hi : ∀⦃c⦄ (h : g c ≠ 0), f (i h) ≠ 0)
  (j : Π⦃b⦄, f b ≠ 0 → γ) (hj : ∀⦃b⦄ (h : f b ≠ 0), g (j h) ≠ 0)
  (hji : ∀⦃c⦄ (h : g c ≠ 0), j (hi h) = c)
  (hij : ∀⦃b⦄ (h : f b ≠ 0), i (hj h) = b)
  (hgj : ∀⦃b⦄ (h : f b ≠ 0), g (j h) = f b) :
  (∑i, f i) = (∑j, g j) :=
tsum_eq_tsum_of_is_sum_iff_is_sum $ assume a, is_sum_iff_is_sum_of_ne_zero i hi j hj hji hij hgj

lemma tsum_eq_tsum_of_ne_zero_bij {f : β → α} {g : γ → α}
  (i : Π⦃c⦄, g c ≠ 0 → β)
  (h₁ : ∀⦃c₁ c₂⦄ (h₁ : g c₁ ≠ 0) (h₂ : g c₂ ≠ 0), i h₁ = i h₂ → c₁ = c₂)
  (h₂ : ∀⦃b⦄, f b ≠ 0 → ∃c (h : g c ≠ 0), i h = b)
  (h₃ : ∀⦃c⦄ (h : g c ≠ 0), f (i h) = g c) :
  (∑i, f i) = (∑j, g j) :=
tsum_eq_tsum_of_is_sum_iff_is_sum $ assume a, is_sum_iff_is_sum_of_ne_zero_bij i h₁ h₂ h₃

lemma tsum_eq_tsum_of_iso (j : γ → β) (i : β → γ)
  (h₁ : ∀x, i (j x) = x) (h₂ : ∀x, j (i x) = x) :
  (∑c, f (j c)) = (∑b, f b) :=
tsum_eq_tsum_of_is_sum_iff_is_sum $ assume a, is_sum_iff_is_sum_of_iso i h₁ h₂

lemma tsum_equiv (j : γ ≃ β) : (∑c, f (j c)) = (∑b, f b) :=
tsum_eq_tsum_of_iso j j.symm (by simp) (by simp)

end tsum

section topological_group
variables [add_comm_group α] [topological_space α] [topological_add_group α]
variables {f g : β → α} {a a₁ a₂ : α}

lemma is_sum_neg : is_sum f a → is_sum (λb, - f b) (- a) :=
is_sum_hom has_neg.neg continuous_neg'

lemma has_sum_neg (hf : has_sum f) : has_sum (λb, - f b) :=
has_sum_spec $ is_sum_neg $ is_sum_tsum $ hf

lemma is_sum_sub (hf : is_sum f a₁) (hg : is_sum g a₂) : is_sum (λb, f b - g b) (a₁ - a₂) :=
by simp; exact is_sum_add hf (is_sum_neg hg)

lemma has_sum_sub (hf : has_sum f) (hg : has_sum g) : has_sum (λb, f b - g b) :=
has_sum_spec $ is_sum_sub (is_sum_tsum hf) (is_sum_tsum hg)

section tsum
variables [t2_space α]

lemma tsum_neg (hf : has_sum f) : (∑b, - f b) = - (∑b, f b) :=
tsum_eq_is_sum $ is_sum_neg $ is_sum_tsum $ hf

lemma tsum_sub (hf : has_sum f) (hg : has_sum g) : (∑b, f b - g b) = (∑b, f b) - (∑b, g b) :=
tsum_eq_is_sum $ is_sum_sub (is_sum_tsum hf) (is_sum_tsum hg)

end tsum

end topological_group

section topological_semiring
variables [semiring α] [topological_space α] [topological_semiring α]
variables {f g : β → α} {a a₁ a₂ : α}

lemma is_sum_mul_left (a₂) : is_sum f a₁ → is_sum (λb, a₂ * f b) (a₂ * a₁) :=
is_sum_hom _ (continuous_mul continuous_const continuous_id)

lemma is_sum_mul_right (a₂) (hf : is_sum f a₁) : is_sum (λb, f b * a₂) (a₁ * a₂) :=
@is_sum_hom _ _ _ _ _ _ f a₁ (λa, a * a₂) _ _ _ _
  (continuous_mul continuous_id continuous_const) hf

lemma has_sum_mul_left (a) (hf : has_sum f) : has_sum (λb, a * f b) :=
has_sum_spec $ is_sum_mul_left _ $ is_sum_tsum hf

lemma has_sum_mul_right (a) (hf : has_sum f) : has_sum (λb, f b * a) :=
has_sum_spec $ is_sum_mul_right _ $ is_sum_tsum hf

section tsum
variables [t2_space α]

lemma tsum_mul_left (a) (hf : has_sum f) : (∑b, a * f b) = a * (∑b, f b) :=
tsum_eq_is_sum $ is_sum_mul_left _ $ is_sum_tsum hf

lemma tsum_mul_right (a) (hf : has_sum f) : (∑b, f b * a) = (∑b, f b) * a :=
tsum_eq_is_sum $ is_sum_mul_right _ $ is_sum_tsum hf

end tsum

end topological_semiring

section order_topology
variables [ordered_comm_monoid α] [topological_space α] [ordered_topology α]
  [topological_add_monoid α]
variables {f g : β → α} {a a₁ a₂ : α}

lemma is_sum_le (h : ∀b, f b ≤ g b) (hf : is_sum f a₁) (hg : is_sum g a₂) : a₁ ≤ a₂ :=
le_of_tendsto_of_tendsto at_top_ne_bot hf hg $ univ_mem_sets' $
  assume s, sum_le_sum' $ assume b _, h b

lemma is_sum_le_inj {g : γ → α} (i : β → γ) (hi : injective i) (hs : ∀c∉set.range i, 0 ≤ g c)
  (h : ∀b, f b ≤ g (i b)) (hf : is_sum f a₁) (hg : is_sum g a₂) : a₁ ≤ a₂ :=
have is_sum (λc, (partial_inv i c).cases_on' 0 f) a₁,
begin
  refine (is_sum_iff_is_sum_of_ne_zero_bij (λb _, i b) _ _ _).2 hf,
  { assume c₁ c₂ h₁ h₂ eq, exact hi eq },
  { assume c hc,
    cases eq : partial_inv i c with b; rw eq at hc,
    { contradiction },
    { rw [partial_inv_of_injective hi] at eq,
      exact ⟨b, hc, eq⟩ } },
  { assume c hc, rw [partial_inv_left hi, option.cases_on'] }
end,
begin
  refine is_sum_le (assume c, _) this hg,
  by_cases c ∈ set.range i,
  { rcases h with ⟨b, rfl⟩,
    rw [partial_inv_left hi, option.cases_on'],
    exact h _ },
  { have : partial_inv i c = none := dif_neg h,
    rw [this, option.cases_on'],
    exact hs _ h }
end

lemma tsum_le_tsum (h : ∀b, f b ≤ g b) (hf : has_sum f) (hg : has_sum g) : (∑b, f b) ≤ (∑b, g b) :=
is_sum_le h (is_sum_tsum hf) (is_sum_tsum hg)

end order_topology

section uniform_group

variables [add_comm_group α] [uniform_space α] [complete_space α] [uniform_add_group α]
variables (f g : β → α) {a a₁ a₂ : α}

lemma has_sum_iff_cauchy : has_sum f ↔ cauchy (map (λ (s : finset β), sum s f) at_top) :=
(cauchy_map_iff_exists_tendsto at_top_ne_bot).symm

lemma has_sum_iff_vanishing :
  has_sum f ↔ ∀ e ∈ nhds (0:α), (∃s:finset β, ∀t, disjoint t s → t.sum f ∈ e) :=
begin
  simp only [has_sum_iff_cauchy, cauchy_map_iff, and_iff_right at_top_ne_bot,
    prod_at_top_at_top_eq, uniformity_eq_comap_nhds_zero α, tendsto_comap_iff, (∘)],
  rw [tendsto_at_top' (_ : finset β × finset β → α)],
  split,
  { assume h e he,
    rcases h e he with ⟨⟨s₁, s₂⟩, h⟩,
    use [s₁ ∪ s₂],
    assume t ht,
    have : (s₁ ∪ s₂) ∩ t = ∅ := finset.disjoint_iff_inter_eq_empty.1 ht.symm,
    specialize h (s₁ ∪ s₂, (s₁ ∪ s₂) ∪ t) ⟨le_sup_left, le_sup_left_of_le le_sup_right⟩,
    simpa only [finset.sum_union this, add_sub_cancel'] using h },
  { assume h e he,
    rcases exists_nhds_half_neg he with ⟨d, hd, hde⟩,
    rcases h d hd with ⟨s, h⟩,
    use [(s, s)],
    rintros ⟨t₁, t₂⟩ ⟨ht₁, ht₂⟩,
    have : t₂.sum f - t₁.sum f = (t₂ \ s).sum f - (t₁ \ s).sum f,
    { simp only [(finset.sum_sdiff ht₁).symm, (finset.sum_sdiff ht₂).symm,
        add_sub_add_right_eq_sub] },
    simp only [this],
    exact hde _ _ (h _ finset.sdiff_disjoint) (h _ finset.sdiff_disjoint) }
end

/- TODO: generalize to monoid with a uniform continuous subtraction operator: `(a + b) - b = a` -/
lemma has_sum_of_has_sum_of_sub (hf : has_sum f) (h : ∀b, g b = 0 ∨ g b = f b) : has_sum g :=
(has_sum_iff_vanishing g).2 $
  assume e he,
  let ⟨s, hs⟩ := (has_sum_iff_vanishing f).1 hf e he in
  ⟨s, assume t ht,
    have eq : (t.filter (λb, g b = f b)).sum f = t.sum g :=
      calc (t.filter (λb, g b = f b)).sum f = (t.filter (λb, g b = f b)).sum g :
          finset.sum_congr rfl (assume b hb, (finset.mem_filter.1 hb).2.symm)
        ... = t.sum g :
        begin
          refine finset.sum_subset (finset.filter_subset _) _,
          assume b hbt hb,
          simp only [(∉), finset.mem_filter, and_iff_right hbt] at hb,
          exact (h b).resolve_right hb
        end,
    eq ▸ hs _ $ finset.disjoint_of_subset_left (finset.filter_subset _) ht⟩

lemma has_sum_comp_of_has_sum_of_injective {i : γ → β} (hf : has_sum f) (hi : injective i) :
  has_sum (f ∘ i) :=
suffices has_sum (λb, if b ∈ set.range i then f b else 0),
begin
  refine (has_sum_iff_has_sum_ne_zero_bij (λc _, i c) _ _ _).1 this,
  { assume c₁ c₂ hc₁ hc₂ eq, exact hi eq },
  { assume b hb,
    split_ifs at hb,
    { rcases h with ⟨c, rfl⟩,
      exact ⟨c, hb, rfl⟩ },
    { contradiction } },
  { assume c hc, exact if_pos (set.mem_range_self _) }
end,
has_sum_of_has_sum_of_sub _ _ hf $ assume b, by by_cases b ∈ set.range i; simp [h]

end uniform_group

section cauchy_seq
open finset.Ico filter

lemma cauchy_seq_of_has_sum_dist [metric_space α] {f : ℕ → α}
  (h : has_sum (λn, dist (f n) (f n.succ))) : cauchy_seq f :=
begin
  let d := λn, dist (f n) (f (n+1)),
  refine metric.cauchy_seq_iff'.2 (λε εpos, _),
  rcases (has_sum_iff_vanishing _).1 h {x : ℝ | x < ε} (gt_mem_nhds εpos) with ⟨s, hs⟩,
  have : ∃N:ℕ, ∀x ∈ s, x < N,
  { by_cases h : s = ∅,
    { use 0, simp [h]},
    { use s.max' h + 1,
      exact λx hx, lt_of_le_of_lt (s.le_max' h x hx) (nat.lt_succ_self _) }},
  rcases this with ⟨N, hN⟩,
  refine ⟨N, λn hn, _⟩,
  have : ∀n, n ≥ N → dist (f N) (f n) ≤ (Ico N n).sum d,
  { apply nat.le_induction,
    { simp },
    { assume n hn hrec,
      calc dist (f N) (f (n+1)) ≤ dist (f N) (f n) + d n : dist_triangle _ _ _
        ... ≤ (Ico N n).sum d + d n : add_le_add hrec (le_refl _)
        ... = (Ico N (n+1)).sum d : by rw [succ_top hn, sum_insert, add_comm]; simp }},
  calc dist (f n) (f N) ≤ (Ico N n).sum d : by rw dist_comm; apply this n hn
    ... < ε : hs _ (finset.disjoint_iff_ne.2
                     (λa ha b hb, ne_of_gt (lt_of_lt_of_le (hN _ hb) (mem.1 ha).1)))
end

end cauchy_seq


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.nat.basic
import Mathlib.PostPort

namespace Mathlib

/-!
# Partial predecessor and partial subtraction on the natural numbers

The usual definition of natural number subtraction (`nat.sub`) returns 0 as a "garbage value" for
`a - b` when `a < b`. Similarly, `nat.pred 0` is defined to be `0`. The functions in this file
wrap the result in an `option` type instead:

## Main definitions

- `nat.ppred`: a partial predecessor operation
- `nat.psub`: a partial subtraction operation

-/

namespace nat

/-- Partial predecessor operation. Returns `ppred n = some m`
  if `n = m + 1`, otherwise `none`. -/
@[simp] def ppred : ℕ → Option ℕ :=
  sorry

/-- Partial subtraction operation. Returns `psub m n = some k`
  if `m = n + k`, otherwise `none`. -/
@[simp] def psub (m : ℕ) : ℕ → Option ℕ :=
  sorry

theorem pred_eq_ppred (n : ℕ) : Nat.pred n = option.get_or_else (ppred n) 0 :=
  nat.cases_on n (Eq.refl (Nat.pred 0)) fun (n : ℕ) => Eq.refl (Nat.pred (Nat.succ n))

theorem sub_eq_psub (m : ℕ) (n : ℕ) : m - n = option.get_or_else (psub m n) 0 := sorry

@[simp] theorem ppred_eq_some {m : ℕ} {n : ℕ} : ppred n = some m ↔ Nat.succ m = n := sorry

@[simp] theorem ppred_eq_none {n : ℕ} : ppred n = none ↔ n = 0 := sorry

theorem psub_eq_some {m : ℕ} {n : ℕ} {k : ℕ} : psub m n = some k ↔ k + n = m := sorry

theorem psub_eq_none {m : ℕ} {n : ℕ} : psub m n = none ↔ m < n := sorry

theorem ppred_eq_pred {n : ℕ} (h : 0 < n) : ppred n = some (Nat.pred n) :=
  iff.mpr ppred_eq_some (succ_pred_eq_of_pos h)

theorem psub_eq_sub {m : ℕ} {n : ℕ} (h : n ≤ m) : psub m n = some (m - n) :=
  iff.mpr psub_eq_some (nat.sub_add_cancel h)

theorem psub_add (m : ℕ) (n : ℕ) (k : ℕ) : psub m (n + k) =
  do
    let x ← psub m n
    psub x k := sorry

/-- Same as `psub`, but with a more efficient implementation. -/
def psub' (m : ℕ) (n : ℕ) : Option ℕ :=
  ite (n ≤ m) (some (m - n)) none

theorem psub'_eq_psub (m : ℕ) (n : ℕ) : psub' m n = psub m n := sorry


/-
Copyright (c) 2018 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl
-/
import data.set.finite group_theory.coset data.nat.totient
open function

variables {α : Type*} {s : set α} {a a₁ a₂ b c: α}

-- TODO this lemma isn't used anywhere in this file, and should be moved elsewhere.
namespace finset
open finset

lemma mem_range_iff_mem_finset_range_of_mod_eq [decidable_eq α] {f : ℤ → α} {a : α} {n : ℕ}
  (hn : 0 < n) (h : ∀i, f (i % n) = f i) :
  a ∈ set.range f ↔ a ∈ (finset.range n).image (λi, f i) :=
suffices (∃i, f (i % n) = a) ↔ ∃i, i < n ∧ f ↑i = a, by simpa [h],
have hn' : 0 < (n : ℤ), from int.coe_nat_lt.mpr hn,
iff.intro
  (assume ⟨i, hi⟩,
    have 0 ≤ i % ↑n, from int.mod_nonneg _ (ne_of_gt hn'),
    ⟨int.to_nat (i % n),
      by rw [←int.coe_nat_lt, int.to_nat_of_nonneg this]; exact ⟨int.mod_lt_of_pos i hn', hi⟩⟩)
  (assume ⟨i, hi, ha⟩,
    ⟨i, by rw [int.mod_eq_of_lt (int.coe_zero_le _) (int.coe_nat_lt_coe_nat_of_lt hi), ha]⟩)

end finset

lemma conj_inj [group α] {x : α} : function.injective (λ (g : α), x * g * x⁻¹) :=
λ a b h, by simpa [mul_left_inj, mul_right_inj] using h

lemma mem_normalizer_fintype [group α] {s : set α} [fintype s] {x : α}
  (h : ∀ n, n ∈ s → x * n * x⁻¹ ∈ s) : x ∈ is_subgroup.normalizer s :=
by haveI := classical.prop_decidable;
haveI := set.fintype_image s (λ n, x * n * x⁻¹); exact
λ n, ⟨h n, λ h₁,
have heq : (λ n, x * n * x⁻¹) '' s = s := set.eq_of_subset_of_card_le
  (λ n ⟨y, hy⟩, hy.2 ▸ h y hy.1) (by rw set.card_image_of_injective s conj_inj),
have x * n * x⁻¹ ∈ (λ n, x * n * x⁻¹) '' s := heq.symm ▸ h₁,
let ⟨y, hy⟩ := this in conj_inj hy.2 ▸ hy.1⟩

section order_of
variables [group α] [fintype α] [decidable_eq α]
open quotient_group set

instance quotient_group.fintype (s : set α) [is_subgroup s] [d : decidable_pred s] :
  fintype (quotient s) :=
@quotient.fintype _ _ (left_rel s) (λ _ _, d _)

lemma card_eq_card_quotient_mul_card_subgroup (s : set α) [hs : is_subgroup s] [fintype s]
  [decidable_pred s] : fintype.card α = fintype.card (quotient s) * fintype.card s :=
by rw ← fintype.card_prod;
  exact fintype.card_congr (is_subgroup.group_equiv_quotient_times_subgroup hs)

lemma card_subgroup_dvd_card (s : set α) [is_subgroup s] [fintype s] :
  fintype.card s ∣ fintype.card α :=
by haveI := classical.prop_decidable; simp [card_eq_card_quotient_mul_card_subgroup s]

lemma card_quotient_dvd_card (s : set α) [is_subgroup s] [decidable_pred s] [fintype s] :
  fintype.card (quotient s) ∣ fintype.card α :=
by simp [card_eq_card_quotient_mul_card_subgroup s]

@[simp] lemma card_trivial [fintype (is_subgroup.trivial α)] :
  fintype.card (is_subgroup.trivial α) = 1 :=
fintype.card_eq_one_iff.2
  ⟨⟨(1 : α), by simp⟩, λ ⟨y, hy⟩, subtype.eq $ is_subgroup.mem_trivial.1 hy⟩

lemma exists_gpow_eq_one (a : α) : ∃i≠0, a ^ (i:ℤ) = 1 :=
have ¬ injective (λi, a ^ i),
  from not_injective_int_fintype,
let ⟨i, j, a_eq, ne⟩ := show ∃(i j : ℤ), a ^ i = a ^ j ∧ i ≠ j,
  by rw [injective] at this; simpa [classical.not_forall] in
have a ^ (i - j) = 1,
  by simp [gpow_add, gpow_neg, a_eq],
⟨i - j, sub_ne_zero.mpr ne, this⟩

lemma exists_pow_eq_one (a : α) : ∃i > 0, a ^ i = 1 :=
let ⟨i, hi, eq⟩ := exists_gpow_eq_one a in
begin
  cases i,
  { exact ⟨i, nat.pos_of_ne_zero (by simp [int.of_nat_eq_coe, *] at *), eq⟩ },
  { exact ⟨i + 1, dec_trivial, inv_eq_one.1 eq⟩ }
end

/-- `order_of a` is the order of the element `a`, i.e. the `n ≥ 1`, s.t. `a ^ n = 1` -/
def order_of (a : α) : ℕ := nat.find (exists_pow_eq_one a)

lemma pow_order_of_eq_one (a : α) : a ^ order_of a = 1 :=
let ⟨h₁, h₂⟩ := nat.find_spec (exists_pow_eq_one a) in h₂

lemma order_of_pos (a : α) : order_of a > 0 :=
let ⟨h₁, h₂⟩ := nat.find_spec (exists_pow_eq_one a) in h₁

private lemma pow_injective_aux {n m : ℕ} (a : α) (h : n ≤ m)
  (hn : n < order_of a) (hm : m < order_of a) (eq : a ^ n = a ^ m) : n = m :=
decidable.by_contradiction $ assume ne : n ≠ m,
  have h₁ : m - n > 0, from nat.pos_of_ne_zero (by simp [nat.sub_eq_iff_eq_add h, ne.symm]),
  have h₂ : a ^ (m - n) = 1, by simp [pow_sub _ h, eq],
  have le : order_of a ≤ m - n, from nat.find_min' (exists_pow_eq_one a) ⟨h₁, h₂⟩,
  have lt : m - n < order_of a,
    from (nat.sub_lt_left_iff_lt_add h).mpr $ nat.lt_add_left _ _ _ hm,
  lt_irrefl _ (lt_of_le_of_lt le lt)

lemma pow_injective_of_lt_order_of {n m : ℕ} (a : α)
  (hn : n < order_of a) (hm : m < order_of a) (eq : a ^ n = a ^ m) : n = m :=
(le_total n m).elim
  (assume h, pow_injective_aux a h hn hm eq)
  (assume h, (pow_injective_aux a h hm hn eq.symm).symm)

lemma order_of_le_card_univ : order_of a ≤ fintype.card α :=
finset.card_le_of_inj_on ((^) a)
  (assume n _, fintype.complete _)
  (assume i j, pow_injective_of_lt_order_of a)

lemma pow_eq_mod_order_of {n : ℕ} : a ^ n = a ^ (n % order_of a) :=
calc a ^ n = a ^ (n % order_of a + order_of a * (n / order_of a)) :
    by rw [nat.mod_add_div]
  ... = a ^ (n % order_of a) :
    by simp [pow_add, pow_mul, pow_order_of_eq_one]

lemma gpow_eq_mod_order_of {i : ℤ} : a ^ i = a ^ (i % order_of a) :=
calc a ^ i = a ^ (i % order_of a + order_of a * (i / order_of a)) :
    by rw [int.mod_add_div]
  ... = a ^ (i % order_of a) :
    by simp [gpow_add, gpow_mul, pow_order_of_eq_one]

lemma mem_gpowers_iff_mem_range_order_of {a a' : α} :
  a' ∈ gpowers a ↔ a' ∈ (finset.range (order_of a)).image ((^) a : ℕ → α) :=
finset.mem_range_iff_mem_finset_range_of_mod_eq
  (order_of_pos a)
  (assume i, gpow_eq_mod_order_of.symm)

instance decidable_gpowers : decidable_pred (gpowers a) :=
assume a', decidable_of_iff'
  (a' ∈ (finset.range (order_of a)).image ((^) a))
  mem_gpowers_iff_mem_range_order_of

lemma order_of_dvd_of_pow_eq_one {n : ℕ} (h : a ^ n = 1) : order_of a ∣ n :=
by_contradiction
  (λ h₁, nat.find_min _ (show n % order_of a < order_of a,
    from nat.mod_lt _ (order_of_pos _))
      ⟨nat.pos_of_ne_zero (mt nat.dvd_of_mod_eq_zero h₁), by rwa ← pow_eq_mod_order_of⟩)

lemma order_of_le_of_pow_eq_one {n : ℕ} (hn : 0 < n) (h : a ^ n = 1) : order_of a ≤ n :=
nat.find_min' (exists_pow_eq_one a) ⟨hn, h⟩

lemma sum_card_order_of_eq_card_pow_eq_one {n : ℕ} (hn : 0 < n) :
  ((finset.range n.succ).filter (∣ n)).sum (λ m, (finset.univ.filter (λ a : α, order_of a = m)).card)
  = (finset.univ.filter (λ a : α, a ^ n = 1)).card :=
calc ((finset.range n.succ).filter (∣ n)).sum (λ m, (finset.univ.filter (λ a : α, order_of a = m)).card)
    = _ : (finset.card_bind (by simp [finset.ext]; cc)).symm
... = _ : congr_arg finset.card (finset.ext.2 (begin
  assume a,
  suffices : order_of a ≤ n ∧ order_of a ∣ n ↔ a ^ n = 1,
  { simpa [nat.lt_succ_iff], },
  exact ⟨λ h, let ⟨m, hm⟩ := h.2 in by rw [hm, pow_mul, pow_order_of_eq_one, _root_.one_pow],
    λ h, ⟨order_of_le_of_pow_eq_one hn h, order_of_dvd_of_pow_eq_one h⟩⟩
end))

section
local attribute [instance] set_fintype

lemma order_eq_card_gpowers : order_of a = fintype.card (gpowers a) :=
begin
  refine (finset.card_eq_of_bijective _ _ _ _).symm,
  { exact λn hn, ⟨gpow a n, ⟨n, rfl⟩⟩ },
  { exact assume ⟨_, i, rfl⟩ _,
    have pos: (0:int) < order_of a,
      from int.coe_nat_lt.mpr $ order_of_pos a,
    have 0 ≤ i % (order_of a),
      from int.mod_nonneg _ $ ne_of_gt pos,
    ⟨int.to_nat (i % order_of a),
      by rw [← int.coe_nat_lt, int.to_nat_of_nonneg this];
        exact ⟨int.mod_lt_of_pos _ pos, subtype.eq gpow_eq_mod_order_of.symm⟩⟩ },
  { intros, exact finset.mem_univ _ },
  { exact assume i j hi hj eq, pow_injective_of_lt_order_of a hi hj $ by simpa using eq }
end

@[simp] lemma order_of_one : order_of (1 : α) = 1 :=
by rw [order_eq_card_gpowers, fintype.card_eq_one_iff];
  exact ⟨⟨1, 0, rfl⟩, λ ⟨a, i, ha⟩, by simp [ha.symm]⟩

@[simp] lemma order_of_eq_one_iff : order_of a = 1 ↔ a = 1 :=
⟨λ h, by conv { to_lhs, rw [← pow_one a, ← h, pow_order_of_eq_one] }, λ h, by simp [h]⟩

section classical
local attribute [instance] classical.prop_decidable
open quotient_group

/- TODO: use cardinal theory, introduce `card : set α → ℕ`, or setup decidability for cosets -/
lemma order_of_dvd_card_univ : order_of a ∣ fintype.card α :=
have ft_prod : fintype (quotient (gpowers a) × (gpowers a)),
  from fintype.of_equiv α (gpowers.is_subgroup a).group_equiv_quotient_times_subgroup,
have ft_s : fintype (gpowers a),
  from @fintype.fintype_prod_right _ _ _ ft_prod _,
have ft_cosets : fintype (quotient (gpowers a)),
  from @fintype.fintype_prod_left _ _ _ ft_prod ⟨⟨1, is_submonoid.one_mem (gpowers a)⟩⟩,
have ft : fintype (quotient (gpowers a) × (gpowers a)),
  from @prod.fintype _ _ ft_cosets ft_s,
have eq₁ : fintype.card α = @fintype.card _ ft_cosets * @fintype.card _ ft_s,
  from calc fintype.card α = @fintype.card _ ft_prod :
      @fintype.card_congr _ _ _ ft_prod (gpowers.is_subgroup a).group_equiv_quotient_times_subgroup
    ... = @fintype.card _ (@prod.fintype _ _ ft_cosets ft_s) :
      congr_arg (@fintype.card _) $ subsingleton.elim _ _
    ... = @fintype.card _ ft_cosets * @fintype.card _ ft_s :
      @fintype.card_prod _ _ ft_cosets ft_s,
have eq₂ : order_of a = @fintype.card _ ft_s,
  from calc order_of a = _ : order_eq_card_gpowers
    ... = _ : congr_arg (@fintype.card _) $ subsingleton.elim _ _,
dvd.intro (@fintype.card (quotient (gpowers a)) ft_cosets) $
  by rw [eq₁, eq₂, mul_comm]

end classical

@[simp] lemma pow_card_eq_one (a : α) : a ^ fintype.card α = 1 :=
let ⟨m, hm⟩ := @order_of_dvd_card_univ _ a _ _ _ in
by simp [hm, pow_mul, pow_order_of_eq_one]

lemma powers_eq_gpowers (a : α) : powers a = gpowers a :=
set.ext (λ x, ⟨λ ⟨n, hn⟩, ⟨n, by simp * at *⟩,
  λ ⟨i, hi⟩, ⟨(i % order_of a).nat_abs,
    by rwa [← gpow_coe_nat, int.nat_abs_of_nonneg (int.mod_nonneg _
      (int.coe_nat_ne_zero_iff_pos.2 (order_of_pos _))), ← gpow_eq_mod_order_of]⟩⟩)

open nat

lemma order_of_pow (a : α) (n : ℕ) : order_of (a ^ n) = order_of a / gcd (order_of a) n :=
dvd_antisymm
  (order_of_dvd_of_pow_eq_one
    (by rw [← pow_mul, ← nat.mul_div_assoc _ (gcd_dvd_left _ _), mul_comm,
      nat.mul_div_assoc _ (gcd_dvd_right _ _), pow_mul, pow_order_of_eq_one, _root_.one_pow]))
  (have gcd_pos : 0 < gcd (order_of a) n, from gcd_pos_of_pos_left n (order_of_pos a),
    have hdvd : order_of a ∣ n * order_of (a ^ n),
      from order_of_dvd_of_pow_eq_one (by rw [pow_mul, pow_order_of_eq_one]),
    coprime.dvd_of_dvd_mul_right (coprime_div_gcd_div_gcd gcd_pos)
      (dvd_of_mul_dvd_mul_right gcd_pos
        (by rwa [nat.div_mul_cancel (gcd_dvd_left _ _), mul_assoc,
            nat.div_mul_cancel (gcd_dvd_right _ _), mul_comm])))

lemma pow_gcd_card_eq_one_iff {n : ℕ} {a : α} :
  a ^ n = 1 ↔ a ^ (gcd n (fintype.card α)) = 1 :=
⟨λ h, have hn : order_of a ∣ n, from dvd_of_mod_eq_zero $
      by_contradiction (λ ha, by rw pow_eq_mod_order_of at h;
        exact (not_le_of_gt (nat.mod_lt n (order_of_pos a)))
          (order_of_le_of_pow_eq_one (nat.pos_of_ne_zero ha) h)),
    let ⟨m, hm⟩ := dvd_gcd hn order_of_dvd_card_univ in
    by rw [hm, pow_mul, pow_order_of_eq_one, _root_.one_pow],
  λ h, let ⟨m, hm⟩ := gcd_dvd_left n (fintype.card α) in
    by rw [hm, pow_mul, h, _root_.one_pow]⟩

end

end order_of

section cyclic

local attribute [instance] set_fintype

class is_cyclic (α : Type*) [group α] : Prop :=
(exists_generator : ∃ g : α, ∀ x, x ∈ gpowers g)

def is_cyclic.comm_group [hg : group α] [is_cyclic α] : comm_group α :=
{ mul_comm := λ x y, show x * y = y * x,
    from let ⟨g, hg⟩ := is_cyclic.exists_generator α in
    let ⟨n, hn⟩ := hg x in let ⟨m, hm⟩ := hg y in
    hm ▸ hn ▸ gpow_mul_comm _ _ _,
  ..hg }

lemma is_cyclic_of_order_of_eq_card [group α] [fintype α] [decidable_eq α]
  (x : α) (hx : order_of x = fintype.card α) : is_cyclic α :=
⟨⟨x, set.eq_univ_iff_forall.1 $ set.eq_of_subset_of_card_le
  (set.subset_univ _)
  (by rw [fintype.card_congr (equiv.set.univ α), ← hx, order_eq_card_gpowers])⟩⟩

lemma order_of_eq_card_of_forall_mem_gpowers [group α] [fintype α] [decidable_eq α]
  {g : α} (hx : ∀ x, x ∈ gpowers g) : order_of g = fintype.card α :=
by rw [← fintype.card_congr (equiv.set.univ α), order_eq_card_gpowers];
  simp [hx]; congr

instance [group α] : is_cyclic (is_subgroup.trivial α) :=
⟨⟨(1 : is_subgroup.trivial α), λ x, ⟨0, subtype.eq $ eq.symm (is_subgroup.mem_trivial.1 x.2)⟩⟩⟩

instance is_subgroup.is_cyclic [group α] [is_cyclic α] (H : set α) [is_subgroup H] : is_cyclic H :=
by haveI := classical.prop_decidable; exact
let ⟨g, hg⟩ := is_cyclic.exists_generator α in
if hx : ∃ (x : α), x ∈ H ∧ x ≠ (1 : α) then
  let ⟨x, hx₁, hx₂⟩ := hx in
  let ⟨k, hk⟩ := hg x in
  have hex : ∃ n : ℕ, 0 < n ∧ g ^ n ∈ H,
    from ⟨k.nat_abs, nat.pos_of_ne_zero
      (λ h, hx₂ $ by rw [← hk, int.eq_zero_of_nat_abs_eq_zero h, gpow_zero]),
        match k, hk with
        | (k : ℕ), hk := by rw [int.nat_abs_of_nat, ← gpow_coe_nat, hk]; exact hx₁
        | -[1+ k], hk := by rw [int.nat_abs_of_neg_succ_of_nat,
          ← is_subgroup.inv_mem_iff H]; simp * at *
        end⟩,
  ⟨⟨⟨g ^ nat.find hex, (nat.find_spec hex).2⟩,
    λ ⟨x, hx⟩, let ⟨k, hk⟩ := hg x in
      have hk₁ : g ^ ((nat.find hex : ℤ) * (k / nat.find hex)) ∈ gpowers (g ^ nat.find hex),
        from ⟨k / nat.find hex, eq.symm $ gpow_mul _ _ _⟩,
      have hk₂ : g ^ ((nat.find hex : ℤ) * (k / nat.find hex)) ∈ H,
        by rw gpow_mul; exact is_subgroup.gpow_mem (nat.find_spec hex).2,
      have hk₃ : g ^ (k % nat.find hex) ∈ H,
        from (is_subgroup.mul_mem_cancel_left H hk₂).1 $
          by rw [← gpow_add, int.mod_add_div, hk]; exact hx,
      have hk₄ : k % nat.find hex = (k % nat.find hex).nat_abs,
        by rw int.nat_abs_of_nonneg (int.mod_nonneg _
          (int.coe_nat_ne_zero_iff_pos.2 (nat.find_spec hex).1)),
      have hk₅ : g ^ (k % nat.find hex ).nat_abs ∈ H,
        by rwa [← gpow_coe_nat, ← hk₄],
      have hk₆ : (k % (nat.find hex : ℤ)).nat_abs = 0,
        from by_contradiction (λ h,
          nat.find_min hex (int.coe_nat_lt.1 $ by rw [← hk₄];
            exact int.mod_lt_of_pos _ (int.coe_nat_pos.2 (nat.find_spec hex).1))
          ⟨nat.pos_of_ne_zero h, hk₅⟩),
      ⟨k / (nat.find hex : ℤ), subtype.coe_ext.2 begin
        suffices : g ^ ((nat.find hex : ℤ) * (k / nat.find hex)) = x,
        { simpa [gpow_mul] },
        rw [int.mul_div_cancel' (int.dvd_of_mod_eq_zero (int.eq_zero_of_nat_abs_eq_zero hk₆)), hk]
      end⟩⟩⟩
else
  have H = is_subgroup.trivial α,
    from set.ext $ λ x, ⟨λ h, by simp at *; tauto,
      λ h, by rw [is_subgroup.mem_trivial.1 h]; exact is_submonoid.one_mem _⟩,
  by clear _let_match; subst this; apply_instance

open finset nat

lemma is_cyclic.card_pow_eq_one_le [group α] [fintype α] [decidable_eq α] [is_cyclic α] {n : ℕ}
  (hn0 : 0 < n) : (univ.filter (λ a : α, a ^ n = 1)).card ≤ n :=
let ⟨g, hg⟩ := is_cyclic.exists_generator α in
calc (univ.filter (λ a : α, a ^ n = 1)).card ≤ (gpowers (g ^ (fintype.card α / (gcd n (fintype.card α))))).to_finset.card :
  card_le_of_subset (λ x hx, let ⟨m, hm⟩ := show x ∈ powers g, from (powers_eq_gpowers g).symm ▸ hg x in
    set.mem_to_finset.2 ⟨(m / (fintype.card α / (gcd n (fintype.card α))) : ℕ),
      have hgmn : g ^ (m * gcd n (fintype.card α)) = 1,
        by rw [pow_mul, hm, ← pow_gcd_card_eq_one_iff]; exact (mem_filter.1 hx).2,
      begin
        rw [gpow_coe_nat, ← pow_mul, nat.mul_div_cancel_left', hm],
        refine dvd_of_mul_dvd_mul_right (gcd_pos_of_pos_left (fintype.card α) hn0) _,
        conv {to_lhs, rw [nat.div_mul_cancel (gcd_dvd_right _ _), ← order_of_eq_card_of_forall_mem_gpowers hg]},
        exact order_of_dvd_of_pow_eq_one hgmn
      end⟩)
... ≤ n :
  let ⟨m, hm⟩ := gcd_dvd_right n (fintype.card α) in
  have hm0 : 0 < m, from nat.pos_of_ne_zero
    (λ hm0, (by rw [hm0, mul_zero, fintype.card_eq_zero_iff] at hm; exact hm 1)),
  begin
    rw [← set.card_fintype_of_finset' _ (λ _, set.mem_to_finset), ← order_eq_card_gpowers,
      order_of_pow, order_of_eq_card_of_forall_mem_gpowers hg],
    rw [hm] {occs := occurrences.pos [2,3]},
    rw [nat.mul_div_cancel_left _  (gcd_pos_of_pos_left _ hn0), gcd_mul_left_left,
      hm, nat.mul_div_cancel _ hm0],
    exact le_of_dvd hn0 (gcd_dvd_left _ _)
  end

section totient

variables [group α] [fintype α] [decidable_eq α] (hn : ∀ n : ℕ, 0 < n → (univ.filter (λ a : α, a ^ n = 1)).card ≤ n)
include hn

lemma card_pow_eq_one_eq_order_of_aux (a : α) :
  (finset.univ.filter (λ b : α, b ^ order_of a = 1)).card = order_of a :=
le_antisymm
  (hn _ (order_of_pos _))
  (calc order_of a = @fintype.card (gpowers a) (id _) : order_eq_card_gpowers
    ... ≤ @fintype.card (↑(univ.filter (λ b : α, b ^ order_of a = 1)) : set α)
    (set.fintype_of_finset _ (λ _, iff.rfl)) :
      @fintype.card_le_of_injective (gpowers a) (↑(univ.filter (λ b : α, b ^ order_of a = 1)) : set α)
        (id _) (id _) (λ b, ⟨b.1, mem_filter.2 ⟨mem_univ _,
          let ⟨i, hi⟩ := b.2 in
          by rw [← hi, ← gpow_coe_nat, ← gpow_mul, mul_comm, gpow_mul, gpow_coe_nat,
            pow_order_of_eq_one, one_gpow]⟩⟩) (λ _ _ h, subtype.eq (subtype.mk.inj h))
    ... = (univ.filter (λ b : α, b ^ order_of a = 1)).card : set.card_fintype_of_finset _ _)

local notation `φ` := nat.totient

private lemma card_order_of_eq_totient_aux₁ :
  ∀ {d : ℕ}, d ∣ fintype.card α → 0 < (univ.filter (λ a : α, order_of a = d)).card →
  (univ.filter (λ a : α, order_of a = d)).card = φ d
| 0     := λ hd hd0, absurd hd0 (mt card_pos.1
  (by simp [finset.ext, nat.pos_iff_ne_zero.1 (order_of_pos _)]))
| (d+1) := λ hd hd0,
let ⟨a, ha⟩ := exists_mem_of_ne_empty (card_pos.1 hd0) in
have ha : order_of a = d.succ, from (mem_filter.1 ha).2,
have h : ((range d.succ).filter (∣ d.succ)).sum
    (λ m, (univ.filter (λ a : α, order_of a = m)).card) =
    ((range d.succ).filter (∣ d.succ)).sum φ, from
  finset.sum_congr rfl
    (λ m hm, have hmd : m < d.succ, from mem_range.1 (mem_filter.1 hm).1,
      have hm : m ∣ d.succ, from (mem_filter.1 hm).2,
      card_order_of_eq_totient_aux₁ (dvd.trans hm hd) (finset.card_pos.2
        (ne_empty_of_mem (show a ^ (d.succ / m) ∈ _,
          from mem_filter.2 ⟨mem_univ _,
          by rw [order_of_pow, ha, gcd_eq_right (div_dvd_of_dvd hm),
            nat.div_div_self hm (succ_pos _)]⟩)))),
have hinsert : insert d.succ ((range d.succ).filter (∣ d.succ))
    = (range d.succ.succ).filter (∣ d.succ),
  from (finset.ext.2 $ λ x, ⟨λ h, (mem_insert.1 h).elim (λ h, by simp [h, range_succ])
    (by clear _let_match; simp [range_succ]; tauto), by clear _let_match; simp [range_succ] {contextual := tt}; tauto⟩),
have hinsert₁ : d.succ ∉ (range d.succ).filter (∣ d.succ),
  by simp [mem_range, zero_le_one, le_succ],
(add_right_inj (((range d.succ).filter (∣ d.succ)).sum
  (λ m, (univ.filter (λ a : α, order_of a = m)).card))).1
  (calc _ = (insert d.succ (filter (∣ d.succ) (range d.succ))).sum
        (λ m, (univ.filter (λ a : α, order_of a = m)).card) :
    eq.symm (finset.sum_insert (by simp [mem_range, zero_le_one, le_succ]))
  ... = ((range d.succ.succ).filter (∣ d.succ)).sum (λ m,
      (univ.filter (λ a : α, order_of a = m)).card) :
    sum_congr hinsert (λ _ _, rfl)
  ... = (univ.filter (λ a : α, a ^ d.succ = 1)).card :
    sum_card_order_of_eq_card_pow_eq_one (succ_pos d)
  ... = ((range d.succ.succ).filter (∣ d.succ)).sum φ :
    ha ▸ (card_pow_eq_one_eq_order_of_aux hn a).symm ▸ (sum_totient _).symm
  ... = _ : by rw [h, ← sum_insert hinsert₁];
      exact finset.sum_congr hinsert.symm (λ _ _, rfl))

lemma card_order_of_eq_totient_aux₂ {d : ℕ} (hd : d ∣ fintype.card α) :
  (univ.filter (λ a : α, order_of a = d)).card = φ d :=
by_contradiction $ λ h,
have h0 : (univ.filter (λ a : α , order_of a = d)).card = 0 :=
  not_not.1 (mt nat.pos_iff_ne_zero.2 (mt (card_order_of_eq_totient_aux₁ hn hd) h)),
let c := fintype.card α in
have hc0 : 0 < c, from fintype.card_pos_iff.2 ⟨1⟩,
lt_irrefl c $
  calc c = (univ.filter (λ a : α, a ^ c = 1)).card :
    congr_arg card $ by simp [finset.ext, c]
  ... = ((range c.succ).filter (∣ c)).sum
      (λ m, (univ.filter (λ a : α, order_of a = m)).card) :
    (sum_card_order_of_eq_card_pow_eq_one hc0).symm
  ... = (((range c.succ).filter (∣ c)).erase d).sum
      (λ m, (univ.filter (λ a : α, order_of a = m)).card) :
    eq.symm (sum_subset (erase_subset _ _) (λ m hm₁ hm₂,
      have m = d, by simp at *; cc,
      by simp [*, finset.ext] at *; exact h0))
  ... ≤ (((range c.succ).filter (∣ c)).erase d).sum φ :
    sum_le_sum (λ m hm,
      have hmc : m ∣ c, by simp at hm; tauto,
      (imp_iff_not_or.1 (card_order_of_eq_totient_aux₁ hn hmc)).elim
        (λ h, by simp [nat.le_zero_iff.1 (le_of_not_gt h), nat.zero_le])
        (by simp [le_refl] {contextual := tt}))
  ... < φ d + (((range c.succ).filter (∣ c)).erase d).sum φ :
    lt_add_of_pos_left _ (totient_pos (nat.pos_of_ne_zero
      (λ h, nat.pos_iff_ne_zero.1 hc0 (eq_zero_of_zero_dvd $ h ▸ hd))))
  ... = (insert d (((range c.succ).filter (∣ c)).erase d)).sum φ : eq.symm (sum_insert (by simp))
  ... = ((range c.succ).filter (∣ c)).sum φ : finset.sum_congr
      (finset.insert_erase (mem_filter.2 ⟨mem_range.2 (lt_succ_of_le (le_of_dvd hc0 hd)), hd⟩)) (λ _ _, rfl)
  ... = c : sum_totient _

lemma is_cyclic_of_card_pow_eq_one_le : is_cyclic α :=
have ∃ x, x ∈ univ.filter (λ a : α, order_of a = fintype.card α),
from exists_mem_of_ne_empty (card_pos.1 $
  by rw [card_order_of_eq_totient_aux₂ hn (dvd_refl _)];
  exact totient_pos (fintype.card_pos_iff.2 ⟨1⟩)),
let ⟨x, hx⟩ := this in
is_cyclic_of_order_of_eq_card x (finset.mem_filter.1 hx).2

end totient

lemma is_cyclic.card_order_of_eq_totient [group α] [is_cyclic α] [fintype α] [decidable_eq α]
  {d : ℕ} (hd : d ∣ fintype.card α) : (univ.filter (λ a : α, order_of a = d)).card = totient d :=
card_order_of_eq_totient_aux₂ (λ n, is_cyclic.card_pow_eq_one_le) hd

end cyclic


import data.fintype.basic
import data.set.lattice
import DFA

universes u v

variable {α : Type}

structure NFA (alphabet : Type u) :=
[alphabet_fintype : fintype alphabet]
(state : Type v)
[state_fintype : fintype state]
[state_dec : decidable_eq state]
(step : state → alphabet → finset state)
(start : finset state)
(accept_states : finset state)
namespace NFA

-- @[reducible] def start_dec (M : NFA α) := decidable_pred M.start
-- @[reducible] def step_dec (M : NFA α) := Π (S : M.state) (a : α), decidable_pred (M.step S a)
-- instance dec₁ (M : NFA α) := M.start_dec
-- instance dec₂ (M : NFA α) := M.step_dec
-- instance dec₃ (M : NFA α) := M.accept_dec
instance dec (M : NFA α) := M.state_dec

instance fin₁ (M : NFA α) := M.alphabet_fintype
instance fin₂ (M : NFA α) := M.state_fintype

def step_set (M : NFA α) : finset M.state → α → finset M.state :=
λ Ss a, finset.bind Ss (λ S, (M.step S a))

def eval (M : NFA α) : list α → finset M.state := list.foldl M.step_set M.start

def accepts (M : NFA α) (s : list α) : Prop :=
∃ S ∈ M.accept_states, S ∈ M.eval s

def NFA_of_DFA (M : DFA α) : NFA α :=
{ alphabet_fintype := M.alphabet_fintype,
  state := M.state,
  state_fintype := M.state_fintype,
  step := λ S a, {M.step S a},
  start := {M.start},
  accept_states := M.accept_states }

lemma NFA_of_DFA_eval_match (M : DFA α) [decidable_eq M.state] (s : list α) :
  {M.eval s} = (NFA_of_DFA M).eval s :=
begin
  change {list.foldl M.step M.start s} = list.foldl (NFA_of_DFA M).step_set {M.start} s,
  generalize : M.start = start,
  revert start,
  induction s with a s ih,
  { tauto },
  { intro start,
    rw [list.foldl, list.foldl],
    have : (NFA_of_DFA M).step_set {start} a = {M.step start a},
    { rw step_set,
      finish },
    rw this,
    tauto }
end

lemma NFA_of_DFA_correct (M : DFA α) (s : list α) :
  M.accepts s ↔ (NFA_of_DFA M).accepts s :=
begin
  rw [accepts, DFA.accepts, ←NFA_of_DFA_eval_match],
  split,
  { intro h,
    use M.eval s,
    finish },
  { rintro ⟨ S, hS₁, hS₂ ⟩,
    rw finset.mem_singleton at hS₂,
    rw hS₂ at hS₁,
    assumption }
end

def DFA_of_NFA (M : NFA α) : DFA α :=
{ alphabet_fintype := M.alphabet_fintype,
  state := finset M.state,
  step := M.step_set,
  start := M.start,
  accept_states := finset.univ.filter (λ S, ∃ s ∈ S, s ∈ M.accept_states) }

lemma DFA_of_NFA_correct (M : NFA α) (s : list α) :
  M.accepts s ↔ M.DFA_of_NFA.accepts s :=
begin
  rw [accepts, DFA.accepts, eval, DFA.eval],
  change (∃ (S : M.state) (H : S ∈ M.accept_states), S ∈ list.foldl M.step_set M.start s) ↔ list.foldl M.step_set M.start s ∈ finset.univ.filter (λ S : finset M.state, ∃ s ∈ S, s ∈ M.accept_states),
  rw finset.mem_filter,
  finish
end

end NFA

structure ε_NFA (alphabet : Type u) :=
[alphabet_fintype : fintype alphabet]
(state : Type v)
[state_fintype : fintype state]
[state_dec : decidable_eq state]
(step : state → option alphabet → finset state)
(start : finset state)
(accept_states : finset state)

namespace ε_NFA

instance dec (M : ε_NFA α) := M.state_dec

instance fin₁ (M : ε_NFA α) : fintype α := M.alphabet_fintype
instance fin₂ (M : ε_NFA α) : fintype M.state := M.state_fintype

def step_set' (M : ε_NFA α) : finset M.state → option α → finset M.state :=
λ Ss a, finset.bind Ss (λ S, M.step S a)

inductive ε_closure_set (M : ε_NFA α) (Ss : finset M.state) : M.state → Prop
| base : ∀ (S ∈ Ss), ε_closure_set S
| step : ∀ S T, ε_closure_set S → T ∈ M.step S option.none → ε_closure_set T

def sub_of_compl {β : Type u} [fintype β] [decidable_eq β] : ∀ T U : finset β, Tᶜ ⊆ Uᶜ → U ⊆ T :=
begin
  intros T U h x hxU,
  by_contra hTc,
  rw ←finset.mem_compl at hTc,
  have hUc := finset.mem_of_subset h hTc,
  finish
end

instance ε_NFA_has_well_founded {β : Type u} [fintype β] [decidable_eq β] : has_well_founded (finset β) :=
{ r := (λ S₁ S₂ : finset β, S₁ᶜ < S₂ᶜ),
  wf :=
  inv_image.wf _ finset.lt_wf }

def ε_closure (M : ε_NFA α) : finset M.state → finset M.state
| S :=
begin
  let S' := S ∪ M.step_set' S none,
  by_cases heq : S' = S,
  { exact S },
  { let : S'ᶜ < Sᶜ,
    { have hsub : S'ᶜ ⊆ Sᶜ,
      { intros s hs,
        rw finset.mem_compl at hs ⊢,
        finish },
      use hsub,
      { intro hS,
        apply heq,
        rw finset.subset.antisymm_iff,
        split;
        apply sub_of_compl;
        assumption } },
    exact ε_closure S' }
end
using_well_founded {dec_tac := tactic.assumption}

lemma step_set'_wf (M : ε_NFA α) (S : finset M.state) (hneq : S ∪ M.step_set' S none ≠ S) :
  (S ∪ M.step_set' S none)ᶜ < Sᶜ :=
begin
  have hsub : (S ∪ M.step_set' S none)ᶜ ⊆ Sᶜ,
  { intros s hs,
    rw finset.mem_compl at hs ⊢,
    finish },
  use hsub,
  intro hS,
  apply hneq,
  rw finset.subset.antisymm_iff,
  split;
  apply sub_of_compl,
  assumption'
end

lemma ε_closure_equiv_ε_closure_set (M : ε_NFA α) :
  Π (S : finset M.state) (s : M.state), s ∈ M.ε_closure S ↔ M.ε_closure_set S s
| S :=
begin
  have IH := λ T (h : Tᶜ < Sᶜ), ε_closure_equiv_ε_closure_set T,
  intro s,
  split,
  { intro h,
    rw ε_closure at h,
    dsimp at h,
    split_ifs at h with heq,
    { apply ε_closure_set.base,
      assumption },
    { have hwf : (S ∪ M.step_set' S none)ᶜ < Sᶜ := M.step_set'_wf S heq,
      have h' : M.ε_closure_set (S ∪ M.step_set' S none) s,
        rwa ← IH (S ∪ M.step_set' S none) hwf,
      induction h' with t ht t' t d e ih,
      { simp at ht,
        cases ht,
        { apply ε_closure_set.base,
          assumption },
        { rw step_set' at ht,
          simp only [exists_prop, finset.mem_bind] at ht,
          cases ht with t' ht,
          apply ε_closure_set.step t' t,
          { apply ε_closure_set.base,
            tauto },
          { tauto } } },
      { apply ε_closure_set.step t' t,
        { apply ih,
          rwa IH (S ∪ M.step_set' S none) hwf },
        assumption } } },
  { intro h,
    rw ε_closure,
    dsimp,
    split_ifs with heq;
    induction h with t ht t' t ht' ht ih,
    { assumption },
    { rw ←heq,
      simp only [finset.mem_union],
      right,
      rw step_set',
      simp only [exists_prop, finset.mem_bind],
      use t',
      tauto },
    all_goals
    { have hwf : (S ∪ M.step_set' S none)ᶜ < Sᶜ := M.step_set'_wf S heq },
    { rw IH (S ∪ M.step_set' S none) hwf,
      apply ε_closure_set.base,
      rw finset.mem_union,
      left,
      assumption },
    { rw IH (S ∪ M.step_set' S none) hwf,
      apply ε_closure_set.step t' t,
      rwa ←IH (S ∪ M.step_set' S none) hwf,
      assumption } }
end
using_well_founded {dec_tac := tactic.assumption}

def step_set (M : ε_NFA α) : finset M.state → α → finset M.state :=
λ Ss a, M.ε_closure $ finset.bind Ss (λ S, M.step S (option.some a))

def eval (M : ε_NFA α) : list α → finset M.state :=
  list.foldl M.step_set (M.ε_closure M.start)

def accepts (M : ε_NFA α) (s : list α) : Prop :=
∃ S ∈ M.accept_states, S ∈ M.eval s

instance accepts_dec (M : ε_NFA α) : decidable_pred M.accepts :=
begin
  intro s,
  exact fintype.decidable_exists_fintype
end

def NFA_of_ε_NFA (M : ε_NFA α) : NFA α :=
{ alphabet_fintype := M.alphabet_fintype,
  state := M.state,
  step := λ S a, M.ε_closure (M.step S (some a)),
  start := M.ε_closure M.start,
  accept_states := M.accept_states }

lemma NFA_of_ε_NFA_step_set_match (M : ε_NFA α) (Ss : finset M.state) (a : α) :
  M.step_set Ss a = M.NFA_of_ε_NFA.step_set Ss a :=
begin
  rw [step_set, NFA.step_set],
  simp,
  ext b,
  rw ε_closure_equiv_ε_closure_set,
  split,
  { intro h,
    -- generalize_hyp hT : (Ss.bind (λ (S : M.state), M.step S (some a))) = Ts at h,
    induction h with s h U T hU h ih,
    {
      -- rw ←hT at h,
      simp only [exists_prop, finset.mem_bind] at h ⊢,
      cases h with i hi,
      rw @finset.mem_bind _ M.state M.state_dec,
      use i,
      use hi.1,
      change s ∈ M.ε_closure (M.step i (some a)),
      rw ε_closure_equiv_ε_closure_set,
      apply ε_closure_set.base,
      tauto },
    { rw @finset.mem_bind _ M.state M.state_dec at ⊢ ih,
      rcases ih with ⟨ i, h₁, h₂ ⟩,
      existsi i,
      existsi h₁,
      change T ∈ M.ε_closure (M.step i (some a)),
      rw ε_closure_equiv_ε_closure_set,
      apply ε_closure_set.step U _,
      change U ∈ M.ε_closure (M.step _ (some _)) at h₂,
      rw ←ε_closure_equiv_ε_closure_set,
      assumption' } },
  { rw @finset.mem_bind _ M.state M.state_dec,
    rintro ⟨ s, hsSs, hba ⟩,
    change b ∈ M.ε_closure (M.step _ (some _)) at hba,
    rw ε_closure_equiv_ε_closure_set at hba,
    induction hba with s h U T hU h ih,
    { apply ε_closure_set.base,
      finish },
    { specialize ih,
      apply ε_closure_set.step,
      assumption' } }
end

lemma NFA_of_ε_NFA_eval_match (M : ε_NFA α) (s : list α) :
  M.eval s = (NFA_of_ε_NFA M).eval s :=
begin
  change list.foldl M.step_set (M.ε_closure M.start) s = list.foldl M.NFA_of_ε_NFA.step_set (M.ε_closure M.start) s,
  congr,
  ext1,
  ext1,
  rw NFA_of_ε_NFA_step_set_match
end

lemma NFA_of_ε_NFA_correct (M : ε_NFA α) (s : list α) :
  M.accepts s ↔ M.NFA_of_ε_NFA.accepts s :=
begin
  rw [accepts, NFA.accepts, NFA_of_ε_NFA_eval_match],
  tauto
end

end ε_NFA


-- main theorem: add_iter_sound
import algebra
import combinators
import add_monotonic
import add_finite

namespace iter

section params_unary
variables {σ I V : Type} [linear_order I]
variables (s t : σ) {a : iter σ I V}

section semantics
variables [add_monoid V]

@[simp] lemma terminal_semantics₁_zero (h : a.terminal t) : a.semantics₁ t = 0 := by simp *

@[simp]
theorem terminal_zero {t} {a : iter σ I V} (m : a.monotonic) (h : a.terminal t) (j:ℕ) : a.semantics t j = 0 := begin
induction j with _ jh generalizing t,
all_goals {simp *}
end

lemma succ_of_ge_succ : ∀ {i i' : ℕ}, i.succ ≤ i' → ∃ i'':ℕ, i' = i''.succ
| i (nat.succ i'') hle := ⟨_, rfl⟩

theorem semantics_mono {i i'} {s} : a.monotonic → a.terminal_by s i → i ≤ i' → a.semantics s i = a.semantics s i' := λ mono fin hle, begin
induction i with i hi generalizing i' s,
{ simp * at * },
obtain ⟨i'', h1⟩ := succ_of_ge_succ hle,
rw h1 at *,
simp only [semantics],
have : i ≤ i'' := nat.le_of_succ_le_succ hle,
rw hi (step_progress fin) this,
end

end semantics
end params_unary

section params_binary

variables {σ₁ σ₂ I V : Type} [linear_order I] [decidable_eq σ₁] [decidable_eq σ₂] [add_comm_monoid V]
{a : iter σ₁ I V} {b : iter σ₂ I V}
{s₁ : σ₁} {s₂ : σ₂}

theorem add_iter_sound {i j}
: a.monotonic → b.monotonic → a.terminal_by s₁ i → b.terminal_by s₂ j →
  (a +' b).semantics (s₁,s₂) (i+j) = a.semantics s₁ i + b.semantics s₂ j :=
λ amono bmono afin bfin, begin
generalize hnij : i+j = n,
induction n with n hn generalizing s₁ s₂ i j,
{ obtain ⟨i0, j0⟩ := sum_zero.1 hnij.symm,
  simp only [*, semantics, sum_zero, add_zero],
},

obtain (⟨hs,nta,h⟩|⟨hs,ntdi,h⟩|⟨hs,ntb,h⟩) := step_sem_trichotomy a b s₁ s₂,

{ -- a.δ
  obtain ⟨i', hisucc⟩ := not_terminal_succ nta afin,
  rw hisucc at *,
  simp only [semantics],
  rw [hs,h],
  rw hn (step_progress afin) bfin _,
  { rw add_assoc },
  { simp [*, nat.succ_add] at * },
},

{ -- a.δ, b.δ
  obtain (⟨ta, tb⟩|⟨nta,ntb⟩) := ntdi,

  { simp only [*, terminal_zero, add_zero, add_iter_monotonic, add_iter_terminal] },

  { obtain ⟨i', hisucc⟩ := not_terminal_succ nta afin,
    obtain ⟨j', hjsucc⟩ := not_terminal_succ ntb bfin,
    simp only [hisucc, hjsucc] at *,
    simp only [semantics, hs, h],
    replace afin := step_progress afin,
    rw semantics_mono amono afin (nat.le_succ _),
    have afin' := terminal_by_mono i' i'.succ amono afin (nat.le_succ _),
    have := hn afin' (step_progress bfin) (nat.succ.inj hnij),
    rw this,
    abel,
  },
},

{ -- b.δ
  obtain ⟨j', hjsucc⟩ := not_terminal_succ ntb bfin,
  rw hjsucc at *,
  simp only [iter.semantics],
  rw [hs, h],
  rw hn afin (step_progress bfin) _,
  { abel },
  { simp [*, nat.add_succ] at * },
},
end

variables (u : stream σ₁ I V) (v : stream σ₂ I V)

theorem add_stream_sound  {i j} : u.monotonic → v.monotonic → u.terminal_by i → v.terminal_by j →
⟦mk_add u v, i+j⟧ = ⟦u, i⟧ + ⟦v, j⟧ := add_iter_sound

end params_binary
end iter