BioConsert Project – February 2011

Brute-Force algorithm to find the medians of a set (ens) of rankings of [n]:

VraiesMedianes:=proc(ens,n)
  local tris,res,d,i,cout,dtemp;
  tris:=decompositions(n);
  cout:=cost_matrix(ens,n);
  d:=100000;
  for i from 1 to nops(tris) do
     dtemp:=newDistanceKendall(cout,nops(ens),tris[i],n);
     if dtemp < d then
        res:=[ens,{tris[i]},dtemp];
        d:=dtemp;
     elif dtemp = d then
        res[2]:=res[2] union {tris[i]};
     fi;
  od;
res;
end:

Generate all rankings of [n]:

decompositions:=n->map(op,map(F,Parts({seq(i,i=1..n)}))):

F:=L->permutations(map(convert,L,`list`)):

permutations:=A->if A={} then {{}}
    else {seq(seq([A[i],op(B)],B in permutations(A minus {A[i]})),i=1..nops(A))} fi:

card:=nops:

`&+` := `union`:
`&-` := `minus`:
`&X` := proc(A,B) local a,b:
    {seq(seq([a,b],a in A),b in B)}
end:

un_elem:=A->op(1,A):

Parts:=A->Sigma({seq(Parts_k(A,k),k=1..card(A))}):

Sigma:=F->if F={} then {}
    else F[1] &+ Sigma(F &- {F[1]}) fi:

Parts_k:=proc(A,k) local P,x:
    if k>card(A) then {}
    elif k=1 then {{A}}
    elif k=card(A) then {{seq({x},x=A)}}
    else
      x:=un_elem(A):
      {seq(P &+ {{x}},P in Parts_k(A &- {x},k-1))} &+
        {seq(seq((P &- {B}) &+ {B &+ {x}},B in P),P in Parts_k(A &- {x},k))}
    fi
end:

Generate a matrix containing in position [i,j] the Kendall-tau distance of pair (i,j) with respect to the rankings of [n] of set "ens" 

cost_matrix:=proc(ens,n)
 local cout,i,j,k,m,pos;
 cout:=Array(1..n,1..n);
 for m from 1 to nops(ens) do
    pos:=position(ens[m],n);
    for i from 1 to n do
      for j from i+1 to n do
          if pos[i] < pos[j] then 
              cout[j,i]:=cout[j,i]+1;
          elif pos[i] > pos[j] then 
              cout[i,j]:=cout[i,j]+1;
          fi;
      od;
    od;
od;
cout;
end:

Generate an array of length n containing in position i, the position of i in the ranking i.e. the index of the bucket containing i 

position:=proc(liste,n)
local i,j,pos;
pos:=Array(1..n);
for i from 1 to nops(liste) do
   for j from 1 to nops(liste[i]) do
       pos[liste[i][j]]:=i;
   od:
od;
pos;
end:

Compute the Kendall-tau distance of the ranking tri to the set ens containing card=m rankings of [n]

newDistanceKendall:=proc(cost_matrix(ens),m,tri,n)
  local i,j,distance,cout,pos;
  distance:=0;
  pos:=position(tri,n);
  for i from 1 to n-1 do
     for j from i+1 to n do
        if pos[i] < pos[j] then
         distance:=distance + m-matriceCout[j,i];
        elif pos[i] > pos[j] then
         distance:=distance + m-matriceCout[i,j];
        else
         distance:=distance+matriceCout[i,j]+ matriceCout[j,i];
        fi;
     od;
  od;
  distance;
  end:

Randomly choose a certain number "nombre" of sets of m rankings of [n]:

RandomTris:=proc(n,m,nombre)
  option remember:
  local tris,i,ens,roll,res;
  tris:=decompositions(n);
  roll:=rand(1..nops(tris));
  res:=[];
  while nops(res) <> nombre do
    ens:={};
    while nops(ens) <> m do
       ens:=ens union {tris[roll()]};
    od;
    res:=[op(res),ens];
  od;
 res;
 end: