Tisztán funkcionális adatszerkezetek (folytatás)

Tisztán funkcionális adatszerkezetek (folytatás)

˝ Rövid összefoglalás az eddigiekrol A hatékony adatszerkezetek általában... „[..] language-independent only in the sense of Henry Ford: Programmers can use any language as they want, as long as it’s imperative.” – Chris Okasaki, Purely Functional Data Structures, 1996 Az imperatív adatszerkezetek viszont: I

Gyakran dönto˝ mértékben támaszkodnak az elemek felülírására („destructive update”)

I

Ezáltal nem tisztán funkcionálisak, mivel azok mindig (automatikusan) perzisztensek: az adatszerkezet régi ˝ állapotai is elérhetoek

Hatékony (megvalósítható) perzisztencia: lusta kiértékelés, memoization, amortizáció. [2..40]

Interlude: Zipper A zipper az adatszerkezet egy olyan ábrázolási módja, amely megkönnyíti annak bejárását és elemeinek módosítását. I

"gap buffer": ugyanazon pozícióhoz (kurzorhoz) tartozó beszúrások és törlések nyalábolása, optimalizációja – az amortizált költsége kevés.

I

Gyakran alkalmazzák nagyobb méretu˝ adatszerkezetekben való mozgásra vagy „fókuszálásra”, például: I I I

I

Fókusz és ablakok elhelyezésének kezelése (xmonad) ˝ Szövegszerkesztok Tranzakciós szemantikával rendelkezo˝ állományrendszerek – http://hackage.haskell.org/package/ZFS

˝ Ez a megoldás tetszoleges rekurzívan definiált adatszerkezet (lista, fa stb.) esetén alkalmazható. [3..40]

Kétirányú listák: "List with Zipper"

[4..40]

Kétirányú listák: "List with Zipper"

[5..40]

Kétirányú listák: implementáció (1)

newtype ZippList α = ZPL ([α], [α]) fromList :: [α] → ZippList α fromList xs = ZPL ([], xs) toList :: ZippList α → [α] toList (ZPL (xs, ys)) = reverse xs ++ ys get :: ZippList α → [α] get (ZPL (_, ys)) = ys

[6..40]

Kétirányú listák: implementáció (2) right :: ZippList α → ZippList α right (ZPL (xs, (y : ys))) = ZPL (y : xs, ys) right zl = zl left :: ZippList α → ZippList α left (ZPL ((x : xs), ys)) = ZPL (xs, x : ys) left zl = zl put :: Either α α → ZippList α → ZippList α put (Left e) (ZPL (xs, ys)) = ZPL (e : xs, ys) put (Right e) (ZPL (xs, ys)) = ZPL (xs, e : ys) putLeft = put ◦ Left putRight = put ◦ Right [7..40]

Kétirányú listák: implementáció (3)

modify :: (α → Maybe α) → ZippList α → ZippList α modify f (ZPL (xs, y : ys)) = ZPL $ case (f y ) of Nothing → (xs, ys) Just e → (xs, e : ys) modify _ zl = zl update f = modify (Just ◦ f ) delete = modify (const Nothing)

[8..40]

Kétirányú fák: "Tree with Zipper"

[9..40]

Kétirányú fák: "Tree with Zipper"

[10..40]

Kétirányú fák: "Tree with Zipper"

[11..40]

Kétirányú fák: "Tree with Zipper"

[12..40]

Kétirányú fák: implementáció (1)

data Tree α = Branch (Tree α) (Tree α) | Leaf α data TreeContext α = Top | L (TreeContext α) (Tree α) | R (Tree α) (TreeContext α) type Location α γ = (α, γ) type TreeLocation α = Location (Tree α) (TreeContext α)

[13..40]

Kétirányú fák: implementáció (2) treeLeft :: TreeLocation α → TreeLocation α treeLeft (Branch l r , c) = (l, L c r ) treeRight :: TreeLocation α → TreeLocation α treeRight (Branch l r , c) = (r , R l c) treeTop :: Tree α → TreeLocation α treeTop t = (t, Top) treeUp :: TreeLocation α → TreeLocation α treeUp (t, L c r ) = (Branch t r , c) treeUp (t, R l c) = (Branch l t, c)

[14..40]

Kétirányú fák: implementáció (3) treeUpmost :: TreeLocation α → TreeLocation α treeUpmost l@(t, Top) = l treeUpmost l = treeUpmost (treeUp l) treeChange :: TreeLocation α → (Tree α → Tree α) → TreeLocation α treeChange (t, c) f = (f t, c)

treeView :: TreeLocation α → Tree α treeView (t, _) = t Például: treeChange ((treeRight ◦ treeLeft ◦ treeTop) t) (const (Leaf 0)) [15..40]

Ráadás: Zipper monád

newtype Zipper λ α = Zipper { unZipper :: State λ α } deriving (Functor , Applicative, Monad, MonadState λ) traverse :: Location α γ → Zipper (Location α γ) α → α traverse start tt = evalState (unZipper tt) start move :: (Location α γ → Location α γ) → Zipper (Location α γ) α move f = do modify f gets fst change :: (α → α) → Zipper (Location α γ) α change f = do modify (λ (t, c) . (f t, c)) gets fst

[16..40]

Zipper monád: példa swapTree :: Zipper (TreeLocation α) (Tree α) swapTree = move swap where swap (t, R l c) = (l, L c t) swap (t, L c r ) = (r , R t c) treeMap :: (α → Tree α) → (Tree α → Tree α → Tree α) → (Tree α → Tree α) treeMap leaf branch = λ t . (treeTop t) 8 traverse8 treeMapM where treeMapM = do t ← gets fst case t of Branch _ _ → do move treeLeft lmod ← treeMapM swapTree rmod ← treeMapM move treeUp (change ◦ const) (branch lmod rmod ) Leaf x → return (leaf x)

[17..40]

FingerTree (intuíció)

[18..40]

FingerTree (intuíció)

[19..40]

FingerTree (intuíció)

[20..40]

FingerTree (intuíció)

[21..40]

FingerTree (intuíció)

[22..40]

FingerTree (intuíció)

[23..40]

FingerTree (intuíció)

[24..40]

Implementáció: társított (indexelt) típusszinonimák {-# LANGUAGE TypeFamilies, KindSignatures #-} class Collects α where type Elem α :: ? empty :: α insert :: Elem α → α → α ... instance Eq (Elem [ε]) ⇒ Collects [ε] where type Elem [ε] = ε empty = [] insert e xs = (e : xs) ...

[25..40]

Implementáció: nézetminták {-# LANGUAGE ViewPatterns #-} type Typ = . . . data TypView = Unit | Arrow Typ Typ view :: Typ → TypView view = . . . size :: Typ → Integer size t = case (view t) of Unit →1 Arrow t1 t2 → size t1 + size t2 Nézetminták segítségével pedig: size (view → Unit) =1 size (view → Arrow t1 t2 ) = size t1 + size t2 [26..40]

Implementáció: mohón kiértékelt adatkonstruktorok data T = T !Int !Int I

A konstruktor ! segítségével megjelölt paramétereit ˝ (strictness annotation) normálformára kell hozni, mielott azt alkalmazzuk.

I

Körültekintéssel kell alkalmazni, mivel ez automatikusan nem vezet a teljesítmény növekedéséhez.

I

˝ ronthatja a teljesítményt: ha az adott mezot ˝ már Sot, egyszer kiértékeltük, akkor lényegében még egyszer kiértékeltetjük (feleslegesen).

I

A helyzet tisztázásában a fordító nem mindig tud a segítségünkre lenni.

[27..40]

Implementáció: egymásba ágyazott típusok -- alternáló lista data AList α β = Nil | Cons α (AList β α) alist :: AList Int Char alist = Cons 1 (Cons 0 A0 (Cons 2 (Cons 0 B 0 Nil))) -- ciklikus lista data Void data CList α β = Var β | Nil | RCons α (CList (Maybe β)) 1

clist1 , clist2 :: CList Int Void 2 1 clist1 = RCons 1 (RCons 2 (Var Nothing)) clist2 = RCons 1 (RCons 2 (RCons 3 (Var (Just Nothing)))) I

I

2 3

A rekurzív részben az adattípust nem a deklaráció szerint alkalmazzuk: nested, non-regular, non-uniform, heterogenous data type Adattípusokon belüli invariánsok (típusozott) megtartására alkalmazható. [28..40]

FingerTree: definíció (1) class (Monoid (Measure α)) ⇒ Measured α where type Measure α measure :: α → Measure α data FingerTree α = Empty | Single α | Deep !(Measure α) !(Digit α) (FingerTree (Node α)) !(Digit α) deep :: (Measured α) ⇒ Digit α → FingerTree (Node α) → Digit α → FingerTree α deep pr m sf = Deep (measure pr ⊕ measure m ⊕ measure sf ) pr m sf data Node α = Node2 (Measure α) α α | Node3 (Measure α) α α α node2 :: (Measured α) ⇒ α → α → Node α node2 x y = Node2 (measure x ⊕ measure y ) x y node3 :: (Measured α) ⇒ α → α → α → Node α node3 x y z = Node3 (measure x ⊕ measure y ⊕ measure z) x y z

[29..40]

FingerTree: definíció (2) newtype Digit α = D { unD :: [α] } prependDigit :: α → Digit α → Digit α prependDigit x (D xs) = D (x : xs) appendDigit :: Digit α → α → Digit α appendDigit (D xs) x = D (xs ++ [x]) breakDigit :: Digit α → (α, Digit α) breakDigit (D (x : xs)) = (x, D xs) kaerbDigit :: Digit α → (α, Digit α) kaerbDigit (D xs) = (last xs, D (init xs))

[30..40]

FingerTree: definíció (3) instance (Measured α) ⇒ Measured (Node α) where type Measure (Node α) = Measure α measure (Node2 m _ _) = m measure (Node3 m _ _ _) = m instance (Measured α) ⇒ Measured (Digit α) where type Measure (Digit α) = Measure α measure (D xs) = foldr (⊕) mempty (map measure xs) instance (Measured α) ⇒ Measured (FingerTree α) where type Measure (FingerTree α) = Measure α measure Empty = mempty measure (Single x) = measure x measure (Deep m _ _ _) = m [31..40]

FingerTree: létrehozás -- O(1) empty :: (Measured α) ⇒ FingerTree α empty = Empty singleton :: (Measured α) ⇒ α → FingerTree α singleton = Single infixr 5 C (C) :: (Measured α) ⇒ α → FingerTree α → FingerTree α x C Empty = Single x x C (Single y ) = deep (D [x]) Empty (D [y ]) x C (Deep _ (D [y , z, u, w]) m sf ) = deep (D [x, y ]) (node3 z u w C m) sf x C (Deep _ pr m sf ) = deep (prependDigit x pr ) m sf -- O(n) (E) :: (Measured α) ⇒ [α] → FingerTree α → FingerTree α xs E ys = foldr (C) ys xs fromList :: (Measured α) ⇒ [α] → FingerTree α fromList xs = xs E Empty digitToTree :: (Measured α) ⇒ Digit α → FingerTree α digitToTree (D xs) = fromList xs

[32..40]

FingerTree: elérés infixr 5  data ViewL α = EmptyL | α  (FingerTree α) -- O(1) viewl :: (Measured α) ⇒ FingerTree α → ViewL α viewl Empty = EmptyL viewl (Single x) = x  Empty viewl (Deep _ pr m sf ) = p  (deepl lpr m sf ) where (p, lpr ) = breakDigit pr deepl :: (Measured α) ⇒ Digit α → FingerTree (Node α) → Digit α → FingerTree α deepl (D []) (viewl → EmptyL) sf = digitToTree sf deepl (D []) (viewl → x  m) sf = deep (nodeToDigit x) m sf deepl pr m sf = deep pr m sf nodeToDigit :: (Measured α) ⇒ Node α → Digit α nodeToDigit (Node2 _ x y ) = D [x, y ] nodeToDigit (Node3 _ x y z) = D [x, y , z]

[33..40]

FingerTree: elérés (alkalmazás)

isEmpty :: (Measured α) ⇒ FingerTree α → Bool isEmpty (viewl → EmptyL) = True isEmpty _ = False headl :: (Measured α) ⇒ FingerTree α → α headl (viewl → x  _) = x taill :: (Measured α) ⇒ FingerTree α → FingerTree α taill (viewl → _  x) = x

[34..40]

FingerTree: összekapcsolás infixr 5 ./ -- O(log(min(n, m))) (./) :: (Measured α) ⇒ FingerTree α → FingerTree α → FingerTree α xs ./ ys = f xs [] ys where f :: (Measured α) ⇒ FingerTree α → [α] → FingerTree α → FingerTree α f Empty ts xs = ts E xs f xs ts Empty = xs D ts f (Single x) ts xs = x C (ts E xs) f xs ts (Single x) = (xs D ts) B x f (Deep _ pr1 m1 sf1 ) ts (Deep _ pr2 m2 sf2 ) = deep pr1 (f m1 (nodes (unD sf1 ++ ts ++ unD pr2 )) m2 ) sf2 nodes :: (Measured nodes [x, y ] nodes [x, y , z] nodes [x, y , z, u] nodes (x : y : z : xs)

α) ⇒ [α] → [Node α] = [node2 x y ] = [node3 x y z] = [node2 x y , node2 z u] = node3 x y z : nodes xs

[35..40]

FingerTree: felbontás (1) data Split φ α = Split (φ α) α (φ α) ˝ i: kezdoérték, P(·): monoton predikátum, csak ∧ és ∨ ¬P(i) ∧ P(i ⊕ kdk) =⇒ let Split l x r = splitDigit p i d in toList l ++ [x] ++ toList r = toList d ∧ ¬P(i ⊕ klk) ∧ P(i ⊕ klk ⊕ kxk) splitDigit :: (Measured α) ⇒ (Measure α → Bool) → Measure α → Digit α → Split Digit α splitDigit p i (breakDigit → (x, D [])) = Split (D []) x (D []) splitDigit p i (breakDigit → (x, xs)) |pj = Split (D []) x xs | otherwise = let Split l y r = splitDigit p j xs in Split (prependDigit x l) y r where j = i ⊕ measure x

x i

¬P ...

x

1

2

v1

v2

x

i-1

x x i

vi-1

i+1

vi

[36..40]

P ...

x

n-1

x

vn-1

n

vn

FingerTree: felbontás (2) ¬P(i) ∧ P(i ⊕ ktk) =⇒ let Split l x r = splitTree p i t in toList l ++ [x] ++ toList r = toList t ∧ ¬P(i ⊕ klk) ∧ P(i ⊕ klk ⊕ kxk) -- O(log(min(nl , nr ))) splitTree :: (Measured α) ⇒ (Measure α → Bool) → Measure α → FingerTree α → Split FingerTree α splitTree p i (Single x) = Split Empty x Empty splitTree p i (Deep _ pr m sf ) | p vpr = let Split l x r = splitDigit p i pr in Split (digitToTree l) x (deepl r m sf ) | p vm = let Split ml xs mr = splitTree p vpr m Split l x r = splitDigit p (vpr ⊕ measure ml) (nodeToDigit xs) in Split (deepr pr ml l) x (deepl r mr sf ) | otherwise = let Split l x r = splitDigit p vm sf in Split (deepr pr m l) x (digitToTree r ) where (vpr , vm) = (i ⊕ measure pr , vpr ⊕ measure m)

[37..40]

FingerTree: felbontás (3) t 6= Empty =⇒ let Split l x r = splitTree p i t in toList l ++ [x] ++ toList r = toList t ∧ (l = Empty ∨ ¬P(i ⊕ klk)) ∧ (r = Empty ∨ P(i ⊕ klk ⊕ kxk)) split :: (Measured α) ⇒ (Measure α → Bool) → FingerTree α → (FingerTree α, FingerTree α) split p Empty = (Empty , Empty ) split p t | p (measure t) = (l, x C r ) | otherwise = (t, Empty ) where Split l x r = splitTree p mempty t

[38..40]

FingerTree: véletlen elérésu˝ sorozatok (alkalmazás) newtype Elem ν α = Elem { getElem :: α } newtype Size = Size { getSize :: Int } deriving (Eq, Ord) newtype Seq α = Seq (FingerTree (Elem Size α))

instance Monoid Size where mempty = Size 0 mappend (Size m) (Size n) = Size (m + n) instance Measured (Elem Size α) where type Measure (Elem Size a) = Size measure (Elem _) = Size 1 fromList :: [α] → Seq α fromList xs = Seq (FT .fromList (map Elem xs)) toList :: Seq α → [α] toList (Seq t) = map getElem (FT .toList t)

[39..40]

FingerTree: véletlen elérésu˝ sorozatok (alkalmazás)

length :: Seq α → Int length (Seq xs) = getSize (FT .measure xs) splitAt :: Int → Seq α → (Seq α, Seq α) splitAt i (Seq xs) = (Seq l, Seq r ) where (l, r ) = FT .split (Size i <) xs (!) :: Seq α → Int → α (Seq xs) ! i = getElem x where Split _ x _ = FT .splitTree (Size i <) (Size 0) xs

[40..40]