set workspace=1;
W:free(s0,s1,s2,s3);
W.relations:s0^2,s1^2,s2^2,s3^2,(s0*s2)^2,(s0*s3)^2,(s1*s3)^2,
(s0*s1)^3,(s1*s2)^4,(s2*s3)^3;
print 'Calculated Group - now starting on nonsparse elements';
H0:=<s1,s2,s3>;
H3:=<s0,s1,s2>;
KK:=H0*H3;
K:=KK;
for each g in W do
  K:=K join (KK^g);
end;
save 'w343';
print 'Calculated nonsparse elements - now starting on subgroups';

S:=subgroups(W);
I:=<identity of W>;
save 'w343';
print 'Calculated subgroups - now checking for sparseness';

A:=empty;
for j = 1 to length(S) do
  if ((<S[j]> meet K) eq I) then
    A:=append(A,S[j]);
  end;
end;
save 'w343';

print ' ';
print 'List of subgroups which would produce quotient polytopes';
print 'Also some additional information';
print 'There are',length(A),'subgroups listed.';
for j = 1 to length(A) do
  print ' ';
  print ' ';
  print 'A[',j,']',A[j];
  if invariant(W,A[j]) then
    print 'A is Normal in W, hence M/A is strongly regular';
  end;
  print 'Normaliser: (Aut(M/A) is isomorphic to N/A)';
  print normaliser(W,A[j]);
  print 'Core: (Gamma(M/A) is isomorphic to W/C)';
  print core(W,A[j]);
end;
quit;