For example, I have the following code:
data Tree = Branches (List Tree) | Node Int
sumTree : Tree -> Int
sumTree (Branches xs) = sum (map sumTree xs)
sumTree (Node x) = x
If I want it pass the totality check, I have to expand map manually:
data Tree = Branches (List Tree) | Node Int
sumTree : Tree -> Int
sumTree (Branches xs) = sum' xs where
sum' [] = 0
sum' (x::xs) = sumTree x + sum' xs
sumTree (Node x) = x
Which makes a lot of power with functional programming not available if I want to avoid assert_total everywhere. Is there any way to workaround this issue?
Related
So I want to partitision a List ItemModel in Elm into List (List ItemModel). List.partition only makes the list into two lists.
I wrote some code that makes the list into the parts I want (code below).
But it's not as nice of a solution as I'd like, and since it seems like an issue many people would have, I wonder are there better examples of doing this?
partition : List (ItemModel -> Bool) -> List ItemModel -> List (List ItemModel)
partition filters models =
let
filterMaybe =
List.head filters
in
case filterMaybe of
Just filter ->
let
part =
Tuple.first (List.partition filter models)
in
part :: (partition (List.drop 1 filters) models)
Nothing ->
[]
The returned list maps directly from the filters parameter, so it's actually pretty straightforward to do this using just List.map and List.filter (which is what you're really doing since you're discarding the remainder list returned from List.partition):
multifilter : List (a -> Bool) -> List a -> List (List a)
multifilter filters values =
filters |> List.map(\filter -> List.filter filter values)
Repeated partitioning needs to use the leftovers from each step as the input for the next step. This is different than simple repeated filtering of the same sequence by several filters.
In Haskell (which this question was initially tagged as, as well),
partitions :: [a -> Bool] -> [a] -> [[a]]
partitions preds xs = go preds xs
where
go [] xs = []
go (p:ps) xs = let { (a,b) = partition p xs } in (a : go ps b)
which is to say,
partitions preds xs = foldr g (const []) preds xs
where
g p r xs = let { (a,b) = partition p xs } in (a : r b)
or
-- mapAccumL :: (acc -> x -> (acc, y)) -> acc -> [x] -> (acc, [y])
partitions preds xs = snd $ mapAccumL (\xs p -> partition (not . p) xs) xs preds
Testing:
> partitions [ (<5), (<10), const True ] [1..15]
[[1,2,3,4],[5,6,7,8,9],[10,11,12,13,14,15]]
unlike the repeated filtering,
> [ filter p xs | let xs = [1..15], p <- [ (<5), (<10), const True ]]
[[1,2,3,4],[1,2,3,4,5,6,7,8,9],[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]]
Let's say we have a function merge that, well, just merges two lists:
Order : Type -> Type
Order a = a -> a -> Bool
merge : (f : Order a) -> (xs : List a) -> (ys : List a) -> List a
merge f xs [] = xs
merge f [] ys = ys
merge f (x :: xs) (y :: ys) = case x `f` y of
True => x :: merge f xs (y :: ys)
False => y :: merge f (x :: xs) ys
and we'd like to prove something clever about it, for instance, that merging two non-empty lists produces a non-empty list:
mergePreservesNonEmpty : (f : Order a) ->
(xs : List a) -> (ys : List a) ->
{auto xsok : NonEmpty xs} -> {auto ysok : NonEmpty ys} ->
NonEmpty (merge f xs ys)
mergePreservesNonEmpty f (x :: xs) (y :: ys) = ?wut
Inspecting the type of the hole wut gives us
wut : NonEmpty (case f x y of True => x :: merge f xs (y :: ys) False => y :: merge f (x :: xs) ys)
Makes sense so far! So let's proceed and case-split as this type suggests:
mergePreservesNonEmpty f (x :: xs) (y :: ys) = case x `f` y of
True => ?wut_1
False => ?wut_2
It seems reasonable to hope that the types of wut_1 and wut_2 would match the corresponding branches of merge's case expression (so wut_1 would be something like NonEmpty (x :: merge f xs (y :: ys)), which can be instantly satisfied), but our hopes fail: the types are the same as for the original wut.
Indeed, the only way seems to be to use a with-clause:
mergePreservesNonEmpty f (x :: xs) (y :: ys) with (x `f` y)
mergePreservesNonEmpty f (x :: xs) (y :: ys) | True = ?wut_1
mergePreservesNonEmpty f (x :: xs) (y :: ys) | False = ?wut_2
In this case the types would be as expected, but this leads to repeating the function arguments for every with branch (and things get worse once with gets nested), plus with doesn't seem to play nice with implicit arguments (but that's probably worth a question on its own).
So, why doesn't case help here, are there any reasons besides purely implementation-wise behind not matching its behaviour with that of with, and are there any other ways to write this proof?
The stuff to the left of the | is only necessary if the new information somehow propagates backwards to the arguments.
mergePreservesNonEmpty : (f : Order a) ->
(xs : List a) -> (ys : List a) ->
{auto xsok : NonEmpty xs} -> {auto ysok : NonEmpty ys} ->
NonEmpty (merge f xs ys)
mergePreservesNonEmpty f (x :: xs) (y :: ys) with (x `f` y)
| True = IsNonEmpty
| False = IsNonEmpty
-- for contrast
sym' : (() -> x = y) -> y = x
sym' {x} {y} prf with (prf ())
-- matching against Refl needs x and y to be the same
-- now we need to write out the full form
sym' {x} {y=x} prf | Refl = Refl
As for why this is the case, I do believe it's just the implementation, but someone who knows better may dispute that.
There's an issue about proving things with case: https://github.com/idris-lang/Idris-dev/issues/4001
Because of this, in idris-bi we ultimately had to remove all cases in such functions and define separate top-level helpers that match on the case condition, e.g., like here.
Let's consider a predicate showing that the elements in the list are in increasing order (and for simplicity let's only deal with non-empty lists):
mutual
data Increasing : List a -> Type where
SingleIncreasing : (x : a) -> Increasing [x]
RecIncreasing : Ord a => (x : a) ->
(rest : Increasing xs) ->
(let prf = increasingIsNonEmpty rest
in x <= head xs = True) ->
Increasing (x :: xs)
%name Increasing xsi, ysi, zsi
increasingIsNonEmpty : Increasing xs -> NonEmpty xs
increasingIsNonEmpty (SingleIncreasing y) = IsNonEmpty
increasingIsNonEmpty (RecIncreasing x rest prf) = IsNonEmpty
Now let's try to write some useful lemmas with this predicate. Let's start with showing that concatenating two increasing lists produces an increasing list, given that the last element of the first list is not greater than the first element of the second list. The type of this lemma would be:
appendIncreasing : Ord a => {xs : List a} ->
(xsi : Increasing xs) ->
(ysi : Increasing ys) ->
{auto leq : let xprf = increasingIsNonEmpty xsi
yprf = increasingIsNonEmpty ysi
in last xs <= head ys = True} ->
Increasing (xs ++ ys)
Let's now try to implement it! A reasonable way seems to be case-splitting on xsi. The base case where xsi is a single element is trivial:
appendIncreasing {leq} (SingleIncreasing x) ysi = RecIncreasing x ysi leq
The other case is more complicated. Given
appendIncreasing {leq} (RecIncreasing x rest prf) ysi = ?wut
it seems reasonable to proceed by recursively proving this for the result of joining rest and ysi by relying on leq and then prepending x using the prf. At this point the leq is actually a proof of last (x :: xs) <= head ys = True, and the recursive call to appendIncreasing would need to have a proof of last xs <= head ys = True. I don't see a good way to directly prove that the former implies the latter, so let's fall back to rewriting and first write a lemma showing that the last element of a list isn't changed by prepending to the front:
lastIsLast : (x : a) -> (xs : List a) -> {auto ok : NonEmpty xs} -> last xs = last (x :: xs)
lastIsLast x' [x] = Refl
lastIsLast x' (x :: y :: xs) = lastIsLast x' (y :: xs)
Now I would expect to be able to write
appendIncreasing {xs = x :: xs} {leq} (RecIncreasing x rest prf) ysi =
let rest' = appendIncreasing {leq = rewrite lastIsLast x xs in leq} rest ysi
in ?wut
but I fail:
When checking right hand side of appendIncreasing with expected type
Increasing ((x :: xs) ++ ys)
When checking argument leq to Sort.appendIncreasing:
rewriting last xs to last (x :: xs) did not change type last xs <= head ys = True
How can I fix this?
And, perhaps, my proof design is suboptimal. Is there a way to express this predicate in a more useful manner?
If rewrite doesn't find the right predicate, try to be explicit with replace.
appendIncreasing {a} {xs = x :: xs} {ys} (RecIncreasing x rest prf) ysi leq =
let rekPrf = replace (sym $ lastIsLast x xs) leq
{P=\T => (T <= (head ys {ok=increasingIsNonEmpty ysi})) = True} in
let rek = appendIncreasing rest ysi rekPrf in
let appPrf = headIsHead xs ys {q = increasingIsNonEmpty rek} in
let extPrf = replace appPrf prf {P=\T => x <= T = True} in
RecIncreasing x rek extPrf
with
headIsHead : (xs : List a) -> (ys : List a) ->
{auto p : NonEmpty xs} -> {auto q : NonEmpty (xs ++ ys)} ->
head xs = head (xs ++ ys)
headIsHead (x :: xs) ys = Refl
Some suggestions:
Use Data.So x instead of x = True, makes run-time functions
easier to write.
Lift Ord a from the constructor to the type, making it
more clear which ordering is used (and you don't have to match on
{a} at appendIncreasing, I guess).
Don't forget that you can
match on variables in constructors, so instead of repeating that Increasing xs has
NonEmpty xs, just use Increasing (x :: xs).
Leading to:
data Increasing : Ord a -> List a -> Type where
SingleIncreasing : (x : a) -> Increasing ord [x]
RecIncreasing : (x : a) -> Increasing ord (y :: ys) ->
So (x <= y) ->
Increasing ord (x :: y :: ys)
appendIncreasing : {ord : Ord a} ->
Increasing ord (x :: xs) -> Increasing ord (y :: ys) ->
So (last (x :: xs) <= y) ->
Increasing ord ((x :: xs) ++ (y :: ys))
Should make proving things a lot easier, especially if you want to include empty lists.
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)
Let's say we have an infinite list:
data InfList : Type -> Type where
(::) : (value : elem) -> Inf (InfList elem) -> InfList elem
And we want to have finite number of its elements:
getPrefix : (count : Nat) -> InfList a -> List a
getPrefix Z _ = []
getPrefix (S k) (value :: xs) = value :: getPrefix k (?rest)
So, what is left:
a : Type
k : Nat
value : a
xs : InfList a
--------------------------------------
rest : InfList a
It turned out that after pattern matching xs become InfList a instead of Inf (InfList a).
Is there a way to have xs delayed?
It seems to be delayed anyway.
If you execute :x getPrefix 10 one with
one : InfList Int
one = 1 :: one
you get 1 :: getPrefix 9 (1 :: Delay one)
I can't find it anymore in the documentation but idris seems to insert Delay automatically.
Just try to add Delay constructor manually. It's removed implicitly.
getPrefix : (count : Nat) -> InfList a -> List a
getPrefix Z _ = []
getPrefix (S k) (value :: Delay xs) = value :: getPrefix k xs