Re: [Haskell-cafe] What do you call Applicative Functor Morphism?

2010-11-06 Thread Sebastian Fischer

Hello,

I'm curious and go a bit off topic triggered by your statement:

On Nov 6, 2010, at 12:49 PM, rocon...@theorem.ca wrote:


An applicative functor morphism is a polymorphic function,
eta : forall a. A1 a - A2 a between two applicative functors A1 and  
A2 that preserve pure and *


I recently wondered: why morphism and not homomorphism?

Wikipedia says:

In abstract algebra, a homomorphism is a structure-preserving map  
between two algebraic structures


and

In mathematics, a morphism is an abstraction derived from structure- 
preserving mappings between two mathematical structures.


One difference is absract algebra ... algebraic structures vs  
mathematics ... mathematic structures another difference is the  
abstraction derived from part in the second phrase.


So for the `Monoid` class, I'd say monoid homomorphism but I'm  
unsure whether `Applicative` counts as an algebraic structure or calls  
for using morphism instead.


Is there a deeper reason why people use morphism and not  
homomorphism or is it just because it's shorter?


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


Re: [Haskell-cafe] What do you call Applicative Functor Morphism?

2010-11-06 Thread Dan Doel
On Saturday 06 November 2010 2:09:13 am Sebastian Fischer wrote:
 Is there a deeper reason why people use morphism and not
 homomorphism or is it just because it's shorter?

I don't really know. But that's (one) standard terminology in category theory. 
Objects and morphisms.

It may be due to there being multiple prefixes in category theory that you can 
add to that:

  isomorphism
  epimorphism
  monomorphism
  ...

In that light, it makes some sense to have the default be just morphism, 
rather than the additional homo- prefix.

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


Re: [Haskell-cafe] Compiler constraints in cabal

2010-11-06 Thread Reiner Pope
Ah, I hadn't thought of that. But doesn't the version of GHC change
much more often than the version of base does?

Reiner

On 6 November 2010 03:49, Ozgur Akgun ozgurak...@gmail.com wrote:
 AFAIK, the way to do this is putting constraints on the base package.

 On 5 November 2010 14:59, Reiner Pope reiner.p...@gmail.com wrote:

 Hi,

 I have a library, hmatrix-static, on Hackage. Version 0.3 (the current
 version) compiles with ghc-6.12.

 Let's say I want to upgrade my library using new features in ghc-7.0,
 and then release these upgrades as version 0.4. Is there any way to
 state in my cabal file that this new version will no longer compile
 under ghc-6.12? The reason I would like to state this is so that a
 user with ghc-6.12 can do 'cabal install hmatrix-static' (or do a
 cabal install of a program depending on hmatrix-static) and see that
 cabal will install version 0.3 rather than attempt to install version
 0.4 and fail.

 Thanks for your help.

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



 --
 Ozgur Akgun

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


Re: [Haskell-cafe] Compiler constraints in cabal

2010-11-06 Thread Ivan Lazar Miljenovic
On 6 November 2010 17:52, Reiner Pope reiner.p...@gmail.com wrote:
 Ah, I hadn't thought of that. But doesn't the version of GHC change
 much more often than the version of base does?

Each major version of GHC has a different (major) version of base.

I think you can also say stuff like ghc = 6.10, but I'm not sure.

-- 
Ivan Lazar Miljenovic
ivan.miljeno...@gmail.com
IvanMiljenovic.wordpress.com
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] vector-space and standard API for vectors

2010-11-06 Thread wren ng thornton

On 11/5/10 7:54 AM, Alexey Khudyakov wrote:



We already know that there are noncommutative modules/vectorspaces of
interest (e.g., modules over quaternions and modules over graph paths),
why not support them from the beginning? It seems like you're going out
of your way to exclude things that would be trivial to include. This is
exactly why this is my standard complaint against the various proposals
out there for new numeric hierarchies. People who are used to only using
R^n think the proposals are just fine, but none of the proposals capture
the structures I work with daily. Which means the new proposals are no
better than the Prelude for me.


Could you tell what data structures do you use? It's difficult to think
about them without concrete examples.


Data structures? That varies a lot depending on the task: Data.Map, 
Data.Set, Data.IntMap, Data.IntSet, Data.Trie, Data.ByteString...


A lot of my concrete examples of semirings and modules come from natural 
language processing tasks. One example I already mentioned is the 
semiring of a collection of paths over a graph (so something like 
Data.Set (Data.Seq Arc)). Path collections show up, for example, when 
dealing with Markov chains and HMMs where the goal is to maximize or sum 
the weights over all paths.


To make it clearer, a Markov chain is a probabilistic version of a 
finite state automaton, so you have some set of nodes, and the arcs for 
transitioning from one node to another have probabilistic weights on 
them. An HMM is an extension of a Markov chain into a probabilistic 
version of a Moore machine, so in addition to the probabilistic 
transitions from state to state, we also have for each state a 
probability distribution over emitted symbols.


An interesting problem for HMMs is this: given some observed sequence of 
emitted symbols, reconstruct the most likely path of states which would 
cause the symbol sequence to be emitted. A nearly identical problem is: 
given some observed sequence of symbols, determine the total probability 
of all state sequences which could have generated it.


In addition to the perspective of HMMs as probabilistic Moore machines, 
there are two other perspectives which are helpful. One is the graphical 
model perspective where we have something that looks a bit like this (in 
fixed-width font):


Q0 - Q1 - Q2 - ... - Qn
  | ||
  v vv
  S1S2   Sn

Each Sk and Qk are random variables. The random variables Qk represent 
being in some particular state q at time k, and the choice of which 
state is drawn from a probability distribution based on the state 
Q(k-1). The random variables Sk represent emitting some particular 
symbol s at time k, and the choice of which symbol is drawn from a 
distribution based on the state Qk.


The third perspective, which is the most helpful one for solving our two 
problems, is if we take this graphical model and unfold it into a 
trellis graph (ignoring the Sk variables for now). Each node in the 
trellis represents an assignment of particular values to each of the 
random variables. So if Q1 could take on values qA, qB, and qC then we'd 
have three nodes for each of Q1=qA, Q1=qB, and Q1=qC. The arcs in the 
trellis are weighted with the probability of transitioning from one node 
to the next; so an arc Q1=q1 - Q2=q2 has weight Pr(Q2=q2 | Q1=q1). A 
path through the trellis represents a variable assignment, which is to 
say a sequence of states in the Markov chain; and the weight of the path 
is the probability of the Markov chain taking that path.


There is a general algorithm for solving the two problems I mentioned, 
and ultimately they're the same algorithm except with different 
semirings. Note that a collection of paths between two points on a graph 
forms a semiring[1] where sum is the union of path collections and 
product is the extension of paths[2], so the answers we want can be 
gotten by semiring homomorphisms from the collection of paths to some 
other domain. To get the probability of all state sequences which could 
give rise to a given symbol sequence we can use the probability 
semiring[3] ---which we can simplify to the metric space [0..1] with (+) 
and (*), since the algorithm ensures that all events are disjoint. This 
version is called the forward algorithm. To get the probability the 
most likely state sequence we can use the semiring [0..1] with max and 
(+), which is called the Viterbi algorithm. In practice we tend to use 
the log version of these semirings in order to prevent underflow. 
There's also a variant of the Viterbi algorithm which stores 
backpointers to the most likely previous state, which makes it easier to 
recover the most likely state sequence instead of just the 
(log)probability of the sequence. The Viterbi algorithm with back 
pointers is also a semiring: Maybe(Prob, Maybe State) with Nothing as 
zero, Just(1,Nothing) as one, argmax as sum: mx+my = do { 

Re: Re[2]: [Haskell-cafe] Most popular haskell applications

2010-11-06 Thread Stephen Tetley
Hi Bulat

Doesn't your own FreeArc do pretty well? Its appealing to an audience
beyond programmers.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Most popular haskell applications

2010-11-06 Thread Tillmann Rendel

Ivan Lazar Miljenovic wrote:


Bulat Ziganshin wrote:


people, are you know haskell apps that has more than 50k downloads per
month (or more than 25k users) ?


Possible candidates:

* GHC

* XMonad

* Darcs


* Pandoc

I have no idea how to measure number of downloads or users, but pandoc 
is used outside of the Haskell community. (And it can process this email).


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


Re: [Haskell-cafe] What do you call Applicative Functor Morphism?

2010-11-06 Thread wren ng thornton

On 11/6/10 2:09 AM, Sebastian Fischer wrote:

Hello,

I'm curious and go a bit off topic triggered by your statement:

On Nov 6, 2010, at 12:49 PM, rocon...@theorem.ca wrote:


An applicative functor morphism is a polymorphic function,
eta : forall a. A1 a - A2 a between two applicative functors A1 and
A2 that preserve pure and *


I recently wondered: why morphism and not homomorphism?


Indeed, for the present example I'd call eta an applicative-functor 
homomorphism[1].


The use of morphism in category theory originated as a shortening of 
homomorphism[2], though there is a semantic difference between them as 
the two terms are used today. A morphism is an arrow in any particular 
category. What it takes to be morphism in category, C, depends on which 
category C happens to be. It turns out that many of the algebraic 
constructs studied outside of category theory form categories where the 
objects are particular constructs (e.g., specific rings, groups,...) and 
the morphisms are the appropriate homomorphisms (e.g., ring 
homomorphisms, group homomorphisms,...). Thus, the term homomorphism 
has to do with particular kinds of structure preserving transformations 
that are discussed in the underlying theories, whereas morphism is a 
general term in category theory used as a metatheory.



[1] Assuming the context presented in the original email. In other 
contexts I may refer to eta as an Applicative morphism (i.e., a morphism 
in the category whose objects are Applicative instances) or as an 
Applicative transformation (i.e., a natural transformation between 
Applicative instances viewed as functors).


[2] Whence the use of Hom(A,B) to refer to the collection of morphisms 
from A to B, and related terms like hom-set and hom-functor.


--
Live well,
~wren
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Compiler constraints in cabal

2010-11-06 Thread wren ng thornton

On 11/6/10 3:13 AM, Ivan Lazar Miljenovic wrote:

On 6 November 2010 17:52, Reiner Popereiner.p...@gmail.com  wrote:

Ah, I hadn't thought of that. But doesn't the version of GHC change
much more often than the version of base does?


Each major version of GHC has a different (major) version of base.

I think you can also say stuff like ghc= 6.10, but I'm not sure.


The correct condition notation is: impl(ghc = 6.10)

--
Live well,
~wren
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Finding the contents of haskell platform?

2010-11-06 Thread Andrew Coppin

On 05/11/2010 09:05 PM, Stephen Tetley wrote:

On 5 November 2010 20:08, Andrew Coppinandrewcop...@btinternet.com  wrote:


Would it be hard to replace - with a real Unicode arrow character?


It should be quite easy - whether a given font has an arrow readily
available is a different matter.


I can't remember the last time I saw a browser that couldn't do this. 
There /are/ symbols that don't work reliably, but the basic arrow 
symbols seem to be pretty well supported.


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


Re: [Haskell-cafe] Compiler constraints in cabal

2010-11-06 Thread Reiner Pope
I was aware of this condition, but I'm not precisely sure it addresses
my requirements. When you run cabal install some-package, cabal
reads all version constraints listed in the build-depends field, and
chooses which versions of which packages to download from Hackage in
order to satisfy these constraints.

I want to expose my dependency on a particular version of ghc to
cabal's constraint satisfier. The end result I want is that when you
type cabal install hmatrix-static with ghc-6.12 installed, then
cabal chooses hmatrix-static-0.3; and when you type cabal install
hmatrix-static with ghc-7.0 installed, then cabal chooses
hmatrix-static-0.4.

As I understand it, using impl(ghc = 7.0) won't achieve this.

The closest thing I can think of is to write my hmatrix-static.cabal
file for version 0.4 as:

 ...
 if impl(ghc  7.0)
build-depends: nonexistant-package
 ...

so that cabal cannot satisfy the constraints for hmatrix-static-0.4
unless I have ghc = 7.0.

This seems a little hacky, and I'm also not sure if it works. (I'm
finding it rather hard to test these ideas, because I don't want to
upload a new package to Hackage every time...)

All the best,
Reiner

On 6 November 2010 19:24, wren ng thornton w...@freegeek.org wrote:
 On 11/6/10 3:13 AM, Ivan Lazar Miljenovic wrote:

 On 6 November 2010 17:52, Reiner Popereiner.p...@gmail.com  wrote:

 Ah, I hadn't thought of that. But doesn't the version of GHC change
 much more often than the version of base does?

 Each major version of GHC has a different (major) version of base.

 I think you can also say stuff like ghc= 6.10, but I'm not sure.

 The correct condition notation is: impl(ghc = 6.10)

 --
 Live well,
 ~wren
 ___
 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] Finding the contents of haskell platform?

2010-11-06 Thread Stephen Tetley
On 6 November 2010 09:52, Andrew Coppin andrewcop...@btinternet.com wrote:

 I can't remember the last time I saw a browser that couldn't do this. There
 /are/ symbols that don't work reliably, but the basic arrow symbols seem to
 be pretty well supported.

Okay I'll shift my position a bit...

Arrows are likely present in a modern system font. Outside the
Symbol font, they aren't a standard symbol in PostScript and the font
standards are based on PostScript - OpenType being the latest though
it has less PostScript than its predecessors. But fonts are still
quite a different beast to Unicode. So fonts are completely free not
to define arrows or most other symbols, however it seems that standard
system fonts e.g Arial, Times New Roman on Windows define them.
There's no guarantee they will be present in the standard system fonts
on old systems or in non-system fonts that define whichever symbols
the font designer feels necessary.

Modern browsers might add in arrow from a different font if it is not
present in the one chosen by the web page author - I suspect this is
happening on this page where the arrow looks wrong typographically:

http://conal.net/blog/posts/adding-numbers/
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Flagstone problem

2010-11-06 Thread Brent Yorgey
On Thu, Nov 04, 2010 at 10:50:06AM -0700, michael rice wrote:
 Hi,
 
 I've been looking at a flagstone problem, where no two adjacent
 n-tuples can be identical. I solved the problem with Icon using

Interesting stuff!

 
 = Here's my Haskell code 
 
 import Data.Bits
 import Data.List
 
 flagstone n =  foldl (++)  (take n (map show (f $ group [if even y
 then 0 else 1 | y - [bitcount x  | x - [20..]]])))

By the way, I would write this as

flagstone n = concat . take n . map show . f . group 
. map (fromEnum . odd . bitcount) $ [20..]

You should never use foldl (++) as it is rather inefficient: you get
things like (((a ++ b) ++ c) ++ d) ... which ends up traversing the
left part of the list repeatedly.  And list comprehensions can be nice
at times, but personally using map seems clearer in this case.

 = My question 
 
 A further exercise in the text:
 
 Exercise 5.-(a) Define a(n) as the sum of the binary
 digits in the binary representation of n. Define b(i) as
 the number of a's between successive zeros as before.
 Then T = b(1) b(2) b(3) b(4) ... gives an infinite
 sequence of *seven* symbols with no repeats. (b) Write
 a routine to generate a sequence for seven colors of
 beads on a string with no repeats.
 
 I may be misreading, but does this make any sense?

Doesn't make much sense to me.  The sum of binary digits in the binary
representation of n will not be zero very often... 

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


Re: [Haskell-cafe] What do you call Applicative Functor Morphism?

2010-11-06 Thread Ross Paterson
On Fri, Nov 05, 2010 at 11:49:27PM -0400, rocon...@theorem.ca wrote:
 An applicative functor morphism is a polymorphic function,
 eta : forall a. A1 a - A2 a between two applicative functors A1 and
 A2 that preserve pure and *:
 
 eta (pure c) = pure c
 eta (f * x) = eta f * eta x
 
 What do you guys call such a thing?  My leading candidate is
 idomatic transformation.

An applicative functor is a functor with some extra structure.  Such a
function is a natural transformation between the underlying functors
that preserves the extra structure.  So applicative transformation
seems a logical name.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] hmatrix's fitModel function crashes ghc(i)

2010-11-06 Thread Roel van Dijk
Hello,

I would like to use hmatrix to do some function fitting with the
Levenberg Marquardt algorithm. As an example I would like to fit the
very simple function f x = a*x + b on some data points. The problem
is that executing the 'fitModel' function crashes GHC(i) with a
segmentation fault. This makes debugging difficult. Can anyone spot
what I am doing wrong? Given all the lists of Double's it seems very
easy to make an error regarding the number of arguments with the model
function or the derivative.

Try to evaluate the 'test' function in the small program listed below.
I would expect an output of [1, 0] (y = 1*x + 0) instead of a
segmentation fault.

Relevant versions:
 - hmatrix-0.10.0.0
 - gsl-1.14
 - ghc-6.12.3 (64 bit)


Small program:

module Test where

-- from base:
import Control.Arrow ( second )
import Control.Applicative   ( pure )

-- from hmatrix:
import Data.Packed.Matrix( Matrix )
import Numeric.GSL.Fitting   ( FittingMethod(LevenbergMarquardt), fitModel )


-- input list of (x, y) pairs, output coefficients of f x = a x * b
fitLinear :: [(Double, Double)] - ([Double], Matrix Double)
fitLinear samples = fitModel 1
 1
 10
 (linearModel, linearDer)
 (map (second pure) samples)
 [0, 0]

linearModel :: [Double] - Double - [Double]
linearModel [a, b] x = [a*x + b, 0]
linearModel _  x = error wrong arguments

linearDer :: [Double] - Double - [[Double]]
linearDer [_, _] x = [[x, 0]]
linearDer _  _ = error wrong arguments

test = fitLinear [(0,0), (1,1), (2,2)]
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] How to put a string into Data.Binary.Put

2010-11-06 Thread C K Kashyap
Hi,
I was trying to put a String in a ByteString

import qualified Data.ByteString.Lazy as BS
message :: BS.ByteString
message = runPut $ do
  let string=SOME STRING
  map (putWord8.fromIntegral.ord)
string  -- this ofcourse generates [Put]

How can I convert the list of Put's such that it could be used in the Put monad?

For now I used the workaround of first converting the string to
ByteString like this -

stringToByteString :: String - BS.ByteString
stringToByteString str = BS.pack (map (fromIntegral.ord) str)

and then using putLazyByteString inside the Put monad.

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


[Haskell-cafe] Re: Review request for my baby steps towards a platform independent interactive graphics using VNC

2010-11-06 Thread C K Kashyap
I've progressed further - now the VNC client opens up a window with
the dimensions set in the code!

https://github.com/ckkashyap/LearningPrograms/blob/master/Haskell/vnc/vnc.hs


I've pasted the code here for quick reference - would really
appreciate some feedback.

module Main where

import Network.Server
import Network.Socket
import Control.Monad
import System.IO

import qualified Data.ByteString.Lazy as BS
import Data.Char
import Data.Binary.Get
import Data.Binary.Put
import Data.Word


main :: IO ()
main = do
running - serveOne (Just $ UserWithDefaultGroup ckk) server
putStrLn server is accepting connections!!!
waitFor running

where server = Server (SockAddrInet 5901 iNADDR_ANY) Stream doVNC


doVNC :: ServerRoutine
doVNC (h,n,p) = do startRFB h


startRFB :: Handle - IO ()
startRFB h = do
hPutStr h RFB 003.003\n
hFlush h

clientHeaderByteStream - BS.hGet h 12
putStrLn (show clientHeaderByteStream)
let (m,n) = ( runGet readClientHeader clientHeaderByteStream)

-- Send 1 to the client, meaning, no auth required
BS.hPutStr h (BS.pack [0,0,0,1])
hFlush h

clientInitMessage - BS.hGet h 1

let sharedOrNot = runGet (do {x-getWord8;return(x);}) 
clientInitMessage

putStrLn (show sharedOrNot)


BS.hPutStr h serverInitMessage
hFlush h






serverInitMessage :: BS.ByteString
serverInitMessage = runPut $ do
putWord16be (300::Word16) -- width
putWord16be (300::Word16) -- height
--pixel format
putWord8 (32::Word8) -- bits per pixl
putWord8 (24::Word8) -- depth
putWord8 (1::Word8) -- big endian
putWord8 (1::Word8) -- true color
putWord16be (255::Word16) -- red max
putWord16be (255::Word16) -- green max
putWord16be (255::Word16) -- blue max
putWord8 (24::Word8) -- red shift
putWord8 (1::Word8)  -- green shift
putWord8 (1::Word8)  -- blue shift
--padding
putWord8 (0::Word8)
putWord8 (0::Word8)
putWord8 (0::Word8)
--name length
let name = Haskell Framebuffer
putWord32be (((fromIntegral.length) 
name)::Word32)
putLazyByteString (stringToByteString name)




byteString2Number :: BS.ByteString - Int
byteString2Number bs = _byteString2Number 1 (digits bs)
where
_byteString2Number _ [] = 0
_byteString2Number n (x:xs) = (n*x) + (_byteString2Number 
(n*10) xs)
digits bs = map ((+(-48)).fromIntegral) (BS.unpack(BS.reverse 
bs))


readClientHeader  = do
getLazyByteString 4
m - getLazyByteString 3
getWord8
n - getLazyByteString 3
getWord8
let majorVersionNumber = byteString2Number m
let minorVersionNumber = byteString2Number n
if (majorVersionNumber /= 3) then
fail (ERROR: Unsupported version  ++ (show 
majorVersionNumber))
else
return (byteString2Number m,byteString2Number n)



word8ToByteString :: Word8 - BS.ByteString
word8ToByteString n = runPut $ putWord8 n

word16ToByteString :: Word16 - BS.ByteString
word16ToByteString n = runPut $ putWord16be n


word32ToByteString :: Word32 - BS.ByteString
word32ToByteString n = runPut $ putWord32be n


stringToByteString :: String - BS.ByteString
stringToByteString str = BS.pack (map (fromIntegral.ord) str)




On Thu, Nov 4, 2010 at 12:18 PM, C K Kashyap ckkash...@gmail.com wrote:
 Hi,

 I started with the implementation of a VNC server library intended to
 be used as a library for rendering graphics and interacting with the
 user(mouse/keyboard). I'd appreciate it very much if I could  get some
 feedback on my approach to binary parsing and Haskellism.
 Also, any reference/suggestion on how I could go about using a state
 machine to deal with the RFB protocol.

 http://hpaste.org/41131/vnc_server

 It's really early - but just wanted to get some advice on the approach.

 --
 Regards,
 Kashyap




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


Re: [Haskell-cafe] How to put a string into Data.Binary.Put

2010-11-06 Thread Daniel Fischer
On Saturday 06 November 2010 13:30:45, C K Kashyap wrote:
 Hi,
 I was trying to put a String in a ByteString

 import qualified Data.ByteString.Lazy as BS
 message :: BS.ByteString
 message = runPut $ do
   let string=SOME STRING
   map (putWord8.fromIntegral.ord)
 string  -- this ofcourse generates [Put]

You'd want

mapM_ (putWord8 . fromIntegral . ord)


 How can I convert the list of Put's such that it could be used in the
 Put monad?

sequence_ :: Monad m = [m a] - m ()

if you want to use the results of the monadic actions,

sequence :: Monad m = [m a] - m [a]

Often sequence and sequence_ are used for list resulting from a map, so 
there's

mapM_ :: Monad m = (a - m b) - [a] - m ()
mapM_ f xs = sequence_ (map f xs)

mapM :: Monad m = (a - m b) - [a] - m [b]
mapM f xs = sequence (map f xs)


 For now I used the workaround of first converting the string to
 ByteString like this -

 stringToByteString :: String - BS.ByteString
 stringToByteString str = BS.pack (map (fromIntegral.ord) str)

 and then using putLazyByteString inside the Put monad.

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


[Haskell-cafe] ANNOUNCE: arrow-list. List arrows for Haskell.

2010-11-06 Thread Sebastiaan Visser
Hi all,

Live from the Hackaton in Ghent, Belgium, I present the first release of the 
arrow-list[1,2] package. List arrows are a powerful tool when processing XML, 
building query languages and lots of other domains that build on functions that 
might return more than one value as their output.

This package is inspired by the arrow combinators provided by the HXT package, 
but in my opinion list arrows deserve to be on Hackage on their own.

Cheers,
Sebastiaan

[1] http://hackage.haskell.org/package/arrow-list
[2] https://github.com/sebastiaanvisser/arrow-list




(package description)


List arrows for Haskell.

This small Haskell library provides some type class, types and functions to
work with list arrows. List arrows represent computations that may return
multiple outputs. Making functions that return lists an instance of both the
`Category` and `Arrow` type classes allow you to easily compose multiple
computations into one with standard building blocks.

This package provides:

  - A type class `ArrowList` for embedding functions that produce a list of
outputs into _some_ list arrow.
 
  - A list of utility functions for working with list-arrows, these functions
are based on the `ArrowList` type class so they are not tied one specific
instance.

  - A concrete list arrow type that is implemented as a `Kleisli` arrow over
the `ListT` list monad transformer. In short, you can both build pure list
arrows and list arrows that produce tributary effects.

  - Not list arrow specific: A type class `ArrowKleisli` for embedding monadic
computations into an arrow.


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


Re: [Haskell-cafe] How to put a string into Data.Binary.Put

2010-11-06 Thread C K Kashyap
Thanks a lot Gregory and Daniel,

I think I'll go with the mapM_ (putWord8 . fromIntegral . ord) approach.

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


[Haskell-cafe] Packagse for a simple database application

2010-11-06 Thread jean-christophe mincke
Hello Cafe,

More as an exercice than anything else I would like to write a small
database application which would allow a user to read/write data from/to a
DB.
The user would interact with the application via a web browser.

Which (reliable/stable/workable) packages are the best for this task? I was
thinking of Happstack and HaskellDB. Any others?

Thank you

Regards

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


Re: [Haskell-cafe] What do you call Applicative Functor Morphism?

2010-11-06 Thread roconnor

On Sat, 6 Nov 2010, Sebastian Fischer wrote:


Hello,

I'm curious and go a bit off topic triggered by your statement:

On Nov 6, 2010, at 12:49 PM, rocon...@theorem.ca wrote:


An applicative functor morphism is a polymorphic function,
eta : forall a. A1 a - A2 a between two applicative functors A1 and A2 
that preserve pure and *


I recently wondered: why morphism and not homomorphism?


Morphisms can be more general than homomorphisms.  But in this case I mean 
the morphisms which are homomorphisms.  I was too lazy to write out the 
whole word.


--
Russell O'Connor  http://r6.ca/
``All talk about `theft,''' the general counsel of the American Graphophone
Company wrote, ``is the merest claptrap, for there exists no property in
ideas musical, literary or artistic, except as defined by statute.''
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] How to put a string into Data.Binary.Put

2010-11-06 Thread John Millikin
Use one of the Char8 modules, depending on whether you want a strict
or lazy bytestring:

---
import qualified Data.ByteString.Lazy.Char8 as BS

message :: BS.ByteString
message = BS.pack SOME STRING
---

See the docs at:

http://hackage.haskell.org/packages/archive/bytestring/0.9.1.7/doc/html/Data-ByteString-Char8.html
http://hackage.haskell.org/packages/archive/bytestring/0.9.1.7/doc/html/Data-ByteString-Lazy-Char8.html

mapping over putWord8 is much slower than putting a single bytestring;
if you want to put a string, pack it first:

---
putString :: String - Put
putString str = putLazyByteString (BS.pack str)

-- alternative: probably faster

import qualified Data.ByteString.Char8 as B

putString :: String - Put
putString str = putByteString (B.pack str)
---


On Sat, Nov 6, 2010 at 05:30, C K Kashyap ckkash...@gmail.com wrote:
 Hi,
 I was trying to put a String in a ByteString

 import qualified Data.ByteString.Lazy as BS
 message :: BS.ByteString
 message = runPut $ do
                                  let string=SOME STRING
                                  map (putWord8.fromIntegral.ord)
 string  -- this ofcourse generates [Put]

 How can I convert the list of Put's such that it could be used in the Put 
 monad?

 For now I used the workaround of first converting the string to
 ByteString like this -

 stringToByteString :: String - BS.ByteString
 stringToByteString str = BS.pack (map (fromIntegral.ord) str)

 and then using putLazyByteString inside the Put monad.

 --
 Regards,
 Kashyap
 ___
 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] Flagstone problem

2010-11-06 Thread michael rice
Hi Brent,

Efficiency aside, your code is definitely more readable.  I flubbed that step 
from True/False to 0/1 using fromEnum. Haskell's grab bag has so many tools 
it's easy to omit one.

Thanks,

Michael


--- On Sat, 11/6/10, Brent Yorgey byor...@seas.upenn.edu wrote:

From: Brent Yorgey byor...@seas.upenn.edu
Subject: Re: [Haskell-cafe] Flagstone problem
To: haskell-cafe@haskell.org
Date: Saturday, November 6, 2010, 7:03 AM

On Thu, Nov 04, 2010 at 10:50:06AM -0700, michael rice wrote:
 Hi,
 
 I've been looking at a flagstone problem, where no two adjacent
 n-tuples can be identical. I solved the problem with Icon using

Interesting stuff!

 
 = Here's my Haskell code 
 
 import Data.Bits
 import Data.List
 
 flagstone n =  foldl (++)  (take n (map show (f $ group [if even y
 then 0 else 1 | y - [bitcount x  | x - [20..]]])))

By the way, I would write this as

flagstone n = concat . take n . map show . f . group 
            . map (fromEnum . odd . bitcount) $ [20..]

You should never use foldl (++) as it is rather inefficient: you get
things like (((a ++ b) ++ c) ++ d) ... which ends up traversing the
left part of the list repeatedly.  And list comprehensions can be nice
at times, but personally using map seems clearer in this case.

 = My question 
 
 A further exercise in the text:
 
 Exercise 5.-(a) Define a(n) as the sum of the binary
 digits in the binary representation of n. Define b(i) as
 the number of a's between successive zeros as before.
 Then T = b(1) b(2) b(3) b(4) ... gives an infinite
 sequence of *seven* symbols with no repeats. (b) Write
 a routine to generate a sequence for seven colors of
 beads on a string with no repeats.
 
 I may be misreading, but does this make any sense?

Doesn't make much sense to me.  The sum of binary digits in the binary
representation of n will not be zero very often... 

-Brent
___
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] http://functionalley.eu

2010-11-06 Thread Alistair Ward
I've just written a few packages which I think may be useful, and have
made them available as free opensource on a personal website
http://functionalley.eu.
I opted to host them there rather than  uploading them to Hackage,
because they're part of a wider project.
The main offerings are; a regex-engine which is polymorphic in terms of
the type of the input-data, a traditional character-based regex-engine
derived from it, and an application to determine the most efficient
order in which to pack files into a given storage-space.

I understand this isn't the ideal venue in which announce new packages,
but having looked briefly at the hask...@haskell.org mail-group and
the cerebral offerings there, I'm rather concerned that my meagre
offerings may resemble germs in a Dettol factory. Is there a more
appropriate forum ?

If anyone has the time, I'd also greatly appreciate any feedback on this
s/w.

Regards,
Alistair Ward

P.S. This is my first posting.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] http://functionalley.eu

2010-11-06 Thread Don Stewart
haskellcafe:
 I've just written a few packages which I think may be useful, and have made
 them available as free opensource on a personal website 
 http://functionalley.eu

Wonderful, thank you!

 I opted to host them there rather than  uploading them to Hackage, because
 they're part of a wider project.

Note that this means they won't be cabal installable or searchable. Was
that your intention?

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


Re: [Haskell-cafe] http://functionalley.eu

2010-11-06 Thread Miguel Mitrofanov
Black letters over dark blue background hurt my eyes.

On 6 Nov 2010, at 18:10, Alistair Ward wrote:

 I've just written a few packages which I think may be useful, and have made 
 them available as free opensource on a personal website 
 http://functionalley.eu.
 I opted to host them there rather than  uploading them to Hackage, because 
 they're part of a wider project.
 The main offerings are; a regex-engine which is polymorphic in terms of the 
 type of the input-data, a traditional character-based regex-engine derived 
 from it, and an application to determine the most efficient order in which to 
 pack files into a given storage-space.
 
 I understand this isn't the ideal venue in which announce new packages, but 
 having looked briefly at the hask...@haskell.org mail-group and the 
 cerebral offerings there, I'm rather concerned that my meagre offerings may 
 resemble germs in a Dettol factory. Is there a more appropriate forum ?
 
 If anyone has the time, I'd also greatly appreciate any feedback on this s/w.
 
 Regards,
 Alistair Ward
 
 P.S. This is my first posting.
 ___
 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] http://functionalley.eu

2010-11-06 Thread Claus Reinke
I opted to host them there rather than  uploading them to Hackage, 
because

they're part of a wider project.


Note that this means they won't be cabal installable or searchable. Was
that your intention?


I am curious about this: wasn't cabal designed with the
option of having several package repos in mind?

   please clarify/document --remote-repo
   http://hackage.haskell.org/trac/hackage/ticket/759

Claus


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


Re: [Haskell-cafe] http://functionalley.eu

2010-11-06 Thread Don Stewart
claus.reinke:
 I opted to host them there rather than  uploading them to Hackage,  
 because
 they're part of a wider project.

 Note that this means they won't be cabal installable or searchable. Was
 that your intention?

 I am curious about this: wasn't cabal designed with the
 option of having several package repos in mind?

please clarify/document --remote-repo
http://hackage.haskell.org/trac/hackage/ticket/759


It supports remote Hackage repositories -- not arbitrary URLs (though
that is planned). Search won't work though.

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


Re: [Haskell-cafe] How to put a string into Data.Binary.Put

2010-11-06 Thread Gregory Crosswhite

On 11/6/10 6:38 AM, C K Kashyap wrote:

Thanks a lot Gregory and Daniel,

I think I'll go with the mapM_ (putWord8 . fromIntegral . ord) approach.



If your string has any chance of containing Unicode characters then you 
will want to use the encode function in the module 
Codec.Binary.UTF8.String in the package utf8-string, so that the 
code becomes


mapM_ putWord8 . encode

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


Re: [Haskell-cafe] Flagstone problem

2010-11-06 Thread Alexander Solla


On Nov 6, 2010, at 4:03 AM, Brent Yorgey wrote:


Doesn't make much sense to me.  The sum of binary digits in the binary
representation of n will not be zero very often...


I think they mean the sum (mod 2) when they say the sum of binary  
digits.  That should be zero half the time.

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


Re: [Haskell-cafe] Finding the contents of haskell platform?

2010-11-06 Thread Alexander Solla


On Nov 6, 2010, at 3:56 AM, Stephen Tetley wrote:


Modern browsers might add in arrow from a different font if it is not
present in the one chosen by the web page author - I suspect this is
happening on this page where the arrow looks wrong typographically:


I don't think that's what's going on.  Notice that the font used in  
that page is fixed width.  The arrow looks wrong because it has to fit  
in a fixed width space.  Fixed width arrows all look stubby, even if  
they are styled like the rest of the font.


Very few programming fonts have arrows or other symbols.  When I  
played around with UnicodeSyntax, I tried lots of different fonts.   
The only one I found that is halfway readable is GNU Unifont (at  
unifoundry.com)

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


Re: [Haskell-cafe] Finding the contents of haskell platform?

2010-11-06 Thread Stephen Tetley
On 6 November 2010 18:01, Alexander Solla a...@2piix.com wrote:

 On Nov 6, 2010, at 3:56 AM, Stephen Tetley wrote:

 Modern browsers might add in arrow from a different font if it is not
 present in the one chosen by the web page author - I suspect this is
 happening on this page where the arrow looks wrong typographically:

 I don't think that's what's going on.  Notice that the font used in that
 page is fixed width.  The arrow looks wrong because it has to fit in a fixed
 width space.  Fixed width arrows all look stubby, even if they are styled
 like the rest of the font.


Yes - I expect I'm wrong on that, although I'd say the arrow looks
wrong because its too low.

I thought I read that Firefox does a font swap if it can't find a
glyph, but thinking about it myself I can't see that this would make
sense - Firefox would have to know an awful lot about the OSes fonts
to know if they have missing glyphs.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Re: http://functionalley.eu

2010-11-06 Thread Maciej Piechotka
On Sat, 2010-11-06 at 15:10 +, Alistair Ward wrote:
 I opted to host them there rather than  uploading them to Hackage,
 because they're part of a wider project.

You can upload to hackage packages hosted (like webpage, code repo, bug
tracker...) elsewhere - it similar to Ubuntu (or insert your favourite
distro here) containing packages for KDE while not hosting KDE.

Regards


signature.asc
Description: This is a digitally signed message part
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: http://functionalley.eu

2010-11-06 Thread Alistair Ward
Thanks for the feedback.

That sounds interesting.
I've not uploaded anything to hackage before, so perhaps such features
will become more obvious after I've had a go.

On Sat, 2010-11-06 at 18:19 +, Maciej Piechotka wrote:
 On Sat, 2010-11-06 at 15:10 +, Alistair Ward wrote:
  I opted to host them there rather than  uploading them to Hackage,
  because they're part of a wider project.
 
 You can upload to hackage packages hosted (like webpage, code repo, bug
 tracker...) elsewhere - it similar to Ubuntu (or insert your favourite
 distro here) containing packages for KDE while not hosting KDE.
 
 Regards
 ___
 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] Flagstone problem

2010-11-06 Thread michael rice
Hi, Alexander

Your change produces the same sequence of 0s, 1s, and 2s.

mod n 2 == fromEnum (even n)

Michael


--- On Sat, 11/6/10, Alexander Solla a...@2piix.com wrote:

From: Alexander Solla a...@2piix.com
Subject: Re: [Haskell-cafe] Flagstone problem
To: 
Cc: haskell-cafe Cafe haskell-cafe@haskell.org
Date: Saturday, November 6, 2010, 1:40 PM


On Nov 6, 2010, at 4:03 AM, Brent Yorgey wrote:

 Doesn't make much sense to me.  The sum of binary digits in the binary
 representation of n will not be zero very often...

I think they mean the sum (mod 2) when they say the sum of binary digits.  
That should be zero half the time.
___
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] internship opportunities in France

2010-11-06 Thread Lorenzo Fundaró
Hello folks !
I am a Computer Science student looking for an internship of 6 months here
in France. Does anybody know of any company working with Haskell ?
Thanks in advance :D,

Lorenzo Fundaró García
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Re: hmatrix's fitModel function crashes ghc(i)

2010-11-06 Thread Alberto Ruiz

Hello Roel,

Roel van Dijk wrote:

Hello,

I would like to use hmatrix to do some function fitting with the
Levenberg Marquardt algorithm. As an example I would like to fit the
very simple function f x = a*x + b on some data points. The problem
is that executing the 'fitModel' function crashes GHC(i) with a
segmentation fault.


Can you reproduce it on a 32 bit machine?

There is a known problem with some hmatrix GSL wrappers on 64 bit in 
interpreted mode. This is mentioned at the end of the install page:


http://code.haskell.org/hmatrix/install.html

In this case the segmentation fault happens inside a foreign GSL 
function, only in interpreted code, and only in 64 bit. It does not 
happen in compiled code. (Although I have a report of a similar 
segmentation fault with compiled code if the output is redirected). I 
don't really know how to debug this kind of problem. As a first step I 
will try to obtain a minimal test case without any package dependencies.


This makes debugging difficult. Can anyone spot

what I am doing wrong?


Your are doing nothing wrong. I will create a new, more visible page for 
the known problems.


Given all the lists of Double's it seems very

easy to make an error regarding the number of arguments with the model
function or the derivative.


Static argument checking would be ideal, but at least they are normal 
runtime errors and should never crash the program.



Try to evaluate the 'test' function in the small program listed below.
I would expect an output of [1, 0] (y = 1*x + 0) instead of a
segmentation fault.


It works for me in 32 bit:

$ ghci Test.hs
GHCi, version 6.12.3: http://www.haskell.org/ghc/  :? for help
Loading package ghc-prim ... linking ... done.
Loading package integer-gmp ... linking ... done.
Loading package base ... linking ... done.
Loading package ffi-1.0 ... linking ... done.
[1 of 1] Compiling Test ( Test.hs, interpreted )
Ok, modules loaded: Test.
*Test test
Loading package filepath-1.1.0.4 ... linking ... done.
Loading package old-locale-1.0.0.2 ... linking ... done.
Loading package old-time-1.0.0.5 ... linking ... done.
Loading package unix-2.4.0.2 ... linking ... done.
Loading package directory-1.0.1.1 ... linking ... done.
Loading package process-1.0.1.3 ... linking ... done.
Loading package array-0.3.0.1 ... linking ... done.
Loading package storable-complex-0.2.1 ... linking ... done.
Loading package hmatrix-0.10.0.1 ... linking ... done.
([1.0,0.0],(14)
 [ 1.0, 0.0, 1.0, 0.0 ])



Relevant versions:
 - hmatrix-0.10.0.0
 - gsl-1.14
 - ghc-6.12.3 (64 bit)


Small program:

module Test where

-- from base:
import Control.Arrow ( second )
import Control.Applicative   ( pure )

-- from hmatrix:
import Data.Packed.Matrix( Matrix )
import Numeric.GSL.Fitting   ( FittingMethod(LevenbergMarquardt), fitModel )


-- input list of (x, y) pairs, output coefficients of f x = a x * b
fitLinear :: [(Double, Double)] - ([Double], Matrix Double)
fitLinear samples = fitModel 1
 1
 10
 (linearModel, linearDer)
 (map (second pure) samples)
 [0, 0]

linearModel :: [Double] - Double - [Double]
linearModel [a, b] x = [a*x + b, 0]
linearModel _  x = error wrong arguments

linearDer :: [Double] - Double - [[Double]]
linearDer [_, _] x = [[x, 0]]
linearDer _  _ = error wrong arguments

test = fitLinear [(0,0), (1,1), (2,2)]


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


Re: [Haskell-cafe] internship opportunities in France

2010-11-06 Thread Corentin Dupont
Hello,
as well as I know, there is very few, if no, jobs in Haskell in France.
They are much more on CAML.

Corentin

On Sat, Nov 6, 2010 at 9:00 PM, Lorenzo Fundaró lfund...@etu.utc.fr wrote:

 Hello folks !
 I am a Computer Science student looking for an internship of 6 months here
 in France. Does anybody know of any company working with Haskell ?
 Thanks in advance :D,

 Lorenzo Fundaró García

 ___
 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] What do you call Applicative Functor Morphism?

2010-11-06 Thread Ben
category theory encompasses more than just algebra.  so there are 
homomorphisms, but also diffeomorphisms, symplectomorphisms, et cetera (in 
addition to things which don't have the -morphism suffix in normal usage, like 
continuous maps, natural transformations.)

b

On Nov 6, 2010, at 7:19 AM, rocon...@theorem.ca wrote:

 On Sat, 6 Nov 2010, Sebastian Fischer wrote:
 
 Hello,
 
 I'm curious and go a bit off topic triggered by your statement:
 
 On Nov 6, 2010, at 12:49 PM, rocon...@theorem.ca wrote:
 
 An applicative functor morphism is a polymorphic function,
 eta : forall a. A1 a - A2 a between two applicative functors A1 and A2 
 that preserve pure and *
 
 I recently wondered: why morphism and not homomorphism?
 
 Morphisms can be more general than homomorphisms.  But in this case I mean 
 the morphisms which are homomorphisms.  I was too lazy to write out the whole 
 word.
 
 -- 
 Russell O'Connor  http://r6.ca/
 ``All talk about `theft,''' the general counsel of the American Graphophone
 Company wrote, ``is the merest claptrap, for there exists no property in
 ideas musical, literary or artistic, except as defined by statute.''
 ___
 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] internship opportunities in France

2010-11-06 Thread Vo Minh Thu
Hi,

There is for instance http://gamr7.com/

They are listed in http://www.haskell.org/haskellwiki/Haskell_in_industry

Cheers,
Thu

2010/11/6 Corentin Dupont corentin.dup...@gmail.com:
 Hello,
 as well as I know, there is very few, if no, jobs in Haskell in France.
 They are much more on CAML.

 Corentin

 On Sat, Nov 6, 2010 at 9:00 PM, Lorenzo Fundaró lfund...@etu.utc.fr wrote:

 Hello folks !
 I am a Computer Science student looking for an internship of 6 months here
 in France. Does anybody know of any company working with Haskell ?
 Thanks in advance :D,

 Lorenzo Fundaró García

 ___
 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] Most popular haskell applications

2010-11-06 Thread Ivan Lazar Miljenovic
On 6 November 2010 19:14, Tillmann Rendel
ren...@mathematik.uni-marburg.de wrote:
 Ivan Lazar Miljenovic wrote:

 Bulat Ziganshin wrote:

 people, are you know haskell apps that has more than 50k downloads per
 month (or more than 25k users) ?

 Possible candidates:

 * GHC

 * XMonad

 * Darcs

 * Pandoc

 I have no idea how to measure number of downloads or users, but pandoc is
 used outside of the Haskell community. (And it can process this email).

I _knew_ I was missing something...

And seeing as how some ruby developers have developed bindings to
pandoc, it _must_ be popular ;-)

-- 
Ivan Lazar Miljenovic
ivan.miljeno...@gmail.com
IvanMiljenovic.wordpress.com
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] internship opportunities in France

2010-11-06 Thread Yves Parès
Nope, the page is outdated.
Gamr7 doesn't use Haskell currently. They used it before, but now Haskell is
sort of in standby. Currently they mostly use Python and C/C++.
I don't work here, I know it since I have applied for this intership
proposal (I'm french too) and been accepted.


2010/11/6 Vo Minh Thu not...@gmail.com

 Hi,

 There is for instance http://gamr7.com/

 They are listed in http://www.haskell.org/haskellwiki/Haskell_in_industry

 Cheers,
 Thu

 2010/11/6 Corentin Dupont corentin.dup...@gmail.com:
  Hello,
  as well as I know, there is very few, if no, jobs in Haskell in France.
  They are much more on CAML.
 
  Corentin
 
  On Sat, Nov 6, 2010 at 9:00 PM, Lorenzo Fundaró lfund...@etu.utc.fr
 wrote:
 
  Hello folks !
  I am a Computer Science student looking for an internship of 6 months
 here
  in France. Does anybody know of any company working with Haskell ?
  Thanks in advance :D,
 
  Lorenzo Fundaró García
 
  ___
  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

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


Re: [Haskell-cafe] internship opportunities in France

2010-11-06 Thread Yves Parès
But (and sorry for the double mail), Lorenzo, you may want to take a look
abroad.
It looks like you are looking for the same thing I was. But I kind of gave
up since I found 2 interesting internships in France (nothing to do with
Haskell).

You're looking for a 6-month intership. I guess you're in M2 or in 5th year
in a school of engineering, right? (I'm in the INSA of Rouen)
In France, I think it's a dead-end: I only know in France one university
that teaches Haskell, that of Caen, and they're not proposing internships (I
searched), and I know no company that uses Haskell.
But there might be some company or university in Europe that could offer
such an intership.


2010/11/6 Yves Parès limestr...@gmail.com

 Nope, the page is outdated.
 Gamr7 doesn't use Haskell currently. They used it before, but now Haskell
 is sort of in standby. Currently they mostly use Python and C/C++.
 I don't work here, I know it since I have applied for this intership
 proposal (I'm french too) and been accepted.


 2010/11/6 Vo Minh Thu not...@gmail.com

 Hi,

 There is for instance http://gamr7.com/

 They are listed in http://www.haskell.org/haskellwiki/Haskell_in_industry

 Cheers,
 Thu

 2010/11/6 Corentin Dupont corentin.dup...@gmail.com:
  Hello,
  as well as I know, there is very few, if no, jobs in Haskell in France.
  They are much more on CAML.
 
  Corentin
 
  On Sat, Nov 6, 2010 at 9:00 PM, Lorenzo Fundaró lfund...@etu.utc.fr
 wrote:
 
  Hello folks !
  I am a Computer Science student looking for an internship of 6 months
 here
  in France. Does anybody know of any company working with Haskell ?
  Thanks in advance :D,
 
  Lorenzo Fundaró García
 
  ___
  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



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


Re: [Haskell-cafe] Review request for my baby steps towards a platform independent interactive graphics using VNC

2010-11-06 Thread Sebastian Fischer


On Nov 4, 2010, at 3:48 PM, C K Kashyap wrote:


Also, any reference/suggestion on how I could go about using a state
machine to deal with the RFB protocol.


A simple way to model state machines is to use one function for each  
state. Each function calls the functions corresponding to successor  
states.


(Not sure whether this answers you question, though).

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


Re: [Haskell-cafe] ANNOUNCE: arrow-list. List arrows for Haskell.

2010-11-06 Thread Sebastian Fischer


On Nov 6, 2010, at 10:00 PM, Sebastiaan Visser wrote:

List arrows are a powerful tool when processing XML, building query  
languages and lots of other domains that build on functions that  
might return more than one value as their output.


Interesting. Do you plan to write some examples that show

  * how to use ListArrows,
  * differences to using the list monad, and
  * when using ListArrow is preferrable?

I'm interested to see something like this worked out although I have  
some rough ideas like monads are more powerful and arrows may allow  
stronger reasoning and more efficient implementations. Can you  
substantiate these general points for the concrete case of ListArrow  
vs list monad?


I assume your implementation is *not* more efficient than the list  
monad as it builds on ListT.


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


[Haskell-cafe] hmatrix's fitModel function crashes ghc(i)

2010-11-06 Thread Vivian McPhail
 Message: 29
 Date: Sat, 6 Nov 2010 13:22:10 +0100
 From: Roel van Dijk vandijk.r...@gmail.com
 Subject: [Haskell-cafe] hmatrix's fitModel function crashes ghc(i)
 To: Haskell Caf? haskell-cafe@haskell.org
 Message-ID:
aanlktim5egsl_bz+ruv-=d-z3db65sc8o=ckqltcy...@mail.gmail.com
 Content-Type: text/plain; charset=UTF-8

 Hello,

 I would like to use hmatrix to do some function fitting with the
 Levenberg Marquardt algorithm. As an example I would like to fit the
 very simple function f x = a*x + b on some data points. The problem
 is that executing the 'fitModel' function crashes GHC(i) with a
 segmentation fault. This makes debugging difficult. Can anyone spot
 what I am doing wrong? Given all the lists of Double's it seems very
 easy to make an error regarding the number of arguments with the model
 function or the derivative.

 Try to evaluate the 'test' function in the small program listed below.
 I would expect an output of [1, 0] (y = 1*x + 0) instead of a
 segmentation fault.

 Relevant versions:
  - hmatrix-0.10.0.0
  - gsl-1.14
  - ghc-6.12.3 (64 bit)


Is that the 64 bit Linux ghc?

I think the problem is with the GSL random number generation through GHCi.

Try:

 module Test where

 Import Numeric.Container(RandDist,randomVector)

 seed = 0
 size = 100

 main = putStrLn $ show $ randomVector seed Gaussian size

This should work when compiled with `ghc --make` and crash when invoked in
`ghci`.

I think the problem is with linking static data in GHCi on x86_64.

Hope this helps.  I seem to recall there might be a ghc trac ticket related
to this but a quick search turned up nothing.

Cheers,

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


Re: [Haskell-cafe] Compiler constraints in cabal

2010-11-06 Thread wren ng thornton

On 11/6/10 6:20 AM, Reiner Pope wrote:

I was aware of this condition, but I'm not precisely sure it addresses
my requirements. When you run cabal install some-package, cabal
reads all version constraints listed in the build-depends field, and
chooses which versions of which packages to download from Hackage in
order to satisfy these constraints.

I want to expose my dependency on a particular version of ghc to
cabal's constraint satisfier. The end result I want is that when you
type cabal install hmatrix-static with ghc-6.12 installed, then
cabal chooses hmatrix-static-0.3; and when you type cabal install
hmatrix-static with ghc-7.0 installed, then cabal chooses
hmatrix-static-0.4.



Clients of hmatrix-static would have to say

if impl(ghc = 7.0)
Build-Depends: hmatrix-static == 0.4.*
else
Build-Depends: hmatrix-static == 0.3.*

in order to pull in the right dependency for themselves.

In order to get the behavior you're after, though, is trickier business. 
Since every version of GHC ships with a different version of base, 
you'll have to make use of that knowledge such that users of ghc-7.0 
with base-5 will get hmatrix-static-0.4 whereas users of ghc-6.12 with 
base-4 will get hmatrix-static-0.3


--
Live well,
~wren
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe