########## # File @(#) Bdr2Part (PART PACKAGE) Wed Feb 26 19:16:36 MET 1997 ########## interface(verboseproc=0); # # Border2Part(border) returns the partition (tableau) corresponding to the # given border. # The border is a list of 0 and 1, 0 denoting an # horizontal chunk, 1 a vertical one. # Extremity segments shall not be included (i.e. 1 on the # left top, 0 on the right bottom). # The returned partition is in decreasing order. # # renvoie la partition (le tableau) correspondant a la # frontiere en argument. # La frontiere est une liste de 0 et de 1, 0 correspondant # a un morceau horizontal, 1 a un morceau vertical. # Les portions extremes ne sont pas incluses (1 en haut # a gauche, 0 en bas a droite). # La partition renvoyee est en ordre decroissant. # # Border2Part(border, m) returns the same, m[1] denoting an horizontal chunk # of the border, m[2] a vertical one. # # Border2Part(border, m) renvoie la meme chose, m[1] correspondant a un # segment horizontal, m[2] un segment vertical. # # VP260297 SV280798 `PART/Border2Part/int` := proc(border) local i, # variable for loop... h, # horizontal encoding... n, # number of horizontal segments lambda; # the result lambda := NULL; n := 0; if (nargs = 2) then h := op(1,args[2]); else h := 0; fi; for i from 1 to nops(border) do if (border[i] = h) then n := n+1; else lambda := n, lambda; fi; od; [lambda] end; # # VP230397 # Interfacing options... `PART/Border2Part` := proc(border) local i, # variable for loop... alphbt; # the alphabet... alphbt := NULL; # default value... if (nargs >= 2) then for i from 2 to nargs do if (op(1, args[i]) = 'alphabet') then alphbt := op(2, args[i]); fi; od; fi; `PART/Border2Part/int`(border,alphbt); end; # # SV240497 `PART/Border2Part/interface` := proc(border) `PART/Border2Part`(args); end; # # This is the same function but for the PART package so that it provides # some verifications on the arguments. # # VP260297 `PART/Border2Part/check` := proc(border) if (nargs >= 2) then if (type(args[2],`=`)) then if (op(1, args[2]) = 'alphabet') then if (not type(op(2, args[2]), list)) then ERR['PARTPerror'](4,procname); elif (nops(op(2, args[2]))<>2) then ERR['PARTPerror'](4,procname); fi; else ERR['PARTPerror'](4,procname); fi; else ERR['PARTPerror'](3,procname); fi; if (not TYP['IsBorder'](args[1], args[2..nargs])) then ERR['PARTPerror'](1,procname); fi; elif (not TYP['IsBorder'](args[1])) then ERR['PARTPerror'](1,procname); fi; end; # # SV160497 `PART_PACK/Border2Part` := proc(border) `PART/Border2Part/check`(args); `PART/Border2Part/interface`(args); end; # savelib(`PART/Border2Part/int`, `PART/Border2Part/int.m`); savelib(`PART/Border2Part`, `PART/Border2Part.m`); savelib(`PART/Border2Part/interface`, `PART/Border2Part/interface.m`); savelib(`PART/Border2Part/check`, `PART/Border2Part/check.m`); savelib(`PART_PACK/Border2Part`, `PART_PACK/Border2Part.m`); # if (not assigned(_NOQUIT)) then quit; fi; ########## # File @(#) FreeCore (FREE PACKAGE) Mon Feb 27 18:10:18 Frh 1995 ########## interface(verboseproc=0); # # FreeEm(m) is called to analyse a monomial. # # est appelee pour analyser un monome. # # SV100497 SV280798 `FREE/FreeEm`:=proc(m,coeff,wordr) local coeffi, # a coefficient... word, # a word... i, # variable for loop... j; # variable for sequence... option remember; coeffi:=1; if (type(m,`*`)) then for i from nops(m) by -1 to 1 do if (TYP['IsWord'](op(i,m))) then if (not assigned(word)) then word:=[op(op(i,m))] else ERR['FREEPerror'](9,procname) fi elif (type(op(i,m),`^`)) then if (TYP['IsWord'](op(1,op(i,m)))) then ERR['FREEPerror'](9,procname) else coeffi:=coeffi*op(i,m) fi else coeffi:=coeffi*op(i,m) fi od; elif (TYP['IsWord'](m)) then word:=[op(m)] elif (type(m,`^`)) then if (TYP['IsWord'](op(1,m))) then ERR['FREEPerror'](9,procname) else coeffi:=coeffi*m fi else coeffi:=m; fi; if (not assigned(coeffi)) then coeff:=1 else coeff:=coeffi fi; if (not assigned(word)) then wordr:=[] else wordr:=word fi end; # # FreeE(e) is called to analyse an element. It returns a table indexed by # all words appearing in the element e, in each monomial. # # est appelee pour analyser un element. Elle retourne une table # indicee par tous les mots apparaissant dans e, dans chaque # monome. # # SV100497 `FREE/FreeE`:=proc(e) local i, # variable for loops... t, # the result... c, # a coefficient... w; # a word... t:=table(sparse); if (type(e,`+`)) then for i from 1 to nops(e) do `FREE/FreeEm`(op(i,e),'c','w'); t[w]:=t[w]+c od; else `FREE/FreeEm`(e,'c','w'); t[w]:=t[w]+c fi; eval(t) end; # savelib(`FREE/FreeEm`, `FREE/FreeEm.m`); savelib(`FREE/FreeE`, `FREE/FreeE.m`); # if (not assigned(_NOQUIT)) then quit; fi; ########## # File @(#) ListComp (COMP PACKAGE) Sat Mar 22 10:24:50 NFT 1997 ########## interface(verboseproc=0); # # ListCompo(n) returns the list of all compositions of n. # # retourne la liste des compositions de n. # # ListCompo(n, options) computes the list of all compositions of n constrained # by the following allowed options: # * lg <= l : length of compositions shall not exceed l, # * lg = l : length of compositions is set to l, # * maxouter = m : outermost possible shape, # * allowzeros : compositions may include one or more zeros # (length must be set by option lg = l). # * nb : only returns the number of compositions; # # renvoie la liste des compositions de n eventuellement # restreinte par les options suivantes: # * lg <= l : la longueur des compositions est au maximum l, # * lg = l : la longueur des compositions est fixee a l, # * maxouter = m : forme la plus externe possible, # * allowzeros : les compositions peuvent comporter plusieurs # zeros (l'option lg = l doit cependant etre # positionnee) # * nb : renvoie uniquement le nombre de compositions; # #VP220397 # we may compute separatly the classical case... `COMP/ListCompo/rec/elem` := proc(n) local i; # variable for sequence... option remember; if (n = 0) then [[]]; else [seq(op(map(proc(x,y) [y, op(x)] end, `COMP/ListCompo/rec/elem`(n+i), -i)), i=-n..-1)]; fi; end; # # To have op(...) compatible with Maple V Release 4... # # SV020797 `COMP/SubSeq/list`:=proc(subseq, l) if (l=[]) then NULL else if (op(1, subseq)>op(2, subseq)) then NULL else op(subseq, l) fi fi end; # #VP220397 SV170199 # exactl is true if l is constant; zerone either equals 0 or one. `COMP/ListCompo/rec` := proc(n,l,exactl,zerone,m) local i, # variable for sequence... j, # variable for sequence... gp; # greatest part of outermost shape... option remember; if (l = 0) then if (n > 0) then # no solution. []; else [[]]; fi; elif (n = 0) then if (exactl) then if (zerone = 0) then [[seq(0, i=1..l)]]; else []; fi; else if (zerone = 0) then [[], seq([seq(0, i=1..j)], j=1..l)]; else [[]]; fi; fi; else if (m = []) then gp := n; else gp := m[1]; fi; [seq(op(map(proc(x,y) [y, op(x)] end, `COMP/ListCompo/rec`(n+i, l-1, exactl,zerone, [`COMP/SubSeq/list`(2..nops(m), m)]), -i)), i=-min(n, gp)..-zerone)]; fi; end; # # Counting functions # #VP220397 `COMP/NbCompo/elem` := proc(n) 2^(n-1); end; # #VP220397 SV170199 `COMP/NbCompo/rec` := proc(n,l,exactl,zerone,m) local i, # variable for sequence... gp; # greatest part of outermost shape... option remember; if (l = 0) then if (n > 0) then # no solution. 0; else 1; fi; elif (n = 0) then if (exactl) then if (zerone = 0) then 1; else 0; fi; else if (zerone = 0) then 1+l; else 1; fi; fi; else if (m = []) then gp := n; else gp := m[1]; fi; convert([seq(`COMP/NbCompo/rec`(n+i, l-1, exactl,zerone, [`COMP/SubSeq/list`(2..nops(m), m)]), i=-min(n, gp)..-zerone)], `+`); fi; end; # # End of counting functions... # #VP220397 SV170199 # Treating options... `COMP/ListCompo` := proc(n) local i, # variable for sequence... j, # variable for loop.. max_lg, # maximal length of compositions... set_lg, # length is in fact set... less_lg, # maximal length is set... max_out, # outermost possible shape... zero_one, # inserting zeros... nb_count, # only counting... dont_forget, # we may may not to forget results... res; # result (needed for forget instruction)... max_lg := n; # default value... set_lg := false; # default value... less_lg := false; # default value... max_out := [n]; # default value... zero_one := 1; # default value... nb_count := false; # default value... dont_forget := false;# I remember when I was young... if (nargs >= 2) then for j from 2 to nargs do if (type(args[j],`=`)) then if (op(1, args[j]) = `lg`) then if (max_lg <> -1) then if (set_lg) then if (op(2, args[j])=max_lg) then # max_lg unchanged. else max_lg := -1; # no solution because for instance lg=5, lg=6. fi else if (less_lg) then if (op(2, args[j])<=max_lg) then max_lg := op(2, args[j]); else max_lg := -1; # no solution because for instance lg<=5, lg=6. fi; else max_lg := op(2, args[j]); fi; fi; fi; set_lg := true; elif (op(1, args[j]) = `maxouter`) then max_out := op(2, args[j]); # max_out will be completed by 0's. fi; elif (type(args[j],`<=`)) then if (op(1, args[j]) = `lg`) then if (max_lg <> -1) then if (set_lg) then if (op(2, args[j])>=max_lg) then # max_lg unchanged because set to lg=5, and lg<=6 added. else max_lg := -1; # no solution because for instance lg=6, lg<=5. fi; else if (less_lg) then if (op(2, args[j])>=max_lg) then # max_lg unchanged because lg<=5, lg<=6. else max_lg := op(2, args[j]); # because lg<=6, lg<=5. fi else max_lg := op(2, args[j]); fi; fi; fi; less_lg := true; fi; elif (args[j] = `allowzeros`) then zero_one := 0; elif (args[j] = `nb`) then nb_count := true; elif (args[j] = `dontforget`) then dont_forget := true; fi; od; fi; if (max_lg = -1) then if (nb_count) then # only counting... 0; else []; fi; else if (nb_count) then # only counting... if (nargs=2) then `COMP/NbCompo/elem`(n); else max_out := [op(max_out), seq(n, i=1..max_lg-nops(max_out))]; res := `COMP/NbCompo/rec`(n, max_lg, set_lg, zero_one, max_out); if (not dont_forget) then forget(`COMP/NbCompo/rec`); fi; res; fi; elif (nargs=1) then res := `COMP/ListCompo/rec/elem`(n); forget(`COMP/ListCompo/rec/elem`); res; elif (nargs=2 and dont_forget) then # we shall stay efficient... `COMP/ListCompo/rec/elem`(n); else max_out := [op(max_out), seq(n, i=1..max_lg-nops(max_out))]; res := `COMP/ListCompo/rec`(n, max_lg, set_lg, zero_one, max_out); if (not dont_forget) then forget(`COMP/ListCompo/rec`); fi; res; fi; fi; end; # # SV240497 `COMP/ListCompo/interface` := proc(n) `COMP/ListCompo`(args); end; # # #VP220397 SV141298 SV170199 `COMP/ListCompo/check` := proc(n) local i; # variable for loop... if (not type(n, integer)) then ERR['COMPPerror'](1,procname); # Wrong type for first argument... elif (nargs >= 2) then for i from 2 to nargs do # Checking all possibilities... if (not type(args[i],`=`) and not type(args[i],`<=`) and args[i]<>`nb` and args[i]<>`allowzeros` and args[i]<>`dontforget`) then ERR['COMPPerror'](2*i-1,procname); # Wrong type for ith argument... fi; # Checking structured arguments... if (type(args[i],`=`)) then if (op(1, args[i]) = `lg`) then if (not type(op(2, args[i]), nonnegint)) then ERR['COMPPerror'](2*i-1,procname);# Wrong type for ith argument... fi; elif (op(1, args[i]) = `maxouter`) then if (not TYP['IsCompo'](subs(0=NULL, op(2, args[i])))) then ERR['COMPPerror'](2*i-1,procname);# Wrong type for ith argument... fi; fi; elif (type(args[i],`<=`)) then if (op(1, args[i]) = `lg`) then if (not type(op(2, args[i]), nonnegint)) then ERR['COMPPerror'](2*i-1,procname);# Wrong type for ith argument... fi; else ERR['COMPPerror'](2*i-1,procname); # Wrong type for ith argument... fi; fi; od; fi; end; # # SV160497 `COMP_PACK/ListCompo` := proc(n) `COMP/ListCompo/check`(args); `COMP/ListCompo/interface`(args); end; # savelib(`COMP/ListCompo/rec/elem`, `COMP/ListCompo/rec/elem.m`); savelib(`COMP/SubSeq/list`, `COMP/SubSeq/list.m`); savelib(`COMP/ListCompo/rec`, `COMP/ListCompo/rec.m`); savelib(`COMP/NbCompo/elem`, `COMP/NbCompo/elem.m`); savelib(`COMP/NbCompo/rec`, `COMP/NbCompo/rec.m`); savelib(`COMP/ListCompo`, `COMP/ListCompo.m`); savelib(`COMP/ListCompo/interface`, `COMP/ListCompo/interface.m`); savelib(`COMP/ListCompo/check`, `COMP/ListCompo/check.m`); savelib(`COMP_PACK/ListCompo`, `COMP_PACK/ListCompo.m`); # if (not assigned(_NOQUIT)) then quit; fi; ########## # File @(#) SfAExpn (SFA PACKAGE) Mercredi 23 juillet 1997 15:51:21 ########## interface(verboseproc=0); # # SfAExpand(sfa) converts subterms in sfa that are on polynomial alphabet # expressions into terms on one single alphabet. # # The following formulae are used (some of them should be optimized later): # # p[I](-A) = (-1)^size(I) p[I](A) # e[I](-A) = (-1)^|I| h[I](A) # h[I](-A) = (-1)^|I| e[I](A) # s[I](-A) = (-1)^|I| s[I~](A) # m[I](-A) = TopA(m[I](A)) # # p[I](AB) = p[I](A) p[I](B) # e[I](AB) = (-1)^|I| product{i=1..size(I)} # sum{|J|=I.i} (-1)^|J| ToeA(m[J](A)) e[J](B) # h[I](AB) = product{i=1..size(I)} # sum{|J|=I.i} TohA(m[J](A)) h[J](B) # s[I](AB) = sum{|J|=|I|} s[I*J](A) s[J](B) where * = SfInternal # m[I](AB) = TopA(m[I](AB)) # # For any k <> 0, 1 : # p[I](kA) = k^(size(I)) p[I](A) # e[I](kA) = (-1)^|I| product{i=1..size(I)} # sum{|J|=I.i} (-1)^|J| m[J](k) h[J](A) # h[I](kA) = product{i=1..size(I)} # sum{|J|=I.i} m[J](k) h[J](A) # s[I](kA) = sum{|J|=|I|} s[I*J](k) s[J](A) where * = SfInternal # m[I](kA) = TopA(m[I](kA)) # # p[I](A+B) = product{i=1..size(I)} p[I.i](A) + p[I.i](B) # e[I](A+B) = product{i=1..size(I)} # sum{j=0..I.i} e[I.i-j](A) e[j](B) # h[I](A+B) = product{i=1..size(I)} # sum{j=0..I.i} h[I.i-j](A) h[j](B) # s[I](A+B) = sum{J in I} s[J](B) SfDiff(s[J], s[I])(A) # m[I](A+B) = sum{I' U I"=I} m[I'](A) m[I"](B) # # For any k <> 0, 1 : # p[I](k) = k^size(I) # e[I](k) = product{i=1..size} # k(k-1)(k-2)..(k-I.i+1)/I.i! # h[I](k) = product{i=1..size} # k(k+1)(k+2)..(k+I.i-1)/I.i! # m[I](k) = product{i=1..size} # k(k-1)(k-2)..(k-n+1)/(a1!a2!..an!) with I=1^a1..n^an # s[I](k) = product{i=1..size} ld[i]*(i-dp+k) / # product(hooks(I)) with (dp, ld) = Part2Diagonal(I) # # VP230797 VP120997 VP151097 VP120298 VP020398 VP030398 VP100299 VP110299 `SFA/SfAExpand` := proc(sfa) local part, # indexing partition... alphab, # alphabet... base, # a basis... lp, # a list of partitions... l, # a list of lists... i, # var for loop and seq... j, # var for loop... k, # var for seq... v, # var... ra, # remaining alphabet... t; # a table... global SFABases; # known bases... option remember; if type(sfa, `+`) then map(`SFA/SfAExpand`, sfa); elif type(sfa, `*`) then t := `SFA/MonomialA`(sfa, SFABases); for i in map(op, [indices(t)]) do if (i <> 'coeff') then for j in map(op, [indices(t[i])]) do if type(t[i][j], `*`) then # VP020398 t['coeff'] := t['coeff'] * eval(cat(`SFA/To`,i,`A`)(expand(map(`SFA/SfAExpand`, t[i][j](j))))); else t['coeff'] := t['coeff'] * (`SFA/SfAExpand`(t[i][j](j))); fi; od; fi; od; expand(t['coeff']); elif type(sfa, `^`) then base := op(0, op(0, op(1, sfa))); if (base='p' or base ='e' or base='h') then # To_A is much faster than SfACollect... `SFA/SfAExpand`(eval(cat(`SFA/To`, base, `A`)(sfa))); elif (type(op(2, sfa), posint) and (base='s' or base='m')) then `SFA/SfAExpand`(eval(cat(`SYMF/To`, base)(op(0, op(1, sfa))^op(2,sfa))) (op(1,op(1, sfa)))); else sfa; fi; elif (type(sfa, function) and (`TYP/IspA`(sfa) or `TYP/IseA`(sfa) or `TYP/IshA`(sfa) or `TYP/IssA`(sfa) or `TYP/IsmA`(sfa))) then part := [op(op(0, sfa))]; base := op(0, op(0, sfa)); alphab := op(1, sfa); # First, we check the partition... if (part=[]) then if (base='p') then # can not handle such a case... ERROR(`p[](...) can not be expanded!`); else 1; fi; elif type(alphab, `^`) then # Alphabet is a power... if type(op(2, alphab), posint) then if (base='p') then `SFA/SfAExpand`(p[op(part)](op(1, alphab))) * `SFA/SfAExpand`(p[op(part)](op(1, alphab)^(op(2, alphab)-1))); elif (base='e') then v := NULL; for i from 1 to nops(part) do lp := `PART/ListPart`(part[i]); v := v, convert([ seq((-1)^(convert(lp[j], `+`))* `SFA/SfAExpand`(`SFA/ToeA`( m[op(lp[j])](op(1, alphab)))) * `SFA/SfAExpand`(e[op(lp[j])](op(1, alphab)^(op(2, alphab)-1))), j = 1..nops(lp))], `+`); od; (-1)^(convert(part, `+`))*`SFA/ToeA`(expand(convert([v], `*`))); elif (base='h') then v := NULL; for i from 1 to nops(part) do lp := `PART/ListPart`(part[i]); v := v, convert([ seq( `SFA/SfAExpand`(`SFA/TohA`(m[op(lp[j])](op(1, alphab)))) * `SFA/SfAExpand`(h[op(lp[j])](op(1, alphab)^(op(2, alphab)-1))), j = 1..nops(lp))], `+`); od; `SFA/TohA`(expand(convert([v], `*`))); elif (base='s') then lp := `PART/ListPart`(convert(part, `+`)); `SFA/TosA`(convert([ # VP110299 seq(`SFA/SfAExpand`(expand( # VP110299 `SFA/Sf2SfA`( `SYMF/SfInternal`(s[op(part)], s[op(lp[i])], 's'),op(1, alphab)) * s[op(lp[i])](op(1, alphab)^(op(2, alphab)-1)))), i=1..nops(lp))], `+`)); elif (base='m') then `SFA/SfAExpand`(`SFA/TopA`(sfa)); fi; elif type(op(2,alphab),negint) or (type(op(2,alphab),`*`) and sign(op(2,alphab))=-1) then # VP110299 # This is a fraction: we put the result on the p-basis... if (base='p') then `SFA/SfAExpand`(p[op(part)](numer(alphab)))/ convert([seq(subs(map((x,y)->x=x^y, SfAVars(),part[i]), denom(alphab)), i=1..nops(part))],`*`); else `SFA/SfAExpand`(`SFA/TopA`(sfa, [alphab])); fi; elif `TYP/IsConstant`(alphab) then # The power is a constant... if (base=`p`) then alphab^nops(part); elif (base=`e`) then convert( [seq(convert([seq(alphab-j, j=0..part[i]-1)], `*`)/factorial(part[i]), i=1..nops(part))], `*`); elif (base=`h`) then convert( [seq(convert([seq(alphab+j, j=0..part[i]-1)], `*`)/factorial(part[i]), i=1..nops(part))], `*`); elif (base=`s`) then convert([seq(seq(alphab-i+j ,j=1..part[i]), i=1..nops(part))], `*`)/ convert(`PART/Part2ListHook`(part), `*`); elif (base=`m`) then v := `PART/Part2Exp`(part); convert([seq(alphab-i, i=0..nops(v)-1)], `*`) / convert(map(factorial, v), `*`); fi; else sfa; fi; elif type(alphab, `*`) then if type(op(1, alphab), negative) then # Negative alphabet... if (base='p') then (-1)^(nops(part)) * `SFA/SfAExpand`(p[op(part)](-alphab)); elif (base='e') then (-1)^(convert(part, `+`)) * `SFA/SfAExpand`(h[op(part)](-alphab)); elif (base='h') then (-1)^(convert(part, `+`)) * `SFA/SfAExpand`(e[op(part)](-alphab)); elif (base='s') then (-1)^(convert(part, `+`)) * `SFA/SfAExpand`(s[op(`PART/Part2Conjugate`(part))](-alphab)); elif (base='m') then `SFA/SfAExpand`(`SFA/TopA`(sfa)); fi; elif type(op(1, alphab), `^`) then # Product with a power as first term... ra := convert([op(2..nops(alphab), alphab)], `*`); if type(op(2, op(1, alphab)), posint) then if (base='p') then `SFA/SfAExpand`(p[op(part)](op(1, op(1, alphab)))) * `SFA/SfAExpand`(p[op(part)]( op(1, op(1, alphab))^(op(2, op(1, alphab))-1)*ra)); elif (base='e') then v := NULL; for i from 1 to nops(part) do lp := `PART/ListPart`(part[i]); v := v, convert([ seq((-1)^(convert(lp[j], `+`))* `SFA/SfAExpand`(`SFA/ToeA`( m[op(lp[j])](op(1, op(1, alphab))))) * `SFA/SfAExpand`(e[op(lp[j])]( op(1, op(1, alphab))^(op(2, op(1, alphab))-1)*ra)), j = 1..nops(lp))], `+`); od; (-1)^(convert(part, `+`))*`SFA/ToeA`(expand(convert([v], `*`))); elif (base='h') then v := NULL; for i from 1 to nops(part) do lp := `PART/ListPart`(part[i]); v := v, convert([ seq( `SFA/SfAExpand`(`SFA/TohA`(m[op(lp[j])]( op(1, op(1, alphab))))) * `SFA/SfAExpand`(h[op(lp[j])]( op(1, op(1, alphab))^(op(2, op(1, alphab))-1)*ra)), j = 1..nops(lp))], `+`); od; `SFA/TohA`(expand(convert([v], `*`))); elif (base='s') then lp := `PART/ListPart`(convert(part, `+`)); `SFA/TosA`(convert([ # VP110299 seq(`SFA/SfAExpand`(expand( # VP110299 `SFA/Sf2SfA`(`SYMF/SfInternal`(s[op(part)], s[op(lp[i])], 's'), op(1, op(1, alphab))) * s[op(lp[i])](op(1, op(1, alphab))^(op(2, op(1,alphab))-1)*ra))), i=1..nops(lp))], `+`)); elif (base='m') then `SFA/SfAExpand`(`SFA/TopA`(sfa)); fi; elif type(op(2,op(1,alphab)),negint) or (type(op(2,op(1,alphab)),`*`) and sign(op(2,op(1,alphab)))=-1) then # VP110299 # This is a fraction: we put the result on the p-basis... if (base='p') then `SFA/SfAExpand`(p[op(part)](numer(op(1,alphab))))/ convert([seq(subs(map((x,y)->x=x^y, SfAVars(),part[i]), denom(op(1,alphab))), i=1..nops(part))],`*`) * `SFA/SfAExpand`(p[op(part)](op(2..nops(alphab),alphab))); else `SFA/SfAExpand`(`SFA/TopA`(sfa, [alphab])); fi; else sfa; fi; elif `TYP/IsArgAlphabet/simple`(op(1, alphab)) or `TYP/IsVariable`(op(1,alphab)) then # Product of two alphabets... if (base='p') then `SFA/SfAExpand`(p[op(part)](op(1, alphab))) * `SFA/SfAExpand`(p[op(part)] (convert([op(2..nops(alphab), alphab)], `*`))); elif (base='e') then v := NULL; for i from 1 to nops(part) do lp := `PART/ListPart`(part[i]); v := v, convert([ seq((-1)^(convert(lp[j], `+`))* `SFA/SfAExpand`(`SFA/ToeA`( m[op(lp[j])](op(1, alphab)))) * `SFA/SfAExpand`(e[op(lp[j])](convert([op(2..nops(alphab), alphab)], `*`))), j = 1..nops(lp))], `+`); od; (-1)^(convert(part, `+`))*`SFA/ToeA`(expand(convert([v], `*`))); elif (base='h') then v := NULL; for i from 1 to nops(part) do lp := `PART/ListPart`(part[i]); v := v, convert([ seq( `SFA/SfAExpand`(`SFA/TohA`(m[op(lp[j])](op(1, alphab)))) * `SFA/SfAExpand`(h[op(lp[j])](convert([op(2..nops(alphab), alphab)], `*`))), j = 1..nops(lp))], `+`); od; `SFA/TohA`(expand(convert([v], `*`))); elif (base='s') then lp := `PART/ListPart`(convert(part, `+`)); `SFA/TosA`(convert([ # VP110299 seq(`SFA/SfAExpand`(expand( # VP110299 `SFA/Sf2SfA`(`SYMF/SfInternal`(s[op(part)], s[op(lp[i])], 's'), op(1, alphab)) * s[op(lp[i])](convert([op(2..nops(alphab), alphab)], `*`)))), i=1..nops(lp))], `+`)); elif (base='m') then `SFA/SfAExpand`(`SFA/TopA`(sfa)); fi; # VP110299 `TYP/IsConstant` matches any sum... I've added this just before. # 1st term of product is a sum => expand... elif type(op(1, alphab), `+`) then `SFA/SfAExpand`(base[op(part)](expand(alphab))); elif `TYP/IsConstant`(op(1, alphab)) then # Product of an alphabet by a numeric/formal constant if (base='p') then op(1, alphab)^(nops(part)) * `SFA/SfAExpand`(p[op(part)] (convert([op(2..nops(alphab), alphab)], `*`))); elif (base='e') then v := NULL; for i from 1 to nops(part) do lp := `PART/ListPart`(part[i]); l := [seq(`PART/Part2Exp`(lp[j]), j=1..nops(lp))]; v := v, convert([ seq((-1)^(part[i])* convert([seq(op(1, alphab)-k, k=0..convert(l[j], `+`)-1)], `*`) / convert(map(factorial, l[j]), `*`) * `SFA/SfAExpand`(e[op(lp[j])](convert([op(2..nops(alphab), alphab)], `*`))), j = 1..nops(lp))], `+`); od; (-1)^(convert(part, `+`))*`SFA/ToeA`(expand(convert([v], `*`))); elif (base='h') then v := NULL; for i from 1 to nops(part) do lp := `PART/ListPart`(part[i]); l := [seq(`PART/Part2Exp`(lp[j]), j=1..nops(lp))]; v := v, convert([seq( # of multinomials... convert([seq(op(1, alphab)-k, k=0..convert(l[j], `+`)-1)], `*`) / convert(map(factorial, l[j]), `*`) * `SFA/SfAExpand`(h[op(lp[j])] (convert([op(2..nops(alphab), alphab)], `*`))), j=1..nops(lp))], `+`); od; `SFA/TohA`(expand(convert([v], `*`))); elif (base='s') then v := convert(part, `+`); lp :=`PART/ListPart`(v); expand( convert([ seq(subs(seq(p.j=op(1, alphab), j=1..v), `SYMF/SfInternal`(s[op(part)], s[op(lp[i])], 's')) * `SFA/SfAExpand`(s[op(lp[i])] (convert([op(2..nops(alphab), alphab)], `*`))), i=1..nops(lp))], `+`)); elif (base='m') then # Nothing better for the moment... `SFA/SfAExpand`(`SFA/TopA`(sfa)); fi; elif (type(op(1,alphab), function) and (`TYP/IspA`(op(1,alphab)) or `TYP/IseA`(op(1,alphab)) or `TYP/IshA`(op(1,alphab)) or `TYP/IssA`(op(1,alphab)) or `TYP/IsmA`(op(1,alphab)))) then # Alphabet may be a product of symmetric function... if (`TYP/IspA`(op(1,alphab)) and base='p' and `TYP/IsArgAlphabet/simple`(op(1, op(1,alphab)))) then p[op(sort([ seq(op(map((n,m) -> n*m, [op(op(0, op(1,alphab)))],part[i])), i=1..nops(part))], (x,y) -> evalb(x>y)))](op(1, op(1,alphab)))* `SFA/SfAExpand`(p[op(part)] (convert([op(2..nops(alphab), alphab)], `*`))); else `SFA/SfAExpand`(`SFA/TopA`(base[op(part)] (`SFA/TopA`(`SFA/SfAExpand`(alphab))))); fi; else # donna what to do with this... sfa; fi; elif type(alphab, `+`) then # Sum of two alphabets... if (base='p') then `SFA/SfACollect`( expand(convert([ seq( `SFA/SfAExpand`(p[part[i]](op(1, alphab))) + `SFA/SfAExpand`(p[part[i]](convert([op(2..nops(alphab), alphab)], `+`))), i=1..nops(part)) ], `*`)), 'p'); elif (base='e') then `SFA/ToeA`(expand(convert([ seq(convert([ seq( `SFA/SfAExpand`(e[subs(0=NULL,part[i]-j)](op(1, alphab))) * `SFA/SfAExpand`(e[subs(0=NULL,j)] (convert([op(2..nops(alphab), alphab)], `+`))), j=0..part[i]) ], `+`), i=1..nops(part)) ], `*`))); elif (base='h') then `SFA/TohA`(expand(convert([ seq(convert([ seq( `SFA/SfAExpand`(h[subs(0=NULL,part[i]-j)](op(1, alphab))) * `SFA/SfAExpand`(h[subs(0=NULL,j)] (convert([op(2..nops(alphab), alphab)], `+`))), j=0..part[i]) ], `+`), i=1..nops(part)) ], `*`))); elif (base='s') then lp := `PART/ListPartIn`(part); expand( convert([ seq(`SFA/TosA`(`SFA/SfAExpand`( # VP100299 s[op(lp[i])](convert([op(1..nops(alphab)-1, alphab)], `+`))) * `SFA/SfAExpand`((`SYMF/SfDiff`(s[op(lp[i])], s[op(part)])) (op(nops(alphab), alphab)))), i=1..nops(lp))], `+`)); elif (base='m') then lp := `PART/SplitPart`(part, 2); convert([ seq(`SFA/TomA`(expand(`SFA/SfAExpand`( # VP100299 m[op(lp[i][1])](op(1, alphab))) * `SFA/SfAExpand`(m[op(lp[i][2])] (convert([op(2..nops(alphab), alphab)], `+`))))), i=1..nops(lp))], `+`); fi; elif `TYP/IsArgAlphabet/simple`(alphab) then # Alphabet is a single alphabet Ai... sfa; elif `TYP/IsVariable`(alphab) then # Alphabet is a variable... VP120298... if (base=`p`) or (base=`h`) then alphab^(convert(part,`+`)); elif (base=`e`) then if part=[] then 1; elif part=[1] then alphab; else 0; fi; elif (base=`s`) or (base=`m`) then if part=[] then 1; elif nops(part)=1 then alphab^(part[1]); else 0; fi; fi; elif (type(alphab, function) and (`TYP/IspA`(alphab) or `TYP/IseA`(alphab) or `TYP/IshA`(alphab) or `TYP/IssA`(alphab) or `TYP/IsmA`(alphab))) then # Alphabet may be a symmetric function... if (`TYP/IspA`(alphab) and base='p' and `TYP/IsArgAlphabet/simple`(op(1, alphab))) then p[op(sort([ seq(op(map((n,m) -> n*m, [op(op(0, alphab))],part[i])), i=1..nops(part))], (x,y) -> evalb(x>y)))](op(1, alphab)); else `SFA/SfAExpand`(`SFA/TopA`(base[op(part)] (`SFA/TopA`(`SFA/SfAExpand`(alphab))))); fi; else # Alphabet is a numerical/formal constant... if (base=`p`) then alphab^nops(part); elif (base=`e`) then convert( [seq(convert([seq(alphab-j, j=0..part[i]-1)], `*`)/factorial(part[i]), i=1..nops(part))], `*`); elif (base=`h`) then convert( [seq(convert([seq(alphab+j, j=0..part[i]-1)], `*`)/factorial(part[i]), i=1..nops(part))], `*`); elif (base=`s`) then convert([seq(seq(alphab-i+j ,j=1..part[i]), i=1..nops(part))], `*`)/ convert(`PART/Part2ListHook`(part), `*`); elif (base=`m`) then v := `PART/Part2Exp`(part); convert([seq(alphab-i, i=0..nops(v)-1)], `*`) / convert(map(factorial, v), `*`); fi; fi; else sfa; fi; end; # # No special check is made, since sfa must be first decomposed # VP120997 `SFA/SfAExpand/check` := proc(sfa) end; # # VP120997 `SFA/SfAExpand/interface` := proc(sfa) `SFA/SfAExpand`(args); end; # # VP120997 `SFA_PACK/SfAExpand` := proc(sfa) `SFA/SfAExpand/check`(args); `SFA/SfAExpand/interface`(args); end; # savelib(`SFA/SfAExpand`, `SFA/SfAExpand.m`); savelib(`SFA/SfAExpand/interface`, `SFA/SfAExpand/interface.m`); savelib(`SFA/SfAExpand/check`, `SFA/SfAExpand/check.m`); savelib(`SFA_PACK/SfAExpand`, `SFA_PACK/SfAExpand.m`); # if (not assigned(_NOQUIT)) then quit; fi; ########## # File @(#) Tab2Mat (TAB PACKAGE) Sat Dec 31 16:08:39 Frh 1994 ########## interface(verboseproc=0); # # Tab2Mat(t) converts a tableau (list of lists) into a tableau (matrix). # Indeed, one may represent a tableau by a matrix. # # convertit un tableau (liste de listes) en un tableau (matrice). # En effet, on peut representer un tableau par une matrice. # # SV021094 SV100598 `TAB/Tab2Mat`:=proc(t) local nl, # number of lines... nc, # number of columns... i; # variable for sequence... nl:=nops(t); if (nl=0) then eval(linalg['matrix'](1,1,[` `])) else nc:=max(op(map(nops,t))); if (nc=0) then eval(linalg['matrix'](nl,1,[seq(` `, i=1..nl)])) else eval(linalg['matrix'](nl,nc, map(op, [seq([op(t[i]),(` `$nc-nops(t[i]))], i=1..nl)]))) fi fi end; # # SV240497 `TAB/Tab2Mat/interface`:=proc(t) `TAB/Tab2Mat`(args); end; # # This is the same function but for the TAB package so that it provides # some verifications on the arguments. # # SV051094 `TAB/Tab2Mat/check`:=proc(t) # checking types... if (not TYP['IsTab'](t)) then ERR['TABPerror'](1,procname) fi; end; # # SV160497 `TAB_PACK/Tab2Mat`:=proc(t) `TAB/Tab2Mat/check`(args); `TAB/Tab2Mat/interface`(args) end; # savelib(`TAB/Tab2Mat`, `TAB/Tab2Mat.m`); savelib(`TAB/Tab2Mat/interface`, `TAB/Tab2Mat/interface.m`); savelib(`TAB/Tab2Mat/check`, `TAB/Tab2Mat/check.m`); savelib(`TAB_PACK/Tab2Mat`, `TAB_PACK/Tab2Mat.m`); # if (not assigned(_NOQUIT)) then quit; fi; ########## # File @(#) ToXfix (FM PACKAGE) Fri Mar 8 11:47:04 MET 1996 ########## interface(verboseproc=0); # # ToXfix(pol,b) expresses pol on the X basis assuming that pol is expressed solely in # terms of the base b (x, X, Y). # Whenever the second argument is forgotten # no suppositions are made on the bases appearing in pol. # pol is expanded before any computation except when the argument # noexpand specifies that no expansion should be done. # The result is NOT collected with respect to X[...], ... # # exprime pol sur la base X en considerant pol comme exprime uniquement # sur la base b (x, X, Y). Si le deuxieme argument manque, # aucune supposition n'est faite quant aux bases apparaissant dans # l'expression de pol. # pol est etendu sauf si l'argument noexpand specifie le contraire. # Le resultat n'est PAS collecte par rapport a X[...], ... # # SV080396 SV290797 SV311098 `FM/ToXfix/heart`:=proc(pol) local i, # indices of a table... j, # variable for loop... k, # variable for sequence... ind, # indices... r, # the result... u, # temporary result... t; # a table representing a monomial... global _FMn, # cardinal of the alphabet... FMBases; # known bases... if (nargs=1) then if (type(pol,`+`)) then # we convert each monomial... RETURN(map(`FM/ToXfix/heart`,pol)) fi; # this is a monomial... t:=`FM/Monomial`(pol,FMBases); if ({indices(t)} minus {['coeff']} = {['X']}) then # we have only some X... r:=t['coeff']; t['coeff']:='t[coeff]'; r:=r*`FM/Xmonom2Xfix`(t['X']); RETURN(`FM/Collect`(r)) elif (not assigned(t['Y'])) then # we treat the table... ind:=indices(t); for i in ind do if (op(i)='coeff') then next elif (op(i)='x') then t['x']:=`FM/x2Xfix`(t['x']) elif (op(i)='X') then t['X']:=`FM/Xmonom2Xfix`(t['X']) fi od; r:=t['coeff']; t['coeff']:='t[coeff]'; if (ind=['coeff']) then RETURN(r) else r:=r*`FM/ToXfix/heart`(expand(convert(map(op,[entries(t)]),`*`))); RETURN(`FM/Collect`(r)) fi elif (type(t['Y'],indexed)) then # we treat the table... for i in indices(t) do if (op(i)='coeff') then next elif (op(i)='x') then t['x']:=`FM/x2Xfix`(t['x']) elif (op(i)='X') then t['X']:=`FM/Xmonom2Xfix`(t['X']) elif (op(i)='Y') then t['Y']:=`FM/X2Xfix`(`SP/Y2X`(t['Y'],noexpand)) fi od; r:=t['coeff']; t['coeff']:='t[coeff]'; r:=r*`FM/ToXfix/heart`(expand(convert(map(op,[entries(t)]),`*`))); RETURN(`FM/Collect`(r)) elif (type(t['Y'],`^`)) then # we treat the table... for i in indices(t) do if (op(i)='coeff') then next elif (op(i)='x') then t['x']:=`FM/x2Xfix`(t['x']) elif (op(i)='X') then t['X']:=`FM/Xmonom2Xfix`(t['X']) elif (op(i)='Y') then t['Y']:=`FM/Xmonom2Xfix`(`SP/Y2X`(op(1,t['Y']),noexpand)^(op(2,t['Y']))) fi od; r:=t['coeff']; t['coeff']:='t[coeff]'; r:=r*`FM/ToXfix/heart`(expand(convert(map(op,[entries(t)]),`*`))); RETURN(`FM/Collect`(r)) else # t['Y'] is a product of Y Schubert polynomials... for i in indices(t) do if (op(i)='coeff') then next elif (op(i)='x') then t['x']:=`FM/x2Xfix`(t['x']) elif (op(i)='X') then t['X']:=`FM/Xmonom2Xfix`(t['X']) elif (op(i)='Y') then t['Y']:=`FM/Xmonom2Xfix`(map(`SP/Y2X`,t['Y'],noexpand)) fi od; r:=t['coeff']; t['coeff']:='t[coeff]'; r:=r*`FM/ToXfix/heart`(expand(convert(map(op,[entries(t)]),`*`))); RETURN(`FM/Collect`(r)) fi else if (not member(args[2],FMBases)) then ERR['FMPerror'](11,procname) fi; if (args[2]='X') then if (nargs >= 3 and args[3]='collect') then # we collect the result... RETURN(`FM/Collect`(pol)) fi; RETURN(pol) fi; if (type(pol,`+`)) then # we convert each monomial... RETURN(map(`FM/ToXfix/heart`,args[1..nargs])) fi; # this is a monomial... t:=`FM/Monomial`(pol,args[2]); # pol is solely expressed on args[2] basis... if (args[2]='x') then if (assigned(t[args[2]])) then r:=t['coeff']*`FM/x2Xfix`(t[args[2]]) else r:=convert(map(op,[entries(t)]),`*`) fi; if (nargs >= 3 and args[3]='collect') then # we collect the result... RETURN(`FM/Collect`(r)) fi; RETURN(r) elif (args[2]='Y') then if (assigned(t[args[2]])) then if (type(t[args[2]], 'indexed')) then r:=t['coeff']*`FM/X2Xfix`(`SP/Y2X`(t[args[2]])) else r:=t['coeff']*`FM/Xmonom2Xfix`(map(`SP/Y2X`, t[args[2]])) fi else r:=convert(map(op,[entries(t)]),`*`) fi; if (nargs >= 3 and args[3]='collect') then # we collect the result... RETURN(`FM/Collect`(r)) fi; RETURN(r) fi fi end; # # Xmonom2Xfix(sp) from a product of Schubert polynomials of Sn to the X basis. # # d'un produit de polynomes de Schubert de Sn a la base X. # # SV290496 SV060398 `FM/Xmonom2Xfix`:=proc(sp) local save_CLGn, # _CLGn... save_Sn, # _Sn... i, # variable for loop... t, # a table... ta, # a table... flag, # a flag... r; # the result... global _FMn, # cardinal of the alphabet... _CLGn, # degree of the linear group... _Sn; # fixed degree of the symmetric group... t:=cat(`FM/data/XmXfix`, _FMn); if (type(t, table)) then # this is the case where the table of pre-computed data is loaded... if (type(sp, indexed)) then RETURN(sp) elif (type(sp, `^`)) then save_Sn:=_Sn; `SP/Flag`(-1, 'dontforget'); r:=op(1, sp); for i from 2 to op(2, sp) do if (type(r, indexed)) then if (assigned(t[ [op(r)], [op(op(1, sp))] ])) then r:=t[ [op(r)], [op(op(1, sp))] ] else r:=t[ [op(op(1, sp))], [op(r)] ] fi elif (type(r, `*`)) then r:=map(proc(mono, perm, t) if (type(mono, `indexed`)) then if (op(0, mono)=`X`) then if (assigned(t[ [op(mono)], perm ])) then RETURN(t[ [op(mono)], perm ]) else RETURN(t[ perm, [op(mono)] ]) fi fi; RETURN(mono) fi; RETURN(mono) end, r, [op(op(1, sp))], t); r:=`CLG/Tos_n`(r) else # r is a sum...because it can't be a `^`... r:=map(proc(mono, perm, t) map(proc(mono, perm, t) if (type(mono, `indexed`)) then if (op(0, mono)=`X`) then if (assigned(t[ [op(mono)], perm ])) then RETURN(t[ [op(mono)], perm ]) else RETURN(t[ perm, [op(mono)] ]) fi fi; RETURN(mono) fi; RETURN(mono) end, mono, perm, t) end, r, [op(op(1, sp))], t); r:=`CLG/Tos_n`(r) fi od; `SP/Flag`(save_Sn, 'dontforget'); RETURN(r) else save_Sn:=_Sn; `SP/Flag`(-1, 'dontforget'); flag:=false; for i from 1 to nops(sp) do if (type(op(i, sp), `^`)) then flag:=true; break fi od; if (flag) then RETURN(`FM/ToXfix/heart`( expand(map(`FM/Xmonom2Xfix`, sp)) )) fi; r:=op(1, sp); for i from 2 to nops(sp) do if (type(r, indexed)) then if (assigned(t[ [op(r)], [op(op(i, sp))] ])) then r:=t[ [op(r)], [op(op(i, sp))] ] else r:=t[ [op(op(i, sp))], [op(r)] ] fi elif (type(r, `*`)) then r:=map(proc(mono, perm, t) if (type(mono, `indexed`)) then if (op(0, mono)=`X`) then if (assigned(t[ [op(mono)], perm ])) then RETURN(t[ [op(mono)], perm ]) else RETURN(t[ perm, [op(mono)] ]) fi fi; RETURN(mono) fi; RETURN(mono) end, r, [op(op(i, sp))], t); r:=`CLG/Tos_n`(r) else # r is a sum...because it can't be a `^`... r:=map(proc(mono, perm, t) map(proc(mono, perm, t) if (type(mono, `indexed`)) then if (op(0, mono)=`X`) then if (assigned(t[ [op(mono)], perm ])) then RETURN(t[ [op(mono)], perm ]) else RETURN(t[ perm, [op(mono)] ]) fi fi; RETURN(mono) fi; RETURN(mono) end, r, perm, t) end, r, [op(op(i, sp))], t); r:=`CLG/Tos_n`(r) fi od; `SP/Flag`(save_Sn, 'dontforget'); RETURN(r) fi else # this is the case where the table of pre-computed data is not loaded... save_Sn:=_Sn; `SP/Flag`(-1, 'dontforget'); r:=`SP/ToX/heart`(sp); `SP/Flag`(save_Sn, 'dontforget'); RETURN(`FM/X2Xfix`(r)) fi end; # # SV290496 `FM/ToXfix`:=proc(pol) if (nargs=1) then RETURN(`FM/ToXfix/heart`(expand(pol))) elif (nargs=2) then if (args[2]='noexpand') then RETURN(`FM/ToXfix/heart`(pol)) elif (args[2]='collect') then RETURN(`FM/ToXfix/heart`(`FM/ToXfix/heart`(expand(pol)),'X',collect)) fi; RETURN(`FM/ToXfix/heart`(expand(pol),args[2])) elif (nargs=3) then if (args[2]='noexpand') then if (args[3]='collect') then RETURN(`FM/ToXfix/heart`(`FM/ToXfix/heart`(pol),'X',collect)) fi; RETURN(`FM/ToXfix/heart`(pol,args[3])) elif (args[3]='collect') then RETURN(`FM/ToXfix/heart`(expand(pol),args[2..nargs])) else ERR['FMPerror'](9,procname) fi; fi; if (args[2]<>'noexpand') then ERR['FMPerror'](4,procname) elif (args[4]<>'collect') then ERR['FMPerror'](6,procname) fi; RETURN(`FM/ToXfix/heart`(`FM/ToXfix/heart`(pol,args[3]),'X',args[4])) end; # # SV240497 `FM/ToXfix/interface`:=proc(pol) `FM/ToXfix`(args); end; # # SV230497 `FM/ToXfix/check`:=proc(pol) end; # # SV240497 `FM_PACK/ToXfix`:=proc(pol) `FM/ToXfix/check`(args); `FM/ToXfix/interface`(args); end; # savelib(`FM/ToXfix/heart`, `FM/ToXfix/heart.m`); savelib(`FM/Xmonom2Xfix`, `FM/Xmonom2Xfix.m`); savelib(`FM/ToXfix`, `FM/ToXfix.m`); savelib(`FM/ToXfix/interface`, `FM/ToXfix/interface.m`); savelib(`FM/ToXfix/check`, `FM/ToXfix/check.m`); savelib(`FM_PACK/ToXfix`, `FM_PACK/ToXfix.m`); # if (not assigned(_NOQUIT)) then quit; fi; ########## # File @(#) ToXfixSc (FM PACKAGE) Tue Apr 30 10:52:29 METDST 1996 ########## interface(verboseproc=0); # # ToXfixScal(pol,b) expresses pol on the X basis assuming that pol is # expressed solely in terms of the base b (x, X, Y). # Is uses scalar products instead of Monk for instance. # Whenever the second argument is forgotten # no suppositions are made on the bases appearing in pol. # pol is expanded before any computation except when the argument # noexpand specifies that no expansion should be done. # The result is NOT collected with respect to X[...], ... # # exprime pol sur la base X en considerant pol comme # exprime uniquement sur la base b (x, X, Y). La fonction utilise # des produits scalaires au lieu de Monk par exemple. # Si le deuxieme argument manque, # aucune supposition n'est faite quant aux bases apparaissant dans # l'expression de pol. # pol est etendu sauf si l'argument noexpand specifie le contraire. # Le resultat n'est PAS collecte par rapport a X[...], ... # # SV300496 SV290797 SV311098 `FM/ToXfixScal/heart`:=proc(pol) local i, # indices of a table... j, # variable for loop... k, # variable for sequence... ind, # indices... r, # the result... u, # temporary result... t; # a table representing a monomial... global _FMn, # cardinal of the alphabet... FMBases; # known bases... if (nargs=1) then if (type(pol,`+`)) then # we convert each monomial... RETURN(map(`FM/ToXfixScal/heart`,pol)) fi; # this is a monomial... t:=`FM/Monomial`(pol,FMBases); if ({indices(t)} minus {['coeff']} = {['X']}) then # we have only some X... r:=t['coeff']; t['coeff']:='t[coeff]'; r:=r*`FM/Xmonom2XfixScal`(t['X']); RETURN(`FM/Collect`(r)) elif (not assigned(t['Y'])) then # we treat the table... ind:=indices(t); for i in ind do if (op(i)='coeff') then next elif (op(i)='x') then t['x']:=`FM/x2XfixScal`(t['x']) elif (op(i)='X') then t['X']:=`FM/Xmonom2XfixScal`(t['X']) fi od; r:=t['coeff']; t['coeff']:='t[coeff]'; if (ind=['coeff']) then RETURN(r) else r:=r*`FM/ToXfixScal/heart`(expand(convert(map(op,[entries(t)]),`*`))); RETURN(`FM/Collect`(r)) fi elif (type(t['Y'],indexed)) then # we treat the table... for i in indices(t) do if (op(i)='coeff') then next elif (op(i)='x') then t['x']:=`FM/x2XfixScal`(t['x']) elif (op(i)='X') then t['X']:=`FM/Xmonom2XfixScal`(t['X']) elif (op(i)='Y') then t['Y']:=`FM/X2Xfix`(`SP/Y2X`(t['Y'],noexpand)) fi od; r:=t['coeff']; t['coeff']:='t[coeff]'; r:=r*`FM/ToXfixScal/heart`(expand(convert(map(op,[entries(t)]),`*`))); RETURN(`FM/Collect`(r)) elif (type(t['Y'],`^`)) then # we treat the table... for i in indices(t) do if (op(i)='coeff') then next elif (op(i)='x') then t['x']:=`FM/x2XfixScal`(t['x']) elif (op(i)='X') then t['X']:=`FM/Xmonom2XfixScal`(t['X']) elif (op(i)='Y') then t['Y']:=`FM/Xmonom2XfixScal`(`SP/Y2X`(op(1,t['Y']),noexpand)^(op(2,t['Y']))) fi od; r:=t['coeff']; t['coeff']:='t[coeff]'; r:=r*`FM/ToXfixScal/heart`(expand(convert(map(op,[entries(t)]),`*`))); RETURN(`FM/Collect`(r)) else # t['Y'] is a product of Y Schubert polynomials... for i in indices(t) do if (op(i)='coeff') then next elif (op(i)='x') then t['x']:=`FM/x2XfixScal`(t['x']) elif (op(i)='X') then t['X']:=`FM/Xmonom2XfixScal`(t['X']) elif (op(i)='Y') then t['Y']:=`FM/Xmonom2XfixScal`(map(`SP/Y2X`,t['Y'],noexpand)) fi od; r:=t['coeff']; t['coeff']:='t[coeff]'; r:=r*`FM/ToXfixScal/heart`(expand(convert(map(op,[entries(t)]),`*`))); RETURN(`FM/Collect`(r)) fi else if (not member(args[2],FMBases)) then ERR['FMPerror'](11,procname) fi; if (args[2]='X') then if (nargs >= 3 and args[3]='collect') then # we collect the result... RETURN(`FM/Collect`(pol)) fi; RETURN(pol) fi; if (type(pol,`+`)) then # we convert each monomial... RETURN(map(`FM/ToXfixScal/heart`,args[1..nargs])) fi; # this is a monomial... t:=`FM/Monomial`(pol,args[2]); # pol is solely expressed on args[2] basis... if (args[2]='x') then if (assigned(t[args[2]])) then r:=t['coeff']*`FM/x2XfixScal`(t[args[2]]) else r:=convert(map(op,[entries(t)]),`*`) fi; if (nargs >= 3 and args[3]='collect') then # we collect the result... RETURN(`FM/Collect`(r)) fi; RETURN(r) elif (args[2]='Y') then if (assigned(t[args[2]])) then if (type(t[args[2]], 'indexed')) then r:=t['coeff']*`FM/X2Xfix`(`SP/Y2X`(t[args[2]])) else r:=t['coeff']*`FM/Xmonom2XfixScal`(map(`SP/Y2X`, t[args[2]])) fi else r:=convert(map(op,[entries(t)]),`*`) fi; if (nargs >= 3 and args[3]='collect') then # we collect the result... RETURN(`FM/Collect`(r)) fi; RETURN(r) fi fi end; # # Xmonom2XfixScal(sp) from a product of Schubert polynomials of Sn to the X basis. # # d'un produit de polynomes de Schubert de Sn a la base X. # # SV300496 SV060398 `FM/Xmonom2XfixScal`:=proc(sp) local save_CLGn, # _CLGn... save_Sn, # _Sn... i, # variable for loop... t, # a table... ta, # a table... flag, # a flag... r; # the result... global _FMn, # cardinal of the alphabet... _CLGn, # degree of the linear group... _Sn; # fixed degree of the symmetric group... t:=cat(`FM/data/XmXfix`, _FMn); if (type(t, table)) then # this is the case where the table of pre-computed data is loaded... if (type(sp, indexed)) then RETURN(sp) elif (type(sp, `^`)) then save_Sn:=_Sn; `SP/Flag`(-1, 'dontforget'); r:=op(1, sp); for i from 2 to op(2, sp) do if (type(r, indexed)) then if (assigned(t[ [op(r)], [op(op(1, sp))] ])) then r:=t[ [op(r)], [op(op(1, sp))] ] else r:=t[ [op(op(1, sp))], [op(r)] ] fi elif (type(r, `*`)) then r:=map(proc(mono, perm, t) if (type(mono, `indexed`)) then if (op(0, mono)=`X`) then if (assigned(t[ [op(mono)], perm ])) then RETURN(t[ [op(mono)], perm ]) else RETURN(t[ perm, [op(mono)] ]) fi fi; RETURN(mono) fi; RETURN(mono) end, r, [op(op(1, sp))], t); r:=`CLG/Tos_n`(r) else # r is a sum...because it can't be a `^`... r:=map(proc(mono, perm, t) map(proc(mono, perm, t) if (type(mono, `indexed`)) then if (op(0, mono)=`X`) then if (assigned(t[ [op(mono)], perm ])) then RETURN(t[ [op(mono)], perm ]) else RETURN(t[ perm, [op(mono)] ]) fi fi; RETURN(mono) fi; RETURN(mono) end, mono, perm, t) end, r, [op(op(1, sp))], t); r:=`CLG/Tos_n`(r) fi od; `SP/Flag`(save_Sn, 'dontforget'); RETURN(r) else save_Sn:=_Sn; `SP/Flag`(-1, 'dontforget'); flag:=false; for i from 1 to nops(sp) do if (type(op(i, sp), `^`)) then flag:=true; break fi od; if (flag) then RETURN(`FM/ToXfixScal/heart`( expand(map(`FM/Xmonom2XfixScal`, sp)) )) fi; r:=op(1, sp); for i from 2 to nops(sp) do if (type(r, indexed)) then if (assigned(t[ [op(r)], [op(op(i, sp))] ])) then r:=t[ [op(r)], [op(op(i, sp))] ] else r:=t[ [op(op(i, sp))], [op(r)] ] fi elif (type(r, `*`)) then r:=map(proc(mono, perm, t) if (type(mono, `indexed`)) then if (op(0, mono)=`X`) then if (assigned(t[ [op(mono)], perm ])) then RETURN(t[ [op(mono)], perm ]) else RETURN(t[ perm, [op(mono)] ]) fi fi; RETURN(mono) fi; RETURN(mono) end, r, [op(op(i, sp))], t); r:=`CLG/Tos_n`(r) else # r is a sum...because it can't be a `^`... r:=map(proc(mono, perm, t) map(proc(mono, perm, t) if (type(mono, `indexed`)) then if (op(0, mono)=`X`) then if (assigned(t[ [op(mono)], perm ])) then RETURN(t[ [op(mono)], perm ]) else RETURN(t[ perm, [op(mono)] ]) fi fi; RETURN(mono) fi; RETURN(mono) end, r, perm, t) end, r, [op(op(i, sp))], t); r:=`CLG/Tos_n`(r) fi od; `SP/Flag`(save_Sn, 'dontforget'); RETURN(r) fi else # this is the case where the table of pre-computed data is not loaded... save_Sn:=_Sn; `SP/Flag`(-1, 'dontforget'); r:=`SP/ToX/heart`(sp); `SP/Flag`(save_Sn, 'dontforget'); RETURN(`FM/X2Xfix`(r)) fi end; # # SV300496 `FM/ToXfixScal`:=proc(pol) if (nargs=1) then RETURN(`FM/ToXfixScal/heart`(expand(pol))) elif (nargs=2) then if (args[2]='noexpand') then RETURN(`FM/ToXfixScal/heart`(pol)) elif (args[2]='collect') then RETURN(`FM/ToXfixScal/heart`(`FM/ToXfixScal/heart`(expand(pol)),'X',collect)) fi; RETURN(`FM/ToXfixScal/heart`(expand(pol),args[2])) elif (nargs=3) then if (args[2]='noexpand') then if (args[3]='collect') then RETURN(`FM/ToXfixScal/heart`(`FM/ToXfixScal/heart`(pol),'X',collect)) fi; RETURN(`FM/ToXfixScal/heart`(pol,args[3])) elif (args[3]='collect') then RETURN(`FM/ToXfixScal/heart`(expand(pol),args[2..nargs])) else ERR['FMPerror'](9,procname) fi; fi; if (args[2]<>'noexpand') then ERR['FMPerror'](4,procname) elif (args[4]<>'collect') then ERR['FMPerror'](6,procname) fi; RETURN(`FM/ToXfixScal/heart`(`FM/ToXfixScal/heart`(pol,args[3]),'X',args[4])) end; # # SV240497 `FM/ToXfixScal/interface`:=proc(pol) `FM/ToXfixScal`(args); end; # # SV230497 `FM/ToXfixScal/check`:=proc(pol) end; # # SV240497 `FM_PACK/ToXfixScal`:=proc(pol) `FM/ToXfixScal/check`(args); `FM/ToXfixScal/interface`(args); end; # savelib(`FM/ToXfixScal/heart`, `FM/ToXfixScal/heart.m`); savelib(`FM/Xmonom2XfixScal`, `FM/Xmonom2XfixScal.m`); savelib(`FM/ToXfixScal`, `FM/ToXfixScal.m`); savelib(`FM/ToXfixScal/interface`, `FM/ToXfixScal/interface.m`); savelib(`FM/ToXfixScal/check`, `FM/ToXfixScal/check.m`); savelib(`FM_PACK/ToXfixScal`, `FM_PACK/ToXfixScal.m`); # if (not assigned(_NOQUIT)) then quit; fi; ########## # File @(#) ListTab (TAB PACKAGE) Tue Jan 9 16:45:39 MET 1996 ########## interface(verboseproc=0); # # ListTab(shape, comp) builds the list of all tableaux of a given shape # and a given evaluation comp (composition). # If comp is increasing then it is more efficient. # One can also give a tableau (list of lists in fact) # describing minimal entries in the result # (mintab=[[-infinity, 5], [1,6]] for instance). # # construit la liste de tous les tableaux d'une forme # shape donnee et d'evaluation comp donnee (composition). # Si comp est croissante, c'est plus efficace. # On peut aussi specifier un tableau (liste de listes # en fait) decrivant les entrees minimales dans le # resultat (mintab=[[-infinity, 5], [1,6]] par exemple). # # Remarque: je pense qu'il y a moyen de faire la construction directe du # tableau (et non pas de la matrice de 0 et 1 puis de la matrice au sens # du tableau en deux dimensions puis du tableau code par ligne) car avec # les longueurs de chaque ligne du tableau, on doit pouvoir savoir sans # difficulte la place des lettres que l'on vient de rajouter...a voir... # # SV090196 SV140196 SV220497 `TAB/NbTab/rec`:=proc(conjs, comp, ininconjs, inincomp) local res, # the result... ncomp, # nops(comp)... nconjs; # nops(conjs)... # this option remember implies to put a map(copy, recursive call) # at the end of the function. Otherwise it does not work because # all matrices are the same at the end... # option remember; # in fact, sometimes conjs, comp are the same for some ininconjs, inincomp # different so we manage ourselves the remember table... if (op(4, op(procname))<>NULL) then if (assigned(op(4, op(procname))[conjs, comp])) then RETURN(op(4, op(procname))[conjs, comp]) fi fi; ncomp:=nops(comp); nconjs:=nops(conjs); if (comp[1]>nconjs) then res:=0; `TAB/NbTab/rec`(conjs, comp):=res; res else if (ncomp=1) then res:=1; `TAB/NbTab/rec`(conjs, comp):=res; res else res:=convert(map(proc(v, conjs, nconjs, newcomp, ncomp, ininconjs, inincomp) local i, j, newconjs; newconjs:=[seq(conjs[i]-v[i], i=1..nconjs)]; if (newconjs[1]=-1) then 0 else for j from 2 to nconjs do if ((newconjs[j]>newconjs[j-1]) or (newconjs[j]=-1)) then RETURN(0) fi od; # newconjs is a partition with eventually some # 0's at the end... `TAB/NbTab/rec`(subs(0=NULL, newconjs), newcomp, ininconjs, inincomp) fi end, `SG/ListPerm`([1$comp[1],0$(nconjs-comp[1])]), conjs, nconjs, [op(2..ncomp, comp)], ncomp, ininconjs, inincomp), `+`); `TAB/NbTab/rec`(conjs, comp):=res; res fi fi end; # # SV190597 `TAB/NbTab/elem`:=proc(shape, comp) local i, # variable for sequence... res, # the result... conjs; # conjugate shape... if (convert(shape, `+`)<>convert(comp, `+`)) then 0 else if (shape=[]) then # comp=[] because of the previous test... 1 else # both shape and comp are not empty... conjs:=`PART/Part2Conjugate`(shape); if (nargs=3) then res:=`TAB/NbTab/rec`(conjs, [seq(comp[-i], i=-nops(comp)..-1)], nops(conjs), nops(comp)); forget(`TAB/NbTab/rec`); else # we do not forget the result because an internal function # needs to remember. Moreover, this internal function will # forget at the end (cf. SYMF/s2m)... res:=`TAB/NbTab/rec`(conjs, [seq(comp[-i], i=-nops(comp)..-1)], nops(conjs), nops(comp)) fi; res fi fi end; # # SV190597 `TAB/NbTab`:=proc(shape, evalu) `TAB/NbTab/elem`(shape, subs(0=NULL, evalu), args[3..nargs]) end; # # SV090196 SV140196 SV220497 SV071197 `TAB/NbTab/mintab/rec`:=proc(conjs, comp, ininconjs, inincomp, mmini) local i, # variable for loop... res, # the result... ncomp, # nops(comp)... nconjs; # nops(conjs)... # this option remember implies to put a map(copy, recursive call) # at the end of the function. Otherwise it does not work because # all matrices are the same at the end... # option remember; # in fact, sometimes conjs, comp are the same for some ininconjs, inincomp # different so we manage ourselves the remember table... if (op(4, op(procname))<>NULL) then if (assigned(op(4, op(procname))[conjs, comp, mmini])) then RETURN(op(4, op(procname))[conjs, comp, mmini]) fi fi; ncomp:=nops(comp); nconjs:=nops(conjs); if (comp[1]>nconjs) then res:=0; `TAB/NbTab/mintab/rec`(conjs, comp, mmini):=res; res else if (ncomp=1) then for i from 1 to comp[1] do if (1newconjs[j-1]) or (newconjs[j]=-1)) then RETURN(0) fi od; # newconjs is a partition with eventually some # 0's at the end... `TAB/NbTab/mintab/rec`(subs(0=NULL, newconjs), newcomp, ininconjs, inincomp, mmini) fi end, `SG/ListPerm`([1$comp[1],0$(nconjs-comp[1])]), conjs, nconjs, [op(2..ncomp, comp)], ncomp, ininconjs, inincomp, mmini), `+`); `TAB/NbTab/mintab/rec`(conjs, comp, mmini):=res; res fi fi end; # # SV190597 SV071197 `TAB/NbTab/mintab/elem`:=proc(shape, comp, mmini) local i, # variable for sequence... res, # the result... conjs; # conjugate shape... if (convert(shape, `+`)<>convert(comp, `+`)) then 0 else if (shape=[]) then # comp=[] because of the previous test... 1 else # both shape and comp are not empty... conjs:=`PART/Part2Conjugate`(shape); if (nargs=4) then res:=`TAB/NbTab/mintab/rec`(conjs, [seq(comp[-i], i=-nops(comp)..-1)], nops(conjs), nops(comp), mmini); forget(`TAB/NbTab/mintab/rec`); else # we do not forget the result because an internal function # needs to remember. Moreover, this internal function will # forget at the end (cf. SYMF/s2m)... res:=`TAB/NbTab/mintab/rec`(conjs, [seq(comp[-i], i=-nops(comp)..-1)], nops(conjs), nops(comp), mmini) fi; res fi fi end; # # SV190597 SV071197 SV130800 `TAB/NbTab/mintab`:=proc(shape, evalu, mini) local nmini, # new mini... mmini, # matrix mini... v, # a vector... i, # variable for loop... j,k, # variables for sequence... dec, # a counter... cnt, # another counter... seqs; # sequence for substitution... v:=subs(0=NULL, evalu); dec:=nops(evalu)-nops(v); if (shape<>[]) then nmini:=[op(1..nops(v), [seq([seq(-infinity, k=1..nops(op(1, shape)))], j=1..nops(v)-nops(op(2, mini))), op(op(2, mini))])]; nmini:=map(proc(l, n) local i; if (nops(l)0) then seqs:=seqs, i=cnt; cnt:=cnt+1 else seqs:=seqs, i=-infinity fi od; mmini:=subs({seqs}, eval(mmini)); if (nargs=4) then `TAB/NbTab/mintab/elem`(shape, v, mmini, args[4]); else `TAB/NbTab/mintab/elem`(shape, v, mmini); fi fi end; # # SV080196 SV220497 `TAB/ListTab/rec`:=proc(conjs, comp, ininconjs, inincomp) local k, # variable for sequence... ncomp, # nops(comp)... nconjs; # nops(conjs)... # this option remember implies to put a map(copy, recursive call) # at the end of the function. Otherwise it does not work because # all matrices are the same at the end... option remember; ncomp:=nops(comp); nconjs:=nops(conjs); if (comp[1]>nconjs) then [] else if (ncomp=1) then [linalg['matrix'](inincomp, ininconjs, [seq(0, k=1..(inincomp-1)*ininconjs), seq(1, k=1..comp[1]), seq(0, k=1..(ininconjs-comp[1]))])] else map(proc(v, conjs, nconjs, newcomp, ncomp, ininconjs, inincomp) local i, j, newconjs; newconjs:=[seq(conjs[i]-v[i], i=1..nconjs)]; if (newconjs[1]=-1) then NULL else for j from 2 to nconjs do if ((newconjs[j]>newconjs[j-1]) or (newconjs[j]=-1)) then RETURN(NULL) fi od; # newconjs is a partition with eventually some 0's at the end... op(map(proc(m, v, nconjs, ncomp, ininconjs, inincomp) local i; for i from 1 to nconjs do m[inincomp+1-ncomp,i]:=v[i] od; m end, map(copy, `TAB/ListTab/rec`(subs(0=NULL, newconjs), newcomp, ininconjs, inincomp)), v, nconjs, ncomp, ininconjs, inincomp)) fi end, `SG/ListPerm`([seq(1, k=1..comp[1]), seq(0, k=1..(nconjs-comp[1]))]), conjs, nconjs, [op(2..ncomp, comp)], ncomp, ininconjs, inincomp) fi fi end; # # SV080196 SV160496 SV220497 `TAB/ListTab/elem`:=proc(shape, comp) local i, # variable for sequence... res, # the result... conjs; # conjugate shape... if (convert(shape, `+`)<>convert(comp, `+`)) then [] else if (shape=[]) then # comp=[] because of the previous test... [[]] else # both shape and comp are not empty... conjs:=`PART/Part2Conjugate`(shape); # we conjugate the shape and compute the mirror image of # the evaluation because it is useful for the recursive call... res:=map(proc(mat01, nconjs, ncomp) local m, c, r, deb, k; m:=linalg['matrix'](ncomp, nconjs, [seq(` `, k=1..ncomp*nconjs)]); for c from 1 to nconjs do deb:=ncomp; r:=deb; while ((deb<>0) and (r<>0)) do while ((mat01[r, c]=0)) do r:=r-1; if (r=0) then break fi od; if (r=0) then deb:=0 else m[deb, c]:=ncomp+1-r; r:=r-1; deb:=deb-1 fi od od; subs([]=NULL, `TAB/Mat2Tab`(m)) end, `TAB/ListTab/rec`(conjs, [seq(comp[-i], i=-nops(comp)..-1)], nops(conjs), nops(comp)), nops(conjs), nops(comp)); forget(`TAB/ListTab/rec`); res fi fi end; # # SV080196 SV220497 SV071197 `TAB/ListTab/mintab/rec`:=proc(conjs, comp, ininconjs, inincomp, mmini) local i, # variable for loop... k, # variable for sequence... ncomp, # nops(comp)... nconjs; # nops(conjs)... # this option remember implies to put a map(copy, recursive call) # at the end of the function. Otherwise it does not work because # all matrices are the same at the end... option remember; ncomp:=nops(comp); nconjs:=nops(conjs); if (comp[1]>nconjs) then [] else if (ncomp=1) then for i from 1 to comp[1] do if (1newconjs[j-1]) or (newconjs[j]=-1)) then RETURN(NULL) fi od; # newconjs is a partition with eventually some 0's at the end... op(map(proc(m, v, nconjs, ncomp, ininconjs, inincomp) local i; for i from 1 to nconjs do m[inincomp+1-ncomp,i]:=v[i] od; m end, map(copy, `TAB/ListTab/mintab/rec`(subs(0=NULL, newconjs), newcomp, ininconjs, inincomp, mmini)), v, nconjs, ncomp, ininconjs, inincomp)) fi end, `SG/ListPerm`([seq(1, k=1..comp[1]), seq(0, k=1..(nconjs-comp[1]))]), conjs, nconjs, [op(2..ncomp, comp)], ncomp, ininconjs, inincomp, mmini) fi fi end; # # Tableaux generators with minimal entries given in the matrix mmini... # # SV080196 SV160496 SV220497 SV071197 `TAB/ListTab/mintab/elem`:=proc(shape, comp, mmini) local i, # variable for sequence... res, # the result... conjs; # conjugate shape... if (convert(shape, `+`)<>convert(comp, `+`)) then [] else if (shape=[]) then [[]] else conjs:=`PART/Part2Conjugate`(shape); res:=map(proc(mat01, nconjs, ncomp) local m, c, r, deb, k; m:=linalg['matrix'](ncomp, nconjs, [seq(` `, k=1..ncomp*nconjs)]); for c from 1 to nconjs do deb:=ncomp; r:=deb; while ((deb<>0) and (r<>0)) do while ((mat01[r, c]=0)) do r:=r-1; if (r=0) then break fi od; if (r=0) then deb:=0 else m[deb, c]:=ncomp+1-r; r:=r-1; deb:=deb-1 fi od od; subs([]=NULL, `TAB/Mat2Tab`(m)) end, `TAB/ListTab/mintab/rec`(conjs, [seq(comp[-i], i=-nops(comp)..-1)], nops(conjs), nops(comp), mmini), nops(conjs), nops(comp)); forget(`TAB/ListTab/mintab/rec`); res fi fi end; # # SV160496 SV220497 SV071197 SV130800 `TAB/ListTab/mintab`:=proc(shape, evalu, mini) local nmini, # new mini... mmini, # matrix mini... res, # the result... v, # a vector... i, # variable for loop... j,k, # variables for sequence... dec, # a counter... cnt, # another counter... seqs, # sequence for substitution... val; # a value... v:=subs(0=NULL, evalu); dec:=nops(evalu)-nops(v); if (shape<>[]) then nmini:=[op(1..nops(v), [seq([seq(-infinity, k=1..nops(op(1, shape)))], j=1..nops(v)-nops(op(2, mini))), op(op(2, mini))])]; nmini:=map(proc(l, n) local i; if (nops(l)0) then seqs:=seqs, i=cnt; cnt:=cnt+1 else seqs:=seqs, i=-infinity fi od; mmini:=subs({seqs}, eval(mmini)); res:=`TAB/ListTab/mintab/elem`(shape, v, mmini); for i from nops(evalu) by -1 to 1 do if (evalu[i]=0) then dec:=dec-1 else val:=i-dec; res:=subs(val=i, res) fi od; res fi end; # # SV240497 SV071197 `TAB/ListTab/interface`:=proc(shape, evalu) if (nargs=3 or nargs=4) then if (args[3]='nb') then if (nargs=4) then if (type(args[4], `=`)) then `TAB/NbTab/mintab`(args[1..2], args[4]); else # this is the case for instance in SYMF/s2m where # args[4] = `dontforget`... `TAB/NbTab`(args); fi else `TAB/NbTab`(args); fi else if (nargs=4) then `TAB/NbTab/mintab`(args); else `TAB/ListTab/mintab`(args); fi fi else `TAB/ListTab`(args); fi end; # # This is the same function but for the TAB package so that it provides # some verifications on the arguments. # # SV090196 SV160496 `TAB/ListTab/check`:=proc(shape, comp) local tab, # a tableau... i, j; # variables for loop... # checking types... if (not TYP['IsPart'](shape)) then ERR['TABPerror'](1,procname) fi; if (not type(comp, list)) then ERR['TABPerror'](3,procname) fi; for i from 1 to nops(comp) do if (not type(comp[i], nonnegint)) then ERR['TABPerror'](4,procname) fi od; if (nargs=3 or nargs=4) then if (type(args[3], symbol)) then if (args[3]<>'nb') then ERR['TABPerror'](6,procname) fi elif (type(args[3],`=`)) then if (type(op(1, args[3]), symbol)) then if (op(1, args[3])<>'mintab') then ERR['TABPerror'](6,procname) fi; tab:=op(2, args[3]); if (not type(tab, list)) then ERR['TABPerror'](6,procname) fi; for i from 1 to nops(tab) do if (not type(op(i, tab), list)) then ERR['TABPerror'](6,procname) fi; od fi else ERR['TABPerror'](5,procname) fi; if (nargs=4) then if (type(args[4], symbol)) then if (args[4]<>'nb') then ERR['TABPerror'](8,procname) fi elif (type(args[4],`=`)) then if (type(op(1, args[4]), symbol)) then if (op(1, args[4])<>'mintab') then ERR['TABPerror'](8,procname) fi; tab:=op(2, args[4]); if (not type(tab, list)) then ERR['TABPerror'](8,procname) fi; for i from 1 to nops(tab) do if (not type(op(i, tab), list)) then ERR['TABPerror'](8,procname) fi; od fi else ERR['TABPerror'](7,procname) fi; fi; elif (nargs<>2) then ERR['TABPerror'](9,procname) fi; end; # # SV160497 `TAB_PACK/ListTab`:=proc(shape, comp) `TAB/ListTab/check`(args); `TAB/ListTab/interface`(args) end; # # save `TAB/NbTab/rec`, # `TAB/NbTab/elem`, # `TAB/NbTab`, # `TAB/NbTab/mintab/rec`, # `TAB/NbTab/mintab/elem`, # `TAB/NbTab/mintab`, # `TAB/ListTab/rec`, # `TAB/ListTab/elem`, # `TAB/ListTab/mintab/rec`, # `TAB/ListTab/mintab/elem`, # `TAB/ListTab/mintab`, # `TAB/ListTab/interface`, # `TAB/ListTab/check`, # `TAB_PACK/ListTab`, # ``.TABLib.`/TAB/src/ListTab.m`; savelib(`TAB/NbTab/rec`, `TAB/NbTab/rec.m`); savelib(`TAB/NbTab/elem`, `TAB/NbTab/elem.m`); savelib(`TAB/NbTab`, `TAB/NbTab.m`); savelib(`TAB/NbTab/mintab/rec`, `TAB/NbTab/mintab/rec.m`); savelib(`TAB/NbTab/mintab/elem`, `TAB/NbTab/mintab/elem.m`); savelib(`TAB/NbTab/mintab`, `TAB/NbTab/mintab.m`); savelib(`TAB/ListTab/rec`, `TAB/ListTab/rec.m`); savelib(`TAB/ListTab/elem`, `TAB/ListTab/elem.m`); savelib(`TAB/ListTab/mintab/rec`, `TAB/ListTab/mintab/rec.m`); savelib(`TAB/ListTab/mintab/elem`, `TAB/ListTab/mintab/elem.m`); savelib(`TAB/ListTab/mintab`, `TAB/ListTab/mintab.m`); savelib(`TAB/ListTab/interface`, `TAB/ListTab/interface.m`); savelib(`TAB/ListTab/check`, `TAB/ListTab/check.m`); savelib(`TAB_PACK/ListTab`, `TAB_PACK/ListTab.m`); if (not assigned(_NOQUIT)) then quit; fi;