Tag Info

New answers tagged

1

It is probably a bug in V10.02. In V10.1: Directive does not work on each individual element of the Graphics. If you want to use it then you can do it like this: VectorPlot[{1, 1}, {x, 0, 8}, {y, 0, 8}, VectorStyle -> {Arrowheads[0], Directive[Red, Thick]}] For the rest examples, they all work fine.


2

The differential equation, its initial condition, and its boundary conditions are translationally invariant in space. Consequently, the solution must be independent of x and y. Indeed, solving the equations as given in the Question does give a spatially constant solution that oscillates in time. For instance, DensityPlot[Evaluate[Re[A[x, y, 10000]] /. ...


5

I am answering my own question as I have discovered an undocumented Mathematica feature which does exactly what I wanted. While playing around with some plot options, I discovered that setting PlotTheme->"Monochrome" had precisely the effect that I wanted - it displayed only some of the edges of the box. So I started digging, and running ...


2

Graphics3D[{EdgeForm[{}], GraphicsComplex[front, MeshCells[DelaunayMesh[front], 2], VertexColors -> Hue /@ back]}] MeshCoordinates[DelaunayMesh[front]] == front (*True*)


0

Graphics[{Circle[{3,5},7], Circle[{5,6},3],Circle[{1,8},2]}]


4

Combine Plots with Show, and remember to use PlotRange -> All: Show[ Plot[x, {x, 0, 1}, PlotStyle -> Blue], Plot[x^2, {x, 1, 2}, PlotStyle -> Red], PlotRange -> All] Another option, as Karsten7. stated, is to use piecewise functions with non-numeric default value outside their domain: Plot[ {Piecewise[{{x, x < 1}}, Null], ...


-2

Plot[x^2, {x, 0, 1}, AxesOrigin -> {-1, -1}, PlotRange -> {{0, 1}, {0, 1}}]


0

You guessed right that one problem in your code is the missing definition of V. In the snippet you posted above, you defined a function V[X_, Y_, Z_, Len_, Br_, Dep_]. Later, you try to call it by writing D[V, x]. This does not work, because Mathematica distinguishes between V and V[X_, Y_, Z_, Len_, Br_, Dep_]. You can see this by looking into the down ...


1

Assuming $G=\rho=1$, move the gradient operator into the integral: $$ \begin{align} - \mathbf{g} = \nabla V(X,Y,Z) &= \nabla \int_{-D}^{D} \int_{-B}^{B} \int_{-L}^{L} \frac{{dx}'{dy}'{dz}'}{\sqrt{(X-{x}')^2+(Y-{y}')^2+(Z-{z}')^2)}} \\ &= \int_{-D}^{D} \int_{-B}^{B} \int_{-L}^{L} \nabla ...


1

If you use Mathematica 10: plotrange = {{0, 1}, {0, 1}, {-1, 1}}; edges = Composition[ Part[#, {8, 7, 4, 6, 2, 10, 9, 5, 1, 3, 11, 12}] &, Delete[#, List /@ {1, 5, 6, 9, 11, 15}] &, MeshPrimitives[#, 1] &, BoundaryDiscretizeRegion, Apply[Cuboid], Transpose ][plotrange]; Show[ Plot3D[ Sin[Pi*x]*Sin[2 Pi*y], {x, 0, 1}, ...


4

myData = {{2, 1, #}, {1, 1, 0}} & /@ Table[1/(n + 2) + .2 RandomReal[], {n, 1, 15}]; SectorChart3D[myData, BoxRatios -> {1, 1, 1}, ColorFunction -> Function[{x, y, z}, Hue[z]], ColorFunctionScaling -> False]


3

Update According to @xzczd in my comment: Simply removing the outermost braces will work, i.e. {0,0},{1,2},{5,3},{6,5}. Original Answer (0,0) (1,2) (5,3) (6,5) worked. To efficiently convert your lists to this form: convertlist[expr_] := StringReplace["(0,0) " <> ToString[expr], {"{{" -> "(", "}}" -> ")", "}, {" -> ") ("}] Comparing ...


0

Had to guess at ki and gamma : ki = 1 gamma = 3 Abar = (a/b)^(1/2); B = (2*(Abar - 1) + (4*Abar^2 + Abar + 4)^(1/2))/(3*(Abar)^(1/2)); T = a*(1 + 3/(4*B*Abar)); K = (B*(2*a)^(1/2) + (2*b)^(1/2))^(2*gamma); eq = K*x^gamma*(1 - 2*(1 + B^2)*x)^ki - T solutions = Flatten[Table[{a, b, N[x /. #]} & /@ Solve[eq == 0 && 0 < x < 1 ...


0

Update Here is a solution that I think provides a good way to visualize the singleton and paired solutions. data1 has two singleton solutions. data1 = { {{1., 1., x}, {1., 2., 0.132143, 0.294483}, {1., 3., 0.105496, 0.331848}, {1., 4., 0.0886402, 0.353948}, {1., 5., 0.0767417, 0.369095}}, {{2., 1., 0.185235}, {2., 2., 0.0794541, ...


7

A quick and dirty way to do this is to pad the image with pixels of some inoffensive color, so that the actual meaningful part of the image gets mapped to a smaller portion of the sphere: image = Import["ExampleData/ocelot.jpg"]; {width, height} = ImageMeasurements[image, "Dimensions"]; image = ImagePad[image, {{2 width, 2 width}, {height, height}}, White]; ...


2

ParameticPlot is what you are looking for. With[{r = 1}, ParametricPlot[r {2 π t - Sin[2 π t], 1 - Cos[2 π t]}, {t, 0, 2}]]


2

I have changed so solution and vector plot match: Subscript[\[Tau], yz] = -\!\( \*SubscriptBox[\(\[PartialD]\), \(x\)]\(\[CapitalPhi][x, y]\)\); Subscript[\[Tau], xz] = \!\( \*SubscriptBox[\(\[PartialD]\), \(y\)]\(\[CapitalPhi][x, y]\)\); vp = VectorPlot[{Subscript[\[Tau], xz], Subscript[\[Tau], yz]}, {x, 0, 1}, {y, 0, 1}]; \[CapitalOmega] = ...


1

Copying ybeltukov's RegionDistribution from How to generate random points in a region?, we get: reg = ImplicitRegion[0 <= x <= Pi/4 && Sin[x] <= y <= Cos[x], {x, y}]; region = DiscretizeRegion@reg; pts = RandomVariate[RegionDistribution[region], 5000]; // AbsoluteTiming ListPlot[pts, AspectRatio -> Automatic] (* {0.003288, Null} *) ...


2

1. I doubt there is an easier way than what you did. One can wrap it up in a function: ClearAll[markerMesh]; SetAttributes[markerMesh, HoldAll]; markerMesh[Plot[fns_List, {x_, x1_, x2_}, opts : OptionsPattern[]], markerOpts : OptionsPattern[]] := Show[ Plot[fns, {x, x1, x2}, Evaluate@FilterRules[{opts}, Except[{Mesh}]]], ListPlot[MapThread[ ...


3

testGraph = ListPlot3D[data, Mesh -> None, InterpolationOrder -> 3, ColorFunction -> "SouthwestColors", AxesLabel -> {Rotate["Number of Processes", - 20 Degree], Rotate["Number of Operations", 60 Degree], Rotate["Time (ms)", 95 Degree]}, ImageSize -> 450]


2

decibel is a relative unit. I'm pretty sure there is no implied standard reference in audio processing, (it looks like audiologists have a few go-to's e.g. dB HL, but I don't know what Audacity does). That said, you need a reference value. Since you're looking at FFT's the total power might be a good choice. Then decibels will tell you how strong a ...


0

Take your $y$ values (in a list myData) and convert them by the definition for decibels: 20 Log[10, #/Min[myData]] & /@ myData If your data is in the form of {{t1, v1}, {t2, v2}, ...} then in a simple (but inefficient) method: myData = {{3, 6}, {4, 8}, {5, 2}}; myMin = Min[myData[[All, 2]]]; fixedData = {#[[1]], 20 Log[10, #[[2]]/myMin]} & /@ ...


2

Another possibility is to use PlotRangePadding. Lets take 2012rcampion's answer Plot[x^2, {x, 0, 1}, AxesOrigin -> {-1, 0}, PlotRange -> {{0, 1}, {0, 1}}, PlotRangePadding -> {2, 0}] You can change the padding range to see when your axes are appearing.


1

Well, if you don't want to use FaceGrids (which can be pretty ugly), you could construct the box you want by hand: With[{xi = 0, xf = 1, yi = 0, yf = 1, zmin = -1, zmax = 1}, Show[Plot3D[Sin[Pi*x]*Sin[2 Pi*y], {x, xi, xf}, {y, yi, yf}, Boxed -> False], Graphics3D[{ GrayLevel[0.75], Line[1.02{ {xi, yi, zmin}, {xi, yf, zmin}, ...


6

Update: SeedRandom[123] d1 = BinormalDistribution[.75]; r = RandomVariate[d1, 20]; hg = Histogram3D[r, Automatic, "PDF", ChartStyle -> Opacity[.35]]; sh = SmoothHistogram3D[r, Automatic, "PDF", BoundaryStyle -> None, PlotStyle -> None, Mesh -> {{{.03, Directive[Thick, Orange]}, {.11, Directive[Thick, Red]}}}]; Row[{Show[hg, sh, PlotRange ...


3

Edit, based on the added info in the question: data1 = RandomVariate[BinormalDistribution[.75], 10]; distribution1 = SmoothKernelDistribution[data1]; data2 = RandomVariate[BinormalDistribution[.75], 10]; distribution2 = SmoothKernelDistribution[data2]; ContourPlot[ {PDF[distribution1, {x, y}] == 10^(-2), PDF[distribution2, {x, y}] == ...


3

Lest we forget the old-fashined ways: extremes=data[[Ordering[# data[[All,2]],1][[1]]&/@{-1,1}]]; DateListPlot[{data,##&@@(List/@extremes)}, Joined -> {True,False,False}, BaseStyle -> PointSize[Large], PlotStyle -> {Gray,Red, Green}, PlotLegends -> {"data", "max","min"}] Note: If data is not sorted, we need to sort it first ...


3

Do you care about maxima and minima or peaks? If peaks then you could use FindPeaks but this is only available for M10+. Note also that FindPeaks only handles regularly spaced TimeSeries - hence the use of TemporalRegularity: data = TimeSeries[{{{2015, 3, 25}, 130}, {{2015, 3, 26}, 132}, {{2015, 3, 27}, 132}, {{2015, 3, 30}, 133}, {{2015, 3, 31}, 132}, ...


8

Perhaps a bit more elegant than Sjoerd's approach: data = Sort @ data; (* address Sjoerd's concern *) pts = { data, MinimalBy[data, Last, 1], MaximalBy[data, Last, 1] }; DateListPlot[pts, Joined -> {True, False, False}, PlotStyle -> {Automatic, Red, Green} ]


1

I did a quick fix: tbl = Table[{Expr1, Expr2}, {\[Alpha], -1, 1, 0.25}]; leg = Table[\[Alpha], {\[Alpha], -1, 1, 0.25}]; Plot[tbl, {x, 0, 1}, PlotLegends -> leg] which seems to work:


4

Haven't aimed for efficiency or elegance but for 'straightforwardness' data = Sort@data; (* just to make sure the dates are always sorted *) max = Max@data[[All, 2]]; min = Min@data[[All, 2]]; maxPos = FirstPosition[data[[All, 2]], max] // First; minPos = FirstPosition[data[[All, 2]], min] // First; maxPlotPos = MapAt[AbsoluteTime, data[[maxPos]], 1]; ...


4

Here is an approach with Inset. From the documentation: Inset[obj,pos,opos,size,dirs] represents an object obj inset in a graphic... specifies that the inset should be placed at position pos in the graphic... aligns the inset so that position opos in the object lies at position pos in the enclosing graphic... specifies the size of the inset in ...


3

Update: ClearAll[showF] showF[tr_: {10, 10}, rt_: {-Pi/4, {0, 0}}, opts : OptionsPattern[{Graphics, Graphics3D}]][g_] := Module[{head = Head[g], pr = PlotRange[g], transF=Composition[TranslationTransform[tr], RotationTransform[rt[[1]], rt[[2]]]]}, Module[{prim = If[head === Graphics3D, Cuboid, Rectangle] @@Transpose[pr], points = ...


2

Here is an example. You have to be careful with the plot range so that the aspect ratio is just right, otherwise the figure is going to look skewed. transform = Composition[ TranslationTransform[{10, 5}], RotationTransform[45 Degree] ]; ListLinePlot[{ Table[transform@{x, Sin[x]}, {x, 0, 2 Pi, 0.1}], Table[{x, Sin[x]}, {x, 0, 2 Pi, 0.1}] }, ...


0

This is the sole purpose of RegionFunction: DensityPlot[Sin[10 x + 10 y], {x, 1, 2}, {y, 0, 1}, ColorFunction -> "SunsetColors", Frame -> True, FrameLabel -> {"x", "y"}, PlotLegends -> BarLegend[All, LegendLabel -> "Frequency"], RegionFunction -> Function[{x, y}, 0 < y < x/2] ] Edit Another way in V10 is R = ...


3

First our definitions: f[x_, y_] := Max[2 - (y - 1)^2, x + 1 - (y - 2)^2] Γ = Interval[{0, 4}] The definition of $G(x)$ is (adjusting the notation slightly): $$ \{y\in\Gamma:\forall_{z\in\Gamma}f(x,y)\geq f(x,z)\} $$ In English, this is The set of $y$ (in $\Gamma$) for which $f(x,y)$ is no less than $f(x,z)$ for any $z$ in $\Gamma$. We can make ...


0

No idea if this is the right thing to do, but here's my approach: red = Reduce[f[x, y] >= f[x, Interval[0, 4]], {x, y}] (* (x <= 0 && 0 <= y <= 2) || (0 < x < 4 && 0 <= y <= 2 + Sqrt[x]) || (x >= 4 && 0 <= y <= 4) *) For a first idea what's going on: ContourPlot[f[x, y], {x, -4, 4}, {y, -4, 4}] ...


1

One approach: p[ x_ ] := p /. First@FindRoot[ VF[x, p] - VL[x, p] == 0 , { p, 0.001 }] ParametricPlot[{p[x], x}, {x, .5, 5}, AspectRatio -> 1/GoldenRatio] Note this is somewhat fortuitous that we can pick an initial guess at p that consistently yields the first solution.. Another approach is to operate on the graphics generated by contour ...


4

Most of the desired plot can be achieved using only options Mesh and MeshFunctions. Plot[{Sin[x], Cos[x]}, {x, -0.01, 4.01}, MeshFunctions -> {If[Abs[Sin[#] - #2] < .001 && Abs[Cos[#] - #2] > .0001, Sin[# 2 Pi] + 1, Sin[# Pi] - 1] &}, Mesh -> {{{1, Directive[Red, PointSize[0.02]]}, {-1, ...


1

You can get a color gradient that is symmetric around zero using a custom Blend as the ColorFunction, plus ColorFunctionScaling -> False. DensityPlot[x + y , {x, -2, 2}, {y, -3, 2}, ColorFunction -> (Blend[{{-5, Green}, {0, White}, {4, Red}}, #] &), ColorFunctionScaling -> False] Knowing the minimum and maximum of the data range is ...


4

You can change the legend using the LegendMarkers option to an explicitly constructed LineLegend. The points are a bit of a hack, but you can always explicitly create them as an Epilog collection of points. I couldn't work out which colour scheme is the default in version 10, so I used the first indexed colour scheme, which replicates the default styles used ...


2

Plot is not really for discrete results like this, though one can harangue it into doing so. Better to use DiscretePlot or ListPlot, e.g.: Table[CountingFcn[SampleDats[[j, All]], r], {j, 1, Length[SampleDats]}, {r, 0, 13}]; ListPlot[%, Joined -> True, InterpolationOrder -> 0, DataRange -> {0, 13}]


4

I might be missing the point of the question but I think you just need _?NumericQ: ClearAll[CountingFcn] CountingFcn[dat_, r_?NumericQ] := Count[dat, u_ /; u < r]; This prevents the evaluation of the function until r is numeric. Now: PlotCountsEval[SampleDats, {0, 13}] Reference: PatternTest, NumericQ


1

As it is a polynomial family, here is an algebraic approach: family = x/a + y/b - 1 // Together // Numerator; constraint = a + b - 2; envsys = Flatten@{family, D[family, {{a, b}}] - λ D[constraint, {{a, b}}], constraint} (* {-a b + b x + a y, -b + y - λ, -a + x - λ, -2 + a + b} *) env = First@GroebnerBasis[envsys, {λ, a, b}] (* 4 - 4 x + x^2 - 4 y - 2 x ...


2

For the second part of your question (finding the envelope) we can use the argument from page 5 of these lecture notes. Basically the envelope is where two very close strings intersect each other. We can parameterize the string by: $$ \{x,y\} = \{x_1(t),y_1(t)\}(1-s) + \{x_2(t),y_2(t)\}s $$ Where the $\{x_i,y_i\}$ represent the two endpoints, $s\in ...


2

The second part of your question can be resolved as follows. First find the equation for any given line. y = k x + y0. Solve[{b == k * 0 + y0, 0 == k * a + y0, a + b == 2}, {k, y0, a}] {{k -> b/(-2 + b), y0 -> b, a -> 2 - b}} It is clear enough, that the bottom and leftmost boundaries are the x and y axes. Let's find the boundary on top. We ...


1

The first part of your question can be done using Plot f[a_, x_] := 2 - a - (2 - a) x/a Plot[Table[f[a, x], {a, .001, 2, .03}], {x, 0, 3}, PlotRange -> {{0, 2}, {0, 2}}, AspectRatio -> 1, Evaluated -> True] or Graphics with Line primitives: Graphics[Table[{Hue[RandomReal[]], Line[{{a, 0}, {0, 2 - a}}]}, {a, 0, 2, .03}], AspectRatio -> ...


3

Is this what you want? data = { {"a", "b", 1, 0.5, 4}, {"x", "y", 10, 100, 4.21} }; numericdata = data; numericdata[[All, 1]] = Range[1, Length[numericdata]]; (**) numericdata[[All, 2]] = Range[1, Length[numericdata]]; (**) ListPointPlot3D[ { numericdata[[All, {1, 2, 3}]], numericdata[[All, {1, 2, 4}]], numericdata[[All, {1, 2, 5}]] }, ...


1

The option value is ignored because DateListPlot calls Graphics`DateListPlotDump`iDateListPlot which only uses Options for these items: {PlotRange, AxesOrigin, GridLines, GridLinesStyle, Epilog, Prolog, Frame, Axes, Ticks, FrameTicks, DateTicksFormat, DateFunction, DataRange, PlotRangePadding, PlotLegends, PlotStyle, PlotMarkers, Joined, BaseStyle, ...


0

Use PieceWise to define your function: StreamPlot[{1, Piecewise[{{0.4 p (1 - p/30), 0 < t <= 5}, {0.4 p (1 - p/30) - 0.25 p, t >= 5}}]}, {t, 0, 10}, {p, -5, 5}]



Top 50 recent answers are included