[Haskell-cafe] Translating an imperative algorithm - negascout

Toby Hutton toby.hutton at gmail.com
Thu Feb 26 18:19:56 EST 2009


On Fri, Feb 27, 2009 at 7:54 AM, Colin Paul Adams
<colin at colina.demon.co.uk> wrote:
> Hello Haskellers,
>
> I want to implement the negascout algorithm for the game I'm writing.
>
> Wikipedia gives the algorithm in imperative terms:
>
> http://en.wikipedia.org/wiki/Negascout
>
> I've tried to translate this into Haskell. I'm not sure if I'm going
> about it the right way, and if I am, if I've done it correctly.

In my opinion keeping the code looking vaguely like the pseudo-code is
a good idea for when you revisit it weeks later and try to remember
what the hell you were originally doing.

But I don't want to try and refactor the code you've provided without
some tests to ensure everything is correct.  Rule number one for
refactoring. :)  But for starters I imagine it's far more readable to
covert all the 'case boolExpr of' expressions to 'if then else'.

Secondly there's a lot of repeated functionality in there that should
be abstracted to smaller functions, which I think could still be done
without sacrificing the correlation to the algorithm pseudocode.
There's 3 parts which check if alpha is greater than beta which could
be abstracted and there's the check if rest is empty else recurse
which could be abstracted.  negascout' would be far more readable if
you did this as long as you gave the helper functions good names. :)

Sorry to be so vague though.  If you have some data and tests then I
can help you out some more if you like.




> Any comments on my effort here, are welcome:
>
> module Move (negascout
>            ) where
>
> {-# contract negascout Ok -> {depth | depth >= 0} ->
>  Ok -> Ok -> Ok #-}
> negascout :: Node -> Int -> Int -> Int -> Int
> negascout node depth alpha beta =
>    case depth == 0 || is_terminal node of
>      True -> evaluate node
>      False -> let child:rest = children node
>                   b = beta  -- initial window is (-beta, -alpha)
>               in negascout' child (depth-1) (- b) (- alpha) beta rest
>
>
> -- Implementation
>
> {-# contract negascout' Ok -> {depth | depth >= 0} ->
>  Ok -> Ok -> Ok -> Ok -> Ok #-}
> negascout' :: Node -> Int -> Int -> Int -> Int -> [Node] -> Int
> negascout' node depth beta' alpha beta rest =
>    let a = negate $ negascout child depth beta' alpha
>    in case a > (- alpha) of
>         True -> let alpha' = a
>                 in case alpha' >= beta of
>                      True -> alpha' -- beta cut-off
>                      False -> case alpha' >= (- beta') of -- null window failed high?
>                                 True -> let alpha'' = negate $ negascout child depth (- beta) (- alpha') -- full re-search
>                                         in case alpha'' >= beta of
>                                                         True -> alpha'' -- beta cut-off
>                                                         False -> case rest of
>                                                                    [] -> alpha''
>                                                                    child':rest' -> let b' = alpha'' + 1
>                                                                                    in negascout' child' depth (- b') alpha'' beta rest'
>                                            False -> case rest of
>                                                       [] -> alpha'
>                                                             child':rest' ->  let b' = alpha' + 1
>                                                                              in negascout' child' depth (- b') alpha' beta rest'
>                    False -> case rest of
>                               [] -> alpha
>                                     child':rest' ->  let b' = alpha + 1
>                                                      in negascout' child' depth (- b') alpha beta rest'
>
>
> --
> Colin Adams
> Preston Lancashire
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>


More information about the Haskell-Cafe mailing list