Skip to content

Commit

Permalink
NNS 10.9.4 Beta
Browse files Browse the repository at this point in the history
  • Loading branch information
OVVO-Financial committed Dec 2, 2024
1 parent 271abc4 commit ce05056
Show file tree
Hide file tree
Showing 36 changed files with 272 additions and 253 deletions.
4 changes: 2 additions & 2 deletions DESCRIPTION
View file
Original file line number Diff line number Diff line change
@@ -1,8 +1,8 @@
Package: NNS
Type: Package
Title: Nonlinear Nonparametric Statistics
Version: 10.9.3
Date: 2024-10-14
Version: 10.9.4
Date: 2024-12-02
Authors@R: c(
person("Fred", "Viole", role=c("aut","cre"), email="ovvo.financial.systems@gmail.com"),
person("Roberto", "Spadim", role=c("ctb"))
Expand Down
Binary file removed NNS_10.9.3.tar.gz
View file
Binary file not shown.
Binary file removed NNS_10.9.3.zip
View file
Binary file not shown.
Binary file added NNS_10.9.4.tar.gz
View file
Binary file not shown.
Binary file added NNS_10.9.4.zip
View file
Binary file not shown.
8 changes: 5 additions & 3 deletions R/NNS_MC.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -9,7 +9,8 @@
#' @param by numeric; \code{.01} default will set the \code{by} argument in \code{seq(-1, 1, step)}.
#' @param exp numeric; \code{1} default will exponentially weight maximum rho value if \code{exp > 1}. Shrinks values towards \code{upper_rho}.
#' @param type options("spearman", "pearson", "NNScor", "NNSdep"); \code{type = "spearman"}(default) dependence metric desired.
#' @param drift logical; \code{TRUE} default preserves the drift of the original series.
#' @param drift logical; \code{drift = TRUE} (default) preserves the drift of the original series.
#' @param target_drift numerical; code{NULL} (default) Specifies the desired drift when \code{drift = TRUE}, i.e. a risk-free rate of return.
#' @param xmin numeric; the lower limit for the left tail.
#' @param xmax numeric; the upper limit for the right tail.
#' @param ... possible additional arguments to be passed to \link{NNS.meboot}.
Expand Down Expand Up @@ -38,6 +39,7 @@ NNS.MC <- function(x,
exp = 1,
type = "spearman",
drift = TRUE,
target_drift = NULL,
xmin = NULL,
xmax = NULL, ...){

Expand All @@ -51,8 +53,8 @@ NNS.MC <- function(x,
exp_rhos <- rev(c((neg_rhos^exp)*-1, pos_rhos^(1/exp)))


samples <- suppressWarnings(NNS.meboot(x = x, reps = reps, rho = exp_rhos, type = type, drift = drift,
xmin = xmin, xmax = xmax, ...))
samples <- suppressWarnings(NNS.meboot(x = x, reps = reps, rho = exp_rhos, type = type,
drift = drift, target_drift = target_drift, xmin = xmin, xmax = xmax, ...))

replicates <- samples["replicates",]

Expand Down
107 changes: 58 additions & 49 deletions R/NNS_meboot.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -6,14 +6,15 @@
#' @param reps numeric; number of replicates to generate.
#' @param rho numeric [-1,1] (vectorized); A \code{rho} must be provided, otherwise a blank list will be returned.
#' @param type options("spearman", "pearson", "NNScor", "NNSdep"); \code{type = "spearman"}(default) dependence metric desired.
#' @param drift logical; \code{TRUE} default preserves the drift of the original series.
#' @param trim numeric [0,1]; The mean trimming proportion, defaults to \code{trim=0.1}.
#' @param drift logical; \code{drift = TRUE} (default) preserves the drift of the original series.
#' @param target_drift numerical; code{NULL} (default) Specifies the desired drift when \code{drift = TRUE}, i.e. a risk-free rate of return.
#' @param trim numeric [0,1]; The mean trimming proportion, defaults to \code{trim = 0.1}.
#' @param xmin numeric; the lower limit for the left tail.
#' @param xmax numeric; the upper limit for the right tail.
#' @param reachbnd logical; If \code{TRUE} potentially reached bounds (xmin = smallest value - trimmed mean and
#' xmax = largest value + trimmed mean) are given when the random draw happens to be equal to 0 and 1, respectively.
#' @param expand.sd logical; If \code{TRUE} the standard deviation in the ensemble is expanded. See \code{expand.sd} in meboot::meboot.
#' @param force.clt logical; If \code{TRUE} the ensemble is forced to satisfy the central limit theorem. See \code{force.clt} in meboot::meboot.
#' @param expand.sd logical; If \code{TRUE} the standard deviation in the ensemble is expanded. See \code{expand.sd} in \code{meboot::meboot}.
#' @param force.clt logical; If \code{TRUE} the ensemble is forced to satisfy the central limit theorem. See \code{force.clt} in \code{meboot::meboot}.
#' @param scl.adjustment logical; If \code{TRUE} scale adjustment is performed to ensure that the population variance of the transformed series equals the variance of the data.
#' @param sym logical; If \code{TRUE} an adjustment is performed to ensure that the ME density is symmetric.
#' @param elaps logical; If \code{TRUE} elapsed time during computations is displayed.
Expand Down Expand Up @@ -59,27 +60,28 @@
#' boots <- NNS.meboot(AirPassengers, reps=100, rho = 0, xmin = 0)
#'
#' # Verify correlation of replicates ensemble to original
#' cor(boots["ensemble",], AirPassengers, method = "spearman")
#' cor(boots["ensemble",]$ensemble, AirPassengers, method = "spearman")
#'
#' # Plot all replicates
#' matplot(boots["replicates",] , type = 'l')
#' matplot(boots["replicates",]$replicates , type = 'l')
#'
#' # Plot ensemble
#' lines(boots["ensemble",], lwd = 3)
#' lines(boots["ensemble",]$ensemble, lwd = 3)
#' }
#' @export

NNS.meboot <- function(x,
reps=999,
rho=NULL,
type="spearman",
drift=TRUE,
trim=0.10,
xmin=NULL,
xmax=NULL,
reachbnd=TRUE,
expand.sd=TRUE, force.clt=TRUE,
scl.adjustment = FALSE, sym = FALSE, elaps=FALSE,
reps = 999,
rho = NULL,
type = "spearman",
drift = TRUE,
target_drift = NULL,
trim = 0.10,
xmin = NULL,
xmax = NULL,
reachbnd = TRUE,
expand.sd = TRUE, force.clt = TRUE,
scl.adjustment = FALSE, sym = FALSE, elaps = FALSE,
digits = 6,
colsubj, coldata, coltimes,...)
{
Expand Down Expand Up @@ -206,47 +208,48 @@
m <- c(matrix2)
l <- length(e)

func <- function(ab, d=drift, ty=type){
func <- function(ab, d = drift, ty = type) {
a <- ab[1]
b <- ab[2]

if(ty=="spearman" || ty=="pearson"){
ifelse(d,
(abs(cor((a*m + b*e)/(a + b), e, method = ty) - rho) +
abs(mean((a*m + b*e))/mean(e) - 1) +
abs( cor((a*m + b*e)/(a + b), 1:l) - cor(e, 1:l))
),
abs(cor((a*m + b*e)/(a + b), e, method = ty) - rho) +
abs(mean((a*m + b*e))/mean(e) - 1)
)

# Compute the adjusted ensemble
combined <- (a * m + b * e) / (a + b)

# Check correlation or dependence structure
if (ty == "spearman" || ty == "pearson") {
error <- abs(cor(combined, e, method = ty) - rho)
} else if (ty == "nnsdep") {
error <- abs(NNS.dep(combined, e)$Dependence - rho)
} else {
if(ty=="nnsdep"){
ifelse(d,
(abs(NNS.dep((a*m + b*e)/(a + b), e)$Dependence - rho) +
abs(mean((a*m + b*e))/mean(e) - 1) +
abs( NNS.dep((a*m + b*e)/(a + b), 1:l)$Dependence - NNS.dep(e, 1:l)$Dependence)
),
abs(NNS.dep((a*m + b*e)/(a + b), e)$Dependence - rho) +
abs(mean((a*m + b*e))/mean(e) - 1)
)
} else {
ifelse(d,
(abs(NNS.dep((a*m + b*e)/(a + b), e)$Correlation - rho) +
abs(mean((a*m + b*e))/mean(e) - 1) +
abs( NNS.dep((a*m + b*e)/(a + b), 1:l)$Correlation - NNS.dep(e, 1:l)$Correlation)
),
abs(NNS.dep((a*m + b*e)/(a + b), e)$Correlation - rho) +
abs(mean((a*m + b*e))/mean(e) - 1)
)
}
error <- abs(NNS.dep(combined, e)$Correlation - rho)
}

return(error)
}


res <- optim(c(.01,.01), func, control=list(abstol = .01))

ensemble <- (res$par[1]*matrix2 + res$par[2]*ensemble) / (sum(abs(res$par)))


# Drift
orig_coef <- fast_lm(1:n, x)$coef
orig_intercept <- orig_coef[1]
orig_drift <- orig_coef[2]

new_coef <- apply(ensemble, 2, function(i) fast_lm(1:n, i)$coef)
slopes <- new_coef[2,]

if(drift){
if(is.null(target_drift)) new_slopes <- (orig_drift - slopes) else new_slopes <- (target_drift - slopes)
ensemble <- ensemble + t(t(sapply(new_slopes, function(slope) cumsum(rep(slope, n)))))

new_intercepts <- orig_intercept - new_coef[1,]
ensemble <- sweep(ensemble, 2, new_intercepts, FUN = "+")
}



if(identical(ordxx_2, ordxx)){
if(reps>1) ensemble <- t(apply(ensemble, 1, function(x) sample(x, size = reps, replace = TRUE)))
Expand All @@ -257,6 +260,8 @@
if(expand.sd) ensemble <- NNS.meboot.expand.sd(x=x, ensemble=ensemble, ...)

if(force.clt && reps > 1) ensemble <- force.clt(x=x, ensemble=ensemble)



# scale adjustment

Expand All @@ -279,6 +284,9 @@
# Force min / max values
if(!is.null(trim[[2]])) ensemble <- apply(ensemble, 2, function(z) pmax(trim[[2]], z))
if(!is.null(trim[[3]])) ensemble <- apply(ensemble, 2, function(z) pmin(trim[[3]], z))




if(is.ts(x)){
ensemble <- ts(ensemble, frequency=frequency(x), start=start(x))
Expand All @@ -287,7 +295,8 @@
if(reps>1) dimnames(ensemble)[[2]] <- paste("Replicate", 1:reps)
}




final <- list(x=x, replicates=round(ensemble, digits = digits), ensemble=Rfast::rowmeans(ensemble), xx=xx, z=z, dv=dv, dvtrim=dvtrim, xmin=xmin,
xmax=xmax, desintxb=desintxb, ordxx=ordxx, kappa = kappa)

Expand Down
2 changes: 1 addition & 1 deletion R/Normalization.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -14,7 +14,7 @@
#' @examples
#' \dontrun{
#' set.seed(123)
#' x <- rnorm(100) ; y<-rnorm(100)
#' x <- rnorm(100) ; y <- rnorm(100)
#' A <- cbind(x, y)
#' NNS.norm(A)
#'
Expand Down
33 changes: 11 additions & 22 deletions R/RcppExports.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -18,8 +18,7 @@ fast_lm_mult <- function(x, y) {
#' @param variable a numeric vector. \link{data.frame} or \link{list} type objects are not permissible.
#' @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/ref=cm_sw_su_dp}
#' @references Viole, F. and Nawrocki, D. (2013) "Nonlinear Nonparametric Statistics: Using Partial Moments" (ISBN: 1490523995)
#' @examples
#' set.seed(123)
#' x <- rnorm(100)
Expand All @@ -37,8 +36,7 @@ LPM <- function(degree, target, variable) {
#' @param variable a numeric vector. \link{data.frame} or \link{list} type objects are not permissible.
#' @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/ref=cm_sw_su_dp}
#' @references Viole, F. and Nawrocki, D. (2013) "Nonlinear Nonparametric Statistics: Using Partial Moments" (ISBN: 1490523995)
#' @examples
#' set.seed(123)
#' x <- rnorm(100)
Expand All @@ -56,10 +54,8 @@ UPM <- function(degree, target, variable) {
#' @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/ref=cm_sw_su_dp}
#' @references Viole, F. (2017) "Continuous CDFs and ANOVA with NNS"
#' \url{https://www.ssrn.com/abstract=3007373}
#' @references Viole, F. and Nawrocki, D. (2013) "Nonlinear Nonparametric Statistics: Using Partial Moments" (ISBN: 1490523995)
#' @references Viole, F. (2017) "Continuous CDFs and ANOVA with NNS" \doi{10.2139/ssrn.3007373}
#' @examples
#' set.seed(123)
#' x <- rnorm(100)
Expand Down Expand Up @@ -92,8 +88,7 @@ LPM.ratio <- function(degree, target, variable) {
#' @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/ref=cm_sw_su_dp}
#' @references Viole, F. and Nawrocki, D. (2013) "Nonlinear Nonparametric Statistics: Using Partial Moments" (ISBN: 1490523995)
#' @examples
#' set.seed(123)
#' x <- rnorm(100)
Expand Down Expand Up @@ -121,8 +116,7 @@ UPM.ratio <- function(degree, target, variable) {
#' @param target_y numeric; Target for lower deviations of variable Y. Typically the mean of Variable Y for classical statistics equivalences, but does not have to be.
#' @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/ref=cm_sw_su_dp}
#' @references Viole, F. and Nawrocki, D. (2013) "Nonlinear Nonparametric Statistics: Using Partial Moments" (ISBN: 1490523995)
#' @examples
#' set.seed(123)
#' x <- rnorm(100) ; y <- rnorm(100)
Expand All @@ -143,8 +137,7 @@ Co.LPM <- function(degree_lpm, x, y, target_x, target_y) {
#' @param target_y numeric; Target for upside deviations of variable Y. Typically the mean of Variable Y for classical statistics equivalences, but does not have to be.
#' @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/ref=cm_sw_su_dp}
#' @references Viole, F. and Nawrocki, D. (2013) "Nonlinear Nonparametric Statistics: Using Partial Moments" (ISBN: 1490523995)
#' @examples
#' set.seed(123)
#' x <- rnorm(100) ; y <- rnorm(100)
Expand All @@ -166,8 +159,7 @@ Co.UPM <- function(degree_upm, x, y, target_x, target_y) {
#' @param target_y numeric; Target for lower deviations of variable Y. Typically the mean of Variable Y for classical statistics equivalences, but does not have to be.
#' @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/ref=cm_sw_su_dp}
#' @references Viole, F. and Nawrocki, D. (2013) "Nonlinear Nonparametric Statistics: Using Partial Moments" (ISBN: 1490523995)
#' @examples
#' set.seed(123)
#' x <- rnorm(100) ; y <- rnorm(100)
Expand All @@ -189,8 +181,7 @@ D.LPM <- function(degree_lpm, degree_upm, x, y, target_x, target_y) {
#' @param target_y numeric; Target for upper deviations of variable Y. Typically the mean of Variable Y for classical statistics equivalences, but does not have to be.
#' @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/ref=cm_sw_su_dp}
#' @references Viole, F. and Nawrocki, D. (2013) "Nonlinear Nonparametric Statistics: Using Partial Moments" (ISBN: 1490523995)
#' @examples
#' set.seed(123)
#' x <- rnorm(100) ; y <- rnorm(100)
Expand All @@ -212,10 +203,8 @@ D.UPM <- function(degree_lpm, degree_upm, x, y, target_x, target_y) {
#' @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/ref=cm_sw_su_dp}
#' @references Viole, F. (2017) "Bayes' Theorem From Partial Moments"
#' \url{https://www.ssrn.com/abstract=3457377}
#' @references Viole, F. and Nawrocki, D. (2013) "Nonlinear Nonparametric Statistics: Using Partial Moments" (ISBN: 1490523995)
#' @references Viole, F. (2017) "Bayes' Theorem From Partial Moments" \doi{10.2139/ssrn.3457377}
#' @examples
#' set.seed(123)
#' x <- rnorm(100) ; y <- rnorm(100) ; z <- rnorm(100)
Expand Down
4 changes: 2 additions & 2 deletions README.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,7 +3,7 @@



[![packageversion](https://img.shields.io/badge/NNS%20version-10.9.3-blue.svg?style=flat-square)](https://github.com/OVVO-Financial/NNS/commits/NNS-Beta-Version) [![Licence](https://img.shields.io/badge/licence-GPL--3-blue.svg)](https://www.gnu.org/licenses/gpl-3.0.en.html)
[![packageversion](https://img.shields.io/badge/NNS%20version-10.9.4-blue.svg?style=flat-square)](https://github.com/OVVO-Financial/NNS/commits/NNS-Beta-Version) [![Licence](https://img.shields.io/badge/licence-GPL--3-blue.svg)](https://www.gnu.org/licenses/gpl-3.0.en.html)

<h2 style="margin: 0; padding: 0; border: none; height: 40px;"></h2>

Expand Down Expand Up @@ -59,7 +59,7 @@ Please see https://github.com/OVVO-Financial/NNS/blob/NNS-Beta-Version/examples/
title = {NNS: Nonlinear Nonparametric Statistics},
author = {Fred Viole},
year = {2016},
note = {R package version 10.9.3},
note = {R package version 10.9.4},
url = {https://CRAN.R-project.org/package=NNS},
}
```
Expand Down
30 changes: 15 additions & 15 deletions doc/NNSvignette_Sampling.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -149,7 +149,7 @@ legend('left', legend = c('ecdf', 'LPM.ratio'), fill=c('black','red'), border=NA
# sapply(boots, function(r) cor(r, x, method = "spearman"))
#
# rho = 1 rho = 0.5 rho = -0.5 rho = -1
# 1.0000000 0.4988059 -0.4995740 -0.9982358
# 1.0000000 0.4989619 -0.4984818 -0.9779778

## ----multisim, eval=FALSE-----------------------------------------------------
# set.seed(123)
Expand All @@ -171,8 +171,8 @@ legend('left', legend = c('ecdf', 'LPM.ratio'), fill=c('black','red'), border=NA
# NNS.copula(original.data)
# NNS.copula(new.dep.data)
#
# [1] 0.4379469
# [1] 0.4390599
# [1] 0.4353849
# [1] 0.4357026

## ----eval=FALSE---------------------------------------------------------------
# head(original.data)
Expand Down Expand Up @@ -206,17 +206,17 @@ legend('left', legend = c('ecdf', 'LPM.ratio'), fill=c('black','red'), border=NA
## ----eval=FALSE---------------------------------------------------------------
# for(i in 1:4) print(cor(new.boot.dep.matrix[,i], original.data[,i], method = "spearman"))
#
# [1] 0.9453275
# [1] 0.9523726
# [1] 0.9498499
# [1] 0.9524516
# [1] 0.9432899
# [1] 0.9460947
# [1] 0.9442031
# [1] 0.9423242

## ----eval=FALSE---------------------------------------------------------------
# NNS.copula(original.data)
# NNS.copula(new.boot.dep.matrix)
#
# [1] 0.4379469
# [1] 0.4302545
# [1] 0.4353849
# [1] 0.4263725

## ----eval=FALSE---------------------------------------------------------------
# head(original.data)
Expand All @@ -230,12 +230,12 @@ legend('left', legend = c('ecdf', 'LPM.ratio'), fill=c('black','red'), border=NA
# [5,] 0.12928774 -2.54934277 0.1741359 0.12928774
# [6,] 1.71506499 1.04057346 -0.6152683 1.71506499
# x y z x
# ensemble1 -0.4667731 -0.8418413 -0.6139059 -0.4708890
# ensemble2 -0.2333747 -1.0908710 0.3748315 -0.2711240
# ensemble3 1.4799734 0.2893831 -0.3851513 1.3645317
# ensemble4 0.1751654 0.2995113 1.1342461 0.1486429
# ensemble5 0.4128802 -2.9789634 -0.1141124 0.3846150
# ensemble6 1.5592660 1.1800553 -0.5285532 1.5041917
# ensemble1 -0.4268047 -0.7794553 -0.6364458 -0.4642642
# ensemble2 -0.2965744 -1.0682197 0.3297265 -0.2531178
# ensemble3 1.3302149 0.3054734 -0.4014515 1.4914884
# ensemble4 0.2257378 0.3108846 1.0603892 0.1728540
# ensemble5 0.4716743 -3.3344967 -0.1917697 0.4309379
# ensemble6 1.3984978 1.1881374 -0.5295386 1.5326055

## ----threads, echo = FALSE----------------------------------------------------
Sys.setenv("OMP_THREAD_LIMIT" = "")
Expand Down
Loading

0 comments on commit ce05056

Please sign in to comment.