R/functions-finance.R

Defines functions finance_max_draw_down finance_profit_factor finance_mean_variance_portfolio_buysell finance_mean_variance_model_ccy finance_historical_volatility finance_black_scholes_one_touch_digital finance_black_scholes_barrier finance_black_scholes_vanilla finance_implied_volatility finance_black_scholes_err

Documented in finance_black_scholes_barrier finance_black_scholes_err finance_black_scholes_one_touch_digital finance_black_scholes_vanilla finance_historical_volatility finance_implied_volatility finance_max_draw_down finance_mean_variance_model_ccy finance_mean_variance_portfolio_buysell finance_profit_factor

#'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
  put_premium <- call_premium - s + exp(-r * t)  * k
  if (call_put == "call"){
    return(call_premium)
  } else if (call_put == "put"){
    return(put_premium)
  } else {
    return(call_premium)
  }
}


#'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
  call_premium <- finance_black_scholes_vanilla(call_put = "call",
                                                s = s, k = k, r = r,
                                                sigma = sigma, t = t)
  put_premium <- finance_black_scholes_vanilla(call_put = "put",
                                               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
  in_up_call_blek <- call_premium - out_up_call_blek
  in_up_call_bgek <- call_premium - out_up_call_bgek
  in_down_call_blek <- call_premium - out_down_call_blek
  in_down_call_bgek <- call_premium - out_down_call_bgek
  #put
  in_up_put_blek <- put_premium - out_up_put_blek
  in_up_put_bgek <- put_premium - out_up_put_bgek
  in_down_put_blek <- put_premium - out_down_put_blek
  in_down_put_bgek <- put_premium - out_down_put_bgek
  #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
  #adjustment of price
  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
    }
  }
  #adjustment of long performance
  x[2:n, ccy] <- round( (x[2:n, ccy] / x[1:(n - 1), ccy]) - 1, 4)
  #adjustment of short performance
  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
finance_mean_variance_portfolio_buysell <-
  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)
  #adjustment of price
  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.