GAP 4.8.9 installation with standard packages -- copy to your CoCalc project to get it
############################################################################# ## This program is free software: you can redistribute it and/or modify ## it under the terms of the GNU General Public License as published by ## the Free Software Foundation, either version 2 of the License, or ## (at your option) any later version. ## ## This program is distributed in the hope that it will be useful, ## but WITHOUT ANY WARRANTY; without even the implied warranty of ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ## GNU General Public License for more details. ## #W simpleChains.gi Ruth Hoffmann ## ## #Y Copyright (C) 2004-2015 School of Computer Science, #Y University of St. Andrews, North Haugh, #Y St. Andrews, Fife KY16 9SS, Scotland ## ################################################################################ ## #F OnePointDelete(perm) ## ## OnePointDelete removes single points in the simple permutation and returns ## a list of the resulting simple permutations, in their rank encoding. ## InstallGlobalFunction(OnePointDelete, function(perm) local i,p,t,j,plist,p1; if IsSimplePerm(perm) and not(IsExceptionalPerm(perm)) then if IsRankEncoding(perm) then p:=RankDecoding(perm); else p:=ShallowCopy(perm); fi; plist:=[]; for i in [1..Length(p)] do p1:=ShallowCopy(p); t:=Remove(p1,i); for j in [1..Length(p1)] do if p1[j] > t then p1[j]:=p1[j]-1; fi; od; if IsSimplePerm(p1) then Add(plist,p1); fi; od; Apply(plist,RankEncoding); return plist; elif IsExceptionalPerm(perm) then Print(perm, "is an exceptional permutation and needs 2 point deletion."); return fail; else Print(perm, "is not simple."); return fail; fi; end ); ################################################################################ ## #F TwoPointDelete(perm) ## ## TwoPointDelete removes two points of the input exceptional permutation and ## returns the list of the unique resulting permutation, in its rank encoding. ## InstallGlobalFunction(TwoPointDelete, function(perm) local m,p; if IsExceptionalPerm(perm) then m:=Length(perm)/2; if IsRankEncoding(perm) then p:=StructuralCopy(perm); else p:=RankEncoding(perm); fi; if p{[1..m]}=[2..m+1] then Remove(p,Length(p)); Remove(p,m); return [p]; elif Reversed(p{[1..m]})=[1,3..2*m-1] then Remove(p,m+1); Remove(p,1); return [p]; else Remove(p,2); Remove(p,1); return [p]; fi; else Print("The input permutation is not an exceptional permutation.\n"); return fail; fi; end ); ################################################################################ ## #F PointDeletion(perm) ## ## PointDeletion, takes any simple permutation does not matter whether ## exceptional or not and removes the right number of points. ## InstallGlobalFunction(PointDeletion, function(perm) if IsSimplePerm(perm) then if IsExceptionalPerm(perm) then return TwoPointDelete(perm); else return OnePointDelete(perm); fi; else Print(perm, "is not simple."); return fail; fi; end ); ######## ## Experimental, undocumented code to get the language of simple permutations ## with one more point. ######## ################################################################################ ## #F NonSimpleOnePointAdditionTransducer(length,k) ## ## Constructs an transducer that when applied to an language, finds all the words ## with an additional letter which seem are not simple permutations. ## InstallGlobalFunction(NonSimpleOnePointAdditionTransducer, function(length,k) local nostates,init,accept,trans,i,n; nostates:=2*k+7; init:=1; accept:=[k+4..nostates]; trans:=[]; Append(trans,[[0,0,1,2],[0,1,1,3],[0,1,2,k+4],[0,length+1,2,k+5]]); for i in [1..k] do Append(trans,[[i,i,3,k+6],[i,i+1,3,k+7],[i,i,k+6,k+6],[i,i+1,k+7,k+7],[i,i,2,2]]); Add(trans,[i,i,2,3+i]); Append(trans,[[0,i,3+i,k+7+i],[0,i+1,3+i,k+7+i]]); if not(i=k) then for n in [1..k] do if n <= i then Add(trans,[n,n,k+7+i,k+8+i]); else Add(trans,[n,n+1,k+7+i,k+7+i]); fi; od; else for n in [1..k] do Add(trans,[n,n,k+7+i,k+7+i]); od; fi; od; return Transducer(nostates,init,trans,accept); end ); ################################################################################ ## #F OneStepSimplePermsAut(perms) ## ## Takes in a list of rank encoded simple permutations, of the same length and ## returns the simple permutations that are have one additional point and are ## encoded using the same alphabet. ## InstallGlobalFunction(OneStepSimplePermsAut, function(perms) local l,k,i,a,t1,b,t2,c,res,alph1,expaut,tmp,tmp1,a1; l:=Length(perms[1]); k:=0; for i in perms do if Maximum(i) > k then k:=Maximum(i); fi; od; #(T_sn(C^R))^R a:=MinimalAutomaton(ReversedAutomaton(RatExpToAut(SequencesToRatExp(perms)))); t1:=NonSimpleOnePointAdditionTransducer(l,k); b:=MinimalAutomaton(ReversedAutomaton(MinimalAutomaton(CombineAutTransducer(a,t1))));; #(T_i(C^R))^R n S_l+1 t2:=TransposedTransducer(DeletionTransducer(l+1));; c:=IntersectionAutomaton(MinimalAutomaton(ReversedAutomaton(MinimalAutomaton( CombineAutTransducer(a,t2)))),BoundedClassAutomaton(l+1));; #L(C) tmp:=IntersectionAutomaton(ComplementDA(b),c); # # Union of L(C) with exceptional perms to get whole language, might not # be needed though. # alph1:=AlphabetOfAutomatonAsList(tmp); expaut:=ExceptionalBoundedAutomaton(Length(alph1)); tmp1:=MinimalAutomaton(UnionAutomata(expaut,tmp)); a1:=ExpandAlphabet(BoundedClassAutomaton(k),AlphabetOfAutomaton(tmp)); res:=IntersectionAutomaton(tmp1,a1); return res; end );