[Haskell-beginners] Exercise of "Programming with Arrows"
Thiago Negri
evohunz
Tue Oct 8 15:43:04 UTC 2013
I think I'm starting to get the "way of arrows".
My implementation was incorrect. I've seen it with the hand made test
listed below [1].
The output of "first arrA" and "first arrB" should be joined together and
form a new stream with the length of the shortest output of both ("arrA ***
arrB"), and this wasn't happening.
I've found package "streamproc" at Hackage and that gave me some insights.
Yet I think "streamproc" is also wrong, as it does not buffer the second
stream.
You can check it at line 58 of SP.hs [3] that it ignores the first element
of the pair.
But I didn't write a test to check what is the implication of this, I'll
try to do this as a next step into understanding arrows.
That exercise really helped me!
My new implementation, wich I think is correct now, is listed below [2].
Thanks!
Thiago
[1]:
inputA :: [String]
inputA = ["a", "b", "hello", "c", "d", "e", "hello", "f", "g", "e", "x"]
arrA :: SP String String
arrA = Get (\a -> if a == "hello" then (Put a (Put "world" arrA))
else (Put "unknown" arrA))
arrB :: SP String String
arrB = Get (\a -> if a == "my" then (Get (\a -> if a == "name" then (Get
(\a -> if a == "is" then Get (\a -> Put ("name: " ++ a) arrB)
else arrB))
else arrB))
else arrB)
inputB :: [String]
inputB = ["a", "b", "my", "name", "is", "thiago", "and", "I", "am", "so",
"cool"]
inputAB :: [(String, String)]
inputAB = zip inputA inputB
main :: IO ()
main = let actualOutputB = runSP arrB inputB
actualOutputB1 = runSP (first arrB) (zip inputB (repeat "a"))
actualOutputA = runSP arrA inputA
actualOutputA1 = runSP (first arrA) (zip inputA (repeat "a"))
actualOutputAB = runSP (arrA *** arrB) inputAB
in do putStrLn $ "inputAB: " ++ show inputAB
putStrLn $ "outputA: " ++ show actualOutputA
putStrLn $ "outputA1: " ++ show actualOutputA1
putStrLn $ "outputB: " ++ show actualOutputB
putStrLn $ "outputB1: " ++ show actualOutputB1
putStrLn $ "outputAB: " ++ show actualOutputAB
[2]:
module SP where
import Prelude hiding (id, (.))
import Control.Category
import Control.Arrow
import Test.QuickCheck
data SP a b = Put b (SP a b) | Get (a -> SP a b)
runSP :: SP a b -> [a] -> [b]
runSP (Put b s) as = b:runSP s as
runSP (Get k) (a:as) = runSP (k a) as
runSP (Get k) [] = []
compose :: SP b c -> SP a b -> SP a c
compose (Put a s) g = Put a (compose s g)
compose (Get k) (Put a s) = compose (k a) s
compose f (Get k) = Get (\a -> compose f (k a))
instance Category SP where
id = arr id
(.) = compose
instance Arrow SP where
arr f = Get (\a -> Put (f a) (arr f))
first = queued empty empty
queued :: Queue a -> Queue c -> SP a b -> SP (a, c) (b, c)
queued qa qc (Put a s) = case pop qc of Nothing -> Get (\(a', c) -> Put (a,
c) (queued (push a' qa) qc s))
Just (c, qc') -> Put (a, c) (queued
qa qc' s)
queued qa qc (Get k) = case pop qa of Nothing -> Get (\(a, c) -> queued qa
(push c qc) (k a))
Just (a, qa') -> queued qa' qc (k a)
data Queue a = Queue [a]
empty :: Queue a
empty = Queue []
push :: a -> Queue a -> Queue a
push a (Queue as) = Queue (a:as)
pop :: Queue a -> Maybe (a, Queue a)
pop (Queue []) = Nothing
pop (Queue (a:as)) = Just (a, Queue as)
delayed :: (a, c) -> SP a b -> SP (a, c) (b, c)
delayed (a, c) (Put b s) = Put (b, c) (delayed (a, c) s)
delayed (a, c) (Get k) = firstWithValue (k a) c
firstWithValue :: SP a b -> c -> SP (a, c) (b, c)
firstWithValue (Put a s) c = Put (a, c) (firstWithValue s c)
firstWithValue (Get k) _ = Get (\(a, c) -> firstWithValue (k a) c)
input :: [(String, String)]
input = [("a1", "a2"), ("b1", "b2"), ("c1", "c2"), ("d1", "d2")]
myArrow :: SP (String, String) (String, String)
myArrow = (delay "db1" >>> delay "da1") *** (delay "db2" >>> delay "da2")
delay :: a -> SP a a
delay b = Put b (arr id)
inputA :: [String]
inputA = ["a", "b", "hello", "c", "d", "e", "hello", "f", "g", "e", "x"]
arrA :: SP String String
arrA = Get (\a -> if a == "hello" then (Put a (Put "world" arrA))
else (Put "unknown" arrA))
arrB :: SP String String
arrB = Get (\a -> if a == "my" then (Get (\a -> if a == "name" then (Get
(\a -> if a == "is" then Get (\a -> Put ("name: " ++ a) arrB)
else arrB))
else arrB))
else arrB)
inputB :: [String]
inputB = ["a", "b", "my", "name", "is", "thiago", "and", "I", "am", "so",
"cool"]
inputAB :: [(String, String)]
inputAB = zip inputA inputB
main :: IO ()
main = let actualOutputB = runSP arrB inputB
actualOutputB1 = runSP (first arrB) (zip inputB (repeat "a"))
actualOutputA = runSP arrA inputA
actualOutputA1 = runSP (first arrA) (zip inputA (repeat "a"))
actualOutputAB = runSP (arrA *** arrB) inputAB
in do putStrLn $ "inputAB: " ++ show inputAB
putStrLn $ "outputA: " ++ show actualOutputA
putStrLn $ "outputA1: " ++ show actualOutputA1
putStrLn $ "outputB: " ++ show actualOutputB
putStrLn $ "outputB1: " ++ show actualOutputB1
putStrLn $ "outputAB: " ++ show actualOutputAB
[3]: https://github.com/peti/streamproc/blob/master/Control/Arrow/SP.hs#L58
2013/10/7 Thiago Negri <evohunz at gmail.com>
> This is my first contact with QuickCheck, but does this test count as a
> proof that my implementation is correct?
>
> QuickCheck shows 100 tests passed.
>
> prop_a xs = runSP (f *** g) xs == runSP (first f >>> swap >>> first g >>>
> swap) xs
> where swap = arr (\(a,b) -> (b,a))
> f = arr (++"a")
> g = arr (++"b")
>
>
>
> 2013/10/7 Thiago Negri <evohunz at gmail.com>
>
>> "On the one hand, indeterminate a's need to be fed in before
>> indeterminate b's get pulled out. On the other hand, the c's need to behave
>> as if they were in a no-op assembly line. One c goes in, the one (and
>> same!) c drops out."
>>
>> I agree with "no-op assembly line", but when I'm using `first` on a
>> processor, I want to process the first stream *only*. The second stream
>> should remain as it was not touched, so future processors will receive the
>> same sequence from the second stream.
>>
>> I mean, I think I need to guarantee that this definition holds:
>>
>> `g *** f` is the same as `first g >>> swap >>> first f >>> swap`
>>
>> If my implementation of `first` uses a real no-op assembly line for `c`
>> (i.e., `arr id`), then I would lose the stream. As you said, I need to
>> buffer the second stream while processing the first one.
>>
>> Is my line of tought correct?
>>
>> I'll try to write some tests to verify this.
>>
>> Thanks!
>>
>>
>> 2013/10/7 Kim-Ee Yeoh <ky3 at atamo.com>
>>
>>> Hey Thiago,
>>>
>>> First of all, congratulations for reading Hughes! Many of his papers are
>>> worth reading and re-reading for both beginners and experts alike.
>>>
>>>
>>> On Tue, Oct 8, 2013 at 12:05 AM, Thiago Negri <evohunz at gmail.com> wrote:
>>>
>>>> Exercise 2 (section 2.5) is asking to create a Stream Processor that
>>>> can map more than one output per input (e.g. 3 outcomes for a single
>>>> consume of the stream).
>>>
>>>
>>> Given
>>>
>>>
>>> > data SP a b = Put b (SP a b) | Get (a -> SP a b)
>>>
>>> it's easy to see that it's not just about more than one output per
>>> input. It's about n pieces of input producing m pieces of output, where
>>> (n,m) may even -- and probably does -- depend on previous inputs!
>>>
>>> The exercise asks for an implementation of the following Arrow instance:
>>>
>>> > first :: arr a b -> arr (a,c) (b,c)
>>>
>>> which, specialized to our case, is just SP a b -> SP (a,c) (b,c).
>>>
>>> It should now be apparent what the 'trickiness' is. On the one hand,
>>> indeterminate a's need to be fed in before indeterminate b's get pulled
>>> out. On the other hand, the c's need to behave as if they were in a no-op
>>> assembly line. One c goes in, the one (and same!) c drops out.
>>>
>>> So one way to look at this is as a buffering problem.
>>>
>>> At this point, I'd encourage you to think of some quickcheck tests you
>>> can write to convince yourself whether you have a right implementation or
>>> not.
>>>
>>> Your main function doesn't seem adequate for the task.
>>>
>>> -- Kim-Ee
>>>
>>> _______________________________________________
>>> Beginners mailing list
>>> Beginners at haskell.org
>>> http://www.haskell.org/mailman/listinfo/beginners
>>>
>>>
>>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/beginners/attachments/20131008/a6fb6264/attachment.html>
More information about the Beginners
mailing list