The following patches provide hashUpdate! and as a result hash
functions to the Expression, Kernel, Float and Complex domains. Also
included is a patch to XHashTable to optionally pass a user specified
function representing equality in the key domain. This is important
for the use of XHashTable in domains like Expression where equality is
not canonical.
Please review and let me know if I can commit.
wspage@opensuse:~/fricas-ker> svn diff > ../exprhash.patch
wspage@opensuse:~/fricas-ker> cat ../exprhash.patch
Index: src/algebra/expr.spad
===================================================================
--- src/algebra/expr.spad (revision 1893)
+++ src/algebra/expr.spad (working copy)
@@ -147,7 +147,10 @@
x : % = y : % == (x - y) =$Rep 0$Rep
numer x == numer(x)$Rep
denom x == denom(x)$Rep
-
+ hashUpdate!(s : HashState, x : %) : HashState ==
+ s := hashUpdate!(s, numer x)
+ s := hashUpdate!(s, denom x)
+
EREP := Record(num : MP, den : MP)
coerce(p : MP) : % == [p, 1]$EREP pretend %
Index: src/algebra/float.spad
===================================================================
--- src/algebra/float.spad (revision 1893)
+++ src/algebra/float.spad (working copy)
@@ -185,6 +185,12 @@
if wholeObj then
OMputEndObject(dev)
+ hashUpdate!(s : HashState, x : %) : HashState ==
+ s := hashUpdate!(s, mantissa x)
+ s := hashUpdate!(s, exponent x)
+ s
+
+
shift2(x, y) == sign(x)*shift(sign(x)*x, y)
asin x ==
Index: src/algebra/gaussian.spad
===================================================================
--- src/algebra/gaussian.spad (revision 1893)
+++ src/algebra/gaussian.spad (working copy)
@@ -589,6 +589,12 @@
if wholeObj then
OMputEndObject(dev)
+ hashUpdate!(s : HashState, x : %) : HashState ==
+ s := hashUpdate!(s, real x)
+ s := hashUpdate!(s, imag x)
+ s
+
+
0 == [0, 0]
1 == [1, 0]
zero? x == zero?(x.real) and zero?(x.imag)
Index: src/algebra/kl.spad
===================================================================
--- src/algebra/kl.spad (revision 1893)
+++ src/algebra/kl.spad (working copy)
@@ -376,6 +376,13 @@
setPredicates(s, l)
o [convert x for x in argument(k)]$List(Pattern Float)
+ hashUpdate!(s : HashState, k : %) : HashState ==
+ s := hashUpdate!(s, name k)
+ s := hashUpdate!(s, height k)
+ for x in argument(k) repeat
+ s := hashUpdate!(s, x)
+ s
+
)abbrev package KERNEL2 KernelFunctions2
++ Description:
++ This package exports some auxiliary functions on kernels
Index: src/algebra/xhash.spad
===================================================================
--- src/algebra/xhash.spad (revision 1893)
+++ src/algebra/xhash.spad (working copy)
@@ -89,6 +89,7 @@
N ==> NonNegativeInteger
Z ==> Integer
I ==> SingleInteger
+B ==> Boolean
)if LiterateDoc
Let us now discuss the overall domain implementation.
@@ -102,7 +103,7 @@
++ Keywords: hash table
++ Description:
++ An implementation of a hash table that uses equality of the key domain
-++ to decide upon equality of keys.
+++ or a user specified function to decide upon equality of keys.
XHashTable(Key: SetCategory, Entry: Type):
Join(TableAggregate(Key, Entry), finiteAggregate, shallowlyMutable) with
table: (Key -> SingleInteger) -> %
@@ -111,6 +112,10 @@
++ the sense that from k1=k2 follows h(k1)=h(k2). If that is not
++ the case, k1 and k2 will internally be considered as being
++ different keys.
+ table: (Key -> SingleInteger,(Key,Key) -> Boolean) -> %
+ ++ table(h,eq) creates an empty hash table that uses eq instead
+ ++ of the "=" from the Key domain. Note that h and eq must be
+ ++ compatible in the sense that h(k1)~=h(k2) -> not eq(k1,k2)
== add
KE ==> Record(key: Key, entry: Entry)
UE ==> Union(Entry, "failed")
@@ -257,7 +262,8 @@
maxNumOfVirtualEntries: Z,_
idx: Z,_
arr: Buckets,_
- hashFunction: Key -> I)
+ hashFunction: Key -> I,_
+ eqFunction: (Key,Key) -> Boolean)
)if LiterateDoc
Note that for a value $r$ of type \texttt{Rep} it always holds:
@@ -334,7 +340,7 @@
stored and thus the loops eventually terminate.
)endif
- localSearch(a: Buckets, k: Key, h: Key -> I): Z ==
+ localSearch(a: Buckets, k: Key, h: Key -> I, eq:(Key,Key) -> B): Z ==
update!(p, mk) ==>
p := p + h2
if p>=n then p := p-n
@@ -348,12 +354,12 @@
deletedPosition?: Boolean := false
while not vacant? mk repeat
deleted? mk => (deletedPosition? := true; break)
- k = toKey mk => return p -- key found
+ eq(k,toKey mk) => return p -- key found
update!(p, mk)
q := p -- first position of a free entry
-- We ignore DELETED entries when looking for the key.
while not vacant? mk repeat
- not deleted? mk and k = toKey mk =>
+ not deleted? mk and eq(k,toKey mk) =>
setKeyEntry!(a, n, q, k, getEntry(a, n, p))
deleteKeyEntry!(a, n, p)
return q -- entry has been copied to previous DELETED position
@@ -386,6 +392,7 @@
m: N := arrayLengths ix
r: Rep := rep x
h: Key -> I := r.hashFunction
+ eq: (Key,Key) -> B := r.eqFunction
a: Buckets := r.arr
n: Z := numOfBuckets a
c: Buckets := newArr m
@@ -393,7 +400,7 @@
k: Key := toKey mk
-- Note that k is not in c, and there are no DELETED positions.
-- Thus, -m<=p<0.
- p := m + localSearch(c, k, h)
+ p := m + localSearch(c, k, h, eq)
setKeyEntry!(c, m, p, k, getEntry(a, n, i))
r.arr := c --destructively set new array
r.idx := ix
@@ -433,11 +440,15 @@
function into the representation.
)endif
- table(hashfunction: Key -> SingleInteger): % ==
+ table(hashfunction: Key -> SingleInteger,eqfunction: (Key,Key) ->
Boolean): % ==
n: N := arrayLengths 0
maxEntries: Z := maxLoad n
maxVirtualEntries: Z := maxVirtualLoad n
- per [0, maxEntries, 0, maxVirtualEntries, 0, newArr n, hashfunction]
+ hashfunction := forceLazySlot((hash$Key)@(Key -> I))$Lisp
pretend (Key->I)
+ per [0, maxEntries, 0, maxVirtualEntries, 0, newArr n,
hashfunction, eqfunction]
+ table(hashfunction: Key -> SingleInteger): % ==
+ table(hashfunction,forceLazySlot((_=$Key)@((Key,Key) ->
B))$Lisp pretend ((Key,Key)->B))
+
empty(): % ==
table(forceLazySlot((hash$Key)@(Key -> I))$Lisp pretend (Key->I))
@@ -465,19 +476,22 @@
search(k: Key, x: %): Union(Entry, "failed") ==
a: Buckets := rep(x).arr
h: Key -> I := rep(x).hashFunction
- p: Z := localSearch(a, k, h)
+ eq: (Key,Key) -> B := rep(x).eqFunction
+ p: Z := localSearch(a, k, h, eq)
p<0 => "failed"
getEntry(a, numOfBuckets a, p)::UE
elt(x: %, k: Key): Entry ==
a: Buckets := rep(x).arr
h: Key -> I := rep(x).hashFunction
- p := localSearch(a, k, h)
+ eq: (Key,Key) -> B := rep(x).eqFunction
+ p := localSearch(a, k, h, eq)
p<0 => error "key not in table"
getEntry(a, numOfBuckets a, p)
elt(x: %, k: Key, e: Entry): Entry ==
a: Buckets := rep(x).arr
h: Key -> I := rep(x).hashFunction
- p := localSearch(a, k, h)
+ eq: (Key,Key) -> B := rep(x).eqFunction
+ p := localSearch(a, k, h, eq)
p<0 => e
getEntry(a, numOfBuckets a, p)
@@ -500,7 +514,8 @@
if rep(x).numOfEntries >= rep(x).maxNumOfEntries then grow! x
a: Buckets := rep(x).arr
h: Key -> I := rep(x).hashFunction
- p := localSearch(a, k, h)
+ eq: (Key,Key) -> B := rep(x).eqFunction
+ p := localSearch(a, k, h, eq)
n: Z := numOfBuckets a
p>=0 => setEntry!(a, n, p, e)
r: Rep := rep x
@@ -527,7 +542,8 @@
remove!(k: Key, x: %): Union(Entry, "failed") ==
a: Buckets := rep(x).arr
h: Key -> I := rep(x).hashFunction
- p := localSearch(a, k, h)
+ eq: (Key,Key) -> B := rep(x).eqFunction
+ p := localSearch(a, k, h, eq)
p<0 => "failed" -- key has not been found
n: Z := numOfBuckets a
e: Entry := getEntry(a, n, p) -- to be returned
@@ -546,7 +562,7 @@
r: Rep := rep x
per [r.numOfEntries, r.maxNumOfEntries,_
r.numOfDeletedEntries, r.maxNumOfVirtualEntries,_
- r.idx, copy(r.arr), r.hashFunction]
+ r.idx, copy(r.arr), r.hashFunction, r.eqFunction]
)if LiterateDoc
\subsubsection{Setting common values}
@@ -621,8 +637,9 @@
xa := rep(x).arr; xn := numOfBuckets xa
ya := rep(y).arr; yn := numOfBuckets ya
h := rep(y).hashFunction
+ eq := rep(y).eqFunction
for i in 0..xn - 1 | key?(mk: MKey := getMKey(xa, i)) repeat
- p := localSearch(ya, toKey mk, h)
+ p := localSearch(ya, toKey mk, h, eq)
p < 0 => return false
getEntry(xa, xn, i) ~= getEntry(ya, yn, p) => return false
true
wspage@opensuse:~/fricas-ker>
--
You received this message because you are subscribed to the Google Groups
"FriCAS - computer algebra system" group.
To unsubscribe from this group and stop receiving emails from it, send an email
to [email protected].
To post to this group, send email to [email protected].
Visit this group at http://groups.google.com/group/fricas-devel.
For more options, visit https://groups.google.com/d/optout.
Index: src/algebra/expr.spad
===================================================================
--- src/algebra/expr.spad (revision 1893)
+++ src/algebra/expr.spad (working copy)
@@ -147,7 +147,10 @@
x : % = y : % == (x - y) =$Rep 0$Rep
numer x == numer(x)$Rep
denom x == denom(x)$Rep
-
+ hashUpdate!(s : HashState, x : %) : HashState ==
+ s := hashUpdate!(s, numer x)
+ s := hashUpdate!(s, denom x)
+
EREP := Record(num : MP, den : MP)
coerce(p : MP) : % == [p, 1]$EREP pretend %
Index: src/algebra/float.spad
===================================================================
--- src/algebra/float.spad (revision 1893)
+++ src/algebra/float.spad (working copy)
@@ -185,6 +185,12 @@
if wholeObj then
OMputEndObject(dev)
+ hashUpdate!(s : HashState, x : %) : HashState ==
+ s := hashUpdate!(s, mantissa x)
+ s := hashUpdate!(s, exponent x)
+ s
+
+
shift2(x, y) == sign(x)*shift(sign(x)*x, y)
asin x ==
Index: src/algebra/gaussian.spad
===================================================================
--- src/algebra/gaussian.spad (revision 1893)
+++ src/algebra/gaussian.spad (working copy)
@@ -589,6 +589,12 @@
if wholeObj then
OMputEndObject(dev)
+ hashUpdate!(s : HashState, x : %) : HashState ==
+ s := hashUpdate!(s, real x)
+ s := hashUpdate!(s, imag x)
+ s
+
+
0 == [0, 0]
1 == [1, 0]
zero? x == zero?(x.real) and zero?(x.imag)
Index: src/algebra/kl.spad
===================================================================
--- src/algebra/kl.spad (revision 1893)
+++ src/algebra/kl.spad (working copy)
@@ -376,6 +376,13 @@
setPredicates(s, l)
o [convert x for x in argument(k)]$List(Pattern Float)
+ hashUpdate!(s : HashState, k : %) : HashState ==
+ s := hashUpdate!(s, name k)
+ s := hashUpdate!(s, height k)
+ for x in argument(k) repeat
+ s := hashUpdate!(s, x)
+ s
+
)abbrev package KERNEL2 KernelFunctions2
++ Description:
++ This package exports some auxiliary functions on kernels
Index: src/algebra/xhash.spad
===================================================================
--- src/algebra/xhash.spad (revision 1893)
+++ src/algebra/xhash.spad (working copy)
@@ -89,6 +89,7 @@
N ==> NonNegativeInteger
Z ==> Integer
I ==> SingleInteger
+B ==> Boolean
)if LiterateDoc
Let us now discuss the overall domain implementation.
@@ -102,7 +103,7 @@
++ Keywords: hash table
++ Description:
++ An implementation of a hash table that uses equality of the key domain
-++ to decide upon equality of keys.
+++ or a user specified function to decide upon equality of keys.
XHashTable(Key: SetCategory, Entry: Type):
Join(TableAggregate(Key, Entry), finiteAggregate, shallowlyMutable) with
table: (Key -> SingleInteger) -> %
@@ -111,6 +112,10 @@
++ the sense that from k1=k2 follows h(k1)=h(k2). If that is not
++ the case, k1 and k2 will internally be considered as being
++ different keys.
+ table: (Key -> SingleInteger,(Key,Key) -> Boolean) -> %
+ ++ table(h,eq) creates an empty hash table that uses eq instead
+ ++ of the "=" from the Key domain. Note that h and eq must be
+ ++ compatible in the sense that h(k1)~=h(k2) -> not eq(k1,k2)
== add
KE ==> Record(key: Key, entry: Entry)
UE ==> Union(Entry, "failed")
@@ -257,7 +262,8 @@
maxNumOfVirtualEntries: Z,_
idx: Z,_
arr: Buckets,_
- hashFunction: Key -> I)
+ hashFunction: Key -> I,_
+ eqFunction: (Key,Key) -> Boolean)
)if LiterateDoc
Note that for a value $r$ of type \texttt{Rep} it always holds:
@@ -334,7 +340,7 @@
stored and thus the loops eventually terminate.
)endif
- localSearch(a: Buckets, k: Key, h: Key -> I): Z ==
+ localSearch(a: Buckets, k: Key, h: Key -> I, eq:(Key,Key) -> B): Z ==
update!(p, mk) ==>
p := p + h2
if p>=n then p := p-n
@@ -348,12 +354,12 @@
deletedPosition?: Boolean := false
while not vacant? mk repeat
deleted? mk => (deletedPosition? := true; break)
- k = toKey mk => return p -- key found
+ eq(k,toKey mk) => return p -- key found
update!(p, mk)
q := p -- first position of a free entry
-- We ignore DELETED entries when looking for the key.
while not vacant? mk repeat
- not deleted? mk and k = toKey mk =>
+ not deleted? mk and eq(k,toKey mk) =>
setKeyEntry!(a, n, q, k, getEntry(a, n, p))
deleteKeyEntry!(a, n, p)
return q -- entry has been copied to previous DELETED position
@@ -386,6 +392,7 @@
m: N := arrayLengths ix
r: Rep := rep x
h: Key -> I := r.hashFunction
+ eq: (Key,Key) -> B := r.eqFunction
a: Buckets := r.arr
n: Z := numOfBuckets a
c: Buckets := newArr m
@@ -393,7 +400,7 @@
k: Key := toKey mk
-- Note that k is not in c, and there are no DELETED positions.
-- Thus, -m<=p<0.
- p := m + localSearch(c, k, h)
+ p := m + localSearch(c, k, h, eq)
setKeyEntry!(c, m, p, k, getEntry(a, n, i))
r.arr := c --destructively set new array
r.idx := ix
@@ -433,11 +440,15 @@
function into the representation.
)endif
- table(hashfunction: Key -> SingleInteger): % ==
+ table(hashfunction: Key -> SingleInteger,eqfunction: (Key,Key) -> Boolean): % ==
n: N := arrayLengths 0
maxEntries: Z := maxLoad n
maxVirtualEntries: Z := maxVirtualLoad n
- per [0, maxEntries, 0, maxVirtualEntries, 0, newArr n, hashfunction]
+ hashfunction := forceLazySlot((hash$Key)@(Key -> I))$Lisp pretend (Key->I)
+ per [0, maxEntries, 0, maxVirtualEntries, 0, newArr n, hashfunction, eqfunction]
+ table(hashfunction: Key -> SingleInteger): % ==
+ table(hashfunction,forceLazySlot((_=$Key)@((Key,Key) -> B))$Lisp pretend ((Key,Key)->B))
+
empty(): % ==
table(forceLazySlot((hash$Key)@(Key -> I))$Lisp pretend (Key->I))
@@ -465,19 +476,22 @@
search(k: Key, x: %): Union(Entry, "failed") ==
a: Buckets := rep(x).arr
h: Key -> I := rep(x).hashFunction
- p: Z := localSearch(a, k, h)
+ eq: (Key,Key) -> B := rep(x).eqFunction
+ p: Z := localSearch(a, k, h, eq)
p<0 => "failed"
getEntry(a, numOfBuckets a, p)::UE
elt(x: %, k: Key): Entry ==
a: Buckets := rep(x).arr
h: Key -> I := rep(x).hashFunction
- p := localSearch(a, k, h)
+ eq: (Key,Key) -> B := rep(x).eqFunction
+ p := localSearch(a, k, h, eq)
p<0 => error "key not in table"
getEntry(a, numOfBuckets a, p)
elt(x: %, k: Key, e: Entry): Entry ==
a: Buckets := rep(x).arr
h: Key -> I := rep(x).hashFunction
- p := localSearch(a, k, h)
+ eq: (Key,Key) -> B := rep(x).eqFunction
+ p := localSearch(a, k, h, eq)
p<0 => e
getEntry(a, numOfBuckets a, p)
@@ -500,7 +514,8 @@
if rep(x).numOfEntries >= rep(x).maxNumOfEntries then grow! x
a: Buckets := rep(x).arr
h: Key -> I := rep(x).hashFunction
- p := localSearch(a, k, h)
+ eq: (Key,Key) -> B := rep(x).eqFunction
+ p := localSearch(a, k, h, eq)
n: Z := numOfBuckets a
p>=0 => setEntry!(a, n, p, e)
r: Rep := rep x
@@ -527,7 +542,8 @@
remove!(k: Key, x: %): Union(Entry, "failed") ==
a: Buckets := rep(x).arr
h: Key -> I := rep(x).hashFunction
- p := localSearch(a, k, h)
+ eq: (Key,Key) -> B := rep(x).eqFunction
+ p := localSearch(a, k, h, eq)
p<0 => "failed" -- key has not been found
n: Z := numOfBuckets a
e: Entry := getEntry(a, n, p) -- to be returned
@@ -546,7 +562,7 @@
r: Rep := rep x
per [r.numOfEntries, r.maxNumOfEntries,_
r.numOfDeletedEntries, r.maxNumOfVirtualEntries,_
- r.idx, copy(r.arr), r.hashFunction]
+ r.idx, copy(r.arr), r.hashFunction, r.eqFunction]
)if LiterateDoc
\subsubsection{Setting common values}
@@ -621,8 +637,9 @@
xa := rep(x).arr; xn := numOfBuckets xa
ya := rep(y).arr; yn := numOfBuckets ya
h := rep(y).hashFunction
+ eq := rep(y).eqFunction
for i in 0..xn - 1 | key?(mk: MKey := getMKey(xa, i)) repeat
- p := localSearch(ya, toKey mk, h)
+ p := localSearch(ya, toKey mk, h, eq)
p < 0 => return false
getEntry(xa, xn, i) ~= getEntry(ya, yn, p) => return false
true
