RSD-SR algoritmus

Az algoritmus bemenete: preferenciak. A preferenciak lista i. eleme az i. hallgató szobákon vett preferenciáit mutatja.

<<Combinatorica`

PrefPerm[preferenciak_,perm_]:=
Module[{i,seged},

seged=Table[0,{Length[preferenciak]}];

For[i=1,i≤Length[perm],i++,
seged[[perm[[i]] ]]=preferenciak[[i]];
];
seged

];

PermInv[perm_]:=
Module[{i,seged},
seged=Table[0,{Length[perm]}];
For[i=1,i≤Length[perm],i++,
seged[[perm[[i]] ]]=i;
];
seged
];

ParositasPermInv[parositas_,perm_]:=
Module[{i,segedpar,segedperm},

segedpar=parositas;
segedperm=PermInv[perm];

For[i=1,i≤Length[segedpar],i++,
segedpar[[i,1 ]]=segedperm[[i]];
];
segedpar
];


Torles[preferenciak_,parositas_]:=
Module[{i,j,segedpref},

segedpref=preferenciak;

segedpref[[parositas[[1]] ]]={};


For[i=1,i≤Length[segedpref ],i++,
For[j=1,j<=Length[ segedpref[[i]] ],j++,
If[ segedpref[[i,j]]==parositas[[2]],
segedpref[[i]]=Delete[segedpref[[i]],j];
 ];
];
];

segedpref
];

RSDSR[preferenciak_]:=
Module[{i,segedpref,parositas,perm},

perm=RandomPermutation[Length[preferenciak]];
segedpref=PrefPerm[preferenciak,perm];
parositas={};

For[i=1,i≤Length[segedpref],i++,
If[segedpref[[i]]≠{},
parositas=Join[parositas,{{i,segedpref[[i,1]]}}];
segedpref=Torles[segedpref,{i,segedpref[[i,1]]}]
];
];

ParositasPermInv[parositas,perm]
];

preferenciak={{4,6,7},{4},{8,1},{1,2,6},{1,7,3},{5,1,3},{2,8,3},{3,7}};
RSDSR[preferenciak]

TTC algoritmus

A bemenet: G. A G lista minden eleme egy tulajdonos házakon vett preferenciáit tartalmazza, azt hogy hányadik tulajdonos házát szeretné.

G={{5,4},{6},{2,3},{1},{5},{9},{8},{2,7},{2},{7,10}};

TTC[G_]:=Module[{korok,seged,bejart,csucs,kor,parositas},
korok={};

seged=G;

kor={1};

While[kor!={},

bejart=Table[False,{Length[seged]}];
kor={};

While[kor=={} && bejart!=Table[True,{Length[seged]}],

csucs=1;
While[i≤Length[bejart] && bejart[[csucs]],
csucs=csucs+1;
];

While[ Not[ bejart[[csucs]] ] ,
bejart[[csucs]]=True;
If[seged[[csucs]]≠{},
kor=Insert[kor,csucs,-1];
csucs=seged[[csucs,1]];
];
];
];


If[kor≠{},
While[ kor[[1]]≠ csucs,
kor=Delete[kor,1];
 ];
korok=Insert[korok,kor,-1];

For[i=1,i<=Length[kor],i++,
seged[[ kor[[i]] ]]={};

j=1;
While[j≤Length[seged],

k=1;
While[k≤Length[ seged[[j]] ],
If[ seged[[j,k]]==kor[[i]] ,
seged[[j]]=Delete[seged[[j]],k],
k=k+1;
]
];
j=j+1;
];
];
];

];

parositas={};
i=1;
While[i≤Length[korok],
j=1;
While[j<Length[ korok[[i]] ],
parositas=Insert[parositas,{korok[[i,j]],korok[[i,j+1]]},-1];
j=j+1;
];
parositas=Insert[parositas,{korok[[i,j]],korok[[i,1]]},-1];
i=i+1;
];

parositas
];

TTC[G]

YRM-IGYT algoritmus

Az algoritmus bemenete: preferenciak, hazak. A preferenciák lista minden eleme egy tulajdonos házakon való preferenciáit tartalmazza. Ha a házak lista i. eleme nulla, akkor a háznak nincs még tulajdonosa, ha x, nem  nulla, akkor az i. háznak az x. személy a tulajdonosa. Minden házzal rendelkező preferenciasorrendjéban utoljára rámutat saját házára is. Ha az eredményben nem szerepel egy tulajdonos, az azt jelenti, hogy nem kap házat.

<<Combinatorica`

PrefPerm[preferenciak_,perm_]:=
Module[{i,seged},

seged=Table[0,{Length[preferenciak]}];

For[i=1,i≤Length[perm],i++,
seged[[perm[[i]] ]]=preferenciak[[i]];
];
seged

];

PermInv[perm_]:=
Module[{i,seged},
seged=Table[0,{Length[perm]}];
For[i=1,i≤Length[perm],i++,
seged[[perm[[i]] ]]=i;
];
seged
];

ParositasPermInv[parositas_,perm_]:=
Module[{i,segedpar,segedperm},

segedpar=parositas;
segedperm=PermInv[perm];

For[i=1,i≤Length[segedpar],i++,
segedpar[[i,1 ]]=segedperm[[i]];
];
segedpar
];

HazPerm[hazak_,perm_]:=
Module[{i,seged},

seged=hazak;

For[i=1,i≤Length[seged],i++,
If[0<seged[[i]],
seged[[i]]=perm[[i]];
];
];

seged
];

KorokUtak[preferenciak_,hazak_,kezdopont_]:=
Module[{i,csucs,csucsok,parositas,bejart},

parositas={};

bejart=Table[False,{Length[hazak]}];

csucsok={};
csucs=kezdopont;
While[hazak[[ preferenciak[[csucs,1]] ]]≠0  && bejart[[ preferenciak[[csucs,1]] ]]≠True,
csucsok=Insert[csucsok,csucs,-1];
bejart[[ preferenciak[[csucs,1]] ]]=True;
csucs=hazak[[ preferenciak[[csucs,1]] ]];
];
csucsok=Insert[csucsok,csucs,-1];

If[hazak[[ preferenciak[[csucs,1]] ]]==0,
For[i=1,i≤Length[csucsok],i++,
parositas=Insert[parositas,{csucsok[[i]],preferenciak[[ csucsok[[i]],1 ]]},-1];
];
];

If[bejart[[ preferenciak[[csucs,1]] ]],
While[ csucs≠ csucsok[[1]],
csucsok=Delete[csucsok,1];
 ];
csucsok=Delete[csucsok,-1];

For[i=1,i≤Length[csucsok],i++,
parositas=Insert[parositas,{csucsok[[i]],preferenciak[[ csucsok[[i]],1 ]]},-1];
];
];

parositas

];

(* Az elkelt házak és tulajdonosaik eltávolítása *)
Torles[preferenciak_,hazak_,parositas_]:=
Module[{i,j,k,segedpref,segedhaz},

segedpref=preferenciak;
segedhaz=hazak;

For[i=1,i≤Length[parositas],i++,
segedpref[[parositas[[i,1]] ]]={};
];

For[i=1,i≤Length[parositas],i++,

For[j=1,j≤Length[segedpref ],j++,
For[k=1,k≤Length[ segedpref[[j]] ],k++,
If[ segedpref[[j,k]]==parositas[[i,2]],
segedpref[[j]]=Delete[segedpref[[j]],k];
 ];
];
];
];

For[i=1,i≤Length[hazak],i++,
If[segedpref[[segedhaz[[i]] ]]=={},
segedhaz[[i]]=0
 ];
];

{segedpref,segedhaz}
];

YRMIGYT[preferenciak_,hazak_]:=
Module[{i,seged,segedpref,segedhaz,parositas,korokutak,perm},

perm=RandomPermutation[Length[preferenciak]];

parositas={};
segedpref=PrefPerm[preferenciak,perm];
segedhaz=HazPerm[hazak,perm];

i=1;
While[i≤Length[segedpref],
If[segedpref[[i]]≠{},
korokutak=KorokUtak[segedpref,segedhaz,i];
parositas=Join[parositas,korokutak];
seged=Torles[segedpref,segedhaz,korokutak];
segedpref=seged[[1]];
segedhaz=seged[[2]];
,
i=i+1;
];
];

ParositasPermInv[parositas,perm]

];

preferenciak={{4,6,7},{4},{8,1},{1,2,6},{1,7,3},{5,1,3},{2,8,3},{3,7}};
hazak={3,0,5,0,0,4,8,0};

YRMIGYT[preferenciak,hazak]

TTCC algoritmus

Az eljárás bemenete: G. A G lista minden eleme egy páciens donorokon való preferenciasorrendjét tartalmazza.

(*G éleinek megfordítása*)
Elfordit[G_]:=
Module[{Gf,i},
Gf=Table[{},{Length[G]}];

For[i=1,i≤Length[G],i++,
If[ G[[i]]≠{} && G[[i,1]]≠0,
Gf[[ G[[i,1]] ]]=Insert[Gf[[ G[[i,1]] ]],i,-1];
];
];
Gf
];

(*w-láncok megkeresése*)
WLancok[G_]:=
Module[{i,k,Gf,wlancok,bejart,seged},

wlancok={};
Gf=Elfordit[G];

For[i=1,i≤Length[Gf],i++,
If[Gf[[i]]=={} && G[[i]]≠ {} ,

bejart=Table[False,{Length[G]}];

seged={};
k=i;
While[ k≠0  &&  Not[ bejart[[k]] ],
bejart[[k]]=True;
seged=Insert[seged,k,-1];
k=G[[k,1]];
];

If[  k==0,
wlancok=Insert[ wlancok,seged,-1];
];
];
];
wlancok
];

(*körök megkeresése*)
Korok[G_]:=
Module[{i,k,j,korok,seged,bejart},

bejart=Table[False,{Length[G]}];
korok={};

For[i=1,i≤Length[G],i++,

seged={};
k=i;
While[ G[[k]]≠{}&& k≠0  && Not[ bejart[[k]] ],
bejart[[k]]=True;
seged=Insert[seged,k,-1];
k=G[[k,1]];
];

If[k≠0 &&  G[[k]]≠{},
seged=Insert[seged,k,-1];
j=Length[seged]-1;
While[1<=j && seged[[j]] ≠ seged[[-1]],
j=j-1;
];

If[j≠0,
korok=Insert[korok ,Table[seged[[m]],{m,j+1,Length[seged]} ],-1];
];
];
];
korok
];

KorParositas[korok_]:=
Module[{i,j,parositas},

parositas={};

For[i=1,i≤Length[korok],i++,
For[j=1,j≤Length[korok[[i]]]-1,j++,
parositas=Insert[parositas,{korok[[i,j]],korok[[i,j+1]]},-1];
];
parositas=Insert[parositas,{korok[[i,j]],korok[[i,1]]},-1];
];

parositas
];

LancParositas[lancok_]:=
Module[{i,j,parositas},
parositas={};

For[i=1,i≤Length[lancok],i++,
For[j=1,j≤Length[lancok[[i]]]-1,j++,
parositas=Insert[parositas,{lancok[[i,j]],lancok[[i,j+1]]},-1];
];
parositas=Insert[parositas,{lancok[[i,j]],0},-1];
];

parositas
];

Torles[G_,csucsok_]:=
Module[{i,j,k,seged,torlendo,tovabb},

seged=G;
torlendo=csucsok;
tovabb=True;

While[tovabb,

For[i=1,i<=Length[torlendo],i++,
seged[[torlendo[[i]] ]]={};
];

tovabb=False;
For[i=1,i<=Length[torlendo],i++,
For[j=1,j<=Length[seged],j++,
For[k=1,k<=Length[seged[[j]]],k++,
If[seged[[j,k]]≠0 && seged[[seged[[j,k]] ]]=={},

seged[[j]]=Delete[seged[[j]],k];
tovabb=True;
];
];
];
];

];
seged
];

TTCC[G_]:=
Module[{i,seged,parositas,korok,lancok,csucsok,max},
seged=G;
parositas={};

korok={1};
lancok={1};
While[korok≠{} || lancok≠{} ,

korok=Korok[seged];
If[korok≠{},
parositas=Join[parositas,KorParositas[korok]];

csucsok=Flatten[korok];
seged=Torles[seged,csucsok];
];

lancok=WLancok[seged];
If[lancok≠{},
max=1;
For[i=2,i≤Length[lancok],i++,
If[Length[lancok[[max]] ]< Length[lancok[[i]] ],
max=i;
];
];

parositas=Join[parositas,LancParositas[{lancok[[max]] }] ];
csucsok=Flatten[lancok[[max]]];
seged=Torles[seged,lancok[[max]]];
];

];

parositas
];

G={{3},{6},{10,4},{0},{9},{10},{1},{0},{6,4,5},{2}};
TTCC[G]

Szélességi bejárás

A vese csere programnak van olyan változata, hogy egy páciensnek nem csak egy donorja lehet, hanem akár több is. Ekkor a TTCC algoritmusnál nem csak olyan gráf jöhet létre, ahol minden csúcs kifoka pontosan egy, hanem több is lehet, így a fenti algoritmus nem használható, másképp kell köröket keresni a gráfban. Ez megoldható hatékonyan a szélességi bejárással. Amikor a bejárás során egy keresztélhez érünk, akkor annak megfelel egy kör. Ezt az algoritmust még nem írtam meg.

G={{3,4},{2},{1,3,5,6},{2,4,6},{3,6},{2}};

csucsszam=Length[G];

bejart=Table[False,{csucsszam(G)}];

sor={1};
bejart[[1]]=True;

bejarasisorrend={};

While[sor≠{},
bejartcsucs=sor[[-1]] ;

bejarasisorrend=Insert[bejarasisorrend,bejartcsucs,-1];

For[i=1,i≤Length[ G[[bejartcsucs]] ],i++,

If[ Not[ bejart[[ G[[bejartcsucs,i]] ]] ]  ,sor=Insert[sor,G[[bejartcsucs,i]] ,1];
];

bejart[[ G[[bejartcsucs,i]] ]]=True;

];

sor=Delete[sor,-1];
;]


bejarasisorrend