[Almost certainly not the most efficient program; constructs all isomorphism classes
of linking pairings on 2-groups of fixed order;
the sequence is obtained at the end by taking the number of isomorphism classes,
i.e. nops(TOUS(n)) = n-th term of the sequence; comments in French.]

RESOL1:= proc(k,Rho,Sigma)
local N,res, res1, res2, relevesolprov, relevesol;
N:=nops(Rho);

# cas ou l'on teste la premiere valeur (k = N) a droite du tableau:

if k = N and modp(Rho[k],2) = 1 then return({-1}): end if:
if k = N and modp(Rho[k],2) = 0 then return({0}): end if:

# tous les autres cas (k < N):

res:=sum(Rho[j],j=k+1..N);
res1:=res mod 2:
relevesolprov:={modp(res,8), modp(res + 2,8), modp(res + 4, 8), modp(res + 6,8)};
if Sigma[k+1] = -1 then relevesol:=relevesolprov else \
 res2:= sum(Rho[j],j=k+2..N) - Sigma[k+1] mod 2: \
 relevesol:={modp(res1,8), modp(res1+4,8)} intersect relevesolprov: end if;
if modp(Rho[k],2) = 1 then relevesol:={-1}: end if:
relevesol;
end proc;

  RESOL1 := proc(k, Rho, Sigma)
local N, res, res1, res2, relevesolprov, relevesol;
    N := nops(Rho);
    if k = N and modp(Rho[k], 2) = 1 then return {-1} end if;
    if k = N and modp(Rho[k], 2) = 0 then return {0} end if;
    res := sum(Rho[j], j = k + 1 .. N);
    res1 := res mod 2;
    relevesolprov := {modp(res, 8), modp(res + 2, 8),
        modp(res + 4, 8), modp(res + 6, 8)};
    if Sigma[k + 1] = -1 then relevesol := relevesolprov
    else
        res2 := (sum(Rho[j], j = k + 2 .. N) - Sigma[k + 1])
            mod 2;
        relevesol := {modp(res1, 8), modp(res1 + 4, 8)}
            intersect relevesolprov
    end if;
    if modp(Rho[k], 2) = 1 then relevesol := {-1} end if;
    relevesol
end proc

Un exemple d'utilisation de RESOL1:

A:=[1,0,2,1];nops(A);

                          A := [1, 0, 2, 1]


                                  4

B:=[0,0,1,-1]; # tableau construit jusqu'a SIGMA[3] (=1), reste a construire
               # SIGMA[2], SIGMA[1].


                          B := [0, 0, 1, -1]

RESOL1(2,A,B); # valeurs possibles de SIGMA[2]

                                {1, 5}

Fin de l'exemple d'utilisation de RESOL1







RECHTAB recherche les tableaux *standards* commencant a l'entier k ;
retourne les valeurs possibles pour SIGMA[k].
On suppose le tableau Sigma construit jusqu'a Sigma[k+1].
Les tableaux standards n'existent que si k est regulier.
RECHTAB:=proc(k,Rho,Sigma)

local fin,ListeV;

ListeV:={}: 

# On pourrait deja mettre la valeur "-1" parmi les valeurs possibles si le                             # rang est non nul, mais on s'occupe ici uniquement des valeurs regulieres a priori.


# Cas ou l'entier k est irregulier: pas de tableau standard a rechercher,
# la SEULE valeur possible est "-1".

if modp(Rho[k],2) = 1 then return({-1}): end if: 

# Cas ou l'indice k est indice maximal (et regulier):

if k = nops(Rho) then return({0}): end if: 

# premier cas: tableau standard 1
if k+2 <=nops(Rho) and Rho[k+1] = 0 and Rho[k+2] = 0 then return({Sigma[k+2] mod 8}): end if:

if k+1 = nops(Rho) and Rho[k+1] = 0 then return({0}): end if:

# deuxieme cas: tableau standard 2
if k+2<=nops(Rho) and Rho[k+1] = 1 and Sigma[k+2] <> -1 then return({Sigma[k+2]+1 mod 8,Sigma[k+2]+7 mod 8}): end if:

if k+1 = nops(Rho) and Rho[k+1] = 1 then return({1 mod 8, 7 mod 8}): end if:

# troisieme cas: tableau standard 3
if k+2<=nops(Rho) and Rho[k+1] = 2 and Sigma[k+1] = -1 and Sigma[k+2] <> -1 then \
 return({Sigma[k+2] mod 8,Sigma[k+2]+2 mod 8,Sigma[k+2]+6 mod 8}): end if:

if k+1 = nops(Rho) and Rho[k+1] = 2 and Sigma[k+1] = -1 then \
return({0 mod 8,2 mod 8,6 mod 8}): end if:

# quatrieme cas: tableau standard 4
if k+2<=nops(Rho) and Rho[k+1] > 0 and Sigma[k+1] <> -1 and Sigma[k+2] <> -1 then \
 return({Sigma[k+2] mod 8,Sigma[k+2]+4 mod 8}): end if:

if k+1 = nops(Rho) and Rho[k+1] > 0 and Sigma[k+1] <> -1 then \
return({0 mod 8, 4 mod 8}): end if:

end proc; 
 

  RECHTAB := proc(k, Rho, Sigma)
local fin, ListeV;
    ListeV := {};
    if modp(Rho[k], 2) = 1 then return {-1} end if;
    if k = nops(Rho) then return {0} end if;
    if
    k + 2 <= nops(Rho) and Rho[k + 1] = 0 and Rho[k + 2] = 0
    then return {Sigma[k + 2] mod 8}
    end if;
    if k + 1 = nops(Rho) and Rho[k + 1] = 0 then return {0}
    end if;
    if k + 2 <= nops(Rho) and Rho[k + 1] = 1 and
    Sigma[k + 2] <> -1 then return
        {(Sigma[k + 2] + 1) mod 8, (Sigma[k + 2] + 7) mod 8}
    end if;
    if k + 1 = nops(Rho) and Rho[k + 1] = 1 then
        return {1 mod 8, 7 mod 8}
    end if;
    if k + 2 <= nops(Rho) and Rho[k + 1] = 2 and
    Sigma[k + 1] = -1 and Sigma[k + 2] <> -1 then return {
        Sigma[k + 2] mod 8, (Sigma[k + 2] + 2) mod 8,
        (Sigma[k + 2] + 6) mod 8}
    end if;
    if k + 1 = nops(Rho) and Rho[k + 1] = 2 and
    Sigma[k + 1] = -1 then return {0 mod 8, 2 mod 8, 6 mod 8}
    end if;
    if k + 2 <= nops(Rho) and 0 < Rho[k + 1] and
    Sigma[k + 1] <> -1 and Sigma[k + 2] <> -1 then
        return {Sigma[k + 2] mod 8, (Sigma[k + 2] + 4) mod 8}
    end if;
    if k + 1 = nops(Rho) and 0 < Rho[k + 1] and
    Sigma[k + 1] <> -1 then return {0 mod 8, 4 mod 8}
    end if
end proc






Exemples d'utilisation de RECHTAB:


U:=[1,0,1,2];

                          U := [1, 0, 1, 2]

V:=[0,0,-1,0];

                          V := [0, 0, -1, 0]

RECHTAB(2,U,V); # Valeurs possibles de SIGMA[2]:

                                {1, 7}

U:=[1,0,1,1];

                          U := [1, 0, 1, 1]

V:=[0,0,-1,-1];

                         V := [0, 0, -1, -1]

RECHTAB(2,U,V); # Valeurs possibles de SIGMA[2] (imposees par la methode
                # des tableaux standards)
U:=[1,0,2,2];

                          U := [1, 0, 2, 2]

V:=[0,0,-1,0];

                          V := [0, 0, -1, 0]

RECHTAB(2,U,V); # Valeurs possibles de SIGMA[2]:

                              {0, 2, 6}

U:=[1,0,2,3];

                          U := [1, 0, 2, 3]

V:=[0,0,0,0];

                          V := [0, 0, 0, 0]

RECHTAB(4,U,V);

                                 {-1}

Fin d'exemples d'utilisation de RECHTAB



VALEUR(k,R,S) utilise les tableaux R et S partiellement remplis (jusqu'a k+1)
pour determiner toutes les valeurs
possibles de Sigma[k] (avec RESOL1 et RECHTAB).
VALEUR:=proc(k,Rho,Sigma)
local ENS:
ENS:=RESOL1(k,Rho,Sigma) intersect RECHTAB(k,Rho,Sigma);

# Des que le rang Rho[k] est non nul, la valeur "-1" est possible, on la rajoute ici:

if Rho[k] > 0 then return(ENS union {-1}) else return(ENS): end if:
end proc;


  VALEUR := proc(k, Rho, Sigma)
local ENS;
    ENS := RESOL1(k, Rho, Sigma) intersect
        RECHTAB(k, Rho, Sigma);
    if 0 < Rho[k] then return ENS union {-1}
    else return ENS
    end if
end proc

Exemple d'utilisation de VALEUR(k,R,S):
R:=[0,1,2,3,0,2];

                       R := [0, 1, 2, 3, 0, 2]

S:=[0,0,0,0,0,0];

                       S := [0, 0, 0, 0, 0, 0]

VALEUR(5,R,S);

                                {0, 4}

RECHTAB(5,R,S);

                                {0, 4}

RESOL1(5,R,S);

                                {0, 4}



Procedure pour calculer tous les tableaux admissibles si l'on dispose du tableau des rangs.

BIG:=proc(Rho)
local GrandeListep, GrandeListe, GrandeListecom, NouvelleListe, n, num, k,p,r,val:

GrandeListep:=[]:
NouvelleListe:={}:GrandeListe:={}:
n:=nops(Rho):
num:=1:
# Boucle pour le cran dans le tableau des rangs
# Les tableaux admissibles sont complets quand k = 0:
for k from n by -1 to 1 do
if nops(GrandeListe) > 0 then num:=nops(GrandeListe): end if:
      
    # Boucle pour la mise a jour de la liste des tableaux admissibles:
    for p from 1 to num do

    # On complete par des 0 a gauche le p-eme tableau de la grande liste:
    if k < n then GrandeListep:=GrandeListe[p]: end if:    
    GrandeListecom:=[seq(0,i=1..k),op(GrandeListep)]: # Tableau complete      

          # Boucle pour la mise a jour de la valeur au cran k
          # chaque valeur possible donne un (morceau de) tableau admissible
          # pour le calcul des valeurs possibles, on fait appel a la procedure VALEUR
          # on met a jour ensuite une nouvelle grande liste:
          for r from 1 to nops(VALEUR(k,Rho,GrandeListecom)) do

              val:=[op(VALEUR(k,Rho,GrandeListecom))][r]:
              NouvelleListe:= {op(NouvelleListe),[val,op(GrandeListep)]}:

          end do:                                          

    end do:
GrandeListe:=NouvelleListe:
NouvelleListe:={}:
end do:

GrandeListe;
end proc;


  BIG := proc(Rho)
local GrandeListep, GrandeListe, GrandeListecom,
NouvelleListe, n, num, k, p, r, val;
    GrandeListep := [];
    NouvelleListe := {};
    GrandeListe := {};
    n := nops(Rho);
    num := 1;
    for k from n by -1 to 1 do
        if 0 < nops(GrandeListe) then
            num := nops(GrandeListe)
        end if;
        for p to num do
            if k < n then GrandeListep := GrandeListe[p]
            end if;
            GrandeListecom :=
                [seq(0, i = 1 .. k), op(GrandeListep)];
            for r to nops(VALEUR(k, Rho, GrandeListecom)) do
                val :=
                    [op(VALEUR(k, Rho, GrandeListecom))][r];
                NouvelleListe := {[val, op(GrandeListep)],
                    op(NouvelleListe)}
            end do
        end do;
        GrandeListe := NouvelleListe;
        NouvelleListe := {}
    end do;
    GrandeListe
end proc



BIG([1,2,1]);

               {[-1, -1, -1], [-1, 1, -1], [-1, 7, -1]}

VALEUR(1,[1,2,1],[0,0,0]); VALEUR(2,[1,2,1],[0,0,-1]);

                                 {-1}


                              {-1, 1, 7}

RECHTAB(2,[1,2,1],[0,0,-1]);

                                {1, 7}

RESOL1(2,[1,2,1],[0,0,-1]);

                             {1, 3, 5, 7}

BIG([1,1,1]);

                            {[-1, -1, -1]}

BIG([1,0,1]);

                      {[-1, 1, -1], [-1, 7, -1]}

BIG([2,2]);

    {[-1, -1], [0, 0], [-1, 0], [0, -1], [2, -1], [6, -1], [4, 0]}

BIG([2]);BIG([0,1]);

                             {[-1], [0]}


                          {[1, -1], [7, -1]}

BIG([3]);BIG([0,0,1]);

                                {[-1]}


           {[1, 1, -1], [5, 1, -1], [1, 7, -1], [5, 7, -1]}

RECHTAB(1,[2],[0]);RESOL1(1,[2],[0]);VALEUR(1,[2],[0]);

                                 {0}


                                 {0}


                               {-1, 0}

BIG([4,5]);

            {[-1, -1], [1, -1], [7, -1], [3, -1], [5, -1]}

BIG([2,3]);

            {[-1, -1], [1, -1], [7, -1], [3, -1], [5, -1]}

BIG([1,2]);

                         {[-1, -1], [-1, 0]}

Procedure annexe pour convertir une partition en un tableau:
convtable:=proc(Liste)
local i,u,n,tableau:

tableau:=[]:
for i from 1 to nops(Liste) do
   if i = 1 and Liste[1]=1 then tableau:=[op(tableau),1]: end if:
   if i = 1 and Liste[1] > 1 then n:=Liste[1]-1:
                                  tableau:=[op(tableau),seq(0,j=1..n),1]: 
                              end if:
   if i > 1 and Liste[i]-Liste[i-1] = 0 then u:=tableau[nops(tableau)]: 
                                             tableau[nops(tableau)]:= u + 1:
                                             end if:
   if i > 1 and Liste[i]-Liste[i-1] >= 1 then \
 tableau:=[op(tableau),seq(0,r=1..Liste[i]-Liste[i-1]-1),1]: end if:
end do:

tableau;
end proc; 


  convtable := proc(Liste)
local i, u, n, tableau;
    tableau := [];
    for i to nops(Liste) do
        if i = 1 and Liste[1] = 1 then
            tableau := [op(tableau), 1]
        end if;
        if i = 1 and 1 < Liste[1] then
            n := Liste[1] - 1;
            tableau := [op(tableau), seq(0, j = 1 .. n), 1]
        end if;
        if 1 < i and Liste[i] - Liste[i - 1] = 0 then
            u := tableau[nops(tableau)];
            tableau[nops(tableau)] := u + 1
        end if;
        if 1 < i and 1 <= Liste[i] - Liste[i - 1] then
            tableau := [op(tableau),
            seq(0, r = 1 .. Liste[i] - Liste[i - 1] - 1), 1]
        end if
    end do;
    tableau
end proc

Exemple d'utilisation:
convtable([1,1,1]);

                                 [3]

convtable([1,2,3,4,5]);

                           [1, 1, 1, 1, 1]

convtable([1,2,4,4,7,7,9]);

                     [1, 1, 0, 2, 0, 0, 2, 0, 1]

Le nombre de tableaux admissibles est egal au nombre d'enlacements \
 (pour le profil de rang donne):

Procedure pour trouver tous les enlacements (sous forme de tableaux admissibles) \
 sur un 2-groupe d'ordre donne p^{n} =
procedure pour trouver tous les tableaux admissibles dont la somme des rangs est fixee.
Cela revient a determiner toutes les partitions d'un entier n et de calculer tous \
 les tableaux admissibles pour une partition donnee.
with(combinat,partition);



                             [partition]

TOUS:=proc(n)
local i, total,Partableau,Megaliste:
Megaliste:=[];
total:=nops(partition(n));
for i from 1 to total do
    Partableau:=convtable(partition(n)[i]):
    Megaliste:=[op(Megaliste),op(BIG(Partableau))]:
    end do:
Megaliste;
end proc: