[Haskell-beginners] Exercise of "Programming with Arrows"

Thiago Negri evohunz
Thu Oct 10 17:10:50 UTC 2013


And now I'm stuck trying to create an instance of ArrowLoop for the stream
processor. :(

My first implementation used a queue, just like the "first" function of my
Arrow instance. It worked like a charm, but failed in the test proposed by
the paper:

"""
- Check that your implementation of loop has the property that the arrows
loop (arr id) and loop (arr swap) behave as arr id:

SP> runSP (loop (arr id)) [1..10]
[1,2,3,4,5,6,7,8,9,10]

SP> runSP (loop (arr swap)) [1..10]
[1,2,3,4,5,6,7,8,9,10]
"""

The first test was ok, but the "runSP (loop (arr swap)) [1..10]" tried to
consume a value from my empty feedback queue and it exploded.

I scrolled back to section 2.3 to see how Hughes did this neat trick to his
SF type and it kind of made sense to me. But I can't express that same
"irrefutable pattern magic" on the SP data type. As the result of consuming
an element of the stream is dynamic (it's like a monad bind), I can't find
a way to declare fit the expression of the feedback stream in terms of
itself, I keep hitting recursion at some point.

I don't even know if I can explain what I'm feeling about what my problem
is. Yet I can't find a way to solve the problem.

Can someone help me?
Please, don't solve it for me, just give some tips.

My current code is here:
https://gist.github.com/thiago-negri/2e541a9f9762c727bdd4
The problematic ArrowLoop instance is at line 45.

Thanks,
Thiago.



2013/10/8 Thiago Negri <evohunz at gmail.com>

> 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/20131010/3ca1d812/attachment-0001.html>



More information about the Beginners mailing list