Why is this causing my program to crash? [closed] - r

Closed. This question needs debugging details. It is not currently accepting answers.
Edit the question to include desired behavior, a specific problem or error, and the shortest code necessary to reproduce the problem. This will help others answer the question.
Closed 5 years ago.
Improve this question
I have created the following user defined function which generates random variables using the Acceptance-Rejection Method. However, whenever it is called, my program goes on and eventually crashes or I have to force quit. I have gone through it several times. Any ideas as to what could be causing this?
I am aware that this may not be the best way to have written this (Yesterday was the first time I have used R) so any extra tips are a bonus!
acceptReject <- function(){
Z <- 0
Y <- c(0,0)
while(Y[2] < .5*(Y[1]-1)**2){
U <- runif(2,0,1)
Y <- log(U)
}
Z <- Y[1]
U <- runif(1,0,1)
if(U <= .5){
Z <- abs(Z)
}
else{
Z <- -abs(Z)
}
Z
}

You have an infinite loop.
If you assume that Y ~ log( [0,1] ) (mathematically), that means that it always range between log(0) and log(1), equating to -Inf and 0, respectively. (Bottom line, it is always less-than-or-equal-to zero.)
Now let's look at your conditional: .5*(Y[1]-1)**2. If you know the domain of Y is c(-Inf,0), then the range of this formula is
.5*(c(-Inf,0)-1)**2
# [1] Inf 0.5
(This is always greater-than-or-equal-to 0.5.)
Since Y is always <= 0 and the formula is always >= 0.5, your conditional will mathematically always be true. Infinite loop.

Related

How does one calculate the correct amplitude with R's fft()-function? [closed]

Closed. This question needs details or clarity. It is not currently accepting answers.
Want to improve this question? Add details and clarify the problem by editing this post.
Closed 2 years ago.
Improve this question
In R, I am generating uncorrelated values in time domain with rnorm(). Then I apply fft() to these values, however, I am only getting a value of 0.88 instead of 1. Is there anything I am not aware of?
Here is a MWE:
# dt <- 0.01 # time stesp
nSteps <- 100000 # Number of time steps
# df <- 1/(nSteps*dt) # frequency resolution
# t <- 0:(nSteps-1)*dt #
y <- rnorm(nSteps, mean=0, sd=1) # generate uncorrelated data. Should result in a white noise spectrum with sd=1
y_sq_sum <- sum(y^2)
# We ignore cutting to the Nyquist frequency.
# f <- 0:(nSteps-1)*df
fft_y <- abs(fft(y))/sqrt(length(y))
fft_y_sq_sum <- sum(fft_y^2)
print(paste("Check for Parseval's theorem: y_sq_sum = ", y_sq_sum, "; fft_y_sq_sum = ", fft_y_sq_sum, sep=""))
print(paste("Mean amplitude of my fft spectrum: ", mean(fft_y)))
print(paste("The above is typically around 0.88, why is it not 1?"))
This question doesn't belong on StackOverflow, it's more of a Cross-validated kind of thing. But here's an answer anyway:
Parseval's theorem says that the mean of fft_y^2 should be 1. The square root function is a concave function, so Jensen's inequality says the mean of sqrt(fft_y^2) will be less than 1. Since fft_y is positive in your definition, fft_y = sqrt(fft_y^2).

To solve given expression in R and find T value? [closed]

Closed. This question needs debugging details. It is not currently accepting answers.
Edit the question to include desired behavior, a specific problem or error, and the shortest code necessary to reproduce the problem. This will help others answer the question.
Closed 2 years ago.
Improve this question
enter image description hereI have an question concerning the possibility to solve functions in R, but to know the answer would really help to understand the R better.
0.10 = (1/(1+(((1.04e+19*((T/300)^(3/2)))/(4e+16))exp((-(0.045)/(0.0259(T/300)))))))
How can I solve this expression in R and find the value of T?
Your equation does not have solutions. To see this define the function, defined over the positive reals,
f <- function(T) (1/(1+(((1.04e+19*((T/300)^(3/2)))/(4e+16))*exp((-(-0.045)/(0.0259*(T/300)))))))
and define a function f(x) - a, in order to solve the equation f(x) - a = 0.
g <- function(x, a) f(x) - a
Now plot this second function.
curve(g(x, 0.10), 0, 1e3)
As the graph shows, all values of g(x, 0.10) = f(x) - 0.10 are positive, f(x) != 0.10 for all x.
Analytically, if the functions never changes sign it does not have roots. Since the function is continuous, all we need to do is to check its value near 0 and the maximum.
g(.Machine$double.eps, 0.10)
#[1] -0.1
The maximum is determined with optimise.
optimise(g, c(0, 1e3), a = 0.10, maximum = TRUE)
#$maximum
#[1] 347.4904
#
#$objective
#[1] -0.09931205
Both values are negative, which confirms what the graph had shown.
Edit
Everything that was said above is right but apparently the function's expression was wrong. With the correct expression the root can be found with uniroot. Note that the solution given in the question's image was found by trial and error, the solution below was found by a numeric method but they are the same solution.
f <- function(T) {
numer <- 1.04e19*(T/300)^(3/2) / 4e16
numer <- numer * exp(-0.045/(0.0259*T/300))
numer <- 1 + numer
1/numer
}
g <- function(x, a) f(x) - a
xzero <- uniroot(g, a = 0.10, interval = c(0, 1e3))
xzero
#$root
#[1] 192.9487
#
#$f.root
#[1] -1.149569e-10
#
#$iter
#[1] 13
#
#$init.it
#[1] NA
#
#$estim.prec
#[1] 6.103516e-05
curve(g(x, 0.10), 0, 1e3)
abline(h = 0)
points(xzero$root, 0, col = "blue", pch = 16)

Coding a simple loop for a sliding window [closed]

Closed. This question is not reproducible or was caused by typos. It is not currently accepting answers.
This question was caused by a typo or a problem that can no longer be reproduced. While similar questions may be on-topic here, this one was resolved in a way less likely to help future readers.
Closed 3 years ago.
Improve this question
I have the following problem. I have a time series made by 2659 observations. I need to perform a statistical test over a sliding window of length 256 and each time I want to extract the p-values from these tests and gather them into a time series vector. To perform this test (runs test) I want as threshold a moving average that moves along with the data and the rolling window. Here is my attemp (in R)
x<- ts(rnorm(2659, mean = 0.0001, sd = 0.0001))
library(randtests)
for(i in 1:2404){
runs <- runs.test(x[i:i+255], threshold = mean(x[i:i+255]))
ret[i] <- runs$p.value
}
The index starts from 1 but stops to 2404 because the time window must move of 256 each time, therefore the first window goes from 1 to 256, the second from 2 to 257... and finally stops to 255+2404 = 2659. I hope that I made clear my problem, I do not understand why it does not work. Of course I need to plot the result over time to have in a plot all the p-values over the time. I hope you can help me.
PS: Please, set a seed if you propose an example so that I can reproduce your results.
Use rollapplyr with the indicated function.
library(zoo)
pv <- function(xx) runs.test(xx, threshold = mean(xx))$p.value
out <- rollapplyr(x, 256, pv, fill = NA)
Note
library(randtests)
set.seed(123)
x <- ts(rnorm(2659, mean = 0.0001, sd = 0.0001))
Two changes to your existing code should make it work:
set.seed(0)
x <- ts(rnorm(2659, mean = 0.0001, sd = 0.0001))
library(randtests)
ret <- rep(NA, length(x))
for(i in 1:2404){
runs <- runs.test(x[i:(i+255)], threshold = mean(x[i:(i+255)]))
ret[i] <- runs$p.value
}
First change is to initialize the ret variable before the loop. ret <- rep(NA, length(x))
The second change is to add the parenthesis, i.e. x[i:(i+255)]. If you do x[i:i+255], you will get a single return value, x[i].

Birth Death Code [closed]

Closed. This question needs to be more focused. It is not currently accepting answers.
Want to improve this question? Update the question so it focuses on one problem only by editing this post.
Closed 6 years ago.
Improve this question
My question:
At an institute for experimental mathematics there is a computer that helps solve problems.
Problems arrive to the computer at a poisson process with intensity "Landa" per hour.
The time to solve each problem can be seen as a exponential distribution with parameter "mu".
In our world we have four different states. S = (0,1,2,3)
State 0 = 0 problems have arrived to the computer
State 1 = the computer is solving 1 question
State 2 = the computer is solving 1 question + 1 in queue.
State 3 = the computer is solving 1 question + 2 in queue.
If a question comes when we are in state 3, the sender gets an error message and tries again later. The institution has decided that maximum of 5 % of the senders should get this error message.
To decide who should have access to the computer, we are 3 different proposals.
Only the professors are alowed to send questions ( Landa = 2, Mu = 10)
Professors and students are alowed to send questions( Landa = 6, Mu = 10)
Anyone is alowed to send questions( Landa =10, Mu = 10)
We should investigate what of the 3 proposals don't fill upp the computer more than 5% of the time.
I have two things i need help with
First thing:
To Solve the question I've been given this structure of code(the code under). What i need help with is if someone can briefly explain to me the purpose of the following code paragraf where i have written "#?".
So what i really need help with is some1 to explain parts of the code.
Secound thing:
In two places i have written "...", there i need help to fill in some code.
bd_process <- function(lambda, mu, initial_state = 0, steps = 100) {
time_now <- 0
state_now <- initial_state
time <- 0
state <- initial_state
for (i in 1:steps) {
if (state_now == 3) {
lambda_now <- 0
} else {
lambda_now <- lambda
}
if (state_now == 0) {
mu_now <- 0
} else {
mu_now <- mu
}
#?
time_to_transition <- ...
#?
if (...) {
state_now <- state_now - 1
} else {
state_now <- state_now + 1
}
#?
time_now <- time_now + time_to_transition
#?
time <- c(time, time_now)
#?
state <- c(state, state_now) #WHAT DOE THIS VECTOR CONSIST OF?
}
list(time = time, state = state)
}
The code appears to be written with an implicit assumption that the interarrival and service distributions are memoryless, i.e., either exponential or geometric. Without memorylessness it's invalid to turn off processing by setting the rates to zero.
With the memoryless property, you can figure out the time_to_transition as a superposition of the two Poisson processes, and determine whether it was an arrival or a departure by randomizing proportional to the ratio of one of the rates to the combined rate. It's also valid to zero one of the rates then because when you unzero it the elapsed time where the rate was zero doesn't matter due to the memoryless property.

'Non-conformable arguments' in R code [closed]

Closed. This question is not reproducible or was caused by typos. It is not currently accepting answers.
This question was caused by a typo or a problem that can no longer be reproduced. While similar questions may be on-topic here, this one was resolved in a way less likely to help future readers.
Closed 4 years ago.
Improve this question
: ) I previously wrote an R function that will compute a least-squares polynomial of arbitrary order to fit whatever data I put into it. "LeastSquaresDegreeN.R" The code works because I can reproduce results I got previously. However, when I try to put new data into it I get a "Non-conformable arguments" error.
"Error in Conj(t(Q))%*%t(b) : non-conformable arguments"
An extremely simple example of data that should work:
t <- seq(1,100,1)
fifthDegree <- t^5
LeastSquaresDegreeN(t,fifthDegree,5)
This should output and plot a polynomial f(t) = t^5 (up to rounding errors).
However I get "Non-conformable arguments" error even if I explicitly make these vectors:
t <- as.vector(t)
fifthDegree <- as.vector(fifthDegree)
LeastSquaresDegreeN(t,fifthDegree,5)
I've tried putting in the transpose of these vectors too - but nothing works.
Surely the solution is really simple. Help!? Thank you!
Here's the function:
LeastSquaresDegreeN <- function(t, b, deg)
{
# Usage: t is independent variable vector, b is function data
# i.e., b = f(t)
# deg is desired polynomial order
# deg <- deg + 1 is a little adjustment to make the R loops index correctly.
deg <- deg + 1
t <- t(t)
dataSize <- length(b)
A <- mat.or.vec(dataSize, deg) # Built-in R function to create zero
# matrix or zero vector of arbitrary size
# Given basis phi(z) = 1 + z + z^2 + z^3 + ...
# Define matrix A
for (i in 0:deg-1) {
A[1:dataSize,i+1] = t^i
}
# Compute QR decomposition of A. Pull Q and R out of QRdecomp
QRdecomp <- qr(A)
Q <- qr.Q(QRdecomp, complete=TRUE)
R <- qr.R(QRdecomp, complete=TRUE)
# Perform Q^* b^T (Conjugate transpose of Q)
c <- Conj(t(Q))%*%t(b)
# Find x. R isn't square - so we have to use qr.solve
x <- qr.solve(R, c)
# Create xPlot (which is general enough to plot any degree
# polynomial output)
xPlot = x[1,1]
for (i in 1:deg-1){
xPlot = xPlot + x[i+1,1]*t^i
}
# Now plot it. Least squares "l" plot first, then the points in red.
plot(t, xPlot, type='l', xlab="independent variable t", ylab="function values f(t)", main="Data Plotted with Nth Degree Least Squares Polynomial", col="blue")
points(t, b, col="red")
} # End

Resources