Here is a problem that I don't know if can be solved in Mathematica.
(* Courtesy to Lunchtime Playground Blog *)
to3d[plot_, height_, opacity_] :=
Module[{newplot}, newplot = First#Graphics[plot];
newplot = N#newplot /. {x_?AtomQ, y_?AtomQ} -> {x, y, height} /.
Arrowheads[List[List[x_, y_, notz_]]] ->
Arrowheads[List[List[x, y]]];newplot /.GraphicsComplex[xx__] -> {Opacity[opacity], GraphicsComplex[xx]}];
(* A function to combine 2D Graphics object in Mathematica *)
test[list_]:=VectorQ[list,SameQ[Head[#],Graphics]&];
My3DPlot[list_?(test[#]&),height_?(VectorQ[#,NumberQ]&),opacity_?(VectorQ[#,NumberQ]&),opts:OptionsPattern[]]:=Block[{a},a=MapThread[Graphics3D[to3d[#1,#2,#3]]&,{list,height,opacity}];
Show[a,opts]
]
(* List of 2D graphics *)
list=Table[ContourPlot[y+Sin[x^i+i y],{x,-3,3},{y,-3,3},Contours->15,ContourLines->False,ColorFunction->RandomChoice[ColorData["Gradients"]]],{i,{1,2,3,4}}];
(* List of heights where you want to place the images *)
height={-.5,0,.5,1};
(* List of opacities you want to apply to your 2D layers *)
opacity={1,.8,.7,.5};
(* The function inherits all the options of standard Graphics3D as they are passed through the Show command *)
My3DPlot[Reverse#list,height,opacity,Lighting->"Neutral",BoxRatios->{1,1,.9},Axes->True]
Now this returns a cool picture like this one.
Here my question is if it is possible to create a filling for this 2D layers using the same color functions as are used with in the contour plots for example? Target is to fill the hollow between these 2D layers with some light or color that continuously changes according to the neighboring layer color-function.
I hope this can be done in Mathematica but my limited knowledge in Mathematica graphics is making it a difficult hurdle for me.
It should be possible. Texture can be used to generate a 3D texture. The example given in the documentation:
data = Table[{r, g, b}, {r, 0, 1, 1/20}, {g, 0, 1, 1/20}, {b, 0, 1, 1/20}];
Graphics3D[
{
Opacity[1/3],
Texture[data],
EdgeForm[],
Polygon[Table[{{0, 0, z}, {1, 0, z}, {1, 1, z}, {0, 1, z}}, {z, 0, 1, 1/20}],
VertexTextureCoordinates ->
Table[{{0, 0, s}, {1, 0, s}, {1, 1, s}, {0, 1, s}}, {s, 0, 1, 1/20}]]
},
Lighting -> "Neutral"
]
This simulates a volume by using a large set of planes. You can do the same. All you have to do is describe the 3D texture, which should interpolate between the planes you already have.Blend would be the function to be used here. For each pixel column in your cube the color varies as Blend[{col1,col2,col3,...},x] with x going from 0 to 1 and coli the color of the pixel in the ith plane given by the contour plots.
The main problem will be that a 3D semi-transparant object with fuzzy color gradients is not something that visualizes very well.
Related
I would like to rotate an image based on a second image. Both images are satellite images, however, they are not rotated in the same direction(in one image top is in the north direction and in the other the rotation is not known). But, I have at least three pixel pairs in each of the images (x1,y1,x2,y2). So my idea is to figure out their relative position and get the rotation angle from that.
Currently, I estimate the angle like this:
def angle_between(v1, v2):
""" Returns the angle in radians between vectors 'v1' and 'v2'::
>>> angle_between((1, 0, 0), (0, 1, 0))
1.5707963267948966
>>> angle_between((1, 0, 0), (1, 0, 0))
0.0
>>> angle_between((1, 0, 0), (-1, 0, 0))
3.141592653589793
"""
v1_u = unit_vector(v1)
v2_u = unit_vector(v2)
angle_rad = np.arccos(np.clip(np.dot(v1_u, v2_u), -1.0, 1.0))
return (angle_rad*180)/math.pi
with the inputs like this:
v1 = [points[0][0] - points[1][0], points[0][1] - points[1][1]] #hist
v2 = [points[0][2] - points[1][2], points[0][3] - points[1][3]] #ref
However, this only uses two pixel pairs instead of the three. Therefore, the rotation is some times incorrect. Could anybody show me how to use all three pixels?
My first attempt was to check on which side of the straight the third pixel lies in the image and based on that negate the angle. But, this does not work for all images.
EDIT:
I cannot add the original images, as they are copyrighted, however, as the image content is not really important I added whitened images. The first is the input image with the three points drawn in, the second is the rotated image (where additionally the (wrong, due to rotation) cutout area is marked with a rectangle) and third the historical image.
The points are the following:
567.01,144,1544.4,4581.8
1182.6,1568.1,2934.1,3724.3
938.97,1398.1,2795.8,4002.5
with:
x_historical, y_historical, x_presentday, y_presentday
Is there any reason that underlies mathematica's way of presenting this graph
ListPlot[
Table[{x, x*01}, {x, -5, 5, .08}],
PlotStyle -> White,
Filling -> 0,
FillingStyle -> {Dashed, Brown}]
While the dashing is present for the part of the graph above the zero boundary, another part of the graph has the filling that is solid.
Am I doing something wrong?
Not that wrong. Mathematica is interpreting your filling style as being Dashed below zero and Brown above. You just need another pair of braces, like so:
ListPlot[Table[{x, x*01}, {x, -5, 5, .08}], PlotStyle -> White,
Filling -> 0, FillingStyle -> {{Dashed, Brown}}]
Hope that helps.
I would like to draw a rectangle (or more) which printed on paper shows the rectangle in units of cm.
So
Graphics[{Rectangle[{0, 0}, {19, 28}], Orange, Rectangle[{0, 0}, {1, 1}]}]
will print out as two rectangles which can be measured as exactly 1cm x 1cm (orange one) and the black one as 19x28 cm.
It seems that some variables are important:
The ImageSize and of course the AspectRatio.
I used AspectRatio->19/28 and for the ImageSize various settings like ImageSize->{19*27,28*27} but it keeps being not very accurate.
I export the graphics to TIFF and then print out with windows photo gallery to a full page photo. Does anyone have experience with this? There must be a formula instead of trial and error.
UPDATE:
I tried the suggestion of #Szabolcs and I used the following code:
g = Graphics[{White, EdgeForm[Directive[Thick, Black]],
Rectangle[{0, 0}, {18, 28}], Orange, Rectangle[{0, 0}, {10, 10}]}]
final = Show[g, AspectRatio -> Automatic,
PlotRange -> {{-0.5, 18.5}, {-0.5, 28.5}}]
cm = 72/2.54
Export["final.pdf", Show[final, ImageSize -> {19 cm, 29 cm}]]
This works great. The orange rectangle of 10x10cm is when measured exactly 10x10cm
the cm 72/2.54 value was not what I expected since I though Windows uses 96dpi and Mac 72dpi (reading from the www). However 72 is the value that works.
I've also beenn playing with the frames but then it gets ugly. Haven't found a way to get the right results dispite playing with all possible settings. What should work is create the frames/ticks etc myself inside the selected boundaries but that's not the path I would like to pursue..
g = Graphics[{Rectangle[{0, 0}, {19, 28}], Orange, Rectangle[{0, 0}, {1, 1}]}]
Okay, first thing you need to do is set the x and y directions to use the same units, which means
Show[g, AspectRatio -> Automatic]
But this is already the default.
Second thing you need to do is choose a size and range for your plot area. Let's make it 21 by 30 with your rectangles centred:
plotArea = {{0, 21}, {0, 30}} - {1, 1}
Show[g, AspectRatio -> Automatic, PlotRange -> plotArea]
Third thing you need to do is turning off adding any padding/margins that make the actual size of your figure larger than your plot range:
final = Show[g, AspectRatio -> Automatic, PlotRange -> plotArea, PlotRangePadding -> 0, ImagePadding -> 0]
I believe ImageMargins does not make a difference, but if it does, set that to 0 as well.
The final thing you need to do is export this to a printable format that preserves the image dimensions, and set the size of the image so that 1 cm will be 1 unit on your plot. Mathematica accepts image sizes in printer's points, so let's define:
cm = 72/2.54
Export["final.pdf", Show[final, ImageSize -> 21 cm]]
We want the plot to be 21 cm wide because it's 21 units wide. Use PDF as export format, not TIFF. The ImageSize needs to be used inside Show to work around some problems with Export ...
Now open your PDF in Adobe Reader, open the print dialogue, and make sure that Page Scaling is set to None! I don't know how to do this in other readers ... Also make sure your figure fits the paper (21 by 30 cm is too large for A4 ...)
I'm not going to do a test print, so let me know if this works for you :-) The size of the PDF generated this way is exactly 21 by 30 cm, so if something goes wrong, it must happen at the printing stage.
I believe you need to add PlotRangePadding -> None and set image dimensions appropriately.
In this case, the "bounding box" size is the same as your larger rectangle: {19, 28}
The robust way to do this is to set ImageSize to the actual required dimensions, and make use of ImageResolution, which will embed this value into the TIFF file for proper printing:
cm = 72 / 2.54;
g = Graphics[{Rectangle[{0, 0}, {19, 28}], Orange,
Rectangle[{0, 0}, {1, 1}]}, PlotRangePadding -> None,
ImageSize -> {19, 28}*cm];
Export["print.tif", g, ImageResolution -> 300]
This assumes that you want to print from a raster format (TIFF) but you can also export to other formats such as PDF with the same method.
If I do a Plot with Frame->True is there a way I can find the coordinates of the corners of the Frame in the absolute coordinates of the image? I have the numerical values of PlotRange and PlotRangePadding but note that I don't want to tamper with the actual plot in any way, just find out where in the full display area Mathematica chooses to place the frame/axes of the plot.
As pointed out by Brett Champion, I'm looking for the coordinates {x,y} such that Scaled[{0,0}] == ImageScaled[{x,y}].
[Note that I edited this question to remove my confusing misuse of the term "scaled coordinates".]
The corners of the frame are at Scaled[{0,0}] and Scaled[{1,1}].
The corners of the full graphic (including labels) are at ImageScaled[{0,0}] and ImageScaled[{1,1}].
Converting between them is hard, although in theory it's possible to convert Scaled and user (unscaled) coordinates if you know the actual, numeric, settings for PlotRange and PlotRangePadding.
Depending on your application, you might also be able to use MousePosition, which knows these things as well.
Rasterize (and HTML export) also know how to find bounding boxes of annotations, in a bitmap/pixel coordinate system:
In[33]:= Rasterize[
Plot[Sin[x], {x, 0, 10}, Frame -> True,
Prolog -> {LightYellow,
Annotation[Rectangle[Scaled[{0, 0}], Scaled[{1, 1}]], "One",
"Region"]}], "Regions"]
Out[33]= {{"One", "Region"} -> {{22., 1.33573}, {358.9, 209.551}}}
Here's how dreeves used that Rasterize trick to make a function to return exactly what he was looking for (note the assumption of a global variable imgsz which gives the ImageSize option for rasterizing the plot -- the coordinates of the frame depend on that value):
(* Returns the geometry of the frame of the plot:
{width, height, x offset, y offset, total width, total height}. *)
geom[p_Graphics] := Module[{q, x1, y1, x2, y2, xmax, ymax},
q = Show[p, Prolog->{Annotation[Rectangle[Scaled[{0,0}], Scaled[{1,1}]],
"MAGIC00","MAGIC11"]}];
{{x1,y1}, {x2,y2}} = Rasterize[q, "Regions", ImageSize->imgsz][[1,2]];
{xmax,ymax} = Rasterize[p, "RasterSize", ImageSize->imgsz];
{x2-x1, y2-y1, x1, y1, xmax, ymax}]
The coordinates of the upper left corner of the frame are always Scaled[{0,1}].
The coordinates of the lower right corner of the frame are always Scaled[{1,0}].
Let's place large points at the upper left and lower right corners:
Plot[Cos[x], {x, 0, 10}, Frame -> True,
Epilog -> {PointSize[.08], Point[Scaled[{0, 1}]], Point[Scaled[{1, 0}]]} ]
When I click on the graph (see below) , it is obvious that there is no padding around the frame of the plot.
Now, with ImagePadding on, let's place Points in the same corners:
Plot[Cos[x], {x, 0, 10}, Frame -> True,
ImagePadding -> {{37, 15}, {20, 48}},
Epilog -> {PointSize[.08], Point[Scaled[{0, 1}]], Point[Scaled[{1, 0}]]} ]
The Points stay at the corners of the graph frame.
There is ImagePadding around the graph frame.
EDIT: Based on the clarification of the question by dreeves.
Plot[Cos[x], {x, 1, 9}, ImageSize -> 300, AspectRatio -> 1,
Frame -> True, ImagePadding -> 30,
FrameTicks -> {Range[9], Automatic},
Epilog -> {PointSize[.08], Point[Scaled[{0, 1}]], Point[Scaled[{1, 0}]]}]
I've drawn the plot as 300x300 to simplify the numbers.
Here's the analysis.
Documentation states that ImagePadding "is defined within ImageSize".
The image shown above has a width and height of 300 pixels.
There is a 30 pixel margin drawn around the frame; this corresponds to 10% of the width and height.
So the frame corners should be, starting from the origin, at ImageScaled[{.1,.1}], ImageScaled[{.9,.1}, ImageScaled[{.9,.9}] & ImageScaled[{.1,.9}].
It's easy to work out the value for other AspectRatios and ImageSizes.
One possibility is to take manual control of ImagePadding:
Plot[Sin[x], {x, 0, 10}, Frame -> True,
ImagePadding -> {{30, 5}, {20, 5}}]
ImageTake[Rasterize[%], {5, -20}, {30, -5}]
I need to incorporate a 3D model of the Earth into a satellite orbit intercept simulation I have created in Mathematica (I need it to work with "Graphics3D[]). I have downloaded several different models in formats that Mathematica claims to support and I even created my own in Pro/E. The ones that actually do get imported into the program (using "Import[]") lose their surface image and I am left with a generic sphere. How can I get custom 3D graphics to import correctly into Mathematica? Are certain formats better than others? (I have been using mostly CAD models) And is there place to download more (user-created) 3D graphics for Mathematica?
I know it's possible because Belisarius has done so in a response to a question here:
How to create 2D (3D) animation in Wolfram Mathematica with the camera following the object?
which is almost exactly what I need to do, as far as views go.
myEarth =
ParametricPlot3D[{Cos#u Sin#v, Sin#u Sin#v, Cos#v}, {u, 0, 2 Pi}, {v, 0, Pi},
Mesh -> None, TextureCoordinateFunction -> ({#4, 1 - #5} &),
PlotStyle -> Texture[Show[map, ImageSize -> 1000]]];
a = {-1, 1};
Animate[
Show[
Graphics3D[Sphere[{0, 0, 0}, .5],
ViewPoint -> 3.5 {Cos#t, Sin#t, 0}, SphericalRegion -> True,
PlotRange -> {a, a, a}, Axes -> False, Boxed -> False],
myEarth],
{t, 0, 2 Pi}]
Edit
I found from where I borrowed some code: http://reference.wolfram.com/mathematica/ref/Texture.html Under Applications, Earth Texture