So im trying to solve an equation that have 3 unknown factor. I decided to use nlm.
I defined my function F that take 3 parameters that are put in a vector, and what im trying to find is the vetor X that verify the following equation :
F(X)-F(X1)-F(X2)-F(X3)=0
so I applied nlm to the LHS. but i get some weird results, instead of having a solution that make the LHS close to zero, it give solution that make the LHS converge to -infinite
Can anyone point me to the right direction.
Thank you all in advance :)
rm(list=ls())
Ta <- 30 #commun parameter
c <- 0.09 #commun parameter
Delta_T <- c( 10, 20, 30 ) #vector containing X1(1), X2(1) and X3(1)
tetha <- c( 0.9, 1.1, 1.5 ) #vector containing X1(2), X2(2) and X3(2)
t <- c( 300, 400, 100 )
N <- t/tetha #vector containing X1(3), X2(3) and X3(3)
F <- function(X){ #definition of function F
x <- X[1]
y <- X[2]
N <- X[3]
N*(min(c(y,2))/2)^1/3*x^1.9*exp(-1414/(x+Ta+273))*(1+c*(x/20)^2.1*(2/min(y,2))^1/3)
}
S <- vector("numeric",length(t)) #creation of F(X1) F(X2) and F(X3)
for (i in 1:length(t)) {
S[i]=F(c(Delta_T[i],tetha[i],N[i]))
}
Eq <- function(X){ #creation of F(X)-F(X1)-F(X2)-F(X3)
F(X)-sum(S)}
p <- c(min(Delta_T),min(tetha),min(N))
Sol = nlm(Eq,p)
EDIT : so I found the solution to the problem, instead of writing
Eq <- function(X){ #creation of F(X)-F(X1)-F(X2)-F(X3)
F(X)-sum(S)}
I applied abs() to the function Eq
Eq <- function(X){ #creation of F(X)-F(X1)-F(X2)-F(X3)
abs(F(X)-sum(S)) }
I dont get satisfying results doe, the error is close to 0 but X[2] is way bigger then 2 because of the min(2,X[2])
So i found the solution to this problem, instead of using the function nlm to solve my non linear equation, I used the function auglag from the package nloptr.
Eq <- function(X){ #creation of F(X)-F(X1)-F(X2)-F(X3)
F(X)-sum(S)}
p <- c(min(Delta_T),min(tetha),min(N))
Sol = auglag(p,Eq,hin = Eq)
auglag is a very strong non linear optimization algorithme. And the results are very satisfying as i get an error 10e-7
Related
I apologise if this is a duplicate; I've read answers to similar questions to no avail.
I'm trying to integrate under a curve, given a specific formula (below) for said integration.
As a toy example, here's some data:
Antia_Model <- function(t,y,p1){
r <- p1[1]; k <- p1[2]; p <- p1[3]; o <- p1[4]
P <- y[1]; I <- y[2]
dP = r*P - k*P*I
dI = p*I*(P/(P + o))
list(c(dP,dI))
}
r <- 0.25; k <- 0.01; p <- 1; o <- 1000 # Note that r can range btw 0.1 and 10 in this model
parms <- c(r, k, p, o)
P0 <- 1; I0 <- 1
N0 <- c(P0, I0)
TT <- seq(0.1, 50, 0.1)
results <- lsoda(N0, TT, Antia_Model, parms, verbose = FALSE)
P <- results[,2]; I <- results[,3]
As I understand it, I should be able to use the auc() function from the MESS package (can I just use the integrate() function? Unclear...), which should look something like this:
auc(P, TT, from = x1, to = x2, type = "spline")
Though I don't really understand how to use the "from" and "to" arguments, or how to incorporate "u" from the original integration formula...
Using the integrate() function seems more intuitive, but if I try:
u <- 1
integrand <- function(P) {u*P}
q <- integrate(integrand, lower = 0, upper = Inf)
I get this error:
# Error in integrate(integrand, lower = 0, upper = Inf) :
# the integral is probably divergent
As you can tell, I'm pretty lost, so any help would be greatly appreciated! Thank you so much! :)
integrand is technically acceptable but right now, it's the identity function f(x) = x. The area under it from [0, inf) is infinite, i.e. divergent.
From the documentation of integrate the first argument is:
an R function taking a numeric first argument and returning a numeric vector of the same length. Returning a non-finite element will generate an error.
If instead you use a pulse function:
pulse <- function(x) {ifelse(x < 5 & x >= 0, 1, 0)}
integrate(pulse, lower = 0, upper = Inf)
#> 5 with absolute error < 8.5e-05
I want to use the “fsolve” function solution of nonlinear equations, equations and code is as follows, but I can only use “fsolve”function only to find the solution of a set of nonlinear equations, for example, I have three number in the A and B coefficient（A_coeff and B_coeff）, according to my idea is that each number after formulas to calculate a set of solution, then three, there should be three sets of solution, what can I do to achieve them
A_coeff<-c(177506.9,177639.3,178039.4)
B_coeff<-c(0.0003485474,0.0005155126,0.0004671370)
C_coeff<-5.511464
D_coeff<-23.39138
E_coeff<-5.0866e+17
F_coeff<-0.9732414
library('pracma')
Para_fun <- function(temp1) {
new <- sqrt((4*temp1-1)/3)
return(new)
}
Para_fun2<- function(temp1) {
new2 <- ceiling(temp1/C_coeff)
return(new2)
}
F_try<- function(x){
s_actual <- x[1]
K_actual <- x[2]
n_tube <- x[3]
c( A_coeff/K_actual-s_actual,
(B_coeff+F_coeff/(E_coeff/Para_fun(n_tube)^(2/3))^0.25)^-1-K_actual,
Para_fun2(s_actual)*D_coeff-n_tube)}
x0_xinitial_value<- c(20,2000,20)
X_result<- fsolve(F_try, x0_xinitial_value)
X_result$x
The easiest way to solve your problem is to solve the set of equations for each pair of A_coeff and B_coeff with a loop.
Redefine function F_try as (where I have rewritten the code to make easier to read and less confusing)
F_try<- function(x,k){
s_actual <- x[1]
K_actual <- x[2]
n_tube <- x[3]
y <- numeric(length(x))
y[1] <- A_coeff[k]/K_actual-s_actual
y[2] <- (B_coeff[k]+F_coeff/(E_coeff/Para_fun(n_tube)^(2/3))^0.25)^-1-K_actual
y[3] <- Para_fun2(s_actual)*D_coeff-n_tube
y
}
The argument k is the index of the vector of coefficient A_coeff and B_coeff.
If you try this like so
X_result <- matrix(NA,nrow=3,ncol=3)
xstart <- x0_xinitial_value
for( k in 1:3){
z <- fsolve(F_try, xstart,k=k)
X_result[k,] <- z$x
}
X_result
you will get an error message
Error in if (norm(s, "F") < tol || norm(as.matrix(ynew), "F") < tol) break :
with message
missing value where TRUE/FALSE needed
Calls: fsolve -> broyden
In addition: Warning message:
In sqrt((4 * temp1 - 1)/3) : NaNs produced
Execution halted
It is no immediately clear what is wrong and why the error occurs.
There is another package nleqslv which gives more insight into what is going wrong.
You can use it like this
library(nleqslv)
X_result <- matrix(NA,nrow=3,ncol=3)
xstart <- x0_xinitial_value
for( k in 1:3){
z <- nleqslv(xstart,F_try,k=k)
X_result[k,] <- z$x
}
X_result
Inspecting X_result shows that the third solution is most likely wrong.
Cutting a long story short it appears that for k=3 and the starting values you provided the algorithms cannot find a solution.
A solution is to make the starting value for each k equal to the solution for the previous k. Like so
X_result <- matrix(NA,nrow=3,ncol=3)
xstart <- x0_xinitial_value
for( k in 1:3){
z <- nleqslv(xstart,F_try,k=k)
X_result[k,] <- z$x
xstart <- z$x
}
X_result
resulting in
[,1] [,2] [,3]
[1,] 72.60480 2444.837 327.4793
[2,] 102.59563 1731.451 444.4362
[3,] 94.16426 1890.732 421.0448
It is advisable to check the exit code of nleqslv for each row of this matrix
to make sure that a solution was found.
I'm trying to compute a kind of Gini index using a generated dataset.
But, I got a problem in the last integrate function.
If I try to integrate the function named f1,
R says
Error in integrate(Q, 0, p) : length(upper) == 1 is not TRUE
My code is
# set up parameters b>a>1 and the number of observations n
n <- 1000
a <- 2
b <- 4
# generate x and y
# where x follows beta distribution
# y = 10x+3
x <- rbeta(n,a,b)
y <- 10*x+3
# the starting point of the integration having problem
Q <- function(q) {
quantile(y,q)
}
# integrate the function Q from 0 to p
G <- function(p) {
integrate(Q,0,p)
}
# compute a function
L <- function(p) {
numer <- G(p)$value
dino <- G(1)$value
numer/dino
}
# the part having problem
d <- 3
f1 <- function(p) {
((1-p)^(d-2))*L(p)
}
integrate(f1,0,1) # In this integration, the aforementioned error appears
I think, the repeated integrate could make a problem but I have no idea what is the exact problem.
Please help me!
As mentioned by #John Coleman, integrate needs to have a vectorized function and a proper subdivisions option to fulfill the integral task. Even if you have already provided a vectorized function for integral, it is sometimes tricky to properly set the subdivisions in integrate(...,subdivisions = ).
To address your problem, I recommend integral from package pracma, where you still a vectorized function for integral (see what I have done to functions G and L), but no need to set subdivisions manually, i.e.,
library(pracma)
# set up parameters b>a>1 and the number of observations n
n <- 1000
a <- 2
b <- 4
# generate x and y
# where x follows beta distribution
# y = 10x+3
x <- rbeta(n,a,b)
y <- 10*x+3
# the starting point of the integration having problem
Q <- function(q) {
quantile(y,q)
}
# integrate the function Q from 0 to p
G <- function(p) {
integral(Q,0,p)
}
# compute a function
L <- function(p) {
numer <- Vectorize(G)(p)
dino <- G(1)
numer/dino
}
# the part having problem
d <- 3
f1 <- function(p) {
((1-p)^(d-2))*L(p)
}
res <- integral(f1,0,1)
then you will get
> res
[1] 0.1283569
The error that you reported is due to the fact that the function in integrate must be vectorized and integrate itself isn't vectorized.
From the help (?integrate):
f must accept a vector of inputs and produce a vector of function
evaluations at those points. The Vectorize function may be helpful to
convert f to this form.
Thus one "fix" is to replace your definition of f1 by:
f1 <- Vectorize(function(p) {
((1-p)^(d-2))*L(p)
})
But when I run the resulting code I always get:
Error in integrate(Q, 0, p) : maximum number of subdivisions reached
A solution might be to assemble a large number of quantiles and then smooth it out and use that rather than your Q, although the error here strikes me as odd.
Environments and the like have always confused me incredibly in R. I guess therefore this is more of a reference request, since I've been surfing the site for the last hour in search of an answer to no avail.
I have a simple R function called target defined as follows
target <- function(x,scale,shape){
s <- scale
b <- shape
value <- 0.5*(sin(s*x)^b + x + 1)
return(value)
}
I then define the function AR
AR <- function(n,f,...){
variates <- NULL
for(i in 1:n){
z <- runif(1)
u <- runif(1)
if(u < f(z, scale, shape)/c){
variates[i] <- z
}else{next}
}
variates <- variates[!is.na(variates)]
return(variates)
}
in which the function target is being evaluated. Unfortunately, the call returns the following error
sample <- AR(n = 10000, f = target, shape = 8, scale = 5)
Error in fun(z, scale, shape) : object 'shape' not found
I know this has to do with the function AR not knowing where to look for the objects shape and scale, but I thought that was exactly the job of the ellipsis: allowing me to sort of put argument definition "on hold" until one actually calls the function. Where am I wrong and could anyone give me a lead as to where to look for insight on this specific problem?
You are very close, you just need to make use of your ellipses...
NB: c was not defined in AR so I added it and gave it a value.
NB2: I would refrain from using c and sample in your function as these themselves are functions and could cause some confusion downt he road.
AR <- function(n, f, c, ...){
variates <- NULL
for(i in 1:n){
z <- runif(1)
u <- runif(1)
if(u < f(z, ...)/c){ ##instead of using shape and scale use the ellipses and R will insert any parameters here which were not defined in the function
variates[i] <- z
}else{next}
}
variates <- variates[!is.na(variates)]
return(variates)
}
sample <- AR(n = 10000, f = target, shape = 8, scale = 5, c = 100)
I am trying to estimate the below log function using maximum likelihood method in R, but I get the following error:
Error in optim(start, f, method = method, hessian = TRUE, ...) : objective function in optim evaluates to length 10 not 1
My attempt was as follows:
Generating data
set.seed(101)
n <- 10
u <- runif(n)
theta1 <- 1
lamba1 <- 0.5
Generating PTIR data using quantile function
x <- function(u, theta1, lamba1) {
(-theta1/(log((1+lamba1)-sqrt((1+lamba1)^2-(4*lamba1*u)))/(2*lamba1)))^(1/(2))
}
x <- x(u = u, theta1 = theta1, lamba1 = lamba1)
Declaring the Log-Likelihood function
LL <- function(theta, lamba) {
R = suppressWarnings((n*log(2))+
(n*log(theta))-(((2)+1)*sum(log(x)))-
(sum(theta/(x^(2))))+
(log(1+lamba-(2*lamba*exp(-theta/(x^(2)))))))
return(-R)
}
mle(LL, start = list(theta = 5, lamba=0.5))
Any advice would be greatly appreciated.
I don't know how to fix your problem, but hopefully I can help you diagnose it. As #KonradRudolph suggests in comments, This may be a case where the usual advice "add more parentheses if you're not sure" may do more harm than good ... I've rewritten your function in a way that matches what you've got above, but has fewer parentheses and more consistent line breaking/indentation. Every line below is a separate additive term. Your specific problem is that the last term involves x (which has length 10 in this case), but is not summed, so the return value ends up being a length-10 vector.
LL2 <- function(theta, lambda) {
R <- n*log(2)+
n*log(theta)-
((2)+1)*sum(log(x))-
sum(theta/(x^2))+
log(1+lambda-(2*lambda*exp(-theta/x^2)))
return(-R)
}
all.equal(LL(1,1),LL2(1,1)) ## TRUE
length(LL2(1,1)) ## 10