# 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

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}

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.

13

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

13

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] &; ...

12

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

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

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

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

There are many examples on the Wolfram Demonstrations web site on this topic: http://demonstrations.wolfram.com/search.html?query=pi%20approximations These examples come with the code that generated them and allow you to make your own variations.

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 (other than visual), but ...

10

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

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

8

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]

8

I am going to go out on a limb here as my mathematics is not as solid as I would like in this area. But, the primary difference between a Taylor series and expansion in terms of Chebyshev polynomials is the Chebyshev expansion is global while the Taylor series is not. Hence, the phrase "expanding around a point" is not applicable in the Chebyshev case. ...

8

The problem seems to be that outArea = Last /@ ComponentMeasurements[points, "Area"] // Total; estimates the area of the whole square image, not of the disk or the points. For instance, with SeedRandom[1]; points = Show[ Graphics[{Pink, Point /@ Select[Partition[RandomReal[{-1, 1}, 100000], 2], ({a, b} = #; a^2 + b^2 <= 0.98) &...

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

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.

7

Could work with a low discrepancy rather than pseudorandom sequence. These tend to be better for avoiding approximation errors associated with "clumping" (and the corresponding "empty regions") that one gets with the latter. The code below will provide a sequence that is uniformly distributed modulo 1 in the unit square and seems to be low discrepancy, ...

7

Yes, I believe the NR authors neglected to halve the last coefficient in their formulae (the halving is due to the fact that $T_1(x)=x$, not $2x$). As a check on the correctness of your coefficients, I'll use (a special case of) Salzer's algorithm to produce Chebyshev coefficients from the monomial coefficients: c = CoefficientList[-4.1261 + .99213 x - 0....

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