Line data Source code
1 : /* Copyright (C) 2000 The PARI group.
2 :
3 : This file is part of the PARI/GP package.
4 :
5 : PARI/GP is free software; you can redistribute it and/or modify it under the
6 : terms of the GNU General Public License as published by the Free Software
7 : Foundation; either version 2 of the License, or (at your option) any later
8 : version. It is distributed in the hope that it will be useful, but WITHOUT
9 : ANY WARRANTY WHATSOEVER.
10 :
11 : Check the License for details. You should have received a copy of it, along
12 : with the package; see the file 'COPYING'. If not, write to the Free Software
13 : Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
14 :
15 : /*******************************************************************/
16 : /* */
17 : /* CONCATENATION */
18 : /* */
19 : /*******************************************************************/
20 : #include "pari.h"
21 : #include "paripriv.h"
22 :
23 : /* assume A or B is a t_LIST */
24 : static GEN
25 21 : listconcat(GEN A, GEN B)
26 : {
27 : long i, l1, lx;
28 : GEN L, z, L1, L2;
29 :
30 21 : if (typ(A) != t_LIST) {
31 7 : if (list_typ(B)!=t_LIST_RAW) pari_err_TYPE("listconcat",B);
32 7 : L2 = list_data(B);
33 7 : if (!L2) return mklistcopy(A);
34 7 : lx = lg(L2) + 1;
35 7 : z = mklist();
36 7 : list_data(z) = L = cgetg(lx, t_VEC);
37 35 : for (i = 2; i < lx; i++) gel(L,i) = gcopy(gel(L2,i-1));
38 7 : gel(L,1) = gcopy(A); return z;
39 14 : } else if (typ(B) != t_LIST) {
40 7 : if (list_typ(A)!=t_LIST_RAW) pari_err_TYPE("listconcat",A);
41 7 : L1 = list_data(A);
42 7 : if (!L1) return mklistcopy(B);
43 7 : lx = lg(L1) + 1;
44 7 : z = mklist();
45 7 : list_data(z) = L = cgetg(lx, t_VEC);
46 35 : for (i = 1; i < lx-1; i++) gel(L,i) = gcopy(gel(L1,i));
47 7 : gel(L,i) = gcopy(B); return z;
48 : }
49 : /* A, B both t_LISTs */
50 7 : if (list_typ(A)!=t_LIST_RAW) pari_err_TYPE("listconcat",A);
51 7 : if (list_typ(B)!=t_LIST_RAW) pari_err_TYPE("listconcat",B);
52 7 : L1 = list_data(A); if (!L1) return listcopy(B);
53 7 : L2 = list_data(B); if (!L2) return listcopy(A);
54 :
55 7 : l1 = lg(L1);
56 7 : lx = l1-1 + lg(L2);
57 7 : z = mklist();
58 7 : list_data(z) = L = cgetg(lx, t_VEC);
59 7 : L2 -= l1-1;
60 35 : for (i=1; i<l1; i++) gel(L,i) = gcopy(gel(L1,i));
61 35 : for ( ; i<lx; i++) gel(L,i) = gcopy(gel(L2,i));
62 7 : return z;
63 : }
64 :
65 : /* assume A or B is a t_STR */
66 : static GEN
67 427 : strconcat(GEN x, GEN y)
68 : {
69 : size_t l, lx;
70 427 : char *sx = GENtostr_unquoted(x);
71 427 : char *sy = GENtostr_unquoted(y), *str;
72 427 : lx = strlen(sx);
73 427 : l = nchar2nlong(lx + strlen(sy) + 1);
74 427 : x = cgetg(l + 1, t_STR); str = GSTR(x);
75 427 : strcpy(str, sx);
76 427 : strcpy(str+lx,sy); return x;
77 : }
78 :
79 : /* concat A and B vertically. Internal */
80 : GEN
81 20430170 : vconcat(GEN A, GEN B)
82 : {
83 : long la, ha, hb, hc, i, j, T;
84 : GEN M, a, b, c;
85 :
86 20430170 : if (!A) return B;
87 20393421 : if (!B) return A;
88 20393421 : la = lg(A); if (la==1) return B;
89 20333839 : T = typ(gel(A,1)); /* t_COL or t_VECSMALL */
90 20333839 : ha = lgcols(A); M = cgetg(la,t_MAT);
91 20334558 : hb = lgcols(B); hc = ha+hb-1;
92 253345936 : for (j=1; j<la; j++)
93 : {
94 233010162 : c = cgetg(hc, T); gel(M, j) = c;
95 232997456 : a = gel(A,j);
96 232997456 : b = gel(B,j);
97 1041237857 : for (i=1; i<ha; i++) *++c = *++a;
98 1034854257 : for (i=1; i<hb; i++) *++c = *++b;
99 : }
100 20335774 : return M;
101 : }
102 :
103 : static void
104 49 : err_cat(GEN x, GEN y) { pari_err_OP("concatenation",x,y); }
105 :
106 : GEN
107 24531032 : shallowconcat(GEN x, GEN y)
108 : {
109 24531032 : long tx=typ(x),ty=typ(y),lx=lg(x),ly=lg(y),i;
110 : GEN z,p1;
111 :
112 24531032 : if (tx==t_STR || ty==t_STR) return strconcat(x,y);
113 24530680 : if (tx==t_LIST || ty==t_LIST) return listconcat(x,y);
114 :
115 24530637 : if (tx==t_MAT && lx==1)
116 : {
117 195104 : if (ty!=t_VEC) return gtomat(y);
118 0 : if (ly==1) return cgetg(1, t_MAT);
119 0 : err_cat(x,y);
120 : }
121 24335533 : if (ty==t_MAT && ly==1)
122 : {
123 166239 : if (tx!=t_VEC) return gtomat(x);
124 0 : if (lx==1) return cgetg(1, t_MAT);
125 0 : err_cat(x,y);
126 : }
127 :
128 24169732 : if (tx == ty)
129 : {
130 16040605 : if (tx == t_MAT)
131 12753992 : { if (lgcols(x) != lgcols(y)) err_cat(x,y); }
132 : else
133 3286613 : if (!is_matvec_t(tx) && tx != t_VECSMALL) return mkvec2(x, y);
134 16040542 : z=cgetg(lx+ly-1,tx);
135 177591253 : for (i=1; i<lx; i++) z[i] = x[i];
136 82497064 : for (i=1; i<ly; i++) z[lx+i-1]= y[i];
137 16040505 : return z;
138 : }
139 :
140 8129127 : if (! is_matvec_t(tx))
141 : {
142 20480 : if (! is_matvec_t(ty)) return mkvec2(x, y);
143 20480 : z=cgetg(ly+1,ty);
144 20480 : if (ty != t_MAT) p1 = x;
145 : else
146 : {
147 0 : if (lgcols(y)!=2) err_cat(x,y);
148 0 : p1 = mkcol(x);
149 : }
150 66886 : for (i=2; i<=ly; i++) z[i] = y[i-1];
151 20480 : gel(z, 1) = p1; return z;
152 : }
153 8108620 : if (! is_matvec_t(ty))
154 : {
155 1521231 : z=cgetg(lx+1,tx);
156 1521231 : if (tx != t_MAT) p1 = y;
157 : else
158 : {
159 0 : if (lgcols(x)!=2) err_cat(x,y);
160 0 : p1 = mkcol(y);
161 : }
162 39755404 : for (i=1; i<lx; i++) z[i]=x[i];
163 1521231 : gel(z, lx) = p1; return z;
164 : }
165 :
166 6587349 : switch(tx)
167 : {
168 16562 : case t_VEC:
169 : switch(ty)
170 : {
171 16562 : case t_COL:
172 16562 : if (lx<=2) return (lx==1)? y: shallowconcat(gel(x,1),y);
173 0 : if (ly>=3) break;
174 0 : return (ly==1)? x: shallowconcat(x,gel(y,1));
175 0 : case t_MAT:
176 0 : z=cgetg(ly,t_MAT); if (lx != ly) break;
177 0 : for (i=1; i<ly; i++) gel(z,i) = shallowconcat(gel(x,i),gel(y,i));
178 0 : return z;
179 : }
180 0 : break;
181 :
182 107473 : case t_COL:
183 : switch(ty)
184 : {
185 407 : case t_VEC:
186 407 : if (lx<=2) return (lx==1)? y: shallowconcat(gel(x,1), y);
187 176 : if (ly>=3) break;
188 176 : return (ly==1)? x: shallowconcat(x, gel(y,1));
189 107066 : case t_MAT:
190 107066 : if (lx != lgcols(y)) break;
191 107066 : z=cgetg(ly+1,t_MAT); gel(z,1) = x;
192 663902 : for (i=2; i<=ly; i++) gel(z,i) = gel(y,i-1);
193 107066 : return z;
194 : }
195 0 : break;
196 :
197 6463324 : case t_MAT:
198 : switch(ty)
199 : {
200 0 : case t_VEC:
201 0 : z=cgetg(lx, t_MAT); if (ly != lx) break;
202 0 : for (i=1; i<lx; i++) gel(z,i) = shallowconcat(gel(x,i), gel(y,i));
203 0 : return z;
204 6463316 : case t_COL:
205 6463316 : if (ly != lgcols(x)) break;
206 6463305 : z=cgetg(lx+1,t_MAT); gel(z,lx) = y;
207 23356086 : for (i=1; i<lx; i++) z[i]=x[i];
208 6463346 : return z;
209 : }
210 8 : break;
211 : }
212 0 : err_cat(x,y);
213 : return NULL; /* LCOV_EXCL_LINE */
214 : }
215 :
216 : /* see catmany() */
217 : static GEN
218 19854 : catmanyMAT(GEN y1, GEN y2)
219 : {
220 19854 : long i, h = 0, L = 1;
221 : GEN z, y;
222 68629 : for (y = y2; y >= y1; y--)
223 : {
224 48775 : GEN c = gel(y,0);
225 48775 : long nc = lg(c)-1;
226 48775 : if (nc == 0) continue;
227 48747 : if (h != lgcols(c))
228 : {
229 19847 : if (h) err_cat(gel(y2,0), c);
230 19847 : h = lgcols(c);
231 : }
232 48747 : L += nc;
233 48747 : z = new_chunk(nc) - 1;
234 172324 : for (i=1; i<=nc; i++) gel(z,i) = gel(c,i);
235 : }
236 19854 : z = new_chunk(1);
237 19854 : *z = evaltyp(t_MAT) | evallg(L);
238 19854 : return z;
239 : }
240 : static GEN
241 147 : catmanySTR(GEN y1, GEN y2)
242 : {
243 147 : long L = 1; /* final \0 */
244 : GEN z, y;
245 : char *s;
246 7336 : for (y = y1; y <= y2; y++)
247 : {
248 7189 : char *c = GSTR( gel(y,0) );
249 7189 : L += strlen(c);
250 : }
251 147 : z = cgetg(nchar2nlong(L)+1, t_STR);
252 147 : s = GSTR(z);
253 7336 : for (y = y1; y <= y2; y++)
254 : {
255 7189 : char *c = GSTR( gel(y,0) );
256 7189 : long nc = strlen(c);
257 7189 : if (nc) { (void)memcpy(s, c, nc); s += nc; }
258 : }
259 147 : *s = 0; return z;
260 : }
261 :
262 : /* all entries in y have the same type t = t_VEC, COL, MAT or VECSMALL
263 : * concatenate y[k1..k2], with yi = y + ki, k1 <= k2 */
264 : static GEN
265 2122682 : catmany(GEN y1, GEN y2, long t)
266 : {
267 : long i, L;
268 : GEN z, y;
269 2122682 : if (y1 == y2) return gel(y1,0);
270 2120582 : if (t == t_MAT) return catmanyMAT(y1, y2);
271 2100728 : if (t == t_STR) return catmanySTR(y1, y2);
272 2100581 : L = 1;
273 7855564 : for (y = y2; y >= y1; y--)
274 : {
275 5754975 : GEN c = gel(y,0);
276 5754975 : long nc = lg(c)-1;
277 5754975 : if (nc == 0) continue;
278 5193244 : L += nc;
279 5193244 : z = new_chunk(nc) - 1;
280 17085854 : for (i=1; i<=nc; i++) gel(z,i) = gel(c,i);
281 : }
282 2100589 : z = new_chunk(1);
283 2100608 : *z = evaltyp(t) | evallg(L);
284 2100606 : return z;
285 : }
286 :
287 : GEN
288 7807106 : shallowconcat1(GEN x)
289 : {
290 7807106 : pari_sp av = avma;
291 : long lx, t, i;
292 : GEN z;
293 7807106 : switch(typ(x))
294 : {
295 7807086 : case t_VEC: case t_COL:
296 7807086 : lx = lg(x);
297 7807086 : break;
298 21 : case t_LIST:
299 21 : if (list_typ(x)!=t_LIST_RAW) pari_err_TYPE("concat",x);
300 21 : if (!list_data(x)) pari_err_DOMAIN("concat","vector","=",x,x);
301 7 : x = list_data(x); lx = lg(x);
302 7 : break;
303 0 : default:
304 0 : pari_err_TYPE("concat",x);
305 : return NULL; /* LCOV_EXCL_LINE */
306 : }
307 7807093 : if (lx==1) pari_err_DOMAIN("concat","vector","=",x,x);
308 7807136 : if (lx==2) return gel(x,1);
309 2122700 : z = gel(x,1); t = typ(z); i = 2;
310 2122700 : if (is_matvec_t(t) || t == t_VECSMALL || t == t_STR)
311 : { /* detect a "homogeneous" object: catmany is faster */
312 5813068 : for (; i<lx; i++)
313 3692723 : if (typ(gel(x,i)) != t) break;
314 2122683 : z = catmany(x + 1, x + i-1, t);
315 : }
316 2125684 : for (; i<lx; i++) {
317 2968 : z = shallowconcat(z, gel(x,i));
318 2968 : if (gc_needed(av,3))
319 : {
320 0 : if (DEBUGMEM>1) pari_warn(warnmem,"concat: i = %ld", i);
321 0 : z = gerepilecopy(av, z);
322 : }
323 : }
324 2122716 : return z;
325 : }
326 :
327 : GEN
328 840 : gconcat1(GEN x)
329 : {
330 840 : pari_sp av = avma;
331 840 : return gerepilecopy(av, shallowconcat1(x));
332 : }
333 :
334 : /* fill M[xoff+i, yoff+j] with the contents of c ( c * Id_n if scalar ) */
335 : static void
336 16638939 : matfill(GEN M, GEN c, long xoff, long yoff, long n)
337 : {
338 : long i, j, h, l;
339 16638939 : l = lg(c); if (l == 1) return;
340 16612244 : switch(typ(c))
341 : {
342 44275 : case t_VEC:
343 1032605 : for (i = 1; i < l; i++)
344 988330 : gcoeff(M,xoff+1,yoff+i) = gel(c,i);
345 44275 : break;
346 161776 : case t_COL:
347 1188618 : for (i = 1; i < l; i++)
348 1026842 : gcoeff(M,xoff+i,yoff+1) = gel(c,i);
349 161776 : break;
350 9345006 : case t_MAT:
351 9345006 : h = lgcols(c);
352 27730109 : for (j = 1; j < l; j++)
353 74410108 : for (i = 1; i < h; i++) gcoeff(M,xoff+i,yoff+j) = gcoeff(c,i,j);
354 9345001 : break;
355 7061187 : default:
356 15944887 : for (i = 1; i <= n; i++)
357 8883700 : gcoeff(M, xoff+i, yoff+i) = c;
358 7061187 : break;
359 : }
360 : }
361 :
362 : static GEN
363 18755077 : _matsize(GEN x)
364 : {
365 18755077 : long t = typ(x), L = lg(x) - 1;
366 18755077 : switch(t)
367 : { /* matsize */
368 88564 : case t_VEC: return mkvecsmall2(1, L);
369 323496 : case t_COL: return mkvecsmall2(L, 1);
370 11280643 : case t_MAT: return mkvecsmall2(L? nbrows(x): 0, L);
371 7062374 : default:
372 7062374 : if (is_noncalc_t(t)) pari_err_TYPE("_matsize", x);
373 7062381 : return mkvecsmall2(1, 1);
374 : }
375 : }
376 :
377 : GEN
378 3686023 : shallowmatconcat(GEN v)
379 : {
380 3686023 : long i, j, h, l = lg(v), L = 0, H = 0;
381 : GEN M, maxh, maxl;
382 3686023 : if (l == 1) return cgetg(1,t_MAT);
383 3681517 : switch(typ(v))
384 : {
385 997201 : case t_VEC:
386 3067305 : for (i = 1; i < l; i++)
387 : {
388 2070112 : GEN c = gel(v,i);
389 2070112 : GEN s = _matsize(c);
390 2070107 : H = maxss(H, s[1]);
391 2070104 : L += s[2];
392 : }
393 997193 : M = zeromatcopy(H, L);
394 997219 : L = 0;
395 3067361 : for (i = 1; i < l; i++)
396 : {
397 2070146 : GEN c = gel(v,i);
398 2070146 : GEN s = _matsize(c);
399 2070142 : matfill(M, c, 0, L, 1);
400 2070142 : L += s[2];
401 : }
402 997215 : return M;
403 :
404 3619 : case t_COL:
405 49693 : for (i = 1; i < l; i++)
406 : {
407 46074 : GEN c = gel(v,i);
408 46074 : GEN s = _matsize(c);
409 46074 : H += s[1];
410 46074 : L = maxss(L, s[2]);
411 : }
412 3619 : M = zeromatcopy(H, L);
413 3619 : H = 0;
414 49693 : for (i = 1; i < l; i++)
415 : {
416 46074 : GEN c = gel(v,i);
417 46074 : GEN s = _matsize(c);
418 46074 : matfill(M, c, H, 0, 1);
419 46074 : H += s[1];
420 : }
421 3619 : return M;
422 2680697 : case t_MAT:
423 2680697 : h = lgcols(v);
424 2680697 : maxh = zero_zv(h-1);
425 2680697 : maxl = zero_zv(l-1);
426 8802051 : for (j = 1; j < l; j++)
427 20644082 : for (i = 1; i < h; i++)
428 : {
429 14522727 : GEN c = gcoeff(v,i,j);
430 14522727 : GEN s = _matsize(c);
431 14522727 : if (s[1] > maxh[i]) maxh[i] = s[1];
432 14522727 : if (s[2] > maxl[j]) maxl[j] = s[2];
433 : }
434 8802059 : for (i = 1, H = 0; i < h; i++) H += maxh[i];
435 8802052 : for (j = 1, L = 0; j < l; j++) L += maxl[j];
436 2680696 : M = zeromatcopy(H, L);
437 8802054 : for (j = 1, L = 0; j < l; j++)
438 : {
439 20644085 : for (i = 1, H = 0; i < h; i++)
440 : {
441 14522728 : GEN c = gcoeff(v,i,j);
442 14522728 : matfill(M, c, H, L, minss(maxh[i], maxl[j]));
443 14522728 : H += maxh[i];
444 : }
445 6121357 : L += maxl[j];
446 : }
447 2680697 : return M;
448 0 : default:
449 0 : pari_err_TYPE("shallowmatconcat", v);
450 : return NULL;/*LCOV_EXCL_LINE*/
451 : }
452 : }
453 : GEN
454 76580 : matconcat(GEN v)
455 : {
456 76580 : pari_sp av = avma;
457 76580 : return gerepilecopy(av, shallowmatconcat(v));
458 : }
459 :
460 : GEN
461 19425194 : gconcat(GEN x, GEN y)
462 : {
463 : long tx, lx,ty,ly,i;
464 : GEN z,p1;
465 :
466 19425194 : if (!y) return gconcat1(x);
467 19424354 : tx = typ(x);
468 19424354 : ty = typ(y);
469 19424354 : if (tx==t_STR || ty==t_STR)
470 : {
471 7 : pari_sp av = avma;
472 7 : return gerepileuptoleaf(av, strconcat(x,y));
473 : }
474 19424347 : if (tx==t_LIST || ty==t_LIST) return listconcat(x,y);
475 19424326 : lx=lg(x); ly=lg(y);
476 :
477 19424326 : if (tx==t_MAT && lx==1)
478 : {
479 588 : if (ty!=t_VEC) return gtomat(y);
480 21 : if (ly==1) return cgetg(1, t_MAT);
481 7 : err_cat(x,y);
482 : }
483 19423738 : if (ty==t_MAT && ly==1)
484 : {
485 21 : if (tx!=t_VEC) return gtomat(x);
486 14 : if (lx==1) return cgetg(1, t_MAT);
487 7 : err_cat(x,y);
488 : }
489 :
490 19423717 : if (tx == ty)
491 : {
492 653413 : if (tx == t_MAT && lgcols(x) != lgcols(y)) err_cat(x,y);
493 653413 : if (!is_matvec_t(tx))
494 : {
495 210 : if (tx != t_VECSMALL) return mkvec2copy(x, y);
496 203 : z = cgetg(lx+ly-1,t_VECSMALL);
497 301 : for (i=1; i<lx; i++) z[i] = x[i];
498 294 : for (i=1; i<ly; i++) z[lx+i-1]= y[i];
499 203 : return z;
500 : }
501 653203 : z=cgetg(lx+ly-1,tx);
502 3303976 : for (i=1; i<lx; i++) gel(z,i) = gcopy(gel(x,i));
503 2529396 : for (i=1; i<ly; i++) gel(z,lx+i-1)= gcopy(gel(y,i));
504 653203 : return z;
505 : }
506 :
507 18770304 : if (! is_matvec_t(tx))
508 : {
509 168 : if (! is_matvec_t(ty)) return mkvec2copy(x, y);
510 168 : z=cgetg(ly+1,ty);
511 168 : if (ty != t_MAT) p1 = gcopy(x);
512 : else
513 : {
514 14 : if (lgcols(y)!=2) err_cat(x,y);
515 7 : p1 = mkcolcopy(x);
516 : }
517 3514 : for (i=2; i<=ly; i++) gel(z,i) = gcopy(gel(y,i-1));
518 161 : gel(z,1) = p1; return z;
519 : }
520 18770136 : if (! is_matvec_t(ty))
521 : {
522 18770038 : z=cgetg(lx+1,tx);
523 18770038 : if (tx != t_MAT) p1 = gcopy(y);
524 : else
525 : {
526 14 : if (lgcols(x)!=2) err_cat(x,y);
527 7 : p1 = mkcolcopy(y);
528 : }
529 2547662340 : for (i=1; i<lx; i++) gel(z,i) = gcopy(gel(x,i));
530 18770031 : gel(z,lx) = p1; return z;
531 : }
532 :
533 98 : switch(tx)
534 : {
535 35 : case t_VEC:
536 : switch(ty)
537 : {
538 28 : case t_COL:
539 28 : if (lx<=2) return (lx==1)? gcopy(y): gconcat(gel(x,1),y);
540 28 : if (ly>=3) break;
541 14 : return (ly==1)? gcopy(x): gconcat(x,gel(y,1));
542 7 : case t_MAT:
543 7 : z=cgetg(ly,t_MAT); if (lx != ly) break;
544 21 : for (i=1; i<ly; i++) gel(z,i) = gconcat(gel(x,i),gel(y,i));
545 7 : return z;
546 : }
547 14 : break;
548 :
549 49 : case t_COL:
550 : switch(ty)
551 : {
552 42 : case t_VEC:
553 42 : if (lx<=2) return (lx==1)? gcopy(y): gconcat(gel(x,1),y);
554 28 : if (ly>=3) break;
555 21 : return (ly==1)? gcopy(x): gconcat(x,gel(y,1));
556 7 : case t_MAT:
557 7 : if (lx != lgcols(y)) break;
558 7 : z=cgetg(ly+1,t_MAT); gel(z,1) = gcopy(x);
559 14 : for (i=2; i<=ly; i++) gel(z,i) = gcopy(gel(y,i-1));
560 7 : return z;
561 : }
562 7 : break;
563 :
564 14 : case t_MAT:
565 : switch(ty)
566 : {
567 7 : case t_VEC:
568 7 : z=cgetg(lx,t_MAT); if (ly != lx) break;
569 21 : for (i=1; i<lx; i++) gel(z,i) = gconcat(gel(x,i),gel(y,i));
570 7 : return z;
571 7 : case t_COL:
572 7 : if (ly != lgcols(x)) break;
573 7 : z=cgetg(lx+1,t_MAT); gel(z,lx) = gcopy(y);
574 14 : for (i=1; i<lx; i++) gel(z,i) = gcopy(gel(x,i));
575 7 : return z;
576 : }
577 0 : break;
578 : }
579 21 : err_cat(x,y);
580 : return NULL; /* LCOV_EXCL_LINE */
581 : }
|
