[Haskell-beginners] Translating imperative algorithms to Haskell
Stephen Blackheath [to Haskell-Beginners]
mutilating.cauliflowers.stephen at blacksapphire.com
Sun Feb 21 14:29:13 EST 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 at haskell.org
>> http://www.haskell.org/mailman/listinfo/beginners
>>
> _______________________________________________
> Beginners mailing list
> Beginners at haskell.org
> http://www.haskell.org/mailman/listinfo/beginners
>
More information about the Beginners
mailing list