/-
Copyright (c) 2021 Aaron Anderson, Jesse Michael Han, Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson, Jesse Michael Han, Floris van Doorn

! This file was ported from Lean 3 source module model_theory.syntax
! leanprover-community/mathlib commit d565b3df44619c1498326936be16f1a935df0728
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.List.ProdSigma
import Mathbin.Data.Set.Prod
import Mathbin.Logic.Equiv.Fin
import Mathbin.ModelTheory.LanguageMap

/-!
# Basics on First-Order Syntax
This file defines first-order terms, formulas, sentences, and theories in a style inspired by the
[Flypitch project](https://flypitch.github.io/).

## Main Definitions
* A `first_order.language.term` is defined so that `L.term α` is the type of `L`-terms with free
  variables indexed by `α`.
* A `first_order.language.formula` is defined so that `L.formula α` is the type of `L`-formulas with
  free variables indexed by `α`.
* A `first_order.language.sentence` is a formula with no free variables.
* A `first_order.language.Theory` is a set of sentences.
* The variables of terms and formulas can be relabelled with `first_order.language.term.relabel`,
`first_order.language.bounded_formula.relabel`, and `first_order.language.formula.relabel`.
* Given an operation on terms and an operation on relations,
  `first_order.language.bounded_formula.map_term_rel` gives an operation on formulas.
* `first_order.language.bounded_formula.cast_le` adds more `fin`-indexed variables.
* `first_order.language.bounded_formula.lift_at` raises the indexes of the `fin`-indexed variables
above a particular index.
* `first_order.language.term.subst` and `first_order.language.bounded_formula.subst` substitute
variables with given terms.
* Language maps can act on syntactic objects with functions such as
`first_order.language.Lhom.on_formula`.
* `first_order.language.term.constants_vars_equiv` and
`first_order.language.bounded_formula.constants_vars_equiv` switch terms and formulas between having
constants in the language and having extra variables indexed by the same type.

## Implementation Notes
* Formulas use a modified version of de Bruijn variables. Specifically, a `L.bounded_formula α n`
is a formula with some variables indexed by a type `α`, which cannot be quantified over, and some
indexed by `fin n`, which can. For any `φ : L.bounded_formula α (n + 1)`, we define the formula
`∀' φ : L.bounded_formula α n` by universally quantifying over the variable indexed by
`n : fin (n + 1)`.

## References
For the Flypitch project:
- [J. Han, F. van Doorn, *A formal proof of the independence of the continuum hypothesis*]
[flypitch_cpp]
- [J. Han, F. van Doorn, *A formalization of forcing and the unprovability of
the continuum hypothesis*][flypitch_itp]

-/

universe u v w u' v'

namespace FirstOrder

namespace Language

variable (L : Language.{u, v}) {L' : Language}

variable {M : Type w} {N P : Type _} [L.Structure M] [L.Structure N] [L.Structure P]

variable {α : Type u'} {β : Type v'} {γ : Type _}

open FirstOrder

open Structure Fin

/- ./././Mathport/Syntax/Translate/Command.lean:364:30: infer kinds are unsupported in Lean 4: var {} -/
/- ./././Mathport/Syntax/Translate/Command.lean:364:30: infer kinds are unsupported in Lean 4: func {} -/
/-- A term on `α` is either a variable indexed by an element of `α`
  or a function symbol applied to simpler terms. -/
inductive Term (α : Type u') : Type max u u'
  | var : ∀ a : α, term
  | func : ∀ {l : ℕ} (f : L.Functions l) (ts : Fin l → term), term
#align first_order.language.term FirstOrder.Language.Term

export Term ()

variable {L}

namespace Term

open Finset

/- warning: first_order.language.term.var_finset -> FirstOrder.Language.Term.varFinset is a dubious translation:
lean 3 declaration is
  forall {L : FirstOrder.Language.{u1, u2}} {α : Type.{u3}} [_inst_4 : DecidableEq.{succ u3} α], (FirstOrder.Language.Term.{u1, u2, u3} L α) -> (Finset.{u3} α)
but is expected to have type
  forall {L : FirstOrder.Language.{u1, u3}} {α : Type.{u2}} [_inst_4 : DecidableEq.{succ u2} α], (FirstOrder.Language.Term.{u1, u3, u2} L α) -> (Finset.{u2} α)
Case conversion may be inaccurate. Consider using '#align first_order.language.term.var_finset FirstOrder.Language.Term.varFinsetₓ'. -/
/-- The `finset` of variables used in a given term. -/
@[simp]
def varFinset [DecidableEq α] : L.term α → Finset α
  | var i => {i}
  | func f ts => univ.bunionᵢ fun i => (ts i).varFinset
#align first_order.language.term.var_finset FirstOrder.Language.Term.varFinset

/- warning: first_order.language.term.var_finset_left -> FirstOrder.Language.Term.varFinsetLeft is a dubious translation:
lean 3 declaration is
  forall {L : FirstOrder.Language.{u1, u2}} {α : Type.{u3}} {β : Type.{u4}} [_inst_4 : DecidableEq.{succ u3} α], (FirstOrder.Language.Term.{u1, u2, max u3 u4} L (Sum.{u3, u4} α β)) -> (Finset.{u3} α)
but is expected to have type
  forall {L : FirstOrder.Language.{u1, u3}} {α : Type.{u2}} {β : Type.{u4}} [_inst_4 : DecidableEq.{succ u2} α], (FirstOrder.Language.Term.{u1, u3, max u2 u4} L (Sum.{u2, u4} α β)) -> (Finset.{u2} α)
Case conversion may be inaccurate. Consider using '#align first_order.language.term.var_finset_left FirstOrder.Language.Term.varFinsetLeftₓ'. -/
/-- The `finset` of variables from the left side of a sum used in a given term. -/
@[simp]
def varFinsetLeft [DecidableEq α] : L.term (Sum α β) → Finset α
  | var (Sum.inl i) => {i}
  | var (Sum.inr i) => ∅
  | func f ts => univ.bunionᵢ fun i => (ts i).varFinsetLeft
#align first_order.language.term.var_finset_left FirstOrder.Language.Term.varFinsetLeft

/- warning: first_order.language.term.relabel -> FirstOrder.Language.Term.relabel is a dubious translation:
lean 3 declaration is
  forall {L : FirstOrder.Language.{u1, u2}} {α : Type.{u3}} {β : Type.{u4}}, (α -> β) -> (FirstOrder.Language.Term.{u1, u2, u3} L α) -> (FirstOrder.Language.Term.{u1, u2, u4} L β)
but is expected to have type
  forall {L : FirstOrder.Language.{u1, u3}} {α : Type.{u2}} {β : Type.{u4}}, (α -> β) -> (FirstOrder.Language.Term.{u1, u3, u2} L α) -> (FirstOrder.Language.Term.{u1, u3, u4} L β)
Case conversion may be inaccurate. Consider using '#align first_order.language.term.relabel FirstOrder.Language.Term.relabelₓ'. -/
/-- Relabels a term's variables along a particular function. -/
@[simp]
def relabel (g : α → β) : L.term α → L.term β
  | var i => var (g i)
  | func f ts => func f fun i => (ts i).relabel
#align first_order.language.term.relabel FirstOrder.Language.Term.relabel

theorem relabel_id (t : L.term α) : t.relabel id = t :=
  by
  induction' t with _ _ _ _ ih
  · rfl
  · simp [ih]
#align first_order.language.term.relabel_id FirstOrder.Language.Term.relabel_id

@[simp]
theorem relabel_id_eq_id : (Term.relabel id : L.term α → L.term α) = id :=
  funext relabel_id
#align first_order.language.term.relabel_id_eq_id FirstOrder.Language.Term.relabel_id_eq_id

@[simp]
theorem relabel_relabel (f : α → β) (g : β → γ) (t : L.term α) :
    (t.relabel f).relabel g = t.relabel (g ∘ f) :=
  by
  induction' t with _ _ _ _ ih
  · rfl
  · simp [ih]
#align first_order.language.term.relabel_relabel FirstOrder.Language.Term.relabel_relabel

@[simp]
theorem relabel_comp_relabel (f : α → β) (g : β → γ) :
    (Term.relabel g ∘ Term.relabel f : L.term α → L.term γ) = Term.relabel (g ∘ f) :=
  funext (relabel_relabel f g)
#align first_order.language.term.relabel_comp_relabel FirstOrder.Language.Term.relabel_comp_relabel

/-- Relabels a term's variables along a bijection. -/
@[simps]
def relabelEquiv (g : α ≃ β) : L.term α ≃ L.term β :=
  ⟨relabel g, relabel g.symm, fun t => by simp, fun t => by simp⟩
#align first_order.language.term.relabel_equiv FirstOrder.Language.Term.relabelEquiv

/- warning: first_order.language.term.restrict_var -> FirstOrder.Language.Term.restrictVar is a dubious translation:
lean 3 declaration is
  forall {L : FirstOrder.Language.{u1, u2}} {α : Type.{u3}} {β : Type.{u4}} [_inst_4 : DecidableEq.{succ u3} α] (t : FirstOrder.Language.Term.{u1, u2, u3} L α), ((coeSort.{succ u3, succ (succ u3)} (Finset.{u3} α) Type.{u3} (Finset.hasCoeToSort.{u3} α) (FirstOrder.Language.Term.varFinset.{u1, u2, u3} L α (fun (a : α) (b : α) => _inst_4 a b) t)) -> β) -> (FirstOrder.Language.Term.{u1, u2, u4} L β)
but is expected to have type
  PUnit.{max (max (max (succ (succ u1)) (succ (succ u2))) (succ (succ u3))) (succ (succ u4))}
Case conversion may be inaccurate. Consider using '#align first_order.language.term.restrict_var FirstOrder.Language.Term.restrictVarₓ'. -/
/-- Restricts a term to use only a set of the given variables. -/
def restrictVar [DecidableEq α] : ∀ (t : L.term α) (f : t.varFinset → β), L.term β
  | var a, f => var (f ⟨a, mem_singleton_self a⟩)
  | func F ts, f =>
    func F fun i => (ts i).restrictVar (f ∘ Set.inclusion (subset_bunionᵢ_of_mem _ (mem_univ i)))
#align first_order.language.term.restrict_var FirstOrder.Language.Term.restrictVar

/- warning: first_order.language.term.restrict_var_left -> FirstOrder.Language.Term.restrictVarLeft is a dubious translation:
lean 3 declaration is
  forall {L : FirstOrder.Language.{u1, u2}} {α : Type.{u3}} {β : Type.{u4}} [_inst_4 : DecidableEq.{succ u3} α] {γ : Type.{u5}} (t : FirstOrder.Language.Term.{u1, u2, max u3 u5} L (Sum.{u3, u5} α γ)), ((coeSort.{succ u3, succ (succ u3)} (Finset.{u3} α) Type.{u3} (Finset.hasCoeToSort.{u3} α) (FirstOrder.Language.Term.varFinsetLeft.{u1, u2, u3, u5} L α γ (fun (a : α) (b : α) => _inst_4 a b) t)) -> β) -> (FirstOrder.Language.Term.{u1, u2, max u4 u5} L (Sum.{u4, u5} β γ))
but is expected to have type
  PUnit.{max (max (max (max (succ (succ u1)) (succ (succ u2))) (succ (succ u3))) (succ (succ u4))) (succ (succ u5))}
Case conversion may be inaccurate. Consider using '#align first_order.language.term.restrict_var_left FirstOrder.Language.Term.restrictVarLeftₓ'. -/
/-- Restricts a term to use only a set of the given variables on the left side of a sum. -/
def restrictVarLeft [DecidableEq α] {γ : Type _} :
    ∀ (t : L.term (Sum α γ)) (f : t.varFinsetLeft → β), L.term (Sum β γ)
  | var (Sum.inl a), f => var (Sum.inl (f ⟨a, mem_singleton_self a⟩))
  | var (Sum.inr a), f => var (Sum.inr a)
  | func F ts, f =>
    func F fun i =>
      (ts i).restrictVarLeft (f ∘ Set.inclusion (subset_bunionᵢ_of_mem _ (mem_univ i)))
#align first_order.language.term.restrict_var_left FirstOrder.Language.Term.restrictVarLeft

end Term

/-- The representation of a constant symbol as a term. -/
def Constants.term (c : L.Constants) : L.term α :=
  func c default
#align first_order.language.constants.term FirstOrder.Language.Constants.term

/-- Applies a unary function to a term. -/
def Functions.apply₁ (f : L.Functions 1) (t : L.term α) : L.term α :=
  func f ![t]
#align first_order.language.functions.apply₁ FirstOrder.Language.Functions.apply₁

/-- Applies a binary function to two terms. -/
def Functions.apply₂ (f : L.Functions 2) (t₁ t₂ : L.term α) : L.term α :=
  func f ![t₁, t₂]
#align first_order.language.functions.apply₂ FirstOrder.Language.Functions.apply₂

namespace Term

/- warning: first_order.language.term.constants_to_vars -> FirstOrder.Language.Term.constantsToVars is a dubious translation:
lean 3 declaration is
  forall {L : FirstOrder.Language.{u1, u2}} {α : Type.{u3}} {γ : Type.{u4}}, (FirstOrder.Language.Term.{max u1 u4, u2, u3} (FirstOrder.Language.withConstants.{u1, u2, u4} L γ) α) -> (FirstOrder.Language.Term.{u1, u2, max u4 u3} L (Sum.{u4, u3} γ α))
but is expected to have type
  forall {L : FirstOrder.Language.{u1, u4}} {α : Type.{u2}} {γ : Type.{u3}}, (FirstOrder.Language.Term.{max u1 u3, u4, u2} (FirstOrder.Language.withConstants.{u1, u4, u3} L γ) α) -> (FirstOrder.Language.Term.{u1, u4, max u3 u2} L (Sum.{u3, u2} γ α))
Case conversion may be inaccurate. Consider using '#align first_order.language.term.constants_to_vars FirstOrder.Language.Term.constantsToVarsₓ'. -/
/-- Sends a term with constants to a term with extra variables. -/
@[simp]
def constantsToVars : L[[γ]].term α → L.term (Sum γ α)
  | var a => var (Sum.inr a)
  | @func _ _ 0 f ts =>
    Sum.casesOn f (fun f => func f fun i => (ts i).constantsToVars) fun c => var (Sum.inl c)
  | @func _ _ (n + 1) f ts =>
    Sum.casesOn f (fun f => func f fun i => (ts i).constantsToVars) fun c => isEmptyElim c
#align first_order.language.term.constants_to_vars FirstOrder.Language.Term.constantsToVars

/- warning: first_order.language.term.vars_to_constants -> FirstOrder.Language.Term.varsToConstants is a dubious translation:
lean 3 declaration is
  forall {L : FirstOrder.Language.{u1, u2}} {α : Type.{u3}} {γ : Type.{u4}}, (FirstOrder.Language.Term.{u1, u2, max u4 u3} L (Sum.{u4, u3} γ α)) -> (FirstOrder.Language.Term.{max u1 u4, u2, u3} (FirstOrder.Language.withConstants.{u1, u2, u4} L γ) α)
but is expected to have type
  forall {L : FirstOrder.Language.{u1, u4}} {α : Type.{u2}} {γ : Type.{u3}}, (FirstOrder.Language.Term.{u1, u4, max u3 u2} L (Sum.{u3, u2} γ α)) -> (FirstOrder.Language.Term.{max u1 u3, u4, u2} (FirstOrder.Language.withConstants.{u1, u4, u3} L γ) α)
Case conversion may be inaccurate. Consider using '#align first_order.language.term.vars_to_constants FirstOrder.Language.Term.varsToConstantsₓ'. -/
/-- Sends a term with extra variables to a term with constants. -/
@[simp]
def varsToConstants : L.term (Sum γ α) → L[[γ]].term α
  | var (Sum.inr a) => var a
  | var (Sum.inl c) => Constants.term (Sum.inr c)
  | func f ts => func (Sum.inl f) fun i => (ts i).varsToConstants
#align first_order.language.term.vars_to_constants FirstOrder.Language.Term.varsToConstants

/-- A bijection between terms with constants and terms with extra variables. -/
@[simps]
def constantsVarsEquiv : L[[γ]].term α ≃ L.term (Sum γ α) :=
  ⟨constantsToVars, varsToConstants, by
    intro t
    induction' t with _ n f _ ih
    · rfl
    · cases n
      · cases f
        · simp [constants_to_vars, vars_to_constants, ih]
        · simp [constants_to_vars, vars_to_constants, constants.term]
      · cases f
        · simp [constants_to_vars, vars_to_constants, ih]
        · exact isEmptyElim f, by
    intro t
    induction' t with x n f _ ih
    · cases x <;> rfl
    · cases n <;> · simp [vars_to_constants, constants_to_vars, ih]⟩
#align first_order.language.term.constants_vars_equiv FirstOrder.Language.Term.constantsVarsEquiv

/-- A bijection between terms with constants and terms with extra variables. -/
def constantsVarsEquivLeft : L[[γ]].term (Sum α β) ≃ L.term (Sum (Sum γ α) β) :=
  constantsVarsEquiv.trans (relabelEquiv (Equiv.sumAssoc _ _ _)).symm
#align first_order.language.term.constants_vars_equiv_left FirstOrder.Language.Term.constantsVarsEquivLeft

@[simp]
theorem constantsVarsEquivLeft_apply (t : L[[γ]].term (Sum α β)) :
    constantsVarsEquivLeft t = (constantsToVars t).relabel (Equiv.sumAssoc _ _ _).symm :=
  rfl
#align first_order.language.term.constants_vars_equiv_left_apply FirstOrder.Language.Term.constantsVarsEquivLeft_apply

@[simp]
theorem constantsVarsEquivLeft_symm_apply (t : L.term (Sum (Sum γ α) β)) :
    constantsVarsEquivLeft.symm t = varsToConstants (t.relabel (Equiv.sumAssoc _ _ _)) :=
  rfl
#align first_order.language.term.constants_vars_equiv_left_symm_apply FirstOrder.Language.Term.constantsVarsEquivLeft_symm_apply

instance inhabitedOfVar [Inhabited α] : Inhabited (L.term α) :=
  ⟨var default⟩
#align first_order.language.term.inhabited_of_var FirstOrder.Language.Term.inhabitedOfVar

instance inhabitedOfConstant [Inhabited L.Constants] : Inhabited (L.term α) :=
  ⟨(default : L.Constants).term⟩
#align first_order.language.term.inhabited_of_constant FirstOrder.Language.Term.inhabitedOfConstant

/-- Raises all of the `fin`-indexed variables of a term greater than or equal to `m` by `n'`. -/
def liftAt {n : ℕ} (n' m : ℕ) : L.term (Sum α (Fin n)) → L.term (Sum α (Fin (n + n'))) :=
  relabel (Sum.map id fun i => if ↑i < m then Fin.castAdd n' i else Fin.addNat n' i)
#align first_order.language.term.lift_at FirstOrder.Language.Term.liftAt

/- warning: first_order.language.term.subst -> FirstOrder.Language.Term.subst is a dubious translation:
lean 3 declaration is
  forall {L : FirstOrder.Language.{u1, u2}} {α : Type.{u3}} {β : Type.{u4}}, (FirstOrder.Language.Term.{u1, u2, u3} L α) -> (α -> (FirstOrder.Language.Term.{u1, u2, u4} L β)) -> (FirstOrder.Language.Term.{u1, u2, u4} L β)
but is expected to have type
  forall {L : FirstOrder.Language.{u1, u3}} {α : Type.{u2}} {β : Type.{u4}}, (FirstOrder.Language.Term.{u1, u3, u2} L α) -> (α -> (FirstOrder.Language.Term.{u1, u3, u4} L β)) -> (FirstOrder.Language.Term.{u1, u3, u4} L β)
Case conversion may be inaccurate. Consider using '#align first_order.language.term.subst FirstOrder.Language.Term.substₓ'. -/
/-- Substitutes the variables in a given term with terms. -/
@[simp]
def subst : L.term α → (α → L.term β) → L.term β
  | var a, tf => tf a
  | func f ts, tf => func f fun i => (ts i).subst tf
#align first_order.language.term.subst FirstOrder.Language.Term.subst

end Term

-- mathport name: language.term.var
scoped[FirstOrder] prefix:arg "&" => FirstOrder.Language.Term.var ∘ Sum.inr

namespace Lhom

/- warning: first_order.language.Lhom.on_term -> FirstOrder.Language.Lhom.onTerm is a dubious translation:
lean 3 declaration is
  forall {L : FirstOrder.Language.{u1, u2}} {L' : FirstOrder.Language.{u4, u5}} {α : Type.{u3}}, (FirstOrder.Language.Lhom.{u1, u2, u4, u5} L L') -> (FirstOrder.Language.Term.{u1, u2, u3} L α) -> (FirstOrder.Language.Term.{u4, u5, u3} L' α)
but is expected to have type
  forall {L : FirstOrder.Language.{u1, u5}} {L' : FirstOrder.Language.{u3, u4}} {α : Type.{u2}}, (FirstOrder.Language.Lhom.{u1, u5, u3, u4} L L') -> (FirstOrder.Language.Term.{u1, u5, u2} L α) -> (FirstOrder.Language.Term.{u3, u4, u2} L' α)
Case conversion may be inaccurate. Consider using '#align first_order.language.Lhom.on_term FirstOrder.Language.Lhom.onTermₓ'. -/
/-- Maps a term's symbols along a language map. -/
@[simp]
def onTerm (φ : L →ᴸ L') : L.term α → L'.term α
  | var i => var i
  | func f ts => func (φ.onFunction f) fun i => on_term (ts i)
#align first_order.language.Lhom.on_term FirstOrder.Language.Lhom.onTerm

@[simp]
theorem id_onTerm : ((Lhom.id L).onTerm : L.term α → L.term α) = id :=
  by
  ext t
  induction' t with _ _ _ _ ih
  · rfl
  · simp_rw [on_term, ih]
    rfl
#align first_order.language.Lhom.id_on_term FirstOrder.Language.Lhom.id_onTerm

@[simp]
theorem comp_onTerm {L'' : Language} (φ : L' →ᴸ L'') (ψ : L →ᴸ L') :
    ((φ.comp ψ).onTerm : L.term α → L''.term α) = φ.onTerm ∘ ψ.onTerm :=
  by
  ext t
  induction' t with _ _ _ _ ih
  · rfl
  · simp_rw [on_term, ih]
    rfl
#align first_order.language.Lhom.comp_on_term FirstOrder.Language.Lhom.comp_onTerm

end Lhom

/-- Maps a term's symbols along a language equivalence. -/
@[simps]
def Lequiv.onTerm (φ : L ≃ᴸ L') : L.term α ≃ L'.term α
    where
  toFun := φ.toLhom.onTerm
  invFun := φ.invLhom.onTerm
  left_inv := by
    rw [Function.leftInverse_iff_comp, ← Lhom.comp_on_term, φ.left_inv, Lhom.id_on_term]
  right_inv := by
    rw [Function.rightInverse_iff_comp, ← Lhom.comp_on_term, φ.right_inv, Lhom.id_on_term]
#align first_order.language.Lequiv.on_term FirstOrder.Language.Lequiv.onTerm

variable (L) (α)

/- ./././Mathport/Syntax/Translate/Command.lean:364:30: infer kinds are unsupported in Lean 4: falsum {} -/
/-- `bounded_formula α n` is the type of formulas with free variables indexed by `α` and up to `n`
  additional free variables. -/
inductive BoundedFormula : ℕ → Type max u v u'
  | falsum {n} : bounded_formula n
  | equal {n} (t₁ t₂ : L.term (Sum α (Fin n))) : bounded_formula n
  | Rel {n l : ℕ} (R : L.Relations l) (ts : Fin l → L.term (Sum α (Fin n))) : bounded_formula n
  | imp {n} (f₁ f₂ : bounded_formula n) : bounded_formula n
  | all {n} (f : bounded_formula (n + 1)) : bounded_formula n
#align first_order.language.bounded_formula FirstOrder.Language.BoundedFormula

/-- `formula α` is the type of formulas with all free variables indexed by `α`. -/
@[reducible]
def Formula :=
  L.BoundedFormula α 0
#align first_order.language.formula FirstOrder.Language.Formula

/-- A sentence is a formula with no free variables. -/
@[reducible]
def Sentence :=
  L.Formula Empty
#align first_order.language.sentence FirstOrder.Language.Sentence

/-- A theory is a set of sentences. -/
@[reducible]
def Theory :=
  Set L.Sentence
#align first_order.language.Theory FirstOrder.Language.Theory

variable {L} {α} {n : ℕ}

/-- Applies a relation to terms as a bounded formula. -/
def Relations.boundedFormula {l : ℕ} (R : L.Relations n) (ts : Fin n → L.term (Sum α (Fin l))) :
    L.BoundedFormula α l :=
  BoundedFormula.rel R ts
#align first_order.language.relations.bounded_formula FirstOrder.Language.Relations.boundedFormula

/-- Applies a unary relation to a term as a bounded formula. -/
def Relations.boundedFormula₁ (r : L.Relations 1) (t : L.term (Sum α (Fin n))) :
    L.BoundedFormula α n :=
  r.BoundedFormula ![t]
#align first_order.language.relations.bounded_formula₁ FirstOrder.Language.Relations.boundedFormula₁

/-- Applies a binary relation to two terms as a bounded formula. -/
def Relations.boundedFormula₂ (r : L.Relations 2) (t₁ t₂ : L.term (Sum α (Fin n))) :
    L.BoundedFormula α n :=
  r.BoundedFormula ![t₁, t₂]
#align first_order.language.relations.bounded_formula₂ FirstOrder.Language.Relations.boundedFormula₂

/-- The equality of two terms as a bounded formula. -/
def Term.bdEqual (t₁ t₂ : L.term (Sum α (Fin n))) : L.BoundedFormula α n :=
  BoundedFormula.equal t₁ t₂
#align first_order.language.term.bd_equal FirstOrder.Language.Term.bdEqual

/-- Applies a relation to terms as a bounded formula. -/
def Relations.formula (R : L.Relations n) (ts : Fin n → L.term α) : L.Formula α :=
  R.BoundedFormula fun i => (ts i).relabel Sum.inl
#align first_order.language.relations.formula FirstOrder.Language.Relations.formula

/-- Applies a unary relation to a term as a formula. -/
def Relations.formula₁ (r : L.Relations 1) (t : L.term α) : L.Formula α :=
  r.Formula ![t]
#align first_order.language.relations.formula₁ FirstOrder.Language.Relations.formula₁

/-- Applies a binary relation to two terms as a formula. -/
def Relations.formula₂ (r : L.Relations 2) (t₁ t₂ : L.term α) : L.Formula α :=
  r.Formula ![t₁, t₂]
#align first_order.language.relations.formula₂ FirstOrder.Language.Relations.formula₂

/-- The equality of two terms as a first-order formula. -/
def Term.equal (t₁ t₂ : L.term α) : L.Formula α :=
  (t₁.relabel Sum.inl).bdEqual (t₂.relabel Sum.inl)
#align first_order.language.term.equal FirstOrder.Language.Term.equal

namespace BoundedFormula

instance : Inhabited (L.BoundedFormula α n) :=
  ⟨falsum⟩

instance : Bot (L.BoundedFormula α n) :=
  ⟨falsum⟩

/-- The negation of a bounded formula is also a bounded formula. -/
@[match_pattern]
protected def not (φ : L.BoundedFormula α n) : L.BoundedFormula α n :=
  φ.imp ⊥
#align first_order.language.bounded_formula.not FirstOrder.Language.BoundedFormula.not

/-- Puts an `∃` quantifier on a bounded formula. -/
@[match_pattern]
protected def ex (φ : L.BoundedFormula α (n + 1)) : L.BoundedFormula α n :=
  φ.Not.all.Not
#align first_order.language.bounded_formula.ex FirstOrder.Language.BoundedFormula.ex

instance : Top (L.BoundedFormula α n) :=
  ⟨BoundedFormula.not ⊥⟩

instance : Inf (L.BoundedFormula α n) :=
  ⟨fun f g => (f.imp g.Not).Not⟩

instance : Sup (L.BoundedFormula α n) :=
  ⟨fun f g => f.Not.imp g⟩

/-- The biimplication between two bounded formulas. -/
protected def iff (φ ψ : L.BoundedFormula α n) :=
  φ.imp ψ ⊓ ψ.imp φ
#align first_order.language.bounded_formula.iff FirstOrder.Language.BoundedFormula.iff

open Finset

/- warning: first_order.language.bounded_formula.free_var_finset -> FirstOrder.Language.BoundedFormula.freeVarFinset is a dubious translation:
lean 3 declaration is
  forall {L : FirstOrder.Language.{u1, u2}} {α : Type.{u3}} [_inst_4 : DecidableEq.{succ u3} α] {n : Nat}, (FirstOrder.Language.BoundedFormula.{u1, u2, u3} L α n) -> (Finset.{u3} α)
but is expected to have type
  forall {L : FirstOrder.Language.{u1, u3}} {α : Type.{u2}} [_inst_4 : DecidableEq.{succ u2} α] {n : Nat}, (FirstOrder.Language.BoundedFormula.{u1, u3, u2} L α n) -> (Finset.{u2} α)
Case conversion may be inaccurate. Consider using '#align first_order.language.bounded_formula.free_var_finset FirstOrder.Language.BoundedFormula.freeVarFinsetₓ'. -/
/-- The `finset` of variables used in a given formula. -/
@[simp]
def freeVarFinset [DecidableEq α] : ∀ {n}, L.BoundedFormula α n → Finset α
  | n, falsum => ∅
  | n, equal t₁ t₂ => t₁.varFinsetLeft ∪ t₂.varFinsetLeft
  | n, Rel R ts => univ.bunionᵢ fun i => (ts i).varFinsetLeft
  | n, imp f₁ f₂ => f₁.freeVarFinset ∪ f₂.freeVarFinset
  | n, all f => f.freeVarFinset
#align first_order.language.bounded_formula.free_var_finset FirstOrder.Language.BoundedFormula.freeVarFinset

/- warning: first_order.language.bounded_formula.cast_le -> FirstOrder.Language.BoundedFormula.castLe is a dubious translation:
lean 3 declaration is
  forall {L : FirstOrder.Language.{u1, u2}} {α : Type.{u3}} {m : Nat} {n : Nat}, (LE.le.{0} Nat Nat.hasLe m n) -> (FirstOrder.Language.BoundedFormula.{u1, u2, u3} L α m) -> (FirstOrder.Language.BoundedFormula.{u1, u2, u3} L α n)
but is expected to have type
  forall {L : FirstOrder.Language.{u1, u3}} {α : Type.{u2}} {m : Nat} {n : Nat}, (LE.le.{0} Nat Nat.hasLe m n) -> (FirstOrder.Language.BoundedFormula.{u1, u3, u2} L α m) -> (FirstOrder.Language.BoundedFormula.{u1, u3, u2} L α n)
Case conversion may be inaccurate. Consider using '#align first_order.language.bounded_formula.cast_le FirstOrder.Language.BoundedFormula.castLeₓ'. -/
/-- Casts `L.bounded_formula α m` as `L.bounded_formula α n`, where `m ≤ n`. -/
@[simp]
def castLe : ∀ {m n : ℕ} (h : m ≤ n), L.BoundedFormula α m → L.BoundedFormula α n
  | m, n, h, falsum => falsum
  | m, n, h, equal t₁ t₂ =>
    equal (t₁.relabel (Sum.map id (Fin.castLe h))) (t₂.relabel (Sum.map id (Fin.castLe h)))
  | m, n, h, Rel R ts => rel R (Term.relabel (Sum.map id (Fin.castLe h)) ∘ ts)
  | m, n, h, imp f₁ f₂ => (f₁.castLe h).imp (f₂.castLe h)
  | m, n, h, all f => (f.castLe (add_le_add_right h 1)).all
#align first_order.language.bounded_formula.cast_le FirstOrder.Language.BoundedFormula.castLe

@[simp]
theorem castLe_rfl {n} (h : n ≤ n) (φ : L.BoundedFormula α n) : φ.castLe h = φ :=
  by
  induction' φ with _ _ _ _ _ _ _ _ _ _ _ ih1 ih2 _ _ ih3
  · rfl
  · simp [Fin.castLe_of_eq]
  · simp [Fin.castLe_of_eq]
  · simp [Fin.castLe_of_eq, ih1, ih2]
  · simp [Fin.castLe_of_eq, ih3]
#align first_order.language.bounded_formula.cast_le_rfl FirstOrder.Language.BoundedFormula.castLe_rfl

@[simp]
theorem castLe_castLe {k m n} (km : k ≤ m) (mn : m ≤ n) (φ : L.BoundedFormula α k) :
    (φ.castLe km).castLe mn = φ.castLe (km.trans mn) :=
  by
  revert m n
  induction' φ with _ _ _ _ _ _ _ _ _ _ _ ih1 ih2 _ _ ih3 <;> intro m n km mn
  · rfl
  · simp
  · simp only [cast_le, eq_self_iff_true, heq_iff_eq, true_and_iff]
    rw [← Function.comp.assoc, relabel_comp_relabel]
    simp
  · simp [ih1, ih2]
  · simp only [cast_le, ih3]
#align first_order.language.bounded_formula.cast_le_cast_le FirstOrder.Language.BoundedFormula.castLe_castLe

@[simp]
theorem castLe_comp_castLe {k m n} (km : k ≤ m) (mn : m ≤ n) :
    (BoundedFormula.castLe mn ∘ BoundedFormula.castLe km :
        L.BoundedFormula α k → L.BoundedFormula α n) =
      BoundedFormula.castLe (km.trans mn) :=
  funext (castLe_castLe km mn)
#align first_order.language.bounded_formula.cast_le_comp_cast_le FirstOrder.Language.BoundedFormula.castLe_comp_castLe

/- warning: first_order.language.bounded_formula.restrict_free_var -> FirstOrder.Language.BoundedFormula.restrictFreeVar is a dubious translation:
lean 3 declaration is
  forall {L : FirstOrder.Language.{u1, u2}} {α : Type.{u3}} {β : Type.{u4}} [_inst_4 : DecidableEq.{succ u3} α] {n : Nat} (φ : FirstOrder.Language.BoundedFormula.{u1, u2, u3} L α n), ((coeSort.{succ u3, succ (succ u3)} (Finset.{u3} α) Type.{u3} (Finset.hasCoeToSort.{u3} α) (FirstOrder.Language.BoundedFormula.freeVarFinset.{u1, u2, u3} L α (fun (a : α) (b : α) => _inst_4 a b) n φ)) -> β) -> (FirstOrder.Language.BoundedFormula.{u1, u2, u4} L β n)
but is expected to have type
  PUnit.{max (max (max (succ (succ u1)) (succ (succ u2))) (succ (succ u3))) (succ (succ u4))}
Case conversion may be inaccurate. Consider using '#align first_order.language.bounded_formula.restrict_free_var FirstOrder.Language.BoundedFormula.restrictFreeVarₓ'. -/
/-- Restricts a bounded formula to only use a particular set of free variables. -/
def restrictFreeVar [DecidableEq α] :
    ∀ {n : ℕ} (φ : L.BoundedFormula α n) (f : φ.freeVarFinset → β), L.BoundedFormula β n
  | n, falsum, f => falsum
  | n, equal t₁ t₂, f =>
    equal (t₁.restrictVarLeft (f ∘ Set.inclusion (subset_union_left _ _)))
      (t₂.restrictVarLeft (f ∘ Set.inclusion (subset_union_right _ _)))
  | n, Rel R ts, f =>
    rel R fun i => (ts i).restrictVarLeft (f ∘ Set.inclusion (subset_bunionᵢ_of_mem _ (mem_univ i)))
  | n, imp φ₁ φ₂, f =>
    (φ₁.restrictFreeVar (f ∘ Set.inclusion (subset_union_left _ _))).imp
      (φ₂.restrictFreeVar (f ∘ Set.inclusion (subset_union_right _ _)))
  | n, all φ, f => (φ.restrictFreeVar f).all
#align first_order.language.bounded_formula.restrict_free_var FirstOrder.Language.BoundedFormula.restrictFreeVar

/- warning: first_order.language.bounded_formula.alls -> FirstOrder.Language.BoundedFormula.alls is a dubious translation:
lean 3 declaration is
  forall {L : FirstOrder.Language.{u1, u2}} {α : Type.{u3}} {n : Nat}, (FirstOrder.Language.BoundedFormula.{u1, u2, u3} L α n) -> (FirstOrder.Language.Formula.{u1, u2, u3} L α)
but is expected to have type
  forall {L : FirstOrder.Language.{u1, u3}} {α : Type.{u2}} {n : Nat}, (FirstOrder.Language.BoundedFormula.{u1, u3, u2} L α n) -> (FirstOrder.Language.Formula.{u1, u3, u2} L α)
Case conversion may be inaccurate. Consider using '#align first_order.language.bounded_formula.alls FirstOrder.Language.BoundedFormula.allsₓ'. -/
/-- Places universal quantifiers on all extra variables of a bounded formula. -/
def alls : ∀ {n}, L.BoundedFormula α n → L.Formula α
  | 0, φ => φ
  | n + 1, φ => φ.all.alls
#align first_order.language.bounded_formula.alls FirstOrder.Language.BoundedFormula.alls

/- warning: first_order.language.bounded_formula.exs -> FirstOrder.Language.BoundedFormula.exs is a dubious translation:
lean 3 declaration is
  forall {L : FirstOrder.Language.{u1, u2}} {α : Type.{u3}} {n : Nat}, (FirstOrder.Language.BoundedFormula.{u1, u2, u3} L α n) -> (FirstOrder.Language.Formula.{u1, u2, u3} L α)
but is expected to have type
  forall {L : FirstOrder.Language.{u1, u3}} {α : Type.{u2}} {n : Nat}, (FirstOrder.Language.BoundedFormula.{u1, u3, u2} L α n) -> (FirstOrder.Language.Formula.{u1, u3, u2} L α)
Case conversion may be inaccurate. Consider using '#align first_order.language.bounded_formula.exs FirstOrder.Language.BoundedFormula.exsₓ'. -/
/-- Places existential quantifiers on all extra variables of a bounded formula. -/
def exs : ∀ {n}, L.BoundedFormula α n → L.Formula α
  | 0, φ => φ
  | n + 1, φ => φ.ex.exs
#align first_order.language.bounded_formula.exs FirstOrder.Language.BoundedFormula.exs

/- warning: first_order.language.bounded_formula.map_term_rel -> FirstOrder.Language.BoundedFormula.mapTermRel is a dubious translation:
lean 3 declaration is
  forall {L : FirstOrder.Language.{u1, u2}} {L' : FirstOrder.Language.{u5, u6}} {α : Type.{u3}} {β : Type.{u4}} {g : Nat -> Nat}, (forall (n : Nat), (FirstOrder.Language.Term.{u1, u2, u3} L (Sum.{u3, 0} α (Fin n))) -> (FirstOrder.Language.Term.{u5, u6, u4} L' (Sum.{u4, 0} β (Fin (g n))))) -> (forall (n : Nat), (FirstOrder.Language.Relations.{u1, u2} L n) -> (FirstOrder.Language.Relations.{u5, u6} L' n)) -> (forall (n : Nat), (FirstOrder.Language.BoundedFormula.{u5, u6, u4} L' β (g (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne)))))) -> (FirstOrder.Language.BoundedFormula.{u5, u6, u4} L' β (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) (g n) (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne)))))) -> (forall {n : Nat}, (FirstOrder.Language.BoundedFormula.{u1, u2, u3} L α n) -> (FirstOrder.Language.BoundedFormula.{u5, u6, u4} L' β (g n)))
but is expected to have type
  forall {L : FirstOrder.Language.{u1, u5}} {L' : FirstOrder.Language.{u3, u4}} {α : Type.{u2}} {β : Type.{u6}} {g : Nat -> Nat}, (forall (n : Nat), (FirstOrder.Language.Term.{u1, u5, u2} L (Sum.{u2, 0} α (Fin n))) -> (FirstOrder.Language.Term.{u3, u4, u6} L' (Sum.{u6, 0} β (Fin (g n))))) -> (forall (n : Nat), (FirstOrder.Language.Relations.{u1, u5} L n) -> (FirstOrder.Language.Relations.{u3, u4} L' n)) -> (forall (n : Nat), (FirstOrder.Language.BoundedFormula.{u3, u4, u6} L' β (g (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne)))))) -> (FirstOrder.Language.BoundedFormula.{u3, u4, u6} L' β (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) (g n) (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne)))))) -> (forall {n : Nat}, (FirstOrder.Language.BoundedFormula.{u1, u5, u2} L α n) -> (FirstOrder.Language.BoundedFormula.{u3, u4, u6} L' β (g n)))
Case conversion may be inaccurate. Consider using '#align first_order.language.bounded_formula.map_term_rel FirstOrder.Language.BoundedFormula.mapTermRelₓ'. -/
/-- Maps bounded formulas along a map of terms and a map of relations. -/
def mapTermRel {g : ℕ → ℕ} (ft : ∀ n, L.term (Sum α (Fin n)) → L'.term (Sum β (Fin (g n))))
    (fr : ∀ n, L.Relations n → L'.Relations n)
    (h : ∀ n, L'.BoundedFormula β (g (n + 1)) → L'.BoundedFormula β (g n + 1)) :
    ∀ {n}, L.BoundedFormula α n → L'.BoundedFormula β (g n)
  | n, falsum => falsum
  | n, equal t₁ t₂ => equal (ft _ t₁) (ft _ t₂)
  | n, Rel R ts => rel (fr _ R) fun i => ft _ (ts i)
  | n, imp φ₁ φ₂ => φ₁.mapTermRel.imp φ₂.mapTermRel
  | n, all φ => (h n φ.mapTermRel).all
#align first_order.language.bounded_formula.map_term_rel FirstOrder.Language.BoundedFormula.mapTermRel

/-- Raises all of the `fin`-indexed variables of a formula greater than or equal to `m` by `n'`. -/
def liftAt : ∀ {n : ℕ} (n' m : ℕ), L.BoundedFormula α n → L.BoundedFormula α (n + n') :=
  fun n n' m φ =>
  φ.mapTermRel (fun k t => t.liftAt n' m) (fun _ => id) fun _ =>
    castLe (by rw [add_assoc, add_comm 1, add_assoc])
#align first_order.language.bounded_formula.lift_at FirstOrder.Language.BoundedFormula.liftAt

@[simp]
theorem mapTermRel_mapTermRel {L'' : Language}
    (ft : ∀ n, L.term (Sum α (Fin n)) → L'.term (Sum β (Fin n)))
    (fr : ∀ n, L.Relations n → L'.Relations n)
    (ft' : ∀ n, L'.term (Sum β (Fin n)) → L''.term (Sum γ (Fin n)))
    (fr' : ∀ n, L'.Relations n → L''.Relations n) {n} (φ : L.BoundedFormula α n) :
    ((φ.mapTermRel ft fr fun _ => id).mapTermRel ft' fr' fun _ => id) =
      φ.mapTermRel (fun _ => ft' _ ∘ ft _) (fun _ => fr' _ ∘ fr _) fun _ => id :=
  by
  induction' φ with _ _ _ _ _ _ _ _ _ _ _ ih1 ih2 _ _ ih3
  · rfl
  · simp [map_term_rel]
  · simp [map_term_rel]
  · simp [map_term_rel, ih1, ih2]
  · simp [map_term_rel, ih3]
#align first_order.language.bounded_formula.map_term_rel_map_term_rel FirstOrder.Language.BoundedFormula.mapTermRel_mapTermRel

@[simp]
theorem mapTermRel_id_id_id {n} (φ : L.BoundedFormula α n) :
    (φ.mapTermRel (fun _ => id) (fun _ => id) fun _ => id) = φ :=
  by
  induction' φ with _ _ _ _ _ _ _ _ _ _ _ ih1 ih2 _ _ ih3
  · rfl
  · simp [map_term_rel]
  · simp [map_term_rel]
  · simp [map_term_rel, ih1, ih2]
  · simp [map_term_rel, ih3]
#align first_order.language.bounded_formula.map_term_rel_id_id_id FirstOrder.Language.BoundedFormula.mapTermRel_id_id_id

/-- An equivalence of bounded formulas given by an equivalence of terms and an equivalence of
relations. -/
@[simps]
def mapTermRelEquiv (ft : ∀ n, L.term (Sum α (Fin n)) ≃ L'.term (Sum β (Fin n)))
    (fr : ∀ n, L.Relations n ≃ L'.Relations n) {n} : L.BoundedFormula α n ≃ L'.BoundedFormula β n :=
  ⟨mapTermRel (fun n => ft n) (fun n => fr n) fun _ => id,
    mapTermRel (fun n => (ft n).symm) (fun n => (fr n).symm) fun _ => id, fun φ => by simp, fun φ =>
    by simp⟩
#align first_order.language.bounded_formula.map_term_rel_equiv FirstOrder.Language.BoundedFormula.mapTermRelEquiv

/-- A function to help relabel the variables in bounded formulas. -/
def relabelAux (g : α → Sum β (Fin n)) (k : ℕ) : Sum α (Fin k) → Sum β (Fin (n + k)) :=
  Sum.map id finSumFinEquiv ∘ Equiv.sumAssoc _ _ _ ∘ Sum.map g id
#align first_order.language.bounded_formula.relabel_aux FirstOrder.Language.BoundedFormula.relabelAux

@[simp]
theorem sum_elim_comp_relabelAux {m : ℕ} {g : α → Sum β (Fin n)} {v : β → M}
    {xs : Fin (n + m) → M} :
    Sum.elim v xs ∘ relabelAux g m = Sum.elim (Sum.elim v (xs ∘ castAdd m) ∘ g) (xs ∘ natAdd n) :=
  by
  ext x
  cases x
  · simp only [bounded_formula.relabel_aux, Function.comp_apply, Sum.map_inl, Sum.elim_inl]
    cases' g x with l r <;> simp
  · simp [bounded_formula.relabel_aux]
#align first_order.language.bounded_formula.sum_elim_comp_relabel_aux FirstOrder.Language.BoundedFormula.sum_elim_comp_relabelAux

@[simp]
theorem relabelAux_sum_inl (k : ℕ) :
    relabelAux (Sum.inl : α → Sum α (Fin n)) k = Sum.map id (natAdd n) :=
  by
  ext x
  cases x <;> · simp [relabel_aux]
#align first_order.language.bounded_formula.relabel_aux_sum_inl FirstOrder.Language.BoundedFormula.relabelAux_sum_inl

/-- Relabels a bounded formula's variables along a particular function. -/
def relabel (g : α → Sum β (Fin n)) {k} (φ : L.BoundedFormula α k) : L.BoundedFormula β (n + k) :=
  φ.mapTermRel (fun _ t => t.relabel (relabelAux g _)) (fun _ => id) fun _ =>
    castLe (ge_of_eq (add_assoc _ _ _))
#align first_order.language.bounded_formula.relabel FirstOrder.Language.BoundedFormula.relabel

/-- Relabels a bounded formula's free variables along a bijection. -/
def relabelEquiv (g : α ≃ β) {k} : L.BoundedFormula α k ≃ L.BoundedFormula β k :=
  mapTermRelEquiv (fun n => Term.relabelEquiv (g.sumCongr (Equiv.refl _))) fun n => Equiv.refl _
#align first_order.language.bounded_formula.relabel_equiv FirstOrder.Language.BoundedFormula.relabelEquiv

@[simp]
theorem relabel_falsum (g : α → Sum β (Fin n)) {k} :
    (falsum : L.BoundedFormula α k).relabel g = falsum :=
  rfl
#align first_order.language.bounded_formula.relabel_falsum FirstOrder.Language.BoundedFormula.relabel_falsum

@[simp]
theorem relabel_bot (g : α → Sum β (Fin n)) {k} : (⊥ : L.BoundedFormula α k).relabel g = ⊥ :=
  rfl
#align first_order.language.bounded_formula.relabel_bot FirstOrder.Language.BoundedFormula.relabel_bot

@[simp]
theorem relabel_imp (g : α → Sum β (Fin n)) {k} (φ ψ : L.BoundedFormula α k) :
    (φ.imp ψ).relabel g = (φ.relabel g).imp (ψ.relabel g) :=
  rfl
#align first_order.language.bounded_formula.relabel_imp FirstOrder.Language.BoundedFormula.relabel_imp

@[simp]
theorem relabel_not (g : α → Sum β (Fin n)) {k} (φ : L.BoundedFormula α k) :
    φ.Not.relabel g = (φ.relabel g).Not := by simp [bounded_formula.not]
#align first_order.language.bounded_formula.relabel_not FirstOrder.Language.BoundedFormula.relabel_not

@[simp]
theorem relabel_all (g : α → Sum β (Fin n)) {k} (φ : L.BoundedFormula α (k + 1)) :
    φ.all.relabel g = (φ.relabel g).all :=
  by
  rw [relabel, map_term_rel, relabel]
  simp
#align first_order.language.bounded_formula.relabel_all FirstOrder.Language.BoundedFormula.relabel_all

@[simp]
theorem relabel_ex (g : α → Sum β (Fin n)) {k} (φ : L.BoundedFormula α (k + 1)) :
    φ.ex.relabel g = (φ.relabel g).ex := by simp [bounded_formula.ex]
#align first_order.language.bounded_formula.relabel_ex FirstOrder.Language.BoundedFormula.relabel_ex

@[simp]
theorem relabel_sum_inl (φ : L.BoundedFormula α n) :
    (φ.relabel Sum.inl : L.BoundedFormula α (0 + n)) = φ.castLe (ge_of_eq (zero_add n)) :=
  by
  simp only [relabel, relabel_aux_sum_inl]
  induction' φ with _ _ _ _ _ _ _ _ _ _ _ ih1 ih2 _ _ ih3
  · rfl
  · simp [Fin.natAdd_zero, cast_le_of_eq, map_term_rel]
  · simp [Fin.natAdd_zero, cast_le_of_eq, map_term_rel]
  · simp [map_term_rel, ih1, ih2]
  · simp [map_term_rel, ih3, cast_le]
#align first_order.language.bounded_formula.relabel_sum_inl FirstOrder.Language.BoundedFormula.relabel_sum_inl

/-- Substitutes the variables in a given formula with terms. -/
@[simp]
def subst {n : ℕ} (φ : L.BoundedFormula α n) (f : α → L.term β) : L.BoundedFormula β n :=
  φ.mapTermRel (fun _ t => t.subst (Sum.elim (Term.relabel Sum.inl ∘ f) (var ∘ Sum.inr)))
    (fun _ => id) fun _ => id
#align first_order.language.bounded_formula.subst FirstOrder.Language.BoundedFormula.subst

/-- A bijection sending formulas with constants to formulas with extra variables. -/
def constantsVarsEquiv : L[[γ]].BoundedFormula α n ≃ L.BoundedFormula (Sum γ α) n :=
  mapTermRelEquiv (fun _ => Term.constantsVarsEquivLeft) fun _ => Equiv.sumEmpty _ _
#align first_order.language.bounded_formula.constants_vars_equiv FirstOrder.Language.BoundedFormula.constantsVarsEquiv

/- warning: first_order.language.bounded_formula.to_formula -> FirstOrder.Language.BoundedFormula.toFormula is a dubious translation:
lean 3 declaration is
  forall {L : FirstOrder.Language.{u1, u2}} {α : Type.{u3}} {n : Nat}, (FirstOrder.Language.BoundedFormula.{u1, u2, u3} L α n) -> (FirstOrder.Language.Formula.{u1, u2, u3} L (Sum.{u3, 0} α (Fin n)))
but is expected to have type
  forall {L : FirstOrder.Language.{u1, u3}} {α : Type.{u2}} {n : Nat}, (FirstOrder.Language.BoundedFormula.{u1, u3, u2} L α n) -> (FirstOrder.Language.Formula.{u1, u3, u2} L (Sum.{u2, 0} α (Fin n)))
Case conversion may be inaccurate. Consider using '#align first_order.language.bounded_formula.to_formula FirstOrder.Language.BoundedFormula.toFormulaₓ'. -/
/-- Turns the extra variables of a bounded formula into free variables. -/
@[simp]
def toFormula : ∀ {n : ℕ}, L.BoundedFormula α n → L.Formula (Sum α (Fin n))
  | n, falsum => falsum
  | n, equal t₁ t₂ => t₁.equal t₂
  | n, Rel R ts => R.Formula ts
  | n, imp φ₁ φ₂ => φ₁.toFormula.imp φ₂.toFormula
  | n, all φ =>
    (φ.toFormula.relabel
        (Sum.elim (Sum.inl ∘ Sum.inl) (Sum.map Sum.inr id ∘ finSumFinEquiv.symm))).all
#align first_order.language.bounded_formula.to_formula FirstOrder.Language.BoundedFormula.toFormula

variable {l : ℕ} {φ ψ : L.BoundedFormula α l} {θ : L.BoundedFormula α l.succ}

variable {v : α → M} {xs : Fin l → M}

/-- An atomic formula is either equality or a relation symbol applied to terms.
  Note that `⊥` and `⊤` are not considered atomic in this convention. -/
inductive IsAtomic : L.BoundedFormula α n → Prop
  | equal (t₁ t₂ : L.term (Sum α (Fin n))) : IsAtomic (bdEqual t₁ t₂)
  |
  Rel {l : ℕ} (R : L.Relations l) (ts : Fin l → L.term (Sum α (Fin n))) :
    IsAtomic (R.BoundedFormula ts)
#align first_order.language.bounded_formula.is_atomic FirstOrder.Language.BoundedFormula.IsAtomic

theorem not_all_isAtomic (φ : L.BoundedFormula α (n + 1)) : ¬φ.all.IsAtomic := fun con => by
  cases Con
#align first_order.language.bounded_formula.not_all_is_atomic FirstOrder.Language.BoundedFormula.not_all_isAtomic

theorem not_ex_isAtomic (φ : L.BoundedFormula α (n + 1)) : ¬φ.ex.IsAtomic := fun con => by cases Con
#align first_order.language.bounded_formula.not_ex_is_atomic FirstOrder.Language.BoundedFormula.not_ex_isAtomic

theorem IsAtomic.relabel {m : ℕ} {φ : L.BoundedFormula α m} (h : φ.IsAtomic)
    (f : α → Sum β (Fin n)) : (φ.relabel f).IsAtomic :=
  IsAtomic.rec_on h (fun _ _ => IsAtomic.equal _ _) fun _ _ _ => IsAtomic.rel _ _
#align first_order.language.bounded_formula.is_atomic.relabel FirstOrder.Language.BoundedFormula.IsAtomic.relabel

theorem IsAtomic.liftAt {k m : ℕ} (h : IsAtomic φ) : (φ.liftAt k m).IsAtomic :=
  IsAtomic.rec_on h (fun _ _ => IsAtomic.equal _ _) fun _ _ _ => IsAtomic.rel _ _
#align first_order.language.bounded_formula.is_atomic.lift_at FirstOrder.Language.BoundedFormula.IsAtomic.liftAt

theorem IsAtomic.castLe {h : l ≤ n} (hφ : IsAtomic φ) : (φ.castLe h).IsAtomic :=
  IsAtomic.rec_on hφ (fun _ _ => IsAtomic.equal _ _) fun _ _ _ => IsAtomic.rel _ _
#align first_order.language.bounded_formula.is_atomic.cast_le FirstOrder.Language.BoundedFormula.IsAtomic.castLe

/-- A quantifier-free formula is a formula defined without quantifiers. These are all equivalent
to boolean combinations of atomic formulas. -/
inductive IsQf : L.BoundedFormula α n → Prop
  | falsum : is_qf falsum
  | of_is_atomic {φ} (h : IsAtomic φ) : is_qf φ
  | imp {φ₁ φ₂} (h₁ : is_qf φ₁) (h₂ : is_qf φ₂) : is_qf (φ₁.imp φ₂)
#align first_order.language.bounded_formula.is_qf FirstOrder.Language.BoundedFormula.IsQf

theorem IsAtomic.isQf {φ : L.BoundedFormula α n} : IsAtomic φ → IsQf φ :=
  IsQf.of_is_atomic
#align first_order.language.bounded_formula.is_atomic.is_qf FirstOrder.Language.BoundedFormula.IsAtomic.isQf

theorem isQf_bot : IsQf (⊥ : L.BoundedFormula α n) :=
  IsQf.falsum
#align first_order.language.bounded_formula.is_qf_bot FirstOrder.Language.BoundedFormula.isQf_bot

theorem IsQf.not {φ : L.BoundedFormula α n} (h : IsQf φ) : IsQf φ.Not :=
  h.imp isQf_bot
#align first_order.language.bounded_formula.is_qf.not FirstOrder.Language.BoundedFormula.IsQf.not

theorem IsQf.relabel {m : ℕ} {φ : L.BoundedFormula α m} (h : φ.IsQf) (f : α → Sum β (Fin n)) :
    (φ.relabel f).IsQf :=
  IsQf.rec_on h isQf_bot (fun _ h => (h.relabel f).IsQf) fun _ _ _ _ h1 h2 => h1.imp h2
#align first_order.language.bounded_formula.is_qf.relabel FirstOrder.Language.BoundedFormula.IsQf.relabel

theorem IsQf.liftAt {k m : ℕ} (h : IsQf φ) : (φ.liftAt k m).IsQf :=
  IsQf.rec_on h isQf_bot (fun _ ih => ih.liftAt.IsQf) fun _ _ _ _ ih1 ih2 => ih1.imp ih2
#align first_order.language.bounded_formula.is_qf.lift_at FirstOrder.Language.BoundedFormula.IsQf.liftAt

theorem IsQf.castLe {h : l ≤ n} (hφ : IsQf φ) : (φ.castLe h).IsQf :=
  IsQf.rec_on hφ isQf_bot (fun _ ih => ih.castLe.IsQf) fun _ _ _ _ ih1 ih2 => ih1.imp ih2
#align first_order.language.bounded_formula.is_qf.cast_le FirstOrder.Language.BoundedFormula.IsQf.castLe

theorem not_all_isQf (φ : L.BoundedFormula α (n + 1)) : ¬φ.all.IsQf := fun con =>
  by
  cases' Con with _ con
  exact φ.not_all_is_atomic Con
#align first_order.language.bounded_formula.not_all_is_qf FirstOrder.Language.BoundedFormula.not_all_isQf

theorem not_ex_isQf (φ : L.BoundedFormula α (n + 1)) : ¬φ.ex.IsQf := fun con =>
  by
  cases' Con with _ con _ _ con
  · exact φ.not_ex_is_atomic Con
  · exact not_all_is_qf _ Con
#align first_order.language.bounded_formula.not_ex_is_qf FirstOrder.Language.BoundedFormula.not_ex_isQf

/-- Indicates that a bounded formula is in prenex normal form - that is, it consists of quantifiers
  applied to a quantifier-free formula. -/
inductive IsPrenex : ∀ {n}, L.BoundedFormula α n → Prop
  | of_is_qf {n} {φ : L.BoundedFormula α n} (h : IsQf φ) : is_prenex φ
  | all {n} {φ : L.BoundedFormula α (n + 1)} (h : is_prenex φ) : is_prenex φ.all
  | ex {n} {φ : L.BoundedFormula α (n + 1)} (h : is_prenex φ) : is_prenex φ.ex
#align first_order.language.bounded_formula.is_prenex FirstOrder.Language.BoundedFormula.IsPrenex

theorem IsQf.isPrenex {φ : L.BoundedFormula α n} : IsQf φ → IsPrenex φ :=
  IsPrenex.of_is_qf
#align first_order.language.bounded_formula.is_qf.is_prenex FirstOrder.Language.BoundedFormula.IsQf.isPrenex

theorem IsAtomic.isPrenex {φ : L.BoundedFormula α n} (h : IsAtomic φ) : IsPrenex φ :=
  h.IsQf.IsPrenex
#align first_order.language.bounded_formula.is_atomic.is_prenex FirstOrder.Language.BoundedFormula.IsAtomic.isPrenex

theorem IsPrenex.induction_on_all_not {P : ∀ {n}, L.BoundedFormula α n → Prop}
    {φ : L.BoundedFormula α n} (h : IsPrenex φ)
    (hq : ∀ {m} {ψ : L.BoundedFormula α m}, ψ.IsQf → P ψ)
    (ha : ∀ {m} {ψ : L.BoundedFormula α (m + 1)}, P ψ → P ψ.all)
    (hn : ∀ {m} {ψ : L.BoundedFormula α m}, P ψ → P ψ.Not) : P φ :=
  IsPrenex.rec_on h (fun _ _ => hq) (fun _ _ _ => ha) fun _ _ _ ih => hn (ha (hn ih))
#align first_order.language.bounded_formula.is_prenex.induction_on_all_not FirstOrder.Language.BoundedFormula.IsPrenex.induction_on_all_not

theorem IsPrenex.relabel {m : ℕ} {φ : L.BoundedFormula α m} (h : φ.IsPrenex)
    (f : α → Sum β (Fin n)) : (φ.relabel f).IsPrenex :=
  IsPrenex.rec_on h (fun _ _ h => (h.relabel f).IsPrenex) (fun _ _ _ h => by simp [h.all])
    fun _ _ _ h => by simp [h.ex]
#align first_order.language.bounded_formula.is_prenex.relabel FirstOrder.Language.BoundedFormula.IsPrenex.relabel

theorem IsPrenex.castLe (hφ : IsPrenex φ) : ∀ {n} {h : l ≤ n}, (φ.castLe h).IsPrenex :=
  IsPrenex.rec_on hφ (fun _ _ ih _ _ => ih.castLe.IsPrenex) (fun _ _ _ ih _ _ => ih.all)
    fun _ _ _ ih _ _ => ih.ex
#align first_order.language.bounded_formula.is_prenex.cast_le FirstOrder.Language.BoundedFormula.IsPrenex.castLe

theorem IsPrenex.liftAt {k m : ℕ} (h : IsPrenex φ) : (φ.liftAt k m).IsPrenex :=
  IsPrenex.rec_on h (fun _ _ ih => ih.liftAt.IsPrenex) (fun _ _ _ ih => ih.castLe.all)
    fun _ _ _ ih => ih.castLe.ex
#align first_order.language.bounded_formula.is_prenex.lift_at FirstOrder.Language.BoundedFormula.IsPrenex.liftAt

/- warning: first_order.language.bounded_formula.to_prenex_imp_right -> FirstOrder.Language.BoundedFormula.toPrenexImpRight is a dubious translation:
lean 3 declaration is
  forall {L : FirstOrder.Language.{u1, u2}} {α : Type.{u3}} {n : Nat}, (FirstOrder.Language.BoundedFormula.{u1, u2, u3} L α n) -> (FirstOrder.Language.BoundedFormula.{u1, u2, u3} L α n) -> (FirstOrder.Language.BoundedFormula.{u1, u2, u3} L α n)
but is expected to have type
  forall {L : FirstOrder.Language.{u1, u3}} {α : Type.{u2}} {n : Nat}, (FirstOrder.Language.BoundedFormula.{u1, u3, u2} L α n) -> (FirstOrder.Language.BoundedFormula.{u1, u3, u2} L α n) -> (FirstOrder.Language.BoundedFormula.{u1, u3, u2} L α n)
Case conversion may be inaccurate. Consider using '#align first_order.language.bounded_formula.to_prenex_imp_right FirstOrder.Language.BoundedFormula.toPrenexImpRightₓ'. -/
/-- An auxiliary operation to `first_order.language.bounded_formula.to_prenex`.
  If `φ` is quantifier-free and `ψ` is in prenex normal form, then `φ.to_prenex_imp_right ψ`
  is a prenex normal form for `φ.imp ψ`. -/
def toPrenexImpRight : ∀ {n}, L.BoundedFormula α n → L.BoundedFormula α n → L.BoundedFormula α n
  | n, φ, bounded_formula.ex ψ => ((φ.liftAt 1 n).toPrenexImpRight ψ).ex
  | n, φ, all ψ => ((φ.liftAt 1 n).toPrenexImpRight ψ).all
  | n, φ, ψ => φ.imp ψ
#align first_order.language.bounded_formula.to_prenex_imp_right FirstOrder.Language.BoundedFormula.toPrenexImpRight

theorem IsQf.toPrenexImpRight {φ : L.BoundedFormula α n} :
    ∀ {ψ : L.BoundedFormula α n}, IsQf ψ → φ.toPrenexImpRight ψ = φ.imp ψ
  | _, is_qf.falsum => rfl
  | _, is_qf.of_is_atomic (is_atomic.equal _ _) => rfl
  | _, is_qf.of_is_atomic (is_atomic.rel _ _) => rfl
  | _, is_qf.imp is_qf.falsum _ => rfl
  | _, is_qf.imp (is_qf.of_is_atomic (is_atomic.equal _ _)) _ => rfl
  | _, is_qf.imp (is_qf.of_is_atomic (is_atomic.rel _ _)) _ => rfl
  | _, is_qf.imp (is_qf.imp _ _) _ => rfl
#align first_order.language.bounded_formula.is_qf.to_prenex_imp_right FirstOrder.Language.BoundedFormula.IsQf.toPrenexImpRight

theorem isPrenex_toPrenexImpRight {φ ψ : L.BoundedFormula α n} (hφ : IsQf φ) (hψ : IsPrenex ψ) :
    IsPrenex (φ.toPrenexImpRight ψ) :=
  by
  induction' hψ with _ _ hψ _ _ _ ih1 _ _ _ ih2
  · rw [hψ.to_prenex_imp_right]
    exact (hφ.imp hψ).IsPrenex
  · exact (ih1 hφ.lift_at).all
  · exact (ih2 hφ.lift_at).ex
#align first_order.language.bounded_formula.is_prenex_to_prenex_imp_right FirstOrder.Language.BoundedFormula.isPrenex_toPrenexImpRight

/- warning: first_order.language.bounded_formula.to_prenex_imp -> FirstOrder.Language.BoundedFormula.toPrenexImp is a dubious translation:
lean 3 declaration is
  forall {L : FirstOrder.Language.{u1, u2}} {α : Type.{u3}} {n : Nat}, (FirstOrder.Language.BoundedFormula.{u1, u2, u3} L α n) -> (FirstOrder.Language.BoundedFormula.{u1, u2, u3} L α n) -> (FirstOrder.Language.BoundedFormula.{u1, u2, u3} L α n)
but is expected to have type
  forall {L : FirstOrder.Language.{u1, u3}} {α : Type.{u2}} {n : Nat}, (FirstOrder.Language.BoundedFormula.{u1, u3, u2} L α n) -> (FirstOrder.Language.BoundedFormula.{u1, u3, u2} L α n) -> (FirstOrder.Language.BoundedFormula.{u1, u3, u2} L α n)
Case conversion may be inaccurate. Consider using '#align first_order.language.bounded_formula.to_prenex_imp FirstOrder.Language.BoundedFormula.toPrenexImpₓ'. -/
/-- An auxiliary operation to `first_order.language.bounded_formula.to_prenex`.
  If `φ` and `ψ` are in prenex normal form, then `φ.to_prenex_imp ψ`
  is a prenex normal form for `φ.imp ψ`. -/
def toPrenexImp : ∀ {n}, L.BoundedFormula α n → L.BoundedFormula α n → L.BoundedFormula α n
  | n, bounded_formula.ex φ, ψ => (φ.toPrenexImp (ψ.liftAt 1 n)).all
  | n, all φ, ψ => (φ.toPrenexImp (ψ.liftAt 1 n)).ex
  | _, φ, ψ => φ.toPrenexImpRight ψ
#align first_order.language.bounded_formula.to_prenex_imp FirstOrder.Language.BoundedFormula.toPrenexImp

theorem IsQf.toPrenexImp :
    ∀ {φ ψ : L.BoundedFormula α n}, φ.IsQf → φ.toPrenexImp ψ = φ.toPrenexImpRight ψ
  | _, _, is_qf.falsum => rfl
  | _, _, is_qf.of_is_atomic (is_atomic.equal _ _) => rfl
  | _, _, is_qf.of_is_atomic (is_atomic.rel _ _) => rfl
  | _, _, is_qf.imp is_qf.falsum _ => rfl
  | _, _, is_qf.imp (is_qf.of_is_atomic (is_atomic.equal _ _)) _ => rfl
  | _, _, is_qf.imp (is_qf.of_is_atomic (is_atomic.rel _ _)) _ => rfl
  | _, _, is_qf.imp (is_qf.imp _ _) _ => rfl
#align first_order.language.bounded_formula.is_qf.to_prenex_imp FirstOrder.Language.BoundedFormula.IsQf.toPrenexImp

theorem isPrenex_toPrenexImp {φ ψ : L.BoundedFormula α n} (hφ : IsPrenex φ) (hψ : IsPrenex ψ) :
    IsPrenex (φ.toPrenexImp ψ) :=
  by
  induction' hφ with _ _ hφ _ _ _ ih1 _ _ _ ih2
  · rw [hφ.to_prenex_imp]
    exact is_prenex_to_prenex_imp_right hφ hψ
  · exact (ih1 hψ.lift_at).ex
  · exact (ih2 hψ.lift_at).all
#align first_order.language.bounded_formula.is_prenex_to_prenex_imp FirstOrder.Language.BoundedFormula.isPrenex_toPrenexImp

/- warning: first_order.language.bounded_formula.to_prenex -> FirstOrder.Language.BoundedFormula.toPrenex is a dubious translation:
lean 3 declaration is
  forall {L : FirstOrder.Language.{u1, u2}} {α : Type.{u3}} {n : Nat}, (FirstOrder.Language.BoundedFormula.{u1, u2, u3} L α n) -> (FirstOrder.Language.BoundedFormula.{u1, u2, u3} L α n)
but is expected to have type
  forall {L : FirstOrder.Language.{u1, u3}} {α : Type.{u2}} {n : Nat}, (FirstOrder.Language.BoundedFormula.{u1, u3, u2} L α n) -> (FirstOrder.Language.BoundedFormula.{u1, u3, u2} L α n)
Case conversion may be inaccurate. Consider using '#align first_order.language.bounded_formula.to_prenex FirstOrder.Language.BoundedFormula.toPrenexₓ'. -/
/-- For any bounded formula `φ`, `φ.to_prenex` is a semantically-equivalent formula in prenex normal
  form. -/
def toPrenex : ∀ {n}, L.BoundedFormula α n → L.BoundedFormula α n
  | _, falsum => ⊥
  | _, equal t₁ t₂ => t₁.bdEqual t₂
  | _, Rel R ts => rel R ts
  | _, imp f₁ f₂ => f₁.toPrenex.toPrenexImp f₂.toPrenex
  | _, all f => f.toPrenex.all
#align first_order.language.bounded_formula.to_prenex FirstOrder.Language.BoundedFormula.toPrenex

theorem toPrenex_isPrenex (φ : L.BoundedFormula α n) : φ.toPrenex.IsPrenex :=
  BoundedFormula.recOn φ (fun _ => isQf_bot.IsPrenex) (fun _ _ _ => (IsAtomic.equal _ _).IsPrenex)
    (fun _ _ _ _ => (IsAtomic.rel _ _).IsPrenex) (fun _ _ _ h1 h2 => isPrenex_toPrenexImp h1 h2)
    fun _ _ => IsPrenex.all
#align first_order.language.bounded_formula.to_prenex_is_prenex FirstOrder.Language.BoundedFormula.toPrenex_isPrenex

end BoundedFormula

namespace Lhom

open BoundedFormula

/- warning: first_order.language.Lhom.on_bounded_formula -> FirstOrder.Language.Lhom.onBoundedFormula is a dubious translation:
lean 3 declaration is
  forall {L : FirstOrder.Language.{u1, u2}} {L' : FirstOrder.Language.{u4, u5}} {α : Type.{u3}}, (FirstOrder.Language.Lhom.{u1, u2, u4, u5} L L') -> (forall {k : Nat}, (FirstOrder.Language.BoundedFormula.{u1, u2, u3} L α k) -> (FirstOrder.Language.BoundedFormula.{u4, u5, u3} L' α k))
but is expected to have type
  forall {L : FirstOrder.Language.{u1, u5}} {L' : FirstOrder.Language.{u3, u4}} {α : Type.{u2}}, (FirstOrder.Language.Lhom.{u1, u5, u3, u4} L L') -> (forall {k : Nat}, (FirstOrder.Language.BoundedFormula.{u1, u5, u2} L α k) -> (FirstOrder.Language.BoundedFormula.{u3, u4, u2} L' α k))
Case conversion may be inaccurate. Consider using '#align first_order.language.Lhom.on_bounded_formula FirstOrder.Language.Lhom.onBoundedFormulaₓ'. -/
/-- Maps a bounded formula's symbols along a language map. -/
@[simp]
def onBoundedFormula (g : L →ᴸ L') : ∀ {k : ℕ}, L.BoundedFormula α k → L'.BoundedFormula α k
  | k, falsum => falsum
  | k, equal t₁ t₂ => (g.onTerm t₁).bdEqual (g.onTerm t₂)
  | k, Rel R ts => (g.onRelation R).BoundedFormula (g.onTerm ∘ ts)
  | k, imp f₁ f₂ => (on_bounded_formula f₁).imp (on_bounded_formula f₂)
  | k, all f => (on_bounded_formula f).all
#align first_order.language.Lhom.on_bounded_formula FirstOrder.Language.Lhom.onBoundedFormula

@[simp]
theorem id_onBoundedFormula :
    ((Lhom.id L).onBoundedFormula : L.BoundedFormula α n → L.BoundedFormula α n) = id :=
  by
  ext f
  induction' f with _ _ _ _ _ _ _ _ _ _ _ ih1 ih2 _ _ ih3
  · rfl
  · rw [on_bounded_formula, Lhom.id_on_term, id.def, id.def, id.def, bd_equal]
  · rw [on_bounded_formula, Lhom.id_on_term]
    rfl
  · rw [on_bounded_formula, ih1, ih2, id.def, id.def, id.def]
  · rw [on_bounded_formula, ih3, id.def, id.def]
#align first_order.language.Lhom.id_on_bounded_formula FirstOrder.Language.Lhom.id_onBoundedFormula

@[simp]
theorem comp_onBoundedFormula {L'' : Language} (φ : L' →ᴸ L'') (ψ : L →ᴸ L') :
    ((φ.comp ψ).onBoundedFormula : L.BoundedFormula α n → L''.BoundedFormula α n) =
      φ.onBoundedFormula ∘ ψ.onBoundedFormula :=
  by
  ext f
  induction' f with _ _ _ _ _ _ _ _ _ _ _ ih1 ih2 _ _ ih3
  · rfl
  · simp only [on_bounded_formula, comp_on_term, Function.comp_apply]
    rfl
  · simp only [on_bounded_formula, comp_on_relation, comp_on_term, Function.comp_apply]
    rfl
  · simp only [on_bounded_formula, Function.comp_apply, ih1, ih2, eq_self_iff_true, and_self_iff]
  · simp only [ih3, on_bounded_formula, Function.comp_apply]
#align first_order.language.Lhom.comp_on_bounded_formula FirstOrder.Language.Lhom.comp_onBoundedFormula

/-- Maps a formula's symbols along a language map. -/
def onFormula (g : L →ᴸ L') : L.Formula α → L'.Formula α :=
  g.onBoundedFormula
#align first_order.language.Lhom.on_formula FirstOrder.Language.Lhom.onFormula

/-- Maps a sentence's symbols along a language map. -/
def onSentence (g : L →ᴸ L') : L.Sentence → L'.Sentence :=
  g.onFormula
#align first_order.language.Lhom.on_sentence FirstOrder.Language.Lhom.onSentence

/-- Maps a theory's symbols along a language map. -/
def onTheory (g : L →ᴸ L') (T : L.Theory) : L'.Theory :=
  g.onSentence '' T
#align first_order.language.Lhom.on_Theory FirstOrder.Language.Lhom.onTheory

@[simp]
theorem mem_onTheory {g : L →ᴸ L'} {T : L.Theory} {φ : L'.Sentence} :
    φ ∈ g.onTheory T ↔ ∃ φ₀, φ₀ ∈ T ∧ g.onSentence φ₀ = φ :=
  Set.mem_image _ _ _
#align first_order.language.Lhom.mem_on_Theory FirstOrder.Language.Lhom.mem_onTheory

end Lhom

namespace Lequiv

/-- Maps a bounded formula's symbols along a language equivalence. -/
@[simps]
def onBoundedFormula (φ : L ≃ᴸ L') : L.BoundedFormula α n ≃ L'.BoundedFormula α n
    where
  toFun := φ.toLhom.onBoundedFormula
  invFun := φ.invLhom.onBoundedFormula
  left_inv := by
    rw [Function.leftInverse_iff_comp, ← Lhom.comp_on_bounded_formula, φ.left_inv,
      Lhom.id_on_bounded_formula]
  right_inv := by
    rw [Function.rightInverse_iff_comp, ← Lhom.comp_on_bounded_formula, φ.right_inv,
      Lhom.id_on_bounded_formula]
#align first_order.language.Lequiv.on_bounded_formula FirstOrder.Language.Lequiv.onBoundedFormula

theorem onBoundedFormula_symm (φ : L ≃ᴸ L') :
    (φ.onBoundedFormula.symm : L'.BoundedFormula α n ≃ L.BoundedFormula α n) =
      φ.symm.onBoundedFormula :=
  rfl
#align first_order.language.Lequiv.on_bounded_formula_symm FirstOrder.Language.Lequiv.onBoundedFormula_symm

/-- Maps a formula's symbols along a language equivalence. -/
def onFormula (φ : L ≃ᴸ L') : L.Formula α ≃ L'.Formula α :=
  φ.onBoundedFormula
#align first_order.language.Lequiv.on_formula FirstOrder.Language.Lequiv.onFormula

@[simp]
theorem onFormula_apply (φ : L ≃ᴸ L') :
    (φ.onFormula : L.Formula α → L'.Formula α) = φ.toLhom.onFormula :=
  rfl
#align first_order.language.Lequiv.on_formula_apply FirstOrder.Language.Lequiv.onFormula_apply

@[simp]
theorem onFormula_symm (φ : L ≃ᴸ L') :
    (φ.onFormula.symm : L'.Formula α ≃ L.Formula α) = φ.symm.onFormula :=
  rfl
#align first_order.language.Lequiv.on_formula_symm FirstOrder.Language.Lequiv.onFormula_symm

/-- Maps a sentence's symbols along a language equivalence. -/
@[simps]
def onSentence (φ : L ≃ᴸ L') : L.Sentence ≃ L'.Sentence :=
  φ.onFormula
#align first_order.language.Lequiv.on_sentence FirstOrder.Language.Lequiv.onSentence

end Lequiv

-- mathport name: term.bd_equal
scoped[FirstOrder] infixl:88 " =' " => FirstOrder.Language.Term.bdEqual

-- mathport name: bounded_formula.imp
-- input \~- or \simeq
scoped[FirstOrder] infixr:62 " ⟹ " => FirstOrder.Language.BoundedFormula.imp

-- mathport name: bounded_formula.all
-- input \==>
scoped[FirstOrder] prefix:110 "∀'" => FirstOrder.Language.BoundedFormula.all

-- mathport name: bounded_formula.not
scoped[FirstOrder] prefix:arg "∼" => FirstOrder.Language.BoundedFormula.not

-- mathport name: bounded_formula.iff
-- input \~, the ASCII character ~ has too low precedence
scoped[FirstOrder] infixl:61 " ⇔ " => FirstOrder.Language.BoundedFormula.iff

-- mathport name: bounded_formula.ex
-- input \<=>
scoped[FirstOrder] prefix:110 "∃'" => FirstOrder.Language.BoundedFormula.ex

-- input \ex
namespace Formula

/-- Relabels a formula's variables along a particular function. -/
def relabel (g : α → β) : L.Formula α → L.Formula β :=
  @BoundedFormula.relabel _ _ _ 0 (Sum.inl ∘ g) 0
#align first_order.language.formula.relabel FirstOrder.Language.Formula.relabel

/-- The graph of a function as a first-order formula. -/
def graph (f : L.Functions n) : L.Formula (Fin (n + 1)) :=
  equal (var 0) (func f fun i => var i.succ)
#align first_order.language.formula.graph FirstOrder.Language.Formula.graph

/-- The negation of a formula. -/
protected def not (φ : L.Formula α) : L.Formula α :=
  φ.Not
#align first_order.language.formula.not FirstOrder.Language.Formula.not

/-- The implication between formulas, as a formula. -/
protected def imp : L.Formula α → L.Formula α → L.Formula α :=
  BoundedFormula.imp
#align first_order.language.formula.imp FirstOrder.Language.Formula.imp

/-- The biimplication between formulas, as a formula. -/
protected def iff (φ ψ : L.Formula α) : L.Formula α :=
  φ.Iff ψ
#align first_order.language.formula.iff FirstOrder.Language.Formula.iff

theorem isAtomic_graph (f : L.Functions n) : (graph f).IsAtomic :=
  BoundedFormula.IsAtomic.equal _ _
#align first_order.language.formula.is_atomic_graph FirstOrder.Language.Formula.isAtomic_graph

/-- A bijection sending formulas to sentences with constants. -/
def equivSentence : L.Formula α ≃ L[[α]].Sentence :=
  (BoundedFormula.constantsVarsEquiv.trans (BoundedFormula.relabelEquiv (Equiv.sumEmpty _ _))).symm
#align first_order.language.formula.equiv_sentence FirstOrder.Language.Formula.equivSentence

theorem equivSentence_not (φ : L.Formula α) : equivSentence φ.Not = (equivSentence φ).Not :=
  rfl
#align first_order.language.formula.equiv_sentence_not FirstOrder.Language.Formula.equivSentence_not

theorem equivSentence_inf (φ ψ : L.Formula α) :
    equivSentence (φ ⊓ ψ) = equivSentence φ ⊓ equivSentence ψ :=
  rfl
#align first_order.language.formula.equiv_sentence_inf FirstOrder.Language.Formula.equivSentence_inf

end Formula

namespace Relations

variable (r : L.Relations 2)

/-- The sentence indicating that a basic relation symbol is reflexive. -/
protected def reflexive : L.Sentence :=
  ∀'r.boundedFormula₂ (&0) &0
#align first_order.language.relations.reflexive FirstOrder.Language.Relations.reflexive

/-- The sentence indicating that a basic relation symbol is irreflexive. -/
protected def irreflexive : L.Sentence :=
  ∀'∼(r.boundedFormula₂ (&0) &0)
#align first_order.language.relations.irreflexive FirstOrder.Language.Relations.irreflexive

/-- The sentence indicating that a basic relation symbol is symmetric. -/
protected def symmetric : L.Sentence :=
  ∀'∀'(r.boundedFormula₂ (&0) &1 ⟹ r.boundedFormula₂ (&1) &0)
#align first_order.language.relations.symmetric FirstOrder.Language.Relations.symmetric

/-- The sentence indicating that a basic relation symbol is antisymmetric. -/
protected def antisymmetric : L.Sentence :=
  ∀'∀'(r.boundedFormula₂ (&0) &1 ⟹ r.boundedFormula₂ (&1) &0 ⟹ Term.bdEqual (&0) &1)
#align first_order.language.relations.antisymmetric FirstOrder.Language.Relations.antisymmetric

/-- The sentence indicating that a basic relation symbol is transitive. -/
protected def transitive : L.Sentence :=
  ∀'∀'∀'(r.boundedFormula₂ (&0) &1 ⟹ r.boundedFormula₂ (&1) &2 ⟹ r.boundedFormula₂ (&0) &2)
#align first_order.language.relations.transitive FirstOrder.Language.Relations.transitive

/-- The sentence indicating that a basic relation symbol is total. -/
protected def total : L.Sentence :=
  ∀'∀'(r.boundedFormula₂ (&0) &1 ⊔ r.boundedFormula₂ (&1) &0)
#align first_order.language.relations.total FirstOrder.Language.Relations.total

end Relations

section Cardinality

variable (L)

/-- A sentence indicating that a structure has `n` distinct elements. -/
protected def Sentence.cardGe (n) : L.Sentence :=
  (((((List.finRange n).product (List.finRange n)).filterₓ fun ij : _ × _ => ij.1 ≠ ij.2).map
          fun ij : _ × _ => ∼((&ij.1).bdEqual &ij.2)).foldr
      (· ⊓ ·) ⊤).exs
#align first_order.language.sentence.card_ge FirstOrder.Language.Sentence.cardGe

/-- A theory indicating that a structure is infinite. -/
def infiniteTheory : L.Theory :=
  Set.range (Sentence.cardGe L)
#align first_order.language.infinite_theory FirstOrder.Language.infiniteTheory

/-- A theory that indicates a structure is nonempty. -/
def nonemptyTheory : L.Theory :=
  {Sentence.cardGe L 1}
#align first_order.language.nonempty_theory FirstOrder.Language.nonemptyTheory

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/-- A theory indicating that each of a set of constants is distinct. -/
def distinctConstantsTheory (s : Set α) : L[[α]].Theory :=
  (fun ab : α × α => ((L.con ab.1).term.equal (L.con ab.2).term).Not) '' (s ×ˢ s ∩ Set.diagonal αᶜ)
#align first_order.language.distinct_constants_theory FirstOrder.Language.distinctConstantsTheory

variable {L} {α}

open Set

theorem monotone_distinctConstantsTheory :
    Monotone (L.distinctConstantsTheory : Set α → L[[α]].Theory) := fun s t st =>
  image_subset _ (inter_subset_inter_left _ (prod_mono st st))
#align first_order.language.monotone_distinct_constants_theory FirstOrder.Language.monotone_distinctConstantsTheory

theorem directed_distinctConstantsTheory :
    Directed (· ⊆ ·) (L.distinctConstantsTheory : Set α → L[[α]].Theory) :=
  Monotone.directed_le monotone_distinctConstantsTheory
#align first_order.language.directed_distinct_constants_theory FirstOrder.Language.directed_distinctConstantsTheory

theorem distinctConstantsTheory_eq_unionᵢ (s : Set α) :
    L.distinctConstantsTheory s =
      ⋃ t : Finset s,
        L.distinctConstantsTheory (t.map (Function.Embedding.subtype fun x => x ∈ s)) :=
  by
  classical
    simp only [distinct_constants_theory]
    rw [← image_Union, ← Union_inter]
    refine' congr rfl (congr (congr rfl _) rfl)
    ext ⟨i, j⟩
    simp only [prod_mk_mem_set_prod_eq, Finset.coe_map, Function.Embedding.coe_subtype, mem_Union,
      mem_image, Finset.mem_coe, Subtype.exists, Subtype.coe_mk, exists_and_right, exists_eq_right]
    refine' ⟨fun h => ⟨{⟨i, h.1⟩, ⟨j, h.2⟩}, ⟨h.1, _⟩, ⟨h.2, _⟩⟩, _⟩
    · simp
    · simp
    · rintro ⟨t, ⟨is, _⟩, ⟨js, _⟩⟩
      exact ⟨is, js⟩
#align first_order.language.distinct_constants_theory_eq_Union FirstOrder.Language.distinctConstantsTheory_eq_unionᵢ

end Cardinality

end Language

end FirstOrder


/-
Copyright (c) 2019 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import data.nat.parity
import data.equiv.fintype
import group_theory.perm.sign
/-!
# Cyclic permutations

## Main definitions

In the following, `f : equiv.perm β`.

* `equiv.perm.is_cycle`: `f.is_cycle` when two nonfixed points of `β`
  are related by repeated application of `f`.
* `equiv.perm.same_cycle`: `f.same_cycle x y` when `x` and `y` are in the same cycle of `f`.

The following two definitions require that `β` is a `fintype`:

* `equiv.perm.cycle_of`: `f.cycle_of x` is the cycle of `f` that `x` belongs to.
* `equiv.perm.cycle_factors`: `f.cycle_factors` is a list of disjoint cyclic permutations that
  multiply to `f`.

## Main results

* This file contains several closure results:
  - `closure_is_cycle` : The symmetric group is generated by cycles
  - `closure_cycle_adjacent_swap` : The symmetric group is generated by
    a cycle and an adjacent transposition
  - `closure_cycle_coprime_swap` : The symmetric group is generated by
    a cycle and a coprime transposition
  - `closure_prime_cycle_swap` : The symmetric group is generated by
    a prime cycle and a transposition

-/
namespace equiv.perm
open equiv function finset

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

section sign_cycle

/-!
### `is_cycle`
-/

variables [fintype α]

/-- A permutation is a cycle when any two nonfixed points of the permutation are related by repeated
  application of the permutation. -/
def is_cycle (f : perm β) : Prop := ∃ x, f x ≠ x ∧ ∀ y, f y ≠ y → ∃ i : ℤ, (f ^ i) x = y

lemma is_cycle.ne_one {f : perm β} (h : is_cycle f) : f ≠ 1 :=
λ hf, by simpa [hf, is_cycle] using h

lemma is_cycle.two_le_card_support {f : perm α} (h : is_cycle f) :
  2 ≤ f.support.card :=
two_le_card_support_of_ne_one h.ne_one

lemma is_cycle_swap {α : Type*} [decidable_eq α] {x y : α} (hxy : x ≠ y) : is_cycle (swap x y) :=
⟨y, by rwa swap_apply_right,
  λ a (ha : ite (a = x) y (ite (a = y) x a) ≠ a),
    if hya : y = a then ⟨0, hya⟩
    else ⟨1, by { rw [gpow_one, swap_apply_def], split_ifs at *; cc }⟩⟩

lemma is_swap.is_cycle {α : Type*} [decidable_eq α] {f : perm α} (hf : is_swap f) : is_cycle f :=
begin
  obtain ⟨x, y, hxy, rfl⟩ := hf,
  exact is_cycle_swap hxy,
end

lemma is_cycle.inv {f : perm β} (hf : is_cycle f) : is_cycle (f⁻¹) :=
let ⟨x, hx⟩ := hf in
⟨x, by { simp only [inv_eq_iff_eq, *, forall_prop_of_true, ne.def] at *, cc },
  λ y hy, let ⟨i, hi⟩ := hx.2 y (by { simp only [inv_eq_iff_eq, *, forall_prop_of_true,
      ne.def] at *, cc }) in
    ⟨-i, by rwa [gpow_neg, inv_gpow, inv_inv]⟩⟩

lemma is_cycle.is_cycle_conj {f g : perm β} (hf : is_cycle f) : is_cycle (g * f * g⁻¹) :=
begin
  obtain ⟨a, ha1, ha2⟩ := hf,
  refine ⟨g a, by simp [ha1], λ b hb, _⟩,
  obtain ⟨i, hi⟩ := ha2 (g⁻¹ b) _,
  { refine ⟨i, _⟩,
    rw conj_gpow,
    simp [hi] },
  { contrapose! hb,
    rw [perm.mul_apply, perm.mul_apply, hb, apply_inv_self] }
end

lemma is_cycle.exists_gpow_eq {f : perm β} (hf : is_cycle f) {x y : β}
  (hx : f x ≠ x) (hy : f y ≠ y) : ∃ i : ℤ, (f ^ i) x = y :=
let ⟨g, hg⟩ := hf in
let ⟨a, ha⟩ := hg.2 x hx in
let ⟨b, hb⟩ := hg.2 y hy in
⟨b - a, by rw [← ha, ← mul_apply, ← gpow_add, sub_add_cancel, hb]⟩

lemma is_cycle.exists_pow_eq [fintype β] {f : perm β} (hf : is_cycle f) {x y : β}
  (hx : f x ≠ x) (hy : f y ≠ y) : ∃ i : ℕ, (f ^ i) x = y :=
let ⟨n, hn⟩ := hf.exists_gpow_eq hx hy in
by classical; exact ⟨(n % order_of f).to_nat, by {
  have := n.mod_nonneg (int.coe_nat_ne_zero.mpr (ne_of_gt (order_of_pos f))),
  rwa [← gpow_coe_nat, int.to_nat_of_nonneg this, ← gpow_eq_mod_order_of] }⟩

/-- The subgroup generated by a cycle is in bijection with its support -/
noncomputable def is_cycle.gpowers_equiv_support {σ : perm α} (hσ : is_cycle σ) :
  (↑(subgroup.gpowers σ) : set (perm α)) ≃ (↑(σ.support) : set α) :=
equiv.of_bijective (λ τ, ⟨τ (classical.some hσ),
begin
  obtain ⟨τ, n, rfl⟩ := τ,
  rw [finset.mem_coe, coe_fn_coe_base, subtype.coe_mk, gpow_apply_mem_support, mem_support],
  exact (classical.some_spec hσ).1,
end⟩)
begin
  split,
  { rintros ⟨a, m, rfl⟩ ⟨b, n, rfl⟩ h,
    ext y,
    by_cases hy : σ y = y,
    { simp_rw [subtype.coe_mk, gpow_apply_eq_self_of_apply_eq_self hy] },
    { obtain ⟨i, rfl⟩ := (classical.some_spec hσ).2 y hy,
      rw [subtype.coe_mk, subtype.coe_mk, gpow_apply_comm σ m i, gpow_apply_comm σ n i],
      exact congr_arg _ (subtype.ext_iff.mp h) } }, by
  { rintros ⟨y, hy⟩,
    rw [finset.mem_coe, mem_support] at hy,
    obtain ⟨n, rfl⟩ := (classical.some_spec hσ).2 y hy,
    exact ⟨⟨σ ^ n, n, rfl⟩, rfl⟩ },
end

@[simp] lemma is_cycle.gpowers_equiv_support_apply {σ : perm α} (hσ : is_cycle σ) {n : ℕ} :
  hσ.gpowers_equiv_support ⟨σ ^ n, n, rfl⟩ = ⟨(σ ^ n) (classical.some hσ),
    pow_apply_mem_support.2 (mem_support.2 (classical.some_spec hσ).1)⟩ :=
rfl

@[simp] lemma is_cycle.gpowers_equiv_support_symm_apply {σ : perm α} (hσ : is_cycle σ) (n : ℕ) :
  hσ.gpowers_equiv_support.symm ⟨(σ ^ n) (classical.some hσ),
    pow_apply_mem_support.2 (mem_support.2 (classical.some_spec hσ).1)⟩ =
    ⟨σ ^ n, n, rfl⟩ :=
(equiv.symm_apply_eq _).2 hσ.gpowers_equiv_support_apply

lemma order_of_is_cycle {σ : perm α} (hσ : is_cycle σ) : order_of σ = σ.support.card :=
begin
  rw [order_eq_card_gpowers, ←fintype.card_coe],
  convert fintype.card_congr (is_cycle.gpowers_equiv_support hσ),
end

lemma is_cycle_swap_mul_aux₁ {α : Type*} [decidable_eq α] : ∀ (n : ℕ) {b x : α} {f : perm α}
  (hb : (swap x (f x) * f) b ≠ b) (h : (f ^ n) (f x) = b),
  ∃ i : ℤ, ((swap x (f x) * f) ^ i) (f x) = b
| 0         := λ b x f hb h, ⟨0, h⟩
| (n+1 : ℕ) := λ b x f hb h,
  if hfbx : f x = b then ⟨0, hfbx⟩
  else
    have f b ≠ b ∧ b ≠ x, from ne_and_ne_of_swap_mul_apply_ne_self hb,
    have hb' : (swap x (f x) * f) (f⁻¹ b) ≠ f⁻¹ b,
      by { rw [mul_apply, apply_inv_self, swap_apply_of_ne_of_ne this.2 (ne.symm hfbx),
          ne.def, ← f.injective.eq_iff, apply_inv_self],
        exact this.1 },
    let ⟨i, hi⟩ := is_cycle_swap_mul_aux₁ n hb'
      (f.injective $ by { rw [apply_inv_self], rwa [pow_succ, mul_apply] at h }) in
    ⟨i + 1, by rw [add_comm, gpow_add, mul_apply, hi, gpow_one, mul_apply, apply_inv_self,
        swap_apply_of_ne_of_ne (ne_and_ne_of_swap_mul_apply_ne_self hb).2 (ne.symm hfbx)]⟩

lemma is_cycle_swap_mul_aux₂ {α : Type*} [decidable_eq α] :
  ∀ (n : ℤ) {b x : α} {f : perm α} (hb : (swap x (f x) * f) b ≠ b) (h : (f ^ n) (f x) = b),
  ∃ i : ℤ, ((swap x (f x) * f) ^ i) (f x) = b
| (n : ℕ) := λ b x f, is_cycle_swap_mul_aux₁ n
| -[1+ n] := λ b x f hb h,
  if hfbx : f⁻¹ x = b then
    ⟨-1, by rwa [gpow_neg, gpow_one, mul_inv_rev, mul_apply, swap_inv, swap_apply_right]⟩
  else if hfbx' : f x = b then ⟨0, hfbx'⟩
  else
  have f b ≠ b ∧ b ≠ x := ne_and_ne_of_swap_mul_apply_ne_self hb,
  have hb : (swap x (f⁻¹ x) * f⁻¹) (f⁻¹ b) ≠ f⁻¹ b,
    by { rw [mul_apply, swap_apply_def],
      split_ifs;
      simp only [inv_eq_iff_eq, perm.mul_apply, gpow_neg_succ_of_nat, ne.def,
        perm.apply_inv_self] at *;
      cc },
  let ⟨i, hi⟩ := is_cycle_swap_mul_aux₁ n hb
    (show (f⁻¹ ^ n) (f⁻¹ x) = f⁻¹ b, by
      rw [← gpow_coe_nat, ← h, ← mul_apply, ← mul_apply, ← mul_apply, gpow_neg_succ_of_nat,
        ← inv_pow, pow_succ', mul_assoc, mul_assoc, inv_mul_self, mul_one, gpow_coe_nat,
        ← pow_succ', ← pow_succ]) in
  have h : (swap x (f⁻¹ x) * f⁻¹) (f x) = f⁻¹ x, by rw [mul_apply, inv_apply_self, swap_apply_left],
  ⟨-i, by rw [← add_sub_cancel i 1, neg_sub, sub_eq_add_neg, gpow_add, gpow_one, gpow_neg,
      ← inv_gpow, mul_inv_rev, swap_inv, mul_swap_eq_swap_mul, inv_apply_self, swap_comm _ x,
      gpow_add, gpow_one, mul_apply, mul_apply (_ ^ i), h, hi, mul_apply, apply_inv_self,
      swap_apply_of_ne_of_ne this.2 (ne.symm hfbx')]⟩

lemma is_cycle.eq_swap_of_apply_apply_eq_self {α : Type*} [decidable_eq α]
  {f : perm α} (hf : is_cycle f) {x : α}
  (hfx : f x ≠ x) (hffx : f (f x) = x) : f = swap x (f x) :=
equiv.ext $ λ y,
let ⟨z, hz⟩ := hf in
let ⟨i, hi⟩ := hz.2 x hfx in
if hyx : y = x then by simp [hyx]
else if hfyx : y = f x then by simp [hfyx, hffx]
else begin
  rw [swap_apply_of_ne_of_ne hyx hfyx],
  refine by_contradiction (λ hy, _),
  cases hz.2 y hy with j hj,
  rw [← sub_add_cancel j i, gpow_add, mul_apply, hi] at hj,
  cases gpow_apply_eq_of_apply_apply_eq_self hffx (j - i) with hji hji,
  { rw [← hj, hji] at hyx, cc },
  { rw [← hj, hji] at hfyx, cc }
end

lemma is_cycle.swap_mul {α : Type*} [decidable_eq α] {f : perm α} (hf : is_cycle f) {x : α}
  (hx : f x ≠ x) (hffx : f (f x) ≠ x) : is_cycle (swap x (f x) * f) :=
⟨f x, by { simp only [swap_apply_def, mul_apply],
        split_ifs; simp [f.injective.eq_iff] at *; cc },
  λ y hy,
  let ⟨i, hi⟩ := hf.exists_gpow_eq hx (ne_and_ne_of_swap_mul_apply_ne_self hy).1 in
  have hi : (f ^ (i - 1)) (f x) = y, from
    calc (f ^ (i - 1)) (f x) = (f ^ (i - 1) * f ^ (1 : ℤ)) x : by rw [gpow_one, mul_apply]
    ... = y : by rwa [← gpow_add, sub_add_cancel],
  is_cycle_swap_mul_aux₂ (i - 1) hy hi⟩

lemma is_cycle.sign : ∀ {f : perm α} (hf : is_cycle f),
  sign f = -(-1) ^ f.support.card
| f := λ hf,
let ⟨x, hx⟩ := hf in
calc sign f = sign (swap x (f x) * (swap x (f x) * f)) :
  by rw [← mul_assoc, mul_def, mul_def, swap_swap, trans_refl]
... = -(-1) ^ f.support.card :
  if h1 : f (f x) = x
  then
    have h : swap x (f x) * f = 1,
      begin
        rw hf.eq_swap_of_apply_apply_eq_self hx.1 h1,
        simp only [perm.mul_def, perm.one_def, swap_apply_left, swap_swap]
      end,
    by { rw [sign_mul, sign_swap hx.1.symm, h, sign_one, hf.eq_swap_of_apply_apply_eq_self hx.1 h1,
      card_support_swap hx.1.symm], refl }
  else
    have h : card (support (swap x (f x) * f)) + 1 = card (support f),
      by rw [← insert_erase (mem_support.2 hx.1), support_swap_mul_eq h1,
        card_insert_of_not_mem (not_mem_erase _ _)],
    have wf : card (support (swap x (f x) * f)) < card (support f),
      from card_support_swap_mul hx.1,
    by { rw [sign_mul, sign_swap hx.1.symm, (hf.swap_mul hx.1 h1).sign, ← h],
      simp only [pow_add, mul_one, units.neg_neg, one_mul, units.mul_neg, eq_self_iff_true,
        pow_one, units.neg_mul_neg] }
using_well_founded {rel_tac := λ _ _, `[exact ⟨_, measure_wf (λ f, f.support.card)⟩]}

-- The lemma `support_pow_le` is relevant. It means that `h2` is equivalent to
-- `σ.support = (σ ^ n).support`, as well as to `σ.support.card ≤ (σ ^ n).support.card`.
lemma is_cycle_of_is_cycle_pow {σ : perm α} {n : ℤ}
  (h1 : is_cycle (σ ^ n)) (h2 : σ.support ≤ (σ ^ n).support) : is_cycle σ :=
begin
  have key : ∀ x : α, (σ ^ n) x ≠ x ↔ σ x ≠ x,
  { simp_rw [←mem_support],
    exact finset.ext_iff.mp (le_antisymm (support_pow_le σ n) h2) },
  obtain ⟨x, hx1, hx2⟩ := h1,
  refine ⟨x, (key x).mp hx1, λ y hy, _⟩,
  cases (hx2 y ((key y).mpr hy)) with i _,
  exact ⟨n * i, by rwa gpow_mul⟩,
end

end sign_cycle

/-!
### `same_cycle`
-/

/-- The equivalence relation indicating that two points are in the same cycle of a permutation. -/
def same_cycle (f : perm β) (x y : β) : Prop := ∃ i : ℤ, (f ^ i) x = y

@[refl] lemma same_cycle.refl (f : perm β) (x : β) : same_cycle f x x := ⟨0, rfl⟩

@[symm] lemma same_cycle.symm (f : perm β) {x y : β} : same_cycle f x y → same_cycle f y x :=
λ ⟨i, hi⟩, ⟨-i, by rw [gpow_neg, ← hi, inv_apply_self]⟩

@[trans] lemma same_cycle.trans (f : perm β) {x y z : β} :
  same_cycle f x y → same_cycle f y z → same_cycle f x z :=
λ ⟨i, hi⟩ ⟨j, hj⟩, ⟨j + i, by rw [gpow_add, mul_apply, hi, hj]⟩

lemma same_cycle.apply_eq_self_iff {f : perm β} {x y : β} :
  same_cycle f x y → (f x = x ↔ f y = y) :=
λ ⟨i, hi⟩, by rw [← hi, ← mul_apply, ← gpow_one_add, add_comm, gpow_add_one, mul_apply,
    (f ^ i).injective.eq_iff]

lemma is_cycle.same_cycle {f : perm β} (hf : is_cycle f) {x y : β}
  (hx : f x ≠ x) (hy : f y ≠ y) : same_cycle f x y :=
hf.exists_gpow_eq hx hy

instance [fintype α] (f : perm α) : decidable_rel (same_cycle f) :=
λ x y, decidable_of_iff (∃ n ∈ list.range (fintype.card (perm α)), (f ^ n) x = y)
⟨λ ⟨n, _, hn⟩, ⟨n, hn⟩, λ ⟨i, hi⟩, ⟨(i % order_of f).nat_abs, list.mem_range.2
  (int.coe_nat_lt.1 $
    by { rw int.nat_abs_of_nonneg (int.mod_nonneg _
        (int.coe_nat_ne_zero_iff_pos.2 (order_of_pos _))),
      { apply lt_of_lt_of_le (int.mod_lt _ (int.coe_nat_ne_zero_iff_pos.2 (order_of_pos _))),
        { simp [order_of_le_card_univ] },
        exact fintype_perm },
      exact fintype_perm, }),
  by { rw [← gpow_coe_nat, int.nat_abs_of_nonneg (int.mod_nonneg _
      (int.coe_nat_ne_zero_iff_pos.2 (order_of_pos _))), ← gpow_eq_mod_order_of, hi],
    exact fintype_perm }⟩⟩

lemma same_cycle_apply {f : perm β} {x y : β} : same_cycle f x (f y) ↔ same_cycle f x y :=
⟨λ ⟨i, hi⟩, ⟨-1 + i, by rw [gpow_add, mul_apply, hi, gpow_neg_one, inv_apply_self]⟩,
 λ ⟨i, hi⟩, ⟨1 + i, by rw [gpow_add, mul_apply, hi, gpow_one]⟩⟩

lemma same_cycle_cycle {f : perm β} {x : β} (hx : f x ≠ x) : is_cycle f ↔
  (∀ {y}, same_cycle f x y ↔ f y ≠ y) :=
⟨λ hf y, ⟨λ ⟨i, hi⟩ hy, hx $
    by { rw [← gpow_apply_eq_self_of_apply_eq_self hy i, (f ^ i).injective.eq_iff] at hi,
      rw [hi, hy] },
  hf.exists_gpow_eq hx⟩,
  λ h, ⟨x, hx, λ y hy, h.2 hy⟩⟩

lemma same_cycle_inv (f : perm β) {x y : β} : same_cycle f⁻¹ x y ↔ same_cycle f x y :=
⟨λ ⟨i, hi⟩, ⟨-i, by rw [gpow_neg, ← inv_gpow, hi]⟩,
 λ ⟨i, hi⟩, ⟨-i, by rw [gpow_neg, ← inv_gpow, inv_inv, hi]⟩ ⟩

lemma same_cycle_inv_apply {f : perm β} {x y : β} : same_cycle f x (f⁻¹ y) ↔ same_cycle f x y :=
by rw [← same_cycle_inv, same_cycle_apply, same_cycle_inv]

/-!
### `cycle_of`
-/

/-- `f.cycle_of x` is the cycle of the permutation `f` to which `x` belongs. -/
def cycle_of [fintype α] (f : perm α) (x : α) : perm α :=
of_subtype (@subtype_perm _ f (same_cycle f x) (λ _, same_cycle_apply.symm))

lemma cycle_of_apply [fintype α] (f : perm α) (x y : α) :
  cycle_of f x y = if same_cycle f x y then f y else y := rfl

lemma cycle_of_inv [fintype α] (f : perm α) (x : α) :
  (cycle_of f x)⁻¹ = cycle_of f⁻¹ x :=
equiv.ext $ λ y, begin
  rw [inv_eq_iff_eq, cycle_of_apply, cycle_of_apply],
  split_ifs; simp [*, same_cycle_inv, same_cycle_inv_apply] at *
end

@[simp] lemma cycle_of_pow_apply_self [fintype α] (f : perm α) (x : α) :
  ∀ n : ℕ, (cycle_of f x ^ n) x = (f ^ n) x
| 0     := rfl
| (n+1) := by { rw [pow_succ, mul_apply, cycle_of_apply,
    cycle_of_pow_apply_self, if_pos, pow_succ, mul_apply],
  exact ⟨n, rfl⟩ }

@[simp] lemma cycle_of_gpow_apply_self [fintype α] (f : perm α) (x : α) :
  ∀ n : ℤ, (cycle_of f x ^ n) x = (f ^ n) x
| (n : ℕ) := cycle_of_pow_apply_self f x n
| -[1+ n] := by rw [gpow_neg_succ_of_nat, ← inv_pow, cycle_of_inv,
  gpow_neg_succ_of_nat, ← inv_pow, cycle_of_pow_apply_self]

lemma same_cycle.cycle_of_apply [fintype α] {f : perm α} {x y : α} (h : same_cycle f x y) :
  cycle_of f x y = f y := dif_pos h

lemma cycle_of_apply_of_not_same_cycle [fintype α] {f : perm α} {x y : α} (h : ¬same_cycle f x y) :
  cycle_of f x y = y := dif_neg h

@[simp] lemma cycle_of_apply_self [fintype α] (f : perm α) (x : α) :
  cycle_of f x x = f x := (same_cycle.refl _ _).cycle_of_apply

lemma is_cycle.cycle_of_eq [fintype α] {f : perm α} (hf : is_cycle f) {x : α} (hx : f x ≠ x) :
  cycle_of f x = f :=
equiv.ext $ λ y,
  if h : same_cycle f x y then by rw [h.cycle_of_apply]
  else by rw [cycle_of_apply_of_not_same_cycle h, not_not.1 (mt ((same_cycle_cycle hx).1 hf).2 h)]

@[simp] lemma cycle_of_eq_one_iff [fintype α] (f : perm α) {x : α} : cycle_of f x = 1 ↔ f x = x :=
begin
  simp_rw [ext_iff, cycle_of_apply, one_apply],
  refine ⟨λ h, (if_pos (same_cycle.refl f x)).symm.trans (h x), λ h y, _⟩,
  by_cases hy : f y = y,
  { rw [hy, if_t_t] },
  { exact if_neg (mt same_cycle.apply_eq_self_iff (by tauto)) },
end

lemma is_cycle.cycle_of [fintype α] {f : perm α} (hf : is_cycle f) {x : α} :
  cycle_of f x = if f x = x then 1 else f :=
begin
  by_cases hx : f x = x,
  { rwa [if_pos hx, cycle_of_eq_one_iff] },
  { rwa [if_neg hx, hf.cycle_of_eq] },
end

lemma cycle_of_one [fintype α] (x : α) : cycle_of 1 x = 1 :=
(cycle_of_eq_one_iff 1).mpr rfl

lemma is_cycle_cycle_of [fintype α] (f : perm α) {x : α} (hx : f x ≠ x) : is_cycle (cycle_of f x) :=
have cycle_of f x x ≠ x, by rwa [(same_cycle.refl _ _).cycle_of_apply],
(same_cycle_cycle this).2 $ λ y,
⟨λ h, mt h.apply_eq_self_iff.2 this,
  λ h, if hxy : same_cycle f x y then
  let ⟨i, hi⟩ := hxy in
  ⟨i, by rw [cycle_of_gpow_apply_self, hi]⟩
  else by { rw [cycle_of_apply_of_not_same_cycle hxy] at h, exact (h rfl).elim }⟩

/-!
### `cycle_factors`
-/

/-- Given a list `l : list α` and a permutation `f : perm α` whose nonfixed points are all in `l`,
  recursively factors `f` into cycles. -/
def cycle_factors_aux [fintype α] : Π (l : list α) (f : perm α),
  (∀ {x}, f x ≠ x → x ∈ l) →
  {l : list (perm α) // l.prod = f ∧ (∀ g ∈ l, is_cycle g) ∧ l.pairwise disjoint}
| []     f h := ⟨[], by { simp only [imp_false, list.pairwise.nil, list.not_mem_nil, forall_const,
    and_true, forall_prop_of_false, not_not, not_false_iff, list.prod_nil] at *,
  ext, simp * }⟩
| (x::l) f h :=
if hx : f x = x then
  cycle_factors_aux l f (λ y hy, list.mem_of_ne_of_mem (λ h, hy (by rwa h)) (h hy))
else let ⟨m, hm₁, hm₂, hm₃⟩ := cycle_factors_aux l ((cycle_of f x)⁻¹ * f)
  (λ y hy, list.mem_of_ne_of_mem
    (λ h : y = x,
      by { rw [h, mul_apply, ne.def, inv_eq_iff_eq, cycle_of_apply_self] at hy, exact hy rfl })
    (h (λ h : f y = y, by { rw [mul_apply, h, ne.def, inv_eq_iff_eq, cycle_of_apply] at hy,
        split_ifs at hy; cc }))) in
    ⟨(cycle_of f x) :: m, by { rw [list.prod_cons, hm₁], simp },
      λ g hg, ((list.mem_cons_iff _ _ _).1 hg).elim (λ hg, hg.symm ▸ is_cycle_cycle_of _ hx)
        (hm₂ g),
      list.pairwise_cons.2 ⟨λ g hg y,
        or_iff_not_imp_left.2 (λ hfy,
          have hxy : same_cycle f x y := not_not.1 (mt cycle_of_apply_of_not_same_cycle hfy),
          have hgm : g :: m.erase g ~ m := list.cons_perm_iff_perm_erase.2 ⟨hg, list.perm.refl _⟩,
          have ∀ h ∈ m.erase g, disjoint g h, from
            (list.pairwise_cons.1 ((hgm.pairwise_iff (λ a b (h : disjoint a b), h.symm)).2 hm₃)).1,
          classical.by_cases id $ λ hgy : g y ≠ y,
            (disjoint_prod_right _ this y).resolve_right $
            have hsc : same_cycle f⁻¹ x (f y), by rwa [same_cycle_inv, same_cycle_apply],
            by { rw [disjoint_prod_perm hm₃ hgm.symm, list.prod_cons,
                ← eq_inv_mul_iff_mul_eq] at hm₁,
              rwa [hm₁, mul_apply, mul_apply, cycle_of_inv, hsc.cycle_of_apply,
                inv_apply_self, inv_eq_iff_eq, eq_comm] }),
        hm₃⟩⟩

/-- Factors a permutation `f` into a list of disjoint cyclic permutations that multiply to `f`. -/
def cycle_factors [fintype α] [linear_order α] (f : perm α) :
  {l : list (perm α) // l.prod = f ∧ (∀ g ∈ l, is_cycle g) ∧ l.pairwise disjoint} :=
cycle_factors_aux (univ.sort (≤)) f (λ _ _, (mem_sort _).2 (mem_univ _))

/-- Factors a permutation `f` into a list of disjoint cyclic permutations that multiply to `f`,
  without a linear order. -/
def trunc_cycle_factors [fintype α] (f : perm α) :
  trunc {l : list (perm α) // l.prod = f ∧ (∀ g ∈ l, is_cycle g) ∧ l.pairwise disjoint} :=
quotient.rec_on_subsingleton (@univ α _).1
  (λ l h, trunc.mk (cycle_factors_aux l f h))
  (show ∀ x, f x ≠ x → x ∈ (@univ α _).1, from λ _ _, mem_univ _)

@[elab_as_eliminator] lemma cycle_induction_on [fintype β] (P : perm β → Prop) (σ : perm β)
  (base_one : P 1) (base_cycles : ∀ σ : perm β, σ.is_cycle → P σ)
  (induction_disjoint : ∀ σ τ : perm β, disjoint σ τ → is_cycle σ → P σ → P τ → P (σ * τ)) :
  P σ :=
begin
  suffices :
    ∀ l : list (perm β), (∀ τ : perm β, τ ∈ l → τ.is_cycle) → l.pairwise disjoint → P l.prod,
  { classical,
    let x := σ.trunc_cycle_factors.out,
    exact (congr_arg P x.2.1).mp (this x.1 x.2.2.1 x.2.2.2) },
  intro l,
  induction l with σ l ih,
  { exact λ _ _, base_one },
  { intros h1 h2,
    rw list.prod_cons,
    exact induction_disjoint σ l.prod
      (disjoint_prod_list_of_disjoint (list.pairwise_cons.mp h2).1)
      (h1 _ (list.mem_cons_self _ _))
      (base_cycles σ (h1 σ (l.mem_cons_self σ)))
      (ih (λ τ hτ, h1 τ (list.mem_cons_of_mem σ hτ)) (list.pairwise_of_pairwise_cons h2)) },
end

section generation

variables [fintype α] [fintype β]

open subgroup

lemma closure_is_cycle : closure {σ : perm β | is_cycle σ} = ⊤ :=
begin
  classical,
  exact top_le_iff.mp (le_trans (ge_of_eq closure_is_swap) (closure_mono (λ _, is_swap.is_cycle))),
end

lemma closure_cycle_adjacent_swap {σ : perm α} (h1 : is_cycle σ) (h2 : σ.support = ⊤) (x : α) :
  closure ({σ, swap x (σ x)} : set (perm α)) = ⊤ :=
begin
  let H := closure ({σ, swap x (σ x)} : set (perm α)),
  have h3 : σ ∈ H := subset_closure (set.mem_insert σ _),
  have h4 : swap x (σ x) ∈ H := subset_closure (set.mem_insert_of_mem _ (set.mem_singleton _)),
  have step1 : ∀ (n : ℕ), swap ((σ ^ n) x) ((σ^(n+1)) x) ∈ H,
  { intro n,
    induction n with n ih,
    { exact subset_closure (set.mem_insert_of_mem _ (set.mem_singleton _)) },
    { convert H.mul_mem (H.mul_mem h3 ih) (H.inv_mem h3),
      rw [mul_swap_eq_swap_mul, mul_inv_cancel_right], refl } },
  have step2 : ∀ (n : ℕ), swap x ((σ ^ n) x) ∈ H,
  { intro n,
    induction n with n ih,
    { convert H.one_mem,
      exact swap_self x },
    { by_cases h5 : x = (σ ^ n) x,
      { rw [pow_succ, mul_apply, ←h5], exact h4 },
      by_cases h6 : x = (σ^(n+1)) x,
      { rw [←h6, swap_self], exact H.one_mem },
      rw [swap_comm, ←swap_mul_swap_mul_swap h5 h6],
      exact H.mul_mem (H.mul_mem (step1 n) ih) (step1 n) } },
  have step3 : ∀ (y : α), swap x y ∈ H,
  { intro y,
    have hx : x ∈ (⊤ : finset α) := finset.mem_univ x,
    rw [←h2, mem_support] at hx,
    have hy : y ∈ (⊤ : finset α) := finset.mem_univ y,
    rw [←h2, mem_support] at hy,
    cases is_cycle.exists_pow_eq h1 hx hy with n hn,
    rw ← hn,
    exact step2 n },
  have step4 : ∀ (y z : α), swap y z ∈ H,
  { intros y z,
    by_cases h5 : z = x,
    { rw [h5, swap_comm], exact step3 y },
    by_cases h6 : z = y,
    { rw [h6, swap_self], exact H.one_mem },
    rw [←swap_mul_swap_mul_swap h5 h6, swap_comm z x],
    exact H.mul_mem (H.mul_mem (step3 y) (step3 z)) (step3 y) },
  rw [eq_top_iff, ←closure_is_swap, closure_le],
  rintros τ ⟨y, z, h5, h6⟩,
  rw h6,
  exact step4 y z,
end

lemma closure_cycle_coprime_swap {n : ℕ} {σ : perm α} (h0 : nat.coprime n (fintype.card α))
  (h1 : is_cycle σ) (h2 : σ.support = finset.univ) (x : α) :
  closure ({σ, swap x ((σ ^ n) x)} : set (perm α)) = ⊤ :=
begin
  rw [←finset.card_univ, ←h2, ←order_of_is_cycle h1] at h0,
  cases exists_pow_eq_self_of_coprime h0 with m hm,
  have h2' : (σ ^ n).support = ⊤ := eq.trans (support_pow_coprime h0) h2,
  have h1' : is_cycle ((σ ^ n) ^ (m : ℤ)) := by rwa ← hm at h1,
  replace h1' : is_cycle (σ ^ n) := is_cycle_of_is_cycle_pow h1'
    (le_trans (support_pow_le σ n) (ge_of_eq (congr_arg support hm))),
  rw [eq_top_iff, ←closure_cycle_adjacent_swap h1' h2' x, closure_le, set.insert_subset],
  exact ⟨subgroup.pow_mem (closure _) (subset_closure (set.mem_insert σ _)) n,
    set.singleton_subset_iff.mpr (subset_closure (set.mem_insert_of_mem _ (set.mem_singleton _)))⟩,
end

lemma closure_prime_cycle_swap {σ τ : perm α} (h0 : (fintype.card α).prime) (h1 : is_cycle σ)
  (h2 : σ.support = finset.univ) (h3 : is_swap τ) : closure ({σ, τ} : set (perm α)) = ⊤ :=
begin
  obtain ⟨x, y, h4, h5⟩ := h3,
  obtain ⟨i, hi⟩ := h1.exists_pow_eq (mem_support.mp
  ((finset.ext_iff.mp h2 x).mpr (finset.mem_univ x)))
    (mem_support.mp ((finset.ext_iff.mp h2 y).mpr (finset.mem_univ y))),
  rw [h5, ←hi],
  refine closure_cycle_coprime_swap (nat.coprime.symm
    (h0.coprime_iff_not_dvd.mpr (λ h, h4 _))) h1 h2 x,
  cases h with m hm,
  rwa [hm, pow_mul, ←finset.card_univ, ←h2, ←order_of_is_cycle h1,
    pow_order_of_eq_one, one_pow, one_apply] at hi,
end

end generation

section
variables [fintype α] {σ τ : perm α}

noncomputable theory

lemma is_conj_of_support_equiv (f : {x // x ∈ (σ.support : set α)} ≃ {x // x ∈ (τ.support : set α)})
  (hf : ∀ (x : α) (hx : x ∈ (σ.support : set α)), (f ⟨σ x, apply_mem_support.2 hx⟩ : α) =
    τ ↑(f ⟨x,hx⟩)) :
  is_conj σ τ :=
begin
  refine is_conj_iff.2 ⟨equiv.extend_subtype f, _⟩,
  rw mul_inv_eq_iff_eq_mul,
  ext,
  simp only [perm.mul_apply],
  by_cases hx : x ∈ σ.support,
  { rw [equiv.extend_subtype_apply_of_mem, equiv.extend_subtype_apply_of_mem],
    { exact hf x (finset.mem_coe.2 hx) } },
  { rwa [not_not.1 ((not_congr mem_support).1 (equiv.extend_subtype_not_mem f _ _)),
      not_not.1 ((not_congr mem_support).mp hx)] }
end

theorem is_cycle.is_conj (hσ : is_cycle σ) (hτ : is_cycle τ) (h : σ.support.card = τ.support.card) :
  is_conj σ τ :=
begin
  refine is_conj_of_support_equiv (hσ.gpowers_equiv_support.symm.trans
    ((gpowers_equiv_gpowers begin
      rw [order_of_is_cycle hσ, h, order_of_is_cycle hτ],
  end).trans hτ.gpowers_equiv_support)) _,
  intros x hx,
  simp only [perm.mul_apply, equiv.trans_apply, equiv.sum_congr_apply],
  obtain ⟨n, rfl⟩ := hσ.exists_pow_eq (classical.some_spec hσ).1 (mem_support.1 hx),
  apply eq.trans _ (congr rfl (congr rfl (congr rfl
    (congr rfl (hσ.gpowers_equiv_support_symm_apply n).symm)))),
  apply (congr rfl (congr rfl (congr rfl (hσ.gpowers_equiv_support_symm_apply (n + 1))))).trans _,
  simp only [ne.def, is_cycle.gpowers_equiv_support_apply,
    subtype.coe_mk, gpowers_equiv_gpowers_apply],
  rw [pow_succ, perm.mul_apply],
end

theorem is_cycle.is_conj_iff (hσ : is_cycle σ) (hτ : is_cycle τ) :
  is_conj σ τ ↔ σ.support.card = τ.support.card :=
⟨begin
  intro h,
  obtain ⟨π, rfl⟩ := is_conj_iff.1 h,
  apply finset.card_congr (λ a ha, π a) (λ _ ha, _) (λ _ _ _ _ ab, π.injective ab) (λ b hb, _),
  { simp [mem_support.1 ha] },
  { refine ⟨π⁻¹ b, ⟨_, π.apply_inv_self b⟩⟩,
    contrapose! hb,
    rw [mem_support, not_not] at hb,
    rw [mem_support, not_not, perm.mul_apply, perm.mul_apply, hb, perm.apply_inv_self] }
end, hσ.is_conj hτ⟩

@[simp]
lemma support_conj : (σ * τ * σ⁻¹).support = τ.support.map σ.to_embedding :=
begin
  ext,
  simp only [mem_map_equiv, perm.coe_mul, comp_app, ne.def, perm.mem_support, equiv.eq_symm_apply],
  refl,
end

lemma card_support_conj : (σ * τ * σ⁻¹).support.card = τ.support.card :=
by simp

end

theorem disjoint.is_conj_mul {α : Type*} [fintype α] {σ τ π ρ : perm α}
  (hc1 : is_conj σ π) (hc2 : is_conj τ ρ)
  (hd1 : disjoint σ τ) (hd2 : disjoint π ρ) :
  is_conj (σ * τ) (π * ρ) :=
begin
  classical,
  obtain ⟨f, rfl⟩ := is_conj_iff.1 hc1,
  obtain ⟨g, rfl⟩ := is_conj_iff.1 hc2,
  have hd1' := coe_inj.2 hd1.support_mul,
  have hd2' := coe_inj.2 hd2.support_mul,
  rw [coe_union] at *,
  have hd1'' := disjoint_iff_disjoint_coe.1 (disjoint_iff_disjoint_support.1 hd1),
  have hd2'' := disjoint_iff_disjoint_coe.1 (disjoint_iff_disjoint_support.1 hd2),
  refine is_conj_of_support_equiv _ _,
  { refine ((equiv.set.of_eq hd1').trans (equiv.set.union hd1'')).trans
      ((equiv.sum_congr (subtype_equiv f (λ a, _)) (subtype_equiv g (λ a, _))).trans
      ((equiv.set.of_eq hd2').trans (equiv.set.union hd2'')).symm);
    { simp only [set.mem_image, to_embedding_apply, exists_eq_right,
        support_conj, coe_map, apply_eq_iff_eq] } },
  { intros x hx,
    simp only [trans_apply, symm_trans_apply, set.of_eq_apply,
      set.of_eq_symm_apply, equiv.sum_congr_apply],
    rw [hd1', set.mem_union] at hx,
    cases hx with hxσ hxτ,
    { rw [mem_coe, mem_support] at hxσ,
      rw [set.union_apply_left hd1'' _, set.union_apply_left hd1'' _],
      simp only [subtype_equiv_apply, perm.coe_mul, sum.map_inl, comp_app,
        set.union_symm_apply_left, subtype.coe_mk, apply_eq_iff_eq],
      { have h := (hd2 (f x)).resolve_left _,
        { rw [mul_apply, mul_apply] at h,
          rw [h, inv_apply_self, (hd1 x).resolve_left hxσ] },
        { rwa [mul_apply, mul_apply, inv_apply_self, apply_eq_iff_eq] } },
      { rwa [subtype.coe_mk, subtype.coe_mk, mem_coe, mem_support] },
      { rwa [subtype.coe_mk, subtype.coe_mk, perm.mul_apply,
          (hd1 x).resolve_left hxσ, mem_coe, apply_mem_support, mem_support] } },
    { rw [mem_coe, ← apply_mem_support, mem_support] at hxτ,
      rw [set.union_apply_right hd1'' _, set.union_apply_right hd1'' _],
      simp only [subtype_equiv_apply, perm.coe_mul, sum.map_inr, comp_app,
        set.union_symm_apply_right, subtype.coe_mk, apply_eq_iff_eq],
      { have h := (hd2 (g (τ x))).resolve_right _,
        { rw [mul_apply, mul_apply] at h,
          rw [inv_apply_self, h, (hd1 (τ x)).resolve_right hxτ] },
        { rwa [mul_apply, mul_apply, inv_apply_self, apply_eq_iff_eq] } },
      { rwa [subtype.coe_mk, subtype.coe_mk, mem_coe, ← apply_mem_support, mem_support] },
      { rwa [subtype.coe_mk, subtype.coe_mk, perm.mul_apply,
          (hd1 (τ x)).resolve_right hxτ, mem_coe, mem_support] } } }
end

section fixed_points

/-!
### Fixed points
-/

lemma fixed_point_card_lt_of_ne_one [fintype α] {σ : perm α} (h : σ ≠ 1) :
  (filter (λ x, σ x = x) univ).card < fintype.card α - 1 :=
begin
  rw [nat.lt_sub_left_iff_add_lt, ← nat.lt_sub_right_iff_add_lt, ← finset.card_compl,
    finset.compl_filter],
  exact one_lt_card_support_of_ne_one h
end

end fixed_points

end equiv.perm