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 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

share|improve this question
    
yes, thats true, I will remove the color of the curve later. –  Shukoff Nov 4 '13 at 11:24
    
Do you want to dynamically change the position of "sections" or it should be constant? –  Kuba Nov 4 '13 at 13:09
    
Not constant, should be possible to change them. –  Shukoff Nov 4 '13 at 13:16
    
@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! –  Pickett Nov 4 '13 at 18:09
    
@Anon: ok, makes sense. Thanx! –  Shukoff Nov 4 '13 at 18:13

3 Answers 3

up vote 8 down vote accepted

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

share|improve this answer
    
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,...)? –  Shukoff Nov 4 '13 at 22:19
    
@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. –  Pickett Nov 5 '13 at 7:10
    
And how to insert a horizontal BarLegend for TemperatureColors below the temperatureDisk with the temperature on it decreasing from left to right? –  Shukoff Nov 5 '13 at 7:51
    
@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. –  Pickett Nov 5 '13 at 10:20
    
Thank you very much for your answers, helped very much! –  Shukoff Nov 5 '13 at 14:05

(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

share|improve this answer
    
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)? –  Shukoff Nov 4 '13 at 21:22
    
@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. –  ssch Nov 4 '13 at 21:47
    
Just a tiny remark, I find usefult to create disks with Point + PointSize to not worry about ratios. –  Kuba Nov 4 '13 at 22:24
    
@Kuba Oh quite right, thanks for the reminder! –  ssch Nov 4 '13 at 23:18
    
@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... :) –  cormullion Nov 5 '13 at 12:37

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

share|improve this answer

Your Answer

 
discard

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

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