Making strIndex total in Quick Search? - dependent-type

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?

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

Testing if a proof is sound in Idris

I'm trying to write a test code to check if plusComm : (a : Nat) -> (b : Nat) -> a + b = b + a indeed proves a + b = b + a on natural numbers, i.e. the code does not fake one using typed holes, postulate, believe_me, assert_total, etc.
Specifically, if the proof is faked in some way, I want the program to fail in one of the three ways:
Compilation error
Run-time error e.g. segfault
Run-time infinite loop
If these options are not feasible, I'm open to source code analysis as a last resort (for my purposes, that should be written in Idris too). I heard of Language.Reflection but I'm not sure if it's the right tool here.
The code below is one attempt that failed because proofEval doesn't even look at the actual value passed:
plusComm : (a : Nat) -> (b : Nat) -> a + b = b + a
plusComm a b = ?plusComm
proofEval : {a : ty} -> (a = b) -> ty
proofEval {a=a} _ = a
main : IO ()
main = do
putStrLn "Compiled Successfully!"
print (proofEval (plusComm 1 2))
The above, when compiled and run, produces the following output and exits without error.
Compiled Successfully!
3
Partial answer
I found a way to catch postulate and holes using dependent tuples:
plusComm : (a : Nat) -> (b : Nat) -> a + b = b + a
plusComm = plusCommutative
proofEval : (a : Nat) -> (b : Nat) -> (a : Nat ** (b : Nat ** (a + b = b + a)))
proofEval a b = (a ** (b ** plusComm a b))
main : IO ()
main = do
putStrLn "Compiled Successfully!"
print $ fst $ snd $ proofEval 1 2
-- `print $ fst $ proofEval 1 2` doesn't work for the purpose
Output:
Compiled Successfully!
2
Some possible fake proofs and the results:
-- typed hole
plusComm : (a : Nat) -> (b : Nat) -> a + b = b + a
plusComm = ?plusComm
-- result: runtime error (abort)
ABORT: Attempt to evaluate hole Main.plusComm1
-- postulate
postulate plusComm : (a : Nat) -> (b : Nat) -> a + b = b + a
-- result: compilation error
reachable postulates:
Main.plusComm
Note that assert_total or believe_me is not caught using this method as marked in the linked snippet.

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

Totality and searching for elements in Streams

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

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.