ski*_*lls 1 haskell graph path-finding
我正在尝试在haskell中编写一个代码,从A点到F点,在棋盘游戏中,本质上是一个Matrix,遵循最短的路径.
这是董事会:
AAAA
ACCB
ADEF
*
0 0 N
机器人进入字母A,在底部(它是*),并且必须到达F,在板的底部是坐标,x = 0,y = 0,并指向北.F坐标是(3,0)
诀窍是,它不能跳过多个字母,它可以从A到B,B到C等,它可以遍历类型的字母(A到A,B到B等)
它只能前进并转弯(左,右)所以让我去F的路径就是
前进,前进,右,前进,前进,前进,右,跳,右,跳,前进,左,跳,左,前进,前进
一旦达到F,就完成了.
我想尝试这种方法,使用树
A
/ \
A D
/ \
/ \
A C
/ \ / \
/ \ D C
A
/ \
/ \
A
/
/
A
/ \
B A
/ \
C F
在那之后,我只需要验证正确的路径和最短的权利？
问题是,我没有那么多使用树木的经验.
你会指出任何其他方式来获得最佳路径吗？
非常感谢你 .
我们将通过分三部分搜索树来解决这个问题.首先,我们将构建一个Tree表示问题路径的路径,每个州都有分支.我们想找到到达具有一定标准的州的最短路径,因此我们将编写广泛的第一个搜索来搜索任何一个Tree.这对于您提供的示例问题来说还不够快,因此我们将使用转置表改进广度优先搜索,该转换表跟踪我们已经探索过的状态以避免再次探索它们.
我们假设你的游戏板是用from表示的ArrayData.Array
import Data.Array
type Board = Array (Int, Int) Char
board :: Board
board = listArray ((1,1),(3,4)) ("AAAA" ++ "ACCB" ++ "ADEF")
Data.Array没有提供一个默认的简单方法来确保我们查找值的索引!实际上是在.的范围内Array.为方便起见,我们将提供一个安全版本,Just v如果值在Array或Nothing以其他方式返回.
import Data.Maybe
(!?) :: Ix i => Array i a -> i -> Maybe a
a !? i = if inRange (bounds a) i then Just (a ! i) else Nothing
所述State难题的可通过的组合来表示position机器人和direction机器人面向.
data State = State {position :: (Int, Int), direction :: (Int, Int)}
deriving (Eq, Ord, Show)
这direction是一个单位向量,可以添加position到获取新的position.我们可以旋转的方向向量left或right与moveTowards它.
right :: Num a => (a, a) -> (a, a)
right (down, across) = (across, -down)
left :: Num a => (a, a) -> (a, a)
left (down, across) = (-across, down)
moveTowards :: (Num a, Num b) => (a, b) -> (a, b) -> (a, b)
moveTowards (x1, y1) (x2, y2) = (x1 + x2, y1 + y2)
为了探索董事会,我们需要能够从一个州确定哪些举动是合法的.要做到这一点,命名移动是有用的,所以我们将创建一个数据类型来表示可能的移动.
import Prelude hiding (Right, Left)
data Move = Left | Right | Forward | Jump
deriving (Show)
要确定哪些动作在板上是合法的,我们需要知道Board我们正在使用哪个和State机器人.这表明了类型moves :: Board -> State -> Move,但我们将在每次移动后计算新状态以确定移动是否合法,因此我们也将返回新状态以方便起见.
moves :: Board -> State -> [(Move, State)]
moves board (State pos dir) =
(if inRange (bounds board) pos then [(Right, State pos (right dir)), (Left, State pos (left dir))] else []) ++
(if next == Just here then [(Forward, State nextPos dir)] else []) ++
(if next == Just (succ here) then [(Jump, State nextPos dir)] else [])
where
here = fromMaybe 'A' (board !? pos)
nextPos = moveTowards dir pos
next = board !? nextPos
如果我们在电路板上,我们可以打开Left和Right; 我们是主板上的限制,保证所有State通过返回小号moves有positionS中的电路板上.如果在保存的值nextPos,next位置相匹配的是Just here,我们可以去Forward给它(如果我们离开董事会,我们假设是什么here是'A').如果next是我们能够做到Just的继承者.如果是不在董事会,它是,也不能匹配或.hereJumpnextNothingJust hereJust (succ here)
到目前为止,我们刚刚提供了问题的描述,并没有涉及用树回答问题.我们将使用中Tree定义的玫瑰树Data.Tree.
data Tree a = Node {
rootLabel :: a, -- ^ label value
subForest :: Forest a -- ^ zero or more child trees
}
type Forest a = [Tree a]
a的每个节点Tree a包含单个值a和分支列表,每个分支都是a Tree a.
我们Tree将从我们的moves函数中直接构建一个s 列表.我们要做出的每个结果moves的rootLabel一个Node,使分支机构的名单Tree,我们得到当我们小号explore的新状态.
import Data.Tree
explore :: Board -> State -> [Tree (Move, State)]
explore board = map go . moves board
where
go (label, state) = Node (label, state) (explore board state)
在这一点上,我们的树木是无限的; 没有什么可以阻止机器人无休止地旋转到位......我们无法画出一个,但是如果我们能让limit树只进行几步就可以.
limit :: Int -> Tree a -> Tree a
limit n (Node a ts)
| n <= 0 = Node a []
| otherwise = Node a (map (limit (n-1)) ts)
当我们开始左下角朝向电路板时,我们将只显示树的前几层State (4, 1) (-1, 0).
(putStrLn .
drawForest .
map (fmap (\(m, s) -> show (m, board ! position s)) . limit 2) .
explore board $ State (4, 1) (-1, 0))
(Forward,'A')
|
+- (Right,'A')
| |
| +- (Right,'A')
| |
| `- (Left,'A')
|
+- (Left,'A')
| |
| +- (Right,'A')
| |
| `- (Left,'A')
|
`- (Forward,'A')
|
+- (Right,'A')
|
+- (Left,'A')
|
`- (Forward,'A')
广度优先搜索在下降到下一个级别(进入被搜索的"深度")之前,在一个级别(跨越被搜索的"广度")探索所有可能性.广度优先搜索找到目标的最短路径.对于我们的树,这意味着在探索内层中的任何内容之前,在一层探索所有内容.我们将通过创建节点队列来探索将我们在下一层中发现的节点添加到队列末尾.队列将始终保留当前层中的节点,后跟下一层中的节点.它永远不会保留层中的任何节点,因为在我们移动到下一层之前,我们不会发现这些节点.
为了实现这一点,我们需要一个有效的队列,因此我们将使用Data.Sequence /中的序列.
import Data.Sequence (viewl, ViewL (..), (><))
import qualified Data.Sequence as Seq
我们从一个空的队列Seq.empty节点开始探索,一个空的路径[]进入Trees.我们将最初的可能性添加到queuewith 的结尾><(序列的连接)和go.我们看一下的开头queue.如果没有任何东西EmptyL,我们没有找到通往目标的路径并返回Nothing.如果那里有东西,并且它与目标匹配p,我们将返回我们向后累积的路径.如果队列中的第一件事与目标不匹配,我们将其添加为路径的最新部分,并将其所有分支添加到剩下的部分queued.
breadthFirstSearch :: (a -> Bool) -> [Tree a] -> Maybe [a]
breadthFirstSearch p = combine Seq.empty []
where
combine queue ancestors branches =
go (queue >< (Seq.fromList . map ((,) ancestors) $ branches))
go queue =
case viewl queue of
EmptyL -> Nothing
(ancestors, Node a bs) :< queued ->
if p a
then Just . reverse $ a:ancestors
else combine queued (a:ancestors) bs
这让我们写我们的第一个solve为Board秒.这里很方便,所有返回的位置moves都在板上.
solve :: Char -> Board -> State -> Maybe [Move]
solve goal board = fmap (map fst) . breadthFirstSearch ((== goal) . (board !) . position . snd) . explore board
如果我们为我们的主板运行它,它永远不会完成!好吧,最终它会,但我的餐巾纸计算表明它将需要大约4000万步.迷宫末端的路径长达16步,机器人经常会看到3个选项,可以在每个步骤中执行操作.
> solve 'F' board (State (4, 1) (-1, 0))
我们可以解决更小的难题
AB
AC
*
我们可以代表这个难题的董事会
smallBoard :: Board
smallBoard = listArray ((1,1),(2,2)) ("AB" ++ "AC")
我们solve也找'C'起行3列1看往低数行.
> solve 'C' smallBoard (State (3, 1) (-1, 0))
Just [Forward,Forward,Right,Jump,Right,Jump]
当然,这个问题必须比探索4000万条可能的路径更容易解决.大多数这些路径包括旋转到位或随机地来回蜿蜒.退化路径都共享一个属性,他们继续访问他们已经访问过的状态.在breadthFirstSeach代码中,这些路径不断向队列添加相同的节点.我们可以通过记住我们已经看过的节点来摆脱所有这些额外的工作.
我们会记得设定我们已经看到一个节点Set从Data.Set.
import qualified Data.Set as Set
对于签名,breadthFirstSearch我们将从节点的标签添加到该节点的分支的表示的函数.只要节点外的所有分支都相同,表示应该相等.为了快速比较O(log n)时间表示与Set我们要求表示具有Ord实例而不仅仅是相等.该Ord实例允许Set使用二进制搜索检查成员资格.
breadthFirstSearchUnseen:: Ord r => (a -> r) -> (a -> Bool) -> [Tree a] -> Maybe [a]
除了保持的轨迹queue,breadthFirstSearchUnseen跟踪该组表示已的seen,开始Set.empty.每次我们将分支添加到queuewith时,combine我们也会添加表示seen.我们只添加unseen其表示不在我们已经拥有的分支集合中的分支seen.
breadthFirstSearchUnseen repr p = combine Set.empty Seq.empty []
where
combine seen queued ancestors unseen =
go
(seen `Set.union` (Set.fromList . map (repr . rootLabel) $ unseen))
(queued >< (Seq.fromList . map ((,) ancestors ) $ unseen))
go seen queue =
case viewl queue of
EmptyL -> Nothing
(ancestors, Node a bs) :< queued ->
if p a
then Just . reverse $ ancestors'
else combine seen queued ancestors' unseen
where
ancestors' = a:ancestors
unseen = filter (flip Set.notMember seen . repr . rootLabel) bs
现在我们可以改进我们的solve功能使用breadthFirstSearchUnseen.来自节点的所有分支都由State- Move达到该状态的标签无关 - 因此我们仅使用元组的snd一部分(Move, State)作为节点的表示.
solve :: Char -> Board -> State -> Maybe [Move]
solve goal board = fmap (map fst) . breadthFirstSearchUnseen snd ((== goal) . (board !) . position . snd) . explore board
我们现在可以solve很快地完成原始拼图.
> solve 'F' board (State (4, 1) (-1, 0))
Just [Forward,Forward,Forward,Right,Forward,Forward,Forward,Right,Jump,Right,Jump,Forward,Left,Jump,Left,Jump,Jump]