/* fmon.c */

#include "def.h"
#include "macro.h"

static INT nu_v_v();
static INT v_v_nu();
static INT permutiere_v();
static INT permutiere_v1();
static INT sims_kette1();
static INT vertausche();
static INT vertausche1();
static INT permutiere_v2();
static INT vertausche_zeilen();

static INT nu_v_v(v,a,b)
OP v,a,b;
/* sei v ein VECTOR mit Eintraegen 1,2,...,a (a ist INTEGER Objekt),
   dann ist b (INTEGER Objekt) die Nummer von v  */
{
INT i;
OP hilf=callocobject();
OP hilf1=callocobject();
OP hilf2=callocobject();
m_i_i(0L,b);
M_I_I(1L,hilf);
for (i=S_V_LI(v)-1L;i>=0L;--i)
{
  if (i!=S_V_LI(v)-1L) mult_apply(a,hilf);
  copy(S_V_I(v,i),hilf2);
  dec(hilf2);
  mult(hilf2,hilf,hilf1);
  add_apply(hilf1,b);
}
inc(b);
freeall(hilf);freeall(hilf1);
}

static INT v_v_nu(b,a,l,v)
OP b,a,l,v;
/* b INTEGER Objekt ist die Nummer eines VECTORS v der zu bestimmen ist
   v hat Eintraege (INTEGER Objekte) aus 1,...,a
   und ist von der Laenge l (INTEGER Objekt).  */
{
INT i;
OP hilf=callocobject();
OP hilf1=callocobject();
OP hilf2=callocobject();
OP hilf3=callocobject();
m_l_v(l,v);
hoch(a,l,hilf);
copy(b,hilf1);
dec(hilf1);
for (i=0L;i<S_V_LI(v);++i)
{
  ganzdiv(hilf,a,hilf);
  quores(hilf1,hilf,hilf2,hilf3);
  inc(hilf2);
  copy(hilf2,S_V_I(v,i));
  copy(hilf3,hilf1);
}
freeall(hilf); freeall(hilf1); freeall(hilf2); freeall(hilf3);
}

INT gen_fmon_group(a,b,c)
/* c ist ein VECTOR Objekt,
   die Eintragungen von c sind PERMUTATION Objekte
   c stellt ein Erzeugendensystem von S_a\wr S_b dar
   a,b sind INTEGER Objekte  */
OP a,b,c;
{
INT i,j,k,l;
OP hilf=callocobject();
OP v=callocobject();
OP w=callocobject();
hoch(a,b,hilf);
if (gt(a,cons_zwei))
{
  if (gt(b,cons_zwei)) m_il_v(4L,c);
  else m_il_v(3L,c);
}
else
{
  if (gt(b,cons_zwei)) m_il_v(3L,c);
  else m_il_v(2L,c);
}
m_il_p(S_I_I(hilf),S_V_I(c,0L));
for (i=1L;i<S_V_LI(c);++i) copy(S_V_I(c,0L),S_V_I(c,i));
ganzdiv(hilf,a,hilf);
j=1L;k=0L;l=0L;
for (i=0L;i<S_P_LI(S_V_I(c,l));++i)
{  
  if ((j==1L) && (i!=0L)) k=k+S_I_I(a);
  ++j;
  if (j>S_I_I(a)) j=1L;
  M_I_I(j+k,S_P_I(S_V_I(c,l),i));
}
if (gt(a,cons_zwei))
{
  j=1L;k=0L;++l;
  for (i=0L;i<S_P_LI(S_V_I(c,l));++i)
  {  
    if ((j==1L) && (i!=0L)) k=k+S_I_I(a);
    if (j==1L) M_I_I(j+k+1L,S_P_I(S_V_I(c,l),i));
    else
    if (j==2L) M_I_I(j+k-1L,S_P_I(S_V_I(c,l),i));
    else
    M_I_I(j+k,S_P_I(S_V_I(c,l),i));
    ++j;
    if (j>S_I_I(a)) j=1L;
  }
}
m_l_v(b,w);
m_i_i(1L,hilf);
++l;
for (i=0L;i<S_P_LI(S_V_I(c,l));++i,inc(hilf))
{
  v_v_nu(hilf,a,b,v);
  permutiere_v(v,w);
  nu_v_v(w,a,S_P_I(S_V_I(c,l),i));
  if (gt(b,cons_zwei))
  {
    permutiere_v1(v);
    nu_v_v(v,a,S_P_I(S_V_I(c,l+1L),i));
  }
}
freeall(hilf); freeall(v); freeall(w);
}

static INT permutiere_v(v,w)
OP v,w;
/* der VECTOR w entsteht aus v durch zyklische Vertauschung der 
Eintraege */
{
INT i;
for (i=0L;i<S_V_LI(v)-1L;++i) copy(S_V_I(v,i),S_V_I(w,i+1L));
copy(S_V_I(v,i),S_V_I(w,0L));
}

static INT permutiere_v1(v)
OP v;
/* im VECTOR v werden die ersten 2 Eintraege vertauscht */
/* Vertauschung der 1. und der 2. Zeile in einem Vektor aus a^n */
{
INT i=S_V_II(v,0L);
copy(S_V_I(v,1L),S_V_I(v,0l));
M_I_I(i,S_V_I(v,1L));
}

static INT sims_kette1(a,n,i,v)
OP a,n,v;
INT i;
/* a Anzahl der Elemente im Alphabet
   n Laenge der Codewoerter
   i Zeichen das  vertauscht werden soll mit i+1,...,a
   v ist ein VECTOR der die einzelnen PERMUTATIONen enthaelt
   dies ist der Stabilisator von (1,...,1)\in a^n in S_a\wrS_n
   */
{
INT k;
OP hilf=callocobject();
hoch(a,n,hilf);
m_il_v(1L,v);
first_permutation(hilf,S_V_I(v,0L));
freeall(hilf);
for (k=S_I_I(n)-1L;k>=0L;--k) vertausche(a,n,i,k,v);
}

static INT vertausche(a,n,i,k,v)
OP a,n,v;
INT i,k;
/* vertauscht bei den Vektoren in a^n in der k-ten Zeile (k laeuft von
   0 bis n-1) den Buchstaben j (\in{1,...,a}) mit allen moeglichen
   Buchstaben i+1,...,a.  */
{
INT j,l;
OP w=callocobject();
OP ww=callocobject();
copy(v,w);
for (j=i+1L;j<=S_I_I(a);++j)
{
  copy(w,ww);
  for (l=0L;l<S_V_LI(ww);++l)
  {
    vertausche1(a,n,i,j,k,S_V_I(v,l),S_V_I(ww,l));
  }
  append(v,ww,v);
}
freeall(w); freeall(ww);
}

static INT vertausche1(a,n,i,j,k,v,w)
OP a,n,v,w;
INT i,j,k;
{
INT l,m,i1,i2,j2,i3,i4,j4,i5;
OP hilf=callocobject();
OP hilf1=callocobject();
M_I_I(k,hilf);
hoch(a,hilf,hilf1);
i1=S_I_I(hilf1);
sub(n,hilf,hilf);
dec(hilf);
hoch(a,hilf,hilf1);
i5=S_I_I(hilf1);
i2=i5*(i-1);
j2=i5*(j-1);
i3=i5*S_I_I(a);
freeself(hilf); freeall(hilf1);
first_permutation(S_P_L(v),hilf);
for (l=0L;l<i1;++l)
{
  i4=i2+l*i3;
  j4=j2+l*i3;
  for (m=0L;m<i5;++m) swap(S_P_I(hilf,j4+m),S_P_I(hilf,i4+m));
}
for (i=0L;i<S_P_LI(v);++i) copy(S_P_I(hilf,S_P_II(v,i)-1L),S_P_I(w,i));
freeall(hilf);
}

/*static INT vertausche1(a,n,i,j,k,v,w)
OP a,n,v,w;
INT i,j,k;
{
INT l,m,i1,i2,j2,i3,i4,j4,i5;
OP hilf=callocobject();
OP hilf1=callocobject();
M_I_I(k,hilf);
hoch(a,hilf,hilf1);
i1=S_I_I(hilf1);
sub(n,hilf,hilf);
dec(hilf);
hoch(a,hilf,hilf1);
i5=S_I_I(hilf1);
i2=i5*(i-1);
j2=i5*(j-1);
i3=i5*S_I_I(a);
freeall(hilf); freeall(hilf1);
for (l=0L;l<i1;++l)
{
  i4=i2+l*i3;
  j4=j2+l*i3;
  for (m=0L;m<i5;++m)
  {
    copy(S_P_I(v,i4+m),S_P_I(w,j4+m));
    copy(S_P_I(v,j4+m),S_P_I(w,i4+m));
  }
}
}*/

static INT permutiere_v2(v,i,j)
OP v;
INT i,j;
/* Vertauschung der i. und der j. Zeile in einem VECTOR aus a^n */
{
INT k=S_V_II(v,i);
copy(S_V_I(v,j),S_V_I(v,i));
M_I_I(k,S_V_I(v,j));
}

static INT vertausche_zeilen(a,n,i,k,v)
OP a,n,v;
INT i,k;
/* vertauscht in allen Vektoren von a^n die k-te Zeile (0<=k<n) mit der
0,1,...,k-1-ten Zeile, und alle Vorkommen des Buchstaben i (1<=i<=a)
in der k-ten Zeile mit allen moeglichen Buchstaben i+1,...,a; */
{
INT j,u;
OP  hilf=callocobject();
OP w=callocobject();
hoch(a,n,hilf);
m_il_v(k+1L,v);
first_permutation(hilf,S_V_I(v,0L));
for (j=1L;j<S_V_LI(v);++j) m_il_p(S_I_I(hilf),S_V_I(v,j));
for (j=0L;j<k;++j)
{
  m_i_i(1L,hilf);
  for (u=0L;u<S_P_LI(S_V_I(v,0L));++u,inc(hilf))
  {
    v_v_nu(hilf,a,n,w);
    permutiere_v2(w,j,k);
    nu_v_v(w,a,S_P_I(S_V_I(v,j+1L),u));
  }
}
freeall(hilf); freeall(w);
vertausche(a,n,i,k,v);
}

INT co_sims_kette_fmon(a,n,b,anz,abbr,basis)
OP a,n,b,anz,abbr,basis;
/* Bestimmt die Sims-Kette b (MATRIX deren Eintraege PERMUTATION sind)
   diese sind die strong generators von S_a\wr S_n als Exponentiation
   dieser 2 Gruppen
   anz ist ein VECTOR der die Anzahl der Nebenklassen Repraesentanten
   in den einzelnen Zeilen enthaelt
   abbr ist ein VECTOR der angibt, bis zu welcher Nummer der Elemente
   von a^n der punktweise Stabilisator gleich bleibt
   basis (INTEGER) gibt die Anzahl der nicht trivialen Zeilen in b an. 
 */
{
INT i,j,k,num;
OP v=callocobject();
OP hilf=callocobject();
OP hilf1=callocobject();
OP hilf2=callocobject();
copy(a,hilf);
dec(hilf);
mult(hilf,n,hilf1);
inc(hilf1);
hoch(a,n,hilf2);
m_lh_m(hilf2,hilf1,b);
m_l_v(hilf1,anz);
m_l_v(hilf1,abbr);
sims_kette1(a,n,1L,v);
num=0L;
copy(S_V_L(v),S_V_I(anz,num));
m_i_i(1L,S_V_I(abbr,num));
for (j=0L;j<S_V_LI(v);++j) copy(S_V_I(v,j),S_M_IJ(b,num,j));
++num;
vertausche_zeilen(a,n,2L,S_I_I(n)-1L,v);
copy(S_V_L(v),S_V_I(anz,num));
m_i_i(2L,S_V_I(abbr,num));
for (j=0L;j<S_V_LI(v);++j) copy(S_V_I(v,j),S_M_IJ(b,num,num+j));
++num;
for (i=3L;i<S_I_I(a);++i) 
{
  m_il_v(1L,v);
  first_permutation(hilf2,S_V_I(v,0L));
  vertausche(a,n,i,S_I_I(n)-1L,v);
  copy(S_V_L(v),S_V_I(anz,num));
  m_i_i(i,S_V_I(abbr,num));
  for (j=0L;j<S_V_LI(v);++j) copy(S_V_I(v,j),S_M_IJ(b,num,num+j));
  ++num;
}
for (k=S_I_I(n)-2L;k>=0L;--k)
{
  m_i_i(k+1L,hilf);
  sub(n,hilf,hilf);
  hoch(a,hilf,hilf1);
  vertausche_zeilen(a,n,2L,k,v);
  copy(S_V_L(v),S_V_I(anz,num));
  add(hilf1,cons_eins,S_V_I(abbr,num));
  for (j=0L;j<S_V_LI(v);++j) copy(S_V_I(v,j),S_M_IJ(b,num,num+j));
  ++num;
  for (i=3L;i<S_I_I(a);++i) 
  {
    m_il_v(1L,v);
    first_permutation(hilf2,S_V_I(v,0L));
    vertausche(a,n,i,k,v);
    copy(S_V_L(v),S_V_I(anz,num));
    add(S_V_I(abbr,num-1L),hilf1,S_V_I(abbr,num));
    for (j=0L;j<S_V_LI(v);++j) copy(S_V_I(v,j),S_M_IJ(b,num,num+j));
    ++num;
  }
}
--num;
while ((eq(S_V_I(anz,num),cons_eins)) && (num>0L)) --num;
m_i_i(num,basis);
freeall(v); freeall(hilf); freeall(hilf1); freeall(hilf2);
}

INT sims_kette_fmon(a,n,b)
OP a,n,b;
/* b (MATRIX) beinhaltet die strong generators von S_a\wr S_n
als Exponentiation operierend auf a^n.  */
{
INT i,j,k,num;
OP v=callocobject();
OP hilf=callocobject();
OP hilf1=callocobject();
OP hilf2=callocobject();
copy(a,hilf);
dec(hilf);
mult(hilf,n,hilf1);
inc(hilf1);
hoch(a,n,hilf2);
m_lh_m(hilf2,hilf2,b);
println(hilf2);
sims_kette1(a,n,1L,v);
num=0L;
for (j=0L;j<S_V_LI(v);++j) copy(S_V_I(v,j),S_M_IJ(b,num,j));
++num;
vertausche_zeilen(a,n,2L,S_I_I(n)-1L,v);
for (j=0L;j<S_V_LI(v);++j) copy(S_V_I(v,j),S_M_IJ(b,num,num+j));
++num;
for (i=3L;i<S_I_I(a);++i) 
{
  m_il_v(1L,v);
  first_permutation(hilf2,S_V_I(v,0L));
  vertausche(a,n,i,S_I_I(n)-1L,v);
  for (j=0L;j<S_V_LI(v);++j) copy(S_V_I(v,j),S_M_IJ(b,num,num+j));
  ++num;
}
if (!eq(a,cons_zwei))
{
  first_permutation(hilf2,S_M_IJ(b,num,num));
  ++num;
}
for (k=S_I_I(n)-2L;k>=0L;--k)
{
  m_i_i(k+1L,hilf);
  sub(n,hilf,hilf);
  hoch(a,hilf,hilf1);
  vertausche_zeilen(a,n,2L,k,v);
  for (j=0L;j<S_V_LI(v);++j) copy(S_V_I(v,j),S_M_IJ(b,num,num+j));
  ++num;
  for (j=1L;j<S_I_I(hilf1);++j)
  {
    first_permutation(hilf2,S_M_IJ(b,num,num));
    ++num;
  }
  for (i=3L;i<S_I_I(a);++i) 
  {
    m_il_v(1L,v);
    first_permutation(hilf2,S_V_I(v,0L));
    vertausche(a,n,i,k,v);
    for (j=0L;j<S_V_LI(v);++j) copy(S_V_I(v,j),S_M_IJ(b,num,num+j));
    ++num;
    for (j=1L;j<S_I_I(hilf1);++j)
    {
      first_permutation(hilf2,S_M_IJ(b,num,num));
      ++num;
    }
  }
if (!eq(a,cons_zwei))
{
  for (j=0L;j<S_I_I(hilf1);++j)
  {
    first_permutation(hilf2,S_M_IJ(b,num,num));
    ++num;
  }
}
}
freeall(v); freeall(hilf); freeall(hilf1); freeall(hilf2);
}

INT conj_cl_Sa_wr_Sb(a,b,d,h) OP a,b,d,h;
{
INT i;
OP f=callocobject();
OP c=callocobject();
makevectorofpart(a,f);
makevectorof_kranztypus(b,S_V_L(f),c);
m_il_v(S_V_LI(c),h);
for (i=0L;i<S_V_LI(c);i++) 
{
  kranztypus_to_matrix(S_V_I(c,i),S_V_I(h,i)); 
}
sort(h);
m_il_v(S_V_LI(h),d);
for (i=0L;i<S_V_LI(h);i++) 
{
  typusorder(S_V_I(h,i),a,b,S_V_I(d,i),f); 
}
freeall(f); freeall(c);
}

t_kranz_exponentiation(a,m,b)
OP a,m,b;
/* a ist ein Repr. eines Kranzproduktes S_m wr S_n vom Typ KRANZ
   b wird eine PERMUTATION von m^n 
   man beachte: n=S_P_L(s_kr_g(a))   */
{
INT i;
OP n;
OP hilf=callocobject();
OP vek=callocobject();
OP vek1=callocobject();
OP perm1=callocobject();
n=S_P_L(s_kr_g(a));
hoch(m,n,hilf);
m_il_p(s_i_i(hilf),b);
m_i_i(1L,hilf);
for (i=0L;i<S_P_LI(b);++i,inc(hilf))
{
  v_v_nu(hilf,m,n,vek);
  operate_perm_vector(s_kr_g(a),vek,vek1);
  nu_v_v(vek1,m,S_P_I(b,i));
}
for (i=0L;i<S_V_LI(s_kr_v(a));++i)
{
  if (!emptyp(s_kr_i(a,i)))
  {
    t_VECTOR_ZYKEL(s_kr_i(a,i),perm1); /* Achtung ",i" neu eingefuegt */
    permutiere_in_der_i_zeile(m,n,i,perm1,b);
  } 
}
freeall(hilf); freeall(vek); freeall(vek1); freeall(perm1);
}

permutiere_in_der_i_zeile(a,n,i,perm,erg)
OP a,n,perm,erg;
INT i;
/* Darstellung  von Sa wr Sn
   i\in {0,...,n-1}
   perm ist PERMUTATION von {1,...,a} vom Typ ZYKEL
   diese induziert eine PERMUTATION erg auf {1,...,a^n}
*/
{
OP hilf=callocobject();
OP erg1=callocobject();
INT j,k;
/*printf("perm ");println(perm);*/
hoch(a,n,hilf);
/*first_permutation(hilf,erg);*/
copy(erg,erg1);
j=0L;
/*println(erg);
println(perm);
println(S_P_L(perm));*/
while (j<S_P_LI(perm))
{
  k=S_P_II(perm,j);
/*printf("K %d\n",k);
printf("%d\n",j);*/
  while ((++j<S_P_LI(perm))&& (k<S_P_II(perm,j)))
  {
/*printf(" innen %d\n",j);*/
    vertausche1(a,n,k,S_P_II(perm,j),i,erg,erg1);
/*println(erg1);*/
    copy(erg1,erg);
  }
}
freeall(erg1); freeall(hilf);
}

class_rep_kranz1(f,a,b)
OP a,b,f;
/* a ist MATRIX Darstellung einer Konjugiertenklasse in S_m wr S_n
   b ist ein Repraesentant vom Typ KRANZ  
   f ist ein VECTOR, der die einzelnen Partitionen von m beinhaltet */
{
OP typ=callocobject();
OP typ1=callocobject();
INT i,j,k,l;
init_kranz(b);
m_l_nv(S_M_H(a),typ);
m_l_v(S_M_H(a),s_kr_v(b));
k=0L;
for (j=0L;j<S_M_HI(a);++j)
{
  for (i=0L;i<S_M_LI(a);++i)
  {
    if (!nullp(S_M_IJ(a,j,i)))
    {
      add_apply(S_M_IJ(a,j,i),S_V_I(typ,j));
      for (l=1L;l<=S_M_IJI(a,j,i);++l)
      {
	m_part_perm(S_V_I(f,i),s_kr_i(b,k));
	k=k+j+1L;
      }
    }
  }
}
m_ks_pa(EXPONENT,typ,typ1),
m_part_perm(typ1,s_kr_g(b));
freeall(typ); freeall(typ1);
}

class_rep_kranz11(f,a,b)
OP a,b,f;
/* a ist MATRIX Darstellung einer Konjugiertenklasse in S_m wr S_n
   b ist ein Repraesentant vom Typ KRANZ  
   f ist ein VECTOR, der die einzelnen Partitionen von m beinhaltet */
{
OP typ=callocobject();
OP typ1=callocobject();
OP eins=callocobject();
INT i,j,k,l,m;
first_permutation(S_M_L(a),eins);
init_kranz(b);
m_l_nv(S_M_H(a),typ);
m_l_v(S_M_H(a),s_kr_v(b));
k=0L;
for (j=0L;j<S_M_HI(a);++j)
{
  for (i=0L;i<S_M_LI(a);++i)
  {
    if (!nullp(S_M_IJ(a,j,i)))
    {
      add_apply(S_M_IJ(a,j,i),S_V_I(typ,j));
      for (l=1L;l<=S_M_IJI(a,j,i);++l)
      {
	m_part_perm(S_V_I(f,i),s_kr_i(b,k));
	for (m=1L;(m<j+1L);++m) copy(eins,s_kr_i(b,k+m));
	k=k+j+1L;
      }
    }
  }
}
m_ks_pa(EXPONENT,typ,typ1),
m_part_perm(typ1,s_kr_g(b));
freeall(typ); freeall(typ1); freeall(eins);
}