This is an anti-symmetrical recursive function that will take a list of pairs If the list is anti-symmetrical then an empty list will return and if the list is symmetrical it will return only the two pairs that are symmetrical.
Here is an example output.
val antisymmetric_rel = [(1,2), (2,3), (4,4), (5,9), (10,9), (0,0)];
antisymmetricCounterEx(antisymmetric_rel);
(* [] *)
val not_antisymmetric_rel = [(1,2), (2,3), (4,4), (5,9), (10,9), (9,5)];
(* [((5,9),(9,5))] *)
Here is what I have so far.
fun antisymmetricCounterEx([]) = []
| antisymmetricCounterEx(relation) =
let
fun testOne((a, b), []) = []
| testOne((a, b), (c, d)::rest) =
(if (not (a = d)) orelse testOne((b, d), rest) ) then []
else [(a, b)] # testOne((c, d), rest);
fun testAll([]) = []
| testAll((a, b)::rest) =
testOne((a, b), relation) # testAll(rest);
in
testAll(relation)
end;
I am getting errors that I cannot understand but it seems that the type and operands are ok.
First off, let's clean up your code a bit.
We can remove the parentheses here: (if (not (a = d)) orelse testOne((b, d), rest) ) then [] which break the syntax, as well as generally eliminate extraneous parens throughout the code.
not (a = d) can be written as a <> d
[(a, b)] # testOne((c, d), rest) is replaced with (a, b) :: testOne((c, d), rest)
fun antisymmetricCounterEx([]) = []
| antisymmetricCounterEx(relation) =
let
fun testOne((a, b), []) = []
| testOne((a, b), (c, d)::rest) =
if a <> d orelse testOne((b, d), rest) then []
else (a, b) :: testOne((c, d), rest);
fun testAll([]) = []
| testAll((a, b)::rest) =
testOne((a, b), relation) # testAll(rest);
in
testAll(relation)
end;
This still fails because as pointed out in comments testOne returns a list:
fun testOne((a, b), []) = []
But it's used in a boolean context.
Really what you have is a filtering exercise. You need to filter for any pair that has a symmetrical counterpart in the list. However, you need to account for pairs that are symmetrical with themselves, like (4, 4) and (0, 0).
To aid with this, let's write a list_count function that can count the number of elements in a list that fulfill a predicate function.
fun list_count _ [] = 0
| list_count f (x::xs) =
(if f x then 1 else 0) + list_count f xs;
We can now use List.filter and list_count to achieve the desired result.
fun sym_pairs(pairs) =
List.filter
(fn (a, b) =>
let
val c = list_count (fn (c, d) => a = d andalso b = c) pairs
in
if a = b then c > 1
else c = 1
end)
pairs;
Now:
sym_pairs([(1,2), (2,3), (4,4), (5,9), (10,9), (0,0)]);
Yields: []. And:
sym_pairs([(1,2), (2,3), (4,4), (5,9), (10,9), (9,5)]);
Yields: [(5, 9), (9,5)].
Related
I implement function which adds an element once to every list of a list.
example:
f :: a -> [[a]] -> [[[a]]]
f 7 [[1],[2],[3]]
[[[7,1],[2],[3]],[[1],[7,2],[3]],[[1],[2],[7,3]]]
I start with this solution:
f :: a -> [[a]] -> [[[a]]]
f e xs = ((\n -> (\(x,l)-> if x==n then e:l else l) <$> zip [1..] xs) <$> [1..length xs])
Can you please provide some more nice implementations of this function?
You can implement this with recursion. As base case we consider an empty list:
f _ [] = []
for non-empty lists (x:xs) we can use the first item, which is the first sublist. We thus can produce a list where we prepend the first sublist x with the element e, followed by the remaining items xs, so (e:x) : xs is the first item. For the remaining items we recurse on the tail of the list xs and will for each sublist prepend this with the sublist x:
f e (x:xs) = ((e:x) : xs) : map (x:) (f e xs)
so putting these together gives us:
f :: a -> [[a]] -> [[[a]]]
f _ [] = []
f e (x:xs) = ((e : x) : xs) : map (x:) (f e xs)
Write splits which gives all possible ways of splitting a list
splits :: [a] -> [([a], [a])]
splits xs = zip (inits xs) (tails xs)
for example
> splits "abc"
[("","abc"),("a","bc"),("ab","c"),("abc","")]
and using it write a function that operates on each element of a list
onEach :: (a -> a) -> [a] -> [[a]]
onEach f xs = [ys ++ f z : zs | (ys, z:zs) <- splits xs]
like this
> onEach toUpper "abc"
["Abc","aBc","abC"]
and now f is just
f :: a -> [[a]] -> [[[a]]]
f x = onEach (x:)
Answer of David Flercher with onEach :: (a -> a) -> [a] -> [[a]] very interesting, I do some generalization with typeclass, I think this is usefull when we need some versions of objects mutated in one parameter..:
class Eachable e where
each :: (a -> a) -> e a -> [e a]
Now we can each on different types for example on Lists:
instance Eachable [] where
each _ [] = []
each g (x:xs) = ((g x) : xs) : map (x:) (each g xs)
each (+1) [1,2,3]
[[2,2,3],[1,3,3],[1,2,4]]
and Trees
data Tree a = Empty | Node (Tree a) a (Tree a) deriving Show
instance Eachable Tree where
each _ Empty = []
each g t#(Node l a r) = (\i -> e g 1 i t) <$> [1..count t] where
e _ _ _ Empty = Empty
e g c i (Node l a r) = Node l' a' r' where
a' = if c==i then g a else a
l' = if c==i then l else e g (c+1) i l
r' = if c==i then r else e g (c+(count l)+1) i r
count Empty = 0
count (Node l _ r) = 1 + count l + count r
tr = Node (Node Empty 1 Empty) 2 (Node Empty 3 Empty)
each (+1) tr
[Node (Node Empty 1 Empty) 3 (Node Empty 3 Empty),Node (Node Empty 2 Empty) 2 (Node Empty 3 Empty),Node (Node Empty 1 Empty) 2 (Node Empty 4 Empty)]
and others:
data Animal a = Animal {speed::a,size::a,smart::a} deriving Show
instance Eachable Animal where
each g (Animal sp sz sm) = [Animal (g sp) sz sm, Animal sp (g sz) sm, Animal sp sz (g sm)]
each (+1) $ Animal 1 1 1
[Animal {speed = 2, size = 1, smart = 1},Animal {speed = 1, size = 2, smart = 1},Animal {speed = 1, size = 1, smart = 2}]
I want to write a function that gives the cartesiant product of two sequences that's what i did but i thought that it can be interesting to have less complexity with I want to browsing once the first sequence s1 and n times the second using map and then append all the results:
`let cartesian_product a b =
let na = length a in
let nb = length b in
init
(na * nb)
(fun j -> let i = j / nb in
at a i, at b (j - i*nb))
`
that's what i did for the moment :
`let rec cartesian_product a b =
let rec aux x b () = match b () with
| Nil -> Nil
| Cons(e, b) -> Cons ((x, e), aux x b)
in
match a () with
| Nil -> nil
| Cons (x, a) -> append (aux x b) (cartesian_product a b)`
but i didn't use map (is there a better way for doing that)??
Your aux function is essentially a specific case of map so you can write:
let rec cartesian_product a b = match a () with
| Nil -> Nil
| Cons (x, a) -> append (map (fun e -> (x, e)) b) (cartesian_product a b)
As a rule of thumb when you feel the need to write a function called aux, take a step back and think whether you can use map or fold. In fact, you could improve my code by using a fold instead of deconstructing the sequence yourself.
Here an example of the algorithm with a structure of list :
let cartesian_product a b =
let open List in
let mk_tuple l n = map (fun x -> (n,x)) l in
a |> map (mk_tuple b) |> fold_left append []
This will give you :
cartesian_product [0;1] [2;3];;
- : (int * int) list = [(0, 2); (0, 3); (1, 2); (1, 3)]
I have a list of 3 tuples items, I would like to index the list based on the first item, I have already written a code that sounds logically sane to me yet am getting a type error, here's what I wrote
addIndex [] indexed = indexed
addIndex ((a1,b1,c1):xs) []
= addIndex xs [(a1,b1,c1,0)]
addIndex ((a1,b1,c1):xs) indexedWIP
= addIndexH ((a1,b1,c1):xs) indexedWIP (last indexedWIP)
addIndexH ((a1,b1,c1):xs) indexedWIP (ax,bx,cx,ix)
= if (a1 /= ax)
then (addIndex xs (indexedWIP ++ (a1,b1,c1,(ix+1))))
else (addIndex xs (indexedWIP ++ (a1,b1,c1,(ix))))
I'm getting the following type error
ERROR file:.\lmaogetrektson.hs:109 - Type error in application
*** Expression : indexedWIP ++ (a1,b1,c1,ix + 1)
*** Term : (a1,b1,c1,ix + 1)
*** Type : (b,c,d,e)
*** Does not match : [a]
Let me examine the types of your addIndex at each row:
addIndex :: [a] -> b -> b
addIndex [] indexed = indexed
-- Combined with the above, leads to:
addIndex :: (Num n) => [(a,b,c)] -> [(a,b,c,n)] -> [(a,b,c,n)]
addIndex ((a1,b1,c1):xs) [] = addIndex xs [(a1,b1,c1,0)]
-- This call demands addIndexH satisfies:
addIndexH :: (Num n) => [(a,b,c)] -> [(a,b,c,n)] -> (a,b,c,n) -> [(a,b,c,n)]
-- It's also costly, as last needs to traverse the list
addIndex ((a1,b1,c1):xs) indexedWIP =
addIndexH ((a1,b1,c1):xs) indexedWIP (last indexedWIP)
-- /= check matches types of a1 and ax, requiring them to be Eq
addIndexH ((a1,b1,c1):xs) indexedWIP (ax,bx,cx,ix) =
if (a1 /= ax) then (addIndex xs (indexedWIP ++ (a1,b1,c1,(ix+1))))
else (addIndex xs (indexedWIP ++ (a1,b1,c1,(ix))))
The distinction of list and tuple is actually the problem you hit here.
Prelude> :t (++)
(++) :: [a] -> [a] -> [a]
Both operands to ++ must be same-type lists. So we need something like:
addIndexH ((a1,b1,c1):xs) indexedWIP (ax,bx,cx,ix) =
if (a1 /= ax) then (addIndex xs (indexedWIP ++ [(a1,b1,c1,(ix+1))]))
else (addIndex xs (indexedWIP ++ [(a1,b1,c1,(ix))]))
The end result should be a function that takes a list of 3-tuples and another list of enumerated 4-tuples, but in a rather circuitous manner. Consider how it expands:
addIndex [(a,b,c), (x,y,z)] []
addIndex [(x,y,z)] [(a,b,c,0)]
addIndexH [(x,y,z)] [(a,b,c,0)] (a,b,c,0)
addIndex [] ([(a,b,c,0)] ++ [(x,y,z,(0+1))])
([(a,b,c,0)] ++ [(x,y,z,(0+1))])
That's a fairly complex procedure, and it grows worse the longer the lists are (we haven't even looked at duplicate a fields yet).
When you do encounter a duplicate a field, you still append it, only keeping the new index value. This means, since we only checked against the last item, that we have two items of matching a and index right next to each other. The function could be rewritten in several ways, in particular without rebuilding lists of every intermediate length and traversing the growing one for each element.
I think you make it more complex than necessary. If I understand it correctly, you take as input a list of 3-tuples (a, b, c), and you want to return a list of 4-tuples (a, b, c, i), where i specifies the thus far number of different a-values we observed.
We thus perform some sort of mapping but with an accumulator. Although we can use higher-order constructs here, let us here aim to use recursion and add an accumulator. We can first define a helper function with signature:
addIndex' :: (Num n, Eq a) => a -> n -> [(a, b, c)] -> [(a, b, c, n)]
where the first parameter is thus the a-value of the previous element (we here assume that we processed already an element). The second parameter is the number of elements we thus far observed, the third elements is the list of elements we still have to process, and the result is the list of 4-tuples.
In case the list is exhausted, then we can return the empty list, regardless of the other variables:
addIndex' _ _ [] = []
in the other case, we should compare the previous key ap with the current key a, and in case the two are equal, we return the tuple with the index i as last element, we then recurse with the same index; otherwise we increment the index (to i1 = i + 1). We each time recurse on the tail of the list:
addIndex' ap i ((a, b, c): xs) | a == ap = (a, b, c, i) : addIndex' a i xs
| otherwise = (a, b, c, i1) : addIndex' a i1 xs
where i1 = i + 1
So we obtain the function:
addIndex' :: (Num n, Eq a) => a -> n -> [(a, b, c)] -> [(a, b, c, n)]
addIndex' _ _ [] = []
addIndex' ap i ((a, b, c): xs) | a == ap = (a, b, c, i) : addIndex' a i xs
| otherwise = (a, b, c, i1) : addIndex' a i1 xs
where i1 = i + 1
But now we still have to process the first element. We know that if the list is empty, we return the empty list:
addIndex [] = []
otherwise we return as first tuple the first one in the given list with index 0, and then make a call to addIndex' with the remaining tuples and the first key as accumulator:
addIndex ((a, b, c): xs) = (a, b, c, 0) : addIndex' a 0 xs
so we obtain as full solution:
addIndex :: (Num n, Eq a) => [(a, b, c)] -> [(a, b, c, n)]
addIndex [] = []
addIndex ((a, b, c): xs) = (a, b, c, 0) : addIndex' a 0 xs
addIndex' :: (Num n, Eq a) => a -> n -> [(a, b, c)] -> [(a, b, c, n)]
addIndex' _ _ [] = []
addIndex' ap i ((a, b, c): xs) | a == ap = (a, b, c, i) : addIndex' a i xs
| otherwise = (a, b, c, i1) : addIndex' a i1 xs
where i1 = i + 1
Then we generate for example:
Prelude> addIndex [('a', 1, 4), ('a', 2, 5), ('b', 1, 3), ('b', 0, 2), ('c', 1, 2)]
[('a',1,4,0),('a',2,5,0),('b',1,3,1),('b',0,2,1),('c',1,2,2)]
But note that we only look at the previous element, and hence for example if the 'a' key occurs after 'c', we will increment the counter again:
Prelude> addIndex [('a', 1, 4), ('a', 2, 5), ('b', 1, 3), ('b', 0, 2), ('c', 1, 2), ('a', 3, 4)]
[('a',1,4,0),('a',2,5,0),('b',1,3,1),('b',0,2,1),('c',1,2,2),('a',3,4,3)]
This function will run in linear time O(n) whereas the functions you composed will run in quadratic time O(n2) since appending is done in linear time (as well as last, etc.).
So basically I have a list of tuples [(a,b)], from which i have to do some filtering. One job is to remove inverted duplicates such that if (a,b) and (b,a) exist in the list, I only take one instance of them. But the list comprehension has not been very helpful. How to go about this in an efficient manner?
Thanks
Perhaps an efficient way to do so (O(n log(n))) would be to track the tuples (and their reverses) already added, using Set:
import qualified Data.Set as Set
removeDups' :: Ord a => [(a, a)] -> Set.Set (a, a) -> [(a, a)]
removeDups' [] _ = []
removeDups' ((a, b):tl) s | (a, b) `Set.member` s = removeDups' tl s
removeDups' ((a, b):tl) s | (b, a) `Set.member` s = removeDups' tl s
removeDups' ((a, b):tl) s = ((a, b):rest) where
s' = Set.insert (a, b) s
rest = removeDups' tl s'
removeDups :: Ord a => [(a, a)] -> [(a, a)]
removeDups l = removeDups' l (Set.fromList [])
The function removeDups calls the auxiliary function removeDups' with the list, and an empty set. For each pair, if it or its inverse are in the set, it is passed; otherwise, both it and its inverses are added, and the tail is processed. \
The complexity is O(n log(n)), as the size of the set is at most linear in n, at each step.
Example
...
main = do
putStrLn $ show $ removeDups [(1, 2), (1, 3), (2, 1)]
and
$ ghc ord.hs && ./ord
[1 of 1] Compiling Main ( ord.hs, ord.o )
Linking ord ...
[(1,2),(1,3)]
You can filter them using your own function:
checkEqTuple :: (a, b) -> (a, b) -> Bool
checkEqTuple (x, y) (x', y') | (x==y' && y == x') = True
| (x==x' && y == y') = True
| otherwise = False
then use nubBy
Prelude Data.List> nubBy checkEqTuple [(1,2), (2,1)]
[(1,2)]
I feel like I'm repeating myself a bit, but that's okay. None of this code had been tested or even compiled, so there may be bugs. Suppose we can impose an Ord constraint for efficiency. I'll start with a limited implementation of sets of pairs.
import qualified Data.Set as S
import qualified Data.Map.Strict as M
newtype PairSet a b =
PS (M.Map a (S.Set b))
empty :: PairSet a b
empty = PS M.empty
insert :: (Ord a, Ord b)
=> (a, b) -> PairSet a b -> PairSet a b
insert (a, b) (PS m) = PS $ M.insertWith S.union a (S.singleton b) m
member :: (Ord a, Ord b)
=> (a, b) -> PairSet a b -> Bool
member (a, b) (PS m) =
case M.lookup a m of
Nothing -> False
Just s -> S.member b s
Now we just need to keep track of which pairs we've seen.
order :: Ord a => (a, a) -> (a, a)
order p#(a, b)
| a <= b = p
| otherwise = (b, a)
nubSwaps :: Ord a => [(a,a)] -> [(a,a)]
nubSwaps xs = foldr go (`seq` []) xs empty where
go p r s
| member op s = r s
| otherwise = p : r (insert op s)
where op = order p
If a and b are ordered and compareable, you could just do this:
[(a,b) | (a,b) <- yourList, a<=b]
How should one convert a list with a known length into nested pairs? In other words, what is the most convenient way to fill the type holes below?
_ [1,2] :: (Int,Int)
_ [1,2,3] :: ((Int,Int),Int)
_ [1,2,3,4] :: (((Int,Int),Int),Int)
_ [1,2,3,4,5] :: ((((Int,Int),Int),Int),Int)
EDIT: note that the type holes need not be the same function, I'm looking for a convenient pattern (if a convenient pattern exists) to fill the holes.
Perhaps like this:
step f xs = (f (init xs), last xs)
len1 = head
len2 = step len1
len3 = step len2
len4 = step len3
In ghci:
*Main> len4 [1..4]
(((1,2),3),4)
One may of course also directly implement one of these functions with pattern matching:
len4' [a,b,c,d] = (((a,b),c),d)
This will also not traverse the list as many times as there are elements, which is nice.
Chiming in with a dependently typed version. First, let's get done with the boilerplate:
{-# LANGUAGE
TemplateHaskell, DataKinds, ScopedTypeVariables,
FlexibleInstances, PolyKinds, TypeOperators,
TypeFamilies, GADTs, UndecidableInstances #-}
import Data.Singletons.TH
import qualified GHC.TypeLits as Lit
$(singletons [d| data Nat = Z | S Nat deriving (Eq, Show) |])
The use of TH here is purely for boilerplate reduction and we won't use TH in our actual code. In fact, the above could be (and should be) factored out in a package somewhere (at the time of writing this answer there isn't such a package with up-to-date singletons dependency).
tuplify becomes a function whose return type depends on a Nat parameter.
type family NTup n a where
NTup (S (S Z)) a = (a, a)
NTup (S (S (S n))) a = (NTup (S (S n)) a, a)
tuplify :: Sing n -> [a] -> NTup n a
tuplify n as = go n (reverse as) where
go :: Sing n -> [a] -> NTup n a
go (SS (SS SZ)) [a, b] = (b, a)
go (SS (SS (SS n))) (a:as) = (go (SS (SS n)) as, a)
go _ _ = error "tuplify: length mismatch"
Trying it out:
tuplify (SS (SS (SS SZ))) [1, 2, 3] -- ((1, 2), 3)
Writing out the naturals is quite arduous now, so let's introduce some syntactic sugar:
type family N n where
N 0 = Z
N n = S (N (n Lit.- 1))
type SN n = Sing (N n)
Now:
tuplify (sing:: SN 10) [1..10] -- (((((((((1,2),3),4),5),6),7),8),9),10)
As a side note, if we convert the empty list to () (and thereby also allow one-element nested tuples) our definitions become much more natural:
type family NTup n a where
NTup Z a = ()
NTup (S n) a = (NTup n a, a)
tuplify :: Sing n -> [a] -> NTup n a
tuplify n = go n . reverse where
go :: Sing n -> [a] -> NTup n a
go SZ [] = ()
go (SS n) (a:as) = (go n as, a)
go _ _ = error "tuplify: length mismatch"
tuplify (sing:: SN 5) [1..5] -- ((((((),1),2),3),4),5)
This would be a nice exercise in Agda with dependent types. In Haskell you can achieve something close with (also inspired from Daniel Wagner's solution)
class C a b where
listToTuple :: [a] -> b
instance C a a where
listToTuple [x] = x
instance C a b => C a (b,a) where
listToTuple xs = (listToTuple (init xs), last xs)
Some tests:
> listToTuple [1..3::Int] :: ((Int,Int),Int)
((1,2),3)
> listToTuple [0..3::Int] :: (((Int,Int),Int),Int)
(((0,1),2),3)
Note that the return type annotation is mandatory, otherwise Haskell can not deduce how many elements the return tuple must have. If there is a mismatch between the tuple and list length, a run-time error occurs. This is pretty much unavoidable since lists do not carry their length in their type, so the compiler can not check this earlier (unlike using a vector GADT).
In order to have such a generic and type-safe function, you'd need dependent types so that the number of nested tuples in the result could depend on the length of the input list.
However it's possible to get close to that with polymorphic recursion.
Let's define a data type as follows:
data TupleList' r a = Value r | Tuple (TupleList' (r, a) a)
deriving (Show, Read, Eq, Ord)
type TupleList = TupleList' ()
So a value of type TupleList a is isomorphic to (), ((), a), (((), a), a) etc, depending on how many Tuple constructors wrap the final Value.
Now we can convert a list into such a tuple as follows:
fromList :: [a] -> TupleList a
fromList = loop ()
where
loop :: r -> [a] -> TupleList' r a
loop r [] = Value r
loop r (x:xs) = Tuple (loop (r, x) xs)
Notice that loop uses polymorphic recursion (as any function that operates on TupleList' - its recursive call has signature (r, a) -> [a] -> TupleList' (r, a) a.
Example: mapM_ (print . fromList) (inits [1..4]) yields
Value ()
Tuple (Value ((),1))
Tuple (Tuple (Value (((),1),2)))
Tuple (Tuple (Tuple (Value ((((),1),2),3))))
Tuple (Tuple (Tuple (Tuple (Value (((((),1),2),3),4)))))
The simplest way is
z (x:xs) = x
s r (x:xs) = (x, r xs)
toTuples n xs = n xs
But toTuples returns pairs in the reverse order:
toTuples (s (s (s z))) [1..] == (1,(2,(3,4)))
We can use CPS to fix this:
z f xs = f ()
s r f (x:xs) = r (\p -> (f p, x)) xs
toTuples n (x:xs) = n (const x) xs
Then
toTuples (s (s (s z))) [1..] == (((1,2),3),4)
And we can define some syntactic sugar (I'm mostly stealing from András Kovács' answer):
{-# LANGUAGE TemplateHaskell, UndecidableInstances, DataKinds, GADTs, TypeFamilies, TypeOperators #-}
import Data.Singletons.TH
import GHC.TypeLits
$(singletons [d| data Nat = Z | S Nat deriving (Eq, Show) |])
z f xs = f ()
s r f (x:xs) = r (\p -> (f p, x)) xs
toTuples n (x:xs) = n (const x) xs
type family Result n r a where
Result Z r a = r
Result (S n) r a = Result n (r, a) a
run :: Sing n -> (() -> r) -> [a] -> Result n r a
run SZ = z
run (SS sn) = s (run sn)
toTuplesN :: Sing n -> [a] -> Result n a a
toTuplesN sn (x:xs) = run sn (const x) xs
type family N n where
N 0 = Z
N n = S (N (n - 1))
type SN n = Sing (N (n - 1))
main = print $ toTuplesN (sing :: SN 6) [1..] -- (((((1,2),3),4),5),6)
Note that the code works for infinite lists too, since there is no reversing.