Code coverage tests

This page documents the degree to which the PARI/GP source code is tested by our public test suite, distributed with the source distribution in directory src/test/. This is measured by the gcov utility; we then process gcov output using the lcov frond-end.

We test a few variants depending on Configure flags on the pari.math.u-bordeaux.fr machine (x86_64 architecture), and agregate them in the final report:

The target is to exceed 90% coverage for all mathematical modules (given that branches depending on DEBUGLEVEL or DEBUGMEM are not covered). This script is run to produce the results below.

LCOV - code coverage report
Current view: top level - basemath - alglin3.c (source / functions) Hit Total Coverage
Test: PARI/GP v2.12.0 lcov report (development 23712-7b25a218b) Lines: 480 521 92.1 %
Date: 2019-03-24 05:44:59 Functions: 44 50 88.0 %
Legend: Lines: hit not hit

          Line data    Source code
       1             : /* Copyright (C) 2012  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. It is distributed in the hope that it will be useful, but WITHOUT
       8             : ANY WARRANTY WHATSOEVER.
       9             : 
      10             : Check the License for details. You should have received a copy of it, along
      11             : with the package; see the file 'COPYING'. If not, write to the Free Software
      12             : Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
      13             : 
      14             : /********************************************************************/
      15             : /**                                                                **/
      16             : /**                         LINEAR ALGEBRA                         **/
      17             : /**                          (third part)                          **/
      18             : /**                                                                **/
      19             : /********************************************************************/
      20             : #include "pari.h"
      21             : #include "paripriv.h"
      22             : 
      23             : /*******************************************************************/
      24             : /*                                                                 */
      25             : /*                               SUM                               */
      26             : /*                                                                 */
      27             : /*******************************************************************/
      28             : 
      29             : GEN
      30      134031 : vecsum(GEN v)
      31             : {
      32      134031 :   pari_sp av = avma;
      33             :   long i, l;
      34             :   GEN p;
      35      134031 :   if (!is_vec_t(typ(v)))
      36           7 :     pari_err_TYPE("vecsum", v);
      37      134024 :   l = lg(v);
      38      134024 :   if (l == 1) return gen_0;
      39      134017 :   p = gel(v,1);
      40      134017 :   if (l == 2) return gcopy(p);
      41      288259 :   for (i=2; i<l; i++)
      42             :   {
      43      199382 :     p = gadd(p, gel(v,i));
      44      199382 :     if (gc_needed(av, 2))
      45             :     {
      46           0 :       if (DEBUGMEM>1) pari_warn(warnmem,"sum");
      47           0 :       p = gerepileupto(av, p);
      48             :     }
      49             :   }
      50       88877 :   return gerepileupto(av, p);
      51             : }
      52             : 
      53             : /*******************************************************************/
      54             : /*                                                                 */
      55             : /*                         TRANSPOSE                               */
      56             : /*                                                                 */
      57             : /*******************************************************************/
      58             : /* A[x0,]~ */
      59             : static GEN
      60     9118870 : row_transpose(GEN A, long x0)
      61             : {
      62     9118870 :   long i, lB = lg(A);
      63     9118870 :   GEN B  = cgetg(lB, t_COL);
      64     9118870 :   for (i=1; i<lB; i++) gel(B, i) = gcoeff(A, x0, i);
      65     9118870 :   return B;
      66             : }
      67             : static GEN
      68       18599 : row_transposecopy(GEN A, long x0)
      69             : {
      70       18599 :   long i, lB = lg(A);
      71       18599 :   GEN B  = cgetg(lB, t_COL);
      72       18599 :   for (i=1; i<lB; i++) gel(B, i) = gcopy(gcoeff(A, x0, i));
      73       18599 :   return B;
      74             : }
      75             : 
      76             : /* No copy*/
      77             : GEN
      78     2599240 : shallowtrans(GEN x)
      79             : {
      80             :   long i, dx, lx;
      81             :   GEN y;
      82     2599240 :   switch(typ(x))
      83             :   {
      84         189 :     case t_VEC: y = leafcopy(x); settyp(y,t_COL); break;
      85       17073 :     case t_COL: y = leafcopy(x); settyp(y,t_VEC); break;
      86             :     case t_MAT:
      87     2581978 :       lx = lg(x); if (lx==1) return cgetg(1,t_MAT);
      88     2581978 :       dx = lgcols(x); y = cgetg(dx,t_MAT);
      89     2581978 :       for (i = 1; i < dx; i++) gel(y,i) = row_transpose(x,i);
      90     2581978 :       break;
      91           0 :     default: pari_err_TYPE("shallowtrans",x); return NULL;
      92             :   }
      93     2599240 :   return y;
      94             : }
      95             : 
      96             : GEN
      97       39872 : gtrans(GEN x)
      98             : {
      99             :   long i, dx, lx;
     100             :   GEN y;
     101       39872 :   switch(typ(x))
     102             :   {
     103       34937 :     case t_VEC: y = gcopy(x); settyp(y,t_COL); break;
     104        2946 :     case t_COL: y = gcopy(x); settyp(y,t_VEC); break;
     105             :     case t_MAT:
     106        1982 :       lx = lg(x); if (lx==1) return cgetg(1,t_MAT);
     107        1975 :       dx = lgcols(x); y = cgetg(dx,t_MAT);
     108        1975 :       for (i = 1; i < dx; i++) gel(y,i) = row_transposecopy(x,i);
     109        1975 :       break;
     110           7 :     default: pari_err_TYPE("gtrans",x); return NULL;
     111             :   }
     112       39858 :   return y;
     113             : }
     114             : 
     115             : /*******************************************************************/
     116             : /*                                                                 */
     117             : /*                           EXTRACTION                            */
     118             : /*                                                                 */
     119             : /*******************************************************************/
     120             : 
     121             : static long
     122         182 : str_to_long(char *s, char **pt)
     123             : {
     124         182 :   long a = atol(s);
     125         182 :   while (isspace((int)*s)) s++;
     126         182 :   if (*s == '-' || *s == '+') s++;
     127         182 :   while (isdigit((int)*s) || isspace((int)*s)) s++;
     128         182 :   *pt = s; return a;
     129             : }
     130             : 
     131             : static int
     132         112 : get_range(char *s, long *a, long *b, long *cmpl, long lx)
     133             : {
     134         112 :   long max = lx - 1;
     135             : 
     136         112 :   *a = 1; *b = max;
     137         112 :   if (*s == '^') { *cmpl = 1; s++; } else *cmpl = 0;
     138         112 :   if (!*s) return 0;
     139         112 :   if (*s != '.')
     140             :   {
     141         105 :     *a = str_to_long(s, &s);
     142         105 :     if (*a < 0) *a += lx;
     143         105 :     if (*a<1 || *a>max) return 0;
     144             :   }
     145         112 :   if (*s == '.')
     146             :   {
     147         105 :     s++; if (*s != '.') return 0;
     148         105 :     do s++; while (isspace((int)*s));
     149         105 :     if (*s)
     150             :     {
     151          77 :       *b = str_to_long(s, &s);
     152          77 :       if (*b < 0) *b += lx;
     153          77 :       if (*b<1 || *b>max || *s) return 0;
     154             :     }
     155          98 :     return 1;
     156             :   }
     157           7 :   if (*s) return 0;
     158           7 :   *b = *a; return 1;
     159             : }
     160             : 
     161             : static int
     162          35 : extract_selector_ok(long lx, GEN L)
     163             : {
     164             :   long i, l;
     165          35 :   switch (typ(L))
     166             :   {
     167             :     case t_INT: {
     168             :       long maxj;
     169           7 :       if (!signe(L)) return 1;
     170           7 :       l = lgefint(L)-1;
     171           7 :       maxj = BITS_IN_LONG - bfffo(*int_MSW(L));
     172           7 :       return ((l-2) * BITS_IN_LONG + maxj < lx);
     173             :     }
     174             :     case t_STR: {
     175             :       long first, last, cmpl;
     176           7 :       return get_range(GSTR(L), &first, &last, &cmpl, lx);
     177             :     }
     178             :     case t_VEC: case t_COL:
     179          14 :       l = lg(L);
     180          28 :       for (i=1; i<l; i++)
     181             :       {
     182          21 :         long j = itos(gel(L,i));
     183          21 :         if (j>=lx || j<=0) return 0;
     184             :       }
     185           7 :       return 1;
     186             :     case t_VECSMALL:
     187           7 :       l = lg(L);
     188          21 :       for (i=1; i<l; i++)
     189             :       {
     190          14 :         long j = L[i];
     191          14 :         if (j>=lx || j<=0) return 0;
     192             :       }
     193           7 :       return 1;
     194             :   }
     195           0 :   return 0;
     196             : }
     197             : 
     198             : GEN
     199        9436 : shallowmatextract(GEN x, GEN l1, GEN l2)
     200             : {
     201        9436 :   long i, j, n1 = lg(l1), n2 = lg(l2);
     202        9436 :   GEN M = cgetg(n2, t_MAT);
     203       60102 :   for(i=1; i < n2; i++)
     204             :   {
     205       50666 :     long ii = l2[i];
     206       50666 :     GEN C = cgetg(n1, t_COL);
     207      671874 :     for (j=1; j < n1; j++)
     208             :     {
     209      621208 :       long jj = l1[j];
     210      621208 :       gel(C, j) = gmael(x, ii, jj);
     211             :     }
     212       50666 :     gel(M, i) = C;
     213             :   }
     214        9436 :   return M;
     215             : }
     216             : 
     217             : GEN
     218       36176 : shallowextract(GEN x, GEN L)
     219             : {
     220       36176 :   long i,j, tl = typ(L), tx = typ(x), lx = lg(x);
     221             :   GEN y;
     222             : 
     223       36176 :   switch(tx)
     224             :   {
     225             :     case t_VEC:
     226             :     case t_COL:
     227             :     case t_MAT:
     228       36169 :     case t_VECSMALL: break;
     229           7 :     default: pari_err_TYPE("extract",x);
     230             : 
     231             :   }
     232       36169 :   if (tl==t_INT)
     233             :   { /* extract components of x as per the bits of mask L */
     234             :     long k, l, ix, iy, maxj;
     235             :     GEN Ld;
     236        3276 :     if (!signe(L)) return cgetg(1,tx);
     237        3269 :     y = new_chunk(lx);
     238        3269 :     l = lgefint(L)-1; ix = iy = 1;
     239        3269 :     maxj = BITS_IN_LONG - bfffo(*int_MSW(L));
     240        3269 :     if ((l-2) * BITS_IN_LONG + maxj >= lx)
     241           7 :       pari_err_TYPE("vecextract [mask too large]", L);
     242        3637 :     for (k = 2, Ld = int_LSW(L); k < l; k++, Ld = int_nextW(Ld))
     243             :     {
     244         375 :       ulong B = *Ld;
     245       20439 :       for (j = 0; j < BITS_IN_LONG; j++, B >>= 1, ix++)
     246       20064 :         if (B & 1) y[iy++] = x[ix];
     247             :     }
     248             :     { /* k = l */
     249        3262 :       ulong B = *Ld;
     250       28397 :       for (j = 0; j < maxj; j++, B >>= 1, ix++)
     251       25135 :         if (B & 1) y[iy++] = x[ix];
     252             :     }
     253        3262 :     y[0] = evaltyp(tx) | evallg(iy);
     254        3262 :     return y;
     255             :   }
     256       32893 :   if (tl==t_STR)
     257             :   {
     258         105 :     char *s = GSTR(L);
     259             :     long first, last, cmpl, d;
     260         105 :     if (! get_range(s, &first, &last, &cmpl, lx))
     261           7 :       pari_err_TYPE("vecextract [incorrect range]", L);
     262          98 :     if (lx == 1) return cgetg(1,tx);
     263          98 :     d = last - first;
     264          98 :     if (cmpl)
     265             :     {
     266          21 :       if (d >= 0)
     267             :       {
     268          14 :         y = cgetg(lx - (1+d),tx);
     269          14 :         for (j=1; j<first; j++) gel(y,j) = gel(x,j);
     270          14 :         for (i=last+1; i<lx; i++,j++) gel(y,j) = gel(x,i);
     271             :       }
     272             :       else
     273             :       {
     274           7 :         y = cgetg(lx - (1-d),tx);
     275           7 :         for (j=1,i=lx-1; i>first; i--,j++) gel(y,j) = gel(x,i);
     276           7 :         for (i=last-1; i>0; i--,j++) gel(y,j) = gel(x,i);
     277             :       }
     278             :     }
     279             :     else
     280             :     {
     281          77 :       if (d >= 0)
     282             :       {
     283          35 :         y = cgetg(d+2,tx);
     284          35 :         for (i=first,j=1; i<=last; i++,j++) gel(y,j) = gel(x,i);
     285             :       }
     286             :       else
     287             :       {
     288          42 :         y = cgetg(2-d,tx);
     289          42 :         for (i=first,j=1; i>=last; i--,j++) gel(y,j) = gel(x,i);
     290             :       }
     291             :     }
     292          98 :     return y;
     293             :   }
     294             : 
     295       32788 :   if (is_vec_t(tl))
     296             :   {
     297          63 :     long ll=lg(L); y=cgetg(ll,tx);
     298         140 :     for (i=1; i<ll; i++)
     299             :     {
     300          91 :       j = itos(gel(L,i));
     301          91 :       if (j<=0) pari_err_COMPONENT("vecextract","<=",gen_0,stoi(j));
     302          84 :       if (j>=lx) pari_err_COMPONENT("vecextract",">=",stoi(lx),stoi(j));
     303          77 :       gel(y,i) = gel(x,j);
     304             :     }
     305          49 :     return y;
     306             :   }
     307       32725 :   if (tl == t_VECSMALL)
     308             :   {
     309       32718 :     long ll=lg(L); y=cgetg(ll,tx);
     310      141653 :     for (i=1; i<ll; i++)
     311             :     {
     312      108935 :       j = L[i];
     313      108935 :       if (j<=0) pari_err_COMPONENT("vecextract","<=",gen_0,stoi(j));
     314      108935 :       if (j>=lx) pari_err_COMPONENT("vecextract",">=",stoi(lx),stoi(j));
     315      108935 :       gel(y,i) = gel(x,j);
     316             :     }
     317       32718 :     return y;
     318             :   }
     319           7 :   pari_err_TYPE("vecextract [mask]", L);
     320             :   return NULL; /* LCOV_EXCL_LINE */
     321             : }
     322             : 
     323             : /* does the component selector l select 0 component ? */
     324             : static int
     325         105 : select_0(GEN l)
     326             : {
     327         105 :   switch(typ(l))
     328             :   {
     329             :     case t_INT:
     330          14 :       return (!signe(l));
     331             :     case t_VEC: case t_COL: case t_VECSMALL:
     332          70 :       return (lg(l) == 1);
     333             :   }
     334          21 :   return 0;
     335             : }
     336             : 
     337             : GEN
     338       28056 : extract0(GEN x, GEN l1, GEN l2)
     339             : {
     340       28056 :   pari_sp av = avma, av2;
     341             :   GEN y;
     342       28056 :   if (! l2)
     343             :   {
     344       27951 :     y = shallowextract(x, l1);
     345       27909 :     if (lg(y) == 1 || typ(y) == t_VECSMALL) return y;
     346       27902 :     av2 = avma;
     347       27902 :     y = gcopy(y);
     348             :   }
     349             :   else
     350             :   {
     351         105 :     if (typ(x) != t_MAT) pari_err_TYPE("extract",x);
     352         105 :     y = shallowextract(x,l2);
     353         105 :     if (select_0(l1)) { set_avma(av); return zeromat(0, lg(y)-1); }
     354          91 :     if (lg(y) == 1 && lg(x) > 1)
     355             :     {
     356          35 :       if (!extract_selector_ok(lgcols(x), l1))
     357           7 :         pari_err_TYPE("vecextract [incorrect mask]", l1);
     358          28 :       set_avma(av); return cgetg(1, t_MAT);
     359             :     }
     360          56 :     y = shallowextract(shallowtrans(y), l1);
     361          56 :     av2 = avma;
     362          56 :     y = gtrans(y);
     363             :   }
     364       27958 :   stackdummy(av, av2);
     365       27958 :   return y;
     366             : }
     367             : 
     368             : static long
     369        5020 : vecslice_parse_arg(long lA, long *y1, long *y2, long *skip)
     370             : {
     371        5020 :   *skip=0;
     372        5020 :   if (*y1==LONG_MAX)
     373             :   {
     374         182 :     if (*y2!=LONG_MAX)
     375             :     {
     376          91 :       if (*y2<0) *y2 += lA;
     377          91 :       if (*y2<0 || *y2==LONG_MAX || *y2>=lA)
     378           0 :         pari_err_DIM("_[..]");
     379          91 :       *skip=*y2;
     380             :     }
     381         182 :     *y1 = 1; *y2 = lA-1;
     382             :   }
     383        4838 :   else if (*y2==LONG_MAX) *y2 = *y1;
     384        5020 :   if (*y1<=0) *y1 += lA;
     385        5020 :   if (*y2<0) *y2 += lA;
     386        5020 :   if (*y1<=0 || *y1>*y2+1 || *y2>=lA) pari_err_DIM("_[..]");
     387        5006 :   return *y2 - *y1 + 2 - !!*skip;
     388             : }
     389             : 
     390             : static GEN
     391        5503 : vecslice_i(GEN A, long t, long lB, long y1, long skip)
     392             : {
     393        5503 :   GEN B = cgetg(lB, t);
     394             :   long i;
     395      143905 :   for (i=1; i<lB; i++, y1++)
     396             :   {
     397      138402 :     if (y1 == skip) { i--; continue; }
     398      138311 :     gel(B,i) = gcopy(gel(A,y1));
     399             :   }
     400        5503 :   return B;
     401             : }
     402             : 
     403             : static GEN
     404          14 : rowslice_i(GEN A, long lB, long x1, long y1, long skip)
     405             : {
     406          14 :   GEN B = cgetg(lB, t_VEC);
     407             :   long i;
     408          77 :   for (i=1; i<lB; i++, y1++)
     409             :   {
     410          63 :     if (y1 == skip) { i--; continue; }
     411          56 :     gel(B,i) = gcopy(gcoeff(A,x1,y1));
     412             :   }
     413          14 :   return B;
     414             : }
     415             : 
     416             : static GEN
     417           0 : rowsmallslice_i(GEN A, long lB, long x1, long y1, long skip)
     418             : {
     419           0 :   GEN B = cgetg(lB, t_VECSMALL);
     420             :   long i;
     421           0 :   for (i=1; i<lB; i++, y1++)
     422             :   {
     423           0 :     if (y1 == skip) { i--; continue; }
     424           0 :     B[i] = coeff(A,x1,y1);
     425             :   }
     426           0 :   return B;
     427             : }
     428             : 
     429             : static GEN
     430          28 : vecsmallslice_i(GEN A, long t, long lB, long y1, long skip)
     431             : {
     432          28 :   GEN B = cgetg(lB, t);
     433             :   long i;
     434         126 :   for (i=1; i<lB; i++, y1++)
     435             :   {
     436          98 :     if (y1 == skip) { i--; continue; }
     437          91 :     B[i] = A[y1];
     438             :   }
     439          28 :   return B;
     440             : }
     441             : GEN
     442        4677 : vecslice0(GEN A, long y1, long y2)
     443             : {
     444        4677 :   long skip, lB, t = typ(A);
     445        4677 :   switch(t)
     446             :   {
     447             :     case t_VEC: case t_COL:
     448        4579 :       lB = vecslice_parse_arg(lg(A), &y1, &y2, &skip);
     449        4565 :       return vecslice_i(A, t,lB,y1,skip);
     450             :     case t_VECSMALL:
     451          28 :       lB = vecslice_parse_arg(lg(A), &y1, &y2, &skip);
     452          28 :       return vecsmallslice_i(A, t,lB,y1,skip);
     453             :     case t_LIST:
     454          63 :       if (list_typ(A) == t_LIST_RAW)
     455             :       {
     456          63 :         GEN y, z = list_data(A);
     457          63 :         long l = z? lg(z): 1;
     458          63 :         lB = vecslice_parse_arg(l, &y1, &y2, &skip);
     459          63 :         y = mklist(); if (!z) return y;
     460          63 :         list_data(y) = vecslice_i(z, t_VEC,lB,y1,skip);
     461          63 :         return y;
     462             :       }
     463             :     default:
     464           7 :       pari_err_TYPE("_[_.._]",A);
     465             :       return NULL;/*LCOV_EXCL_LINE*/
     466             :   }
     467             : }
     468             : 
     469             : GEN
     470         182 : matslice0(GEN A, long x1, long x2, long y1, long y2)
     471             : {
     472             :   GEN B;
     473         182 :   long i, lB, lA = lg(A), rA, t, skip, rskip, rlB;
     474         182 :   long is_col = y1!=LONG_MAX && y2==LONG_MAX;
     475         182 :   long is_row = x1!=LONG_MAX && x2==LONG_MAX;
     476             :   GEN (*slice)(GEN A, long t, long lB, long y1, long skip);
     477         182 :   if (typ(A)!=t_MAT) pari_err_TYPE("_[_.._,_.._]",A);
     478         182 :   lB = vecslice_parse_arg(lA, &y1, &y2, &skip);
     479         182 :   if (is_col) return vecslice0(gel(A, y1), x1, x2);
     480         168 :   rA = lg(A)==1 ? 1: lgcols(A);
     481         168 :   rlB = vecslice_parse_arg(rA, &x1, &x2, &rskip);
     482         168 :   t = lg(A)==1 ? t_COL: typ(gel(A,1));
     483         168 :   if (is_row) return t == t_COL ? rowslice_i(A, lB, x1, y1, skip):
     484           0 :                                   rowsmallslice_i(A, lB, x1, y1, skip);
     485         154 :   slice = t == t_COL? &vecslice_i: &vecsmallslice_i;
     486             : 
     487         154 :   B = cgetg(lB, t_MAT);
     488        1043 :   for (i=1; i<lB; i++, y1++)
     489             :   {
     490         889 :     if (y1 == skip) { i--; continue; }
     491         875 :     gel(B,i) = slice(gel(A,y1),t,rlB, x1, rskip);
     492             :   }
     493         154 :   return B;
     494             : }
     495             : 
     496             : GEN
     497       10002 : vecrange(GEN a, GEN b)
     498             : {
     499             :   GEN y;
     500             :   long i, l;
     501       10002 :   if (typ(a)!=t_INT) pari_err_TYPE("[_.._]",a);
     502        9995 :   if (typ(b)!=t_INT) pari_err_TYPE("[_.._]",b);
     503        9988 :   if (cmpii(a,b)>0) return cgetg(1,t_VEC);
     504        9981 :   l = itos(subii(b,a))+1;
     505        9981 :   a = setloop(a);
     506        9981 :   y = cgetg(l+1, t_VEC);
     507        9981 :   for (i=1; i<=l; a = incloop(a), i++) gel(y,i) = icopy(a);
     508        9981 :   return y;
     509             : }
     510             : 
     511             : GEN
     512           0 : vecrangess(long a, long b)
     513             : {
     514             :   GEN y;
     515             :   long i, l;
     516           0 :   if (a>b) return cgetg(1,t_VEC);
     517           0 :   l = b-a+1;
     518           0 :   y = cgetg(l+1, t_VEC);
     519           0 :   for (i=1; i<=l; a++, i++) gel(y,i) = stoi(a);
     520           0 :   return y;
     521             : }
     522             : 
     523             : GEN
     524          88 : genindexselect(void *E, long (*f)(void* E, GEN x), GEN A)
     525             : {
     526             :   long l, i, lv;
     527             :   GEN v, z;
     528             :   pari_sp av;
     529          88 :   clone_lock(A);
     530          88 :   switch(typ(A))
     531             :   {
     532             :     case t_LIST:
     533           7 :       z = list_data(A);
     534           7 :       l = z? lg(z): 1;
     535           7 :       break;
     536             :     case t_VEC: case t_COL: case t_MAT:
     537          74 :       l = lg(A);
     538          74 :       z = A;
     539          74 :       break;
     540             :     default:
     541           7 :       pari_err_TYPE("select",A);
     542             :       return NULL;/*LCOV_EXCL_LINE*/
     543             :   }
     544          81 :   v = cgetg(l, t_VECSMALL);
     545          81 :   av = avma;
     546        4785 :   for (i = lv = 1; i < l; i++) {
     547        4704 :     if (f(E, gel(z,i))) v[lv++] = i;
     548        4704 :     set_avma(av);
     549             :   }
     550          81 :   clone_unlock_deep(A); fixlg(v, lv); return v;
     551             : }
     552             : static GEN
     553          76 : extract_copy(GEN A, GEN v)
     554             : {
     555          76 :   long i, l = lg(v);
     556          76 :   GEN B = cgetg(l, typ(A));
     557          76 :   for (i = 1; i < l; i++) gel(B,i) = gcopy(gel(A,v[i]));
     558          76 :   return B;
     559             : }
     560             : /* as genselect, but treat A [ t_VEC,t_COL, or t_MAT] as a t_VEC */
     561             : GEN
     562           0 : vecselect(void *E, long (*f)(void* E, GEN x), GEN A)
     563             : {
     564             :   GEN v;
     565           0 :   clone_lock(A);
     566           0 :   v = genindexselect(E, f, A);
     567           0 :   A = extract_copy(A, v); settyp(A, t_VEC);
     568           0 :   clone_unlock_deep(A); return A;
     569             : }
     570             : GEN
     571          79 : genselect(void *E, long (*f)(void* E, GEN x), GEN A)
     572             : {
     573             :   GEN y, z, v;/* v left on stack for efficiency */
     574          79 :   clone_lock(A);
     575          79 :   switch(typ(A))
     576             :   {
     577             :     case t_LIST:
     578          14 :       z = list_data(A);
     579          14 :       if (!z) y = mklist();
     580             :       else
     581             :       {
     582             :         GEN B;
     583          14 :         y = cgetg(3, t_LIST);
     584          14 :         v = genindexselect(E, f, z);
     585          14 :         B = extract_copy(z, v);
     586          14 :         y[1] = lg(B)-1;
     587          14 :         list_data(y) = B;
     588             :       }
     589          14 :       break;
     590             :     case t_VEC: case t_COL: case t_MAT:
     591          58 :       v = genindexselect(E, f, A);
     592          58 :       y = extract_copy(A, v);
     593          58 :       break;
     594             :     default:
     595           7 :       pari_err_TYPE("select",A);
     596             :       return NULL;/*LCOV_EXCL_LINE*/
     597             :   }
     598          72 :   clone_unlock_deep(A); return y;
     599             : }
     600             : 
     601             : static void
     602        9092 : check_callgen1(GEN f, const char *s)
     603             : {
     604        9092 :   if (typ(f) != t_CLOSURE || closure_is_variadic(f)  || closure_arity(f) < 1)
     605           0 :     pari_err_TYPE(s, f);
     606        9092 : }
     607             : 
     608             : GEN
     609          95 : select0(GEN f, GEN x, long flag)
     610             : {
     611          95 :   check_callgen1(f, "select");
     612          95 :   switch(flag)
     613             :   {
     614          79 :     case 0: return genselect((void *) f, gp_callbool, x);
     615          16 :     case 1: return genindexselect((void *) f, gp_callbool, x);
     616           0 :     default: pari_err_FLAG("select");
     617             :              return NULL;/*LCOV_EXCL_LINE*/
     618             :   }
     619             : }
     620             : 
     621             : GEN
     622        7882 : parselect_worker(GEN d, GEN C)
     623             : {
     624        7882 :   return gequal0(closure_callgen1(C, d))? gen_0: gen_1;
     625             : }
     626             : 
     627             : GEN
     628           8 : parselect(GEN C, GEN D, long flag)
     629             : {
     630             :   pari_sp av;
     631           8 :   long lv, l = lg(D), i;
     632             :   GEN V, W, worker;
     633           8 :   check_callgen1(C, "parselect");
     634           8 :   if (!is_vec_t(typ(D))) pari_err_TYPE("parselect",D);
     635           8 :   W = cgetg(l, t_VECSMALL); av = avma;
     636           8 :   worker = strtoclosure("_parselect_worker", 1, C);
     637           8 :   V = gen_parapply(worker, D);
     638        8016 :   for (lv=1, i=1; i<l; i++)
     639        8008 :     if (signe(gel(V,i))) W[lv++] = i;
     640           8 :   fixlg(W, lv);
     641           8 :   set_avma(av);
     642           8 :   return flag? W: extract_copy(D, W);
     643             : }
     644             : 
     645             : GEN
     646           0 : veccatapply(void *E, GEN (*f)(void* E, GEN x), GEN x)
     647             : {
     648           0 :   pari_sp av = avma;
     649           0 :   GEN v = vecapply(E, f, x);
     650           0 :   return lg(v) == 1? v: gerepilecopy(av, shallowconcat1(v));
     651             : }
     652             : 
     653             : static GEN
     654          14 : vecapply2(void *E, GEN (*f)(void* E, GEN x), GEN x)
     655             : {
     656             :   long i, lx;
     657          14 :   GEN y = cgetg_copy(x, &lx); y[1] = x[1];
     658          14 :   for (i=2; i<lx; i++) gel(y,i) = f(E, gel(x,i));
     659          14 :   return y;
     660             : }
     661             : static GEN
     662      123571 : vecapply1(void *E, GEN (*f)(void* E, GEN x), GEN x)
     663             : {
     664             :   long i, lx;
     665      123571 :   GEN y = cgetg_copy(x, &lx);
     666      123571 :   for (i=1; i<lx; i++) gel(y,i) = f(E, gel(x,i));
     667      123571 :   return y;
     668             : }
     669             : static GEN
     670           7 : mapapply1(void *E, GEN (*f)(void* E, GEN x), GEN x)
     671             : {
     672             :   long i, lx;
     673           7 :   GEN y = cgetg_copy(x, &lx);
     674          28 :   for (i=1; i<lx; i++)
     675             :   {
     676          21 :     GEN xi = gel(x, i);
     677          42 :     gel(y,i) = mkvec2(mkvec2(gcopy(gmael(xi, 1, 1)), f(E,gmael(xi, 1, 2))),
     678          21 :                              gcopy(gel(xi, 2)));
     679             :   }
     680           7 :   return y;
     681             : }
     682             : /* as genapply, but treat A [ t_VEC,t_COL, or t_MAT] as a t_VEC */
     683             : GEN
     684      114772 : vecapply(void *E, GEN (*f)(void* E, GEN x), GEN x)
     685             : {
     686             :   GEN y;
     687      114772 :   clone_lock(x); y = vecapply1(E,f,x);
     688      114772 :   clone_unlock_deep(x); settyp(y, t_VEC); return y;
     689             : }
     690             : GEN
     691        8785 : genapply(void *E, GEN (*f)(void* E, GEN x), GEN x)
     692             : {
     693        8785 :   long i, lx, tx = typ(x);
     694             :   GEN y, z;
     695        8785 :   if (is_scalar_t(tx)) return f(E, x);
     696        8785 :   clone_lock(x);
     697        8785 :   switch(tx) {
     698           7 :     case t_POL: y = normalizepol(vecapply2(E,f,x)); break;
     699             :     case t_SER:
     700           7 :       y = ser_isexactzero(x)? gcopy(x): normalize(vecapply2(E,f,x));
     701           7 :       break;
     702             :     case t_LIST:
     703             :       {
     704          28 :         long t = list_typ(x);
     705          28 :         z = list_data(x);
     706          28 :         if (!z)
     707           7 :           y = mklist_typ(t);
     708             :         else
     709             :         {
     710          21 :           y = cgetg(3, t_LIST);
     711          21 :           y[1] = evaltyp(t)|evallg(lg(z)-1);
     712          21 :           switch(t)
     713             :           {
     714             :           case t_LIST_RAW:
     715          14 :             list_data(y) = vecapply1(E,f,z);
     716          14 :             break;
     717             :           case t_LIST_MAP:
     718           7 :             list_data(y) = mapapply1(E,f,z);
     719           7 :             break;
     720             :           }
     721             :         }
     722             :       }
     723          28 :       break;
     724             :     case t_MAT:
     725          42 :       y = cgetg_copy(x, &lx);
     726          42 :       for (i = 1; i < lx; i++) gel(y,i) = vecapply1(E,f,gel(x,i));
     727          42 :       break;
     728             : 
     729        8701 :     case t_VEC: case t_COL: y = vecapply1(E,f,x); break;
     730             :     default:
     731           0 :       pari_err_TYPE("apply",x);
     732             :       return NULL;/*LCOV_EXCL_LINE*/
     733             :   }
     734        8785 :   clone_unlock_deep(x); return y;
     735             : }
     736             : 
     737             : GEN
     738        8785 : apply0(GEN f, GEN x)
     739             : {
     740        8785 :   check_callgen1(f, "apply");
     741        8785 :   return genapply((void *) f, gp_call, x);
     742             : }
     743             : 
     744             : GEN
     745         343 : vecselapply(void *Epred, long (*pred)(void* E, GEN x), void *Efun,
     746             :                          GEN (*fun)(void* E, GEN x), GEN A)
     747             : {
     748             :   GEN y;
     749         343 :   long i, l = lg(A), nb=1;
     750         343 :   clone_lock(A); y = cgetg(l, t_VEC);
     751      168175 :   for (i=1; i<l; i++)
     752      167832 :     if (pred(Epred, gel(A,i))) gel(y,nb++) = fun(Efun, gel(A,i));
     753         343 :   fixlg(y,nb); clone_unlock_deep(A); return y;
     754             : }
     755             : 
     756             : GEN
     757           0 : veccatselapply(void *Epred, long (*pred)(void* E, GEN x), void *Efun,
     758             :                             GEN (*fun)(void* E, GEN x), GEN A)
     759             : {
     760           0 :   pari_sp av = avma;
     761           0 :   GEN v = vecselapply(Epred, pred, Efun, fun, A);
     762           0 :   return lg(v) == 1? v: gerepilecopy(av, shallowconcat1(v));
     763             : }
     764             : 
     765             : GEN
     766         214 : gen_parapply(GEN worker, GEN D)
     767             : {
     768         214 :   long l, i, pending = 0, workid;
     769             :   GEN V, W, done;
     770             :   struct pari_mt pt;
     771         214 :   W = cgetg(2, t_VEC);
     772         214 :   V = cgetg_copy(D, &l);
     773         214 :   mt_queue_start_lim(&pt, worker, l-1);
     774       14346 :   for (i=1; i<l || pending; i++)
     775             :   {
     776       14132 :     if (i<l) gel(W,1) = gel(D,i);
     777       14132 :     mt_queue_submit(&pt, i, i<l? W: NULL);
     778       14132 :     done = mt_queue_get(&pt, &workid, &pending);
     779       14132 :     if (done) gel(V,workid) = done;
     780             :   }
     781         214 :   mt_queue_end(&pt);
     782         214 :   return V;
     783             : }
     784             : 
     785             : GEN
     786         204 : parapply(GEN C, GEN D)
     787             : {
     788         204 :   pari_sp av = avma;
     789         204 :   check_callgen1(C, "parapply");
     790         204 :   if (!is_vec_t(typ(D))) pari_err_TYPE("parapply",D);
     791         204 :   return gerepileupto(av, gen_parapply(C, D));
     792             : }
     793             : 
     794             : GEN
     795          28 : genfold(void *E, GEN (*f)(void* E, GEN x, GEN y), GEN x)
     796             : {
     797          28 :   pari_sp av = avma;
     798             :   GEN z;
     799          28 :   long i, l = lg(x);
     800          28 :   if (!is_vec_t(typ(x))|| l==1  ) pari_err_TYPE("fold",x);
     801          28 :   clone_lock(x);
     802          28 :   z = gel(x,1);
     803         119 :   for (i=2; i<l; i++)
     804             :   {
     805          91 :     z = f(E,z,gel(x,i));
     806          91 :     if (gc_needed(av, 2))
     807             :     {
     808           0 :       if (DEBUGMEM>1) pari_warn(warnmem,"fold");
     809           0 :       z = gerepilecopy(av, z);
     810             :     }
     811             :   }
     812          28 :   clone_unlock_deep(x);
     813          28 :   return gerepilecopy(av, z);
     814             : }
     815             : 
     816             : GEN
     817          28 : fold0(GEN f, GEN x)
     818             : {
     819          28 :   if (typ(f) != t_CLOSURE || closure_arity(f) < 2) pari_err_TYPE("apply",f);
     820          28 :   return genfold((void *) f, gp_call2, x);
     821             : }
     822             : /*******************************************************************/
     823             : /*                                                                 */
     824             : /*                     SCALAR-MATRIX OPERATIONS                    */
     825             : /*                                                                 */
     826             : /*******************************************************************/
     827             : GEN
     828       88116 : gtomat(GEN x)
     829             : {
     830             :   long lx, i;
     831             :   GEN y;
     832             : 
     833       88116 :   if (!x) return cgetg(1, t_MAT);
     834       88102 :   switch(typ(x))
     835             :   {
     836             :     case t_LIST:
     837          28 :       if (list_typ(x)==t_LIST_MAP)
     838          14 :         return maptomat(x);
     839          14 :       x = list_data(x);
     840          14 :       if (!x) return cgetg(1, t_MAT);
     841             :       /* fall through */
     842             :     case t_VEC: {
     843        2667 :       lx=lg(x); y=cgetg(lx,t_MAT);
     844        2667 :       if (lx == 1) break;
     845        2667 :       if (typ(gel(x,1)) == t_COL) {
     846        2394 :         long h = lgcols(x);
     847        5649 :         for (i=2; i<lx; i++) {
     848        3255 :           if (typ(gel(x,i)) != t_COL || lg(gel(x,i)) != h) break;
     849             :         }
     850        2394 :         if (i == lx) { /* matrix with h-1 rows */
     851        2394 :           y = cgetg(lx, t_MAT);
     852        2394 :           for (i=1 ; i<lx; i++) gel(y,i) = gcopy(gel(x,i));
     853        2394 :           return y;
     854             :         }
     855             :       }
     856         273 :       for (i=1; i<lx; i++) gel(y,i) = mkcolcopy(gel(x,i));
     857         273 :       break;
     858             :     }
     859             :     case t_COL:
     860       23867 :       lx = lg(x);
     861       23867 :       if (lx == 1) return cgetg(1, t_MAT);
     862       23853 :       if (typ(gel(x,1)) == t_VEC) {
     863           7 :         long j, h = lg(gel(x,1));
     864          14 :         for (i=2; i<lx; i++) {
     865           7 :           if (typ(gel(x,i)) != t_VEC || lg(gel(x,i)) != h) break;
     866             :         }
     867           7 :         if (i == lx) { /* matrix with h cols */
     868           7 :           y = cgetg(h, t_MAT);
     869          28 :           for (j=1 ; j<h; j++) {
     870          21 :             gel(y,j) = cgetg(lx, t_COL);
     871          21 :             for (i=1; i<lx; i++) gcoeff(y,i,j) = gcopy(gmael(x,i,j));
     872             :           }
     873           7 :           return y;
     874             :         }
     875             :       }
     876       23846 :       y = mkmatcopy(x); break;
     877             :     case t_MAT:
     878       51368 :       y = gcopy(x); break;
     879             :     case t_QFI: case t_QFR: {
     880             :       GEN b;
     881        8422 :       y = cgetg(3,t_MAT); b = gmul2n(gel(x,2),-1);
     882        8422 :       gel(y,1) = mkcol2(icopy(gel(x,1)), b);
     883        8422 :       gel(y,2) = mkcol2(b, icopy(gel(x,3)));
     884        8422 :       break;
     885             :     }
     886             :     default:
     887        1757 :       y = cgetg(2,t_MAT); gel(y,1) = mkcolcopy(x);
     888        1757 :       break;
     889             :   }
     890       85666 :   return y;
     891             : }
     892             : 
     893             : /* create the diagonal matrix, whose diagonal is given by x */
     894             : GEN
     895        1183 : diagonal(GEN x)
     896             : {
     897        1183 :   long j, lx, tx = typ(x);
     898             :   GEN y;
     899             : 
     900        1183 :   if (! is_matvec_t(tx)) return scalarmat(x,1);
     901        1176 :   if (tx==t_MAT)
     902             :   {
     903          14 :     if (RgM_isdiagonal(x)) return gcopy(x);
     904           7 :     pari_err_TYPE("diagonal",x);
     905             :   }
     906        1162 :   lx=lg(x); y=cgetg(lx,t_MAT);
     907        2814 :   for (j=1; j<lx; j++)
     908             :   {
     909        1652 :     gel(y,j) = zerocol(lx-1);
     910        1652 :     gcoeff(y,j,j) = gcopy(gel(x,j));
     911             :   }
     912        1162 :   return y;
     913             : }
     914             : /* same, assuming x is a t_VEC/t_COL. Not memory clean. */
     915             : GEN
     916       58955 : diagonal_shallow(GEN x)
     917             : {
     918       58955 :   long j, lx = lg(x);
     919       58955 :   GEN y = cgetg(lx,t_MAT);
     920             : 
     921      158161 :   for (j=1; j<lx; j++)
     922             :   {
     923       99206 :     gel(y,j) = zerocol(lx-1);
     924       99206 :     gcoeff(y,j,j) = gel(x,j);
     925             :   }
     926       58955 :   return y;
     927             : }
     928             : 
     929             : GEN
     930         385 : zv_diagonal(GEN x)
     931             : {
     932         385 :   long j, l = lg(x), n = l-1;
     933         385 :   GEN y = cgetg(l,t_MAT);
     934             : 
     935        1330 :   for (j = 1; j < l; j++)
     936             :   {
     937         945 :     gel(y,j) = zero_Flv(n);
     938         945 :     ucoeff(y,j,j) = uel(x,j);
     939             :   }
     940         385 :   return y;
     941             : }
     942             : 
     943             : /* compute m*diagonal(d) */
     944             : GEN
     945          70 : matmuldiagonal(GEN m, GEN d)
     946             : {
     947             :   long j, lx;
     948          70 :   GEN y = cgetg_copy(m, &lx);
     949             : 
     950          70 :   if (typ(m)!=t_MAT) pari_err_TYPE("matmuldiagonal",m);
     951          70 :   if (! is_vec_t(typ(d))) pari_err_TYPE("matmuldiagonal",d);
     952          70 :   if (lg(d) != lx) pari_err_OP("operation 'matmuldiagonal'", m,d);
     953          70 :   for (j=1; j<lx; j++) gel(y,j) = RgC_Rg_mul(gel(m,j), gel(d,j));
     954          70 :   return y;
     955             : }
     956             : 
     957             : /* compute A*B assuming the result is a diagonal matrix */
     958             : GEN
     959           7 : matmultodiagonal(GEN A, GEN B)
     960             : {
     961           7 :   long i, j, hA, hB, lA = lg(A), lB = lg(B);
     962           7 :   GEN y = matid(lB-1);
     963             : 
     964           7 :   if (typ(A) != t_MAT) pari_err_TYPE("matmultodiagonal",A);
     965           7 :   if (typ(B) != t_MAT) pari_err_TYPE("matmultodiagonal",B);
     966           7 :   hA = (lA == 1)? lB: lgcols(A);
     967           7 :   hB = (lB == 1)? lA: lgcols(B);
     968           7 :   if (lA != hB || lB != hA) pari_err_OP("operation 'matmultodiagonal'", A,B);
     969          56 :   for (i=1; i<lB; i++)
     970             :   {
     971          49 :     GEN z = gen_0;
     972          49 :     for (j=1; j<lA; j++) z = gadd(z, gmul(gcoeff(A,i,j),gcoeff(B,j,i)));
     973          49 :     gcoeff(y,i,i) = z;
     974             :   }
     975           7 :   return y;
     976             : }
     977             : 
     978             : /* [m[1,1], ..., m[l,l]], internal */
     979             : GEN
     980      237519 : RgM_diagonal_shallow(GEN m)
     981             : {
     982      237519 :   long i, lx = lg(m);
     983      237519 :   GEN y = cgetg(lx,t_VEC);
     984      237519 :   for (i=1; i<lx; i++) gel(y, i) = gcoeff(m,i,i);
     985      237519 :   return y;
     986             : }
     987             : 
     988             : /* same, public function */
     989             : GEN
     990           0 : RgM_diagonal(GEN m)
     991             : {
     992           0 :   long i, lx = lg(m);
     993           0 :   GEN y = cgetg(lx,t_VEC);
     994           0 :   for (i=1; i<lx; i++) gel(y,i) = gcopy(gcoeff(m,i,i));
     995           0 :   return y;
     996             : }
     997             : 
     998             : 

Generated by: LCOV version 1.13