7
$\begingroup$

I'm looking for a way to visualize evolution of histogram over time. You have $n$ timesteps, each with its own set of data, and I want to create $n$ histograms and visualize them as a density plot. Basically I want to demonstrate how the distribution of a 1-dimensional quantity changes over time.

In my weights and biases project it looks like this:

enter image description here

A concrete application for Mathematica is below. I'm using ListPlot to visualize it, but ListPlot doesn't quite have the right look.

Ideally it would look like a density plot, perhaps with some marking separating the region of 0 density from non-zero density. Any tips appreciated!

numSamples = 100;
numSteps = 1000;

SeedRandom[1];
p = 1;
n = 200;
alpha = 1.5;
sampler = 
  Switch[n, 2, CirclePoints, 3, SpherePoints, _, 
   RandomPoint[Sphere[n], #] &];
xb0 = sampler[numSamples];
h = Table[1/i^p, {i, 1, n}] // N;
hb = Table[alpha h, {numSamples}];
batchStep[xb_] := xb - hb*xb;
xTrajectories = 
 NestList[batchStep, xb0, 
  numSteps - 1];(*numSteps x numSamples x n*)
yTrajectories = 
 Map[Total[#*h*#] &, 
  xTrajectories, {2}];(*numSteps x numSamples*)
(*turn into ListPlot \
friendly format*)
\
(*augment=Compile[{{trajectory,_Real,1}},MapIndexed[{First@#2,#1}&,\
trajectory]];
logyTrajectories=augment/@Transpose[Log@yTrajectories];(*numSamples,\
numSteps,2*) *)
logyTrajectories = Transpose@Log@yTrajectories;
meanTrajectory = Mean[logyTrajectories];
logyTrajectories = (# - meanTrajectory) & /@ 
  logyTrajectories; (* decenter *)
logyTrajectories = 
 Transpose[
  RandomSample /@ 
   Transpose[
    logyTrajectories]]; (* randomize *)
ListPlot[logyTrajectories]

enter image description here

$\endgroup$
1
  • 1
    $\begingroup$ Look at Histogram3D and let time be one dimension. $\endgroup$ Jul 21 at 2:15
12
$\begingroup$
data = MapIndexed[Thread[{#2[[1]], #}] &, Transpose@logyTrajectories]; 

dhcount = DensityHistogram[Join @@ data, {{.5 + Range[0, 1001]}, 40}, 
  AspectRatio -> 1/2, ImageSize -> 900, PerformanceGoal -> "Speed"]

enter image description here

ClearAll[tooltip]
tooltip[pt_]:= Panel[SmoothHistogram[
     logyTrajectories[[All, Clip[Floor[pt[[1]]] + 1, {1, 1000}]]], 
     Filling -> Axis, PlotRange -> {{-.75, .75}, {0, 10}}, 
     ImageSize -> 200, AspectRatio -> 1/2, 
     PlotLabel -> Style[Clip[Floor[pt[[1]]] + 1, {1, 1000}], 22, Gray]], 
   Background -> White, ImageSize -> {Automatic, All}, 
   ImageMargins -> 0, Alignment -> Center]

 DynamicModule[{pt = {1, 0}}, 
 LocatorPane[Dynamic[pt], 
  Show[dhcount, Graphics[{Thick, Dashed, Blue, 
     Dynamic @ Tooltip[Line[{{#, -1}, {#, 1}} &@Clip[pt[[1]], {1, 1000}]], 
       tooltip[pt]]}]], Appearance -> None]]

enter image description here

epilogs = Table[First @ SmoothHistogram[logyTrajectories[[All, i]], 
      Filling -> Axis, PlotRange -> {{-1, 1}, {0, 14}}, ImageSize -> 150, 
      AspectRatio -> 1/2], {i, 1000}] /. 
   ll : (_Line | _Polygon) :> GeometricTransformation[ll, 
     TranslationTransform[{1050, 0}]@*ScalingTransform[{30, 1}]@*
      ReflectionTransform[{1, -1}]];


Show[dhcount, PlotRange -> {{0, 1250}, {-1, 1}}, 
 FrameTicks -> {{Automatic, Automatic}, {Range[0, 1000, 100], Automatic}}, 
 Epilog -> Dynamic[{Text[Style[Clip[Floor @ First @
      CurrentValue[{"MousePosition", "Graphics", {0, 0}}], {1, 1000}], 24, 
        Gray], Scaled[{.9, .9}]], 
    Thick, Dashed, Blue, 
    Line[{{#, -1}, {#, 1}} & @ Clip[First @
        CurrentValue[{"MousePosition", "Graphics", {0, 0}}], {1, 1000}]], 
    Dashing[{}], 
    epilogs[[Clip[Floor @ First @
         CurrentValue[{"MousePosition", "Graphics", {0, 0}}], {1, 1000}]]]}]]

enter image description here

We get much more responsive interaction using tooltip as the setting for "DisplayFunction" suboption for CoordinateToolOptions (but could not figure out how to add the vertical lines):

Show[dhcount, CoordinatesToolOptions -> {"DisplayFunction" -> tooltip}]

enter image description here

$\endgroup$
1
  • 1
    $\begingroup$ Amazing! (I have to enter more characters to have this comment accepted but the first 8 characters says it all.) $\endgroup$
    – JimB
    Jul 22 at 20:08
11
$\begingroup$

If you have 1,000 sets of 100 sample points, then having animated smooth histograms would seem ideal to show change.

h = Table[SmoothHistogram[logyTrajectories[[All, i]], Automatic, "PDF",
    PlotRange -> {MinMax[Flatten[logyTrajectories]], {0, 14}},
    PlotLabel -> Style[ToString[i], Bold, 24]], {i, 1000}];

Export["smooth.gif", h]

Animated smooth histograms

Note that only the first 250 frames are shown above because of file size limits for this site.

An alternative is to show both the paths and the smooth histograms with a red line to identify where in the set of paths the smooth histogram represents.

lp = ListPlot[logyTrajectories];
h = Table[
   GraphicsRow[{Show[lp, ListPlot[{{i, -0.9}, {i, 0.8}}, PlotStyle -> Red, Joined -> True]],
     SmoothHistogram[logyTrajectories[[All, i]], Automatic, "PDF",
      PlotRange -> {MinMax[Flatten[logyTrajectories]], {0, 14}}]}], {i, 5, 500,5}];
Export["smooth.gif", h]

Smooth histogram with reference to paths

And one could rearrange the two figures so that the common axis is parallel to each other if that would use less space and/or be easier to interpret.

$\endgroup$
1
$\begingroup$

You can try something like

k=SmoothKernelDistribution/@logyTrajectories;
curves=Table[{x/Length[k],y,PDF[k[[x]],y]},{x,Length[k]}];
range={y}~Join~MinMax[logyTrajectories];
ParametricPlot3D[
    curves,
    Evaluate@range]

to get the evolution of the histogram

histogram evolution

(The x-axis is the fraction of 1-100, the y-axis is the trajectory value, the z-axis is a smoothed histogram of the data.)

You can make it more visually pleasing (for example, stretching out the x-axis) by specifying options to your liking.

$\endgroup$
1
  • $\begingroup$ I might have the directions wrong---you might need a Transpose[] around the logyTrajectories in the first line. $\endgroup$
    – evanb
    Jul 21 at 14:54

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.