# R/ptools_geomean_functions.r In donboyd5/ptools: Tools for simulation modeling of pension funds

#### Documented in gm.lr_to_rgm_to_rr_to_gmr_to_gm.n

```#' Get long-run geometric mean associated with arithmetic mean
#'
#' This is the exact calculation rather than the gm = r - var /2 approximation.
#' See https://web.stanford.edu/~wfsharpe/mia/rr/mia_rr3.htm
#'
#' @param r Numeric vector of arithmetic returns.
#' @param sd standard deviation
#' @return The long-run geometric mean, given \code{r} and \code{sd}.
#' @export
#' @examples
#' r_to_gm(.08, .12)
r_to_gm <- function(r, sd){
# Get long-run geometric mean associated with arithmetic mean
# https://web.stanford.edu/~wfsharpe/mia/rr/mia_rr3.htm
# this is the exact calculation rather than the gm = r - var /2 approximation
gm <- {(1 + r)^2 - sd^2}^(1/2) - 1
return(gm)
}

#' Get arithmetic mean associated with a long-run geometric mean
#'
#' This is the exact calculation rather than the ar = gr + var /2 approximation
#' See https://web.stanford.edu/~wfsharpe/mia/rr/mia_rr3.htm
#'
#' @param gm Numeric vector of long-run geometric-mean returns.
#' @param sd standard deviation
#' @return The arithmetic mean, given \code{gm} and \code{sd}.
#' @export
#' @examples
#' gm_to_r(0.07331263, .12)
gm_to_r <- function(gm, sd){
# get arithmetic mean associated with a long-run geometric mean
# https://web.stanford.edu/~wfsharpe/mia/rr/mia_rr3.htm
# this is the exact calculation rather than the ar = gr + var /2 approximation
r <- {(1 + gm)^2 + sd^2}^(1/2) - 1
return(r)
}

#' Get expected geometric mean at year n, for a given arithmentic mean r
#'
#'
#' @param r Numeric vector of arithmetic returns
#' @param sd standard deviation
#' @param n year
#' @return Expected geometric mean at year \code{n}, given \code{r} and \code{sd}.
#' @export
#' @examples
#' r_to_gm.n(.08, .12, 1)
#' r_to_gm.n(.08, .12, 10)
#' r_to_gm.n(.08, .12, 100)
#' r_to_gm.n(.08, .12, 1000000)
#' # compare to the exact calculation -- hmmm...
#' r_to_gm(.08, .12)
#' # compare to the approximation
#' .08 - .12^2 / 2
r_to_gm.n <- function(r, sd, n){
# get expected geometric mean at year n, for a given arithmentic mean r
# r	expected arithmetic return
# gm.n	expected geometric return at n
# var	variance of r
# a	= (1 + r)^2
# b	= (1 - n) / 2*n
# gm.n = (1 + r) * (1+ var /a) ^ b - 1
var <- sd^2
a <- (1 + r)^2
b <- (1 - n) / (2 * n)
gm.n <- (1 + r) * (1 + var / a)^b - 1
return(gm.n)
}

#' Find the arithmetic mean needed to result in a particular long-run geometric mean gm
#'
#' Use brute force by minimizing error
#'
#' @param gm Numeric vector of long-run geometric-mean returns.
#' @param sd standard deviation of the arithmetic mean
#' @return The approximated arithmetic mean, given \code{gm} and \code{sd}.
#' @export
#' @examples
#' gm.lr_to_r(0.07331263, .12)
#' # compare to exact calculation
#' gm_to_r(0.07331263, .12)
gm.lr_to_r <- function(gm, sd){
# find the arithmetic mean needed to result in a particular long-run geometric mean gm.lr
# use brute force by minimizing error
obj <- function(armean, sd, target){
gmean <- r_to_gm.n(armean, sd, 1e9)
obj <- (gmean - gm)^2
return(obj)
}
opt <- optim(gm, obj, sd=sd, target=gm, method="BFGS")
return(opt\$par)
}
```
donboyd5/ptools documentation built on May 13, 2017, 4:34 a.m.