Slow insertion sorting - haskell

insertionSort :: (Ord a) => [a] -> [a]
insertionSort (x:xs) = insertionSortIter [x] xs
where insertionSortIter sorted [] = sorted
insertionSortIter sorted (x:xs) = insertionSortIter (insert x sorted (length sorted)) xs
insert x list n --insert x in list at n
| n == 0 = x:list
| x < list !! (n - 1) = insert x list (n - 1)
| otherwise = firstns ++ (x:other) where (firstns, other) = splitAt n list
-- [1..10000] 30s
mergeSort :: (Ord a) => [a] -> [a]
mergeSort (x:[]) = [x]
mergeSort list = merge (mergeSort list1) (mergeSort list2)
where (list1, list2) = splitAt (length list `div` 2) list
merge [] list = list
merge list [] = list
merge (x:xs) (y:ys) = if x < y then x:(merge xs (y:ys)) else y:(merge (x:xs) ys)
-- [1..10000] 2.4s
Time of execution is specified with time of building (at 1 or 1.5s). But still you can feel the difference.
Probably the problem is execution of each branch in guard of insert function or firstns ++ (x:other) is too slow. But in any case, to put the item in the end of the list I need to go through the entire list for O(n).

Your insert function is slow. Here's how to do insertion sort:
insertionSort :: Ord a => [a] -> [a]
insertionSort xs = f [] xs
where
f rs [] = rs
f rs (x:xs) = f (insert x rs) xs
insert x [] = [x]
insert x rrs#(r:rs) = if x < r then x:rrs else r:insert x rs
In case of confusion, the rrs#(r:rs) syntax means that rrs is the entire list, r is its head, and rs is its tail.
insert goes through the list and puts out all the elements that are supposed to be in front of x, then it puts out x followed by elements that are supposed to be after x.

Related

create a function ved that will only remove the last occurrence of the largest item in the list using recursion

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!

Is there a way to use "<=" for pattern matching in Haskell?

I have the following code, that drops every nth element in a list.
dropEvery :: [a] -> Int -> [a]
dropEvery xs n = f xs n ++ dropEvery (drop n xs) n
where
f ys 0 = []
f ys 1 = []
f [] m = []
f (y:ys) n = y : (f ys (n-1))
I would like to make it a bit shorter and was wondering if there is a way to use "<=" in pattern matching. I tried doing this using a where clause, which did not work, why?
f ys m = []
where
m <= 1 || ys == []
How can I shirk this redundancy? Is there a nice way to use "less or equal" in pattern matching?
EDIT: I tried this using guards
where
f ys m
| m <= 1 || null ys = []
| otherwise = (head ys) : (f (tail ys) (n-1))
You can work with a guard:
dropEvery :: [a] -> Int -> [a]
dropEvery xs n = f xs n ++ dropEvery (drop n xs) n
where
f ys i | i <= 1 = []
f [] _ = []
f (y:ys) n = y : (f ys (n-1))
If the condition in the guard is satisfied, then that clause "fires" and thus in this case will return an empty list [].
You will however get stuck in an infinite loop, since you write f xs n ++ dropEvery (n xs) n but drop 3 [] will return [], and thus it will keep calling dropEvery with an empty list.
You can make use of recursion where we each time decrement n until it reaches 0, and then we make two hops, so:
dropEvery :: Int -> [a] -> [a]
dropEvery n = go (n-1)
where go _ [] = []
go i (x:xs)
| i <= 0 = go (n-1) xs
| otherwise = x : go (i-1) xs
We can also work with splitAt :: [a] -> ([a], [a]) and with a pattern guard:
dropEvery n [] = []
dropEvery n ds
| (_:ys) <- sb = sa ++ dropEvery n ys
| otherwise = sa
where (sa, sb) = splitAt (n-1) ds

Group Sum to N: working with list of lists

I'm learning Haskell and working on a problem where you take in a number, n, and list, iL. With these you check what consecutive numbers would be < than n and store it in a list. You can have more than one list. I've created a function called groupSumtoN that would return this list of lists.
I've created a helper function helperToSum to recursively create the list and return the output, which takes the number n, input , and acc ( the result).
Here is what I have tried so far:
groupSumtoN :: (Ord a, Num a) => a -> [a] -> [[a]]
groupSumtoN n [] = []
groupSumtoN n iL = (helperToSum n iL [])
helperToSum n [] acc = acc
helperToSum n (x:xs) acc | (sum acc) + x < n = (helperToSum n xs (acc : x))
| (sum acc) + x > n = acc:(helperToSum n xs [x])
I get two infinite type errors, one for calling helperToSum from groupSumtoN and another in this line.
(sum acc) + x < n = (helperToSum n xs (acc : x))
As an example I have an example how this function should work below:
groupSumtoN 15 [1, 2, 3, 4, 5, 6, 7, 8, 9, 10]
[[1,2,3,4,5],[6,7],[8],[9],[10]]
Any help would be greatly appreciated.
The base case:
helperToSum n [] acc = acc
Does not make much sense, since it expects a list of lists. You need to return a singleton list:
helperToSun n [] acc = [acc]
Another problem is that (acc : x) is not valid. (:) is a constructor of a list, and has type (:) :: a -> [a] -> [a]. You can not use it to append values. We could, for now, use (x : acc). In that case, you will later need to reverse.
It is furthermore better to use otherwise as second guard. Here for example it is possible that the sum is exactly n, and that case is not covered right now.
With these problems in mind, we can fix the compilation errors, with the following function:
helperToSum :: (Ord a, Num a) => a -> [a] -> [a] -> [[a]]
helperToSum n [] acc = [acc]
helperToSum n (x:xs) acc | (sum acc) + x <= n = (helperToSum n xs (x : acc))
| otherwise = acc:(helperToSum n xs [x])
But here the groups will be reversed, and furthermore it is not very efficient. We can make a more lazy variant that on the fly calculates how much space is left in a group, and aims to assign the items in the current, or the next group based on that condition:
groupSumtoN :: (Ord a, Num a) => a -> [a] -> [[a]]
groupSumtoN n = go n
where go _ [] = [[]]
go r (x:xs) | x <= r = let (t:tl) = go (r-x) xs in (x:t) : tl
| x > n = error "Item too large"
| otherwise = [] : go n (x:xs)
Here an empty lists, will produce a single group:
Prelude> groupSumtoN 15 []
[[]]
I leave it as an exercise to further improve this.

What's an efficient way to pluck an element out of a list and return the element, and rest of list in a tuple?

This seems to be a very common operation but I can't find it in hoogle for some reason. Either way, it's an interesting thought exercise. My naive implementation:
pluckL :: [a] -> Int -> Maybe ( a, [a] )
pluckL xs idx = if idx < length xs then Just $ pluck' xs idx else Nothing
where
pluck' l n = let subl = drop n l in ( head subl, rest l n ++ tail subl )
rest l n = reverse $ drop ( length l - n ) $ reverse l
My main gripe is that I'm flipping the list too many times, so I'm looking for a creative way where you can traverse the list once and generate the tuple.
There will never be an efficient way. But there can at least be a pretty way:
pluckL xs i = case splitAt i xs of
(b, v:e) -> Just (v, b ++ e)
_ -> Nothing
You can get by with one fewer reverse and fewer operations on the list if you use an accumulator:
pluckL :: [a] -> Int -> Maybe (a, [a])
pluckL xs idx = pluck xs idx [] where
pluck (x:xs) 0 acc = Just $ ( x, (reverse acc) ++ xs )
pluck (x:xs) i acc = pluck xs (i-1) (x:acc)
pluck [] i acc = Nothing
You can use elem to check if the elem is in the list or not, then depending of the result return Nothing or use delete x to remove x from the list, as follow for example,
pluckL :: Eq a => [a] -> a -> Maybe (a, [a])
pluckL xs0 x =
if (x `elem` xs0)
then Just (x, xs)
else Nothing
where xs = delete x xs0

can you get a count on matches in a list comprehension (trying to insertionSort on a qsort after threshold)

I come from a C++ background so I'm not sure if I'm even going about this properly. But what I'm trying to do is write up quick sort but fallback to insertion sort if the length of a list is less than a certain threshold. So far I have this code:
insertionSort :: (Ord a) => [a] -> [a]
insertionSort [] = []
insertionSort (x:xs) = insert x (insertionSort xs)
quickSort :: (Ord a) => [a] -> [a]
quickSort x = qsHelper x (length x)
qsHelper :: (Ord a) => [a] -> Int -> [a]
qsHelper [] _ = []
qsHelper (x:xs) n
| n <= 10 = insertionSort xs
| otherwise = qsHelper before (length before) ++ [x] ++ qsHelper after (length after)
where
before = [a | a <- xs, a < x]
after = [a | a <- xs, a >= x]
Now what I'm concerned about is calculating the length of each list every time. I don't fully understand how Haskell optimizes things or the complete effects of lazy evaluation on code like the above. But it seems like calculating the length of the list for each before and after list comprehension is not a good thing? Is there a way for you to extract the number of matches that occurred in a list comprehension while performing the list comprehension?
I.e. if we had [x | x <- [1,2,3,4,5], x > 3] (which results in [4,5]) could I get the count of [4,5] without using a call to length?
Thanks for any help/explanations!
Short answer: no.
Less short answer: yes, you can fake it. import Data.Monoid, then
| otherwise = qsHelper before lenBefore ++ [x] ++ qsHelper after lenAfter
where
(before, Sum lenBefore) = mconcat [([a], Sum 1) | a <- xs, a < x]
(after, Sum lenAfter) = mconcat [([a], Sum 1) | a <- xs, a >= x]
Better answer: you don't want to.
Common reasons to avoid length include:
its running time is O(N)
but it costs us O(N) to build the list anyway
it forces the list spine to be strict
but we're sorting the list: we have to (at least partially) evaluate each element in order to know which is the minimum; the list spine is already forced to be strict
if you don't care how long the list is, just whether it's shorter/longer than another list or a threshold, length is wasteful: it will walk all the way to the end of the list regardless
BINGO
isLongerThan :: Int -> [a] -> Bool
isLongerThan _ [] = False
isLongerThan 0 _ = True
isLongerThan n (_:xs) = isLongerThan (n-1) xs
quickSort :: (Ord a) => [a] -> [a]
quickSort [] = []
quickSort (x:xs)
| not (isLongerThan 10 (x:xs)) = insertionSort xs
| otherwise = quickSort before ++ [x] ++ quickSort after
where
before = [a | a <- xs, a < x]
after = [a | a <- xs, a >= x]
The real inefficiency here though is in before and after. They both step through the entire list, comparing each element against x. So we are stepping through xs twice, and comparing each element against x twice. We only have to do it once.
(before, after) = partition (< x) xs
partition is in Data.List.
No, there is no way to use list comprehensions to simultaneously do a filter and count the number of found elements. But if you are worried about this performance hit, you should not be using the list comprehensions the way you are in the first place: You are filtering the list twice, hence applying the predicate <x and its negation to each element. A better variant would be
(before, after) = partition (< x) xs
Starting from that it is not hard to write a function
partitionAndCount :: (a -> Bool) -> [a] -> (([a],Int), ([a],Int))
that simultaneously partitions and counts the list and counts the elements in each of the returned list:
((before, lengthBefore), (after, lengthAfter)) = partitionAndCount (< x) xs
Here is a possible implementation (with a slightly reordered type):
{-# LANGUAGE BangPatterns #-}
import Control.Arrow
partitionAndCount :: (a -> Bool) -> [a] -> (([a], [a]), (Int, Int))
partitionAndCount p = go 0 0
where go !c1 !c2 [] = (([],[]),(c1,c2))
go !c1 !c2 (x:xs) = if p x
then first (first (x:)) (go (c1 + 1) c2 xs)
else first (second (x:)) (go c1 (c2 + 1) xs)
And here you can see it in action:
*Main> partitionAndCount (>=4) [1,2,3,4,5,3,4,5]
(([4,5,4,5],[1,2,3,3]),(4,4))

Resources