# R/functions-finance.R In naokiookura/rquants: Tools to sumirate your strategy for FX,CFD easier

```#'calculate price differences between price with black sholes model and price for the comparison
#'@param s spot price of the underlying asset
#'@param k strike price
#'@param r risk free rate (annual rate, expressed in terms of continuous compounding)
#'@param sigma volatility of returns of the underlying asset
#'@param t time to maturity
#'@param prc_mkt price for the comparison(vector)
#'@examples finance_black_scholes_err(s = 100, k = 100, r = 0.01, sigma = 0.05, t = 1 / 12, prc_mkt = 98)
#'@encoding UtF-8
#'@export
finance_black_scholes_err <- function (s = 100, k = 100, r = 0.01,
sigma = 0.05, t = 1 / 12, prc_mkt = 98){
tmp <- abs(
prc_mkt -
finance_black_scholes_vanilla(call_put = "call", s, k, r, sigma, t)
)
return(tmp)
}

#'calculate implied volatility
#'@param s spot price of the underlying asset
#'@param k strike price
#'@param r risk free rate (annual rate, expressed in terms of continuous compounding)
#'@param sigma volatility of returns of the underlying asset
#'@param t time to maturity
#'@param prc_mkt price for the comparison(vector)
#'@examples finance_implied_volatility(s = 100, k = 100, r = 0.01, sigma = 0.05, t = 1 / 12, prc_mkt = 98)
#'@encoding UtF-8
#'@export
finance_implied_volatility <- function (s = 100, k = 100, r = 0.01,
sigma = 0.05, t = 1 / 12, prc_mkt = 98){
iv <- optimize(
finance_black_scholes_err,
interval = c(0, 5),
maximum = FALSE,
prc_mkt = prc_mkt,
s = s,
k = k,
r = r,
t = t
)
return(iv)
}

#'calculate vanilla option price with black scholes model
#'@param call_put call or put
#'@param s spot price of the underlying asset
#'@param k strike price
#'@param r risk free rate annual rate, expressed in terms of continuous compounding. in the case of a currency r is demanded in formula R_d - R_f R_d is domestic risk-free interest rate  R_f is foreign risk-free interest rate
#'@param sigma volatility of returns of the underlying asset
#'@param t time to maturity
#'@examples finance_black_scholes_vanilla(call_put = "call", s = 100, k = 100, r = 0.01, sigma = 0.06, t = 1 / 12)
#'@encoding UtF-8
#'@export
finance_black_scholes_vanilla <-
function (call_put = "call", s = 100, k = 100, r = 0.01,
sigma = 0.06, t = 1 / 12){
d1 <- (log(s / k) + (r + sigma ^ 2 / 2) * t) / (sigma * sqrt(t))
#this is equal to the next expression (1 / sqrt(2 * pi)) * exp(-0.5 * (x ^ 2))
d2 <- d1 - sigma * sqrt(t)
#price of call option
call_premium <- s * pnorm(d1) - exp(-r * t) * k * pnorm(d2)
#price of put option
if (call_put == "call"){
} else if (call_put == "put"){
} else {
}
}

#'calculate barrier option price with black scholes model
#'@param in_out knock-in or knock-out
#'@param call_put call or put
#'@param s spot price of the underlying asset
#'@param k strike price
#'@param r risk free rate annual rate, expressed in terms of continuous compounding. in the case of a currency r is demanded in formula R_d - R_f R_d is domestic risk-free interest rate R_f is foreign risk-free interest rate
#'@param sigma volatility of returns of the underlying asset
#'@param t time to maturity
#'@param b barrier price
#'@examples finance_black_scholes_barrier(in_out = "out", call_put = "call", s = 100, k = 100, r = 0.01, sigma = 0.05, t = 1 / 12, b = 105)
#'@encoding UtF-8
#'@export
finance_black_scholes_barrier <-
function (in_out = "out", call_put = "call", s = 100, k = 100, r = 0.01,
sigma = 0.05, t = 1 / 12, b = 105){
d1 <- (log(s / k) + (r - 0.5 * sigma ^ 2) * t) / (sigma * sqrt(t))
d2 <- (log(s / b) + (r - 0.5 * sigma ^ 2) * t) / (sigma * sqrt(t))
d3 <- (log(b ^ 2 / (k * s)) + (r - 0.5 * sigma ^ 2) * t) / (sigma * sqrt(t))
d4 <- (log(b / s) + (r - 0.5 * sigma ^ 2) * t) / (sigma * sqrt(t))
c1 <- s * pnorm(d1 + sigma * sqrt(t)) - exp(-r * t) * k * pnorm(d1)
c2 <- s * pnorm(d2 + sigma * sqrt(t)) - exp(-r * t) * k * pnorm(d2)
c3 <- (b ^ 2 / s) * pnorm(d3 + sigma * sqrt(t)) - exp(-r * t) * k * pnorm(d3)
c4 <- (b ^ 2 / s) * pnorm(d4 + sigma * sqrt(t)) - exp(-r * t) * k * pnorm(d4)
p1 <- -s * pnorm(-d1 (sigma * -1) * sqrt(t)) + exp(-r * t) * k * pnorm(-d1)
p2 <- -s * pnorm(-d2 (sigma * -1) * sqrt(t)) + exp(-r * t) * k * pnorm(-d2)
p3 <-
- (b ^ 2 / s) * pnorm(-d3 - sigma * sqrt(t)) + exp(-r * t) * k * pnorm(-d3)
p4 <-
- (b ^ 2 / s) * pnorm(-d4 - sigma * sqrt(t)) + exp(-r * t) * k * pnorm(-d4)
m <- (b / s) ^ (2 * r / sigma ^ 2 - 1)
#vanilla price
s = s, k = k, r = r,
sigma = sigma, t = t)
s = s, k = k, r = r,
sigma = sigma, t = t)
#knock_out
#call
out_up_call_blek <- 0
out_up_call_bgek <- c1 - c2 - m * (c3 - c4)
out_down_call_blek <- c1 - m * c3
out_down_call_bgek <- c2 - m * c4
#put
out_up_put_blek <- p2 - m * p4
out_up_put_bgek <- p1 - m * p3
out_down_put_blek <- p1 - p2 - m * (p3 - p4)
out_down_put_bgek <- 0
#knock-in
#call
#put
#knock_out
v <- 0
if (in_out == "out"){
#call
if (call_put == "call"){
#up
if (k >= s){
#barrier and strike price
if (b <= k){
v <- out_up_call_blek
} else if (b >= k){
v <- out_up_call_bgek
}
#down
} else if (k <= s){
#barrier and strike price
if (b <= k){
v <- out_down_call_blek
} else if (b >= k){
v <- out_down_call_bgek
}
}
#put
} else if (call_put == "put"){
#up
if (k >= s){
#barrier and strike price
if (b <= k){
v <- out_up_put_blek
} else if (b >= k){
v <- out_up_put_bgek
}
#down
} else if (k <= s){
#barrier and strike price
if (b <= k){
v <- out_down_put_blek
} else if (b >= k){
v <- out_down_put_bgek
}
}
}
#knock-in
} else if (in_out == "in"){
#call
if (call_put == "call"){
#up
if (k >= s){
#barrier and strike price
if (b <= k){
v <- in_up_call_blek
} else if (b >= k){
v <- in_up_call_bgek
}
#down
} else if (k <= s){
#barrier and strike price
if (b <= k){
v <- in_down_call_blek
} else if (b >= k){
v <- in_down_call_bgek
}
}
#put
} else if (call_put == "put"){
#up
if (k >= s){
#barrier and strike price
if (b <= k){
v <- in_up_put_blek
} else if (b >= k){
v <- in_up_put_bgek
}
#down
} else if (k <= s){
#barrier and strike price
if (b <= k){
v <- in_down_put_blek
} else if (b >= k){
v <- in_down_put_bgek
}
}
}
}
return(v)
}

#'calculate one touch option price with black scholes model
#'@param up_down up or down side
#'@param s spot price of the underlying asset
#'@param k strike price
#'@param r risk free rate annual rate, expressed in terms of continuous compounding. in the case of a currency r is demanded in formula R_d - R_f R_d is domestic risk-free interest rate R_f is foreign risk-free interest rate
#'@param sigma volatility of returns of the underlying asset
#'@param t time to maturity
#'@examples finance_black_scholes_one_touch_digital(up_down = "up", s = 100, k = 100, r = 0.01, sigma = 0.05, t = 1 / 12)
#'@encoding UtF-8
#'@export
finance_black_scholes_one_touch_digital <-
function (up_down = "up", s = 100, k = 100, r = 0.01,
sigma = 0.05, t = 1 / 12){
#where
miu <- (r - (0.5 * sigma ^ 2)) / sigma ^ 2
lambda <- sqrt(miu ^ 2 + 2 * r / sigma ^ 2)
z <- log(k / s) / (sigma * sqrt(t)) + lambda * sigma * sqrt(t)
#s>k one touch down
c_one_touch_down <-
k * ( (k / s) ^ (miu + lambda) * pnorm(z) +
(k / s) ^ (miu - lambda) * pnorm(z - (2 * lambda * sigma * sqrt(t))))
#s<k one touch down
c_one_touch_up <-
k * ( (k / s) ^ (miu + lambda) * pnorm(-z) +
(k / s) ^ (miu - lambda) * pnorm( (2 * lambda * sigma * sqrt(t)) - z))
if (up_down == "up"){
#Up
v <- c_one_touch_up
} else if (up_down == "down"){
#Down
v <- c_one_touch_down
} else {
v <- 0
}
v_pct <- v / s
return(v_pct)
}

#'calculate barrier option price with black scholes model
#'@param x vector of price(vector)
#'@param t time to maturity
#'@param sigma volatility of returns of the underlying asset
#'@examples finance_historical_volatility(x = c(100, 101, 105, 101, 99), t = 250, sigma_mag = 1)
#'@encoding UtF-8
#'@export
finance_historical_volatility <- function (x = c(100, 101, 105, 101, 99),
t = 250, sigma_mag = 1){
n <- length(x)
chg <- x[2:n] / x[1:(n - 1)]
a <- sd(chg) * sqrt(t) * sigma_mag
return(a)
}

#'calculate mean variance portforio
#'@param ccy currencys considering good combination(vector)
#'@param dt_start date of start
#'@param dt_end date of end
#'@param min_rat as minumum ratio
#'@encoding UtF-8
#'@examples finance_mean_variance_model_ccy(ccy = c("usdjpy", "eurjpy", "eurusd"), dt_start = "2010/01/03", dt_end = "2015/01/01", min_rat = 0.1)
#'@export
finance_mean_variance_model_ccy <-
function (ccy = c("usdjpy", "eurjpy", "eurusd"),
dt_start = "2010/01/03", dt_end = "2015/01/01", min_rat = 0.1){
#setting
ccy_n <- length(ccy)
pfm <- data.frame(ccy = ccy, mu = 0, sigma = 0)
dt_start <- as.Date(dt_start)
dt_end <- as.Date(dt_end)
#names of column
clm_ccy <- paste("ccy", 1:ccy_n, sep = "")
clm_rat <- paste("rat", 1:ccy_n, sep = "")
clm_mu <- paste("mu", 1:ccy_n, sep = "")
clm_sd <- paste("sd", 1:ccy_n, sep = "")
#investment ratio variation
rat_seq <- seq(0, 1, min_rat)
rat_n <- length(rat_seq)
#result data set
a_n <- rat_n ^ ccy_n
a <- data.frame(id = 1:a_n, mu_p = 0, var_p = 0, sigma_p = 0)
a <- a[, -1]
for (i in 1:ccy_n){
a[, clm_ccy[i]] <- ccy[i]
}
a[, clm_rat] <- 0
a[, clm_mu] <- 0
a[, clm_sd] <- 0
for (i in 1:ccy_n){
#investment ratio variation
rat2 <- rep(rat_seq[1], a_n / (rat_n ^ (ccy_n - i + 1)))
for (j in 2:rat_n){
rat2 <- c(rat2, rep(rat_seq[j], a_n / (rat_n ^ (ccy_n - i + 1))))
}
#repeat this process to combinatorial number of investment ratio variation
rat2 <- rep(rat2, a_n / (rat_n ^ (ccy_n - (ccy_n - i + 1) + 1)))
a[, clm_rat[(ccy_n - i + 1)]] <- rat2
}
#leave combination that the total becomes 100%
a[, "rat_sum"] <- apply(X = a[, clm_rat], MARGIN = 1, fun = sum)
a <- a[a\$rat_sum == 1, ]
a <- a[, -ncol(a)]
rownames(a) <- 1:nrow(a)
#performance
ccy_prc <- usdjpy_d
x <- ccy_prc[, c("dt", "c")]
colnames(x) <- c("dt", ccy[1])
x\$dt <- as.Date(x\$dt)
x[, ccy[-1]] <- 0
x <- x[x\$dt >= dt_start & x\$dt <= dt_end, ]
rownames(x) <- 1:nrow(x)
for (i in 2:length(ccy)){
ccy_prc <- read.csv(paste("data/", ccy[i], "_d1.csv", sep = ""))
ccy_prc\$dt <- as.Date(ccy_prc\$dt)
ccy_prc <- ccy_prc[ccy_prc\$dt >= dt_start & ccy_prc\$dt <= dt_end, ]
x[, ccy[i]] <- ccy_prc\$c
}
n <- nrow(x)
#information of column
for (i in 1:length(ccy)){
if (substring(text = ccy[i], first = 4, last = 6) == "jpy"){
x[, ccy[i]] <- x[, ccy[i]] * 100
} else if (substring(text = ccy[i], first = 4, last = 6) == "usd"){
x[, ccy[i]] <- x[, ccy[i]] * 10000
}
}
x[2:n, ccy] <- round( (x[2:n, ccy] / x[1:(n - 1), ccy]) - 1, 4)
x <- x[-1, -1]
#performance measurement
pfm\$mu <- apply(X = x[, ccy], MARGIN = 2, fun = mean)
pfm\$sigma <- apply(X = x[, ccy], MARGIN = 2, fun = sd)
for (i in 1:ccy_n){
a[, clm_mu[i]] <- rep(pfm\$mu[i], 1, nrow(a))
a[, clm_sd[i]] <- rep(pfm\$sigma[i], 1, nrow(a))
}
#covariance matrix
cov <- var(x)
for (i in 1:ccy_n){
for (j in 1:ccy_n){
cov[i, j] <- ifelse(j >= i, 0, cov[i, j])
}
}
for (i in 1:nrow(a)){
#covariance is considered by investment ratio variation
cov_rat <- cov
for (j in 1:ccy_n){
for (k in 1:ccy_n){
if (k >= j){
cov_rat[j, k] <- 0
} else {
cov_rat[j, k] <- 2 * as.numeric(a[i, clm_rat][j]) *
as.numeric(a[i, clm_rat][k]) * cov[j, k]
}
}
}
#create column of mean and variance
a[i, "mu_p"] <- sum(a[i, clm_rat] * pfm\$mu)
a[i, "var_p"] <-
sum( (a[i, clm_rat] ^ 2) * (pfm[, "sigma"] ^ 2)) + sum(cov_rat)
a[i, "sigma_p"] <- a[i, "var_p"] ^ (1 / 2) #calculate volatility
}
a <- a[order(a\$sigma_p), ]
return(a)
}

#'calculate barrier option price with black scholes model
#'@param x price data(data.frame)
#'@param min_rat combinatorial number of investment ratio variation
#'@examples finance_mean_variance_portfolio_buysell(x = data.frame(usdjpy = c(100.00, 90.50, 90.00), eurjpy = c(120.00, 119.00, 118.90)), min_rat = 0.05)
#'@encoding UtF-8
#'@export
function (x = data.frame(usdjpy = c(100.00, 90.50, 90.00),
eurjpy = c(120.00, 119.00, 118.90)),
min_rat = 0.05){
#setting
ccy <- colnames(x)
ccy_n <- length(ccy)
pfm <- data.frame(ccy = ccy, mu = 0, sigma = 0)
#names of column
clm_ccy <- paste("ccy", 1:ccy_n, sep = "")
clm_side <- paste("side", 1:ccy_n, sep = "")
clm_rat <- paste("rat", 1:ccy_n, sep = "")
clm_mu <- paste("mu", 1:ccy_n, sep = "")
clm_sd <- paste("sd", 1:ccy_n, sep = "")
#investment ratio variation
rat_seq <-
c("b0",
paste("b", seq(min_rat, 1, min_rat), sep = ""),
paste("s", seq(min_rat, 1, min_rat), sep = "")
)
rat_n <- length(rat_seq)
#result data set
a_n <- rat_n ^ ccy_n
a <- data.frame(id = 1:a_n, mu_p = 0, var_p = 0, sigma_p = 0)
a <- a[, -1]
for (i in 1:ccy_n){
a[, clm_ccy[i]] <- ccy[i]
}
a[, clm_side] <- 0
a[, clm_rat] <- 0
a[, clm_mu] <- 0
a[, clm_sd] <- 0
for (i in 1:ccy_n){
#investment ratio variation
rat2 <- rep(rat_seq[1], a_n / (rat_n ^ (ccy_n - i + 1)))
for (j in 2:rat_n){
rat2 <- c(rat2, rep(rat_seq[j], a_n / (rat_n ^ (ccy_n - i + 1))))
}
#repeat this process to combinatorial number of investment ratio variation
rat2 <- rep(rat2, a_n / (rat_n ^ (ccy_n - (ccy_n - i + 1) + 1)))
a[, clm_rat[(ccy_n - i + 1)]] <- rat2
}
#combinatorial number, investment ratio, side
for (i in 1:ccy_n){
side <- substring(a[, clm_rat[(ccy_n - i + 1)]], first = 1, last = 1)
rat <-
as.numeric(substring(a[, clm_rat[(ccy_n - i + 1)]], first = 2, last = 5))
a[, clm_side[(ccy_n - i + 1)]] <- ifelse(side == "b", 1, -1)
a[, clm_rat[(ccy_n - i + 1)]] <- rat
}
#leave combination that the total becomes 100%
a[, "rat_sum"] <- apply(X = a[, clm_rat], MARGIN = 1, fun = sum)
a <- a[a\$rat_sum == 1, ]
a <- a[, -ncol(a)]
rownames(a) <- 1:nrow(a)
n <- nrow(x)
for (i in 1:ccy_n){
if (substring(text = ccy[i], first = 4, last = 6) == "jpy"){
x[, ccy[i]] <- x[, ccy[i]] * 100
} else if (substring(text = ccy[i], first = 4, last = 6) == "usd"){
x[, ccy[i]] <- x[, ccy[i]] * 10000
}
}
for (i in 1:nrow(a)){
#plofit and loss sampling data
x2 <- round( (x[2:n, ccy] / x[1:(n - 1), ccy]) - 1, 4)
for (j in 1:ccy_n){
#plofit and loss sampling data considering side
x2[, ccy[j]] <- x2[, ccy[j]] * a[i, clm_side[j]]
}
x2 <- x2[-1, ]
#performance measurement
pfm\$mu <- apply(X = x2, MARGIN = 2, fun = mean)
pfm\$sigma <- apply(X = x2, MARGIN = 2, fun = sd)
for (j in 1:ccy_n){
a[i, clm_mu[j]] <- pfm\$mu[j]
a[i, clm_sd[j]] <- pfm\$sigma[j]
}
#covariance matrix
cov <- var(x2)
for (j in 1:ccy_n){
for (k in 1:ccy_n){
cov[j, k] <- ifelse(k >= j, 0, cov[j, k])
}
}
#covariance is considered by investment ratio variation
cov_rat <- cov
for (j in 1:ccy_n){
for (k in 1:ccy_n){
if (k >= j){
cov_rat[j, k] <- 0
} else {
cov_rat[j, k] <-
2 * as.numeric(a[i, clm_rat][j]) *
as.numeric(a[i, clm_rat][k]) * cov[j, k]
}
}
}
#create column of mean and variance
a[i, "mu_p"] <- sum(a[i, clm_rat] * pfm\$mu)
a[i, "var_p"] <-
sum( (a[i, clm_rat] ^ 2) * (pfm[, "sigma"] ^ 2)) + sum(cov_rat)
a[i, "sigma_p"] <- a[i, "var_p"] ^ (1 / 2) #calculate volatility
}
a <- a[order(a\$sigma_p), ]
z <- a[1, ]
return(z)
}

#'calculate profit factor
#'@param pl timeseries of trade profit and loss(vector)
#'@param pf_max limit of extra value
#'@examples finance_profit_factor(pl = c(10, -30, 20, 15, -5), pf_max = 10)
#'@encoding UtF-8
#'@export
finance_profit_factor <- function (pl = c(10, -30, 20, 15, -5), pf_max = 10){
#unit test
if (F){
pl <- c(-10, 20, -50, 100, 120, -50)
pf_max <- 10
}
pl <- c(pl, 0.001, -0.001)
a <- round(sum(pl[pl > 0]) / abs(sum(pl[pl < 0])), 2)
a <- ifelse(a > pf_max, pf_max, a)
return(a)
}

#'calculate max draw down
#'@param bln times series data of balance(vector)
#'@param pf_max limit of extra value
#'@examples finance_max_draw_down(bln = c(100, 99, 98, 99, 100, 101, 102, 103))
#'@encoding UtF-8
#'@export
finance_max_draw_down <- function (bln = c(100, 99, 98, 99, 100, 101, 102)){
x <- data.frame(bln = bln, dd = 0)
n <- nrow(x)
for (i in 1:n){
x[i, "dd"] <- round(min(x[i:n, "bln"]) / x[i, "bln"], 2) - 1
}
a <- min(x\$dd)
return(a)
}
```
naokiookura/rquants documentation built on May 23, 2017, 10:31 a.m.