I am trying to proof a property of the icmp6 checksum function (sum 16bit integers, add carry, invert 16bit integer).
I defined the functions in isabelle. (I know my proofs are terrible)
But for some reason, isabelle can't proof something about the icmp_csum function, it wants to have.
When I replace the oops in the paste with done it produces thousands of lines that just says:
"linarith_split_limit exceeded (current value is 9)"
theory Scratch
imports Main Int List
begin
fun norm_helper :: "nat ⇒ nat" where
"norm_helper x = (let y = divide x 65536 in (y + x - y * 65536))"
lemma "x ≥ 65536 ⟹ norm_helper x < x" by simp
lemma h: "norm_helper x ≤ x" by simp
fun normalize :: "nat ⇒ nat" where
"normalize x = (if x ≥ 65536
then normalize (norm_helper x)
else x)"
inductive norm_to :: "nat ⇒ nat ⇒ bool" where
"(x < 65536) ⟹ norm_to x x"
| "norm_to y z ⟹ y = norm_helper x ⟹ norm_to x z"
lemma ne: "norm_to x y ⟹ y = normalize x"
apply (induct x y rule: norm_to.induct) by simp+
lemma i: "norm_to x y ⟹ x ≥ y"
apply (induct x y rule: norm_to.induct) by simp+
lemma l: "norm_to x y ⟹ y < 65536"
apply (induct x y rule: norm_to.induct) by simp+
lemma en: "y = normalize x ⟹ norm_to x y"
apply (induct x rule: normalize.induct)
proof -
fix x :: nat
assume 1: "(x ≥ 65536 ⟹ y = Scratch.normalize (norm_helper x) ⟹ norm_to (norm_helper x) y)"
assume 2: "y = Scratch.normalize x"
show "norm_to x y"
proof (cases "x ≥ 65536")
show "¬ 65536 ≤ x ⟹ norm_to x y"
using norm_to.intros(1)[of x] 2 by simp
{
assume s: "65536 ≤ x"
have d: "y = normalize (norm_helper x)" using 2 s by simp
show "65536 ≤ x ⟹ norm_to x y"
using 1 d norm_to.intros(2)[of "norm_helper x" y x]
by blast
}
qed
qed
lemma "normalize x ≤ x" using en i by simp
lemma n[simp]: "normalize x < 65536" using en l by blast
fun sum :: "nat list ⇒ nat" where
"sum [] = 0"
| "sum (x#xs) = x + sum xs"
fun csum :: "nat list ⇒ nat" where
"csum xs = normalize (sum xs)"
fun invert :: "nat ⇒ nat" where
"invert x = 65535 - x"
lemma c: "csum xs ≤ 65535" using n[of "sum xs"] by simp
lemma ic: "invert (csum xs) ≥ 0" using c[of xs] by blast
lemma asdf:
assumes "xs = ys"
shows "invert (csum xs) = invert (csum ys)"
using HOL.arg_cong[of "csum xs" "csum ys" invert,
OF HOL.arg_cong[of xs ys csum]] assms(1)
by blast
function icmp_csum :: "nat list ⇒ nat" where
"icmp_csum xs = invert (csum xs)"
apply simp
apply (rule asdf)
apply simp
oops
end
I have no idea why there is tracing output from linarith there, but given that your definition is neither recursive nor performs pattern matching, you can write it as a definition:
definition icmp_csum :: "nat list ⇒ nat" where
"icmp_csum xs = invert (csum xs)"
Another possibility is to change invert to a definition instead of a fun. (In general, if it's neither recursive nor performs pattern matching, definition is preferable because it has much less overhead than fun.)
NB, just import Main, not Main Int List.
Edit: An explanation from Tobias Nipkow on the mailing list:
This is a known issue. In the outdated LNCS 2283 you can find a discussion what to do about it in Section 3.5.3 Simplification and Recursive Functions. The gist: don't use "if", use pattern matching or "case". Or disable if_split.
Related
datatype 'a list = Cons 'a "'a list" | Nil
instantiation list :: (order) order
begin
fun less_eq_list :: "'a list ⇒ 'a list ⇒ bool" where
"less_eq_list Nil Nil = True" |
"less_eq_list (Cons _ _) Nil = True" |
"less_eq_list Nil (Cons _ _) = False" |
"less_eq_list (Cons _ a) (Cons _ b) = less_eq_list a b"
instance
proof
fix x y:: "'a list"
show "x ≤ x"
apply(induct_tac x)
apply(auto)
done
(* at this point the state is
show x ≤ x
Successful attempt to solve goal by exported rule:
?x2 ≤ ?x2
proof (state)
this:
x ≤ x
goal (3 subgoals):
1. ⋀x y. (x < y) = (x ≤ y ∧ ¬ y ≤ x)
2. ⋀x y z. x ≤ y ⟹ y ≤ z ⟹ x ≤ z
3. ⋀x y. x ≤ y ⟹ y ≤ x ⟹ x = y
*)
show "(x < y) = (x ≤ y ∧ ¬ y ≤ x)"
(* I get an error here
Failed to refine any pending goal
Local statement fails to refine any pending goal
Failed attempt to solve goal by exported rule:
(?x2 < ?y2) = (?x2 ≤ ?y2 ∧ ¬ ?y2 ≤ ?x2)
*)
qed
end
What is wrong with this? The proof of "x ≤ x" worked like a charm. Somehow "(x < y) = (x ≤ y ∧ ¬ y ≤ x)" doesn't match any subgoal.
Class order is a subclass of preorder, which in turn is a subclass of ord. Class ord requires you to define both less_eq (≤) and less (<). In your code, you have correctly defined less_eq_list but forgot to define less_list, and that's why you got an error when trying to prove (x < y) = (x ≤ y ∧ ¬ y ≤ x).
There is a set of some structures. I'm trying to prove that the cardinality of the set equals some number. Full theory is too long to post here. So here is a simplified one just to show the idea.
Let the objects (which I need to count) are sets containing natural numbers from 1 to n. The idea of the proof is as follows. I define a function which transforms sets to lists of 0 and 1. Here is the function and its inverse:
fun set_to_bitmap :: "nat set ⇒ nat ⇒ nat ⇒ nat list" where
"set_to_bitmap xs x 0 = []"
| "set_to_bitmap xs x (Suc n) =
(if x ∈ xs then Suc 0 else 0) # set_to_bitmap xs (Suc x) n"
fun bitmap_to_set :: "nat list ⇒ nat ⇒ nat set" where
"bitmap_to_set [] n = {}"
| "bitmap_to_set (x#xs) n =
(if x = Suc 0 then {n} else {}) ∪ bitmap_to_set xs (Suc n)"
value "set_to_bitmap {1,3,7,8} 1 8"
value "bitmap_to_set (set_to_bitmap {1,3,7,8} 1 8) 1"
Then I plan to prove that 1) a number of 0/1 lists with length n equals 2^^n,
2) the functions are bijections,
3) so the cardinality of the original set is 2^^n too.
Here are some auxiliary definitions and lemmas, which seems useful:
definition "valid_set xs n ≡ (∀a. a ∈ xs ⟶ 0 < a ∧ a ≤ n)"
definition "valid_bitmap ps n ≡ length ps = n ∧ set ps ⊆ {0, Suc 0}"
lemma length_set_to_bitmap:
"valid_set xs n ⟹
x = Suc 0 ⟹
length (set_to_bitmap xs x n) = n"
apply (induct xs x n rule: set_to_bitmap.induct)
apply simp
sorry
lemma bitmap_members:
"valid_set xs n ⟹
x = Suc 0 ⟹
set_to_bitmap xs x n = ps ⟹
set ps ⊆ {0, Suc 0}"
apply (induct xs x n arbitrary: ps rule: set_to_bitmap.induct)
apply simp
sorry
lemma valid_set_to_valid_bitmap:
"valid_set xs n ⟹
x = Suc 0 ⟹
set_to_bitmap xs x n = ps ⟹
valid_bitmap ps n"
unfolding valid_bitmap_def
using bitmap_members length_set_to_bitmap by auto
lemma valid_bitmap_to_valid_set:
"valid_bitmap ps n ⟹
x = Suc 0 ⟹
bitmap_to_set ps x = xs ⟹
valid_set xs n"
sorry
lemma set_to_bitmap_inj:
"valid_set xs n ⟹
valid_set xy n ⟹
x = Suc 0 ⟹
set_to_bitmap xs x n = ps ⟹
set_to_bitmap ys x n = qs ⟹
ps = qs ⟹
xs = ys"
sorry
lemma set_to_bitmap_surj:
"valid_bitmap ps n ⟹
x = Suc 0 ⟹
∃xs. set_to_bitmap xs x n = ps"
sorry
lemma bitmap_to_set_to_bitmap_id:
"valid_set xs n ⟹
x = Suc 0 ⟹
bitmap_to_set (set_to_bitmap xs x n) x = xs"
sorry
lemma set_to_bitmap_to_set_id:
"valid_bitmap ps n ⟹
x = Suc 0 ⟹
set_to_bitmap (bitmap_to_set ps x) x n = ps"
sorry
Here is a final lemma:
lemma valid_set_size:
"card {xs. valid_set xs n} = 2 ^^ n"
Does this approach seem valid? Are there any examples of such a proof? Could you suggest an idea on how to prove the lemmas? I'm stuck because the induction with set_to_bitmap.induct seems to be not applicable here.
In principle, that kind of approach does work: if you have a function f from a set A to a set B and an inverse function to it, you can prove bij_betw f A B (read: f is a bijection from A to B), and that then implies card A = card B.
However, there are a few comments that I have:
You should use bool lists instead of nat lists if you can only have 0 or 1 in them anyway.
It is usually better to use existing library functions than to define new ones yourself. Your two functions could be defined using library functions like this:
set_to_bitmap :: nat ⇒ nat ⇒ nat set ⇒ bool list
set_to_bitmap x n A = map (λi. i ∈ A) [x..<x+n]
bitmap_to_set :: nat ⇒ bool list ⇒ nat set
bitmap_to_set n xs = (λi. i + n) ` {i. i < length xs ∧ xs ! i}```
Side note: I would use upper-case letters for sets, not something like xs (which is usually used for lists).
Perhaps this is because you simplified your problem, but in its present form, valid_set A n is simply the same as A ⊆ {1..n} and the {A. valid_set A n} is simply Pow {1..n}. The cardinality of that is easy to show with results from the library:
lemma "card (Pow {1..(n::nat)}) = 2 ^ n"
by (simp add: card_Pow)`
As for your original questions: Your first few lemmas are provable, but for the induction to go through, you have to get rid of some of the unneeded assumptions first. The x = Suc 0 is the worst one – there is no way you can use induction if you have that as an assumption, because as soon as you do one induction step, you increase x by 1 and so you won't be able to apply your induction hypothesis. The following versions of your first three lemmas go through easily:
lemma length_set_to_bitmap:
"length (set_to_bitmap xs x n) = n"
by (induct xs x n rule: set_to_bitmap.induct) auto
lemma bitmap_members:
"set (set_to_bitmap xs x n) ⊆ {0, Suc 0}"
by (induct xs x n rule: set_to_bitmap.induct) auto
lemma valid_set_to_valid_bitmap: "valid_bitmap (set_to_bitmap xs x n) n"
unfolding valid_bitmap_def
using bitmap_members length_set_to_bitmap by auto
I also recommend not adding "abbreviations" like ps = set_to_bitmap xs x n as an assumption. It doesn't break anything, but it tends to complicate things needlessly.
The next lemma is a bit trickier. Due to your recursive definitions, you have to generalise the lemma first (valid_bitmap requires the set to be in the range from 1 to n, but once you make one induction step it has to be from 2 to n). The following works:
lemma valid_bitmap_to_valid_set_aux:
"bitmap_to_set ps x ⊆ {x..<x + length ps}"
by (induction ps x rule: bitmap_to_set.induct)
(auto simp: valid_bitmap_def valid_set_def)
lemma valid_bitmap_to_valid_set:
"valid_bitmap ps n ⟹ valid_set (bitmap_to_set ps 1) n"
using valid_bitmap_to_valid_set_aux unfolding valid_bitmap_def valid_set_def
by force
Injectivity and surjectivity (which is your ultimate goal) should follow from the fact that the two are inverse functions. Proving that will probably be doable with induction, but will require a few generalisations and auxiliary lemmas. It should be easier if you stick to the non-recursive definition using library functions that I sketched above.
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
I'm trying to define a conjunction function for 4-valued logic (false, true, null, and error). In my case the conjunction is equivavlent to min function on linear order false < error < null < true.
datatype bool4 = JF | JT | BN | BE
instantiation bool4 :: linear_order
begin
fun leq_bool4 :: "bool4 ⇒ bool4 ⇒ bool" where
"leq_bool4 JF b = True"
| "leq_bool4 BE b = (b = BE ∨ b = BN ∨ b = JT)"
| "leq_bool4 BN b = (b = BN ∨ b = JT)"
| "leq_bool4 JT b = (b = JT)"
instance proof
fix x y z :: bool4
show "x ⊑ x"
by (induct x) simp_all
show "x ⊑ y ⟹ y ⊑ z ⟹ x ⊑ z"
by (induct x; induct y) simp_all
show "x ⊑ y ⟹ y ⊑ x ⟹ x = y"
by (induct x; induct y) simp_all
show "x ⊑ y ∨ y ⊑ x"
by (induct x; induct y) simp_all
qed
end
definition and4 :: "bool4 ⇒ bool4 ⇒ bool4" where
"and4 a b ≡ minimum a b"
I guess there must be an easier way to define a linear order in Isabelle HOL. Could you suggest a simplification of the theory?
You can use the "Datatype_Order_Generator" AFP entry.
Then it's as simple as importing "$AFP/Datatype_Order_Generator/Order_Generator" and declaring derive linorder "bool4". Note that the constructors must be declared in the order you want them when defining your datatype.
Details on how to download and use the AFP locally can be found here.
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.