diff options
| author | Hannes Schulze <haschu0103@outlook.de> | 2025-12-03 21:45:09 +0100 |
|---|---|---|
| committer | Hannes Schulze <haschu0103@outlook.de> | 2025-12-03 21:52:56 +0100 |
| commit | b00c95bd3580a8a8bd779f57a034900140ce41fa (patch) | |
| tree | 246965a032976b2cf59e2d9768c0f33aadff135e /Algebra/Term.lean | |
| parent | 2edae587eee2ed64f66a4e4bedca6e654ad2f708 (diff) | |
more cleanup
Diffstat (limited to 'Algebra/Term.lean')
| -rw-r--r-- | Algebra/Term.lean | 253 |
1 files changed, 0 insertions, 253 deletions
diff --git a/Algebra/Term.lean b/Algebra/Term.lean deleted file mode 100644 index fe7e742..0000000 --- a/Algebra/Term.lean +++ /dev/null @@ -1,253 +0,0 @@ -import Mathlib -import Nominal - -namespace Algebra - -variable (πΈ : Type) [Infinite πΈ] [Countable πΈ] [DecidableEq πΈ] - -/-- A graded signature. -/ -structure Signature where - pure : Type - free : Type - bound : Type - /-- Type representing the arguments required for an operation. -/ - args : pure β free β bound β Type - args_fintype : β f, Fintype (args f) := by intro; infer_instance - /-- Depth of an operation. -/ - depth : pure β free β bound β β - -def Signature.pureArgs (sig : Signature) (f : sig.pure) : Type := sig.args (.inl f) -def Signature.freeArgs (sig : Signature) (f : sig.free) : Type := sig.args (.inr (.inl f)) -def Signature.boundArgs (sig : Signature) (f : sig.bound) : Type := sig.args (.inr (.inr f)) - -def Signature.pureArgs_fintype (sig : Signature) (f : sig.pure) : Fintype (sig.pureArgs f) := sig.args_fintype (.inl f) -def Signature.freeArgs_fintype (sig : Signature) (f : sig.free) : Fintype (sig.freeArgs f) := sig.args_fintype (.inr (.inl f)) -def Signature.boundArgs_fintype (sig : Signature) (f : sig.bound) : Fintype (sig.boundArgs f) := sig.args_fintype (.inr (.inr f)) - -def Signature.arity (sig : Signature) (f : sig.pure β sig.free β sig.bound) : β := (sig.args_fintype f).card -def Signature.pureArity (sig : Signature) (f : sig.pure) : β := sig.arity (.inl f) -def Signature.freeArity (sig : Signature) (f : sig.free) : β := sig.arity (.inr (.inl f)) -def Signature.boundArity (sig : Signature) (f : sig.bound) : β := sig.arity (.inr (.inr f)) - -def Signature.pureDepth (sig : Signature) (f : sig.pure) : β := sig.depth (.inl f) -def Signature.freeDepth (sig : Signature) (f : sig.free) : β := sig.depth (.inr (.inl f)) -def Signature.boundDepth (sig : Signature) (f : sig.bound) : β := sig.depth (.inr (.inr f)) - -variable {sig : Signature} -variable {X : Type} [NominalSet πΈ X] -variable {Y : Type} [NominalSet πΈ Y] - -inductive Term (sig : Signature) (X : Type) [NominalSet πΈ X] - | var (x : X) : Term sig X - | pure (f : sig.pure) (args : sig.pureArgs f β Term sig X) : Term sig X - | free (a : πΈ) (f : sig.free) (args : sig.freeArgs f β Term sig X) : Term sig X - | bound (a : πΈ) (f : sig.bound) (args : sig.boundArgs f β Term sig X) : Term sig X - -inductive Term.HasDepth : Term πΈ sig X β β β Prop - | var (x : X) : HasDepth (.var x) 0 - | pure (f : sig.pure) (args : sig.pureArgs f β Term πΈ sig X) (k : β) : - (β arg : sig.pureArgs f, HasDepth (args arg) k) β HasDepth (.pure f args) (k + sig.pureDepth f) - | free (a : πΈ) (f : sig.free) (args : sig.freeArgs f β Term πΈ sig X) (k : β) : - (β arg : sig.freeArgs f, HasDepth (args arg) k) β HasDepth (.free a f args) (k + sig.freeDepth f) - | bound (a : πΈ) (f : sig.bound) (args : sig.boundArgs f β Term πΈ sig X) (k : β) : - (β arg : sig.boundArgs f, HasDepth (args arg) k) β HasDepth (.bound a f args) (k + sig.boundDepth f) - -def TermAtDepth (sig : Signature) (X : Type) [NominalSet πΈ X] (n : β) := - { t : Term πΈ sig X // t.HasDepth πΈ n } - -def TermAtDepth.var (x : X) : TermAtDepth πΈ sig X 0 := β¨.var x, by constructorβ© - -def TermAtDepth.pure {n : β} (f : sig.pure) (args : sig.pureArgs f β TermAtDepth πΈ sig X n) : - TermAtDepth πΈ sig X (n + sig.pureDepth f) := - β¨.pure f (Subtype.val β args), by constructor; intro arg; exact (args arg).propβ© - -def TermAtDepth.free {n : β} (a : πΈ) (f : sig.free) (args : sig.freeArgs f β TermAtDepth πΈ sig X n) : - TermAtDepth πΈ sig X (n + sig.freeDepth f) := - β¨.free a f (Subtype.val β args), by constructor; intro arg; exact (args arg).propβ© - -def TermAtDepth.bound {n : β} (a : πΈ) (f : sig.bound) (args : sig.boundArgs f β TermAtDepth πΈ sig X n) : - TermAtDepth πΈ sig X (n + sig.boundDepth f) := - β¨.bound a f (Subtype.val β args), by constructor; intro arg; exact (args arg).propβ© - -def Substitution (sig : Signature) (X : Type) [NominalSet πΈ X] (Y : Type) [NominalSet πΈ Y] := - X β Term πΈ sig Y - -def Substitution.apply (Ο : Substitution πΈ sig X Y) : Term πΈ sig X β Term πΈ sig Y - | .var x => Ο x - | .pure f args => .pure f (fun x => Ο.apply (args x)) - | .free a f args => .free a f (fun x => Ο.apply (args x)) - | .bound a f args => .bound a f (fun x => Ο.apply (args x)) - -@[simp] lemma Substitution.apply_var {x : X} {Ο : Substitution πΈ sig X Y} : - Ο.apply πΈ (.var x) = (Ο x) := rfl - -@[simp] lemma Substitution.apply_pure - {f : sig.pure} {args : sig.pureArgs f β Term πΈ sig X} {Ο : Substitution πΈ sig X Y} : - Ο.apply πΈ (.pure f args) = .pure f (apply πΈ Ο β args) := rfl - -@[simp] lemma Substitution.apply_free - {a : πΈ} {f : sig.free} {args : sig.freeArgs f β Term πΈ sig X} {Ο : Substitution πΈ sig X Y} : - Ο.apply πΈ (.free a f args) = .free a f (apply πΈ Ο β args) := rfl - -@[simp] lemma Substitution.apply_bound - {a : πΈ} {f : sig.bound} {args : sig.boundArgs f β Term πΈ sig X} {Ο : Substitution πΈ sig X Y} : - Ο.apply πΈ (.bound a f args) = .bound a f (apply πΈ Ο β args) := rfl - -def UniformSubstitution (sig : Signature) (X : Type) [NominalSet πΈ X] (Y : Type) [NominalSet πΈ Y] (l : β) := - X β TermAtDepth πΈ sig Y l - -def UniformSubstitution.toSubstitution {l : β} (Ο : UniformSubstitution πΈ sig X Y l) : Substitution πΈ sig X Y := - fun x => (Ο x).val - -def UniformSubstitution.apply {n l : β} (Ο : UniformSubstitution πΈ sig X Y l) (t : TermAtDepth πΈ sig X n) : - TermAtDepth πΈ sig Y (n + l) := - β¨Ο.toSubstitution.apply πΈ t.val, by - suffices β t n, t.HasDepth πΈ n β (Ο.toSubstitution.apply πΈ t).HasDepth πΈ (n + l) by - exact this t.val n t.prop - intro t; fun_induction Substitution.apply - Β· intro n h; cases h - rw [Nat.zero_add] - exact (Ο _).prop - all_goals - intro n h; cases h; expose_names - rw [Nat.add_right_comm] - constructor; intro arg - apply ih1; exact h argβ© - -@[simp] lemma UniformSubstitution.apply_var - {x : X} {l : β} {Ο : UniformSubstitution πΈ sig X Y l} : - (Ο.apply πΈ (.var πΈ x)).val = (Ο x).val := rfl - -@[simp] lemma UniformSubstitution.apply_pure - {n : β} {f : sig.pure} {args : sig.pureArgs f β TermAtDepth πΈ sig X n} - {l : β} {Ο : UniformSubstitution πΈ sig X Y l} : - (Ο.apply πΈ (.pure πΈ f args)).val = (TermAtDepth.pure πΈ f (apply πΈ Ο β args)).val := rfl - -@[simp] lemma UniformSubstitution.apply_free - {n : β} {a : πΈ} {f : sig.free} {args : sig.freeArgs f β TermAtDepth πΈ sig X n} - {l : β} {Ο : UniformSubstitution πΈ sig X Y l} : - (Ο.apply πΈ (.free πΈ a f args)).val = (TermAtDepth.free πΈ a f (apply πΈ Ο β args)).val := rfl - -@[simp] lemma UniformSubstitution.apply_bound - {n : β} {a : πΈ} {f : sig.bound} {args : sig.boundArgs f β TermAtDepth πΈ sig X n} - {l : β} {Ο : UniformSubstitution πΈ sig X Y l} : - (Ο.apply πΈ (.bound πΈ a f args)).val = (TermAtDepth.bound πΈ a f (apply πΈ Ο β args)).val := rfl - -private def rename (Ο : FPerm πΈ) : Term πΈ sig X β Term πΈ sig X - | .var x => .var (Ο β’ x) - | .pure f args => .pure f (fun x => rename Ο (args x)) - | .free a f args => .free (Ο β’ a) f (fun x => rename Ο (args x)) - | .bound a f args => .bound (Ο β’ a) f (fun x => rename Ο (args x)) - -private lemma one_rename (t : Term πΈ sig X) : rename πΈ 1 t = t := by - induction' t <;> all_goals simp [rename, *] - -private lemma mul_rename (Ο Ο : FPerm πΈ) (t : Term πΈ sig X) : - rename πΈ (Ο * Ο) t = rename πΈ Ο (rename πΈ Ο t) := by - induction' t <;> all_goals simp [rename, mul_smul, *] - -instance : PermSet πΈ (Term πΈ sig X) where - smul := rename πΈ - one_smul := one_rename πΈ - mul_smul := mul_rename πΈ - -@[simp] lemma smul_var {Ο : FPerm πΈ} {x : X} : - Ο β’ (Term.var x : Term πΈ sig X) = Term.var (Ο β’ x) := rfl - -@[simp] lemma smul_pure {Ο : FPerm πΈ} {f : sig.pure} {args : sig.pureArgs f β Term πΈ sig X} : - Ο β’ Term.pure f args = Term.pure f ((Ο β’ Β·) β args) := rfl - -@[simp] lemma smul_free {Ο : FPerm πΈ} {a : πΈ} {f : sig.free} {args : sig.freeArgs f β Term πΈ sig X} : - Ο β’ Term.free a f args = Term.free (Ο β’ a) f ((Ο β’ Β·) β args) := rfl - -@[simp] lemma smul_bound {Ο : FPerm πΈ} {a : πΈ} {f : sig.bound} {args : sig.boundArgs f β Term πΈ sig X} : - Ο β’ Term.bound a f args = Term.bound (Ο β’ a) f ((Ο β’ Β·) β args) := rfl - -private def atoms : Term πΈ sig X β Set πΈ - | .var x => NominalSet.supp πΈ x - | .pure f args => ββ {atoms (args x) | x : sig.pureArgs f} - | .free a f args => {a} βͺ ββ {atoms (args x) | x : sig.freeArgs f} - | .bound a f args => {a} βͺ ββ {atoms (args x) | x : sig.boundArgs f} - -private lemma atoms_finite (t : Term πΈ sig X) : (atoms πΈ t).Finite := by - fun_induction atoms <;> all_goals expose_names - Β· exact NominalSet.supp_finite πΈ - Β· have hfin := (sig.pureArgs_fintype f).finite - apply Set.Finite.sUnion - Β· simp only [Set.setOf_exists, Set.setOf_eq_eq_singleton', Set.iUnion_singleton_eq_range] - apply Set.finite_range - Β· intro S β¨x, hSβ© - rw [β hS] - exact ih1 x - Β· have hfin := (sig.freeArgs_fintype f).finite - apply Set.Finite.union - Β· exact Set.finite_singleton a - Β· apply Set.Finite.sUnion - Β· simp only [Set.setOf_exists, Set.setOf_eq_eq_singleton', Set.iUnion_singleton_eq_range] - apply Set.finite_range - Β· intro S β¨x, hSβ© - rw [β hS] - exact ih1 x - Β· have hfin := (sig.boundArgs_fintype f).finite - apply Set.Finite.union - Β· exact Set.finite_singleton a - Β· apply Set.Finite.sUnion - Β· simp only [Set.setOf_exists, Set.setOf_eq_eq_singleton', Set.iUnion_singleton_eq_range] - apply Set.finite_range - Β· intro S β¨x, hSβ© - rw [β hS] - exact ih1 x - -private lemma atoms_support (t : Term πΈ sig X) : PermSet.HasSupport πΈ t (atoms πΈ t) := by - intro Ο - fun_induction atoms <;> all_goals expose_names - Β· have hsupp : PermSet.HasSupport πΈ x (NominalSet.supp πΈ x) := NominalSet.supp_is_support πΈ - intro hΟ - simp only [PermSet.fix', smul_var, Term.var.injEq, Set.mem_setOf_eq] - exact hsupp hΟ - Β· intro hΟ - simp only [PermSet.fix', smul_pure, Term.pure.injEq, heq_eq_eq, true_and, Set.mem_setOf_eq] - ext x - rw [Function.comp_apply] - apply ih1 - apply PermSet.fix_antitone_mem πΈ hΟ - apply Set.subset_sUnion_of_mem - use x - all_goals - intro hΟ - simp only [PermSet.fix', smul_free, smul_bound, Term.free.injEq, Term.bound.injEq, heq_eq_eq, - true_and, Set.mem_setOf_eq] - constructor - Β· apply PermSet.fix_antitone_mem πΈ hΟ - apply Set.subset_union_left - rfl - Β· ext x - rw [Function.comp_apply] - apply ih1 - apply PermSet.fix_antitone_mem πΈ hΟ - apply Set.subset_union_of_subset_right - apply Set.subset_sUnion_of_mem - use x - -instance : NominalSet πΈ (Term πΈ sig X) where - fin_supp t := by - use atoms πΈ t - exact β¨atoms_support πΈ t, atoms_finite πΈ tβ© - -instance Term.instHasDepthEquivariant {n : β} : - Set.Equivariant πΈ {t : Term πΈ sig X | HasDepth πΈ t n} := by - constructor; intro t Ο ht - suffices β t n, t.HasDepth πΈ n β (rename πΈ Ο t).HasDepth πΈ n by - exact this t n ht - intro t; fun_induction rename - Β· intro n h; cases h; constructor - all_goals - intro n h; cases h - expose_names - constructor; intro arg - apply ih1; exact h arg - -instance {n : β} : NominalSet πΈ (TermAtDepth πΈ sig X n) := - (Subtype.instNominalSetElem πΈ : NominalSet πΈ {t : Term πΈ sig X | Term.HasDepth πΈ t n}) - -end Algebra |
