I am both new to maximum likelihood and writing loop functions in R. I am playing around with the function in Matlab and I'm wondering if its correctly transcribed in R? There is not easy way for me to check it since I'm not familiar with MATLAB. The code uses equations (1) and (3) from the paper.
#Matlab Code. The matlab code imposes two conditions under which lnpq takes different values depending on q.
p=N/K;
if q == 0
lnqp = log(p);
else
lnqp =((p^q)-1)/q;
end
Y = ((aa *((p*K/Ka)-1))-1)*lnqp;
#R code. In the R code function, I'm trying to impose similar conditions on lnpq. Here is my attempt. However, I don't know how to compare if the values obtained from Matlab are similar to R. I am not sure how to verify across platforms
p <- c(1:00)
skewfun <- function(aa, K, Ka, q){
Y <- ifelse(q = 0, ((aa *((p*K/Ka)-1))-1)*log(p),((aa *((p*K/Ka)-1))-1)*((p^q)-1)/q)
}
The inputs can be either numeric scalars or vectors. If you don't have Matlab you could install Octave which is free and compatible with Matlab and try the original Matlab code there and then compare the outputs for a test case to the result of running the following on the same test case to ensure that it gives the same result.
f <- function(aa, N, K, Ka, q) {
p <- N / K
lnqp <- ifelse(q == 0, log(p), (p^q - 1) / q)
Y <- (aa * (p * K / Ka - 1) - 1) * lnqp
Y
}
aa <- 1; N <- 1; K <- 1; Ka <- 1; q <- 1 # test data: change to use your data
f(aa, N, K, Ka, q)
## [1] 0
You can use matconv package to facilitate automatic code conversion:
matconv::mat2r(inMat = "Y = ((aa *((p*K/Ka)-1))-1)*lnqp;")
will return:
$matCode
[1] "Y = ((aa *((p*K/Ka)-1))-1)*lnqp;"
$rCode
[1] "Y <- ((aa *((p*K/Ka)-1))-1)*lnqp"
R mailing list has also useful bash script that you may use for that purpose.
Related
I am reading Section 4.2 in Simulation (2006, 4ed., Elsevier) by Sheldon M. Ross, which introducing generating a Poisson random variable by the inverse transform method.
Denote pi =P(X=xi)=e^{-λ} λ^i/i!, i=0,1,... and F(i)=P(X<=i)=Σ_{k=0}^i pi to be the PDF and CDF for Poisson, respectively, which can be computed via dpois(x,lambda) and ppois(x,lambda) in R.
There are two inverse transform algorithms for Poisson: the regular version and the improved one.
The steps for the regular version are as follows:
Simulate an observation U from U(0,1).
Set i=0 and F=F(0)=p0=e^{-λ}.
If U<F, select X=i and terminate.
If U >= F, obtain i=i+1, F=F+pi and return to the previous step.
I write and test the above steps as follows:
### write the regular R code
pois_inv_trans_regular = function(n, lambda){
X = rep(0, n) # generate n samples
for(m in 1:n){
U = runif(1)
i = 0; F = exp(-lambda) # initialize
while(U >= F){
i = i+1; F = F + dpois(i,lambda) # F=F+pi
}
X[m] = i
}
X
}
### test the code (for small λ, e.g. λ=3)
set.seed(0); X = pois_inv_trans_regular(n=10000,lambda=3); c(mean(X),var(X))
# [1] 3.005000 3.044079
Note that the mean and variance for Poisson(λ) are both λ, so the writing and testing for the regular code are making sense!
Next I tried the improved one, which is designed for large λ and described according to the book as follows:
The regular algorithm will need to make 1+λ searches, i.e. O(λ) computing complexity, which is fine when λ is small, while it can be greatly improved upon when λ is large.
Indeed, since a Poisson random variable with mean λ is most likely to take on one of the two integral values closest to λ , a more efficient algorithm would first check one of these values, rather than starting at 0 and working upward. For instance, let I=Int(λ) and recursively determine F(I).
Now generate a Poisson random variable X with mean λ by generating a random number U, noting whether or not X <= I by seeing whether or not U <= F(I). Then search downward starting from I in the case where X <= I and upward starting from I+1 otherwise.
It is said that the improved algorithm only need 1+0.798√λ searches, i.e., having O(√λ) complexity.
I tried to wirte the R code for the improved one as follows:
### write the improved R code
pois_inv_trans_improved = function(n, lambda){
X = rep(0, n) # generate n samples
p = function(x) {dpois(x,lambda)} # PDF: p(x) = P(X=x) = λ^x exp(-λ)/x!
F = function(x) {ppois(x,lambda)} # CDF: F(x) = P(X ≤ x)
I = floor(lambda) # I=Int(λ)
F1 = F(I); F2 = F(I+1) # two close values
for(k in 1:n){
U = runif(1)
i = I
if ( F1 < U & U <= F2 ) {
i = I+1
}
while (U <= F1){ # search downward
i = i-1; F1 = F1 - p(i)
}
while (U > F2){ # search upward
i = i+1; F2 = F2 + p(i)
}
X[k] = i
}
X
}
### test the code (for large λ, e.g. λ=100)
set.seed(0); X = pois_inv_trans_improved(n=10000,lambda=100); c(mean(X),var(X))
# [1] 100.99900000 0.02180118
From the simulation results [1] 100.99900000 0.02180118 for c(mean(X),var(X)), which shows nonsense for the variance part. What should I remedy this issue?
The main problem was that F1 and F2 were modified within the loop and not reset, so eventually a very wide range of U's are considered to be in the middle.
The second problem was on the search downward the p(i) used should be the original i, because F(x) = P(X <= x). Without this, the code hangs for low U.
The easiest fix for this is to start i = I + 1. Then "in the middle" if statement isn't needed.
pois_inv_trans_improved = function(n, lambda){
X = rep(0, n) # generate n samples
p = function(x) {dpois(x,lambda)} # PDF: p(x) = P(X=x) = λ^x exp(-λ)/x!
`F` = function(x) {ppois(x,lambda)} # CDF: F(x) = P(X ≤ x)
I = floor(lambda) # I=Int(λ)
F1 = F(I); F2 = F(I+1) # two close values
for(k in 1:n){
U = runif(1)
i = I + 1
# if ( F1 < U & U <= F2 ) {
# i = I + 1
# }
F1tmp = F1
while (U <= F1tmp){ # search downward
i = i-1; F1tmp = F1tmp - p(i);
}
F2tmp = F2
while (U > F2tmp){ # search upward
i = i+1; F2tmp = F2tmp + p(i)
}
X[k] = i
}
X
}
This gives:
[1] 100.0056 102.2380
I have to use recursion to produce pseudo random numbers. For fixed values a, b and c, I need to calculate:
x_n+1 = (a * x_n + c) modulo 2^b. Random numbers are obtained by the function R_n = x_n / (2^b). I need to save these R_n values to make a histogram. How can I make a function in R that uses it's previous values x_n to produce x_n+1? I have made a start with my code, it's listed below.
a=5
b=4
c=3
k=10000
random <- function(x) {
if(x<k){
x = (a*x+c)%%2^b
k++
}
}
Here's a thought for starters,
random <- function(a = 5, b = 4, c = 3, k = 10000, x0 = 1) {
x <- x0 # or some other sane default
function(n = 1) {
newx <- Reduce(function(oldx, ign) (a*oldx + c) %% (2^b), seq_len(n),
init = x, accumulate = TRUE)[-1]
# if (x >= k)? do something else
if (length(newx)) {
x <<- newx[length(newx)]
k <<- k + n
}
newx
}
}
The premise is that the random function is a setup function that returns a function. This inner function has its a, b, c, k, and previous x variables stored within it.
thisran <- random()
thisran()
# [1] 8
thisran(3)
# [1] 11 10 5
I haven't studied creating PRNG in depth, but I'm inferring that x0 here is effectively your seed. I'm not certain why you had a if (x<k) conditional in your function; since k was never used otherwise, just incremented, I'm thinking it only serves as a termination indicator for your PRNG (so it is not infinite).
If need be, the current k value (and other variables, for that matter) can be peeked-at with
get("k", environment(thisran))
# [1] 10003
BTW: the use of Reduce might seem like an unnecessary complication, but it enables the ran(n) functionality, similar to other PRNGs in R. That is, one can do runif(7) for seven random numbers, and I thought it would be useful to do that here. The use of Reduce is required in that case since each calculation depends on the results from the previous calculation, so a sample replicate or sapply would not work (without some contrived coding that I wanted to avoid).
I want to draw samples from this function
f(x) = 1/(gamma(1+1/x))^N
for x > 0 and N is number of samples
I tried using the quantile , the rejection method and the metropolis Hasting but could not figure out. I'm also new to R programming.
EDIT.
The OP posted the following function in a comment.
Falp <- function(a, b, abi) {
ti = seq(a, b, abi)
m = length(x)
Fx = fx = matrix(0, m)
fx = 1/(((gamma(1 + 1/x))^N))
}
The formating was mine with help by formatR::tidy_source().
I hope you are well. I was wondering if you could help me with the question provided in the attached link, please. Below the link I attach an R-code that solves the problem recursively for particular values of the parameters of the distributions involved. However, I realized that this method is inefficient. Thanks a lot for your help.
How to obtain the probability distribution of a sum of dependent discrete random variables more efficiently
library(boot) # The library boot is necessary to use the command inv.logit.
TMax <- 500 # In this R-code, I am using TMax instead of using T.
M <- 2000
beta0 <- 1
beta1 <- 0.5
Prob_S <- function(k, r){ # In this R-code, I am using r instead of using t.
if(r == 1){
Aux <- dbinom(x = k, size = M, prob = inv.logit(beta0))
}
if(r %in% 2:TMax){
Aux <- 0
for(u in 0:k){
Aux <- Aux + dbinom(x = k - u, size = M - u,
prob = inv.logit(beta0 + beta1 * u)) * Prob_S(u, r - 1)
}
}
Aux
}
m <- 300
P <- Prob_S(k = m, r = TMax) # Computing P takes a loooong time. :(
I am re-writting an algorithm I did in C++ in R for practice called the Finite Difference Method. I am pretty new with R so I don't know all the rules regarding vector/matrix multiplication. For some reason I am getting a non-conformable arguments error when I do this:
ST_u <- matrix(0,M,1)
ST_l <- matrix(0,M,1)
for(i in 1:M){
Z <- matrix(gaussian_box_muller(i),M,1)
ST_u[i] <- (S0 + delta_S)*exp((r - (sigma*sigma)/(2.0))*T + sigma*sqrt(T)%*%Z)
ST_l[i] <- (S0 - delta_S)*exp((r - (sigma*sigma)/(2.0))*T + sigma*sqrt(T)%*%Z)
}
I get this error:
Error in sqrt(T) %*% Z : non-conformable arguments
Here is my whole code:
gaussian_box_muller <- function(n){
theta <- runif(n, 0, 2 * pi)
rsq <- rexp(n, 0.5)
x <- sqrt(rsq) * cos(theta)
return(x)
}
d_j <- function(j, S, K, r, v,T) {
return ((log(S/K) + (r + (-1^(j-1))*0.5*v*v)*T)/(v*(T^0.5)))
}
call_delta <- function(S,K,r,v,T){
return (S * dnorm(d_j(1, S, K, r, v, T))-K*exp(-r*T) * dnorm(d_j(2, S, K, r, v, T)))
}
Finite_Difference <- function(S0,K,r,sigma,T,M,delta_S){
ST_u <- matrix(0,M,1)
ST_l <- matrix(0,M,1)
for(i in 1:M){
Z <- matrix(gaussian_box_muller(i),M,1)
ST_u[i] <- (S0 + delta_S)*exp((r - (sigma*sigma)/(2.0))*T + sigma*sqrt(T)%*%Z)
ST_l[i] <- (S0 - delta_S)*exp((r - (sigma*sigma)/(2.0))*T + sigma*sqrt(T)%*%Z)
}
Delta <- matrix(0,M,1)
totDelta <- 0
for(i in 1:M){
if(ST_u[i] - K > 0 && ST_l[i] - K > 0){
Delta[i] <- ((ST_u[i] - K) - (ST_l[i] - K))/(2*delta_S)
}else{
Delta <- 0
}
totDelta = totDelta + exp(-r*T)*Delta[i]
}
totDelta <- totDelta * 1/M
Var <- 0
for(i in 1:M){
Var = Var + (Delta[i] - totDelta)^2
}
Var = Var*1/M
cat("The Finite Difference Delta is : ", totDelta)
call_Delta_a <- call_delta(S,K,r,sigma,T)
bias <- abs(call_Delta_a - totDelta)
cat("The bias is: ", bias)
cat("The Variance of the Finite Difference method is: ", Var)
MSE <- bias*bias + Var
cat("The marginal squared error is thus: ", MSE)
}
S0 <- 100.0
delta_S <- 0.001
K <- 100.0
r <- 0.05
sigma <- 0.2
T <- 1.0
M <- 10
result1 <- Finite_Difference(S0,K,r,sigma,T,M,delta_S)
I can't seem to figure out the problem, any suggestions would be greatly appreciated.
In R, the %*% operator is reserved for multiplying two conformable matrices. As one special case, you can also use it to multiply a vector by a matrix (or vice versa), if the vector can be treated as a row or column vector that conforms to the matrix; as a second special case, it can be used to multiply two vectors to calculate their inner product.
However, one thing it cannot do is perform scalar multipliciation. Scalar multiplication of vectors or matrices always uses the plain * operator. Specifically, in the expression sqrt(T) %*% Z, the first term sqrt(T) is a scalar, and the second Z is a matrix. If what you intend to do here is multiply the matrix Z by the scalar sqrt(T), then this should just be written sqrt(T) * Z.
When I made this change, your program still didn't work because of another bug -- S is used but never defined -- but I don't understand your algorithm well enough to attempt a fix.
A few other comments on the program not directly related to your original question:
The first loop in Finite_Difference looks suspicious: guassian_box_muller(i) generates a vector of length i as i varies in the loop from 1 up to M, and forcing these vectors into a column matrix of length M to generate Z is probably not doing what you want. It will "reuse" the values in a cycle to populate the matrix. Try these to see what I mean:
matrix(gaussian_box_muller(1),10,1) # all one value
matrix(gaussian_box_muller(3),10,1) # cycle of three values
You also use loops in many places where R's vector operations would be easier to read and (typically) faster to execute. For example, your definition of Var is equivalent to:
Var <- sum((Delta - totDelta)^2)/M
and the definitions of Delta and totDelta could also be written in this simplified fashion.
I'd suggest Googling for "vector and matrix operations in r" or something similar and reading some tutorials. Vector arithmetic in particular is idiomatic R, and you'll want to learn it early and use it often.
You might find it helpful to consider the rnorm function to generate random Gaussians.
Happy R-ing!