source: git/Tst/Old/lib0 @ b35b93

spielwiese
Last change on this file since b35b93 was b35b93, checked in by Olaf Bachmann <obachman@…>, 26 years ago
This commit was generated by cvs2svn to compensate for changes in r1396, which included commits to RCS files with non-trunk default branches. git-svn-id: file:///usr/local/Singular/svn/trunk@1397 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 27.7 KB
Line 
1//===========================================================================//
2// LIBRARY:  lib0           library of some general procedures               //
3//           type lib0();   to list the procedures                           //
4//                          7/94 GMG+BM                                      //
5//===========================================================================//
6
7proc A_Z (string s,int n)
8USAGE:    A_Z("a",n);  a any letter, n integer (-26<= n <=26, !=0)
9RETURN:   string of n small (if a is small) or capital (if a is capital)
10          letters, comma seperated, beginning with a, in alphabetical
11          order (or revers alphabetical order if n<0)
12EXAMPLE:  example A_Z; shows an example
13{
14  if (n>=-26 and n<=26 and n!=0 )
15  {
16    string @alpha =
17      "a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,"+
18      "a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,"+
19      "A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z,"+
20      "A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z";
21    int @ii; int @aa;
22    for (@ii=1; @ii<=51; @ii=@ii+2)
23    {
24      if ( @alpha[@ii] ==  s )
25      {
26        @aa = @ii;
27      }
28    }
29    if ( @aa == 0)
30    {
31      for (@ii=105; @ii<=155; @ii=@ii+2)
32      {
33        if ( @alpha[@ii] ==  s )
34        {
35          @aa = @ii;
36        }
37     }
38    }
39  }
40  if ( @aa != 0)
41  {
42    string @out;
43    if (n > 0)
44    {
45      @out = @alpha[@aa,2*(n)-1];
46      return (@out);
47    }
48    string @beta =
49      "z,y,x,w,v,u,t,s,r,q,p,o,n,m,l,k,j,i,h,g,f,e,d,c,b,a,"+
50      "z,y,x,w,v,u,t,s,r,q,p,o,n,m,l,k,j,i,h,g,f,e,d,c,b,a,"+
51      "Z,Y,X,W,V,U,T,S,R,Q,P,O,N,M,L,K,J,I,H,G,F,E,D,C,B,A,"+
52      "Z,Y,X,W,V,U,T,S,R,Q,P,O,N,M,L,K,J,I,H,G,F,E,D,C,B,A";
53    if ( @aa < 52 )
54    {
55      @aa=52-@aa;
56    }
57    if ( @aa > 104 )
58    {
59      @aa=260-@aa;
60    }
61    @out = @beta[@aa,2*(-n)-1];
62    return (@out);
63  }
64}
65example
66{
67//--------------------------------- EXAMPLE ----------------------------------
68  "EXAMPLE:";
69  "   A_Z(\"c\",5);";                                        A_Z("c",5);
70  "   A_Z(\"Z\",-5);";                                       A_Z("Z",-5);
71  "   string sR = \"ring R = (0,\"+A_Z(\"A\",6)+\"),(\"+A_Z(\"a\",10)+\"),dp;\" ";
72    string @sR = "ring R = (0,"+A_Z("A",6)+"),("+A_Z("a",10)+"),dp;";
73  "   sR;";                                                  @sR;
74  "   execute sR;";                                          execute @sR;
75  "   R;";                                                   R;
76  "   kill R;";                                              kill R;
77}
78///////////////////////////////////////////////////////////////////////////////
79proc bin (int n,int m)
80USAGE:    bin(n,m);   n, m integers
81RETURN:   n choose m  of type <int>, limited size (machine integers)!
82NOTE:     Use proc binom and ring of characteristic 0 for bigger integers
83{
84  int @r;
85  if ( m < 0 or m > n )
86  {
87    return(@r);
88  }
89  @r=1;
90  if (m == 0)
91  {
92    return(@r);
93  }
94  if (m >= n-m)
95  {
96    m=n-m;
97  }
98  for (int @l=1 ; @l<=m ; @l=@l+1 )
99  {
100    @r=@r*(n+1-@l) / @l;
101  }
102  return (@r);
103}
104example
105{
106  "EXAMPLE:";
107  " bin(7,3);";                   bin(7,3);
108  " int n=10; int m=7;";          int @n=10; int @m=7;
109  " int b=bin(n,m); b;";          int @b=bin(@n,@m); @b;
110  kill @n,@m,@b;
111}
112///////////////////////////////////////////////////////////////////////////////
113
114proc binom
115{
116   if (#ARGS !=1 and #ARGS !=2)
117   {
118//=============================================================================
119  " USAGE:   binom(n,k); n, k integers";
120  " RETURN:  n choose k  of type <poly>, uses characteristic of basering";
121  " NOTE:    needs a basering(!), result is computed in corresponding char,";
122  "          for small integers you may use procedure bin;";
123  " EXAMPLE: binom(\"ex\"); shows an example";
124//=============================================================================
125      return();
126   }
127
128   parameter = "n", "k";
129   if( #ARGS ==2 and defined(basering) )
130   {
131      if ( typeof(#1) == "int" and typeof(#2) == "int" )
132      {
133         poly @r;
134         if (#k < 0)
135         {
136            return(@r);
137         }
138         if (#k > #n)
139         {
140         return(@r);
141         }
142         @r=1;
143         if (#k == 0)
144         {
145            return(@r);
146         }
147         if (#k >= #n-#k)
148         {
149            #k = #n-#k;
150         }
151         int @l;
152         string @st;
153         for (@l=1 ; @l<=#k ; @l=@l+1 )
154         {
155            @r=@r*(#n+1-@l);
156            @st="@r=@r*(1/"+string(@l)+");";
157            execute(@st);
158         }
159         return (@r);
160      }
161   }
162//--------------------------------- EXAMPLE -----------------------------------
163   if (( typeof(#1) == "string" ) and ( #1 == "ex" ))
164   {
165      "EXAMPLE:";
166      " ring r1=0,x,ls;";             ring @r1=0,x,ls;
167      " binom(37,17);";               binom(37,17);
168      " ring r2=31,x,dp;";            ring @r2=31,x,dp;
169      " poly p = binom(37,17);p;";    poly @p = binom(37,17);@p;
170      return();
171   }
172   " USAGE:   binom(n,k); n, k integers";
173   " RETURN:  n choose k  of type <poly>, uses characteristic of basering";
174   " NOTE:    needs a basering(!), result is computed in corresponding char,";
175   "          for small integers you may use procedure bin;";
176   " EXAMPLE: binom(\"ex\"); shows an example";
177}
178///////////////////////////////////////////////////////////////////////////////
179
180proc fac
181{
182   if ( #ARGS !=1 )
183   {
184//=============================================================================
185  " USAGE:   fac(n);  (n integer)";
186  " RETURN:  n!, of type <poly>, uses characteristic of basering";
187  " NOTE:    needs a basering(!), result is computed in corresponding char,";
188  " EXAMPLE: fac(\"ex\"); shows an example";
189//=============================================================================
190      return();
191   }
192
193   parameter = "n";
194   if( typeof(#1) == "int" and defined(basering) )
195   {
196      poly @p=1;
197      int @i;
198      for ( @i=1; @i<=#n; @i=@i+1)
199      {
200         @p=@p*@i;
201      }
202      return(@p);
203   }
204//--------------------------------- EXAMPLE -----------------------------------
205   if (( typeof(#1) == "string" ) and ( #1 == "ex" ))
206   {
207      "EXAMPLE:";
208      " ring r1=0,x,ls;";             ring @r1=0,x,ls;
209      " fac(37);";                    fac(37);
210      " ring r2=17,x,dp;";            ring @r2=17,x,dp;
211      " poly p = fac(37);p;";         poly @p = fac(37);@p;
212      return();
213   }
214   " USAGE:   fac(n);  (n integer)";
215   " RETURN:  n!, of type <poly>, uses characteristic of basering";
216   " NOTE:    needs a basering(!), result is computed in corresponding char,";
217   " EXAMPLE: fac(\"ex\"); shows an example";
218}
219///////////////////////////////////////////////////////////////////////////////
220
221proc koszul1
222{
223   if (#ARGS != 1 and #ARGS != 2)
224   {
225//=============================================================================
226" USAGE:    koszul1(<ideal>,n); n integer";
227" RETURN:   <matrix>:= n-th koszul1 matrix of <ideal>";
228" EXAMPLE:  koszul1(\"ex\"); shows an example";
229//=============================================================================
230     return();
231   }
232
233   if (#ARGS == 2)
234   {
235      if (typeof(#1) == "ideal" and typeof(#2) == "int")
236      {
237//-------------------------- compare_index(iv,iv) -----------------------------
238 proc compare_ind
239 {
240   parameter="v1","v2";
241   int @q=size(#v1);
242   intvec @res;
243   int @a;int @b;int @c=1;int @d;
244   for (@a=1; @a<=@q; @a=@a+1)
245   {
246      @b=@b+1;
247      if (#v1[@a] != #v2[@b])
248      {
249         @d=@d+1;
250         if (@d>1)
251         {
252            @res=0,1;
253            return(@res);
254         }
255         @res=#v2[@b],@c;
256         @a=@a-1;
257      }
258      @c=-@c;
259      if (@d == 0)
260      {
261         @res=#v2[@q+1],@c;
262      }
263   }
264   return(@res);
265 }
266//--------------------------- next_ind(#iv,#n,#p) -----------------------------
267 proc next_ind
268 {
269    parameter="v","n","p";
270    int @l;int @q;int @s;intvec @res=#v;
271    for ( @l=#p; @l>0; @l=@l-1 )
272    {
273       @s=#v[@l]-#n+#p-@l;
274       if (@s<0)
275       {
276          @s=#v[@l];
277          for (@q=@l; @q<=#p; @q=@q+1 )
278          {
279             @res[@q]=@s+@q-@l+1;
280          }
281          return(@res);
282       }
283    }
284    return(0);
285 }
286//------------------------------ alt_ind(#n,#p) -------------------------------
287 proc alt_ind
288 {
289   parameter="n","p";
290   int @m=bin(#n,#p);int @a;
291   intvec ind(1)=1..#p;
292   for (  @a=2; @a<=@m; @a=@a+1 )
293   {
294     intvec ind(@a)=next_ind(ind(@a-1),#n,#p);
295   }
296   return();
297 }
298//------------------------------- end_ind(#m) ---------------------------------
299 proc end_ind
300 {
301   parameter="m";
302   int @n;
303   for (@n=1; @n<=#m; @n=@n+1)
304   {
305      kill ind(@n);
306   }
307   return();
308 }
309//------------------------------ koszul1(id,nr) --------------------------------
310      int @t;
311      int @w;
312      int @e;
313      int @n=ncols(#1);
314      int @p=#2;
315      ideal @id=#1;
316      intvec @zz;
317      if ((@p>@n) or (@p<=0))
318      {
319         kill compare_ind; kill next_ind; kill alt_ind; kill end_ind;
320         return("#2 out of range");
321      }
322      int @c=bin(@n,@p);
323      int @r=bin(@n,@p-1);
324      matrix @res[@r][@c];
325      alt_ind(@n,@p);
326      intvec @riv=1..@p-1;
327      for (@t=1; @t<=@n-@p+1; @t=@t+1)
328      {
329         @res[1,@t]=@id[@t+@p-1];
330         if (@p-2*(@p/2)==0)
331         {
332            @res[1,@t]=-@res[1,@t];
333         }
334      }
335      for (@e=2; @e<=@r; @e=@e+1)
336      {
337         @riv=next_ind(@riv,@n,@p-1);
338         for (@w=1; @w<=@c; @w=@w+1)
339         {
340            @zz=compare_ind(@riv,ind(@w));
341            if (@zz[1] != 0)
342            {
343               @res[@e,@w]=@id[@zz[1]]*@zz[2];
344            }
345         }
346      }
347      end_ind(@c);
348      kill compare_ind; kill next_ind; kill alt_ind; kill end_ind;
349      return(@res);
350   }
351   }
352//--------------------------------- EXAMPLE -----------------------------------
353   if (( typeof(#1)=="string") and (#1 == "ex"))
354   {
355      "EXAMPLE:";
356      " ring r=200,(a,b,c,d),ds;"; ring @r=200,(a,b,c,d),ds;
357      " ideal i=a,b,c,d;";         ideal @i=a,b,c,d;
358      " pmat(koszul1(i,2));";       pmat(koszul1(@i,2));
359      return();
360   }
361   " USAGE:    koszul1(<id>,<int>);";
362   " RETURN:   <mat>:= i-th koszul1 matrix of <id>";
363   " EXAMPLE:  koszul1(\"ex\"); shows an example";
364}
365///////////////////////////////////////////////////////////////////////////////
366
367proc mem
368{
369   if ( #ARGS !=1 )
370   {
371//=============================================================================
372  " USAGE:   mem(n);  n integer ";
373  " RETURNS: mem(0) = memory used by active variables";
374  "          mem(1) = total memory used";
375//=============================================================================
376      return();
377   }
378
379   parameter = "n";
380   if (typeof(#n) == "int")
381   {
382      if (#n == 0)
383      {
384         string @m =
385         "//memory used by active variables: ",string((memory(0)+1023)/1024),"k";
386         return(@m);
387      }
388      if (#n != 0)
389      {
390         string @m =
391         "//total memory used: ",string((memory(1)+1023)/1024),"k";
392         return(@m);
393      }
394   }
395//--------------------------------- EXAMPLE -----------------------------------
396   if ( typeof(#1) == "string" )
397   {  if ( #1 == "ex" )
398      {
399         "EXAMPLE:";
400         " mem(0);";                         mem(0);
401         " string s=mem(1); s;";             string @s=mem(1); @s;
402         return();
403       }
404   }
405   " USAGE:   mem(n);  n integer ";
406   " RETURNS: mem(0) = memory used by active variables";
407   "          mem(1) = total memory used";
408             return();
409}
410///////////////////////////////////////////////////////////////////////////////
411
412proc multiply
413{
414   if (#ARGS !=1 and #ARGS !=2)
415   {
416//=============================================================================
417  " USAGE1:  multiply(<ideal/poly>,<module>);";
418  " RETURN:  module <ideal/poly>*<module>";
419  " USAGE2:  multiply(<ideal>,<matrix>);";
420  " RETURN:  ideal <ideal>*<matrix> (consider <ideal> as row vector)";
421  " USAGE3:  multiply(<poly>,<matrix>);";
422  " RETURN:  matrix <poly>*<matrix> (mult. each entry of <matrix> with <poly>)";
423  " USAGE4:  multiply(<matrix>,<vector>);";
424  " RETURN:  vector <matrix>*<vector> (consider <vector> as column vector)";
425  " EXAMPLE: multiply(\"ex\"); shows an example";
426//=============================================================================
427      return();
428   }
429
430   parameter = "i", "m";
431   if ( #ARGS == 2 )
432   {
433      int @ii; int @jj;
434//-------------------------- <ideal/poly>*<module> ----------------------------
435      if ((typeof(#i)=="ideal" or typeof(#i)=="poly") and typeof(#m)=="module")
436      {
437         ideal @i = #i;
438         module @m; module @mo;
439         for ( @ii=1; @ii<=size(@i); @ii=@ii+1 )
440         {
441            for ( @jj=1; @jj<=size(#m); @jj=@jj+1 )
442            {
443               @m = @m,@i[@ii]*#m[@jj];
444            }
445         }
446         return(@m+@mo);
447      }
448//----------------------------- <ideal>*<matrix> ------------------------------
449      if ( typeof(#i) == "ideal" and typeof(#m) == "matrix" )
450      {
451         if ( nrows(#m) != ncols(#i) )
452         {
453         "//size not compatible: ncols(<ideal>) != nrows(<matrix>)";
454         return();
455         }
456         return(ideal(matrix(#i)*#m));
457      }
458//----------------------------- <poly>*<matrix> -------------------------------
459      if ( typeof(#i) == "poly" and typeof(#m) == "matrix")
460      {
461         matrix @m[nrows(#m)][ncols(#m)];
462         for ( @ii=1; @ii<=nrows(#m); @ii=@ii+1 )
463         {
464            for ( @jj=1; @jj<=ncols(#m); @jj=@jj+1 )
465            {
466               @m[@ii,@jj] = #1*#m[@ii,@jj];
467            }
468         }
469         return(@m);
470      }
471//----------------------------- <matrix>*<vector> -----------------------------
472      if ( typeof(#i) == "matrix" and typeof(#m) == "vector" )
473      {
474         module @m=#m;
475         matrix @a=matrix(@m);
476         if ( nrows(@a) != ncols(#i) )
477         {
478         "//size not compatible: ncols(<matrix>) != nrows(<vector>)";
479         return();
480         }
481         module @i = module(#i*@a);
482         vector @v = @i[1];
483         return(@v);
484      }
485   }
486//--------------------------------- EXAMPLE -----------------------------------
487   if (( typeof(#1) == "string" ) and ( #1 == "ex" ))
488   {
489      "EXAMPLE:";
490      " ring r=0,(x,y,z),(c,dp);";          ring @r=0,(x,y,z),(c,dp);
491      " ideal i = xy,xz,yz;";               ideal @i = xy,xz,yz;
492      " poly f = xyz;";                     poly @f = xyz;
493      " module m = [1,2,3],[x,y,z];";       module @m = [1,2,3],[x,y,z];
494      " vector v = [xy,xz,yz];";            vector @v = [xy,xz,yz];
495      " matrix M[2][3] = 1,2,3,x,y,z;";     matrix @M[2][3] =1,2,3,x,y,z;
496      " pmat(M);";                          pmat(@M);
497      " multiply(i,m);";                    multiply(@i,@m);
498      " multiply(f,m);";                    multiply(@f,@m);
499      " multiply(i,transpose(M));";         multiply(@i,transpose(@M));
500      " pmat(multiply(f,M));";              pmat(multiply(@f,@M));
501      " multiply(M,v);";                    multiply(@M,@v);
502      return();
503   }
504   " USAGE1:  multiply(<ideal/poly>,<module>);";
505   " RETURN:  module <ideal/poly>*<module>";
506   " USAGE2:  multiply(<ideal>,<matrix>);";
507   " RETURN:  ideal <ideal>*<matrix> (consider <ideal> as row vector)";
508   " USAGE3:  multiply(<poly>,<matrix>);";
509   " RETURN:  matrix <poly>*<matrix> (mult. each entry of <matrix> with <poly>)";
510   " USAGE4:  multiply(<matrix>,<vector>);";
511   " RETURN:  vector <matrix>*<vector> (consider <vector> as column vector)";
512   " EXAMPLE: multiply(\"ex\"); shows an example";
513}
514///////////////////////////////////////////////////////////////////////////////
515
516proc pmat (matrix m,list #)
517USAGE:    pmat(<matrix>,[n]);  n integer
518RETURNS:  <matrix> in array format if it fits into pagewidth. If n is
519          given, only the first n characters of each colum are shown
520{
521  if ( size(#) == 0)
522  {
523//------------- main case: input is a matrix, no second argument---------------
524    int @elems;
525    int @mlen;
526    int @slen;
527    int @c;
528    int @r;
529//-------------- count maximal size of each column, and sum up ----------------
530
531    for ( @c=1; @c<=ncols(m); @c=@c+1)
532    {  int @len(@c);
533      for (@r=1; @r<=nrows(m); @r=@r+1)
534      {
535        @elems = @elems + 1;
536        string @s(@elems) = string(m[@r,@c])+",";
537        @slen = size(@s(@elems));
538        if (@slen > @len(@c))
539        {
540          @len(@c) = @slen;
541        }
542      }
543      @mlen = @mlen + @len(@c);
544    }
545//---------------------- print all - except last - rows -----------------------
546
547    string @aus;
548    string @sep = " ";
549    if (@mlen >= pagewidth)
550    {
551      @sep = newline;
552    }
553
554    for (@r=1; @r<nrows(m); @r=@r+1)
555    {
556      @elems = @r;
557      @aus = "";
558      for (@c=1; @c<=ncols(m); @c=@c+1)
559      {
560        @aus = @aus + @s(@elems)[1,@len(@c)] + @sep;
561        @elems = @elems + nrows(m);
562      }
563      @aus;
564    }
565//--------------- print last row (no comma after last entry) ------------------
566
567    @aus = "";
568    @elems = nrows(m);
569    for (@c=1; @c<ncols(m); @c=@c+1)
570    {
571      @aus = @aus + @s(@elems)[1,@len(@c)] + @sep;
572      @elems = @elems + nrows(m);
573    }
574    @aus = @aus + string(m[nrows(m),ncols(m)]);
575    @aus;
576    return();
577  }
578//--------- second case: input is a matrix, second argument is given ----------
579
580  if ( size(#) == 1 )
581  {
582    if ( typeof(#[1]) == "int" )
583    {
584      string @aus;
585      string @tmp;
586      int @ll;
587      int @c;
588      int @r;
589      for ( @r=1; @r<=nrows(m); @r=@r+1)
590      {
591        @aus = "";
592        for (@c=1; @c<=ncols(m); @c=@c+1)
593        {
594          @tmp = string(m[@r,@c]);
595          @aus = @aus + @tmp[1,#[1]] + " ";
596        }
597        @aus;
598      }
599    }
600  }
601}
602example
603{
604//--------------------------------- EXAMPLE ----------------------------------
605  " EXAMPLE:";
606  " ring r=0,(x,y,z),ls;";     ring @r=0,(x,y,z),ls;
607  " ideal i= x,z+3y,x+y,z;";   ideal @i= x,z+3y,x+y,z;
608  " matrix m[3][3] =i^2;";     matrix @m[3][3]=@i^2;
609  " pmat(m);";                 pmat(@m);
610  " pmat(m,3);";               pmat(@m,3);
611  kill @r;
612}
613///////////////////////////////////////////////////////////////////////////////
614
615proc randommat
616{
617   if (#ARGS != 1 and #ARGS != 3 and #ARGS != 5)
618   {
619//=============================================================================
620  " USAGE:   randommat(n,m,d[,u,o]);  n,m,d,u,o integers";
621  " RETURNS: nxm matrix with entries homogeneous polynomials of degree d";
622  "          [and coefficients between u and o]";
623  " NOTE:    For performance reasons try small bounds u and o in char 0";
624  " EXAMPLE: randommat(\"ex\"); shows an example";
625//=============================================================================
626      return();
627   }
628
629   parameter="n","m","d","u","o";
630   if (#ARGS == 3)
631   {
632      int #u=-30000;
633      int #o= 30000;
634      #ARGS=5;
635   }
636   if (#ARGS == 5)
637   {
638      if ( typeof(#n)=="int" and typeof(#m)=="int" and
639         typeof(#d)=="int" and typeof(#u)=="int" and typeof(#o)=="int" )
640      {
641         int @g =size(maxideal(#d));
642         matrix @m = matrix(maxideal(#d));
643         matrix @col[@g][1];
644         matrix @random[#n][#m];
645         int @k; int @l; int @ii;
646         for ( @k=#n; @k>0; @k=@k-1)
647         {
648            for ( @l=#m; @l>0; @l=@l-1)
649            {
650               for ( @ii=1; @ii<=@g; @ii=@ii+1)
651               {
652                  @col[@ii,1] = random(#u,#o);
653               }
654               @random[@k,@l]=(@m*@col)[1,1];
655            }
656         }
657         return(@random);
658      }
659   }
660//--------------------------------- EXAMPLE -----------------------------------
661   if (( typeof(#1) == "string" ) and  ( #1 == "ex" ))
662   {
663      "EXAMPLE:";
664      " ring r=0,(x,y,z),dp;";            ring @r=0,(x,y,z),dp;
665      " matrix A=randommat(3,3,2,-9,9);"; matrix @A=randommat(3,3,2,-9,9);
666      " A; pmat(A);";                     @A; pmat(@A);
667      return();
668   }
669   " USAGE:   randommat(n,m,d[,u,o]);  n,m,d,u,o integers";
670   " RETURNS: nxm matrix with entries homogeneous polynomials of degree d";
671   "          [and coefficients between u and o]";
672   " NOTE:    For performance reasons try small bounds u and o in char 0";
673   " EXAMPLE: randommat(\"ex\"); shows an example";
674}
675///////////////////////////////////////////////////////////////////////////////
676
677proc shift
678{
679   if ( #ARGS != 1 and #ARGS != 2 )
680   {
681//=============================================================================
682  " USAGE:    shift(<ideal>,n);  n integer";
683  " RETURN:   module <ideal>*gen(n), n-th component generated by <ideal>";
684  " EXAMPLE:  shift(\"ex\"); shows an example";
685//=============================================================================
686      return();
687   }
688
689   parameter = "i","n";
690   if (#ARGS == 2)
691   {
692      if (typeof(#1) == "ideal" and typeof(#2) == "int")
693      {
694         module @m=#i[1]*gen(#n);
695         for (int @n=2; @n<=ncols(#i) ; @n=@n+1 )
696         {
697            @m=@m,#i[@n]*gen(#n);
698         }
699         return(@m);
700      }
701   }
702//--------------------------------- EXAMPLE ----------------------------------
703   if (( typeof(#1) == "string" ) and ( #1 == "ex" ))
704   {
705      "EXAMPLE:";
706      " ring r = 0,(x,y,z),(c,dp);";        ring @r= 0,(x,y,z),(c,dp);
707      " ideal i = xy,xz,yz;";               ideal @i= xy,xz,yz;
708      " module m = shift(i,2)+shift(i,4);"; module @m=shift(@i,2)+shift(@i,4);
709      " m;";                                @m;
710      return();
711   }
712   " USAGE:    shift(<ideal>,n);  n integer";
713   " RETURN:   module <ideal>*gen(n), n-th component generated by <ideal>";
714   " EXAMPLE:  shift(\"ex\"); shows an example";
715   return();
716}
717///////////////////////////////////////////////////////////////////////////////
718
719proc sum
720{
721   if ( #ARGS !=1 )
722   {
723//=============================================================================
724  " USAGE:    sum(v);  v vector or intvec";
725  " RETURN:   <poly> or <int> = sum of components of v";
726  " EXAMPLE:  sum(\"ex\"); shows an example";
727//=============================================================================
728      return();
729   }
730
731   if ( #ARGS ==1 )
732   {
733      if ( typeof(#1) == "vector" )
734      {
735         poly @v;
736         module @m = #1;
737         matrix @mat=matrix(@m);
738         for ( int @n=1 ; @n<=nrows(@mat); @n=@n+1)
739         {
740            @v=@v+@mat[@n,1];
741         }
742         return(@v);
743      }
744      if ( typeof(#1) == "intvec" )
745      {
746         int @v;
747         for (int @n=1 ; @n<=size(#1); @n=@n+1)
748         {
749            @v=@v+#1[@n];
750         }
751         return(@v);
752      }
753   }
754//--------------------------------- EXAMPLE ----------------------------------
755   if (( typeof(#1) == "string" ) and ( #1 == "ex" ))
756   {
757      "EXAMPLE:";
758      " ring r = 0,(x,y,z),dp;";            ring @r= 0,(x,y,z),dp;
759      " vector v = [xy,xz,yz];";            vector @pv = [xy,xz,yz];
760      " sum(v);";                           sum(@pv);
761      " intvec iv = 1,2,3,4,5;";            intvec @iv = 1,2,3,4,5;
762      " sum(iv);";                          sum(@iv);
763      return();
764   }
765   " USAGE:    sum(v);  v vector or intvec";
766   " RETURN:   <poly> or <int> = sum of components of v";
767   " EXAMPLE:  sum(\"ex\"); shows an example";
768   return();
769}
770///////////////////////////////////////////////////////////////////////////////
771
772proc trmod
773{
774   if (#ARGS != 1)
775   {
776//=============================================================================
777  " USAGE:    trmod(<module>);";
778  " RETURNS:  transposed (dual) module";
779  " EXAMPLE:  trmod(\"ex\"); shows an example";
780//=============================================================================
781      return();
782   }
783
784   if (typeof(#1) == "module")
785   {
786      matrix @mat=matrix(#1);
787      module @mod=module(transpose(@mat));
788      return(@mod);
789    }
790//--------------------------------- EXAMPLE ----------------------------------
791   if (( typeof(#1) == "string" ) and ( #1 == "ex" ))
792   {
793      "EXAMPLE:";
794      " ring r = 0,(x,y,z),(c,dp);";        ring @r= 0,(x,y,z),(c,dp);
795      " module m = [xy,xz,yz]; m;";         module m = [xy,xz,yz]; m;
796      " m = trmod(m); m;";                  m=trmod(m); m;
797      return();
798   }
799   " USAGE:    trmod(<module>);";
800   " RETURNS:  transposed (dual) module";
801   " EXAMPLE:  trmod(\"ex\"); shows an example";
802   return();
803}
804///////////////////////////////////////////////////////////////////////////////
805
806proc tab
807USAGE:    tab(n);  (n integer)
808RETURNS:  string of n space tabs
809EXAMPLE:  example tab; shows an example
810{
811  if (#ARGS == 1)
812  {
813    if (typeof(#1) == "int")
814    {
815      if (#1 == 0)
816      {
817        return("");
818      }
819      string @s=" ";
820      return(@s[1,#1]);
821    }
822  }
823}
824example
825{
826  "EXAMPLE:";
827  " for(int n=0; n<=5; n=n+1)";
828  " { tab(5-n)+\"*\"+tab(n)+\"+\"+tab(n)+\"*\"; }";
829  for(int @n=0; @n<=5; @n=@n+1)
830  {
831     tab(5-@n)+"*"+tab(@n)+"+"+tab(@n)+"*";
832  }
833  kill @n;
834}
835///////////////////////////////////////////////////////////////////////////////
836
837proc primes
838{
839   if ( #ARGS !=2 and #ARGS != 1)
840   {
841//=============================================================================
842 " USAGE:   primes(n,m);  n,m integers ";
843 " RETURNS: intvec, consisting of all primes p, prime(n)<=p<=m, in increasing";
844 "          order if n<m, resp. prime(m)<=p<=n, in decreasing order if m<n";
845 " EXAMPLE: primes(\"ex\"); shows an example";
846//=============================================================================
847      return();
848   }
849
850   parameter = "n", "m";
851   if ( #ARGS ==2 )
852   {
853      if ( typeof(#n)=="int" and typeof(#m)=="int" )
854      {
855         int @n = #n; int @m = #m;
856         if (#n>#m)
857         {
858            @n=#m ; @m= #n;
859         }
860         int @q = prime(@m);
861         int @p = prime(@n);
862         intvec @v = @q;
863         @q = @q-1;
864         if ( #n>#m )
865         {
866            while ( @q>=@p )
867            {
868               @q = prime(@q);
869               @v = @v,@q;
870               @q = @q-1;
871            }
872            return(@v);
873         }
874         while ( @q>=@p )
875         {
876            @q = prime(@q);
877            @v = @q,@v;
878            @q = @q-1;
879         }
880         return(@v) ;
881      }
882   }
883//--------------------------------- EXAMPLE -----------------------------------
884   if (( typeof(#1) == "string" ) and ( #1 == "ex" ))
885   {
886      "EXAMPLE:";
887      "primes(50,100);";                primes(50,100);
888      "intvec v=primes(37,1); v;";      intvec @v = primes(37,1); @v;
889      return();
890   }
891   " USAGE:   primes(n,m);  n,m integers ";
892   " RETURNS: intvec, consisting of all primes p, prime(n)<=p<=m, in increasing";
893   "          order if n<m (resp. prime(m)<=p<=n, in decreasing order if m<n)";
894   " EXAMPLE: primes(\"ex\"); shows an example";
895}
896///////////////////////////////////////////////////////////////////////////////
897
898proc split
899{
900   if ( #ARGS!=1 and #ARGS!=2 )
901   {
902//=============================================================================
903  " USAGE:    split(s,n); s string, n integer ";
904  " RETURNS:  same string, split into lines of length n separated by \\";
905  " EXAMPLE:  split(\"ex\"); shows an example";
906//=============================================================================
907      return();
908   }
909
910   parameter = "s","n";
911   if ( #ARGS == 2 )
912   {
913      if ( typeof(#s) == "string" and typeof(#n) == "int" )
914      {
915         string @line;
916         string @res="";
917         int @l=size(#s);
918         int @p;
919         int @i;
920         if ( #s[@l,1] != newline )
921         {
922             #s=#s+newline;
923         }
924         while (1)
925         {
926            @l=find(#s,newline);
927            @line=#s[1,@l];
928            @p=1;
929            while ( @l>=#n )
930            {
931               @res=@res+@line[@p,#n-1]+"\\"+newline;
932               @p=@p+#n-1;
933               @l=@l-#n+1;
934            }
935            @res=@res+@line[@p,@l];
936            @l=size(@line);
937            if ( @l>=size(#s)) break;
938            #s=#s[@l+1,size(#s)-@l];
939         }
940         return (@res);
941      }
942   }
943//--------------------------------- EXAMPLE ----------------------------------
944   if (( typeof(#1) == "string" ) and ( #1 == "ex" ))
945   {
946      "EXAMPLE:";
947      " ring r = 0,(x,y,z),ds;";       ring @r= 0,(x,y,z),ds;
948      " poly f = (x+y+z)^9;";          poly @f = (x+y+z)^9;
949      " split(string(f),40);";         split(string(@f),40);
950      return();
951   }
952   " USAGE:    split(s,n); s string, n integer ";
953   " RETURNS:  same string, split into lines of length n separated by \\";
954   " EXAMPLE:  split(\"ex\"); shows an example";
955}
956///////////////////////////////////////////////////////////////////////////////
Note: See TracBrowser for help on using the repository browser.