Why is my simproc not activated on the prescribed pattern? - isabelle

I'm writing a simproc for sine simplifications. Here is an example rewriting sin(x+8pi+pi/2) to cos(x):
lemma rewrite_sine_1:
fixes k' :: int and k :: real
assumes "k ≡ 2 * of_int k'"
shows "sin (x + k*pi + pi/2) ≡ cos (x)"
sorry
ML ‹
fun rewrite_sine ctxt ct =
let
val sum = ct |> Thm.term_of |> dest_comb |> snd
val x = sum |> dest_comb |> fst |> dest_comb |> snd
|> dest_comb |> fst |> dest_comb |> snd
val k = sum |> dest_comb |> fst |> dest_comb |> snd
|> dest_comb |> snd |> dest_comb |> fst
|> dest_comb |> snd |> dest_comb |> snd |> HOLogic.dest_numeral
val rk = SOME (Thm.cterm_of ctxt (HOLogic.mk_number HOLogic.realT k))
val ik2 = SOME (Thm.cterm_of ctxt (HOLogic.mk_number HOLogic.intT (k div 2)))
val cx = SOME( Thm.cterm_of ctxt x)
in
SOME (Thm.instantiate' [] [rk,ik2,cx] #{thm rewrite_sine_1})
end
›
ML ‹
rewrite_sine #{context} #{cterm "sin(x+8*pi+pi/2)"}
›
Up to here everything works but once I set up my simproc:
simproc_setup sine1 ("sin (x + 8 * pi + pi / 2)") = ‹K rewrite_sine›
(* this should be handled by sine1 only, but is not *)
lemma "sin (x + 8 * pi + pi / 2) = cos(x)"
apply simp
sorry
(* this should be handled by sine1 only, but is not *)
lemma "sin(x+8*pi+pi/2) = cos(x)"
apply(tactic ‹simp_tac (put_simpset HOL_basic_ss #{context} addsimprocs [#{simproc sine1}]) 1›)
sorry
I see that it is not really applying even with a basic simpset. Others simprocs is set-up did work, see here.

In the first example, your simproc is not called becaus simprocs (if I remember correctly) are only called after exhausting all ‘normal’ rewriting, and your goal is immediately rewritten to sin (17 * pi / 2 + x) = cos x. Since your simproc does not match that goal anymore, it is not called.
In the second example, your simproc is called (you can verify this by inserting e.g. a val _ = #{print} "foo" into your let block) and it indeed produces a rewrite rule. Unfortunately, this rewrite rule still has the precondition 8 ≡ 2 * real_of_int 4, which simp cannot solve with the very basic simplifier setup you are using, so it fails to apply the rule.
You can find out what's going on there using the simplifier trace:
lemma "sin(x+8*pi+pi/2) = cos(x)"
using [[simp_trace, simp_trace_depth_limit = 100]]
apply(tactic ‹simp_tac (put_simpset HOL_basic_ss #{context} addsimprocs [#{simproc sine1}]) 1›)
Output:
[0]Adding simplification procedure "Scratch.sine1" for
sin (?x + 8 * pi + pi / 2)
[0]Adding simplification procedure "Scratch.sine1" for
sin (?x + 8 * pi + pi / 2)
[1]SIMPLIFIER INVOKED ON THE FOLLOWING TERM:
sin (x + 8 * pi + pi / 2) = cos x
[1]Procedure "Scratch.sine1" produced rewrite rule:
8 ≡ 2 * real_of_int 4 ⟹
sin (x + 8 * pi + pi / 2) ≡ cos x
[1]Applying instance of rewrite rule
8 ≡ 2 * real_of_int 4 ⟹
sin (x + 8 * pi + pi / 2) ≡ cos x
[1]Trying to rewrite:
8 ≡ 2 * real_of_int 4 ⟹
sin (x + 8 * pi + pi / 2) ≡ cos x
[2]SIMPLIFIER INVOKED ON THE FOLLOWING TERM:
8 ≡ 2 * real_of_int 4
[1]FAILED
8 ≡ 2 * real_of_int 4 ⟹
sin (x + 8 * pi + pi / 2) ≡ cos x
[1]IGNORED result of simproc "Scratch.sine1" -- does not match
sin (x + 8 * pi + pi / 2)
If you add the rule 2 * real_of_int 4 ≡ 8 to your simpset, it works as intended.

Related

Reification for interpretation functions which use different interpretation functions below quantifiers/lambdas

I'm currently trying use Isabelle/HOL's reification tactic. I'm unable to use different interpretation functions below quantifiers/lambdas. The below MWE illustrates this. The important part is the definition of the form function, where the ter call occurs below the ∀. When trying to use the reify tactic I get an Cannot find the atoms equation error. I don't get this error for interpretation functions which only call themselves under quantifiers.
I can't really reformulate my problem to avoid this. Does anybody know how to get reify working for such cases?
theory MWE
imports
"HOL-Library.Reflection"
begin
datatype Ter = V nat | P Ter Ter
datatype Form = All0 Ter
fun ter :: "Ter ⇒ nat list ⇒ nat"
where "ter (V n) vs = vs ! n"
| "ter (P t1 t2) vs = ter t1 vs + ter t2 vs"
fun form :: "Form ⇒ nat list ⇒ bool"
where "form (All0 t) vs = (∀ v . ter t (v#vs) = 0)" (* use of different interpretation function below quantifier *)
(*
I would expect this to reify to:
form (All0 (P (V 0) (V 0))) []
instead I get an error :-(
*)
lemma "∀ n :: nat . n + n = 0"
apply (reify ter.simps form.simps)
(* proof (prove)
goal (1 subgoal):
1. ∀n. n + n = n + n
Cannot find the atoms equation *)
oops
(* As a side note: the following example in src/HOL/ex/Reflection_Examples.thy (line 448, Isabelle2022) seems to be broken? For me, the reify invocation
doesn't change the goal at all. It uses quantifiers too, but only calls the same interpretation function under quantifiers and also doesn't throw an error,
so at least for me this seems to be unrelated to my problem.
*)
(*
lemma " ∀x. ∃n. ((Suc n) * length (([(3::int) * x + f t * y - 9 + (- z)] # []) # xs) = length xs) ∧ m < 5*n - length (xs # [2,3,4,x*z + 8 - y]) ⟶ (∃p. ∀q. p ∧ q ⟶ r)"
apply (reify Irifm.simps Irnat_simps Irlist.simps Irint_simps)
oops
*)
end

How to make Isabelle use basic math rules?

I'm trying to learn Isabelle:
theory test
imports Main
begin
datatype tree = Leaf | Node tree tree
fun nodes :: "tree ⇒ nat" where
"nodes Leaf = 1"|
"nodes (Node x y) = 1 + (nodes x) + (nodes y)"
fun explode :: "nat ⇒ tree ⇒ tree" where
"explode 0 t = t" |
"explode (Suc n) t = explode n (Node t t)"
theorem tree_count: "nodes (explode h l) = 2^h + 2^h * (nodes l) - 1"
apply(induction h arbitrary: l)
apply(auto simp add: numeral_eq_Suc)
done
end
However, the theorem is not solved:
Failed to finish proof:
goal (1 subgoal):
1. ⋀h l. (⋀l. nodes (explode h l) = Suc (Suc 0) ^ h + Suc (Suc 0) ^ h * nodes l - Suc 0) ⟹
Suc (Suc 0) ^ h + (Suc (Suc 0) ^ h + Suc (Suc 0) ^ h * (nodes l + nodes l)) - Suc 0 =
Suc (Suc 0) ^ h + Suc (Suc 0) ^ h + (Suc (Suc 0) ^ h + Suc (Suc 0) ^ h) * nodes l - Suc 0
If I'm not mistaken, Isabelle is just not applying x + x = 2*x and a + (b + c) = a + b + c. So I tried adding a lemma to use it with simp:
lemma a: "(x:nat) + x = 2*x"
But this fails with
Type unification failed: Clash of types "_ ⇒ _" and "_ set"
Type error in application: incompatible operand type
Operator: (∈) x :: ??'a set ⇒ bool
Operand: nat :: int ⇒ nat
I assume that it's just not possible to define the type of a variable in a lemma?
Now I could of course redifine the addition - but I guess that's not really best practice.
What would be the best way to solve the initial problem?
Some general approaches to find the right lemmas:
Use the theorem search, either via the query panel or in the text with find_theorems:
find_theorems ‹_ * (_ + _)›
find_theorems name: assoc "_ + _ + _"
find_theorems ‹2 * ?z = ?z + ?z›
Use sledgehammer.
Try the algebra_simps collection as suggested by waldelb (There are also ac_simps, algebra_split_simps, field_simps, and field_split_simps ).
Try to split it up into smaller steps. This helps the simp tool, because simplification can work on both sides of the equation and because you can guide it to the right intermediate steps. The example below is a bit too extreme, doing only one rewrite per step. In general, you can just add intermediary steps where the automatic ones fail.
theorem tree_count: ‹nodes (explode h l) = 2^h + 2^h * (nodes l) - 1›
proof (induction h arbitrary: l)
case 0
show ‹nodes (explode 0 l) = 2 ^ 0 + 2 ^ 0 * nodes l - 1›
by simp
next
case (Suc h)
have ‹nodes (explode (Suc h) l)
= nodes (explode h (Node l l))›
by (subst explode.simps, rule refl)
also have "... = 2 ^ h + 2 ^ h * nodes (Node l l) - 1"
by (subst Suc, rule refl)
also have "... = 2 ^ h + 2 ^ h * (1 + nodes l + nodes l) - 1"
by (subst nodes.simps, rule refl)
also have "... = 2 ^ h + 2 ^ h * (1 + (nodes l + nodes l)) - 1"
by (subst add.assoc, rule refl)
also have "... = 2 ^ h + 2 ^ h * (1 + (2 * nodes l)) - 1"
by (subst mult_2, rule refl)
also have "... = 2 ^ h + (2 ^ h * 1 + 2 ^ h * (2 * nodes l)) - 1"
by (subst distrib_left, rule refl)
also have "... = 2 ^ h + (2 ^ h * 1 + 2 ^ h * 2 * nodes l) - 1"
by (subst mult.assoc, rule refl)
also have "... = 2 ^ h + (2 ^ h * 1 + 2 ^ Suc h * nodes l) - 1"
by (subst power_Suc2, rule refl)
also have "... = (2 ^ h + 2 ^ h * 1) + 2 ^ Suc h * nodes l - 1"
by (subst add.assoc, rule refl)
also have "... = (2 ^ h + 2 ^ h) + 2 ^ Suc h * nodes l - 1"
by (subst mult_1_right, rule refl)
also have "... = 2 ^ h * 2 + 2 ^ Suc h * nodes l - 1"
by (subst mult_2_right, rule refl)
also have "... = 2 ^ Suc h + 2 ^ Suc h * nodes l - 1"
by (subst power_Suc2, rule refl)
finally show ?case .
qed
algebra_simps is a list of common math rules. Adding it solves the problem:
apply(auto simp add: numeral_eq_Suc algebra_simps)

Quadratic Formula in Isabelle?

I'm looking for a theory file which contains the quadratic formula:
and of course it would be helpful to know the name of the lemma too.
I've already found this paper:
http://www.inf.ed.ac.uk/publications/thesis/online/IM040231.pdf
and I can copy-paste the proof in that, but then I'll have to rewrite it (because it doesn't copy perfectly). It would be better to have something that works straight away: maybe if someone knows where the theory file that matches this paper can be found?
The paper you linked is very old and the proofs from it will not work without major changes.
Here's a short and simple proof of the theorem:
theory Scratch
imports Complex_Main
begin
lemma real_sqrt_unique':
"(x::real) ^ 2 = y ⟹ x = -sqrt y ∨ x = sqrt y"
using real_sqrt_unique[of x y] real_sqrt_unique[of "-x" y]
by (cases "x ≥ 0") simp_all
lemma quadratic_roots_formula:
fixes a b c x :: real
assumes "a ≠ 0"
defines "disc ≡ b^2 - 4 * a * c"
assumes "disc ≥ 0"
shows "a * x^2 + b * x + c = 0 ⟷ x ∈ {(-b - sqrt disc) / (2*a), (-b + sqrt disc) / (2*a)}"
proof -
from assms have "a * x^2 + b * x + c = 0 ⟷ 4 * a * (a * x^2 + b * x + c) = 0"
by simp
also have "4 * a * (a * x^2 + b * x + c) = (2 * a * x + b) ^ 2 - b^2 + 4 * a * c"
by (simp add: algebra_simps power2_eq_square)
also have "… = 0 ⟷ (2 * a * x + b) ^ 2 = disc" by (simp add: disc_def algebra_simps)
also from ‹disc ≥ 0› have "… ⟷ (2 * a * x + b) ∈ {-sqrt disc, sqrt disc}"
by (auto simp: real_sqrt_unique')
also have "… ⟷ x ∈ {(-b - sqrt disc) / (2*a), (-b + sqrt disc) / (2*a)}"
using assms by (auto simp: field_simps)
finally show ?thesis .
qed

In isabelle, why is this simplification lemma not being substituted?

I'm working through the Isabelle "Programming and Proving" tutorial, and am coming to Ex2.10, where you have to arrive at an equation discribing the number of nodes in an "exploded" tree.
The approach I've taken to this is to create separate expressions for the internal and leaf nodes in the tree, and am working on a proof for the number of internal nodes in the tree, as such:
lemma dddq: " a>0 ⟶ (nodes_noleaf (explode a b) = (ptser (a - 1) (2::nat)) + ((2 ^ a) * (nodes_noleaf b)))"
apply(induction a)
apply(simp)
apply(simp add:eeei eeed eeej eeek )
and this leaves the proof state as the following:
goal (1 subgoal):
1. ⋀a. 0 < a ⟶ nodes_noleaf (explode a b) = ptser (a - Suc 0) 2 + 2 ^ a * nodes_noleaf b ⟹
Suc (2 * nodes_noleaf (explode a b)) = ptser a 2 + 2 * 2 ^ a * nodes_noleaf b
Now, I also created (and successfully proved) a lemma that should replace the ptser a 2 + 2 * 2 ^ a * nodes_noleaf b with (Suc (2 * ((ptser (a - Suc 0) 2) + 2 ^ a * nodes_noleaf b)))), as such:
lemma eeek: "∀ a b . a>0 ⟶ (((ptser a 2) + 2 * 2 ^ a * nodes_noleaf b) = (Suc (2 * ((ptser (a - Suc 0) 2) + 2 ^ a * nodes_noleaf b))))"
apply(auto)
apply(simp add: ddddd)
done
However, adding this to the list of simplifications for the dddq does nothing, and I don't see the reason why.
Additional definitions..
fun nodes_noleaf:: "tree0 ⇒ nat" where
"nodes_noleaf Tip = 0"|
"nodes_noleaf (Node a b) = (add 1 (add (nodes_noleaf a) (nodes_noleaf b)))"
fun explode:: "nat ⇒ tree0 ⇒ tree0" where
"explode 0 t = t" |
"explode (Suc n) t = explode n (Node t t)"
fun ptser:: "nat ⇒ nat ⇒ nat" where
"ptser 0 b = b^0" |
"ptser a b = b^a + (ptser (a - 1) b)"
Your lemma eeek is a conditional rewrite rule, because it can only be applied when the simplifier can prove that a > 0 holds. In your goal state, however, you do not have the assumption a > 0. The 0 < a is a precondition to the induction hypothesis (--> binds stronger than ==>), which is why simp does not apply the induction hypothesis either.
Since the question does not contain all the definitions of your goal, it is hard to pinpoint the exact reason. Nevertheless, I suggest to drop the assumption a > 0 from dddq and prove a stronger statement.
A comment on style: Try to use the connectives !! and ==> of the natural deduction framework rather than explicit universal quantifiers and -->. The simplifier knows how to convert them back into !! and ==>, but other proof methods do not do this automatically. Thus, using !! and ==> will save you boilerplate proof steps later on.

F# lazy recursion

I am have some problems with recursion in Lazy Computations. I need calculation the square root by Newton Raphson method. I do not know how to apply a lazy evaluation. This is my code:
let next x z = ((x + z / x) / 2.);
let rec iterate f x =
List.Cons(x, (iterate f (f x)));
let rec within eps list =
let a = float (List.head list);
let b = float (List.head (List.tail list));
let rest = (List.tail (List.tail (list)));
if (abs(a - b) <= eps * abs(b))
then b
else within eps (List.tail (list));
let lazySqrt a0 eps z =
within eps (iterate (next z) a0);
let result2 = lazySqrt 10. Eps fvalue;
printfn "lazy approach";
printfn "result: %f" result2;
Of course, stack overflow exception.
You're using F# lists which has eager evaluation. In your example, you need lazy evaluation and decomposing lists, so F# PowerPack's LazyList is appropriate to use:
let next z x = (x + z / x) / 2.
let rec iterate f x =
LazyList.consDelayed x (fun () -> iterate f (f x))
let rec within eps list =
match list with
| LazyList.Cons(a, LazyList.Cons(b, rest)) when abs(a - b) <= eps * abs(b) -> b
| LazyList.Cons(a, res) -> within eps res
| LazyList.Nil -> failwith "Unexpected pattern"
let lazySqrt a0 eps z =
within eps (iterate (next z) a0)
let result2 = lazySqrt 10. Eps fvalue
printfn "lazy approach"
printfn "result: %f" result2
Notice that I use pattern matching which is more idiomatic than head and tail.
If you don't mind a slightly different approach, Seq.unfold is natural here:
let next z x = (x + z / x) / 2.
let lazySqrt a0 eps z =
a0
|> Seq.unfold (fun a ->
let b = next z a
if abs(a - b) <= eps * abs(b) then None else Some(a, b))
|> Seq.fold (fun _ x -> x) a0
If you need lazy computations, then you have to use appropriate tools. List is not lazy, it is computed to the end. Your iterate function never ends, so the entire code stack overflows in this function.
You may use Seq here.
Note: Seq.skip almost inevitably leads you to an O(N^2) complexity.
let next N x = ((x + N / x) / 2.);
let rec iterate f x = seq {
yield x
yield! iterate f (f x)
}
let rec within eps list =
let a = Seq.head list
let b = list |> Seq.skip 1 |> Seq.head
if (abs(a - b) <= eps * abs(b))
then b
else list |> Seq.skip 1 |> within eps
let lazySqrt a0 eps z =
within eps (iterate (next z) a0);
let result2 = lazySqrt 10. 0.0001 42.;
printfn "lazy approach";
printfn "result: %f" result2;
// 6.4807406986501
Yet another approach is to use LazyList from F# PowerPack. The code is available in this article. Copying it to my answer for sake of integrity:
open Microsoft.FSharp.Collections.LazyList
let next N (x:float) = (x + N/x) / 2.0
let rec repeat f a =
LazyList.consDelayed a (fun() -> repeat f (f a))
let rec within (eps : float) = function
| LazyList.Cons(a, LazyList.Cons(b, rest)) when (abs (a - b)) <= eps -> b
| x -> within eps (LazyList.tail x)
let newton_square a0 eps N = within eps (repeat (next N) a0)
printfn "%A" (newton_square 16.0 0.001 16.0)
Some minor notes:
Your next function is wrong;
The meaning of eps is relative accuracy while in most academic books I've seen an absolute accuracy. The difference between the two is whether or not it's measured against b, here: <= eps * abs(b). The code from FPish treats eps as an absolute accuracy.

Resources