This question already has answers here:
Cartesian product of 2 lists in Haskell
(15 answers)
Closed 10 years ago.
I know how to use list comprehension to do this, but how can I implement a function that will recursively compute the cartesian product given two sets?
Here's where I'm stuck (and I'm a noob)
crossProd :: [Int] -> [Int] -> [(Int,Int)]
crossProd xs ys | xs == [] || ys == [] = []
| otherwise = (head xs, head ys) : crossProd (tail xs) (ys)
The output of this gives me
[(1,4),(1,5),(1,6)]
If the sets are [1,2,3] and [4,5,6] respectively..
How would I go about getting the rest?
The most basic case is this:
{-crossProdAux :: Int -> [Int] -> [(Int,Int)]-}
crossProdAux x [] = []
crossProdAux x (a:b) = (x, a):(crossProdAux x b)
{-crossProd :: [Int] -> [Int] -> [(Int,Int)]-}
crossProd [] ys = []
crossProd (a:b) ys= (crossProdAux a ys)++(crossProd b ys)
This can be done in a single function:
crossProd :: [a] -> [b] -> [(a, b)]
crossProd (x:xs) ys = map (\y -> (x, y)) ys ++ crossProd xs ys
crossProd _ _ = []
Notice that I've generalised your types so that this works for any a and b, rather than just Ints.
The key to this function is understanding that you want to pair each element in the first list with each element in the second. This solution therefore takes one element x from the first list, and pairs it with every one in ys. This is done by mapping a function that takes each value y from ys, and turns it into a pair (x, y). We add this to the front of recursing with the rest of the list xs.
In the base case, there is nothing left to pair, so the output is empty.
Related
I have to implement a function in haskell that takes a list [Int] and gives a list [[Int]] with all permutations, but i'm only allowed to use:
[], :, True, False, comparisons, &&, ||, and not
permutations [] = [[]]
permutations xs = [(y:zs) | (y,ys) <- picks xs, zs <- permutations ys]
where
picks (x:xs) = (x,xs) : [(y,x:ys) | (y,ys) <- picks xs]
My idea was to use something like that but i have to replace the <-
As mentioned by chepner in the comments, a few missing elementary library functions can easily be re-implemented “on the spot”.
The Wikipedia article on permutations leads us to, among many other things, the Steinhaus–Johnson–Trotter algorithm, which seems well suited to linked lists.
For this algorithm, an essential building block is a function we could declare as:
spread :: a -> [a] -> [[a]]
For example, expression spread 4 [1,2,3] has to put 4 at all possible positions within [1,2;3], thus evaluating to: [[4,1,2,3],[1,4,2,3],[1,2,4,3],[1,2,3,4]]. To get all permutations of [1,2,3,4], you just need to apply spread 4 to all permutations of [1,2,3]. And it is easy to write spread in recursive fashion:
spread :: a -> [a] -> [[a]]
spread x [] = [[x]]
spread x (y:ys) = (x:y:ys) : (map (y:) (spread x ys))
And permutations can thus be obtained like this:
permutations :: [a] -> [[a]]
permutations [] = [[]]
permutations (x:xs) = concat (map (spread x) (permutations xs))
Overall, a rules-compliant version of the source code would go like this, with its own local versions of the map and concat Prelude functions:
permutations :: [a] -> [[a]]
permutations [] = [[]]
permutations (x:xs) = myConcat (myMap (spread x) (permutations xs))
where
myMap fn [] = []
myMap fn (z:zs) = (fn z) : (myMap fn zs)
myConcat [] = []
myConcat ([]:zss) = myConcat zss
myConcat ((z:zs):zss) = z : (myConcat (zs:zss))
spread z [] = [[z]]
spread z (y:ys) = ( z:y:ys) : (myMap (y:) (spread z ys))
You must use recursion to define rmax2 and you must do so from “scratch”. That is, other than the cons operator, head, tail, and comparisons, you should not use any functions from the Haskell library.
I created a function that removes all instances of the largest item, using list comprehension. How do I remove the last instance of the largest number using recursion?
ved :: Ord a => [a] -> [a]
ved [] =[]
ved as = [ a | a <- as, m /= a ]
where m= maximum as
An easy way to split the problem into two easier subproblems consists in:
get the position index of the rightmost maximum value
write a general purpose function del that eliminates the element of a list at a given position. This does not require an Ord constraint.
If we were permitted to use regular library functions, ved could be written like this:
ved0 :: Ord a => [a] -> [a]
ved0 [] = []
ved0 (x:xs) =
let
(maxVal,maxPos) = maximum (zip (x:xs) [0..])
del k ys = let (ys0,ys1) = splitAt k ys in (ys0 ++ tail ys1)
in
del maxPos (x:xs)
where the pairs produced by zip are lexicographically ordered, thus ensuring the rightmost maximum gets picked.
We need to replace the library functions by manual recursion.
Regarding step 1, that is finding the position of the rightmost maximum, as is commonly done, we can use a recursive stepping function and a wrapper above it.
The recursive step function takes as arguments the whole context of the computation, that is:
current candidate for maximum value, mxv
current rightmost position of maximum value, mxp
current depth into the original list, d
rest of original list, xs
and it returns a pair: (currentMaxValue, currentMaxPos)
-- recursive stepping function:
findMax :: Ord a => a -> Int -> Int -> [a] -> (a, Int)
findMax mxv mxp d [] = (mxv,mxp)
findMax mxv mxp d (x:xs) = if (x >= mxv) then (findMax x d (d+1) xs)
else (findMax mxv mxp (d+1) xs)
-- top wrapper:
lastMaxPos :: Ord a => [a] -> Int
lastMaxPos [] = (-1)
lastMaxPos (x:xs) = snd (findMax x 0 1 xs)
Step 2, eliminating the list element at position k, can be handled in very similar fashion:
-- recursive stepping function:
del1 :: Int -> Int -> [a] -> [a]
del1 k d [] = []
del1 k d (x:xs) = if (d==k) then xs else x : del1 k (d+1) xs
-- top wrapper:
del :: Int -> [a] -> [a]
del k xs = del1 k 0 xs
Putting it all together:
We are now able to write our final recursion-based version of ved. For simplicity, we inline the content of wrapper functions instead of calling them.
-- ensure we're only using authorized functionality:
{-# LANGUAGE NoImplicitPrelude #-}
import Prelude (Ord, Eq, (==), (>=), (+), ($), head, tail,
IO, putStrLn, show, (++)) -- for testing only
ved :: Ord a => [a] -> [a]
ved [] = []
ved (x:xs) =
let
findMax mxv mxp d [] = (mxv,mxp)
findMax mxv mxp d (y:ys) = if (y >= mxv) then (findMax y d (d+1) ys)
else (findMax mxv mxp (d+1) ys)
(maxVal,maxPos) = findMax x 0 1 xs
del1 k d (y:ys) = if (d==k) then ys else y : del1 k (d+1) ys
del1 k d [] = []
in
del1 maxPos 0 (x:xs)
main :: IO ()
main = do
let xs = [1,2,3,7,3,2,1,7,3,5,7,5,4,3]
res = ved xs
putStrLn $ "input=" ++ (show xs) ++ "\n" ++ " res=" ++ (show res)
If you are strictly required to use recursion, you can use 2 helper functions: One to reverse the list and the second to remove the first largest while reversing the reversed list.
This result in a list where the last occurrence of the largest element is removed.
We also use a boolean flag to make sure we don't remove more than one element.
This is ugly code and I really don't like it. A way to make things cleaner would be to move the reversal of the list to a helper function outside of the current function so that there is only one helper function to the main function. Another way is to use the built-in reverse function and use recursion only for the removal.
removeLastLargest :: Ord a => [a] -> [a]
removeLastLargest xs = go (maximum xs) [] xs where
go n xs [] = go' n True [] xs
go n xs (y:ys) = go n (y:xs) ys
go' n f xs [] = xs
go' n f xs (y:ys)
| f && y == n = go' n False xs ys
| otherwise = go' n f (y:xs) ys
Borrowing the implementation of dropWhileEnd from Hackage, we can implement a helper function splitWhileEnd:
splitWhileEnd :: (a -> Bool) -> [a] -> ([a], [a])
splitWhileEnd p = foldr (\x (xs, ys) -> if p x && null xs then ([], x:ys) else (x:xs, ys)) ([],[])
splitWhileEnd splits a list according to a predictor from the end. For example:
ghci> xs = [1,2,3,4,3,2,4,3,2]
ghci> splitWhileEnd (< maximum xs) xs
([1,2,3,4,3,2,4],[3,2])
With this helper function, you can write ven as:
ven :: Ord a => [a] -> [a]
ven xs =
let (x, y) = splitWhileEnd (< maximum xs) xs
in init x ++ y
ghci> ven xs
[1,2,3,4,3,2,3,2]
For your case, you can refactor splitWhileEnd as:
fun p = \x (xs, ys) -> if p x && null xs then ([], x:ys) else (x:xs, ys)
splitWhileEnd' p [] = ([], [])
splitWhileEnd' p (x : xs) = fun p x (splitWhileEnd' p xs)
ven' xs = let (x, y) = splitWhileEnd' (< maximum xs) xs in init x ++ y
If init and ++ are not allowed, you can implement them manually. It's easy!
BTW, I guess this may be your homework for Haskell course. I think it's ridiculous if your teacher gives the limitations. Who is programming from scratch nowadays?
Anyway, you can always work around this kind of limitations by reimplementing the built-in function manually. Good luck!
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.
So i have
pair:: [a] -> [b] -> [(a,b)]
pair[] _ = []
pair(x:xs) (y:ys) = (x, y) : prod xs ys
But the result are only like the following:
>> pair [1,2] [3,4]
>> [(1,3),(2,4)]
How can I make this so it pairs like:
[(1,3),(1,4),(2,3),(2,4)]
You can use the list applicative (or monad) instance:
λ> liftA2 (,) [1,2] [3,4]
[(1,3),(1,4),(2,3),(2,4)]
Or, equivalently,
f = do
x <- [1,2]
y <- [3,4]
return (x,y)
You can also use a list comprehension:
[ (x,y) | x <- [1,3], y <- [2,4] ]
Although there is already a much more elegant answer, i think it is worthwhile to show how this would be achieved in a simple straightforward way. If you want to get all pairs, you obviously need to visit every element of one list for an element in the other.
pair :: [a] -> [b] -> [(a, b)]
pair [] _ = []
pair (x:xs) ys = pair' x ys ++ pair xs ys where
pair' :: a -> [b] -> [(a, b)]
pair' _ [] = []
pair' x (y:ys) = (x,y) : pair' x ys
But of course using the pair = liftA2 (,) or [1,3] >>= \x -> [2,4] >>= \y -> (x,y) in its do notation or list comprehension notation is much better. Also ++ isn't what you normally want to do. So maybe you can build the lists as pair' would do, keep them in a list and then concat them.
concat $ map (\x -> map (\y -> (x,y)) ys) xs
I'm stuck at making a function in Haskell wich has to do the following:
For each integer in a list check how many integers in front of it are smaller.
smallerOnes [1,2,3,5] will have the result [(1,0), (2,1), (3,2), (5,3)]
At the moment I have:
smallerOnes :: [Int] -> [(Int,Int)]
smallerOnes [] = []
smallerOnes (x:xs) =
I don't have any clue on how to tackle this problem. Recursion is probably the way of thinking here but at that point I'm losing it.
It is beneficial here not to start with a base case, but rather with a main case.
Imagine we've already processed half the list. Now we are faced with the rest of the list, say x:xs. We want to know how many integers "before it" are smaller than x; so we need to know these elements, say ys: length [y | y<-ys, y<x] will be the answer.
So you'll need to use an internal function that will maintain the prefix ys, produce the result for each x and return them in a list:
smallerOnes :: [Int] -> [(Int,Int)]
smallerOnes [] = []
smallerOnes xs = go [] xs
where
go ys (x:xs) = <result for this x> : <recursive call with updated args>
go ys [] = []
This can also be coded using some built-in higher-order functions, e.g.
scanl :: (a -> b -> a) -> a -> [b] -> [a]
which will need some post-processing (like map snd or something) or more directly with
mapAccumL :: (acc -> x -> (acc, y)) -> acc -> [x] -> (acc, [y])
mapAccumL is in Data.List.
import Data.List (inits)
smallerOnes :: [Int] -> [(Int,Int)]
smallerOnes xs = zipWith (\x ys -> (x, length $ filter (< x) ys)) xs (inits xs)