Is it possible to overlay two or more graphics in Mathematica, if the graphics are generated by functions such as ReliefPlot or DensityPlot, using Opacity to control the appearance?
For example:
a = ReliefPlot[
Table[i + Sin[i^2 + j^2], {i, -4, 4, .03}, {j, -4, 4, .03}], ImageSize -> 100]
b = ReliefPlot[
Table[i + Sin[i^3 + j^3], {i, -4, 4, .03}, {j, -4, 4, .03}], ImageSize -> 100]
Show[a,b]
combines the two, but I can't work out how to insert an Opacity command anywhere here such that both are visible. The documentation states that these functions accept the same options as Graphics ("ReliefPlot has the same options as Graphics, with the following additions and changes:"), but I don't understand how to control the graphics... (And I may be confused about the difference between graphics options and directives, as well.)
Enlightenment - and less opacity - very welcome!
Edit: Wow, you guys are quicker than my version of Mathematica - thanks!
You'll have to issue the opacity directive to ColorFunction like so:
a = ReliefPlot[
Table[i + Sin[i^2 + j^2], {i, -4, 4, .03}, {j, -4, 4, .03}],
ImageSize -> 100]
b = ReliefPlot[
Table[i + Sin[i^3 + j^3], {i, -4, 4, .03}, {j, -4, 4, .03}],
ImageSize -> 100,
ColorFunction -> (Directive[Opacity[0.5],
ColorData["Rainbow"][#]] &)]
Show[a, b]
In general, in all *Plot* functions, you control opacity with either PlotStyle or ColorFunction, as the case may be. If this were just a Graphics primitive, you'd probably do something like Graphics[{Opacity[0.5], object}].
Since ReliefPlot doesn't have a PlotStyle option, you can use BaseStyle -> Opacity[0.5] to introduce transparency into the graphics.
An alternative is to work with Images and the ReliefImage function, and then compose the resulting images together using ImageCompose:
ImageCompose[
ReliefImage[Table[i + Sin[i^2 + j^2], {i, -4, 4, .03}, {j, -4, 4, .03}]],
{ReliefImage[Table[i + Sin[i^3 + j^3], {i, -4, 4, .03}, {j, -4, 4, .03}]],
0.5}
]
Since ReliefPlot also essentially returns pixel data in a Graphics-compatible format, perhaps Images will suit you better.
The default colour function of ReliefImage is different: you can use ColorFunction -> "LakeColors" to switch to ReliefPlot's one.
Originally I had a function here to extract the raster data from ReliefPlot, but then Brett Champion pointed to RasterImage in the comment below
The answers using transparency will work in a very general way, but in this particular example of combining two ReliefPlot[]s, you might want to consider plotting the sum of the two:
f[i_] := i + Sin[i^2 + j^2];
g[i_] := i + Sin[i^3 + j^3];
ReliefPlot[Table[f[i] + g[i], {i, -4, 4, .03}, {j, -4, 4, .03}], ImageSize -> 100]
Show[a, {Opacity[0.5],#}& /# b]
Related
Ok! I'm working towards building a nested manipulate command that will solve n number of damped oscillating masses in series (with fixed endpoints). I have everything pretty much working but I have one problem - when I increase the number of oscillators, my initial conditions lag behind a bit. For example, if I set n to 4, Mathematica says I still only have 2 initial conditions (the starting number - position and velocity for one oscillator). When I then move to 3, I now have 8 (from my 4 oscillators) - which is too many for the state space equations, and it all fails. What is going on?
(Yes, I know that my initial conditions aren't going to be put in correctly yet, I'm just trying to get them to match up first).
coupledSMD[n_, m_, k_, b_, f_, x0_, v0_, tmax_] :=
Module[{aM, bM, cM, dM},
aM = Join[Table[Boole[i == j - n], {i, n}, {j, 2 n}],
Join[
If[n != 1,DiagonalMatrix[-2 k/m Table[1, {n}]] +
k/m DiagonalMatrix[Table[1, {n - 1}], 1] +
k/m DiagonalMatrix[Table[1, {n - 1}], -1],
{{-2 k/m}}],
If[n != 1,DiagonalMatrix[-2 b/m Table[1, {n}]] +
b/m DiagonalMatrix[Table[1, {n - 1}], 1] +
b/m DiagonalMatrix[Table[1, {n - 1}], -1],
{{-2 b/m}}], 2]];
bM = Join[Table[0, {n}, {1}], Table[1/m, {n}, {1}]];
cM = Table[Boole[i == j], {i, n}, {j, 2 n}];
dM = Table[0, {n}, {1}];
OutputResponse[
{StateSpaceModel[{aM, bM, cM, dM}], Flatten[Join[x0, v0]]},
f, {t, 0, tmax}]
]
Manipulate[
With[{
x0s = Table[Subscript[x, i, 0], {i, 1, n}],
v0s = Table[Subscript[v, i, 0], {i, 1, n}],
initialx = Sequence ## Table[{{Subscript[x, i, 0], 0}, -10, 10}, {i, 1, n}],
initialv = Sequence ## Table[{{Subscript[v, i, 0], 0}, -10, 10}, {i, 1, n}]},
Manipulate[
myplot = coupledSMD[n, m, k, b, f, x0s, v0s, tmax];
Plot[myplot, {t, 0, tmax}, PlotRange -> yheight {-1, 1},
PlotLegends -> Table[Subscript[x, i, 0], {i, 1, n}]],
Style["Initial Positions", Bold],
initialx,
Delimiter,
Style["Initial Velocities", Bold],
initialv,
Delimiter,
Style["System conditions", Bold],
{{m, 1, "Mass(kg)"}, 0.1, 10, Appearance -> "Labeled"},
{{k, 1, "Spring Constant(N/m)"}, 0.1, 10, Appearance -> "Labeled"},
{{b, 0, "Damping Coefficient(N.s/m)"}, 0, 1, Appearance -> "Labeled"},
{{f, 0, "Applied Force"}, 0, 10, Appearance -> "Labeled"},
Delimiter,
Style["Plot Ranges", Bold],
{tmax, 10, 100},
{{yheight, 10}, 1, 100},
Delimiter,
ControlPlacement -> Flatten[{Table[Right, {2 n + 2}], Table[Left, {8}]}]
]],
{n, 1, 4, 1}
]
Edit: Updated the code. It works now, but I'm still getting the errors. I'm guessing that it has something to do with a time lag in the updating process? - That some parts are getting updated before others. Again, it seems to be working perfectly, except it throws these errors (the errors seem superfluous to me, as if they are remnants in the code, but not actually causing a problem)
But I don't really know what I'm talking about :)
Can I plot and deal with implicit functions in Mathematica?
for example :-
x^3 + y^3 = 6xy
Can I plot a function like this?
ContourPlot[x^3 + y^3 == 6*x*y, {x, -2.7, 5.7}, {y, -7.5, 5}]
Two comments:
Note the double equals sign and the multiplication symbols.
You can find this exact input via the WolframAlpha interface. This interface is more forgiving and accepts your input almost exactly - although, I did need to specify that I wanted some type of plot.
Yes, using ContourPlot.
And it's even possible to plot the text x^3 + y^3 = 6xy along its own curve, by replacing the Line primitive with several Text primitives:
ContourPlot[x^3 + y^3 == 6 x y, {x, -4, 4}, {y, -4, 4},
Background -> Black, PlotPoints -> 7, MaxRecursion -> 1, ImageSize -> 500] /.
{
Line[s_] :>
Map[
Text[Style["x^3+y^3 = 6xy", 16, Hue[RandomReal[]]], #, {0, 0}, {1, 1}] &,
s]
}
Or you can animate the equation along the curve, like so:
res = Table[ Normal[
ContourPlot[x^3 + y^3 == 6 x y, {x, -4, 4}, {y, -4, 4},
Background -> Black,
ImageSize -> 600]] /.
{Line[s_] :> {Line[s],
Text[Style["x^3+y^3 = 6xy", 16, Red], s[[k]], {0, 0},
s[[k + 1]] - s[[k]]]}},
{k, 1, 448, 3}];
ListAnimate[res]
I'm guessing this is what you need:
http://reference.wolfram.com/mathematica/Compatibility/tutorial/Graphics/ImplicitPlot.html
ContourPlot[x^3 + y^3 == 6 x*y, {x, -10, 10}, {y, -10, 10}]
I have already checked all the examples and settings in the Mathematica documentation center, but couldn't find any example on how to choose the numbers that will be shown on the axes.
How do I change plot axis numbering like 2,4,6,.. to PI,2PI,3PI,...?
Howard has already given the correct answer in the case where you want the labels Pi, 2 Pi etc to be at the values Pi, 2 Pi etc.
Sometimes you might want to use substitute tick labels at particular values, without rescaling data.
One of the other examples in the documentation shows how:
Plot[Sin[x], {x, 0, 10},
Ticks -> {{{Pi, 180 \[Degree]}, {2 Pi, 360 \[Degree]}, {3 Pi,
540 \[Degree]}}, {-1, 1}}]
I have a suite of small custom functions for formatting Ticks the way I want them. This is probably too much information if you are just starting out, but it is worth knowing that you can use any number format and substitute anything into your ticks if desired.
myTickGrid[min_, max_, seg_, units_String, len_?NumericQ,
opts : OptionsPattern[]] :=
With[{adj = OptionValue[UnitLabelShift], bls = OptionValue[BottomLabelShift]},
Table[{i,
If[i == max,
DisplayForm[AdjustmentBox[Style[units, LineSpacing -> {0, 12}],
BoxBaselineShift -> If[StringCount[units, "\n"] > 0, adj + 2, adj]]],
If[i == min,
DisplayForm#AdjustmentBox[Switch[i, _Integer,
NumberForm[i, DigitBlock -> 3,
NumberSeparator -> "\[ThinSpace]"], _, N[i]],
BoxBaselineShift -> bls],
Switch[i, _Integer, NumberForm[i, DigitBlock -> 3,
NumberSeparator -> "\[ThinSpace]"], _, N[i]]]], {len, 0}}, {i,
If[Head[seg] === List, Union[{min, max}, seg], Range[min, max, seg]]}]]
And setting:
Options[myTickGrid] = {UnitLabelShift -> 1.3, BottomLabelShift -> 0}
SetOptions[myTickGrid, UnitLabelShift -> 1.3, BottomLabelShift -> 0]
Example:
Plot[Erfc[x], {x, -2, 2}, Frame -> True,
FrameTicks -> {myTickGrid[-2, 2, 1, "x", 0.02, UnitLabelShift -> 0],
myTickGrid[0, 2, {0.25, .5, 1, 1.8}, "Erfc(x)", 0.02]}]
You can find an example here:
Ticks -> {{Pi, 2 Pi, 3 Pi}, {-1, 0, 1}}
Ticks also accepts a function, which will save you the trouble of listing the points manually or having to change the max value each time. Here's an example:
xTickFunc[min_, max_] :=
Table[{i, i, 0.02}, {i, Ceiling[min/Pi] Pi, Floor[max/Pi] Pi, Pi}]
Plot[Sinc[x], {x, -5 Pi, 5 Pi}, Ticks -> {xTickFunc, Automatic},
PlotRange -> All]
If you want more flexibility in customizing your ticks, you might want to look into LevelScheme.
If you run the following code snippet:
Manipulate[
Graphics3D[
{Cuboid[{{-1, -1, -1}, {1, 1, 1}}], Sphere[{5, 5, 5}, 1]},
ViewPoint -> {1, 1, a}, AxesOrigin -> {0,0,0}
],
{a, 1, 100}
]
and move the viewpoint from (1,1,1) to (1,1,100) with the slider you will see that after a while the objects remain fixed in size.
Questions.
1. When I move the viewpoint further away from the scene I want the objects to become smaller. How should this be done in Mathematica?
( EDIT: )
2. What is the position of the 'camera' in relation to Viewpoint?
See ViewAngle. Under "More Information", note that the default setting ViewAngle -> Automatic is effectively equivalent to ViewAngle -> All when you zoom far enough out.
You just need to add an explicit setting for ViewAngle:
Manipulate[
Graphics3D[{Cuboid[{{-1, -1, -1}, {1, 1, 1}}], Sphere[{5, 5, 5}, 1]},
ViewPoint -> {1, 1, a}, AxesOrigin -> {0, 0, 0},
ViewAngle -> 35 Degree], {a, 1, 100}]
As far as I know, the camera viewpoint really coincides with the position given by ViewPoint. Because Mathematica scales the result to fit in about the same image you don't see much changes but they are there. The perspective changes considerably. Try, for instance, to move away from a semi-transparant square and you'll see that the farther you go, the more the projection becomes an orthogonal projection:
If you want to scale your image according to distance you can use ImageSize. SphericalRegion is good to stabilize the image.
Manipulate[
vp = {1, 1, a};
Graphics3D[{Cuboid[{{-1, -1, -1}, {1, 1, 1}}], Sphere[{5, 5, 5}, 1]},
ViewPoint -> vp,
AxesOrigin -> {0, 0, 0},
SphericalRegion -> True,
ImageSize -> 500/Norm[vp]],
{a, 1, 100}
]
[animation made with some ImagePadding to keep object in the center. I stopped the animation at a = 10, the image gets pretty small after that]
How can I make it such that plotting the following function
ListPointPlot3D[points, PlotStyle -> PointSize[0.05]];
the points I see are green or yellow, for instance, instead of the typical dark blue ones?
Thanks
Use Directive to combine styles, ie
ListPointPlot3D[points, PlotStyle -> Directive[{PointSize[0.05], Green}]]
Edit I give you below two possible solutions in a context related to your previous question. Nevertheless, please note that #Yaroslav's code is much better.
f[x_, y_] := x^2 + y^2;
t = Graphics3D[{PointSize[Large], Red, Point#
Flatten[Table[{x, y, f[x, y]}, {x, 0, 10, 1}, {y, 1, 2, 1}], 1]}];
b = Plot3D[f[x, y], {x, -10, 10}, {y, -10, 10},
ColorFunction -> "MintColors"];
Show[{b, t}]
Or
f[x_, y_] := x^2 + y^2;
points = Flatten[Table[{x, y, f[x, y]}, {x, 0, 10, 1}, {y, 1, 2, 1}],
1];
a = ListPointPlot3D[points,
PlotStyle -> Table[{Red, PointSize[0.05]}, {Length#t}]];
b = Plot3D[f[x, y], {x, -10, 10}, {y, -10, 10},
ColorFunction -> "MintColors"];
Show[{b, a}]
Sometimes I find the following approach useful, as it allows me to
manipulate the plot symbol (PlotMarkers does not seem to work with ListPointPlot3D,
at least in Mathematica 7) [originally suggested by Jens-Peer Kuska]:
ListPointPlot3D[{{1,1,1},{2,2,2},{3,3,3}}]/.Point[xy_]:>(Style[Text["\[FilledUpTriangle]",#],Red,FontSize-> 20]&/#xy)