source: git/Tst/Old/lib @ 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: 3.7 KB
Line 
1//
2// lib with useful ? procs
3//
4proc prideal (ideal id)
5{
6  "// ideal";
7  for (int @i=1; @i<=nrows(id); @i=@i+1)
8  {
9    "//id[" +  string(@i) + "] : "+  string(id[@i]);
10  }
11  "// dim  :", dim(id);
12  "// mult :", multiplicity(id);
13  return();
14}
15
16proc formmat (matrix m)
17{
18  int @elems = 0;
19  int @mlen  = 0;
20  int @slen  = 0;
21  int @c;
22  for (int @r=1; @r<=nrows(m); @r=@r+1)
23  {
24    for (@c=1; @c<=ncols(m); @c=@c+1)
25    {
26      @elems = @elems + 1;
27      string @s(@elems) = string(m[@r,@c]);
28      @slen = size(@s(@elems));
29      if (@slen > @mlen)
30      {
31        @mlen = @slen;
32      }
33    }
34  }
35  @elems = 0;
36  string @aus = "";
37  string @sep = " ";
38  if (@mlen * ncols(m) >= pagewidth)
39  {
40    @sep = newline;
41  }
42  for (@r=1; @r<=nrows(m); @r=@r+1)
43  {
44    for (@c=1; @c<=ncols(m); @c=@c+1)
45    {
46      @elems = @elems + 1;
47      @slen = size(@s(@elems));
48      @aus = @aus + @s(@elems)[1,@mlen] + @sep;
49    }
50    @aus = @aus + newline;
51//    @aus = "";
52  }
53  return(@aus);
54}
55proc fixmat (matrix m,int l)
56{
57  string @aus;
58  string @tmp;
59  int @ll;
60  int @c;
61  for (int @r=1; @r<=nrows(m); @r=@r+1)
62  {
63    @aus = "";
64    for (@c=1; @c<=ncols(m); @c=@c+1)
65    {
66      @tmp = string(m[@r,@c]);
67      @aus = @aus + @tmp[1,l] + " ";
68    }
69    @aus;
70  }
71}
72proc stransp (int r, int c, list #)
73{
74  // transpose a submatrix
75  matrix @m[r][c];
76  int @ii = 1;
77  int @j;
78  for (int @i = 1; @i<=r; @i=@i+1)
79  {
80    for (@j = 1; @j<=c; @j=@j+1)
81    {
82      @m[@i,@j] = #[@ii];
83      @ii=@ii+1;
84    }
85  }
86  return(transpose(@m));
87}
88proc unitmat (int r, list #)
89{
90  // create an unit matrix, # is optional
91  poly @p = 1;
92  if (size(#) == 1)
93  {
94    @p = #[1];
95  }
96  matrix @m[r][r];
97  return (@m + @p);
98}
99//
100// declare a ring with a different dialog
101// using defaults etc;
102//
103
104proc permute (int n, list #)
105{
106  //if (#ARGS == 2)
107  //{
108  //  string @actionstring = #action +"();";
109  //}
110  if (defined(PERMUTE_DATA) or defined(PERMUTE_WORK))
111  {
112    "permute: PERMUTE_WORK/DATA already defined, please kill them!";
113    return();
114  }
115  //
116  // initialize global data
117  //
118  intvec PERMUTE_DATA = n;  // must be global
119  intvec PERMUTE_WORK = 1;   // must be global
120  export PERMUTE_DATA, PERMUTE_WORK;
121  for (int @i=#n-1; @i>0; @i=@i-1)
122  {
123    PERMUTE_DATA = PERMUTE_DATA, @i;
124    PERMUTE_WORK = PERMUTE_WORK, 1;
125  }
126  int @done = 0;
127  while (@done == 0)
128  {
129    "permute", PERMUTE_DATA;  // this could be an action call
130    //if (#ARGS == 2)
131    //{
132    //  execute @actionstring;
133    //}
134    @done = next_permute(n);
135  }
136  kill PERMUTE_DATA, PERMUTE_WORK;
137  return ("-----------");
138}
139
140proc next_permute (int n)
141{
142  int @rc = 1;
143  if (n > 1)
144  {
145    if(PERMUTE_WORK[n] < n)
146    {
147      PERMUTE_DATA[PERMUTE_WORK[n]] = PERMUTE_DATA[PERMUTE_WORK[n] + 1];
148      PERMUTE_DATA[PERMUTE_WORK[n] + 1] = n;
149      PERMUTE_WORK[n] = PERMUTE_WORK[n] + 1;
150      return(0);
151    }
152    @rc = next_permute(n-1);
153    for(int @i=n-1; @i>=1; @i=@i-1)
154    {
155      PERMUTE_DATA[@i+1] = PERMUTE_DATA[@i];
156    }
157    PERMUTE_DATA[1] = n;
158    PERMUTE_WORK[n] = 1;
159    return(@rc);
160  }
161  return (@rc);
162}
163//
164// permutations as described in:
165//   data structures, algorithms, and program style using c
166//   james f. korsh
167//   leonard j. garrett
168//   pp. 162
169//
170proc permute1 (int n)
171{
172  int @done = 0;
173  while (@done == 0)
174  {
175    "permute", all;  // this could be an action call
176    @done = next(n);
177  }
178  return ("-----------");
179}
180proc next (int n)
181{
182  int @rc = 1;
183  if (n > 1)
184  {
185    if(l[n] < n)
186    {
187      all[l[n]] = all[l[n] + 1];
188      all[l[n] + 1] = n;
189      l[n] = l[n] + 1;
190      return(0);
191    }
192    @rc = next(n-1);
193    for(int @i=n-1; @i>=1; @i=@i-1)
194    {
195      all[@i+1] = all[@i];
196    }
197    all[1] = n;
198    l[n] = 1;
199    return(@rc);
200  }
201  return (@rc);
202}
Note: See TracBrowser for help on using the repository browser.