Can you suggest how to apply an induction rule to the following lemma?
datatype 'a expr =
Literal "'a literal_expr"
| Var "string"
and 'a literal_expr =
NullLiteral
| CollectionLiteral "'a collection_literal_part_expr list"
and 'a collection_literal_part_expr =
CollectionItem "'a expr"
datatype 'a type = OclVoid | Set "'a type"
inductive typing and collection_parts_typing where
"typing Γ (Literal NullLiteral) OclVoid"
| "collection_parts_typing Γ prts τ ⟹
typing Γ (Literal (CollectionLiteral prts)) (Set τ)"
| "collection_parts_typing Γ [] OclVoid"
| "⟦typing Γ a τ; collection_parts_typing Γ xs σ⟧ ⟹
collection_parts_typing Γ (CollectionItem a # xs) σ"
lemma
"typing Γ1 expr τ1 ⟹ typing Γ1 expr σ1 ⟹ τ1 = σ1" and
"collection_parts_typing Γ2 prts τ2 ⟹
collection_parts_typing Γ2 prts σ2 ⟹ τ2 = σ2"
apply (induct expr and prts)
apply (induct rule: typing_collection_parts_typing.inducts)
The following questions contains a very simple examples:
How to prove lemmas for mutually recursive types?
How to fix "Illegal schematic variable(s)" in mutually recursive rule induction?
But my example is more complicated. And I can't understand what's wrong with my datatypes, predicates or lemmas. This exact theory can be reformulated without mutual recursion. But it's just a small fragment of my actual theory.
There exists a plausible solution that is similar to the one provided in the accepted answer to your previous question. Please note that I changed some of the names of some of the elements in your definitions and that I relied heavily on sledgehammer to bring the proof to a conclusion.
datatype 'a expr =
Literal "'a literal_expr"
| Var "string"
and 'a literal_expr =
NL
| CL "'a clpe list"
and 'a clpe = CI "'a expr"
datatype 'a type = OclVoid | Set "'a type"
inductive typing and cpt where
"typing Γ (Literal NL) OclVoid"
| "cpt Γ prts τ ⟹ typing Γ (Literal (CL prts)) (Set τ)"
| "cpt Γ [] OclVoid"
| "⟦typing Γ a τ; cpt Γ xs σ⟧ ⟹ cpt Γ (CI a # xs) σ"
lemma
fixes Γ1 Γ2 :: 'a
and expr :: "'b expr"
and prts :: "'b clpe list"
and σ1 τ1 σ2 τ2 :: "'c type"
shows
"typing Γ1 expr τ1 ⟹ typing Γ1 expr σ1 ⟹ τ1 = σ1" and
"cpt Γ2 prts τ2 ⟹ cpt Γ2 prts σ2 ⟹ τ2 = σ2"
apply(
induction Γ1 expr τ1 and Γ2 prts τ2
arbitrary: σ1 and σ2
rule: typing_cpt.inducts
)
subgoal by (blast dest: typing.cases)
subgoal
by (metis
expr.inject(1)
literal_expr.distinct(1)
literal_expr.inject
typing.cases)
subgoal by (blast dest: cpt.cases)
subgoal by (metis cpt.cases list.discI list.sel(3))
done
Isabelle version: Isabelle2020
Related
I'm studying topological filters in Filter.thy
theory Filter
imports Set_Interval Lifting_Set
begin
subsection ‹Filters›
text ‹
This definition also allows non-proper filters.
›
locale is_filter =
fixes F :: "('a ⇒ bool) ⇒ bool"
assumes True: "F (λx. True)"
assumes conj: "F (λx. P x) ⟹ F (λx. Q x) ⟹ F (λx. P x ∧ Q x)"
assumes mono: "∀x. P x ⟶ Q x ⟹ F (λx. P x) ⟹ F (λx. Q x)"
typedef 'a filter = "{F :: ('a ⇒ bool) ⇒ bool. is_filter F}"
proof
show "(λx. True) ∈ ?filter" by (auto intro: is_filter.intro)
qed
I don't get this definition. It's quite convoluted so I'll simplify it first
The expression
F (λx. P x) could be simplified to F P (using eta reduction of lambda calculus). The predicate 'a ⇒ bool is really just a set 'a set. Similarly ('a ⇒ bool) ⇒ bool should be 'a set set. Then we could rewrite the axioms as
assumes conj: "P ∈ F ∧ Q ∈ F ⟹ Q ∩ P ∈ F"
assumes mono: "P ⊆ Q ∧ P ∈ F ⟹ Q ∈ F"
Now my question is about the True axiom. It is equivalent to
assumes True: "UNIV ∈ F"
This does not match with the definitions of filters that I ever saw.
The axiom should be instead
assumes True: "{} ∉ F" (* the name True is not very fitting anymore *)
The statement UNIV ∈ F is unnecessary because it follows from axiom mono.
So what's up with this definition that Isabelle provides?
The link provided by Javier Diaz has lots of explanations.
Turns out this is a definition of improper filter. The axiom True is necessary and does not follow from mono. If this axiom was missing then F could be defined as
F P = False
or in set-theory notation, F could be an empty set and mono and conj would then be satisfied vacuously.
Here is a definition of a simple language:
theory SimpleLang
imports Main
begin
type_synonym vname = "string"
datatype exp = BConst bool | IConst int | Let vname exp exp | Var vname | And exp exp
datatype type = BType | IType
type_synonym tenv = "vname ⇒ type option"
inductive typing :: "tenv ⇒ exp ⇒ type ⇒ bool"
("(1_/ ⊢/ (_ :/ _))" [50,0,50] 50) where
BConstTyping: "Γ ⊢ BConst c : BType" |
IConstTyping: "Γ ⊢ IConst c : IType" |
LetTyping: "⟦Γ ⊢ init : t1; Γ(var ↦ t1) ⊢ body : t⟧ ⟹ Γ ⊢ Let var init body : t" |
VarTyping: "Γ var = Some t ⟹ Γ ⊢ Var var : t" |
AndTyping: "⟦Γ ⊢ a : BType; Γ ⊢ b : BType⟧ ⟹ Γ ⊢ And a b : BType"
lemma AndTypingRev:
"Γ ⊢ And a b : BType ⟹ Γ ⊢ a : BType ∧ Γ ⊢ b : BType"
end
I defined a typing function for expressions. And I'm trying to prove that if And-expression has a Bool Type then both of its arguments have Bool Type too. It's a reversion of AndTyping rule from the theory.
Could you suggest how to prove this lemma? Could it be proved without Isar?
inductive proves an elimination rule called typing.cases for this sort of thing. That allows you to do ‘rule inversion’. The Isar way is to do it like this:
lemma AndTypingRev:
assumes "Γ ⊢ And a b : BType"
shows "Γ ⊢ a : BType ∧ Γ ⊢ b : BType"
using assms by (cases rule: typing.cases) auto
Since this is the default rule for case distinctions involving typing, you can also just write by cases auto. In any case, if you use cases for this, you should chain in the assumption involving typing with using, from, etc.
You can also do it without chaining using e.g. erule:
lemma AndTypingRev:
"Γ ⊢ And a b : BType ⟹ Γ ⊢ a : BType ∧ Γ ⊢ b : BType"
by (erule typing.cases) auto
There is another way: You can use the inductive_cases command to automatically generate a suitable lemma for rule inversion (essentially, it's a specialised version of the typing.cases rule):
inductive_cases AndTypingRev: "Γ ⊢ And a b : BType"
You can make it even more general:
inductive_cases AndTypingRev: "Γ ⊢ And a b : t"
That gives you an elimination rule AndTypingRev that you can use with erule, elim, or cases:
?Γ ⊢ And ?a ?b : ?t ⟹
(?t = BType ⟹ ?Γ ⊢ ?a : BType ⟹ ?Γ ⊢ ?b : BType ⟹ ?P) ⟹
?P
Here is a simple theory written on the plain HOL:
theory ToyList
imports Main
begin
no_notation Nil ("[]") and Cons (infixr "#" 65) and append (infixr "#" 65)
hide_type list
hide_const rev
datatype 'a list = Nil ("[]") | Cons 'a "'a list" (infixr "#" 65)
primrec snoc :: "'a list => 'a => 'a list" (infixr "#>" 65)
where
"[] #> y = y # []" |
"(x # xs) #> y = x # (xs #> y)"
primrec rev :: "'a list => 'a list"
where
"rev [] = []" |
"rev (x # xs) = (rev xs) #> x"
lemma rev_snoc [simp]: "rev(xs #> y) = y # (rev xs)"
apply(induct_tac xs)
apply(auto)
done
theorem rev_rev [simp]: "rev(rev xs) = xs"
apply(induct_tac xs)
apply(auto)
done
end
snoc is an opposite of cons. It adds an item to the end of the list.
I want to prove a similar lemma via HOLCF. At a first stage I consider only strict lists. I declared the domain of strict lists in HOLCF. Also I declared two recursive functions:
ssnoc - appends an item to the end of a list
srev - reverses a list
Prefix s means "strict".
theory Test
imports HOLCF
begin
domain 'a SList = SNil | SCons "'a" "'a SList"
fixrec ssnoc :: "'a SList → 'a → 'a SList"
where
"ssnoc ⋅ SNil ⋅ x = SCons ⋅ x ⋅ SNil" |
"ssnoc ⋅ ⊥ ⋅ x = ⊥" |
"x ≠ ⊥ ∧ xs ≠ ⊥ ⟹ ssnoc ⋅ (SCons ⋅ x ⋅ xs) ⋅ y = SCons ⋅ x ⋅ (ssnoc ⋅ xs ⋅ y)"
fixrec srev :: "'a SList → 'a SList"
where
"srev ⋅ ⊥ = ⊥" |
"srev ⋅ SNil = SNil" |
"x ≠ ⊥ ∧ xs ≠ ⊥ ⟹ srev ⋅ (SCons ⋅ x ⋅ xs) = ssnoc ⋅ (srev ⋅ xs) ⋅ x"
lemma srev_singleton [simp]:
"srev ⋅ (SCons ⋅ a ⋅ SNil) = SCons ⋅ a ⋅ SNil"
apply(induct)
apply(simp_all)
done
lemma srev_ssnoc [simp]:
"srev ⋅ (ssnoc ⋅ xs ⋅ a) = SCons ⋅ a ⋅ (srev ⋅ xs)"
apply(induct xs)
apply(simp_all)
done
lemma srev_srev [simp]:
"srev ⋅ (srev ⋅ xs) = xs"
apply(induct xs)
apply(simp_all)
done
end
I'm trying to prove that double reversion of the list equals to the original list (srev_srev lemma). I have declared two helper lemmas:
srev_singleton - reverse of the singleton list is the original singleton list
srev_ssnoc - reversion of the list equals to the list starting from the last item of the original list appending reversion of the rest items of the original list
But I can't prove any of the lemmas. Could you point out the errors?
Also why the precondition "x ≠ ⊥ ∧ xs ≠ ⊥" is necessary in the function definitions? And why should I declare "srev ⋅ ⊥ = ⊥" and "ssnoc ⋅ ⊥ ⋅ x = ⊥" explicitly. I guess that in HOLCF by default functions are undefined if any of the arguments is undefined.
If your intention is to model lists a la Haskell (aka "lazy lists"), then you should use something like:
domain 'a list = Nil ("[]") | Cons (lazy 'a) (lazy "'a list") (infix ":" 65)
(note the "lazy" annotations for Cons). Then you do not need the assumptions on your third equation. E.g.,
fixrec append :: "'a list → 'a list → 'a list"
where
"append $ [] $ ys = ys"
| "append $ (x : xs) $ ys = x : (append $ xs $ ys)"
for what you called ssnoc and
fixrec reverse :: "'a list → 'a list"
where
"reverse $ [] = []"
| "reverse $ (x : xs) = append $ xs $ (x : [])"
for reverse.
However, since this type of lists allows for "infinite" values, you will not be able to prove that reverse $ (reverse $ xs) = xs hold in general (because it doesn't). This only holds for finite lists, which can be characterized inductively. (See, e.g., https://arxiv.org/abs/1306.1340 for a more detailed discussion.)
If, however, you do not want to model lazy lists (i.e., really don't want the "lazy" annotations in your datatype), then your equations might not hold without the assumptions. Now if the equations have those assumptions, they can only be applied in cases where the assumptions are satisfied. So gain, you will not be able to proof (without additional assumptions) that reverse $ (reverse $ xs) = xs. It might again be possible to obtain the appropriate assumptions by an inductive predicate, but I did not investigate further.
Update: After playing a bit with strict lists in HOLCF, I have some more comments:
First, my guess is that the preconditions in the fixrec specifications are necessary due to the internal construction, but we are able to get rid of them afterwards.
I managed to prove your lemma as follows. For completeness I give the whole content of my theory file. First make sure that notation doesn't clash with existing one:
no_notation
List.Nil ("[]") and
Set.member ("op :") and
Set.member ("(_/ : _)" [51, 51] 50)
Then define the type of strict lists
domain 'a list = Nil ("[]") | Cons 'a "'a list" (infixr ":" 65)
and the function snoc.
fixrec snoc :: "'a list → 'a → 'a list"
where
"snoc $ [] $ y = y : []"
| "x ≠ ⊥ ⟹ xs ≠ ⊥ ⟹ snoc $ (x:xs) $ y = x : snoc $ xs $ y"
Now, we obtain an unconditional variant of the second equation by:
Showing that snoc is strict in its first argument (note the usage of fixrec_simp).
Showing that snoc is strict in its second argument (here induction is needed).
And finally, obtaining the equation by case analysis on all three variables.
lemma snoc_bot1 [simp]: "snoc $ ⊥ $ y = ⊥" by fixrec_simp
lemma snoc_bot2 [simp]: "snoc $ xs $ ⊥ = ⊥" by (induct xs) simp_all
lemma snoc_Cons [simp]: "snoc $ (x:xs) $ y = x : snoc $ xs $ y"
by (cases "x = ⊥"; cases "xs = ⊥"; cases "y = ⊥";simp)
Then the function reverse
fixrec reverse :: "'a list → 'a list"
where
"reverse $ [] = []"
| "x ≠ ⊥ ⟹ xs ≠ ⊥ ⟹ reverse $ (x : xs) = snoc $ (reverse $ xs) $ x"
and again an unconditional variant of its second equation:
lemma reverse_bot [simp]: "reverse $ ⊥ = ⊥" by fixrec_simp
lemma reverse_Cons [simp]: "reverse $ (x : xs) = snoc $ (reverse $ xs) $ x"
by (cases "x = ⊥"; cases "xs = ⊥"; simp)
Now the lemma about reverse and snoc you also had:
lemma reverse_snoc [simp]: "reverse $ (snoc $ xs $ y) = y : reverse $ xs"
by (induct xs) simp_all
And finally the desired lemma:
lemma reverse_reverse [simp]:
"reverse $ (reverse $ xs) = xs"
by (induct xs) simp_all
The way I obtained this solution was by just looking into the remaining subgoals of your failed attempts, then get more failed attempts, look into the remaining subgoals, repeat, ...
I've written some simple parser combinators (without backtracking etc.). Here are the important definitions for my problem.
type_synonym ('a, 's) parser = "'s list ⇒ ('a * 's list) option"
definition sequenceP :: "('a, 's) parser
⇒ ('b, 's) parser
⇒ ('b, 's) parser" (infixl ">>P" 60) where
"sequenceP p q ≡ λ i .
(case p i of
None ⇒ None
| Some v ⇒ q (snd v))"
definition consumerP :: "('a, 's) parser ⇒ bool" where
"consumerP p ≡ (∀ i . (case p i of
None ⇒ True |
Some v ⇒ length (snd v) ≤ length i))"
I do want to proof the following lemma.
lemma consumerPI: "consumerP p ⟹ consumerP q ⟹ consumerP (p >>P q)"
apply (unfold sequenceP_def)
apply (simp (no_asm) add:consumerP_def)
apply clarsimp
apply (case_tac "case p i of None ⇒ None | Some v ⇒ q (snd v)")
apply simp
apply clarsimp
apply (case_tac "p i")
apply simp
apply clarsimp
apply (unfold consumerP_def)
I arrive at this proof state, at which I fail to continue.
goal (1 subgoal):
1. ⋀i a b aa ba.
⟦∀i. case p i of None ⇒ True | Some v ⇒ length (snd v) ≤ length i;
∀i. case q i of None ⇒ True | Some v ⇒ length (snd v) ≤ length i; q ba = Some (a, b); p i = Some (aa, ba)⟧
⟹ length b ≤ length i
Can anybody give me a tip how to solve this goal?
Thanks in advance!
It turns out that if you just want to prove the lemma, without further insight, then
lemma consumerPI: "consumerP p ⟹ consumerP q ⟹ consumerP (p >>P q)"
by (smt consumerP_def le_trans option.case_eq_if sequenceP_def)
does the job.
If you want to have insight, you want to go for a structured proof. First identify some useful lemmas about consumerP, and then write a Isar proof that details the necessary steps.
lemma consumerPI[intro!]:
assumes "⋀ i x r . p i = Some (x,r) ⟹ length r ≤ length i"
shows "consumerP p"
unfolding consumerP_def by (auto split: option.split elim: assms)
lemma consumerPE[elim, consumes 1]:
assumes "consumerP p"
assumes "p i = Some (x,r)"
shows "length r ≤ length i"
using assms by (auto simp add: consumerP_def split: option.split_asm)
lemma consumerP_sequencePI: "consumerP p ⟹ consumerP q ⟹ consumerP (p >>P q)"
proof-
assume "consumerP p"
assume "consumerP q"
show "consumerP (p >>P q)"
proof(rule consumerPI)
fix i x r
assume "(p >>P q) i = Some (x, r)"
then obtain x' r' where "p i = Some (x', r')" and "q r' = Some (x,r)"
by (auto simp add: sequenceP_def split:option.split_asm)
from `consumerP q` and `q r' = Some (x, r)`
have "length r ≤ length r'" by (rule consumerPE)
also
from `consumerP p` and `p i = Some (x', r')`
have "length r' ≤ length i" by (rule consumerPE)
finally
show "length r ≤ length i".
qed
qed
In fact, for this definition you can very nicely use the inductive command, and get intro and elim rules for free:
inductive consumerP where
consumerPI: "(⋀ i x r . p i = Some (x,r) ⟹ length r ≤ length i) ⟹ consumerP p"
In the above proof, you can replace by (rule consumerPE) by by cases and it works.
expect to use the subgoal to run the list which defined by let? aa = [1,2]
and run rev_app on this aa and show the value as [2,1]
theory Scratch2
imports Datatype
begin
datatype 'a list = Nil ("[]")
| Cons 'a "'a list" (infixr "#" 65)
(* This is the append function: *)
primrec app :: "'a list => 'a list => 'a list" (infixr "#" 65)
where
"[] # ys = ys" |
"(x # xs) # ys = x # (xs # ys)"
primrec rev :: "'a list => 'a list" where
"rev [] = []" |
"rev (x # xs) = (rev xs) # (x # [])"
primrec itrev :: "'a list => 'a list => 'a list" where
"itrev [] ys = ys" |
"itrev (x#xs) ys = itrev xs (x#ys)"
value "rev (True # False # [])"
lemma app_Nil2 [simp]: "xs # [] = xs"
apply(induct_tac xs)
apply(auto)
done
lemma app_assoc [simp]: "(xs # ys) # zs = xs # (ys # zs)"
apply(induct_tac xs)
apply(auto)
done
(1 st trial)
lemma rev_app [simp]: "rev(xs # ys) = (rev ys) # (rev xs)"
apply(induct_tac xs)
thus ?aa by rev_app
show "rev_app [1; 2]"
(2nd trial)
value "rev_app [1,2]"
(3 rd trial)
fun ff :: "'a list ⇒ 'a list"
where "rev(xs # ys) = (rev ys) # (rev xs)"
value "ff [1,2]"
thus ?aa by rev_app
show "rev_app [1; 2]"
end
Firstly, you need the syntax for list enumeration (I just picked it up in the src/HOL/List.thy file):
syntax
-- {* list Enumeration *}
"_list" :: "args => 'a list" ("[(_)]")
translations
"[x, xs]" == "x#[xs]"
"[x]" == "x#[]"
Then, is one of the following what you're searching for ?
Proposition 1:
lemma example1: "rev [a, b] = [b, a]"
by simp
This lemma is proved by applying the definition rules of rev that are used by the method simp to rewrite the left-hand term and prove that the two sides of the equality are equal. This is the solution I prefer because you can see the example is satisfied even without evaluating it with Isabelle.
Proposition 2:
value "rev [a, b]" (* return "[b, a]" *)
Here and in Proposition 3, we just uses the command value to evaluate rev.
Proposition 3:
value "rev [a, b] = [b, a]" (* returns "True" *)
This lemma is not used by the previous propositions:
lemma rev_app [simp]: "rev(xs # ys) = (rev ys) # (rev xs)"
apply (induct_tac xs)
by simp_all
Notes:
As a general principle, you shouldn't import the "Datatype" package alone, but import "Main" instead.
In your 1st attempt you're mixing the "apply" (apply ...) and the "structured proof" (thus ...) styles
"thus ?aa" makes no sense if "?aa" is "[1,2]" as the argument of "thus" should be a subgoal, ie. a proposition with a boolean value.
To evaluate, the command "value" uses ML execution or if this fails, normalisation by evaluation.
In example1, you can use a custom proof and thus lemmas (for example: by (simp add:rev_app)