Tag Info

New answers tagged

3

Response from support@wolfram.com: Thanks for contacting Wolfram Technical Support and for taking the time to send in the report. This is indeed a wrong behaviour of HighlightImage, specifically for how it deals with regions. I've filed an incidence report and I will keep you posted for any updates on this issue. Thanks again for bringing the issue ...


4

DiscretizeRegion will work in place of ToElementMesh: Jet0[pts_: {{1, 0}, {1.8, 1.8}, {0, 2}}] := Module[{xu, yu, n, m, knots, fx, fy, pr, t, r}, {xu, yu} = Transpose[pts]; n = 2; m = Length[pts]; knots = {ConstantArray[0, n + 1], Range[m - n - 1]/(m - n), ConstantArray[1, n + 1]} // Flatten; fx[t_] = xu.Table[BSplineBasis[{n, knots}, i - 1, ...


5

There is a workaround involving Rationalize. Jet0[pts0_: {{1, 0}, {1.8, 1.8}, {0, 2}}] := Module[{xu, yu, n, m, knots, fx, fy, pr, mesh, t, r}, pts=Rationalize[pts0,0.001]; {xu, yu} = Transpose[pts]; n = 2; m = Length[pts]; knots = {ConstantArray[0, n + 1], Range[m - n - 1]/(m - n), ConstantArray[1, n + 1]} // Flatten; fx[t_] = ...


5

You could also do: g[z_] := ParametricPlot3D[{{2 Cos[t] + Cos[z t], 2 Sin[t] - Sin[z t], z}, {3 Cos[t], 3 Sin[t], z}, {Cos[t], Sin[t], z}}, {t, 0, 2 Pi}, PlotStyle -> {{Thick, Hue[z/5]}, Black, Black}]; then, plt = Show[Table[g@z, {z, 2, 5}], PlotRange -> All] You can rescale as desired wrt box ratios or z. The following is a ...


6

One way to do this is to covert the 2D graphics primitives to an equivalent 3D primitive using a set of rules. It's not so simple as tacking on the z-coordinate to every list of two numbers. Sometimes your list of two numbers might not be a 2D point. So these rules must specifically target the bits which we know are coordinates. As a start we can transform ...


6

I'm not quite yet willing to reveal how I did the fancy woven 籠目 torus in my comment, but I will at least reveal how to make a GraphicsComplex[] object for this lattice. (I in fact asked this question as I needed the function in the course of building Archimedean lattices.) multisegment[lst_List, scts_List] := Block[{acc}, acc = ...


7

Just for fun: c[p_, m_, n_, v_] := Join @@ CoordinateBoundingBoxArray[{p, p + {m, n} v}, v] tile[m_, n_] := With[{pts = CirclePoints[{##}, 1, 6] & @@@ Join @@ (c[#, m, n, {2, 2 Sqrt[3]}] & /@ {{0, 0}, {1, Sqrt[3]}})}, Graphics[{EdgeForm[Black], FaceForm[White], Polygon /@ pts, PointSize[0.01], Point /@ pts}, ImageSize -> ...


5

As can be seen from the images presented, the interpolation being done under the hood by VertexColors depends on a prior triangulation of the polygon, thus resulting in visible triangular bands. The approaches presented thus far have all needed to perform a preliminary triangulation; I shall now present a method that avoids this preprocessing step. One ...


13

unitcell[i_, j_] := Translate[ {Line[{{1/2, Sqrt[3]/2}, {0, 0}, {1, 0}}], Line[{{1/4, Sqrt[3]/4}, {1/2, 0}}], Line[{{1, Sqrt[3]/2}, {5/4, Sqrt[3]/4}}], PointSize[Large], Point[{{0, 0}, {1/4, Sqrt[3]/4}, {1/2, 0}}]}, {i + j/2, Sqrt[3]/2 j}] Graphics[Array[unitcell, {5, 5}]]


2

You don't need to write code to find cycles. There is a built-in function for that (FindCycle) Besides, using pattern matching for this goal as you did is bound to be rather slow. For visualization of the cycles you can use HighlightGraph. g = Graph[Rule @@@ a, VertexLabels -> "Name"] cycles = FindCycle[g, Infinity, 99999] Manipulate[ ...


1

It looks like setting Compatibility: Acrobat 4 (PDF 1.3) in the Save Adobe PDF dialog in Illustrator solves the issue (checked with Illustrator 17): In the resulting PDF file the transparency is flattened without rasterization (here "Untitled-1.pdf" is PDF file generated by Illustrator from blank document where the Exported file "pl.pdf" was Placed): (* ...


5

On OS X, a simple workaround is to re-save the Mathematica-exported PDF with Preview.app before placing it. Simply open it in Preview and press ⌘-S. I did try processing the PDF through several other programs, but Preview was the only one that worked with all files I tried without destroying them. Some others worked only with PDFs containing no ...


3

For version 10.x the answer can be found in the documentation: ListPlot[Table[Accumulate@RandomReal[1, 10] + i, {i, 2}], PlotMarkers -> {{"\[FilledCircle]", 20}, {"\[FilledSquare]", 10}}, Joined -> True, PlotLegends -> {"line1", "line2"}] This should work for graphics objects like the OP used too.


5

In 10.x, the simplest thing is to specify the PlotMarkers directly, but as noted, the legends ignore ImageSize if specified within the graphic. The correct way to do this is to use the {{g1, s1}, {g2, s2} ...} form of PlotMarkers, e.g. ListPlot[Table[Accumulate@RandomReal[1, 10] + i, {i, 2}], PlotMarkers -> {{Graphics[{Disk[]}], 1/4}, ...


12

shape = CountryData["Ethiopia", "Shape"]; mask = ColorNegate@Binarize[shape, .99]; data = EntityValue[CountryData[], {"Name", "Population"}]; wc = WordCloud[data, mask, WordOrientation -> "Random", Frame -> False]; shapeRange = PlotRange /. AbsoluteOptions[shape, PlotRange]; cloudRange = PlotRange /. AbsoluteOptions[wc, PlotRange]; tr = ...


1

PlotStyle is your Friend. plt = Plot[{Cos[x], Sin[x]}, {x, 0, 2} , PlotStyle -> {{Red, Thick}, {Blue, Thick}}]; plt2 = ListPlot[{{1, 1}, {0.5, 0.5}}, PlotStyle -> Red]; plt3 = ListPlot[{{0.4, 1}, {0.2, 0.5}}, PlotStyle -> Blue]; Show[plt, plt2, plt3]


5

If what you want is a nice smooth surface of the outer boundary, then in Mathematica 10.2 you can do the following: data3D = RandomReal[{0, 1}, {100, 3}]; (* generate some random point *) cvx = ConvexHullMesh[data3D] (* get the outer boundary *) Now we can Discretize the surface and smooth it in one go: smooth = DiscretizeRegion[cvx, ...


10

Such a filling is possible with ParametricPlot. ParametricPlot[{x, x (Sin[x] + o)}, {x, 0, 4 Pi}, {o, -0.5, .5}, ColorFunction -> (ColorData["Rainbow"][#4] &), AspectRatio -> 1/GoldenRatio, Frame -> False, Axes -> False, BoundaryStyle -> None]


7

No crash with version 10.2 on Win7 x64 but there definitely is a bug: Here is how the graph is displayed in the FrontEnd: Show[Plot[x, {x, 0, 1}], Graphics[{Rotate[Text[Style["test", 60], {.5, .5}], \[Pi]/4]}]] And here is how the Exported PDF is rendered by Acrobat 11.0.12 (other PDF viewers show the same):


4

On my system (OS X 10.10.4) it doesn't even display correctly on-screen. This means that rasterization doesn't help. I can confirm the problem in 10.0.2, 10.1.0 and 10.2.0. The problem doesn't exist in 9.0.1. We can trace back this problem to a BezierCurve bug. gr = Show@Graph[{1 <-> 1, 1 <-> 2}, EdgeShapeFunction -> "Line", ...


1

I decided to modify undistortedGraphicsColumn from LLlAMnYP's post to work for my purposes and extend it to an undistortedGraphicsGrid. Because I am particularly interested in aligning the plot region frames carefully, I have changed the names to alignedGraphicsColumn and alignedGraphicsGrid Caveats, up front: alignedGraphicsColumn is a straight-forward ...


5

Graphics (and Graphics3D) accept graphics primitives as input. Version 10 introduced a number of special (or basic) geometric regions which serve as both regions and graphics primitives, so they can be given directly to Graphics (at least the 2D and 3D cases), for example Graphics[Disk[]]. When it comes to derived regions, sometimes they directly correspond ...


4

As ilian pointed out in a comment, you are not limited to DiscretizeRegion for visualizing a region. There is also RegionPlot, which may be more to your liking. Comapare r = RegionUnion[Disk[{0, 0}, 1], Disk[{2, 0}, 1]]; DiscretizeRegion[r] with RegionPlot[r, AspectRatio -> Automatic]


2

To be honest, I was quite surprised that Mathematica finds an analytical solution when you just enter the problem in naively: Area[RegionIntersection[Disk[{l, 0}, l], Disk[{0, l}, l], Disk[{l/2, l/2}, l/2]]] On Mathematica 10.1 I don't get the expression with complex terms that Fernando got above, I get the purely real ConditionalExpression[-(1/4) ...


4

In version 10, we can bypass exporting to PDF and re-importing and can outline text directly using region discretization functions. This is shown in the documentation of BoundaryDiscretizeGraphics. reg = BoundaryDiscretizeGraphics[Text[Style["R", FontFamily -> "Cambria"]], _Text] The region can then be converted back to graphics, and the FilledCurve ...


3

The options (including internal defaults) for Plot etc. override the options set for Graphics. For example: SetOptions[Graphics, ImageSize -> Tiny]; Plot[Sinc[x], {x, 0, 5}] If you wish to use the Graphics setting try Inherited: Plot[Sinc[x], {x, 0, 5}, ImageSize -> Inherited] I want to set ImageSize->Tiny once, somewhere ... If ...


1

As noted in the comments only the first Epilog option will be used by Show. You could instead use a function that combines Prologs and Epilogs manually, if that is desired. myShow[gr__] := Show[gr, Join @@ Map[Options[#, {Prolog, Epilog}] &, {gr}] // Merge[List] // Normal ] Example: g1 = Plot[Style[2 Sin[x], Green], {x, -4, 4}, Epilog -> ...


3

I couldn't get your code to show anything as posted. After quite a bit of debugging I came up with this: m1 = 1; m2 = 1; lc1 = 1; lc2 = 1; l1 = 2; l2 = 2; Ix2 = 1; Iy2 = 1; Iz1 = 1; Iz2 = 1; m11[t_] := m1*(lc1)^2 + m2*(l1 + lc2*Cos[θ2[t]])^2 + Ix2*(Sin[θ2[t]])^2 + Iy2*(Cos[θ2[t]])^2 + Iz1; m22[t_] := m2*(lc2)^2 + Iz2; V11[t_] := 0; V12[t_] := ...


2

I think there is a problem with your fit expression: you have the argument of Sum wrapped in a list {}, which makes for an awkward output format. I don't see any reason for that. I modified your fit function to remove that extraneous list and I'll use the modified version here (see it at the end of the post). I then imported your data and saved it into a ...


2

pts = Table[{t, Sin[t]}, {t, 0, 2 \[Pi], \[Pi]/4}]; Graphics[{Arrow[BSplineCurve[pts]]}] For you then: z = 0.09; c = Table[{0.03 Sin[20 \[Phi]], \[Phi], 0.05}, {\[Phi], 0.8, 1.1, 0.01}]; d = RotationMatrix[\[Theta], {0, 0, 1}]; e = Graphics3D[{Arrowheads[0], Red, Arrow[BSplineCurve[ Table[c.d, {\[Theta], 0, 2 \[Pi], \[Pi]/15}]]]}]; a = ...


0

Many thanks for your replies, which helped me a lot. I finally ended up with the following: a = Graphics3D[{Opacity[.8], EdgeForm[], Cyan, Cylinder[{{0, 0, 0}, {0, 0, 0.1}}, 0.8]}, Boxed -> False, ImageSize -> Large, ViewPoint -> Above]; b = Graphics3D[{Red, Arrow /@ Table[{0.8 {Cos[\[Theta]], Sin[\[Theta]], 0}, { Cos[\[Theta]], ...


4

Click on your figure. Then a set of graphics tools will appear beneath your figure. Use the Coordinates Tool. One by one, click on the corners of the region you seek. Then use the window below to Copy Coordinates. Here the ones I get for the front W face of your figure: {{72.5`, 507.5`}, {70.5`, 158.5`}, {135.5`, 140.5`}, {136.5`, 484.5`}, {209.5`, ...


1

Using the parametric equation and calculating the normal as the cross product of the partial derivatives: f[u_, v_] := {3 a Cos[u] Sin[v], 2 a Sin[u] Sin[v], 4 c Cos[v]} normal[u_, v_] := Evaluate[Normalize@Cross[D[f[x, y], x], D[f[x, y], y]]] /. {x -> u, y -> v} Block[{a = 5, c = 1}, ...


3

a = Graphics3D[Ellipsoid[{0, 0, 0}, {3, 1, 2}]] b = Graphics3D[ Arrow /@ Table[{{2 Cos[θ], Sin[θ], 0}, 2 {2 Cos[θ], Sin[θ], 0}}, {θ, 0, 2 π, π/10}]] Show[a, b] It is unclear whether you'd prefer this: a = Graphics3D[Ellipsoid[{0, 0, 0}, {3, 1, 2}]]; b = Graphics3D[ Table[Arrow[{{3.05 Cos[\[Theta]], Sin[\[Theta]], ...


2

Unsure if I understand your question, but I'll try an answer. You can extract data like so an store them in a variable; data = Table[ x + y Sin[x y], {x, Range[0, 12, 0.1]}, {y, Range[0, 12, 0.1]}] A plot of the data shows us that we are not deviated, please note that I have, for obvious reasons a small increment of 0.1 selected; ...


2

Maybe you can use something like this: points = {{0, 0}, {1/2, 1/2}, {1, 0}, {1, 1}, {-1, 2}, {1, 2}, {0, 1}}; Graphics[JoinedCurve[Line[points], CurveClosed -> True]] Here the list points has 7 elements, and the Graphics contains seven lines connecting these points in the order given. The seventh line is the one that closes the curve by going from ...


6

For example SeedRandom[Exp[I Pi]]; pts = RandomReal[{0, 1}, {7, 2}]; Framed@Graphics@Polygon@pts[[Last@FindShortestTour@pts]] For a star: s = Transpose@Through[{Re, Im}[E^(2 I Pi Range@7/7)]]; Graphics@Line@Join[s, s, s, s][[1 ;; -1 ;; 3]] ss@n_ := Transpose@Through[{Re, Im}[E^(2 I Pi Range@n/n)]]; star@n_ := ...


1

Here's a somewhat different approach: With[{s = 101, (* resolution *) w = 2 (* thickness *)}, Block[{h = (s + 1)/2}, rules = {a1 -> Image[SparseArray[{{j_, k_} /; h - w <= j <= h + w || h - w <= k <= h + w :> 0}, {s, s}, 1]], a2 -> Image[SparseArray[{{j_, k_} ...


2

You need to "convert" your GeoGraphics object to a Graphics object for Show to deal with it. You can do so by Applying (@@) the Graphics head to the GeoGraphics object. I can't use your parametric plot because it is missing definitions, so the following will serve as an example of combining objects of various provenance: c = Graphics @@ ...


4

Taking the request for post-processing at face value we might do something like: intr = RegionIntersection @@ DiscretizeGraphics /@ {def, ghi} poly = Cases[Normal @ Region`MeshRegionToGraphics @ intr, _Polygon, -1]; Show[abc, Graphics[{White, poly}]]


3

I hope that I am understanding your goal correctly. I would suggest using a single compound condition in RegionPlot, rathen than trying to combine graphics afterwards: RegionPlot[ Not[-(a - 1.5)^2 + 1 < b && -(6*a - 3)^2 + 0.75 < b], {a, 0, 1}, {b, 0, 1}, PlotRange -> {0, 1}, PlotRangePadding -> None, AspectRatio -> 1, Frame -> ...


5

RegionPlot[Not[1 -(a - 3/2)^2 < b && 3/4 -(6 a - 3)^2 < b], {a, 0, 1}, {b, 0, 1}, PlotStyle -> None, BoundaryStyle -> None, Mesh -> 30, MeshFunctions -> {-#1 - #2 &}, MeshStyle -> GrayLevel[3/4]]


4

What you could do is download and install the STIX fonts by following the instructions here. These fonts are (if I'm not mistaken) also used by MathJAX, the engine that renders $\LaTeX$ code on this web site. Then, in Mathematica, do something like this: baseStyle = {FontFamily -> "STIXGeneral", 12, ScriptSizeMultipliers -> .66, ...


5

Use Labeled, which can be used to label almost anything, instead of Show. data = RandomReal[{0, 1}, {10, 10}]; Labeled[GraphicsRow[ Table[MatrixPlot[data, AspectRatio -> Full, PlotLabel -> i, FrameTicks -> Automatic, ColorFunction -> (GrayLevel[1 - #] &), ColorFunctionScaling -> False], {i, 3}],ImageSize -> ...


3

As @belisarius suggests: Plot[{15 - x, x, -7 + Sin[x]}, {x, 0, 10}, PlotRange -> {{-.5, 10}, Automatic}, AxesOrigin -> {0, 0}, TicksStyle -> {Automatic, White}, AxesStyle -> {Automatic, White}, ImageSize -> 700, Epilog -> {Rotate[Text[Style[ "Velocity component \!\(\*SubscriptBox[\(v\), \(z\)]\) of \ atoms", 18], {-0.2, 7}], ...


0

With the solution above suggested by David G. Stork, I made this complete (?) working solution. I'm now wondering if it could be improved in some way. Currently, it's a bit slow. SeedRandom[]; f := {RandomReal[{0, 10}, 2], RandomReal[{0.5, 3}]} l = {f}; While[Length@l < 10, While[k = f; Not[And @@ ((# + k)[[2]] < EuclideanDistance[#[[1]], ...


3

Edit: Thanks to MarcoB, here's the solution (this increases the size of the x axis label): Plot[x^2 + 4 x, {x, -7, 6}, ImageSize -> 600, AxesStyle -> Arrowheads[{0, 0.03}], Epilog -> { Inset[Style["x axis", FontSize -> 25], Scaled[{0.5, 0.15}]], Inset["y axis", Scaled[{0.5, 0.95}]]}, PlotStyle -> {Thickness[0.007]}, LabelStyle -> ...


7

You can use your Disk (or any grayscale image) as an alpha channel: img = ExampleData[{"TestImage", "F16"}]; disk = Graphics[Disk[]]; diskImg = ColorConvert[Rasterize[disk, ImageSize -> ImageDimensions[img]], "Grayscale"]; circleImg = ColorCombine[{img, ColorNegate@diskImg}, "RGB"] Then you can use Inset to place it like other graphics ...


2

This is not really anywhere near a reasonable answer but perhaps it will motivate better answers. I have upvoted the Texture approach by use of polygons. img = (* pick your desired graphics*) g = Graphics[{}, ImageSize -> {400, 400}, Background -> Black]; Manipulate[ Row[{ic = ImageCompose[g, img, Scaled[{x, y}]], ia = ImageAdd[ic, msk = ...


9

Disk is less convenient. You can define your own disk as a polygonial approximation (here with a default value of a 50-points polygon): myDisk[n_: 50] := Module[{ps}, ps = Table[{Cos[t], Sin[t]}, {t, Range[0, 2 \[Pi], 2 \[Pi]/n]}]; Polygon[ps, VertexTextureCoordinates -> Rescale[ps]] ]; Edit -- changed the picture Then everything works: ...



Top 50 recent answers are included