/* SYMMETRICA zykelind.c */ #include "def.h" #include "macro.h" static INT zykeltyp_on_pairs_reduced(); static INT zykeltyp_on_2sets(); static INT zykeltyp_on_ksubsets(); static INT zykeltyp_on_ktuples(); static INT zykelind_index_verschieben(); static INT zykelind_operation_for_exp(); static INT zykeltyp_operation_for_exp(); static INT zykeltyp_poly_part(); static INT zykeltyp_hyperbegleitmatrix_poly(); static INT exponenten_bestimmen(); static INT charakteristik_bestimmen(); static INT zykeltyp_poly_part_aff(); static INT zykeltyp_hyperbegleitmatrix_poly_afferg(); static INT zykelind_aff1Zp(); static INT zykelind_aff1Z2(); static INT min_pot(); static INT zykelind_dir_prod_pglkq(); static INT zykelind_dir_prod_pglkq_apply(); static INT zykelind_hoch_dir_prod_pglkq(); static INT mod_mult(); static INT subexponenten_bestimmen(); static INT zyklische_gruppe(); static INT zykeltyp_poly_part_pglkq(); static INT zykeltyp_hyperbegleitmatrix_poly_pglkq(); static INT zykelind_aus_subzykelind(); static INT monom_to_vek(); static INT vek_to_monom(); static INT sum_vector11(); static INT sum_vector1(); static INT zykelind_red(); static INT zykelind_red_apply(); static INT debruijn_formel(); static INT eval_polynom_maxgrad(); static INT mult_po_po_maxgrad(); static INT hoch_po_maxgrad(); static INT zykelind_test1(); static INT comp_vector1(); static INT ordnung(); static INT mu(); static INT vektor_mult_apply(); static INT vektor_prod(); static INT vektor_kgv_prod_durch_kgv(); static INT fmultinom(); static INT fmultinom_ext(); static INT erster_kandidat(); static INT next_kandidat(); static INT next_kandidat2(); static INT first_unordered_part_into_atmost_k_parts(); static INT next_unordered_part_into_atmost_k_parts(); static INT first_part_into_atmost_k_parts(); static INT next_part_into_atmost_k_parts(); static INT redf_f1(); static INT redf_f2(); static INT redf_f3(); static INT redf_f1h(); static INT redf_f2h(); static INT redf_f3h(); static INT redf_formel(); #ifdef POLYTRUE INT zykelind_dir_prod(a,b,c) /* Berechnet aus den Zykelindizes a und b einen weiteren Zykelindex c. Es operiere G auf X und H auf Y dann operiert G\times H auf X\times Y. Der Zykelindex c ist der Zykelindex der Operation von G\times H in obiger Situation, falls a der Zykelindex von der Aktion von G auf X und b der Zykelindex der Aktion von H auf Y ist. */ OP a,b,c; { OP hilfk,hilfmonom,monom1,monom2,monom3; INT i1,i2,ex1,ex2; INT erg=OK; CTO(POLYNOM,"zykelind_dir_prod(1)",a); CTO(POLYNOM,"zykelind_dir_prod(2)",b); hilfk=callocobject(); hilfmonom=callocobject(); monom3=callocobject(); M_I_I(0L,hilfk); erg+=m_scalar_polynom(hilfk,c); monom1=a; while (monom1!=NULL) { monom2=b; while (monom2!=NULL) { erg+=mult(S_PO_K(monom1),S_PO_K(monom2),hilfk); erg+=m_scalar_polynom(hilfk,monom3); for (i1=0L; i1=2L) { M_I_I(ex1,hilf); erg+=binom(hilf,cons_zwei,hilf1); erg+=m_iindex_iexponent_monom(i1,(i1+1L),hilfmonom); erg+=hoch(hilfmonom,hilf1,hilfmonom); erg+=mult_apply(hilfmonom,b); } if (i1 % 2L == 0L) erg+=m_iindex_iexponent_monom(i1,ex1*i1/2L,hilfmonom); else { erg+=m_iindex_iexponent_monom(i1,ex1*((i1+1L)/2L-1L),hilfmonom); erg+=m_iindex_iexponent_monom((i1+1L)/2L-1L,ex1,hilf1); erg+=mult_apply(hilf1,hilfmonom); } erg+=mult_apply(hilfmonom,b); } } i1=S_V_LI(S_PO_S(a))-1L; ex1=S_V_II(S_PO_S(a),i1); if (ex1 != 0L) { if (ex1>=2L) { M_I_I(ex1,hilf); erg+=binom(hilf,cons_zwei,hilf1); erg+=m_iindex_iexponent_monom(i1,(i1+1L),hilfmonom); erg+=hoch(hilfmonom,hilf1,hilfmonom); erg+=mult_apply(hilfmonom,b); } if (i1 % 2L == 0L) erg+=m_iindex_iexponent_monom(i1,ex1*i1/2L,hilfmonom); else { erg+=m_iindex_iexponent_monom(i1,ex1*((i1+1L)/2L-1L),hilfmonom); erg+=m_iindex_iexponent_monom((i1+1L)/2L-1L,ex1,hilf1); erg+=mult_apply(hilf1,hilfmonom); } erg+=mult_apply(hilfmonom,b); } erg+=freeall(hilf); erg+=freeall(hilf1); erg+=freeall(hilfmonom); if (erg != OK) error(" in computation of zykeltyp_on_2sets(a,b) "); return(erg); } INT zykelind_on_2sets(a,b) OP a,b; /* Berechnet aus dem Zykelindex a den Zykelindex b der auf der Menge aller 2-elementigen Teilmengen induzierten Gruppenaktion, die durch die zu a gehoerende Gruppenaktion definiert wird. */ { OP hilfk,monom1,monom3; INT erg=OK; if (S_O_K(a)!=POLYNOM) return error("zykelind_on_2sets(a,b) a not POLYNOM"); if (not EMPTYP(b)) erg+=freeself(b); hilfk=callocobject(); monom3=callocobject(); M_I_I(0L,hilfk); erg+=m_scalar_polynom(hilfk,b); monom1=a; while (monom1!=NULL) { erg+=zykeltyp_on_2sets(monom1,monom3); erg+=add_apply(monom3,b); monom1=S_PO_N(monom1); } erg+=freeall(hilfk); erg+=freeall(monom3); if (erg != OK) error(" in computation of zykelind_on_2sets(a,b) "); return(erg); } INT zykelind_superp_lin_dir_graphs(a,bb) OP a,bb; /* Berechnet den Zyklenzeiger der Gruppenaktion von S_n auf der Menge aller Paare (i,j) mit i ungleich j (Kanten eines gerichteten Graphen) und auf der Menge aller 2-elementigen Teilmengen von {1,2,...,n} (Kanten eines linearen Graphen). Die entsprechenden Zykelverzeichnisse werden dabei mit verschiedenen Familien von Unbestimmten versehen. a ist ein Integer Objekt, das den Wert von n (Anzahl der Knoten der Graphen) angibt. bb ist der errechnete Zyklenzeiger, also ein 2-dimensionaler Zykelindex. c=s_mz_v(bb) ist ein Vektor Objekt. Die (zwei) Eintragungen von c definieren die Stellen in dem Polynomobjekt an denen eine neue Familie von Unbestimmten beginnt. (Somit ist der erste Wert von c gleich 0. Den zweiten Wert kann man in diesem Fall stets gleich (a ueber 2) setzen.) */ { OP b,c,d,cc,hilfmonom,monom1,monom2,monom3,monom4,vekt; INT i1,i2,ex1,ex2; INT erg=OK; if (S_O_K(a)!=INTEGER) return error("zykelind_superp_lin_dir_graphs(a,b) a not INTEGER"); if (not EMPTYP(bb)) erg+=freeself(bb); d=callocobject(); cc=callocobject(); b=callocobject(); c=callocobject(); hilfmonom=callocobject(); monom2=callocobject(); monom3=callocobject(); monom4=callocobject(); vekt=callocobject(); erg+=zykelind_Sn(a,d); erg+=m_scalar_polynom(cons_null,b); erg+=m_il_v(2L,c); M_I_I(0L,S_V_I(c,0L)); erg+=binom(a,cons_zwei,cc); erg+=copy(cc,S_V_I(c,1L)); monom1=d; while (monom1!=NULL) { erg+=zykeltyp_on_pairs_reduced(monom1,monom3); erg+=zykeltyp_on_2sets(monom1,monom2); erg+=copy(S_PO_S(monom2),vekt); while (S_V_LI(vekt)0L) erg+=add_apply(hilf5,S_V_I(c,i)); else erg+=sub(S_V_I(c,i),hilf5,S_V_I(c,i)); } } erg+=ganzdiv(S_V_I(c,i),hilf,S_V_I(c,i)); erg+=inc(hilf); } erg+=freeall(hilf); erg+=freeall(hilf1); erg+=freeall(hilf2); erg+=freeall(hilf3); erg+=freeall(hilf4); erg+=freeall(hilf5); erg+=freeall(pow); erg+=freeall(teiler); erg+=freeall(teiler1); if (erg!=OK) EDC("zykeltyp_operation_for_exp"); return erg; } /* ************************************************************** The cycle indices of centralizers of permutations and stabilizers of partitions. ****************************************************************** */ INT zykelind_centralizer(typ,res) OP typ,res; /* Berechnet den Zyklenzeiger des Stabilisators einer Permutation, vom Zykeltyp typ.*/ { INT erg=OK; OP typv,typvv; OP a=callocobject(); OP b=callocobject(); OP c=callocobject(); OP d=callocobject(); INT i; INT j=0L; erg+=m_scalar_polynom(cons_eins,res); if (S_O_K(typ)==PERMUTATION) { typv=callocobject(); erg+=zykeltyp(typ,typv); t_VECTOR_EXPONENT(typv,typv); typvv=S_PA_S(typv); j=1L; } else if (S_O_K(typ)==PARTITION) { if (S_PA_K(typ)==VECTOR) { typv=callocobject(); t_VECTOR_EXPONENT(typ,typv); typvv=S_PA_S(typv); j=1L; } else typvv=S_PA_S(typ); } else if ((S_O_K(typ)==VECTOR) || (S_O_K(typ)==INTEGERVECTOR)) typvv=typ; else if (S_O_K(typ)==POLYNOM) typvv=S_PO_S(typ); else error("zykelind_centralizer(a,b) a wrong objectkind"); for (i=0,M_I_I(1L,d);i0L) erg+=add_apply(hilf1,ergeb); else if (j<0L) erg+=sub(ergeb,hilf1,ergeb); } erg+=ganzdiv(ergeb,d,ergeb); erg+=freeall(hilf); erg+=freeall(hilf1); if (erg!=OK) error("in computation of number_of_irred_poly_of_degree(d,q,ergeb) "); return(erg); } static INT exponenten_bestimmen(d,q,a,b) OP d,q,a,b; { INT i,j,k,l; OP hilf,hilfv,dd,c,e,f,g,h,speicher; OP ax_e; INT erg=OK; hilf=callocobject(); hilfv=callocobject(); dd=callocobject(); c=callocobject(); e=callocobject(); f=callocobject(); g=callocobject(); h=callocobject(); speicher=callocobject(); erg+=init(BINTREE,speicher); erg+=m_l_v(d,a); erg+=m_l_v(d,b); for (i=0L;i0L) { /*4*/ M_I_I(i+1L,d); erg+=m_scalar_polynom(null,zs2); first_unordered_part_into_atmost_k_parts(S_PA_II(c,i),S_V_LI(S_V_I(v1,i)),c1); do { /*5*/ erg+=m_iindex_monom(0L,zs3); for (j=0L;j0L) { /*4*/ M_I_I(i+1L,d); erg+=m_scalar_polynom(null,zs2); first_unordered_part_into_atmost_k_parts(S_PA_II(c,i),S_V_LI(S_V_I(v1,i)),c1); do { /*5*/ erg+=m_iindex_monom(0L,zs3); for (j=0L;j=1 INTEGER objekt den Zyklenzeiger der Gruppe aller regulaeren $k\times k$ Matrizen (k ein INTEGER objekt) ueber Z_n=(Z modulo n) als Permutationsgruppe von Z_n^k */ { INT erg=OK; OP hilf=callocobject(); OP hilfpoly=callocobject(); OP q=callocobject(); if (S_O_K(k)!=INTEGER) return error("zykelind_glkzn(k,n,cy_ind) k not INTEGER"); if (S_I_I(k)<1L) return error("zykelind_glkzn(k,n,cy_ind) k<1"); if (S_O_K(n)!=INTEGER) return error("zykelind_glkzn(k,n,cy_ind) n not INTEGER"); if (S_I_I(n)<1L) return error("zykelind_glkzn(k,n,cy_ind) n<1"); if (!emptyp(cy_ind)) erg+=freeself(cy_ind); erg+=m_iindex_monom(0L,cy_ind); erg+=integer_factor(n,hilf);/* monopoly Faktorisierung von q */ erg+=copy(hilf,q); while(hilf!=NULL) { if (!einsp(S_PO_K(hilf))) return error(" zykelind_glkzn(k,n,cy_ind) n not square free"); hilf=s_l_n(hilf); } hilf=callocobject(); erg+=copy(q,hilf); while(hilf!=NULL) { erg+=copy(S_PO_S(hilf),q); erg+=zykelind_glkq(k,q,hilfpoly); erg+=zykelind_dir_prod_apply(hilfpoly,cy_ind); hilf=s_l_n(hilf); } /*erg+=freeall(hilf);*/ erg+=freeall(hilfpoly); erg+=freeall(q); if (erg!=OK) error("in computation of zykelind_glkzn(k,n,cy_ind)"); return(erg); } INT zykelind_affkzn(k,n,cy_ind) OP k,n,cy_ind; /* Berechnet fuer quadratfreies n>=1 INTEGER objekt den Zyklenzeiger der Gruppe aller affinen Abbildungen Z_n^k -> Z_n^k mit Z_n=(Z modulo n) als Permutationsgruppe von Z_n^k */ { INT erg=OK; OP hilf=callocobject(); OP hilfpoly=callocobject(); OP q=callocobject(); if (S_O_K(k)!=INTEGER) return error("zykelind_affkzn(k,n,cy_ind) k not INTEGER"); if (S_I_I(k)<1L) return error("zykelind_affkzn(k,n,cy_ind) k<1"); if (S_O_K(n)!=INTEGER) return error("zykelind_affkzn(k,n,cy_ind) n not INTEGER"); if (S_I_I(n)<1L) return error("zykelind_affkzn(k,n,cy_ind) n<1"); if (!emptyp(cy_ind)) erg+=freeself(cy_ind); if (einsp(k)) return zykelind_aff1Zn(n,cy_ind); erg+=m_iindex_monom(0L,cy_ind); erg+=integer_factor(n,hilf);/* monopoly Faktorisierung von q */ erg+=copy(hilf,q); while(hilf!=NULL) { if (!einsp(S_PO_K(hilf))) return error(" zykelind_affkzn(k,n,cy_ind) n not square free"); hilf=s_l_n(hilf); } hilf=callocobject(); erg+=copy(q,hilf); while(hilf!=NULL) { erg+=copy(S_PO_S(hilf),q); erg+=zykelind_affkq(k,q,hilfpoly); erg+=zykelind_dir_prod_apply(hilfpoly,cy_ind); hilf=s_l_n(hilf); } /*erg+=freeall(hilf);*/ erg+=freeall(hilfpoly); erg+=freeall(q); ENDR("internal function zykelind_affkzn"); } static INT zykelind_aff1Zp(p,a,r) OP p,a,r; /* p sei eine Primzahl ungleich 2 r ist der Zyklenzeiger von der Gruppe aller affinen Abbildungen von Z_{p^a}. */ { if (eq(p,cons_zwei)) return zykelind_aff1Z2(a,r); else { INT erg=OK; INT i,j,k; OP hilf1=callocobject(); OP hilf2=callocobject(); OP hilf3=callocobject(); OP hilf4=callocobject(); OP hilf5=callocobject(); OP hmonom=callocobject(); OP hmonom1=callocobject(); OP teiler=callocobject(); OP pp=callocobject(); erg+=m_i_i(0L,r); erg+=copy(p,pp); erg+=dec(pp); erg+=alle_teiler(pp,teiler); erg+=m_i_i(0L,hilf1); for (i=0L;i0L) { /*4*/ M_I_I(i+1L,d); erg+=m_scalar_polynom(null,zs2); first_unordered_part_into_atmost_k_parts(S_PA_II(c,i),S_V_LI(S_V_I(v1,i)),c1); do { /*5*/ erg+=m_scalar_polynom(eins,zs3); for (j=0L;j0L) { /*4*/ M_I_I(i+1L,d); erg+=m_scalar_polynom(null,zs2); first_unordered_part_into_atmost_k_parts(S_PA_II(c,i),S_V_LI(S_V_I(v1,i)),c1); do { /*5*/ erg+=m_scalar_polynom(eins,zs3); for (j=0L;j1L) { erg+=fakul(S_V_I(a,i),hilf); erg+=mult_apply(hilf,c); } erg+=mult_apply(S_PO_K(hilfm),c); erg+=freeall(hilf); if (erg!=OK) error("in computation of debruijn_formel(a,b,c)"); return(erg); } hilfm=S_PO_N(hilfm); } M_I_I(0L,c); freeall(hilf); if (erg!=OK) error("in computation of debruijn_formel(a,b,c)"); return(erg); } static INT sum_vector11(vecobj,ergebnis,gr) OP vecobj,ergebnis,gr; /* berechnet die Summe $\sum_{i=0L}^{s_v_li(vecobj)-1L} (i+1)*s_v_i(vecobj,i)$ falls diese kleiner als gr bleibt, ansonsten gibt sie die erste Teilsumme groesser als gr aus. */ { INT i; INT erg = OK; OP hilf=callocobject(); if ((S_O_K(vecobj)!=VECTOR)&&(S_O_K(vecobj)!=INTEGERVECTOR)) return error("sum_vector11(vecobj,ergebnis) vecobj not VECTOR"); if (!emptyp(ergebnis)) erg+=freeself(ergebnis); M_I_I(0L,ergebnis); for ( i=0L; i < S_V_LI(vecobj);i++) { erg+=m_i_i(i+1L,hilf); erg+=mult_apply(S_V_I(vecobj,i),hilf); erg += add_apply(hilf , ergebnis); if (gt(ergebnis,gr)) { erg+=freeall(hilf); if (erg!=OK) error(" in computation of sum_vector11(vecobj,ergebnis) "); return(erg); } } erg+=freeall(hilf); if (erg!=OK) error(" in computation of sum_vector11(vecobj,ergebnis) "); return erg; } static INT sum_vector1(vecobj,ergebnis) OP vecobj,ergebnis; /* berechnet die Summe $\sum_{i=0L}^{s_v_li(vecobj)-1L} (i+1)*s_v_i(vecobj,i)$ */ { INT i; INT erg = OK; OP hilf=callocobject(); if ((S_O_K(vecobj)!=VECTOR)&&(S_O_K(vecobj)!=INTEGERVECTOR)) return error("sum_vector1(vecobj,ergebnis) vecobj not VECTOR"); if (!emptyp(ergebnis)) erg+=freeself(ergebnis); M_I_I(0L,ergebnis); for ( i=0L; i < S_V_LI(vecobj);i++) { erg+=m_i_i(i+1L,hilf); erg+=mult_apply(S_V_I(vecobj,i),hilf); erg += add_apply(hilf , ergebnis); } if (erg!=OK) error(" in computation of sum_vector1(vecobj,ergebnis) "); return erg; } INT stirling_numbers_second_kind_vector(a,b) OP a,b; /* a INTEGER object , the result b is a VECTOR object of length a+1 with entry s_v_i(i,b) = 2. Stirl. number S(a,i) */ /* HF 1994 */ /* AK 200704 V3.0 */ { INT erg=OK; CTO(INTEGER,"stirling_numbers_second_kind_vector(1)",a); SYMCHECK(S_I_I(a)<0,"stirling_numbers_second_kind_vector:parameter <0"); { if (NULLP_INTEGER(a)) { erg += m_o_v(cons_null,b); } else { OP bb,c,d,e,f; INT i,j; CALLOCOBJECT5(bb,c,d,e,f); M_I_I(0L,f); erg+=m_il_v(S_I_I(a)+1L,b); M_I_I(0L,S_V_I(b,0L)); i=0L; erg+=m_iindex_iexponent_monom(0L,s_i_i(a),d); for (j=1;j<=S_I_I(a);j++) { M_I_I(j,c); erg+=zykelind_Sn(c,bb); erg+=debruijn_all_functions(d,bb,e); erg+=sub(e,f,S_V_I(b,j)); CLEVER_COPY(e,f); } FREEALL5(bb,c,d,e,f); } } ENDR("stirling_numbers_second_kind_vector"); } INT polya1_sub(a,c,b) OP a,b,c; /* einsetzung */ /* a ist polynom */ /* c ist length of alphabet */ /* b wird ergebnis x_i ----> 1 + 2 q^i */ /* AK 080190 */ /* AK 091190 V1.1 */ /* AK 200891 V1.3 */ /*FRIP 15.3.94 */ { OP d,e,f,g; INT i; INT erg=OK; if (S_O_K(a)!=POLYNOM) return error("polya1_sub(a,c,b) a not POLYNOM"); if (S_O_K(c)!=INTEGER) return error("polya1_sub(a,c,b) c not INTEGER"); if (not EMPTYP(b)) erg+=freeself(b); d=callocobject(); e=callocobject(); f=callocobject(); g=callocobject(); M_I_I(1L,d); erg += m_scalar_polynom(d,e); M_I_I(2L,d); erg += m_il_v(1L,f); M_I_I(1L,s_v_i(f,0L)); erg+=m_skn_po(f,d,NULL,g); erg += m_il_v(S_I_I(c),d); for (i=0L;i 1 + i q^i */ /* AK 080190 */ /* AK 091190 V1.1 */ /* AK 200891 V1.3 */ /*FRIP 15.3.94 */ { OP d,e,f,g; INT i; INT erg=OK; if (S_O_K(a)!=POLYNOM) return error("polya2_sub(a,c,b) a not POLYNOM"); if (S_O_K(c)!=INTEGER) return error("polya2_sub(a,c,b) c not INTEGER"); if (not EMPTYP(b)) erg+=freeself(b); d=callocobject(); e=callocobject(); f=callocobject(); g=callocobject(); M_I_I(1L,d); erg += m_scalar_polynom(d,e); /*M_I_I(2L,d);*/ erg += m_il_v(1L,f); M_I_I(1L,s_v_i(f,0L)); erg+=m_skn_po(f,d,NULL,g); erg += m_il_v(S_I_I(c),d); for (i=0L;i 1 + q^i + q^2i + q^3i + ... */ /* dd ist die hoechste Potenz von q die eingesetzt werden kann */ /* das Ergebnis stimmt nur bis zu der Potenz q^dd */ /* AK 080190 */ /* AK 091190 V1.1 */ /* AK 200891 V1.3 */ /*FRIP 7.6.94 */ { OP d,e,f,g,h; INT i; INT erg=OK; if (S_O_K(a)!=POLYNOM) return error("polya3_sub(a,c,b) a not POLYNOM"); if (S_O_K(c)!=INTEGER) return error("polya3_sub(a,c,b) c not INTEGER"); if (not EMPTYP(b)) erg+=freeself(b); d=callocobject(); e=callocobject(); f=callocobject(); g=callocobject(); h=callocobject(); M_I_I(1L,d); erg += m_scalar_polynom(d,e); erg += m_il_v(1L,f); M_I_I(1L,s_v_i(f,0L)); erg+=m_skn_po(f,d,NULL,g); erg += m_il_v(S_I_I(c),d); for (i=0L;i 1 + q^i */ /* maxgrad ist der maximale Grad der berechnet werden soll */ /* AK 080190 */ /* AK 091190 V1.1 */ /* AK 200891 V1.3 */ /*FRIP 15.3.94 */ { OP d,e,f,g; INT i; INT erg=OK; if (S_O_K(a)!=POLYNOM) return error("co_polya_sub(a,c,maxgrad,b) a not POLYNOM"); if (S_O_K(c)!=INTEGER) return error("co_polya_sub(a,c,maxgrad,b) c not INTEGER"); if (not EMPTYP(b)) erg+=freeself(b); d=callocobject(); e=callocobject(); f=callocobject(); g=callocobject(); M_I_I(1L,d); erg += m_scalar_polynom(d,e); /*M_I_I(1L,d);*/ erg += m_il_v(1L,f); M_I_I(1L,s_v_i(f,0L)); erg+=m_skn_po(f,d,NULL,g); erg += m_il_v(S_I_I(c),d); for (i=0L;i 1 + q^i + q^2i + q^3i + ... */ /* dd ist die hoechste Potenz von q die eingesetzt werden kann */ /* das Ergebnis stimmt nur bis zu der Potenz q^dd */ /* AK 080190 */ /* AK 091190 V1.1 */ /* AK 200891 V1.3 */ /*FRIP 7.6.94 */ { OP d,e,f,g,h; INT i; INT erg=OK; if (S_O_K(a)!=POLYNOM) return error("co_polya3_sub(a,c,dd,b) a not POLYNOM"); if (S_O_K(c)!=INTEGER) return error("co_polya3_sub(a,c,dd,b) c not INTEGER"); if (not EMPTYP(b)) erg+=freeself(b); d=callocobject(); e=callocobject(); f=callocobject(); g=callocobject(); h=callocobject(); M_I_I(1L,d); erg += m_scalar_polynom(d,e); erg += m_il_v(1L,f); M_I_I(1L,s_v_i(f,0L)); erg+=m_skn_po(f,d,NULL,g); erg += m_il_v(S_I_I(c),d); for (i=0L;i0 falls a>b <0 falls a0 */ if (erg != 0L) return(erg); ++i; } } else { for ( i=0L; i= 0L) { M_I_I(S_V_II(v,i)+1L,S_V_I(v,i)); if (S_V_II(v,i) > m) { M_I_I(0L,S_V_I(v,i)); i=i-1L; } else fertig=1L; } if (i<0L) return(2L); /* alle Kandidaten aufgelistet */ else return(1L); /* kein Fehler aufgetreten */ } static INT next_kandidat2(vfh,v) OP v,vfh; { int i,fertig; if (S_O_K(vfh)!=VECTOR) return error("next_kandidat2(vfh,v) vfh not VECTOR"); /* for (i=0;i= 0L) { M_I_I(S_V_II(v,i)+1L,S_V_I(v,i)); if (S_V_II(v,i) > S_V_II(vfh,i)) { M_I_I(0L,S_V_I(v,i)); i=i-1L; } else fertig=1L; } if (i<0L) return(2L); /* alle Kandidaten aufgelistet */ else return(1L); /* kein Fehler aufgetreten */ } static INT mu(a) OP a; /* Berechnet Moebiusfunktion(a) */ { OP aa,tei; INT j; INT erg=OK; if (S_O_K(a)!=INTEGER) return error("mu(a) a not INTEGER"); if (S_I_I(a)<1L) return error("mu(a) a<1"); if (S_I_I(a)==1L) { if (erg != OK) error(" in computation of mu(a) "); return(1L); } aa=callocobject(); erg+=integer_factor(a,aa);/* monopoly Faktorisierung von a */ j=0L; tei=aa; while (tei != NULL) { ++j; if(S_PO_KI(tei)>1L) { erg+=freeall(aa); if (erg != OK) error(" in computation of mu(a) "); return(0L); } tei=S_L_N(tei); } if (j%2L==0L) { erg+=freeall(aa); if (erg != OK) error(" in computation of mu(a) "); return(1L); } else { erg+=freeall(aa); if (erg != OK) error(" in computation of mu(a) "); return(-1L); } } INT coeff_of_in(a,b,c) OP a,b,c; /* Bestimmt c, den Koeffizienten von x^a in dem Polynom b ( b ist ein Polynom in einer Unbestimmten). */ { OP poly; INT erg=OK; if (S_O_K(a)!=INTEGER) return error("coeff_of_in(a,b,c) a not INTEGER"); if (S_I_I(a)<0L) return error("coeff_of_in(a,b,c) a<0"); if (S_O_K(b)!=POLYNOM) return error("coeff_of_in(a,b,c) b not POLYNOM"); if (not EMPTYP(c)) erg+=freeself(c); poly=b; while (poly!=NULL) { if (eq(a,S_PO_SI(poly,0L))) { erg+=copy(S_PO_K(poly),c); if (erg != OK) error(" in computation of coeff_of_in(a,b,c) "); return(erg); } poly=S_PO_N(poly); } M_I_I(0L,c); if (erg != OK) error(" in computation of coeff_of_in(a,b,c) "); return(erg); } static INT vektor_mult_apply(a,b) OP a,b; /* Sei a[i] das i-te Element von a, dann wird a[i] als a[i]*b berechnet. */ { INT i; INT erg=OK; /*if (S_O_K(a)==INTEGERVECTOR) C_O_K(a,VECTOR);*/ if ((S_O_K(a)!=VECTOR)&&(S_O_K(a)!=INTEGERVECTOR)) return error("vektor_mult_apply(a,b) a not VECTOR"); if (S_O_K(b)!=INTEGER) return error("vektor_mult_apply(a,b) b not INTEGER"); for (i=0L;i=0. Diese Darstellung wird als VECTOR a weitergegeben. */ { int i; INT erg=OK; m_il_nv(k,a); if (k>0) M_I_I(s,S_V_I(a,k-1L)); ENDR("internal func first_unordered_part_into_atmost_k_parts"); } static INT next_unordered_part_into_atmost_k_parts(a) OP a; /*next_pa_into_atmost_k_parts(a)*/ /* Berechnet den Nachfolger der Darstellung einer natuerlichen Zahl als Summe von hoechstens k Summanden >=0. Die natuerliche Zahl ist dabei die Summe ueber alle Elemente von a, k ist die Laenge von a. */ { int i; INT erg = OK; CTO(VECTOR,"next_unordered_part_into_atmost_k_parts",a); i=S_V_LI(a)-1L; while( (i>=0L) && nullp(S_V_I(a,i)) ) --i; if (i<=0L) return(2L); /* alle aufglistet */ copy(S_V_I(a,i),S_V_I(a,S_V_LI(a)-1L)); dec(S_V_I(a,S_V_LI(a)-1L)); inc(S_V_I(a,i-1L)); if (i=1L) && (le(S_V_I(v,i),hilf1))); if ((i==0L) && (eq(S_V_I(v,i),hilf1))) { res=2L; goto ende; } copy(S_V_I(v,i),hilf1); dec(hilf1); quores(hilf,hilf1,hilf2,hilf3); if (nullp(hilf3)) l=0L; else l=1L; if (S_I_I(hilf2)+i+l<=S_V_LI(v)) { for (j=0L;j0L) nn = S_L_N(nn); else { redf_f3(S_L_S(von),S_L_S(nn),har); nn = S_L_N(nn); } } return(OK); } static INT redf_f3(a,b,c) OP a,b,c; /* a,b sin MONOMe mit gleichem S_MO_S VECTOR ihre Koeffizienten werden zusammenmultipliziert und als neuer Term zu c (POLYNOM) mit S_MO_S VECTOR dazuaddiert */ { INT erg=OK; OP hilf=callocobject(); OP monom=callocobject(); erg+=mult(S_MO_K(a),S_MO_K(b),hilf); erg+=m_skn_po(S_MO_S(a),hilf,NULL,monom); erg+=add_apply(monom,c); erg+=freeall(hilf); erg+=freeall(monom); if (erg!=OK) EDC("redf_f3"); return erg; } static INT redf_f1h(a,b,na,nb,c) OP a,b,na,nb,c; /* a,b sin POLYNOME, c wird ein neues POLYNOM, dessen MONOMe sowohl in a als auch in b vorkommen. Die entsprechenden Koeffizienten werden zusammenmultipliziert. Dazu werden a und b in Listen umgewandelt. Diese Listen werden in redf_f2h auf gleiche MONOM-VECTOREN untersucht, und c wird dann in redf_f3h aufgebaut. na und nb sind die Vielfachheiten, mit denen a bzw b auftritt */ { INT erg=OK; OP al=callocobject(); OP bl=callocobject(); erg+=copy_list(a,al); erg+=copy_list(b,bl); erg+=m_i_i(0L,c); erg+=redf_f2h(al,bl,na,nb,c); erg+=freeall(al);erg+=freeall(bl); if (erg!=OK) return error(" in computation of redf_f1h"); return erg; } static INT redf_f2h(von,nach,na,nb,har) OP von,nach,na,nb,har; /* untersucht die Listen von und nach auf gleiche MONOM-VECTORen Falls solche auftreten wird redf_f3h aufgerufen. */ { INT erg; OP nn = callocobject(); *nn = *nach; while((von != NULL) && (nn != NULL)) { erg=comp_monomvector_monomvector(S_L_S(von),S_L_S(nn)); if (erg < 0L) von = S_L_N(von); else if (erg >0L) nn = S_L_N(nn); else { redf_f3h(S_L_S(von),S_L_S(nn),na,nb,har); nn = S_L_N(nn); } } return(OK); } static INT redf_f3h(a,b,na,nb,c) OP a,b,na,nb,c; /* a,b sin MONOMe mit gleichem S_MO_S VECTOR ihre Koeffizienten werden zusammenmultipliziert und als neuer Term zu c (POLYNOM) mit S_MO_S VECTOR dazuaddiert */ { INT erg=OK; OP hilf=callocobject(); OP monom=callocobject(); erg+=hoch(S_MO_K(a),na,hilf); erg+=hoch(S_MO_K(b),nb,monom); erg+=mult_apply(monom,hilf); erg+=freeself(monom); erg+=m_skn_po(S_MO_S(a),hilf,NULL,monom); erg+=add_apply(monom,c); erg+=freeall(hilf); erg+=freeall(monom); if (erg!=OK) EDC("redf_f3h"); return erg; } static INT redf_formel(a,n,b) OP a,b; INT n; /* Berechnet den Koeffizienten fuer die Errechnung des cup bzw. cap Produktes von n+1 gleichen Monomen mit der Gestalt a (ist ein Vektor Objekt). Das Ergebnis ist b. */ { OP hilf; INT i,erg; erg=OK; if (a==NULL) return m_i_i(0L,b); if ((S_O_K(a)!=VECTOR) && (S_O_K(a)!=INTEGERVECTOR)) return error("redf_formel(a,n,b) a not VECTOR"); if (not EMPTYP(b)) erg+=freeself(b); if (n<1L) return error("redf_formel(a,n,b) n<1"); hilf=callocobject(); erg+=m_i_i(1L,b); for (i=0L; i1L) { erg+=m_il_v(2L,z); erg+=copy(v,S_V_I(z,0L)); erg+=copy(p,S_V_I(z,1L)); } else erg+=copy(p,z); ENDR("m_v_po_mz"); } INT zykelind_tetraeder(aa) OP aa; /* Berechnet den Zyklenzeiger der Drehgruppe des Tetraeders. Es treten 3 Familien von Unbestimmten auf. Die erste Familie bezieht sich auf Gruppenaktion auf der Menge der Knoten, die zweite auf der Menge der Kanten und die dritte auf der Menge der Flaechen des Tetraeders. */ { OP a,b,koef,vektor,hilf; INT i; INT erg=OK; koef=callocobject(); vektor=callocobject(); hilf=callocobject(); a=callocobject(); b=callocobject(); erg+=m_ioiu_b(1L,12L,koef); erg+=m_il_v(11L,vektor); for (i=0L;i