1 #include "def.h"
2 #include "macro.h"
3
4
5 INT all_points_phg();
6
scan_galois(OP v)7 INT scan_galois(OP v)
8 {
9 OP d=callocobject();
10 INT i,erg=OK;
11 printf("degree:");scan(INTEGER,d);
12 erg += m_il_v(S_I_I(d)+2,v); C_O_K(v,GALOISRING);
13 erg += copy(d,S_V_I(v,0));
14 printf("characteristic:");scan(INTEGER,S_V_I(v,1));
15 for (i=0;i<S_I_I(d);i++)
16 {
17 erg += scan(INTEGER,S_V_I(v,i+2));
18 }
19 erg += freeall(d);
20 ENDR("scan_galois");
21 }
22
add_galois(OP p1,OP p2,OP p3)23 INT add_galois(OP p1,OP p2, OP p3) //p3 = p2+p1
24 {
25 INT erg =OK,i;
26 // funktioniert auch mit p1=p2.....
27
28 copy(p1,p3);
29 for (i=2;i<S_V_LI(p3);i++)
30 {
31 M_I_I((S_V_II(p1,i)+S_V_II(p2,i))%S_GR_CI(p3), S_V_I(p3,i)) ;
32 }
33
34 ENDR("add_galois");
35 }
36
t_galois_polynom(OP g,OP p)37 INT t_galois_polynom(OP g, OP p)
38 {
39 INT i,erg=OK;
40 OP z;
41 init(MONOPOLY,p);
42 z=p;
43 for (i=2;i<S_V_LI(g);i++)
44 {
45 OP mo;
46 mo = callocobject();
47 b_sk_mo(callocobject(),callocobject(),mo);
48 C_L_S(z,mo);
49 M_I_I(S_V_II(g,i),S_PO_K(z));
50 M_I_I(i-2,S_PO_S(z));
51 if (i+1 <S_V_LI(g)) { C_L_N(z,callocobject()); z=S_L_N(z); init(MONOPOLY,z); }
52 }
53 ENDR("t_galois_polynom");
54 }
55
56 static OP mgg_c=NULL; //charakteristik zu multiplikationstafel
57 static OP mgg_d=NULL; // degree zu multiplikationstafel
58 static OP mgg_mt=NULL; //multiplikationstafel
59 static OP mgg_pl=NULL; //irred polynom
60 static INT mgg_change_counter; // count the new entries in the mult table
get_galois_irred(OP g,OP ip)61 INT get_galois_irred(OP g, OP ip) // irreduzible zu galois ring
62 {
63 INT erg =OK;
64 OP v;
65 if (
66 (S_I_I(mgg_c)==S_GR_CI(g))
67 &&
68 (S_I_I(mgg_d)==S_GR_DI(g))
69 &&
70 (not EMPTYP(mgg_pl))
71 ) {
72 copy(mgg_pl,ip);
73 goto endr_ende;
74 }
75 v=callocobject();
76 factorize(S_GR_C(g),v);
77 get_ff_irred(S_V_I(v,0) ,S_GR_D(g),ip);
78 copy(S_GR_C(g),mgg_c);
79 copy(S_GR_D(g),mgg_d);
80 copy(ip,mgg_pl);
81 freeall(v);
82 ENDR("get_galois_irred");
83 }
84
t_polynom_galois(OP p,INT c,INT d,OP g)85 INT t_polynom_galois(OP p ,INT c, INT d, OP g)
86 {
87 INT erg =OK,i=2;
88 OP z=p;
89 m_il_nv(d+2,g); C_O_K(g,GALOISRING);
90 m_i_i(d,S_V_I(g,0));
91 m_i_i(c,S_V_I(g,1));
92
93 if (S_L_S(z) == NULL) goto endr_ende;
94
95 while (z!=NULL)
96 {
97 M_I_I( S_I_I(S_PO_K(z)),
98 S_V_I(g,2+S_I_I(S_PO_S(z)) )
99 );
100 z = S_L_N(z);
101 }
102 ENDR("t_polynom_galois");
103 }
104
init_galois_global(OP charac,OP deg)105 INT init_galois_global( OP charac, OP deg )
106 {
107 INT erg =OK;
108 if ((S_I_I(mgg_c)==S_I_I(charac)) && (S_I_I(mgg_d)==S_I_I(deg))) return OK;
109 if (S_I_I(mgg_c) != 0) // previously different galois ring
110 {
111 // store mult table
112 if (mgg_change_counter>0)
113 store_result_2(charac,deg,"galois_mult",mgg_mt);
114 }
115 freeself(mgg_mt);
116 // load mult table
117
118 check_result_2(charac,deg,"galois_mult",mgg_mt);
119
120 if (emptyp(mgg_mt)) // first time
121 {
122 OP h=callocobject();
123 hoch(charac,deg,h);
124 if (S_I_I(h) <= 256) // only table in small cases
125 m_lh_m(h,h,mgg_mt);
126 freeall(h);
127 }
128 copy(charac,mgg_c);
129 copy(deg,mgg_d);
130 mgg_change_counter=0;
131 ENDR("init_galois_global");
132 }
133
134
galois_anfang()135 INT galois_anfang()
136 {
137 INT erg =OK;
138 CALLOCOBJECT4(mgg_c,mgg_d,mgg_mt,mgg_pl);
139 M_I_I(0,mgg_c);
140 M_I_I(0,mgg_d);
141 mgg_change_counter=0;
142 ENDR("galois_anfang");
143 }
galois_ende()144 INT galois_ende()
145 {
146 INT erg =OK;
147 if (S_I_I(mgg_c) != 0) // previously different galois ring
148 {
149 // store mult table
150 if (mgg_change_counter>0)
151 S2R(mgg_c,mgg_d,"galois_mult",mgg_mt);
152 }
153 FREEALL4(mgg_c,mgg_d,mgg_mt,mgg_pl);
154 ENDR("galois_ende");
155 }
index_galois(OP g)156 INT index_galois(OP g)
157 // index of galois ring element
158 {
159 INT d=S_GR_DI(g);
160 INT c=S_GR_CI(g);
161 INT res=0,i,m;
162 for (i=0,m=1;i<d;i++,m*=c)
163 res += S_V_II(g,2+i)*m;
164 return res;
165 }
166
mult_galois_galois(OP p1,OP p2,OP p3)167 INT mult_galois_galois(OP p1, OP p2, OP p3)
168 {
169 INT erg = OK,p1i,p2i;
170 CTO(GALOISRING,"mult_galois(1)",p1);
171 CTO(GALOISRING,"mult_galois(2)",p2);
172 SYMCHECK(S_GR_CI(p1)!=S_GR_CI(p2),"mult_galois_galois:different characteristics");
173 SYMCHECK(S_GR_DI(p1)!=S_GR_DI(p2),"mult_galois_galois:different degrees");
174 {
175 OP poly1,poly2,poly3,poly4,irred,diverg;
176 if (S_GR_DI(p1)==1) {
177 copy(p1,p3);
178 M_I_I((S_V_II(p1,2)*S_V_II(p2,2))%S_GR_CI(p1), S_V_I(p3,2));
179 goto endr_ende;
180 }
181 if (
182 (S_GR_CI(p1)!=S_I_I(mgg_c)) || (S_GR_DI(p1)!=S_I_I(mgg_d))
183 )
184 init_galois_global(S_GR_C(p1),S_GR_D(p1)); // initialize irred polynomial and mult_table
185
186 if (not EMPTYP(mgg_mt)) // check if result available
187 {
188 p1i=index_galois(p1);
189 p2i=index_galois(p2);
190 if (p1i >= S_M_HI(mgg_mt)) error("mult_galois_galois:I1");
191 if (p2i >= S_M_HI(mgg_mt)) error("mult_galois_galois:I2");
192 if (not EMPTYP(S_M_IJ(mgg_mt,p1i,p2i))) // result of multiplicazion is known
193 {
194 copy(S_M_IJ(mgg_mt,p1i,p2i),p3);
195 goto endr_ende;
196 }
197 }
198
199 CALLOCOBJECT6(poly1,poly2,poly3,poly4,irred,diverg);
200 t_galois_polynom(p1,poly1);
201 t_galois_polynom(p2,poly2);
202 mult(poly1,poly2,poly3);
203 mod(poly3,S_GR_C(p1),poly3);
204 get_galois_irred(p1,irred);
205 quores(poly3,irred,diverg,poly4);
206 mod(poly4,S_GR_C(p1),poly4);
207 t_polynom_galois(poly4,S_GR_CI(p1),S_GR_DI(p1),p3);
208 FREEALL6(poly1,poly2,poly3,poly4,irred,diverg);
209
210 if (not EMPTYP(mgg_mt)) // check if result available
211 {
212 mgg_change_counter++;
213 copy(p3,S_M_IJ(mgg_mt,p1i,p2i));
214 }
215
216 }
217 ENDR("mult_galois");
218 }
219
mult_galois(OP a,OP b,OP c)220 INT mult_galois(OP a, OP b, OP c)
221 {
222 INT erg = OK;
223 switch (S_O_K(b)) {
224 case GALOISRING:
225 erg += mult_galois_galois(a,b,c);
226 break;
227 case VECTOR:
228 {
229 INT i;
230 copy(b,c);
231 for (i=0;i<S_V_LI(c);i++)
232 erg += mult_galois(a,S_V_I(b,i),S_V_I(c,i));
233 }
234 break;
235 default:
236 printobjectkind(b);
237 error("mult_galois(2): wrong second type");
238 erg = ERROR;
239 }
240 ENDR("mult_galois");
241 }
242
unitp_galois(OP g)243 INT unitp_galois(OP g)
244 {
245 INT j,erg =OK;
246 for (j=2;j<S_V_LI(g);j++)
247 {
248 if (ggt_i(S_V_II(g,j), S_GR_CI(g)) == 1) return TRUE;
249 }
250 return FALSE;
251 ENDR("unitp_galois");
252 }
253
nullp_galois(OP g)254 INT nullp_galois(OP g)
255 /* AK 131206 V3.1 */
256 {
257 INT erg = OK;
258 INT i;
259 for (i=2;i<S_V_LI(g);i++)
260 if (S_V_II(g,i) != 0) return FALSE;
261 return TRUE;
262 ENDR("nullp_galois");
263 }
264
null_galois(OP a,OP b)265 INT null_galois(OP a,OP b)
266 {
267 INT erg =OK,i;
268 copy(a,b);
269 for (i=2;i<S_V_LI(b);i++) M_I_I(0,S_V_I(b,i));
270 ENDR("null_galois");
271 }
272
einsp_galois(OP g)273 INT einsp_galois(OP g)
274 {
275 INT erg = OK;
276 INT i;
277 if (S_V_II(g,2) != 1) return FALSE;
278 for (i=3;i<S_V_LI(g);i++)
279 if (S_V_II(g,i) != 0) return FALSE;
280 return TRUE;
281 ENDR("einsp_galois");
282 }
283
first_gr_given_c_d(OP c,OP d,OP gr)284 INT first_gr_given_c_d(OP c, OP d, OP gr)
285 {
286 INT erg =OK;
287 m_il_nv(S_I_I(d)+2,gr); C_O_K(gr,GALOISRING);
288 copy(d,S_V_I(gr,0));
289 copy(c,S_V_I(gr,1));
290 ENDR("first_gr_given_c_d");
291 }
292
null_gr_given_c_d(OP c,OP d,OP gr)293 INT null_gr_given_c_d(OP c, OP d, OP gr)
294 {
295 return first_gr_given_c_d(c,d,gr);
296 }
297
eins_gr_given_c_d(OP c,OP d,OP gr)298 INT eins_gr_given_c_d(OP c, OP d, OP gr)
299 {
300 INT erg = OK;
301 first_gr_given_c_d(c,d,gr);
302 m_i_i(1,S_V_I(gr,2));
303 ENDR("eins_gr_given_c_d");
304 }
305
eins_galois(OP a,OP b)306 INT eins_galois(OP a,OP b)
307 {
308 INT erg = OK;
309 if (a==b)
310 {
311 INT i;
312 M_I_I(1,S_V_I(b,2));
313 for (i=3;i<S_V_LI(b);i++) M_I_I(0,S_V_I(b,i));
314 }
315 else
316 erg += eins_gr_given_c_d(S_GR_C(a),S_GR_D(a),b);
317 ENDR("eins_galois");
318 }
319
invers_galois(a,b)320 INT invers_galois(a,b) OP a,b;
321 {
322 INT erg = OK;
323 CE2(a,b,invers_galois);
324 {
325 OP c;
326 c=CALLOCOBJECT();
327 copy(a,c);
328 copy(a,b);
329 while (! einsp_galois(c))
330 {
331 SWAP(b,c);
332 mult_galois(a,b,c);
333 }
334 FREEALL(c);
335 }
336 ENDR("invers_galois");
337 }
338
addinvers_apply_galois(OP a)339 INT addinvers_apply_galois(OP a)
340 /* AK 200307 */
341 {
342 INT erg =OK,i,ai;
343 CTO(GALOISRING,"addinvers_apply_galois(1)",a);
344 for (i=2;i<S_V_LI(a);i++)
345 {
346 if (S_V_II(a,i)!=0)
347 {
348 ai = S_GR_CI(a)-S_V_II(a,i);
349 M_I_I(ai,S_V_I(a,i));
350 }
351 }
352 ENDR("addinvers_apply_galois");
353 }
354
random_gr_given_c_d(c,d,b)355 INT random_gr_given_c_d(c,d,b) OP c,d; OP b;
356 {
357 INT erg = OK;
358 CTO(INTEGER,"random_gr_given_c_d(1)",c);
359 CTO(INTEGER,"random_gr_given_c_d(2)",d);
360 SYMCHECK(prime_power_p(c) ==FALSE,"random_gr_given_c_d:c no prime power");
361 {
362 INT i;
363 m_il_v(S_I_I(d)+2,b); C_O_K(b,GALOISRING);
364 m_i_i(S_I_I(d),S_V_I(b,0));
365 m_i_i(S_I_I(c),S_V_I(b,1));
366 for (i=2;i<S_V_LI(b);i++)
367 m_i_i(rand()%S_I_I(c),S_V_I(b,i));
368 }
369 ENDR("random_gr_given_c_d");
370 }
371
372
373
next_apply_gr(OP gr1)374 INT next_apply_gr(OP gr1)
375 /* AK 150307 */
376 {
377 INT erg =OK,i,j,c;
378 CTO(GALOISRING,"next_apply_gr(1)",gr1);
379 c=S_V_II(gr1,1);
380 for (i=S_V_LI(gr1)-1; i>=2;i--)
381 if (S_V_II(gr1,i) < c-1) {
382 INC_INTEGER(S_V_I(gr1,i));
383 for (j=i+1;j<S_V_LI(gr1);j++) M_I_I(0,S_V_I(gr1,j));
384 return OK;
385 }
386 return LAST_FF;
387
388 ENDR("next_apply_gr");
389 }
390
next_gr(OP gr1,OP gr2)391 INT next_gr(OP gr1, OP gr2)
392 {
393 INT erg =OK,i,j,c;
394 CTO(GALOISRING,"next_gr(1)",gr1);
395 if (gr1!=gr2) copy(gr1,gr2);
396 return next_apply_gr(gr2);
397 /*
398 c=S_V_II(gr2,1);
399 for (i=S_V_LI(gr2)-1; i>=2;i--)
400 if (S_V_II(gr2,i) < c-1) {
401 INC_INTEGER(S_V_I(gr2,i));
402 for (j=i+1;j<S_V_LI(gr2);j++) M_I_I(0,S_V_I(gr2,j));
403 return OK;
404 }
405 return LAST_FF;
406 */
407 ENDR("next_gr");
408 }
409
410
vectorofzerodivisors_galois(OP c,OP d,OP v)411 INT vectorofzerodivisors_galois(OP c, OP d, OP v)
412 /* vector with all non unit elements */
413 {
414 INT erg =OK;
415 OP sl=callocobject();
416 m_il_v(0,v);
417 first_gr_given_c_d(c,d,sl);
418 do {
419 if (! unitp_galois(sl)) { inc(v); copy(sl,S_V_I(v,S_V_LI(v)-1)); }
420 } while(next_gr(sl,sl)!=LAST_FF);
421 ENDR("vectorofzerodivisors_galois");
422 }
423
424
random_subgroup_glk_grcd_smaller_k(k,c,d,a)425 INT random_subgroup_glk_grcd_smaller_k(k,c,d,a) OP k,c,d,a;
426 /* erzeuger fuer kleinere glnk-1 */
427 {
428 INT erg = OK;
429 CTO(INTEGER,"random_subgroup_glk_grcd_smaller_k(1)",k);
430 SYMCHECK(S_I_I(k)<1,"random_subgroup_glk_grcd_smaller_k(1): k<1");
431 SYMCHECK(S_I_I(d)<1,"random_subgroup_glk_grcd_smaller_k(3): d<1");
432 SYMCHECK(prime_power_p(c)==FALSE,"random_subgroup_glk_grcd_smaller_k(2): no prime power");
433 {
434 INT i,j;
435 if (S_I_I(k)<=2)
436 erg += random_subgroup_glk_grcd_cyclic(k,c,d,a);
437 else
438 {
439 DEC(k);
440 erg += random_subgroup_glk_grcd(k,c,d,a);
441 for (i=0;i<S_V_LI(a);i++)
442 {
443 OP mat;
444 mat = S_V_I(a,i);
445 erg += inc(mat);
446 erg += eins_gr_given_c_d(c,d,S_M_IJ(mat,S_M_HI(mat)-1,S_M_LI(mat)-1));
447 for (j=0;j<S_M_HI(mat)-1;j++)
448 {
449 erg += null_gr_given_c_d(c,d,S_M_IJ(mat,j,S_M_LI(mat)-1));
450 erg += null_gr_given_c_d(c,d,S_M_IJ(mat,S_M_HI(mat)-1,j));
451 }
452 }
453 INC(k);
454 }
455 }
456 ENDR("random_subgroup_glk_grcd_smaller_k");
457 }
458
459
random_subgroup_glk_grcd_diagonal(k,c,d,a)460 INT random_subgroup_glk_grcd_diagonal(k,c,d,a) OP k,c,d,a;
461 /* subgroup generated by diagonal matrix */
462 /* AK 110804 */
463 {
464 INT erg = OK;
465 CTO(INTEGER,"random_subgroup_glk_grcd_diagonal(1)",k);
466 SYMCHECK(S_I_I(k)<1,"random_subgroup_glk_grcd_diagonal(1): k<1");
467 SYMCHECK(S_I_I(d)<1,"random_subgroup_glk_grcd_diagonal(3): d<1");
468 SYMCHECK(prime_power_p(c)==FALSE,
469 "random_subgroup_glk_grcd_diagonal(2): no prime power");
470 {
471 OP z;
472 INT ii,jj;
473 erg += m_il_v(1,a);
474 z = S_V_I(a,0);
475 erg += m_lh_m(k,k,z);
476 for (ii=0;ii<S_M_HI(z);ii++)
477 for (jj=0;jj<S_M_HI(z);jj++)
478 if (ii!=jj) erg += null_gr_given_c_d(c,d,S_M_IJ(z,ii,jj));
479
480 for (jj=0;jj<S_M_HI(z);jj++)
481 {
482 nn:
483 erg += random_gr_given_c_d(c,d,S_M_IJ(z,jj,jj));
484 if (! unitp_galois(S_M_IJ(z,jj,jj))) goto nn;
485 }
486
487 }
488 printf("diag generator:");println(a);
489 ENDR("random_subgroup_glk_grcd_diagonal");
490 }
491
492
random_subgroup_glk_grcd_2gen(k,c,d,a)493 INT random_subgroup_glk_grcd_2gen(k,c,d,a) OP k,d,c,a;
494 /* AK 170407 V3.1 */
495 {
496 INT erg =OK;
497 CTO(INTEGER,"random_subgroup_glk_grcd_2gen(1)",k);
498 CTO(INTEGER,"random_subgroup_glk_grcd_2gen(2)",c);
499 CTO(INTEGER,"random_subgroup_glk_grcd_2gen(3)",d);
500 {
501 OP v1,v2;
502 CALLOCOBJECT2(v1,v2);
503 erg += random_subgroup_glk_grcd_cyclic(k,c,d,v1);
504 erg += random_subgroup_glk_grcd_cyclic(k,c,d,v2);
505 erg += append(v1,v2,a);
506 FREEALL2(v1,v2);
507 }
508 ENDR("random_subgroup_glk_grcd_2gen");
509 }
510
random_subgroup_glk_grcd_cyclic(k,c,d,a)511 INT random_subgroup_glk_grcd_cyclic(k,c,d,a) OP k,d,c,a;
512 /* findet zuf�llige erzeuger einer zyklischen
513 untergruppe von glk ueber GR characteristik c und degree d */
514 /* AK 241106 V3.1 */
515 {
516 INT erg = OK;
517 CTO(INTEGER,"random_subgroup_glk_grcd_cyclic(1)",k);
518 CTO(INTEGER,"random_subgroup_glk_grcd_cyclic(2)",c);
519 CTO(INTEGER,"random_subgroup_glk_grcd_cyclic(3)",d);
520 {
521 OP mat;INT i,j;
522 mat = CALLOCOBJECT();
523 m_lh_m(k,k,mat);
524 ag:
525 for (i=0;i<S_M_HI(mat);i++)
526 for (j=0;j<S_M_LI(mat);j++)
527 {
528 random_gr_given_c_d(c,d,S_M_IJ(mat,i,j));
529 }
530 m_o_v(mat,a);
531
532 {
533 OP d;
534 d=CALLOCOBJECT();
535 det_mat_imm(mat,d); printf("det=");println(d);
536 if (! unitp_galois(d)) { freeall(d); goto ag; }
537
538 //order(mat,d); printf("ordnung:"); println(d);
539 FREEALL(d);
540 }
541
542 FREEALL(mat);
543 }
544 ENDR("random_subgroup_glk_grcd_cyclic");
545 }
546
multscal_221106(mat,point,res)547 static INT multscal_221106(mat,point,res) OP mat,point,res;
548 {
549 INT i; INT erg = OK;
550 OP inv;
551 //println(point);
552 inv = CALLOCOBJECT();
553 MULT(mat,point,res);
554 for (i=0;i<S_V_LI(res);i++) if (unitp_galois(S_V_I(res,i))) break;
555 // bei i eintrag != null
556 if (i==S_V_LI(res)) { println(res); error("no unit found"); }
557 INVERS(S_V_I(res,i),inv); // printf("break bei %d, mult mit:",i);println(inv);
558 MULT_APPLY(inv,res);
559 FREEALL(inv);
560 //println(res);
561 ENDR("multscal_151104");
562 }
563
random_subgroup_glk_grcd_stabilizer(k,phgc,phgd,a)564 INT random_subgroup_glk_grcd_stabilizer(k,phgc,phgd,a) OP k,phgc,phgd,a;
565 /* subgroup generated as stabilizer of operation on 1-dim subspaces over Galoisring *
566 /
567 /* AK 281106 */
568 {
569 INT erg = OK;
570 CTO(INTEGER,"random_subgroup_glk_grcd_stabilizer(1)",k);
571 CTO(INTEGER,"random_subgroup_glk_grcd_stabilizer(3)",phgd);
572 SYMCHECK(S_I_I(k)<1,"random_subgroup_glk_grcd_stabilizer(1): k<1");
573 SYMCHECK(S_I_I(phgd)<1,"random_subgroup_glk_grcd_stabilizer(3): degree<1");
574 SYMCHECK(prime_power_p(phgc)==FALSE,
575 "random_subgroup_glk_grcd_stabilizer(2): no prime power");
576 {
577 /* first step onedim random element */
578 OP z=callocobject(),v;
579 INT i,np=-1;
580 all_points_phg(k,phgc,phgd,z);
581 i = rand()%S_V_LI(z);
582 v = S_V_I(z,i);
583 // println(v);
584 /* jetzt ist v ein kanonischer 1-dim subspace */
585
586 /* orbit mit stabilizer */
587
588
589 {
590 OP g = callocobject();
591 OP res = callocobject();
592 nochmal:
593 random_subgroup_glk_grcd(k,phgc,phgd,g);
594 println(g); println(v);
595 orbit(g,v,res,multscal_221106,a);
596
597 println(res); println(S_V_L(res));
598 /* check ob gesamte punkte */
599 if (S_V_LI(res)==S_V_LI(z)) goto nochmal;
600 FREEALL2(g,res);
601 }
602
603 FREEALL(z);
604 }
605 ENDR("random_subgroup_glk_grcd_stabilizer");
606 }
607
608
random_subgroup_glk_grcd(k,c,d,a)609 INT random_subgroup_glk_grcd(k,c,d,a) OP k,d,c,a;
610 {
611 INT erg = OK;
612 CTO(INTEGER,"random_subgroup_glk_grcd(1)",k);
613 CTO(INTEGER,"random_subgroup_glk_grcd(2)",c);
614 CTO(INTEGER,"random_subgroup_glk_grcd(3)",d);
615 {
616 INT i;
617 i = rand();
618 i = i%6;
619 if (i==0)
620 return random_subgroup_glk_grcd_diagonal(k,c,d,a);
621 else if (i==1)
622 return random_subgroup_glk_grcd_smaller_k(k,c,d,a);
623 else if (i==2)
624 return random_subgroup_glk_grcd_stabilizer(k,c,d,a);
625 else if (i==3)
626 return random_subgroup_glk_grcd_2gen(k,c,d,a);
627 else
628 return random_subgroup_glk_grcd_cyclic(k,c,d,a);
629 }
630 ENDR("random_subgroup_glk_grcd");
631 }
632
633
get_incidence_phg(OP k,OP phg_c,OP phg_d,OP erz,OP matrix,OP bahnsizes,OP eindim,OP eindimbahnen,OP hyper,OP hyperbahnen)634 INT get_incidence_phg(OP k,OP phg_c, OP phg_d,OP erz,OP matrix,OP bahnsizes,
635 OP eindim /*mybe NULL*/, OP eindimbahnen,
636 OP hyper /*mybe NULL*/, OP hyperbahnen)
637 {
638 INT erg =OK,i,j;
639 INT edf=0;
640 OP c,hyprep,anzbahn,transerz;
641 CALLOCOBJECT4(c,hyprep,anzbahn,transerz);
642 if (eindim==NULL) { edf=1; eindim=CALLOCOBJECT(); }
643 all_points_phg(k,phg_c,phg_d,eindim);
644 printf("anzahl punkte:"); println(S_V_L(eindim));
645 all_orbits(eindim,erz,eindimbahnen,NULL,multscal_221106); // f bahnen von 1dim uvr nummeriert 1,2,...
646 //println(eindimbahnen);
647
648 erg +=max(eindimbahnen,anzbahn); // c ist anzahl bahnen
649 printf("anzahl der bahnen = "); println(anzbahn);
650
651 erg += m_lh_nm(anzbahn,anzbahn,matrix);
652 erg += m_l_nv(anzbahn,bahnsizes);
653 m_il_v(S_V_LI(erz),transerz);
654 for (i=0;i<S_V_LI(transerz);i++) transpose(S_V_I(erz,i),S_V_I(transerz,i));
655 if (hyper!=NULL) copy(eindim,hyper);
656 else hyper=eindim;
657 all_orbits(hyper,transerz,hyperbahnen,NULL,multscal_221106); // f bahnen von 1dim uvr nummeriert 1,2,...
658 //printf("bahnen der hyperebenen:");println(hyperbahnen);
659 max(hyperbahnen,c);
660 printf("anzahl der hyperbahnen = "); println(c);
661 m_l_v(c,hyprep); // vektor f�r repr�sentanten der hyperebenen
662 for (i=0;i<S_V_LI(hyperbahnen);i++) { M_I_I(i,S_V_I(hyprep, S_V_II(hyperbahnen,i)-1)); }
663 println(hyprep);
664 for (j=0;j<S_V_LI(eindimbahnen);j++)
665 {
666 for (i=0;i<S_V_LI(hyprep);i++)
667 {
668 OP y,x;
669 x = S_V_I(eindim,S_V_II(hyprep,i));
670 y = S_V_I(eindim,j);
671 erg +=scalarproduct(x,y,c);
672 if (NULLP(c)) INC(S_M_IJ(matrix,i,S_V_II(eindimbahnen,j)-1));
673 }
674
675 INC(S_V_I(bahnsizes,S_V_II(eindimbahnen,j)-1));
676 }
677 if (edf==1) FREEALL(eindim);
678 FREEALL4(c,hyprep,anzbahn,transerz);
679 ENDR("get_incidence_phg");
680 }
681
all_points_phg(k,phg_c,phg_d,res)682 INT all_points_phg(k,phg_c,phg_d,res) OP k,phg_c,phg_d,res;
683 /* alle 1 dimensionalen uvr von GR(c,d)^k */
684 /* in sortierter folge */
685 /* AK 211106 */
686 {
687 INT erg = OK;
688 CTO(INTEGER,"all_points_phg(1)",k);
689 CTO(INTEGER,"all_points_phg(2)",phg_c);
690 CTO(INTEGER,"all_points_phg(3)",phg_d);
691
692 C3R(k,phg_c,phg_d,"all_points_phg_store",res);
693 {
694 INT i,j; OP z,h,v,nv;
695 CALLOCOBJECT2(v,nv);
696 vectorofzerodivisors_galois(phg_c, phg_d, nv);
697 //printf("nullteiler sind:");println(nv);
698 m_il_v(0,res);
699 for (i=0;i<S_I_I(k);i++)
700 {
701 m_il_v(0,v);
702 inc(v);
703 z = S_V_I(v,S_V_LI(v)-1);
704 m_l_v(k,z);
705 for (j=0;j<i;j++) null_gr_given_c_d(phg_c,phg_d,S_V_I(z,j));
706 eins_gr_given_c_d(phg_c,phg_d,S_V_I(z,i));
707 for (j=i+1;j<S_I_I(k);j++)
708 first_gr_given_c_d(phg_c,phg_d,S_V_I(z,j));
709
710 // das war der erste mit der 1 an der stelle i
711 h = CALLOCOBJECT();
712 if (i<(S_I_I(k)-1))
713 while (1) {
714 INT res;
715 copy(z,h);
716 j=S_V_LI(h)-1;
717 nochmal:
718 res = next_gr(S_V_I(z,j),S_V_I(h,j));
719 if (res == LAST_FF) {
720 if (j==(i+1)) break;
721 j--; goto nochmal;
722 }
723 else {
724 INT jj;
725 for (jj=j+1;jj<S_V_LI(h);jj++)
726 first_gr_given_c_d(phg_c,phg_d,S_V_I(h,jj));
727 inc(v); z = S_V_I(v,S_V_LI(v)-1);
728 copy(h,z);
729 }
730 }
731 FREEALL(h);
732 /* v ist jetzt der vektor mit 0'en bis platz i
733 jetzt m�ssen davor alle m�glichen nullteiler in allen permutationen kommen */
734 append_apply(res,v); // v an res anh�ngen
735 if ((S_V_LI(nv)>1)&&(i>0)) {
736 OP lv;
737 lv=CALLOCOBJECT();
738 m_il_nv(i,lv); // nv ist die schleife �ber alle f�llungen , nullvektor ist start
739 nn:
740 for (j=S_V_LI(lv)-1;j>=0;j--)
741 {
742 if (S_V_II(lv,j)+1 < S_V_LI(nv)) { inc(S_V_I(lv,j));
743 for (++j;j<S_V_LI(lv);j++) M_I_I(0,S_V_I(lv,j));
744 // lv hat jetzt die indices der nullteiler
745 for (j=0;j<S_V_LI(v);j++)
746 {
747 INT k;
748 for (k=0;k<S_V_LI(lv);k++)
749 copy(S_V_I(nv,S_V_II(lv,k)), S_V_I(S_V_I(v,j),k));
750 }
751 append_apply(res,v); // v an res anh�ngen
752 // println(lv);
753 goto nn;
754 }
755 // das war die letzte nullteiler verteilung
756 }
757 FREEALL(lv);
758 }
759 }
760 FREEALL2(v,nv);
761 SYM_sort(res);
762 }
763 S3R(k,phg_c,phg_d,"all_points_phg_store",res);
764 ENDR("all_points");
765 }
766
767