Suppose I have the following in scope:
A : Set
xs = [x1, x2, ..., xn] : List A
f : A → Set
I can then use Data.List.All to make a type that contains y1 : f x1, y2 : f x2, ..., yn : f xn :
ys = [y1, y2, ..., yn] : All f xs
My quesiton is, suppose I have another function
g : {x : A} → f x → Set
Is there something in the standard library for turning that into a type AllAll g ys such that I can then have z1 : g {x1} y1, z2 : g {x2} y2, ..., zn : g {xn} yn in some zs = [z1, ..., zn] : AllAll g ys?
To clarify, here's how I'd implement it myself; my question is whether I have to do it this way or if something in the standard library (maybe Data.List.All itself?) that I could use:
data AllAll {A : Set} {f : A → Set} (g : {x : A} → f x → Set) : {xs : List A} → (ys : All f xs) → Set where
[] : AllAll g []
_∷_ : ∀ {x y xs ys} → g y → AllAll g ys → AllAll g {x ∷ xs} (y ∷ ys)
You can indeed use the existing All for this. First define a function which 'forgets' the structure of All:
open import Data.List
open import Data.List.All
open import Data.Product
lower-All : ∀ {a p} {A : Set a} {P : A → Set p} {xs} → All P xs → List (∃ P)
lower-All [] = []
lower-All (x ∷ xs) = (_ , x) ∷ lower-All xs
Then simply compose this function with All itself:
AllAll : ∀ {a x p} {X : Set x} {A : X → Set a} (P : ∀ {x} → A x → Set p)
→ ∀ {xs} → All A xs → Set _
AllAll P = λ xs → All (P ∘ proj₂) (lower-All xs)
One downside to this is that to pattern match on ys : AllAll P xs you must pattern match on xs first. Depending on how many functions you need to write which pattern match on AllAll this encoding may not be very convenient. One upside is you get additional 'nestings' for free:
AllAllAll : ∀ {l₀ l₁ l₂ l₃}
{A₀ : Set l₀}
{A₁ : A₀ → Set l₁}
{A₂ : ∀ {x} → A₁ x → Set l₂}
(A₃ : ∀ {x} {y : A₁ x} → A₂ y → Set l₃)
→ ∀ {xs₀} {xs₁ : All A₁ xs₀} (xs₂ : AllAll A₂ xs₁) → Set _
AllAllAll P = AllAll P
(Although if you find yourself in need of such a monster, perhaps consider refactoring your program....)
I leave as an exercise to prove the isomorphism between this version and the one in the OP.
Related
I'm trying to write a reverse vector function in agda, and am running into the following stumbling block
Goal: Vec Nat (suc n)
Have: Vec Nat (n +N 1)
If I understand correctly, these values aren't definionally equal. Here is the reverse function.
vReverse : {X : Set} {n : Nat} → Vec X n → Vec X n
vReverse [] = []
vReverse (x ,- x₁) = {!(vReverse x₁) +V (x ,- [])!}
How can I overcome this, if possilbe, without refactoring the code. If a refactor is necessary, how can one generally avoid these pitfalls a priori? Here is the rest of the code.
data Nat : Set where
zero : Nat
suc : Nat -> Nat -- recursive data type
{-# BUILTIN NATURAL Nat #-}
_+N_ : Nat -> Nat -> Nat
zero +N y = y
suc x +N y = suc (x +N y) -- there are other choices
data Vec (X : Set) : Nat -> Set where -- like lists, but length-indexed
[] : Vec X zero
_,-_ : {n : Nat} -> X -> Vec X n -> Vec X (suc n)
infixr 4 _,-_ -- the "cons" operator associates to the right
_+V_ : {X : Set}{m n : Nat} -> Vec X m -> Vec X n -> Vec X (m +N n)
[] +V xs = xs
(x ,- xs) +V [] = x ,- xs +V []
(x ,- xs) +V x₁ ,- ys = x ,- xs +V x₁ ,- ys
The idea is that you can transform an element of type P x into an element of type P y provided you can prove x ≡ y. Let me guide you through this process step by step. Here is the base code you provided, which I have not refactored as you requested.
data Nat : Set where
zero : Nat
suc : Nat -> Nat -- recursive data type
{-# BUILTIN NATURAL Nat #-}
_+N_ : Nat -> Nat -> Nat
zero +N y = y
suc x +N y = suc (x +N y) -- there are other choices
infixl 5 _+N_
data Vec (X : Set) : Nat -> Set where -- like lists, but length-indexed
[] : Vec X zero
_,-_ : {n : Nat} -> X -> Vec X n -> Vec X (suc n)
infixr 4 _,-_ -- the "cons" operator associates to the right
However, your concatenation function was incorrect and it didn't terminate so here is the corrected version.
_+V_ : {X : Set}{m n : Nat} -> Vec X m -> Vec X n -> Vec X (m +N n)
[] +V vs = vs
(x ,- xs) +V vs = x ,- (xs +V vs)
The reason why we don't need to do any substitution in this function is because suc n + m is definitionally equal to suc (n + m).
Since you've defined your own naturals and your own addition, I'm assuming you want to redefine everything by yourself. According to this assumption, you'll need to define propositional equality, which is done as follows:
data _≡_ {a} {A : Set a} (x : A) : A → Set a where
refl : x ≡ x
infix 1 _≡_
From this definition, we can define the substitution that was mentioned in the preamble of this answer, as well as in a comment of your question:
subst : ∀ {a b} {A : Set a} {x y : A} (P : A → Set b) → x ≡ y → P x → P y
subst _ refl p = p
In your reverse function, the problem lies in the fact that n + 1 is not definitionally equal to suc n. Which is why we need a property to establish this fact, which we can then feed to our substitution mechanism. This proof requires the congruence of the propositional equality we defined, as follows:
cong : ∀ {a b} {A : Set a} {B : Set b} (f : A → B) {x y} → x ≡ y → f x ≡ f y
cong _ refl = refl
n+1≡sn : ∀ {n} → n +N 1 ≡ suc n
n+1≡sn {zero} = refl
n+1≡sn {suc _} = cong suc n+1≡sn
We now have all the required elements to write your vReverse function:
vReverse : ∀ {X n} → Vec X n → Vec X n
vReverse [] = []
vReverse (x ,- x₁) = subst (Vec _) n+1≡sn ((vReverse x₁) +V (x ,- []))
To go Further, you can use the same process to build the usual reverse function which is more efficient (linear complexity). I took the liberty to do this for you, since it shows more examples of usage of subst.
n+sm≡sn+m : ∀ {n m} → n +N suc m ≡ suc (n +N m)
n+sm≡sn+m {zero} = refl
n+sm≡sn+m {suc _} = cong suc n+sm≡sn+m
reverse-better-aux : ∀ {X n m} → Vec X n → Vec X m → Vec X (n +N m)
reverse-better-aux [] v₂ = v₂
reverse-better-aux (x ,- v₁) v₂ = subst (Vec _) n+sm≡sn+m (reverse-better-aux v₁ (x ,- v₂))
n+0≡n : ∀ {n} → n +N 0 ≡ n
n+0≡n {zero} = refl
n+0≡n {suc _} = cong suc n+0≡n
reverse-better : ∀ {X n} → Vec X n → Vec X n
reverse-better v = subst (Vec _) n+0≡n (reverse-better-aux v [])
So what I have so far is something like this:
combs :: [[Char]]
combs = [[i] ++ [j] ++ [k] ++ [l] | i <- x, j <- x, k <- x, l <- x]
where x = "abc"
So this is the working function for n = 4, is there any way to make this work for an arbitrary number of generators? I could program in for n = 1, 2, 3 etc.. but ideally need it to work for any given n. For reference, x is just an arbitrary string of unique characters. I'm struggling to think of a way to somehow extract it to work for n generators.
You can use replicateM:
replicateM :: Applicative m => Int -> m a -> m [a]
E.g.:
generate :: Num a => Int -> [[a]]
generate = flip replicateM [1,2,3]
to generate all possiible lists of a given length and consisting of elements 1..3.
As far as I know, you can not construct list comprehension with an arbitrary number of generators, but usually if you do something with arbitrary depth, recursion is the way to do it.
So we have to think of solving this, in terms of itself. If you want all possible strings that can be generated with the characters in x. In case n = 0, we can generate exactly one string: the empty string.
combs 0 = [""]
so a list with one element [].
Now in case we want to generate strings with one characters, we can of course simply return x:
combs 1 = x
and now the question is what to do in case n > 1. In that case we can obtain all the strings with length n-1, and and for each such string, and each such character in x, produce a new string. Like:
combs n = [ (c:cs) | c <- x, cs <- combs (n-1) ]
Note that this makes the second case (n = 1) redundant. We can pick a character c from x, and prepend that to the empty string. So a basic implementation is:
combs :: Int -> [[Char]]
combs 0 = [""]
combs n = [(c:cs) | c <- x, cs <- combs (n-1)]
where x = "abc"
Now we can still look for improvements. List comprehensions are basically syntactical sugar for the list monad. So we can use liftA2 here:
import Control.Applicative(liftA2)
combs :: Int -> [[Char]]
combs 0 = [""]
combs n = liftA2 (:) x (combs (n-1))
where x = "abc"
we probably also want to make the set of characters a parameter:
import Control.Applicative(liftA2)
combs :: [Char] -> Int -> [[Char]]
combs _ 0 = [""]
combs x n = liftA2 (:) x (combs (n-1))
and we do not have to restrict us to characters, we can produce a certesian power for all possible types:
import Control.Applicative(liftA2)
combs :: [a] -> Int -> [[a]]
combs _ 0 = [[]]
combs x n = liftA2 (:) x (combs (n-1))
First I would translate the comprehension as a monadic expression.
x >>= \i -> x >>= \j -> x >>= \k -> x >>= \l -> return [i,j,k,l]
With n = 4 we see we have 4 x's, and generally will have n x's. Therefore, I am thinking about a list of x's of length n.
[x,x,x,x] :: [[a]]
How might we go from [x,x,x,x] to the monadic expression? A first good guess is foldr, since we want to do something with each element of the list. Particularly, we want to take an element from each x and form a list with these elements.
foldr :: (a -> b -> b) -> b -> [a] -> b
-- Or more accurately for our scenario:
foldr :: ([a] -> [[a]] -> [[a]]) -> [[a]] -> [[a]] -> [[a]]
There are two terms to come up with for foldr, which I will call f :: [a] -> [[a]] -> [[a]] and z :: [[a]]. We know what foldr f z [x,x,x,x] is:
foldr f z [x,x,x,x] = f x (f x (f x (f x z)))
If we add parentheses to the earlier monadic expression, we have this:
x >>= \i -> (x >>= \j -> (x >>= \k -> (x >>= \l -> return [i,j,k,l])))
You can see how the two expressions are looking similar. We should be able to find an f and z to make them the same. If we choose f = \x a -> x >>= \x' -> a >>= \a' -> return (x' : a') we get:
f x (f x (f x (f x z)))
= (\x a -> a >>= \a' -> x >>= \x' -> return (x' : a')) x (f x (f x (f x z)))
= f x (f x (f x z)) >>= \a' -> x >>= \x' -> return (x' : a')
= f x (f x (f x z)) >>= \a' -> x >>= \l -> return (l : a')
= (f x (f x z) >>= \a' -> x >>= \k -> return (k : a')) >>= \a' -> x >>= \l -> return (l : a')
= f x (f x z) >>= \a' -> x >>= \k -> x >>= \l -> return (l : k : a')
Note that I have reversed the order of i,j,k,l to l,k,j,i but in context of finding combinations, this should be irrelevant. We could try a' ++ [x'] instead if it was really of concern.
The last step is because (a >>= \b -> c) >>= \d -> e is the same as a >>= \b -> c >>= \d -> e (when accounting for variable hygiene) and return a >>= \b -> c is the same as (\b -> c) a.
If we keep unfolding this expression, eventually we will reach z >>= \a' -> … on the front. The only choice that makes sense here then is z = [[]]. This means that foldr f z [] = [[]] which may not be desirable (preferring [] instead). Instead, we might use foldr1 (for non-empty lists, and we might use Data.NonEmpty) or we might add a separate clause for empty lists to combs.
Looking at f = \x a -> x >>= \x' -> a >>= \a' -> return (x' : a') we might realise this helpful equivalence: a >>= \b -> return (c b) = c <$> a. Therefore, f = \x a -> x >>= \x' -> (x' :) <$> a. Then also, a >>= \b -> c (g b) = g <$> a >>= \b -> c and so f = (:) <$> x >>= \x' -> x' <$> a. Finally, a <*> b = a >>= \x -> x <$> b and so f = (:) <$> x <*> a.
The official implementation of sequenceA for lists is foldr (\x a -> (:) <$> x <*> a) (pure []), exactly what we came up with here too. This can be further shortened as foldr (liftA2 (:)) (pure []) but there is possibly some optimisation difference that made the implementors not choose this.
Last step is to merely come up with a list of n x's. This is just replicate replicate n x. There happens to be a function which does both replication and sequencing, called replicateM replicateM n x.
I'm trying to write a Haskell function that automatically distributes a binary operation over a list, kind of how arithmetic operations work in the J language.
You can think of it as a "deep zipWith" that works on nested lists of any depth, including non-lists and lists of different depths.
For example:
distr (+) 1 10 === 11 -- Non-list values are added together
distr (+) [1,2] 10 === [11,12] -- Non-list values distribute over lists
distr (+) [1,2] [10,20] === [11,22] -- Two lists get zipped
distr (+) [[1,2],[3,4]] [[10,20],[30,40]] === [[11,22],[33,44]] -- Nested lists get zipped
Lists of different lengths get truncated, like with zipWith, but this is not important.
Now, I have already written this:
{-# LANGUAGE
MultiParamTypeClasses,
FunctionalDependencies,
UndecidableInstances,
FlexibleInstances
#-}
class Distr a b c x y z | a b c x y -> z
where distr :: (a -> b -> c) -> (x -> y -> z)
instance Distr a b c a b c where distr = id
instance {-# OVERLAPPING #-}
(Distr a b c x y z) => Distr a b c [x] [y] [z]
where distr = zipWith . distr
instance (Distr a b c x y z) => Distr a b c [x] y [z]
where distr f xs y = map (\x -> distr f x y) xs
instance (Distr a b c x y z) => Distr a b c x [y] [z]
where distr f x ys = map (\y -> distr f x y) ys
This defines a 6-parameter typeclass Distr with a function distr :: (Distr a b c x y z) => (a -> b -> c) -> (x -> y -> z), and some instances of Distr on nested lists.
It works well on the examples above, but its behavior on lists of unequal nesting depth is not exactly what I want.
It does this (which works if you add type annotations to (+) and both lists):
distr (+) [[1,2],[3,4]] [10,20] === [[11,12],[23,24]] -- Zip and distribute
Try it here.
What I want is this:
distr (+) [[1,2],[3,4]] [10,20] === [[11,22],[13,24]] -- Distribute and zip
The current implementation applies zipWith until one of its arguments is a non-list value, which is then distributed over the other list.
I would prefer it to distribute one argument (the one with fewer list layers) over the other until it reaches equal nesting depth, and then use zipWith to reduce them to non-list values.
My question is: Can I achieve the second kind of behavior?
I'm happy with a solution that requires me to explicitly tell Haskell the types of the operator and each argument, as my current solution does.
I will not call distr on an operator that takes lists as inputs, so that case need not be handled.
However, I don't want to give extra arguments to distr that serve as type hints, or have several different versions of distr for different use cases.
I know my problem could be solved this way, but I'd prefer a solution where it isn't necessary.
(As a gist in Literate Haskell)
{-# LANGUAGE DataKinds, FlexibleContexts, FlexibleInstances,
TypeFamilies, MultiParamTypeClasses, UndecidableInstances,
RankNTypes, ScopedTypeVariables, FunctionalDependencies, TypeOperators #-}
module Zip where
import Data.Proxy
import GHC.TypeLits
Let's first assume that the two nested lists have the same depth. E.g., depth 2:
zipDeep0 ((+) :: Int -> Int -> Int) [[1,2],[3,4,5]] [[10,20],[30,40]] :: [[Int]]
[[11,22],[33,44]]
Implementation:
zipDeep0
:: forall n a b c x y z
. (ZipDeep0 n a b c x y z, n ~ Levels a x, n ~ Levels b y, n ~ Levels c z)
=> (a -> b -> c) -> (x -> y -> z)
zipDeep0 = zipDeep0_ (Proxy :: Proxy n)
Levels a x computes the depth of a in the nested list type x.
Closed type families allow us to do some non-linear type-level pattern matching
(where a occurs twice in a clause).
type family Levels a x :: Nat where
Levels a a = 0
Levels a [x] = 1 + Levels a x
We use that depth to select the ZipDeep0 instance implementing the zip,
This way is neater than relying only on the six other ordinary type parameters,
as it avoids a problem with type inference and overlapping instances when some list is empty (so
we can't infer its actual type from itself), or when a, b, c are also
list types.
class ZipDeep0 (n :: Nat) a b c x y z where
zipDeep0_ :: proxy n -> (a -> b -> c) -> x -> y -> z
-- Moving the equality constraints into the context helps type inference.
instance {-# OVERLAPPING #-} (a ~ x, b ~ y, c ~ z) => ZipDeep0 0 a b c x y z where
zipDeep0_ _ = id
instance (ZipDeep0 (n - 1) a b c x y z, xs ~ [x], ys ~ [y], zs ~ [z])
=> ZipDeep0 n a b c xs ys zs where
zipDeep0_ _ f = zipWith (zipDeep0_ (Proxy :: Proxy (n - 1)) f)
When the two lists are not of the same depth, let's first assume the second one
is deeper, so we must distribute over it.
We start losing some type inference, we must know at least Levels a x (and
thus a and x) and either Levels b y or Levels c z before this function
can be applied.
Example:
zipDeep1 (+) [10,20 :: Int] [[1,2],[3,4]] :: [[Int]]
[[11,22],[13,24]]
Implementation:
zipDeep1
:: forall n m a b c x y z
. (n ~ Levels a x, m ~ Levels b y, m ~ Levels c z, ZipDeep1 (m - n) a b c x y z)
=> (a -> b -> c) -> x -> y -> z
zipDeep1 = zipDeep1_ (Proxy :: Proxy (m - n))
The difference between levels (m - n) tells us how many layers we must "distribute"
through before falling back to zipDeep0.
class ZipDeep1 (n :: Nat) a b c x y z where
zipDeep1_ :: proxy n -> (a -> b -> c) -> x -> y -> z
instance {-# OVERLAPPING #-} ZipDeep0 (Levels a x) a b c x y z => ZipDeep1 0 a b c x y z where
zipDeep1_ _ = zipDeep0_ (Proxy :: Proxy (Levels a x))
instance (ZipDeep1 (n - 1) a b c x y z, ys ~ [y], zs ~ [z]) => ZipDeep1 n a b c x ys zs where
zipDeep1_ proxy f xs = fmap (zipDeep1_ (Proxy :: Proxy (n - 1)) f xs)
Finally, we can do a type-level comparison when either list may be the deeper
one. We lose all type inference though.
Example:
zipDeep ((+) :: Int -> Int -> Int) [[1,2 :: Int],[3,4]] [10 :: Int,20] :: [[Int]]
[[11,22],[13,24]]
Some type inference is recovered by instead specifying the expected depth of
each list with TypeApplications.
zipDeep #2 #1 ((+) :: Int -> Int -> Int) [[1,2],[3,4]] [10,20]
[[11,22],[13,24]]
Implementation:
zipDeep
:: forall n m a b c x y z
. (ZipDeep2 (CmpNat n m) n m a b c x y z, n ~ Levels a x, m ~ Levels b y)
=> (a -> b -> c) -> x -> y -> z
zipDeep = zipDeep2_ (Proxy :: Proxy '(CmpNat n m, n, m))
class ZipDeep2 (cmp :: Ordering) (n :: Nat) (m :: Nat) a b c x y z where
zipDeep2_ :: proxy '(cmp, n, m) -> (a -> b -> c) -> x -> y -> z
instance {-# OVERLAPPING #-} (n ~ Levels a x, m ~ Levels b y, m ~ Levels c z, ZipDeep1 (m - n) a b c x y z)
=> ZipDeep2 'LT n m a b c x y z where
zipDeep2_ _ = zipDeep1
instance (n ~ Levels a x, m ~ Levels b y, n ~ Levels c z, ZipDeep1 (n - m) b a c y x z)
=> ZipDeep2 cmp n m a b c x y z where
zipDeep2_ _ = flip . zipDeep1 . flip
Agda makes use of the following operator to show inverses between sets:
_↔_ : ∀ {f t} → Set f → Set t → Set _
Is there an equivalent in Idris? I'm trying to define bag equality on lists
data Elem : a -> List a -> Type where
Here : {xs : List a} -> Elem x (x :: xs)
There : {xs : List a} -> Elem x xs -> Elem x (y :: xs)
(~~) : List a -> List a -> Type
xs ~~ ys {a} = Elem a xs <-> Elem a ys
So that we can construct l1 ~~ l2 when l1 and l2 have the same elements in any order.
The Agda definition of ↔ seems to be very complicated and I am not sure if there is something equivalent in the Idris standard library.
The basic idea behind Agda's ↔ is to package up two functions with two proofs of roundtripping, which is easy enough to do in Idris as well:
infix 7 ~~
data (~~) : Type -> Type -> Type where
MkIso : {A : Type} -> {B : Type} ->
(to : A -> B) -> (from : B -> A) ->
(fromTo : (x : A) -> from (to x) = x) ->
(toFrom : (y : B) -> to (from y) = y) ->
A ~~ B
You can use it like in the following minimal example:
notNot : Bool ~~ Bool
notNot = MkIso not not prf prf
where
prf : (x : Bool) -> not (not x) = x
prf True = Refl
prf False = Refl
The reason the Agda version is more complicated is because it is parameterized over the choice of equality as well, so it doesn't have to be the propositional one (which is the strictest/finest there is). Parameterizing the Idris definition of ~~ above from = to arbitrary PA : A -> A -> Type and PB : B -> B -> Type is left as an exercise to the reader.
How would I combine the following 2 functions:
replaceNth n newVal (x:xs)
| n == 0 = newVal:xs
| otherwise = x:replaceNth (n-1) newVal xs
replaceMthNth m n v arg = replaceNth m (replaceNth n v (arg !! m)) arg
into a single function?
Is it possible?
This is pretty hideous but it does the job:
replacemn 0 0 z ((x : xs) : xss) = (z : xs) : xss
replacemn 0 n z ((x : xs) : xss) =
let (ys : yss) = replacemn 0 (n-1) z (xs : xss)
in ((x : ys) : yss)
replacemn m n z (xs:xss) = xs : replacemn (m-1) n z xss
Function composition
Functions in Haskell may be composed at no cost. E.g. given two functions, f and g, you can compose them into a new function: f . g, which applies g to an argument, then applies f to the result. You should be able to use composition in the same way here.
Ok, here it is with no other named functions in the global namespace, or using any where or let clauses or any other global functions.
{-# LANGUAGE ScopedTypeVariables,RankNTypes #-}
module Temp where
newtype Mu a = Mu (Mu a -> a)
replaceMthNth :: Int -> Int -> a -> [[a]] -> [[a]]
replaceMthNth = (\h (f :: Int -> forall b . b -> [b] -> [b]) -> h f f)
( \replaceNth replaceNth' ->
-- definition of replaceMthNth in terms of some replaceNth and replaceNth'
\m n v arg -> replaceNth m (replaceNth' n v (arg !! m)) arg
)
$
-- y combinator
((\f -> (\h -> h $ Mu h) $ \x -> f $ (\(Mu g) -> g) x $ x) :: (a -> a) -> a) $
(\replaceNth ->
-- definition of replaceNth given a recursive definition
(\(n::Int) newVal xs -> case xs of
[] -> []
(x:xs) -> if n == 0 then newVal:xs else x:replaceNth (n-1) newVal xs
)
)
I don't understand what the question is at all :), but here is how I would implement it:
modifyNth :: Int -> (a -> a) -> [a] -> [a]
modifyNth n f (x:xs)
| n == 0 = f x : xs
| otherwise = x : modifyNth (n-1) f xs
replaceNthMth :: Int -> Int -> a -> [[a]] -> [[a]]
replaceNthMth m n v = modifyNth m (modifyNth n (const v))
This way you don't need to traverse the list twice (first time with !!, second time with replaceNth)
Here's a grotesque implementation that rebuilds the 2d list structure with nested list comprehensions over zips with infinite lists:
replaceMthNth :: Int -> Int -> a -> [[a]] -> [[a]]
replaceMthNth m n v ass = [[if (x,y) == (m,n) then v else a
| (y, a) <- zip [0..] as]
| (x, as) <- zip [0..] ass]