Algebraic data types: Difference between revisions
Content added Content deleted
m (→{{header|Tailspin}}: update to latest) |
(→{{header|J}}: replace implementation) |
||
Line 884: | Line 884: | ||
''Symbols are a data type and are created by the verb s:. Symbols provide a mechanism for searching, sorting, and comparisons more efficient than alternative mechanisms such as boxed strings. Structural, selection, and relational verbs work on symbols. Arithmetic verbs do not work on symbols.'' |
''Symbols are a data type and are created by the verb s:. Symbols provide a mechanism for searching, sorting, and comparisons more efficient than alternative mechanisms such as boxed strings. Structural, selection, and relational verbs work on symbols. Arithmetic verbs do not work on symbols.'' |
||
The following code |
The following code represents a best effort translation of the current Haskell implementation of this task: |
||
<lang J> |
<lang J>insert=:{{ |
||
'R';'';y;a: |
|||
help=: noun define |
|||
: |
|||
red-black tree |
|||
if. 0=#y do. 'R';y;x;<y |
|||
Store dictionary in red-black tree. The keys can be any noun. |
|||
elseif. 0=L.y do. x insert 'R';'';y;a: |
|||
else. |
|||
'C e K w'=. y |
|||
select. *x - K |
|||
case. _1 do. balance C;(x insert e);K;<w |
|||
case. 0 do. y |
|||
case. 1 do. balance C;e;K;<x insert w |
|||
end. |
|||
end. |
|||
}} |
|||
NB. C: color, e: east, K: key, w: west |
|||
Reference: |
|||
NB. two cascaded reds under a black become two black siblings under a red |
|||
Left-leaning Red-Black Trees |
|||
balance=: {{ |
|||
Robert Sedgewick |
|||
'C e K w'=. y |
|||
Department of Computer Science |
|||
if. #e do. |
|||
Princeton University |
|||
'eC ee eK ew'=. e |
|||
if. 'R'=eC do. |
|||
if. #ee do. |
|||
'eeC eee eeK eew'=. ee NB. ((eee eeK eew) eK ew) K w => (eee eeK eew) eK (ew K w) |
|||
if. 'R'=eeC do. 'R';('B';eee;eeK;<eew);eK;<'B';ew;K;<w return. end. end. |
|||
if. #ew do. |
|||
'ewC ewe ewK eww'=. ew NB. (ee ek (ewe ewK eww)) K w => (ee ek ewe) ewK (eww K w) |
|||
if. 'R'=ewC do. 'R';('B';ee;eK;<ewe);ewK;<'B';eww;K;<w return. end. end. end. end. |
|||
if. #w do. |
|||
'wC we wK ww'=. w |
|||
if. 'R'=wC do. |
|||
if. #we do. |
|||
'weC wee weK wew'=. we NB. e K ((wee weK wew) wK ww) => (e K wee) weK (wew wK ww) |
|||
if. 'R'=weC do. 'R';('B';e;K;<wee);weK;<'B';wew;wK;<ww return. end. end. |
|||
if. #ww do. |
|||
'wwC wwe wwK www'=. ww NB. e K (we wK (wwe wwK www)) => (e K we) wK (wwe wwK www) |
|||
if. 'R'=wwC do. 'R';('B';e;K;<we);wK;<'B';wwe;wwK;<www return. end. end. end. end. |
|||
y |
|||
}}</lang> |
|||
Example use: |
|||
verbs: |
|||
insert key;value Inserts item into tree |
|||
delete key Deletes item with key from tree |
|||
Deletion via the Sedgewick method is fairly simple. |
|||
However, I elected to remove the KEY;VALUE pair |
|||
rather than change the tree. |
|||
find key Returns the associated definition or EMPTY |
|||
items any_noun Returns all the items as a rank 1 array of KEY;VALUE pairs |
|||
keys any_noun Returns all the keys as a rank 1 array of boxes |
|||
values any_noun Returns all the values as a rank 1 array of boxes |
|||
<lang J> 3 insert 2 insert 5 |
|||
J stores all data as arrays. |
|||
┌─┬───────┬─┬───────┐ |
|||
I chose to use array indexes to implement pointers. |
|||
│R│┌─┬┬─┬┐│3│┌─┬┬─┬┐│ |
|||
An "index" is a rank 0 length 1 array. |
|||
│ ││B││2│││ ││B││5│││ |
|||
│ │└─┴┴─┴┘│ │└─┴┴─┴┘│ |
|||
└─┴───────┴─┴───────┘</lang> |
|||
Note that by convention we treat the root node as black. This approach always labels it with 'R' which we ignore. However, if we wish to validate these trees, we must account for the discrepancy. |
|||
Internal data structure: |
|||
<lang J>NB. always treat root of tree as black |
|||
T This rank 2 array stores indexes of left and right at each branch point. |
|||
validate=: {{ |
|||
C rank 1 array of node color. |
|||
if. 0=#y do. 1 return. end. |
|||
H rank 1 array of the hash value of each key. |
|||
'C e K w'=. y |
|||
R rank 0 array stores the root index. |
|||
check 'B';e;K;<w |
|||
D rank 1 array of boxes. In each box is a rank 2 array of key value |
|||
}} |
|||
pairs associated with the hash value. Hash collision invokes direct |
|||
lookup by key among the keys having same hash. |
|||
check=: {{ |
|||
Additional test idea (done): |
|||
if. 0=#y do. 1 return. end. |
|||
Changing the hash to 0: or 2&| rapidly tests |
|||
'C e K w'=. y |
|||
hash collision code for integer keys. |
|||
if. 'R'=C do. |
|||
) |
|||
if. 'R'={.;{.e do. 0 return. end. |
|||
if. 'R'={.;{.w do. 0 return. end. |
|||
bitand=: (#. 1 0 0 0 1)b. |
|||
bitxor=: (#. 1 0 1 1 0)b. |
|||
hash=: [: ((4294967295) bitand (bitxor 1201&*))/ 846661 ,~ ,@:(a.&i.)@:": |
|||
NB. hash=: ] [ 1&bitand NB. can choose simple hash functions for tests |
|||
setup=: 3 : 0 |
|||
T=: i. 0 2 NB. Tree |
|||
H=: D=: C=: i. 0 NB. Hashes, Data, Color |
|||
R=: _ NB. Root |
|||
'BLACK RED'=: i. 2 |
|||
EMPTY |
|||
) |
|||
setup'' |
|||
flipColors=: monad def 'C=: -.@:{`[`]}&C (, {&T) y' |
|||
3 : 0 'test flipColors' |
|||
DD=.D=: ,/<@:(;3j1&":)"0 i.3 |
|||
TT=.T=: _ _,0 2,:_ _ |
|||
CC=.C=: 1 0 1 |
|||
RR=.R=: 1 |
|||
HH=.H=: i.3 |
|||
flipColors R |
|||
assert C -: -. CC |
|||
assert HH -: H |
|||
assert TT -: T |
|||
assert DD -: D |
|||
assert RR -: R |
|||
) |
|||
getColor=: monad def 'C ({~ :: (BLACK"_))"_ 0 y' NB. y the node |
|||
rotateTree=: dyad define NB. x left or right, y node |
|||
I=. x <@:(, -.)~ y |
|||
X=. I { T NB. x = root.otherside |
|||
J=. X <@:, x |
|||
T=: (J { T) I} T |
|||
T=: y J} T |
|||
C=: y (RED ,~ {)`(X , [)`]} C |
|||
X |
|||
) |
|||
3 : 0 'test rotateTree' |
|||
DD=.D=:,/<@:(;3j1&":)"0 i.5 |
|||
TT=.T=:_ _,0 2,_ _,1 4,:_ _ |
|||
CC=.C=:0 1 0 0 0 |
|||
R=:3 |
|||
HH=.H=:i.5 |
|||
assert R = rotateTree/0 1 , R |
|||
assert DD -: D |
|||
assert CC -: C |
|||
assert HH -: H |
|||
assert TT -: T |
|||
) |
|||
setup'' |
|||
insert_privately=: adverb define |
|||
: |
|||
ROOT=. m |
|||
HASH=. x |
|||
ITEM=. y |
|||
if. _ -: ROOT do. NB. new key |
|||
ROOT=. # H |
|||
H=: H , HASH |
|||
T=: T , _ _ |
|||
D=: D , < ,: , ITEM |
|||
C=: C , RED |
|||
elseif. HASH = ROOT { H do. NB. change a value or hash collision |
|||
STACK=. ROOT >@:{ D |
|||
I=. STACK i.&:({."1) ITEM |
|||
STACK=. ITEM <@:(I}`,@.(I = #@])) STACK |
|||
D=: STACK ROOT } D |
|||
elseif. do. NB. Follow tree |
|||
NB. if both children are red then flipColors ROOT |
|||
flipColors^:((,~ RED) -: getColor@:({&T)) ROOT |
|||
I=. <@:(, HASH > {&H) ROOT |
|||
TEMP=. HASH (I { T) insert_privately y |
|||
T=: TEMP I } T |
|||
NB.if (isRed(h.right) && !isRed(h.left)) h = rotateLeft(h) |
|||
ROOT=. 0&rotateTree^:((BLACK,RED) -: getColor@:({&T)) ROOT |
|||
NB.if (isRed(h.left) && isRed(h.left.left)) h = rotateRight(h) |
|||
if. RED -: getColor {. ROOT { T do. |
|||
if. (RED -: (getColor@:(([: {&T <@:,&0)^:2) :: (BLACK"_))) ROOT do. |
|||
ROOT=. 1 rotateTree ROOT |
|||
end. |
end. |
||
a=. check e |
|||
end. |
|||
b=. check w |
|||
end. |
|||
(*a)*(*b)*(a=b)*a+'B'=C |
|||
ROOT |
|||
}}</lang> |
|||
) |
|||
insert=: monad define"1 |
|||
assert 'boxed' -: datatype y |
|||
R=: (R insert_privately~ hash@:(0&{::)) y |
|||
C=: BLACK R } C |
|||
y |
|||
) |
|||
find_hash_index=: monad define NB. y is the hash |
|||
if. 0 = # T do. '' return. end. NB. follow the tree |
|||
I=. R NB. instead of |
|||
while. y ~: I { H do. NB. direct search |
|||
J=. <@:(, y > {&H) I |
|||
if. _ > II=. J { T do. I=. II else. '' return. end. |
|||
end. |
|||
) |
|||
find=: monad define |
|||
if. '' -: I=. find_hash_index hash y do. EMPTY return. end. |
|||
LIST=. I {:: D |
|||
K=. {. |: LIST |
|||
LIST {::~ ::empty 1 ,~ K i. < y |
|||
) |
|||
delete=: 3 : 0 |
|||
if. '' -: I=. find_hash_index hash y do. EMPTY return. end. |
|||
LIST=. I {:: D |
|||
K=. {. |: LIST |
|||
J=. K i. < y |
|||
RESULT=. J ({::~ ,&1)~ LIST |
|||
STACK=. J <@:({. , (}.~ >:)~) LIST |
|||
D=. LIST I } D |
|||
RESULT |
|||
) |
|||
Here, validate returns the effective "black depth" of the tree (treating the root node as black and treating empty nodes as black), or 0 if the tree is not balanced properly. |
|||
getPathsToLeaves=: a:&$: : (4 : 0) NB. PATH getPathsToLeaves ROOT use: getPathsToLeaves R |
|||
if. 0 = # y do. getPathsToLeaves R return. end. |
|||
PATH=. x ,&.> y |
|||
if. _ -: y do. return. end. |
|||
PATH getPathsToLeaves"0 y { T |
|||
) |
|||
For example: |
|||
check=: 3 : 0 |
|||
COLORS=. getColor"0&.> a: -.~ ~. , getPathsToLeaves '' |
|||
result=. EMPTY |
|||
if. 0&e.@:(= {.) +/@:(BLACK&=)@>COLORS do. result=. result,<'mismatched black count' end. |
|||
if. 1 e. 1&e.@:(*. (= 1&|.))@:(RED&=)@>COLORS do. result=. result,<'successive reds' end. |
|||
>result |
|||
) |
|||
<lang J> ?.~20 |
|||
getPath=: 3 : 0 NB. get path to y, the key |
|||
14 18 12 16 5 1 3 0 6 13 9 8 15 17 2 10 7 4 19 11 |
|||
if. 0 = # H do. EMPTY return. end. |
|||
insert/?.~20 |
|||
HASH=. hash y |
|||
┌─┬──────────────────────────────────────────────────────────────────────┬──┬────────────────────────────────────────────────────────────────────────┐ |
|||
PATH=. , I=. R |
|||
│R│┌─┬───────────────────────────────────┬─┬────────────────────────────┐│10│┌─┬────────────────────────────────────────────────┬──┬────────────────┐│ |
|||
while. HASH ~: I { H do. |
|||
│ ││R│┌─┬──────────────┬─┬──────────────┐│5│┌─┬───────┬─┬──────────────┐││ ││B│┌─┬────────────────┬──┬────────────────────────┐│17│┌─┬────────┬──┬┐││ |
|||
J=. <@:(, HASH > {&H) I |
|||
│ ││ ││B│┌─┬┬─┬───────┐│2│┌─┬───────┬─┬┐││ ││B│┌─┬┬─┬┐│7│┌─┬┬─┬───────┐│││ ││ ││R│┌─┬┬──┬────────┐│13│┌─┬────────┬──┬────────┐││ ││B│┌─┬┬──┬┐│19││││ |
|||
PATH=. PATH , II=. J { T |
|||
│ ││ ││ ││B││0│┌─┬┬─┬┐││ ││B│┌─┬┬─┬┐│4││││ ││ ││B││6│││ ││B││8│┌─┬┬─┬┐││││ ││ ││ ││B││11│┌─┬┬──┬┐││ ││B│┌─┬┬──┬┐│15│┌─┬┬──┬┐│││ ││ ││R││18│││ ││││ |
|||
if. _ > II do. I=. II else. EMPTY return. end. |
|||
│ ││ ││ ││ ││ ││R││1││││ ││ ││R││3│││ ││││ ││ │└─┴┴─┴┘│ ││ ││ ││R││9││││││ ││ ││ ││ ││ ││R││12││││ ││ ││R││14│││ ││R││16│││││ ││ │└─┴┴──┴┘│ ││││ |
|||
end. |
|||
│ ││ ││ ││ ││ │└─┴┴─┴┘││ ││ │└─┴┴─┴┘│ ││││ ││ │ │ ││ ││ │└─┴┴─┴┘││││ ││ ││ ││ ││ │└─┴┴──┴┘││ ││ │└─┴┴──┴┘│ │└─┴┴──┴┘│││ │└─┴────────┴──┴┘││ |
|||
PATH |
|||
│ ││ ││ │└─┴┴─┴───────┘│ │└─┴───────┴─┴┘││ ││ │ │ │└─┴┴─┴───────┘│││ ││ ││ │└─┴┴──┴────────┘│ │└─┴────────┴──┴────────┘││ │ ││ |
|||
) |
|||
│ ││ │└─┴──────────────┴─┴──────────────┘│ │└─┴───────┴─┴──────────────┘││ ││ │└─┴────────────────┴──┴────────────────────────┘│ │ ││ |
|||
│ │└─┴───────────────────────────────────┴─┴────────────────────────────┘│ │└─┴────────────────────────────────────────────────┴──┴────────────────┘│ |
|||
└─┴──────────────────────────────────────────────────────────────────────┴──┴────────────────────────────────────────────────────────────────────────┘ |
|||
validate insert/?.~20 |
|||
4</lang> |
|||
Finally a caution: red black trees exhibit poor cache coherency. In many (perhaps most or all) cases an amortized hierarchical linear sort mechanism will perform better than a red black tree implementation. (And that characteristic is especially true of this particular implementation.) |
|||
items=: 3 :';D' |
|||
keys=: 3 :'0{"1 items y' |
|||
values=: 3 :'1{"1 items y' |
|||
</lang> |
|||
With use: |
|||
<lang J> |
|||
load'rb.ijs' |
|||
NB. populate dictionary in random order with 999 key value pairs |
|||
insert@:(; 6j1&":)"0@:?~ 999 |
|||
find 'the' NB. 'the' has no entry. |
|||
find 239 NB. entry 239 has the anticipated formatted string value. |
|||
239.0 |
|||
find 823823 NB. also no such entry |
|||
NB. |
|||
NB. tree passes the "no consecutive red" and "same number of black" |
|||
NB. nodes to and including NULL leaves. |
|||
check'' |
|||
</lang> |
|||
=={{header|jq}}== |
=={{header|jq}}== |