Re: [Haskell-beginners] Translating imperative algorithms to Haskell

21 Feb 2010

      All,

And... A slight variation that shadows alpha (which some people don't
like, but I think it's a great technique) and thereby avoids the mistake
I made in my previous three versions where I forgot a ' in -negascout ch
(depth-1) (-beta) (-alpha').  (You have to watch that in Haskell.)

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

Steve

Stephen Blackheath [to Haskell-Beginners] wrote:
...
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@haskell.org
http://www.haskell.org/mailman/listinfo/beginners
_______________________________________________
Beginners mailing list
Beginners@haskell.org
http://www.haskell.org/mailman/listinfo/beginners