It's easy to prove
f : Nat -> Nat
proveMe : (x : Nat) -> Maybe Nat
proveMe x = if (f x) == 0 then Just 42 else Nothing
theProof : (x : Nat) -> (f x = Z) -> (Just 42 = proveMe x)
theProof x prf = rewrite prf in Refl
But what if the calculation of Just 42 requires the proof that f x = 0?
proveMe2 : (x : Nat) -> Maybe Nat
proveMe2 x with (decEq (f x) Z)
| Yes prf = Just 42
| No _ = Nothing
theProof2 : (x : Nat) -> (f x = Z) -> (Just 42 = proveMe2 x)
theProof2 x prf = ?howToFillThis
How can I prove it now?
I tried to "follow the structure of the with clause", but when doing so I would have to convince idris that the contra-case is impossible:
theProof3 : (x : Nat) -> (f x = Z) -> (Just 42 = proveMe2 x)
theProof3 x prf with (decEq (f x) Z)
| Yes prf2 = Refl
| No contra impossible -- "...is a valid case"
I had completely forgotten about void : Void -> a. Using Ex falso quodlibet the proof is simply
theProof3 : (x : Nat) -> (f x = Z) -> (Just 42 = proveMe2 x)
theProof3 x prf with (decEq (f x) Z)
| Yes prf2 = Refl
| No contra = void $ contra prf
Related
In the following code (which is an attempt to solve an exercise from 'Software Foundations' [chapter on Lists]), Idris reports a very complex type for countSingleton_rhs. The type includes a complex expression having the following at its core: case decEq x x of ....
module CountSingleton
data NatList : Type where
Nil : NatList
(::) : Nat -> NatList -> NatList
-- count occurrences of a value in a list
count : (v : Nat) -> (s : NatList) -> Nat
count _ [] = Z
count Z (Z :: ns) = S (count Z ns)
count Z (_ :: ns) = count Z ns
count j#(S _) (Z :: ns) = count j ns
count (S j) ((S k) :: ns) =
case decEq j k of
Yes Refl => S (count (S j) ns)
No _ => count (S j) ns
-- to prove
countSingleton : (v : Nat) -> (count v [v]) = S Z
countSingleton Z = Refl
countSingleton (S k) = ?countSingleton_rhs
Why isn't Idris simplifying decEq x x to Yes Refl?
Is there a better way to implement count which avoids this behaviour?
What can I do to simplify/rewrite the types in order to make progress?
Your count function is more splitted than it needs to. If you check for decEq x y anyway, you can unify all cases except count _ [] = Z:
count : (v : Nat) -> (s : NatList) -> Nat
count _ [] = Z
count x (y :: ns) = case decEq x y of
Yes Refl => S (count x ns)
No _ => count x ns
The straight-forward way to prove countSingleton is to follow the flow. Your countSingleton_rhs has a complex type, because the type is a case switch, depending on the result of decEq v v. Using with Idris can apply the result of the branch to the resulting type.
countSingleton : (v : Nat) -> (count v [v]) = S Z
countSingleton v with (decEq v v)
| Yes prf = Refl
| No contra = absurd $ contra Refl
As you have noted, this seems a bit redundant, as decEq x x is clearly Yes Refl. Luckily it is already proven in the library: decEqSelfIsYes : DecEq a => decEq x x = Yes Refl, which we can use to rewrite the resulting type:
countSingleton : (v : Nat) -> (count v [v]) = S Z
countSingleton v = rewrite decEqSelfIsYes {x=v} in Refl
Unfortunately because of an open issue, rewriting case types doesn't always work. But you can just rewrite count with with to circumvent this issue:
count : (v : Nat) -> (s : NatList) -> Nat
count _ [] = Z
count x (y :: ns) with (decEq x y)
| Yes _ = S (count x ns)
| No _ = count x ns
I am learning Idris and I have a bit of a noob question.
I am doing exercise 2 of chapter 8.3 of the book on type driven development with Idris. The point is to implement DecEq for your own Vector. This is how far I got:
data Vect : Nat -> Type -> Type where
Nil : Vect 0 elem
(::) : elem -> Vect n elem -> Vect (S n) elem
headUnequal : {xs : Vect n a} -> {ys : Vect n a} -> (contra : (x = y) -> Void) -> ((x :: xs) = (y :: ys)) -> Void
headUnequal contra Refl = contra Refl
tailsUnequal : {xs : Vect n a} -> {ys : Vect n a} -> (contra : (xs = ys) -> Void) -> ((x :: xs) = (y :: ys)) -> Void
tailsUnequal contra Refl = contra Refl
headAndTailEq : {xs : Vect n a} -> {ys : Vect n a} -> (xEqY : x = y) -> (xsEqYs : xs = ys) -> ((x :: xs) = (y :: ys))
headAndTailEq xEqY xsEqYs = ?hole
implementation DecEq a => DecEq (Vect n a) where
decEq [] [] = Yes Refl
decEq (x :: xs) (y :: ys) =
case decEq x y of
No xNeqY => No $ headUnequal xNeqY
Yes xEqY => case decEq xs ys of
No xsNeqYs => No $ tailsUnequal xsNeqYs
Yes xsEqYs => Yes $ headAndTailEq xEqY xsEqYs
How do I fill ?hole?
I've seen the solution on https://github.com/edwinb/TypeDD-Samples/blob/master/Chapter8/Exercises/ex_8_3.idr. With that knowledge I can make my solution work:
implementation DecEq a => DecEq (Vect n a) where
decEq [] [] = Yes Refl
decEq (x :: xs) (y :: ys) =
case decEq x y of
No xNeqY => No $ headUnequal xNeqY
Yes Refl => case decEq xs ys of
No xsNeqYs => No $ tailsUnequal xsNeqYs
Yes Refl => Yes Refl
But honestly, why does this work? Why does the final Yes Refl only work if I don't name the proofs?
Thank you!
The important difference is the value matching in the case-blocks, not the naming of the proofs. If you inspect the first case with
decEq (x :: xs) (y :: ys) =
case decEq x y of
No xNeqY => No $ headUnequal xNeqY
Yes Refl => ?hole
you will see, that the ?hole only needs Dec (x :: xs = x :: ys). In your version on the other hand, ?hole is Dec (x :: xs = y :: ys):
decEq (x :: xs) (y :: ys) =
case decEq x y of
No xNeqY => No $ headUnequal xNeqY
Yes xEqY => ?hole
Here, xEqY : x = y. Idris has no special understanding of =, so this simply means, that there is a value xEqY that has the type x = y (and there is no further inspection on what xEqY could be). If you match on Refl, Idris can unify x and y, because Refl is a constructor for x = x - the values are the same. Thus you gain more information with pattern matching; instead of an opaque variable name, you get a concrete value. As a rule of thumb: always pattern match until you have enough information on the right hand side.
With this, your proof can also be implemented easily:
headAndTailEq : {xs : Vect n a} -> {ys : Vect n a} -> (xEqY : x = y) -> (xsEqYs : xs = ys) -> ((x :: xs) = (y :: ys))
headAndTailEq Refl Refl = Refl
I have a function count in idris, defined as :
count : Eq a => a -> Vect n a -> Nat
count x [] = Z
count x (y::ys) = with (x == y)
| True = S (count x ys)
| False = count x ys
And a proof of the maximum value count can return:
countLTELen : Eq a => (x : a) -> (l : Vect n a) -> LTE (count x l) n
countLTELen x [] = lteRefl
countLteLen x (y::ys) with (x == y)
| True = LTESucc (countLTELen x ys)
| False = lteSuccRight (countLTELen x ys)
which is all well and good. I now want to write a function which removes all of an element from a list, removeAll :
removeAll : Eq a => (x : a) -> (l : Vect n a) -> Vect (n - (count x l)) a
removeAll x [] = []
removeAll x (y::ys) with (x == y)
| True = removeAll x ys
| False = x :: removeAll x ys
But this definition gives an error:
|
56 | removeAll : Eq a => (x : a) -> (l : Vect n a) -> Vect (n - (count x l)) a
| ^
When checking type of Proof.removeAll:
When checking argument smaller to function Prelude.Nat.-:
Can't find a value of type
LTE (count a n constraint x l) n
How can I use my proof to inform Idris that this type signature is correct?
Right now, Idris can't find the proof {auto smaller : LTE n m} for (-).
So either you need to be explicit:
removeAll : Eq a => (x : a) -> (l : Vect n a) ->
Vect ((-) {smaller=countLTELen x l} n (count x l) ) a
Or, because smaller is an auto-argument, you can hint the compiler to your proof function. Then this function will be tried when auto-finding a value for LTE (count x l) n.
%hint
countLTELen : Eq a => (x : a) -> (l : Vect n a) -> LTE (count x l) n
I'm building a little dependently-typed lambda calculus interpreter:
import Data.Vect
%default total
{- fin helper functions and lemmas -}
incrFin : Fin n -> Fin (S n) -> Fin (S n)
incrFin x FZ = FS x
incrFin FZ (FS y) = FZ
incrFin (FS x) (FS y) = FS (incrFin x y)
subrFin : (x : Fin (S n)) -> (y : Fin (S n)) -> (x = y -> Void) -> Fin n
subrFin FZ FZ neq = absurd (neq Refl)
subrFin FZ (FS x) neq = x
subrFin {n = S n} (FS x) FZ neq = FZ
subrFin {n = S n} (FS x) (FS y) neq = FS (subrFin x y (\Refl => neq Refl))
indexOfIncrFin : (x : Fin (S n)) -> (y : Fin n) -> (env : Vect n a) -> (t : a) ->
index (incrFin y x) (insertAt x t env) = index y env
{- elided -}
indexOfSubrFin : {n : Nat} -> {env : Vect n a} -> (neq : (x = y) -> Void) ->
index (subrFin x y neq) env = index y (insertAt x t2 env)
{- elided -}
indexInsertAt : (x : Fin (S n)) -> (t : a) -> (env : Vect n a) -> index x (insertAt x t env) = t
{- elided -}
incrFinChanges : (x : Fin n) -> (y : Fin (S n)) -> Not (incrFin x y = y)
{- elided -}
{- main code -}
data Ty = Base | Arrow Ty Ty
data Expr : Vect n Ty -> Ty -> Type where
Var : (x : Fin n) -> index x env = t -> Expr env t
Con : Expr env Base
App : Expr env (Arrow t1 t2) -> Expr env t1 -> Expr env t2
Abs : (t1 : Ty) -> Expr (t1 :: env) t2 -> Expr env (Arrow t1 t2)
incr : (x : Fin (S n)) -> (tt : Ty) -> Expr env t -> Expr (insertAt x tt env) t
incr x tt (Var y Refl) {env = env} = Var (incrFin y x) (indexOfIncrFin x y env tt)
incr x tt Con = Con
incr x tt (App e1 e2) = App (incr x tt e1) (incr x tt e2)
incr x tt (Abs t1 e) = Abs t1 (incr (FS x) tt e)
subst : (x : Fin (S n)) -> Expr env t' -> Expr (insertAt x t' env) t -> Expr env t
subst {env = env} {t' = t'} x e' (Var y pf) with (decEq x y)
subst {env = env} {t' = t'} x e' (Var x Refl) | Yes Refl = rewrite indexInsertAt x t' env in e'
subst {env = env} {t' = t'} x e' (Var y Refl) | No neq = Var (subrFin x y neq) (indexOfSubrFin neq)
subst x e' Con = Con
subst x e' (App e1 e2) = App (subst x e' e1) (subst x e' e2)
subst x e' (Abs t1 e) = Abs t1 (subst (FS x) (incr FZ t1 e') e)
substIncr : (x : Fin (S n)) -> (e' : Expr env t') -> (e : Expr env t) -> subst x e' (incr x t' e) = e
substIncr x e' (Var y Refl) with (decEq x (incrFin y x))
substIncr x e' (Var y Refl) | Yes eq = absurd (incrFinChanges y x (sym eq))
substIncr x e' (Var y Refl) | No neq = ?substIncr_missingCase
substIncr x e' Con = Refl
substIncr x e' (App e1 e2) = rewrite substIncr x e' e1 in rewrite substIncr x e' e2 in Refl
substIncr x e' (Abs t1 e) = rewrite substIncr (FS x) (incr FZ t1 e') e in Refl
The problem is the last missing case of the substIncr proof. The type won't reduce, because subst only reduces when the proof in Var is identically Refl, and instead it's indexOfIncrFin x y env t'. Now, indexOfIncrFin is total, it always returns Refl, but its type isn't just f x y = z; it, instead, has a complicated term on either side of the equality (index (incrFin y x) (insertAt x t env) = index y env). So when I try to match on it, via with or case, it complains about "type mismatch between index y env = index y env (type of Refl) and index (incrFin y x) (insertAt x t' env) = index y env (expected type)."
The only other thing I could think of was to change the definition of subst to rewrite instead of matching on Refl, but that (a) is kinda uglier, and (b) bogs me down in some kind of rewrite__impl type I understand even less, and which also won't reduce.
Any ideas on how to work around this?
Given:
*section3> :module Data.Vect
*section3> :let e = the (Vect 0 Int) []
*section3> :let xs = the (Vect _ _) [1,2]
*section3> decEq xs e
(input):1:7:When checking argument x2 to function Decidable.Equality.decEq:
Type mismatch between
Vect 0 Int (Type of e)
and
Vect 2 Integer (Expected type)
Specifically:
Type mismatch between
0
and
2
Why must the Nat arguments equal each other for DecEq?
Note - posted in https://groups.google.com/forum/#!topic/idris-lang/qgtImCLka3I originally
decEq is for homogenous propositional equality:
||| Decision procedures for propositional equality
interface DecEq t where
||| Decide whether two elements of `t` are propositionally equal
total decEq : (x1 : t) -> (x2 : t) -> Dec (x1 = x2)
As you can see, x1 and x2 are both of type t. In your case, you have x1 : Vect 2 Integer and x2 : Vect 0 Int. These are two different types.
You can write your own heterogenous equality decider for Vectors of the same element type by first checking their lengths, then delegating to the homogenous version:
import Data.Vect
vectLength : {xs : Vect n a} -> {ys : Vect m a} -> xs = ys -> n = m
vectLength {n = n} {m = n} Refl = Refl
decEqVect : (DecEq a) => (xs : Vect n a) -> (ys : Vect m a) -> Dec (xs = ys)
decEqVect {n = n} {m = m} xs ys with (decEq n m)
decEqVect xs ys | Yes Refl = decEq xs ys
decEqVect xs ys | No notEq = No (notEq . vectLength)