Let’s try the Bernstein Expansion formula.
Bernstein expansion of an arbitraty function is:
B(n, f) at x is equal to Sum(from nu=0 to nu=n, f(nu/n) * Bern(nu,n,x)
The nature of this expression is really interesting. It’s a functional. The support is [0,1], also the expanded part of the function f lies on the [0,1] segment (because for n < nu < 0 Bern is 0)
Also, the formula ‘discretizes’ a continuous function into ‘points’ f(nu/n) the number of which is limited by the number of the polynomials in the basis. The image of the function is the function itself and this is the property of the Bernstein basis polynomials which are based on this ‘limit’ property of the Binomial distribution.
Let’s define an expression as a function
Bernstein <- function(n, f, x, sc = 1) {
# n = number of polynomials in the basis
# f - name of the function without quotes
# x - vector of x
# sc - scale for the value of the argument for f, default - 1.0
b <- 0 ##initialize
for(nu in 0:n) {
b <- b + f(sc*nu/n) * dbinom(nu, n, x, log = FALSE)
}
return(b) # requires so that it would return a vector
}
As an example let’s expand a whole sin period
x <- seq(0, 1, .01)
n <- c(200)
B <- Bernstein(n, sin, x, sc=2*pi)
qplot(x, B, color = I("red"),
size = I(1), alpha = I(1/2), geom = c("point", "line"))

Add a new chunk by clicking the Insert Chunk button on the toolbar or by pressing Ctrl+Alt+I.
When you save the notebook, an HTML file containing the code and output will be saved alongside it (click the Preview button or press Ctrl+Shift+K to preview the HTML file).
LS0tDQp0aXRsZTogIkJlcm5zdGVpbiBFeHBhbnNpb24gTm90ZWJvb2siDQpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sNCi0tLQ0KDQpMZXQncyB0cnkgdGhlIEJlcm5zdGVpbiBFeHBhbnNpb24gZm9ybXVsYS4NCg0KQmVybnN0ZWluIGV4cGFuc2lvbiBvZiBhbiBhcmJpdHJhdHkgZnVuY3Rpb24gaXM6DQoNCkIobiwgZikgYXQgeCBpcyBlcXVhbCB0byBTdW0oZnJvbSBudT0wIHRvIG51PW4sIGYobnUvbikgKiBCZXJuKG51LG4seCkNCg0KVGhlIG5hdHVyZSBvZiB0aGlzIGV4cHJlc3Npb24gaXMgcmVhbGx5IGludGVyZXN0aW5nLiANCiAgSXQncyBhIGZ1bmN0aW9uYWwuDQogIFRoZSBzdXBwb3J0IGlzIFswLDFdLCBhbHNvIHRoZSBleHBhbmRlZCBwYXJ0IG9mIHRoZSBmdW5jdGlvbiBmDQogIGxpZXMgb24gdGhlIFswLDFdIHNlZ21lbnQgKGJlY2F1c2UgZm9yIG4gPCBudSA8IDAgQmVybiBpcyAwKQ0KDQpBbHNvLCB0aGUgZm9ybXVsYSAnZGlzY3JldGl6ZXMnIGEgY29udGludW91cyBmdW5jdGlvbiBpbnRvICdwb2ludHMnIGYobnUvbikgdGhlIG51bWJlciBvZiB3aGljaCBpcyBsaW1pdGVkIGJ5IHRoZSBudW1iZXIgb2YgdGhlIHBvbHlub21pYWxzIGluIHRoZSBiYXNpcy4gVGhlIGltYWdlIG9mIHRoZSBmdW5jdGlvbiBpcyB0aGUgZnVuY3Rpb24gaXRzZWxmIGFuZCB0aGlzIGlzIHRoZSBwcm9wZXJ0eSBvZiB0aGUgQmVybnN0ZWluIGJhc2lzIHBvbHlub21pYWxzIHdoaWNoIGFyZSBiYXNlZCBvbiB0aGlzICdsaW1pdCcgcHJvcGVydHkgb2YgdGhlIEJpbm9taWFsIGRpc3RyaWJ1dGlvbi4NCg0KTGV0J3MgZGVmaW5lIGFuIGV4cHJlc3Npb24gYXMgYSBmdW5jdGlvbg0KDQpgYGB7cn0NCkJlcm5zdGVpbiA8LSBmdW5jdGlvbihuLCBmLCB4LCBzYyA9IDEpIHsNCg0KIyBuID0gbnVtYmVyIG9mIHBvbHlub21pYWxzIGluIHRoZSBiYXNpcw0KIyBmIC0gbmFtZSBvZiB0aGUgZnVuY3Rpb24gd2l0aG91dCBxdW90ZXMNCiMgeCAtIHZlY3RvciBvZiB4DQojIHNjIC0gc2NhbGUgZm9yIHRoZSB2YWx1ZSBvZiB0aGUgYXJndW1lbnQgZm9yIGYsIGRlZmF1bHQgLSAxLjANCiAgDQogIGIgPC0gMCAgICAgIyNpbml0aWFsaXplDQogIA0KICBmb3IobnUgaW4gMDpuKSB7DQogICAgYiA8LSBiICsgZihzYypudS9uKSAqIGRiaW5vbShudSwgbiwgeCwgbG9nID0gRkFMU0UpDQogIH0NCiAgcmV0dXJuKGIpICAjIHJlcXVpcmVzIHNvIHRoYXQgaXQgd291bGQgcmV0dXJuIGEgdmVjdG9yDQp9DQpgYGANCg0KQXMgYW4gZXhhbXBsZSBsZXQncyBleHBhbmQgYSB3aG9sZSBzaW4gcGVyaW9kDQoNCmBgYHtyfQ0KeCA8LSBzZXEoMCwgMSwgLjAxKQ0KbiA8LSBjKDIwMCkNCg0KQiA8LSBCZXJuc3RlaW4obiwgc2luLCB4LCBzYz0yKnBpKQ0KDQpxcGxvdCh4LCBCLCBjb2xvciA9IEkoInJlZCIpLCANCiAgICAgIHNpemUgPSBJKDEpLCBhbHBoYSA9IEkoMS8yKSwgZ2VvbSA9IGMoInBvaW50IiwgImxpbmUiKSkNCmBgYA0KDQpBZGQgYSBuZXcgY2h1bmsgYnkgY2xpY2tpbmcgdGhlICpJbnNlcnQgQ2h1bmsqIGJ1dHRvbiBvbiB0aGUgdG9vbGJhciBvciBieSBwcmVzc2luZyAqQ3RybCtBbHQrSSouDQoNCldoZW4geW91IHNhdmUgdGhlIG5vdGVib29rLCBhbiBIVE1MIGZpbGUgY29udGFpbmluZyB0aGUgY29kZSBhbmQgb3V0cHV0IHdpbGwgYmUgc2F2ZWQgYWxvbmdzaWRlIGl0IChjbGljayB0aGUgKlByZXZpZXcqIGJ1dHRvbiBvciBwcmVzcyAqQ3RybCtTaGlmdCtLKiB0byBwcmV2aWV3IHRoZSBIVE1MIGZpbGUpLg0K