Tag Info

New answers tagged

2

The exact area - i.e. not a numerical approximation - can be obtained as follows: f[x_] := x^3; g[x_] := x^5 - 2 x^3 - 3 x; Find the points on the real axis where f[x] and g[x] intersect. sol = Solve[f[x] == g[x], x, Reals] (* {{x -> 0}, {x -> Root[-3 - 3 #1^2 + #1^4 &, 1]}, {x -> Root[-3 - 3 #1^2 + #1^4 &, 2]}} *) Compute the area ...


3

Here I post a different approach based on the awesome new Region functions: f[x_] := x^3 g[x_] := x^5 - 2 x^3 - 3 x We solve for the intersections: sol = x /. NSolve[f[x] == g[x], x, Reals] {-1.94712297, 0, 1.94712297} Edit Here are the regions of interest: r1 = ImplicitRegion[g[x] > y && f[x] < y, {{x, -1.94712297, 0}, y}]; r2 = ...


2

f[x_] := x^3 g[x_] := x^5 - 2 x^3 - 3 x sol = Partition[x /. NSolve[f[x] == g[x], x, Reals], 2, 1] Tr@(Abs@Integrate[g[x] - f[x], {x, Sequence @@ #}] & /@ sol) (*14.7695*)


7

Here's what the plot looks like: f[x_] := x^3 g[x_] := x^5 - 2 x^3 - 3 x Plot[{f[x], g[x]}, {x, -5, 5}, PlotRange -> {-10, 10}] You first solve for the intersections: sol = x /. NSolve[f[x] == g[x], x, Reals] {-1.94712297, 0, 1.94712297} Now you can find the area by integrating the difference between the curves in the intervals obtained: ...


0

fun = t/Sqrt[2 + t^3]; The following is quite slow: NMinimize[{NIntegrate[fun, {t, -1, x}], 1 <= x <= 3}, x] // Quiet {-0.0764949, {x -> 1.}} NMaximize[{NIntegrate[fun, {t, -1, x}], 1 <= x <= 3}, x] // Quiet {1.15208, {x -> 3.}} This is much faster: res = Transpose[{#, Map[NIntegrate[fun, {t, -1, #}] &, #]}]&[Range[1, 3, ...


3

We can use a simple sieve to find these numbers in $O(x \log \log x)$ time. I went ahead and compiled my solution to make it as fast as possible. PrimesUpTo = Compile[{{n, _Integer}}, Block[{S = Range[2, n]}, Do[ If[S[[i]] != 0, S[[2i+1 ;; -1 ;; i+1]] *= 0; ], {i, Sqrt[n]} ]; Select[S, Positive] ], ...


13

This is competitive with Mr Wizards code and seems faster in some cases: fn2[x_Integer, n_Integer] := Module[{y = Range @ x}, (y[[# ;; x ;; #]] = 0) & /@ Prime[Range @ Min[n, PrimePi @ x]]; SparseArray[y]["NonzeroValues"]] AbsoluteTiming[fn[10000, 1223];] (* {0.004000, Null} *) AbsoluteTiming[fn2[10000, 1223];] (* {0.010001, Null} *) ...


13

I believe this is correct, and very fast: fn[x_Integer, n_Integer] := Complement[Range @ x, Join @@ Range[#, x, #]] & @ Prime @ Range @ n Test: fn[10000, 1223] {1, 9929, 9931, 9941, 9949, 9967, 9973} It seems I am a bit late to return to this problem and Simon Woods already provided a memory optimized approach. His sieve is comparatively ...


4

ss[x_, n_] := Flatten@Position[CoprimeQ[#, Sequence @@ Prime[Range@n]] & /@ Range@x, True]


1

I can't Trace the WordData problem because I don't have that error on my system. Howvever after loading CountryData[] you should have this behavior: DataPaclets`CountryDataDump`$GroupHash["Countries"] // Short {Afghanistan, Albania, Algeria, AmericanSamoa, << 233 >>, Yemen, Zambia, Zimbabwe} That you do not indicates that this definition ...


1

This is a verbose epilog to the nice answers given: fun = Sin[x]; lim = 4 Pi; max = Round @ First @ FindMaximum[fun, {x, 0}]; min = Round @ First @ FindMinimum[fun, {x, 0}]; xp = FindInstance[(fun == max || fun == min) && 0 <= x < lim, x, Reals, 15]//Values//Flatten; yp = Table[fun, {x, xp}] plo = Plot[fun, {x, 0, lim}, ...


1

A quick look at a Table of the outcomes of your code shows pretty much what the problem is. If FuncThomae[x_] := If[ ExactNumberQ[Rationalize[x]], If[x == 0, 1, L = #^-1 & /@ Divisors[Numerator[Rationalize[x]]] ] , 0] then Table[FuncThomae[x], {x, 0, 1, 0.1}] produces {1, {1}, {1}, {1, 1/3}, {1, 1/2}, {1}, {1, 1/3}, {1, 1/7}, {1, ...


7

Another alternative is to use ConditionalExpression using the second-order condition for a local maximum as the second argument: f = Sin; Plot[f[x], {x, 0, 20 Pi}, Mesh -> {{0}}, MeshFunctions -> {ConditionalExpression[f'[#], f''[#] < 0] &}, MeshStyle -> {PointSize[Large], Red}] f = Sin[#] - 1/2 Cos[Pi #] &; ...


0

For what it's worth, this is equivalent to the sum of If statements: Fold[PiecewiseExpand[Plus[##]] &, 0, List @@ PiecewiseExpand /@ (If[0 <= t < 1, k T UnitStep[k T] - (k T - 6 T) UnitStep[k T - 6 T], 0] + If[1 <= t < 2, k T UnitStep[k T] - (k T - 6 T) UnitStep[k T - 6 T], 0] + If[2 <= t < 3, k T UnitStep[k T] - (k T - ...


1

Here is another answer based on use on the sinc interpolation formula. In practice, this is not used for D/A since it is not efficient, also in practice a low pass smoothing filter is applied after the D/A. But this does not use the control system functions, and is direct implementation of the Sinc interpolation as is from the textbook. (ps. here is also a ...


1

I think Michael E2 is exactly true. "should normally be chosen to be continuous monotonic functions." I have tried draw like this. Because it is not continuous monotonic function it is drawed lines along with the polygon meshs. I think MeshFunction seems improbable for your purpose. f[x_, y_] := (x^2 + 3 y^2)*E^(1 - x^2 - y^2) f1 = Plot3D[f[x, y], {x, -2, ...


6

MeshFunctions, according to the documentation, "should normally be chosen to be continuous monotonic functions." Failing that, the mesh functions should be transverse to the mesh levels (i.e., cross them, not have a local extremum); in this case, however, one might have trouble with sampling missing a small region where the mesh function very briefly ...


4

You have a numerical accuracy problem more than anything else. The mesh points are not computed all that accurately, and you have to allow for it in your code. For example, Plot[Sin[x], {x, 0, N[8 Pi]}, Mesh -> {{1}}, MeshFunctions -> (Boole[Chop[Cos[#1], .005] == 0 && #2 > 0] &), MeshStyle -> {PointSize[Large], Red}] works ...


4

I am not sure if this meets what you are looking for. But too small to put it in comment. Mathematica already implements zero order hold in the control system functions. Here is a quick example I wrote to show how to use it. The f(t) function has to be made a transfer function (using Laplace) and then you can use the ZOH option in the conversion. Clear[f, ...


1

Probably something like this could do: i[k_, T_] := k*T*UnitStep[k*T] - (k*T - 6 T)*UnitStep[k*T - 6 T] samplePer = 1/2; vals = Table[{k + 1, i[k, samplePer]}, {k, 0, 10}] f = Interpolation[vals, InterpolationOrder -> 0]; Quiet@Plot[f@t, {t, 0, 10}, AxesOrigin -> {-1, -1}]


0

I measured time with AbsoluteTiming[]. Then plotted the graph of $log(t)[log(n)]$, where $n$ are variables of the minimized function and $t$ is time needed to find the minimum. The rounded slope $k$ is time complexity of the method, that is $O(n^{k})$.


1

Here is an approach for what i think you mean that does an interpolation rather than selectively dropping columns.. i0 = ExampleData[{"TestImage", "Lena"}]; w = ImageDimensions[i0][[1]]; c[x_] := ((1 + Erf[2 (4 x - 2)])/2); vals = Table[1 + (w - 1) c[x], {x, 0, 1, 1/200}] // N; Image[(Interpolation[MapIndexed[{First@#2, #1} &, #]] /@ vals) & /@ ...


1

If you want the value of status outside of the Manipulate to be updated whenever it changes inside the Manipulate, just drop the explicitDynamic`. Manipulate[status = If[a < b, Yes, No], {a, 2}, {b, 5}] Dynamic[status === Yes] The Manipulate will still work as it did before the change, and the second expression will track the changed to status made ...


1

(status /. Dynamic -> Identity) === Yes (* True *)


4

From the comments, we can set up the OP's DEs as follows and show they can be solved exactly. First the system is the direct product of two independent systems, so let's separated them. γ = 6; g = -98/10; yIVP = {y''[t] + γ*(y'[t])^2 == g, y[0] == 0, y'[0] == 15/10}; qIVP = {q''[t] == -γ*(q'[t])^2, q[0] == 0, q'[0] == 7}; nysol0 = NDSolve[yIVP, {y}, {t, ...


2

You can get a path function directly from the solution of your ODEs. I don't understand your ODE's, so I'm going to work with a much simpler system, which gives the path of particle moving under constant gravity in a vacuum. g = -9.8; numSoln = NDSolve[{ y''[t] == g, q''[t] == 0., y[0] == 0., q[0] == 0, y'[0] == 50., q'[0] == ...


2

There are at least two approaches by which you could obtain a closed form emulation of your answer. Both involve extracting a list of points that are part of the solution. 1. Inexpensive but takes you outside Mathematica. Export the list of points to a CSV file. Obtain (free trial) a program called Eureqa (http://www.nutonian.com/products/eureqa/) that ...


1

an example I wrote some months ago for inspiration Manipulate[ ContourPlot[ Evaluate@esp[q3D[p], p3D[p], {x, y, z}], {x, -10, 10}, {y, -10, 10}, (*ContourPlot Options*) Contours -> 20, ContourLabels -> All, (*Tooltip Labels*) FrameLabel -> {"x", "y"}, PlotRange -> 11, ImageSize -> 850 ], (*--Controls--*)(*use Alt-Click to set ...


0

My personal experience of opening a version 9 notebook in version 10 had no such warnings at all, that I could see. Also I looked for compatibility checker and found none. It could exist but I didn't find it. When I had an issue with version 9 being corrupted by V10 install, system restore did not fix the issue to my wide eyed amazement. Also, uninstalling ...


8

Warning: Modifying a built-in function is not advised As @m_goldberg already stated, Lookup has Attributes HoldAllComplete, so a workaround will be to remove this Attribute: Edit: As per m_goldberg's recommendation attr = Attributes[Lookup]; Attributes[Lookup] = {}; Now t1 = TempHead[a -> 1, b -> 2, c -> 3]; t2 = TempHead[c -> 3, d -> 4, ...


6

Lookup has the attribute HoldAllComplete, which means the kernel evaluator will not see its arguments and, therefore, will not look at its up-values.


7

It seems me that the answers of mathe and Yves Klett do not meet expectations of the author. The latter is as much as I have got it, to have a short analytical expression for the solution. Probably the author has an intention to use the result further in some analytical calculations, or to do something comparable. Am I right? If yes, one should first of ...


6

Solve[L == (3 W)/2 + 3/2 Sqrt[4 A^2 Pi^2 + W^2] - Sqrt[ 6 A^2 Pi^2 + 3 W^2 + 5 W Sqrt[4 A^2 Pi^2 + W^2]]/Sqrt[2], W, Quartics -> False] or Solve[L == (3 W)/2 + 3/2 Sqrt[4 A^2 Pi^2 + W^2] - Sqrt[ 6 A^2 Pi^2 + 3 W^2 + 5 W Sqrt[4 A^2 Pi^2 + W^2]]/Sqrt[2], W, Reals]


2

One shotgun approach is to sic Simplify or FullSimplify onto your solution: sol1 = Solve[ L == (3 W)/2 + (3 Sqrt[4 A^2 Pi^2 + W^2])/2 - Sqrt[6 A^2 Pi^2 + 3 W^2 + 5 W Sqrt[4 A^2 Pi^2 + W^2]]/Sqrt[2], W]; sol2 = Simplify[sol1]; LeafCount /@ {sol1, sol2} ByteCount /@ {sol1, sol2} {3849, 3077} {111720, 92840} (Note: FullSimplify is still ...


3

I wanted to let everyone know what happened to me in case it prevents the stress I'm feeling right now. I was worried about the changes in the way dates are handled as I have many lines of code with date features as I am backtesting investments. I decided to see what happens and if I could fix any issues with great inputs above. I made sure not to ...


5

Description ? at the beginning of a line is the short from of Information. Given a pattern that matches multiple Symbols Information returns a list of them in alphabetical (canonical) order, in columns top to bottom and left to right. You are therefore asking how you can modify the behavior of this System function. You would need some way of storing the ...


2

First, I should say that I could find no examples of using RegionPlot3D with regions in the documentation. It works on some regions, not on others, and in this case runs longer than one wants to wait. It runs nonstop because Reduce[Exists[{u, v}, x - Cos[u] == 0 && y - Cos[v] - Sin[u] == 0 && z - Sin[v] == 0 && 0 <= u ...


0

I think you may find value in this rule: sequentialQ[x_List] := x == Range[x[[1]], x[[-1]]] rule = HoldPattern[Plus[s : F_[_, j___] ..]] /; sequentialQ @ {s}[[All, 1]] :> (HoldForm[Sum[F[i, j], {i, ##}]] & @@ {Min@#, Max@#} &[{s}[[All, 1]]]); Test: F[1.0, q, r] + F[1.5, q, r] + F[2, q, r] + F[2.7, q, r] + F[3.0, q, r] /. rule


2

Here is a different sort of answer, but very V10-style. The only logical expression however is Element, so I'm afraid this will fall short. Clear[regFn, regFn`mesh]; regFn`mesh[polyh_] := regFn`mesh[polyh] = ConvexHullMesh@PolyhedronData[polyh, "VertexCoordinates"] regFn[polyh_] := With[{region = regFn`mesh[polyh]}, {##} ∈ region &] This ...


2

I suppose they are nice....They check that a point is inside each facet plane. # -> PolyhedronData[#, "RegionFunction"] & /@ {"Octahedron", "Dodecahedron", "Icosahedron"} (* {"Octahedron" -> (2 (#1 + #3) <= Sqrt[2] + 2 #2 && 2 (#1 + #2 + #3) <= Sqrt[2] && 2 (#2 + #3) <= Sqrt[2] + 2 #1 && 2 #3 <= ...


0

You can use Mod with a non-integer second argument: f[a_] := Ceiling[Mod[a, 2 \[Pi]]/\[Pi]] To generalize you can make a Periodic operator as follows: Periodic[T_, offset_: 0][f_] := f@*((Mod[#, T] - offset) &) f2pi = Periodic[2 \[Pi]][Ceiling[#/\[Pi]] &] f3pi = Periodic[3 \[Pi], 0.1][Ceiling[#/\[Pi]] &] quadratic[x_] := (x/\[Pi])^2; parabola ...


2

You can use a combination of Floor, Floor[x, a] gives the greatest multiple of a less than or equal to x and Mod, Mod[m, n] gives the remainder on division of m by n to get f[x_] := 1 + Floor[Mod[x, 2 π]/π]


3

You can also use the built-in function SquareWave: ClearAll[f]; f[x_] := SquareWave[{2, 1}, x/(2 Pi)]; Plot[f[x], {x, 0, 10 Pi}, Ticks -> {Pi Range[10], Automatic}, ExclusionsStyle -> Automatic, PlotRange -> {0, 3}, ImageSize -> 400] Update: another alternative: Use ListInterpolation with options InterpolationOrder->0 and ...


1

Here is a method that uses UnitStep and Sin to generate the square wave. Sin produces the periodicity and UnitStep maps the sinusoid into a square-wave. This method will be faster than Which. f[x_] := 1 + UnitStep[Sin[x + Pi]] Plot[f[x], {x, -10, 10}, Exclusions -> None, PlotStyle -> Thick]


1

Here's one way to make your function periodic: f[t_] := Which[0 <= t < Pi, 1, Pi <= t < 2 Pi, 2, t < 0, f[t + 2 Pi], t > 2 Pi, f[t - 2 Pi]] For example: Plot[f[t], {t, -10, 10}] This method works well for any function you care to use (not just square waves). For instance, f[t] can be linear in one half and quadratic in the second ...


2

In mathematics, a set can be write in two(or more) form: one is {3x | x in [0,1]}, the other {x | P(x)}, where P is called a propositional function or predicate. Since Mathematica have a great power of dealing with quantifiers, once you can write a set in the second form above, you can do plenty of things and tricks that you would have thought to have ...


6

The answer is 0, if the question is what is the value of Mean[fit["FitResiduals"]] and fit is a linear, least-squares fitted model. data = WeatherData["London", "Temperature", {{2004, 1, 1}, {2013, 12, 31}, "Day"}]; normaldata = Partition[Reverse[data["Values"][[All, 1]]], 2, 1]; fit = LinearModelFit[SetPrecision[normaldata, Infinity], x, x, ...


1

Something like this: m4 = Quiet[Table[a[[i, j]], {i, 4}, {j, 4}]]; soln = With[{det = Simplify[Det[m4]]}, Compile[{{a, _Real, 2}}, det]]; soln[RandomReal[1., {4, 4}]] -0.036117495644621564` But Det is quite efficient as it is, I would think.


11

foo = With[{f = #0}, (# /. {p___, a, b, c, q___} :> Join[{p, "abc"}, f @ {q}])] & lst = {1, 2, a, b, c, 3, {4, a, b, c}, 5}; foo@lst (* {1, 2, "abc", 3, {4, "abc"}, 5} *) This works because With automatically renames the patterns used in RuleDelayed since both are scoping constructs. Other constructs can be used as well such as RuleDelayed itself: ...


3

You can "inject" that variable by grabbing it with With. It then gets put into the body of the With verbatim, hence it gets inside the Function in the desired form. f2[expr_] := With[{var = First@Variables[expr]}, expr /. var -> # &] f2[x^2] (* Out[79]= x^2 /. x -> #1 & *) This can also be done in the way you had tried, with a bit of work ...



Top 50 recent answers are included