I was trying to prove that replicate1 works correctly by showing that all elements of replicate1 n x are x:
all1 : (p : a -> Bool) -> List a -> Bool
all1 p [] = True
all1 p (x :: xs) = p x && all1 p xs
replicate1 : (n: Nat) -> a -> List a
replicate1 Z x = [x]
replicate1 (S k) x = x :: replicate1 k x
all_replicate_is_x : Eq a => {x: a} -> all1 (== x) (replicate1 n x) = True
all_replicate_is_x {n = Z} = ?hole
all_replicate_is_x {n = (S k)} = ?all_replicate_is_x_rhs_2
The base case hole is
Test.hole [P]
`-- a : Type
constraint : Eq a
x : a
-----------------------------------------
Test.hole : x == x && Delay True = True
How to prove this?
Related
I am stuck with Idris (again, sigh). I am doing an exercise on merge sort from the type driven development with Idris book on chapter 10. I have this:
import Data.Vect
import Data.Vect.Views
sort2 : Ord a => (l: a) -> (r: a) -> (a, a)
sort2 l r = if l <= r then (l, r) else (r, l)
needHelp : Vect (S (S (n + m))) a -> Vect (S (plus n (S m))) a
needHelp {n=(S n)} {m=(S m)} (x :: xs) = ?help
vectMerge : Ord a => Vect n a -> Vect m a -> Vect (n + m) a
vectMerge [] ys = ys
vectMerge {n} xs [] = rewrite plusZeroRightNeutral n in xs
vectMerge {n=(S n)} {m=(S m)} (x :: xs) (y :: ys) =
let (f, s) = sort2 x y in
needHelp (f :: s :: (vectMerge xs ys))
I have isolated the needHelp function so you can see the rewrite that I want to achieve. I tried this:
vectMerge : Ord a => Vect n a -> Vect m a -> Vect (n + m) a
vectMerge [] ys = ys
vectMerge {n} xs [] = rewrite plusZeroRightNeutral n in xs
vectMerge {n=(S n)} {m=(S m)} (x :: xs) (y :: ys) =
let (f, s) = sort2 x y in
let tail = (rewrite plusSuccRightSucc n m in s :: vectMerge xs ys) in
f :: tail
But Idris complains:
When checking right hand side of Main.case block in vectMerge with expected type
Vect (S (plus n (S m))) a
rewriting S (plus n m) to plus n (S m) did not change type letty
I don't understand why this doesn't work. Help much appreciated.
rewrite works with respect to your current goal, not wrt to the term you are trying to use to solve the goal (I tried to illustrate it in this answer).
So, here is a possible solution:
import Data.Vect
sort2 : Ord a => (l: a) -> (r: a) -> (a, a)
sort2 l r = if l <= r then (l, r) else (r, l)
vectMerge : Ord a => Vect n a -> Vect m a -> Vect (n + m) a
vectMerge [] ys = ys
vectMerge {n} xs [] = rewrite plusZeroRightNeutral n in xs
vectMerge {n=(S n)} {m=(S m)} (x :: xs) (y :: ys) =
let (f, s) = sort2 x y in
rewrite sym $ plusSuccRightSucc n m in
(f :: s :: (vectMerge xs ys))
sym in sym $ plusSuccRightSucc n m reverses the direction of rewrite.
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?
I'm trying to write in Idris a function that create a Vect by passing the size of the Vect and a function taking the index in parameter.
So far, I've this :
import Data.Fin
import Data.Vect
generate: (n:Nat) -> (Nat -> a) ->Vect n a
generate n f = generate' 0 n f where
generate': (idx:Nat) -> (n:Nat) -> (Nat -> a) -> Vect n a
generate' idx Z f = []
generate' idx (S k) f = (f idx) :: generate' (idx + 1) k f
But I would like to ensure that the function passed in parameter is only taking index lesser than the size of the Vect.
I tried that :
generate: (n:Nat) -> (Fin n -> a) ->Vect n a
generate n f = generate' 0 n f where
generate': (idx:Fin n) -> (n:Nat) -> (Fin n -> a) -> Vect n a
generate' idx Z f = []
generate' idx (S k) f = (f idx) :: generate' (idx + 1) k f
But it doesn't compile with the error
Can't convert
Fin n
with
Fin (S k)
My question is : is what I want to do possible and how ?
The key idea is that the first element of the vector is f 0, and for the tail, if you have k : Fin n, then FS k : Fin (S n) is a "shift" of the finite number that increments its value and its type at the same time.
Using this observation, we can rewrite generate as
generate : {n : Nat} -> (f : Fin n -> a) -> Vect n a
generate {n = Z} f = []
generate {n = S _} f = f 0 :: generate (f . FS)
Another possibility is to do what #dfeuer suggested and generate a vector of Fins, then map f over it:
fins : (n : Nat) -> Vect n (Fin n)
fins Z = []
fins (S n) = FZ :: map FS (fins n)
generate' : {n : Nat} -> (f : Fin n -> a) -> Vect n a
generate' f = map f $ fins _
Proving generate f = generate' f is left as en exercise to the reader.
Cactus's answer appears to be about the best way to get what you asked for, but if you want something that can be used at runtime, it will be quite inefficient. The essential reason for this is that to weaken a Fin n to a Fin n+m requires that you completely deconstruct it to change the type of its FZ, and then build it back up again. So there can be no sharing at all between the Fin values produced for each vector element. An alternative is to combine a Nat with a proof that it is below a given bound, which leads to the possibility of erasure:
data NFin : Nat -> Type where
MkNFin : (m : Nat) -> .(LT m n) -> NFin n
lteSuccLeft : LTE (S n) m -> LTE n m
lteSuccLeft {n = Z} prf = LTEZero
lteSuccLeft {n = (S k)} {m = Z} prf = absurd (succNotLTEzero prf)
lteSuccLeft {n = (S k)} {m = (S j)} (LTESucc prf) = LTESucc (lteSuccLeft prf)
countDown' : (m : Nat) -> .(m `LTE` n) -> Vect m (NFin n)
countDown' Z mLTEn = []
countDown' (S k) mLTEn = MkNFin k mLTEn :: countDown' k (lteSuccLeft mLTEn)
countDown : (n : Nat) -> Vect n (NFin n)
countDown n = countDown' n lteRefl
countUp : (n : Nat) -> Vect n (NFin n)
countUp n = reverse $ countDown n
generate : (n : Nat) -> (NFin n -> a) -> Vect n a
generate n f = map f (countUp n)
As in the Fin approach, the function you pass to generate does not need to work on all naturals; it only needs to handle ones less than n.
I used the NFin type to explicitly indicate that I want the LT m n proof to be erased in all cases. If I didn't want/need that, I could just use (m ** LT m n) instead.
Suppose I have a function with this signature:
myNatToFin : (m : Nat) -> (n : Nat) -> { auto p : n `GT` m } -> Fin n
I try to apply it like this myNatToFin k (S k) in the body of another function and I get the error:
Can't solve goal
GT (S k) k
So, I believe I have to explicitly pass a proof that GT (S k) k, but I have no idea how to do this. How can I explicitly pass the implicit proof argument so that this compiles?
You can give explicit arguments for implicit parameters by enclosing them in braces and prefixing with the parameter name, like {p = someExpression foo}.
Full example:
import Data.Fin
myNatToFin : (m : Nat) -> (n : Nat) -> { auto p : n `GT` m } -> Fin n
myNatToFin m n = ?x -- See https://stackoverflow.com/questions/29908731/
lteRefl : LTE n n
lteRefl {n = Z} = LTEZero
lteRefl {n = S _} = LTESucc lteRefl
foo : (k : Nat) -> Fin (S k)
foo k = myNatToFin k (S k) {p = LTESucc lteRefl}