I have a function that doubles the elements of a list in the form
double [x1, x2, ...] = [x1, x1, x2, x2, ...]
namely
fun double :: " 'a list ⇒ 'a list"
where
"double [] = []" |
"double (x#xs) = x # x # double xs"
and a function that reverses the elements of a list with the help of another function snoc that adds an element to the right side of a list:
fun snoc :: "'a list ⇒ 'a ⇒ 'a list"
where
"snoc [] x = [x]" |
"snoc (y # ys) x = y # (snoc ys x)"
fun reverse :: "'a list ⇒ 'a list"
where
"reverse [] = []" |
"reverse (x # xs) = snoc (reverse xs) x"
Now I want to prove that
lemma rev_double: "rev (double xs) = double (rev xs)"
is true.
I tried to apply induction on xs
lemma rev_double: "rev (double xs) = double (rev xs)"
by (induction xs)
and I wrote an auxiliary lemma double_snoc that ensures that doubling a list is the same as doubling its first element and the rest of the list (which uses the function snocleft which inserts an element at the left end of a list)
fun snocleft::"'a list ⇒ 'a ⇒ 'a list "
where
"snocleft [] x = [x]" |
"snocleft (y # ys) x = x # (y # ys)"
lemma double_snoc: "double (snocleft xs y) = y # y # double xs"
by (induction xs) auto
I still haven't made any progress in proving the lemma. Do you have some solutions or hints on how to set up the prove?
You define your function as reverse, but in all of your lemmas, you use rev, referring to the pre-defined list reversal function rev.
What you mean is probably this:
lemma reverse_double: "reverse (double xs) = double (reverse xs)"
If you attempt to prove this by induction (with apply (induction xs)), you will get stuck in the induction case with the following goal:
snoc (snoc (double (reverse xs)) a) a =
double (snoc (reverse xs) a)
This should be intuitively obvious: if you first snoc and then double, it is the same as first doubling and then snoc-ing twice. So let's prove this as an auxiliary lemma:
lemma double_snoc: "double (snoc xs x) = snoc (snoc (double xs) x) x"
by (induction xs) auto
Now the proof of reverse_double goes through automatically:
lemma reverse_double: "reverse (double xs) = double (reverse xs)"
by (induction xs) (auto simp: double_snoc)
Related
fun intersperse :: " 'a list ⇒ 'a ⇒ 'a list" where
"intersperse (x#y#xs) a = x#(a#(intersperse (y#xs) a))"|
"intersperse xs _ = xs"
lemma target:"map f (intersperse xs a) = intersperse (map f xs) (f a)"
The lemma seems very intuitive, but I can't get Isabelle to prove the lemma. I tried induction on xs, but the sledgehammer still can't find a proof. Then I tried adding auxiliary lemmas, all of them are easy to prove but don't help much proving target. I will list my attempts below though:
lemma intersp_1: "interspserse (xs#[y,x]) a = (intersperse (xs#[y]) a) # [a,x]"
...done
lemma intersp_2:"map f (intersperse (xs#[b,x]) a) = (map f (intersperse (xs#[b]) a)) # [(f a),(f x)]"
...done
lemma intersp_3: "map f (intersperse (x#y#xs) a) = (f x)#(f a)#(map f (intersperse (y#xs) a))"
...done
As a new learner of Isabelle I'm kind of stuck here. The only solution that I can currently think of is to come up with an appropriate lemma that provides enough hint to the solver. However I don't know how to "appropriately" dispart the induction step of target (after applying induction on xs) into a supplementary lemma. The induction step is
goal (1 subgoal):
1. ⋀aa xs.
map f (intersperse xs a) = intersperse (map f xs) (f a) ⟹
map f (intersperse (aa # xs) a) = intersperse (map f (aa # xs)) (f a)
Any help is appreciated!
Here's a proof:
lemma target: "map f (intersperse xs a) = intersperse (map f xs) (f a)"
proof (induct xs)
case Nil
then show ?case by simp
next
case (Cons x xs)
consider "xs = []" | "∃y ys. xs = y # ys" by (meson list.exhaust)
then show ?case using Cons by (cases; auto)
qed
The key here is that intersperse (x # []) a and intersperse (x # y # ys) a match different patterns, so by considering each case separately sledgehammer can easily find a proof.
Here is another option: Use the specialized induction rule for intersperse:
lemma target:"map f (intersperse xs a) = intersperse (map f xs) (f a)"
by (induct "(map f xs)" "f a" arbitrary: xs rule: intersperse.induct) auto
The rule intersperse.induct contains three cases:
x#y#xs
[]
[v]
These can then be solved by auto since they fit the simplification rules available for the function.
Since the parameters of intersperse in the lemma are not variables, it is necessary to give them explicitly to the induct method and use arbitrary to state what the variable parts are.
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.
I am trying to solve Exercise 4.6 in “Programming and Proving in Isabelle/HOL”. It asks to define a function elems :: "'a list ⇒ 'a set" that converts a list into a set, and to prove the lemma "x ∈ elems xs ⟹ ∃ ys zs . xs = ys # x # zs ∧ x ∉ elems ys". Until now, I have come that far:
fun elems :: "'a list ⇒ 'a set" where
"elems [] = {}" |
"elems (x # xs) = {x} ∪ elems xs"
lemma first_occ: "x ∈ elems xs ⟹ ∃ ys zs . xs = ys # x # zs ∧ x ∉ elems ys"
proof (induction xs)
case Nil
thus ?case by simp
next
case (Cons u us)
show ?case
proof cases
assume "x = u"
thus ?case
proof
⟨…⟩
At this point, I get the error message “Failed to apply initial proof method”. This is strange, since the goal, ?case, is the proposition ∃ ys zs . u # us = ys # x # zs ∧ x ∉ elems ys, and it should be possible to prove existential propositions by showing the proposition under the ∃ for a specific witness.
the problem with your line proof is that it proof is meant to apply some default rule. In the above proof, Isabelle is not able to figure out that you want to perform existential introduction. So, you probably want to explicitly tell the system to do so, e.g., by continue with something like proof (intro exI).
I hope, this helps,
René
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, ...
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)