[Haskell-beginners] Translating imperative algorithms to Haskell

[Stephen Blackheath [to Haskell-Beginners]]

Stephen, Mikhail & all,

I'll have a go...

Wikipedia's imperative pseudo-code:

function negascout(node, depth, α, β)
    if node is a terminal node or depth = 0
        return the heuristic value of node
    b := β                                          (* initial window is
(-β, -α) *)
    foreach child of node
        a := -negascout (child, depth-1, -b, -α)
        if a>α
            α := a
        if α≥β
            return α                                (* Beta cut-off *)
        if α≥b                                      (* check if
null-window failed high*)
           α := -negascout(child, depth-1, -β, -α)  (* full re-search *)
           if α≥β
               return α                             (* Beta cut-off *)
        b := α+1                                    (* set new null
window *)
    return α

My attempt to render into Haskell without ST monad and without
attempting to understand the algorithm at all.

Version 1 with lets

negascout :: Node -> Int -> Int -> Int -> Int
negascout node depth _ _  | terminal node || depth == 0 = heuristic node
negascout node depth alpha beta =
    ns (children node) alpha beta beta     -- initial window is (-beta,
-alpha)
  where
    ns (ch:chs) alpha beta b =
        let alpha' = alpha `max` negascout ch (depth-1) (-b) (-alpha)
        in  if alpha' >= beta then alpha' else                 -- beta
cut-off
            if alpha' >= b    then                             -- full
re-search
                let alpha'' = -negascout ch (depth-1) (-beta) (-alpha)
                in  if alpha'' >= beta then alpha''       -- beta cut-off
                    else  ns chs alpha'' beta (alpha''+1) -- new window
            else ns chs alpha' beta (alpha'+1)            -- new window
    ns [] alpha _ _ = alpha

Version 2 with cases

negascout :: Node -> Int -> Int -> Int -> Int
negascout node depth _ _  | terminal node || depth == 0 = heuristic node
negascout node depth alpha beta =
    ns (children node) alpha beta     -- initial window is (-beta, -alpha)
  where
    ns (ch:chs) alpha b =
        case alpha `max` negascout ch (depth-1) (-b) (-alpha) of
            alpha' | alpha' >= beta -> alpha'                  -- beta
cut-off
            alpha' | alpha' >= b    ->                         -- full
re-search
                case -negascout ch (depth-1) (-beta) (-alpha) of
                    alpha'' | alpha'' >= beta -> alpha''       -- beta
cut-off
                    alpha'' -> ns chs alpha'' (alpha''+1)      -- new window
            alpha' -> ns chs alpha' (alpha'+1)                 -- new window
    ns [] alpha _ = alpha

I think with case, it's slightly more readable.  Marginally more verbose
than the imperative version, because Haskell makes you do your state
keeping more explicitly.  Personally I find the Haskell easier to read.
 When I read the imperative version, it takes work to assemble in my
head what is written out explicitly in the Haskell, but maybe that's
just me.

I certainly don't think the Haskell version is any more complex.  I
think there are cases where mutability is so important to an algorithm
that Haskell struggles (at least in terms of performance), but I don't
think this is one of those cases.

Just for fun here's another version where I'm breaking it up into three
parts:


data Next a = Cont a | Break a

breakableFoldl :: (a -> b -> Next a) -> a -> [b] -> a
breakableFoldl body state xs = loop state xs
  where
    loop state [] = state
    loop state (x:xs) = case body state x of
        Cont state'  -> loop state' xs
        Break state' -> state'

negascout :: Node -> Int -> Int -> Int -> Int
negascout node depth _ _  | terminal node || depth == 0 = heuristic node
negascout node depth alpha0 beta = alphaOut
  where
    (alphaOut, _) = breakableFoldl (\(alpha, b) ch ->
            (alpha `max` negascout ch (depth-1) (-b) (-alpha))
                `betaCutoffOr` \alpha' ->
                    if alpha' >= b then      -- full re-search
                        (-negascout ch (depth-1) (-beta) (-alpha))
                            `betaCutoffOr` \alpha'' -> Cont (alpha'',
alpha''+1)
                    else
                        Cont (alpha', alpha'+1)
        ) (alpha0, beta) (children node)      -- initial window is
(-beta, -alpha)

    -- Break out if the input alpha value hits the beta cutoff,
otherwise pass
    -- it to a non-cutoff case.
    betaCutoffOr :: Int -> (Int -> Next (Int,Int)) -> Next (Int,Int)
    betaCutoffOr alpha _ | alpha >= beta = Break (alpha, undefined)
    betaCutoffOr alpha nonCutoffCase     = nonCutoffCase alpha


This is a higher level of abstraction, which communicates intent fairly
clearly, and shows how easily you can abstract common patterns out in
Haskell.  An improvement in this case?  I think so, but there are
arguments against that.

Here's the missing code that makes each version above typecheck:

data Node = Node {
        heuristic :: Int,
        children :: [Node]
    }

terminal :: Node -> Bool
terminal = undefined


Steve

Stephen Tetley wrote:
> Hello all
> 
> How are search trees generated and what is their 'shape' - i.e. leaf
> labelled, node labelled, binary trees or rose trees?
> 
> I've a functional reformulation of the Wikipedia algorithm which is
> about the same line count (excepting auxiliaries, which is a bit of a
> cheat), but its producing bad results on a leaf and node labelled rose
> tree.
> 
> By the way, the imperative essence of the negascout algorithm and what
> makes it elegant is how it cuts off (control flow), rather than
> statefulness (assignment). Even though the line count is roughly the
> same and I believe I match the traversal behaviour / cut offs, the
> imperative version is simply nicer than my functional version.
> 
> Best wishes
> 
> Stephen
> _______________________________________________
> Beginners mailing list
> Beginners at haskell.org
> http://www.haskell.org/mailman/listinfo/beginners
>