1
$\begingroup$

I have a data file containing several columns and thousands lines of data. Below I present a small portion of it, in order to express my issue:

-6.00000000          -0.50000000   0.2012925952067529E+01   -.1354335628382003E+01   -.1226489717949115E+01   0.3971000000000000E+02   0.3563073636222663E-02    8
-6.00000000          -0.40000000   -.1667709017102080E+01   0.1996988297249126E+01   -.8819770483714856E+00   0.2608000000000000E+02   0.7532864609099250E-05    6
-6.00000000          -0.30000000   -.1790107106742991E+01   -.1663230917261907E+01   0.1128076001589623E+01   0.2088000000000000E+02   0.3177221419972102E-02    3
-6.00000000          -0.20000000   -.1705528943436493E+01   -.1416493048162809E+01   -.1473371717762452E+01   0.1974000000000000E+02   0.1287464426169665E-04    7
-6.00000000          -0.10000000   -.1438853964633666E+01   0.8237153975034051E+00   0.2328464291089728E+01   0.1852000000000000E+02   0.4189535638506170E-02    2
-6.00000000           0.00000000   -.7656851229280424E+00   -.1226763235452721E+01   -.2690993457287972E+01   0.4270000000000000E+02   0.1253249246603346E-11    7
-6.00000000           0.10000000   0.2359731627744364E+01   -.1081845089584134E+01   -.1195510444527736E+01   0.3603000000000000E+02   0.3777453269309895E-06    8

The first two columns correspond to the coordinates $x$ and $y$. I have a MMA code (is given below) for plotting the coordinates $(x,y)$ and assign to each point a color according to the value of the sixth column. The last column has an integer which takes values inside the interval [0,8].

input = ReadList["data18.out", Number, RecordLists -> True];
input2 = ReadList["data0.out", Number, RecordLists -> True];

data = Table[{input[[i, 1]], input[[i, 2]], Log10[input[[i, 6]]]}, {i,1, Length[input]}];
data2 = Table[{input2[[i, 1]], input2[[i, 3]]}, {i, 1, Length[input2]}];

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, 
 Row[{Subscript["log", "10"], "(", Subscript["t", "esc"], 
   ")"}]}, {None, None}}, 
LabelStyle -> Directive[FontFamily -> "Helvetica", 17], 
FrameTicks -> {{None, All}, {None, None}}, 
FrameTicksStyle -> Directive[FontFamily -> "Helvetica", 15, Plain], 
ColorFunction -> colorFunction]

V = ω^2/2*(x^2 + y^2 + z^2) + ϵ*(x^2*y^2 + x^2*z^2 + 
  y^2*z^2 - x^2*y^2*z^2);
Vxy = V /. {z -> 0};
ω = ϵ = 1;
E0 = 8.5;
z0 = 0.1;
xmin = 4.5;

f[x_, px_] := 1/2*px^2 + V /. {y -> 0, z -> z0};

plrange = {{-xmin, xmin}, {-xmin, xmin}};
valrange = {0, 5};

C0 = ContourPlot[Evaluate[f[x, px]], {x, -5, 5}, {px, -5, 5}, 
Contours -> {E0}, ContourStyle -> {{Black, Thickness[0.003]}}, 
AspectRatio -> 1, ContourShading -> False, PlotPoints -> 200, 
PerformanceGoal -> "Speed", PlotRange -> plrange];

L0 = ListPlot[data2, PlotStyle -> {Black, PointSize[0.011]}];

With[{opts = {ImageSize -> {Automatic, 550}}, cf = "Rainbow"}, 
Row[{Show[
ListPlot[List /@ data[[All, {1, 2}]], 
 PlotStyle -> ({PointSize[0.01], ColorData[cf][1 - #]} & /@ 
    Rescale[data[[All, 3]], valrange]), PlotRange -> plrange, 
 AspectRatio -> 1, Frame -> True, RotateLabel -> False, 
 Axes -> None, FrameTicks -> True, 
 FrameLabel -> {Subscript["x", "0"], 
   OverDot[Subscript["x", "0"]]}, 
 LabelStyle -> Directive[FontFamily -> "Helvetica", 17], 
 ImagePadding -> {{60, 20}, {60, 20}}, opts], C0, L0], 
Show[colorbar[valrange, ColorData[cf][1 - #] &], 
ImagePadding -> {{20, 60}, {60, 20}}, opts]}]]

The data18.out file contains all the data. However, if there is a zero at the last column I want the corresponding points to be plotted in black; only when 1-8 the rainbow colors should apply. So, in order plot with in black these points, I extracted them in a separate file data0.out. What I want is instead of using two files, to use only the original data_all.out file. I suppose that and IF condition is possible inside the ListPlot

Here is the final output

grid

Many thanks in advance.

EDIT

The complete data file can be found here: data

EDIT 2

A revised working MMA notebook can be downloaded from here: code

$\endgroup$

1 Answer 1

4
$\begingroup$

If data was to hold information also about the last column a new color function could be defined like this:

colfunc[x_] := If[x[[8]] == 0, Black, ColorData[cf][1 - x[[3]]]]

x[[8]] is supposed to be the value from the last column. x[[3]] is supposed to be the data that determines the color in the ordinary case. However, this would have to have been rescaled beforehand, something like:

data[[All,3]]=Rescale[data[[All,3]],valrange]

You guessed yourself that If would do it and I'm sure you are correct. Do you think you could make this work? Step one is to import all data into the data list. Each row should simply correspond to a row in your data files. Then inside Listplot: colfunc/@data after data has already been rescaled.

EDIT: Since I now have the data I've tried implement the solution fully.

The first changes I wanted to make was in how the data was imported, so that we have all the information in the list data. But in order to do so we need to define valrange early on, so I also changed the order of that:

plrange = {{-xmin, xmin}, {-xmin, xmin}};
valrange = {0, 5};
data = Import["~/Desktop/data_all.out", "Table"];
data[[All, 6]] = Rescale[Log10[data[[All, 6]]], valrange];

Now defining the color function:

colfunc[x_, cf_] := If[x[[8]] == 0, Black, ColorData[cf][1 - x[[6]]]]

And the rest of the code which I haven't changed:

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, 
     Row[{Subscript["log", "10"], "(", Subscript["t", "esc"], 
       ")"}]}, {None, None}}, 
  LabelStyle -> Directive[FontFamily -> "Helvetica", 17], 
  FrameTicks -> {{None, All}, {None, None}}, 
  FrameTicksStyle -> Directive[FontFamily -> "Helvetica", 15, Plain], 
  ColorFunction -> colorFunction]
V = ω^2/
     2*(x^2 + y^2 + z^2) + ϵ*(x^2*y^2 + x^2*z^2 + y^2*z^2 - 
      x^2*y^2*z^2);
Vxy = V /. {z -> 0};
ω = ϵ = 1;
E0 = 8.5;
z0 = 0.1;
xmin = 4.5;
f[x_, px_] := 1/2*px^2 + V /. {y -> 0, z -> z0};
C0 = ContourPlot[Evaluate[f[x, px]], {x, -5, 5}, {px, -5, 5}, 
   Contours -> {E0}, ContourStyle -> {{Black, Thickness[0.003]}}, 
   AspectRatio -> 1, ContourShading -> False, PlotPoints -> 200, 
   PerformanceGoal -> "Speed", PlotRange -> plrange];

And finally, the piece of code which I have changed. Look carefully at the row where the color function is being used:

With[{opts = {ImageSize -> {Automatic, 550}}, cf = "Rainbow"}, Row[{
   Show[
    ListPlot[
     List /@ data[[All, {1, 2}]],
     PlotStyle -> ({PointSize[0.01], colfunc[#, cf]} & /@ data), 
     PlotRange -> plrange,
     AspectRatio -> 1,
     Frame -> True,
     RotateLabel -> False,
     Axes -> None,
     FrameTicks -> True,
     FrameLabel -> {Subscript["x", "0"], 
       OverDot[Subscript["x", "0"]]}, 
     LabelStyle -> Directive[FontFamily -> "Helvetica", 17],
     ImagePadding -> {{60, 20}, {60, 20}}, opts
     ], C0],
   Show[colorbar[valrange, ColorData[cf][1 - #] &], 
    ImagePadding -> {{20, 60}, {60, 20}}, opts]
   }]
 ]

circleplot

Well, as you can see the colors are different. It has to do with the scaling, or with the data manipulation at import (Log10 and so on, might've missed something there). Surely the OP will be able to rescale the data as he wishes, but the black dots are exactly where they are supposed to be as far as I can tell.

$\endgroup$
11
  • $\begingroup$ It seems that this is what I want. However, I cannot figure out what to change. See my EDIT; I added a link to the complete data file. If you want incorporate your solution to my original code and see if the output is the same. $\endgroup$
    – Vaggelis_Z
    Aug 17, 2013 at 14:03
  • $\begingroup$ @Vaggelis_Z Is it the same as data18.out in your code? $\endgroup$
    – C. E.
    Aug 17, 2013 at 14:35
  • $\begingroup$ No, the file I uploaded has all the values, from 0 to 8 at eighth column. At the original code, we read to different external files data18 and data0. Now only one file should be read (the data_all). Whenever there is 0 the (x,y) point should be plotted in black, otherwise according to the rainbow pallet. $\endgroup$
    – Vaggelis_Z
    Aug 17, 2013 at 14:38
  • $\begingroup$ @Vaggelis_Z OK, I understand. $\endgroup$
    – C. E.
    Aug 17, 2013 at 14:50
  • $\begingroup$ valrange={0,5} determines the minimum and maximum values of the colorbar and it's irrelevant with what I want! Have you managed to incorporate your solution to the code? $\endgroup$
    – Vaggelis_Z
    Aug 17, 2013 at 14:52

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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