I want to get the derivative value from the function below when x = 2. Is there way to keep the form of the function and also get derivative value with out any additional package?
f <- function(x)
return(x^3)
For example, I have tried below but they didn't work.
x=2
deriv(~f, "x")
x=2
deriv(~body(f),"x")
x=2
D(expression(f),"x")
You can use deriv, however, one caveat is that you can only use expressions/calls.
derivative = deriv(~ x^3, "x")
x <- 2
eval(derivative )
With a named expression:
f = expression(x^3)
dx2x <- D(f,"x")
and the rest is the same.
See this link for the documentation:
https://www.rdocumentation.org/packages/Deriv/versions/3.8.2/topics/Deriv
This would be approximation
foo = function(x, delta = 1e-5, n = 3){
x = seq(from = x - delta, to = x + delta, length.out = max(2, n))
y = x^3
mean(diff(y)/diff(x))
}
foo(2)
#[1] 12
Related
I need to find the value of a parameter which make my function produce a specific result.
I write down something like this:
## Defining the function
f = function(a, b, c, x) sqrt(t(c(a, b, c, x)) %*% rho %*% c(a, b, c, x))
## Set di input needed
rho <- matrix(c(1,0.3,0.2,0.4,
0.3,1,0.1,0.1,
0.2,0.1,1,0.5,
0.4,0.1,0.5,1),
nrow = 4, ncol = 4)
target <- 10000
## Optimize
output <- optimize(f, c(0, target), tol = 0.0001, a = 1000, b = 1000, c = 1000, maximum = TRUE)
I would like to derive di value of x related to the maximum of my function (the target value).
Thanks,
Ric
You can find one such x with closed formula. For symmetric matrices (like the one you have) you can achieve target value by vector x where x is defined as:
spectral_decomp <- eigen(rho, TRUE)
eigen_vec1 <- spectral_decomp$vectors[,1]
lambda1 <- spectral_decomp$values[[1]]
target <- 1000
x <- (target / sqrt(lambda1)) * eigen_vec1
check:
sqrt(matrix(x, nrow = 1) %*% rho %*% matrix(x, ncol = 1))
Within R i implemented the well-known gradient descent algorithm :
grad_descent<-function(iter = 100, alpha = 0.001 ){
# define the objective function f(x)
# iter is the number of itérations to try
# alpha is the step parameter
objFun = function (x,y) return(x^2+y^2) #sphere function / objective function
# define the gradient of f(x)
# Note we don't split up the gradient
gradient <- function(x , y) {
result <- c(2*x,2*y) # vector of gradient / partial dérivatives
return(result)
}
init = c(1,1) #initial point search
x <- init[1]
y <- init[2]
# create a vector to contain all xs for all steps
x.All = numeric(iter)
y.All = numeric(iter)
# gradient descent method to find the minimum
for(i in seq_len(iter)){
# Guard against NaNs
tmp <- c(x,y) - alpha * gradient(x,y)
if ( !is.nan(suppressWarnings(objFun(tmp[1], tmp[2]))) ) {
x <- tmp[1]
y <- tmp[2]
}
x.All[i] = x
y.All[i] = y
print(c(i, x,y, objFun(x,y))) # we print the current itération with corresponding objective function value
}
# print result and plot all xs for every iteration
print(paste("The minimum of f(x) is ", objFun(x,y), " at position x = ", x, sep = ""))
plot(x.All, type = "l")
print(paste("The minimum of f(x) is ", objFun(x ,y), " at position y = ", y, sep = ""))
plot(y.All, type = "l")
}
# Example of excecution
grad_descent(iter = 100, alpha = 0.01 )
The formula of gradient descent algorithm is as follow :
X(0) is the starting point gived by the user.
X(t)=X(t-1)-alpa*gradient(X(n-1))
where :
alpha is the step and X(t-1) is the vector of the previous obtained optimum.
The problem :
My code works fine in 2d but it cannot be used for an objective function that has n variables ( n-dimensions ).
Also i need a way such to use objFun as argument of the function grad_descent which means something like :
grad_descent(objFun,iter = 100, alpha = 0.001)
I wish my question is clear.
Thank you a lot for help !
objFun = function (x) return(sum(x^2)) #sphere function / objective function
grad_descent<-function(objFun ,iter = 100, alpha = 0.001 , start_init ){
# define the objective function f(x)
# iter is the number of itérations to try
# alpha is the step parameter
# define the gradient of f(x)
# Note we don't split up the gradient
gradient <- function(x) {
result <- c(2*x) # vector of gradient / partial dérivatives
return(result)
}
init = start_init #initial point search
x <- init
# create a vector to contain all xs for all steps
x.All = numeric(iter)
# gradient descent method to find the minimum
for(i in seq_len(iter)){
# Guard against NaNs
tmp <- c(x) - alpha * gradient(x)
if ( !is.nan(suppressWarnings(objFun(tmp))) ) {
x <- tmp
}
print(c(i, x,objFun(x))) # we print the current itération with corresponding objective function value
}
# print result and plot all xs for every iteration
print(paste("The minimum of f(x) is ", objFun(x), " at position x = ", x, sep = ""))
plot(x.All, type = "l")
}
# Example of excecution
grad_descent(objFun ,iter = 100, alpha = 0.01,c(1,1,1))
I am trying to set up a function in R that computes a polynomial
P(x) = c1 + c2*x + c3*x^2 + ... + cn-1*x^n-2 + cn*x^n-1
for various values of x and set coefficients c.
Horner's method is to
Set cn = bn
For i = n-1, n-1, ..., 2, 1, set bi = bi+1*x + ci
Return the output
What I have so far:
hornerpoly1 <- function(x, coef, output = tail(coef,n=1), exp = seq_along(coef)-1) {
for(i in 1:tail(exp,n=1)) {
(output*x)+head(tail(coef,n=i),n=1)
}
}
hornerpoly <- function(x, coef) {
exp<-seq_along(coef)-1
output<-tail(coef,n=1)
if(length(coef)<2) {
stop("Must be more than one coefficient")
}
sapply(x, hornerpoly1, coef, output,exp)
}
I also need to error check on the length of coef, that's what the if statement is for but I am not struggling with that part. When I try to compute this function for x = 1:3 and coef = c(4,16,-1), I get three NULL statements, and I can't figure out why. Any help on how to better construct this function or remedy the null output is appreciated. Let me know if I can make anything more clear.
How about the following:
Define a function that takes x as the argument at which to evaluate the polynomial, and coef as the vector of coefficients in decreasing order of degree. So the vector coef = c(-1, 16, 4) corresponds to P(x) = -x^2 + 16 * x + 4.
The Horner algorithm is implemented in the following function:
f.horner <- function(x, coef) {
n <- length(coef);
b <- rep(0, n);
b[n] <- coef[n];
while (n > 0) {
n <- n - 1;
b[n] <- coef[n] + b[n + 1] * x;
}
return(b[1]);
}
We evaluate the polynomial at x = 1:3 for coef = c(-1, 16, 4):
sapply(1:3, f.horner, c(-1, 16, 4))
#[1] 19 47 83
Some final comments:
Note that the check on the length of coef is realised in the statement while (n > 0) {...}, i.e. we go through the coefficients starting from the last and stop when we reach the first coefficient.
You don't need to save the intermediate b values as a vector in the function. This is purely for (my) educational/trouble-shooting purposes. It's easy to rewrite the code to store bs last value, and then update b every iteration. You could then also vectorise f.horner to take a vector of x values instead of only a scalar.
My objective is to evaluate and to plot the following log-likelihood function with two parameters:
set.seed(123)
N = 100
x = 4*rnorm(N)
y = 0.8*x + 2*rnorm(N);
LogL <- function(param,x,y,N){
beta = param[1]
sigma2 = param[2]
LogLikelihood = -N/2*log(2*pi*sigma2) - sum( (y - beta*x)^2 / (2*sigma2) ) }
I've tried using 'outer' in order to use 'wireframe' as in the following thread:
How can I plot 3D function in r?
but without success:
param1 <- seq(-2, 2, length= 30)
param2 <- seq(0.1, 4, length= 30)
values1 <- matrix(c(param1,param2),30)
z <- outer(values1, x=x,y=y,N=N, LogL)
How can I use 'outer' properly in this case? Is there any other alternative to evaluate and to plot the function 'LogL'?
The first question is that outer() needs to have the two arguments to LogL() as separate vectors, which means rewriting your function to use the two arguments instead of one length 2 argument that you unpack. In addition, (from ?outer)
Each will be extended by rep to length the products of the lengths of X and Y before FUN is called.
so the function needs to deal with ALL the possible values of X and Y in a single call. There's probably a better way to do this, but in the interest of simplicity, I used a for() loop to loop over the different values of X and Y.
set.seed(123)
N = 100
x = 4*rnorm(N)
y = 0.8*x + 2*rnorm(N);
LogL <- function(param1, param2, x, y, N){
beta = param1
sigma2 = param2
LogLikelihood = vector("numeric",length(beta))
for (i in 1:length(beta)){
LogLikelihood[i] = -N/2*log(2*pi*sigma2[i]) - sum( (y - beta[i]*x)^2 / (2*sigma2[i]) )
}
return(LogLikelihood)
}
param1 <- seq(-2, 2, length= 30)
names(param1) <- param1
param2 <- seq(0.1, 4, length= 30)
names(param2) <- param2
z <- outer(X = param1, Y = param2, FUN = LogL, N = N, x = x, y = y)
require(lattice)
#> Loading required package: lattice
wireframe(z, drape=T, col.regions=rainbow(100))
# test it out
LogL(param1[3], param2[3], x = x, y = y, N = N)
#> [1] -11768.37
z[3,3]
#> [1] -11768.37
and that works.
Created on 2018-03-13 by the reprex package (v0.2.0).
I have 1 know value of x. and I too have 1 formula. y = 0.92x now I want to flip LHS to RHS expected output will be x = y/0.92 its for multiplication and division. It should handle all basic mathematical operations. Is there any package for this in R or any one have defined function in R
I don't think there is any way to accomplish what you want. Rewriting mathematical formulas while they are represented as R functions is not an easy thing to do. What you can do is use uniroot to solve functions. For example:
# function for reversing a function. y is your y value
# only possible x values in interval will be considered.
inverseFun = function(y, fun, interval = c(-1e2, 1e2), ...) {
f = function(.y, .fun, ...) y - fun(...)
uniroot(f, interval, .y = y, .fun = fun, ...)
}
# standard math functions
add = function(a, b) a + b
substract = function(a, b) a - b
multiply = function(a, b) a * b
divide = function(a, b) a / b
# test it works
inverseFun(y = 3, add, b = 1)
# 2
inverseFun(y = -10, substract, b = 1)
# -9
inverseFun(y = 30, multiply, b = 2)
# 15
inverseFun(y = 30, divide, b = 1.75)
# 52.5
The above is an example, inverseFun(y = 3, `+`, b = 1) also works although it might be less clear what is happening. A last remark is that uniroot tries to minimize a function which might be time consuming for complicated functions.