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 create a two-dimensional plot using data from an external file. This file contains several triplets of numbers. The first two columns indicate the x and y position, while the third one works as an indicator for every (x,y) point. The desired plot should depict each point as a colorful dot and the color of each dot should be assigned according to the value of the third column. I used ListDensityPlot to create my plot but for a strange reason it joins all the points together and of course spreads the colors. This is the code I used:

SetDirectory[" ... To be inserted ... "];
data = Import["Esc_data.out", "Table"];
S1 = ListDensityPlot[data, Mesh -> None, ColorFunction -> "Rainbow", 
PlotLegends -> Placed[BarLegend[Automatic, LegendMargins -> 
{{0, 0}, {10, 5}}, LegendLabel -> "\!\(\*SubscriptBox[\(log\), \(10\)]\)(Tesc)",
LabelStyle -> {FontSize -> 15, FontFamily -> "Helvetica"}], 
Right], PerformanceGoal -> "Quality", FrameLabel -> {"x", "y"}, 
RotateLabel -> False, 
LabelStyle -> Directive[FontSize -> 17, FontFamily -> "Helvetica"], 
ImageSize -> 500]

The correct plot should be the following: correc plot

It took me two minutes and four lines in gnuplot to create this plot! So, it must be achievable in Mathematica too. However, I couldn't find out how to control the size of the dots and mainly how to "tell" to the program not to join the points between them.

The data file can be obtained here or here.

Many many thanks in advance!


I modified VLC's last version like this

Clear[colorbar]
colorbar[{min_, max_}, colorFunction_: Automatic, divs_: 150] := 
DensityPlot[y, {x, 0, 0.1}, {y, min, max}, AspectRatio -> 10, 
PlotRangePadding -> 0, PlotPoints -> {2, divs}, MaxRecursion -> 0, 
Frame -> True, 
FrameLabel -> {{None, 
 "log10(\!\(\*SubscriptBox[\(T\), \(esc\)]\))"}, {None, None}}, 
LabelStyle -> Directive[FontFamily -> "Helvetica", 15], 
FrameTicks -> {{None, All}, {None, None}}, 
FrameTicksStyle -> Directive[FontFamily -> "Helvetica", 15, Plain], 
ColorFunction -> colorFunction]

With[{opts = {ImageSize -> {Automatic, 500}}, cf = "Rainbow"}, 
Row[{ListPlot[List /@ data[[All, {1, 2}]], 
PlotStyle -> ({PointSize[0.0045], ColorData[cf][#1]} & /@ 
   Rescale[data[[All, 2]], {1.5, 5}]), 
PlotRange -> {{-1, 1}, {-1, 1}}, AspectRatio -> 1, Frame -> True, 
AspectRatio -> 1, RotateLabel -> False, Axes -> None, 
FrameTicks -> True, FrameLabel -> {"x", "y"}, 
LabelStyle -> Directive[FontFamily -> "Helvetica", 17], 
ImagePadding -> {{60, 10}, {60, 20}}, opts], 
Show[colorbar[{1.5, 5}, cf], ImagePadding -> {{10, 60}, {20, 10}}, 
opts]}]]

Now the frame labels of the main plot are shown. However, the colorbar is larger than the square. I want the height of the colorbar to be the same as the height of the square. Finally, how could I merge in a Show this plot with the following contour

V = 1/2*(ω1^2*x^2 + ω2^2*y^2) - ϵ*x^2*y^2;
ω1 = 0.4; ω2 = 0.4;
ϵ = 1;
xmin = 1;
hesc = 0.0064;
C0 = ContourPlot[V, {x, -xmin, xmin}, {y, -xmin, xmin}, 
Contours -> {hesc}, ContourStyle -> {Gray, Thickness[0.003]}, 
AspectRatio -> 1, ContourShading -> False, PlotRange -> All, 
PlotPoints -> 200, ImageSize -> 500];

new plot

share|improve this question
    
@VLC The LegendLabel should be inserted inside the colorbar module? –  Vaggelis_Z Jan 10 '13 at 20:50
    
I suspect that there must be a much easier way to produce this plot. VLC's code working fine but you have to create the colorbar on your own! What I mean, is that ListDensityPlot SHOULD have an option like Joined->False. –  Vaggelis_Z Jan 10 '13 at 20:56
    
@VLC Hey, I am new here; I don't know all the rules yet! Anyway, I think that your solution is more close to what I want. The only issue is how to label the colorbar and also how could I change the fonts of the colorbar. –  Vaggelis_Z Jan 11 '13 at 11:33
add comment

3 Answers 3

up vote 12 down vote accepted

I would simply use ListPlot with a PlotStyle that is defined as a function of your third column:

ListPlot[List /@ data[[All, {1, 2}]], 
 PlotStyle -> ({PointSize[0.01], ColorData["Rainbow"][#1]} & /@ 
    Rescale[data[[All, 3]], {1.5, 4}]), 
 PlotRange -> {{-1, 1}, {-1, 1}}, AspectRatio -> 1, Frame -> True, 
 Axes -> None]

enter image description here

To add the color legend you could use the solution provided here that in your case would look like:

Clear[colorbar]
colorbar[{min_, max_}, colorFunction_: Automatic, divs_: 150] := 
 DensityPlot[y, {x, 0, 0.1}, {y, min, max}, AspectRatio -> 10, 
  PlotRangePadding -> 0, PlotPoints -> {2, divs}, MaxRecursion -> 0, 
  FrameTicks -> {None, Automatic, None, None}, 
  ColorFunction -> colorFunction]

With[{opts = {ImageSize -> {Automatic, 300}, ImagePadding -> 20}, 
  cf = "Rainbow"}, 
 Row[{ListPlot[List /@ data[[All, {1, 2}]], 
    PlotStyle -> ({PointSize[0.01], ColorData["Rainbow"][#1]} & /@ 
       Rescale[data[[All, 3]], {1.5, 4}]), 
    PlotRange -> {{-1, 1}, {-1, 1}}, AspectRatio -> 1, Frame -> True, 
    Axes -> None, FrameTicks -> True, opts], 
   Show[colorbar[{1.5, 4}, cf], opts]}]]

enter image description here

With some additional options you can change the default font and add a label to the color legend:

Clear[colorbar]
colorbar[{min_, max_}, colorFunction_: Automatic, divs_: 150] := 
 DensityPlot[y, {x, 0, 0.1}, {y, min, max}, AspectRatio -> 10, 
  PlotRangePadding -> 0, PlotPoints -> {2, divs}, MaxRecursion -> 0, 
  Frame -> True, FrameLabel -> {{None, "log10(Tesc)"}, {None, None}}, 
  LabelStyle -> Directive[FontFamily -> "Helvetica", 14, Bold], 
  FrameTicks -> {{None, All}, {None, None}}, 
  FrameTicksStyle -> Directive[FontFamily -> "Helvetica", 10, Plain], 
  ColorFunction -> colorFunction]

With[{opts = {ImageSize -> {Automatic, 300}}, cf = "Rainbow"}, 
 Row[{ListPlot[List /@ data[[All, {1, 2}]], 
    PlotStyle -> ({PointSize[0.01], ColorData[cf][#1]} & /@ 
       Rescale[data[[All, 3]], {1.5, 4}]), 
    PlotRange -> {{-1, 1}, {-1, 1}}, AspectRatio -> 1, Frame -> True, 
    Axes -> None, FrameTicks -> True, 
    LabelStyle -> Directive[FontFamily -> "Helvetica", 10], 
    ImagePadding -> {{40, 10}, {20, 20}}, opts], 
   Show[colorbar[{1.5, 4}, cf], ImagePadding -> {{10, 40}, {20, 20}}, 
    opts]}]]

enter image description here

Last additions:

Clear[colorbar]
colorbar[{min_, max_}, colorFunction_: Automatic, divs_: 150] := 
 DensityPlot[y, {x, 0, 0.1}, {y, min, max}, AspectRatio -> 10, 
  PlotRangePadding -> 0, PlotPoints -> {2, divs}, MaxRecursion -> 0, 
  Frame -> True, 
  FrameLabel -> {{None, 
     "log10(\!\(\*SubscriptBox[\(T\), \(esc\)]\))"}, {None, None}}, 
  LabelStyle -> Directive[FontFamily -> "Helvetica", 15], 
  FrameTicks -> {{None, All}, {None, None}}, 
  FrameTicksStyle -> Directive[FontFamily -> "Helvetica", 15, Plain], 
  ColorFunction -> colorFunction]

\[Omega]1 = 0.4;
\[Omega]2 = 0.4;
\[Epsilon] = 1;
V[x_, y_] := 
  1/2*(\[Omega]1^2*x^2 + \[Omega]2^2*y^2) - \[Epsilon]*x^2*y^2;
xmin = 1;

fig = ContourPlot[
   Evaluate[V[x, y]], {x, -xmin, xmin}, {y, -xmin, xmin}, 
   Contours -> 10, ContourStyle -> {{Gray, Thickness[0.003]}}, 
   AspectRatio -> 1, ContourShading -> False, 
   PlotRange -> {{-1, 1}, {-1, 1}}];

With[{opts = {ImageSize -> {Automatic, 500}}, cf = "Rainbow"}, Row[{
   Show[
    ListPlot[List /@ data[[All, {1, 2}]], 
     PlotStyle -> ({PointSize[0.0045], ColorData[cf][#1]} & /@ 
        Rescale[data[[All, 2]], {1.5, 5}]), 
     PlotRange -> {{-1, 1}, {-1, 1}}, AspectRatio -> 1, Frame -> True,
      AspectRatio -> 1, RotateLabel -> False, Axes -> None, 
     FrameTicks -> True, FrameLabel -> {"x", "y"}, 
     LabelStyle -> Directive[FontFamily -> "Helvetica", 17], 
     ImagePadding -> {{60, 20}, {60, 20}}, opts],
    fig],
   Show[colorbar[{1.5, 5}, cf], ImagePadding -> {{20, 60}, {60, 20}}, 
    opts]}]]

enter image description here

share|improve this answer
    
Very Good! But how could we insert the vertical PlotLegends in order to indicate the different colors? –  Vaggelis_Z Jan 10 '13 at 19:19
    
@Vaggelis_Z See update for a plot with a vertical color legend. –  VLC Jan 10 '13 at 19:32
    
@Vaggelis_Z The last addition should do what you're looking for. I suggest that you play a bit with the different options (ImagePadding,LabelStyle,FrameLabel,FrameTicks,FrameTicksStyle etc.) to see what contribution has each of these. –  VLC Jan 11 '13 at 12:12
    
Your last version is OK. However, I have two questions: (i) How could I add FrameLabel in the main plot and also (ii) how to combine in a Show this plot with another one let's say a ContourPlot –  Vaggelis_Z Jan 15 '13 at 15:53
    
@Vaggelis_Z (i) you just need to insert FrameLabel in the list of options that are within the ListPlot function and you will probably have to adjust the ImagePadding in the case the labels are not visible. (ii) Your question is already the answer: enclose the ListPlot and the ContourPlot within Show[] and place it instead of the ListPlot that is now in the code. –  VLC Jan 15 '13 at 16:13
show 7 more comments

Part of the original question referred to a density plot. To incorporate that element into the solution this version includes Opacity to allow the density of areas with close or overlapping points to be assessed. Such an effect can be observed in the two upper quadrant clusters.

densityHeatMap[data, opacity->0.5, Frame->True, FrameLabel->{"", "", "", "log10(Tesc)"}]

Mathematica graphics

An additional benefit is that it gives some insight into areas where points of some particular some value might be obscured by overlapping, perhaps densely, points of different values. This effect is observable in the tips of the four main clusters where some high value points can be overlapped by lower value ones.

Clear@densityHeatMap;
Options[densityHeatMap] = {opacity -> 0.25, shiftRatio -> 1.05, 
   colorFunction -> ColorData["Rainbow"], pointSize -> 0.005,
   numHues -> 10, legend -> True, Frame -> True, 
   FrameTicks -> {Automatic, Automatic, Automatic, None}, 
   FrameLabel -> {"", "", "", ""}};
densityHeatMap[data_, opts : OptionsPattern[]] := 
 Module[{hues, shift, lLbls, lLocs, lSize, minX, maxX, minY, maxY, minZ, maxZ, lgnd,
   cf = OptionValue@colorFunction, op = OptionValue@opacity, 
   ps = OptionValue@pointSize, sr = OptionValue@shiftRatio, 
   nh = OptionValue@numHues},
  {{minX, maxX}, {minY, maxY}, {minZ, maxZ}} = {Min@#, Max@#} & /@ (data\[Transpose]);
  shift = {maxX sr, 0}; lLbls = FindDivisions[{minZ, maxZ}, nh] // N;
  hues = Range[0, 1, 1/(Length@lLbls - 1)] // N;

  lLocs = {0, #} & /@ 
    Range[Sequence @@ {minY, 
       maxY}, (Subtract @@ {maxY, minY})/(Length@lLbls - 1)];
  lSize = Subtract @@ lLocs[[{-1, 1}, 2]]/(Length@lLbls);

  lgnd = Graphics@
    MapThread[{cf[#1], Opacity@op, 
       Rectangle @@ {#3 + shift, #3 + {lSize, lSize} + shift},
       Darker@Gray, 
       Text[ToString@#2, #3 + {0.2, lSize/2} + shift]} &, {hues, 
      lLbls, lLocs}];

  Show[Graphics[{cf[#3], PointSize@ps, Opacity@op, 
       Point[{#1, #2}]} & @@@ 
     Transpose[{data[[All, 1]], data[[All, 2]], 
       Rescale@data[[All, 3]]}]], lgnd, 
   Sequence @@ FilterRules[{opts}, Options@Graphics]]  
  ]

A more concise skeletal version is given below.

d = Import["/tmp/Esc_data.out", "Table"];

With[{s=Max@d[[All,3]]},Show[Graphics[{1-Hue[#3/s],Point[{#1, #2}]}& @@@ d], Frame->True]]

Mathematica graphics

You can insert a PointSize directive if you want to adjust the size of the points.

share|improve this answer
    
One line indeed! But what about the vertical color legend? –  Vaggelis_Z Jan 10 '13 at 20:51
    
Use a single Point expression and VertexColors (as I did here) for better performance. +1 –  Mr.Wizard Jan 11 '13 at 6:07
    
@Mr.Wizard I could use the Point expression but how could I appear the vertical colorbar which explains the different colors? –  Vaggelis_Z Jan 11 '13 at 7:54
    
You have sacrificed AspectRatio -> 1 for the one line :) –  István Zachar Jan 11 '13 at 8:58
    
@IstvánZachar Using image_doctor's code how could I insert the vertical colorbar and also name it as log10(Tesc)? –  Vaggelis_Z Jan 11 '13 at 11:12
show 1 more comment

This is anything but fast, but here's how you do it with BubbleChart:

data = Import["C:\\Temp\\Esc_data.out", "Table"];
range = {Min@#, Max@#} &@data[[All, 3]];

plot =  BubbleChart[data, PlotRange -> {{-1, 1}, {-1, 1}}, ImageSize -> 300, 
   ChartElementFunction -> ({
       EdgeForm@None, 
       Hue[Rescale[Last@#2, range, {.6, 0.}]],
       Disk[Most@#2, .02]
     } &)];

legend = Grid[Table[{Graphics[{Hue[i], Rectangle[]}, ImageSize -> 25], 
              Rescale[i, {0, .6}, Reverse@range]},
       {i, 0, .6, .6/8}], Spacings -> {.3, 0}, Alignment -> Left];

Row@{plot, Labeled[legend, "legend\ntitle", Top]}

Mathematica graphics

share|improve this answer
add comment

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.