Mercurial > hg > jgplsrc

annotate vsb.c @ 0:e0bbaa717f41 draft default tip

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
lol J
author Jordi Gutiérrez Hermoso <jordigh@octave.org>
date Mon, 25 Nov 2013 11:56:30 -0500
parents
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
1 /* Copyright 1990-2011, Jsoftware Inc. All rights reserved. */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
2 /* License in license.txt. */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
3 /* */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
4 /* Verbs: s: */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
5
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
6 #include "j.h"
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
7
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
8
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
9 /* >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
10
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
11 #define BLACK 0
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
12 #define RED 1
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
13 #define ROOT (jt->sbroot)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
14 #define FILLFACTOR (jt->sbfillfactor)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
15 #define GAP (jt->sbgap)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
16
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
17 static const SBU sentinel = {0,0,0,BLACK,0,0,0,IMIN,0,0};
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
18
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
19 /* #define TMP */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
20 #ifdef TMP
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
21 #include <time.h>
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
22 static int tmp_lr=0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
23 static int tmp_rr=0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
24 static int tmp_lt=0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
25 static int tmp_while=0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
26 static int tmp_node=0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
27 static int tmp_reorder=0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
28 static int tmp_moves=0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
29 static int tmp_imax=0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
30 static int tmp_rhit=0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
31 static int tmp_lhit=0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
32 static clock_t clo;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
33 static D tickk=1.0/CLOCKS_PER_SEC;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
34 #endif
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
35
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
36
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
37 /* implementation dependend declarations */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
38 typedef enum {
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
39 STATUS_OK,
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
40 STATUS_MEM_EXHAUSTED,
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
41 STATUS_DUPLICATE_KEY,
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
42 STATUS_KEY_NOT_FOUND
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
43 } statusEnum;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
44
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
45
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
46 #ifdef TMP
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
47 #define NODE(a) (tmp_node++,a+jt->sbuv)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
48 #else
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
49 #define NODE(a) (a+jt->sbuv)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
50 #endif
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
51
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
52 #define NODEM(a,b) (jt->sbuv[a].b)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
53 #define LEFT(a) NODEM(a,left)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
54 #define RIGHT(a) NODEM(a,right)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
55 #define ORDER(a) NODEM(a,order)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
56 #define INDEX(a) NODEM(a,i)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
57 #define LENGTH(a) NODEM(a,n)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
58 #define HASH(a) NODEM(a,h)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
59 #define COLOR(a) NODEM(a,color)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
60 #define DOWN(a) NODEM(a,down)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
61 #define UP(a) NODEM(a,up)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
62 #define PARENT(a) NODEM(a,parent)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
63 #define GRANDPARENT(a) (PARENT(PARENT(a)))
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
64 #define ISLEFTCHILD(x) (x == LEFT(PARENT(x)))
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
65 #define ISRIGHTCHILD(x) (x == RIGHT(PARENT(x)))
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
66 #define compLT(a,b) Vcompare(jt,a,b)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
67 #define compEQ(a,b) ( a == b )
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
68
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
69
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
70
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
71 #ifdef TMP
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
72 static void showdepth(J jt, I node, int **ptr, I* size, I depth)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
73 {
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
74 if(LEFT(node) == 0) {
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
75 (*ptr) = realloc((*ptr), sizeof(I)*((*size)+1));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
76 (*ptr)[(*size)++]=depth;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
77 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
78 else showdepth(jt, LEFT(node), ptr, size, depth+1);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
79
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
80 if(RIGHT(node) == 0) {
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
81 (*ptr) = realloc((*ptr), sizeof(I)*((*size)+1));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
82 (*ptr)[(*size)++]=depth;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
83 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
84 else showdepth(jt, RIGHT(node), ptr, size, depth+1);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
85 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
86 #endif
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
87
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
88 static __inline int Vcompare(J jt,I a,I b){I m,n;SBU*u,*v;UC*s,*t;U2*p,*q;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
89 #ifdef TMP
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
90 tmp_lt++;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
91 #endif
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
92 u=a+jt->sbuv; m=u->n; s=(UC*)(jt->sbsv+u->i);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
93 v=b+jt->sbuv; n=v->n; t=(UC*)(jt->sbsv+v->i);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
94 switch((SBC2&u->flag?2:0)+(SBC2&v->flag?1:0)){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
95 case 0: { DO(MIN(m,n), if(*s!=*t)R *s<*t; ++s; ++t;);} break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
96 case 1: { q=(U2*)t; n/=2; DO(MIN(m,n), if(*s!=*q)R *s<*q; ++s; ++q;);} break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
97 case 2: {p=(U2*)s; m/=2; DO(MIN(m,n), if(*p!=*t)R *p<*t; ++p; ++t;);} break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
98 case 3: {p=(U2*)s; q=(U2*)t; m/=2; n/=2; DO(MIN(m,n), if(*p!=*q)R *p<*q; ++p; ++q;);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
99 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
100 R m<n;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
101 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
102
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
103 static __inline void rotateLeft(J jt, I x) {I y;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
104 #ifdef TMP
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
105 tmp_lr++;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
106 #endif
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
107 /***************************
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
108 * rotate node x to left *
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
109 ***************************/
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
110 y = RIGHT(x);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
111 if (RIGHT(x)= LEFT(y)) PARENT(LEFT(y)) = x; /* establish x->right link */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
112 if (y) PARENT(y) = PARENT(x); /* establish y->parent link */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
113 if (PARENT(x) == 0) ROOT = y;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
114 else if (ISLEFTCHILD(x)) LEFT (PARENT(x))= y;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
115 else RIGHT(PARENT(x))= y;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
116 if (LEFT(y) = x) PARENT(x) = y; /* link x and y */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
117 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
118
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
119
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
120 static __inline void rotateRight(J jt, I x) {I y;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
121 #ifdef TMP
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
122 tmp_rr++;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
123 #endif
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
124 /***************************
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
125 * rotate node x to right *
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
126 ***************************/
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
127 y = LEFT(x);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
128 if (LEFT(x)= RIGHT(y)) PARENT(RIGHT(y))= x; /* establish x->left link */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
129 if (y) PARENT(y) = PARENT(x); /* establish y->parent link */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
130 if (PARENT(x) == 0) ROOT = y;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
131 else if (ISRIGHTCHILD(x)) RIGHT(PARENT(x))= y;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
132 else LEFT (PARENT(x))= y;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
133 if (RIGHT(y)= x) PARENT(x) = y; /* link x and y */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
134 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
135
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
136 static __inline void insertFixup(J jt, I x) {B b;I y;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
137
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
138 /*************************************
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
139 * maintain Red-Black tree balance *
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
140 * after inserting node x *
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
141 *************************************/
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
142
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
143 /* check Red-Black properties */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
144 /* the repositioning is necessary to propogate the rebalancing */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
145 while (x != ROOT && COLOR(PARENT(x)) == RED) {
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
146 #ifdef TMP
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
147 tmp_while++;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
148 #endif
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
149 if (ISLEFTCHILD(PARENT(x))) { /* we have a violation */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
150 y = RIGHT(GRANDPARENT(x)); /* uncle */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
151 b = COLOR(y)==BLACK; /* uncle is BLACK */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
152 if (b && ISRIGHTCHILD(x)) {x=PARENT(x); rotateLeft(jt,x);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
153 COLOR(PARENT(x)) = BLACK;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
154 COLOR(GRANDPARENT(x)) = RED;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
155 if (b) rotateRight(jt, GRANDPARENT(x));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
156 else {COLOR(y)=BLACK; x=GRANDPARENT(x);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
157 }else { /* mirror image of above code */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
158 y = LEFT(GRANDPARENT(x)); /* uncle */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
159 b = COLOR(y)==BLACK; /* uncle is BLACK */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
160 if (b && ISLEFTCHILD(x)) {x=PARENT(x); rotateRight(jt,x);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
161 COLOR(PARENT(x)) = BLACK;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
162 COLOR(GRANDPARENT(x)) = RED;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
163 if (b) rotateLeft(jt, GRANDPARENT(x));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
164 else {COLOR(y)=BLACK; x=GRANDPARENT(x);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
165 }}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
166 COLOR(ROOT) = BLACK;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
167 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
168
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
169 static statusEnum insert(J jt, I key) {
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
170 I current,dist,i,keep1,keep2,lorder,parent,rorder,to_the_left,to_the_right;SBU *x;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
171 #ifdef TMP
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
172 static I icount=0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
173 #endif
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
174
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
175 if (key < 0) R STATUS_KEY_NOT_FOUND;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
176
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
177 /***********************************************
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
178 * allocate node for data and insert in tree *
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
179 ***********************************************/
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
180
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
181 /* find future parent */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
182 current = ROOT; /* jt-> root points to the int value of the root symbol */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
183 parent = to_the_left = to_the_right = 0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
184
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
185 while (current != 0) {
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
186 if (compEQ(key, current))return STATUS_DUPLICATE_KEY;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
187 parent = current;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
188 if(compLT(key, current)){to_the_right=current; current= LEFT(current);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
189 else {to_the_left =current; current=RIGHT(current);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
190 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
191
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
192 #ifdef TMP
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
193 icount++;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
194 if (icount==10000&&0) {I corder,running;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
195 icount=running=corder=0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
196 do {
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
197 ORDER(running)=corder;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
198 corder+=FILLFACTOR;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
199 running=UP(running);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
200 } while(running);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
201 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
202 #endif
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
203
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
204 /* get the new node */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
205
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
206 lorder = to_the_left ? ORDER(to_the_left) : 0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
207 rorder = to_the_right ? ORDER(to_the_right) : lorder + 2 * FILLFACTOR;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
208
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
209 if(rorder-lorder<2) { /* if(rorder-lorder<(2*GAP)) { */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
210 i=0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
211 /*parameter GAP is TWICE the difference in order numbers we want after re-ordering*/
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
212 while(to_the_right&&to_the_left&&(ORDER(to_the_right)-ORDER(to_the_left))<(GAP*++i)){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
213 keep1=to_the_left; to_the_left =DOWN(to_the_left);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
214 keep2=to_the_right; to_the_right=UP (to_the_right);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
215 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
216
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
217 #ifdef TMP
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
218 if(!to_the_left )UP(0) =keep1,i++,tmp_lhit++ ;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
219 if(!to_the_right)DOWN(0)=keep2,i++,tmp_rhit++;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
220 tmp_imax=__max(i,tmp_imax);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
221 tmp_moves+=2*i;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
222 tmp_reorder++;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
223 #else
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
224 if(!to_the_left )UP(0) =keep1,i++;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
225 if(!to_the_right)DOWN(0)=keep2,i++;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
226 #endif
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
227
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
228 lorder= to_the_left ? ORDER(to_the_left ) : rorder-2*i*FILLFACTOR;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
229 rorder= to_the_right ? ORDER(to_the_right) : lorder+2*i*FILLFACTOR;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
230 dist = (rorder-lorder)/(2*i);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
231
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
232 while(--i) {
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
233 to_the_left =UP (to_the_left); lorder+=dist; ORDER(to_the_left )=lorder;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
234 to_the_right=DOWN(to_the_right); rorder-=dist; ORDER(to_the_right)=rorder;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
235 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
236 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
237
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
238 x = NODE(key);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
239 x->parent= parent;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
240 x->left = 0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
241 x->right = 0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
242 x->color = RED;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
243 x->order = (rorder+lorder)/2;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
244 x->up = to_the_right; DOWN(to_the_right)=key;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
245 x->down = to_the_left; UP(to_the_left) =key;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
246
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
247 /* insert node in tree */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
248 if (0==parent) ROOT =key;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
249 else if(compLT(key, parent))LEFT(parent) =key;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
250 else RIGHT(parent)=key;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
251
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
252 insertFixup(jt, key);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
253
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
254 return STATUS_OK;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
255 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
256
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
257 /* >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
258
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
259 static I jtsbextend(J jt,I n,C*s,UI h,I hi){A x;I c,*hv,j,p;SBU*v;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
260 c=jt->sbun;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
261 if(c==*AS(jt->sbu)){ /* extend sbu unique symbols */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
262 RZ(x=ext(1,jt->sbu)); jt->sbu=x; jt->sbuv=(SBU*)AV(x);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
263 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
264 if(AN(jt->sbs)<n+jt->sbsn){ /* extend sbs strings */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
265 GA(x,LIT,2*(n+jt->sbsn),1,0); MC(CAV(x),jt->sbsv,jt->sbsn);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
266 fa(jt->sbs); ra(x); jt->sbs=x; jt->sbsv=CAV(x);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
267 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
268 if(AN(jt->sbh)<2*c){ /* extend sbh hash table */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
269 p=2*AN(jt->sbh); DO(64, if(p<=ptab[i]){p=ptab[i]; break;});
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
270 RZ(x=apv(p,-1L,0L)); hv=AV(x); v=jt->sbuv;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
271 DO(c, j=v++->h%p; while(0<=hv[j])j=(1+j)%p; hv[j]=i;);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
272 fa(jt->sbh); ra(x); jt->sbh=x; jt->sbhv= AV(x);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
273 hi=h%p; /* new hi wrt new sbh size */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
274 while(0<=hv[hi])hi=(1+hi)%p;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
275 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
276 R hi;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
277 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
278
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
279 static SB jtsbinsert(J jt,B c2,I n,C*s,UI h,I hi){I c,m,p;SBU*u;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
280 c=jt->sbun; /* cardinality */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
281 m=jt->sbsn; /* existing # chars in sbs */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
282 p=c2&&m%2; /* pad for alignment */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
283 RE(hi=sbextend(n+p,s,h,hi)); /* extend global tables as req'd*/
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
284 MC(SBSV(m+p),s,n); /* copy string into sbs */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
285 u=SBUV(c); u->i=m+p; u->n=n; u->h=h; /* index/length/hash */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
286 u->flag=c2?SBC2:0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
287 ASSERTSYS(STATUS_OK==insert(jt,c),"sbinsert");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
288 (jt->sbhv)[hi]=c; /* make sbh point to new symbol */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
289 ++jt->sbun; /* # unique symbols */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
290 jt->sbsn+=n+p; /* # chars in sbs */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
291 R(SB)c;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
292 } /* insert new symbol */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
293
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
294 static SB jtsbprobe(J jt,B c2,I n,C*s){B b;C*t;I hi,hn,ui;SBU*u;UI h;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
295 h=c2?hic2(n,(UC*)s):hic(n,(UC*)s);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
296 hn=AN(jt->sbh); /* size of hast table */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
297 hi=h%hn; /* index into hash table */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
298 while(1){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
299 ui=(jt->sbhv)[hi]; /* index into unique symbols */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
300 if(0>ui)R sbinsert(c2,n,s,h,hi); /* new symbol */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
301 u=SBUV(ui);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
302 if(h==u->h){ /* old symbol, maybe */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
303 t=SBSV(u->i);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
304 switch((c2?2:0)+(u->flag&SBC2?1:0)){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
305 case 1: if(n==u->n/2){C2*q=(C2*)t; b=1; DO(n, if(s[i]!=q[i]){b=0; break;}); if(b)R(SB)ui;}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
306 case 2: if(n==u->n*2){C2*q=(C2*)s; b=1; DO(n/2, if(t[i]!=q[i]){b=0; break;}); if(b)R(SB)ui;}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
307 case 3:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
308 case 0: if(n==u->n&&!memcmp(t,s,n))R(SB)ui; break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
309 }}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
310 hi=(1+hi)%hn; /* next hash table index */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
311 }} /* insert new symbol or get existing symbol */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
312
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
313
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
314 static A jtsbunstr(J jt,I q,A w){A z;B c2;I i,j,m,wn;SB*zv;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
315 RZ(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
316 if(!AN(w))R vec(SBT,0L,0L);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
317 ASSERT(AT(w)&LIT+C2T,EVDOMAIN);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
318 ASSERT(1>=AR(w),EVRANK);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
319 c2=1&&AT(w)&C2T; wn=AN(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
320 if(c2){C2 c,*wv=(C2*)AV(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
321 c=wv[q==-1?0:wn-1];
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
322 m=0; DO(wn, if(c==wv[i])++m;);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
323 GA(z,SBT,m,1,0); zv=SBAV(z);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
324 if(q==-1){for(i=j=1;i<=wn;++i)if(c==wv[i]||i==wn){RE(*zv++=sbprobe(c2,2*(i-j),(C*)(j+wv))); j=i+1;}}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
325 else {for(i=j=0;i< wn;++i)if(c==wv[i] ){RE(*zv++=sbprobe(c2,2*(i-j),(C*)(j+wv))); j=i+1;}}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
326 }else{C c,*wv=CAV(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
327 c=wv[q==-1?0:wn-1];
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
328 m=0; DO(wn, if(c==wv[i])++m;);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
329 GA(z,SBT,m,1,0); zv=SBAV(z);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
330 if(q==-1){for(i=j=1;i<=wn;++i)if(c==wv[i]||i==wn){RE(*zv++=sbprobe(c2,i-j,j+wv)); j=i+1;}}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
331 else {for(i=j=0;i< wn;++i)if(c==wv[i] ){RE(*zv++=sbprobe(c2,i-j,j+wv)); j=i+1;}}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
332 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
333 R z;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
334 } /* monad s: on leading (_1=q) or trailing (_2=q) character separated strings */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
335
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
336 static A jtsbunlit(J jt,C cx,A w){A z;B c2;I i,m,wc,wr,*ws;SB*zv;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
337 RZ(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
338 ASSERT(!AN(w)||AT(w)&LIT+C2T,EVDOMAIN);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
339 ASSERT(1<AR(w),EVRANK);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
340 c2=1&&AT(w)&C2T; wr=AR(w); ws=AS(w); wc=ws[wr-1];
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
341 RE(m=wc?AN(w)/wc:prod(wr-1,ws));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
342 GA(z,SBT,m,wr-1,ws); zv=SBAV(z);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
343 if(!wc)memset(zv,C0,m*sizeof(SB));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
344 else if(c2){C2 c=(C2)cx,*s,*wv=(C2*)AV(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
345 for(i=0;i<m;++i){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
346 s=wc+wv; DO(wc, if(c!=*--s)break;); /* exclude trailing "blanks" */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
347 RE(*zv++=sbprobe(c2,2*((c!=*s)+s-wv),(C*)wv));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
348 wv+=wc;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
349 }}else{C c=cx,*s,*wv=CAV(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
350 for(i=0;i<m;++i){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
351 s=wc+wv; DO(wc, if(c!=*--s)break;); /* exclude trailing "blanks" */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
352 RE(*zv++=sbprobe(c2,(c!=*s)+s-wv,wv));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
353 wv+=wc;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
354 }}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
355 R z;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
356 } /* each row of literal array w less the trailing "blanks" is a symbol */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
357
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
358 static F1(jtsbunbox){A*wv,x,z;B c2;I i,m,n,wd;SB*zv;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
359 RZ(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
360 ASSERT(!AN(w)||BOX&AT(w),EVDOMAIN);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
361 m=AN(w); wv=AAV(w); wd=(I)w*ARELATIVE(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
362 GA(z,SBT,m,AR(w),AS(w)); zv=SBAV(z);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
363 for(i=0;i<m;++i){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
364 x=WVR(i); n=AN(x); c2=1&&AT(x)&C2T;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
365 ASSERT(!n||AT(x)&LIT+C2T,EVDOMAIN);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
366 ASSERT(1>=AR(x),EVRANK);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
367 RE(*zv++=sbprobe(c2,c2?n+n:n,CAV(x)));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
368 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
369 R z;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
370 } /* each element of boxed array w is a string */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
371
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
372 static F1(jtsbunind){A z;I j,n,*zv;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
373 RZ(z=cvt(INT,w));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
374 zv=AV(z); n=jt->sbun;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
375 DO(AN(w), j=*zv++; ASSERT(0<=j&&j<n,EVINDEX););
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
376 AT(z)=SBT;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
377 R z;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
378 } /* w is a numeric array of symbol indices */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
379
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
380 #ifdef TMP
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
381 F1(jtsb1){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
382 A abc;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
383 clo=clock();
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
384 RZ(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
385 switch(AT(w)){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
386 default: ASSERT(0,EVDOMAIN);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
387 case C2T:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
388 case LIT: abc=(1>=AR(w)?sbunstr(-1L,w):sbunlit(' ',w)); break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
389 case BOX: abc=(sbunbox(w));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
390 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
391 clo-=clock();
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
392 R abc;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
393 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
394 #else
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
395 F1(jtsb1){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
396 RZ(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
397 switch(AT(w)){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
398 default: ASSERT(0,EVDOMAIN);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
399 case C2T:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
400 case LIT: R 1>=AR(w)?sbunstr(-1L,w):sbunlit(' ',w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
401 case BOX: R sbunbox(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
402 }} /* monad s: main control */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
403 #endif
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
404
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
405
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
406 F1(jtsborder){A z;I n,*zv;SB*v;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
407 RZ(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
408 n=AN(w); v=SBAV(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
409 ASSERT(!n||SBT&AT(w),EVDOMAIN);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
410 GA(z,INT,n,AR(w),AS(w)); zv=AV(z);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
411 DO(n, *zv++=SBUV(*v++)->order;);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
412 R z;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
413 } /* order numbers for symbol array w */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
414
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
415 static F1(jtsbbox){A z,*zv;C*s;I n;SB*v;SBU*u;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
416 RZ(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
417 n=AN(w); v=SBAV(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
418 ASSERT(!n||SBT&AT(w),EVDOMAIN);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
419 GA(z,BOX,n,AR(w),AS(w)); zv=AAV(z);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
420 DO(n, u=SBUV(*v++); s=SBSV(u->i); RZ(*zv++=SBC2&u->flag?vec(C2T,u->n/2,s):str(u->n,s)););
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
421 R z;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
422 } /* boxed strings for symbol array w */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
423
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
424 #define C2FSB(zv,u,q,m,c) \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
425 {C*s=SBSV(u->i);I k=u->n; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
426 if(SBC2&u->flag){MC(zv,s,k); zv+=k/=2;}else DO(k, *zv++=*s++;); \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
427 if(2==q)*zv++=c; else if(3==q)DO(m-k, *zv++=c;); \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
428 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
429
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
430 static A jtsbstr(J jt,I q,A w){A z;B c2=0;C c;I m,n;SB*v,*v0;SBU*u;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
431 RZ(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
432 m=n=AN(w); v=v0=SBAV(w); c=1==q?'`':C0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
433 ASSERT(!n||SBT&AT(w),EVDOMAIN);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
434 DO(n, u=SBUV(*v++); if(u->flag&SBC2){c2=1; m+=u->n/2;}else m+=u->n;);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
435 v=v0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
436 GA(z,c2?C2T:LIT,m,1,0);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
437 if(c2){C2*zv;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
438 zv=(C2*)AV(z);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
439 if(1==q)*zv++=c;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
440 DO(n-1, u=SBUV(*v++); C2FSB(zv,u,2,0,c););
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
441 if(n){ u=SBUV(*v++); C2FSB(zv,u,q,0,c);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
442 }else{C*zv;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
443 zv=CAV(z);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
444 if(1==q)*zv++=c;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
445 DO(n-1, u=SBUV(*v++); MC(zv,SBSV(u->i),u->n); zv+=u->n; *zv++=c;);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
446 if(n){ u=SBUV(*v++); MC(zv,SBSV(u->i),u->n); zv+=u->n; if(2==q)*zv=c;}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
447 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
448 R z;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
449 } /* leading (1=q) or trailing (2=q) separated string for symbol array w */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
450
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
451 static A jtsblit(J jt,C c,A w){A z;B c2=0;I k,m=0,n;SB*v,*v0;SBU*u;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
452 RZ(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
453 n=AN(w); v=v0=SBAV(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
454 ASSERT(!n||SBT&AT(w),EVDOMAIN);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
455 DO(n, u=SBUV(*v++); k=u->n; if(u->flag&SBC2){c2=1; k/=2;} if(m<k)m=k;);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
456 v=v0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
457 GA(z,c2?C2T:LIT,n*m,1+AR(w),AS(w)); *(AR(w)+AS(z))=m;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
458 if(c2){C2*zv=(C2*)AV(z); DO(n, u=SBUV(*v++); C2FSB(zv,u,3,m,c););}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
459 else {C*zv=CAV(z); memset(zv,c,n*m); DO(n, u=SBUV(*v++); MC(zv,SBSV(u->i),u->n); zv+=m;);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
460 R z;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
461 } /* literal array for symbol array w padded with c */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
462
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
463
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
464 static F1(jtsbhashstat){A z;I j,k,n,p,*zv;SBU*v;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
465 n=jt->sbun; v=jt->sbuv; p=AN(jt->sbh);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
466 GA(z,INT,n,1,0); zv=AV(z);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
467 DO(n, j=v++->h%p; k=1; while(i!=(jt->sbhv)[j]){j=(j+1)%p; ++k;} *zv++=k;);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
468 R z;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
469 } /* # queries in hash table for each unique symbol */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
470
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
471 static A jtsbcheck1(J jt,A una,A sna,A u,A s,A h,A roota,A ff,A gp){PROLOG;A x,*xv,y;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
472 B b,*dnv,*lfv,*rtv,*upv;C*ptv,*sv;I c,f,g,hn,*hv,i,j,r,sn,un,*yv;SBU*uv,*v;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
473 RZ(una&&sna&&u&&s&&h);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
474 ASSERTD(!AR(una),"c atom"); /* cardinality */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
475 ASSERTD(INT&AT(una),"c integer");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
476 c=*AV(una);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
477 ASSERTD(0<=c,"c non-negative");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
478 ASSERTD(!AR(sna),"sn atom"); /* string length */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
479 ASSERTD(INT&AT(sna),"sn integer");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
480 sn=*AV(sna);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
481 ASSERTD(0<=sn,"sn non-negative"); /* root */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
482 ASSERTD(!AR(roota),"root atom");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
483 ASSERTD(INT&AT(roota),"root integer");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
484 r=*AV(roota);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
485 ASSERTD(0<=r,"root non-negative");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
486 ASSERTD(r<c,"root bounded by c");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
487 ASSERTD(!AR(ff),"ff atom"); /* fill factor */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
488 ASSERTD(INT&AT(ff),"ff integer");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
489 f=*AV(ff);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
490 ASSERTD(0<=f,"ff non-negative");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
491 ASSERTD(!AR(gp),"gap atom"); /* gap */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
492 ASSERTD(INT&AT(gp),"gap integer");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
493 g=*AV(gp);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
494 ASSERTD(0<=g,"gap non-negative");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
495 ASSERTD(g<f,"gap bounded by ff");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
496 sv=CAV(s);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
497 un=*AS(u); uv=(SBU*)AV(u);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
498 hn= AN(h); hv=AV(h);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
499 ASSERTD(2==AR(u),"u matrix");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
500 ASSERTD(INT&AT(u),"u integer");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
501 ASSERTD(*(1+AS(u))==sizeof(SBU)/SZI,"u #columns");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
502 ASSERTD(c<=un,"c bounded by #u");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
503 ASSERTD(1==AR(s),"s vector");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
504 ASSERTD(LIT&AT(s),"s literal");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
505 ASSERTD(sn<=AN(s),"sn bounded by #s");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
506 ASSERTD(1==AR(h),"h vector");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
507 ASSERTD(INT&AT(h),"h integer");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
508 ASSERTD(c<=AN(h),"c bounded by #h");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
509 ASSERTD(equ(vec(INT,1L,&hn),factor(sc(hn))),"#h prime");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
510 b=0; DO(AN(h), j=hv[i]; if(-1==j)b=1; else ASSERTD(0<=j&&j<c,"h index"););
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
511 ASSERTD(b,"h full");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
512 GA(x,B01,c,1,0); lfv=BAV(x); memset(lfv,C0,c);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
513 GA(x,B01,c,1,0); rtv=BAV(x); memset(rtv,C0,c);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
514 GA(x,B01,c,1,0); dnv=BAV(x); memset(dnv,C0,c);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
515 GA(x,B01,c,1,0); upv=BAV(x); memset(upv,C0,c);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
516 GA(x,LIT,c,1,0); ptv=CAV(x); memset(ptv,C0,c); ptv[0]=1;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
517 GA(x,BOX,c,1,0); xv=AAV(x); RZ(xv[0]=str(uv->n,sv+uv->i));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
518 GA(y,INT,c,1,0); yv= AV(y); yv[0]=uv->order;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
519 for(i=1,v=1+uv;i<c;++i,++v){B c2;I ord,vi,vn;UC*vc;UI k;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
520 c2=1&&v->flag&SBC2;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
521 vi=v->i;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
522 vn=v->n;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
523 vc=(UC*)(sv+vi);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
524 ASSERTD(0<=vi&&vi<=sn,"u index");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
525 ASSERTD(!(c2&&vi%2),"u index alignment");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
526 ASSERTD(0<=vn&&!(c2&&vn%2),"u length");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
527 ASSERTD(sn>=vi+vn,"u index/length");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
528 k=(c2?hic2:hic)(vn,vc);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
529 ASSERTD(k==v->h,"u hash");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
530 j=k%hn; while(i!=hv[j]&&0<=hv[j])j=(1+j)%hn;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
531 ASSERTD(i==hv[j],"u/h mismatch");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
532 ASSERTD(BLACK==v->color||RED==v->color,"u color");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
533 RZ(xv[i]=c2?vec(C2T,vn/2,vc):str(vn,vc));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
534 yv[i]=ord=v->order;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
535 j=v->parent; ASSERTD( 0<=j&&j<c&&2>=++ptv[j],"u parent");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
536 j=v->left; ASSERTD(!j||0<=j&&j<c&&1>=++lfv[j]&& ord>(j+uv)->order ,"u left" );
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
537 j=v->right; ASSERTD(!j||0<=j&&j<c&&1>=++rtv[j]&& ord<(j+uv)->order ,"u right" );
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
538 j=v->down; ASSERTD( 0<=j&&j<c&&1>=++dnv[j]&&(!j||ord>(j+uv)->order),"u predecessor");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
539 j=v->up; ASSERTD( 0<=j&&j<c&&1>=++upv[j]&&(!j||ord<(j+uv)->order),"u successor" );
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
540 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
541 ASSERTD(equ(grade1(x),grade1(y)),"u order");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
542 EPILOG(one);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
543 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
544
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
545 static F1(jtsbcheck){R sbcheck1(sc(jt->sbun),sc(jt->sbsn),jt->sbu,jt->sbs,jt->sbh,sc(ROOT),sc(FILLFACTOR),sc(GAP));}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
546
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
547 static F1(jtsbsetdata){A h,s,u,*wv,x;I wd;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
548 RZ(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
549 ASSERTD(BOX&AT(w),"arg type");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
550 ASSERTD(1==AR(w), "arg rank");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
551 ASSERTD(8==AN(w), "arg length");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
552 wv=AAV(w); wd=(I)w*ARELATIVE(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
553 RZ(sbcheck1(WVR(0),WVR(1),WVR(2),WVR(3),WVR(4),WVR(5),WVR(6),WVR(7)));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
554 jt->sbun=*AV(WVR(0));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
555 jt->sbsn=*AV(WVR(1));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
556 RZ(x=ra(ca(WVR(2)))); u=jt->sbu; jt->sbu=x; jt->sbuv=(SBU*)AV(x);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
557 RZ(x=ra(ca(WVR(3)))); s=jt->sbs; jt->sbs=x; jt->sbsv= CAV(x);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
558 RZ(x=ra(ca(WVR(4)))); h=jt->sbh; jt->sbh=x; jt->sbhv= AV(x);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
559 ROOT =*AV(WVR(5));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
560 FILLFACTOR=*AV(WVR(6));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
561 GAP =*AV(WVR(7));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
562 fa(u); fa(s); fa(h);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
563 R one;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
564 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
565
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
566 static F1(jtsbgetdata){A z,*zv;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
567 GA(z,BOX,8,1,0); zv=AAV(z);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
568 RZ(zv[0]=sc(jt->sbun));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
569 RZ(zv[1]=sc(jt->sbsn));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
570 RZ(zv[2]=ca(jt->sbu));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
571 RZ(zv[3]=ca(jt->sbs));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
572 RZ(zv[4]=ca(jt->sbh));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
573 RZ(zv[5]=sc(ROOT));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
574 RZ(zv[6]=sc(FILLFACTOR));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
575 RZ(zv[7]=sc(GAP));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
576 R z;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
577 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
578
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
579 F2(jtsb2){A z;I j,k,n;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
580 #ifdef TMP
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
581 I*zv;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
582 #endif
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
583 RZ(a&&w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
584 RE(j=i0(a)); n=AN(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
585 ASSERT(!(1<=j&&j<=7)||!n||SBT&AT(w),EVDOMAIN);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
586 switch(j){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
587 default: ASSERT(0,EVDOMAIN);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
588 case 0:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
589 RE(k=i0(w));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
590 switch(k){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
591 default: ASSERT(0,EVDOMAIN);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
592 case 0: R sc(jt->sbun);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
593 case 1: R sc(jt->sbsn);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
594 case 2: R ca(jt->sbu);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
595 case 3: R ca(jt->sbs);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
596 case 4: R ca(jt->sbh);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
597 case 5: R sc(ROOT);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
598 case 6: R sc(FILLFACTOR);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
599 case 7: R sc(GAP);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
600 case 10: R sbgetdata(zero);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
601 case 11: R sbcheck(zero);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
602 case 12: R sbhashstat(zero);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
603 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
604 case 1: R sbstr(1L,w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
605 case -1: R sbunstr(-1L,w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
606 case 2: R sbstr(2L,w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
607 case -2: R sbunstr(-2L,w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
608 case 3: R sblit(C0,w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
609 case -3: R sbunlit(C0,w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
610 case 4: R sblit(' ',w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
611 case -4: R sbunlit(' ',w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
612 case 5: R sbbox(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
613 case -5: R sbunbox(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
614 case 6: RZ(z=ca(w)); AT(z)=INT; R z;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
615 case -6: R sbunind(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
616 case 7: R sborder(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
617 case 10: R sbsetdata(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
618 case 16: GAP = 4; R sc(GAP);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
619 case 17: GAP++; ASSERT(FILLFACTOR>GAP,EVLIMIT); R sc(GAP);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
620 case 18: GAP--; R sc(GAP);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
621 case 19: FILLFACTOR=1024; R sc(FILLFACTOR);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
622 case 20: FILLFACTOR*=2; R sc(FILLFACTOR);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
623 case 21: FILLFACTOR/=2; ASSERT(FILLFACTOR>GAP,EVLIMIT); R sc(FILLFACTOR);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
624 #ifdef TMP
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
625 case 22:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
626 GA(z,INT,10,1,0); zv=AV(z);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
627 zv[0] = tmp_lr = 0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
628 zv[1] = tmp_rr = 0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
629 zv[2] = tmp_lt = 0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
630 zv[3] = tmp_while = 0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
631 zv[4] = tmp_node = 0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
632 zv[5] = tmp_reorder = 0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
633 zv[6] = tmp_moves = 0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
634 zv[7] = tmp_imax = 0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
635 zv[8] = tmp_lhit;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
636 zv[9] = tmp_rhit;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
637 R z;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
638 case 23:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
639 GA(z,INT,10,1,0);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
640 zv[0] = tmp_lr;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
641 zv[1] = tmp_rr;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
642 zv[2] = tmp_lt;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
643 zv[3] = tmp_while;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
644 zv[4] = tmp_node;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
645 zv[5] = tmp_reorder;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
646 zv[6] = tmp_moves;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
647 zv[7] = tmp_imax;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
648 zv[8] = tmp_lhit;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
649 zv[9] = tmp_rhit;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
650 R z;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
651 case 24: R sc((I)clo);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
652 case 25: R scf(tickk);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
653 #endif
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
654 }}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
655
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
656
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
657 B jtsbtypeinit(J jt){A x;I c=sizeof(SBU)/SZI,s[2];
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
658 s[0]=2000; s[1]=c;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
659 GA(x,LIT,20000,1,0); jt->sbs=x; jt->sbsv= CAV(x); jt->sbsn=0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
660 RZ(x=apv(ptab[5],-1L,0L)); jt->sbh=x; jt->sbhv= AV(x);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
661 GA(x,INT,*s*c,2,s); jt->sbu=x; jt->sbuv=(SBU*)AV(x);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
662 GAP=15; /* TWICE the difference in order numbers we want after re-ordering */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
663 FILLFACTOR=1024;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
664 ROOT=0; /* initialize binary tree; initialize the empty symbol (used as fill) */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
665 jt->sbuv[0]=sentinel;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
666 jt->sbun=1;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
667 *jt->sbhv=0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
668 R 1;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
669 } /* initialize global data for SBT datatype */