source: git/Singular/algmap.cc @ c4bbf1f

spielwiese
Last change on this file since c4bbf1f was a38f5ea, checked in by Olaf Bachmann <obachman@…>, 26 years ago
* configure.in (VERSION_DATE): Passed universal tst test:Increased version to 1.1.8 (i.e. version which has COMP_FAST built in, by default). * longalg.cc (naDBTest): fixed lines for number tests git-svn-id: file:///usr/local/Singular/svn/trunk@1287 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 6.1 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id: algmap.cc,v 1.10 1998-03-27 15:43:17 obachman Exp $ */
5/*
6* ABSTRACT - the mapping of polynomials from rings with
7* 'alg' numbers
8*/
9
10#include "mod2.h"
11#include "tok.h"
12#include "polys.h"
13#include "numbers.h"
14#include "longalg.h"
15#include "ipid.h"
16#include "ring.h"
17#include "mmemory.h"
18#include "febase.h"
19#include "maps.h"
20#include "algmap.h"
21
22
23static poly maLongalg1Fetch(poly res, poly p0, ring r0, int n,
24                            int t, BOOLEAN *nom)
25{
26  napoly a0, b0;
27  poly q0, q1 = NULL;
28  int i, j, m = r0->N;
29
30  if (naGetDenom(pGetCoeff(p0)) != NULL)
31  {
32    *nom = TRUE;
33    return res;
34  }
35  a0 = naGetNom(pGetCoeff(p0));
36  do
37  {
38    q0 = pInit();
39    pSetComp(q0,pRingGetComp(r0, p0));
40    if (t!=0)
41    {
42      pGetCoeff(q0) = (number)Alloc0(sizeof(rnumber));
43      b0 = naGetNom(pGetCoeff(q0)) = napNew();
44      napGetCoeff(b0) = nacCopy(napGetCoeff(a0));
45      for (i=1; i<=t; i++)
46      {
47        napGetExp(b0,i) = napGetExp(a0,i);
48      }
49    }
50    else
51    {
52      pGetCoeff(q0) = nCopy(napGetCoeff(a0));
53    }
54    for (i=m; i>0; i--)
55    {
56      pSetExp(q0,i, pRingGetExp(r0, p0,i));
57    }
58    j = t;
59    for (i=m+1; i<=n; i++)
60    {
61      j++;
62      pSetExp(q0,i, napGetExp(a0,j));
63    }
64    pSetm(q0);
65    q1 = pAdd(q1, q0);
66    a0 = napNext(a0);
67  }
68  while (a0 != NULL);
69  return pAdd(res, q1);
70}
71
72static poly maLongalg2Fetch(poly res, poly p0, ring r0, int n, int s,
73                            int t, BOOLEAN *nom)
74{
75  poly q0;
76  int i, j;
77  napoly b0;
78  napoly a0 = NULL, b1 = NULL;
79
80  if (s!=0)
81  {
82    if (naGetDenom(pGetCoeff(p0)) != NULL)
83    {
84      *nom = TRUE;
85      return res;
86    }
87    a0 = naGetNom(pGetCoeff(p0));
88  }
89  q0 = pInit();
90  pSetComp(q0,pRingGetComp(r0, p0));
91  for (i=n; i>0; i--)
92  {
93    pSetExp(q0,i, pRingGetExp(r0,p0,i));
94  }
95  pSetm(q0);
96  do
97  {
98    b0 = napNew();
99    if (s!=0)
100    {
101      napGetCoeff(b0) = nacCopy(napGetCoeff(a0));
102      for (i=1; i<=s; i++)
103      {
104        napGetExp(b0,i) = napGetExp(a0,i);
105      }
106    }
107    else
108    {
109      napGetCoeff(b0) = nacCopy(pGetCoeff(p0));
110    }
111    j = n;
112    for (i=s+1; i<=t; i++)
113    {
114      j++;
115      napGetExp(b0,i) = pRingGetExp(r0,p0,j);
116    }
117    if (s==0)
118    {
119      naGetNom(pGetCoeff(q0)) = b0;
120      return pAdd(res, q0);
121    }
122    b1 = napAdd(b1, b0);
123    a0 = napNext(a0);
124  }
125  while (a0 != NULL);
126  if (pGetCoeff(q0)==NULL)
127    pGetCoeff(q0) = (number)Alloc0(sizeof(rnumber));
128  naGetNom(pGetCoeff(q0)) = b1;
129  return pAdd(res, q0);
130}
131
132/*2
133* return Fe(preimage)
134* Fe : k(y(1),..,y(s))[x(1),..,x(m)] -> k(y(1),..,y(t))[x(1),..,x(n)]
135*      with:
136*      s+m = t+n,
137*      Fe(y(i)) = y(i), i = 1,..,min(s,t),
138*      Fe(x(i)) = x(i), i = 1,..,min(m,n),
139*      and
140*      1. for s>t: Fe(y(i)) = x(i+n-t), i = t+1,..,s
141*      2. for m>n: Fe(x(i)) = y(i+t-n), i = n+1,..,m
142*/
143poly maAlgpolyFetch(ring R, poly preimage)
144{
145  BOOLEAN nom=FALSE;
146  int m, n, s, t;
147  poly p0, result=NULL;
148
149  if (preimage == NULL)
150  {
151    return NULL;
152  }
153  m = R->N;
154  n = currRing->N;
155  s = rPar(R);
156  t = rPar(currRing);
157  if ((m+s) != (n+t))
158  {
159    WerrorS("no algfetch possible");
160    return NULL;
161  }
162  if (n == m)
163  {
164    return pCopy(preimage);
165  }
166  p0 = preimage;
167  if (s > t)
168  {
169    while (p0!=NULL)
170    {
171      result = maLongalg1Fetch(result, p0, R, n, t, &nom);
172      if (nom)
173      {
174        goto err_algfetch;
175      }
176      pIter(p0);
177    }
178  }
179  else
180  {
181    while (p0!=NULL)
182    {
183      result = maLongalg2Fetch(result, p0, R, n, s, t, &nom);
184      if (nom)
185      {
186        goto err_algfetch;
187      }
188      pIter(p0);
189    }
190  }
191  return result;
192
193err_algfetch:
194  pDelete(&result);
195  WerrorS("denominator in algnumber");
196  return NULL;
197}
198
199static poly maLongalgMap(poly res, ring r, poly p0, int s, int t,
200                         BOOLEAN *nom, poly monpart, ideal F)
201{
202  number cc;
203  napoly a0, b0;
204  poly q, q0, q1 = NULL;
205  int i;
206 
207  if (s == 0)
208  {
209    if (t!=0)
210    {
211      nNew(&cc);
212      b0 = napNew();
213      napGetCoeff(b0) = pGetCoeff(p0);
214      naGetNom(cc) = b0;
215      pMultN(monpart,cc);
216      napGetCoeff(b0) = NULL;
217      nDelete(&cc);
218    }
219    else
220    {
221      pMultN(monpart,pGetCoeff(p0));
222    }
223    pSetCompP(monpart, pRingGetComp(r, p0));
224    return pAdd(res, monpart);
225  }
226  if (naGetDenom(pGetCoeff(p0)) != NULL)
227  {
228    *nom = TRUE;
229    WerrorS("denominator in algnumber");
230    pDelete(&monpart);
231    pDelete(&res);
232    return NULL;
233  }
234  a0 = naGetNom(pGetCoeff(p0));
235  do
236  {
237    q = pInit();
238    if (t!=0)
239    {
240      pGetCoeff(q) = (number)Alloc0(sizeof(rnumber));
241      b0 = naGetNom(pGetCoeff(q)) = napNew();
242      napGetCoeff(b0) = nacCopy(napGetCoeff(a0));
243    }
244    else
245    {
246      pGetCoeff(q) = nCopy(napGetCoeff(a0));
247    }
248    for(i=0; i<s; i++)
249    {
250      if (napGetExp(a0,i+1) != 0)
251      {
252        if (F->m[i]!=NULL)
253        {
254          q0 = pPower(pCopy(F->m[i]),napGetExp(a0,i+1));
255          q = pMult(q, q0);
256        }
257        else
258        {
259          pDelete(&q);
260          break;
261        }
262      }
263    }
264    q1 = pAdd(q1, q);
265    a0 = napNext(a0);
266  }
267  while (a0 != NULL);
268  q1 = pMult(q1,monpart);
269  pSetCompP(q1,pRingGetComp(r, p0));
270  return pAdd(res, q1);
271}
272
273number maNumberOne(number x)
274{
275  return nInit(1);
276}
277
278/*2
279* return Ma(preimage)
280* Ma : k(y(1),..,y(s))[x(1),..,x(m)] -> k(y(1),..,y(t))[z(1),..,z(n)]
281* the ideals F = f_1,..,f_s and G = g_1,..,g_m in k(y(1),..,y(t))[z(1),..,z(n)]
282* are as follows:
283* f_i = Ma(y(i)), g_i = Ma(x(i))
284*/
285poly maAlgpolyMap(ring R, poly preimage, ideal F, ideal G)
286{
287  BOOLEAN nom=FALSE;
288  int m, s, t;
289  poly p0, monpart, result = NULL;
290
291  if (preimage == NULL)
292  {
293    return NULL;
294  }
295  m = R->N;
296  if (m != IDELEMS(G))
297  {
298    WerrorS("error 1 in algmap");
299    return NULL;
300  }
301  s = rPar(R);
302  if ((s!=0) && (s != IDELEMS(F)))
303  {
304    WerrorS("error 2 in algmap");
305    return NULL;
306  }
307  t = rPar(currRing);
308  p0 = preimage;
309  poly pr=NULL;
310  nMap=maNumberOne;
311  while (p0!=NULL)
312  {
313    poly pr=pNext(p0);
314    p0->next=NULL;
315    monpart = maEval((map)G, p0, R);
316    result = maLongalgMap(result, R, p0, s, t, &nom, monpart, F);
317    pTest(result);
318    if (nom)
319    {
320      return NULL;
321    }
322    p0->next = pr;
323    p0=pr;
324  }
325  return result;
326}
Note: See TracBrowser for help on using the repository browser.