Tag Info

New answers tagged

1

Not really a fancy answer but questions need to be answered and I hope this answers the (quite unclear) question. As mentioned in the comments the important parts in the following codes are Module, Panel for the Manipulate lookalike and Dynamic for the update. Since you mentioned that you were not using Plot here is an example with a Graphic entity. ...


6

Just define your own ColorFunction,e.g.,: MatrixPlot[{{1, 2, 1}, {3, 0, 1}, {0, 0, -1}}, ColorFunction -> (First@ Pick[{Red, Green, Blue, Orange, Black}, IntervalMemberQ[{Interval[{1, 2}], Interval[{2, 3}], Interval[{3, 4}], Interval[{0, 1}], Interval[{-Infinity, Infinity}]}, #]] &), ColorFunctionScaling -> False] ...


1

tr = Plotting[S, u, d, 4]; vt = {S, d^2 S*u^2, d^3 S}; MapAt[# /. fr:Framed[Alternatives@@ vt, ___]:> MapAt[Darker, fr, {{2, 1, 2}}] &, tr, {1}] or pos = Join @@ (Position[tr, Framed[#, ___]] & /@ vt); MapAt[Orange &, tr, Join[#, {2, 1, 2}] & /@ pos] or tr2 = tr; (tr2[[Sequence @@ #]] = Orange) & /@ (Join[#, {2, 1, 2}] & /@ ...


1

Your code can be made to work as you expect to by simplifying it. With[{imgSize = 300, nPts = 100}, Manipulate[ Grid[{ {k, Cos[1. k], ""}, {p, y = Cos[p], Sin[y]}, {Graphics[{ {Gray, Line[RandomReal[{-1, 1}, {nPts, 2}]]}, {Red, Disk[p, 0.05]}}, PlotRange -> {{-1, 1}, {-1, 1}}, ImageSize ...


2

As a warm up, let's find the PDF of XX. Now if we just do PDF[XX, x], Mathematica will seemingly spin forever, which one might think is caused by Integrate. Let's see if that's correct. First let's Print each time we Integrate: Block[{Integrate}, Integrate[e__] /; (Print[{e}]; False) := Null; PDF[XX, x] ] Ok so there is one integral, and notice we ...


5

The built-in ContourPlot3D seems fast enough for me: f = #3 Sin[10 #1]^2 + (1 - #3) #3 Cos[20 #2]^2 &; frange = Through@{NMinValue, NMaxValue}[{f[x, y, z], 0 <= x <= 1 && 0 <= y <= 1 && 0 <= z <= 1}, {x, y, z}]; AbsoluteTiming[ trigplot3d = ContourPlot3D[x + y + z == 1, {x, 0, 1}, {y, ...


2

While the order of the plots in Show makes difference, it is not the whole story. By default, many options are set automatically at the time of execution. In particular, PlotRange and AxesOrigin. The settings for Plot and ListPlot are determined separately since they are evaluated separately. This much I think can be inferred from the documentation, ...


0

Hmm, perhaps you just want to define a "function"? myLayout[plots_] := GraphicsGrid[{{plots[[1]], plots[[2]]}, {plots[[3]], plots[[4]]}}, ImageSize -> 500] This can then be called with: myLayout@plots


1

Format will remain same as the plotting data, i.e. you can specify a separate marker for each point: Table[ListLinePlot[ll[[i, 1 ;; 3]], PlotLabel -> i, PlotMarkers -> ll[[i, 1 ;; 3]]], {i, 3}]


5

One way would be by using PointLegend: ListPlot[Range[10], PlotMarkers -> {\[FilledCircle]}, PlotLegends -> Placed[PointLegend[{Red, Green}, Style[#, FontSize -> 20] & /@ {"A", "B"}], {Top, Right}], PlotStyle -> {Black}, Joined -> True, Mesh -> All, MeshStyle -> Red]


1

If you meant Sin[x], then I suppose something like Plot[Evaluate[Sin[x[t]] /. solution], {t, 0, 20}] is what you're after. In this case, the term "product" should be read as "composition." If, on the other hand, you meant to multiply the solution by Sin[t], then perhaps Plot[Evaluate[Sin[t] x[t] /. solution], {t, 0, 20}] will do. (Evaluate has to ...


3

In the examples you find: Plot[Evaluate[y[t] /. s], {t, 0, 30}, PlotRange -> All] Expand it like this for the product with Sin[t]: Plot[Evaluate[y[t] /. s] * Sin[t], {t, 0, 30}, PlotRange -> All]


7

1. If you need to change just the tick labels you can use FrameTicks as follows: rp1 = Module[{n = 300, p = 0.29}, RegionPlot[{y > (1/2)*(n - x) && y + x <= n && y > p/(1 - p)*x}, {x, 0, n}, {y, n, 0}, FrameLabel -> {"x", "y"}, PlotStyle -> {Directive[Yellow, Opacity[0.5]]}, FrameTicks -> {{{#, ToString[300 - ...


4

Here's some sample data along the lines of what I think you're using: {data1, data2, data3, data4, data5} = Table[{#, i} & /@ RandomVariate[NormalDistribution[i, i], 100], {i, 5}]; Now when we generate a 3D histogram with 10 bins, we get gaps: Histogram3D[{data1, data2, data3, data4, data5}, 10] The reason for this is that your bin ...


3

Make the width 1: f[{{xmin_, xmax_}, {ymin_, ymax_}, {zmin_, zmax_}}, ___] := Cuboid[{xmin, ymin, zmin}, {xmax, ymin + 1, zmax}]; Histogram3D[N@{Data1, Data2, Data3, Data4, Data5}, 10, Boxed -> False, FaceGrids -> {Bottom, Front, Left}, ChartStyle -> "Pastel", ChartElementFunction -> f, Ticks -> {Automatic, None, Automatic}, ...


3

Significant manual cleaning was required for block of data in post. The data: data = {{{"ID", "Day", 1., 2., 3., 4., 5., 6., 7., 8., 9., 10., 11., 12., 13., 14., 15., 16., 17., 18., 19., 20., 21., 22.}, {"H. sapiens", 1., 145.7, 153.2, 164.6, 161.1, 170.8, 191.7, 179.2, 178.5, 198.5, 169.9, 135.8, 182.8, 205.3, 210.3, 197.3, 238.4, ...


1

reorgdata = GatherBy[data[[1]], #[[2]] &][[2 ;;, All, 3 ;;]]; variances = Thread[Variance /@ reorgdata]; means = Thread[Mean /@ reorgdata]; Row[{ListPlot[means, PlotLabel -> "means", ImageSize -> 300], ListPlot[variances, PlotLabel -> "variances", ImageSize -> 300]}]


0

Image[RegionPlot[{Cos[x^2 y] > 0, Sinc[x y + x y^2] <= 0.3}, {x, -1, 1}, {y, -1, 10}]] Then you can deal with a image object instead of a graphics object


5

Here is a very simple, step-by-step way to go about solving your problem. z[t_] := {1, t^2, t^3} Norm[z[t]] Sqrt[1 + Abs[t]^4 + Abs[t]^6] Those absolute values are going to give us trouble, so lets get rid of them. You want to plot over the range 0 to 5, so we can assume t ≥ 0. nz[t_] = Simplify[Norm[z[t]], Assumptions -> t >= 0] Sqrt[1 + ...


10

You're running into two issues. We'll start with the one that is causing the messages. By default Plot avoids symbolic evaluation of your function, and uses numeric evaluation instead. For example, it may evaluate at t=1.23: D[D[z[1.23],1.23],1.23] and then D complains that 1.23 isn't a valid variable and returns D[D[{1, 1.5129, 1.8608669999999998}, ...


6

You could set up a dynamic VertexRenderingFunction that allows you to change the colors of your vertices with a click. colorClickVRF[colors_List] := Function[{pos, name}, Module[{i, len}, i = 1; len = Length[colors]; DynamicModule[{ backColor = Lighter[First[colors]], frameColor = Darker[First[colors]]}, ...


1

The plots you are producing by adding PlotLegends all have Head of Legended. So the closest to what you already have would be to do the following: Legended[ ContourPlot[ Cos[x]+Cos[y],{x,0,4 Pi},{y,0,4 Pi}, ContourShading->None ], Placed["example",{0.8,0.1}] ] This produces an output that is of the same type as your plot with contour shading ...


8

One easy way is to replace the style of the specific nodes in the final tree. Let's make a function for it: colorize[tree_, nodes_List] := With[{patt = Alternatives @@ nodes}, tree /. Framed[p : patt, style_, r2___] :> Framed[p, style /. c_RGBColor :> Darker[c], r2] ] Now you can do t = Plotting[S, u, d, 4]; colorize[t, {S, d^2 S*u^2, d^3 ...


3

I don't think this is entirely unexpected since PlotLegends is meant to depict what the colours mean. You switch off the colours and the plot legend disappears. The canonical way to leave the "example" in place is to use an epilog: p = ContourPlot[Cos[x] + Cos[y], {x, 0, 4 Pi}, {y, 0, 4 Pi}, ContourShading -> None, Epilog -> Text["example", ...


2

Plot[{x^-2, UnitStep[1 - x], Boole[x > 1] x^-2}, {x, 0, 4}, PlotStyle -> Blue, Filling -> {3 -> {{2}, {Purple, Red}}}]


1

Another workaround is to create the plot as normal and then delete all the Polygon expressions: ContourPlot[Cos[x] + Cos[y], {x, 0, 4 Pi}, {y, 0, 4 Pi}, PlotLegends -> Placed["example", {0.8, 0.1}]] // DeleteCases[#, _Polygon, -1] &


6

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}}]


2

Let me give a workaround myself after some attempts. It is only a workaround thus other answers are appreciated! ContourPlot[Cos[x] + Cos[y], {x, 0, 4 Pi}, {y, 0, 4 Pi}, PlotLegends -> Placed["example", {0.8, 0.1}], ColorFunction -> (White &)] This works. In other words, here the contour shading is not turned off, but instead colored as ...


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[]}]


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}}]]


0

I guess this could be solved by defcol[n_] := ColorData[1, "ColorList"][[n]]; Legended[Plot[{Sin[x], Sin[x]^2, Cos[x]}, {x, -2 \[Pi], 2 \[Pi]}], Placed[LineLegend[ {defcol[1], defcol[2], defcol[3]}, {"S", "S2", "C"}, LegendLayout -> "Row"], {0.5, -0.1}]] The position of Legend is defined by option {0.5, -0.1} This could be applied for any ...


4

What you see is Moiré pattern Closely related topic with 2D case: Using high RasterSize changes contour pattern Worth to add that the patterns does not seem to have a translation symmetry because the projection is not parallel. You can compare it with distant ViewPoint case: ListPointPlot3D[ Table[{n, s, (Prime[n]^s/(Prime[n]^s - 1))}, {n, 1, 2000}, {s, ...


3

It looks to me like you've got some inconsistency in your VertexNormals. This can certainly happen with numerically generated functions though, as others have rightly pointed out, it's hard to say for sure without some more specific info. Here's a simple way to force this sort of thing to happen. (* A list of vertices to feed to Polygon *) pts = ...


1

There seem to be at least two issues here: You are not resetting ExtractionCon = {} inside the outer Do loop, therefore Divided1 grows longer than Partition1 With (1) corrected you will get a different error (repeated): Set::setraw: Cannot assign to raw object 3. >> because the x* Symbols now have values, and they evaluate before the assignment is ...


2

Short Answer Clear[Derivative] first. Long Answer OK, it's surprising that there seems to be no regular answer to this common problem for beginners, let me elaborate my comment into an answer. If you restart your Mathematica and run your code again then you'll find your problem no longer exists anymore! Then, why? Because Mathematica is unstable? Of ...


3

Based on the discussion in chat among Kuba halirutan and Michael Hale: trajnormal = RandomFunction[PoissonProcess[1], {0, 100}]["PathFunction"]; trajdiscount = RandomFunction[PoissonProcess[5], {0, 100}]["PathFunction"]; Clear[show] show[1, t_, step_] := ListLinePlot[ {#, 50 - trajnormal[#]}\[Transpose] & @ Range[0, t, step], ...


1

I can't make heads or tails of above, but perhaps this will get you started. Read the documentation - it's your best source of information. First, let's get some solution from NDSolve : sol = NDSolve[{u''[t] + u[t] == 0, u[0] == 0, u'[0] == 1}, u, {t, 0, \[Pi]}] (* {{u->InterpolatingFunction[{{0.,3.14159}},<>]}} *) So, NDSolve has given us a ...


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. ...


3

If I understand you correctly you want to show the label "0.2" at the $z$-value 5. The option Ticks allows you to do this. Here is an example: Plot3D[ 5 Sin[x y], { x, 0, π}, { y, 0, π}, Ticks -> { Automatic, Automatic, {-5, -3, 0, {5, "0.2"}}}]


4

Like noted in the comments the problem is that Manipulate[ListLinePlot[{OutputResponse[discLowPass[T, τ], dataNoise]}], {{T, .1}, .005, 25}, {{τ, .005}, .001, .025}] doesn't work while the following works: Manipulate[ListLinePlot[OutputResponse[discLowPass[T, τ], dataNoise]], {{T, .1}, .005, 25}, {{τ, .005}, .001, .025}] ...


1

What is going on? By Trace-ing the ContourPlot3D, I found the warning (on my MMA) comes from a function System`ProtoPlotDump`findextreme (Hereafter, the context System`ProtoPlotDump` will be omitted for readability): findextreme[{f_, {x_, xmin_, xmax_}, {y_, ymin_, ymax_}, {z_, zmin_, zmax_} }] := ...


0

I got a result using Mathematica 9.01 . It is possible that you have an older version or missing libraries. Install flash in your computer to see if this might have to do with the graphic diver.


4

To answer your main question, I generated the coords as specified: coords = Flatten[ Array[(Characters@"abc")[[#]] <> ToString@#2 -> {#, #2} &, {3, 4} ], 1] {"a1" -> {1, 1}, "a2" -> {1, 2}, "a3" -> {1, 3}, "a4" -> {1, 4}, "b1" -> {2, 1}, "b2" -> {2, 2}, "b3" -> {2, 3}, "b4" -> {2, 4}, "c1" -> {3, 1}, "c2" ...


2

I solved more general system linked by @SjoerdC.deVries in the comments reproducing figure 3 and 4 - to prove it is correct. You can simplify this to version you need. Clear["Global`*"] al = 2; a = 2/1000; k = 600; b = 1/10; g = 46/10^5; c = 1/100; m = 1/100; E1 = 1; q1 = 2/10; E2 = 813/1000; q2 = 2/100; Tf = 300; eqs = { x'[t] == al x[t] (1 - ...


1

I really don't understand why Show behaves this way with LogPlots. Anyway a way out is to manually extract the the ticks from the plots: logShow[a__Graphics, opts : OptionsPattern[Show]] := With[{ft = (FrameTicks /. #[[2]])[[1, 1]] & /@ {a}}, Show[{a}, FrameTicks -> {All, Join @@ ft}, Evaluate[opts]] ] and although this is probably easy ...


2

I can't think of a way to do this without indexing the data. If that's not a problem, the following will do: With[{ indexed = MapIndexed[ {Sequence @@ #2, #1} &, Sin[0.5 Range@100] /. {a_?Negative -> Missing[]} ] }, ListPlot[ SplitBy[ indexed, NumericQ@Last@# & ], Joined -> True, InterpolationOrder -> 2 ...


1

You could just do without Missing: ListPlot[Cases[{#, Sin[0.5 #]} & /@ Range[100], {_, _?NonNegative}], Joined -> True]


3

You can display zero crossing using MeshFunctions. Here is a clumsy exploitation from created graphic. The half-periods (difference between consecutive points) are displayed below with mean in red. x1plot = ListPlot[x1data, AxesLabel -> {"t", "x1"}, Joined -> True, MeshFunctions -> (#2 &), Mesh -> {{0.}}, MeshStyle -> {Red, ...


1

You can use an appropriately defined MeshFunction as per your constraint equation. For every t you should then get a line on the sphere. If you don't want the sphere to be visible you can change the opacity to zero in the relevant option. Here I've chosen the constants a, b, c so that the constraint equation has a solution: Manipulate[ Module[{a = 1, b = ...


0

As you have one constraint equation, your surface $\vec{x}(\theta,\phi,t)$ is in fact parametrized by two parameters only. In this simple case you could solve $$ \cos\theta+a(\phi+bt)^2+c=0 $$ and get $$ \theta=\arccos(-a(\phi+bt)^2-c) $$ Then, by inserting it in $\vec{x}$ you see that $\vec{x}=\vec{x}(\phi,t)$, which can now be readily plotted.



Top 50 recent answers are included