Hot answers tagged

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


10

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


10

This should do it: Plot[Tan[x], {x, -2 π, 2 π}, Exclusions -> Range[-3 π/2, 3 π/2, π], ExclusionsStyle -> Directive[Gray, Dashed, Arrowheads[{}]], PlotStyle -> Arrowheads[0.04 {-1, 1}], Ticks -> {Range[-2 π, 2 π, π/2], Automatic}] /. Line -> Arrow


6

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


6

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

I tested on 10.2 and 10.4. I recommend just using the tick labels from some other plot and overlaying the data using Show. With minimal changes to your example I got following proof of principle. plist = {#, 1. Log[#! + 1]} & /@ {.1, .5, 1, 5, 10, 50, 100, 500, 1000, 5000, 10000, 50000, 100000}; Show[{LogLogPlot[0, {x, .1, 10^5}, PlotRange -&...


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


5

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


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


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


4

Given $d\in\mathbb{N}_0$, the Taylor series about $x=i/2^d$ is a polynomial of degree at most $d$ for all $i\in\mathbb{Z}$. Let $S_d$ be the set of such Taylor series. There exist polynomials $pol_0,pol_1,\ ...\ ,pol_d$ of degree $0,1,\ ...\ ,d$ such that every $s\in S_d$ has the form $$s(x)=\sum_{i\ =\ 0}^dc_i(x)\ pol_i(\Lambda(2-2^{i+1}(x\bmod 2^{1-i}))/...


4

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


4

Nice find. I think that this is simply giving the equivalent of a DataRange over the z (density) values. Put another way it is providing the third parameter of Rescale: That lets us conveniently do something like this: DensityPlot[ x, {x, -12, 0}, {y, -1, 1} , ColorFunctionScaling -> {385, 745} , ColorFunction -> "VisibleSpectrum" ] ...


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


4

Here is one way to convert the ticks into the desired format: ListLogLogPlot[plist, PlotRange -> {{.1, 10^5}, {10^-1, 10^6}}, Joined -> True] /. {v_, t_?NumberQ, l1_, {AbsoluteThickness[0.1]}} :> {v, NumberForm[N@t, NumberFormat -> (Superscript[#2, #3] &), ExponentFunction -> (# &)], l1, {AbsoluteThickness[0.1]}} With ...


4

You can also change Lines to Arrows using PlotStyle as follows: Plot[Tan[x], {x, -2 π, 2 π}, Exclusions -> Range[-3 π/2, 3 π/2, π], ExclusionsStyle -> Directive[Gray, Dashed], PlotStyle -> ({Arrowheads[{-.05, .05}], Arrow @@ #} &), Ticks -> {Range[-2 π, 2 π, π/2], Automatic}]


3

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


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


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


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


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


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


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


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


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


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[ω_, τ_] := ...


2

Using custom tick labels still works, but one has to use the logarithmic label position, as this conversion is no longer done automatically for custom tick labels. ListLogLogPlot[plist, PlotRange -> {{.1, 10^5}, {10^-1, 10^6}}, Ticks -> {Table[{N@Log[10^i], Superscript[10, i]}, {i, -1, 5}], Table[{N@Log[10^i], Superscript[10, i]}, {i, -1,...


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


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



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