| products/sources/formale Sprachen/Java/Netbeans/nbbuild/ (Apache JAVA IDE Version 28©) |
|
Quelle vector.gi Sprache: unbekannt |
|
|
#############################################################################
## #W vector.gi Laurent Bartholdi ## ## #Y Copyright (C) 2006, Laurent Bartholdi ## ############################################################################# ## ## This file implements the category of linear machines and elements with a ## vector space as stateset. ## ############################################################################# # Jacobian family BindGlobal("FRJFAMILY@", function(fam) local i, f; if IsListOrCollection(fam) then fam := FRMFamily(fam); elif not IsFamily(fam) then fam := FamilyObj(fam); fi; for i in FR_FAMILIES do if fam in i{[2..Length(i)]} then if IsBound(i[4]) then return i[4]; fi; f := NewFamily(Concatenation("FRElement(",String(i[1]),")"), IsFRElement and IsJacobi f!.alphabet := i[1]; if IsVectorSpace(i[1]) then # so LieObject works SetCharacteristic(f,Characteristic(i[1])); fi; f!.standard := Size(i[1])<2^28 and i[1]=[1..Size(i[1])]; if not f!.standard then f!.a2n := x->Position(Enumerator(i[1]),x); f!.n2a := x->Enumerator(i[1])[x]; fi; i[4] := f; return f; fi; od; return fail; end); InstallMethod(FREFamily, "(FR) for a jacobian linear element", [IsLinearFRElement and IsJacobianElement], function(E) local i, fam; fam := FamilyObj(E); for i in FR_FAMILIES do if IsBound(i[4]) and fam=i[4] then return i[3]; fi; od; return FREFamily(AlphabetOfFRObject(E)); end); ############################################################################ ## #M Minimized . . . . . . . . . . . . . . . . . . . .minimize linear machine ## # mode=0 means normal # mode=1 means all states are known to be accessible # mode=2 means all states are known to be distinct and accessible # boolean corr=true means compute correspondence ## BindGlobal("MATRIX@", function(l,f) return List(l,__x->List(__x,f)); end); BindGlobal("VECTORZEROM@", function(f,n,r) return VectorMachineNC(f,MATRIX@(IdentityMat(n),x->IdentityMat(0,r)),IdentityMat(0 end); BindGlobal("VECTORZEROE@", function(f,n,r) return VectorElementNC(f,MATRIX@(IdentityMat(n),x->IdentityMat(0,r)),IdentityMat(0 end); BindGlobal("COEFF@", function(B,v) local x; x := Coefficients(B,v); ConvertToVectorRep(x); MakeImmutable(x); return x; end); BindGlobal("CONSTANTVECTOR@", function(S,x) local v; v := ListWithIdenticalEntries(Length(S),x); ConvertToVectorRep(v); return v; end); BindGlobal("VECTORMINIMIZE@", function(fam,r,transitions,output,input,mode,docorr local B, i, n, v, V, W, t, m, todo, f, corr; if input<>fail then ConvertToVectorRep(input); fi; ConvertToVectorRep(output); for i in transitions do for i in i do ConvertToMatrixRep(i); od; od; if docorr then corr := IdentityMat(Length(output),r); MakeImmutable(corr); fi; if input<>fail and mode=0 and Length(output)>0 then todo := NewFIFO([input]); V := Subspace(r^Length(output),[]); for v in todo do if not v in V then V := ClosureLeftModule(V,v); for i in transitions do for i in i do Add(todo,v*i); od; od; fi; od; if Dimension(V)<Length(input) then B := Basis(V); input := COEFF@(B,input); v := transitions; transitions := []; for i in v do t := []; for i in i do m := List(B,x->COEFF@(B,x*i)); MakeImmutable(m); ConvertToMatrixRep(m); Add(t,m); od; Add(transitions,t); od; if docorr then corr := List(corr,v->COEFF@(B,v)); MakeImmutable(corr); ConvertToMatrixRep(corr); Error("cannot happen"); fi; if B=[] then output := []; else output := B*output; ConvertToVectorRep(output); MakeImmutable(output); fi; fi; fi; if Length(output)=0 or IsZero(output) then if input=fail then f := VECTORZEROM@(fam,Length(transitions),r); else f := VECTORZEROE@(fam,Length(transitions),r); fi; if docorr then SetCorrespondence(f,[]); fi; return f; fi; if mode<=1 then todo := NewFIFO([output]); W := r^Length(output); V := Subspace(W,[]); for v in todo do if not v in V then V := ClosureLeftModule(V,v); for i in transitions do for i in i do Add(todo,i*v); od; od; fi; od; if Dimension(V)<Length(output) then f := AsList(Basis(V)); ConvertToMatrixRep(f); f := NaturalHomomorphismBySubspace(W,Subspace(W,NullspaceMat(TransposedMat(f)))); B := Basis(Range(f)); W := List(B,x->PreImagesRepresentativeNC(f,x)); ConvertToMatrixRep(W); if input <> fail then input := COEFF@(B,input^f); fi; v := transitions; transitions := []; for i in v do t := []; for i in i do m := List(W,x->COEFF@(B,(x*i)^f)); MakeImmutable(m); ConvertToMatrixRep(m); Add(t,m); od; Add(transitions,t); od; if docorr then corr := List(corr,v->COEFF@(B,v^f)); MakeImmutable(corr); ConvertToMatrixRep(corr); fi; output := W*output; ConvertToVectorRep(output); MakeImmutable(output); fi; fi; if input=fail then f := VectorMachineNC(fam,transitions,output); else todo := [input]; V := Subspace(r^Length(output),[]); f := 1; while f <= Length(todo) do if todo[f] in V then Remove(todo,f); else V := ClosureLeftModule(V,todo[f]); for i in transitions do for i in i do Add(todo,todo[f]*i); od; od; f := f+1; fi; od; if todo<>IdentityMat(Length(output),r) then B := BasisNC(V,todo); input := COEFF@(B,input); v := transitions; transitions := []; for i in v do t := []; for i in i do m := List(B,x->COEFF@(B,x*i)); MakeImmutable(m); ConvertToMatrixRep(m); Add(t,m); od; Add(transitions,t); od; if docorr then corr := List(corr,v->COEFF@(B,v)); MakeImmutable(corr); ConvertToMatrixRep(corr); fi; output := B*output; ConvertToVectorRep(output); MakeImmutable(output); fi; f := VectorElementNC(fam,transitions,output,input); fi; if docorr then SetCorrespondence(f,corr); fi; return f; end); InstallMethod(Minimized, "(FR) for a vector machine", [IsLinearFRMachine and IsVectorFRMachineRep], M->VECTORMINIMIZE@(FamilyObj(M),LeftActingDomain(M), M!.transitions,M!.output,fail,0,true)); InstallMethod(Minimized, "(FR) for a vector element", [IsLinearFRElement and IsVectorFRMachineRep], E->VECTORMINIMIZE@(FamilyObj(E),LeftActingDomain(E), E!.transitions,E!.output,E!.input,0,true)); InstallMethod(IsMinimized, "(FR) for a vector machine", [IsLinearFRMachine and IsVectorFRMachineRep], M->Length(Minimized(M)!.transitions[1][1]=Length(M!.transitions[1][1]))); ############################################################################ InstallOtherMethod(KroneckerProduct, "generic method for nested lists", [IsObject, IsObject, IsInt], function(l1,l2,level) local i1, i2, row, kroneckerproduct; if level=0 then return l1 * l2; elif level=1 then kroneckerproduct := []; for i1 in l1 do Append(kroneckerproduct,i1*l2); od; ConvertToVectorRepNC(kroneckerproduct); else kroneckerproduct := []; for i1 in l1 do for i2 in l2 do Add(kroneckerproduct,KroneckerProduct(i1,i2,level-1)); od; od; fi; return kroneckerproduct; end); ############################################################################# ## #O LeftActingDomain ## InstallOtherMethod(LeftActingDomain, "(FR) for a linear machine", [IsLinearFRMachine], M->LeftActingDomain(AlphabetOfFRObject(M))); InstallOtherMethod(LeftActingDomain, "(FR) for a linear element", [IsLinearFRElement], E->LeftActingDomain(AlphabetOfFRObject(E))); ############################################################################ ############################################################################ ## #O Output(<Machine>, <State>) #O Transition(<Machine>, <State>, <Input>, <Output>) #O Transitions(<Machine>, <State>, <Input>) ## InstallMethod(InitialState, "(FR) for a vector element", [IsLinearFRElement and IsVectorFRMachineRep], E->E!.input); InstallMethod(Output, "(FR) for a vector machine", [IsLinearFRMachine and IsVectorFRMachineRep,IsVector], function(M,s) return s*M!.output; end); InstallMethod(Output, "(FR) for a vector element", [IsLinearFRElement and IsVectorFRMachineRep], M->M!.input*M!.output); InstallMethod(Transitions, "(FR) for a vector machine", [IsLinearFRMachine and IsVectorFRMachineRep,IsVector,IsVector], function(M,s,a) return List(a*M!.transitions,v->s*v); end); InstallMethod(Transition, "(FR) for a vector machine", [IsLinearFRMachine and IsVectorFRMachineRep,IsVector,IsVector,IsVector], function(M,s,a,b) return s*(a*M!.transitions*b); end); InstallMethod(Transitions, "(FR) for a vector element", [IsLinearFRElement and IsVectorFRMachineRep,IsVector], function(M,a) return List(a*M!.transitions,v->M!.input*v); end); InstallOtherMethod(\[\], "(FR) for a vector element and an index", [IsLinearFRElement and IsVectorFRMachineRep,IsPosInt], function(E,i) return List(E!.transitions[i],v->VECTORMINIMIZE@(FamilyObj(E),LeftActingDomain(E), end); InstallMethod(Transition, "(FR) for a vector element", [IsLinearFRElement and IsVectorFRMachineRep,IsVector,IsVector], function(M,a,b) return M!.input*(a*M!.transitions*b); end); InstallMethod(StateSet, "(FR) for a vector machine in vector rep", [IsLinearFRMachine and IsVectorFRMachineRep], M->LeftActingDomain(M)^Length(M!.output)); InstallMethod(StateSet, "(FR) for a vector element in vector rep", [IsLinearFRElement and IsVectorFRMachineRep], E->LeftActingDomain(E)^Length(E!.output)); InstallMethod(GeneratorsOfFRMachine, "(FR) for a vector machine", [IsLinearFRMachine and IsVectorFRMachineRep], M->Basis(StateSet(M))); InstallOtherMethod(\^, "(FR) for a vector and a vector element", [IsVector, IsLinearFRElement and IsVectorFRMachineRep], function(v,e) return v*MATRIX@(e!.transitions,v->e!.input*v*e!.output); end); InstallMethod(Activity, "(FR) for a vector element and a level", [IsLinearFRElement and IsVectorFRMachineRep, IsInt], function(e,n) local b, i, m; if IsZero(e) then i := Dimension(AlphabetOfFRObject(e))^n; m := NullMat(i,i,LeftActingDomain(e)); ConvertToMatrixRep(m); return m; fi; if n=0 then m := [[e!.input*e!.output]]; ConvertToMatrixRep(m); return m; fi; m := MATRIX@(e!.transitions, function(v) v := [e!.input*v]; ConvertToMatrixRep(v); return v; end); for i in [2..n] do m := KroneckerProduct(m,e!.transitions,2); od; m := MATRIX@(m,v->v[1]*e!.output); b := ValueOption("blocks"); if b=fail then ConvertToMatrixRep(m); else m := AsBlockMatrix(m,i,i); fi; if IsJacobianElement(e) then m := LieObject(m); fi; return m; end); InstallMethod(Activity, "(FR) for a linear element", [IsLinearFRElement], x->Activity(x,1)); InstallMethod(Activities, "(FR) for a vector element and a level", [IsLinearFRElement and IsVectorFRMachineRep, IsInt], function(e,n) local i, b, m, r, result; result := [[[e!.input*e!.output]]]; m := e!.transitions; b := ValueOption("blocks"); for i in [2..n] do r := MATRIX@(m,v->e!.input*v*e!.output); if b=fail then ConvertToMatrixRep(r); else r := AsBlockMatrix(r,b,b); fi; if IsJacobianElement(e) then r := LieObject(r); fi; Add(result,r); if i<>n then m := KroneckerProduct(m,e!.transitions,2); fi; od; return result; end); ACTIVITYSPARSE@ := fail; # shut up warning ACTIVITYSPARSE@ := function(l,e,v,n,x,y) local d, p, i, j; if IsZero(v) then return; fi; if n=0 then d := v*e!.output; if not IsZero(d) then p := PositionSorted(l,[[x,y]]); if IsBound(l[p]) and l[p][1]=[x,y] then l[p][2] := l[p][2] + d; else Add(l,[[x,y],d],p); fi; fi; else d := Length(e!.transitions); for i in [1..d] do for j in [1..d] do ACTIVITYSPARSE@(l,e,v*e!.transitions[i][j],n-1,(x-1)*d+i,(y-1)*d+j); od; od; fi; end; MakeReadOnlyGlobal("ACTIVITYSPARSE@"); InstallMethod(ActivitySparse, "(FR) for a vector element and a level", [IsLinearFRElement and IsVectorFRMachineRep, IsInt], function(e,n) local l; l := []; ACTIVITYSPARSE@(l,e,e!.input,n,1,1); return l; end); InstallOtherMethod(State, "(FR) for a vector element and two vectors", [IsLinearFRElement and IsVectorFRMachineRep, IsVector, IsVector], function(E,a,b) return VECTORMINIMIZE@(FamilyObj(E),LeftActingDomain(E),E!.transitions,E!.output, end); InstallOtherMethod(NestedMatrixState, "(FR) for a vector element and two lists", [IsLinearFRElement and IsVectorFRMachineRep, IsList, IsList], function(E,ilist,jlist) local x, n; x := E!.input; for n in [1..Length(ilist)] do x := x*E!.transitions[ilist[n]][jlist[n]]; od; return VECTORMINIMIZE@(FamilyObj(E),LeftActingDomain(E),E!.transitions,E!.output, end); InstallOtherMethod(NestedMatrixCoefficient, "(FR) for a vector element and two lists", [IsLinearFRElement and IsVectorFRMachineRep, IsList, IsList], function(E,ilist,jlist) local x, n; x := E!.input; for n in [1..Length(ilist)] do x := x*E!.transitions[ilist[n]][jlist[n]]; od; return x*E!.output; end); InstallMethod(DecompositionOfFRElement, "(FR) for a vector element", [IsLinearFRElement and IsVectorFRMachineRep], function(E) return MATRIX@(E!.transitions,v->VECTORMINIMIZE@(FamilyObj(E),LeftActingDomain(E), end); InstallMethod(DecompositionOfFRElement, "(FR) for a vector element and a level", [IsLinearFRElement, IsInt], function(E,n) local d, m, i, j; if n=0 then return [[E]]; fi; d := Dimension(AlphabetOfFRObject(E)); E := DecompositionOfFRElement(E,n-1); m := []; for i in [1..Length(E)] do for j in [1..Length(E)] do m{[1..d]+(i-1)*d}{[1..d]+(j-1)*d} := DecompositionOfFRElement(E[i][j]); od; od; return m; end); InstallMethod(IsConvergent, "(FR) for a vector element", [IsLinearFRElement], E->DecompositionOfFRElement(E)[1][1]=E); InstallMethod(States, "(FR) for a vector element", [IsLinearFRElement and IsVectorFRMachineRep], E->VectorSpace(LeftActingDomain(E), List(Basis(StateSet(E)),s->FRElement(E,s)))); InstallOtherMethod(States, "(FR) for a vector machine", [IsLinearFRMachine and IsVectorFRMachineRep], M->VectorSpace(LeftActingDomain(M), List(Basis(StateSet(M)),s->FRElement(M,s)))); BindGlobal("DECOMPMATRIX@", function(m,d,n) local result, N, i, j, k; result := List([1..d],i->List([1..d],j->[])); for k in [2..n] do N := d^(k-2); for i in [1..d] do for j in [1..d] do Add(result[i][j],m[k]{[(i-1)*N+1..i*N]}{[(j-1)*N+1..j*N]}); od; od; od; return result; end); BindGlobal("GUESSMATRIX@", function(r,matlist,d) local spaces, bases, trans, inp, out, i, ii, j, jj, k, m, n, todo, c, x; n := Length(matlist); if n<=1 then return fail; fi; if IsZero(matlist[n]) then return VECTORZEROE@(FREFamily(r^d),d,r); fi; spaces := []; bases := []; for i in [1..n] do c := [Flat(matlist{[1..i]})]; Add(spaces,VectorSpace(r,c)); Add(bases,Basis(spaces[i],c)); od; trans := List([1..d],i->List([1..d],j->[])); out := []; inp := []; todo := [matlist]; for m in todo do Add(out,m[1][1][1]); if inp=[] then Add(inp,One(r)); else Add(inp,Zero(r)); fi; n := Length(m)-1; m := DECOMPMATRIX@(m,d,n+1); if spaces[n]=fail then return fail; fi; for i in [1..d] do for j in [1..d] do x := Flat(m[i][j]); c := Coefficients(bases[n],x); if c=fail then Add(todo,m[i][j]); for ii in [1..d] do for jj in [1..d] do for k in trans[ii][jj] do Add(k,Zero(r)); od; od; od; for k in [1..n] do c := Flat(m[i][j]{[1..k]}); if spaces[k]=fail or c in spaces[k] then spaces[k] := fail; else spaces[k] := ClosureLeftModule(spaces[k],c); bases[k] := Basis(spaces[k],Concatenation(bases[k],[c])); fi; od; c := Coefficients(bases[n],x); fi; Add(trans[i][j],c); od; od; od; return VectorElement(r,trans,out,inp); end); InstallGlobalFunction(GuessVectorElement, # "(FR) for a matrix[list], ring, degree", function(arg) local n, r, d, matlist, i; for i in arg do if IsInt(i) then if IsBound(d) then Error("Degree specified twice"); fi; d := i; elif IsList(i) then if IsBound(matlist) then Error("Matrix specified twice"); fi; matlist := i; elif IsRing(i) then if IsBound(r) then Error("Ring specified twice"); fi; r := i; fi; od; if not IsBound(matlist) then Error("Matrix not specified"); fi; if IsMatrix(matlist) then if not IsBound(d) then d := PrimePowersInt(Length(matlist)); n := Gcd(d{[2,4..Length(d)]}); d := RootInt(Length(matlist),n); Info(InfoFR,2,"I guess the matrix dimension is ",d,"^",n); else n := LogInt(Length(matlist),d); if Length(matlist)<>d^n then Error("Matrix dimension must be d^n for some n"); fi; fi; matlist := List([0..n],i->matlist{[1..d^i]}{[1..d^i]}); else n := Length(matlist); if not IsBound(d) then if n>1 then d := Length(matlist[2]); else d := 0; fi; fi; if not ForAll([1..n],i->IsMatrix(matlist[i]) and Length(matlist[i][1])=d^(i-1)) then Error("<matlist> should be a list of matrices of size 1,d,d^2,...,d^n"); fi; fi; if not IsBound(r) then r := FieldOfMatrixList(matlist); fi; return GUESSMATRIX@(r,matlist,d); end); InstallMethod(TransposedFRElement, "(FR) for a vector element", [IsLinearFRElement and IsVectorFRMachineRep], function(E) return VECTORMINIMIZE@(FamilyObj(E),LeftActingDomain(E), TransposedMat(E!.transitions),E!.output,E!.input,2,false); end); BindGlobal("ISTRIANGULARVECTOR@", function(e,prop) local V, x, n, v, w, i, j, todo; V := TrivialSubspace(StateSet(e)); n := Length(e!.transitions); todo := NewFIFO([e!.input]); for v in todo do if not v in V then V := ClosureLeftModule(V,v); for i in [1..n] do for j in [1..n] do w := v*e!.transitions[i][j]; if i<j and prop in [IsDiagonalFRElement,IsLowerTriangularFRElement] and not IsZero(w) then return false; elif i>j and prop in [IsDiagonalFRElement,IsUpperTriangularFRElement] and not IsZero(w) th return false; elif i=j then Add(todo,w); fi; od; od; fi; od; return true; end); InstallMethod(IsSymmetricFRElement, "(FR) for a linear element", [IsLinearFRElement], E->E=TransposedFRElement(E)); InstallMethod(IsAntisymmetricFRElement, "(FR) for a linear element", [IsLinearFRElement], E->E=-TransposedFRElement(E)); InstallMethod(IsLowerTriangularFRElement, "(FR) for a vector element", [IsLinearFRElement and IsVectorFRMachineRep], E->ISTRIANGULARVECTOR@(E,IsLowerTriangularFRElement)); InstallMethod(IsUpperTriangularFRElement, "(FR) for a vector element", [IsLinearFRElement and IsVectorFRMachineRep], E->ISTRIANGULARVECTOR@(E,IsUpperTriangularFRElement)); InstallMethod(IsDiagonalFRElement, "(FR) for a vector element", [IsLinearFRElement and IsVectorFRMachineRep], E->ISTRIANGULARVECTOR@(E,IsDiagonalFRElement)); InstallMethod(LDUDecompositionFRElement, "(FR) for an FR element", [IsLinearFRElement], function(A) local F, L, D, U, gL, gD, gU, s, n; F := LeftActingDomain(A); L := []; D := []; U := []; n := 0; while true do s := SemiEchelonMatTransformation(Activity(A,n)); n := n+1; Add(U,s.vectors); s := s.coeffs; Add(D,DiagonalMat(List([1..Length(s)],i->s[i][i]^-1))); Add(L,s^-1/D[n]); if n=1 then continue; fi; gL := GuessVectorElement(L,F); if gL=fail then continue; fi; gD := GuessVectorElement(D,F); if gD=fail then continue; fi; gU := GuessVectorElement(U,F); if gU=fail then continue; fi; if gL*gD*gU=A then return [gL,gD,gU]; fi; Info(InfoFR, 2, "LDUDecompositionFRElement: trying at level ",n); od; end); ############################################################################ ############################################################################ ## #O VectorMachine #O VectorElement ## BindGlobal("VECTORCHECK@", function(transitions,output,input) local m, n, i, j; if input<>fail then MakeImmutable(input); ConvertToVectorRep(input); fi; MakeImmutable(output); ConvertToVectorRep(output); n := Length(output); if input<>fail and Length(input)<>n then Error("input and output should have the same length"); fi; m := Length(transitions); for i in [1..m] do if Length(transitions[i])<>m then Error("transitions should be a square matrix"); fi; for j in transitions[i] do if Length(j)<>n or ForAny(j,x->Length(x)<>n) then Error("transitions[i,j] should be a ",n,"x",n,"-matrix"); fi; MakeImmutable(j); ConvertToMatrixRep(j); od; od; end); InstallMethod(VectorMachineNC, "(FR) for lists of transitions and output", [IsFamily,IsTransitionTensor,IsVector], function(f,transitions,output) local M; M := Objectify(NewType(f, IsLinearFRMachine and IsVectorFRMachineRep), rec(transitions := transitions, output := output)); return M; end); InstallMethod(VectorMachine, "(FR) for lists of transitions and output", [IsRing,IsTransitionTensor,IsVector], function(r,transitions,output) VECTORCHECK@(transitions,output,fail); return VectorMachineNC(FRMFamily(r^Length(transitions)), One(r)*transitions,One(r)*output); end); InstallMethod(UnderlyingFRMachine, "(FR) for a vector element", [IsLinearFRElement and IsVectorFRMachineRep], function(E) return VectorMachineNC(FRMFamily(E),E!.transitions,E!.output); end); InstallMethod(VectorElementNC, "(FR) for lists of transitions, output, input", [IsFamily,IsTransitionTensor,IsVector,IsVector], function(f,transitions,output,input) local E; E := Objectify(NewType(f, IsLinearFRElement and IsVectorFRMachineRep), rec(input := input, transitions := transitions, output := output)); return E; end); InstallMethod(VectorElement, "(FR) for lists of transitions, output and input", [IsRing,IsTransitionTensor,IsVector,IsVector], function(r,transitions,output,input) VECTORCHECK@(transitions,output,input); return VECTORMINIMIZE@(FREFamily(r^Length(transitions)),r, One(r)*transitions,One(r)*output,One(r)*input,0,false); end); InstallMethod(VectorElement, "(FR) for lists of transitions, output and input, nd a categor [IsRing,IsTransitionTensor,IsVector,IsVector,IsOperation], function(r,transitions,output,input,cat) local fam; VECTORCHECK@(transitions,output,input); if cat=IsJacobianElement then fam := FRJFAMILY@(r^Length(transitions)); else fam := FREFamily(r^Length(transitions)); fi; return VECTORMINIMIZE@(fam,r,One(r)*transitions,One(r)*output,One(r)*input,0,fals end); InstallMethod(FRElement, "(FR) for a vector machine and a state", [IsLinearFRMachine and IsVectorFRMachineRep, IsVector], function(M,s) return VECTORMINIMIZE@(FREFamily(M),LeftActingDomain(M),M!.transitions,M!.output, end); InstallMethod(FRElement, "(FR) for a vector machine, a state and a category", [IsLinearFRMachine and IsVectorFRMachineRep, IsVector, IsOperation], function(M,s,cat) local f; if cat=IsJacobianElement then f := FRJFAMILY@(M); else f := FREFamily(M); fi; return VECTORMINIMIZE@(f,LeftActingDomain(M),M!.transitions,M!.output,s,0,false); end); InstallMethod(FRElement, "(FR) for a vector element and a state", [IsLinearFRElement and IsVectorFRMachineRep, IsVector], function(E,s) return VECTORMINIMIZE@(FamilyObj(E),LeftActingDomain(E),E!.transitions,E!.output, end); InstallMethod(FRElement, "(FR) for a vector machine and a state index", [IsLinearFRMachine and IsVectorFRMachineRep, IsInt], function(M,s) if IsZero(M) then return VECTORZEROE@(FREFamily(M),Dimension(AlphabetOfFRObject(M)),LeftActingDomai fi; return VECTORMINIMIZE@(FREFamily(M),LeftActingDomain(M),M!.transitions,M!.output, end); InstallMethod(FRElement, "(FR) for a vector element and a state index", [IsLinearFRElement and IsVectorFRMachineRep, IsInt], function(E,s) if IsZero(E) then return VECTORZEROE@(FamilyObj(E),Dimension(AlphabetOfFRObject(E)),LeftActingDomai fi; return VECTORMINIMIZE@(FamilyObj(E),LeftActingDomain(E),E!.transitions,E!.output, end); InstallMethod(LieObject, "(FR) for an associative vector element", [IsLinearFRElement and IsVectorFRMachineRep and IsAssociativeElement], e->VectorElementNC(FRJFAMILY@(e),e!.transitions,e!.output,e!.input)); InstallMethod(AssociativeObject, "(FR) for a jacobian vector element", [IsLinearFRElement and IsVectorFRMachineRep and IsJacobianElement], e->VectorElementNC(FREFamily(e),e!.transitions,e!.output,e!.input)); ############################################################################# ############################################################################# ## #M ViewObj #M String #M Display ## InstallMethod(ViewString, "(FR) for a vector machine", [IsLinearFRMachine and IsVectorFRMachineRep], function(M) return CONCAT@("<Linear machine on alphabet ", LeftActingDomain(M), "^", Length(M!.transitions), " with ", Length(M!.output), "-dimensional stateset>"); end); InstallMethod(ViewString, "(FR) for a vector element", [IsLinearFRElement and IsVectorFRMachineRep], function(E) local skip, s; if IsZero(E) then s := "<Zero l"; skip := true; elif IsOne(E) then s := "<Identity l"; skip := true; else s := "<L"; skip := false; fi; Append(s,CONCAT@("inear element on alphabet ",LeftActingDomain(E),"^", Length(E!.tran if not skip then Append(s,CONCAT@(" with ",Length(E!.output), "-dimensional stateset")); fi; if IsJacobianElement(E) then Append(s,"-"); fi; Append(s,">"); return s; end); InstallMethod(String, "(FR) vector machine to string", [IsLinearFRMachine and IsVectorFRMachineRep], function(M) return CONCAT@("VectorMachine(",LeftActingDomain(M),", ", M!.transitions,", ", M!.out end); InstallMethod(String, "(FR) vector element to string", [IsLinearFRElement and IsVectorFRMachineRep], function(E) local x; if IsJacobianElement(E) then x := ",IsJacobianElement"; else x := ""; fi; return CONCAT@("VectorElement(",LeftActingDomain(E),", ", E!.transitions,", ", E!.output,", ",E!.input,x,")"); end); BindGlobal("VECTORDISPLAY@", function(M) local r, i, j, k, l, m, n, xlen, xprint, xrule, headlen, headrule, headblank, s; r := LeftActingDomain(M); n := Length(M!.transitions); m := Length(M!.output); if IsFFECollection(r) and DegreeOverPrimeField(r)=1 then xlen := LogInt(Characteristic(r),10)+2; xprint := function(x) if IsZero(x) then return String(".",xlen-1); else return String(IntF else xlen := Maximum(List(Flat(M!.transitions),x->Length(String(x))))+1; xprint := x->String(x,xlen-1); fi; xrule := ListWithIdenticalEntries(xlen,'-'); headlen := Length(String(r))+1; headrule := ListWithIdenticalEntries(headlen,'-'); headblank := ListWithIdenticalEntries(headlen,' '); s := Concatenation(String(r,headlen)," |"); for i in [1..n] do APPEND@(s,String(i,QuoInt(xlen*m,2)+1),String("",xlen*m-QuoInt(xlen*m,2)),"|"); od; Append(s,"\n"); APPEND@(s,headrule,"-+"); for i in [1..n] do for j in [1..m] do Append(s,xrule); od; Append(s,"-+"); od; Append(s,"\n"); for i in [1..n] do APPEND@(s,String(i,headlen)," "); if m>=1 then APPEND@(s,"|"); for j in [1..m] do if j>1 then APPEND@(s,headblank," |"); fi; for k in [1..n] do for l in [1..m] do APPEND@(s," ",xprint(M!.transitions[i][k][j][l])); od; APPEND@(s," |"); od; APPEND@(s,"\n"); od; APPEND@(s,headrule,"-"); fi; APPEND@(s,"+"); for i in [1..n] do for j in [1..m] do APPEND@(s,xrule); od; APPEND@(s,"-+"); od; APPEND@(s,"\n"); od; APPEND@(s,"Output:"); for i in [1..m] do APPEND@(s," ",xprint(M!.output[i])); od; APPEND@(s,"\n"); if IsLinearFRElement(M) then if IsJacobianElement(M) then APPEND@(s,"Jacobian; "); fi; APPEND@(s,"Initial state:"); for i in [1..m] do APPEND@(s," ",xprint(M!.input[i])); od; APPEND@(s,"\n"); fi; return s; end); InstallMethod(DisplayString, "(FR) for a vector machine", [IsLinearFRMachine and IsVectorFRMachineRep], VECTORDISPLAY@); InstallMethod(DisplayString, "(FR) for a vector element", [IsLinearFRElement and IsVectorFRMachineRep], VECTORDISPLAY@); ############################################################################# ############################################################################# ## #M AsVectorMachine #M AsVectorElement ## BindGlobal("DELTA@", function(x) if x then return 1; else return 0; fi; end); BindGlobal("ASVECTORMACHINE@", function(r,M) local id, V; id := IdentityMat(Size(StateSet(M)),r); V := VectorMachineNC(FRMFamily(r^Size(AlphabetOfFRObject(M))), List(AlphabetOfFRObject(M),i->List(AlphabetOfFRObject(M),j->List(StateSet(M),s->DEL CONSTANTVECTOR@(StateSet(M),One(r))); SetCorrespondence(V,id); return V; end); InstallMethod(AsVectorMachine, "(FR) for a Mealy machine", [IsRing,IsMealyMachine and IsMealyMachineIntRep], ASVECTORMACHINE@); InstallMethod(AsVectorMachine, "(FR) for a FR machine", [IsRing,IsFRMachine], function(r,M) local N, V; Info(InfoFR,2,"AsVectorMachine: converting to Mealy machine"); N := AsMealyMachine(M); V := ASVECTORMACHINE@(r,N); V!.Correspondence := Correspondence(V){Correspondence(N)}; return V; end); InstallMethod(AsVectorMachine, "(FR) for a ss space of linear elements", [IsVectorSpace and IsFRElementCollection], function(V) local a, b, c, M; a := AlphabetOfFRObject(Representative(V)); b := Basis(V); c := List(b,DecompositionOfFRElement); M := VectorMachineNC(FamilyObj(Representative(V)),LeftActingDomain(V), List(Basis(a),i->List(Basis(a),j->List(c,x->Coefficients(b,i*x*j)))),List(b,Output) SetCorrespondence(M,V); return M; end); InstallMethod(AsLinearMachine, "(FR) for a Mealy machine", [IsRing,IsMealyMachine and IsMealyMachineIntRep], ASVECTORMACHINE@); BindGlobal("ASVECTORELEMENT@", function(r,E) local id, V; id := IdentityMat(Size(StateSet(E)),r); V := VECTORMINIMIZE@(FREFamily(r^Size(AlphabetOfFRObject(E))),r, List(AlphabetOfFRObject(E),i->List(AlphabetOfFRObject(E),j->List(StateSet(E),s->DEL CONSTANTVECTOR@(StateSet(E),One(r)), IdentityMat(Size(StateSet(E)),r)[1],0,true); return V; end); InstallMethod(AsVectorElement, "(FR) for a Mealy element", [IsRing,IsMealyElement and IsMealyMachineIntRep], ASVECTORELEMENT@); InstallMethod(AsVectorElement, "(FR) for a FR element", [IsRing,IsFRElement], function(r,E) Info(InfoFR,2,"AsVectorMachine: converting to Mealy machine"); return ASVECTORELEMENT@(r,AsMealyElement(E)); end); InstallMethod(AsLinearElement, "(FR) for a Mealy element", [IsRing,IsMealyElement and IsMealyMachineIntRep], ASVECTORELEMENT@); InstallMethod(AsMealyElement, "(FR) for a vector element", [IsLinearFRElement and IsVectorFRMachineRep], function(E) local states, trans, out, t, o, x, y, s, i; states := [E]; trans := []; out := []; for s in states do t := []; o := []; for i in DecompositionOfFRElement(s) do x := Filtered([1..Length(i)],x->not IsZero(i[x])); if Length(x)<>1 then return fail; fi; x := x[1]; Add(o,x); x := i[x]; y := Position(states,x); if y=fail then Add(states,x); Add(t,Length(states)); if RemInt(Length(states),100)=0 then Info(InfoFR,3,"AsMealyElement: at least ",Length(states)," states"); fi; else Add(t,y); fi; od; Add(trans,t); Add(out,o); od; return MealyElement(trans,out,1); end); InstallMethod(TopElement, "(FR) for a ring and a matrix", [IsRing, IsMatrix], function(r,m) if IsOne(m) then return VectorElementNC(FREFamily(r^Length(m)), One(r)*MATRIX@(m,x->[[x]]),[One(r)],[One(r)]); else return VectorElementNC(FREFamily(r^Length(m)), One(r)*(MATRIX@(m,x->[[0,x],[0,0]])+MATRIX@(m^0,x->[[0,0],[0,x]])), [One(r),One(r)],[One(r),Zero(r)]); fi; end); ############################################################################# ############################################################################ ## #M InverseOp #M OneOp #M ZeroOp ## InstallMethod(IsInvertible, "(FR) for a linear element", [IsLinearFRElement], E->InverseOp(E)<>fail); InstallMethod(InverseOp, "(FR) for a vector element", [IsLinearFRElement and IsVectorFRMachineRep], function(E) local A, n, F; n := LogInt(20,Dimension(AlphabetOfFRObject(E))); A := List(Activities(E,n),Inverse); repeat Add(A,Inverse(Activity(E,n))); if A[n+1]=fail then return fail; fi; F := GuessVectorElement(LeftActingDomain(E),A); if F<>fail and IsOne(F*E) then return F; fi; n := n+1; Info(InfoFR, 2, "InverseOp: extending to depth ",n); until false; end); InstallMethod(OneOp, "(FR) for a vector machine", [IsLinearFRMachine and IsVectorFRMachineRep], function(M) return VectorMachineNC(FamilyObj(M), MATRIX@(IdentityMat(Length(M!.transitions),LeftActingDomain(M)),x->[[x]]), [One(LeftActingDomain(M))]); end); InstallMethod(OneOp, "(FR) for a vector element", [IsLinearFRElement and IsVectorFRMachineRep], function(E) return VectorElementNC(FamilyObj(E), MATRIX@(IdentityMat(Length(E!.transitions),LeftActingDomain(E)),x->[[x]]), [One(LeftActingDomain(E))], [One(LeftActingDomain(E))]); end); InstallMethod(ZeroOp, "(FR) for a vector machine", [IsLinearFRMachine and IsVectorFRMachineRep], M->VECTORZEROM@(FamilyObj(M),Length(M!.transitions), LeftActingDomain(M))); InstallMethod(ZeroOp, "(FR) for a vector element", [IsLinearFRElement and IsVectorFRMachineRep], E->VECTORZEROE@(FamilyObj(E),Length(E!.transitions), LeftActingDomain(E))); BindGlobal("VECTORPLUS@", function(M,N) local i, j, t, x, zM, zN, transitions, output, input; if IsZero(M) then return N; fi; if IsZero(N) then return M; fi; # otherwise zM, zN are undefined transitions := []; zM := 0*M!.output; zN := 0*N!.output; for i in [1..Length(M!.transitions)] do t := []; for j in [1..Length(M!.transitions)] do x := List(M!.transitions[i][j],r->Concatenation(r,zN)); Append(x,List(N!.transitions[i][j],r->Concatenation(zM,r))); MakeImmutable(x); ConvertToMatrixRepNC(x); Add(t,x); od; Add(transitions,t); od; output := Concatenation(M!.output,N!.output); MakeImmutable(output); ConvertToVectorRepNC(output); if IsLinearFRElement(M) then input := Concatenation(M!.input,N!.input); MakeImmutable(input); ConvertToVectorRepNC(input); return VECTORMINIMIZE@(FamilyObj(M),LeftActingDomain(M), transitions,output,input,0,false); else return VectorMachineNC(FamilyObj(M),transitions,output); fi; end); InstallMethod(\+, "for two vector machines", IsIdenticalObj, [IsLinearFRMachine and IsVectorFRMachineRep, IsLinearFRMachine and IsVectorFRMachineRep], VECTORPLUS@); InstallMethod(\+, "for two vector elements", IsIdenticalObj, [IsLinearFRElement and IsVectorFRMachineRep, IsLinearFRElement and IsVectorFRMachineRep], VECTORPLUS@); InstallMethod(\*, "for a scalar and a vector machine", [IsScalar,IsLinearFRMachine and IsVectorFRMachineRep], function(x,M) if not IsRat(x) and not x in LeftActingDomain(M) then TryNextMethod(); fi; # matrix? return VectorMachineNC(FamilyObj(M),M!.transitions,x*M!.output); end); InstallMethod(\*, "for a vector machine and a scalar", [IsLinearFRMachine and IsVectorFRMachineRep,IsScalar], function(M,x) if not IsRat(x) and not x in LeftActingDomain(M) then TryNextMethod(); fi; # matrix? return VectorMachineNC(FamilyObj(M),M!.transitions,M!.output*x); end); InstallMethod(\+, "for a scalar and a vector element", [IsScalar,IsLinearFRElement and IsVectorFRMachineRep], function(x,E) if not IsRat(x) and not x in LeftActingDomain(E) then TryNextMethod(); fi; # matrix? return x*One(E)+E; end); InstallMethod(\+, "for a vector element and a scalar", [IsLinearFRElement and IsVectorFRMachineRep,IsScalar], function(E,x) if not IsRat(x) and not x in LeftActingDomain(E) then TryNextMethod(); fi; # matrix? return E+x*One(E); end); InstallMethod(AdditiveInverseSameMutability, "for a vector machine", [IsLinearFRMachine and IsVectorFRMachineRep], function(M) return VectorMachineNC(FamilyObj(M),M!.transitions,-M!.output); end); InstallMethod(AdditiveInverseSameMutability, "for a vector element", [IsLinearFRElement and IsVectorFRMachineRep], function(E) return VectorElementNC(FamilyObj(E),E!.transitions,-E!.output,E!.input); end); BindGlobal("VECTORTIMES@", function(M,N) local i, j, k, t, x, transitions, output, input; if Length(M!.output)=0 or Length(N!.output)=0 then return Zero(M); fi; transitions := []; for i in [1..Length(M!.transitions)] do t := []; for k in [1..Length(M!.transitions)] do x := Sum([1..Length(M!.transitions)],j->KroneckerProduct(M!.transitions[i][j],N!.tr Add(t,x); od; Add(transitions,t); od; output := KroneckerProduct(M!.output,N!.output,1); if IsLinearFRElement(M) then input := KroneckerProduct(M!.input,N!.input,1); MakeImmutable(input); ConvertToVectorRepNC(input); x := VECTORMINIMIZE@(FamilyObj(M),LeftActingDomain(M), transitions,output,input,0,false); else x := VectorMachineNC(FamilyObj(M),transitions,output); fi; return x; end); InstallMethod(\*, "for two vector machines", IsIdenticalObj, [IsLinearFRMachine and IsVectorFRMachineRep, IsLinearFRMachine and IsVectorFRMachineRep], VECTORTIMES@); InstallMethod(\*, "for two vector elements", IsIdenticalObj, [IsLinearFRElement and IsVectorFRMachineRep and IsAssociativeElement, IsLinearFRElement and IsVectorFRMachineRep and IsAssociativeElement], VECTORTIMES@); InstallMethod(\*, "for two vector elements", IsIdenticalObj, [IsLinearFRElement and IsVectorFRMachineRep and IsJacobianElement, IsLinearFRElement and IsVectorFRMachineRep and IsJacobianElement], function(x,y) return VECTORTIMES@(x,y)-VECTORTIMES@(y,x); end); InstallMethod(PthPowerImage, "for a vector element", [IsLinearFRElement and IsVectorFRMachineRep and IsJacobianElement], function(x) local p; p := Characteristic(LeftActingDomain(x)); if not IsPrime(p) then TryNextMethod(); fi; return LieObject(AssociativeObject(x)^p); end); InstallMethod(PthPowerImage, "for a vector element and a number", [IsLinearFRElement and IsVectorFRMachineRep and IsJacobianElement, IsInt], function(x,n) local p; p := Characteristic(LeftActingDomain(x)); if not IsPrime(p) then TryNextMethod(); fi; return LieObject(AssociativeObject(x)^(p^n)); end); InstallMethod(\*, "for a scalar and a vector element", [IsScalar,IsLinearFRElement and IsVectorFRMachineRep], function(x,E) if not IsRat(x) and not x in LeftActingDomain(E) then TryNextMethod(); fi; # matrix? return VECTORMINIMIZE@(FamilyObj(E),LeftActingDomain(E), E!.transitions,x*E!.output,E!.input,1,false); end); InstallMethod(\*, "for a vector element and a scalar", [IsLinearFRElement and IsVectorFRMachineRep,IsScalar], function(E,x) if not IsRat(x) and not x in LeftActingDomain(E) then TryNextMethod(); fi; # matrix? return VECTORMINIMIZE@(FamilyObj(E),LeftActingDomain(E), E!.transitions,E!.output*x,E!.input,1,false); end); InstallMethod(TensorProductOp, "for vector machines", [IsList, IsLinearFRMachine and IsVectorFRMachineRep], function(list,_) Error("todo"); end); ############################################################################ ############################################################################ ## #M IsOne #M IsZero #M = #M < ## InstallMethod(\=, "(FR) for two vector machines", IsIdenticalObj, [IsLinearFRMachine and IsVectorFRMachineRep, IsLinearFRMachine and IsVectorFRMachineRep], function(M,N) return M!.transitions=N!.transitions and M!.output=N!.output; end); InstallMethod(\<, "(FR) for two vector machines", IsIdenticalObj, [IsLinearFRMachine and IsVectorFRMachineRep, IsLinearFRMachine and IsVectorFRMachineRep], function(M,N) return M!.transitions<N!.transitions or (M!.transitions=N!.transitions and M!.output<N!.output); end); InstallMethod(IsOne, "(FR) for a vector machine", [IsLinearFRMachine and IsVectorFRMachineRep], function(M) local n, i, j, r; n := Length(M!.transitions); r := LeftActingDomain(M); for i in [1..n] do for j in [1..n] do if (i=j and M!.transitions[i][j]<>[[One(r)]]) or (i<>j and M!.transitions[i][j]<>[[Zero(r)]]) then return false; fi; od; od; return M!.output=[One(r)]; end); InstallMethod(IsZero, "(FR) for a vector machine", [IsLinearFRMachine and IsVectorFRMachineRep], function(M) return Length(M!.output)=0; end); InstallMethod(\=, "(FR) for two vector elements", IsIdenticalObj, [IsLinearFRElement and IsVectorFRMachineRep, IsLinearFRElement and IsVectorFRMachineRep], function(M,N) return M!.transitions=N!.transitions and M!.output=N!.output; end); InstallMethod(\<, "(FR) for two vector elements", IsIdenticalObj, [IsLinearFRElement and IsVectorFRMachineRep, IsLinearFRElement and IsVectorFRMachineRep], function(M,N) local i, j, Mt, Nt, a; i := 1; a := [1..Length(N!.transitions)]; repeat if not IsBound(N!.output[i]) then return false; # either left longer, or equal elements elif not IsBound(M!.output[i]) then return true; # SHORTlex, right longer elif M!.output[i]<>N!.output[i] then return M!.output[i]<N!.output[i]; # shortLEX else for j in [1..i] do Mt := M!.transitions{a}{a}[i][j]; Nt := N!.transitions{a}{a}[i][j]; if Mt<>Nt then return Mt<Nt; fi; od; for j in [1..i-1] do Mt := M!.transitions{a}{a}[j][i]; Nt := N!.transitions{a}{a}[j][i]; if Mt<>Nt then return Mt<Nt; fi; od; fi; i := i+1; until false; end); InstallMethod(IsOne, "(FR) for a vector element", [IsLinearFRElement and IsVectorFRMachineRep], function(E) local n, i, j, r; n := Length(E!.transitions); r := LeftActingDomain(E); for i in [1..n] do for j in [1..n] do if (i=j and E!.transitions[i][j]<>[[One(r)]]) or (i<>j and E!.transitions[i][j]<>[[Zero(r)]]) then return false; fi; od; od; return E!.output=[One(r)]; end); InstallMethod(IsZero, "(FR) for a vector element", [IsLinearFRElement and IsVectorFRMachineRep], function(E) return Length(E!.output)=0; end); ############################################################################ ############################################################################ ## #M Nucleus ## #!!! optimize; avoid creating / destroying vector spaces all the time, # and combine all elements into a machine before computing limit states #!!! take limit states of vector machine #!!! multiply vector machine with generating machine #!!! minimize BindGlobal("VECTORLIMITMACHINE@", function(M) local V, W, i, j; W := StateSet(M); repeat V := W; W := Subspace(V,[]); for i in Basis(V) do for j in M!.transitions do for j in j do W := ClosureLeftModule(W,i*j); od; od; od; until V=W; return VectorMachineNC(FamilyObj(M),MATRIX@(M!.transitions,x->List(Basis(W),b->Coef end); BindGlobal("LINEARLIMITSTATES@", function(L) local V, B, d, W, oldW, r; #!!! V := LINEARSTATES@(L); B := Basis(V); d := TransposedMat(List(B,w->List(Concatenation(DecompositionOfFRElement(w)),x->Coef W := LeftActingDomain(V)^Length(B); repeat oldW := W; W := Subspace(W,Concatenation(Basis(W)*d)); until oldW=W; return Subspace(V,Basis(W)*B); end); InstallMethod(LimitStates, "(FR) for a linear element", [IsLinearFRElement and IsFRElementStdRep], x->LINEARLIMITSTATES@([x])); #!!! disable / integrate in code. We need to keep track of the linear elements #with their natural machine rep InstallMethod(LimitStates, "(FR) for a vector machine", [IsLinearFRMachine and IsVectorFRMachineRep], M->States(VECTORLIMITMACHINE@(M))); InstallMethod(LimitStates, "(FR) for a vector element", [IsLinearFRElement and IsVectorFRMachineRep], E->States(VECTORLIMITMACHINE@(E))); InstallMethod(LimitStates, "(FR) for a space of linear elements", [IsFRElementCollection], function(L) if not ForAll(L,IsLinearFRElement) then TryNextMethod(); fi; return States(LimitFRMachine(L)); end); #!!! make it universal, as soon as LimitFRMachine works better InstallMethod(LimitFRMachine, "(FR) for a vector machine", [IsLinearFRMachine and IsVectorFRMachineRep], VECTORLIMITMACHINE@); InstallMethod(LimitFRMachine, "(FR) for a vector element", [IsLinearFRElement and IsVectorFRMachineRep], VECTORLIMITMACHINE@); InstallMethod(LimitFRMachine, "(FR) for a space of linear elements", [IsVectorSpace and IsFRElementCollection], function(V) return VECTORLIMITMACHINE@(Sum(GeneratorsOfVectorSpace(V),x->AsVectorMachine(Under end); InstallMethod(LimitFRMachine, "(FR) for a space of linear elements", [IsFRElementCollection], function(L) if not ForAll(L,IsLinearFRElement) then TryNextMethod(); fi; return VECTORLIMITMACHINE@(Sum(L,x->AsVectorMachine(UnderlyingFRMachine(x)))); end); BindGlobal("LINEARNUCLEUS@", function(V) # V is a vector space of linear elements, e.g. state space of a machine local v, newv, oldv, x, gens; gens := Basis(V); newv := gens; v := Subspace(V,[]); while newv<>[] do oldv := newv; newv := []; for x in Basis(LimitStates(oldv)) do if not x in v then Add(newv,x); v := ClosureLeftModule(v,x); fi; od; if newv<>[] then newv := ListX(newv,gens,\*); Info(InfoFR, 2, "Nucleus: The nucleus is at least ",v); fi; od; return v; end); #!!! disable InstallMethod(NucleusOfFRMachine, "(FR) for a linear machine", [IsLinearFRMachine], M->States(NucleusMachine(M))); InstallMethod(NucleusMachine, "(FR) for a linear machine", [IsLinearFRMachine], function(M) local l, oldl; #!!! keep track of original generators, if they're linear elements M := LimitFRMachine(Minimized(AsVectorMachine(M))); l := M; repeat oldl := l; l := Minimized(LimitFRMachine(l*M)); #!!! use Lie bracket in case the machine is from a Lie element until l=oldl; return l; end); ############################################################################ ############################################################################ ## #M Nice basis ## InstallHandlingByNiceBasis("IsVectorFRElementSpace", rec( detect := function(R,l,V,z) if l=[] then return IsLinearFRElement(z) and IsVectorFRMachineRep(z) and LeftActingDomain(z)=R; else return ForAll(l,x->IsLinearFRElement(x) and IsVectorFRMachineRep(x) and LeftActingDomain(x)=R); fi; end, NiceFreeLeftModuleInfo := function(V) local m, b, init; b := GeneratorsOfLeftModule(V); if b=[] or ForAll(b,IsZero) then return rec(machine := UnderlyingFRMachine(Zero(V)), space := VectorSpace(LeftActingDomain(V),[],Zero(LeftActingDomain(V))), dim := 0); fi; m := Minimized(Sum(List(b,UnderlyingFRMachine))); init := List([1..Length(b)],i->Concatenation(List([1..Length(b)], j->DELTA@(i=j)*AsList(b[j]!.input)))); # need "AsList" because NullMapMatrix is not a list :( return rec(machine := m, space := VectorSpace(LeftActingDomain(V),init*Correspondence(m)), dim := Length(m!.output)); end, NiceVector := function(V,v) local i, x, n, w; i := NiceFreeLeftModuleInfo(V); if IsZero(v) then return Zero(i.space); fi; n := Minimized(i.machine+UnderlyingFRMachine(v)); if Length(n!.output)>Length(i.machine!.output) then return fail; else x := v!.input*Correspondence(n){[1..Length(v!.output)]+i.dim}; if x in i.space then return x; else return fail; fi; fi; end, UglyVector := function(V,v) local i; i := NiceFreeLeftModuleInfo(V); if v in i.space then if IsTrivial(i.space) then # avoid GAP bug with 0-dimensional space return FRElement(i.machine,NullMapMatrix); fi; return FRElement(i.machine,v); else return fail; fi; end)); ############################################################################ [ Verzeichnis aufwärts0.57unsichere Verbindung Übersetzung europäischer Sprachen durch Browser ] |
2026-03-28