Untitled
unknown
elm
4 years ago
16 kB
4
Indexable
module Dict exposing
( Dict
, empty, singleton, insert, update, remove
, isEmpty, member, get, size
, keys, values, toList, fromList
, map, foldl, foldr, filter, partition
, union, intersect, diff, merge
)
{-| A dictionary mapping unique keys to values. The keys can be any comparable
type. This includes `Int`, `Float`, `Time`, `Char`, `String`, and tuples or
lists of comparable types.
Insert, remove, and query operations all take *O(log n)* time.
# Dictionaries
@docs Dict
# Build
@docs empty, singleton, insert, update, remove
# Query
@docs isEmpty, member, get, size
# Lists
@docs keys, values, toList, fromList
# Transform
@docs map, foldl, foldr, filter, partition
# Combine
@docs union, intersect, diff, merge
-}
import Basics exposing (..)
import Maybe exposing (..)
import List exposing (..)
-- DICTIONARIES
-- The color of a node. Leaves are considered Black.
type NColor
= Red
| Black
{-| A dictionary of keys and values. So a `Dict String User` is a dictionary
that lets you look up a `String` (such as user names) and find the associated
`User`.
import Dict exposing (Dict)
users : Dict String User
users =
Dict.fromList
[ ("Alice", User "Alice" 28 1.65)
, ("Bob" , User "Bob" 19 1.82)
, ("Chuck", User "Chuck" 33 1.75)
]
type alias User =
{ name : String
, age : Int
, height : Float
}
-}
type Dict k v
= RBNode_elm_builtin NColor k v (Dict k v) (Dict k v)
| RBEmpty_elm_builtin
{-| Create an empty dictionary. -}
empty : Dict k v
empty =
RBEmpty_elm_builtin
{-| Get the value associated with a key. If the key is not found, return
`Nothing`. This is useful when you are not sure if a key will be in the
dictionary.
animals = fromList [ ("Tom", Cat), ("Jerry", Mouse) ]
get "Tom" animals == Just Cat
get "Jerry" animals == Just Mouse
get "Spike" animals == Nothing
-}
get : comparable -> Dict comparable v -> Maybe v
get targetKey dict =
case dict of
RBEmpty_elm_builtin ->
Nothing
RBNode_elm_builtin _ key value left right ->
case compare targetKey key of
LT ->
get targetKey left
EQ ->
Just value
GT ->
get targetKey right
{-| Determine if a key is in a dictionary. -}
member : comparable -> Dict comparable v -> Bool
member key dict =
case get key dict of
Just _ ->
True
Nothing ->
False
{-| Determine the number of key-value pairs in the dictionary. -}
size : Dict k v -> Int
size dict =
sizeHelp 0 dict
sizeHelp : Int -> Dict k v -> Int
sizeHelp n dict =
case dict of
RBEmpty_elm_builtin ->
n
RBNode_elm_builtin _ _ _ left right ->
sizeHelp (sizeHelp (n+1) right) left
{-| Determine if a dictionary is empty.
isEmpty empty == True
-}
isEmpty : Dict k v -> Bool
isEmpty dict =
case dict of
RBEmpty_elm_builtin ->
True
RBNode_elm_builtin _ _ _ _ _ ->
False
{-| Insert a key-value pair into a dictionary. Replaces value when there is
a collision. -}
insert : comparable -> v -> Dict comparable v -> Dict comparable v
insert key value dict =
-- Root node is always Black
case insertHelp key value dict of
RBNode_elm_builtin Red k v l r ->
RBNode_elm_builtin Black k v l r
x ->
x
insertHelp : comparable -> v -> Dict comparable v -> Dict comparable v
insertHelp key value dict =
case dict of
RBEmpty_elm_builtin ->
-- New nodes are always red. If it violates the rules, it will be fixed
-- when balancing.
RBNode_elm_builtin Red key value RBEmpty_elm_builtin RBEmpty_elm_builtin
RBNode_elm_builtin nColor nKey nValue nLeft nRight ->
case compare key nKey of
LT ->
balance nColor nKey nValue (insertHelp key value nLeft) nRight
EQ ->
RBNode_elm_builtin nColor nKey value nLeft nRight
GT ->
balance nColor nKey nValue nLeft (insertHelp key value nRight)
balance : NColor -> k -> v -> Dict k v -> Dict k v -> Dict k v
balance color key value left right =
case right of
RBNode_elm_builtin Red rK rV rLeft rRight ->
case left of
RBNode_elm_builtin Red lK lV lLeft lRight ->
RBNode_elm_builtin
Red
key
value
(RBNode_elm_builtin Black lK lV lLeft lRight)
(RBNode_elm_builtin Black rK rV rLeft rRight)
_ ->
RBNode_elm_builtin color rK rV (RBNode_elm_builtin Red key value left rLeft) rRight
_ ->
case left of
RBNode_elm_builtin Red lK lV (RBNode_elm_builtin Red llK llV llLeft llRight) lRight ->
RBNode_elm_builtin
Red
lK
lV
(RBNode_elm_builtin Black llK llV llLeft llRight)
(RBNode_elm_builtin Black key value lRight right)
_ ->
RBNode_elm_builtin color key value left right
{-| Remove a key-value pair from a dictionary. If the key is not found,
no changes are made. -}
remove : comparable -> Dict comparable v -> Dict comparable v
remove key dict =
-- Root node is always Black
case removeHelp key dict of
RBNode_elm_builtin Red k v l r ->
RBNode_elm_builtin Black k v l r
x ->
x
{-| The easiest thing to remove from the tree, is a red node. However, when searching for the
node to remove, we have no way of knowing if it will be red or not. This remove implementation
makes sure that the bottom node is red by moving red colors down the tree through rotation
and color flips. Any violations this will cause, can easily be fixed by balancing on the way
up again.
-}
removeHelp : comparable -> Dict comparable v -> Dict comparable v
removeHelp targetKey dict =
case dict of
RBEmpty_elm_builtin ->
RBEmpty_elm_builtin
RBNode_elm_builtin color key value left right ->
if targetKey < key then
case left of
RBNode_elm_builtin Black _ _ lLeft _ ->
case lLeft of
RBNode_elm_builtin Red _ _ _ _ ->
RBNode_elm_builtin color key value (removeHelp targetKey left) right
_ ->
case moveRedLeft dict of
RBNode_elm_builtin nColor nKey nValue nLeft nRight ->
balance nColor nKey nValue (removeHelp targetKey nLeft) nRight
RBEmpty_elm_builtin ->
RBEmpty_elm_builtin
_ ->
RBNode_elm_builtin color key value (removeHelp targetKey left) right
else
removeHelpEQGT targetKey (removeHelpPrepEQGT targetKey dict color key value left right)
removeHelpPrepEQGT : comparable -> Dict comparable v -> NColor -> comparable -> v -> Dict comparable v -> Dict comparable v -> Dict comparable v
removeHelpPrepEQGT targetKey dict color key value left right =
case left of
RBNode_elm_builtin Red lK lV lLeft lRight ->
RBNode_elm_builtin
color
lK
lV
lLeft
(RBNode_elm_builtin Red key value lRight right)
_ ->
case right of
RBNode_elm_builtin Black _ _ (RBNode_elm_builtin Black _ _ _ _) _ ->
moveRedRight dict
RBNode_elm_builtin Black _ _ RBEmpty_elm_builtin _ ->
moveRedRight dict
_ ->
dict
{-| When we find the node we are looking for, we can remove by replacing the key-value
pair with the key-value pair of the left-most node on the right side (the closest pair).
-}
removeHelpEQGT : comparable -> Dict comparable v -> Dict comparable v
removeHelpEQGT targetKey dict =
case dict of
RBNode_elm_builtin color key value left right ->
if targetKey == key then
case getMin right of
RBNode_elm_builtin _ minKey minValue _ _ ->
balance color minKey minValue left (removeMin right)
RBEmpty_elm_builtin ->
RBEmpty_elm_builtin
else
balance color key value left (removeHelp targetKey right)
RBEmpty_elm_builtin ->
RBEmpty_elm_builtin
getMin : Dict k v -> Dict k v
getMin dict =
case dict of
RBNode_elm_builtin _ _ _ ((RBNode_elm_builtin _ _ _ _ _) as left) _ ->
getMin left
_ ->
dict
removeMin : Dict k v -> Dict k v
removeMin dict =
case dict of
RBNode_elm_builtin color key value ((RBNode_elm_builtin lColor _ _ lLeft _) as left) right ->
case lColor of
Black ->
case lLeft of
RBNode_elm_builtin Red _ _ _ _ ->
RBNode_elm_builtin color key value (removeMin left) right
_ ->
case moveRedLeft dict of
RBNode_elm_builtin nColor nKey nValue nLeft nRight ->
balance nColor nKey nValue (removeMin nLeft) nRight
RBEmpty_elm_builtin ->
RBEmpty_elm_builtin
_ ->
RBNode_elm_builtin color key value (removeMin left) right
_ ->
RBEmpty_elm_builtin
moveRedLeft : Dict k v -> Dict k v
moveRedLeft dict =
case dict of
RBNode_elm_builtin clr k v (RBNode_elm_builtin lClr lK lV lLeft lRight) (RBNode_elm_builtin rClr rK rV ((RBNode_elm_builtin Red rlK rlV rlL rlR) as rLeft) rRight) ->
RBNode_elm_builtin
Red
rlK
rlV
(RBNode_elm_builtin Black k v (RBNode_elm_builtin Red lK lV lLeft lRight) rlL)
(RBNode_elm_builtin Black rK rV rlR rRight)
RBNode_elm_builtin clr k v (RBNode_elm_builtin lClr lK lV lLeft lRight) (RBNode_elm_builtin rClr rK rV rLeft rRight) ->
case clr of
Black ->
RBNode_elm_builtin
Black
k
v
(RBNode_elm_builtin Red lK lV lLeft lRight)
(RBNode_elm_builtin Red rK rV rLeft rRight)
Red ->
RBNode_elm_builtin
Black
k
v
(RBNode_elm_builtin Red lK lV lLeft lRight)
(RBNode_elm_builtin Red rK rV rLeft rRight)
_ ->
dict
moveRedRight : Dict k v -> Dict k v
moveRedRight dict =
case dict of
RBNode_elm_builtin clr k v (RBNode_elm_builtin lClr lK lV (RBNode_elm_builtin Red llK llV llLeft llRight) lRight) (RBNode_elm_builtin rClr rK rV rLeft rRight) ->
RBNode_elm_builtin
Red
lK
lV
(RBNode_elm_builtin Black llK llV llLeft llRight)
(RBNode_elm_builtin Black k v lRight (RBNode_elm_builtin Red rK rV rLeft rRight))
RBNode_elm_builtin clr k v (RBNode_elm_builtin lClr lK lV lLeft lRight) (RBNode_elm_builtin rClr rK rV rLeft rRight) ->
case clr of
Black ->
RBNode_elm_builtin
Black
k
v
(RBNode_elm_builtin Red lK lV lLeft lRight)
(RBNode_elm_builtin Red rK rV rLeft rRight)
Red ->
RBNode_elm_builtin
Black
k
v
(RBNode_elm_builtin Red lK lV lLeft lRight)
(RBNode_elm_builtin Red rK rV rLeft rRight)
_ ->
dict
{-| Update the value of a dictionary for a specific key with a given function. -}
update : comparable -> (Maybe v -> Maybe v) -> Dict comparable v -> Dict comparable v
update targetKey alter dictionary =
case alter (get targetKey dictionary) of
Just value ->
insert targetKey value dictionary
Nothing ->
remove targetKey dictionary
{-| Create a dictionary with one key-value pair. -}
singleton : comparable -> v -> Dict comparable v
singleton key value =
-- Root node is always Black
RBNode_elm_builtin Black key value RBEmpty_elm_builtin RBEmpty_elm_builtin
-- COMBINE
{-| Combine two dictionaries. If there is a collision, preference is given
to the first dictionary.
-}
union : Dict comparable v -> Dict comparable v -> Dict comparable v
union t1 t2 =
foldl insert t2 t1
{-| Keep a key-value pair when its key appears in the second dictionary.
Preference is given to values in the first dictionary.
-}
intersect : Dict comparable v -> Dict comparable v -> Dict comparable v
intersect t1 t2 =
filter (\k _ -> member k t2) t1
{-| Keep a key-value pair when its key does not appear in the second dictionary.
-}
diff : Dict comparable a -> Dict comparable b -> Dict comparable a
diff t1 t2 =
foldl (\k v t -> remove k t) t1 t2
{-| The most general way of combining two dictionaries. You provide three
accumulators for when a given key appears:
1. Only in the left dictionary.
2. In both dictionaries.
3. Only in the right dictionary.
You then traverse all the keys from lowest to highest, building up whatever
you want.
-}
merge
: (comparable -> a -> result -> result)
-> (comparable -> a -> b -> result -> result)
-> (comparable -> b -> result -> result)
-> Dict comparable a
-> Dict comparable b
-> result
-> result
merge leftStep bothStep rightStep leftDict rightDict initialResult =
let
stepState rKey rValue (list, result) =
case list of
[] ->
(list, rightStep rKey rValue result)
(lKey, lValue) :: rest ->
if lKey < rKey then
stepState rKey rValue (rest, leftStep lKey lValue result)
else if lKey > rKey then
(list, rightStep rKey rValue result)
else
(rest, bothStep lKey lValue rValue result)
(leftovers, intermediateResult) =
foldl stepState (toList leftDict, initialResult) rightDict
in
List.foldl (\(k,v) result -> leftStep k v result) intermediateResult leftovers
-- TRANSFORM
{-| Apply a function to all values in a dictionary.
-}
map : (k -> a -> b) -> Dict k a -> Dict k b
map func dict =
case dict of
RBEmpty_elm_builtin ->
RBEmpty_elm_builtin
RBNode_elm_builtin color key value left right ->
RBNode_elm_builtin color key (func key value) (map func left) (map func right)
{-| Fold over the key-value pairs in a dictionary from lowest key to highest key.
import Dict exposing (Dict)
getAges : Dict String User -> List String
getAges users =
Dict.foldl addAge [] users
addAge : String -> User -> List String -> List String
addAge _ user ages =
user.age :: ages
-- getAges users == [33,19,28]
-}
foldl : (k -> v -> b -> b) -> b -> Dict k v -> b
foldl func acc dict =
case dict of
RBEmpty_elm_builtin ->
acc
RBNode_elm_builtin _ key value left right ->
foldl func (func key value (foldl func acc left)) right
{-| Fold over the key-value pairs in a dictionary from highest key to lowest key.
import Dict exposing (Dict)
getAges : Dict String User -> List String
getAges users =
Dict.foldr addAge [] users
addAge : String -> User -> List String -> List String
addAge _ user ages =
user.age :: ages
-- getAges users == [28,19,33]
-}
foldr : (k -> v -> b -> b) -> b -> Dict k v -> b
foldr func acc t =
case t of
RBEmpty_elm_builtin ->
acc
RBNode_elm_builtin _ key value left right ->
foldr func (func key value (foldr func acc right)) left
{-| Keep only the key-value pairs that pass the given test. -}
filter : (comparable -> v -> Bool) -> Dict comparable v -> Dict comparable v
filter isGood dict =
foldl (\k v d -> if isGood k v then insert k v d else d) empty dict
{-| Partition a dictionary according to some test. The first dictionary
contains all key-value pairs which passed the test, and the second contains
the pairs that did not.
-}
partition : (comparable -> v -> Bool) -> Dict comparable v -> (Dict comparable v, Dict comparable v)
partition isGood dict =
let
add key value (t1, t2) =
if isGood key value then
(insert key value t1, t2)
else
(t1, insert key value t2)
in
foldl add (empty, empty) dict
-- LISTS
{-| Get all of the keys in a dictionary, sorted from lowest to highest.
keys (fromList [(0,"Alice"),(1,"Bob")]) == [0,1]
-}
keys : Dict k v -> List k
keys dict =
foldr (\key value keyList -> key :: keyList) [] dict
{-| Get all of the values in a dictionary, in the order of their keys.
values (fromList [(0,"Alice"),(1,"Bob")]) == ["Alice", "Bob"]
-}
values : Dict k v -> List v
values dict =
foldr (\key value valueList -> value :: valueList) [] dict
{-| Convert a dictionary into an association list of key-value pairs, sorted by keys. -}
toList : Dict k v -> List (k,v)
toList dict =
foldr (\key value list -> (key,value) :: list) [] dict
{-| Convert an association list into a dictionary. -}
fromList : List (comparable,v) -> Dict comparable v
fromList assocs =
List.foldl (\(key,value) dict -> insert key value dict) empty assocsEditor is loading...