Reasoning about overlapping inductive definitions in Isabelle - isabelle

I would like to prove the following lemma in Isabelle:
lemma "T (Open # xs) ⟹ ¬ S (Open # xs) ⟹ count xs Close ≤ count xs Open"
Please find the definitions below:
datatype paren = Open | Close
inductive S where
S_empty: "S []" |
S_append: "S xs ⟹ S ys ⟹ S (xs # ys)" |
S_paren: "S xs ⟹ S (Open # xs # [Close])"
inductive T where
T_S: "T []" |
T_append: "T xs ⟹ T ys ⟹ T (xs # ys)" |
T_paren: "T xs ⟹ T (Open # xs # [Close])" |
T_left: "T xs ⟹ T (Open # xs)"
The lemma states that an unbalanced parentheses structure would result in a possibly unbalanced structure when removing an Open bracket.
I've been trying the techniques that are described in the book "A proof-assistant for Higher-order logic", but so far none of them work. In particular, I tried to use rule inversion and rule induction, sledgehammer and other techniques.
One of the problems is that I haven't yet learned about Isar proofs, which thus complicates the proof. I would prefer if you can orient me with plain apply commands.

Please find a proof below. It is not unlikely that it can be improved: I tried to follow the simplest route towards the proof and relied on sledgehammer to fill in the details.
theory so_raoidii
imports Complex_Main
begin
datatype paren = Open | Close
inductive S where
S_empty: "S []" |
S_append: "S xs ⟹ S ys ⟹ S (xs # ys)" |
S_paren: "S xs ⟹ S (Open # xs # [Close])"
inductive T where
T_S: "T []" |
T_append: "T xs ⟹ T ys ⟹ T (xs # ys)" |
T_paren: "T xs ⟹ T (Open # xs # [Close])" |
T_left: "T xs ⟹ T (Open # xs)"
lemma count_list_lem:
"count_list xsa a = n ⟹
count_list ysa a = m ⟹
count_list (xsa # ysa) a = n + m"
apply(induction xsa arbitrary: ysa n m)
apply auto
done
lemma T_to_count: "T xs ⟹ count_list xs Close ≤ count_list xs Open"
apply(induction rule: T.induct)
by (simp add: count_list_lem)+
lemma T_to_S_count: "T xs ⟹ count_list xs Close = count_list xs Open ⟹ S xs"
apply(induction rule: T.induct)
apply(auto)
apply(simp add: S_empty)
apply(metis S_append T_to_count add.commute add_le_cancel_right count_list_lem
dual_order.antisym)
apply(simp add: count_list_lem S_paren)
using T_to_count by fastforce
lemma "T (Open # xs) ⟹
¬ S (Open # xs) ⟹
count_list xs Close ≤ count_list xs Open"
apply(cases "T xs")
apply(simp add: T_to_count)
using T_to_S_count T_to_count by fastforce
end

Related

Proving the correctness of an algorithm to partition lists in Isabelle

I trying to prove correct an algorithm to split a list of integers into sublists of equal sum in linear time. Here you can see the algorithm I have chosen to do so.
I would like to get some feedback regarding:
The convenience of my definition for the splitting function.
The "induction" hypothesis to use in my situation.
Please, bear in mind that up to now I have only worked with apply-scripts and not with Isar proofs.
Here is a preliminary implementation of the algorithm and the correctness definition:
definition
"ex_balanced_sum xs = (∃ ys zs. sum_list ys = sum_list zs ∧
xs = ys # zs ∧ ys ≠ [] ∧ zs ≠ [])"
fun check_list :: "int list ⇒ int ⇒ int ⇒ bool" where
"check_list [] n acc = False" |
"check_list (x#xs) n acc = (if n = acc then True else (check_list xs (n-x) (acc+x)))"
fun linear_split :: "int list ⇒ bool" where
"linear_split [] = False" |
"linear_split [x] = False" |
"linear_split (x # xs) = check_list xs (sum_list xs) x"
The theorem to prove is as follows:
lemma linear_correct: "linear_split xs ⟷ ex_balanced_sum xs"
If I reason for instance for the first implication as:
lemma linear_correct_1: "linear_split xs ⟹ ex_balanced_sum xs"
apply(induction xs rule: linear_split.induct)
Then I get a list of subgoals that I think are not appropriate:
linear_split [] ⟹ ex_balanced_sum []
⋀x. linear_split [x] ⟹ ex_balanced_sum [x]
⋀x v va. linear_split (x # v # va) ⟹ ex_balanced_sum (x # v # va)
In particular, these subgoals don't have an induction hypothesis! (am I right?). I tried to perform a different induction by just writing apply(induction xs) but then the goals look as:
linear_split [] ⟹ ex_balanced_sum []
⋀a xs. (linear_split xs ⟹ ex_balanced_sum xs) ⟹ linear_split (a # xs) ⟹ ex_balanced_sum (a # xs)
Here the hypothesis is also not an induction hypothesis since it is assuming an implication.
So, what is the best way to define this function to get a nice induction hypothesis?
Edit (a one-function version)
fun check :: "int list ⇒ int ⇒ int ⇒ bool" where
"check [] n acc = False" |
"check [x] n acc = False" |
"check (x # y # xs) n acc = (if n-x = acc+x then True else check (y # xs) (n-x) (acc+x))"
definition "linear_split xs = check xs (sum_list xs) 0"
Background
I was able to prove the theorem linear_correct for a function (splitl) that is very similar to the function check in the statement of the question. Unfortunately, I would prefer not to make any attempts to convert the proof into an apply script.
The proof below is the first proof that came to my mind after I started investigating the question. Thus, there may exist better proofs.
Proof Outline
The proof is based on the induction based on the length of the list. In particular, assume
splitl xs (sum_list xs) 0 ⟹ ex_balanced_sum xs
holds for all lists with the length less than l. If l = 1, then the result is easy to show. Assume, that l>=2. Then the list can be expressed in the form x#v#xs. In this case if it is possible to split the list using splitl, then it can be shown (splitl_reduce) that either
"splitl ((x + v)#xs) (sum_list ((x + v)#xs)) 0" (1)
or
"x = sum_list (v#xs)" (2).
Thus, the proof proceeds by cases for (1) and (2). For (1), the length of the list is (x + v)#xs) is l-1. Hence, by the induction hypothesis ex_balanced_sum (x + v)#xs). Therefore, by the definition of ex_balanced_sum, also ex_balanced_sum x#v#xs. For (2), it can be easily seen that the list can be expressed as [x]#(v#xs) and, in this case, given (2), it satisfies the conditions of ex_balanced_sum by definition.
The proof for the other direction is similar and based on the converse of the lemma associated with (1) and (2) above: if "splitl ((x + v)#xs) (sum_list ((x + v)#xs)) 0" or "x = sum_list (v#xs)", then "splitl (x#v#xs) (sum_list (x#v#xs)) 0".
theory so_ptcoaatplii
imports Complex_Main
begin
definition
"ex_balanced_sum xs =
(∃ ys zs. sum_list ys = sum_list zs ∧ xs = ys # zs ∧ ys ≠ [] ∧ zs ≠ [])"
fun splitl :: "int list ⇒ int ⇒ int ⇒ bool" where
"splitl [] s1 s2 = False" |
"splitl [x] s1 s2 = False" |
"splitl (x # xs) s1 s2 = ((s1 - x = s2 + x) ∨ splitl xs (s1 - x) (s2 + x))"
lemma splitl_reduce:
assumes "splitl (x#v#xs) (sum_list (x#v#xs)) 0"
shows "splitl ((x + v)#xs) (sum_list ((x + v)#xs)) 0 ∨ x = sum_list (v#xs)"
proof -
from assms have prem_cases:
"((x = sum_list (v#xs)) ∨ splitl (v#xs) (sum_list (v#xs)) x)" by auto
{
assume "splitl (v#xs) (sum_list (v#xs)) x"
then have "splitl ((x + v)#xs) (sum_list ((x + v)#xs)) 0"
proof(induction xs arbitrary: x v)
case Nil then show ?case by simp
next
case (Cons a xs) then show ?case by simp
qed
}
with prem_cases show ?thesis by auto
qed
(*Sledgehammered*)
lemma splitl_expand:
assumes "splitl ((x + v)#xs) (sum_list ((x + v)#xs)) 0 ∨ x = sum_list (v#xs)"
shows "splitl (x#v#xs) (sum_list (x#v#xs)) 0"
by (smt assms list.inject splitl.elims(2) splitl.simps(3) sum_list.Cons)
lemma splitl_to_sum: "splitl xs (sum_list xs) 0 ⟹ ex_balanced_sum xs"
proof(induction xs rule: length_induct)
case (1 xs) show ?case
proof-
obtain x v xst where x_xst: "xs = x#v#xst"
by (meson "1.prems" splitl.elims(2))
have main_cases:
"splitl ((x + v)#xst) (sum_list ((x + v)#xst)) 0 ∨ x = sum_list (v#xst)"
by (rule splitl_reduce, insert x_xst "1.prems", rule subst)
{
assume "splitl ((x + v)#xst) (sum_list ((x + v)#xst)) 0"
with "1.IH" x_xst have "ex_balanced_sum ((x + v)#xst)" by simp
then obtain yst zst where
yst_zst: "(x + v)#xst = yst#zst"
and sum_yst_eq_sum_zst: "sum_list yst = sum_list zst"
and yst_ne: "yst ≠ []"
and zst_ne: "zst ≠ []"
unfolding ex_balanced_sum_def by auto
then obtain ystt where ystt: "yst = (x + v)#ystt"
by (metis append_eq_Cons_conv)
with sum_yst_eq_sum_zst have "sum_list (x#v#ystt) = sum_list zst" by simp
moreover have "xs = (x#v#ystt)#zst" using x_xst yst_zst ystt by auto
moreover have "(x#v#ystt) ≠ []" by simp
moreover with zst_ne have "zst ≠ []" by simp
ultimately have "ex_balanced_sum xs" unfolding ex_balanced_sum_def by blast
}
note prem = this
{
assume "x = sum_list (v#xst)"
then have "sum_list [x] = sum_list (v#xst)" by auto
moreover with x_xst have "xs = [x] # (v#xst)" by auto
ultimately have "ex_balanced_sum xs" using ex_balanced_sum_def by blast
}
with prem main_cases show ?thesis by blast
qed
qed
lemma sum_to_splitl: "ex_balanced_sum xs ⟹ splitl xs (sum_list xs) 0"
proof(induction xs rule: length_induct)
case (1 xs) show ?case
proof -
from "1.prems" ex_balanced_sum_def obtain ys zs where
ys_zs: "xs = ys#zs"
and sum_ys_eq_sum_zs: "sum_list ys = sum_list zs"
and ys_ne: "ys ≠ []"
and zs_ne: "zs ≠ []"
by blast
have prem_cases: "∃y v yst. ys = (y#v#yst) ∨ (∃y. ys = [y])"
by (metis remdups_adj.cases ys_ne)
{
assume "∃y. ys = [y]"
then have "splitl xs (sum_list xs) 0"
using splitl.elims(3) sum_ys_eq_sum_zs ys_zs zs_ne by fastforce
}
note prem = this
{
assume "∃y v yst. ys = (y#v#yst)"
then obtain y v yst where y_v_yst: "ys = (y#v#yst)" by auto
then have
"sum_list ((y + v)#yst) = sum_list zs ∧ ((y + v)#yst) ≠ [] ∧ zs ≠ []"
using sum_ys_eq_sum_zs zs_ne by auto
then have ebs_ypv: "ex_balanced_sum (((y + v)#yst)#zs)"
using ex_balanced_sum_def by blast
have l_ypv: "length (((y + v)#yst)#zs) < length xs"
by (simp add: y_v_yst ys_zs)
from l_ypv ebs_ypv have
"splitl (((y + v)#yst)#zs) (sum_list (((y + v)#yst)#zs)) 0"
by (rule "1.IH"[THEN spec, rule_format])
with splitl_expand have splitl_ys_exp:
"splitl ((y#v#yst)#zs) (sum_list ((y#v#yst)#zs)) 0"
by (metis Cons_eq_appendI)
from ys_zs have "splitl xs (sum_list xs) 0"
by (rule ssubst, insert y_v_yst splitl_ys_exp, simp)
}
with prem prem_cases show ?thesis by auto
qed
qed
lemma linear_correct: "ex_balanced_sum xs ⟷ splitl xs (sum_list xs) 0"
using splitl_to_sum sum_to_splitl by auto
end

How to lift a transitive relation from elements to lists?

I'm trying to prove that a transitive relation on elements of lists is equivalent to a transitive relation on lists (under some conditions).
Here is a first lemma:
lemma list_all2_rtrancl1:
"(list_all2 P)⇧*⇧* xs ys ⟹
list_all2 P⇧*⇧* xs ys"
apply (induct rule: rtranclp_induct)
apply (simp add: list.rel_refl)
by (smt list_all2_trans rtranclp.rtrancl_into_rtrancl)
And here is a symmetric lemma:
lemma list_all2_rtrancl2:
"(⋀x. P x x) ⟹
list_all2 P⇧*⇧* xs ys ⟹
(list_all2 P)⇧*⇧* xs ys"
apply (erule list_all2_induct)
apply simp
I guess that a relation should be reflexive. But maybe I should use another assumptions. The lemma could be proven given the assumption that P is transitive, however P is not transitive. I'm stuck. Could you suggest what assumptions to choose and how to prove this lemma?
It seems that nitpick gives me a wrong counterexample for the specific case of the last lemma (xs = [0] and ys = [2]):
lemma list_all2_rtrancl2_example:
"list_all2 (λx y. x = y ∨ Suc x = y)⇧*⇧* xs ys ⟹
(list_all2 (λx y. x = y ∨ Suc x = y))⇧*⇧* xs ys"
nitpick
I can prove that the lemma holds for this example:
lemma list_all2_rtrancl2_example_0_2:
"list_all2 (λx y. x = y ∨ Suc x = y)⇧*⇧* [0] [2] ⟹
(list_all2 (λx y. x = y ∨ Suc x = y))⇧*⇧* [0] [2]"
apply (rule_tac ?b="[1]" in converse_rtranclp_into_rtranclp; simp)
apply (rule_tac ?b="[2]" in converse_rtranclp_into_rtranclp; simp)
done
It may be feasible to use listrel instead of list_all2. Indeed, as shown below, they are equivalent (see set_listrel_eq_list_all2). However, there are several theorems in the standard library about listrel that do not have their equivalents for list_all2.
lemma set_listrel_eq_list_all2:
"listrel {(x, y). r x y} = {(xs, ys). list_all2 r xs ys}"
using list_all2_conv_all_nth listrel_iff_nth by fastforce
lemma listrel_tclosure_1: "(listrel r)⇧* ⊆ listrel (r⇧*)"
by
(
simp add:
listrel_rtrancl_eq_rtrancl_listrel1
listrel_subset_rtrancl_listrel1
rtrancl_subset_rtrancl
)
lemma listrel_tclosure_2: "refl r ⟹ listrel (r⇧*) ⊆ (listrel r)⇧*"
by
(
simp add:
listrel1_subset_listrel
listrel_rtrancl_eq_rtrancl_listrel1
rtrancl_mono
)
context
includes lifting_syntax
begin
lemma listrel_list_all2_transfer[transfer_rule]:
"((=) ===> (=) ===> (=) ===> (=))
(λr xs ys. (xs, ys) ∈ listrel {(x, y). r x y}) list_all2"
unfolding rel_fun_def using set_listrel_eq_list_all2 listrel_iff_nth by blast
end
lemma list_all2_rtrancl_1:
"(list_all2 r)⇧*⇧* xs ys ⟹ list_all2 r⇧*⇧* xs ys"
proof transfer
fix r :: "'a ⇒ 'a ⇒ bool" and xs :: "'a list" and ys:: "'a list"
assume "(λxs ys. (xs, ys) ∈ listrel {(x, y). r x y})⇧*⇧* xs ys"
then have "(xs, ys) ∈ (listrel {(x, y). r x y})⇧*"
unfolding rtranclp_def rtrancl_def by auto
then have "(xs, ys) ∈ listrel ({(x, y). r x y}⇧*)"
using listrel_tclosure_1 by auto
then show "(xs, ys) ∈ listrel {(x, y). r⇧*⇧* x y}"
unfolding rtranclp_def rtrancl_def by auto
qed
lemma list_all2_rtrancl_2:
"reflp r ⟹ list_all2 r⇧*⇧* xs ys ⟹ (list_all2 r)⇧*⇧* xs ys"
proof transfer
fix r :: "'a ⇒ 'a ⇒ bool" and xs :: "'a list" and ys :: "'a list"
assume as_reflp: "reflp r" and p_in_lr: "(xs, ys) ∈ listrel {(x, y). r⇧*⇧* x y}"
from as_reflp have refl: "refl {(x, y). r x y}"
using reflp_refl_eq by fastforce
from p_in_lr have "(xs, ys) ∈ listrel ({(x, y). r x y}⇧*)"
unfolding rtranclp_def rtrancl_def by auto
with refl have "(xs, ys) ∈ (listrel {(x, y). r x y})⇧*"
using listrel_tclosure_2 by auto
then show "(λxs ys. (xs, ys) ∈ listrel {(x, y). r x y})⇧*⇧* xs ys"
unfolding rtranclp_def rtrancl_def by auto
qed
A direct proof for list_all2 is also provided (legacy):
list_all2_induct is applied to the lists; the base case is trivial. Thence, it remains to show that (L P)* x#xs y#ys if (L (P*)) xs ys, (L P)* xs ys and P* x y.
The idea is that it is possible to find zs (e.g. xs) such that (L P) xs zs and (L P)+ zs ys.
Then, given that P* x y and P x x, by induction based on the transitive properties of P*, (L P) x#xs y#zs. Therefore, also, (L P)* x#xs y#zs.
Also, given that (L P)+ zs ys and P y y, by induction, (L P)+ y#zs y#ys. Thus, also, (L P)* y#zs y#ys.
From 3 and 4 conclude (L P)* x#xs y#ys.
lemma list_all2_rtrancl2:
assumes as_r: "(⋀x. P x x)"
shows "(list_all2 P⇧*⇧*) xs ys ⟹ (list_all2 P)⇧*⇧* xs ys"
proof(induction rule: list_all2_induct)
case Nil then show ?case by simp
next
case (Cons x xs y ys) show ?case
proof -
from as_r have lp_xs_xs: "list_all2 P xs xs" by (rule list_all2_refl)
from Cons.hyps(1) have x_xs_y_zs: "(list_all2 P)⇧*⇧* (x#xs) (y#xs)"
proof(induction rule: rtranclp_induct)
case base then show ?case by simp
next
case (step y z) then show ?case
proof -
have rt_step_2: "(list_all2 P)⇧*⇧* (y#xs) (z#xs)"
by (rule r_into_rtranclp, rule list_all2_Cons[THEN iffD2])
(simp add: step.hyps(2) lp_xs_xs)
from step.IH rt_step_2 show ?thesis by (rule rtranclp_trans)
qed
qed
from Cons.IH have "(list_all2 P)⇧*⇧* (y#xs) (y#ys)"
proof(induction rule: rtranclp_induct)
case base then show ?case by simp
next
case (step ya za) show ?case
proof -
have rt_step_2: "(list_all2 P)⇧*⇧* (y#ya) (y#za)"
by (rule r_into_rtranclp, rule list_all2_Cons[THEN iffD2])
(simp add: step.hyps(2) as_r)
from step.IH rt_step_2 show ?thesis by (rule rtranclp_trans)
qed
qed
with x_xs_y_zs show ?thesis by simp
qed
qed
As a side note, in my view (I know very little about nitpick), nitpick should not provide invalid counterexamples without any warning. I believe, usually, when nitpick 'suspects' that a counterexample may be invalid it notifies the user that the example is 'potentially spurious'. It may be useful to submit a bug report if this issue has not been recorded elsewhere.
Isabelle version: Isabelle2020

How to use different code lemmas for different modes of inductive predicate?

(The question is related to How to define an inductive predicate on fset? but a more concrete)
Here is a simple theory with 2 kinds of values and a casting predicate:
theory FSetIndTest
imports Main "~~/src/HOL/Library/FSet"
begin
datatype val1 = A | B
datatype val2 = C | D
inductive cast_val :: "val1 ⇒ val2 ⇒ bool" where
"cast_val A C"
| "cast_val B D"
code_pred [show_modes] cast_val .
fun cast_val_fun :: "val1 ⇒ val2" where
"cast_val_fun A = C"
| "cast_val_fun B = D"
fun cast_val_fun_inv :: "val2 ⇒ val1" where
"cast_val_fun_inv C = A"
| "cast_val_fun_inv D = B"
I'm trying to define a cast predicate for fsets. It works fine in i ⇒ o ⇒ bool mode, but doesn't support o ⇒ i ⇒ bool mode:
inductive cast_fset1 :: "val1 fset ⇒ val2 fset ⇒ bool" where
"cast_fset1 {||} {||}"
| "cast_val x y ⟹ cast_fset1 xs ys ⟹
cast_fset1 (finsert x xs) (finsert y ys)"
lemma cast_fset1_left [code_pred_intro]:
"fimage cast_val_fun xs = ys ⟹ cast_fset1 xs ys"
apply (induct xs arbitrary: ys)
apply (simp add: cast_fset1.intros(1))
by (metis (full_types) cast_fset1.intros(2) cast_val.intros(1) cast_val.intros(2) cast_val_fun.simps(1) cast_val_fun.simps(2) fimage_finsert val1.exhaust)
lemma cast_fset1_left_inv:
"cast_fset1 xs ys ⟹
fimage cast_val_fun xs = ys"
apply (induct rule: cast_fset1.induct)
apply simp
using cast_val.simps by auto
code_pred [show_modes] cast_fset1
by (simp add: cast_fset1_left_inv)
values "{x. cast_fset1 {|A, B|} x}"
So I try to define a code lemma for both arguments. And as result only i ⇒ i ⇒ bool mode is supported:
inductive cast_fset2 :: "val1 fset ⇒ val2 fset ⇒ bool" where
"cast_fset2 {||} {||}"
| "cast_val x y ⟹ cast_fset2 xs ys ⟹
cast_fset2 (finsert x xs) (finsert y ys)"
lemma cast_fset2_code [code_pred_intro]:
"fimage cast_val_fun xs = ys ⟹ cast_fset2 xs ys"
"fimage cast_val_fun_inv ys = xs ⟹ cast_fset2 xs ys"
apply (auto)
apply (induct xs arbitrary: ys)
apply (simp add: cast_fset2.intros(1))
apply (metis (full_types) cast_fset2.intros(2) cast_val.intros(1) cast_val.intros(2) cast_val_fun.simps(1) cast_val_fun.simps(2) fimage_finsert val1.exhaust)
apply (induct ys arbitrary: xs)
apply (simp add: cast_fset2.intros(1))
by (smt cast_fset2.intros(2) cast_val.intros(1) cast_val.intros(2) cast_val_fun_inv.elims cast_val_fun_inv.simps(1) fimage_finsert)
lemma cast_fset2_code_inv:
"cast_fset2 xs ys ⟹ fimage cast_val_fun xs = ys"
"cast_fset2 xs ys ⟹ fimage cast_val_fun_inv ys = xs"
apply (induct rule: cast_fset2.induct)
apply simp
apply simp
using cast_val.simps cast_val_fun.simps(1) apply auto[1]
using cast_val.simps by auto
code_pred [show_modes] cast_fset2
by (simp add: cast_fset2_code_inv(1))
I'm trying to use [code] annotation instead of [code_pred_intro]:
inductive cast_fset3 :: "val1 fset ⇒ val2 fset ⇒ bool" where
"cast_fset3 {||} {||}"
| "cast_val x y ⟹ cast_fset3 xs ys ⟹
cast_fset3 (finsert x xs) (finsert y ys)"
lemma cast_fset3_left:
"fimage cast_val_fun xs = ys ⟹ cast_fset3 xs ys"
apply (induct xs arbitrary: ys)
apply (simp add: cast_fset3.intros(1))
by (metis (full_types) cast_fset3.intros(2) cast_val.intros(1) cast_val.intros(2) cast_val_fun.simps(1) cast_val_fun.simps(2) fimage_finsert val1.exhaust)
lemma cast_fset3_left_inv:
"cast_fset3 xs ys ⟹
fimage cast_val_fun xs = ys"
apply (induct rule: cast_fset3.induct)
apply simp
using cast_val.simps by auto
lemma cast_fset3_left_code [code]:
"fimage cast_val_fun xs = ys ⟷
cast_fset3 xs ys"
using cast_fset3_left cast_fset3_left_inv by blast
But I get the following warning and the lemma is ignored at all:
Partially applied constant "FSetIndTest.cast_val_fun" on left hand side of equation, in theorem:
cast_val_fun |`| ?xs = ?ys ≡ cast_fset3 ?xs ?ys
Is it possible to use different code lemmas for different modes (i ⇒ o ⇒ bool, o ⇒ i ⇒ bool) of an inductive predicate? How to fix last lemma? Why I get this warning?
Code generation for an inductive predicate always operates on the same set of introduction rules; however you are always free to introduce a copy of an existing inductive predicate and equip that with a different set of introduction rules.
The attribute [code] is just for equations, not for introduction rules.

Basic Isabelle/Isar style (exercise 4.6)

I'm interested in using Isabelle/Isar for writing proofs which are both human-readable and machine checked, and I am looking to improve my style and streamline my proofs.
prog-prove has the following exercise:
Exercise 4.6. Define a recursive function elems :: 'a list ⇒ 'a set and prove x ∈ elems xs ⟹ ∃ ys zs. xs = ys # x # zs ∧ x ∉ elems ys.
Mimicking something similar to what I would write with pen and paper, my solution is
fun elems :: "'a list ⇒ 'a set" where
"elems [] = {}" |
"elems (x # xs) = {x} ∪ elems xs"
fun takeUntil :: "('a ⇒ bool) ⇒ 'a list ⇒ 'a list" where
"takeUntil f [] = []" |
"takeUntil f (x # xs) = (case (f x) of False ⇒ x # takeUntil f xs | True ⇒ [])"
theorem "x ∈ elems xs ⟹ ∃ ys zs. xs = ys # x # zs ∧ x ∉ elems ys"
proof -
assume 1: "x ∈ elems xs"
let ?ys = "takeUntil (λ z. z = x) xs"
let ?zs = "drop (length ?ys + 1) xs"
have "xs = ?ys # x # ?zs ∧ x ∉ elems ?ys"
proof
have 2: "x ∉ elems ?ys"
proof (induction xs)
case Nil
thus ?case by simp
next
case (Cons a xs)
thus ?case
proof -
{
assume "a = x"
hence "takeUntil (λz. z = x) (a # xs) = []" by simp
hence A: ?thesis by simp
}
note eq = this
{
assume "a ≠ x"
hence "takeUntil (λz. z = x) (a # xs) = a # takeUntil (λz. z = x) xs" by simp
hence ?thesis using Cons.IH by auto
}
note noteq = this
have "a = x ∨ a ≠ x" by simp
thus ?thesis using eq noteq by blast
qed
qed
from 1 have "xs = ?ys # x # ?zs"
proof (induction xs)
case Nil
hence False by simp
thus ?case by simp
next
case (Cons a xs)
{
assume 1: "a = x"
hence 2: "takeUntil (λz. z = x) (a # xs) = []" by simp
hence "length (takeUntil (λz. z = x) (a # xs)) + 1 = 1" by simp
hence 3: "drop (length (takeUntil (λz. z = x) (a # xs)) + 1) (a # xs) = xs" by simp
from 1 2 3 have ?case by simp
}
note eq = this
{
assume 1: "a ≠ x"
with Cons.prems have "x ∈ elems xs" by simp
with Cons.IH
have IH: "xs = takeUntil (λz. z = x) xs # x # drop (length (takeUntil (λz. z = x) xs) + 1) xs" by simp
from 1 have 2: "takeUntil (λz. z = x) (a # xs) = a # takeUntil (λz. z = x) (xs)" by simp
from 1 have "drop (length (takeUntil (λz. z = x) (a # xs)) + 1) (a # xs) = drop (length (takeUntil (λz. z = x) xs) + 1) xs" by simp
hence ?case using IH 2 by simp
}
note noteq = this
have "a = x ∨ a ≠ x" by simp
thus ?case using eq noteq by blast
qed
with 2 have 3: ?thesis by blast
thus "xs = takeUntil (λz. z = x) xs # x # drop (length (takeUntil (λz. z = x) xs) + 1) xs" by simp
from 3 show "x ∉ elems (takeUntil (λz. z = x) xs)" by simp
qed
thus ?thesis by blast
qed
but it seems rather long. In particular, I think invoking law of excluded middle here is cumbersome, and I feel like there ought to be some convenient schematic variable like ?goal which can refer to the current goal or something.
How can I make this proof shorter without sacrificing clarity?
Not really an answer to your specific question, but I would nonetheless like to point out, that a more concise prove can still be comprehensible.
lemma "x ∈ elems xs ⟹ ∃ ys zs. xs = ys # x # zs ∧ x ∉ elems ys"
proof (induction)
case (Cons l ls)
thus ?case
proof (cases "x ≠ l")
case True
hence "∃ys zs. ls = ys # x # zs ∧ x ∉ elems ys" using Cons by simp
thus ?thesis using ‹x ≠ l› Cons_eq_appendI by fastforce
qed (fastforce)
qed (simp)
Here's another shorter proof than your own:
fun elems :: ‹'a list ⇒ 'a set› where
‹elems [] = {}› |
‹elems (x#xs) = {x} ∪ elems xs›
lemma elems_prefix_suffix:
assumes ‹x ∈ elems xs›
shows ‹∃pre suf. xs = pre # [x] # suf ∧ x ∉ elems pre›
using assms proof(induction xs)
fix y ys
assume *: ‹x ∈ elems (y#ys)›
and IH: ‹x ∈ elems ys ⟹ ∃pre suf. ys = pre # [x] # suf ∧ x ∉ elems pre›
{
assume ‹x = y›
from this have ‹∃pre suf. y#ys = pre # [x] # suf ∧ x ∉ elems pre›
using * by fastforce
}
note L = this
{
assume ‹x ≠ y› and ‹x ∈ elems ys›
moreover from this obtain pre and suf where ‹ys = pre # [x] # suf› and ‹x ∉ elems pre›
using IH by auto
moreover have ‹y#ys = y#pre # [x] # suf› and ‹x ∉ elems (y#pre)›
by(simp add: calculation)+
ultimately have ‹∃pre suf. y#ys = pre # [x] # suf ∧ x ∉ elems pre›
by(metis append_Cons)
}
from this and L show ‹∃pre suf. y#ys = pre # [x] # suf ∧ x ∉ elems pre›
using * by auto
qed auto ― ‹Base case trivial›
I've used a few features of Isar to compress the proof:
Blocks within the braces {...} allow you to perform hypothetical reasoning.
Facts can be explicitly named using note.
The moreover keyword starts a calculation that implicitly "carries along" facts as they are established. The calculation "comes to a head" with the ultimately keyword. This style can significantly reduce the number of explicitly named facts that you need to introduce over the course of a proof.
The qed auto completes the proof by applying auto to all remaining subgoals. A comment notes that the subgoal remaining is the base case of the induction, which is trivial.

Proving a theorem about parser combinators

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.

Resources