Замена дисков крестами с использованием графики в Mathematica

Question

Рассмотрим следующий список:

dalist = {{47.9913, 11.127, 208}, {47.5212, 10.3002, 208}, 
          {49.7695, 9.96838, 160}, {48.625, 12.7042, 436}}

Это координаты фиксации Глаз на экране, где в каждом подсписке

#1 - это координата X,

#2 координата Y и

#3, продолжительность, проведенная в этом конкретном месте

Затем я использую следующее:

Disk[{#[[1]], #[[2]]}, 3N[#[[3]]/Total[dalist[[All, 3]]]]] & /@ dalist

, чтобы нарисовать дискс продолжительностью взвешенного диаметра.

Вместо этого я хотел бы нарисовать крест, где 2 сегмента пересекаются в середине, а длина каждого из них соответствует диаметру диска, как показано ниже.

Это то, что у меня еще есть:

Graphics[{
          Line[{{#[[1]] - 3 N[#[[3]]/Total[dalist[[All, 3]]]], #[[2]]},
                {#[[1]] + 3 N[#[[3]]/Total[dalist[[All, 3]]]], #[[2]]}}] & /@ dalist,
          Line[{{#[[1]], #[[2]] - 3 N[#[[3]]/Total[dalist[[All, 3]]]]},
                {#[[1]], #[[2]] + 3 N[#[[3]]/Total[dalist[[All, 3]]]]}}] & /@ dalist}]

Мне было интересно, есть ли более простой способ, используя что-то похожее на PlotMarkers, которые существуют в ListPlot

Answer 1

Используйте две строки. Что-то вроде:

pointTrans =
  {
     Line[{{#[[1]] - l, #[[2]]}, {#[[1]] + l, #[[2]]}}],
     Line[{{#[[1]], #[[2]] - l}, {#[[1]], #[[2]] + l}}]
     } /. l -> #[[3]]/Mean[dalist[[All, 3]]] &;

pointTrans /@ dalist // Graphics // Show

Answer 2

Вы также можете использовать BubbleChart:

plus[{x:{x0_, x1_}, y:{y0_, y1_}}, __] := 
 Line[{{{x0, Mean[y]}, {x1, Mean[y]}}, {{Mean[x], y0}, {Mean[x], y1}}}]

BubbleChart[dalist, ChartElementFunction -> plus] (*or maybe "MarkerBubble" instead of plus*)

Answer 3

Мне кажется, здесь удобна небольшая вспомогательная функция:

makeCross[{x_, y_, r_}, total_] := With[{scale = 3*r/total}, 
  Line[{{{x - scale, y}, {x + scale, y}}, {{x, y - scale}, {x, y + scale}}}]]

total = Total[dalist[[All, 3]]];

Graphics[makeCross[#, mean] & /@ dalist]

Answer 4

Как вы уже можете нарисовать круги, почему бы просто не использовать это так:

circles=Graphics[Disk[{#[[1]], #[[2]]}, 3 N[#[[3]]/Total[dalist[[All, 3]]]]] & /@ dalist]

, а затем

circles /. Disk[{x_, y_}, r_] :> Line[{{{x, y - r/2}, {x, y + r/2}}, {{x - r/2, y}, {x + r/2, y}}}]

, давая

Answer 5

Я хотел бы предложить эту модификацию кода Артефакто.

pointTrans = 
  With[{l = #3/2/Mean@dalist[[All, 3]]}, 
    Line@{{{# - l, #2}, {# + l, #2}}, {{#, #2 - l}, {#, #2 + l}}}
  ] &;

Graphics[{Thick, pointTrans @@@ dalist}]