Rewrite with implications in Isabelle - isabelle

I am looking for a method to do rewriting, but with implications instead of equalities.
For example I know that x = 3 ∧ y = 4 implies Q x y and now I want to replace a positive occurrence of Q x y in my current subgoal with x = 3 ∧ y = 4.
Is there an existing method in Isabelle to do this?
For example I would like to do somthing like this (where implication_subst is the name of the method I am looking for):
lemma
assumes a1: "⋀x y. x = 3 ∧ y = 4 ⟹ Q x y"
shows "(∃x y. A x ∧ Q x y ∧ B y)"
proof (implication_subst a1)
show "∃x y. A x ∧ (x = 3 ∧ y = 4) ∧ B y"
sorry
qed
Below is my (incomplete) attempt to implement such a method using Eisbach, maybe this gives a better idea of what I am looking for:
named_theorems pos_cong
lemma implication_subst_exists[pos_cong]:
assumes "⋀x. P x ⟹ Q x"
and "∃x. P x"
shows "∃x. Q x"
using assms by blast
lemma implication_subst_conjl[pos_cong]:
assumes "P ⟹ Q"
and "P ∧ A"
shows "Q ∧ A"
using assms by blast
lemma implication_subst_conjr[pos_cong]:
assumes "P ⟹ Q"
and "A ∧ P"
shows "A ∧ Q"
using assms by blast
lemma implication_subst_neg[pos_cong]:
assumes "P ⟹ Q"
and "P"
shows "¬¬Q"
using assms by auto
lemma implication_subst_impl[pos_cong]:
assumes "P ⟹ ¬Q"
and "¬P ⟶ A"
shows "Q ⟶ A"
using assms by auto
lemma implication_subst_impr[pos_cong]:
assumes "P ⟹ Q"
and "A ⟶ P"
shows "A ⟶ Q"
using assms by auto
lemma implication_subst_neg_disj_l[pos_cong]:
assumes "P ⟹ ¬Q"
and "¬(¬P ∨ A)"
shows "¬(Q ∨ A)"
using assms by auto
lemma implication_subst_neg_disj_r[pos_cong]:
assumes "P ⟹ ¬Q"
and "¬(A ∨ ¬P)"
shows "¬(A ∨ Q)"
using assms by auto
method implication_subst_h uses r declares pos_cong = (
rule r
| (rule pos_cong, implication_subst_h r: r, assumption))
method implication_subst uses r declares pos_cong =
(implication_subst_h r: r pos_cong: pos_cong, (unfold not_not)?)
lemma example1:
assumes a1: "⋀x y. x = 3 ∧ y = 4 ⟹ Q x y"
shows "∃x y. A x ∧ Q x y ∧ B y"
proof (implication_subst r: a1)
show "∃x y. A x ∧ (x = 3 ∧ y = 4) ∧ B y"
sorry
qed
lemma example2:
assumes a1: "⋀x y. x = 3 ∧ y = 4 ⟹ Q x y"
shows "(∃x y. ¬(¬A x ∨ ¬Q x y ∨ ¬B y))"
proof (implication_subst r: a1)
show "∃x y. ¬ (¬ A x ∨ ¬ (x = 3 ∧ y = 4) ∨ ¬ B y)"
sorry
qed

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 prove elimination rules using Isar?

Here is a simple theory:
datatype t1 = A | B | C
datatype t2 = D | E t1 | F | G
inductive R where
"R A B"
| "R B C"
inductive_cases [elim]: "R x B" "R x A" "R x C"
inductive S where
"S D (E _)"
| "R x y ⟹ S (E x) (E y)"
inductive_cases [elim]: "S x D" "S x (E y)"
I can prove lemma elim using two helper lemmas:
lemma tranclp_S_x_E:
"S⇧+⇧+ x (E y) ⟹ x = D ∨ (∃z. x = E z)"
by (induct rule: converse_tranclp_induct; auto)
(* Let's assume that it's proven *)
lemma reflect_tranclp_E:
"S⇧+⇧+ (E x) (E y) ⟹ R⇧+⇧+ x y"
sorry
lemma elim:
"S⇧+⇧+ x (E y) ⟹
(x = D ⟹ P) ⟹ (⋀z. x = E z ⟹ R⇧+⇧+ z y ⟹ P) ⟹ P"
using reflect_tranclp_E tranclp_S_x_E by blast
I need to prove elim using Isar:
lemma elim:
assumes "S⇧+⇧+ x (E y)"
shows "(x = D ⟹ P) ⟹ (⋀z. x = E z ⟹ R⇧+⇧+ z y ⟹ P) ⟹ P"
proof -
assume "S⇧+⇧+ x (E y)"
then obtain z where "x = D ∨ x = E z"
by (induct rule: converse_tranclp_induct; auto)
also have "S⇧+⇧+ (E z) (E y) ⟹ R⇧+⇧+ z y"
sorry
finally show ?thesis
But I get the following errors:
No matching trans rules for calculation:
x = D ∨ x = E z
S⇧+⇧+ (E z) (E y) ⟹ R⇧+⇧+ z y
Failed to refine any pending goal
Local statement fails to refine any pending goal
Failed attempt to solve goal by exported rule:
(S⇧+⇧+ x (E y)) ⟹ P
How to fix them?
I guess that this lemma could have a simpler proof. But I need to prove it in two steps:
Show the possible values of x
Show that E reflects transitive closure
I think also that this lemma could be proven by cases on x. But my real data types have too many cases. So, it's not a preferred solution.
This variant seems to work:
lemma elim:
assumes "S⇧+⇧+ x (E y)"
and "x = D ⟹ P"
and "⋀z. x = E z ⟹ R⇧+⇧+ z y ⟹ P"
shows "P"
proof -
have "S⇧+⇧+ x (E y)" by (simp add: assms(1))
then obtain z where "x = D ∨ x = E z"
by (induct rule: converse_tranclp_induct; auto)
moreover
have "S⇧+⇧+ (E z) (E y) ⟹ R⇧+⇧+ z y"
sorry
ultimately show ?thesis
using assms by auto
qed
Assumptions should be separated from the goal.
As a first statement I shoud use have instead of assume. It's not a new assumption, just the existing one.
Instead of finally I should use ultimately. It seems that the later one has a simpler application logic.

What kind of functions preserve properties of closure?

I'm trying to prove the following lemmas:
lemma tranclp_fun_preserve:
"(⋀x y. x ≠ y ⟹ f x ≠ f y) ⟹
(⋀x y. f x ≠ f y ⟹ x ≠ y) ⟹
(⋀x y. f x = f y ⟹ x = y) ⟹
(λ x y. P x y)⇧+⇧+ (f x) (f y) ⟹ (λ x y. P (f x) (f y))⇧+⇧+ x y"
apply (erule tranclp.cases)
apply blast
lemma tranclp_fun_preserve2:
"(⋀x y. x ≠ y ⟹ f x ≠ f y) ⟹
(⋀x y. f x ≠ f y ⟹ x ≠ y) ⟹
(⋀x y. f x = f y ⟹ x = y) ⟹
(λ x y. P (f x) (f y))⇧+⇧+ x y ⟹ (λ x y. P x y)⇧+⇧+ (f x) (f y)"
apply (erule tranclp.cases)
apply blast
However, I'm stuck. Should I choose another set of assumptions for the function f? Could you suggest how to prove the lemmas tranclp_fun_preserve and tranclp_fun_preserve2?
UPDATE
My function is injective with a special property described at the end. I'm afraid that the following example is too long. However, I want to make it a little bit more realistic. Here are two auxiliary types errorable and nullable:
(*** errorable ***)
notation
bot ("⊥")
typedef 'a errorable ("_⇩⊥" [21] 21) = "UNIV :: 'a option set" ..
definition errorable :: "'a ⇒ 'a errorable" ("_⇩⊥" [1000] 1000) where
"errorable x = Abs_errorable (Some x)"
instantiation errorable :: (type) bot
begin
definition "⊥ ≡ Abs_errorable None"
instance ..
end
free_constructors case_errorable for
errorable
| "⊥ :: 'a errorable"
apply (metis Rep_errorable_inverse bot_errorable_def errorable_def not_Some_eq)
apply (metis Abs_errorable_inverse UNIV_I errorable_def option.inject)
by (simp add: Abs_errorable_inject bot_errorable_def errorable_def)
(*** nullable ***)
class opt =
fixes null :: "'a" ("ε")
typedef 'a nullable ("_⇩□" [21] 21) = "UNIV :: 'a option set" ..
definition nullable :: "'a ⇒ 'a nullable" ("_⇩□" [1000] 1000) where
"nullable x = Abs_nullable (Some x)"
instantiation nullable :: (type) opt
begin
definition "ε ≡ Abs_nullable None"
instance ..
end
free_constructors case_nullable for
nullable
| "ε :: 'a nullable"
apply (metis Rep_nullable_inverse null_nullable_def nullable_def option.collapse)
apply (simp add: Abs_nullable_inject nullable_def)
by (metis Abs_nullable_inverse UNIV_I null_nullable_def nullable_def option.distinct(1))
Two kinds of values:
datatype any = BoolVal "bool⇩⊥" | NatVal "nat⇩⊥" | RealVal "real⇩⊥" | InvalidAny unit
datatype oany = OBoolVal "bool⇩⊥⇩□" | ONatVal "nat⇩⊥⇩□" | ORealVal "real⇩⊥⇩□" | OInvalidAny "unit⇩□"
Here is a concrete example of the function f (any_to_oany), it's injective:
inductive any_oany :: "any ⇒ oany ⇒ bool" where
"any_oany (BoolVal x) (OBoolVal x⇩□)"
| "any_oany (NatVal x) (ONatVal x⇩□)"
| "any_oany (RealVal x) (ORealVal x⇩□)"
| "any_oany (InvalidAny x) (OInvalidAny x⇩□)"
fun any_to_oany :: "any ⇒ oany" where
"any_to_oany (BoolVal x) = (OBoolVal x⇩□)"
| "any_to_oany (NatVal x) = (ONatVal x⇩□)"
| "any_to_oany (RealVal x) = (ORealVal x⇩□)"
| "any_to_oany (InvalidAny x) = (OInvalidAny x⇩□)"
lemma any_oany_eq_fun:
"any_oany x y ⟷ any_to_oany x = y"
by (cases x; cases y; auto simp: any_oany.simps)
Here is a concrete example of the relation P (cast_oany):
inductive cast_any :: "any ⇒ any ⇒ bool" where
"cast_any (BoolVal ⊥) (InvalidAny ())"
| "cast_any (NatVal ⊥) (RealVal ⊥)"
| "cast_any (NatVal x⇩⊥) (RealVal (real x)⇩⊥)"
| "cast_any (RealVal ⊥) (InvalidAny ())"
inductive cast_oany :: "oany ⇒ oany ⇒ bool" where
"cast_any x y ⟹ any_oany x ox ⟹ any_oany y oy ⟹
cast_oany ox oy"
| "cast_oany (OBoolVal ε) (OInvalidAny ε)"
| "cast_oany (ONatVal ε) (ORealVal ε)"
| "cast_oany (ORealVal ε) (OInvalidAny ε)"
I proved equivalence of cast_any and cast_oany on any:
lemma cast_any_implies_cast_oany:
"cast_any x y ⟹ cast_oany (any_to_oany x) (any_to_oany y)"
by (simp add: any_oany_eq_fun cast_oany.intros(1))
lemma cast_oany_implies_cast_any:
"cast_oany (any_to_oany x) (any_to_oany y) ⟹ cast_any x y"
by (cases x; cases y; simp add: any_oany.simps cast_oany.simps)
And my final goal is to prove similar lemmas for the transitive closures of these relations:
lemma trancl_cast_oany_implies_cast_any:
"cast_oany⇧+⇧+ (any_to_oany x) (any_to_oany y) ⟹ cast_any⇧+⇧+ x y"
lemma trancl_cast_any_implies_cast_oany:
"cast_any⇧+⇧+ x y ⟹ cast_oany⇧+⇧+ (any_to_oany x) (any_to_oany y)"
I proved the following intermediate lemmas:
lemma trancl_cast_oany_implies_cast_any':
"(λx y. cast_oany (any_to_oany x) (any_to_oany y))⇧+⇧+ x y ⟹
cast_any⇧+⇧+ x y"
apply (erule tranclp_trans_induct)
apply (simp add: cast_oany_implies_cast_any tranclp.r_into_trancl)
by auto
lemma trancl_cast_any_implies_cast_oany':
"cast_any⇧+⇧+ x y ⟹
(λx y. cast_oany (any_to_oany x) (any_to_oany y))⇧+⇧+ x y"
apply (erule tranclp_trans_induct)
apply (simp add: cast_any_implies_cast_oany tranclp.r_into_trancl)
by auto
At last, if I could prove the following lemmas from the original question, then I will able to prove my goal lemmas.
lemma tranclp_fun_preserve:
"cast_oany⇧+⇧+ (any_to_oany x) (any_to_oany y) ⟹
(λx y. cast_oany (any_to_oany x) (any_to_oany y))⇧+⇧+ x y"
lemma tranclp_fun_preserve2:
"(λx y. cast_oany (any_to_oany x) (any_to_oany y))⇧+⇧+ x y ⟹
cast_oany⇧+⇧+ (any_to_oany x) (any_to_oany y)"
In this paragraph I provide an important property of the function any_to_oany. The set of oany values consists of two parts:
nulls (OBoolVal ε, ONatVal ε, ORealVal ε, OInvalidAny ε)
all other values.
The relation cast_oany relates the values inside the first part and inside the second part separately. There is no relation between the values from different parts. The function any_to_oany maps values only to the second part. I don't know what is the right name of this property: subsets 1 and 2 are "closed" with respect to the relation cast_oany. And the function any_to_oany maps values only to one subset, and it's bijective on this subset.
The answer presented below is a substantial revision of the original answer. The original answer is available through the revision history.
Effectively, in the course of the initial revisions it was established that the question comes down to merely proving that bijective functions between two sets preserve the properties of closure. The solution below presents the relevant proofs without the application-specific context (the answer also combines some of the amendments to the original answer that were made by the author of the thread):
section ‹Extension of the theory #{text Transitive_Closure}›
theory Transitive_Closure_Ext
imports
Complex_Main
"HOL-Library.FuncSet"
begin
lemma trancl_subset_trancl: "r ⊆ s⇧+ ⟹ r⇧+ ⊆ s⇧+"
by (metis subsetI trancl_id trancl_mono trans_trancl)
lemma mono_tranclp[mono]: "(⋀a b. R a b ⟶ S a b) ⟹ R⇧+⇧+ a b ⟶ S⇧+⇧+ a b"
apply(rule) using trancl_mono[to_pred] by blast
lemma tranclp_mono: "R ≤ S ⟹ R⇧+⇧+ ≤ S⇧+⇧+"
by (metis (full_types) mono_tranclp predicate2D predicate2I)
lemma preserve_tranclp:
assumes "⋀x y. R x y ⟹ S (f x) (f y)"
shows "R⇧+⇧+ x y ⟹ S⇧+⇧+ (f x) (f y)"
proof -
assume Rpp: "R⇧+⇧+ x y"
define P where P: "P = (λx y. S⇧+⇧+ (f x) (f y))"
define r where r: "r = (λx y. S (f x) (f y))"
have major: "r⇧+⇧+ x y"
by (insert assms Rpp r; erule tranclp_trans_induct; auto)
have cases_1: "r x y ⟹ P x y" for x y unfolding r P by simp
have cases_2: "r⇧+⇧+ x y ⟹ P x y ⟹ r⇧+⇧+ y z ⟹ P y z ⟹ P x z" for x y z
unfolding P by simp
from major cases_1 cases_2 have "P x y" by (rule tranclp_trans_induct)
thus "S⇧+⇧+ (f x) (f y)" unfolding P .
qed
lemma preserve_trancl:
assumes "map_prod f f ` r ⊆ s"
shows "map_prod f f ` r⇧+ ⊆ s⇧+"
proof -
from assms have "(x, y) ∈ r ⟶ (f x, f y) ∈ s" for x y by auto
then have "(x, y) ∈ r⇧+ ⟶ (f x, f y) ∈ s⇧+" for x y
by (metis preserve_tranclp[to_set])
thus "map_prod f f ` r⇧+ ⊆ s⇧+" by clarsimp
qed
lemma preserve_tranclp_inv:
assumes bij_f: "bij_betw f a b"
and R: "⋀x y. R x y ⟹ (x, y) ∈ a × a"
and S: "⋀x y. S x y ⟹ (x, y) ∈ b × b"
and S_R: "⋀x y. (x, y) ∈ a × a ⟹ S (f x) (f y) ⟹ R x y"
shows "(x, y) ∈ a × a ⟹ S⇧+⇧+ (f x) (f y) ⟹ R⇧+⇧+ x y"
proof -
assume x_y_in_aa: "(x, y) ∈ a × a"
assume Spp: "S⇧+⇧+ (f x) (f y)"
define g where g: "g = the_inv_into a f"
define gr where gr: "gr = restrict g b"
define P where P: "P = (λx y. (x, y) ∈ b × b ⟶ R⇧+⇧+ (gr x) (gr y))"
from Spp have fx_fy_in_bb: "(f x, f y) ∈ b × b"
using S by (metis converse_tranclpE mem_Sigma_iff tranclp.cases)
have cases_1: "S x y ⟹ P x y" for x y unfolding P
proof(rule impI)
assume Sxy: "S x y" and xy_in_bb: "(x, y) ∈ b × b"
with bij_f have gr_in_aa: "(gr x, gr y) ∈ a × a"
unfolding gr g apply(auto)
using bij_betwE bij_betw_the_inv_into by blast+
from bij_f xy_in_bb have "x = f (gr x)" and "y = f (gr y)"
unfolding gr g using f_the_inv_into_f_bij_betw by fastforce+
with Sxy have S_fgrx_fgry: "S (f (gr x)) (f (gr y))" by simp
from gr_in_aa S_fgrx_fgry have "R (gr x) (gr y)" by (rule S_R)
thus "R⇧+⇧+ (gr x) (gr y)" ..
qed
with bij_f S have
"S⇧+⇧+ x y ⟹ S⇧+⇧+ y z ⟹ x ∈ b ⟹ z ∈ b ⟹ y ∈ b" for x y z
by (auto dest: SigmaD1 tranclpD)
with P have cases_2:
"S⇧+⇧+ x y ⟹ P x y ⟹ S⇧+⇧+ y z ⟹ P y z ⟹ P x z" for x y z
by auto
from Spp cases_1 cases_2 have "P (f x) (f y)" by (rule tranclp_trans_induct)
with bij_f fx_fy_in_bb x_y_in_aa show "R⇧+⇧+ x y"
unfolding P gr g restrict_def bij_betw_def by (simp add: the_inv_into_f_f)
qed
lemma preserve_trancl_inv:
assumes bij_f: "bij_betw f a b"
and r_in_aa: "r ⊆ a × a"
and s_in_bb: "s ⊆ b × b"
and s_r: "(map_prod f f -` s) ∩ (a × a) ⊆ r ∩ (a × a)"
shows "(map_prod f f -` s⇧+) ∩ (a × a) ⊆ r⇧+ ∩ (a × a)"
proof -
from r_in_aa have r_in_aa_set:
"(x, y) ∈ r ⟹ (x, y) ∈ a × a" for x y by auto
from s_in_bb have s_in_bb_set: "⋀x y. (x, y) ∈ s ⟹ (x, y) ∈ b × b" by auto
from s_r have s_r_set:
"(x, y) ∈ a × a ⟹ (f x, f y) ∈ s ⟹ (x, y) ∈ r" for x y
unfolding map_prod_def by auto
from bij_f r_in_aa_set s_in_bb_set s_r_set have
"(x, y) ∈ a × a ⟹ (f x, f y) ∈ s⇧+ ⟹ (x, y) ∈ r⇧+" for x y
by (rule preserve_tranclp_inv[to_set])
thus ?thesis unfolding map_prod_def by clarsimp
qed
lemma preserve_rtranclp:
assumes "⋀x y. R x y ⟹ S (f x) (f y)"
shows "R⇧*⇧* x y ⟹ S⇧*⇧* (f x) (f y)"
by (insert assms, metis Nitpick.rtranclp_unfold preserve_tranclp)
lemma preserve_rtrancl:
assumes "map_prod f f ` r ⊆ s"
shows "map_prod f f ` r⇧* ⊆ s⇧*"
proof -
from assms have "(x, y) ∈ r ⟶ (f x, f y) ∈ s" for x y by auto
then have "(x, y) ∈ r⇧* ⟶ (f x, f y) ∈ s⇧*" for x y
by (metis preserve_rtranclp[to_set])
thus "map_prod f f ` r⇧* ⊆ s⇧*" by clarsimp
qed
lemma preserve_rtranclp_inv:
assumes bij_f: "bij_betw f a b"
and "⋀x y. R x y ⟹ (x, y) ∈ a × a"
and "⋀x y. S x y ⟹ (x, y) ∈ b × b"
and "⋀x y. (x, y) ∈ a × a ⟹ S (f x) (f y) ⟹ R x y"
shows "(x, y) ∈ a × a ⟹ S⇧*⇧* (f x) (f y) ⟹ R⇧*⇧* x y"
proof -
assume xy_in_aa: "(x, y) ∈ a × a" and Spp: "S⇧*⇧* (f x) (f y)"
show "R⇧*⇧* x y"
proof(cases "f x ≠ f y")
case True show ?thesis
proof -
from True Spp obtain z where "S⇧*⇧* (f x) z" and "S z (f y)"
by (auto elim: rtranclp.cases)
then have "S⇧+⇧+ (f x) (f y)" by (rule rtranclp_into_tranclp1)
with assms xy_in_aa have "R⇧+⇧+ x y" by (rule preserve_tranclp_inv)
thus ?thesis by simp
qed
next
case False show ?thesis
proof -
from False xy_in_aa bij_f have "x = y"
unfolding bij_betw_def by (auto dest: SigmaD1 SigmaD2 inj_onD)
thus "R⇧*⇧* x y" by simp
qed
qed
qed
lemma preserve_rtrancl_inv:
assumes bij_f: "bij_betw f a b"
and r_in_aa: "r ⊆ a × a"
and s_in_bb: "s ⊆ b × b"
and as_s_r: "(map_prod f f -` s) ∩ (a × a) ⊆ r ∩ (a × a)"
shows "(map_prod f f -` s⇧*) ∩ (a × a) ⊆ r⇧* ∩ (a × a)"
proof -
from r_in_aa have r_in_aa_set:
"(x, y) ∈ r ⟹ (x, y) ∈ a × a" for x y by auto
from s_in_bb have s_in_bb_set:
"(x, y) ∈ s ⟹ (x, y) ∈ b × b" for x y by auto
from as_s_r have s_r:
"(x, y) ∈ a × a ⟹ (f x, f y) ∈ s ⟹ (x, y) ∈ r" for x y
unfolding map_prod_def by auto
from bij_f r_in_aa_set s_in_bb_set s_r have
"(x, y) ∈ a × a ⟹ (f x, f y) ∈ s⇧* ⟹ (x, y) ∈ r⇧*" for x y
by (rule preserve_rtranclp_inv[to_set])
thus ?thesis unfolding map_prod_def by clarsimp
qed
end

Can't obtain variable

I'm trying to prove the following simple theorem I've come up with, that:
A point is on the boundary iff any small enough ball around that point contains points both in S and out of S.
Below I've managed to do the forward direction but I'm stuck on the backwards direction.
Using the same approach fails on the last step, the goal is close but not quite there, and I'm not sure what to do here:
lemma frontier_ball: "x ∈ frontier S ⟷
(∃r>0. (∀δ>0. δ<r ⟶ ((ball x δ) ∩ S ≠ {} ∧ (ball x δ) ∩ -S ≠ {})))"
(is "?lhs = ?rhs")
proof
{
assume "?lhs"
hence "x ∉ interior S ∧ x ∉ interior (-S)" by (auto simp: frontier_def interior_complement)
hence "∀δ>0. ((ball x δ) ∩ S ≠ {} ∧ (ball x δ) ∩ -S ≠ {})" by (auto simp: mem_interior)
then have "?rhs" by (simp add: Orderings.no_top_class.gt_ex)
}
{
assume "¬?lhs"
hence "x ∈ interior S ∨ x ∈ interior (-S)" by (auto simp: frontier_def interior_complement)
hence "∃δ>0. ball x δ ∩ S = {} ∨ ball x δ ∩ -S = {}" by (auto simp: mem_interior)
then have "¬?rhs" by (simp add: subset_ball)
}
qed
I tried to tell isabelle how to obtain such a delta but it's stuck on the obtain step:
lemma frontier_ball: "x ∈ frontier S ⟷
(∃r>0. (∀δ>0. δ<r ⟶ ((ball x δ) ∩ S ≠ {} ∧ (ball x δ) ∩ -S ≠ {})))"
(is "?lhs = ?rhs")
proof
{
assume "?lhs"
hence "x ∉ interior S ∧ x ∉ interior (-S)" by (auto simp: frontier_def interior_complement)
hence "∀δ>0. ((ball x δ) ∩ S ≠ {} ∧ (ball x δ) ∩ -S ≠ {})" by (auto simp: mem_interior)
then have "?rhs" by (simp add: Orderings.no_top_class.gt_ex)
}
{
fix r::real
assume "¬?lhs ∧ r>0"
hence "x ∈ interior S ∨ x ∈ interior (-S)" by (auto simp: frontier_def interior_complement)
then obtain r2 where "r2>0" and "ball x r2 ∩ S = {} ∨ ball x r2 ∩ -S = {}" by (auto simp: mem_interior)
then obtain δ where "δ>0 ∧ δ<r ∧ δ<r2" by auto
}
qed
Any pointers would be great!
Well, you can just construct such a δ. If you have r > 0 and r2 > 0 you want some δ that fulfils 0 < δ ≤ r2 and 0 < δ < r, why not just use min r2 (r/2)? You can define δ to be that and then you can prove the properties you want:
def δ ≡ "min r2 (r/2)"
with r2 A have δ: "δ > 0" "δ < r" "δ ≤ r2" by auto
with r2 have δ': "ball x δ ∩ S = {} ∨ ball x r2 ∩ -S = {}" using subset_ball[OF δ(3)] by auto
Or, a bit more direct:
lemma frontier_ball: "(x :: 'a :: {metric_space}) ∈ frontier S ⟷
(∃r>0. (∀δ>0. δ<r ⟶ ((ball x δ) ∩ S ≠ {} ∧ (ball x δ) ∩ -S ≠ {})))"
(is "?lhs = ?rhs")
proof -
{
assume "?lhs"
hence "x ∉ interior S ∧ x ∉ interior (-S)" by (auto simp: frontier_def interior_complement)
hence "∀δ>0. ((ball x δ) ∩ S ≠ {} ∧ (ball x δ) ∩ -S ≠ {})" by (auto simp: mem_interior)
then have "?rhs" by (simp add: Orderings.no_top_class.gt_ex)
}
moreover
{
assume lhs: "¬?lhs"
{
fix r :: real assume r: "r > 0"
from lhs have "x ∈ interior S ∨ x ∈ interior (-S)"
by (auto simp: frontier_def interior_complement)
then obtain δ where "δ > 0" "ball x δ ∩ S = {} ∨ ball x δ ∩ -S = {}"
by (auto simp: mem_interior)
with r have "min δ (r/2) > 0" "min δ (r/2) < r"
"ball x (min δ (r/2)) ∩ S = {} ∨ ball x (min δ (r/2)) ∩ -S = {}" using subset_ball by auto
hence "∃δ>0. δ < r ∧ (ball x δ ∩ S = {} ∨ ball x δ ∩ -S = {})" by blast
}
hence "¬?rhs" by blast
}
ultimately show ?thesis by blast
qed
For the record, I would avoid doing things like assume "A ∧ B". Do assume "A" "B" instead. That gives you two facts that you can work with directly, instead of having them wrapped up with a HOL conjunction in one fact.

Resources