I wonder if it is possible to implement something like contrib's Data.SortedMapwhere, as an example, the key type could be Key n and the value type be Value n where n is the same Nat?
For a Map (Key n) (Value n) (which fails with "No such variable n") some usual functions would then have types like these
Key : Nat -> Type
Value : Nat -> Type
lookup : {n : Nat} -> Key n -> WonderMap Key Value -> Maybe (Value n)
insert : {n : Nat} -> Key n -> Value n -> WonderMap Key Value -> WonderMap Key Value
I tried the following using dependent pairs
MyMap : Type
MyMap = SortedMap (n ** Key n) (n **Value n)
but I think the ns here are not the same one so it is interpreted like
MyMap = SortedMap (n ** Key n) (x ** Value x)
in other words, the Key and Value types are not "connected" in the way I would like, i.e. a Value n can only be stored underKey n and lookup for a Key n always returns a Value n.
And
MyOtherMap : Nat -> Type
MyOtherMap n = SortedMap (Key n) (Value n)
should create a map type indexed by n : Nat so I could not store Value 1 values under Key 1 keys and Value 7 values under Key 7 keys in the same map.
Is it possible to implement the map type I want where a family of key types are used to store a corresponding family of value types? (Other than having one MyOtherMap for each n : Nat and then have all those bundled up in a larger structure, see my answer)
This answer isn't really a solution to my problem, it is more just a way to show what I want to achieve (and it is not even the most general case).
So please do not dismiss my question as already answered. ;-) Thank you!
I thought I'd try to implement the naive approach. This can't be the easiest way.
import Data.SortedMap
-- pretty much a Vector
data Key : Type -> Nat -> Type where
KNil : Key a 0
KCons : a -> Key a n -> Key a (S n)
Eq a => Eq (Key a n) where
KNil == KNil = True
(KCons x xs) == (KCons y ys) = x == y && xs == ys
Ord a => Ord (Key a n) where
compare KNil KNil = EQ
compare (KCons x xs) (KCons y ys) = case compare x y of
EQ => compare xs ys
x => x
-- same as Key
data Value : Type -> Nat -> Type where
VNil : Value a 0
VCons : a -> Value a n -> Value a (S n)
-- Map for keys and values of a fixed length
NatIndexedMap : (Nat -> Type) -> (Nat -> Type) -> Nat -> Type
NatIndexedMap k v n = SortedMap (k n) (v n)
nim2 : NatIndexedMap (Key Nat) (Value String) 2
nim2 = SortedMap.fromList [(KCons 0 (KCons 0 KNil), VCons "a" (VCons "a" VNil))]
nim3 : NatIndexedMap (Key Nat) (Value String) 3
nim3 = SortedMap.fromList [(KCons 0 (KCons 0 (KCons 0 KNil)), VCons "a" (VCons "a" (VCons "a" VNil)))]
-- List of maps with keys and values which increase in length
data WonderMap : (Nat -> Type) -> (Nat -> Type) -> Nat -> Type where
WonderMapNil : {k : Nat -> Type} -> {v : Nat -> Type} -> WonderMap k v 0
WonderMapCons : {n : Nat} -> {k : Nat -> Type} -> {v : Nat -> Type}
-> NatIndexedMap k v (S n) -> WonderMap k v n -> WonderMap k v (S n)
wm : WonderMap (Key Nat) (Value String) 3
wm = WonderMapCons nim3 (WonderMapCons nim2 (WonderMapCons SortedMap.empty WonderMapNil))
-- will return Nothing if Key n > Map n
lookup : {n : Nat} -> {m : Nat} -> {k : Nat -> Type} -> {v : Nat -> Type} -> k n -> WonderMap k v m -> Maybe (v n)
lookup {n = Z} _ WonderMapNil = Nothing
lookup {m = Z} _ _ = Nothing
lookup {n = S n'} {m = S m'} key (WonderMapCons map maps) =
case decEq (S n') (S m') of
Yes prf => SortedMap.lookup key (rewrite prf in map)
No _ => if (S n') < (S m')
then lookup key maps
else Nothing
This way we need an empty map for every empty key length. It's also not quite as general as it should be.
$ idris -p contrib WonderMap.idr
____ __ _
/ _/___/ /____(_)____
/ // __ / ___/ / ___/ Version 1.3.1
_/ // /_/ / / / (__ ) http://www.idris-lang.org/
/___/\__,_/_/ /_/____/ Type :? for help
Idris is free software with ABSOLUTELY NO WARRANTY.
For details type :warranty.
*WonderMap> :t wm
wm : WonderMap (Key Nat) (Value String) 3
*WonderMap> lookup (KCons 0 KNil) wm -- there are no key/value pairs for n = 0
Nothing : Maybe (Value String 1)
*WonderMap> lookup (KCons 0 (KCons 0 KNil)) wm
Just (VCons "a" (VCons "a" VNil)) : Maybe (Value String 2)
*WonderMap> lookup (KCons 0 (KCons 0 (KCons 0 KNil))) wm
Just (VCons "a" (VCons "a" (VCons "a" VNil))) : Maybe (Value String 3)
*WonderMap> lookup (KCons 0 (KCons 0 (KCons 1 KNil))) wm -- good n, bad key
Nothing : Maybe (Value String 3)
*WonderMap> lookup (KCons 0 (KCons 0 (KCons 0 (KCons 0 KNil)))) wm -- wm only has key/value pairs for n <= 3
Nothing : Maybe (Value String 4)
Related
Whereby I could construct an anonymous, ad-hoc record; that's editable, appendable, modifiable, where each value can have different heterogenous type, and where the compiler checks that the consumers type expectations unify with the types of the produced record at all the given keys?
Similar to what Purescript supports.
It could, but there isn't a module in the standard library, and the two github projects gonzaw/extensible-records and jmars/Records don't seem to be full-fledged/outdated.
You might need to implement it for yourself. The rough idea is:
import Data.Vect
%default total
data Record : Vect n (String, Type) -> Type where
Empty : Record []
Cons : (key : String) -> (val : a) -> Record rows -> Record ((key, a) :: rows)
delete : {k : Vect (S n) (String, Type)} -> (key : String) ->
Record k -> {auto prf : Elem (key, a) k} -> Record (Vect.dropElem k prf)
delete key (Cons key val r) {prf = Here} = r
delete key (Cons oth val Empty) {prf = (There later)} = absurd $ noEmptyElem later
delete key (Cons oth val r#(Cons x y z)) {prf = (There later)} =
Cons oth val (delete key r)
update : (key : String) -> (new : a) -> Record k -> {auto prf : Elem (key, a) k} -> Record k
update key new (Cons key val r) {prf = Here} = Cons key new r
update key new (Cons y val r) {prf = (There later)} = Cons y val $ update key new r
get : (key : String) -> Record k -> {auto prf : Elem (key, a) k} -> a
get key (Cons key val x) {prf = Here} = val
get key (Cons x val y) {prf = (There later)} = get key y
With this we can write functions that handle fields without knowing the full record type:
rename : (new : String) -> Record k -> {auto prf : Elem ("name", String) k} -> Record k
rename new x = update "name" new x
forgetAge : Record k -> {auto prf : Elem ("age", Nat) k} -> Record (dropElem k prf)
forgetAge k = delete "age" k
getName : Record k -> {auto prf : Elem ("name", String) k} -> String
getName r = get "name" r
S0 : Record [("name", String), ("age", Nat)]
S0 = Cons "name" "foo" $ Cons "age" 20 $ Empty
S1 : Record [("name", String)]
S1 = forgetAge $ rename "bar" S0
ok1 : getName S1 = "bar"
ok1 = Refl
ok2 : getName S0 = "foo"
ok2 = Refl
Of course you can simplify and prettify this alot with syntax rules.
I have the following inductive type MyVec:
import Data.Vect
data MyVec: {k: Nat} -> Vect k Nat -> Type where
Nil: MyVec []
(::): {k, n: Nat} -> {v: Vect k Nat} -> Vect n Nat -> MyVec v -> MyVec (n :: v)
-- example:
val: MyVec [3,2,3]
val = [[2,1,2], [0,2], [1,1,0]]
That is, the type specifies the lengths of all vectors inside a MyVec.
The problem is, val will have k = 3 (k is the number of vectors inside a MyVec), but the ctor :: does not know this fact. It will first build a MyVec with k = 1, then with 2, and finally with 3. This makes it impossible to define constraints based on the final shape of the value.
For example, I cannot constrain the values to be strictly less than k. Accepting Vects of Fin (S k) instead of Vects of Nat would rule out some valid values, because the last vectors (the first inserted by the ctor) would "know" a smaller value of k, and thus a stricter contraint.
Or, another example, I cannot enforce the following constraint: the vector at position i cannot contain the number i. Because the final position of a vector in the container is not known to the ctor (it would be automatically known if the final value of k was known).
So the question is, how can I enforce such global properties?
There are (at least) two ways to do it, both of which may require tracking additional information in order to check the property.
Enforcing properties in the data definition
Enforcing all elements < k
I cannot constrain the values to be strictly less than k. Accepting Vects of Fin (S k) instead of Vects of Nat would rule out some valid values...
You are right that simply changing the definition of MyVect to have Vect n (Fin (S k)) in it would not be correct.
However, it is not too hard to fix this by generalizing MyVect to be polymorphic, as follows.
data MyVec: (A : Type) -> {k: Nat} -> Vect k Nat -> Type where
Nil: {A : Type} -> MyVec A []
(::): {A : Type} -> {k, n: Nat} -> {v: Vect k Nat} -> Vect n A -> MyVec A v -> MyVec A (n :: v)
val : MyVec (Fin 3) [3,2,3]
val = [[2,1,2], [0,2], [1,1,0]]
The key to this solution is separating the type of the vector from k in the definition of MyVec, and then, at top level, using the "global value of k to constrain the type of vector elements.
Enforcing vector at position i does not contain i
I cannot enforce that the vector at position i cannot contain the number i because the final position of a vector in the container is not known to the constructor.
Again, the solution is to generalize the data definition to keep track of the necessary information. In this case, we'd like to keep track of what the current position in the final value will be. I call this index. I then generalize A to be passed the current index. Finally, at top level, I pass in a predicate enforcing that the value does not equal the index.
data MyVec': (A : Nat -> Type) -> (index : Nat) -> {k: Nat} -> Vect k Nat -> Type where
Nil: {A : Nat -> Type} -> {index : Nat} -> MyVec' A index []
(::): {A : Nat -> Type} -> {k, n, index: Nat} -> {v: Vect k Nat} ->
Vect n (A index) -> MyVec' A (S index) v -> MyVec' A index (n :: v)
val : MyVec' (\n => (m : Nat ** (n == m = False))) 0 [3,2,3]
val = [[(2 ** Refl),(1 ** Refl),(2 ** Refl)], [(0 ** Refl),(2 ** Refl)], [(1 ** Refl),(1 ** Refl),(0 ** Refl)]]
Enforcing properties after the fact
Another, sometimes simpler way to do it, is to not enforce the property immediately in the data definition, but to write a predicate after the fact.
Enforcing all elements < k
For example, we can write a predicate that checks whether all elements of all vectors are < k, and then assert that our value has this property.
wf : (final_length : Nat) -> {k : Nat} -> {v : Vect k Nat} -> MyVec v -> Bool
wf final_length [] = True
wf final_length (v :: mv) = isNothing (find (\x => x >= final_length) v) && wf final_length mv
val : (mv : MyVec [3,2,3] ** wf 3 mv = True)
val = ([[2,1,2], [0,2], [1,1,0]] ** Refl)
Enforcing vector at position i does not contain i
Again, we can express the property by checking it, and then asserting that the value has the property.
wf : (index : Nat) -> {k : Nat} -> {v : Vect k Nat} -> MyVec v -> Bool
wf index [] = True
wf index (v :: mv) = isNothing (find (\x => x == index) v) && wf (S index) mv
val : (mv : MyVec [3,2,3] ** wf 0 mv = True)
val = ([[2,1,2], [0,2], [1,1,0]] ** Refl)
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)
Given the following from Type-Driven Development with Idris:
import Data.Vect
data EqNat : (num1 : Nat) -> (num2 : Nat) -> Type where
Same : (num : Nat) -> EqNat num num
sameS : (eq : EqNat k j) -> EqNat (S k) (S j)
sameS (Same n) = Same (S n)
checkEqNat : (num1 : Nat) -> (num2 : Nat) -> Maybe (EqNat num1 num2)
checkEqNat Z Z = Just $ Same Z
checkEqNat Z (S k) = Nothing
checkEqNat (S k) Z = Nothing
checkEqNat (S k) (S j) = case checkEqNat k j of
Just eq => Just $ sameS eq
Nothing => Nothing
exactLength : (len : Nat) -> (input : Vect m a) -> Maybe (Vect len a)
exactLength {m} len input = case (checkEqNat m len) of
Just (Same m) => Just input
Nothing => Nothing
If I replace the last function's Just (Same m) with Just eq, the compiler complains:
*Lecture> :r
Type checking ./Lecture.idr
Lecture.idr:19:75:
When checking right hand side of Main.case block in exactLength at Lecture.idr:18:34 with expected type
Maybe (Vect len a)
When checking argument x to constructor Prelude.Maybe.Just:
Type mismatch between
Vect m a (Type of input)
and
Vect len a (Expected type)
Specifically:
Type mismatch between
m
and
len
Holes: Main.exactLength
How does Just (Same m), i.e. the working code, provide "evidence" that exactLength's len and m are equal?
What I find useful when working with Idris is adding holes when you're not sure about something rather than solving them. Like adding a hole into Just ... branch to see what's going on there:
exactLength : (len : Nat) -> (input : Vect m a) -> Maybe (Vect len a)
exactLength {m} len input = case (checkEqNat m len) of
Just (Same m) => ?hole
Nothing => Nothing
and then change (Same m) to eq and back while looking at the results of type checking. In the eq case it's like this:
- + Main.hole [P]
`-- a : Type
m : Nat
len : Nat
eq : EqNat m len
input : Vect m a
--------------------------------
Main.hole : Maybe (Vect len a)
And in the (Same m) case it's like this:
- + Main.hole_1 [P]
`-- m : Nat
a : Type
input : Vect m a
--------------------------------
Main.hole_1 : Maybe (Vect m a)
So eq is something of a type EqNat m len, no one knows whether it's inhabitant or not, while Same m (or Same len) is definitely inhabitant which proves that m and len are equal.
When you start with
exactLength : (len : Nat) -> (input : Vect m a) -> Maybe (Vect len a)
exactLength {m} len input with (_)
exactLength {m} len input | with_pat = ?_rhs
and gradually extend the missing links until you reached
exactLength : (len : Nat) -> (input : Vect m a) -> Maybe (Vect len a)
exactLength {m} len input with (checkEqNat m len)
exactLength {m = m} len input | Nothing = Nothing
exactLength {m = len} len input | (Just (Same len)) = Just input
you can see how idris can derive from the fact that checkEqNat m len returned a Just (Same ...) that it can then infer that {m = len}. AFAIK just writing Just eq is not a proof that eq is indeed inhabited.
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.