Tag Info

New answers tagged

1

With some random data fhat = RandomReal[{-1, 1}, {1000, 4}]; One can get a BoxWhiskerChart with the value of the mean placed below each box and grid lines with BoxWhiskerChart[Transpose[fhat], "Mean", BarOrigin -> Left, LabelingFunction -> (Placed[Mean[#], Below] &), GridLines -> Automatic] Or with specified vertical grid lines, no ...


5

Looking at the rather dismal automatic placement of contour labels in the example Sin[x y], I thought it may be worth pointing out that you can often get better results with customized placement. For this, I devised a function burnTooltip in this answer. Here is how to use it for this question: Options[burnTooltips] = {ImageSize -> 360, ...


2

f[x_, y_] := Sin[x y] ContourPlot[f[x, y], {x, -2, 2}, {y, -2, 2}, ContourLabels -> All] Or if you want only some of them: f[x_, y_] := Sin[x y] ContourPlot[f[x, y], {x, -2, 2}, {y, -2, 2}, ContourLabels -> (If[Abs@#3 <= .25, Text[#3, {#1, #2}]] &)]


1

eq = { x'[t] Sin[y[ t]] + x[t] y'[t] a == 1, y'[t] Cos[x[t]] - y[t] x'[t] b == 1} sol = ParametricNDSolve[{eq, x[0] == 1, y[0] == 1}, {x, y}, {t, 0, 1}, {a, b}] Manipulate[ ParametricPlot[{x[a, b][t], y[a, b][t]} /. sol, {t, 0, 1}, AspectRatio -> 1], {a, 0.5, 1}, {b, 0.5, 1}]


0

NIntegrate x (y^3 + 1)^(1/2) over Polygon[{{0, 0}, {6, 2}, {0, 2}}]: NIntegrate [x (y^3 + 1)^(1/2), {x, y} \[Element] Polygon[{{0, 0}, {6, 2}, {0, 2}}]] Answer:26.


2

f[x_, y_] = x (y^3 + 1)^(1/2); Plot3D[f[x, y], {x, 0, 6}, {y, x/3, 2}, Filling -> 0] Plot3D[f[x, y], {x, 0, 6}, {y, 0, 2}, RegionFunction -> Function[{x, y}, x/3 <= y <= 2 && x >= 0], Filling -> 0] RegionPlot3D[0 <= z <= f[x, y] && x/3 <= y <= 2 && 0 <= x <= 6, {x, 0, 6}, {y, 0, 2}, ...


1

In V10: Plot3D[x (y^3 + 1)^(1/2), {x, y} \[Element] Polygon[{{0, 0}, {6, 2}, {0, 2}}], AxesLabel -> Automatic]


1

Several methods. one of them is: Plot3D[x (y^3 + 1)^(1/2), {x, 0, 6}, {y, 0, 2}, RegionFunction -> Function[{x, y}, y <= 2 && y >= 3 x && x >= 0]]


4

The short answer is there is no solution. The problem alluded to in the tutorial is that the derivative expression -Sqrt[y[x]^3] (or equivalently y[x]^(3/2)) is discontinuous in a complex neighborhood of y[0] == -2. The discontinuity arises from the branch-cut choice in Mathematica. As for NDSolve, it fails to complete a solution because it tries to ...


1

One problem is that HeavisidePi[x] is undefined for $x=\pm\frac{1}{2}$, and a second one is that Mathematica's function plot routines often do not like discrete functions. The following code tackles both problems (the odd step size takes care of the undefined positions): DiscretePlot3D[w[x, y], {x, -2, 2, .10001}, {y, -5, 5, .10001}, PlotRange -> ...


2

Let's call $u=f_1(x)$ and $v=f_2(y)$. Do you want to plot $g(u,v)=1$ against $x$ and $y$, or $g(x,y)=1$ against $u$ and $v$? @bill's answer does the former. Here's a way to do the latter: Use ParametricPlot, and define the contour using MeshFunctions. f1[x_] := Log[1 + x] f2[y_] := Exp[y] - 1 g[x_, y_] := x^2 + y^2 ParametricPlot[{f1[x], f2[y]}, {x, -1.2, ...


3

It's simpler than you fear. First the command is ContourPlot... for a simple g, this will give you the circle of radius 1. g[x_, y_] := x^2 + y^2; ContourPlot[g[x, y] == 1, {x, -2, 2}, {y, -2, 2}] Now say you have the two functions f1 and f2 f1[x_] := Log[x]; f2[y_] := Exp[y]; ContourPlot[g[f1[x], f2[y]] == 1, {x, -2, 2}, {y, -2, 2}] Now you get the ...


2

Insert a Null (or anything that's not a real number) where you want a gap. ListLinePlot[{{0, 0}, {1, 0}, {2, 0}, Null, {3, 5}, {4, 6}, {5, 7}}]


0

if you want specifically "ThermometerColors" then try this: color = ColorData["ThermometerColors"][#] & /@ Range[0, 1, .1]; ListLinePlot[ Table[{{-test[[i, 1]] Cos[test[[i, 2]] Degree], -test[[i, 1]] Sin[ test[[i, 2]] Degree]}, {test[[i, 1]] Cos[test[[i, 2]] Degree], test[[i, 1]] Sin[test[[i, 2]] Degree]}}, {i, 1, 10}], ...


1

For a start I think you may need to use SetDelayed (:=) instead of Set (=). Then be careful with the spaces, a b c (the product of three different variables) is not the same as abc (a single variable). Then porbably you want something like this: ClearAll[a, b, c, d, e, f, g, h, i, j, k] Panel[Grid[{{Style["Inputs", Bold], SpanFromLeft}, {"a:", ...


1

Try: f[x_] := 2 Log[-0.5 x + 2] - 1 Plot[f[x], {x, -5, 5}] Plot[{Re[f[x]], Im[f[x]]}, {x, -5, 5}, PlotLegends -> "Expressions", PlotStyle -> {Blue, Red}, PlotRange -> Full]


2

There are some good links about this topic https://reference.wolfram.com/language/ref/Plot.html http://reference.wolfram.com/language/howto/PlotFunctionsOfOneVariable.html http://reference.wolfram.com/language/howto/PlotFunctionsOfTwoVariables.html http://reference.wolfram.com/language/howto/PlotAGraph.html Plot[-2 x^2 - 4 x - 3, {x, -10, 10}] f[x_] := ...


0

This is very rudimentary implementation of what I think you are asking for. I also added PerformanceGoal -> "Speed" to the VectorPlot to prevent the movement of the plot when clicking. The idea is to sore the plots in a buffer with a counter telling how many there are. A button is used to clear the buffer. Manipulate[ tick; Module[{solveEqn, sol, ...


20

First define the Morse code (from rosettacode.org with corrections by @evanb) morsecode = (#1 -> Characters[#2]) & @@@ { {"a", ".-"}, {"b", "-..."}, {"c", "-.-."}, {"d", "-.."}, {"e", "."}, {"f", "..-."}, {"g", "--."}, {"h", "...."}, {"i", ".."}, {"j", ".---"}, {"k", "-.-"}, {"l", ".-.."}, {"m", "--"}, {"n", "-."}, {"o", "---"}, ...


2

I'll use a simpler form for an example. One can keep track of the least value that has given an error/warning message in a variable. It can be set whenever a message is generated using Check. The use of Quiet is optional. You may want to limit the messages that trigger a Check or that are suppressed by Quiet. See their documentation for more. I also ...


3

Try this idea: Plot[If[x < 0, Integrate[Exp[x*z^2], {z, -\[Infinity], \[Infinity]}], None], {x, -1, 1}] Within this example you will get the following plot: Have fun!


3

It seems AxesOrigin property spoils everything. A bug maybe.. I can suggest 2 way outs: first, simply: Graphics3D[{arrowAxes[3], Sphere[{1, 1, 1}]}, Axes -> True, Boxed -> False, AxesEdge -> {{0, -1}, {0, -1}, {0, -1}}, AxesStyle -> Opacity[0], TicksStyle -> Opacity[1]] This gives what you want, but i don't know how to specify the ...


1

I just changed your code a little bit, to TickStyle->None arrowAxes[arrowLength_] := Map[{Apply[RGBColor, #], Arrow[Tube[{{0, 0, 0}, #}]]} &, arrowLength IdentityMatrix[3]]; Graphics3D[{Sphere[{1, 1, 1}], arrowAxes[3]}, Axes -> True, Boxed -> False, AxesOrigin -> {0, 0, 0}, AxesStyle -> Opacity[0], TicksStyle -> None]


17

Your comment raises interesting question: I got everything simply faded and flat, while in the example - its all bright and sharp I think the problem is related to the fact that Mathematica's graphical functions always work in linear colorspace. Starting from Pickett's solution with better resampling method, in version 10.0.1 we obtain: ...


6

You tried to decrease the width of the lines to below the minimum width. In order to achieve the same effect you can increase the size of the image instead. x = RandomReal[1, 10000]; y = RandomReal[1, 10000]; Show[ImageResize[Rasterize@ListLinePlot[{Thread@{x, y}}, ImageSize -> 10000], 300], ImageSize -> 300]


9

On-screen, lines are always at least 1 pixel wide in Mathematica, regardless of the thickness setting. Not sure what you tried with Opacity, as it seems to be possible to achieve the same effect: PlotStyle -> Directive[AbsoluteThickness[1], Opacity[.05]]


1

make use of ContourPlot to find solutions.. dat = Table[ {#[[1]], #[[2]], 1 - #[[1]] - #[[2]]} & /@ Select[ Cases[ ContourPlot[ Abs[ b - a] == ( sig - 2 (1 - b - a ) + 1 )^.35 , {a, 0, 1}, {b, 0, 1}] , List[a_Real, b_Real] :> { a, b } , Infinity] , #[[1]] + ...


2

Perhaps this is your aim: tsv = ImportString["0,000000000E0 1,237909063E1 3,333333333E-2 1,237909063E1 6,666666667E-2 1,237909063E1 1,000000000E-1 1,240163557E1 1,333333333E-1 1,267077663E1 1,666666667E-1 1,309703315E1 2,000000000E-1 1,363531527E1 2,333333333E-1 1,390445633E1 2,666666667E-1 1,448782832E1 3,000000000E-1 ...


4

You can specify the decimal point using the Numberpoint option, like described here: Import["file.txt", "Table", "NumberPoint" -> ","]


5

You have the import. dates = Import["http://www.sudomemo.net/statistics/firstSeenDump.php", "JSON"] Gather them up by day and count how many in each day. dailyGather = GatherBy[dates, Take[DateList[#], 3] &]; dailyVisits = {Take[DateList[dailyGather[[#, 1]]], 3],Length[dailyGather[[#]]]} & /@ Range[First@Dimensions[dailyGather]]; Plot the ...


5

You're about to realize that derivatives in the real world are a pain. You have to aggregate data as much as possible and average it a lot until you get a "textbook-quality second-derivative! dates = DateList /@ Import["http://www.sudomemo.net/statistics/firstSeenDump.php", "JSON"] Grouping by days and counting: datesDays = Tally@dates[[All, ;; 3]]; ...


2

Use #3 instead of #. See the RegionFunction -> docs, "Details" section- f[x_] := Sin@ x g[x_] := x^2; ParametricPlot[{g@x, f@x}, {x, 0, 3}, RegionFunction -> (! 1 < #3 < 2 &), AspectRatio -> 1]


2

A common approach to removing outliers is to use an order statistic filter. The simplest of these is the MedianFilter: x = data[[All, 1]]; ySmoothed = MedianFilter[data[[All, 2]], 5]; ListPlot[Transpose[{x, ySmoothed}]]


2

ContourPlot[Min[(-7 + 100 t - x) (5 + 100 t - x), (400 t^2 + 40 t (-5 + x) + (-5 + x) (7 + x))], {t, 0, .05}, {x, -1, 5}, PlotRange -> All, Exclusions -> None] Exclusions->None fixes the issue in both version 9 and 10: Without the Exclusions->None option, I reproduce the issue in both versions (Windows 8 - 64bit):


2

n = 20 (*even*) f = Interpolation[Transpose[{data[[All, 1]], Join[ data[[;; (n/2 - 1), 2]] , MovingAverage[data[[All, 2]], n] , data[[-n/2 ;;, 2]] ]}]] GraphicsColumn[{ListPlot[data], ListPlot[ Select[ data , Abs[f[#[[1]]] - #[[2]]] < .2 & ] ]}]


4

data = RandomInteger[10, {20, 20}]; ticklabels = StringJoin /@ # & /@ RandomChoice[CharacterRange["A", "Z"], {2, 20, 3}]; ticklabels2 = MapAt[Rotate[#, Pi/2] &, ticklabels, {2, All}]; ticks = (MapIndexed[{First@#2, #1} &, #] & /@ ticklabels2); ticks2 = {{ticks[[1]], None}, {None, ticks[[2]]}}; ArrayPlot[data, FrameTicks -> ticks2] ...


3

is this what you want? tikc1 = {r1, r2, r3}; htick = {#, Style[tikc1[[#]], 14, Bold]} & /@ Range[3]; tikc2 = {c1, c2, c3, c4}; vtick = {#, Style[Rotate[tikc2[[#]], Pi/2], Bold, Red, 14]} & /@ Range[4]; ArrayPlot[{{1, 0, 0, 0.3}, {1, 1, 0, 0.3}, {1, 0, 1, 0.7}}, FrameTicks -> {htick, vtick, htick, vtick}]


3

As you expect monotonic "smooth" behavior, a simple solution is to z-score the differences. diff = data[[All, 2]] // Differences; mn = Mean[diff] std = StandardDeviation[diff] (* 3 std is bad *) bad = Position[diff, x_ /; Abs[x] > Abs[mn + 3 std]] ListPlot[data, PlotRange -> All] ListPlot[data[[bad // Flatten]], PlotStyle -> Red] Show[%, %%] ...


0

Solve gives all the solutions as functions of k (note that K is used by Mathematica for dummy variables of integration and summation): sols = Solve[f[Ω, k] == 0, Ω]; Solve::ratnz: Solve was unable to solve the system with inexact coefficients. The answer was obtained by solving a corresponding exact system and numericizing the result. >> Plot[Re[Ω] ...


1

According to my tests, your function (where only even powers of omega occur) have symmetric solutions. Depending on the initial starting value for the root search, FindRoot converges to a solution or the opposite. That's why you observe the oscillations in your plot. Solution : To prevent FindRoot from choosing "randomly" one solution or the opposite, you ...


0

A = Exp[-(x - μ)^2/(2 σ^2)]/(Sqrt[2 Pi] σ); A1 = A /. (μ -> μ + s); W = Piecewise[{{A1, x <= c}}, A]; Manipulate[ Plot[{W} /. {μ -> mu, σ -> sig, s -> ss, c -> cut}, {x, -10, 10}, PlotRange -> {{-10, 10}, {0, .5}}] , {{mu, 1}, -10, 10}, {{sig, 2}, -10, 10}, {{ss, 2}, -10, 10}, {{cut, 1}, -10, 10}]


5

Rolled back to the very first version: ClearAll[x]; Plot[Evaluate[Range[50] + x], {x, -5, 5}, PlotLegends -> "Expressions"] Update -2: For other users who might have liked the deleted version: Plot[Evaluate[{1, 2, 3, " ... ", 49, 50} + x], {x, -5, 5}, PlotLegends -> "Expressions"] ... and a few variations: Plot[Evaluate[Range[50] + x], {x, ...


3

funcs = Tooltip /@ ({E^x, (Series[E^x, {x, 0, #}] // Normal) & /@ Range[6]} // Flatten); Plot[funcs, {x, 0, 5}]


0

You can use helpers as: text1 = "My Title"; text2 = "My other Title"; text3 = "More Text"; text4 = "Well ..."; ans use'm within ListPlot, lp1 = ListPlot[data , PlotLabel -> text1 , AxesLabel -> {x, y} , ImageSize -> Medium]; lp2 = ListPlot[data , PlotLabel -> text2 , Frame -> True , FrameLabel -> {x, y} , ImageSize ...


0

PlotLabel does it! Table[ListPlot[Table[X Sin[n/Pi], {n, 30}], PlotLabel -> X], {X, 3}]


1

Mathematica uses the style environment specified by the ScreenStyleEnvironment FrontEnd option for on-screen rendering and Exporting into raster formats but for printing and Exporting into PostScript formats it uses the style environment specified by the PrintingStyleEnvironment option. They have different values by default: Options[$FrontEnd, ...


1

a = 2000; n1 = 176/100; n2 = 1; \[Lambda] = 1450; NA = (n1^2 - n2^2)^(1/2); V = 2*Pi*a/\[Lambda]*NA; k0 = (2*Pi)/\[Lambda]; kT = (n1^2*k0^2 - \[CapitalBeta]^2)^(1/2); \[Gamma] = (\[CapitalBeta]^2 - n2^2*k0^2)^(1/2); Y = (V^2 - X^2)^(1/2); l = 0; LHS = X*(BesselJ[l + 1, X]/BesselJ[l, X]); RHS = Y*(BesselK[l + 1, Y]/BesselK[l, Y]); intersections = {X, LHS} /. ...


3

results = Sort@RandomInteger[100, {20, 30}]; Columns 2, 5 and 12 versus 1: ListLinePlot[results[[All, {1, #}]] & /@ {2, 5, 12}, PlotLegends -> Placed[Row[{"n = ", #}] & /@ {2, 5, 12}, Right]] columns = {2, 3, 15, 20}; ListLinePlot[results[[All, {1, #}]] & /@ columns, PlotLegends -> Placed[Row[{"n = ", #}] & /@ columns, ...


0

There are several ways to change the x-ticks. In your case, the most simple solution is probably scaling the function and not touching the tick labels at all. Plot, hence, (4*\pi Gr)/(3c^2) (1000*R) with $x$ running from $x_\text{Min}/1000$ to $x_\text{Max}/1000$ You can directly manipulate what Mathematica is placing as label plf=FullGraphics[Plot[ (4 ...


1

If your x-axis data (first column in your data matrix) is in the form 100000 m, as in the following fake data dt1a = Sort@ Transpose[{Quantity[RandomInteger[10^4, 100], "Meter"], RandomReal[100, 100]}]; then you can use UnitConvert on the first column of your data: dt1b = MapAt[UnitConvert[#, "Kilometer"] &, dt2, {All, 1}]; Plotting the two data ...



Top 50 recent answers are included