Tag Info

Hot answers tagged

30

Manipulate[ ParametricPlot[({Sin[n t1], Sin[(n - 1) t1]}), {t1, 0, 2 Pi}, Epilog -> {Red, PointSize[Large], Table[If[OddQ[i + j], Point[{Cos[Pi i/(2 (n - 1))], Cos[Pi j/(2 (n))]}]], {i, 2 n - 3}, {j, 2 n - 1}]}], {{n, 5}, 2, 20, 1}] General Case I We can generalize to the Lissajous curve specified by the two non-negative ...


19

If you are comfortable using undocumented and unsupported functionality we can do this with a ScalingFunctions option as I did for ListLogLinearPlot for the whole real numbers. (* listability *) (self : fn[off_, scale_])[x_List] := self /@ x (self : invfn[off_, scale_])[x_List] := self /@ x fn[off_, scale_][x_?NumericQ] := If[x < off, Log[x], ...


18

Ok, here's a very brief toy example while I don't have access to my desktop computer at work. It's easy enough to figure out, that a LogPlot of f is basically the plot of Log[f[x]]. And A LogLinearPlot is the plot of f[Exp[x]]. But we can extend this to arbitrary scalings of the axes. I start with defining a piecewise function which maps x values between 0 ...


17

You can use your ContourPlot, you just need to wrap coordinates with GeoPosition, note that you have to flip order. (if x is longitude and y is latitude, because GeoPosition assumes first is latitude and so on.) cp is Graphics[GraphicsComplex[coordinates, primitives]...], it is convenient to use this form. We can apply GeoPosition in one place and reduce ...


17

One way (whew, there are a lot of intersections! -- here's a shorter version): sol = NSolve[{Sin[10 t], Sin[9 t]} == ({Sin[10 t], Sin[9 t]} /. t -> s) && 0 <= t < s < 2 Pi, {t, s}]; ParametricPlot[{Sin[10 t], Sin[9 t]}, {t, 0, 2 π}, Epilog -> {Red, PointSize[Large], Point[{Sin[10 t], Sin[9 t]} /. sol]}] ({Sin[100 t], ...


11

I don't like to think too much :P Manipulate[ {#, Composition[ # - 1 &, Length, Union, Flatten, MorphologicalComponents, Binarize, Rasterize ]@#} &@ ParametricPlot[{Sin[ n t], Sin[m t]}, {t, 0, 2 Pi}, Axes -> False, PlotStyle -> Thick] , {n, 2, 10, 1}, {m, 1, 9, 1}]


11

There is a specific function called CountRoots, which does exactly what you want: CountRoots[poly, x] (* 12 *) You can then compare this number to the number of roots given by the length of the coefficient list: Length@CoefficientList[poly, x] - 1 (* 36 *)


11

One very clean way to do this is via x3dom, which is a javascript framework for deploying the x3d standard. The library is well supported by modern browsers, and the output is an html file with a supporting archive of x3d files. It is generally very clean and fast, and it does not require any external plugins. The library can be called from the x3dom site or ...


11

Updated An arbitrary density plot for the example: den = DensityPlot[Sin[x] Sin[y], {x, -180, 180}, {y, -90, 90}] : Extract the graphics primitives from the density plot: prim = First @ Cases[den, Graphics[a_, ___] :> a, {0, -1}, 1]; Plot them directly with GeoGraphics while setting the desired GeoStyling for the GeoBackground: GeoGraphics[ ...


9

clicks = {}; insert = 0; data = RandomReal[100, {50, 2}]; You can add the points in clicks using Epilog: Column[{ListPlot[Button[Tooltip@#, If[insert < 5 && ! MemberQ[clicks, #], AppendTo[clicks, #]; insert++;]] & /@ N@data, ImageSize -> 400, Epilog -> Dynamic[{ Directive[Opacity[.7, Red], PointSize[Large]], ...


9

Probably this match your plot: ParametricPlot[{r {r k2, v1}}, {s1, 0.0, 50}, {r, 0, 1}, PlotRange -> {{0, 0.3}, {0, 1.5}}, AspectRatio -> 0.5, BoundaryStyle -> Directive[Black, Thick], Mesh -> 100, MeshFunctions -> (50 #1 - #2 &)]


9

f[x_] := x^2 With[ {a = 0, b = 6, n = 7}, rectangles = Table[ {Opacity[0.05], EdgeForm[Gray], Rectangle[ {a + i (b - a)/n, 0}, {a + (i + 1) (b - a)/n, Mean[{f[a + i (b - a)/n], f[a + (i + 1) (b - a)/n]}]} ]}, {i, 0, n - 1, 1} ]; Show[ Plot[f[x], {x, a, b}, PlotStyle -> Thick, AxesOrigin -> {0, 0}], ...


9

I know you said "without plot", but why reinvent the wheel? adaptivepoints=Sort@Last@Last@ Reap[Plot[f = Sin[x], {x, 0, 100}, EvaluationMonitor :> Sow[{f, x}]]]; You can similarly use NIntegrate, which might be more robust in terms of warning you if the adaptive scheme is not converging. g[x_?NumericQ] := Sin[x]; ...


8

I have no idea if the old syntax was removed for a reason, but normal behaviour can be returned with the following workaround: Unprotect[Visualization`Utilities`FrameTicksQ]; Visualization`Utilities`FrameTicksQ[{ _?Visualization`Utilities`OptionsDump`tickListQ, _?Visualization`Utilities`OptionsDump`tickListQ, ...


8

Graphics`Mesh`MeshInit[]; eps = 1/1000000; pp = ParametricPlot[{Sin[10 t], Sin[9 t]}, {t, eps, 2 π}]; intersections = Graphics`Mesh`FindIntersections[pp]; Show[pp, Epilog -> {Red, PointSize[Large], Point@intersections}] Graphics`Mesh`FindIntersections[ParametricPlot[{Sin[100 t], Sin[99 t]}, {t, eps, 2 π}]] // Length // Timing ...


8

One way is to use ListLinePlot: ListLinePlot@Table[{r, (1 - r^2)^(1/32)}, {r, -1, 1, 1/100}] Plot uses open sampling to avoid singularities at endpoints: Cases[Plot[x^2, {x, 0, 1}], Line[p_] :> First@p, Infinity] Cases[Plot[1/x, {x, 0, 1}, PlotRange -> All], Line[p_] :> First@p, Infinity] (* both yield {{2.04082*10^-8, 4.16493*10^-16}} *) ...


8

Thanks to the links and tips provided by Mr.Wizard I found the answer I was looking for, with a combination of EvaluationMonitor and the undocumented Bag functionality. Two problems with the code I found: For some reason updating the Bag object doesn't trigger the evaluation of a Dynamic expression containing it. I had to add another variable which ...


8

data3 = Style[{##}, ColorData["Rainbow"][Abs[(#1 - 0.5)] + Abs[1/10 (#2 - 5)]]] & @@@ data; Legended[ListPlot[data3, PlotStyle -> PointSize[0.01]], BarLegend["Rainbow"]] Update for your question in the comment: The color function ColorData["Rainbow"] ranges from 0 to 1 so the value has to be used within this range. Abs function ...


7

Here is an alternative to RegionPlot that potentially produces higher quality: it's based on Tube with varying radius, as I also used in this answer: With[ {a = 1, R = .7, n = 40, xMax = 1.5}, Manipulate[ Graphics3D[ GeometricTransformation[ {CapForm[None], {Opacity[.5], Pink, #, Cyan, GeometricTransformation[#, {{-1, 0, 0}, ...


7

Using either Swatchlegend, PointLegend, LineLegend, Barlegend you can easily generate a legend like you would get in a plot. SwatchLegend[{Red, Green, Blue}, {"red", "green", "blue"}] PointLegend[{Red, Green, Blue}, {"red", "green", "blue"}] LineLegend[{Red, Green, Blue}, {"red", "green", "blue"}] BarLegend["Rainbow"] Non-default styles are ...


7

I assume you are referring to the z-axis label, which is badly behaved (it tends to jump to the top or bottom of the axis on my example plot), especially at certain viewpoints: Although, by the nature of perspective in 3D plots, the axes labels will not always appear to be in the middle the the axis, here the position does seem to move out from the ...


7

To fill with a solid color, you can post-process the Line primitive into a Polygon ParametricPlot[{k2, v1}, {s1, 0.0, 50}, PlotRange -> {{0, 0.3}, {0, 1.5}}, AspectRatio -> 0.5, PlotStyle -> Black] /. Line[x_] :> {Blue, Polygon[x]} Update: Using the approach in this answer mentioned in Alexey's comment: poly = Cases[pp, Line[x_] :> ...


7

Manipulate[ Show[Plot[Sin[x], {x, 0, 2 Pi}], DiscretePlot[Sin[t], {t, 0, 2 Pi, Pi/6}, ExtentSize -> p, PlotMarkers -> {"Point", Large}, ColorFunction -> "Rainbow", PlotStyle -> EdgeForm[Black]]], {p, {Left, Full, Right}}]


7

As others mentioned, this is really an effect of ColorFunctionScaling -> True Manipulate[ DensityPlot[Sin[x] Sin[y], {x, -4, 4}, {y, -3, 3}, PlotRange -> {Automatic, Automatic, {-k, k}}, PlotLegends -> BarLegend[{Automatic, {-k, k}}], ColorFunctionScaling -> False, ColorFunction -> (ColorData["Rainbow"][Rescale[#, {-k, k}]] ...


7

Graphics`Mesh`MeshInit[]; eps = 1/100000000; Manipulate[Labeled[plt = ParametricPlot[{Sin[n t], Sin[(n - 1) t]}, {t, eps, 2 Pi}, Axes -> False, PlotStyle -> Thick]; plt /. Line -> Polygon, Grid[{{"n", "p"}, {n, 2 + Length@Graphics`Mesh`FindIntersections[plt]}}, ItemStyle -> Directive[16, "Panel"]], Top], {n, 2, 10, 1}]


7

You can use the values of the quantiles of your sample as bin delimiters for your histogram. You can think of $n$-quantiles as those threshold values that divide your data set into $n$ equal-sized subsets. Let's generate some sample data and set your requirements, i.e. number of points per bin: SeedRandom[10] sample = RandomVariate[NormalDistribution[], ...


7

Update: An alternative approach is to extract coordinates of the Rectangles and use Show similar to the approach @Algohi's answer. We define an auxiliary function lF to generate the coordinates for the line we need, and use it in the function showF that takes an Histogram as input and Shows it together with a line joining the midpoints of the rectangle ...


7

You need to either join all desired plots, e.g. ContourPlot[#, {x, -10, 10}, {y, -10, 10}, ContourStyle -> Red] &@(Join @@ Table[{y == (1/Sqrt[3])*x + i, y == -(1/Sqrt[3])*x + i, x == i*Sqrt[3]/2}, {i, -7, 7}]) or Show, e.g.: Show[ContourPlot[#, {x, -10, 10}, {y, -10, 10}, ContourStyle -> Red] & /@ Table[{y == ...


6

In your case, you have some arrows that are all drawn in the same style. This allows you to put all of them into a single Arrow command. For several differently colored arrows you would then have groups of Arrow commands for each different style: Manipulate[ Graphics[{Black, Thick, Circle[{-x, 0}, r], PointSize[.03], Point[{0, 0}], Red, ...


6

Update: Generate a separate legend with the default color scheme and export it: lineleg = LineLegend["DefaultPlotStyle"/. (Method/. Charting`ResolvePlotTheme[Automatic, ListLinePlot]), {"leg1", "leg2", "leg3"}]; Export["plotlegend.pdf",lineleg] To get the default colors associated with various PlotThemes you can use the function ...



Only top voted, non community-wiki answers of a minimum length are eligible