7
$\begingroup$

I want to read (temperature) values from plotted (cooling) curves and visualize them in layered circles.

I have an example made manually for clarification:

3 plotted curves, at certain time steps the value of all plotted curves are read out -> I made a scale assigning (temperature) values to colors.

These colors are used further to color the inner circle (value from curve "center"), the mid-layer (value from curve "half radius") and the outer layer (value from curve "radius").

Data can be found here (csv-file)

Thank you for helping me! enter image description here

Improve this question
$\endgroup$
9
  • $\begingroup$ yes, thats true, I will remove the color of the curve later. $\endgroup$
    – Shukoff
    Nov 4 '13 at 11:24
  • $\begingroup$ Do you want to dynamically change the position of "sections" or it should be constant? $\endgroup$
    – Kuba ♦
    Nov 4 '13 at 13:09
  • $\begingroup$ Not constant, should be possible to change them. $\endgroup$
    – Shukoff
    Nov 4 '13 at 13:16
  • 1
    $\begingroup$ @Shukoff Please do not accept my answer so quickly. I did not manage to finish it and when you accept my answer you dissuade others from giving it a try! $\endgroup$
    – C. E.
    Nov 4 '13 at 18:09
  • 1
    $\begingroup$ In my opinion the question about "how to reverse the order of a horizontal BarLegend" should be a new, separate question. It is a perfectly good stand-alone problem, and really completely unrelated to this "fill circle layers with colors" question, except that you personally happen to want both features on one chart. $\endgroup$
    – Simon Woods
    Nov 5 '13 at 12:09
9
$\begingroup$

Not the prettiest, perhaps, but I just wanted to finish what I started. I was able to finish it after having read ssch excellent answer and see how he used Offset. This plot was truly a challenge to me, and the problem is in combining the different graphics. Had I tried this again I would probably do everything with Graphics and not use ListLinePlot at all.

(*Time;Temperature center;Temperature half radius;Temperature radius*)
data = Rest /@ 
   Import["~/Downloads/mmadata.csv", "Table", 
    "FieldSeparators" -> ";"];
timeseries = Transpose[data];

(*Where to sample*)
samplepts = {500, 1000, 1500};

(*Generate disk*)

temperatureDisk[pt_, data_, r_] := Module[{colordata},
  colordata = 
   Reverse[ColorData[
      "TemperatureMap"] /@ ((data[[pt]] - 15)/(32 - 15))];
  MapIndexed[{#, 
     Disk[Offset[{0, -3 r}, {pt, Min[data]}], 
      Offset[(r/3) (4 - First@#2)]]} &, colordata]
  ]

p = ListLinePlot[timeseries, GridLines -> {samplepts, {}}, 
   GridLinesStyle -> Dashed];

g = Graphics[temperatureDisk[#, data, 10] & /@ samplepts];

legend = SwatchLegend[
   ColorData["TemperatureMap"] /@ Flatten[{0, (Range[10]/10), 32}],
   Flatten[{"< 15", Round[(32 - 15) (Range[10]/10) + 14], "> 32"}],
   LegendLayout -> "Column"
   ];

GraphicsRow[{
  Show[
   p,
   g,
   PlotRange -> {{0, Length[First[timeseries]]}, {Min[data], 
      Max[data]}},
   AxesOrigin -> {0, Min[data]},
   PlotRangeClipping -> False,
   ImagePadding -> {{All, All}, {40, All}}
   ],
  legend
  }, Spacings -> 0, ImageSize -> 500]

scrn

Improve this answer
$\endgroup$
5
  • $\begingroup$ in a second step: is there an easy way to create a table from the colored circles from different such graphs (circles of each graph per row; header: "experiment", samplept1, samplept2,...)? $\endgroup$
    – Shukoff
    Nov 4 '13 at 22:19
  • $\begingroup$ @Shukoff Yes, it should be easy. All you need is the temeperatureDisk function and TableForm or possibly GraphicsGrid. TableForm is better if you want headers. You can turn the output into an image using Rasterize. $\endgroup$
    – C. E.
    Nov 5 '13 at 7:10
  • $\begingroup$ And how to insert a horizontal BarLegend for TemperatureColors below the temperatureDisk with the temperature on it decreasing from left to right? $\endgroup$
    – Shukoff
    Nov 5 '13 at 7:51
  • $\begingroup$ @Shukoff I'm not good at combining graphics like this but you could try to wrap the entire thing with GraphicsColumn. The risk is you will get a large white space in between the plot and the bar, which perhaps could be fixed by playing with AspectRatio and perhaps not. $\endgroup$
    – C. E.
    Nov 5 '13 at 10:20
  • $\begingroup$ Thank you very much for your answers, helped very much! $\endgroup$
    – Shukoff
    Nov 5 '13 at 14:05
10
$\begingroup$

(This answer has just the circles, not the box with color scale information)

To get circular looking disks I use Offset[r] for the radius, which ignores aspect-ratio and plot scale:

Plot[x, {x, 0, 30}, AspectRatio -> 1/10, Epilog -> {
   {Red, Circle[{5, 5}, 5]},
   {Green, Circle[{20, 20}, Offset[10]]}
   }]

enter image description here

When putting Graphics together with Show the Axes will also extend, I avoid this with ImagePadding Which also allows to put everything in Epilog:

p = Plot[x, {x, 0, 30}];
GraphicsRow[{
  Show[{p, Graphics[{Disk[{15, -15}, Offset[10]]}]},
   PlotRangeClipping -> False,
   PlotRange -> All],
  Show[p,
   Epilog -> {Disk[{15, -15}, Offset[10]]},
   PlotRangeClipping -> False, ImagePadding -> {{All, All}, {50, All}}]
  }]

axes

This function takes a Graphics object and a list of x-values as argument and for each curve (Line) makes a disk layer.

The list wrangling became quite ugly, if you need clarification on some parts just ask.

ClearAll[circleLayer]
Options[circleLayer] = {
   ColorFunctionScaling -> True,
   ColorFunction -> ColorData["Temperature"],
   "Radius" -> 10};
circleLayer[g_Graphics, ind_List, OptionsPattern[]] := Module[{
   fns = Cases[g, l_Line :> Interpolation[l[[1]]], Infinity],
   plotRange = (PlotRange /. AbsoluteOptions[g, PlotRange]),
   fpts, pts, lines, colorF, rmax
   },
  {rmax, colorF} = OptionValue[{"Radius", ColorFunction}];

  fpts = MapIndexed[
     {ConstantArray[rmax (1 - First[#2]/(Length[fns] + 1)), Length[ind]],
      ind, #[ind]}\[Transpose] &,
     fns
     ]~Flatten~1;
  (* Lines from curves to disks *)
  lines = {Dashed, Line[
     (x \[Function] {Offset[{0, -1.5 rmax}, {x, plotRange[[2, 1]]}],
                    {x, Max[Through[fns[x]]]}}) /@ ind ]};
  (* points on curve *)
  pts = {Gray, Disk[#, Offset[rmax/5]] & /@ fpts[[All, 2 ;; 3]]};

  If[OptionValue[ColorFunctionScaling],
   fpts[[All, 3]] = Rescale[fpts[[All, 3]]]
   ];

  Show[g,
   PlotRangeClipping -> False,
   ImagePadding -> {{All, All}, {4 rmax, All}},
   Epilog -> {
     EdgeForm[Black],
     pts, lines,
     Function[{r, x, y},
       {colorF[y],
        Disk[
         Offset[{0, -3 rmax}, {x, plotRange[[2, 1]]}],
         Offset[r]
         ]}] @@@ fpts}]]

Example:

circleLayer[
 Plot[{x, x^2, Sin[x]}, {x, -1, 1}],
 {-1/3, 1/3, 2/3, 1}]

example

For the linked data you get something like:

listplot

Improve this answer
$\endgroup$
8
  • $\begingroup$ how to insert the scaled PlotLegend? and how to color the line around the circles and its layers with the corresponding color (removal of the black circle lines)? $\endgroup$
    – Shukoff
    Nov 4 '13 at 21:22
  • $\begingroup$ @Shukoff Get rid of EdgeForm to remove the borders. For the legend (assuming you don't mean just text) you need to build it yourself and then Show it together with the plot or put it in the Epilog. $\endgroup$
    – ssch
    Nov 4 '13 at 21:47
  • $\begingroup$ Just a tiny remark, I find usefult to create disks with Point + PointSize to not worry about ratios. $\endgroup$
    – Kuba ♦
    Nov 4 '13 at 22:24
  • $\begingroup$ @Kuba Oh quite right, thanks for the reminder! $\endgroup$
    – ssch
    Nov 4 '13 at 23:18
  • $\begingroup$ @ssch Offset[10] is interesting - is this usage documented? In the help, it only gives Offset[{dx,dy},position] and I would never guess what giving a single number would do... :) $\endgroup$
    – cormullion
    Nov 5 '13 at 12:37
2
$\begingroup$

Like Anon, I didn't know about the Offset option, which turned out to be useful. I didn't finish my attempt, but here is how far I got - and with the use of Offset. I was interested in whether it was possible to do the job with a single ListLinePlot command. I'm not sure it is (there's still work to do with scaling the disks somehow), but this is as close as I got:

ListLinePlot[
 {data[[2 ;; -1, {1, 2}]], data[[2 ;; -1, {1, 3}]], 
  data[[2 ;; -1, {1, 4}]]},
 PlotRange -> {{-50, 2100}, {-5, 35}},
 PlotStyle ->  {Red, Blue, Purple},
 ImageSize -> 800, ImagePadding -> 25,
 Epilog -> Table[
   {xcenter, ycenter} = data[[x, {1, 2}]]; 
   yhalfradius = data[[x, 3]];
   yradius = data[[x, 4]];
   {
    Thin, Red,
    Line[{{xcenter, -3}, {xcenter, ycenter}}],
    ColorData["TemperatureMap"][Rescale[ycenter, {1, 30}]],
    Disk[{xcenter, -3}, Offset[Rescale[ycenter, {1, 4}]]],
    Disk[{xcenter, ycenter}, Offset[3]],
    ColorData["TemperatureMap"][Rescale[yhalfradius, {1, 30}]],
    Disk[{xcenter, -3},   Offset[Rescale[yhalfradius, {1, 4}]]],
    Disk[{xcenter, yhalfradius}, Offset[3]],
    ColorData["TemperatureMap"][Rescale[yradius, {1, 30}]],
    Disk[{xcenter, -3}, Offset[Rescale[ yradius, {1, 4}]]],
    Disk[{xcenter, yradius}, Offset[3]]
    },
   {x,   {2, 252, 501, 1001, 1501, 2001}}],
 PlotLegends -> Placed[data[[1, 2 ;;]], {0.75, 0.85}]
 ]

plot

Improve this answer
$\endgroup$

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.