[Haskell-beginners] Beginners Digest, Vol 53, Issue 7

Patrick Lynch kmandpjlynch at verizon.net
Tue Nov 6 16:19:08 CET 2012


Can anyone recommend a way of using Haskell on the web?

----- Original Message ----- 
From: <beginners-request at haskell.org>
To: <beginners at haskell.org>
Sent: Monday, November 05, 2012 4:27 PM
Subject: Beginners Digest, Vol 53, Issue 7


> Send Beginners mailing list submissions to
> beginners at haskell.org
>
> To subscribe or unsubscribe via the World Wide Web, visit
> http://www.haskell.org/mailman/listinfo/beginners
> or, via email, send a message with subject or body 'help' to
> beginners-request at haskell.org
>
> You can reach the person managing the list at
> beginners-owner at haskell.org
>
> When replying, please edit your Subject line so it is more specific
> than "Re: Contents of Beginners digest..."
>
>
> Today's Topics:
>
>   1.  Double usage of a wire (arrow) (Nathan H?sken)
>   2.  Trying to write netwire combiner similar to multicast
>      (Nathan H?sken)
>   3. Re:  Double usage of a wire (arrow) (Ertugrul S?ylemez)
>   4. Re:  Trying to write netwire combiner similar to multicast
>      (Ertugrul S?ylemez)
>   5. Re:  Trying to write netwire combiner similar to multicast
>      (Nathan H?sken)
>   6.  Missing termination rule for recursive function (Oscar Benjamin)
>   7. Re:  Missing termination rule for recursive function
>      (Daniel Fischer)
>   8. Re:  Missing termination rule for recursive function
>      (Jay Sulzberger)
>
>
> ----------------------------------------------------------------------
>
> Message: 1
> Date: Mon, 05 Nov 2012 15:12:00 +0100
> From: Nathan H?sken <nathan.huesken at posteo.de>
> Subject: [Haskell-beginners] Double usage of a wire (arrow)
> To: beginners at haskell.org
> Message-ID: <5097C930.605 at posteo.de>
> Content-Type: text/plain; charset=ISO-8859-1
>
> Hey,
>
> If I double use an arrow (in this example a wire from netwire) like this:
>
> objectWire :: WireP [Collision] Object
> objectWire = (Object <$> integral_ initPos) . speedWire <*> speedWire
>
> will it be double evaluated, or can the compiler optimize this to
> evaluate speedWire only once?
>
> Thanks!
> Nathan
>
>
>
> ------------------------------
>
> Message: 2
> Date: Mon, 05 Nov 2012 17:04:51 +0100
> From: Nathan H?sken <nathan.huesken at posteo.de>
> Subject: [Haskell-beginners] Trying to write netwire combiner similar
> to multicast
> To: beginners at haskell.org
> Message-ID: <5097E3A3.5060208 at posteo.de>
> Content-Type: text/plain; charset=ISO-8859-1
>
> Hey,
>
> I am trying to write a netwire combiner similar to multicast. The only
> difference is that when one of the wires inihibts, I want to remove it
> from the list.
>
> So this is my attempt:
>
> manager :: (Monad m) => [Wire e m a b] -> Wire e m [a] [b]
> manager ws' = mkGen $ \dt xs' -> do
>            res <- mapM (\(w,x) -> stepWire w dt x) $ zip ws' xs'
>            let filt (Left a, b) = Just (a, b)
>                filt _           = Nothing
>                resx = mapMaybe filt res
>            return (Left $ (fmap fst) resx,manager (fmap snd resx))
>
> ghc gives this compiler error:
>
> BreakoutImproved.hs:90:62:
>    Couldn't match type `e' with `[e]'
>      `e' is a rigid type variable bound by
>          the type signature for
>            manager :: Monad m => [Wire e m a b] -> Wire e m [a] [b]
>          at BreakoutImproved.hs:85:1
>    Expected type: [(e, Wire [e] m a b)]
>      Actual type: [(e, Wire e m a b)]
>    In the second argument of `fmap', namely `resx'
>    In the first argument of `manager', namely `(fmap snd resx)'
>
> Now this, I do not get.
> Why does manager expect an argument of type [(e, Wire [e] m a b)].
> The type signature clearly says [(e, Wire e m a b)] (which is what it is
> getting).
>
> Thanks!
> Nathan
>
>
>
> ------------------------------
>
> Message: 3
> Date: Mon, 5 Nov 2012 17:22:48 +0100
> From: Ertugrul S?ylemez <es at ertes.de>
> Subject: Re: [Haskell-beginners] Double usage of a wire (arrow)
> To: beginners at haskell.org
> Message-ID: <20121105172248.11ea27da at tritium.streitmacht.eu>
> Content-Type: text/plain; charset="utf-8"
>
> Nathan H?sken <nathan.huesken at posteo.de> wrote:
>
>> If I double use an arrow (in this example a wire from netwire) like
>> this:
>>
>> objectWire :: WireP [Collision] Object
>> objectWire = (Object <$> integral_ initPos) . speedWire <*> speedWire
>>
>> will it be double evaluated, or can the compiler optimize this to
>> evaluate speedWire only once?
>
> It will be double-evaluated.  To prevent this you can use the Arrow
> interface:
>
>    proc x' -> do
>        x <- speedWire -< x'
>        {- ... use x ... -}
>
> However, in WireP it's guaranteed that you get the same result, so for
> code conciseness you can still have speedWire twice, if sacrificing some
> speed is not too big an issue.
>
>
> Greets,
> Ertugrul
>
> -- 
> Not to be or to be and (not to be or to be and (not to be or to be and
> (not to be or to be and ... that is the list monad.
> -------------- next part --------------
> A non-text attachment was scrubbed...
> Name: signature.asc
> Type: application/pgp-signature
> Size: 836 bytes
> Desc: not available
> URL: 
> <http://www.haskell.org/pipermail/beginners/attachments/20121105/018fec91/attachment-0001.pgp>
>
> ------------------------------
>
> Message: 4
> Date: Mon, 5 Nov 2012 17:29:49 +0100
> From: Ertugrul S?ylemez <es at ertes.de>
> Subject: Re: [Haskell-beginners] Trying to write netwire combiner
> similar to multicast
> To: beginners at haskell.org
> Message-ID: <20121105172949.2a8bc181 at tritium.streitmacht.eu>
> Content-Type: text/plain; charset="utf-8"
>
> Nathan H?sken <nathan.huesken at posteo.de> wrote:
>
>> I am trying to write a netwire combiner similar to multicast. The only
>> difference is that when one of the wires inihibts, I want to remove it
>> from the list.
>>
>> So this is my attempt:
>>
>> manager :: (Monad m) => [Wire e m a b] -> Wire e m [a] [b]
>> manager ws' = mkGen $ \dt xs' -> do
>>             res <- mapM (\(w,x) -> stepWire w dt x) $ zip ws' xs'
>>             let filt (Left a, b) = Just (a, b)
>>                 filt _           = Nothing
>>                 resx = mapMaybe filt res
>>             return (Left $ (fmap fst) resx,manager (fmap snd resx))
>
> Notice that Left means inhibition.  You seem to be filtering out
> produced results and trying to keep only the inhibition values, which of
> course does not make much sense and triggers the type error you are
> seeing.
>
> Also your interface seems very unsafe to me.  I suggest the following
> interface instead:
>
>    shrinking :: (Monad m) => [Wire e m a b] -> Wire e m a [b]
>
> Then normally 'a' could be something like Map K A.
>
>
> Greets,
> Ertugrul
>
> -- 
> Not to be or to be and (not to be or to be and (not to be or to be and
> (not to be or to be and ... that is the list monad.
> -------------- next part --------------
> A non-text attachment was scrubbed...
> Name: signature.asc
> Type: application/pgp-signature
> Size: 836 bytes
> Desc: not available
> URL: 
> <http://www.haskell.org/pipermail/beginners/attachments/20121105/35a4df3f/attachment-0001.pgp>
>
> ------------------------------
>
> Message: 5
> Date: Mon, 05 Nov 2012 18:05:24 +0100
> From: Nathan H?sken <nathan.huesken at posteo.de>
> Subject: Re: [Haskell-beginners] Trying to write netwire combiner
> similar to multicast
> To: beginners at haskell.org
> Message-ID: <5097F1D4.10109 at posteo.de>
> Content-Type: text/plain; charset=ISO-8859-1
>
> On 11/05/2012 05:29 PM, Ertugrul S?ylemez wrote:
>> Nathan H?sken <nathan.huesken at posteo.de> wrote:
>>
>>> I am trying to write a netwire combiner similar to multicast. The only
>>> difference is that when one of the wires inihibts, I want to remove it
>>> from the list.
>>>
>>> So this is my attempt:
>>>
>>> manager :: (Monad m) => [Wire e m a b] -> Wire e m [a] [b]
>>> manager ws' = mkGen $ \dt xs' -> do
>>>             res <- mapM (\(w,x) -> stepWire w dt x) $ zip ws' xs'
>>>             let filt (Left a, b) = Just (a, b)
>>>                 filt _           = Nothing
>>>                 resx = mapMaybe filt res
>>>             return (Left $ (fmap fst) resx,manager (fmap snd resx))
>>
>> Notice that Left means inhibition (...).
>
> I was sure right meant inhibition ... thanks!
>
>> Also your interface seems very unsafe to me.  I suggest the following
>> interface instead:
>>
>>     shrinking :: (Monad m) => [Wire e m a b] -> Wire e m a [b]
>>
>> Then normally 'a' could be something like Map K A.
>
> That would mean, the individual wires have to know there own id?!?
> Mmmh, I will try to keep this bookkeeping out of the wires with this
> interface:
>
> shrinking :: (Monad m) => [Wire e m a b] -> Wire e m (Map Int a) (Int,b)
>
> shrinking will assign the ids to the wires and returns them with the
> result. I will see where this gets me ... :).
>
> Regards,
> Nathan
>
>
>
>
>
> ------------------------------
>
> Message: 6
> Date: Mon, 5 Nov 2012 19:53:52 +0000
> From: Oscar Benjamin <oscar.j.benjamin at gmail.com>
> Subject: [Haskell-beginners] Missing termination rule for recursive
> function
> To: beginners at haskell.org
> Message-ID:
> <CAHVvXxQK+Ex96r3nDGw9RQr3hzp8FRKjm+ntar17Fq70q=qj=A at mail.gmail.com>
> Content-Type: text/plain; charset=ISO-8859-1
>
> Hi all,
>
> I'm new to this list and I'm in the very early stages of learning
> Haskell but I am confident with Python and some other languages.
> Seeing the connection between Haskell's lists and Python's generators
> I tried to reimplement a generator-based Python program in Haskell. I
> now have it working but I was hoping that someone could help me
> resolve a few queries.
>
> The Python program used itertools.permutations which is an iterator
> that yields all permutations of a sequence. Does Haskell have a
> similar function in it's standard library?
>
> I found a suggestion [1] for implementing a permutations function:
>
> -- Select each item and remainder from a sequence
> selections :: [a] -> [(a, [a])]
> selections []     = []
> selections (x:xs) = (x,xs) : [ (y,x:ys) | (y,ys) <- selections xs ]
>
> -- Permutations of a sequence
> permutations :: [a] -> [[a]]
> permutations xs = [ y:zs | (y,ys) <- selections xs, zs <- permutations 
> ys ]
>
> After a while I established that this permutations function seemed to
> be returning an empty list. Looking at it I thought that it might be
> missing a termination condition so I added
>
>  permutations [] = []
>
> but the result was unchanged. When I changed it to
>
>  permutations [] = [[]]
>
> I got the desired result. I can understand why this termination
> condition is needed to make the function recurse properly.
>
> What's confusing me though is why neither of the first two raised any
> kind of error at compile- or run-time. I would understand if an
> infinite loop had occurred (a common result for non-terminating
> recursion) but as far as I can tell it just returned an empty list.
> Can anyone explain to me how the function terminates in the three
> different cases?
>
> Also what is a good way of debugging this kind of problem? I found it
> quite difficult to establish that permutations was returning an empty
> list (in context there were other functions that could have been
> failing).
>
>
> Thanks in advance,
> Oscar
>
> [1] http://www.haskell.org/pipermail/haskell-cafe/2002-June/003122.html
>
>
>
> ------------------------------
>
> Message: 7
> Date: Mon, 05 Nov 2012 22:00:22 +0100
> From: Daniel Fischer <daniel.is.fischer at googlemail.com>
> Subject: Re: [Haskell-beginners] Missing termination rule for
> recursive function
> To: beginners at haskell.org
> Message-ID: <2714241.jonKyYpzCS at linux-v7dw.site>
> Content-Type: text/plain; charset="us-ascii"
>
> On Montag, 5. November 2012, 19:53:52, Oscar Benjamin wrote:
>> Hi all,
>>
>> I'm new to this list
>
> Welcome, then.
>
>> The Python program used itertools.permutations which is an iterator
>> that yields all permutations of a sequence. Does Haskell have a
>> similar function in it's standard library?
>
> There's permutations in Data.List
>
> Prelude Data.List> permutations [1,2,3]
> [[1,2,3],[2,1,3],[3,2,1],[2,3,1],[3,1,2],[1,3,2]]
>
> which even works on infinite lists:
>
> Prelude Data.List> map (take 5) . take 5 $ permutations [1 .. ]
> [[1,2,3,4,5],[2,1,3,4,5],[3,2,1,4,5],[2,3,1,4,5],[3,1,2,4,5]]
>
> (as a consequence, it is a bit slower than an optimal implementation 
> working
> only on finite lists could be).
>
>>
>> I found a suggestion [1] for implementing a permutations function:
>>
>> -- Select each item and remainder from a sequence
>> selections :: [a] -> [(a, [a])]
>> selections []     = []
>> selections (x:xs) = (x,xs) : [ (y,x:ys) | (y,ys) <- selections xs ]
>>
>> -- Permutations of a sequence
>> permutations :: [a] -> [[a]]
>> permutations xs = [ y:zs | (y,ys) <- selections xs, zs <- permutations 
>> ys ]
>>
>> After a while I established that this permutations function seemed to
>> be returning an empty list. Looking at it I thought that it might be
>> missing a termination condition so I added
>>
>>   permutations [] = []
>>
>> but the result was unchanged.
>
> permutations [x] = [ y:zs | (y,ys) <- selections [x], zs <- permutations 
> ys]
> ~> [ y:zs | (y,ys) <- [(x,[])], zs <- permutations ys]
> ~> [ x:zs | zs <- permutations []]
> ~> []
>
> since permutations [] = []
>
>> When I changed it to
>>
>>   permutations [] = [[]]
>
> That changes the last steps above to
>
> ~> [ x:zs | zs <- permutations []]
> ~> [ x:zs | zs <- [[]] ]
> ~> [ x:[] ]
> ~> [ [x] ]
>
> and the former is not even correct, because there is exactly one 
> permutation
> of an empty list.
>
>>
>> I got the desired result. I can understand why this termination
>> condition is needed to make the function recurse properly.
>>
>> What's confusing me though is why neither of the first two raised any
>> kind of error at compile- or run-time.
>
> The type is still correct, the empty list can have elements of any type,
>
> [] :: [a]
>
> in particular, the elements can be lists, in which case the type is
> specialised to
>
> [] :: [[b]]
>
> So the compiler has no reason to complain.
>
> And at runtime, you're only `concatMap`ping over an empty list, resulting 
> in
> an empty list, that's normal and nothing that could cause an exception.
>
>> I would understand if an
>> infinite loop had occurred (a common result for non-terminating
>> recursion) but as far as I can tell it just returned an empty list.
>> Can anyone explain to me how the function terminates in the three
>> different cases?
>
> We had two cases above, the one without explicit base case remains
>
>> permutations xs = [ y:zs | (y,ys) <- selections xs, zs <- permutations 
>> ys ]
>
> That leads to
>
> permutations [] = [ y:zs | (y,ys) <- selections [], zs <- permutations 
> ys ]
> ~> [ y:zs | (y,ys) <- [], zs <- permutations ys ]
>
> and you're again `concatMap`ping over an empty list, resulting in an empty
> list. If you're starting with a non-empty finite list, the recursive call 
> is
> to a list one element shorter etc. until finally
>
> permutations []
>
> is called - and then you prepend an element ot each list in an empty list,
> resulting in an empty list...
>
>>
>> Also what is a good way of debugging this kind of problem? I found it
>> quite difficult to establish that permutations was returning an empty
>> list (in context there were other functions that could have been
>> failing).
>>
>
> Trace the execution of very simple cases (empty lists, singleton lists, 
> lists
> with two elements) by hand with pencil and paper. That's the most 
> instructive
> and fruitful way.
>
> Check the results of simple cases against what you know the result ought 
> to
> be.
>
> Single-step through the evaluation of simple cases in the ghci debugger if
> necessary.
>
>
>
> ------------------------------
>
> Message: 8
> Date: Mon, 5 Nov 2012 16:27:47 -0500 (EST)
> From: Jay Sulzberger <jays at panix.com>
> Subject: Re: [Haskell-beginners] Missing termination rule for
> recursive function
> To: beginners at haskell.org
> Message-ID: <Pine.NEB.4.64.1211051614500.12460 at panix3.panix.com>
> Content-Type: TEXT/PLAIN; charset=US-ASCII; format=flowed
>
>
>
> On Mon, 5 Nov 2012, Oscar Benjamin <oscar.j.benjamin at gmail.com> wrote:
>
>> Hi all,
>>
>> I'm new to this list and I'm in the very early stages of learning
>> Haskell but I am confident with Python and some other languages.
>> Seeing the connection between Haskell's lists and Python's generators
>> I tried to reimplement a generator-based Python program in Haskell. I
>> now have it working but I was hoping that someone could help me
>> resolve a few queries.
>>
>> The Python program used itertools.permutations which is an iterator
>> that yields all permutations of a sequence. Does Haskell have a
>> similar function in it's standard library?
>>
>> I found a suggestion [1] for implementing a permutations function:
>>
>> -- Select each item and remainder from a sequence
>> selections :: [a] -> [(a, [a])]
>> selections []     = []
>> selections (x:xs) = (x,xs) : [ (y,x:ys) | (y,ys) <- selections xs ]
>>
>> -- Permutations of a sequence
>> permutations :: [a] -> [[a]]
>> permutations xs = [ y:zs | (y,ys) <- selections xs, zs <- permutations 
>> ys ]
>>
>> After a while I established that this permutations function seemed to
>> be returning an empty list. Looking at it I thought that it might be
>> missing a termination condition so I added
>>
>>  permutations [] = []
>>
>> but the result was unchanged. When I changed it to
>>
>>  permutations [] = [[]]
>>
>> I got the desired result. I can understand why this termination
>> condition is needed to make the function recurse properly.
>>
>> What's confusing me though is why neither of the first two raised any
>> kind of error at compile- or run-time. I would understand if an
>> infinite loop had occurred (a common result for non-terminating
>> recursion) but as far as I can tell it just returned an empty list.
>> Can anyone explain to me how the function terminates in the three
>> different cases?
>
> Let us assume we are in case 0:
>
> We have neither
>
>   permutations [] = []
>
> nor
>
>   permutations [] = [[]]
>
> in our code.
>
> Then let us calculate
>
>   permutations ["a"]
>
> Assuming selections is correct, we have
>
>   permutations ["a"] ~> the list of all lists of form "a":(something that 
> lies in permutations [])
>
> So what is the value of permutations []?  It is the list of all things of 
> form
>
>   y:zs
>
>   such that
>
>   (y,ys) lies in selections xs and zs lies in permutations ys
>
> where xs = [].  But there are no such things.  And so the list of
> sll such things is the empty list [].
>
> What is perhaps confusing is that, at this juncture, one tends to
> think that
>
>   y:zs
>
> must really be
>
>   y:[]
>
> but it is not.  [] is an object in the Haskell world, and a
> subexpression zs appears in the expression on the right hand side
> of
>
>   permutations xs = [ y:zs | (y,ys) <- selections xs, zs <- permutations 
> ys ]
>
> but there is no object in the Haskell world which can be the
> value of zs because there is no object which can be the value of
> (y, ys), because the line
>
>   selections []     = []
>
> appears in the definition of selections: (y, ys) would have to be
> an element, that is an object lying in, selections [], but
> selections [] = [].
>
>>
>> Also what is a good way of debugging this kind of problem? I found it
>> quite difficult to establish that permutations was returning an empty
>> list (in context there were other functions that could have been
>> failing).
>>
>>
>> Thanks in advance,
>> Oscar
>
> I am not sure.  I think many people just slowly "by hand" run
> their own interpreter in their head.
>
> ad types: I conjecture that Haskell's type checker, by design,
> when run on this code, treats the expressions [] and [["a"]] as
> both being of type [[a]].
>
> If my conjecture is correct, then case 0 code would pass the type
> checker.
>
> ad termination: the "list comprehension" operator returns,
> correctly according to the conventions of the twentieth century,
> the null list when there are no objects which satisfy the
> conditions written to the right of the "|".
>
> oo--JS.
>
>
>>
>> [1] http://www.haskell.org/pipermail/haskell-cafe/2002-June/003122.html
>>
>> _______________________________________________
>> Beginners mailing list
>> Beginners at haskell.org
>> http://www.haskell.org/mailman/listinfo/beginners
>>
>>
>
>
>
>
>
> ------------------------------
>
> _______________________________________________
> Beginners mailing list
> Beginners at haskell.org
> http://www.haskell.org/mailman/listinfo/beginners
>
>
> End of Beginners Digest, Vol 53, Issue 7
> ****************************************
> 




More information about the Beginners mailing list