I am attempting this exercise in Haskell wiki: https://en.wikibooks.org/wiki/Haskell/Higher-order_functions
The following exercise combines what you have learned about higher
order functions, recursion and I/O. We are going to recreate what is
known in imperative languages as a for loop. Implement a function
for :: a -> (a -> Bool) -> (a -> a) -> (a -> IO ()) -> IO ()
for i p f job = -- ???
so far I have:
-- for : init value, end condition function, increment function, IO function,
-- returns IO action
generate :: a -> (a->Bool) -> (a->a) -> [a]
generate s cnd incr = if (cnd s) then [] else [s] ++ generate (incr s) cnd incr
printToList = do
u <- print 1
v <- print 2
return [u,v]
ioToASingle :: [IO a] -> IO [a]
ioToASingle (x:xs) = do
x' <- x
return [x']
sequenceIO :: [IO a] -> IO [a]
sequenceIO [] = return []
sequenceIO (x:xs) = do
x' <- x
xs' <- sequenceIO xs
return ([x'] ++ xs')
for::a->(a->Bool)->(a->a)->(a->IO())->IO()
for s cnd incr ioFn = sequence_ (map (ioFn) (generate s cnd incr))
for'::a->(a->Bool)->(a->a)->(a->IO a)->IO [a]
for' s cnd incr ioFn = sequenceIO (map (ioFn) (generate s cnd incr))
for works OK:
for 1 (\i->i==10) (\i->i+1) (print)
1
2
3
4
5
6
7
8
9
for' gets an error:
*Main> for' 1 (\i->i==10) (\i->i+1) (print)
<interactive>:323:6: error:
• No instance for (Num ()) arising from the literal ‘1’
• In the first argument of ‘for'’, namely ‘1’
In the expression: for' 1 (\ i -> i == 10) (\ i -> i + 1) (print)
In an equation for ‘it’:
it = for' 1 (\ i -> i == 10) (\ i -> i + 1) (print)
*Main>
I can't figure out what's wrong.
Here's what you wrote:
for' :: a -> (a -> Bool) -> (a -> a ) -> (a -> IO a ) -> IO [a]
for' s cnd incr ioFn = sequenceIO (map (ioFn) ...
*Main> for' 1 (\i->i==10) (\i->i+1) (print )
a (a -> IO ())
------------
() a ~ ()
Thus 1 :: (Num a) => a ~ (Num ()) => (). But there's no Num instance for the type ().
This is GHC's roundabout way of telling you, you need a function of type a -> IO a, not a -> IO ().
Hindley-Milner allows unification with a "narrower" type, but here it would be better if it weren't -- the error message would be much clearer.
In any case it is easy to conjure up your own value–returning print, like
myprint :: a -> IO a
myprint x = do { print x -- or, print x >> return x
; return x
}
sequenceIO return type is IO [a], but ioFn (as in the definition of for') is "print" which returns IO(). You need ioFn to return IO a, so that return of sequenceIO will be IO [a].
e.g. try "return" instead of "print" and then print the value. "return" is a function in haskell which simply converts the argument passed into monad, in this case IO monad.
main = do p <- for' 1 (\i->i==10) (\i->i+1) (return)
print(p)
This will print simply list of 1 to 9 numbers.
Or
p :: Int -> IO [Int]
p x = for' 1 (\i->i==x) (\i->i+1) (return)
main = do y <- p 10
print (y)
I have a function called calcArr_ArrOfArr in F# with the signature int [] -> int [][] -> int, i.e. calcArr_ArrOfArr takes two arguments, an int array and an array of int arrays, and returns an int.
I want to create the function calcArrOfArr with the signature int [][] -> int, which does the following:
let calcArrOfArr (arrOfArr : int [][]) =
Array.fold (fun acc e -> acc + (calcArr_ArrOfArr e arrOfArr.[?..])) 0 arrOfArr
where ? would be the index of e + 1.
In other words, in calcArrOfArr I want to apply calcArr_ArrOfArr to every element e of arrOfArr plus the "remaining portion" of arrOfArr, i.e. the slice of arrOfArr starting from after element e. Of course, for the last element of arrOfArr, nothing would be added to the accumulator, nor would an exception be thrown.
Is there a way to create calcArrOfArr in a functional way? An Array.foldi function would come handy...
If you feel you need Array.foldi, write one! The following snippet will extend the built-in Array module with a foldi:
module Array =
let foldi f z a =
a |> Array.fold (fun (i,a) x -> i+1, f i a x) (0,z) |> snd
Slicing from past-the-end gives you the empty array (i.e., [|0;1|].[2..] = [||]), so now your original suggestion works:
let calcArrOfArr (arrOfArr : int [][]) =
Array.foldi (fun i acc e -> acc + (calcArr_ArrOfArr e arrOfArr.[i+1..])) 0 arrOfArr
However, the slice arrOfArr.[i+1..] copies the array slice; this might be unfortunate for efficiency.
Haven't tested it, but this seems about right:
let calcArrOfArr (arrOfArr : int [][]) =
arrOfArr
|> Seq.mapi (fun i x -> i, x)
|> Seq.fold (fun acc (i, e) -> acc + (calcArr_ArrOfArr e arrOfArr.[i+1..])) 0
What do I have to do to make GHC accept this code:
{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
module STTest where
import Data.Array.ST
import Control.Monad.ST.Strict as S
import Control.Monad.ST.Lazy as L
-- ST monad arrays (unboxed in actual code)
type Arr s a = STArray s Int a
-- representing some algorithm that works on these STArrays
data ArrGen s a = ArrGen (a -> S.ST s (Arr s a)) (Arr s a -> S.ST s ())
-- class for some "generator"
class Generator g a where
gen :: g -> a -> [a]
instance Generator (ArrGen s a) a where
gen (ArrGen create apply) s = L.runST $ do
a <- strictToLazyST $ create s -- DOES NOT WORK
strictToLazyST $ apply a >> getElems a
The error I get is the following:
Couldn't match type `s' with `s1'
`s' is a rigid type variable bound by
the instance declaration at STTest.hs:20:28
`s1' is a rigid type variable bound by
a type expected by the context: L.ST s1 [a] at STTest.hs:21:33
However, this works fine:
data Dummy
create' :: a -> S.ST s (Arr s a)
create' = undefined
apply' :: Arr s a -> S.ST s [a]
apply' = undefined
instance Generator Dummy a where
gen _ s = L.runST $ do
a <- strictToLazyST $ create' s
strictToLazyST $ apply' a >> getElems a
Why does it work with the second and not the first? And what can I do with the data declaration to make it work? Or can I add some sort of "forall" on the instance declaration?
The above is just a minimal test program. I actually loop the apply forever to create an infinite Stream of the output values. (So I can't just merge the two steps together.) And I really want to be able to instantiate once for the ArrGen data type and then make a variety of values of it using these STArray algorithms.
EDIT:
Didn't think to put the forall inside the functions to ArrGen (I put it on the overall type). Though now I have the a problem of getting it to work on STUArray. Like if I use the following:
class (Integral a, Bits a, forall s. MArray (STUArray s) a (S.ST s)) => HasSTU a
type AC a = (HasSTU a) => forall s. a -> S.ST s (STUArray s Int a)
type AU a = (HasSTU a) => forall s. STUArray s Int a -> S.ST s ()
type TX a = (HasSTU a) => a -> a -- or without the context
data ArrayGen a = AG (AC a) (AU a) (TX a)
Then this fails:
instance (HasSTU a) => Generator (ArrayGen a) a [a] where
gens (AG c u p) s = fmap (fmap p) $ L.runST $ do
ar <- strictToLazyST $ (c s)
streamM $ strictToLazyST $ u ar >> getElems ar -- can't use getElems here!
streamM :: (Applicative f) => f a -> f (Stream a))
streamM = Cons <$> a <*> streamM a
It complains:
Could not deduce (MArray (STUArray s) a (S.ST s))
arising from a use of `getElems'
from the context (HasSTU a)
Even though the context (HasSTU a) says (in my mind) that there is an (MArray (STUArray s) a (S.ST s)) context for all s, it doesn't seem to think so. I tried to fix it by changing the (AU a) type:
type AU a = (HasSTU a) => forall s. STUArray s Int a -> S.ST s [a]
And it seems to type check, but I am unable to actually use it. Similarly if I change to:
class (Integral a, Bits a, forall s. MArray (STUArray s) a (S.ST s)) => HasSTU s a
type AC a = (forall s. HasSTU s a) => a -> S.ST s (STUArray s Int a)
...
instance (forall s. HasSTU s a) => Generator (ArrayGen a) a [a] where
...
instance forall s. HasSTU s Word32 -- !!!
But then when I try to run something:
Could not deduce (forall s. HasSTU s Word32)
I hate this s! Why? I have an instance for all s! And I am really lost as to where I should put my foralls and what's really going on.
The problem is that runST requires a forall s. ST s t argument, but your type fixes s, so a use of create and apply in the monadic action makes it unsuitable for runST.
It does not seem to me that your use case forbids giving ArrGen polymorphic (in s) arguments, so
{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, RankNTypes #-}
module STTest where
import Data.Array.ST
import Control.Monad.ST.Strict as S
import Control.Monad.ST.Lazy as L
-- ST monad arrays (unboxed in actual code)
type Arr s a = STArray s Int a
-- representing some algorithm that works on these STArrays
data ArrGen a = ArrGen (forall s. a -> S.ST s (Arr s a)) (forall s. Arr s a -> S.ST s ())
-- class for some "generator"
class Generator g a where
gen :: g -> a -> [a]
instance Generator (ArrGen a) a where
gen (ArrGen create apply) s = L.runST $ do
a <- strictToLazyST $ create s -- DOES NOT WORK
strictToLazyST $ apply a >> getElems a
making the components polymorphic works (at least in the sense that it compiles, your use case may forbid this approach).
Why does it work with the second and not the first?
Because there, the s was not fixed, the computation is fully polymorphic in s, as required by runST.
EDIT3: I'm writing a code to process very long input list of Ints with only few hundred non-duplicates. I use two auxiliary lists to maintain cumulative partial sums to calculate some accumulator value, the how's and why's are non-important. I want to ditch all lists here and turn it into nice destructive loop, and I don't know how. I don't need the whole code, just a skeleton code would be great, were read/write is done to two auxiliary arrays and some end result is returned. What I have right now would run 0.5 hour for the input. I've coded this now in C++, and it runs in 90 seconds for the same input.
I can't understand how to do this, at all. This is the list-based code that I have right now:(but the Map-based code below is clearer)
ins :: (Num b, Ord a) => a -> b -> [(a, b)] -> ([(a, b)], b)
ins n x [] = ( [(n,x)], 0)
ins n x l#((v, s):t) =
case compare n v of
LT -> ( (n,s+x) : l , s )
EQ -> ( (n,s+x) : t , if null t then 0 else snd (head t))
GT -> let (u,z) = ins n x t
in ((v,s+x):u,z)
This is used in a loop, to process a list of numbers of known length, (changed it to foldl now)
scanl g (0,([],[])) ns -- ns :: [Int]
g ::
(Num t, Ord t, Ord a) =>
(t, ([(a, t)], [(a, t)])) -> a -> (t, ([(a, t)], [(a, t)]))
g (c,( a, b)) n =
let
(a2,x) = ins n 1 a
(b2,y) = if x>0 then ins n x b else (b,0)
c2 = c + y
in
(c2,( a2, b2))
This works, but I need to speed it up. In C, I would keep the lists (a,b) as arrays; use binary search to find the element with the key just above or equal to n (instead of the sequential search used here); and use in-place update to change all the preceding entries.
I'm only really interested in final value. How is this done in Haskell, with mutable arrays?
I tried something, but I really don't know what I'm doing here, and am getting strange and very long error messages (like "can not deduce ... from context ..."):
goarr top = runSTArray $ do
let sz = 10000
a <- newArray (1,sz) (0,0) :: ST s (STArray s Int (Integer,Integer))
b <- newArray (1,sz) (0,0) :: ST s (STArray s Int (Integer,Integer))
let p1 = somefunc 2 -- somefunc :: Integer -> [(Integer, Int)]
go1 p1 2 0 top a b
go1 p1 i c top a b =
if i >= top
then
do
return c
else
go2 p1 i c top a b
go2 p1 i c top a b =
do
let p2 = somefunc (i+1) -- p2 :: [(Integer, Int)]
let n = combine p1 p2 -- n :: Int
-- update arrays and calc new c
-- like the "g" function is doing:
-- (a2,x) = ins n 1 a
-- (b2,y) = if x>0 then ins n x b else (b,0)
-- c2 = c + y
go1 p2 (i+1) c2 top a b -- a2 b2??
This doesn't work at all. I don't even know how to encode loops in do notation. Please help.
UPD: the Map based code that runs 3 times slower:
ins3 :: (Ord k, Num a) => k -> a -> Map.Map k a -> (Map.Map k a, a)
ins3 n x a | Map.null a = (Map.insert n x a , 0)
ins3 n x a = let (p,q,r) = Map.splitLookup n a in
case q of
Nothing -> (Map.union (Map.map (+x) p)
(Map.insert n (x+leftmost r) r) , leftmost r)
Just s -> (Map.union (Map.map (+x) p)
(Map.insert n (x+s) r) , leftmost r)
leftmost r | Map.null r = 0
| otherwise = snd . head $ Map.toList r
UPD2: The error message is " Could not deduce (Num (STArray s1 i e)) from the context () arising from the literal `0' at filename.hs:417:11"
that's where it says return c in go1 function. Perhaps c is expected to be an array, but I want to return the accumulator value that is built while using the two auxiliary arrays.
EDIT3: I've replaced scanl and (!!) with foldl and take as per Chris's advice, and now it runs in constant space with sane empirical complexity and is actually projected to finish in under 0.5 hour - a.o.t. ... 3 days ! I knew about it of course but was so sure GHC optimizes the stuff away for me, surely it wouldn't make that much of a difference, I thought! And so felt only mutable arrays could help... Bummer.
Still, C++ does same in 90 sec, and I would very much appreciate help in learning how to code this with mutable arrays, in Haskell.
Are the input values ever EQ? If they are not EQ then the way scanl g (0,([],[])) ns is used means that the first [(,)] array, call it a always has map snd a == reverse [1..length a] at each stage of g. For example, in a length 10 list the value of snd (a !! 4) is going to be 10-4. Keeping these reversed index values by mutating the second value of each preceding entry in a is quite wasteful. If you need speed then this is one place to make a better algorithm.
None of this applies to the second [(,)] whose purpose is still mysterious to me. It records all insertions that were not done at the end of a, so perhaps it allows one to reconstruct the initial sequence of values.
You said "I'm only really interested in final value." Do you mean you only care about the last value in list output by the scanl .. line? If so then you need a foldl instead of scanl.
Edit: I am adding a non-mutable solution using a custom Finger Tree. It passes my ad hoc testing (at bottom of code):
{-# LANGUAGE MultiParamTypeClasses #-}
import Data.Monoid
import Data.FingerTree
data Entry a v = E !a !v deriving Show
data ME a v = NoF | F !(Entry a v) deriving Show
instance Num v => Monoid (ME a v) where
mempty = NoF
NoF `mappend` k = k
k `mappend` NoF = k
(F (E _a1 v1)) `mappend` (F (E a2 v2)) = F (E a2 (v1 + v2))
instance Num v => Measured (ME a v) (Entry a v) where
measure = F
type M a v = FingerTree (ME a v) (Entry a v)
getV NoF = 0
getV (F (E _a v)) = v
expand :: Num v => M a v -> [(a, v)]
expand m = case viewl m of
EmptyL -> []
(E a _v) :< m' -> (a, getV (measure m)) : expand m'
ins :: (Ord a, Num v) => a -> v -> M a v -> (M a v, v)
ins n x m =
let comp (F (E a _)) = n <= a
comp NoF = False
(lo, hi) = split comp m
in case viewl hi of
EmptyL -> (lo |> E n x, 0)
(E v s) :< higher | n < v ->
(lo >< (E n x <| hi), getV (measure hi))
| otherwise ->
(lo >< (E n (s+x) <| higher), getV (measure higher))
g :: (Num t, Ord t, Ord a) =>
(t, (M a t, M a t)) -> a -> (t, (M a t, M a t))
g (c, (a, b)) n =
let (a2, x) = ins n 1 a
(b2, y) = if x>0 then ins n x b else (b, 0)
in (c+y, (a2, b2))
go :: (Ord a, Num v, Ord v) => [a] -> (v, ([(a, v)], [(a, v)]))
go ns = let (t, (a, b)) = foldl g (0, (mempty, mempty)) ns
in (t, (expand a, expand b))
up = [1..6]
down = [5,4..1]
see'tests = map go [ up, down, up ++ down, down ++ up ]
main = putStrLn . unlines . map show $ see'test
Slightly unorthodox, I am adding a second answer using a mutable technique. Since user1308992 mentioned Fenwick trees, I have used them to implement the algorithm. Two STUArray are allocated and mutated during the run. The basic Fenwick tree keeps totals for all smaller indices and the algorithm here needs totals for all larger indices. This change is handled by the (sz-x) subtraction.
import Control.Monad.ST(runST,ST)
import Data.Array.ST(STUArray,newArray)
import Data.Array.Base(unsafeRead, unsafeWrite)
import Data.Bits((.&.))
import Debug.Trace(trace)
import Data.List(group,sort)
{-# INLINE lsb #-}
lsb :: Int -> Int
lsb i = (negate i) .&. i
go :: [Int] -> Int
go xs = compute (maximum xs) xs
-- Require "top == maximum xs" and "all (>=0) xs"
compute :: Int -> [Int] -> Int
compute top xs = runST mutating where
-- Have (sz - (top+1)) > 0 to keep algorithm simple
sz = top + 2
-- Reversed Fenwick tree (no bounds checking)
insert :: STUArray s Int Int -> Int -> Int -> ST s ()
insert arr x v = loop (sz-x) where
loop i | i > sz = return ()
| i <= 0 = error "wtf"
| otherwise = do
oldVal <- unsafeRead arr i
unsafeWrite arr i (oldVal + v)
loop (i + lsb i)
getSum :: STUArray s Int Int -> Int -> ST s Int
getSum arr x = loop (sz - x) 0 where
loop i acc | i <= 0 = return acc
| otherwise = do
val <- unsafeRead arr i
loop (i - lsb i) $! acc + val
ins n x arr = do
insert arr n x
getSum arr (succ n)
mutating :: ST s Int
mutating = do
-- Start index from 0 to make unsafeRead, unsafeWrite easy
a <- newArray (0,sz) 0 :: ST s (STUArray s Int Int)
b <- newArray (0,sz) 0 :: ST s (STUArray s Int Int)
let loop [] c = return c
loop (n:ns) c = do
x <- ins n 1 a
y <- if x > 0
then
ins n x b
else
return 0
loop ns $! c + y
-- Without debugging use the next line
-- loop xs 0
-- With debugging use the next five lines
c <- loop xs 0
a' <- see a
b' <- see b
trace (show (c,(a',b'))) $ do
return c
-- see is only used in debugging
see arr = do
let zs = map head . group . sort $ xs
vs <- sequence [ getSum arr z | z <- zs ]
let ans = filter (\(a,v) -> v>0) (zip zs vs)
return ans
up = [1..6]
down = [5,4..1]
see'tests = map go [ up, down, up ++ down, down ++ up ]
main = putStrLn . unlines . map show $ see'tests
let me call the function accumrArray.
accumrArray ::
(e' -> e -> e) An accumulating function
-> e A default element
-> (i, i) The bounds of the array
-> [(i, e')] List of associations
-> a i e The array
accumrArray (:) [] (1,2) [(1,1),(2,2),(2,3)] === array [(1,[1]), (2,[2,3])]
head $ (accumrArray (:) [] (1,1) [(1,x)|x<-[4..]]) ! 1 === 4
How strange... I wrote this function a few days ago for someone else. The function first appeared in LML (I believe), but never made it into the Haskell array library.
Here you go:
{-# LANGUAGE ScopedTypeVariables #-}
import Data.Array
import System.IO.Unsafe
import Data.IORef
import Data.Array.MArray
import Data.Array.Base
import Control.Monad
import Data.Array.IO
accumArrayR :: forall a e i. Ix i => (a -> e -> e) -> e -> (i,i) -> [(i,a)] -> Array i e
accumArrayR f e bounds#(l,u) assocs = unsafePerformIO $ do
ref <- newIORef assocs
arr <- newArray_ bounds
let _ = arr :: IOArray i e
let n = safeRangeSize (l,u)
let elem x = unsafePerformIO $ do
ass <- readIORef ref
let loop [] = writeIORef ref [] >> return e
loop ((y,a):rest) = do
let ix = safeIndex bounds n y
let r = f a (elem x)
unsafeWrite arr ix r
if (ix == x)
then writeIORef ref rest >> return r
else loop rest
loop ass
forM_ [0..n] $ \ix -> unsafeWrite arr ix (elem ix)
unsafeFreeze arr
A challenge for the reader: use accumArrayR to implement linear-time depth-first-search of a graph.
Edit I should mention that the function isn't thread-safe as written. Turning the IORef into an MVar would fix it, but there might be better ways.
Not the most efficient, but...
accumrArray f x b l = accumArray (flip f) x b (reverse l)
I would argue that
accumrArray f x b l = accumArray (flip f) x b (reverse l)
is indeed the best solution (credits to sclv's answer).
Its supposed "inefficiency" comes from fact that foldr applies the function f from right to left.
However, since accumArray is strict, l can never be infinite, otherwise the program would be incorrect. It would never terminate.
Therefore, foldl (flip f) is just as good as a foldr.