How could I make a list where I get every number/letter which has a prime index number?
primeIndex :: [a] -> [a]
primeIndex [1..20] == [2, 3, 5, 7, 11, 13, 17, 19]
primeIndex "primesarefun" == "rieau"
A possible strategy:
Following the general approach mentioned above by #Joseph Sible-Reinstate Monica, the problem can be solved like this:
get a list of all prime numbers, say primes
use that first list to create an auxiliary list of booleans which has True elements solely at prime indices
use the second list together with classic list functions (map, filter, zip) to solve the problem
Regarding the first part, there are a number of available algorithms in the relevant page of the Haskell Wiki. We can just pick one of them.
import Data.List.Ordered
_Y :: (t -> t) -> t
_Y g = g (_Y g)
joinL :: (Ord a, Eq a) => [[a]] -> [a]
joinL ((x:xs):t) = x : union xs (joinL t)
joinL ([]:t) = joinL t
joinL [] = []
primesLME :: [Integer]
primesLME = 2 : _Y ((3:) . minus [5,7..] . joinL . map (\p-> [p*p, p*p+2*p..]))
primes = primesLME
with LME standing for Linear MErging.
Regarding the second part, a function to transform primes into the required list of booleans, say primeMask, can be taken from SO_q59092535.
-- boolean list from index list (with unfoldr):
booleansFromIndices :: [Integer] -> [Bool]
booleansFromIndices indices =
let sfn (pos,ind) = Just $ -- stepping function for unfoldr
if (null ind)
then ( False, (pos+1, []) )
else ( pos==head ind,
(pos+1, if (pos==head ind) then tail ind else ind))
in unfoldr sfn (0,indices)
primeMask :: [Bool]
primeMask = drop 1 $ booleansFromIndices primes -- 1-based indexing
Putting it all together (third and last part):
In a ghci session:
λ>
λ> take 10 primes
[2,3,5,7,11,13,17,19,23,29]
λ>
λ>
λ> take 15 primeMask
[False,True,True,False,True,False,True,False,False,False,True,False,True,False,False]
λ>
λ> take 20 $ map (\b -> if b then '1' else '0') primeMask
"01101010001010001010"
λ>
λ> str = "primesarefun"
λ>
λ> zip primeMask str
[(False,'p'),(True,'r'),(True,'i'),(False,'m'),(True,'e'),(False,'s'),(True,'a'),(False,'r'),(False,'e'),(False,'f'),(True,'u'),(False,'n')]
λ>
λ> filter fst $ zip primeMask str
[(True,'r'),(True,'i'),(True,'e'),(True,'a'),(True,'u')]
λ>
λ> map snd $ filter fst $ zip primeMask str
"rieau"
λ>
λ> primeIndex = \xs -> map snd $ filter fst $ zip primeMask xs
λ>
λ> primeIndex [1..20]
[2,3,5,7,11,13,17,19]
λ>
This is code #1:
fibs = 0:1:zipWith (+) fibs (tail fibs)
I wrote the same code with list comprehension (code #2):
fibs' = 0:1:[x+y|x<-fibs',y<-tail fibs']
but code #1 produces the Fibonnacci numbers while code #2 produces 0 1 1 1 1
Why does this happen?
List comprehensions such as [x+y|x<-fibs',y<-tail fibs'] will generate x+y for all combinations of x,y extracted from the two lists. For instance,
[ (x,y) | x<-[1..10] , y<-[1..10] ]
will generate all the 100 pairs, essentially computing the cartesian product of the two lists.
Zipping the lists instead only generates pairs for the corresponding elements, yielding only 10 pairs.
Parallel list comprehensions instead work as zip does. For instance,
[ (x,y) | x<-[1..10] | y<-[1..10] ]
will return the same 10 pairs as zip. You can enable this Haskell extension by adding {-# LANGUAGE ParallelListComp #-} at the beginning of your file.
Personally, I do not use this extension much, preferring to explicitly use zip instead.
List comprehensions over multiple lists do not work like zip/zipWith - each element of one list is combined with each element of the other list rather than being combined pair-wise. To illustrate this difference, look at this simpler example:
xs = [1,2]
ys = [3, 4]
zipped = zipWith (+) xs ys -- [4, 6]
comprehended = [x+y | x <- xs, y <- ys] [4, 5, 5, 6]
To get the behavior of zip in a list comprehension, you'd need to use the GHC extension for parallel list comprehensions, which allows you to write this:
parallelComp = [x+y | x <- xs | y <- ys] -- [4, 6]
The reason is: it's not the same code. :) The first sample uses zipWith which is applying (+) pairwise. The second one does something like Cartesian product, but instead of returning pair (x,y) it returns x+y.
Compare:
zip [1..5] [2..6] === [(1,2),(2,3),(3,4),(4,5),(5,6)]
With:
[ (x,y) | x <- [1..5], y <- [2..6] ] === [(1,2),(1,3),(1,4),(1,5),(1,6),
(2,2),(2,3),(2,4),(2,5),(2,6),
(3,2),(3,3),(3,4),(3,5),(3,6),
(4,2),(4,3),(4,4),(4,5),(4,6),
(5,2),(5,3),(5,4),(5,5),(5,6)]
The list comprehension
[ x + y | x <- xs, y <- ys ]
equals (more or less) to the following imperative pseudocode
list = emptyList
foreach (x in xs) {
foreach (y in ys) {
append (x+y) to list
}
}
return list
However, if that ys is an infinitive list, as in your code #2, then the result list will be
list = emptyList
x = head of xs
foreach (y in ys) {
append (x+y) to list
}
return list
That is why you got that list consists of 0, 1, 1, ... .
You can get the behaviour you want using ZipList rather than []. Since ZipList is not a monad you cannot use monadic do. Instead you have to use applicative do, also known as "arrow notation"! :)
{-# LANGUAGE Arrows #-}
import Prelude hiding (id, (.))
import Control.Arrow
import Control.Applicative
import Control.Category
data A f a b = A (f (a -> b))
type Arr f a = A f () a
runA :: A f a b -> f (a -> b)
runA (A f) = f
arrOfApp :: Functor f => f a -> Arr f a
arrOfApp = A . fmap const
appOfArr :: Functor f => Arr f a -> f a
appOfArr = fmap ($ ()) . runA
The definitions above are rather similar to those you can find in optparse-applicative.
zipListArr :: [a] -> Arr ZipList a
zipListArr = arrOfApp . ZipList
getZipListArr :: Arr ZipList a -> [a]
getZipListArr = getZipList . appOfArr
instance Applicative f => Category (A f) where
id = A (pure id)
A f . A g = A ((.) <$> f <*> g)
instance Applicative f => Arrow (A f) where
arr f = A (pure f)
first (A f) = A (fmap first f)
fibs' :: [Int]
fibs' = 0 : 1 : (getZipListArr $ proc () -> do
x <- zipListArr fibs' -< ()
y <- zipListArr (tail fibs') -< ()
returnA -< x + y)
*Main> take 10 fibs'
[0,1,1,2,3,5,8,13,21,34]
Using lists to model nondeterminism is problematic if the inputs can take infinitely many values. For example
pairs = [ (a,b) | a <- [0..], b <- [0..] ]
This will return [(0,1),(0,2),(0,3),...] and never get around to showing you any pair whose first element is not 0.
Using the Cantor pairing function to collapse a list of lists into a single list can get around this problem. For example, we can define a bind-like operator that orders its outputs more intelligently by
(>>>=) :: [a] -> (a -> [b]) -> [b]
as >>>= f = cantor (map f as)
cantor :: [[a]] -> [a]
cantor xs = go 1 xs
where
go _ [] = []
go n xs = hs ++ go (n+1) ts
where
ys = filter (not.null) xs
hs = take n $ map head ys
ts = mapN n tail ys
mapN :: Int -> (a -> a) -> [a] -> [a]
mapN _ _ [] = []
mapN n f xs#(h:t)
| n <= 0 = xs
| otherwise = f h : mapN (n-1) f t
If we now wrap this up as a monad, we can enumerate all possible pairs
newtype Select a = Select { runSelect :: [a] }
instance Monad Select where
return a = Select [a]
Select as >>= f = Select $ as >>>= (runSelect . f)
pairs = runSelect $ do
a <- Select [0..]
b <- Select [0..]
return (a,b)
This results in
>> take 15 pairs
[(0,0),(0,1),(1,0),(0,2),(1,1),(2,0),(0,3),(1,2),(2,1),(3,0),(0,4),(1,3),(2,2),(3,1),(4,0)]
which is a much more desirable result. However, if we were to ask for triples instead, the ordering on the outputs isn't as "nice" and it's not even clear to me that all outputs are eventually included --
>> take 15 triples
[(0,0,0),(0,0,1),(1,0,0),(0,1,0),(1,0,1),(2,0,0),(0,0,2),(1,1,0),(2,0,1),(3,0,0),(0,1,1),(1,0,2),(2,1,0),(3,0,1),(4,0,0)]
Note that (2,0,1) appears before (0,1,1) in the ordering -- my intuition says that a good solution to this problem will order the outputs according to some notion of "size", which could be an explicit input to the algorithm, or could be given implicitly (as in this example, where the "size" of an input is its position in the input lists). When combining inputs, the "size" of a combination should be some function (probably the sum) of the size of the inputs.
Is there an elegant solution to this problem that I am missing?
TL;DR: It flattens two dimensions at a time, rather than flattening three at once. You can't tidy this up in the monad because >>= is binary, not ternary etc.
I'll assume you defined
(>>>=) :: [a] -> (a -> [b]) -> [b]
as >>>= f = cantor $ map f as
to interleave the list of lists.
You like that because it goes diagonally:
sums = runSelect $ do
a <- Select [0..]
b <- Select [0..]
return (a+b)
gives
ghci> take 36 sums
[0,1,1,2,2,2,3,3,3,3,4,4,4,4,4,5,5,5,5,5,5,6,6,6,6,6,6,6,7,7,7,7,7,7,7,7]
so it's pleasingly keeping the "sizes" in order, but the pattern appears to be broken for triples, and you doubt completeness, but you needn't. It's doing the same trick, but twice, rather than for all three at once:
triplePairs = runSelect $ do
a <- Select [0..]
b <- Select [0..]
c <- Select [0..]
return $ (a,(b,c))
The second pair is treated as a single source of data, so notice that:
ghci> map fst $ take 36 pairs
[0,0,1,0,1,2,0,1,2,3,0,1,2,3,4,0,1,2,3,4,5,0,1,2,3,4,5,6,0,1,2,3,4,5,6,7]
ghci> map fst $ take 36 triplePairs
[0,0,1,0,1,2,0,1,2,3,0,1,2,3,4,0,1,2,3,4,5,0,1,2,3,4,5,6,0,1,2,3,4,5,6,7]
and (adding some spaces/newlines for clarity of pattern):
ghci> map snd $ take 36 pairs
[0, 1,0, 2,1,0, 3,2,1,0, 4,3,2,1,0, 5,4,3,2,1,0, 6,5,4,3,2,1,0, 7,6,5,4,3,2,1,0]
ghci> map snd $ take 36 triplePairs
[(0,0), (0,1),(0,0), (1,0),(0,1),(0,0), (0,2),(1,0),(0,1),(0,0),
(1,1),(0,2),(1,0),(0,1),(0,0),
(2,0),(1,1),(0,2),(1,0),(0,1),(0,0),
(0,3),(2,0),(1,1),(0,2),(1,0),(0,1),(0,0),
(1,2),(0,3),(2,0),(1,1),(0,2),(1,0),(0,1),(0,0)]
so you can see it's using exactly the same pattern. This doesn't preserve total sums and it oughtn't because we're getting to three dimensions by flattening two dimensions first before flattening the third in. The pattern is obscured, but it's just as guaranteed to make it to the end of the list.
Sadly if you want to do three dimensions in a sum-preserving way, you'll have to write cantor2, cantor3 and cantor4 functions, possibly a cantorN function, but you'll have to ditch the monadic interface, which is inherently based on the bracketing of >>=, hence two-at-a-time flattening of dimensions.
import Control.Applicative
import Control.Arrow
data Select a = Select [a]
| Selects [Select a]
instance Functor Select where
fmap f (Select x) = Select $ map f x
fmap f (Selects xss) = Selects $ map (fmap f) xss
instance Applicative Select where
pure = Select . (:[])
Select fs <*> xs = Selects $ map (`fmap`xs) fs
Selects fs <*> xs = Selects $ map (<*>xs) fs
instance Monad Select where
return = pure
Select xs >>= f = Selects $ map f xs
Selects xs >>= f = Selects $ map (>>=f) xs
runSelect :: Select a -> [a]
runSelect = go 1
where go n xs = uncurry (++) . second (go $ n+1) $ splitOff n xs
splitOff n (Select xs) = second Select $ splitAt n xs
splitOff n (Selects sls) = (concat hs, Selects $ tsl ++ rl)
where ((hs, tsl), rl) = first (unzip . map (splitOff n)) $ splitAt n sls
*Select> take 15 . runSelect $ do { a<-Select [0..]; b<-Select [0..]; return (a,b) }
[(0,0),(0,1),(1,0),(1,1),(0,2),(1,2),(2,0),(2,1),(2,2),(0,3),(1,3),(2,3),(3,0),(3,1),(3,2)]
*Select> take 15 . runSelect $ do { a<-Select [0..]; b<-Select [0..]; c<-Select [0..]; return (a,b,c) }
[(0,0,0),(0,0,1),(0,1,0),(0,1,1),(1,0,0),(1,0,1),(1,1,0),(1,1,1),(0,0,2),(0,1,2),(0,2,0),(0,2,1),(0,2,2),(1,0,2),(1,1,2)]
Note that this is still not quite Cantor-tuples ((0,1,1) shouldn't come before (1,0,0)), but getting it correct would be possible as well in a similar manner.
A correct multidimentional enumerator could be represented with a temporary state object
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverlappingInstances #-}
class Space a b where
slice :: a -> ([b], a)
instance Space [a] a where
slice (l:ls) = ([l], ls)
slice [] = ([], [])
instance (Space sp x) => Space ([sp], [sp]) x where
slice (fs, b:bs) = let
ss = map slice (b : fs)
yield = concat $ map fst ss
in (yield, (map snd ss, bs))
Here an N dimensional space is represented by a tuple of lists of N-1 dimensional subspaces that have and haven't been touched by the enumeration.
You can then use the following to produce a well ordered list
enumerate :: (Space sp x) => sp -> [x]
enumerate sp = let (sl, sp') = slice sp
in sl ++ enumerate sp'
Example in Ideone.
The omega package does exactly what you want and guarantees that every element will be eventually visited:
import Control.Applicative
import Control.Monad.Omega
main = print . take 200 . runOmega $
(,,) <$> each [0..] <*> each [0..] <*> each [0..]
Another option would be to use LogicT. It gives more flexibility (if you need) and has operations such as (>>-) that ensure that every combination is eventually encountered.
import Control.Applicative
import Control.Monad
import Control.Monad.Logic
-- | Convert a list into any MonadPlus.
each :: (MonadPlus m) => [a] -> m a
each = msum . map return
-- | A fair variant of '(<*>)` that ensures that both branches are explored.
(<#>) :: (MonadLogic m) => m (a -> b) -> m a -> m b
(<#>) f k = f >>- (\f' -> k >>- (\k' -> return $ f' k'))
infixl 4 <#>
main = print . observeMany 200 $
(,,) <$> each [0..] <#> each [0..] <#> each [0..]