Haskell - 使用树计算最短路径 [英] Haskell - Calculating the shortest path using trees

问题描述

我试图在棋盘游戏中编写一个代码，在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的路径是 b
$ b

前进，前进，右转，前进，前进，前进，右转，右转，右转，前进，左转，跳转，左转，转发，转发

一旦达到F，就完成了。

我想试试这个方法，使用树

  A 
 / \ 
 AD 
 / \ 
 / \ 
 AC 
 / \ / \ 
 / \ DC 
 A 
 / \ 
 / \ 
 A 
 / 
 / 
 A 
 / \ 
 BA 
 / \ 
 CF 
  

之后，我只需要验证正确的路径和最短的权利？

问题是，我没有太多的使用树的经验。

您是否会指出任何其他方式来获得最佳路径？

非常感谢。

解决方案

我们将通过三部分搜索树来解决此问题。首先，我们将构建一个代表通过问题的路径的 Tree ，并为每个状态分支。我们希望找到达到具有一定标准的状态的最短路径，因此我们将编写广度优先搜索搜索任何树。这对于您提供的示例问题来说速度不够快，因此我们将通过在广度上优化搜索范围换位表，它跟踪我们已经探索过的状态，以避免再次探索它们。

构建树

我们假设您的棋盘以 Array from Data.Array

 导入Data.Array 
 
类型Board = Array（Int，Int）Char 
 
 board :: Board 
 board = listArray（（1,1），（3,4））（AAAA++ACCB++ADEF）
  

Data.Array 没有提供默认的简单方法来确保我们用！实际上在 Array 的范围内。为方便起见，我们将提供一个安全版本，如果该值在 Array 或<$中，则返回 Just v c $ c> Nothing 否则。

  import Data.Maybe 
 
 （！？）:: Ix i =>阵列i a  - >我 - >也许是
 a！？ i = if inRange（bounds a）然后我就是（a！i）else 
  

<$谜题的c $ c> State 可以由机器人的位置和方向机器人正面对。

  data State = State {position ::（Int，Int）， direction ::（Int，Int）} 
 derived（Eq，Ord，Show）
  

方向是可以添加到位置以获得新的位置的单位向量。我们可以旋转方向向量 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 ::（数字a，数字b）=> （a，b）→> （a，b）→> （a，b）
 moveTowards（x1，y1）（x2，y2）=（x1 + x2，y1 + y2）
  

为了探索董事会，我们需要能够从一个国家确定什么样的举动是合法的。要做到这一点，命名这些动作会非常有用，因此我们将创建一个数据类型来表示可能的动作。

 导入前导隐藏（右，左）
 
数据移动=左| Right |转发|跳转
导出（显示）
  

为了确定棋盘上什么棋子合法，我们需要知道我们正在使用哪个 Board ，机器人的 State 。这表明类型移动:: Board - >状态 - >移动，但我们将在每次移动后计算新状态，以确定移动是否合法，所以我们还会返回新状态以方便使用。

  moves :: Board  - >状态 - > [（移动，状态）] 
移动棋盘（状态位置）= 
（如果inRange（边界板）pos然后[（右，状态pos（右方向）），（左，状态pos （如果next == Just here then [（Forward，State nextPos dir）] else []）++ 
（if next == Just（succ）在这里）然后[（Jump，State nextPos dir）] else []）
其中
 here = fromMaybe'A'（board！？pos）
 nextPos = moveTowards dir pos 
下一个= board！？ nextPos 
  

如果我们在板子上，我们可以将 Left 和右键;我们在板上的限制保证所有状态>由移动返回具有位置 s在板上。如果 nextPos ，下一个位置的值与的值匹配，则 c $ c>我们可以去转发（如果我们离开董事会，我们假设这里 是'A'）。如果下一个是只是这是这里的继承者我们可以跳转到它。如果 next 不在板上，它就是 Nothing ，并且不能匹配 / code>或 Just（succ here）。





直到现在，我们只是提供了问题的描述，并没有涉及用树回答问题。我们将使用树 -tree.htmlrel =noreferrer> Data.Tree 。

 数据树a =节点{
 rootLabel :: a， -  ^标签值
 subForest :: Forest a  -  ^零个或多个子树
} 
 
类型Forest a = [Tree a] 
  

树a 包含单个值 a 和分支列表，每个分支都是树a

我们将以一种简单的方式建立一个 Tree code> moves 函数。我们打算将移动的 rootLabel 的每个结果作为 Node ，并让分支成为当我们探索新状态时得到的 Tree 的列表。

  import Data.Tree 
 
 explore :: Board  - >状态 - > [树（移动，状态）] 
探索board = map go。移动板
其中
去（标签，状态）=节点（标签，状态）（探索板状态）
  

此时，我们的树是无限的;没有任何东西可以阻止机器人无休止地旋转。我们不能绘制一个，但是如果我们能够 limit 这棵树只需要几个步骤，我们就可以了。

  limit :: Int  - >树a  - >树a 
限制n（节点a ts）
 | n< = 0 =节点a [] 
 |否则= Node a（map（limit（n-1））ts）
  

（$，$）>状态（4，1）（-1，0）时，我们从左下角开始面向棋盘的前几对树。

 （putStrLn。
 drawForest。
 map（fmap（\（m，s） - > show（m ，
 
 
 
 
 $ b $（b 
 
 
 
 
 
 | 
 +  - （右，'A'）
 | | 
 | +  - （右，'A'）
 | | 
 | ` - （左，'A'）
 | 
 +  - （左，'A'）
 | | 
 | +  - （右，'A'）
 | | 
 | ` - （左，'A'）
 | 
` - （转发，'A'）
 | 
 +  - （右，'A'）
 | 
 +  - （左，'A'）
 | 
` - （转发，'A'）
  

广度优先搜寻

广度优先搜索在下一级搜索之前（在所搜索内容的深度中）探索所有可能性（跨搜索内容的广度）， 。广度优先搜索找到到目标的最短路径。对于我们的树木来说，这意味着在探索内层的任何内容之前，先探索一层的所有内容。我们将通过创建一个节点队列来探索将下一层发现的节点添加到队列末尾来完成此任务。队列将始终保存来自当前层的节点，然后保存来自下一层的节点。它永远不会从这个层中保留任何节点，因为直到我们移动到下一层，我们才会发现这些节点。

为了实现这一点，我们需要一个高效的队列，所以我们将使用一个来自数据的序列.Sequence /

  import Data.Sequence（viewl，ViewL（..），（><） ）
导入合格的Data.Sequence as Seq 
  

我们从一个空队列 Seq.empty 要探索的节点和一个空路径 [] 放入树秒。我们用>< （序列级联）和队列结尾添加了最初的可能性C $ C>走。我们看看队列的开头。如果没有剩下任何东西， EmptyL ，我们没有找到目标路径并返回 Nothing 。如果那里有东西，并且它匹配目标 p ，我们返回我们已经向后积累的路径。如果队列中的第一项与目标不匹配，我们将其添加为路径的最新部分，并将其所有分支添加到队列的其余部分 。

  breadthFirstSearch ::（a  - > Bool） - > [树a]  - >可能[a] 
 breadthFirstSearch p = combine Seq.empty [] 
其中
合并队列祖先branch = 
 go（队列><（Seq.fromList。map（ ，）祖先）$分支））
去队列= 
案例viewl队列
 EmptyL  - >没有
（祖先，节点a bs）：<排队 - > 
如果p a 
则Just。反向$ a：ancestors 
 else排队等候（a：ancestors）bs 
  

这让我们为 Board s写下我们的第一个 solve 。在这里很方便，所有从 moves 返回的头寸都在板上。

  solve :: Char  - >板 - >状态 - >也许[移动] 
解决goal board = fmap（map fst）。 breadthFirstSearch（（==目标）。（board！）。position。snd）。探索董事会
  

如果我们为董事会运行它，它永远不会结束！嗯，最终它会的，但我的餐后计算表明，它将需要约4000万步。迷宫末端的路径长达16步，机器人经常出现3个选项，以便在每个步骤做什么。

 >解决'F'板（状态（4,1）（-1,0））
  

我们可以解决更小的难题，如

  AB 
 AC 
 * 
  
 
 
 
我们可以用这个拼图来代表这个拼图的板子。 
 
  smallBoard :: Board 
 smallBoard = listArray（（1,1），（2,2））（AB++AC）
  pre> 
 
 
我们解决它寻找'C'从行 3 列 1 开始寻找行号较小的行。 
 
 
 >解决'C'smallBoard（状态（3,1）（-1,0））
只是[前进，前进，右转，右转，跳转] 
  
 
 
 
换位表
 
 
 
当然，这个问题比探索4000万个可能的路径更容易解决。这些路径中的大部分都是由旋转到位或随机来回蜿蜒。退化的路径都共享一个属性，他们继续访问他们已经访问过的国家。在 breadthFirstSeach 代码中，这些路径不断向队列添加相同的节点。我们可以通过记住我们已经看到的节点来摆脱所有这些额外的工作。
 
 
 
我们会记住我们已经看到的一组节点  Set   Data.Set  。
  import合格Data.Set as Set 
  
签名 breadthFirstSearch 我们将从一个节点的标签添加一个函数到该节点分支的表示。只要节点外的所有分支都相同，表示就应该是相等的。为了快速比较 O（log n）时间中的表示与 Set ，我们要求表示有一个 Ord 实例，而不仅仅是相等。  Ord 实例允许 Set 检查二进制搜索。 
 
 
  breadthFirstSearchUnseen :: Ord r => （a→r）→> （a  - > Bool） - > [树a]  - >也许[a] 
  
除了跟踪队列， breadthFirstSearchUnseen 记录看过的的表示集合，从<$ c $开始C> Set.empty 。每次我们用 combine 将分支添加到队列中时，我们也将表示添加到看过。我们只添加 unseen 分支，其表示不在我们已经看到的分支组中。
  breadthFirstSearchUnseen repr p = combine Set.empty Seq.empty [] 
其中
合并了看到排队的祖先unseen = 
去
（见`Set.union`（Set.fromList。map（repr。rootLabel）$ unseen））
（queued><（Seq.fromList。map（（，））祖先）$ unseen））
去看队列= 
案例viewl队列
 EmptyL  - >没有
（祖先，节点a bs）：<排队 - > 
如果p a 
则Just。反向$ ancestors'
 else结合看到排队祖先'看不见的
其中
 ancestors'= a：ancestors 
 unseen =过滤器（翻转Set.notMember看到。repr。rootLabel）bs 
  
现在我们可以改进我们的 solve 函数来使用 breadthFirstSearchUnseen 。所有来自节点的分支都由 State 确定 - 到达该状态的 Move 标签无关紧要 - 所以我们只使用（Move，State）元组的 snd 部分作为节点的表示。 p> 
 
 
  solve :: Char  - >板 - >状态 - >也许[移动] 
解决goal board = fmap（map fst）。 breadthFirstSearchUnseen snd（（== goal）。（board！）。position。snd）。探索董事会
  
我们现在可以解决原始非常迅速地解谜。 
 
 
 >解决'F'板（状态（4,1）（-1,0））
只是[向前，向前，向前，向右，向前，向前，向前，向右，跳转，向右，跳转，向前，向左，跳转，左转，跳转，跳转] 
  
 
i am trying to write a code in haskell, that goes from point A, to point F, on a board game, that is essentially a Matrix, following the shortest path. 

This is the board:
AAAA
ACCB
ADEF
*
0 0 N
The robot enters on the letter A, on the bottom (where it is the * ), and must reach F, on the bottom of the board are the coordinates, x=0, y=0, and pointing towards North. F coordinate is (3,0)

The trick is, it can't jump more than one letter, it can go from A to B, B to C, etc. and it can walk through the letters of the type (A to A, B to B, etc)

It can only move forward and make turns (Left, right) so the path to let me go to F would be

Forward, Forward, Right, Forward ,Forward, Forward, Right, Jump, Right, Jump, Forward, Left, Jump, Left, Forward, Forward

Once it reaches F, it's done.

I want to try this approach, using a Tree
                  A
                 / \
                A   D
               / \ 
              /   \
             A     C
            / \   / \
           /   \ D   C
          A     
         / \  
        /   \ 
       A
      /
     /
    A
   / \
  B   A
 / \  
C   F 
After that i would only need to validate the correct path and shortest right?

Problem is , i don't have that much experience using trees.

Would you indicate any other way to get the best path?

Thank you very much . 
解决方案
We're going to solve this problem by searching a tree in three parts. First we will build a Tree representing the paths through the problem, with branches for each state. We'd like to find the shortest path to get to a state with a certain criteria, so we will write a breadth first search for searching any Tree. This won't be fast enough for the example problem you provided, so we will improve on the breadth first search with a transposition table which keeps track of states we have already explored to avoid exploring them again.

Building a Tree

We'll assume that your playing board is represented in an Array from Data.Array
import Data.Array

type Board = Array (Int, Int) Char

board :: Board
board = listArray ((1,1),(3,4)) ("AAAA" ++ "ACCB" ++ "ADEF")
Data.Array doesn't provide a default easy way to make sure indexes that we look up values for with ! are actually in the bounds of the Array. For convenience, we'll provide a safe version that returns Just v if the value is in the Array or Nothing otherwise.
import Data.Maybe

(!?) :: Ix i => Array i a -> i -> Maybe a
a !? i = if inRange (bounds a) i then Just (a ! i) else Nothing
The State of the puzzle can be represented by the combination of a position of the robot and the direction that the robot is facing.
data State = State {position :: (Int, Int), direction  :: (Int, Int)}
    deriving (Eq, Ord, Show)
The direction is a unit vector that can be added to the position to get a new position. We can rotate the direction vector left or right and moveTowards it.
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)
To explore a board, we will need to be able to determine from a state what moves are legal. To do this it'd be useful to name the moves, so we'll make a data type to represent the possible moves.
import Prelude hiding (Right, Left)

data Move = Left | Right | Forward | Jump
    deriving (Show)
To determine what moves are legal on a board we need to know which Board we are using and the State of the robot. This suggests the type moves :: Board -> State -> Move, but we re going to be computing the new state after each move just to decide if the move was legal, so we will also return the new state for convenience.
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
If we're on the board, we can turn Left and Right; the restriction that we be on the board guarantees all the States returned by moves have positions that are on the board. If the value held at the nextPos, next position matches what is Just here we can go Forward to it (if we're off the board, we assume what is here is 'A'). If next is Just the successor of what is here we can Jump to it. If next is off the board it is Nothing and can't match either Just here or Just (succ here).

Up until this point, we've just provided the description of the problem and haven't touched on answering the question with tree. We are going to use the rose tree Tree defined in Data.Tree.
data Tree a = Node {
        rootLabel :: a,         -- ^ label value
        subForest :: Forest a   -- ^ zero or more child trees
    }

type Forest a = [Tree a]
Each node of a Tree a holds a single value a and a list of branches which are each a Tree a.

We are going to build a list of Trees in a straightforward manner from our moves function. We are going to make each result of moves the rootLabel of a Node and make the branches be the list of Trees we get when we explore the new state.
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)
At this point, our trees are infinite; nothing keeps the robot from endlessly spinning in place.. We can't draw one, but we could if we could limit the tree to just a few steps.
limit :: Int -> Tree a -> Tree a
limit n (Node a ts)
    | n <= 0    = Node a []
    | otherwise = Node a (map (limit (n-1)) ts)
We'll display just the first couple levels of the tree when we start off the bottom left corner facing towards the board in 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')


Breadth First Search

Breadth first search explores all the possibilities at one level (across the "breadth" of what is being searched) before descending into the next level (into the "depth" of what is being searched). Breadth first search finds the shortest path to a goal. For our trees, this means exploring everything at one layer before exploring any of what's in the inner layers. We'll accomplish this by making a queue of nodes to explore adding the nodes we discover in the next layer to the end of the queue. The queue will always hold nodes from the current layer followed by nodes from the next layer. It will never hold any nodes from the layer past that because we won't discover those nodes until we have moved on to the next layer.

To implement that, we need an efficient queue, so we'll use a sequence from Data.Sequence/
import Data.Sequence (viewl, ViewL (..), (><))
import qualified Data.Sequence as Seq
We start with an empty queue Seq.empty of nodes to explore and an empty path [] into the Trees. We add the initial possibilities to the end of the queue with >< (concatenation of sequences) and go. We look at the start of the queue. If there's nothing left, EmptyL, we didn't find a path to the goal and return Nothing. If there is something there, and it matches the goal p, we return the path we have accumulate backwards. If the first thing in the queue doesn't match the goal we add it as the most recent part of the path and add all of its branches to the remainder of what was 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
This lets us write our first solve for Boards. It's convenient here that all of the positions returned from moves are on the board.
solve :: Char -> Board -> State -> Maybe [Move]
solve goal board = fmap (map fst) . breadthFirstSearch ((== goal) . (board !) . position . snd) . explore board
If we run this for our board it never finishes! Well, eventually it will, but my back of a napkin calculation suggests it will take about 40 million steps. The path to the end of the maze is 16 steps long and the robot is frequently presented with 3 options for what to do at each step.
> solve 'F' board (State (4, 1) (-1, 0))
We can solve much smaller puzzles like
AB
AC
*
Which we can represent the board for this puzzle with
smallBoard :: Board
smallBoard = listArray ((1,1),(2,2)) ("AB" ++ "AC")
We solve it looking for 'C' starting in row 3 column 1 looking towards lower numbered rows.
> solve 'C' smallBoard (State (3, 1) (-1, 0))
Just [Forward,Forward,Right,Jump,Right,Jump]


Transposition Table

Certainly this problem must be easier to solve than exploring 40 million possible paths. Most of those paths consist of spinning in place or randomly meandering back and forth. The degenerate paths all share one property, they keep visiting states they have already visited. In the breadthFirstSeach code, those paths keep adding the same nodes to the queue. We can get rid of all of this extra work just by remembering the nodes that we've already seen.

We'll remember the set of nodes we've already seen with a Set from Data.Set.
import qualified Data.Set as Set
To the signature of breadthFirstSearch we'll add a function from the label for a node to a representation for the branches of that node. The representation should be equal whenever all the branches out of the node are the same. In order to quickly compare the representations in O(log n) time with a Set we require that the representation have an Ord instance instead of just equality. The Ord instance allows Set to check for membership with binary search.
breadthFirstSearchUnseen:: Ord r => (a -> r) -> (a -> Bool) -> [Tree a] -> Maybe [a]
In addition to keeping track of the queue, breadthFirstSearchUnseen keeps track of the set of representations that have been seen, starting with Set.empty. Each time we add branches to the queue with combine we also add the representations to seen. We only add the unseen branches whose representations are not in the set of branches we've already 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
Now we can improve our solve function to use breadthFirstSearchUnseen. All of the branches from a node are determined by the State - the Move label that got to that state is irrelevant - so we only use the snd part of the (Move, State) tuple as the representation for a node.
solve :: Char -> Board -> State -> Maybe [Move]
solve goal board = fmap (map fst) . breadthFirstSearchUnseen snd ((== goal) . (board !) . position . snd) . explore board
We can now solve the original puzzle very quickly.
> 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]


                        
这篇关于Haskell  - 使用树计算最短路径的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！