New answers tagged

0

Perhaps you would like to use Histogram3D Manipulate[ Histogram3D[ Table[{Frequency[k, r, fmin, fmax], Amplitude[k, r]}, {k, 0, Nwaves - 1}]], {{Nwaves, 1, Style["Number of waves", 10]}, 1, 50, 1, ImageSize -> Large, Appearance -> {"Labeled", "Closed"}}, {{fmin, 0, Style["Min frequency", 10]}, 0, fmax, 0.001, ImageSize -> Large, Appearance ...


1

Thanks to ciao's and Kuba's explanation, I have thought of some little code to exemplify the scoping behaviour of Manipulate; I hope it will be helpful to people who are still not very familiar with the concept: a), Manipulate[Hold@x, {x,0,1}] b), p=x; Manipulate[2 p-x,{x,0,1}] c), rpl=p->x; Manipulate[(2 p/.rpl)-x,{x,0,1}]


2

Clear["Global`*"]; Φcl = (-G*Mcl)/Sqrt[x^2 + y^2 + z^2 + a^2]; Φeff = Φcl + 1/2*(κ2 - 4*ω^2)*x^2 + 1/2*v2*z^2; G = 1; Mcl = 2.2; a = 0.182; κ2 = 1.8; ω = 1; v2 = 7.6; E0 = -3.2; rm = 1; P0 = ContourPlot3D[Φeff == E0, {x, -rm, rm}, {y, -rm, rm}, {z, -rm, rm}, Mesh -> None] Now extract the points from the surface pts = First@Cases[P0, ...


4

This version works: rl = {ρ[z_, ϕ_] :> 1/5 Sqrt[25 - 25 z^2 + 10 Sin[5 ϕ] + Sin[5 ϕ]^2]}; Manipulate[PolarPlot[Evaluate[ReplaceAll[ρ[z, ϕ], %]], {ϕ,0, 2 Pi}], {z, -1, 1}] Manipulate[PolarPlot[Evaluate[ReplaceAll[ρ[z, ϕ], rl]], {ϕ,0, 2 Pi}], {z, -1, 1}] The main change is in the way the rule is defined as a $RuleDelayed$ instead of $Rule$.


3

Well, you can use DiscretizeGraphics and RandomPoint to achieve what you want: P0 = ContourPlot3D[Φeff == E0, {x, -rm, rm}, {y, -rm, rm}, {z, -rm, rm}, Mesh -> None, Lighting -> None]; Note the Lighting -> None option, this is to circumvent a bug in DiscretizeGraphics that the good people at Wolfram refuse to fix. gg = ...


3

Here are two additional approaches, one uses RegionIntersection, the other uses DiscretizeGraphics: f[x_, y_, z_] = x^4 + y^4 + z^4 - 1; g[x_, y_, z_] = x - 2 y + z - 2; regF = ImplicitRegion[f[x, y, z] == 0, {x, y, z}]; regG = ImplicitRegion[g[x, y, z] == 0, {x, y, z}]; reg = DiscretizeRegion @ RegionIntersection[regF, regG] MeshCoordinates @ reg // ...


4

For version 9: f[x_, y_, z_] := x^3 + y^2 - z^2 g[x_, y_, z_] := x^2 + y^2 + z^2 - 1 cp3d = ContourPlot3D[{f[x, y, z]==0, g[x, y, z]==0}, {x, -2, 2}, {y, -2, 2}, {z, -2, 2}, BoundaryStyle -> {1 -> None, 2 -> None, {1, 2} -> {Thick, Red}}, ContourStyle -> Opacity[.7], Mesh -> None, ImageSize -> 400]; points = Cases[Normal@cp3d, ...


2

You did not define K0 so I added a Manipulate to control its value. b2[K_] := 1 - (K/938.27 + 1)^-2 Fbeta[K_] := Log[1.02*10^6*b2[K]/(1 - b2[K])] - b2[K] dEdx[K_] := 0.17/b2[K]*(Fbeta[K] - 4.31) Manipulate[ myplot = Plot[ NIntegrate[1/dEdx[K], {K, 1000 kappa, K0}]/ NIntegrate[1/dEdx[K], {K, 0, K0}], {kappa, 0, 1}, PlotRange -> {0, 1}], {{K0, ...


2

Adding links to comment by MarcoB Note the Attributes of RegionPlot Attributes[RegionPlot] (* {HoldAll, Protected, ReadProtected} *) Since RegionPlot and other plot functions have attribute HoldAll you need to use Evaluate a = {x^2 < y^3 + 1, y^2 < x^3 + 1}; RegionPlot[Evaluate[a], {x, -2, 5}, {y, -2, 5}]


1

I am not sure how well the following is answering your question. Here is the general idea: Write a function that finds distances from an arbitrary point to each of the lines defined by the polygons sides (line segments). Use some sort of dynamic manipulation to plot the most interesting point-segment distances. I assume it is important to stay in 3D, ...


6

I'm not sure what kinds of calculations you'll want to do on the intersection line; but to get a sample of points on the intersection line, you could use DiscretizeRegion and MeshCoordinates: f[x_, y_, z_] = x^4 + y^4 + z^4 - 1; g[x_, y_, z_] = x - 2 y + z - 2; ContourPlot3D[{f[x, y, z] == 0, g[x, y, z] == 0}, {x, -2, 2}, {y, -2, 2}, {z, -2, 2}, ...


0

The code you posted works, but it generates a cobweb plot: logistic[2.8, 0.1] For the visualization you want, take a closer look at the definitions of f and seq in the code you posted. The plots you want to generate shows x[n] vs. start value, x0, for iterations 1 through 5, at 4 different growth rates, r. recurrenceList[r_, x0_, n_:50] := NestList[(r ...


3

ClearAll[pw] conds = # <= t <= #2 & @@@ Partition[t /@ Range[-1, 3], 2, 1]; vals = X[#][t] & /@ Range[0, 3]; pw[k_][t_] := Simplify[Piecewise[{{vals[[k + 2]], conds[[k + 2]]}}]] Plot[Evaluate[pw[#][t] & /@ Range[-1, m - 1]], {t, 0, 4}, PlotLegends -> "Expressions", PlotRange -> All]


3

First off, in your code sol = RSolve[{x[n + 1] == 2.8*x[n]*(1 - x[n]), x[0] == 0.2}, x[n], n] ListPlot[Table[{n, x[n] /. sol[[1]]}, {n, 1, 5}], PlotStyle -> {Hue[1], PointSize[0.0125]}]; you have a semicolon after the ListPlot command, so you won't get a plot. Second, have a look at the output of RSolve - it does not give an analytic formula. sol = ...


-1

Please consider this is an extended comment, as like MarcoB I don't understand what you are trying to achieve but have you seen Piecewise? For example x[t_] = Piecewise[ Evaluate@Transpose[{{1 + t, 1 - t, t}, #1[[1]] <= t < #1[[2]] & /@ Partition[Table[1 + 10*(1 - 0.9^k), {k, 0, 3}], 2, 1]}], Indeterminate] Plot[x[t], {t, 0, 4}] ...


2

Not a bug - it's a feature!! First let's import the data in as quick a fashion as possible, arableLandPerPopulation=<<"https://gist.githubusercontent.com/jasondbiggs/9e915145a2d4cfa34119fa4d0e535ed2/raw/75387a17c21ee7ff9d7f21e528ca2f971e24209b/gistfile1.txt"; Now look at the GeoRegionValuePlot with and without the PlotRange specified ...


1

You've created a MeshRegion, so you can plot it with RegionPlot3D, Of course, since your cylinder is rotated with respect to the cartesian coordinates, you'll need to find the right combination of coordinates to give the mesh you want. Here are some examples, RegionPlot3D[hull, Mesh -> 10, MeshFunctions -> #, Axes -> True, ImageSize -> ...


8

Histogram does not support a grouped ChartLayout. Hence the workaround using BarChart: I've arranged the 'histogram' into a bar chart so that the data can be displayed side by side. An alternative to using BarChart with "Grouped" layout is to use a custom ChartElementFunction to produce the desired Histogram layout: ClearAll[groupedHistogram] ...


3

f[x_] := x + 2; g[x_] := Sin[x]; Plot[{f[x], g[x]}, {x, 0, Pi/2}, PlotRange -> {-0.1, 3.65}, PlotLegends -> "Expressions", Filling -> (1 -> {2}), Frame -> True, Epilog -> {Directive[Thick, Magenta], Line[{{#, g[#]}, {#, f[#]}}] & /@ {0, Pi/2}}] rgn = ImplicitRegion[g[x] <= y <= f[x] && 0 <= x <= ...


7

Rather than Show, you can use Prolog + Inset with Scaled: Plot[ 140 PDF[SmoothKernelDistribution[#], x] & /@ {S086, T086, X086}, {x, 0, 100}, Evaluated -> True, PlotStyle -> { {Thickness[0.01], RGBColor[0.23, 0.42, 0.63]}, {Thickness[0.01], RGBColor[0.29, 0.53, 0.80]}, {Thickness[0.01], RGBColor[0.62, 0.73, 0.88]}}, Frame -> ...


3

r3 = AppendTo[Table[{Graphics[{Text[ Which[i == 1, Subscript[P, 0], i == Length[d0], Subscript[P, f], True, ToString[i - 1]], Offset[{0, 10}, d0[[i]]]]}], Graphics[{PointSize[Large], Which[i == 1, Red], Which[i == Length[d0] - 1, {Point[d0[[i]]], Blue, Point[d0[[i + 1]]]}, True, Point[d0[[i]]]]}], Graphics[{Arrow[d0[[i ;; i + ...


4

Use a Graph with directed edges labels = Thread[ Range[12] -> (Placed[#, Above] & /@ Join[{Subscript[x, 0]}, Range[10], {Subscript[x, f]}])]; Graph[# \[DirectedEdge] # + 1 & /@ Range[11], VertexCoordinates -> d0, VertexLabels -> labels, VertexStyle -> {1 -> Red, 12 -> Blue}] Or, if you need to have it look like the ...


2

Cases[fplot, RGBColor[x_, y_, z_] :> {x, y, z}, Infinity] {{0.368417, 0.506779, 0.709798}, {0.880722, 0.611041, 0.142051}, {0.560181, 0.691569, 0.194885}, {0.922526, 0.385626, 0.209179}}


7

The following is a universal solution which extracts RGB color values assigned to the Line primitives of a plot generated by built-in plotting functions of Mathematica 10: Cases[fplot, {___, c_Directive, __Line} :> ColorConvert[c, RGBColor], Infinity] // InputForm {RGBColor[0.368417, 0.506779, 0.709798, 1.], RGBColor[0.880722, 0.611041, 0.142051, ...


5

Here's a possibility. Copy the graphic into a new cell, type p1 = in front of the plot and evaluate the cell. Then, do p1 /. Point[a__] :> {PointSize[0.2], Point[a]} Here's a gif showing the procedure:


3

ContourPlot3D[ {x^2 + y^2 == 1, z == Sqrt[x^2 + y^2]}, {x, -2, 2}, {y, -2, 2}, {z, -.5, 2}, ContourStyle -> Opacity[.65]]


1

Here are two code samples to get you started. Both snippets achieve the same result: Plot3D[Sqrt[x^2 + y^2], {x, y} ∈ Disk[{0, 0}, 4]] or alternatively Plot3D[ Sqrt[x^2 + y^2], {x, -4, 4}, {y, -4, 4}, RegionFunction -> Function[{x, y, z}, x^2 + y^2 <= 4^2] ] Either one generates the following: A different, possibly easier approach, ...


2

You can use make a spiral separately and combine with Show. Show[Plot3D[4 x^2 + y^2, {x, -70, 70}, {y, -70, 70}, Mesh -> None], ParametricPlot3D[{u/2 Cos[u], u Sin[u], u^2}, {u, 0, 40 Pi}, PlotStyle -> Thick]] L = 70; Export["par.gif", Table[ Show[Plot3D[ x^2 + y^2, {x, -L, L}, {y, -L, L}, Mesh -> None, BoxRatios -> {1, 1, .5}, ...


3

Perhaps this is helpful or can be adapted. Using the data from OP. Note the "normal distribution" has been scaled for effect (not quantitative): d = {data1, data2, data3}; style = {Red, Green, Blue}; lab = {"data1", "data2", "data3"}; dc = DistributionChart[Join[Table[Null, {3}], d], ChartStyle -> style]; bw = BoxWhiskerChart[d, ChartStyle -> style]; ...


9

This is very similar to Quantum_Oli's answer, but I will post it anyway. It use's a modified version of Jens's plotGrid function to do the work of combining the plots. The function is imported from a pastebin to save space here, << "http://pastebin.com/raw/tmMYLyMh"; hist = Show[ Plot[140 PDF[SmoothKernelDistribution[#], x] & /@ {data1, ...


7

It is indeed possible, although not necessarily straightforward. The method I present below gives a pretty robust and accurate way of lining up plots, the downside is a little bit of code and having to specify a few different options. I'm used to it, it works. The key is that by specifying the ImageSize, and the Left and Right components of the ImagePadding ...


2

I am posting the answer based on taking the phrase "the example is without importance" on face value (i.e. not a homework or similar). I am not exactly I understand the aim. So, with these caveats and to motivate clarification: f[a_, b_, x_, y_] := {a, b}.{x^2, y^2} /; a + b > 0 f[a_, b_, x_, y_] := Null Manipulate[ Column[{ Row[{"a+b= ", a + b}, ...


4

If you look at the FullForm of your variable result you will see that it contains some small complex numbers. You can remove these by using Plot[Abs[result[[i]]] instead.


2

I reported this to WRI tech support. This is what I sent them I have encountered an issue when evaluating an example given in ref/ImplicitRegion. The example before I evaluated its code showed a circle. Evaluation should have redrawn the circle, but it actually produced a blank plot. I enclose a screen capture to illustrate the problem. screen capture ...


2

If you just want to make a plot of the region in question, this is good RevolutionPlot3D[{{x, (x + 8)^4}, {x, 8 x + 64}}, {x, -8, -6}, {th, 0, 2 π}, Mesh -> None, Axes -> False, Boxed -> False, BoxRatios -> {1, 1, .3}] But try as I might, I can't seem to find a way to get the volume of the region using Volume - this would involve ...


2

Here's a symbolic-algebraic way, based on the cylindrical algebraic decomposition (CAD) that Reduce computes. (* Disk/Washer method *) Clear[x, y, z]; eqns = {y == (x - 2)^4, 8 x - y == 16}; axis = x == 10; {depV} = Variables[Subtract @@ axis]; {indepV} = Complement[{x, y}, {depV}]; vars = {indepV, depV}; components = Map[ Reduce[#, vars] &, (* ...


3

If your plot doesn't show anything, it's often helpful to look what your plotted function does. If you evaluate e.g. f[1] in your notebook, you'll see: -1 + ln[1] That's because there is no build-in function called ln. You probably want Log.


2

Changed h = N[(t[n] - t[0])/n, 2]; to h = (t[n] - t[0])/n; Changed Piecewise[...] to Simplify@Piecewise[...], and Used t /@ Range[0, n] as horizontal axis ticks: With these changes: Plot[Evaluate[A[#][t] & /@ Range[0, n]], {t, 0, 1}, PlotRange -> {0, 1}, PlotLegends -> "Expressions", Ticks -> {t /@ Range[0, n], Automatic}] ...


2

Have a look at AxesOrigin and FindDivisions Plot[Evaluate[A[#][t] & /@ Range[0, n]] , {t, 0, 1} , PlotRange -> {{-.25, 1.22}, {-.25, 1.25}} , AxesOrigin -> {-.25, -.25} , Ticks -> {FindDivisions[{0, 1}, 4], Automatic} , PlotLegends -> "Expressions"]


2

As someone else here mentioned there are no Log and LogLog versions of RegionPlot, so you can make them yourself. The answer above relies on the user being able to apply the Log function to the input in the correct fashion, but it isn't always obvious which arguments or variables should be given the Log function in the argument, and which should have their ...


4

There is no LogRegionPlot or LogLogRegionPlot, so if you want to make one you'll have to do the scaling yourself, and then supply the correct tick marks yourself using the undocumented (and sometimes poorly behaved) Charting`ScaledTicks function: {RegionPlot[Exp[Abs[x]] <= y <= 100, {x, -6, 6}, {y, 0, 120}], RegionPlot[ Log@Exp[Abs[x]] <= y ...


2

I think it may be more expedient to use Framed to generate the frame you want, rather than having an extra graphics object: Framed[ Show[ { Graphics[{Red, Thick, Circle[]}], Plot[Sin[x], {x, -2, 5}, PlotStyle -> Directive[Thick, Blue]] }, PlotRange -> {{0, Pi}, {-Pi/2, Pi/2}}, (*REMOVED*) (*PlotRangeClipping -> ...


3

Tweak the plot domain so that it's not symmetric: ContourPlot3D[..., {α1, 0 + 0.1 + 0.0001, 90 - 0.1}, (* slight offset *) {α2, 0 + 0.1, 90 - 0.1}, {ψ, 0.2, 180 - 0.2}, ...]


7

You can do something like this, SetAttributes[verbosePlot, HoldAll] verbosePlot[plotcommand_] := Module[{plot, pp, mr}, {pp, mr} = {PlotPoints, MaxRecursion} /. (Trace[plot = plotcommand, HoldPattern[(MaxRecursion -> _Integer) | (PlotPoints -> _Integer)], TraceInternal -> True] // Flatten // Reverse // ...


0

Just a comment to @kglr with picture.I change his temp2[[1]]=temp1[[1]]to temp2[[2]]=temp1[[2]];temp2[[3]]=Mean@Delete[temp1,2].But this method don't sufficient to guarantee intersection of the curves like plot1 = ParametricPlot[ Evaluate[ l1[t] = BezierFunction[ temp1 = RandomReal[{0, RandomReal[50]}, {3, 2}]][t]], {t, 0, 3}]; plot2 = ...


0

This is what we get playing with the parameters of SmoothHistogram and SmoothKernelDistribution: data = RandomSample[Join[RandomVariate[NormalDistribution[2, 1], 2000], ConstantArray[0, {100}]]]; Histogram[data] SmoothHistogram[data, {"Adaptive", .1, .001}] SmoothHistogram[data, {"Adaptive", .05, .01}] dist = SmoothKernelDistribution[data, ...


2

A simpler and minimal version Manipulate[ Graphics[{Red, Circle[{0, 0}, Cos[Pi/n]], Blue, Circle[{0, 0}, 1], Green, Line[{Cos[2 Pi #/n], Sin[2 Pi #/n]} & /@ Range[0, n]]}], {n, 3, 30, 1}] Inner circle will adjust itself according to the polygon.


6

There are numerous ways to do this in Mathematica, and it's hard to say which would be most useful for learning. Here's one; a unit circle is drawn, then a polygon with no filling and black edge on basis of CirclePoints which generates points of a regular polygon lying on the unit circle. Finally, mean of two first points is taken, and distance to the origin ...


3

One way is to force temp1 and temp2 to share an endpoint: plot1 = ParametricPlot[Evaluate[l1[t] = BezierFunction[ temp1 = RandomReal[{0, RandomReal[50]}, {3, 2}]][t]], {t, 0, 3}]; plot2 = ParametricPlot[Evaluate[l2[t] = BezierFunction[ temp2 = RandomReal[{0, RandomReal[50]}, {3, 2}]; temp2[[1]] = temp1[[1]]; temp2][t]], {t, 0, 3}, ...


1

ClearAll[dt, y] y[s_, d_, f_] := s + f + d; dt = Transpose[{RandomReal[{-1, 1}, 1000], RandomReal[{-.5, .5}, 1000]}]; styleddt = Style[{##}, PointSize[.02], Piecewise[{{Red, -2 <= y[##, .5] <= 0}}, Blue]] & @@@ dt; labels = {"-2<=y[s,d,.5]<=0", " otherwise"}; colors = {Red, Blue}; legend = Row[Style[##, "Panel", 18] & @@@ ...



Top 50 recent answers are included