I created a custom List type and I'm trying to implement the zip function for it. But I cant figure it out, it always throw an error on the last line.
data List a = Empty | Cons a (List a) deriving (Eq, Ord, Show, Read)
listZip :: List a -> List a -> List a
listZip _ Empty = Empty
listZip Empty _ = Empty
listZip (Cons x1 (x2)) (Cons y1 (y2)) = Cons (Cons x1 y1) (listZip x2 y2)
The return type looks wrong, you probably want to return a list of 2-tuples, so:
listZip :: List a -> List a -> List (a, a)
or more generic:
listZip :: List a -> List b -> List (a, b)
Then you implement this with:
listZip :: List a -> List b -> List (a, b)
listZip _ Empty = Empty
listZip Empty _ = Empty
listZip (Cons x1 (x2)) (Cons y1 (y2)) = Cons … (listZip x2 y2)
where I leave the … part as an exercise.
Related
As the title suggests i am trying to implement a high order function declared as
Ord u => [v->u]->[v]->[u]
that has inputs a) a list of functions of any type and a range of values of any type and b) a list of elements of the same type and then it will return a list that is the result of all elements that occured from applying a function from the given list to an element from the given list in ascending order without repetitive values.
i was trying to implement it with the foldr function with no luck.
i thought that i can index with zip the functions as a pair so they will be applied one by one with the foldr function. bellow that i created a insertion sort so i can sort the final list
apply :: Ord u => [v->u]->[v]->[u]
apply f y = insSort (foldr(\(i, x) y -> x:y ) (zip [1..] f))
insSort :: Ord u => [u] -> [u]
insSort (h:t) = insert h (insSort t)
insSort [] = []
insert :: Ord u => u -> [u] -> [u]
insert n (h:t)
| n <= h = n : h : t
| otherwise = h : insert n t
insert n [] = [n]
for example some inputs with the output:
>apply [abs] [-1]
[1]
>apply [(^2)] [1..5]
[1,4,9,16,25]
>apply [(^0),(0^),(\x->div x x),(\x->mod x x)] [1..1000]
[0,1]
>apply [head.tail,last.init] ["abc","aaaa","cbbc","cbbca"]
"abc"
> apply [(^2),(^3),(^4),(2^)] [10]
[100,1000,1024,10000]
>apply [(*5)] (apply [(‘div‘5)] [1..100])
[0,5,10,15,20,25,30,35,40,45,50,55,60,65,70,75,80,85,90,95,100]
apply :: [a -> b] -> [a] -> [b]
First of all, this signature matches that of the standard <*> function, which is part of the Applicative class.
class Applicative f where
pure :: a -> f a
(<*>) :: f (a -> b) -> f a -> f b
Setting f ~ [] we have <*> :: [a -> b] -> [a] -> [b].
There are at least two sensible ways of writing an Applicative instance for lists. The first one takes the Cartesian product of its inputs, pairing every function with every value. If <*>'s input lists have length N and M, the output list will have length N*M. pure for this specification would put an element in a singleton list, so that pure id <*> xs = xs.
instance Applicative [] where
pure x = [x]
(f:fs) <*> xs = map f xs ++ (fs <*> xs)
This is equivalent to the standard Applicative instance for [].
The other sensible way of implementing Applicative zips the two lists together by applying functions to elements pointwise. If <*>'s input lists have length N and M, the output list will have length min(N, M). pure creates an infinite list, so once again pure id <*> xs = xs.
instance Applicative [] where
pure x = let xs = x:xs in xs
[] <*> _ = []
_ <*> [] = []
(f:fs) <*> (x:xs) = f x : (fs <*> xs)
This instance is available in base under the ZipList newtype.
To simplify the problem I'm facing, assume this data type:
data Item = X Int | Y Char deriving (Eq, Show..)
and two lists
let a = [X 1, Y 'g']
let b = [X 2]
I need to replace all items in a with the first (or any) item in b with the same constructor. So the result would be: [X 2, Y 'g'].
Any suggestions?
Borrowing ideas from an answer by Petr Pudlák you could try:
{-# LANGUAGE DeriveDataTypeable #-}
import Data.Data
import Data.Function (on)
import Data.List (nubBy, find)
import Data.Maybe (fromMaybe)
data Item = X Int | Y Char
deriving (Eq, Show, Typeable, Data)
a = [X 1, Y 'g']
b = [X 2]
main :: IO ()
main = print $ map replace a
where b' = nubBy (on (==) toConstr) b -- remove duplicates
replace x = fromMaybe x $ find (on (==) toConstr x) b'
You can also skip removing the duplicates in b and use b instead of b' in the last line.
First you'll need a way to determine what constructor has been used:
isX :: Item -> Bool
isX (X _) = True
isX _ = False
-- If you have more than 2 constructors you'll have to write them all like isX
isY :: Item -> Bool
isY = not . isX
And a method to get the first value of each kind of constructor
import Data.Maybe
firstX :: [Item] -> Maybe Item
firstX = listToMaybe . filter isX
firstY :: [Item] -> Maybe Item
firstY = listToMaybe . filter isY
Then a way to replace items
replaceItem :: Item -> Maybe Item -> Item
replaceItem = fromMaybe
replaceItems :: [Item] -> Maybe Item -> Maybe Item -> [Item]
replaceItems [] _ _ = []
replaceItems (item:items) x y =
(if isX item
then replaceItem item x
else replaceItem item y) : replaceItems items x y
But since this is just a map:
replaceXY :: Item -> Maybe Item -> Maybe Item -> [Item]
replaceXY item x y =
if isX item
then replaceItem item x
else replaceItem item y
replaceItems items x y = map (\item -> replaceXY item x y) items
And finally you just have to combine this with firstX and firstY:
replaceFrom :: [Item] -> [Item] -> [Item]
replaceFrom a b =
let x = firstX b
y = firstY b
in replaceXY a x y
You can just make a function to replace the items:
specialReplace :: Item -> Item -> Item
specialReplace (X x1) (X x2) = (X x1)
specialReplace (Y y1) (Y y2) = (Y y1)
specialReplace _ a = a
and then:
foldr (\el list -> map (specialReplace el) list) a b
will run trough your a list and apply the correlated substitutions in b accordingly. Of course if more Xs or Ys are introduced in the b list, then last one will be used at the end.
Your live exampleAnother live example
For a given Item and a list to be replaced, consider,
replace' :: Item -> [Item] -> [Item]
replace' _ [] = []
replace' (X i) ((X j):xs) = (X i) : replace' (X i) xs
replace' (Y i) ((Y j):xs) = (Y i) : replace' (Y i) xs
replace' r (x:xs) = x : replace' r xs
in which each pattern related to each type in Item. In this approach the latest occurrence of each type will be kept in the replaced list.
I have a type synonym type Entity = ([Feature], Body) for whatever Feature and Body mean. Objects of Entity type are to be grouped together:
type Bunch = [Entity]
and the assumption, crucial for the algorithm working with Bunch, is that any two entities in the same bunch have the equal number of features.
If I were to implement this constraint in an OOP language, I would add the corresponding check to the method encapsulating the addition of entities into a bunch.
Is there a better way to do it in Haskell? Preferably, on the definition level. (If the definition of Entity also needs to be changed, no problem.)
Using type-level length annotations
So here's the deal. Haskell does have type-level natural numbers and you can annotate with types using "phantom types". However you do it, the types will look like this:
data Z
data S n
data LAList x len = LAList [x] -- length-annotated list
Then you can add some construction functions for convenience:
lalist1 :: x -> LAList x (S Z)
lalist1 x = LAList [x]
lalist2 :: x -> x -> LAList x (S (S Z))
lalist2 x y = LAList [x, y]
-- ...
And then you've got more generic methods:
(~:) :: x -> LAList x n -> LAList x (S n)
x ~: LAList xs = LAList (x : xs)
infixr 5 ~:
nil :: LAList x Z
nil = LAList []
lahead :: LAList x (S n) -> x
lahead (LAList xs) = head xs
latail :: LAList x (S n) -> LAList x n
latail (LAList xs) = tail xs
but by itself the List definition doesn't have any of this because it's complicated. You may be interested in the Data.FixedList package for a somewhat different approach, too. Basically every approach is going to start off looking a little weird with some data type that has no constructor, but it starts to look normal after a little bit.
You might also be able to get a typeclass so that all of the lalist1, lalist2 operators above can be replaced with
class FixedLength t where
la :: t x -> LAList x n
but you will probably need the -XTypeSynonymInstances flag to do this, as you want to do something like
type Pair x = (x, x)
instance FixedLength Pair where
la :: Pair x -> LAList [x] (S (S Z))
la (a, b) = LAList [a, b]
(it's a kind mismatch when you go from (a, b) to Pair a).
Using runtime checking
You can very easily take a different approach and encapsulate all of this as a runtime error or explicitly model the error in your code:
-- this may change if you change your definition of the Bunch type
features :: Entity -> [Feature]
features = fst
-- we also assume a runBunch :: [Entity] -> Something function
-- that you're trying to run on this Bunch.
allTheSame :: (Eq x) => [x] -> Bool
allTheSame (x : xs) = all (x ==) xs
allTheSame [] = True
permissiveBunch :: [Entity] -> Maybe Something
permissiveBunch es
| allTheSame (map (length . features) es) = Just (runBunch es)
| otherwise = Nothing
strictBunch :: [Entity] -> Something
strictBunch es
| allTheSame (map (length . features) es) = runBunch es
| otherwise = error ("runBunch requires all feature lists to be the same length; saw instead " ++ show (map (length . features) es))
Then your runBunch can just assume that all the lengths are the same and it's explicitly checked for above. You can get around pattern-matching weirdnesses with, say, the zip :: [a] -> [b] -> [(a, b)] function in the Prelude, if you need to pair up the features next to each other. (The goal here would be an error in an algorithm due to pattern-matching for both runBunch' (x:xs) (y:ys) and runBunch' [] [] but then Haskell warns that there are 2 patterns which you've not considered in the match.)
Using tuples and type classes
One final way to do it which is a compromise between the two (but makes for pretty good Haskell code) involves making Entity parametrized over all features:
type Entity x = (x, Body)
and then including a function which can zip different entities of different lengths together:
class ZippableFeatures z where
fzip :: z -> z -> [(Feature, Feature)]
instance ZippableFeatures () where
fzip () () = []
instance ZippableFeatures Feature where
fzip f1 f2 = [(f1, f2)]
instance ZippableFeatures (Feature, Feature) where
fzip (a1, a2) (b1, b2) = [(a1, b1), (a2, b2)]
Then you can use tuples for your feature lists, as long as they don't get any larger than the maximum tuple length (which is 15 on my GHC). If you go larger than that, of course, you can always define your own data types, but it's not going to be as general as type-annotated lists.
If you do this, your type signature for runBunch will simply look like:
runBunch :: (ZippableFeatures z) => [Entity z] -> Something
When you run it on things with the wrong number of features you'll get compiler errors that it can't unify the type (a, b) with (a, b, c).
There are various ways to enforce length constraints like that; here's one:
{-# LANGUAGE DataKinds, KindSignatures, GADTs, TypeFamilies #-}
import Prelude hiding (foldr)
import Data.Foldable
import Data.Monoid
import Data.Traversable
import Control.Applicative
data Feature -- Whatever that really is
data Body -- Whatever that really is
data Nat = Z | S Nat -- Natural numbers
type family Plus (m::Nat) (n::Nat) where -- Type level natural number addition
Plus Z n = n
Plus (S m) n = S (Plus m n)
data LList (n :: Nat) a where -- Lists tagged with their length at the type level
Nil :: LList Z a
Cons :: a -> LList n a -> LList (S n) a
Some functions on these lists:
llHead :: LList (S n) a -> a
llHead (Cons x _) = x
llTail :: LList (S n) a -> LList n a
llTail (Cons _ xs) = xs
llAppend :: LList m a -> LList n a -> LList (Plus m n) a
llAppend Nil ys = ys
llAppend (Cons x xs) ys = Cons x (llAppend xs ys)
data Entity n = Entity (LList n Feature) Body
data Bunch where
Bunch :: [Entity n] -> Bunch
Some instances:
instance Functor (LList n) where
fmap f Nil = Nil
fmap f (Cons x xs) = Cons (f x) (fmap f xs)
instance Foldable (LList n) where
foldMap f Nil = mempty
foldMap f (Cons x xs) = f x `mappend` foldMap f xs
instance Traversable (LList n) where
traverse f Nil = pure Nil
traverse f (Cons x xs) = Cons <$> f x <*> traverse f xs
And so on. Note that n in the definition of Bunch is existential. It can be anything, and what it actually is doesn't affect the type—all bunches have the same type. This limits what you can do with bunches to a certain extent. Alternatively, you can tag the bunch with the length of its feature lists. It all depends what you need to do with this stuff in the end.
I can view the, say, 4th item in a list using a lens like this:
preview (ix 3) myList
Is there something that could replace "preview" in order to remove the fourth item from the list instead of viewing it? The return list should be the same as the original list say the 4th item would be deleted.
Or perhaps there may be a way of doing this using the filtered function?
Sounds like you want to use ifiltered:
toListOf (folded . ifiltered (\i _ -> i /= 3)) $ myList
-- or
myList ^.. folded . ifiltered (\i _ -> i /= 3))
There is a more general way of doing this, using Monoid and Foldable.
deleteN
:: (Foldable f, Monoid (f a))
=> (a -> f a -> f a) -- ^ cons operator
-> Int -- ^ index to delete
-> f a -- ^ initial structure
-> f a -- ^ resultant structure
deleteN cons n xs = flipTfo xs $ folded . ifiltered (\i _ -> i /= n)
where
flipTfo = flip toFoldableOf
toFoldableOf l = foldrOf l cons mempty
and you can specialise this to list with
deleteList :: Monoid a => Int -> [a] -> [a]
deleteList = deleteN (:)
I'm trying to implement a kind of zipper for length-indexed lists which would return each item of the list paired with a list where that element is removed. E.g. for ordinary lists:
zipper :: [a] -> [(a, [a])]
zipper = go [] where
go _ [] = []
go prev (x:xs) = (x, prev ++ xs) : go (prev ++ [x]) xs
So that
> zipper [1..5]
[(1,[2,3,4,5]), (2,[1,3,4,5]), (3,[1,2,4,5]), (4,[1,2,3,5]), (5,[1,2,3,4])]
My current attempt at implementing the same thing for length-indexed lists:
{-# LANGUAGE GADTs #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeFamilies #-}
data Nat = Zero | Succ Nat
type One = Succ Zero
type family (+) (a :: Nat) (b :: Nat) :: Nat
type instance (+) Zero n = n
type instance (+) (Succ n) m = Succ (n + m)
data List :: Nat -> * -> * where
Nil :: List Zero a
Cons :: a -> List size a -> List (Succ size) a
single :: a -> List One a
single a = Cons a Nil
cat :: List a i -> List b i -> List (a + b) i
cat Nil ys = ys
cat (Cons x xs) ys = Cons x (xs `cat` ys)
zipper :: List (Succ n) a -> List (Succ n) (a, List n a)
zipper = go Nil where
go :: (p + Zero) ~ p
=> List p a -> List (Succ q) a -> List (Succ q) (a, List (p + q) a)
go prev (Cons x Nil) = single (x, prev)
go prev (Cons x xs) = (x, prev `cat` xs) `Cons` go (prev `cat` single x) xs
This feels like it should be rather straightforward, but as there doesn't seem to be any way to convey to GHC that e.g. + is commutative and associative or that zero is the identity, I'm running into lots of problems where the type checker (understandably) complains that it cannot determine that a + b ~ b + a or that a + Zero ~ a.
Do I need to add some sort of proof objects (data Refl a b where Refl :: Refl a a et al.) or is there some way to make this work with just adding more explicit type signatures?
Alignment
Dependently typed programming is like doing two jigsaws which some rogue has glued together. Less metaphorically, we express simultaneous computations at the value level and at the type level, and we must ensure their compatibility. Of course, we are each our own rogue, so if we can arrange for the jigsaws to be glued in alignment, we shall have an easier time of it. When you see proof obligations for type repair, you might be tempted to ask
Do I need to add some sort of proof objects (data Refl a b where Refl :: Refl a a et al.) or is there some way to make this work with just adding more explicit type signatures?
But you might first consider in what way the value- and type-level computations are out of alignment, and whether there is any hope to bring them closer.
A Solution
The question here is how to compute the vector (length-indexed list) of selections from a vector. So we'd like something with type
List (Succ n) a -> List (Succ n) (a, List n a)
where the element in each input position gets decorated with the one-shorter vector of its siblings. The proposed method is to scan left-to-right, accumulating the elder siblings in a list which grows on the right, then concatenate with the younger siblings at each position. Growing lists on the right is always a worry, especially when the Succ for the length is aligned to the Cons on the left. The need for concatenation necessitates type-level addition, but the arithmetic resulting from right-ended activity is out of alignment with the computation rules for addition. I'll get back to this style in a bit, but let's try thinking it out again.
Before we get into any accumulator-based solution, let's just try bog standard structural recursion. We have the "one" case and the "more" case.
picks (Cons x xs#Nil) = Cons (x, xs) Nil
picks (Cons x xs#(Cons _ _)) = Cons (x, xs) (undefined (picks xs))
In both cases, we put the first decomposition at the front. In the second case, we have checked that the tail is nonempty, so we can ask for its selections. We have
x :: a
xs :: List (Succ n) a
picks xs :: List (Succ n) (a, List n a)
and we want
Cons (x, xs) (undefined (picks xs)) :: List (Succ (Succ n)) (a, List (Succ n) a)
undefined (picks xs) :: List (Succ n) (a, List (Succ n) a)
so the undefined needs to be a function which grows all the sibling lists by reattaching x at the left end (and left-endedness is good). So, I define the Functor instance for List n
instance Functor (List n) where
fmap f Nil = Nil
fmap f (Cons x xs) = Cons (f x) (fmap f xs)
and I curse the Prelude and
import Control.Arrow((***))
so that I can write
picks (Cons x xs#Nil) = Cons (x, xs) Nil
picks (Cons x xs#(Cons _ _)) = Cons (x, xs) (fmap (id *** Cons x) (picks xs))
which does the job with not a hint of addition, let alone a proof about it.
Variations
I got annoyed about doing the same thing in both lines, so I tried to wriggle out of it:
picks :: m ~ Succ n => List m a -> List m (a, List n a) -- DOESN'T TYPECHECK
picks Nil = Nil
picks (Cons x xs) = Cons (x, xs) (fmap (id *** (Cons x)) (picks xs))
But GHC solves the constraint aggressively and refuses to allow Nil as a pattern. And it's correct to do so: we really shouldn't be computing in a situation where we know statically that Zero ~ Succ n, as we can easily construct some segfaulting thing. The trouble is just that I put my constraint in a place with too global a scope.
Instead, I can declare a wrapper for the result type.
data Pick :: Nat -> * -> * where
Pick :: {unpick :: (a, List n a)} -> Pick (Succ n) a
The Succ n return index means the nonemptiness constraint is local to a Pick. A helper function does the left-end extension,
pCons :: a -> Pick n a -> Pick (Succ n) a
pCons b (Pick (a, as)) = Pick (a, Cons b as)
leaving us with
picks' :: List m a -> List m (Pick m a)
picks' Nil = Nil
picks' (Cons x xs) = Cons (Pick (x, xs)) (fmap (pCons x) (picks' xs))
and if we want
picks = fmap unpick . picks'
That's perhaps overkill, but it might be worth it if we want to separate older and younger siblings, splitting lists in three, like this:
data Pick3 :: Nat -> * -> * where
Pick3 :: List m a -> a -> List n a -> Pick3 (Succ (m + n)) a
pCons3 :: a -> Pick3 n a -> Pick3 (Succ n) a
pCons3 b (Pick3 bs x as) = Pick3 (Cons b bs) x as
picks3 :: List m a -> List m (Pick3 m a)
picks3 Nil = Nil
picks3 (Cons x xs) = Cons (Pick3 Nil x xs) (fmap (pCons3 x) (picks3 xs))
Again, all the action is left-ended, so we're fitting nicely with the computational behaviour of +.
Accumulating
If we want to keep the style of the original attempt, accumulating the elder siblings as we go, we could do worse than to keep them zipper-style, storing the closest element in the most accessible place. That is, we can store the elder siblings in reverse order, so that at each step we need only Cons, rather than concatenating. When we want to build the full sibling list in each place, we need to use reverse-concatenation (really, plugging a sublist into a list zipper). You can type revCat easily for vectors if you deploy the abacus-style addition:
type family (+/) (a :: Nat) (b :: Nat) :: Nat
type instance (+/) Zero n = n
type instance (+/) (Succ m) n = m +/ Succ n
That's the addition which is in alignment with the value-level computation in revCat, defined thus:
revCat :: List m a -> List n a -> List (m +/ n) a
revCat Nil ys = ys
revCat (Cons x xs) ys = revCat xs (Cons x ys)
We acquire a zipperized go version
picksr :: List (Succ n) a -> List (Succ n) (a, List n a)
picksr = go Nil where
go :: List p a -> List (Succ q) a -> List (Succ q) (a, List (p +/ q) a)
go p (Cons x xs#Nil) = Cons (x, revCat p xs) Nil
go p (Cons x xs#(Cons _ _)) = Cons (x, revCat p xs) (go (Cons x p) xs)
and nobody proved anything.
Conclusion
Leopold Kronecker should have said
God made the natural numbers to perplex us: all the rest is the work of man.
One Succ looks very like another, so it is very easy to write down expressions which give the size of things in a way which is out of alignment with their structure. Of course, we can and should (and are about to) equip GHC's constraint solver with improved kit for type-level numerical reasoning. But before that kicks in, it's worth just conspiring to align the Conses with the Succs.