0
$\begingroup$

UPDATE WITH WORKING EXAMPLE

Following what @Kuba said, I've attempted to find a MWE that shows the problem without too much of the other stuff, and here's what I've done.

Here's a couple of new GIFs to show the problem: one of them is a "closeup" to what happens at the 50th point threshold, let's say; the other one is the entire computation. closeup at 50th point problem showcase

Now for the code used!

I've moved the red coloring up front, so it's clearer. Bear with the initial numerical lists, they're needed to compute the plot!

Needs["ComputationalGeometry`"]

ax = {-0.1746015783681`, -0.171744280521`, -0.1753424479885`, \
-0.1818458390149`, -0.1809263260599`, -0.179514865692`, \
-0.1855975041929`, -0.1946914824968`, -0.1950397333495`, \
-0.1927830485728`, -0.1903676037906`, -0.1813196070505`, \
-0.1791299762296`, -0.1829230554782`, -0.1773529674489`, \
-0.1787983200338`, -0.1879380539756`, -0.182404296226`, \
-0.1784390293998`, -0.1860209123609`, -0.1809745997407`, \
-0.1704765474764`, -0.1715602192745`, -0.1760999618028`, \
-0.1800162507619`, -0.1839354357525`, -0.1674646656581`, \
-0.1600203030248`, -0.1707130354576`, -0.1776024218527`, \
-0.1822423762589`, -0.1909958033058`, -0.187934546206`, \
-0.1751694881397`, -0.1672043083525`, -0.1756886117798`, \
-0.1786703799603`, -0.1643010527693`, -0.1609161369298`, \
-0.1548654897932`, -0.159330579992`, -0.1666642778476`, \
-0.1705566606098`, -0.1651841230109`, -0.1590624597891`, \
-0.1572528899478`, -0.1645688614408`, -0.1691789062584`, \
-0.1700776661369`, -0.1831444320553`, -0.1756400139901`, \
-0.1726808740354`, -0.1839756338981`, -0.1850826110625`};

ay = {0.0331378591656`, 0.0409481302281`, 0.0422659823338`, 
   0.043104907643`, 0.0470038392703`, 0.0493021015212`, 
   0.0572258911383`, 0.0617176993451`, 0.0717445961243`, 
   0.074826655056`, 0.0701977897732`, 0.0744846137707`, 
   0.0782133209711`, 0.0765184550871`, 0.0704380146454`, 
   0.0675561618231`, 0.0654454440966`, 0.0646604678239`, 
   0.0610291942788`, 0.050425044872`, 0.0481746091749`, 
   0.0459573319292`, 0.0333965852916`, 0.0235605891572`, 
   0.0117588371722`, 0.0033762281309`, 
   0.0006015510757`, -0.0161951821118`, -0.0239303359718`, \
-0.0243545255201`, -0.0302308027512`, -0.0326944750102`, \
-0.0372133126888`, -0.0392181142279`, -0.0446498649591`, \
-0.048496237962`, -0.0521995787495`, -0.0597592798179`, \
-0.0639631319254`, -0.0612661252642`, -0.0555731192592`, \
-0.053499608459`, -0.047099952508`, -0.034003132337`, \
-0.0301277803374`, -0.0234019856993`, -0.0159851047869`, \
-0.0094231411377`, -0.010157386318`, -0.0095515292143`, \
-0.0058310425886`, -0.0077447972646`, -0.0095447993443`, \
-0.0110744762862`};

Dimensions[ax]

Dimensions[ay]

g = 9.81;
ch = ConvexHull[Transpose[{ay, ax}]];
chf = Transpose[{ay, ax}][[ch]];
chf = Join[chf, {First[chf]}]; (* to close the plot *)

Manipulate[
           car  = 1 ;; pos;
            Show[
                ListLinePlot[chf],
                
                ListPlot[
                    Transpose[{ay, ax}],
                    PlotStyle -> {ColorData["HTML"]["DarkGray"]},
                    PerformanceGoal -> "Speed"
                        ],
  ListPlot[
                        Transpose[{ay[[car]], ax[[car]]}],
                        PlotStyle -> {ColorData["HTML"]["Red"]},
                        PerformanceGoal -> "Speed"
                        ],
            ImageSize -> 750,
            AspectRatio -> 1,
            PlotRange -> Automatic,
            Frame -> True,
            FrameLabel -> {{"\[LeftArrow] Longitudinal acceleration ->",
                            "<- Longitudinal acceleration ->"}, 
                           {"\<-Left Curve/ Right Curve ->", 
                            "<- Left Curve/ Right Curve ->"}}
            ],
 {{pos, 1, "Position"}, 1, Length[ax], 1}, Paneled -> False
 ]

What I've found from this is that the problem doesn't arise if the plot contains less than 50 points (so in the example 54 are used), and the change in color appears exactly when the 50th point is colored in red. The notebook has its own context, I've deleted all unnecessary stuff. While writing this, I thought that maybe Performance -> "Speed" could have been part of the problem, but deleting it doesn't change anything, it seems.

If it's easier to see firsthand, here's the MWE notebook. No other files needed.

ORIGINAL QUESTION

Don't know if the title is clear, but I've got a video to explain better. [EDITED OUT because it was wrong and it wasn't showing the problem]

As you can see, the colors I'm using in the left plot seem to change of intensity/depth/other during the animation execution. I thought this could depend on the "heaviness" of the computation, but even PerformanceGoal -> "Speed" seems not to have any effect on that.

Here's the part of code I'm using to generate that plot. I'll make the whole notebook available if it's needed, but since it's a good amount of computations to get to this point, for now I'll just leave this snippet.

Manipulate[
 car  = 1 ;; pos;
 quot = Quotient[pos, 705];
 index = quot + 1 ;; quot + 2;
 curve = curves[[quot + 1]] ;; curves[[quot + 2]];
 circuit = Transpose[{xCircuit, yCircuit}];

 Row[{[
     Show[
          ListLinePlot[chf],

          ListPlot[
                   Transpose[{ayfil[[car]]/g, axfil[[car]]/g}],
                   PlotStyle -> {ColorData["HTML"]["Red"]},
                   PerformanceGoal -> "Speed",
                   PlotLegends -> 
                       Placed[SwatchLegend[{"evolution"}, LegendMarkerSize -> 15, 
                       LegendMarkers -> "Bubble", 
                       LegendLabel -> Style["Curves", 20]], Left]
          ],

          ListPlot[
                   Transpose[{ayfil/g, axfil/g}],
                   PlotStyle -> {ColorData["HTML"]["DarkGray"]},
                   PerformanceGoal -> "Speed",
                   PlotLegends -> 
                       Placed[SwatchLegend[{"g-g plot"}, LegendMarkerSize -> 15, 
                       LegendMarkers -> "Bubble"], Left]
          ],
    
          ImageSize -> 750,
          AspectRatio -> 1,
          PlotRange -> {{-3.5, 3.5}, {-4, 2}},
          Frame -> True,
          FrameLabel -> {{"<- Longitudinal acceleration ->",
                          "<- Longitudinal acceleration ->"}, 
                         {"<- Left Curve/ Right Curve ->", 
                          "<- Left Curve/ Right Curve ->"}},
          LabelStyle -> Directive[Black, Bold]
     ]
     ,
     Show[
          ListLinePlot[
                       Transpose[{xCircuit, yCircuit}],
                       ImageSize -> 500, 
                       AspectRatio -> Automatic
          ],

          Graphics[{
                    PointSize[0.02],
                    Green,
                    Point[circuit[[pos]] ],
                    PlotLegends -> Placed[{"real-time position"}, Left]
          }]
     ]
 }],
{{pos, 1, "Position"}, 1, Length[axfil], 50, AnimationRate -> 200}, 
Paneled -> False]

Can't figure out what to change or add unfortunately!

EDIT: forgot to mention I've got Mathematica 11.3 on Windows 10 EDIT2: since I'm not sure how to post a simpler MWE without pasting a bunch of numbers, here's the whole notebook and xls files needed, if this helps... I thought the code itself could be the problem, but I guess having a proper working program at hand is always better -> notebook

$\endgroup$
6
  • 4
    $\begingroup$ It doesn't seem possible to run your code. $\endgroup$
    – C. E.
    Commented Sep 13, 2020 at 22:32
  • $\begingroup$ Maybe because it needs previous computations? Should I add the whole notebook? $\endgroup$
    – slim71
    Commented Sep 14, 2020 at 11:55
  • $\begingroup$ @C.E. I've added the notebook, because I think it doesn't make sense to paste the numerical lists used (they're almost 10000 elements each) $\endgroup$
    – slim71
    Commented Sep 14, 2020 at 12:00
  • 1
    $\begingroup$ @slim71 can you try to prepare a minimal working example? you will greatly increase changes of getting attention. p.s. I don't see any changes in the left plot instead of a pale dot in the center, is this what I should be focusing at? $\endgroup$
    – Kuba
    Commented Sep 16, 2020 at 6:50
  • $\begingroup$ @Kuba I'll try to see if I can make something similar, but to be honest I thought it was the complexity of this plot to influence the behaviour, since other Manipulate[] never did this for me... PS: also, thanks for pointing out the GIF isn't showing it, I'll change it! weird, I was sure it was... $\endgroup$
    – slim71
    Commented Sep 16, 2020 at 10:11

1 Answer 1

3
$\begingroup$

You need to specify an explicit size for the points:

(* setup code from question *)

Manipulate[
           car  = 1 ;; pos;
            Show[
                ListLinePlot[chf],
                
                ListPlot[
                    Transpose[{ay, ax}],
                    PlotStyle -> {ColorData["HTML"]["DarkGray"]},
                    PerformanceGoal -> "Speed"
                        ],
                ListPlot[
                        Transpose[{ay[[car]], ax[[car]]}],
                        PlotStyle -> Directive[ColorData["HTML"]["Red"], AbsolutePointSize[7]],
                        PerformanceGoal -> "Speed"
                        ],
            ImageSize -> 750,
            AspectRatio -> 1,
            PlotRange -> Automatic,
            Frame -> True,
            FrameLabel -> {{"\[LeftArrow] Longitudinal acceleration ->",
                            "<- Longitudinal acceleration ->"}, 
                           {"\<-Left Curve/ Right Curve ->", 
                            "<- Left Curve/ Right Curve ->"}}
            ],
 {{pos, 1, "Position"}, 1, Length[ax], 1}, Paneled -> False
 ]

What is happening is that the automatically determined point size changes at 50 points (the idea being that points need to be smaller if there are many of them). The function responsible for this is Charting`adaptivePointSize:

GeneralUtilities`PrintDefinitions@Charting`adaptivePointSize

The relevant piece of code is:

size = Which[
    n<50,
        7,
    n<100,
        6,
    n<250
        5,
    n<500
        4,
    n>15000,
        1,
    ...
]

where n is the number of points. As you can see, the first break is at 50 points, which is exactly what you are seeing.

$\endgroup$
1
  • $\begingroup$ oh, that's very clear now! So there's basically a mechanism similar to the PlotRange change, got it! Man, I would never figure that out, with my basic knowledge! Thanks a lot! $\endgroup$
    – slim71
    Commented Sep 18, 2020 at 16:10

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.