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