1 #include "def.h"
2 #include "macro.h"
3
4 /* SYMMETRICA vector.c */
5 /* AK 160986 */
6
7 struct vector * callocvectorstruct();
8 static INT charvalue_bit_co();
9 static INT mem_counter_vec=0;
10 static int vector_speicherindex=-1; /* AK 231001 */
11 static int vector_speichersize=0; /* AK 231001 */
12 static struct vector **vector_speicher=NULL; /* AK 231001 */
13
14 INT freevectorstruct();
15
16 #define B_LS_V(l,s,r) \
17 do { FREESELF(r);\
18 C_O_K(r,VECTOR); \
19 r->ob_self.ob_vector = callocvectorstruct();\
20 C_V_S(r,s);\
21 C_V_L(r,l); } while(0)
22
23
24 #ifdef VECTORTRUE
vec_anfang()25 INT vec_anfang()
26 /* AK 100893 */
27 {
28 INT erg = OK;
29 #ifdef UNDEF
30 mem_counter_vec=0;
31 return OK;
32 #endif
33
34
35 ANFANG_MEMMANAGER(vector_speicher,
36 vector_speicherindex,
37 vector_speichersize,
38 mem_counter_vec);
39 ENDR("vec_anfang");
40
41 }
42
vec_ende()43 INT vec_ende()
44 /* AK 100893 */
45 {
46 INT erg = OK;
47 if (no_banner != TRUE)
48 if (mem_counter_vec != (INT)0)
49 {
50 fprintf(stderr, "mem_counter_vec = %" PRIINT "\n" ,mem_counter_vec);
51 erg += error("vec memory not freed");
52 }
53 #ifdef UNDEF
54 erg += vec_speicher_ende();
55 return erg;
56 #endif
57 ENDE_MEMMANAGER(vector_speicher,
58 vector_speicherindex,
59 vector_speichersize,
60 mem_counter_vec,"vec speicher not freed");
61
62 ENDR("vec_ende");
63 }
64
65
einsp_vector(a)66 INT einsp_vector(a) OP a;
67 /* AK 010692 */
68 /* AK 040398 V2.0 */
69 {
70 INT i;
71 for (i=(INT)0;i<S_V_LI(a);i++)
72 if (not einsp(S_V_I(a,i))) return FALSE;
73 return TRUE;
74 }
75
einsp_integervector(a)76 INT einsp_integervector(a) OP a;
77 /* AK 040398 V2.0 */
78 {
79 INT i;
80 for (i=(INT)0;i<S_V_LI(a);i++)
81 if (S_V_II(a,i) != (INT)1) return FALSE;
82 return TRUE;
83 }
84
decreasingp_vector(a)85 INT decreasingp_vector(a) OP a;
86 /* AK 151196 */
87 {
88 INT i;
89 if (S_V_LI(a) <= 1) return TRUE;
90
91 for (i=S_V_LI(a)-2;i>=0;i--)
92 if (LT(S_V_I(a,i),S_V_I(a,i+1))) return FALSE;
93 return TRUE;
94 }
95
96 #endif /* VECTORTRUE */
97
vectorp(a)98 INT vectorp(a) OP a;
99 /* AK 210192 */
100 /* AK 011098 V2.0 */
101 /* AK 110902 V2.1 */
102 {
103 #ifdef VECTORTRUE
104 if (
105 (s_o_k(a) == VECTOR)
106 ||
107 (s_o_k(a) == WORD)
108 ||
109 (s_o_k(a) == KRANZ)
110 ||
111 (s_o_k(a) == LAURENT)
112 ||
113 (s_o_k(a) == COMPOSITION)
114 ||
115 (s_o_k(a) == INTEGERVECTOR)
116 ||
117 (s_o_k(a) == SUBSET)
118 ||
119 (s_o_k(a) == HASHTABLE)
120 ||
121 (s_o_k(a) == FF)
122 ) return TRUE;
123 #endif /* VECTORTRUE */
124 return FALSE;
125 }
126
127 #ifdef VECTORTRUE
m_o_v(ob,vec)128 INT m_o_v(ob,vec) OP ob,vec;
129 /* make_object_vector */
130 /* AK 260488 */
131 /* AK 270689 V1.0 */ /* AK 211289 V1.1 */ /* AK 200891 V1.3 */
132 /* AK 011098 V2.0 */
133 /* input: arbitrary object
134 output: VECTOR object with one component = copy of first
135 parameter */
136 /* ob and vec may be equal */
137 {
138 INT erg = OK;
139 CE2(ob,vec,m_o_v);
140 erg += m_il_v((INT)1,vec);
141 COPY(ob,S_V_I(vec,(INT)0));
142 ENDR("m_o_v");
143 }
144
b_o_v(ob,vec)145 INT b_o_v(ob,vec) OP ob,vec;
146 /* build_object_vector */
147 /* AK 170590 V1.1 */ /* AK 200891 V1.3 */
148 /* AK 011098 V2.0 */
149 {
150 INT erg = OK;
151 OP l;
152 SYMCHECK( ob == vec, "b_o_v: the two parameters are equal");
153 NEW_INTEGER(l,1);
154 B_LS_V(l,ob,vec);
155 ENDR("b_o_v");
156 }
157
m_l_nv(il,vec)158 INT m_l_nv(il,vec) OP il,vec;
159 /* AK 160791 V1.3 */
160 /* AK 011098 V2.0 */
161 /* il and vec may be equal */
162 {
163 INT erg = OK;
164 CTO(INTEGER,"m_l_nv",il);
165 SYMCHECK(S_I_I(il) < 0,"m_l_nv:length < 0");
166 erg += m_il_nv(S_I_I(il),vec);
167 ENDR("m_l_nv");
168 }
169
m_il_nv(il,vec)170 INT m_il_nv(il,vec) INT il; OP vec;
171 /* AK 160791 V1.3 */
172 /* AK 011098 V2.0 */
173 {
174 INT i;
175 INT erg = OK;
176 SYMCHECK(il < 0,"m_il_nv:length < 0");
177 erg += m_il_v(il,vec);
178 for (i=(INT)0;i<S_V_LI(vec);i++)
179 M_I_I((INT)0,S_V_I(vec,i));
180 ENDR("m_il_nv");
181 }
182
183 /* object BITVECTOR */
184 /* S_V_LI = length in bit
185 S_BV_LI = length in byte */
186
s_bv_li(a)187 INT s_bv_li(a) OP a;
188 /* AK 050399 */
189 {
190 INT erg = OK,l;
191 CTO(BITVECTOR,"s_bv_li",a);
192 C_O_K(a,VECTOR);
193 l = s_v_li(a);
194 C_O_K(a,BITVECTOR);
195 return (l % 8 == 0 ? (l>>3) : (l>>3) +1);
196 ENDR("s_bv_li");
197 }
198
199
m_il_bv(il,bitvec)200 INT m_il_bv(il,bitvec) INT il; OP bitvec;
201 /* AK 161294 */
202 /* AK 190298 V2.0 */
203 /* il is length in bit */
204 {
205 INT erg = OK;
206 SYMCHECK(il < 0,"m_il_bv: negativ length");
207
208 B_LS_V(callocobject(),NULL,bitvec);
209 M_I_I(il,S_V_L(bitvec));
210 if (il > 0)
211 C_V_S(bitvec,SYM_calloc(S_BV_LI(bitvec)/8+1,8));
212 C_O_K(bitvec,BITVECTOR);
213 ENDR("m_il_bv");
214 }
215
m_il_nbv(il,bitvec)216 INT m_il_nbv(il,bitvec) INT il; OP bitvec;
217 /* AK 161294 */
218 /* AK 011098 V2.0 */
219 {
220 INT erg = OK;
221 COP("m_il_nbv(2)",bitvec);
222 SYMCHECK(il < 0,"m_il_nbv: negativ length");
223 B_LS_V(callocobject(),NULL,bitvec);
224 M_I_I(il,S_V_L(bitvec));
225 if (il > (INT)0)
226 C_V_S(bitvec,SYM_calloc(S_BV_LI(bitvec)/8+1,8));
227 C_O_K(bitvec,BITVECTOR);
228 ENDR("m_il_nbv");
229 }
230
231
m_il_v(il,vec)232 INT m_il_v(il,vec) INT il; OP vec;
233 /* make_integerlength_vector */
234 /* AK 250587 */ /* AK 270689 V1.0 */ /* AK 211289 V1.1 */
235 /* AK 080291 V1.2 test on negativ
236 test on zero length */
237 /* AK 200891 V1.3 */
238 /* AK 020398 V2.0 */
239 {
240 INT erg = OK,i;
241 OP l;
242 COP("m_il_v(2)",vec);
243 SYMCHECK(il < 0,"m_il_v: negativ length");
244
245 if (S_O_K(vec) == VECTOR) /* AK 261006 */
246 {
247 if (S_V_LI(vec)==il)
248 {
249 for (i=0,l=S_V_S(vec);i<il;i++,l++) FREESELF(l);
250 goto endr_ende;
251 }
252 }
253
254 NEW_INTEGER(l,il);
255
256 if (il == (INT)0)
257 B_LS_V(l,NULL,vec);
258 else if (il == (INT)1)
259 B_LS_V(l,CALLOCOBJECT(),vec);
260 else
261 B_LS_V(l, (OP) SYM_MALLOC(il * sizeof(struct object)),vec);
262
263 for (i=0,l=S_V_S(vec);i<il;i++,l++)
264 C_O_K(l,EMPTY);
265 ENDR("m_il_v");
266 }
267
m_il_integervector(il,vec)268 INT m_il_integervector(il,vec) INT il; OP vec;
269 /* AK 121101 */
270 {
271 INT erg = OK,i;
272 OP l;
273 COP("m_il_integervector(2)",vec);
274 SYMCHECK(il < 0,"m_il_integervector: negativ length");
275 NEW_INTEGER(l,il);
276 if (il == (INT)0)
277 B_LS_V(l,NULL,vec);
278 else if (il == (INT)1)
279 B_LS_V(l,CALLOCOBJECT(),vec);
280 else
281 B_LS_V(l, (OP) SYM_MALLOC((int)il * sizeof(struct object)),vec);
282
283 for (i=0,l=S_V_S(vec);i<il;i++,l++)
284 C_O_K(l,EMPTY);
285 C_O_K(vec,INTEGERVECTOR);
286 ENDR("m_il_v");
287 }
288
mem_size_vector(a)289 INT mem_size_vector(a) OP a;
290 /* AK 150295 */
291 /* AK 011098 V2.0 */
292 {
293 INT erg = 0,i; OP z;
294 if (a == NULL) return 0;
295 if (not VECTORP(a)) WTO("mem_size_vector",a);
296 erg += sizeof(struct object);
297 erg += sizeof(struct vector);
298 erg += mem_size(S_V_L(a));
299 for (i=0,z = S_V_S(a);i<S_V_LI(a);i++,z++)
300 erg += mem_size(z);
301 return erg;
302 }
303
304
b_l_v(length,a)305 INT b_l_v(length,a) OP length, a;
306 /* build_length_vector
307 build length becomes part of the result */
308 /* AK 170590 V1.1 */ /* AK 200891 V1.3 */
309 /* AK 011098 V2.0 */
310 {
311
312 INT erg = OK,i;
313 OP self ; /* self komponente des vectors */
314
315 CTO(INTEGER,"b_l_v",length);
316 if (length == a)
317 {
318 erg += error("b_l_v:two identic parameter");
319 goto endr_ende;
320 }
321
322
323 if (NULLP_INTEGER(length))
324 {
325 B_LS_V(length,NULL,a); /* AK 021291 */
326 goto endr_ende;
327 }
328
329 if (S_I_I(length) == (INT)1)
330 self = CALLOCOBJECT();
331 else
332 self = (OP) SYM_MALLOC((int)S_I_I(length) *
333 sizeof(struct object));
334 if (self == NULL)
335 {
336 erg += error("b_l_v:no memory");
337 goto endr_ende;
338 }
339
340 B_LS_V( length , self, a);
341
342 for (i=(INT)0;i<S_V_LI(a);i++) /* AK 271191 DOS */
343 C_O_K(S_V_I(a,i),EMPTY);
344 ENDR("b_l_v");
345 }
346
b_l_nv(a,b)347 INT b_l_nv(a,b) OP a,b;
348 /* AK 170692 */
349 /* AK 011098 V2.0 */
350 /* AK 271006 V3.1 */
351 {
352 INT i,erg = OK;;
353 CTO(INTEGER,"b_l_nv",a);
354 erg += b_l_v(a,b);
355 for (i=0;i<S_V_LI(b);i++)
356 M_I_I(0,S_V_I(b,i));
357 ENDR("b_l_nv");
358 }
359
m_l_v(length,a)360 INT m_l_v(length,a) OP length,a;
361 /* make_length_vector
362 make means: working with a copy of length in the result */
363 /* AK 170590 V1.1 */ /* AK 200891 V1.3 */
364 /* AK 011098 V2.0 */
365 /* length and a may be equal */
366 {
367 OP l ;
368 INT erg = OK;
369 CTO(INTEGER,"m_l_v",length);
370 l = CALLOCOBJECT();
371 COPY_INTEGER(length,l);
372 erg += b_l_v(l,a);
373 ENDR("m_l_v");
374 }
375
add_apply_vector(a,b)376 INT add_apply_vector(a,b) OP a, b;
377 /* b = b+a */
378 /* AK 211289 V1.1 */ /* AK 200891 V1.3 */
379 /* AK 011098 V2.0 */
380 {
381 INT i,erg = OK,t=0;
382 OP c;
383 CTTO(VECTOR,INTEGERVECTOR,"add_apply_vector(1)",a);
384 CTTO(VECTOR,INTEGERVECTOR,"add_apply_vector(2)",b);
385
386 if (S_V_LI(a) > S_V_LI(b))
387 {
388 c = CALLOCOBJECT();
389 COPY(a,c);
390 for (i=(INT)0;i<S_V_LI(a);i++)
391 if (i < S_V_LI(b))
392 {
393 ADD_APPLY(S_V_I(b,i),S_V_I(c,i));
394 if (S_O_K(S_V_I(c,i)) != INTEGER) t=1;
395 }
396 else break;
397 FREESELF(b);
398 *b = *c;
399 C_O_K(c,EMPTY);
400 FREEALL(c);
401 }
402 else {
403 for (i=0;i<S_V_LI(b);i++)
404 if (i < S_V_LI(a))
405 {
406 ADD_APPLY(S_V_I(a,i),S_V_I(b,i));
407 if (S_O_K(S_V_I(b,i)) != INTEGER) t=1;
408 }
409 else break;
410 };
411 if (t) C_O_K(b,VECTOR);
412 ENDR("add_apply_vector");
413 }
414
415
add_vector(a,b,c)416 INT add_vector(a,b,c) OP a, b, c;
417 /* AK 221086 */
418 /* AK 280689 V1.0 */ /* AK 211289 V1.1 */ /* AK 200891 V1.3 */
419 /* AK 260298 V2.0 */
420 {
421 INT i;
422 INT erg = OK;
423 CTO(EMPTY,"add_vector(3)",c);
424 if (not VECTORP(b))
425 {
426 erg += WTO("add_vector(2)",b);
427 goto endr_ende;
428 }
429 if (not VECTORP(a))
430 {
431 erg += WTO("add_vector(1)",a);
432 goto endr_ende;
433 }
434 CTO(EMPTY,"add_vector(3)",c);
435
436 if (S_V_LI(a) > S_V_LI(b))
437 {
438 erg += copy_vector(a,c);
439 for (i=(INT)0;i<S_V_LI(a);i++)
440 if (i < S_V_LI(b))
441 {
442 ADD_APPLY(S_V_I(b,i),S_V_I(c,i));
443 }
444 else break;
445 }
446 else {
447 erg += copy_vector(b,c);
448 for (i=(INT)0;i<S_V_LI(b);i++)
449 if (i < S_V_LI(a))
450 {
451 ADD_APPLY(S_V_I(a,i),S_V_I(c,i));
452 }
453 else break;
454 };
455 ENDR("add_vector");
456 }
457
add_integervector(a,b,c)458 INT add_integervector(a,b,c) OP a, b, c;
459 /* AK 260298 V2.0 */
460 /* AK 210704 V3.0 */
461 {
462 INT erg = OK;
463 CTO(INTEGERVECTOR,"add_integervector(1)",a);
464 CTO(EMPTY,"add_integervector(3)",c);
465 {
466 INT i,t=0;
467 if (S_O_K(b)!=INTEGERVECTOR) {
468 erg += add_vector(a,b,c);
469 goto endr_ende;
470 }
471 CTO(INTEGERVECTOR,"add_integervector(2)",b);
472 if (S_V_LI(a) > S_V_LI(b))
473 {
474 erg += copy_integervector(a,c);
475 for (i=0;i<S_V_LI(a);i++)
476 if (i < S_V_LI(b))
477 {
478 erg += add_apply_integer_integer(S_V_I(b,i),S_V_I(c,i));
479 if (S_O_K(S_V_I(c,i)) != INTEGER)t=1;
480 }
481 else break;
482 }
483 else {
484 erg += copy_integervector(b,c);
485 for (i=0;i<S_V_LI(b);i++)
486 if (i < S_V_LI(a))
487 {
488 erg += add_apply_integer_integer(S_V_I(a,i),S_V_I(c,i));
489 if (S_O_K(S_V_I(c,i)) != INTEGER)t=1;
490 }
491 else break;
492 };
493 if (t==1) C_O_K(c,VECTOR);
494 }
495 ENDR("add_integervector");
496 }
497
qsort_vector(vec)498 INT qsort_vector(vec) OP vec;
499 /* sorts a vector object vec
500 at the end the vector is increasing according to the routine comp
501 AK 060488 */
502 /* AK 280689 V1.0 */ /* AK 211289 V1.1 */ /* AK 200891 V1.3 */
503 /* AK 011098 V2.0 */
504 /* AK 060704 V3.0 */
505 {
506 INT erg = OK;
507 CTTO(INTEGERVECTOR,VECTOR,"qsort_vector(1)",vec);
508 {
509 qsort(
510 S_V_S(vec),(int)S_V_LI(vec),
511 sizeof(struct object),comp
512 );
513 return(OK);
514 }
515 CTTO(INTEGERVECTOR,VECTOR,"qsort_vector(1e)",vec);
516 ENDR("qsort_vector");
517 }
518
usersort_vector(vec,f)519 INT usersort_vector(vec,f) OP vec;INT (*f)();
520 /* sorting with a user defined comparion */
521 /* AK 011098 V2.0 */ /* AK 060704 V3.0 */
522 {
523 INT erg = OK;
524 CTTO(INTEGERVECTOR,VECTOR,"usersort_vector(1)",vec);
525 {
526 qsort(S_V_S(vec),(int)S_V_LI(vec),sizeof(struct object),f);
527 return(OK);
528 }
529 CTTO(INTEGERVECTOR,VECTOR,"usersort_vector(1e)",vec);
530 ENDR("usersort_vector");
531 }
532
sort_vector(vec)533 INT sort_vector(vec) OP vec;
534 /* insertion-sort (knuth) AK 270787 */
535 /* AK 280689 V1.0 */ /* AK 211289 V1.1 */ /* AK 200891 V1.3 */
536 /* AK 011098 V2.0 */
537 /* AK 060704 V3.0 */
538 {
539 INT erg = OK;
540 CTTO(INTEGERVECTOR,VECTOR,"sort_vector(1)",vec);
541 {
542 INT i,j,k;
543 OBJECTSELF zeiger;
544 OBJECTKIND art;
545
546 for (i=0;i<S_V_LI(vec);i++)
547 for (j=0;j<i;j++)
548 if (LT(S_V_I(vec,i),S_V_I(vec,j)))
549 {
550 zeiger = S_O_S(S_V_I(vec,i));
551 art = S_O_K(S_V_I(vec,i));
552 for (k=i;k>j;k--)
553 *S_V_I(vec,k) = *S_V_I(vec,k-1);
554 C_O_S(S_V_I(vec,j),zeiger);
555 C_O_K(S_V_I(vec,j),art);
556 };
557 return(OK);
558 }
559 CTTO(INTEGERVECTOR,VECTOR,"sort_vector(1e)",vec);
560 ENDR("sort_vector");
561 }
562
563
564
random_bv(a,b)565 INT random_bv(a,b) OP a,b;
566 /* AK 250194 */
567 /* AK 011098 V2.0 */
568 {
569 INT erg = OK,i;
570 int rand();
571 CTO(INTEGER,"random_bv",a);
572 erg += m_il_bv(S_I_I(a),b);
573 C_O_K(b,BITVECTOR);
574 for (i=(INT)0;i<S_V_LI(b);i++)
575 {
576 if (rand()%2)
577 SET_BV_I(b,i);
578 }
579 ENDR("random_bv");
580 }
581
sscan_bitvector(t,a)582 INT sscan_bitvector(t,a) OP a; char *t;
583 /* AK 011098 V2.0 */
584 {
585 INT erg = OK;
586 OP c;
587 COP("sscan_bitvector(1)",t);
588 COP("sscan_bitvector(2)",a);
589 c = callocobject();
590 erg += sscan_integervector(t,c);
591 erg += t_INTVECTOR_BITVECTOR(c,a);
592 FREEALL(c);
593 ENDR("sscan_bitvector");
594 }
595
sscan_integervector(t,a)596 INT sscan_integervector(t,a) OP a; char *t;
597 /* AK 050194 to read integervector from string
598 format [1,2,3,..]
599 */
600 /* AK 011098 V2.0 */
601 {
602 INT i,n,erg = OK;
603 char *v,*w;
604 int SYM_isdigit();
605
606 COP("sscan_integervector(1)",t);
607 COP("sscan_integervector(2)",a);
608
609 v = t;
610 while (*v == ' ') v++;
611 if (*v != '[')
612 {erg = ERROR; goto spe;}
613 w = v; n = (INT)1;
614 /* now we count the number of parts */
615 w++;
616 while (*w != ']')
617 {
618 if (*w == ' ') ; /* AK 060397 */
619 else if (*w == ',') n++;
620 else if (*w == '-'); /* AK 280197 */
621 else if (not SYM_isdigit(*w))
622 {erg = ERROR; goto spe;}
623 w++;
624 }
625 /* n is the number of parts */
626 m_il_v(n,a);
627 C_O_K(a,INTEGERVECTOR);
628 w = v;
629 w++;
630 for (i=(INT)0; i<n; i++)
631 {
632 erg += sscan(w,INTEGER,S_V_I(a,i));
633 if (erg != OK) goto spe;
634 if (*w == '-') w++; /* AK 151097 */
635 while (SYM_isdigit(*w)) w++;
636 w++;
637 }
638 spe:
639 ENDR("sscan_integervector");
640 }
641
sscan_permvector(t,a)642 INT sscan_permvector(t,a) OP a; char *t;
643 /* AK 180998 to read permutationvector from string
644 format [[..],[...],[...],..]
645 */
646 /* AK 011098 V2.0 */
647 {
648 INT i,n,erg = OK;
649 char *v,*w;
650 COP("sscan_permvector(1)",t);
651 COP("sscan_permvector(2)",a);
652
653 v = t;
654 while (*v == ' ') v++;
655 if (*v != '[')
656 {erg = ERROR; goto spe;}
657 w = v; n = (INT)1;
658 /* now we count the number of parts */
659 w++;
660 while (*w != ']')
661 {
662 if (*w == ' ') ;
663 else if (*w == '[')
664 {
665 w++;
666 while (*w != ']')
667 {
668 if (*w == '\0') {erg = ERROR; goto spe;}
669 else w++;
670 }
671 }
672 else if (*w == ',') n++;
673 else
674 {erg = ERROR; goto spe;}
675 w++;
676 }
677 /* n is the number of parts */
678 m_il_v(n,a);
679 C_O_K(a,VECTOR);
680 w = v;
681 while (*w != '[') w++;
682 w++;
683 for (i=(INT)0; i<n; i++)
684 {
685 while (*w != '[') w++;
686 erg += sscan(w,PERMUTATION,S_V_I(a,i));
687 if (erg != OK) goto spe;
688 while (*w != ']') w++;
689 w++;
690 }
691 spe:
692 ENDR("sscan_permvector");
693 }
694
random_integervector(a,b)695 INT random_integervector(a,b) OP a,b;
696 /* AK 250194 */
697 /* AK 011098 V2.0 */
698 {
699 INT erg = OK,i;
700 CTO(INTEGER,"random_integervector",a);
701
702 erg += m_l_v(a,b);
703 C_O_K(b,INTEGERVECTOR);
704 for (i=(INT)0;i<S_V_LI(b);i++)
705 erg += random_integer(S_V_I(b,i),NULL,NULL);
706 ENDR("random_integervector");
707 }
708
freeself_galois(a)709 INT freeself_galois(a) OP a;
710 {
711 INT erg =OK;
712 {
713 SYM_free(S_V_S(a));
714 FREEALL(S_V_L(a));
715 freevectorstruct(S_O_S(a).ob_vector);
716 C_O_K(a,EMPTY);
717 }
718 ENDR("freeself_galois");
719 }
720
freeself_integervector(a)721 INT freeself_integervector(a) OP a;
722 /* AK 110394 */ /* AK 020698 V2.0 */
723 /* AK 060704 V3.0 */
724 {
725 INT erg = OK;
726 CTTTO(COMPOSITION,SUBSET,INTEGERVECTOR,"freeself_integervector(1)",a);
727 {
728
729 if (S_V_LI(a) == 1)
730 FREEALL(S_V_S(a));
731 else if (S_V_LI(a) > 0)
732 SYM_free(S_V_S(a));
733
734 FREEALL(S_V_L(a));
735 freevectorstruct(S_O_S(a).ob_vector);
736 C_O_K(a,EMPTY);
737 }
738 CTO(EMPTY,"freeself_integervector(1e)",a);
739 ENDR("freeself_integervector");
740 }
741
742
743
freeself_hashtable(vec)744 INT freeself_hashtable(vec) OP vec;
745 /* AK 231001 AK 100307*/
746 /* length > 1 */
747 {
748 INT i,erg=OK,j;
749 OP z,zj;
750
751 CTO(HASHTABLE,"freeself_hashtable(1)",vec);
752
753 if (S_V_II(vec,S_V_LI(vec)) > 0)
754 {
755 for (i=(INT)0,z=S_V_S(vec);i<S_V_LI(vec);i++,z++)
756 if (not EMPTYP(z))
757 {
758 for (j=0,zj=S_V_S(z);j<S_V_LI(z);j++,zj++)
759 FREESELF(zj);
760 FREESELF_INTEGERVECTOR(z);
761 }
762 else if (S_I_I(z) == -1) goto ee;
763 else { i = S_I_I(z)-1; z = S_V_I(vec,i); }
764 }
765 else {
766 for (i=(INT)0,z=S_V_S(vec);i<S_V_LI(vec);i++,z++)
767 if (not EMPTYP(z))
768 {
769 C_O_K(z,INTEGERVECTOR);
770 FREESELF_INTEGERVECTOR(z);
771 }
772 else if (S_I_I(z) == -1) goto ee;
773 else { i = S_I_I(z)-1; z = S_V_I(vec,i); }
774 }
775
776 ee:
777 SYM_free(S_V_S(vec));
778 FREEALL(S_V_L(vec));
779 freevectorstruct(S_O_S(vec).ob_vector);
780 C_O_K(vec,EMPTY);
781
782 ENDR("freeself_hashtable");
783 }
784
785
786
freeself_bitvector(a)787 INT freeself_bitvector(a) OP a;
788 /* AK 081294 */
789 /* AK 020698 V2.0 */
790 {
791 INT erg = OK;
792 CTO(BITVECTOR,"freeself_bitvector",a);
793
794 if (S_V_S(a) != NULL)
795 SYM_free(S_V_S(a));
796 FREEALL(S_V_L(a));
797 freevectorstruct(S_O_S(a).ob_vector);
798 C_O_K(a,EMPTY);
799 ENDR("freeself_bitvector");
800 }
801
802 #define FREESELF_VC(vec)\
803 if (S_V_LI(vec) == 1)\
804 FREEALL(S_V_S(vec));\
805 else if (S_V_LI(vec) > 0)\
806 {\
807 OP z;INT i;\
808 for (z = S_V_S(vec),i=0;i<S_V_LI(vec);i++,z++)\
809 FREESELF(z);\
810 \
811 SYM_free(S_V_S(vec));\
812 }\
813 FREEALL(S_V_L(vec));\
814 freevectorstruct(S_O_S(vec).ob_vector);\
815 C_O_K(vec,EMPTY);
816
817
freeself_laurent(vec)818 INT freeself_laurent(vec) OP vec;
819 /* AK 060502 */
820 {
821 INT erg=OK;
822 CTO(LAURENT,"freeself_laurent",vec);
823 FREESELF_VC(vec);
824 ENDR("freeself_laurent");
825 }
826
827
828
829
freeself_vector(vec)830 INT freeself_vector(vec) OP vec;
831 /*
832 frees the memory allocated to a vector object,
833 after this routine vec is an empty object
834 */
835 /* AK 280689 V1.0 */ /* AK 211189 V1.1 */ /* AK 130691 V1.2 */
836 /* AK 200891 V1.3 */ /* AK 011098 V2.0 */
837 /* AK 271006 V3.1 */
838 {
839 INT erg=OK;
840 CTTTO(QUEUE,WORD,VECTOR,"freeself_vector",vec);
841
842
843 {
844 FREESELF_VC(vec);
845 }
846
847
848 ENDR("freeself_vector");
849 }
850
851
852
853
addinvers_vector(vec,res)854 INT addinvers_vector(vec,res) OP vec,res;
855 /* AK 270887 */ /* AK 280689 V1.0 */ /* AK 201289 V1.1 */
856 /* AK 200891 V1.3 */ /* AK 011098 V2.0 */
857 /* AK 271006 V3.1 */
858 {
859 INT erg = OK;
860 CTO(VECTOR,"addinvers_vector(1)",vec);
861 CTO(EMPTY,"addinvers_vector(2)",res);
862
863 {
864 INT i;
865
866 erg += m_l_v(S_V_L(vec),res);
867 C_O_K(res,S_O_K(vec));
868 for (i=0;i<S_V_LI(vec);i++)
869 erg += addinvers(S_V_I(vec,i),S_V_I(res,i));
870 }
871
872 ENDR("addinvers_vector");
873 }
874
875
addinvers_apply_vector(vec)876 INT addinvers_apply_vector(vec) OP vec;
877 /* AK 201289 V1.1 */ /* AK 080591 V1.2 */ /* AK 200891 V1.3 */
878 /* AK 011098 V2.0 */
879 {
880 INT i,erg=OK;
881 CTO(VECTOR,"addinvers_apply_vector(1)",vec);
882
883 for (i=(INT)0;i<S_V_LI(vec);i++)
884 erg += addinvers_apply(S_V_I(vec,i));
885
886 ENDR("addinvers_apply_vector");
887 }
888
mod_vector(vec,mo,res)889 INT mod_vector(vec,mo,res) OP vec,mo,res;
890 /* AK 101198 V2.0 */
891 {
892 INT i,erg=OK;
893 CTO(VECTOR,"mod_vector(1)",vec);
894 erg += m_l_v(S_V_L(vec),res);
895 C_O_K(res,S_O_K(vec));
896 for (i=(INT)0;i<S_V_LI(vec);i++)
897 erg += mod(S_V_I(vec,i),mo, S_V_I(res,i) );
898 ENDR("mod_vector");
899 }
900
901
addtoallvectorelements(zahl,vector,res)902 INT addtoallvectorelements(zahl,vector,res) OP zahl,vector,res;
903 /* AK 280689 V1.0 */ /* AK 211289 V1.1 */ /* AK 200891 V1.3 */
904 /* AK 011098 V2.0 */
905 {
906 INT i;
907 INT erg = OK;
908 CTO(VECTOR,"addtoallvectorelements(2)",vector);
909
910 erg += m_l_v(S_V_L(vector),res);
911 C_O_K(res,S_O_K(vector));
912 for( i = (INT)0; i < S_V_LI(res);
913 erg += add(zahl,S_V_I(res,i),S_V_I(res,i)),
914 i++);
915 ENDR("addtoallvectorelements");
916 }
917
absolute_vector(vec,res)918 INT absolute_vector(vec,res) OP vec, res;
919 /* AK 240293 */
920 /* AK 011098 V2.0 */
921 {
922 INT i,erg=OK;
923 CTO(VECTOR,"absolute_vector(1)",vec);
924 CTO(EMPTY,"absolute_vector(2)",res);
925
926 m_il_v( S_V_LI(vec), res);
927
928 for( i=(INT)0; i < S_V_LI(vec); i++)
929 {
930 erg += absolute(S_V_I(vec,i),S_V_I(res,i));
931 }
932 C_O_K(res,S_O_K(vec));
933 ENDR("absolute_vector");
934 }
935
absolute_integervector(vec,res)936 INT absolute_integervector(vec,res) OP vec, res;
937 /* AK 070502 */
938 {
939 INT i,erg=OK;
940 CTO(INTEGERVECTOR,"absolute_vector(1)",vec);
941 CTO(EMPTY,"absolute_vector(2)",res);
942
943 erg += m_il_integervector( S_V_LI(vec), res);
944
945 for( i=(INT)0; i < S_V_LI(vec); i++)
946 ABSOLUTE_INTEGER(S_V_I(vec,i),S_V_I(res,i));
947
948 ENDR("absolute_vector");
949 }
950
951 #define COPY_VC(vec,res)\
952 {\
953 OP zv,zr;\
954 INT i;\
955 erg += m_il_v( S_V_LI(vec), res); \
956 for(zv=S_V_S(vec), i=0, zr = S_V_S(res);\
957 i < S_V_LI(vec); \
958 i++,zv++,zr++) \
959 COPY(zv,zr); \
960 }
961
copy_vector(vec,res)962 INT copy_vector(vec,res) OP vec, res;
963 /* AK 021286 */ /* AK 280689 V1.0 */ /* AK 081289 V1.1 */
964 /* AK 120391 V1.2 */ /* AK 200891 V1.3 */
965 /* AK 011098 V2.0 */
966 {
967 INT erg = OK;
968 CTO(VECTOR,"copy_vector(1)",vec);
969 CTO(EMPTY,"copy_vector(2)",res);
970 COPY_VC(vec,res);
971 C_O_K(res,VECTOR);
972 ENDR("copy_vector");
973 }
974
copy_word(vec,res)975 INT copy_word(vec,res) OP vec, res;
976 {
977 INT erg = OK;
978 CTO(WORD,"copy_word(1)",vec);
979 CTO(EMPTY,"copy_word(2)",res);
980 COPY_VC(vec,res);
981 C_O_K(res,WORD);
982 ENDR("copy_word");
983 }
copy_kranz(vec,res)984 INT copy_kranz(vec,res) OP vec, res;
985 {
986 INT erg = OK;
987 CTO(KRANZ,"copy_kranz(1)",vec);
988 CTO(EMPTY,"copy_kranz(2)",res);
989 COPY_VC(vec,res);
990 C_O_K(res,KRANZ);
991 ENDR("copy_kranz");
992 }
993
copy_subset(vec,res)994 INT copy_subset(vec,res) OP vec, res;
995 {
996 INT erg = OK;
997 CTO(SUBSET,"copy_subset(1)",vec);
998 CTO(EMPTY,"copy_subset(2)",res);
999 COPY_VC(vec,res);
1000 C_O_K(res,SUBSET);
1001 ENDR("copy_subset");
1002 }
copy_laurent(vec,res)1003 INT copy_laurent(vec,res) OP vec, res;
1004 {
1005 INT erg = OK;
1006 CTO(LAURENT,"copy_laurent(1)",vec);
1007 CTO(EMPTY,"copy_laurent(2)",res);
1008 COPY_VC(vec,res);
1009 C_O_K(res,LAURENT);
1010 ENDR("copy_laurent");
1011 }
copy_queue(vec,res)1012 INT copy_queue(vec,res) OP vec, res;
1013 {
1014 INT erg = OK;
1015 CTO(QUEUE,"copy_queue(1)",vec);
1016 CTO(EMPTY,"copy_queue(2)",res);
1017 COPY_VC(vec,res);
1018 C_O_K(res,QUEUE);
1019 ENDR("copy_queue");
1020 }
1021
1022
1023
sub_comp_bv(a,b)1024 INT sub_comp_bv(a,b) OP a,b;
1025 /* AK 180396 */
1026 /* AK 011098 V2.0 */
1027 {
1028 INT erg=0,i,ai,bi;
1029 CTO(BITVECTOR,"comp_bv",a);
1030 CTO(BITVECTOR,"comp_bv",b);
1031 if (S_V_LI(a) != S_V_LI(b))
1032 return NONCOMPARABLE;
1033 for (i=0;i<S_V_LI(a);i++)
1034 {
1035 ai = GET_BV_I(a,i);
1036 bi = GET_BV_I(b,i);
1037 if (ai == bi) continue;
1038 if ((ai < bi) && (erg == 1)) return NONCOMPARABLE;
1039 if ((ai < bi) && (erg == 0)) { erg = -1; continue; }
1040 if ((ai > bi) && (erg == -1)) return NONCOMPARABLE;
1041 if ((ai > bi) && (erg == 0)) { erg = 1; continue; }
1042 }
1043 return erg;
1044 ENDR("sub_comp_bv");
1045 }
1046
comp_bv(a,b)1047 INT comp_bv(a,b) OP a,b;
1048 /* AK 200395 */
1049 /* AK 011098 V2.0 */
1050 {
1051 INT erg = OK;
1052 CTO(BITVECTOR,"comp_bv",a);
1053 CTO(BITVECTOR,"comp_bv",b);
1054 if (S_V_LI(a) != S_V_LI(b))
1055 error("comp_bv:different lengths");
1056 /*
1057 for (i=0;i<S_V_LI(a);i++)
1058 if (GET_BV_I(a,i) < GET_BV_I(b,i)) return (INT)-1;
1059 else if (GET_BV_I(a,i) > GET_BV_I(b,i)) return (INT)1;
1060 return (INT) 0;
1061 */
1062 /*
1063 println(a);
1064 println(b);
1065 */
1066 erg = (INT) memcmp((void *)S_V_S(a), (void *)S_V_S(b), (size_t)S_BV_LI(a));
1067 /*
1068 printf("comp=%ld\n",erg);
1069 */
1070 return erg;
1071
1072
1073
1074 ENDR("comp_bv");
1075 }
1076
1077
eq_vector(a,b)1078 INT eq_vector(a,b) OP a,b;
1079 /* AK 201201 */
1080 /* AK 291104 V3.0 */
1081 {
1082 INT erg = OK;
1083 CTO(VECTOR,"eq_vector(1)",a);
1084 if (S_O_K(b) != VECTOR) return FALSE;
1085 CTO(VECTOR,"eq_vector(2)",b);
1086 if (S_V_LI(b) != S_V_LI(a)) return FALSE;
1087
1088 {
1089 INT i,l=S_V_LI(a);
1090 for (i=0;i<l;i++)
1091 if (not EQ(S_V_I(a,i), S_V_I(b,i)) ) return FALSE;
1092
1093 return TRUE;
1094 }
1095 ENDR("eq_vector");
1096 }
1097
eq_integervector_integervector(a,b)1098 INT eq_integervector_integervector(a,b) OP a,b;
1099 /* AK 120104 */ /* AK 280804 V3.0 */
1100 {
1101 INT erg = OK;
1102 CTO(INTEGERVECTOR,"eq_integervector_integervector(1)",a);
1103 CTO(INTEGERVECTOR,"eq_integervector_integervector(2)",b);
1104 {
1105 OP za,zb;INT i;
1106 if (S_V_LI(a) != S_V_LI(b)) return FALSE;
1107 for (i=0,za=S_V_S(a),zb=S_V_S(b);
1108 i<S_V_LI(a);
1109 i++,za++,zb++)
1110 if (S_I_I(za)!=S_I_I(zb)) return FALSE;
1111 return TRUE;
1112 }
1113 ENDR("eq_integervector_integervector");
1114 }
1115
1116 #define COMP_VC(a,b)\
1117 {/*lex comp for vector objects */\
1118 INT i,res;\
1119 OP az,bz;\
1120 for (az=S_V_S(a),bz=S_V_S(b),i=0; \
1121 i<S_V_LI(a); i++,az++,bz++)\
1122 {\
1123 if (i >= S_V_LI(b)) return(1);\
1124 res = comp(az,bz);\
1125 if (res != 0) return(res);\
1126 };\
1127 if (S_V_LI(a) < S_V_LI(b)) return -1;\
1128 return(0);\
1129 }
1130
comp_integervector(a,b)1131 INT comp_integervector(a,b) OP a,b;
1132 /* AK 011098 V2.0 *//* AK 270804 V3.0 */
1133 {
1134 INT erg = OK;
1135 CTTTO(INTEGERVECTOR,COMPOSITION,SUBSET,"comp_integervector(1)",a);
1136 if (S_O_K(b) == VECTOR) { /* AK 080502 */ COMP_VC(a,b); }
1137 CTTTO(INTEGERVECTOR,COMPOSITION,SUBSET,"comp_integervector(2)",b);
1138 {
1139 OP za,zb;
1140 INT i;
1141
1142 za = S_V_S(a);zb=S_V_S(b);
1143 for ( i=0; i<S_V_LI(a); i++,za++,zb++)
1144 {
1145 if (i >= S_V_LI(b)) return 1;
1146 if (S_I_I(za) > S_I_I(zb)) return 1;
1147 if (S_I_I(za) == S_I_I(zb)) continue;
1148 return -1;
1149 };
1150 if (i < S_V_LI(b))
1151 return -1;
1152 return 0;
1153 }
1154 ENDR("comp_integervector");
1155 }
1156
comp_galois(a,b)1157 INT comp_galois(a,b) OP a,b;
1158 {
1159 INT erg = OK;
1160 CTO(GALOISRING,"comp_galois(1)",a);
1161 CTO(GALOISRING,"comp_galois(2)",b);
1162 {
1163 OP za,zb;
1164 INT i;
1165
1166 za = S_V_S(a);zb=S_V_S(b);
1167 for ( i=0; i<S_V_LI(a); i++,za++,zb++)
1168 {
1169 if (i >= S_V_LI(b)) return 1;
1170 if (S_I_I(za) > S_I_I(zb)) return 1;
1171 if (S_I_I(za) == S_I_I(zb)) continue;
1172 return -1;
1173 };
1174 if (i < S_V_LI(b))
1175 return -1;
1176 return 0;
1177 }
1178 ENDR("comp_galois");
1179 }
1180
comp_vector(a,b)1181 INT comp_vector(a,b) OP a,b;
1182 /* AK 060488 */ /* AK 280689 V1.0 */ /* AK 201289 V1.1 */
1183 /* AK 200891 V1.3 */
1184 /* AK 260298 V2.0 */
1185 {
1186 INT erg = OK;
1187 CTO(VECTOR,"comp_vector(1)",a);
1188 CTTTO(VECTOR,INTEGERVECTOR,WORD,"comp_vector(2)",b);
1189 COMP_VC(a,b);
1190
1191 ENDR("comp_vector");
1192 }
1193
comp_word(a,b)1194 INT comp_word(a,b) OP a,b;
1195 /* AK 060502 from comp_vector */
1196 {
1197 INT erg = OK;
1198 CTO(WORD,"comp_word(1)",a);
1199 CTTTO(VECTOR,INTEGERVECTOR,WORD,"comp_word(2)",b);
1200 COMP_VC(a,b);
1201
1202 ENDR("comp_word");
1203 }
1204
1205
scan_bitvector(res)1206 INT scan_bitvector(res) OP res;
1207 /* AK 280689 V1.0 */ /* AK 211289 V1.1 */ /* AK 080591 V1.2 */
1208 /* AK 200891 V1.3 */
1209 /* AK 011098 V2.0 */
1210 {
1211 INT i,erg =OK;
1212 OP d,e;
1213 COP("scan_bitvector(1)",res);
1214
1215 d = callocobject();
1216 e = callocobject();
1217 erg += printeingabe("input of a bitvector (0-1 vector)");
1218 erg += printeingabe("length of bit vector ");
1219 erg += scan(INTEGER,d);
1220 erg += b_l_v(d,e);
1221 for (i=(INT)0;i<S_V_LI(e); erg += scan(INTEGER,S_V_I(e,i++)));
1222 erg += t_INTVECTOR_BITVECTOR(e,res);
1223 FREEALL(e);
1224 ENDR("scan_bitvector");
1225 }
1226
scan_integervector(res)1227 INT scan_integervector(res) OP res;
1228 /* AK 280689 V1.0 */ /* AK 211289 V1.1 */ /* AK 080591 V1.2 */
1229 /* AK 200891 V1.3 */ /* AK 180998 V2.0 */
1230 {
1231 INT i,erg =OK;
1232 OP d;
1233 COP("scan_integervector(1)",res);
1234
1235 d = callocobject();
1236 erg += printeingabe("length of INTEGER vector ");
1237 erg += scan(INTEGER,d);
1238 erg += b_l_v(d,res);
1239 for (i=(INT)0;i<S_V_LI(res); erg += scan(INTEGER,S_V_I(res,i++)));
1240 C_O_K(res,INTEGERVECTOR);
1241 ENDR("scan_integervector");
1242 }
1243
scan_permvector(res)1244 INT scan_permvector(res) OP res;
1245 /* AK 180998 V2.0 */
1246 {
1247 INT i,erg =OK;
1248 OP d;
1249 COP("scan_permvector(1)",res);
1250
1251 d = callocobject();
1252 erg += printeingabe("length of PERMUTATION vector ");
1253 erg += scan(INTEGER,d);
1254 erg += b_l_v(d,res);
1255 for (i=(INT)0;i<S_V_LI(res); erg += scan(PERMUTATION,S_V_I(res,i++)));
1256 C_O_K(res,VECTOR);
1257 ENDR("scan_permvector");
1258 }
1259
1260
1261
1262
scan_vector(res)1263 INT scan_vector(res) OP res;
1264 /* AK 280689 V1.0 */ /* AK 211289 V1.1 */ /* AK 200891 V1.3 */
1265 /* AK 011098 V2.0 */
1266 {
1267 INT i,erg=OK;
1268 OBJECTKIND kind;
1269 OP d;
1270 COP("scan_vector(1)",res);
1271
1272 d = callocobject();
1273 erg += printeingabe("length of vector ");
1274 erg += scan(INTEGER,d);
1275 erg += b_l_v(d,res);
1276 erg += printeingabe("kind of vector elements ");
1277 kind = scanobjectkind();
1278 for (i=(INT)0;i < S_V_LI(res); erg += scan(kind,S_V_I(res,i++)));
1279 ENDR("scan_vector");
1280 }
1281
1282
1283
callocvectorstruct()1284 struct vector * callocvectorstruct()
1285 /* AK 170889 V1.1 malloc statt calloc */ /* AK 211289 V1.1 */
1286 /* AK 200891 V1.3 */
1287 /* AK 011098 V2.0 */
1288 {
1289 struct vector * res;
1290 INT erg = OK;
1291 #ifdef UNDEF
1292 if (vector_speicherindex >= 0) /* AK 231001 */
1293 {
1294 res=vector_speicher[vector_speicherindex--];
1295 goto ende;
1296 }
1297
1298 res = (struct vector *) SYM_MALLOC(sizeof(struct vector));
1299 if (res == NULL)
1300 no_memory();
1301 ende:
1302 mem_counter_vec++;
1303 #endif
1304 CALLOC_MEMMANAGER(struct vector,
1305 vector_speicher,
1306 vector_speicherindex,
1307 mem_counter_vec,
1308 res);
1309 return res;
1310 ENDTYP("callocvectorstruct", struct vector * );
1311 }
1312
freevectorstruct(v)1313 INT freevectorstruct(v) struct vector *v;
1314 /* AK 231001 */
1315 {
1316 INT erg = OK;
1317 #ifdef UNDEF
1318 if (vector_speicherindex+1 == vector_speichersize) {
1319 if (vector_speichersize == 0) {
1320 vector_speicher = (struct vector **) SYM_MALLOC(100 * sizeof(struct vector *));
1321 if (vector_speicher == NULL) {
1322 erg += error("no memory");
1323 goto endr_ende;
1324 }
1325 vector_speichersize = 100;
1326 }
1327 else {
1328 vector_speicher = (struct vector **) SYM_realloc (vector_speicher,
1329 2 * vector_speichersize * sizeof(struct vector *));
1330 if (vector_speicher == NULL) {
1331 erg += error("no memory");
1332 goto endr_ende;
1333 }
1334 vector_speichersize = 2 * vector_speichersize;
1335 }
1336 }
1337 vector_speicher[++vector_speicherindex] = v;
1338 mem_counter_vec--;
1339 #endif
1340 FREE_MEMMANAGER(struct vector *,
1341 vector_speicher,
1342 vector_speicherindex,
1343 vector_speichersize,
1344 mem_counter_vec,
1345 v);
1346 ENDR("freevectorstruct");
1347 }
1348
1349 #ifdef UNDEF
vec_speicher_ende()1350 static INT vec_speicher_ende()
1351 /* AK 230101 */
1352 {
1353 INT erg = OK,i;
1354
1355 for (i=0;i<=vector_speicherindex;i++)
1356 SYM_free(vector_speicher[i]);
1357 if (vector_speicher!= NULL) {
1358 COP("vec_speicher_ende:vector_speicher",vector_speicher);
1359 SYM_free(vector_speicher);
1360 }
1361 vector_speicher=NULL;
1362 vector_speicherindex=-1;
1363 vector_speichersize=0;
1364 ENDR("vec_speicher_ende");
1365 }
1366 #endif
1367
1368
b_ls_v(length,self,res)1369 INT b_ls_v(length,self,res) OP length, self,res;
1370 /* AK 280689 V1.0 */ /* AK 211289 V1.1 */ /* AK 200891 V1.3 */
1371 /* AK 011098 V2.0 */
1372 /* self will be freed */
1373 {
1374 OBJECTSELF d;
1375 INT erg = OK;
1376 COP("b_ls_v(3)",res);
1377
1378 d.ob_vector = callocvectorstruct();
1379 erg += b_ks_o(VECTOR, d,res); /* res will be freed */
1380 C_V_S(res,self);
1381 C_V_L(res,length);
1382 ENDR("b_ls_v");
1383 }
1384
1385
s_v_s(a)1386 OP s_v_s(a) OP a;
1387 /* AK 270689 V1.0 */ /* AK 211289 V1.1 */ /* AK 200891 V1.3 */
1388 /* AK 011098 V2.0 */
1389 {
1390 OBJECTSELF c;
1391 c = s_o_s(a);
1392 if (a==NULL)
1393 {
1394 error("s_v_s:object == NULL");
1395 return(NULL);
1396 }
1397 if (c.ob_vector==NULL)
1398 {
1399 error( "s_v_s:vector pointer == NULL");
1400 return(NULL);
1401 }
1402 if (not vectorp(a)) { /* AK 210192 */
1403 error("s_v_s: not VECTOR");
1404 return NULL;
1405 }
1406 return(c.ob_vector->v_self);
1407 }
1408
s_v_l(a)1409 OP s_v_l(a) OP a;
1410 /* AK 270689 V1.0 */ /* AK 201289 V1.1 */ /* AK 180691 V1.2 */
1411 /* AK 200891 V1.3 */
1412 /* AK 011098 V2.0 */
1413 {
1414 OBJECTSELF c;
1415 OP erg=NULL;
1416 c = s_o_s(a);
1417 if (a==NULL)
1418 {
1419 error("s_v_l:object == NULL");
1420 return(NULL);
1421 }
1422 if (c.ob_vector==NULL)
1423 {
1424 error( "s_v_l:vector pointer == NULL");
1425 return(NULL);
1426 }
1427 if (not vectorp(a)) { /* AK 210192 */
1428 WTO("s_v_l",a);
1429 return NULL;
1430 }
1431 erg = c.ob_vector->v_length;
1432 if (s_o_k(erg) != INTEGER)
1433 {
1434 printobjectkind(erg);
1435 error( "s_v_l:length != INTEGER");
1436 return(NULL);
1437 }
1438 if (s_i_i(erg) < (INT)0)
1439 {
1440 error( "s_v_l:length <0");
1441 return(NULL);
1442 }
1443 return erg;
1444 }
1445
1446
s_v_li(a)1447 INT s_v_li(a) OP a;
1448 /* AK 270689 V1.0 */ /* AK 201289 V1.1 */ /* AK 180691 V1.2 */
1449 /* AK 200891 V1.3 */
1450 /* AK 011098 V2.0 */
1451 {
1452 INT erg = s_i_i(s_v_l(a));
1453 return erg;
1454 }
1455
s_v_i(a,i)1456 OP s_v_i(a,i) OP a; INT i;
1457 /* AK 270689 V1.0 */ /* AK 201289 V1.1 */ /* AK 180691 V1.2 */
1458 /* AK 200891 V1.3 */
1459 /* AK 011098 V2.0 */
1460 {
1461 INT j;
1462 if (i<(INT)0)
1463 {
1464 fprintf(stderr, "index = %" PRIINT "\n" ,i);
1465 error("s_v_i:negative index");
1466 return(NULL);
1467 }
1468 if (s_o_k(a) == HASHTABLE)
1469 {
1470 if (i > (j=s_v_li(a)) )
1471 {
1472 fprintf(stderr, "index = %" PRIINT " dimension = %" PRIINT "\n" ,i,j);
1473 error("s_v_i hashtable:index too big");
1474 return(NULL);
1475 }
1476 }
1477 else if (i >= (j=s_v_li(a)) )
1478 {
1479 fprintf(stderr, "index = %" PRIINT " dimension = %" PRIINT "\n" ,i,j);
1480 error("s_v_i:index too big");
1481 return(NULL);
1482 }
1483 return(s_v_s(a) + (i));
1484 }
1485
c_v_i(a,i,b)1486 INT c_v_i(a,i,b) OP a,b; INT i;
1487 /* AK 170889 V1.1 */ /* AK 180691 V1.2 */
1488 /* AK 200891 V1.3 */
1489 /* AK 011098 V2.0 */
1490 {
1491 c_o_k(s_v_i(a,i),s_o_k(b));
1492 c_o_s(s_v_i(a,i),s_o_s(b));
1493 return(OK);
1494 }
1495
s_v_ii(a,i)1496 INT s_v_ii(a,i) OP a; INT i;
1497 /* AK 270689 V1.0 */ /* AK 201289 V1.1 */ /* AK 180691 V1.2 */
1498 /* AK 200891 V1.3 */
1499 /* AK 011098 V2.0 */
1500 {
1501 return(s_i_i(s_v_i(a,i)));
1502 }
1503
c_v_s(a,b)1504 INT c_v_s(a,b) OP a,b;
1505 /* AK 270689 V1.0 */ /* AK 201289 V1.1 */ /* AK 180691 V1.2 */
1506 /* AK 200891 V1.3 */
1507 /* AK 011098 V2.0 */
1508 {
1509 OBJECTSELF c;
1510 c = s_o_s(a);
1511 (c.ob_vector->v_self)=b;
1512 return(OK);
1513 }
1514
c_v_l(a,b)1515 INT c_v_l(a,b) OP a,b;
1516 /* AK 270689 V1.0 */ /* AK 201289 V1.1 */ /* AK 180691 V1.2 */
1517 /* AK 200891 V1.3 */
1518 /* AK 011098 V2.0 */
1519 {
1520 OBJECTSELF c;
1521 c = s_o_s(a);
1522 (c.ob_vector->v_length)=b;
1523 return(OK);
1524 }
1525
1526 #define LASTOF_V(a,b)\
1527 SYMCHECK(S_V_LI(a) == 0,"LASTOF_V:length of vector == 0");\
1528 if (S_V_LI(a)>0) COPY(S_V_I(a,S_V_LI(a)-(INT)1),b);
1529
1530
lastof_vector(a,b)1531 INT lastof_vector(a,b) OP a,b;
1532 /* AK 280689 V1.0 */ /* AK 211289 V1.1 */ /* AK 180691 V1.2 */
1533 /* AK 200891 V1.3 */ /* AK 020398 V2.0 */
1534 {
1535 INT erg = OK;
1536 CTO(VECTOR,"lastof_vector(1)",a);
1537 CTO(EMPTY,"lastof_vector(2)",b);
1538 LASTOF_V(a,b);
1539 ENDR("lastof_vector");
1540 }
1541
lastof_integervector(a,b)1542 INT lastof_integervector(a,b) OP a,b;
1543 /* AK 280689 V1.0 */ /* AK 211289 V1.1 */ /* AK 180691 V1.2 */
1544 /* AK 200891 V1.3 */ /* AK 020398 V2.0 */
1545 {
1546 INT erg = OK;
1547 CTO(INTEGERVECTOR,"lastof_integervector(1)",a);
1548 CTO(EMPTY,"lastof_integervector(2)",b);
1549 LASTOF_V(a,b);
1550 ENDR("lastof_integervector");
1551 }
1552
1553
length_vector(a,b)1554 INT length_vector(a,b) OP a,b;
1555 /* AK 280689 V1.0 */ /* AK 211289 V1.1 */ /* AK 180691 V1.2 */
1556 /* AK 200891 V1.3 */
1557 /* AK 011098 V2.0 */
1558 {
1559 return(copy(S_V_L(a),b));
1560 }
1561
1562
tex_vector(vecobj)1563 INT tex_vector(vecobj) OP vecobj;
1564 /* AK 101187 */
1565 /* mit tex werden alle elemente ausgegeben */
1566 /* AK 280689 V1.0 */ /* AK 211289 V1.1 */
1567 /* AK 070291 V1.2 prints to texout */
1568 /* AK 200891 V1.3 */
1569 /* AK 011098 V2.0 */
1570 {
1571 INT i,ot=texmath_yn;
1572
1573 if (texmath_yn==0)
1574 {
1575 fprintf(texout,"\\ $[");
1576 texmath_yn = 1;
1577 }
1578 else
1579 fprintf(texout,"\\ [");
1580
1581 for( i = (INT)0; i<S_V_LI(vecobj); i++)
1582 {
1583 texposition += (INT)6;
1584 tex(S_V_I(vecobj,i));
1585 if (i != S_V_LI(vecobj)-1)
1586 { fprintf(texout,","); texposition ++; }
1587 };
1588
1589 fprintf(texout,"]\\ ");
1590 texposition += (INT)6;
1591 if (ot == 0) {
1592 fprintf(texout,"$ ");
1593 texmath_yn = 0;
1594 }
1595 return(OK);
1596 }
1597
1598
sprint_vector(t,a)1599 INT sprint_vector(t,a) char *t; OP a;
1600 /* AK 240398 V2.0 */
1601 {
1602 INT erg = OK;
1603 INT i;
1604 if (not VECTORP(a))
1605 {
1606 WTO("sprint_vector",a);
1607 goto endr_ende;
1608 }
1609 sprintf(t,"["); t++;
1610 for (i=0;i<S_V_LI(a);i++)
1611 {
1612 if (i>0) { sprintf(t,","); t++; }
1613 erg += sprint(t,S_V_I(a,i));
1614 if (erg != OK)
1615 {
1616 WTO("sprint_vector: wrong type of vector-entry",S_V_I(a,i));
1617 goto endr_ende;
1618 }
1619 t += strlen(t);
1620 }
1621 sprintf(t,"]");
1622 ENDR("sprint_vector");
1623
1624 }
1625
sprint_integervector(t,a)1626 INT sprint_integervector(t,a) char *t; OP a;
1627 /* AK 240398 V2.0 */
1628 {
1629 INT erg = OK;
1630 INT i;
1631 CTO(INTEGERVECTOR,"sprint_integervector",a);
1632 sprintf(t,"["); t++;
1633 for (i=0;i<S_V_LI(a);i++)
1634 {
1635 if (i>0) { sprintf(t,","); t++; }
1636 sprintf(t,"%ld",S_V_II(a,i));
1637 t += intlog(S_V_I(a,i));
1638 if (S_V_II(a,i) < 0) t++;
1639 }
1640 sprintf(t,"]");
1641 ENDR("sprint_integervector");
1642 }
1643
fprint_vector(f,vecobj)1644 INT fprint_vector(f,vecobj) FILE *f; OP vecobj;
1645 /* AK 171186 */
1646 /* AK 280689 V1.0 */ /* AK 211289 V1.1 */ /* AK 200891 V1.3 */
1647 /* AK 190298 V2.0 */ /* AK 201204 V3.0 */
1648 {
1649 INT i, erg = OK;
1650 COP("fprint_vector(1)",f);
1651
1652 putc('[',f);
1653 if (f == stdout) zeilenposition++;
1654 for( i = 0; i<S_V_LI(vecobj); i++)
1655 {
1656 erg += fprint(f,S_V_I(vecobj,i));
1657 if (i != S_V_LI(vecobj)-1)
1658 {
1659 putc(',',f);
1660 if (f == stdout) {
1661 zeilenposition++;
1662 check_zeilenposition(stdout);
1663 }
1664
1665 }
1666 }
1667
1668 putc(']',f);
1669 if (f == stdout) zeilenposition++;
1670 ENDR("fprint_vector");
1671 }
1672
1673
1674
1675
objectread_bv(filename,vec)1676 INT objectread_bv(filename,vec) FILE *filename; OP vec;
1677 /* AK 220395 */
1678 /* AK 011098 V2.0 */
1679 {
1680 INT erg = OK,n;
1681 B_LS_V(callocobject(),NULL,vec);
1682 C_O_K(vec,BITVECTOR);
1683 objectread(filename,S_V_L(vec));
1684 fgetc(filename);
1685 C_V_S(vec,SYM_calloc(S_BV_LI(vec)/8+1,8) );
1686 n = fread(S_V_S(vec),(size_t)1,(size_t)S_BV_LI(vec),filename);
1687 if (n != S_BV_LI(vec))
1688 {
1689 erg += error("objectread_bv: error during read");
1690 goto endr_ende;
1691 }
1692 ENDR("objectread_bv");
1693 }
1694
objectread_vector(filename,vec)1695 INT objectread_vector(filename,vec) FILE *filename; OP vec;
1696 /* AK 131086 */ /* AK 280689 V1.0 */ /* AK 211289 V1.1 */
1697 /* AK 200891 V1.3 */ /* AK 011098 V2.0 */
1698 {
1699 INT i,erg = OK;
1700 OP length;
1701 COP("objectread_vector(1)",filename);
1702 COP("objectread_vector(2)",vec);
1703
1704 length = callocobject();
1705 erg += objectread(filename,length);
1706 erg += b_l_v(length,vec);
1707 for (i=(INT)0;i<S_I_I(length);i++)
1708 erg += objectread(filename,S_V_I(vec,i));
1709 ENDR("objectread_vector");
1710 }
objectwrite_bv(filename,vec)1711 INT objectwrite_bv(filename,vec) FILE *filename; OP vec;
1712 /* AK 220395 */
1713 /* AK 011098 V2.0 */
1714 {
1715 INT erg = OK;
1716 size_t n;
1717 COP("objectwrite_bv(1)",filename);
1718 COP("objectwrite_bv(2)",vec);
1719 fprintf(filename," %ld ",S_O_K(vec));
1720 objectwrite(filename,S_V_L(vec));
1721 n = fwrite(S_V_S(vec),(size_t)1,(size_t)S_BV_LI(vec),filename);
1722 if (n != S_BV_LI(vec))
1723 {
1724 erg += error("objectwrite_bv: error during write");
1725 goto endr_ende;
1726 }
1727 ENDR("objectwrite_bv");
1728 }
1729
1730
objectwrite_vector(filename,vec)1731 INT objectwrite_vector(filename,vec) FILE *filename; OP vec;
1732 /* AK 131086 */ /* AK 280689 V1.0 */ /* AK 211289 V1.1 */
1733 /* AK 200891 V1.3 */
1734 /* AK 011098 V2.0 */
1735 {
1736 INT i;
1737 INT erg = OK;
1738 COP("objectwrite_vector(1)",filename);
1739 COP("objectwrite_vector(2)",vec);
1740 fprintf(filename," %ld ",S_O_K(vec));
1741
1742 erg += objectwrite(filename,S_V_L(vec));
1743
1744 for (i=(INT)0;i<S_V_LI(vec);i++)
1745 erg += objectwrite(filename,S_V_I(vec,i));
1746 ENDR("objectwrite_vector");
1747 }
1748
1749
inc_vector(a)1750 INT inc_vector(a) OP a;
1751 /* AK 011098 V2.0 */
1752 /* AK 020206 V3.0 */
1753 /* increase the length by one empty object at the end */
1754 {
1755 return inc_vector_co(a,(INT) 1);
1756 }
1757
inc_vector_co(a,r)1758 INT inc_vector_co(a,r) OP a; INT r;
1759 /* AK 270887 */
1760 /* increase the length by r empty objects at the end */
1761 /* AK 280689 V1.0 */ /* AK 211289 V1.1 */ /* AK 070891 V1.3 */
1762 /* AK 011098 V2.0 */ /* AK 280705 V3.0 */
1763 {
1764 INT i,erg=OK;
1765 OP z;
1766 CTTTTO(QUEUE,HASHTABLE,VECTOR,INTEGERVECTOR,"inc_vector_co(1)",a);
1767 if (r == (INT)0) goto endr_ende;
1768 SYMCHECK((r < 0), "inc_vector_co: neg increment");
1769
1770
1771 if ((S_V_LI(a) == (INT)0)&&(r==1))
1772 {
1773 z = CALLOCOBJECT();
1774 }
1775 else if (S_V_LI(a) == (INT)0)
1776 {
1777 i = (r) * (sizeof(struct object));
1778 z = (OP ) SYM_MALLOC((unsigned) i);
1779 }
1780 else if (S_V_LI(a) == (INT)1) /* AK 310197 */
1781 {
1782 i = (r+1) * (sizeof(struct object));
1783 z = (OP ) SYM_MALLOC((unsigned) i);
1784 *z = *S_V_S(a);
1785 C_O_K(S_V_S(a),EMPTY);
1786 FREEALL(S_V_S(a)); /* vector of length, the self part was allocated
1787 using callocobject */
1788 }
1789 else {
1790 i = (S_V_LI(a) + r) * (sizeof(struct object));
1791 z = (OP ) SYM_realloc((char*) S_V_S(a),(unsigned) i);
1792 }
1793
1794 SYMCHECK(z == NULL,"inc_vector_co:self == NULL");
1795
1796 C_V_S(a,z);
1797 M_I_I(S_V_LI(a) + r, S_V_L(a));
1798 if (S_O_K(a) == INTEGERVECTOR)
1799 for (i=0;i<r;i++)
1800 M_I_I(0,S_V_I(a,S_V_LI(a)-1-i));
1801 else
1802 for (i=0;i<r;i++)
1803 C_O_K(S_V_I(a,S_V_LI(a)-1-i),EMPTY);
1804 ENDR("inc_vector_co");
1805 }
1806
sum_integervector(vecobj,res)1807 INT sum_integervector(vecobj,res) OP vecobj,res;
1808 /* AK V2.0 250298 */
1809 {
1810 INT i;
1811 INT erg = OK;
1812 CTTO(COMPOSITION,INTEGERVECTOR,"sum_integervector(1)",vecobj);
1813 CTTO(INTEGER,EMPTY,"sum_integervector(2)",res);
1814
1815 M_I_I((INT)0,res);
1816 for ( i=(INT)0; i < S_V_LI(vecobj);i++)
1817 {
1818 ADD_APPLY_INTEGER(S_V_I(vecobj,i), res);
1819 }
1820
1821 ENDR("sum_integervector");
1822 }
1823
sum_vector(vecobj,res)1824 INT sum_vector(vecobj,res) OP vecobj,res;
1825 /* AK 280689 V1.0 */ /* AK 081289 V1.1 */ /* AK 070891 V1.3 */
1826 /* AK V2.0 250298 */
1827 {
1828 INT i;
1829 INT erg = OK;
1830 CTO(EMPTY,"sum_vector(2)",res);
1831 M_I_I((INT)0,res);
1832 for ( i=(INT)0; i < S_V_LI(vecobj);i++)
1833 {
1834 ADD_APPLY( S_V_I(vecobj,i), res);
1835 }
1836 ENDR("sum_vector");
1837 }
1838
1839
1840
max_integervector(vec,m)1841 INT max_integervector(vec,m) OP vec,m;
1842 /* return copy of the maximal element */
1843 /* AK 061098 V2.0 */
1844 {
1845 INT i;
1846 INT erg = OK;
1847 INT zm;
1848 CE2(vec,m,max_integervector);
1849 zm = S_V_II(vec,(INT)0);
1850 for(i=(INT)1;i<S_V_LI(vec);i++)
1851 if (S_V_II(vec,i) > zm) zm = S_V_II(vec,i);
1852 erg += m_i_i(zm,m);
1853 ENDR("max_integervector");
1854 }
1855
1856
min_integervector(vec,m)1857 INT min_integervector(vec,m) OP vec,m;
1858 /* return copy of the minimal element */
1859 /* AK 140703 */
1860 {
1861 INT i;
1862 INT erg = OK;
1863 INT zm;
1864 CE2(vec,m,min_integervector);
1865 zm = S_V_II(vec,(INT)0);
1866 for(i=(INT)1;i<S_V_LI(vec);i++)
1867 if (S_V_II(vec,i) < zm) zm = S_V_II(vec,i);
1868 erg += m_i_i(zm,m);
1869 ENDR("min_integervector");
1870 }
1871
1872
1873
max_vector(vec,m)1874 INT max_vector(vec,m) OP vec,m;
1875 /* return copy of the maximal element */
1876 /* AK 280689 V1.0 */ /* AK 050390 V1.1 */ /* AK 100691 V1.2 */
1877 /* AK 070891 V1.3 */
1878 /* AK 011098 V2.0 */
1879 {
1880 INT i;
1881 INT erg = OK;
1882 OP zm;
1883 CTO(VECTOR,"max_vector(1)",vec);
1884 CE2(vec,m,max_vector);
1885 zm = S_V_I(vec,(INT)0);
1886 for(i=(INT)1;i<S_V_LI(vec);i++)
1887 if (GR(S_V_I(vec,i),zm)) zm = S_V_I(vec,i);
1888 erg += copy(zm,m);
1889 ENDR("max_vector");
1890 }
1891
1892
min_vector(vec,m)1893 INT min_vector(vec,m) OP vec,m;
1894 /* return copy of the minimal element */
1895 /* AK 140703 */
1896 {
1897 INT i;
1898 INT erg = OK;
1899 OP zm;
1900 CTO(VECTOR,"min_vector(1)",vec);
1901 CE2(vec,m,min_vector);
1902 zm = S_V_I(vec,(INT)0);
1903 for(i=(INT)1;i<S_V_LI(vec);i++)
1904 if (LT(S_V_I(vec,i),zm)) zm = S_V_I(vec,i);
1905 CLEVER_COPY(zm,m);
1906 ENDR("min_vector");
1907 }
1908
1909
1910
findmax_vector(vec)1911 OP findmax_vector(vec) OP vec;
1912 /* AK 100102 */
1913 {
1914 INT erg = OK;
1915 CTO(VECTOR,"findmax_vector(1)",vec);
1916 {
1917 OP res; INT i;
1918 if (S_V_LI(vec) == 0) return NULL;
1919 res = S_V_S(vec);
1920 for (i=1; i<S_V_LI(vec);i++)
1921 if (GR(S_V_I(vec,i),res) ) res = S_V_I(vec,i);
1922 return res;
1923 }
1924 ENDO("findmax_vector");
1925 }
1926
mult_apply_scalar_vector(a,b)1927 INT mult_apply_scalar_vector(a,b) OP a,b;
1928 /* AK 060498 V2.0 */
1929 {
1930 INT erg = OK;
1931 INT i;
1932 CTO(VECTOR,"mult_apply_scalar_vector(2)",b);
1933 for (i=(INT)0; i<S_V_LI(b); i++)
1934 MULT_APPLY(a, S_V_I(b,i));
1935 ENDR("mult_apply_scalar_vector");
1936 }
1937
mult_apply_integer_integervector(a,b)1938 INT mult_apply_integer_integervector(a,b) OP a,b;
1939 /* AK 090703 V2.0 */
1940 {
1941 INT erg = OK;
1942 INT i;
1943 CTO(INTEGERVECTOR,"mult_apply_integer_integervector(2)",b);
1944 CTO(INTEGER,"mult_apply_integer_integervector(1)",a);
1945 for (i=(INT)0; i<S_V_LI(b); i++)
1946 {
1947 MULT_APPLY_INTEGER_INTEGER(a, S_V_I(b,i));
1948 if (S_O_K(S_V_I(b,i)) != INTEGER)
1949 C_O_K(b,VECTOR);
1950 }
1951 ENDR("mult_apply_integer_integervector");
1952 }
1953
1954
mult_scalar_vector(a,b,c)1955 INT mult_scalar_vector(a,b,c) OP a,b,c;
1956 /* AK 010888 skalarmultiplikation */
1957 /* a ist skalar b ist vector c wird vector */
1958 /* AK 280689 V1.0 */ /* AK 211289 V1.1 */ /* AK 070891 V1.3 */
1959 /* AK 011098 V2.0 */
1960 {
1961 INT i = (INT)0;
1962 INT erg = OK;
1963 CTO(VECTOR,"mult_scalar_vector(2)",b);
1964 CTO(EMPTY,"mult_scalar_vector(3)",c);
1965 erg += m_il_v(S_V_LI(b),c);
1966 C_O_K(c,S_O_K(b));
1967 for (i=(INT)0; i<S_V_LI(c); i++)
1968 erg += mult(a, S_V_I(b,i), S_V_I(c,i));
1969 ENDR("mult_scalar_vector");
1970 }
1971
1972 #ifdef MATRIXTRUE
mult_vector_matrix(a,b,c)1973 INT mult_vector_matrix(a,b,c) OP a, b, c;
1974 /* AK 200192 */
1975 /* AK 011098 V2.0 */
1976 {
1977 INT i,j;
1978 INT erg = OK;
1979 OP d;
1980 CTO(VECTOR,"mult_vector_matrix(1)",a);
1981 CTO(MATRIX,"mult_vector_matrix(2)",b);
1982 CTO(EMPTY,"mult_vector_matrix(3)",c);
1983 SYMCHECK(S_V_LI(a)!=S_M_HI(b),"mult_vector_matrix:length of vector != height of matrix");
1984
1985 erg += m_il_v(S_M_LI(b),c);
1986 d = CALLOCOBJECT();
1987 for (i=0;i<S_V_LI(c);i++)
1988 {
1989 for (j=0;j<S_V_LI(a);j++)
1990 {
1991 FREESELF(d);
1992 MULT(S_V_I(a,j),S_M_IJ(b,j,i),d);
1993 if (j==0)
1994 SWAP(d,S_V_I(c,i));
1995 else
1996 ADD_APPLY(d,S_V_I(c,i));
1997 }
1998 }
1999 FREEALL(d);
2000 ENDR("mult_vector_matrix");
2001 }
2002 #endif /* MATRIXTRUE */
2003
mult_vector_vector(a,b,c)2004 INT mult_vector_vector(a,b,c) OP a, b, c;
2005 /* AK 110588 componentenweise multiplication */
2006 /* AK 280689 V1.0 */ /* AK 211289 V1.1 */ /* AK 070891 V1.3 */
2007 /* AK 011098 V2.0 */
2008 {
2009 INT i = 0, erg = OK;
2010 CTO(VECTOR,"mult_vector_vector(1)",a);
2011 CTO(VECTOR,"mult_vector_vector(2)",b);
2012 CTO(EMPTY,"mult_vector_vector(3)",c);
2013 SYMCHECK( (S_V_LI(a) != S_V_LI(b)), "mult_vector_vector:different size of vectors");
2014
2015
2016 erg += m_il_v(S_V_LI(a),c);
2017 for (i=(INT)0;i<S_V_LI(b);i++)
2018 MULT(S_V_I(a,i),S_V_I(b,i),S_V_I(c,i));
2019
2020 ENDR("mult_vector_vector");
2021 }
2022
scalarproduct_vector(a,b,d)2023 INT scalarproduct_vector(a,b,d) OP a,b,d;
2024 /* AK 141189 V1.1 */ /* AK 070891 V1.3 */ /* AK 011098 V2.0 */
2025 /* AK 230904 V3.0 */
2026 {
2027 INT erg = OK; /* AK 200192 */
2028 CTO(VECTOR,"scalarproduct_vector(1)",a);
2029 CTO(VECTOR,"scalarproduct_vector(2)",b);
2030 CTO(EMPTY,"scalarproduct_vector(3)",d);
2031 SYMCHECK( (S_V_LI(a) != S_V_LI(b)), "scalarproduct_vector:different length");
2032
2033 {
2034 OP c,za=S_V_S(a),zb=S_V_S(b);
2035 INT i;
2036 c = CALLOCOBJECT();
2037 null(za,d);
2038 for (i=S_V_LI(a)-1;i>=0;i--,za++,zb++)
2039 {
2040 if ( (not NULLP(za)) && (not NULLP(zb))) { /* AK 230904 */
2041 CLEVER_MULT(za,zb,c);
2042 ADD_APPLY(c,d);
2043 }
2044 }
2045 FREEALL(c);
2046 }
2047
2048 CTO(ANYTYPE,"scalarproduct_vector(e)",d);
2049 ENDR("scalarproduct_vector");
2050 }
2051
dec_vector(a)2052 INT dec_vector(a) OP a;
2053 /* AK 120187 kuerzt den vector um 1 */
2054 /* das letzte element wird gestrichen */
2055 /* AK 280689 V1.0 */ /* AK 211289 V1.1 */ /* AK 070891 V1.3 */
2056 /* AK 011098 V2.0 */
2057 {
2058 INT erg = OK; /* AK 100893 */
2059 OP zz;
2060 CTO(VECTOR,"dec_vector(1)",a);
2061
2062 SYMCHECK(S_V_LI(a) == 0, "dec_vector:initial length == 0");
2063
2064 FREESELF(S_V_I(a,S_V_LI(a)-1));
2065 /* freigeben des speicherplatzes des letzten vectorelements */
2066 DEC_INTEGER(S_V_L(a));
2067 /* verkuerzen der laenge um eins */
2068 if (S_V_LI(a) == (INT)1) /* AK 111093 */
2069 {
2070 zz = S_V_S(a);
2071 C_V_S(a,CALLOCOBJECT());
2072 *(S_V_S(a)) = *zz;
2073 SYM_free(zz);
2074 }
2075 else if (S_V_LI(a) == (INT)0) /* AK 100893 */
2076 {
2077 FREEALL(S_V_S(a));
2078 C_V_S(a,NULL);
2079 }
2080
2081 ENDR("dec_vector");
2082 }
2083
dec_integervector(a)2084 INT dec_integervector(a) OP a;
2085 /* AK 230402 */
2086 /* AK 230904 V3.0 */
2087 {
2088 INT erg = OK; /* AK 100893 */
2089 CTO(INTEGERVECTOR,"dec_integervector(1)",a);
2090 SYMCHECK(S_V_LI(a) == 0, "dec_integervector:initial length == 0");
2091 {
2092 OP zz;
2093
2094 DEC_INTEGER(S_V_L(a));
2095 /* verkuerzen der laenge um eins */
2096 if (S_V_LI(a) == (INT)1) /* AK 111093 */
2097 {
2098 zz = S_V_S(a);
2099 C_V_S(a,CALLOCOBJECT());
2100 *(S_V_S(a)) = *zz;
2101 SYM_free(zz);
2102 }
2103 else if (S_V_LI(a) == (INT)0) /* AK 100893 */
2104 {
2105 FREEALL(S_V_S(a));
2106 C_V_S(a,NULL);
2107 }
2108 }
2109 ENDR("dec_integervector");
2110 }
2111
reverse_vector(a,b)2112 INT reverse_vector(a,b) OP a, b;
2113 /* AK 160802 */
2114 /* AK 230904 V3.0 */
2115 {
2116 INT erg = OK;
2117 CTTTO(WORD,INTEGERVECTOR,VECTOR,"reverse_vector(1)",a);
2118 CE2(a,b,reverse_vector);
2119 {
2120 INT i,j;
2121 erg += m_il_v(S_V_LI(a),b);
2122 C_O_K(b,S_O_K(a));
2123 for (i=0,j=S_V_LI(b)-1;i<S_V_LI(b);i++,j--)
2124 COPY(S_V_I(a,i),S_V_I(b,j));
2125 }
2126 ENDR("reverse_vector");
2127 }
2128
append_vector(a,b,c)2129 INT append_vector(a,b,c) OP a, b, c;
2130 /* haengt den vector b an den vector a an */
2131 /* c = [a1,..,ak,b1,...,bl] */
2132 /* AK 280689 V1.0 */ /* AK 211289 V1.1 */ /* AK 070891 V1.3 */
2133 /* AK 011098 V2.0 */
2134 {
2135 INT i,length;
2136 INT erg = OK;
2137 CTTTTO(QUEUE,WORD,INTEGERVECTOR,VECTOR,"append_vector(1)",a);
2138 if (a == c) /* a = [a1,..,ak,b1,..,bl] */
2139 {
2140 erg += append_apply_vector(a,b);
2141 goto endr_ende;
2142 }
2143 if (b == c) /* b = [a1,...,ak,b1,....,bl] */
2144 {
2145 OP d;
2146 d = callocobject();
2147 erg += append_vector(a,b,d);
2148 erg += swap(b,d);
2149 FREEALL(d);
2150 goto endr_ende;
2151 }
2152
2153 if (not VECTORP(b)) /* AK 291292 */
2154 {
2155 /* c = [a1,...,ak,b] */
2156 erg += m_il_v(S_V_LI(a)+1,c);
2157 C_O_K(c,S_O_K(a));
2158 for( i=(INT)0;i<S_V_LI(a);i++)
2159 COPY(S_V_I(a,i),S_V_I(c,i));
2160 COPY(b,S_V_I(c,S_V_LI(a)));
2161 goto endr_ende;
2162 }
2163 length=S_V_LI(a)+S_V_LI(b);
2164 erg += m_il_v(length,c);
2165 if (S_O_K(a) == S_O_K(b)) /* AK 030295 */
2166 C_O_K(c,S_O_K(a));
2167 else
2168 C_O_K(c,VECTOR);
2169 for( i=(INT)0;i<length; i++)
2170 if (i < S_V_LI(a))
2171 erg += copy(S_V_I(a,i),S_V_I(c,i));
2172 else
2173 erg += copy(S_V_I(b,i-S_V_LI(a)),S_V_I(c,i));
2174 ENDR("append_vector");
2175 }
2176
append_apply_vector(a,b)2177 INT append_apply_vector(a,b) OP a,b;
2178 /* AK 060901 */
2179 /* a is of vector type */
2180 /* a = [a1,...,ak,b1,...,bl */
2181 /* a and b may be equal */
2182 {
2183 INT erg = OK,i,j;
2184 CTTTO(QUEUE,VECTOR,INTEGERVECTOR,"append_apply_vector(1)",a);
2185 if (a == b)
2186 {
2187 i = S_V_LI(a);
2188 erg += inc_vector_co(a,i);
2189 for (j=0;i<S_V_LI(a);i++,j++)
2190 {
2191 COPY(S_V_I(b,j),S_V_I(a,i));
2192 }
2193 }
2194 else if (not VECTORP(b))
2195 {
2196 erg += inc_vector(a);
2197 COPY(b,S_V_I(a,S_V_LI(a)-1));
2198 }
2199 else {
2200 j = S_V_LI(b);
2201 i = S_V_LI(a);
2202 erg += inc_vector_co(a,j);
2203 for (j=0;j<S_V_LI(b);j++)
2204 {
2205 COPY(S_V_I(b,j),S_V_I(a,i+j));
2206 }
2207 }
2208 ENDR("append_apply_vector");
2209 }
2210
mult_apply_vector(a,b)2211 INT mult_apply_vector(a,b) OP a, b;
2212 /* AK 070891 V1.3 */
2213 /* AK 011098 V2.0 */
2214 {
2215 INT erg = OK;
2216 switch (S_O_K(b)) {
2217 case VECTOR:
2218 erg += mult_apply_vector_vector(a,b); break;
2219 default:
2220 erg = error("mult_apply_vector: wrong type"); break;
2221 }
2222 return erg;
2223 }
2224
mult_apply_vector_vector(a,b)2225 INT mult_apply_vector_vector(a,b) OP a, b;
2226 /* AK 110588 componentenweise multiplication */
2227 /* AK 280689 V1.0 */ /* AK 211289 V1.1 */ /* AK 070891 V1.3 */
2228 /* AK 011098 V2.0 */
2229 {
2230 INT i = (INT)0;
2231 INT erg = OK;
2232 CTO(VECTOR,"mult_apply_vector_vector(1)",a);
2233 CTO(VECTOR,"mult_apply_vector_vector(2)",b);
2234 SYMCHECK(S_V_LI(a) != S_V_LI(b),"mult_apply_vector_vector:different size of vectors ");
2235
2236 for (i=(INT)0;i<S_V_LI(b);i++)
2237 MULT_APPLY(S_V_I(a,i),S_V_I(b,i));
2238
2239 ENDR("mult_apply_vector_vector");
2240 }
2241
weight_vector(a,b)2242 INT weight_vector(a,b) OP a,b;
2243 /* number of nonzero entries */
2244 /* a and b may be equal */
2245 /* AK 131206 V3.1 */
2246 {
2247 INT erg = OK;
2248 INT i,j=0;
2249 OP z;
2250 for (i=0,z=S_V_S(a);i<S_V_LI(a);i++,z++)
2251 if (NULLP(z)!=TRUE) j++;
2252 erg += m_i_i(j,b);
2253 ENDR("weight_vector");
2254 }
2255
nullp_integervector(a)2256 INT nullp_integervector(a) OP a;
2257 /* AK 311091 */
2258 /* AK 190298 V2.0 */
2259 /* AK 131206 V3.1 */
2260 {
2261 INT i;
2262 INT erg = OK;
2263 CTO(INTEGERVECTOR,"nullp_integervector(1)",a);
2264 for (i=(INT)0;i<S_V_LI(a); i++)
2265 {
2266 if (not INTEGERP(S_V_I(a,i)))
2267 {
2268 C_O_K(a, VECTOR);
2269 if (not nullp(S_V_I(a,i)))
2270 return FALSE;
2271 }
2272 else {
2273 if (S_V_II(a,i) != (INT)0) return FALSE;
2274 }
2275 }
2276 return TRUE;
2277
2278 ENDR("nullp_integervector");
2279 }
2280
nullp_vector(a)2281 INT nullp_vector(a) OP a;
2282 /* AK 311091 */
2283 /* AK 011098 V2.0 */
2284 /* AK 131206 V3.1 */
2285 {
2286 INT i;
2287 for (i=(INT)0;i<S_V_LI(a); i++)
2288 if (not nullp(S_V_I(a,i)))
2289 return FALSE;
2290 return TRUE;
2291 }
2292
posp_vector(a)2293 INT posp_vector(a) OP a;
2294 /* AK 190298 V2.0 */
2295 {
2296 INT erg = OK;
2297 INT i;
2298 CTO(VECTOR,"posp_vector(1)",a);
2299 for (i=(INT)0;i<S_V_LI(a); i++)
2300 if (not posp(S_V_I(a,i))) return FALSE;
2301 return TRUE;
2302
2303 ENDR("posp_vector");
2304 }
2305
index_vector(a,b)2306 INT index_vector(a,b) OP a,b;
2307 /* AK 010393 */ /* AK 011098 V2.0 */
2308 /* get index of a in b */
2309 /* AK 291104 V3.0 */
2310 {
2311 INT erg = OK;
2312 CTO(VECTOR,"index_vector(2)",b);
2313 {
2314 INT i;
2315 for (i=0;i<S_V_LI(b);i++)
2316 if (EQ(S_V_I(b,i),a)) return i;
2317 return -1;
2318 }
2319 ENDR("index_vector");
2320 }
2321
index_vector_binary_co(a,b,left,right)2322 static INT index_vector_binary_co(a,b,left,right) OP a,b;INT left,right;
2323 /* AK 211100 */
2324 {
2325 INT erg=OK,mitte,res;
2326 if (left > right) return -1;
2327 mitte = (left+right)/2;
2328 res = COMP(a,S_V_I(b,mitte));
2329 if (res == 0) return mitte;
2330 if (res < 0)
2331 return index_vector_binary_co(a,b,left,mitte-1);
2332 else
2333 return index_vector_binary_co(a,b,mitte+1,right);
2334 ENDR("local:index_vector_binary_co");
2335 }
2336
index_vector_binary(a,b)2337 INT index_vector_binary(a,b) OP a,b;
2338 /* AK 211100 */
2339 /* assumes sorted according to comp */
2340 {
2341 return index_vector_binary_co(a,b,0,S_V_LI(b)-1);
2342 }
2343
insert_entry_vector(a,index,b)2344 INT insert_entry_vector(a,index,b) OP a,b; INT index;
2345 /* AK 280607 */
2346 /* new empty object add position index */
2347 {
2348 INT erg = OK;
2349 SYMCHECK(not VECTORP(a),"insert_entry_vector(1): not VECTORP");
2350 {
2351 INT i,j;
2352 if (a == b)
2353 {
2354 OP c;
2355 c = CALLOCOBJECT();
2356 *c = *b;
2357 C_O_K(b,EMPTY);
2358 erg += insert_entry_vector(c,index,b);
2359 FREEALL(c);
2360 goto endr_ende;
2361 }
2362 if (index<0) erg += copy(a,b);
2363 else if (index>=S_V_LI(a)) erg += copy(a,b);
2364 else {
2365 erg += m_il_v(S_V_LI(a)+1,b);
2366 C_O_K(b,S_O_K(a));
2367 for (i=0;i<index;i++)
2368 {
2369 COPY(S_V_I(a,i),S_V_I(b,i));
2370 }
2371 for (i=index;i<S_V_LI(a);i++)
2372 {
2373 COPY(S_V_I(a,i),S_V_I(b,i+1));
2374 }
2375 }
2376 }
2377 ENDR("insert_entry_vector");
2378 }
2379
delete_entry_vector(a,index,b)2380 INT delete_entry_vector(a,index,b) OP a,b; INT index;
2381 /* AK 220296 */
2382 /* AK 011098 V2.0 */
2383 /* in the case of an index outside the vector,
2384 no deletion , otherwise the vector shrinks */
2385 /* AK 210804 V3.0 */
2386 {
2387 INT erg = OK;
2388 SYMCHECK(not VECTORP(a),"delete_entry_vector(1): not VECTORP");
2389 {
2390 INT i,j;
2391 if (a == b)
2392 {
2393 /* old:211107
2394 OP c;
2395 c = CALLOCOBJECT();
2396 *c = *b;
2397 C_O_K(b,EMPTY);
2398 erg += delete_entry_vector(c,index,b);
2399 FREEALL(c);
2400 */
2401 if (index < 0) goto endr_ende;
2402 if (index >= S_V_LI(a)) goto endr_ende;
2403 FREESELF(S_V_I(a,index));
2404 DEC_INTEGER(S_V_L(a));
2405 if (index == S_V_LI(a)) goto endr_ende;
2406
2407 for (i=index;i<S_V_LI(a);i++)
2408 SWAP(S_V_I(a,i),S_V_I(a,i+1));
2409 goto endr_ende;
2410 }
2411 erg += m_il_v(S_V_LI(a)-1,b);
2412 C_O_K(b,S_O_K(a));
2413 for (i=0,j=0;i<S_V_LI(b);i++)
2414 {
2415 if (j == index) j++;
2416 COPY(S_V_I(a,j),S_V_I(b,i));
2417 j++;
2418 }
2419 }
2420 ENDR("delete_entry_vector");
2421 }
2422
find_vector(a,b)2423 OP find_vector(a,b) OP a,b;
2424 /* AK 010393 */
2425 /* AK 011098 V2.0 */
2426 /* null if a not in b */
2427 {
2428 INT i = index_vector(a,b);
2429 if (i == (INT)-1)
2430 return NULL;
2431 else
2432 return S_V_I(b,i);
2433 }
2434
2435
t_INTVECTOR_UCHAR(a,b)2436 INT t_INTVECTOR_UCHAR(a,b) OP a; char **b;
2437 /* AK 011098 V2.0 */
2438 {
2439 INT i;
2440 INT erg = OK;
2441 CTO(INTEGERVECTOR,"t_INTVECTOR_UCHAR(1)",a);
2442 *b = SYM_MALLOC((int) S_V_LI(a)+1);
2443 SYMCHECK( (*b) == NULL,"t_INTVECTOR_UCHAR:no memory");
2444
2445 (*b)[0]=(unsigned char) S_V_LI(a);
2446 for (i=(INT)1;i<=S_V_LI(a);i++)
2447 (*b)[i] = (unsigned char) S_V_II(a,i-(INT)1);
2448 ENDR("t_INTVECTOR_UCHAR");
2449 }
t_UCHAR_INTVECTOR(a,b)2450 INT t_UCHAR_INTVECTOR(a,b) OP b; char *a;
2451 /* AK 011098 V2.0 */
2452 {
2453 INT erg = OK;
2454 INT i;
2455 COP("t_UCHAR_INTVECTOR(1)",a);
2456 COP("t_UCHAR_INTVECTOR(2)",b);
2457
2458 erg += m_il_v((INT)a[0],b);
2459 for (i=(INT)0;i<S_V_LI(b);i++)
2460 M_I_I(a[i+1], S_V_I(b,i));
2461 ENDR("t_UCHAR_INTVECTOR");
2462 }
2463
comp_numeric_vector(a,b)2464 INT comp_numeric_vector(a,b) OP a,b;
2465 /* AK 020893 */
2466 /* AK 011098 V2.0 */
2467 {
2468 INT i,m,erg=OK;
2469 OP c;
2470 if (not VECTORP(a) || not VECTORP(b))
2471 {
2472 WTT("comp_numeric_vector",a,b);
2473 goto endr_ende;
2474 }
2475 if (S_V_LI(a) > S_V_LI(b)) /* error wrong: < corrected AK 130199 */
2476 { c = a; a = b; b = c; m = (INT)-1; }
2477 else
2478 m = (INT)1;
2479
2480 /* the vector a is the shorter one */
2481
2482 for (i=(INT)0;i<S_V_LI(a);i++)
2483 if (S_O_K(S_V_I(a,i)) != INTEGER)
2484 return error("comp_numeric_vector:no INTEGER entry");
2485 else if (S_O_K(S_V_I(b,i)) != INTEGER)
2486 return error("comp_numeric_vector:no INTEGER entry");
2487 else if (S_V_II(a,i) < S_V_II(b,i))
2488 return m * (INT)-1;
2489 else if (S_V_II(a,i) > S_V_II(b,i))
2490 return m ;
2491 for (;i<S_V_LI(b);i++)
2492 if (S_O_K(S_V_I(b,i)) != INTEGER)
2493 return error("comp_numeric_vector:no INTEGER entry");
2494 else if (S_V_II(b,i) < (INT)0)
2495 return m ;
2496 else if (S_V_II(b,i) > (INT)0)
2497 return m * (INT)-1;
2498 return (INT)0;
2499 ENDR("comp_numeric_vector");
2500 }
2501
add_apply_integervector(a,b)2502 INT add_apply_integervector(a,b) OP a, b;
2503 /* b = b+a */
2504 /* AK 211289 V1.1 */ /* AK 200891 V1.3 */
2505 /* AK 011098 V2.0 */
2506 {
2507 INT i,erg = OK;
2508 CTO(INTEGERVECTOR,"add_apply_integervector(1)",a);
2509 CTTO(INTEGERVECTOR,VECTOR,"add_apply_integervector(2)",b);
2510
2511 if (S_V_LI(a) > S_V_LI(b))
2512 {
2513 i = S_V_LI(b);
2514 inc_vector_co(b,S_V_LI(a) - S_V_LI(b));
2515 for (; i<S_V_LI(a); i++)
2516 M_I_I((INT)0,S_V_I(b,i));
2517 }
2518 if (S_O_K(b) == INTEGERVECTOR)
2519 {
2520 for (i=(INT)0;i<S_V_LI(b);i++)
2521 if (i < S_V_LI(a))
2522 {
2523 erg += add_apply_integer_integer(S_V_I(a,i),S_V_I(b,i));
2524 if (not INTEGERP(S_V_I(b,i))) /* AK 310195 */
2525 C_O_K(b,VECTOR);
2526 }
2527 else
2528 break;
2529 }
2530 else
2531 {
2532 for (i=(INT)0;i<S_V_LI(b);i++)
2533 if (i < S_V_LI(a))
2534 {
2535 if (INTEGERP(S_V_I(a,i)) && INTEGERP(S_V_I(b,i)))
2536 {
2537 erg += add_apply_integer_integer(S_V_I(a,i),S_V_I(b,i));
2538 if (not INTEGERP(S_V_I(b,i))) /* AK 310195 */
2539 C_O_K(b,VECTOR);
2540 }
2541 else if (INTEGERP(S_V_I(a,i))) {
2542 erg += add_apply(S_V_I(a,i),S_V_I(b,i));
2543 C_O_K(b,VECTOR);
2544 }
2545 else {
2546 erg += add_apply(S_V_I(a,i),S_V_I(b,i));
2547 C_O_K(a,VECTOR);
2548 if (not INTEGERP(S_V_I(b,i))) /* AK 310195 */
2549 C_O_K(b,VECTOR);
2550 }
2551 }
2552 else break;
2553 }
2554 ENDR("add_apply_integervector");
2555 }
2556
copy_bitvector(vec,res)2557 INT copy_bitvector(vec,res) OP vec, res;
2558 /* AK 180396 */
2559 /* AK 011098 V2.0 */
2560 {
2561 INT erg = OK;
2562 CTO(BITVECTOR,"copy_bitvector(1)",vec);
2563 CTO(EMPTY,"copy_bitvector(2)",res);
2564
2565 erg += m_il_bv( S_V_LI(vec), res); /* length in bit */
2566 memcpy(S_V_S(res),S_V_S(vec), S_BV_LI(vec)); /* length in byte */
2567 C_O_K(res,S_O_K(vec));
2568
2569 ENDR("copy_bitvector");
2570 }
2571
reverse_bitvector(vec,res)2572 INT reverse_bitvector(vec,res) OP vec,res;
2573 /* AK 090703 */
2574 {
2575 INT erg = OK,i,j;
2576 CTO(BITVECTOR,"reverse_bitvector(1)",vec);
2577 CE2(vec,res,reverse_bitvector);
2578
2579 erg += m_il_bv( S_V_LI(vec), res); /* length in bit */
2580 C_O_K(res,S_O_K(vec));
2581 for (i=S_V_LI(vec)-1,j=0;i>=0;i--,j++)
2582 if (GET_BV_I(vec,i)==1)
2583 SET_BV_I(res,j);
2584 else
2585 UNSET_BV_I(res,j);
2586
2587 ENDR("reverse_bitvector");
2588 }
2589
einsp_bitvector(vec)2590 INT einsp_bitvector(vec) OP vec;
2591 /* AK 200606
2592 all one vector ?
2593 */
2594 {
2595 INT erg = OK,i;
2596 CTO(BITVECTOR,"einsp_bitvector(1)",vec);
2597 for (i=S_V_LI(vec)-1;i>=0;i--)
2598 if (GET_BV_I(vec,i)==0) return FALSE;
2599 return TRUE;
2600 ENDR("einsp_bitvector");
2601 }
2602
2603
invers_bitvector(vec,res)2604 INT invers_bitvector(vec,res) OP vec,res;
2605 /* AK 090703 */
2606 /* the complement */
2607 {
2608 INT erg = OK,i;
2609 CTO(BITVECTOR,"invers_bitvector(1)",vec);
2610 CE2(vec,res,invers_bitvector);
2611
2612 erg += m_il_bv( S_V_LI(vec), res); /* length in bit */
2613 C_O_K(res,S_O_K(vec));
2614 for (i=S_V_LI(vec)-1;i>=0;i--)
2615 if (GET_BV_I(vec,i)==1)
2616 UNSET_BV_I(res,i);
2617 else
2618 SET_BV_I(res,i);
2619 ENDR("invers_bitvector");
2620 }
2621
2622
2623
inc_bitvector(v)2624 INT inc_bitvector(v) OP v;
2625 /* AK 020698 V2.0 */
2626 {
2627 INT erg = OK;
2628 CTO(BITVECTOR,"inc_bitvector(1)",v);
2629 if ((S_V_LI(v) % 8) == 0)
2630 {
2631 C_V_S(v, SYM_realloc(S_V_S(v), S_V_LI(v)/8 + 1));
2632 }
2633 INC_INTEGER(S_V_L(v));
2634 ENDR("inc_bitvector");
2635 }
2636
copy_integervector(vec,res)2637 INT copy_integervector(vec,res) OP vec, res;
2638 /* AK 021286 */ /* AK 280689 V1.0 */ /* AK 081289 V1.1 */
2639 /* AK 120391 V1.2 */ /* AK 200891 V1.3 */
2640 /* AK 011098 V2.0 */
2641 {
2642 INT erg = OK;
2643 CTO(INTEGERVECTOR,"copy_integervector(1)",vec);
2644 CTO(EMPTY,"copy_integervector(2)",res);
2645
2646 erg += m_il_v( S_V_LI(vec), res);
2647 memcpy(S_V_S(res),S_V_S(vec), S_V_LI(vec) * sizeof(struct object));
2648 C_O_K(res,S_O_K(vec));
2649
2650 ENDR("copy_integervector");
2651 }
2652
copy_galois(vec,res)2653 INT copy_galois(vec,res) OP vec, res;
2654 /* AK 211106 V3.1 */
2655 {
2656 INT erg = OK;
2657 CTO(GALOISRING,"copy_galois(1)",vec);
2658 CTO(EMPTY,"copy_galois(2)",res);
2659
2660 erg += m_il_v( S_V_LI(vec), res);
2661 memcpy(S_V_S(res),S_V_S(vec), S_V_LI(vec) * sizeof(struct object));
2662 C_O_K(res,S_O_K(vec));
2663
2664 ENDR("copy_integervector");
2665 }
2666
2667
copy_composition(vec,res)2668 INT copy_composition(vec,res) OP vec, res;
2669 /* AK 070102 */
2670 /* identic to copy_integervector */
2671 {
2672 INT erg = OK;
2673 CTO(COMPOSITION,"copy_composition(1)",vec);
2674 CTO(EMPTY,"copy_composition(2)",res);
2675
2676 erg += m_il_v( S_V_LI(vec), res);
2677 memcpy(S_V_S(res),S_V_S(vec), S_V_LI(vec) * sizeof(struct object));
2678 C_O_K(res,S_O_K(vec));
2679
2680 ENDR("copy_composition");
2681 }
2682
2683
2684
comp_colex_vector(a,b)2685 INT comp_colex_vector(a,b) OP a,b;
2686 /* a,b vectors colex order */
2687 /* AK V1.1 151189 */ /* AK 200891 V1.3 */
2688 /* AK 011098 V2.0 */
2689 {
2690 INT i = S_V_LI(a)-1;
2691 INT j = S_V_LI(b)-1;
2692 INT erg;
2693
2694 if (not VECTORP(a))
2695 error("comp_colex_vector:kind != VECTOR");
2696 if (not VECTORP(b))
2697 error("comp_colex_vector:kind != VECTOR");
2698
2699
2700 for (;(i >= (INT)0) || (j>=(INT)0); i--,j--)
2701 {
2702 if (i<(INT)0) return((INT)1);
2703 if (j<(INT)0) return((INT)-1);
2704 erg = comp(S_V_I(a,i),S_V_I(b,j));
2705 if (erg <(INT)0) return((INT)1);
2706 if (erg >(INT)0) return((INT)-1);
2707 }
2708 return((INT)0);
2709 }
2710
2711
2712
2713
2714 /* laenge in byte */
unset_bv_i(a,i)2715 INT unset_bv_i(a,i) OP a; INT i;
2716 /* ite bit auf 0 setzen */
2717 /* AK 011098 V2.0 */
2718 {
2719 INT erg = OK;
2720 CTO(BITVECTOR,"unset_bv_i",a);
2721 if (S_V_LI(a) < i)
2722 return error("unset_bv_i: index to big");
2723 if (i< 0)
2724 return error("unset_bv_i: index negativ");
2725 *((unsigned char *)S_V_S(a) + (i/8)) &= (~(1 << (i%8)));
2726
2727 ENDR("unset_bv_i");
2728 }
set_bv_i(a,i)2729 INT set_bv_i(a,i) OP a; INT i;
2730 /* ite bit setzen */
2731 /* AK 011098 V2.0 */
2732 {
2733 INT erg = OK;
2734 CTO(BITVECTOR,"set_bv_i",a);
2735 if (S_V_LI(a) < i)
2736 return error("set_bv_i: index to big");
2737 if (i< 0)
2738 return error("set_bv_i: index negativ");
2739 *((unsigned char *)S_V_S(a) + (i/8)) |= (1 << (i%8));
2740
2741 ENDR("set_bv_i");
2742 }
get_bv_i(a,i)2743 INT get_bv_i(a,i) OP a; INT i;
2744 /* AK 011098 V2.0 */
2745 {
2746 INT erg = OK;
2747 CTO(BITVECTOR,"set_bv_i",a);
2748 if (S_V_LI(a) < i)
2749 return error("set_bv_i: index to big");
2750 if (i< 0)
2751 return error("set_bv_i: index negativ");
2752 return (*(((unsigned char *)S_V_S(a) ) + i/8) >> (i%8))%2;
2753 ENDR("get_bv_i");
2754
2755 }
2756
2757
fprint_bitvector(fp,a)2758 INT fprint_bitvector(fp,a) OP a; FILE *fp;
2759 /* AK 011098 V2.0 */
2760 {
2761 INT i,erg = OK;
2762 CTO(BITVECTOR,"fprint_bitvector",a);
2763 for (i=0;i<S_V_LI(a);i++)
2764 {
2765 fprintf(fp,"%d",GET_BV_I(a,i));
2766 if (fp == stdout)
2767 {
2768 zeilenposition ++;
2769 if (zeilenposition > 70)
2770 {
2771 printf("\n");
2772 zeilenposition = 0;
2773 }
2774 }
2775 }
2776 ENDR("fprint_bitvector");
2777 }
2778
2779
t_INTVECTOR_BITVECTOR(a,b)2780 INT t_INTVECTOR_BITVECTOR(a,b) OP a,b;
2781 /* AK 011098 V2.0 */
2782 /* a and b may be equal */
2783 {
2784 INT erg = OK;
2785 INT i,l;
2786 if (not VECTORP(a))
2787 {
2788 WTO("t_INTVECTOR_BITVECTOR",a);
2789 goto endr_ende;
2790 }
2791 CE2(a,b,t_INTVECTOR_BITVECTOR);
2792 /* a is INTVECTOR object */
2793 l = S_V_LI(a);
2794 erg += m_il_bv(l,b);
2795
2796 for (i=0;i<S_V_LI(b);i++)
2797 if ((S_V_II(a,i)%2) == 0)
2798 UNSET_BV_I(b,i);
2799 else
2800 SET_BV_I(b,i);
2801
2802 ENDR("t_INTVECTOR_BITVECTOR");
2803 }
2804
nullp_bitvector(bit)2805 INT nullp_bitvector(bit) OP bit;
2806 /* AK 011098 V2.0 */
2807 {
2808 unsigned char *self;
2809 INT l,i;
2810 self = (unsigned char *) S_V_S(bit);
2811 l = S_V_LI(bit);
2812 for (i=0;i<= (l/8);i++)
2813 if (self[i] != 0) return FALSE;
2814 return TRUE;
2815 }
2816
sup_bitvector(bit1,bit2,res)2817 INT sup_bitvector(bit1, bit2, res) OP bit1,bit2,res;
2818 /* AK 011098 V2.0 */
2819 {
2820 unsigned char *self, *bs1, *bs2;
2821 INT erg = OK;
2822 INT i,l;
2823 CTO(BITVECTOR,"sup_bitvector(1)",bit1);
2824 CTO(BITVECTOR,"sup_bitvector(2)",bit2);
2825 if (S_V_LI(bit1) != S_V_LI(bit2))
2826 error("sup_bitvector:diff lengths");
2827 l = S_V_LI(bit1);
2828 bs1 = (unsigned char *) S_V_S(bit1);
2829 bs2 = (unsigned char *) S_V_S(bit2);
2830 self = (unsigned char *)SYM_calloc(l/8+1,8);
2831 for (i=0;i<= (l/8);i++)
2832 self[i] = bs1[i] | bs2[i];
2833 B_LS_V(callocobject(),self,res);
2834 M_I_I(l,S_V_L(res));
2835 C_O_K(res,BITVECTOR);
2836 ENDR("sup_bitvector");
2837 }
2838
inf_bitvector(bit1,bit2,res)2839 INT inf_bitvector(bit1, bit2, res) OP bit1,bit2,res;
2840 /* AK 011098 V2.0 */
2841 {
2842 unsigned char *self, *bs1, *bs2;
2843 INT erg = OK;
2844 INT i,l;
2845 CTO(BITVECTOR,"inf_bitvector(1)",bit1);
2846 CTO(BITVECTOR,"inf_bitvector(2)",bit2);
2847 if (S_V_LI(bit1) != S_V_LI(bit2))
2848 error("inf_bitvector:diff lengths");
2849 l = S_V_LI(bit1);
2850 bs1 = (unsigned char *) S_V_S(bit1);
2851 bs2 = (unsigned char *) S_V_S(bit2);
2852 self = (unsigned char *)SYM_calloc(l/8+1,8);
2853 for (i=0;i<= (l/8);i++)
2854 self[i] = bs1[i] & bs2[i];
2855 B_LS_V(callocobject(),self,res);
2856 M_I_I(l,S_V_L(res));
2857 C_O_K(res,BITVECTOR);
2858 ENDR("inf_bitvector");
2859 }
2860
exor_bitvector_apply(bit1,res)2861 INT exor_bitvector_apply(bit1, res) OP bit1,res;
2862 /* AK 011098 V2.0 */
2863 {
2864 unsigned char *bs1, *bs2;
2865 INT erg = OK;
2866 INT i,l;
2867 CTO(BITVECTOR,"exor_bitvector_apply(1)",bit1);
2868 CTO(BITVECTOR,"exor_bitvector_apply(2)",res);
2869 if (S_V_LI(bit1) != S_V_LI(res))
2870 error("exor_bitvector_apply:diff lengths");
2871 l = S_V_LI(bit1);
2872 bs1 = (unsigned char *) S_V_S(bit1);
2873 bs2 = (unsigned char *) S_V_S(res);
2874 for (i=l/8;i>=0;i--)
2875 bs2[i] ^= bs1[i] ;
2876 ENDR("exor_bitvector_apply");
2877 }
2878
2879
2880
inf_bitvector_apply(bit1,res)2881 INT inf_bitvector_apply(bit1, res) OP bit1,res;
2882 /* AK 011098 V2.0 */
2883 {
2884 unsigned char *bs1, *bs2;
2885 INT erg = OK;
2886 INT i,l;
2887 CTO(BITVECTOR,"inf_bitvector_apply(1)",bit1);
2888 CTO(BITVECTOR,"inf_bitvector_apply(2)",res);
2889
2890 if (S_V_LI(bit1) != S_V_LI(res))
2891 error("inf_bitvector_apply:diff lengths");
2892 l = S_V_LI(bit1);
2893 bs1 = (unsigned char *) S_V_S(bit1);
2894 bs2 = (unsigned char *) S_V_S(res);
2895 for (i=0;i<= (l/8);i++)
2896 bs2[i] &= bs1[i] ;
2897 ENDR("inf_bitvector_apply");
2898 }
2899
sup_bitvector_apply(bit1,res)2900 INT sup_bitvector_apply(bit1, res) OP bit1,res;
2901 /* AK 200606 V2.0 */
2902 {
2903 unsigned char *bs1, *bs2;
2904 INT erg = OK;
2905 INT i,l;
2906 CTO(BITVECTOR,"sup_bitvector_apply(1)",bit1);
2907 CTO(BITVECTOR,"sup_bitvector_apply(2)",res);
2908
2909 if (S_V_LI(bit1) != S_V_LI(res))
2910 error("sup_bitvector_apply:diff lengths");
2911 l = S_V_LI(bit1);
2912 bs1 = (unsigned char *) S_V_S(bit1);
2913 bs2 = (unsigned char *) S_V_S(res);
2914 for (i=0;i<= (l/8);i++)
2915 bs2[i] |= bs1[i] ;
2916 ENDR("sup_bitvector_apply");
2917 }
2918
2919
2920
2921
t_BITVECTOR_INTVECTOR(a,b)2922 INT t_BITVECTOR_INTVECTOR(a,b) OP a,b;
2923 /* AK 011098 V2.0 */
2924 {
2925 unsigned char *self;
2926 INT i,j,k;
2927 if (a == b)
2928 return ERROR;
2929 /* a is INTVECTOR object */
2930 self = (unsigned char *) S_V_S(a);
2931 m_il_v(S_V_LI(a),b);
2932 for (i=0,j=0,k=1;i<S_V_LI(b);i++,k*=2 )
2933 {
2934 if (k==256) { j ++; k = 1;}
2935 if (self[j] & k)
2936 M_I_I((INT)1,S_V_I(b,i));
2937 else
2938 M_I_I((INT)0,S_V_I(b,i));
2939 }
2940 C_O_K(b,INTEGERVECTOR);
2941 return OK;
2942 }
2943
t_VECTOR_BIT(a,b)2944 INT t_VECTOR_BIT(a,b) OP a,b;
2945 /* AK 091294 */
2946 /* AK 011098 V2.0 */
2947 {
2948 INT erg = OK;
2949 INT il=0,i,j= -1,k=0;
2950 unsigned char *self;
2951 CTO(PARTITION,"t_VECTOR_BIT(1)",a);
2952 if (S_PA_K(a) != VECTOR)
2953 {
2954 erg += error("t_VECTOR_BIT input no VECTOR kind PARTITION object");
2955 goto endr_ende;
2956 }
2957 CE2(a,b,t_VECTOR_BIT);
2958
2959 if (S_PA_LI(a) > 0)
2960 il = S_PA_LI(a) + S_PA_II(a,S_PA_LI(a)-(INT)1);
2961 /* laenge des bit vectors i n bit */
2962
2963 erg += b_ks_pa(BITVECTOR,callocobject(),b);
2964 B_LS_V(callocobject(),NULL,S_PA_S(b));
2965 M_I_I(il,S_PA_L(b));
2966 C_O_K(S_PA_S(b),BITVECTOR);
2967 if (il == 0) goto endr_ende;
2968
2969 self = (unsigned char *) SYM_calloc(il/64+1,8);
2970 C_V_S(S_PA_S(b),self);
2971
2972 for (i=(INT)0,j=S_PA_LI(a)-1,k=S_PA_II(a,S_PA_LI(a)-1);i<il;i++)
2973 {
2974 if (j== -1) /* nur noch einsen */
2975 {
2976 SET_BV_I(S_PA_S(b),i);
2977 k--;
2978 }
2979 else if (k > S_PA_II(a,j))
2980 {
2981 SET_BV_I(S_PA_S(b),i);
2982 k--;
2983 }
2984 else {
2985 j--;
2986 }
2987 }
2988 C_PA_K(b,BITVECTOR);
2989 if (k != 0)
2990 return error("t_VECTOR_BIT: internal error tVB-0");
2991 if (j != -1)
2992 return error("t_VECTOR_BIT: internal error tVB-1");
2993 ENDR("t_VECTOR_BIT");
2994 }
2995
maxpart_bitvector_part_i(a)2996 static INT maxpart_bitvector_part_i(a) OP a;
2997 /* AK 011098 V2.0 */
2998 {
2999 INT i,j=0;
3000 for (i=0;i<=S_V_LI(a);i++)
3001 {
3002 if (GET_BV_I(a,i) != (INT)1) break;
3003 }
3004 /* d.h. i ist die 0 */
3005 for (;i<=S_V_LI(a);i++)
3006 if (GET_BV_I(a,i) == (INT)1) j++;
3007 return j;
3008 /* maximaler teil */
3009 }
3010
length_bitvector_part_i(a)3011 static INT length_bitvector_part_i(a) OP a;
3012 /* AK 011098 V2.0 */
3013 {
3014 INT i,j=0,k;
3015 for (i=S_V_LI(a)-1;i>=0;i--)
3016 {
3017 if ((k=GET_BV_I(a,i)) != (INT)0) break;
3018 }
3019 /* d.h. i ist die letzte 1 */
3020 for (k=(INT)0;k<i;k++)
3021 if (GET_BV_I(a,k) == (INT)0) j++;
3022 return j;
3023 }
3024
t_BIT_VECTOR(a,b)3025 INT t_BIT_VECTOR(a,b) OP a,b;
3026 /* AK 121294 */
3027 /* AK 011098 V2.0 */
3028 {
3029 INT erg = OK;
3030 INT il, i,j,k;
3031 CTO(PARTITION,"t_BIT_VECTOR(1)",a);
3032
3033 if (S_PA_K(a) != BITVECTOR)
3034 return error("t_BIT_VECTOR input no BITVECTOR kind PARTITION object");
3035 if (check_equal_2(a,b,t_BIT_VECTOR,&erg) == EQUAL)
3036 return erg;
3037
3038 il = length_bitvector_part_i(S_PA_S(a)); /* Anzahl teile */
3039
3040 b_ks_pa(VECTOR,callocobject(),b);
3041 m_il_integervector(il,S_PA_S(b));
3042 j=0;k=0;
3043 for (i=S_PA_LI(a)-1;i>=0;i--)
3044 {
3045 if(GET_BV_I(S_PA_S(a),i) == 1) break;
3046 }
3047 for (;k<il;i--)
3048 if (GET_BV_I(S_PA_S(a),i) == 1)
3049 j++;
3050 else
3051 {
3052 M_I_I(j,S_PA_I(b,k));
3053 k++;
3054 }
3055 ENDR("t_BIT_VECTOR");
3056 }
3057
3058 static INT dimension_bit_co();
dimension_bit(a,b)3059 INT dimension_bit(a,b) OP a,b;
3060 /* AK 011098 V2.0 */
3061 {
3062 INT erg = OK;
3063 CTO(PARTITION,"dimension_bit",a);
3064 if (S_PA_K(a) != BITVECTOR)
3065 {
3066 erg += error("dimension_bit input no BITVECTOR kind PARTITION object");
3067 goto endr_ende;
3068 }
3069 CE2(a,b,dimension_bit);
3070 m_i_i((INT)0,b);
3071 println(a);
3072 erg += dimension_bit_co(S_PA_S(a),b,(INT)1);
3073 println(b);
3074 ENDR("dimension_bit");
3075 }
3076
dimension_bit_co(a,b,sig)3077 static INT dimension_bit_co(a,b,sig) OP a,b; INT sig;
3078 /* AK 141294 */
3079 {
3080 INT nu,is,i,il,j,jo=0,k,l,erg=OK;
3081 OP c,d;
3082 CTO(BITVECTOR,"dimension_bit_co(1)",a);
3083 CTTO(INTEGER,LONGINT,"dimension_bit_co(2)",b);
3084
3085 il = length_bitvector_part_i(a);
3086 is = maxpart_bitvector_part_i(a);
3087 c = callocobject();
3088 d = callocobject();
3089 erg += m_il_v(is,c);
3090 C_O_K(c,INTEGERVECTOR);
3091 M_I_I((INT)1,d);
3092 j=0;k=0;
3093 for (i=S_V_LI(a)-1;i>=0;i--)
3094 {
3095 if(GET_BV_I(a,i) == 1) break;
3096 }
3097 /* hier geht die partition los */
3098 nu = 0;
3099 for (;k<il;i--)
3100 if (GET_BV_I(a,i) == 1)
3101 j++;
3102 else
3103 {
3104 if (k==0)
3105 {
3106 for (l=0;l<j;l++)
3107 M_I_I(j-l,S_V_I(c,l));
3108 nu += j;
3109 jo = j;
3110 }
3111 else {
3112 for (l=0;l<jo;l++)
3113 {
3114 MULT_APPLY_INTEGER(S_V_I(c,l),d);
3115 M_I_I(S_V_II(c,l)+1+j-jo, S_V_I(c,l));
3116 }
3117 for (;l<j;l++)
3118 M_I_I(j-l,S_V_I(c,l));
3119 nu += j;
3120 jo = j;
3121 }
3122 k++;
3123 }
3124
3125 k=0;
3126 for (i=(INT)0;i<jo;i++)
3127 MULT_APPLY_INTEGER(S_V_I(c,i),d);
3128 erg += freeself(c);
3129 M_I_I(nu,c);
3130 erg += fakul(c,c);
3131 erg += ganzdiv(c,d,c);
3132 if (sig == (INT)1)
3133 ADD_APPLY(c,b);
3134 else
3135 sub(b,c,b);
3136 FREEALL(c);
3137 FREEALL(d);
3138 ENDR("internal routine:dimension_bit_co");
3139 }
3140
charvalue_bit(a,b,scv)3141 INT charvalue_bit (a,b,scv) OP a,b,scv;
3142 /* AK 011098 V2.0 */
3143 {
3144 INT erg = OK;
3145 if (S_O_K(a) != PARTITION)
3146 if (S_PA_K(a) != BITVECTOR)
3147 return ERROR;
3148 if (S_O_K(b) != PARTITION)
3149 if (S_PA_K(b) != VECTOR)
3150 return ERROR;
3151
3152 FREESELF(scv); M_I_I(0,scv);
3153 erg += charvalue_bit_co(S_PA_S(a),S_PA_S(b),scv,S_PA_LI(b)-(INT)1,(INT)1);
3154 ENDR("charvalue_bit");
3155 }
3156
charvalue_bit_co(a,b,c,index,sig)3157 static INT charvalue_bit_co(a,b,c,index,sig)
3158 OP a,b,c;
3159 register INT index,sig;
3160 {
3161 INT i,j,k,l,lh,hakenlaenge, ol;
3162 unsigned char *uc,*uch;
3163
3164 if ((S_V_II(b,index) == (INT)1)
3165 &&
3166 (index >= 6)
3167 )
3168 {
3169 dimension_bit_co(a,c,sig);
3170 return OK;
3171 }
3172
3173 i=S_V_LI(a)-1;
3174 uc = ((unsigned char *) S_V_S(a)) + (i/8);
3175 l = i%8;
3176 for (;i>=0;i--,l--)
3177 {
3178 if (l < 0) {l+=8;uc--;}
3179 if (GET_BV_I(a,i) != 0) break;
3180 /* if (GET_BIT_I(uc,l) != 0) break; */
3181 }
3182 ol = S_V_LI(a);
3183 M_I_I(i+1,S_V_L(a));
3184 /* i index erster wagrechter eintrag */
3185 hakenlaenge = S_V_II(b,index);
3186 uch = ((unsigned char *) S_V_S(a)) + ((i-hakenlaenge)/8);
3187 lh = (i-hakenlaenge)%8;
3188 for (;i>=hakenlaenge;i--,l--,lh--)
3189 {
3190 if (l < 0) {l+=8;uc--;}
3191 if (lh < 0) {lh+=8;uch--;}
3192 if (GET_BV_I(a,i) != 1) continue;
3193 /* if (GET_BIT_I(uc,l) != 1) continue; */
3194 if (GET_BV_I(a,i-hakenlaenge) != 0) continue;
3195 /* if (GET_BIT_I(uch,lh) != 0) continue; */
3196 k = 0;
3197 for (j=i-1;j>i-hakenlaenge;j--)
3198 if (GET_BV_I(a,j) == 0) k++;
3199
3200 /* k is leglength */
3201 if (index == (INT)0)
3202 {
3203 if (k%2 == 1) sig *= -1;
3204 if (sig==1) inc(c); else dec(c);
3205 goto ende;
3206 }
3207
3208 UNSET_BV_I(a,i);
3209 /* UNSET_BIT_I(uc,l);*/
3210 SET_BV_I(a,i-hakenlaenge);
3211 /*SET_BIT_I(uch,lh);*/
3212 if (k%2 == 0)
3213 charvalue_bit_co(a,b,c,index-1,sig);
3214 else
3215 charvalue_bit_co(a,b,c,index-1,sig* ((INT)-1));
3216 SET_BV_I(a,i);
3217 /*SET_BIT_I(uc,l);*/
3218 UNSET_BV_I(a,i-hakenlaenge);
3219 /*UNSET_BIT_I(uch,lh);*/
3220 }
3221 ende:
3222 M_I_I(ol,S_V_L(a));
3223 return OK;
3224 }
3225
next_lex_vector(a,b)3226 INT next_lex_vector(a,b) OP a,b;
3227 /* AK 060802 */
3228 /* computes the next vector */
3229 /* a and b may be equal */
3230 /* return TRUE if there was a lexicoigraphic next vector
3231 FALSE if it is already the biggest one */
3232 {
3233 INT erg = OK;
3234 INT i,j,k;
3235 OP m;
3236 CTTO(INTEGERVECTOR,VECTOR,"next_lex_vector(1)",a);
3237 if (a != b) erg += copy(a,b);
3238 if (S_V_LI(b) <= 1) return FALSE;
3239 /* vector has length >= 1 */
3240
3241 /* to left till decrease */
3242 for (i=S_V_LI(b)-2;i>=0;i--)
3243 if (LT(S_V_I(b,i),S_V_I(b,i+1))) break;
3244
3245
3246 if (i==-1) return FALSE;
3247
3248 k = i+1;
3249 for (j=i+1;j<S_V_LI(b);j++)
3250 if (LT(S_V_I(b,j),S_V_I(b,k)) && GT(S_V_I(b,j),S_V_I(b,i))) k=j;
3251 /* exchange elements at i and k */
3252 swap(S_V_I(b,k),S_V_I(b,i));
3253 /* sort remain part from i+1 */
3254 m = S_V_S(b);
3255 j = S_V_LI(b);
3256 C_V_S(b,S_V_I(b,i+1));
3257 M_I_I(j-i-1,S_V_L(b));
3258 qsort_vector(b);
3259 C_V_S(b,m);
3260 M_I_I(j,S_V_L(b));
3261
3262 return TRUE;
3263 ENDR("next_lex_vector");
3264 }
3265
fprint_queue(fp,q)3266 INT fprint_queue(fp,q) FILE *fp; OP q;
3267 /* AK 251103 */
3268 {
3269 fprint_vector(fp,q);
3270 return OK;
3271 }
3272
init_queue(q)3273 INT init_queue(q) OP q;
3274 /* AK 251103 */
3275 {
3276 INT erg = OK;
3277 m_il_v(0,q);C_O_K(q,QUEUE);
3278 ENDR("init_queue");
3279 }
3280
push(a,q)3281 INT push(a,q) OP a,q;
3282 /* AK 251103 */
3283 {
3284 INT erg =OK;
3285 C_O_K(q,VECTOR);
3286 inc(q);
3287 C_V_I(q,S_V_LI(q)-1,a);
3288 C_O_K(q,QUEUE);
3289 CTO(QUEUE,"push(e)",q);
3290 ENDR("push");
3291 }
3292
pop(q)3293 OP pop(q) OP q;
3294 /* AK 251103 */
3295 {
3296 OP z;
3297 INT i,erg =OK;
3298 CTO(QUEUE,"pop(1)",q);
3299
3300 for (i=0;i<S_V_LI(q);i++)
3301 if (not EMPTYP(S_V_I(q,i))) { z=callocobject();*z = *S_V_I(q,i);
3302 C_O_K(S_V_I(q,i),EMPTY);
3303 if (i>100) { INT j; /* AK 210104 */
3304 for (j=0;i+j<S_V_LI(q);j++) *S_V_I(q,j)=*S_V_I(q,i+j);
3305 M_I_I(j,S_V_L(q));
3306 }
3307 return z; }
3308
3309 return NULL;
3310 ENDO("pop");
3311 }
3312
3313
3314
3315 #endif /* VECTORTRUE */
3316
3317