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

import solutions.sheet04

/-! Linear maps

In this section, we give the definition of a linear map, show that a 2x2-matrix gives rise to a linear map,
and that every linear map from ℝ² to ℝ² is given by a matrix.
-/

/-- `linear_map V W` is the type of linear maps from `V` to `W`. -/
@[ext] structure linear_map (V W : Type) [real_vector_space V] [real_vector_space W] :=
(to_fun : V → W)
(map_add' (v v' : V) : to_fun (v + v') = to_fun v + to_fun v')
(map_smul' (a : ℝ) (v : V) : to_fun (a • v) = a • to_fun v)

namespace linear_map

-- throughout this sheet, `V` and `W` will be real vector spaces.
variables {V W : Type} [real_vector_space V] [real_vector_space W]

-- We use notation `V →ₗᵢₙ H` for the type of linear maps from `V` to `W`.
notation V ` →ₗᵢₙ ` W := linear_map V W

-- A linear map is a function, and so we set up a "coercion"
-- so that a linear map can be regarded as a function (even
-- though it's actually a pair consisting of a function and two axioms)
instance : has_coe_to_fun (V →ₗᵢₙ W) (λ _, V → W) :=
{ coe := linear_map.to_fun }

@[simp] lemma simplify_coercion (f : V →ₗᵢₙ W) (v : V) : f.to_fun v = f v := rfl

-- Notice that we can now write `f (v + v')` and `f (a • v)` even though `f` isn't actually a
-- function, it's a pair consisting of a function `f.to_fun` and the axioms `f.map_add'` and `f.map_smul`.
-- The below lemma is how we want to use it as mathematicians though.
lemma map_add (f : V →ₗᵢₙ W) (v v' : V) :
  f (v + v') = f v + f v' :=
begin
  -- the point is that f.map_add and f.map_add' are *definitionally equal*
  -- but *syntactically different*, and the primed version looks uglier.
  -- The point of this lemma is that `f.map_add` looks nicer.
  exact f.map_add' v v'
end

lemma map_smul (f : V →ₗᵢₙ W) (a : ℝ) (v : V) :
  f (a • v) = a • f v :=
begin
  exact f.map_smul' a v
end

@[simp] lemma map_zero (f : V →ₗᵢₙ W) : f 0 = 0 :=
begin
  rw [← real_vector_space.zero_smul_eq_zero_vector (0 : V), map_smul, real_vector_space.zero_smul_eq_zero_vector],
end

/- The following could be important later on. See if you use it. -/
lemma expand_two_linear (f : ℝ² →ₗᵢₙ ℝ²) (v : ℝ²) : (f v) = v.x • f ⟨1,0⟩ + v.y • f ⟨0,1⟩ :=
begin
  have h : v = v.x • ⟨1,0⟩ + v.y • ⟨0,1⟩,
    { ext; simp, },
  rw [h, map_add, map_smul, map_smul],
  simp,
end

end linear_map

def two_matrix.to_linear_map (A : Mat₂) : ℝ² →ₗᵢₙ ℝ² :=
{ to_fun := λ v, ⟨v.1 * A.fst_row.1 + v.2 * A.fst_row.2, v.1 * A.snd_row.1 + v.2 * A.snd_row.2⟩,
  map_add' := begin intros v v', ext; simp only [plane.add_x, plane.add_y]; rw [add_mul, add_mul, add_assoc], { rw [← add_assoc (v'.x * A.fst_row.x), add_comm (v'.x * A.fst_row.x), add_assoc, add_assoc] }, {rw [← add_assoc (v'.x * A.snd_row.x), add_comm (v'.x * A.snd_row.x), add_assoc, add_assoc] } end,
  map_smul' := begin intros a v, ext; simp only [plane.smul_x, plane.smul_y]; rw [mul_add, mul_assoc, mul_assoc], end }

instance : has_coe_to_fun (two_matrix) (λ _, ℝ² → ℝ²) :=
{ coe := λ A, (A.to_linear_map).to_fun }

/- The following seems self-evident if you think what it means, but it is not immediately
  clear to the simplifyer. If you want, you can comment it out and see what stops working
  in later proofs. -/
@[simp] lemma to_linear_map_to_fun_eq_to_fun  (A : Mat₂) (v : ℝ²) :
A.to_linear_map v = A v := rfl

/- Now an expression like the following makes sense.-/
#check two_matrix.zero_matrix plane.zero_vector

/- Or even the following, which might seem a bit confusing.-/
#check (0 : two_matrix) 0 = 0

/- The following two simp-lemmas will help us actually prove such statements. -/
@[simp] lemma matrix_multiplication_x (A : Mat₂) (v : ℝ²) :
(A v).1 = v.1 * A.fst_row.1 + v.2 * A.fst_row.2 := rfl

@[simp] lemma matrix_multiplication_y (A : Mat₂) (v : ℝ²) :
(A v).2 = v.1 * A.snd_row.1 + v.2 * A.snd_row.2 := rfl

/- The zero matrix applied to the zero vector is equal to zero ...amazing.-/
example : (0 : two_matrix) 0 = 0 :=
begin
  ext;
  simp,
end

/- Let's generalise this to the zero matrix applied to an arbitrary vector.-/
lemma zero_matrix_apply (v : ℝ²) : (0 : two_matrix) v = 0 :=
begin
  ext;
  simp,
end

/- The other way round. -/
lemma matrix_apply_zero_vector (A : Mat₂) : A 0 = 0 :=
begin
  ext;
  simp,
end

/- Now the other way round, associating a matrix to a linear map. -/
def linear_map.to_two_matrix (f : ℝ² →ₗᵢₙ ℝ²) : Mat₂ :=
{ fst_row := ⟨(f ⟨1,0⟩).1, (f ⟨0,1⟩).1⟩,
  snd_row := ⟨(f ⟨1,0⟩).2, (f ⟨0,1⟩).2⟩ }

@[simp] lemma linear_map.to_two_matrix_fst_row_x (f : ℝ² →ₗᵢₙ ℝ²) : f.to_two_matrix.fst_row.x = (f ⟨1,0⟩).1 := rfl
@[simp] lemma linear_map.to_two_matrix_fst_row_y  (f : ℝ² →ₗᵢₙ ℝ²) : f.to_two_matrix.fst_row.y = (f ⟨0,1⟩).1 := rfl
@[simp] lemma linear_map.to_two_matrix_snd_row_x (f : ℝ² →ₗᵢₙ ℝ²) : f.to_two_matrix.snd_row.x = (f ⟨1,0⟩).2 := rfl
@[simp] lemma linear_map.to_two_matrix_snd_row_y  (f : ℝ² →ₗᵢₙ ℝ²) : f.to_two_matrix.snd_row.y = (f ⟨0,1⟩).2 := rfl

@[simp] lemma to_two_matrix_to_fun_eq_to_fun (f : ℝ² →ₗᵢₙ ℝ²) (v : ℝ²) : f.to_two_matrix v = f.to_fun v :=
begin
  ext; simp; { rw linear_map.expand_two_linear f v, simp only [plane.add_x, plane.smul_x, plane.add_y, plane.smul_y], },
end

/- And now we show that there is a 1-1 correspondence between 2x2-matrices and linear maps from the plane to itself. -/
def matrix_linear_correspondence : (ℝ² →ₗᵢₙ ℝ²) ≃ Mat₂ :=
{ to_fun := linear_map.to_two_matrix,
  inv_fun := two_matrix.to_linear_map,
  left_inv := begin intro f, ext v, { change (f.to_two_matrix v).x = (f.to_fun v).x, simp }, { change (f.to_two_matrix v).y = (f.to_fun v).y, simp }, end,
  right_inv := begin intro A, ext; simp end,
}

/- As a bonus you could even think about putting a vector space structure on (ℝ² →ₗᵢₙ ℝ²) and proving that it is
  linearly isomorphic to Mat₂. -/


/-
Copyright (c) 2022 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import data.set.lattice

/-!
# Formal concept analysis

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

This file defines concept lattices. A concept of a relation `r : α → β → Prop` is a pair of sets
`s : set α` and `t : set β` such that `s` is the set of all `a : α` that are related to all elements
of `t`, and `t` is the set of all `b : β` that are related to all elements of `s`.

Ordering the concepts of a relation `r` by inclusion on the first component gives rise to a
*concept lattice*. Every concept lattice is complete and in fact every complete lattice arises as
the concept lattice of its `≤`.

## Implementation notes

Concept lattices are usually defined from a *context*, that is the triple `(α, β, r)`, but the type
of `r` determines `α` and `β` already, so we do not define contexts as a separate object.

## TODO

Prove the fundamental theorem of concept lattices.

## References

* [Davey, Priestley *Introduction to Lattices and Order*][davey_priestley]

## Tags

concept, formal concept analysis, intent, extend, attribute
-/

open function order_dual set

variables {ι : Sort*} {α β γ : Type*} {κ : ι → Sort*} (r : α → β → Prop) {s s₁ s₂ : set α}
  {t t₁ t₂ : set β}

/-! ### Intent and extent -/

/-- The intent closure of `s : set α` along a relation `r : α → β → Prop` is the set of all elements
which `r` relates to all elements of `s`. -/
def intent_closure (s : set α) : set β := {b | ∀ ⦃a⦄, a ∈ s → r a b}

/-- The extent closure of `t : set β` along a relation `r : α → β → Prop` is the set of all elements
which `r` relates to all elements of `t`. -/
def extent_closure (t : set β) : set α := {a | ∀ ⦃b⦄, b ∈ t → r a b}

variables {r}

lemma subset_intent_closure_iff_subset_extent_closure :
  t ⊆ intent_closure r s ↔ s ⊆ extent_closure r t :=
⟨λ h a ha b hb, h hb ha, λ h b hb a ha, h ha hb⟩

variables (r)

lemma gc_intent_closure_extent_closure :
  galois_connection (to_dual ∘ intent_closure r) (extent_closure r ∘ of_dual) :=
λ s t, subset_intent_closure_iff_subset_extent_closure

lemma intent_closure_swap (t : set β) : intent_closure (swap r) t = extent_closure r t := rfl
lemma extent_closure_swap (s : set α) : extent_closure (swap r) s = intent_closure r s := rfl

@[simp] lemma intent_closure_empty : intent_closure r ∅ = univ :=
eq_univ_of_forall $ λ _ _, false.elim

@[simp] lemma extent_closure_empty : extent_closure r ∅ = univ := intent_closure_empty _

@[simp] lemma intent_closure_union (s₁ s₂ : set α) :
  intent_closure r (s₁ ∪ s₂) = intent_closure r s₁ ∩ intent_closure r s₂ :=
set.ext $ λ _, ball_or_left_distrib

@[simp] lemma extent_closure_union (t₁ t₂ : set β) :
  extent_closure r (t₁ ∪ t₂) = extent_closure r t₁ ∩ extent_closure r t₂ :=
intent_closure_union _ _ _

@[simp] lemma intent_closure_Union (f : ι → set α) :
  intent_closure r (⋃ i, f i) = ⋂ i, intent_closure r (f i) :=
(gc_intent_closure_extent_closure r).l_supr

@[simp] lemma extent_closure_Union (f : ι → set β) :
  extent_closure r (⋃ i, f i) = ⋂ i, extent_closure r (f i) :=
intent_closure_Union _ _

@[simp] lemma intent_closure_Union₂ (f : Π i, κ i → set α) :
  intent_closure r (⋃ i j, f i j) = ⋂ i j, intent_closure r (f i j) :=
(gc_intent_closure_extent_closure r).l_supr₂

@[simp] lemma extent_closure_Union₂ (f : Π i, κ i → set β) :
  extent_closure r (⋃ i j, f i j) = ⋂ i j, extent_closure r (f i j) :=
intent_closure_Union₂ _ _

lemma subset_extent_closure_intent_closure (s : set α) :
  s ⊆ extent_closure r (intent_closure r s) :=
(gc_intent_closure_extent_closure r).le_u_l _

lemma subset_intent_closure_extent_closure (t : set β) :
  t ⊆ intent_closure r (extent_closure r t) :=
subset_extent_closure_intent_closure _ t

@[simp] lemma intent_closure_extent_closure_intent_closure (s : set α) :
  intent_closure r (extent_closure r $ intent_closure r s) = intent_closure r s :=
(gc_intent_closure_extent_closure r).l_u_l_eq_l _

@[simp] lemma extent_closure_intent_closure_extent_closure (t : set β) :
  extent_closure r (intent_closure r $ extent_closure r t) = extent_closure r t :=
intent_closure_extent_closure_intent_closure _ t

lemma intent_closure_anti : antitone (intent_closure r) :=
(gc_intent_closure_extent_closure r).monotone_l

lemma extent_closure_anti : antitone (extent_closure r) := intent_closure_anti _

/-! ### Concepts -/

variables (α β)

/-- The formal concepts of a relation. A concept of `r : α → β → Prop` is a pair of sets `s`, `t`
such that `s` is the set of all elements that are `r`-related to all of `t` and `t` is the set of
all elements that are `r`-related to all of `s`. -/
structure concept extends set α × set β :=
(closure_fst : intent_closure r fst = snd)
(closure_snd : extent_closure r snd = fst)

namespace concept
variables {r α β} {c d : concept α β r}

attribute [simp] closure_fst closure_snd

@[ext] lemma ext (h : c.fst = d.fst) : c = d :=
begin
  obtain ⟨⟨s₁, t₁⟩, h₁, _⟩ := c,
  obtain ⟨⟨s₂, t₂⟩, h₂, _⟩ := d,
  dsimp at h₁ h₂ h,
  subst h,
  subst h₁,
  subst h₂,
end

lemma ext' (h : c.snd = d.snd) : c = d :=
begin
  obtain ⟨⟨s₁, t₁⟩, _, h₁⟩ := c,
  obtain ⟨⟨s₂, t₂⟩, _, h₂⟩ := d,
  dsimp at h₁ h₂ h,
  subst h,
  subst h₁,
  subst h₂,
end

lemma fst_injective : injective (λ c : concept α β r, c.fst) := λ c d, ext
lemma snd_injective : injective (λ c : concept α β r, c.snd) := λ c d, ext'

instance : has_sup (concept α β r) :=
⟨λ c d, { fst := extent_closure r (c.snd ∩ d.snd),
  snd := c.snd ∩ d.snd,
  closure_fst := by rw [←c.closure_fst, ←d.closure_fst, ←intent_closure_union,
    intent_closure_extent_closure_intent_closure],
  closure_snd := rfl }⟩

instance : has_inf (concept α β r) :=
⟨λ c d, { fst := c.fst ∩ d.fst,
  snd := intent_closure r (c.fst ∩ d.fst),
  closure_fst := rfl,
  closure_snd := by rw [←c.closure_snd, ←d.closure_snd, ←extent_closure_union,
    extent_closure_intent_closure_extent_closure] }⟩

instance : semilattice_inf (concept α β r) := fst_injective.semilattice_inf _ $ λ _ _, rfl

@[simp] lemma fst_subset_fst_iff : c.fst ⊆ d.fst ↔ c ≤ d := iff.rfl
@[simp] lemma fst_ssubset_fst_iff : c.fst ⊂ d.fst ↔ c < d := iff.rfl

@[simp] lemma snd_subset_snd_iff : c.snd ⊆ d.snd ↔ d ≤ c :=
begin
  refine ⟨λ h, _, λ h, _⟩,
  { rw [←fst_subset_fst_iff, ←c.closure_snd, ←d.closure_snd],
    exact extent_closure_anti _ h },
  { rw [←c.closure_fst, ←d.closure_fst],
    exact intent_closure_anti _ h }
end

@[simp] lemma snd_ssubset_snd_iff : c.snd ⊂ d.snd ↔ d < c :=
by rw [ssubset_iff_subset_not_subset, lt_iff_le_not_le, snd_subset_snd_iff, snd_subset_snd_iff]

lemma strict_mono_fst : strict_mono (prod.fst ∘ to_prod : concept α β r → set α) :=
λ c d, fst_ssubset_fst_iff.2

lemma strict_anti_snd : strict_anti (prod.snd ∘ to_prod : concept α β r → set β) :=
λ c d, snd_ssubset_snd_iff.2

instance : lattice (concept α β r) :=
{ sup := (⊔),
  le_sup_left := λ c d, snd_subset_snd_iff.1 $ inter_subset_left _ _,
  le_sup_right := λ c d, snd_subset_snd_iff.1 $ inter_subset_right _ _,
  sup_le := λ c d e, by { simp_rw ←snd_subset_snd_iff, exact subset_inter },
  ..concept.semilattice_inf }

instance : bounded_order (concept α β r) :=
{ top := ⟨⟨univ, intent_closure r univ⟩, rfl, eq_univ_of_forall $ λ a b hb, hb trivial⟩,
  le_top := λ _, subset_univ _,
  bot := ⟨⟨extent_closure r univ, univ⟩, eq_univ_of_forall $ λ b a ha, ha trivial, rfl⟩,
  bot_le := λ _, snd_subset_snd_iff.1 $ subset_univ _ }

instance : has_Sup (concept α β r) :=
⟨λ S, { fst := extent_closure r (⋂ c ∈ S, (c : concept _ _ _).snd),
        snd := ⋂ c ∈ S, (c : concept _ _ _).snd,
        closure_fst := by simp_rw [←closure_fst, ←intent_closure_Union₂,
          intent_closure_extent_closure_intent_closure],
        closure_snd := rfl }⟩

instance : has_Inf (concept α β r) :=
⟨λ S, { fst := ⋂ c ∈ S, (c : concept _ _ _).fst,
        snd := intent_closure r (⋂ c ∈ S, (c : concept _ _ _).fst),
        closure_fst := rfl,
        closure_snd := by simp_rw [←closure_snd, ←extent_closure_Union₂,
          extent_closure_intent_closure_extent_closure] }⟩

instance : complete_lattice (concept α β r) :=
{ Sup := Sup,
  le_Sup := λ S c hc, snd_subset_snd_iff.1 $ bInter_subset_of_mem hc,
  Sup_le := λ S c hc, snd_subset_snd_iff.1 $ subset_Inter₂ $ λ d hd, snd_subset_snd_iff.2 $ hc d hd,
  Inf := Inf,
  Inf_le := λ S c, bInter_subset_of_mem,
  le_Inf := λ S c, subset_Inter₂,
  ..concept.lattice, ..concept.bounded_order }

@[simp] lemma top_fst : (⊤ : concept α β r).fst = univ := rfl
@[simp] lemma top_snd : (⊤ : concept α β r).snd = intent_closure r univ := rfl
@[simp] lemma bot_fst : (⊥ : concept α β r).fst = extent_closure r univ := rfl
@[simp] lemma bot_snd : (⊥ : concept α β r).snd = univ := rfl
@[simp] lemma sup_fst (c d : concept α β r) : (c ⊔ d).fst = extent_closure r (c.snd ∩ d.snd) := rfl
@[simp] lemma sup_snd (c d : concept α β r) : (c ⊔ d).snd = c.snd ∩ d.snd := rfl
@[simp] lemma inf_fst (c d : concept α β r) : (c ⊓ d).fst = c.fst ∩ d.fst := rfl
@[simp] lemma inf_snd (c d : concept α β r) : (c ⊓ d).snd = intent_closure r (c.fst ∩ d.fst) := rfl
@[simp] lemma Sup_fst (S : set (concept α β r)) :
  (Sup S).fst = extent_closure r ⋂ c ∈ S, (c : concept _ _ _).snd := rfl
@[simp] lemma Sup_snd (S : set (concept α β r)) : (Sup S).snd = ⋂ c ∈ S, (c : concept _ _ _).snd :=
rfl
@[simp] lemma Inf_fst (S : set (concept α β r)) : (Inf S).fst = ⋂ c ∈ S, (c : concept _ _ _).fst :=
rfl
@[simp] lemma Inf_snd (S : set (concept α β r)) :
  (Inf S).snd = intent_closure r ⋂ c ∈ S, (c : concept _ _ _).fst := rfl

instance : inhabited (concept α β r) := ⟨⊥⟩

/-- Swap the sets of a concept to make it a concept of the dual context. -/
@[simps] def swap (c : concept α β r) : concept β α (swap r) :=
⟨c.to_prod.swap, c.closure_snd, c.closure_fst⟩

@[simp] lemma swap_swap (c : concept α β r) : c.swap.swap = c := ext rfl

@[simp] lemma swap_le_swap_iff : c.swap ≤ d.swap ↔ d ≤ c := snd_subset_snd_iff
@[simp] lemma swap_lt_swap_iff : c.swap < d.swap ↔ d < c := snd_ssubset_snd_iff

/-- The dual of a concept lattice is isomorphic to the concept lattice of the dual context. -/
@[simps] def swap_equiv : (concept α β r)ᵒᵈ ≃o concept β α (function.swap r) :=
{ to_fun := swap ∘ of_dual,
  inv_fun := to_dual ∘ swap,
  left_inv := swap_swap,
  right_inv := swap_swap,
  map_rel_iff' := λ c d, swap_le_swap_iff }

end concept


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import data.equiv.mul_add_aut
import group_theory.group_action.units

/-!
# Group actions applied to various types of group

This file contains lemmas about `smul` on `group_with_zero`, and `group`.
-/

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

section mul_action

/-- `monoid.to_mul_action` is faithful on cancellative monoids. -/
@[to_additive /-" `add_monoid.to_add_action` is faithful on additive cancellative monoids. "-/]
instance right_cancel_monoid.to_has_faithful_scalar [right_cancel_monoid α] :
  has_faithful_scalar α α :=
⟨λ x y h, mul_right_cancel (h 1)⟩

section group
variables [group α] [mul_action α β]

@[simp, to_additive] lemma inv_smul_smul (c : α) (x : β) : c⁻¹ • c • x = x :=
by rw [smul_smul, mul_left_inv, one_smul]

@[simp, to_additive] lemma smul_inv_smul (c : α) (x : β) : c • c⁻¹ • x = x :=
by rw [smul_smul, mul_right_inv, one_smul]

/-- Given an action of a group `α` on `β`, each `g : α` defines a permutation of `β`. -/
@[to_additive, simps] def mul_action.to_perm (a : α) : equiv.perm β :=
⟨λ x, a • x, λ x, a⁻¹ • x, inv_smul_smul a, smul_inv_smul a⟩

/-- Given an action of an additive group `α` on `β`, each `g : α` defines a permutation of `β`. -/
add_decl_doc add_action.to_perm

/-- `mul_action.to_perm` is injective on faithful actions. -/
@[to_additive] lemma mul_action.to_perm_injective [has_faithful_scalar α β] :
  function.injective (mul_action.to_perm : α → equiv.perm β) :=
(show function.injective (equiv.to_fun ∘ mul_action.to_perm), from smul_left_injective').of_comp

variables (α) (β)

/-- Given an action of a group `α` on a set `β`, each `g : α` defines a permutation of `β`. -/
@[simps]
def mul_action.to_perm_hom : α →* equiv.perm β :=
{ to_fun := mul_action.to_perm,
  map_one' := equiv.ext $ one_smul α,
  map_mul' := λ u₁ u₂, equiv.ext $ mul_smul (u₁:α) u₂ }

/-- Given an action of a additive group `α` on a set `β`, each `g : α` defines a permutation of
`β`. -/
@[simps]
def add_action.to_perm_hom (α : Type*) [add_group α] [add_action α β] :
  α →+ additive (equiv.perm β) :=
{ to_fun := λ a, additive.of_mul $ add_action.to_perm a,
  map_zero' := equiv.ext $ zero_vadd α,
  map_add' := λ a₁ a₂, equiv.ext $ add_vadd a₁ a₂ }

/-- The tautological action by `equiv.perm α` on `α`.

This generalizes `function.End.apply_mul_action`.-/
instance equiv.perm.apply_mul_action (α : Type*) : mul_action (equiv.perm α) α :=
{ smul := λ f a, f a,
  one_smul := λ _, rfl,
  mul_smul := λ _ _ _, rfl }

@[simp] protected lemma equiv.perm.smul_def {α : Type*} (f : equiv.perm α) (a : α) : f • a = f a :=
rfl

/-- `equiv.perm.apply_mul_action` is faithful. -/
instance equiv.perm.apply_has_faithful_scalar (α : Type*) : has_faithful_scalar (equiv.perm α) α :=
⟨λ x y, equiv.ext⟩

variables {α} {β}

@[to_additive] lemma inv_smul_eq_iff {a : α} {x y : β} : a⁻¹ • x = y ↔ x = a • y :=
(mul_action.to_perm a).symm_apply_eq

@[to_additive] lemma eq_inv_smul_iff {a : α} {x y : β} : x = a⁻¹ • y ↔ a • x = y :=
(mul_action.to_perm a).eq_symm_apply

lemma smul_inv [group β] [smul_comm_class α β β] [is_scalar_tower α β β] (c : α) (x : β) :
  (c • x)⁻¹ = c⁻¹ • x⁻¹  :=
by rw [inv_eq_iff_mul_eq_one, smul_mul_smul, mul_right_inv, mul_right_inv, one_smul]

lemma smul_zpow [group β] [smul_comm_class α β β] [is_scalar_tower α β β]
  (c : α) (x : β) (p : ℤ) :
  (c • x) ^ p = c ^ p • x ^ p :=
by { cases p; simp [smul_pow, smul_inv] }

@[to_additive] protected lemma mul_action.bijective (g : α) : function.bijective (λ b : β, g • b) :=
(mul_action.to_perm g).bijective

@[to_additive] protected lemma mul_action.injective (g : α) : function.injective (λ b : β, g • b) :=
(mul_action.bijective g).injective

@[to_additive] lemma smul_left_cancel (g : α) {x y : β} (h : g • x = g • y) : x = y :=
mul_action.injective g h

@[simp, to_additive] lemma smul_left_cancel_iff (g : α) {x y : β} : g • x = g • y ↔ x = y :=
(mul_action.injective g).eq_iff

@[to_additive] lemma smul_eq_iff_eq_inv_smul (g : α) {x y : β} :
  g • x = y ↔ x = g⁻¹ • y :=
(mul_action.to_perm g).apply_eq_iff_eq_symm_apply

end group

/-- `monoid.to_mul_action` is faithful on nontrivial cancellative monoids with zero. -/
instance cancel_monoid_with_zero.to_has_faithful_scalar [cancel_monoid_with_zero α] [nontrivial α] :
  has_faithful_scalar α α :=
⟨λ x y h, mul_left_injective₀ one_ne_zero (h 1)⟩

section gwz
variables [group_with_zero α] [mul_action α β]

@[simp]
lemma inv_smul_smul₀ {c : α} (hc : c ≠ 0) (x : β) : c⁻¹ • c • x = x :=
inv_smul_smul (units.mk0 c hc) x

@[simp]
lemma smul_inv_smul₀ {c : α} (hc : c ≠ 0) (x : β) : c • c⁻¹ • x = x :=
smul_inv_smul (units.mk0 c hc) x

lemma inv_smul_eq_iff₀ {a : α} (ha : a ≠ 0) {x y : β} : a⁻¹ • x = y ↔ x = a • y :=
(mul_action.to_perm (units.mk0 a ha)).symm_apply_eq

lemma eq_inv_smul_iff₀ {a : α} (ha : a ≠ 0) {x y : β} : x = a⁻¹ • y ↔ a • x = y :=
(mul_action.to_perm (units.mk0 a ha)).eq_symm_apply

end gwz

end mul_action

section distrib_mul_action

section group
variables [group α] [add_monoid β] [distrib_mul_action α β]

variables (β)

/-- Each element of the group defines an additive monoid isomorphism.

This is a stronger version of `mul_action.to_perm`. -/
@[simps {simp_rhs := tt}]
def distrib_mul_action.to_add_equiv (x : α) : β ≃+ β :=
{ .. distrib_mul_action.to_add_monoid_hom β x,
  .. mul_action.to_perm_hom α β x }

variables (α β)

/-- Each element of the group defines an additive monoid isomorphism.

This is a stronger version of `mul_action.to_perm_hom`. -/
@[simps]
def distrib_mul_action.to_add_aut : α →* add_aut β :=
{ to_fun := distrib_mul_action.to_add_equiv β,
  map_one' := add_equiv.ext (one_smul _),
  map_mul' := λ a₁ a₂, add_equiv.ext (mul_smul _ _) }

variables {α β}

theorem smul_eq_zero_iff_eq (a : α) {x : β} : a • x = 0 ↔ x = 0 :=
⟨λ h, by rw [← inv_smul_smul a x, h, smul_zero], λ h, h.symm ▸ smul_zero _⟩

theorem smul_ne_zero_iff_ne (a : α) {x : β} : a • x ≠ 0 ↔ x ≠ 0 :=
not_congr $ smul_eq_zero_iff_eq a

end group

section gwz
variables [group_with_zero α] [add_monoid β] [distrib_mul_action α β]

theorem smul_eq_zero_iff_eq' {a : α} (ha : a ≠ 0) {x : β} : a • x = 0 ↔ x = 0 :=
smul_eq_zero_iff_eq (units.mk0 a ha)

theorem smul_ne_zero_iff_ne' {a : α} (ha : a ≠ 0) {x : β} : a • x ≠ 0 ↔ x ≠ 0 :=
smul_ne_zero_iff_ne (units.mk0 a ha)

end gwz

end distrib_mul_action

section mul_distrib_mul_action
variables [group α] [monoid β] [mul_distrib_mul_action α β]

variables (β)

/-- Each element of the group defines a multiplicative monoid isomorphism.

This is a stronger version of `mul_action.to_perm`. -/
@[simps {simp_rhs := tt}]
def mul_distrib_mul_action.to_mul_equiv (x : α) : β ≃* β :=
{ .. mul_distrib_mul_action.to_monoid_hom β x,
  .. mul_action.to_perm_hom α β x }

variables (α β)

/-- Each element of the group defines an multiplicative monoid isomorphism.

This is a stronger version of `mul_action.to_perm_hom`. -/
@[simps]
def mul_distrib_mul_action.to_mul_aut : α →* mul_aut β :=
{ to_fun := mul_distrib_mul_action.to_mul_equiv β,
  map_one' := mul_equiv.ext (one_smul _),
  map_mul' := λ a₁ a₂, mul_equiv.ext (mul_smul _ _) }

variables {α β}

end mul_distrib_mul_action

section arrow

/-- If `G` acts on `A`, then it acts also on `A → B`, by `(g • F) a = F (g⁻¹ • a)`. -/
@[simps] def arrow_action {G A B : Type*} [group G] [mul_action G A] : mul_action G (A → B) :=
{ smul := λ g F a, F (g⁻¹ • a),
  one_smul := by { intro, simp only [one_inv, one_smul] },
  mul_smul := by { intros, simp only [mul_smul, mul_inv_rev] } }

local attribute [instance] arrow_action

/-- When `B` is a monoid, `arrow_action` is additionally a `mul_distrib_mul_action`. -/
def arrow_mul_distrib_mul_action {G A B : Type*} [group G] [mul_action G A] [monoid B] :
  mul_distrib_mul_action G (A → B) :=
{ smul_one := λ g, rfl,
  smul_mul := λ g f₁ f₂, rfl }

local attribute [instance] arrow_mul_distrib_mul_action

/-- Given groups `G H` with `G` acting on `A`, `G` acts by
  multiplicative automorphisms on `A → H`. -/
@[simps] def mul_aut_arrow {G A H} [group G] [mul_action G A] [monoid H] : G →* mul_aut (A → H) :=
mul_distrib_mul_action.to_mul_aut _ _

end arrow

namespace is_unit

section mul_action
variables [monoid α] [mul_action α β]

@[to_additive] lemma smul_left_cancel {a : α} (ha : is_unit a) {x y : β} :
  a • x = a • y ↔ x = y :=
let ⟨u, hu⟩ := ha in hu ▸ smul_left_cancel_iff u

end mul_action

section distrib_mul_action
variables [monoid α] [add_monoid β] [distrib_mul_action α β]

@[simp] theorem smul_eq_zero {u : α} (hu : is_unit u) {x : β} :
  u • x = 0 ↔ x = 0 :=
exists.elim hu $ λ u hu, hu ▸ smul_eq_zero_iff_eq u

end distrib_mul_action

end is_unit

@[simp] lemma is_unit_smul_iff [group α] [monoid β] [mul_action α β]
  [smul_comm_class α β β] [is_scalar_tower α β β] {g : α} {m : β} :
  is_unit (g • m) ↔ is_unit m :=
⟨λ h, inv_smul_smul g m ▸ h.smul g⁻¹, is_unit.smul g⟩


-- Eliminacion_de_la_conjuncion.lean
-- Eliminación de la conjunción.
-- José A. Alonso Jiménez
-- Sevilla, 12 de agosto de 2020
-- ---------------------------------------------------------------------

-- En este relación se muestra distintas formas de demostrar un teorema
-- con eliminación de la conjunción.

import tactic
variables (P Q : Prop)

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    P ∧ Q → P
-- ----------------------------------------------------------------------

-- 1ª demostración (con intro, cases y exact)
-- ==========================================

example : P ∧ Q → P :=
begin
  intro h,
  cases h with hP hQ,
  exact hP,
end

-- Prueba:
/-
  P Q : Prop
  ⊢ P ∧ Q → P
intro h,
  h : P ∧ Q
  ⊢ P
cases h with hP hQ,
  hP : P,
  hQ : Q
  ⊢ P
exact hP,
  no goals
-/

-- Comentarios:
-- + La táctica (cases h with h1 h2), cuando la hipótesis h es una
--   conjunción aplica la regla de eliminación de la conjunción; es
--   decir, si h es (P ∧ Q), entonces elimina h y añade las hipótesis
--   (h1 : P) y (h2 : Q).

-- 2ª demostración (con rintro y exact)
-- ====================================

example : P ∧ Q → P :=
begin
  rintro ⟨hP, hQ⟩,
  exact hP,
end

-- Prueba:
/-
  P Q : Prop
  ⊢ P ∧ Q → P
rintro ⟨hP, hQ⟩,
  hP : P,
  hQ : Q
  ⊢ P
exact hP,
  no goals
-/

-- Comentarios:
-- + La táctica (rintro ⟨h1, h2⟩), cuando la conclusión es una
--   implicación cuyo antecedente es una conjunción, aplica las reglsa
--   de introducción de la implicación y de eliminación de la conjunción;
--   es decir, si la conclusión es (P ∧ Q → R) entonces añade las
--   hipótesis (h1 : P) y (h2 : Q) y cambia la conclusión a R.

-- 3ª demostración (con rintro y assumption)
-- =========================================

example : P ∧ Q → P :=
begin
  rintro ⟨hP, hQ⟩,
  assumption,
end

-- Comentarios:
-- + la táctica assumption concluye la demostración si la conclusión
--   coincide con alguna de las hipótesis.

-- 4ª demostración (estructurada)
-- ==============================

example : P ∧ Q → P :=
begin
  assume h : P ∧ Q,
  show P, from h.1,
end

-- 5ª demostración (estructurada)
-- ==============================

example : P ∧ Q → P :=
assume h, h.1

-- 6ª demostración (con término de prueba)
-- ======================================

example : P ∧ Q → P :=
λ ⟨hP,_⟩, hP

-- 7ª demostración (con lema)
-- ==========================

example : P ∧ Q → P :=
and.left

-- Comentarios:
-- + Se usa el lema
--      and.left : P ∧ Q → P
-- + El lema se encuentra con
--      by library_search

-- 8ª demostración (automática con auto)
-- =====================================

example : P ∧ Q → P :=
by tauto

-- 9ª demostración (automática con finish)
-- =======================================

example : P ∧ Q → P :=
by finish


/-
Copyright (c) 2021 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta, Alena Gusakov, Yaël Dillies
-/
import data.finset.slice
import logic.function.iterate

/-!
# Shadows

This file defines shadows of a set family. The shadow of a set family is the set family of sets we
get by removing any element from any set of the original family. If one pictures `finset α` as a big
hypercube (each dimension being membership of a given element), then taking the shadow corresponds
to projecting each finset down once in all available directions.

## Main definitions

* `finset.shadow`: The shadow of a set family. Everything we can get by removing a new element from
  some set.
* `finset.up_shadow`: The upper shadow of a set family. Everything we can get by adding an element
  to some set.

## Notation

We define notation in locale `finset_family`:
* `∂ 𝒜`: Shadow of `𝒜`.
* `∂⁺ 𝒜`: Upper shadow of `𝒜`.

We also maintain the convention that `a, b : α` are elements of the ground type, `s, t : finset α`
are finsets, and `𝒜, ℬ : finset (finset α)` are finset families.

## References

* https://github.com/b-mehta/maths-notes/blob/master/iii/mich/combinatorics.pdf
* http://discretemath.imp.fu-berlin.de/DMII-2015-16/kruskal.pdf

## Tags

shadow, set family
-/

open finset nat

variables {α : Type*}

namespace finset
section shadow
variables [decidable_eq α] {𝒜 : finset (finset α)} {s t : finset α} {a : α} {k r : ℕ}

/-- The shadow of a set family `𝒜` is all sets we can get by removing one element from any set in
`𝒜`, and the (`k` times) iterated shadow (`shadow^[k]`) is all sets we can get by removing `k`
elements from any set in `𝒜`. -/
def shadow (𝒜 : finset (finset α)) : finset (finset α) := 𝒜.sup (λ s, s.image (erase s))

localized "notation `∂ `:90 := finset.shadow" in finset_family

/-- The shadow of the empty set is empty. -/
@[simp] lemma shadow_empty : ∂ (∅ : finset (finset α)) = ∅ := rfl
@[simp] lemma shadow_singleton_empty : ∂ ({∅} : finset (finset α)) = ∅ := rfl

--TODO: Prove `∂ {{a}} = {∅}` quickly using `covers` and `grade_order`

/-- The shadow is monotone. -/
@[mono] lemma shadow_monotone : monotone (shadow : finset (finset α) → finset (finset α)) :=
λ 𝒜 ℬ, sup_mono

/-- `s` is in the shadow of `𝒜` iff there is an `t ∈ 𝒜` from which we can remove one element to
get `s`. -/
lemma mem_shadow_iff : s ∈ ∂ 𝒜 ↔ ∃ t ∈ 𝒜, ∃ a ∈ t, erase t a = s :=
by simp only [shadow, mem_sup, mem_image]

lemma erase_mem_shadow (hs : s ∈ 𝒜) (ha : a ∈ s) : erase s a ∈ ∂ 𝒜 :=
mem_shadow_iff.2 ⟨s, hs, a, ha, rfl⟩

/-- `t` is in the shadow of `𝒜` iff we can add an element to it so that the resulting finset is in
`𝒜`. -/
lemma mem_shadow_iff_insert_mem : s ∈ ∂ 𝒜 ↔ ∃ a ∉ s, insert a s ∈ 𝒜 :=
begin
  refine mem_shadow_iff.trans ⟨_, _⟩,
  { rintro ⟨s, hs, a, ha, rfl⟩,
    refine ⟨a, not_mem_erase a s, _⟩,
    rwa insert_erase ha },
  { rintro ⟨a, ha, hs⟩,
    exact ⟨insert a s, hs, a, mem_insert_self _ _, erase_insert ha⟩ }
end

/-- The shadow of a family of `r`-sets is a family of `r - 1`-sets. -/
protected lemma _root_.set.sized.shadow (h𝒜 : (𝒜 : set (finset α)).sized r) :
  (∂ 𝒜 : set (finset α)).sized (r - 1) :=
begin
  intros A h,
  obtain ⟨A, hA, i, hi, rfl⟩ := mem_shadow_iff.1 h,
  rw [card_erase_of_mem hi, h𝒜 hA],
end

lemma sized_shadow_iff (h : ∅ ∉ 𝒜) :
  (∂ 𝒜 : set (finset α)).sized r ↔ (𝒜 : set (finset α)).sized (r + 1) :=
begin
  refine ⟨λ h𝒜 s hs, _, set.sized.shadow⟩,
  obtain ⟨a, ha⟩ := nonempty_iff_ne_empty.2 (ne_of_mem_of_not_mem hs h),
  rw [←h𝒜 (erase_mem_shadow hs ha), card_erase_add_one ha],
end

/-- `s ∈ ∂ 𝒜` iff `s` is exactly one element less than something from `𝒜` -/
lemma mem_shadow_iff_exists_mem_card_add_one :
  s ∈ ∂ 𝒜 ↔ ∃ t ∈ 𝒜, s ⊆ t ∧ t.card = s.card + 1 :=
begin
  refine mem_shadow_iff_insert_mem.trans ⟨_, _⟩,
  { rintro ⟨a, ha, hs⟩,
    exact ⟨insert a s, hs, subset_insert _ _, card_insert_of_not_mem ha⟩ },
  { rintro ⟨t, ht, hst, h⟩,
    obtain ⟨a, ha⟩ : ∃ a, t \ s = {a} :=
      card_eq_one.1 (by rw [card_sdiff hst, h, add_tsub_cancel_left]),
    exact ⟨a, λ hat,
      not_mem_sdiff_of_mem_right hat ((ha.ge : _ ⊆ _) $ mem_singleton_self a),
      by rwa [insert_eq a s, ←ha, sdiff_union_of_subset hst]⟩ }
end

/-- Being in the shadow of `𝒜` means we have a superset in `𝒜`. -/
lemma exists_subset_of_mem_shadow (hs : s ∈ ∂ 𝒜) : ∃ t ∈ 𝒜, s ⊆ t :=
let ⟨t, ht, hst⟩ := mem_shadow_iff_exists_mem_card_add_one.1 hs in ⟨t, ht, hst.1⟩

/-- `t ∈ ∂^k 𝒜` iff `t` is exactly `k` elements less than something in `𝒜`. -/
lemma mem_shadow_iff_exists_mem_card_add :
  s ∈ (∂^[k]) 𝒜 ↔ ∃ t ∈ 𝒜, s ⊆ t ∧ t.card = s.card + k :=
begin
  induction k with k ih generalizing 𝒜 s,
  { refine ⟨λ hs, ⟨s, hs, subset.refl _, rfl⟩, _⟩,
    rintro ⟨t, ht, hst, hcard⟩,
    rwa eq_of_subset_of_card_le hst hcard.le },
  simp only [exists_prop, function.comp_app, function.iterate_succ],
  refine ih.trans _,
  clear ih,
  split,
  { rintro ⟨t, ht, hst, hcardst⟩,
    obtain ⟨u, hu, htu, hcardtu⟩ := mem_shadow_iff_exists_mem_card_add_one.1 ht,
    refine ⟨u, hu, hst.trans htu, _⟩,
    rw [hcardtu, hcardst],
    refl },
  { rintro ⟨t, ht, hst, hcard⟩,
    obtain ⟨u, hsu, hut, hu⟩ := finset.exists_intermediate_set k
      (by { rw [add_comm, hcard], exact le_succ _ }) hst,
    rw add_comm at hu,
    refine ⟨u, mem_shadow_iff_exists_mem_card_add_one.2 ⟨t, ht, hut, _⟩, hsu, hu⟩,
    rw [hcard, hu],
    refl }
end

end shadow

open_locale finset_family

section up_shadow
variables [decidable_eq α] [fintype α] {𝒜 : finset (finset α)} {s t : finset α} {a : α} {k r : ℕ}

/-- The upper shadow of a set family `𝒜` is all sets we can get by adding one element to any set in
`𝒜`, and the (`k` times) iterated upper shadow (`up_shadow^[k]`) is all sets we can get by adding
`k` elements from any set in `𝒜`. -/
def up_shadow (𝒜 : finset (finset α)) : finset (finset α) :=
𝒜.sup $ λ s, sᶜ.image $ λ a, insert a s

localized "notation `∂⁺ `:90 := finset.up_shadow" in finset_family

/-- The upper shadow of the empty set is empty. -/
@[simp] lemma up_shadow_empty : ∂⁺ (∅ : finset (finset α)) = ∅ := rfl

/-- The upper shadow is monotone. -/
@[mono] lemma up_shadow_monotone : monotone (up_shadow : finset (finset α) → finset (finset α)) :=
λ 𝒜 ℬ, sup_mono

/-- `s` is in the upper shadow of `𝒜` iff there is an `t ∈ 𝒜` from which we can remove one element
to get `s`. -/
lemma mem_up_shadow_iff : s ∈ ∂⁺ 𝒜 ↔ ∃ t ∈ 𝒜, ∃ a ∉ t, insert a t = s :=
by simp_rw [up_shadow, mem_sup, mem_image, exists_prop, mem_compl]

lemma insert_mem_up_shadow (hs : s ∈ 𝒜) (ha : a ∉ s) : insert a s ∈ ∂⁺ 𝒜 :=
mem_up_shadow_iff.2 ⟨s, hs, a, ha, rfl⟩

/-- The upper shadow of a family of `r`-sets is a family of `r + 1`-sets. -/
protected lemma _root_.set.sized.up_shadow (h𝒜 : (𝒜 : set (finset α)).sized r) :
  (∂⁺ 𝒜 : set (finset α)).sized (r + 1) :=
begin
  intros A h,
  obtain ⟨A, hA, i, hi, rfl⟩ := mem_up_shadow_iff.1 h,
  rw [card_insert_of_not_mem hi, h𝒜 hA],
end

/-- `t` is in the upper shadow of `𝒜` iff we can remove an element from it so that the resulting
finset is in `𝒜`. -/
lemma mem_up_shadow_iff_erase_mem : s ∈ ∂⁺ 𝒜 ↔ ∃ a ∈ s, s.erase a ∈ 𝒜 :=
begin
  refine mem_up_shadow_iff.trans ⟨_, _⟩,
  { rintro ⟨s, hs, a, ha, rfl⟩,
    refine ⟨a, mem_insert_self a s, _⟩,
    rwa erase_insert ha },
  { rintro ⟨a, ha, hs⟩,
    exact ⟨s.erase a, hs, a, not_mem_erase _ _, insert_erase ha⟩ }
end

/-- `s ∈ ∂⁺ 𝒜` iff `s` is exactly one element less than something from `𝒜`. -/
lemma mem_up_shadow_iff_exists_mem_card_add_one :
  s ∈ ∂⁺ 𝒜 ↔ ∃ t ∈ 𝒜, t ⊆ s ∧ t.card + 1 = s.card :=
begin
  refine mem_up_shadow_iff_erase_mem.trans ⟨_, _⟩,
  { rintro ⟨a, ha, hs⟩,
    exact ⟨s.erase a, hs, erase_subset _ _, card_erase_add_one ha⟩ },
  { rintro ⟨t, ht, hts, h⟩,
    obtain ⟨a, ha⟩ : ∃ a, s \ t = {a} :=
      card_eq_one.1 (by rw [card_sdiff hts, ←h, add_tsub_cancel_left]),
    refine ⟨a, sdiff_subset _ _ ((ha.ge : _ ⊆ _) $ mem_singleton_self a), _⟩,
    rwa [←sdiff_singleton_eq_erase, ←ha, sdiff_sdiff_eq_self hts] }
end

/-- Being in the upper shadow of `𝒜` means we have a superset in `𝒜`. -/
lemma exists_subset_of_mem_up_shadow (hs : s ∈ ∂⁺ 𝒜) : ∃ t ∈ 𝒜, t ⊆ s :=
let ⟨t, ht, hts, _⟩ := mem_up_shadow_iff_exists_mem_card_add_one.1 hs in ⟨t, ht, hts⟩

/-- `t ∈ ∂^k 𝒜` iff `t` is exactly `k` elements more than something in `𝒜`. -/
lemma mem_up_shadow_iff_exists_mem_card_add :
  s ∈ (∂⁺^[k]) 𝒜 ↔ ∃ t ∈ 𝒜, t ⊆ s ∧ t.card + k = s.card :=
begin
  induction k with k ih generalizing 𝒜 s,
  { refine ⟨λ hs, ⟨s, hs, subset.refl _, rfl⟩, _⟩,
    rintro ⟨t, ht, hst, hcard⟩,
    rwa ←eq_of_subset_of_card_le hst hcard.ge },
  simp only [exists_prop, function.comp_app, function.iterate_succ],
  refine ih.trans _,
  clear ih,
  split,
  { rintro ⟨t, ht, hts, hcardst⟩,
    obtain ⟨u, hu, hut, hcardtu⟩ := mem_up_shadow_iff_exists_mem_card_add_one.1 ht,
    refine ⟨u, hu, hut.trans hts, _⟩,
    rw [←hcardst, ←hcardtu, add_right_comm],
    refl },
  { rintro ⟨t, ht, hts, hcard⟩,
    obtain ⟨u, htu, hus, hu⟩ := finset.exists_intermediate_set 1
      (by { rw [add_comm, ←hcard], exact add_le_add_left (zero_lt_succ _) _ }) hts,
    rw add_comm at hu,
    refine ⟨u, mem_up_shadow_iff_exists_mem_card_add_one.2 ⟨t, ht, htu, hu.symm⟩, hus, _⟩,
    rw [hu, ←hcard, add_right_comm],
    refl }
end

@[simp] lemma shadow_image_compl : (∂ 𝒜).image compl = ∂⁺ (𝒜.image compl) :=
begin
  ext s,
  simp only [mem_image, exists_prop, mem_shadow_iff, mem_up_shadow_iff],
  split,
  { rintro ⟨_, ⟨s, hs, a, ha, rfl⟩, rfl⟩,
    exact ⟨sᶜ, ⟨s, hs, rfl⟩, a, not_mem_compl.2 ha, compl_erase.symm⟩ },
  { rintro ⟨_, ⟨s, hs, rfl⟩, a, ha, rfl⟩,
    exact ⟨s.erase a, ⟨s, hs, a, not_mem_compl.1 ha, rfl⟩, compl_erase⟩ }
end

@[simp] lemma up_shadow_image_compl : (∂⁺ 𝒜).image compl = ∂ (𝒜.image compl) :=
begin
  ext s,
  simp only [mem_image, exists_prop, mem_shadow_iff, mem_up_shadow_iff],
  split,
  { rintro ⟨_, ⟨s, hs, a, ha, rfl⟩, rfl⟩,
    exact ⟨sᶜ, ⟨s, hs, rfl⟩, a, mem_compl.2 ha, compl_insert.symm⟩ },
  { rintro ⟨_, ⟨s, hs, rfl⟩, a, ha, rfl⟩,
    exact ⟨insert a s, ⟨s, hs, a, mem_compl.1 ha, rfl⟩, compl_insert⟩ }
end

end up_shadow
end finset


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

! This file was ported from Lean 3 source module order.heyting.boundary
! leanprover-community/mathlib commit 448144f7ae193a8990cb7473c9e9a01990f64ac7
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Order.BooleanAlgebra

/-!
# Co-Heyting boundary

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

The boundary of an element of a co-Heyting algebra is the intersection of its Heyting negation with
itself. The boundary in the co-Heyting algebra of closed sets coincides with the topological
boundary.

## Main declarations

* `coheyting.boundary`: Co-Heyting boundary. `coheyting.boundary a = a ⊓ ￢a`

## Notation

`∂ a` is notation for `coheyting.boundary a` in locale `heyting`.
-/

variable {α : Type _}

namespace Coheyting

variable [CoheytingAlgebra α] {a b : α}

#print Coheyting.boundary /-
/-- The boundary of an element of a co-Heyting algebra is the intersection of its Heyting negation
with itself. Note that this is always `⊥` for a boolean algebra. -/
def boundary (a : α) : α :=
  a ⊓ ￢a
#align coheyting.boundary Coheyting.boundary
-/

-- mathport name: «expr∂ »
scoped[Heyting] prefix:120 "∂ " => Coheyting.boundary

/- warning: coheyting.inf_hnot_self -> Coheyting.inf_hnot_self is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : CoheytingAlgebra.{u1} α] (a : α), Eq.{succ u1} α (Inf.inf.{u1} α (SemilatticeInf.toHasInf.{u1} α (Lattice.toSemilatticeInf.{u1} α (GeneralizedCoheytingAlgebra.toLattice.{u1} α (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} α _inst_1)))) a (HNot.hnot.{u1} α (CoheytingAlgebra.toHasHnot.{u1} α _inst_1) a)) (Coheyting.boundary.{u1} α _inst_1 a)
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : CoheytingAlgebra.{u1} α] (a : α), Eq.{succ u1} α (Inf.inf.{u1} α (Lattice.toInf.{u1} α (GeneralizedCoheytingAlgebra.toLattice.{u1} α (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} α _inst_1))) a (HNot.hnot.{u1} α (CoheytingAlgebra.toHNot.{u1} α _inst_1) a)) (Coheyting.boundary.{u1} α _inst_1 a)
Case conversion may be inaccurate. Consider using '#align coheyting.inf_hnot_self Coheyting.inf_hnot_selfₓ'. -/
theorem inf_hnot_self (a : α) : a ⊓ ￢a = ∂ a :=
  rfl
#align coheyting.inf_hnot_self Coheyting.inf_hnot_self

#print Coheyting.boundary_le /-
theorem boundary_le : ∂ a ≤ a :=
  inf_le_left
#align coheyting.boundary_le Coheyting.boundary_le
-/

/- warning: coheyting.boundary_le_hnot -> Coheyting.boundary_le_hnot is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : CoheytingAlgebra.{u1} α] {a : α}, LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (GeneralizedCoheytingAlgebra.toLattice.{u1} α (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} α _inst_1)))))) (Coheyting.boundary.{u1} α _inst_1 a) (HNot.hnot.{u1} α (CoheytingAlgebra.toHasHnot.{u1} α _inst_1) a)
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : CoheytingAlgebra.{u1} α] {a : α}, LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (GeneralizedCoheytingAlgebra.toLattice.{u1} α (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} α _inst_1)))))) (Coheyting.boundary.{u1} α _inst_1 a) (HNot.hnot.{u1} α (CoheytingAlgebra.toHNot.{u1} α _inst_1) a)
Case conversion may be inaccurate. Consider using '#align coheyting.boundary_le_hnot Coheyting.boundary_le_hnotₓ'. -/
theorem boundary_le_hnot : ∂ a ≤ ￢a :=
  inf_le_right
#align coheyting.boundary_le_hnot Coheyting.boundary_le_hnot

/- warning: coheyting.boundary_bot -> Coheyting.boundary_bot is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : CoheytingAlgebra.{u1} α], Eq.{succ u1} α (Coheyting.boundary.{u1} α _inst_1 (Bot.bot.{u1} α (GeneralizedCoheytingAlgebra.toHasBot.{u1} α (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} α _inst_1)))) (Bot.bot.{u1} α (GeneralizedCoheytingAlgebra.toHasBot.{u1} α (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} α _inst_1)))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : CoheytingAlgebra.{u1} α], Eq.{succ u1} α (Coheyting.boundary.{u1} α _inst_1 (Bot.bot.{u1} α (GeneralizedCoheytingAlgebra.toBot.{u1} α (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} α _inst_1)))) (Bot.bot.{u1} α (GeneralizedCoheytingAlgebra.toBot.{u1} α (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} α _inst_1)))
Case conversion may be inaccurate. Consider using '#align coheyting.boundary_bot Coheyting.boundary_botₓ'. -/
@[simp]
theorem boundary_bot : ∂ (⊥ : α) = ⊥ :=
  bot_inf_eq
#align coheyting.boundary_bot Coheyting.boundary_bot

/- warning: coheyting.boundary_top -> Coheyting.boundary_top is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : CoheytingAlgebra.{u1} α], Eq.{succ u1} α (Coheyting.boundary.{u1} α _inst_1 (Top.top.{u1} α (CoheytingAlgebra.toHasTop.{u1} α _inst_1))) (Bot.bot.{u1} α (GeneralizedCoheytingAlgebra.toHasBot.{u1} α (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} α _inst_1)))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : CoheytingAlgebra.{u1} α], Eq.{succ u1} α (Coheyting.boundary.{u1} α _inst_1 (Top.top.{u1} α (CoheytingAlgebra.toTop.{u1} α _inst_1))) (Bot.bot.{u1} α (GeneralizedCoheytingAlgebra.toBot.{u1} α (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} α _inst_1)))
Case conversion may be inaccurate. Consider using '#align coheyting.boundary_top Coheyting.boundary_topₓ'. -/
@[simp]
theorem boundary_top : ∂ (⊤ : α) = ⊥ := by rw [boundary, hnot_top, inf_bot_eq]
#align coheyting.boundary_top Coheyting.boundary_top

/- warning: coheyting.boundary_hnot_le -> Coheyting.boundary_hnot_le is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : CoheytingAlgebra.{u1} α] (a : α), LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (GeneralizedCoheytingAlgebra.toLattice.{u1} α (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} α _inst_1)))))) (Coheyting.boundary.{u1} α _inst_1 (HNot.hnot.{u1} α (CoheytingAlgebra.toHasHnot.{u1} α _inst_1) a)) (Coheyting.boundary.{u1} α _inst_1 a)
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : CoheytingAlgebra.{u1} α] (a : α), LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (GeneralizedCoheytingAlgebra.toLattice.{u1} α (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} α _inst_1)))))) (Coheyting.boundary.{u1} α _inst_1 (HNot.hnot.{u1} α (CoheytingAlgebra.toHNot.{u1} α _inst_1) a)) (Coheyting.boundary.{u1} α _inst_1 a)
Case conversion may be inaccurate. Consider using '#align coheyting.boundary_hnot_le Coheyting.boundary_hnot_leₓ'. -/
theorem boundary_hnot_le (a : α) : ∂ (￢a) ≤ ∂ a :=
  inf_comm.trans_le <| inf_le_inf_right _ hnot_hnot_le
#align coheyting.boundary_hnot_le Coheyting.boundary_hnot_le

/- warning: coheyting.boundary_hnot_hnot -> Coheyting.boundary_hnot_hnot is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : CoheytingAlgebra.{u1} α] (a : α), Eq.{succ u1} α (Coheyting.boundary.{u1} α _inst_1 (HNot.hnot.{u1} α (CoheytingAlgebra.toHasHnot.{u1} α _inst_1) (HNot.hnot.{u1} α (CoheytingAlgebra.toHasHnot.{u1} α _inst_1) a))) (Coheyting.boundary.{u1} α _inst_1 (HNot.hnot.{u1} α (CoheytingAlgebra.toHasHnot.{u1} α _inst_1) a))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : CoheytingAlgebra.{u1} α] (a : α), Eq.{succ u1} α (Coheyting.boundary.{u1} α _inst_1 (HNot.hnot.{u1} α (CoheytingAlgebra.toHNot.{u1} α _inst_1) (HNot.hnot.{u1} α (CoheytingAlgebra.toHNot.{u1} α _inst_1) a))) (Coheyting.boundary.{u1} α _inst_1 (HNot.hnot.{u1} α (CoheytingAlgebra.toHNot.{u1} α _inst_1) a))
Case conversion may be inaccurate. Consider using '#align coheyting.boundary_hnot_hnot Coheyting.boundary_hnot_hnotₓ'. -/
@[simp]
theorem boundary_hnot_hnot (a : α) : ∂ (￢￢a) = ∂ (￢a) := by
  simp_rw [boundary, hnot_hnot_hnot, inf_comm]
#align coheyting.boundary_hnot_hnot Coheyting.boundary_hnot_hnot

/- warning: coheyting.hnot_boundary -> Coheyting.hnot_boundary is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : CoheytingAlgebra.{u1} α] (a : α), Eq.{succ u1} α (HNot.hnot.{u1} α (CoheytingAlgebra.toHasHnot.{u1} α _inst_1) (Coheyting.boundary.{u1} α _inst_1 a)) (Top.top.{u1} α (CoheytingAlgebra.toHasTop.{u1} α _inst_1))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : CoheytingAlgebra.{u1} α] (a : α), Eq.{succ u1} α (HNot.hnot.{u1} α (CoheytingAlgebra.toHNot.{u1} α _inst_1) (Coheyting.boundary.{u1} α _inst_1 a)) (Top.top.{u1} α (CoheytingAlgebra.toTop.{u1} α _inst_1))
Case conversion may be inaccurate. Consider using '#align coheyting.hnot_boundary Coheyting.hnot_boundaryₓ'. -/
@[simp]
theorem hnot_boundary (a : α) : ￢∂ a = ⊤ := by rw [boundary, hnot_inf_distrib, sup_hnot_self]
#align coheyting.hnot_boundary Coheyting.hnot_boundary

/- warning: coheyting.boundary_inf -> Coheyting.boundary_inf is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : CoheytingAlgebra.{u1} α] (a : α) (b : α), Eq.{succ u1} α (Coheyting.boundary.{u1} α _inst_1 (Inf.inf.{u1} α (SemilatticeInf.toHasInf.{u1} α (Lattice.toSemilatticeInf.{u1} α (GeneralizedCoheytingAlgebra.toLattice.{u1} α (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} α _inst_1)))) a b)) (Sup.sup.{u1} α (SemilatticeSup.toHasSup.{u1} α (Lattice.toSemilatticeSup.{u1} α (GeneralizedCoheytingAlgebra.toLattice.{u1} α (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} α _inst_1)))) (Inf.inf.{u1} α (SemilatticeInf.toHasInf.{u1} α (Lattice.toSemilatticeInf.{u1} α (GeneralizedCoheytingAlgebra.toLattice.{u1} α (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} α _inst_1)))) (Coheyting.boundary.{u1} α _inst_1 a) b) (Inf.inf.{u1} α (SemilatticeInf.toHasInf.{u1} α (Lattice.toSemilatticeInf.{u1} α (GeneralizedCoheytingAlgebra.toLattice.{u1} α (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} α _inst_1)))) a (Coheyting.boundary.{u1} α _inst_1 b)))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : CoheytingAlgebra.{u1} α] (a : α) (b : α), Eq.{succ u1} α (Coheyting.boundary.{u1} α _inst_1 (Inf.inf.{u1} α (Lattice.toInf.{u1} α (GeneralizedCoheytingAlgebra.toLattice.{u1} α (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} α _inst_1))) a b)) (Sup.sup.{u1} α (SemilatticeSup.toSup.{u1} α (Lattice.toSemilatticeSup.{u1} α (GeneralizedCoheytingAlgebra.toLattice.{u1} α (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} α _inst_1)))) (Inf.inf.{u1} α (Lattice.toInf.{u1} α (GeneralizedCoheytingAlgebra.toLattice.{u1} α (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} α _inst_1))) (Coheyting.boundary.{u1} α _inst_1 a) b) (Inf.inf.{u1} α (Lattice.toInf.{u1} α (GeneralizedCoheytingAlgebra.toLattice.{u1} α (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} α _inst_1))) a (Coheyting.boundary.{u1} α _inst_1 b)))
Case conversion may be inaccurate. Consider using '#align coheyting.boundary_inf Coheyting.boundary_infₓ'. -/
/-- **Leibniz rule** for the co-Heyting boundary. -/
theorem boundary_inf (a b : α) : ∂ (a ⊓ b) = ∂ a ⊓ b ⊔ a ⊓ ∂ b :=
  by
  unfold boundary
  rw [hnot_inf_distrib, inf_sup_left, inf_right_comm, ← inf_assoc]
#align coheyting.boundary_inf Coheyting.boundary_inf

/- warning: coheyting.boundary_inf_le -> Coheyting.boundary_inf_le is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : CoheytingAlgebra.{u1} α] {a : α} {b : α}, LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (GeneralizedCoheytingAlgebra.toLattice.{u1} α (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} α _inst_1)))))) (Coheyting.boundary.{u1} α _inst_1 (Inf.inf.{u1} α (SemilatticeInf.toHasInf.{u1} α (Lattice.toSemilatticeInf.{u1} α (GeneralizedCoheytingAlgebra.toLattice.{u1} α (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} α _inst_1)))) a b)) (Sup.sup.{u1} α (SemilatticeSup.toHasSup.{u1} α (Lattice.toSemilatticeSup.{u1} α (GeneralizedCoheytingAlgebra.toLattice.{u1} α (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} α _inst_1)))) (Coheyting.boundary.{u1} α _inst_1 a) (Coheyting.boundary.{u1} α _inst_1 b))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : CoheytingAlgebra.{u1} α] {a : α} {b : α}, LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (GeneralizedCoheytingAlgebra.toLattice.{u1} α (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} α _inst_1)))))) (Coheyting.boundary.{u1} α _inst_1 (Inf.inf.{u1} α (Lattice.toInf.{u1} α (GeneralizedCoheytingAlgebra.toLattice.{u1} α (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} α _inst_1))) a b)) (Sup.sup.{u1} α (SemilatticeSup.toSup.{u1} α (Lattice.toSemilatticeSup.{u1} α (GeneralizedCoheytingAlgebra.toLattice.{u1} α (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} α _inst_1)))) (Coheyting.boundary.{u1} α _inst_1 a) (Coheyting.boundary.{u1} α _inst_1 b))
Case conversion may be inaccurate. Consider using '#align coheyting.boundary_inf_le Coheyting.boundary_inf_leₓ'. -/
theorem boundary_inf_le : ∂ (a ⊓ b) ≤ ∂ a ⊔ ∂ b :=
  (boundary_inf _ _).trans_le <| sup_le_sup inf_le_left inf_le_right
#align coheyting.boundary_inf_le Coheyting.boundary_inf_le

/- warning: coheyting.boundary_sup_le -> Coheyting.boundary_sup_le is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : CoheytingAlgebra.{u1} α] {a : α} {b : α}, LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (GeneralizedCoheytingAlgebra.toLattice.{u1} α (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} α _inst_1)))))) (Coheyting.boundary.{u1} α _inst_1 (Sup.sup.{u1} α (SemilatticeSup.toHasSup.{u1} α (Lattice.toSemilatticeSup.{u1} α (GeneralizedCoheytingAlgebra.toLattice.{u1} α (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} α _inst_1)))) a b)) (Sup.sup.{u1} α (SemilatticeSup.toHasSup.{u1} α (Lattice.toSemilatticeSup.{u1} α (GeneralizedCoheytingAlgebra.toLattice.{u1} α (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} α _inst_1)))) (Coheyting.boundary.{u1} α _inst_1 a) (Coheyting.boundary.{u1} α _inst_1 b))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : CoheytingAlgebra.{u1} α] {a : α} {b : α}, LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (GeneralizedCoheytingAlgebra.toLattice.{u1} α (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} α _inst_1)))))) (Coheyting.boundary.{u1} α _inst_1 (Sup.sup.{u1} α (SemilatticeSup.toSup.{u1} α (Lattice.toSemilatticeSup.{u1} α (GeneralizedCoheytingAlgebra.toLattice.{u1} α (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} α _inst_1)))) a b)) (Sup.sup.{u1} α (SemilatticeSup.toSup.{u1} α (Lattice.toSemilatticeSup.{u1} α (GeneralizedCoheytingAlgebra.toLattice.{u1} α (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} α _inst_1)))) (Coheyting.boundary.{u1} α _inst_1 a) (Coheyting.boundary.{u1} α _inst_1 b))
Case conversion may be inaccurate. Consider using '#align coheyting.boundary_sup_le Coheyting.boundary_sup_leₓ'. -/
theorem boundary_sup_le : ∂ (a ⊔ b) ≤ ∂ a ⊔ ∂ b :=
  by
  rw [boundary, inf_sup_right]
  exact
    sup_le_sup (inf_le_inf_left _ <| hnot_anti le_sup_left)
      (inf_le_inf_left _ <| hnot_anti le_sup_right)
#align coheyting.boundary_sup_le Coheyting.boundary_sup_le

/- The intuitionistic version of `coheyting.boundary_le_boundary_sup_sup_boundary_inf_left`. Either
proof can be obtained from the other using the equivalence of Heyting algebras and intuitionistic
logic and duality between Heyting and co-Heyting algebras. It is crucial that the following proof be
intuitionistic. -/
example (a b : Prop) : (a ∧ b ∨ ¬(a ∧ b)) ∧ ((a ∨ b) ∨ ¬(a ∨ b)) → a ∨ ¬a :=
  by
  rintro ⟨⟨ha, hb⟩ | hnab, (ha | hb) | hnab⟩ <;> try exact Or.inl ha
  · exact Or.inr fun ha => hnab ⟨ha, hb⟩
  · exact Or.inr fun ha => hnab <| Or.inl ha

/- warning: coheyting.boundary_le_boundary_sup_sup_boundary_inf_left -> Coheyting.boundary_le_boundary_sup_sup_boundary_inf_left is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : CoheytingAlgebra.{u1} α] {a : α} {b : α}, LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (GeneralizedCoheytingAlgebra.toLattice.{u1} α (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} α _inst_1)))))) (Coheyting.boundary.{u1} α _inst_1 a) (Sup.sup.{u1} α (SemilatticeSup.toHasSup.{u1} α (Lattice.toSemilatticeSup.{u1} α (GeneralizedCoheytingAlgebra.toLattice.{u1} α (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} α _inst_1)))) (Coheyting.boundary.{u1} α _inst_1 (Sup.sup.{u1} α (SemilatticeSup.toHasSup.{u1} α (Lattice.toSemilatticeSup.{u1} α (GeneralizedCoheytingAlgebra.toLattice.{u1} α (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} α _inst_1)))) a b)) (Coheyting.boundary.{u1} α _inst_1 (Inf.inf.{u1} α (SemilatticeInf.toHasInf.{u1} α (Lattice.toSemilatticeInf.{u1} α (GeneralizedCoheytingAlgebra.toLattice.{u1} α (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} α _inst_1)))) a b)))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : CoheytingAlgebra.{u1} α] {a : α} {b : α}, LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (GeneralizedCoheytingAlgebra.toLattice.{u1} α (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} α _inst_1)))))) (Coheyting.boundary.{u1} α _inst_1 a) (Sup.sup.{u1} α (SemilatticeSup.toSup.{u1} α (Lattice.toSemilatticeSup.{u1} α (GeneralizedCoheytingAlgebra.toLattice.{u1} α (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} α _inst_1)))) (Coheyting.boundary.{u1} α _inst_1 (Sup.sup.{u1} α (SemilatticeSup.toSup.{u1} α (Lattice.toSemilatticeSup.{u1} α (GeneralizedCoheytingAlgebra.toLattice.{u1} α (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} α _inst_1)))) a b)) (Coheyting.boundary.{u1} α _inst_1 (Inf.inf.{u1} α (Lattice.toInf.{u1} α (GeneralizedCoheytingAlgebra.toLattice.{u1} α (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} α _inst_1))) a b)))
Case conversion may be inaccurate. Consider using '#align coheyting.boundary_le_boundary_sup_sup_boundary_inf_left Coheyting.boundary_le_boundary_sup_sup_boundary_inf_leftₓ'. -/
theorem boundary_le_boundary_sup_sup_boundary_inf_left : ∂ a ≤ ∂ (a ⊔ b) ⊔ ∂ (a ⊓ b) :=
  by
  simp only [boundary, sup_inf_left, sup_inf_right, sup_right_idem, le_inf_iff, sup_assoc,
    @sup_comm _ _ _ a]
  refine' ⟨⟨⟨_, _⟩, _⟩, ⟨_, _⟩, _⟩ <;> try exact le_sup_of_le_left inf_le_left <;>
    refine' inf_le_of_right_le _
  · rw [hnot_le_iff_codisjoint_right, codisjoint_left_comm]
    exact codisjoint_hnot_left
  · refine' le_sup_of_le_right _
    rw [hnot_le_iff_codisjoint_right]
    exact codisjoint_hnot_right.mono_right (hnot_anti inf_le_left)
#align coheyting.boundary_le_boundary_sup_sup_boundary_inf_left Coheyting.boundary_le_boundary_sup_sup_boundary_inf_left

/- warning: coheyting.boundary_le_boundary_sup_sup_boundary_inf_right -> Coheyting.boundary_le_boundary_sup_sup_boundary_inf_right is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : CoheytingAlgebra.{u1} α] {a : α} {b : α}, LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (GeneralizedCoheytingAlgebra.toLattice.{u1} α (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} α _inst_1)))))) (Coheyting.boundary.{u1} α _inst_1 b) (Sup.sup.{u1} α (SemilatticeSup.toHasSup.{u1} α (Lattice.toSemilatticeSup.{u1} α (GeneralizedCoheytingAlgebra.toLattice.{u1} α (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} α _inst_1)))) (Coheyting.boundary.{u1} α _inst_1 (Sup.sup.{u1} α (SemilatticeSup.toHasSup.{u1} α (Lattice.toSemilatticeSup.{u1} α (GeneralizedCoheytingAlgebra.toLattice.{u1} α (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} α _inst_1)))) a b)) (Coheyting.boundary.{u1} α _inst_1 (Inf.inf.{u1} α (SemilatticeInf.toHasInf.{u1} α (Lattice.toSemilatticeInf.{u1} α (GeneralizedCoheytingAlgebra.toLattice.{u1} α (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} α _inst_1)))) a b)))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : CoheytingAlgebra.{u1} α] {a : α} {b : α}, LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (GeneralizedCoheytingAlgebra.toLattice.{u1} α (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} α _inst_1)))))) (Coheyting.boundary.{u1} α _inst_1 b) (Sup.sup.{u1} α (SemilatticeSup.toSup.{u1} α (Lattice.toSemilatticeSup.{u1} α (GeneralizedCoheytingAlgebra.toLattice.{u1} α (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} α _inst_1)))) (Coheyting.boundary.{u1} α _inst_1 (Sup.sup.{u1} α (SemilatticeSup.toSup.{u1} α (Lattice.toSemilatticeSup.{u1} α (GeneralizedCoheytingAlgebra.toLattice.{u1} α (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} α _inst_1)))) a b)) (Coheyting.boundary.{u1} α _inst_1 (Inf.inf.{u1} α (Lattice.toInf.{u1} α (GeneralizedCoheytingAlgebra.toLattice.{u1} α (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} α _inst_1))) a b)))
Case conversion may be inaccurate. Consider using '#align coheyting.boundary_le_boundary_sup_sup_boundary_inf_right Coheyting.boundary_le_boundary_sup_sup_boundary_inf_rightₓ'. -/
theorem boundary_le_boundary_sup_sup_boundary_inf_right : ∂ b ≤ ∂ (a ⊔ b) ⊔ ∂ (a ⊓ b) :=
  by
  rw [@sup_comm _ _ a, inf_comm]
  exact boundary_le_boundary_sup_sup_boundary_inf_left
#align coheyting.boundary_le_boundary_sup_sup_boundary_inf_right Coheyting.boundary_le_boundary_sup_sup_boundary_inf_right

/- warning: coheyting.boundary_sup_sup_boundary_inf -> Coheyting.boundary_sup_sup_boundary_inf is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : CoheytingAlgebra.{u1} α] (a : α) (b : α), Eq.{succ u1} α (Sup.sup.{u1} α (SemilatticeSup.toHasSup.{u1} α (Lattice.toSemilatticeSup.{u1} α (GeneralizedCoheytingAlgebra.toLattice.{u1} α (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} α _inst_1)))) (Coheyting.boundary.{u1} α _inst_1 (Sup.sup.{u1} α (SemilatticeSup.toHasSup.{u1} α (Lattice.toSemilatticeSup.{u1} α (GeneralizedCoheytingAlgebra.toLattice.{u1} α (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} α _inst_1)))) a b)) (Coheyting.boundary.{u1} α _inst_1 (Inf.inf.{u1} α (SemilatticeInf.toHasInf.{u1} α (Lattice.toSemilatticeInf.{u1} α (GeneralizedCoheytingAlgebra.toLattice.{u1} α (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} α _inst_1)))) a b))) (Sup.sup.{u1} α (SemilatticeSup.toHasSup.{u1} α (Lattice.toSemilatticeSup.{u1} α (GeneralizedCoheytingAlgebra.toLattice.{u1} α (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} α _inst_1)))) (Coheyting.boundary.{u1} α _inst_1 a) (Coheyting.boundary.{u1} α _inst_1 b))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : CoheytingAlgebra.{u1} α] (a : α) (b : α), Eq.{succ u1} α (Sup.sup.{u1} α (SemilatticeSup.toSup.{u1} α (Lattice.toSemilatticeSup.{u1} α (GeneralizedCoheytingAlgebra.toLattice.{u1} α (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} α _inst_1)))) (Coheyting.boundary.{u1} α _inst_1 (Sup.sup.{u1} α (SemilatticeSup.toSup.{u1} α (Lattice.toSemilatticeSup.{u1} α (GeneralizedCoheytingAlgebra.toLattice.{u1} α (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} α _inst_1)))) a b)) (Coheyting.boundary.{u1} α _inst_1 (Inf.inf.{u1} α (Lattice.toInf.{u1} α (GeneralizedCoheytingAlgebra.toLattice.{u1} α (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} α _inst_1))) a b))) (Sup.sup.{u1} α (SemilatticeSup.toSup.{u1} α (Lattice.toSemilatticeSup.{u1} α (GeneralizedCoheytingAlgebra.toLattice.{u1} α (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} α _inst_1)))) (Coheyting.boundary.{u1} α _inst_1 a) (Coheyting.boundary.{u1} α _inst_1 b))
Case conversion may be inaccurate. Consider using '#align coheyting.boundary_sup_sup_boundary_inf Coheyting.boundary_sup_sup_boundary_infₓ'. -/
theorem boundary_sup_sup_boundary_inf (a b : α) : ∂ (a ⊔ b) ⊔ ∂ (a ⊓ b) = ∂ a ⊔ ∂ b :=
  le_antisymm (sup_le boundary_sup_le boundary_inf_le) <|
    sup_le boundary_le_boundary_sup_sup_boundary_inf_left
      boundary_le_boundary_sup_sup_boundary_inf_right
#align coheyting.boundary_sup_sup_boundary_inf Coheyting.boundary_sup_sup_boundary_inf

#print Coheyting.boundary_idem /-
@[simp]
theorem boundary_idem (a : α) : ∂ ∂ a = ∂ a := by rw [boundary, hnot_boundary, inf_top_eq]
#align coheyting.boundary_idem Coheyting.boundary_idem
-/

/- warning: coheyting.hnot_hnot_sup_boundary -> Coheyting.hnot_hnot_sup_boundary is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : CoheytingAlgebra.{u1} α] (a : α), Eq.{succ u1} α (Sup.sup.{u1} α (SemilatticeSup.toHasSup.{u1} α (Lattice.toSemilatticeSup.{u1} α (GeneralizedCoheytingAlgebra.toLattice.{u1} α (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} α _inst_1)))) (HNot.hnot.{u1} α (CoheytingAlgebra.toHasHnot.{u1} α _inst_1) (HNot.hnot.{u1} α (CoheytingAlgebra.toHasHnot.{u1} α _inst_1) a)) (Coheyting.boundary.{u1} α _inst_1 a)) a
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : CoheytingAlgebra.{u1} α] (a : α), Eq.{succ u1} α (Sup.sup.{u1} α (SemilatticeSup.toSup.{u1} α (Lattice.toSemilatticeSup.{u1} α (GeneralizedCoheytingAlgebra.toLattice.{u1} α (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} α _inst_1)))) (HNot.hnot.{u1} α (CoheytingAlgebra.toHNot.{u1} α _inst_1) (HNot.hnot.{u1} α (CoheytingAlgebra.toHNot.{u1} α _inst_1) a)) (Coheyting.boundary.{u1} α _inst_1 a)) a
Case conversion may be inaccurate. Consider using '#align coheyting.hnot_hnot_sup_boundary Coheyting.hnot_hnot_sup_boundaryₓ'. -/
theorem hnot_hnot_sup_boundary (a : α) : ￢￢a ⊔ ∂ a = a :=
  by
  rw [boundary, sup_inf_left, hnot_sup_self, inf_top_eq, sup_eq_right]
  exact hnot_hnot_le
#align coheyting.hnot_hnot_sup_boundary Coheyting.hnot_hnot_sup_boundary

/- warning: coheyting.hnot_eq_top_iff_exists_boundary -> Coheyting.hnot_eq_top_iff_exists_boundary is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : CoheytingAlgebra.{u1} α] {a : α}, Iff (Eq.{succ u1} α (HNot.hnot.{u1} α (CoheytingAlgebra.toHasHnot.{u1} α _inst_1) a) (Top.top.{u1} α (CoheytingAlgebra.toHasTop.{u1} α _inst_1))) (Exists.{succ u1} α (fun (b : α) => Eq.{succ u1} α (Coheyting.boundary.{u1} α _inst_1 b) a))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : CoheytingAlgebra.{u1} α] {a : α}, Iff (Eq.{succ u1} α (HNot.hnot.{u1} α (CoheytingAlgebra.toHNot.{u1} α _inst_1) a) (Top.top.{u1} α (CoheytingAlgebra.toTop.{u1} α _inst_1))) (Exists.{succ u1} α (fun (b : α) => Eq.{succ u1} α (Coheyting.boundary.{u1} α _inst_1 b) a))
Case conversion may be inaccurate. Consider using '#align coheyting.hnot_eq_top_iff_exists_boundary Coheyting.hnot_eq_top_iff_exists_boundaryₓ'. -/
theorem hnot_eq_top_iff_exists_boundary : ￢a = ⊤ ↔ ∃ b, ∂ b = a :=
  ⟨fun h => ⟨a, by rw [boundary, h, inf_top_eq]⟩,
    by
    rintro ⟨b, rfl⟩
    exact hnot_boundary _⟩
#align coheyting.hnot_eq_top_iff_exists_boundary Coheyting.hnot_eq_top_iff_exists_boundary

end Coheyting

open Heyting

section BooleanAlgebra

variable [BooleanAlgebra α]

/- warning: coheyting.boundary_eq_bot -> Coheyting.boundary_eq_bot is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : BooleanAlgebra.{u1} α] (a : α), Eq.{succ u1} α (Coheyting.boundary.{u1} α (BiheytingAlgebra.toCoheytingAlgebra.{u1} α (BooleanAlgebra.toBiheytingAlgebra.{u1} α _inst_1)) a) (Bot.bot.{u1} α (BooleanAlgebra.toHasBot.{u1} α _inst_1))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : BooleanAlgebra.{u1} α] (a : α), Eq.{succ u1} α (Coheyting.boundary.{u1} α (BiheytingAlgebra.toCoheytingAlgebra.{u1} α (BooleanAlgebra.toBiheytingAlgebra.{u1} α _inst_1)) a) (Bot.bot.{u1} α (BooleanAlgebra.toBot.{u1} α _inst_1))
Case conversion may be inaccurate. Consider using '#align coheyting.boundary_eq_bot Coheyting.boundary_eq_botₓ'. -/
@[simp]
theorem Coheyting.boundary_eq_bot (a : α) : ∂ a = ⊥ :=
  inf_compl_eq_bot
#align coheyting.boundary_eq_bot Coheyting.boundary_eq_bot

end BooleanAlgebra


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

! This file was ported from Lean 3 source module group_theory.subgroup.finite
! leanprover-community/mathlib commit f93c11933efbc3c2f0299e47b8ff83e9b539cbf6
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Set.Finite
import Mathlib.GroupTheory.Subgroup.Basic
import Mathlib.GroupTheory.Submonoid.Membership

/-!
# Subgroups

This file provides some result on multiplicative and additive subgroups in the finite context.

## Tags
subgroup, subgroups
-/

open BigOperators

variable {G : Type _} [Group G]

variable {A : Type _} [AddGroup A]

namespace Subgroup

@[to_additive]
instance (K : Subgroup G) [DecidablePred (· ∈ K)] [Fintype G] : Fintype K :=
  show Fintype { g : G // g ∈ K } from inferInstance

@[to_additive]
instance (K : Subgroup G) [Finite G] : Finite K :=
  Subtype.finite

end Subgroup

/-!
### Conversion to/from `Additive`/`Multiplicative`
-/

namespace Subgroup

variable (H K : Subgroup G)

/-- Product of a list of elements in a subgroup is in the subgroup. -/
@[to_additive "Sum of a list of elements in an `AddSubgroup` is in the `AddSubgroup`."]
protected theorem list_prod_mem {l : List G} : (∀ x ∈ l, x ∈ K) → l.prod ∈ K :=
  list_prod_mem
#align subgroup.list_prod_mem Subgroup.list_prod_mem
#align add_subgroup.list_sum_mem AddSubgroup.list_sum_mem

/-- Product of a multiset of elements in a subgroup of a `CommGroup` is in the subgroup. -/
@[to_additive "Sum of a multiset of elements in an `AddSubgroup` of an `AddCommGroup` is in
 the `AddSubgroup`."]
protected theorem multiset_prod_mem {G} [CommGroup G] (K : Subgroup G) (g : Multiset G) :
    (∀ a ∈ g, a ∈ K) → g.prod ∈ K :=
  multiset_prod_mem g
#align subgroup.multiset_prod_mem Subgroup.multiset_prod_mem
#align add_subgroup.multiset_sum_mem AddSubgroup.multiset_sum_mem

@[to_additive]
theorem multiset_noncommProd_mem (K : Subgroup G) (g : Multiset G) (comm) :
    (∀ a ∈ g, a ∈ K) → g.noncommProd comm ∈ K :=
  K.toSubmonoid.multiset_noncommProd_mem g comm
#align subgroup.multiset_noncomm_prod_mem Subgroup.multiset_noncommProd_mem
#align add_subgroup.multiset_noncomm_sum_mem AddSubgroup.multiset_noncommSum_mem

/-- Product of elements of a subgroup of a `CommGroup` indexed by a `Finset` is in the
    subgroup. -/
@[to_additive "Sum of elements in an `AddSubgroup` of an `AddCommGroup` indexed by a `Finset`
 is in the `AddSubgroup`."]
protected theorem prod_mem {G : Type _} [CommGroup G] (K : Subgroup G) {ι : Type _} {t : Finset ι}
    {f : ι → G} (h : ∀ c ∈ t, f c ∈ K) : (∏ c in t, f c) ∈ K :=
  prod_mem h
#align subgroup.prod_mem Subgroup.prod_mem
#align add_subgroup.sum_mem AddSubgroup.sum_mem

@[to_additive]
theorem noncommProd_mem (K : Subgroup G) {ι : Type _} {t : Finset ι} {f : ι → G} (comm) :
    (∀ c ∈ t, f c ∈ K) → t.noncommProd f comm ∈ K :=
  K.toSubmonoid.noncommProd_mem t f comm
#align subgroup.noncomm_prod_mem Subgroup.noncommProd_mem
#align add_subgroup.noncomm_sum_mem AddSubgroup.noncommSum_mem

-- porting note: increased priority to appease `simpNF`, otherwise left-hand side reduces
@[to_additive (attr := simp 1100, norm_cast)]
theorem val_list_prod (l : List H) : (l.prod : G) = (l.map Subtype.val).prod :=
  SubmonoidClass.coe_list_prod l
#align subgroup.coe_list_prod Subgroup.val_list_prod
#align add_subgroup.coe_list_sum AddSubgroup.val_list_sum

-- porting note: increased priority to appease `simpNF`, otherwise left-hand side reduces
@[to_additive (attr := simp 1100, norm_cast)]
theorem val_multiset_prod {G} [CommGroup G] (H : Subgroup G) (m : Multiset H) :
    (m.prod : G) = (m.map Subtype.val).prod :=
  SubmonoidClass.coe_multiset_prod m
#align subgroup.coe_multiset_prod Subgroup.val_multiset_prod
#align add_subgroup.coe_multiset_sum AddSubgroup.val_multiset_sum

-- porting note: increased priority to appease `simpNF`, otherwise `simp` can prove it.
@[to_additive (attr := simp 1100, norm_cast)]
theorem val_finset_prod {ι G} [CommGroup G] (H : Subgroup G) (f : ι → H) (s : Finset ι) :
    ↑(∏ i in s, f i) = (∏ i in s, f i : G) :=
  SubmonoidClass.coe_finset_prod f s
#align subgroup.coe_finset_prod Subgroup.val_finset_prod
#align add_subgroup.coe_finset_sum AddSubgroup.val_finset_sum

@[to_additive]
instance fintypeBot : Fintype (⊥ : Subgroup G) :=
  ⟨{1}, by
    rintro ⟨x, ⟨hx⟩⟩
    exact Finset.mem_singleton_self _⟩
#align subgroup.fintype_bot Subgroup.fintypeBot
#align add_subgroup.fintype_bot AddSubgroup.fintypeBot

/- curly brackets `{}` are used here instead of instance brackets `[]` because
  the instance in a goal is often not the same as the one inferred by type class inference.  -/
@[to_additive] -- porting note: removed `simp` because `simpNF` says it can prove it.
theorem card_bot {_ : Fintype (⊥ : Subgroup G)} : Fintype.card (⊥ : Subgroup G) = 1 :=
  Fintype.card_eq_one_iff.2
    ⟨⟨(1 : G), Set.mem_singleton 1⟩, fun ⟨_y, hy⟩ => Subtype.eq <| Subgroup.mem_bot.1 hy⟩
#align subgroup.card_bot Subgroup.card_bot
#align add_subgroup.card_bot AddSubgroup.card_bot

@[to_additive]
theorem eq_top_of_card_eq [Fintype H] [Fintype G] (h : Fintype.card H = Fintype.card G) : H = ⊤ :=
  by
  letI : Fintype (H : Set G) := ‹Fintype H›
  rw [SetLike.ext'_iff, coe_top, ← Finset.coe_univ, ← (H : Set G).coe_toFinset, Finset.coe_inj, ←
    Finset.card_eq_iff_eq_univ, ← h, Set.toFinset_card]
  congr
#align subgroup.eq_top_of_card_eq Subgroup.eq_top_of_card_eq
#align add_subgroup.eq_top_of_card_eq AddSubgroup.eq_top_of_card_eq

@[to_additive]
theorem eq_top_of_le_card [Fintype H] [Fintype G] (h : Fintype.card G ≤ Fintype.card H) : H = ⊤ :=
  eq_top_of_card_eq H
    (le_antisymm (Fintype.card_le_of_injective Subtype.val Subtype.coe_injective) h)
#align subgroup.eq_top_of_le_card Subgroup.eq_top_of_le_card
#align add_subgroup.eq_top_of_le_card AddSubgroup.eq_top_of_le_card

@[to_additive]
theorem eq_bot_of_card_le [Fintype H] (h : Fintype.card H ≤ 1) : H = ⊥ :=
  let _ := Fintype.card_le_one_iff_subsingleton.mp h
  eq_bot_of_subsingleton H
#align subgroup.eq_bot_of_card_le Subgroup.eq_bot_of_card_le
#align add_subgroup.eq_bot_of_card_le AddSubgroup.eq_bot_of_card_le

@[to_additive]
theorem eq_bot_of_card_eq [Fintype H] (h : Fintype.card H = 1) : H = ⊥ :=
  H.eq_bot_of_card_le (le_of_eq h)
#align subgroup.eq_bot_of_card_eq Subgroup.eq_bot_of_card_eq
#align add_subgroup.eq_bot_of_card_eq AddSubgroup.eq_bot_of_card_eq

@[to_additive card_le_one_iff_eq_bot]
theorem card_le_one_iff_eq_bot [Fintype H] : Fintype.card H ≤ 1 ↔ H = ⊥ :=
  ⟨fun h =>
    (eq_bot_iff_forall _).2 fun x hx => by
      simpa [Subtype.ext_iff] using Fintype.card_le_one_iff.1 h ⟨x, hx⟩ 1,
    fun h => by simp [h]⟩
#align subgroup.card_le_one_iff_eq_bot Subgroup.card_le_one_iff_eq_bot
#align add_subgroup.card_nonpos_iff_eq_bot AddSubgroup.card_le_one_iff_eq_bot

@[to_additive one_lt_card_iff_ne_bot]
theorem one_lt_card_iff_ne_bot [Fintype H] : 1 < Fintype.card H ↔ H ≠ ⊥ :=
  lt_iff_not_le.trans H.card_le_one_iff_eq_bot.not
#align subgroup.one_lt_card_iff_ne_bot Subgroup.one_lt_card_iff_ne_bot
#align add_subgroup.pos_card_iff_ne_bot AddSubgroup.one_lt_card_iff_ne_bot

end Subgroup

namespace Subgroup

section Pi

open Set

variable {η : Type _} {f : η → Type _} [∀ i, Group (f i)]

@[to_additive]
theorem pi_mem_of_mulSingle_mem_aux [DecidableEq η] (I : Finset η) {H : Subgroup (∀ i, f i)}
    (x : ∀ i, f i) (h1 : ∀ i, i ∉ I → x i = 1) (h2 : ∀ i, i ∈ I → Pi.mulSingle i (x i) ∈ H) :
    x ∈ H := by
  induction' I using Finset.induction_on with i I hnmem ih generalizing x
  · convert one_mem H
    ext i
    exact h1 i (Finset.not_mem_empty i)
  · have : x = Function.update x i 1 * Pi.mulSingle i (x i) :=
      by
      ext j
      by_cases heq : j = i
      · subst heq
        simp
      · simp [heq]
    rw [this]
    clear this
    apply mul_mem
    · apply ih <;> clear ih
      · intro j hj
        by_cases heq : j = i
        · subst heq
          simp
        · simp [heq]
          apply h1 j
          simpa [heq] using hj
      · intro j hj
        have : j ≠ i := by
          rintro rfl
          contradiction
        simp [this]
        exact h2 _ (Finset.mem_insert_of_mem hj)
    · apply h2
      simp
#align subgroup.pi_mem_of_mul_single_mem_aux Subgroup.pi_mem_of_mulSingle_mem_aux
#align add_subgroup.pi_mem_of_single_mem_aux AddSubgroup.pi_mem_of_single_mem_aux

@[to_additive]
theorem pi_mem_of_mulSingle_mem [Finite η] [DecidableEq η] {H : Subgroup (∀ i, f i)} (x : ∀ i, f i)
    (h : ∀ i, Pi.mulSingle i (x i) ∈ H) : x ∈ H := by
  cases nonempty_fintype η
  exact pi_mem_of_mulSingle_mem_aux Finset.univ x (by simp) fun i _ => h i
#align subgroup.pi_mem_of_mul_single_mem Subgroup.pi_mem_of_mulSingle_mem
#align add_subgroup.pi_mem_of_single_mem AddSubgroup.pi_mem_of_single_mem

/-- For finite index types, the `Subgroup.pi` is generated by the embeddings of the groups.  -/
@[to_additive "For finite index types, the `Subgroup.pi` is generated by the embeddings of the
 additive groups."]

end Pi

end Subgroup

namespace Subgroup

section Normalizer

theorem mem_normalizer_fintype {S : Set G} [Finite S] {x : G} (h : ∀ n, n ∈ S → x * n * x⁻¹ ∈ S) :
    x ∈ Subgroup.setNormalizer S := by
  haveI := Classical.propDecidable; cases nonempty_fintype S;
      haveI := Set.fintypeImage S fun n => x * n * x⁻¹;
    exact fun n =>
      ⟨h n, fun h₁ =>
        have heq : (fun n => x * n * x⁻¹) '' S = S :=
          Set.eq_of_subset_of_card_le (fun n ⟨y, hy⟩ => hy.2 ▸ h y hy.1)
            (by rw [Set.card_image_of_injective S conj_injective])
        have : x * n * x⁻¹ ∈ (fun n => x * n * x⁻¹) '' S := heq.symm ▸ h₁
        let ⟨y, hy⟩ := this
        conj_injective hy.2 ▸ hy.1⟩
#align subgroup.mem_normalizer_fintype Subgroup.mem_normalizer_fintype

end Normalizer

end Subgroup

namespace MonoidHom

variable {N : Type _} [Group N]

open Subgroup

@[to_additive]
instance decidableMemRange (f : G →* N) [Fintype G] [DecidableEq N] : DecidablePred (· ∈ f.range) :=
  fun _ => Fintype.decidableExistsFintype
#align monoid_hom.decidable_mem_range MonoidHom.decidableMemRange
#align add_monoid_hom.decidable_mem_range AddMonoidHom.decidableMemRange

-- this instance can't go just after the definition of `mrange` because `Fintype` is
-- not imported at that stage
/-- The range of a finite monoid under a monoid homomorphism is finite.
Note: this instance can form a diamond with `Subtype.fintype` in the
presence of `Fintype N`. -/
@[to_additive "The range of a finite additive monoid under an additive monoid homomorphism is
 finite.

Note: this instance can form a diamond with `Subtype.fintype` or `Subgroup.fintype` in the presence
of `Fintype N`."]
instance fintypeMrange {M N : Type _} [Monoid M] [Monoid N] [Fintype M] [DecidableEq N]
    (f : M →* N) : Fintype (mrange f) :=
  Set.fintypeRange f
#align monoid_hom.fintype_mrange MonoidHom.fintypeMrange
#align add_monoid_hom.fintype_mrange AddMonoidHom.fintypeMrange

/-- The range of a finite group under a group homomorphism is finite.

Note: this instance can form a diamond with `Subtype.fintype` or `Subgroup.fintype` in the
presence of `Fintype N`. -/
@[to_additive "The range of a finite additive group under an additive group homomorphism is finite.

Note: this instance can form a diamond with `Subtype.fintype` or `Subgroup.fintype` in the
 presence of `Fintype N`."]
instance fintypeRange [Fintype G] [DecidableEq N] (f : G →* N) : Fintype (range f) :=
  Set.fintypeRange f
#align monoid_hom.fintype_range MonoidHom.fintypeRange
#align add_monoid_hom.fintype_range AddMonoidHom.fintypeRange

end MonoidHom


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

/-!
# Darboux's theorem

In this file we prove that the derivative of a differentiable function on an interval takes all
intermediate values. The proof is based on the
[Wikipedia](https://en.wikipedia.org/wiki/Darboux%27s_theorem_(analysis)) page about this theorem.
-/

open filter set
open_locale topological_space classical

variables {a b : ℝ} {f f' : ℝ → ℝ}

/-- Darboux's theorem: if `a ≤ b` and `f' a < m < f' b`, then `f' c = m` for some `c ∈ [a, b]`. -/
theorem exists_has_deriv_within_at_eq_of_gt_of_lt
  (hab : a ≤ b) (hf : ∀ x ∈ (Icc a b), has_deriv_within_at f (f' x) (Icc a b) x)
  {m : ℝ} (hma : f' a < m) (hmb : m < f' b) :
  m ∈ f' '' (Icc a b) :=
begin
  have hab' : a < b,
  { refine lt_of_le_of_ne hab (λ hab', _),
    subst b,
    exact lt_asymm hma hmb },
  set g : ℝ → ℝ := λ x, f x - m * x,
  have hg : ∀ x ∈ Icc a b, has_deriv_within_at g (f' x - m) (Icc a b) x,
  { intros x hx,
    simpa using (hf x hx).sub ((has_deriv_within_at_id x _).const_mul m) },
  obtain ⟨c, cmem, hc⟩ : ∃ c ∈ Icc a b, is_min_on g (Icc a b) c,
    from compact_Icc.exists_forall_le (nonempty_Icc.2 $ hab)
      (λ x hx, (hg x hx).continuous_within_at),
  have cmem' : c ∈ Ioo a b,
  { cases eq_or_lt_of_le cmem.1 with hac hac,
    -- Show that `c` can't be equal to `a`
    { subst c,
      refine absurd (sub_nonneg.1 $ nonneg_of_mul_nonneg_left _ (sub_pos.2 hab'))
        (not_le_of_lt hma),
      have : b - a ∈ pos_tangent_cone_at (Icc a b) a,
        from mem_pos_tangent_cone_at_of_segment_subset (segment_eq_Icc hab ▸ subset.refl _),
      simpa [-sub_nonneg, -continuous_linear_map.map_sub]
        using hc.localize.has_fderiv_within_at_nonneg (hg a (left_mem_Icc.2 hab)) this },
    cases eq_or_lt_of_le cmem.2 with hbc hbc,
    -- Show that `c` can't be equal to `b`
    { subst c,
      refine absurd (sub_nonpos.1 $ nonpos_of_mul_nonneg_right _ (sub_lt_zero.2 hab'))
        (not_le_of_lt hmb),
      have : a - b ∈ pos_tangent_cone_at (Icc a b) b,
        from mem_pos_tangent_cone_at_of_segment_subset (by rw [segment_symm, segment_eq_Icc hab]),
      simpa [-sub_nonneg, -continuous_linear_map.map_sub]
        using hc.localize.has_fderiv_within_at_nonneg (hg b (right_mem_Icc.2 hab)) this },
    exact ⟨hac, hbc⟩ },
  use [c, cmem],
  rw [← sub_eq_zero],
  have : Icc a b ∈ 𝓝 c, by rwa [← mem_interior_iff_mem_nhds, interior_Icc],
  exact (hc.is_local_min this).has_deriv_at_eq_zero ((hg c cmem).has_deriv_at this)
end

/-- Darboux's theorem: if `a ≤ b` and `f' a > m > f' b`, then `f' c = m` for some `c ∈ [a, b]`. -/
theorem exists_has_deriv_within_at_eq_of_lt_of_gt
  (hab : a ≤ b) (hf : ∀ x ∈ (Icc a b), has_deriv_within_at f (f' x) (Icc a b) x)
  {m : ℝ} (hma : m < f' a) (hmb : f' b < m) :
  m ∈ f' '' (Icc a b) :=
let ⟨c, cmem, hc⟩ := exists_has_deriv_within_at_eq_of_gt_of_lt hab (λ x hx, (hf x hx).neg)
  (neg_lt_neg hma) (neg_lt_neg hmb)
in ⟨c, cmem, neg_injective hc⟩

/-- Darboux's theorem: the image of a convex set under `f'` is a convex set. -/
theorem convex_image_has_deriv_at {s : set ℝ} (hs : convex s)
  (hf : ∀ x ∈ s, has_deriv_at f (f' x) x) :
  convex (f' '' s) :=
begin
  refine real.convex_iff_ord_connected.2 ⟨_⟩,
  rintros _ ⟨a, ha, rfl⟩ _ ⟨b, hb, rfl⟩ m ⟨hma, hmb⟩,
  cases eq_or_lt_of_le hma with hma hma,
    by exact hma ▸ mem_image_of_mem f' ha,
  cases eq_or_lt_of_le hmb with hmb hmb,
    by exact hmb.symm ▸ mem_image_of_mem f' hb,
  cases le_total a b with hab hab,
  { have : Icc a b ⊆ s, from hs.ord_connected.out ha hb,
    rcases exists_has_deriv_within_at_eq_of_gt_of_lt hab
      (λ x hx, (hf x $ this hx).has_deriv_within_at) hma hmb
      with ⟨c, cmem, hc⟩,
    exact ⟨c, this cmem, hc⟩ },
  { have : Icc b a ⊆ s, from hs.ord_connected.out hb ha,
    rcases exists_has_deriv_within_at_eq_of_lt_of_gt hab
      (λ x hx, (hf x $ this hx).has_deriv_within_at) hmb hma
      with ⟨c, cmem, hc⟩,
    exact ⟨c, this cmem, hc⟩ }
end

/-- If the derivative of a function is never equal to `m`, then either
it is always greater than `m`, or it is always less than `m`. -/
theorem deriv_forall_lt_or_forall_gt_of_forall_ne {s : set ℝ} (hs : convex s)
  (hf : ∀ x ∈ s, has_deriv_at f (f' x) x) {m : ℝ} (hf' : ∀ x ∈ s, f' x ≠ m) :
  (∀ x ∈ s, f' x < m) ∨ (∀ x ∈ s, m < f' x) :=
begin
  contrapose! hf',
  rcases hf' with ⟨⟨b, hb, hmb⟩, ⟨a, ha, hma⟩⟩,
  exact (convex_image_has_deriv_at hs hf).ord_connected.out (mem_image_of_mem f' ha)
    (mem_image_of_mem f' hb) ⟨hma, hmb⟩
end