Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

I've written the standard version of a tree map (a graphic that shows nested data) and I'm looking to improve on this layout by switching to different types of polygons or perhaps circles. Can anyone see a way to adapt this code in the style of a Voronoi diagram or otherwise?

enter image description here

enter image description here

Here is the code:

$buf = .05; $3Dbuf = .1; $3DQ = True;
ToList[x_List] := x;
ToList[x_] := {x};
FlatJoin[list___] := Join @@ (ToList /@ {list});
Second[x_] := x[[2]];

$frameStyle = Sequence[EdgeForm[Directive[Opacity[0.6], Black, Thin]], GrayLevel[.7], Opacity[.1]];
    $leafStyle = Sequence[EdgeForm[Directive[Black, Thin]], GrayLevel[1], Opacity[1]];

    drawRectangle[{p1_, p2_}, area_List, max_, depth_] /; Length[area] > 1 := 
    {{$frameStyle, 
        	If[$3DQ, Cuboid[Append[p1, depth], Append[p2, depth]], Rectangle[p1, p2]]},
    {First @ TreeMap[area, (1-$buf)p1 + $buf p2, (1-$buf)p2 + $buf p1, max, depth + $3Dbuf]}};

    drawRectangle[{p1_, p2_}, _, max_, depth_] := {$leafStyle, 
        		If[$3DQ, Cuboid[Append[p1, depth], Append[p2, depth]], Rectangle[p1, p2]]};


    TreeMap[areas2_, lowerLeft2_, upperRight_, max_, depth_:0] := Module[
        {
            width, height, area, aspectRatio, fixedLengthDirection,
            fittedAreas, i, j, varLength, fixedLength, incs, last,
            aspectRatios, incsPts, lowers, uppers, layout, vl, recs,
            prims, lowerLeft, areas, areas1
        },

        prims = {};
        areas1 = areas2 / Total[areas2, {1, Infinity}] * Apply[Times, upperRight - lowerLeft2];
        areas = Total[areas1, {2,Infinity}];
        lowerLeft = lowerLeft2;
        For[j = 1, j <= Length[areas], Null,

        {width, height} = Subtract[upperRight, lowerLeft];
        area = width * height;
        aspectRatio = width / height;

        If[aspectRatio < 1,
            fixedLength = width;
            fixedLengthDirection = "Horizontal",
            fixedLength = height;
            fixedLengthDirection = "Vertical"
        ];

        If[j == Length[areas], 
            AppendTo[prims,  drawRectangle[{lowerLeft, upperRight}, Last @ areas1, max, depth]]; Break[]];

        For[i = j, i <= Length[areas], i++,
            fittedAreas = areas[[j;;i]];
            varLength = Total[fittedAreas] / fixedLength;
            incs = fittedAreas / varLength;
            If[i > 1 && Max[varLength / incs] >= max, Break[]];
            layout = {varLength, incs, areas1[[j;;i]]};
        ];
        j = i;

        If[fixedLengthDirection === "Vertical",
            incsPts = FlatJoin[Second[lowerLeft], Second[lowerLeft] + Accumulate[layout[[2]]]];
            lowers = Thread[{First[lowerLeft], Most[incsPts]}];
            uppers = Thread[{First[lowerLeft] + layout[[1]], Rest[incsPts]}];
            recs = Transpose[{lowers, uppers}]
        ,
            incsPts = FlatJoin[First[lowerLeft], First[lowerLeft] + Accumulate[layout[[2]]]];
            lowers = Thread[{Most[incsPts], Second[lowerLeft]}];
            uppers = Thread[{Rest[incsPts], Second[lowerLeft] + layout[[1]]}];
            recs = Transpose[{lowers, uppers}]
        ];

        AppendTo[prims, MapThread[
            drawRectangle[##, max, depth]&, {recs, layout[[3]]}]];
            lowerLeft = If[fixedLengthDirection === "Vertical",
            {First[lowerLeft] + layout[[1]], Second @ lowerLeft}, 
            {First @ lowerLeft, Second[lowerLeft] + layout[[1]]}
        ];
        ];

         If[$3DQ, Graphics3D[#, Boxed -> False, 
            Background -> Black]&, Graphics][{prims}]
    ];
share|improve this question
11  
I'm glad you weren't disheartened by the reception and closure (and deletion) of your previous post on treemaps, and made an effort on the code (actually, a working implementation) — a hearty +1 for that! I wish more new users were like this :) –  rm -rf Jun 3 '12 at 6:13
    
Thanks @R.M. I found a good explanation of basic algorithm here: win.tue.nl/~vanwijk/stm.pdf –  M.R. Jun 3 '12 at 6:18
1  
FlatJoin seems like a strange function; could you not write FlatJoin[list___] := Flatten[{list}, 1]? –  Mr.Wizard Jun 3 '12 at 6:31
    
Yes, that is much better, thanks. –  M.R. Jun 3 '12 at 6:40
1  
You could try using RLink as there are some nice Treemap plotting packages in R. There is some R code here you could implement (if you have Windows mathematica.stackexchange.com/questions/15373/…): stat.auckland.ac.nz/~paul/Reports/VoronoiTreemap/… –  Jonathan Shock Mar 20 '13 at 5:27
show 2 more comments

Know someone who can answer? Share a link to this question via email, Google+, Twitter, or Facebook.

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Browse other questions tagged or ask your own question.