Tag Info

New answers tagged

0

DEGREE = 2; x0 = 1; y0 = \[Pi]; f = x^2*Sin[(x*y)/2]; g = Normal@Series[f, {x, x0, DEGREE}, {y, y0, DEGREE}]; $$ g(x,y)=(x-1)^2 \left(\left(\frac{\pi ^2}{64}-\frac{3}{4}\right) (y-\pi )^2-\frac{3}{4} \pi (y-\pi )-\frac{\pi ^2}{8}+1\right)+(x-1) \left(-\frac{1}{2} (y-\pi )^2-\frac{1}{4} \pi (y-\pi )+2\right)-\frac{1}{8} (y-\pi )^2+1 $$ Plot3D[#, ...


2

Manipulate[a = Plot[x, {x, 0, 1}]; b = Plot[1 - z, {z, 0, 1}]; Show[If[cond1 == 1, a, Graphics[]], If[cond2 == 1, b, Graphics[]], Axes -> (cond1+cond2>=1), PlotRange -> {{0, 1}, {0, 1}}, AspectRatio -> 1/GoldenRatio], Grid[{{Control[{{cond1, 1, ""}, {0, 1}}], "a"}, {Control[{{cond2, 1, ""}, {0, 1}}], "b"}}]] Change Axes -> ...


9

Fortunately there is a solution but it appears to be undocumented and takes a bit of guess work. The magic is: FilledCurveBoxOptions -> {Method -> {"SplinePoints" -> (* integer value *)}} This may be set globally or for a Notebook: SetOptions[InputNotebook[], FilledCurveBoxOptions -> {Method -> {"SplinePoints" -> 30}}] (Use $FrontEnd ...


6

For something somewhat different, I've elected to use BSplineCurve[] + FilledCurve[] to render each annular sector: sector[{r1_?NumericQ, r2_?NumericQ}, {θ1_?NumericQ, θ2_?NumericQ}] /; r1 < r2 := Module[{cc = Cos[(θ2 - θ1)/2], p1, p2, pm, sk = {0, 0, 0, 1, 1, 1}, sw}, sw = {1, cc, 1}; p1 = Through[{Cos, Sin}[θ1]]; p2 = ...


4

The edit is the additional graphic. You can dress up the coloring and thickness yourself, here's the modification (the new first graphic entry): a = {9, -5}; u = a/Norm[a]; Graphics[{ Red, Circle[{0, 0}, 1, {0, -Pi/2}], Blue, Arrow[{{0, 0}, a}], Red, Arrow[{{0, 0}, u}], Text[Style["<9, -5>", Blue, Background -> White], {9, -5.4}], Text[Style[ ...


8

I presume you're plotting a Fresnel zone plate. DensityPlot[Sin[50 Sqrt[1 + x^2 + y^2]]^2, {x, -1, 1}, {y, -1, 1}, PlotPoints -> 100, ColorFunction -> GrayLevel, Frame -> None] And if you'd like to overlap two Fresnel plates, just use Manipulate: Manipulate[ DensityPlot[ Sin[50 Sqrt[1 + x^2 + y^2]]^2 + Sin[50 Sqrt[1 + (x + dx)^2 + ...


3

I think a ContourPlot will do nicely here, as you suggested. The coloring can be obtained with the built-in GrayLevel color function. You can choose how dense the contour lines are by either plotting over a larger domain than the unit square, or by changing the coefficients to $x^2$ and $y^2$ within the $\cos$ function. The negative sign is there to ...


1

Needs["Combinatorica`"] a = CompleteGraph[7, 2]; b = DeleteVertices[a, {3, 4}]; The functions you need to delete randomly selected two edges are the built-in function RandomChoice and the Combinatorica functions Edges and DeleteEdges. deletededges = RandomChoice[Edges[b], 2]; c = DeleteEdges[b, deletededges]; Row[{ShowGraph[a, VertexStyle -> ...


5

Prolog You can use Prolog and Inset which avoids rasterizing the GeoGraphics: lena = ExampleData[{"TestImage", "Lena"}]; GeoGraphics[Polygon[Entity["Country", "Canada"]], GeoProjection -> {"Orthographic", "Centering" -> {0, -97}}, Prolog -> Inset[Image[lena, ImageSize -> 500]]] RemoveBackground RemoveBackground works on GeoGraphics; ...


4

Graphics[{PointSize[.04], Point[a = {6, 17}], Point[b = {7, 37}], InfiniteLine[{a, b}]}, Axes -> True, GridLines -> {{a[[1]], b[[1]]}, {a[[2]], b[[2]]}}, PlotRange -> {{0, 10}, {0, 40}}, AxesOrigin -> {0, 0}] From the documentation: InfiniteLine[{Subscript[p, 1],Subscript[p, 2]}] represents the infinite straight line passing ...


4

Scaled and ImageScaled coordinates are extremely useful to study the behaviors of the options for Graphics. I'll try to contribute what I can. What follows, mostly applies to Plot and similar functions. Often Graphics created explicitly with the Graphics head, such as those in Mr.Wizard's answer may behave differently, as compared to Plot. First example: ...


10

Padding Without padding of any kind the over-all aspect ratio and element (primitive) aspect ratio are the same and as specified: g0 = Graphics[{Opacity[0.5, Red], Rectangle[{0, 0}, {3, 2}]}, AspectRatio -> 2/3, Background -> GrayLevel[0.8], PlotRangePadding -> 0] (There is a one pixel discrepancy along the right edge where the background ...


2

As @Mr.Wizard pointed out, multiple interesting solutions to your problem have been proposed on this site. I just wanted to add an observation here. I realize that you did not say so explicitly, but I would think that many users would try some combination of ListPointPlot3D for this kind of task. However, it has been my impression when using the *3D list ...


4

It seems to me that there is little point in making the image size so small that the image cannot possibly have a close to accurate aspect ratio. If I also get rid of the superfluous parts outside of the plot range by setting PlotRangePadding, ImagePadding, and ImageMargins all to zero, I can use simple ImageDimensions to check aspect ratio. Doing all this ...


3

Update: The edge shape function "CurvedArc" has an option "Curvature" that controls the shape of the BezierCurve it produces. Examples: Graph[{1 -> 2, 2 -> 3, 1->3}, VertexCoordinates -> {{0, 0}, {1, 1}, {2, 2}}, VertexLabels -> Placed["Name", Center], VertexSize -> Medium, EdgeShapeFunction -> GraphElementData[{"CurvedArc", ...


5

I do this all the time, but use small buttons next to the slider. This is handy when one wants to jump to specific value, and sometimes it is hard to get the slider to go there exactly without few hits and misses and one ends up opening the slider using "+" and typing in the value in the small window which is not very efficient sometimes. Here is an example ...


2

As per the comment section of the OP I assume that the image padding is a constant number of printer points, though it is not necessarily known. I use the rasterize trick to obtain the size of the plotting range in printer points: printerPointsPlotRange = (#[[2]] - #[[1]] &)@ (Rasterize[Show[#, Epilog -> ...


2

This is far from ideal and it has limitations with extreme triangles. The aesthetically pleasing images prompt me to post despite this. Perhaps others will improve. I modified David G. Stork function. The solid area is reasonable straight forward. The orange spheres delineate triangle: ae[a_, b_, c_] := Developer`PartitionMap[VectorAngle @@ # &, {a, ...


7

May way of thinking so far: According to the Documentation, when the third argument of Inset is Automatic, the inset will have its original size inside of enclosing graphics. Its a good start. The inset has non-zero ImagePadding (needed for the frame ticks), so some additional space must be added inside of the plot range of the enclosing graphics via ...


5

The general idea is the same as bbgodfrey's so most credits for him, the approach is slightly different, perhaps more automatic. We start by converting OP's parametric expression to cartesian: eq = #.# &@{Cos[Θ], Sin[Θ]} /. Solve[ Thread[{x, y} == RotationMatrix[β].{a + c Cos[Θ], b + d Sin[Θ]}], {Cos[Θ], Sin[Θ]} ][[1]] // Simplify ...


2

This appears fixed as of Mathematica 10.1.0, at least on my 32 bit Linux with NVidia Geforce GTX 750 Ti and binary driver 340.46, where the bug does reproduce with Mathematica 10.0.0.


3

I like the existing answers but I cannot resist posting my own formulation. I shall make use of the new-in-10.1 CirclePoints though I shall also provide an alternative without it. First Rules that specify the thickness of each radial line, counterclockwise from 3 o'clock: rls = {"a1" -> {3, 3, 3, 3}, "b1" -> {1, 3, 1, 3}, "c1" -> {1, 1, 3, 3}, ...


9

This problem can be simplified substantially by noting that only the largest ellipses contribute to the boundary of the second figure in the question. So, for instance, Table[ParametricPlot[RotationMatrix[β].{a + 5 Cos[Θ], b + 6 Sin[Θ]}, {Θ, 0, 2 Pi}, PlotRange -> {{-15, 15}, {-15, 15}}], {a, 0, 5, 1}, {b, 1, 6, 1}, {β, 0, Pi, 1}] // Flatten // ...


5

You could define $a_1,a_2$,.. as graphic primitives (Line) and use Translate: a1 = {Thickness[.01], Line[{{{0, 0}, {1, 0}}, {{1/2, -1/2}, {1/2, 1/2}}}]}; a2 = {Line[{{{0, 0}, {1, 0}}, {{1/2, -1/2}, {1/2, 1/2}}}]}; b1 = {Line[{{0, 0}, {1, 0}}], Thickness[.01], Line[{{1/2, -1/2}, {1/2, 1/2}}]}; b2 = {Line[{{1/2, -1/2}, {1/2, 1/2}}], Thickness[.01], Line[{{0, ...


4

One way of doing that is create an image for each element and then use GraphicsGrid With the definition about line of @halmir a1 = {Thickness[.03], Line[{{{0, 0}, {1, 0}}, {{1/2, -1/2}, {1/2, 1/2}}}]}; a2 = {Line[{{{0, 0}, {1, 0}}, {{1/2, -1/2}, {1/2, 1/2}}}]}; b1 = {Line[{{0, 0}, {1, 0}}], Thickness[.03], Line[{{1/2, -1/2}, {1/2, 1/2}}]}; b2 = ...


4

Make points on a sphere: pts = {p1, p2, p3} = Sort[Normalize /@ Table[RandomReal[{-1, 1}], {3}, {3}]]; Then plot a sphere with a region function on the 'positive' side of each of the three planes defined by the origin ({0,0,0}) and successive pairs of points: oneSide = ContourPlot3D[x^2 + y^2 + z^2 == 1, {x, -1, 1}, {y, -1, 1}, {z, -1, 1}, ...


1

myPlot = Plot[x, {x, -3, 2}]; AbsoluteOptions[myPlot, {PlotRange, PlotRangePadding}] {PlotRange -> {{-3., 2.}, {-3., 2.}}, PlotRangePadding -> {{Scaled[0.02], Scaled[0.02]}, {Scaled[0.05], Scaled[0.05]}}}


4

Just for fun. This could made much more concise but I am time poor: Manipulate[ ParametricPlot[{{Cos[t], Sin[t]}, {1, 0} + {t, Sin[t]}, {Cos[t], t}}, {t, 0, 2 Pi}, PlotRange -> {{-1.5, 2 Pi + 1}, {-1.5, 2 Pi}}, Epilog -> {EdgeForm[Black], Yellow, Disk[{Cos[p], Sin[p]}, 0.1], Disk[{p, Sin[p]} + {1, 0}, 0.1], Disk[{Cos[p], p}, 0.1], Black, ...


4

I believe you want DataRange: dat = Table[PDF[BinomialDistribution[50, 0.5], k], {k, 0, 50}]; ListPlot[dat] ListPlot[dat, DataRange -> {-25, 25}]


1

This is not yet a complete answer but I think it may set you on a viable path. We can style each element using StyleBox as follows: boxes = RowBox[{"(", FractionBox[ RowBox[{RowBox[{"(", RowBox[{"a", "+", "b"}], ")"}], SuperscriptBox["c", "d"]}], SqrtBox["e"]], ")"}]; colors = ColorData[54, "ColorList"] boxesNew = Module[{i = 1}, ...


5

to draw dotted lines between the corresponding red points on the circle and their periodic curves First, create graphics objects showing only the axes for the three plots, and translate and scale the second and third ones by appropriate amounts: ax1 = FullGraphics[ParametricPlot[{{Cos[t], Sin[t]}, {-Sin[t], Cos[t]}}, {t, 0, 2 Pi}, PlotRange -> ...


3

Update 2015-05-14 I contacted WRI support and they confirmed that this is a known issue with Export (support case: 3206586). Summary @ChenStatsYu seems to have found an unexplained behavior of the Export function for PDF files that looks like a bug. Detailed results 1) I generated two graphics similar to those in the OP's original question, then ...


0

Plot[{PDF[NormalDistribution[], x], PDF[NormalDistribution[-4, 1], x], PDF[NormalDistribution[2, 1], x]}, {x, -8, 6}, AxesLabel -> {None, None}, Ticks -> {Automatic, None}, Axes -> {True, False}, Background -> None, PlotLegends -> Placed[{"N(0,1)", "N(-4,1)", "N(2,1)"}, {1, .5}]]


2

This is not an answer but rather an extended comment to @kguler to demonstrate Appearance -> "Labeled" with Slider2D in version 10.1 $Version "10.1.0 for Mac OS X x86 (64-bit) (March 24, 2015)" Using @kguler answer Manipulate[ Graphics[{Polygon[{pt1, pt2, pt3}]}, PlotRangeClipping -> False, Frame -> True, PlotRange -> {{0, 10}, ...


4

You can attach multiple controls to a variable: Manipulate[Graphics[{Polygon[{pt1, pt2, pt3}]}, PlotRangeClipping -> False, Frame -> True, PlotRange -> {{0, 10}, {0, 10}}], {{pt1, {0, 0}}}, {{pt2, {0, 1}}}, {{pt3, {1, 1}}}, Row[{Control@{{pt1, {0, 0}}, {0, 0}, {10, 10}, Slider2D}, Control@{{pt2, {0, 1}}, {0, 0}, {10, 10}, Slider2D}, ...


5

Update: Based on OP's update I'd just like one arrow on the end of each axis... the task is simpler than assumed in my original answer: Module[{range = {{0, 100000}, {0, 10^9}}}, Plot[x^2, {x, 0, 100000}, PlotStyle -> {Red, Thick}, ImageSize -> 500, Epilog -> {Arrowheads[.03], Arrow[{Scaled[{0, 0}], Scaled[{1, 0}]}], ...


3

I post this answer just as exploiting some other functions. Barring transcriptional, interpretational and indexing errors: func[s0_, m_, s_, t_, h_] := Module[{d = Sqrt[h], n = t/h, rv, x}, rv = {0}~Join~RandomVariate[NormalDistribution[0, d], n]; x = Accumulate[rv]; MapIndexed[{(#2[[1]] - 1) h, s0 Exp[(m - s^2/2) (#2[[1]] - 1) h + s #1]} &, ...


3

You can do this in very many ways. Probably one of the simplest conceptually could be to wrap your repeating code in a Table with a constant iterator: Table[ Module[ {data}, data = RandomVariate[NormalDistribution[RandomReal[], RandomReal[]], 100]; Histogram[data] ], {6} ] Alternatively, you could use control structures instructions ...


1

Instead of grouping the cells, you can simply close the input cell via the menu Cell > Cell Properties > Open (if you are generating the whole notebook programmatically, I believe you can use CellOpen -> False). The closed cell is indicated by the small cell bracket on top.


3

Yes, I think you can, using the PlotMarkers -> {graphic, size} option to the plotting functions. See the documentation for PlotMarkers here for the details. For instance, let's generate a colored pentagon, export it as an EPS file, and re-import it from that file: Export["pentagon.eps", Graphics[{EdgeForm[{Thickness[0.05], Darker@Green}], ...


4

As it is pointed out in my old answer here, graphics and text are displayed inside of the FrontEnd in the style environment defined by the ScreenStyleEvironment option while are Exported into "PDF" in the style environment defined by the PrintingStyleEnvironment option: Options[$FrontEnd, {ScreenStyleEnvironment, PrintingStyleEnvironment}] ...


0

http://demonstrations.wolfram.com/RestrictedThreeBodyProblem/ http://demonstrations.wolfram.com/RestrictedThreeBodyProblemIn3D/ are also related to this question.


1

If you absolutely, positively insist on using RegionPlot, then it's still possible to do with the curve you mentioned. This is because it's actually possible for your curve to be written as $v_1(k_2)$, albeit in a pretty ugly form. Start by inverting your relation between $s_1$ and $k_2$: s1solns = Solve[(k3*((n - 1)*(s1/k1)^n - 1))/(1 + (s1/k1)^n)^2 == ...


9

Probably this match your plot: ParametricPlot[{r {r k2, v1}}, {s1, 0.0, 50}, {r, 0, 1}, PlotRange -> {{0, 0.3}, {0, 1.5}}, AspectRatio -> 0.5, BoundaryStyle -> Directive[Black, Thick], Mesh -> 100, MeshFunctions -> (50 #1 - #2 &)]


7

To fill with a solid color, you can post-process the Line primitive into a Polygon ParametricPlot[{k2, v1}, {s1, 0.0, 50}, PlotRange -> {{0, 0.3}, {0, 1.5}}, AspectRatio -> 0.5, PlotStyle -> Black] /. Line[x_] :> {Blue, Polygon[x]} Update: Using the approach in this answer mentioned in Alexey's comment: poly = Cases[pp, Line[x_] :> ...


6

In your case, you have some arrows that are all drawn in the same style. This allows you to put all of them into a single Arrow command. For several differently colored arrows you would then have groups of Arrow commands for each different style: Manipulate[ Graphics[{Black, Thick, Circle[{-x, 0}, r], PointSize[.03], Point[{0, 0}], Red, ...


0

Graphics[{Arrow[{{x1,y1},{x2,y2}}], Arrow[{{x3,y3},{x4,y4}}]] For example: Graphics[{{Red, Arrow[{{0, 0}, {1, 3}}]}, {Green, Arrow[{{2, 6}, {4, 3}}]}}]


1

Example: Plot[{Sin[x], Cos[x]}, {x, -3, 3}, PlotLegends -> "Expressions", PlotLabel -> "This is my plot"] Then from the Edit pulldown menu: Edit > CopyAs > PDF Then paste into your Word document.


4

Here's an approach using ParametricPlot3D, in which spheres are plotted and then sliced off using the option RegionFunction. It's not clear to me how you intend to have the inner regions "blank" as they are occluded, but the options to Show let you vary the appearance. outerSphere[sphereCenter_: {0, 0, 0}, regionLimit_: 0.6, color_, opacity_] := Module[ ...


7

Here is an alternative to RegionPlot that potentially produces higher quality: it's based on Tube with varying radius, as I also used in this answer: With[ {a = 1, R = .7, n = 40, xMax = 1.5}, Manipulate[ Graphics3D[ GeometricTransformation[ {CapForm[None], {Opacity[.5], Pink, #, Cyan, GeometricTransformation[#, {{-1, 0, 0}, ...



Top 50 recent answers are included