[Haskell-beginners] Translating imperative algorithms to Haskell

[Stephen Blackheath [to Haskell-Beginners]]

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 at haskell.org
>> http://www.haskell.org/mailman/listinfo/beginners
>>
> _______________________________________________
> Beginners mailing list
> Beginners at haskell.org
> http://www.haskell.org/mailman/listinfo/beginners
>