New answers tagged graphics
2
so following my comment you can do this..
dz = .01; i3d =
Image3D[Table[
Image[Rasterize[
Graphics3D[Cylinder[{{0, 0, 0}, {1, 2, 0}}, 1], Boxed -> False,
ViewPoint -> {0, 0, Infinity},
PlotRange -> {All, All, {z - dz, z + dz}}]] ] , {z, -1, 1, dz}]];
ImageData[i3d][[100, 100, 100]]
The problem as QuadraticU noted is your 3D "objects" ...
1
Using the ImageSize and ImageResolution options can be a bit tricky sometimes, but this will usually work:
g = Plot[Sin[x], {x, 0, 10}]
cm = 72/2.54 (* centimetre *)
Export["figure.tiff", Show[g, ImageSize -> 10 cm], ImageResolution -> 300]
This will export an image 10 cm wide with 300 dpi resolution.
The important point was to use ImageSize ...
9
This now has been discussed in Wolfram blog post by Michael Trott:
Making Formulas… for Everything—From Pi to the Pink Panther to Sir Isaac Newton
Here is one of the example apps from blog - go read it in full - fun! Don't miss the link to download the notebook with complete code and apps at the end of the blog.
6
What about this:
Import["ExampleData/wrench.obj.gz", "PolygonObjects"] // Graphics3D
You can use the FaceForm[None] trick as shown by @J.M. here just as well if you only want the wireframe looks.
7
At OP's behest:
The easiest approach to see the mesh lines is to remove the EdgeForm[] instruction that causes them not to appear. For instance,
DeleteCases[Import["ExampleData/wrench.obj.gz"], _EdgeForm, ∞]
As SEngstrom suggests, you can also use a replacement rule. If, for instance, you want a thick gray mesh, here's what you can do:
...
3
As noted by xslittlegrass you can get coincident vertices by instructing Graphics3D not to use padding of the plot range, by using PlotRangePadding -> 0.
AspectRatio controls the two dimensional image aspect ratio rather the proportions of the three dimensional rendering which is what I expect you intended; for that use BoxRatios.
Specifying Boxed -> ...
5
The comment is right, but here is a thought. If you'd like a cube you should use Cuboid and leave the 3D box for the role it plays - to put things in a better 3D perspective (if needed). Then you precisely control all coordinates. You could try something like
Graphics3D[{
{Red, Opacity[.7], Polygon[{{1, 0, 0}, {0, 1, 0}, {0, 0, 1}}]},
{Opacity[.2], ...
3
You could use RotationAction -> "Clip". You will find that this also drastically improves interactive rotation performance on complex graphics. It often produces a lot of extra white space around the plot, but that can be controlled with ViewAngle if necessary. ViewAngle by itself will also fix the viewpoint which has the same effect, so you may use ...
1
Here is a trivial text recognizer based on the input samples you've given, it might act as a template for a more customized solution for you.
It may be that you want a more generic solution, in which case you can increase the number of training templates, or abstract a generalized model of the characters that you are interested in.
(* Import example ...
6
You must add the option PlotRangeClipping -> True
Show[...,PlotRangeClipping -> True]
Explanation of your results :
Show[gr1,gr2 ...] take the options of the first graphic in the list, gr1 here.
Concerning the scatterplot, Graphics[] has by default PlotRangeClipping -> False
Concerning the line, Plot[] has by default PlotRangeClipping ...
6
Contextual menu bindings are defined in the file here:
FileNameJoin[{$InstallationDirectory,
"SystemFiles", "FrontEnd", "TextResources", "ContextMenus.tr"}]
Examining the contents of that file, you can discover that the "Convert to Graphics" contextual menu item maps to the Mathematica command GraphComputation`GraphConvertToGraphics. Thus, for example,
...
10
ParametricPlot3D[{{Sin[u], 0, u}, {Cos[u], 1, u}}, {u, 0, 20},
BoxRatios -> 1, PlotRange -> {{-2, 2}, {-.5, 2}, {0, 20}}]
=== update - general thoughts ===
I've seen the comments to this question and a few other approaches to the waterfall (or wire) plot are given in this question: Plotting several functions. Also I cannot not mention one of my ...
11
Well, just after I had posted the question, I found a stupidly simple way to do it:
In[15]:= Show[CompleteGraph[8]] // Head
Out[15]= Graphics
4
To understand what is going on lets examine your initial plot. We assign it to the variable g:
g = Show[
Plot[1/2 x + 1/2, {x, -6, 7}],
ListPlot[{{4, -2.5}, {2, 1.5}}, Joined -> True, PlotMarkers -> Automatic]
]
g // ImageDimensions
{360, 224}
The figure's aspect ratio is therefore:
#2/#1 & @@ ImageDimensions[g] // N
...
4
This is really a comment, but it doesn't fit well into a comment box.
Since you say in your profile that you are a fan of minimalism, you might want to consider doing your plot this way:
Plot[1/2 x + 1/2, {x, -6, 7},
Epilog -> Line[{{4, -2.5}, {2, 1.5}}],
AspectRatio -> Automatic]
3
This is definitely a problem in Xorg or multiple drivers. The behavior you describe, i.e. logging out, appears on machine with Intel graphics. If you try this on nVidia machine with nvidia driver, you'll have a hang.
Now, you may be lucky to have something in /var/log/Xorg.0.log*. Here's what I have near the end of /var/log/Xorg.0.log.old.
The workaround is ...
10
Here is some code to convert filled curves to polygons (2D or 3D).
Updated
(I had the same idea as J.M., to combine the best of both answers...)
The code now handles filled curves containing BSplineCurve
primitives as well as BezierCurve and Line.
The curve primitives are converted to lines using J.M.'s ParametricPlot trick, ensuring good sampling.
...
3
Maybe the right way is to use RegionFunction for this, then it's very straight forward if we have a test function that checks whether a point lies inside given filled curve or not. I use rasterization to perform such test, but i'm sure it can be done better.
a = {{-1, 0}, {0, 1}, {1, 0}}; b = {{0, -2/3}};
g = Graphics[
FilledCurve[{{BezierCurve[2 a], ...
4
Cheating a bit:
a = {{-1, 0}, {0, 1}, {1, 0}}; b = {{0, -2/3}};
big = First @ Cases[ParametricPlot[BezierFunction[2 a][t], {t, 0, 1}], Line[l_] :> l, ∞];
small = First @ Cases[ParametricPlot[BezierFunction[a][t], {t, 0, 1}], Line[l_] :> l, ∞];
Graphics3D[{Directive[Black, EdgeForm[]], Polygon[Map[Append[#, 0] &,
(2 b) ~Join~ ...
5
Here is one approach doing the animation directly in Mathematica:
data1 = Import["https://raw.github.com/dk0r/comp-phys/master/Final_Project/M1_position.csv"];
data2 = Import["https://raw.github.com/dk0r/comp-phys/master/Final_Project/M2_position.csv"];
params = {xmin -> -3, xmax -> 3, ymin -> -2, ymax -> 2, trail -> 50,
diskradius -> ...
3
I'm also wondering why Mathematica doesn't treat the derivative of Abs as normal way. But here is a solution.
Plot[Evaluate@ComplexExpand[D[Abs[5 - 2 x], x]], {x, -10, 10}]
3
Since your are simulating Light, why not use Tube
tube1IncidentAndReflection={{-1,1,0},{0,0,0},{1,1,0}};
tube2IncidentAndRefraction={{-1,1,0},{0,0,0},{.6,-1,0}};
...
8
Might it be the way Mathematica deals with the derivative of Abs[]? For example,
D[Abs[5 - 2 x], x]
returns
-2*Derivative[1][Abs][5 - 2*x]
Try
Plot[Evaluate[D[Sqrt[(5 - 2 x)^2], x]], {x, -10, 10}]
14
Use ShearingTransform:
Graphics3D[{Polygon[{{-1.5, -1.5, 0}, {1.5, -1.5, 0}, {1.5, 1.5,
0}, {-1.5, 1.5, 0}}],
Polygon[{{-1.5, 0, -1.5}, {1.5, 0, -1.5}, {1.5, 0, 1.5}, {-1.5, 0,
1.5}}], Opacity[0.5],
GeometricTransformation[Cylinder[{{-1, 1, 0}, {0.0, 0, 0}}, 0.2],
ShearingTransform[ -Pi/4, {-1, 1, 0}, {1, 1, 0}]],
...
1
This works here ...
{listA, listB} = {{1, 2, 3, 4}, {5, 6, 7, 8}};
ListLogPlot[{listA, listB}, PlotStyle -> {{PointSize[0.02], Red}, {PointSize[0.04], Blue}}]
8
You also aren't getting the right line thickness in your legend. I'd suggest a slightly different route, of creating custom legend markers, similar to the method described in this answer, and including them in a SwatchLegend.
legmarkers = MapThread[Graphics[{#1, AbsoluteThickness[2],
Line[{{-1, 0}, {1, 0}}], #2}] &, {col, {Disk[{0, 0}, 0.3],
...
5
This was a bit harder -- and turned out more complicated -- than I thought it would be at first, mainly because at first I didn't think ahead to what would be required: To do the ticks and rotate them, you need to know the full plot range, including the padding, and the aspect ratio. Moreover, AbsoluteOptions does not work the way that would make it easy to ...
2
The question refers to a function rasterListContourPlot whose purpose was to replace the polygon-based filling of ListContourPlot with a rasterized image while maintaining all line-bases primitives as vector art. The output is a combination of Graphics objects, and there was no provision for Legended wrappers.
Here is a quick fix to the particular function ...
8
Directive denotes a single compound graphics directive, which idea cannot otherwise be expressed, although the same effect can often be attained through multiple paths. But then again, Mathematica offers multiple paths for many computations.
In a document one can define styles such as
myStyle = Directive[Thick, Blue, Opacity[0.5]]
and use them equally ...
7
I think all the other answers do a better job at exactly replicating the original image than what I am going to share, but my main intention here is to provide some exposition and show the utility in a particular coordinate transformation that naturally results in graphics having similar properties to the original image. I will refer to this transformation ...
0
A very simple workaround is to save your image as JPG or PNG. It is important to choose a good ImageResolution as Export Option.
This sounds like dirty workaround but If you have very many points in you vector-based pdf-file you will end up with a very large file. Then a rasterized image is better. In your document (especially in print), no difference can ...
9
Maybe using some Lines to simulate a flare star:
flarerays = Normalize /@ RandomVariate[NormalDistribution[], {500, 3}];
Graphics3D[{
White, Specularity[.1, 10], Sphere[],
Opacity[.1],
Orange,
Line[{{1, 1, 2}, {1, 1, 2} + 10 #}] & /@ flarerays,
Blue,
Line[{{-1, 1, -1}, {-1, 1, -1} + 10 #}] & /@ flarerays
},
Lighting -> {
...
1
You can use this package to call igraph through RLink. igraph does support multi-edges. After setting up the package, do
edgelist1 = {{1, 2}, {2, 3}, {3, 4}, {4, 1}, {1, 2}, {1, 4}}
GraphPlot[Rule @@@ edgelist1]
(* see the multiple edges *)
This is a bit more complex than passing a graph object because in Mathematica you can't construct a graph with ...
6
You could use Epilog in the main plot to Inset the zoomed graph :
P2 = Show[{C0, S0}, Frame -> True, FrameLabel -> {"R", "z"},
RotateLabel -> False, Axes -> False,
FrameStyle -> Directive[FontSize -> 17, FontFamily -> "Helvetica"],
PlotRange -> {{0.3, 4.5}, {-5, 5}}]
Show[ContourPlot[Veff, {R, 0.001, 35}, {z, -80, 80}, ...
6
Also not very pretty:
lights = {{"Point", Green, {5, 0, 0}}, {"Point", Red, {0, -5, 0}}};
indicators = Text[Style["*", 50, Bold, #2], #3] & @@@ lights;
Graphics3D[{Sphere[{0, 0, 0}, 3], indicators}, Lighting -> lights]
6
Not very pretty, but:
Graphics3D[{
Gray,
Specularity[3, 5],
Sphere[],
Cuboid[{-10, -10, -2}, {10, 10, -1}],
{ (* light *)
White,
EdgeForm[None],
Glow[Yellow],
Opacity[0.5],
Scale[
Translate[
PolyhedronData["GreatStellatedDodecahedron", "Faces"],
{2, 2, 10}],
3]
}
},
Lighting -> {{"Point", Yellow, {2, 2, ...
1
This is not the perfect solution to the problem, however the behavior of the manipulate is improved over what it was in the original question. Thanks to all who looked at this and especially David Park who gave me the “choiceEnabled =True/False” as well as all who left comments. I am not going to accept this as “The Answer”, in hopes that someone will ...
0
Another way (I think in this way only a certain number of data are used for regionplot but I'm not sure about it):
sindata = Table[{i, j, Sin[i + j^2]}, {i, 0, 3, 0.1}, {j, 0, 3, 0.1}]~Flatten~1;
cosdata = Table[{i, j, Cos[i + j^2]}, {i, 0, 3, 0.1}, {j, 0, 3, 0.1}]~Flatten~1;
sinfunc = Interpolation[sindata];
cosfunc = Interpolation[cosdata];
With[{a = ...
2
I can't really blame the OP. After all, the docs here so glibly recommend that one now do ListSurfacePlot3D[Flatten[pts, 1]] where one once needed to do ListSurfacePlot3D[pts].
We could, as halirutan did in his answer, grab the old routine from the package Graphics`Graphics3D` and just use it again in the new Mathematica. Or, we could exploit the fact that ...
1
The first thing I tried was to Flatten your data, so that it is a flat list of 3D coordinates. When you take your simple cylinder example and apply for instance a shearing transformation, you see, that you cannot rely on what ListSurfacePlot3D is doing.
Not only that it does not reconstruct your whole cylinder points, furthermore it gets really messy when ...
2
plot1 = ListContourPlot[
Flatten[Table[{i, j, Sin[i + j^2]}, {i, 0, 3, 0.1}, {j, 0, 3, 0.1}], 1],
RegionFunction -> Function[{x, y, z}, z < 1/2]];
plot2 = ListContourPlot[
Flatten[Table[{i, j, Cos[i + j^2]}, {i, 0, 3, 0.1}, {j, 0, 3, 0.1}], 1],
RegionFunction -> ...
3
You could try a RegionPlot:
RegionPlot[
Sin[i^2 + j] > 0 && Abs@Cos[i^2 + j] < 0.7, {i, 0, 3}, {j, 0, 3},
PlotPoints -> 80,
Mesh -> 2,
ColorFunction ->
Function[{x, y}, ColorData["SolarColors"][Sin[x ^2 + y]]],
MeshFunctions -> {Sin[#1 ^2 + #2] &, Abs@Cos[#1 ^2 + #2] &}]
This isn't quite the same as a ...
5
Needs["ErrorBarPlots`"]
nd = {#[[1, 1]], Mean[#[[All, 2]]],
StandardDeviation[#[[All, 2]]]/Sqrt[Length[#[[All, 2]]]]
} & /@ GatherBy[data, #[[1]] &];
fit[x_] = LinearModelFit[data, {1, x}, x]["BestFit"]
3.525688 - 0.02640621028 x
Show[
ErrorListPlot[{nd[[All, {1, 2}]], ErrorBar /@ nd[[All, 3]]}\[Transpose],
PlotRange -> ...
2
this is the kind of "hack" that I often throw together to illustrate math concepts for my students. The code is terrible but the result looks okay. Perhaps there is something here you can use...
The code...
Manipulate[
If[angle < 0,
endpt = {Cos[Abs[angle] Degree], - Sin[Abs[angle] Degree]} +
0.1 Abs[angle] Degree {Cos[
Abs[angle] ...
1
To give people ideas:
angle[a_] := Module[{p}, Show[
p = PolarPlot[1000 + 10 x, {x, 0, a}, PlotStyle -> Thick],
Graphics[{Thick, Extract[p, Position[p, _Hue]][[1]],
Line[{{0, 0}, 1.9 Extract[p, Position[p, _Line]][[1, 1, -1]]}]}]]];
angle[(2 360 + 45) Degree]
Remember to watch for negative angles.
6
Here's something I've used before:
rotCircle[angle_, ctr_, base1_, base2_, directives___] :=
With[{step = 0.05 Sign[angle], spiral = 0.01},
{directives,
Arrow[Table[ctr + (1.1 + spiral s) (Cos[s] base1 + Sin[s] base2),
{s, Append[Range[0, angle, step], angle]}]]}
]
Graphics[rotCircle[10., {0, 0}, {1, 0}, {0, 1}, Red, Thick], PlotRange -> ...
3
Does this give you a start?
DynamicModule[{p = {1.5, 0}},
Deploy@LocatorPane[Dynamic[p],
Dynamic@Graphics[
{Brown, Thick, Line[{{0, 0}, p/Norm[p]*1.5}],
Circle[{0, 0}, 1, {Mod[ArcTan @@ p, 2 Pi], 2 Pi}]},
PlotRange -> {{-2, 2}, {-2, 2}}, Axes -> True,
AxesOrigin -> {0, 0}], Appearance -> None
]
]
8
The only significant difference is compositing rings of colors over the wavy pattern.
(* colors for color mask *)
colFn = Blend[{{0, RGBColor[1, 0, 0.6]}, {0.03,
RGBColor[1, 0, 0.6]}, {0.04, RGBColor[0.4, 0, 0.8]}, {0.06,
RGBColor[0.5, 1, 0.8]}, {0.08, Lighter[Yellow, 0.6]}, {0.14,
Lighter[Yellow, 0.6]}, {0.2, RGBColor[0.2, 0, 0.9]}, ...
12
After trying things out, it would seem that I had ended up with a solution qualitatively similar to halirutan's; that is, wrap a sharply-peaked wave around a circle, and then have the "radius" vary. Nevertheless, my choice of the wave used is different, so I thought that I might as well post my variation:
With[{b = 10, f = 30, h = 2, w = 9},
...
19
The best I can do..
Well I think I missed some important properties on optical illusion that is presented in OP and halirutan's answer. I would very much like to wait for halirutan's explanation on it (if he is willing :)
Here is how I did it.
The outline shape is governed by equation 50 (1 + r/2) (Abs[Mod[θ, (2 π)/50] - π/50]^2 + r^0.1 10^-2) with 0 ...
Top 50 recent answers are included
