Tag Info

Hot answers tagged

14

Update: With the function top defined in the original post you can replicate all the cool things you see in rm-rf's answer in the linked Q/A. For example, with a slight modification of gr1, i.e., Graphics3D[hexTile[20, 20] /. Polygon[l_] :> {Directive[Orange, Opacity[0.8], Specularity[White, 30]], Polygon[l], Polygon[{Pi/5, 0} + {-1, 1} # & ...


11

Update: Adding a button to print a snapshot: Manipulate[Module[{a = {{2, 3}, {3, 2}}, vp}, vp = VectorPlot[a.{x, y}, {x, -4, 4}, {y, -4, 4}, VectorScale -> {0.045, 0.9, None}, VectorPoints -> 16]; z = NDSolveValue[Thread[{x'[t], y'[t], x[0], y[0]} == Join[a.{x@t, y@t}, #]], {x@t, y@t}, {t, -2, 1}] & /@ u; plot = ParametricPlot[z, ...


9

A method of assembling 2d contour plots ... Show[Table[ Graphics3D@ First@Cases[ Normal@ContourPlot[y^2 == a*x, {x, 0, 2}, {y, -2, 2}, Frame -> False], Line[x_] :> {Hue[(a - 1)/4], Line[Append[#, a] & /@ x]}, Infinity], {a, 1, 5, .5}] ,PlotRange->All] ...


8

You may use NMinimize[] on the results of ParametricNDSolve[] like this: g = 9.81; m = 10; rho = 1.225; Cd = 0.5; A = 0.1; rcd = rho Cd A; vMax = 40; EndTime[theta_] := (2 vMax Sin[theta])/g + 5; sol[Ux_, Uy_, Uz_] := Quiet@ParametricNDSolve[{ m z''[t] == -m g - Tanh[z'[t]] 1/2 rcd (z'[t] - Uz)^2, z[0] == 0, z'[0] == v Cos[theta], m ...


8

adjmat = {{0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1}, {1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0}, {0, 1, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {1, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 1, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 1, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, ...


7

I believe the first part of your question is answered by Stack. Observe: g := Stack[] something[f1[g], f3[g]] something[f1[{something, f1}], f3[{something, f3}]] So you can find that g was evaluated in f1 or f3 and further that these were evaluated in something. However this should not be necessary for your Ticks application. The value of Ticks ...


7

I believe this can be considered a bug, but it is also related to the (IMHO) non-bug behavior of automatic styling described in PlotLegends won't generate automatically more than 15 labels in v10. We see that if we use PlotLegends -> Automatic the number of legends is limited to the number of styles: ListPlot[Table[{j, i}, {i, Range[20]}, {j, ...


7

By default the frames of a GIF are stacked on top of each other. One can change this behavior using the Export option "TransitionEffect" -> Background: Export["D:\\InformationMaterial\\Wolfram\\vTest.gif", v, "TransparentColor" -> White, "TransitionEffect" -> Background] The default setting is "TransitionEffect" -> None.


7

There is an undocumented form of LegendLayout that is useful here: LegendLayout -> {"Column", noOfColumns} similarly for "Row" and their reversed cousins. So, in your case I would use LegendLayout -> {"Column", 2} giving Obviously, you do not have to include the color list when you pass it to PlotLegends.


7

Using the "almost new" feature of NDSolve[] that allows it to detect vector equations based upon the dimensions of the initial conditions. a = {{2, 3}, {3, 2}}; vp = VectorPlot[a.{x, y}, {x, -4, 4}, {y, -4, 4}, Axes -> True, AxesLabel -> {x, y}, VectorScale -> {0.045, 0.9, None}, VectorPoints -> 16]; ...


7

If I understand the question correctly, PolarPlot[Cos[2 t] Sin[2 t], {t, 0, 2 Pi}, PlotStyle -> Directive[Red, Dashed], PolarAxesOrigin -> {Pi/2, .5}, PolarGridLines -> Automatic, PolarAxes -> True, PolarTicks -> {Table[{N[Pi/6 i], ToString[30 i] <> "°"}, {i, 0, 11}], Table[{0.1 i, 0.1 i}, {i, 4}]}] produces the desired ...


7

Also PlotRange[plot] PlotRange /. AbsoluteOptions[plot] Last @@ AbsoluteOptions[plot, PlotRange] PlotRange /. plot[[2]] all give (* {{0.,10.},{-0.999999,1.}} *) Note: Regarding usage of PlotRange as a function, it is undocumented, and the earliest reference I could find on this site is this answer dated Oct 11, 2012: The same range on each plot in a ...


6

Using PiecewiseExpand[Abs[x], x \[Element] Reals] instead of Abs[x]: Plot[Evaluate@ D[PiecewiseExpand[Abs[x], x \[Element] Reals], x], {x, -10, 10}, PlotStyle -> Thick] You can convert Abs to Piecewise for real arguments using PiecewiseExpand: absToPW[x_] := PiecewiseExpand[Abs[x], x \[Element] Reals] absToPW[z] which you can differentiate ...


6

You can use ClipPlanes. Using the same example from the docs as Zviovich: tori = ParametricPlot3D[{{4 + (3 + Cos[v]) Sin[u], 4 + (3 + Cos[v]) Cos[u], 4 + Sin[v]}, {8 + (3 + Cos[v]) Cos[u], 3 + Sin[v], 4 + (3 + Cos[v]) Sin[u]}}, {u, 0, 2 Pi}, {v, 0, 2 Pi}, PlotStyle -> {Red, Green}]; Show[tori, ClipPlanes -> {{0, 0, -1, 4}}] ...


6

Here's a way to get the 2D graphics from an already-generated plot. tori = ParametricPlot3D[{{4 + (3 + Cos[v]) Sin[u], 4 + (3 + Cos[v]) Cos[u], 4 + Sin[v]}, {8 + (3 + Cos[v]) Cos[u], 3 + Sin[v], 4 + (3 + Cos[v]) Sin[u]}}, {u, 0, 2 Pi}, {v, 0, 2 Pi}, PlotStyle -> {Red, Green}, Mesh -> None, PlotStyle -> Thickness[0.1]]; ...


6

Here's one way: ContourPlot3D[y^2 == a*x, {x, 0, 2}, {y, -2, 2}, {a, 0.9, 5.1}, MeshFunctions -> {#3 &}, Mesh -> {Table[a, {a, 1, 5, 0.5}]}, ContourStyle -> None, BoundaryStyle -> None] /. GraphicsComplex[p_, g_, opts___] :> GraphicsComplex[p, g /. Line[v_] :> {Hue[((p ~Part~ v[[1]] ~Part~ 3) - 1)/4], Thick, ...


6

A quick one based on your phase diagram context, where bg contains the color of your 2D planes: g = Table[ParametricPlot3D[{y^2/a, y, a}, {y, -2, 2}, PlotStyle -> Hue[(a*2 - 1)/10]], {a, 1, 5, 1}]; bg = Table[ContourPlot3D[z == a, {x, -4, 6}, {y, -4, 4}, {z, .8, 5.2}, Mesh -> None, ContourStyle -> Directive[Hue[1 - (a*2 - 1)/10], Opacity[0.3]]], ...


6

Here is a way to do it: TruncatedOctahedron = ImplicitRegion[{x + y + z <= 10 && x + y - z <= 10 && x - y + z <= 10 && -x + y + z <= 10 && x + y + z >= -10 && x + y - z >= -10 && x - y + z >= -10 && -x + y + z >= -10 && -6 <= x <= 6 && ...


6

A couple of ideas. Rendering is a problem with transparency and so many planes. Hence the need for "DepthPeelingLayers". {zsol} = Solve[2 a x + 2 b y - z + a^2 + b^2 == 0, {z}]; family = Graphics3D[ {Opacity[0.3], Darker@Red, Specularity[White, 10], EdgeForm[Directive[Opacity[0.25], Red]], Table[InfinitePlane[{x, y, z} /. zsol /. Thread[{x, y} ...


6

A computer is a finite machine and there is a limit to how well you can visually explore such functions. Perhaps it will give enough of a impression to sum only a few terms. Even 5 terms exceeds the monitor's ability to display all the turns. Plot[ Evaluate@Table[Sum[(1/2)^n*Cos[3^n*Pi*x], {n, 0, k}], {k, {1, 2, 5}}], {x, 0, 3}, PlotStyle -> ...


5

Unless you specify the tick mark length in your tick specifications tick marks are rendered with default length and style. tickF = {#, DateString[#, {"MonthNameShort", " ", "Day", "/", "YearShort"}]} & /@ AbsoluteTime /@ DateRange[##, {10, "Day"}] &; Example data: data = {{3368649600, 8}, {3369427200, 10}, {3370291200, 12}, {3370636800, ...


5

Apparently, ParametricNDSolve cannot handle x[t0] or y[t0] when t0 is a parameter. A work-around is to shift time to begin at t0, in which case the code becomes, sol = ParametricNDSolve[{x'[t] == y[t], y'[t] == x[t] - 1 - \[Epsilon] Cos[5 (t + t0)], x[0] == x0, y[0] == y0}, {x, y}, {t, -t0, -t0 + 10}, {t0, x0, y0, \[Epsilon]}] which works fine. ...


5

First, a function to produce dots to be used as filling: dotsF[n_: {50, 50}, sz_: Medium, clr_: LightGray] := With[{g = Tuples[{Range[n[[1]]], Range[n[[2]]]}]}, Graphics[{clr, PointSize[sz], Point@g}, ImagePadding -> 0, PlotRangeClipping -> False, PlotRangePadding -> 0, AspectRatio -> 1]] dotsF[{10, 10}, .1, Green] It will be more ...


5

PlotMarkers are passed to the legends via the LegendMarkers option. Here it looks like only 15 markers are being passed in, e.g. In[3]:= plot = ListPlot[Table[{j, i}, {i, Range[20]}, {j, Range[3]}], Joined -> True, PlotMarkers -> {Automatic, Large}, PlotLegends -> Range[20]]; In[4]:= Cases[plot, HoldPattern[LegendMarkers -> l_] :> l, ...


5

PairedBarChart >> Possible Issues: PairedBarChart does not accept negative values: A work-around is to combine two BarCharts using Row: SeedRandom[0] data = RandomInteger[{-5, 5}, {2, 10}]; opts = {ChartStyle -> 63, BarOrigin -> Left, AxesOrigin -> {0, 0}, ImageSize -> 500}; Panel[Row[BarChart[#, opts] & /@ data, Spacer[10]]] Of ...


5

Here is an example of how to do it: f[x_, y_] := {Sin[x], Cos[y], Sin[2 x + y]} Block[{x, y, h, xMin = -1, xMax = 3, yMin = -3, yMax = 3}, Graphics[{}, PlotRange -> {{xMin, xMax}, {yMin, yMax}}, Epilog -> Inset[Show[ColorCombine[Table[Image[ DensityPlot[f[x, y][[i]], {x, xMin, xMax}, {y, yMin, yMax}, Frame -> None, ...


5

Using BoundaryStyle Use the option BoundaryStyle and set the option value to {{1, 2} -> Directive[Thick, Red]}: Plot3D[{-5 - x - y, -Sqrt[8 x^2 + 8 y^2]}, {x, -5, 5}, {y, -5, 5}, Mesh -> None, BoxRatios -> {1, 1, 1}, BoundaryStyle -> {{1, 2} -> Directive[Thick, Red]} ] Using MeshFunctions Use the difference between the two functions ...


5

Gamma is an extremely quickly increasing function, so you're dealing with the ratio of huge numbers here. Something similar to catastrophic cancellation can happen. Fortunately, Mathematica is very good at dealing with this situation if you let it use arbitrary precision instead of machine precision. Change 0.5 to 1/2 and add something like ...


5

While @Szabolcs has provided the correct work-around, the actual issue has to do with automatic use of Compile for function evaluation. The affected range is such that the value of Gamma[1+n] is still a machine real, but their product is out-of-bound. The issue comes, because the default setting of Compile's RuntimeOptions is to tolerate machine arithmetic ...


4

Looks fine to me, once you get your aspect ratio proper. foci = {{-3, 25}, {2, 20}}; ContourPlot[ Total[EuclideanDistance[#, {x, y}] & /@ foci], {x, -5, 5}, {y, 10, 30}, AspectRatio -> 2, Epilog -> {Black, PointSize[Large], Point@foci}] or your horizontal and vertical ranges equal: foci = {{-3, 25}, {2, 20}}; mycontplot = ContourPlot[ ...



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