# Tag Info

33

We can use the Ramer-Douglas-Peucker algorithm to reduce the number of points. This algorithm was originally devised for processing map data. reg = BoundaryDiscretizeGraphics[ Text[Style["S", FontFamily -> "Verdana", FontWeight -> Bold]], _Text] poly = First@reg["BoundaryPolygons"]; pts = SimplifyLine[First[poly], 0.02]; Graphics@{EdgeForm[...

24

Writing: NSum[(-1)^n/Sqrt[Log[n]], {n, 2, Infinity}, Method -> "AlternatingSigns"] I get: 0.690243 which is what you want. In particular, directly from Numerical Evaluation of Sums and Products you read: The way NSum works is to include a certain number of terms explicitly, and then to try and estimate the contribution of the remaining ones. ...

16

I've fiddled with this on and off for a while now, hesitating to decide whether it was worth posting since another answer has already been accepted. The undocumented function, ExperimentalOptimizeExpression, can be used to break down the solutions algebraically into common subexpressions, and it seemed like an approach worth sharing. On the other hand, ...

16

Here's a way to leverage the Clenshaw-Curtis rule of NIntegrate and Anton Antonov's answer, Determining which rule NIntegrate selects automatically, to construct a piecewise Chebyshev series for a function. It also turns out that InterpolatingFunction implements a Chebyshev series approximation as one of its interpolating units (undocumented). With ...

16

You could use VietePiApprox[n_] := (Times @@ NestList[Sqrt[2 + #] &, Sqrt[2], n])/ 2^(n + 1) SetAttributes[VietePiApprox, Listable] which approximates Pi as follows. N[VietePiApprox[Range[5]] - 2/\[Pi]] {0.0166617, 0.00410909, 0.0010238, 0.000255735, 0.0000639204}

15

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 ...

15

You can just take Bob Hanlon's answer from 2006 directly, and modify the plot just a bit to update it. ChebyshevApprox[n_Integer?Positive, f_Function, x_] := Module[{c, xk}, xk = Pi (Range[n] - 1/2)/n; c[j_] = 2*Total[Cos[j*xk]*(f /@ Cos[xk])]/n; Total[Table[c[k]*ChebyshevT[k, x], {k, 0, n - 1}]] - c[0]/2]; f = 3*#^2*Exp[-2*#]*Sin[2 #*Pi] &; ...

14

From Weierstrass Approximation Theorem we know there is such a polynomial, moreover there are infinitely many polynomials satisfying given criterion. Therefore we would like to find those ones of the minimal order. Since we are supposed to exploit series approximations we define a polynomial of n - th order approximating 6 ArcTan[x] for x such that (-(1/...

14

You can use Series to specify the order of approximation. When an expression involving the output of Series, which is a SeriesData object, is evaluated, the calculus is done for you. sol = Solve[x^2 + (b + Epsilon)*x + c == 0, x] approx = sol /. Epsilon -> Series[Epsilon, {Epsilon, 0, 1}] // Normal Alternatively, you could apply Series to the formula ...

14

One slick way to derive the analytic Chebyshev series of a function is to use the relationship between the Chebyshev polynomials and the cosine, and then use the built-in FourierCosSeries[]. As an example: f[x_] := Exp[x]; n = 5; (* degree of approximation *) approx[x_] = FourierCosSeries[f[Cos[t]], t, n] /. Cos[k_. t] :> ChebyshevT[k, x] (Note that the ...

14

How about this: Normal@Series[1/((a + b) b), {a, Infinity, 1}] (* ==> 1/(a b) *) Normal@Series[ArcTan[a + b], {a, Infinity, 1}] (* ==> -(1/a) + Pi/2 *) Edit in response to comment Having been told what the desired result for ArcTan[a+b] is, it looks like the following expansion method might be what's needed. At least it's consistent with the ...

14

1 + ContinuedFractionK[(2 n - 1)^2, 2, {n, 1, Infinity}] (* 4/π *) Pick a termination point less than Infinity to get an approximation.

11

You can use the undocumented ReturnMeshObject method like @Simon Woods used here to get ListSurfacePlot3D to do the smoothing for you. With this option added, it returns a GraphicsComplex ready to be used by DiscretizeGraphics. GraphicsMesh`MeshInit[]; mc = MeshCoordinates[surface]; extractedmesh = DiscretizeGraphics[ First@ListSurfacePlot3D[mc, ...

11

Taylor polynomials of order n aren't necessarily the nth degree polynomials that optimally approximate a function on a given interval. We can use linear least squares to find the optimal polynomials for a fixed n. inn[f_, g_, x_] := Integrate[f g, {x, -1/Sqrt[3], 1/Sqrt[3]}] LeastSquarePolynomial[f_, x_, n_] := With[{pows = x^Range[0, n]}, pows . ...

11

Here is an answer with LinearModelFit using the data in the example referenced in the question. Data: Ndata = 20; x = Table[10 N[i/Ndata], {i, 0, Ndata - 1}]; y = Sin[0.1 x^2]; data = Transpose[{x, y}] ListPlot[data] Radial basis functions: GaussianRadialFunction[k_, r_] := Exp[-(k r)^2]; bFuncs = Table[GaussianRadialFunction[k, r], {k, 0.01, 1, 0.04}...

11

As @t-smart seems to suspect, the change in V11.3 to let machine underflows to underflow to 0. is at the root of this bug. In the OP's problem, Mathematica isolates the roots with rational numbers to the desired precision. It then uses the interval length to determine the precision argument to N to get the final result. Unfortunately it uses machine ...

10

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]

10

Here is my attempt to use ParametricPlot for obtaining an adaptive approximation of the shape. It is based on the code of glyph to Polygon conversion engine by Simon Woods. The latter converts BezierCurves directly into BezierFunctions (as BoundaryDiscretizeGraphics does) what isn't correct in general since these functions are compatible only for ...

10

Here I present a very simple angle-based polygon reduction algorithm as described in the chapter "A Simple Algorithm" of David Eberly's "Polyline Reduction". The only addition is that I treat the list as cyclic since we work with closed polygon, not with an open polyline. The algorithm is vastly inefficient and has no quality control (...

9

We can find a 7th order polynomial that meets the requirement if we minimise the $\infty$-norm. For simplicity I construct an array of {x, 6 ArcTan[x]} over the required range and plug it into FindFit, no doubt there are better ways. {a, b} = {-1, 1}/Sqrt[3]; data = Table[{x, 6 ArcTan[x]}, {x, a, b, (b - a)/1000.}]; n = 7; expr = Sum[c[i] x^i, {i, 1, n, 2}];...

9

The best analytic built-in approximation is the Riemann Prime Counting Function; it is implemented in Mathematica as RiemannR. So far we know exact values of $\pi$ prime counting function for n < 10^25, however in Mathematica its counterpart PrimePi[n] can be computed exactly to much lower values i.e. up to 25 10^13 -1, see e.g. What is so special about ...

9

The following is fast and suggests an almost straight and horizontal line: p = Range[0, 1, 1/100]; v[x_] := v[x] = ChebyshevT[6, x] f[x_?NumericQ, a_?NumericQ, b_?NumericQ, c_?NumericQ] := a x x + b x + c abs[x_?NumericQ, a_?NumericQ, b_?NumericQ, c_?NumericQ] := (v[x] - f[x, a, b, c])^2 maxabs[a_?NumericQ, b_?NumericQ, c_?NumericQ] := Max[abs[#, a, b, c] ...

9

Introduction Radial basis function approximation has the form $$f(x) \approx \sum_{j=1}^N c_j \phi(\| x-x_j\|)$$ for some function $\phi(r)$ such as a Gaussian. Solving for the coefficients $c_j$ is a linear problem and might be done either as a least-squares fit or as an interpolation problem. As mentioned on the Community posting, http://community.wolfram....

9

Well, FoldList also can finish this job: 2/Times @@ (1/2 FoldList[Sqrt[2 + #] &, ConstantArray[Sqrt[2.], 10]]) By the way, by putting the one half just before NestList, FoldList can save one's effort for counting the number of twos in the denominators.

9

We construct an NDSolve method which can pass an NIntegrate method to NIntegrate to set up an integration rule. We define a method nintegrate implements such a method. The requirements are the ODE is of the form y'[x] == f[x], and the NIntegrate method returns an interpolatory rule. Example: foo = NDSolveValue[{y'[x] == Sin[x^2], y[0] == 0}, y, {x, 0, 15}...

8

Take a series around infinity, dropping all $1/x^n$ terms. Series[1/x + x^2, {x, \[Infinity], 0}] (* x^2+O[1/x]^1 *) Use Normal to obtain an ordinary expression from the SeriesData object. A slightly more complicated example: the hyperbola represented by $\sqrt{x^2-1}$ has asymptote $y=x$ for positive $x$; so we get: Normal@Series[Sqrt[x^2 - 1], {x, \[...

8

One can construct a Chebyshev series approximation to the integrand for an interval, such as -5 <= x <=5 mentioned in the comments, and integrate it to get a series expansion for the integral. It is well known that Chebyshev series representation have numerical advantages over power series. I saw a comment about a NPU-supported method, but I don't ...

8

The integral is Pi/2, a proof of which may be found on math.SE. Here's a numerical check, integrating $(\tan z)/z$ over parallel paths $z = x \pm a i$ and subtracting $(2 a)/(a^2 + x^2)$ to get NIntegrate to converge. The OP's integral is equal to the sum of the two below. a = 50; 1/2 NIntegrate[ Tan[x + a I]/(x + a I) + Tan[x - a I]/(x - a I) - (2 ...

8

Try WolframAlpha guess[x_]:=WolframAlpha["identify "<>ToString@x]

7

Here is how I would do it: expr = 1/((x + a + b) (c + d)); Limit[ ϵ expr /. Thread[# -> ϵ #] &@Select[Variables[expr], # =!= x &], ϵ -> 0 ] (* ==> 1/(c x + d x) *) I replaced all variables except x by ϵ times themselves and took the limit of ϵ times the original expression as ϵ goes to zero. This will leave only terms linear in the ...

Only top voted, non community-wiki answers of a minimum length are eligible