Re: [Haskell-cafe] Re: Haskell version of Norvig's Python Spelling Corrector

2007-04-24 Thread Udo Stenzel
Pete Kazmier wrote:
   train:: [B.ByteString] - WordFreq
   train words = frequencyMap
   where
 frequencyMap = foldr incWordCount M.empty words
 incWordCount w m = M.insertWith (+) w 1 m
 
 So is 'incWordCount' strict in its second argument?  I'm still not
 sure exactly what that means.

Yes.  incWordCount is strict in its second argument since

incWordCount x undefined == undefined

Of course you cannot see that from the definition of incWordCount alone,
this depends on the behavior of M.insertWith.  

 According to the wiki page, if it is
 strict in the second argument, I should have used foldl' instead of
 foldr.

Remember that the difference between foldr and foldl is not one between
left and right; both have to recurse from the left.  But foldr is normal
recursion, while foldl is accumulator recursion.  You obviously wanted
an accumulator, and it should usually be strictly evaluated.

There is another bug of this sort in your code.  Consider

 incWordCount w m = M.insertWith (+) w 1 m

There is no reason to evaluate the sum inside the map, instead an
unevaluated thunk is put in there.  Unfortunately, you need to take the
long way of using M.lookup and M.insert to build a strict replacement
for M.insertWith.  (A strict variant of Data.Map would be useful here,
unfortunately, there is none.)


-Udo
-- 
Streitigkeiten dauerten nie lange, wenn nur eine Seite Unrecht hätte.
-- de la Rochefoucauld


signature.asc
Description: Digital signature
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] HXT namespace problem

2007-04-24 Thread Martin Huschenbett

Hi all,

I'm currently trying to generate XML documents with HXT. Everything went 
well but I can't figure out how to generate the xmlns:... attributes 
for the namespaces.


My code looks like:

  runX $ constA (request TableListRequest)  root [] [writeA] 
writeDocument [(a_indent,v_1)] -

where writeA generates the actual content. This code generates something 
like:


?xml version=1.0 encoding=UTF-8?
soapenv:Envelope
  soapenv:Body
request:tablelist/
  /soapenv:Body
/soapenv:Envelope

But I want it with XML namespaces, i.e.:

?xml version=1.0 encoding=UTF-8?
soapenv:Envelope
xmlns:soapenv=http://schemas.xmlsoap.org/soap/envelope/;
xmlns:request=http://www.officematic.de/domas/request;

  soapenv:Body
request:tablelist/
  /soapenv:Body
/soapenv:Envelope

I tried using uniqueNamespaces and uniqueNamespacesFromDeclAndQNames 
but neither worked. Maybe I used them in the wrong part of code.


The tree representation my document looks like:

---XTag /
   |
   +---XTag {http://schemas.xmlsoap.org/soap/envelope/}soapenv:Envelope;
   |
   +---XTag {http://schemas.xmlsoap.org/soap/envelope/}soapenv:Body;
   |
   +---XTag 
{http://www.officematic.de/domas/request}request:tablelist;


and for me this looks like if there is enough namespace information 
provided.


I would appreciate any help,

Martin.

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Re: Compilling GHC on Vista

2007-04-24 Thread Monique Monteiro

I still get the same message even with these instructions.  I guess it
may be due to some Vista security checking...

Cheers,

Monique

On 4/24/07, Simon Marlow [EMAIL PROTECTED] wrote:

Tom Schrijvers wrote:

 Here's the more complete error message:

 configure:3321: checking for C compiler default output file name
 configure:3348: c:/MinGW/bin/gccconftest.c  5
 ld: /mingw/lib/crt2.o: No such file: No such file or directory
 configure:3351: $? = 1
 configure:3389: result:
 configure: failed program was:
 configure:3396: error: C compiler cannot create executables
 See `config.log' for more details.

 Do make sure that MingW's bin/ and libexec/gcc/mingw32/3.4.2/ are the
 very first two in your path. I get the same error message if I don't do
 that.

Hi Tom - would you mind adding the right incantation to the Vista instructions
at the top of http://hackage.haskell.org/trac/ghc/wiki/Building/Windows?

Cheers,
   Simon




--
__
Monique Monteiro, MSc
MCP .NET Framework 2.0 / SCJP / IBM OOAD
Project Manager
Recife Microsoft Innovation Center
+55 81 34198137
http://www.cin.ufpe.br/~mlbm
http://thespoke.net/blogs/moniquelouise/default.aspx
[EMAIL PROTECTED]
MSN: [EMAIL PROTECTED]
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Is Template Haskell a suitable macro language?

2007-04-24 Thread Joel Reymont
I'm finding myself dealing with several large abstract syntax trees  
that are very similar in nature. The constructor names would be the  
same or one type may be a small extension of another.


This is something that I wouldn't worry about with Lisp, for example,  
as I would create a bunch of macros for creating syntax trees and  
reuse them all over. I cannot do this in Haskell, though, as my  
macros are functions and so I must repeat them for every AST since  
they return different types.


I'm wondering if Template Haskell is a suitable replacement for Lisp  
macros.


What is the consensus?

Thanks, Joel

--
http://wagerlabs.com/





___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Newbie seeking advice regarding data structure for a tricky algorithm

2007-04-24 Thread Andrew Wagner

Hi Toby,

On 4/24/07, Toby Hutton [EMAIL PROTECTED] wrote:

Hi,

I'm trying to implement a fast kd-tree in Haskell.
http://en.wikipedia.org/wiki/Kd-tree  It's a binary tree
representing space partitions.


Trees are pretty easy to implement in haskell, due to their inherent
recursive nature. For example, you can do something like this:

data Tree a = Node a [Tree a]

Then the elements of the list are just the children subtrees of the
current node. This is the approach taken by
http://haskell.org/ghc/docs/latest/html/libraries/base/Data-Tree.html
for example. I personally think this is easier than trying to define
an actual binary tree. With this approach, the algorithms mentioned in
the wikipedia article above should be relatively straight-forward to
implement.

As for the paper cited, and the 'analogous' algorithm, you lost me. I
don't see what the algorithm you gives has to do with the problem, so
I'm quite confused. My suggestion would be to try to translate one of
the algorithms from wikipedia, and use that. If you can't work out how
to do this, feel free to check back with me and/or the list.

Good luck!

[snip]

Andrew
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] faster factorial function via FFI?

2007-04-24 Thread Dan Drake
On Mon, 23 Apr 2007 at 04:36PM -0700, Stefan O'Rear wrote:
  I'm finding the number of set partitions that correspond to a certain
  integer partition. If p = p_1, p_2,...,p_k is an integer partition of n,
  then there are
  
 n!
   --
   p_1! * p_2! * ... * p_k! * 1^c_1 * ... * k^c_k
 
 That formula isn't even correct.  Consider p = replicate n 1, that is
 n partitions each of size 1.  There is only one way to do this - put
 each element in its own partition.  However, your formula gives:

Correct, the formula is incorrect. :)  The i^c_i terms need to be
c_i!.

(I got it right in my code, though.)

Dan

-- 
Ceci n'est pas une .signature.


signature.asc
Description: Digital signature
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Is Template Haskell a suitable macro language?

2007-04-24 Thread Robin Green
On Tue, 24 Apr 2007 14:23:47 +0100
Joel Reymont [EMAIL PROTECTED] wrote:

 I'm finding myself dealing with several large abstract syntax trees  
 that are very similar in nature. The constructor names would be the  
 same or one type may be a small extension of another.
 
 This is something that I wouldn't worry about with Lisp, for
 example, as I would create a bunch of macros for creating syntax
 trees and reuse them all over. I cannot do this in Haskell, though,
 as my macros are functions and so I must repeat them for every AST
 since they return different types.
 
 I'm wondering if Template Haskell is a suitable replacement for Lisp  
 macros.
 
 What is the consensus?

I saw your earlier post on abstract syntax trees, and I have indeed
been using Template Haskell for processing syntax trees. (Sorry I
didn't reply earlier.) It works quite well, yes.

Here's my success story. Basically I have two modules, Abstract and
Concrete, which define data types for abstract and concrete syntax
respectively. The Abstract module also contains code to convert
concrete syntax (i.e. what comes out of the parser) into abstract
syntax, and the code that just does copying (i.e. the boilerplate code)
is generated by Template Haskell code.

What I do looks like this:


$(let
 preprocess :: [Dec] - Q [Dec]
 -- definition omitted

 in preprocess =
   [d|type Param = (Ident, Term)

  data FixBody = FixBody Ident [Param] (Maybe Annotation)
(Maybe Term) Term deriving (Typeable, Data, Eq)
  data MatchItem = MatchItem Term (Maybe Ident) (Maybe Term)
deriving (Typeable, Data, Eq)
  data IdentWithParams = IdentWithParams Ident [Param] (Maybe
Term) deriving (Typeable, Data, Eq)

  class Abstraction c a {- | c - a -} where { abstractL ::
Monad m = c - StateT [(Ident,Term)] m a }

#include common2.inc
   |])

Let me explain what's going on here, starting from the bottom. The
order of these parts is very important! The #include common2.inc
includes the type definitions which are common to both modules. (I
actually maintain a file common.inc and then that is preprocessed to
replace newlines with semicolons, in order to avoid the problem that
would otherwise occur that the file would be included at the wrong
identation level. Although the file is still included at the wrong
indentation level, apparently the use of semicolons mollifies ghc!) The
reason why I don't just put the stuff in common2.inc into another
module is because it refers to types that are defined *differently* in
each syntax! So I really am using cpp [actually, cpphs] for an
appropriate purpose here.

The class Abstraction defines a method abstractL. It is defined for
every concrete syntax data type and specifies how to translate that
type into abstract syntax (except the top-level which is handled
differently). The fundep is commented out because (a) ghc rejected it
and (b) I didn't need it anyway.

The preprocess function then takes all of the decls between [d| and |]
as input, passes through the declarations before the class declaration
(i.e. the ones that are not the same) without looking at them any
further, and then generates instances of the class for each data
declaration given below the class (i.e. all the types which are in
common, where only automatic copying code needs to be generated). It
also passes through all of the declarations given as input.

Why not simply put the initial declarations at the top of the file?
Well, ghc rejects that, if I remember correctly, because they refer to
other types which have yet to be generated (well, passed through) by
Template Haskell. Template Haskell seems to break the general principle
in Haskell that one can refer to a declaration in the same module,
textually before that declaration.

-- 
Robin
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: Compilling GHC on Vista

2007-04-24 Thread Tom Schrijvers

I still get the same message even with these instructions.  I guess it
may be due to some Vista security checking...


Do you still get the same error message in your config.log now? Or a 
different one? There is also an error on Vista with checking whether a 
file is executable. I don't know whether there's already a solution 
for that in the repository?


Tom


Cheers,

Monique

On 4/24/07, Simon Marlow [EMAIL PROTECTED] wrote:

Tom Schrijvers wrote:

 Here's the more complete error message:

 configure:3321: checking for C compiler default output file name
 configure:3348: c:/MinGW/bin/gccconftest.c  5
 ld: /mingw/lib/crt2.o: No such file: No such file or directory
 configure:3351: $? = 1
 configure:3389: result:
 configure: failed program was:
 configure:3396: error: C compiler cannot create executables
 See `config.log' for more details.

 Do make sure that MingW's bin/ and libexec/gcc/mingw32/3.4.2/ are the
 very first two in your path. I get the same error message if I don't do
 that.

Hi Tom - would you mind adding the right incantation to the Vista 
instructions

at the top of http://hackage.haskell.org/trac/ghc/wiki/Building/Windows?

Cheers,
   Simon




--
__
Monique Monteiro, MSc
MCP .NET Framework 2.0 / SCJP / IBM OOAD
Project Manager
Recife Microsoft Innovation Center
+55 81 34198137
http://www.cin.ufpe.br/~mlbm
http://thespoke.net/blogs/moniquelouise/default.aspx
[EMAIL PROTECTED]
MSN: [EMAIL PROTECTED]
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe



--
Tom Schrijvers

Department of Computer Science
K.U. Leuven
Celestijnenlaan 200A
B-3001 Heverlee
Belgium

tel: +32 16 327544
e-mail: [EMAIL PROTECTED]
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: Compilling GHC on Vista

2007-04-24 Thread Monique Monteiro

For backward compatibility reasons, I'm using GHC 6.2.2.  So, if there
is already a solution for this issue in the GHC repository, please let
me know how to add it manually.

I don't have problems with ./configure on Windows XP.

On 4/24/07, Tom Schrijvers [EMAIL PROTECTED] wrote:

 I still get the same message even with these instructions.  I guess it
 may be due to some Vista security checking...

Do you still get the same error message in your config.log now? Or a
different one? There is also an error on Vista with checking whether a
file is executable. I don't know whether there's already a solution
for that in the repository?

Tom

 Cheers,

 Monique

 On 4/24/07, Simon Marlow [EMAIL PROTECTED] wrote:
 Tom Schrijvers wrote:
 
  Here's the more complete error message:
 
  configure:3321: checking for C compiler default output file name
  configure:3348: c:/MinGW/bin/gccconftest.c  5
  ld: /mingw/lib/crt2.o: No such file: No such file or directory
  configure:3351: $? = 1
  configure:3389: result:
  configure: failed program was:
  configure:3396: error: C compiler cannot create executables
  See `config.log' for more details.
 
  Do make sure that MingW's bin/ and libexec/gcc/mingw32/3.4.2/ are the
  very first two in your path. I get the same error message if I don't do
  that.

 Hi Tom - would you mind adding the right incantation to the Vista
 instructions
 at the top of http://hackage.haskell.org/trac/ghc/wiki/Building/Windows?

 Cheers,
Simon



 --
 __
 Monique Monteiro, MSc
 MCP .NET Framework 2.0 / SCJP / IBM OOAD
 Project Manager
 Recife Microsoft Innovation Center
 +55 81 34198137
 http://www.cin.ufpe.br/~mlbm
 http://thespoke.net/blogs/moniquelouise/default.aspx
 [EMAIL PROTECTED]
 MSN: [EMAIL PROTECTED]
 ___
 Haskell-Cafe mailing list
 Haskell-Cafe@haskell.org
 http://www.haskell.org/mailman/listinfo/haskell-cafe


--
Tom Schrijvers

Department of Computer Science
K.U. Leuven
Celestijnenlaan 200A
B-3001 Heverlee
Belgium

tel: +32 16 327544
e-mail: [EMAIL PROTECTED]




--
__
Monique Monteiro, MSc
MCP .NET Framework 2.0 / SCJP / IBM OOAD
Project Manager
Recife Microsoft Innovation Center
+55 81 34198137
http://www.cin.ufpe.br/~mlbm
http://thespoke.net/blogs/moniquelouise/default.aspx
[EMAIL PROTECTED]
MSN: [EMAIL PROTECTED]
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: Haskell version of Norvig's Python Spelling Corrector

2007-04-24 Thread Bryan O'Sullivan

Udo Stenzel wrote:


There is another bug of this sort in your code.  Consider


incWordCount w m = M.insertWith (+) w 1 m


There is no reason to evaluate the sum inside the map, instead an
unevaluated thunk is put in there.


Would not Data.Map.insertWith' do the trick?

b
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Re: IDE support

2007-04-24 Thread Benedikt Schmidt
Claus Reinke [EMAIL PROTECTED] writes:

 I use emacs exclusively for hacking Haskell, but I wanted to see
 if it's possible to connect to the shim server-process from vim
 and started working on omnicompletion:
 http://shim.haskellco.de/trac/attachment/wiki/ScreenShots/vim-shim.png
 http://shim.haskellco.de/trac/wiki/ShimVim
 http://darcsweb.haskellco.de/darcsweb.cgi?r=shim;a=tree;f=/vim
 I don't think I will spend much more time working on this, but
 if anyone wants to try it out or improve it,  I would be happy
 to answer questions and review patches.

 thanks, i too had been wondering about the vim and part of shim,
 especially about the interprocess communication. you're using vim's
 python embedding for that, but many vim users won't have python.

I'm not sure if it's possible to use the vim scripting language for
that, but i used the python embedding so that I could base everything
on the python omnicompletion.

 more importantly: is that python solution (using unix sockets
 portable, ie, would it work for windows vim users if they were asked
 to install python for that purpose?

I don't think it's portable, but Tim Newsham added support
for TCP sockets to the haskell and emacs side and it should be
pretty easy to adapt the python vim script.
Of course, you have to be careful with TCP since you can't use
file permissions to make sure that nobody else connects to the
socket.

Thanks,
  Benedikt

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Is Template Haskell a suitable macro language?

2007-04-24 Thread Jacques Carette

Magnus Jonsson wrote:
I have the same problem too when using Haskell. The more I try to 
enforce static guarantees the more I get lots of datatypes that are 
similar except for one or two constructors. The best way I have found 
to avoid this is to simply give up on some of the static guarantees 
and just use one datatype that contains all the constructors. Less 
static guarantees but also less needless type coaxing between 90% 
similar types. I haven't tried using macros.
In Ocaml, you can frequently use polymorphic variants to get the same 
effect.


Which means that if you are willing to do enough type-class-hackery, it 
should, in principle, be possible to do the same in Haskell.  But it 
sure isn't as convenient!


This all points to some clear need for more ``flavours'' of polymorphism 
being needed (in Haskell), to be able to express *in the type system* 
what TH allows you to say outside.


Jacques
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Is Template Haskell a suitable macro language?

2007-04-24 Thread Josef Svenningsson

On 4/24/07, Jacques Carette [EMAIL PROTECTED] wrote:

In Ocaml, you can frequently use polymorphic variants to get the same
effect.

Which means that if you are willing to do enough type-class-hackery, it
should, in principle, be possible to do the same in Haskell.  But it
sure isn't as convenient!


You seem to imply that there is an encoding of polymorphic variants in
Haskell using type classes. While I know that it's possible to achieve
similar effects using type classes I haven't seen a direct encoding.
If there is such an encoding I would be very interested to hear about
it.


This all points to some clear need for more ``flavours'' of polymorphism
being needed (in Haskell), to be able to express *in the type system*
what TH allows you to say outside.


I totally agree with this.

Cheers,

Josef
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Is Template Haskell a suitable macro language?

2007-04-24 Thread Jacques Carette

Josef Svenningsson wrote:

On 4/24/07, Jacques Carette [EMAIL PROTECTED] wrote:

In Ocaml, you can frequently use polymorphic variants to get the same
effect.

Which means that if you are willing to do enough type-class-hackery, it
should, in principle, be possible to do the same in Haskell.  But it
sure isn't as convenient!


You seem to imply that there is an encoding of polymorphic variants in
Haskell using type classes. While I know that it's possible to achieve
similar effects using type classes I haven't seen a direct encoding.
If there is such an encoding I would be very interested to hear about
it.

As usual, look for a solution from Oleg:
http://www.haskell.org/pipermail/haskell/2006-July/018172.html

There was also a proposal by Koji Kagawa (published at Haskell '06)
http://portal.acm.org/citation.cfm?id=1159842.1159848coll=dl=ACMtype=seriesidx=1159842part=ProceedingsWantType=Proceedingstitle=HaskellCFID=15151515CFTOKEN=6184618

Jacques
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] faster factorial function via FFI?

2007-04-24 Thread Dan Weston
A thing of beauty is a joy forever. Simple, fast, elegant. If I learn 
any more from this list, someone is going to start charging me tuition! :)


Dan

[EMAIL PROTECTED] wrote:

G'day all.

Quoting Dan Weston [EMAIL PROTECTED]:


Why all the fuss? n! is in fact very easily *completely* factored into
prime numbers [...]


It's even easier than that.

primePowerOf :: Integer - Integer - Integer
primePowerOf n p
  = (n - s p n) `div` (p-1)
  where
s p 0 = 0
s p n = let (q,r) = n `divMod` p in s p q + r

factorisedFactorial :: Integer - [(Integer,Integer)]
factorisedFactorial n = [ (p, primePowerOf n p) | p - primesUpTo n ]

factorial :: Integer - Integer
factorial = product . zipWith (^) . factorisedFactorial

(Implement primesUpTo using your favourite prime sieve.)

Manipulating prime factors like this is sometimes MUCH faster than
computing products for this kind of combinatorial work, because Integer
division is quite expensive.

Cheers,
Andrew Bromage


___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] faster factorial function via FFI?

2007-04-24 Thread Bryan O'Sullivan

Dan Weston wrote:

A thing of beauty is a joy forever. Simple, fast, elegant.



factorial :: Integer - Integer
factorial = product . zipWith (^) . factorisedFactorial


Well... The zipWith (^) should be map (uncurry (^)).

And the performance of this approach is strongly dependent on the 
efficiency of your prime sieve, so you're moving the complexity around, 
not eliminating it.


The binary splitting method doesn't need a source of primes, and 
performs half decently on numbers such as fact 1e6 (5.5 million digits 
computed in about 5 seconds).


b
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Newbie seeking advice regarding data structure for a tricky algorithm

2007-04-24 Thread Tillmann Rendel

Hi,

Toby Hutton wrote:

Say I want to put the words 'foo', 'bar' and 'baz' into a binary tree.  The
heuristic requires I split the words into letters and sort them:
'aabbfoorz'.  The heuristic then may decide, based on the sorted letters,
that 'bar' and 'foo' should go in the left child and 'baz' goes in the
right.  Typically we'd then simply recurse and for example, the left 
child's

words would be re-sorted into 'abfoor' and the heuristic is reapplied.

If we assume that sorting is relatively expensive, we can avoid the re-sort
for the children by unmerging the parent's sorted list of letters.  Two
sublists of a sorted list should already be sorted.  If we know which word
each letter belongs to it would be more efficient to tag the letters with
'left' or 'right' as the words are classified.  Then we can iterate down 
the sorted letter list and  produce new sorted sublists rather simply.


So it's not actually that complicated, and I can imagine exactly how it
could be done in C but I really don't know how to approach this in Haskell.


What about just storing with each character a reference to the word it 
orignally comes from?



import Data.List (sortBy)

data Tagged = Tag String Char

tag :: Tagged - String
tag (Tag x _) = x
  
compareTagged :: Tagged - Tagged - Ordering

(Tag _ x) `compareTagged` (Tag _ y) = x `compare` y
  
tagWord :: String - [Tagged]

tagWord word = map (Tag word) word

unmerge :: [a] - (a - Bool) - ([a], [a])
unmerge xs p = foldr f ([], []) xs where
  f x (ls, rs) | p x = (x:ls, rs)
   | otherwise = (ls, x:rs)
   
data Tree = Empty | Leaf String | Node Tree Tree


tree :: ([Tagged] - String - Bool) - [String] - Tree
tree heuristic words = tree' words sorted where

  -- we only need to sort once ...
  sorted = sortBy compareTagged . concat . map tagWord $ words
  
  tree' [] _ = Empty

  tree' [word] _ = Leaf word
  
  tree' words sorted = let 
 predicate = heuristic sorted

 (leftWords, rightWords) = unmerge words predicate
 -- ... because we reuse the ordered list by unmerging it
 (leftSorted, rightSorted) = unmerge sorted (predicate . tag)
   in 
 Node (tree' leftWords leftSorted) (tree' rightWords rightSorted)


  Tillmann

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: Haskell version of Norvig's Python Spelling Corrector

2007-04-24 Thread Udo Stenzel
Bryan O'Sullivan wrote:
 Udo Stenzel wrote:
 
 There is another bug of this sort in your code.  Consider
 
 incWordCount w m = M.insertWith (+) w 1 m
 
 There is no reason to evaluate the sum inside the map, instead an
 unevaluated thunk is put in there.
 
 Would not Data.Map.insertWith' do the trick?

Oops, you're right, this is a fairly recent addition.  


-Udo
-- 
Walk softly and carry a BFG-9000.


signature.asc
Description: Digital signature
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] HXT namespace problem

2007-04-24 Thread Tim Walkenhorst



  runX $ constA (request TableListRequest)  root [] [writeA] 
writeDocument [(a_indent,v_1)] -


writeDocument [(a_indent,v_1), (a_check_namespaces, v_1)] -

should do the trick.

Cheers,
Tim

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] About functional programing, type theory and a master thesis topic

2007-04-24 Thread Glauber Cabral

Hi everybody =)
First time I write to the list.
My name is Glauber and I'm doing my master course at UNICAMP, Brazil,
under supervisor of Prof. Dr. Arnaldo Vieira Moura.

I'm interested in Haskell, type theory and algebraic specification
(formal methods). I've been studying these subjects to my
Computer-Science-Bachelor-degree-final work. It was an implementation
of an homomorphism between a little constructive algebraic
specification code (based mainly in Loeckx's Specification of Abstract
Data Types) and a Haskell code. SableCC was used as tool to implement
the interpreter because I've already used it before. One theme to work
one should be implementing this in Haskell itself, but  there is
already HasCASL.

I've already contacted the HasCASL professors and I'm reading more
about the project.
At the same time, I want to look for some theme under type theory, too.
The main concern about HasCASL is that I want to get in deep touch
with functional programming during my master thesis and I'm not sure
(yet) if studying HasCASL would get me there.

I've reading some papers about type theory and Haskell (mainly the
ones suggested in the haskell.org site) and as I could see the topics
are very interesting. I'm not sure, however, if there is something
that can be done in a 2-year-master course. Mainly, they propose new
extensions that have became new languages (Cayenne, Omega and
Epigram).

Other topic I'd like to get in touch is theorem proving. As I could
see, Coq and Isabelle are the most used with Haskell. Indeed, HasCASL
use Isabelle and this could be a nice thing to work on, as was
suggested by HasCASL professors.

As I know that lots of you here are researchers, I'd like to ask some
opinions about what can be done as a master thesis having in mind that
I want to continue in a PhD course after the master one.

Sorry if the email is too large. And thank for the patience and for
any opinion you can give me.

Yours,
Glauber.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] About functional programing, type theory and a master thesis topic

2007-04-24 Thread Stefan O'Rear
On Tue, Apr 24, 2007 at 09:25:55PM -0300, Glauber Cabral wrote:
 Hi everybody =)
 First time I write to the list.

http://haskell.org/pipermail/haskell-cafe/2007-April/024819.html
http://haskell.org/pipermail/haskell-cafe/2007-April/024867.html

(I am not a researcher and cannot comment on the rest of your post,
except to say that it is not too long.)


Stefan
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] About functional programing, type theory and a master thesis topic

2007-04-24 Thread Glauber Cabral

Hi =)
No problem!
And sorry by the duplicated post. I've had just checked my gmail and
the message was not there, 2 days after posting. I've sent again and
then there were 2 copies.
Cheers,
Glauber

On 4/24/07, Stefan O'Rear [EMAIL PROTECTED] wrote:

On Tue, Apr 24, 2007 at 09:25:55PM -0300, Glauber Cabral wrote:
 Hi everybody =)
 First time I write to the list.

http://haskell.org/pipermail/haskell-cafe/2007-April/024819.html
http://haskell.org/pipermail/haskell-cafe/2007-April/024867.html

(I am not a researcher and cannot comment on the rest of your post,
except to say that it is not too long.)


Stefan


___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] About functional programing, type theory and a master thesis topic

2007-04-24 Thread Stefan O'Rear
On Tue, Apr 24, 2007 at 09:58:01PM -0300, Glauber Cabral wrote:
 Hi =)
 No problem!
 And sorry by the duplicated post. I've had just checked my gmail and
 the message was not there, 2 days after posting. I've sent again and
 then there were 2 copies.
 Cheers,
 Glauber
 
 On 4/24/07, Stefan O'Rear [EMAIL PROTECTED] wrote:
 On Tue, Apr 24, 2007 at 09:25:55PM -0300, Glauber Cabral wrote:
  Hi everybody =)
  First time I write to the list.
 
 http://haskell.org/pipermail/haskell-cafe/2007-April/024819.html
 http://haskell.org/pipermail/haskell-cafe/2007-April/024867.html
 
 (I am not a researcher and cannot comment on the rest of your post,
 except to say that it is not too long.)
 
 
 Stefan
 

gmail is known to randomly eat posts from this list.

Stefan
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] faster factorial function via FFI?

2007-04-24 Thread ajb
G'day all.

Quoting Bryan O'Sullivan [EMAIL PROTECTED]:

 Well... The zipWith (^) should be map (uncurry (^)).

Err... yes.

 And the performance of this approach is strongly dependent on the
 efficiency of your prime sieve, so you're moving the complexity around,
 not eliminating it.

Yes and no.  Standard algorithms for computing and manipulating
combinatorial-sized Integers strongly depend on the properties of
your Integer implementation.

Manipulating lists of prime factors can also be more efficient,
because most of the numbers you deal with are machine-word-sized.

 The binary splitting method doesn't need a source of primes, and
 performs half decently on numbers such as fact 1e6 (5.5 million digits
 computed in about 5 seconds).

And on the other hand, if you're computing something other than just
a factorial (e.g. a complex combinatorial function, like the OP said),
prime factoring avoids large Integer divisions, which are often many
times more expensive than large Integer multiplications.

Cheers,
Andrew Bromage
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Is Excel a FP language?

2007-04-24 Thread Tony Morris
In a debate I proposed Excel is a functional language. It was refuted
and I'd like to know what some of you clever Haskellers might think :)

My opposition proposed (after some weeding out) that there is a
distinction between Excel, the application, the GUI and Excel, the
language (which we eventually agreed (I think) manifested itself as a
.xls file). Similarly, VB is both a language and a development
environment and referring to VB is a potential ambiguity. I disagree
with this analogy on the grounds that the very definition of Excel
(proposed by Microsoft) makes no distinction. Further, it is impossible
to draw a boundary around one and not the other.

I also pointed to the paper by Simon Peyton-Jones titled, Improving the
world's most popular functional language: user-defined functions in
Excel, which quite clearly refers to Excel as a [popular] functional
language.

The debate started when I referred to the fact that financial
institutions change their functional language from Excel to something
like OCaml or Haskell. Of course, there is no doubting that these
companies can replace their entire use of Excel with a functional
language, which I think is almost enough to fully support my position
(emphasis on almost).


-- 
Tony Morris
http://tmorris.net/

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] On reflection

2007-04-24 Thread Greg Meredith

Oleg, Simon,

Thanks for your help. If i understand it correctly, the code below gives a
reasonably clean first cut at a demonstration of process calculi as
polymorphically parametric in the type of name, allowing for an
instantiation of the type in which the quoted processes play the role of
name. This is much, much cleaner and easier to read than the OCaml version.

Best wishes,

--greg

{-# OPTIONS -fglasgow-exts -fallow-undecidable-instances #-}

module Core(
   Nominal
  ,Name
  ,Locality
  ,Location
  ,CoreProcessSyntax
  ,CoreAgentSyntax
  ,MinimalProcessSyntax
  ,MinimalAgentSyntax
  ,ReflectiveProcessSyntax
--   ,make_process
  )
   where

-- What's in a name?

class Nominal n where
  nominate :: i - n i

-- newtype Name i = Nominate i deriving (Eq, Show)
newtype Name i = Name i deriving (Eq, Show)

instance Nominal Name where nominate i = Name i

-- Where are we?

class Locality a where
  locate :: (Eq s, Nominal n) = s - (n i) - a s (n i)
  name :: (Eq s, Nominal n) = a s (n i) - (n i)

-- data Location s n = Locate s n deriving (Eq, Show)
data Location s n = Location s n deriving (Eq, Show)

instance Locality Location where
 locate s n = Location s n
 name (Location s n) = n


-- Constraints

class CoreProcessSyntax p a x | p - a x where
  zero :: p
  sequence :: a - x - p
  compose :: [p] - p

class CoreAgentSyntax x p n | x - p n where
  bind  :: [n] - p - x
  offer :: [n] - p - x

-- Freedom (as in freely generated)

data MinimalProcessSyntax l x =
   Null
   | Sequence l x
   | Composition [MinimalProcessSyntax l x]

data MinimalAgentSyntax n p =
   Thunk (() - p)
   | Abstraction ([n] - p)
   | Concretion [n] p

-- Responsibility : constraining freedom to enjoy order

instance CoreProcessSyntax (MinimalProcessSyntax l x) l x where
   zero = Null
   sequence l a = Sequence l a
   compose [] = zero
   compose ps = Composition ps

instance CoreAgentSyntax (MinimalAgentSyntax n p) p n where
   bind [] proc = Thunk (\() - proc)
--  -- TODO : lgm : need to substitute m for name in proc
   bind (name:names) proc = Abstraction (\m - comp $ bind names proc)
   where comp (Thunk fp) = fp ()
 -- comp (Abstraction abs) = abs name
   offer names proc = Concretion names proc

data ReflectiveProcessSyntax =
   Reflect
   (MinimalProcessSyntax
(Location [(Name ReflectiveProcessSyntax)] (Name
ReflectiveProcessSyntax))
(MinimalAgentSyntax (Name ReflectiveProcessSyntax)
ReflectiveProcessSyntax))

-- instance (CoreProcessSyntax p a x) =
-- CoreProcessSyntax
-- (MinimalProcessSyntax
--  (Location
--   [(Name (MinimalProcessSyntax a x))]
--   (Name (MinimalProcessSyntax a x)))
--  (MinimalAgentSyntax
--   (Name (MinimalProcessSyntax a x))
--   (MinimalProcessSyntax a x)))
-- (Location
--   [(Name (MinimalProcessSyntax a x))]
--   (Name (MinimalProcessSyntax a x)))
-- (MinimalAgentSyntax
--   (Name (MinimalProcessSyntax a x))
--   (MinimalProcessSyntax a x))

--
L.G. Meredith
Managing Partner
Biosimilarity LLC
505 N 72nd St
Seattle, WA 98103

+1 206.650.3740

http://biosimilarity.blogspot.com
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Is there a best *nix or BSD distro for Haskell hacking?

2007-04-24 Thread Grady Lemoine

I can confirm that, although before Ubuntu Feisty came out I just
compiled GHC 6.6 myself.  I was surprised how easy it was -- I had
heard building GHC was hard, but I guess that's only if you don't
already have a Haskell compiler.  I expect I'll probably be compiling
the newest version myself again once the features I'm missing out on
become important enough to me.

--Grady Lemoine

On 4/22/07, Ryan Dickie [EMAIL PROTECTED] wrote:

I'm running feisty.
 [EMAIL PROTECTED]:~$ ghc --version
 The Glorious Glasgow Haskell Compilation System, version 6.6

--ryan


On 4/22/07, Dougal Stanton [EMAIL PROTECTED] wrote:
 On 22/04/07, Ryan Dickie [EMAIL PROTECTED] wrote:

  Many of the haskell packages including darcs, ghc, and well over 100
other
  packages (mostly libraries) are in the package manager ready to be
  installed.

 The problem with Ubuntu (at least until the Feisty release a few days
 ago?) was that GHC wasn't up-to-date by default; it came with 6.4.
 Moving to 6.6 isn't a difficult feat (the generic binaries from the
 GHC site seem to work fine for Edgy, if you install libreadline too)
 but being behind that curve is noticeable. If you want to stay on the
 cutting edge Gentoo takes a lot of the hassle out of it, since you can
 use the repository stored on haskell.org. The downside is having to
 keep the rest of the system updated if you've got a slow machine.

 You pays your money, etc.

 D.
 ___
 Haskell-Cafe mailing list
 Haskell-Cafe@haskell.org
 http://www.haskell.org/mailman/listinfo/haskell-cafe



___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe



___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] faster factorial function via FFI?

2007-04-24 Thread Bryan O'Sullivan

[EMAIL PROTECTED] wrote:


Yes and no.  Standard algorithms for computing and manipulating
combinatorial-sized Integers strongly depend on the properties of
your Integer implementation.

Manipulating lists of prime factors can also be more efficient,
because most of the numbers you deal with are machine-word-sized.


Yep.  By the way, if approximations are good enough, the OP could use 
Gosper's formula:


gosper :: Integral a = a - a

gosper n | n  143 = let n' = fromIntegral n
 g = sqrt ((n' * 2 + 1/3) * pi)
   * n'**n' * exp (-n')
 in round g

The accuracy of this approximation increases with n, until you hit the 
ceiling of whatever your Double implementation can manage (142, typically).


b
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Is Excel a FP language?

2007-04-24 Thread Albert Y. C. Lai

Tony Morris wrote:

My opposition proposed (after some weeding out) that there is a
distinction between Excel, the application, the GUI and Excel, the
language (which we eventually agreed (I think) manifested itself as a
.xls file).


I say Excel is a functional language. If there needs to be the quoted 
distinction, fine: Excel the language is a functional language, and 
Excel the application is an interpreter of said language.


(Does the opposition self-consistently distinguish Perl the language 
from perl.exe the interpreter?)

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe