Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Adaptive gridlines

I want to use gridlines to create an effect of millimeter graphing paper on a 2d graph, to show how multi-variable function depends on 1 variable. The scales of different variables differ a lot, so my naive approach (that I have used before) does not seem to work.

Example of what I have at the moment:

<< ErrorBarPlots`
Cmb[x_, y_, ex_, ey_] := {{N[x], N[y]}, ErrorBar[ex, ey]};
SetAttributes[Cmb, Listable];

ELP[x_, y_, ex_, ey_, name_] :=
 ErrorListPlot[
  Cmb[x, y, ex, ey],
  PlotRange -> FromTo[x, y],
  PlotLabel -> name,
  Joined -> True, Frame -> True, GridLines -> GetGrid,
  ImageSize -> {600}
 ]

Both FromTo (I want to leave 5% margin in the frame) and GetGrid do not work exactly as I want them to.

On some axes the variables differs many orders of 10. And I do not want, that one axis has many orders of 10 gridlines more then other. And most importantly I want the gridlines to line up with ticks.

Sample data:

ELP[
  {4124961/25000000, 27573001/100000000, 9162729/25000000, 44635761/
   100000000, 15737089/25000000, 829921/1562500, 4405801/4000000, 
   23068809/25000000, 329386201/100000000, 58079641/100000000},
  {1/10, 1/5, 3/10, 2/5, 3/5, 1/2, 1/2, 1/2, 1/2, 1/2},
  {2031/(250000 Sqrt[10]), 5251/(500000 Sqrt[10]), 3027/(
   250000 Sqrt[10]), 6681/(500000 Sqrt[10]), 3967/(250000 Sqrt[10]), 
   911/(62500 Sqrt[10]), 2099/(100000 Sqrt[10]), 4803/(
   250000 Sqrt[10]), 18149/(500000 Sqrt[10]), 7621/(500000 Sqrt[10])},
  {1/2000, 1/1000, 3/2000, 1/500, 3/1000, 1/400, 1/400, 1/400, 1/400, 
   1/400},
  "T2, m"
]

Would result in:

enter image description here

And my naive GetGrid, that works in some sence:

FromTo[x_, y_] := Module[{dx, dy},
   dx = (Max[x] - Min[x])*0.1;
   dy = (Max[y] - Min[y])*0.1;
   {{Min[x] - dx, Max[x] + dx}, {Min[y] - dy, Max[y] + dy}}];
GetGrid[min_, max_] := Module[{step, i},
  step = (max - min)/100;
  Table[
   {min + i*step,
    If[Equal[Mod[i, 10], 0],
     Directive[Gray, Thick, Opacity[0.5]],
     If[Equal[Mod[i, 5], 0],
      Directive[Gray, Opacity[0.5]],
      Directive[LightGray, Opacity[0.5]]
      ]]},
   {i, 1, 100}]
  ]

Question

How to make GridLines line up with ticks?

edit: With

GetTicks[x_, y_] := Module[{dx, dy},
   dx = (Max[x] - Min[x])*0.1;
   dy = (Max[y] - Min[y])*0.1;
   {
    Min[x] - dx + Table[i*dx*1.2, {i, 1, 9}],
    Min[y] - dy + Table[i*dy*1.2, {i, 1, 9}]
    }];

ELP[x_, y_, ex_, ey_, name_] :=
 ErrorListPlot[
  Cmb[x, y, ex, ey],
  PlotRange -> FromTo[x, y],
  PlotLabel -> name,
  Joined -> True, Frame -> True, GridLines -> GetGrid, 
  FrameTicks -> GetTicks[x, y],
  ImageSize -> {600},
  AspectRatio -> 1
  ]

I can get:

enter image description here

And that is a lot better. But I would like to shift the grid and not the ticks.

edit: @Sjoerd C. de Vries

Your solution does what I wanted to archive and works. I also noticed, that if I take first 5 elements of sample data, then the plot will be (elements are sorted and regression line is added). enter image description here

Notice the left most element is like off grid.

like image 250
Margus Avatar asked Apr 14 '11 14:04

Margus


3 Answers

Don't use FrameTicks but shift the grid correctly. This is a first approach. Dinner waits.

getGrid[min_, max_] :=
 Module[{step, i},
  Print[{min, max}];
  step = 1/100;
  Table[
   {
    Floor[min, 0.1] + i*step,
    If[Equal[Mod[i, 10], 0], Directive[Gray, Thick, Opacity[0.5]],
     If[Equal[Mod[i, 5], 0], Directive[Gray, Opacity[0.5]],
      Directive[LightGray, Opacity[0.5]]
      ]
     ]
    },
   {i, 1, (Ceiling[max, 0.1] - Floor[min, 0.1])/step // Round}
   ]
  ]

Use an AspectRatio that's appropriate for the grid (probably the ratio of x and y ranges)


After-dinner update

To make it more robust for different value ranges (per your comment) I generate the ticks that would be chosen by ListPlot and base my steps on that:

getGrid[min_, max_] :=
 Module[{step, i,j},
  i = Cases[(Ticks /. 
       AbsoluteOptions[ListPlot[{{min, min}, {max, max}}], 
        Ticks])[[1]], {a_, ___, {_, AbsoluteThickness[0.25`]}} :> a];
  step = i[[2]] - i[[1]];
  Table[
   {
    i[[1]] + j*step/10,
    If[Equal[Mod[j, 10], 0], Directive[Gray, Thick, Opacity[0.5]],
     If[Equal[Mod[j, 5], 0], Directive[Gray, Opacity[0.5]],
      Directive[LightGray, Opacity[0.5]]
      ]
     ]
    },
   {j, 0, 10 Length[i]}
   ]
  ]

and getting the aspect ratio which yields a square raster

getAspect[{{minX_, maxX_}, {minY_, maxY_}}] :=
 Module[{stepx, stepy, i, rx, ry},
   i = (Ticks /.AbsoluteOptions[ListPlot[{{minX, minY}, {maxX, maxY}}], Ticks]);
   rx = Cases[i[[1]], {a_, ___, {_, AbsoluteThickness[0.25`]}} :> a];
   stepx = rx[[2]] - rx[[1]];
   ry = Cases[i[[2]], {a_, ___, {_, AbsoluteThickness[0.25`]}} :> a];
   stepy = ry[[2]] - ry[[1]];
  ((maxY - minY)/stepy)/((maxX - minX)/stepx)
  ]

Test

ELP[x_, y_, ex_, ey_, name_] := 
 ErrorListPlot[Cmb[x, y, ex, ey], PlotLabel -> name, Joined -> True, 
  Frame -> True, GridLines -> getGrid, ImageSize -> {600}, 
  PlotRangePadding -> 0, AspectRatio -> getAspect[FromTo[x, y]], 
  PlotRange -> FromTo[x, y]]


ELP[{4124961/25000000, 27573001/100000000, 9162729/25000000, 
  44635761/100000000, 15737089/25000000, 829921/1562500, 
  4405801/4000000, 23068809/25000000, 329386201/100000000, 
  58079641/100000000}, {1/10, 1/5, 3/10, 2/5, 3/5, 1/2, 1/2, 1/2, 1/2,
   1/2}, {2031/(250000 Sqrt[10]), 5251/(500000 Sqrt[10]), 
  3027/(250000 Sqrt[10]), 1/100000 6681/(500000 Sqrt[10]), 
  3967/(250000 Sqrt[10]), 911/(62500 Sqrt[10]), 
  2099/(100000 Sqrt[10]), 4803/(250000 Sqrt[10]), 
  18149/(500000 Sqrt[10]), 7621/(500000 Sqrt[10])}, {1/2000, 1/1000, 
  3/2000, 1/500, 3/1000, 1/400, 1/400, 1/400, 1/400, 1/400}, "T2, m"]

enter image description here

Here I divide the y-values by 20 and multiplied the x-values by 10000 to show the grid is still good:

enter image description here


Final update (I hope)

This uses FindDivisions as suggested by belisarius. However, I used the three level line structure standard for milimeter paper as requested by Margus:

getGrid[x_, y_] := 
 FindDivisions[{x, y}, {10, 2, 5}] /. {r_, s_, t_} :> 
   Join[
     {#, Directive[Gray, Thick, Opacity[0.5]]} & /@ r, 
     {#, Directive[Gray, Opacity[0.5]]} & /@ Union[Flatten[s]], 
     {#, Directive[LightGray, Opacity[0.5]]} & /@ Union[Flatten[t]]
   ]

and

getAspect[{{minX_, maxX_}, {minY_, maxY_}}] :=
 Module[{stepx, stepy},
  stepx = (#[[2]] - #[[1]]) &@FindDivisions[{minX, maxX}, 10];
  stepy = (#[[2]] - #[[1]]) &@FindDivisions[{minY, maxY}, 10];
 ((maxY - minY)/stepy)/((maxX - minX)/stepx)
  ]

WARNING!!!

I just noticed that if you have this in MMA:

enter image description here

and you copy it to SO (just ctrl-c ctrl-v), you get this:

(maxY - minY)/stepy/(maxX - minX)/stepx  

which is not mathematically equivalent. It should be this:

((maxY - minY)*stepx)/((maxX - minX)*stepy)

I corrected this in the code above, but it has been posted wrong for half a day while working correctly on my computer. Thought that it would be good to mention this.

like image 134
Sjoerd C. de Vries Avatar answered Oct 17 '22 11:10

Sjoerd C. de Vries


I think FindDivisions[ ] is what you're after:

FindDivisions[{xmin,xmax},n] finds a list of about n "nice" numbers that divide the interval around xmin to xmax into equally spaced parts.

getTicks[x_, y_] := Flatten@FindDivisions[#, {10}] & /@ FromTo[x, y]
getGrid  [x_,y_] := FindDivisions[{x,y},{10,5}]/.
                          {r__,{s__}}:>Join@@{s,{#,{Gray,Thick}}&/@r} 

enter image description here

like image 39
Dr. belisarius Avatar answered Oct 17 '22 12:10

Dr. belisarius


If you use the same function for FrameTicks and Gridlines, they'll line up.

See FrameTicks, and GridLines. I think you'll need ImageMargins for the border.

like image 20
DavidC Avatar answered Oct 17 '22 11:10

DavidC