Standard ML :How to cycle through a list? - sml

I am trying to write a program that cycle through a list n times.
Suppose that L = [a1, a2, ... , an]
What I am trying to achieve is [ai+1, a i+2, ... , an, a1, a2, ... , ai].
I referenced to a previous post about this exact problem. However, I am not sure how to obtain the output or [ai+1, a i+2, ... , an, a1, a2, ... , ai].
For the output: I tried
-cycle([1,2,3,4], 5);
However the error that I am getting is that the operand and operator don't match
This is the code I found from the previous post:
fun cycle n i =
if i = 0 then n
else cycle (tl n) (i-1) # [hd(n)];

A way to do this using if-then-else:
fun cycle xs n =
if n = 0
then []
else xs # cycle xs (n - 1)
You might instead like to use pattern matching:
fun cycle xs 0 = []
| cycle xs n = xs # cycle xs (n - 1)
But the most elegant solution, I think, is using higher-order functions:
fun cycle xs n =
List.concat (List.tabulate (n, fn _ => xs))
A slightly harder task is how to write a cycle for lazy lists that cycles infinitely...
datatype 'a lazylist = Cons of 'a * (unit -> 'a lazylist) | Nil
fun fromList [] = Nil
| fromList (x::xs) = Cons (x, fn () => fromList xs)
fun take 0 _ = []
| take _ Nil = []
| take n (Cons (x, tail)) = x :: take (n - 1) (tail ())
local
fun append' (Nil, ys) = ys
| append' (Cons (x, xtail), ys) =
Cons (x, fn () => append' (xtail (), ys))
in
fun append (xs, Nil) = xs
| append (xs, ys) = append' (xs, ys)
end
fun cycle xs = ...
where take 5 (cycle (fromList [1,2])) = [1,2,1,2,1].

Related

Given an (a * b) list, return a (a * b list) list

A funky title perhaps, but I'm having a problem with the following:
Given a list of type (a * b) list, I want to create a new list with type (a * b list) list. An example:
Given list let testList = [(1,"c");(2,"a");(1,"b")], my function should return [(1, ["c";"b"]; (2, ["a"])].
I have the following, but I'm a little stuck on how to continue:
let rec toRel xs =
match xs with
| (a,b)::rest -> (a,[b])::toRel rest
| _ -> []
You can use the built-in function List.groupBy and then map to remove the redundant key:
testList |> List.groupBy fst |> List.map (fun (k,v) -> (k, List.map snd v))
// val it : (int * string list) list = [(1, ["c"; "b"]); (2, ["a"])]
Otherwise if you want to continue with a match you can do something like this:
let toRel x =
let rec loop acc xs =
match xs with
| (k, b) :: rest ->
let acc =
match Map.tryFind k acc with
| Some v -> Map.add k (b::v) acc
| None -> Map.add k [b] acc
loop acc rest
| _ -> acc
loop Map.empty x |> Map.toList
Or using Option.toList you can write it:
let toRel x =
let rec loop acc xs =
match xs with
| (k, b) :: rest ->
let acc =
let lst = Map.tryFind k acc |> Option.toList |> List.concat
Map.add k (b::lst) acc
loop acc rest
| _ -> acc
loop Map.empty x |> Map.toList

Implement insert in haskell with foldr

How to implement insert using foldr in haskell.
I tried:
insert'' :: Ord a => a -> [a] -> [a]
insert'' e xs = foldr (\x -> \y -> if x<y then x:y else y:x) [e] xs
No dice.
I have to insert element e in list so that it goes before first element that is larger or equal to it.
Example:
insert'' 2.5 [1,2,3] => [1.0,2.0,2.5,3.0]
insert'' 2.5 [3,2,1] => [2.5,3.0,2.0,1.0]
insert'' 2 [1,2,1] => [1,2,2,1]
In last example first 2 is inserted one.
EDIT:
Thanks #Lee.
I have this now:
insert'' :: Ord a => a -> [a] -> [a]
insert'' e xs = insert2 e (reverse xs)
insert2 e = reverse . snd . foldr (\i (done, l) -> if (done == False) && (vj e i) then (True, e:i:l) else (done, i:l)) (False, [])
where vj e i = e<=i
But for this is not working:
insert'' 2 [1,3,2,3,3] => [1,3,2,2,3,3]
insert'' 2 [1,3,3,4] => [1,3,2,3,4]
insert'' 2 [4,3,2,1] => [4,2,3,2,1]
SOLUTION:
insert'' :: Ord a => a -> [a] -> [a]
insert'' x xs = foldr pom poc xs False
where
pom y f je
| je || x > y = y : f je
| otherwise = x : y : f True
poc True = []
poc _ = [x]
Thanks #Pedro Rodrigues (It just nedded to change x>=y to x>y.)
(How to mark this as answered?)
You need paramorphism for that:
para :: (a -> [a] -> r -> r) -> r -> [a] -> r
foldr :: (a -> r -> r) -> r -> [a] -> r
para c n (x : xs) = c x xs (para c n xs)
foldr c n (x : xs) = c x (foldr c n xs)
para _ n [] = n
foldr _ n [] = n
with it,
insert v xs = para (\x xs r -> if v <= x then (v:x:xs) else (x:r)) [v] xs
We can imitate paramorphisms with foldr over init . tails, as can be seen here: Need to partition a list into lists based on breaks in ascending order of elements (Haskell).
Thus the solution is
import Data.List (tails)
insert v xs = foldr g [v] (init $ tails xs)
where
g xs#(x:_) r | v <= x = v : xs
| otherwise = x : r
Another way to encode paramorphisms is by a chain of functions, as seen in the answer by Pedro Rodrigues, to arrange for the left-to-right information flow while passing a second copy of the input list itself as an argument (replicating the effect of tails):
insert v xs = foldr g (\ _ -> [v]) xs xs
where
g x r xs | v > x = x : r (tail xs) -- xs =#= (x:_)
| otherwise = v : xs
-- visual aid to how this works, for a list [a,b,c,d]:
-- g a (g b (g c (g d (\ _ -> [v])))) [a,b,c,d]
Unlike the version in his answer, this does not copy the rest of the list structure after the insertion point (which is possible because of paramorphism's "eating the cake and having it too").
Here's my take at it:
insert :: Ord a => a -> [a] -> [a]
insert x xs = foldr aux initial xs False
where
aux y f done
| done || x > y = y : f done
| otherwise = x : y : f True
initial True = []
initial _ = [x]
However IMHO using foldr is not the best fit for this problem, and for me the following solution is easier to understand:
insert :: Int -> [Int] -> [Int]
insert x [] = [x]
insert x z#(y : ys)
| x <= y = x : z
| otherwise = y : insert x ys
I suppose fold isn't handy here. It always processes all elements of list, but you need to stop then first occurence was found.
Of course it is possible, but you probable don't want to use this:
insert' l a = snd $ foldl (\(done, l') b -> if done then (True, l'++[b]) else if a<b then (False, l'++[b]) else (True, l'++[a,b])) (False, []) l

Cartesian product of infinite lists in Haskell

I have a function for finite lists
> kart :: [a] -> [b] -> [(a,b)]
> kart xs ys = [(x,y) | x <- xs, y <- ys]
but how to implement it for infinite lists? I have heard something about Cantor and set theory.
I also found a function like
> genFromPair (e1, e2) = [x*e1 + y*e2 | x <- [0..], y <- [0..]]
But I'm not sure if it helps, because Hugs only gives out pairs without ever stopping.
Thanks for help.
Your first definition, kart xs ys = [(x,y) | x <- xs, y <- ys], is equivalent to
kart xs ys = xs >>= (\x ->
ys >>= (\y -> [(x,y)]))
where
(x:xs) >>= g = g x ++ (xs >>= g)
(x:xs) ++ ys = x : (xs ++ ys)
are sequential operations. Redefine them as alternating operations,
(x:xs) >>/ g = g x +/ (xs >>/ g)
(x:xs) +/ ys = x : (ys +/ xs)
[] +/ ys = ys
and your definition should be good to go for infinite lists as well:
kart_i xs ys = xs >>/ (\x ->
ys >>/ (\y -> [(x,y)]))
testing,
Prelude> take 20 $ kart_i [1..] [101..]
[(1,101),(2,101),(1,102),(3,101),(1,103),(2,102),(1,104),(4,101),(1,105),(2,103)
,(1,106),(3,102),(1,107),(2,104),(1,108),(5,101),(1,109),(2,105),(1,110),(3,103)]
courtesy of "The Reasoned Schemer". (see also conda, condi, conde, condu).
another way, more explicit, is to create separate sub-streams and combine them:
kart_i2 xs ys = foldr g [] [map (x,) ys | x <- xs]
where
g a b = head a : head b : g (tail a) (tail b)
this actually produces exactly the same results. But now we have more control over how we combine the sub-streams. We can be more diagonal:
kart_i3 xs ys = g [] [map (x,) ys | x <- xs]
where -- works both for finite
g [] [] = [] -- and infinite lists
g a b = concatMap (take 1) a
++ g (filter (not . null) (take 1 b ++ map (drop 1) a))
(drop 1 b)
so that now we get
Prelude> take 20 $ kart_i3 [1..] [101..]
[(1,101),(2,101),(1,102),(3,101),(2,102),(1,103),(4,101),(3,102),(2,103),(1,104)
,(5,101),(4,102),(3,103),(2,104),(1,105),(6,101),(5,102),(4,103),(3,104),(2,105)]
With some searching on SO I've also found an answer by Norman Ramsey with seemingly yet another way to generate the sequence, splitting these sub-streams into four areas - top-left tip, top row, left column, and recursively the rest. His merge there is the same as our +/ here.
Your second definition,
genFromPair (e1, e2) = [x*e1 + y*e2 | x <- [0..], y <- [0..]]
is equivalent to just
genFromPair (e1, e2) = [0*e1 + y*e2 | y <- [0..]]
Because the list [0..] is infinite there's no chance for any other value of x to come into play. This is the problem that the above definitions all try to avoid.
Prelude> let kart = (\xs ys -> [(x,y) | ls <- map (\x -> map (\y -> (x,y)) ys) xs, (x,y) <- ls])
Prelude> :t kart
kart :: [t] -> [t1] -> [(t, t1)]
Prelude> take 10 $ kart [0..] [1..]
[(0,1),(0,2),(0,3),(0,4),(0,5),(0,6),(0,7),(0,8),(0,9),(0,10)]
Prelude> take 10 $ kart [0..] [5..10]
[(0,5),(0,6),(0,7),(0,8),(0,9),(0,10),(1,5),(1,6),(1,7),(1,8)]
you can think of the sequel as
0: (0, 0)
/ \
1: (1,0) (0,1)
/ \ / \
2: (2,0) (1, 1) (0,2)
...
Each level can be expressed by level n: [(n,0), (n-1, 1), (n-2, 2), ..., (0, n)]
Doing this to n <- [0..]
We have
cartesianProducts = [(n-m, m) | n<-[0..], m<-[0..n]]

Eliminating the duplicates completely in Haskell

I have this code but it does not do what I want totally, I takes a list of tuples;
[(3,2),(1,2),(1,3),(1,2),(4,3),(3,2),(1,2)]
and gives
[(1,3),(4,3),(3,2),(1,2)]
but I want it to give
[(1,3),(4,3)]
where am I doing wrong? Thanks in advance.
eliminate :: [(Int,Int)] -> [(Int,Int)]
eliminate [] = []
eliminate (x:xs)
| isTheSame xs x = eliminate xs
| otherwise = x : eliminate xs
isTheSame :: [(Int,Int)] -> (Int,Int) -> Bool
isTheSame [] _ = False
isTheSame (x:xs) a
| (fst x) == (fst a) && (snd x) == (snd a) = True
| otherwise = isTheSame xs a
The code is almost correct. Just change this line
| isTheSame xs x = eliminate xs
to
| isTheSame xs x = eliminate $ filter (/=x) xs
The reason is that if x is contained in xs, you want to delete all occurences of x.
That said, there are a few parts in your code sample that could be expressed more elegantly:
(fst x) == (fst a) && (snd x) == (snd a) is the same as x == a
isTheSame is the same as elem, only with its arguments reversed
Thus, we could express the function eliminate like this:
eliminate [] = []
eliminate (x:xs)
| x `elem` xs = eliminate $ filter (/=x) xs
| otherwise = x : eliminate xs
This should do it:
-- all possibilities of picking one elt from a domain
pick :: [a] -> [([a], a)]
pick [] = []
pick (x:xs) = (xs,x) : [ (x:dom,y) | (dom,y) <- pick xs]
unique xs = [x | (xs,x) <- pick xs, not (elem x xs)]
Testing:
*Main Data.List> unique [(3,2),(1,2),(1,3),(1,2),(4,3),(3,2),(1,2)]
[(1,3),(4,3)]
More here and in Splitting list into a list of possible tuples
Following Landei's lead, here's a short version (although it'll return its results sorted):
import Data.List
unique xs = [x | [x] <- group . sort $ xs]
Inefficient reference implementation.
import Data.List
dups xs = xs \\ nub xs
eliminate xs = filter (`notElem` dups xs) xs
A shorter version (but results will be sorted):
import Data.List
eliminate :: [(Int,Int)] -> [(Int,Int)]
eliminate = concat . filter ((== 1) . length) . group . sort
Or with Maybe (thank you, Marimuthu):
import Data.List
import Data.Maybe
eliminate = mapMaybe f . group . sort where f [x] = Just x; f _ = Nothing
Thinking about... we could use lists instead of Maybe:
import Data.List
eliminate = (>>= f) . group . sort where f [x] = [x]; f _ = []

How to compute frequency via list comprehension?

count :: Eq a => a -> [a] -> Int
count n [] = 0
count n (x:xs) | n == x = 1 + count n xs
| otherwise = count n xs
rmdups :: Eq a => [a] -> [a]
rmdups [ ] = [ ]
rmdups (x:xs) = x : rmdups (filter(/= x) xs)
using the 2 functions, a third needs to be created, called frequency:
it should count how many times each distinct value in a list occurs in that list. for example : frequency "ababc", should return [(3,'a'),(2,'b'),(1,'c')].
the layout for frequency is :
frequency :: Eq a => [a] -> [(Int, a)]
P.s rmdups, removes duplicates from list, so rmdups "aaabc" = abc
and count 2 [1,2,2,2,3] = 3.
so far i have:
frequency :: Eq a => [a] -> [(Int, a)]
frequency [] = []
frequency (x:xs) = (count x:xs, x) : frequency (rmdups xs)
but this is partly there, (wrong). thanks
frequency xs = map (\c -> (count c xs,c)) (rmdups xs)
or, with a list comprehension,
frequency xs = [(count c xs, c) | c <- rmdups xs]
is the shortest way to define it using your count and rmdups. If you need it sorted according to frequency (descending) as in your example,
frequency xs = sortBy (flip $ comparing fst) $ map (\c -> (count c xs,c)) (rmdups xs)
using sortBy from Data.List and comparing from Data.Ord.
If all you have is an Eq constraint, you cannot gain much efficiency, but if you only need it for types in Ord, you can get a much more efficient implementation using e.g. Data.Set or Data.Map.
Here is my own 'lazy' answer, which does not call rmdups:
frequency [] = []
frequency (y:ys) = [(count y (y:ys), y)] ++ frequency (filter (/= y) ys)
import qualified Data.Set as Set
frequency xs = map (\x -> (length $ filter (== x) xs, x)) (Set.toList $ Set.fromList xs)