# R/Partial_Moments.R In OVVO-Financial/NNS: Nonlinear Nonparametric Statistics

#### Documented in Co.LPMCo.UPMD.LPMD.UPMLPMLPM.ratioNNS.PDFPM.matrixUPMUPM.ratio

```#' Lower Partial Moment
#'
#' This function generates a univariate lower partial moment for any degree or target.
#' @param degree integer; \code{(degree = 0)} is frequency, \code{(degree = 1)} is area.
#' @param target numeric; Typically set to mean, but does not have to be. (Vectorized)
#' @param variable a numeric vector.
#' @return LPM of variable
#' @author Fred Viole, OVVO Financial Systems
#' @references Viole, F. and Nawrocki, D. (2013) "Nonlinear Nonparametric Statistics: Using Partial Moments"
#' \url{https://www.amazon.com/dp/1490523995}
#' @examples
#' set.seed(123)
#' x <- rnorm(100)
#' LPM(0, mean(x), x)
#' @export

LPM <-  function(degree, target, variable){
sum((target - (variable[variable <= target])) ^ degree) / length(variable)
}
LPM <- Vectorize(LPM, vectorize.args = 'target')

#' Upper Partial Moment
#'
#' This function generates a univariate upper partial moment for any degree or target.
#' @param degree integer; \code{(degree = 0)} is frequency, \code{(degree = 1)} is area.
#' @param target numeric; Typically set to mean, but does not have to be. (Vectorized)
#' @param variable a numeric vector.
#' @return UPM of variable
#' @author Fred Viole, OVVO Financial Systems
#' @references Viole, F. and Nawrocki, D. (2013) "Nonlinear Nonparametric Statistics: Using Partial Moments"
#' \url{https://www.amazon.com/dp/1490523995}
#' @examples
#' set.seed(123)
#' x <- rnorm(100)
#' UPM(0, mean(x), x)
#' @export

UPM <-  function(degree, target, variable){
sum(((variable[variable > target]) - target) ^ degree) / length(variable)
}
UPM <- Vectorize(UPM, vectorize.args = 'target')

#' Co-Upper Partial Moment
#'
#' This function generates a co-upper partial moment between two equal length variables for any degree or target.
#' @param degree.x integer; Degree for variable X.  \code{(degree.x = 0)} is frequency, \code{(degree.x = 1)} is area.
#' @param degree.y integer; Degree for variable Y.  \code{(degree.y = 0)} is frequency, \code{(degree.y = 1)} is area.
#' @param x a numeric vector.
#' @param y a numeric vector of equal length to \code{x}.
#' @param target.x numeric; Typically the mean of Variable X for classical statistics equivalences, but does not have to be. (Vectorized)
#' @param target.y numeric; Typically the mean of Variable Y for classical statistics equivalences, but does not have to be. (Vectorized)
#' @return Co-UPM of two variables
#' @author Fred Viole, OVVO Financial Systems
#' @references Viole, F. and Nawrocki, D. (2013) "Nonlinear Nonparametric Statistics: Using Partial Moments"
#' \url{https://www.amazon.com/dp/1490523995}
#' @examples
#' set.seed(123)
#' x <- rnorm(100) ; y <- rnorm(100)
#' Co.UPM(0,0,x,y,mean(x),mean(y))
#' @export

Co.UPM <- function(degree.x, degree.y, x, y, target.x = mean(x), target.y = mean(y)){
if(length(x)>1){
z <- cbind(x,y); z <- z[complete.cases(z),]
x <- z[,1]
y <- z[,2]
}
if(degree.x == 0){x[x == target.x] <- target.x - 1}
if(degree.y == 0){y[y == target.y] <- target.y - 1}
x <- x - target.x
y <- y - target.y
x[x <= 0] <- 0
y[y <= 0] <- 0
x[x > 0] <- x[x > 0] ^ degree.x
y[y > 0] <- y[y > 0] ^ degree.y
return(x %*% y / length(x))
}
Co.UPM <- Vectorize(Co.UPM, vectorize.args = c('target.x', 'target.y'))

#' Co-Lower Partial Moment
#'
#' This function generates a co-lower partial moment for between two equal length variables for any degree or target.
#' @param degree.x integer; Degree for variable X.  \code{(degree.x = 0)} is frequency, \code{(degree.x = 1)} is area.
#' @param degree.y integer; Degree for variable Y.  \code{(degree.y = 0)} is frequency, \code{(degree.y = 1)} is area.
#' @param x a numeric vector.
#' @param y a numeric vector of equal length to \code{x}.
#' @param target.x numeric; Typically the mean of Variable X for classical statistics equivalences, but does not have to be. (Vectorized)
#' @param target.y numeric; Typically the mean of Variable Y for classical statistics equivalences, but does not have to be. (Vectorized)
#' @return Co-LPM of two variables
#' @author Fred Viole, OVVO Financial Systems
#' @references Viole, F. and Nawrocki, D. (2013) "Nonlinear Nonparametric Statistics: Using Partial Moments"
#' \url{https://www.amazon.com/dp/1490523995}
#' @examples
#' set.seed(123)
#' x <- rnorm(100) ; y <- rnorm(100)
#' Co.LPM(0, 0, x, y, mean(x), mean(y))
#' @export

Co.LPM <- function(degree.x, degree.y, x, y, target.x = mean(x), target.y = mean(y)){
if(length(x)>1){
z <- cbind(x,y); z <- z[complete.cases(z),]
x <- z[,1]
y <- z[,2]
}
if(degree.x == 0){x[x == target.x] <- target.x - 1}
if(degree.y == 0){y[y == target.y] <- target.y - 1}
x <- target.x - x
y <- target.y - y
x[x <= 0] <- 0
y[y <= 0] <- 0
x[x > 0] <- x[x > 0] ^ degree.x
y[y > 0] <- y[y > 0] ^ degree.y
return(x %*% y / length(x))
}
Co.LPM <- Vectorize(Co.LPM, vectorize.args = c('target.x', 'target.y'))

#' Divergent-Lower Partial Moment
#'
#' This function generates a divergent lower partial moment between two equal length variables for any degree or target.
#' @param degree.x integer; Degree for variable X.  \code{(degree.x = 0)} is frequency, \code{(degree.x = 1)} is area.
#' @param degree.y integer; Degree for variable Y.  \code{(degree.y = 0)} is frequency, \code{(degree.y = 1)} is area.
#' @param x a numeric vector.
#' @param y a numeric vector of equal length to \code{x}.
#' @param target.x numeric; Typically the mean of Variable X for classical statistics equivalences, but does not have to be. (Vectorized)
#' @param target.y numeric; Typically the mean of Variable Y for classical statistics equivalences, but does not have to be. (Vectorized)
#' @return Divergent LPM of two variables
#' @author Fred Viole, OVVO Financial Systems
#' @references Viole, F. and Nawrocki, D. (2013) "Nonlinear Nonparametric Statistics: Using Partial Moments"
#' \url{https://www.amazon.com/dp/1490523995}
#' @examples
#' set.seed(123)
#' x <- rnorm(100) ; y <- rnorm(100)
#' D.LPM(0, 0, x, y, mean(x), mean(y))
#' @export

D.LPM <- function(degree.x, degree.y, x, y, target.x = mean(x), target.y = mean(y)){
if(length(x)>1){
z <- cbind(x,y); z <- z[complete.cases(z),]
x <- z[,1]
y <- z[,2]
}
if(degree.x == 0){x[x == target.x] <- target.x - 1}
if(degree.y == 0){y[y == target.y] <- target.y - 1}
x <- x - target.x
y <- target.y - y
x[x <= 0] <- 0
y[y <= 0] <- 0
x[x > 0] <- x[x > 0] ^ degree.x
y[y > 0] <- y[y > 0] ^ degree.y
return(x %*% y / length(x))
}
D.LPM <- Vectorize(D.LPM, vectorize.args = c('target.x', 'target.y'))

#' Divergent-Upper Partial Moment
#'
#' This function generates a divergent upper partial moment between two equal length variables for any degree or target.
#' @param degree.x integer; Degree for variable X.  \code{(degree.x = 0)} is frequency, \code{(degree.x = 1)} is area.
#' @param degree.y integer; Degree for variable Y.  \code{(degree.y = 0)} is frequency, \code{(degree.y = 1)} is area.
#' @param x a numeric vector.
#' @param y a numeric vector of equal length to \code{x}.
#' @param target.x numeric; Typically the mean of Variable X for classical statistics equivalences, but does not have to be. (Vectorized)
#' @param target.y numeric; Typically the mean of Variable Y for classical statistics equivalences, but does not have to be. (Vectorized)
#' @return Divergent UPM of two variables
#' @author Fred Viole, OVVO Financial Systems
#' @references Viole, F. and Nawrocki, D. (2013) "Nonlinear Nonparametric Statistics: Using Partial Moments"
#' \url{https://www.amazon.com/dp/1490523995}
#' @examples
#' set.seed(123)
#' x <- rnorm(100) ; y <- rnorm(100)
#' D.UPM(0, 0, x, y, mean(x), mean(y))
#' @export

D.UPM <- function(degree.x, degree.y, x, y, target.x = mean(x), target.y = mean(y)){
if(length(x)>1){
z <- cbind(x,y); z <- z[complete.cases(z),]
x <- z[,1]
y <- z[,2]
}
if(degree.x == 0){x[x == target.x] <- target.x - 1}
if(degree.y == 0){y[y == target.y] <- target.y - 1}
x <- target.x - x
y <- y - target.y
x[x <= 0] <- 0
y[y <= 0] <- 0
x[x > 0] <- x[x > 0] ^ degree.x
y[y > 0] <- y[y > 0] ^ degree.y
return(x %*% y / length(x))
}
D.UPM <- Vectorize(D.UPM, vectorize.args = c('target.x', 'target.y'))

#' Partial Moment Matrix
#'
#'
#' This function generates a co-partial moment matrix for the specified co-partial moment.
#' @param LPM.degree integer; Degree for \code{variable} below \code{target} deviations.  \code{(degree = 0)} is frequency, \code{(degree = 1)} is area.
#' @param UPM.degree integer; Degree for \code{variable} above \code{target} deviations.  \code{(degree = 0)} is frequency, \code{(degree = 1)} is area.
#' @param target numeric; Typically the mean of Variable X for classical statistics equivalences, but does not have to be. (Vectorized)  \code{(target = "mean")} (default) will set the target as the mean of every variable.
#' @param variable a numeric matrix or data.frame.
#' @param pop.adj logical; \code{FALSE} (default) Adjusts the sample co-partial moment matrices for population statistics.
#' @return Matrix of partial moment quadrant values (CUPM, DUPM, DLPM, CLPM), and overall covariance matrix.  Uncalled quadrants will return a matrix of zeros.
#' @note For divergent asymmetical \code{"D.LPM" and "D.UPM"} matrices, matrix is \code{D.LPM(column,row,...)}.
#' @author Fred Viole, OVVO Financial Systems
#' @references Viole, F. and Nawrocki, D. (2013) "Nonlinear Nonparametric Statistics: Using Partial Moments"
#' \url{https://www.amazon.com/dp/1490523995}
#' @references Viole, F. (2017) "Bayes' Theorem From Partial Moments"
#' \url{https://ssrn.com/abstract=3457377}
#' @examples
#' set.seed(123)
#' x <- rnorm(100) ; y <- rnorm(100) ; z <- rnorm(100)
#' A <- cbind(x,y,z)
#' PM.matrix(LPM.degree = 1, UPM.degree = 1, target = "mean", variable = A)
#'
#' ## Use of vectorized numeric targets (target_x, target_y, target_z)
#' PM.matrix(LPM.degree = 1, UPM.degree = 1, target = c(0, 0.15, .25), variable = A)
#'
#' ## Calling Individual Partial Moment Quadrants
#' cov.mtx <- PM.matrix(LPM.degree = 1, UPM.degree = 1, target = "mean", variable = A)
#' cov.mtx\$cupm
#'
#' ## Full covariance matrix
#' cov.mtx\$cov.matrix
#' @export

PM.matrix <- function(LPM.degree, UPM.degree, target = "mean", variable, pop.adj=FALSE){

n <- ncol(variable)
if(is.null(n)){stop("supply a matrix-like 'variable'")}

clpms <- list()
cupms <- list()
dlpms <- list()
dupms <- list()

for(i in 1 : n){
if(is.numeric(target)){
clpms[[i]] <- sapply(1 : n, function(b) Co.LPM(x = variable[ , i], y = variable[ , b], degree.x = LPM.degree, degree.y = LPM.degree, target.x = target[i], target.y = target[b]))

cupms[[i]] <- sapply(1 : n, function(b) Co.UPM(x = variable[ , i], y = variable[ , b], degree.x = UPM.degree, degree.y = UPM.degree, target.x = target[i], target.y = target[b]))

dlpms[[i]] <- sapply(1 : n, function(b) D.LPM(x = variable[ , i], y = variable[ , b], degree.x = UPM.degree, degree.y = LPM.degree, target.x = target[i], target.y = target[b]))

dupms[[i]] <- sapply(1 : n, function(b) D.UPM(x = variable[ , i], y = variable[ , b], degree.x = LPM.degree, degree.y = UPM.degree, target.x = target[i], target.y = target[b]))

} else {
clpms[[i]] <- sapply(1 : n, function(b) Co.LPM(x = variable[ , i], y = variable[ , b], degree.x = LPM.degree, degree.y = LPM.degree, target.x = mean(variable[ , i]), target.y = mean(variable[ , b])))

cupms[[i]] <- sapply(1 : n, function(b) Co.UPM(x = variable[ , i], y = variable[ , b], degree.x = UPM.degree, degree.y = UPM.degree, target.x = mean(variable[ , i]), target.y = mean(variable[ , b])))

dlpms[[i]] <- sapply(1 : n, function(b) D.LPM(x = variable[ , i], y = variable[ , b], degree.x = UPM.degree, degree.y = LPM.degree, target.x = mean(variable[ , i]), target.y = mean(variable[ , b])))

dupms[[i]] <- sapply(1 : n, function(b) D.UPM(x = variable[ , i], y = variable[ , b], degree.x = LPM.degree, degree.y = UPM.degree, target.x = mean(variable[ , i]), target.y = mean(variable[ , b])))
}
}

clpm.matrix <- matrix(unlist(clpms), n, n)
colnames(clpm.matrix) <- colnames(variable)
rownames(clpm.matrix) <- colnames(variable)

cupm.matrix <- matrix(unlist(cupms), n, n)
colnames(cupm.matrix) <- colnames(variable)
rownames(cupm.matrix) <- colnames(variable)

dlpm.matrix <- matrix(unlist(dlpms), n, n)
diag(dlpm.matrix) <- 0
colnames(dlpm.matrix) <- colnames(variable)
rownames(dlpm.matrix) <- colnames(variable)

dupm.matrix <- matrix(unlist(dupms), n, n)
diag(dupm.matrix) <- 0
colnames(dupm.matrix) <- colnames(variable)
rownames(dupm.matrix) <- colnames(variable)

adjustment <- length(variable[ , 1]) / (length(variable[ , 1]) - 1)
}

cov.matrix <- cupm.matrix + clpm.matrix - dupm.matrix - dlpm.matrix

return(list(cupm = cupm.matrix,
dupm = dupm.matrix,
dlpm = dlpm.matrix,
clpm = clpm.matrix,
cov.matrix = cov.matrix
))
}

#' Lower Partial Moment RATIO
#'
#' This function generates a standardized univariate lower partial moment for any degree or target.
#' @param degree integer; \code{(degree = 0)} is frequency, \code{(degree = 1)} is area.
#' @param target numeric; Typically set to mean, but does not have to be. (Vectorized)
#' @param variable a numeric vector.
#' @return Standardized LPM of variable
#' @author Fred Viole, OVVO Financial Systems
#' @references Viole, F. and Nawrocki, D. (2013) "Nonlinear Nonparametric Statistics: Using Partial Moments"
#' \url{https://www.amazon.com/dp/1490523995}
#' @references Viole, F. (2017) "Continuous CDFs and ANOVA with NNS"
#' \url{https://ssrn.com/abstract=3007373}
#' @examples
#' set.seed(123)
#' x <- rnorm(100)
#' LPM.ratio(0, mean(x), x)
#'
#' \dontrun{
#' ## Empirical CDF (degree = 0)
#' lpm_cdf <- LPM.ratio(0, sort(x), x)
#' plot(sort(x), lpm_cdf)
#'
#' ## Continuous CDF (degree = 1)
#' lpm_cdf_1 <- LPM.ratio(1, sort(x), x)
#' plot(sort(x), lpm_cdf_1)
#'
#' ## Joint CDF
#' x <- rnorm(5000) ; y <- rnorm(5000)
#' plot3d(x, y, Co.LPM(0, 0, sort(x), sort(y), x, y), col = "blue", xlab = "X", ylab = "Y",
#' zlab = "Probability", box = FALSE)
#' }
#' @export

LPM.ratio <- function(degree, target, variable){
lpm <- LPM(degree, target, variable)

if(degree > 0){
upm <- UPM(degree, target, variable)
return(lpm / (lpm + upm))
} else {
return(lpm)
}
}

#' Upper Partial Moment RATIO
#'
#' This function generates a standardized univariate upper partial moment for any degree or target.
#' @param degree integer; \code{(degree = 0)} is frequency, \code{(degree = 1)} is area.
#' @param target numeric; Typically set to mean, but does not have to be. (Vectorized)
#' @param variable a numeric vector.
#' @return Standardized UPM of variable
#' @author Fred Viole, OVVO Financial Systems
#' @references Viole, F. and Nawrocki, D. (2013) "Nonlinear Nonparametric Statistics: Using Partial Moments"
#' \url{https://www.amazon.com/dp/1490523995}
#' @examples
#' set.seed(123)
#' x <- rnorm(100)
#' UPM.ratio(0, mean(x), x)
#'
#' ## Joint Upper CDF
#' \dontrun{
#' x <- rnorm(5000) ; y <- rnorm(5000)
#' plot3d(x, y, Co.UPM(0, 0, sort(x), sort(y), x, y), col = "blue", xlab = "X", ylab = "Y",
#' zlab = "Probability", box = FALSE)
#' }
#' @export

UPM.ratio <- function(degree, target, variable){
upm <- UPM(degree, target, variable)

if(degree > 0){
lpm <- LPM(degree, target, variable)
return(upm / (lpm + upm))
} else {
return(upm)
}
}

#' NNS PDF
#'
#' This function generates an empirical PDF using continuous CDFs from \link{LPM.ratio}.
#'
#' @param variable a numeric vector.
#' @param degree integer; \code{(degree = 0)} is frequency, \code{(degree = 1)} (default) is area.
#' @param target a numeric range of values [a,b] where a < b.  \code{NULL} (default) uses the \code{variable} observations.
#' @param bins numeric; \code{NULL} (default) Selects number of observations as default bins.
#' @param plot logical; plots PDF.
#' @return Returns a data.table containing the intervals used and resulting PDF of the variable.
#' @author Fred Viole, OVVO Financial Systems
#' @references Viole, F. and Nawrocki, D. (2013) "Nonlinear Nonparametric Statistics: Using Partial Moments"
#' \url{https://www.amazon.com/dp/1490523995}
#' @examples
#' set.seed(123)
#' x <- rnorm(100)
#' NNS.PDF(x)
#'
#' ## Custom target range
#' NNS.PDF(x, target = c(-5, 5))
#' @export

NNS.PDF <- function(variable, degree = 1, target = NULL, bins = NULL, plot = TRUE){

if(is.null(target)){target <- sort(variable)}

# d/dx approximation
if(is.null(bins)){bins <- length(variable)}

d.dx <- (abs(max(target)) + abs(min(target))) / bins
tgt <- seq(min(target), max(target), d.dx)
PDF <- abs((diff(LPM.ratio(degree, tgt, variable),2)))

Intervals <- (sort(tgt)+(d.dx/2))[1:length(PDF)]

if(plot){plot(Intervals, PDF, col = 'steelblue', type = 'l', lwd = 3, xlab = "X")}

return(data.table(cbind("Intervals" = Intervals, PDF)))
}
```
OVVO-Financial/NNS documentation built on March 21, 2020, 4:36 p.m.