Адаптивные линии сетки - PullRequest
       15

Адаптивные линии сетки

7 голосов
/ 14 апреля 2011

Я хочу использовать линии сетки для создания эффекта миллиметровой графической бумаги на двумерном графике, чтобы показать, как функция с несколькими переменными зависит от 1 переменной.Шкалы разных переменных сильно различаются, поэтому мой наивный подход (который я использовал ранее), похоже, не работает.

Пример того, что у меня есть на данный момент:

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

И FromTo (я хочу оставить 5% поля в кадре), и GetGrid не работают точно так, как я хочу.

На некоторых осях переменные отличаются на много порядков от 10. И я не хочу, чтобы одна ось имела много порядков на 10 линий сетки больше, чем другие.И самое главное, я хочу, чтобы линии сетки совпадали с галочками.

Пример данных:

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

Результатом будет:

enter image description here

И мой наивный GetGrid, который работает в некотором смысле:

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

Вопрос

Как заставить GridLines выравниваться с галочками?

edit: С

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
  ]

я могу получить:

enter image description here

И это намного лучше.Но я бы хотел сместить сетку, а не галочки.

edit: @Sjoerd C. de Vries

Ваше решение делает то, что я хотел, чтобы архивировать и работает.Я также заметил, что если я возьму первые 5 элементов данных выборки, то график будет (элементы отсортированы и добавлена ​​линия регрессии).enter image description here

Обратите внимание, что самый левый элемент похож на сетку.

Ответы [ 3 ]

8 голосов
/ 14 апреля 2011

Не используйте FrameTicks, но смещайте сетку правильно.Это первый подход.Обед ждет.

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

Используйте AspectRatio, который подходит для сетки (вероятно, соотношение диапазонов x и y)


Обновление после ужина

Чтобы сделать его более устойчивым для разных диапазонов значений (согласно вашему комментарию), я генерирую тики, которые будут выбраны ListPlot, и основываю свои шаги на этом:

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

и получаюсоотношение сторон, которое дает квадратный растр

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

Тест

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

Здесь я делю y-значения на 20 и умножили значения x на 10000, чтобы показать, что сетка по-прежнему исправна:

enter image description here


Окончательное обновление (надеюсь)

Использует FindDivisions как , предложенное Белизарием .Однако я использовал стандарт трехуровневой линейной структуры для миллиметровой бумаги в соответствии с просьбой Маргуса:

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

и

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

ПРЕДУПРЕЖДЕНИЕ !!!

Я только что заметил, что если у вас есть это в MMA:

enter image description here

и вы копируете его в SO (просто ctrl-c ctrl-v), вы получаетеэто:

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

, что не математически эквивалентно .Это должно быть так:

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

Я исправил это в приведенном выше коде, но он был опубликован неправильно в течение полдня при правильной работе на моем компьютере.Думал, что было бы хорошо упомянуть об этом.

4 голосов
/ 15 апреля 2011

Я думаю, FindDivisions [] - это то, что вы ищете:

FindDivisions [{xmin, xmax}, n] находит список из n "хороших" чиселкоторые делят интервал от xmin до xmax на равноотстоящие части.

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

1 голос
/ 14 апреля 2011

Если вы используете одну и ту же функцию для FrameTicks и Gridlines, они выстроятся в линию.

См. FrameTicks и GridLines . Я думаю, вам понадобится ImageMargins для границы.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...