So long Haskell, and thanks for all the functional fish

I've realized I haven't written or read a line of Haskell in the past 6 months. After roughly ten years of tinkering with it, it seems that I've given up on it. There is a big obvious reason, and other smaller ones.

Professionally, my job got a lot more challenging (I'm officially an **architect** now, which means I still write lots of code but I have to draw pretty diagrams too (-: ) and involves a lot of research and learning new stuff, things like microservices, docker, messaging, Angular2, mobile apps, etc. So a lot of my time is dedicated to work or to learning for work, so I don't have the time to play around with something quite unrelated like Haskell.

I suppose to be honest there also was a bit of lassitude with Haskell. I got tired of the less than optimal IDEs, I realized Haskell was not going to get me a great job, and there were a few little skirmishes on the web that got ugly and made me see the community in a less favorable light.

This was fun, though, and I certainly learned a lot, and I hope it has made me a better programmer. A lot of my coding now is done in Java 8, and it's good to be able to apply some functional idioms practiced in Haskell, and more general ideas like data immutability, small pure functions do help make better - more testable, easier to understand - code.

So maybe I'll come back to Haskell some day, but not for now. To all the open source projects I've contributed, I wish you the best!

Happy Haskell (or any other language) Hacking!

Porting my typeclass game to reactive-banana-sdl

Some time ago I wrote a tiny game called TypeClass, just to experiment with the SDL bindings for Haskell. I was always curious to learn more about FRP, but never really knew where to start. So I just decided to change TypeClass to use reactive-banana, since it looked like a nice library with a dedicated author. And there are SDL bindings too!
It took a bit efforts since I didn't find any sample in reactive-banana-sdl, but I finally got it working. The game is exactly the same from the outside, so it still not that exciting. But I feel I've made progress in understanding events and behaviors and how it all fits together.

I've put the game on github, so anybody else interested in using reactive-banana with SDL can at least have a sample. It requires my own version of reactive-banana.

Happy Haskell Hacking!

Predictable random for testing

In my Haskell RPG game, the results of actions are random: I use the standard random generator to simulate the throw of a dice in a table top RPG.
However for writing unit tests that is not ideal, since I would like to be able to test the outcome of an action for a given result of the dice. I didn't
want to clutter the code (even if using a State monad) with something used only for testing, so I experimented with IORef and a custom Test Generator.

First of all, we need a data type to store our non random random generator. It will store a list of results and the index it's at in that list. It's
basically a circular list, so that when we reach the end we start again. If the list is one element long, then the same result will be given for all
dice throws:

data TestGen = TestGen [Int] Int

mkTestGen is just a helper function to initialise the index to 0

mkTestGen l=TestGen l 0

This is the real magic: I thought you needed to pass around an IORef as any other variable to be able to read its results, but in fact this is not necessary,
if somewhat of a kludge:

testGen :: IORef (TestGen)
{-# NOINLINE testGen #-}
testGen=unsafePerformIO (newIORef (mkTestGen []))

This means that testGen is initialized only once as a TestGen with an empty list, no matter how many time it's called. It seemed to work in ghci even
without the NOINLINE pragma. Don't ask me why. So, given a simple setter function:

setTestGen l=do
 writeIORef testGen (mkTestGen l)

We can specify what we want as the random generator. If we have an empty list, we use the standard random generator, otherwise we return the current element
in the list, and increment the index, going back to zero if we overrun the list:

randomInt ::(Int,Int) -> IO (Int) 
randomInt (l,h)=do
 (TestGen list ix)<-readIORef testGen 
 if null list
  then getStdRandom (randomR (l,h))
  else do
   let e=list!!ix
   let ix'=ix+1
   let ix''=if ix'==(length list)
    then 0
    else ix'
   writeIORef testGen (TestGen list ix'')
   if e<l || e>h
    then error (printf "%d not in range (%d,%d)" e l h)
    else return e

And this works, amazingly:

 setTestGen [2]
 l<-replicateM 3 (randomInt (1,6))
 assertEqual ("l is not 3 2s") [2,2,2] l
 setTestGen [2,3,4]
 l<-replicateM 4 (randomInt (1,6))
 assertEqual ("l is not 2,3,4,2") [2,3,4,2] l
 setTestGen []

(Notice how I reset the test generator to standard at the end by passing an empty list).

So now I can test my code with predictable results, that will be still random in production use.
Oops, already found a bug on the first test written with that technique!

Arrays to the rescue!

Some time ago I blogged about Haskell Generics and how they simplified my code of a little RPG game I'm writing. My data types were designed with lists. For example a character has traits, and traits are a list of Characteristic objects, that have a name (Strength, Dexterity, etc.) and values. The Generics code helped me to deal with finding the right item in the list depending on the name, updating its value, etc. Records were no good because you can pass the generated function as an accessor but not as a mutator.

I have some unit tests that generate random characters, and I thought they were pretty slow, which I thought was due to the random number generator. Then I ran the tests with profiling on. Guess what? The Generics code amounted for a huge amount of the time spent. And I'd say the underlying list operation, with loads of list updates, were not great either.

So I got rid of the Generics code, and I decided to replace my lists by something else. In the Java world (my day time job) I rely heavily on Maps. I thought it was a bit overkill in this case, so I turned to the Haskell array package. And there was light!

You see, Arrays in Haskell are a different beast that arrays in other languages. You can use different types for the indices, not only integers. So since the data type representing the names of characteristics is a simple enumeration, I could use that as the array index. So the characters traits are an array with the names as indices:

data Characteristic = Strength | Dexterity | ...
  deriving (Show,Read,Eq,Enum,Bounded,Ord,Ix)

Ix is the type class that an array index type must implement

type CharacteristicRatings=Array Characteristic Rating

data Character = Character {
  ...
  ,traits::CharacteristicRatings
  ...
  }

And Rating follow the same pattern, since a rating has the current value for the characteristic, the normal value, etc.

Then the array operations make it easy enough to read and modify values: ! to get the value at the specified index, // to update. I get type safety and expressiveness (no need to even use toEnum and fromEnum), and performance...

Performance? With the Generics code and lists, my tests took 8 seconds. With arrays and no Generics, 0.26s. Nuff said.

instance Data Map where -- half done!

While testing my JSON serializer/deserializer, I made the (unpleasant) discovery that some standard structures (most notable Data.Map.Map) do not implement all of Data.Generics.Data interface. They just call error on things like toConstr and gunfold. Which is not good, since I use these methods. Why they can't just pretend that a Map K v is for generics a map of (k,v) I don't understand (they implement gfoldl that way), but hey, I'm only a humble learner of Haskell...

So I spent a few hours trying to modify my JSON code to work around this issue, to no avail (well I can get the serialization all right, but the deserialization seems to be tricky). So I've got another approach to work: since the default for Data instances is not right when your objects contains Map structures, lets rewrite these... Using the source for Data.Map and the documentation for Data.Generics.Data, I managed to get it to work, but of course the price is loads (loads, loads) of boilerplate code.

So here goes: I have the simple object: (assume import qualified Data.Map as M)

data MapObjF=MapObjF (M.Map String Int) String
 deriving (Eq,Typeable,Show)

So MapObjF contains a Map String Integer and a String

And here's the Data instance definition (big breath):

instance Data MapObjF where
     gfoldl k z (MapObjF m s) = k (k (z (MapObjF . M.fromList)) (M.toList m)) s
     gunfold k z _ = k (k (z (MapObjF . M.fromList)))
     toConstr (MapObjF _ _) = con_MapObjF
     dataTypeOf _ = ty_MapObjF

con_MapObjF = mkConstr ty_MapObjF "MapObjF" [] Prefix
ty_MapObjF   = mkDataType "MyModule.MapObjF" [con_MapObjF]

I define the constructor, the datatype, and implement gfoldl and gunfold transforming the map into a list of tuples. Of course if you have several constructors, loads of fields it soon becomes unwieldy. Now, is there a Haskell macro system so I can easily generate all that boilerplate for all my data types? Noooo I don't want to leave Haskell for LISP...

Handling errors in JSON to Haskell deserialization

My JSON deserializing code presented previously works, but when an error occurs, most likely because the JSON doesn't represent the objects you expect it to, we're a bit lost: we get a terse error message and our program aborts, because Data.Generics tend to call error when it encounters a problem, and our own calls from Maybe to Just may fail. So we need to build a way to report errors without crashing. Now, famously, there are several ways to report errors, and for a start I'll work with Either.

First, we create a error type that can help us represent both JSON parsing error and deserialization errors:

data JSOND13NError=JSONError ParseError
  | D13NError String String
  deriving Show

The two parameters in D13NError are the error message and the path in the JSON object where the error occured. They will be carried in the Either monad in a tuple of Strings

So parsing can either throw a JSONError or try to deserialize:

jsonStringToObj :: forall a. Data a => String -> Either JSOND13NError a
jsonStringToObj s= case parse JSON.json "JSON.parse" s of 
 Left err->Left (JSONError err)
 Right js->case (jsonToObj js "/") of
  Left (s,path) -> Left (D13NError s path)
  Right o-> Right o

The path starts at "/" for the deserialization

To work with Either we need a couple of helper function, one to translate the Maybe values we get from cast to Either:

toEither :: String -> Maybe a -> String -> Either (String,String) a
toEither s Nothing path=Left (s,path)
toEither _ (Just a) _=Right a

And then the monad declaration for Either(message,path):

instance Monad (Either (String,String)) where
 return a=Right a
 fail s=Left (s,"/")
 Right a >>= f2 =f2 a
 Left s >>= f2 =Left s 

With this, our main function becomes:

jsonToObj :: forall a. Data a => JSON.Value -> String -> Either (String,String) a
jsonToObj (JSON.String s) path=toEither "Not a String" (cast s) path
jsonToObj (JSON.Bool b) path=toEither "Not a Bool" (cast b) path
jsonToObj x path=do
 (values,cons)<-case x of
   JSON.Object m -> fieldJSONValues m myDataType path
   JSON.Number fl -> Right ([],if isPrefixOf "Prelude.Int" (dataTypeName myDataType)
    then mkIntConstr myDataType (round fl)
    else mkFloatConstr myDataType fl)
   JSON.Array [] -> Right ([],indexConstr myDataType 1)
   JSON.Array (x:xs) -> Right ([(x,path),((JSON.Array xs),path)],indexConstr myDataType 2)
 let StateT f=fromConstrM (StateT (\((x,path):xs) -> do
   r<-jsonToObj x path
   return (r,xs)
   )) cons
 r<- f values
 return (fst r)
 where
  getArg :: a' -> a'
  getArg = undefined
  getType :: a
  getType = undefined
  myDataType = dataTypeOf (getArg getType)

We use a StateT monad transformer to wrap our Either monad in the State. I'm not sure I understand 100% of how monad transformers actually work, but it works!

And the fieldJSONValues handles a few error conditions, along with building the path where we're at, by adding after the current path the name of each field in turn

fieldJSONValues :: (M.Map String JSON.Value) -> DataType -> String -> Either (String,String) ([(JSON.Value,String)],Constr)
fieldJSONValues m dt path | isAlgType dt=
 if idx>(maxConstrIndex dt)
  then Left ((printf "Constructor index %d too big" idx),path)
  else 
   if null fn 
    then Right ((map (\x->(fromJust $ M.lookup (show x) m',path++(show x)++"/")) (sort $ map (\x->((read x)::Int)) (M.keys m'))),c)
    else  
     let vals=map (\(x,y)->(fromJust x,y)) (filter (\(x,y)->isJust x) (map (\x->((M.lookup x m'),path++x++"/")) fn))
     in if (length vals) < (length fn)
      then Left ("Not enough fields",path)
      else Right (vals,c)
 where 
  idx=case M.lookup constrIndexField m of
   Just (JSON.Number f)->truncate f
   _ -> 1
  m'=M.delete constrIndexField m
  c=indexConstr dt idx 
  fn=constrFields c
fieldJSONValues m dt path | otherwise =Left ("Not an algebraic type",path)

Once I had the previous code working, using a different monad and adding error handling was easy. I suppose I could further abstract and try not to hard code the Either monad in it but use any type of Monad or MonadError, but this gives me what I want: no program crash and the ability to recover from errors!

Deserializing JSON to Haskell Data objects

Since last week I found a few other posts and libraries on the subject of JSON serialization and deserialization: here and here for example. Nonetheless I've continued on my own path, since the best way of learning is doing. It took me a while to figure out how to reconstruct a Haskell object, and I've only got some limited functionnality to work, but it works. I looked into the source code for gread for clues, I have to say.

So what we want is simple enough:

jsonToObj :: forall a. Data a => JSON.Value -> a

Given a JSON value we want an haskell object, and hopefully the type will match... OK, I'm a bit terse on the error handling side of things at the moment!
(Note: for the code to work you need to import: Control.Monad.State, Data.Generics, Data.List, qualified Data.Map as M, Data.Maybe)

It's simple enough for Strings and Bools:

jsonToObj (JSON.String s)=fromJust $ cast s
jsonToObj (JSON.Bool b)=fromJust $ cast b

Of course, if you expected a Foo and parse a JSON.String, this will fail(The cast return a Maybe). You have to cast since the signature doesn't force Strings or Bools, only Data.

For other types of objects (including numbers, because cast doesn't perform number conversion I found) it's a bit more complicated. Basically we have to figure out the type we want, find a constructor to build an instance of that type, and pass to that constructors proper values from the JSON object.
To find the type we want, I use funny code find in gread:

myDataType = dataTypeOf (getArg getType)
getArg :: a' -> a'
getArg = undefined
getType :: a
getType = undefined

This create a dummy function returning my type, and a dummy function returning what it gets as parameter. They don't need to be implemented, the compiler only cares about the type.

The meat of the function, that decides what constructor to invoke and what data to useas constructor parameter is a bit more involved:

(values,cons)=case x of
 JSON.Object m -> let
  c=indexConstr myDataType 1
  in ((map (\x->fromJust $ M.lookup x m) (constrFields c)),c)
 JSON.Number fl -> ([],if isPrefixOf "Prelude.Int" (dataTypeName myDataType)
  then mkIntConstr myDataType (round fl)
  else mkFloatConstr myDataType fl)
 JSON.Array [] -> ([],indexConstr myDataType 1)
 JSON.Array (x:xs) -> ([x,(JSON.Array xs)],indexConstr myDataType 2)

This snippet calculates the objects to iterator over and the constructor index to use. There's a bit a hand waving there: for objects we will take the first construtor we defined (I'll implement multiple constructor support later), and the JSON values it contains in the map. We just ensure we get the values in the order the fields are defined (given by the constrFields function). For number we use the int constructor if our result type looks like an int, otherwise we use the float constructor. There is probably a better way to construct a number from a Double, but I still need to find it. For the moment we look if the type name starts with "Prelude.Int", which is arguably not very Haskelly. For Arrays, we need to recreate the (head,rest) tuple that gave me trouble when serializing, so we deal first with the head of the list, and put the rest afterwards. The empty list is the first constructor, a non empty the second.

Then to actually create the object we pass the values inside a State monad:

State f=(fromConstrM (State (\(x:xs) -> (jsonToObj x,xs))) cons)

For the list of values we convert the head from json and keep the rest as state. This simple line was the result of intense thinking, I implemented my own State monad first to really understand what I needed to do and then figured out that the State monad did the exact same thing. The final working code is always shorter that all the previous failed attempts!
We then only need to call the State function with the values we calculated earlier, and that give us our full code:

jsonToObj x=
 fst $ f values
 where
  getArg :: a' -> a'
  getArg = undefined
  getType :: a
  getType = undefined
  myDataType = dataTypeOf (getArg getType)
  (values,cons)=case x of
   JSON.Object m -> let
    c=indexConstr myDataType 1
    in ((map (\x->fromJust $ M.lookup x m) (constrFields c)),c)
   JSON.Number fl -> ([],if isPrefixOf "Prelude.Int" (dataTypeName myDataType)
    then mkIntConstr myDataType (round fl)
    else mkFloatConstr myDataType fl)
   JSON.Array [] -> ([],indexConstr myDataType 1)
   JSON.Array (x:xs) -> ([x,(JSON.Array xs)],indexConstr myDataType 2)
  State f=(fromConstrM (State (\(x:xs) -> (jsonToObj x,xs))) cons)

The unintentional infinite list

The other day I was happily hacking away at some Haskell code. Same thing as always: think hard at about how to represent my problem in Haskell, then type the code quickly enough. Then launch my HUnit test. Tests doesn't return, just seem to be looping for ever!! Uh oh.
So I check my code, all the foldr and foldl and such, to make sure nowhere I create an infinite sequence. Nothing. So I took a deep breath and started the ghci debugger. I'm used to graphical debugger (like Java in Eclipse) but hey I managed to pretty quickly locate the offending function. Only a typo that couldn't be caught by the compiler. Since it's not the first time this has happened to me, here it is:
I tend to not be too comfortable with big one liner functions, so I revert often to several lines after a let instruction to cleanly separate each step of the computation. So when I repeatedly change some structure I tend to get:

fn a =
   let
       a1=fn1 a
       a2=fn2 a1
   in fn3 a2

and the typo there was a line like:

    a2 = fn2 a2

So I had typed in a2 instead of a1, and the compiler was perfectly happy, I wanted to create an infinite list, right? Er... That wasn't exactly my intention.
So I fixed the typo. Then ran my test. Which passed. Of course.

Java and higher order generics

Funny coincidence: yesterday in work I was trying to find a way to express something simple enough in Java: I want a method map that takes a generic collection and return a collection of the same type (that is, passing a List should return a List, passing a Set should return a Set) with a different generic type. In Java you can have:

public <T1,T2> Collection<T2> map(Collection<T1> c,Mapper<T1,T2>

Where Mapper is an interface defining the method T2 map(T1 o);
There is no way I think in Java to express that if you pass a subclass of collection you get the same subclass back.

I tried things like <T1,T2,C extends Collection,C1 extends C<T1>,C2 extends C<T2> and other crazy things that my compiler didn't appreciate.


You have to duplicate methods, and that's what we've done in work:

public <T1,T2> List<T2> map(List<T1> c,Mapper<T1,T2>
public <T1,T2> Set<T2> map(Set<T1> c,Mapper<T1,T2>

And of course a colleague needed a Vector because he was using an old library still using Vectors...
And then today I found that blog post, that point to that PDF document. Apparently you can do this kind of things in Scala and Haskell... Do I need to convince my company to move to Scala?

Haskell design patterns are (probably) needed

I was reading that post, and thinking: well when I start a Haskell project (for fun, yes, I don't use Haskell in work) I do wonder how best to design it. Yes I know about higher order functions, generics and such, but I don't think these low level constructs are enough to express, on their own, the design of the system as the design patterns from the GoF do. I would love to see patterns on how to allow extensibility, separation of concerns and such in Haskell. Years of experience in Java mean that I see a lot of things in terms of objects, inheritance vs composition, interfaces, etc, and not all of that apply in Haskell. I see a lot of low level algorithms in Haskell, but few software design papers (papers like this one are useful, we need more of them).

Structure of a functional Java, er, method

A method in FLOJ (remember, the functional Java based language I'm toying with) has a simple structure:
- a method definition 100% similar to a normal Java method: visibility generic return-type type parameters.
There are no exceptions, of course, since exceptions are things Best Done in Monads, once I've figured out
out I'll implement monads.
- a series of assignments of the form x=e where x is a variable name, and e an expression
- a return expression

For example:

public static String[] testMap(){
   a=["toto","titi"];
   a.map(String.toUpperCase);
}

Since the return expression is always the last expression, there is no need for a return keyword, but it's accepted by the parser. In the exemple above, the method returns the list of String TOTO and TITI.
Note also that the assignments do not allow nor require the type definition of the left hand side of the assignment. The type is inferred from the
return type of the right hand side expression (in the exemple above, a is a list of String). It's not as powerful as the full blown Haskell type inference but at least it saves some typing.

Of course, the generated Java code will add a sneaky final keyword to all the assignments, to enforce the fact that there's no variables in a functional language.

All in all, that structure makes the code easy to read and to understand: the sequence of calculations and the final expression yielding the method result.

I don't think my FLOJ language will ever be a full blown industrial-strength language, but I know that by implementing my own functional language I will learn a lot
more about functional languages than by just using one. Just implementing method pointers, type inference, combinator parsers and such, I understand more the why and how of Haskell.

A simple functional structure in Java

I have progressed a little bit in creating a functional language on top of Java, code name FLOJ (Functional Language On Java (-:). For the moment I'm only working on single files (I have a working parser), on the simple language constructs.
It's really interesting, because looking at very simple things make you think in depth about some issues that you may not really consider in Java proper. For example, this is the definition of a very simple structure:

package fr.moresmau.jp.floj.samples;

public class Simple(String data,int port){

}

So you can see that the package system is Java's and class definition are very similar. There are no constructor, so. Since null are not allowed (nulls are a huge source of bugs, I'll provide a Maybe object or something like that later),
the structure must have all its data filled in. If you want different operations to be done, you just create static functions that take parameters and create what you need, no need for several constructors. So the list of fields is entered straight after the name of the class.
Simple is a structure with a string and an int. It's easy enough to generate the constructor in Java:

package fr.moresmau.jp.floj.samples;

public class Simple{
 public final String data;
 
 public final int port;
 
 public Simple(final String _data, final int _port){
  if(_data==null){throw new NullPointerException("_data");}
  this.data=_data;
  this.port=_port;
 }
... 

The fields are immutable of course, so we don't bother with a getXXX() method, we just expose the field.
And you can then add setters that return a new object :

... public Simple setData(final String _data){
  if(_data==null){throw new NullPointerException("_data");}
  if (_data.equals(data)){return this;}
  return new fr.moresmau.jp.floj.samples.Simple(_data,port);
 }
 
 public Simple setPort(final int _port){
  if (_port==port){return this;}
  return new fr.moresmau.jp.floj.samples.Simple(data,_port);
 }
...

Note the null handling is not ideal, left for later. Note also we avoid superfluous creations if the data will not change.

So far, so good.

Then I decided to implement equals, so that equals is based on the data and not pointer equality:

...
 public boolean equals(final java.lang.Object o){
  if (this==o){return true;}
  if (o instanceof fr.moresmau.jp.floj.samples.Simple){
   fr.moresmau.jp.floj.samples.Simple co=(fr.moresmau.jp.floj.samples.Simple)o;
   if (!this.data.equals(co.data)){return false;}
   if (this.port!=co.port){return false;}
   return true;
  }
  return false;
 }
...

And with this of course the problem of overloaded equals method raises its head. If I want to allow subclasses to add more fields, my equals method won't work for subclasses.
If I check the exact class name in equals, subclasses that only add/overload methods will not be equals to superclasses.
So what can I do? I haven't decided. I could forbid subclasses to define more data fields (that's I think what you have in Haskell: you inherit functions from your type classes but no data).
I could also make the equals method final and not generate it for subclasses, but equality would then ignore the additional fields.
Another option would be to check the class name in that equals method and generate the proper equals method for all subclasses, but that may cause problems if we then extends the FLOJ class by a Java Class (which will be possible since we generate Java code).
But maybe it should be so, that a class is never equals to its subclasses? Returning equals between two instances that have the same data but different behavior (one instance has an overloaded method) is probably an error in the OO world...

Anyway, creating your own language is fun, I'm learning a lot and maybe I'll even end up with something usable!! I'll keep you posted on my progress.

My own Java-based functional language

I've been toying for a while with the idea of creating my own Java based functional language, if only to be able to see first hand the challenges in creating a functional language. The language I envision has the following characteristics:
- syntax close to Java: contrary to JHaskell or CAL, I want something that looks like Java, not something totally different
- Java type system: use the normal Java OO type system: classes with at most one superclass, interfaces. Maybe I'll run into issues but for the moment...
- pure functional and monadic: what I love in Haskell is the clear delimitation between what's purely functional and what's subject to side effects (IO, etc...). I'd like to have that in my language. I know about Scala, but Scala lets you mix functional and imperative code, I want something pure (and I don't like to add new very un-Java like keywords like def)!
- Java integration: there is no point of being implemented in Java if we can't reuse the wealth of Java code and libraries out there. Probably I'll need a way to distinguish somehow functional Java code (like the String methods) and not functional code, and wrap access to non functional code in a monad.

Now that's an ambitious program!! I've started some parsing and conversion to Java source files (hey, if Java can do some of the type checking for me...), but it's going to be a long road...
Of course, if such a language already exists, I'd be delighted to hear about it!

The beauty of Haskell Combinators

Pffiuu, it's been a while since I've posted here, but don't think I've been idle. In addition to my day job, I'm still hacking away at Haskell. And still loving it!! I just wanted today to express my pleasure (yes, pleasure) at working with some cool APIs and libraries that are out there.
I'm doing a bit of research into language parsing and I'm using Parsec for parsing and the HughesPJ Pretty Printing library (included with GHC) to dump the parsed AST and check that I can output what I parse and reparse it into a equivalent structure. I have to say, working with combinators (monadic or otherwise) is actually fun and easy. I've developed code parser before, for example using some Java parser generators, but coding your parser directly in your favorite functional language is really sweet. And of course, I like the way that similar concepts are expressed the same in the two libraries, even down to the function names: parens() in Parsec will parse something surrounded but parentheses and parens() in HughesPJ will write something in between parenthesis.
I had also a exhilarating ah ah moment when I discovered in the Parsec doc makeTokenParser that suddenly made it so easy to accommodate with spaces and pesky littls things of this caliber.
Thanks to all contributors to these libraries for making my functional programming evenings fun!

A very dumb neural network in Haskell

Continuing my implementations of Michael Negnevitsky book on Artifical Intelligence in Haskell, I have tried to code a three layer neural network to implement exclusive or (Intelligence indeed...).

A neuron is made of its input weight and its threshold, and its output is calculated thus (apologies to all of you who gave me some tips about parameter order and newtype declaration, I haven't changed the code yet to follow your good advice!):

type Neuron= ([Value],Value)
type Value = Float

neuronOutput :: [Value] -> Neuron -> Value
neuronOutput inputs (weights,threshold) =
    let
        tot=(foldl (+) 0 (zipWith (*) inputs weights)) - threshold
    in
        1 / (1 + ((2.7182) ** (-tot)))

A three layer network whose input layer does nothing but fire its input to the midle layer can be modelled by to lists of neurons, and I use a TestCase type to keep track of inputs and expected outputs

       
type Network = ([Neuron],[Neuron])
type TestCase = ([Value],[Value])

Running the whole network with some input values is easy:

exec ::  Network -> [Value] -> ([Value],[Value])
exec (hidden,output) inputs =
    let
        hiddenOutputs = map (neuronOutput inputs) hidden
        outputOutputs = map (neuronOutput hiddenOutputs) output
    in
        (hiddenOutputs,outputOutputs)

The meat is all in one function, that calculates the output of the network for a given test and adapts the weights accordingly, first for the output layer then for the hidden layer:

defaultLearningRate::Value
defaultLearningRate=0.1

step ::  (Network,Value) -> TestCase -> (Network,Value)
step ((hidden,output),err) (inputs,expected)=
    let
        (hiddenOutputs,outputOutputs)=exec (hidden,output) inputs
        errorOutputs= zipWith (-) expected outputOutputs
        gradientOutputs=zipWith (\o d->o*(1-o)*d) outputOutputs errorOutputs
        newOutputs=zipWith (\(ws,t) g -> ( zipWith (\h w->w+ (defaultLearningRate*h*g)) hiddenOutputs ws ,t+(defaultLearningRate*g*(-1)))) output gradientOutputs
        weightsByHidden= transpose (map fst output)
        gradientHidden =zipWith (\o ws-> o * (1-o) * (foldl (+) 0 (zipWith (*) ws gradientOutputs))) hiddenOutputs weightsByHidden
        newHidden=zipWith (\(ws,t) g -> ( zipWith (\h w->w+ (defaultLearningRate*h*g)) inputs ws ,t+(defaultLearningRate*g*(-1)))) hidden gradientHidden
        newErr=err + (foldl (+) 0 (map (^2) errorOutputs))
    in ((newHidden,newOutputs),newErr)
 

The result is a new adapted network and the sum of squared errors.

An epoch is a set of tests:

epoch :: Network -> [TestCase] -> (Network,Value)
epoch network= foldl step (network,0)

We can then repeat epoch till the sum of squared errors for an epoch is less than the threshold for convergence:

errorConvergence::Value
errorConvergence=0.001

run ::     Network -> [TestCase] -> Int -> (Network,Int,Value)
run network allInputs epochNb=
    let (newNetwork,delta) = epoch network allInputs
    in (?) (delta <= errorConvergence || epochNb>225)
            (newNetwork, epochNb,delta)
            (run newNetwork allInputs (epochNb+1))
   
(?) :: Bool -> a -> a -> a
(?) True a _  = a
(?) False _ a = a

(Is there a standard function for (?)? I got tired of if then else...)

Then I test my code with the same start network as in the book:

test = do
    let n = ([([0.5,0.4],0.8),([0.9,1.0],-0.1)],[([-1.2,1.1],0.3)])
    let (n',e,err) = run n [([1,1],[0]),([0,1],[1]),([1,0],[1]),([0,0],[0])] 1
    print (n',e,err)
    return ()

And I get a mixed feeling about the result: the network does converge, and then it does work, but after something like 54000 epochs, while in the book it supposedly take 224! The book gives the result for the first test and I'm getting exactly the same thing, but it looks like my network learns a lot slower than it should. I would suppose I have a subtle error somewhere, but for the life of me I can't find it... If it jumps at anybody, please let me know. My hope now is that when refactoring the code and following the books advice on improving the performance I will find the bug!!

I have tried with random networks:

network :: Int -> Int -> Int-> IO Network
network inputNb hiddenNb outputNb= do
    a<-randomNeurons inputNb hiddenNb
    b<-randomNeurons hiddenNb outputNb
    return (a,b)
   
randomNeurons:: Int -> Int -> IO [Neuron]
randomNeurons nbInput nbNeurons= replicateM nbNeurons (randomNeuron nbInput)
   
randomNeuron:: Int -> IO Neuron
randomNeuron nb= do
    w<-replicateM nb (randomWeight nb)
    t<-randomWeight nb
    return (w,t)
   
randomWeight:: Int -> IO Value
randomWeight nbInput= do
    let interval= randomR ((-2.4)/(fromIntegral nbInput),2.4/(fromIntegral nbInput))
    getStdRandom interval

But I don't get better results...

A perceptron in Haskell

After reading Michael Negnevitsky book on Artifical Intelligence, I started playing with some of the algorithms he gives in Haskell. So my first endeavour is writing a simple perceptron (a one neuron neural network) to perform AND or OR logical operations. Next I'll start a full multi layer network to do much more complex operations like exclusive OR (-:.
Once again I was struck with the simplicity of the Haskell code necessary to implement such functionality (and I'm no Haskell expert yet). You think about how you going to implement it, the type checker tells you when you're doing something stupid, and by the time everything is written and compiles it kinda works.
The core method is calculating the output of the neuron, given the inputs, the weight of each input and the threshold value for that neuron:

neuronOutput :: [Float] -> [Float] -> Float -> Float
neuronOutput inputs weights threshold =
    let
        tot=(foldl (+) 0 (zipWith (*) inputs weights)) - threshold
    in
        if tot >= 0
            then 1
            else 0

Using zipWith we multiply each input with its weigth, calculate the sum with fold and remove the threshold. A negative result yields 0, else it yields 1.

Adjusting the weights to adapt to the error of a test case is no more difficult:

defaultLearningRate::Float
defaultLearningRate=0.1

adjustWeights :: [Float] -> [Float] -> Float -> Float -> [Float]
adjustWeights inputs origWeights expected actual =
    let
        e=expected - actual
        delta (i,w) = w + (defaultLearningRate * i * e)
    in
        map delta (zip inputs origWeights)

We modify the weight by applying to each weight a delta that is dependant on the input weight, the error ratio and the learning rat

A single step is made of calculating the output of the neuron and adapting the weights, given the expected value:

defaultThreshold::Float
defaultThreshold=0.2

step :: [Float] -> [Float] -> Float -> [Float]
step inputs weights expected=
    let
        o = neuronOutput inputs weights defaultThreshold
    in
        adjustWeights inputs weights expected o   

Then an epoch applies the step function to each different input sets. The hardest part is calculating the average of all deltas to find if the weights have changed at all during the evaluation of all the test cases

epoch :: [([Float],Float)] -> [Float] -> ([Float],Float)
epoch allInputs weights=
    let
        f w (inputs,expected) = step inputs w expected
        newWeights=foldl f weights allInputs
        delta= (foldl (+) 0 (map abs (zipWith (-) newWeights weights))) / (fromIntegral $ length weights)
    in (newWeights,delta)

A training run is only launching the epoch function repeatedly till the delta is zero:

run ::     [([Float],Float)] -> [Float] -> Int -> ([Float],Int)
run allInputs weights epochNb=
    let (newWeights,delta) = epoch allInputs weights
    in if delta == 0
        then
            (newWeights, epochNb)
        else
            run allInputs newWeights (epochNb+1)

We generate the initial weights in the IO monad, passing the number of weights needed:

initialWeights :: Int -> IO [Float]
initialWeights nb = do
    let interval= randomR (-0.5,0.5)
    (replicateM nb (getStdRandom interval))

Putting it all together:

test :: IO()
test = do
    w<-initialWeights 2
    let (ws,i)=run [([0,0],0),([0,1],0),([1,0],0),([1,1],1)] w 1
    print (ws,i)
    return ()

test find out the proper weights to implement AND and print them out, with the number of epochs needed to reach the result. You can then call neuronOutput with the resulting weights and your input: you have a AND logical gate!

As usual, any pointer to how to improve the code is welcome!

Javascript and Hibernate, hand in hand

Some time ago I had written a little prototype that was quite interesting, but I never pursued it. Maybe I should try to get some people interested and develop it further...
The idea was to use Rhino to have a Javascript-based framework on the server, thus using the same language on the server and on the client, like ASP did in the good old days. I was also thinking of having the source code for custom applications stored in the database, instead of having it in source files, but that's another story. That explains why the examples below are about "applications" and "components"
The first component is Hibernate connectivity. My framework lets you:
1. Dynamically configure Hibernate mapping for Javascript defined classes. For example, if you wanted to define a Web Application with several attributes and a reference to the components that it defines:

function Application(){
 this.displayName='';
 this.urlName='';
 this.defaultUrl='';
 this.id=-1;
 this.components=[];
}


Application.storage(
 {
 id:
  {name:'id',column:'ID',type:'long'},
 properties: 
  [
   {name:'displayName','not-null':true},
   {name:'urlName','not-null':true,unique:true,'unique-key':'APPLICATION_URL'},
   {name:'defaultUrl'}
  ], 
 references:
  [
   {'list':
    {name:'components',table:'APPLICATION_COMPONENT',
     details:[
      {'key':{column:'APPLICATIONID'}},
      {'list-index':{column:'idx',base:'0'}},
      {'many-to-many':{'column':'COMPONENTID','class':'Component'}}
     ]
    }
   }
  ]
 }
 );

Note that storage() is a function of the Function object which takes a Javascript structure that mimicks the Hibernate XML.

2. Access Hibernate functionality through a "hibernate" host object. For example, a JSUnit method testing the addition of a new "Application" object:

var appId;
var appUrlName;

function testAdd(){
 assertNotUndefined(hibernate);
 var app=new Application();
 assertNotUndefined(app);
 app.displayName="TestAppJS"+new Date();
 app.urlName=app.displayName;
 appUrlName=app.urlName;
 hibernate.save(app);
 hibernate.commit();
 assertNotNaN(app.id);
 assertTrue(app.id>0);
 appId=app.id;
}

The hibernate object lets you list objects, get a particular object, modify or create instances, etc. I have implemented a Hibernate EntityTuplizer and an subclass of Rhino's NativeArray that encapsulate a PersistentList, so that multiples references can be seen as Javascript arrays.

3. Query the database either through the HQL language:

var apps=hibernate.query("from Application where urlName=?",["TestAppJS"]);

or through a pure Javascript function based mechanism:

var apps=hibernate.query("Application",function(app){
 return app.urlName=="TestAppJS";}
);

That I think is very cool. In Rhino I can access the source code of the function that is passed as the second argument to query, and transform it into HQL. I haven't implemented as much as I could, of course, but it works with simple queries. At least there is no other syntax to learn to do a query, it's basically the equivalent of a filter function in functional language.

Then I had started to develop a web framework (probably the millioneth Java web framework by now) with Javascript objects to generate HTML and a mapping between urls and javascript functions, and where one URL could chain several functions, but I haven't gone very far.

Now if somebody feels there's some value in any of that I can sure post the code and we can move it forward. Anything that can show that Javascript is a cool language to run in a JVM in a worthwhile enterprise (-: