1
$\begingroup$

I have the following code which results in the heatmap shown:

indexnames2 = {"A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M"};
tblname = "Test Plot"
distmat = {{1.0, 0, 0, 0, 0, 0, 0.022, 0.015, 0, 0, 0, 0.0074}, {0, 
    1.0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 1.0, 0, 0, 0, 0, 0, 0, 
    0, 0, 0}, {0, 0, 0, 1.0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 
    1.0, 0, 0, 0, 0, 0, 0.45, 0}, {0, 0, 0, 0, 0, 1.0, 0, 0, 0, 0, 0, 
    0}, {0.022, 0, 0, 0, 0, 0, 1.0, 0.63, 0, 0, 0, 0.20}, {0.015, 0, 
    0, 0, 0, 0, 0.63, 1.0, 0, 0, 0, 0.12}, {0, 0, 0, 0, 0, 0, 0, 0, 
    1.0, 0.20, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0.20, 1.0, 0, 0}, {0, 
    0, 0, 0, 0.45, 0, 0, 0, 0, 0, 1.0, 0}, {0.0075, 0, 0, 0, 0, 0, 
    0.20, 0.12, 0, 0, 0, 1.0}};
ticks = Transpose[{Range[Length[indexnames2]], indexnames2}];
color[z_] := 
 Which[z == 0, Blue, 0 < z < 1, 
  ColorData["TemperatureMap"][Rescale[z, {0, 1}]]]

Legended[MatrixPlot[distmat, ColorFunction -> color, 
  ColorFunctionScaling -> False, RotateLabel -> True, 
  ImageSize -> {500, 500}, 
  PlotLabel -> Style[tblname, FontSize -> 18], 
  FrameTicks -> {ticks, None, None, 
    MapAt[Rotate[#, 90 Degree] &, ticks, {All, 2}]}], 
 BarLegend[{"TemperatureMap", {0, 1}}]]

enter image description here

I would like for the entries to be sorted so the most similar entities are shown in the top right and the least similar are shown in the bottom right. Is there a Mathematica function for this that would make the plot look more like the one shown below (I know this one is also not sorted but it does show some clustering like I want to achieve.)?

enter image description here

$\endgroup$
3
  • $\begingroup$ Use FindClusters or FindGraphCommunities. $\endgroup$
    – Szabolcs
    May 8, 2020 at 12:27
  • $\begingroup$ One thing to try is "minimum bandwidth" -- see the answer here: mathematica.stackexchange.com/a/32007/1783 $\endgroup$
    – bill s
    May 8, 2020 at 12:29
  • $\begingroup$ I'm not sure if FindClusters can work with a pre-computed distance matrix, but perhaps you have the source data too. Sorry, no time for a full answer, but I hope these are useful references. $\endgroup$
    – Szabolcs
    May 8, 2020 at 12:29

1 Answer 1

4
$\begingroup$

You may use ResourceFunction["SymmetricSort"].

I am defining "most similar" to be number of near-by entities and small distance to those entities. Using distmat as in OP.

MatrixPlot[distmat, FrameTicks -> Range@12]

Mathematica graphics

Can Count the number of zero entries (small if many near-bys) and Total the distances (small if close).

close = Through[{Count[0], Total}@#] & /@ distmat;
Short[close, .5]
{{8,1.0444},{11,1.},<<9>>,{8,1.3275}}

Take the Ordering of the close metrics. Numerical ordering will do since we want smallest values in both metrics.

sortIndex = Ordering[close]
{1, 12, 8, 7, 9, 10, 5, 11, 2, 3, 4, 6}

sortIndex give the order of the items (indexed 1 to 12) in the sorted matrix. For example, the 12th item should placed in the 2nd position of the new matrix.

ResourceFunction["SymmetricSort"] distmat with sortIndex.

ssdistmat = ResourceFunction["SymmetricSort"][distmat, sortIndex];
MatrixPlot[ssdistmat
 , FrameTicks -> 
  ConstantArray[{MapIndexed[Flatten@Reverse@{##} &, sortIndex], None}, 2]
 ]

Mathematica graphics

The distance matrix is sorted by similarity.

Hope this helps.

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.