Related
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 [])
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.
I have just started learning F*, going through the tutorial. One of the exercises there is to prove that the reverse function on lists is injective.
Since this follows from the fact that involutions are injective I would like to express that fact as a lemma in F*. To do that I define
let is_involutive f = forall x. (f (f x) == x)
let is_injective f = forall x y. (f x == f y) ==> x == y
Is this the right way to define the notion of f being involutive or injective in F*?
Then I state the lemma
val inv_is_inj: #a:eqtype -> a -> f:(a->a) ->
Lemma (requires (is_involutive f)) (ensures(is_injective f))
Informally the proof can be written as
{ fix (x:a) (y:a)
assume (f x == f y)
then have (f (f x) == f (f y))
with (is_involutive f) have (x == y)
} hence (forall (x:a) (y:a). f x == f y ==> x == y)
then have (is_injective f)
How do I express such proof in F*?
In general, what F* language constructs can be used to prove statements of the form forall (x:a). phi x, where phi is a predicate on a type a?
I am trying to define a function that accepts a point (x,y) as input, and returns an infinite list corresponding to recursively calling
P = (u^2 − v^2 + x, 2uv + y)
The initial values of u and v are both 0.
The first call would be
P = (0^2 - 0^2 + 1, 2(0)(0) + 2) = (1,2)
Then that resulting tuple (1,2) would be the next values for u and v, so then it would be
P = (1^2 - 2^2 + 1, 2(1)(2) + 2) = (-2,6)
and so on.
I'm trying to figure out how to code this in Haskell. This is what I have so far:
o :: Num a =>(a,a) -> [(a,a)]
o (x,y) = [(a,b)| (a,b)<- [p(x,y)(x,y)]]
where p(x,y)(u,v) = ((u^2)-(v^2)+x,(2*u*v)+y)
I'm really not sure how to make this work. Any help would be appreciated!
Let's first ignore the exact question you have, and focus on getting the loop working. What you want, essentially, is to have something that takes some initial value iv (namely, (0, 0) for (u, v)), and returns the list
f iv : f (f iv) : f (f (f iv)) : f (f (f (f iv))) : ...
for some function f (constructed from your p and (x, y)). Moreover, you want the result to reuse the previously computed elements of the list. If I would write a function myself that does this, it might looke like this (but maybe with some different names):
looper :: (a -> a) -> a -> [a]
looper f iv = one_result : more_results
where
one_result = f iv
more_results = looper f one_result
But, of course, I would first look if a function with that type exists. It does: it's called Data.List.iterate. The only thing it does wrong is the first element of the list will be iv, but that can be easily fixed by using tail (which is fine here: as long as your iteration function terminates, iterate will always generate an infinite list).
Let's now get back to your case. We established that it'll generally look like this:
o :: Num a => (a, a) -> [(a, a)]
o (x, y) = tail (iterate f iv)
where
f (u, v) = undefined
iv = undefined
As you indicated, the initial value of (u, v) is (0, 0), so that's what our definition of iv will be. f now has to call p with the (x, y) from o's argument and the (u, v) for that iteration:
o :: Num a => (a, a) -> [(a, a)]
o (x, y) = tail (iterate f iv)
where
f (u, v) = p (x, y) (u, v)
iv = (0, 0)
p = undefined
It's as simple as that: the (x, y) from o's definition is actually in scope in the where-clause. You could even decide to merge f and p, and end up with
o :: Num a => (a, a) -> [(a, a)]
o (x, y) = tail (iterate p iv)
where
iv = (0, 0)
p (u, v) = (u^2 - v^2 + x, 2 * u * v + y)
Also, may I suggest that you use Data.Complex for your application? This makes the constraints on a a bit stricter (you need RealFloat a, because of Num.signum), but in my opinion, it makes your code much easier to read:
import Data.Complex
import Data.List (iterate)
{- ... -}
o :: Num (Complex a) => Complex a -> [Complex a]
o c = tail (iterate p iv)
where
iv = 0 -- or "0 :+ 0", if you want to be explicit
p z = z^2 + c
You want:
To construct a list [(u, v)] with the head of this list equal (0, 0)
And then map this list with the function \(u, v) -> (u^2 - v^2 + x, 2 * u * v + y), appending results of this function to the list.
We can write this function as described:
func :: (Num t) => (t, t) -> [(t, t)]
func (x, y) = (0, 0) : map functionP (func (x, y))
where functionP (u, v) = (u^2 - v^2 + x, 2 * u * v + y)
GHCi > take 5 $ func (1, 2)
> [(0,0),(1,2),(-2,6),(-31,-22),(478,1366)]
How should one convert a list with a known length into nested pairs? In other words, what is the most convenient way to fill the type holes below?
_ [1,2] :: (Int,Int)
_ [1,2,3] :: ((Int,Int),Int)
_ [1,2,3,4] :: (((Int,Int),Int),Int)
_ [1,2,3,4,5] :: ((((Int,Int),Int),Int),Int)
EDIT: note that the type holes need not be the same function, I'm looking for a convenient pattern (if a convenient pattern exists) to fill the holes.
Perhaps like this:
step f xs = (f (init xs), last xs)
len1 = head
len2 = step len1
len3 = step len2
len4 = step len3
In ghci:
*Main> len4 [1..4]
(((1,2),3),4)
One may of course also directly implement one of these functions with pattern matching:
len4' [a,b,c,d] = (((a,b),c),d)
This will also not traverse the list as many times as there are elements, which is nice.
Chiming in with a dependently typed version. First, let's get done with the boilerplate:
{-# LANGUAGE
TemplateHaskell, DataKinds, ScopedTypeVariables,
FlexibleInstances, PolyKinds, TypeOperators,
TypeFamilies, GADTs, UndecidableInstances #-}
import Data.Singletons.TH
import qualified GHC.TypeLits as Lit
$(singletons [d| data Nat = Z | S Nat deriving (Eq, Show) |])
The use of TH here is purely for boilerplate reduction and we won't use TH in our actual code. In fact, the above could be (and should be) factored out in a package somewhere (at the time of writing this answer there isn't such a package with up-to-date singletons dependency).
tuplify becomes a function whose return type depends on a Nat parameter.
type family NTup n a where
NTup (S (S Z)) a = (a, a)
NTup (S (S (S n))) a = (NTup (S (S n)) a, a)
tuplify :: Sing n -> [a] -> NTup n a
tuplify n as = go n (reverse as) where
go :: Sing n -> [a] -> NTup n a
go (SS (SS SZ)) [a, b] = (b, a)
go (SS (SS (SS n))) (a:as) = (go (SS (SS n)) as, a)
go _ _ = error "tuplify: length mismatch"
Trying it out:
tuplify (SS (SS (SS SZ))) [1, 2, 3] -- ((1, 2), 3)
Writing out the naturals is quite arduous now, so let's introduce some syntactic sugar:
type family N n where
N 0 = Z
N n = S (N (n Lit.- 1))
type SN n = Sing (N n)
Now:
tuplify (sing:: SN 10) [1..10] -- (((((((((1,2),3),4),5),6),7),8),9),10)
As a side note, if we convert the empty list to () (and thereby also allow one-element nested tuples) our definitions become much more natural:
type family NTup n a where
NTup Z a = ()
NTup (S n) a = (NTup n a, a)
tuplify :: Sing n -> [a] -> NTup n a
tuplify n = go n . reverse where
go :: Sing n -> [a] -> NTup n a
go SZ [] = ()
go (SS n) (a:as) = (go n as, a)
go _ _ = error "tuplify: length mismatch"
tuplify (sing:: SN 5) [1..5] -- ((((((),1),2),3),4),5)
This would be a nice exercise in Agda with dependent types. In Haskell you can achieve something close with (also inspired from Daniel Wagner's solution)
class C a b where
listToTuple :: [a] -> b
instance C a a where
listToTuple [x] = x
instance C a b => C a (b,a) where
listToTuple xs = (listToTuple (init xs), last xs)
Some tests:
> listToTuple [1..3::Int] :: ((Int,Int),Int)
((1,2),3)
> listToTuple [0..3::Int] :: (((Int,Int),Int),Int)
(((0,1),2),3)
Note that the return type annotation is mandatory, otherwise Haskell can not deduce how many elements the return tuple must have. If there is a mismatch between the tuple and list length, a run-time error occurs. This is pretty much unavoidable since lists do not carry their length in their type, so the compiler can not check this earlier (unlike using a vector GADT).
In order to have such a generic and type-safe function, you'd need dependent types so that the number of nested tuples in the result could depend on the length of the input list.
However it's possible to get close to that with polymorphic recursion.
Let's define a data type as follows:
data TupleList' r a = Value r | Tuple (TupleList' (r, a) a)
deriving (Show, Read, Eq, Ord)
type TupleList = TupleList' ()
So a value of type TupleList a is isomorphic to (), ((), a), (((), a), a) etc, depending on how many Tuple constructors wrap the final Value.
Now we can convert a list into such a tuple as follows:
fromList :: [a] -> TupleList a
fromList = loop ()
where
loop :: r -> [a] -> TupleList' r a
loop r [] = Value r
loop r (x:xs) = Tuple (loop (r, x) xs)
Notice that loop uses polymorphic recursion (as any function that operates on TupleList' - its recursive call has signature (r, a) -> [a] -> TupleList' (r, a) a.
Example: mapM_ (print . fromList) (inits [1..4]) yields
Value ()
Tuple (Value ((),1))
Tuple (Tuple (Value (((),1),2)))
Tuple (Tuple (Tuple (Value ((((),1),2),3))))
Tuple (Tuple (Tuple (Tuple (Value (((((),1),2),3),4)))))
The simplest way is
z (x:xs) = x
s r (x:xs) = (x, r xs)
toTuples n xs = n xs
But toTuples returns pairs in the reverse order:
toTuples (s (s (s z))) [1..] == (1,(2,(3,4)))
We can use CPS to fix this:
z f xs = f ()
s r f (x:xs) = r (\p -> (f p, x)) xs
toTuples n (x:xs) = n (const x) xs
Then
toTuples (s (s (s z))) [1..] == (((1,2),3),4)
And we can define some syntactic sugar (I'm mostly stealing from András Kovács' answer):
{-# LANGUAGE TemplateHaskell, UndecidableInstances, DataKinds, GADTs, TypeFamilies, TypeOperators #-}
import Data.Singletons.TH
import GHC.TypeLits
$(singletons [d| data Nat = Z | S Nat deriving (Eq, Show) |])
z f xs = f ()
s r f (x:xs) = r (\p -> (f p, x)) xs
toTuples n (x:xs) = n (const x) xs
type family Result n r a where
Result Z r a = r
Result (S n) r a = Result n (r, a) a
run :: Sing n -> (() -> r) -> [a] -> Result n r a
run SZ = z
run (SS sn) = s (run sn)
toTuplesN :: Sing n -> [a] -> Result n a a
toTuplesN sn (x:xs) = run sn (const x) xs
type family N n where
N 0 = Z
N n = S (N (n - 1))
type SN n = Sing (N (n - 1))
main = print $ toTuplesN (sing :: SN 6) [1..] -- (((((1,2),3),4),5),6)
Note that the code works for infinite lists too, since there is no reversing.