4
$\begingroup$

I have a distance matrix data, and want to visualize it as below:

enter image description here

The current codes I am using is:

data={{0., 1.2, 1.73, 3.57, 3.22, 3.17}, {1.2, 0., 0.53, 2.37, 2.05, 
  1.97}, {1.73, 0.53, 0., 1.85, 1.54, 1.45}, {3.57, 2.37, 1.85, 0., 
  0.42, 0.41}, {3.22, 2.05, 1.54, 0.42, 0., 0.31}, {3.17, 1.97, 1.45, 
  0.41, 0.31, 0.}};

DendrogramPlot[DirectAgglomerate[data,Style[#, 16] & /@ {"G1", "G2", "G3", "G4", "G5", "G6"},Linkage -> "Single"], LeafLabels -> Automatic,Orientation -> Right,
  PlotStyle -> {Red, Thick}, Axes -> {True, False},AxesOrigin -> {-1, 0}, ImageSize -> 560, AxesStyle -> {{Directive[Gray, 12], Arrowheads[.02]}, Automatic},AspectRatio -> 1/2]

which results:

enter image description here

The cluster distances information can be easily obtained by:

DirectAgglomerate[data,Style[#,16]&/@{"G1","G2","G3","G4","G5","G6"},Linkage->"Single"]

which is:

Cluster[Cluster[G1,Cluster[G2,G3,0.53,1,1],1.2,1,2],Cluster[Cluster[G5,G6,0.31,1,1],G4,0.41,2,1],1.45,3,3]

how can I label the cluster distances into the DendrogramPlot automatically?

PS: I noticed there is already a similar post here: , but the answer does not label the distances as text something like the Python implementation here.

$\endgroup$
4
$\begingroup$

Post-processing the DendrogramPlot output to extract the cluster distances and placing them in appropriate locations:

dplt = DendrogramPlot[DirectAgglomerate[data, 
    Style[#, 16] & /@ {"G1", "G2", "G3", "G4", "G5", "G6"}, 
    Linkage -> "Single"], LeafLabels -> Automatic, 
   Orientation -> Right, PlotStyle -> {Red, Thick}, 
   Axes -> {True, False}, AxesOrigin -> {-1, 0}, ImageSize -> 560, 
   AxesStyle -> {{Directive[Gray, 12], Arrowheads[.02]}, Automatic}, 
   AspectRatio -> 1/2];

( thanks: BobHanlon for the simpler version for rule)

rule = Line[a : {_, {x_, y1_}, {x_, y2_}, _}] :> {Line[a], Black, 
         FontSize -> 16, Text[x, {x, (y1 + y2)/2}, {1, 0}, {1, 0}]};

dplt /. rule

Mathematica graphics

Alternatively:

labels = Cases[dplt, Line[a : {_, {x_, y1_}, {x_, y2_},_}] :>
   {Black, FontSize -> 16, Text[x, {x, (y1 + y2)/2}, {1, 0}, {1, 0}]}, Infinity];

Show[dplt, Graphics@labels]

Mathematica graphics

$\endgroup$
  • 1
    $\begingroup$ ... this works when Orientation->Right. For other orientations, similar rules can be constructed. $\endgroup$ – kglr May 15 '16 at 13:40
  • $\begingroup$ I should learn more on the programmar details of Mathematica. Thank you! $\endgroup$ – LCFactorization May 15 '16 at 13:55
  • 1
    $\begingroup$ @LCFactorization, glad it worked for you. Pity there is no option that gives control on the labeling directly. Thank you for the Accept. $\endgroup$ – kglr May 15 '16 at 13:59
  • 1
    $\begingroup$ An alternative rule: line : Line[{_, {x_, y1_}, {x_, y2_}, _}] :> Sequence[line, {Black, Text[Style[NumberForm[x, {3, 2}], 12], {x, (y1 + y2)/2}, {1.25, 0}]}] This also would have to be modified or generalized to handle a different Orientation $\endgroup$ – Bob Hanlon May 15 '16 at 14:08
  • 1
    $\begingroup$ @BobHanlon, thank you, that's much cleaner. $\endgroup$ – kglr May 15 '16 at 14:17

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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