R/quarterly_pin.R

In pinbasic: Fast and Stable Estimation of the Probability of Informed Trading (PIN)

#' Quarterly PIN estimates
#'
#' Estimation of model parameters and probability of informed trading for quarterly data.
#'
#' Wrapper around \code{\link{pin_est}} function and therefore inherits its settings for optimization.
#' Data is split into quarters with the \code{\link[lubridate]{quarter}} function from \pkg{lubridate} package.
#' According to the help page of this function \code{dates} argument must be \cr
#' \emph{a date-time object of class POSIXct, POSIXlt, Date, chron, yearmon, yearqtr, zoo, zooreg,
#'  timeDate, xts, its, ti, jul, timeSeries, fts or anything else that can be converted with as.POSIXlt}. \cr
#' \code{\link{nlminb}} function in the \pkg{stats} package is used for maximization.
#' Vectors for \code{numbuys} and \code{numsells} need to have same length. \cr
#' Calculation of confidence interval for the probability of informed trading is disabled by default.
#' For more details see \code{\link{pin_est_core}} or \code{\link{pin_confint}}.
#'
#' @param dates see \strong{Details}
#' @inheritParams pin_ll
#' @inheritParams pin_est_core
#' @inheritParams pin_confint
#' @param ci_control \emph{list}: see \code{\link{pin_est_core}}
#'
#' @seealso \code{\link{nlminb}},
#'          \code{\link{initial_vals}}
#'          \code{\link{pin_est}}
#'          \code{\link{pin_est_core}}
#'          \code{\link{pin_confint}}
#'          \code{\link[lubridate]{quarter}}
#'          \code{\link[lubridate]{year}}
#'
#' @return
#' A list of lists with class 'qpin'. The length of the outer list equals the number of available quarters in the data.
#' Naming scheme for the outer list is 'Year.QuarterNumber', where QuarterNumber equals an integer from 1 to 4.
#' The inner list is structured as follows:
#' \describe{
#' \item{Results}{Matrix containing the parameter estimates as well as their estimated standard errors,
#'  t-values and p-values.}
#'  \item{ll}{Value of likelihood function returned by \code{nlminb}}
#'  \item{pin}{Value(s) of the estimated probability of informed trading}
#'  \item{conv}{Convergence code for nlminb optimization}
#'  \item{message}{Convergence message returned by the nlminb optimizer}
#'  \item{iterations}{Number of iterations until convergence of nlminb optimizer}
#'  \item{init_vals}{Vector of initial values}
#'  \item{confint}{If \code{confint = TRUE}; confidence interval for the probability of informed trading}
#'  }
#'
#' @references
#' Easley, David et al. (2002) \cr
#' Is Information Risk a Determinant of Asset Returns? \cr
#' \emph{The Journal of Finance}, Volume 57, Number 5, pp. 2185 - 2221 \cr
#' \doi{10.1111/1540-6261.00493}
#'
#' Easley, David et al. (1996) \cr
#' Liquidity, Information, and Infrequently Traded Stocks\cr
#' \emph{The Journal of Finance}, Volume 51, Number 4, pp. 1405 - 1436 \cr
#' \doi{10.1111/j.1540-6261.1996.tb04074.x}
#'
#' Easley, David et al. (2010) \cr
#' Factoring Information into Returns \cr
#' \emph{Journal of Financial and Quantitative Analysis}, Volume 45, Issue 2, pp. 293 - 309 \cr
#' \doi{10.1017/S0022109010000074}
#'
#' Ersan, Oguz and Alici, Asli (2016) \cr
#' An unbiased computation methodology for estimating the probability of informed trading (PIN) \cr
#' \emph{Journal of International Financial Markets, Institutions and Money}, Volume 43, pp. 74 - 94 \cr
#' \doi{10.1016/j.intfin.2016.04.001}
#'
#' Gan, Quan et al. (2015) \cr
#' A faster estimation method for the probability of informed trading
#' using hierarchical agglomerative clustering \cr
#' \emph{Quantitative Finance}, Volume 15, Issue 11, pp. 1805 - 1821 \cr
#' \doi{10.1080/14697688.2015.1023336}
#'
#' Grolemund, Garett and Wickham, Hadley (2011) \cr
#' Dates and Times Made Easy with lubridate \cr
#' \emph{Journal of Statistical Software}, Volume 40, Issue 3, pp. 1 - 25 \cr
#' \doi{10.18637/jss.v040.i03}
#'
#' Lin, Hsiou-Wei William and Ke, Wen-Chyan (2011) \cr
#' A computing bias in estimating the probability of informed trading \cr
#' \emph{Journal of Financial Markets}, Volume 14, Issue 4, pp. 625 - 640 \cr
#' \doi{10.1016/j.finmar.2011.03.001}
#'
#' Yan, Yuxing and Zhang, Shaojun (2012) \cr
#' An improved estimation method and empirical properties of the probability of informed trading \cr
#' \emph{Journal of Banking & Finance}, Volume 36, Issue 2, pp. 454 - 467 \cr
#' \doi{10.1016/j.jbankfin.2011.08.003}
#'
#' @examples
#' # Loading one year of simulated daily buys and sells
#'
#' data('BSfrequent2015')
#'
#' # Quarterly estimates for model parameters and the probability of informed trading
#' # Rownames of 'BSfrequent2015' equal the business days in 2015.
#'
#' qpin2015 <- qpin(numbuys = BSfrequent2015[,"Buys"],
#'                  numsells = BSfrequent2015[,"Sells"],
#'                  dates = as.Date(rownames(BSfrequent2015), format = "%Y-%m-%d"))

#' @export

qpin <- function(numbuys = NULL, numsells = NULL, dates = NULL,
                 nlminb_control = list(),
                 confint = FALSE, ci_control = list(), posterior = TRUE) {
  if(is.null(numbuys)) stop("Missing data for 'numbuys'")
  if(is.null(numsells)) stop("Missing data for 'numsells'")
  if(is.null(dates)) stop("Missing 'dates'")
  if(length(numbuys) != length(numsells)) stop("Unequal lengths for 'numbuys' and 'numsells'")

  quarters <- lubridate::quarter(dates, with_year = TRUE)
  quarters_char <- as.character(quarters)

  quarter_num <- length(unique(quarters))

  quarter_list <- vector("list", quarter_num)
  data_years <- unique(lubridate::year(dates))
  data_years_char <- as.character(data_years)
  quarters_per_year <- numeric(length(data_years))
  names(quarters_per_year) <- data_years_char
  quarter_names <- character(0)

  for(i in data_years_char) {
    quarters_per_year[i] <- max(as.numeric(substring(quarters_char[grepl(i,quarters_char)],
                                                     first = 6)))
    quarter_names <- c(quarter_names, paste0(i, ".", 1:quarters_per_year[i]))
  }

  names(quarter_list) <- quarter_names
  BS_data <- cbind(numbuys, numsells)

  for(i in data_years_char) {
    for(j in 1:quarters_per_year[i]) {
      quarter_list[[paste0(i,".",j)]] <- BS_data[quarters_char == paste0(i,".",j),]
    }
  }

  res <- lapply(quarter_list,
                function(x) pin_est(numbuys = x[,1], numsells = x[,2],
                                    nlminb_control = nlminb_control,
                                    confint = confint, ci_control = ci_control, posterior = posterior))
  class(res) <- c("list", "qpin")
  res
}