How can I have Idris automatically prove that two values are not equal? - proof

How can I have Idris automatically prove that two values are not equal?
p : Not (Int = String)
p = \Refl impossible
How can I have Idris automatically generate this proof? auto does not appear to be capable of proving statements involving Not. My end goal is to have Idris automatically prove that all elements in a vector are unique and that two vectors are disjoint.
namespace IsSet
data IsSet : List t -> Type where
Nil : IsSet []
(::) : All (\a => Not (a = x)) xs -> IsSet xs -> IsSet (x :: xs)
namespace Disjoint
data Disjoint : List t -> List t -> Type where
Nil : Disjoint [] ys
(::) : All (\a => Not (a = x)) ys -> Disjoint xs ys -> Disjoint (x :: xs) ys
f : (xs : List Type) -> (ys: List Type) -> {p1 : IsSet xs} -> {p2 : IsSet ys} -> {p3 : Disjoint xs ys} -> ()
f _ _ = ()
q : ()
q = f ['f1, 'f2] ['f3, 'f4]

Using %hint I got Idris to auto prove any NotEq it encountered. Since Not (a = b) is a function (since Not a is a -> Void), I needed to make NotEq (since auto cannot prove functions).
module Main
import Data.Vect
import Data.Vect.Quantifiers
%default total
fromFalse : (d : Dec p) -> {auto isFalse : decAsBool d = False} -> Not p
fromFalse (Yes _) {isFalse = Refl} impossible
fromFalse (No contra) = contra
data NotEq : a -> a -> Type where
MkNotEq : {a : t} -> {b : t} -> Not (a = b) -> NotEq a b
%hint
notEq : DecEq t => {a : t} -> {b : t} -> {auto isFalse : decAsBool (decEq a b) = False} -> NotEq a b
notEq = MkNotEq (fromFalse (decEq _ _))
NotElem : k -> Vect n k -> Type
NotElem a xs = All (\x => NotEq a x) xs
q : (a : lbl) -> (b : Vect n lbl) -> {auto p : NotElem a b} -> ()
q _ _ = ()
w : ()
w = q "a" ["b","c"]

Related

Couldn't match expected type ‘Bool’ with actual type ‘a -> Bool’

I want to write a function that returns the longest prefix of a list, where applying a function to every item in that prefix produces a strictly ascending list.
For example:
longestAscendingPrefix (`mod` 5) [1..10] == [1,2,3,4]
longestAscendingPrefix odd [1,4,2,6,8,9,3,2,1] == [1]
longestAscendingPrefix :: Ord b => (a -> b) -> [a] -> [a]
longestAscendingPrefix _ [] = []
longestAscendingPrefix f (x:xs) = takeWhile (\y z -> f y <= f z) (x:xs)
This code snippet produces the error message in the title. It seems the problem lies within that lambda function.
takeWhile has type takeWhile :: (a -> Bool) -> [a] -> [a]. The first parameter is thus a function that maps an element of the list to a Bool. Your lambda expression has type Ord b => a -> a -> Bool, which does not make much sense.
You can work with explicit recursion with:
longestAscendingPrefix :: Ord b => (a -> b) -> [a] -> [a]
longestAscendingPrefix f = go
where go [] = []
go [x] = …
go (x1:x2:xs) = …
where you need to fill in the … parts the last one makes a recursive call to go.

How to write my own Haskell sortOn function

I was wondering how to write my own sortOn function.
I made a sortBy function and an on function as shown bellow but can't figure out how to combine them and what additional code to add. sortOn is like sortBy but the given function (in here named comp) is applied only once for every element of the list
sortBy :: (a -> a -> Ordering) -> [a] -> [a]
sortBy comp [] = []
sortBy comp [x] = [x]
sortBy comp (x:xs) = insert x (sortBy comp xs)
where
insert x [] = [x]
insert x (y:ys)
| (comp x y == LT) || (comp x y == EQ) = x:y:ys
| otherwise = y:(insert x ys)
on :: (b -> b -> c) -> (a -> b) -> a -> a -> c
on b f x y = b (f x) (f y)
Here's a hint.
If you have a list [a] and you just sort it, the sort function will implicitly make use of the Ord instance for a and specifically the function:
compare :: a -> a -> Ordering
to figure out the relative ordering of pairs of a elements.
Now, if you have a list [a] and a transformation function b, and you want to use sortOn to sort the list of the transformed values, you'll need to figure out the relative ordering of pairs of b elements. How will you do this? Well, you'll implicitly use the Ord instance for b and specifically the function:
compare :: b -> b -> Ordering
In other words, when you try to define:
sortOn :: (Ord b) => (a -> b) -> [a] -> [a]
sortOn f lst = ...
you'll have arguments of type:
f :: a -> b
lst :: [a]
and additional objects of type:
sortBy :: (a -> a -> Ordering) -> [a] -> [a]
on :: (b -> b -> c) -> (a -> b) -> a -> a -> c
compare :: b -> b -> Ordering
Now, can you see how to put them together to define sortOn?
SPOILERS
Further hint: What's the type of compare `on` f?
Further further hint: It's a -> a -> Ordering.

Can I extract a proof of bounds from an enumeration expression?

Consider this trivial program:
module Study
g : Nat -> Nat -> Nat
g x y = x - y
f : Nat -> List Nat
f x = map (g x) [1, 2 .. x]
It gives an obvious error:
|
4 | g x y = x - y
| ^
When checking right hand side of g with expected type
Nat
When checking argument smaller to function Prelude.Nat.-:
Can't find a value of type
LTE y x
— Saying I should offer some proof that this subtraction is safe to perform.
Surely, in the given context, g is always invoked safely. This follows from the way enumerations behave. How can I extract a proof of that fact so that I can give it to the invocation of g?
I know that I can use isLTE to obtain the proof:
g : Nat -> Nat -> Nat
g x y = case y `isLTE` x of
(Yes prf) => x - y
(No contra) => ?s_2
This is actually the only way I know of, and it seems to me that in a situation such as we have here, where x ≥ y by construction, there should be a way to avoid a superfluous case statement. Is there?
For map (\y = x - y) [1, 2 .. x] there needs to be a proof \y => LTE y x for every element of [1, 2 .. x]. There is Data.List.Quantifiers.All for this: All (\y => LTE y x) [1, 2 .. x].
But constructing and applying this proof is not so straight-forward. You could either build a proof about the range function lteRange : (x : Nat) -> All (\y => LTE y x) (natRange x) or define a function that returns a range and its proof lteRange : (x : Nat) -> (xs : List Nat ** All (\y => LTE y x) xs). For simplicity, I'll show an example with the second type.
import Data.List.Quantifiers
(++) : All p xs -> All p ys -> All p (xs ++ ys)
(++) [] ys = ys
(++) (x :: xs) ys = x :: (xs ++ ys)
lteRange : (x : Nat) -> (xs : List Nat ** All (\y => LTE y x) xs)
lteRange Z = ([] ** [])
lteRange (S k) = let (xs ** ps) = lteRange k in
(xs ++ [S k] ** weakenRange ps ++ [lteRefl])
where
weakenRange : All (\y => LTE y x) xs -> All (\y => LTE y (S x)) xs
weakenRange [] = []
weakenRange (y :: z) = lteSuccRight y :: weakenRange z
Also, map only applies one argument, but (-) needs the proof, too. So with a little helper function …
all_map : (xs : List a) -> All p xs -> (f : (x : a) -> p x -> b) -> List b
all_map [] [] f = []
all_map (x :: xs) (p :: ps) f = f x p :: all_map xs ps f
We can roughly do what you wanted without checking for LTE during the run-time:
f : Nat -> List Nat
f x = let (xs ** prfs) = lteRange x in all_map xs prfs (\y, p => x - y)

Filter function in nonogram solver

I have to understand the Deductive solver By Ted Yin from https://wiki.haskell.org/Nonogram
i don't know how
elim b w ps = filter (\p -> all (\x -> x `elem` p) b &&
all (\x -> x `notElem` p) w) ps
works. I only know that
all (\x -> x `notElem` [1]) [1,2,3,4]
gives False, and
all (\x -> x `elem` [1]) [1,1,1,1]
gives True.
but i don't know hot to run all elim function and how it works
First, help yourself to a little whitespace to aid understanding, and name your subexpressions:
elim b w ps = filter (\p -> all (\x -> x `elem` p) b &&
all (\x -> x `notElem` p) w
) ps
= filter foo ps
where
foo p = all (\x -> x `elem` p) b &&
all (\x -> x `notElem` p) w
= filter foo ps
where
foo p = all tst1 b && all tst2 w
where
tst1 = (\x -> x `elem` p)
tst2 = (\x -> x `notElem` p)
= filter foo ps
where
foo p = (&&) (all tst1 b) (all tst2 w)
where
tst1 x = elem x p
tst2 y = notElem y p
Now what does that do? Or better yet, what is it? Let's go by some types to build up our insight here:
filter :: (a -> Bool) -> [a] -> [a]
foo :: a -> Bool
ps :: [a]
filter foo ps :: [a]
p :: a
foo p :: Bool
(&&) :: Bool -> Bool -> Bool
all tst1 b :: Bool
all tst2 w :: Bool
---------------------------
all :: (t -> Bool) -> [t] -> Bool
tst1 :: t -> Bool
tst2 :: t -> Bool
b :: [t]
w :: [t]
---------------------------
......
---------------------------
elim b w ps :: [a]
elim :: [t] -> [t] -> [a] -> [a]
Complete the picture by working through the types of tst1 and tst2 to find out the relationship between the t and a types.
tst1 :: t -> Bool -- tst1 x = elem x p
tst2 :: t -> Bool -- tst2 y = notElem y p
x :: t
y :: t
elem :: Eq t => t -> [t] -> Bool
notElem :: Eq t => t -> [t] -> Bool
p :: [t] -- it was : a !
Thus a ~ [t] and [a] ~ [[t]] and finally,
elim b w ps :: [[t]]
elim :: Eq t => [t] -> [t] -> [[t]] -> [[t]]
So then filter foo leaves only those ps in ps for which foo p == True.
And that means all tst1 b == True and all tst2 w == True.
And that means, every x in b is an element of p, and every y in w is not an element in p. Or in other words only such ps in ps are left alone in the resulting list for which
foo p = (b \\ p) == [] && (p \\ w) == p
holds:
import Data.List (\\)
elim b w ps = [ p | p <- ps, (b \\ p) == [], (p \\ w) == p ]

Act on a `case` clause in Haskell

I'm attempting problem 11 of "99 Haskell Problems." The problem description is pretty much:
Write a function encodeModified that groups consecutive equal elements, then counts each group, and separates singles from runs.
For example:
Prelude> encodeModified "aaaabccaadeeee"
[Multiple 4 'a',Single 'b',Multiple 2 'c',
Multiple 2 'a',Single 'd',Multiple 4 'e']
Here's my working code:
module Batch2 where
import Data.List -- for `group`
data MultiElement a = Single a | Multiple Int a deriving (Show)
encodeModified :: (Eq a) => [a] -> [MultiElement a]
encodeModified = map f . group
where f xs = case length xs of 1 -> Single (head xs)
_ -> Multiple (length xs) (head xs)
I'd like to take out that pesky repeated (head xs) in the final two lines. I figured I could do so by treating the result of the case clause as a partially applied data constructor, as follows, but no luck:
encodeModified :: (Eq a) => [a] -> [MultiElement a]
encodeModified = map f . group
where f xs = case length xs of 1 -> Single
_ -> Multiple length xs
(head xs)
I also tried putting parenthese around the case clause itself, but to no avail. In that case, the case clause itself failed to compile (throwing an error upon hitting the _ symbol on the second line of the clause).
EDIT: this error was because I added a parenthesis but didn't add an extra space to the next line to make the indentation match. Thanks, raymonad.
I can also solve it like this, but it seems a little messy:
encodeModified :: (Eq a) => [a] -> [MultiElement a]
encodeModified = map (\x -> f x (head x)) . group
where f xs = case length xs of 1 -> Single
_ -> Multiple (length xs)
How can I do this?
The function application operator $ can be used to make this work:
encodeModified = map f . group
where f xs = case length xs of 1 -> Single
_ -> Multiple (length xs)
$ head xs
You could match on xs itself instead:
encodeModified :: (Eq a) => [a] -> [MultiElement a]
encodeModified = map f . group
where f xs = case xs of (x:[]) -> Single x
(x:_) -> Multiple (length xs) x
or more tersely as
encodeModified :: (Eq a) => [a] -> [MultiElement a]
encodeModified = map f . group
where f (x:[]) = Single x
f xs#(x:_) = Multiple (length xs) x
or even
encodeModified :: (Eq a) => [a] -> [MultiElement a]
encodeModified = map f . group
where f as#(x:xs) = case xs of [] -> Single x
_ -> Multiple (length as) x
Admittedly most of these have some repetition, but not of function application.
You could also go with let:
encodeModified :: (Eq a) => [a] -> [MultiElement a]
encodeModified = map f . group
where f xs = let x = head xs
len = length xs in
case len of 1 -> Single x
_ -> Multiple len x