Haskell Zipper

Haskell Zipper

二叉树

记录方向

二元树

data Tree a = Empty | Node a (Tree a) (Tree a)

改变节点值

data Direction = L | R

change :: [Direction] -> Tree Char -> Tree Char
change (L:xs) (Node x l r) = Node x (change xs l) r
change (R:xs) (Node x l r) = Node x l (change xs r)
change [] (Node _ l r) = Node 'P' l r

查看节点值

elemAt :: [Direction] -> Tree a -> a
elemAt (L:xs) (Node _ l _) = elemAt xs l
elemAt (R:xs) (Node _ _ r) = elemAt xs r
elemAt [] (Node x _ _) = x

示例

elemAt [R, L] $ change [R, L] testTree
= 'P'

行动函数

向右向左行动后, 动作(面包屑)前插在 List

goLeft :: (Tree a, [Direction]) -> (Tree a, [Direction])
goLeft (Node _ l _, xs) = (l, L:xs)

goRight :: (Tree a, [Direction]) -> (Tree a, [Direction])
goRight (Node _ _ r, xs) = (r, R:xs)

逻辑函数

goLeft (goRight (testTree, []))
= (..., [L,R])

定义 -:

(-:) :: a -> (a -> b) -> b
x -: f = f x

(testTree, []) -: goRight -: goLeft
= (..., [L,R])

重定义记录

类型

data Crumb a = LeftCrumb a (Tree a) | RightCrumb a (Tree a)

• LeftCrumb 左方向 RightCrumb 右方向
• a 节点值
• Tree a 未走方向的子树

goLeft

goLeft :: (Tree a, [Crumb a]) -> (Tree a, [Crumb a])
goLeft (Node x l r, xs) = (l, LeftCrumb x r : xs)

goRight

goRight :: (Tree a, [Crumb a]) -> (Tree a, [Crumb a])
goRight (Node x l r, xs) = (r, RightCrumb x l : xs) 

goUp

goUp :: (Tree a, [Crumb a]) -> (Tree a, [Crumb a])
goUp (t, LeftCrumb x r : xs) = (Node x t r, xs)
goUp (t, RightCrumb x l : xs) = (Node x l t, xs)

Zipper

类型

type Zipper a = (Tree a, [Crumb a])

goLeft

goLeft :: Zipper a -> Zipper a
goLeft (Node x l r, xs) = (l, LeftCrumb x r : xs)

goRight

goLeft :: Zipper a -> Zipper a
goLeft (Node x l r, xs) = (r, RightCrumb x l : xs)

goUp

goUp :: Zipper a -> Zipper a
goUp (t, LeftCrumb x r : xs) = (Node x t r, xs)
goUp (t, RightCrumb x l : xs) = (Node x l t, xs)

modify

modify :: (a -> a) -> Zipper a -> Zipper a
modify f (Node x l r, xs) = (Node (f x) l r, xs)
modify f (Empty, xs) = (Empty, xs)

(testTree, []) -: goLeft -: goRight -: modify (\_ -> 'P')

attach

attach :: Tree a -> Zipper a -> Zipper a
attach t (_, xs) = (t, xs)

示例

t1 = (testTree, []) -: goLeft -: goLeft -: goLeft -: goLeft
t2 = t1 -: attach (Node 'Z' Empty Empty)

goTop

goTop :: Zipper a -> Zipper a
goTop (t, []) = (t, [])
goTop z = goTop (goUp z)

List

类型

data List a = Empty | Cons a (List a)

type ListZipper a = ([a], [a])

goForward

goForward :: ListZipper a -> ListZipper a
goForward (x:xs, bs) = (xs, x:bs)

goBack

goBack :: ListZipper a -> ListZipper a
goBack (xs, b:bs) = (b:xs, bs)

示例

xs = [1, 2, 3, 4]
goForward (xs, []) = ([2, 3, 4], [1])

goForward ([2, 3, 4], [1]) = ([3, 4], [2, 1])

goForward ([3, 4], [2, 1]) = ([4], [3, 2, 1])

goBack ([4], [3, 2, 1]) = ([3, 4], [2, 1])

文件系统

类型

type Name = String
type Data = String
data FSItem = File Name Data | Folder Name [FSItem]

Zipper

type FSZipper = (FSItem, [(Name, [FSItem], [FSItem])])

goUp

goUp :: FSZipper -> FSZipper
goUp (item, (name, ls, rs) : bs) = (Folder name (ls ++ [item] ++ rs), bs)

goTo

import Data.List (break)

goTo :: Name -> FSZipper -> FSZipper
goTo name (Folder folderName items, bs) =
	let (ls, item:rs) = break (nameIs name) items
	in (item, (folderName, ls, rs) : bs)
	
nameIs :: Name -> FSItem -> Bool
nameIs name (Folder folderName _) = name == folderName
nameIs name (File fileName _) = name == fileName

示例

t1 = (myDisk, []) -: goTo "f1" -: goTo "e.bmp"

fst t1 = File "e.bmp" "Yikes!"

t2 = t1 -: goUp -: goTo "d.gif"

fst t2 = File "d.gif" "smash!!"

myDisk :: FSItem  
    myDisk = 
        Folder "root"   
            [ File "a.wmv" "baaaaaa"  
            , File "b.avi" "god bless"  
            , Folder "f1"  
                [ File "c.jpg" "bleargh"  
                , File "d.gif" "smash!!"  
                , File "e.bmp" "Yikes!"  
                ]  
            , File "f.doc" "best mustard"  
            , Folder "f2"  
                [ File "g.exe" "10gotofart"  
                , File "h.dmg" "mov eax, h00t"  
                , File "i.exe" "really not a virus"  
                , Folder "f3"  
                    [ File "j.hs" "main = print (fix error)"  
                    , File "k.hs" "main = print 4"  
                    ]  
                ]  
            ]

fsRename

fsRename :: Name -> FSZipper ->FSZipper
fsRename name (Folder _ items, bs) = (Folder name items, bs)
fsRename name (File _ items, bs) = (File name items, bs)

示例

(myDisk, []) -: goTo "f1" -: fsRename "1f" -: goUp

fsNewFile

fsNewFile :: FSItem -> FSZipper -> FSZipper
fsNewFile item (Folder name items, bs) = (Folder name (item:items), bs)

示例

(myDisk, []) -: goTo "f1" -: fsNewFile (File "l.jpg" "lol") -: goUp

Maybe Zipper

goLeft

goLeft :: Zipper a -> Maybe (Zipper a)
goLeft (Node x l r, bs) = Just (l, LeftCrumb x r : bs)
goLeft (Empty, _) = Nothing

goRight

goRight :: Zipper a -> Maybe (Zipper a)
goRight (Node x l r, bs) = Just (r, RightCrumb x l : bs)
goRight (Empty, _) = Nothing

goUp

goUp :: Zipper a -> Maybe (Zipper a)
goUp (t, LeftCrumb x r : bs) = Just (Node x t r, bs)
goUp (t, RightCrumb x l : bs) = Just (Node x l t, bs)
goUp (_, []) = Nothing

示例

testTree = Node 1 Empty (Node 2 Empty Empty)

return (testTree, []) >>= goRight
Just (Node 2 Empty Empty,[RightCrumb 1 Empty])

return (testTree,[]) >>= goRight >>= goRight
Just (Empty,[RightCrumb 2 Empty,RightCrumb 1 Empty])

return (testTree,[]) >>= goRight >>= goRight >>= goRight
Nothing