I just reinvented some monad, but I'm not sure which. It lets you model steps of a computation, so you can interleave the steps of numerous computations to find which one finishes first.
{-# LANGUAGE ExistentialQuantification #-}
module Computation where
-- model the steps of a computation
data Computation a = forall b. Step b (b -> Computation a) | Done a
instance Monad Computation where
(Step b g) >>= f = Step b $ (>>=f) . g
(Done b) >>= f = Step b f
return = Done
runComputation :: Computation a -> a
runComputation (Step b g) = runComputation (g b)
runComputation (Done a) = a
isDone :: Computation a -> Bool
isDone (Done _) = True
isDone _ = False
-- an order for a set of computations
data Schedule a = a :> Computation (Schedule a) | Last
toList :: Schedule a -> [a]
toList Last = []
toList (a :> c) = a : (toList . runComputation) c
-- given a set of computations, find a schedule to generate all their results
type Strategy a = [Computation a] -> Computation (Schedule a)
-- schedule all the completed computations, and step the rest,
-- passing the remaining to the given function
scheduleOrStep :: (Queue (Computation a) -> Computation (Schedule a)) -> Strategy a
scheduleOrStep s cs = scheduleOrStep' id cs
where scheduleOrStep' q ((Done a):cs) = Done $ a :> scheduleOrStep' q cs
scheduleOrStep' q ((Step b g):cs) = scheduleOrStep' (q . (g b:)) cs
scheduleOrStep' q [] = s q
-- schedule all completed compuations, step all the rest once, and repeat
-- (may never complete for infinite lists)
-- checking each row of
-- [ [ c0s0, c1s0, c2s0, ... ]
-- , [ c0s1, c1s1, c2s1, ... ]
-- , [ c0s2, c1s2, c2s2, ... ]
-- ...
-- ]
-- (where cNsM is computation N stepped M times)
fair :: Strategy a
fair [] = Done Last
fair cs = scheduleOrStep (fair . ($[])) cs
-- schedule more steps for earlier computations rather than later computations
-- (works on infinite lists)
-- checking the sw-ne diagonals of
-- [ [ c0s0, c1s0, c2s0, ... ]
-- , [ c0s1, c1s1, c2s1, ... ]
-- , [ c0s2, c1s2, c2s2, ... ]
-- ...
-- ]
-- (where cNsM is computation N stepped M times)
diag :: Enqueue (Computation a)-> Strategy a
diag _ [] = Done Last
diag enq cs = diag' cs id
where diag' (c:cs) q = scheduleOrStep (diag' cs) (enq c q $ [])
diag' [] q = fair (q [])
-- diagonal downwards :
-- [ c0s0,
-- c1s0, c0s1,
-- c2s0, c1s1, c0s2,
-- ...
-- cNs0, c{N-1}s1, ..., c1s{N-1}, c0sN,
-- ...
-- ]
diagd :: Strategy a
diagd = diag prepend
-- diagonal upwards :
-- [ c0s0,
-- c0s1, c1s0,
-- c0s2, c1s1, c2s0,
-- ...
-- c0sN, c1s{N-1}, ..., c{s1N-1}, cNs0,
-- ...
-- ]
diagu :: Strategy a
diagu = diag append
-- a queue type
type Queue a = [a] -> [a]
type Enqueue a = a -> Queue a -> Queue a
append :: Enqueue a
append x q = q . (x:)
prepend :: Enqueue a
prepend x q = (x:) . q
I feel like this is probably some kind of threading monad?
It looks like a resumption-with-state monad. I think there used to be a resumption monad in MTL around GHC 6.6 but if there was it disappeared. William Harrison at the University of Missouri has a number of papers about resumption monads - http://people.cs.missouri.edu/~harrisonwl/publications.html
I don't understand why not
data Computation a = Step (Computation a) | Done a
instance Monad Computation where
(Step g) >>= f = Step $ g >>= f
(Done b) >>= f = Step (f b)
return = Done
I'm not sure what this monad is, but it's definitely simpler and seems to be equivalent in most respects.
I haven't spent too much time understanding your code, but it really sounds like the coroutine monad from the monad-coroutine package, which may be a bit more general.
This looks similar to the definition of stream fusion used by Don Stewart did a while ago, and also somewhat related to iteratees (though wihtout the notion of pushing data into the iteratee using an enumerator), but less so than stream fusion I guess.
Related
I have random number generator
rand :: Int -> Int -> IO Int
rand low high = getStdRandom (randomR (low,high))
and a helper function to remove an element from a list
removeItem _ [] = []
removeItem x (y:ys) | x == y = removeItem x ys
| otherwise = y : removeItem x ys
I want to shuffle a given list by randomly picking an item from the list, removing it and adding it to the front of the list. I tried
shuffleList :: [a] -> IO [a]
shuffleList [] = []
shuffleList l = do
y <- rand 0 (length l)
return( y:(shuffleList (removeItem y l) ) )
But can't get it to work. I get
hw05.hs:25:33: error:
* Couldn't match expected type `[Int]' with actual type `IO [Int]'
* In the second argument of `(:)', namely
....
Any idea ?
Thanks!
Since shuffleList :: [a] -> IO [a], we have shuffleList (xs :: [a]) :: IO [a].
Obviously, we can't cons (:) :: a -> [a] -> [a] an a element onto an IO [a] value, but instead we want to cons it onto the list [a], the computation of which that IO [a] value describes:
do
y <- rand 0 (length l)
-- return ( y : (shuffleList (removeItem y l) ) )
shuffled <- shuffleList (removeItem y l)
return y : shuffled
In do notation, values to the right of <- have types M a, M b, etc., for some monad M (here, IO), and values to the left of <- have the corresponding types a, b, etc..
The x :: a in x <- mx gets bound to the pure value of type a produced / computed by the M-type computation which the value mx :: M a denotes, when that computation is actually performed, as a part of the combined computation represented by the whole do block, when that combined computation is performed as a whole.
And if e.g. the next line in that do block is y <- foo x, it means that a pure function foo :: a -> M b is applied to x and the result is calculated which is a value of type M b, denoting an M-type computation which then runs and produces / computes a pure value of type b to which the name y is then bound.
The essence of Monad is thus this slicing of the pure inside / between the (potentially) impure, it is these two timelines going on of the pure calculations and the potentially impure computations, with the pure world safely separated and isolated from the impurities of the real world. Or seen from the other side, the pure code being run by the real impure code interacting with the real world (in case M is IO). Which is what computer programs must do, after all.
Your removeItem is wrong. You should pick and remove items positionally, i.e. by index, not by value; and in any case not remove more than one item after having picked one item from the list.
The y in y <- rand 0 (length l) is indeed an index. Treat it as such. Rename it to i, too, as a simple mnemonic.
Generally, with Haskell it works better to maximize the amount of functional code at the expense of non-functional (IO or randomness-related) code.
In your situation, your “maximum” functional component is not removeItem but rather a version of shuffleList that takes the input list and (as mentioned by Will Ness) a deterministic integer position. List function splitAt :: Int -> [a] -> ([a], [a]) can come handy here. Like this:
funcShuffleList :: Int -> [a] -> [a]
funcShuffleList _ [] = []
funcShuffleList pos ls =
if (pos <=0) || (length(take (pos+1) ls) < (pos+1))
then ls -- pos is zero or out of bounds, so leave list unchanged
else let (left,right) = splitAt pos ls
in (head right) : (left ++ (tail right))
Testing:
λ>
λ> funcShuffleList 4 [0,1,2,3,4,5,6,7,8,9]
[4,0,1,2,3,5,6,7,8,9]
λ>
λ> funcShuffleList 5 "#ABCDEFGH"
"E#ABCDFGH"
λ>
Once you've got this, you can introduce randomness concerns in simpler fashion. And you do not need to involve IO explicitely, as any randomness-friendly monad will do:
shuffleList :: MonadRandom mr => [a] -> mr [a]
shuffleList [] = return []
shuffleList ls =
do
let maxPos = (length ls) - 1
pos <- getRandomR (0, maxPos)
return (funcShuffleList pos ls)
... IO being just one instance of MonadRandom.
You can run the code using the default IO-hosted random number generator:
main = do
let inpList = [0,1,2,3,4,5,6,7,8]::[Integer]
putStrLn $ "inpList = " ++ (show inpList)
-- mr automatically instantiated to IO:
outList1 <- shuffleList inpList
putStrLn $ "outList1 = " ++ (show outList1)
outList2 <- shuffleList outList1
putStrLn $ "outList2 = " ++ (show outList2)
Program output:
$ pickShuffle
inpList = [0,1,2,3,4,5,6,7,8]
outList1 = [6,0,1,2,3,4,5,7,8]
outList2 = [8,6,0,1,2,3,4,5,7]
$
$ pickShuffle
inpList = [0,1,2,3,4,5,6,7,8]
outList1 = [4,0,1,2,3,5,6,7,8]
outList2 = [2,4,0,1,3,5,6,7,8]
$
The output is not reproducible here, because the default generator is seeded by its launch time in nanoseconds.
If what you need is a full random permutation, you could have a look here and there - Knuth a.k.a. Fisher-Yates algorithm.
I have written this function that computes Collatz sequences, and I see wildly varying times of execution depending on the spin I give it. Apparently it is related to something called "memoization", but I have a hard time understanding what it is and how it works, and, unfortunately, the relevant article on HaskellWiki, as well as the papers it links to, have all proven to not be easily surmountable. They discuss intricate details of the relative performance of highly layman-indifferentiable tree constructions, while what I miss must be some very basic, very trivial point that these sources neglect to mention.
This is the code. It is a complete program, ready to be built and executed.
module Main where
import Data.Function
import Data.List (maximumBy)
size :: (Integral a) => a
size = 10 ^ 6
-- Nail the basics.
collatz :: Integral a => a -> a
collatz n | even n = n `div` 2
| otherwise = n * 3 + 1
recollatz :: Integral a => a -> a
recollatz = fix $ \f x -> if (x /= 1)
then f (collatz x)
else x
-- Now, I want to do the counting with a tuple monad.
mocollatz :: Integral b => b -> ([b], b)
mocollatz n = ([n], collatz n)
remocollatz :: Integral a => a -> ([a], a)
remocollatz = fix $ \f x -> if x /= 1
then f =<< mocollatz x
else return x
-- Trivialities.
collatzLength :: Integral a => a -> Int
collatzLength x = (length . fst $ (remocollatz x)) + 1
collatzPairs :: Integral a => a -> [(a, Int)]
collatzPairs n = zip [1..n] (collatzLength <$> [1..n])
longestCollatz :: Integral a => a -> (a, Int)
longestCollatz n = maximumBy order $ collatzPairs n
where
order :: Ord b => (a, b) -> (a, b) -> Ordering
order x y = snd x `compare` snd y
main :: IO ()
main = print $ longestCollatz size
With ghc -O2 it takes about 17 seconds, without ghc -O2 -- about 22 seconds to deliver the length and the seed of the longest Collatz sequence starting at any point below size.
Now, if I make these changes:
diff --git a/Main.hs b/Main.hs
index c78ad95..9607fe0 100644
--- a/Main.hs
+++ b/Main.hs
## -1,6 +1,7 ##
module Main where
import Data.Function
+import qualified Data.Map.Lazy as M
import Data.List (maximumBy)
size :: (Integral a) => a
## -22,10 +23,15 ## recollatz = fix $ \f x -> if (x /= 1)
mocollatz :: Integral b => b -> ([b], b)
mocollatz n = ([n], collatz n)
-remocollatz :: Integral a => a -> ([a], a)
-remocollatz = fix $ \f x -> if x /= 1
- then f =<< mocollatz x
- else return x
+remocollatz :: (Num a, Integral b) => b -> ([b], a)
+remocollatz 1 = return 1
+remocollatz x = case M.lookup x (table mutate) of
+ Nothing -> mutate x
+ Just y -> y
+ where mutate x = remocollatz =<< mocollatz x
+
+table :: (Ord a, Integral a) => (a -> b) -> M.Map a b
+table f = M.fromList [ (x, f x) | x <- [1..size] ]
-- Trivialities.
-- Then it will take just about 4 seconds with ghc -O2, but I would not live long enough to see it complete without ghc -O2.
Looking at the details of cost centres with ghc -prof -fprof-auto -O2 reveals that the first version enters collatz about a hundred million times, while the patched one -- just about one and a half million times. This must be the reason of the speedup, but I have a hard time understanding the inner workings of this magic. My best idea is that we replace a portion of expensive recursive calls with O(log n) map lookups, but I don't know if it's true and why it depends so much on some godforsaken compiler flags, while, as I see it, such performance swings should all follow solely from the language.
Can I haz an explanation of what happens here, and why the performance differs so vastly between ghc -O2 and plain ghc builds?
P.S. There are two requirements to the achieving of automagical memoization highlighted elsewhere on Stack Overflow:
Make a function to be memoized a top-level name.
Make a function to be memoized a monomorphic one.
In line with these requirements, I rebuilt remocollatz as follows:
remocollatz :: Int -> ([Int], Int)
remocollatz 1 = return 1
remocollatz x = mutate x
mutate :: Int -> ([Int], Int)
mutate x = remocollatz =<< mocollatz x
Now it's as top level and as monomorphic as it gets. Running time is about 11 seconds, versus the similarly monomorphized table version:
remocollatz :: Int -> ([Int], Int)
remocollatz 1 = return 1
remocollatz x = case M.lookup x (table mutate) of
Nothing -> mutate x
Just y -> y
mutate :: Int -> ([Int], Int)
mutate = \x -> remocollatz =<< mocollatz x
table :: (Int -> ([Int], Int)) -> M.Map Int ([Int], Int)
table f = M.fromList [ (x, f x) | x <- [1..size] ]
-- Running in less than 4 seconds.
I wonder why the memoization ghc is supposedly performing in the first case here is almost 3 times slower than my dumb table.
Can I haz an explanation of what happens here, and why the performance differs so vastly between ghc -O2 and plain ghc builds?
Disclaimer: this is a guess, not verified by viewing GHC core output. A careful answer would do so to verify the conjectures outlined below. You can try peering through it yourself: add -ddump-simpl to your compilation line and you will get copious output detailing exactly what GHC has done to your code.
You write:
remocollatz x = {- ... -} table mutate {- ... -}
where mutate x = remocollatz =<< mocollatz x
The expression table mutate in fact does not depend on x; but it appears on the right-hand side of an equation that takes x as an argument. Consequently, without optimizations, this table is recomputed each time remocollatz is called (presumably even from inside the computation of table mutate).
With optimizations, GHC notices that table mutate does not depend on x, and floats it to its own definition, effectively producing:
fresh_variable_name = table mutate
where mutate x = remocollatz =<< mocollatz x
remocollatz x = case M.lookup x fresh_variable_name of
{- ... -}
The table is therefore computed just once for the entire program run.
don't know why it [the performance] depends so much on some godforsaken compiler flags, while, as I see it, such performance swings should all follow solely from the language.
Sorry, but Haskell doesn't work that way. The language definition tells clearly what the meaning of a given Haskell term is, but does not say anything about the runtime or memory performance needed to compute that meaning.
Another approach to memoization that works in some situations, like this one, is to use a boxed vector, whose elements are computed lazily. The function used to initialize each element can use other elements of the vector in its calculation. As long as the evaluation of an element of the vector doesn't loop and refer to itself, just the elements it recursively depends on will be evaluated. Once evaluated, an element is effectively memoized, and this has the further benefit that elements of the vector that are never referenced are never evaluated.
The Collatz sequence is a nearly ideal application for this technique, but there is one complication. The next Collatz value(s) in sequence from a value under the limit may be outside the limit, which would cause a range error when indexing the vector. I solved this by just iterating through the sequence until back under the limit and counting the steps to do so.
The following program takes 0.77 seconds to run unoptimized and 0.30 when optimized:
import qualified Data.Vector as V
limit = 10 ^ 6 :: Int
-- The Collatz function, which given a value returns the next in the sequence.
nextCollatz val
| odd val = 3 * val + 1
| otherwise = val `div` 2
-- Given a value, return the next Collatz value in the sequence that is less
-- than the limit and the number of steps to get there. For example, the
-- sequence starting at 13 is: [13, 40, 20, 10, 5, 16, 8, 4, 2, 1], so if
-- limit is 100, then (nextCollatzWithinLimit 13) is (40, 1), but if limit is
-- 15, then (nextCollatzWithinLimit 13) is (10, 3).
nextCollatzWithinLimit val = (firstInRange, stepsToFirstInRange)
where
firstInRange = head rest
stepsToFirstInRange = 1 + (length biggerThanLimit)
(biggerThanLimit, rest) = span (>= limit) (tail collatzSeqStartingWithVal)
collatzSeqStartingWithVal = iterate nextCollatz val
-- A boxed vector holding Collatz length for each index. The collatzFn used
-- to generate the value for each element refers back to other elements of
-- this vector, but since the vector elements are only evaluated as needed and
-- there aren't any loops in the Collatz sequences, the values are calculated
-- only as needed.
collatzVec :: V.Vector Int
collatzVec = V.generate limit collatzFn
where
collatzFn :: Int -> Int
collatzFn index
| index <= 1 = 1
| otherwise = (collatzVec V.! nextWithinLimit) + stepsToGetThere
where
(nextWithinLimit, stepsToGetThere) = nextCollatzWithinLimit index
main :: IO ()
main = do
-- Use a fold through the vector to find the longest Collatz sequence under
-- the limit, and keep track of both the maximum length and the initial
-- value of the sequence, which is the index.
let (maxLength, maxIndex) = V.ifoldl' accMaxLen (0, 0) collatzVec
accMaxLen acc#(accMaxLen, accMaxIndex) index currLen
| currLen <= accMaxLen = acc
| otherwise = (currLen, index)
putStrLn $ "Max Collatz length below " ++ show limit ++ " is "
++ show maxLength ++ " at index " ++ show maxIndex
I am trying to implement a bubble sort over any traversable container using the Tardis monad.
{-# LANGUAGE TupleSections #-}
module Main where
import Control.DeepSeq
import Control.Monad.Tardis
import Data.Bifunctor
import Data.Traversable
import Data.Tuple
import Debug.Trace
newtype Finished = Finished { isFinished :: Bool }
instance Monoid Finished where
mempty = Finished False
mappend (Finished a) (Finished b) = Finished (a || b)
-- | A single iteration of bubble sort over a list.
-- If the list is unmodified, return 'Finished' 'True', else 'False'
bubble :: Ord a => [a] -> (Finished, [a])
bubble (x:y:xs)
| x <= y = bimap id (x:) (bubble (y:xs))
| x > y = bimap (const $ Finished False) (y:) (bubble (x:xs))
bubble as = (Finished True, as)
-- | A single iteration of bubble sort over a 'Traversable'.
-- If the list is unmodified, return 'Finished' 'True', else 'Finished' 'False'
bubbleTraversable :: (Traversable t, Ord a, NFData a, Show a) => t a -> (Finished, t a)
bubbleTraversable t = extract $ flip runTardis (initFuture, initPast) $ forM t $ \here -> do
sendPast (Just here)
(mp, finished) <- getPast
-- For the first element use the first element,
-- else the biggest of the preceding.
let this = case mp of { Nothing -> here; Just a -> a }
mf <- force <$> getFuture -- Tardis uses lazy pattern matching,
-- so force has no effect here, I guess.
traceM "1"
traceShowM mf -- Here the program enters an infinite loop.
traceM "2"
case mf of
Nothing -> do
-- If this is the last element, there is nothing to do.
return this
Just next -> do
if this <= next
-- Store the smaller element here
-- and give the bigger into the future.
then do
sendFuture (Just next, finished)
return this
else do
sendFuture (Just this, Finished False)
return next
where
extract :: (Traversable t) => (t a, (Maybe a, (Maybe a, Finished))) -> (Finished, t a)
extract = swap . (snd . snd <$>)
initPast = (Nothing, Finished True)
initFuture = Nothing
-- | Sort a list using bubble sort.
sort :: Ord a => [a] -> [a]
sort = snd . head . dropWhile (not . isFinished . fst) . iterate (bubble =<<) . (Finished False,)
-- | Sort a 'Traversable' using bubble sort.
sortTraversable :: (Traversable t, Ord a, NFData a, Show a) => t a -> t a
sortTraversable = snd . head . dropWhile (not . isFinished . fst) . iterate (bubbleTraversable =<<) . (Finished False,)
main :: IO ()
main = do
print $ sort ([1,4,2,5,2,5,7,3,2] :: [Int]) -- works like a charm
print $ sortTraversable ([1,4,2,5,2,5,7,3,2] :: [Int]) -- breaks
The main difference between bubble and bubbleTraversable is the handling of the Finished flag: In bubble we assume that the right-most element is already sorted and change the flag, if the elements to the left of it aren't; in bubbleTraversable we do it the other way around.
While trying to evaluate mf in bubbleTraversablethe program enters an infinite loop in the lazy references as evidenced by the ghc output <<loop>>.
The problem is probably, that forM tries to evaluate the elements successively, before the monadic chaining takes place (especially since forM is flip traverse for lists). Is there any way to rescue this implementation?
First of all, style-wise, Finished = Data.Monoid.Any (but you only use the Monoid bit for (bubble =<<) when it may as well be bubble . snd, so I just dropped it for Bool), head . dropWhile (not . isFinished . fst) = fromJust . find (isFinished . fst), case x of { Nothing -> default; Just t = f t } = maybe default f x, and maybe default id = fromMaybe default.
Second, your assumption that force does nothing in Tardis is wrong. Thunks don't "remember" they were created in a lazy-pattern match. force itself does nothing, but when the thunk it produces is evaluated, it causes the thunk it was given to be evaluated to NF, no exceptions. In your case, that case mf of ... evaluates mf to normal form (instead of just WHNF) because mf has force in it. I don't believe it's causing any problems here, though.
The real problem is that you are "deciding what to do" depending on a future value. This means you are matching on a future value, and then you are using that future value to produce a Tardis computation that gets (>>=)'d into the one that produces that value. This is a no-no. If it's any clearer: runTardis (do { x <- getFuture; x `seq` return () }) ((),()) = _|_ but runTardis (do { x <- getFuture; return $ x `seq` () }) ((),()) = ((),((),())). You are allowed to use a future value to create a pure value, but you cannot use it to decide the Tardis you will run. In your code, this is when you try case mf of { Nothing -> do ...; Just x -> do ... }.
This also means that traceShowM is causing an issue all by itself, as printing something in IO evaluates it deeply (traceShowM is approximately unsafePerformIO . (return () <$) . print). mf needs to be evaluated as the unsafePerformIO is executing, but mf depends on evaluating the Tardis operations that come after the traceShowM, but traceShowM forces the print to be done before it allows the next Tardis operation (return ()) to be revealed. <<loop>>!
Here's the fixed version:
{-# LANGUAGE TupleSections #-}
module Main where
import Control.Monad
import Control.Monad.Tardis
import Data.Bifunctor
import Data.Tuple
import Data.List hiding (sort)
import Data.Maybe
-- | A single iteration of bubble sort over a list.
-- If the list is unmodified, return 'True', else 'False'
bubble :: Ord a => [a] -> (Bool, [a])
bubble (x:y:xs)
| x <= y = bimap id (x:) (bubble (y:xs))
| x > y = bimap (const False) (y:) (bubble (x:xs))
bubble as = (True, as)
-- | A single iteration of bubble sort over a 'Traversable'.
-- If the list is unmodified, return 'True', else 'False'
bubbleTraversable :: (Traversable t, Ord a) => t a -> (Bool, t a)
bubbleTraversable t = extract $ flip runTardis init $ forM t $ \here -> do
-- Give the current element to the past so it will have sent us biggest element
-- so far seen.
sendPast (Just here)
(mp, finished) <- getPast
let this = fromMaybe here mp
-- Given this element in the present and that element from the future,
-- swap them if needed.
-- force is fine here
mf <- getFuture
let (this', that', finished') = fromMaybe (this, mf, finished) $ do
that <- mf
guard $ that < this
return (that, Just this, False)
-- Send the bigger element back to the future
-- Can't use mf to decide whether or not you sendFuture, but you can use it
-- to decide WHAT you sendFuture.
sendFuture (that', finished')
-- Replace the element at this location with the one that belongs here
return this'
where
-- No need to be clever
extract (a, (_, (_, b))) = (b, a)
init = (Nothing, (Nothing, True))
-- | Sort a list using bubble sort.
sort :: Ord a => [a] -> [a]
sort = snd . fromJust . find fst . iterate (bubble . snd) . (False,)
-- | Sort a 'Traversable' using bubble sort.
sortTraversable :: (Traversable t, Ord a) => t a -> t a
sortTraversable = snd . fromJust . find fst . iterate (bubbleTraversable . snd) . (False,)
main :: IO ()
main = do
print $ sort ([1,4,2,5,2,5,7,3,2] :: [Int]) -- works like a charm
print $ sortTraversable ([1,4,2,5,2,5,7,3,2] :: [Int]) -- works like a polymorphic charm
-- Demonstration that force does work in Tardis
checkForce = fst $ sortTraversable [(1, ""), (2, undefined)] !! 1
-- checkForce = 2 if there is no force
-- checkForce = _|_ if there is a force
If you still want to trace mf, you can mf <- traceShowId <$> getFuture, but you may not get any well-defined order to the messages (don't expect time to make sense inside a Tardis!), though in this case it seems to just print the tails of the lists backwards.
I've been trying to learn about static analysis of applicative functors. Many sources say that an advantage of using them over monads is the susceptibility to static analysis.
However, the only example I can find of actually performing static analysis is too complicated for me to understand. Are there any simpler examples of this?
Specifically, I want to know if I can performing static analysis on recursive applications. For example, something like:
y = f <$> x <*> y <*> z
When analyzing the above code, is it possible to detect that it is recursive on y? Or does referential transparency still prevent this from being possible?
Applicative functors allow static analysis at runtime. This is better explained by a simpler example.
Imagine you want to calculate a value, but want to track what dependencies that value has. Eg you may use IO a to calculate the value, and have a list of Strings for the dependencies:
data Input a = Input { dependencies :: [String], runInput :: IO a }
Now we can easily make this an instance of Functor and Applicative. The functor instance is trivial. As it doesn't introduce any new dependencies, you just need to map over the runInput value:
instance Functor (Input) where
fmap f (Input deps runInput) = Input deps (fmap f runInput)
The Applicative instance is more complicated. the pure function will just return a value with no dependencies. The <*> combiner will concat the two list of dependencies (removing duplicates), and combine the two actions:
instance Applicative Input where
pure = Input [] . return
(Input deps1 getF) <*> (Input deps2 runInput) = Input (nub $ deps1 ++ deps2) (getF <*> runInput)
With that, we can also make an Input a an instance of Num if Num a:
instance (Num a) => Num (Input a) where
(+) = liftA2 (+)
(*) = liftA2 (*)
abs = liftA abs
signum = liftA signum
fromInteger = pure . fromInteger
Nexts, lets make a couple of Inputs:
getTime :: Input UTCTime
getTime = Input { dependencies = ["Time"], runInput = getCurrentTime }
-- | Ideally this would fetch it from somewhere
stockPriceOf :: String -> Input Double
stockPriceOf stock = Input { dependencies = ["Stock ( " ++ stock ++ " )"], runInput = action } where
action = case stock of
"Apple" -> return 500
"Toyota" -> return 20
Finally, lets make a value that uses some inputs:
portfolioValue :: Input Double
portfolioValue = stockPriceOf "Apple" * 10 + stockPriceOf "Toyota" * 20
This is a pretty cool value. Firstly, we can find the dependencies of portfolioValue as a pure value:
> :t dependencies portfolioValue
dependencies portfolioValue :: [String]
> dependencies portfolioValue
["Stock ( Apple )","Stock ( Toyota )"]
That is the static analysis that Applicative allows - we know the dependencies without having to execute the action.
We can still get the value of the action though:
> runInput portfolioValue >>= print
5400.0
Now, why can't we do the same with Monad? The reason is Monad can express choice, in that one action can determine what the next action will be.
Imagine there was a Monad interface for Input, and you had the following code:
mostPopularStock :: Input String
mostPopularStock = Input { dependencies ["Popular Stock"], getInput = readFromWebMostPopularStock }
newPortfolio = do
stock <- mostPopularStock
stockPriceOf "Apple" * 40 + stockPriceOf stock * 10
Now, how can we calculate the dependencies of newPortolio? It turns out we can't do it without using IO! It will depend on the most popular stock, and the only way to know is to run the IO action. Therefore it isn't possible to statically track dependencies when the type uses Monad, but completely possible with just Applicative. This is a good example of why often less power means more useful - as Applicative doesn't allow choice, dependencies can be calculated statically.
Edit: With regards to the checking if y is recursive on itself, such a check is possible with applicative functors if you are willing to annotate your function names.
data TrackedComp a = TrackedComp { deps :: [String], recursive :: Bool, run :: a}
instance (Show a) => Show (TrackedComp a) where
show comp = "TrackedComp " ++ show (run comp)
instance Functor (TrackedComp) where
fmap f (TrackedComp deps rec1 run) = TrackedComp deps rec1 (f run)
instance Applicative TrackedComp where
pure = TrackedComp [] False
(TrackedComp deps1 rec1 getF) <*> (TrackedComp deps2 rec2 value) =
TrackedComp (combine deps1 deps2) (rec1 || rec2) (getF value)
-- | combine [1,1,1] [2,2,2] = [1,2,1,2,1,2]
combine :: [a] -> [a] -> [a]
combine x [] = x
combine [] y = y
combine (x:xs) (y:ys) = x : y : combine xs ys
instance (Num a) => Num (TrackedComp a) where
(+) = liftA2 (+)
(*) = liftA2 (*)
abs = liftA abs
signum = liftA signum
fromInteger = pure . fromInteger
newComp :: String -> TrackedComp a -> TrackedComp a
newComp name tracked = TrackedComp (name : deps tracked) isRecursive (run tracked) where
isRecursive = (name `elem` deps tracked) || recursive tracked
y :: TrackedComp [Int]
y = newComp "y" $ liftA2 (:) x z
x :: TrackedComp Int
x = newComp "x" $ 38
z :: TrackedComp [Int]
z = newComp "z" $ liftA2 (:) 3 y
> recursive x
False
> recursive y
True
> take 10 $ run y
[38,3,38,3,38,3,38,3,38,3]
Yes, applicative functors allow more analysis than monads. But no, you can't observe the recursion. I've written a paper about parsing which explains the problem in detail:
https://lirias.kuleuven.be/bitstream/123456789/352570/1/gc-jfp.pdf
The paper then discusses an alternative encoding of recursion which does allow analysis and has some other advantages and some downsides. Other related work is:
https://lirias.kuleuven.be/bitstream/123456789/376843/1/p97-devriese.pdf
And more related work can be found in the related work sections of those papers...
I am using enumerator-0.4.10, and I need to distribute processing of
different parts of the incoming stream to different iteratees (I am
parsing a huge XML file, and different sub-trees have different
processing logic). Only a single iteratee will be active at a time
since the sub-trees don't intersect.
I wrote a simple example that filters the stream and passes the result
to one iteratee; please see below. However, with multiple nested
iteratees it seems to me that I can no longer use an enumeratee. Do I
need to write my own multi-enumeratee that holds multiple inner
iteratees? Any better ideas?
Here is my (beginner's) code for a single nested iteratee:
module Main ( main ) where
import qualified Data.Enumerator as E ( Enumeratee, Step(..), Stream(..),
checkDone, checkDoneEx, continue, enumList, joinI, run_, yield )
import Data.Enumerator ( ($$), (>>==) )
import qualified Data.Enumerator.List as EL ( consume )
-- cribbed from EL.concatMap
concatMapAccum :: Monad m => (s -> ao -> (s, [ai])) -> s ->
E.Enumeratee ao ai m b
concatMapAccum f s0 = E.checkDone (E.continue . step s0)
where
step _ k E.EOF = E.yield (E.Continue k) E.EOF
step s k (E.Chunks xs) = loop s k xs
loop s k [] = E.continue (step s k)
loop s k (x:xs) = case f s x of
(s', ais) -> k (E.Chunks $ ais) >>==
E.checkDoneEx (E.Chunks xs) (\k' -> loop s' k' xs)
passFromTo :: Monad m => ((a -> Bool), (a -> Bool)) -> Bool -> E.Enumeratee a a m b
passFromTo (from, to) pass0 =
concatMapAccum updatePass pass0
where
updatePass pass el = case (pass, from el, to el) of
(True, _, to_el) -> (not to_el, [el])
(False, True, _) -> (True, [el])
(False, False, _) -> (False, [])
main :: IO()
main = do
E.run_ (E.enumList 3 [1..20] $$
E.joinI $ passFromTo ((\e -> e == 3 || e == 13), (\e -> e == 7 || e == 17)) False $$
EL.consume) >>= print
$ ./dist/build/StatefulEnumeratee/StatefulEnumeratee
[3,4,5,6,7,13,14,15,16,17]
Yes, you need an enumeratee that passes the stream to multiple iteratees, like Data.Iteratee.sequence_ and Data.Iteratee.Parallel.psequence_ from iteratee-0.8.6. sequence_ takes a list of iteratees to run simultaneously, and handles each input chunk by mapM across that list. psequence_ takes similar arguments, but runs each input iteratee in a separate forkIO thread.
There has been some discussion on haskell-cafe and the iteratee mailing lists about these over the past year, eg: http://www.haskell.org/pipermail/haskell-cafe/2011-January/088319.html The main thing to be careful about is handling errors from the inner iteratees: in your application, if one inner iteratee fails do you want to terminate all iteratees or just that one, and [how] do you want to propagate those errors.