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

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

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


6

ClearAll[tF] SeedRandom[10] n = 100; sample = Sort[Sin[Pi*RandomVariate[UniformDistribution[{0, 1}], n]]]; dist = EmpiricalDistribution[sample]; Use tF to define a custom ProbabilityDistribution: tF[y_] := 2/Pi*ArcSin[y] tfdist = ProbabilityDistribution[{"CDF", tF[x]}, {x, 0, 1}]; Row[Plot[Evaluate[#[tfdist, x]], {x, 0, 1}, Filling -> Axis, ...


6

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


5

cf[x_, y_, z_] := Plus @@ (({x, y, z} - {1, -4, 3})^2); opts = {ViewPoint -> {5, 5, 5}, Axes -> True, AxesLabel -> {x, y, z}, Ticks -> {Range[-4, 6, 1], Range[-9, 1, 1], Range[-2, 8, 1]}, ImageSize -> 300}; BoundaryStyle Use BoundaryStyle->{{1,2}->Directive[Red, Tube@@#&]} (or BoundaryStyle -> {{1, 2} -> Directive[Red, # ...


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


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

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

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

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

Here are two ways. Using Dashing[None] to turn off dashing. Graphics[{ Dashed, Blue, Line[{{-9, 0}, {12, 0}}], Dashing[None], Line[{{-9, -4}, {12, 4}}]}] Using sub-lists to control the scope of directives. Graphics[{ Blue, {Dashed, Line[{{-9, 0}, {12, 0}}]}, Line[{{-9, -4}, {12, 4}}]}] Both produce


5

With no changes in the first 6 lines of your first code block, pNV = OwnValues[parametersNV] /. RuleDelayed[x_, {y_}] :> HoldForm[y] /. {x_} :> x; framelbl := {{"θ(ζ)", Rotate["", 180 Degree]}, {"ζ", pNV}}; Plot[{d1}, {x, 0, 1}, PlotRange -> All, Axes -> False, Frame -> True, LabelStyle -> Black, FrameLabel -> framelbl, ...


5

Also fixing your code... n=30; TF[y_] = 2/Pi*ArcSin[y]; SeedRandom[10]; sample = Sort[Sin[Pi*RandomVariate[UniformDistribution[{0, 1}], n]]]; d = EmpiricalDistribution[sample]; EF = CDF[d, x]; To get the max. difference, I tried NMaximize and others, but didn't work. The one that worked for me was this: X = NArgMax[{Abs[EF - TF[x]], 0 < x < 1}, x] ...


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

Just using a slightly different approach and using the derived circle and interpreting question as generating a torus from the circle of intersection between sphere and x-z plane: s = ParametricPlot3D[ 5 {Sin[u] Cos[v], Sin[u] Sin[v], Cos[u]} + {1, -4, 3}, {u, 0, Pi}, {v, 0, 2 Pi}, RegionFunction -> Function[{x, y, z, u, v}, y <= 0], Mesh ...


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]


4

The derivative of your function has a discontinuity for $x=1$. theoreticalFunction[x_] := 2/Pi * ArcSin[x] D[theoreticalFunction[x], x] (* Out: 2/(Pi Sqrt[1 - x^2]) *) Plot uses internal methods that try to plot "most" points within the domain given, removing "outliers". This method detects that your derivative rises to infinity for $x=1$ and clips that ...


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

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

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

Perhaps this will be helpful in exploring. At the end of gif I am trying to illustrate you can select, copy and paste the desired option values. pl = ParametricPlot3D[ 5 {Sin[u] Cos[v], Sin[u] Sin[v], Cos[u]} + {1, -4, 3}, {u, 0, Pi}, {v, 0, 2 Pi}, RegionFunction -> Function[{x, y, z}, y <= 0]]; DynamicModule[{vp, va, vv, vc}, {vp, va, vv, ...


3

You need to specify dx as a function of n, or replace dx definition directly in Manipulate. Functional Form of dx Clear[f, a, b, n, dx]; f[x_] := x^2; a = 0; b = 1; dx[n_] := (b - a)/n; Manipulate[ Show[Plot[f[x], {x, a, b}, PlotStyle -> Thick, AxesLabel -> {"x", "y"}], Graphics[{Table[{Opacity[0.05], EdgeForm[Gray], Rectangle[{a + i ...


3

Hat-tip to DrMajorBob for this handy workaround: ContourPlot[ Exp[-x^2 - y^2] , {x, 0, 2}, {y, 0, 2} , PlotRange -> Full , Contours -> 10^Range[-4, 0, 0.1] ] /. {Tooltip[expr_, tooltip_] :> Tooltip[expr, DisplayForm[SuperscriptBox[10, Log[10, tooltip]]] ]} This uses the fact that Tooltip'd expressions have a very ...


3

The solution below seems to work for me from within ContourPlot, using the ContourLabels option: ContourPlot[ Exp[-x^2 - y^2], {x, 0, 2}, {y, 0, 2}, PlotRange -> Full, Contours -> 10^Range[-4, 0, 0.1], ContourLabels -> {None, Tooltip[#3, DisplayForm[SuperscriptBox[10, Log[10, #2]]]] &} ] The key piece of information is the fact that ...



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