#' Interactive Applet to Examine Taylor and Least Squares Approximations #' #' This applet displays a plot of a function, its Taylor series approximation, #' and a least squres approximation. #' #' #' @param expr a mathematical expression. See mosaic \code{D}. #' @param xlim The range of the dependent variable. #' @param \dots Additional arguments to \code{expr}. mTaylor <- function(expr, ...){ # packages if( !require(mosaic)) stop("Must load mosaic package.") if( !require(manipulate) ) stop("Must use a manipulate-compatible version of R, e.g. RStudio") # functions vals <- list(...) f <- mosaic::makeFun(expr, ..., strict.declaration=FALSE ) varname <- all.names(rhs(expr)) if( length(varname) > 1 ) stop("Function of > 1 variable.") xlim <- inferArgs( vars=varname, dots=vals, defaults=list(xlim=c(0,1)) )[[1]] x <- seq(min(xlim), max(xlim), length = 1000) # colors trans.blue <- rgb(0,0,1,.1) # least squares rectangle color rect.trans.blue <- rgb(0,0,1,.05) trans.red <- rgb(1,0,0,.1) # red polygon fill color font.size <- 13 line.blue <- rgb(0,0,1,.5) # least squares line color line.red <- rgb(1,0,0,.5) # Taylor line color # Derivatives of function for Taylor Series dd <- list() for (k in 1:10) dd[[k]] <- mosaic::symbolicD(expr,..., strict.declaration=FALSE, .order=k) myplot <- function(a, TaylorBeTrue, lsquares, xwid, n, err, which.plot){ # Taylor Series T <- list() # zeroth order is index 1 T[[1]] <- f(a) + 0*x for (k in 2:11) { T[[k]] <- T[[k-1]] + (dd[[k-1]](a)*((x-a)^(k-1)))/factorial(k-1) } # Least Squares: Row 1 is order 0 myx <- seq(a-xwid/2, a+xwid/2, length = 1000) A <- outer(myx-a, 0:n, "^") coefs <- qr.solve(A, f(myx)) lsq.func <- 0 for(j in 0:n){ lsq.func <- lsq.func+(x-a)^(j)*coefs[[j+1]] } # plotting mypanel <- function(x, y){ panel.points(a, f(a), cex = 2) if(lsquares){ panel.xyplot(x, lsq.func, type = "l", col = line.blue, lwd = 5) panel.rect(xright=min(myx), xleft=max(myx), ybottom=-999999, ytop = 999999, col = rect.trans.blue, border = FALSE) ypts <- lsq.func # lSquares RMSE from myPanel inds <- which( x > min(myx) & x < max(myx) ) .newY <- c(0,y,0); .newYPts <- c(0,ypts,0) myY <- .newYPts[inds]-.newY[inds] lsRMS <- abs(sqrt(mean(myY^2))*diff(range(myx))) grid.text(label = paste("Least Squares RMS error: ", signif(lsRMS,4)), x = unit(0,"npc")+unit(1, "mm"), y = unit(1,"npc")-unit(1.5, "lines"), just ="left", gp = gpar(col = "blue", fontsize =font.size)) } if(TaylorBeTrue){ panel.points(x, T[[as.numeric(n)+1]], type = "l", col = line.red, lwd = 5) ypts <- c(T[[as.numeric(n)+1]]) # TAYLOR RMSE from myPanel inds <- which(x>min(myx)&xmin(myx)&xmin(myx)&x