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".
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)
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
I'm formalizing this article in Isabelle. In section 4.1 it describes the following setting:
context
fixes c d :: real
assumes "c ≠ 0" "∃ b. c = b^2" "∃ b'. d = b'^2"
begin
definition t where "t = sqrt(d/c)"
definition e' where "e' x y = x^2 + y^2 - 1 - t^2 * x^2 * y^2"
definition ρ where "ρ x y = (-y,x)"
definition τ where "τ x y = (1/(t*x),1/(t*y))"
It then defines G to be the abelian group of order eight generated by ρ and τ.
Is there an easy way of:
Stating that ρ and τ generate a group.
Since ρ and τ have order 2 and commute I think that all the rest commute and maybe there is a built-in theorem saying that this has to correspond to an abelian group of order 8?
I did make an attempt to solve the problem and came up with a slightly forceful method for its solution:
context
fixes c d :: real
assumes "c ≠ 0" "∃b. c = b^2" "∃b'. d = b'^2"
begin
definition t where "t = sqrt(d/c)"
definition e' where "e' x y = x^2 + y^2 - 1 - t^2 * x^2 * y^2"
context
assumes nz_t: "t ≠ 0"
begin
definition ρ :: "real × real ⇒ real × real" where
"ρ z = (-snd z, fst z)"
definition τ :: "real × real ⇒ real × real" where
"τ z = (1/(t*fst z), 1/(t*snd z))"
definition S where
"S ≡
{
id,
(λz. (-snd z, fst z)),
(λz. (-fst z, -snd z)),
(λz. (snd z, -fst z)),
(λz. (1/(t*fst z), 1/(t*snd z))),
(λz. (-1/(t*snd z), 1/(t*fst z))),
(λz. (-1/(t*fst z), -1/(t*snd z))),
(λz. (1/(t*snd z), -1/(t*fst z)))
}"
definition ρS where
"ρS ≡
{id, (λz. (-snd z, fst z)), (λz. (-fst z, -snd z)), (λz. (snd z, -fst z))}"
definition τS where
"τS ≡ {id, (λz. (1/(t*fst z), 1/(t*snd z)))}"
definition BIJ where "BIJ = ⦇carrier = {f. bij f}, mult = comp, one = id⦈"
interpretation bij: group BIJ
unfolding BIJ_def
apply unfold_locales
subgoal by (simp add: bij_comp)
subgoal by (simp add: comp_assoc)
subgoal by simp
subgoal by simp
subgoal by simp
subgoal
unfolding Units_def
by clarsimp
(metis inj_iff bij_betw_def bij_betw_inv_into inv_o_cancel surj_iff)
done
(*the proof may take quite a few seconds*)
lemma comp_S: "x ∈ S ⟹ y ∈ S ⟹ x ∘ y ∈ S"
unfolding comp_apply S_def Set.insert_iff by (elim disjE) fastforce+
lemma comm_S: "x ∈ S ⟹ y ∈ S ⟹ x ∘ y = y ∘ x"
unfolding comp_apply S_def Set.insert_iff by (elim disjE) fastforce+
lemma bij_ρ: "bij ρ"
unfolding bij_def inj_def surj_def ρ_def
by clarsimp (metis add.inverse_inverse)
lemma bij_τ: "bij τ"
unfolding bij_def inj_def surj_def τ_def
proof(simp add: nz_t, intro allI, intro exI)
fix a show "a = 1 / (t * (1/(a*t)))" using nz_t by simp
qed
lemma generate_ρτ: "generate BIJ {ρ, τ} = S"
proof(standard; intro subsetI)
have inv_τ: "inv⇘BIJ⇙ τ = τ"
unfolding m_inv_def
proof(standard)
show "τ ∈ carrier BIJ ∧ τ ⊗⇘BIJ⇙ τ = 𝟭⇘BIJ⇙ ∧ τ ⊗⇘BIJ⇙ τ = 𝟭⇘BIJ⇙"
unfolding BIJ_def apply(intro conjI)
subgoal using bij_τ by simp
subgoal unfolding τ_def using nz_t by auto
subgoal unfolding τ_def using nz_t by auto
done
then show
"y ∈ carrier BIJ ∧ τ ⊗⇘BIJ⇙ y = 𝟭⇘BIJ⇙ ∧ y ⊗⇘BIJ⇙ τ = 𝟭⇘BIJ⇙ ⟹ y = τ"
for y
unfolding BIJ_def by (auto intro: left_right_inverse_eq)
qed
define ρ' :: "real × real ⇒ real × real" where "ρ' = (λz. (snd z, -fst z))"
have bij_ρ': "bij ρ'"
unfolding bij_def inj_def surj_def ρ'_def
by simp (metis add.inverse_inverse)
have inv_ρ: "inv⇘BIJ⇙ ρ = ρ'"
unfolding m_inv_def
proof(standard)
show "ρ' ∈ carrier BIJ ∧ ρ ⊗⇘BIJ⇙ ρ' = 𝟭⇘BIJ⇙ ∧ ρ' ⊗⇘BIJ⇙ ρ = 𝟭⇘BIJ⇙"
unfolding BIJ_def apply(intro conjI)
subgoal using bij_ρ' by auto
subgoal unfolding ρ_def ρ'_def by auto
subgoal unfolding ρ_def ρ'_def by auto
done
then show
"y ∈ carrier BIJ ∧ ρ ⊗⇘BIJ⇙ y = 𝟭⇘BIJ⇙ ∧ y ⊗⇘BIJ⇙ ρ = 𝟭⇘BIJ⇙ ⟹ y = ρ'"
for y
unfolding BIJ_def by (auto intro: left_right_inverse_eq)
qed
have ττ: "τ ⊗⇘BIJ⇙ τ = 𝟭⇘BIJ⇙"
unfolding BIJ_def τ_def comp_def by (auto simp: nz_t)
show "x ∈ generate BIJ {ρ, τ} ⟹ x ∈ S" for x
apply(induction rule: generate.induct)
subgoal unfolding BIJ_def S_def by auto
subgoal unfolding BIJ_def S_def ρ_def τ_def by auto
subgoal
unfolding Set.insert_iff apply(elim disjE)
subgoal using inv_ρ unfolding BIJ_def S_def ρ_def ρ'_def by simp
subgoal using inv_τ unfolding BIJ_def S_def τ_def by simp
subgoal by simp
done
subgoal unfolding BIJ_def by (metis monoid.select_convs(1) comp_S)
done
show "x ∈ S ⟹ x ∈ generate BIJ {ρ, τ}" for x
unfolding S_def Set.insert_iff
proof(elim disjE; clarsimp)
show "id ∈ generate BIJ {ρ, τ}"
unfolding BIJ_def using generate.simps by fastforce
show ρ_gen: "(λz. (- snd z, fst z)) ∈ generate BIJ {ρ, τ}"
by (fold ρ_def, rule generate.simps[THEN iffD2]) simp
show τ_gen: "(λz. (1 / (t * fst z), 1 / (t * snd z))) ∈ generate BIJ {ρ, τ}"
by (fold τ_def) (simp add: generate.incl)
from inv_ρ show inv_ρ_gen: "(λz. (snd z, - fst z)) ∈ generate BIJ {ρ, τ}"
by (fold ρ'_def) (auto simp: generate.inv insertI1)
show ρρ_gen: "(λz. (- fst z, - snd z)) ∈ generate BIJ {ρ, τ}"
proof-
have ρρ: "(λz. (- fst z, - snd z)) = ρ ⊗⇘BIJ⇙ ρ"
unfolding ρ_def BIJ_def by auto
show ?thesis
apply(rule generate.simps[THEN iffD2])
using ρρ ρ_gen[folded ρ_def] by auto
qed
show "(λz. (- (1 / (t * snd z)), 1 / (t * fst z))) ∈ generate BIJ {ρ, τ}"
proof-
have ρτ: "(λz. (- (1 / (t * snd z)), 1 / (t * fst z))) = ρ ⊗⇘BIJ⇙ τ"
unfolding ρ_def τ_def BIJ_def by auto
show ?thesis
apply(rule generate.simps[THEN iffD2])
using ρτ ρ_gen[folded ρ_def] τ_gen[folded τ_def] by auto
qed
show
"(λz. (- (1 / (t * fst z)), - (1 / (t * snd z)))) ∈ generate BIJ {ρ, τ}"
proof-
have ρρτ:
"(λz. (- (1 / (t * fst z)), - (1 / (t * snd z)))) =
(λz. (- fst z, - snd z)) ⊗⇘BIJ⇙ τ"
unfolding τ_def BIJ_def by auto
show ?thesis
apply(rule generate.simps[THEN iffD2])
using ρρτ ρρ_gen τ_gen[folded τ_def] by auto
qed
show "(λz. (1 / (t * snd z), - (1 / (t * fst z)))) ∈ generate BIJ {ρ, τ}"
proof-
have inv_ρ_τ:
"(λz. (1 / (t * snd z), - (1 / (t * fst z)))) =
(λz. (snd z, - fst z)) ⊗⇘BIJ⇙ τ"
unfolding τ_def BIJ_def by auto
show ?thesis
apply(rule generate.simps[THEN iffD2])
using inv_ρ_τ inv_ρ_gen τ_gen[folded τ_def] by auto
qed
qed
qed
lemma "comm_group (BIJ⦇carrier := (generate BIJ {ρ, τ})⦈)"
proof-
have ρτ_ss_BIJ: "{ρ, τ} ⊆ carrier BIJ"
using bij_ρ bij_τ unfolding BIJ_def by simp
interpret ρτ_sg: subgroup "(generate BIJ {ρ, τ})" BIJ
using ρτ_ss_BIJ by (rule bij.generate_is_subgroup)
interpret ρτ_g: group "BIJ⦇carrier := (generate BIJ {ρ, τ})⦈"
by (rule ρτ_sg.subgroup_is_group[OF bij.group_axioms])
have car_S: "carrier (BIJ⦇carrier := S⦈) = S" by simp
have BIJ_comp: "x ⊗⇘BIJ⦇carrier := S⦈⇙ y = x ∘ y" for x y
unfolding BIJ_def by auto
from ρτ_g.group_comm_groupI[
unfolded generate_ρτ car_S BIJ_comp, OF comm_S, simplified
]
show ?thesis unfolding generate_ρτ by assumption
qed
lemma id_pair_def: "(λx. x) = (λz. (fst z, snd z))" by simp
lemma distinct_single: "distinct [x] = True" by simp
lemma ne_ff'_gg'_imp_ne_fgf'g':
assumes "f ≠ f' ∨ g ≠ g'"
shows
"(λz. (f (fst z) (snd z), g (fst z) (snd z))) ≠
(λz. (f' (fst z) (snd z), g' (fst z) (snd z)))"
using assms
proof(rule disjE)
assume "f ≠ f'"
then obtain x y where "f x y ≠ f' x y" by blast
then show ?thesis by (metis (hide_lams) fst_eqD snd_eqD)
next
assume "g ≠ g'"
then obtain x y where "g x y ≠ g' x y" by blast
then show ?thesis by (metis (hide_lams) fst_eqD snd_eqD)
qed
lemma id_ne_hyp: "(λa. a) ≠ (λa. 1/(t*a))"
proof(rule ccontr, simp)
assume id_eq_hyp: "(λa. a) = (λa. 1/(t*a))"
{
fix a :: real assume "a > 0"
define b where "b = sqrt(a)"
from ‹a > 0› have "a = b*b" and "b > 0" unfolding b_def by auto
from id_eq_hyp have "b = 1/(t*b)" by metis
with ‹b > 0› have "b div b =(1/(t*b)) div b" by simp
with ‹b > 0› have "1 = (1/(t*a))" unfolding ‹a = b*b› by simp
with ‹a > 0› nz_t have "t*a = 1" by simp
}
note ta_eq_one = this
define t2 where "t2 = (if t > 0 then 2/t else -2/t)"
with nz_t have "t2 > 0" unfolding t2_def by auto
from nz_t have "t*t2 = 2 ∨ t*t2 = -2" unfolding t2_def by auto
from ta_eq_one ‹t2 > 0› this show False by auto
qed
lemma id_ne_mhyp: "(λa. a) ≠ (λa. -1/(t*a))"
proof(rule ccontr, simp)
assume id_eq_hyp: "(λa. a) = (λa. -(1/(t*a)))"
{
fix a :: real assume "a > 0"
define b where "b = sqrt(a)"
from ‹a > 0› have "a = b*b" and "b > 0" unfolding b_def by auto
from id_eq_hyp have "b = -(1/(t*b))" by metis
with ‹b > 0› have "b div b =-1/(t*b) div b" by simp
with ‹b > 0› have "1 = -1/(t*a)" unfolding ‹a = b*b› by simp
with ‹a > 0› nz_t have "t*a = -1" by (metis divide_eq_1_iff)
}
note ta_eq_one = this
define t2 where "t2 = (if t > 0 then 2/t else -2/t)"
with nz_t have "t2 > 0" unfolding t2_def by auto
from nz_t have "t*t2 = 2 ∨ t*t2 = -2" unfolding t2_def by auto
from ta_eq_one ‹t2 > 0› this show False by auto
qed
lemma mid_ne_hyp: "(λa. -a) ≠ (λa. 1 / (t*a))"
using id_ne_mhyp by (metis minus_divide_left minus_equation_iff)
lemma mid_ne_mhyp: "(λa. -a) ≠ (λa. -1 / (t*a))"
using id_ne_hyp by (metis divide_minus_left minus_equation_iff)
lemma hyp_neq_hyp_1: "(λa. - 1/(t*a)) ≠ (λa. 1/(t*a))"
using nz_t
by (metis divide_cancel_right id_ne_mhyp mult_cancel_right1 mult_left_cancel
one_neq_neg_one)
lemma distinct:
"distinct
[
id,
(λz. (-snd z, fst z)),
(λz. (-fst z, -snd z)),
(λz. (snd z, -fst z)),
(λz. (1/(t*fst z), 1/(t*snd z))),
(λz. (-1/(t*snd z), 1/(t*fst z))),
(λz. (-1/(t*fst z), -1/(t*snd z))),
(λz. (1/(t*snd z), -1/(t*fst z)))
]"
apply(unfold distinct_length_2_or_more)+
unfolding
distinct_length_2_or_more
distinct_single
id_def id_pair_def
HOL.simp_thms(21)
by
(intro conjI)
(
rule ne_ff'_gg'_imp_ne_fgf'g',
metis one_neq_neg_one id_ne_hyp id_ne_mhyp
mid_ne_hyp mid_ne_mhyp hyp_neq_hyp_1
)+
lemma "card S = 8"
using distinct unfolding S_def using card_empty card_insert_disjoint by auto
end
end
Remarks
I relied on sledgehammer for many parts of the proofs and there is some unnecessary code duplication. Therefore, just like most of my answers on SO, this answer is far from perfect from the perspective of the coding style.
I would be interested to know if there is a better overall approach for the solution. Somehow, I came to believe that most of the more thoughtful approaches (e.g. using theorems about cyclic groups to determine the order of ρ and τ and then using |HK|=|H||K|/|H∩K| to determine the order of G) would require proving quite a number of additional theorems for HOL-Algebra, but I did not check with the AFP before making this remark and I do not use HOL-Algebra on a regular basis. Therefore, I may have missed something.
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.