Proving primes in Coq - primes

I have a Coq function that classifies prime numbers.
I exported it to Haskell and tested it; it works fine.
I want to rigorously prove it indeed classifies primes,
so I tried to prove the following theorem isPrimeCorrect:
(************)
(* helper'' *)
(************)
Fixpoint helper' (p m n : nat) : bool :=
match m with
| 0 => false
| 1 => false
| S m' => (orb ((mult m n) =? p) (helper' p m' n))
end.
(**********)
(* helper *)
(**********)
Fixpoint helper (p m : nat) : bool :=
match m with
| 0 => false
| S m' => (orb ((mult m m) =? p) (orb (helper' p m' m) (helper p m')))
end.
(***********)
(* isPrime *)
(***********)
Fixpoint isPrime (p : nat) : bool :=
match p with
| 0 => false
| 1 => false
| S p' => (negb (helper p p'))
end.
(***********)
(* divides *)
(***********)
Definition divides (n p : nat) : Prop :=
exists (m : nat), ((mult m n) = p).
(*********)
(* prime *)
(*********)
Definition prime (p : nat) : Prop :=
(p > 1) /\ (forall (n : nat), ((divides n p) -> ((n = 1) \/ (n = p)))).
(*****************************)
(* isPrime correctness proof *)
(*****************************)
Theorem isPrimeCorrect: forall (p : nat),
((isPrime p) = true) <-> (prime p).
I spent a good few hours on this theorem today with no actual progress.
Actually, I was a bit surprised how difficult it is since I previously
managed to prove pretty similar stuff. Any hints/clues how to proceed?

You must explicitely write lemmas for each of the helping functions, which state exactly what you think this function does for you. For instance, I tried to do this for your helper' function and I came up with the following lemma:
Require Import Arith Psatz.
(************)
(* helper'' *)
(************)
Fixpoint helper' (p m n : nat) : bool :=
match m with
| 0 => false
| 1 => false
| S m' => (orb ((mult m n) =? p) (helper' p m' n))
end.
Lemma helper'_correct :
forall p m n,
helper' p m n = true <-> exists k, (1 < k <= m /\ p = k * n).
Proof.
intros p; induction m as [ | m' IH]; intros n.
split;[discriminate | ].
intros [k [abs _]].
lia. (* Here the hypothesis abs has statement 1 <= k < 0
and lia recognizes that it is absurd. *)
destruct m' as [ | m''] eqn: E.
split;[discriminate | intros [k [abs _]]; lia].
change (helper' p (S (S m'')) n) with (orb ((mult (S (S m'')) n) =? p)
(helper' p (S m'') n)).
rewrite Bool.orb_true_iff.
split.
intros [it | later].
now exists (S (S m'')); split;[lia | symmetry; apply beq_nat_true ].
rewrite IH in later; destruct later as [k [k1 k2]].
exists k.
(* here hypothesis k1 states 1 < k <= S m''
k2 states p = k * n
and we need to prove 1 < k <= S (S m'') /\ p = k * n
lia can do that automatically. *)
lia.
intros [k [[k1 km] k2]].
apply le_lt_or_eq in km; rewrite or_comm in km; destruct km as [km | km].
now left; rewrite <- km; rewrite Nat.eqb_eq, k2.
right; apply lt_n_Sm_le in km.
change (helper' p (S m'') n = true); rewrite IH.
exists k.
lia.
Qed.
Obviously there should also be a way to link the helper function wih the divides predicate.

Related

Write the function residue l n which calculates the residue of n by l by making an iterative calculation

I want to write the function residue l n which calculates the residue of n by l by making an iterative calculation starting with n and using the items in the list in order. The calculation is as follows:
-initially the residue is the value of n
-each element e of l (taken in the order of the list) changes the residue in the following way:
if e and the residue are of the same parity (both even or both odd) then the new residue is the sum of r and e, otherwise it is the difference between r and e (r-e).
-the last residue is the result of the game.
Example: residu [1;3] 7 returns 5 as a result of the following calculations:
7 + 1 (same parity +) = 8
8 - 3 (parité différente -) = 5
This is my code but it doesn't seem to be working:
let rec residue l n =
if l = [] then 0 else
if (((List.hd l) mod 2 <> 0) && (n mod 2 <> 0 )) || (((List.hd l) mod 2 == 0) && (n mod 2 == 0 ))
then
(List.hd l) + residue (List.tl l) ((List.hd l)+ n) else
n - (List.hd l) - residue (List.tl l) (n - (List.hd l));;
residu [1;3] 7;;
- : int = 6 (The correct result should be 5)
Thank you for your help.
Here is my stab at it.
let rec residue l n =
let parity a b =
if ((a mod 2 <> 0) && (b mod 2 <> 0)) ||
((a mod 2 == 0) && (b mod 2 == 0)) then true else false in
match l, n with
| [], n -> n
| (x::xs), n -> if parity x n then residue xs (n+x) else residue xs (n-x)
Hope it helps for figuring out the problem.

Overcoming definitional equality issues when constructing basic Agda functions

I'm trying to write a reverse vector function in agda, and am running into the following stumbling block
Goal: Vec Nat (suc n)
Have: Vec Nat (n +N 1)
If I understand correctly, these values aren't definionally equal. Here is the reverse function.
vReverse : {X : Set} {n : Nat} → Vec X n → Vec X n
vReverse [] = []
vReverse (x ,- x₁) = {!(vReverse x₁) +V (x ,- [])!}
How can I overcome this, if possilbe, without refactoring the code. If a refactor is necessary, how can one generally avoid these pitfalls a priori? Here is the rest of the code.
data Nat : Set where
zero : Nat
suc : Nat -> Nat -- recursive data type
{-# BUILTIN NATURAL Nat #-}
_+N_ : Nat -> Nat -> Nat
zero +N y = y
suc x +N y = suc (x +N y) -- there are other choices
data Vec (X : Set) : Nat -> Set where -- like lists, but length-indexed
[] : Vec X zero
_,-_ : {n : Nat} -> X -> Vec X n -> Vec X (suc n)
infixr 4 _,-_ -- the "cons" operator associates to the right
_+V_ : {X : Set}{m n : Nat} -> Vec X m -> Vec X n -> Vec X (m +N n)
[] +V xs = xs
(x ,- xs) +V [] = x ,- xs +V []
(x ,- xs) +V x₁ ,- ys = x ,- xs +V x₁ ,- ys
The idea is that you can transform an element of type P x into an element of type P y provided you can prove x ≡ y. Let me guide you through this process step by step. Here is the base code you provided, which I have not refactored as you requested.
data Nat : Set where
zero : Nat
suc : Nat -> Nat -- recursive data type
{-# BUILTIN NATURAL Nat #-}
_+N_ : Nat -> Nat -> Nat
zero +N y = y
suc x +N y = suc (x +N y) -- there are other choices
infixl 5 _+N_
data Vec (X : Set) : Nat -> Set where -- like lists, but length-indexed
[] : Vec X zero
_,-_ : {n : Nat} -> X -> Vec X n -> Vec X (suc n)
infixr 4 _,-_ -- the "cons" operator associates to the right
However, your concatenation function was incorrect and it didn't terminate so here is the corrected version.
_+V_ : {X : Set}{m n : Nat} -> Vec X m -> Vec X n -> Vec X (m +N n)
[] +V vs = vs
(x ,- xs) +V vs = x ,- (xs +V vs)
The reason why we don't need to do any substitution in this function is because suc n + m is definitionally equal to suc (n + m).
Since you've defined your own naturals and your own addition, I'm assuming you want to redefine everything by yourself. According to this assumption, you'll need to define propositional equality, which is done as follows:
data _≡_ {a} {A : Set a} (x : A) : A → Set a where
refl : x ≡ x
infix 1 _≡_
From this definition, we can define the substitution that was mentioned in the preamble of this answer, as well as in a comment of your question:
subst : ∀ {a b} {A : Set a} {x y : A} (P : A → Set b) → x ≡ y → P x → P y
subst _ refl p = p
In your reverse function, the problem lies in the fact that n + 1 is not definitionally equal to suc n. Which is why we need a property to establish this fact, which we can then feed to our substitution mechanism. This proof requires the congruence of the propositional equality we defined, as follows:
cong : ∀ {a b} {A : Set a} {B : Set b} (f : A → B) {x y} → x ≡ y → f x ≡ f y
cong _ refl = refl
n+1≡sn : ∀ {n} → n +N 1 ≡ suc n
n+1≡sn {zero} = refl
n+1≡sn {suc _} = cong suc n+1≡sn
We now have all the required elements to write your vReverse function:
vReverse : ∀ {X n} → Vec X n → Vec X n
vReverse [] = []
vReverse (x ,- x₁) = subst (Vec _) n+1≡sn ((vReverse x₁) +V (x ,- []))
To go Further, you can use the same process to build the usual reverse function which is more efficient (linear complexity). I took the liberty to do this for you, since it shows more examples of usage of subst.
n+sm≡sn+m : ∀ {n m} → n +N suc m ≡ suc (n +N m)
n+sm≡sn+m {zero} = refl
n+sm≡sn+m {suc _} = cong suc n+sm≡sn+m
reverse-better-aux : ∀ {X n m} → Vec X n → Vec X m → Vec X (n +N m)
reverse-better-aux [] v₂ = v₂
reverse-better-aux (x ,- v₁) v₂ = subst (Vec _) n+sm≡sn+m (reverse-better-aux v₁ (x ,- v₂))
n+0≡n : ∀ {n} → n +N 0 ≡ n
n+0≡n {zero} = refl
n+0≡n {suc _} = cong suc n+0≡n
reverse-better : ∀ {X n} → Vec X n → Vec X n
reverse-better v = subst (Vec _) n+0≡n (reverse-better-aux v [])

Hint on FStar proof dead end

Can I get a brief explanation why this proof effort fails?
In my studies I'm trying to recognize simple patterns in generated lists of integers.
The generator below produces a list of alternating 0s and 1s. I'd like to prove that items at even indexes are 0.
val evenb : nat -> bool
let rec evenb n =
match n with
| 0 -> true
| 1 -> false
| n -> evenb (n - 2)
val nth_item : ls: list nat {length ls > 0} -> n: nat {n < length ls} -> nat
let rec nth_item ls n =
match ls with
| [h] -> h
| h :: t -> if n = 0 then h else nth_item t (n - 1)
val gen_01 : lng: nat {lng >= 2 && evenb lng} -> ls: list nat {length ls = lng}
let rec gen_01 lng =
match lng with
| 2 -> [0; 1]
| _ -> [0; 1] # gen_01 (lng - 2)
let rec lemma_01 (lng: nat {lng >= 2 && evenb lng}) :
Lemma (forall (n: nat {n <= lng - 2 && evenb n}) . (nth_item (gen_01 lng) n) = 0) =
match lng with
| 2 -> ()
| _ -> lemma_01 (lng - 2)
FStar returns 'could not prove post-condition'.
I'd appreciate any help regarding the approach.
F* should also report a secondary error location pointing to the conjunct in the postcondition that was not provable---in this case, it's just the nth_item (gen_01 lng) n = 0 goal.
One way to diagnose this is to consider one branch of the proof at a time. E.g. if you add an admit(); in the second branch, then you'll see that the first branch is easily provable. So, what's going wrong is the inductive case. You don't have a strong enough induction hypothesis to prove the property you want.
Here's one proof of it ... there are probably many others.
First, I proved this:
let rec access_2n (l:nat{l >= 2 && evenb l}) (n:nat{2 * n < l})
: Lemma (ensures nth_item (gen_01 l) (2 * n) = 0)
= match n with
| 0 -> ()
| _ -> access_2n (l - 2) (n - 1)
Notice the induction on the pair l, n so that the length and the access index decrease together.
This is pretty much the property you wanted to prove, stated slightly differently. To massage it into the form you want, I did this:
First, a lemma to interpret evenb arithmetically:
[Edit: I added an open FStar.Mul to bring the * symbol into scope for multiplication]
open FStar.Mul
let rec evenb_is_even (n:nat{evenb n})
: Lemma (2 * (n / 2) = n)
= match n with
| 0 -> ()
| _ -> evenb_is_even (n - 2)
Then to prove something very like your lemma, but for an explicit n.
let lemma_01_aux (lng: nat {lng >= 2 && evenb lng}) (n:nat{n <= lng - 2 && evenb n})
: Lemma (nth_item (gen_01 lng) n = 0)
= access_2n lng (n / 2); evenb_is_even n
And finally to universally quantify over n using a library that turns lemmas into quantified postconditions.
let lemma_01 (lng: nat {lng >= 2 && evenb lng})
: Lemma (forall (n: nat {n <= lng - 2 && evenb n}) . (nth_item (gen_01 lng) n) = 0)
= FStar.Classical.forall_intro_2 lemma_01_aux

How to prove something obviously logical - list_get problem in Prop

The problem is that I cannot apply induction on H without skipping a step. I was supposed to get Some instr0 to apply the standard lemma :
Lemma get_Some {A} (l:list A) n x :
list_get l n = Some x -> n < length l.
Proof.
revert n. induction l; destruct n; simpl; try discriminate.
- auto with arith.
- intros. apply IHl in H. auto with arith.
Qed.
frankly the first that come in mind is unfold the definition of Step and try induction on list_get.
Lemma getthatStep code m m' (n := List.length code):
Step code m m' -> pc m < length code .
1 subgoal
code : list instr
m, m' : machine
n := length code : nat
H : match list_get code (pc m) with
| Some instr0 => Stepi instr0 m m'
| None => False
end
______________________________________(1/1)
pc m < length code
It seems obvious but I'm pretty blocked.
Here some Information on the types :
Record machine :=Mach {
(** Pointeur de code *)
pc : nat;
(** Pile principale *)
stack : list nat;
(** Pile de variables *)
vars : list nat
}.
Inductive instr :=
| Push : nat -> instr
| Pop : instr
| Op : op -> instr
| NewVar : instr
Inductive Stepi : instr -> machine -> machine -> Prop :=
| SPush pc stk vs n : Stepi (Push n) (Mach pc stk vs) (Mach (S pc) (n::stk) vs)
| SPop pc stk vs x : Stepi Pop (Mach pc (x::stk) vs) (Mach (S pc) stk vs)
| SOp pc stk vs o y x : Stepi (Op o) (Mach pc (y::x::stk) vs) (Mach (S pc) (eval_op o x y :: stk) vs). ```
(* Takes two machines and a list of instructions if their code
is valid it returns true else it returns false *)
Definition Step (code:list instr) (m m' : machine) : Prop :=
match list_get code m.(pc) with
| Some instr => Stepi instr m m'
| None => False
end.
You can get the relevant information with destruct (list_get code (pc m)) eqn:H'. This will give you enough information to apply your lemma in one case, and to prove the goal by exfalso in the other case.

Idris - Define a primes type

I am learning Idris and as a personal exercise, I would like to implement a Primes type, consisting of all the prime numbers.
Is there a way in idris to define a new type starting from a type and a property, which will select all the elements of the starting type for which the property holds true? In my case, is there a way to define Primes as the set of Nat such that n <= p and n|p => n=1 or n=p?
If this is not possible, should I define prime numbers constructing them inductively using some kind of sieve?
I like copumpkin's Agda definition of Prime, which looks like this in Idris:
data Divides : Nat -> Nat -> Type where
MkDivides : (q : Nat) ->
n = q * S m ->
Divides (S m) n
data Prime : Nat -> Type where
MkPrime : GT p 1 ->
((d : Nat) -> Divides d p -> Either (d = 1) (d = p))
-> Prime p
Read as "if p is divisible by d, then d must be 1 or p" - a common definition for primality.
Proving this by hand for a number can be pretty tedious:
p2' : (d : Nat) -> Divides d 2 -> Either (d = 1) (d = 2)
p2' Z (MkDivides _ _) impossible
p2' (S Z) (MkDivides Z Refl) impossible
p2' (S Z) (MkDivides (S Z) Refl) impossible
p2' (S Z) (MkDivides (S (S Z)) Refl) = Left Refl
p2' (S Z) (MkDivides (S (S (S _))) Refl) impossible
p2' (S (S Z)) (MkDivides Z Refl) impossible
p2' (S (S Z)) (MkDivides (S Z) Refl) = Right Refl
p2' (S (S Z)) (MkDivides (S (S _)) Refl) impossible
p2' (S (S (S _))) (MkDivides Z Refl) impossible
p2' (S (S (S _))) (MkDivides (S _) Refl) impossible
p2 : Prime 2
p2 = MkPrime (LTESucc (LTESucc LTEZero)) p2'
It's also very involved to write a decision procedure for this. That'll be a big exercise! You'll probably find the rest of the definitions useful for that:
https://gist.github.com/copumpkin/1286093