/-
Copyright 2020 Google LLC

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

      http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
 -/
import order.filter.basic
import topology.bases
import data.real.nnreal
import topology.instances.real
import topology.instances.nnreal
import topology.instances.ennreal

import topology.algebra.infinite_sum
import formal_ml.set
import formal_ml.finset
import formal_ml.nat
import formal_ml.ennreal
import formal_ml.nnreal
import data.finset
import order.complete_lattice
import formal_ml.filter_util
import formal_ml.real

/-
  A high-level point:
  On closer inspection of infinite-sum.lean, several of these theorems are covered.
-/
open finset
-- See cfilter
/-
  There are some useful functions already in the library:
  finset.sum_subset
-/

--The core of this is finset.sum_const. However, there are not many lemmas that I found
--around add_monoid.smul.
lemma finset_sum_const {α:Type*} {S:finset α} {f:α → ennreal} {c:ennreal}:(∀ k, f k =c) →
  S.sum f = S.card * c :=
begin
  intros A1,
  have A2:f = λ k, c,
  {
    ext,
    rw A1,
  },
  rw A2,
  rw (@finset.sum_const α ennreal S _ c),
  rw ennreal_add_monoid_smul_def,
end

--This is a combination of finset.sum_congr and finset.sum_const_zero.
lemma finite_sum_zero_eq_zero {α β:Type*} [add_comm_monoid α] [decidable_eq β] (f:β → α) (S:finset β):
  (∀ s∈ S, f s = 0) →
  S.sum f = 0 :=
begin
  intro A1,
  let g:β → α := λ a:β, (0:α),
  begin
    have B1:S = S := rfl,
    have B2:(∀ x∈ S, f x = g x),
    {
      intros x B2A,
      rw A1 x B2A,
    },

    rw finset.sum_congr B1 B2,
    apply finset.sum_const_zero,
  end
end

lemma finset_sum_le2 {α β:Type*} [decidable_eq α]
    [ordered_add_comm_monoid β] {S:finset α} {f g:α → β}:
  (∀ s∈ S, f s ≤ g s) →  S.sum f ≤ S.sum g :=
begin
  apply finset.induction_on S,
  {
    intros A1,
    simp,
  },
  {
    intros a S2 A1 A2 A3,
    rw finset.sum_insert,
    rw finset.sum_insert,
    apply add_le_add,
    apply A3,
    simp,
    apply A2,
    {
      intros a2 A4,
      apply A3,
      simp,
      right,
      exact A4,
    },
    exact A1,
    exact A1,
  }
end

lemma finset_prod_le {α β:Type*} [decidable_eq α]
    [ordered_comm_monoid β] {S:finset α} {f g:α → β}
  (h_le:∀ s∈ S, f s ≤ g s) : S.prod f ≤ S.prod g :=
begin
  revert h_le,
  apply finset.induction_on S,
  { simp },
  { intros a s h_a_notin_s h_ind h_le,
    rw finset.prod_insert h_a_notin_s,
    rw finset.prod_insert h_a_notin_s,
    apply mul_le_mul',
    { apply h_le, simp },
    apply h_ind,
    intros a' h_a'_in_s,
    apply h_le,
    simp [h_a'_in_s],
 },
end

lemma finset_sum_le3 {α β:Type*}  [decidable_eq α] [ordered_add_comm_monoid β] {f g:α → β} {S:finset α}:
  f ≤ g →
  S.sum f ≤ S.sum g :=
begin
  intro A1,
  apply finset_sum_le2,
  intros n A2,
  apply A1,
end

lemma finset.sum_nonnegative_of_nonnegative {α β:Type*} [decidable_eq α] [ordered_add_comm_monoid β] {S:finset α}
  {f:α → β}:(0 ≤ f) → 0 ≤ S.sum f :=
begin
  intros A1,
  have A2:S.sum (0:α → β) = (0:β),
  {
    apply finite_sum_zero_eq_zero,
    intros a A2A,
    refl,
  },
  rw ← A2,
  apply finset_sum_le3,
  apply A1,
end

lemma finset.sum_monotone_of_nonnegative {α β:Type*} [decidable_eq α] [ordered_add_comm_monoid β] {S T:finset α}
  {f:α → β}:0 ≤ f → S ⊆ T → S.sum f ≤ T.sum f  :=
begin
  intros A1 A2,
  rw ← finset.sum_sdiff A2,
  rw add_comm,
  apply le_add_of_nonneg,
  apply finset.sum_nonnegative_of_nonnegative,
  apply A1,
end

lemma finset.sum_monotone {α β:Type*} [decidable_eq α] [canonically_ordered_add_monoid β] {S T:finset α}
  {f:α → β}:S ⊆ T → S.sum f ≤ T.sum f  :=
begin
  intros A2,
  rw ← finset.sum_sdiff A2,
  rw add_comm,
  apply le_add_nonnegative,
end

lemma finset.element_le_sum {α β:Type*} [D:decidable_eq α] [canonically_ordered_add_monoid β] {S:finset α} {a:α}
  {f:α → β}:(a ∈ S) → f a ≤ S.sum f  :=
begin
  intros A2,
  rw ← @finset.sum_singleton α β a f,
  apply finset.sum_monotone,
  simp,
  apply A2,
end

lemma finset.sum_monotone' {α β:Type*} [D:decidable_eq α] [canonically_ordered_add_monoid β]
  {f:α → β}:monotone (λ S:finset α, S.sum f) :=
begin
  intros S T B1,
  apply finset.sum_monotone B1,
end

lemma ennreal.sum_monotone {α:Type*} [decidable_eq α] {S T:finset α}
  {f:α → ennreal}:S ⊆ T → S.sum f ≤ T.sum f  :=
begin
  intro A1,
  apply finset.sum_monotone A1,
end

--This should be removed, and finset.sum_nonnegative_of_nonnegative should be used directly.
lemma nn_sum_nonneg {α:Type*} [decidable_eq α] (f:α → real) (S:finset α):
  (∀ n, f n ≥ 0) → (0≤ (S.sum f) ) :=
begin
  intro A1,
  apply finset.sum_nonnegative_of_nonnegative,
  rw le_func_def2,
  intros n,
  apply A1,
end

--This should be removed, and finset.sum_monotone_of_nonnegative should be used directly.
lemma nn_sum_monotonic {α:Type*} [decidable_eq α] (f:α → real) (S T:finset α):
  (∀ n, f n ≥ 0) → (S⊆ T)→ ((S.sum f) ≤ (T.sum f)) :=
begin
  intro A1,
  apply finset.sum_monotone_of_nonnegative,
  rw le_func_def2,
  intros n,
  apply A1,
end

lemma sum_monotonic_of_nnreal {α:Type*} [D:decidable_eq α] (f:α → nnreal) (S T:finset α):
  (S⊆ T)→ ((S.sum f) ≤ (T.sum f)) :=
begin
  apply finset.sum_monotone,
end

lemma sum_monotone_of_nonneg {α:Type*} [D:decidable_eq α] {f:α → ℝ}:
  0 ≤ f → monotone (λ s:finset α, s.sum f) :=
begin
  intros A1 a b A2,
  simp,
  apply @nn_sum_monotonic α D f a b,
  apply A1,
  apply A2,
end

lemma sum_monotone_of_nnreal {α:Type*} [D:decidable_eq α] {f:α → nnreal}:
  monotone (λ s:finset α, s.sum f) :=
begin
  apply finset.sum_monotone',
end

/-
  This concept of sum is similar to absolutely convergent,
  as opposed to convergent. To eliminate the difference, we
  just insist the function is positive.

  TODO: revisit in the context of later theories.
-/
lemma has_classical_limit_real (f:ℕ → real) (v:real):
  (∀ n, f n ≥ 0) →
  (∀ e>0, ∃ m,∀ m', m < m' →
  ((v - e <(finset.sum (finset.range m') f)) ∧
    (finset.sum (finset.range m') f) < v  + e)
   ) →
  has_sum f v
  :=
begin
  intros a a_1,
  unfold has_sum,
  apply filter_tendsto_intro,
  intros,
  unfold set.preimage,
  -- lemma mem_nhds_elim_real_bound (b:set real) (x:real): b∈ nhds x →
  -- (∃ r>0, (set.Ioo (x-r) (x+r)) ⊆ b)
  have A1:(∃ r>0, (set.Ioo (v-r) (v+r)) ⊆ b),
  {
    apply mem_nhds_elim_real_bound,
    exact H,
  },
  cases A1,
  cases A1_h,
  apply filter_contains_preimage_superset,
  {
    apply A1_h_h,
  },
  have A2:(∃ (m : ℕ), ∀ (m' : ℕ), m < m' →

        v - A1_w < finset.sum (range m') f ∧
        finset.sum (range m') f < v + A1_w
        ),
  {
    apply a_1,
    apply A1_h_w,
  },
  cases A2,

  apply filter_at_top_intro3,
  show finset ℕ,
  {
    exact finset.range (nat.succ A2_w),
  },
  {
    intros,
    unfold set.Ioo,
    simp,
    split,
    {
      have D1:(range (nat.succ A2_w)).sum  f ≤ d.sum f,
      {
         apply nn_sum_monotonic,
         apply a,
         apply H_1,
      },
      have D2:v - A1_w < finset.sum (range (nat.succ A2_w)) f  ∧
             finset.sum (range (nat.succ A2_w)) f < v + A1_w,
      {
         apply A2_h,
          apply nat.lt_succ_self,
      },
      cases D2,
      apply lt_of_lt_of_le,
      {
        apply D2_left,
      },
      {
        apply D1,
      },
    },
    {
      have B1:∃ n, (d⊆ finset.range n),
      {
        apply finset_range_bound,
      },
      cases B1,
      cases (nat.decidable_le B1_w A2_w),
      {
        have B2:A2_w<B1_w,
        {
          have B3:A2_w<B1_w ∨ A2_w ≥ B1_w,
          {
            apply nat.lt_or_ge,
          },
          cases B3,
          {
            apply B3,
          },
          {
            exfalso,
            apply h,
            apply B3,
          }
        },
        have B4:d.sum f ≤ (range B1_w).sum  f,
        {
          apply nn_sum_monotonic,
          {
            apply a,
          },
          {
            apply B1_h,
          }
        },
        --rw ← finite_sum_real_finset at B4,
        have B5:v - A1_w < (finset.sum (range B1_w) f) ∧ finset.sum (range B1_w) f < v + A1_w,
        {
          apply A2_h,
          apply B2,
        },
        cases B5,
        apply lt_of_le_of_lt,
        {
          apply B4,
        },
        {
          apply B5_right,
        }
      },
      {
        have C1:range B1_w ⊆ range (nat.succ A2_w),
        {
          apply finset_range_monotonic,
          apply le_trans,
          apply h,
          apply nat.le_of_lt,
          apply nat.lt_succ_self,
        },
        have C2:v - A1_w < finset.sum (range (nat.succ A2_w)) f ∧
               finset.sum (range (nat.succ A2_w)) f < v + A1_w,
        {
          apply A2_h,
          apply nat.lt_succ_self,
        },
        cases C2,
        have C3:d⊆ range (nat.succ A2_w),
        {
          apply finset.subset.trans,
          apply B1_h,
          apply C1,
        },
        have C4:d.sum f ≤  (range (nat.succ A2_w)).sum f,
        {
          apply nn_sum_monotonic,
          apply a,
          apply C3,
        },
        apply lt_of_le_of_lt,
        {
          apply C4,
        },
        {
          apply C2_right,
        }
      }
    }
  }

end

lemma finite_sum_real_eq_finite_sum2 (f:ℕ → nnreal) (n:ℕ):
  (finset.sum (range n)  (λ (a : ℕ), ((f a):real))) =
  ((@finset.sum ℕ nnreal _ (range n) f):real) :=
begin
  rw nnreal.coe_sum,
end

lemma has_classical_limit_nnreal (f:ℕ → nnreal) (v:nnreal):
  (∀ e>0, ∃ m,∀ m', m < m' →  v < (finset.sum (range m') f) + e)  →
  (∀ m', (finset.sum (range m') f) ≤ v) →
  has_sum f v
  :=
begin
  intros a a_1,

  apply (@nnreal.has_sum_coe _ f v).mp,
  apply has_classical_limit_real,
  {
    intros n,
    simp,
  },
  {
    intros e H,
    have A1:0 < e,
    {
      apply H,
    },
    have A2:max e 0 = e,
    {
      apply max_eq_left,
      apply le_of_lt,
      apply A1,
    },
    rw ← A2 at A1,
    have A2B:(nnreal.of_real e) > 0,
    {
      unfold nnreal.of_real,
      apply A1,
    },
    have A3:(∃ (m : ℕ), ∀ (m' : ℕ), m < m' → v < (finset.sum (range m') f) + (nnreal.of_real e)),
    {
      apply a,
      apply A2B,
    },
    cases A3,
    apply exists.intro A3_w,
    intros m' a_2,
    have A4:v < finset.sum (range m') f  + nnreal.of_real e,
    {
      apply A3_h,
      apply a_2,
    },
    split,
    {
      rw finite_sum_real_eq_finite_sum2,
      apply (@sub_lt_iff_lt_add real _ (↑v) ↑(finset.sum (range m') (λ (a : ℕ), f a)) e).mpr,
      simp,
      rw real.linear_ordered_comm_ring.add_comm,
      have A5: (v:ℝ) < (((@finset.sum ℕ nnreal _ (range m') f) + nnreal.of_real e):ℝ),
      {
        apply A4,
      },
      have A6:((nnreal.of_real e):ℝ) = e,
      {
        unfold nnreal.of_real,
        simp,
        apply le_of_lt H,
      },
      rw A6 at A5,
      rw add_comm,
      apply A5,
    },
    {
      rw finite_sum_real_eq_finite_sum2,
      have A7:finset.sum (range m') f ≤ v,
      {
        apply a_1,
      },
      simp,
      have A8:((@finset.sum ℕ nnreal _ (range m') f):ℝ) ≤ (v:ℝ),
      {
        apply A7,
      },
      apply lt_of_le_of_lt,
      {
        apply A8,
      },
      rw add_comm,
      apply (@sub_lt_iff_lt_add real _ (↑v) e (↑v)).mp,
      simp,
      apply H,
    }
  }
end

--Not quite the classical way of thinking about a limit, but
--more practical for nonnegative sums.
lemma has_classical_limit_nnreal' (f:ℕ → nnreal) (v:nnreal):
  (∀ e>0, ∃ m,  v < (finset.sum (range m) f) + e)  →
  (∀ m', (finset.sum (range m') f) ≤ v) →
  has_sum f v
  :=
begin
  intros A1 A2,
  apply has_classical_limit_nnreal f v _ A2,
  intros e B1,
  have B2 := A1 e B1,
  cases B2 with m B2,
  apply exists.intro m,
  intro m',
  intro B3,
  have B4:(range m).sum f ≤ (range m').sum f,
  {
    apply sum_monotonic_of_nnreal,
    simp,
    apply le_of_lt B3,
  },
  have B5:(range m).sum f + e ≤ (range m').sum f + e,
  {
    simp,
    apply B4,
  },
  apply lt_of_lt_of_le B2 B5,
end

--Definitely this is in the mathlib library under a different name.
lemma disjoint_partition_sum_eq {α β:Type*} [decidable_eq α] [add_comm_monoid β]
  (f:α  → β) (S T:finset α):
  (T ≥ S) →
   S.sum f +  (T\S).sum f = T.sum f :=
begin
  intros a,
  have A1:disjoint S (T\ S),
  {
    apply (@disjoint.symm (finset α) _ (T \ S) S),
    apply finset.sdiff_disjoint,
  },
  have A2:S.sum f +  (T\S).sum f = (S ∪ T \ S).sum  f,
  {
    apply (sum_disjoint_add f S (T \ S)),
    apply A1,
  },
  rw finset.union_sdiff_of_subset at A2,
  {
    exact A2,
  },
  {
    apply a,
  }
end

--This is a special case of finset.sum_subset

--TODO: remove, and use summable.has_sum.
lemma has_sum_tsum {α β: Type*} [add_comm_monoid α] [topological_space α]
  {f:β → α}:summable f → has_sum f (tsum f) :=
begin
  intro A1,
  apply summable.has_sum A1,
end

--TODO: remove, and use has_sum_sum_of_ne_finset_zero.
--This is certainly a lemma in infinite_sum.
lemma has_finite_sum (α β:Type*) [topological_space α] [add_comm_monoid α] [decidable_eq β] (f:β → α) (S:finset β):
  (∀ s∉ S, f s = 0) → (has_sum f (S.sum f)) :=
begin
  intros a,
  apply has_sum_sum_of_ne_finset_zero,
  apply a,
end

lemma finite_sum_eq3 (α β:Type*) [topological_space α] [t2_space α] [add_comm_monoid α]
  [decidable_eq β] (f:β → α) (S:finset β):
  (∀ s∉ S, f s = 0) → (tsum f) =  (S.sum f) :=
begin
  intros a,
  have A1:has_sum f (S.sum f),
  {
    apply has_finite_sum,
    apply a,
  },
  have A2:summable f,
  {
    apply has_sum.summable,
    apply A1,
  },
  apply has_sum.tsum_eq,
  apply A1,
end

--TODO: replace with finset.sum_congr
lemma finset_sum_subst2 {α β:Type*} [decidable_eq α] [add_comm_monoid β] {S:finset α} {f g:α → β}:
  (∀ s∈ S, f s = g s) →  S.sum f = S.sum g :=
begin
  intros A1,
  apply finset.sum_congr,
  refl,
  apply A1,
end

lemma finset_sum_subst {α:Type*} [decidable_eq α] {S:finset α} {f g:α → nnreal}:
  (∀ s∈ S, f s = g s) →  S.sum f = S.sum g :=
begin
  apply finset_sum_subst2,
end

/-
add_monoid.smul (card S) k = ↑(card S) * k
-/
lemma finset_sum_le_const {α:Type*} [D:decidable_eq α] {S:finset α} {f:α → nnreal} {k:nnreal}:
  (∀ s∈ S, f s ≤ k) →  S.sum f ≤ S.card  * k :=
begin
  have A1:S.sum (λ s, k) = S.card * k,
  {
    rw finset.sum_const,
    apply nnreal_add_monoid_smul_def,
  },
  intro A2,
  rw ← A1,
  apply finset_sum_le2,
  intros s A4,
  apply A2,
  apply A4,
end

/-
canonically_ordered_comm_semiring.mul_eq_zero_iff :
  ∀ {α : Type u_1} [c : canonically_ordered_comm_semiring α] (a b : α), a * b = 0 ↔ a = 0 ∨ b = 0
-/
lemma finset_sum_eq_zero_iff {α:Type*} [decidable_eq α] {S:finset α} {f:α → nnreal}:
  S.sum f = 0 ↔ ∀ s∈ S, f s = 0 :=
begin
  split,
  {
    apply finset.induction_on S,
    {
      intros A1 s A2,
      exfalso,
      apply A2,
    },
    {
      intros a s a_1 a_2 a_3 s_1 H,
      rw finset.sum_insert at a_3,
      rw nnreal_add_eq_zero_iff (f a) (finset.sum s f) at a_3,
      cases a_3 with A3 A4,
      simp at H,
      cases H,
      {
        subst s_1,
        exact A3,
      },
      {
        apply a_2,
        exact A4,
        exact H,
      },
      apply a_1,
    }
  },
  {
    intros A1,
    have A2:∀ s:α, s ∈ S→ f s = (λ k:α, 0) s,
    {
      simp,
      exact A1,
    },
    rw finset_sum_subst A2,
    simp,
  }
end

lemma finset_sum_neg  {α:Type*} {f:α → ℝ} {S:finset α}:
  (S).sum (-f) = -((S).sum f) :=
begin
  apply finset.sum_neg_distrib,
end

lemma finset_sum_mul_const {α:Type*} {f:α → ℝ} {S:finset α} {k:ℝ}:
    S.sum (λ n, k * (f n)) = k * S.sum f :=
begin
  apply finset.sum_hom,
end

----- Working on the relationship between the supremum and the sum of a nonnegative function--------

/-
  A lot of times, it helps to think about a sum over nonnegative values. In particular,
  if 0 ≤ f ≤ g, then if g is summable, then f is summable. For example, this allows us to write:

  0 ≤ pos_only g ≤ abs g
  0 ≤ -neg_only g ≤ abs g

  This seemingly innocuous result is tricky, but there is a simple way to achieve it. In
  particular, we can show that if the image of finset.sum.

  Some of the lemmas below might hold for a conditionally complete linear order.
-/

/-
  A more explicit interpretation of summation over the reals.
 -/
lemma has_sum_real {α:Type*} {f:α → ℝ} [decidable_eq α] {x:ℝ}:
  (∀ ε>0, ∃ S:finset α, ∀ T⊇S, abs (T.sum f - x) < ε) ↔
  (has_sum f x) :=
begin
  split;intro A1,
  {
    unfold has_sum,
    apply filter_tendsto_intro,
    intros b A2,
    have A3:= mem_nhds_elim_real_bound b x A2,
    cases A3 with ε A4,
    cases A4 with A5 A6,
    have A7 := A1 ε A5,
    cases A7 with S A8,
    apply filter_at_top_intro3 S,
    intros T A9,
    have A10 := A8 T A9,
    apply A6,
    rw ← abs_lt_iff_in_Ioo,
    simp,
    apply A10,
  },
  {
    intros ε A2,
    unfold has_sum at A1,
    have A3:set.Ioo (x - ε) (x + ε) ∈ nhds x := Ioo_nbhd A2,
    have A4 := filter_tendsto_elim A1 A3,
    have A5 := mem_filter_at_top_elim A4,
    cases A5 with S A6,
    apply exists.intro S,
    intros T A7,
    rw set.subset_def at A6,
    have A8 := A6 T A7,
    have A9:T.sum f ∈ set.Ioo (x - ε) (x + ε) := A8,
    rw abs_lt_iff_in_Ioo,
    apply A9,
  }
end

lemma real_le_of_forall_lt {x y:ℝ}:(∀ ε > 0, x < y + ε) → x ≤ y :=
begin
  intro A1,
  apply le_of_not_gt,
  intro A2,
  have A3:0 < x-y := sub_pos_of_lt A2,
  have A4:= A1 (x-y) A3,
  simp at A4,
  apply lt_irrefl x A4,
end

lemma has_sum_real_nonnegh {α:Type*} {f:α → ℝ} [decidable_eq α] {x:ℝ}:
  (0 ≤ f) →
  (((∀ ε>0, ∃ S:finset α, x - ε  < S.sum f) ∧ (∀ T:finset α, T.sum f ≤ x)) ↔
  (∀ ε>0, ∃ S:finset α, ∀ T⊇S, abs (T.sum f - x) < ε)) :=
begin
  intro A1,
  split;intros A2,
  {
    cases A2 with A3 A4,
    intros ε A5,
    have A6 := A3 ε A5,
    cases A6 with S A7,
    apply exists.intro S,
    intros T A8,
    rw abs_lt2,
    split,
    {
      apply lt_of_lt_of_le,
      apply A7,
      apply sum_monotone_of_nonneg A1 A8,
    },
    {
      apply lt_of_le_of_lt,
      apply A4,
      simp,
      apply A5,
    }
  },
  {
    split,
    {
      intros ε A5,
      have A6 := A2 ε A5,
      cases A6 with S A7,
      apply exists.intro S,
      have A8:S ⊆ S := finset.subset.refl S,
      have A9:= A7 S A8,
      rw abs_lt2 at A9,
      apply A9.left,
    },
    {
      intro T,
      apply real_le_of_forall_lt,
      intros ε A3,
      have A4 := A2 ε A3,
      cases A4 with S A5,
      have A6:S ⊆ S ∪ T := finset.subset_union_left S T,
      have A7:T ⊆ S ∪ T := finset.subset_union_right S T,
      have A8 := A5 (S ∪ T) A6,
      rw abs_lt2 at A8,
      cases A8 with A9 A10,
      apply lt_of_le_of_lt,
      apply sum_monotone_of_nonneg A1 A7,
      apply A10,
    }
  }
end

lemma has_sum_real_nonneg {α:Type*} {f:α → ℝ} [decidable_eq α] {x:ℝ}:
  (0 ≤ f) →
  (((∀ ε>0, ∃ S:finset α, x - ε  < S.sum f) ∧ (∀ T:finset α, T.sum f ≤ x)) ↔
  (has_sum f x)) :=
begin
  intro A1,
  apply iff.trans,
  rw has_sum_real_nonnegh A1,
  apply has_sum_real,
end

lemma mem_upper_bounds_of_has_sum {α:Type*} {f:α → ℝ} [decidable_eq α] {x:ℝ}:
  0 ≤ f →
  has_sum f x →
  x∈ upper_bounds (set.range (λ s:finset α, s.sum f)) :=
begin
  intros A1 A2,
  rw ← has_sum_real_nonneg at A2,
  cases A2 with A3 A4,
  unfold upper_bounds,
  simp,
  apply A4,
  apply A1
end

lemma lower_not_upper_bound_of_has_sum {α:Type*} {f:α → ℝ} [decidable_eq α] {x y:ℝ}:
  0 ≤ f →
  has_sum f x →
  y < x →
  (∃ z∈ (set.range (λ s:finset α, s.sum f)), y < z) :=
begin
  intros A1 A2 A3,
  rw ← has_sum_real_nonneg A1 at A2,
  cases A2 with A4 A5,
  have A6:0 < x-y := sub_pos_of_lt A3,
  have A7:= A4 (x-y) A6,
  cases A7 with S A8,
  apply exists.intro (S.sum f),
  split,
  {
    simp,
  },
  {
    rw sub_inv at A8,
    apply A8
  }
end

lemma le_upper_bound_intro {s : set ℝ} {b c: ℝ}:
   (∀ (w : ℝ), w < b → (∃ (a : ℝ) (H : a ∈ s), w < a)) →
   (c∈ upper_bounds s) →
   (b ≤ c) :=
begin
  intros A1 A2,
  apply le_of_not_lt,
  intro A3,
  have A4 := A1 c A3,
  cases A4 with z A5,
  cases A5 with A6 A7,
  unfold upper_bounds at A2,
  simp at A2,
  have A8:= A2 A6,
  apply not_le_of_lt A7,
  apply A8,
end

lemma least_upper_bounds_of_has_sum {α:Type*} {f:α → ℝ} [decidable_eq α] {x y:ℝ}:
  0 ≤ f →
  has_sum f x →
  y∈ upper_bounds (set.range (λ s:finset α, s.sum f)) →
  (x ≤ y):=
begin
  intros A1 A2 A3,
  apply @le_upper_bound_intro (set.range (λ s:finset α, s.sum f)),
  {
    intros w A4,
    apply lower_not_upper_bound_of_has_sum;assumption,
  },
  {
    apply A3,
  },
end

lemma set_range_inhabited_domain {α:Type*} {β:Type*} {f:α → β}
  [A1:inhabited α]:(set.range f).nonempty :=
begin
  unfold set.range,
  apply exists.intro (f A1.default),
  simp,
end

lemma set_range_finset_nonempty {α β:Type*} [add_comm_monoid β] {f:α → β}:
  (set.range (λ (s : finset α), s.sum f)).nonempty :=
begin
  apply set_range_inhabited_domain,
end

lemma bdd_above_def {α:Type*} [preorder α] {s:set α}:
  bdd_above s = (upper_bounds s).nonempty := rfl

lemma bdd_above_of_has_sum {α:Type*} {f:α → ℝ} [decidable_eq α] {x:ℝ}:
  0 ≤ f →
  has_sum f x →
  bdd_above (set.range (λ s:finset α, s.sum f)) :=
begin
  intros A1 A2,
  rw bdd_above_def,
  apply exists.intro x,
  apply mem_upper_bounds_of_has_sum A1 A2,
end

lemma supr_of_has_sum {α:Type*} {f:α → ℝ} [decidable_eq α] {x:ℝ}:
  0 ≤ f →
  has_sum f x →
  x = ⨆ (s : finset α), s.sum f :=
begin
  intros A1 A2,
  unfold supr,
  symmetry,
  apply cSup_intro,
  {
    apply set_range_finset_nonempty,
  },
  {
    intros x2 A3,
    have A4:=mem_upper_bounds_of_has_sum A1 A2,
    unfold upper_bounds at A4,
    simp at A4,
    simp at A3,
    cases A3 with y A5,
    subst x2,
    apply A4,
  },
  {
    intros w A7,
    apply lower_not_upper_bound_of_has_sum;assumption,
  }
end

lemma tsum_eq_supr_of_summable {α:Type*} {f:α → ℝ} [decidable_eq α] {x:ℝ}:
  0 ≤ f →
  summable f →
  tsum f = ⨆ (s : finset α), s.sum f :=
begin
  intros A1 A2,
  have A3:=summable.has_sum A2,
  apply supr_of_has_sum A1 A3,
end

lemma tsum_in_upper_bounds_of_summable {α:Type*} {f:α → ℝ} [decidable_eq α]:
  0 ≤ f →
  summable f →
  (tsum f)∈ upper_bounds (set.range (λ s:finset α, s.sum f)) :=
begin
  intros A1 A2,
  have A3 := summable.has_sum A2,
  apply mem_upper_bounds_of_has_sum A1 A3,
end

lemma has_sum_of_bdd_above {α:Type*} {f:α → ℝ} [decidable_eq α] {x:ℝ}:
  0 ≤ f →
  bdd_above (set.range (λ s:finset α, s.sum f)) →
  (x = ⨆ (s : finset α), s.sum f) →
  has_sum f x  :=
begin
  intros A1 AX A2,
  unfold supr at A2,
  unfold has_sum,
  apply filter_tendsto_intro,
  intros S A3,
  have A4 := mem_nhds_elim_real A3,
  cases A4 with a A5,
  cases A5 with b A6,
  cases A6 with A7 A8,
  cases A8 with A9 A10,
  cases A10 with A11 A12,
  rw A2 at A11,
  have A13:(set.range (λ (s : finset α), s.sum f)).nonempty,
  {
    apply set_range_finset_nonempty,
  },
  have A14:= exists_lt_of_lt_cSup A13 A11,
  cases A14 with d A15,
  cases A15 with A16 A17,
  simp at A16,
  cases A16 with T A18,
  subst d,

  apply filter_at_top_intro3 T,
  intros V A19,
  apply A9,
  simp,
  split,
  {
    apply lt_of_lt_of_le A17,
    apply sum_monotone_of_nonneg A1 A19,
  },
  {
    have A20:V.sum f ≤ x,
    {
      rw A2,
      apply le_cSup,
      apply AX,
      simp,
    },
    apply lt_of_le_of_lt,
    apply A20,
    apply A12,
  }
end

lemma has_sum_of_supr2 {α:Type*} {f:α → ℝ} [decidable_eq α]:
  0 ≤ f →
  bdd_above (set.range (λ s:finset α, s.sum f)) →
  has_sum f (⨆ (s : finset α), s.sum f)  :=
begin
  intros A1 A2,
  apply has_sum_of_bdd_above A1 A2,
  refl,
end

lemma summable_of_bdd_above {α:Type*} {f:α → ℝ} [decidable_eq α]:
  0 ≤ f →
  bdd_above (set.range (λ s:finset α, s.sum f)) →
  summable f  :=
begin
  intros A1 A2,
  unfold summable,
  apply exists.intro (⨆ (s : finset α), s.sum f),
  apply has_sum_of_supr2 A1 A2,
end

lemma bdd_above_of_le_of_bdd_above {α:Type*}  [D:decidable_eq α] {f g:α → ℝ}:
  f ≤ g →
  bdd_above (set.range (λ (s : finset α), s.sum g)) →
  bdd_above (set.range (λ (s : finset α), s.sum f)) :=
begin
  intros A1 A2,
  rw bdd_above_def at A2,
  cases A2 with x A3,
  unfold upper_bounds at A3,
  simp at A3,
  rw bdd_above_def,
  apply exists.intro x,
  unfold upper_bounds,
  simp,
  intros S,
  have A7:S.sum f ≤ S.sum g,
  {
    apply finset_sum_le2,
    intros a A7A,
    apply A1,
  },
  apply le_trans A7,
  apply A3,
end

lemma has_sum_of_le_of_le_of_has_sum {α:Type*} {f g:α → ℝ} [D:decidable_eq α]:
  0 ≤ f →
  f ≤ g →
  summable g →
  summable f :=
begin
  intros A1 A2 A3,
  have A4:0 ≤ g,
  {
    apply le_trans A1 A2,
  },
  apply summable_of_bdd_above A1,

  cases A3 with x A5,
  --have A6 := supr_of_has_sum A4 A5,
  have A7 := bdd_above_of_has_sum A4 A5,
  --have A11 := A7,
  apply bdd_above_of_le_of_bdd_above A2 A7,
end

-- is_bdd

lemma le_func_def {α:Type*} {f g:α → ℝ}:(f ≤ g) ↔ (∀ n:α, f n ≤ g n) :=
begin
  refl,
end

lemma le_func_refl {α:Type*} {f:α → ℝ}:f ≤ f :=
begin
  rw le_func_def,
  intro n,
  refl,
end

lemma le_func_trans {α:Type*} {f g h:α → ℝ}:f ≤ g → g ≤ h → f ≤ h :=
begin
  rw le_func_def,
  rw le_func_def,
  rw le_func_def,
  intros A1 A2,
  intro n,
  apply le_trans (A1 n) (A2 n),
end

lemma nonpos_iff_neg_nonneg_func {α:Type*} {f:α → ℝ}:(f ≤ 0) ↔ (0 ≤ -f) :=
begin
  rw le_func_def,
  rw le_func_def,
  split;intros A1 n,
  {
    apply neg_nonneg_of_nonpos,
    apply A1,
  },
  {
    apply nonpos_of_neg_nonneg,
    apply A1,
  }
end

noncomputable def pos_only (x:ℝ):ℝ := if (0 ≤ x) then x else 0

noncomputable def neg_only (x:ℝ):ℝ := if (x ≤ 0) then x else 0

def restrict_real  (P:ℝ → Prop) (D:decidable_pred P) (x:ℝ):ℝ :=
   if (P x) then x else 0

lemma pos_only_add_neg_only_eq {α:Type*} {f:α → ℝ}:(pos_only ∘ f) + (neg_only ∘ f) = f :=
begin
  ext x,
  simp,
  unfold pos_only neg_only,
  have A1:0 <f x ∨ 0 =f x ∨ f x < 0 := lt_trichotomy 0 (f x),
  cases A1,
  {
    rw if_pos,
    rw if_neg,

    rw add_zero,
    apply not_le_of_lt A1,
    apply le_of_lt A1,
  },
  cases A1,
  {
    rw if_pos,
    rw if_pos,
    rw ← A1,
    rw zero_add,
    rw ← A1,
    rw ← A1,
  },
  {
    rw if_neg,
    rw if_pos,
    rw zero_add,
    apply le_of_lt A1,
    apply not_le_of_lt A1,
  }
end

lemma pos_only_sub_neg_only_eq_abs {α:Type*} {f:α → ℝ}:(pos_only ∘ f) - (neg_only ∘ f) = abs ∘ f :=
begin
  ext x,
  have A1:((pos_only ∘ f) - (neg_only ∘ f) ) x = ((pos_only (f x)) - (neg_only (f x))) := rfl,
  have A2:((abs ∘ f) x) = (abs (f x)) := rfl,
  rw A1,
  rw A2,
  unfold pos_only neg_only,

  have A3:0 <f x ∨ 0 =f x ∨ f x < 0 := lt_trichotomy 0 (f x),
  cases A3,
  {
    rw if_pos,
    rw if_neg,
    simp,
    rw abs_of_pos,
    apply A3,
    apply not_le_of_lt A3,
    apply le_of_lt A3,
  },
  cases A3,
  {
    rw if_pos,
    rw if_pos,
    rw ← A3,
    rw sub_zero,
    simp,
    rw ← A3,
    rw ← A3,
  },
  {
    rw if_neg,
    rw if_pos,
    simp,
    rw abs_of_neg,
    apply A3,
    apply le_of_lt A3,
    apply not_le_of_lt A3,
  }
end

lemma le_of_add_nonneg_le {α:Type*} {f g h:α → ℝ}:f + g ≤ h → 0 ≤ g → f ≤ h :=
begin
  rw le_func_def,
  rw le_func_def,
  rw le_func_def,
  intros A1 A2 n,
  have A3 := A1 n,
  have A4 := A2 n,
  simp at A3,
  have A5:f n + 0 ≤  f n + g n,
  {
    apply add_le_add_left A4,
  },
  rw add_zero at A5,
  apply le_trans,
  apply A5,
  apply A3,
end

lemma le_of_add_nonneg_eq {α:Type*} {f g h:α → ℝ}:f + g = h → 0 ≤ g → f ≤ h :=
begin
  intros A1 A2,
  have A3:f + g ≤ h,
  {
    rw A1,
    apply le_func_refl,
  },
  apply le_of_add_nonneg_le A3 A2,
end

lemma pos_only_nonneg {α:Type*} {f:α → ℝ}:0≤ (pos_only ∘ f) :=
begin
  rw le_func_def,
  intro n,
  simp,
  unfold pos_only,
  have A1:(0 ≤ f n) ∨ ¬(0 ≤ f n) := le_or_not_le,
  cases A1,
  {
    rw if_pos,
    apply A1,
    apply A1,
  },
  {
    rw if_neg,
    apply A1,
  }
end

lemma neg_neg_only_nonneg {α:Type*} {f:α → ℝ}:0≤ -(neg_only ∘ f) :=
begin
  rw le_func_def,
  intro n,
  simp,
  unfold neg_only,
  have A1:(f n ≤ 0) ∨ ¬(f n ≤ 0) := le_or_not_le,
  cases A1,
  {
    rw if_pos,
    apply A1,
    apply A1,
  },
  {
    rw if_neg,
    apply A1,
  }
end

lemma neg_only_nonpos {α:Type*} {f:α → ℝ}:(neg_only ∘ f) ≤ 0 :=
begin
  rw nonpos_iff_neg_nonneg_func,
  apply neg_neg_only_nonneg,
end

lemma pos_only_le_abs {α:Type*} {f:α → ℝ}: (pos_only ∘ f ≤ abs ∘ f) :=
begin
  have A1:=@pos_only_sub_neg_only_eq_abs α f,
  apply le_of_add_nonneg_eq A1,
  apply neg_neg_only_nonneg,
end

lemma neg_neg_only_le_abs {α:Type*} {f:α → ℝ}: (-neg_only ∘ f ≤ abs ∘ f) :=
begin
  have A1:=@pos_only_sub_neg_only_eq_abs α f,
  rw sub_eq_add_neg at A1,
  rw add_comm at A1,
  apply le_of_add_nonneg_eq A1,
  apply pos_only_nonneg,
end

lemma pos_only_neg_eq_neg_only {α:Type*} {f:α → ℝ}: (pos_only ∘ (-f)) = -(neg_only ∘ f) :=
begin
  ext x,
  simp,
  unfold pos_only neg_only,
  have A3:0 <f x ∨ 0 =f x ∨ f x < 0 := lt_trichotomy 0 (f x),
  cases A3,
  {
    rw if_neg,
    rw if_neg,
    {
      simp,
    },
    {
      intro A4,
      apply not_le_of_lt A3,
      apply A4,
    },
    {
      intro A4,
      apply not_le_of_lt A3,
      apply nonpos_of_neg_nonneg,
      apply A4,
    }
  },
  cases A3,
  {
    rw if_pos,
    rw if_pos,
    rw ← A3,
    simp,
    rw ← A3,
  },
  {
    rw if_pos,
    rw if_pos,
    apply le_of_lt A3,
    apply neg_nonneg_of_nonpos,
    apply le_of_lt A3,
  }
end

lemma neg_only_le {α:Type*} {f:α → ℝ}: (neg_only ∘ f ≤ f) :=
begin
  have A1:=@pos_only_add_neg_only_eq α f,
  --simp at A1,
  rw add_comm at A1,
  apply le_of_add_nonneg_eq A1,
  apply pos_only_nonneg,
end

/-
  Okay, so far I have:
  pos_only f ∧  neg_only f → f
  pos_only f ∧  neg_only f → abs f
  Now, with the new result, I get:
  abs f → pos_only f
  abs f → -neg_only f → neg_only f

  What remains is either:
  f → pos_only f
  f → neg_only f
  f → abs f

  The solution is that if summable f,
-/

lemma neg_neg_func {α:Type*} {f:α → ℝ}:-(-f)=f :=
begin
  simp,
end

lemma finset_sum_lower_bound {α:Type*} [decidable_eq α] {f:α → ℝ} {S:finset α}:
  S.sum (neg_only ∘ f) ≤ S.sum (f) :=
begin
  apply finset_sum_le2,
  intros s A1,
  apply neg_only_le,
end

lemma finset_sum_diff {α:Type*} [decidable_eq α] {f:α → ℝ} {S T:finset α}:
  T.sum f = (T ∪ S).sum f - (S \ T).sum f :=
begin
  have A1:T ∪ S = T ∪ (S\ T),
  {
    simp,
  },
  have A2:disjoint T (S \ T),
  {
    apply finset_disjoint_symm,
    apply finset.sdiff_disjoint,
  },
  have A3:(T ∪ S).sum f = T.sum f + (S \ T).sum f,
  {
    rw A1,
    symmetry,
    apply sum_disjoint_add,
    apply A2,
  },
  have A4:(T ∪ S).sum f - (S \ T).sum f= T.sum f + (S \ T).sum f - (S \ T).sum f,
  {
    rw A3,
  },
  symmetry,
  simp at A4,
  apply A4,
end

lemma finset_sum_neg_monotone_neg {α:Type*} [decidable_eq α] {f:α → ℝ} {S T:finset α}:
  f ≤ 0 →
  T ⊆ S →
  S.sum f ≤ T.sum (f) :=
begin
  intros A1 A2,
  apply le_of_neg_le_neg,
  rw ← finset_sum_neg,
  rw ← finset_sum_neg,
  apply sum_monotone_of_nonneg,
  {
    rw ← nonpos_iff_neg_nonneg_func,
    apply A1,
  },
  {
    apply A2,
  }
end

lemma finset_sum_diff_lower_bound {α:Type*} [decidable_eq α] {f:α → ℝ} {S T:finset α}:
  S.sum (neg_only ∘ f) ≤ (S \ T).sum (f) :=
begin
  have A1:S.sum (neg_only ∘ f) ≤ (S \ T).sum (neg_only ∘ f),
  {
    apply finset_sum_neg_monotone_neg,
    apply neg_only_nonpos,
    apply finset.sdiff_subset,
  },
  have A2:(S \ T).sum (neg_only ∘ f) ≤ (S \ T).sum f,
  {
    apply finset_sum_lower_bound,
  },
  apply le_trans A1 A2,

end

lemma bdd_above_of_summable_f {α:Type*} [decidable_eq α] {f:α → ℝ}:
  summable f → bdd_above  (set.range (λ (s : finset α), s.sum f)) :=
begin
  intro A1,
  unfold summable at A1,
  cases A1 with x A2,
  unfold has_sum at A2,
  have A5:(0:ℝ) < (1:ℝ) := zero_lt_one,
  have A6:set.Ioo (x - 1) (x + 1) ∈ nhds x := Ioo_nbhd A5,
  have A7:=filter_tendsto_elim A2 A6,
  simp at A7,
  cases A7 with S A8,
  let z:=x + 1 - (S.sum (neg_only ∘ f)),
  begin
    have B1:z=x + 1 - (S.sum (neg_only ∘ f)) := rfl,
    rw bdd_above_def,
    unfold upper_bounds,
    apply exists.intro z,
    simp,
    intros T,
    have B3:T.sum f = (T ∪ S).sum f - (S \ T).sum f := finset_sum_diff,
    rw B3,
    have B4:(T ∪ S).sum f - (S \ T).sum f ≤ (T ∪ S).sum f - S.sum (neg_only ∘ f),
    {
      apply sub_le_sub_left,
      apply finset_sum_diff_lower_bound,
    },
    apply le_trans B4 ,
    have B5:= (A8 (T ∪ S) (subset_union_right T S)).right,
    rw B1,
    simp,

    apply le_of_lt B5,
  end
end

lemma finset_sum_pos_only_eq_sum {α:Type*} [decidable_eq α] {f:α → ℝ} {S:finset α}:
  ∃ {T:finset α}, T⊆ S ∧ T.sum f = S.sum (pos_only ∘ f) :=
begin
  apply finset.induction_on S,
  {
    apply exists.intro ∅,
    split,
    {
      simp,
    },
    {
      simp,
      refl,
    }
  },
  {
    intros a V A1 A2,
    cases A2 with T A3,
    cases A3 with A4 A5,
    have A6: (0 ≤ f a) ∨ ¬ (0 ≤ f a) := le_or_not_le,
    cases A6,
    {
      apply exists.intro (insert a T),
      split,
      {
        rw finset.subset_iff,
        intros x A7,
        simp at A7,
        simp,
        cases A7,
        {
          left,
          apply A7,
        },
        {
          right,
          apply A4,
          apply A7,
        }
      },
      {
        rw sum_insert_add,
        rw sum_insert_add,
        rw ← A5,
        simp,
        unfold pos_only,
        rw if_pos,
        apply A6,
        {
          intro A8,
          apply A1,
          apply A8,
        },
        {
          intro A9,
          apply A1,
          rw finset.subset_iff at A4,
          apply A4,
          apply A9,
        }
      }
    },
    {
      apply exists.intro T,
      split,
      {
        rw finset.subset_iff,
        intros x A10,
        simp,
        right,
        apply A4,
        apply A10,
      },
      {
        rw sum_insert_add,
        rw ← A5,
        simp,
        have A11:pos_only (f a) = 0,
        {
          unfold pos_only,
          apply if_neg,
          apply A6,

        },
        rw A11,
        apply A1,
      }
    }
  }
end

lemma summable_pos_only_of_summable {α:Type*} [decidable_eq α] {f:α → ℝ}:
  summable f → summable (pos_only ∘ f) :=
begin
  intro A1,
  apply summable_of_bdd_above,
  apply pos_only_nonneg,
  have A2:=bdd_above_of_summable_f A1,
  rw bdd_above_def,
  unfold upper_bounds,
  rw bdd_above_def at A2,
  unfold upper_bounds at A2,
  cases A2 with x A3,
  apply exists.intro x,
  simp,
  intros S,
  have A5 := @finset_sum_pos_only_eq_sum α _ f S,
  cases A5 with T A6,
  cases A6 with A7 A8,
  rw ← A8,
  simp at A3,
  apply A3,
end

lemma summable_neg_only_of_summable {α:Type*} [decidable_eq α] {f:α → ℝ}:
  summable f → summable (neg_only ∘ f) :=
begin
  intro A1,
  have A2:-(-(neg_only ∘ f)) = neg_only ∘ f := neg_neg_func,
  rw ← A2,
  apply summable.neg,
  rw ← pos_only_neg_eq_neg_only,
  apply summable_pos_only_of_summable,
  apply summable.neg,
  apply A1,
end

lemma summable_iff_pos_only_summable_neg_only_summable {α:Type*} [decidable_eq α] {f:α → ℝ}:
  summable f ↔ (summable (pos_only ∘ f) ∧ summable (neg_only ∘ f))  :=
begin
  split;intro A1,
  {
    split,
    apply summable_pos_only_of_summable A1,
    apply summable_neg_only_of_summable A1,
  },
  {
    rw ← @pos_only_add_neg_only_eq α f,
    apply summable.add,
    apply A1.left,
    apply A1.right,
  }
end

lemma summable_iff_abs_summable {α:Type*} [decidable_eq α] {f:α → ℝ}:
    summable f ↔ summable (abs ∘ f) :=
begin
  apply iff.trans,
  apply summable_iff_pos_only_summable_neg_only_summable,
  split;intro A1,
  {
    rw ← pos_only_sub_neg_only_eq_abs,
    apply summable.sub,
    apply A1.left,
    apply A1.right,
  },
  {
    split,
    {
      apply has_sum_of_le_of_le_of_has_sum,
      {
        apply pos_only_nonneg,
      },
      {
        apply pos_only_le_abs,
      },
      {
        apply A1,
      }
    },
    {
      have A2:(-(-neg_only ∘ f))=neg_only ∘ f := neg_neg_func,
      rw ← A2,
      apply summable.neg,
      apply has_sum_of_le_of_le_of_has_sum,
      {
        apply neg_neg_only_nonneg,
      },
      {
        apply neg_neg_only_le_abs,
      },
      {
        apply A1,
      }
    }
  }
end

lemma summable_intro {α β:Type*} [add_comm_monoid β] [topological_space β] {f:α → β} {x:β}:
  has_sum f x → summable f :=
begin
  intro A1,
  unfold summable,
  apply exists.intro x,
  apply A1,
end

lemma has_sum_nnreal_bounds {α:Type*} {f:α → nnreal} [D:decidable_eq α] {x:nnreal}:(x≠ 0) → (has_sum f x) → (∀ S:finset α, S.sum f ≤ x) :=
begin
  intros A1 A2,
  intro S,
  unfold has_sum at A2,
  apply le_of_not_lt,
  intro A3,
  let r := (finset.sum S f) - x,
  --let B := {C:finset α|S ≤ C},
  begin
    have A5:set.Iio (finset.sum S f) ∈ nhds x,
    {
      apply set_Iio_in_nhds_of_lt A1 A3,
    },
    --have A4:set.Ioo (x - r) (x + r) ∈ filter.at_top,
    --unfold filter.tendsto at A2,
    --unfold filter.map at A2,
    --apply filter_at_top_intro,
    have A6:= filter_tendsto_elim A2 A5,
    have A7 := filter_at_top_elim  A6,
    cases A7 with B A7,
    rw set.subset_def at A7,
    have A8:(B∪ S) ∈ {b : finset α | B ≤ b},
    {
      simp,
      apply finset.subset_union_left,
    },
    have A9 := A7 (B ∪ S) A8,
    simp at A9,
    have A10 := not_le_of_lt A9,
    apply A10,
    apply sum_monotone_of_nnreal,
    simp,
    apply finset.subset_union_right,
  end
end

lemma has_sum_nnreal_ne_zero {α:Type*} {f:α → nnreal} [decidable_eq α] {x:nnreal}:(x≠ 0) →
  ((∀ ε>0, ∃ S:finset α,
   ∀ T⊇S,  (T.sum f ≤ x) ∧  x - ε < T.sum f  )↔
  (has_sum f x)) :=
begin
  intro AX,
  split;intro A1,
  {
    unfold has_sum,
    apply filter_tendsto_intro,
    intros b A2,
    have A3:= mem_nhds_elim_nnreal_bound b x AX A2,
    cases A3 with ε A4,
    cases A4 with A5 A6,
    have A7 := A1 ε A5,
    cases A7 with S A8,
    apply filter_at_top_intro3 S,
    intros T A9,
    have A10 := A8 T A9,
    apply A6,
    simp,
    split,
    {
      apply A10.right,
    },
    {
     apply lt_of_le_of_lt,
     apply A10.left,
     apply lt_add_of_pos_right,
     apply A5,
    },
  },
  {
    intros ε A2,
    have A10 := has_sum_nnreal_bounds AX A1,
    unfold has_sum at A1,
    have A3:set.Ioo (x - ε) (x + ε) ∈ nhds x,
    {
      apply set_Ioo_in_nhds_of_ne_zero AX A2,
    },
    have A4 := filter_tendsto_elim A1 A3,
    have A5 := mem_filter_at_top_elim A4,
    cases A5 with S A6,
    apply exists.intro S,
    intros T A7,
    rw set.subset_def at A6,
    have A8 := A6 T A7,
    have A9:T.sum f ∈ set.Ioo (x - ε) (x + ε) := A8,
    split,
    {
      apply A10 T,
    },
    {
      simp at A9,
      apply A9.left,
    },
  }
end

/-

lemma summable_bounded_nnreal {β:Type*} (f:β → nnreal):
 (∀ S:finset β,  S.sum f = 0) →
 has_sum f 0 :=
begin
  apply has_sum_zero,
end -/

lemma nnreal.minus_half_eq_half {ε:nnreal}:ε - ε/2 = ε/2 :=
begin
  have A1:(ε/2 + ε/2) - ε/2 = ε - ε/2,
  {
    rw nnreal.add_halves,
  },
  rw ← A1,
  rw nnreal.add_sub_cancel,
end

lemma all_finset_sum_eq_zero_iff_eq_zero {β:Type*} [D:decidable_eq β] (f:β → nnreal):
 (∀ S:finset β,  S.sum f = 0) ↔ f = 0 :=
begin
  split;intros A1,
  {
    ext b,
    have A2 := A1 {b},
    simp at A2,
    rw A2,
    simp,
  },
  {
    intros S,
    apply finite_sum_zero_eq_zero,
    intros b A2,
    rw A1,
    simp,
  },
end

lemma has_sum_of_bounded_nnreal {β:Type*} [D:decidable_eq β] (f:β → nnreal) (v:nnreal):
 (∀ S:finset β,  S.sum f ≤ v) →
 (∀ ε>0, ∃ S:finset β,  v - ε ≤ S.sum f)  →
 has_sum f v :=
begin
  intros A1 A2,
  have A3:v = 0 ∨ v ≠ 0 := @eq_or_ne nnreal _ v 0,
  cases A3,
  {
    subst v,
    have A4:f = 0,
    {
      rw ← all_finset_sum_eq_zero_iff_eq_zero,
      intro S,
      apply le_bot_iff.mp,
      apply A1 S,
    },
    subst f,
    apply has_sum_zero,
  },
  {
    have A10:0 < v,
    {
      apply bot_lt_iff_ne_bot.mpr A3,
    },
    rw ←  has_sum_nnreal_ne_zero A3,
    intros ε A4,
    let k:nnreal := (min ε v)/2,
    begin
      have A8:k = ((min ε v)/2) := rfl,
      have A11:0 < min ε v,
      {
        rw lt_min_iff,
        split,
        apply A4,
        apply A10,
      },
      have A7:0 < k,
      {
        rw A8,
        apply nnreal.half_pos,
        apply A11,
      },
      have A12:k < min ε v,
      {
        apply nnreal.half_lt_self,
        apply bot_lt_iff_ne_bot.mp A11,
      },
      have A6 := A2 k A7,
      cases A6 with S A6,
      apply exists.intro S,
      intro T,
      intro A5,
      split,
      {
        apply A1,
      },
      {
        apply lt_of_lt_of_le,
        have A9:v - ε < v - k,
        {
          apply nnreal_sub_lt_sub_of_lt,
          {
            apply lt_of_lt_of_le,
            apply A12,
            apply min_le_left,
          },
          {
            apply lt_of_lt_of_le,
            apply A12,
            apply min_le_right,
          },
        },
        apply A9,
        apply le_trans,
        apply A6,
        apply sum_monotone_of_nnreal,
        --simp,
        apply A5,
      },
    end,
    apply D,
  },
end

lemma nnreal.le_Sup {S:set nnreal}:(∃ (x : nnreal), ∀ (y : nnreal), y ∈ S → y ≤ x) →
   ∀ {x : nnreal}, x ∈ S → x ≤ Sup S :=
begin
  intro A1,
  intros x A2,
  rw ← nnreal.coe_le_coe,
  rw nnreal.coe_Sup,
  apply real.le_Sup,
  cases A1 with z A1,
  apply exists.intro (coe z),
  intros y A3,
  cases A3 with y2 A3,
  cases A3 with A3 A4,
  subst y,
  rw nnreal.coe_le_coe,
  apply A1 y2 A3,
  simp,
  apply A2,
end

lemma nnreal.le_Sup_of_bdd_above {S:set nnreal}:
  bdd_above S →
  (∀ x∈ S, (x ≤ Sup S)) :=
begin
  intros A1 y A2,
  apply nnreal.le_Sup,
  rw bdd_above_def at A1,
  unfold set.nonempty upper_bounds at A1,
  cases A1 with x A1,
  apply exists.intro x,
  apply A1,
  apply A2,
end

lemma nnreal.le_supr_of_bdd_above {α:Type*} {f:α → nnreal}:
  bdd_above (set.range f) →
  (∀ x:α, (f x ≤ ⨆ (s : α), f s)) :=
begin
  intro A1,
  unfold supr,
  intro a,
  simp,
  apply nnreal.le_Sup_of_bdd_above A1,
  simp,
end

lemma nnreal.x_eq_zero_of_supr_finset_sum_eq_zero {S:set nnreal}:
   (bdd_above S) →
   (Sup S = 0) →
   (∀ x:nnreal, x∈ S → x = 0):=
begin
  intros A1 A2 x A3,
  have A4:x≤ 0,
  {
    rw ← A2,
    apply nnreal.le_Sup_of_bdd_above,
    apply A1,
    apply A3,
  },
  apply le_bot_iff.mp A4,
end

lemma zero_of_supr_finset_sum_eq_zero {α:Type*} [D:decidable_eq α] {f:α → nnreal}:
  (bdd_above (set.range (λ s:finset α, s.sum f))) →
 ((⨆ (s :finset α), finset.sum s f) = 0) →
 (f = 0) :=
begin
  intros A1 A2,
  have A3:(∀ (s :finset α), finset.sum s f= 0),
  {
    intros S,
    --apply le_bot_iff.mp,
    apply nnreal.x_eq_zero_of_supr_finset_sum_eq_zero A1,
    unfold supr at A2,
    apply A2,
    simp,
  },
  rw @all_finset_sum_eq_zero_iff_eq_zero α D f at A3,
  apply A3
end

noncomputable def nnreal.conditionally_complete_lattice:conditionally_complete_lattice nnreal :=
  infer_instance

noncomputable instance nnreal.conditionally_complete_linear_order:conditionally_complete_linear_order nnreal := {
  .. nnreal.conditionally_complete_lattice,
  .. nnreal.linear_order
}

lemma nnreal.has_sum_of_bdd_above {α:Type*} {f:α → nnreal} [decidable_eq α] {x:nnreal}:
  bdd_above (set.range (λ s:finset α, s.sum f)) →
  (x = ⨆ (s : finset α), s.sum f) →
  has_sum f x  :=
begin
  intros AX A2,
  apply has_sum_of_bounded_nnreal,
  {
    intro S,
    rw A2,
    apply @nnreal.le_supr_of_bdd_above (finset α) (λ s:finset α, s.sum f) AX,
  },
  {
    have A3:(x = 0) ∨ (x ≠ 0) := eq_or_ne,
    cases A3,
    {
      subst x,
      intro ε,
      intro A4,
      apply exists.intro ∅,
      rw A3,
      have A4:0 - ε ≤ 0,
      {
        apply nnreal.sub_le_self,
      },
      apply le_trans A4,
      apply bot_le,
      have A3A:f = 0,
      {
        apply zero_of_supr_finset_sum_eq_zero,
        apply AX,
        apply A3,
      },
      apply finset.has_emptyc,
    },
    {
      intros ε A1,
      have A4:x - ε < x,
      {
        apply nnreal.sub_lt_self,
        apply bot_lt_iff_ne_bot.mpr,
        apply A3,
        apply A1,
      },
      --apply nnreal.
      let T := (set.range (λ (s : finset α), finset.sum s f)),
      begin
        have A5:T = (set.range (λ (s : finset α), finset.sum s f)) := rfl,
        have A6:Sup T = x,
        {
          rw A2,
          refl,
        },
        have A7:∃b∈ T, x-ε< b,
        {
          apply @exists_lt_of_lt_cSup nnreal _ T,
          rw A5,
          apply @set_range_finset_nonempty α nnreal _ f,
          rw A6,
          apply A4,
        },
        cases A7 with b A7,
        cases A7 with A7 A8,
        rw A5 at A7,
        simp at A7,
        cases A7 with S A7,
        subst b,
        apply exists.intro S,
        apply le_of_lt A8,
      end
    },
  },
end

lemma nnreal.has_sum_of_supr {α:Type*} {f:α → nnreal} [decidable_eq α]:
  bdd_above (set.range (λ s:finset α, s.sum f)) →
  has_sum f (⨆ (s : finset α), s.sum f)  :=
begin
  intros A1 A2,
  have A3:(⨆ (s : finset α), s.sum f) = (⨆ (s : finset α), s.sum f),
  {
    refl,
  },
  apply nnreal.has_sum_of_bdd_above A1 A3,
end

lemma summable_bounded_nnreal {β:Type*} [decidable_eq β] (f:β → nnreal) (v:nnreal):
 (∀ S:finset β,  S.sum f ≤ v) →
 summable f :=
begin
  intro A1,
  apply has_sum.summable,
  apply nnreal.has_sum_of_supr,
    rw bdd_above_def,
    unfold upper_bounds,
    apply @set.nonempty_of_mem _ _ v,
    simp,
    apply A1,
end

lemma choose_sum_succ {d m : ℕ}:
      (finset.range d).sum (λ (i : ℕ), m.choose i.succ) + 1 =
    (finset.range d.succ).sum (λ (i : ℕ), m.choose (i)) :=
begin
  rw finset.sum_range_succ', simp,
end

lemma choose_sum_pred {d m : ℕ}:
      (finset.range d).sum (λ (i : ℕ), m.choose i) =
    (finset.range d.succ).sum (λ (i : ℕ), if (i = 0) then 0 else (m.choose i.pred)) :=
begin
  rw finset.sum_range_succ', simp,
end

lemma finset.sum_add {α β: Type*} [decidable_eq β] {S:finset β} [add_comm_monoid α] (f g:β → α):
S.sum f + S.sum g = S.sum (f + g) :=
begin
  apply finset.induction_on S,
  { simp },
  intros a s h1 h2,
  repeat {rw finset.sum_insert h1},
  rw ← h2,  simp, rw add_assoc, rw ← add_assoc (s.sum f),
  rw add_comm (s.sum f),
  rw add_assoc (g a),
  rw ← add_assoc,
end

lemma choose_succ {d m : ℕ} :m.choose d.succ + m.choose d = m.succ.choose d.succ :=
begin
  simp [nat.choose],
  ring,
end

lemma choose_sum_rec {d m : ℕ}:
(finset.range d.succ).sum (λ (i : ℕ), m.choose i) +
      (finset.range d).sum (λ (i : ℕ), m.choose i) =
    (finset.range d.succ).sum (λ (i : ℕ), m.succ.choose i) :=
begin
  rw @choose_sum_pred d,
  simp,
  rw finset.sum_add,
  apply finset.sum_congr,
  refl,
  intros x h1,
  simp at h1,
  cases x,
  { simp },
  { simp, rw if_neg, rw choose_succ, apply nat.succ_ne_zero },
end

lemma finset.sum_distrib_left {α:Type*} {β:Type*} [comm_semiring β] {f:β} {g:α → β}
    {S:finset α}:S.sum (λ a:α, f * (g a))=f * (S.sum g) :=
begin
  have A1:(λ a:α, f * (g a)) = (λ a:α, (add_monoid_hom.mul_left f).to_fun (g a)),
  {
    unfold add_monoid_hom.mul_left,
  },
  rw A1,
  have A2:f * (S.sum g) = (add_monoid_hom.mul_left f).to_fun (S.sum g),
  {
    unfold add_monoid_hom.mul_left,
  },
  rw A2,
  symmetry,
  apply @add_monoid_hom.map_sum α β β _ _ (add_monoid_hom.mul_left f) g S,
end


-- `pos_num` -- the British Natural Numbers.
-- The same as pnat

/- todo --
  make nicer recursor to get less `one` and more `1`.
  le world
  add docstrings
  add questions (these are solutions)
-/
import tactic

namespace xena

-- should be elsewhere
-- pnat inductive principle
@[elab_as_eliminator] def pnat'.induction {C : ℕ → Prop} {n : ℕ} (hn : n ≠ 0) (h1 : C 1)
  (IH : ∀ d, C d → C (d + 1)) : C n :=
begin
  cases n, cases hn rfl, clear hn,
  induction n with d hd, assumption,
  apply IH,
  assumption,
end

/-- The type of positive binary numbers.

     13 = 1101(base 2) = bit1 (bit0 (bit1 one)) -/
@[derive has_reflect, derive decidable_eq]
inductive pos_num : Type
| one  : pos_num
| bit1 : pos_num → pos_num
| bit0 : pos_num → pos_num

notation `ℙ` := pos_num

namespace pos_num

-- there is no interface relating one, bit0 and bit1.

-- notation for 1
instance : has_one ℙ := ⟨pos_num.one⟩

-- the default natural
def thirty_seven := bit1 (bit0 (bit1 (bit0 (bit0 (one)))))

-- the naturals are nonempty
instance : inhabited ℙ := ⟨thirty_seven⟩

-- this interface for rec is just to make stuff work under the hood.
/-
using 'exit' to interrupt Lean
-/

--#check @pos_num.rec
-- if you are interested.
@[simp] lemma rec_one (C : ℙ → Type) (x : C 1) (h1 : Π (a : ℙ), C a → C (bit1 a))
 (h0 : Π (a : ℙ), C a → C (bit0 a)) : (pos_num.rec x h1 h0 1  : C 1) = x := rfl

@[simp] lemma rec_one' (C : ℙ → Type) (x : C 1) (h1 : Π (a : ℙ), C a → C (bit1 a))
 (h0 : Π (a : ℙ), C a → C (bit0 a)) : (pos_num.rec x h1 h0 one  : C one) = x := rfl

@[simp] lemma rec_bit0 (C : ℙ → Type) (x : C 1) (h1 : Π (a : ℙ), C a → C (bit1 a))
   (h0 : Π (a : ℙ), C a → C (bit0 a)) (p : ℙ) :
   (pos_num.rec x h1 h0 (bit0 p)  : C (bit0 p)) = h0 p (pos_num.rec x h1 h0 p) := rfl

@[simp] lemma rec_bit1 (C : ℙ → Type) (x : C 1) (h1 : Π (a : ℙ), C a → C (bit1 a))
   (h0 : Π (a : ℙ), C a → C (bit0 a)) (p : ℙ) :
   (pos_num.rec x h1 h0 (bit1 p)  : C (bit1 p)) = h1 p (pos_num.rec x h1 h0 p) := rfl

/-! # Succ -/

-- we define `succ` and its interface with the three constructors.

def succ : ℙ → ℙ
| 1        := bit0 one
| (bit1 n) := bit0 (succ n)
| (bit0 n) := bit1 n

@[simp] lemma succ_one : succ 1 = bit0 1 := rfl
@[simp] lemma succ_bit1 (n : ℙ) : succ (bit1 n) = bit0 (succ n) := rfl
@[simp] lemma succ_bit0 (n : ℙ) : succ (bit0 n) = bit1 n := rfl

/-! # Addition -/

-- computer scientists want this definition
/-- addition on ℙ -/
protected def add : ℙ → ℙ → ℙ
| 1        b        := succ b
| a        1        := succ a
| (bit0 a) (bit0 b) := bit0 (add a b)
| (bit1 a) (bit1 b) := bit0 (succ (add a b))
| (bit0 a) (bit1 b) := bit1 (add a b)
| (bit1 a) (bit0 b) := bit1 (add a b)

-- I don't need succ, I want + to be the primitive object
-- because it has more symmetries
-- My proposed definition of addition is below
/--
latexdef $ (+) : \P^2 \to \P $
| 1        1        := bit0 1
| 1        (bit0 b) := bit1 b
| 1        (bit1 b) := bit0 (1 + b)
| (bit0 a) 1        := bit1 a
| (bit0 a) (bit0 b) := bit0 (a + b)
| (bit0 a) (bit1 b) := bit1 (a + b)
| (bit1 a) 1        := bit1 (a + 1)
| (bit1 a) (bit0 b) := bit1 (a + b)
-- Now for the last one.
-- when I do the carry one, in exactly
-- what order do I add the carry 1 to the
-- two digits in the next column?
-- This way is is "add like normal, but then don't forget to add on
-- the carry one after"
| (bit1 a) (bit1 b) := bit0 ((a + b) + 1)
-/
instance : has_add ℙ := ⟨pos_num.add⟩

-- I will make the mathematician's recursor in a minute.
-- First let's do some easier stuff relating succ and addition.

-- addition and succ

@[simp] lemma add_one_eq_succ (a : ℙ) : a + 1 = succ a :=
begin
  cases a; refl
end

@[simp] lemma add_one_eq_succ' (a : ℙ) : a + one = succ a :=
add_one_eq_succ a

@[simp] lemma one_add_eq_succ (a : ℙ) : 1 + a = succ a :=
begin
  cases a; refl
end

@[simp] lemma one_add_eq_succ' (a : ℙ) : one + a = succ a :=
one_add_eq_succ a

/-! # Mathematician's interface to addition -/

@[simp] lemma one_add_one : 1 + 1 = bit0 1 := rfl
@[simp] lemma one_add_bit0 (p : ℙ) :
  1 + bit0 p = bit1 p := rfl
@[simp] lemma one_add_bit0' (p : ℙ) :
  one + bit0 p = bit1 p := rfl
@[simp] lemma one_add_bit1 (p : ℙ) :
  (1 : ℙ) + (bit1 p) = bit0 (1 + p) :=
  begin
    change succ (bit1 p) = _,
    unfold succ,
    congr,
    simp,
  end

@[simp] lemma one_add_bit1' (p : ℙ) :
  one + bit1 p = bit0 (1 + p) := one_add_bit1 p

@[simp] lemma bit0_add_one (a : ℙ) : (bit0 a) + 1 = bit1 a := rfl
@[simp] lemma bit0_add_one' (a : ℙ) : (bit0 a) + one = bit1 a := rfl
@[simp] lemma bit1_add_one (a : ℙ) : (bit1 a) + 1 = bit0 (a + 1) :=
begin
  show succ (bit1 a) = _,
  unfold succ,
  simp,
end
@[simp] lemma bit1_add_one' (a : ℙ) : (bit1 a) + one = bit0 (a + one) :=
bit1_add_one a

@[simp] lemma bit0_add_bit0 (a b : ℙ) :
  (bit0 a) + (bit0 b) = bit0 (a + b) := rfl
@[simp] lemma bit1_add_bit1 (a b : ℙ) :
  (bit1 a) + (bit1 b) = bit0 ((a + b) + 1) :=
begin
--  show (bit1 a) + (bit1 b) = bit0 ((a + b) + 1) :=
  show bit0 (succ (a + b)) = _,
  simp
end

@[simp] lemma bit0_add_bit1 (a b : ℙ) :
 (bit0 a) + (bit1 b) = bit1 (a + b) := rfl
@[simp] lemma bit1_add_bit0 (a b : ℙ) :
  (bit1 a) + (bit0 b) = bit1 (a + b) := rfl

/-! #  some more bit0 and bit1 things -/

lemma bit0_eq_add_self (p : ℙ) : bit0 p = p + p :=
begin
  induction p with p hp p hp,
  { refl },
  { rw bit1_add_bit1,
    congr',
    rw ←hp,
    rw bit0_add_one
  },
  { rw bit0_add_bit0,
    congr' }
end

lemma bit1_eq_add_self_add_one (p : ℙ) : bit1 p = p + p + 1 :=
begin
  rw ←succ_bit0,
  rw bit0_eq_add_self,
  simp,
end

lemma bit1_eq_succ_add_self (p : ℙ) : bit1 p = succ (p + p) :=
begin
  simp [bit1_eq_add_self_add_one]
end

/-! # Even and odd -/

-- This just works but it's kind of useless.

/-! # Even and odd -- it all works -/
inductive even : ℙ → Prop
| even_bit0 (n : ℙ) : even (bit0 n)

inductive odd : ℙ → Prop
| odd_one : odd 1
| odd_bit1 (n : ℙ) : odd (bit1 n)

def odd_one := odd.odd_one -- put it in the root namespace
def even_bit0 := even.even_bit0
def odd_bit1 := odd.odd_bit1

lemma even_or_odd (a : ℙ) : even a ∨ odd a :=
begin
  cases a,
  right, apply odd_one,
  right, apply odd_bit1,
  left, apply even_bit0
end

lemma not_even_and_odd (a : ℙ) : ¬ (even a ∧ odd a) :=
begin
  induction a,
  { rintro ⟨⟨⟩,_⟩},
  { rintro ⟨⟨⟩,_⟩},
  /-
protected eliminator xena.pos_num.rec : Π {C : ℙ → Sort l},
  C one → (Π (a : ℙ), C a → C (bit1 a)) → (Π (a : ℙ), C a → C (bit0 a)) → Π (n : ℙ), C n
-/

  { rintro ⟨_,⟨⟩⟩ },
end

lemma odd_add_odd (a b : ℙ) (ha : odd a) (hb : odd b) : even (a + b) :=
begin
  cases ha; cases hb; apply even_bit0,
end

lemma odd_add_even (a b : ℙ) (ha : odd a) (hb : even b) : odd (a + b) :=
begin
  cases ha; cases hb; apply odd_bit1,
end

lemma even_add_odd (a b : ℙ) (ha : even a) (hb : odd b) : odd (a + b) :=
begin
  cases ha; cases hb; apply odd_bit1,
end

lemma even_add_even (a b : ℙ) (ha : even a) (hb : even b) : even (a + b) :=
begin
  cases ha; cases hb; apply even_bit0,
end

-- end of odd/even nonsense; now back to associativity and commutativity

lemma add_one_add_one (a : ℙ) : a + (1 + 1) = a + 1 + 1 :=
begin
  induction a; simp; refl,
end

-- finally add_succ
@[simp] lemma add_succ (a b : ℙ) : a + succ b = succ (a + b) :=
begin
  induction b with b hb b hb generalizing a,
  { show a + (1 + 1) = succ (a + 1),
    simp,
    convert add_one_add_one a,
    simp,
  },
  { induction a with a ha a ha,
    { simp },
    { simp, --rw succ_eq_add_one,
      rw hb a },
    { simp [hb a] } },
  { induction a with a ha a ha; simp },
end

lemma add_comm (a b : ℙ) : a + b = b + a :=
begin
  induction b with b hb b hb generalizing a,
  { simp },
  { cases a with a a,
    { rw one_add_bit1',
      rw bit1_add_one',
      rw hb 1,
      refl },
    { rw [bit1_add_bit1, bit1_add_bit1, hb] },
    { rw [bit0_add_bit1, bit1_add_bit0, hb] } },
  { cases a with a a,
    { rw [one_add_bit0', bit0_add_one'] },
    { rw [bit1_add_bit0, bit0_add_bit1, hb] },
    { rw [bit0_add_bit0, bit0_add_bit0, hb] }
  }
end

@[simp] lemma succ_add (a b : ℙ) : (succ a) + b = succ (a + b) :=
begin
  rw add_comm,
  rw add_succ,
  rw add_comm,
end

lemma add_assoc (a b c : ℙ) : a + (b + c) = a + b + c :=
begin
  induction c with c hc c hc generalizing a b,
  { simp [add_succ] },
  { cases b with b b,
    { rw [add_one_eq_succ', one_add_eq_succ', add_succ, succ_add] },
    { cases a with a a,
      { simp },
      { simp, rw ←hc },
      { simp [hc] } },
    { cases a with a a; simp [hc] } },
  { cases b with b b,
    { simp, rw [←succ_bit0, add_succ] },
    { cases a with a a; simp [hc] },
    { cases a; simp [hc]  } }
end

lemma add_assoc' (a b c : ℙ) : a + b + c = a + (b + c) :=
by rw add_assoc a b c

/-! # Equiv.to_fun and inv_fun -/

-- data

/-- the "identity" inclusion sending n to n -/
def equiv.to_fun_aux : ℙ → ℕ :=
pos_num.rec 1 (λ b (n : ℕ), _root_.bit1 n) (λ b n, _root_.bit0 n)

-- recursor for the funtion
@[simp] lemma equiv.to_fun_one : equiv.to_fun_aux 1 = 1 := rfl
@[simp] lemma equiv.to_fun_one' : equiv.to_fun_aux one = 1 := rfl

@[simp] lemma equiv.to_fun_two : equiv.to_fun_aux (bit0 1) = 2 := rfl

@[simp] lemma equiv.to_fun_bit0 (a : ℙ) : equiv.to_fun_aux (bit0 a) =
  _root_.bit0 (equiv.to_fun_aux a) :=
begin
  refl
end

@[simp] lemma equiv.to_fun_bit1 (a : ℙ) : equiv.to_fun_aux (bit1 a) =
  _root_.bit1 (equiv.to_fun_aux a) :=
begin
  refl
end

lemma equiv.to_fun_ne_zero (p : ℙ) : equiv.to_fun_aux p ≠ 0 :=
begin
  induction p;
  simp [*, _root_.bit0],
  rintro ⟨⟩,
end

lemma equiv.to_fun_succ (p : ℙ) :
  equiv.to_fun_aux (succ p) = nat.succ (equiv.to_fun_aux p) :=
begin
  induction p with p hp p hp,
  { refl },
  {simp [hp], generalize h : equiv.to_fun_aux p = n, show (n + 1) + (n + 1) = (n + n + 1) + 1, ring },
  { refl }
end

-- note: returns a junk value at 0
def equiv.inv_fun_aux : ℕ → ℙ
| 0 := thirty_seven -- unreachable code has been reached
| 1 := 1
| (n + 2) := succ (equiv.inv_fun_aux (n + 1))

--#print prefix equiv.inv_fun

@[simp] lemma equiv.inv_fun_one : equiv.inv_fun_aux 1 = 1 := rfl
@[simp] lemma equiv.inv_fun_succ_succ (n : ℕ) :
  equiv.inv_fun_aux (n + 2) =
    succ (equiv.inv_fun_aux (n + 1)) :=
begin
  refl
end

@[simp] lemma equiv.inv_fun_succ {n : ℕ} (hn : n ≠ 0) :
  equiv.inv_fun_aux (nat.succ n) =
    succ (equiv.inv_fun_aux n) :=
begin
  cases n, cases hn rfl, clear hn,
  refl
end

-- pnat inductive principle
@[elab_as_eliminator] def pnat'.induction {C : ℕ → Prop} {n : ℕ} (hn : n ≠ 0) (h1 : C 1)
  (IH : ∀ d, C d → C (d + 1)) : C n :=
begin
  cases n, cases hn rfl, clear hn,
  induction n with d hd, assumption,
  apply IH,
  assumption,
end

/-! ## relation between equiv and addition -/
@[simp] lemma equiv.inv_fun_add {a b : ℕ} (ha : a ≠ 0) (hb : b ≠ 0) :
  equiv.inv_fun_aux (a + b) = equiv.inv_fun_aux a + equiv.inv_fun_aux b :=
begin
  cases a, cases ha rfl, cases b, cases hb rfl, clear ha, clear hb,
  induction b with d hd generalizing a,
  { rw equiv.inv_fun_succ_succ,
    rw ←add_one_eq_succ,
    congr' },
  { rw (show (nat.succ a + nat.succ (nat.succ d) =
  (nat.succ (a + d) + 2)), by omega),
  rw equiv.inv_fun_succ_succ,
  rw (show nat.succ (a + d) + 1 = nat.succ a + nat.succ d, by omega),
  rw hd,
  simp }
end

@[simp] lemma equiv.inv_fun_bit0 {a : ℕ} (ha : a ≠ 0) :
  equiv.inv_fun_aux (_root_.bit0 a) = bit0 (equiv.inv_fun_aux a) :=
begin
  simp [bit0_eq_add_self, (show _root_.bit0 a = a + a, from rfl),
    equiv.inv_fun_add ha ha]
end

@[simp] lemma equiv.inv_fun_bit1 {a : ℕ} (ha : a ≠ 0) :
  equiv.inv_fun_aux (_root_.bit1 a) = bit1 (equiv.inv_fun_aux a) :=
begin
  rw [←succ_bit0, nat.bit1_eq_succ_bit0, equiv.inv_fun_succ],
  congr',
  rw equiv.inv_fun_bit0 ha, intro h, apply ha, exact nat.bit0_inj h,
end

-- equiv.inv_fun_aux : ℕ → pos_num is the identity on positive n.
-- it's defined by recursion

section equiv

/-! # Equiv -/

def same : ℙ ≃ {n : ℕ // n ≠ 0} :=
{ to_fun := λ p, ⟨equiv.to_fun_aux p, equiv.to_fun_ne_zero p⟩,
  inv_fun := λ n, equiv.inv_fun_aux n.1,
  left_inv := begin
    intro p,
    induction p with p h p h,
    { refl },
    { simp at *, rw [equiv.inv_fun_bit1, h], apply equiv.to_fun_ne_zero },
    { simp * at *, rw [equiv.inv_fun_bit0, h], apply equiv.to_fun_ne_zero },
  end,
  right_inv := begin
    intro n,
    cases n with n hn,
    simp,
    apply pnat'.induction hn, refl,
    intros d hd,
    rw [←nat.succ_eq_add_one],
    cases d, refl,
    rw equiv.inv_fun_succ_succ,
    rw equiv.to_fun_succ,
    rw hd
  end }

lemma bij1 (p : ℙ) : equiv.inv_fun_aux (equiv.to_fun_aux p) = p :=
same.left_inv p

lemma bij2 (n : ℕ) (hn : n ≠ 0) : equiv.to_fun_aux (equiv.inv_fun_aux n) = n :=
begin
  have : same (same.symm ⟨n, hn⟩) = ⟨n, hn⟩,
    convert same.right_inv _,
    apply_fun subtype.val at this,
    rw ← this,
    congr'
end
--same.right_inv ⟨n, hn⟩

--lemma equiv.same_symm_add : same.symm (a + b) = same.symm a + same.symm b

lemma nat.add_ne_zero_left (a b : ℕ) (h : b ≠ 0) : a + b ≠ 0 :=
begin
  omega,
end

lemma equiv.to_fun_add (p q : ℙ) :
  equiv.to_fun_aux (p + q) = equiv.to_fun_aux p + equiv.to_fun_aux q :=
begin
--  rw ← (show same.symm (same p) = p, from same.left_inv p),
  --rw ← (show same.symm (same q) = q, from same.left_inv q),
  rw ← (show equiv.inv_fun_aux (equiv.to_fun_aux p) = p, from same.left_inv p),
  rw ← (show equiv.inv_fun_aux (equiv.to_fun_aux q) = q, from same.left_inv q),
  rw ← equiv.inv_fun_add,
  rw bij1,
  rw bij2,
  rw bij2,
  { apply equiv.to_fun_ne_zero },
  { apply nat.add_ne_zero_left,
    apply equiv.to_fun_ne_zero },
  { apply equiv.to_fun_ne_zero },
  { apply equiv.to_fun_ne_zero },
end

end equiv

/-- computer-science-endorsed definition of mul-/
protected def mul (a : ℙ) : ℙ → ℙ
| 1        := a
| (bit0 b) := bit0 (mul b)
| (bit1 b) := bit0 (mul b) + a

instance : has_mul ℙ := ⟨pos_num.mul⟩

@[simp] lemma mul_one (a : ℙ) : a * 1 = a := rfl

@[simp] lemma mul_bit0 (a b : ℙ) : a * (bit0 b) = bit0 (a * b) := rfl

@[simp] lemma mul_bit1 (a b : ℙ) : a * (bit1 b) = bit0 (a * b) + a := rfl

@[simp] lemma one_mul (p : ℙ) : 1 * p = p :=
begin
  induction p;
  all_goals { try {rw (show (one : ℙ) = 1, from rfl)}};
  simp [*]
end

/-! # Current state : working on to_fun_mul -/
-- (sorry-free up to here)

@[simp] lemma equiv.to_fun_mul (a b : ℙ) :
  same (a * b) = ⟨(same a).1 * (same b).1, begin
    apply nat.mul_ne_zero;
    apply equiv.to_fun_ne_zero,
  end⟩ :=
begin
  apply subtype.eq,
  induction b with b hb b hb generalizing a,
  { rw (show (one : ℙ) = 1, from rfl),
    rw mul_one,
    symmetry',
    apply _root_.mul_one },
  { unfold_coes, simp [same] at hb ⊢,
    rw equiv.to_fun_add,
    rw equiv.to_fun_bit0,
    sorry },
  { sorry }
end

section pred

/-! # Pred == a possibly mad project. -/

-- I get stuck proving the equiv. There is a sorry in the
-- equiv in this section.

/-! to_fun is the bijection ℙ → ℕ, considered as a function. -/
def pred.to_fun : ℙ → ℕ :=
pos_num.rec 0 (λ b (n : ℕ), (n + n + 1 + 1)) (λ b n, n + n + 1)

-- interface for pred.to_fun
lemma pred.to_fun_one : pred.to_fun 1 = 0 := rfl
lemma pred.to_fun_two : pred.to_fun (bit0 1) = 1 := rfl
lemma pred.to_fun_bit0 (a : ℙ) : pred.to_fun (bit0 a) =
  (pred.to_fun a) + (pred.to_fun a) + 1 :=
begin
  refl
end

lemma pred.to_fun_bit1 (a : ℙ) : pred.to_fun (bit1 a) =
  (pred.to_fun a + pred.to_fun a + 1 + 1) :=
begin
  refl
end

/-- `inv_fun : the bijection ℕ → ℙ, considered as a function -/
def pred.inv_fun := nat.rec 1 (λ n p, succ p)

-- the interface for inv_fun

lemma pred.inv_fun_zero : pred.inv_fun 0 = 1 :=rfl
lemma pred.inv_fun_succ (n : ℕ) :
  pred.inv_fun (nat.succ n) = succ (pred.inv_fun n) :=rfl
lemma pred.inv_fun_succ' (n : ℕ) :
  pred.inv_fun (n + 1) = succ (pred.inv_fun n) :=rfl

open nat

def temp : {n : ℕ // n ≠ 0} ≃ ℕ :=
{ to_fun := λ n, pred n.1,
  inv_fun := λ n, ⟨nat.succ n, succ_ne_zero n⟩,
  left_inv := λ n, begin
    cases n with n hn,
    cases n with n, cases hn rfl,
    refl,
  end,
  right_inv := λ n, begin
    refl,
  end
}

/-! # equiv -/
def pred : ℙ ≃ ℕ := same.trans temp

end pred

/-! # The usual induction principle -/

-- I deduce this from an equiv to a nat-like object.
def pos_num.induction (C : ℙ → Prop) (x : C 1) (h : ∀ d, C d → C (succ d))
  (p : ℙ) : C p :=
begin
  suffices : ∀ n : ℕ, C (pred.symm n),
  { convert this (pred p), simp },
  intro n,
  induction n with d hd,
  { convert x },
  { convert h _ hd },
end

def pow : ℙ → ℙ → ℙ
| x 1 := 1
| x (bit0 y) := pow x y * pow x y
| x (bit1 y) := pow x y * pow x y * x
-- cf bit1 y = y + y + 1

-- all the usual pred stuff

def pred' : ℙ → ℙ
| 1 := 37
| (bit1 a) := bit0 a
| (bit0 a) := bit1 (pred' a)

def size : ℙ → ℙ
| 1        := 1
| (bit0 n) := succ (size n)
| (bit1 n) := succ (size n)

  def of_nat_succ : ℕ → ℙ
  | 0            := 1
  | (nat.succ n) := succ (of_nat_succ n)

  def of_nat (n : ℕ) : ℙ := of_nat_succ (nat.pred n)

/-! # semigroup-/

instance : add_semigroup ℙ :=
{ add := (+),
  add_assoc := add_assoc' }

/-! # mul -/

#print pos_num.mul
-- not even a monoid because no 0

  open ordering

-- inductive prop
-- not sure if this is right
inductive le : ∀ (a b : ℙ), Prop
| one_le : ∀ (a : ℙ), le 1 a
| bit0_mono : ∀ (a b : ℙ), le a b → le (bit0 a) (bit0 b)
| bit1_mono : ∀ (a b : ℙ), le a b → le (bit1 a) (bit1 b)
| comm_diag : ∀ (a b : ℙ), le a b → le (bit0 a) (bit1 b)
| funny_one : ∀ (a b : ℙ), le a b → a ≠ b → le (bit1 a) (bit0 b)

namespace le

instance : has_le ℙ := ⟨le⟩

--has_lt will be autogenerated by preorder

instance : partial_order ℙ :=
{ le := (≤),
  le_refl := begin
    intro a,
    induction a,
    apply one_le,
    apply bit1_mono,
    assumption,
    apply bit0_mono,
    assumption,
  end,
  le_trans := begin
    rintros a b c hab hbc,
    induction hab with B B C hBC bCBc b6 b7 b8 b9 b10;
    clear a b,
    -- with b | ⟨a, b, hab⟩ | ⟨a, b, hab⟩ | ⟨a,
 --b, hab⟩ | ⟨a, b, hab, haneb⟩,
    { apply one_le },
    { rcases hbc with hab,
      apply bit0_mono,
      cases hbc with hbc,
--      cases hbc,
--      apply bit0_mono,
--      assumption,
--      cases c,
--      { cases hbc },
      { sorry },
      { sorry }},

    -- rintros ⟨_,a0,a1⟩ ⟨_,b0,b1⟩ ⟨_,c0,c1⟩,
    -- --try {cc}, -- solves five of them
    -- { cc },
    -- { cc },
    -- { cc },
    -- { intros, apply one_le one,

    -- },

    sorry, sorry, sorry
  end,
  le_antisymm := begin
    sorry
  end }

end le

end pos_num

end xena

#exit

--instance : has_lt ℙ := ⟨λa b, cmp a b = ordering.lt⟩

theorem le_refl (a : ℙ) : a ≤ a := sorry

#exit

instance : has_lt ℙ := ⟨λa b, cmp a b = ordering.lt⟩
instance : has_le ℙ := ⟨λa b, ¬ b < a⟩

  instance decidable_lt : @decidable_rel ℙ (<)
  | a b := by dsimp [(<)]; apply_instance

  instance decidable_le : @decidable_rel ℙ (≤)
  | a b := by dsimp [(≤)]; apply_instance

end ℙ

section
  variables {α : Type*} [has_zero α] [has_one α] [has_add α]

  def cast_pos_num : ℙ → α
  | 1                := 1
  | (ℙ.bit0 a) := bit0 (cast_pos_num a)
  | (ℙ.bit1 a) := bit1 (cast_pos_num a)

  def cast_num : num → α
  | 0           := 0
  | (num.pos p) := cast_pos_num p

  @[priority 10] instance pos_num_coe : has_coe ℙ α := ⟨cast_pos_num⟩

  @[priority 10] instance num_nat_coe : has_coe num α := ⟨cast_num⟩

  instance : has_repr ℙ := ⟨λ n, repr (n : ℕ)⟩
  instance : has_repr num := ⟨λ n, repr (n : ℕ)⟩
end

namespace num
  open ℙ

  def succ' : num → ℙ
  | 0       := 1
  | (pos p) := succ p

  def succ (n : num) : num := pos (succ' n)

  protected def add : num → num → num
  | 0       a       := a
  | b       0       := b
  | (pos a) (pos b) := pos (a + b)

  instance : has_add num := ⟨num.add⟩

  protected def bit0 : num → num
  | 0       := 0
  | (pos n) := pos (ℙ.bit0 n)

  protected def bit1 : num → num
  | 0       := 1
  | (pos n) := pos (ℙ.bit1 n)

  def bit (b : bool) : num → num := cond b num.bit1 num.bit0

  def size : num → num
  | 0       := 0
  | (pos n) := pos (ℙ.size n)

  def nat_size : num → nat
  | 0       := 0
  | (pos n) := ℙ.nat_size n

  protected def mul : num → num → num
  | 0       _       := 0
  | _       0       := 0
  | (pos a) (pos b) := pos (a * b)

  instance : has_mul num := ⟨num.mul⟩

  open ordering
  def cmp : num → num → ordering
  | 0       0       := eq
  | _       0       := gt
  | 0       _       := lt
  | (pos a) (pos b) := ℙ.cmp a b

  instance : has_lt num := ⟨λa b, cmp a b = ordering.lt⟩
  instance : has_le num := ⟨λa b, ¬ b < a⟩

  instance decidable_lt : @decidable_rel num (<)
  | a b := by dsimp [(<)]; apply_instance

  instance decidable_le : @decidable_rel num (≤)
  | a b := by dsimp [(≤)]; apply_instance

  def to_znum : num → znum
  | 0       := 0
  | (pos a) := znum.pos a

  def to_znum_neg : num → znum
  | 0       := 0
  | (pos a) := znum.neg a

  def of_nat' : ℕ → num :=
  nat.binary_rec 0 (λ b n, cond b num.bit1 num.bit0)

end num

namespace znum
  open ℙ

  def zneg : znum → znum
  | 0       := 0
  | (pos a) := neg a
  | (neg a) := pos a

  instance : has_neg znum := ⟨zneg⟩

  def abs : znum → num
  | 0       := 0
  | (pos a) := num.pos a
  | (neg a) := num.pos a

  def succ : znum → znum
  | 0       := 1
  | (pos a) := pos (ℙ.succ a)
  | (neg a) := (ℙ.pred' a).to_znum_neg

  def pred : znum → znum
  | 0       := neg 1
  | (pos a) := (ℙ.pred' a).to_znum
  | (neg a) := neg (ℙ.succ a)

  protected def bit0 : znum → znum
  | 0       := 0
  | (pos n) := pos (ℙ.bit0 n)
  | (neg n) := neg (ℙ.bit0 n)

  protected def bit1 : znum → znum
  | 0       := 1
  | (pos n) := pos (ℙ.bit1 n)
  | (neg n) := neg (num.cases_on (pred' n) 1 ℙ.bit1)

  protected def bitm1 : znum → znum
  | 0       := neg 1
  | (pos n) := pos (num.cases_on (pred' n) 1 ℙ.bit1)
  | (neg n) := neg (ℙ.bit1 n)

  def of_int' : ℤ → znum
  | (n : ℕ) := num.to_znum (num.of_nat' n)
  | -[1+ n] := num.to_znum_neg (num.of_nat' (n+1))

end znum

namespace ℙ
  open znum

  def sub' : ℙ → ℙ → znum
  | a        1        := (pred' a).to_znum
  | 1        b        := (pred' b).to_znum_neg
  | (bit0 a) (bit0 b) := (sub' a b).bit0
  | (bit0 a) (bit1 b) := (sub' a b).bitm1
  | (bit1 a) (bit0 b) := (sub' a b).bit1
  | (bit1 a) (bit1 b) := (sub' a b).bit0

  def of_znum' : znum → option ℙ
  | (znum.pos p) := some p
  | _            := none

  def of_znum : znum → ℙ
  | (znum.pos p) := p
  | _            := 1

  protected def sub (a b : ℙ) : ℙ :=
  match sub' a b with
  | (znum.pos p) := p
  | _ := 1
  end

  instance : has_sub ℙ := ⟨pos_num.sub⟩
end ℙ

namespace num
  def ppred : num → option num
  | 0       := none
  | (pos p) := some p.pred'

  def pred : num → num
  | 0       := 0
  | (pos p) := p.pred'

  def div2 : num → num
  | 0 := 0
  | 1 := 0
  | (pos (ℙ.bit0 p)) := pos p
  | (pos (ℙ.bit1 p)) := pos p

  def of_znum' : znum → option num
  | 0            := some 0
  | (znum.pos p) := some (pos p)
  | (znum.neg p) := none

  def of_znum : znum → num
  | (znum.pos p) := pos p
  | _            := 0

  def sub' : num → num → znum
  | 0       0       := 0
  | (pos a) 0       := znum.pos a
  | 0       (pos b) := znum.neg b
  | (pos a) (pos b) := a.sub' b

  def psub (a b : num) : option num :=
  of_znum' (sub' a b)

  protected def sub (a b : num) : num :=
  of_znum (sub' a b)

  instance : has_sub num := ⟨num.sub⟩
end num

namespace znum
  open ℙ

  protected def add : znum → znum → znum
  | 0       a       := a
  | b       0       := b
  | (pos a) (pos b) := pos (a + b)
  | (pos a) (neg b) := sub' a b
  | (neg a) (pos b) := sub' b a
  | (neg a) (neg b) := neg (a + b)

  instance : has_add znum := ⟨znum.add⟩

  protected def mul : znum → znum → znum
  | 0       a       := 0
  | b       0       := 0
  | (pos a) (pos b) := pos (a * b)
  | (pos a) (neg b) := neg (a * b)
  | (neg a) (pos b) := neg (a * b)
  | (neg a) (neg b) := pos (a * b)

  instance : has_mul znum := ⟨znum.mul⟩

  open ordering
  def cmp : znum → znum → ordering
  | 0       0       := eq
  | (pos a) (pos b) := ℙ.cmp a b
  | (neg a) (neg b) := ℙ.cmp b a
  | (pos _) _       := gt
  | (neg _) _       := lt
  | _       (pos _) := lt
  | _       (neg _) := gt

  instance : has_lt znum := ⟨λa b, cmp a b = ordering.lt⟩
  instance : has_le znum := ⟨λa b, ¬ b < a⟩

  instance decidable_lt : @decidable_rel znum (<)
  | a b := by dsimp [(<)]; apply_instance

  instance decidable_le : @decidable_rel znum (≤)
  | a b := by dsimp [(≤)]; apply_instance

end znum

namespace ℙ

  def divmod_aux (d : ℙ) (q r : num) : num × num :=
  match num.of_znum' (num.sub' r (num.pos d)) with
  | some r' := (num.bit1 q, r')
  | none    := (num.bit0 q, r)
  end

  def divmod (d : ℙ) : ℙ → num × num
  | (bit0 n) := let (q, r₁) := divmod n in
    divmod_aux d q (num.bit0 r₁)
  | (bit1 n) := let (q, r₁) := divmod n in
    divmod_aux d q (num.bit1 r₁)
  | 1        := divmod_aux d 0 1

  def div' (n d : ℙ) : num := (divmod d n).1

  def mod' (n d : ℙ) : num := (divmod d n).2

  def sqrt_aux1 (b : ℙ) (r n : num) : num × num :=
  match num.of_znum' (n.sub' (r + num.pos b)) with
  | some n' := (r.div2 + num.pos b, n')
  | none := (r.div2, n)
  end

  def sqrt_aux : ℙ → num → num → num
  | b@(bit0 b') r n := let (r', n') := sqrt_aux1 b r n in sqrt_aux b' r' n'
  | b@(bit1 b') r n := let (r', n') := sqrt_aux1 b r n in sqrt_aux b' r' n'
  | 1           r n := (sqrt_aux1 1 r n).1
/-

def sqrt_aux : ℕ → ℕ → ℕ → ℕ
| b r n := if b0 : b = 0 then r else
  let b' := shiftr b 2 in
  have b' < b, from sqrt_aux_dec b0,
  match (n - (r + b : ℕ) : ℤ) with
  | (n' : ℕ) := sqrt_aux b' (div2 r + b) n'
  | _ := sqrt_aux b' (div2 r) n
  end

/-- `sqrt n` is the square root of a natural number `n`. If `n` is not a
  perfect square, it returns the largest `k:ℕ` such that `k*k ≤ n`. -/
def sqrt (n : ℕ) : ℕ :=
match size n with
| 0      := 0
| succ s := sqrt_aux (shiftl 1 (bit0 (div2 s))) 0 n
end
-/

end ℙ

namespace num

  def div : num → num → num
  | 0       _       := 0
  | _       0       := 0
  | (pos n) (pos d) := ℙ.div' n d

  def mod : num → num → num
  | 0       _       := 0
  | n       0       := n
  | (pos n) (pos d) := ℙ.mod' n d

  instance : has_div num := ⟨num.div⟩
  instance : has_mod num := ⟨num.mod⟩

  def gcd_aux : nat → num → num → num
  | 0            a b := b
  | (nat.succ n) 0 b := b
  | (nat.succ n) a b := gcd_aux n (b % a) a

  def gcd (a b : num) : num :=
  if a ≤ b then
    gcd_aux (a.nat_size + b.nat_size) a b
  else
    gcd_aux (b.nat_size + a.nat_size) b a

end num

namespace znum

  def div : znum → znum → znum
  | 0       _       := 0
  | _       0       := 0
  | (pos n) (pos d) := num.to_znum (ℙ.div' n d)
  | (pos n) (neg d) := num.to_znum_neg (ℙ.div' n d)
  | (neg n) (pos d) := neg (ℙ.pred' n / num.pos d).succ'
  | (neg n) (neg d) := pos (ℙ.pred' n / num.pos d).succ'

  def mod : znum → znum → znum
  | 0       d := 0
  | (pos n) d := num.to_znum (num.pos n % d.abs)
  | (neg n) d := d.abs.sub' (ℙ.pred' n % d.abs).succ

  instance : has_div znum := ⟨znum.div⟩
  instance : has_mod znum := ⟨znum.mod⟩

  def gcd (a b : znum) : num := a.abs.gcd b.abs

end znum

section
  variables {α : Type*} [has_zero α] [has_one α] [has_add α] [has_neg α]

  def cast_znum : znum → α
  | 0            := 0
  | (znum.pos p) := p
  | (znum.neg p) := -p

  @[priority 10] instance znum_coe : has_coe znum α := ⟨cast_znum⟩

  instance : has_repr znum := ⟨λ n, repr (n : ℤ)⟩
end

/- The snum representation uses a bit string, essentially a list of 0 (ff) and 1 (tt) bits,
   and the negation of the MSB is sign-extended to all higher bits. -/
namespace nzsnum
  notation a :: b := bit a b

  def sign : nzsnum → bool
  | (msb b) := bnot b
  | (b :: p) := sign p

  @[pattern] def not : nzsnum → nzsnum
  | (msb b) := msb (bnot b)
  | (b :: p) := bnot b :: not p
  prefix ~ := not

  def bit0 : nzsnum → nzsnum := bit ff
  def bit1 : nzsnum → nzsnum := bit tt

  def head : nzsnum → bool
  | (msb b)  := b
  | (b :: p) := b

  def tail : nzsnum → snum
  | (msb b)  := snum.zero (bnot b)
  | (b :: p) := p

end nzsnum

namespace snum
  open nzsnum

  def sign : snum → bool
  | (zero z) := z
  | (nz p)   := p.sign

  @[pattern] def not : snum → snum
  | (zero z) := zero (bnot z)
  | (nz p)   := ~p
  prefix ~ := not

  @[pattern] def bit : bool → snum → snum
  | b (zero z) := if b = z then zero b else msb b
  | b (nz p)   := p.bit b

  notation a :: b := bit a b

  def bit0 : snum → snum := bit ff
  def bit1 : snum → snum := bit tt

  theorem bit_zero (b) : b :: zero b = zero b := by cases b; refl

  theorem bit_one (b) : b :: zero (bnot b) = msb b := by cases b; refl

end snum

namespace nzsnum
  open snum

  def drec' {C : snum → Sort*} (z : Π b, C (snum.zero b))
    (s : Π b p, C p → C (b :: p)) : Π p : nzsnum, C p
  | (msb b)  := by rw ←bit_one; exact s b (snum.zero (bnot b)) (z (bnot b))
  | (bit b p) := s b p (drec' p)
end nzsnum

namespace snum
  open nzsnum

  def head : snum → bool
  | (zero z) := z
  | (nz p)   := p.head

  def tail : snum → snum
  | (zero z) := zero z
  | (nz p)   := p.tail

  def drec' {C : snum → Sort*} (z : Π b, C (snum.zero b))
    (s : Π b p, C p → C (b :: p)) : Π p, C p
  | (zero b) := z b
  | (nz p)   := p.drec' z s

  def rec' {α} (z : bool → α) (s : bool → snum → α → α) : snum → α :=
  drec' z s

  def bits : snum → Π n, vector bool n
  | p 0     := vector.nil
  | p (n+1) := head p :: bits (tail p) n

  def test_bit : nat → snum → bool
  | 0     p := head p
  | (n+1) p := test_bit n (tail p)

  def succ : snum → snum :=
  rec' (λ b, cond b 0 1) (λb p succp, cond b (ff :: succp) (tt :: p))

  def pred : snum → snum :=
  rec' (λ b, cond b (~1) ~0) (λb p predp, cond b (ff :: p) (tt :: predp))

  protected def neg (n : snum) : snum := succ ~n

  instance : has_neg snum := ⟨snum.neg⟩

  -- First bit is 0 or 1 (tt), second bit is 0 or -1 (tt)
  def czadd : bool → bool → snum → snum
  | ff ff p := p
  | ff tt p := pred p
  | tt ff p := succ p
  | tt tt p := p

  def cadd : snum → snum → bool → snum :=
  rec' (λ a p c, czadd c a p) $ λa p IH,
  rec' (λb c, czadd c b (a :: p)) $ λb q _ c,
  bitvec.xor3 a b c :: IH q (bitvec.carry a b c)

  protected def add (a b : snum) : snum := cadd a b ff

  instance : has_add snum := ⟨snum.add⟩

  protected def sub (a b : snum) : snum := a + -b

  instance : has_sub snum := ⟨snum.sub⟩

  protected def mul (a : snum) : snum → snum :=
  rec' (λ b, cond b (-a) 0) $ λb q IH,
  cond b (bit0 IH + a) (bit0 IH)

  instance : has_mul snum := ⟨snum.mul⟩

end snum

namespace int
  def of_snum : snum → ℤ :=
  snum.rec' (λ a, cond a (-1) 0) (λa p IH, cond a (bit1 IH) (bit0 IH))

  instance snum_coe : has_coe snum ℤ := ⟨of_snum⟩
end int

instance : has_lt snum := ⟨λa b, (a : ℤ) < b⟩
instance : has_le snum := ⟨λa b, (a : ℤ) ≤ b⟩


/-
Copyright (c) 2021 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import topology.subset_properties
import topology.connected
import topology.continuous_function.basic
import algebra.indicator_function
import tactic.tfae
import tactic.fin_cases

/-!
# Locally constant functions

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

This file sets up the theory of locally constant function from a topological space to a type.

## Main definitions and constructions

* `is_locally_constant f` : a map `f : X → Y` where `X` is a topological space is locally
                            constant if every set in `Y` has an open preimage.
* `locally_constant X Y` : the type of locally constant maps from `X` to `Y`
* `locally_constant.map` : push-forward of locally constant maps
* `locally_constant.comap` : pull-back of locally constant maps

-/

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

open set filter
open_locale topology

/-- A function between topological spaces is locally constant if the preimage of any set is open. -/
def is_locally_constant (f : X → Y) : Prop := ∀ s : set Y, is_open (f ⁻¹' s)

namespace is_locally_constant

protected lemma tfae (f : X → Y) :
  tfae [is_locally_constant f,
    ∀ x, ∀ᶠ x' in 𝓝 x, f x' = f x,
    ∀ x, is_open {x' | f x' = f x},
    ∀ y, is_open (f ⁻¹' {y}),
    ∀ x, ∃ (U : set X) (hU : is_open U) (hx : x ∈ U), ∀ x' ∈ U, f x' = f x] :=
begin
  tfae_have : 1 → 4, from λ h y, h {y},
  tfae_have : 4 → 3, from λ h x, h (f x),
  tfae_have : 3 → 2, from λ h x, is_open.mem_nhds (h x) rfl,
  tfae_have : 2 → 5,
  { intros h x,
    rcases mem_nhds_iff.1 (h x) with ⟨U, eq, hU, hx⟩,
    exact ⟨U, hU, hx, eq⟩ },
  tfae_have : 5 → 1,
  { intros h s,
    refine is_open_iff_forall_mem_open.2 (λ x hx, _),
    rcases h x with ⟨U, hU, hxU, eq⟩,
    exact ⟨U, λ x' hx', mem_preimage.2 $ (eq x' hx').symm ▸ hx, hU, hxU⟩ },
  tfae_finish
end

@[nontriviality] lemma of_discrete [discrete_topology X] (f : X → Y) :
  is_locally_constant f :=
λ s, is_open_discrete _

lemma is_open_fiber {f : X → Y} (hf : is_locally_constant f) (y : Y) :
  is_open {x | f x = y} :=
hf {y}

lemma is_closed_fiber {f : X → Y} (hf : is_locally_constant f) (y : Y) :
  is_closed {x | f x = y} :=
⟨hf {y}ᶜ⟩

lemma is_clopen_fiber {f : X → Y} (hf : is_locally_constant f) (y : Y) :
  is_clopen {x | f x = y} :=
⟨is_open_fiber hf _, is_closed_fiber hf _⟩

lemma iff_exists_open (f : X → Y) :
  is_locally_constant f ↔ ∀ x, ∃ (U : set X) (hU : is_open U) (hx : x ∈ U), ∀ x' ∈ U, f x' = f x :=
(is_locally_constant.tfae f).out 0 4

lemma iff_eventually_eq (f : X → Y) :
  is_locally_constant f ↔ ∀ x, ∀ᶠ y in 𝓝 x, f y = f x :=
(is_locally_constant.tfae f).out 0 1

lemma exists_open {f : X → Y} (hf : is_locally_constant f) (x : X) :
  ∃ (U : set X) (hU : is_open U) (hx : x ∈ U), ∀ x' ∈ U, f x' = f x :=
(iff_exists_open f).1 hf x

protected lemma eventually_eq {f : X → Y} (hf : is_locally_constant f) (x : X) :
  ∀ᶠ y in 𝓝 x, f y = f x :=
(iff_eventually_eq f).1 hf x

protected lemma continuous [topological_space Y] {f : X → Y} (hf : is_locally_constant f) :
  continuous f :=
⟨λ U hU, hf _⟩

lemma iff_continuous {_ : topological_space Y} [discrete_topology Y] (f : X → Y) :
  is_locally_constant f ↔ continuous f :=
⟨is_locally_constant.continuous, λ h s, h.is_open_preimage s (is_open_discrete _)⟩

lemma of_constant (f : X → Y) (h : ∀ x y, f x = f y) :
  is_locally_constant f :=
(iff_eventually_eq f).2 $ λ x, eventually_of_forall $ λ x', h _ _

lemma const (y : Y) : is_locally_constant (function.const X y) :=
of_constant _ $ λ _ _, rfl

lemma comp {f : X → Y} (hf : is_locally_constant f) (g : Y → Z) :
  is_locally_constant (g ∘ f) :=
λ s, by { rw set.preimage_comp, exact hf _ }

lemma prod_mk {Y'} {f : X → Y} {f' : X → Y'} (hf : is_locally_constant f)
  (hf' : is_locally_constant f') :
  is_locally_constant (λ x, (f x, f' x)) :=
(iff_eventually_eq _).2 $ λ x, (hf.eventually_eq x).mp $ (hf'.eventually_eq x).mono $
  λ x' hf' hf, prod.ext hf hf'

lemma comp₂ {Y₁ Y₂ Z : Type*} {f : X → Y₁} {g : X → Y₂}
  (hf : is_locally_constant f) (hg : is_locally_constant g) (h : Y₁ → Y₂ → Z) :
  is_locally_constant (λ x, h (f x) (g x)) :=
(hf.prod_mk hg).comp (λ x : Y₁ × Y₂, h x.1 x.2)

lemma comp_continuous [topological_space Y] {g : Y → Z} {f : X → Y}
  (hg : is_locally_constant g) (hf : continuous f) :
  is_locally_constant (g ∘ f) :=
λ s, by { rw set.preimage_comp, exact hf.is_open_preimage _ (hg _) }

/-- A locally constant function is constant on any preconnected set. -/
lemma apply_eq_of_is_preconnected {f : X → Y} (hf : is_locally_constant f)
  {s : set X} (hs : is_preconnected s) {x y : X} (hx : x ∈ s) (hy : y ∈ s) :
  f x = f y :=
begin
  let U := f ⁻¹' {f y},
  suffices : x ∉ Uᶜ, from not_not.1 this,
  intro hxV,
  specialize hs U Uᶜ (hf {f y}) (hf {f y}ᶜ) _ ⟨y, ⟨hy, rfl⟩⟩ ⟨x, ⟨hx, hxV⟩⟩,
  { simp only [union_compl_self, subset_univ] },
  { simpa only [inter_empty, not_nonempty_empty, inter_compl_self] using hs }
end

lemma apply_eq_of_preconnected_space [preconnected_space X]
  {f : X → Y} (hf : is_locally_constant f) (x y : X) :
  f x = f y :=
hf.apply_eq_of_is_preconnected is_preconnected_univ trivial trivial

lemma eq_const [preconnected_space X] {f : X → Y} (hf : is_locally_constant f) (x : X) :
  f = function.const X (f x) :=
funext $ λ y, hf.apply_eq_of_preconnected_space y x

lemma exists_eq_const [preconnected_space X] [nonempty Y] {f : X → Y} (hf : is_locally_constant f) :
  ∃ y, f = function.const X y :=
begin
  casesI is_empty_or_nonempty X,
  { exact ⟨classical.arbitrary Y, funext $ h.elim⟩ },
  { exact ⟨f (classical.arbitrary X), hf.eq_const _⟩ },
end

lemma iff_is_const [preconnected_space X] {f : X → Y} :
  is_locally_constant f ↔ ∀ x y, f x = f y :=
⟨λ h x y, h.apply_eq_of_is_preconnected is_preconnected_univ trivial trivial, of_constant _⟩

lemma range_finite [compact_space X] {f : X → Y} (hf : is_locally_constant f) :
  (set.range f).finite :=
begin
  letI : topological_space Y := ⊥, haveI := discrete_topology_bot Y,
  rw @iff_continuous X Y ‹_› ‹_› at hf,
  exact (is_compact_range hf).finite_of_discrete
end

@[to_additive] lemma one [has_one Y] : is_locally_constant (1 : X → Y) := const 1

@[to_additive] lemma inv [has_inv Y] ⦃f : X → Y⦄ (hf : is_locally_constant f) :
  is_locally_constant f⁻¹ :=
hf.comp (λ x, x⁻¹)

@[to_additive]
lemma mul [has_mul Y] ⦃f g : X → Y⦄ (hf : is_locally_constant f) (hg : is_locally_constant g) :
  is_locally_constant (f * g) :=
hf.comp₂ hg (*)

@[to_additive]
lemma div [has_div Y] ⦃f g : X → Y⦄ (hf : is_locally_constant f) (hg : is_locally_constant g) :
  is_locally_constant (f / g) :=
hf.comp₂ hg (/)

/-- If a composition of a function `f` followed by an injection `g` is locally
constant, then the locally constant property descends to `f`. -/
lemma desc {α β : Type*} (f : X → α) (g : α → β)
  (h : is_locally_constant (g ∘ f)) (inj : function.injective g) : is_locally_constant f :=
begin
  rw (is_locally_constant.tfae f).out 0 3,
  intros a,
  have : f ⁻¹' {a} = (g ∘ f) ⁻¹' { g a },
  { ext x,
    simp only [mem_singleton_iff, function.comp_app, mem_preimage],
    exact ⟨λ h, by rw h, λ h, inj h⟩ },
  rw this,
  apply h,
end

lemma of_constant_on_connected_components [locally_connected_space X] {f : X → Y}
  (h : ∀ x, ∀ y ∈ connected_component x, f y = f x) :
  is_locally_constant f :=
begin
  rw iff_exists_open,
  exact λ x, ⟨connected_component x, is_open_connected_component, mem_connected_component, h x⟩,
end

lemma of_constant_on_preconnected_clopens [locally_connected_space X] {f : X → Y}
  (h : ∀ U : set X, is_preconnected U → is_clopen U → ∀ x ∈ U, ∀ y ∈ U, f y = f x) :
  is_locally_constant f :=
of_constant_on_connected_components (λ x, h (connected_component x)
  is_preconnected_connected_component is_clopen_connected_component x mem_connected_component)

end is_locally_constant

/-- A (bundled) locally constant function from a topological space `X` to a type `Y`. -/
@[protect_proj]
structure locally_constant (X Y : Type*) [topological_space X] :=
(to_fun : X → Y)
(is_locally_constant : is_locally_constant to_fun)

namespace locally_constant

instance [inhabited Y] : inhabited (locally_constant X Y) :=
⟨⟨_, is_locally_constant.const default⟩⟩

instance : has_coe_to_fun (locally_constant X Y) (λ _, X → Y) := ⟨locally_constant.to_fun⟩

initialize_simps_projections locally_constant (to_fun → apply)

@[simp] lemma to_fun_eq_coe (f : locally_constant X Y) : f.to_fun = f := rfl

@[simp] lemma coe_mk (f : X → Y) (h) : ⇑(⟨f, h⟩ : locally_constant X Y) = f := rfl

theorem congr_fun {f g : locally_constant X Y} (h : f = g) (x : X) : f x = g x :=
congr_arg (λ h : locally_constant X Y, h x) h

theorem congr_arg (f : locally_constant X Y) {x y : X} (h : x = y) : f x = f y :=
congr_arg (λ x : X, f x) h

theorem coe_injective : @function.injective (locally_constant X Y) (X → Y) coe_fn
| ⟨f, hf⟩ ⟨g, hg⟩ h := have f = g, from h, by subst f

@[simp, norm_cast] theorem coe_inj {f g : locally_constant X Y} : (f : X → Y) = g ↔ f = g :=
coe_injective.eq_iff

@[ext] theorem ext ⦃f g : locally_constant X Y⦄ (h : ∀ x, f x = g x) : f = g :=
coe_injective (funext h)

theorem ext_iff {f g : locally_constant X Y} : f = g ↔ ∀ x, f x = g x :=
⟨λ h x, h ▸ rfl, λ h, ext h⟩

section codomain_topological_space

variables [topological_space Y] (f : locally_constant X Y)

protected lemma continuous : continuous f := f.is_locally_constant.continuous

/-- We can turn a locally-constant function into a bundled `continuous_map`. -/
def to_continuous_map : C(X, Y) := ⟨f, f.continuous⟩

/-- As a shorthand, `locally_constant.to_continuous_map` is available as a coercion -/
instance : has_coe (locally_constant X Y) C(X, Y) := ⟨to_continuous_map⟩

@[simp] lemma to_continuous_map_eq_coe : f.to_continuous_map = f := rfl

@[simp] lemma coe_continuous_map : ((f : C(X, Y)) : X → Y) = (f : X → Y) := rfl

lemma to_continuous_map_injective :
  function.injective (to_continuous_map : locally_constant X Y → C(X, Y)) :=
λ _ _ h, ext (continuous_map.congr_fun h)

end codomain_topological_space

/-- The constant locally constant function on `X` with value `y : Y`. -/
def const (X : Type*) {Y : Type*} [topological_space X] (y : Y) :
  locally_constant X Y :=
⟨function.const X y, is_locally_constant.const _⟩

@[simp] lemma coe_const (y : Y) : (const X y : X → Y) = function.const X y := rfl

/-- The locally constant function to `fin 2` associated to a clopen set. -/
def of_clopen {X : Type*} [topological_space X] {U : set X} [∀ x, decidable (x ∈ U)]
  (hU : is_clopen U) : locally_constant X (fin 2) :=
{ to_fun := λ x, if x ∈ U then 0 else 1,
  is_locally_constant := begin
    rw (is_locally_constant.tfae (λ x, if x ∈ U then (0 : fin 2) else 1)).out 0 3,
    intros e,
    fin_cases e,
    { convert hU.1 using 1,
      ext,
      simp only [mem_singleton_iff, fin.one_eq_zero_iff, mem_preimage, ite_eq_left_iff,
        nat.succ_succ_ne_one],
      tauto },
    { rw ← is_closed_compl_iff,
      convert hU.2,
      ext,
      simp }
  end }

@[simp] lemma of_clopen_fiber_zero {X : Type*} [topological_space X] {U : set X}
  [∀ x, decidable (x ∈ U)] (hU : is_clopen U) : of_clopen hU ⁻¹' ({0} : set (fin 2)) = U :=
begin
  ext,
  simp only [of_clopen, mem_singleton_iff, fin.one_eq_zero_iff, coe_mk, mem_preimage,
    ite_eq_left_iff, nat.succ_succ_ne_one],
  tauto,
end

@[simp] lemma of_clopen_fiber_one {X : Type*} [topological_space X] {U : set X}
  [∀ x, decidable (x ∈ U)] (hU : is_clopen U) : of_clopen hU ⁻¹' ({1} : set (fin 2)) = Uᶜ :=
begin
  ext,
  simp only [of_clopen, mem_singleton_iff, coe_mk, fin.zero_eq_one_iff, mem_preimage,
    ite_eq_right_iff, mem_compl_iff, nat.succ_succ_ne_one],
  tauto,
end

lemma locally_constant_eq_of_fiber_zero_eq {X : Type*} [topological_space X]
  (f g : locally_constant X (fin 2)) (h : f ⁻¹' ({0} : set (fin 2)) = g ⁻¹' {0}) : f = g :=
begin
  simp only [set.ext_iff, mem_singleton_iff, mem_preimage] at h,
  ext1 x,
  exact fin.fin_two_eq_of_eq_zero_iff (h x)
end

lemma range_finite [compact_space X] (f : locally_constant X Y) :
  (set.range f).finite :=
f.is_locally_constant.range_finite

lemma apply_eq_of_is_preconnected (f : locally_constant X Y) {s : set X} (hs : is_preconnected s)
  {x y : X} (hx : x ∈ s) (hy : y ∈ s) :
  f x = f y :=
f.is_locally_constant.apply_eq_of_is_preconnected hs hx hy

lemma apply_eq_of_preconnected_space [preconnected_space X] (f : locally_constant X Y) (x y : X) :
  f x = f y :=
f.is_locally_constant.apply_eq_of_is_preconnected is_preconnected_univ trivial trivial

lemma eq_const [preconnected_space X] (f : locally_constant X Y) (x : X) :
  f = const X (f x) :=
ext $ λ y, apply_eq_of_preconnected_space f _ _

lemma exists_eq_const [preconnected_space X] [nonempty Y] (f : locally_constant X Y) :
  ∃ y, f = const X y :=
begin
  rcases classical.em (nonempty X) with ⟨⟨x⟩⟩|hX,
  { exact ⟨f x, f.eq_const x⟩ },
  { exact ⟨classical.arbitrary Y, ext $ λ x, (hX ⟨x⟩).elim⟩ }
end

/-- Push forward of locally constant maps under any map, by post-composition. -/
def map (f : Y → Z) : locally_constant X Y → locally_constant X Z :=
λ g, ⟨f ∘ g, λ s, by { rw set.preimage_comp, apply g.is_locally_constant }⟩

@[simp] lemma map_apply (f : Y → Z) (g : locally_constant X Y) : ⇑(map f g) = f ∘ g := rfl

@[simp] lemma map_id : @map X Y Y _ id = id := by { ext, refl }

@[simp] lemma map_comp {Y₁ Y₂ Y₃ : Type*} (g : Y₂ → Y₃) (f : Y₁ → Y₂) :
  @map X _ _ _ g ∘ map f = map (g ∘ f) := by { ext, refl }

/-- Given a locally constant function to `α → β`, construct a family of locally constant
functions with values in β indexed by α. -/
def flip {X α β : Type*} [topological_space X] (f : locally_constant X (α → β)) (a : α) :
  locally_constant X β := f.map (λ f, f a)

/-- If α is finite, this constructs a locally constant function to `α → β` given a
family of locally constant functions with values in β indexed by α. -/
def unflip {X α β : Type*} [fintype α] [topological_space X] (f : α → locally_constant X β) :
  locally_constant X (α → β) :=
{ to_fun := λ x a, f a x,
  is_locally_constant := begin
    rw (is_locally_constant.tfae (λ x a, f a x)).out 0 3,
    intros g,
    have : (λ (x : X) (a : α), f a x) ⁻¹' {g} = ⋂ (a : α), (f a) ⁻¹' {g a}, by tidy,
    rw this,
    apply is_open_Inter,
    intros a,
    apply (f a).is_locally_constant,
  end }

@[simp]
lemma unflip_flip {X α β : Type*} [fintype α] [topological_space X]
  (f : locally_constant X (α → β)) : unflip f.flip = f := by { ext, refl }

@[simp]
lemma flip_unflip {X α β : Type*} [fintype α] [topological_space X]
  (f : α → locally_constant X β) : (unflip f).flip = f := by { ext, refl }

section comap

open_locale classical

variables [topological_space Y]

/-- Pull back of locally constant maps under any map, by pre-composition.

This definition only makes sense if `f` is continuous,
in which case it sends locally constant functions to their precomposition with `f`.
See also `locally_constant.coe_comap`. -/
noncomputable
def comap (f : X → Y) :
  locally_constant Y Z → locally_constant X Z :=
if hf : continuous f
then λ g, ⟨g ∘ f, g.is_locally_constant.comp_continuous hf⟩
else
begin
  by_cases H : nonempty X,
  { introsI g, exact const X (g $ f $ classical.arbitrary X) },
  { intro g, refine ⟨λ x, (H ⟨x⟩).elim, _⟩,
    intro s, rw is_open_iff_nhds, intro x, exact (H ⟨x⟩).elim }
end

@[simp] lemma coe_comap (f : X → Y) (g : locally_constant Y Z) (hf : continuous f) :
  ⇑(comap f g) = g ∘ f :=
by { rw [comap, dif_pos hf], refl }

@[simp] lemma comap_id : @comap X X Z _ _ id = id :=
by { ext, simp only [continuous_id, id.def, function.comp.right_id, coe_comap] }

lemma comap_comp [topological_space Z]
  (f : X → Y) (g : Y → Z) (hf : continuous f) (hg : continuous g) :
  @comap _ _ α _ _ f ∘ comap g = comap (g ∘ f) :=
by { ext, simp only [hf, hg, hg.comp hf, coe_comap] }

lemma comap_const (f : X → Y) (y : Y) (h : ∀ x, f x = y) :
  (comap f : locally_constant Y Z → locally_constant X Z) =
  λ g, ⟨λ x, g y, is_locally_constant.const _⟩ :=
begin
  ext, rw coe_comap,
  { simp only [h, coe_mk, function.comp_app] },
  { rw show f = λ x, y, by ext; apply h,
    exact continuous_const }
end

end comap

section desc

/-- If a locally constant function factors through an injection, then it factors through a locally
constant function. -/
def desc {X α β : Type*} [topological_space X] {g : α → β} (f : X → α) (h : locally_constant X β)
  (cond : g ∘ f = h) (inj : function.injective g) : locally_constant X α :=
{ to_fun := f,
  is_locally_constant := is_locally_constant.desc _ g (by { rw cond, exact h.2 }) inj }

@[simp]
lemma coe_desc {X α β : Type*} [topological_space X] (f : X → α) (g : α → β)
  (h : locally_constant X β) (cond : g ∘ f = h) (inj : function.injective g) :
  ⇑(desc f h cond inj) = f := rfl

end desc

section indicator
variables {R : Type*} [has_one R] {U : set X} (f : locally_constant X R)
open_locale classical

/-- Given a clopen set `U` and a locally constant function `f`, `locally_constant.mul_indicator`
  returns the locally constant function that is `f` on `U` and `1` otherwise. -/
@[to_additive /-" Given a clopen set `U` and a locally constant function `f`,
  `locally_constant.indicator` returns the locally constant function that is `f` on `U` and `0`
  otherwise. "-/, simps]
noncomputable def mul_indicator (hU : is_clopen U) :
  locally_constant X R :=
{ to_fun := set.mul_indicator U f,
  is_locally_constant :=
    begin
      rw is_locally_constant.iff_exists_open, rintros x,
      obtain ⟨V, hV, hx, h'⟩ := (is_locally_constant.iff_exists_open _).1 f.is_locally_constant x,
      by_cases x ∈ U,
      { refine ⟨U ∩ V, is_open.inter hU.1 hV, set.mem_inter h hx, _⟩, rintros y hy,
        rw set.mem_inter_iff at hy, rw [set.mul_indicator_of_mem hy.1, set.mul_indicator_of_mem h],
        apply h' y hy.2, },
      { rw ←set.mem_compl_iff at h, refine ⟨Uᶜ, (is_clopen.compl hU).1, h, _⟩,
        rintros y hy, rw set.mem_compl_iff at h, rw set.mem_compl_iff at hy,
        simp [h, hy], },
    end, }

variables (a : X)

@[to_additive]

variables {a}

@[to_additive]
theorem mul_indicator_of_mem (hU : is_clopen U) (h : a ∈ U) : f.mul_indicator hU a = f a :=
by{ rw mul_indicator_apply, apply set.mul_indicator_of_mem h, }

@[to_additive]
theorem mul_indicator_of_not_mem (hU : is_clopen U) (h : a ∉ U) : f.mul_indicator hU a = 1 :=
by{ rw mul_indicator_apply, apply set.mul_indicator_of_not_mem h, }

end indicator
end locally_constant