In Isabelle HOL, I have a predicate on two numbers like this:
definition f :: "nat ⇒ nat ⇒ bool"
where
...
I can prove that this predicate is morally a function:
lemma f_function:
fixes x :: nat
shows "∃! y . f x y""
...
Intuitively, this should be enough for me to construct a function f' :: nat ⇒ nat that is provably equivalent to f', i.e.:
lemma f'_correct:
"f x y = (f' x = y)"
But how do I do that?
definition f' :: "nat ⇒ nat"
where
"f' x ≡ ?"
What do I put in for the question mark?
The typical approach is to use the definite description operator THE:
definition f' :: "nat ⇒ nat" where "f' x = (THE y. f x y)"
If you have already proven that this y is unique, you can then use e.g. the theorem theI' to show that f x (f' x) holds and theI_unique to show that if f x y holds, then y = f' x.
For more information about THE, SOME, etc. see the following:
Isabelle/HOL: What does the THE construct denote?
Proving intuitive statements about THE in Isabelle
Related
I have following simple Isabelle/HOL theory:
theory Max_Of_Two_Integers_Real
imports Main
"HOL-Library.Multiset"
"HOL-Library.Code_Target_Numeral"
"HOL-Library.Code_Target_Nat"
"HOL-Library.Code_Abstract_Nat"
begin
definition two_integer_max_case_def :: "nat ⇒ nat ⇒ nat" where
"two_integer_max_case_def a b = (case a > b of True ⇒ a | False ⇒ b)"
lemma spec_final:
fixes a :: nat and b :: nat
assumes "a > b" (* and "b < a" *)
shows "two_integer_max_case_def a b = a"
using assms by (simp add: two_integer_max_case_def_def)
lemma spec_1:
fixes a :: nat and b :: nat
shows "a > b ⟹ two_integer_max_case_def a b = a"
by (simp add: two_integer_max_case_def_def)
lemma spec_2:
shows " (a ∈ nat set) ∧ (b ∈ nat set) ∧ (a > b) ⟹ two_integer_max_case_def a b = a"
by (simp add: two_integer_max_case_def_def)
end
Three lemmas try to express and prove that same statement, but progressively I am trying to move information from assumes and fixes towards the term. First 2 lemmas are correct, but the third (last) lemma is failing syntactically with the error message:
Type unification failed: Clash of types "_ ⇒ _" and "int"
Type error in application: incompatible operand type
Operator: nat :: int ⇒ nat
Operand: set :: ??'a list ⇒ ??'a set
My aim in this lemma is to move type information from the fixes towards the term/statement? How I make statements about the type of variable in the term (of inner syntax)?
Maybe I should use, if I am trying to avoid fixes clause (in which the variables may be declared), the full ForAll expression like:
lemma spec_final_3:
shows "∀ a :: nat . ∀ b :: nat . ( (a > b) ⟹ two_integer_max_case_def a b = a)"
by (simp add: two_integer_max_case_def_def)
But it is failing syntactically as well with the error message:
Inner syntax error: unexpected end of input⌂
Failed to parse prop
So - is it possible to include type statements in the term directly (without fixes clause) and is there any difference between fixes clause and type statement in the term? Maybe such differences start to appear during (semi)automatic proofs, e.g., when simplification tactics are applied or some other tactics?
nat set is interpreted as a function (that does not type correctly). The set of natural numbers can be expressed as UNIV :: nat set. Then, spec_2 reads
lemma spec_2:
shows "a ∈ (UNIV :: nat set) ∧ b ∈ (UNIV :: nat set) ∧ a > b ⟹
two_integer_max_case_def a b = a"
by (simp add: two_integer_max_case_def_def)
However, more natural way would be to include the type information in spec_1 without fixes clause:
lemma spec_1':
shows "(a :: nat) > (b :: nat) ⟹ two_integer_max_case_def a b = a"
by (simp add: two_integer_max_case_def_def)
∀ belongs to HOL, so the HOL implication should be used in spec_final_3:
lemma spec_final_3:
shows "∀ a :: nat. ∀ b :: nat. a > b ⟶ two_integer_max_case_def a b = a"
by (simp add: two_integer_max_case_def_def)
spec_1 can also be rewritten using an explicit meta-logic qualification (and implication) to look similar to spec_final_3:
lemma spec_1'':
shows "⋀ a :: nat. ⋀ b :: nat. a > b ⟹ two_integer_max_case_def a b = a"
by (simp add: two_integer_max_case_def_def)
I am trying to define in a Isabelle theory the property of right cancellation for function composition but
there are some errors that I can't to fix.
The definition I would like specify in Isabelle is the following:
f : A → B has the property of right cancellation iff
∀ C : (∀ g, h : B → C ) : g ◦ f = h ◦ f =⇒ g = h
Is it possible? Or more precisely, is it possible to quantify over a type?
Thanks in advance
It's not possible to explicitly quantify over types. If you prove a lemma with a type variable, it is implicitly proved for all instantiations of the type.
In some cases you can use a workaround and use the type V from the AFP entry ZFC_in_HOL. This type V basically is a type with so many elements that there is an injective function from (almost?) every HOL type into V. So in some cases it can be used as a kind of dynamic type to escape the type system.
theory ...
imports "ZFC_in_HOL.ZFC_Typeclasses"
begin
definition right_cancellation :: "('a ⇒ 'b) ⇒ bool" where
"right_cancellation f ≡ (∀g h :: 'b ⇒ V. g ∘ f = h ∘ f ⟶ g = h)"
In this case it is also possible to show that the definition is independent of the type used, so you might just use bool:
definition right_cancellation :: "'c itself ⇒ ('a ⇒ 'b) ⇒ bool" where
"right_cancellation t f ≡ (∀ g h :: 'b ⇒ 'c. g ∘ f = h ∘ f ⟶ g = h)"
lemma
fixes f:: "'x ⇒ 'y"
assumes as: "a1 ≠ (a2::'a)"
and r: "right_cancellation (A::'a itself) f"
shows "right_cancellation (B::'b itself) f"
I'm working on a theory that requires usage of rings, so I imported the following theories: https://www.isa-afp.org/browser_info/devel/AFP/Group-Ring-Module/
Right now, I have defined a set X of a certain type and I'd like to define operations on it to make it a ring, as in the locale "Ring" of the imported theory.
How do I define a ring with carrier X and have it recognized as an instance of the locale "Ring"?
The locale "Ring" is declared by extending "aGroup", which in turn is declared by extending "Group", which is in the theory "Algebra2.thy":
record 'a Group = "'a carrier" +
top :: "['a, 'a ] ⇒ 'a" (infixl "⋅ı" 70)
iop :: "'a ⇒ 'a" ("ρı _" [81] 80)
one :: "'a" ("𝟭ı")
locale Group =
fixes G (structure)
assumes top_closed: "top G ∈ carrier G → carrier G → carrier G"
and tassoc : "⟦a ∈ carrier G; b ∈ carrier G; c ∈ carrier G⟧ ⟹
(a ⋅ b) ⋅ c = a ⋅ (b ⋅ c)"
and iop_closed:"iop G ∈ carrier G → carrier G"
and l_i :"a ∈ carrier G ⟹ (ρ a) ⋅ a = 𝟭"
and unit_closed: "𝟭 ∈ carrier G"
and l_unit:"a ∈ carrier G ⟹ 𝟭 ⋅ a = a"
Another possible problem I antecipate: if I'm not mistaken, the carrier must be of type 'a set, but my set X is of type ('a set \times 'a) set set. Is there a workaround?
EDIT: In order to better formulate the sequential question in the comments, here are some pieces of what I did. All that follows is within the context of a locale presheaf, that fixes (among other things):
T :: 'a set set and
objectsmap :: "'a set ⇒ ('a, 'm) Ring_scheme" and
restrictionsmap:: "('a set ×'a set) ⇒ ('a ⇒ 'a)"
I then introduced the following:
definition prestalk :: "'a ⇒('a set × 'a) set" where
"prestalk x = { (U,s). (U ∈ T) ∧ x ∈U ∧ (s ∈ carrier (objectsmap U))}"
definition stalkrel :: "'a ⇒ ( ('a set × 'a) × ('a set × 'a) ) set" where
"stalkrel x = {( (U,s), (V,t) ). (U,s) ∈ prestalk x ∧ (V,t) ∈ prestalk x ∧ (∃W. W ⊆ U∩V ∧ x∈W ∧
restrictionsmap (V,W) t = restrictionsmap (U,W)) s} "
I then proved that for each x, stalkrel x is an equivalence relation, and defined:
definition germ:: "'a ⇒ 'a set ⇒ 'a ⇒ ('a set × 'a) set" where
"germ x U s = {(V,t). ((U,s),(V,t)) ∈ stalkrel x}"
definition stalk:: "'a ⇒( ('a set × 'a) set) set" where
"stalk x = {w. (∃ U s. w = germ x U s ∧ (U,s) ∈ prestalk x) }"
I'm trying to show that for each x this stalk x is a ring, and the ring operation is "built" out of the ring operations of rings objectsmap (U∩V) , i.e, I'd like germ x U s + germ x V t to be germ x (U∩V) (restrictionsmap (U, (U∩V)) s + restrictionsmap (V, (U∩V)) t), where this last sum is the sum of ring objectsmap (U∩V).
A multiplicative Group in the AFP entry mentioned is a record with four fields: a set carrier for the carrier, the binary group operation top, the inverse operation iop and the neutral element one. Similarly, a Ring is a record which extends an additive group (record aGroup with fields carrier, pop, mop, zero) with the binary multiplicative operation tp and the multiplicative unit un. If you want to define an instance of a group or record, you must define something of the appropriate record type. For example,
definition my_ring :: "<el> Ring" where
"my_ring =
(|carrier = <c>,
pop = <plus>,
mop = <minus>,
zero = <0>,
tp = <times>,
un = <unit>|)"
where you have to replace all the <...> by the types and terms for your ring. That is, <el> is the type of the ring elements, <c> is the carrier set, etc. Note that you can specialise the type of ring elements as needed.
In order to prove that my_ring is indeed a ring, you must show that it satisfies the assumptions of the corresponding locale Ring:
lemma "Ring my_ring"
proof unfold_locales
...
qed
If you want to use the theorems that have been proven abstractly for arbitrary rings, you may want to interpret the locale using interpretation.
What is the easiest way to generate code for a sorting algorithm that sorts its argument in reverse order, while building on top of the existing List.sort?
I came up with two solutions that are shown below in my answer. But both of them are not really satisfactory.
Any other ideas how this could be done?
I came up with two possible solutions. But both have (severe) drawbacks. (I would have liked to obtain the result almost automatically.)
Introduce a Haskell-style newtype. E.g., if we wanted to sort lists of nats, something like
datatype 'a new = New (old : 'a)
instantiation new :: (linorder) linorder
begin
definition "less_eq_new x y ⟷ old x ≥ old y"
definition "less_new x y ⟷ old x > old y"
instance by (default, case_tac [!] x) (auto simp: less_eq_new_def less_new_def)
end
At this point
value [code] "sort_key New [0::nat, 1, 0, 0, 1, 2]"
yields the desired reverse sorting. While this is comparatively easy, it is not as automatic as I would like the solution to be and in addition has a small runtime overhead (since Isabelle doesn't have Haskell's newtype).
Via a locale for the dual of a linear order. First we more or less copy the existing code for insertion sort (but instead of relying on a type class, we make the parameter that represents the comparison explicit).
fun insort_by_key :: "('b ⇒ 'b ⇒ bool) ⇒ ('a ⇒ 'b) ⇒ 'a ⇒ 'a list ⇒ 'a list"
where
"insort_by_key P f x [] = [x]"
| "insort_by_key P f x (y # ys) =
(if P (f x) (f y) then x # y # ys else y # insort_by_key P f x ys)"
definition "revsort_key f xs = foldr (insort_by_key (op ≥) f) xs []"
at this point we have code for revsort_key.
value [code] "revsort_key id [0::nat, 1, 0, 0, 1, 2]"
but we also want all the nice results that have already been proved in the linorder locale (that derives from the linorder class). To this end, we introduce the dual of a linear order and use a "mixin" (not sure if I'm using the correct naming here) to replace all occurrences of linorder.sort_key (which does not allow for code generation) by our new "code constant" revsort_key.
interpretation dual_linorder!: linorder "op ≥ :: 'a::linorder ⇒ 'a ⇒ bool" "op >"
where
"linorder.sort_key (op ≥ :: 'a ⇒ 'a ⇒ bool) f xs = revsort_key f xs"
proof -
show "class.linorder (op ≥ :: 'a ⇒ 'a ⇒ bool) (op >)" by (rule dual_linorder)
then interpret rev_order: linorder "op ≥ :: 'a ⇒ 'a ⇒ bool" "op >" .
have "rev_order.insort_key f = insort_by_key (op ≥) f"
by (intro ext) (induct_tac xa; simp)
then show "rev_order.sort_key f xs = revsort_key f xs"
by (simp add: rev_order.sort_key_def revsort_key_def)
qed
While with this solution we do not have any runtime penalty, it is far too verbose for my taste and is not easily adaptable to changes in the standard code setup (e.g., if we wanted to use the mergesort implementation from the Archive of Formal Proofs for all of our sorting operations).
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