I am performing a script updating. I encount such a question that :
constdefs is_initiator::"sigma \<Rightarrow> agent\<Rightarrow> agent \<Rightarrow>nat \<Rightarrow>nat \<Rightarrow>bool"
"is_initiator s A B Na Nb ==
(SP s)=[(+, Crypt (pubK B) {|Nonce Na, Agent A|}),
(-,Crypt (pubK A) {|Nonce Na, Nonce Nb, Agent B|}),
(+, Crypt (pubK B) (Nonce Nb))]"
constdefs is_responder::"sigma \<Rightarrow> agent\<Rightarrow> agent \<Rightarrow>nat \<Rightarrow>nat \<Rightarrow>bool"
"is_responder s A B Na Nb ==
(SP s)=[(-, Crypt (pubK B) {|Nonce Na, Agent A|}),
(+,Crypt (pubK A) {|Nonce Na, Nonce Nb, Agent B|}),
(-, Crypt (pubK B) (Nonce Nb))]"
defs NSL_1:
"\<Sigma> == {s. Is_penetrator_strand s |
(EX A B Na Nb. is_initiator s A B Na Nb) |
(EX A B Na Nb. is_responder s A B Na Nb)
}"
And In Isabelle 2020, I code these phases into
definition is_initiator::"sigma \<Rightarrow> agent\<Rightarrow> agent \<Rightarrow>nat \<Rightarrow>nat \<Rightarrow>bool" where
"is_initiator s A B Na Nb ==
(SP s)=[(+, Crypt (pubK B) \<lbrace>Nonce Na, Agent A\<rbrace>),
(-,Crypt (pubK A) \<lbrace>Nonce Na, Nonce Nb, Agent B\<rbrace>),
(+, Crypt (pubK B) (Nonce Nb))]"
definition is_responder::"sigma \<Rightarrow> agent\<Rightarrow> agent \<Rightarrow>nat \<Rightarrow>nat \<Rightarrow>bool" where
"is_responder s A B Na Nb ==
(SP s)=[(-, Crypt (pubK B) \<lbrace> Nonce Na, Agent A\<rbrace>),
(+,Crypt (pubK A) \<lbrace>Nonce Na, Nonce Nb, Agent B\<rbrace>),
(-, Crypt (pubK B) (Nonce Nb))]"
definition NSL_1:
"NSL_1 == \<Sigma> = {s. Is_penetrator_strand s |
(EX A B Na Nb. is_initiator s A B Na Nb) |
(EX A B Na Nb. is_responder s A B Na Nb)
}"
When i try to unfold the definition NSL_1 in the lemma, find that can not pass in Isabelle2020. How can i transform these codes rightly? Thanks.
The main aim of this is that i wanna unfold the definition NSL_1.
1. ¬ Is_penetrator_strand (fst m') ⟹
Key k ⊏ node_term m' ∧
m' ∈ nodes b ∧
k ∉ KP ∧
(∀a ba. (a, ba) ≺⇩b m' ⟶ (a, ba) ∈ nodes b ⟶ Key k ⊏ node_term (a, ba) ⟶ k ∈ KP) ⟹
b ∈ bundles ⟹
fst m' ∈ Σ ⟹
(∃A B Na Nb. is_initiator (fst m') A B Na Nb) ∨
(∃A B Na Nb. is_responder (fst m') A B Na Nb)
It can be seen that we assume that strand can not be Is_penetrator_strand, so it must be is_initiator and is_responder. Second question that how to apply the definition into lemma prove.
I am not familiar with def, but it seems that the constant being defined is Sigma, and the name of the fact that Sigma = ... is NSL_1. So you'd need
definition NSL_1:
"\<Sigma> == {s. Is_penetrator_strand s |
(EX A B Na Nb. is_initiator s A B Na Nb) |
(EX A B Na Nb. is_responder s A B Na Nb)
}"
Then you can do unfolding NSL_1 or apply (unfold NSL_1) or apply (auto simp add: NSL_1), whatever you need.
Related
Here is a math exercise (taken from page 2 - in Russian):
There are 100 visually indistinguishable coins of three types: gold, silver and copper (each type occurs at least once). It is known that gold weighs 3 grams each, silver weighs 2 grams each, copper weighs 1 gram each. How can I determine the type of all coins in no more than 101 weighings on two-plate scales without weights?
(Note: I guess that the exercise is wrong and at most 102 weighings are required. However it doesn't matter)
The solution is as follows:
Take coins one by one from a list of coins and compare each coin with a previous one
If the coins have the same weight, then we assign them to one group and continue to weigh further
If we found a heavier coin cj than the previous one, then go to step 2
If we found a lighter coin ci than the previous one, then keep weighing coins trying to find a coin cj heavier than ci
If we found a lighter coin instead, then c0 > ci > cj and we know weights of these coins: 3 > 2 > 1. Go to step 3
Keep comparing coins
If we found a heavier coin ck than cj, then ci < cj < ck (and weights are 1 < 2 < 3)
If we found a lighter coin ck than cj, then compare ci and ck
If ci < ck, then weights of ci, cj, ck are 1, 3, 2
If ci > ck, then weights of ci, cj, ck are 2, 3, 1
If ci = ck, then compare ci + ck with cj
If ci + ck < cj, then weights of ci, cj, ck are 1, 3, 1 (in this case we don't have a sliver coin, so we will use two copper coins instead on steps 3 and 4)
If ci + ck > cj, then weights of ci, cj, ck are 2, 3, 2
If ci + ck = cj, then weights of ci, cj, ck are 1, 2, 1
Compare rest coins with the silver coin (or two copper coins)
Lighter coins are copper
Same coins are silver
Heavier coins are gold
If on step 1 we found a lighter coin first instead of a heavier one, then we need to compare first heavy coins with a silver coin to determine their weight (it could be a 102th weighing depending on a coin set)
Here is an example of a coin list:
c0 ci cj ck
3 3 2 2 2 3 3 1 1 2 1 3
|_| |___| |_|
i j k
Here is a solution in Isabelle HOL:
datatype coin = GC | SC | CC
datatype comp = LT | EQ | GT
primrec coin_weight :: "coin ⇒ nat" where
"coin_weight CC = 1"
| "coin_weight SC = 2"
| "coin_weight GC = 3"
primrec sum_list where
"sum_list f [] = 0"
| "sum_list f (x # xs) = f x + sum_list f xs"
definition weigh :: "coin list ⇒ coin list ⇒ comp" where
"weigh xs ys = (
let xw = sum_list coin_weight xs in
let yw = sum_list coin_weight ys in
if xw < yw then LT else
if xw > yw then GT else EQ)"
definition std_weigh :: "coin list ⇒ coin ⇒ nat" where
"std_weigh xs ys ≡ (case weigh xs [ys] of LT ⇒ 3 | GT ⇒ 1 | EQ ⇒ 2)"
definition gen_weights :: "coin list ⇒ coin ⇒ coin list ⇒ nat ⇒ nat ⇒ nat ⇒ nat ⇒ nat ⇒ nat ⇒ nat list" where
"gen_weights cs c⇩0 std i j k w⇩j w⇩k w ≡
― ‹Optional heavy coins (\<^term>‹c⇩0›...)›
replicate i (std_weigh std c⇩0) #
― ‹Light coins (\<^term>‹c⇩i›...)›
replicate j w⇩j #
― ‹Heavy coins (\<^term>‹c⇩j›...)›
replicate k w⇩k #
― ‹A light coin (\<^term>‹c⇩k›)›
[w] #
― ‹Rest coins›
map (std_weigh std) cs"
primrec determine_weights where
"determine_weights [] c⇩0 c⇩i c⇩j i j k = None"
| "determine_weights (c⇩k # cs) c⇩0 c⇩i c⇩j i j k = (
case weigh [c⇩j] [c⇩k]
of LT ⇒ Some (gen_weights cs c⇩0 [c⇩j] i j (Suc k) 1 2 3)
| GT ⇒ Some (
case weigh [c⇩i] [c⇩k]
of LT ⇒ gen_weights cs c⇩0 [c⇩k] i j (Suc k) 1 3 2
| GT ⇒ gen_weights cs c⇩0 [c⇩i] i j (Suc k) 2 3 1
| EQ ⇒ (
case weigh [c⇩i, c⇩k] [c⇩j]
of LT ⇒ gen_weights cs c⇩0 [c⇩i, c⇩k] i j (Suc k) 1 3 1
| GT ⇒ gen_weights cs c⇩0 [c⇩k] i j (Suc k) 2 3 2
| EQ ⇒ gen_weights cs c⇩0 [c⇩j] i j (Suc k) 1 2 1))
| EQ ⇒ determine_weights cs c⇩0 c⇩i c⇩j i j (Suc k))"
primrec find_heavier where
"find_heavier [] c⇩0 c⇩i i j alt = None"
| "find_heavier (c⇩j # cs) c⇩0 c⇩i i j alt = (
case weigh [c⇩i] [c⇩j]
of LT ⇒ determine_weights cs c⇩0 c⇩i c⇩j i (Suc j) 0
| GT ⇒ alt cs c⇩j (Suc j)
| EQ ⇒ find_heavier cs c⇩0 c⇩i i (Suc j) alt)"
primrec weigh_coins where
"weigh_coins [] = Some []"
| "weigh_coins (c⇩0 # cs) =
find_heavier cs c⇩0 c⇩0 0 0
(λcs c⇩i i. find_heavier cs c⇩0 c⇩i i 0
(λcs c⇩j j. Some (gen_weights cs c⇩0 [c⇩i] 0 i j 3 2 1)))"
I can prove that the solution is valid for a concrete case:
definition "coins ≡ [GC, GC, SC, SC, SC, GC, GC, CC, CC, SC, CC, GC]"
value "weigh_coins coins"
lemma weigh_coins_ok:
"cs = coins ⟹
weigh_coins cs = Some ws ⟹
ws = map coin_weight cs"
by (induct cs; auto simp: coins_def weigh_def gen_weights_def std_weigh_def)
lemma weigh_coins_length_ok:
"cs = coins ⟹
weigh_coins cs = Some ws ⟹
length cs = length ws"
by (induct cs; auto simp: coins_def weigh_def gen_weights_def std_weigh_def)
However I have no idea how to prove it for a general case:
lemma weigh_coins_ok:
"weigh_coins cs = Some ws ⟹
ws = map coin_weight cs"
proof (induct cs)
case Nil
then show ?case by simp
next
case (Cons c cs)
then show ?case
qed
I can't induct over cs because I'll need to prove that
weigh_coins (c # cs) = Some ws ⟹ ∃ws. weigh_coins cs = Some ws
It doesn't hold. I can determine weights for [CC, SC, GC], but can't do it for [SC, GC].
An alternative approach is to prove these lemmas for a special cases:
[CC, CC, ...] # [SC, SC, ...] # [GC, GC, ...] # ...
[CC, CC, ...] # [GC, GC, ...] # [SC, SC, ...] # ...
[SC, SC, ...] # [GC, GC, ...] # [CC, CC, ...] # ...
...
And then to prove that the list of cases is exhaustive.
For example:
lemma weigh_coins_length:
"cs = [CC] # replicate n CC # [SC, GC] ⟹
weigh_coins cs = Some ws ⟹
length cs = length ws"
apply (induct n arbitrary: cs ws)
apply (auto simp: weigh_def gen_weights_def std_weigh_def)[1]
However I can't prove even this lemma.
The questions are:
Could you suggest how such a lemmas can be proven or how to reformulate the functions to make the lemmas provable?
How to formulate the lemma that weigh function is used at most n + 2 times in the algorithm, where n is the number of coins?
Some general hints:
You have three recursive functions: determine_weights, find_heavier, weigh_coins.
For each recursive function, try to express a relation between the inputs and results without using recursion (instead use quantifiers). The property you prove for the earlier functions must be strong enough to prove the properties for the later ones.
Also, the property should not fix any of the parameters. For example find_heavier is always initially called with j = 0, but the property should work for all values of j so that it can be used during induction.
Also try to formulate and prove the high level steps in your description: For example show that this function finds a silver coin or two copper coins.
Regarding question 2:
I would try to state the problem in a way where it is not possible to cheat. For example:
datatype strategy =
Return "coin list"
| Weigh "nat list" "nat list" "comp ⇒ strategy" ― ‹Weigh coins based on positions›
definition "select indexes coins ≡ map (nth coins) indexes"
fun runStrategy where
"runStrategy coins _ (Return r) = Some r"
| "runStrategy coins 0 _ = None"
| "runStrategy coins (Suc n) (Weigh xs ys cont) = (
if distinct xs ∧ distinct ys ∧ set xs ∩ set ys = {} then
runStrategy coins n (cont (weigh (select xs coins) (select ys coins)))
else None)"
lemma "∃strategy. ∀coins.
length coins = 100 ∧ (∀c. c ∈ set coins)
⟶ runStrategy coins 101 strategy = Some coins"
Here runStrategy calls weigh at most 101 times and the strategy cannot learn anything about the coins, except for the comparison result passed into the continuation of Weigh.
I'm trying to define a supremum operation for a datatype based on fmap:
datatype t = A | B | C "(nat, t) fmap"
abbreviation
"supc f xs ys ≡
fmmap_keys
(λk x. f x (the (fmlookup ys k)))
(fmfilter (λk. k |∈| fmdom ys) xs)"
fun sup_t (infixl "⊔" 65) where
"A ⊔ _ = A"
| "B ⊔ B = B"
| "B ⊔ _ = A"
| "C xs ⊔ C ys = C (supc (⊔) xs ys)"
| "C xs ⊔ _ = A"
And get the error:
Unfinished subgoals:
(a, 1, <):
1. ⋀ys x. size (the (fmlookup ys x)) < Suc (∑x∈fset (fset_of_fmap ys). Suc (case x of (a, x) ⇒ size x))
(a, 1, <=):
1. ⋀ys x. size (the (fmlookup ys x)) ≤ Suc (∑x∈fset (fset_of_fmap ys). Suc (case x of (a, x) ⇒ size x))
(a, 2, <):
1. ⋀xs xa. size xa < Suc (∑x∈fset (fset_of_fmap xs). Suc (case x of (a, x) ⇒ size x))
(a, 2, <=):
1. ⋀xs xa. size xa ≤ Suc (∑x∈fset (fset_of_fmap xs). Suc (case x of (a, x) ⇒ size x))
(a, 3, <):
1. False
Calls:
a) (C xs, C ys) ~> (xa, the (fmlookup ys x))
Measures:
1) λp. size (snd p)
2) λp. size (fst p)
3) size
Result matrix:
1 2 3
a: ? ? <=
Could not find lexicographic termination order.
If I simplify the function passed as the first argument to fmmap_keys, then the error disappears:
abbreviation
"supc f xs ys ≡
fmmap_keys
(λk x. x)
(fmfilter (λk. k |∈| fmdom ys) xs)"
So I guess, that the error is caused by a complex recursive call of sup_t. The only possible source of non-termination is structures of the form C («[x ↦ C (...)]»). But an external C is removed on each recursive call so the function should terminate.
Could you suggest how to fix this error or redefine supc?
UPDATE
Here is an alternative definition:
abbreviation
"supc f xs ys ≡
fmap_of_list (map
(λ(k, x). (k, f x (the (fmlookup ys k))))
(sorted_list_of_fmap (fmfilter (λk. k |∈| fmdom ys) xs)))"
function sup_t (infixl "⊔" 65) where
"A ⊔ _ = A"
| "B ⊔ x = (if x = B then B else A)"
| "C xs ⊔ x = (case x of C ys ⇒ C (supc sup_t xs ys) | _ ⇒ A)"
by pat_completeness auto
termination
apply auto
I have to prove the following subgoal:
⋀a b. sup_t_dom (a, b)
How to unfold sup_t_dom?
Please find a potentially viable solution in the code listing below.
Background
The issue that you have encountered is described partially in the document "Defining Recursive Functions in Isabelle/HOL" written by Alexander Krauss (also known as "Tutorial on Function Definitions" in Isabelle documentation) and more comprehensively in the PhD thesis "Automating Recursive Definitions and Termination Proofs in Higher-Order Logic" that was also written by Alexander Krauss. In particular, see Chapter 4 in the tutorial and section 3.3 in the thesis.
Size of t
From the aforementioned references, it is possible to infer that one way to prove the termination of sup_t is to provide a suitable measure function. In this case, it is apparent that a measure function that is associated with the size of the datatype might be suitable for the application. Unfortunately, t is a nested type and (in this particular case) the default function size does not seem to capture the recursive nature of the datatype - this is not always the case (see section 3.3.2 in the thesis).
As the first step, I provided a new size function for t. The definition is based on the total number of Cs contained within x::t (the definition should be easy to modify to suit your needs for other applications).
Measure and Termination
I found that the measure function (λ(xs, ys). size ys) is suitable to prove the termination of sup_t. Also, this measure function is used in Isabelle to prove the termination of sup_t if it is declared with the command fun. However, in this case, it was not possible to prove that the arguments of recursive calls indeed decrease with respect to the relation that was established by the measure automatically. However, it would be sufficient to show that "size (the (fmlookup x k)) < size (C x)".
Unfortunately, the function supc (as stated in your question) is not self-certifying with respect to the property that the first argument that is passed to (λk x. f x (the (fmlookup ys k))) is in the domain of ys. Therefore, the (fmlookup ys k) can take the value the None. Given that this issue seems to be nearly orthogonal to the main topic of the question, I decided not to investigate it further and made an amendment to the function supc to ensure that it is guaranteed to return a concrete term of t (you may want to prove explicitly that the function specified below is identical in its behaviour to the one that you provided in your question or, otherwise, provide a better alternative that would be self-certifying):
abbreviation
"supc f xs ys ≡
fmmap_keys
(λk x. if (k |∈| fmdom ys) then (f x (the (fmlookup ys k))) else A)
(fmfilter (λk. k |∈| fmdom ys) xs)"
After this modification, the previous goal "size (the (fmlookup x k)) < size (C x)" was changed to "(k |∈| fmdom ys) ⟹ size (the (fmlookup x k)) < size (C x)", which could be easily proven (see lemma measure_cond). If this lemma is declared as an introduction rule then the termination of sup_t can be proven automatically if it is declared with the command fun.
Remarks
The main reason why I decided to investigate this issue and provide an answer is that I knew very little about some of the main topics of the question and wanted to learn them. As a result, my answer may be suboptimal due to the lack of experience/knowledge in these areas. Of course, if you also have doubts about whether the solution that I proposed here is optimal for the application, it may be worth trying to ask the question on the mailing list.
theory termination_problem
imports
Complex_Main
"HOL-Library.Finite_Map"
begin
datatype (plugins del: "size") t = A | B | C "(nat, t) fmap"
abbreviation "tcf ≡ (λ v::(nat × nat). (λ r::nat. snd v + r))"
interpretation tcf: comp_fun_commute tcf
proof
fix x y
show "tcf y ∘ tcf x = tcf x ∘ tcf y"
proof -
fix z
have "(tcf y ∘ tcf x) z = snd y + snd x + z" by auto
also have "(tcf x ∘ tcf y) z = snd y + snd x + z" by auto
ultimately have "(tcf y ∘ tcf x) z = (tcf x ∘ tcf y) z" by auto
then show "(tcf y ∘ tcf x) = (tcf x ∘ tcf y)" by auto
qed
qed
instantiation t :: size
begin
primrec t_size :: "t ⇒ nat" where
AR: "t_size A = 0" |
BR: "t_size B = 0" |
CR: "t_size (C x) =
(Suc 0) + ffold tcf 0 (fset_of_fmap (fmmap t_size x))"
definition size_t where
size_t_def: "size_t = t_size"
instance ..
end
lemma ffold_rec_exp:
assumes "k |∈| fmdom x"
and "ky = (k, the (fmlookup (fmmap t_size x) k))"
shows "ffold tcf 0 (fset_of_fmap (fmmap t_size x)) =
tcf ky (ffold tcf 0 ((fset_of_fmap (fmmap t_size x)) |-| {|ky|}))"
using assms tcf.ffold_rec by auto
lemma elem_le_ffold:
assumes "k |∈| fmdom x"
shows "t_size (the (fmlookup x k)) <
(Suc 0) + ffold tcf 0 (fset_of_fmap (fmmap t_size x))"
using ffold_rec_exp assms by auto
lemma measure_cond [intro]:
assumes "k |∈| fmdom x"
shows "size (the (fmlookup x k)) < size (C x)"
using assms elem_le_ffold size_t_def by auto
abbreviation
"supc f xs ys ≡
fmmap_keys
(λk x. if (k |∈| fmdom ys) then (f x (the (fmlookup ys k))) else A)
(fmfilter (λk. k |∈| fmdom ys) xs)"
fun sup_t (infixl "⊔" 65) where
"A ⊔ _ = A"
| "B ⊔ x = (if x = B then B else A)"
| "C xs ⊔ x = (case x of C ys ⇒ C (supc sup_t xs ys) | _ ⇒ A)"
(*Examples*)
abbreviation "list_1 ≡ fmap_of_list [(1::nat, B)]"
abbreviation "list_2 ≡ fmap_of_list [(1::nat, A), (2::nat, A)]"
value "(C list_1) ⊔ (C list_2)"
abbreviation "list_3 ≡ fmap_of_list [(1::nat, B), (3::nat, A)]"
abbreviation "list_4 ≡ fmap_of_list [(2::nat, A), (4::nat, B)]"
value "(C list_3) ⊔ (C list_4)"
abbreviation "list_5 ≡ fmap_of_list [(1::nat, B), (2::nat, B)]"
abbreviation "list_6 ≡ fmap_of_list [(2::nat, B), (4::nat, B)]"
value "(C list_5) ⊔ (C list_6)"
abbreviation "list_7 ≡
fmap_of_list [(1::nat, B), (2::nat, C list_5), (3::nat, A)]"
abbreviation "list_8 ≡ fmap_of_list [(2::nat, B), (4::nat, B)]"
value "(C list_7) ⊔ (C list_8)"
abbreviation "list_9 ≡
fmap_of_list [(1::nat, B), (2::nat, C list_5), (3::nat, A)]"
abbreviation "list_10 ≡ fmap_of_list [(2::nat, C list_6), (3::nat, B)]"
value "(C list_9) ⊔ (C list_10)"
end
I'm trying to define an upper semilattice:
A ≺ B
... ≺ C [B,B,B] ≺ C [B,B] ≺ C [B] ≺ B
C [A] ≺ C [B]
C [A,A] ≺ C [A,B] ≺ C [B,B]
C [A,A] ≺ C [B,A] ≺ C [B,B]
C [A,A,A] ≺ C [A,A,B] ≺ C [A,B,B] ≺ C [B,B,B]
C [A,A,A] ≺ C [A,B,A] ≺ C [A,B,B] ≺ C [B,B,B]
C [A,A,A] ≺ C [A,A,B] ≺ C [B,A,B] ≺ C [B,B,B]
C [A,A,A] ≺ C [B,A,A] ≺ C [B,A,B] ≺ C [B,B,B]
C [A,A,A] ≺ C [A,B,A] ≺ C [B,B,A] ≺ C [B,B,B]
C [A,A,A] ≺ C [B,A,A] ≺ C [B,B,A] ≺ C [B,B,B]
and so on...
I need to prohibit a direct relations of the form:
C [A,A] ≺ C [B,B]
C [A,A,B] ≺ C [B,B,B]
and so on...
Only one element must differ in preceding elements. I will define this indirect relations as a transitive closure.
I tried to define it as follows:
datatype t = A | B | C "t list"
definition "only_one p xs ys ≡
let xys = zip xs ys in
length xs = length ys ∧
list_all (λ(x, y). x = y ∨ p x y) xys ∧
length xs =
length (takeWhile (λ(x, y). x = y) xys) +
length (takeWhile (λ(x, y). x = y) (rev xys)) + 1"
inductive prec_t ("_ ≺ _" [65, 65] 65) where
"A ≺ B"
| "C [B] ≺ B"
| "C (xs#[B]) ≺ C xs"
| "only_one (λx y. x ≺ y) xs ys ⟹
C xs ≺ C ys"
But I get the following error:
Proof failed.
1. ⋀x y xa xb xs ys.
x (?x47 x y xa xb xs ys) (?x48 x y xa xb xs ys) ⟶
y (?x47 x y xa xb xs ys) (?x48 x y xa xb xs ys) ⟹
only_one x xs ys ⟶ only_one y xs ys
The error(s) above occurred for the goal statement⌂:
mono
(λp x1 x2.
x1 = A ∧ x2 = B ∨
x1 = C [B] ∧ x2 = B ∨
(∃xs. x1 = C (xs # [B]) ∧ x2 = C xs) ∨ (∃xs ys. x1 = C xs ∧ x2 = C ys ∧ only_one p xs ys))
Could you suggest how to fix it?
UPDATE
I redefined the condition checker as follows. But it doesn't help.
primrec only_one' :: "bool ⇒ ('a ⇒ 'a ⇒ bool) ⇒ 'a list ⇒ 'a list ⇒ bool" where
"only_one' found p xs [] = (case xs of [] ⇒ found | _ ⇒ False)"
| "only_one' found p xs (y # ys) = (case xs of [] ⇒ False | z # zs ⇒
if z = y then only_one' found p zs ys else
let found' = p z y in
if found ∧ found' then False else only_one' found' p zs ys)"
abbreviation "only_one ≡ only_one' False"
UPDATE 2
An inductive definition doesn't help too:
inductive only_one :: "bool ⇒ ('a ⇒ 'a ⇒ bool) ⇒ 'a list ⇒ 'a list ⇒ bool" where
"only_one True p [] []"
| "x = y ⟹
only_one found p xs ys ⟹
only_one found p (x#xs) (y#ys)"
| "p x y ⟹
found = False ⟹
only_one True p xs ys ⟹
only_one found p (x#xs) (y#ys)"
Your inductive definition is not accepted, since Isabelle does not know that only_one is monotone.
Therefore, the following code in front of your inductive definition should solve your problem.
lemma only_one_mono: "(⋀ x y. x ∈ set xs ⟹ y ∈ set ys ⟹ p x y ⟶ q x y) ⟹
only_one p xs ys ⟶ only_one q xs ys" sorry
declare only_one_mono[mono]
Best, René
I'm trying to write a custom induction rule for an inductive set. Unfortunately, when I try to apply it with induction rule: my_induct_rule, I get an extra, impossible to prove case. I have the following:
inductive iterate :: "('a ⇒ 'a ⇒ bool) ⇒ 'a ⇒ 'a ⇒ bool" for f where
iter_refl [simp]: "iterate f a a"
| iter_step [elim]: "f a b ⟹ iterate f b c ⟹ iterate f a c"
theorem my_iterate_induct: "iterate f x y ⟹ (⋀a. P a a) ⟹
(⋀a b c. f a b ⟹ iterate f b c ⟹ P b c ⟹ P a c) ⟹ P x y"
by (induction x y rule: iterate.induct) simp_all
lemma iter_step_backwards: "iterate f a b ⟹ f b c ⟹ iterate f a c"
proof (induction a b rule: my_iterate_induct)
...
qed
Obviously the custom induction rule doesn't give me any new power (my real use case is more complicated) but that's kinda the point. my_iterate_induct is exactly the same as the autogenerated iterate.induct rule, as far as I can tell, but inside the proof block I have the following goals:
goal (3 subgoals):
1. iterate ?f a b
2. ⋀a. iterate f a a ⟹ f a c ⟹ iterate f a c
3. ⋀a b ca. ?f a b ⟹ iterate ?f b ca ⟹
(iterate f b ca ⟹ f ca c ⟹ iterate f b c) ⟹ iterate f a ca ⟹
f ca c ⟹ iterate f a c
Goal 1 seems to rise from some failure to unify ?f with the actual argument f, but if I ignore the fact that the f is fixed and try induction f a b rule: my_iterate_induct I just get Failed to apply proof method, as expected. How do I get the nice behaviour that the regular iterate.induct provides?
You need to declare your custom induction rule as ‘consuming’ one premise using the consumes attribute (see the Isabelle/Isar reference manual, §6.5.1):
theorem my_iterate_induct [consumes 1]: "iterate f x y ⟹ (⋀a. P a a) ⟹
(⋀a b c. f a b ⟹ iterate f b c ⟹ P b c ⟹ P a c) ⟹ P x y"
by (induction x y rule: iterate.induct) simp_all
I have a datatype and an inductive predicate over it (which is actually a small-step semantics of some transition system):
datatype dtype = E | A | B dtype
inductive dsem :: "dtype ⇒ dtype ⇒ bool" where
"dsem A E"
| "dsem (B E) E"
| "dsem d d' ⟹ dsem (B d) (B d')"
and also a function which is computed by case distinction:
fun f :: "dtype ⇒ nat" where
"f E = 0"
| "f A = 1"
| "f (B _) = 2"
I'm trying to prove some property about the inductive predicate, and assumptions also involve computing the value of f which doesn't participate in induction.
lemma
assumes d: "dsem s s'"
and h: "h s v"
and v: "v = f s"
shows "P v"
using d h
proof (induct rule: dsem.induct)
For the 3rd semantics rule Isabelle computes the subgoal
⋀d d'. dsem d d' ⟹ (h d v ⟹ P v) ⟹ h (B d) v ⟹ P v
where the value of s is lost so it is impossible to compute the value v.
I can neither include v into the induction assumptions because then Isabelle generates the subgoal
⋀d d'. dsem d d' ⟹ (h d v ⟹ v = f d ⟹ P v) ⟹ h (B d) v ⟹ v = f (B d) ⟹ P v
where the induction hypothesis says v = f d which is incorrect since v = f (B d) in this case. Nor can I put v into arbitrary: ... because the value of v must be fixed throughout the proof.
It would be nice to have an explicit binding s = B d in the generated subgoal; unfortunately, the rule dsem.induct doesn't provide it.
Does anybody know a workaround for computing the value v in this case?
It seems strange to me that v should be at the same time fixed and computed from s and that is what chris is saying in the comments.
If the solution Brian gives in the comments is what you want, it could duplicate the expression f s which could be big (and use s several times) and perhaps the point of the assumption v = f s was to avoid this.
A first workaround (that was possibly what Brian implicitly proposed) is to make Isabelle do the unfolding:
lemma
assumes d: "dsem s s'"
and h: "h s v"
and v: "v = big_f s s"
shows "P v"
using d h
unfolding v -- {* <<<< *}
proof (induct rule: dsem.induct)
A second workaround could be to abbreviate big_f instead of big_f s s:
lemma
assumes d: "dsem s s'"
and h: "h s (f s)"
and v: "f = (λs. big_f s s)" -- {* <<<< *}
shows "P (f s)"
using d h
proof (induct rule: dsem.induct)