Find any possible bondings of a list and predicate - list

My task is that I want to create a function that finds any possible "bondings" of a given list and a predicate but I can't find the right solution.
a bonding for ls for binary predicate p is a list of pairs bs :: [ (a,a) ] such that the following conditions hold
Every element in ls appears exactly once in map fst bs and exactly once in map snd bs
If a pair (x,y) appears in bs then both x and y must appear in ls.
If a pair (x,y) appears in bs then (y,x) also appears in bs.
If a pair (x,y) appears in bs then x does not equal y.
If a pair (x,y) appears in bs then p x y is True.
Furthermore, the function that I thought it will be useful for this problem is the following findBonding :: Eq a => (a -> a -> Bool) -> [a] -> Maybe [(a,a)] such that findBonding p ls takes p as predicate and ls as a list of integers.
For example, findBonding (\x -> \y -> odd(x+y)) [2,3,4,5,6,7] should return Just [(2,3),(3,2),(4,5),(5,4),(6,7),(7,6)]
Is it a good idea to declare findBonding with foldr of the ls (the list) and then p (the predicate) to be the function that should declare which pairs to find and then to loop over every two items to find the correct pairs and to return them as a list of lists.

With your final definition of a "bonding", this should do what you want:
import Data.Maybe
-- > removeEach [1,2,3,4] == [(1,[2,3,4]),(2,[1,3,4]),(3,[1,2,4]),(4,[1,2,3])]
removeEach :: [a] -> [(a,[a])]
removeEach [] = []
removeEach (x:xs) = (x,xs):map (fmap (x:)) (removeEach xs)
-- > findBonding (\x -> \y -> odd(x+y)) [2,3,4,5,6,7] == Just [(2,3),(3,2),(4,5),(5,4),(6,7),(7,6)]
-- > findBonding (\x -> \y -> even(x+y)) [2,3,4,5,6,7] == Nothing
findBonding :: (a -> a -> Bool) -> [a] -> Maybe [(a,a)]
findBonding f = listToMaybe . go where
go [] = [[]]
go (x:xs) = [(x,y):(y,x):xys | (y,ys) <- removeEach xs, f x y && f y x, xys <- go ys]
I created the helper function removeEach to, for each element in a list, provide that element plus the list without it.
The findBonding function takes the head of the list x, then finds an element y in the list such that f x y and f y x both hold, yields those pairs, and then recurses on the remainder of the list. It uses the outer list as a nondeterminism monad to ensure that if any possible combination of pairings work, it will find one.

Related

Function to find number of occurrences in list

So I already have a function that finds the number of occurrences in a list using maps.
occur :: [a] -> Map a a
occur xs = fromListWith (+) [(x, 1) | x <- xs]
For example if a list [1,1,2,3,3] is inputted, the code will output [(1,2),(2,1),(3,2)], and for a list [1,2,1,1] the output would be [(1,3),(2,1)].
I was wondering if there's any way I can change this function to use foldr instead to eliminate the use of maps.
You can make use of foldr where the accumulator is a list of key-value pairs. Each "step" we look if the list already contains a 2-tuple for the given element. If that is the case, we increment the corresponding value. If the item x does not yet exists, we add (x, 1) to that list.
Our function thus will look like:
occur :: Eq => [a] -> [(a, Int)]
occur = foldr incMap []
where incMap thus takes an item x and a list of 2-tuples. We can make use of recursion here to update the "map" with:
incMap :: Eq a => a -> [(a, Int)] -> [(a, Int)]
incMap x = go
where go [] = [(x, 1)]
go (y2#(y, ny): ys)
| x == y = … : ys
| otherwise = y2 : …
where I leave implementing the … parts as an exercise.
This algorithm is not very efficient, since it takes O(n) to increment the map with n the number of 2-tuples in the map. You can also implement incrementing the Map for the given item by using insertWith :: Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a, which is more efficient.

Get index of next smallest element in the list in Haskell

I m a newbie to Haskell. I am pretty good with Imperative languages but not with functional. Haskell is my first as a functional language.
I am trying to figure out, how to get the index of the smallest element in the list where the minimum element is defined by me.
Let me explain by examples.
For example :
Function signature
minList :: x -> [x]
let x = 2
let list = [2,3,5,4,6,5,2,1,7,9,2]
minList x list --output 1 <- is index
This should return 1. Because the at list[1] is 3. It returns 1 because 3 is the smallest element after x (=2).
let x = 1
let list = [3,5,4,6,5,2,1,7,9,2]
minList x list -- output 9 <- is index
It should return 9 because at list[9] is 2 and 2 is the smallest element after 1. x = 1 which is defined by me.
What I have tried so far.
minListIndex :: (Ord a, Num a) => a -> [a] -> a
minListIndex x [] = 0
minListIndex x (y:ys)
| x > y = length ys
| otherwise = m
where m = minListIndex x ys
When I load the file I get this error
• Couldn't match expected type ‘a’ with actual type ‘Int’
‘a’ is a rigid type variable bound by
the type signature for:
minListIndex :: forall a. (Ord a, Num a) => a -> [a] -> a
at myFile.hs:36:17
• In the expression: 1 + length ys
In an equation for ‘minListIndex’:
minListIndex x (y : ys)
| x > y = 1 + length ys
| otherwise = 1 + m
where
m = minListIndex x ys
• Relevant bindings include
m :: a (bound at myFile.hs:41:19)
ys :: [a] (bound at myFile.hs:38:19)
y :: a (bound at myFile.hs:38:17)
x :: a (bound at myFile.hs:38:14)
minListIndex :: a -> [a] -> a (bound at myFile.hs:37:1)
When I modify the function like this
minListIndex :: (Ord a, Num a) => a -> [a] -> a
minListIndex x [] = 0
minListIndex x (y:ys)
| x > y = 2 -- <- modified...
| otherwise = 3 -- <- modifiedd
where m = minListIndex x ys
I load the file again then it compiles and runs but ofc the output is not desired.
What is the problem with
| x > y = length ys
| otherwise = m
?
In short: Basically, I want to find the index of the smallest element but higher than the x which is defined by me in parameter/function signature.
Thanks for the help in advance!
minListIndex :: (Ord a, Num a) => a -> [a] -> a
The problem is that you are trying to return result of generic type a but it is actually index in a list.
Suppose you are trying to evaluate your function for a list of doubles. In this case compiler should instantiate function's type to Double -> [Double] -> Double which is nonsense.
Actually compiler notices that you are returning something that is derived from list's length and warns you that it is not possible to match generic type a with concrete Int.
length ys returns Int, so you can try this instead:
minListIndex :: Ord a => a -> [a] -> Int
Regarding your original problem, seems that you can't solve it with plain recursion. Consider defining helper recursive function with accumulator. In your case it can be a pair (min_value_so_far, its_index).
First off, I'd separate the index type from the list element type altogether. There's no apparent reason for them to be the same. I will use the BangPatterns extension to avoid a space leak without too much notation; enable that by adding {-# language BangPatterns #-} to the very top of the file. I will also import Data.Word to get access to the Word64 type.
There are two stages: first, find the index of the given element (if it's present) and the rest of the list beyond that point. Then, find the index of the minimum of the tail.
-- Find the 0-based index of the first occurrence
-- of the given element in the list, and
-- the rest of the list after that element.
findGiven :: Eq a => a -> [a] -> Maybe (Word64, [a])
findGiven given = go 0 where
go !_k [] = Nothing --not found
go !k (x:xs)
| given == xs = Just (k, xs)
| otherwise = go (k+1) xs
-- Find the minimum (and its index) of the elements of the
-- list greater than the given one.
findMinWithIndexOver :: Ord a => a -> [a] -> Maybe (Word64, a)
findMinWithIndexOver given = go 0 Nothing where
go !_k acc [] = acc
go !k acc (x : xs)
| x <= given = go (k + 1) acc xs
| otherwise
= case acc of
Nothing -> go (k + 1) (Just (k, x)) xs
Just (ix_min, curr_min)
| x < ix_min = go (k + 1) (Just (k, x)) xs
| otherwise = go (k + 1) acc xs
You can now put these functions together to construct the one you seek. If you want a general Num result rather than a Word64 one, you can use fromIntegral at the very end. Why use Word64? Unlike Int or Word, it's (practically) guaranteed not to overflow in any reasonable amount of time. It's likely substantially faster than using something like Integer or Natural directly.
It is not clear for me what do you want exactly. Based on examples I guess it is: find the index of the smallest element higher than x which appears after x. In that case, This solution is plain Prelude. No imports
minList :: Ord a => a -> [a] -> Int
minList x l = snd . minimum . filter (\a -> x < fst a) . dropWhile (\a -> x /= fst a) $ zip l [0..]
The logic is:
create the list of pairs, [(elem, index)] using zip l [0..]
drop elements until you find the input x using dropWhile (\a -> x /= fst a)
discards elements less than x using filter (\a -> x < fst a)
find the minimum of the resulting list. Tuples are ordered using lexicographic order so it fits your problem
take the index using snd
Your function can be constructed out of ready-made parts as
import Data.Maybe (listToMaybe)
import Data.List (sortBy)
import Data.Ord (comparing)
foo :: (Ord a, Enum b) => a -> [a] -> Maybe b
foo x = fmap fst . listToMaybe . take 1
. dropWhile ((<= x) . snd)
. sortBy (comparing snd)
. dropWhile ((/= x) . snd)
. zip [toEnum 0..]
This Maybe finds the index of the next smallest element in the list above the given element, situated after the given element, in the input list. As you've requested.
You can use any Enum type of your choosing as the index.
Now you can implement this higher-level executable specs as direct recursion, using an efficient Map data structure to hold your sorted elements above x seen so far to find the next smallest, etc.
Correctness first, efficiency later!
Efficiency update: dropping after the sort drops them sorted, so there's a wasted effort there; indeed it should be replaced with the filtering (as seen in the answer by Luis Morillo) before the sort. And if our element type is in Integral (so it is a properly discrete type, unlike just an Enum, thanks to #dfeuer for pointing this out!), there's one more opportunity for an opportunistic optimization: if we hit on a succ minimal element by pure chance, there's no further chance of improvement, and so we should bail out at that point right there:
bar :: (Integral a, Enum b) => a -> [a] -> Maybe b
bar x = fmap fst . either Just (listToMaybe . take 1
. sortBy (comparing snd))
. findOrFilter ((== succ x).snd) ((> x).snd)
. dropWhile ((/= x) . snd)
. zip [toEnum 0..]
findOrFilter :: (a -> Bool) -> (a -> Bool) -> [a] -> Either a [a]
findOrFilter t p = go
where go [] = Right []
go (x:xs) | t x = Left x
| otherwise = fmap ([x | p x] ++) $ go xs
Testing:
> foo 5 [2,3,5,4,6,5,2,1,7,9,2] :: Maybe Int
Just 4
> foo 2 [2,3,5,4,6,5,2,1,7,9,2] :: Maybe Int
Just 1
> foo 1 [3,5,4,6,5,2,1,7,9,2] :: Maybe Int
Just 9

haskell: how to get list of numbers which are higher then their neighbours in a starting list

I am trying to learn Haskell and I want to solve one task. I have a list of Integers and I need to add them to another list if they are bigger then both of their neighbors. For Example:
I have a starting list of [0,1,5,2,3,7,8,4] and I need to print out a list which is [5, 8]
This is the code I came up but it returns an empty list:
largest :: [Integer]->[Integer]
largest n
| head n > head (tail n) = head n : largest (tail n)
| otherwise = largest (tail n)
I would solve this as outlined by Thomas M. DuBuisson. Since we want the ends of the list to "count", we'll add negative infinities to each end before creating triples. The monoid-extras package provides a suitable type for this.
import Data.Monoid.Inf
pad :: [a] -> [NegInf a]
pad xs = [negInfty] ++ map negFinite xs ++ [negInfty]
triples :: [a] -> [(a, a, a)]
triples (x:rest#(y:z:_)) = (x,y,z) : triples rest
triples _ = []
isBig :: Ord a => (a,a,a) -> Bool
isBig (x,y,z) = y > x && y > z
scnd :: (a, b, c) -> b
scnd (a, b, c) = b
finites :: [Inf p a] -> [a]
finites xs = [x | Finite x <- xs]
largest :: Ord a => [a] -> [a]
largest = id
. finites
. map scnd
. filter isBig
. triples
. pad
It seems to be working appropriately; in ghci:
> largest [0,1,5,2,3,7,8,4]
[5,8]
> largest [10,1,10]
[10,10]
> largest [3]
[3]
> largest []
[]
You might also consider merging finites, map scnd, and filter isBig in a single list comprehension (then eliminating the definitions of finites, scnd, and isBig):
largest :: Ord a => [a] -> [a]
largest xs = [x | (a, b#(Finite x), c) <- triples (pad xs), a < b, c < b]
But I like the decomposed version better; the finites, scnd, and isBig functions may turn out to be useful elsewhere in your development, especially if you plan to build a few variants of this for different needs.
One thing you might try is lookahead. (Thomas M. DuBuisson suggested a different one that will also work if you handle the final one or two elements correctly.) Since it sounds like this is a problem you want to solve on your own as a learning exercise, I’ll write a skeleton that you can take as a starting-point if you want:
largest :: [Integer] -> [Integer]
largest [] = _
largest [x] = _ -- What should this return?
largest [x1,x2] | x1 > x2 = _
| x1 < x2 = _
| otherwise = _
largest [x1,x2,x3] | x2 > x1 && x2 > x3 = _
| x3 > x2 = _
| otherwise = _
largest (x1:x2:x3:xs) | x2 > x1 && x2 > x3 = _
| otherwise = _
We need the special case of [x1,x2,x3] in addition to (x1:x2:x3:[]) because, according to the clarification in your comment, largest [3,3,2] should return []. but largest [3,2] should return [3]. Therefore, the final three elements require special handling and cannot simply recurse on the final two.
If you also want the result to include the head of the list if it is greater than the second element, you’d make this a helper function and your largest would be something like largest (x1:x2:xs) = (if x1>x2 then [x1] else []) ++ largest' (x1:x2:xs). That is, you want some special handling for the first elements of the original list, which you don’t want to apply to all the sublists when you recurse.
As suggested in the comments, one approach would be to first group the list into tuples of length 3 using Preludes zip3 and tail:
*Main> let xs = [0,1,5,2,3,7,8,4]
*Main> zip3 xs (tail xs) (tail (tail xs))
[(0,1,5),(1,5,2),(5,2,3),(2,3,7),(3,7,8),(7,8,4)]
Which is of type: [a] -> [b] -> [c] -> [(a, b, c)] and [a] -> [a] respectively.
Next you need to find a way to filter out the tuples where the middle element is bigger than the first and last element. One way would be to use Preludes filter function:
*Main> let xs = [(0,1,5),(1,5,2),(5,2,3),(2,3,7),(3,7,8),(7,8,4)]
*Main> filter (\(a, b, c) -> b > a && b > c) xs
[(1,5,2),(7,8,4)]
Which is of type: (a -> Bool) -> [a] -> [a]. This filters out elements of a list based on a Boolean returned from the predicate passed.
Now for the final part, you need to extract the middle element from the filtered tuples above. You can do this easily with Preludes map function:
*Main> let xs = [(1,5,2),(7,8,4)]
*Main> map (\(_, x, _) -> x) xs
[5,8]
Which is of type: (a -> b) -> [a] -> [b]. This function maps elements from a list of type a to b.
The above code stitched together would look like this:
largest :: (Ord a) => [a] -> [a]
largest xs = map (\(_, x, _) -> x) $ filter (\(a, b, c) -> b > a && b > c) $ zip3 xs (tail xs) (tail (tail xs))
Note here I used typeclass Ord, since the above code needs to compare with > and <. It's fine to keep it as Integer here though.

Adding corresponding values of Tuple in a list in Haskell

I have a list for example: [(1,2),(3,4),(5,6)] and the function should return me the sum of the corresponding Tuples. So, this list should return (9,12). I know how to make the tuples add up individually but I have having troubles doing it them together.
sumSecondTuple list = foldl (\acc (x,y) -> (+) y acc) 0 list
sumFirstTuple list = foldl (\acc (x,y) -> (+) x acc) 0 list
I have this much so far. Is there a way I can incooperate them together?
You can also use foldr1:
foldr1 :: Foldable t => (a -> a -> a) -> t a -> a
In this case,
sumSecondTuple :: Num a => [(a,a)] -> (a,a)
sumSecondTuple = foldr1 f
where
f = (\ (a,b) (c,d) -> (a+c,b+d) )
However, sumSecondTuple [] returns an exception Prelude.foldr1: empty list. So, it's better to use foldr than use foldr1 on this occasion.

Creating a lists of lists with new element in each position

i'm new in the haskell world and i'd like to know how to insert a value in each position of a list in haskell, and return a lists of sublists containing the value in each position. For example:
insert' :: a -> [a] -> [[a]]
insert' a [] = [[a]]
insert' a list = ??
To get something like:
insert' 7 [1,2,3] = [[7,1,2,3],[1,7,2,3],[1,2,7,3],[1,2,3,7]]
insert' :: a -> [a] -> [[a]]
insert' y [] = [[y]]
insert' y xss#(x:xs) = (y : xss) : map (x :) (insert' y xs)
While the empty list case comes natural, let's take a look at insert' y xss#(x:xs). We essentially have two cases we need to cover:
y appears in front of x. Then we can just use y : xss.
y appears somewhere after x. We therefore just insert it in the rest of our list and make sure that x is the first element with map (x:).
Although #delta's answer is definitely more elegant, here a solution with difference lists. If we insert an element x on every location of list ys = [y1,y2,...,yn], the first time we will insert it as head, so that means we can construct x : ys.
. For the second element of the resulting list, we want to construct a list [y1,x,y2,...,yn]. We can do this like y1 : x : y2s. The next lists will all have a structure y1 : ....
The question is: how can we write a recursive structure that keeps track of the fact that we want to put elements in the head. We can use a function for that: we start with a function id. If we now call id (x:ys) then we will of course generate the list (x:ys).
We can however, based on the id function, construct a new function id2 = \z -> id (y1:z). This function will thus put y1 in the head of the list and then add the list with which we call id2 as tail. Next we can construct id3 = \z -> id2 (y2:z). This will put y1 and y2 as first elements followed by the tail z.
So we can put this into the following recursive format:
insert' :: a -> [a] -> [[a]]
insert' x = go id
where go d [] = [d [x]]
go d ys#(yh:yt) = (d (x : ys)) : go (d . (yh :)) yt
So we redirect insert' to go where the initial difference list is simply the id function. Each time we check if we have reached the end of the given list. If that is the case, we return the basecase: we call [x] (as tail) on the difference list, and thus construct a list where we append x as last element.
In case we have not yet reached the last element, we will first emit d (x : ys): we prepend x to the list and provide this as argument to the difference list d. d will prepend y1 : y2 : ... : yk up to the point where we insert x. Furthermore we call recursively go (d . (yh :)) yt on the tail of the list: we thus construct a new difference list, wehere we insert (yh :) as tail of the list. We thus produce a new function with one argument: the tail after the yh element.
This function produces the expected results:
*Main> insert' 4 []
[[4]]
*Main> insert' 4 [1,2,5]
[[4,1,2,5],[1,4,2,5],[1,2,4,5],[1,2,5,4]]
*Main> insert' 7 [1,2,3]
[[7,1,2,3],[1,7,2,3],[1,2,7,3],[1,2,3,7]]
You may also do as follows;
import Data.List
spread :: a -> [a] -> [[a]]
spread x xs = zipWith (++) (inits xs) ((x:) <$> tails xs)
*Main> spread 7 [1,2,3]
[[7,1,2,3],[1,7,2,3],[1,2,7,3],[1,2,3,7]]
*Main> spread 7 []
[[7]]
So this is about three stages.
(x:) <$> tails xs is all about applying the (x:) function to all elements of tails xs function. So tails [1,2,3] would return [[1,2,3],[2,3],[3],[]] and we are to apply an fmap which is designated by <$> in the inline form. This is going to be the third argument of the zipWith function.
(inits xs) which would return [[],[1],[1,2],[1,2,3]], is going to be the second argument to zipWith.
zipWith (++) is obviously will zip two list of lists by concatenating the list elements.
So we may also express the same functionality with applicative function functors as follows;
spread :: a -> [a] -> [[a]]
spread x = zipWith (++) <$> inits <*> fmap (x:) . tails
In this case we fmap the zipWith (++) function with type [[a]] -> [[a]] -> [[a]] over inits and then apply it over to fmap (x:) . tails.
It could get more pointfree but becomes more complicated to read through (at least for me). In my opinion this is as best as it gets.