I'm trying to write code to efficiently solve for all values in a matrix based on an optimization. I'm trying to find the value of x that minimizes the equation:
(x - (1 / ((1 / x) - sqrt(1 / x))))^2
I wrote some code that accomplishes this task, but it isn't pretty (nor is it fast).
mSS <- function(x)
{
#Sum of squares for X and the transformation
(x - (1 / ((1 / test_mat[rows, cols]) - sqrt(1 / x))))^2
}
n = 151
m = 50000
test_mat = matrix(rnorm(n * m, mean = 0, sd = 1), n, m)
trans_mat = matrix(data = NA, n, m)
#Go through each row/col position in array, find value that minimizes mSS function
for (cols in 1:ncol(test_mat)) {
for (rows in 1:nrow(test_mat)) {
trans_mat[rows, cols] = optimize(mSS, c(0, 3))$minimum
}
}
I'm mentally stuck trying to figure out the best approach for making this go faster. I was thinking maybe using apply with some custom functions might be the route, but I'm having difficulty figuring out a workable solution. Any pointers in the right direction would be appreciated.
Try this:
mSS<-function(x, a)
{
#Sum of squares for X and the transformation
(x-(1/((1/a)-sqrt(1/x))))^2
}
y <- as.numeric(test_mat)
ty <- sapply(y, function(x) optimize(mSS,c(0,3),a=x)$minimum)
trans_mat <- matrix(ty, nrow=nrow(test_mat))
Related
H2 = 0
H3 - H999 = =SQRT(EXP(G3*0,1))*NORMINV(RAND();0;1)
I2 - I999 = =$E$2+$D$2*EXP($A$2*($G2-$B$2)+$C$2)/(1+EXP($A$2*($G2-$B$2)+$C$2))+H2
Hi guys,
i created the formula obove in excel.
I want to implement this one to R. Can anyone help me with this?
I already tried to do it with formula and with data.frame.
The probelm is that sigma depends on t and X(t)-1.
Can anyone help me with it?
Thanks,
Max
Edit for further question:
Simulation with sigma only depending on t in R
Simulation with sigma only depending on t in Excel
This seems to require a for loop. If the intention is the run this multiple times to get X(t), then the replications can be vectorized within the for loop:
fXt <- function(A, B, C, D, E, delta, steps, n) {
t <- seq(delta, by = delta, length.out = steps)
# pre-allocate Xt and sigma
Xt <- matrix(rep(E + D*exp(A*(t - B) + C)/(1 + exp(A*(t - B) + C)), each = n), n, steps)
sigma <- matrix(0, n, steps)
r <- matrix(exp(0.025)*rnorm(n*(steps - 1L)), n, steps - 1L) # sqrt(exp(0.05)) = exp(0.025)
for (i in 2:steps) {
sigma[,i] <- r[,i - 1L]*sqrt(abs(Xt[,i - 1L] - 50))
Xt[,i] <- Xt[,i] + sigma[,i]
}
t(Xt)
}
Call it like so:
Xt <- fXt(2, 5, 3, 30, 100, 0.05, 998, 100)
Xt will be a matrix with 998 rows and 100 columns. Each column is a different replication.
I want to implete the function of the Wiener representation in R (see https://en.wikipedia.org/wiki/Wiener_process#Wiener_representation). (I want to implement the first formulae) When plotting this
function it should look more similar to the standard brownian motion the higher the dimension of the random vector is, and the lower it should look smoother.
I have tried to implement it, but I think there is a mistake somewhere in the loop, because the graphs do not should look much more like a brownian motion when n is high, I even went as high as 10000 there isn't enough fluctation inside each graph
brownmotion <- function(n, time=1000){
W <- rep(0, time)
Wp1 <- rep(0, time)
Wp2 <- 0
X <- seq(0, 1, length.out = time)
xsi <- rnorm(n)
for ( i in 1:length(X)){
for (j in 1:n){
Wp1[i] <- X[i]*xsi[1]
Wp2 <- Wp2 + xsi[j]*sin(j*X[i]*pi)/(j*pi)
W[i] <- Wp1[i] + sqrt(2)*Wp2
}
}
return (W)
}
Since this is R, this is better done without loops:
brownmotion <- function(n, time=1000){
X <- seq(0, 1, length.out = time)
xsi <- rnorm(n + 1)
W <- xsi[1] * X + sqrt(2) * colSums(xsi[-1] * sin(pi * 1:n %*% t(X)) / (pi * 1:n))
return (W)
}
When coding this, I noticed a small error in your original code in that you use xsi[1] twice. I avoided this by making xsi length n + 1, so xsi[1] could be the initial value and there are still n values left.
Please see the above equation. As you can see 0<= i <j <= n. I wrote the following command in R. When i=0, we consider X_0 = 0. I generated two observations n=2 and I manually calculated the values. They are, 4.540201, 1.460604. However, my r codes overwrite the results. I got this output 1.460604 1.460604. I couldn't figure it out. What is the reason for that?
I updated the code below.
n = 2
set.seed(2)
x = rexp(n, 1)
xo = sort(x)
xo
value1 = matrix(NA, nrow = 2,2)
for(j in 1:n){
for(i in 0:(j-1)){
value1[i,j] = ifelse(i==0,((n - j + 1)*sum(xo[i+1] - 0)), ((n - j + 1)*sum(xo[i+1] - xo[i])) )
}
}
value1
You could write that in a way more simple way by using matrix multiplication.
Assuming your X_k and your X_i are vectors, you could:
X_k <- as.matrix(X_k)
X_i <- as.matrix(X_i)
difference <- (X_k - X_i)
output <- (n - j + 1) * (t(difference) %*% difference)
Where t() calculates the transpose of a matrix and %*% is matrix multiplication.
I'm trying wherever possible to replace my for loops with apply / map functions
However I am stuck when it comes to times where I need to use the loop index as a position. This is easy to do with a for loop
Take the following code, I use the index i in both the left hand and the right hand side of the assignment:
score <- function(x) {
n <- length(x)
right <- x
for(i in 1:n) {
right[i] <- (n - x[i] + 1) / (i * n)
}
(1 / n) * sum(right)
}
score(c(2,1,3))
how do i rewrite the above using map or apply functions?
You could use this:
x = c(2,1,3)
n = length(x)
(1/n) * sum(sapply(1:n, function(i) (n - x[i] + 1)/(i*n) ))
We could vectorize this
v1 <- c(2, 1, 3)
n <- length(v1)
(1/n) *sum((n - v1 + 1)/(seq_along(v1) * n))
#[1] 0.4259259
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!