New answers tagged

1

Ok, thanks to @xslittlegrass for the hint. So, the solution omega = 2 Pi; a = 0.1; b = 0.2; c = 300; n1 = 10^(-4); n2 = 10^(-7); k1 = n1 omega/c; k2 = n2 omega/c; r = 0.25; z = r Pi/ (k1 - k2); s = 10; ParametricPlot[{2 a Cos[omega t - 0.5 (k1 + k2) z - 0.5 (k1 - k2) z] , 2 b Cos[omega t - 0.5 (k1 + k2) z + 0.5 (k1 - k2) z] }, {t, 0, 2 Pi/omega}] ...


3

If you want to stick with one call to ListPlot and all of your data have the same time limits, something like this might work. ListPlot[Flatten[{Transpose[x], MovingAverage[#, 180] & /@ Transpose[x]}, {2, 1}], DataRange -> {0, 46}, Joined -> True, Frame -> True, FrameLabel -> {{"x (m)", ""}, {"t (sec)", ""}}, ImageSize -> Large] ...


3

As a quick and dirty answer: time = Table[t/60, {t, 1, 2726}] // N; x = Get@"http://pastebin.com/raw/7xwgGDsd"; (* make these data TemporalData *) td = TemporalData[Transpose[{time, #}] & /@ Transpose[x]]; $PlotTheme = "Scientific"; Show[ { ListLinePlot @ td, ListLinePlot[ MovingMap[ Mean, td, Quantity[180, "Events"] ], ...


4

Just for fun: data = Tally @ raw Note: raw is your original data Graphics[{{PointSize @ Abs[#[[2]]/50], Tooltip[Point @ #[[1]], #[[1]]]} & /@ data}, Axes -> True] Output:


9

First use Tally to count the number and then use BubbleChart. data1 = Tally[data] /. {{x_, y_}, z_} :> {x, y, z} BubbleChart[data1]


1

Unfortunately, I can't comment due to lack of reputation, so I hope I might be excused for writing as an answer what should be a comment. I'd like to have a link to your posted scatter plots. They look to me like either experimental results from particle physics experiments or numerical simulation data from theoretical particle physics, Standard Model for ...


2

Here is a generic answer. Let say you have a function f[x] and you want to make a noisy plot out of it. f[x_] := Sin[x]; list1 = Table[{Y, f[Y]}, {Y, 0., 12, 0.01}]; ramp = 0.2 (*noise amplitude*) list2 = Table[{Y, f[Y] + RandomReal[{-ramp, ramp}]}, {Y, 0., 12, 0.01}]; Show[ListPlot[list2, Frame -> True], ListLinePlot[list1, Frame -> True, PlotStyle ...


2

You will want to set the automatic rescaling of the data passed to ColorFunction, then write your own ColorFunction that appropriately rescales the data so that a $z$ value of 25 is translated to an input of $0.5$ to the TemperatureMap color function: ParametricPlot3D[ yourFunction, yourParamValues, ColorFunctionScaling -> False, ColorFunction ...


11

region = ImplicitRegion[ 0 < z < 4 - x*y && 0 <= x <= 2 && 0 <= y <= 1, {x, y, z}]; RegionPlot3D[region, BoxRatios -> {1, 1, 1}, Axes -> True] Volume[region] (* 7 *) RegionMeasure[region] (* 7 *) Integrate[1, {x, 0, 2}, {y, 0, 1}, {z, 0, 4 - x*y}] (* 7 *) Integrate[1, Element[{x, y, z}, ...


3

The option LegendMargins can be used to significantly reduce the spacing. This option can be added directly to LineLegend plots = Table[ Plot[x i, {x, 0, 1}, PlotStyle -> {Hue[i/11]}, PlotLegends -> LineLegend[{"Serial " <> ToString[i]}, LabelStyle -> {FontFamily -> "Times", 10}, LegendMargins -> {0, 0}], ...


2

Just to get you started: cpoly = First[Cases[ChromaticityPlot[{}], _GraphicsComplex, ∞]]; xy2uv = LinearFractionalTransform[{DiagonalMatrix[{4, 6}], {0, 0}, {-2, 12}, 3}]; planckLocus[t_?NumericQ] := With[{planck = 1/((Exp[1.43877696*^7/(# t)] - 1) #^5) &}, Normalize[({{1.0478112, 0.022886602, -0.050126976}, {0.029542398, ...


1

Use Hue[h,s] to distinguish between groups via h and within groups via s: pts = {{{0.10, 485}, {0.22, 495}, {0.35, 500}}, {{0.94, 739}, {2.95,814}}, {{3.47, 802}}}; saturationList = {1, .5, .2, .5, .3, .7}; sl = MapIndexed[Thread[{#2[[1]], #}]&, Internal`PartitionRagged[saturationList, Length /@ pts], {1}]; newpts = Style[{#, ...


2

Here is a kick --- sunday --- answer p1 := Plot[Sin[x], {x, 0, 1}] p2 := Plot[Cos[x], {x, 0, 1}] GraphicsGrid[{{p1}, {p2}}] Export["Where you want\\name of the file", pasted GraphicsGrid] You may copy the GraphicsGrid on clicking on the vertical bar


1

I think it will be better to use Graphics pts = {{{0.10, 485}, {0.22, 495}, {0.35, 500}}, {{0.94, 739}, {2.95, 814}}, {{3.47, 802}}}; saturationList = {.5, .2, .5, .3, .7}; col = {Red, Blue, Green, Brown}; Graphics[Table[{PointSize[Large], Lighter[col[[i]], saturationList[[#]]], Point[pts[[i]][[#]]]} & /@ Range[Length[pts[[i]]]], {i, ...


3

g1 = Graph[{Dog -> Apple, Apple -> Screwdriver}, VertexLabels -> "Name", GraphLayout -> "CircularEmbedding", ImagePadding -> 40] g2 = GraphComplement[UndirectedGraph[g1], VertexLabels -> "Name", ImagePadding -> 40, VertexCoordinates -> GraphEmbedding[g1]] Using GraphPlot GraphPlot[AdjacencyMatrix[g2], ...


2

Perhaps, ClearAll[inpField] inpField[arg_, fs_: 5] := InputField[arg, FieldSize -> fs, Background -> Yellow, Appearance -> "Frameless"] Interpretation[{f = {-y, -2 x}, xmin = 0, xmax = 1, ymin = 0, ymax = 1}, Panel@Row[{"StreamPlot[", inpField[Dynamic[f], 12], ", \n ", Invisible["StreamPlo"], "{x, ", inpField[Dynamic[xmin]], ",", ...


2

Manipulate[Plot[Piecewise[{{ξ x^2, x <= 1/(2 ξ - 1)}, {x, x > 1/(2 ξ - 1)}}], {x, 0, 5}, GridLines -> {{{1/(2 ξ - 1), Directive[Thick, Red]}}, {}}, Epilog -> Text[Framed[ToString@Round[1/(2 ξ - 1), .1], Background -> Orange], {1/(2 ξ - 1), -.5}], PlotRangePadding -> .9], {{ξ, .7}, ...


3

Sometimes, you may not want to reconstruct the legend from scratch then you can extract the legends from the plots, and make adjustments on them, for example p=Show[plots, PlotRange -> All]; opt = First@Cases[plots[[1]], LineLegend[x_List, y_List, opt__] :> {opt}, ∞]; lgd = LineLegend[ Sequence @@ Transpose[ First@Cases[#, ...


6

Update 2: Post-processing plots without having to create a new legend: Legended[Show[plots[[;; , 1]], PlotRange -> All], Column[Join @@ plots[[;; , 2, All, 1]], Spacings -> -.8]] Legended[Show[plots[[;; , 1]], PlotRange -> All], Placed[Column[Join @@ plots[[;; , 2, All, 1]], Spacings -> -.8], {Before, Top}]] Original post: Use the ...


2

I differ from xslittlegrass on what you want the label to be. I would modify your code like so: Manipulate[ With[{threshold = 1/(2 ξ - 1)}, Show[ Plot[ Piecewise[{{ξ x^2, x <= threshold}, {x, x > threshold}}], {x, 0, 5}], Graphics[ {HalfLine[{threshold, 0}, {0, 1}], Text[Round[threshold, .01], {threshold, ...


3

One way is to add a text element in the graphics object: Manipulate[ Show[Plot[ Piecewise[{{ξ x^2, x <= 1/(2 ξ - 1)}, {x, x > 1/(2 ξ - 1)}}], {x, 0, 5}], Graphics[{Line[{{1/(2 ξ - 1), 0}, {1/(2 ξ - 1), 25}}], Text["label", {1/(2 ξ - 1), 0}]}]], {ξ, 0, 1, Appearance -> "Labeled"}]


2

If you want to simplify generating the input these are simpler ways: x = Range[4]; y = Partition[ Range[7], 4, 1]; then you can use Inner: z = Inner[List, x, y, List]; and finally ListPlot[z] Instead of playing with Partition and Range you can generate the input of ListPlot with Table: z = Table[{i, i + k - 1}, {k, 4}, {i, 4}]; or even better ...


1

Your problem with conditionals can be fixed by evaluating your terms under the assumption that t ∈ Reals. For example, A = 14*(1 + I); As = 14*(1 - I); Ω = 2*Pi*0.01*10^6; X = 10^7; k = 2*Pi*0.1*10^6; n = -1.425; s[t_] = Assuming[t ∈ Reals, Integrate[((2*k)*(4*X*X*A*A*As*As)*E^(I*ω*t))/ ((2*I*X*As*As*2*I*X*A*A + (-4*I*X*A*As - k - I*ω + ...


0

However, the third one with AspectRatio->Automatic is totally wrong. But we can see the legend bar is exactly the same, it conform with horizontal width, thought it should be confirm with image height!! I see this behavior quite logical: you have specified the horizontal width only, so the size of the legend is now determined by what you have ...


0

Here is a workaround that is valid for version 8. Before PlotLegends was introduced I would simply make a DensityPlot when I needed a color bar to use as a legend: r[θ_, ϕ_] := 1/((Sin[θ]^4* Cos[ϕ]^4*0.049896792) + (2*(Sin[θ]* Cos[ϕ])^2*(Sin[θ]* Sin[ϕ])^2*(-0.01555592)) + (2*(Sin[θ]* ...


0

Here is a method that will work in version 9, although it requires you to install the CustomTicks package. Here is a BoxWhiskerChart using the normal linear scaling: SeedRandom[420]; data = RandomVariate[ RayleighDistribution[RandomInteger[500]], {8, 50}]; bwc = BoxWhiskerChart[data, "Outliers", ChartStyle -> 56] Here is the log-scaled chart you ...


0

This is not straightforward. You have some hope of stumbling into approximately correct results because of the aggressively decreasing exponentials in your sum, but I make no promises that you can get any particular degree of precision. You should probably construct little machines for each $n$ that sequentially produce values of $\beta_{n,k}$ for ...


3

If you use a number instead of Automatic for the AspectRatio option, it seems to work: ContourPlot[Sin[x y], {x, 0, 3 Pi}, {y, 0, Pi}, Contours -> 5, PlotLegends -> Placed[BarLegend[Automatic], Right], AspectRatio -> 1/2, ImageSize -> 200] Since AspectRatio->Automatic simply determines the ratio by the plot range, one can make an easy ...


5

I think this is a bug due to the creation of an improper SparseArray for the Raster of the ArrayPlot. ap = ArrayPlot[{{0}}, ColorFunction -> Function[a, RGBColor[a, a, a]], ColorFunctionScaling -> False]; {sa} = Cases[ap, _SparseArray, Infinity] The normal expression Normal[sa] {{0.}} looks OK, but InputForm[sa] ...


3

Show[ListContourPlot[#, Contours -> {0}, ContourShading -> None, ContourStyle -> Directive[Thick, #2]] & @@@ {{list1, Red}, {list2, Green}}]


3

If I understand your question correctly, here is a possible approach to extracting the {x, y} list of values corresponding to the zeroes of your function when the function is only available through data points. First of all, I will generate a data list, since you did not provide one. Let's consider for instance the following function as an example: f[x_, ...


2

You can first find all the roots by their z value, and then select out the first point that touches zero. For example: ε0 = 1.*^-3; ListPlot[Table[ First /@ SplitBy[ Sort[Select[ls, Abs[#[[3]]] < ε0 &][[All, 1 ;; 2]]], First], {ls, {list1, list2}}], PlotRange -> All]


5

DynamicModule[{n = 20}, Column[{Row[{Slider[Dynamic[n], {1, 100, 1}], Dynamic[n]}], Dynamic[Legended[PieChart[Thread[Style[#[[All, 2]], #[[All, 1]] /. {True -> Red, False -> Green}] ], ChartStyle -> {Green, Red}] &@ Tally@RandomChoice[{True, False}, n], SwatchLegend[{Green, Red}, {False, True}]]]}]] ...


0

Here is the fixed notebook. Your main problems were that the third elements of the first argument in ListContourPlot were imaginary and that you switched two values in Part in fsingle. In the notebook, I highlighted lines I have changed and wrote why I changed them in the comments (there were some inefficiencies). However, please try to post your actual ...


4

The Red/Green problem stems from the fact that Tally returns tallied values in the order each element is first encountered, and the other issue is because Tally doesn't return a 0 entry for elements not in the list. Both issues can be solved with a custom tally: explicitTally[list_,toTally_List] := {#, Count[list, #]} & /@ toTally; If you use ...


4

In recent versions PlotTheme -> "Monochrome" may suit your needs: Plot[{Sin[t], Sin[2 t], Sin[3 t]}, {t, 0, 2 π}, PlotLegends -> {"t=1", "t=2", "t=3"}, PlotTheme -> "Monochrome"] dat = Table[{Sin[t], Sin[2 t], Sin[3 t]}, {t, 0, 2 π, 0.1}]\[Transpose]; ListLinePlot[dat, PlotLegends -> {"t=1", "t=2", "t=3"}, PlotTheme -> "Monochrome"] ...


3

You can use PlotMarker in ListPlot to do that data = Table[ Table[{t, f[t]}, {t, 0, 2 π, π/10}], {f, {Sin[#] &, Sin[2 #] &, Sin[3 #] &}}]; ListPlot[data, Joined -> True, PlotLegends -> {"t=1", "t=2", "t=3"}, PlotMarkers -> Automatic] Or something like ListLinePlot[data, PlotLegends -> {"t=1", "t=2", "t=3"}, ...


1

You can use ScalingFunctions. It appears in red but works. ParametricPlot[{{x, Erfc[x]}, {x, Erf[x]}}, {x, .05, 10}, PlotRange -> All, ScalingFunctions -> {"Log", Identity}, Frame -> True, AspectRatio -> 0.6]


0

The specifics of your plot don't matter so much here, just that you can make a ParametricPlot but you really want a LogLinearPlot from it. This is most easily done if you simply extract the line from the plot, and feed it to ListLogLinearPlot plotToLogLinearPlot[plot_, opts : OptionsPattern[]] := ListLogLinearPlot[ Cases[ plot, Line[x__] :> x ...


1

ContourPlot[{4 x == 3 y, {x, y} ∈ Integers}, {x, 0, 20}, {y, 0, 20}, ContourStyle -> Thin, Epilog -> {Red, AbsolutePointSize[6], Tooltip[Point[#], #] & /@ ({x, y} /. Solve[{4 x == 3 y, 0 <= x <= 20, 0 <= y <= 20}, {x, y}, Integers])}]


3

Inspection of the InputForm of the generated plot reveals that a function is used to generate the labeling rectangles: DisplayFunction :> (FormBox[ FrameBox[ StyleBox[ StyleBox[ PaneBox[#1, Alignment -> Left, AppearanceElements -> None, ImageSizeAction -> "ResizeToFit"], LineIndent -> 0, StripOnInput ...


4

The ways listed work perfectly well, but you can save yourself a couple of keystrokes just by doing myList[[;;;;2]] If you don't provide starting and ending points for the first ;;, Mathematica is kind enough to assume that you want to go from the beginning (1) to the end (-1). For my tastes, at least, this looks a little nicer too. (It'll auto-format ...


7

You can use Part (also written [[...]]) to get what you want. For example, myList= Table[{i, i}, {i, 1, 20}]; ListPlot[myList] ListPlot[myList[[1;;-1;;2]]] (* every second point *) ListPlot[myList[[1;;-1;;3]]] (* every 3rd point*)


3

w = w0 (1 + z^2/zR^2); w1 = 100 200*^-6; w0set = 2*^-6; λ0 = 632*^-9; Ixy2 = FullSimplify[ComplexExpand[(.5 Exp[I (k x + Δϕ)] + .5 Exp[I l ArcTan[y, x]])*Conjugate[.5 Exp[I (k x + Δϕ)] + .5 Exp[I l ArcTan[y, x]]]]]; Grating0 = Ixy2 /. {k -> 11 2 π/λ 0/8, w0 -> w0set, zR -> π w0set^2/λ0, z -> 10*^-4, p -> 0, l -> 0, r -> Norm[{x, y}], Δϕ ...


2

Using ClipPlanes and ClipPlanesStyle Animate[Graphics3D[Cuboid[{2, -2, -1}, {-2, 2, 3}], ClipPlanes -> -{-t, -t, 1, 0}, Boxed -> False, ClipPlanesStyle -> Directive[Yellow, Opacity[0.5], Specularity[White, 30]] ], {{t, -0}, -3, 3}, AnimationRunning -> False]


1

As others pointed out, you have not defined flapDragon as a function of a variable t, you've defined it as a symbol with a single DownValue for the symbol t. Notice that this does not work, Plot[Evaluate@flapDragon[tt], {tt, 0, 0.02}] That's because flapDragon[tt] is not defined. I still wonder why Evaluate works The reason it works is that Plot ...


5

zmax = 20; r = 1 Animate[Show[Graphics3D[Cone[{{0, 0, 0}, {0, 0, 2}}, r]], Graphics3D[{PointSize[.05], Point[{1.1 r (zmax - v)/zmax Sin[v], 1.1 r (zmax - v)/zmax Cos[v], 2 v/zmax}]}], ParametricPlot3D[{r (zmax - z)/zmax Sin[z], r (zmax - z)/zmax Cos[z], 2 z/zmax}, {z, 0, zmax}, PlotStyle -> {Thick, Blue}], Axes -> True, PlotRange -> ...


2

The WriteString in your loop form should be: WriteString[path, 0.01*i, " ", 1/((y[30]^2 + y[30 - Pi/2]^2)) /. First@s, "\n"] This gives you no { } in the file and Imports properly. You could also use Write: Write[path, 0.01*i, OutputForm[" "], 1/((y[30]^2 + y[30 - Pi/2]^2)) /. First@s] That said its usually preferable to generate ...


1

The easiest workaround is to use Table[Labeled[ ListVectorPlot[data[[i]], PlotRange -> All, VectorColorFunction -> Function[{x, y, vx, vy, n}, ColorData["Rainbow"][Rescale[n, {min, max}]]], VectorColorFunctionScaling -> False, ImageSize -> 300], BarLegend[{"Rainbow", {min, max}}, ImageSize -> 300], {{Right, Center}} ...


2

Make a function to select $n_x,n_y,n_z$ from the $i^{th}$ data set p[i_, n_] := d2[[i, All, n]] Another function to select all the time component t[i_] := d2[[i, All, 1]] Combine them properly for ListPlot data[i_, n_] := Partition[Riffle[t[i], p[i, n]], 2] For the $n_x$ component put $n=2$. Similarly you can plot it for $n=3,4$ ...



Top 50 recent answers are included