I was trying to come up with a "one-liner" for generating permutations of a list in Haskell. This is what I have so far:
perms xs = if length xs == 0 then [[]] else [x:ys | x <- xs, ys <- perms $ delete x xs]
The problem is that I am having to use if which I don't like very much in Haskell. Is it possible to avoid using if, or a multi-part definition, or a case statement etc. and only "higher-order" functions (e.g. foldr etc.) to achieve this? (and also ideally keep it relatively small one-liner)
If you find it satisfactory to just get rid of the if without any interesting changes to the function, base-4.7.0.0 (bundled with GHC 7.8) includes bool in Data.Bool.
perms xs = bool [[]] [x:ys | x <- xs, ys <- perms $ delete x xs] $ not (null xs)
I manage to implement this perms by using foldr, but it becomes more complex. It is hardly to believe this is what you are looking for:
perms xs = filter (\l -> length l == length xs) $ foldr step [[]] xs
where step x acc = (map (x:) . perms $ delete x xs) ++ acc
[ghci] let perms1 xs = [x:ys | x <- xs, (not . null) xs ,ys <- perms $ delete x xs]
[ghci] perms1 []
[]
[ghci] perms1 [1,2,3]
[[1,2,3],[1,3,2],[2,1,3],[2,3,1],[3,1,2],[3,2,1]]
The higher function you need is the one that does the same thing as your if expression: check a given predicate, if true, then evaluate to expression1, else evaluate to expression2.
I didn't find this in the standard library, but this is the function you are looking for:
myBranchFunction :: t -> t -> [a] -> t
myBranchFunction e1 e2 xs = if length xs == 0 then e1 else e2
(you could generalize this further by having length be an argument to myBranchFunction if you would like.)
Then you could define perms' like so:
perms' :: Eq a => [a] -> [[a]]
perms' xs = myBranchFunction [[]] [x:ys | x <- xs, ys <- perms $ delete x xs] xs
Note that all we are doing is moving the if expression out to another function. For this function, however, I think I would prefer not to try to fit it on one line and just use a case expression for readability.
Related
just working on a problem and it keeps giving me this error:
Exception: Prelude.tail: empty list
Here is my code so far:
lxP :: Eq a => [[a]] -> [a]
lxP [] = []
lxP xss
| any null xss = []
| otherwise = loop xss []
where loop ::Eq b => [[b]] -> [b] -> [b]
loop xss acc =
let xs = concatMap (take 1) xss
in if any (\x -> x /= head xs) (tail xs)
then reverse acc
else loop (map tail xss) (head xs : acc)
Any idea if my indentation is the problem or is it something with the code?
PS. How could I improve the efficiency?
I can’t quite work out what your function is supposed to do. It doesn’t make sense to me as a reasonable thing to want. Here’s what it looks like to me:
You take some list of lists (let’s say it’s a matrix for now as I’m about to talk about columns) and you want to return the longest prefix of the first row such that each element is in a constant column.
So let’s try to write this in a more idiomatic way.
Now we want to look for constantness in columns, but what should we do if the rows aren’t the same length? I’m going to decide that we’ll just ignore them and imagine shoving all elements upwards so that there are no gaps. Let’s convert rows to columns:
transpose :: [[a]] -> [[a]]
transpose xss = t xss where
n = maximum (map length xss)
t [] = repeat n []
t (xs:xss) = join xs (t xss)
join [] yss = yss
join (x:xs) (ys:yss) = (x:ys) : join xs yss
So now we can write the function.
myWeirdFunction xss
| any null xss = []
| otherwise = map head $ takeWhile constant $ transpose xss where
constant (x:xs) = c x xs
c x (y:ys) | y == x = c x ys
| True = False
c x [] = True
In this question, the author brings up an interesting programming question: given two string, find possible 'interleaved' permutations of those that preserves order of original strings.
I generalized the problem to n strings instead of 2 in OP's case, and came up with:
-- charCandidate is a function that finds possible character from given strings.
-- input : list of strings
-- output : a list of tuple, whose first value holds a character
-- and second value holds the rest of strings with that character removed
-- i.e ["ab", "cd"] -> [('a', ["b", "cd"])] ..
charCandidate xs = charCandidate' xs []
charCandidate' :: [String] -> [String] -> [(Char, [String])]
charCandidate' [] _ = []
charCandidate' ([]:xs) prev =
charCandidate' xs prev
charCandidate' (x#(c:rest):xs) prev =
(c, prev ++ [rest] ++ xs) : charCandidate' xs (x:prev)
interleavings :: [String] -> [String]
interleavings xs = interleavings' xs []
-- interleavings is a function that repeatedly applies 'charCandidate' function, to consume
-- the tuple and build permutations.
-- stops looping if there is no more tuple from charCandidate.
interleavings' :: [String] -> String -> [String]
interleavings' xs prev =
let candidates = charCandidate xs
in case candidates of
[] -> [prev]
_ -> concat . map (\(char, ys) -> interleavings' ys (prev ++ [char])) $ candidates
-- test case
input :: [String]
input = ["ab", "cd"]
-- interleavings input == ["abcd","acbd","acdb","cabd","cadb","cdab"]
it works, however I'm quite concerned with the code:
it is ugly. no point-free!
explicit recursion and additional function argument prev to preserve states
using tuples as intermediate form
How can I rewrite the above program to be more "haskellic", concise, readable and more conforming to "functional programming"?
I think I would write it this way. The main idea is to treat creating an interleaving as a nondeterministic process which chooses one of the input strings to start the interleaving and recurses.
Before we start, it will help to have a utility function that I have used countless times. It gives a convenient way to choose an element from a list and know which element it was. This is a bit like your charCandidate', except that it operates on a single list at a time (and is consequently more widely applicable).
zippers :: [a] -> [([a], a, [a])]
zippers = go [] where
go xs [] = []
go xs (y:ys) = (xs, y, ys) : go (y:xs) ys
With that in hand, it is easy to make some non-deterministic choices using the list monad. Notionally, our interleavings function should probably have a type like [NonEmpty a] -> [[a]] which promises that each incoming string has at least one character in it, but the syntactic overhead of NonEmpty is too annoying for a simple exercise like this, so we'll just give wrong answers when this precondition is violated. You could also consider making this a helper function and filtering out empty lists from your top-level function before running this.
interleavings :: [[a]] -> [[a]]
interleavings [] = [[]]
interleavings xss = do
(xssL, h:xs, xssR) <- zippers xss
t <- interleavings ([xs | not (null xs)] ++ xssL ++ xssR)
return (h:t)
You can see it go in ghci:
> interleavings ["abc", "123"]
["abc123","ab123c","ab12c3","ab1c23","a123bc","a12bc3","a12b3c","a1bc23","a1b23c","a1b2c3","123abc","12abc3","12ab3c","12a3bc","1abc23","1ab23c","1ab2c3","1a23bc","1a2bc3","1a2b3c"]
> interleavings ["a", "b", "c"]
["abc","acb","bac","bca","cba","cab"]
> permutations "abc" -- just for fun, to compare
["abc","bac","cba","bca","cab","acb"]
This is fastest implementation I've come up with so far. It interleaves a list of lists pairwise.
interleavings :: [[a]] -> [[a]]
interleavings = foldr (concatMap . interleave2) [[]]
This horribly ugly mess is the best way I could find to interleave two lists. It's intended to be asymptotically optimal (which I believe it is); it's not very pretty. The constant factors could be improved by using a special-purpose queue (such as the one used in Data.List to implement inits) rather than sequences, but I don't feel like including that much boilerplate.
{-# LANGUAGE BangPatterns #-}
import Data.Monoid
import Data.Foldable (toList)
import Data.Sequence (Seq, (|>))
interleave2 :: [a] -> [a] -> [[a]]
interleave2 xs ys = interleave2' mempty xs ys []
interleave2' :: Seq a -> [a] -> [a] -> [[a]] -> [[a]]
interleave2' !prefix xs ys rest =
(toList prefix ++ xs ++ ys)
: interleave2'' prefix xs ys rest
interleave2'' :: Seq a -> [a] -> [a] -> [[a]] -> [[a]]
interleave2'' !prefix [] _ = id
interleave2'' !prefix _ [] = id
interleave2'' !prefix xs#(x : xs') ys#(y : ys') =
interleave2' (prefix |> y) xs ys' .
interleave2'' (prefix |> x) xs' ys
Using foldr over interleave2
interleave :: [[a]] -> [[a]]
interleave = foldr ((concat .) . map . iL2) [[]] where
iL2 [] ys = [ys]
iL2 xs [] = [xs]
iL2 (x:xs) (y:ys) = map (x:) (iL2 xs (y:ys)) ++ map (y:) (iL2 (x:xs) ys)
Another approach would be to use the list monad:
interleavings xs ys = interl xs ys ++ interl ys xs where
interl [] ys = [ys]
interl xs [] = [xs]
interl xs ys = do
i <- [1..(length xs)]
let (h, t) = splitAt i xs
map (h ++) (interl ys t)
So the recursive part will alternate between the two lists, taking all from 1 to N elements from each list in turns and then produce all possible combinations of that. Fun use of the list monad.
Edit: Fixed bug causing duplicates
Edit: Answer to dfeuer. It turned out tricky to do code in the comment field. An example of solutions that do not use length could look something like:
interleavings xs ys = interl xs ys ++ interl ys xs where
interl [] ys = [ys]
interl xs [] = [xs]
interl xs ys = splits xs >>= \(h, t) -> map (h ++) (interl ys t)
splits [] = []
splits (x:xs) = ([x], xs) : map ((h, t) -> (x:h, t)) (splits xs)
The splits function feels a bit awkward. It could be replaced by use of takeWhile or break in combination with splitAt, but that solution ended up a bit awkward as well. Do you have any suggestions?
(I got rid of the do notation just to make it slightly shorter)
Combining the best ideas from the existing answers and adding some of my own:
import Control.Monad
interleave [] ys = return ys
interleave xs [] = return xs
interleave (x : xs) (y : ys) =
fmap (x :) (interleave xs (y : ys)) `mplus` fmap (y :) (interleave (x : xs) ys)
interleavings :: MonadPlus m => [[a]] -> m [a]
interleavings = foldM interleave []
This is not the fastest possible you can get, but it should be good in terms of general and simple.
says that we want to filter out all the odd one in a list.
odd' (i,n) = odd i
unbox (i,n) = n
f :: [Int] -> [Int]
f lst = map unbox $ filter odd' $ zip [1..] lst
*Main> f [1,2,3,4]
[1,3]
it has the unpleasant boxing and unboxing.
can we change the way we think this problem and eliminate boxing and unboxing?
#user3237465 list comprehension is indeed a good way of thinking this sort of problem.
as well as function composition. well, I think we won't get rid of "wrapping the original list to [(index,value)] form and then unwrap it" without writing a special form like #Carsten König provided.
Or have a function that give out one value's index given the list and the value. like filter (odd . getindex) xs
and maybe that's why clojure made it's pattern matching strong enough to get value in complex structure.
you can always rewrite the function if you want - this comes to mind:
odds :: [a] -> [a]
odds (x:_:xs) = x : odds xs
odds [x] = [x]
odds _ = []
aside from this both you don't need odd' and unbox:
odd' is just odd . fst
unbox is just snd
You can write this as
f xs = [x | (i, x) <- zip [0..] xs, even i]
or
f = snd . foldr (\x ~(o, e) -> (e, x : o)) ([], [])
or
import Data.Either
f = lefts . zipWith ($) (cycle [Left, Right])
i am a beginner in haskell programming and very often i get the error
xxx.hs:30:1: parse error on input `xxx'
And often there is a little bit playing with the format the solution. Its the same code and it looks the same, but after playing around, the error is gone.
At the moment I've got the error
LookupAll.hs:30:1: parse error on input `lookupAll'
After that code:
lookupOne :: Int -> [(Int,a)] -> [a]
lookupOne _ [] = []
lookupOne x list =
if fst(head list) == x then snd(head list) : []
lookupOne x (tail list)
-- | Given a list of keys and a list of pairs of key and value
-- 'lookupAll' looks up the list of associated values for each key
-- and concatenates the results.
lookupAll :: [Int] -> [(Int,a)] -> [a]
lookupAll [] _ = []
lookupAll _ [] = []
lookupAll xs list = lookupOne h list ++ lookupAll t list
where
h = head xs
t = tail xs
But I have done everything right in my opinion. There are no tabs or something like that. Always 4 spaces. Is there a general solutoin for this problems? I am using notepad++ at the moment.
Thanks!
The problem is not with lookupAll, it's actually with the previous two lines of code
if fst (head list) == x then snd (head list) : []
lookupOne x (tail list)
You haven't included an else on this if statement. My guess is that you meant
if fst (head list) == x then snd (head list) : []
else lookupOne x (tail list)
Which I personally would prefer to format as
if fst (head list) == x
then snd (head list) : []
else lookupOne x (tail list)
but that's a matter of taste.
If you are wanting to accumulate a list of values that match a condition, there are a few ways. By far the easiest is to use filter, but you can also use explicit recursion. To use filter, you could write your function as
lookupOne x list
= map snd -- Return only the values from the assoc list
$ filter (\y -> fst y == x) list -- Find each pair whose first element equals x
If you wanted to use recursion, you could instead write it as
lookupOne _ [] = [] -- The base case pattern
lookupOne x (y:ys) = -- Pattern match with (:), don't have to use head and tail
if fst y == x -- Check if the key and lookup value match
then snd y : lookupOne x ys -- If so, prepend it onto the result of looking up the rest of the list
else lookupOne x ys -- Otherwise, just return the result of looking up the rest of the list
Both of these are equivalent. In fact, you can implement filter as
filter cond [] = []
filter cond (x:xs) =
if cond x
then x : filter cond xs
else filter cond xs
And map as
map f [] = []
map f (x:xs) = f x : map f xs
Hopefully you can spot the similarities between filter and lookupOne, and with map consider f == snd, so you have a merger of the two patterns of map and filter in the explicit recursive version of lookupOne. You could generalize this combined pattern into a higher order function
mapFilter :: (a -> b) -> (a -> Bool) -> [a] -> [b]
mapFilter f cond [] = []
mapFilter f cond (x:xs) =
if cond x
then f x : mapFilter f cond xs
else : mapFilter f cond xs
Which you can use to implement lookupOne as
lookupOne x list = mapFilter snd (\y -> fst y == x) list
Or more simply
lookupOne x = mapFilter snd ((== x) . fst)
I think #bheklilr is right - you're missing an else.
You could fix this particular formatting problem, however, by forming lookupOne as a function composition, rather than writing your own new recursive function.
For example, you can get the right kind of behaviour by defining lookupOne like this:
lookupOne a = map snd . filter ((==) a . fst)
This way it's clearer that you're first filtering out the elements of the input list for which the first element of the tuple matches the key, and then extracting just the second element of each tuple.
Write a function that returns the running sum of list. e.g. running [1,2,3,5] is [1,3,6,11]. I write this function below which just can return the final sum of all the values among the list.So how can i separate them one by one?
sumlist' xx=aux xx 0
where aux [] a=a
aux (x:xs) a=aux xs (a+x)
I think you want a combination of scanl1 and (+), so something like
scanl1 (+) *your list here*
scanl1 will apply the given function across a list, and report each intermediate value into the returned list.
Like, to write it out in pseudo code,
scanl1 (+) [1,2,3]
would output a list like:
[a, b, c] where { a = 1, b = a+2, c = b+3 }
or in other words,
[1, 3, 6]
Learn You A Haskell has a lot of great examples and descriptions of scans, folds, and much more of Haskell's goodies.
Hope this helps.
You can adjust your function to produce a list by simply prepending a+x to the result on each step and using the empty list as the base case:
sumlist' xx = aux xx 0
where aux [] a = []
aux (x:xs) a = (a+x) : aux xs (a+x)
However it is more idiomatic Haskell to express this kind of thing as a fold or scan.
While scanl1 is clearly the "canonical" solution, it is still instructive to see how you could do it with foldl:
sumList xs = tail.reverse $ foldl acc [0] xs where
acc (y:ys) x = (x+y):y:ys
Or pointfree:
sumList = tail.reverse.foldl acc [0] where
acc (y:ys) x = (x+y):y:ys
Here is an ugly brute force approach:
sumList xs = reverse $ acc $ reverse xs where
acc [] = []
acc (x:xs) = (x + sum xs) : acc xs
There is a cute (but not very performant) solution using inits:
sumList xs = tail $ map sum $ inits xs
Again pointfree:
sumList = tail.map sum.inits
Related to another question I found this way:
rsum xs = map (\(a,b)->a+b) (zip (0:(rsum xs)) xs)
I think it is even quite efficient.
I am not sure how canonical is this but it looks beautiful to me :)
sumlist' [] = []
sumlist' (x:xs) = x : [x + y | y <- sumlist' xs]
As others have commented, it would be nice to find a solution that is both linear and non-strict. The problem is that the right folds and scans do not allow you to look at items to the left of you, and the left folds and scans are all strict on the input list. One way to achieve this is to define our own function which folds from the right but looks to the left. For example:
sumList:: Num a => [a] -> [a]
sumList xs = foldlr (\x l r -> (x + l):r) 0 [] xs
It's not too difficult to define foldr so that it is non-strict in the list. Note that it has to have two initialisers -- one going from the left (0) and one terminating from the right ([]):
foldlr :: (a -> b -> [b] -> [b]) -> b -> [b] -> [a] -> [b]
foldlr f l r xs =
let result = foldr (\(l', x) r' -> f x l' r') r (zip (l:result) xs) in
result