Proof over cases for which set element is included in - isabelle

I want to validate the following theorem, for which I already have a proof on paper, in Isabelle:
theorem
assumes "(X :: 'a set) ∩ (Y :: 'a set) = {}"
and "trans (r :: 'a rel) ∧ total_in X r"
and "trans (r' :: 'a rel) ∧ total_in Y r'"
shows "∃ m. m ⊇ (r ∪ r') ∧ trans m ∧ total_in (X ∪ Y) m"
proof
have 1: "(r ∪ r' ∪ {(x, y) | x y. x ∈ X ∧ y ∈ Y}) ⊇ (r ∪ r')" by simp
have 2: "trans (r ∪ r' ∪ {(x, y) | x y. x ∈ X ∧ y ∈ Y})" sorry
have 3: "total_in (X ∪ Y) (r ∪ r' ∪ {(x, y) | x y. x ∈ X ∧ y ∈ Y})" sorry
from 1 2 3 show "
r ∪ r' ⊆ (r ∪ r' ∪ {(x, y) | x y. x ∈ X ∧ y ∈ Y})
∧ trans (r ∪ r' ∪ {(x, y) | x y. x ∈ X ∧ y ∈ Y})
∧ total_in (X ∪ Y) (r ∪ r' ∪ {(x, y) | x y. x ∈ X ∧ y ∈ Y})" by auto
qed
To prove 2 and 3, I would like to make use of a case distinction on which subsets the parties in a given member of the new relation are included in:
(a, b) ∈ (r ∪ r' ∪ {(x, y) | x y. x ∈ X ∧ y ∈ Y}) where (a ∈ X, b ∈ X) or (a ∈ X, b ∈ Y), etc.
For each of the possible cases, I would then like to prove the subgoals.
Is there some kind of automatic proof rule that can help me formalize this? I am quite new to Isabelle and am not sure what I even would be searching for in the reference to find this.
Furthermore, I am unhappy with having to copy "(r ∪ r' ∪ {(x, y) | x y. x ∈ X ∧ y ∈ Y})" all over the place. What is the idiomatic way to extract this new relation into some kind of definition to avoid copying?

Below I provide a code listing that, hopefully, will help you to find answers to most of the problems stated in your question:
definition total_in :: "'a set ⇒ 'a rel ⇒ bool"
where "total_in X r ⟷ total_on X r ∧ r ⊆ X × X"
―‹I could not find the definition of ‹total_in› in the source code of
Isabelle/HOL. Please let me know if my guess is wrong.›
lemma total_inI[intro]:
assumes "total_on X r" and "r ⊆ X × X"
shows "total_in X r"
using assms unfolding total_in_def by simp
lemma total_inE[elim]:
assumes "total_in X r"
obtains "total_on X r" and "r ⊆ X × X"
using assms unfolding total_in_def by simp
lemma my_thm:
―‹In this case, there does not seem to be any need to specify the types
explicitly: type inference does not seem to struggle to infer the types
that you suggested.›
―‹There is rarely a need to combine assumptions using HOL's conjunction.›
―‹Some of the assumptions seem to be redundant. Of course, given that I
am not certain as to what is the meaning of ‹total_in›, I might be wrong.›
assumes "total_in X r" and "total_in Y r'"
shows "∃m. m ⊇ r ∪ r' ∧ trans m ∧ total_in (X ∪ Y) m"
proof(intro exI conjI)
―‹Use the introduction of the existential quantifier and conjunction to
start the proof.›
let ?m = "(X ∪ Y) × (X ∪ Y)"
―‹Syntactic abbreviation.›
―‹Alternatively you can use ‹define› to provide a new definition inside
the proof context, e.g. ‹define m where "m = (X ∪ Y) × (X ∪ Y)"››
show "r ∪ r' ⊆ ?m" using assms by auto
show "trans ?m" by (intro transI) auto
show "total_in (X ∪ Y) ?m" by (auto simp: total_on_def)
qed
Side remarks:
I am not certain what exactly is the intended meaning of total_in in the statement of your question. I could not find this constant in the Isabelle/HOL's source code. I took the liberty to guess its meaning and provide my own definition (please let me know if my guess was wrong).
My proof is not entirely identical to the proof that you proposed. However, hopefully, you will be able to modify it to suit your needs.
I am quite new to Isabelle and am not sure what I even would be
searching for in the reference to find this.
My own starting point for learning Isabelle was the book "Concrete Semantics" by Tobias Nipkow and Gerwin Klein. Once you are comfortable with the basics, the best way to proceed when you start struggling to find information is to search through the official documentation, i.e. the tutorials and the document "isar-ref".
In this particular case, it is likely that you would wish to look at "Section 6: Proofs" in "isar-ref".
Isabelle version: Isabelle2020

Related

Isar: Failed to retrieve literal fact

I have the following code:
assume H: "x ≠ xa ∧ x ∈ elems xs" (is "?H1 ∧ ?H2")
hence "?H1" and "?H2" by auto
from Cons.IH[OF `?H2` ] have 1: "∃ys zs. xs = ys # x # zs ∧ x ∉ elems ys" by simp
then obtain ys zs where 2: "xs = ys # x # zs ∧ x ∉ elems ys" (is "?C1 ∧ ?C2") by blast
hence "?C1" and "?C2" by auto
from `?C1` have R1: "xa # xs = (xa # ys) # x # zs" by simp
from `x ≠ xa` and `x ∉ elems ys` have R2: "x ∉ elems (xa#ys)" by auto
from R1 R2 show ?case by blast
Without the lines : hence "?H1" and "?H2" by auto and hence "?C1" and "?C2" by auto I cannot refer to the literal facts `?C1` and `?H2`. (I also cannot refer to the terms the "unkowns/abbreviations/metavariables/" ?<name> expand to; I get the same error. The metavariables are actually expanded to the literal facts they refer to in the error message (e.g. for `?H2` I get
Failed to retrieve literal fact⌂:
x ∈ elems xs
, so they must be in scope somehow??)
My question is:
Why does this not work?
is there a better workaround than my hence … by auto?
Expanding on Javier's comment, the (is "?H1 ∧ ?H2") creates two macro variables. Those are in scope, such as is ?case for instance. ?H1 and ?H2 refer to the terms x ≠ xa and x ∈ elems xs, but this does not mean that they are proven facts. What changes, are the term bindings, as you can inspect by:
assume H: "x ≠ xa ∧ x ∈ elems xs" (is "?H1 ∧ ?H2")
print_term_bindings
>>>>
?H1 ≡ ¬ x = xa
?H2 ≡ x ∈ elems xs
...
print_facts
>>>>
H: x ≠ xa ∧ x ∈ elems xs
...
Your snippet is just a sugared way of writing:
assume H: "x ≠ xa ∧ x ∈ elems xs"
hence "x ≠ xa" and "x ∈ elems xs" by auto
from Cons.IH[OF `x ∈ elems xs`] have 1: "∃ys zs. xs = ys # x # zs ∧ x ∉ elems ys" by simp
then obtain ys zs where 2: "xs = ys # x # zs ∧ x ∉ elems ys" by blast
hence "xs = ys # x # zs" and "x ∉ elems ys" by auto
from `xs = ys # x # zs` have R1: "xa # xs = (xa # ys) # x # zs" by simp
from `x ≠ xa` and `x ∉ elems ys` have R2: "x ∉ elems (xa#ys)" by auto
from R1 R2 show [whatever ?case expands to] by blast
Clearly, this proof does not work if you drop the line hence "x ≠ xa" and "x ∈ elems xs" by auto, which proves the literal fact x ∈ elems xs. Without it, Isabelle cannot accept Cons.IH[OF `x ∈ elems xs`], which causes the error you cite.
Regarding the question of how to write an equivalent proof without the need for hence … by auto: You can't, really. There needs to be some proof that the conjuncts are facts.
The most lightweight way to refer to sub-conjuncts of facts as facts is with conjunct1/2[OF ...]: Just write from Cons.IH[OF conjunct2[OF H]] have... instead of from Cons.IH[OF `?H2`] have....
However, what you are emulating here through term bindings is actually the “array” feature of Isabelle's facts.
If one writes a fact as a chain of sub-facts H: ‹x ≠ xa› ‹x ∈ elems xs› instead of H: ‹x ≠ xa ∧ x ∈ elems xs›, one can afterwards refer to the first part as H(1) and to the second one as H(2). In your example, one would have to slightly adapt the surrounding proof (using safe or clarify) in order for the changed assumption to be okay. It would then read something like:
proof (..., safe)
assume H: "x ≠ xa" "x ∈ elems xs"
from Cons.IH[OF H(2)] have 1: "∃ys zs. xs = ys # x # zs ∧ x ∉ elems ys" by simp
then obtain ys zs where C: "xs = ys # x # zs" "x ∉ elems ys" by blast
from C(1) have R1: "xa # xs = (xa # ys) # x # zs" by simp
from `x ≠ xa` and `x ∉ elems ys` have R2: "x ∉ elems (xa#ys)" by auto
from R1 R2 show ?case by blast
next ...
No macros for literal-fact names or unpacking needed!
My general experience is that there are very limited reasons to use the macros for naming literal facts when you can use the conventional naming of facts. Even more generally, most of the time when one can express a conjunction or an implication at the meta level, opting for meta will make life easier: assumes P: "a" "b" shows "c" is more handy than shows "a /\ b ==> c".

How to prove by case analysis on a logical condition being either true or false in Isabelle/HOL?

I know that Isabelle can do case analysis by constructors (e.g. of a list), but
Is there a way to split into cases based on whether a condition is true or false?
For example, in proving the following lemma, my logic (as indicated by the following invalid proof in invalid syntax), is that if the condition "x ∈ A" is true, the proof simplifies to something trivial; it also simplifies when the condition is false (i.e. "x ∉ A"):
lemma "(x ∈ A ∨ x ∈ B) ∧ (x ∈ A ∨ x ∈ C) ⟹ x ∈ A ∨ (x ∈ B ∧ x ∈ C)"
proof (case "x ∈ A")
(* ... case true *)
show "x ∈ A ∨ (x ∈ B ∧ x ∈ C)" by (rule disjI1)
next (* ... case false *)
have "x ∈ B ∧ x ∈ C" by simp
show "x ∈ A ∨ (x ∈ B ∧ x ∈ C)" by (rule disjI2)
But I don't know how to translate this "case analysis" in English into Isabelle.
Is there way in Isabelle/HOL to express this kind of case analysis by the true or false of a condition? (as of Isabelle 2021)
(Or does it require additional axioms such as the law of excluded middle?)
You've almost correctly guessed the syntax, you can write a proof by cases for any predicate with the syntax proof (cases "<pred>").
For the example you provided:
lemma "(x ∈ A ∨ x ∈ B) ∧ (x ∈ A ∨ x ∈ C) ⟹ x ∈ A ∨ (x ∈ B ∧ x ∈ C)"
proof (cases "x ∈ A")
(* ... case true *)
case True
then show "x ∈ A ∨ (x ∈ B ∧ x ∈ C)" by (rule disjI1)
next (* ... case false *)
case False
then have "x ∈ B ∧ x ∈ C" sorry (* by simp*)
then show "x ∈ A ∨ (x ∈ B ∧ x ∈ C)" by (rule disjI2)

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 can I prove the lemma in Exercise 4.6 in “Programming and Proving in Isabelle/HOL”?

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é

Lifting a partial definition to a quotient type

I have a partially-defined operator (disj_union below) on sets that I would like to lift to a quotient type (natq). Morally, I think this should be ok, because it is always possible to find in the equivalence class some representative for which the operator is defined [*]. However, I cannot complete the proof that the lifted definition preserves the equivalence, because disj_union is only partially defined. In my theory file below, I propose one way I have found to define my disj_union operator, but I don't like it because it features lots of abs and Rep functions, and I think it would be hard to work with (right?).
What is a good way to define this kind of thing using quotients in Isabelle?
theory My_Theory imports
"~~/src/HOL/Library/Quotient_Set"
begin
(* A ∪-operator that is defined only on disjoint operands. *)
definition "X ∩ Y = {} ⟹ disj_union X Y ≡ X ∪ Y"
(* Two sets are equivalent if they have the same cardinality. *)
definition "card_eq X Y ≡ finite X ∧ finite Y ∧ card X = card Y"
(* Quotient sets of naturals by this equivalence. *)
quotient_type natq = "nat set" / partial: card_eq
proof (intro part_equivpI)
show "∃x. card_eq x x" by (metis card_eq_def finite.emptyI)
show "symp card_eq" by (metis card_eq_def symp_def)
show "transp card_eq" by (metis card_eq_def transp_def)
qed
(* I want to lift my disj_union operator to the natq type.
But I cannot complete the proof, because disj_union is
only partially defined. *)
lift_definition natq_add :: "natq ⇒ natq ⇒ natq"
is "disj_union"
oops
(* Here is another attempt to define natq_add. I think it
is correct, but it looks hard to prove things about,
because it uses abstraction and representation functions
explicitly. *)
definition natq_add :: "natq ⇒ natq ⇒ natq"
where "natq_add X Y ≡
let (X',Y') = SOME (X',Y').
X' ∈ Rep_natq X ∧ Y' ∈ Rep_natq Y ∧ X' ∩ Y' = {}
in abs_natq (disj_union X' Y')"
end
[*] This is a little bit like how capture-avoiding substitution is only defined on the condition that bound variables do not clash; a condition that can always be satisfied by renaming to another representative in the alpha-equivalence class.
What about something like this (just an idea):
definition disj_union' :: "nat set ⇒ nat set ⇒ nat set"
where "disj_union' X Y ≡
let (X',Y') = SOME (X',Y').
card_eq X' X ∧ card_eq Y' Y ∧ X' ∩ Y' = {}
in disj_union X' Y'"
lift_definition natq_add :: "natq ⇒ natq ⇒ natq"
is "disj_union'" oops
For the record, here is Ondřej's suggestion (well, a slight amendment thereof, in which only one of the operands is renamed, not both) carried out to completion...
(* A version of disj_union that is always defined. *)
definition disj_union' :: "nat set ⇒ nat set ⇒ nat set"
where "disj_union' X Y ≡
let Y' = SOME Y'.
card_eq Y' Y ∧ X ∩ Y' = {}
in disj_union X Y'"
(* Can always choose a natural that is not in a given finite subset of ℕ. *)
lemma nats_infinite:
fixes A :: "nat set"
assumes "finite A"
shows "∃x. x ∉ A"
proof (rule ccontr, simp)
assume "∀x. x ∈ A"
hence "A = UNIV" by fast
hence "finite UNIV" using assms by fast
thus False by fast
qed
(* Can always choose n naturals that are not in a given finite subset of ℕ. *)
lemma nat_renaming:
fixes x :: "nat set" and n :: nat
assumes "finite x"
shows "∃z'. finite z' ∧ card z' = n ∧ x ∩ z' = {}"
using assms
apply (induct n)
apply (intro exI[of _ "{}"], simp)
apply (clarsimp)
apply (rule_tac x="insert (SOME y. y ∉ x ∪ z') z'" in exI)
apply (intro conjI, simp)
apply (rule someI2_ex, rule nats_infinite, simp, simp)+
done
lift_definition natq_add :: "natq ⇒ natq ⇒ natq"
is "disj_union'"
apply (unfold disj_union'_def card_eq_def)
apply (rule someI2_ex, simp add: nat_renaming)
apply (rule someI2_ex, simp add: nat_renaming)
apply (metis card.union_inter_neutral disj_union_def empty_iff finite_Un)
done

Resources