Inverse of matrix and numerical integration in R - r

in R I try to
1) get a general form of an inverse of a matrix (I mean a matrix with parameters instead of specific numbers),
2) then use this to compute an integral.
I mean, I've got a P matrix with a parameter theta, I need to add and subtract something, then take an inverse of this and multiply it by a vector so that I am given a vector pil. From the vector pil I take term by term and multiply it by a function with again the parameter theta and the result must be integrated from 0 to infinity.
I tried this, but it didn't work because I know the result should be pst=
(0.3021034 0.0645126 0.6333840)
c<-0.1
g<-0.15
integrand1 <- function(theta) {
pil1 <- function(theta) {
P<-matrix(c(
1-exp(-theta), 1-exp(-theta),1-exp(-theta),exp(-theta),0,0,0,exp(-theta),exp(-theta)
),3,3);
pil<-(rep(1,3))%*%solve(diag(1,3)-P+matrix(1,3,3));
return(pil[[1]])
}
q<-pil1(theta)*(c^g/gamma(g)*theta^(g-1)*exp(-c*theta))
return(q)}
(pst1<-integrate(integrand1, lower = 0, upper = Inf)$value)
#0.4144018
This was just for the first term of the vector pst, because when I didn't know how to a for cycle for this.
Please, do you have any idea why it won't work and how to make it work?

Functions used in integrate should be vectorized as stated in the help.
At the end of your code add this
integrand2 <- Vectorize(integrand1)
integrate(integrand2, lower = 0, upper = Inf)$value
#[1] 0.3021034
The result is the first element of your expected result.
You will have to present more information about the input to get your expected vector.

Related

What are the correct Conditions to test for Weighted Die?

I was commanded with the following question. Write a function, named pdice, to simulate a weighted die that has probability of landing on 1:6 of (p1,p2,p3,p4,p5,p6) respectively. You can simulate this by using the parameter prob = p in the sample function, where p is a vector of non-negative numbers of length 6 (at least one needs to be >0). It will use p/sum(p) as the probabilities. This function has arguments p, n. Check ?sample to find out what conditions you need to check for p. Your function should generate an error message if these conditions are not met. Below is my code thus far, which runs, though giving back a warning about a coercing error of double to logical.
pdice <- function(n, p){
weightofDies <- c(1/40, rep(4/40,4), 23/40)
roll <- sample(1:6, size = n, replace = TRUE, prob = weightofDies)
if(n>0 && all(p=1)) {
return(roll)
}
else {
print("Error, Conditions Not Met")
}
}
I'm confused when the question says use parameter prob = p, then defines p as a vector of non-negative numbers of length 6. How can a probability be defined as a vector? Thus when it came to the conditions my brief understanding made sure the number of rolls (n) was greater than zero. And with p I just went on ahead to make sure the probabilities of this "Vector" added up to one. However not sure if my process thus far is correct. I created my biased probabilities via weightofDies.

compute the integration in R

I compute the cumulative distribution function whose result should lie in [0,1]. The equation for computing the CDF is:
\begin{align}
F= \int_{\hat{a}}^{x}\frac{2}{\hat{b}-\hat{a}} ~\sum \nolimits_{k=0}^{' N-1} C_{k}~\text{cos} \bigg( \big(y - \hat{a} \big) \frac{k \pi}{\hat{b} - \hat{a}}\bigg) ~dy
\end{align}
where
Ck is a vector
cos term is a vector
length(ck) = length(cos term) = N.
I am sure the equation is correct, but I am afraid my code is incorrect.
Here is my code:
integrand<-function(x,myCk)
{
(2/(b-a))*(t(myCk)%*%as.matrix(cos((x-hat.a)*uk)))
}
f <- function(x){integrand(x,myCk)}
# define a vectorized version of this function
fv <- Vectorize(f,"x")
res<-integrate(fv,upper = r,lower = hat.a, subdivisions = 2000)$value
resreturns the cumulative distribution function, and the result can be larger than 1.
myCkis a vector generated by another function.
hat.ais the lower bound for integration, and it is negative.
ukis a vector generated by a function. The length of ukequals the length of myCk.
I appreciate your advice!

Finding the Maximum of a Function with numerical derivatives in R

I wish to numerically find the maximum of the function multiplied by Beta 3 shown on p346 of the following link when tau=30:
http://www.ssc.upenn.edu/~fdiebold/papers/paper49/Diebold-Li.pdf
They give the answer on p347 as 0.0609.
I would like to confirm this numerically in R. I.e. to take the derivative and find the value where it reaches zero.
library(numDeriv)
x <- 30
testh <- function(lambda){ ((1-exp(-lambda*30))/(lambda*30)) - exp(-lambda*30) }
grad_h <- function(lambda){
val <- grad(testh, lambda)
return(val^2)
}
OptLam <- optimize(f=grad_h, interval=c(0.0001,120), tol=0.0000000000001)
I take the square of the gradient as I want the minimum to be at zero.
Unfortunately, the answer comes back as Lambda=120!! With lambda at 120 the value of the objective function is 5.36e-12.
By working by hand I can func a lower value of the numerical derivative that is closer to zero (it is also close to the analytical value given above):
grad_h(0.05977604)
## [1] 4.24494e-12
Why is the function above not finding this lower value? I have set the tolerance very high so it should be able to find such this optimal value?
Is it possible to correct the existing method so that it gives the correct answer?
Is there a better way to find the maximum gradient of a function numerically in R?
For example is there an optimizer that looks for zero rather than trying to find a minimum of maximum?
You can use uniroot to find where the derivative is 0. This might work for you,
grad_h <- function(lambda){
val=grad(testh,lambda)
return(val)
}
## The root
res <- uniroot(grad_h, c(0,120), tol=1e-10)
## see it
ls <- seq(0.001, 1, length=1000)
plot(ls, testh(ls), col="salmon")
abline(v=res$root, col="steelblue", lwd=2, lty=2)
text(x=res$root, y=testh(res$root),
labels=sprintf("(%f, %s)", res$root,
format(testh(res$root), scientific = T)), adj=-0.1)

Integrate a function in R through time

I would like to integrate the following function with respect to t, for lower bound = 0 and upper bound = t. I can do that with the following code, but my ultimate goal is to have a value of the integral for each t. Even if I make t a sequence instead of a value, or if I try and use sapply, I still cannot get a value for the integral at each step of t.
#initialize constants
kap=-0.1527778
alph0<-6
b<-0
po<-0.01
t<-100
gp_st<-integrate(function(t) (1-alph0/(alph0+b*t)*(1-po^kap))^(1/kap),lower=0,upper=t)$value
#try alternate where t is now a sequence
t<-seq(1:100)
gp_st2<-function(h) sapply(h,gp_st) #still gives length of 1
Thanks!
Try making gp_st a function of your upper bound, like so:
gp_st <- function(h) {
integrate(function(t) (1-alph0/(alph0+b*t)*(1-po^kap))^(1/kap),lower=0,upper=h)$value
}
Then you can use sapply much as you intended:
t<-seq(1:100)
gp_st2 <- sapply(t, gp_st)
and now gp_st2 is a numeric vector of length 100.
The problem is that you are evaluating the integral in gp_st, and you don't want to do that. You want the following:
ff = function(t) {
(1-alph0/(alph0+b*t)*(1-po^kap))^(1/kap)
}
sapply(1:100, function(ul) {
integrate(ff, lower = 0, upper = ul)$value
})
There are naturally more efficient ways to do this.

how to set the constraints for constrOptim

I have a function that has needs weights to be applied to a matrix to return a scalar value. But the weights can only be between an upper and lower bound say c(-5,5), and must sum to less than a numerical value y. How does one apply these contraints to the constrOptim function?
So for example my function could be any function that does the trick but im going to provide a mock example one anyway...(I think its non-linear...)
example weights are where y==1 is say
weights <- c(0.1,0.4,0.5)
require(timeSeries)
objective.fun <- function(weights, matrix.obj){
sum( colSds( matrix.obj * rep(weights,each=nrow(matrix.obj)) )
}
and an example matrix.obj of say
matrix.obj <- data.frame(cbind(x=rnorm(100), y=rnorm(100), z=rnorm(100)))
The number of columns is variable....

Resources