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
        [EMAIL PROTECTED]

You can reach the person managing the list at
        [EMAIL PROTECTED]

When replying, please edit your Subject line so it is more specific
than "Re: Contents of Beginners digest..."


Today's Topics:

   1.  Re: [Haskell-cafe] ANNOUNCE: Haskell Communities and
      Activities Report (15th ed., November 2008) (Don Stewart)
   2. Re:  Re: Installing Gtk2hs (Duncan Coutts)
   3. Re:  Re: Installing Gtk2hs (Duncan Coutts)
   4.  Re: Memoization (Apfelmus, Heinrich)
   5.  Re: ANNOUNCE: Haskell Communities and Activities Report
      (15th ed., November 2008) (Benjamin L.Russell)
   6.  What causes <<loop>>? (Martin Hofmann)
   7.  Special session on Haskell language  (John Edward)


----------------------------------------------------------------------

Message: 1
Date: Fri, 28 Nov 2008 16:15:30 -0800
From: Don Stewart <[EMAIL PROTECTED]>
Subject: [Haskell-beginners] Re: [Haskell-cafe] ANNOUNCE: Haskell
        Communities     and Activities Report (15th ed., November 2008)
To: Janis Voigtlaender <[EMAIL PROTECTED]>
Cc: [EMAIL PROTECTED], [EMAIL PROTECTED], [EMAIL PROTECTED],
        beginners@haskell.org, [EMAIL PROTECTED],
        [EMAIL PROTECTED]
Message-ID: <[EMAIL PROTECTED]>
Content-Type: text/plain; charset=us-ascii

Good work!

It is always interesting to see the secret Haskell projects that only
get announced via the HCAR. Things not on haskell@ or on hackage.

For example, this under-the-radar project:

    http://www.haskell.org/communities/11-2008/html/report.html#sect7.7

    7.7  IVU Traffic Technologies AG Rostering Group

Haskell to solve constraints on EU bus timetables! In production use!    

-- Don


voigt:
> On behalf of the many, many contributors, I am pleased to announce
> that the
> 
>             Haskell Communities and Activities Report
>                   (15th edition, November 2008)
> 
>                http://www.haskell.org/communities/
> 
> is now available from the Haskell Communities home page in PDF and
> HTML formats.


------------------------------

Message: 2
Date: Sun, 30 Nov 2008 22:33:54 +0000
From: Duncan Coutts <[EMAIL PROTECTED]>
Subject: Re: [Haskell-beginners] Re: Installing Gtk2hs
To: Colin Paul Adams <[EMAIL PROTECTED]>
Cc: beginners@haskell.org
Message-ID: <[EMAIL PROTECTED]>
Content-Type: text/plain

On Sun, 2008-11-30 at 09:08 +0000, Colin Paul Adams wrote:
>     Colin> Now make fails with:
> 
>     Colin> svgcairo/Graphics/Rendering/Cairo/SVG.chs:201:2: Couldn't
>     Colin> match expected type `()' against inferred type `CInt'
>     Colin> Expected type: Render () Inferred type: Render CInt In the

> So I tried changing Render () to Render CInt in four places in
> SVG.chs.

Aye, the cairo C library changed it's API from 1.6 to 1.8. It added an
int return type to several functions that previously returned void.

> Now it installs OK with 6.8.3, and all the demos run.
> 
> I'd have a go at getting it to work with 6.10.1 if I knew what to do.
> It appears the library structure has changed incompatibly (and ghc
> didn't even change its version number - that's pretty bad).

The version of ghc did change of course, 6.8 -> 6.10, but perhaps you
mean the versions of the libraries? They changed also, to reflect the
API changes.

> Is there a document anywhere that details the structure changes?

Yes, the ghc-6.10 release notes.

Duncan



------------------------------

Message: 3
Date: Sun, 30 Nov 2008 22:43:45 +0000
From: Duncan Coutts <[EMAIL PROTECTED]>
Subject: Re: [Haskell-beginners] Re: Installing Gtk2hs
To: Colin Paul Adams <[EMAIL PROTECTED]>
Cc: beginners@haskell.org
Message-ID: <[EMAIL PROTECTED]>
Content-Type: text/plain

On Sun, 2008-11-30 at 09:24 +0000, Colin Paul Adams wrote:
> >>>>> "Colin" == Colin Paul Adams <[EMAIL PROTECTED]> writes:
> 
>     Colin> Now it installs OK with 6.8.3, and all the demos run.
> 
> Well, not quite all:
> 
> mozembed fails to compile with:
> 
> TestEmbedMoz.hs:5:7:
>     Could not find module `Graphics.UI.Gtk.MozEmbed':
>       Use -v to see a list of the files searched for.
> make: *** [testembedmoz] Error 1

This almost certainly is because you didn't build the mozembed component
of gtk2hs. The ./configure script lists all the bits that it's going to
build. By default if the corresponding C devel package is not available
then the binding will not be built. If you really want to build it then
use ./configure --enable-firefox or --enable-xulrunner and it will stop
and report exactly what bits it needed but could not find.

> And the svgviewer programs fail at runtime with:
> 
> svgviewer: user error (Pattern match failure in do expression at 
> SvgViewer.hs:11:2-9)

That's kind of by design, it's a simple demo program that does no error
checking on the command line arguments. See that line in the source
code:

  (file:_) <- getArgs

So if you call it with a single .svg file parameter it should work.

> and:
> 
> svg2png: user error (Pattern match failure in do expression at 
> Svg2Png.hs:9:2-18)

Same issue.

> and for treelist:
> 
> make: *** No rule to make target `TreeSort.hs', needed by `treesort'.  Stop.

Good catch, that file is missing from the tarball.

> and for opengl:
> 
> ghc --make RotatingCube.hs -o cube 
> 
> RotatingCube.hs:7:17:
>     Could not find module `Graphics.UI.Gtk.OpenGL':
>       Use -v to see a list of the files searched for.
> make: *** [cube] Error 1

Same as the fist problem. You built gtk2hs without the opengl component.
Use ./configure --enable-opengl and it'll tell you what you're missing.

> and for sourceview:
> 
> ghc --make SourceViewTest.hs -o sourceview 
> 
> SourceViewTest.hs:5:7:
>     Could not find module `Graphics.UI.Gtk.SourceView':
>       Use -v to see a list of the files searched for.
> make: *** [sourceview] Error 1

Same problem again, but for the sourceview component.
./configure --enable-sourceview

Basically you need to install a bunch of -devel fedora packages so that
the Haskell bindings can be built. The thing to check is the summary
produced at that end of running ./configure

Duncan



------------------------------

Message: 4
Date: Mon, 01 Dec 2008 11:02:08 +0100
From: "Apfelmus, Heinrich" <[EMAIL PROTECTED]>
Subject: [Haskell-beginners] Re: Memoization
To: beginners@haskell.org
Message-ID: <[EMAIL PROTECTED]>
Content-Type: text/plain; charset=ISO-8859-1

abdullah abdul Khadir wrote:
> Hi,
>       I am a student and we had an assignment in Haskell. The question, was
> given a string of the form  "1-2+3*5-7+4-6+3" i.e., any sequence of integers
> as well as some operators between them we had to find a maximum possible
> value for the expression as well as the expression itself . So for maxval
> "1-2+3*5-7+4-6+3" it is (76,"(1-((2+3)*((5-(7+4))-(6+3))))"). The function
> we had to write was maxval :: String -> (Int,String). For further details on
> the question, have a look at our sir's web page
> here<http://www.cmi.ac.in/%7Emadhavan/courses/programming08/assignment6.txt>.
>
> I solved the question, we had to use memoization, and submitted the
> solution. It is given below. Now the problem is I am just wondering if it
> can be solved in a better manner. Translation : Is there some way in Haskell
> to do it in a more simpler way and as well as to reduce the number of lines
> of the program.

Yes, your solution can be made more beautiful. Let me show how.


First of all, we should separate *parsing* the input into a list of
numbers and operations from *computing* the result.

    maxval :: String -> (Int, String)
    maxval = compute . parse

In other words,  parse  extracts the numbers and arithmetic operations
from the input. One example implementation is

    type Op = Char

    parse :: String -> ([Int], [Op])
    parse [] = ([],[])
    parse s  = let (n,s2) = parseInt s in
        case s2 of
            []    -> ([n],[])
            op:s3 -> let (ns,ops) = parse s3 in (n:ns,op:ops)

    parseInt :: String -> (Int, String)
    parseInt s = (n, s')
        where
        (digits, s') = span isDigit s
        n            = foldl (\x c -> 10*x + fromDigit c) 0 digits
        fromDigit c  = ord c - ord '0'

but it's more complicated then necessary. We should at least use the
reads  functions from the  Prelude . And in any case, *parser
combinators* are the best way to parse something. But for now, the
straightforward way above shall suffice.


Second, we can considerably clarify things by defining new types. Our
first abstraction is the *expression*

    type Expr   = (Int,String)

    value :: Expr -> Int
    value = fst

which consists of a value and its textual representation. For instance,

  (20, "((6*3)+2)")
  (30, "(6*(3+2))")

are expressions. We can combine two expression by applying one of our
arithmetic operations both to the value and the textual representation

    applyExpr :: Op -> Expr -> Expr -> Expr
    applyExpr op (x,ex) (y,ey) =
        (f op x y, "(" ++ ex ++ [op] ++ ey ++ ")")
        where
        f '+' = (+)
        f '-' = (-)
        f '*' = (*)

Our main algorithm will choose maximal and minimal values from a set of
possible expressions. Therefore, we introduce the following type

    data MinMax = M Expr Expr deriving (Show)

which represents a range of values by recording expressions of minimal
and maximal value.

    maxexpr :: MinMax -> Expr
    maxexpr (M _ e) = e

We can merge two such ranges ("union") by choosing the lower first and
the higher second part:

    merge :: MinMax -> MinMax -> MinMax
    merge (M x y) (M x2 y2) = M emin emax
        where
        emin = if value x < value x2 then x else x2
        emax = if value y > value y2 then y else y2

    merges :: [MinMax] -> MinMax
    merges = foldr1 merge

    fromExpr :: Expr -> MinMax
    fromExpr e = M e e

Now, we also want to apply arithmetic expressions to these ranges. For
'+','-' and '*', the following function does the right thing:

    applyMinMax :: Op -> MinMax -> MinMax -> MinMax
    applyMinMax op (M x y) (M x2 y2) =
        merges [fromExpr (applyExpr op z z2) | z<-[x,y], z2<-[x2,y2]]


With these preliminaries, we can now express the algorithm. The main
ingredient is a function  (f :: Int -> Int -> MinMax)  that calculates
the range of possible values for expression that only utilize numbers
between the positions  i  and  j  in the list. And as common in dynamic
programming, we employ a memo table to store the intermediate results.

    compute :: ([Int], [Op]) -> Expr
    compute (xs,ops) = maxexpr (f 1 n)
        where
        n = length xs
        f = memoize n f'
        f' i j
            | i == j    = let x = xs !! (i-1)
                              e = (x,show x)
                          in fromExpr e
            | otherwise = merges [applyMinMax (ops !! (k-1))
                                  (f i k) (f (k+1) j)
                                 | k <- [i..(j-1)]]

Where exactly is the memo table? It's hidden in

    memoize :: Int -> (Int -> Int -> a) -> (Int -> Int -> a)
    memoize n f = \i j -> table ! (i,j)
        where
        table = array ((1,1),(n,n))
                 [((i,j), f i j) | i<-[1..n], j<-[1..n]]

which takes a function of two arguments from 1 to n and tabulates its
values in an array. (You need to  import Data.Array  for the arrays.) In
other words,  f  tabulates the results of  f'  which in turn uses the
tabulated values returned by  f  to compute its results. Thanks to lazy
evaluation, this "tabulate the result before it's available" works.


To summarize, the key points of the new solution are

  * Parse input.
  * Abstractions.
  * Memoization is a simple higher order function.


But there is more. Namely, there are many different ways to implement
the memoization. I used an array, you were asked to use a linked list.
The former is O(1) the latter O(n). There is a way to do it with plain
trees but still O(1), see also section 3 of

  Richard Bird and Ralf Hinze.
  "Trouble Shared is Trouble Halved"
  http://www.informatik.uni-bonn.de/~ralf/publications/HW2003.pdf


And there is even more! Namely, we knew that the problem is an instance
of dynamic programming, we knew the algorithm before implementing it.
But how to find the algorithm in the first place? Well, the usual answer
is "by thinking hard". However, there are very systemic ways to derive
dynamic programming algorithms from just the problem specification! In a
sense, much of the work of R. Bird centers this topic. The book "Algebra
of Programming"

http://web.comlab.ox.ac.uk/oucl/research/pdt/ap/pubs.html#Bird-deMoor96:Algebra

is one of the cornerstones.

The systematic derivation of dynamic programming algorithms has been
rediscovered in a more direct but less general fashion

   http://bibiserv.techfak.uni-bielefeld.de/adp/



Regards,
H. Apfelmus



------------------------------

Message: 5
Date: Wed, 03 Dec 2008 15:39:41 +0900
From: Benjamin L.Russell <[EMAIL PROTECTED]>
Subject: [Haskell-beginners] Re: ANNOUNCE: Haskell Communities and
        Activities      Report (15th ed., November 2008)
To: beginners@haskell.org
Cc: [EMAIL PROTECTED], [EMAIL PROTECTED]
Message-ID: <[EMAIL PROTECTED]>
Content-Type: text/plain; charset=us-ascii

On Fri, 28 Nov 2008 16:15:30 -0800, Don Stewart <[EMAIL PROTECTED]>
wrote:

>Good work!
>
>It is always interesting to see the secret Haskell projects that only
>get announced via the HCAR. Things not on haskell@ or on hackage.
>
>For example, this under-the-radar project:
>
>    http://www.haskell.org/communities/11-2008/html/report.html#sect7.7
>
>    7.7  IVU Traffic Technologies AG Rostering Group
>
>Haskell to solve constraints on EU bus timetables! In production use!    

Speaking of production use, one type of project that would be
interesting would be a study examining how Haskell can increase
programmer productivity for production use for programmers who are not
necessarily gifted in programming, but whose forte may lie in another
field and who are very interested in functional programming; i.e.,
some type of tabulated data (preferably a graph, although a table
would work, too) of data quantifying how useful Haskell is in allowing
one whose forte may not necessarily be in programming (say, a
physicist, mathematician, or even a translator who happens to have an
algorithmically-focused computer science degree) to equal or excel the
productivity of, say, a gifted C/C++ programmer in, say, setting up a
commercial Web site.

The reason is that recently, there has been news of people in academia
leaving for other realms because of worsening conditions (see "As
strikes begin, lecturer quits to become plumber" at
http://www.guardian.co.uk/uk/2004/feb/24/lecturerspay.highereducation,
and "Why I am Not a Professor OR The Decline and Fall of the British
University" at http://www.lambdassociates.org/blog/decline.htm).  Up
to know, my dream was to publish a paper on type theory to motivate
study of Haskell, but now it looks like I may need to aim for creating
a commercial Web site.  However, I am not sure of being able to
compete with commercial Web sites, because I am more of a
writer/translator who happens to like functional programming than a
real-life programmer.

I've already seen such articles as "Why Functional Programming
Matters" (see http://www.md.chalmers.se/~rjmh/Papers/whyfp.html), "Why
Haskell Matters" (see
http://www.haskell.org/haskellwiki/Why_Haskell_matters), and "Beating
the Averages" (see http://www.paulgraham.com/avg.html).  However,
these essays tend to focus on how a functional language FL is
structurally better than non-functional languages NFL in general,
without specifying the skill-level of the programmer.  Instead, it
would be interesting to find the minimum skill-level s necessary for,
say, somebody whose forte is not in programming, but who, say, studies
functional programming as a hobby, to use Haskell as a tool in
achieving a productivity level equivalent to that of a gifted C/C++
programmer.

To sum:  Can a theoretically-minded Haskell student who studies
Haskell out of interest in type theory compete with star C/C++
programmers in developing, say, commercial Web sites?

This is not quite clear, because even if Haskell can increase
programmer productivity by tenfold, a star programmer can also be more
productive than an average programmer by tenfold.

How risky is this challenge?

-- Benjamin L. Russell

>
>-- Don
>
>
>voigt:
>> On behalf of the many, many contributors, I am pleased to announce
>> that the
>> 
>>             Haskell Communities and Activities Report
>>                   (15th edition, November 2008)
>> 
>>                http://www.haskell.org/communities/
>> 
>> is now available from the Haskell Communities home page in PDF and
>> HTML formats.
-- 
Benjamin L. Russell  /   DekuDekuplex at Yahoo dot com
http://dekudekuplex.wordpress.com/
Translator/Interpreter / Mobile:  +011 81 80-3603-6725
"Furuike ya, kawazu tobikomu mizu no oto." 
-- Matsuo Basho^ 



------------------------------

Message: 6
Date: Wed, 03 Dec 2008 10:25:07 +0100
From: Martin Hofmann <[EMAIL PROTECTED]>
Subject: [Haskell-beginners] What causes <<loop>>?
To: beginners@haskell.org
Message-ID: <[EMAIL PROTECTED]>
Content-Type: text/plain

I've already posted this mail on haskell-cafe, but apparently the
subject suggested a too simple question, so I try it here again. I am
picking up a discussion with the same topic from haskell-users on
8th November. 

Thunks with reference on themselves was mentioned as main reason for
<<loop>>.

> A safe recursive definition would be
>   let x = Foo (x+1)
> However, if you leave out the constructor,
>   let x = x + 1
> you get a <<loop>> (or a deadlock).
> 

Are there any other reasons? 

I am trying to debug monadic code which stores state information in a
record maintaining several Data.Maps, but in vain so far. A state is
modified/changed in several steps by a compound function i.e.

        changeA $ changeB $ changeC state

Could this also lead to a deadlock? If so, can I prevent this using CPS?
If the state transformation is the main purpose/computation of the monad
at all, is it better to use CPS? Is code using mtl, records or Data.Map
more prone to <<loop>> or does this not matter at all. How can I
identify self-referencing thunks more easily? Is there any rule of thumb
to prevent <<loop>>? Are there any less obvious newbie mistakes causing
<<loop> then the one above?

Sorry, a lot of questions at once, but I am kind of helpless because I
can't find any reason of my <<loop>>, so any comments, experience, and
tips are highly appreciated.

Thanks,

Martin



------------------------------

Message: 7
Date: Wed, 3 Dec 2008 17:57:21 -0800 (PST)
From: John Edward <[EMAIL PROTECTED]>
Subject: [Haskell-beginners] Special session on Haskell language 
To: beginners@haskell.org
Message-ID: <[EMAIL PROTECTED]>
Content-Type: text/plain; charset="iso-8859-1"

Special session on Haskell language at MULTICONF-09 call for papers
 
Special session on Haskell language will be held at the 2009 Multi Conference 
in Computer Science, Information Technology and Control systems and 
Computational Science and Computer Engineering (MULTICONF-09) (website: 
http://www.PromoteResearch.org) and it will be held during July 13-16 2009 in 
Orlando, FL, USA. We invite draft paper submissions. The event consists of the 
following conferences:
·         International Conference on Artificial Intelligence and Pattern 
Recognition (AIPR-09) 
·         International Conference on Automation, Robotics and Control Systems 
(ARCS-09)
·         International Conference on Bioinformatics, Computational Biology, 
Genomics and Chemoinformatics (BCBGC-09)
·         International Conference on Enterprise Information Systems and Web 
Technologies (EISWT-09)
·         International Conference on High Performance Computing, Networking 
and Communication Systems (HPCNCS-09) 
·         International Conference on Information Security and Privacy (ISP-09)
·         International Conference on Recent Advances in Information Technology 
and Applications (RAITA-09)
·         International Conference on Software Engineering Theory and Practice 
(SETP-09) 
·         International Conference on Theory and Applications of Computational 
Science (TACS-09)
·         International Conference on Theoretical and Mathematical Foundations 
of Computer Science (TMFCS-09)
 
The website http://www.PromoteResearch.org  contains more details.
 
Sincerely
John Edward
Publicity committee
 
 


      
-------------- next part --------------
An HTML attachment was scrubbed...
URL: 
http://www.haskell.org/pipermail/beginners/attachments/20081203/2b0f6236/attachment.htm

------------------------------

_______________________________________________
Beginners mailing list
Beginners@haskell.org
http://www.haskell.org/mailman/listinfo/beginners


End of Beginners Digest, Vol 6, Issue 1
***************************************

Reply via email to