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 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 - RgV.c (source / functions) Hit Total Coverage
Test: PARI/GP v2.10.0 lcov report (development 19825-b77c7f8) Lines: 456 529 86.2 %
Date: 2016-12-06 05:49:02 Functions: 78 87 89.7 %
Legend: Lines: hit not hit

          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. 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             : #include "pari.h"
      15             : #include "paripriv.h"
      16             : 
      17             : int
      18     3660067 : RgM_is_ZM(GEN x)
      19             : {
      20     3660067 :   long i, j, h, l = lg(x);
      21     3660067 :   if (l == 1) return 1;
      22     3659794 :   h = lgcols(x);
      23     3659794 :   if (h == 1) return 1;
      24    11475258 :   for (j = l-1; j > 0; j--)
      25    49063836 :     for (i = h-1; i > 0; i--)
      26    41247770 :       if (typ(gcoeff(x,i,j)) != t_INT) return 0;
      27     3236610 :   return 1;
      28             : }
      29             : 
      30             : int
      31          21 : RgV_is_ZMV(GEN V)
      32             : {
      33          21 :   long i, l = lg(V);
      34         231 :   for (i=1; i<l; i++)
      35         210 :     if (typ(gel(V,i))!=t_MAT || !RgM_is_ZM(gel(V,i)))
      36           0 :       return 0;
      37          21 :   return 1;
      38             : }
      39             : 
      40             : /********************************************************************/
      41             : /**                                                                **/
      42             : /**                   GENERIC LINEAR ALGEBRA                       **/
      43             : /**                                                                **/
      44             : /********************************************************************/
      45             : /*           GENERIC  MULTIPLICATION involving zc/zm                */
      46             : 
      47             : /* x[i,] * y */
      48             : static GEN
      49      409995 : RgMrow_zc_mul_i(GEN x, GEN y, long c, long i)
      50             : {
      51      409995 :   pari_sp av = avma;
      52      409995 :   GEN s = NULL;
      53             :   long j;
      54    16467619 :   for (j=1; j<c; j++)
      55             :   {
      56    16057624 :     long t = y[j];
      57    16057624 :     if (!t) continue;
      58     1750710 :     if (!s) { s = gmulgs(gcoeff(x,i,j),t); continue; }
      59     1343347 :     switch(t)
      60             :     {
      61      625719 :       case  1: s = gadd(s, gcoeff(x,i,j)); break;
      62      220430 :       case -1: s = gsub(s, gcoeff(x,i,j)); break;
      63      497198 :       default: s = gadd(s, gmulgs(gcoeff(x,i,j), t)); break;
      64             :     }
      65             :   }
      66      409995 :   if (!s) { avma = av; return gen_0; }
      67      407363 :   return gerepileupto(av, s);
      68             : }
      69             : GEN
      70       69937 : RgMrow_zc_mul(GEN x, GEN y, long i) { return RgMrow_zc_mul_i(x,y,lg(y),i); }
      71             : /* x non-empty t_MAT, y a compatible zc (dimension > 0). */
      72             : static GEN
      73      104305 : RgM_zc_mul_i(GEN x, GEN y, long c, long l)
      74             : {
      75      104305 :   GEN z = cgetg(l,t_COL);
      76             :   long i;
      77      104305 :   for (i = 1; i < l; i++) gel(z,i) = RgMrow_zc_mul_i(x,y,c,i);
      78      104305 :   return z;
      79             : }
      80             : GEN
      81       70770 : RgM_zc_mul(GEN x, GEN y) { return RgM_zc_mul_i(x,y, lg(x), lgcols(x)); }
      82             : /* x t_MAT, y a compatible zm (dimension > 0). */
      83             : GEN
      84        8339 : RgM_zm_mul(GEN x, GEN y)
      85             : {
      86        8339 :   long j, c, l = lg(x), ly = lg(y);
      87        8339 :   GEN z = cgetg(ly, t_MAT);
      88        8339 :   if (l == 1) return z;
      89        8339 :   c = lgcols(x);
      90        8339 :   for (j = 1; j < ly; j++) gel(z,j) = RgM_zc_mul_i(x, gel(y,j), l,c);
      91        8339 :   return z;
      92             : }
      93             : 
      94             : static GEN
      95       36793 : RgV_zc_mul_i(GEN x, GEN y, long l)
      96             : {
      97             :   long i;
      98       36793 :   GEN z = gen_0;
      99       36793 :   pari_sp av = avma;
     100       36793 :   for (i = 1; i < l; i++) z = gadd(z, gmulgs(gel(x,i), y[i]));
     101       36793 :   return gerepileupto(av, z);
     102             : }
     103             : GEN
     104          28 : RgV_zc_mul(GEN x, GEN y) { return RgV_zc_mul_i(x, y, lg(x)); }
     105             : 
     106             : GEN
     107        9259 : RgV_zm_mul(GEN x, GEN y)
     108             : {
     109        9259 :   long j, l = lg(x), ly = lg(y);
     110        9259 :   GEN z = cgetg(ly, t_VEC);
     111        9259 :   for (j = 1; j < ly; j++) gel(z,j) = RgV_zc_mul_i(x, gel(y,j), l);
     112        9259 :   return z;
     113             : }
     114             : 
     115             : /* scalar product x.x */
     116             : GEN
     117        1197 : RgV_dotsquare(GEN x)
     118             : {
     119        1197 :   long i, lx = lg(x);
     120        1197 :   pari_sp av = avma;
     121             :   GEN z;
     122        1197 :   if (lx == 1) return gen_0;
     123        1197 :   z = gsqr(gel(x,1));
     124        4774 :   for (i=2; i<lx; i++)
     125             :   {
     126        3577 :     z = gadd(z, gsqr(gel(x,i)));
     127        3577 :     if (gc_needed(av,3))
     128             :     {
     129           0 :       if(DEBUGMEM>1) pari_warn(warnmem,"RgV_dotsquare, i = %ld",i);
     130           0 :       z = gerepileupto(av, z);
     131             :     }
     132             :   }
     133        1197 :   return gerepileupto(av,z);
     134             : }
     135             : 
     136             : /* scalar product x.y, lx = lg(x) = lg(y) */
     137             : static GEN
     138     1457452 : RgV_dotproduct_i(GEN x, GEN y, long lx)
     139             : {
     140     1457452 :   pari_sp av = avma;
     141             :   long i;
     142             :   GEN z;
     143     1457452 :   if (lx == 1) return gen_0;
     144     1456913 :   z = gmul(gel(x,1),gel(y,1));
     145    43928231 :   for (i=2; i<lx; i++)
     146             :   {
     147    42471318 :     z = gadd(z, gmul(gel(x,i), gel(y,i)));
     148    42471318 :     if (gc_needed(av,3))
     149             :     {
     150           0 :       if(DEBUGMEM>1) pari_warn(warnmem,"RgV_dotproduct, i = %ld",i);
     151           0 :       z = gerepileupto(av, z);
     152             :     }
     153             :   }
     154     1456913 :   return gerepileupto(av,z);
     155             : }
     156             : GEN
     157       89381 : RgV_dotproduct(GEN x,GEN y)
     158             : {
     159       89381 :   if (x == y) return RgV_dotsquare(x);
     160       89381 :   return RgV_dotproduct_i(x, y, lg(x));
     161             : }
     162             : /* v[1] + ... + v[lg(v)-1] */
     163             : GEN
     164      257587 : RgV_sum(GEN v)
     165             : {
     166             :   GEN p;
     167      257587 :   long i, l = lg(v);
     168      257587 :   if (l == 1) return gen_0;
     169      257587 :   p = gel(v,1); for (i=2; i<l; i++) p = gadd(p, gel(v,i));
     170      257587 :   return p;
     171             : }
     172             : /* v[1] + ... + v[n]. Assume lg(v) > n. */
     173             : GEN
     174         518 : RgV_sumpart(GEN v, long n)
     175             : {
     176             :   GEN p;
     177             :   long i;
     178         518 :   if (!n) return gen_0;
     179         518 :   p = gel(v,1); for (i=2; i<=n; i++) p = gadd(p, gel(v,i));
     180         518 :   return p;
     181             : }
     182             : /* v[m] + ... + v[n]. Assume lg(v) > n, m > 0. */
     183             : GEN
     184           0 : RgV_sumpart2(GEN v, long m, long n)
     185             : {
     186             :   GEN p;
     187             :   long i;
     188           0 :   if (n < m) return gen_0;
     189           0 :   p = gel(v,m); for (i=m+1; i<=n; i++) p = gadd(p, gel(v,i));
     190           0 :   return p;
     191             : }
     192             : GEN
     193         362 : RgM_sumcol(GEN A)
     194             : {
     195         362 :   long i,j,m,l = lg(A);
     196             :   GEN v;
     197             : 
     198         362 :   if (l == 1) return cgetg(1,t_MAT);
     199         362 :   if (l == 2) return gcopy(gel(A,1));
     200         208 :   m = lgcols(A);
     201         208 :   v = cgetg(m, t_COL);
     202         680 :   for (i = 1; i < m; i++)
     203             :   {
     204         472 :     pari_sp av = avma;
     205         472 :     GEN s = gcoeff(A,i,1);
     206         472 :     for (j = 2; j < l; j++) s = gadd(s, gcoeff(A,i,j));
     207         472 :     gel(v, i) = gerepileupto(av, s);
     208             :   }
     209         208 :   return v;
     210             : }
     211             : 
     212             : static GEN
     213      677690 : _gmul(void *data, GEN x, GEN y)
     214      677690 : { (void)data; return gmul(x,y); }
     215             : 
     216             : GEN
     217       30286 : RgV_prod(GEN x)
     218             : {
     219       30286 :   return gen_product(x, NULL, _gmul);
     220             : }
     221             : 
     222             : /*                    ADDITION SCALAR + MATRIX                     */
     223             : /* x square matrix, y scalar; create the square matrix x + y*Id */
     224             : GEN
     225       16352 : RgM_Rg_add(GEN x, GEN y)
     226             : {
     227       16352 :   long l = lg(x), i, j;
     228       16352 :   GEN z = cgetg(l,t_MAT);
     229             : 
     230       16352 :   if (l==1) return z;
     231       16352 :   if (l != lgcols(x)) pari_err_OP( "+", x, y);
     232       16352 :   z = cgetg(l,t_MAT);
     233       74370 :   for (i=1; i<l; i++)
     234             :   {
     235       58018 :     GEN zi = cgetg(l,t_COL), xi = gel(x,i);
     236       58018 :     gel(z,i) = zi;
     237     1995532 :     for (j=1; j<l; j++)
     238     1937514 :       gel(zi,j) = i==j? gadd(y,gel(xi,j)): gcopy(gel(xi,j));
     239             :   }
     240       16352 :   return z;
     241             : }
     242             : GEN
     243           0 : RgM_Rg_sub(GEN x, GEN y)
     244             : {
     245           0 :   long l = lg(x), i, j;
     246           0 :   GEN z = cgetg(l,t_MAT);
     247             : 
     248           0 :   if (l==1) return z;
     249           0 :   if (l != lgcols(x)) pari_err_OP( "-", x, y);
     250           0 :   z = cgetg(l,t_MAT);
     251           0 :   for (i=1; i<l; i++)
     252             :   {
     253           0 :     GEN zi = cgetg(l,t_COL), xi = gel(x,i);
     254           0 :     gel(z,i) = zi;
     255           0 :     for (j=1; j<l; j++)
     256           0 :       gel(zi,j) = i==j? gsub(y,gel(xi,j)): gcopy(gel(xi,j));
     257             :   }
     258           0 :   return z;
     259             : }
     260             : GEN
     261        1596 : RgM_Rg_add_shallow(GEN x, GEN y)
     262             : {
     263        1596 :   long l = lg(x), i, j;
     264        1596 :   GEN z = cgetg(l,t_MAT);
     265             : 
     266        1596 :   if (l==1) return z;
     267        1491 :   if (l != lgcols(x)) pari_err_OP( "+", x, y);
     268        5649 :   for (i=1; i<l; i++)
     269             :   {
     270        4158 :     GEN zi = cgetg(l,t_COL), xi = gel(x,i);
     271        4158 :     gel(z,i) = zi;
     272        4158 :     for (j=1; j<l; j++) gel(zi,j) = gel(xi,j);
     273        4158 :     gel(zi,i) = gadd(gel(zi,i), y);
     274             :   }
     275        1491 :   return z;
     276             : }
     277             : GEN
     278       45215 : RgM_Rg_sub_shallow(GEN x, GEN y)
     279             : {
     280       45215 :   long l = lg(x), i, j;
     281       45215 :   GEN z = cgetg(l,t_MAT);
     282             : 
     283       45215 :   if (l==1) return z;
     284       45215 :   if (l != lgcols(x)) pari_err_OP( "-", x, y);
     285      524536 :   for (i=1; i<l; i++)
     286             :   {
     287      479321 :     GEN zi = cgetg(l,t_COL), xi = gel(x,i);
     288      479321 :     gel(z,i) = zi;
     289      479321 :     for (j=1; j<l; j++) gel(zi,j) = gel(xi,j);
     290      479321 :     gel(zi,i) = gsub(gel(zi,i), y);
     291             :   }
     292       45215 :   return z;
     293             : }
     294             : 
     295             : GEN
     296      501429 : RgC_Rg_add(GEN x, GEN y)
     297             : {
     298      501429 :   long k, lx = lg(x);
     299      501429 :   GEN z = cgetg(lx, t_COL);
     300      501429 :   if (lx == 1)
     301             :   {
     302           7 :     if (isintzero(y)) return z;
     303           0 :     pari_err_TYPE2("+",x,y);
     304             :   }
     305      501422 :   gel(z,1) = gadd(y,gel(x,1));
     306      501422 :   for (k = 2; k < lx; k++) gel(z,k) = gcopy(gel(x,k));
     307      501422 :   return z;
     308             : }
     309             : GEN
     310        3710 : RgC_Rg_sub(GEN x, GEN y)
     311             : {
     312        3710 :   long k, lx = lg(x);
     313        3710 :   GEN z = cgetg(lx, t_COL);
     314        3710 :   if (lx == 1)
     315             :   {
     316           0 :     if (isintzero(y)) return z;
     317           0 :     pari_err_TYPE2("-",x,y);
     318             :   }
     319        3710 :   gel(z,1) = gsub(gel(x,1), y);
     320        3710 :   for (k = 2; k < lx; k++) gel(z,k) = gcopy(gel(x,k));
     321        3710 :   return z;
     322             : }
     323             : /* a - x */
     324             : GEN
     325       11508 : Rg_RgC_sub(GEN a, GEN x)
     326             : {
     327       11508 :   long k, lx = lg(x);
     328       11508 :   GEN z = cgetg(lx,t_COL);
     329       11508 :   if (lx == 1)
     330             :   {
     331           0 :     if (isintzero(a)) return z;
     332           0 :     pari_err_TYPE2("-",a,x);
     333             :   }
     334       11508 :   gel(z,1) = gsub(a, gel(x,1));
     335       11508 :   for (k = 2; k < lx; k++) gel(z,k) = gneg(gel(x,k));
     336       11508 :   return z;
     337             : }
     338             : 
     339             : 
     340             : static GEN
     341    15252360 : RgC_add_i(GEN x, GEN y, long lx)
     342             : {
     343    15252360 :   GEN A = cgetg(lx, t_COL);
     344             :   long i;
     345    15252360 :   for (i=1; i<lx; i++) gel(A,i) = gadd(gel(x,i), gel(y,i));
     346    15252360 :   return A;
     347             : }
     348             : GEN
     349    12880739 : RgC_add(GEN x, GEN y) { return RgC_add_i(x, y, lg(x)); }
     350             : GEN
     351      489152 : RgV_add(GEN x, GEN y)
     352             : {
     353      489152 :   long i, lx = lg(x);
     354      489152 :   GEN A = cgetg(lx, t_VEC);
     355      489152 :   for (i=1; i<lx; i++) gel(A,i) = gadd(gel(x,i), gel(y,i));
     356      489152 :   return A;
     357             : }
     358             : 
     359             : static GEN
     360     1462842 : RgC_sub_i(GEN x, GEN y, long lx)
     361             : {
     362             :   long i;
     363     1462842 :   GEN A = cgetg(lx, t_COL);
     364     1462842 :   for (i=1; i<lx; i++) gel(A,i) = gsub(gel(x,i), gel(y,i));
     365     1462842 :   return A;
     366             : }
     367             : GEN
     368     1428523 : RgC_sub(GEN x, GEN y) { return RgC_sub_i(x, y, lg(x)); }
     369             : GEN
     370       74023 : RgV_sub(GEN x, GEN y)
     371             : {
     372       74023 :   long i, lx = lg(x);
     373       74023 :   GEN A = cgetg(lx, t_VEC);
     374       74023 :   for (i=1; i<lx; i++) gel(A,i) = gsub(gel(x,i), gel(y,i));
     375       74023 :   return A;
     376             : }
     377             : 
     378             : GEN
     379      497574 : RgM_add(GEN x, GEN y)
     380             : {
     381      497574 :   long lx = lg(x), l, j;
     382             :   GEN z;
     383      497574 :   if (lx == 1) return cgetg(1, t_MAT);
     384      497574 :   z = cgetg(lx, t_MAT); l = lgcols(x);
     385      497574 :   for (j = 1; j < lx; j++) gel(z,j) = RgC_add_i(gel(x,j), gel(y,j), l);
     386      497574 :   return z;
     387             : }
     388             : GEN
     389        8437 : RgM_sub(GEN x, GEN y)
     390             : {
     391        8437 :   long lx = lg(x), l, j;
     392             :   GEN z;
     393        8437 :   if (lx == 1) return cgetg(1, t_MAT);
     394        8437 :   z = cgetg(lx, t_MAT); l = lgcols(x);
     395        8437 :   for (j = 1; j < lx; j++) gel(z,j) = RgC_sub_i(gel(x,j), gel(y,j), l);
     396        8437 :   return z;
     397             : }
     398             : 
     399             : static GEN
     400     2664475 : RgC_neg_i(GEN x, long lx)
     401             : {
     402             :   long i;
     403     2664475 :   GEN y = cgetg(lx, t_COL);
     404     2664475 :   for (i=1; i<lx; i++) gel(y,i) = gneg(gel(x,i));
     405     2664475 :   return y;
     406             : }
     407             : GEN
     408       54672 : RgC_neg(GEN x) { return RgC_neg_i(x, lg(x)); }
     409             : GEN
     410        8632 : RgV_neg(GEN x)
     411             : {
     412        8632 :   long i, lx = lg(x);
     413        8632 :   GEN y = cgetg(lx, t_VEC);
     414        8632 :   for (i=1; i<lx; i++) gel(y,i) = gneg(gel(x,i));
     415        8632 :   return y;
     416             : }
     417             : GEN
     418      469672 : RgM_neg(GEN x)
     419             : {
     420      469672 :   long i, hx, lx = lg(x);
     421      469672 :   GEN y = cgetg(lx, t_MAT);
     422      469672 :   if (lx == 1) return y;
     423      469665 :   hx = lgcols(x);
     424      469665 :   for (i=1; i<lx; i++) gel(y,i) = RgC_neg_i(gel(x,i), hx);
     425      469665 :   return y;
     426             : }
     427             : 
     428             : GEN
     429      137079 : RgV_RgC_mul(GEN x, GEN y)
     430             : {
     431      137079 :   long lx = lg(x);
     432      137079 :   if (lx != lg(y)) pari_err_OP("operation 'RgV_RgC_mul'", x, y);
     433      137016 :   return RgV_dotproduct_i(x, y, lx);
     434             : }
     435             : GEN
     436           7 : RgC_RgV_mul(GEN x, GEN y)
     437             : {
     438           7 :   long i, ly = lg(y);
     439           7 :   GEN z = cgetg(ly,t_MAT);
     440           7 :   for (i=1; i<ly; i++) gel(z,i) = RgC_Rg_mul(x, gel(y,i));
     441           7 :   return z;
     442             : }
     443             : GEN
     444           0 : RgC_RgM_mul(GEN x, GEN y)
     445             : {
     446           0 :   long i, ly = lg(y);
     447           0 :   GEN z = cgetg(ly,t_MAT);
     448           0 :   if (ly != 1 && lgcols(y) != 2) pari_err_OP("operation 'RgC_RgM_mul'",x,y);
     449           0 :   for (i=1; i<ly; i++) gel(z,i) = RgC_Rg_mul(x, gcoeff(y,1,i));
     450           0 :   return z;
     451             : }
     452             : GEN
     453           0 : RgM_RgV_mul(GEN x, GEN y)
     454             : {
     455           0 :   if (lg(x) != 2) pari_err_OP("operation 'RgM_RgV_mul'", x,y);
     456           0 :   return RgC_RgV_mul(gel(x,1), y);
     457             : }
     458             : 
     459             : /* x[i,]*y, l = lg(y) > 1 */
     460             : static GEN
     461    68920043 : RgMrow_RgC_mul_i(GEN x, GEN y, long i, long l)
     462             : {
     463    68920043 :   pari_sp av = avma;
     464    68920043 :   GEN t = gmul(gcoeff(x,i,1), gel(y,1)); /* l > 1 ! */
     465             :   long j;
     466    68920043 :   for (j=2; j<l; j++) t = gadd(t, gmul(gcoeff(x,i,j), gel(y,j)));
     467    68920043 :   return gerepileupto(av,t);
     468             : }
     469             : GEN
     470         455 : RgMrow_RgC_mul(GEN x, GEN y, long i)
     471         455 : { return RgMrow_RgC_mul_i(x, y, i, lg(x)); }
     472             : 
     473             : /* compatible t_MAT * t_COL, lx = lg(x) = lg(y) > 1, l = lgcols(x) */
     474             : static GEN
     475    10099397 : RgM_RgC_mul_i(GEN x, GEN y, long lx, long l)
     476             : {
     477    10099397 :   GEN z = cgetg(l,t_COL);
     478             :   long i;
     479    10099397 :   for (i=1; i<l; i++) gel(z,i) = RgMrow_RgC_mul_i(x,y,i,lx);
     480    10099397 :   return z;
     481             : }
     482             : 
     483             : GEN
     484     8568718 : RgM_RgC_mul(GEN x, GEN y)
     485             : {
     486     8568718 :   long lx = lg(x);
     487     8568718 :   GEN ffx = NULL, ffy = NULL;
     488     8568718 :   if (lx != lg(y)) pari_err_OP("operation 'RgM_RgC_mul'", x,y);
     489     8568718 :   if (lx == 1) return cgetg(1,t_COL);
     490     8568718 :   if (RgM_is_FFM(x, &ffx) && RgC_is_FFC(y, &ffy)) {
     491          28 :     if (!FF_samefield(ffx, ffy))
     492           0 :       pari_err_OP("*", ffx, ffy);
     493          28 :     return FFM_FFC_mul(x, y, ffx);
     494             :   }
     495     8568690 :   return RgM_RgC_mul_i(x, y, lx, lgcols(x));
     496             : }
     497             : 
     498             : GEN
     499      100950 : RgV_RgM_mul(GEN x, GEN y)
     500             : {
     501      100950 :   long i, lx, ly = lg(y);
     502             :   GEN z;
     503      100950 :   if (ly == 1) return cgetg(1,t_VEC);
     504      100943 :   lx = lg(x);
     505      100943 :   if (lx != lgcols(y)) pari_err_OP("operation 'RgV_RgM_mul'", x,y);
     506      100936 :   z = cgetg(ly, t_VEC);
     507      100936 :   for (i=1; i<ly; i++) gel(z,i) = RgV_dotproduct_i(x, gel(y,i), lx);
     508      100936 :   return z;
     509             : }
     510             : 
     511             : static int
     512      408926 : is_modular_mul(GEN a, GEN b, GEN *z)
     513             : {
     514      408926 :   GEN p1 = NULL, p2 = NULL, p;
     515             :   ulong pp;
     516      408926 :   if (!RgM_is_FpM(a, &p1) || !p1) return 0;
     517          77 :   if (!RgM_is_FpM(b, &p2) || !p2) return 0;
     518          77 :   p = gcdii(p1, p2);
     519          77 :   a = RgM_Fp_init(a, p, &pp);
     520          77 :   switch(pp)
     521             :   {
     522             :   case 0:
     523          15 :     b = RgM_to_FpM(b,p);
     524          15 :     b = FpM_mul(a,b,p);
     525          15 :     *z = FpM_to_mod(b,p);
     526          15 :     break;
     527             :   case 2:
     528          28 :     b = RgM_to_F2m(b);
     529          28 :     b = F2m_mul(a,b);
     530          28 :     *z = F2m_to_mod(b);
     531          28 :     break;
     532             :   default:
     533          34 :     b = RgM_to_Flm(b,pp);
     534          34 :     b = Flm_mul(a,b,pp);
     535          34 :     *z = Flm_to_mod(b,pp);
     536             :   }
     537          77 :   return 1;
     538             : }
     539             : static int
     540         812 : is_modular_sqr(GEN a, GEN *z)
     541             : {
     542         812 :   GEN p = NULL;
     543             :   ulong pp;
     544         812 :   if (!RgM_is_FpM(a, &p) || !p) return 0;
     545          63 :   a = RgM_Fp_init(a, p, &pp);
     546          63 :   switch(pp)
     547             :   {
     548          15 :     case 0: *z = FpM_to_mod(FpM_mul(a,a, p), p); break;
     549          14 :     case 2: *z = F2m_to_mod(F2m_mul(a,a)); break;
     550          34 :     default:*z = Flm_to_mod(Flm_mul(a,a, pp), pp); break;
     551             :   }
     552          63 :   return 1;
     553             : }
     554             : 
     555             : GEN
     556     2017954 : RgM_mul(GEN x, GEN y)
     557             : {
     558     2017954 :   pari_sp av = avma;
     559     2017954 :   long j, l, lx, ly = lg(y);
     560     2017954 :   GEN z, ffx = NULL, ffy = NULL;
     561     2017954 :   if (ly == 1) return cgetg(1,t_MAT);
     562     2017303 :   lx = lg(x);
     563     2017303 :   if (lx != lgcols(y)) pari_err_OP("operation 'RgM_mul'", x,y);
     564     2017303 :   if (lx == 1) return zeromat(0,ly-1);
     565     2017282 :   if (RgM_is_ZM(x) && RgM_is_ZM(y))
     566     1608356 :     return ZM_mul(x, y);
     567      408926 :   if (is_modular_mul(x,y,&z)) return gerepileupto(av, z);
     568      408849 :   if (RgM_is_FFM(x, &ffx) && RgM_is_FFM(y, &ffy)) {
     569         133 :     if (!FF_samefield(ffx, ffy))
     570           0 :       pari_err_OP("*", ffx, ffy);
     571         133 :     return FFM_mul(x, y, ffx);
     572             :   }
     573      408716 :   z = cgetg(ly, t_MAT);
     574      408716 :   l = lgcols(x);
     575      408716 :   for (j=1; j<ly; j++) gel(z,j) = RgM_RgC_mul_i(x, gel(y,j), lx, l);
     576      408716 :   return z;
     577             : }
     578             : /* assume result is symmetric */
     579             : GEN
     580           0 : RgM_multosym(GEN x, GEN y)
     581             : {
     582           0 :   long j, lx, ly = lg(y);
     583             :   GEN M;
     584           0 :   if (ly == 1) return cgetg(1,t_MAT);
     585           0 :   lx = lg(x);
     586           0 :   if (lx != lgcols(y)) pari_err_OP("operation 'RgM_multosym'", x,y);
     587           0 :   if (lx == 1) return cgetg(1,t_MAT);
     588           0 :   if (ly != lgcols(x)) pari_err_OP("operation 'RgM_multosym'", x,y);
     589           0 :   M = cgetg(ly, t_MAT);
     590           0 :   for (j=1; j<ly; j++)
     591             :   {
     592           0 :     GEN z = cgetg(ly,t_COL), yj = gel(y,j);
     593             :     long i;
     594           0 :     for (i=1; i<j; i++) gel(z,i) = gcoeff(M,j,i);
     595           0 :     for (i=j; i<ly; i++)gel(z,i) = RgMrow_RgC_mul_i(x,yj,i,lx);
     596           0 :     gel(M,j) = z;
     597             :   }
     598           0 :   return M;
     599             : }
     600             : /* x~ * y, assuming result is symmetric */
     601             : GEN
     602         538 : RgM_transmultosym(GEN x, GEN y)
     603             : {
     604         538 :   long i, j, l, ly = lg(y);
     605             :   GEN M;
     606         538 :   if (ly == 1) return cgetg(1,t_MAT);
     607         538 :   if (lg(x) != ly) pari_err_OP("operation 'RgM_transmultosym'", x,y);
     608         538 :   l = lgcols(y);
     609         538 :   if (lgcols(x) != l) pari_err_OP("operation 'RgM_transmultosym'", x,y);
     610         538 :   M = cgetg(ly, t_MAT);
     611        2390 :   for (i=1; i<ly; i++)
     612             :   {
     613        1852 :     GEN xi = gel(x,i), c = cgetg(ly,t_COL);
     614        1852 :     gel(M,i) = c;
     615        4992 :     for (j=1; j<i; j++)
     616        3140 :       gcoeff(M,i,j) = gel(c,j) = RgV_dotproduct_i(xi,gel(y,j),l);
     617        1852 :     gel(c,i) = RgV_dotproduct_i(xi,gel(y,i),l);
     618             :   }
     619         538 :   return M;
     620             : }
     621             : /* x~ * y */
     622             : GEN
     623           0 : RgM_transmul(GEN x, GEN y)
     624             : {
     625           0 :   long i, j, l, lx, ly = lg(y);
     626             :   GEN M;
     627           0 :   if (ly == 1) return cgetg(1,t_MAT);
     628           0 :   lx = lg(x);
     629           0 :   l = lgcols(y);
     630           0 :   if (lgcols(x) != l) pari_err_OP("operation 'RgM_transmul'", x,y);
     631           0 :   M = cgetg(ly, t_MAT);
     632           0 :   for (i=1; i<ly; i++)
     633             :   {
     634           0 :     GEN yi = gel(y,i), c = cgetg(lx,t_COL);
     635           0 :     gel(M,i) = c;
     636           0 :     for (j=1; j<lx; j++) gel(c,j) = RgV_dotproduct_i(yi,gel(x,j),l);
     637             :   }
     638           0 :   return M;
     639             : }
     640             : 
     641             : GEN
     642         119 : gram_matrix(GEN x)
     643             : {
     644         119 :   long i,j, l, lx = lg(x);
     645             :   GEN M;
     646         119 :   if (!is_matvec_t(typ(x))) pari_err_TYPE("gram",x);
     647         119 :   if (lx == 1) return cgetg(1,t_MAT);
     648         105 :   l = lgcols(x);
     649         105 :   M = cgetg(lx,t_MAT);
     650         294 :   for (i=1; i<lx; i++)
     651             :   {
     652         189 :     GEN xi = gel(x,i), c = cgetg(lx,t_COL);
     653         189 :     gel(M,i) = c;
     654         280 :     for (j=1; j<i; j++)
     655          91 :       gcoeff(M,i,j) = gel(c,j) = RgV_dotproduct_i(xi,gel(x,j),l);
     656         189 :     gel(c,i) = RgV_dotsquare(xi);
     657             :   }
     658         105 :   return M;
     659             : }
     660             : 
     661             : GEN
     662         896 : RgM_sqr(GEN x)
     663             : {
     664         896 :   pari_sp av = avma;
     665         896 :   long j, lx = lg(x);
     666         896 :   GEN z, ffx = NULL;
     667         896 :   if (lx == 1) return cgetg(1, t_MAT);
     668         861 :   if (lx != lgcols(x)) pari_err_OP("operation 'RgM_mul'", x,x);
     669         861 :   if (RgM_is_ZM(x))         return ZM_sqr(x);
     670         812 :   if (is_modular_sqr(x,&z)) return gerepileupto(av, z);
     671         749 :   if (RgM_is_FFM(x, &ffx))  return FFM_mul(x, x, ffx);
     672         721 :   z = cgetg(lx, t_MAT);
     673         721 :   for (j=1; j<lx; j++) gel(z,j) = RgM_RgC_mul_i(x, gel(x,j), lx, lx);
     674         721 :   return z;
     675             : }
     676             : 
     677             : static GEN
     678        1316 : _RgM_add(void *E, GEN x, GEN y) { (void)E; return RgM_add(x, y); }
     679             : 
     680             : static GEN
     681           0 : _RgM_sub(void *E, GEN x, GEN y) { (void)E; return RgM_sub(x, y); }
     682             : 
     683             : static GEN
     684        2149 : _RgM_cmul(void *E, GEN P, long a, GEN x) { (void)E; return RgM_Rg_mul(x,gel(P,a+2)); }
     685             : 
     686             : static GEN
     687         105 : _RgM_sqr(void *E, GEN x) { (void) E; return RgM_sqr(x); }
     688             : 
     689             : static GEN
     690         224 : _RgM_mul(void *E, GEN x, GEN y) { (void) E; return RgM_mul(x, y); }
     691             : 
     692             : static GEN
     693        1526 : _RgM_one(void *E) { long *n = (long*) E; return matid(*n); }
     694             : 
     695             : static GEN
     696           0 : _RgM_zero(void *E) { long *n = (long*) E; return zeromat(*n,*n); }
     697             : 
     698             : static GEN
     699        1099 : _RgM_red(void *E, GEN x) { (void)E; return x; }
     700             : 
     701             : static struct bb_algebra RgM_algebra = { _RgM_red, _RgM_add, _RgM_sub,
     702             :        _RgM_mul, _RgM_sqr, _RgM_one, _RgM_zero };
     703             : 
     704             : /* generates the list of powers of x of degree 0,1,2,...,l*/
     705             : GEN
     706         154 : RgM_powers(GEN x, long l)
     707             : {
     708         154 :   long n = lg(x)-1;
     709         154 :   return gen_powers(x,l,1,(void *) &n, &_RgM_sqr, &_RgM_mul, &_RgM_one);
     710             : }
     711             : 
     712             : GEN
     713         462 : RgX_RgMV_eval(GEN Q, GEN x)
     714             : {
     715         462 :   long n = lg(x)>1 ? lg(gel(x,1))-1:0;
     716         462 :   return gen_bkeval_powers(Q,degpol(Q),x,(void*)&n,&RgM_algebra,&_RgM_cmul);
     717             : }
     718             : 
     719             : GEN
     720         371 : RgX_RgM_eval(GEN Q, GEN x)
     721             : {
     722         371 :   long n = lg(x)-1;
     723         371 :   return gen_bkeval(Q,degpol(Q),x,1,(void*)&n,&RgM_algebra,&_RgM_cmul);
     724             : }
     725             : 
     726             : GEN
     727     1120907 : RgC_Rg_div(GEN x, GEN y) {
     728     1120907 :   long i, lx = lg(x);
     729     1120907 :   GEN z = cgetg(lx, t_COL);
     730     1120907 :   for (i=1; i<lx; i++) gel(z,i) = gdiv(gel(x,i),y);
     731     1120907 :   return z;
     732             : }
     733             : GEN
     734     3881009 : RgC_Rg_mul(GEN x, GEN y) {
     735     3881009 :   long i, lx = lg(x);
     736     3881009 :   GEN z = cgetg(lx, t_COL);
     737     3881009 :   for (i=1; i<lx; i++) gel(z,i) = gmul(gel(x,i),y);
     738     3881009 :   return z;
     739             : }
     740             : GEN
     741        3713 : RgV_Rg_mul(GEN x, GEN y) {
     742        3713 :   long i, lx = lg(x);
     743        3713 :   GEN z = cgetg(lx, t_VEC);
     744        3713 :   for (i=1; i<lx; i++) gel(z,i) = gmul(gel(x,i),y);
     745        3713 :   return z;
     746             : }
     747             : GEN
     748      103283 : RgM_Rg_div(GEN X, GEN c) {
     749      103283 :   long i, j, h, l = lg(X);
     750      103283 :   GEN A = cgetg(l, t_MAT);
     751      103283 :   if (l == 1) return A;
     752      103234 :   h = lgcols(X);
     753      762210 :   for (j=1; j<l; j++)
     754             :   {
     755      658976 :     GEN a = cgetg(h, t_COL), x = gel(X, j);
     756      658976 :     for (i = 1; i < h; i++) gel(a,i) = gdiv(gel(x,i), c);
     757      658976 :     gel(A,j) = a;
     758             :   }
     759      103234 :   return A;
     760             : }
     761             : GEN
     762       71115 : RgM_Rg_mul(GEN X, GEN c) {
     763       71115 :   long i, j, h, l = lg(X);
     764       71115 :   GEN A = cgetg(l, t_MAT);
     765       71115 :   if (l == 1) return A;
     766       71080 :   h = lgcols(X);
     767      331716 :   for (j=1; j<l; j++)
     768             :   {
     769      260636 :     GEN a = cgetg(h, t_COL), x = gel(X, j);
     770      260636 :     for (i = 1; i < h; i++) gel(a,i) = gmul(gel(x,i), c);
     771      260636 :     gel(A,j) = a;
     772             :   }
     773       71080 :   return A;
     774             : }
     775             : 
     776             : /********************************************************************/
     777             : /*                                                                  */
     778             : /*                    SCALAR TO MATRIX/VECTOR                       */
     779             : /*                                                                  */
     780             : /********************************************************************/
     781             : /* fill the square nxn matrix equal to t*Id */
     782             : static void
     783     1825702 : fill_scalmat(GEN y, GEN t, long n)
     784             : {
     785             :   long i;
     786     8423328 :   for (i = 1; i <= n; i++)
     787             :   {
     788     6597626 :     gel(y,i) = zerocol(n);
     789     6597626 :     gcoeff(y,i,i) = t;
     790             :   }
     791     1825702 : }
     792             : 
     793             : GEN
     794      382420 : scalarmat(GEN x, long n) {
     795      382420 :   GEN y = cgetg(n+1, t_MAT);
     796      382420 :   if (!n) return y;
     797      382420 :   fill_scalmat(y, gcopy(x), n); return y;
     798             : }
     799             : GEN
     800         938 : scalarmat_shallow(GEN x, long n) {
     801         938 :   GEN y = cgetg(n+1, t_MAT);
     802         938 :   fill_scalmat(y, x, n); return y;
     803             : }
     804             : GEN
     805         140 : scalarmat_s(long x, long n) {
     806         140 :   GEN y = cgetg(n+1, t_MAT);
     807         140 :   if (!n) return y;
     808         140 :   fill_scalmat(y, stoi(x), n); return y;
     809             : }
     810             : GEN
     811     1442211 : matid(long n) {
     812             :   GEN y;
     813     1442211 :   if (n < 0) pari_err_DOMAIN("matid", "size", "<", gen_0, stoi(n));
     814     1442204 :   y = cgetg(n+1, t_MAT);
     815     1442204 :   fill_scalmat(y, gen_1, n); return y;
     816             : }
     817             : 
     818             : INLINE GEN
     819      380279 : scalarcol_i(GEN x, long n, long c)
     820             : {
     821             :   long i;
     822      380279 :   GEN y = cgetg(n+1,t_COL);
     823      380279 :   if (!n) return y;
     824      380279 :   gel(y,1) = c? gcopy(x): x;
     825      380279 :   for (i=2; i<=n; i++) gel(y,i) = gen_0;
     826      380279 :   return y;
     827             : }
     828             : 
     829             : GEN
     830       45851 : scalarcol(GEN x, long n) { return scalarcol_i(x,n,1); }
     831             : 
     832             : GEN
     833      334428 : scalarcol_shallow(GEN x, long n) { return scalarcol_i(x,n,0); }
     834             : 
     835             : int
     836        7995 : RgM_isscalar(GEN x, GEN s)
     837             : {
     838        7995 :   long i, j, lx = lg(x);
     839             : 
     840        7995 :   if (lx == 1) return 1;
     841        7995 :   if (lx != lgcols(x)) return 0;
     842        7995 :   if (!s) s = gcoeff(x,1,1);
     843             : 
     844       19098 :   for (j=1; j<lx; j++)
     845             :   {
     846       16396 :     GEN c = gel(x,j);
     847       38434 :     for (i=1; i<j; )
     848        9661 :       if (!gequal0(gel(c,i++))) return 0;
     849             :     /* i = j */
     850       12377 :       if (!gequal(gel(c,i++),s)) return 0;
     851       33428 :     for (   ; i<lx; )
     852       11222 :       if (!gequal0(gel(c,i++))) return 0;
     853             :   }
     854        2702 :   return 1;
     855             : }
     856             : 
     857             : int
     858        1953 : RgM_isidentity(GEN x)
     859             : {
     860        1953 :   long i,j, lx = lg(x);
     861             : 
     862        1953 :   if (lx == 1) return 1;
     863        1953 :   if (lx != lgcols(x)) return 0;
     864        3780 :   for (j=1; j<lx; j++)
     865             :   {
     866        3136 :     GEN c = gel(x,j);
     867        6741 :     for (i=1; i<j; )
     868        1197 :       if (!gequal0(gel(c,i++))) return 0;
     869             :     /* i = j */
     870        2408 :       if (!gequal1(gel(c,i++))) return 0;
     871        4970 :     for (   ; i<lx; )
     872        1316 :       if (!gequal0(gel(c,i++))) return 0;
     873             :   }
     874         644 :   return 1;
     875             : }
     876             : 
     877             : long
     878           0 : RgC_is_ei(GEN x)
     879             : {
     880           0 :   long i, j = 0, l = lg(x);
     881           0 :   for (i = 1; i < l; i++)
     882             :   {
     883           0 :     GEN c = gel(x,i);
     884           0 :     if (gequal0(c)) continue;
     885           0 :     if (!gequal1(c) || j) return 0;
     886           0 :     j = i;
     887             :   }
     888           0 :   return j;
     889             : }
     890             : 
     891             : int
     892          28 : RgM_isdiagonal(GEN x)
     893             : {
     894          28 :   long i,j, lx = lg(x);
     895          28 :   if (lx == 1) return 1;
     896          28 :   if (lx != lgcols(x)) return 0;
     897             : 
     898          77 :   for (j=1; j<lx; j++)
     899             :   {
     900          56 :     GEN c = gel(x,j);
     901          91 :     for (i=1; i<j; i++)
     902          35 :       if (!gequal0(gel(c,i))) return 0;
     903          91 :     for (i++; i<lx; i++)
     904          42 :       if (!gequal0(gel(c,i))) return 0;
     905             :   }
     906          21 :   return 1;
     907             : }
     908             : int
     909           7 : isdiagonal(GEN x)
     910             : {
     911           7 :   return (typ(x)==t_MAT) && RgM_isdiagonal(x);
     912             : }
     913             : 
     914             : /* returns the first index i<=n such that x=v[i] if it exists, 0 otherwise */
     915             : long
     916       21735 : RgV_isin(GEN v, GEN x)
     917             : {
     918       21735 :   long i, l = lg(v);
     919      405699 :   for (i = 1; i < l; i++)
     920      405510 :     if (gequal(gel(v,i), x)) return i;
     921         189 :   return 0;
     922             : }
     923             : 
     924             : GEN
     925        3724 : RgM_det_triangular(GEN mat)
     926             : {
     927        3724 :   long i,l = lg(mat);
     928             :   pari_sp av;
     929             :   GEN s;
     930             : 
     931        3724 :   if (l<3) return l<2? gen_1: gcopy(gcoeff(mat,1,1));
     932        2254 :   av = avma; s = gcoeff(mat,1,1);
     933        2254 :   for (i=2; i<l; i++) s = gmul(s,gcoeff(mat,i,i));
     934        2254 :   return av==avma? gcopy(s): gerepileupto(av,s);
     935             : }
     936             : 
     937             : GEN
     938        3829 : RgV_kill0(GEN v)
     939             : {
     940             :   long i, l;
     941        3829 :   GEN w = cgetg_copy(v, &l);
     942     2352783 :   for (i = 1; i < l; i++)
     943             :   {
     944     2348954 :     GEN a = gel(v,i);
     945     2348954 :     gel(w,i) = gequal0(a) ? NULL: a;
     946             :   }
     947        3829 :   return w;
     948             : }

Generated by: LCOV version 1.11