1 /*mod_dg_sbd.c
2 berechnet eine darstellende matrix,
3 nach basisaenderung der bideterminanten
4 modular
5 um die �bliche bezeichnung zu bekommen, wird die
6 conjugierte partition genommen
7 */
8 /* es wird nur die erste standard bi determinant ausgerechnet, die �brigen mit operate
9 perm
10 dabei wird die permutation genommen die von SYT 0 zu SYT i f�hrt */
11
12 /* es wird keine ff arithmetik verwendet */
13
14 #include "def.h"
15 #include "macro.h"
16
17 /* standard bideterminanten */
18 /* polynom indiziert mit integer matrix */
19 /* */
20 /* basis fuer specht modul mit sbd */
21
22 static OP zero_one_matrices = NULL;
23 static INT init_zero_one(OP part);
24 static INT close_zero_one();
25
operate_perm_spaltenmatrix_new(a,b,c)26 static INT operate_perm_spaltenmatrix_new(a,b,c) OP a,b,c;
27 /* vertausch spalten gemaess der permutation */
28 /* spalte 0 nur wenn permutation auch 0 enthaelt */
29 /* AK 080802 */
30 {
31 INT erg = OK;
32 INT i,j;
33 CTO(PERMUTATION,"operate_perm_spaltenmatrix(1)",a);
34 CTTO(INTEGERMATRIX,MATRIX,"operate_perm_spaltenmatrix(2)",b);
35 CE3(a,b,c,operate_perm_spaltenmatrix);
36 SYMCHECK(S_P_LI(a) > S_M_LI(b),
37 "operate_perm_spaltenmatrix: permutation degree too big");
38 COPY(b,c);
39 for (j=0;j<S_P_LI(a);j++)
40 for (i=0;i<S_M_HI(b);i++)
41 CLEVER_COPY(S_M_IJ(b,i,j), S_M_IJ(c,i,S_P_II(a,j)-1));
42
43 CTTO(INTEGERMATRIX,MATRIX,"operate_perm_spaltenmatrix(e-3)",c);
44 ENDR("operate_perm_spaltenmatrix");
45 }
46
println_bid(a)47 static INT println_bid(a) OP a;
48 {
49 OP z;
50 INT i,j;
51 if (NULLP(a)) { printf("empty bideterminant"); }
52 else{
53 FORALL(z,a,{
54 print(S_MO_K(z)); printf(" [");
55 for (i=1;i<S_M_HI(S_MO_S(z));i++)
56 for (j=1;j<S_M_LI(S_MO_S(z));j++)
57 print(S_M_IJ(S_MO_S(z),i,j));
58 printf("] ");
59 });
60 }
61
62 printf("\n");zeilenposition=0;
63 }
64
make_basis(e,prim,v)65 static INT make_basis(e,prim,v) OP e; OP prim;
66 /* the matrix e will be transformed into a basis mod prim using
67 row transformations
68 the number of rows (= dimension ) may be smaller at the end
69 */
70 OP v; /* vector mit zeilen nummern der original matrix
71 die in die basis gehen AK 210703 */
72 {
73 INT i,j,k,l;
74 INT erg = OK;
75 OP d,c;
76
77 CTO(MATRIX,"make_basis(1)",e);
78 d = CALLOCOBJECT();
79 c = CALLOCOBJECT();
80
81 if (v!=NULL)
82 { /* AK 210703 */
83 m_il_v(S_M_HI(e),v);
84 for (i=0;i<S_V_LI(v);i++) M_I_I(i,S_V_I(v,i));
85 /* v initialized to 0.1.2.3.... */
86 }
87
88 if (S_M_HI(e) < 2)
89 {
90 if (NULLP(e)) k=0; else k=1;
91 goto a3;
92 }
93
94
95 j=0; k = 0;
96 a2:
97 if (j == S_M_LI(e)) goto a3;
98 for (i=k;i<S_M_HI(e);i++)
99 if (not NULLP(S_M_IJ(e,i,j))) break;
100 if (i== S_M_HI(e)) /* in spalte j kein eintrag != 0 */
101 { j++; goto a2; }
102 change_row_ij(e,i,k);
103 if (v!=NULL) SWAP(S_V_I(v,i),S_V_I(v,k)); /*AK 210703*/
104
105 /* am platz k,j ist jetzt ein eintrag != 0 */
106 /* in den zeilen drunter eine null an den platz in der spalte j */
107
108 for (i=k+1;i<S_M_HI(e); i++)
109 {
110 if (NULLP(S_M_IJ(e,i,j))) continue;
111
112 nochmal:
113 for (l=j;l<S_M_LI(e);l++)
114 {
115 ADD_APPLY(S_M_IJ(e,k,l),S_M_IJ(e,i,l));
116 M_I_I(S_M_IJI(e,i,l)%S_I_I(prim),S_M_IJ(e,i,l));
117 }
118 if (! NULLP(S_M_IJ(e,i,j))) goto nochmal;
119 }
120
121 k++; j++; goto a2;
122 a3:
123 /* k ist laenge der basis = dimension */
124 for (i=k;i<S_M_HI(e);i++)
125 for (j=0;j<S_M_LI(e);j++)
126 FREESELF(S_M_IJ(e,i,j));
127 M_I_I(k,S_M_H(e));
128 if (v!=NULL) M_I_I(k,S_V_L(v)); /*AK 210703*/
129
130 FREEALL(c);
131 FREEALL(d);
132 ENDR("make_basis");
133 }
134
decompose_matrix(in,basis,mat,prim)135 static INT decompose_matrix(in,basis,mat,prim) OP in,basis,mat;OP prim;
136 {
137 INT erg = OK,i,j,k;
138 CTO(VECTOR,"decompose_matrix(1)",in);
139 CTO(MATRIX,"decompose_matrix(2)",basis);
140
141 /* basis ist obere dreiecksmatrix */
142
143 m_ilih_nm(S_V_LI(in),S_V_LI(in),mat);
144 for (i=0;i<S_V_LI(in);i++)
145 {
146 OP leading_term;
147 OP p,t,ko;
148 INT l;
149 p = CALLOCOBJECT();
150 COPY(S_V_I(in,i),p);
151 j = 0; k = 0;
152 aa:
153 for (;j<S_V_LI(p);j++)
154 if (not NULLP(S_V_I(p,j))) break;
155 if (j==S_V_LI(p)) goto ee;
156
157 /* an der stelle j ist ein eintrag != null, es muss ein basis
158 element k geben was als ersten eintrag != 0 was an der stelle j hat */
159
160 bb:
161 if (k == S_M_HI(basis)) error("decompose_matrix: could not decompose");
162 if (NULLP(S_M_IJ(basis,k,j))) { k++; goto bb; }
163 for (l=0;l<j;l++)
164 if (not NULLP(S_M_IJ(basis,k,l))) { k++; goto bb; }
165
166 /* der basis vektor k geht ins ergenis */
167
168 t = CALLOCOBJECT();
169 ko = CALLOCOBJECT();
170 select_row(basis,k,t);
171
172 M_I_I(1,ko);
173 while ( (S_I_I(ko) * S_M_IJI(basis,k,j) )%S_I_I(prim) != S_V_II(p,j))
174 INC_INTEGER(ko);
175 COPY(ko,S_M_IJ(mat,k,i));
176 M_I_I(-S_I_I(ko),ko);
177 MULT_APPLY(ko,t);
178 ADD_APPLY(t,p);
179 for (l=0;l<S_V_LI(p);l++)
180 {
181 INT eintrag;
182 eintrag = S_V_II(p,l);
183 eintrag %= S_I_I(prim);
184 if (eintrag < 0) eintrag += S_I_I(prim);
185 M_I_I(eintrag, S_V_I(p,l));
186 }
187 FREEALL(ko);
188 FREEALL(t);
189 goto aa;
190 ee:
191 FREEALL(p);
192 } /* end for */
193 ENDR("decompose_matrix");
194 }
195
196
197
get_dg(b,e,c,prim)198 static INT get_dg(b,e,c,prim) OP b,e,c;OP prim;
199 /* berechnet die modulare darstellung */
200 /* dabei ist b die permutation, e die basis des moduls
201 c wird matrix */
202 {
203 OP d,a;
204 INT erg = OK;
205 INT i,j;
206
207 if (S_M_HI(e) == 0) {
208 /* z.b. part = 11....111 */
209 m_ilih_m(0,0,c);
210 goto endr_ende;
211 }
212
213 SYMCHECK(zero_one_matrices==NULL,"get_dg:internal error");
214
215 a = CALLOCOBJECT();
216 d = CALLOCOBJECT();
217 m_il_v(S_M_HI(e),d);
218 m_il_v(S_M_LI(e),a);
219 for (j=0;j<S_V_LI(a);j++)
220 b_sk_mo(CALLOCOBJECT(),CALLOCOBJECT(),S_V_I(a,j));
221
222 for (i=0;i<S_V_LI(d);i++)
223 {
224 for (j=0;j<S_V_LI(a);j++)
225 {
226 CLEVER_COPY(S_M_IJ(e,i,j),S_MO_K(S_V_I(a,j)));
227 operate_perm_spaltenmatrix_new(b,S_V_I(zero_one_matrices,j),S_MO_S(S_V_I(a,j)));
228 }
229 qsort_vector(a);
230 m_il_v(S_V_LI(a),S_V_I(d,i));
231 for (j=0;j<S_V_LI(a);j++)
232 COPY(S_MO_K(S_V_I(a,j)), S_V_I(S_V_I(d,i),j));
233 }
234
235 /* im vector d stehen die bideterminanten nach anwendung der permutation
236 diese jetzt zerlegen in der basis in e
237 dies ergibt die zeilen der darstellenden matrix
238 */
239
240 FREEALL(a);
241 decompose_matrix(d,e,c,prim);
242 FREEALL(d);
243 ENDR("get_dg");
244 }
245
specht_basis_mod_p(e,p)246 static INT specht_basis_mod_p(e,p) OP e,p;
247 /* die basis des specht moduls wird mod p gerechnet,
248 die koeff sind nun FF
249
250 und es ist normaleweise keine basis mehr */
251 {
252 INT i,j,erg =OK;
253
254 for (i=0;i<S_M_HI(e);i++)
255 for (j=0;j<S_M_LI(e);j++)
256 {
257 INT eintrag ;
258 eintrag = S_M_IJI(e,i,j) % S_I_I(p);
259 if (eintrag < 0) eintrag += S_I_I(p);
260 M_I_I(eintrag, S_M_IJ(e,i,j));
261 }
262 ENDR("specht_basis_mod_p");
263 }
264
get_specht_basis_of_sbd(a,e)265 static INT get_specht_basis_of_sbd(a,e) OP a,e;
266 /* basis des specht moduls aus
267 P-symmetrizied sbd */
268 /* koeff sind INTEGER, e is matrix zeilenweise sortiert wie in zero_one_matrices */
269 /* input is partition */
270 {
271 OP bb,cc,aa,z,dd;
272 OP c,d;
273 INT i,j,k;
274 INT erg = OK;
275 CTO(PARTITION,"get_specht_basis_of_sbd(1)",a);
276 CALLOCOBJECT5(cc,c,d,bb,dd);
277
278 makevectorofSYT(a,cc);
279 m_lh_nm(S_V_L(zero_one_matrices),S_V_L(cc),e);
280
281 m_u_t(a,bb);
282 for (i=0;i<S_PA_LI(a);i++)
283 for (j=0;j<S_PA_II(a,S_PA_LI(a)-1-i);j++)
284 M_I_I(i+1,S_T_IJ(bb,i,j));
285
286 P_symmetrized_bideterminant(bb,S_V_I(cc,0),d);
287
288 k=0;
289 FORALL(z,d,{
290 m_ilih_m(S_M_LI(S_MO_S(z))-1,S_M_HI(S_MO_S(z))-1,dd);
291 C_O_K(dd,INTEGERMATRIX);
292 for (i=0;i<S_M_HI(S_MO_S(z))-1;i++)
293 for (j=0;j<S_M_LI(S_MO_S(z))-1;j++)
294 M_I_I(S_M_IJI(S_MO_S(z),i+1,j+1),S_M_IJ(dd,i,j));
295 swap(dd,S_MO_S(z));
296 while (not EQ(S_MO_S(z),S_V_I(zero_one_matrices,k))) k++;
297 COPY(S_MO_K(z),S_M_IJ(e,0,k));
298 });
299
300 t_LIST_VECTOR(d,d);
301
302
303 copy(d,dd);
304 for (i=1;i<S_M_HI(e);i++)
305 {
306 OP ddd;
307 OP aaa = S_V_I(cc,i);
308 OP aa = S_V_I(cc,0);
309 INT ii;
310 ddd = callocobject();
311 weight(aa,c);
312 m_il_p(S_I_I(c),ddd);
313 for (ii=0;ii<S_T_HI(aa);ii++)
314 for (j=0;j<=zeilenende(aa,ii);j++)
315 M_I_I(S_T_IJI(aaa,ii,j),S_P_I(ddd,S_T_IJI(aa,ii,j)-1));
316
317 /* ddd is permutation to go from SYT at place 0 to SYT at place i in vector e */
318
319 for (j=0;j<S_V_LI(d);j++)
320 {
321 copy(S_MO_K(S_V_I(d,j)), S_MO_K(S_V_I(dd,j)));
322 operate_perm_spaltenmatrix_new(ddd,S_MO_S(S_V_I(d,j)),S_MO_S(S_V_I(dd,j)));
323 }
324
325 freeall(ddd);
326 qsort_vector(dd);
327
328 k=0;
329 for (j=0;j<S_V_LI(dd);j++)
330 {
331 while (not EQ(S_MO_S(S_V_I(dd,j)),S_V_I(zero_one_matrices,k))) k++;
332 COPY(S_MO_K(S_V_I(dd,j)),S_M_IJ(e,i,k));
333 }
334 }
335 FREEALL5(cc,bb,dd,c,d);
336 ENDR("get_specht_basis_of_sbd");
337 }
338
basis_mod_dg(prim,part,e)339 INT basis_mod_dg(prim,part,e) OP part,prim,e;
340 /* computes the basis e of the modular irreducible sn-module labeled by part */
341 /* AK 270503 */
342 /* AK 070704 V3.0 */
343 {
344 INT erg = OK;
345 CTO(INTEGER,"basis_mod_dg(1)",prim);
346 CTO(PARTITION,"basis_mod_dg(2)",part);
347 CE3(prim,part,e,basis_mod_dg);
348
349
350
351 {
352 OP a;
353 init_zero_one(part);
354 a = CALLOCOBJECT();
355 conjugate(part,a);
356 get_specht_basis_of_sbd(a,e);
357 FREEALL(a);
358
359
360 specht_basis_mod_p(e,prim); /*entires are now mod p*/
361 make_basis(e,prim,NULL);
362 }
363
364 ENDR("basis_mod_dg");
365 }
366
367
kk_280604(part,e,prim)368 INT kk_280604 (part,e,prim) OP part,e,prim;
369 /* computes the matrix e
370 whose rows are basis of the irreducible sn-module labeled by part */
371 /* AK 270604 */
372 {
373 INT i,j,erg =OK;
374 OP a,temp;
375
376 init_zero_one(part);
377 a = callocobject();
378 conjugate(part,a);
379 get_specht_basis_of_sbd(a,e);
380 if (S_I_I(prim)!=0){ /*dann konvertiere nach Fp*/
381 for (i=0;i<S_M_HI(e);i++){ /*konvertiere jetzt die Matrix entries in FF-Elemente*/
382 for (j=0;j<S_M_LI(e);j++){
383 temp=S_M_IJ(e,i,j);
384 t_INTEGER_FF(temp,prim,S_M_IJ(e,i,j));
385 }
386 }
387 }
388 freeall(a);
389 close_zero_one();
390 }
391
392
393 static INT ss; /*size*/
mycmp(a,b)394 static INT mycmp(a,b) OP a,b;
395 {
396 INT i;
397 for (i=0;i<ss;i++) if (S_I_I(a+i) < S_I_I(b+i)) return 1;
398 else if (S_I_I(a+i) > S_I_I(b+i)) return -1;
399 ;
400 return 0;
401 }
402
get_symm_specht_poly(a,i,c)403 static INT get_symm_specht_poly(a,i,c) OP a,c; INT i;
404 /* AK 210703 */
405 /* ite reihe von a ist symmetrized specht polynom
406 write it as object of type POLYNOM */
407 {
408 INT j,erg = OK;
409 init(HASHTABLE,c);
410 for (j=0;j<S_M_LI(a);j++)
411 {
412 if (S_M_IJI(a,i,j)!=0)
413 {
414 OP d,m;
415 INT k,l;
416 m=S_V_I(zero_one_matrices,j);
417 d=CALLOCOBJECT();
418 b_sk_mo(CALLOCOBJECT(),CALLOCOBJECT(),d);
419 M_I_I(S_M_IJI(a,i,j),S_MO_K(d));
420 m_il_nv(S_M_LI(m),S_MO_S(d));
421 for (k=0;k<S_M_LI(m);k++)
422 for (l=1;l<S_M_HI(m);l++)
423 if (S_M_IJI(m,l,k) == 1) { M_I_I(l,S_MO_SI(d,k)); break; }
424
425
426 insert(d,c,NULL,NULL);
427 }
428 }
429 t_HASHTABLE_POLYNOM(c,c);
430 ENDR("get_symm_specht_poly");
431 }
432
init_zero_one(part)433 static INT init_zero_one(part) OP part;
434 /* this vector of zero one matrices are the possible exponent in the
435 sbd */
436 {
437 OP a,b,c,d;INT erg=OK;
438 zero_one_matrices=callocobject(); /*global*/
439 CALLOCOBJECT4(a,b,c,d);
440 erg += weight_partition(part,b);
441 last_partition(b,c);
442 conjugate(part,a);
443 reverse_vector(S_PA_S(a),d);
444 all_01_matrices(d,c,zero_one_matrices);
445 FREEALL4(a,b,c,d);
446 qsort_vector(zero_one_matrices);
447 ENDR("internal:init_zero_one");
448 }
close_zero_one()449 static INT close_zero_one()
450 {
451 INT erg =OK;
452 erg+=freeall(zero_one_matrices); zero_one_matrices=NULL;
453 ENDR("internal:close_zero_one");
454 }
makevectorofsymspecht_poly(part,v)455 INT makevectorofsymspecht_poly(part,v) OP part,v;
456 /* AK 300703 */
457 /* produces a vector of symmetrized specht polynomials
458 these are basis of the ordinary specht module
459 and generator of the modular specht module
460 */
461 {
462 INT erg = OK;
463 CTO(PARTITION,"makevectorofsymspecht_poly(1)",part);
464 CE2(part,v,makevectorofsymspecht_poly);
465 {OP a,e;INT i;
466 init_zero_one(part);
467 CALLOCOBJECT2(a,e);
468 conjugate_partition(part,a);
469 get_specht_basis_of_sbd(a,e);
470 m_l_v(S_M_H(e),v);
471 for (i=0;i<S_M_HI(e);i++)
472 get_symm_specht_poly(e,i,S_V_I(v,i));
473
474 FREEALL2(a,e);
475 close_zero_one();
476 }
477 ENDR("makevectorofsymspecht_poly");
478 }
479
code_mod_into_ord(prim,part,f)480 INT code_mod_into_ord(prim,part,f) OP prim,part,f;
481 /* AK 210703 embedding of the mod into ord spect module
482 compute mod basis, take the original symmetrized specht
483 polynomials which become bases, write them in the basis
484 of the non symmetrized specht polynomials
485 read it as coeff in N, get code */
486 {
487 INT erg = OK,i,j,k;
488 OP a,b,c,d,e,v;
489 CTO(INTEGER,"code_mod_into_ord(1)",prim);
490 CTO(PARTITION,"code_mod_into_ord(2)",part);
491
492 CALLOCOBJECT5(a,b,c,d,v);
493 init_zero_one(part);
494 conjugate(part,a);
495 FREEALL3(b,c,d);
496 e = CALLOCOBJECT();
497 get_specht_basis_of_sbd(a,e);
498 copy(e,a);
499
500 specht_basis_mod_p(e,prim); /*entires are mod p*/
501 make_basis(e,prim,v); /* v is vector 1=in basis of mod */
502
503 CALLOCOBJECT2(c,d);
504
505 m_ilih_nm(S_M_HI(a),S_V_LI(v),f);
506 conjugate(part,e);
507 makevectorofspecht_poly(e,d);
508 /* compute the specht polynomials according to the rows
509 indexed in v */
510 for (i=0;i<S_M_HI(f);i++)
511 {
512 INT j;
513 get_symm_specht_poly(a,S_V_II(v,i),c);
514 mod(c,prim,c);
515 aaa:
516 if (not NULLP(c))
517 for (j=0L;j<S_V_LI(d); j++)
518 if (EQ(S_PO_S(c),S_PO_S(S_V_I(d,j))))
519 {
520 CLEVER_COPY(S_PO_K(c),S_M_IJ(f,i,j));
521 FREESELF(e);
522 MULT(S_PO_K(c),S_V_I(d,j),e);
523 erg += sub_apply(e,c); /* c = c -e */
524 mod(c,prim,c);
525 goto aaa;
526 }
527
528 }
529 FREEALL4(e,d,c,v);
530 erg+=freeall(zero_one_matrices); zero_one_matrices=NULL;
531 ENDR("code_mod_into_ord");
532 }
533
code_mod_into_ord2(prim,part,f)534 INT code_mod_into_ord2(prim,part,f) OP prim,part,f;
535 /* AK 300703 embedding of the mod into ord specht module
536 compute mod basis, take this basis
537 write the in basis
538 of the non symmetrized specht polynomials
539 read it as coeff in N, get code */
540 /* as we take the same subspace the minimal distance in code_mod_into_ord2
541 and code_mod_into_ord are equal !! */
542 {
543 INT erg = OK,i,j,k;
544 OP a,b,c,d,e,v;
545 CTO(INTEGER,"code_mod_into_ord2(1)",prim);
546 CTO(PARTITION,"code_mod_into_ord2(2)",part);
547
548 CALLOCOBJECT5(a,b,c,d,v);
549 init_zero_one(part);
550 conjugate(part,a);
551 FREEALL3(b,c,d);
552 e = CALLOCOBJECT();
553 get_specht_basis_of_sbd(a,e);
554 copy(e,a);
555
556 specht_basis_mod_p(e,prim); /*entires are mod p*/
557 make_basis(e,prim,v); /* v is vector 1=in basis of mod*/
558 CALLOCOBJECT2(c,d);
559
560 m_ilih_nm(S_M_HI(a),S_V_LI(v),f);conjugate(part,d);
561 makevectorofspecht_poly(d,d);
562 /* compute the specht polynomials according to the rows
563 in e */
564 for (i=0;i<S_M_HI(f);i++)
565 {
566 INT j;
567 get_symm_specht_poly(e,i,c);
568 mod(c,prim,c);
569 aaa:
570 if (not NULLP(c))
571 for (j=0L;j<S_V_LI(d); j++)
572 if (EQ(S_PO_S(c),S_PO_S(S_V_I(d,j))))
573 {
574 CLEVER_COPY(S_PO_K(c),S_M_IJ(f,i,j));
575 FREESELF(v);
576 MULT(S_PO_K(c),S_V_I(d,j),v);
577 erg += sub_apply(v,c); /* c = c -v */
578 mod(c,prim,c);
579 goto aaa;
580 }
581
582 }
583 FREEALL4(e,d,c,v);
584 erg+=freeall(zero_one_matrices); zero_one_matrices=NULL;
585 ENDR("code_mod_into_ord2");
586 }
587
588
embedding_mod_into_ord(prim,part,f)589 INT embedding_mod_into_ord(prim,part,f) OP prim,part,f;
590 /* for the embedding of modular irreducible
591 into irreducible of ordinary */
592 /* the modular symmetrized specht polynomials are written in the basis */
593 /* of the symmetrized specht polynomials */
594 /* AK 170703 for arbitrary prime */
595 {
596 INT erg = OK,i,j,k;
597 OP a,b,c,d,e;
598 CTO(INTEGER,"basis_mod_dg(1)",prim);
599 CTO(PARTITION,"basis_mod_dg(2)",part);
600 CE3(prim,part,f,basis_mod_dg);
601
602 b = CALLOCOBJECT();
603 weight(part,b);
604
605
606 a = CALLOCOBJECT();
607 conjugate(part,a);
608 init_zero_one(part);
609 e = CALLOCOBJECT();
610 get_specht_basis_of_sbd(a,e);
611 FREEALL(a);
612
613
614
615 specht_basis_mod_p(e,prim);
616 FREEALL(zero_one_matrices);
617 c = CALLOCOBJECT();
618 COPY(e,c);
619 make_basis(e,prim,NULL);
620 /* write c in the basis of e*/
621
622 /*sortiere e*/
623 ss = S_M_HI(e);
624 qsort(S_M_S(e),S_M_HI(e),sizeof(struct object)*S_M_LI(e),mycmp);
625
626 m_ilih_nm(S_M_HI(e),S_M_HI(c),f);
627
628 d = CALLOCOBJECT();
629 m_il_v(S_M_HI(e),d);
630 for (i=0;i<S_M_HI(e);i++)
631 for (j=0;i<S_M_LI(e);j++) if (S_M_IJI(e,i,j) != 0) {M_I_I(j,S_V_I(d,i)); break; }
632
633 /* vector mit erster position != 0 */
634
635 b = CALLOCOBJECT();
636 m_il_v(S_M_LI(c),b);
637 for (i=0;i<S_M_HI(f);i++)
638 {
639 INT ko;
640 /* zeile aus c */
641 for (j=0;j<S_V_LI(b);j++) COPY(S_M_IJ(c,i,j),S_V_I(b,j));
642 again:
643 /* erster eintrag != 0 in b */
644 for (j=0;j<S_V_LI(b);j++) if (S_V_II(b,j) != 0) break;
645 if (j==S_V_LI(b)) {
646 continue; }
647 /* welcher basis vector muss abgezogen werden? */
648 for (k=0;k<S_V_LI(d); k++) if (S_V_II(d,k)==j) break;
649 if (k==S_V_LI(d)) error("kk");
650 ko = 1;
651 while ((ko*S_M_IJI(e,k,j))%S_I_I(prim) != S_V_II(b,j)) ko++;
652 M_I_I(ko, S_M_IJ(f,i,k)); /* koeff schreiben*/
653 /* aendern fuer prim != 2*/
654 /* k te zeile abziehen*/
655 ko = S_I_I(prim)-ko;
656 for (;j<S_V_LI(b);j++)
657 M_I_I( (S_V_II(b,j)+ko*S_M_IJI(e,k,j))%S_I_I(prim), S_V_I(b,j));
658 goto again;
659 }
660
661 FREEALL(b);
662 FREEALL(d);
663
664 FREEALL(c);
665 FREEALL(e);
666 transpose(f,f);
667 ENDR("embedding_mod_into_ord");
668 }
669
670
mod_dg_sbd(prim,part,perm,mat)671 INT mod_dg_sbd(prim,part,perm,mat)
672 OP prim,part,perm,mat;
673 /* AK 020902
674 computes a modular irreducible representation
675 using standard bideterminants */
676 {
677 INT erg = OK;
678 OP a,b,c,d,e;
679 CTO(INTEGER,"mod_dg_sbd(1)",prim);
680 CTO(PARTITION,"mod_dg_sbd(2)",part);
681 CTO(PERMUTATION,"mod_dg_sbd(3)",perm);
682 CE4(prim,part,perm,mat,mod_dg_sbd);
683
684 b = CALLOCOBJECT();
685 weight(part,b);
686
687 if (S_P_LI(perm) != S_I_I(b)) {
688 erg += error("mod_dg_sbd: degree perm != weight part");
689 FREEALL(b);
690 goto endr_ende;
691 }
692 FREEALL(b);
693
694 e = CALLOCOBJECT();
695 basis_mod_dg(prim,part,e);
696 get_dg(perm,e,mat,prim);
697 close_zero_one();
698 FREEALL(e);
699 ENDR("mod_dg_sbd");
700 }
701