labelLeaves(Tree, Tree1) :- label(N, Tree, (N, Tree1)).label(N, branch(A, B), (N1, branch(A1, B1))) :-label(N, A, (Na, A1)),label(N, B, (Nb, B1)),N1 is Na + Nb.label(N, leaf(_), (1, leaf(N))).
# The next line provides data to work with.tree(branch(branch(leaf(a), branch(leaf(b), leaf(c))), leaf(d))).
?- tree(T), labelLeaves(T, T1).T = branch(branch(leaf(a), branch(leaf(b), leaf(c))), leaf(d)),T1 = branch(branch(leaf(4), branch(leaf(4), leaf(4))), leaf(4)) ;false.
Send Beginners mailing list submissions to
beginners@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@haskell.org
You can reach the person managing the list at
beginners-owner@haskell.org
When replying, please edit your Subject line so it is more specific
than "Re: Contents of Beginners digest..."
Today's Topics:
1. Re: strange behaviour : computing lowest divisor (Daniel Fischer)
2. Re: Tying the knot (Heinrich Apfelmus)
3. runtime error <<loop>> when using -O compile option
(Gerold Meisinger)
4. Re: runtime error <<loop>> when using -O compile option
(Sangeet Kumar)
5. Re: Tying the knot (Alex Rozenshteyn)
6. Re: Tying the knot (Patrick LeBoutillier)
7. Re: Tying the knot (aditya siram)
----------------------------------------------------------------------
Message: 1
Date: Wed, 29 Dec 2010 12:49:00 +0100
From: Daniel Fischer <daniel.is.fischer@googlemail.com>
Subject: Re: [Haskell-beginners] strange behaviour : computing lowest
divisor
To: beginners@haskell.org
Message-ID: <201012291249.01415.daniel.is.fischer@googlemail.com>
Content-Type: text/plain; charset="utf-8"
On Wednesday 29 December 2010 10:59:53, Abhijit Ray wrote:
> Thanks, that seems to have fixed it.
>
> On Wed, Dec 29, 2010 at 5:46 PM, Lyndon Maydwell <maydwell@gmail.com>
wrote:
> > Try with Integer rather than Int. Might be an overflow issue...
> >
> > >
> > > *Main> ld 278970415063349480483707695
Yes, that number is between 2^87 and 2^88, as an Int, it's typically one of
206297903 = 7*37*796517 (32-bit Ints)
or
-9158009321667437777 = -7*13*15015953*670203649 (64-bit Ints).
------------------------------
Message: 2
Date: Wed, 29 Dec 2010 13:49:34 +0100
From: Heinrich Apfelmus <apfelmus@quantentunnel.de>
Subject: Re: [Haskell-beginners] Tying the knot
To: beginners@haskell.org
Message-ID: <iffaou$ba4$1@dough.gmane.org>
Content-Type: text/plain; charset=UTF-8; format=flowed
Alex Rozenshteyn wrote:
> I'm trying to understand the technique referred to as "tying the knot", but
> documentation on the internet seems to be much sparser and more obtuse than
> I like.
>
> So I'm asking here.
>
> As far as I understand, "tying the knot" refers to a way of using laziness
> to implement something like references in a purely functional way.
Not really.
"Tying the knot" refers to writing a seemingly circular program, where
the result of a function is used as argument to the very same function.
A canonical example is the following solution to the problem of labeling
all the leaves in a tree with the total leaf count:
data Tree a = Branch (Tree a) (Tree a) | Leaf a
labelLeaves :: Tree a -> Tree Int
labelLeaves tree = tree'
where
(n, tree') = label n tree -- n is both result and argument!
label n (Branch a b) = (na+nb, Branch a' b')
where
(na,a') = label n a
(nb,b') = label n b
label n (Leaf _) = (1, Leaf n)
In some cases, this be used to implement read-only doubly-linked lists
and other things that seem to require references, but not everything
involving references can be solved by tying a knot; in particular, the
references will be read-only.
(Feel free to put my blurb above on the HaskellWiki.)
> I'm trying to write a toy simulation:
> I have a population :: [Person]
> I want to collect a random subset of possible pairs of distinct people.
> So I go to each person in the population and select a subset of the people
> after him/her in the list; these are pairs in which s/he is the first
> element.
>
> I want to then be able to ask for all pairs in which a person is the first
> or the second element. I could give each person a unique id, but it seems
> like tying the knot is a valid way to implement this.
This situation doesn't have anything to do with tying the knot. After
all, how do you distinguish persons in the first place? You probably
already gave the unique IDs. Then, it's simply a matter of applying the
function
filter (\(x,y) -> x == p || y == p)
where p is the person you are looking for.
Regards,
Heinrich Apfelmus
--
http://apfelmus.nfshost.com
------------------------------
Message: 3
Date: Wed, 29 Dec 2010 13:57:15 +0000 (UTC)
From: Gerold Meisinger <gerold.meisinger@gmail.com>
Subject: [Haskell-beginners] runtime error <<loop>> when using -O
compile option
To: beginners@haskell.org
Message-ID: <loom.20101229T145705-480@post.gmane.org>
Content-Type: text/plain; charset=us-ascii
Hello!
I'm working on a computer game using Yampa and I get the following
runtime error:
$ myprog: <<loop>>
when compiling with
$ ghc --make MyProg.hs -o myprog -O
(without -O it works fine)
I stripped the bug down to the program below. What's funny is that the
error disappears under certain "odd circumstances" (marked as #1-#4). My
questions are:
1. How can I avoid this bug without introducing one of the "odd
circumstances"?
2. Why is it that I get this error?
3. How would you hunt down such a bug? Originally I got no clue where it
came from, so I just took the program apart piece by piece.
{-# LANGUAGE Arrows #-}
module Main (main) where
import FRP.Yampa
type ObjIn = Event () -- loop #1
--type ObjIn = Bool -- no loop #1
type ObjOut = (String, Int) -- loop #2
--type ObjOut = Int -- no loop #2
type GameObj = SF ObjIn ObjOut
testObj :: GameObj
testObj = proc hit -> do
returnA -< ("testObj", 1) -- loop #2
-- returnA -< 1 -- no loop #2
process :: [GameObj] -> SF () [ObjOut]
process objs = proc _ -> do
rec
gamestate <- par logic objs
-< gamestate -- loop #3 (recursive definition!)
-- -< [] -- no loop #3
returnA -< gamestate
logic :: [ObjOut] -> [sf] -> [(ObjIn, sf)]
logic gamestate objs = map route objs
where
route obj =
(if null (foo gamestate) then NoEvent else NoEvent, obj)
-- loop #1
-- (if null (foo gamestate) then False else False, obj)
-- no loop #1
foo :: [ObjOut] -> [ObjOut]
foo [] = []
foo objs = concat (collisions objs)
where
collisions [] = []
collisions (out:objs') =
[[out, out'] | out' <- objs, out `collide` out'] -- loop
#4
-- [[out, out'] | out' <- objs, True] -- no loop #4
collide :: ObjOut -> ObjOut -> Bool
collide (_, p) (_, p') = True -- loop #2
--collide p p' = True -- no loop #2
main :: IO ()
main = do
putStrLn . show $ embed (process [testObj]) ((), [(1.0,
Nothing)])
(Btw: I re-opened a bug report:
http://hackage.haskell.org/trac/ghc/ticket/2722#comment:10 )
------------------------------
Message: 4
Date: Wed, 29 Dec 2010 15:06:41 +0100 (CET)
From: Sangeet Kumar <sk@one.com>
Subject: Re: [Haskell-beginners] runtime error <<loop>> when using -O
compile option
To: Gerold Meisinger <gerold.meisinger@gmail.com>
Cc: beginners@haskell.org
Message-ID: <10654318.18.1293631600822.JavaMail.sangeetk@sk>
Content-Type: text/plain; charset=utf-8
Hi,
Thankyou for the update. I will confirm the delivery as soon as I receive it.
Regards,
Sangeet
----- Original Message -----
From: "Gerold Meisinger" <gerold.meisinger@gmail.com>
To: beginners@haskell.org
Sent: Wednesday, December 29, 2010 2:57:15 PM
Subject: [Haskell-beginners] runtime error <<loop>> when using -O compile option
Hello!
I'm working on a computer game using Yampa and I get the following
runtime error:
$ myprog: <<loop>>
when compiling with
$ ghc --make MyProg.hs -o myprog -O
(without -O it works fine)
I stripped the bug down to the program below. What's funny is that the
error disappears under certain "odd circumstances" (marked as #1-#4). My
questions are:
1. How can I avoid this bug without introducing one of the "odd
circumstances"?
2. Why is it that I get this error?
3. How would you hunt down such a bug? Originally I got no clue where it
came from, so I just took the program apart piece by piece.
{-# LANGUAGE Arrows #-}
module Main (main) where
import FRP.Yampa
type ObjIn = Event () -- loop #1
--type ObjIn = Bool -- no loop #1
type ObjOut = (String, Int) -- loop #2
--type ObjOut = Int -- no loop #2
type GameObj = SF ObjIn ObjOut
testObj :: GameObj
testObj = proc hit -> do
returnA -< ("testObj", 1) -- loop #2
-- returnA -< 1 -- no loop #2
process :: [GameObj] -> SF () [ObjOut]
process objs = proc _ -> do
rec
gamestate <- par logic objs
-< gamestate -- loop #3 (recursive definition!)
-- -< [] -- no loop #3
returnA -< gamestate
logic :: [ObjOut] -> [sf] -> [(ObjIn, sf)]
logic gamestate objs = map route objs
where
route obj =
(if null (foo gamestate) then NoEvent else NoEvent, obj)
-- loop #1
-- (if null (foo gamestate) then False else False, obj)
-- no loop #1
foo :: [ObjOut] -> [ObjOut]
foo [] = []
foo objs = concat (collisions objs)
where
collisions [] = []
collisions (out:objs') =
[[out, out'] | out' <- objs, out `collide` out'] -- loop
#4
-- [[out, out'] | out' <- objs, True] -- no loop #4
collide :: ObjOut -> ObjOut -> Bool
collide (_, p) (_, p') = True -- loop #2
--collide p p' = True -- no loop #2
main :: IO ()
main = do
putStrLn . show $ embed (process [testObj]) ((), [(1.0,
Nothing)])
(Btw: I re-opened a bug report:
http://hackage.haskell.org/trac/ghc/ticket/2722#comment:10 )
_______________________________________________
Beginners mailing list
Beginners@haskell.org
http://www.haskell.org/mailman/listinfo/beginners
------------------------------
Message: 5
Date: Wed, 29 Dec 2010 14:31:48 -0500
From: Alex Rozenshteyn <rpglover64@gmail.com>
Subject: Re: [Haskell-beginners] Tying the knot
To: Heinrich Apfelmus <apfelmus@quantentunnel.de>
Cc: beginners@haskell.org
Message-ID:
<AANLkTi=T4QYGbx9r_xoD8e8cPiOak58DvMqZZNta=wHL@mail.gmail.com>
Content-Type: text/plain; charset="utf-8"
Thank you. I'm still unclear as to how tying the know works and when it is
useful, but at least one of my misconceptions has been clarified.
I haven't given my `Person`s unique ids yet, thinking that I could avoid it
if I worked carefully. Guess it's not worth the effort.
On Wed, Dec 29, 2010 at 7:49 AM, Heinrich Apfelmus <
apfelmus@quantentunnel.de> wrote:
> Alex Rozenshteyn wrote:
>
>> I'm trying to understand the technique referred to as "tying the knot",
>> but
>> documentation on the internet seems to be much sparser and more obtuse
>> than
>> I like.
>>
>> So I'm asking here.
>>
>> As far as I understand, "tying the knot" refers to a way of using laziness
>> to implement something like references in a purely functional way.
>>
>
> Not really.
>
> "Tying the knot" refers to writing a seemingly circular program, where the
> result of a function is used as argument to the very same function.
>
> A canonical example is the following solution to the problem of labeling
> all the leaves in a tree with the total leaf count:
>
> data Tree a = Branch (Tree a) (Tree a) | Leaf a
>
> labelLeaves :: Tree a -> Tree Int
> labelLeaves tree = tree'
> where
> (n, tree') = label n tree -- n is both result and argument!
>
> label n (Branch a b) = (na+nb, Branch a' b')
> where
> (na,a') = label n a
> (nb,b') = label n b
> label n (Leaf _) = (1, Leaf n)
>
>
> In some cases, this be used to implement read-only doubly-linked lists and
> other things that seem to require references, but not everything involving
> references can be solved by tying a knot; in particular, the references will
> be read-only.
>
>
> (Feel free to put my blurb above on the HaskellWiki.)
>
>
> I'm trying to write a toy simulation:
>> I have a population :: [Person]
>> I want to collect a random subset of possible pairs of distinct people.
>> So I go to each person in the population and select a subset of the people
>> after him/her in the list; these are pairs in which s/he is the first
>> element.
>>
>> I want to then be able to ask for all pairs in which a person is the first
>> or the second element. I could give each person a unique id, but it seems
>> like tying the knot is a valid way to implement this.
>>
>
> This situation doesn't have anything to do with tying the knot. After all,
> how do you distinguish persons in the first place? You probably already gave
> the unique IDs. Then, it's simply a matter of applying the function
>
> filter (\(x,y) -> x == p || y == p)
>
> where p is the person you are looking for.
>
>
> Regards,
> Heinrich Apfelmus
>
> --
> http://apfelmus.nfshost.com
>
>
> _______________________________________________
> Beginners mailing list
> Beginners@haskell.org
> http://www.haskell.org/mailman/listinfo/beginners
>
--
Alex R
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/beginners/attachments/20101229/25d48f2f/attachment-0001.htm>
------------------------------
Message: 6
Date: Wed, 29 Dec 2010 17:52:32 -0500
From: Patrick LeBoutillier <patrick.leboutillier@gmail.com>
Subject: Re: [Haskell-beginners] Tying the knot
To: Heinrich Apfelmus <apfelmus@quantentunnel.de>
Cc: beginners@haskell.org
Message-ID:
<AANLkTi=CfON5g6SQM_JbQo9OFjNzXy4KFqDD_CcniFdm@mail.gmail.com>
Content-Type: text/plain; charset=ISO-8859-1
Heinrich,
> A canonical example is the following solution to the problem of labeling all
> the leaves in a tree with the total leaf count:
>
> ? ?data Tree a = Branch (Tree a) (Tree a) | Leaf a
>
> ? ?labelLeaves :: Tree a -> Tree Int
> ? ?labelLeaves tree = tree'
> ? ? ? ?where
> ? ? ? ?(n, tree') = label n tree ?-- n is both result and argument!
>
> ? ? ? ?label n (Branch a b) = (na+nb, Branch a' b')
> ? ? ? ? ? ?where
> ? ? ? ? ? ?(na,a') = label n a
> ? ? ? ? ? ?(nb,b') = label n b
> ? ? ? ?label n (Leaf _) ? ? = (1, Leaf n)
>
This looks completely freaky to me... how does it work? Is it the
laziness that allows the sum to be calculated first while preserving
the structure (as thunks?), and then once the value of n is known it
is propagated back down the tree and the actual tree values
constructed? Anyways this is really amazing to my newbie eyes...
Patrick
--
=====================
Patrick LeBoutillier
Rosem?re, Qu?bec, Canada
------------------------------
Message: 7
Date: Wed, 29 Dec 2010 18:22:27 -0600
From: aditya siram <aditya.siram@gmail.com>
Subject: Re: [Haskell-beginners] Tying the knot
To: Patrick LeBoutillier <patrick.leboutillier@gmail.com>
Cc: Heinrich Apfelmus <apfelmus@quantentunnel.de>,
beginners@haskell.org
Message-ID:
<AANLkTi=61Mzm5J-XAqhYuAG5c0U_At5cDcSorsxBE416@mail.gmail.com>
Content-Type: text/plain; charset=ISO-8859-1
My brain turns into strange braid when I see this kind of thing. I
don't quite understand it and I've never used it in real world code
but I'll try and explain anyway. Caveat emptor.
First forget about 'labelLeaves' and think a function that only
returned the leaf count:
count :: Tree a -> Int
count tree = c
where
c = count' tree
count' (Branch a b) = na+nb
where
na = count' a
nb = count' b
count' (Leaf _) = 1
> count $ Branch (Leaf "hello") (Leaf "world")
2
Now look at 'n' and imagine it was a memory location. Mentally
substitute some hex address (like 0x0000) if it makes it easier.
Here's what the function looks like now:
labelLeaves :: Tree a -> Tree Int
labelLeaves tree = tree'
where
(0x0000, tree') = label 0x0000 tree -- n is both result and argument!
label 0x0000 (Branch a b) = (na+nb, Branch a' b')
where
(na,a') = label 0x0000 a
(nb,b') = label 0x0000 b
label 0x0000 (Leaf _) = (1, Leaf 0x0000)
So if labelLeaves is given (Branch (Leaf "hello") (Leaf "world")) as
an argument, and we continue to think of 'n' as a memory location the
function returns something like:
(Branch (Leaf 0x0000) (Leaf 0x0000))
The part of the function where the leaves are counted up is exactly
like my 'count' example above, but when the function is done instead
of just returning it this line:
(n,tree') = label n tree
assigns the final count to 'n'. If 'n' is a memory location the final
leaf count would be sitting in 0x0000. Subbing the value at that
location into the result we get:
(Branch (Leaf 2) (Leaf 2))
-deech
On Wed, Dec 29, 2010 at 4:52 PM, Patrick LeBoutillier
<patrick.leboutillier@gmail.com> wrote:
> Heinrich,
>
>> A canonical example is the following solution to the problem of labeling all
>> the leaves in a tree with the total leaf count:
>>
>> ? ?data Tree a = Branch (Tree a) (Tree a) | Leaf a
>>
>> ? ?labelLeaves :: Tree a -> Tree Int
>> ? ?labelLeaves tree = tree'
>> ? ? ? ?where
>> ? ? ? ?(n, tree') = label n tree ?-- n is both result and argument!
>>
>> ? ? ? ?label n (Branch a b) = (na+nb, Branch a' b')
>> ? ? ? ? ? ?where
>> ? ? ? ? ? ?(na,a') = label n a
>> ? ? ? ? ? ?(nb,b') = label n b
>> ? ? ? ?label n (Leaf _) ? ? = (1, Leaf n)
>>
>
> This looks completely freaky to me... how does it work? Is it the
> laziness that allows the sum to be calculated first while preserving
> the structure (as thunks?), and then once the value of n is known it
> is propagated back down the tree and the actual tree values
> constructed? Anyways this is really amazing to my newbie eyes...
>
> Patrick
> --
> =====================
> Patrick LeBoutillier
> Rosem?re, Qu?bec, Canada
>
> _______________________________________________
> Beginners mailing list
> Beginners@haskell.org
> http://www.haskell.org/mailman/listinfo/beginners
>
------------------------------
_______________________________________________
Beginners mailing list
Beginners@haskell.org
http://www.haskell.org/mailman/listinfo/beginners
End of Beginners Digest, Vol 30, Issue 46
*****************************************