diff --git a/library/init/data/default.lean b/library/init/data/default.lean index 92735eb72f..066cf1e31e 100644 --- a/library/init/data/default.lean +++ b/library/init/data/default.lean @@ -8,3 +8,4 @@ import init.data.basic init.data.nat init.data.char init.data.string import init.data.list init.data.int init.data.array import init.data.fin init.data.uint init.data.ordering import init.data.rbtree init.data.rbmap init.data.option.basic init.data.option.instances +import init.data.hashmap diff --git a/library/init/data/hashmap/basic.lean b/library/init/data/hashmap/basic.lean index 7d4b499547..a7663ae763 100644 --- a/library/init/data/hashmap/basic.lean +++ b/library/init/data/hashmap/basic.lean @@ -4,27 +4,27 @@ Released under Apache 2.0 license as described in the file LICENSE. Author: Leonardo de Moura -/ prelude -import init.data.array.basic init.data.list.basic +import init.data.array.basic init.data.assoclist import init.data.option.basic init.data.hashable universes u v w -def bucketArray (α : Type u) (β : α → Type v) := -{ b : Array (List (Σ a, β a)) // b.sz > 0 } +def HashMapBucket (α : Type u) (β : Type v) := +{ b : Array (AssocList α β) // b.size > 0 } -def bucketArray.updt {α : Type u} {β : α → Type v} (data : bucketArray α β) (i : USize) (d : List (Σ a, β a)) (h : i.toNat < data.val.sz) : bucketArray α β := +def HashMapBucket.update {α : Type u} {β : Type v} (data : HashMapBucket α β) (i : USize) (d : AssocList α β) (h : i.toNat < data.val.size) : HashMapBucket α β := ⟨ data.val.updt i d h, transRelRight Greater (Array.szUpdateEq (data.val) ⟨USize.toNat i, h⟩ d) data.property ⟩ -structure HashmapImp (α : Type u) (β : α → Type v) := +structure HashMapImp (α : Type u) (β : Type v) := (size : Nat) -(buckets : bucketArray α β) +(buckets : HashMapBucket α β) -def mkHashmapImp {α : Type u} {β : α → Type v} (nbuckets := 8) : HashmapImp α β := +def mkHashMapImp {α : Type u} {β : Type v} (nbuckets := 8) : HashMapImp α β := let n := if nbuckets = 0 then 8 else nbuckets in { size := 0, buckets := - ⟨ mkArray n [], - have p₁ : (mkArray n ([] : List (Σ a, β a))).sz = n, from szMkArrayEq _ _, + ⟨ mkArray n AssocList.nil, + have p₁ : (mkArray n (@AssocList.nil α β)).size = n, from szMkArrayEq _ _, have p₂ : n = (if nbuckets = 0 then 8 else nbuckets), from rfl, have p₃ : (if nbuckets = 0 then 8 else nbuckets) > 0, from match nbuckets with @@ -32,143 +32,108 @@ let n := if nbuckets = 0 then 8 else nbuckets in | (Nat.succ x) := Nat.zeroLtSucc _, transRelRight Greater (Eq.trans p₁ p₂) p₃ ⟩ } -namespace HashmapImp -variables {α : Type u} {β : α → Type v} +namespace HashMapImp +variables {α : Type u} {β : Type v} def mkIdx {n : Nat} (h : n > 0) (u : USize) : { u : USize // u.toNat < n } := ⟨u %ₙ n, USize.modnLt _ h⟩ -def reinsertAux (hashFn : α → USize) (data : bucketArray α β) (a : α) (b : β a) : bucketArray α β := +def reinsertAux (hashFn : α → USize) (data : HashMapBucket α β) (a : α) (b : β) : HashMapBucket α β := let ⟨i, h⟩ := mkIdx data.property (hashFn a) in -data.updt i (⟨a, b⟩ :: data.val.idx i h) h +data.update i (AssocList.cons a b (data.val.idx i h)) h -def foldBuckets {δ : Type w} (data : bucketArray α β) (d : δ) (f : δ → Π a, β a → δ) : δ := -data.val.foldl (λ b d, b.foldl (λ r (p : Σ a, β a), f r p.1 p.2) d) d +def foldBuckets {δ : Type w} (data : HashMapBucket α β) (d : δ) (f : δ → α → β → δ) : δ := +data.val.foldl (λ b d, b.foldl f d) d -def findAux [DecidableEq α] (a : α) : List (Σ a, β a) → Option (β a) -| [] := none -| (⟨a',b⟩::t) := - if h : a' = a then some (Eq.recOn h b) else findAux t - -def containsAux [DecidableEq α] (a : α) (l : List (Σ a, β a)) : Bool := -(findAux a l).isSome - -def find [DecidableEq α] [Hashable α] (m : HashmapImp α β) (a : α) : Option (β a) := +def find [HasBeq α] [Hashable α] (m : HashMapImp α β) (a : α) : Option β := match m with | ⟨_, buckets⟩ := let ⟨i, h⟩ := mkIdx buckets.property (hash a) in - findAux a (buckets.val.idx i h) + (buckets.val.idx i h).find a -def fold {δ : Type w} (m : HashmapImp α β) (d : δ) (f : δ → Π a, β a → δ) : δ := +def contains [HasBeq α] [Hashable α] (m : HashMapImp α β) (a : α) : Bool := +match m with +| ⟨_, buckets⟩ := + let ⟨i, h⟩ := mkIdx buckets.property (hash a) in + (buckets.val.idx i h).contains a + +def fold {δ : Type w} (m : HashMapImp α β) (d : δ) (f : δ → α → β → δ) : δ := foldBuckets m.buckets d f -def replaceAux [DecidableEq α] (a : α) (b : β a) : List (Σ a, β a) → List (Σ a, β a) -| [] := [] -| (⟨a', b'⟩::t) := if a' = a then ⟨a, b⟩::t else ⟨a', b'⟩ :: replaceAux t - -def eraseAux [DecidableEq α] (a : α) : List (Σ a, β a) → List (Σ a, β a) -| [] := [] -| (⟨a', b'⟩::t) := if a' = a then t else ⟨a', b'⟩ :: eraseAux t - -def insert [DecidableEq α] [Hashable α] (m : HashmapImp α β) (a : α) (b : β a) : HashmapImp α β := +def insert [HasBeq α] [Hashable α] (m : HashMapImp α β) (a : α) (b : β) : HashMapImp α β := match m with | ⟨size, buckets⟩ := let ⟨i, h⟩ := mkIdx buckets.property (hash a) in let bkt := buckets.val.idx i h in - if containsAux a bkt - then ⟨size, buckets.updt i (replaceAux a b bkt) h⟩ + if bkt.contains a + then ⟨size, buckets.update i (bkt.replace a b) h⟩ else let size' := size + 1 in - let buckets' := buckets.updt i (⟨a, b⟩::bkt) h in - if size' <= buckets.val.sz + let buckets' := buckets.update i (AssocList.cons a b bkt) h in + if size' <= buckets.val.size then ⟨size', buckets'⟩ - else let nbuckets' := buckets.val.sz * 2 in + else let nbuckets' := buckets.val.size * 2 in let aux₁ : nbuckets' > 0 := Nat.mulPos buckets.property (Nat.zeroLtBit0 Nat.oneNeZero) in - let aux₂ : (mkArray nbuckets' ([] : List (Σ a, β a))).sz = nbuckets' := szMkArrayEq _ _ in + let aux₂ : (mkArray nbuckets' (@AssocList.nil α β)).size = nbuckets' := szMkArrayEq _ _ in ⟨ size', - foldBuckets buckets' ⟨mkArray nbuckets' [], aux₂.symm ▸ aux₁⟩ (reinsertAux hash) ⟩ + foldBuckets buckets' ⟨mkArray nbuckets' AssocList.nil, aux₂.symm ▸ aux₁⟩ (reinsertAux hash) ⟩ -def erase [DecidableEq α] [Hashable α] (m : HashmapImp α β) (a : α) : HashmapImp α β := +def erase [HasBeq α] [Hashable α] (m : HashMapImp α β) (a : α) : HashMapImp α β := match m with | ⟨ size, buckets ⟩ := let ⟨i, h⟩ := mkIdx buckets.property (hash a) in let bkt := buckets.val.idx i h in - if containsAux a bkt then ⟨size - 1, buckets.updt i (eraseAux a bkt) h⟩ + if bkt.contains a then ⟨size - 1, buckets.update i (bkt.erase a) h⟩ else m -inductive WellFormed [DecidableEq α] [Hashable α] : HashmapImp α β → Prop -| mkWff : ∀ n, WellFormed (mkHashmapImp n) +inductive WellFormed [HasBeq α] [Hashable α] : HashMapImp α β → Prop +| mkWff : ∀ n, WellFormed (mkHashMapImp n) | insertWff : ∀ m a b, WellFormed m → WellFormed (insert m a b) | eraseWff : ∀ m a, WellFormed m → WellFormed (erase m a) -end HashmapImp +end HashMapImp -def DHashmap (α : Type u) (β : α → Type v) [DecidableEq α] [Hashable α] := -{ m : HashmapImp α β // m.WellFormed } +def HashMap (α : Type u) (β : Type v) [HasBeq α] [Hashable α] := +{ m : HashMapImp α β // m.WellFormed } -open HashmapImp +open HashMapImp -def mkDHashmap {α : Type u} {β : α → Type v} [DecidableEq α] [Hashable α] (nbuckets := 8) : DHashmap α β := -⟨ mkHashmapImp nbuckets, WellFormed.mkWff nbuckets ⟩ +def mkHashMap {α : Type u} {β : Type v} [HasBeq α] [Hashable α] (nbuckets := 8) : HashMap α β := +⟨ mkHashMapImp nbuckets, WellFormed.mkWff nbuckets ⟩ -namespace DHashmap -variables {α : Type u} {β : α → Type v} [DecidableEq α] [Hashable α] +namespace HashMap +variables {α : Type u} {β : Type v} [HasBeq α] [Hashable α] -def insert (m : DHashmap α β) (a : α) (b : β a) : DHashmap α β := +instance : Inhabited (HashMap α β) := +⟨mkHashMap⟩ + +instance : HasEmptyc (HashMap α β) := +⟨mkHashMap⟩ + +@[inline] def insert (m : HashMap α β) (a : α) (b : β) : HashMap α β := match m with | ⟨ m, hw ⟩ := ⟨ m.insert a b, WellFormed.insertWff m a b hw ⟩ -def erase (m : DHashmap α β) (a : α) : DHashmap α β := +@[inline] def erase (m : HashMap α β) (a : α) : HashMap α β := match m with | ⟨ m, hw ⟩ := ⟨ m.erase a, WellFormed.eraseWff m a hw ⟩ -def find (m : DHashmap α β) (a : α) : Option (β a) := +@[inline] def find (m : HashMap α β) (a : α) : Option β := match m with | ⟨ m, _ ⟩ := m.find a -@[inline] def contains (m : DHashmap α β) (a : α) : Bool := -(m.find a).isSome +@[inline] def contains (m : HashMap α β) (a : α) : Bool := +match m with +| ⟨ m, _ ⟩ := m.contains a -def fold {δ : Type w} (m : DHashmap α β) (d : δ) (f : δ → Π a, β a → δ) : δ := +@[inline] def fold {δ : Type w} (m : HashMap α β) (d : δ) (f : δ → α → β → δ) : δ := match m with | ⟨ m, _ ⟩ := m.fold d f -def size (m : DHashmap α β) : Nat := +@[inline] def size (m : HashMap α β) : Nat := match m with | ⟨ {size := sz, ..}, _ ⟩ := sz -@[inline] def empty (m : DHashmap α β) : Bool := +@[inline] def empty (m : HashMap α β) : Bool := m.size = 0 -end DHashmap - -def Hashmap (α : Type u) (β : Type v) [DecidableEq α] [Hashable α] := -DHashmap α (λ _, β) - -def mkHashmap {α : Type u} {β : Type v} [DecidableEq α] [Hashable α] (nbuckets := 8) : Hashmap α β := -mkDHashmap nbuckets - -namespace Hashmap -variables {α : Type u} {β : Type v} [DecidableEq α] [Hashable α] - -@[inline] def insert (m : Hashmap α β) (a : α) (b : β) : Hashmap α β := -DHashmap.insert m a b - -@[inline] def erase (m : Hashmap α β) (a : α) : Hashmap α β := -DHashmap.erase m a - -@[inline] def find (m : Hashmap α β) (a : α) : Option β := -DHashmap.find m a - -@[inline] def contains (m : Hashmap α β) (a : α) : Bool := -(m.find a).isSome - -@[inline] def fold {δ : Type w} (m : Hashmap α β) (d : δ) (f : δ → α → β → δ) : δ := -DHashmap.fold m d f - -@[inline] def size (m : Hashmap α β) : Nat := -DHashmap.size m - -@[inline] def empty (m : Hashmap α β) : Bool := -DHashmap.empty m - -end Hashmap +end HashMap diff --git a/library/init/lean/disjoint_set.lean b/library/init/lean/disjoint_set.lean index 682aead5b5..a544919b63 100644 --- a/library/init/lean/disjoint_set.lean +++ b/library/init/lean/disjoint_set.lean @@ -16,18 +16,18 @@ structure DisjointSet.Node (α : Type u) := (find : α) (rank : Nat := 0) -structure DisjointSet (α : Type u) [DecidableEq α] [Hashable α] : Type u := -(map : Hashmap α (DisjointSet.Node α)) +structure DisjointSet (α : Type u) [HasBeq α] [Hashable α] : Type u := +(map : HashMap α (DisjointSet.Node α)) -def mkDisjointSet (α : Type u) [DecidableEq α] [Hashable α] : DisjointSet α := -⟨mkHashmap⟩ +def mkDisjointSet (α : Type u) [HasBeq α] [Hashable α] : DisjointSet α := +⟨mkHashMap⟩ variables {α : Type u} namespace DisjointSet variables [DecidableEq α] [Hashable α] -private def findAux : Nat → α → Hashmap α (Node α) → Node α +private def findAux : Nat → α → HashMap α (Node α) → Node α | 0 a m := { find := a, rank := 0 } | (n+1) a m := match m.find a with diff --git a/tests/playground/hash.lean b/tests/playground/hash.lean index c93fbd58d5..e5b5a3762b 100644 --- a/tests/playground/hash.lean +++ b/tests/playground/hash.lean @@ -1,7 +1,19 @@ -import init.data.hashable +import init.data.hashmap.basic + +def mkMap (s : String) : Nat → HashMap String Nat → HashMap String Nat +| 0 m := m +| (n+1) m := mkMap n (m.insert (s ++ toString n) n) + +def checkMap (s : String) (m : HashMap String Nat) : Nat → IO Unit +| 0 := pure () +| (n+1) := do + let key := s ++ toString n, + unless (m.contains key) (throw $ IO.userError "not found"), + IO.println (key ++ " |-> " ++ toString (m.find key)), + checkMap n def main (xs : List String): IO Unit := -do IO.println $ hash xs.head, - IO.println $ hash xs.head.toNat, - IO.println $ mixHash 1 2, - pure () +do let s := "base", + let n := xs.head.toNat, + let m := mkMap s n {}, + checkMap s m n