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
Related
I am trying to apply a function on the elements of an array that are different from NA. I tried to use an if statement with the !is.na function but I get an error message saying that the "argument is of length zero". Would someone have an idea on how to fix that error or an alternative way to only select the non NA values of the matrix?
F <- function(x, a, b, c, d) {
f <- a*(tanh(b*(x - c)) - d)
return(f)
}
nlon <- 3241 ; nlat <- 1680
p1 <- 3221 ; p2 <- 1103
pr_new <- matrix(0, nlat, nlon) # for the example
lim <- 10
for (n in 1:nlon) {
a <- -0.5; b <- 1; c <- 0; d <- 1 #Parameters of F
if (n < p1) { #left side of the step
for (m in nlat - lim:nlat) {
if (!is.na(c(pr_new[m, n]))) { #no calculation on the NA values
pr_new[m, n] <- F(n, a, b, c, d)
}
}
} else { #right side of the step
if (is.na(c(pr_new[p2, n]))) { #if we are on the upper step
for (m in p2 - 1:p2 - 1 - lim) {
if (!is.na(c(pr_new[m, n]))) { #no calculation on the NA values
pr_new[m, n] <- F(m, a, b, c, d)
}
}
} else { #if we are on the lower step
for (m in p2:p2 - lim) {
if (!is.na(c(pr_new[m, n]))) { #no calculation on the NA values
pr_new[m, n] <- F(m, a, b, c, d)
}
}
}
}
}
You can find out which value to which a loop-index was set after an error by simply typing the loop-index name at the console:
Error in if (!is.na(c(pr_new[m, n]))) { : argument is of length zero
> m
[1] 0 # R uses 1 based indexing so 0 indexed value is not there
> n
[1] 1
> str( p2:p2-lim) # demonstrating error
num 1093
The comment was correct from #zephryl , but it only identified one of the three times that a similar error was made.
for (m in nlat-lim:nlat){ ...
for (m in p2-1:p2-1-lim){ ...
for (m in p2:p2-lim){ ...
In each of these an expression using both colons and minnus signs has been incorrectly contsructed because the ":" has a higher operator precedence than a binary minus sign. You can find the operator precedence rules at the ?Syntax help page.
If you correct those three errors you get code that runs without error.
for (n in 1:nlon){
a= -0.5; b=1; c=0; d=1 #Parameters of F
if (n<p1){ #left side of the step
for (m in (nlat-lim):nlat ){ # fix #1
if (!is.na(c(pr_new[m,n]))){ #no calculation on the NA values
pr_new[m,n]=F(n,a,b,c,d)
}
}
}
else{ #right side of the step
if (is.na(c(pr_new[p2,n]))) { #if we are on the upper step
for (m in (p2-1):(p2-1-lim) ){ # fix #2
if (!is.na(c(pr_new[m,n]))){ #no calculation on the NA values
pr_new[m,n]=F(m,a,b,c,d)
}
}
}
else { #if we are on the lower step
for (m in p2:(p2-lim) ){ # fix # 3
if (!is.na(c(pr_new[m,n]))){ #no calculation on the NA values
pr_new[m,n]=F(m,a,b,c,d)
}
}
}
}
}
Regarding the tangential "answer" from a new user of low rep, I did test the theory that it might return a similar answer. I did try chatGPT on some questions and noticed that it not only returned incorrect ansers, but it was alo unable to learn from its mistakes when there were reported to it. When the title and body of the question were given to ChatGPT it gave an almost identical answer to the now-deleted one.
The which function can be used to return a vector of indices from an array or matrix but it is most useful when it is used with the arr.ind parameter is set to its non-default value: ..., arr.in = TRUE. And na.omit can be used to remove cases from matrices. It will however, remove, entire lines of values for any row that contains a single NA.
I am trying to run a loop that contains a while and an if statement. The code works outside of the loop but not inside! This is a very simplified version which basically is trying to collect sets xx[j] which contain 10 numbers each.
When I run it, it never actually allocates the 'x' to the set xx[j] but I'm not sure why!
n <- 10
xx <- list()
for (j in 1:5) {
xx[j] <= NULL
while (length(xx[j]) < n) {
x <- runif(1)
if (0.5 <= x) {
xx[j] <- c(xx[j], x)
}
}
}
I've fixed and polished the code.
The changes are:
Elements of a list are accessed with double brackets xx[[j]]
The list is created of the target length 5
Removed setting the elements of the list to NULL as they are NULL initially
The fixed code:
n = 10
xx = vector('list',5)
for (j in seq_along(xx)) {
while(length(xx[[j]]) < n){
x = runif(1)
if (0.5 <= x) {
xx[[j]] = c(xx[[j]], x)
}
}
}
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 trying to write a square root function in R. The function is supposed to behave like sqrt() but not use that function of course. I'm supposed to use Newton's method for computing the square root, which is:
y(a+1) = [y(a) + x / y(a)]/2
Here x is the number I'm trying to calculate the square root of and y(0) would be the initial guess of the square root of x.
The function is supposed to take in four arguments: x (the number I'm trying to compute the square root of), eps (the difference in value between iterations that are considered be equal), iter (the max number of iterations), and verbose (says I want to output intermediate results).
My issue is that I am not very well versed in writing functions in R. I have experience in C++, but they are slightly different in R.
I believe I'm supposed to write something that goes like this.
Asks the user to input a number as a guess for the value we want to calculate the square root of. Make a for loop from 1 to iter with two if statements 1) that stop the function and output the y value if the max number of iterations have been reached 2) stop the function and output the y value if the difference between successive iterations is less than eps.
Here is the code I have so far:
MySqrt <- function (x, eps = 1e-6, iter = 100, verbose = TRUE) {
for (i in 0:itmax) {
y[0] <- readline(prompt="Please enter your initial square root guess: ")
y[i + 1] = (y[i] + x / y[i])/2
if (i == 100) {
stop (return(y[i + 1]))
}
if (abs(y[i + 1] - y[i]) < eps) {
stop (return(y[i + 1]))
}
}
return(y[i + 1])
}
Here is the error I receive after entering the initial square root guess: Error in y[0] <- readline(prompt = "Please enter your initial square root guess: ") :
object 'y' not found
Honestly, I didn't expect the code to work because I'm sure there are more than one errors.
You should use iter instead of itmax.
I initialized y within the function and input of y should be formatted as a number instead of a character. You could also simplify the if statement by using | (or).
I also added "cat" function so you could see what i is before the function prints out the square root value.
MySqrt <- function (x, eps = 1e-6, iter = 100, verbose = TRUE) {
y = 0
y[1] = as.numeric(readline(prompt="Please enter your initial square root guess: "))
for (i in 1:iter) {
y[i+1] = as.numeric((y[i] + (x/y[i]))/2)
if (i == 100 || abs(y[i+1] - y[i]) < eps) {
cat("This is", i,"th try: \n")
return(y[i+1])
}
}
}
Try this simply:
newton.raphson <- function(x, start, epsilon=0.0001, maxiter=100) {
y <- c(start) # initial guess
a <- 1 # number of iterations
while (TRUE) {
y <- c(y, (y[a] + x / y[a])/2)
if (abs(y[a+1] - y[a]) < epsilon | a > maxiter) { # converged or exceeded maxiter
return(y[a+1])
}
a <- a + 1
}
}
newton.raphson(2, 0.5, 0.01)
# [1] 1.414234
newton.raphson(3, 0.5, 0.01)
# [1] 1.732051
since sqrt(n) < n/2 then with precision of 1/10000
sqrnt=function(y){
x=y/2
while (abs(x*x-y) > 1e-10)
{x=(x+y/x)/2 }
x
}
In Newton’s method. If you want to know the square root of a, you can start estimate a number, x (for examples a/2), you can compute a better estimate with the following formula:
y = (x + a / x) / 2
If y != x, you set x = y, and repeat until y == x. Then you get the square root of a. Please see the code below:
square_root <- function(a) {
x <- a/2
while (TRUE) {
y <- (x + a / x) / 2
if (y == x) break
x <- y
}
return(y)
}
So, I'm supposed to write the code to execute Newton's Method to calculate the square root of any arbitrary number to a specified precision (tolerance).
Here is my code:
MySqrt <- function(x, eps = 1e-6, itmax = 100, verbose = TRUE) {
GUESS <- 11
myvector <- integer(0)
i <- 1
if (x < 0) {
stop("Square root of negative value")
}
else {
myvector[i] <- GUESS
while (i <= itmax) {
GUESS <- (GUESS + (x/GUESS)) * 0.5
myvector[i+1] <- GUESS
if (abs(GUESS-myvector[i]) < eps) {
break()
}
if (verbose) {
cat("Iteration: ", formatC(i, width = 1), formatC(GUESS, digits = 10, width = 12), "\n")
}
i <- i + 1
}
}
myvector[i]
}
eps is the tolerance. When I use the function to calculate the square root of, say, 21, I got this as an output:
> MySqrt(21, eps = 1e-1, verbose = TRUE)
Iteration: 1 6.454545455
Iteration: 2 4.854033291
Iteration: 3 4.59016621
I'm not sure if the function stops carrying out iterations when it is supposed to, however. Can someone verify if my code is correct? This would be greatly appreciated!
Your code is almost correct. It is iterating the correct number of times. The only bug is that you don't increment i until after the break statement, so you are not returning the most recent approximation. Instead you are returning the previous one.
In order to verify that it is stopping at the right time, you can move the tracing line up above the break. You can also add GUESS-myvector[i] to the trace, so you can watch it halt as soon as the difference gets small enough. If you do this and run the function, the fact that it is stopping at the right time, as well as the fact that it is returning the wrong value, will be obvious:
> MySqrt(21,eps=1e-1)
Iteration: 1 6.454545 -4.545455
Iteration: 2 4.854033 -1.600512
Iteration: 3 4.590166 -0.2638671
Iteration: 4 4.582582 -0.007584239
[1] 4.590166
While your code is (almost) correct, it is not written in very good R style. For example, unless you want to return the entire vector of estimates, there is no reason that you need to keep them all around. Also, rather than using a while loop, here it would make more sense to use a for loop. Here one possible improved version of your function:
MySqrt <- function(x, eps = 1e-6, itmax = 100, verbose = TRUE) {
GUESS <- 11
if (x < 0) {
stop("Square root of negative value")
}
for(i in 1:itmax){
nextGUESS <- (GUESS + (x/GUESS)) * 0.5
if (verbose)
cat("Iteration: ", i, nextGUESS, nextGUESS-GUESS, "\n")
if (abs(GUESS-nextGUESS) < eps)
break
GUESS<- nextGUESS
}
nextGUESS
}