Theory Common_Patterns

theory Common_Patterns
imports Main
(*  Title:      HOL/Induct/Common_Patterns.thy
Author: Makarius
*)


header {* Common patterns of induction *}

theory Common_Patterns
imports Main
begin

text {*
The subsequent Isar proof schemes illustrate common proof patterns
supported by the generic @{text "induct"} method.

To demonstrate variations on statement (goal) structure we refer to
the induction rule of Peano natural numbers: @{thm nat.induct
[no_vars]}, which is the simplest case of datatype induction. We
shall also see more complex (mutual) datatype inductions involving
several rules. Working with inductive predicates is similar, but
involves explicit facts about membership, instead of implicit
syntactic typing.
*}



subsection {* Variations on statement structure *}

subsubsection {* Local facts and parameters *}

text {*
Augmenting a problem by additional facts and locally fixed variables
is a bread-and-butter method in many applications. This is where
unwieldy object-level @{text "∀"} and @{text "-->"} used to occur in
the past. The @{text "induct"} method works with primary means of
the proof language instead.
*}


lemma
fixes n :: nat
and x :: 'a
assumes "A n x"
shows "P n x" using `A n x`
proof (induct n arbitrary: x)
case 0
note prem = `A 0 x`
show "P 0 x" sorry
next
case (Suc n)
note hyp = `!!x. A n x ==> P n x`
and prem = `A (Suc n) x`
show "P (Suc n) x" sorry
qed


subsubsection {* Local definitions *}

text {*
Here the idea is to turn sub-expressions of the problem into a
defined induction variable. This is often accompanied with fixing
of auxiliary parameters in the original expression, otherwise the
induction step would refer invariably to particular entities. This
combination essentially expresses a partially abstracted
representation of inductive expressions.
*}


lemma
fixes a :: "'a => nat"
assumes "A (a x)"
shows "P (a x)" using `A (a x)`
proof (induct n "a x" arbitrary: x)
case 0
note prem = `A (a x)`
and defn = `0 = a x`
show "P (a x)" sorry
next
case (Suc n)
note hyp = `!!x. n = a x ==> A (a x) ==> P (a x)`
and prem = `A (a x)`
and defn = `Suc n = a x`
show "P (a x)" sorry
qed

text {*
Observe how the local definition @{text "n = a x"} recurs in the
inductive cases as @{text "0 = a x"} and @{text "Suc n = a x"},
according to underlying induction rule.
*}



subsubsection {* Simple simultaneous goals *}

text {*
The most basic simultaneous induction operates on several goals
one-by-one, where each case refers to induction hypotheses that are
duplicated according to the number of conclusions.
*}


lemma
fixes n :: nat
shows "P n" and "Q n"
proof (induct n)
case 0 case 1
show "P 0" sorry
next
case 0 case 2
show "Q 0" sorry
next
case (Suc n) case 1
note hyps = `P n` `Q n`
show "P (Suc n)" sorry
next
case (Suc n) case 2
note hyps = `P n` `Q n`
show "Q (Suc n)" sorry
qed

text {*
The split into subcases may be deferred as follows -- this is
particularly relevant for goal statements with local premises.
*}


lemma
fixes n :: nat
shows "A n ==> P n"
and "B n ==> Q n"
proof (induct n)
case 0
{
case 1
note `A 0`
show "P 0" sorry
next
case 2
note `B 0`
show "Q 0" sorry
}
next
case (Suc n)
note `A n ==> P n`
and `B n ==> Q n`
{
case 1
note `A (Suc n)`
show "P (Suc n)" sorry
next
case 2
note `B (Suc n)`
show "Q (Suc n)" sorry
}
qed


subsubsection {* Compound simultaneous goals *}

text {*
The following pattern illustrates the slightly more complex
situation of simultaneous goals with individual local assumptions.
In compound simultaneous statements like this, local assumptions
need to be included into each goal, using @{text "==>"} of the Pure
framework. In contrast, local parameters do not require separate
@{text "!!"} prefixes here, but may be moved into the common context
of the whole statement.
*}


lemma
fixes n :: nat
and x :: 'a
and y :: 'b
shows "A n x ==> P n x"
and "B n y ==> Q n y"
proof (induct n arbitrary: x y)
case 0
{
case 1
note prem = `A 0 x`
show "P 0 x" sorry
}
{
case 2
note prem = `B 0 y`
show "Q 0 y" sorry
}
next
case (Suc n)
note hyps = `!!x. A n x ==> P n x` `!!y. B n y ==> Q n y`
then have some_intermediate_result sorry
{
case 1
note prem = `A (Suc n) x`
show "P (Suc n) x" sorry
}
{
case 2
note prem = `B (Suc n) y`
show "Q (Suc n) y" sorry
}
qed

text {*
Here @{text "induct"} provides again nested cases with numbered
sub-cases, which allows to share common parts of the body context.
In typical applications, there could be a long intermediate proof of
general consequences of the induction hypotheses, before finishing
each conclusion separately.
*}



subsection {* Multiple rules *}

text {*
Multiple induction rules emerge from mutual definitions of
datatypes, inductive predicates, functions etc. The @{text
"induct"} method accepts replicated arguments (with @{text "and"}
separator), corresponding to each projection of the induction
principle.

The goal statement essentially follows the same arrangement,
although it might be subdivided into simultaneous sub-problems as
before!
*}


datatype foo = Foo1 nat | Foo2 bar
and bar = Bar1 bool | Bar2 bazar
and bazar = Bazar foo

text {*
The pack of induction rules for this datatype is: @{thm [display]
foo_bar_bazar.inducts [no_vars]}

This corresponds to the following basic proof pattern:
*}


lemma
fixes foo :: foo
and bar :: bar
and bazar :: bazar
shows "P foo"
and "Q bar"
and "R bazar"
proof (induct foo and bar and bazar)
case (Foo1 n)
show "P (Foo1 n)" sorry
next
case (Foo2 bar)
note `Q bar`
show "P (Foo2 bar)" sorry
next
case (Bar1 b)
show "Q (Bar1 b)" sorry
next
case (Bar2 bazar)
note `R bazar`
show "Q (Bar2 bazar)" sorry
next
case (Bazar foo)
note `P foo`
show "R (Bazar foo)" sorry
qed

text {*
This can be combined with the previous techniques for compound
statements, e.g.\ like this.
*}


lemma
fixes x :: 'a and y :: 'b and z :: 'c
and foo :: foo
and bar :: bar
and bazar :: bazar
shows
"A x foo ==> P x foo"
and
"B1 y bar ==> Q1 y bar"
"B2 y bar ==> Q2 y bar"
and
"C1 z bazar ==> R1 z bazar"
"C2 z bazar ==> R2 z bazar"
"C3 z bazar ==> R3 z bazar"
proof (induct foo and bar and bazar arbitrary: x and y and z)
oops


subsection {* Inductive predicates *}

text {*
The most basic form of induction involving predicates (or sets)
essentially eliminates a given membership fact.
*}


inductive Even :: "nat => bool" where
zero: "Even 0"
| double: "Even n ==> Even (2 * n)"

lemma
assumes "Even n"
shows "P n"
using assms
proof induct
case zero
show "P 0" sorry
next
case (double n)
note `Even n` and `P n`
show "P (2 * n)" sorry
qed

text {*
Alternatively, an initial rule statement may be proven as follows,
performing ``in-situ'' elimination with explicit rule specification.
*}


lemma "Even n ==> P n"
proof (induct rule: Even.induct)
oops

text {*
Simultaneous goals do not introduce anything new.
*}


lemma
assumes "Even n"
shows "P1 n" and "P2 n"
using assms
proof induct
case zero
{
case 1
show "P1 0" sorry
next
case 2
show "P2 0" sorry
}
next
case (double n)
note `Even n` and `P1 n` and `P2 n`
{
case 1
show "P1 (2 * n)" sorry
next
case 2
show "P2 (2 * n)" sorry
}
qed

text {*
Working with mutual rules requires special care in composing the
statement as a two-level conjunction, using lists of propositions
separated by @{text "and"}. For example:
*}


inductive Evn :: "nat => bool" and Odd :: "nat => bool"
where
zero: "Evn 0"
| succ_Evn: "Evn n ==> Odd (Suc n)"
| succ_Odd: "Odd n ==> Evn (Suc n)"

lemma
"Evn n ==> P1 n"
"Evn n ==> P2 n"
"Evn n ==> P3 n"
and
"Odd n ==> Q1 n"
"Odd n ==> Q2 n"
proof (induct rule: Evn_Odd.inducts)
case zero
{ case 1 show "P1 0" sorry }
{ case 2 show "P2 0" sorry }
{ case 3 show "P3 0" sorry }
next
case (succ_Evn n)
note `Evn n` and `P1 n` `P2 n` `P3 n`
{ case 1 show "Q1 (Suc n)" sorry }
{ case 2 show "Q2 (Suc n)" sorry }
next
case (succ_Odd n)
note `Odd n` and `Q1 n` `Q2 n`
{ case 1 show "P1 (Suc n)" sorry }
{ case 2 show "P2 (Suc n)" sorry }
{ case 3 show "P3 (Suc n)" sorry }
qed


text {*
Cases and hypotheses in each case can be named explicitly.
*}


inductive star :: "('a => 'a => bool) => 'a => 'a => bool" for r
where
refl: "star r x x"
| step: "r x y ==> star r y z ==> star r x z"

text {* Underscores are replaced by the default name hyps: *}

lemmas star_induct = star.induct [case_names base step[r _ IH]]

lemma "star r x y ==> star r y z ==> star r x z"
proof (induct rule: star_induct) print_cases
case base
then show ?case .
next
case (step a b c) print_facts
from step.prems have "star r b z" by (rule step.IH)
with step.r show ?case by (rule star.step)
qed

end