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 20565808 : vconcat(GEN A, GEN B)
82 : {
83 : long la, ha, hb, hc, i, j, T;
84 : GEN M, a, b, c;
85 :
86 20565808 : if (!A) return B;
87 20529044 : if (!B) return A;
88 20529044 : la = lg(A); if (la==1) return B;
89 20468753 : T = typ(gel(A,1)); /* t_COL or t_VECSMALL */
90 20468753 : ha = lgcols(A); M = cgetg(la,t_MAT);
91 20469296 : hb = lgcols(B); hc = ha+hb-1;
92 255273421 : for (j=1; j<la; j++)
93 : {
94 234803095 : c = cgetg(hc, T); gel(M, j) = c;
95 234791239 : a = gel(A,j);
96 234791239 : b = gel(B,j);
97 1047921594 : for (i=1; i<ha; i++) *++c = *++a;
98 1041151591 : for (i=1; i<hb; i++) *++c = *++b;
99 : }
100 20470326 : 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 24626301 : shallowconcat(GEN x, GEN y)
108 : {
109 24626301 : long tx=typ(x),ty=typ(y),lx=lg(x),ly=lg(y),i;
110 : GEN z,p1;
111 :
112 24626301 : if (tx==t_STR || ty==t_STR) return strconcat(x,y);
113 24625938 : if (tx==t_LIST || ty==t_LIST) return listconcat(x,y);
114 :
115 24625872 : if (tx==t_MAT && lx==1)
116 : {
117 195451 : 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 24430421 : if (ty==t_MAT && ly==1)
122 : {
123 168324 : 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 24262595 : if (tx == ty)
129 : {
130 16121923 : if (tx == t_MAT)
131 12826847 : { if (lgcols(x) != lgcols(y)) err_cat(x,y); }
132 : else
133 3295076 : if (!is_matvec_t(tx) && tx != t_VECSMALL) return mkvec2(x, y);
134 16121865 : z=cgetg(lx+ly-1,tx);
135 179035392 : for (i=1; i<lx; i++) z[i] = x[i];
136 82913384 : for (i=1; i<ly; i++) z[lx+i-1]= y[i];
137 16121802 : return z;
138 : }
139 :
140 8140672 : 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 8120300 : 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 6599039 : switch(tx)
167 : {
168 16583 : case t_VEC:
169 : switch(ty)
170 : {
171 16583 : case t_COL:
172 16583 : 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 107733 : case t_COL:
183 : switch(ty)
184 : {
185 414 : case t_VEC:
186 414 : 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 107319 : case t_MAT:
190 107319 : if (lx != lgcols(y)) break;
191 107319 : z=cgetg(ly+1,t_MAT); gel(z,1) = x;
192 667475 : for (i=2; i<=ly; i++) gel(z,i) = gel(y,i-1);
193 107319 : return z;
194 : }
195 0 : break;
196 :
197 6474726 : 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 6474728 : case t_COL:
205 6474728 : if (ly != lgcols(x)) break;
206 6474716 : z=cgetg(lx+1,t_MAT); gel(z,lx) = y;
207 23412822 : for (i=1; i<lx; i++) z[i]=x[i];
208 6474743 : return z;
209 : }
210 0 : break;
211 : }
212 0 : err_cat(x,y);
213 : return NULL; /* LCOV_EXCL_LINE */
214 : }
215 :
216 : /* see catmany() */
217 : static GEN
218 20887 : catmanyMAT(GEN y1, GEN y2)
219 : {
220 20887 : long i, h = 0, L = 1;
221 : GEN z, y;
222 71764 : for (y = y2; y >= y1; y--)
223 : {
224 50877 : GEN c = gel(y,0);
225 50877 : long nc = lg(c)-1;
226 50877 : if (nc == 0) continue;
227 50849 : if (h != lgcols(c))
228 : {
229 20880 : if (h) err_cat(gel(y2,0), c);
230 20880 : h = lgcols(c);
231 : }
232 50849 : L += nc;
233 50849 : z = new_chunk(nc) - 1;
234 182442 : for (i=1; i<=nc; i++) gel(z,i) = gel(c,i);
235 : }
236 20887 : z = new_chunk(1);
237 20887 : *z = evaltyp(t_MAT) | evallg(L);
238 20887 : 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 2126384 : catmany(GEN y1, GEN y2, long t)
266 : {
267 : long i, L;
268 : GEN z, y;
269 2126384 : if (y1 == y2) return gel(y1,0);
270 2124284 : if (t == t_MAT) return catmanyMAT(y1, y2);
271 2103397 : if (t == t_STR) return catmanySTR(y1, y2);
272 2103250 : L = 1;
273 7864369 : for (y = y2; y >= y1; y--)
274 : {
275 5761112 : GEN c = gel(y,0);
276 5761112 : long nc = lg(c)-1;
277 5761112 : if (nc == 0) continue;
278 5197536 : L += nc;
279 5197536 : z = new_chunk(nc) - 1;
280 17094908 : for (i=1; i<=nc; i++) gel(z,i) = gel(c,i);
281 : }
282 2103257 : z = new_chunk(1);
283 2103268 : *z = evaltyp(t) | evallg(L);
284 2103270 : return z;
285 : }
286 :
287 : GEN
288 7825227 : shallowconcat1(GEN x)
289 : {
290 7825227 : pari_sp av = avma;
291 : long lx, t, i;
292 : GEN z;
293 7825227 : switch(typ(x))
294 : {
295 7825205 : case t_VEC: case t_COL:
296 7825205 : lx = lg(x);
297 7825205 : 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 1 : default:
304 1 : pari_err_TYPE("concat",x);
305 : return NULL; /* LCOV_EXCL_LINE */
306 : }
307 7825212 : if (lx==1) pari_err_DOMAIN("concat","vector","=",x,x);
308 7825254 : if (lx==2) return gel(x,1);
309 2126403 : z = gel(x,1); t = typ(z); i = 2;
310 2126403 : if (is_matvec_t(t) || t == t_VECSMALL || t == t_STR)
311 : { /* detect a "homogeneous" object: catmany is faster */
312 5821298 : for (; i<lx; i++)
313 3697254 : if (typ(gel(x,i)) != t) break;
314 2126382 : z = catmany(x + 1, x + i-1, t);
315 : }
316 2129383 : 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 2126415 : 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 16653016 : matfill(GEN M, GEN c, long xoff, long yoff, long n)
337 : {
338 : long i, j, h, l;
339 16653016 : l = lg(c); if (l == 1) return;
340 16625390 : 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 162115 : case t_COL:
347 1189939 : for (i = 1; i < l; i++)
348 1027824 : gcoeff(M,xoff+i,yoff+1) = gel(c,i);
349 162115 : break;
350 9353473 : case t_MAT:
351 9353473 : h = lgcols(c);
352 27759584 : for (j = 1; j < l; j++)
353 74412038 : for (i = 1; i < h; i++) gcoeff(M,xoff+i,yoff+j) = gcoeff(c,i,j);
354 9353473 : break;
355 7065527 : default:
356 15956861 : for (i = 1; i <= n; i++)
357 8891334 : gcoeff(M, xoff+i, yoff+i) = c;
358 7065527 : break;
359 : }
360 : }
361 :
362 : static GEN
363 18775587 : _matsize(GEN x)
364 : {
365 18775587 : long t = typ(x), L = lg(x) - 1;
366 18775587 : switch(t)
367 : { /* matsize */
368 88564 : case t_VEC: return mkvecsmall2(1, L);
369 324174 : case t_COL: return mkvecsmall2(L, 1);
370 11295838 : case t_MAT: return mkvecsmall2(L? nbrows(x): 0, L);
371 7067011 : default:
372 7067011 : if (is_noncalc_t(t)) pari_err_TYPE("_matsize", x);
373 7067013 : return mkvecsmall2(1, 1);
374 : }
375 : }
376 :
377 : GEN
378 3691501 : shallowmatconcat(GEN v)
379 : {
380 3691501 : long i, j, h, l = lg(v), L = 0, H = 0;
381 : GEN M, maxh, maxl;
382 3691501 : if (l == 1) return cgetg(1,t_MAT);
383 3686345 : switch(typ(v))
384 : {
385 1000711 : case t_VEC:
386 3077188 : for (i = 1; i < l; i++)
387 : {
388 2076482 : GEN c = gel(v,i);
389 2076482 : GEN s = _matsize(c);
390 2076478 : H = maxss(H, s[1]);
391 2076477 : L += s[2];
392 : }
393 1000706 : M = zeromatcopy(H, L);
394 1000715 : L = 0;
395 3077214 : for (i = 1; i < l; i++)
396 : {
397 2076490 : GEN c = gel(v,i);
398 2076490 : GEN s = _matsize(c);
399 2076495 : matfill(M, c, 0, L, 1);
400 2076499 : L += s[2];
401 : }
402 1000724 : return M;
403 :
404 3675 : case t_COL:
405 49812 : for (i = 1; i < l; i++)
406 : {
407 46137 : GEN c = gel(v,i);
408 46137 : GEN s = _matsize(c);
409 46137 : H += s[1];
410 46137 : L = maxss(L, s[2]);
411 : }
412 3675 : M = zeromatcopy(H, L);
413 3675 : H = 0;
414 49812 : for (i = 1; i < l; i++)
415 : {
416 46137 : GEN c = gel(v,i);
417 46137 : GEN s = _matsize(c);
418 46137 : matfill(M, c, H, 0, 1);
419 46137 : H += s[1];
420 : }
421 3675 : return M;
422 2681959 : case t_MAT:
423 2681959 : h = lgcols(v);
424 2681959 : maxh = zero_zv(h-1);
425 2681957 : maxl = zero_zv(l-1);
426 8806362 : for (j = 1; j < l; j++)
427 20654794 : for (i = 1; i < h; i++)
428 : {
429 14530388 : GEN c = gcoeff(v,i,j);
430 14530388 : GEN s = _matsize(c);
431 14530392 : if (s[1] > maxh[i]) maxh[i] = s[1];
432 14530392 : if (s[2] > maxl[j]) maxl[j] = s[2];
433 : }
434 8806374 : for (i = 1, H = 0; i < h; i++) H += maxh[i];
435 8806367 : for (j = 1, L = 0; j < l; j++) L += maxl[j];
436 2681960 : M = zeromatcopy(H, L);
437 8806365 : for (j = 1, L = 0; j < l; j++)
438 : {
439 20654795 : for (i = 1, H = 0; i < h; i++)
440 : {
441 14530390 : GEN c = gcoeff(v,i,j);
442 14530390 : matfill(M, c, H, L, minss(maxh[i], maxl[j]));
443 14530390 : H += maxh[i];
444 : }
445 6124405 : L += maxl[j];
446 : }
447 2681960 : 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 19425244 : gconcat(GEN x, GEN y)
462 : {
463 : long tx, lx,ty,ly,i;
464 : GEN z,p1;
465 :
466 19425244 : if (!y) return gconcat1(x);
467 19424404 : tx = typ(x);
468 19424404 : ty = typ(y);
469 19424404 : if (tx==t_STR || ty==t_STR)
470 : {
471 7 : pari_sp av = avma;
472 7 : return gerepileuptoleaf(av, strconcat(x,y));
473 : }
474 19424397 : if (tx==t_LIST || ty==t_LIST) return listconcat(x,y);
475 19424376 : lx=lg(x); ly=lg(y);
476 :
477 19424376 : 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 19423788 : 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 19423767 : if (tx == ty)
491 : {
492 653453 : if (tx == t_MAT && lgcols(x) != lgcols(y)) err_cat(x,y);
493 653453 : 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 653243 : z=cgetg(lx+ly-1,tx);
502 3304316 : for (i=1; i<lx; i++) gel(z,i) = gcopy(gel(x,i));
503 2529458 : for (i=1; i<ly; i++) gel(z,lx+i-1)= gcopy(gel(y,i));
504 653243 : return z;
505 : }
506 :
507 18770314 : 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 18770146 : if (! is_matvec_t(ty))
521 : {
522 18770048 : z=cgetg(lx+1,tx);
523 18770048 : 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 2547662453 : for (i=1; i<lx; i++) gel(z,i) = gcopy(gel(x,i));
530 18770041 : 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 : }
|
