lean4-htt/tests/lean/run/funind_proof.lean
Joachim Breitner 8038604d3e
feat: functional induction (#3432)
This adds the concept of **functional induction** to lean.

Derived from the definition of a (possibly mutually) recursive function,
a **functional
induction principle** is tailored to proofs about that function. For
example from:

```
def ackermann : Nat → Nat → Nat
  | 0, m => m + 1
  | n+1, 0 => ackermann n 1
  | n+1, m+1 => ackermann n (ackermann (n + 1) m)
derive_functional_induction ackermann
```
we get
```
ackermann.induct (motive : Nat → Nat → Prop) (case1 : ∀ (m : Nat), motive 0 m)
  (case2 : ∀ (n : Nat), motive n 1 → motive (Nat.succ n) 0)
  (case3 : ∀ (n m : Nat), motive (n + 1) m → motive n (ackermann (n + 1) m) → motive (Nat.succ n) (Nat.succ m))
  (x x : Nat) : motive x x
```

At the moment, the user has to ask for the functional induction
principle explicitly using
```
derive_functional_induction ackermann
```

The module docstring of `Lean/Meta/Tactic/FunInd.lean` contains more
details on the
design and implementation of this command.

More convenience around this (e.g. a `functional induction` tactic) will
follow eventually.


This PR includes a bunch of `PSum`/`PSigma` related functions in the
`Lean.Tactic.FunInd`
namespace. I plan to move these to `PackArgs`/`PackMutual` afterwards,
and do some cleaning
up as I do that.

---------

Co-authored-by: David Thrane Christiansen <david@davidchristiansen.dk>
Co-authored-by: Leonardo de Moura <leomoura@amazon.com>
2024-03-05 13:02:05 +00:00

67 lines
2.7 KiB
Text

inductive Term where
| const : String → Term
| app : String → List Term → Term
namespace Term
mutual
def numConsts : Term → Nat
| const _ => 1
| app _ cs => numConstsLst cs
def numConstsLst : List Term → Nat
| [] => 0
| c :: cs => numConsts c + numConstsLst cs
end
mutual
def replaceConst (a b : String) : Term → Term
| const c => if a == c then const b else const c
| app f cs => app f (replaceConstLst a b cs)
def replaceConstLst (a b : String) : List Term → List Term
| [] => []
| c :: cs => replaceConst a b c :: replaceConstLst a b cs
end
derive_functional_induction replaceConst
/--
info: Term.replaceConst.induct (a b : String) (motive1 : Term → Prop) (motive2 : List Term → Prop) (case1 : motive2 [])
(case2 : ∀ (a_1 : String), (a == a_1) = true → motive1 (const a_1))
(case3 : ∀ (a_1 : String), ¬(a == a_1) = true → motive1 (const a_1))
(case4 : ∀ (a : String) (cs : List Term), motive2 cs → motive1 (app a cs))
(case5 : ∀ (c : Term) (cs : List Term), motive1 c → motive2 cs → motive2 (c :: cs)) (x : Term) : motive1 x
-/
#guard_msgs in
#check replaceConst.induct
theorem numConsts_replaceConst (a b : String) (e : Term) : numConsts (replaceConst a b e) = numConsts e := by
apply replaceConst.induct
(motive1 := fun e => numConsts (replaceConst a b e) = numConsts e)
(motive2 := fun es => numConstsLst (replaceConstLst a b es) = numConstsLst es)
case case1 => simp [replaceConstLst, numConstsLst, *]
case case2 => intro c h; guard_hyp h :ₛ (a == c) = true; simp [replaceConst, numConsts, *]
case case3 => intro c h; guard_hyp h :ₛ ¬(a == c) = true; simp [replaceConst, numConsts, *]
case case4 =>
intros f cs ih
guard_hyp ih :ₛnumConstsLst (replaceConstLst a b cs) = numConstsLst cs
simp [replaceConst, numConsts, *]
case case5 =>
intro c cs ih₁ ih₂
guard_hyp ih₁ :ₛ numConsts (replaceConst a b c) = numConsts c
guard_hyp ih₂ :ₛ numConstsLst (replaceConstLst a b cs) = numConstsLst cs
simp [replaceConstLst, numConstsLst, *]
theorem numConsts_replaceConst' (a b : String) (e : Term) : numConsts (replaceConst a b e) = numConsts e := by
apply replaceConst.induct
(motive1 := fun e => numConsts (replaceConst a b e) = numConsts e)
(motive2 := fun es => numConstsLst (replaceConstLst a b es) = numConstsLst es)
<;> intros <;> simp [replaceConst, numConsts, replaceConstLst, numConstsLst, *]
theorem numConsts_replaceConst'' (a b : String) (e : Term) : numConsts (replaceConst a b e) = numConsts e := by
induction e using replaceConst.induct (a := a) (b := b)
(motive2 := fun es => numConstsLst (replaceConstLst a b es) = numConstsLst es) <;>
simp [replaceConst, numConsts, replaceConstLst, numConstsLst, *]
end Term