doubly stochastic graph to permutations
- To: mathgroup at smc.vnet.net
- Subject: [mg3466] doubly stochastic graph to permutations
- From: Daniel Lichtblau <danl>
- Date: Sat, 9 Mar 1996 01:00:08 -0500
- Sender: owner-wri-mathgroup at wolfram.com
At the risk of injecting relevance to this question, I coded an
algorithm in Mathematica to do part (b). If my code were cleaner, a
careful reading would perhaps allow one to construct an argument. As
it is, I suspect it would be far easier to do the problem from
scratch (which in fact should give some insight into construction of
such an algorithm).
In[2]:= permMatrix[vec:{a__Integer}] := Module[{len=Length[vec]},
Table[If [k==vec[[j]], 1, 0], {j, len}, {k, len}]]
In[3]:= augment[mat_] := Module[{len=Length[mat]},
Table[{mat[[i,j]], {i, j}}, {i, len}, {j, len}]]
In[4]:= subMatrix[mat_, i_Integer, j_Integer] :=
Transpose[Drop[Transpose[Drop[mat, {i}]], {j}]]
In[5]:= getMinAndPos[mat_] := Module[{newmat, minlist},
newmat = mat /. 0->Infinity;
minlist = Map[First[Sort[#]]&, newmat];
First[Sort[minlist]]]
In[6]:= getPositionOfMax[mat_] := Module[{newmat, maxlist, ll},
newmat = augment[mat /. Infinity->0];
maxlist = Map[Last[Sort[#]]&, newmat];
ll = Last[Sort[maxlist]];
{ll[[1,2]], ll[[2]]}]
In[7]:= getPositions[mat_, head_] := Module[{len=Length[mat], j, k,
j2, k2},
If [len==1, Return[head[mat[[1,1,2]]]]];
{{j, k}, {j2, k2}} = getPositionOfMax[mat];
head[{j, k}, getPositions[subMatrix[mat, j2, k2], head]]]
In[8]:= stochMatrixToPerms[m_?MatrixQ] := Module[
{len=Length[m], min, j, k, j2, mat=augment[m], posns, row, col,
perm, list, result},
result = list[];
mat = mat /. 0->Infinity;
{min, {j, k}} = getMinAndPos[mat];
While [min!=Infinity,
posns = Flatten[list[{j, k},
getPositions[subMatrix[mat, j, k], list]], Infinity, list];
perm = Map[Last, Sort[posns]];
result = list[result, {min, perm}];
For[j=1, j<=len, j++, mat[[j, perm[[j]], 1]] -= min];
mat = mat /. 0->Infinity;
{min, {j, k}} = getMinAndPos[mat];
];
Map[{#[[1]], permMatrix[#[[2]]]}&,
Flatten[result, Infinity, list] /. list->List]]
General::spell1:
Possible spelling error: new symbol name "min"
is similar to existing symbol "Min".
General::spell1:
Possible spelling error: new symbol name "row"
is similar to existing symbol "Row".
General::spell1:
Possible spelling error: new symbol name "list"
is similar to existing symbol "List".
General::stop: Further output of General::spell1
will be suppressed during this calculation.
In[9]:= mat = {{1/3,1/3,1/3}, {1/2,1/2,0},{1/6,1/6,2/3}}; (*example*)
In[10]:= stochMatrixToPerms[mat]
1
Out[10]= {{-, {{0, 0, 1}, {0, 1, 0}, {1, 0, 0}}},
6
1
> {-, {{0, 0, 1}, {1, 0, 0}, {0, 1, 0}}},
6
1
> {-, {{1, 0, 0}, {0, 1, 0}, {0, 0, 1}}},
3
1
> {-, {{0, 1, 0}, {1, 0, 0}, {0, 0, 1}}}}
3
Daniel Lichtblau
Wolfram Research, Inc.
danl at wolfram.com
==== [MESSAGE SEPARATOR] ====