Tag Info

2

There are some things that bother me in Johu's solution, so I am offering this alternative, which seems both simpler and better to me. This works with versions of Mathematica older than V10. RAveList = RandomReal[1, {11, 5}]; colors = ColorData[97]; labels = Row[{#, "-clusters"}] & /@ Range[2, 12]; ListPlot[Thread[Tooltip[RAveList, labels]], Joined -&...

0

Somewhat similar to J.M.'s but using Bezier curves instead of B-splines. simpsonSegment[{{x1_, y1_}, {x2_, y2_}, {x3_, y3_}}] := FilledCurve[ {Line[{{x1, 0}, {x1, y1}}], BezierCurve[{{x1, y1}, {x2, 1/2 (-y1 + 4 y2 - y3)}, {x3, y3}}], Line[{{x3, y3}, {x3, 0}}]} ]; Manipulate[ Plot[f, {x, a, b}, PlotStyle -> {Red, Thick}, AxesOrigin -&...

3

Your example has several problems, why people can not directly run it. For example you have not provided RAveList and you use it as it was a function. I assume it is an array, but the answer can be easily adjusted. Here is an example of the labels you wanted. RAveList = RandomReal[1, {25, 5}]; selection = 2 ;; 15; labels = Array[StringTemplate["-clusters"]...

3

Use Part to subtract intensity and Transpose to align with the wavelength data: wavelength = Range[350, 750, (400/3647)]; withMagnet = Transpose[{wavelength, RandomReal[1, 3648]}]; withoutMagnet = Transpose[{wavelength, RandomReal[1, 3648]}]; (*The above code just simulates your imported data*) diff = Transpose[{withoutMagnet[[All, 1]], ...

5

Using custom Arrowheads (instead of Epilog) may be slightly more flexible: ah1 = Arrowheads[{{-0.05}, {0.015, 1, Graphics@{EdgeForm[Blue], White, Disk[]}}}]; ah2 = Arrowheads[{{0.05, 1}, {0.015, 0, Graphics@ Disk[]}}]; pw = Piecewise[{{-x^2, x < 1}, {x + 1, x >= 1}}]; This can be used with a combination of MeshFunctions and MeshShading: Plot[pw, {...

5

Use Table old[τ_] := Sin[τ] new[α_, χ_, τ_] := Sin[α τ]^2 + Cos[χ τ]^2 result = Table[Plot3D[ new[α, χ, τ] - old[τ], {α, 0, 2 π}, {χ, 0, π}, MaxRecursion -> 0, AxesLabel -> Automatic] , {τ, 1/10, 1, 1/10}] Export["result.gif", result] Or use Animate Animate[Plot3D[ new[α, χ, τ] - old[τ], {α, 0, 2 π}, {χ, 0, π}, MaxRecursion -> 0, ...

4

Just for fun, here is a variation of C. E.'s animation, which demonstrates that an epicycloid can be constructed as an envelope of the diameter of a rolling circle: With[{n = 3, r = 1, m = 31}, Animate[ParametricPlot[ReIm[(n + 1) r E^(I t) - r E^(I (n + 1) t)], {t, 0, 2 Denominator[n] π}, Axes -> None, ...

0

According to solution of Dr. Belisarius I wrote this more convenient code: (* default options needed for error plot *) Options[errListPlot] = { Filling -> {1 -> {2}}, Joined -> {False, False, True}, PlotStyle -> {Black, Black, Directive[Opacity[0.6], Blue]}, FillingStyle -> Black, PlotMarkers -> {Graphics@Line[.04 {{-1, 0}, {...

4

a bit of a hack.. ipart = 0; Plot[Piecewise[{{-x^2, x < 1}, {x + 1, x >= 1}}], {x, -2, 3}, PlotStyle -> Blue, Epilog -> {Blue, Arrowheads[{-0.02, 0.02}], PointSize[Large], Point[{{1, -1}, {1, 2}}], {White, PointSize[Medium], Point[{1, -1}]}}, AxesLabel -> {"x", "y"}, PlotRange -> {{-2.5, 3}, {-4.5, 4}}, GridLines -&...

1

One way of plotting 4d data is with: DensityPlot3D[ Re[new[α, χ, τ] - old[τ]], {χ, 0, π}, {α, 0, 2 π}, {τ, 0.1, 1}, PlotPoints -> 11] To do this with manipulate, it is wise to do all the calculations first, and storing the values in a dataset. data = Table[ Table[{α, χ, Re[new[α, χ, τ] - old[τ]]}, {χ, π/ 16, π, π/8}, {α, 0, 2 π, ...

2

Updated using mem: as suggested by Simon Woods. Perhaps using Plot3D at a couple of intervals of tau will be enlightening. The results seems plausible based on the fact that old is a 1D function. ClearAll["Global*"] G = 0.01; β = 1; ωc = 50; j = 1; ϕ = 0; θ = π/2; η = Exp[I ϕ] Tan[θ/2]; Clear[ψ] ψ[α_, χ_] := Exp[I α]*Tan[χ/2]; integralgamma[ω_, τ_] := ...

1

Example Show[{ ListLinePlot[Table[(1/x)^3/(Sqrt[\[Pi]]) N[MeijerG[{{-5/2, -2}, {}}, {{2, -2}, {-3}}, 1/x]], {x, 10}]], ListLinePlot[Table[172 (1/y)^(9/2)/(5760000000 Sqrt[\[Pi]]) N[MeijerG[{{-5/2, -2}, {}}, {{2, -2}, {-3}}, 1/y]], {y, 10}]] }, Frame -> True ] Output

0

The command given before editing the question and before my answer was: Manipulate[ Plot3D[new[α_, χ_, τ_] - old[τ_], {α, 0, 2 π}, {χ, 0, π}], {τ, 0, 1}] My answer is: Manipulate[ Plot3D[Evaluate[new[τ, α, χ]] - Evaluate[old[τ]], {α, 0, 2 π}, {χ,0, π}], {τ, 0, 2}]

3

Update fns = Table[{a*x, a*x^2}, {a, 5}]; cd = Flatten@Table[{ Directive[ColorData[97, c], Thick], Directive[ColorData[97, c], Dashed] }, {c, Length[fns]}]; Plot[Evaluate@fns, {x, 0, 6}, PlotStyle -> cd, PlotRange -> All, PlotLabels -> Automatic] fns = Table[{a*x, a*x^2}, {a, 5}]; psA = Table[Directive[ColorData[97, c], ...

0

This bug seems to affect different versions differently, so more than one workaround is needed. Here is another workaround that does not work in version 10.3.1, but it does work on other versions. GeoRegionValuePlot[vals, GeoRange -> {{-60, 75}, {-130, 165}}, GeoBackground -> None, ColorRules -> Flatten@Union[({# -> colfoo@#} & /@ vals[[...

1

That's a funky bug. As JasonB points out in the comments, this can be reduced to a two-country example: GeoRegionValuePlot[ { Entity["Country", "UnitedStates"] -> -1, Entity["Country", "India"] -> 0 } , GeoRange -> {{-60, 75}, {-130, 165}} , ColorFunctionScaling -> False , ColorFunction -> (Blend[{{-1, Red}, {0, Yellow}}, #] &) ...

0

Let's say data1 and data2 are your imported data data1 = Flatten[Table[{Sin[p] Cos[q], Sin[p] Sin[q], Cos[p]}, {p, 0, Pi, Pi/10}, {q, 0, 2 Pi, Pi/10}], 1]; data2 = Flatten[Table[2 {Sin[p] Cos[q], Sin[p] Sin[q], Cos[p]}, {p, 0, Pi, Pi/10}, {q, 0, 2 Pi, Pi/10}], 1]; ndata = Length[data1]; Now use Graphics3D to plot ...

4

I can't follow what you wrote, but I made small example. Using If it checks which function selected, uses SetOptions[Plot... to set the options Manipulate[ If[f === Cos, SetOptions[Plot, {PlotStyle -> Red, Frame -> True}], SetOptions[Plot, {PlotStyle -> Blue, Frame -> False}] ]; Plot[f[x], {x, -2 Pi, 2 Pi}], {f, {Sin, Cos}} ]

3

Commenting out incomplete code and making up definitions for z and sq, this works: z = Sin; sq = Sign@*Cos; opt = {(*Exclusions\[Rule]DeleteDuplicates[Flatten[Table[{d+(n-1)*ct, d+(n-1)*ct+swt,d+n*ct},{n,1,nct}]]],*)PlotStyle -> Orange, AxesLabel -> {"μs", "V"}}; opt2 = {Exclusions -> All, ExclusionsStyle -> Dotted, PlotStyle -> ...

0

Another color table: colTable = Flatten@{Table[Black, {x, 0, 12, 1}], Table[{Blend[{Blue, Green, Yellow, Red}, x]}, {x, 1/10, 1, 1/10}], Table[Black, {x, 24, 256, 1}]} ArrayPlot[ImageData[image], ColorFunction -> (Blend[colTable, #] &), PlotLegends -> Automatic, FrameTicks -> All] Colorize[image, ColorFunction -> (Blend[...

9

Edit Can you think of another way to accomplish the same thing [...]? It would be nice to have a solution that didn't involve duplicating each slider. -nibudd DynamicModule[{a = 1, tempA = 1, auto = True} , ifAuto = Dynamic[ If[auto, Identity, Setting]@#, TrackedSymbols :> {auto} ] &; Column[{ ifAuto @ Dynamic @ Plot[Sin[...

2

Update After reviewing the referenced paper, Zeno and anti-Zeno effects on Dephasing, I discovered that the summation range should be {-$J,J$} for both $m$ and $p$. The graph now shows $J=1$ and $J=2$ as depicted in the paper. ClearAll["Global*"] G = 1/100; β = 1; ωc = 50; ϕ = 0; θ = π/2; η = Exp[I ϕ] Tan[θ/2]; integralgamma[ω_, τ_] := 4 G ω Exp[-ω/ωc]...

3

Adding some decoration on JasonB's answer Do[data[i] = Table[{x, i Sin[i x]}, {x, 0, Pi, Pi/50}], {i, 10}] This is going to be your imported files layer[data_, n_, col_] := {Opacity[0.5], col, EdgeForm[Black], Polygon[data /. {x_, z_} :> {x, n, z}]} Graphics3D[Table[layer[data[i], i, Hue[i/10]], {i, 10}], PlotRange -> {...

12

Based on the comment by Szabolcs I came up with a solution. Here it is xyText[str_, scaling_: 1, offset_: {0, 0, 0}] := Module[{ mesh = DiscretizeGraphics[ Text[Style[str, FontFamily -> "Monospac821 BT"]], _Text, MaxCellMeasure -> 1] }, MeshPrimitives[mesh, 2] /. {x_?NumberQ, y_?NumberQ} :> (scaling {x, y, 0} + offset) ...

3

Clear[η, a, b, s] η[r_, s_, a_, b_] := s (r^((1 - 3 b)/b) E^(-r/(a b))) Manipulate[ Plot[η[r, s, a, b], {r, 0, 10}, PlotRange -> All], {{s, 0.8}, 0, 1, Appearance -> "Labeled"}, {{a, 0.7}, 0.1, 1, Appearance -> "Labeled"}, {{b, 0.05}, 0.001, 0.1, Appearance -> "Labeled"} ] Regarding your original code, when you want to format/...

3

One could override the setting for each polygon group (or GraphicsGroup[]): cp /. p_Polygon :> {Lighting -> {{"Ambient", White}}, p} cp /. gg_GraphicsGroup :> {Lighting -> {{"Ambient", White}}, gg} Update: Addendum. While Lighting shows up in Options@ChromaticityPlot3D, it is not listed among the options in the docs for ChromaticityPlot3D....

5

If you look at the InputForm of ChromaticityPlot3D[{"WideGamutRGB", "sRGB"}] you'll find several spots where it says Lighting -> "Neutral" So if you want to change that, you'll have to modify the output of ChromaticityPlot3D using a replacement rule. Here is an extreme example, one that totally ruins the plot but shows how to change the lighting, ...

1

The difficulty of doing numerical calculation with the 4th power as opposed to the square is immense. This easily demonstrated by doing a couple of exact computations. With[{x = (12/10)*10^15}, Exp[-((x - (121/100)*10^15)^2/(2*10^25))]] 1/E^5 With[{x = (12/10)*10^15}, Exp[-((x - (121/100)*10^15)^4/(2*10^25))]] 1/E^500000000000000000000000000 ...

2

No legend for this slight simplification of Kuba's proposal, but it can be easily added if desired: RegionPlot[True, {x, -3, 3}, {y, -3, 3}, Background -> Black, BoundaryStyle -> None, ColorFunction -> Function[{x, y}, Hue[(Arg[x + I y] - Pi/2)/Pi, 1, 1, (x^2 + y^2) Exp[1 - x^2 - y^2]]], ...

4

Edit Table Case Kuba, can you add also a solution for tables instead of functions, because in fact I have something like this: table1 = Table[(x^2 + y^2) Exp[-x^2 - y^2], {x, -3, 3}, {y, -3, 3}], table2 = Table[ArcTan[x, y], {x, -2.999, 3}, {y, -3., 3}] – Mushegh { table1 = Table[(x^2 + y^2) Exp[-x^2 - y^2], {x, ##}, {y, ##}], table2 = ...

3

If you are willing to do a fair amount of work you can edit your original plot by manually altering the y values and tick marks for the y-axis. Here is your plot plot = ParametricPlot[{x^4, x}, {x, 0, 5}, PlotRange -> {Automatic, Automatic}, Axes -> False, ImageSize -> 500, Frame -> True, FrameLabel -> { {Style["x", FontSize -&...

1

This appears to be a bug. Try for example this modified version of @Mr.Wizard's suggestion: Graphics[Inset[ Framed[Style[111, 30, Red], FrameStyle -> Red, Background -> Directive[White, Opacity[0.5]], ImageMargins -> 70], {25, 0}, {Center, -1.2}], Background -> Black] On Mac OS X, this screen shot shows that the notebook initially ...

2

A Copy-Paste of (or a shameless plagiarism to mark the question answered) link suggested by m_goldberg http://reference.wolfram.com/language/example/SimulateABouncingBall.html h = 20; a = 0.7; t0 = 10; (*time of flight*) ball[t_] = y[t] /. NDSolve[{y''[t] == -9.81, y[0] == h, y'[0] == 0, WhenEvent[y[t] == 0, y'[t] -> -a y'[t]]}, y, {t, 0, t0}][[1]...

3

It looks like this is an issue in version 10. In version 9 PlotRange in ErrorListPlot works as expected: ErrorListPlot[yWithErrors, Joined -> True, PlotStyle -> {Blue}, Epilog -> {PointSize[Large], Point[Transpose[{x, y}]]}, PlotRange -> All, Frame -> True, FrameLabel -> {{"y", ""}, {"x", ""}}, BaseStyle -> {FontSize -> 20, ...

1

Use Table as in your question but add 2-> Bottom to the list. Join[Table[n -> {n - 1}, {n, 3, 5, 1}], {2 -> Bottom}] (* {3 -> {2}, 4 -> {3}, 5 -> {4}, 2 -> Bottom} *) Plot[{i, 4, 6, 8, 10}, {i, 0, 10}, Filling -> Join[Table[n -> {n - 1}, {n, 3, 5, 1}], {2 -> Bottom}]]

3

I guess you're looking for something like this: wave[x_, y_, x0_, y0_, l_, t_] := Sin[Sqrt[(x - x0)^2 + (y - y0)^2]/l + t]; Manipulate[ DensityPlot[ wave[x, y, d, 0, l1, t l1 l2] + wave[x, y, -d, 0, l2, t l1 l2], {x, -100, 100}, {y, -100, 100}, Mesh -> 10, PlotPoints -> 50], {d, 5, 20}, {l1, 5, 20}, {l2, 5, 20}, {t, 0, 1}] d ...

4

Actually I think what you need is ColorFunction and ColorFunctionScaling. In ColorFunction you can set the color in different regions according to the points' {x,y,z} coordination. And I think what you need is just setting some part in a color (in my code, Bed) and the other in another color(in my code, Blue). Then, simply create a function discribing this ...

3

A recommendation to the question poser: Pose your question in the absolute simplest terms, limiting to the minimal example that addresses your point. There is no need here, for instance, for the community to have to download a complicated data set in order to see how to color one part of a plot differently from others. Why do we need to incorporate text ...

2

(All observations apply to version 10.1.0.) ErrorListPlot is written in as a rather straightforward post-processing of ListPlot, with error bar values first assigned to and then retrieved from a definition upon ErrorBarPlotsPrivateerror (hereafter notated error). A definition is made as a side-effect within a replacement rule: {x_?NumericQ, y_?NumericQ, ...

2

One simple option: ListDensityPlot[mydata, ColorFunction -> (Blend[{{-10, Blue}, {0, White}, {5, Red}}, #] &), ColorFunctionScaling -> False, PlotLegends -> Automatic] A simple way to control blend: minLegend = Min[mydata[[;; , -1]]]; maxLegend = Max[mydata[[;; , -1]]]; spdLegend = 2; cf = Blend[{{minLegend , Blue}, {minLegend / ...

2

Reference: Part ListLinePlot[{myMatrix[[All,1]],myMatrix[[All,2]], ...}] data = {{1, 5, 10}, {1, 5, 10}, {1, 5, 10}, {1, 5, 10}, {1, 5, 10}}; ListLinePlot[{data[[All, 1]], data[[All, 2]], data[[All, 3]]}]] Or for a compact, universal solution (Courtesy of J.M.) ListLinePlot[Transpose[myMatrix]]

2

Example ListPlot[ numbers, Filling -> Axis, Ticks -> {numberedTicks, None}, ImageSize -> Large ] Note: numberedTicks as in original post. Output Reference Ticks

2

Formatting clean-up and removing redundant Evaluate and Dynamic. In addition, tmax and c begin at 1 as opposed to 0. Manipulate[{ sol = NDSolve[{x''[t] + c*Sin[x[t]] == 0, x'[0] == a[[1]], x[0] == a[[2]]}, x, {t, 0, tmax}]; Plot[Evaluate[{x[t]} /. sol], {t, 0, tmax}, PlotRange -> All, PlotStyle -> {Thick, Red}]}, {c, 1, 10}, {tmax, 1,...

6

In this case, your Ticks apply to both the x and y axis. The only substitution that can be made using these tick rules is for the value 1 on your range. To leave the y axis alone you can set the ticks to default or sub in your own new rules: ListPlot[numbers, Filling -> Axis, Ticks -> {numberedTicks, Automatic}, ImageSize -> Large]

-1

Perhaps this is a possible answer: Clear[a, b, c, tMax, x, t]; tMax = 20; sol = ParametricNDSolveValue[{x''[t] + c*Sin[x[t]] == 0, x'[0] == 0, x[0] == 2.96706}, x, {t, 0, tMax}, {c}] Plot[Evaluate[Table[sol[c][t], {c, 0, 10, 1}]], {t, 0, tMax}, PlotRange -> All] With Manipulate also added, perhaps this can be done: Clear[a, b, c, tMax, x, t]; ...

9

When I decide to automate a special kind of plot, I try to produce something that can handle more than the particular special case I have at hand. For this question, I think the following makes a good start. SetAttributes[myPlot, HoldAll] myPlot[expr_, hlines : {__}, domain_, opts : OptionsPattern[]] := Module[{n, fills, plt}, n = Length[hlines] - 1; ...

5

Here is a solution via Epilog and graphic primitive Rectangle[] Plot[{i, 4, 6}, {i, 0, 10}, Epilog -> {Opacity[0.3], Lighter@Red, Rectangle[{0, 0}, {10, 4}], Lighter@Blue, Rectangle[{0, 4}, {10, 6}]}]

7

Plot[{i, 0, 4, 6, 8, 10}, {i, 0, 10}, Filling -> Table[n -> {n - 1}, {n, 3, 6, 1}]] Plot[{i, 4, 6, 8, 10}, {i, 0, 10}, Filling -> Flatten[{Table[n -> {n - 1}, {n, 3, 6, 1}], {2 -> Bottom}}]] or Plot[{i, 4, 6, 8, 10}, {i, 0, 10}, Filling -> Table[n -> {n - 1}, {n, 2, 6, 1}] /. {1} -> Bottom // Evaluate]

6

Check out Plot for reference. Use {} to define multiple functions to be plotted and Filling for the shading. Plot[{i, 4, 6}, {i, 0, 10}, Filling -> {3 -> {2}, 2 -> Bottom}]

0

Since documentation for RegionPlot[] contains no examples nor synopses that describe how RegionPlot should be have on a region or a list of regions/Graphics primitives, I don't think one can say authoritatively that a list of disks is a nonstandard argument. RegionPlot[] does accept a list as a single region to be plotted, and it treats it in a reasonable ...

Top 50 recent answers are included