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},
{{j, k}, {j2, k2}} = getPositionOfMax[mat];

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] ====

```

• Prev by Date: MonteCarlo Integration
• Next by Date: Re: Re: FindRoot output format
• Previous by thread: MonteCarlo Integration
• Next by thread: How limited is ReIm?