So far, I have written the following function:
c_rate <- function (bond_value, par, ttm, y) {
t <- seq(1, ttm, 1)
pv_factor <- 1 / (1 + y)^t
cr <- (bond_value - par / (1+y)^t) / (par*sum(pv_factor))
cr
}
however, this yields multiple results.
How can i update the function to only yield one the final index only?
I think you want to raise (1+y)^t to the power of ttm instead:
cr <- (bond_value - par / (1+y)^ttm) / (par*sum(pv_factor))
Related
I get a problem when I run this program in R.
anybody help me to solving this problem..?
par_1<-cbind(c(5.038159),c(3.899621))
par_2<-cbind(c(2.435457),c(13.89517))
tau<-365
cdf2 <- function(x, help) {
pgamma(x, shape=par_1[1], scale=par_1[2]) *
pgamma(x, shape=par_2[1], scale=par_2[2])-help
}
nextEventTime <- function(censoring) {
randomNumber <- runif(n=1, min=0, max=1)
pnew <- randomNumber * (1 - cdf2(censoring, 0)) + cdf2(censoring, 0)
uniroot(f=cdf2, interval=c(0, 1000*tau), help=pnew)$root
}
hazardRate1 <- function(t) {
dgamma(t, shape=par_1[1], scale=par_1[2]) /
(1 - pgamma(t, shape=par_1[1], scale=par_1[2]))
}
hazardRate2 <- function(t) {
dgamma(t, shape=par_2[1], scale=par_2[2]) /
(1 - pgamma(t,shape=par_2[1], scale=par_2[2]))
}
nextEventType <- function(t) {
p <- hazardRate1(t)/(hazardRate1(t)+hazardRate2(t))
randomNumber <- runif(n=1, min=0, max=1)
if (randomNumber <= p) {1} else {2}
}
baris<-c(1:20000)
nexteventtime<-rep(0,time=20000)
nexteventype<-rep(0,time=20000)
dfnexteventime<-data.frame(baris,nexteventtime,nexteventype)
for(i in 1:nrow(dfnexteventime)){
dfnexteventime$nexteventtime[i]<-nextEventTime(dfnexteventime$nexteventtime[i])
dfnexteventime$nexteventype[i]<-nextEventType(dfnexteventime$nexteventtime[i])
}
View(dfnexteventime)
When I run this program, this program will error & produce output like this
Error in if (randomNumber <= p) { : missing value where TRUE/FALSE needed
I think this problem because t value in nextEventType(t) function can't zero (t!=0).
But nextEventTime(dfnexteventime$nexteventtime[i]) never produce zero value, when I run this part for 10 times,
baris<-c(1:20000)
nexteventtime<-rep(0,time=20000)
nexteventype<-rep(0,time=20000)
dfnexteventime<-data.frame(baris,nexteventtime,nexteventype)
for(i in 1:nrow(dfnexteventime)){
dfnexteventime$nexteventtime[i]<-nextEventTime(dfnexteventime$nexteventtime[i])
}
without nextEventType function. This part never produce 0 value.
So, I confuse, what is a problem?.
I want result nextEventType(t) produce not zero value.
because if using zero value will be Error in if(ramdonNumber <= p) { :...
Your problem isn't calling nextEventType(t) on zero, since this will never happen. However, the same error occurs whenever nextEventType(t) is called on a value of t greater than 195. At this point, the term pgamma(t, shape=par_1[1], scale=par_1[2]) is so close to one that R evaluates 1 - pgamma(t, shape=par_1[1], scale=par_1[2]) to zero, so hazardRate1(t) returns Inf. Since nextEventType(t) is trying to assign p to Inf/Inf, p is never defined.
> p <- hazardRate1(196)/(hazardRate1(196) + hazardRate2(196))
> p
[1] NaN
This will only happen in very extreme cases, when you happen to draw > 195 in nextEventTime(t), which only occurs around once in 30,000 random draws. That's why you don't see it when you run it 10 times, but often you do when you run it 20,000 times.
random_draws <- numeric()
for(i in 1:1000000) random_draws[i] <- nextEventTime(0)
length(which(random_draws > 195))
# > [1] 28
Here is my function that does a loop:
answer = function(a,n) {
for (k in 0:n) {
x =+ (a^k)/factorial(k)
}
return(x)
}
answer(1,2) should return 2.5 as it is the calculated value of
1^0 / 0! + 1^1 / 1! + 1^2 / 2! = 1 + 1 + 0.5 = 2.5
But I get
answer(1,2)
#[1] 0.5
Looks like it fails to accumulate all three terms and just stores the newest value every time. += does not work so I used =+ but it is still not right. Thanks.
answer = function(a,n) {
x <- 0 ## initialize the accumulator
for (k in 0:n) {
x <- x + (a^k)/factorial(k) ## note how to accumulate value in R
}
return(x)
}
answer(1, 2)
#[1] 2.5
There is "vectorized" solution:
answer = function(a,n) {
x <- a ^ (0:n) / factorial(0:n)
return(sum(x))
}
In this case you don't need to initialize anything. R will allocate memory behind that <- and sum.
You are using Taylor expansion to approximate exp(a). See this Q & A on the theme. You may want to pay special attention to the "numerical convergence" issue mentioned in my answer.
I'm doing a task but I have no idea how to combine 2 functions so that I get multiple answers from one. I'm doing t.testing and had to write out the function, and then i had to write an if-else loop that states wether the hypotesis will be rejected or not. Both of them work individually but I can't figure out how to merge them so when I run the code I get a numerical answer and a line stating whether the hypotesis will be rejected. For the numerical answer I've got this:
osuustesti <- function(x1,x2,n1,n2) {
((x1/n1)-(x2/n2))/sqrt((1/n1 + 1/n2)*((x1+x2)/(n1+n2))*(1-((x1+x2)/(n1+n2))))
}
And for the line stating what will be done with the hypotesis I've got this:
osuustesti2 <- function(x1,x2,n1,n2,alpha) {
if(abs(((x1/n1)-(x2/n2))/sqrt((1/n1 + 1/n2)*((x1+x2)/(n1+n2))*(1-((x1+x2)/(n1+n2)))))> qnorm(alpha/2,lower.tail=FALSE)) {
cat("Nollahypoteesi hylätään")} else{cat("Nollahypoteesi hyväksytään")
}
}
I have no idea how to combine them into 1 so when I run the code I get both the numerical value and the line... I tried to copying both functions and adding them with & but that didn't work at all...
Something like this should work:
osuustesti <- function(x1, x2, n1, n2, alpha = 0.05) {
numer <- x1 / n1 - x2 / n2
denum <- sqrt((1 / n1 + 1 / n2) *
((x1 + x2) / ( n1 + n2)) *
(1 - ( x1 + x2) / (n1 + n2)))
result <- numer / denum
if (result > qnorm(alpha / 2, lower.tail = FALSE)) {
cat("Nollahypoteesi hylätään\n")
} else {
cat("Nollahypoteesi hyväksytään\n")
}
return(result)
}
I save result to result object, then compare it to alpha, cat the string and in the end use return() to return result from the function.
I'm trying to replicate the Excel Solver in R- which is basically a constraint optimization problem
I'm trying to minimize the cost per action which is total spend/ total actions which equals to the below function with a few constraints.
CPA function:
(a+b+c+d)/((consta+(Baln(a)))+ (constb+(Bbln(b)))+(constc+(Bcln(c)))+(constd+(Bdln(d)))
where the unknown variables are a,b,c,d and const* stands for constant from a regressions and B* stand for coefficient from a regression (so they are values that I have).
Here is the simplified filled in function that I'm trying to minimize:
(a+b+c+d)/ (((69.31*ln(a))+(14.885*ln(b))+(21.089*ln(c))+(9.934*ln(d))-(852.93))
Constraints:
a+b+c+d>=0
a+b+c+d<=130000(total spend)
a<=119000 (maxa)
a>=272.56(mina)
b<=11000(maxb)
b>=2.04(minb)
c<=2900(maxc)
c>=408.16(minc)
d<=136800(maxd)
d>=55.02(mind)
I'm doing this using the constraints optimization function. My code is below:
g<-function(a,b,c,d) { (a+b+c+d)/((consta+(Balog(a)))+ (constb+(Bblog(b)))+ (constc+(Bclog(c)))+ (constd+(Bdlog(d)))) }
gb<-function(a) g(a[1], a[2], a[3],a[4])
A<-matrix(c(1,0,0,0,-1,0,0,0,0,1,0,0,0,-1,0,0,0,0,1,0,0,0,-1,0,0,0,0,1,0,0,0,-1,-1,-1,-1,-1,1,1,1,1),4,10)
B<- c(mina, -maxa, minb, -maxb, minc, -maxc, mind, -maxd,-totalspend, 0)
constrOptim(c(273,6,409,56),g,gb,A,B)
When I run the optimization function, it states that something is wrong with my arguments (Error in ui %*% theta : non-conformable arguments). I think it is the gradient of the function that is coded wrong but I'm not sure. Any help is appreciated.
You can consider the following approach
library(DEoptim)
fn_Opt <- function(param)
{
a <- param[1]
b <- param[2]
c <- param[3]
d <- param[4]
bool_Cond <- a + b + c + d <= 130000
if(bool_Cond == FALSE)
{
return(10 ^ 30)
}else
{
val <- (a + b + c + d) / (((69.31 * log(a)) + (14.885 * log(b)) + (21.089 * log(c)) + (9.934 * log(d)) - (852.93)))
return(val)
}
}
obj_DEoptim <- DEoptim(fn = fn_Opt, lower = c(272.56, 2.04, 408.16, 55.02),
upper = c(119000, 11000, 2900, 136800),
control = list(itermax = 10000))
I've just been working though converting some MATLAB scripts to work in R, however having never used MATLAB in my life, and not exactly being an expert on R I'm having some trouble.
Edit: It's a script I was given designed to correct temperature measurements for lag generated by insulation mass effects. My understanding is that It looks at the rate of change of the temperature and attempts to adjust for errors generated by the response time of the sensor. Unfortunately there is no literature available to me to give me an indication of the numbers i am expecting from the function, and the only way to find out will be to experimentally test it at a later date.
the original script:
function [Tc, dT] = CTD_TempTimelagCorrection(T0,Tau,t)
N1 = Tau/t;
Tc = T0;
N = 3;
for j=ceil(N/2):numel(T0)-ceil(N/2)
A = nan(N,1);
# Compute weights
for k=1:N
A(k) = (1/N) + N1 * ((12*k - (6*(N+1))) / (N*(N^2 - 1)));
end
A = A./sum(A);
# Verify unity
if sum(A) ~= 1
disp('Error: Sum of weights is not unity');
end
Comp = nan(N,1);
# Compute components
for k=1:N
Comp(k) = A(k)*T0(j - (ceil(N/2)) + k);
end
Tc(j) = sum(Comp);
dT = Tc - T0;
end
where I've managed to get to:
CTD_TempTimelagCorrection <- function(temp,Tau,t){
## Define which equation to use based on duration of lag and frequency
## With ESM2 profiler sampling # 2hz: N1>tau/t = TRUE
N1 = Tau/t
Tc = temp
N = 3
for(i in ceiling(N/2):length(temp)-ceiling(N/2)){
A = matrix(nrow=N,ncol=1)
# Compute weights
for(k in 1:N){
A[k] = (1/N) + N1 * ((12*k - (6*(N+1))) / (N*(N^2 - 1)))
}
A = A/sum(A)
# Verify unity
if(sum(A) != 1){
print("Error: Sum of weights is not unity")
}
Comp = matrix(nrow=N,ncol=1)
# Compute components
for(k in 1:N){
Comp[k] = A[k]*temp[i - (ceiling(N/2)) + k]
}
Tc[i] = sum(Comp)
dT = Tc - temp
}
return(dT)
}
I think the problem is the Comp[k] line, could someone point out what I've done wrong? I'm not sure I can select the elements of the array in such a way.
by the way, Tau = 1, t = 0.5 and temp (or T0) will be a vector.
Thanks
edit: apparently my description is too brief in explaining my code samples, not really sure what more I could write that would be relevant and not just wasting peoples time. Is this enough Mr Filter?
The error is as follows:
Error in Comp[k] = A[k] * temp[i - (ceiling(N/2)) + k] :
replacement has length zero
In addition: Warning message:
In Comp[k] = A[k] * temp[i - (ceiling(N/2)) + k] :
number of items to replace is not a multiple of replacement length
If you write print(i - (ceiling(N/2)) + k) before that line, you will see that you are using incorrect indices for temp[i - (ceiling(N/2)) + k], which means that nothing is returned to be inserted into Comp[k]. I assume this problem is due to Matlab allowing the use of 0 as an index and not R, and the way negative indices are handled (they don't work the same in both languages). You need to implement a fix to return the correct indices.