Tag Info

New answers tagged

1

Here are the modifications that need to be done on your plots h1 and h2 in order to flip them over the line y == x. If you look "under the hood" at the structure of these two plots by executing, for instance, FullForm@Normal@h1 you find that really there are only two objects, a Line and a Polygon. Both of these Heads take inputs which are lists of {x, y} ...


3

Needs["ErrorBarPlots`"] data = {{34.2, 8.83, 5.8, 4.2, 1.3362, 1.3362}, {44.3, 3.02, 5.7, 4.3, 0.4324, 0.4324}, {54.3, 1.33, 5.7, 4.3, 0.190427, 0.190427}, {64.5, 0.615, 5.5, 4.5, 0.088054, 0.088054}, {78.1, 0.273, 11.9, 8.1, 0.03908765, 0.039087651}, {98.6, 0.0861, 11.4, 8.6, 0.014199975, 0.014199975}, {122.0, 0.0279, 18, 12, ...


3

I cannot reproduce the behavior you observe in my version of Mathematica (10.2 on Win7-64), so I assume that you might be working on an older version. It would be interesting if you could add your version and platform to your question for reference. Nevertheless, in my opinion the problem seems to be that the plotting function is attempting to evaluate ...


1

Perhaps BarChart3D using the "Grid" option for ChartLayout may be more useful for your aim, e.g. mat = {{1, -1, 0, 0}, {-1, 2, 0, -1}, {0, 0, 1, -1}, {0, -1, -1, 2}}; BarChart3D[mat, ChartLayout -> "Grid", ChartLabels -> {Range[4], Range[4]}, LabelingFunction -> (Placed[Style[#, Red, Bold], Above] &), ChartStyle -> Blue] or just ...


5

Below are a bunch, although they seem to be a compilation of options for many or all plotting functions, including (mainly) 3D functions. As @belisarius remarked in a comment, using ?NumericQ is the standard way to prevent symbolic analysis, if indeed Plot is doing such. Use something like nf[x_?NumericQ] := f[x]; Plot[f[x], {x, a, b}] Without a ...


5

Clear[xp] xp[t_, r_, t0_, x0_] := x[t] /. First[NDSolve[{x'[t] + r x[t] == 0, x[t0] == x0}, x[t], {t, 0, 10}]]; Manipulate[ ClickPane[ Plot[g, {t, 0, 10}, PlotRange -> 1, Frame -> True, PlotLabel -> Dynamic[MousePosition["Graphics"]], Epilog -> {PointSize[Large], Point[sp]}], ...


17

If you are serious about using this extensively, consider making a function based on CreateDocument... Here is one way to pursue Szabolcs's line of thought. What follows is a function based on CreateDocument[] that can be used in conjunction with the (now somewhat neglected) option DisplayFunction, which handles where the output of graphics functions ...


14

You can always create a new notebook and put things in it. If you are serious about using this extensively, consider making a function based on CreateDocument that sets the appropriate options for the notebook to look good. Check what CreateDocument@Plot[Sin[x],{x,0,10}] does. Or use a quick-and-dirty hack based on CreatePalette: fig = CreatePalette[#, ...


14

data = Import["orbit3d.out", "Table"]; (* Your Table is not needed; you can use [[...]] instead *) (*d=Table[{data[[i,2]],data[[i,3]],data[[i,4]]},{i,1,Length[data]}];*) d = data[[All, 2 ;; 4]]; l = Line[d]; (* Projections on bounding box *) lz = l /. {x_, y_, z_} -> {x, y, -5.5}; ly = l /. {x_, y_, z_} -> {x, 5.5, z}; lx = l /. {x_, y_, z_} -> ...


4

The function Txk[x,k,n] calculates the contribution of the k^th zero at position x. The parameter n governs how many terms in the sum are used. This corresponds to Havil's equation on the bottom of page 196 of his book Gamma. Note that ExpIntegralEi should be used as @Guesswhoitis suggests, and as discussed here. I think there is a typo in the book, hence ...


4

Mathematica's special technique for handling complex values in a plot is to simply ignore them -- it plots nothing for at values of the domain for which the range is complex. Experiment with the following code. Manipulate[ PolarPlot[r[t], {t, min °, max °}, PlotRange -> {{0, 3.5}, {-1.5, 1.5}}, PlotRangePadding -> Scaled[.05], Epilog ...


1

The question is not clear, so far, but I assume you mean the PlotLegends and not PlotLabel. Mathematica 10 ParametricPlot[ {.5, t} , {t, 0, .5} , PlotStyle -> Blue , PlotLabel -> "here the plot Label" , PlotLegends -> {"here your legend"} , FrameLabel -> {"botoom", "left", "top", "right"} , PlotTheme -> "Detailed" ] ...


2

Edit 2 : Improved Version Firstly I'm renaming your data set b as b1. Create a new data c such that c = a + (10*b1); I'm scaling the data set b1 according to the axis you wanted. Create a barchart for c Plot3 = BarChart[c, BarSpacing -> {0, 1}, Frame -> Left, FrameTicks -> All, BarOrigin -> Bottom, ChartStyle -> {Darker[Red], ...


4

Using ImplicitRegion rgn = ImplicitRegion[-1 <= y <= 1 && 0 <= x <= Sqrt[1 - y^2] && x^2 + y^2 <= z <= Sqrt[x^2 + y^2], {x, y, z}]; RegionPlot3D[rgn, PlotPoints -> 150, Axes -> True, AxesLabel -> (Style[#, Bold, 14] & /@ {"x", "y", "z"})] The volume is vol = Volume[rgn] Pi/12 or ...


7

To get the region, you can use region plot, you should take the limits of the integral exactly as they are written and supply them to the function, separating the region corresponding to each integral by the And function(&&). The edge is a little jagged, but you can play with the number of plot points to get a better or worse picture. RegionPlot3D[ ...


1

This is now my final Code (V10.02). Thanks a lot for the help m_goldberg ! Manipulate[ Plot[Evaluate[checkBoxes/.{ 1-> 1,2-> Log[n],3-> n,4-> Log[n]n,5-> n^2}],{n,0,d}, PlotLabel->TableForm[{{"Funktion","Value"}, Sequence@@DeleteCases[MapThread[If[#1,#2,Null]&, {MatchQ[Alternatives@@checkBoxes]/@Range[5], ...


0

Here is a easy way to do using the built-in function Rescale PolarPlot[Nothing, {t, 0, 2 π},, PolarAxes -> Automatic, PolarTicks -> {Table[{i, Rescale[i, {0., 2. π}]}, {i, 2 π - π/5, 0, -π/5}], None}]


6

data = Import["/Users/roberthanlon/Downloads/test.xlsx"][[1]]; Dimensions[data] {6039, 2} Since the data consists of pairs of values, the distribution given by SmoothKernelDistribution[data] is for a bivariate distribution. K = SmoothKernelDistribution[data]; {xmin, xmax} = MinMax[data[[All, 1]]]; {ymin, ymax} = MinMax[data[[All, 2]]]; ...


3

You can even read the following How to | Import a Spreadsheet data = Import["/Users/xxx/Desktop/test.xlsx", {"Data", 1, All, 1}]; K = SmoothKernelDistribution[data]; Table[Plot[f[K, x], {x, -1000, 4000}, PlotLabel -> f], {f, {PDF, CDF}}] How to | Import a Spreadsheet The spreadsheet is included in the Wolfram Language documentation folder ...


2

PolarPlot[1, {t, 0, 2 Pi}, PolarAxesOrigin -> {0, 1}, PolarAxes -> Automatic, PolarTicks -> Evaluate[{#, If[# == 0, "0/1", ToString[Round[#/(2 Pi), 0.1]]]} & /@ Range[0, 9/5 Pi, 2 Pi/10]]]


7

Here is a rework of your code that I think produces what you are asking for. One issue I have not addressed is plot filling because I think it a bad idea with so many functions on the plot. I also made some minor changes to the control layout to get a more compact display. You can easily restore your original layout if you like. Manipulate[ Column[ ...


0

Since Q is just a multiplicative constant, perhaps you're after one of these: Q = 1/2; f[x_, t_] := Q /2 Exp[-x^2/(4 t)]/Sqrt[π t]; Grid[{{ Plot3D[f[x, t], {x, 0, 10}, {t, 0, 5}, MeshFunctions -> (#3 &), PlotStyle -> {Opacity[.7], Orange, Specularity[Red, 100]}], ContourPlot[f[x, t], {x, 0, 10}, {t, 0, 5}, ...


2

You should assign values ​​and improve the typos. Howsoever I think you are looking for: Q = 1/2; t = 9; Plot[(Q E^(-(x^2/(4 t))))/(2 Sqrt[π t]) , {x, 0, 10} , PlotTheme -> "Detailed"] A Family of Functions can be plottet the following way: f[x_, t_, Q_] := (Q E^(-(x^2/(4 t))))/(2 Sqrt[π t]) tabl = Table[f[x, t, Q], {t, Range[6, 10]}, {Q, Range[1, ...


1

Here is an approach using Annulus. In this approach element {1,1} starts from horizontal axis and I have not adapted but to start of vertical axis downward but this could be adapted. The ticks have been made to match example and I use m from @Taiki answer. Coloring could be modified and generalized as required. elem[r_, t_, m_, col_] := If[r > 1, {col, ...


4

Using the sector[] function from here (replaceable with Annulus in version 10.2), we can generate a plot that looks like, but is smoother, than the result of MATLAB's pcolor(): n = 20; r = N[Range[0, n]/n]; θ = N[π Range[-n, n]/n]; m = Table[r1 Cos[2 θ1], {r1, r}, {θ1, θ}]; jet[u_?NumericQ] := Blend[{{0, RGBColor[0, 0, 9/16]}, {1/9, Blue}, {23/63, Cyan}, ...


2

Yet another possibility: f = Tan; {Plot[InverseFunction[f] @ x, {x, -2 π, 2 π}], Plot[ConditionalExpression[f @ x, Abs[x] < π/2], {x, -2 π, 2 π}, Exclusions -> {Cos[x] == 0}]} // GraphicsRow


2

Probably you can use RegionFunction {Plot[InverseFunction[f]@x, {x, -2 Pi, 2 Pi}], Plot[f@x, {x, -2 Pi, 2 Pi}, RegionFunction -> Function[{x, y}, Pi/2 > x > -Pi/2]]}


6

If you are trying to be concise and want to avoid scoping problems, I recommend this variant. Show @@ With[{color = ColorData[97][#3]}, Plot[#1[t], {t, 0, 2 Pi}, Mesh -> #2, PlotStyle -> color, MeshStyle -> {color, PointSize[Large]}] & @@@ {{Sin, 10, 1}, {Cos, 20, 2}}] which produces exactly ...


3

In order to study that region where you get the defect try f[t_] := {20 Cos[ t] - ((837 + 800 Cos[2 t] - 35 Cos[12 t] + 40 Sqrt[2] Cos[t] Sqrt[801 + Cos[12 t]]) Cos[300 t] + 480 Sin[t] Sin[6 t] Sin[300 t])/(-1637 + 35 Cos[12 t] - 40 Sqrt[2] Cos[t] Sqrt[801 + Cos[12 t]]), 20 Sin[t] + (4 (40 Cos[t] + Sqrt[2] Sqrt[801 + ...


12

Let us look at the structure of the produced Graphics expression using the shortInputForm function: Plot[{Sin[t], Cos[t]}, {t, 0, 2 Pi}, Mesh -> {10, 20}, MeshStyle -> Directive[PointSize[Large]]] // shortInputForm We see that all the Mesh points present as single Point primitive. It means that even on the level of internal structure of the ...


3

an example of a grid of plots: GraphicsGrid[ Partition[Table[ Plot[Sin[i x] , {x, 0, 2 Pi}], {i, 7}], 3, 3 , {1, 1}, Null]] then for your case it will be something like: GraphicsGrid[ Partition[Table[ p=ReadList[]; ... ListPlot[...], {i, Length[datasource]}], 3, 3 , {1, 1}, Null]]


8

I am glad that you are using Mathematica in your high school project. I think you forgot to mention in your question that the code you posted doesn't actually produce the image you showed; you may also want to mention where you obtained that image. Anyway, since your figure is made up of repeating units, I generated one unit, then translated it multiple ...


6

To speed up the CAGDBezierSurface,I have two trials 1, Refactor the pure function AllBasis I don't know why the most efficient method to calculate the Benstein basis is the defintion of Benstein basis. AllBasisNew = Function[{deg, u0}, Bernstein[deg, #, u0] & /@ Range[0, deg]] AllBasisOld = Function[{deg, u0}, ...


2

Just another way to do this: m = {{1, -1}, {2, 1}}; fun = {{1 + (#1 + #2) 0.001, 0}, {0, 1 + #1 #2 0.001}} &; nf[x_] := fun @@ (Inverse[m].x).x So, ListLinePlot[Transpose[NestList[nf, {6, 7}, 1000]],, PlotLegends -> {"a", "b"}] yielding: * Verbatim instructive comment from @Guesswhoitis.* It's alright here, but in general, it's better to use ...


2

The bin-sizes (which is what you interval sizes) can be specified directly in Histogram: Histogram[RandomReal[-30, 40], {5}] Btw, it's funny when you say random numbers from RandomReal[-30,30] (where the size of the list is 40) and you just specified to get a list with 30 random numbers :-) Edit: Ahh, and now I see why you said it. When you want ...


6

Earlier in the summer I had written the following for How to obtain adaptive sampling as in Plot function?. It is something like Guess who it is's technique. But instead of a new version of Mathematica coming along, my brain turned on and I discovered a workaround using FunctionInterpolation. I've been considering posting the following as an answer to ...


7

Adam, I think this is probably what you mean: {a, b} = {6, 7}; t = 0; dt = 0.001; loopvals = Part[#, 2, 1] &@ Reap@ Do[ {l, m} = With[{r = NSolve[{x - y == a, 2 x + y == b}, {x, y}]}, Extract[r, Position[r, _?NumericQ]]]; t = t + dt; a = a + (l + m) a dt; b = b + l m b dt; Sow[{a, b}], {1000} ]; ...


4

To be honest, the code you found isn't a good example of coding in Mathematica. I think the following 3 lines are enough for you: ListStreamPlot[Transpose[{u, v}, {3, 1, 2}], DataRange -> {{0, 1}, {0, 1}}] curl = Most /@ Differences@v - Most@Differences[u, {0, 1}]; ListContourPlot@LowpassFilter[curl, 1] You may also want to try ListDensityPlot: ...


3

This is not an answer, but a extended comment on MarcoB's answer, which I think is a good one. However, I would like to suggest an improvement to the way he plots the fit function together with the data, which makes the plot expression independent of the global variable data. I am assuming that nlm has been defined precisely as shown in MarcoB's answer. ...


2

The following part is incorrect, and redundant anyway: \[Psi]= \[Integral]u dx= \[Integral]v dy \[Omega]= \[PartialD]v/dx-\[PartialD]u/dy Otherwise, the code you copied has only one major problem, in the definition of n. If you try to execute it, you get Do::iterb: Iterator {j,2,n-1} does not have appropriate bounds. >> which suggests where the ...


5

I think you might be after a "smoothed" presentation such as the following: SeedRandom[35] data = Table[{x, x^2 + RandomReal[20]}, {x, -10, 10, 1}]; ListPlot[{data, data}, Joined -> {False, True}, InterpolationOrder -> 3] However, I would caution you against using this kind of interpolated presentation unless you are very sure that it is ...


2

Example data data = SortBy[RandomReal[1, {10, 2}], First] {{0.20784, 0.522849}, {0.437556, 0.931183}, {0.468446, 0.86256}, {0.474691, 0.535952}, {0.52331, 0.838424}, {0.549898, 0.135879}, {0.686447, 0.670915}, {0.807457, 0.539869}, {0.829756, 0.267644}, {0.916977, 0.962118}} As pointed by @march, if you have two lists, xList and yList, you can put ...


1

Using your f you might try : points = f /@ RandomReal[{0, 1.5695},100]; DiscretePlot[PDF[EmpiricalDistribution[points], x], {x, points}]


4

According to the suggestion of Michael E2 and the answer of m_goldberg Replacing the Evaluate @Sequence @@ FilterRules[{opts}, Options[ParametricPlot]] with Evaluate @ FilterRules[{opts}, Options[ParametricPlot]]; Using the construct Block[{u}, ParametricPlot @@ {args...}] Ultilizing the Show and Graphics[If[cp, {Green, Line[pts], ...


10

I have reworked your code somewhat. I hope what I have done will help you with your problem. BezierDefinition[pts_, u0_?NumericQ] := Nest[MovingAverage[ArrayPad[#, 1], {u0, 1 - u0}] &, {1}, Length[pts] - 1].pts ClearAll @ CAGDBezierCurve; Options[CAGDBezierCurve] = {SplineClosed -> False, SplineDegree -> Automatic, ControlPoints -> ...


1

As MarcoB pointed out, Evaluate-In-Place Ctrl+Shift+Enter on ColorSetter[] gives an input object that when clicked brings up the menu color palette. However, if you're putting this inside a plot (or PasteButton) you must use a dynamic function. For putting it in plots use PlotStyle -> DynamicSetting[ColorSetter[]]. Thanks, MarcoB.


4

You need a region of dimension 3: t = 1; VectorPlot3D[{x, y Cosh[t] + z Sinh[t], y Sinh[t] + z Cosh[t]}, {x, -5, 5}, {y, -5, 5}, {z, 0, 5}, RegionFunction -> (( #1^2 + #2^2 - #3^2 < -1) &)] Or you could try something more "manual" to capture the vectors on your region of interest only : field[x_, y_, z_, t_] := {x, y Cosh[t] + z Sinh[t], ...


4

You need to look at s, if you don't know in which form it is returned from DSolve. An easier way is to use DSolveValue in this case. I changed some things in your manipulate, but I'm sure you get the rest yourself: s = DSolveValue[{δ''[t] + g*δ[t]/l + (2*I*ω*Sin[ψ])*δ'[t] == 0, δ[0] == a + b*I, δ'[0] == 0}, δ[t], t]; With[{sol = s}, ...


1

Addition of Method -> {"OptimizePlotMarkers" -> False} solves the problem: Needs["ErrorBarLogPlots`"] ErrorListLogLogPlot[Table[{{kk + i/3, 2 kk}, ErrorBar[kk]}, {i, 1, 3}, {kk, 1, 5}], PlotRange -> {{1, 10}, {1, 20}}, Axes -> False, Frame -> True, PlotMarkers -> Automatic, Method -> {"OptimizePlotMarkers" -> False}]


3

Plot[{x^2, 8 x - 12, -8 x + 20}, {x, -1, 4}, PlotStyle -> {Blue, Red, Red}, Filling -> {2 -> {3}}, AspectRatio -> 1, PlotRange -> {-10, 10}] The crucial part here is the Filling option. You can of course tweak this further to get what you want.



Top 50 recent answers are included