Quelle  automenu   Sprache: unbekannt

//Read in a presentation
//load keepcount;
//read alg, "Input filename";
gapout:="gap"*alg;
ALG:=Open(alg,"r");
s:=Gets(ALG);
n:=#s;
s:="#"*Substring(s,3,n-3);
fprintf gapout, "%o\n",s;
fprintf gapout, "Append( LIE_DATA[7], [\n";
s:=Gets(ALG);
while not IsEof(s) do
if #s eq 0 then continue; end if;

count:=count+1;
countstr:="7."*IntegerToString(count);
n:=#s;
//s:=Substring(s,1,n-1)*"\"";
//print s;
t:=Split(s,">");
s:=t[1]*">";
liepres:="\""*s*"\"";
comments:=t[2];
t:=Split(s,"|");
t1:=Split(t[1],",");
ndgen:=#t1;
t1:=Split(t[2],",");
numrel:=#t1-1;
rels:=[];
for i in [1..numrel] do
  rels[i]:=trim(t1[i]);
end for;
t1:=Split(t1[numrel+1],"=");
class:=StringToInteger(t1[2][1]);

wt:=[];
for i in [1..ndgen] do
wt[i]:=1;
end for;
lastg:=ndgen;
cc:=1;
clend:=[];
clend[1]:=ndgen;
comms:=[];

for mainloop in [1..class-1] do
//get cover

//get number of tails
tails:=ndgen*(ndgen-1);
tails:= tails div 2;
tails:=tails+(lastg-ndgen)*ndgen;
tails:=tails+ndgen;

olastg:=lastg;
nlastg:=tails+lastg;

//add in trivial commutators and powers of weight cc+1
v:=[P!0:i in [1..lastg]];
if cc eq 1 then
  i1:=1;
else;
  i1:=clend[cc-1]+1;
end if;
for i in [i1..lastg] do
   comms[i]:=[];
   powers[i]:=v;
end for;
for i in [2..lastg] do
   for j in [1..i-1] do
      if wt[i]+wt[j] eq cc+1 then
         comms[i][j]:=v;
      end if;
   end for;
end for;

//extend powers
for i in [1..lastg] do
for k in [olastg+1..nlastg] do
  powers[i][k]:=P!0;
end for;
end for;

a:=cc;
hold:=[];
while a gt 0 do
if a eq 1 then
  j1:=2;
else;
  j1:=clend[a-1]+1;
end if;
j2:=clend[a];
for j in [j1..j2] do
for i in [1..ndgen] do
if j gt i then
//extend comms[j][i]
for k in [olastg+1..nlastg] do
  comms[j][i][k]:=P!0;
end for;
//add tail to [j,i], provided it is not a definition
//and provided j is not a power
def:=0;
for k in [ndgen+1..lastg] do
if defns[k] eq [j,i] then
   def:=1;
   break;
end if;
end for;
if def eq 0 then
   //check whether j is a power
   if wt[j] gt 1 and defns[j][1] eq 0 then
     k:=#hold;
     hold[k+1]:=[j,i];
   else;
     lastg:=lastg+1;
     wt[lastg]:=cc+1;
     comms[j][i][lastg]:=P!1;
     defns[lastg]:=[j,i];
   end if;
end if;
end if;
end for;
end for;

//now add in tails to powers
if a eq 1 then
  j1:=1;
else;
  j1:=clend[a-1]+1;
end if;
j2:=clend[a];
for j in [j1..j2] do
  //add tail to powers[j], provided it is not a definition
  def:=0;
  for k in [ndgen+1..lastg] do
  if defns[k] eq [0,j] then
     def:=1;
     break;
  end if;
  end for;
  if def eq 0 then
    lastg:=lastg+1;
    wt[lastg]:=cc+1;
    powers[j][lastg]:=P!1;
    defns[lastg]:=[0,j];
  end if;
end for;

if a eq cc then
   firspg:=lastg+1;
end if;
a:=a-1;
end while;

//now add in commutators stored in hold
for k in [1..#hold] do
  j:=hold[k][1];
  i:=hold[k][2];
  lastg:=lastg+1;
  wt[lastg]:=cc+1;
  comms[j][i][lastg]:=P!1;
  defns[lastg]:=[j,i];
end for;

cc:=cc+1;
clend[cc]:=lastg;
if lastg ne nlastg then
  print "Arghhh!";
end if;


if cc ge 4 then
//Compute non-left-normed commutators
for i in [ndgen+1..clend[cc-2]] do
if 2*wt[i] le cc then
b:=defns[i][1];
a:=defns[i][2];
//i=[b,a] if b ne 0, otherwise i = pa
for j in [i+1..clend[cc-2]] do
if wt[i]+wt[j] le cc then

if b ne 0 then
//set [j,i]=[j,b,a]-[j,a,b]
v1:=[P!0:m in [1..lastg]];
//get [j,b,a]
m1:=clend[wt[j]+wt[b]-1]+1;
m2:=clend[cc-wt[a]];
for m in [m1..m2] do
  g:=comms[j][b][m];
  if g ne 0 then
    v:=comms[m][a];
    for n in [m1..lastg] do
      v1[n]:=v1[n]+g*v[n];
    end for;
  end if;
end for;
//get [j,a,b]
m1:=clend[wt[j]+wt[a]-1]+1;
m2:=clend[cc-wt[b]];
for m in [m1..m2] do
  g:=comms[j][a][m];
  if g ne 0 then
    v:=comms[m][b];
    for n in [m1..lastg] do
      v1[n]:=v1[n]-g*v[n];
    end for;
  end if;
end for;
comms[j][i]:=v1;

else;
//set [j,i] = p[j,a]
v1:=[P!0:m in [1..lastg]];
for m in [1..clend[cc-1]] do
  c:=comms[j][a][m];
  if c ne 0 then
    for n in [1..lastg] do
      v1[n]:=v1[n]+c*powers[m][n];
    end for;
  end if;
end for;
comms[j][i]:=v1;
end if;
//comms[j][i] computed

end if;
end for;
end if;
end for;
end if;


//Enforce defining relations
numrel:=#rels;
if numrel gt 0 then
for i in [1..numrel] do
v1:=[P!0:i in [1..lastg]];
s:=rels[i];
while s ne "" do
a:=split(s);
s:=a[4];
factor:=getpol(P,a[1]);
exp:=StringToInteger(a[2]);
t:=a[3];
g:=StringToCode(t[1])-96;
v2:=[P!0:j in [1..lastg]];
v2[g]:=P!1;
for j in [2..#t] do
  //commute v2 with rest of entries
  g:=StringToCode(t[j])-96;
  v3:=[P!0:i in [1..lastg]];
  for k in [1..clend[cc-1]] do
    //commute v2 with g
    c:=v2[k];
    if c ne 0 then
      h:=comms[k][g];
      for l in [1..lastg] do
        v3[l]:=v3[l]+c*h[l];
      end for;
    end if;
  end for;
  v2:=v3;
end for;
//now get appropriate power p^exp*v2
if exp gt 0 then
for j in [1..exp] do
  v3:=[P!0:k in [1..lastg]];
  for k in [1..clend[cc-1]] do
    c:=v2[k];
    if c ne 0 then
      for l in [1..lastg] do
        v3[l]:=v3[l]+c*powers[k][l];      
      end for;
    end if;
  end for;
  v2:=v3;
end for;
end if;
//this completes calculati0on of p^exp*v2

//add factor*v2 to v1
for k in [1..lastg] do
  v1[k]:=v1[k]+factor*v2[k];
end for;

end while;

//enforce relation
b:=0;
for a in [1..lastg] do
  if v1[a] ne 0 then
    b:=a;
  end if;
end for;

if b gt 0 then
  m:=b;
  if v1[b] ne 1 and v1[b] ne -1 then
  for a in [1..b-1] do
    if v1[a] ne 0 then
      printf "%m^%m + ",a,v1[a];
    end if;
  end for;
  printf "%m^%m\n",b,v1[b];
  print "Do you want to use this relation to eliminate a generator",b;
  readi m,"Enter 0 for NO, or i for YES -- generator i";
  end if;
  if m gt 0 then
    if m gt lastg or v1[m] eq 0 then
      print "tricky!";
    else;
      v27:=v1[m];
      v27:=v27^-1;
      for a in [2..clend[cc-1]] do
      for b in [1..a-1] do
      if wt[a]+wt[b] le cc then
        v:=comms[a][b];
        g:=v[m];
        if g ne 0 then
          c:=g*v27;
          for n in [1..lastg] do
            v[n]:=v[n]-c*v1[n];
          end for;
        end if;
        for n in [m..lastg-1] do
          v[n]:=v[n+1];
        end for;
        comms[a][b]:=[];
        for n in [1..lastg-1] do
          comms[a][b][n]:=v[n];
        end for;
      end if;
      end for;
      end for;

      for a in [1..clend[cc-1]] do
        v:=powers[a];
        g:=v[m];
        if g ne 0 then
          c:=g*v27;
          for n in [1..lastg] do
            v[n]:=v[n]-c*v1[n];
          end for;
        end if;
        for n in [m..lastg-1] do
          v[n]:=v[n+1];
        end for;
        powers[a]:=[];
        for n in [1..lastg-1] do
          powers[a][n]:=v[n];
        end for;
      end for;

      lastg:=lastg-1;
      if m lt firspg then
        firspg:=firspg-1;
      end if;
      defn2:=[];
      for n in [clend[1]+1..lastg] do
        defn2[n]:=defns[n];
        if n ge m then
          defn2[n]:=defns[n+1];
        end if;
      end for;
      defns:=defn2;
    end if;
    clend[cc]:=lastg;
    end if;
end if;

//end of relation code
end for;
end if;



if cc ge 3 then
//Jacobi
for i in [1..ndgen] do
for j in [i+1..clend[cc-2]-1] do
for k in [j+1..clend[cc-2]] do
if wt[i]+wt[j]+wt[k] le cc then
v1:=[];
for m in [1..lastg] do
v1[m]:=P!0;
end for;
//do Jacobi (k,j,i)
//get [k,j,i]
m1:=clend[wt[k]+wt[j]-1]+1;
m2:=clend[cc-wt[i]];
for m in [m1..m2] do
  g:=comms[k][j][m];
  if g ne 0 then
    v:=comms[m][i];
    for n in [m1..lastg] do
      v1[n]:=v1[n]+g*v[n];
    end for;
  end if;
end for;
//get [j,i,k]
m1:=clend[wt[j]+wt[i]-1]+1;
m2:=clend[cc-wt[k]];
for m in [m1..m2] do
  g:=comms[j][i][m];
  if g ne 0 then
    if m gt k then
      v:=comms[m][k];
      for n in [m1..lastg] do
        v1[n]:=v1[n]+g*v[n];
      end for;
    end if;
    if m lt k then
      v:=comms[k][m];
      for n in [m1..lastg] do
        v1[n]:=v1[n]-g*v[n];
      end for;
    end if;
  end if;
end for;
//get [i,k,j]
m1:=clend[wt[i]+wt[k]-1]+1;
m2:=clend[cc-wt[j]];
for m in [m1..m2] do
  g:=comms[k][i][m];
  if g ne 0 then
    v:=comms[m][j];
    for n in [m1..lastg] do
      v1[n]:=v1[n]-g*v[n];
    end for;
  end if;
end for;
// check if zero
b:=0;
for a in [1..lastg] do
if v1[a] ne 0 then
  b:=a;
end if;
end for;

if b gt 0 then
  m:=b;
  if v1[b] ne 1 and v1[b] ne -1 then
  for a in [1..b-1] do
    if v1[a] ne 0 then
      printf "%m^%m + ",a,v1[a];
    end if;
  end for;
  printf "%m^%m\n",b,v1[b];
  print "Do you want to use this Jacobi to eliminate a generator",b;
  readi m,"Enter 0 for NO, or i for YES -- generator i";
  end if;
  if m gt 0 then
    if m gt lastg or v1[m] eq 0 then
      print "tricky!";
    else;
      v27:=v1[m];
      v27:=v27^-1;
      for a in [2..clend[cc-1]] do
      for b in [1..a-1] do
      if wt[a]+wt[b] le cc then
        v:=comms[a][b];
        g:=v[m];
        if g ne 0 then
          c:=g*v27;
          for n in [1..lastg] do
            v[n]:=v[n]-c*v1[n];
          end for;
        end if;
        for n in [m..lastg-1] do
          v[n]:=v[n+1];
        end for;
        comms[a][b]:=[];
        for n in [1..lastg-1] do
          comms[a][b][n]:=v[n];
        end for;
      end if;
      end for;
      end for;

      for a in [1..clend[cc-1]] do
        v:=powers[a];
        g:=v[m];
        if g ne 0 then
          c:=g*v27;
          for n in [1..lastg] do
            v[n]:=v[n]-c*v1[n];
          end for;
        end if;
        for n in [m..lastg-1] do
          v[n]:=v[n+1];
        end for;
        powers[a]:=[];
        for n in [1..lastg-1] do
          powers[a][n]:=v[n];
        end for;
      end for;

      lastg:=lastg-1;
      if m lt firspg then
        firspg:=firspg-1;
      end if;
      defn2:=[];
      for n in [clend[1]+1..lastg] do
        defn2[n]:=defns[n];
        if n ge m then
          defn2[n]:=defns[n+1];
        end if;
      end for;
      defns:=defn2;
    end if;
    clend[cc]:=lastg;
  end if;
end if;
end if;
end for;
end for;
end for;

//Check [pa,a]=0
for i in [1..clend[cc-2]] do
if 2*wt[i]+1 le cc then
  v1:=[P!0:j in [1..lastg]];
  for j in [i+1..clend[cc-wt[i]]] do
    c:=powers[i][j];
    if c ne 0 then
      //add c*[j,i] to v
      for k in [i+1..lastg] do
        v1[k]:=v1[k]+c*comms[j][i][k];
      end for; 
    end if;
  end for;
// check if zero
b:=0;
for a in [1..lastg] do
if v1[a] ne 0 then
  b:=a;
end if;
end for;
if b gt 0 then
  m:=b;
  if v1[b] ne 1 and v1[b] ne -1 then
  printf "[p%m,%m]",i,i;
  for a in [1..b-1] do
    if v1[a] ne 0 then
      printf "%m^%m + ",a,v1[a];
    end if;
  end for;
  printf "%m^%m\n",b,v1[b];
  print "Do you want to use this Jacobi to eliminate a generator",b;
  readi m,"Enter 0 for NO, or i for YES -- generator i";
  end if;
  if m gt 0 then
    if m gt lastg or v1[m] eq 0 then
      print "tricky!";
    else;
      v27:=v1[m];
      v27:=v27^-1;
      for a in [2..clend[cc-1]] do
      for b in [1..a-1] do
      if wt[a]+wt[b] le cc then
        v:=comms[a][b];
        g:=v[m];
        if g ne 0 then
          c:=g*v27;
          for n in [1..lastg] do
            v[n]:=v[n]-c*v1[n];
          end for;
        end if;
        for n in [m..lastg-1] do
          v[n]:=v[n+1];
        end for;
        comms[a][b]:=[];
        for n in [1..lastg-1] do
          comms[a][b][n]:=v[n];
        end for;
      end if;
      end for;
      end for;

      for a in [1..clend[cc-1]] do
        v:=powers[a];
        g:=v[m];
        if g ne 0 then
          c:=g*v27;
          for n in [1..lastg] do
            v[n]:=v[n]-c*v1[n];
          end for;
        end if;
        for n in [m..lastg-1] do
          v[n]:=v[n+1];
        end for;
        powers[a]:=[];
        for n in [1..lastg-1] do
          powers[a][n]:=v[n];
        end for;
      end for;

      lastg:=lastg-1;
      if m lt firspg then
        firspg:=firspg-1;
      end if;
      defn2:=[];
      for n in [clend[1]+1..lastg] do
        defn2[n]:=defns[n];
        if n ge m then
          defn2[n]:=defns[n+1];
        end if;
      end for;
      defns:=defn2;
    end if;
    clend[cc]:=lastg;
  end if;
end if;

end if;
end for;

//Check [pb,a]=[b,pa]
for i in [1..clend[cc-2]-1] do
for j in [i+1..clend[cc-2]] do
if wt[i]+wt[j]+1 le cc then
  v1:=[P!0:k in [1..lastg]];
  //set v1=[pj,i]
  for k in [j+1..clend[cc-wt[i]]] do
    c:=powers[j][k];
    if c ne 0 then
      for l in [j+1..lastg] do
        v1[l]:=v1[l]+c*comms[k][i][l];
      end for;
    end if;
  end for;
  //Add [pi,j] to v1
  for k in [i+1..clend[cc-wt[j]]] do
    c:=powers[i][k];
    if c ne 0 and k ne j then
      if k gt j then
        v2:=comms[k][j];
      else;
        v2:=comms[j][k];
        c:=-c;
      end if;
      for l in [j+1..lastg] do
        v1[l]:=v1[l]+c*v2[l];
      end for;
    end if;
  end for;

// check if zero
b:=0;
for a in [1..lastg] do
if v1[a] ne 0 then
  b:=a;
end if;
end for;
if b gt 0 then
  m:=b;
  if v1[b] ne 1 and v1[b] ne -1 then
  printf "[p%m,%m]=[%m,p%m]",j,i,j,i;
  for a in [1..b-1] do
    if v1[a] ne 0 then
      printf "%m^%m + ",a,v1[a];
    end if;
  end for;
  printf "%m^%m\n",b,v1[b];
  print "Do you want to use this Jacobi to eliminate a generator",b;
  readi m,"Enter 0 for NO, or i for YES -- generator i";
  end if;
  if m gt 0 then
    if m gt lastg or v1[m] eq 0 then
      print "tricky!";
    else;
      v27:=v1[m];
      v27:=v27^-1;
      for a in [2..clend[cc-1]] do
      for b in [1..a-1] do
      if wt[a]+wt[b] le cc then
        v:=comms[a][b];
        g:=v[m];
        if g ne 0 then
          c:=g*v27;
          for n in [1..lastg] do
            v[n]:=v[n]-c*v1[n];
          end for;
        end if;
        for n in [m..lastg-1] do
          v[n]:=v[n+1];
        end for;
        comms[a][b]:=[];
        for n in [1..lastg-1] do
          comms[a][b][n]:=v[n];
        end for;
      end if;
      end for;
      end for;

      for a in [1..clend[cc-1]] do
        v:=powers[a];
        g:=v[m];
        if g ne 0 then
          c:=g*v27;
          for n in [1..lastg] do
            v[n]:=v[n]-c*v1[n];
          end for;
        end if;
        for n in [m..lastg-1] do
          v[n]:=v[n+1];
        end for;
        powers[a]:=[];
        for n in [1..lastg-1] do
          powers[a][n]:=v[n];
        end for;
      end for;

      lastg:=lastg-1;
      if m lt firspg then
        firspg:=firspg-1;
      end if;
      defn2:=[];
      for n in [clend[1]+1..lastg] do
        defn2[n]:=defns[n];
        if n ge m then
          defn2[n]:=defns[n+1];
        end if;
      end for;
      defns:=defn2;
    end if;
    clend[cc]:=lastg;
  end if;
end if;


end if;
end for;
end for;

//Check [pb,a]=p[b,a]
for i in [1..clend[cc-2]-1] do
for j in [i+1..clend[cc-2]] do
if wt[i]+wt[j]+1 le cc then
  v1:=[P!0:k in [1..lastg]];
  //set v1=[pj,i]
  for k in [j+1..clend[cc-wt[i]]] do
    c:=powers[j][k];
    if c ne 0 then
      for l in [j+1..lastg] do
        v1[l]:=v1[l]+c*comms[k][i][l];
      end for;
    end if;
  end for;
  //Subtract p[j,i] from v1
  for k in [1..clend[cc-1]] do
    c:=comms[j][i][k];
    if c ne 0 then
      for l in [1..lastg] do
        v1[l]:=v1[l]-c*powers[k][l];
      end for;
    end if;
  end for;

// check if zero
b:=0;
for a in [1..lastg] do
if v1[a] ne 0 then
  b:=a;
end if;
end for;
if b gt 0 then
  m:=b;
  if v1[b] ne 1 and v1[b] ne -1 then
  printf "[p%m,%m]=[%m,p%m]",j,i,j,i;
  for a in [1..b-1] do
    if v1[a] ne 0 then
      printf "%m^%m + ",a,v1[a];
    end if;
  end for;
  printf "%m^%m\n",b,v1[b];
  print "Do you want to use this Jacobi to eliminate a generator",b;
  readi m,"Enter 0 for NO, or i for YES -- generator i";
  end if;
  if m gt 0 then
    if m gt lastg or v1[m] eq 0 then
      print "tricky!";
    else;
      v27:=v1[m];
      v27:=v27^-1;
      for a in [2..clend[cc-1]] do
      for b in [1..a-1] do
      if wt[a]+wt[b] le cc then
        v:=comms[a][b];
        g:=v[m];
        if g ne 0 then
          c:=g*v27;
          for n in [1..lastg] do
            v[n]:=v[n]-c*v1[n];
          end for;
        end if;
        for n in [m..lastg-1] do
          v[n]:=v[n+1];
        end for;
        comms[a][b]:=[];
        for n in [1..lastg-1] do
          comms[a][b][n]:=v[n];
        end for;
      end if;
      end for;
      end for;

      for a in [1..clend[cc-1]] do
        v:=powers[a];
        g:=v[m];
        if g ne 0 then
          c:=g*v27;
          for n in [1..lastg] do
            v[n]:=v[n]-c*v1[n];
          end for;
        end if;
        for n in [m..lastg-1] do
          v[n]:=v[n+1];
        end for;
        powers[a]:=[];
        for n in [1..lastg-1] do
          powers[a][n]:=v[n];
        end for;
      end for;

      lastg:=lastg-1;
      if m lt firspg then
        firspg:=firspg-1;
      end if;
      defn2:=[];
      for n in [clend[1]+1..lastg] do
        defn2[n]:=defns[n];
        if n ge m then
          defn2[n]:=defns[n+1];
        end if;
      end for;
      defns:=defn2;
    end if;
    clend[cc]:=lastg;
  end if;
end if;


end if;
end for;
end for;

end if;



end for;

if lastg ne 7 then print "Arghh -- wrong order"; readi z27; end if;

fprintf gapout, "[";
fprintf gapout, "%o,%o,%o,%o,",lastg,ndgen,class,liepres;

gappcp:=[];
if cc gt 1 then
for i in [1..clend[cc-1]] do
for j in [1..i] do
c:=powers[i];
if i gt j and wt[i]+wt[j] gt cc then Append(~gappcp,[]); continue; end if;

if j lt i then c:=comms[i][j]; end if;
d:=[];
for k in [1..lastg] do
  if c[k] ne 0 then Append(~d,P!k); Append(~d,c[k]); end if;
end for;
Append(~gappcp,d);
end for;
end for;

while gappcp[#gappcp] eq [] do
  Prune(~gappcp);
end while;
end if;

if gappcp eq [] then
  fprintf gapout, "[],";
else;
  fprintf gapout, "[";
  for i in [1..#gappcp-1] do
    c:=gappcp[i];
    if c eq [] then
      fprintf gapout, "[],";
    else;
      fprintf gapout, "[";
      for j in [1..#c-1] do
        fprintf gapout, "%o,",c[j];
      end for;
      fprintf gapout, "%o],",c[#c];
    end if;
  end for;
  c:=gappcp[#gappcp];
    if c eq [] then
      fprintf gapout, "[]],";
    else;
      fprintf gapout, "[";
      for j in [1..#c-1] do
        fprintf gapout, "%o,",c[j];
      end for;
      fprintf gapout, "%o]],",c[#c];
    end if;
end if;

s:=Gets(ALG);

if not IsEof(s) then

t:=Split(comments,"()");
if #t eq 1 then fprintf gapout, ",,\"%o\"],\n", countstr; end if;
if #t eq 4 then fprintf gapout, "\"%o\",\"%o\",\"%o\"],\n",t[2],t[3],countstr; end if;
if #t eq 3 then
  if t[2][1] eq "p" then fprintf gapout, ",\"%o\",\"%o\"],\n",t[2],countstr; end if;
  if t[2][1] ne "p" then fprintf gapout, "\"%o\",,\"%o\"],\n",t[2],countstr; end if;
end if;

else;

t:=Split(comments,"()");
if #t eq 1 then fprintf gapout, ",,\"%o\"]\n", countstr; end if;
if #t eq 4 then fprintf gapout, "\"%o\",\"%o\",\"%o\"]\n",t[2],t[3],countstr; end if;
if #t eq 3 then
  if t[2][1] eq "p" then fprintf gapout, ",\"%o\",\"%o\"]\n",t[2],countstr; end if;
  if t[2][1] ne "p" then fprintf gapout, "\"%o\",,\"%o\"]\n",t[2],countstr; end if;
end if;

end if;

end while;
fprintf gapout, "]);\n";

//Write("keepcount","count:="*IntegerToString(count)*";":Overwrite:=true);