Wolfram Cloud Document

In[]:=

RandomBinaryMatrix[rows_,cols_,n_]:=Normal[SparseArray[RandomSample[Flatten[Table[{i,j}->1,{i,1,rows},{j,1,cols}],1],n],{rows,cols}]]

In[]:=

RandomBinaryVector[elements_,n_]:=Normal[SparseArray[RandomSample[Table[{i}->1,{i,1,elements}],n],{elements}]]

In[]:=

MatrixSwap[m_]:=Module[{total,target,mCoords,swapCandidate,quadCandidates,n,quadCandidate},total=Total[m,2];target=If[total<(Apply[Times,Dimensions[m]]/2),1,0];mCoords=Position[m,target];swapCandidate=RandomSample[mCoords,1][[1]];quadCandidates=RandomSample[DeleteCases[mCoords,swapCandidate]];n=1;Until[(quadCandidate={{m[[swapCandidate[[1]],swapCandidate[[2]]]],m[[swapCandidate[[1]],quadCandidates[[n,2]]]]},{m[[quadCandidates[[n,1]],swapCandidate[[2]]]],m[[quadCandidates[[n,1]],quadCandidates[[n,2]]]]}};(swapCandidate[[1]]=!=quadCandidates[[n,1]]&&swapCandidate[[2]]=!=quadCandidates[[n,2]]&&Total[quadCandidate]==={1,1}&&Total[quadCandidate,{2}]==={1,1})||n==(total-1)),n++];ReplacePart[m,MapThread[#1->#2&,{{{swapCandidate[[1]],swapCandidate[[2]]},{swapCandidate[[1]],quadCandidates[[n,2]]},{quadCandidates[[n,1]],swapCandidate[[2]]},{quadCandidates[[n,1]],quadCandidates[[n,2]]}},Flatten[Reverse[quadCandidate]]}]]]

In[]:=

Options[MatrixRandomize]={Method->"Free","Swaps"->1000};MatrixRandomize[m_,OptionsPattern[]]:=Module[{rows,cols,rowTotals,colTotals,grandTotal,method},{rows,cols}=Dimensions[m];rowTotals=Total[m,{2}];colTotals=Total[m];grandTotal=Total[colTotals];method=OptionValue[Method];Which[method==="Free",RandomBinaryMatrix[rows,cols,grandTotal],method==="PreserveRowTotals",Map[RandomBinaryVector[cols,#]&,rowTotals],method==="PreserveColumnTotals",Transpose[Map[RandomBinaryVector[rows,#]&,colTotals]],method==="PreserveRowAndColumnTotals",Nest[MatrixSwap,m,OptionValue["Swaps"]]]]

Make a nested matrix using sample with weights.

In[]:=

locations=Flatten[Table[{i,j},{i,1,20},{j,1,20}],1];weights=1./Map[Apply[Times,#]&,locations];testMatrix=Normal[SparseArray[Map[#->1&,RandomSample[weights->locations,200]],{20,20}]];r1=MatrixRandomize[testMatrix];r2=MatrixRandomize[testMatrix,Method->"PreserveRowTotals"];r3=MatrixRandomize[testMatrix,Method->"PreserveColumnTotals"];r4=MatrixRandomize[testMatrix,Method->"PreserveRowAndColumnTotals","Swaps"->10000];GraphicsRow[Map[ColorNegate[Image[#,ImageSize->150]]&,{testMatrix,r1,r2,r3,r4}]]

Out[]=