Two way searching a list of tuples - haskell

tuplesList = [('a','m'), ('b', 'n'), ('c', 'o'), etc]
How do I search this list for a value by first looking at first elements and returning the second if found, but if not found then look at the second elements and return the first element if found. e.g. searching for 'a' would return 'm' and searching for 'n' returns 'b'?
I tried this:
lookup :: Char -> [(Char,Char)] -> Char
lookup x zs = (head [b | (a,b) <- zs, (a==x)])
lookup x zs = (head [a | (a,b) <- zs, (b==x)])
but I don't know how to say if the the 2nd line doesn't find a match then do the 3rd line.
Any help is appreciated.

Haskell already has its own lookup function which you should probably make use of:
lookup' :: Char -> [(Char,Char)] -> Char
lookup' x zs = case (search1, search2) of
(Just y, _) -> y
(Nothing, Just y) -> y
(Nothing, Nothing) -> error "What am I supposed to do here I DON'T KNOW"
where search1 = lookup x zs
search2 = lookup x [(b,a) | (a,b) <- zs]

A nice way to expand your partial solution is to just concatenate the two lists of candidates together, as in:
lookup x zs = head ([ b | (a,b) <- zs, a == x ] ++ [ a | (a,b) <- zs, b == x ])
Do you see why this works?
It's not maximally efficient, because if there's no match on the first component of the tuples it will go through zs twice - if zs is very large this holds on to zs longer than necessary.
In order to improve that I would do something like this (but only if it's very important!):
lookup x zs = goNoSecondBestYet zs where
goNoSecondBestYet [] = error "Nothing found"
goNoSecondBestYet ((a,b):abs)
| a == x = b -- we're done!
| b == x = goSecondBestFound b abs -- keep track of the newly found second best candidate
| otherwise = goNoSecondBestYet abs -- just go on
goSecondBestFound y [] = y
goSecondBestFound y ((a,b):abs)
| a == x = b -- we're done, never mind the second best
| otherwise = goSecondBestFound y abs -- keep going, we already have a second best
This is pretty complex already (try to generalise this to use 4-tuples to see what I mean!) and I would normally use Maybe for this; but it does go through the list only once.

You should consider that a lookup may fail. The natural thing to do here is to return a list of results:
lookup :: Eq a => a -> (a,a) -> [a]
lookup item xs = [ if a==c then b else a | (a,b) <- xs, a == c || b == c ]

Related

How many elements are the same in two lists, which have duplicate elements

I try to find the number of elements that are the same in two lists. There are duplicate elements in two lists.
What I want:
-- (because there are two 's' in both lists )
duplicateEle "sssf" "ssah" = 2
-- (because there are two 'a' and one 's' in both lists, intotal 3 common elements)
duplicateEle "aass" "aaas" = 3
-- (because there are two 'a' and two 's' in both lists, intotal 4 common elements)
duplicateEle "ssaa" "ssaa" = 4
My strategy is check each element in List1 to see if it is the element in List2.
if each element of the List1 is the element of the List2.
If true, count 1 and delete (Data.List) the corresponding element in the second list.
For example,
input "dddd" "ssdd" output 2 because there are two d in both lists.
First I check if the 1st element in List1 which is d is an element in List2, the result is True, so I delete only one d in List2, count +1, now count is 1.
Then I check if the 2nd element in List1 which is d is an element in List2, the result is also True, so, I delete one d in List2,count +1, now count is 2.
Because there is not any d left in List2, so, the count will stay at 2.
My code is: (wrong)
import Data.List
duplicateEleCount :: [Char] -> [Char] -> Int
duplicateEleCount (x:xs) ys =
let count = if x `elem` ys then do 1 (delete x ys) else 0
in count + duplicateEleCount xs ys
What you wrote is not so Haskelly. Since it's strings, we can sort them, then group:
import Data.List
-- group :: Eq a => [a] -> [[a]] -- Defined in `Data.List'
dupreps :: String -> String -> Int
dupreps a b = r
where
x = group $ sort a
y = group $ sort b
Now we have them both ordered and grouped, we can just advance along the two lists in an obvious way,
r = merge'n'count x y 0
merge'n'count _ [] cnt = cnt
merge'n'count [] _ cnt = cnt
merge'n'count (g:gs) (f:fs) cnt
| head g == head f
= merge'n'count gs fs (cnt + min (length g) (length f))
| head g < head f
= merge'n'count gs (f:fs) cnt
| head g > head f
= merge'n'count (g:gs) fs cnt
So that we have e.g.
> dupreps "aab" "abbc"
2
> dupreps "aab" "aabbc"
3
> dupreps "aabccc" "bbc"
2
The groups g and f in merge'n'count are always non-empty by construction, so using head is OK.
If you just want to find the number of common elements between two lists which have repeated items, you can simply do this:
f x y = length $ nub $ intersect x y
intersect will find the common elements (with repetition*), and nub will get the distinct values from that list.
Note: intersect will only include repetition from the first argument i.e. intersect "ss" "s" will return "ss" but intersect "s" "ss" will return just "s".
EDIT: Based on the clarification, we can use foldl to get the desired outcome like so:
dup x y = fst $ foldl (\acc z -> if z `elem` (snd acc) then ((1 + fst acc), delete z (snd acc)) else acc) (0,y) x
This applies the strategy outlined in the question - if the element is found in current value of second list, increase the count and modify the second list, else do nothing.
I believe, this is what you intended to write?
import Data.List
duplicateEleCount :: [Char] -> [Char] -> Int
duplicateEleCount (x:xs) ys =
let (count, ys') = if x `elem` ys then (1, delete x ys) else (0, ys)
in count + duplicateEleCount xs ys'
duplicateEleCount [] _ = 0
You can't use do like you were trying to do. Remember that all variables in Haskell are immutable, so delete doesn't change the original list, it returns a new one that we will have to pass along to the recursive call.
A note on performance: this function is O(n*m), since we have to traverse the whole second list for every element in the first list. We can sort the lists first and perform something similar to the merge operation from merge sort to bring it down to O(n*log(n) + m*log(m))).
On another note, because of haskell's laziness, we can split the function up to one like this, without losing any performance and gaining flexibility:
import Data.List
duplicateElems :: [Char] -> [Char] -> [Char]
duplicateElems (x:xs) ys =
if x `elem` ys
then x : duplicateElems xs (delete x ys)
else duplicateElems xs ys
duplicateElems [] _ = []
duplicateEleCount xs ys = length $ duplicateElems xs ys

Only keep values that appear more than once within a list comprehension

For example, if I have a list comprehension
comp :: Int -> Int -> Int -> [Int]
comp xs a b = [ y | x <- xs, y <- (func x a b) ]
where func is just the function
func :: Int -> Int -> Int -> [Int]
func x a b
| (x == a || x == b = [a,b]
| otherwise = filter (/=a) [a,b])
comp will typically give me duplicate values due to the way my func works.
i.e. I might get comp = [1,2,2,3,3,4] when passing some arbitrary a and b.
My question is: Is there any way I can only keep values in this list that appear more than once within the list comprehension? So that I instead get comp = [2,3] (since 2 and 3 appear more than once).
I understand there are many ways to do it outside of the list comprehension, but I want to know if it is possible to do it inside. Or could I even use a helper function to do this?
Yes, with the help of group:
import Data.List
onlyDupes xs = [x | x:_:_ <- group xs]
It works like this:
λ> onlyDupes [1,2,2,3,3,4]
[2,3]
You could integrate that logic into your existing list comprehension like this:
comp xs a b = [ y | x <- xs, y:_:_ <- group (func x a b) ]
Note: if your values aren't always sorted like they are in your example, then you'll need to use (group . sort) instead of just group.

How do I find all equivalent elements from a Symmetric Closure using Haskell?

I am trying to find all equivalent elements from symmetric closure using the Haskell code in Listing 1 .
symm is a list of tuples representing a set of equivalences on the set {a,b,c,d,l,m}. The equivalences are symmetric, if we have (x,y) then we have (y,x).
[('d','c'),('c','d'),('c','b'),('c','a'),('l','m'),('b','c'),('a','c'),('m','l')]
This relation partitions into two equivalence classes (a=b=c=d) and (l=m).
I wish to create a list of elements that are equivalent to a given element. For example, allEqual 'a' symm should give "bcd" and allEqual 'l' symm should give "m".
Listing 1 works for allEqual x symm when x='l' and x='m', but not for the other cases.
My current incorrect thinking behind the code is as follows:
If x is equal to the first or second element in the current tuple then find a tuple containing the next element from symm with the current tuple and its inverse removed
else
continue searching symm with the first tuple removed.
I think that the continued search with the removed leading tuple (the else above) is not a good idea as that tuple may be required later in the search. However, I cannot think of another way of moving through the list of tuples.
Listing 1
import Data.List as L
symm = [('d','c'),('c','d'),('c','b'),('c','a'),('l','m'),('b','c'),('a','c'),('m','l')]
deleteSymPairs (x,y) xs = L.delete (x,y) (L.delete (y,x) xs)
allEqual :: Eq t => t -> [(t,t)] -> [t]
allEqual x [] = []
allEqual x (y:xs) | (x == (fst y)) = ((snd y) : (allEqual (snd y) (deleteSymPairs y xs)))
| (x == (snd y)) = ((fst y) : (allEqual (fst y) (deleteSymPairs y xs)))
| otherwise = (allEqual x xs)
test1 = allEqual 'a' symm
test2 = allEqual 'm' symm
test3 = allEqual 'l' symm
If possible I would like to keep to vanilla Haskell using lists, though maybe sets are needed?
Any advice appreciated.
The naive solution (i.e. not using the standard union-find data structure) is to just do depth-first search. As usual with depth-first search, we'll keep track of a "set" of nodes that we know are equivalent and have already thoroughly explored for neighbors together with a "set" of frontier nodes that we have just discovered are equivalent but haven't yet searched for neighbors. We need to keep track of both for the usual cycle-avoidance reasons. We'll know we're done with the search when the frontier is empty.
That's the big picture. Now the nitty-gritty. Let's start with a helper function to compute the unadorned, un-transitively-closed neighbor function of the relation.
related :: Eq t => t -> [(t, t)] -> [t]
related t rel = [t'' | (t', t'') <- rel, t == t']
Now we can do our DFS. Initially we don't know of any equivalent nodes, and our frontier is the immediate neighbors of our input value.
transitivelyRelated :: Eq t => t -> [(t,t)] -> [t]
transitivelyRelated t rel = go (related t rel) [] where
go [] ts = ts
go frontier ts = go frontier' ts' where
ts' = frontier ++ ts
frontier' = [ t'
| t <- frontier
, t' <- related t rel
, t' `notElem` ts'
]
If we wanted the reflexive transitive closure instead, we could start with the simpler go [t] [] instead of go (related t rel) [].
However, this is quite inefficient -- something like O(n^3), I think -- compared to the standard way of computing the reflexive symmetric transitive closure which is basically as close to O(n) as it is possible to get without actually being O(n), so I strongly recommend that you step away from only using lists.
If the closure is symmetric but not transitive, you'll never need to look at a tuple you already eliminated.
Also, I'd split the question in two cases: all permutations are present vs not all are.
All permutations are present:
What I mean is, if ('a','b') is present, then so is ('b','a'). This is the case in your example.
In this case, you can simplify your algorithm by only looking at one element of the pair:
import qualified Data.List as L
allEqual :: Eq t => t -> [(t,t)] -> [t]
allEqual x = L.nub . allEqual' x
where
allEqual' x [] = []
allEqual' x (y:ys)
| x == fst y = snd y : allEqual' x ys
| otherwise = allEqual' x ys
Note that using nub is more efficient (O(nlogn)) than filtering every element in the list (O(n2))
Furthermore, you can make this function a bit more readable (in my opinion) by using filter and map
allEqual :: Eq t => t -> [(t,t)] -> [t]
allEqual x ys = L.nub . map snd . filter ((==x) . fst) $ ys
Not all permutations are present
This is similar to your version, only difference is again I'd use nub instead of your deleteSymPairs:
allEqual :: Eq t => t -> [(t,t)] -> [t]
allEqual x = L.nub . allEqual' x
where
allEqual' x [] = []
allEqual' x (y:ys)
| x == fst y = snd y : allEqual' x ys
| x == snd y = fst y : allEqual' x ys
| otherwise = allEqual' x ys

How to fix '*** Exception: Prelude.head: empty list' here

This is a homework , it's to removing the adjacent duplicates.
The result should like this removeAdjacentDuplicates [3,1,2,2,2,2,2,4,4,2,2,3] == [3,1,2,4,2,3]
I knew it's not necessary to use head here, but it's not allowed to use rekursion and List-Comprehensions of Form [e | ...]. Only the function in Prelude is permittet, group und so on , which in other packages are also not allowed. map zip filter concat reverse foldr are recommended.
For example , It's not possible to make this:
removeAdjacentDuplicates :: Eq a => [a] -> [a]
removeAdjacentDuplicates (x:xs#(y:_))
| x == y = x:tail (removeAdjacentDuplicates xs)
| otherwise = x:removeAdjacentDuplicates xs
so I try like this
removeAdjacentDuplicates = foldr (\x result -> if ( x == (head result)) then result else (x : result)) []
but when I test it, it throw *** Exception: Prelude.head: empty list' here out
I have tried to add removeAdjacentDuplicates [] = [] before,
But error is like this
Equations for ‘removeAdjacentDuplicates’ have different numbers of arguments
H7-1.hs:24:1-32
H7-1.hs:25:1-105
|
24 | removeAdjacentDuplicates [] = []
| ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^...
I don't understand where the problem is, and how can I solve it?
x == head result dies if result is [] -- and result is definitely [] in the first iteration of foldr, so adding a special case for when the input list would not require foldr to do any iterations is fixing exactly the wrong case!
Instead of trying to extract a value from the result list, you could insert x into a list; so consider using the condition
[x] == take 1 result
instead -- it never dies.
As said by #DanielWagner, head :: [a] -> a will raise an error for empty lists. We can solve this by using take :: Int -> [a] -> [a], or by using pattern matching:
removeAdjacentDuplicates :: (Foldable f, Eq a) => f a -> [a]
removeAdjacentDuplicates = foldr f []
where f x ys#(y:_) | x == y = ys
f x ys = (x:ys)
here ys#(y:_) will match given the list is non-empty, with y as head of the list. In that case we thus check if x == y, and if that holds, we return ys. Otherwise we return (x:ys).

Finding The Index of Element in an Array - Haskell

Which function can I use to find its index of an element in an Array?
For example, I want to find the index of 'x' in an Array (Data.Array)
lowerCase = listArray ((0,0),(1,12)) ['a'..]
fst <$> find ((== 'a') . snd) $ assocs lowerCase
To get all the indices a certain element appears in your Data.Array the following list comprehension can be used:
results = [fst x | x <- (assocs lowerCase), snd x == 'a']
assocs has the following prototype:
assocs :: Ix i => Array i e -> [(i, e)]
It basically flattens a Data.Array in a List containing (i, e) pairs.
For:
a = listArray ((0,0),(2,2)) ['a'..]
assocs a will output
[((0,0),'a'),((0,1),'b'),((0,2),'c'),((1,0),'d'),((1,1),'e'),((1,2),'f'),((2,0),'g'),((2,1),'h'),((2,2),'i')]
Now, in our list comprehension, we have x <- (assocs a), so x is generated by the list assocs a.
The list outputed by the list comprehension will contain only fst x where
snd x == theElementWeAreLookingFor
Every x generated by assocs a is checked and if the condition snd x == 'a' is met then fst a (the index) will be inserted in the output list.
Once the list is generated, it can be checked whether there are none, one or more outputs.
getElementIndex :: Array (Int, Int) Char -> Char -> Maybe (Int, Int)
getElementIndex a e
| null results = Nothing
| othwerwise = Just $ head results
where results = [fst x | x <- (assocs a), snd x == e]
A imperative pseduocode could look like:
results = []
for_each x in a.toList():
if x.second == 'a':
results.append(x.first)

Resources