BioConsert Project – February 2011

Compute the arithmetic median of the sorted list "Liste Trier"

medianeAri:=proc(ListeTrier)
  local n,rep;
  n:=nops(ListeTrier);
   if type(n,odd) then
     rep:=ListeTrier[(n+1)/2];
   else
     rep:=convert((ListeTrier[(n/2)]+ListeTrier[((n/2)+1)])/2,float,2);
   fi;
rep;
end:

Give a list of positions where position[i] is the position of element i in ranking "tri"following Fagin and al. definition 

position:=proc(tri,n)
local i,j,pos,avant,paquet;
pos:=Array(1..n);
avant:=0;
for i from 1 to nops(tri) do
    paquet:=nops(tri[i]);
    for j from 1 to paquet do
       pos[tri[i][j]]:=convert(avant+((paquet+1)/2),float,2);
    od:
    avant:=avant+paquet;
od;
pos;
end:

Takes as inputs a set of rankings "ensTri" of [n] and returns the ideal position
of each element in a consensus ranking

posIdeal:=proc(ensTri,n)
  local i,j,rep,temp;
  rep:=Array(1..n);
  for i from 1 to n do
     temp:=[];
    for j from 1 to nops(ensTri) do
       temp:=[op(temp),position(ensTri[j],n)[i]];
    od;
       temp:=trier_liste(temp);
       rep[i]:=medianeAri(temp);
  od;
rep;
end:

"Arr" corresponds to the ordered list of ideal positions computed by "posIdeal".
"entierCorres" keeps in memory, for each i, the integer corresponding to the
ideal position in position i in the ordered list.

entierCorres:=proc(arr,n)
  local i,j,trie,reponse,ens;
  reponse:=Array(1..n);
  for i from 1 to n do
     reponse[i]:=[arr[i],i];
  od;           
reponse;
end:

Compute the value c(S) of the Fagin and al. algorithm, where "matrices" is a
matrix containing the value c(i,j) for 1 <= i,j <= n, "CO" is an array containing the
values c(0,j), 1 < = j  < = n and S is the list S_0, …S_i for which we want to compute c(S):

calculS:=proc(matriceC,C0,S)
  local i,rep;
  rep:=0;
  for i from 1 to nops(S)-1 do
     if i=1 then
       rep:=rep+C0[S[i+1]];
     else
       rep:=rep+matriceC[S[i]][S[i+1]];
    fi;
  od;
rep;
end:

Compute the value c(i,j) of the Fagin and al. algorithm:

calculC:=proc(listeF,i,j)
  local rep,l;
  rep:=0;
  for l from i+1 to j do
     rep:=rep+abs(listeF[l]-((i+j+1)/2));
  od;
rep;
end:

Compute S_n from Fagin and al. algorithm. The only difference between the three methods "FaginPetit" (Fagin1 in the results), FaginGros" (Fagin2 in the results) and "FaginMoyen" (Fagin3 in the results) that follows, are the lines (**). When looking for a minimal value i_0 in this line, we take either, 

1) the last one in "FaginPetit" with " < = mini" in line(**) leading to a consensus ranking with small buckets (in fact, in all the example in the article when using this method, the consensus obtained was always a total order i.e a permutation or a ranking with all buckets of size 1). 

2) the first one in "FaginGros" with "< mini" n line (**) leading to as consensus ranking with huge buckets i.e where most of the elements are ties

3) we randomly choose one minimal value for i_0 in "FaginMoyen" leading to a consensus with buckets of different sizes

FaginPetit:=proc(listeF,n)
  local c0,c,i,j,i0,temp,mini,S, rep;
  c0:=Array(1..n);
  S:=Array(1..n);
  c:=Array(1..n,1..n);
  for j from 1 to n do
    c0[j]:=calculC(listeF,0,j);
     if j=1 then
     S[j]:={0,j};
    else 
    for i from 1 to j-1 do
       c[i][j]:=calculC(listeF,i,j);
    od; 
      mini:=c0[j];
      temp:=0;
      for i0 from 1 to j-1 do
        if evalb(calculS(c,c0,trier_liste(convert(S[i0],list))) + c[i0][j] <= mini) then (**)
            mini:=calculS(c,c0,trier_liste(convert(S[i0],list))) + c[i0][j];
            temp:=i0;
        fi;
      od;
      if temp = 0 then
          S[j]:={0,j};
      else
        S[j]:=S[temp] union {j};
      fi;
    fi;
   od;
rep:=S[n];
end:

FaginGros:=proc(listeF,n)
  local c0,c,i,j,i0,temp,mini,S, rep;
   c0:=Array(1..n);
  S:=Array(1..n);
  c:=Array(1..n,1..n);
  for j from 1 to n do
    c0[j]:=calculC(listeF,0,j);
    if j=1 then
     S[j]:={0,j};
    else 
    for i from 1 to j-1 do
       c[i][j]:=calculC(listeF,i,j);
    od; 
      mini:=c0[j];
      temp:=0;
      for i0 from 1 to j-1 do
        if evalb(calculS(c,c0,trier_liste(convert(S[i0],list))) + c[i0][j] < mini) then (**)
            mini:=calculS(c,c0,trier_liste(convert(S[i0],list))) + c[i0][j];
            temp:=i0;
        fi;
      od;
      if temp = 0 then
          S[j]:={0,j};
      else
        S[j]:=S[temp] union {j};
      fi;
    fi;
   od;
rep:=S[n];
end:

FaginMoyen:=proc(listeF,n)
  local c0,c,i,j,i0,temp,mini,S, rep,ran,comp;
  c0:=Array(1..n);
  S:=Array(1..n);
  c:=Array(1..n,1..n);
  for j from 1 to n do
    c0[j]:=calculC(listeF,0,j);
   if j=1 then
     S[j]:={0,j};
    else 
    for i from 1 to j-1 do
       c[i][j]:=calculC(listeF,i,j);
    od; 
      mini:=c0[j];
      temp:=0;
      ran:=roll();
      comp:=1;
      for i0 from 1 to j-1 do
        if evalb(calculS(c,c0,trier_liste(convert(S[i0],list))) + c[i0][j] < mini) then
            mini:=calculS(c,c0,trier_liste(convert(S[i0],list))) + c[i0][j];
            temp:=i0;
        elif evalb(calculS(c,c0,trier_liste(convert(S[i0],list))) + c[i0][j] = mini) and comp>=ran then
            mini:=calculS(c,c0,trier_liste(convert(S[i0],list))) + c[i0][j];
            temp:=i0;
            comp:=1;
            ran:=roll();
        elif evalb(calculS(c,c0,trier_liste(convert(S[i0],list))) + c[i0][j] = mini) and comp < ran then
            comp:=comp+1;
        fi;
      od;
      if temp = 0 then
          S[j]:={0,j};
      else
        S[j]:=S[temp] union {j};
      fi;
    fi;
   od;
rep:=S[n];
end:

Given S_n (from Fagin algorithm) gives the size of each bucket in the consensus ranking:
TaillePaquet:=proc(S_n)
   local i,j,m,taille;
   m:=nops(S_n);
   taille:=[];
   for i from 1 to m-1 do
      taille:=[op(taille),S_n[i+1]-S_n[i]];
   od;
taille;
end:

Given "VecTaille" the result of method "TaillePaquet" and "ArrayTrier", the result of ordering the list of ideal positions given by method "posIdeal", gives a ranking with the buckets of the right size but with the "ideal position" and not the integer 1… n.
 
FormerPaquet:=proc(VecTaille,ArrayTrier)
    local i,j,paq,k,temp;
    paq:=[];
    k:=0;
    for i from 1 to nops(VecTaille) do
       temp:=[];
       for j from k+1 to k+VecTaille[i] do
           temp:=[op(temp),ArrayTrier[j]];
       od;
       k:=k+VecTaille[i];
       paq:=[op(paq),temp];
    od;
paq;
end:

Given the ranking with the right buckets from "FormerPaquet", creates the Fagin and al. consensus by using the correspondence between the ideal position and the right integer (given by "corresp" which is the output of method "entierCorres")

consensus:=proc(triValeur,corresp,n)
  local i,j,k,m,tri,ens;
  tri:=triValeur;
  ens:={seq(k,k=1..n)};
  for i from 1 to nops(triValeur) do
     for j from 1 to nops(triValeur[i]) do
         for m from 1 to n do
            if corresp[m][1]=triValeur[i][j] then
                if member(corresp[m][2],ens) then
                    tri[i][j]:=corresp[m][2];
                    ens:=ens minus {corresp[m][2]};
                    m:=n+1;
                fi;
            fi;
        od;
   od;
od;
tri;
end:

List of instructions to compute a consensus ranking from Fagin and al. algorithm, by either choosing to promote small buckets "algoFaginPetit", huge buckets "algoFaginMoyen" are buckets of random sizes "algoFaginMoyen"

algoFaginPetit:=proc(ens,n)
  local pos,corresp,fag,paqs,triVal,cons;
  pos:=posIdeal(ens,n);
  corresp:=entierCorres(pos,n);
  fag:=FaginPetit(trier_array(pos,n),n);
  paqs:=TaillePaquet(fag);
  triVal:=FormerPaquet(paqs,trier_array(pos,n));
  cons:=consensus(triVal,corresp,n); 
cons;
end: 

algoFaginGros:=proc(ens,n)
  local pos,corresp,fag,paqs,triVal,cons;
  pos:=posIdeal(ens,n);
  corresp:=entierCorres(pos,n);
  fag:=FaginGros(trier_array(pos,n),n);
  paqs:=TaillePaquet(fag);
  triVal:=FormerPaquet(paqs,trier_array(pos,n));
  cons:=consensus(triVal,corresp,n); 
cons;
end: 

algoFaginMoyen:=proc(ens,n)
  local pos,corresp,fag,paqs,triVal,cons;
  pos:=posIdeal(ens,n);
  corresp:=entierCorres(pos,n);
  fag:=FaginMoyen(trier_array(pos,n),n);
  paqs:=TaillePaquet(fag);
  triVal:=FormerPaquet(paqs,trier_array(pos,n));
  cons:=consensus(triVal,corresp,n); 
cons;
end: