Friday, November 28, 2008

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!

Monday, November 03, 2008

Haskell for counting votes!

There's apparently an important election going on in the States. There are also a few interesting articles, for example in the french maths magazine Tangente (no up to date online edition that I could find unfortunately) and in the New Scientist, on how the way you tally votes affect the outcome. Tangente has a stiking example, and I'll go through the 5 vote couting methods they outline with an Haskell implementation of each.
No pesky elephant vs donkey, here, the election is about your favorite female movie star:

data Star = MarylinMonroe | AngelinaJolie | BrigitteBardot | EmmanuelleBeart | ClaudiaCardinale
deriving (Show,Read,Eq,Bounded,Enum,Ord,Ix)


Note the "deriving Ix" (from Data.Array.IArray) so we can use the stars as array indices.

We have six elector profiles: each profile has ranked the stars in order of preferences, and we have the numbers (in millions, say) of electors for that profile. For example, 7.2 million people prefer MarylinMonroe, then Emanuelle Beart, then Claudia Cardinale, 4.8 millions prefer Angelina Jolie, etc. Here's the full data:

votes :: [(Double,[Star])]
votes = [
(7.2,[MarylinMonroe,EmmanuelleBeart,ClaudiaCardinale,BrigitteBardot,AngelinaJolie]),
(4.8,[AngelinaJolie,ClaudiaCardinale,EmmanuelleBeart,BrigitteBardot,MarylinMonroe]),
(4,[BrigitteBardot,AngelinaJolie,ClaudiaCardinale,EmmanuelleBeart,MarylinMonroe]),
(3.6,[EmmanuelleBeart,BrigitteBardot,ClaudiaCardinale,AngelinaJolie,MarylinMonroe]),
(1.6,[ClaudiaCardinale,AngelinaJolie,EmmanuelleBeart,BrigitteBardot,MarylinMonroe]),
(0.8,[ClaudiaCardinale,BrigitteBardot,EmmanuelleBeart,AngelinaJolie,MarylinMonroe])
]


With this we need a few helper method before we're ready to implement our voting algorithms.

We need a way to tally votes for stars, taking into account that several profiles may vote for the same star at the same round (Claudia Cardinale at the first round, say). We use an array with the addition as accumulation function, sorted my popularity
accumVotes ::  [(Star,Double)] ->  [(Star,Double)]
accumVotes v=let
arr=(accumArray (+) 0 (MarylinMonroe,ClaudiaCardinale) v):: Array Star Double
in sortBy (\a b -> compare (snd b) (snd a)) (assocs arr)


For some reason I needed to tell GHC about the array type, it couldn't infer it.
We need a way to get the votes for a given round (even if we'll only be using the first round this way)
roundResults :: Int -> [(Star,Double)]
roundResults r=let
v=map (\(a,b)->(b !! r,a)) votes
in accumVotes v


And a simple extraction function to get the winner's name from accumulated votes:
bestVote ::[(Star,Double)] -> Star
bestVote v= fst $ head $ (accumVotes v)


Now we're ready. The first algorith is a simple one round voting election:

oneRound :: Star
oneRound=bestVote (roundResults 0)


This makes Marylin Monroe the clear winner. But a lot of countries use a two round system: the most popular candidates after the first round make it through to the second round:

We first need a helper function that retrieves the first element from a first list found in a second list (is there a standard method somewhere?)
findFirst :: Eq a => [a] -> [a] -> a 
findFirst toFind (a:rest) = if elem a toFind
then a
else findFirst toFind rest


Then it's straightforward: we get the first two candidates after the first round, and accumulate their results over all the profiles
twoRounds :: Star
twoRounds= let
(fr1:fr2:_)=(roundResults 0)
allScores=map (\(a,b)->(findFirst [fst fr1,fst fr2] b,a)) votes
in bestVote allScores


Angelina Jolie for President! A third method we can use is to proceed by elimination: at each round, we drop the least popular candidate, until we get only one:

elimination :: Star
elimination= fst $ elimination' (roundResults 0)
where
elimination' :: [(Star,Double)] -> (Star,Double)
elimination' (a:b:[])=a
elimination' l= let
firstRound= map fst $ init l
in elimination' $ filter (\a->(snd a) >0.0 ) $ accumVotes $ map (\(a,b)->(findFirst firstRound b,a)) votes


This little recursivity yields Brigitte Bardot. Borda suggested another method: we assign a weight to each candidate depending on its ranking, that weight is used as a multiplier of the votes. First choice gets a total tally of the votes times 5, second choice 4, etc.

borda :: Star
borda = bestVote $ concat $ map (\(a,ss)-> map (\(s,mul)->(s,mul*a)) (zip ss [5,4 .. 1])) votes


And this time, Emanuelle BĂ©art comes on top! Last method we will survey is from Condorcet: we look at each match bewteen two stars in isolation. A match is won if more votes put the first star in front of the second star. We first calculate all the possible matches than consider each won match as 1 vote, and accumulate as before:

condorcet :: Star
condorcet= let
matches=[[x,y] | x <-allStars, y <- tail [x .. ClaudiaCardinale]]
matchResults= map (\match->(bestVote $ map (\(a,b)->(findFirst match b,a)) votes,1)) matches
in bestVote matchResults


And, behold, the winner through this method is... Claudia Cardinale! Five methods, five winners!
Of course these are really quick draft of voting methods, they should take into accound draws, etc... Do not use this code to elect the president of a real country!

Tuesday, September 02, 2008

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.

Friday, July 11, 2008

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...

Tuesday, July 08, 2008

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!

Friday, June 27, 2008

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)

Friday, June 20, 2008

Serializing Haskell objects to JSON

I'm trying to do some simple serialization of Haskell objects to save some state to disk. After tearing some of my hair out debugging parse errors due to silly code I'd written in Read instances declarations, I've decided to use another approach. I'm going to save objects as JSON, since I've already used that JSON library.
The first task is to write generic code that can serialize a Data instance to JSON. This has probably been done somewhere else, but I need to learn, right? So I took a deep breath and dived into Data.Generics.
I quickly rounded up the issues I would face. Most notably, Strings and lists are accessed without any syntaxic sugar, so to speak: Strings are lists of Char, and lists are made of two fields, the head and the rest. Of course, you say, but from that I need to regenerate String and lists of JSON Value objects.
So, to start, how to recognize Strings to treat them differently than other algrebraic types:

isString :: Data a => a -> Bool
isString a = (typeOf a) == (typeOf "")


There's probably better ways to do that, just tell me (-:

Lists (that are not strings) can be recognized with abstract representations of constructors, which are equals regardless of the actual type of elements in the list

isList :: Data a => a -> Bool
isList a
| isString a = False
| otherwise = (typeRepTyCon (typeOf a)) == (typeRepTyCon $ typeOf ([]::[Int]))


Now, transforming a list of the form (head,rest) to [head1,head2...]

jsonList :: Data a => a -> [JSON.Value]
jsonList l=
concat $ gmapQ f l
where f b
| (isList b)= jsonList b
| otherwise = [objToJson b]


For each element (the actual number depends on whether we're the empty list or not) we either reapply the same method, if it's the inner list or we simply transform to JSON

And then the actual method on objects:

objToJson :: Data a => a -> JSON.Value
objToJson o | isString o=JSON.String (fromJust $ ((cast o)::(Maybe String)))
objToJson o | isList o=JSON.Array (jsonList o)
objToJson o | otherwise=
let
c=toConstr o
in
case (constrRep c) of
AlgConstr _-> JSON.Object (Data.Map.fromList(zip (constrFields c) (gmapQ objToJson o)))
StringConstr s -> JSON.String s
FloatConstr f -> JSON.Number f
IntConstr i -> JSON.Number (fromIntegral i)


We first handle Strings, then list, then general objects using constrRep to distinguish between algebraic types that create JSON objects with the proper field names (using constrFields) and other types for JSON primitives.

And that's it for the serialization! The Generics package is not that hard to use but you have to look up examples to figure out how actually use the functions like gmapQ and such...

Now, I have to work on the opposite process: given a type and JSON data, reconstruct the objects... More Haskell fun!

Friday, April 11, 2008

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.

Tuesday, April 01, 2008

Me and my compiler

Pfiuu, long time no post, between my day time work, playing with Haskell and Lispy things (cool sutff like Clojure) and my extra-programming activities (yes, yes)...
I was just thinking about dynamically vs statically typed languages, since there is a lot of discussion about that on the web these days. For example, this article talks about refactoring in both static and dynamic languages. Well, I'm not a huge fan of all the refactoring utilities Eclipse give me, but there's one feature I use a lot: you know, when I change something, like the return type or the arguments of a method, my IDE helpfully adds little red crosses on all the source files that won't compile any more. So then I go through them and adapt the code.
Of course in a dynamically typed language I wouldn't get that, but since everybody has 100% code path coverage in their unit tests, it's just deferring the red cross marking a bit lower than the chain, right? Well, at work it takes 30 minutes to build our whole software from SVN (and only a few seconds to rebuild one individual module from inside Eclipse), and several hours to unit test everything (and have we got 100% test coverage?), so... Methinks I'll stick with something that can check that my types are coherent for me when I work on big projects...

Friday, January 18, 2008

Scraping my boilerplate: Generics instead of Records

I was talking last week about my trouble writing simple code to access and update record field in Haskell. While talking with justin about it, he suggested using parameter type for record object, so that the compiler would check that an update method would actually take as parameters the proper rating and the corresponding update function. That was cool enough, and that got me into the "Scrap your boilerplate" papers and Data.Generics modules. What I have now, using generics programming, is fairly simple and I think I'm getting closer to what Haskell code should be like.
First, Ratings: a Rating has three int values: the current level, normal level, and the experience points. What I do now is that each value is actually typed, and the Rating only holds a list of them:

data RatingScoreType=Normal |
Current |
Experience
deriving (Show,Read,Enum,Eq,Typeable,Data)

data RatingScore=RatingScore RatingScoreType Int
deriving (Show,Read,Typeable,Data)
data Rating=Rating [RatingScore]
deriving (Typeable,Data)

With that I can add an update method that only changes a RatingScore if the type match with the type provided:

addRS :: RatingScoreType -> Int -> RatingScore -> RatingScore
addRS t2 b rs@(RatingScore t1 a)
| t1==t2=RatingScore t1 (a+b)
| otherwise=rs


And a method that tells me if a score match the given type

getRS :: RatingScoreType -> RatingScore -> Bool
getRS t2 rs@(RatingScore t1 a)
| t1==t2=True
| otherwise=False


(note that addRS can be rewritten using getRS but we don't gain anything in code size)

I can then use Data.Generics functions to provide generic update and get functions:

addR :: Data a => RatingScoreType -> Int -> a -> a
addR rst i=everywhere (mkT (addRS rst i))

getR :: Data a => RatingScoreType -> a -> Int
getR rst a=
let (RatingScore t1 b)= head $ listify (getRS rst) a
in b


(There are probably other and maybe better way of writing these, but hey, the documentation is not very rich in examples...)

The level above Ratings are Characteristics: a character holds an array of CharacteristicRating:

data CharacteristicRating = CharacteristicRating Characteristic Rating
deriving (Show,Read,Typeable,Data)


Where Characteristic is again an Enum of all possible characteristics.

I define the similar 4 functions as above, except they filter on Characteristic first and RatingScoreType second:

addC :: Characteristic -> RatingScoreType -> Int -> CharacteristicRating -> CharacteristicRating
addC c2 rst i cr@(CharacteristicRating c1 r)
| c1==c2=everywhere (mkT (addRS rst i)) cr
| otherwise=cr

getC :: Characteristic -> RatingScoreType -> CharacteristicRating -> Bool
getC c2 rst cr@(CharacteristicRating c1 r)
| c1==c2=True
| otherwise=False

addCharacteristic :: Data a => Characteristic -> RatingScoreType -> Int -> a -> a
addCharacteristic c rst i a = everywhere (mkT (addC c rst i)) a

getCharacteristic :: Data a => Characteristic -> RatingScoreType -> a -> Int
getCharacteristic c rst a =
let cr=head $ listify (getC c rst) a
in getR rst cr


This is pretty cool: if I have a Character c:
getCharacteristic Strength Current c


Gives me the current strength! And a function can take a Data instance (a Character or anything else) and a Characteristic and do both testing and changing value in perfect safety!

Now I'm only just starting playing the Data.Generics, and more generally with Haskell program design, but this is cool. My RPG is not progressing fast, but the main game here is actually building it, not playing it!!

Friday, January 11, 2008

Nested records headaches in Haskell

I'm fighting a bit with Haskell records and named fields. This post has some valid remarks, but no real solutions. The main problem I have is managing elegantly nested records:
In my (embryonic) Haskell RPG game, a character is defined as a data type with several named fields (name, gender, traits). Traits is a collection of all characteristics (Strength, Dexterity, etc.). Each trait is itself a record with three values (normal level, current level, experience points). When an action is performed, not only we look at a rating value, we also update the rating experience as a result. So I want a function that takes a character, the name of a characteristic, and can update the proper characteristic rating.
With records
Traits { strength::Rating...}
I get a lookup function: a function strength that I can use to get the current value, so I can have a function like
testTrait :: Character -> (Traits -> Rating) -> ...
Where ... is whatever result the function returns (something like IO(Character,TestResult). But if testTrait needs to modify the record, I don't have a dynamic function to do it! And even if my code could hard code that "strength" is the trait I need, then the update mechanism is singularly cumbersome, since:
let c1=c{traits{strength{experience=1}}}
Doesn't compile (c is a character, I want to set experience of strength to 1). And if I want to modify the value (like do a +1 instead of setting to 1), then I need to unstack everything and rebuild it. Argh! Surely there is a better way?

The solution I have for the moment is that Traits contains only a list of Rating objects. Then I've defined an Enum with a constructor for each characteristic:
data Characteristic = Strength | ...
deriving (Show,Read,Eq,Enum,Bounded)
and I can have a method that combines fromEnum and !! to retrieve the right value. I can also have a little function that let me update a precise element in a list. But of course the type system does not guarantee me that every Character will have the right amount of Rating objects in the array!

It may be that my brain has been totally formatted by years of Java (in Java I could just pass the Rating object and it would get modified in place of course), but I just don't know what structure would give me total safety (enforcing that every character has the proper data) with no boilerplate code and no duplication. (I know I can define helper methods to do all of that, but I though Haskell would let me cut the amount of purely technical code needed and concentrate on the business).

Haskell syntax is not Java syntax; good or bad?

In this blog, the author expresses the opinion that an important part of a language popularity: Java was successful because it looked familiar to C++ developers, and similarly new languages should use Java syntax. This struck a chord: after all, I have started writing a pure functional language using Java syntax. I thought that having a similar syntax would help grasping the language better. But now I wonder. Not only do C++ and Java share a similar syntax, they also share some concepts (objects, etc...). If a language is intrinsically different (like a pure functional language with monads, say), then having a different syntax tells you straight away: warning! This is different, so not only you must learn a new syntax, but you must also learn a new way of programming.
So maybe having Haskell using a totally different syntax is A Good Thing. And it gives me a nice excuse to stop trying to create my own little language that looks a bit like Java but doesn't act like Java and concentrate on writing Haskell code.