source: git/Singular/maps_ip.cc @ 481ed7

spielwiese
Last change on this file since 481ed7 was 481ed7, checked in by Hans Schönemann <hannes@…>, 20 years ago
*hannes: better warning text git-svn-id: file:///usr/local/Singular/svn/trunk@7486 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 8.1 KB
RevLine 
[2f5b71]1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
[481ed7]4/* $Id: maps_ip.cc,v 1.6 2004-09-23 07:39:27 Singular Exp $ */
[2f5b71]5/*
6* ABSTRACT - the mapping of polynomials to other rings
7*/
8
9#include "mod2.h"
10#include "tok.h"
11#include "febase.h"
12#include "polys.h"
13#include "numbers.h"
14#include "ring.h"
15#include "ideals.h"
16#include "matpol.h"
17#include "omalloc.h"
18#include "kstd1.h"
19#include "longalg.h"
20#include "lists.h"
21#include "maps.h"
22#include "prCopy.h"
23
24/*2
25* maps the expression w to res,
26* switch what: MAP_CMD: use theMap for mapping, N for preimage ring
27*              //FETCH_CMD: use pOrdPoly for mapping
28*              IMAP_CMD: use perm for mapping, N for preimage ring
29*              default: map only poly-structures,
30*                       use perm and par_perm, N and P,
31*/
32BOOLEAN maApplyFetch(int what,map theMap,leftv res, leftv w, ring preimage_r,
33                     int *perm, int *par_perm, int P, nMapFunc nMap)
34{
35  int i;
36  int N = preimage_r->N;
37  //Print("N=%d what=%s ",N,Tok2Cmdname(what));
38  //if (perm!=NULL) for(i=1;i<=N;i++) Print("%d -> %d ",i,perm[i]);
39  //PrintS("\n");
40  //Print("P=%d ",P);
41  //if (par_perm!=NULL) for(i=0;i<P;i++) Print("%d -> %d ",i,par_perm[i]);
42  //PrintS("\n");
43  void *data=w->Data();
44  res->rtyp = w->rtyp;
45  switch (w->rtyp)
46  {
47    case NUMBER_CMD:
48      if (P!=0)
49      {
50        res->data=(void *)naPermNumber((number)data,par_perm,P, preimage_r);
51        res->rtyp=POLY_CMD;
52        if (currRing->minpoly!=NULL)
53          res->data=(void *)pMinPolyNormalize((poly)res->data);
54        pTest((poly) res->data);
55      }
56      else
57      {
58        res->data=(void *)nMap((number)data);
59        if (currRing->minpoly!=NULL)
60        {
61          number a=(number)res->data;
62          nNormalize(a);
63          res->data=(void *)a;
64        }
65        #ifdef LDEBUG
66        nTest((number) res->data);
67        #endif
68      }
69      break;
70    case POLY_CMD:
71    case VECTOR_CMD:
72      if ((what==FETCH_CMD)&& (nMap==nCopy))
73        res->data=(void *)prCopyR( (poly)data, preimage_r);
74      else
75      if ((what==IMAP_CMD) || ((what==FETCH_CMD) /* && (nMap!=nCopy)*/))
76        res->data=(void *)pPermPoly((poly)data,perm,preimage_r,nMap,par_perm,P);
77      else /*if (what==MAP_CMD)*/
78      {
79        matrix s=mpNew(N,maMaxDeg_P((poly)data, preimage_r));
80        res->data=(void *)maEval(theMap,(poly)data,preimage_r,nMap,s);
81        idDelete((ideal *)&s);
82      }
83      if (currRing->minpoly!=NULL)
84        res->data=(void *)pMinPolyNormalize((poly)res->data);
85      pTest((poly)res->data);
86      break;
87    case MODUL_CMD:
88    case MATRIX_CMD:
89    case IDEAL_CMD:
90    case MAP_CMD:
91    {
92      int C=((matrix)data)->cols();
93      int R;
94      if (w->rtyp==MAP_CMD) R=1;
95      else R=((matrix)data)->rows();
96      matrix m=mpNew(R,C);
97      char *tmpR=NULL;
98      if(w->rtyp==MAP_CMD)
99      {
100        tmpR=((map)data)->preimage;
101        ((matrix)data)->rank=((matrix)data)->rows();
102      }
103      if ((what==FETCH_CMD)&& (nMap==nCopy))
104      {
105        for (i=R*C-1;i>=0;i--)
106        {
107          m->m[i]=prCopyR(((ideal)data)->m[i], preimage_r);
108          pTest(m->m[i]);
109        }
110      }
111      else
112      if ((what==IMAP_CMD) || ((what==FETCH_CMD) /* && (nMap!=nCopy)*/))
113      {
114        for (i=R*C-1;i>=0;i--)
115        {
116          m->m[i]=pPermPoly(((ideal)data)->m[i],perm,preimage_r,nMap,par_perm,P);
117          pTest(m->m[i]);
118        }
119      }
120      else /* if(what==MAP_CMD) */
121      {
122        matrix s=mpNew(N,maMaxDeg_Ma((ideal)data,preimage_r));
123        for (i=R*C-1;i>=0;i--)
124        {
125          m->m[i]=maEval(theMap,((ideal)data)->m[i],preimage_r,nMap,s);
126          pTest(m->m[i]);
127        }
128        idDelete((ideal *)&s);
129      }
130      if (currRing->minpoly!=NULL)
131      {
132        for (i=R*C-1;i>=0;i--)
133        {
134          m->m[i]=pMinPolyNormalize(m->m[i]);
135          pTest(m->m[i]);
136        }
137      }
138      if(w->rtyp==MAP_CMD)
139      {
140        ((map)data)->preimage=tmpR;
141        ((map)m)->preimage=omStrDup(tmpR);
142      }
143      else
144      {
145        m->rank=((matrix)data)->rank;
146      }
147      res->data=(char *)m;
148      idTest((ideal) m);
149      break;
150    }
151
152    case LIST_CMD:
153    {
154      lists l=(lists)data;
155      lists ml=(lists)omAllocBin(slists_bin);
156      ml->Init(l->nr+1);
157      for(i=0;i<=l->nr;i++)
158      {
159        if (((l->m[i].rtyp>BEGIN_RING)&&(l->m[i].rtyp<END_RING))
160        ||(l->m[i].rtyp==LIST_CMD))
161        {
162          if (maApplyFetch(what,theMap,&ml->m[i],&l->m[i],
163                           preimage_r,perm,par_perm,P,nMap))
164          {
165            ml->Clean();
166            omFreeBin((ADDRESS)ml, slists_bin);
167            res->rtyp=0;
168            return TRUE;
169          }
170        }
171        else
172        {
173          ml->m[i].Copy(&l->m[i]);
174        }
175      }
176      res->data=(char *)ml;
177      break;
178    }
179    default:
180    {
181      return TRUE;
182    }
183  }
184  return FALSE;
185}
186
187/*2
188* substitutes the parameter par (from 1..N) by image,
189* does not destroy p and  image
190*/
191poly pSubstPar(poly p, int par, poly image)
192{
193  ideal theMapI=idInit(rPar(currRing),1);
194  nMapFunc nMap=nSetMap(currRing->algring);
195
196  int i;
197  poly pp;
198  for(i=rPar(currRing);i>0;i--)
199  {
200    if (i!=par)
201    {
202      pp=theMapI->m[i-1]=pOne();
203      lnumber n=(lnumber)pGetCoeff(pp);
204      p_SetExp(n->z,i,1,currRing->algring);
205      p_Setm(n->z,currRing->algring);
206    }
207    else
208      theMapI->m[i-1]=pCopy(image);
209  }
210
211  map theMap=(map)theMapI;
212  theMap->preimage=NULL;
213
214  leftv v=(leftv)omAllocBin(sleftv_bin);
215  sleftv tmpW;
216  poly res=NULL;
217  while (p!=NULL)
218  {
219    memset(&tmpW,0,sizeof(sleftv));
220    memset(v,0,sizeof(sleftv));
221    tmpW.rtyp=POLY_CMD;
222    lnumber n=(lnumber)pGetCoeff(p);
223    tmpW.data=n->z;
[481ed7]224    if (n->n!=NULL) WarnS("ignoring denominators of coefficients...");
[2f5b71]225    if (maApplyFetch(MAP_CMD,theMap,v,&tmpW,currRing->algring,NULL,NULL,0,nMap))
226    {
227      WerrorS("map failed");
228      v->data=NULL;
229    }
230    pp=pHead(p);
231    //PrintS("map:");pWrite(pp);
232    pSetCoeff(pp,nInit(1));
233    //PrintS("->");pWrite((poly)(v->data));
234    poly ppp=pMult((poly)(v->data),pp);
235    //PrintS("->");pWrite(ppp);
236    res=pAdd(res,ppp);
237    pIter(p);
238  }
239  idDelete((ideal *)(&theMap));
240  omFreeBin((ADDRESS)v, sleftv_bin);
241  return res;
242}
243
244/*2
[5bdabc]245* substitute the n-th parameter by the poly e in id
[2f5b71]246* does not destroy id and e
247*/
248ideal  idSubstPar(ideal id, int n, poly e)
249{
250  int k=MATROWS((matrix)id)*MATCOLS((matrix)id);
251  ideal res=(ideal)mpNew(MATROWS((matrix)id),MATCOLS((matrix)id));
252
253  res->rank = id->rank;
254  for(k--;k>=0;k--)
255  {
256    res->m[k]=pSubstPar(id->m[k],n,e);
257  }
258  return res;
259}
260
261/*2
262* substitutes the variable var (from 1..N) by image,
263* does not destroy p and  image
264*/
265poly pSubstPoly(poly p, int var, poly image)
266{
[5bdabc]267#ifdef HAVE_PLURAL
[e1f17c]268  if (rIsPluralRing(currRing))
269  {
270    return pSubst(pCopy(p),var,image);
271  }
[5bdabc]272#endif
[2f5b71]273  map theMap=(map)idMaxIdeal(1);
274  theMap->preimage=NULL;
275  pDelete(&(theMap->m[var-1]));
276  theMap->m[var-1]=pCopy(image);
277
278  leftv v=(leftv)omAlloc0Bin(sleftv_bin);
279  sleftv tmpW;
280  memset(&tmpW,0,sizeof(sleftv));
281  tmpW.rtyp=POLY_CMD;
282  tmpW.data=p;
283  poly res=NULL;
284  if (maApplyFetch(MAP_CMD,theMap,v,&tmpW,currRing,NULL,NULL,0,nCopy))
285  {
286    WerrorS("map failed");
287    v->data=NULL;
288  }
289  res=(poly)(v->data);
290  idDelete((ideal *)(&theMap));
291  omFreeBin((ADDRESS)v, sleftv_bin);
292  return res;
293}
294
295/*2
296* substitute the n-th variable by the poly e in id
297* does not destroy id and e
298*/
299ideal  idSubstPoly(ideal id, int n, poly e)
300{
301
[e4611fa]302#ifdef HAVE_PLURAL
303  if (rIsPluralRing(currRing))
[2f5b71]304  {
[e4611fa]305    int k=MATROWS((matrix)id)*MATCOLS((matrix)id);
306    ideal res=(ideal)mpNew(MATROWS((matrix)id),MATCOLS((matrix)id));
307    res->rank = id->rank;
308    for(k--;k>=0;k--)
309    {
310      res->m[k]=pSubst(pCopy(id->m[k]),n,e);
311    }
312    return res;
[2f5b71]313  }
[e4611fa]314#endif
315  map theMap=(map)idMaxIdeal(1);
316  theMap->preimage=NULL;
317  pDelete(&(theMap->m[n-1]));
318  theMap->m[n-1]=pCopy(e);
319
320  leftv v=(leftv)omAlloc0Bin(sleftv_bin);
321  sleftv tmpW;
322  memset(&tmpW,0,sizeof(sleftv));
323  tmpW.rtyp=IDEAL_CMD;
324  tmpW.data=id;
325  if (maApplyFetch(MAP_CMD,theMap,v,&tmpW,currRing,NULL,NULL,0,nCopy))
326  {
327    WerrorS("map failed");
328    v->data=NULL;
329  }
330  ideal res=(ideal)(v->data);
331  idDelete((ideal *)(&theMap));
332  omFreeBin((ADDRESS)v, sleftv_bin);
[2f5b71]333  return res;
334}
Note: See TracBrowser for help on using the repository browser.