Anforderungen  |   Konzepte  |   Entwurf  |   Entwicklung  |   Qualitätssicherung  |   Lebenszyklus  |   Steuerung
 
 
 
 


SSL crystGcomplex.gi   Sprache: unbekannt

 

##########################################################################
#0
#F  CrystGcomplex
##  Input: A set F of crystallographic matrices, a G-full basis B and 
##         check=1  (check is for future use of implementation of Bredon
##                                                            homology)
##         
##  Output: G-equivariant CW-space for group G generated by F. 
##             
##
InstallGlobalFunction(CrystGcomplex,
function(gens,basis,check)
local i,x,k,combin,n,j,r,m,vect,c,
    B,G,T,S,Bt,Action,Sign,FinalBoundary,BoundaryList,
    L,kcells,cells,w,StabGrp,ActionRecord,lnth,PseudoRotSubGroup,
    RotSubGroupList,
    Dimension,SearchOrbit,pos,StabilizerOfPoint,PseudoBoundary,
    RotSubGroup,
    Elts,Boundary,Stabilizer,DVF,DVFRec,Homotopy,rmult,FinalHomotopy,
    BB,Bool,vol,cent,orb,VOL,trns,tmp,u,v,indx;
    
    B:=basis[1];
    c:=basis[2];
    BB:=basis[3];
    vect:=c-Sum(B)/2;

    vect:=0*vect;

    G:=AffineCrystGroup(gens);
    if not IsStandardAffineCrystGroup(G) then 
    Print("Warning: G is not a standard affine space group.\n");
    fi;
    T:=TranslationSubGroup(G);
    Bt:=T!.TranslationBasis;
    S:=RightTransversal(G,T);
    n:=DimensionOfMatrixGroup(G)-1;
    Elts:=[One(G)];
    Append(Elts,gens);
    lnth:=1000;

#########################################ADDED OCTOBER 2024 
vol:=List(B,b->b*b);
vol:=Product(vol);
vol:=Sqrt(vol);
VOL:=AbsoluteValue(Determinant(BB));
cent:=Sum(B)*(1/2);
orb:=OrbitStabilizerInUnitCubeOnRight(G,VectorModOne(cent)).orbit;
Bool:=Length(orb)*vol=VOL;
if Bool then 

trns:=[0*vect];
else
indx:=List([1..Length(B)],j->Sqrt( (BB[j]*BB[j])/(B[j]*B[j]) )  );
indx:=indx-1;
indx:=List(indx,a->[0..a]);
indx:=Cartesian(indx);
trns:=[];
for x in indx do
   v:=0*vect;
   for i in [1..Length(x)] do
      v:=v + x[i]*B[i];
   od;
   Add(trns,v);
od;
trns:=SSortedList(trns);

fi;
#########################################ADDITION DONE


    if check=1 then    # B is the G-full basis

        L:=[];
        for k in [0..n] do
            L[k+1]:=[];

            ###   list all centers of k-cells

            kcells:=[];
            combin:=Combinations([1..n],k);
            for x in combin do
                w:=[];
                for i in [1..n] do
                    if i in x then
                    Add(w,[1/2]);
                    else Add(w,[0,1]);
                    fi;
                od;
                cells:=Cartesian(w);
                Append(kcells,cells*B+vect);
            od;

######################################Added October 2024
tmp:=[];
for u in kcells do
for v in trns do
Add(tmp, u+v);
od;
od;
kcells:=tmp;
######################################Addition done

            
            ###  search for k-orbits 
            Add(L[k+1],kcells[1]);
            for i in [2..Length(kcells)] do
                r:=0;
                for j in [1..Length(L[k+1])] do
                    if IsList(IsCrystSameOrbit(G,Bt,S,
                                       kcells[i],L[k+1][j])) then
                    break;
                    fi;
                    r:=r+1;
                od;
                if r=Length(L[k+1]) then Add(L[k+1],kcells[i]);fi;
            od;
        od;


# Cubical subdividing the fundamental region:
# slice the fundamental cell into 2^n parts to get a 
# proper action of G on R^n
    elif check=0 then   
        Apply(B,x->x/2); 
        L:=[];
        for k in [0..n] do
            L[k+1]:=[];

            ###   list all centers of k-cells

            kcells:=[];
            combin:=Combinations([1..n],k);
            for x in combin do
            w:=[];
                for i in [1..n] do
                    if i in x then
                    Add(w,[1/2,3/2]);
                    else Add(w,[0,1,2]);
                    fi;
                od;
            cells:=Cartesian(w);
            Append(kcells,cells*B+vect);
            od;


            ###  search for k-orbits 
            Add(L[k+1],kcells[1]);
            for i in [2..Length(kcells)] do
                r:=0;
                for j in [1..Length(L[k+1])] do
                    if IsList(IsCrystSameOrbit(G,Bt,S,
                                         kcells[i],L[k+1][j])) then
                        break;
                    fi;
                        r:=r+1;
                od;
                if r=Length(L[k+1]) then Add(L[k+1],kcells[i]);fi;
            od;
        od;
    else 
        Print("check is either 1 for B is G-full basis and 0 for proper action", "\n");
        return fail;
    fi;

    ###################################################################     
    #1
    #F  Dimension
    ##
    ##  Input:  An integer k    
    ##  Output: ZG-rank of C_k(X)  
    ##
    Dimension:=function(k)
        if k>n then 
            return 0;
        fi;
        return Length(L[k+1]);
    end;
    ###################################################################
    
    ###################################################################     
    #1
    #F  pos
    ##
    ##  Input:  A matrix g    
    ##  Output: If g in Elts then return the position of g, otherwise
    ##          add g to Elts and return the position.
    ##
    pos:=function(g)
    local p;
        p:=Position(Elts,g);
        if p=fail then 
            Add(Elts,g);
            return Length(Elts);
        else 
            return p;
        fi;
    end;
    ###################################################################

    ###################################################################     
    #1
    #F  SearchOrbit
    ##
    ##  Input:  A matrix g    
    ##  Output: If g in Elts then return the position of g, otherwise
    ##          add g to Elts and return the position.
    ##
    SearchOrbit:=function(g,k)
    local i,p,h;
        for i in [1..Length(L[k+1])] do
            p:=IsCrystSameOrbit(G,Bt,S,L[k+1][i],g);
            if IsList(p) then 
                h:=pos(p);
                return [i,h];
            fi;
        od;
    end;
    ###################################################################

# Create a record for the Action 
    ActionRecord:=[];
    for m in [1..lnth+1] do
        ActionRecord[m]:=[];
        for k in [1..Dimension(m-1)] do
            ActionRecord[m][k]:=[];
        od;
    od;


    ###################################################################     
    #1
    #F  rmult
    ##
    ##  Input:  A list L, degree k, position g of an element    
    ##  Output: Product of g and L by the action on right.
    ##
    rmult:=function(L,k,g)
    local x,w,t,h,y,vv;
        vv:=[];
        for x in [1..Length(L)] do
            w:=Elts[L[x][2]]*Elts[g];
            L[x][1]:=Sign(k,L[x][1],pos(w))*L[x][1];
            w:=CanonicalRightCosetElement(StabGrp[k+1]
                                             [AbsInt(L[x][1])],w);
            t:=pos(w);
            Add(vv,[Sign(k,L[x][1],t)*L[x][1],t]);
        od;
        return vv;
    end;
    ################################################################### 

    ###################################################################     
    #1
    #F  Action
    ##
    ##  Input:  Degree m, position k of a generator and position g of 
    ##          an element.                
    ##  Output: 1 or -1.
    ##
    Action:=function(m,k,g)
    local id,r,u,H,abk,ans,x,h,l,i;

        abk:=AbsInt(k);

        if not IsBound(ActionRecord[m+1][abk][g]) then 
            H:=StabGrp[m+1][abk];

            if Order(H)=infinity then
            
            # We are assuming that any infinite stabilizer 
            # group acts trivially.    
        
                ActionRecord[m+1][abk][g]:=1;
            else
                id:=CanonicalRightCosetElement(H,Identity(H));
                r:=CanonicalRightCosetElement(H,Elts[g]^-1);
                r:=id^-1*r;
                u:=r*Elts[g];

                if u in RotSubGroupList[m+1][abk] then  
                    ans:= 1;
                else 
                    ans:= -1; 
                fi;

                ActionRecord[m+1][abk][g]:=ans;
            fi;
        fi;
        return ActionRecord[m+1][abk][g];
    end;
    ###################################################################
    
    ###################################################################     
    #1
    #F  Action
    ##
    ##  Input:  Degree m, position k of a generator and position g of 
    ##          an element.                
    ##  Output: 1 or -1.
    ##
    PseudoBoundary:=function(k,s)
    local f,x,bdry,i,Fnt,Bck,j,ss;
        ss:=AbsInt(s);
        f:=L[k+1][ss];
        if k=0 then return [];fi;
        #x:=f*B^-1;
        x:=(f-vect)*B^-1;
        bdry:=[];
        j:=0;
        for i in [1..n] do
            Fnt:=StructuralCopy(x);
            Bck:=StructuralCopy(x);
            if not IsInt(x[i]) then
                j:=j+1;
                Fnt[i]:=Fnt[i]-1/2;
                Bck[i]:=Bck[i]+1/2;
                #Fnt:=Fnt*B;
                #Bck:=Bck*B;

                Fnt:=Fnt*B+vect;
                Bck:=Bck*B+vect;
                Append(bdry,[SearchOrbit(Fnt,k-1),SearchOrbit(Bck,k-1)]);
                #Append(bdry,[SearchOrbit(Fnt,k-1),SearchOrbit(Bck,k-1)]);
            fi;
        od;
        return bdry;
    end;
    ###################################################################
    
    ###################################################################     
    #1
    #F  Sign
    ##
    ##  Input:  Degree m, position k of a generator and position g of 
    ##          an element.                
    ##  Output: 1 or -1.
    ##
    Sign:=function(m,k,g)
    local x,h,p,r,c,i,y,f,s,kk,e,B1,B2,w;
    
        kk:=AbsInt(k);
        if m=0 then return 1;fi;
        h:=Elts[g];
        p:=CrystFinitePartOfMatrix(h);
        e:=L[m+1][kk];
        #x:=e*B^-1;
        x:=e*B^-1;
        r:=[];
        for i in [1..Length(x)] do
            if not IsInt(x[i]) then
                Add(r,i);
            fi;
        od;
        B1:=B{r};
        B1:=B1*p;
        e:=Flat(e);
        Add(e,1);
        f:=e*h;
        Remove(f);
        y:=f*B^-1;
        c:=[];
        for i in [1..Length(y)] do
            if not IsInt(y[i]) then
                Add(c,i);
            fi;
        od;

        B2:=B{c};
        s:=[];
        for i in [1..Length(B2)] do
            Add(s,SolutionMat(B1,B2[i]));
        od;
        #Print(s);
        return SignInt(Determinant(s));
    end;
    ###################################################################
    
    ###################################################################     
    #1
    #F  Boundary
    ##
    ##  Input:  degree k and position s of a generator. 
    ##                         
    ##  Output: the boundary d(k,s).
    ##    
    Boundary:=function(k,s)
    local psbdry,j,w,bdry;
    
        psbdry:=PseudoBoundary(k,s);
        bdry:=[];
        for j in [1..Length(psbdry)] do
            w:=psbdry[j];
            if (j mod 4 = 3) or (j mod 4 = 2) then
                #if IsEvenInt(j) then
                Add(bdry,Negate([Sign(k-1,w[1],w[2])*w[1],w[2]]));
            else 
                Add(bdry,[Sign(k-1,w[1],w[2])*w[1],w[2]]);
            fi;
        od;


        if s<0 then 
            return NegateWord(bdry);
        else
            return bdry;
        fi;
    end;
    ###################################################################

    # Create a list of boundary     
    BoundaryList:=[];
    for i in [1..n] do
        BoundaryList[i]:=[];
        for j in [1..Dimension(i)] do
            BoundaryList[i][j]:=Boundary(i,j);
        od;
    od;
    ###################################################################
 
    ###################################################################     
    #1
    #F  FinalBoundary
    ##
    ##  Input:  degree n and position k of a generator. 
    ##                         
    ##  Output: the boundary d(k,s).
    ## 
    FinalBoundary:=function(n,k)
    if k>0 then 
        return BoundaryList[n][k];
    else 
        return NegateWord(BoundaryList[n][AbsInt(k)]);
    fi;
    end;
    ###################################################################

    ###################################################################     
    #1
    #F  StabilizerOfPoint
    ##
    ##  Input:  a point g in R^n. 
    ##                         
    ##  Output: The stabilizer subgroup of g.
    ## 
    StabilizerOfPoint:=function(g)
    local H,stbgens,i,h,p;
    #return OrbitStabilizerInUnitCubeOnRight(G,VectorModOne(g)).stabilizer;
        g:=Flat(g);
        Add(g,1);
        stbgens:=[];
        for i in [1..Length(S)] do
            h:=g*S[i]-g;
            Remove(h);
            p:=h*Bt^-1;
            if IsIntList(p) then Add(stbgens,S[i]*
                                       VectorToCrystMatrix(h)^-1);fi;
        od;
        H:=Group(stbgens);
        return H;
    end;
    ###################################################################
    
    ###################################################################
    # Create a empty list for containing the stabilizer subgroup
    StabGrp:=[];
    for i in [1..(n+1)] do
        StabGrp[i]:=[];
        for j in [1..Length(L[i])] do
            StabGrp[i][j]:=StabilizerOfPoint(L[i][j]);
        od;
    od;
    ###################################################################

    ###################################################################     
    #1
    #F  Stabilizer
    ##
    ##  Input:  degree m and position k of a generator (the k-th m-cell). 
    ##                         
    ##  Output: The stabilizer subgroup for the above cell.
    ## 
    Stabilizer:=function(m,k)
        local kk;
        kk:=AbsInt(k);
        return StabGrp[m+1][k];
    end;
    ###################################################################
    
    ###################################################################     
    #1
    #F  PseudoRotSubGroup
    ##
    ##  Input:  degree m and position k of a generator (the k-th m-cell). 
    ##                         
    ##  Output: The rotation subgroup of the above cell.
    ##
    PseudoRotSubGroup:=function(m,k)
    local x,kk,l,h,i,w,r,y,H,id,eltsH,g,RotSbGrp;
        kk:=AbsInt(k);
        RotSbGrp:=[];
        H:=StabGrp[m+1][k];
        eltsH:=Elements(H);

        for g in eltsH do
            if Sign(m,k,pos(g))=1 then 
                Add(RotSbGrp,g);
            fi;
        od;
        RotSubGroupList[m+1][kk]:=Group(RotSbGrp);
        return Group(RotSbGrp);
    end;
    ###################################################################
    
    ################################################################### 
    # Create an empty list for containing the rotation subgroups
    RotSubGroupList:=[];
    for i in [1..(n+1)] do
        RotSubGroupList[i]:=[];
        for j in [1..Length(L[i])] do
            RotSubGroupList[i][j]:=PseudoRotSubGroup(i-1,j);
        od;
    od;
    ###################################################################

    ###################################################################     
    #1
    #F  RotSubGroup
    ##
    ##  Input:  degree m and position k of a generator (the k-th m-cell). 
    ##                         
    ##  Output: The rotation subgroup of the above cell.
    ##    
    RotSubGroup:=function(m,k)
    local kk;
        kk:=AbsInt(k);
        return RotSubGroupList[m+1][kk];
    end;
    ###################################################################

    ###################################################################
    # Create a record for discrete vector field
    DVFRec:=[];
    for k in [1..n+1] do
        DVFRec[k]:=[];
        for i in [1..Length(L[k])] do
            DVFRec[k][i]:=[];
        od;
    od;    
    ###################################################################
    
    if check=1 then
            
        ###################################################################     
        #1
        #F  DVF
        ##
        ##  input an n-cell acts like the starting point of an arrow
        ##  the function returns n+1-cell acts like the end 
        ##  point of the above arrow
        ##  those cells presented by its center.
        ##
        ##  Input:  an n-cell. 
        ##                         
        ##  Output: n+1-cell.
        ##        
        DVF:=function(k,w)    
        local 
            f,x,g,i,y,ww,s,b,j;
            ww:=[AbsInt(w[1]),w[2]];
            if not IsBound(DVFRec[k+1][ww[1]][ww[2]]) then
                x:=StructuralCopy(L[k+1][ww[1]]);
                Add(x,1);
                x:=x*Elts[ww[2]];
                Remove(x);
                f:=(x-vect)*B^-1;
                for i in [1..n] do
                    if not f[i]=0 then
                        if not IsInt(f[i]) then 
                            DVFRec[k+1][ww[1]][ww[2]]:=[];
                            return DVFRec[k+1][ww[1]][ww[2]];
                        else 
                            s:=SignInt(f[i]);
                            f[i]:=f[i]-s*1/2;
                            x:=f*B;
                            y:=SearchOrbit(x,k+1);
                            y[2]:=pos(CanonicalRightCosetElement
                                       (StabGrp[k+2][y[1]],Elts[y[2]]));

                            DVFRec[k+1][ww[1]][ww[2]]:=y;
                            return DVFRec[k+1][ww[1]][ww[2]];
                        fi;
                    fi;
                od;
                DVFRec[k+1][ww[1]][ww[2]]:=[];
                return DVFRec[k+1][ww[1]][ww[2]];
            else
                return DVFRec[k+1][ww[1]][ww[2]];
            fi;
        end;
        ###################################################################

        ###################################################################     
        #1
        #F  Homotopy
        ##
        ##  Input:  Degree k and a word w. 
        ##                         
        ##  Output: The homotopy h(k,w).
        ##
        Homotopy:=function(k,w)
        local 
            h,d,x,y,i,ww,b,p1,p2,s1,s2,v,s,p,t,a,u;

            if w=[] then return [];fi;
            a:=Sign(AbsInt(k),w[1],w[2]);
            d:=[];
            w[2]:=pos(CanonicalRightCosetElement(StabGrp[k+1][AbsInt(w[1])],
                                                                Elts[w[2]]));
            w[1]:=a*Sign(k,w[1],w[2])*w[1];
            ww:=[AbsInt(w[1]),w[2]];
            h:=StructuralCopy(DVF(k,ww));
            if h=[] then 
                return [];
            fi;

            x:=PseudoBoundary(k+1,h[1]);
            u:=List(x,v->[v[1],Elts[v[2]]*Elts[h[2]]]);
            u:=List(u,v->[v[1],pos(CanonicalRightCosetElement
                                (StabGrp[k+1][AbsInt(v[1])],v[2]))]);
            p:=Position(u,ww);
            s:=1;;
            b:=StructuralCopy(FinalBoundary(k+1,h[1]));
            b:=rmult(b,k,h[2]);
            c:=StructuralCopy(b);
            t:=SignInt(b[p][1]);
            Remove(c,p);
            Add(d,h);
            for i in [1..Length(c)] do
                Append(d,NegateWord(Homotopy(k,c[i])));
            od;

            if w[1]*t<0 then 
                return NegateWord(d);
            else
                return d;
            fi;
        end;
        ###############################################################

    else 
        DVF:=fail;
        Homotopy:=fail;
    fi;

    ###################################################################
    return Objectify(HapNonFreeResolution,
            rec(
            dimension:=Dimension,
            boundary:=FinalBoundary,
        PseudoBoundary:=PseudoBoundary,
        dvf:=DVF,
        CellList:=L,
        Sign:=Sign,
            homotopy:=Homotopy,
            elts:=Elts,
            group:=G,
            stabilizer:=Stabilizer,
            action:=Action,
        RotSubGroup:=RotSubGroup,
        Bool:=Bool,      #####ADDED OCTOBER 2024
            properties:=
            [["length",100],
             ["characteristic",0],
             ["type","resolution"]]  ));

end);
################### end of CrystGcomplex  ############################





##########################################################################
#0
#F  ResolutionCubicalCrystGroup
##  Input:  A crystallographic group G and an positive integer n
##         
##  Output: The first n+1 terms of a free ZG-resolution of Z.
##             
##
InstallGlobalFunction(ResolutionCubicalCrystGroup,
function(GG,n)
local G,gens,B,C,R,Gram, pos, Homotopy,Cnew;
 
    G:=StandardAffineCrystGroup(GG); #Added October 2024. Ideally we 
                                     #should modify code so that this 
                                     #conversion is avoided.
    Gram:=GramianOfAverageScalarProductFromFiniteMatrixGroup(
                                                    PointGroup(G));
    if Gram=IdentityMat(DimensionOfMatrixGroup(PointGroup(G))) then
        gens:=GeneratorsOfGroup(G);
        G:=AffineCrystGroup(gens);
        B:=CrystGFullBasis(G);
        if IsList(B) then
            C:=CrystGcomplex(gens,B,1);
            Cnew:=CrystGcomplex(gens,B,1);
            Apply(Cnew!.elts,x->x^-1);

            pos:=function(L,g)
            local p;
                p:=Position(L,g);
                if p=fail then 
                    Add(L,g);
                    return Length(L);
                else 
                    return p;
                fi;
            end;

            Homotopy:=function(n,w)
            local p,h;
                p:=pos(C!.elts,Cnew!.elts[w[2]]^-1);
                h:=StructuralCopy(C!.homotopy(n,[w[1],p]));
                Apply(h,x->[x[1],pos(Cnew!.elts,C!.elts[x[2]]^-1)]);
                return h;
            end;

            Cnew!.homotopy:=Homotopy;
            R:=FreeZGResolution(Cnew,n);
            R!.Bool:=C!.Bool; #Added October 2024
            return R;
        else 
            return fail;
        fi;
    else 
        Print("Gramian matrix is not identity \n");
        return fail;
    fi;
end);
################### end of ResolutionCubicalCrystGroup ###################





##########################################################################
#0
#F  TensorWithComplexRepresentationRing
##  Input:  
##         
##  Output: 
##             
##
InstallGlobalFunction(TensorWithComplexRepresentationRing,
function(C)
local StabIrrTable,i,j,N,
      Dimension,PairToTriple,BoundaryMatrix,Boundary,
      TripleToPair,StabGrp,BoundaryRec,PartialBoundaryMatrix;

    StabGrp:=[];
    i:=0;
    while C!.dimension(i)>0 do
        StabGrp[i+1]:=[];
        for j in [1..C!.dimension(i)] do
        Add(StabGrp[i+1],C!.stabilizer(i,j));
        od;
        i:=i+1;
    od;

    StabIrrTable:=[];
    i:=0;
    while C!.dimension(i)>0 do
        StabIrrTable[i+1]:=[];
        for j in [1..C!.dimension(i)] do
        Add(StabIrrTable[i+1],OrdinaryCharacterTable(StabGrp[i+1][j]));
        od;
        i:=i+1;
    od;
    N:=i-1;

    Dimension:=function(k)
    local d,i;
        d:=0;
        for i in [1..C!.dimension(k)] do
            d:=d+Size(Irr(StabIrrTable[k+1][i]));
        od;
        return d;
    end;

    PairToTriple:=function(i,j)
    local k,x;
        k:=j;
        x:=1;
        while k>Size(Irr(StabIrrTable[i+1][x])) do
            k:=k-Size(Irr(StabIrrTable[i+1][x]));
            x:=x+1;
        od;
        return [i,x,k];
        end;

    TripleToPair:=function(i,j,k)
    local d,x;
        d:=0;
        for x in [1..(j-1)] do
            d:=d+Size(Irr(StabIrrTable[i+1][x]));
        od;
        d:=d+k;
        return [i,d];
    end;

    PartialBoundaryMatrix:=function(n,k)
    local bdry,x,Coeffs,Mat,W,A,B,i,xx,irrA,perm,tbA,tbB,c,M,ccA,ccB,ccBA;
        bdry:=C!.boundary(n,k);
        Mat:=[];
        for i in [1..Length(bdry)] do
            x:=bdry[i][1];
            xx:=AbsInt(x);
            B:=StabGrp[n+1][k];

            A:=ConjugateGroup(B,C!.elts[bdry[i][2]]);
            tbA:=OrdinaryCharacterTable(A);
            tbB:=OrdinaryCharacterTable(B);
            ccB:=tbB!.ConjugacyClasses;
            ccA:=tbA!.ConjugacyClasses; 
            ccBA:=List(ccB,w->(Representative(w)^C!.elts[bdry[i][2]])^A);
            c:=List(ccBA,w->Position(ccA,w));
            M:=TransposedMat(List([1..Size(ccA)],w->TransposedMat(Irr(A))[c[w]]));
            perm:=TransformingPermutations(M,Irr(B));
             irrA:=Permuted(List(Irr(A),x->Permuted(x,perm.columns)),perm.rows);
             Coeffs:=MatScalarProducts(Irr(StabIrrTable[n][xx]),InducedClassFunctions(irrA,StabGrp[n][xx]));   
            Add(Mat,[SignInt(x),xx,Coeffs]);
        od;
        return Mat;
    end;

    BoundaryRec:=[];
    for i in [1..N] do
        BoundaryRec[i]:=[];
        for j in [1..C!.dimension(i)] do
        Add(BoundaryRec[i],PartialBoundaryMatrix(i,j));
#        Print([i,j],BoundaryRec[i][j],"\n");
        od;
    od;

    Boundary:=function(n,k)
    local w,x,y,i,j,b,d;
        b:=[];
        for i in [1..Dimension(n-1)] do
            Add(b,0);
        od;
        w:=PairToTriple(n,k);
#Print("w=",w,"\n");
        x:=StructuralCopy(BoundaryRec[n][w[2]]);
        y:=List(x,a->[a[1],a[2],a[3][w[3]]]);
#Print("y=",y,"\n");
        for i in [1..Length(y)] do
            for j in [1..Length(y[i][3])] do
                if not y[i][3][j]=0 then
#Print("[n-1,y[i][2],j]",[n-1,y[i][2],j],"\n");
                    d:=TripleToPair(n-1,y[i][2],j)[2];
                    b[d]:=b[d]+y[i][1]*y[i][3][j];
                    #Add(b,[y[i][1]*TripleToPair(n-1,y[i][2],j)[2],y[i][3][j]]);
                fi;
            od;
        od;
        #b:=AlgebraicReduction(b);
        return b;
    end;
    
    return Objectify(HapChainComplex,
                rec(
                #elts:=C!.elts,
                dimension:=Dimension,
                boundarymatrix:=PartialBoundaryMatrix,
                boundary:=Boundary,
                #homotopy:=fail,
                #group:=Integers,
                properties:=
                [["length",N],
                 ["characteristic",0],
                 ["type","chainComplex"]]  ));
end);
################### end of TensorWithComplexRepresentationRing ############################


###########################################################################################
#0
#F  TensorWithBurnsideRing
##  Input:  
##         
##  Output: 
##             
##
InstallGlobalFunction(TensorWithBurnsideRing,
function(C)
local StabConjClss,i,j,N,
      Dimension,PairToTriple,BoundaryMatrix,Boundary,
      TripleToPair,StabGrp,BoundaryRec,PartialBoundaryMatrix;

    StabGrp:=[];
    i:=0;
    while C!.dimension(i)>0 do
        StabGrp[i+1]:=[];
        for j in [1..C!.dimension(i)] do
        Add(StabGrp[i+1],C!.stabilizer(i,j));
        od;
        i:=i+1;
    od;

    StabConjClss:=[];
    i:=0;
    while C!.dimension(i)>0 do
        StabConjClss[i+1]:=[];
        for j in [1..C!.dimension(i)] do
        Add(StabConjClss[i+1],ConjugacyClassesSubgroups(StabGrp[i+1][j]));
        od;
        i:=i+1;
    od;
    N:=i-1;

    Dimension:=function(k)
    local d,i;
        d:=0;
        for i in [1..C!.dimension(k)] do
            d:=d+Size(StabConjClss[k+1][i]);
        od;
        return d;
    end;

    PairToTriple:=function(i,j)
    local k,x;
        k:=j;
        x:=1;
        while k>Size(StabConjClss[i+1][x]) do
            k:=k-Size(StabConjClss[i+1][x]);
            x:=x+1;
        od;
        return [i,x,k];
        end;

    TripleToPair:=function(i,j,k)
    local d,x;
        d:=0;
        for x in [1..(j-1)] do
            d:=d+Size(StabConjClss[i+1][x]);
        od;
        d:=d+k;
        return [i,d];
    end;

    PartialBoundaryMatrix:=function(n,k)
    local bdry,x,Coeffs,Mat,A,i,xx,L,j,B,ccB,ccA;
        bdry:=C!.boundary(n,k);
        Mat:=[];
        for i in [1..Length(bdry)] do
            x:=bdry[i][1];
            xx:=AbsInt(x);
            B:=StabGrp[n+1][k];
            A:=ConjugateGroup(B,C!.elts[bdry[i][2]]);
            ccB:=ConjugacyClassesSubgroups(B);
            ccA:=List(ccB,w->(Representative(w)^C!.elts[bdry[i][2]])^A);

            L:=List(ccA,w->PositionsProperty(StabConjClss[n][xx],c->Representative(w) in c));
            Coeffs:=[];
            for j in [1..Length(L)] do
                Coeffs[j]:=[];
                for i in [1..Length(StabConjClss[n][xx])] do
                    if i in L[j] then Coeffs[j][i]:=1;
                    else Coeffs[j][i]:=0;
                    fi;
                od;  
            od;   
            Add(Mat,[SignInt(x),xx,Coeffs]);
        od;
        return Mat;
    end;

    BoundaryRec:=[];
    for i in [1..N] do
        BoundaryRec[i]:=[];
        for j in [1..C!.dimension(i)] do
        Add(BoundaryRec[i],PartialBoundaryMatrix(i,j));
#        Print([i,j],BoundaryRec[i][j],"\n");
        od;
    od;

    Boundary:=function(n,k)
    local w,x,y,i,j,b,d;
        b:=[];
        for i in [1..Dimension(n-1)] do
            Add(b,0);
        od;
        w:=PairToTriple(n,k);
        x:=StructuralCopy(BoundaryRec[n][w[2]]);
        y:=List(x,a->[a[1],a[2],a[3][w[3]]]);
        for i in [1..Length(y)] do
            for j in [1..Length(y[i][3])] do
                if not y[i][3][j]=0 then
                    d:=TripleToPair(n-1,y[i][2],j)[2];
                    b[d]:=b[d]+y[i][1]*y[i][3][j];
                    #Add(b,[y[i][1]*TripleToPair(n-1,y[i][2],j)[2],y[i][3][j]]);
                fi;
            od;
        od;
        #b:=AlgebraicReduction(b);
        return b;
    end;
    
    return Objectify(HapChainComplex,
                rec(
                #elts:=C!.elts,
                classes:=StabConjClss,
                dimension:=Dimension,
                boundarymatrix:=PartialBoundaryMatrix,
                boundary:=Boundary,
                #homotopy:=fail,
                #group:=Integers,
                properties:=
                [["length",N],
                 ["characteristic",0],
                 ["type","chainComplex"]]  ));
end);
################### end of TensorWithBurnsideRing ############################



[ 0.46Quellennavigators  Projekt   ]

                                                                                                                                                                                                                                                                                                                                                                                                     


Neuigkeiten

     Aktuelles
     Motto des Tages

Software

     Produkte
     Quellcodebibliothek

Aktivitäten

     Artikel über Sicherheit
     Anleitung zur Aktivierung von SSL

Muße

     Gedichte
     Musik
     Bilder

Jenseits des Üblichen ....

Besucherstatistik

Besucherstatistik

Monitoring

Montastic status badge