/-
Copyright (c) 2022 Abby J. Goldberg. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Abby J. Goldberg

! This file was ported from Lean 3 source module tactic.linear_combination
! leanprover-community/mathlib commit 540b766a64a8cc1e4b013f43a31e3b0b09787937
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Tactic.Ring

/-!

# linear_combination Tactic
In this file, the `linear_combination` tactic is created.  This tactic, which
works over `ring`s, attempts to simplify the target by creating a linear combination
of a list of equalities and subtracting it from the target.  This file also includes a
definition for `linear_combination_config`.  A `linear_combination_config`
object can be passed into the tactic, allowing the user to specify a
normalization tactic.

## Implementation Notes

This tactic works by creating a weighted sum of the given equations with the
given coefficients.  Then, it subtracts the right side of the weighted sum
from the left side so that the right side equals 0, and it does the same with
the target.  Afterwards, it sets the goal to be the equality between the
lefthand side of the new goal and the lefthand side of the new weighted sum.
Lastly, calls a normalization tactic on this target.

## References

* <https://leanprover.zulipchat.com/#narrow/stream/239415-metaprogramming-.2F.20tactics/topic/Linear.20algebra.20tactic/near/213928196>

-/

namespace LinearCombo

open Tactic

/-! ### Lemmas -/

theorem left_mul_both_sides {α} [h : Mul α] {x y : α} (z : α) (h1 : x = y) : z * x = z * y :=
  congr_arg (Mul.mul z) h1
#align linear_combo.left_mul_both_sides LinearCombo.left_mul_both_sides

theorem sum_two_equations {α} [h : Add α] {x1 y1 x2 y2 : α} (h1 : x1 = y1) (h2 : x2 = y2) :
    x1 + x2 = y1 + y2 :=
  congr (congr_arg Add.add h1) h2
#align linear_combo.sum_two_equations LinearCombo.sum_two_equations

theorem left_minus_right {α} [h : AddGroup α] {x y : α} (h1 : x = y) : x - y = 0 :=
  sub_eq_zero.mpr h1
#align linear_combo.left_minus_right LinearCombo.left_minus_right

theorem all_on_left_equiv {α} [h : AddGroup α] (x y : α) : (x = y) = (x - y = 0) :=
  propext ⟨left_minus_right, sub_eq_zero.mp⟩
#align linear_combo.all_on_left_equiv LinearCombo.all_on_left_equiv

theorem replace_eq_expr {α} [h : Zero α] {x y : α} (h1 : x = 0) (h2 : y = x) : y = 0 := by rwa [h2]
#align linear_combo.replace_eq_expr LinearCombo.replace_eq_expr

theorem eq_zero_of_sub_eq_zero {α} [AddGroup α] {x y : α} (h : y = 0) (h2 : x - y = 0) : x = 0 := by
  rwa [h, sub_zero] at h2
#align linear_combo.eq_zero_of_sub_eq_zero LinearCombo.eq_zero_of_sub_eq_zero

/-! ### Configuration -/

/- ./././Mathport/Syntax/Translate/Expr.lean:330:4: warning: unsupported (TODO): `[tacs] -/
/-- A configuration object for `linear_combination`.

`normalize` describes whether or not the normalization step should be used.

`normalization_tactic` describes the tactic used for normalization when
checking if the weighted sum is equivalent to the goal (when `normalize` is `tt`).
-/
unsafe structure linear_combination_config : Type where
  normalize : Bool := true
  normalization_tactic : tactic Unit := sorry
  exponent : ℕ := 1
#align linear_combo.linear_combination_config linear_combo.linear_combination_config

/-! ### Part 1: Multiplying Equations by Constants and Adding Them Together -/

-- failed to format: unknown constant 'term.pseudo.antiquot'
/--
      Given that `lhs = rhs`, this tactic returns an `expr` proving that
        `coeff * lhs = coeff * rhs`.

      * Input:
        * `h_equality` : an `expr`, whose type should be an equality between terms of
            type `α`, where there is an instance of `has_mul α`
        * `coeff` : a `pexpr`, which should be a value of type `α`

      * Output: an `expr`, which proves that the result of multiplying both sides
          of `h_equality` by the `coeff` holds
      -/
    unsafe
  def
    mul_equality_expr
    ( h_equality : expr ) ( coeff : pexpr ) : tactic expr
    :=
      do
        let q( $ ( lhs ) = $ ( rhs ) ) ← infer_type h_equality
          let left_type ← infer_type lhs
          let coeff_expr ← to_expr ` `( ( $ ( coeff ) : $ ( left_type ) ) )
          mk_app ` ` left_mul_both_sides [ coeff_expr , h_equality ]
#align linear_combo.mul_equality_expr linear_combo.mul_equality_expr

/-- Given two hypotheses that `a = b` and `c = d`, this tactic returns an `expr` proving
  that `a + c = b + d`.

* Input:
  * `h_equality1` : an `expr`, whose type should be an equality between terms of
      type `α`, where there is an instance of `has_add α`
  * `h_equality2` : an `expr`, whose type should be an equality between terms of
      type `α`

* Output: an `expr`, which proves that the result of adding the two
    equalities holds
-/
unsafe def sum_equalities (h_equality1 h_equality2 : expr) : tactic expr :=
  mk_app `` sum_two_equations [h_equality1, h_equality2]
#align linear_combo.sum_equalities linear_combo.sum_equalities

/-- Given that `a = b` and `c = d`, along with a coefficient, this tactic returns an
  `expr` proving that `a + coeff * c = b + coeff * d`.

* Input:
  * `h_equality1` : an `expr`, whose type should be an equality between terms of
      type `α`, where there are instances of `has_add α` and `has_mul α`
  * `h_equality2` : an `expr`, whose type should be an equality between terms of
      type `α`
  * `coeff_for_eq2` : a `pexpr`, which should be a value of type `α`

* Output: an `expr`, which proves that the result of adding the first
  equality to the result of multiplying `coeff_for_eq2` by the second equality
  holds
-/
unsafe def sum_two_hyps_one_mul_helper (h_equality1 h_equality2 : expr) (coeff_for_eq2 : pexpr) :
    tactic expr :=
  mul_equality_expr h_equality2 coeff_for_eq2 >>= sum_equalities h_equality1
#align linear_combo.sum_two_hyps_one_mul_helper linear_combo.sum_two_hyps_one_mul_helper

/-- Given that `l_sum1 = r_sum1`, `l_h1 = r_h1`, ..., `l_hn = r_hn`, and given
  coefficients `c_1`, ..., `c_n`, this tactic returns an `expr` proving that
    `l_sum1 + (c_1 * l_h1) + ... + (c_n * l_hn)`
  `= r_sum1 + (c_1 * r_h1) + ... + (c_n * r_hn)`

* Input:
  * `expected_tp`: the type of the terms being compared in the target equality
  * an `option (tactic expr)` : `none`, if there is no sum to add to yet, or
      `some` containing the base summation equation
  * a `list name` : a list of names, referring to equalities in the local context
  * a `list pexpr` : a list of coefficients to be multiplied with the
      corresponding equalities in the list of names

* Output: an `expr`, which proves that the weighted sum of the given
    equalities added to the base equation holds
-/
unsafe def make_sum_of_hyps_helper (expected_tp : expr) :
    Option (tactic expr) → List expr → List pexpr → tactic expr
  | none, [], [] => to_expr ``((rfl : (0 : $(expected_tp)) = 0))
  | some tactic_hcombo, [], [] => do
    tactic_hcombo
  | none, h_equality :: h_eqs_names, coeff :: coeffs => do
    let-- This is the first equality, and we do not have anything to add to it
      -- h_equality ← get_local h_equality_nam,
      q(@Eq $(eqtp) _ _)
      ← infer_type h_equality |
      throwError "{← h_equality} is expected to be a proof of an equality"
    is_def_eq eqtp expected_tp <|>
        throwError
          "{(←
            h_equality)} is an equality between terms of type {(←
            eqtp)}, but is expected to be between terms of type {← expected_tp}"
    make_sum_of_hyps_helper (some (mul_equality_expr h_equality coeff)) h_eqs_names coeffs
  | some tactic_hcombo, h_equality :: h_eqs_names, coeff :: coeffs => do
    let hcombo
      ←-- h_equality ← get_local h_equality_nam,
        tactic_hcombo
    -- We want to add this weighted equality to the current equality in
        --   the hypothesis
        make_sum_of_hyps_helper
        (some (sum_two_hyps_one_mul_helper hcombo h_equality coeff)) h_eqs_names coeffs
  | _, _, _ => do
    fail
        ("The length of the input list of equalities should be the " ++
          "same as the length of the input list of coefficients")
#align linear_combo.make_sum_of_hyps_helper linear_combo.make_sum_of_hyps_helper

/-- Given a list of names referencing equalities and a list of pexprs representing
  coefficients, this tactic proves that a weighted sum of the equalities
  (where each equation is multiplied by the corresponding coefficient) holds.

* Input:
  * `expected_tp`: the type of the terms being compared in the target equality
  * `h_eqs_names` : a list of names, referring to equalities in the local
      context
  * `coeffs` : a list of coefficients to be multiplied with the corresponding
      equalities in the list of names

* Output: an `expr`, which proves that the weighted sum of the equalities
    holds
-/
unsafe def make_sum_of_hyps (expected_tp : expr) (h_eqs_names : List expr) (coeffs : List pexpr) :
    tactic expr :=
  make_sum_of_hyps_helper expected_tp none h_eqs_names coeffs
#align linear_combo.make_sum_of_hyps linear_combo.make_sum_of_hyps

/-! ### Part 2: Simplifying -/

/-- This tactic proves that the result of moving all the terms in an equality to
  the left side of the equals sign by subtracting the right side of the
  equation from the left side holds.  In other words, given `lhs = rhs`,
  this tactic proves that `lhs - rhs = 0`.

* Input:
  * `h_equality` : an `expr`, whose type should be an equality between terms of
      type `α`, where there is an instance of `add_group α`

* Output: an `expr`, which proves that `lhs - rhs = 0`, where `lhs` and `rhs` are
   the left and right sides of `h_equality` respectively
-/
unsafe def move_to_left_side (h_equality : expr) : tactic expr :=
  mk_app `` left_minus_right [h_equality]
#align linear_combo.move_to_left_side linear_combo.move_to_left_side

-- failed to format: unknown constant 'term.pseudo.antiquot'
/--
      This tactic replaces the target with the result of moving all the terms in the
        target to the left side of the equals sign by subtracting the right side of
        the equation from the left side.  In other words, when the target is
        lhs = rhs, this tactic proves that `lhs - rhs = 0` and replaces the target
        with this new equality.
      Note: The target must be an equality when this tactic is called, and the
        equality must have some type `α` on each side, where there is an instance of
        `add_group α`.

      * Input: N/A

      * Output: N/A
      -/
    unsafe
  def
    move_target_to_left_side
    : tactic Unit
    :=
      do
        let target ← target
          let ( targ_lhs , targ_rhs ) ← match_eq target
          let target_left_eq ← to_expr ` `( $ ( targ_lhs ) - $ ( targ_rhs ) = 0 )
          mk_app ` ` all_on_left_equiv [ targ_lhs , targ_rhs ] >>= replace_target target_left_eq
#align linear_combo.move_target_to_left_side linear_combo.move_target_to_left_side

/-! ### Part 3: Matching the Linear Combination to the Target -/

/-- This tactic changes the goal to be that the lefthand side of the target minus the
  lefthand side of the given expression is equal to 0.  For example,
  if `hsum_on_left` is `5*x - 5*y = 0`, and the target is `-5*y + 5*x = 0`, this
  tactic will change the target to be `-5*y + 5*x - (5*x - 5*y) = 0`.

This tactic only should be used when the target's type is an equality whose
  right side is 0.

* Input:
  * `hsum_on_left` : expr, whose type should be an equality with 0 on the right
      side of the equals sign

* Output: N/A
-/
unsafe def set_goal_to_hleft_sub_tleft (hsum_on_left : expr) : tactic Unit := do
  to_expr ``(eq_zero_of_sub_eq_zero $(hsum_on_left)) >>= apply
  skip
#align linear_combo.set_goal_to_hleft_sub_tleft linear_combo.set_goal_to_hleft_sub_tleft

/-- If an exponent `n` is provided, changes the goal from `t = 0` to `t^n = 0`.
* Input:
  * `exponent : ℕ`, the power to raise the goal by. If `1`, this tactic is a no-op.

* Output: N/A
-/
unsafe def raise_goal_to_power : ℕ → tactic Unit
  | 1 => skip
  | n => refine ``(@pow_eq_zero _ _ _ _ $(q(n)) _)
#align linear_combo.raise_goal_to_power linear_combo.raise_goal_to_power

/-- This tactic attempts to prove the goal by normalizing the target if the
`normalize` field of the given configuration is true.

* Input:
  * `config` : a `linear_combination_config`, which determines the tactic used
      for normalization if normalization is done

* Output: N/A
-/
unsafe def normalize_if_desired (config : linear_combination_config) : tactic Unit :=
  when config.normalize config.normalization_tactic
#align linear_combo.normalize_if_desired linear_combo.normalize_if_desired

/-! ### Part 4: Completed Tactic -/

/-- This is a tactic that attempts to simplify the target by creating a linear combination
  of a list of equalities and subtracting it from the target.
  (If the `normalize` field of the
  configuration is set to ff, then the tactic will simply set the user up to
  prove their target using the linear combination instead of normalizing the subtraction.)

Note: The left and right sides of all the equalities should have the same
  ring type, and the coefficients should also have this type.  There must be
  instances of `has_mul` and `add_group` for this type.  Also note that the
  target must involve at least one variable.

* Input:
  * `h_eqs_names` : a list of names, referring to equations in the local
      context
  * `coeffs` : a list of coefficients to be multiplied with the corresponding
    equations in the list of names
  * `config` : a `linear_combination_config`, which determines the tactic used
      for normalization; by default, this value is the standard configuration
      for a `linear_combination_config`

* Output: N/A
-/
unsafe def linear_combination (h_eqs_names : List pexpr) (coeffs : List pexpr)
    (config : linear_combination_config := { }) : tactic Unit := do
  let q(@Eq $(ext) _ _) ← target |
    fail "linear_combination can only be used to prove equality goals"
  let h_eqs ← h_eqs_names.mapM to_expr
  let hsum ← make_sum_of_hyps ext h_eqs coeffs
  let hsum_on_left ← move_to_left_side hsum
  move_target_to_left_side
  raise_goal_to_power config
  set_goal_to_hleft_sub_tleft hsum_on_left
  normalize_if_desired config
#align linear_combo.linear_combination linear_combo.linear_combination

-- failed to format: unknown constant 'term.pseudo.antiquot'
/-- `mk_mul [p₀, p₁, ..., pₙ]` produces the pexpr `p₀ * p₁ * ... * pₙ`. -/ unsafe
  def
    mk_mul
    : List pexpr → pexpr
    | [ ] => ` `( 1 ) | [ e ] => e | e :: es => ` `( $ ( e ) * $ ( mk_mul es ) )
#align linear_combo.mk_mul linear_combo.mk_mul

-- failed to format: unknown constant 'term.pseudo.antiquot'
/--
      `as_linear_combo neg ms e` is used to parse the argument to `linear_combination`.
      This argument is a sequence of literals `x`, `-x`, or `c*x` combined with `+` or `-`,
      given by the pexpr `e`.
      The `neg` and `ms` arguments are used recursively; called at the top level, its usage should be
      `as_linear_combo ff [] e`.
      -/
    unsafe
  def
    as_linear_combo
    : Bool → List pexpr → pexpr → List ( pexpr × pexpr )
    |
      neg , ms , e
      =>
      let
        ( head , args ) := pexpr.get_app_fn_args e
        match
          head . get_frozen_name , args
          with
          | ` ` Add.add , [ e1 , e2 ] => as_linear_combo neg ms e1 ++ as_linear_combo neg ms e2
            |
              ` ` Sub.sub , [ e1 , e2 ]
              =>
              as_linear_combo neg ms e1 ++ as_linear_combo ( not neg ) ms e2
            | ` ` Mul.mul , [ e1 , e2 ] => as_linear_combo neg ( e1 :: ms ) e2
            | ` ` Div.div , [ e1 , e2 ] => as_linear_combo neg ( ` `( $ ( e2 ) ⁻¹ ) :: ms ) e1
            | ` ` Neg.neg , [ e1 ] => as_linear_combo ( not neg ) ms e1
            | _ , _ => let m := mk_mul ms [ ( e , if neg then ` `( - $ ( m ) ) else m ) ]
#align linear_combo.as_linear_combo linear_combo.as_linear_combo

section InteractiveMode

/- ./././Mathport/Syntax/Translate/Tactic/Mathlib/Core.lean:38:34: unsupported: setup_tactic_parser -/
/-- `linear_combination` attempts to simplify the target by creating a linear combination
  of a list of equalities and subtracting it from the target.
  The tactic will create a linear
  combination by adding the equalities together from left to right, so the order
  of the input hypotheses does matter.  If the `normalize` field of the
  configuration is set to false, then the tactic will simply set the user up to
  prove their target using the linear combination instead of normalizing the subtraction.

Users may provide an optional `with { exponent := n }`. This will raise the goal to the power `n`
  before subtracting the linear combination.

Note: The left and right sides of all the equalities should have the same
  type, and the coefficients should also have this type.  There must be
  instances of `has_mul` and `add_group` for this type.

* Input:
  * `input` : the linear combination of proofs of equalities, given as a sum/difference
      of coefficients multiplied by expressions. The coefficients may be arbitrary
      pre-expressions; if a coefficient is an application of `+` or `-` it should be
      surrounded by parentheses. The expressions can be arbitrary proof terms proving
      equalities. Most commonly they are hypothesis names `h1, h2, ...`.

      If a coefficient is omitted, it is taken to be `1`.
  * `config` : a `linear_combination_config`, which determines the tactic used
      for normalization; by default, this value is the standard configuration
      for a linear_combination_config.  In the standard configuration,
      `normalize` is set to tt (meaning this tactic is set to use
      normalization), and `normalization_tactic` is set to  `ring_nf SOP`.

Example Usage:
```
example (x y : ℤ) (h1 : x*y + 2*x = 1) (h2 : x = y) :
  x*y = -2*y + 1 :=
by linear_combination 1*h1 - 2*h2

example (x y : ℤ) (h1 : x*y + 2*x = 1) (h2 : x = y) :
  x*y = -2*y + 1 :=
by linear_combination h1 - 2*h2

example (x y : ℤ) (h1 : x*y + 2*x = 1) (h2 : x = y) :
  x*y = -2*y + 1 :=
begin
 linear_combination -2*h2,
 /- Goal: x * y + x * 2 - 1 = 0 -/
end

example (x y z : ℝ) (ha : x + 2*y - z = 4) (hb : 2*x + y + z = -2)
    (hc : x + 2*y + z = 2) :
  -3*x - 3*y - 4*z = 2 :=
by linear_combination ha - hb - 2*hc

example (x y : ℚ) (h1 : x + y = 3) (h2 : 3*x = 7) :
  x*x*y + y*x*y + 6*x = 3*x*y + 14 :=
by linear_combination x*y*h1 + 2*h2

example (x y : ℤ) (h1 : x = -3) (h2 : y = 10) :
  2*x = -6 :=
begin
  linear_combination 2*h1 with {normalize := ff},
  simp,
  norm_cast
end

example (x y z : ℚ) (h : x = y) (h2 : x * y = 0) : x + y*z = 0 :=
by linear_combination (-y * z ^ 2 + x) * h + (z ^ 2 + 2 * z + 1) * h2 with { exponent := 2 }

constants (qc : ℚ) (hqc : qc = 2*qc)

example (a b : ℚ) (h : ∀ p q : ℚ, p = q) : 3*a + qc = 3*b + 2*qc :=
by linear_combination 3 * h a b + hqc
```
-/
unsafe def _root_.tactic.interactive.linear_combination
    (input : parse (as_linear_combo false [] <$> texpr)?) (_ : parse (tk "with")?)
    (config : linear_combination_config := { }) : tactic Unit :=
  let (h_eqs_names, coeffs) := List.unzip (input.getD [])
  linear_combination h_eqs_names coeffs config
#align tactic.interactive.linear_combination tactic.interactive.linear_combination

add_tactic_doc
  { Name := "linear_combination"
    category := DocCategory.tactic
    declNames := [`tactic.interactive.linear_combination]
    tags := ["arithmetic"] }

end InteractiveMode

end LinearCombo


/-
Copyright (c) 2023 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 algebra.field.ulift
! leanprover-community/mathlib commit 13e18cfa070ea337ea960176414f5ae3a1534aae
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Field.Basic
import Mathlib.Algebra.Ring.ULift

/-!
# Field instances for `ULift`

This file defines instances for field, semifield and related structures on `ULift` types.

(Recall `ULift α` is just a "copy" of a type `α` in a higher universe.)
-/

universe u v
variable {α : Type u} {x y : ULift.{v} α}

namespace ULift

instance [RatCast α] : RatCast (ULift α) := ⟨λ a ↦ up a⟩

@[simp, norm_cast]
theorem up_ratCast [RatCast α] (q : ℚ) : up (q : α) = q :=
  rfl
#align ulift.up_rat_cast ULift.up_ratCast

@[simp, norm_cast]
theorem down_ratCast [RatCast α] (q : ℚ) : down (q : ULift α) = q :=
  rfl
#align ulift.down_rat_cast ULift.down_ratCast

instance divisionSemiring [DivisionSemiring α] : DivisionSemiring (ULift α) := by
  refine' down_injective.divisionSemiring down .. <;> intros <;> rfl
#align ulift.division_semiring ULift.divisionSemiring

instance semifield [Semifield α] : Semifield (ULift α) :=
  { ULift.divisionSemiring, ULift.commGroupWithZero with }
#align ulift.semifield ULift.semifield

instance divisionRing [DivisionRing α] : DivisionRing (ULift α) := by
  refine' down_injective.divisionRing down .. <;> intros <;> rfl
#align ulift.division_ring ULift.divisionRing

instance field [Field α] : Field (ULift α) :=
  { ULift.semifield, ULift.divisionRing with }
#align ulift.field ULift.field

end ULift


import action group_theory.quotient_group

open quotient_group mul_action

section

parameter {α : Type}
parameters (H : set (free_group α)) [is_subgroup H]
def Q := quotient H
def r : Q := mk 1

lemma r_mk_one : r = mk 1 := rfl

instance mul_act : mul_action (free_group α) Q := mul_action.mul_action H

lemma mul_mk (g g') : g • (mk g' : Q) = mk (g * g') := rfl

lemma smul_r (g : free_group α) : g • r = mk g
  := by rw [r_mk_one, mul_mk, mul_one]

lemma trans_act : orbit (free_group α) r = set.univ
  := set.ext $ λ q, (quot.ind $ λ a, (iff_true _).mpr (⟨a, smul_r a⟩)) q

lemma mk_eq_iff (g g') : (mk g : Q) = mk g' ↔ g⁻¹ * g' ∈ H
  := quotient_group.eq

lemma h_is_stab : H = stabilizer _ r := set.ext $ λ x, begin
  simp,
  rw [smul_r, r_mk_one, mk_eq_iff, mul_one],
  symmetry,
  exact is_subgroup.inv_mem_iff H,
end

def h_isom : H ≃* stabilizer (free_group α) r
  := ⟨λ ⟨x, h⟩, ⟨x, h_is_stab ▸ h⟩,
  λ ⟨x, h⟩, ⟨x, h_is_stab.symm ▸ h⟩,
  λ ⟨_, _⟩, rfl, λ ⟨_, _⟩, rfl, λ ⟨_, _⟩ ⟨_, _⟩, rfl⟩

theorem nielsen_schreier : ∃ (R : Type), nonempty (H ≃* free_group R) ∧ nonempty (Q × α ⊕ unit ≃ Q ⊕ R)
  := ⟨R Q r trans_act, ⟨mul_equiv.trans h_isom $ isom _ _ _⟩, ⟨index_equiv _ _ _⟩⟩

end


import combinatorics.simple_graph.clique
import combinatorics.simple_graph.degree_sum
import data.finset.basic
import data.nat.basic
import tactic.core
import algebra.big_operators

open finset nat
open_locale big_operators classical

variable {α : Type}
variable [fintype α]
variable {t : ℕ}

lemma card_rels : fintype.card (α → α → Prop) = 2^((fintype.card α)^2):=
begin
  rw [pow_two,fintype.card_fun,pow_mul,fintype.card_fun, fintype.card_Prop],
end

def equiv_of_symm_irr : equiv {r : α → α → Prop // symmetric r ∧ irreflexive r} (set ({s:finset α // card s = 2})):=
{ to_fun :=
begin
  intro r, rintros ⟨s,ps⟩,
  rw card_eq_two at ps,
  exact r.1 ps.some ps.some_spec.some,
end,
inv_fun :=
begin
  rintros A,
  refine ⟨_,_,_⟩,
  intros x y,
  by_cases x=y,
  exact false,
  exact  (⟨({x,y}:finset α), card_eq_two.2 ⟨x ,y ,h, rfl⟩ ⟩:({s:finset α// card s = 2})) ∈ A,
  intros x y, dsimp, split_ifs,
  exact false.elim,
  exact false.elim,
  exfalso, exact h (h_1.symm),
  intros h,
  have : ({x,y}:finset α) = {y,x},{
    ext,
    simp only [mem_insert, mem_singleton],
    tauto,
  },
  simp_rw ← this, exact h,
  intros x h1,
  split_ifs at h1;exact h1,
end,
left_inv :=
begin

  sorry,
end,
right_inv :=
begin
  sorry,
end,
}

lemma card_symrels : fintype.card {r : α → α → Prop // symmetric r ∧ irreflexive r} = 2^((fintype.card α).choose 2):=
begin
  rw ← fintype.card_finset_len,
  rw fintype.card_congr equiv_of_symm_irr, exact fintype.card_set,
  apply_instance,
end

/-- The number of possible t-cliques in a a simple_graph α is {card α choose t}-/
lemma card_cliques : card (powerset_len t (univ:finset α)) = nat.choose (fintype.card α) t:=
begin
  rw [card_powerset_len, card_univ],
end

@[reducible]def graphs_with_clique (s : finset α) : set (simple_graph α) :=  {G:simple_graph α | G.is_clique s}

@[simp]lemma empty_clique (G: simple_graph α) : G.is_clique ∅ :=
begin
 intros a ha, exfalso, exact not_mem_empty a ha,
end

@[ext]lemma graph_ext (G H :simple_graph α) : G = H ↔ ∀ u v, G.adj u v = H.adj u v:=
begin
  split,
  intro h,rw h, intros u v, refl,
  intro h,
  ext x y,
  rw h x y,
end

def edge_set_to_graph : set ((powerset_len 2 (univ:finset α))) → (simple_graph α):= λ padj,
{ adj :=
begin
  intros u v,
  by_cases u = v,
    exact false,
  set ed:=({u,v}:finset α) with hed,
  have : ed ∈ powerset_len 2 univ,
  {
    rw mem_powerset_len,
    exact ⟨subset_univ _,card_eq_two.2 ⟨u,v,h,hed⟩⟩,
  },
  have nt:(powerset_len 2 (univ:finset α)):=subtype.mk ed this,
  exact nt ∈ padj,
end,
symm :=
begin
  intros u v,dsimp,
  split_ifs,
  exact false.elim,
  exact false.elim,
  exfalso, apply h (h_1.symm),
  intro hadj,
  have : ({u,v}:finset α)= {v,u},
  {
    ext,
    simp only [mem_insert, mem_singleton],
    tauto,
  },
  simp_rw ← this,
  assumption,
end,
loopless :=
begin
  obviously,
end}

def graph_to_edge_set : (simple_graph α) → set ((powerset_len 2 (univ:finset α))):=
begin
  intro G,
  rintro ⟨pair,pr⟩,
  rw mem_powerset_len at pr,
  obtain ⟨pr1,pr2⟩:=pr,
  rw card_eq_two at pr2,
  exact G.adj pr2.some pr2.some_spec.some,
end

def graph_equiv :equiv (simple_graph α) (set (powerset_len 2 (univ:finset α))) :={
to_fun :=graph_to_edge_set,
inv_fun :=edge_set_to_graph,
left_inv :=
begin
  intro G,
  ext u v,
  unfold edge_set_to_graph,
  dsimp,
--  unfold graph_to_edge_set,
  --dsimp,
  split_ifs,
  simp,
  rw h, exact G.loopless _,

  split,
  intros h1,
  unfold graph_to_edge_set at h1,
  dsimp at h1,
  have : ({u,v}:finset α) ∈ powerset_len 2 univ,
  {
    rw mem_powerset_len,
    exact ⟨subset_univ _,card_eq_two.2 ⟨u,v,h,rfl⟩⟩,
  },
  sorry,
  intros h1,
  unfold graph_to_edge_set,
  dsimp,
  have : ({u,v}:finset α) ∈ powerset_len 2 univ,
  {
    rw mem_powerset_len,
    exact ⟨subset_univ _,card_eq_two.2 ⟨u,v,h,rfl⟩⟩,
  },

  sorry,
end,
right_inv :=
begin
   sorry,
end,
}

@[simp]lemma card_graphs' : fintype.card (simple_graph α) =  2^fintype.card (powerset_len 2 (univ:finset α)):=
begin
  have : equiv (simple_graph α) (set (powerset_len 2 (univ:finset α))),{
    sorry,
  }  ,
  rw fintype.card_congr this,simp only [fintype.card_set],
end

@[simp]lemma card_graphs : fintype.card (simple_graph α) = 2^(nat.choose (fintype.card α) 2):=
begin
  simpa only [card_graphs', fintype.card_coe, card_powerset_len],
end

lemma card_graphs_with_clique {s : finset α} (hs : s ∈ powerset_len t (univ:finset α)) :
 fintype.card (graphs_with_clique s) = 2^((nat.choose (fintype.card α) 2) - (nat.choose t 2)):=
 begin
  cases t with t ht,
  simp only [fintype.card_of_finset, filter_congr_decidable, choose_zero_succ, tsub_zero],
  rw [powerset_len_zero,mem_singleton] at hs, rw hs,
  dsimp,
  simp only [empty_clique, filter_true_of_mem, mem_univ, forall_const],
  exact card_graphs,
  rw mem_powerset_len at hs,
--  obtain ⟨hs1,hs2⟩:=hs,
  simp only [set.coe_set_of],

  sorry,
 end


/-
Copyright (c) 2022 Daniel Roca González. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Daniel Roca González
-/
import analysis.inner_product_space.projection
import analysis.inner_product_space.dual
import analysis.normed_space.banach
import analysis.normed_space.operator_norm
import topology.metric_space.antilipschitz

/-!
# The Lax-Milgram Theorem

We consider an Hilbert space `V` over `ℝ`
equipped with a bounded bilinear form `B : V →L[ℝ] V →L[ℝ] ℝ`.

Recall that a bilinear form `B : V →L[ℝ] V →L[ℝ] ℝ` is *coercive*
iff `∃ C, (0 < C) ∧ ∀ u, C * ‖u‖ * ‖u‖ ≤ B u u`.
Under the hypothesis that `B` is coercive
we prove the Lax-Milgram theorem:
that is, the map `inner_product_space.continuous_linear_map_of_bilin` from
`analysis.inner_product_space.dual` can be upgraded to a continuous equivalence
`is_coercive.continuous_linear_equiv_of_bilin : V ≃L[ℝ] V`.

## References

* We follow the notes of Peter Howard's Spring 2020 *M612: Partial Differential Equations* lecture,
  see[howard]

## Tags

dual, Lax-Milgram
-/

noncomputable theory
open is_R_or_C linear_map continuous_linear_map inner_product_space linear_map (ker range)
open_locale real_inner_product_space nnreal

universe u

namespace is_coercive
variables {V : Type u} [normed_add_comm_group V] [inner_product_space ℝ V] [complete_space V]
variables {B : V →L[ℝ] V →L[ℝ] ℝ}

local postfix `♯`:1025 := @continuous_linear_map_of_bilin ℝ V _ _ _ _

lemma bounded_below (coercive : is_coercive B) :
  ∃ C, 0 < C ∧ ∀ v, C * ‖v‖ ≤ ‖B♯ v‖ :=
begin
  rcases coercive with ⟨C, C_ge_0, coercivity⟩,
  refine ⟨C, C_ge_0, _⟩,
  intro v,
  by_cases h : 0 < ‖v‖,
  { refine (mul_le_mul_right h).mp _,
    calc C * ‖v‖ * ‖v‖
        ≤ B v v : coercivity v
    ... = ⟪B♯ v, v⟫_ℝ : (continuous_linear_map_of_bilin_apply ℝ B v v).symm
    ... ≤ ‖B♯ v‖ * ‖v‖ : real_inner_le_norm (B♯ v) v, },
  { have : v = 0 := by simpa using h,
    simp [this], }
end

lemma antilipschitz (coercive : is_coercive B) :
  ∃ C : ℝ≥0, 0 < C ∧ antilipschitz_with C B♯ :=
begin
  rcases coercive.bounded_below with ⟨C, C_pos, below_bound⟩,
  refine ⟨(C⁻¹).to_nnreal, real.to_nnreal_pos.mpr (inv_pos.mpr C_pos), _⟩,
  refine continuous_linear_map.antilipschitz_of_bound B♯ _,
  simp_rw [real.coe_to_nnreal',
    max_eq_left_of_lt (inv_pos.mpr C_pos),
    ←inv_mul_le_iff (inv_pos.mpr C_pos)],
  simpa using below_bound,
end

lemma ker_eq_bot (coercive : is_coercive B) : ker B♯ = ⊥ :=
begin
  rw [linear_map_class.ker_eq_bot],
  rcases coercive.antilipschitz with ⟨_, _, antilipschitz⟩,
  exact antilipschitz.injective,
end

lemma closed_range (coercive : is_coercive B) : is_closed (range B♯ : set V) :=
begin
  rcases coercive.antilipschitz with ⟨_, _, antilipschitz⟩,
  exact antilipschitz.is_closed_range B♯.uniform_continuous,
end

lemma range_eq_top (coercive : is_coercive B) : range B♯ = ⊤ :=
begin
  haveI := coercive.closed_range.complete_space_coe,
  rw ← (range B♯).orthogonal_orthogonal,
  rw submodule.eq_top_iff',
  intros v w mem_w_orthogonal,
  rcases coercive with ⟨C, C_pos, coercivity⟩,
  obtain rfl : w = 0,
  { rw [←norm_eq_zero, ←mul_self_eq_zero, ←mul_right_inj' C_pos.ne', mul_zero, ←mul_assoc],
    apply le_antisymm,
    { calc C * ‖w‖ * ‖w‖
          ≤ B w w : coercivity w
      ... = ⟪B♯ w, w⟫_ℝ : (continuous_linear_map_of_bilin_apply ℝ B w w).symm
      ... = 0 : mem_w_orthogonal _ ⟨w, rfl⟩ },
    { exact mul_nonneg (mul_nonneg C_pos.le (norm_nonneg w)) (norm_nonneg w) } },
  exact inner_zero_left _,
end

/--
The Lax-Milgram equivalence of a coercive bounded bilinear operator:
for all `v : V`, `continuous_linear_equiv_of_bilin B v` is the unique element `V`
such that `⟪continuous_linear_equiv_of_bilin B v, w⟫ = B v w`.
The Lax-Milgram theorem states that this is a continuous equivalence.
-/
def continuous_linear_equiv_of_bilin (coercive : is_coercive B) : V ≃L[ℝ] V :=
continuous_linear_equiv.of_bijective
  B♯
  coercive.ker_eq_bot
  coercive.range_eq_top

@[simp]
lemma continuous_linear_equiv_of_bilin_apply (coercive : is_coercive B) (v w : V) :
  ⟪coercive.continuous_linear_equiv_of_bilin v, w⟫_ℝ = B v w :=
continuous_linear_map_of_bilin_apply ℝ B v w

lemma unique_continuous_linear_equiv_of_bilin (coercive : is_coercive B) {v f : V}
  (is_lax_milgram : (∀ w, ⟪f, w⟫_ℝ = B v w)) :
  f = coercive.continuous_linear_equiv_of_bilin v :=
unique_continuous_linear_map_of_bilin ℝ B is_lax_milgram

end is_coercive


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Chris Hughes
-/
import algebra.gcd_monoid.basic
import algebra.euclidean_domain.basic
import ring_theory.ideal.basic
import ring_theory.principal_ideal_domain

/-!
# Lemmas about Euclidean domains

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

Various about Euclidean domains are proved; all of them seem to be true
more generally for principal ideal domains, so these lemmas should
probably be reproved in more generality and this file perhaps removed?

## Tags

euclidean domain
-/

noncomputable theory
open_locale classical
open euclidean_domain set ideal

section gcd_monoid

variables {R : Type*} [euclidean_domain R] [gcd_monoid R]

lemma gcd_ne_zero_of_left (p q : R) (hp : p ≠ 0) :
  gcd_monoid.gcd p q ≠ 0 :=
λ h, hp $ eq_zero_of_zero_dvd (h ▸ gcd_dvd_left p q)

lemma gcd_ne_zero_of_right (p q : R) (hp : q ≠ 0) :
  gcd_monoid.gcd p q ≠ 0 :=
λ h, hp $ eq_zero_of_zero_dvd (h ▸ gcd_dvd_right p q)

lemma left_div_gcd_ne_zero {p q : R} (hp : p ≠ 0) :
  p / gcd_monoid.gcd p q ≠ 0 :=
begin
  obtain ⟨r, hr⟩ := gcd_monoid.gcd_dvd_left p q,
  obtain ⟨pq0, r0⟩ : gcd_monoid.gcd p q ≠ 0 ∧ r ≠ 0 := mul_ne_zero_iff.mp (hr ▸ hp),
  rw [hr, mul_comm, mul_div_cancel _ pq0] { occs := occurrences.pos [1] },
  exact r0,
end

lemma right_div_gcd_ne_zero {p q : R} (hq : q ≠ 0) :
  q / gcd_monoid.gcd p q ≠ 0 :=
begin
  obtain ⟨r, hr⟩ := gcd_monoid.gcd_dvd_right p q,
  obtain ⟨pq0, r0⟩ : gcd_monoid.gcd p q ≠ 0 ∧ r ≠ 0 := mul_ne_zero_iff.mp (hr ▸ hq),
  rw [hr, mul_comm, mul_div_cancel _ pq0] { occs := occurrences.pos [1] },
  exact r0,
end

end gcd_monoid

namespace euclidean_domain

/-- Create a `gcd_monoid` whose `gcd_monoid.gcd` matches `euclidean_domain.gcd`. -/
def gcd_monoid (R) [euclidean_domain R] : gcd_monoid R :=
{ gcd := gcd,
  lcm := lcm,
  gcd_dvd_left := gcd_dvd_left,
  gcd_dvd_right := gcd_dvd_right,
  dvd_gcd := λ a b c, dvd_gcd,
  gcd_mul_lcm := λ a b, by rw euclidean_domain.gcd_mul_lcm,
  lcm_zero_left := lcm_zero_left,
  lcm_zero_right := lcm_zero_right }

variables {α : Type*} [euclidean_domain α] [decidable_eq α]

theorem span_gcd {α} [euclidean_domain α] (x y : α) :
  span ({gcd x y} : set α) = span ({x, y} : set α) :=
begin
  letI := euclidean_domain.gcd_monoid α,
  exact span_gcd x y,
end

theorem gcd_is_unit_iff {α} [euclidean_domain α] {x y : α} :
  is_unit (gcd x y) ↔ is_coprime x y :=
begin
  letI := euclidean_domain.gcd_monoid α,
  exact gcd_is_unit_iff x y,
end

-- this should be proved for UFDs surely?
theorem is_coprime_of_dvd {α} [euclidean_domain α] {x y : α}
  (nonzero : ¬ (x = 0 ∧ y = 0)) (H : ∀ z ∈ nonunits α, z ≠ 0 → z ∣ x → ¬ z ∣ y) :
  is_coprime x y :=
begin
  letI := euclidean_domain.gcd_monoid α,
  exact is_coprime_of_dvd x y nonzero H,
end

-- this should be proved for UFDs surely?
theorem dvd_or_coprime {α} [euclidean_domain α] (x y : α)
  (h : irreducible x) : x ∣ y ∨ is_coprime x y :=
begin
  letI := euclidean_domain.gcd_monoid α,
  exact dvd_or_coprime x y h,
end

end euclidean_domain


/-
Copyright (c) 2022 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov
-/
import analysis.normed.group.completion
import analysis.normed_space.operator_norm
import topology.algebra.uniform_ring

/-!
# Normed space structure on the completion of a normed space

If `E` is a normed space over `𝕜`, then so is `uniform_space.completion E`. In this file we provide
necessary instances and define `uniform_space.completion.to_complₗᵢ` - coercion
`E → uniform_space.completion E` as a bundled linear isometry.

We also show that if `A` is a normed algebra over `𝕜`, then so is `uniform_space.completion A`.

TODO: Generalise the results here from the concrete `completion` to any `abstract_completion`.
-/

noncomputable theory

namespace uniform_space
namespace completion

variables (𝕜 E : Type*) [normed_field 𝕜] [normed_add_comm_group E] [normed_space 𝕜 E]

@[priority 100]
instance normed_space.to_has_uniform_continuous_const_smul :
  has_uniform_continuous_const_smul 𝕜 E :=
⟨λ c, (lipschitz_with_smul c).uniform_continuous⟩

instance : normed_space 𝕜 (completion E) :=
{ smul := (•),
  norm_smul_le := λ c x, induction_on x
    (is_closed_le (continuous_const_smul _).norm (continuous_const.mul continuous_norm)) $
    λ y, by simp only [← coe_smul, norm_coe, norm_smul],
  .. completion.module }

variables {𝕜 E}

/-- Embedding of a normed space to its completion as a linear isometry. -/
def to_complₗᵢ : E →ₗᵢ[𝕜] completion E :=
{ to_fun := coe,
  map_smul' := coe_smul,
  norm_map' := norm_coe,
  .. to_compl }

@[simp] lemma coe_to_complₗᵢ : ⇑(to_complₗᵢ : E →ₗᵢ[𝕜] completion E) = coe := rfl

/-- Embedding of a normed space to its completion as a continuous linear map. -/
def to_complL : E →L[𝕜] completion E :=
to_complₗᵢ.to_continuous_linear_map

@[simp] lemma coe_to_complL : ⇑(to_complL : E →L[𝕜] completion E) = coe := rfl

@[simp] lemma norm_to_complL {𝕜 E : Type*} [nontrivially_normed_field 𝕜] [normed_add_comm_group E]
  [normed_space 𝕜 E] [nontrivial E] : ‖(to_complL : E →L[𝕜] completion E)‖ = 1 :=
(to_complₗᵢ : E →ₗᵢ[𝕜] completion E).norm_to_continuous_linear_map

section algebra

variables (𝕜) (A : Type*)

instance [semi_normed_ring A] : normed_ring (completion A) :=
{ dist_eq := λ x y,
  begin
    apply completion.induction_on₂ x y; clear x y,
    { refine is_closed_eq (completion.uniform_continuous_extension₂ _).continuous _,
      exact continuous.comp completion.continuous_extension continuous_sub },
    { intros x y,
      rw [← completion.coe_sub, norm_coe, completion.dist_eq, dist_eq_norm] }
  end,
  norm_mul := λ x y,
  begin
    apply completion.induction_on₂ x y; clear x y,
    { exact is_closed_le (continuous.comp (continuous_norm) continuous_mul) (continuous.comp
        real.continuous_mul (continuous.prod_map continuous_norm continuous_norm)) },
    { intros x y,
      simp only [← coe_mul, norm_coe], exact norm_mul_le x y, }
  end,
  ..completion.ring,
  ..completion.metric_space }

instance [semi_normed_comm_ring A] [normed_algebra 𝕜 A] [has_uniform_continuous_const_smul 𝕜 A] :
  normed_algebra 𝕜 (completion A) :=
{ norm_smul_le := λ r x,
  begin
    apply completion.induction_on x; clear x,
    { exact is_closed_le (continuous.comp (continuous_norm) (continuous_const_smul r))
      (continuous.comp (continuous_mul_left _) continuous_norm), },
    { intros x,
      simp only [← coe_smul, norm_coe], exact norm_smul_le r x }
  end,
  ..completion.algebra A 𝕜}

end algebra

end completion
end uniform_space


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

/-!
# Smooth bump functions on a smooth manifold

In this file we define `smooth_bump_function I c` to be a bundled smooth "bump" function centered at
`c`. It is a structure that consists of two real numbers `0 < r < R` with small enough `R`. We
define a coercion to function for this type, and for `f : smooth_bump_function I c`, the function
`⇑f` written in the extended chart at `c` has the following properties:

* `f x = 1` in the closed euclidean ball of radius `f.r` centered at `c`;
* `f x = 0` outside of the euclidean ball of radius `f.R` centered at `c`;
* `0 ≤ f x ≤ 1` for all `x`.

The actual statements involve (pre)images under `ext_chart_at I f` and are given as lemmas in the
`smooth_bump_function` namespace.

## Tags

manifold, smooth bump function
-/

universes uE uF uH uM
variables
{E : Type uE} [normed_group E] [normed_space ℝ E] [finite_dimensional ℝ E]
{H : Type uH} [topological_space H] (I : model_with_corners ℝ E H)
{M : Type uM} [topological_space M] [charted_space H M] [smooth_manifold_with_corners I M]

open function filter finite_dimensional set
open_locale topological_space manifold classical filter big_operators

noncomputable theory

/-!
### Smooth bump function

In this section we define a structure for a bundled smooth bump function and prove its properties.
-/

/-- Given a smooth manifold modelled on a finite dimensional space `E`,
`f : smooth_bump_function I M` is a smooth function on `M` such that in the extended chart `e` at
`f.c`:

* `f x = 1` in the closed euclidean ball of radius `f.r` centered at `f.c`;
* `f x = 0` outside of the euclidean ball of radius `f.R` centered at `f.c`;
* `0 ≤ f x ≤ 1` for all `x`.

The structure contains data required to construct a function with these properties. The function is
available as `⇑f` or `f x`. Formal statements of the properties listed above involve some
(pre)images under `ext_chart_at I f.c` and are given as lemmas in the `smooth_bump_function`
namespace. -/
structure smooth_bump_function (c : M) extends cont_diff_bump (ext_chart_at I c c) :=
(closed_ball_subset :
  (euclidean.closed_ball (ext_chart_at I c c) R) ∩ range I ⊆ (ext_chart_at I c).target)

variable {M}

namespace smooth_bump_function

open euclidean (renaming dist -> eudist)

variables {c : M} (f : smooth_bump_function I c) {x : M} {I}

/-- The function defined by `f : smooth_bump_function c`. Use automatic coercion to function
instead. -/
def to_fun : M → ℝ :=
indicator (chart_at H c).source (f.to_cont_diff_bump ∘ ext_chart_at I c)

instance : has_coe_to_fun (smooth_bump_function I c) (λ _, M → ℝ) := ⟨to_fun⟩

lemma coe_def :
  ⇑f = indicator (chart_at H c).source (f.to_cont_diff_bump ∘ ext_chart_at I c) :=
rfl

lemma R_pos : 0 < f.R := f.to_cont_diff_bump.R_pos

lemma ball_subset :
  ball (ext_chart_at I c c) f.R ∩ range I ⊆ (ext_chart_at I c).target :=
subset.trans (inter_subset_inter_left _ ball_subset_closed_ball) f.closed_ball_subset

lemma eq_on_source :
  eq_on f (f.to_cont_diff_bump ∘ ext_chart_at I c) (chart_at H c).source :=
eq_on_indicator

lemma eventually_eq_of_mem_source (hx : x ∈ (chart_at H c).source) :
  f =ᶠ[𝓝 x] f.to_cont_diff_bump ∘ ext_chart_at I c :=
f.eq_on_source.eventually_eq_of_mem $ is_open.mem_nhds (chart_at H c).open_source hx

lemma one_of_dist_le (hs : x ∈ (chart_at H c).source)
  (hd : eudist (ext_chart_at I c x) (ext_chart_at I c c) ≤ f.r) :
  f x = 1 :=
by simp only [f.eq_on_source hs, (∘), f.to_cont_diff_bump.one_of_mem_closed_ball hd]

lemma support_eq_inter_preimage :
  support f =
    (chart_at H c).source ∩ (ext_chart_at I c ⁻¹' ball (ext_chart_at I c c) f.R) :=
by rw [coe_def, support_indicator, (∘), support_comp_eq_preimage, ← ext_chart_at_source I,
  ← (ext_chart_at I c).symm_image_target_inter_eq',
  ← (ext_chart_at I c).symm_image_target_inter_eq', f.to_cont_diff_bump.support_eq]

lemma open_support : is_open (support f) :=
by { rw support_eq_inter_preimage, exact ext_chart_preimage_open_of_open I c is_open_ball }

lemma support_eq_symm_image :
  support f = (ext_chart_at I c).symm '' (ball (ext_chart_at I c c) f.R ∩ range I) :=
begin
  rw [f.support_eq_inter_preimage, ← ext_chart_at_source I,
    ← (ext_chart_at I c).symm_image_target_inter_eq', inter_comm],
  congr' 1 with y,
  exact and.congr_right_iff.2
    (λ hy, ⟨λ h, ext_chart_at_target_subset_range _ _ h, λ h, f.ball_subset ⟨hy, h⟩⟩)
end

lemma support_subset_source : support f ⊆ (chart_at H c).source :=
by { rw [f.support_eq_inter_preimage, ← ext_chart_at_source I], exact inter_subset_left _ _ }

lemma image_eq_inter_preimage_of_subset_support {s : set M} (hs : s ⊆ support f) :
  ext_chart_at I c '' s =
    closed_ball (ext_chart_at I c c) f.R ∩ range I ∩ (ext_chart_at I c).symm ⁻¹' s :=
begin
  rw [support_eq_inter_preimage, subset_inter_iff, ← ext_chart_at_source I,
    ← image_subset_iff] at hs,
  cases hs with hse hsf,
  apply subset.antisymm,
  { refine subset_inter (subset_inter (subset.trans hsf ball_subset_closed_ball) _) _,
    { rintro _ ⟨x, -, rfl⟩, exact mem_range_self _ },
    { rw [(ext_chart_at I c).image_eq_target_inter_inv_preimage hse],
      exact inter_subset_right _ _ } },
  { refine subset.trans (inter_subset_inter_left _ f.closed_ball_subset) _,
    rw [(ext_chart_at I c).image_eq_target_inter_inv_preimage hse] }
end

lemma mem_Icc : f x ∈ Icc (0 : ℝ) 1 :=
begin
  have : f x = 0 ∨ f x = _, from indicator_eq_zero_or_self _ _ _,
  cases this; rw this,
  exacts [left_mem_Icc.2 zero_le_one,
    ⟨f.to_cont_diff_bump.nonneg, f.to_cont_diff_bump.le_one⟩]
end

lemma nonneg : 0 ≤ f x := f.mem_Icc.1

lemma le_one : f x ≤ 1 := f.mem_Icc.2

lemma eventually_eq_one_of_dist_lt (hs : x ∈ (chart_at H c).source)
  (hd : eudist (ext_chart_at I c x) (ext_chart_at I c c) < f.r) :
  f =ᶠ[𝓝 x] 1 :=
begin
  filter_upwards [is_open.mem_nhds (ext_chart_preimage_open_of_open I c is_open_ball) ⟨hs, hd⟩],
  rintro z ⟨hzs, hzd : _ < _⟩,
  exact f.one_of_dist_le hzs hzd.le
end

lemma eventually_eq_one : f =ᶠ[𝓝 c] 1 :=
f.eventually_eq_one_of_dist_lt (mem_chart_source _ _) $
by { rw [euclidean.dist, dist_self], exact f.r_pos }

@[simp] lemma eq_one : f c = 1 := f.eventually_eq_one.eq_of_nhds

lemma support_mem_nhds : support f ∈ 𝓝 c :=
f.eventually_eq_one.mono $ λ x hx, by { rw hx, exact one_ne_zero }

lemma tsupport_mem_nhds : tsupport f ∈ 𝓝 c :=
mem_of_superset f.support_mem_nhds subset_closure

lemma c_mem_support : c ∈ support f := mem_of_mem_nhds f.support_mem_nhds

lemma nonempty_support : (support f).nonempty := ⟨c, f.c_mem_support⟩

lemma compact_symm_image_closed_ball :
  is_compact ((ext_chart_at I c).symm '' (closed_ball (ext_chart_at I c c) f.R ∩ range I)) :=
(euclidean.is_compact_closed_ball.inter_right I.closed_range).image_of_continuous_on $
  (ext_chart_at_continuous_on_symm _ _).mono f.closed_ball_subset

/-- Given a smooth bump function `f : smooth_bump_function I c`, the closed ball of radius `f.R` is
known to include the support of `f`. These closed balls (in the model normed space `E`) intersected
with `set.range I` form a basis of `𝓝[range I] (ext_chart_at I c c)`. -/
lemma nhds_within_range_basis :
  (𝓝[range I] (ext_chart_at I c c)).has_basis (λ f : smooth_bump_function I c, true)
    (λ f, closed_ball (ext_chart_at I c c) f.R ∩ range I) :=
begin
  refine ((nhds_within_has_basis euclidean.nhds_basis_closed_ball _).restrict_subset
      (ext_chart_at_target_mem_nhds_within _ _)).to_has_basis' _ _,
  { rintro R ⟨hR0, hsub⟩,
    exact ⟨⟨⟨⟨R / 2, R, half_pos hR0, half_lt_self hR0⟩⟩, hsub⟩, trivial, subset.rfl⟩ },
  { exact λ f _, inter_mem (mem_nhds_within_of_mem_nhds $ closed_ball_mem_nhds f.R_pos)
      self_mem_nhds_within }
end

lemma closed_image_of_closed {s : set M} (hsc : is_closed s) (hs : s ⊆ support f) :
  is_closed (ext_chart_at I c '' s) :=
begin
  rw f.image_eq_inter_preimage_of_subset_support hs,
  refine continuous_on.preimage_closed_of_closed
    ((ext_chart_continuous_on_symm _ _).mono f.closed_ball_subset) _ hsc,
  exact is_closed.inter is_closed_closed_ball I.closed_range
end

/-- If `f` is a smooth bump function and `s` closed subset of the support of `f` (i.e., of the open
ball of radius `f.R`), then there exists `0 < r < f.R` such that `s` is a subset of the open ball of
radius `r`. Formally, `s ⊆ e.source ∩ e ⁻¹' (ball (e c) r)`, where `e = ext_chart_at I c`. -/
lemma exists_r_pos_lt_subset_ball {s : set M} (hsc : is_closed s) (hs : s ⊆ support f) :
  ∃ r (hr : r ∈ Ioo 0 f.R), s ⊆
    (chart_at H c).source ∩ ext_chart_at I c ⁻¹' (ball (ext_chart_at I c c) r) :=
begin
  set e := ext_chart_at I c,
  have : is_closed (e '' s) := f.closed_image_of_closed hsc hs,
  rw [support_eq_inter_preimage, subset_inter_iff, ← image_subset_iff] at hs,
  rcases euclidean.exists_pos_lt_subset_ball f.R_pos this hs.2 with ⟨r, hrR, hr⟩,
  exact ⟨r, hrR, subset_inter hs.1 (image_subset_iff.1 hr)⟩
end

/-- Replace `r` with another value in the interval `(0, f.R)`. -/
def update_r (r : ℝ) (hr : r ∈ Ioo 0 f.R) : smooth_bump_function I c :=
⟨⟨⟨r, f.R, hr.1, hr.2⟩⟩, f.closed_ball_subset⟩

@[simp] lemma update_r_R {r : ℝ} (hr : r ∈ Ioo 0 f.R) : (f.update_r r hr).R = f.R := rfl

@[simp] lemma update_r_r {r : ℝ} (hr : r ∈ Ioo 0 f.R) : (f.update_r r hr).r = r := rfl

@[simp] lemma support_update_r {r : ℝ} (hr : r ∈ Ioo 0 f.R) :
  support (f.update_r r hr) = support f :=
by simp only [support_eq_inter_preimage, update_r_R]

instance : inhabited (smooth_bump_function I c) :=
classical.inhabited_of_nonempty nhds_within_range_basis.nonempty

variables [t2_space M]

lemma closed_symm_image_closed_ball :
  is_closed ((ext_chart_at I c).symm '' (closed_ball (ext_chart_at I c c) f.R ∩ range I)) :=
f.compact_symm_image_closed_ball.is_closed

lemma tsupport_subset_symm_image_closed_ball :
  tsupport f ⊆ (ext_chart_at I c).symm '' (closed_ball (ext_chart_at I c c) f.R ∩ range I) :=
begin
  rw [tsupport, support_eq_symm_image],
  exact closure_minimal (image_subset _ $ inter_subset_inter_left _ ball_subset_closed_ball)
    f.closed_symm_image_closed_ball
end

lemma tsupport_subset_ext_chart_at_source :
  tsupport f ⊆ (ext_chart_at I c).source :=
calc tsupport f
    ⊆ (ext_chart_at I c).symm '' (closed_ball (ext_chart_at I c c) f.R ∩ range I) :
  f.tsupport_subset_symm_image_closed_ball
... ⊆ (ext_chart_at I c).symm '' (ext_chart_at I c).target :
  image_subset _ f.closed_ball_subset
... = (ext_chart_at I c).source :
  (ext_chart_at I c).symm_image_target_eq_source

lemma tsupport_subset_chart_at_source :
  tsupport f ⊆ (chart_at H c).source :=
by simpa only [ext_chart_at_source] using f.tsupport_subset_ext_chart_at_source

protected lemma has_compact_support : has_compact_support f :=
compact_of_is_closed_subset f.compact_symm_image_closed_ball is_closed_closure
 f.tsupport_subset_symm_image_closed_ball

variables (I c)

/-- The closures of supports of smooth bump functions centered at `c` form a basis of `𝓝 c`.
In other words, each of these closures is a neighborhood of `c` and each neighborhood of `c`
includes `tsupport f` for some `f : smooth_bump_function I c`. -/
lemma nhds_basis_tsupport :
  (𝓝 c).has_basis (λ f : smooth_bump_function I c, true) (λ f, tsupport f) :=
begin
  have : (𝓝 c).has_basis (λ f : smooth_bump_function I c, true)
    (λ f, (ext_chart_at I c).symm '' (closed_ball (ext_chart_at I c c) f.R ∩ range I)),
  { rw [← ext_chart_at_symm_map_nhds_within_range I c],
    exact nhds_within_range_basis.map _ },
  refine this.to_has_basis' (λ f hf, ⟨f, trivial, f.tsupport_subset_symm_image_closed_ball⟩)
    (λ f _, f.tsupport_mem_nhds),
end

variable {c}

/-- Given `s ∈ 𝓝 c`, the supports of smooth bump functions `f : smooth_bump_function I c` such that
`tsupport f ⊆ s` form a basis of `𝓝 c`.  In other words, each of these supports is a
neighborhood of `c` and each neighborhood of `c` includes `support f` for some `f :
smooth_bump_function I c` such that `tsupport f ⊆ s`. -/
lemma nhds_basis_support {s : set M} (hs : s ∈ 𝓝 c) :
  (𝓝 c).has_basis (λ f : smooth_bump_function I c, tsupport f ⊆ s) (λ f, support f) :=
((nhds_basis_tsupport I c).restrict_subset hs).to_has_basis'
  (λ f hf, ⟨f, hf.2, subset_closure⟩) (λ f hf, f.support_mem_nhds)

variables [smooth_manifold_with_corners I M] {I}

/-- A smooth bump function is infinitely smooth. -/
protected lemma smooth : smooth I 𝓘(ℝ) f :=
begin
  refine cont_mdiff_of_support (λ x hx, _),
  have : x ∈ (chart_at H c).source := f.tsupport_subset_chart_at_source hx,
  refine cont_mdiff_at.congr_of_eventually_eq _
    (f.eq_on_source.eventually_eq_of_mem $ is_open.mem_nhds (chart_at _ _).open_source this),
  exact f.to_cont_diff_bump.cont_diff_at.cont_mdiff_at.comp _
    (cont_mdiff_at_ext_chart_at' this)
end

protected lemma smooth_at {x} : smooth_at I 𝓘(ℝ) f x := f.smooth.smooth_at

protected lemma continuous : continuous f := f.smooth.continuous

/-- If `f : smooth_bump_function I c` is a smooth bump function and `g : M → G` is a function smooth
on the source of the chart at `c`, then `f • g` is smooth on the whole manifold. -/
lemma smooth_smul {G} [normed_group G] [normed_space ℝ G]
  {g : M → G} (hg : smooth_on I 𝓘(ℝ, G) g (chart_at H c).source) :
  smooth I 𝓘(ℝ, G) (λ x, f x • g x) :=
begin
  apply cont_mdiff_of_support (λ x hx, _),
  have : x ∈ (chart_at H c).source,
  calc x ∈ tsupport (λ x, f x • g x) : hx
     ... ⊆ tsupport f : closure_mono (support_smul_subset_left _ _)
     ... ⊆ (chart_at _ c).source : f.tsupport_subset_chart_at_source,
  exact f.smooth_at.smul ((hg _ this).cont_mdiff_at $
    is_open.mem_nhds (chart_at _ _).open_source this)
end

end smooth_bump_function


/-
Copyright (c) 2019 Zhouhang Zhou. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Zhouhang Zhou, Sébastien Gouëzel, Frédéric Dupuis

! This file was ported from Lean 3 source module analysis.inner_product_space.orthogonal
! leanprover-community/mathlib commit 6e272cd89fa32c72a25dbefd319394c48dce1576
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.DirectSum.Module
import Mathbin.Analysis.Complex.Basic
import Mathbin.Analysis.Convex.Uniform
import Mathbin.Analysis.NormedSpace.Completion
import Mathbin.Analysis.NormedSpace.BoundedLinearMaps
import Mathbin.LinearAlgebra.BilinearForm
import Mathbin.Analysis.InnerProductSpace.Basic

/-!
# Orthogonal complements of submodules

In this file, the `orthogonal` complement of a submodule `K` is defined, and basic API established.
Some of the more subtle results about the orthogonal complement are delayed to
`analysis.inner_product_space.projection`.

## Notation

The orthogonal complement of a submodule `K` is denoted by `Kᗮ`.
-/

variable {𝕜 E F : Type _} [IsROrC 𝕜]

variable [NormedAddCommGroup E] [InnerProductSpace 𝕜 E]

variable [NormedAddCommGroup F] [InnerProductSpace ℝ F]

-- mathport name: «expr⟪ , ⟫»
local notation "⟪" x ", " y "⟫" => @inner 𝕜 _ _ x y

namespace Submodule

variable (K : Submodule 𝕜 E)

/-- The subspace of vectors orthogonal to a given subspace. -/
def orthogonal : Submodule 𝕜 E
    where
  carrier := { v | ∀ u ∈ K, ⟪u, v⟫ = 0 }
  zero_mem' _ _ := inner_zero_right _
  add_mem' x y hx hy u hu := by rw [inner_add_right, hx u hu, hy u hu, add_zero]
  smul_mem' c x hx u hu := by rw [inner_smul_right, hx u hu, MulZeroClass.mul_zero]
#align submodule.orthogonal Submodule.orthogonal

-- mathport name: «expr ᗮ»
notation:1200 K "ᗮ" => orthogonal K

/-- When a vector is in `Kᗮ`. -/
theorem mem_orthogonal (v : E) : v ∈ Kᗮ ↔ ∀ u ∈ K, ⟪u, v⟫ = 0 :=
  Iff.rfl
#align submodule.mem_orthogonal Submodule.mem_orthogonal

/-- When a vector is in `Kᗮ`, with the inner product the
other way round. -/
theorem mem_orthogonal' (v : E) : v ∈ Kᗮ ↔ ∀ u ∈ K, ⟪v, u⟫ = 0 := by
  simp_rw [mem_orthogonal, inner_eq_zero_symm]
#align submodule.mem_orthogonal' Submodule.mem_orthogonal'

variable {K}

/-- A vector in `K` is orthogonal to one in `Kᗮ`. -/
theorem inner_right_of_mem_orthogonal {u v : E} (hu : u ∈ K) (hv : v ∈ Kᗮ) : ⟪u, v⟫ = 0 :=
  (K.mem_orthogonal v).1 hv u hu
#align submodule.inner_right_of_mem_orthogonal Submodule.inner_right_of_mem_orthogonal

/-- A vector in `Kᗮ` is orthogonal to one in `K`. -/
theorem inner_left_of_mem_orthogonal {u v : E} (hu : u ∈ K) (hv : v ∈ Kᗮ) : ⟪v, u⟫ = 0 := by
  rw [inner_eq_zero_symm] <;> exact inner_right_of_mem_orthogonal hu hv
#align submodule.inner_left_of_mem_orthogonal Submodule.inner_left_of_mem_orthogonal

/-- A vector is in `(𝕜 ∙ u)ᗮ` iff it is orthogonal to `u`. -/
theorem mem_orthogonal_singleton_iff_inner_right {u v : E} : v ∈ (𝕜 ∙ u)ᗮ ↔ ⟪u, v⟫ = 0 :=
  by
  refine' ⟨inner_right_of_mem_orthogonal (mem_span_singleton_self u), _⟩
  intro hv w hw
  rw [mem_span_singleton] at hw
  obtain ⟨c, rfl⟩ := hw
  simp [inner_smul_left, hv]
#align submodule.mem_orthogonal_singleton_iff_inner_right Submodule.mem_orthogonal_singleton_iff_inner_right

/-- A vector in `(𝕜 ∙ u)ᗮ` is orthogonal to `u`. -/
theorem mem_orthogonal_singleton_iff_inner_left {u v : E} : v ∈ (𝕜 ∙ u)ᗮ ↔ ⟪v, u⟫ = 0 := by
  rw [mem_orthogonal_singleton_iff_inner_right, inner_eq_zero_symm]
#align submodule.mem_orthogonal_singleton_iff_inner_left Submodule.mem_orthogonal_singleton_iff_inner_left

theorem sub_mem_orthogonal_of_inner_left {x y : E} (h : ∀ v : K, ⟪x, v⟫ = ⟪y, v⟫) : x - y ∈ Kᗮ :=
  by
  rw [mem_orthogonal']
  intro u hu
  rw [inner_sub_left, sub_eq_zero]
  exact h ⟨u, hu⟩
#align submodule.sub_mem_orthogonal_of_inner_left Submodule.sub_mem_orthogonal_of_inner_left

theorem sub_mem_orthogonal_of_inner_right {x y : E} (h : ∀ v : K, ⟪(v : E), x⟫ = ⟪(v : E), y⟫) :
    x - y ∈ Kᗮ := by
  intro u hu
  rw [inner_sub_right, sub_eq_zero]
  exact h ⟨u, hu⟩
#align submodule.sub_mem_orthogonal_of_inner_right Submodule.sub_mem_orthogonal_of_inner_right

variable (K)

/-- `K` and `Kᗮ` have trivial intersection. -/
theorem inf_orthogonal_eq_bot : K ⊓ Kᗮ = ⊥ :=
  by
  rw [eq_bot_iff]
  intro x
  rw [mem_inf]
  exact fun ⟨hx, ho⟩ => inner_self_eq_zero.1 (ho x hx)
#align submodule.inf_orthogonal_eq_bot Submodule.inf_orthogonal_eq_bot

/-- `K` and `Kᗮ` have trivial intersection. -/
theorem orthogonal_disjoint : Disjoint K Kᗮ := by simp [disjoint_iff, K.inf_orthogonal_eq_bot]
#align submodule.orthogonal_disjoint Submodule.orthogonal_disjoint

/-- `Kᗮ` can be characterized as the intersection of the kernels of the operations of
inner product with each of the elements of `K`. -/
theorem orthogonal_eq_inter : Kᗮ = ⨅ v : K, LinearMap.ker (innerSL 𝕜 (v : E)) :=
  by
  apply le_antisymm
  · rw [le_infᵢ_iff]
    rintro ⟨v, hv⟩ w hw
    simpa using hw _ hv
  · intro v hv w hw
    simp only [mem_infi] at hv
    exact hv ⟨w, hw⟩
#align submodule.orthogonal_eq_inter Submodule.orthogonal_eq_inter

/-- The orthogonal complement of any submodule `K` is closed. -/
theorem isClosed_orthogonal : IsClosed (Kᗮ : Set E) :=
  by
  rw [orthogonal_eq_inter K]
  have := fun v : K => ContinuousLinearMap.isClosed_ker (innerSL 𝕜 (v : E))
  convert isClosed_interᵢ this
  simp only [infi_coe]
#align submodule.is_closed_orthogonal Submodule.isClosed_orthogonal

/-- In a complete space, the orthogonal complement of any submodule `K` is complete. -/
instance [CompleteSpace E] : CompleteSpace Kᗮ :=
  K.isClosed_orthogonal.completeSpace_coe

variable (𝕜 E)

/-- `orthogonal` gives a `galois_connection` between
`submodule 𝕜 E` and its `order_dual`. -/
theorem orthogonal_gc :
    @GaloisConnection (Submodule 𝕜 E) (Submodule 𝕜 E)ᵒᵈ _ _ orthogonal orthogonal := fun K₁ K₂ =>
  ⟨fun h v hv u hu => inner_left_of_mem_orthogonal hv (h hu), fun h v hv u hu =>
    inner_left_of_mem_orthogonal hv (h hu)⟩
#align submodule.orthogonal_gc Submodule.orthogonal_gc

variable {𝕜 E}

/-- `orthogonal` reverses the `≤` ordering of two
subspaces. -/
theorem orthogonal_le {K₁ K₂ : Submodule 𝕜 E} (h : K₁ ≤ K₂) : K₂ᗮ ≤ K₁ᗮ :=
  (orthogonal_gc 𝕜 E).monotone_l h
#align submodule.orthogonal_le Submodule.orthogonal_le

/-- `orthogonal.orthogonal` preserves the `≤` ordering of two
subspaces. -/
theorem orthogonal_orthogonal_monotone {K₁ K₂ : Submodule 𝕜 E} (h : K₁ ≤ K₂) : K₁ᗮᗮ ≤ K₂ᗮᗮ :=
  orthogonal_le (orthogonal_le h)
#align submodule.orthogonal_orthogonal_monotone Submodule.orthogonal_orthogonal_monotone

/-- `K` is contained in `Kᗮᗮ`. -/
theorem le_orthogonal_orthogonal : K ≤ Kᗮᗮ :=
  (orthogonal_gc 𝕜 E).le_u_l _
#align submodule.le_orthogonal_orthogonal Submodule.le_orthogonal_orthogonal

/-- The inf of two orthogonal subspaces equals the subspace orthogonal
to the sup. -/
theorem inf_orthogonal (K₁ K₂ : Submodule 𝕜 E) : K₁ᗮ ⊓ K₂ᗮ = (K₁ ⊔ K₂)ᗮ :=
  (orthogonal_gc 𝕜 E).l_sup.symm
#align submodule.inf_orthogonal Submodule.inf_orthogonal

/-- The inf of an indexed family of orthogonal subspaces equals the
subspace orthogonal to the sup. -/
theorem infᵢ_orthogonal {ι : Type _} (K : ι → Submodule 𝕜 E) : (⨅ i, (K i)ᗮ) = (supᵢ K)ᗮ :=
  (orthogonal_gc 𝕜 E).l_supᵢ.symm
#align submodule.infi_orthogonal Submodule.infᵢ_orthogonal

/-- The inf of a set of orthogonal subspaces equals the subspace orthogonal to the sup. -/
theorem Inf_orthogonal (s : Set <| Submodule 𝕜 E) : (⨅ K ∈ s, Kᗮ) = (supₛ s)ᗮ :=
  (orthogonal_gc 𝕜 E).l_supₛ.symm
#align submodule.Inf_orthogonal Submodule.Inf_orthogonal

@[simp]
theorem top_orthogonal_eq_bot : (⊤ : Submodule 𝕜 E)ᗮ = ⊥ :=
  by
  ext
  rw [mem_bot, mem_orthogonal]
  exact
    ⟨fun h => inner_self_eq_zero.mp (h x mem_top),
      by
      rintro rfl
      simp⟩
#align submodule.top_orthogonal_eq_bot Submodule.top_orthogonal_eq_bot

@[simp]
theorem bot_orthogonal_eq_top : (⊥ : Submodule 𝕜 E)ᗮ = ⊤ :=
  by
  rw [← top_orthogonal_eq_bot, eq_top_iff]
  exact le_orthogonal_orthogonal ⊤
#align submodule.bot_orthogonal_eq_top Submodule.bot_orthogonal_eq_top

@[simp]
theorem orthogonal_eq_top_iff : Kᗮ = ⊤ ↔ K = ⊥ :=
  by
  refine'
    ⟨_, by
      rintro rfl
      exact bot_orthogonal_eq_top⟩
  intro h
  have : K ⊓ Kᗮ = ⊥ := K.orthogonal_disjoint.eq_bot
  rwa [h, inf_comm, top_inf_eq] at this
#align submodule.orthogonal_eq_top_iff Submodule.orthogonal_eq_top_iff

theorem orthogonalFamily_self :
    OrthogonalFamily 𝕜 (fun b => ↥(cond b K Kᗮ)) fun b => (cond b K Kᗮ).subtypeₗᵢ
  | tt, tt => absurd rfl
  | tt, ff => fun _ x y => inner_right_of_mem_orthogonal x.Prop y.Prop
  | ff, tt => fun _ x y => inner_left_of_mem_orthogonal y.Prop x.Prop
  | ff, ff => absurd rfl
#align submodule.orthogonal_family_self Submodule.orthogonalFamily_self

end Submodule


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

! This file was ported from Lean 3 source module logic.relation
! 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.Tactic.Basic
import Mathbin.Logic.Relator

/-!
# Relation closures

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

This file defines the reflexive, transitive, and reflexive transitive closures of relations.
It also proves some basic results on definitions in core, such as `eqv_gen`.

Note that this is about unbundled relations, that is terms of types of the form `α → β → Prop`. For
the bundled version, see `rel`.

## Definitions

* `relation.refl_gen`: Reflexive closure. `refl_gen r` relates everything `r` related, plus for all
  `a` it relates `a` with itself. So `refl_gen r a b ↔ r a b ∨ a = b`.
* `relation.trans_gen`: Transitive closure. `trans_gen r` relates everything `r` related
  transitively. So `trans_gen r a b ↔ ∃ x₀ ... xₙ, r a x₀ ∧ r x₀ x₁ ∧ ... ∧ r xₙ b`.
* `relation.refl_trans_gen`: Reflexive transitive closure. `refl_trans_gen r` relates everything
  `r` related transitively, plus for all `a` it relates `a` with itself. So
  `refl_trans_gen r a b ↔ (∃ x₀ ... xₙ, r a x₀ ∧ r x₀ x₁ ∧ ... ∧ r xₙ b) ∨ a = b`. It is the same as
  the reflexive closure of the transitive closure, or the transitive closure of the reflexive
  closure. In terms of rewriting systems, this means that `a` can be rewritten to `b` in a number of
  rewrites.
* `relation.comp`:  Relation composition. We provide notation `∘r`. For `r : α → β → Prop` and
  `s : β → γ → Prop`, `r ∘r s`relates `a : α` and `c : γ` iff there exists `b : β` that's related to
  both.
* `relation.map`: Image of a relation under a pair of maps. For `r : α → β → Prop`, `f : α → γ`,
  `g : β → δ`, `map r f g` is the relation `γ → δ → Prop` relating `f a` and `g b` for all `a`, `b`
  related by `r`.
* `relation.join`: Join of a relation. For `r : α → α → Prop`, `join r a b ↔ ∃ c, r a c ∧ r b c`. In
  terms of rewriting systems, this means that `a` and `b` can be rewritten to the same term.
-/

open Function

variable {α β γ δ : Type _}

section NeImp

variable {r : α → α → Prop}

#print IsRefl.reflexive /-
theorem IsRefl.reflexive [IsRefl α r] : Reflexive r := fun x => IsRefl.refl x
#align is_refl.reflexive IsRefl.reflexive
-/

#print Reflexive.rel_of_ne_imp /-
/-- To show a reflexive relation `r : α → α → Prop` holds over `x y : α`,
it suffices to show it holds when `x ≠ y`. -/
theorem Reflexive.rel_of_ne_imp (h : Reflexive r) {x y : α} (hr : x ≠ y → r x y) : r x y :=
  by
  by_cases hxy : x = y
  · exact hxy ▸ h x
  · exact hr hxy
#align reflexive.rel_of_ne_imp Reflexive.rel_of_ne_imp
-/

#print Reflexive.ne_imp_iff /-
/-- If a reflexive relation `r : α → α → Prop` holds over `x y : α`,
then it holds whether or not `x ≠ y`. -/
theorem Reflexive.ne_imp_iff (h : Reflexive r) {x y : α} : x ≠ y → r x y ↔ r x y :=
  ⟨h.rel_of_ne_imp, fun hr _ => hr⟩
#align reflexive.ne_imp_iff Reflexive.ne_imp_iff
-/

#print reflexive_ne_imp_iff /-
/-- If a reflexive relation `r : α → α → Prop` holds over `x y : α`,
then it holds whether or not `x ≠ y`. Unlike `reflexive.ne_imp_iff`, this uses `[is_refl α r]`. -/
theorem reflexive_ne_imp_iff [IsRefl α r] {x y : α} : x ≠ y → r x y ↔ r x y :=
  IsRefl.reflexive.ne_imp_iff
#align reflexive_ne_imp_iff reflexive_ne_imp_iff
-/

#print Symmetric.iff /-
protected theorem Symmetric.iff (H : Symmetric r) (x y : α) : r x y ↔ r y x :=
  ⟨fun h => H h, fun h => H h⟩
#align symmetric.iff Symmetric.iff
-/

#print Symmetric.flip_eq /-
theorem Symmetric.flip_eq (h : Symmetric r) : flip r = r :=
  funext₂ fun _ _ => propext <| h.Iff _ _
#align symmetric.flip_eq Symmetric.flip_eq
-/

#print Symmetric.swap_eq /-
theorem Symmetric.swap_eq : Symmetric r → swap r = r :=
  Symmetric.flip_eq
#align symmetric.swap_eq Symmetric.swap_eq
-/

#print flip_eq_iff /-
theorem flip_eq_iff : flip r = r ↔ Symmetric r :=
  ⟨fun h x y => (congr_fun₂ h _ _).mp, Symmetric.flip_eq⟩
#align flip_eq_iff flip_eq_iff
-/

#print swap_eq_iff /-
theorem swap_eq_iff : swap r = r ↔ Symmetric r :=
  flip_eq_iff
#align swap_eq_iff swap_eq_iff
-/

end NeImp

section Comap

variable {r : β → β → Prop}

#print Reflexive.comap /-
theorem Reflexive.comap (h : Reflexive r) (f : α → β) : Reflexive (r on f) := fun a => h (f a)
#align reflexive.comap Reflexive.comap
-/

#print Symmetric.comap /-
theorem Symmetric.comap (h : Symmetric r) (f : α → β) : Symmetric (r on f) := fun a b hab => h hab
#align symmetric.comap Symmetric.comap
-/

#print Transitive.comap /-
theorem Transitive.comap (h : Transitive r) (f : α → β) : Transitive (r on f) :=
  fun a b c hab hbc => h hab hbc
#align transitive.comap Transitive.comap
-/

#print Equivalence.comap /-
theorem Equivalence.comap (h : Equivalence r) (f : α → β) : Equivalence (r on f) :=
  ⟨h.1.comap f, h.2.1.comap f, h.2.2.comap f⟩
#align equivalence.comap Equivalence.comap
-/

end Comap

namespace Relation

section Comp

variable {r : α → β → Prop} {p : β → γ → Prop} {q : γ → δ → Prop}

#print Relation.Comp /-
/-- The composition of two relations, yielding a new relation.  The result
relates a term of `α` and a term of `γ` if there is an intermediate
term of `β` related to both.
-/
def Comp (r : α → β → Prop) (p : β → γ → Prop) (a : α) (c : γ) : Prop :=
  ∃ b, r a b ∧ p b c
#align relation.comp Relation.Comp
-/

-- mathport name: «expr ∘r »
local infixr:80 " ∘r " => Relation.Comp

/- warning: relation.comp_eq -> Relation.comp_eq is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {r : α -> β -> Prop}, Eq.{max (succ u1) (succ u2)} (α -> β -> Prop) (Relation.Comp.{u1, u2, u2} α β β r (Eq.{succ u2} β)) r
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} {r : α -> β -> Prop}, Eq.{max (succ u2) (succ u1)} (α -> β -> Prop) (Relation.Comp.{u2, u1, u1} α β β r (fun (x._@.Mathlib.Logic.Relation._hyg.1349 : β) (x._@.Mathlib.Logic.Relation._hyg.1351 : β) => Eq.{succ u1} β x._@.Mathlib.Logic.Relation._hyg.1349 x._@.Mathlib.Logic.Relation._hyg.1351)) r
Case conversion may be inaccurate. Consider using '#align relation.comp_eq Relation.comp_eqₓ'. -/
theorem comp_eq : r ∘r (· = ·) = r :=
  funext fun a =>
    funext fun b => propext <| Iff.intro (fun ⟨c, h, Eq⟩ => Eq ▸ h) fun h => ⟨b, h, rfl⟩
#align relation.comp_eq Relation.comp_eq

/- warning: relation.eq_comp -> Relation.eq_comp is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {r : α -> β -> Prop}, Eq.{max (succ u1) (succ u2)} (α -> β -> Prop) (Relation.Comp.{u1, u1, u2} α α β (Eq.{succ u1} α) r) r
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} {r : α -> β -> Prop}, Eq.{max (succ u2) (succ u1)} (α -> β -> Prop) (Relation.Comp.{u2, u2, u1} α α β (fun (x._@.Mathlib.Logic.Relation._hyg.1448 : α) (x._@.Mathlib.Logic.Relation._hyg.1450 : α) => Eq.{succ u2} α x._@.Mathlib.Logic.Relation._hyg.1448 x._@.Mathlib.Logic.Relation._hyg.1450) r) r
Case conversion may be inaccurate. Consider using '#align relation.eq_comp Relation.eq_compₓ'. -/
theorem eq_comp : (· = ·) ∘r r = r :=
  funext fun a =>
    funext fun b => propext <| Iff.intro (fun ⟨c, Eq, h⟩ => Eq.symm ▸ h) fun h => ⟨a, rfl, h⟩
#align relation.eq_comp Relation.eq_comp

#print Relation.iff_comp /-
theorem iff_comp {r : Prop → α → Prop} : (· ↔ ·) ∘r r = r :=
  by
  have : (· ↔ ·) = (· = ·) := by funext a b <;> exact iff_eq_eq
  rw [this, eq_comp]
#align relation.iff_comp Relation.iff_comp
-/

#print Relation.comp_iff /-
theorem comp_iff {r : α → Prop → Prop} : r ∘r (· ↔ ·) = r :=
  by
  have : (· ↔ ·) = (· = ·) := by funext a b <;> exact iff_eq_eq
  rw [this, comp_eq]
#align relation.comp_iff Relation.comp_iff
-/

/- warning: relation.comp_assoc -> Relation.comp_assoc is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {γ : Type.{u3}} {δ : Type.{u4}} {r : α -> β -> Prop} {p : β -> γ -> Prop} {q : γ -> δ -> Prop}, Eq.{max (succ u1) (succ u4)} (α -> δ -> Prop) (Relation.Comp.{u1, u3, u4} α γ δ (Relation.Comp.{u1, u2, u3} α β γ r p) q) (Relation.Comp.{u1, u2, u4} α β δ r (Relation.Comp.{u2, u3, u4} β γ δ p q))
but is expected to have type
  forall {α : Type.{u4}} {β : Type.{u1}} {γ : Type.{u2}} {δ : Type.{u3}} {r : α -> β -> Prop} {p : β -> γ -> Prop} {q : γ -> δ -> Prop}, Eq.{max (succ u4) (succ u3)} (α -> δ -> Prop) (Relation.Comp.{u4, u2, u3} α γ δ (Relation.Comp.{u4, u1, u2} α β γ r p) q) (Relation.Comp.{u4, u1, u3} α β δ r (Relation.Comp.{u1, u2, u3} β γ δ p q))
Case conversion may be inaccurate. Consider using '#align relation.comp_assoc Relation.comp_assocₓ'. -/
theorem comp_assoc : (r ∘r p) ∘r q = r ∘r p ∘r q :=
  by
  funext a d; apply propext
  constructor
  exact fun ⟨c, ⟨b, hab, hbc⟩, hcd⟩ => ⟨b, hab, c, hbc, hcd⟩
  exact fun ⟨b, hab, c, hbc, hcd⟩ => ⟨c, ⟨b, hab, hbc⟩, hcd⟩
#align relation.comp_assoc Relation.comp_assoc

/- warning: relation.flip_comp -> Relation.flip_comp is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {γ : Type.{u3}} {r : α -> β -> Prop} {p : β -> γ -> Prop}, Eq.{max (succ u3) (succ u1)} (γ -> α -> Prop) (flip.{succ u1, succ u3, 1} α γ Prop (Relation.Comp.{u1, u2, u3} α β γ r p)) (Relation.Comp.{u3, u2, u1} γ β α (flip.{succ u2, succ u3, 1} β γ Prop p) (flip.{succ u1, succ u2, 1} α β Prop r))
but is expected to have type
  forall {α : Type.{u3}} {β : Type.{u1}} {γ : Type.{u2}} {r : α -> β -> Prop} {p : β -> γ -> Prop}, Eq.{max (succ u3) (succ u2)} (γ -> α -> Prop) (flip.{succ u3, succ u2, 1} α γ Prop (Relation.Comp.{u3, u1, u2} α β γ r p)) (Relation.Comp.{u2, u1, u3} γ β α (flip.{succ u1, succ u2, 1} β γ Prop p) (flip.{succ u3, succ u1, 1} α β Prop r))
Case conversion may be inaccurate. Consider using '#align relation.flip_comp Relation.flip_compₓ'. -/
theorem flip_comp : flip (r ∘r p) = flip p ∘r flip r :=
  by
  funext c a; apply propext
  constructor
  exact fun ⟨b, hab, hbc⟩ => ⟨b, hbc, hab⟩
  exact fun ⟨b, hbc, hab⟩ => ⟨b, hab, hbc⟩
#align relation.flip_comp Relation.flip_comp

end Comp

section Fibration

variable (rα : α → α → Prop) (rβ : β → β → Prop) (f : α → β)

#print Relation.Fibration /-
/-- A function `f : α → β` is a fibration between the relation `rα` and `rβ` if for all
  `a : α` and `b : β`, whenever `b : β` and `f a` are related by `rβ`, `b` is the image
  of some `a' : α` under `f`, and `a'` and `a` are related by `rα`. -/
def Fibration :=
  ∀ ⦃a b⦄, rβ b (f a) → ∃ a', rα a' a ∧ f a' = b
#align relation.fibration Relation.Fibration
-/

variable {rα rβ}

/- warning: acc.of_fibration -> Acc.of_fibration is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {rα : α -> α -> Prop} {rβ : β -> β -> Prop} (f : α -> β), (Relation.Fibration.{u1, u2} α β rα rβ f) -> (forall {a : α}, (Acc.{succ u1} α rα a) -> (Acc.{succ u2} β rβ (f a)))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} {rα : α -> α -> Prop} {rβ : β -> β -> Prop} (f : α -> β), (Relation.Fibration.{u2, u1} α β rα rβ f) -> (forall {a : α}, (Acc.{succ u2} α rα a) -> (Acc.{succ u1} β rβ (f a)))
Case conversion may be inaccurate. Consider using '#align acc.of_fibration Acc.of_fibrationₓ'. -/
/-- If `f : α → β` is a fibration between relations `rα` and `rβ`, and `a : α` is
  accessible under `rα`, then `f a` is accessible under `rβ`. -/
theorem Acc.of_fibration (fib : Fibration rα rβ f) {a} (ha : Acc rα a) : Acc rβ (f a) :=
  by
  induction' ha with a ha ih
  refine' Acc.intro (f a) fun b hr => _
  obtain ⟨a', hr', rfl⟩ := fib hr
  exact ih a' hr'
#align acc.of_fibration Acc.of_fibration

/- warning: acc.of_downward_closed -> Acc.of_downward_closed is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {rβ : β -> β -> Prop} (f : α -> β), (forall {a : α} {b : β}, (rβ b (f a)) -> (Exists.{succ u1} α (fun (c : α) => Eq.{succ u2} β (f c) b))) -> (forall (a : α), (Acc.{succ u1} α (InvImage.{succ u1, succ u2} α β rβ f) a) -> (Acc.{succ u2} β rβ (f a)))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} {rβ : β -> β -> Prop} (f : α -> β), (forall {a : α} {b : β}, (rβ b (f a)) -> (Exists.{succ u2} α (fun (c : α) => Eq.{succ u1} β (f c) b))) -> (forall (a : α), (Acc.{succ u2} α (InvImage.{succ u2, succ u1} α β rβ f) a) -> (Acc.{succ u1} β rβ (f a)))
Case conversion may be inaccurate. Consider using '#align acc.of_downward_closed Acc.of_downward_closedₓ'. -/
theorem Acc.of_downward_closed (dc : ∀ {a b}, rβ b (f a) → ∃ c, f c = b) (a : α)
    (ha : Acc (InvImage rβ f) a) : Acc rβ (f a) :=
  ha.of_fibration f fun a b h =>
    let ⟨a', he⟩ := dc h
    ⟨a', he.substr h, he⟩
#align acc.of_downward_closed Acc.of_downward_closed

end Fibration

#print Relation.Map /-
/-- The map of a relation `r` through a pair of functions pushes the
relation to the codomains of the functions.  The resulting relation is
defined by having pairs of terms related if they have preimages
related by `r`.
-/
protected def Map (r : α → β → Prop) (f : α → γ) (g : β → δ) : γ → δ → Prop := fun c d =>
  ∃ a b, r a b ∧ f a = c ∧ g b = d
#align relation.map Relation.Map
-/

variable {r : α → α → Prop} {a b c d : α}

#print Relation.ReflTransGen /-
/-- `refl_trans_gen r`: reflexive transitive closure of `r` -/
@[mk_iff Relation.ReflTransGen.cases_tail_iff]
inductive ReflTransGen (r : α → α → Prop) (a : α) : α → Prop
  | refl : refl_trans_gen a
  | tail {b c} : refl_trans_gen b → r b c → refl_trans_gen c
#align relation.refl_trans_gen Relation.ReflTransGen
-/

attribute [refl] refl_trans_gen.refl

#print Relation.ReflGen /-
/-- `refl_gen r`: reflexive closure of `r` -/
@[mk_iff]
inductive ReflGen (r : α → α → Prop) (a : α) : α → Prop
  | refl : refl_gen a
  | single {b} : r a b → refl_gen b
#align relation.refl_gen Relation.ReflGen
-/

#print Relation.TransGen /-
/-- `trans_gen r`: transitive closure of `r` -/
@[mk_iff]
inductive TransGen (r : α → α → Prop) (a : α) : α → Prop
  | single {b} : r a b → trans_gen b
  | tail {b c} : trans_gen b → r b c → trans_gen c
#align relation.trans_gen Relation.TransGen
-/

attribute [refl] refl_gen.refl

namespace ReflGen

#print Relation.ReflGen.to_reflTransGen /-
theorem to_reflTransGen : ∀ {a b}, ReflGen r a b → ReflTransGen r a b
  | a, _, refl => by rfl
  | a, b, single h => ReflTransGen.tail ReflTransGen.refl h
#align relation.refl_gen.to_refl_trans_gen Relation.ReflGen.to_reflTransGen
-/

#print Relation.ReflGen.mono /-
theorem mono {p : α → α → Prop} (hp : ∀ a b, r a b → p a b) : ∀ {a b}, ReflGen r a b → ReflGen p a b
  | a, _, refl_gen.refl => by rfl
  | a, b, single h => single (hp a b h)
#align relation.refl_gen.mono Relation.ReflGen.mono
-/

instance : IsRefl α (ReflGen r) :=
  ⟨@refl α r⟩

end ReflGen

namespace ReflTransGen

#print Relation.ReflTransGen.trans /-
@[trans]
theorem trans (hab : ReflTransGen r a b) (hbc : ReflTransGen r b c) : ReflTransGen r a c :=
  by
  induction hbc
  case refl => assumption
  case tail c d hbc hcd hac => exact hac.tail hcd
#align relation.refl_trans_gen.trans Relation.ReflTransGen.trans
-/

#print Relation.ReflTransGen.single /-
theorem single (hab : r a b) : ReflTransGen r a b :=
  refl.tail hab
#align relation.refl_trans_gen.single Relation.ReflTransGen.single
-/

#print Relation.ReflTransGen.head /-
theorem head (hab : r a b) (hbc : ReflTransGen r b c) : ReflTransGen r a c :=
  by
  induction hbc
  case refl => exact refl.tail hab
  case tail c d hbc hcd hac => exact hac.tail hcd
#align relation.refl_trans_gen.head Relation.ReflTransGen.head
-/

#print Relation.ReflTransGen.symmetric /-
theorem symmetric (h : Symmetric r) : Symmetric (ReflTransGen r) :=
  by
  intro x y h
  induction' h with z w a b c
  · rfl
  · apply Relation.ReflTransGen.head (h b) c
#align relation.refl_trans_gen.symmetric Relation.ReflTransGen.symmetric
-/

#print Relation.ReflTransGen.cases_tail /-
theorem cases_tail : ReflTransGen r a b → b = a ∨ ∃ c, ReflTransGen r a c ∧ r c b :=
  (cases_tail_iff r a b).1
#align relation.refl_trans_gen.cases_tail Relation.ReflTransGen.cases_tail
-/

#print Relation.ReflTransGen.head_induction_on /-
@[elab_as_elim]
theorem head_induction_on {P : ∀ a : α, ReflTransGen r a b → Prop} {a : α} (h : ReflTransGen r a b)
    (refl : P b refl)
    (head : ∀ {a c} (h' : r a c) (h : ReflTransGen r c b), P c h → P a (h.headI h')) : P a h :=
  by
  induction h generalizing P
  case refl => exact refl
  case tail b c hab hbc ih =>
    apply ih
    show P b _; exact head hbc _ refl
    show ∀ a a', r a a' → refl_trans_gen r a' b → P a' _ → P a _
    exact fun a a' hab hbc => head hab _
#align relation.refl_trans_gen.head_induction_on Relation.ReflTransGen.head_induction_on
-/

#print Relation.ReflTransGen.trans_induction_on /-
@[elab_as_elim]
theorem trans_induction_on {P : ∀ {a b : α}, ReflTransGen r a b → Prop} {a b : α}
    (h : ReflTransGen r a b) (ih₁ : ∀ a, @P a a refl) (ih₂ : ∀ {a b} (h : r a b), P (single h))
    (ih₃ :
      ∀ {a b c} (h₁ : ReflTransGen r a b) (h₂ : ReflTransGen r b c),
        P h₁ → P h₂ → P (h₁.trans h₂)) :
    P h := by
  induction h
  case refl => exact ih₁ a
  case tail b c hab hbc ih => exact ih₃ hab (single hbc) ih (ih₂ hbc)
#align relation.refl_trans_gen.trans_induction_on Relation.ReflTransGen.trans_induction_on
-/

#print Relation.ReflTransGen.cases_head /-
theorem cases_head (h : ReflTransGen r a b) : a = b ∨ ∃ c, r a c ∧ ReflTransGen r c b :=
  by
  induction h using Relation.ReflTransGen.head_induction_on
  · left
    rfl
  · right
    exists _
    constructor <;> assumption
#align relation.refl_trans_gen.cases_head Relation.ReflTransGen.cases_head
-/

#print Relation.ReflTransGen.cases_head_iff /-
theorem cases_head_iff : ReflTransGen r a b ↔ a = b ∨ ∃ c, r a c ∧ ReflTransGen r c b :=
  by
  use cases_head
  rintro (rfl | ⟨c, hac, hcb⟩)
  · rfl
  · exact head hac hcb
#align relation.refl_trans_gen.cases_head_iff Relation.ReflTransGen.cases_head_iff
-/

#print Relation.ReflTransGen.total_of_right_unique /-
theorem total_of_right_unique (U : Relator.RightUnique r) (ab : ReflTransGen r a b)
    (ac : ReflTransGen r a c) : ReflTransGen r b c ∨ ReflTransGen r c b :=
  by
  induction' ab with b d ab bd IH
  · exact Or.inl ac
  · rcases IH with (IH | IH)
    · rcases cases_head IH with (rfl | ⟨e, be, ec⟩)
      · exact Or.inr (single bd)
      · cases U bd be
        exact Or.inl ec
    · exact Or.inr (IH.tail bd)
#align relation.refl_trans_gen.total_of_right_unique Relation.ReflTransGen.total_of_right_unique
-/

end ReflTransGen

namespace TransGen

#print Relation.TransGen.to_reflTransGen /-
theorem to_reflTransGen {a b} (h : TransGen r a b) : ReflTransGen r a b :=
  by
  induction' h with b h b c _ bc ab
  exact refl_trans_gen.single h
  exact refl_trans_gen.tail ab bc
#align relation.trans_gen.to_refl Relation.TransGen.to_reflTransGen
-/

#print Relation.TransGen.trans_left /-
@[trans]
theorem trans_left (hab : TransGen r a b) (hbc : ReflTransGen r b c) : TransGen r a c :=
  by
  induction hbc
  case refl => assumption
  case tail c d hbc hcd hac => exact hac.tail hcd
#align relation.trans_gen.trans_left Relation.TransGen.trans_left
-/

#print Relation.TransGen.trans /-
@[trans]
theorem trans (hab : TransGen r a b) (hbc : TransGen r b c) : TransGen r a c :=
  trans_left hab hbc.to_reflTransGen
#align relation.trans_gen.trans Relation.TransGen.trans
-/

#print Relation.TransGen.head' /-
theorem head' (hab : r a b) (hbc : ReflTransGen r b c) : TransGen r a c :=
  trans_left (single hab) hbc
#align relation.trans_gen.head' Relation.TransGen.head'
-/

#print Relation.TransGen.tail' /-
theorem tail' (hab : ReflTransGen r a b) (hbc : r b c) : TransGen r a c :=
  by
  induction hab generalizing c
  case refl c hac => exact single hac
  case tail d b hab hdb IH => exact tail (IH hdb) hbc
#align relation.trans_gen.tail' Relation.TransGen.tail'
-/

#print Relation.TransGen.head /-
theorem head (hab : r a b) (hbc : TransGen r b c) : TransGen r a c :=
  head' hab hbc.to_reflTransGen
#align relation.trans_gen.head Relation.TransGen.head
-/

#print Relation.TransGen.head_induction_on /-
@[elab_as_elim]
theorem head_induction_on {P : ∀ a : α, TransGen r a b → Prop} {a : α} (h : TransGen r a b)
    (base : ∀ {a} (h : r a b), P a (single h))
    (ih : ∀ {a c} (h' : r a c) (h : TransGen r c b), P c h → P a (h.headI h')) : P a h :=
  by
  induction h generalizing P
  case single a h => exact base h
  case tail b c hab hbc h_ih =>
    apply h_ih
    show ∀ a, r a b → P a _; exact fun a h => ih h (single hbc) (base hbc)
    show ∀ a a', r a a' → trans_gen r a' b → P a' _ → P a _; exact fun a a' hab hbc => ih hab _
#align relation.trans_gen.head_induction_on Relation.TransGen.head_induction_on
-/

#print Relation.TransGen.trans_induction_on /-
@[elab_as_elim]
theorem trans_induction_on {P : ∀ {a b : α}, TransGen r a b → Prop} {a b : α} (h : TransGen r a b)
    (base : ∀ {a b} (h : r a b), P (single h))
    (ih : ∀ {a b c} (h₁ : TransGen r a b) (h₂ : TransGen r b c), P h₁ → P h₂ → P (h₁.trans h₂)) :
    P h := by
  induction h
  case single a h => exact base h
  case tail b c hab hbc h_ih => exact ih hab (single hbc) h_ih (base hbc)
#align relation.trans_gen.trans_induction_on Relation.TransGen.trans_induction_on
-/

#print Relation.TransGen.trans_right /-
@[trans]
theorem trans_right (hab : ReflTransGen r a b) (hbc : TransGen r b c) : TransGen r a c :=
  by
  induction hbc
  case single c hbc => exact tail' hab hbc
  case tail c d hbc hcd hac => exact hac.tail hcd
#align relation.trans_gen.trans_right Relation.TransGen.trans_right
-/

#print Relation.TransGen.tail'_iff /-
theorem tail'_iff : TransGen r a c ↔ ∃ b, ReflTransGen r a b ∧ r b c :=
  by
  refine' ⟨fun h => _, fun ⟨b, hab, hbc⟩ => tail' hab hbc⟩
  cases' h with _ hac b _ hab hbc
  · exact ⟨_, by rfl, hac⟩
  · exact ⟨_, hab.to_refl, hbc⟩
#align relation.trans_gen.tail'_iff Relation.TransGen.tail'_iff
-/

#print Relation.TransGen.head'_iff /-
theorem head'_iff : TransGen r a c ↔ ∃ b, r a b ∧ ReflTransGen r b c :=
  by
  refine' ⟨fun h => _, fun ⟨b, hab, hbc⟩ => head' hab hbc⟩
  induction h
  case single c hac => exact ⟨_, hac, by rfl⟩
  case tail b c hab hbc IH => rcases IH with ⟨d, had, hdb⟩; exact ⟨_, had, hdb.tail hbc⟩
#align relation.trans_gen.head'_iff Relation.TransGen.head'_iff
-/

end TransGen

#print Acc.TransGen /-
theorem Acc.TransGen (h : Acc r a) : Acc (TransGen r) a :=
  by
  induction' h with x _ H
  refine' Acc.intro x fun y hy => _
  cases' hy with _ hyx z _ hyz hzx
  exacts[H y hyx, (H z hzx).inv hyz]
#align acc.trans_gen Acc.TransGen
-/

#print acc_transGen_iff /-
theorem acc_transGen_iff : Acc (TransGen r) a ↔ Acc r a :=
  ⟨Subrelation.accessible fun _ _ => TransGen.single, Acc.TransGen⟩
#align acc_trans_gen_iff acc_transGen_iff
-/

#print WellFounded.transGen /-
theorem WellFounded.transGen (h : WellFounded r) : WellFounded (TransGen r) :=
  ⟨fun a => (h.apply a).TransGen⟩
#align well_founded.trans_gen WellFounded.transGen
-/

section TransGen

#print Relation.transGen_eq_self /-
theorem transGen_eq_self (trans : Transitive r) : TransGen r = r :=
  funext fun a =>
    funext fun b =>
      propext <|
        ⟨fun h => by
          induction h
          case single c hc => exact hc
          case tail c d hac hcd hac => exact trans hac hcd, TransGen.single⟩
#align relation.trans_gen_eq_self Relation.transGen_eq_self
-/

#print Relation.transitive_transGen /-
theorem transitive_transGen : Transitive (TransGen r) := fun a b c => TransGen.trans
#align relation.transitive_trans_gen Relation.transitive_transGen
-/

instance : IsTrans α (TransGen r) :=
  ⟨@TransGen.trans α r⟩

#print Relation.transGen_idem /-
theorem transGen_idem : TransGen (TransGen r) = TransGen r :=
  transGen_eq_self transitive_transGen
#align relation.trans_gen_idem Relation.transGen_idem
-/

/- warning: relation.trans_gen.lift -> Relation.TransGen.lift is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {r : α -> α -> Prop} {p : β -> β -> Prop} {a : α} {b : α} (f : α -> β), (forall (a : α) (b : α), (r a b) -> (p (f a) (f b))) -> (Relation.TransGen.{u1} α r a b) -> (Relation.TransGen.{u2} β p (f a) (f b))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} {r : α -> α -> Prop} {p : β -> β -> Prop} {a : α} {b : α} (f : α -> β), (forall (a : α) (b : α), (r a b) -> (p (f a) (f b))) -> (Relation.TransGen.{u2} α r a b) -> (Relation.TransGen.{u1} β p (f a) (f b))
Case conversion may be inaccurate. Consider using '#align relation.trans_gen.lift Relation.TransGen.liftₓ'. -/
theorem TransGen.lift {p : β → β → Prop} {a b : α} (f : α → β) (h : ∀ a b, r a b → p (f a) (f b))
    (hab : TransGen r a b) : TransGen p (f a) (f b) :=
  by
  induction hab
  case single c hac => exact trans_gen.single (h a c hac)
  case tail c d hac hcd hac => exact trans_gen.tail hac (h c d hcd)
#align relation.trans_gen.lift Relation.TransGen.lift

#print Relation.TransGen.lift' /-
theorem TransGen.lift' {p : β → β → Prop} {a b : α} (f : α → β)
    (h : ∀ a b, r a b → TransGen p (f a) (f b)) (hab : TransGen r a b) : TransGen p (f a) (f b) :=
  by simpa [trans_gen_idem] using hab.lift f h
#align relation.trans_gen.lift' Relation.TransGen.lift'
-/

#print Relation.TransGen.closed /-
theorem TransGen.closed {p : α → α → Prop} :
    (∀ a b, r a b → TransGen p a b) → TransGen r a b → TransGen p a b :=
  TransGen.lift' id
#align relation.trans_gen.closed Relation.TransGen.closed
-/

#print Relation.TransGen.mono /-
theorem TransGen.mono {p : α → α → Prop} :
    (∀ a b, r a b → p a b) → TransGen r a b → TransGen p a b :=
  TransGen.lift id
#align relation.trans_gen.mono Relation.TransGen.mono
-/

#print Relation.TransGen.swap /-
theorem TransGen.swap (h : TransGen r b a) : TransGen (swap r) a b :=
  by
  induction' h with b h b c hab hbc ih
  · exact trans_gen.single h
  exact ih.head hbc
#align relation.trans_gen.swap Relation.TransGen.swap
-/

#print Relation.transGen_swap /-
theorem transGen_swap : TransGen (swap r) a b ↔ TransGen r b a :=
  ⟨TransGen.swap, TransGen.swap⟩
#align relation.trans_gen_swap Relation.transGen_swap
-/

end TransGen

section ReflTransGen

open ReflTransGen

#print Relation.reflTransGen_iff_eq /-
theorem reflTransGen_iff_eq (h : ∀ b, ¬r a b) : ReflTransGen r a b ↔ b = a := by
  rw [cases_head_iff] <;> simp [h, eq_comm]
#align relation.refl_trans_gen_iff_eq Relation.reflTransGen_iff_eq
-/

#print Relation.reflTransGen_iff_eq_or_transGen /-
theorem reflTransGen_iff_eq_or_transGen : ReflTransGen r a b ↔ b = a ∨ TransGen r a b :=
  by
  refine' ⟨fun h => _, fun h => _⟩
  · cases' h with c _ hac hcb
    · exact Or.inl rfl
    · exact Or.inr (trans_gen.tail' hac hcb)
  · rcases h with (rfl | h)
    · rfl
    · exact h.to_refl
#align relation.refl_trans_gen_iff_eq_or_trans_gen Relation.reflTransGen_iff_eq_or_transGen
-/

/- warning: relation.refl_trans_gen.lift -> Relation.ReflTransGen.lift is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {r : α -> α -> Prop} {p : β -> β -> Prop} {a : α} {b : α} (f : α -> β), (forall (a : α) (b : α), (r a b) -> (p (f a) (f b))) -> (Relation.ReflTransGen.{u1} α r a b) -> (Relation.ReflTransGen.{u2} β p (f a) (f b))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} {r : α -> α -> Prop} {p : β -> β -> Prop} {a : α} {b : α} (f : α -> β), (forall (a : α) (b : α), (r a b) -> (p (f a) (f b))) -> (Relation.ReflTransGen.{u2} α r a b) -> (Relation.ReflTransGen.{u1} β p (f a) (f b))
Case conversion may be inaccurate. Consider using '#align relation.refl_trans_gen.lift Relation.ReflTransGen.liftₓ'. -/
theorem ReflTransGen.lift {p : β → β → Prop} {a b : α} (f : α → β)
    (h : ∀ a b, r a b → p (f a) (f b)) (hab : ReflTransGen r a b) : ReflTransGen p (f a) (f b) :=
  ReflTransGen.trans_induction_on hab (fun a => refl) (fun a b => ReflTransGen.single ∘ h _ _)
    fun a b c _ _ => trans
#align relation.refl_trans_gen.lift Relation.ReflTransGen.lift

#print Relation.ReflTransGen.mono /-
theorem ReflTransGen.mono {p : α → α → Prop} :
    (∀ a b, r a b → p a b) → ReflTransGen r a b → ReflTransGen p a b :=
  ReflTransGen.lift id
#align relation.refl_trans_gen.mono Relation.ReflTransGen.mono
-/

#print Relation.reflTransGen_eq_self /-
theorem reflTransGen_eq_self (refl : Reflexive r) (trans : Transitive r) : ReflTransGen r = r :=
  funext fun a =>
    funext fun b =>
      propext <|
        ⟨fun h => by
          induction' h with b c h₁ h₂ IH; · apply refl
          exact trans IH h₂, single⟩
#align relation.refl_trans_gen_eq_self Relation.reflTransGen_eq_self
-/

#print Relation.reflexive_reflTransGen /-
theorem reflexive_reflTransGen : Reflexive (ReflTransGen r) := fun a => refl
#align relation.reflexive_refl_trans_gen Relation.reflexive_reflTransGen
-/

#print Relation.transitive_reflTransGen /-
theorem transitive_reflTransGen : Transitive (ReflTransGen r) := fun a b c => trans
#align relation.transitive_refl_trans_gen Relation.transitive_reflTransGen
-/

instance : IsRefl α (ReflTransGen r) :=
  ⟨@ReflTransGen.refl α r⟩

instance : IsTrans α (ReflTransGen r) :=
  ⟨@ReflTransGen.trans α r⟩

#print Relation.refl_trans_gen_idem /-
theorem refl_trans_gen_idem : ReflTransGen (ReflTransGen r) = ReflTransGen r :=
  reflTransGen_eq_self reflexive_reflTransGen transitive_reflTransGen
#align relation.refl_trans_gen_idem Relation.refl_trans_gen_idem
-/

#print Relation.ReflTransGen.lift' /-
theorem ReflTransGen.lift' {p : β → β → Prop} {a b : α} (f : α → β)
    (h : ∀ a b, r a b → ReflTransGen p (f a) (f b)) (hab : ReflTransGen r a b) :
    ReflTransGen p (f a) (f b) := by simpa [refl_trans_gen_idem] using hab.lift f h
#align relation.refl_trans_gen.lift' Relation.ReflTransGen.lift'
-/

#print Relation.reflTransGen_closed /-
theorem reflTransGen_closed {p : α → α → Prop} :
    (∀ a b, r a b → ReflTransGen p a b) → ReflTransGen r a b → ReflTransGen p a b :=
  ReflTransGen.lift' id
#align relation.refl_trans_gen_closed Relation.reflTransGen_closed
-/

#print Relation.ReflTransGen.swap /-
theorem ReflTransGen.swap (h : ReflTransGen r b a) : ReflTransGen (swap r) a b :=
  by
  induction' h with b c hab hbc ih
  · rfl
  exact ih.head hbc
#align relation.refl_trans_gen.swap Relation.ReflTransGen.swap
-/

#print Relation.reflTransGen_swap /-
theorem reflTransGen_swap : ReflTransGen (swap r) a b ↔ ReflTransGen r b a :=
  ⟨ReflTransGen.swap, ReflTransGen.swap⟩
#align relation.refl_trans_gen_swap Relation.reflTransGen_swap
-/

end ReflTransGen

#print Relation.Join /-
/-- The join of a relation on a single type is a new relation for which
pairs of terms are related if there is a third term they are both
related to.  For example, if `r` is a relation representing rewrites
in a term rewriting system, then *confluence* is the property that if
`a` rewrites to both `b` and `c`, then `join r` relates `b` and `c`
(see `relation.church_rosser`).
-/
def Join (r : α → α → Prop) : α → α → Prop := fun a b => ∃ c, r a c ∧ r b c
#align relation.join Relation.Join
-/

section Join

open ReflTransGen ReflGen

#print Relation.church_rosser /-
/-- A sufficient condition for the Church-Rosser property. -/
theorem church_rosser (h : ∀ a b c, r a b → r a c → ∃ d, ReflGen r b d ∧ ReflTransGen r c d)
    (hab : ReflTransGen r a b) (hac : ReflTransGen r a c) : Join (ReflTransGen r) b c :=
  by
  induction hab
  case refl => exact ⟨c, hac, refl⟩
  case tail d e had hde ih =>
    clear hac had a
    rcases ih with ⟨b, hdb, hcb⟩
    have : ∃ a, refl_trans_gen r e a ∧ refl_gen r b a :=
      by
      clear hcb
      induction hdb
      case refl => exact ⟨e, refl, refl_gen.single hde⟩
      case tail f b hdf hfb ih =>
        rcases ih with ⟨a, hea, hfa⟩
        cases' hfa with _ hfa
        · exact ⟨b, hea.tail hfb, refl_gen.refl⟩
        · rcases h _ _ _ hfb hfa with ⟨c, hbc, hac⟩
          exact ⟨c, hea.trans hac, hbc⟩
    rcases this with ⟨a, hea, hba⟩
    cases' hba with _ hba
    · exact ⟨b, hea, hcb⟩
    · exact ⟨a, hea, hcb.tail hba⟩
#align relation.church_rosser Relation.church_rosser
-/

#print Relation.join_of_single /-
theorem join_of_single (h : Reflexive r) (hab : r a b) : Join r a b :=
  ⟨b, hab, h b⟩
#align relation.join_of_single Relation.join_of_single
-/

#print Relation.symmetric_join /-
theorem symmetric_join : Symmetric (Join r) := fun a b ⟨c, hac, hcb⟩ => ⟨c, hcb, hac⟩
#align relation.symmetric_join Relation.symmetric_join
-/

#print Relation.reflexive_join /-
theorem reflexive_join (h : Reflexive r) : Reflexive (Join r) := fun a => ⟨a, h a, h a⟩
#align relation.reflexive_join Relation.reflexive_join
-/

#print Relation.transitive_join /-
theorem transitive_join (ht : Transitive r) (h : ∀ a b c, r a b → r a c → Join r b c) :
    Transitive (Join r) := fun a b c ⟨x, hax, hbx⟩ ⟨y, hby, hcy⟩ =>
  let ⟨z, hxz, hyz⟩ := h b x y hbx hby
  ⟨z, ht hax hxz, ht hcy hyz⟩
#align relation.transitive_join Relation.transitive_join
-/

#print Relation.equivalence_join /-
theorem equivalence_join (hr : Reflexive r) (ht : Transitive r)
    (h : ∀ a b c, r a b → r a c → Join r b c) : Equivalence (Join r) :=
  ⟨reflexive_join hr, symmetric_join, transitive_join ht h⟩
#align relation.equivalence_join Relation.equivalence_join
-/

#print Relation.equivalence_join_reflTransGen /-
theorem equivalence_join_reflTransGen
    (h : ∀ a b c, r a b → r a c → ∃ d, ReflGen r b d ∧ ReflTransGen r c d) :
    Equivalence (Join (ReflTransGen r)) :=
  equivalence_join reflexive_reflTransGen transitive_reflTransGen fun a b c => church_rosser h
#align relation.equivalence_join_refl_trans_gen Relation.equivalence_join_reflTransGen
-/

#print Relation.join_of_equivalence /-
theorem join_of_equivalence {r' : α → α → Prop} (hr : Equivalence r) (h : ∀ a b, r' a b → r a b) :
    Join r' a b → r a b
  | ⟨c, hac, hbc⟩ => hr.2.2 (h _ _ hac) (hr.2.1 <| h _ _ hbc)
#align relation.join_of_equivalence Relation.join_of_equivalence
-/

#print Relation.reflTransGen_of_transitive_reflexive /-
theorem reflTransGen_of_transitive_reflexive {r' : α → α → Prop} (hr : Reflexive r)
    (ht : Transitive r) (h : ∀ a b, r' a b → r a b) (h' : ReflTransGen r' a b) : r a b :=
  by
  induction' h' with b c hab hbc ih
  · exact hr _
  · exact ht ih (h _ _ hbc)
#align relation.refl_trans_gen_of_transitive_reflexive Relation.reflTransGen_of_transitive_reflexive
-/

#print Relation.reflTransGen_of_equivalence /-
theorem reflTransGen_of_equivalence {r' : α → α → Prop} (hr : Equivalence r) :
    (∀ a b, r' a b → r a b) → ReflTransGen r' a b → r a b :=
  reflTransGen_of_transitive_reflexive hr.1 hr.2.2
#align relation.refl_trans_gen_of_equivalence Relation.reflTransGen_of_equivalence
-/

end Join

end Relation

section EqvGen

variable {r : α → α → Prop} {a b : α}

#print Equivalence.eqvGen_iff /-
theorem Equivalence.eqvGen_iff (h : Equivalence r) : EqvGen r a b ↔ r a b :=
  Iff.intro
    (by
      intro h
      induction h
      case rel => assumption
      case refl => exact h.1 _
      case symm => apply h.2.1; assumption
      case trans a b c _ _ hab hbc => exact h.2.2 hab hbc)
    (EqvGen.rel a b)
#align equivalence.eqv_gen_iff Equivalence.eqvGen_iff
-/

#print Equivalence.eqvGen_eq /-
theorem Equivalence.eqvGen_eq (h : Equivalence r) : EqvGen r = r :=
  funext fun _ => funext fun _ => propext <| h.eqvGen_iff
#align equivalence.eqv_gen_eq Equivalence.eqvGen_eq
-/

#print EqvGen.mono /-
theorem EqvGen.mono {r p : α → α → Prop} (hrp : ∀ a b, r a b → p a b) (h : EqvGen r a b) :
    EqvGen p a b := by
  induction h
  case rel a b h => exact EqvGen.rel _ _ (hrp _ _ h)
  case refl => exact EqvGen.refl _
  case symm a b h ih => exact EqvGen.symm _ _ ih
  case trans a b c ih1 ih2 hab hbc => exact EqvGen.trans _ _ _ hab hbc
#align eqv_gen.mono EqvGen.mono
-/

end EqvGen