Làm thế nào để chức năng tạo ra một bề rộng cây đầu tiên. (Với Haskell)

Question

Nói rằng tôi có những điều sau Haskell loại cây, trong đó "Nhà nước" là một wrapper đơn giản:

data Tree a = Branch (State a) [Tree a] 
      | Leaf (State a) 
      deriving (Eq, Show) 

Tôi cũng có một chức năng "mở rộng :: Tree a -> Tree một" mà phải mất một nút lá, và mở rộng nó thành một chi nhánh, hoặc lấy một chi nhánh và trả về nó không thay đổi gì. Loại cây này đại diện cho cây tìm kiếm N-ary. Tìm kiếm chiều sâu đầu tiên là một sự lãng phí, vì không gian tìm kiếm rõ ràng là vô hạn, vì tôi có thể dễ dàng tiếp tục mở rộng không gian tìm kiếm bằng cách sử dụng mở rộng trên tất cả các nút lá của cây và cơ hội vô tình bị thiếu mục tiêu-nhà nước là rất lớn ... do đó giải pháp duy nhất là một tìm kiếm rộng đầu tiên, thực hiện khá phong nha hơn here, mà sẽ tìm thấy giải pháp nếu nó ở đó.

Điều tôi muốn để tạo, mặc dù, cây đi qua tối đa tìm giải pháp. Đây là một vấn đề bởi vì tôi chỉ biết làm thế nào để làm điều này sâu đầu tiên, có thể được thực hiện bằng cách đơn giản gọi là "mở rộng" chức năng một lần nữa và một lần nữa vào nút con đầu tiên ... cho đến khi một mục tiêu nhà nước được tìm thấy. (Điều này thực sự sẽ không tạo ra bất kỳ điều gì khác sau đó là một danh sách thực sự khó chịu.)

Có thể cho tôi bất kỳ gợi ý nào về cách thực hiện điều này (hoặc toàn bộ thuật toán) hay không. ? (Hoặc bất kỳ nguồn nào về điều này, bởi vì tôi thấy khá ít.)

Answer 1

Bạn đã xem sốcủa Chris Okasaki chưa? Mô-đun Data.Tree bao gồm trình tạo cây monadic có tên là unfoldTreeM_BF sử dụng thuật toán được điều chỉnh từ giấy đó.

Dưới đây là một ví dụ mà tôi nghĩ rằng tương ứng với những gì bạn đang thực hiện:

Giả sử tôi muốn tìm kiếm một cây nhị phân vô hạn của chuỗi nơi tất cả các trẻ em trái là chuỗi mẹ cộng với "a", và bên phải trẻ em là cha mẹ cộng với "bb".Tôi có thể sử dụng để tìm kiếm unfoldTreeM_BF cây chiều rộng đầu tiên và trả lại cây tìm kiếm lên đến giải pháp:

import Control.Monad.State 
import Data.Tree 

children :: String -> [String] 
children x = [x ++ "a", x ++ "bb"] 

expand query x = do 
    found <- get 
    if found 
    then return (x, []) 
    else do 
     let (before, after) = break (==query) $ children x 
     if null after 
     then return (x, before) 
     else do 
      put True 
      return (x, before ++ [head after]) 

searchBF query = (evalState $ unfoldTreeM_BF (expand query) []) False 

printSearchBF = drawTree . searchBF 

Đây không phải là khủng khiếp khá, nhưng nó hoạt động. Nếu tôi tìm kiếm "aabb", tôi nhận được chính xác những gì tôi muốn:

| 
+- a 
| | 
| +- aa 
| | | 
| | +- aaa 
| | | 
| | `- aabb 
| | 
| `- abb 
| 
`- bb 
    | 
    +- bba 
    | 
    `- bbbb 

Nếu đây là loại điều bạn mô tả, không khó để thích ứng với loại cây của bạn.

UPDATE: Dưới đây là một phiên bản do-miễn expand, trong trường hợp bạn đang vào loại điều:.

expand q x = liftM ((,) x) $ get >>= expandChildren 
    where 
    checkChildren (before, []) = return before 
    checkChildren (before, t:_) = put True >> return (before ++ [t]) 

    expandChildren True = return [] 
    expandChildren _  = checkChildren $ break (==q) $ children x 

(Nhờ camccann cho thúc giục tôi ra khỏi thói quen cấu trúc điều khiển cũ Tôi hy vọng điều này Phiên bản có thể chấp nhận được.)

Answer 2

Tôi tò mò tại sao bạn cần chức năng expand - tại sao không chỉ đơn giản là xây dựng toàn bộ cây một cách đệ quy và thực hiện bất kỳ tìm kiếm nào bạn muốn?

Nếu bạn đang sử dụng expand để theo dõi các nút nào được tìm kiếm, hãy xây dựng danh sách khi bạn đi có vẻ đơn giản hơn hoặc thậm chí là cấu trúc cây thứ hai.

Dưới đây là một ví dụ nhanh chóng mà chỉ trả về kết quả đầu tiên mà nó tìm thấy, với sự giả mạo Leaf constructor loại bỏ:

data State a = State { getState :: a } deriving (Eq, Show) 

data Tree a = Branch { 
    state :: State a, 
    children :: [Tree a] 
    } deriving (Eq, Show) 

breadth ts = map (getState . state) ts ++ breadth (concatMap children ts) 
search f t = head $ filter f (breadth [t]) 

mkTree n = Branch (State n) (map mkTree [n, 2*n .. n*n]) 

testTree = mkTree 2 

Đang cố gắng nó ra trong GHCi:

> search (== 24) testTree 
24 

Đối Ngược lại, đây là một ngây thơ tìm kiếm theo chiều sâu đầu tiên:

depth (Branch (State x) ts) = x : (concatMap depth ts) 
dSearch f t = head $ filter f (depth t) 

... tất nhiên là không thành công s để chấm dứt khi tìm kiếm với (== 24), bởi vì các nhánh bên trái nhất là chuỗi vô tận 2 giây.