Tag Info

New answers tagged

1

Manipulate[ Module[ {term = (m - k*m + l*n)}, ParametricPlot[{ (h m + h l n + k m t + k l z)/term, (h l n + (1 - k) (m t + l z))/ term}, {t, 0, 200}, Frame -> True, Axes -> False, PlotRange -> {{0, 2500}, {0, 600}}, FrameLabel -> (Style[#, 14] & /@ {"x-axis", "y-axis"})]], Grid[{ {Control[{{h, 200}, 0, ...


1

You need to add Frame -> True to specify FrameLabel: Needs["ErrorBarPlots`"] ErrorListPlot[{ {{1, 1}, ErrorBar[0.2]}, {{2, 2}, ErrorBar[0.1]}, {{3, 4}, ErrorBar[0.3]}, {{4, 6}, ErrorBar[0.4]}}, Frame -> True, FrameLabel -> {"Position, x (inches)", "Photodetector output (V)" }, GridLines -> Automatic, Joined -> True]


1

In ErrorListPlot, there is not such an option as "FrameLable", but "AxesLable", so use "AxesLable" instead of "FrameLable", just like this Another way to do that is using function "Show, like this: ErrorListPlot[Table[{i, RandomReal[0.5]}, {i, 10}]]; Show[%, Frame -> {{True, False}, {True, False}}, FrameLabel -> {"Position, x (inches)", ...


0

It looks like the plotting may be slow because you're trying to resolve a small feature and upping the number of points you use in the entire plot. If you instead try upping the number of points only in the region between 0.99 and 1.01, where you know the sharp features are, you cut down on the amount of time spent searching: Timing[With[{plotopts = {Mesh ...


3

Here's a version with checkboxes: numData = 4; data = Sort /@ RandomReal[{0, 10}, {5, numData, 2}]; legend = Table["data" <> ToString@i, {i, numData}]; DynamicModule[ { dataCombinations = {} } , Grid @ {{ CheckboxBar[ Dynamic @ dataCombinations, Thread[Range[numData] -> legend], Appearance -> "Vertical" ...


3

Consider: plot1 = Plot[Sin[x], {x, 0, 6 Pi}]; plot2 = Plot[Cos[x], {x, 0, 6 Pi}]; TogglerBar[Dynamic[p], {plot1 -> "Plot 1", plot2 -> "Plot 2"}] Dynamic[p /. {x__} :> Show[x]] See TogglerBar and CheckboxBar.


3

Using some made-up test data to illustrate. This approach is also used here with fading transitions. data1 = Table[Sin[x], {x, 0, 2 Pi, Pi/4}]; data2 = Table[Cos[x], {x, 0, 2 Pi, Pi/4}]; plot1 = ListLinePlot[data1, DataRange -> {0, 2 Pi}]; plot2 = ListLinePlot[data2, DataRange -> {0, 2 Pi}]; id = ImageDimensions[plot1]; Manipulate[Graphics[{White, ...


1

It helps to restrict the domain when using NSolve. eqn = -(\[Pi]/4) + x - 1/2 Sin[2 x]; NSolve[eqn, x, Reals] Plot[eqn, {x, -2, 2}] (*{{x->1.15494}}*)


3

Rationalize all of the definitions and equations so that there are no numerical artifacts resulting from the initial presence of the imaginary factors. C1 = 1/10; C2 = C1/10; R = 50; Tb = 1/10; Geb = 5; Z0 = 50; L[Te_] = Te + 9/10; Zlcr[Te_, w_] = (1/R + 1/(I*L[Te]*w) + I*C1*w)^-1; Zload[Te_, w_] = -I*w*C2 + Zlcr[Te, w]; Γ[Te_, w_] = (Zload[Te, w] - ...


2

This works with both versions: g2 = ListPlot[{{2, 1}, {3, 4}, {3.5, 4.2}, {4, 6}}, PlotStyle -> {Dashing[Large]}, Joined -> True]; g1 = ListPlot[{{2, 1}, {3, 4}, {3.5, 4.2}, {4, 6}, {4.5, 6.6}, {5, 7}, {6, 9}, {8, 11}}, Joined -> True, PlotStyle -> {Dotted}]; Legended[Show[g1, g2], LineLegend[{Dashed, Dotted}, {"Dashed", "Dot"}]] ...


8

As noted by Eldo, this works out of the box on Mathematica 10. On Mathematica 9 LineLegend does the trick: data2 = {{2, 1}, {3, 4}, {3.5, 4.2}, {4, 6}}; data1 = {{2, 1}, {3, 4}, {3.5, 4.2}, {4, 6}, {4.5, 6.6}, {5, 7}, {6, 9}, {8, 11}}; ListPlot[ {data1, data2}, Joined -> True, PlotStyle -> {Dotted, Dashing[Large]}, PlotLegends -> ...


3

This is not really any advance on eldo's answer. I post it for illustration: Manipulate[ ParametricPlot[{t + 1/t, t - 1/t}, {t, -10, 10}, Exclusions -> {0}, Epilog -> {Red, PointSize[0.02], Point[{p + 1/p, p - 1/p}]}], {p, -10, 10}]


1

r = ParametricRegion[{t + 1/t , t - 1/t }, {{t, -80, 80}}]; RegionPlot[r, PlotRange -> {{-4, 4}, {-2, 4}}, Frame -> False, Axes -> True]


9

Edit Here is a version that avoids the use of Inset and instead uses Overlay. I think this version covers all of the OPs requests. I have not tried to functionalize the code at this point since there will likely be some tweaking of parameters based on the actual functions plotted. optsall = {Axes -> False, Frame -> True, ImageSize -> 600, ...


2

Using @MarkMcClure's method eq1 = x^2 + y^2 + z^2 == 1; deriv1 = Derivative[1, 0][z][x, y] /. First[Solve[D[eq1 /. z -> z[x, y], x], Derivative[1, 0][z][x, y]]] /. z[x, y] -> z; with the options Mesh, MeshFunctions and MeshShading gives: ContourPlot3D[Evaluate[eq1], {x, -1, 1}, {y, -1, 1}, {z, -1, 1}, Mesh ...


6

ParametricPlot[{f2[t], g2[t]}, {t, -80, 80}, PlotRange -> {{-4, 4}, {-2, 4}}, Exclusions -> {f2[t] == 0}, ImageSize -> 400] Because FunctionDomain[f2[t], t] Another possibility: ParametricPlot[{f2[t], g2[t]}, {t, -80, 80}, PlotRange -> {{-4, 4}, {-2, 4}}, Exclusions -> {f2[t] == 0}, ExclusionsStyle -> Directive[Red, ...


5

You can get a significant boost by compiling ysaf: ysafc = Compile[{x, y}, Evaluate @ N @ ysaf[λ ArcSin[Sqrt[x^2 + y^2]], ArcTan[x, y]]]; func[x_?NumericQ, y_?NumericQ] := ysafc[x, y] gr = ContourPlot[{func[x, y] == 0, Sqrt[x^2 + y^2] == rmx}, {x, -rmx, rmx}, {y, -rmx, rmx}, RegionFunction -> Function[{x, y, z}, Sqrt[x^2 + y^2] <= rmx], Axes ...


4

One can gain a considerable speed gain by omitting RegionFunction and setting PlotPoints to 10. The following only needs 8 seconds (it uses some ideas of @PhilChang): A = { (8 Sqrt[1035741])/15625, 0, 0, 0, 0, Sqrt[6597877/15]/6250, 0, 0, 0, 0, -(Sqrt[(6338501/10)]/3125), 0, 0, 0, 0, (29 Sqrt[27347/30])/3125, 0, 0, 0, 0, ...


4

Some codes are from the answer of PhilChang Remove["Global`*"]; A = {(8 Sqrt[1035741])/15625, 0, 0, 0, 0, Sqrt[6597877/15]/6250, 0, 0, 0, 0, -(Sqrt[(6338501/10)]/3125), 0, 0, 0, 0, (29 Sqrt[27347/30])/3125, 0, 0, 0, 0, -(Sqrt[(4358874/5)]/3125), 0, 0, 0, 0, -(Sqrt[(352454081/3)]/31250), 0, 0, 0} // N; s[m_, l_] := If[Abs[m] > l, 0, ...


3

data = Table[{10^n, n}, {n, 1, 5}]; ListLogLinearPlot[ data, Epilog -> Table[Text[#[[i]], {Log @ #[[i]], i + 0.5}], {i, 1, Length @ #}] &[First /@ data], PlotRangePadding -> {1, 1}, PlotTheme -> "Detailed"]


2

In my experience economists tend not to write time-series decomposition algorithms of the their own but rather use well established ones. Among them two most well known are ARIMA-X13 and TRAMO-SEATS. Both are implemented by the US Census Bureau and executables are available here. I've tried and implemented a simple package that calls the CB's files in the ...


7

Your plot is not symmetric since your plot has an AspectRatio of 1 while it should be 4/3. This also helps the problem with the cusp not going all the way to the boundary. I also made your boundary a bit cleaner. [...] boundary = Show[Graphics[{Black, Thick, Dashed, Line[#]}] & /@ Permutations[ {{0, Sqrt[6]/3}, {-(1/Sqrt[2]), -Sqrt[6]/6}, ...


4

The orginal program takes 78s on my computer. First, Make vector A a real vector will make the program a little faster. A = {(8 Sqrt[1035741])/15625, 0, 0, 0, 0, Sqrt[6597877/15]/6250, 0, 0, 0, 0, -(Sqrt[(6338501/10)]/3125), 0, 0, 0, 0, (29 Sqrt[27347/30])/3125, 0, 0, 0, 0, -(Sqrt[(4358874/5)]/3125), 0, 0, 0, 0, ...


9

Your question is a little vague but one possible mapping from a square to a circle is the following. This transformation wrapped into a Mathematica function: transformation[points_] := {#[[1]] Sqrt[1 - (#[[2]]^2/2)], #[[2]] Sqrt[1 - (#[[1]]^2/2)]} & /@ # & /@ points; And a little demonstration: points = Table[{a, b}, {a, -1, 1, 0.2}, ...


4

Only the abscissa is logarithmic, so: ListLogLinearPlot[Table[{x, x^2}, {x, 1, 2, 0.1}], Epilog -> {Text["Hello", {Log[1.2], 3.0}]}]


8

An alternative to RegionFunction is ConditionalExpression. Using @paw's cool example z = Sum[Sin[RandomReal[5, 2].{x, y}], {5}]; ContourPlot[Evaluate[ConditionalExpression[z,Norm[{x, y}, 2] < 3]], {x, -3, 3}, {y, -3, 3}, BoundaryStyle -> {Thick, Black}] ContourPlot[Evaluate[ConditionalExpression[z, z Norm[{x, y}] < 3]], {x, -3, ...


13

RegionFunction is the option you are looking for. ContourPlot[ Evaluate[Sum[Sin[RandomReal[5, 2].{x, y}], {5}]], {x, -3, 3}, {y, -3, 3}, BoundaryStyle -> {Thick, Black}, RegionFunction -> Function[{x, y, z}, x^2 + y^2 < 9] ]


2

I have something like this in mind: I am posting this answer so that others can see what I have done. I have no intention of accepting this. Surely others will come up with better ideas. dat = {1, 4, 3, 7, 8, 9, 10}; labels = {"john", "mary", "rusty", "pi", "euler", "leonard", "rupert"}; ArrayPlot[{dat}, FrameTicks -> {{False, False}, ...


1

It is a curious thing, the default appears to do a linear interpolation ( ie. rendering more points than input ), yet specifying InterpolationOrder->1 dramatically increases the number of interpolation points: simple example: data = Table[ Sin[x] , {x, 0, 10}, {y, 0, 10}] // N; ListPlot3D[data] in = ListPlot[ data[[All, 1]] , PlotStyle -> ...


2

Using sim[length_] := Module[{rv = RandomVariate[BetaDistribution[2, 1], length], y, yMed}, y[1] = First@rv; yMed[t_Integer] := yMed[t] = Median[y /@ Range[t]]; y[t_Integer] := y[t] = f[0.5, {rv[[t]], yMed[t - 1]}]; yMed /@ Range[length] ] results in plots like Here Median[y /@ Range[t]] calculates the median for y[1] to y[t], as stated ...


2

The reason that AbsoluteOptions[p, InterpolationOrder] doesn't work is that p is a Graphics object and InterpolationOrder is an option for (e.g.) ListPlot3D, not Graphics. InterpolationOrder guides the creation of the graphic but it does not remain a mutable part of it. I addressed this topic here: Is it possible to change the color of plot in Show? As ...


2

Here's another example. horizontal[pairs_] := Grid[pairs] vertical[pairs_] := Grid[MapAt[Rotate[#, Pi/2] &, Transpose@pairs, {2, All}]] SwatchLegend[{Red, Green, Blue}, {"red", "green", "blue"}, LegendLayout -> horizontal] SwatchLegend[{Red, Green, Blue}, {"red", "green", "blue"}, LegendLayout -> vertical] Example of my first suggestion, ...


5

My answer is based upon Öska's answer here. Credits go to him. A simple example: legend = {"a", "b", "c"}; values = Range@3; MatrixPlot[List /@ values, ColorFunction -> "DarkRainbow", FrameTicks -> {{True , Thread[{values, legend}]}, {False , False }}] MatrixPlot[{values}, FrameTicks -> {{False , False}, {True , Thread[{values, legend}]}}] ...


6

Make rotate transform like this. And change some options of ListPolarPlot. I modified the PolarTicks option. rotatePolar[a_List] := Module[{l = Length[a]}, Table[{2 Pi*(i - 1)/l + Pi/2, a[[i]]}, {i, l}] ] ListPolarPlot[rotatePolar[Reverse[Range[20]]], PolarAxes -> True, PolarAxesOrigin -> {Pi/2, 20}, PolarTicks -> {Drop[ Table[{i, Mod[i ...


3

Sort the data ListPlot[Sort /@ {{{1, 0}, {0, 0.5}}, {{1, 1}, {0, 1}}}, Filling -> {1 -> {2}}, FillingStyle -> LightGray, Joined -> True, Frame -> True]


2

This is my second answer. I was encouraged to post this separately. There is some sense to that, as it lets the community sort out the best solution, instead of tying two solutions together. From my answer to How to do a region plot with many functions When m and v have Ordering[fns, 1] returns the index of the function whose value is least. By setting ...


1

This is a verbose epilog to the nice answers given: fun = Sin[x]; lim = 4 Pi; max = Round @ First @ FindMaximum[fun, {x, 0}]; min = Round @ First @ FindMinimum[fun, {x, 0}]; xp = FindInstance[(fun == max || fun == min) && 0 <= x < lim, x, Reals, 15]//Values//Flatten; yp = Table[fun, {x, xp}] plo = Plot[fun, {x, 0, lim}, ...


0

I found half an answer that works well except for the orientation part. As several of you have hinted at the FindCurvePath function is on the right track, but it only works in two dimensions. My options are thus projecting/rotating any polygon to some canonical plane, or, more easily, using the FindShortestTour function which solves the "traveling salesman ...


4

Here's a different approach to consider. Ordering[fns, 1] returns the index of the function whose value is least for given numeric values for x adn y. (Should there be a tie, it will return the first index only). We can use this in ContourPlot to plot the regions. fns = {x + y, 2 x - y, 1 - x^2 - y^2, (x - 1)^2 + (y - 1)^2 - 2, 2 Sin[x y] - 1/2}; ...


1

With a list of your functions functions = {P1[d, V, A], P2[d, V, A], P3[d, V, A], P4[d, V, A], P5[d, V, A], P6[d, V, A]}; you can create a list of all combinations using And @@ # & /@ MapIndexed[Drop, Partition[#[[1]] < #[[2]] & /@ Tuples[functions, 2], Length @ functions]]


1

A quick look at a Table of the outcomes of your code shows pretty much what the problem is. If FuncThomae[x_] := If[ ExactNumberQ[Rationalize[x]], If[x == 0, 1, L = #^-1 & /@ Divisors[Numerator[Rationalize[x]]] ] , 0] then Table[FuncThomae[x], {x, 0, 1, 0.1}] produces {1, {1}, {1}, {1, 1/3}, {1, 1/2}, {1}, {1, 1/3}, {1, 1/7}, {1, ...


4

In version 10, you can use MeshCoordinates[ConvexHullMesh[...]] as in RunnyKine's answer, but you need to re-order them using MeshCells: pentagon=N@Table[{Cos[2 Pi k /5], Sin[2 Pi k /5]}, {k, 5}] points = N@RandomSample[Join[pentagon, {{0, 0}}]] chm=ConvexHullMesh[points]; ordering=MeshCells[chm,2][[1,1]] out=MeshCoordinates[chm][[ordering]] ...


1

The following works in your special case but can't be generalized. l = {"+", "m", "π", "[]", "2"}; SeedRandom@0; rl = RandomSample[l, 5]; g = With[{cg = CycleGraph[5]}, Graph[UndirectedEdge @@@ Thread@{rl, RotateLeft@rl}, VertexCoordinates -> (Rule @@@ Thread@{rl, VertexCoordinates /. AbsoluteOptions[cg, VertexCoordinates]}), ...


3

If you have Version 10, you could use ConvexHullMesh. pts = RandomReal[{-10, 10}, {6, 2}]; You can then order them by doing: chull = ConvexHullMesh[pts]; And here are the points: MeshCoordinates[chull] Note: This does not always order the points but one can use MeshCells which will give the ordering correctly. See @kguler's answer.


2

Could use ConvexHull in the ComputationalGeometry standard add-on package. Needs["ComputationalGeometry`"] We'll create a simple example. pts = RandomReal[{-10, 10}, {6, 2}]; ListPlot[Append[pts, First[pts]], Joined -> True] Now find and plot the (ordered) outer points. hullindices = ConvexHull[pts]; hullpts = pts[[hullindices]]; ...


7

Another alternative is to use ConditionalExpression using the second-order condition for a local maximum as the second argument: f = Sin; Plot[f[x], {x, 0, 20 Pi}, Mesh -> {{0}}, MeshFunctions -> {ConditionalExpression[f'[#], f''[#] < 0] &}, MeshStyle -> {PointSize[Large], Red}] f = Sin[#] - 1/2 Cos[Pi #] &; ...


9

I agree with beli that an answer is desriable, with mfvonh that closing of questions is a bit out of control, and with m_goldberg that Prolog should be used. I'd happily wait for m_goldberg to post an answer but, since there's 4 close votes already, here's a simple example of the difference between Epilog and Prolog. The difference, of course, is that ...


3

Let me shorten your example a little bit par = ParametricPlot3D[{1 + Cos[t], Sin[t], 2 Sin[t/2]}, {t, 0, 4 \[Pi]}, PlotStyle -> Red, Boxed -> False, AxesOrigin -> {0, 0, 0}, AspectRatio -> 1]; arr = Graphics3D[ { Arrowheads[0.02], {Red, Arrow[{a[0], a[0] + tf[0]}]}, {Green, Arrow[{a[1], a[1] + tf[1]}]}, {Blue, ...


2

Summarizing all of the comments: Clear[T] T[e_?NumericQ] := (1/Pi)*NIntegrate[ 1/Sqrt[Sin[ArcCos[-e]/2]^2 - Sin[\[Phi]/2]^2], {\[Phi], 0, ArcCos[e]/2}] Plot[ {Re[T[e]], Im[T[e]], Abs[T[e]]}, {e, -2, 2}, PlotRange -> All, WorkingPrecision -> 25, PlotLegends -> "Expressions", Frame -> True, Axes -> False] EDIT: With the ...


1

I think Michael E2 is exactly true. "should normally be chosen to be continuous monotonic functions." I have tried draw like this. Because it is not continuous monotonic function it is drawed lines along with the polygon meshs. I think MeshFunction seems improbable for your purpose. f[x_, y_] := (x^2 + 3 y^2)*E^(1 - x^2 - y^2) f1 = Plot3D[f[x, y], {x, -2, ...



Top 50 recent answers are included