Why do Tooltips slow down Dynamic so much? Is there a faster alternative?

Question

I'm working on a Dynamic ListPlot with a few thousand plots, and it seems that wrapping the points with Tooltip slows the Dynamic responsiveness substantially. With the simple example below, dragging the Slider is sluggish. If you change the Show line from "plot1" to "plot2", the Slider response is smooth. Notice that the ListPlot and Tooltips are not being modified by the Control. Maybe Show is muddling things when it combines the graphics, but still, the slowdown doesn't make sense to me, since Tooltip isn't active during the drag, and isn't changing in any way.

x = Table[RandomVariate[NormalDistribution[0, .5], 2], {i, 5000}];
boxPts[x_] := {{x, x}, {-x, x}, {-x, -x}, {x, -x}};
plot1 = ListPlot[MapIndexed[Tooltip[#1, First[#2]] &, x]];
plot2 = ListPlot[x];
Control[{{z, .5}, 0, 1.5}]
overlay = Graphics[{Opacity[.2],
    FilledCurve[{{Line[boxPts[1.5]]}, {Dynamic[Line[boxPts[z]]]}}]}];
Show[overlay, plot1, PlotRange -> 1.5, AspectRatio -> 1]

I'd prefer to be able to use Tooltip, if it's fixable, or at least understand why it's so slow. I'd also be interested in any alternative methods for doing mouseover-style feedback, which could show up inside or outside the plot area. Thank you!

(This is in Mma 9.0.1 on OSX 10.8.5, on a 2012 MBP.)

Update: I noticed that if I execute the Control line after the Show line with plot1, the Slider works smoothly. I then noticed that merely moving the cursor away to a new point can make the Control work normally. This only makes a difference with the plot that has Tooltips, since the other is always smooth.

Answer 1

This is a very common problem for people who work on data analysis. Here as a solution to the problem using LocatorPane and a few other functions and tricks.

    TooltipListPlot[data_, tipFunction_, listPlotOptions___] := DynamicModule[
    {displayQ = False, yRange , xRange, pt, minX, maxX, minY, maxY, tip, threshold, tipPosition, nf, dataPoints, dataAsRulesQ = Head@data[[1]]===Rule}
,
    dataPoints := If[dataAsRulesQ, #[[1]]&/@data, data];
    nf = Nearest@data;
    {maxY, minY} = {Max[#], Min[#]} &@dataPoints[[All, 2]];
    {maxX, minX} = {Max[#], Min[#]} &@dataPoints[[All, 1]];
    pt = {maxX, maxY}*2;
    yRange = maxY - minY ;
    xRange = maxX - minX;
    tipPosition[point_] := {
        Which[point[[1]] < minX + 0.1 xRange,
            Left
        ,point[[1]] > maxX - 0.1 xRange,
            Right
        ,True,
            Center
        ]
    ,
        Which[point[[2]] < minY + 0.1 yRange,
            Bottom
        ,point[[2]] > maxY - 0.1 yRange, 
            Top
        ,True,
            Top
        ]
    };
    threshold = EuclideanDistance[{minX, minY}, {maxX, maxY}]/100.;
    LocatorPane[Dynamic[pt,
        (
        pt = #;
        tip = nf[pt, {1, threshold}];
        displayQ = tip =!= {};
        ) &
        ]
    ,
        Show[
            ListPlot[dataPoints, listPlotOptions]
        ,
            Graphics[{
                Dynamic@
                 If[displayQ, 
                    Text[
                        Framed[tipFunction@tip[[1]]
                        , Background -> Lighter@Lighter@Lighter@Yellow
                        , FrameStyle -> Directive[Opacity[0], White]
                        , FrameMargins -> 2
                        ]
                    , {pt[[1]], pt[[2]]}
                    , tipPosition[pt]
                    ]
                , {}
                ]
            }]
        ]
    , AutoAction -> True
    , Appearance -> None
    ]
]

This is a test example for 10,000 points.

data = Table[RandomVariate[NormalDistribution[0, .5], 2], {i, 10000}];
tipsFunc = 
  Labeled[Column[#, Frame -> True, FrameStyle -> Red], 
    Rotate[": )", -Pi/2]] &;
TooltipListPlot[data, tipsFunc, ImageSize -> 400, Frame -> True, 
 Axes -> False]

And this is a snapshot of the result.

Note that with the latest imrpovement it is now also possible to input data as rules which in some cases may be more appropriate for creating the tooltips. Following is a simple example.

dataAsRules=Table[RandomVariate[NormalDistribution[0,.5], 2]->StringJoin["my tooltip info ",ToString[i]],{i,10000}];
tipsFunc = #&;
TooltipListPlot[dataAsRules,tipsFunc, Frame->True, Axes->False,ImageSize->400]