Tag Info

Hot answers tagged

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 ...


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 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

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

The OP's (current) definition of ncalc is unreadable and unsalvageable, so I made one up from pieces of the code. ncalc = Piecewise[{ {-21. + 294. u - 1029. u^2, u < 1/7}, {2. v (131.25 - 367.5 u + 257.25 u^2), 5/7 < u < 6/7}, {5.25, u == 6/7}, {33.8811 v^2 , u > 1/7}}, -1380.75 + 3160.5 u - 1800.75 u^2] When you set shared ...


6

This is a comment rather than an answer, but it grew too long for the comment box, and I wanted to show graphics, so I'll leave it here in hopes that someone better versed in the inner workings of MMA might explain this behavior. I am using your definition of the wrapper function pp. First of all, I get a slightly different version of the "wrong" function: ...


5

What about Show[ContourPlot[x^3 + y^3 - 3 x y, {x, -10, 10}, {y, -10, 10}, Contours -> {1, 100}, ContourShading -> False], ContourPlot[(x - 4)^2 + (y - 4)^2, {x, -10, 10}, {y, -10, 10}, Contours -> {4}, ContourShading -> False]]


5

As suggested earlier for the circle, you should use == instead of =. Note the major difference in the meaning between these 2 symbols. = means assignment, i.e., you are defining or setting the LHS to be the RHS. On the other hand == is a logical operator that makes the expression evaluates to True if, and only if the LHS value is the same as the RHS value. ...


5

Your histogram doesn't have regular binning, so you will want to specify how you want the binning done in your question. To get you started, however, here is an idea with regular binning. Otherwise you could adapt the code from your previous question on uneven binning to this problem. SeedRandom[10] sample = RandomVariate[NormalDistribution[], 200]; ...


5

You can also define a function that produces the required bin list: ClearAll[bF] bF[n_] := {Quantile[#, Range[# - 1]/# &[Quotient[Length@#, n]]]} & where we used the fact that the second argument of Quantile can be a List. data = RandomVariate[NormalDistribution[], 200]; Row[Histogram[data, bF[10][data], #, PlotLabel -> Style[#, 16, "Panel"], ...


5

eqns = Table[{y==(1/Sqrt[3])*x+i,y == -(1/Sqrt[3])*x+i}, {i, -3, 3}]; ContourPlot[Evaluate[## & @@@ eqns], {x, -3, 3}, {y, -3, 3}] eqns2 = Table[{ x == i Sqrt[3]/2, y == (1/Sqrt[3])*x + i, y == -(1/Sqrt[3])*x + i}, {i, -7, 7}]; ContourPlot[Evaluate[## & @@@ eqns2], {x, -3, 3}, {y, -3, 3}]


5

eqs = Table[{y == (1/Sqrt[3])*x + i, y == -(1/Sqrt[3])*x + i, x == i*Sqrt[3]/2}, {i, -7, 7}]; ParametricPlot[ Evaluate[{x, y} /. ToRules /@ Flatten[eqs] /. {x -> t, y -> t}], {t, -3, 3}, PlotRange -> 3]


5

To deal with the other aspects: legends, labels. I suggest looking through documentation and trying/playing as colours, and other style elements are highly customizable. f[k_, n_, x_] := 1/(1 + (x/k)^n) r = PowerRange[1, 16, 2]; ex = f[1, #, x] & /@ r; Plot[ex, {x, 0, 4}, PlotLegends -> LineLegend[Automatic, r, LegendLabel -> "n"], Frame -> ...


5

As MarcoB posted before me this has to do with evaluation differences. Simply setting HoldFirst on pp produces the original plot: SetAttributes[pp, HoldFirst] pp[ψ_, options___] := ParametricPlot[{r, ψ}, {r, -1, 1}, options, PlotRange -> {Automatic, 1.05 {-1, 1}}] pp[ZernikeR[100, 0, r]] You will want this attribute anyway as without it the ...


4

Here is another way: histogram := Histogram[ RandomVariate[NormalDistribution[0, 1], 200], Automatic, Function[{bins, counts}, Sow[bins, "bins"]; Sow[counts, "counts"]] ] {g, bins} = Reap[histogram]; Show[ g, Graphics@Line@MapThread[{Mean[#], #2} &, Flatten[bins, 1]] ]


4

Plot seems to only do exclusions automatically for certain functions, such as Piecewise and some functions with branch cuts. For algebraic functions it seems to require an equation be passed to the Exclusions options. I suspect that Plot determines exclusions in the same way as mesh points, by tracking when a zero is crossed. It seems simple enough to ...


4

I use the sine curve to replace your original graph.You can accomplish your graph according to this toy code. Plot[Sin[x], {x, 0, 2 Pi}, Epilog -> {Red, Thick, Line[{{0, 0}, {0, -.2}}], Line[{{Pi, 0}, {Pi, -.2}}], Line[{{2 Pi, 0}, {2 Pi, -.2}}], Black, Arrowheads[{-.04, .04}], Arrow[{{0, -.15}, {Pi, -.15}}], Arrow[{{Pi, -.15}, {2 Pi, ...


4

I misunderstood and commented only about computing the Cesaro means as per the question In s I have all partial sums, but I do not know how to divide them by corresponding n. The desired scatter plot of 500 Monte Carlo attempts with samples of increasing length could be obtained with something like ticks = Range[-0.06, 0.06, 0.02]; s = Table[u = ...


4

In your example plot the Monte-Carlo integral is computed afresh for each new amount of sampling points: s[n_] := Total[Sqrt[1 - #^2] & /@ RandomReal[1, n]]/n Then take one random point, find the mean, take two new random points, find their mean, and so on until 500. The result is: ListPlot[Table[s[n], {n, 500}], PlotRange -> {0.7, 0.9}] The ...


4

One option would be to use RevolutionPlot3D. u = Table[Sin[2 \[Pi]*r], {r, 0, 1, 0.1}]; (*u is a dummy u[r]*) f = ListInterpolation[u, {0, 1}]; (*Create an interpolating function over the range {0,1}*) (*Plot it over the domain.*) RevolutionPlot3D[f[r], {r, #1, #2}] & @@@ f["Domain"] You could also generate the points yourself and use ...


4

You can simply add a background polygon: ListLinePlot[{{{0, 0}, {1, 1}}, {{5, 0}, {6, 1}}}, Prolog -> {LightBlue, Polygon[{{0, 0}, {1, 1}, {6, 1}, {5, 0}}]}] Or you can flip the axes twice using the following modification of Mr.Wizard's axisFlip function: axisFlip[l_List] := Replace[l, {x_?NumericQ, y_?NumericQ} :> {y, x}, {-2}]; ...


4

For this specific example (concentric spheres of radius 1 and 5 with "bite" out of it), perhaps easiest: Quiet@RegionPlot3D[ 1 < x^2 + y^2 + z^2 < 25 && -Pi < ArcTan[y, x] < Pi/2, {x, -6, 6}, {y, -6, 6}, {z, -6, 6}, Mesh -> False, PlotPoints -> 50, Boxed -> False, Axes -> False, Background -> Black]


3

Using version 10. The filling is the intersection of the half-plane to the right of the left line with the half-plane to the left of the right line. RegionPlot[ RegionIntersection[ HalfPlane[{{0, 0}, {1, 1}}, {1, 0}], HalfPlane[{{5, 0}, {6, 1}}, {-1, 0}]], PlotRange -> {{0, 6}, {0, 1}}]


3

Here's way of creating the plot by using regions. r1 = ImplicitRegion[(x - 4)^2 + (y - 4)^2 == 4, {x, y}]; r2[k_] := ImplicitRegion[x^3 + y^3 - 3 x y == k, {x, y}]; RegionPlot[RegionUnion[r1, r2[1], r2[100]]]


3

sample = RandomVariate[NormalDistribution[], 200]; histogramdata = Histogram[sample, {Sort@RandomReal[{-4, 4}, 20]}, "PDF"]; h = Cases[histogramdata, StatusArea[_, x_] :> x, -1]; w = Cases[histogramdata, RectangleBox[{x_, _}, {y_, _} | NCache[{y_, _}, _], __] :> Mean@{x, y}, -1]; Show[histogramdata, ListLinePlot[Transpose[{w, h}]]]


3

Modifying the MapAt+GeometricTransformation approach in this answer in the related Q/A linked by @Mr.Wizard: ClearAll[filledLLP] filledLLP[l_, o : OptionsPattern[{Graphics, ListLinePlot}]] := Graphics[MapAt[GeometricTransformation[#, ReflectionMatrix[{-1, 1}]] &, ListLinePlot[Reverse[l, 3], FilterRules[{o}, Options[ListLinePlot]]], {1}][[1]], ...


3

I did not try terribly hard to follow your description but hopefully this at least gives you a start: f[x_] := 1/(1 + (x/k)^n) expr = Table[f[x], {n, {1, 2, 4, 8, 16}}, {k, {1}}] {{1/(1 + x)}, {1/(1 + x^2)}, {1/(1 + x^4)}, {1/(1 + x^8)}, {1/(1 + x^16)}} Plot[expr, {x, 0, 4}] Notice that I use lower case letters to start all Symbol names; capital ...


3

cf[x_, y_, z_] := Plus @@ (({x, y, z} - {1, -4, 3})^2); BoundaryStyle Use BoundaryStyle->{{1,2}->Directive[Red, Tube@@#&]} to make the boundary between the sphere and the plane rendered as a red tube. cp = ContourPlot3D[{cf[x, y, z]== 25, y == 0}, {x, -4, 6}, {y, -9, 1}, {z, -2, 8}, ContourStyle -> {Directive[Blue, Opacity[0.5]], ...


2

Might you be looking for this? The modifications are in the addition of the zeros table (though it would be much better to write down an analytical expression) and the rule for Epilog acts on it accordingly to generate the points. In my example, though, they are black for a small slope and become brighter red/green for larger negative/positive slopes. You ...


2

Try this PIC1 = VectorPlot[{2 x, -2 y}, {x, -3, 3}, {y, -3, 3}]; PIC2 = ContourPlot[x^2 - y^2, {x, -3, 3}, {y, -3, 3}, ColorFunction -> "DeepSeaColors", PlotLegends -> Automatic]; Show[PIC2, PIC1]



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