I find myself often wanting to write expressions of this form
let x = SOME x. x ∈ e1
in e2
that is; let x be an arbitary member of e1 in e2. It's rather verbose, and it seems a bit odd having to bind x twice. Is there a neater way to express this?
There is a simpler solution than copying the setup for let from HOL, namely, to extend the existing syntax translation for let by giving another production for letbind.
abbreviation Let_SOME :: "'a set => ('a => 'b) => 'b"
where "Let_SOME s f == let x = SOME x. x ∈ s in f x"
syntax
"_bindSOME" :: "[pttrn, 'a] => letbind" ("(2_ ∈/ _)" 10)
translations
"let x ∈ a in e" == "CONST Let_SOME a (%x. e)"
This has the advantage over your stand-alone solution that you can mix conventional let bindings with the new ones, as in
term "let x = 5; y ∈ {1,2}; z = 6 in x + y + z"
I examined the way the let x = e1 in e2 syntax is handled (http://isabelle.in.tum.de/library/HOL/HOL/HOL.html), and found I could mostly duplicate that mechanism to provide a new let x ∈ e1 in e2 syntax. Here is my code (I just renamed let to lett throughout):
nonterminal lettbinds and lettbind
syntax
"_bind" :: "[pttrn, 'a] => lettbind" ("(2_ ∈/ _)" 10)
"" :: "lettbind => lettbinds" ("_")
"_binds" :: "[lettbind, lettbinds] => lettbinds" ("_;/ _")
"_Lett" :: "[lettbinds, 'a] => 'a" ("(let (_)/ in (_))" [0, 10] 10)
definition Lett :: "'a set ⇒ ('a ⇒ 'b) ⇒ 'b"
where "Lett s f ≡ let x = SOME x. x ∈ s in f x"
translations
"_Lett (_binds b bs) e" == "_Lett b (_Lett bs e)"
"let x ∈ a in e" == "CONST Lett a (λx. e)"
As a quick test:
value "let x ∈ {2::int,3} in x+x"
Related
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
Here's a small theorem in mathematics:
Suppose u is not an element of A, and v is not an element of B, and f is an injective function from A to B. Let A' = A union {u} and B' = B union {v}, and define g: A' -> B' by g(x) = f(x) if x is in A, and g(u) = v. Then g is injective as well.
If I were writing OCaml-like code, I'd represent A and B as types, and f as an A->B function, something like
module type Q =
sig
type 'a
type 'b
val f: 'a -> 'b
end
and then define a functor
module Extend (M : Q) : Q =
struct
type a = OrdinaryA of M.a | ExoticA
type b = OrdinaryB of M.b | ExoticB
let f x = match x with
OrdinaryA t -> OrdinaryB ( M.f t)
| Exotic A -> ExoticB
end;;
and my theorem would be that if Q.f is injective, then so is (Extend Q).f, where I'm hoping I've gotten the syntax more or less correct.
I'd like to do the same thing in Isabelle/Isar. Normally, that'd mean writing something like
definition injective :: "('a ⇒ 'b) ⇒ bool"
where "injective f ⟷ ( ∀ P Q. (f(P) = f(Q)) ⟷ (P = Q))"
proposition: "injective f ⟹ injective (Q(f))"
and Q is ... something. I don't know how to make, in Isabelle a single operation analogous to the functor Q in OCaml that creates two new datatypes and a function between them. The proof of injectivity seems as if it'd be fairly straightforward --- merely a four-case split. But I'd like help defining the new function that I've called Q f, given the function f.
Here's a solution. I tried to make a "definition" for the function Q, but could not do so; instead, creating a constant Q (built in strong analogy to map) let me state and prove the theorem:
theory Extensions
imports Main
begin
text ‹We show that if we have f: 'a → 'b that's injective, and we extend
both the domain and codomain types by a new element, and extend f in the
obvious way, then the resulting function is still injective.›
definition injective :: "('a ⇒ 'b) ⇒ bool"
where "injective f ⟷ ( ∀ P Q. (f(P) = f(Q)) ⟷ (P = Q))"
datatype 'a extension = Ordinary 'a | Exotic
fun Q :: "('a ⇒ 'b) ⇒ (('a extension) ⇒ ('b extension))" where
"Q f (Ordinary u) = Ordinary (f u)" |
"Q f (Exotic) = Exotic"
lemma "⟦injective f⟧ ⟹ injective (Q f)"
by (smt Q.elims extension.distinct(1) extension.inject injective_def)
end
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).
Single valued relations (as defined by single_valued in the Relation theory) allow to deduce equalities from membership relations. I was wondering if there was a way to take advantage of this to rewrite terms in the goal (and then merge these membership relations).
As an example, here is a goal that cannot be solved by auto or force without auxiliary theorems:
lemma
assumes "single_valued A"
assumes "(a,b) ∈ A" and "(a,b') ∈ A"
shows "b = b'"
using assms
by (metis single_valued_def)
Here the equality is directly in the goal, but it would be great to also rewrite in the assumptions.
Also, I talk here about sets of pairs but I have a more complex application with another kind of relation with a similar property, where such kind of assumptions are common, and I am then looking for a way to simplify them.
It seems to me that automatic methods could greatly benefit from such a feature.
I have already written some simprocs before and it seems to me we could use them here if we could access the set of assumptions once the simproc has been triggered on, which I don't know if this is possible. For example, once "(a,b) ∈ A" has triggered the simproc, could we check if any assumption contains "(a,_) ∈ A" ? But it would perhaps be too costly...
Any idea ?
Here is a simproc that does what you want:
lemma single_valuedD_eq:
"⟦ single_valued A; (x, a) ∈ A ⟧ ⟹ (x, b) ∈ A ⟷ b = a"
by(auto dest: single_valuedD)
simproc_setup single_valued ("(x, y) ∈ A") = {*
(fn phi => fn ctxt => fn redex => case term_of redex of
Const (#{const_name "Set.member"},
Type (#{type_name fun},
[Txy as Type (#{type_name prod}, [Tx, Ty]),
Type (#{type_name fun}, [TA, _])])) $
(Const (#{const_name "Pair"}, _) $ tx $ ty) $
tA =>
let
val thy = Proof_Context.theory_of ctxt;
val prems = Simplifier.prems_of ctxt;
fun mk_stmt t = t |> HOLogic.mk_Trueprop |> Thm.cterm_of thy |> Goal.init
fun mk_thm tac t =
case SINGLE (tac 1) (mk_stmt t) of
SOME thm => SOME (Goal.finish (Syntax.init_pretty_global (Thm.theory_of_thm thm)) thm)
| NONE => NONE;
val svA = Const (#{const_name single_valued}, TA --> #{typ bool}) $ tA
val [z] = Name.invent (Variable.names_of ctxt) "z" 1
val xzA =
Const (#{const_name Set.member}, Txy --> TA --> #{typ bool})
$ (Const (#{const_name Pair}, Tx --> Ty --> Txy)
$ tx $ Var ((z, 0), Ty))
$ tA
in
case mk_thm (resolve_tac prems) svA of NONE => NONE
| SOME thm_svA => case mk_thm (resolve_tac prems) xzA of NONE => NONE
| SOME thm_xzA =>
SOME (#{thm single_valuedD_eq[THEN eq_reflection]} OF [thm_svA, thm_xzA])
end
| _ => NONE)
*}
When it triggers on a term of the pattern (_, _) ∈ _, say (x, y) ∈ A, it checks whether there are assumptions single_valued A and (x, ?z) ∈ A in the current goal. If so, it instantiates the theorem single_valuedD_eq with them and rewrites (x, y) ∈ A to y = ?z with ?z being appropriate instantiated.
Here is an example:
lemma
"⟦ single_valued A; (x, b) ∈ A; (x, c) ∈ A ⟧
⟹ map (λy. (x, y) ∈ A) xs = foo"
apply simp
NEW GOAL:
1. ⟦single_valued A; b = c; (x, c) ∈ A⟧ ⟹ map (λy. y = c) xs = foo
Note that single_valued A has to be an assumption of the goal. It does not suffice to have single_valued A as a [simp] rule somewhere. This is because the assumptions are looked up with resolve_tac prems rather than a full simplifier invocation.