Tag Info

Hot answers tagged

43

Yes we can. The following DashedGraphics3D[ ] function is designed to convert ordinary Graphics3D object to the "line-drawing" style raster image. Clear[DashedGraphics3D] DashedGraphics3D::optx = "Invalid options for Graphics3D are omitted: `1`."; Off[OptionValue::nodef]; Options[DashedGraphics3D] = {ViewAngle -> 0.4, ViewPoint ...


18

This is how I would do this. Define frequencies and sampling rate precisely. Then use Periodogram because it takes SampleRate as an option and rescales frequency axis automatically. Read up Docs on Periodogram - see examples there. data = Table[{t, Sin[2 Pi 697 t] + Sin[2 Pi 1209 t]}, {t, 0., 0.1, 1/8000.}]; ListLinePlot[data, AspectRatio -> 1/4, ...


13

body[t_] = Integrate[#[u^2], {u, 0, t}] & /@ {Cos, Sin} ParametricPlot3D[body[t]~Join~{t}, {t, -2 Pi, 2 Pi}, BoxRatios -> 1, SphericalRegion -> True]


10

So you guys know - quasicrystals are cool structures that can consist of finite number of parts which can be arranged in never repeating - aperiodic - pattern. Thing here is called projection method from a regular lattice. http://www.nature.com/nmat/journal/v3/n11/fig_tab/nmat1244_F3.html Interestingly if you know Fibonacci rabbits problem - that is also ...


9

The order of arguments in Show makes a difference in two ways: The Graphics expression produced by Show will inherit options from the first argument The first argument will appear in the bottom layer, the last one in the top layer. The most common problem (1) causes is that the plot range is inherited from the first argument, causing parts of the second ...


9

N.B. Your actual data calls for a more sophisticated approach than the quick hack in my original answer, so I've replaced it with a much better and quite general solution. There are two things that make your actual data harder to work with than the toy example. First, it is highly irregular and nonuniformly distributed: ListPlot[Most /@ data, AspectRatio ...


8

Seeing Silvia's phenomenal answer I've been inspired to take a crack at this. My method requires the use of ColorFunction so it only works for plots rather than general Graphics3D geometry. However, it does find silhouette edges in the interior of the image, as well as those hidden behind other surfaces (such as the missing side walls of the internal ...


8

What is stored in variable x is different from rotated object you have in output cell. You rotated - so you changed the properties. Many ways to do this - so in addition to comments' methods... 1) In-Export rotation 2) Seeing options Export["test.png", Show[x, opts]]


8

Show[Plot[1/(x^2), {x, 0, 4}, PlotStyle -> Blue, AspectRatio -> 1], Plot[1, {x, 0, 1}, FillingStyle -> Purple, Filling -> Bottom, PlotStyle -> Blue], Plot[1/(x^2), {x, 1, 4}, PlotStyle -> Blue, Filling -> Axis, FillingStyle -> Red, PlotRange -> {Full, {0, 1}}]]


7

Here is a more simple example showing the same effect: G1 = ListPlot[ Table[{i , Sin[i j Pi/50]}, {j, 3}, {i, 50}], PlotRange -> All, Joined -> True, AspectRatio -> 0.8, PlotStyle -> {{Purple, Thickness[0.012]}, {Blue, Thickness[0.014], Dashed}, {Red, Thickness[0.013], DotDashed}}] Export["test1.eps", ...


7

One Plot can do too: Plot[{If[x < 1, 1/(x^2)], If[x > 1, 1/(x^2)]}, {x, 0, 4}, AspectRatio -> 1, Filling -> {2 -> {Axis, Red}}, Epilog -> {Purple, Rectangle[]}]


6

Here are some examples: Column[ BarChart[{{1, 2, 3}, {4, 5, 6}}, ChartLegends -> Placed[{{"Group A", "Group B"}, None}, {#}], ChartStyle -> {"Pastel", None}] & /@ {Left, Right, Top, Bottom, {0.2, 0.7}}, Frame -> All]


6

Maybe try something like ClearAll@plotter plotter[s_, h_] := plotter[s, h] = ListPlot[RecurrenceTable[{x[t + 1] == N[(x[t]^2 + x[t] (1 - x[t]) (1 - s h))/(x[t]^2 + 2 x[t] (1 - x[t]) (1 - s h) + (1 - x[t])^2 (1 - s))], x[0] == 7}, x, {t, 0, 16}] , PlotRange -> {0, 1} ] Manipulate[plotter[s, h], {{s, 1}, 1, 5, 1}, ...


6

I like @Vitaliy's answer, but here's another approach using Fourierinstead of Periodogram. time = 2; tinc = 0.001; sampls = Table[Sin[n*(2 Pi) 4], {n, 0, 2, tinc}]; nyquist = 1/(2 tinc) len = Length@sampls; ListLinePlot[Sqrt[4/len] Abs@Fourier[sampls], PlotRange -> {{0, 10}, All}, DataRange -> {0, (len - 1)/time}] Briefly, I construct a sample ...


6

One option would be to restrict the function from funky regions with a Condition liks this f[x_, y_] /; Abs[x - y] > 5 := (Sin[x] - Sin[y])/(x - y); Plot3D[f[x, y], {x, -10, 10}, {y, -10, 10}] Out: One can easily see that Plot3D will also sample points in the region which is "forbidden", the points are just not drawn due to the RegionFunction. ...


5

There is no built in option, however for the US it's very easy because the coordinates of the state borderlines are all over the Internet. This led me to one such data set. I'll include how I cleaned it up, like this: data = Import["http://econym.org.uk/gmap/states.xml"]; name[{"name" -> n_, ___}] := n coordinates[XMLElement["point", {"lat" -> lat_, ...


5

Two defintions of f, one each side of a. f[a_?NumericQ, t_?NumericQ] /; a > t := 10 Exp[-0.1 Sin[t]]; f[a_?NumericQ, t_?NumericQ] /; a <= t := f[a, t - 1] Exp[-0.1 a]; Plot it. Plot[f[5, t], {t, 0, 10}]


5

ContourPlot3D is not very good at resolving thin features, because it only knows that the feature exists when one of the sampling points happens to land inside it. In general, one thing you can do is to increase PlotPoints, which improves the plot but takes a very long time. ContourPlot3D[ Abs[c[x + I y]] == k^3, {x, -2.5, 2}, {y, -2, 2}, {k, 0, 1.75}, ...


5

If I understand the question correctly, you want to plot $f(a,x)$ as a function of $a$ and $x$, except that $a$ takes discrete values and $x$ lies in a continuous range. Maybe something like f[a_, x_] := Exp[-x] x^(a - 1)/(a - 1)! Then the graph of $f$ isn't a surface but a collection of curves $x\mapsto f(a,x)$, one for each discrete value of $a$. You ...


5

You can use RootLocusPlot. poly = -6.110000000000001`*^6 k^4 + 1000.` s1^2 + 60.335263000000005` (-5.` k + s1)^2; RootLocusPlot[1/poly, {s1, 0, 1}, FeedbackType -> None, PoleZeroMarkers -> {"ParameterValues" -> Range[0.1, 0.9, 0.1]}]


5

It is always nice to have alternative solutions. The following sets up a function which holds its value until a larger value is presented to it. rMax[ts_] := Block[{max = -\[Infinity], rmax}, rmax[x_ /; x <= max]:= max; rmax[x_]:= (max = x; x); rmax /@ ts ] Lets generate some data and extract out the states. SeedRandom[1321]; s = ...


5

E.g, function squares list elements: l1 = {1, 2, 3, 4, 5} {l1, l2, l3, l4, l5, l6} = NestList[#^2 &, l1, 5] (* {{1, 2, 3, 4, 5}, {1, 4, 9, 16, 25}, {1, 16, 81, 256, 625}, {1, 256, 6561, 65536, 390625}, {1, 65536, 43046721, 4294967296, 152587890625}, {1, 4294967296, 1853020188851841, 18446744073709551616, 23283064365386962890625}} *) This ...


5

I would plot each separately and combine them: Show[ ContourPlot3D[(4 - z)^2 == (x^2 + y^2), {x, -3, 3}, {y, -3, 3}, {z, 2, 4}], ContourPlot3D[x^2 + y^2 == 4, {x, -3, 3}, {y, -3, 3}, {z, -2, 2}], PlotRange -> All ]


5

With some decoration : With[{coord = MapIndexed[{#2[[1]], #1} &, data]}, Graphics[{MapThread[Style[Text[#1, #2 + If[OddQ[#2[[1]]], {0, 2}, {0, -2}]], Black, 18, Italic] &, {elements, coord}], PointSize[Large], Gray, Line[{#, # + If[OddQ[#[[1]]], {0, 1.4}, {0, -1.4}]}] & /@ coord, Blue, Point@coord}, Axes -> ...


5

This is likely a consequence of taking the toy example too seriously, but LinearModelFit seems like a good choice: lmf=LinearModelFit[data,{x,y},{x,y}] ContourPlot[lmf[x,y],{x,0,100},{y,0,100},Contours->{80,120},ContourShading->None] For a the data provided you might get some use from: basis[n_,m_] := Flatten[Table[x^i y^j,{i,0,n},{j,0,m}],1] ...


5

Another variation, using ConditionalExpression: Plot[{ ConditionalExpression[x^-2, x <= 1], ConditionalExpression[x^-2, x > 1], ConditionalExpression[1, x <= 1]} , {x, 0, 4}, PlotStyle -> Blue, Filling -> {2 -> {Axis, Red}, 3 -> {Axis, Purple}}]


4

A minor variation of Markus' method, applying the effect as a post process using ReplaceAll. Every Line in the graphics is replaced with two Lines: a thicker copy and the original. The key thing is to localise the additional directives to the extra Line by wrapping it in a list, so that subsequent primitives do not pick up the thickness and colour changes. ...


4

You could do this already with AdministrativeDivisionData and GeoGraphics on Raspberry Pi. In general - some taste of the future: divisions = EntityValue[Entity["AdministrativeDivision", {_, "Sweden"}], "Entities"] GeoGraphics[{EdgeForm[Red], Opacity[0.1], Polygon[divisions]}]


4

Your problem arises due to the following option in the final Show command: FrameTicks -> {{leftTicks, rightTicks}, {Automatic, Automatic}} Instead of {Automatic, Automatic} you should give explicit ticks specification taken from any of two DateListPlots (if they have identical ticks): FrameTicks -> {{leftTicks, rightTicks}, Options[smallPlot, ...


4

h = x^2 + y^2/9 + z^2/4 - 1; g = z; ContourPlot3D[{h == 0, g == 0, g == k}, {x, -1, 1}, {y, -3, 3}, {z, -2, 2}, MeshFunctions -> {Function[{x, y, z, f}, z]}, MeshStyle -> {{Thick, Blue}}, Mesh -> {{0, k }}, ContourStyle -> Directive[Orange, Opacity[0.5], Specularity[White, 30]]]



Only top voted, non community-wiki answers of a minimum length are eligible