strict evaluation of integer accumulator - haskell

Here is a classic first attempt at a custom length function:
length1 [] = 0
length1 (x:xs) = 1 + length1 xs
And here is a tail-recursive version:
length2 = length2' 0 where
length2' n [] = n
length2' n (x:xs) = length2' (n+1) xs
However, (n+1) will not be evaluted strictly, but instad Haskell will create a thunk, right?
Is this a correct way to prevent the creation of the thunk, thus forcing strict evaluation of (n+1)?
length3 = length3' 0 where
length3' n [] = n
length3' n (x:xs) = length3' (n+1) $! xs
How would I achieve the same effect with seq instead of $!?

The usual way now to write it would be as:
length3 :: [a] -> Int
length3 = go 0
where
go :: Int -> [a] -> Int
go n [] = n
go n (x:xs) = n `seq` go (n+1) xs
Namely, as a fold over the list strict in the accumulator.
GHC yields the direct translation to Core:
Main.$wgo :: forall a_abz. GHC.Prim.Int# -> [a_abz] -> GHC.Prim.Int#
Main.$wgo =
\ (n :: GHC.Prim.Int#) (xs :: [a_abz]) ->
case xs of
[] -> n
_ : xs -> Main.$wgo a (GHC.Prim.+# n 1) xs
Showing that it is unboxed (and thus strict) in the accumulator.

I don't think that's quite right--$! is strict in its second argument, so you're just forcing the list and not the accumulator.
You can get the right strictness using seq something like this:
let n' = n + 1 in n' `seq` length3' n' xs
I think a more readable version would use bang patterns (a GHC extension):
length3' !n (x:xs) = ...

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

How do you parallelize lazily read information from stdin in Haskell?

I'm working with this code I wrote, and for some reason threadscope keeps telling me that it's almost never using more than one core at a time. I think the problem is that in order to get the second line it needs to fully evaluate the first line, but I can't figure out an easy way to get it to read in 11 lines at a time.
module Main where
import Control.Parallel
import Control.Parallel.Strategies
import System.IO
import Data.List.Split
import Control.DeepSeq
process :: [String] -> [String]
process lines = do
let xs = map (\x -> read x :: Double) lines
ys = map (\x -> 1.0 / (1.0 + (exp (-x)))) xs
retlines = map (\x -> (show x ) ++ "\n") ys
retlines
main :: IO ()
main = do
c <- getContents
let xs = lines c
ys = (process xs) `using` parBuffer 11 rdeepseq
putStr (foldr (++) [] ys)
If I am reading this code right, parBuffer n only sparks the first n elements -- all the rest are evaluated in the usual Haskell way.
parBuffer :: Int -> Strategy a -> Strategy [a]
parBuffer n strat = parBufferWHNF n . map (withStrategy strat)
parBufferWHNF :: Int -> Strategy [a]
parBufferWHNF n0 xs0 = return (ret xs0 (start n0 xs0))
where -- ret :: [a] -> [a] -> [a]
ret (x:xs) (y:ys) = y `par` (x : ret xs ys)
ret xs _ = xs
-- start :: Int -> [a] -> [a]
start 0 ys = ys
start !_n [] = []
start !n (y:ys) = y `par` start (n-1) ys
Note in particular that start 0 ys = ys and not, say, start 0 ys = evaluateThePreviousChunk `pseq` start n0 ys or something that would start up more sparks. The documentation definitely doesn't make this clear -- I don't think "rolling buffer strategy" obviously implies this behavior, and I agree it's a bit surprising, to the point that I wonder whether this is just a bug in the parallel library that nobody caught yet.
You probably want parListChunk instead.

Haskell Length function implementation

I am learning Haskell programming, and I am trying to understand how lists work, hence I attempted writing two possible length functions:
myLength :: [a] -> Integer
myLength = foldr (\x -> (+) 1) 0
myLength1 :: [a] -> Integer
myLength1 [] = 0
myLength1 (x:xs) = (+1) (myLength1 xs)
Which one is better?
From my point of view, myLength1 is much easier to understand, and looks natural for operating on lists.
On the other hand, myLength is shorter and it does not use recursion; does this imply myLength runs faster than myLength1?
Take in mind this "pseudo implementation" of foldr:
foldr :: function -> initializer -> [a] -> b
foldr _ i [] = i
foldr f i (x:xs) = x `f` (foldr f i xs)
Now we have your code
myLength :: [a] -> Integer
myLength = foldr (\x -> (+) 1) 0
myLength1 :: [a] -> Integer
myLength1 [] = 0
myLength1 (x:xs) = (+1) (myLength1 xs)
Since foldr is also recursive itself, your myLength1 and myLength will be almost the same but in the first case the recursive call is done by foldr instead of explicitly by yourself. They should run around the same time.
Both functions do the same thing : foldr use recursion and will end up executing similarly to your directly recursive function. It could be argued that the foldr version is cleaner (once you're accustomed to them, higher order function are often more readable than direct recursion).
But those two functions are pretty bad : they'll both end up building a big thunk (an unevaluated value) 1 + (1 + (1 + ... + 0)..)) which will take a lot of memory ( O(n) space ) and will slow evaluation. To avoid that you should start adding the 1s from the beginning of the list, like so :
betterLength xs = go 0 xs
where
go n [] = n
go n (_:xs) = n `seq` go (n+1) xs
The seq ensures that n is evaluated before the go function is called recursively and thus there is no accumulation of +1. With the BangPatterns extension, you can write this :
betterLength xs = go 0 xs
where
go n [] = n
go !n (_:xs) = go (n+1) xs
It is also possible to do this version with a fold :
betterLength = foldl' (\n _ -> n + 1) 0
where the foldl' start from the left and is strict (').
Using foldr, it can be implemented as:
length' xs = foldr (\_ n -> 1 + n) 0 xs
Explanation:
The lambda function (\_ x -> n + 1) will increment the accumulator by one every time there is an element. For instance:
lenght' [1..4]
will be applied as:
1 + ( 1 + ( 1 + ( 1 + 0)))
Recall that foldr is defined like this:
foldr :: (a -> b -> b) -> b -> [a] -> b
foldr f v [] = v
foldr f v (x:xs) = f x (foldr f v xs)

Remove every nth element from string

How can you remove every nth element of a string?
I'm guessing you would use the drop function in some kind of way.
Like this drops the first n, how can you change this so only drops the nth, and then the nth after that, and so on, rather than all?
dropthem n xs = drop n xs
Simple. Take (n-1) elements, then skip 1, rinse and repeat.
dropEvery _ [] = []
dropEvery n xs = take (n-1) xs ++ dropEvery n (drop n xs)
Or in showS style for efficiency's sake
dropEvery n xs = dropEvery' n xs $ []
where dropEvery' n [] = id
dropEvery' n xs = (take (n-1) xs ++) . dropEvery n (drop n xs)
-- groups is a pretty useful function on its own!
groups :: Int -> [a] -> [[a]]
groups n = map (take n) . takeWhile (not . null) . iterate (drop n)
removeEveryNth :: Int -> [a] -> [a]
removeEveryNth n = concatMap (take (n-1)) . groups n
remove_every_nth :: Int -> [a] -> [a]
remove_every_nth n = foldr step [] . zip [1..]
where step (i,x) acc = if (i `mod` n) == 0 then acc else x:acc
Here's what the function does:
zip [1..] is used to index all items in the list, so e.g. zip [1..] "foo" becomes [(1,'f'), (2,'o'), (3,'o')].
The indexed list is then processed with a right fold which accumulates every element whose index is not divisible by n.
Here's a slightly longer version that does essentially the same thing, but avoids the extra memory allocations from zip [1..] and doesn't need to calculate modulus.
remove_every_nth :: Int -> [a] -> [a]
remove_every_nth = recur 1
where recur _ _ [] = []
recur i n (x:xs) = if i == n
then recur 1 n xs
else x:recur (i+1) n xs
Try to combine take and drop to achieve this.
take 3 "hello world" = "hel"
drop 4 "hello world" = "o world"
I like the following solution:
del_every_nth :: Int -> [a] -> [a]
del_every_nth n = concat . map init . group n
You just have to define a function group which groups a list in portions of length n. But that's quite easy:
group :: Int -> [a] -> [[a]]
group n [] = []
group n xs = take n xs : group n (drop n xs)

Resources