Totality and searching for elements in Streams - optimization

I want a find function for Streams of size-bounded types which is analogous to the find functions for Lists and Vects.
total
find : MaxBound a => (a -> Bool) -> Stream a -> Maybe a
The challenge is it to make it:
be total
consume no more than constant log_2 N space where N is the number of bits required to encode the largest a.
take no longer than a minute to check at compile time
impose no runtime cost
Generally a total find implementation for Streams sounds absurd. Streams are infinite and a predicate of const False would make the search go on forever. A nice way to handle this general case is the infinite fuel technique.
data Fuel = Dry | More (Lazy Fuel)
partial
forever : Fuel
forever = More forever
total
find : Fuel -> (a -> Bool) -> Stream a -> Maybe a
find Dry _ _ = Nothing
find (More fuel) f (value :: xs) = if f value
then Just value
else find fuel f xs
That works well for my use case, but I wonder if in certain specialized cases the totality checker could be convinced without using forever. Otherwise, somebody may suffer a boring life waiting for find forever ?predicateWhichHappensToAlwaysReturnFalse (iterate S Z) to finish.
Consider the special case where a is Bits32.
find32 : (Bits32 -> Bool) -> Stream Bits32 -> Maybe Bits32
find32 f (value :: xs) = if f value then Just value else find32 f xs
Two problems: it's not total and it can't possibly return Nothing even though there's a finite number of Bits32 inhabitants to try. Maybe I could use take (pow 2 32) to build a List and then use List's find...uh, wait...the list alone would take up GBs of space.
In principle it doesn't seem like this should be difficult. There's finitely many inhabitants to try, and a modern computer can iterate through all 32-bit permutations in seconds. Is there a way to have the totality checker verify the (Stream Bits32) $ iterate (+1) 0 eventually cycles back to 0 and once it does assert that all the elements have been tried since (+1) is pure?
Here's a start, although I'm unsure how to fill the holes and specialize find enough to make it total. Maybe an interface would help?
total
IsCyclic : (init : a) -> (succ : a -> a) -> Type
data FinStream : Type -> Type where
MkFinStream : (init : a) ->
(succ : a -> a) ->
{prf : IsCyclic init succ} ->
FinStream a
partial
find : Eq a => (a -> Bool) -> FinStream a -> Maybe a
find pred (MkFinStream {prf} init succ) = if pred init
then Just init
else find' (succ init)
where
partial
find' : a -> Maybe a
find' x = if x == init
then Nothing
else
if pred x
then Just x
else find' (succ x)
total
all32bits : FinStream Bits32
all32bits = MkFinStream 0 (+1) {prf=?prf}
Is there a way to tell the totality checker to use infinite fuel verifying a search over a particular stream is total?

Let's define what it means for a sequence to be cyclic:
%default total
iter : (n : Nat) -> (a -> a) -> (a -> a)
iter Z f = id
iter (S k) f = f . iter k f
isCyclic : (init : a) -> (next : a -> a) -> Type
isCyclic init next = DPair (Nat, Nat) $ \(m, n) => (m `LT` n, iter m next init = iter n next init)
The above means that we have a situation which can be depicted as follows:
-- x0 -> x1 -> ... -> xm -> ... -> x(n-1) --
-- ^ |
-- |---------------------
where m is strictly less than n (but m can be equal to zero). n is some number of steps after which we get an element of the sequence we previously encountered.
data FinStream : Type -> Type where
MkFinStream : (init : a) ->
(next : a -> a) ->
{prf : isCyclic init next} ->
FinStream a
Next, let's define a helper function, which uses an upper bound called fuel to break out from the loop:
findLimited : (p : a -> Bool) -> (next : a -> a) -> (init : a) -> (fuel : Nat) -> Maybe a
findLimited p next x Z = Nothing
findLimited p next x (S k) = if p x then Just x
else findLimited pred next (next x) k
Now find can be defined like so:
find : (a -> Bool) -> FinStream a -> Maybe a
find p (MkFinStream init next {prf = ((_,n) ** _)}) =
findLimited p next init n
Here are some tests:
-- I don't have patience to wait until all32bits typechecks
all8bits : FinStream Bits8
all8bits = MkFinStream 0 (+1) {prf=((0, 256) ** (LTESucc LTEZero, Refl))}
exampleNothing : Maybe Bits8
exampleNothing = find (const False) all8bits -- Nothing
exampleChosenByFairDiceRoll : Maybe Bits8
exampleChosenByFairDiceRoll = find ((==) 4) all8bits -- Just 4
exampleLast : Maybe Bits8
exampleLast = find ((==) 255) all8bits -- Just 255

Related

How to use data from Maybe as Vect size variable

I'm trying to write a simple program that asks the user about the list size and shows content from that list by index also by the user's input. But I've stuck. I have a function that builds a list by a number. Now I want to create another function that uses Maybe Nat as input and returns Maybe (Vect n Nat). But I have no idea how to accomplish this. Here is the code:
module Main
import Data.Fin
import Data.Vect
import Data.String
getList: (n: Nat) -> Vect n Nat
getList Z = []
getList (S k) = (S k) :: getList k
mbGetList : (Maybe Nat) -> Maybe (Vect n Nat)
mbGetList mbLen = case mbLen of
Just len => Just (getList len)
Nothing => Nothing
main : IO ()
main = do
len <- readNum
-- list <- mbGetList len
putStrLn (show len)
And here is the error:
|
55 | Just len => Just (getList len)
| ~~~~~~~~~~~
When checking right hand side of Main.case block in mbGetList at main.idr:54:24-28 with expected type
Maybe (Vect n Nat)
When checking argument n to function Main.getList:
Type mismatch between
n (Inferred value)
and
len (Given value)
I've tried to declare an implicit variable. The code compiles, but I can't use it (at least throw repl). Also, I've tried to use dependant pair and also failed. Maybe I should use Dec instead of Maybe? But how??? Another attempt was a try to use map function. But in that case, I have an error like that: Can't infer argument n to Functor.
So, what I've missed?
This answer doesn't feel optimal, but here goes
mbGetList : (mbLen: Maybe Nat) -> case mbLen of
(Just len) => Maybe (Vect len Nat)
Nothing => Maybe (Vect Z Nat)
mbGetList (Just len) = Just (getList len)
mbGetList Nothing = Nothing
I think the difficulty comes from the fact that there's no well-defined length for the Vect if you don't have a valid input

Defining groups in Idris

I defined monoid in Idris as
interface Is_monoid (ty : Type) (op : ty -> ty -> ty) where
id_elem : () -> ty
proof_of_left_id : (a : ty) -> ((op a (id_elem ())) = a)
proof_of_right_id : (a : ty) -> ((op (id_elem ())a) = a)
proof_of_associativity : (a, b, c : ty) -> ((op a (op b c)) = (op (op a b) c))
then tried to define groups as
interface (Is_monoid ty op) => Is_group (ty : Type) (op : ty -> ty -> ty) where
inverse : ty -> ty
proof_of_left_inverse : (a : ty) -> (a = (id_elem ()))
but during compilation it showed
When checking type of Group.proof_of_left_inverse:
Can't find implementation for Is_monoid ty op
Is there a way around it.
The error message is a bit misleading, but indeed, the compiler does not know which implementation of Is_monoid to use for your call to id_elem in your definition of proof_of_left_inverse. You can make it work by making it making the call more explicit:
proof_of_left_inverse : (a : ty) -> (a = (id_elem {ty = ty} {op = op} ()))
Now, why is this necessary? If we have a simple interface like
interface Pointed a where
x : a
we can just write a function like
origin : (Pointed b) => b
origin = x
without specifying any type parameters explicitly.
One way to understand this is to look at interfaces and implementations through the lens of other, in a way more basic Idris features. x can be thought of as a function
x : {a : Type} -> {auto p : PointedImpl a} -> a
where PointedImpl is some pseudo type that represents the implementations of Pointed. (Think a record of functions.)
Similarly, origin looks something like
origin : {b : Type} -> {auto j : PointedImpl b} -> b
x notably has two implicit arguments, which the compiler tries to infer during type checking and unification. In the above example, we know that origin has to return a b, so we can unify a with b.
Now i is also auto, so it is not only subject to unification (which does not help here), but in addition, the compiler looks for "surrounding values" that can fill that hole if no explicit one was specified. The first place to look after local variables which we don't have is the parameter list, where we indeed find j.
Thus, our call to origin resolves without us having to explicitly specify any additional arguments.
Your case is more akin to this:
interface Test a b where
x : a
y : b
test : (Test c d) => c
test = x
This will error in the same manner your example did. Going through the same steps as above, we can write
x : {a : Type} -> {b -> Type} -> {auto i : TestImpl a b} -> a
test : {c : Type} -> {d -> Type} -> {auto j : TestImpl c d} -> c
As above, we can unify a and c, but there is nothing that tells us what d is supposed to be. Specifically, we can't unify it with b, and consequently we can't unify TestImpl a b with TestImpl c d and thus we can't use j as value for the auto-parameter i.
Note that I don't claim that this is how things are implemented under the covers. This is just an analogy in a sense, but one that holds up to at least some scrutiny.

Trying to bring implicit argument into scope on the left side of a definition in Idris results in "is f applied to too many arguments" error

The function applyRule is supposed to extract the implicit argument n that is used in another arguments it gets, of type VVect.
data IVect : Vect n ix -> (ix -> Type) -> Type where -- n is here
Nil : IVect Nil b
(::) : b i -> IVect is b -> IVect (i :: is) b
VVect : Vect n Nat -> Type -> Type -- also here
VVect is a = IVect is (flip Vect a)
-- just for completeness
data Expression = Sigma Nat Expression
applyRule : (signals : VVect is Double) ->
(params : List Double) ->
(sigmas : List Double) ->
(rule : Expression) ->
Double
applyRule {n} signals params sigmas (Sigma k expr1) = cast n
Without referring to {n}, the code type-checks (if cast n is changed to some valid double). Adding it in, however, results in the following error:
When checking left hand side of applyRule:
Type mismatch between
Double (Type of applyRule signals params sigmas rule)
and
_ -> _ (Is applyRule signals
params
sigmas
rule applied to too many arguments?)
This doesn't seem to make sense to me, because I'm not pattern-matching on any parameter that could have a dependency on n, so I thought that simply putting it in curly braces would bring it into scope.
You can only bring n into scope if it is defined somewhere (e.g. as a variable in the arguments). Otherwise it would be hard to figure out where the n comes from – at least for a human.
applyRule : {is : Vect n Nat} ->
(signals : VVect is Double) ->
(params : List Double) ->
(sigmas : List Double) ->
(rule : Expression) ->
Double
applyRule {n} signals params sigmas (Sigma k expr1) = cast n

Making strIndex total in Quick Search?

I am working on a version of the Quick Search string searching algorithm in Idris, and have come up with this:
quickSearch : (needle : String) ->
(haystack : String) ->
{auto lengths : (length needle) `LTE` (length haystack)} ->
Maybe Nat
quickSearch needle haystack = let n = length needle in
let h = length haystack in
go (makeBadShift needle) n (h - n)
where
go : (badShift : CharShift) ->
(n : Nat) ->
(last : Nat) ->
Maybe Nat
go badShift n last = go' 0
where
go' : Nat -> Maybe Nat
go' i = if i > last then Nothing
else if (substr i n haystack) == needle then Just i
else if i == last then Nothing
else let ch = strIndex haystack (cast (n + i)) in
let shift = lookupChar badShift ch in
go' (i + shift)
(lookupChar and makeBadShift are elsewhere.)
This works fine, but I wanted to make it more formally correct. To start with, it's not total due to the use of strIndex. It's not hard to create a total version of strIndex (either going through List Char or this:)
strIndex' : (str : String) ->
(n : Nat) ->
{auto ok : (n `LT` (Strings.length str))} ->
Char
strIndex' str n = assert_total $ prim__strIndex str (cast n)
but then I have to have a way of proving that (n + i) is less than h. (It is, because at that point i < h - n.)
If I directly replace the ">" and "==" with their proof-bearing cousins, I wind up looking at negations:
iNEQlast : (i = last) -> Void
and
iNGTlast : (S last) `LTE` i -> Void
which left me stumped.
On the other hand, I can reverse the conditions, ending up with
"quicksearch.idr" 115L, 4588C written
needle : String
haystack : String
lengths : LTE (fromIntegerNat (prim__zextInt_BigInt (prim_lenString needle))) (fromIntegerNat (prim__zextInt_BigInt (prim_lenString haystack)))
badShift : CharShift
n : Nat
h : Nat
nh : LTE n h
i : Nat
iLTlast : LTE (S i) (minus h n)
iLTElast : LTE i (minus h n)
--------------------------------------
go'_rhs_1 : Maybe Nat
but at this point I'm thoroughly confused and don't know how to go forward.
What is the best thing to do now?

Idris: proof that specific terms are impossible

Idris version: 0.9.16
I am attempting to describe constructions generated from a base value and an iterated step function:
namespace Iterate
data Iterate : (base : a) -> (step : a -> a) -> a -> Type where
IBase : Iterate base step base
IStep : Iterate base step v -> Iterate base step (step v)
Using this I can define Plus, describing constructs from iterated addition of a jump value:
namespace Plus
Plus : (base : Nat) -> (jump : Nat) -> Nat -> Type
Plus base jump = Iterate base (\v => jump + v)
Simple example uses of this:
namespace PlusExamples
Even : Nat -> Type; Even = Plus 0 2
even0 : Even 0; even0 = IBase
even2 : Even 2; even2 = IStep even0
even4 : Even 4; even4 = IStep even2
Odd : Nat -> Type; Odd = Plus 1 2
odd1 : Odd 1; odd1 = IBase
odd3 : Odd 3; odd3 = IStep odd1
Fizz : Nat -> Type; Fizz = Plus 0 3
fizz0 : Fizz 0; fizz0 = IBase
fizz3 : Fizz 3; fizz3 = IStep fizz0
fizz6 : Fizz 6; fizz6 = IStep fizz3
Buzz : Nat -> Type; Buzz = Plus 0 5
buzz0 : Buzz 0; buzz0 = IBase
buzz5 : Buzz 5; buzz5 = IStep buzz0
buzz10 : Buzz 10; buzz10 = IStep buzz5
The following describes that values below the base are impossible:
noLess : (base : Nat) ->
(i : Fin base) ->
Plus base jump (finToNat i) ->
Void
noLess Z FZ m impossible
noLess (S b) FZ IBase impossible
noLess (S b) (FS i) IBase impossible
And the following for values between base and jump + base:
noBetween : (base : Nat) ->
(predJump : Nat) ->
(i : Fin predJump) ->
Plus base (S predJump) (base + S (finToNat i)) ->
Void
noBetween b Z FZ m impossible
noBetween b (S s) FZ IBase impossible
noBetween b (S s) (FS i) IBase impossible
I am having trouble defining the following function:
noJump : (Plus base jump n -> Void) -> Plus base jump (jump + n) -> Void
noJump f m = ?noJump_rhs
That is: if n isn't base plus a natural multiple of jump, then neither is jump + n.
If I ask Idris to case split m it only shows me IBase - then I get stuck.
Would someone point me in the right direction?
Edit 0:
Applying induction to m gives me the following message:
Induction needs an eliminator for Iterate.Iterate.Iterate
Edit 1:
Name updates and here is a copy of the source: http://lpaste.net/125873
I think there's a good reason to get stuck on the IBase case of this proof, which is that the theorem is false! Consider:
noplus532 : Plus 5 3 2 -> Void
noplus532 IBase impossible
noplus532 (IStep _) impossible
plus535 : Plus 5 3 (3 + 2)
plus535 = IBase
To Edit 0: to induct on a type, it needs a special qualifier:
%elim data Iterate = <your definition>
To the main question: sorry that I haven't read through all your code, I only want to make some suggestion for falsifying proofs. From my experience (I even delved the standard library sources to find out some help), when you need to prove Not a (a -> Void), often you can use some Not b (b -> Void) and a way to convert a to b, then just pass it to the second proof. For example, a very simple proof that one list cannot be prefix of another if they have different heads:
%elim data Prefix : List a -> List a -> Type where
pEmpty : Prefix Nil ys
pNext : Prefix xs ys -> Prefix (x :: xs) (x :: ys)
prefixNotCons : Not (x = y) -> Not (Prefix (x :: xs) (y :: ys))
prefixNotCons r (pNext _) = r refl
In your case, I suppose you need to combine several proofs.