source: git/Singular/maps_ip.cc @ c00e9b

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