简体   繁体   中英

Replacing Disks by Crosses using Graphics in Mathematica

Consider the following list :

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

Those are coordinatees of Eye fixations on a screen where, within each sublist,

#1 is the X coordinate,

#2 the Y coordinate and

#3 , the duration spent at that particular location

I then use the following :

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

to draw disk with duration weighted diameter.

I would like to draw cross instead where the 2 segments intersect at their middle and the length of each is equivalent to the disk diameter as illustrated bellow.

在此输入图像描述

This is what I have yet :

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

I was wondering if there was a simpler way, using something similar to PlotMarkers that exist in ListPlot

Use two lines. Something like:

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

As you can already draw the circles, why not just use that like so:

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

在此输入图像描述

and then

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

giving

在此输入图像描述

I think a little helper function is convenient here:

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]

You could also use 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*)

在此输入图像描述

I would like to offer this modification of Artefacto's code.

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

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

在此输入图像描述

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM