As an exercise, I am implementing in Haskell a 'cons' operation that forms a pair from two values of any type. Implementing the needed data type is easy enough:
data Nil = Nil deriving (Eq)
data Pair a b = Cons a b deriving (Eq)
car (Cons x _) = x
cdr (Cons _ y) = y
caar = car . car
cdar = cdr . car
cadr = car . cdr
cddr = cdr . cdr
*Main> cddr (Cons 55 (Cons (1,2,3,4) "hello, world!"))
"hello, world!"
*Main>
but inspired by this thread, I want to make the resulting pairs print out like Scheme lists would - including the infamous "improper list" (1 2 3 . 4). My implementation (see below) is working for Char's:
*Main> Cons 'a' (Cons 'b' (Cons 'c' Nil))
('a' 'b' 'c')
*Main> Cons 'a' (Cons 'b' 'c')
('a' 'b' . 'c')
*Main> Cons (Cons 'a' 'b')(Cons 'c' (Cons 'd' Nil))
(('a' . 'b') 'c' 'd')
It's not working so well for Int's (or any other data type). So my question is: how can I make this work for other data types? i.e., I want it to work like this:
*Main> Cons 5 (Cons "hello" (Cons False Nil))
(5 "hello" False)
My current full implementation follows:
data Nil = Nil deriving (Eq)
data Pair a b = Cons a b deriving (Eq)
car (Cons x _) = x
cdr (Cons _ y) = y
caar = car . car
cdar = cdr . car
cadr = car . cdr
cddr = cdr . cdr
instance Show Nil where show _ = "()"
class ShowPair a where
showRight::a->String
instance (Show a, ShowPair a, ShowPair b)=>Show (Pair a b) where
show (Cons car cdr) = "(" ++ (show car) ++ (showRight cdr) ++ ")"
instance (Show a, ShowPair a, ShowPair b)=>ShowPair (Pair a b) where
showRight (Cons car cdr) = " " ++ (show car) ++ (showRight cdr)
instance ShowPair Char where
showRight x = " . " ++ show x
instance ShowPair Int where
showRight x = " . " ++ show x
instance ShowPair Nil where
showRight _ = ""
Here's an option. First, enable these extensions by putting this line at the top of your file:
{-# LANGUAGE FlexibleInstances, OverlappingInstances, UndecidableInstances#-}
Next, remove your ShowPair instances for Char and Int.
Now add a ShowPair instance for anything with Show:
instance Show a => ShowPair a where showRight = (" . " ++) . show
This now ensures that any type a which is an instance of Show is also an instance of ShowPair where it is shown by prepending a . to its normal string form. However, if a type has a more specific ShowPair instance (e.g. Nil), Haskell will use that one instead.
This is not part of standard Haskell, so you need to enable the three language extensions. Look at How to write an instance for all types in another type class? for more information on why you need the extensions.
Ben in the comments to the question mentions the native pair type, which I'm going to use in this answer. I'm also going to substitute your Nil with the Haskell unit type ().
This is a bit outside what you're asking, but I think it's worth saying. It is difficult in Haskell to capture the notion of a "list" in Scheme unless you "cheat" and use an extension like Data.Dynamic. This is because from the point of view of "pure," unextended Haskell, it is difficult if not impossible to assign all Scheme lists the same type. This means that while Scheme allows you to write functions that take any list, proper or improper, you're going to have a hard time doing the same in Haskell (and for good reason; improper "lists" should probably not exist anyway).
So for example, you've basically chosen to use (a, b) as the type of Scheme-like pairs. Now suppose we have these Scheme lists:
(define zero '())
(define one '(1))
(define two '(1 2))
(define three '(1 2 3))
(define four '(1 2 3 4))
Here's a simple translation in terms of Haskell pairs, which corresponds to the way you're doing it:
zero :: ()
zero = ()
one :: (Integer, ())
one = (1, ())
two :: (Integer, (Integer, ()))
two = (1, (2, ()))
three :: (Integer, (Integer, (Integer, ())))
three = (1, (2, (3, ())))
four :: (Integer, (Integer, (Integer, (Integer, ()))))
four = (1, (2, (3, (4, ()))))
The key thing is that in Scheme you can easily write a function that ranges over all lists:
(define (reverse list)
(foldl cons '() list))
(define (filter pred? list)
(foldr (lambda (elem rest)
(if (pred? elem)
(cons elem rest)
rest))
'()
list))
(define (foldl fn init list)
(if (null? list)
init
(foldl fn (fn (car list) init) (cdr list))))
(define (foldr fn init list)
(if (null? list)
init
(fn (car list)
(foldr fn init (cdr list)))))
In this Haskell translation, you cannot do that easily at all, because "lists" of different lengths have different types. And it gets worse when you consider the difference between reverse (which takes a list of length n and produces a list of length n) and filter (which takes a list of length n and produces a list of length m ≤ n such that m can only be known at runtime).
Related
I´m trying to understand haskell and I´m stuck with a "cannot construct the infinite type"-error
I want to implement "<*>" for my own data type, imitating the behaviour of a list.
My functioning code so far:
data List a = Nil | Cons a (List a) deriving Show
instance Functor (List) where
-- fmap :: (Functor f) => (a -> b) -> f a -> f b
fmap f Nil = Nil
fmap f (Cons a (b)) = Cons (f a) (fmap f b)
Now I´m trying to create an instance of 'Applicative List':
instance Applicative List where
pure a = Cons a (Nil)
-- (<*>) :: f (a -> b) -> f a -> f b
(Cons a (b)) <*> (Cons c (d)) = Cons (fmap a (Cons c (d))) (b <*> (Cons c (d)))
(Nil) <*> _ = Nil
_ <*> (Nil) = Nil
The goal is to define '<*>' so it simulates the behaviour of a List.
Example:
(fmap (*)) [5,6,3] <*> [0,2]
--> [0,10,0,12,0,6]
so it should create:
(fmap (*)) (Cons 5 (Cons 6 (Cons 3 (Nil)))) <*> (Cons 0 (Cons 2 (Nil)))
--> (Cons 0 (Cons 10 (Cons 0 (Cons 12 (Cons 0 (Cons 6 (Nil))))))))
but unfortunately I get a (to me) pretty unuseful error:
10-3.hs:14:65: error:
* Occurs check: cannot construct the infinite type: b ~ List b
Expected type: List (List b)
Actual type: List b
* In the second argument of `Cons', namely `(b <*> (Cons c (d)))'
In the expression: Cons (fmap a (Cons c (d))) (b <*> (Cons c (d)))
In an equation for `<*>':
(Cons a (b)) <*> (Cons c (d))
= Cons (fmap a (Cons c (d))) (b <*> (Cons c (d)))
* Relevant bindings include
b :: List (a -> b) (bound at 10-3.hs:14:14)
a :: a -> b (bound at 10-3.hs:14:11)
(<*>) :: List (a -> b) -> List a -> List b (bound at 10-3.hs:14:18)
|
14 | (Cons a (b)) <*> (Cons c (d)) = Cons (fmap a (Cons c (d))) (b <*> (Cons c (d)))
| ^^^^^^^^^^^^^^^^^^
Failed, no modules loaded.
I cant figure out why a List of Lists is expected (List (List b)) because the definition of my data type clearly states a normal List is required as the second parameter for Cons.
I hope someone can help me with this!
EDIT:
Thank you this solved it.
This might be off-topic now, but I was trying to copy the original syntax used for lists to solve it.
Its defined in the Prelude Package as follows:
instance Applicative [] where
{-# INLINE (<*>) #-}
fs <*> xs = [f x | f <- fs, x <- xs]
As I couldn´t use the list comprehension, as for me not wanting to create an actual list (shure I could just convert it later on but I dont like that idea). I translated the syntactic sugar with lambdaBot and got this:
fs <*> xs = concatMap (\ f -> concatMap (\ x -> [f x]) xs) fs
Is there a way to do it like this or is this essentialy the equivalent to doing it with an append (helper)-function?
In the offending line:
(Cons a (b)) <*> (Cons c (d)) = Cons (fmap a (Cons c (d))) (b <*> (Cons c (d)))
The subexpression fmap a (Cons c (d)) has type List b and you are trying to Cons that onto (b <*> (Cons c (d))) which also has type List b. But remember that the type is Cons :: a -> List a -> List a. Note that the first element of Cons needs to be an element and the second element should be a list. So, the compiler assumes that your element type is itself List b and then it reports that it expects the second argument to have type List (List b).
To fix this, instead of using Cons you should write an append :: List a -> List a -> List a function and use that:
(Cons a (b)) <*> (Cons c (d)) = append (fmap a (Cons c (d))) (b <*> (Cons c (d)))
Small note about syntax: you can make the code quite a bit cleaner like this:
Cons f fs <*> xs = append (fmap f xs) (fs <*> xs)
Tips:
Use suggestive names like f for functions, and add an s to the end for lists of something.
Avoid redundant pattern matching (Cons c (d)) -> xs.
Avoid redundant parentheses. In particular you never have to write parentheses around variables like (b) and (d).
(In my actual use case I have a list of type [SomeType], SomeType having a finite number of constructors, all nullary; in the following I'll use String instead of [SomeType] and use only 4 Chars, to simplify a bit.)
I have a list like this "aaassddddfaaaffddsssadddssdffsdf" where each element can be one of 'a', 's', 'd', 'f', and I want to do some further processing on each contiguous sequence of non-as, let's say turning them upper case and reversing the sequence, thus obtaining "aaaFDDDDSSaaaSSSDDFFaFDSFFDSSDDD". (I've added the reversing requirement to make it clear that the processing involves all the contiguous non 'a'-s at the same time.)
To turn each sub-String upper case, I can use this:
func :: String -> String
func = reverse . map Data.Char.toUpper
But how do I run that func only on the sub-Strings of non-'a's?
My first thought is that Data.List.groupBy can be useful, and the overall solution could be:
concat $ map (\x -> if head x == 'a' then x else func x)
$ Data.List.groupBy ((==) `on` (== 'a')) "aaassddddfaaaffddsssadddssdffsdf"
This solution, however, does not convince me, as I'm using == 'a' both when grouping (which to me seems good and unavoidable) and when deciding whether I should turn a group upper case.
I'm looking for advices on how I can accomplish this small task in the best way.
You could classify the list elements by the predicate before grouping. Note that I’ve reversed the sense of the predicate to indicate which elements are subject to the transformation, rather than which elements are preserved.
{-# LANGUAGE ScopedTypeVariables #-}
import Control.Arrow ((&&&))
import Data.Function (on)
import Data.Monoid (First(..))
mapSegmentsWhere
:: forall a. (a -> Bool) -> ([a] -> [a]) -> [a] -> [a]
mapSegmentsWhere p f
= concatMap (applyMatching . sequenceA) -- [a]
. groupBy ((==) `on` fst) -- [[(First Bool, a)]]
. map (First . Just . p &&& id) -- [(First Bool, a)]
where
applyMatching :: (First Bool, [a]) -> [a]
applyMatching (First (Just matching), xs)
= applyIf matching f xs
applyIf :: forall a. Bool -> (a -> a) -> a -> a
applyIf condition f
| condition = f
| otherwise = id
Example use:
> mapSegmentsWhere (/= 'a') (reverse . map toUpper) "aaassddddfaaaffddsssadddssdffsdf"
"aaaFDDDDSSaaaSSSDDFFaFDSFFDSSDDD"
Here I use the First monoid with sequenceA to merge the lists of adjacent matching elements from [(Bool, a)] to (Bool, [a]), but you could just as well use something like map (fst . head &&& map snd). You can also skip the ScopedTypeVariables if you don’t want to write the type signatures; I just included them for clarity.
If we need to remember the difference between the 'a's and the rest, let's put them in different branches of an Either. In fact, let's define a newtype now that we are at it:
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE ViewPatterns #-}
import Data.Bifoldable
import Data.Char
import Data.List
newtype Bunched a b = Bunched [Either a b] deriving (Functor, Foldable)
instance Bifunctor Bunched where
bimap f g (Bunched b) = Bunched (fmap (bimap f g) b)
instance Bifoldable Bunched where
bifoldMap f g (Bunched b) = mconcat (fmap (bifoldMap f g) b)
fmap will let us work over the non-separators. fold will return the concatenation of the non-separators, bifold will return the concatenation of everything. Of course, we could have defined separate functions unrelated to Foldable and Bifoldable, but why avoid already existing abstractions?
To split the list, we can use an unfoldr that alternately searches for as and non-as with the span function:
splitty :: Char -> String -> Bunched String String
splitty c str = Bunched $ unfoldr step (True, str)
where
step (_, []) = Nothing
step (True, span (== c) -> (as, ys)) = Just (Left as, (False, ys))
step (False, span (/= c) -> (xs, ys)) = Just (Right xs, (True, ys))
Putting it to work:
ghci> bifold . fmap func . splitty 'a' $ "aaassddddfaaaffddsssadddssdffsdf"
"aaaFDDDDSSaaaSSSDDFFaFDSFFDSSDDD"
Note: Bunched is actually the same as Tannen [] Either from the bifunctors package, if you don't mind the extra dependency.
There are other answers here, but I think they get too excited about iteration abstractions. A manual recursion, alternately taking things that match the predicate and things that don't, makes this problem exquisitely simple:
onRuns :: Monoid m => (a -> Bool) -> ([a] -> m) -> ([a] -> m) -> [a] -> m
onRuns p = go p (not . p) where
go _ _ _ _ [] = mempty
go p p' f f' xs = case span p xs of
(ts, rest) -> f ts `mappend` go p' p f' f rest
Try it out in ghci:
Data.Char> onRuns ('a'==) id (reverse . map toUpper) "aaassddddfaaaffddsssadddssdffsdf"
"aaaFDDDDSSaaaSSSDDFFaFDSFFDSSDDD"
Here is a simple solution - function process below - that only requires that you define two functions isSpecial and func. Given a constructor from your type SomeType, isSpecial determines whether it is one of those constructors that form a special sublist or not. The function func is the one you included in your question; it defines what should happen with the special sublists.
The code below is for character lists. Just change isSpecial and func to make it work for your lists of constructors.
isSpecial c = c /= 'a'
func = reverse . map toUpper
turn = map (\x -> ([x], isSpecial x))
amalgamate [] = []
amalgamate [x] = [x]
amalgamate ((xs, xflag) : (ys, yflag) : rest)
| xflag /= yflag = (xs, xflag) : amalgamate ((ys, yflag) : rest)
| otherwise = amalgamate ((xs++ys, xflag) : rest)
work = map (\(xs, flag) -> if flag then func xs else xs)
process = concat . work . amalgamate . turn
Let's try it on your example:
*Main> process "aaassddddfaaaffddsssadddssdffsdf"
"aaaFDDDDSSaaaSSSDDFFaFDSFFDSSDDD"
*Main>
Applying one function at a time, shows the intermediate steps taken:
*Main> turn "aaassddddfaaaffddsssadddssdffsdf"
[("a",False),("a",False),("a",False),("s",True),("s",True),("d",True),
("d",True),("d",True),("d",True),("f",True),("a",False),("a",False),
("a",False),("f",True),("f",True),("d",True),("d",True),("s",True),
("s",True),("s",True),("a",False),("d",True),("d",True),("d",True),
("s",True),("s",True),("d",True),("f",True),("f",True),("s",True),
("d",True),("f",True)]
*Main> amalgamate it
[("aaa",False),("ssddddf",True),("aaa",False),("ffddsss",True),
("a",False),("dddssdffsdf",True)]
*Main> work it
["aaa","FDDDDSS","aaa","SSSDDFF","a","FDSFFDSSDDD"]
*Main> concat it
"aaaFDDDDSSaaaSSSDDFFaFDSFFDSSDDD"
*Main>
We can just do what you describe, step by step, getting a clear simple minimal code which we can easily read and understand later on:
foo :: (a -> Bool) -> ([a] -> [a]) -> [a] -> [a]
foo p f xs = [ a
| g <- groupBy ((==) `on` fst)
[(p x, x) | x <- xs] -- [ (True, 'a'), ... ]
, let (t:_, as) = unzip g -- ( [True, ...], "aaa" )
, a <- if t then as else (f as) ] -- final concat
-- unzip :: [(b, a)] -> ([b], [a])
We break the list into same-p spans and unpack each group with the help of unzip. Trying it out:
> foo (=='a') reverse "aaabcdeaa"
"aaaedcbaa"
So no, using == 'a' is avoidable and hence not especially good, introducing an unnecessary constraint on your data type when all we need is equality on Booleans.
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'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.
In haskell, [1,2,3,4,5,6,7] \\ [4,5,6] will return [1,2,3,7]. Now i want to implement the same function using clisp. Up to now i find set-difference works :
(set-difference '(1 2 3 4 5 6 7) '(4 5 6))
Are there any other solution ?
Here are relevant bits of haskell library source. Maybe you can translate these definitions directly. I don't think it uses anything specific to Haskell.
(the source is from http://haskell.org/ghc/docs/latest/html/libraries/base/src/Data-List.html)
delete :: (Eq a) => a -> [a] -> [a]
delete = deleteBy (==)
-- | The 'deleteBy' function behaves like 'delete', but takes a
-- user-supplied equality predicate.
deleteBy :: (a -> a -> Bool) -> a -> [a] -> [a]
deleteBy _ _ [] = []
deleteBy eq x (y:ys) = if x `eq` y then ys else y : deleteBy eq x ys
(\\) :: (Eq a) => [a] -> [a] -> [a]
(\\) = foldl (flip delete)
I don't know Common Lisp that well, so here's a Scheme implementation of the code pasted by Ben:
(define (difference big small)
(fold delete big small))
(define (delete x lst)
(delete-by equal? x lst))
(define (delete-by equal? x lst)
(if (null? lst) '()
(receive (y ys) (car+cdr lst)
(if (equal? x y) ys
(cons y (delete-by equal? x ys))))))
where fold and car+cdr come from SRFI 1, and receive comes from SRFI 8.
If we will allow ourselves the use of SRFI 26's cut form, then we have a solution that looks even closer to the Haskell version (since the latter uses currying in at least two places):
(define difference (cut fold delete <...>))
(define delete (cut delete-by equal? <...>))
; Unchanged from the above version
(define (delete-by equal? x lst)
(if (null? lst) '()
(receive (y ys) (car+cdr lst)
(if (equal? x y) ys
(cons y (delete-by equal? x ys))))))