/-
Copyright (c) 2018 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel
Adapted from the corresponding theory for complete lattices.

Theory of conditionally complete lattices.

A conditionally complete lattice is a lattice in which every non-empty bounded subset s
has a least upper bound and a greatest lower bound, denoted below by Sup s and Inf s.
Typical examples are real, nat, int with their usual orders.

The theory is very comparable to the theory of complete lattices, except that suitable
boundedness and non-emptyness assumptions have to be added to most statements.
We introduce two predicates bdd_above and bdd_below to express this boundedness, prove
their basic properties, and then go on to prove most useful properties of Sup and Inf
in conditionally complete lattices.

To differentiate the statements between complete lattices and conditionally complete
lattices, we prefix Inf and Sup in the statements by c, giving cInf and cSup. For instance,
Inf_le is a statement in complete lattices ensuring Inf s ≤ x, while cInf_le is the same
statement in conditionally complete lattices with an additional assumption that s is
bounded below.
-/
import
  order.lattice order.complete_lattice order.bounds
  tactic.finish data.set.countable

set_option old_structure_cmd true

open preorder set lattice

universes u v w
variables {α : Type u} {β : Type v} {ι : Type w}

section preorder
variables [preorder α] [preorder β] {s t : set α} {a b : α}

/-Sets bounded above and bounded below.-/
def bdd_above (s : set α) := ∃x, ∀y∈s, y ≤ x
def bdd_below (s : set α) := ∃x, ∀y∈s, x ≤ y

/-Introduction rules for boundedness above and below.
Most of the time, it is more efficient to use ⟨w, P⟩ where P is a proof
that all elements of the set are bounded by w. However, they are sometimes handy.-/
lemma bdd_above.mk (a : α) (H : ∀y∈s, y≤a) : bdd_above s := ⟨a, H⟩
lemma bdd_below.mk (a : α) (H : ∀y∈s, a≤y) : bdd_below s := ⟨a, H⟩

/-Empty sets and singletons are trivially bounded. For finite sets, we need
a notion of maximum and minimum, i.e., a lattice structure, see later on.-/
@[simp] lemma bdd_above_empty : ∀ [nonempty α], bdd_above (∅ : set α)
| ⟨x⟩ := ⟨x, by simp⟩

@[simp] lemma bdd_below_empty : ∀ [nonempty α], bdd_below (∅ : set α)
| ⟨x⟩ := ⟨x, by simp⟩

@[simp] lemma bdd_above_singleton : bdd_above ({a} : set α) :=
⟨a, by simp only [set.mem_singleton_iff, forall_eq]⟩

@[simp] lemma bdd_below_singleton : bdd_below ({a} : set α) :=
⟨a, by simp only [set.mem_singleton_iff, forall_eq]⟩

/-If a set is included in another one, boundedness of the second implies boundedness
of the first-/
lemma bdd_above_subset (st : s ⊆ t) : bdd_above t → bdd_above s
| ⟨w, hw⟩ := ⟨w, λ y ys, hw _ (st ys)⟩

lemma bdd_below_subset (st : s ⊆ t) : bdd_below t → bdd_below s
| ⟨w, hw⟩ := ⟨w, λ y ys, hw _ (st ys)⟩

/- Boundedness of intersections of sets, in different guises, deduced from the
monotonicity of boundedness.-/
lemma bdd_above_inter_left : bdd_above s → bdd_above (s ∩ t) :=
bdd_above_subset (set.inter_subset_left _ _)

lemma bdd_above_inter_right : bdd_above t → bdd_above (s ∩ t) :=
bdd_above_subset (set.inter_subset_right _ _)

lemma bdd_below_inter_left : bdd_below s → bdd_below (s ∩ t) :=
bdd_below_subset (set.inter_subset_left _ _)

lemma bdd_below_inter_right : bdd_below t → bdd_below (s ∩ t) :=
bdd_below_subset (set.inter_subset_right _ _)

/--The image under a monotone function of a set which is bounded above is bounded above-/
lemma bdd_above_of_bdd_above_of_monotone {f : α → β} (hf : monotone f) : bdd_above s → bdd_above (f '' s)
| ⟨C, hC⟩ := ⟨f C, by rintro y ⟨x, x_bnd, rfl⟩; exact hf (hC x x_bnd)⟩

/--The image under a monotone function of a set which is bounded below is bounded below-/
lemma bdd_below_of_bdd_below_of_monotone {f : α → β} (hf : monotone f) : bdd_below s → bdd_below (f '' s)
| ⟨C, hC⟩ := ⟨f C, by rintro y ⟨x, x_bnd, rfl⟩; exact hf (hC x x_bnd)⟩

end preorder

/--When there is a global maximum, every set is bounded above.-/
@[simp] lemma bdd_above_top [order_top α] (s : set α) : bdd_above s :=
⟨⊤, by intros; apply order_top.le_top⟩

/--When there is a global minimum, every set is bounded below.-/
@[simp] lemma bdd_below_bot [order_bot α] (s : set α): bdd_below s :=
⟨⊥, by intros; apply order_bot.bot_le⟩

/-When there is a max (i.e., in the class semilattice_sup), then the union of
two bounded sets is bounded, by the maximum of the bounds for the two sets.
With this, we deduce that finite sets are bounded by induction, and that a finite
union of bounded sets is bounded.-/
section semilattice_sup
variables [semilattice_sup α] {s t : set α} {a b : α}

/--The union of two sets is bounded above if and only if each of the sets is.-/
@[simp] lemma bdd_above_union : bdd_above (s ∪ t) ↔ bdd_above s ∧ bdd_above t :=
⟨show bdd_above (s ∪ t) → (bdd_above s ∧ bdd_above t), from
  assume : bdd_above (s ∪ t),
  have S : bdd_above s, by apply bdd_above_subset _ ‹bdd_above (s ∪ t)›; simp only [set.subset_union_left],
  have T : bdd_above t, by apply bdd_above_subset _ ‹bdd_above (s ∪ t)›; simp only [set.subset_union_right],
  and.intro S T,
show (bdd_above s ∧ bdd_above t) → bdd_above (s ∪ t), from
  assume H : bdd_above s ∧ bdd_above t,
  let ⟨⟨ws, hs⟩, ⟨wt, ht⟩⟩ := H in
    /-hs : ∀ (y : α), y ∈ s → y ≤ ws      ht : ∀ (y : α), y ∈ s → y ≤ wt-/
  have Bs : ∀b∈s, b ≤ ws ⊔ wt,
    by intros; apply le_trans (hs b ‹b ∈ s›) _; simp only [lattice.le_sup_left],
  have Bt : ∀b∈t, b ≤ ws ⊔ wt,
    by intros; apply le_trans (ht b ‹b ∈ t›) _; simp only [lattice.le_sup_right],
  show bdd_above (s ∪ t),
    begin
    apply bdd_above.mk (ws ⊔ wt),
    intros b H_1,
    cases H_1,
    apply Bs _ ‹b ∈ s›,
    apply Bt _ ‹b ∈ t›,
    end⟩

/--Adding a point to a set preserves its boundedness above.-/
@[simp] lemma bdd_above_insert : bdd_above (insert a s) ↔ bdd_above s :=
⟨bdd_above_subset (by simp only [set.subset_insert]),
 λ h, by rw [insert_eq, bdd_above_union]; exact ⟨bdd_above_singleton, h⟩⟩

/--A finite set is bounded above.-/
lemma bdd_above_finite [nonempty α] (hs : finite s) : bdd_above s :=
finite.induction_on hs bdd_above_empty $ λ a s _ _, bdd_above_insert.2

/--A finite union of sets which are all bounded above is still bounded above.-/
lemma bdd_above_finite_union [nonempty α] {β : Type v} {I : set β} {S : β → set α} (H : finite I) :
(bdd_above (⋃i∈I, S i)) ↔ (∀i ∈ I, bdd_above (S i)) :=
⟨λ (bdd : bdd_above (⋃i∈I, S i)) i (hi : i ∈ I),
  bdd_above_subset (subset_bUnion_of_mem hi) bdd,
show (∀i ∈ I, bdd_above (S i)) → (bdd_above (⋃i∈I, S i)), from
finite.induction_on H
  (λ _, by rw bUnion_empty; exact bdd_above_empty)
  (λ x s hn hf IH h, by simp only [
      set.mem_insert_iff, or_imp_distrib, forall_and_distrib, forall_eq] at h;
    rw [set.bUnion_insert, bdd_above_union]; exact ⟨h.1, IH h.2⟩)⟩

end semilattice_sup

/-When there is a min (i.e., in the class semilattice_inf), then the union of
two sets which are bounded from below is bounded from below, by the minimum of
the bounds for the two sets. With this, we deduce that finite sets are
bounded below by induction, and that a finite union of sets which are bounded below
is still bounded below.-/

section semilattice_inf
variables [semilattice_inf α] {s t : set α} {a b : α}

/--The union of two sets is bounded below if and only if each of the sets is.-/
@[simp] lemma bdd_below_union : bdd_below (s ∪ t) ↔ bdd_below s ∧ bdd_below t :=
⟨show bdd_below (s ∪ t) → (bdd_below s ∧ bdd_below t), from
  assume : bdd_below (s ∪ t),
  have S : bdd_below s, by apply bdd_below_subset _ ‹bdd_below (s ∪ t)›; simp only [set.subset_union_left],
  have T : bdd_below t, by apply bdd_below_subset _ ‹bdd_below (s ∪ t)›; simp only [set.subset_union_right],
  and.intro S T,
show (bdd_below s ∧ bdd_below t) → bdd_below (s ∪ t), from
  assume H : bdd_below s ∧ bdd_below t,
  let ⟨⟨ws, hs⟩, ⟨wt, ht⟩⟩ := H in
    /-hs : ∀ (y : α), y ∈ s → ws ≤ y      ht : ∀ (y : α), y ∈ s → wt ≤ y-/
  have Bs : ∀b∈s, ws ⊓ wt ≤ b,
    by intros; apply le_trans _ (hs b ‹b ∈ s›); simp only [lattice.inf_le_left],
  have Bt : ∀b∈t, ws ⊓ wt ≤ b,
    by intros; apply le_trans _ (ht b ‹b ∈ t›); simp only [lattice.inf_le_right],
  show bdd_below (s ∪ t),
    begin
    apply bdd_below.mk (ws ⊓ wt),
    intros b H_1,
    cases H_1,
    apply Bs _ ‹b ∈ s›,
    apply Bt _ ‹b ∈ t›,
    end⟩

/--Adding a point to a set preserves its boundedness below.-/
@[simp] lemma bdd_below_insert : bdd_below (insert a s) ↔ bdd_below s :=
⟨show bdd_below (insert a s) → bdd_below s, from bdd_below_subset (by simp only [set.subset_insert]),
 show bdd_below s → bdd_below (insert a s),
   by rw[insert_eq]; simp only [bdd_below_singleton, bdd_below_union, and_self, forall_true_iff] {contextual := tt}⟩

/--A finite set is bounded below.-/
lemma bdd_below_finite [nonempty α] (hs : finite s) : bdd_below s :=
finite.induction_on hs bdd_below_empty $ λ a s _ _, bdd_below_insert.2

/--A finite union of sets which are all bounded below is still bounded below.-/
lemma bdd_below_finite_union [nonempty α] {β : Type v} {I : set β} {S : β → set α} (H : finite I) :
(bdd_below (⋃i∈I, S i)) ↔ (∀i ∈ I, bdd_below (S i)) :=
⟨λ (bdd : bdd_below (⋃i∈I, S i)) i (hi : i ∈ I),
  bdd_below_subset (subset_bUnion_of_mem hi) bdd,
show (∀i ∈ I, bdd_below (S i)) → (bdd_below (⋃i∈I, S i)), from
finite.induction_on H
  (λ _, by rw bUnion_empty; exact bdd_below_empty)
  (λ x s hn hf IH h, by simp only [
      set.mem_insert_iff, or_imp_distrib, forall_and_distrib, forall_eq] at h;
    rw [set.bUnion_insert, bdd_below_union]; exact ⟨h.1, IH h.2⟩)⟩

end semilattice_inf

namespace lattice
/-- A conditionally complete lattice is a lattice in which
every nonempty subset which is bounded above has a supremum, and
every nonempty subset which is bounded below has an infimum.
Typical examples are real numbers or natural numbers.

To differentiate the statements from the corresponding statements in (unconditional)
complete lattices, we prefix Inf and Sup by a c everywhere. The same statements should
hold in both worlds, sometimes with additional assumptions of non-emptyness or
boundedness.-/
class conditionally_complete_lattice (α : Type u) extends lattice α, has_Sup α, has_Inf α :=
(le_cSup : ∀s a, bdd_above s → a ∈ s → a ≤ Sup s)
(cSup_le : ∀s a, s ≠ ∅ → (∀b∈s, b ≤ a) → Sup s ≤ a)
(cInf_le : ∀s a, bdd_below s → a ∈ s → Inf s ≤ a)
(le_cInf : ∀s a, s ≠ ∅ → (∀b∈s, a ≤ b) → a ≤ Inf s)

class conditionally_complete_linear_order (α : Type u)
  extends conditionally_complete_lattice α, decidable_linear_order α

class conditionally_complete_linear_order_bot (α : Type u)
  extends conditionally_complete_lattice α, decidable_linear_order α, order_bot α :=
(cSup_empty : Sup ∅ = ⊥)

/- A complete lattice is a conditionally complete lattice, as there are no restrictions
on the properties of Inf and Sup in a complete lattice.-/

instance conditionally_complete_lattice_of_complete_lattice [complete_lattice α]:
  conditionally_complete_lattice α :=
{ le_cSup := by intros; apply le_Sup; assumption,
  cSup_le := by intros; apply Sup_le; assumption,
  cInf_le := by intros; apply Inf_le; assumption,
  le_cInf := by intros; apply le_Inf; assumption,
  ..‹complete_lattice α›}

instance conditionally_complete_linear_order_of_complete_linear_order [complete_linear_order α]:
  conditionally_complete_linear_order α :=
{ ..lattice.conditionally_complete_lattice_of_complete_lattice, .. ‹complete_linear_order α› }

section conditionally_complete_lattice
variables [conditionally_complete_lattice α] {s t : set α} {a b : α}

theorem le_cSup (h₁ : bdd_above s) (h₂ : a ∈ s) : a ≤ Sup s :=
conditionally_complete_lattice.le_cSup s a h₁ h₂

theorem cSup_le (h₁ : s ≠ ∅) (h₂ : ∀b∈s, b ≤ a) : Sup s ≤ a :=
conditionally_complete_lattice.cSup_le s a h₁ h₂

theorem cInf_le (h₁ : bdd_below s) (h₂ : a ∈ s) : Inf s ≤ a :=
conditionally_complete_lattice.cInf_le s a h₁ h₂

theorem le_cInf (h₁ : s ≠ ∅) (h₂ : ∀b∈s, a ≤ b) : a ≤ Inf s :=
conditionally_complete_lattice.le_cInf s a h₁ h₂

theorem le_cSup_of_le (_ : bdd_above s) (hb : b ∈ s) (h : a ≤ b) : a ≤ Sup s :=
le_trans h (le_cSup ‹bdd_above s› hb)

theorem cInf_le_of_le (_ : bdd_below s) (hb : b ∈ s) (h : b ≤ a) : Inf s ≤ a :=
le_trans (cInf_le ‹bdd_below s› hb) h

theorem cSup_le_cSup (_ : bdd_above t) (_ : s ≠ ∅) (h : s ⊆ t) : Sup s ≤ Sup t :=
cSup_le ‹s ≠ ∅› (assume (a) (ha : a ∈ s), le_cSup ‹bdd_above t› (h ha))

theorem cInf_le_cInf (_ : bdd_below t) (_ :s ≠ ∅) (h : s ⊆ t) : Inf t ≤ Inf s :=
le_cInf ‹s ≠ ∅› (assume (a) (ha : a ∈ s), cInf_le ‹bdd_below t› (h ha))

theorem cSup_le_iff (_ : bdd_above s) (_ : s ≠ ∅) : Sup s ≤ a ↔ (∀b ∈ s, b ≤ a) :=
⟨assume (_ : Sup s ≤ a) (b) (_ : b ∈ s),
  le_trans (le_cSup ‹bdd_above s› ‹b ∈ s›) ‹Sup s ≤ a›,
  cSup_le ‹s ≠ ∅›⟩

theorem le_cInf_iff (_ : bdd_below s) (_ : s ≠ ∅) : a ≤ Inf s ↔ (∀b ∈ s, a ≤ b) :=
⟨assume (_ : a ≤ Inf s) (b) (_ : b ∈ s),
  le_trans ‹a ≤ Inf s› (cInf_le ‹bdd_below s› ‹b ∈ s›),
  le_cInf ‹s ≠ ∅›⟩

lemma cSup_upper_bounds_eq_cInf {s : set α} (h : bdd_below s) (hs : s ≠ ∅) :
  Sup {a | ∀x∈s, a ≤ x} = Inf s :=
let ⟨b, hb⟩ := h, ⟨a, ha⟩ := ne_empty_iff_exists_mem.1 hs in
le_antisymm
  (cSup_le (ne_empty_iff_exists_mem.2 ⟨b, hb⟩) $ assume a ha, le_cInf hs ha)
  (le_cSup ⟨a, assume y hy, hy a ha⟩ $ assume x hx, cInf_le h hx)

lemma cInf_lower_bounds_eq_cSup {s : set α} (h : bdd_above s) (hs : s ≠ ∅) :
  Inf {a | ∀x∈s, x ≤ a} = Sup s :=
let ⟨b, hb⟩ := h, ⟨a, ha⟩ := ne_empty_iff_exists_mem.1 hs in
le_antisymm
  (cInf_le ⟨a, assume y hy, hy a ha⟩ $ assume x hx, le_cSup h hx)
  (le_cInf (ne_empty_iff_exists_mem.2 ⟨b, hb⟩) $ assume a ha, cSup_le hs ha)

/--Introduction rule to prove that b is the supremum of s: it suffices to check that b
is larger than all elements of s, and that this is not the case of any w<b.-/
theorem cSup_intro (_ : s ≠ ∅) (_ : ∀a∈s, a ≤ b) (H : ∀w, w < b → (∃a∈s, w < a)) : Sup s = b :=
have bdd_above s := ⟨b, by assumption⟩,
have (Sup s < b) ∨ (Sup s = b) := lt_or_eq_of_le (cSup_le ‹s ≠ ∅› ‹∀a∈s, a ≤ b›),
have ¬(Sup s < b) :=
  assume: Sup s < b,
  let ⟨a, _, _⟩ := (H (Sup s) ‹Sup s < b›) in  /- a ∈ s, Sup s < a-/
  have Sup s < Sup s := lt_of_lt_of_le ‹Sup s < a› (le_cSup ‹bdd_above s› ‹a ∈ s›),
  show false, by finish [lt_irrefl (Sup s)],
show Sup s = b, by finish

/--Introduction rule to prove that b is the infimum of s: it suffices to check that b
is smaller than all elements of s, and that this is not the case of any w>b.-/
theorem cInf_intro (_ : s ≠ ∅) (_ : ∀a∈s, b ≤ a) (H : ∀w, b < w → (∃a∈s, a < w)) : Inf s = b :=
have bdd_below s := ⟨b, by assumption⟩,
have (b < Inf s) ∨ (b = Inf s) := lt_or_eq_of_le (le_cInf ‹s ≠ ∅› ‹∀a∈s, b ≤ a›),
have ¬(b < Inf s) :=
  assume: b < Inf s,
  let ⟨a, _, _⟩ := (H (Inf s) ‹b < Inf s›) in  /- a ∈ s, a < Inf s-/
  have Inf s < Inf s := lt_of_le_of_lt (cInf_le ‹bdd_below s› ‹a ∈ s›) ‹a < Inf s› ,
  show false, by finish [lt_irrefl (Inf s)],
show Inf s = b, by finish

/--When an element a of a set s is larger than all elements of the set, it is Sup s-/
theorem cSup_of_mem_of_le (_ : a ∈ s) (_ : ∀w∈s, w ≤ a) : Sup s = a :=
have bdd_above s := ⟨a, by assumption⟩,
have s ≠ ∅ := ne_empty_of_mem ‹a ∈ s›,
have A : a ≤ Sup s := le_cSup ‹bdd_above s› ‹a ∈ s›,
have B : Sup s ≤ a := cSup_le ‹s ≠ ∅› ‹∀w∈s, w ≤ a›,
le_antisymm B A

/--When an element a of a set s is smaller than all elements of the set, it is Inf s-/
theorem cInf_of_mem_of_le (_ : a ∈ s) (_ : ∀w∈s, a ≤ w) : Inf s = a :=
have bdd_below s := ⟨a, by assumption⟩,
have s ≠ ∅ := ne_empty_of_mem ‹a ∈ s›,
have A : Inf s ≤ a := cInf_le ‹bdd_below s› ‹a ∈ s›,
have B : a ≤ Inf s := le_cInf ‹s ≠ ∅› ‹∀w∈s, a ≤ w›,
le_antisymm A B

/--b < Sup s when there is an element a in s with b < a, when s is bounded above.
This is essentially an iff, except that the assumptions for the two implications are
slightly different (one needs boundedness above for one direction, nonemptyness and linear
order for the other one), so we formulate separately the two implications, contrary to
the complete_lattice case.-/
lemma lt_cSup_of_lt (_ : bdd_above s) (_ : a ∈ s) (_ : b < a) : b < Sup s :=
lt_of_lt_of_le ‹b < a› (le_cSup ‹bdd_above s› ‹a ∈ s›)

/--Inf s < b s when there is an element a in s with a < b, when s is bounded below.
This is essentially an iff, except that the assumptions for the two implications are
slightly different (one needs boundedness below for one direction, nonemptyness and linear
order for the other one), so we formulate separately the two implications, contrary to
the complete_lattice case.-/

lemma cInf_lt_of_lt (_ : bdd_below s) (_ : a ∈ s) (_ : a < b) : Inf s < b :=
lt_of_le_of_lt (cInf_le ‹bdd_below s› ‹a ∈ s›) ‹a < b›

/--The supremum of a singleton is the element of the singleton-/
@[simp] theorem cSup_singleton (a : α) : Sup {a} = a :=
have A : a ≤ Sup {a} :=
  by apply le_cSup _ _; simp only [set.mem_singleton,bdd_above_singleton],
have B : Sup {a} ≤ a :=
  by apply cSup_le _ _; simp only [set.mem_singleton_iff, forall_eq,ne.def, not_false_iff, set.singleton_ne_empty],
le_antisymm B A

/--The infimum of a singleton is the element of the singleton-/
@[simp] theorem cInf_singleton (a : α) : Inf {a} = a :=
have A : Inf {a} ≤ a :=
  by apply cInf_le _ _; simp only [set.mem_singleton,bdd_below_singleton],
have B : a ≤ Inf {a} :=
  by apply le_cInf _ _; simp only [set.mem_singleton_iff, forall_eq,ne.def, not_false_iff, set.singleton_ne_empty],
le_antisymm A B

/--If a set is bounded below and above, and nonempty, its infimum is less than or equal to
its supremum.-/
theorem cInf_le_cSup (_ : bdd_below s) (_ : bdd_above s) (_ : s ≠ ∅) : Inf s ≤ Sup s :=
let ⟨w, hw⟩ := exists_mem_of_ne_empty ‹s ≠ ∅› in   /-hw : w ∈ s-/
have Inf s ≤ w := cInf_le ‹bdd_below s› ‹w ∈ s›,
have w ≤ Sup s := le_cSup ‹bdd_above s› ‹w ∈ s›,
le_trans ‹Inf s ≤ w› ‹w ≤ Sup s›

/--The sup of a union of sets is the max of the suprema of each subset, under the assumptions
that all sets are bounded above and nonempty.-/
theorem cSup_union (_ : bdd_above s) (_ : s ≠ ∅) (_ : bdd_above t) (_ : t ≠ ∅) :
Sup (s ∪ t) = Sup s ⊔ Sup t :=
have A : Sup (s ∪ t) ≤ Sup s ⊔ Sup t :=
  have s ∪ t ≠ ∅ := by simp only [not_and, set.union_empty_iff, ne.def] at *; finish,
  have F : ∀b∈ s∪t, b ≤ Sup s ⊔ Sup t :=
    begin
      intros,
      cases H,
      apply le_trans (le_cSup ‹bdd_above s› ‹b ∈ s›) _, simp only [lattice.le_sup_left],
      apply le_trans (le_cSup ‹bdd_above t› ‹b ∈ t›) _, simp only [lattice.le_sup_right]
    end,
  cSup_le this F,
have B : Sup s ⊔ Sup t ≤ Sup (s ∪ t) :=
  have Sup s ≤ Sup (s ∪ t) := by apply cSup_le_cSup _ ‹s ≠ ∅›; simp only [bdd_above_union,set.subset_union_left]; finish,
  have Sup t ≤ Sup (s ∪ t) := by apply cSup_le_cSup _ ‹t ≠ ∅›; simp only [bdd_above_union,set.subset_union_right]; finish,
  by simp only [lattice.sup_le_iff]; split; assumption; assumption,
le_antisymm A B

/--The inf of a union of sets is the min of the infima of each subset, under the assumptions
that all sets are bounded below and nonempty.-/
theorem cInf_union (_ : bdd_below s) (_ : s ≠ ∅) (_ : bdd_below t) (_ : t ≠ ∅) :
Inf (s ∪ t) = Inf s ⊓ Inf t :=
have A : Inf s ⊓ Inf t ≤ Inf (s ∪ t) :=
  have s ∪ t ≠ ∅ := by simp only [not_and, set.union_empty_iff, ne.def] at *; finish,
  have F : ∀b∈ s∪t, Inf s ⊓ Inf t ≤ b :=
    begin
      intros,
      cases H,
      apply le_trans _ (cInf_le ‹bdd_below s› ‹b ∈ s›), simp only [lattice.inf_le_left],
      apply le_trans _ (cInf_le ‹bdd_below t› ‹b ∈ t›), simp only [lattice.inf_le_right]
    end,
  le_cInf this F,
have B : Inf (s ∪ t) ≤ Inf s ⊓ Inf t  :=
  have Inf (s ∪ t) ≤ Inf s := by apply cInf_le_cInf _ ‹s ≠ ∅›; simp only [bdd_below_union,set.subset_union_left]; finish,
  have Inf (s ∪ t) ≤ Inf t := by apply cInf_le_cInf _ ‹t ≠ ∅›; simp only [bdd_below_union,set.subset_union_right]; finish,
  by simp only [lattice.le_inf_iff]; split; assumption; assumption,
le_antisymm B A

/--The supremum of an intersection of sets is bounded by the minimum of the suprema of each
set, if all sets are bounded above and nonempty.-/
theorem cSup_inter_le (_ : bdd_above s) (_ : bdd_above t) (_ : s ∩ t ≠ ∅) :
Sup (s ∩ t) ≤ Sup s ⊓ Sup t :=
begin
  apply cSup_le ‹s ∩ t ≠ ∅› _, simp only [lattice.le_inf_iff, and_imp, set.mem_inter_eq], intros b _ _, split,
  apply le_cSup ‹bdd_above s› ‹b ∈ s›,
  apply le_cSup ‹bdd_above t› ‹b ∈ t›
end

/--The infimum of an intersection of sets is bounded below by the maximum of the
infima of each set, if all sets are bounded below and nonempty.-/
theorem le_cInf_inter (_ : bdd_below s) (_ : bdd_below t) (_ : s ∩ t ≠ ∅) :
Inf s ⊔ Inf t ≤ Inf (s ∩ t) :=
begin
  apply le_cInf ‹s ∩ t ≠ ∅› _, simp only [and_imp, set.mem_inter_eq, lattice.sup_le_iff], intros b _ _, split,
  apply cInf_le ‹bdd_below s› ‹b ∈ s›,
  apply cInf_le ‹bdd_below t› ‹b ∈ t›
end

/-- The supremum of insert a s is the maximum of a and the supremum of s, if s is
nonempty and bounded above.-/
theorem cSup_insert (_ : bdd_above s) (_ : s ≠ ∅) : Sup (insert a s) = a ⊔ Sup s :=
calc Sup (insert a s)
        = Sup ({a} ∪ s)   : by rw [insert_eq]
    ... = Sup {a} ⊔ Sup s : by apply cSup_union _ _ ‹bdd_above s› ‹s ≠ ∅›; simp only [ne.def, not_false_iff, set.singleton_ne_empty,bdd_above_singleton]
    ... = a ⊔ Sup s       : by simp only [eq_self_iff_true, lattice.cSup_singleton]

/-- The infimum of insert a s is the minimum of a and the infimum of s, if s is
nonempty and bounded below.-/
theorem cInf_insert (_ : bdd_below s) (_ : s ≠ ∅) : Inf (insert a s) = a ⊓ Inf s :=
calc Inf (insert a s)
        = Inf ({a} ∪ s)   : by rw [insert_eq]
    ... = Inf {a} ⊓ Inf s : by apply cInf_union _ _ ‹bdd_below s› ‹s ≠ ∅›; simp only [ne.def, not_false_iff, set.singleton_ne_empty,bdd_below_singleton]
    ... = a ⊓ Inf s       : by simp only [eq_self_iff_true, lattice.cInf_singleton]

@[simp] lemma cInf_interval [conditionally_complete_lattice α] : Inf {b | a ≤ b} = a :=
cInf_of_mem_of_le (by simp only [set.mem_set_of_eq]) (λw Hw, by simp only [set.mem_set_of_eq] at Hw; apply Hw)

@[simp] lemma cSup_interval [conditionally_complete_lattice α] : Sup {b | b ≤ a} = a :=
cSup_of_mem_of_le (by simp only [set.mem_set_of_eq]) (λw Hw, by simp only [set.mem_set_of_eq] at Hw; apply Hw)

/--The indexed supremum of two functions are comparable if the functions are pointwise comparable-/
lemma csupr_le_csupr {f g : β → α} (B : bdd_above (range g)) (H : ∀x, f x ≤ g x) : supr f ≤ supr g :=
begin
  classical, by_cases nonempty β,
  { have Rf : range f ≠ ∅, {simpa},
    apply cSup_le Rf,
    rintros y ⟨x, rfl⟩,
    have : g x ∈ range g := ⟨x, rfl⟩,
    exact le_cSup_of_le B this (H x) },
  { have Rf : range f = ∅, {simpa},
    have Rg : range g = ∅, {simpa},
    unfold supr, rw [Rf, Rg] }
end

/--The indexed supremum of a function is bounded above by a uniform bound-/
lemma csupr_le [ne : nonempty β] {f : β → α} {c : α} (H : ∀x, f x ≤ c) : supr f ≤ c :=
cSup_le (by simp [not_not_intro ne]) (by rwa forall_range_iff)

/--The indexed supremum of a function is bounded below by the value taken at one point-/
lemma le_csupr {f : β → α} (H : bdd_above (range f)) {c : β} : f c ≤ supr f :=
le_cSup H (mem_range_self _)

/--The indexed infimum of two functions are comparable if the functions are pointwise comparable-/
lemma cinfi_le_cinfi {f g : β → α} (B : bdd_below (range f)) (H : ∀x, f x ≤ g x) : infi f ≤ infi g :=
begin
  classical, by_cases nonempty β,
  { have Rg : range g ≠ ∅, {simpa},
    apply le_cInf Rg,
    rintros y ⟨x, rfl⟩,
    have : f x ∈ range f := ⟨x, rfl⟩,
    exact cInf_le_of_le B this (H x) },
  { have Rf : range f = ∅, {simpa},
    have Rg : range g = ∅, {simpa},
    unfold infi, rw [Rf, Rg] }
end

/--The indexed minimum of a function is bounded below by a uniform lower bound-/
lemma le_cinfi [ne : nonempty β] {f : β → α} {c : α} (H : ∀x, c ≤ f x) : c ≤ infi f :=
le_cInf (by simp [not_not_intro ne]) (by rwa forall_range_iff)

/--The indexed infimum of a function is bounded above by the value taken at one point-/
lemma cinfi_le {f : β → α} (H : bdd_below (range f)) {c : β} : infi f ≤ f c :=
cInf_le H (mem_range_self _)

lemma is_lub_cSup {s : set α} (ne : s ≠ ∅) (H : bdd_above s) : is_lub s (Sup s) :=
⟨assume x, le_cSup H, assume x, cSup_le ne⟩

lemma is_glb_cInf {s : set α} (ne : s ≠ ∅) (H : bdd_below s) : is_glb s (Inf s) :=
⟨assume x, cInf_le H, assume x, le_cInf ne⟩

@[simp] theorem cinfi_const [nonempty ι] {a : α} : (⨅ b:ι, a) = a :=
begin
  rcases exists_mem_of_nonempty ι with ⟨x, _⟩,
  refine le_antisymm (@cinfi_le _ _ _ _ _ x) (le_cinfi (λi, _root_.le_refl _)),
  rw range_const,
  exact bdd_below_singleton
end

@[simp] theorem csupr_const [nonempty ι] {a : α} : (⨆ b:ι, a) = a :=
begin
  rcases exists_mem_of_nonempty ι with ⟨x, _⟩,
  refine le_antisymm (csupr_le (λi, _root_.le_refl _)) (@le_csupr _ _ _ (λ b:ι, a) _ x),
  rw range_const,
  exact bdd_above_singleton
end

end conditionally_complete_lattice

section conditionally_complete_linear_order
variables [conditionally_complete_linear_order α] {s t : set α} {a b : α}

/--When b < Sup s, there is an element a in s with b < a, if s is nonempty and the order is
a linear order.-/
lemma exists_lt_of_lt_cSup (_ : s ≠ ∅) (_ : b < Sup s) : ∃a∈s, b < a :=
begin
  classical, by_contra h,
  have : Sup s ≤ b :=
    by apply cSup_le ‹s ≠ ∅› _; finish,
  apply lt_irrefl b (lt_of_lt_of_le ‹b < Sup s› ‹Sup s ≤ b›)
end

/--When Inf s < b, there is an element a in s with a < b, if s is nonempty and the order is
a linear order.-/
lemma exists_lt_of_cInf_lt (_ : s ≠ ∅) (_ : Inf s < b) : ∃a∈s, a < b :=
begin
  classical, by_contra h,
  have : b ≤ Inf s :=
    by apply le_cInf ‹s ≠ ∅› _; finish,
  apply lt_irrefl b (lt_of_le_of_lt ‹b ≤ Inf s› ‹Inf s < b›)
end

/--Introduction rule to prove that b is the supremum of s: it suffices to check that
1) b is an upper bound
2) every other upper bound b' satisfies b ≤ b'.-/
theorem cSup_intro' (_ : s ≠ ∅)
  (h_is_ub : ∀ a ∈ s, a ≤ b) (h_b_le_ub : ∀ub, (∀ a ∈ s, a ≤ ub) → (b ≤ ub)) : Sup s = b :=
le_antisymm
  (show Sup s ≤ b, from cSup_le ‹s ≠ ∅› h_is_ub)
  (show b ≤ Sup s, from h_b_le_ub _ $ assume a, le_cSup ⟨b, h_is_ub⟩)

end conditionally_complete_linear_order

section conditionally_complete_linear_order_bot
variables [conditionally_complete_linear_order_bot α]

lemma cSup_empty [conditionally_complete_linear_order_bot α] : (Sup ∅ : α) = ⊥ :=
conditionally_complete_linear_order_bot.cSup_empty α

end conditionally_complete_linear_order_bot

section

local attribute [instance] classical.prop_decidable

noncomputable instance : has_Inf ℕ :=
⟨λs, if h : ∃n, n ∈ s then @nat.find (λn, n ∈ s) _ h else 0⟩

noncomputable instance : has_Sup ℕ :=
⟨λs, if h : ∃n, ∀a∈s, a ≤ n then @nat.find (λn, ∀a∈s, a ≤ n) _ h else 0⟩

lemma Inf_nat_def {s : set ℕ} (h : ∃n, n ∈ s) : Inf s = @nat.find (λn, n ∈ s) _ h :=
dif_pos _

lemma Sup_nat_def {s : set ℕ} (h : ∃n, ∀a∈s, a ≤ n) :
  Sup s = @nat.find (λn, ∀a∈s, a ≤ n) _ h :=
dif_pos _

/-- This instance is necessary, otherwise the lattice operations would be derived via
conditionally_complete_linear_order_bot and marked as noncomputable. -/
instance : lattice ℕ := infer_instance

noncomputable instance : conditionally_complete_linear_order_bot ℕ :=
{ Sup := Sup, Inf := Inf,
  le_cSup    := assume s a hb ha, by rw [Sup_nat_def hb]; revert a ha; exact @nat.find_spec _ _ hb,
  cSup_le    := assume s a hs ha, by rw [Sup_nat_def ⟨a, ha⟩]; exact nat.find_min' _ ha,
  le_cInf    := assume s a hs hb,
    by rw [Inf_nat_def (ne_empty_iff_exists_mem.1 hs)]; exact hb _ (@nat.find_spec (λn, n ∈ s) _ _),
  cInf_le    := assume s a hb ha, by rw [Inf_nat_def ⟨a, ha⟩]; exact nat.find_min' _ ha,
  cSup_empty :=
  begin
    simp only [Sup_nat_def, set.mem_empty_eq, forall_const, forall_prop_of_false, not_false_iff, exists_const],
    apply bot_unique (nat.find_min' _ _),
    trivial
  end,
  .. (infer_instance : order_bot ℕ), .. (infer_instance : lattice ℕ),
  .. (infer_instance : decidable_linear_order ℕ) }

end

end lattice /-end of namespace lattice-/

namespace with_top
open lattice
local attribute [instance] classical.prop_decidable

variables [conditionally_complete_linear_order_bot α]

lemma has_lub (s : set (with_top α)) : ∃a, is_lub s a :=
begin
  by_cases hs : s = ∅, { subst hs, exact ⟨⊥, is_lub_empty⟩, },
  rcases ne_empty_iff_exists_mem.1 hs with ⟨x, hxs⟩,
  by_cases bnd : ∃b:α, ↑b ∈ upper_bounds s,
  { rcases bnd with ⟨b, hb⟩,
    have bdd : bdd_above {a : α | ↑a ∈ s}, from ⟨b, assume y hy, coe_le_coe.1 $ hb _ hy⟩,
    refine ⟨(Sup {a : α | ↑a ∈ s} : α), _, _⟩,
    { assume a has,
      rcases (le_coe_iff _ _).1 (hb _ has) with ⟨a, rfl, h⟩,
      exact (coe_le_coe.2 $ le_cSup bdd has) },
    { assume a hs,
      rcases (le_coe_iff _ _).1 (hb _ hxs) with ⟨x, rfl, h⟩,
      refine (coe_le_iff _ _).2 (assume c hc, _), subst hc,
      exact (cSup_le (ne_empty_of_mem hxs) $ assume b (hbs : ↑b ∈ s), coe_le_coe.1 $ hs _ hbs), } },
  exact ⟨⊤, assume a _, le_top, assume a,
    match a with
    | some a, ha := (bnd ⟨a, ha⟩).elim
    | none,   ha := _root_.le_refl ⊤
    end⟩
end

lemma has_glb (s : set (with_top α)) : ∃a, is_glb s a :=
begin
  by_cases hs : ∃x:α, ↑x ∈ s,
  { rcases hs with ⟨x, hxs⟩,
    refine ⟨(Inf {a : α | ↑a ∈ s} : α), _, _⟩,
    exact (assume a has, (coe_le_iff _ _).2 $ assume x hx, cInf_le (bdd_below_bot _) $
      show ↑x ∈ s, from hx ▸ has),
    { assume a has,
      rcases (le_coe_iff _ _).1 (has _ hxs) with ⟨x, rfl, h⟩,
      exact (coe_le_coe.2 $ le_cInf (ne_empty_of_mem hxs) $
        assume b hbs, coe_le_coe.1 $ has _ hbs) } },
  exact ⟨⊤, assume a, match a with
    | some a, ha := (hs ⟨a, ha⟩).elim
    | none,   ha := _root_.le_refl _
    end,
    assume a _, le_top⟩
end

noncomputable instance : has_Sup (with_top α) := ⟨λs, classical.some $ has_lub s⟩
noncomputable instance : has_Inf (with_top α) := ⟨λs, classical.some $ has_glb s⟩

lemma is_lub_Sup (s : set (with_top α)) : is_lub s (Sup s) := classical.some_spec _
lemma is_glb_Inf (s : set (with_top α)) : is_glb s (Inf s) := classical.some_spec _

noncomputable instance : complete_linear_order (with_top α) :=
{ Sup := Sup, le_Sup := assume s, (is_lub_Sup s).1, Sup_le := assume s, (is_lub_Sup s).2,
  Inf := Inf, le_Inf := assume s, (is_glb_Inf s).2, Inf_le := assume s, (is_glb_Inf s).1,
  decidable_le := classical.dec_rel _,
  .. with_top.linear_order, ..with_top.lattice, ..with_top.order_top, ..with_top.order_bot }

lemma coe_Sup {s : set α} (hb : bdd_above s) : (↑(Sup s) : with_top α) = (⨆a∈s, ↑a) :=
begin
  by_cases hs : s = ∅,
  { rw [hs, cSup_empty], simp only [set.mem_empty_eq, lattice.supr_bot, lattice.supr_false], refl },
  apply le_antisymm,
  { refine ((coe_le_iff _ _).2 $ assume b hb, cSup_le hs $ assume a has, coe_le_coe.1 $ hb ▸ _),
    exact (le_supr_of_le a $ le_supr_of_le has $ _root_.le_refl _) },
  { exact (supr_le $ assume a, supr_le $ assume ha, coe_le_coe.2 $ le_cSup hb ha) }
end

lemma coe_Inf {s : set α} (hs : s ≠ ∅) : (↑(Inf s) : with_top α) = (⨅a∈s, ↑a) :=
let ⟨x, hx⟩ := ne_empty_iff_exists_mem.1 hs in
have (⨅a∈s, ↑a : with_top α) ≤ x, from infi_le_of_le x $ infi_le_of_le hx $ _root_.le_refl _,
let ⟨r, r_eq, hr⟩ := (le_coe_iff _ _).1 this in
le_antisymm
  (le_infi $ assume a, le_infi $ assume ha, coe_le_coe.2 $ cInf_le (bdd_below_bot s) ha)
  begin
    refine (r_eq.symm ▸ coe_le_coe.2 $ le_cInf hs $ assume a has, coe_le_coe.1 $ _),
    refine (r_eq ▸ infi_le_of_le a _),
    exact (infi_le_of_le has $ _root_.le_refl _),
  end

end with_top

section order_dual
open lattice

instance (α : Type*) [conditionally_complete_lattice α] :
  conditionally_complete_lattice (order_dual α) :=
{ le_cSup := @cInf_le α _,
  cSup_le := @le_cInf α _,
  le_cInf := @cSup_le α _,
  cInf_le := @le_cSup α _,
  ..order_dual.lattice.has_Inf α,
  ..order_dual.lattice.has_Sup α,
  ..order_dual.lattice.lattice α }

instance (α : Type*) [conditionally_complete_linear_order α] :
  conditionally_complete_linear_order (order_dual α) :=
{ ..order_dual.lattice.conditionally_complete_lattice α,
  ..order_dual.decidable_linear_order α }

end order_dual


inductive zfc : Type
| empty  : zfc
| insert : zfc → zfc → zfc

instance : has_emptyc zfc := ⟨zfc.empty⟩
instance : has_insert zfc zfc := ⟨zfc.insert⟩

instance : has_zero zfc := ⟨{}⟩
instance : has_one zfc := ⟨{0}⟩

def succ (a : zfc) : zfc := has_insert.insert a a

def zfc_add : zfc → zfc → zfc
| m 0 := m
| m (zfc.insert n p) := succ (zfc_add m n)

instance : has_add zfc := ⟨zfc_add⟩

inductive member : zfc → zfc → Prop
| left {a b c : zfc} : member a c → member a (has_insert.insert b c)
| right {a b : zfc} : member a (has_insert.insert a b)

instance : has_mem zfc zfc := ⟨member⟩
instance : has_subset zfc := ⟨(λ a b:zfc, (∀ z:zfc, z ∈ a → z ∈ b))⟩

axiom member.ext (a b : zfc) : (∀ x, x ∈ a ↔ x ∈ b) ↔ a=b

export zfc
export member

definition A : zfc := {1,2,3,4,5}

theorem M1F_Sheet01_Q05a_is_true : (1:zfc) ∈ A :=
begin
    left, left, left, left, right
end

theorem M1F_Sheet01_Q05b_is_false: ({1}:zfc) ∉ A :=
begin
    intro h,
    cases h,
    cases a_1,
    cases a_2,
    cases a_3,
    cases a_4,
    cases a_5
end

theorem M1F_Sheet01_Q05c_is_true: ({1}:zfc) ⊆ A :=
begin
    intro x,
    intro h,
    cases h,
    cases a_1,
    left, left, left, left, right
end

theorem M1F_Sheet01_Q05d_is_true: ({1,2}:zfc) ⊆ A :=
begin
    intro x,
    intro h,
    cases h,
    cases a_1,
    cases a_2,
    left, left, left, left, right,
    left, left, left, right
end

theorem M1F_Sheet01_Q05e_is_true: ({1,2,1}:zfc) ⊆ A :=
begin
    intro x,
    intro h,
    cases h,
    cases a_1,
    cases a_2,
    cases a_3,
    left, left, left, left, right,
    left, left, left, right,
    left, left, left, left, right
end

theorem M1F_Sheet01_Q05f_is_false: ({1,1}:zfc) ∉ A :=
begin
    intro h,
    cases h,
    cases a_1,
    cases a_2,
    cases a_3,
    cases a_4,
    cases a_5
end

theorem M1F_Sheet01_Q05g_is_false: A ∉ A :=
begin
    intro h,
    cases h,
    cases a_1,
    cases a_2,
    cases a_3,
    cases a_4,
    cases a_5
end

theorem M1F_Sheet01_Q05h_is_true: A ⊇ A :=
begin
    intro h,
    exact id
end


variables P Q S T R : Prop.

lemma exA (H1 : (P ∧ Q) ∧ R)
          (H2 : S ∧ T) : Q ∧ S :=
  and.intro -- Q ∧ S
    (and.elim_right --Q
        (and.elim_left H1))
    (and.elim_left H2). -- S

lemma exC (H1 : P)
          (H2 : P →(P → Q)) : Q :=
    show Q,
    from (H2 H1 (show P,
                from (H1))).

lemma exD : (P ∧ Q) → P :=
      assume H : P ∧ Q,
      (and.elim_left H).

lemma exE (H : P) : Q → P ∧ Q :=
      assume H1 : Q,
      and.intro
      H -- P
      H1. -- Q


/-
Copyright (c) 2022 Alice Laroche. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Alice Laroche, Frédéric Dupuis, Jireh Loreaux
-/

import Mathlib.Tactic.PushNeg
import Mathlib.Init.Algebra.Order

variable {α β : Type} [LinearOrder β] {p q : Prop} {p' q' : α → Prop}

example : (¬p ∧ ¬q) → ¬(p ∨ q) := by
  intro h
  push_neg
  guard_target = ¬p ∧ ¬q
  exact h

example : ¬(p ∧ q) → (p → ¬q) := by
  intro h
  push_neg at h
  guard_hyp h : p → ¬q
  exact h

example : (∀(x : α), ¬ p' x) → ¬ ∃(x : α), p' x:= by
  intro h
  push_neg
  guard_target = ∀ (x : α), ¬p' x
  exact h

example : (¬ ∀(x : α), p' x) → (∃(x : α), ¬ p' x) :=by
  intro h
  push_neg at h
  guard_hyp h : ∃ (x : α), ¬p' x
  exact h

example (p : Bool) : decide (¬ ¬ p) = p := by
  push_neg
  guard_target = decide p = p
  cases p <;> rfl

example : ((fun x => x+x) 1) = 2 := by
  push_neg
  guard_target = 1 + 1 = 2
  simp

example : ¬ ¬ p = p := by
  push_neg
  guard_target = p = p
  rfl

example (x y : β) (h : y < x) : ¬(x ≤ y) := by
  push_neg
  guard_target = y < x
  exact h

example (x y : α) (h : x = y) : ¬ (x ≠ y) := by
  push_neg
  guard_target = x = y
  exact h

example : ¬∃ (y : Unit), (y ≠ ()) := by
  push_neg
  guard_target = ∀ (y : Unit), y = ()
  simp

example (h : ∃ y : Nat, ¬(y=1)): ¬∀ (y : Nat), (y = 1) := by
  push_neg
  guard_target = ∃ (y : Nat), y ≠ 1
  exact h

example (x y : β) (h : y < x) : ¬¬¬ (x ≤ y) := by
  push_neg
  guard_target = y < x
  exact h

example (x y : β) (h₁ : ¬¬¬(x < y)) (h₂ : ¬∃ (x y : Nat), x = y) : ¬ ∀(x y : Nat), x = y := by
  push_neg at *
  guard_target = ∃ (x y : Nat), x ≠ y
  guard_hyp h₁ : y ≤ x
  guard_hyp h₂ : ∀ (x y : Nat), x ≠ y
  exact ⟨0, 1, by simp⟩

example (x y : β) (h₁ : ¬¬¬(x < y)) (h₂ : ¬∃ (x y : Nat), x = y) : ¬ ∀(x y : Nat), x = y := by
  push_neg at h₁ h₂ ⊢
  guard_target = ∃ (x y : Nat), x ≠ y
  guard_hyp h₁ : y ≤ x
  guard_hyp h₂ : ∀ (x y : Nat), x ≠ y
  exact ⟨0, 1, by simp⟩

example (h : p → ¬ q) : ¬ (p ∧ q) := by
  push_neg
  guard_target = p → ¬q
  exact h

example (a : β) : ¬ ∀ x : β, x < a → ∃ y : β, (y < a) ∧ ∀ z : β, x = z := by
  push_neg
  guard_target = ∃ x, x < a ∧ ∀ (y : β), y < a → ∃ z, x ≠ z
  sorry

example {α} [Preorder α] (m n : α) (h : ¬(∃ k : α, m ≤ k)) (h₂ : m ≤ n) : m ≤ n := by
  push_neg at h
  guard_hyp h : ∀ k, ¬(m ≤ k)
  exact h₂

example {α} [Preorder α] (m n : α) (h : ¬(∃ k : α, m < k)) (h₂ : m ≤ n) : m ≤ n := by
  push_neg at h
  guard_hyp h : ∀ k, ¬(m < k)
  exact h₂

set_option push_neg.use_distrib true

example (h : ¬ p ∨ ¬ q): ¬ (p ∧ q) := by
  push_neg
  guard_target = ¬p ∨ ¬q
  exact h

example : p →  ¬ ¬ ¬ ¬ ¬ ¬ p := by
  push_neg
  guard_target = p → p
  exact id

example (h : x = 0 ∧ y ≠ 0) : ¬(x = 0 → y = 0) := by
  push_neg
  guard_target = x = 0 ∧ y ≠ 0
  exact h


/-
Copyright (c) 2018 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import data.fintype.basic
import tactic.norm_num

/-!
# Case bash

This file provides the tactic `fin_cases`. `fin_cases x` performs case analysis on `x`, that is
creates one goal for each possible value of `x`, where either:
* `x : α`, where `[fintype α]`
* `x ∈ A`, where `A : finset α`, `A : multiset α` or `A : list α`.
-/

namespace tactic

open expr
open conv.interactive

/-- Checks that the expression looks like `x ∈ A` for `A : finset α`, `multiset α` or `A : list α`,
    and returns the type α. -/
meta def guard_mem_fin (e : expr) : tactic expr :=
do t ← infer_type e,
   α ← mk_mvar,
   to_expr ``(_ ∈ (_ : finset %%α))   tt ff >>= unify t <|>
   to_expr ``(_ ∈ (_ : multiset %%α)) tt ff >>= unify t <|>
   to_expr ``(_ ∈ (_ : list %%α))     tt ff >>= unify t,
   instantiate_mvars α

/--
`expr_list_to_list_expr` converts an `expr` of type `list α`
to a list of `expr`s each with type `α`.

TODO: this should be moved, and possibly duplicates an existing definition.
-/
meta def expr_list_to_list_expr : Π (e : expr), tactic (list expr)
| `(list.cons %%h %%t) := list.cons h <$> expr_list_to_list_expr t
| `([]) := return []
| _ := failed

private meta def fin_cases_at_aux : Π (with_list : list expr) (e : expr), tactic unit
| with_list e :=
(do
  result ← cases_core e,
  match result with
  -- We have a goal with an equation `s`, and a second goal with a smaller `e : x ∈ _`.
  | [(_, [s], _), (_, [e], _)] :=
    do let sn := local_pp_name s,
        ng ← num_goals,
        -- tidy up the new value
        match with_list.nth 0 with
        -- If an explicit value was specified via the `with` keyword, use that.
        | (some h) := tactic.interactive.conv (some sn) none
                        (to_rhs >> conv.interactive.change (to_pexpr h))
        -- Otherwise, call `norm_num`. We let `norm_num` unfold `max` and `min`
        -- because it's helpful for the `interval_cases` tactic.
        | _ := try $ tactic.interactive.conv (some sn) none $
               to_rhs >> conv.interactive.norm_num
                 [simp_arg_type.expr ``(max_def'), simp_arg_type.expr ``(min_def)]
        end,
        s ← get_local sn,
        try `[subst %%s],
        ng' ← num_goals,
        when (ng = ng') (rotate_left 1),
        fin_cases_at_aux with_list.tail e
  -- No cases; we're done.
  | [] := skip
  | _ := failed
  end)

/--
`fin_cases_at with_list e` performs case analysis on `e : α`, where `α` is a fintype.
The optional list of expressions `with_list` provides descriptions for the cases of `e`,
for example, to display nats as `n.succ` instead of `n+1`.
These should be defeq to and in the same order as the terms in the enumeration of `α`.
-/
meta def fin_cases_at (nm : option name) : Π (with_list : option pexpr) (e : expr), tactic unit
| with_list e := focus1 $
  do ty ← try_core $ guard_mem_fin e,
    match ty with
    | none := -- Deal with `x : A`, where `[fintype A]` is available:
      (do
        ty ← infer_type e,
        i ← to_expr ``(fintype %%ty) >>= mk_instance <|> fail "Failed to find `fintype` instance.",
        t ← to_expr ``(%%e ∈ @fintype.elems %%ty %%i),
        v ← to_expr ``(@fintype.complete %%ty %%i %%e),
        h ← assertv (nm.get_or_else `this) t v,
        fin_cases_at with_list h)
    | (some ty) := -- Deal with `x ∈ A` hypotheses:
      (do
        with_list ← match with_list with
        | (some e) := do e ← to_expr ``(%%e : list %%ty), expr_list_to_list_expr e
        | none := return []
        end,
        fin_cases_at_aux with_list e)
    end

namespace interactive

setup_tactic_parser
private meta def hyp := tk "*" *> return none <|> some <$> ident

/--
`fin_cases h` performs case analysis on a hypothesis of the form
`h : A`, where `[fintype A]` is available, or
`h : a ∈ A`, where `A : finset X`, `A : multiset X` or `A : list X`.

`fin_cases *` performs case analysis on all suitable hypotheses.

As an example, in
```
example (f : ℕ → Prop) (p : fin 3) (h0 : f 0) (h1 : f 1) (h2 : f 2) : f p.val :=
begin
  fin_cases *; simp,
  all_goals { assumption }
end
```
after `fin_cases p; simp`, there are three goals, `f 0`, `f 1`, and `f 2`.

`fin_cases h with l` takes a list of descriptions for the cases of `h`.
These should be definitionally equal to and in the same order as the
default enumeration of the cases.

For example,
```
example (x y : ℕ) (h : x ∈ [1, 2]) : x = y :=
begin
  fin_cases h with [1, 1+1],
end
```
produces two cases: `1 = y` and `1 + 1 = y`.

When using `fin_cases a` on data `a` defined with `let`,
the tactic will not be able to clear the variable `a`,
and will instead produce hypotheses `this : a = ...`.
These hypotheses can be given a name using `fin_cases a using ha`.

For example,
```
example (f : ℕ → fin 3) : true :=
begin
  let a := f 3,
  fin_cases a using ha,
end
```
produces three goals with hypotheses
`ha : a = 0`, `ha : a = 1`, and `ha : a = 2`.
-/
meta def fin_cases :
  parse hyp → parse (tk "with" *> texpr)? → parse (tk "using" *> ident)? → tactic unit
| none none nm := do
    ctx ← local_context,
    ctx.mfirst (fin_cases_at nm none) <|>
      fail ("No hypothesis of the forms `x ∈ A`, where " ++
        "`A : finset X`, `A : list X`, or `A : multiset X`, or `x : A`, with `[fintype A]`.")
| none (some _) _ := fail "Specify a single hypothesis when using a `with` argument."
| (some n) with_list nm :=
  do
    h ← get_local n,
    fin_cases_at nm with_list h

end interactive

add_tactic_doc
{ name       := "fin_cases",
  category   := doc_category.tactic,
  decl_names := [`tactic.interactive.fin_cases],
  tags       := ["case bashing"] }

end tactic


/-
Copyright (c) 2019 Minchao Wu. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Minchao Wu, Chris Hughes
-/
import data.list.basic
/-!
# Minimum and maximum of lists

## Main definitions

The main definitions are `argmax`, `argmin`, `minimum` and `maximum` for lists.

`argmax f l` returns `some a`, where `a` of `l` that maximises `f a`. If there are `a b` such that
  `f a = f b`, it returns whichever of `a` or `b` comes first in the list.
  `argmax f []` = none`

`minimum l` returns an `with_top α`, the smallest element of `l` for nonempty lists, and `⊤` for
`[]`
-/
namespace list
variables {α : Type*} {β : Type*} [linear_order β]

/-- Auxiliary definition to define `argmax` -/
def argmax₂ (f : α → β) (a : option α) (b : α) : option α :=
option.cases_on a (some b) (λ c, if f b ≤ f c then some c else some b)

/-- `argmax f l` returns `some a`, where `a` of `l` that maximises `f a`. If there are `a b` such
that `f a = f b`, it returns whichever of `a` or `b` comes first in the list.
`argmax f []` = none` -/
def argmax (f : α → β) (l : list α) : option α :=
l.foldl (argmax₂ f) none

/-- `argmin f l` returns `some a`, where `a` of `l` that minimises `f a`. If there are `a b` such
that `f a = f b`, it returns whichever of `a` or `b` comes first in the list.
`argmin f []` = none` -/
def argmin (f : α → β) (l : list α) :=
@argmax _ (order_dual β) _ f l

@[simp] lemma argmax_two_self (f : α → β) (a : α) : argmax₂ f (some a) a = a :=
if_pos (le_refl _)

@[simp] lemma argmax_nil (f : α → β) : argmax f [] = none := rfl

@[simp] lemma argmin_nil (f : α → β) : argmin f [] = none := rfl

@[simp] lemma argmax_singleton {f : α → β} {a : α} : argmax f [a] = some a := rfl

@[simp] lemma argmin_singleton {f : α → β} {a : α} : argmin f [a] = a := rfl

@[simp] lemma foldl_argmax₂_eq_none {f : α → β} {l : list α} {o : option α} :
  l.foldl (argmax₂ f) o = none ↔ l = [] ∧ o = none :=
list.reverse_rec_on l (by simp) $
  (assume tl hd, by simp [argmax₂];
    cases foldl (argmax₂ f) o tl; simp; try {split_ifs}; simp)

private theorem le_of_foldl_argmax₂ {f : α → β} {l} : Π {a m : α} {o : option α}, a ∈ l →
  m ∈ foldl (argmax₂ f) o l → f a ≤ f m :=
list.reverse_rec_on l
  (λ _ _ _ h, absurd h $ not_mem_nil _)
  begin
    intros tl _ ih _ _ _ h ho,
    rw [foldl_append, foldl_cons, foldl_nil, argmax₂] at ho,
    cases hf : foldl (argmax₂ f) o tl,
    { rw [hf] at ho,
      rw [foldl_argmax₂_eq_none] at hf,
      simp [hf.1, hf.2, *] at * },
    rw [hf, option.mem_def] at ho,
    dsimp only at ho,
    cases mem_append.1 h with h h,
    { refine le_trans (ih h hf) _,
      have := @le_of_lt _ _ (f val) (f m),
      split_ifs at ho;
      simp * at * },
    { split_ifs at ho;
      simp * at * }
  end

private theorem foldl_argmax₂_mem (f : α → β) (l) : Π (a m : α),
  m ∈ foldl (argmax₂ f) (some a) l → m ∈ a :: l :=
list.reverse_rec_on l (by simp [eq_comm])
  begin
    assume tl hd ih a m,
    simp only [foldl_append, foldl_cons, foldl_nil, argmax₂],
    cases hf : foldl (argmax₂ f) (some a) tl,
    { simp {contextual := tt} },
    { dsimp only, split_ifs,
      { finish [ih _ _ hf] },
      { simp {contextual := tt} } }
  end

theorem argmax_mem {f : α → β} : Π {l : list α} {m : α}, m ∈ argmax f l → m ∈ l
| [] m       := by simp
| (hd::tl) m := by simpa [argmax, argmax₂] using foldl_argmax₂_mem f tl hd m

theorem argmin_mem {f : α → β} : Π {l : list α} {m : α}, m ∈ argmin f l → m ∈ l :=
@argmax_mem _ (order_dual β) _ _

@[simp] theorem argmax_eq_none {f : α → β} {l : list α} : l.argmax f = none ↔ l = [] :=
by simp [argmax]

@[simp] theorem argmin_eq_none {f : α → β} {l : list α} : l.argmin f = none ↔ l = [] :=
@argmax_eq_none _ (order_dual β) _ _ _

theorem le_argmax_of_mem {f : α → β} {a m : α} {l : list α} : a ∈ l → m ∈ argmax f l → f a ≤ f m :=
le_of_foldl_argmax₂

theorem argmin_le_of_mem {f : α → β} {a m : α} {l : list α} : a ∈ l → m ∈ argmin f l → f m ≤ f a:=
@le_argmax_of_mem _ (order_dual β) _ _ _ _ _

theorem argmax_concat (f : α → β) (a : α) (l : list α) : argmax f (l ++ [a]) =
  option.cases_on (argmax f l) (some a) (λ c, if f a ≤ f c then some c else some a) :=
by rw [argmax, argmax]; simp [argmax₂]

theorem argmin_concat (f : α → β) (a : α) (l : list α) : argmin f (l ++ [a]) =
  option.cases_on (argmin f l) (some a) (λ c, if f c ≤ f a then some c else some a) :=
@argmax_concat _ (order_dual β) _ _ _ _

theorem argmax_cons (f : α → β) (a : α) (l : list α) : argmax f (a :: l) =
  option.cases_on (argmax f l) (some a) (λ c, if f c ≤ f a then some a else some c) :=
list.reverse_rec_on l rfl $
  assume hd tl ih,  begin
    rw [← cons_append, argmax_concat, ih, argmax_concat],
    cases h : argmax f hd with m,
    { simp [h] },
    { simp [h], dsimp,
      by_cases ham : f m ≤ f a,
      { rw if_pos ham, dsimp,
        by_cases htlm : f tl ≤ f m,
        { rw if_pos htlm, dsimp,
          rw [if_pos (le_trans htlm ham), if_pos ham] },
        { rw if_neg htlm } },
      { rw if_neg ham, dsimp,
        by_cases htlm : f tl ≤ f m,
        { rw if_pos htlm, dsimp,
          rw if_neg ham },
        { rw if_neg htlm, dsimp,
          rw [if_neg (not_le_of_gt (lt_trans (lt_of_not_ge ham) (lt_of_not_ge htlm)))] } } }
  end

theorem argmin_cons (f : α → β) (a : α) (l : list α) : argmin f (a :: l) =
  option.cases_on (argmin f l) (some a) (λ c, if f a ≤ f c then some a else some c) :=
@argmax_cons _ (order_dual β) _ _ _ _

theorem index_of_argmax [decidable_eq α] {f : α → β} : Π {l : list α} {m : α}, m ∈ argmax f l →
  ∀ {a}, a ∈ l → f m ≤ f a → l.index_of m ≤ l.index_of a
| []       m _  _ _  _   := by simp
| (hd::tl) m hm a ha ham := begin
  simp only [index_of_cons, argmax_cons, option.mem_def] at ⊢ hm,
  cases h : argmax f tl,
  { rw h at hm,
    simp * at * },
  { rw h at hm,
    dsimp only at hm,
    cases ha with hahd hatl,
    { clear index_of_argmax,
      subst hahd,
      split_ifs at hm,
      { subst hm },
      { subst hm, contradiction } },
    { have := index_of_argmax h hatl, clear index_of_argmax,
      split_ifs at *;
      refl <|> exact nat.zero_le _ <|> simp [*, nat.succ_le_succ_iff, -not_le] at * } }
end

theorem index_of_argmin [decidable_eq α] {f : α → β} : Π {l : list α} {m : α}, m ∈ argmin f l →
  ∀ {a}, a ∈ l → f a ≤ f m → l.index_of m ≤ l.index_of a :=
@index_of_argmax _ (order_dual β) _ _ _

theorem mem_argmax_iff [decidable_eq α] {f : α → β} {m : α} {l : list α} :
  m ∈ argmax f l ↔ m ∈ l ∧ (∀ a ∈ l, f a ≤ f m) ∧
    (∀ a ∈ l, f m ≤ f a → l.index_of m ≤ l.index_of a) :=
⟨λ hm, ⟨argmax_mem hm, λ a ha, le_argmax_of_mem ha hm, λ _, index_of_argmax hm⟩,
  begin
    rintros ⟨hml, ham, hma⟩,
    cases harg : argmax f l with n,
    { simp * at * },
    { have := le_antisymm (hma n (argmax_mem harg) (le_argmax_of_mem hml harg))
        (index_of_argmax harg hml (ham _ (argmax_mem harg))),
      rw [(index_of_inj hml (argmax_mem harg)).1 this, option.mem_def] }
  end⟩

theorem argmax_eq_some_iff [decidable_eq α] {f : α → β} {m : α} {l : list α} :
  argmax f l = some m ↔ m ∈ l ∧ (∀ a ∈ l, f a ≤ f m) ∧
    (∀ a ∈ l, f m ≤ f a → l.index_of m ≤ l.index_of a) := mem_argmax_iff

theorem mem_argmin_iff [decidable_eq α] {f : α → β} {m : α} {l : list α} :
  m ∈ argmin f l ↔ m ∈ l ∧ (∀ a ∈ l, f m ≤ f a) ∧
    (∀ a ∈ l, f a ≤ f m → l.index_of m ≤ l.index_of a) :=
@mem_argmax_iff _ (order_dual β) _ _ _ _ _

theorem argmin_eq_some_iff [decidable_eq α] {f : α → β} {m : α} {l : list α} :
  argmin f l = some m ↔ m ∈ l ∧ (∀ a ∈ l, f m ≤ f a) ∧
    (∀ a ∈ l, f a ≤ f m → l.index_of m ≤ l.index_of a) := mem_argmin_iff

variable [linear_order α]

/-- `maximum l` returns an `with_bot α`, the largest element of `l` for nonempty lists, and `⊥` for
`[]`  -/
def maximum (l : list α) : with_bot α := argmax id l

/-- `minimum l` returns an `with_top α`, the smallest element of `l` for nonempty lists, and `⊤` for
`[]`  -/
def minimum (l : list α) : with_top α := argmin id l

@[simp] lemma maximum_nil : maximum ([] : list α) = ⊥ := rfl

@[simp] lemma minimum_nil : minimum ([] : list α) = ⊤ := rfl

@[simp] lemma maximum_singleton (a : α) : maximum [a] = a := rfl

@[simp] lemma minimum_singleton (a : α) : minimum [a] = a := rfl

theorem maximum_mem {l : list α} {m : α} : (maximum l : with_top α) = m → m ∈ l := argmax_mem

theorem minimum_mem {l : list α} {m : α} : (minimum l : with_bot α) = m → m ∈ l := argmin_mem

@[simp] theorem maximum_eq_none {l : list α} : l.maximum = none ↔ l = [] := argmax_eq_none

@[simp] theorem minimum_eq_none {l : list α} : l.minimum = none ↔ l = [] := argmin_eq_none

theorem minimum_le_of_mem {a m : α} {l : list α} : a ∈ l → (minimum l : with_top α) = m → m ≤ a :=
argmin_le_of_mem

theorem le_maximum_of_mem' {a : α} {l : list α} (ha : a ∈ l) : (a : with_bot α) ≤ maximum l :=
option.cases_on (maximum l) (λ _ h, absurd ha ((h rfl).symm ▸ not_mem_nil _))
  (λ m hm _, with_bot.coe_le_coe.2 $ hm _ rfl)
  (λ m, @le_maximum_of_mem _ _ _ m _ ha)
  (@maximum_eq_none _ _ l).1

theorem le_minimum_of_mem' {a : α} {l : list α} (ha : a ∈ l) : minimum l ≤ (a : with_top α) :=
@le_maximum_of_mem' (order_dual α) _ _ _ ha

theorem maximum_concat (a : α) (l : list α) : maximum (l ++ [a]) = max (maximum l) a :=
begin
  rw max_comm,
  simp only [maximum, argmax_concat, id],
  cases h : argmax id l,
  { rw [max_eq_left], refl, exact bot_le },
  change (coe : α → with_bot α) with some,
  rw [max_comm],
  simp [max]
end

theorem minimum_concat (a : α) (l : list α) : minimum (l ++ [a]) = min (minimum l) a :=
@maximum_concat (order_dual α) _ _ _

theorem maximum_cons (a : α) (l : list α) : maximum (a :: l) = max a (maximum l) :=
list.reverse_rec_on l (by simp [@max_eq_left (with_bot α) _ _ _ bot_le])
  (λ tl hd ih, by rw [← cons_append, maximum_concat, ih, maximum_concat, max_assoc])

theorem minimum_cons (a : α) (l : list α) : minimum (a :: l) = min a (minimum l) :=
@maximum_cons (order_dual α) _ _ _

theorem maximum_eq_coe_iff {m : α} {l : list α} :
  maximum l = m ↔ m ∈ l ∧ (∀ a ∈ l, a ≤ m) :=
begin
  unfold_coes,
  simp only [maximum, argmax_eq_some_iff, id],
  split,
  { simp only [true_and, forall_true_iff] {contextual := tt} },
  { simp only [true_and, forall_true_iff] {contextual := tt},
    intros h a hal hma,
    rw [le_antisymm hma (h.2 a hal)] }
end

theorem minimum_eq_coe_iff {m : α} {l : list α} :
  minimum l = m ↔ m ∈ l ∧ (∀ a ∈ l, m ≤ a) :=
@maximum_eq_coe_iff (order_dual α) _ _ _

end list


/-
Copyright (c) 2019 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Benjamin Davidson

The `even` and `odd` predicates on the integers.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.int.modeq
import Mathlib.data.nat.parity
import Mathlib.PostPort

namespace Mathlib

namespace int

@[simp] theorem mod_two_ne_one {n : ℤ} : ¬n % bit0 1 = 1 ↔ n % bit0 1 = 0 := sorry

theorem mod_two_ne_zero {n : ℤ} : ¬n % bit0 1 = 0 ↔ n % bit0 1 = 1 := sorry

@[simp] theorem even_coe_nat (n : ℕ) : even ↑n ↔ even n := sorry

theorem even_iff {n : ℤ} : even n ↔ n % bit0 1 = 0 := sorry

theorem odd_iff {n : ℤ} : odd n ↔ n % bit0 1 = 1 := sorry

theorem not_even_iff {n : ℤ} : ¬even n ↔ n % bit0 1 = 1 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (¬even n ↔ n % bit0 1 = 1)) (propext even_iff)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (¬n % bit0 1 = 0 ↔ n % bit0 1 = 1)) (propext mod_two_ne_zero)))
      (iff.refl (n % bit0 1 = 1)))

theorem not_odd_iff {n : ℤ} : ¬odd n ↔ n % bit0 1 = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (¬odd n ↔ n % bit0 1 = 0)) (propext odd_iff)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (¬n % bit0 1 = 1 ↔ n % bit0 1 = 0)) (propext mod_two_ne_one)))
      (iff.refl (n % bit0 1 = 0)))

theorem even_iff_not_odd {n : ℤ} : even n ↔ ¬odd n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (even n ↔ ¬odd n)) (propext not_odd_iff)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (even n ↔ n % bit0 1 = 0)) (propext even_iff)))
      (iff.refl (n % bit0 1 = 0)))

@[simp] theorem odd_iff_not_even {n : ℤ} : odd n ↔ ¬even n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (odd n ↔ ¬even n)) (propext not_even_iff)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (odd n ↔ n % bit0 1 = 1)) (propext odd_iff)))
      (iff.refl (n % bit0 1 = 1)))

theorem even_or_odd (n : ℤ) : even n ∨ odd n :=
  or.imp_right (iff.mpr odd_iff_not_even) (em (even n))

theorem even_or_odd' (n : ℤ) : ∃ (k : ℤ), n = bit0 1 * k ∨ n = bit0 1 * k + 1 := sorry

theorem even_xor_odd (n : ℤ) : xor (even n) (odd n) :=
  or.dcases_on (even_or_odd n)
    (fun (h : even n) => Or.inl { left := h, right := iff.mp even_iff_not_odd h })
    fun (h : odd n) => Or.inr { left := h, right := iff.mp odd_iff_not_even h }

theorem even_xor_odd' (n : ℤ) : ∃ (k : ℤ), xor (n = bit0 1 * k) (n = bit0 1 * k + 1) := sorry

theorem ne_of_odd_sum {x : ℤ} {y : ℤ} (h : odd (x + y)) : x ≠ y := sorry

@[simp] theorem two_dvd_ne_zero {n : ℤ} : ¬bit0 1 ∣ n ↔ n % bit0 1 = 1 := not_even_iff

protected instance even.decidable_pred : decidable_pred even :=
  fun (n : ℤ) => decidable_of_decidable_of_iff (int.decidable_eq (n % bit0 1) 0) sorry

protected instance decidable_pred_odd : decidable_pred odd :=
  fun (n : ℤ) => decidable_of_decidable_of_iff not.decidable sorry

@[simp] theorem even_zero : even 0 := Exists.intro 0 (of_as_true trivial)

@[simp] theorem not_even_one : ¬even 1 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (¬even 1)) (propext even_iff))) one_ne_zero

@[simp] theorem even_bit0 (n : ℤ) : even (bit0 n) :=
  Exists.intro n
    (eq.mpr (id (Eq._oldrec (Eq.refl (bit0 n = bit0 1 * n)) (bit0.equations._eqn_1 n)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (n + n = bit0 1 * n)) (two_mul n))) (Eq.refl (n + n))))

theorem even_add {m : ℤ} {n : ℤ} : even (m + n) ↔ (even m ↔ even n) := sorry

theorem even_neg {n : ℤ} : even (-n) ↔ even n := sorry

@[simp] theorem not_even_bit1 (n : ℤ) : ¬even (bit1 n) := sorry

theorem even_sub {m : ℤ} {n : ℤ} : even (m - n) ↔ (even m ↔ even n) := sorry

theorem even_mul {m : ℤ} {n : ℤ} : even (m * n) ↔ even m ∨ even n := sorry

theorem even_pow {m : ℤ} {n : ℕ} : even (m ^ n) ↔ even m ∧ n ≠ 0 := sorry

end Mathlib


/-
Copyright (c) 2021 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov

! This file was ported from Lean 3 source module analysis.box_integral.partition.filter
! leanprover-community/mathlib commit 92ca63f0fb391a9ca5f22d2409a6080e786d99f7
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.BoxIntegral.Partition.SubboxInduction
import Mathbin.Analysis.BoxIntegral.Partition.Split

/-!
# Filters used in box-based integrals

First we define a structure `box_integral.integration_params`. This structure will be used as an
argument in the definition of `box_integral.integral` in order to use the same definition for a few
well-known definitions of integrals based on partitions of a rectangular box into subboxes (Riemann
integral, Henstock-Kurzweil integral, and McShane integral).

This structure holds three boolean values (see below), and encodes eight different sets of
parameters; only four of these values are used somewhere in `mathlib`. Three of them correspond to
the integration theories listed above, and one is a generalization of the one-dimensional
Henstock-Kurzweil integral such that the divergence theorem works without additional integrability
assumptions.

Finally, for each set of parameters `l : box_integral.integration_params` and a rectangular box
`I : box_integral.box ι`, we define several `filter`s that will be used either in the definition of
the corresponding integral, or in the proofs of its properties. We equip
`box_integral.integration_params` with a `bounded_order` structure such that larger
`integration_params` produce larger filters.

## Main definitions

### Integration parameters

The structure `box_integral.integration_params` has 3 boolean fields with the following meaning:

* `bRiemann`: the value `tt` means that the filter corresponds to a Riemann-style integral, i.e. in
  the definition of integrability we require a constant upper estimate `r` on the size of boxes of a
  tagged partition; the value `ff` means that the estimate may depend on the position of the tag.

* `bHenstock`: the value `tt` means that we require that each tag belongs to its own closed box; the
  value `ff` means that we only require that tags belong to the ambient box.

* `bDistortion`: the value `tt` means that `r` can depend on the maximal ratio of sides of the same
  box of a partition. Presence of this case make quite a few proofs harder but we can prove the
  divergence theorem only for the filter
  `box_integral.integration_params.GP = ⊥ = {bRiemann := ff, bHenstock := tt, bDistortion := tt}`.

### Well-known sets of parameters

Out of eight possible values of `box_integral.integration_params`, the following four are used in
the library.

* `box_integral.integration_params.Riemann` (`bRiemann = tt`, `bHenstock = tt`, `bDistortion = ff`):
  this value corresponds to the Riemann integral; in the corresponding filter, we require that the
  diameters of all boxes `J` of a tagged partition are bounded from above by a constant upper
  estimate that may not depend on the geometry of `J`, and each tag belongs to the corresponding
  closed box.

* `box_integral.integration_params.Henstock` (`bRiemann = ff`, `bHenstock = tt`,
  `bDistortion = ff`): this value corresponds to the most natural generalization of
  Henstock-Kurzweil integral to higher dimension; the only (but important!) difference between this
  theory and Riemann integral is that instead of a constant upper estimate on the size of all boxes
  of a partition, we require that the partition is *subordinate* to a possibly discontinuous
  function `r : (ι → ℝ) → {x : ℝ | 0 < x}`, i.e. each box `J` is included in a closed ball with
  center `π.tag J` and radius `r J`.

* `box_integral.integration_params.McShane` (`bRiemann = ff`, `bHenstock = ff`, `bDistortion = ff`):
  this value corresponds to the McShane integral; the only difference with the Henstock integral is
  that we allow tags to be outside of their boxes; the tags still have to be in the ambient closed
  box, and the partition still has to be subordinate to a function.

* `box_integral.integration_params.GP = ⊥` (`bRiemann = ff`, `bHenstock = tt`, `bDistortion = tt`):
  this is the least integration theory in our list, i.e., all functions integrable in any other
  theory is integrable in this one as well.  This is a non-standard generalization of the
  Henstock-Kurzweil integral to higher dimension.  In dimension one, it generates the same filter as
  `Henstock`. In higher dimension, this generalization defines an integration theory such that the
  divergence of any Fréchet differentiable function `f` is integrable, and its integral is equal to
  the sum of integrals of `f` over the faces of the box, taken with appropriate signs.

  A function `f` is `GP`-integrable if for any `ε > 0` and `c : ℝ≥0` there exists
  `r : (ι → ℝ) → {x : ℝ | 0 < x}` such that for any tagged partition `π` subordinate to `r`, if each
  tag belongs to the corresponding closed box and for each box `J ∈ π`, the maximal ratio of its
  sides is less than or equal to `c`, then the integral sum of `f` over `π` is `ε`-close to the
  integral.

### Filters and predicates on `tagged_prepartition I`

For each value of `integration_params` and a rectangular box `I`, we define a few filters on
`tagged_prepartition I`. First, we define a predicate

```
structure box_integral.integration_params.mem_base_set (l : box_integral.integration_params)
  (I : box_integral.box ι) (c : ℝ≥0) (r : (ι → ℝ) → Ioi (0 : ℝ))
  (π : box_integral.tagged_prepartition I) : Prop :=
```

This predicate says that

* if `l.bHenstock`, then `π` is a Henstock prepartition, i.e. each tag belongs to the corresponding
  closed box;
* `π` is subordinate to `r`;
* if `l.bDistortion`, then the distortion of each box in `π` is less than or equal to `c`;
* if `l.bDistortion`, then there exists a prepartition `π'` with distortion `≤ c` that covers
  exactly `I \ π.Union`.

The last condition is always true for `c > 1`, see TODO section for more details.

Then we define a predicate `box_integral.integration_params.r_cond` on functions
`r : (ι → ℝ) → {x : ℝ | 0 < x}`. If `l.bRiemann`, then this predicate requires `r` to be a constant
function, otherwise it imposes no restrictions on `r`. We introduce this definition to prove a few
dot-notation lemmas: e.g., `box_integral.integration_params.r_cond.min` says that the pointwise
minimum of two functions that satisfy this condition satisfies this condition as well.

Then we define four filters on `box_integral.tagged_prepartition I`.

* `box_integral.integration_params.to_filter_distortion`: an auxiliary filter that takes parameters
  `(l : box_integral.integration_params) (I : box_integral.box ι) (c : ℝ≥0)` and returns the
  filter generated by all sets `{π | mem_base_set l I c r π}`, where `r` is a function satisfying
  the predicate `box_integral.integration_params.r_cond l`;

* `box_integral.integration_params.to_filter l I`: the supremum of `l.to_filter_distortion I c`
  over all `c : ℝ≥0`;

* `box_integral.integration_params.to_filter_distortion_Union l I c π₀`, where `π₀` is a
  prepartition of `I`: the infimum of `l.to_filter_distortion I c` and the principal filter
  generated by `{π | π.Union = π₀.Union}`;

* `box_integral.integration_params.to_filter_Union l I π₀`: the supremum of
  `l.to_filter_distortion_Union l I c π₀` over all `c : ℝ≥0`. This is the filter (in the case
  `π₀ = ⊤` is the one-box partition of `I`) used in the definition of the integral of a function
  over a box.

## Implementation details

* Later we define the integral of a function over a rectangular box as the limit (if it exists) of
  the integral sums along `box_integral.integration_params.to_filter_Union l I ⊤`. While it is
  possible to define the integral with a general filter on `box_integral.tagged_prepartition I` as a
  parameter, many lemmas (e.g., Sacks-Henstock lemma and most results about integrability of
  functions) require the filter to have a predictable structure. So, instead of adding assumptions
  about the filter here and there, we define this auxiliary type that can encode all integration
  theories we need in practice.

* While the definition of the integral only uses the filter
  `box_integral.integration_params.to_filter_Union l I ⊤` and partitions of a box, some lemmas
  (e.g., the Henstock-Sacks lemmas) are best formulated in terms of the predicate `mem_base_set` and
  other filters defined above.

* We use `bool` instead of `Prop` for the fields of `integration_params` in order to have decidable
  equality and inequalities.

## TODO

Currently, `box_integral.integration_params.mem_base_set` explicitly requires that there exists a
partition of the complement `I \ π.Union` with distortion `≤ c`. For `c > 1`, this condition is
always true but the proof of this fact requires more API about
`box_integral.prepartition.split_many`. We should formalize this fact, then either require `c > 1`
everywhere, or replace `≤ c` with `< c` so that we automatically get `c > 1` for a non-trivial
prepartition (and consider the special case `π = ⊥` separately if needed).

## Tags

integral, rectangular box, partition, filter
-/

open Set Function Filter Metric Finset Bool

open Classical Topology Filter NNReal

noncomputable section

namespace BoxIntegral

variable {ι : Type _} [Fintype ι] {I J : Box ι} {c c₁ c₂ : ℝ≥0} {r r₁ r₂ : (ι → ℝ) → Ioi (0 : ℝ)}
  {π π₁ π₂ : TaggedPrepartition I}

open TaggedPrepartition

/-- An `integration_params` is a structure holding 3 boolean values used to define a filter to be
used in the definition of a box-integrable function.

* `bRiemann`: the value `tt` means that the filter corresponds to a Riemann-style integral, i.e. in
  the definition of integrability we require a constant upper estimate `r` on the size of boxes of a
  tagged partition; the value `ff` means that the estimate may depend on the position of the tag.

* `bHenstock`: the value `tt` means that we require that each tag belongs to its own closed box; the
  value `ff` means that we only require that tags belong to the ambient box.

* `bDistortion`: the value `tt` means that `r` can depend on the maximal ratio of sides of the same
  box of a partition. Presence of this case makes quite a few proofs harder but we can prove the
  divergence theorem only for the filter
  `box_integral.integration_params.GP = ⊥ = {bRiemann := ff, bHenstock := tt, bDistortion := tt}`.
-/
@[ext]
structure IntegrationParams : Type where
  (bRiemann bHenstock bDistortion : Bool)
#align box_integral.integration_params BoxIntegral.IntegrationParams

variable {l l₁ l₂ : IntegrationParams}

namespace IntegrationParams

/-- Auxiliary equivalence with a product type used to lift an order. -/
def equivProd : IntegrationParams ≃ Bool × Boolᵒᵈ × Boolᵒᵈ
    where
  toFun l := ⟨l.1, OrderDual.toDual l.2, OrderDual.toDual l.3⟩
  invFun l := ⟨l.1, OrderDual.ofDual l.2.1, OrderDual.ofDual l.2.2⟩
  left_inv := fun ⟨a, b, c⟩ => rfl
  right_inv := fun ⟨a, b, c⟩ => rfl
#align box_integral.integration_params.equiv_prod BoxIntegral.IntegrationParams.equivProd

instance : PartialOrder IntegrationParams :=
  PartialOrder.lift equivProd equivProd.Injective

/-- Auxiliary `order_iso` with a product type used to lift a `bounded_order` structure. -/
def isoProd : IntegrationParams ≃o Bool × Boolᵒᵈ × Boolᵒᵈ :=
  ⟨equivProd, fun ⟨x, y, z⟩ => Iff.rfl⟩
#align box_integral.integration_params.iso_prod BoxIntegral.IntegrationParams.isoProd

instance : BoundedOrder IntegrationParams :=
  isoProd.symm.toGaloisInsertion.liftBoundedOrder

/-- The value
`box_integral.integration_params.GP = ⊥` (`bRiemann = ff`, `bHenstock = tt`, `bDistortion = tt`)
corresponds to a generalization of the Henstock integral such that the Divergence theorem holds true
without additional integrability assumptions, see the module docstring for details. -/
instance : Inhabited IntegrationParams :=
  ⟨⊥⟩

instance : DecidableRel ((· ≤ ·) : IntegrationParams → IntegrationParams → Prop) := fun _ _ =>
  And.decidable

instance : DecidableEq IntegrationParams := fun x y => decidable_of_iff _ (ext_iff x y).symm

/-- The `box_integral.integration_params` corresponding to the Riemann integral. In the
corresponding filter, we require that the diameters of all boxes `J` of a tagged partition are
bounded from above by a constant upper estimate that may not depend on the geometry of `J`, and each
tag belongs to the corresponding closed box. -/
def riemann : IntegrationParams where
  bRiemann := true
  bHenstock := true
  bDistortion := false
#align box_integral.integration_params.Riemann BoxIntegral.IntegrationParams.riemann

/-- The `box_integral.integration_params` corresponding to the Henstock-Kurzweil integral. In the
corresponding filter, we require that the tagged partition is subordinate to a (possibly,
discontinuous) positive function `r` and each tag belongs to the corresponding closed box. -/
def henstock : IntegrationParams :=
  ⟨false, true, false⟩
#align box_integral.integration_params.Henstock BoxIntegral.IntegrationParams.henstock

/-- The `box_integral.integration_params` corresponding to the McShane integral. In the
corresponding filter, we require that the tagged partition is subordinate to a (possibly,
discontinuous) positive function `r`; the tags may be outside of the corresponding closed box
(but still inside the ambient closed box `I.Icc`). -/
def mcShane : IntegrationParams :=
  ⟨false, false, false⟩
#align box_integral.integration_params.McShane BoxIntegral.IntegrationParams.mcShane

/-- The `box_integral.integration_params` corresponding to the generalized Perron integral. In the
corresponding filter, we require that the tagged partition is subordinate to a (possibly,
discontinuous) positive function `r` and each tag belongs to the corresponding closed box. We also
require an upper estimate on the distortion of all boxes of the partition. -/
def gP : IntegrationParams :=
  ⊥
#align box_integral.integration_params.GP BoxIntegral.IntegrationParams.gP

theorem henstock_le_riemann : henstock ≤ riemann := by decide
#align box_integral.integration_params.Henstock_le_Riemann BoxIntegral.IntegrationParams.henstock_le_riemann

theorem henstock_le_mcShane : henstock ≤ mcShane := by decide
#align box_integral.integration_params.Henstock_le_McShane BoxIntegral.IntegrationParams.henstock_le_mcShane

theorem gP_le : gP ≤ l :=
  bot_le
#align box_integral.integration_params.GP_le BoxIntegral.IntegrationParams.gP_le

/-- The predicate corresponding to a base set of the filter defined by an
`integration_params`. It says that

* if `l.bHenstock`, then `π` is a Henstock prepartition, i.e. each tag belongs to the corresponding
  closed box;
* `π` is subordinate to `r`;
* if `l.bDistortion`, then the distortion of each box in `π` is less than or equal to `c`;
* if `l.bDistortion`, then there exists a prepartition `π'` with distortion `≤ c` that covers
  exactly `I \ π.Union`.

The last condition is automatically verified for partitions, and is used in the proof of the
Sacks-Henstock inequality to compare two prepartitions covering the same part of the box.

It is also automatically satisfied for any `c > 1`, see TODO section of the module docstring for
details. -/
@[protect_proj]
structure MemBaseSet (l : IntegrationParams) (I : Box ι) (c : ℝ≥0) (r : (ι → ℝ) → Ioi (0 : ℝ))
  (π : TaggedPrepartition I) : Prop where
  IsSubordinate : π.IsSubordinate r
  IsHenstock : l.bHenstock → π.IsHenstock
  distortion_le : l.bDistortion → π.distortion ≤ c
  exists_compl : l.bDistortion → ∃ π' : Prepartition I, π'.unionᵢ = I \ π.unionᵢ ∧ π'.distortion ≤ c
#align box_integral.integration_params.mem_base_set BoxIntegral.IntegrationParams.MemBaseSet

/-- A predicate saying that in case `l.bRiemann = tt`, the function `r` is a constant. -/
def RCond {ι : Type _} (l : IntegrationParams) (r : (ι → ℝ) → Ioi (0 : ℝ)) : Prop :=
  l.bRiemann → ∀ x, r x = r 0
#align box_integral.integration_params.r_cond BoxIntegral.IntegrationParams.RCond

/-- A set `s : set (tagged_prepartition I)` belongs to `l.to_filter_distortion I c` if there exists
a function `r : ℝⁿ → (0, ∞)` (or a constant `r` if `l.bRiemann = tt`) such that `s` contains each
prepartition `π` such that `l.mem_base_set I c r π`. -/
def toFilterDistortion (l : IntegrationParams) (I : Box ι) (c : ℝ≥0) :
    Filter (TaggedPrepartition I) :=
  ⨅ (r : (ι → ℝ) → Ioi (0 : ℝ)) (hr : l.RCond r), 𝓟 { π | l.MemBaseSet I c r π }
#align box_integral.integration_params.to_filter_distortion BoxIntegral.IntegrationParams.toFilterDistortion

/-- A set `s : set (tagged_prepartition I)` belongs to `l.to_filter I` if for any `c : ℝ≥0` there
exists a function `r : ℝⁿ → (0, ∞)` (or a constant `r` if `l.bRiemann = tt`) such that
`s` contains each prepartition `π` such that `l.mem_base_set I c r π`. -/
def toFilter (l : IntegrationParams) (I : Box ι) : Filter (TaggedPrepartition I) :=
  ⨆ c : ℝ≥0, l.toFilterDistortion I c
#align box_integral.integration_params.to_filter BoxIntegral.IntegrationParams.toFilter

/-- A set `s : set (tagged_prepartition I)` belongs to `l.to_filter_distortion_Union I c π₀` if
there exists a function `r : ℝⁿ → (0, ∞)` (or a constant `r` if `l.bRiemann = tt`) such that `s`
contains each prepartition `π` such that `l.mem_base_set I c r π` and `π.Union = π₀.Union`. -/
def toFilterDistortionUnion (l : IntegrationParams) (I : Box ι) (c : ℝ≥0) (π₀ : Prepartition I) :=
  l.toFilterDistortion I c ⊓ 𝓟 { π | π.unionᵢ = π₀.unionᵢ }
#align box_integral.integration_params.to_filter_distortion_Union BoxIntegral.IntegrationParams.toFilterDistortionUnion

/-- A set `s : set (tagged_prepartition I)` belongs to `l.to_filter_Union I π₀` if for any `c : ℝ≥0`
there exists a function `r : ℝⁿ → (0, ∞)` (or a constant `r` if `l.bRiemann = tt`) such that `s`
contains each prepartition `π` such that `l.mem_base_set I c r π` and `π.Union = π₀.Union`. -/
def toFilterUnion (l : IntegrationParams) (I : Box ι) (π₀ : Prepartition I) :=
  ⨆ c : ℝ≥0, l.toFilterDistortionUnion I c π₀
#align box_integral.integration_params.to_filter_Union BoxIntegral.IntegrationParams.toFilterUnion

theorem rCond_of_bRiemann_eq_false {ι} (l : IntegrationParams) (hl : l.bRiemann = false)
    {r : (ι → ℝ) → Ioi (0 : ℝ)} : l.RCond r := by simp [r_cond, hl]
#align box_integral.integration_params.r_cond_of_bRiemann_eq_ff BoxIntegral.IntegrationParams.rCond_of_bRiemann_eq_false

theorem toFilter_inf_union_eq (l : IntegrationParams) (I : Box ι) (π₀ : Prepartition I) :
    l.toFilter I ⊓ 𝓟 { π | π.unionᵢ = π₀.unionᵢ } = l.toFilterUnion I π₀ :=
  (supᵢ_inf_principal _ _).symm
#align box_integral.integration_params.to_filter_inf_Union_eq BoxIntegral.IntegrationParams.toFilter_inf_union_eq

theorem MemBaseSet.mono' (I : Box ι) (h : l₁ ≤ l₂) (hc : c₁ ≤ c₂) {π : TaggedPrepartition I}
    (hr : ∀ J ∈ π, r₁ (π.Tag J) ≤ r₂ (π.Tag J)) (hπ : l₁.MemBaseSet I c₁ r₁ π) :
    l₂.MemBaseSet I c₂ r₂ π :=
  ⟨hπ.1.mono' hr, fun h₂ => hπ.2 (le_iff_imp.1 h.2.1 h₂), fun hD =>
    (hπ.3 (le_iff_imp.1 h.2.2 hD)).trans hc, fun hD =>
    (hπ.4 (le_iff_imp.1 h.2.2 hD)).imp fun π hπ => ⟨hπ.1, hπ.2.trans hc⟩⟩
#align box_integral.integration_params.mem_base_set.mono' BoxIntegral.IntegrationParams.MemBaseSet.mono'

@[mono]
theorem MemBaseSet.mono (I : Box ι) (h : l₁ ≤ l₂) (hc : c₁ ≤ c₂) {π : TaggedPrepartition I}
    (hr : ∀ x ∈ I.Icc, r₁ x ≤ r₂ x) (hπ : l₁.MemBaseSet I c₁ r₁ π) : l₂.MemBaseSet I c₂ r₂ π :=
  hπ.mono' I h hc fun J hJ => hr _ <| π.tag_mem_icc J
#align box_integral.integration_params.mem_base_set.mono BoxIntegral.IntegrationParams.MemBaseSet.mono

theorem MemBaseSet.exists_common_compl (h₁ : l.MemBaseSet I c₁ r₁ π₁) (h₂ : l.MemBaseSet I c₂ r₂ π₂)
    (hU : π₁.unionᵢ = π₂.unionᵢ) :
    ∃ π : Prepartition I,
      π.unionᵢ = I \ π₁.unionᵢ ∧
        (l.bDistortion → π.distortion ≤ c₁) ∧ (l.bDistortion → π.distortion ≤ c₂) :=
  by
  wlog hc : c₁ ≤ c₂
  · simpa [hU, and_comm'] using this h₂ h₁ hU.symm (le_of_not_le hc)
  by_cases hD : (l.bDistortion : Prop)
  · rcases h₁.4 hD with ⟨π, hπU, hπc⟩
    exact ⟨π, hπU, fun _ => hπc, fun _ => hπc.trans hc⟩
  ·
    exact
      ⟨π₁.to_prepartition.compl, π₁.to_prepartition.Union_compl, fun h => (hD h).elim, fun h =>
        (hD h).elim⟩
#align box_integral.integration_params.mem_base_set.exists_common_compl BoxIntegral.IntegrationParams.MemBaseSet.exists_common_compl

protected theorem MemBaseSet.unionComplToSubordinate (hπ₁ : l.MemBaseSet I c r₁ π₁)
    (hle : ∀ x ∈ I.Icc, r₂ x ≤ r₁ x) {π₂ : Prepartition I} (hU : π₂.unionᵢ = I \ π₁.unionᵢ)
    (hc : l.bDistortion → π₂.distortion ≤ c) :
    l.MemBaseSet I c r₁ (π₁.unionComplToSubordinate π₂ hU r₂) :=
  ⟨hπ₁.1.disjUnion ((π₂.isSubordinateToSubordinate r₂).mono hle) _, fun h =>
    (hπ₁.2 h).disjUnion (π₂.isHenstockToSubordinate _) _, fun h =>
    (distortion_unionComplToSubordinate _ _ _ _).trans_le (max_le (hπ₁.3 h) (hc h)), fun _ =>
    ⟨⊥, by simp⟩⟩
#align box_integral.integration_params.mem_base_set.union_compl_to_subordinate BoxIntegral.IntegrationParams.MemBaseSet.unionComplToSubordinate

protected theorem MemBaseSet.filter (hπ : l.MemBaseSet I c r π) (p : Box ι → Prop) :
    l.MemBaseSet I c r (π.filterₓ p) :=
  by
  refine'
    ⟨fun J hJ => hπ.1 J (π.mem_filter.1 hJ).1, fun hH J hJ => hπ.2 hH J (π.mem_filter.1 hJ).1,
      fun hD => (distortion_filter_le _ _).trans (hπ.3 hD), fun hD => _⟩
  rcases hπ.4 hD with ⟨π₁, hπ₁U, hc⟩
  set π₂ := π.filter fun J => ¬p J
  have : Disjoint π₁.Union π₂.Union := by
    simpa [π₂, hπ₁U] using disjoint_sdiff_self_left.mono_right sdiff_le
  refine' ⟨π₁.disj_union π₂.to_prepartition this, _, _⟩
  · suffices ↑I \ π.Union ∪ π.Union \ (π.filter p).unionᵢ = ↑I \ (π.filter p).unionᵢ by simpa [*]
    have : (π.filter p).unionᵢ ⊆ π.Union := bUnion_subset_bUnion_left (Finset.filter_subset _ _)
    ext x
    fconstructor
    · rintro (⟨hxI, hxπ⟩ | ⟨hxπ, hxp⟩)
      exacts[⟨hxI, mt (@this x) hxπ⟩, ⟨π.Union_subset hxπ, hxp⟩]
    · rintro ⟨hxI, hxp⟩
      by_cases hxπ : x ∈ π.Union
      exacts[Or.inr ⟨hxπ, hxp⟩, Or.inl ⟨hxI, hxπ⟩]
  · have : (π.filter fun J => ¬p J).distortion ≤ c := (distortion_filter_le _ _).trans (hπ.3 hD)
    simpa [hc]
#align box_integral.integration_params.mem_base_set.filter BoxIntegral.IntegrationParams.MemBaseSet.filter

theorem bUnionTaggedMemBaseSet {π : Prepartition I} {πi : ∀ J, TaggedPrepartition J}
    (h : ∀ J ∈ π, l.MemBaseSet J c r (πi J)) (hp : ∀ J ∈ π, (πi J).IsPartition)
    (hc : l.bDistortion → π.compl.distortion ≤ c) : l.MemBaseSet I c r (π.bUnionTagged πi) :=
  by
  refine'
    ⟨tagged_prepartition.is_subordinate_bUnion_tagged.2 fun J hJ => (h J hJ).1, fun hH =>
      tagged_prepartition.is_Henstock_bUnion_tagged.2 fun J hJ => (h J hJ).2 hH, fun hD => _,
      fun hD => _⟩
  · rw [prepartition.distortion_bUnion_tagged, Finset.sup_le_iff]
    exact fun J hJ => (h J hJ).3 hD
  · refine' ⟨_, _, hc hD⟩
    rw [π.Union_compl, ← π.Union_bUnion_partition hp]
    rfl
#align box_integral.integration_params.bUnion_tagged_mem_base_set BoxIntegral.IntegrationParams.bUnionTaggedMemBaseSet

@[mono]
theorem RCond.mono {ι : Type _} {r : (ι → ℝ) → Ioi (0 : ℝ)} (h : l₁ ≤ l₂) (hr : l₂.RCond r) :
    l₁.RCond r := fun hR => hr (le_iff_imp.1 h.1 hR)
#align box_integral.integration_params.r_cond.mono BoxIntegral.IntegrationParams.RCond.mono

theorem RCond.min {ι : Type _} {r₁ r₂ : (ι → ℝ) → Ioi (0 : ℝ)} (h₁ : l.RCond r₁) (h₂ : l.RCond r₂) :
    l.RCond fun x => min (r₁ x) (r₂ x) := fun hR x => congr_arg₂ min (h₁ hR x) (h₂ hR x)
#align box_integral.integration_params.r_cond.min BoxIntegral.IntegrationParams.RCond.min

@[mono]
theorem toFilterDistortion_mono (I : Box ι) (h : l₁ ≤ l₂) (hc : c₁ ≤ c₂) :
    l₁.toFilterDistortion I c₁ ≤ l₂.toFilterDistortion I c₂ :=
  infᵢ_mono fun r =>
    infᵢ_mono' fun hr =>
      ⟨hr.mono h, principal_mono.2 fun _ => MemBaseSet.mono I h hc fun _ _ => le_rfl⟩
#align box_integral.integration_params.to_filter_distortion_mono BoxIntegral.IntegrationParams.toFilterDistortion_mono

@[mono]
theorem toFilter_mono (I : Box ι) {l₁ l₂ : IntegrationParams} (h : l₁ ≤ l₂) :
    l₁.toFilter I ≤ l₂.toFilter I :=
  supᵢ_mono fun c => toFilterDistortion_mono I h le_rfl
#align box_integral.integration_params.to_filter_mono BoxIntegral.IntegrationParams.toFilter_mono

@[mono]
theorem toFilterUnion_mono (I : Box ι) {l₁ l₂ : IntegrationParams} (h : l₁ ≤ l₂)
    (π₀ : Prepartition I) : l₁.toFilterUnion I π₀ ≤ l₂.toFilterUnion I π₀ :=
  supᵢ_mono fun c => inf_le_inf_right _ <| toFilterDistortion_mono _ h le_rfl
#align box_integral.integration_params.to_filter_Union_mono BoxIntegral.IntegrationParams.toFilterUnion_mono

theorem toFilterUnion_congr (I : Box ι) (l : IntegrationParams) {π₁ π₂ : Prepartition I}
    (h : π₁.unionᵢ = π₂.unionᵢ) : l.toFilterUnion I π₁ = l.toFilterUnion I π₂ := by
  simp only [to_filter_Union, to_filter_distortion_Union, h]
#align box_integral.integration_params.to_filter_Union_congr BoxIntegral.IntegrationParams.toFilterUnion_congr

theorem hasBasis_toFilterDistortion (l : IntegrationParams) (I : Box ι) (c : ℝ≥0) :
    (l.toFilterDistortion I c).HasBasis l.RCond fun r => { π | l.MemBaseSet I c r π } :=
  hasBasis_binfᵢ_principal'
    (fun r₁ hr₁ r₂ hr₂ =>
      ⟨_, hr₁.min hr₂, fun _ => MemBaseSet.mono _ le_rfl le_rfl fun x hx => min_le_left _ _,
        fun _ => MemBaseSet.mono _ le_rfl le_rfl fun x hx => min_le_right _ _⟩)
    ⟨fun _ => ⟨1, zero_lt_one⟩, fun _ _ => rfl⟩
#align box_integral.integration_params.has_basis_to_filter_distortion BoxIntegral.IntegrationParams.hasBasis_toFilterDistortion

theorem hasBasis_toFilterDistortionUnion (l : IntegrationParams) (I : Box ι) (c : ℝ≥0)
    (π₀ : Prepartition I) :
    (l.toFilterDistortionUnion I c π₀).HasBasis l.RCond fun r =>
      { π | l.MemBaseSet I c r π ∧ π.unionᵢ = π₀.unionᵢ } :=
  (l.hasBasis_toFilterDistortion I c).inf_principal _
#align box_integral.integration_params.has_basis_to_filter_distortion_Union BoxIntegral.IntegrationParams.hasBasis_toFilterDistortionUnion

theorem hasBasis_toFilterUnion (l : IntegrationParams) (I : Box ι) (π₀ : Prepartition I) :
    (l.toFilterUnion I π₀).HasBasis (fun r : ℝ≥0 → (ι → ℝ) → Ioi (0 : ℝ) => ∀ c, l.RCond (r c))
      fun r => { π | ∃ c, l.MemBaseSet I c (r c) π ∧ π.unionᵢ = π₀.unionᵢ } :=
  by
  have := fun c => l.hasBasis_toFilterDistortionUnion I c π₀
  simpa only [set_of_and, set_of_exists] using has_basis_supr this
#align box_integral.integration_params.has_basis_to_filter_Union BoxIntegral.IntegrationParams.hasBasis_toFilterUnion

theorem hasBasis_toFilterUnion_top (l : IntegrationParams) (I : Box ι) :
    (l.toFilterUnion I ⊤).HasBasis (fun r : ℝ≥0 → (ι → ℝ) → Ioi (0 : ℝ) => ∀ c, l.RCond (r c))
      fun r => { π | ∃ c, l.MemBaseSet I c (r c) π ∧ π.IsPartition } :=
  by
  simpa only [tagged_prepartition.is_partition_iff_Union_eq, prepartition.Union_top] using
    l.has_basis_to_filter_Union I ⊤
#align box_integral.integration_params.has_basis_to_filter_Union_top BoxIntegral.IntegrationParams.hasBasis_toFilterUnion_top

theorem hasBasis_toFilter (l : IntegrationParams) (I : Box ι) :
    (l.toFilter I).HasBasis (fun r : ℝ≥0 → (ι → ℝ) → Ioi (0 : ℝ) => ∀ c, l.RCond (r c)) fun r =>
      { π | ∃ c, l.MemBaseSet I c (r c) π } :=
  by simpa only [set_of_exists] using has_basis_supr (l.has_basis_to_filter_distortion I)
#align box_integral.integration_params.has_basis_to_filter BoxIntegral.IntegrationParams.hasBasis_toFilter

theorem tendsto_embedBox_toFilterUnion_top (l : IntegrationParams) (h : I ≤ J) :
    Tendsto (TaggedPrepartition.embedBox I J h) (l.toFilterUnion I ⊤)
      (l.toFilterUnion J (Prepartition.single J I h)) :=
  by
  simp only [to_filter_Union, tendsto_supr]; intro c
  set π₀ := prepartition.single J I h
  refine' le_supᵢ_of_le (max c π₀.compl.distortion) _
  refine'
    ((l.has_basis_to_filter_distortion_Union I c ⊤).tendsto_iffₓ
          (l.has_basis_to_filter_distortion_Union J _ _)).2
      fun r hr => _
  refine' ⟨r, hr, fun π hπ => _⟩
  rw [mem_set_of_eq, prepartition.Union_top] at hπ
  refine' ⟨⟨hπ.1.1, hπ.1.2, fun hD => le_trans (hπ.1.3 hD) (le_max_left _ _), fun hD => _⟩, _⟩
  · refine' ⟨_, π₀.Union_compl.trans _, le_max_right _ _⟩
    congr 1
    exact (prepartition.Union_single h).trans hπ.2.symm
  · exact hπ.2.trans (prepartition.Union_single _).symm
#align box_integral.integration_params.tendsto_embed_box_to_filter_Union_top BoxIntegral.IntegrationParams.tendsto_embedBox_toFilterUnion_top

theorem exists_memBaseSet_le_union_eq (l : IntegrationParams) (π₀ : Prepartition I)
    (hc₁ : π₀.distortion ≤ c) (hc₂ : π₀.compl.distortion ≤ c) (r : (ι → ℝ) → Ioi (0 : ℝ)) :
    ∃ π, l.MemBaseSet I c r π ∧ π.toPrepartition ≤ π₀ ∧ π.unionᵢ = π₀.unionᵢ :=
  by
  rcases π₀.exists_tagged_le_is_Henstock_is_subordinate_Union_eq r with ⟨π, hle, hH, hr, hd, hU⟩
  refine' ⟨π, ⟨hr, fun _ => hH, fun _ => hd.trans_le hc₁, fun hD => ⟨π₀.compl, _, hc₂⟩⟩, ⟨hle, hU⟩⟩
  exact prepartition.compl_congr hU ▸ π.to_prepartition.Union_compl
#align box_integral.integration_params.exists_mem_base_set_le_Union_eq BoxIntegral.IntegrationParams.exists_memBaseSet_le_union_eq

theorem exists_memBaseSet_isPartition (l : IntegrationParams) (I : Box ι) (hc : I.distortion ≤ c)
    (r : (ι → ℝ) → Ioi (0 : ℝ)) : ∃ π, l.MemBaseSet I c r π ∧ π.IsPartition :=
  by
  rw [← prepartition.distortion_top] at hc
  have hc' : (⊤ : prepartition I).compl.distortion ≤ c := by simp
  simpa [is_partition_iff_Union_eq] using l.exists_mem_base_set_le_Union_eq ⊤ hc hc' r
#align box_integral.integration_params.exists_mem_base_set_is_partition BoxIntegral.IntegrationParams.exists_memBaseSet_isPartition

theorem toFilterDistortionUnion_neBot (l : IntegrationParams) (I : Box ι) (π₀ : Prepartition I)
    (hc₁ : π₀.distortion ≤ c) (hc₂ : π₀.compl.distortion ≤ c) :
    (l.toFilterDistortionUnion I c π₀).ne_bot :=
  ((l.hasBasis_toFilterDistortion I _).inf_principal _).neBot_iff.2 fun r hr =>
    (l.exists_memBaseSet_le_union_eq π₀ hc₁ hc₂ r).imp fun π hπ => ⟨hπ.1, hπ.2.2⟩
#align box_integral.integration_params.to_filter_distortion_Union_ne_bot BoxIntegral.IntegrationParams.toFilterDistortionUnion_neBot

instance toFilterDistortionUnion_ne_bot' (l : IntegrationParams) (I : Box ι) (π₀ : Prepartition I) :
    (l.toFilterDistortionUnion I (max π₀.distortion π₀.compl.distortion) π₀).ne_bot :=
  l.toFilterDistortionUnion_neBot I π₀ (le_max_left _ _) (le_max_right _ _)
#align box_integral.integration_params.to_filter_distortion_Union_ne_bot' BoxIntegral.IntegrationParams.toFilterDistortionUnion_ne_bot'

instance toFilterDistortion_neBot (l : IntegrationParams) (I : Box ι) :
    (l.toFilterDistortion I I.distortion).ne_bot := by
  simpa using (l.to_filter_distortion_Union_ne_bot' I ⊤).mono inf_le_left
#align box_integral.integration_params.to_filter_distortion_ne_bot BoxIntegral.IntegrationParams.toFilterDistortion_neBot

instance toFilter_neBot (l : IntegrationParams) (I : Box ι) : (l.toFilter I).ne_bot :=
  (l.toFilterDistortion_neBot I).mono <| le_supᵢ _ _
#align box_integral.integration_params.to_filter_ne_bot BoxIntegral.IntegrationParams.toFilter_neBot

instance toFilterUnion_neBot (l : IntegrationParams) (I : Box ι) (π₀ : Prepartition I) :
    (l.toFilterUnion I π₀).ne_bot :=
  (l.toFilterDistortionUnion_ne_bot' I π₀).mono <|
    le_supᵢ (fun c => l.toFilterDistortionUnion I c π₀) _
#align box_integral.integration_params.to_filter_Union_ne_bot BoxIntegral.IntegrationParams.toFilterUnion_neBot

theorem eventually_isPartition (l : IntegrationParams) (I : Box ι) :
    ∀ᶠ π in l.toFilterUnion I ⊤, TaggedPrepartition.IsPartition π :=
  eventually_supᵢ.2 fun c =>
    eventually_inf_principal.2 <|
      eventually_of_forall fun π h => π.isPartition_iff_union_eq.2 (h.trans Prepartition.union_top)
#align box_integral.integration_params.eventually_is_partition BoxIntegral.IntegrationParams.eventually_isPartition

end IntegrationParams

end BoxIntegral


/-
Copyright (c) 2020 Oliver Nash. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Oliver Nash
-/
import algebra.direct_sum.module
import algebra.lie.of_associative
import algebra.lie.submodule
import algebra.lie.basic

/-!
# Direct sums of Lie algebras and Lie modules

Direct sums of Lie algebras and Lie modules carry natural algbebra and module structures.

## Tags

lie algebra, lie module, direct sum
-/

universes u v w w₁

namespace direct_sum
open dfinsupp
open_locale direct_sum

variables {R : Type u} {ι : Type v} [comm_ring R]

section modules

/-! The direct sum of Lie modules over a fixed Lie algebra carries a natural Lie module
structure. -/

variables {L : Type w₁} {M : ι → Type w}
variables [lie_ring L] [lie_algebra R L]
variables [Π i, add_comm_group (M i)] [Π i, module R (M i)]
variables [Π i, lie_ring_module L (M i)] [Π i, lie_module R L (M i)]

instance : lie_ring_module L (⨁ i, M i) :=
{ bracket     := λ x m, m.map_range (λ i m', ⁅x, m'⁆) (λ i, lie_zero x),
  add_lie     := λ x y m, by { ext, simp only [map_range_apply, add_apply, add_lie], },
  lie_add     := λ x m n, by { ext, simp only [map_range_apply, add_apply, lie_add], },
  leibniz_lie := λ x y m, by { ext, simp only [map_range_apply, lie_lie, add_apply,
    sub_add_cancel], }, }

@[simp] lemma lie_module_bracket_apply (x : L) (m : ⨁ i, M i) (i : ι) :
  ⁅x, m⁆ i = ⁅x, m i⁆ := map_range_apply _ _ m i

instance : lie_module R L (⨁ i, M i) :=
{ smul_lie := λ t x m, by { ext i, simp only [smul_lie, lie_module_bracket_apply, smul_apply], },
  lie_smul := λ t x m, by { ext i, simp only [lie_smul, lie_module_bracket_apply, smul_apply], }, }

variables (R ι L M)

/-- The inclusion of each component into a direct sum as a morphism of Lie modules. -/
def lie_module_of [decidable_eq ι] (j : ι) : M j →ₗ⁅R,L⁆ ⨁ i, M i :=
{ map_lie' := λ x m,
    begin
      ext i, by_cases h : j = i,
      { rw ← h, simp, },
      { simp [lof, single_eq_of_ne h], },
    end,
  ..lof R ι M j }

/-- The projection map onto one component, as a morphism of Lie modules. -/
def lie_module_component (j : ι) : (⨁ i, M i) →ₗ⁅R,L⁆ M j :=
{ map_lie' := λ x m,
    by simp only [component, lapply_apply, lie_module_bracket_apply, linear_map.to_fun_eq_coe],
  ..component R ι M j }

end modules

section algebras

/-! The direct sum of Lie algebras carries a natural Lie algebra structure. -/

variables (L : ι → Type w)
variables [Π i, lie_ring (L i)] [Π i, lie_algebra R (L i)]

instance lie_ring : lie_ring (⨁ i, L i) :=
{ bracket     := zip_with (λ i, λ x y, ⁅x, y⁆) (λ i, lie_zero 0),
  add_lie     := λ x y z, by { ext, simp only [zip_with_apply, add_apply, add_lie], },
  lie_add     := λ x y z, by { ext, simp only [zip_with_apply, add_apply, lie_add], },
  lie_self    := λ x, by { ext, simp only [zip_with_apply, add_apply, lie_self, zero_apply], },
  leibniz_lie := λ x y z, by { ext, simp only [sub_apply,
    zip_with_apply, add_apply, zero_apply], apply leibniz_lie, },
  ..(infer_instance : add_comm_group _) }

@[simp] lemma bracket_apply (x y : ⨁ i, L i) (i : ι) :
  ⁅x, y⁆ i = ⁅x i, y i⁆ := zip_with_apply _ _ x y i

instance lie_algebra : lie_algebra R (⨁ i, L i) :=
{ lie_smul := λ c x y, by { ext, simp only [
    zip_with_apply, smul_apply, bracket_apply, lie_smul] },
  ..(infer_instance : module R _) }

variables (R ι L)

/-- The inclusion of each component into the direct sum as morphism of Lie algebras. -/
@[simps] def lie_algebra_of [decidable_eq ι] (j : ι) : L j →ₗ⁅R⁆ ⨁ i, L i :=
{ to_fun   := of L j,
  map_lie' := λ x y, by
  { ext i, by_cases h : j = i,
    { rw ← h, simp [of], },
    { simp [of, single_eq_of_ne h], }, },
  ..lof R ι L j, }

/-- The projection map onto one component, as a morphism of Lie algebras. -/
@[simps] def lie_algebra_component (j : ι) : (⨁ i, L i) →ₗ⁅R⁆ L j :=
{ to_fun   := component R ι L j,
  map_lie' := λ x y,
    by simp only [component, bracket_apply, lapply_apply, linear_map.to_fun_eq_coe],
  ..component R ι L j }

@[ext] lemma lie_algebra_ext {x y : ⨁ i, L i}
  (h : ∀ i, lie_algebra_component R ι L i x = lie_algebra_component R ι L i y) : x = y :=
dfinsupp.ext h

include R

lemma lie_of_of_ne [decidable_eq ι] {i j : ι} (hij : j ≠ i) (x : L i) (y : L j) :
  ⁅of L i x, of L j y⁆ = 0 :=
begin
  apply lie_algebra_ext R ι L, intros k,
  rw lie_hom.map_lie,
  simp only [component, of, lapply_apply, single_add_hom_apply, lie_algebra_component_apply,
    single_apply, zero_apply],
  by_cases hik : i = k,
  { simp only [dif_neg, not_false_iff, lie_zero, hik.symm, hij], },
  { simp only [dif_neg, not_false_iff, zero_lie, hik], },
end

lemma lie_of_of_eq [decidable_eq ι] {i j : ι} (hij : j = i) (x : L i) (y : L j) :
  ⁅of L i x, of L j y⁆ = of L i ⁅x, hij.rec_on y⁆ :=
begin
  have : of L j y = of L i (hij.rec_on y), { exact eq.drec (eq.refl _) hij, },
  rw [this, ← lie_algebra_of_apply R ι L i ⁅x, hij.rec_on y⁆, lie_hom.map_lie,
    lie_algebra_of_apply, lie_algebra_of_apply],
end

@[simp] lemma lie_of [decidable_eq ι] {i j : ι} (x : L i) (y : L j) :
  ⁅of L i x, of L j y⁆ =
  if hij : j = i then lie_algebra_of R ι L i ⁅x, hij.rec_on y⁆ else 0 :=
begin
  by_cases hij : j = i,
  { simp only [lie_of_of_eq R ι L hij x y, hij, dif_pos, not_false_iff, lie_algebra_of_apply], },
  { simp only [lie_of_of_ne R ι L hij x y, hij, dif_neg, not_false_iff], },
end

variables {R L ι}

/-- Given a family of Lie algebras `L i`, together with a family of morphisms of Lie algebras
`f i : L i →ₗ⁅R⁆ L'` into a fixed Lie algebra `L'`, we have a natural linear map:
`(⨁ i, L i) →ₗ[R] L'`. If in addition `⁅f i x, f j y⁆ = 0` for any `x ∈ L i` and `y ∈ L j` (`i ≠ j`)
then this map is a morphism of Lie algebras. -/
@[simps] def to_lie_algebra [decidable_eq ι] (L' : Type w₁) [lie_ring L'] [lie_algebra R L']
  (f : Π i, L i →ₗ⁅R⁆ L') (hf : ∀ (i j : ι), i ≠ j → ∀ (x : L i) (y : L j), ⁅f i x, f j y⁆ = 0) :
  (⨁ i, L i) →ₗ⁅R⁆ L' :=
{ to_fun   := to_module R ι L' (λ i, (f i : L i →ₗ[R] L')),
  map_lie' := λ x y,
    begin
      let f' := λ i, (f i : L i →ₗ[R] L'),
      /- The goal is linear in `y`. We can use this to reduce to the case that `y` has only one
        non-zero component. -/
      suffices : ∀ (i : ι) (y : L i), to_module R ι L' f' ⁅x, of L i y⁆ =
        ⁅to_module R ι L' f' x, to_module R ι L' f' (of L i y)⁆,
      { simp only [← lie_algebra.ad_apply R],
        rw [← linear_map.comp_apply, ← linear_map.comp_apply],
        congr, clear y, ext i y, exact this i y, },
      /- Similarly, we can reduce to the case that `x` has only one non-zero component. -/
      suffices : ∀ i j (y : L i) (x : L j), to_module R ι L' f' ⁅of L j x, of L i y⁆ =
        ⁅to_module R ι L' f' (of L j x), to_module R ι L' f' (of L i y)⁆,
      { intros i y,
        rw [← lie_skew x, ← lie_skew (to_module R ι L' f' x)],
        simp only [linear_map.map_neg, neg_inj, ← lie_algebra.ad_apply R],
        rw [← linear_map.comp_apply, ← linear_map.comp_apply],
        congr, clear x, ext j x, exact this j i x y, },
      /- Tidy up and use `lie_of`. -/
      intros i j y x,
      simp only [lie_of R, lie_algebra_of_apply, lie_hom.coe_to_linear_map, to_add_monoid_of,
        coe_to_module_eq_coe_to_add_monoid, linear_map.to_add_monoid_hom_coe],
      /- And finish with trivial case analysis. -/
      rcases eq_or_ne i j with h | h,
      { have h' : f j (h.rec_on y) = f i y, { exact eq.drec (eq.refl _) h, },
        simp only [h, h', lie_hom.coe_to_linear_map, dif_pos, lie_hom.map_lie, to_add_monoid_of,
          linear_map.to_add_monoid_hom_coe], },
      { simp only [h, hf j i h.symm x y, dif_neg, not_false_iff, add_monoid_hom.map_zero], },
    end,
.. to_module R ι L' (λ i, (f i : L i →ₗ[R] L')) }

end algebras

section ideals

variables {L : Type w} [lie_ring L] [lie_algebra R L] (I : ι → lie_ideal R L)

/-- Given a Lie algebra `L` and a family of ideals `I i ⊆ L`, informally this definition is the
statement that `L = ⨁ i, I i`.

More formally, the inclusions give a natural map from the (external) direct sum to the enclosing Lie
algebra: `(⨁ i, I i) → L`, and this definition is the proposition that this map is bijective. -/
def lie_algebra_is_internal [decidable_eq ι] : Prop :=
function.bijective $ to_module R ι L $ λ i, ((I i).incl : I i →ₗ[R] L)

/-- The fact that this instance is necessary seems to be a bug in typeclass inference. See
[this Zulip thread](https://leanprover.zulipchat.com/#narrow/stream/113488-general/topic/
Typeclass.20resolution.20under.20binders/near/245151099). -/
instance lie_ring_of_ideals : lie_ring (⨁ i, I i) := direct_sum.lie_ring (λ i, ↥(I i))

/-- See `direct_sum.lie_ring_of_ideals` comment. -/
instance lie_algebra_of_ideals : lie_algebra R (⨁ i, I i) := direct_sum.lie_algebra (λ i, ↥(I i))

end ideals

end direct_sum