Here is a math exercise (taken from page 2 - in Russian):
There are 100 visually indistinguishable coins of three types: gold, silver and copper (each type occurs at least once). It is known that gold weighs 3 grams each, silver weighs 2 grams each, copper weighs 1 gram each. How can I determine the type of all coins in no more than 101 weighings on two-plate scales without weights?
(Note: I guess that the exercise is wrong and at most 102 weighings are required. However it doesn't matter)
The solution is as follows:
Take coins one by one from a list of coins and compare each coin with a previous one
If the coins have the same weight, then we assign them to one group and continue to weigh further
If we found a heavier coin cj than the previous one, then go to step 2
If we found a lighter coin ci than the previous one, then keep weighing coins trying to find a coin cj heavier than ci
If we found a lighter coin instead, then c0 > ci > cj and we know weights of these coins: 3 > 2 > 1. Go to step 3
Keep comparing coins
If we found a heavier coin ck than cj, then ci < cj < ck (and weights are 1 < 2 < 3)
If we found a lighter coin ck than cj, then compare ci and ck
If ci < ck, then weights of ci, cj, ck are 1, 3, 2
If ci > ck, then weights of ci, cj, ck are 2, 3, 1
If ci = ck, then compare ci + ck with cj
If ci + ck < cj, then weights of ci, cj, ck are 1, 3, 1 (in this case we don't have a sliver coin, so we will use two copper coins instead on steps 3 and 4)
If ci + ck > cj, then weights of ci, cj, ck are 2, 3, 2
If ci + ck = cj, then weights of ci, cj, ck are 1, 2, 1
Compare rest coins with the silver coin (or two copper coins)
Lighter coins are copper
Same coins are silver
Heavier coins are gold
If on step 1 we found a lighter coin first instead of a heavier one, then we need to compare first heavy coins with a silver coin to determine their weight (it could be a 102th weighing depending on a coin set)
Here is an example of a coin list:
c0 ci cj ck
3 3 2 2 2 3 3 1 1 2 1 3
|_| |___| |_|
i j k
Here is a solution in Isabelle HOL:
datatype coin = GC | SC | CC
datatype comp = LT | EQ | GT
primrec coin_weight :: "coin ⇒ nat" where
"coin_weight CC = 1"
| "coin_weight SC = 2"
| "coin_weight GC = 3"
primrec sum_list where
"sum_list f [] = 0"
| "sum_list f (x # xs) = f x + sum_list f xs"
definition weigh :: "coin list ⇒ coin list ⇒ comp" where
"weigh xs ys = (
let xw = sum_list coin_weight xs in
let yw = sum_list coin_weight ys in
if xw < yw then LT else
if xw > yw then GT else EQ)"
definition std_weigh :: "coin list ⇒ coin ⇒ nat" where
"std_weigh xs ys ≡ (case weigh xs [ys] of LT ⇒ 3 | GT ⇒ 1 | EQ ⇒ 2)"
definition gen_weights :: "coin list ⇒ coin ⇒ coin list ⇒ nat ⇒ nat ⇒ nat ⇒ nat ⇒ nat ⇒ nat ⇒ nat list" where
"gen_weights cs c⇩0 std i j k w⇩j w⇩k w ≡
― ‹Optional heavy coins (\<^term>‹c⇩0›...)›
replicate i (std_weigh std c⇩0) #
― ‹Light coins (\<^term>‹c⇩i›...)›
replicate j w⇩j #
― ‹Heavy coins (\<^term>‹c⇩j›...)›
replicate k w⇩k #
― ‹A light coin (\<^term>‹c⇩k›)›
[w] #
― ‹Rest coins›
map (std_weigh std) cs"
primrec determine_weights where
"determine_weights [] c⇩0 c⇩i c⇩j i j k = None"
| "determine_weights (c⇩k # cs) c⇩0 c⇩i c⇩j i j k = (
case weigh [c⇩j] [c⇩k]
of LT ⇒ Some (gen_weights cs c⇩0 [c⇩j] i j (Suc k) 1 2 3)
| GT ⇒ Some (
case weigh [c⇩i] [c⇩k]
of LT ⇒ gen_weights cs c⇩0 [c⇩k] i j (Suc k) 1 3 2
| GT ⇒ gen_weights cs c⇩0 [c⇩i] i j (Suc k) 2 3 1
| EQ ⇒ (
case weigh [c⇩i, c⇩k] [c⇩j]
of LT ⇒ gen_weights cs c⇩0 [c⇩i, c⇩k] i j (Suc k) 1 3 1
| GT ⇒ gen_weights cs c⇩0 [c⇩k] i j (Suc k) 2 3 2
| EQ ⇒ gen_weights cs c⇩0 [c⇩j] i j (Suc k) 1 2 1))
| EQ ⇒ determine_weights cs c⇩0 c⇩i c⇩j i j (Suc k))"
primrec find_heavier where
"find_heavier [] c⇩0 c⇩i i j alt = None"
| "find_heavier (c⇩j # cs) c⇩0 c⇩i i j alt = (
case weigh [c⇩i] [c⇩j]
of LT ⇒ determine_weights cs c⇩0 c⇩i c⇩j i (Suc j) 0
| GT ⇒ alt cs c⇩j (Suc j)
| EQ ⇒ find_heavier cs c⇩0 c⇩i i (Suc j) alt)"
primrec weigh_coins where
"weigh_coins [] = Some []"
| "weigh_coins (c⇩0 # cs) =
find_heavier cs c⇩0 c⇩0 0 0
(λcs c⇩i i. find_heavier cs c⇩0 c⇩i i 0
(λcs c⇩j j. Some (gen_weights cs c⇩0 [c⇩i] 0 i j 3 2 1)))"
I can prove that the solution is valid for a concrete case:
definition "coins ≡ [GC, GC, SC, SC, SC, GC, GC, CC, CC, SC, CC, GC]"
value "weigh_coins coins"
lemma weigh_coins_ok:
"cs = coins ⟹
weigh_coins cs = Some ws ⟹
ws = map coin_weight cs"
by (induct cs; auto simp: coins_def weigh_def gen_weights_def std_weigh_def)
lemma weigh_coins_length_ok:
"cs = coins ⟹
weigh_coins cs = Some ws ⟹
length cs = length ws"
by (induct cs; auto simp: coins_def weigh_def gen_weights_def std_weigh_def)
However I have no idea how to prove it for a general case:
lemma weigh_coins_ok:
"weigh_coins cs = Some ws ⟹
ws = map coin_weight cs"
proof (induct cs)
case Nil
then show ?case by simp
next
case (Cons c cs)
then show ?case
qed
I can't induct over cs because I'll need to prove that
weigh_coins (c # cs) = Some ws ⟹ ∃ws. weigh_coins cs = Some ws
It doesn't hold. I can determine weights for [CC, SC, GC], but can't do it for [SC, GC].
An alternative approach is to prove these lemmas for a special cases:
[CC, CC, ...] # [SC, SC, ...] # [GC, GC, ...] # ...
[CC, CC, ...] # [GC, GC, ...] # [SC, SC, ...] # ...
[SC, SC, ...] # [GC, GC, ...] # [CC, CC, ...] # ...
...
And then to prove that the list of cases is exhaustive.
For example:
lemma weigh_coins_length:
"cs = [CC] # replicate n CC # [SC, GC] ⟹
weigh_coins cs = Some ws ⟹
length cs = length ws"
apply (induct n arbitrary: cs ws)
apply (auto simp: weigh_def gen_weights_def std_weigh_def)[1]
However I can't prove even this lemma.
The questions are:
Could you suggest how such a lemmas can be proven or how to reformulate the functions to make the lemmas provable?
How to formulate the lemma that weigh function is used at most n + 2 times in the algorithm, where n is the number of coins?
Some general hints:
You have three recursive functions: determine_weights, find_heavier, weigh_coins.
For each recursive function, try to express a relation between the inputs and results without using recursion (instead use quantifiers). The property you prove for the earlier functions must be strong enough to prove the properties for the later ones.
Also, the property should not fix any of the parameters. For example find_heavier is always initially called with j = 0, but the property should work for all values of j so that it can be used during induction.
Also try to formulate and prove the high level steps in your description: For example show that this function finds a silver coin or two copper coins.
Regarding question 2:
I would try to state the problem in a way where it is not possible to cheat. For example:
datatype strategy =
Return "coin list"
| Weigh "nat list" "nat list" "comp ⇒ strategy" ― ‹Weigh coins based on positions›
definition "select indexes coins ≡ map (nth coins) indexes"
fun runStrategy where
"runStrategy coins _ (Return r) = Some r"
| "runStrategy coins 0 _ = None"
| "runStrategy coins (Suc n) (Weigh xs ys cont) = (
if distinct xs ∧ distinct ys ∧ set xs ∩ set ys = {} then
runStrategy coins n (cont (weigh (select xs coins) (select ys coins)))
else None)"
lemma "∃strategy. ∀coins.
length coins = 100 ∧ (∀c. c ∈ set coins)
⟶ runStrategy coins 101 strategy = Some coins"
Here runStrategy calls weigh at most 101 times and the strategy cannot learn anything about the coins, except for the comparison result passed into the continuation of Weigh.
Related
I'm an undergraduate student trying to prove correctness and termination of imperative version of Euclidean gcd and Euclidean extended gcd algorithm. I used IMP language to implement the first one and Hoare logic to prove correctness and termination:
lemma "⊢{λs. s ''a'' = n ∧ s ''b'' = m ∧ n > 0 ∧ m > 0 ∧ (gcd (s ''a'') (s ''b'') = gcd (n) (m))}
WHILE (Or (Less (V ''b'') (V ''a'')) (Less (V ''a'') (V ''b'')))
DO (IF (Less (V ''b'') (V ''a'')) THEN
(''a'' ::= Sub (V ''a'') (V ''b''))
ELSE
(''b'' ::= Sub (V ''b'') (V ''a'')))
{λs. s ''a'' = gcd (s ''A'') (s ''B'')}"
apply (rule While'[where P = "λs. s ''a'' = n ∧ s ''b'' = m ∧ 0 < n ∧ 0 < m ∧ gcd (s ''a'') (s ''b'') = gcd n m"])
apply auto
apply (rule Assign')
apply auto
prefer 2
apply (rule Assign')
apply auto
remaining sub goals are:
proof (prove)
goal (3 subgoals):
1. ⋀s. 0 < s ''a'' ⟹ m = s ''b'' ⟹ n = s ''a'' ⟹ s ''a'' < s ''b'' ⟹ False
2. ⋀s. 0 < s ''b'' ⟹ m = s ''b'' ⟹ n = s ''a'' ⟹ s ''b'' < s ''a'' ⟹ False
3. ⋀s. n = s ''a'' ⟹ m = s ''a'' ⟹ 0 < s ''a'' ⟹ s ''b'' = s ''a'' ⟹ s ''a'' = gcd (s ''A'') (s ''B'')
and I don't now how to finish the proof. The gcd function here is default gcd from GCD library. I also tried this definition from Arith2 library:
definition cd :: "[nat, nat, nat] ⇒ bool"
where "cd x m n ⟷ x dvd m ∧ x dvd n"
definition gcd :: "[nat, nat] ⇒ nat"
where "gcd m n = (SOME x. x>0 ∧ cd x m n & (∀y.(cd y m n) ⟶ y dvd x))"
Is what I wrote correct and how should I continue? Should I use these definitions instead or should I write recursive version of gcd function myself? Is this approach correct?
First of all, you have a type in one place, where you talk about s ''A'' and s ''B'' instead of s ''a'' and s ''b''. But that is of course not the problem you were asking about.
The problem here is that the precondition is too strong to work with the WHILE rule. It contains the conditions s ''a'' = n and s ''b'' = m, which clearly do not work as a loop invariant since the loop modifies the variables a and b, so after one loop iteration, one of the conditions s ''a'' = n and s ''b'' = m will no longer hold.
You need to figure out a proper invariant that is weaker than what you have now. What you have to do is to kick out the s ''a'' = n and s ''b'' = m. Then your proof goes through.
You can then recover the statement you actually want to show with the strengthen_pre rule.
So the start of your proof would look something like this:
lemma "⊢{λs. s ''a'' = n ∧ s ''b'' = m ∧ n ≥ 0 ∧ m ≥ 0 ∧ (gcd (s ''a'') (s ''b'') = gcd (n) (m))}
WHILE (Or (Less (V ''b'') (V ''a'')) (Less (V ''a'') (V ''b'')))
DO (IF (Less (V ''b'') (V ''a'')) THEN
(''a'' ::= Sub (V ''a'') (V ''b''))
ELSE
(''b'' ::= Sub (V ''b'') (V ''a'')))
{λs. s ''a'' = gcd (s ''a'') (s ''b'')}"
apply (rule strengthen_pre)
defer
apply (rule While'[where P = "λs. s ''a'' ≥ 0 ∧ s ''b'' ≥ 0 ∧ gcd (s ''a'') (s ''b'') = gcd n m"])
To avoid this awkward manual use of strengthen_pre, other versions of IMP allow annotating the invariants of WHILE loops directly in the algorithm itself, so that a VCG (verification condition generator) can automatically give you all the things you have to prove and you don't have to apply Hoare rules manually.
Addendum: Note however that there is also a problem with your postcondition:
{λs. s ''a'' = gcd (s ''a'') (s ''b'')}
This is not what you want to show! This just means that the value of a after the execution is the GCD of the values of a and b after the execution. This also happens to be true because a and b are always equal after the algorithm has finished – but what you really want to know is that the value of a after the execution is equal to the GCD of a and b before the execution, i.e. equal to gcd n m. You therefore have to change your postcondition to
{λs. s ''a'' = gcd n m}
There is a set of some structures. I'm trying to prove that the cardinality of the set equals some number. Full theory is too long to post here. So here is a simplified one just to show the idea.
Let the objects (which I need to count) are sets containing natural numbers from 1 to n. The idea of the proof is as follows. I define a function which transforms sets to lists of 0 and 1. Here is the function and its inverse:
fun set_to_bitmap :: "nat set ⇒ nat ⇒ nat ⇒ nat list" where
"set_to_bitmap xs x 0 = []"
| "set_to_bitmap xs x (Suc n) =
(if x ∈ xs then Suc 0 else 0) # set_to_bitmap xs (Suc x) n"
fun bitmap_to_set :: "nat list ⇒ nat ⇒ nat set" where
"bitmap_to_set [] n = {}"
| "bitmap_to_set (x#xs) n =
(if x = Suc 0 then {n} else {}) ∪ bitmap_to_set xs (Suc n)"
value "set_to_bitmap {1,3,7,8} 1 8"
value "bitmap_to_set (set_to_bitmap {1,3,7,8} 1 8) 1"
Then I plan to prove that 1) a number of 0/1 lists with length n equals 2^^n,
2) the functions are bijections,
3) so the cardinality of the original set is 2^^n too.
Here are some auxiliary definitions and lemmas, which seems useful:
definition "valid_set xs n ≡ (∀a. a ∈ xs ⟶ 0 < a ∧ a ≤ n)"
definition "valid_bitmap ps n ≡ length ps = n ∧ set ps ⊆ {0, Suc 0}"
lemma length_set_to_bitmap:
"valid_set xs n ⟹
x = Suc 0 ⟹
length (set_to_bitmap xs x n) = n"
apply (induct xs x n rule: set_to_bitmap.induct)
apply simp
sorry
lemma bitmap_members:
"valid_set xs n ⟹
x = Suc 0 ⟹
set_to_bitmap xs x n = ps ⟹
set ps ⊆ {0, Suc 0}"
apply (induct xs x n arbitrary: ps rule: set_to_bitmap.induct)
apply simp
sorry
lemma valid_set_to_valid_bitmap:
"valid_set xs n ⟹
x = Suc 0 ⟹
set_to_bitmap xs x n = ps ⟹
valid_bitmap ps n"
unfolding valid_bitmap_def
using bitmap_members length_set_to_bitmap by auto
lemma valid_bitmap_to_valid_set:
"valid_bitmap ps n ⟹
x = Suc 0 ⟹
bitmap_to_set ps x = xs ⟹
valid_set xs n"
sorry
lemma set_to_bitmap_inj:
"valid_set xs n ⟹
valid_set xy n ⟹
x = Suc 0 ⟹
set_to_bitmap xs x n = ps ⟹
set_to_bitmap ys x n = qs ⟹
ps = qs ⟹
xs = ys"
sorry
lemma set_to_bitmap_surj:
"valid_bitmap ps n ⟹
x = Suc 0 ⟹
∃xs. set_to_bitmap xs x n = ps"
sorry
lemma bitmap_to_set_to_bitmap_id:
"valid_set xs n ⟹
x = Suc 0 ⟹
bitmap_to_set (set_to_bitmap xs x n) x = xs"
sorry
lemma set_to_bitmap_to_set_id:
"valid_bitmap ps n ⟹
x = Suc 0 ⟹
set_to_bitmap (bitmap_to_set ps x) x n = ps"
sorry
Here is a final lemma:
lemma valid_set_size:
"card {xs. valid_set xs n} = 2 ^^ n"
Does this approach seem valid? Are there any examples of such a proof? Could you suggest an idea on how to prove the lemmas? I'm stuck because the induction with set_to_bitmap.induct seems to be not applicable here.
In principle, that kind of approach does work: if you have a function f from a set A to a set B and an inverse function to it, you can prove bij_betw f A B (read: f is a bijection from A to B), and that then implies card A = card B.
However, there are a few comments that I have:
You should use bool lists instead of nat lists if you can only have 0 or 1 in them anyway.
It is usually better to use existing library functions than to define new ones yourself. Your two functions could be defined using library functions like this:
set_to_bitmap :: nat ⇒ nat ⇒ nat set ⇒ bool list
set_to_bitmap x n A = map (λi. i ∈ A) [x..<x+n]
bitmap_to_set :: nat ⇒ bool list ⇒ nat set
bitmap_to_set n xs = (λi. i + n) ` {i. i < length xs ∧ xs ! i}```
Side note: I would use upper-case letters for sets, not something like xs (which is usually used for lists).
Perhaps this is because you simplified your problem, but in its present form, valid_set A n is simply the same as A ⊆ {1..n} and the {A. valid_set A n} is simply Pow {1..n}. The cardinality of that is easy to show with results from the library:
lemma "card (Pow {1..(n::nat)}) = 2 ^ n"
by (simp add: card_Pow)`
As for your original questions: Your first few lemmas are provable, but for the induction to go through, you have to get rid of some of the unneeded assumptions first. The x = Suc 0 is the worst one – there is no way you can use induction if you have that as an assumption, because as soon as you do one induction step, you increase x by 1 and so you won't be able to apply your induction hypothesis. The following versions of your first three lemmas go through easily:
lemma length_set_to_bitmap:
"length (set_to_bitmap xs x n) = n"
by (induct xs x n rule: set_to_bitmap.induct) auto
lemma bitmap_members:
"set (set_to_bitmap xs x n) ⊆ {0, Suc 0}"
by (induct xs x n rule: set_to_bitmap.induct) auto
lemma valid_set_to_valid_bitmap: "valid_bitmap (set_to_bitmap xs x n) n"
unfolding valid_bitmap_def
using bitmap_members length_set_to_bitmap by auto
I also recommend not adding "abbreviations" like ps = set_to_bitmap xs x n as an assumption. It doesn't break anything, but it tends to complicate things needlessly.
The next lemma is a bit trickier. Due to your recursive definitions, you have to generalise the lemma first (valid_bitmap requires the set to be in the range from 1 to n, but once you make one induction step it has to be from 2 to n). The following works:
lemma valid_bitmap_to_valid_set_aux:
"bitmap_to_set ps x ⊆ {x..<x + length ps}"
by (induction ps x rule: bitmap_to_set.induct)
(auto simp: valid_bitmap_def valid_set_def)
lemma valid_bitmap_to_valid_set:
"valid_bitmap ps n ⟹ valid_set (bitmap_to_set ps 1) n"
using valid_bitmap_to_valid_set_aux unfolding valid_bitmap_def valid_set_def
by force
Injectivity and surjectivity (which is your ultimate goal) should follow from the fact that the two are inverse functions. Proving that will probably be doable with induction, but will require a few generalisations and auxiliary lemmas. It should be easier if you stick to the non-recursive definition using library functions that I sketched above.
While doing some basic algebra, I frequently arrive at a subgoal of the following type (sometimes with a finite sum, sometimes with a finite product).
lemma foo:
fixes N :: nat
fixes a :: "nat ⇒ nat"
shows "(a 0) = (∑x = 0..N. (if x = 0 then 1 else 0) * (a x))"
This seems pretty obvious to me, but neither auto nor auto cong: sum.cong split: if_splits can handle this. What's more, sledgehammer also surrenders when called on this lemma. How can one efficiently work with finite sums and products containing if-then-else in general, and how to approach this case in particular?
My favourite way to do these things (because it is very general) is to use the rules sum.mono_neutral_left and sum.mono_neutral_cong_left and the corresponding right versions (and analogously for products). The rule sum.mono_neutral_right lets you drop arbitrarily many summands if they are all zero:
finite T ⟹ S ⊆ T ⟹ ∀i∈T - S. g i = 0
⟹ sum g T = sum g S
The cong rule additionally allows you to modify the summation function on the now smaller set:
finite T ⟹ S ⊆ T ⟹ ∀i∈T - S. g i = 0 ⟹ (⋀x. x ∈ S ⟹ g x = h x)
⟹ sum g T = sum h S
With those, it looks like this:
lemma foo:
fixes N :: nat and a :: "nat ⇒ nat"
shows "a 0 = (∑x = 0..N. (if x = 0 then 1 else 0) * a x)"
proof -
have "(∑x = 0..N. (if x = 0 then 1 else 0) * a x) = (∑x ∈ {0}. a x)"
by (intro sum.mono_neutral_cong_right) auto
also have "… = a 0"
by simp
finally show ?thesis ..
qed
Assuming the left-hand side could use an arbitrary value between 0 and N, what about adding a more general lemma
lemma bar:
fixes N :: nat
fixes a :: "nat ⇒ nat"
assumes
"M ≤ N"
shows "a M = (∑x = 0..N. (if x = M then 1 else 0) * (a x))"
using assms by (induction N) force+
and solving the original one with using bar by blast?
My aim is to get a function constant f from a fact of the form ∀ x . ∃ y . P x y so that ∀ x . P x (f x). Here is how I do it manually:
theory Choose
imports
Main
begin
lemma
fixes P :: "nat ⇒ nat ⇒ nat ⇒ nat ⇒ nat ⇒ bool"
shows True
proof -
(* Somehow obtained this fact *)
have I: "∀ n m :: nat . ∃ i j k . P n m i j k"
by sorry
(* Have to do the rest by hand *)
define F
where "F ≡ λ n m . SOME (i, j, k) . P n m i j k"
define i
where "i ≡ λ n m . fst (F n m)"
define j
where "j ≡ λ n m . fst (snd (F n m))"
define k
where "k ≡ λ n m . snd (snd (F n m))"
have "∀ n m . P n m (i n m) (j n m) (k n m)"
(* prove manually (luckily sledgehammer finds a proof)*)
(*...*)
qed
(* or alternatively: *)
lemma
fixes P :: "nat ⇒ nat ⇒ nat ⇒ nat ⇒ nat ⇒ bool"
shows True
proof -
(* Somehow obtained this fact *)
have I: "∀ n m :: nat . ∃ i j k . P n m i j k"
by sorry
obtain i j k where "∀ n m . P n m (i n m) (j n m) (k n m)"
(* sledgehammer gives up (due to problem being too higher order?) *)
(* prove by hand :-( *)
(*...*)
qed
How to do this more ergonomically? Does Isabelle have something like
Leans choose tactic (https://leanprover-community.github.io/mathlib_docs/tactics.html#choose) ?
(Isabelles specification command only works on the top level :-( ).
(Sorry if this has been asked already, I didn't really find a good buzzword to search for this issue)
I don't think there is anything that automates this use case. You can avoid fiddling around with SOME by using the choice rule directly; it allows you to turn an ‘∀∃’ into a ‘∃∀’. However, you still have to convert P from a curried property with 5 arguments into a tupled one with two arguments first, and then unwrap the result again. I don't see a way around this. This is how I would have done it:
let ?P' = "λ(n,m). λ(i,j,k). P n m i j k"
have I: "∀n m. ∃i j k. P n m i j k"
sorry
hence "∀nm. ∃ijk. ?P' nm ijk"
by blast
hence "∃f. ∀nm. ?P' nm (f nm)"
by (rule choice) (* "by metis" also works *)
then obtain f where f: "?P' (n, m) (f (n, m))" for n m
by auto
define i where "i = (λn m. case f (n, m) of (i, j, k) ⇒ i)"
define j where "j = (λn m. case f (n, m) of (i, j, k) ⇒ j)"
define k where "k = (λn m. case f (n, m) of (i, j, k) ⇒ k)"
have ijk: "P n m (i n m) (j n m) (k n m)" for n m
using f[of n m] by (auto simp: i_def j_def k_def split: prod.splits)
In principle, I am sure this could be automated. I don't think there is any reason why the specification command should only work on the top level and not in local contexts or even Isar proofs, other than that it is old and nobody ever bothered to do it. That said, it would of course mean quite a bit of implementation effort and I for one have encountered situations like this relatively rarely and the boilerplate for applying choice by hand as above is not that bad.
But it would certainly be nice to have automation for this!
I've two Fibonacci implementations, seen below, that I want to prove are functionally equivalent.
I've already proved properties about natural numbers, but this exercise requires another approach that I cannot figure out.
The textbook I'm using have introduced the following syntax of Coq, so it should be possible to prove equality using this notation:
<definition> ::= <keyword> <identifier> : <statement> <proof>
<keyword> ::= Proposition | Lemma | Theorem | Corollary
<statement> ::= {<quantifier>,}* <expression>
<quantifier> ::= forall {<identifier>}+ : <type>
| forall {({<identifier>}+ : <type>)}+
<proof> ::= Proof. {<tactic>.}* <end-of-proof>
<end-of-proof> ::= Qed. | Admitted. | Abort.
Here are the two implementations:
Fixpoint fib_v1 (n : nat) : nat :=
match n with
| 0 => O
| S n' => match n' with
| O => 1
| S n'' => (fib_v1 n') + (fib_v1 n'')
end
end.
Fixpoint visit_fib_v2 (n a1 a2 : nat) : nat :=
match n with
| 0 => a1
| S n' => visit_fib_v2 n' a2 (a1 + a2)
end.
It is pretty obvious that these functions compute the same value for the base case n = 0, but the induction case is much harder?
I've tried proving the following Lemma, but I'm stuck in induction case:
Lemma about_visit_fib_v2 :
forall i j : nat,
visit_fib_v2 i (fib_v1 (S j)) ((fib_v1 j) + (fib_v1 (S j))) = (fib_v1 (add_v1 i (S j))).
Proof.
induction i as [| i' IHi'].
intro j.
rewrite -> (unfold_visit_fib_v2_0 (fib_v1 (S j)) ((fib_v1 j) + (fib_v1 (S j)))).
rewrite -> (add_v1_0_n (S j)).
reflexivity.
intro j.
rewrite -> (unfold_visit_fib_v2_S i' (fib_v1 (S j)) ((fib_v1 j) + (fib_v1 (S j)))).
Admitted.
Where:
Fixpoint add_v1 (i j : nat) : nat :=
match i with
| O => j
| S i' => S (add_v1 i' j)
end.
A note of warning: in what follows I'll to try to show the main idea of such a proof, so I'm not going to stick to some subset of Coq and I won't do arithmetic manually. Instead I'll use some proof automation, viz. the ring tactic. However, feel free to ask additional questions, so you could convert the proof to somewhat that would suit your purposes.
I think it's easier to start with some generalization:
Require Import Arith. (* for `ring` tactic *)
Lemma fib_v1_eq_fib2_generalized n : forall a0 a1,
visit_fib_v2 (S n) a0 a1 = a0 * fib_v1 n + a1 * fib_v1 (S n).
Proof.
induction n; intros a0 a1.
- simpl; ring.
- change (visit_fib_v2 (S (S n)) a0 a1) with
(visit_fib_v2 (S n) a1 (a0 + a1)).
rewrite IHn. simpl; ring.
Qed.
If using ring doesn't suit your needs, you can perform multiple rewrite steps using the lemmas of the Arith module.
Now, let's get to our goal:
Definition fib_v2 n := visit_fib_v2 n 0 1.
Lemma fib_v1_eq_fib2 n :
fib_v1 n = fib_v2 n.
Proof.
destruct n.
- reflexivity.
- unfold fib_v2. rewrite fib_v1_eq_fib2_generalized.
ring.
Qed.
#larsr's answer inspired this alternative answer.
First of all, let's define fib_v2:
Require Import Coq.Arith.Arith.
Definition fib_v2 n := visit_fib_v2 n 0 1.
Then, we are going to need a lemma, which is the same as fib_v2_lemma in #larsr's answer. I'm including it here for consistency and to show an alternative proof.
Lemma visit_fib_v2_main_property n: forall a0 a1,
visit_fib_v2 (S (S n)) a0 a1 =
visit_fib_v2 (S n) a0 a1 + visit_fib_v2 n a0 a1.
Proof.
induction n; intros a0 a1; auto with arith.
change (visit_fib_v2 (S (S (S n))) a0 a1) with
(visit_fib_v2 (S (S n)) a1 (a0 + a1)).
apply IHn.
Qed.
As suggested in the comments by larsr, the visit_fib_v2_main_property lemma can be also proved by the following impressive one-liner:
now induction n; firstorder.
Because of the nature of the numbers in the Fibonacci series it's very convenient to define an alternative induction principle:
Lemma pair_induction (P : nat -> Prop) :
P 0 ->
P 1 ->
(forall n, P n -> P (S n) -> P (S (S n))) ->
forall n, P n.
Proof.
intros H0 H1 Hstep n.
enough (P n /\ P (S n)) by tauto.
induction n; intuition.
Qed.
The pair_induction principle basically says that if we can prove some property P for 0 and 1 and if for every natural number k > 1, we can prove P k holds under the assumption that P (k - 1) and P (k - 2) hold, then we can prove forall n, P n.
Using our custom induction principle, we get the proof as follows:
Lemma fib_v1_eq_fib2 n :
fib_v1 n = fib_v2 n.
Proof.
induction n using pair_induction.
- reflexivity.
- reflexivity.
- unfold fib_v2.
rewrite visit_fib_v2_main_property.
simpl; auto.
Qed.
Anton's proof is very beautiful, and better than mine, but it might be useful, anyway.
Instead of coming up with the generalisation lemma, I strengthened the induction hypothesis.
Say the original goal is Q n. I then changed the goal with
cut (Q n /\ Q (S n))
from
Q n
to
Q n /\ Q (S n)
This new goal trivially implies the original goal, but with it the induction hypothesis becomes stronger, so it becomes possible to rewrite more.
IHn : Q n /\ Q (S n)
=========================
Q (S n) /\ Q (S (S n))
This idea is explained in Software Foundations in the chapter where one does proofs over even numbers.
Because the propostion often is very long, I made an Ltac tactic that names the long and messy term.
Ltac nameit Q :=
match goal with [ _:_ |- ?P ?n] => let X := fresh Q in remember P as X end.
Require Import Ring Arith.
(Btw, I renamed vistit_fib_v2 to fib_v2.)
I needed a lemma about one step of fib_v2.
Lemma fib_v2_lemma: forall n a b, fib_v2 (S (S n)) a b = fib_v2 (S n) a b + fib_v2 n a b.
intro n.
pattern n.
nameit Q.
cut (Q n /\ Q (S n)).
tauto. (* Q n /\ Q (S n) -> Q n *)
induction n.
split; subst; simpl; intros; ring. (* Q 0 /\ Q 1 *)
split; try tauto. (* Q (S n) *)
subst Q. (* Q (S (S n)) *)
destruct IHn as [H1 H2].
assert (L1: forall n a b, fib_v2 (S n) a b = fib_v2 n b (a+b)) by reflexivity.
congruence.
Qed.
The congruence tactic handles goals that follow from a bunch of A = B assumptions and rewriting.
Proving the theorem is very similar.
Theorem fib_v1_fib_v2 : forall n, fib_v1 n = fib_v2 n 0 1.
intro n.
pattern n.
nameit Q.
cut (Q n /\ Q (S n)).
tauto. (* Q n /\ Q (S n) -> Q n *)
induction n.
split; subst; simpl; intros; ring. (* Q 0 /\ Q 1 *)
split; try tauto. (* Q (S n) *)
subst Q. (* Q (S (S n)) *)
destruct IHn as [H1 H2].
assert (fib_v1 (S (S n)) = fib_v1 (S n) + fib_v1 n) by reflexivity.
assert (fib_v2 (S (S n)) 0 1 = fib_v2 (S n) 0 1 + fib_v2 n 0 1) by
(pose fib_v2_lemma; congruence).
congruence.
Qed.
All the boiler plate code could be put in a tactic, but I didn't want to go crazy with the Ltac, since that was not what the question was about.
This proof script only shows the proof structure. It could be useful to explain the idea of the proof.
Require Import Ring Arith Psatz. (* Psatz required by firstorder *)
Theorem fibfib: forall n, fib_v2 n 0 1 = fib_v1 n.
Proof with (intros; simpl in *; ring || firstorder).
assert (H: forall n a0 a1, fib_v2 (S n) a0 a1 = a0 * (fib_v1 n) + a1 * (fib_v1 (S n))).
{ induction n... rewrite IHn; destruct n... }
destruct n; try rewrite H...
Qed.
There is a very powerful library -- math-comp written in the Ssreflect formal proof language that is in its turn based on Coq. In this answer I present a version that uses its facilities. It's just a simplified piece of this development. All credit goes to the original author.
Let's do some imports and the definitions of our two functions, math-comp (ssreflect) style:
From mathcomp
Require Import ssreflect ssrnat ssrfun eqtype ssrbool.
Fixpoint fib_rec (n : nat) {struct n} : nat :=
if n is n1.+1 then
if n1 is n2.+1 then fib_rec n1 + fib_rec n2
else 1
else 0.
Fixpoint fib_iter (a b n : nat) {struct n} : nat :=
if n is n1.+1 then
if n1 is n2.+1
then fib_iter b (b + a) n1
else b
else a.
A helper lemma expressing the basic property of Fibonacci numbers:
Lemma fib_iter_property : forall n a b,
fib_iter a b n.+2 = fib_iter a b n.+1 + fib_iter a b n.
Proof.
case=>//; elim => [//|n IHn] a b; apply: IHn.
Qed.
Now, let's tackle equivalence of the two implementations.
The main idea here, that distinguish the following proof from the other proofs has been presented as of time of this writing, is that we perform
kind of complete induction, using elim: n {-2}n (leqnn n). This gives us the following (strong) induction hypothesis:
IHn : forall n0 : nat, n0 <= n -> fib_rec n0 = fib_iter 0 1 n0
Here is the main lemma and its proof:
Lemma fib_rec_eq_fib_iter : fib_rec =1 fib_iter 0 1.
Proof.
move=>n; elim: n {-2}n (leqnn n)=> [n|n IHn].
by rewrite leqn0; move/eqP=>->.
case=>//; case=>// n0; rewrite ltnS=> ltn0n.
rewrite fib_iter_property.
by rewrite <- (IHn _ ltn0n), <- (IHn _ (ltnW ltn0n)).
Qed.
Here is yet another answer, similar to the one using mathcomp, but this one uses "vanilla" Coq.
First of all, we need some imports, additional definitions, and a couple of helper lemmas:
Require Import Coq.Arith.Arith.
Definition fib_v2 n := visit_fib_v2 n 0 1.
Lemma visit_fib_v2_property n: forall a0 a1,
visit_fib_v2 (S (S n)) a0 a1 =
visit_fib_v2 (S n) a0 a1 + visit_fib_v2 n a0 a1.
Proof. now induction n; firstorder. Qed.
Lemma fib_v2_property n:
fib_v2 (S (S n)) = fib_v2 (S n) + fib_v2 n.
Proof. apply visit_fib_v2_property. Qed.
To prove the main lemma we are going to use the standard well-founded induction lt_wf_ind principle for natural numbers with the < relation (a.k.a. complete induction):
This time we need to prove only one subgoal, since the n = 0 case for complete induction is always vacuously true. Our induction hypothesis, unsurprisingly, looks like this:
IH : forall m : nat, m < n -> fib_v1 m = fib_v2 m
Here is the proof:
Lemma fib_v1_eq_fib2 n :
fib_v1 n = fib_v2 n.
Proof.
pattern n; apply lt_wf_ind; clear n; intros n IH.
do 2 (destruct n; trivial).
rewrite fib_v2_property.
rewrite <- !IH; auto.
Qed.