NNS 11.3 Beta

Author: OVVO-Financial

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: NNS
 Type: Package
 Title: Nonlinear Nonparametric Statistics
-Version: 11.2
-Date: 2025-03-23
+Version: 11.3
+Date: 2025-03-28
 Authors@R: c(
   person("Fred", "Viole", role=c("aut","cre"), email="[email protected]"),
   person("Roberto", "Spadim", role=c("ctb"))

NNS_11.2.tar.gz

@@ -139,10 +139,10 @@ NNS.gravity <- function (x, discrete = FALSE)
 #'   - For \code{method = "riskneutral"}: the risk-free rate \( r \) (e.g., 0.05), used with \( T \) to adjust the mean.
 #' @param method character; scaling method: \code{"minmax"} (default) for min-max scaling, or \code{"riskneutral"} for risk-neutral adjustment.
 #' @param T numeric; time to maturity in years (required for \code{method = "riskneutral"}, ignored otherwise; e.g., 1). Default is NULL.
-#' @param type character; for \code{method = "riskneutral"}: \code{"Terminal"} (default, mean = \( S_0 e^{r T} \)) or \code{"Discounted"} (mean = \( S_0 \)).
+#' @param type character; for \code{method = "riskneutral"}: \code{"Terminal"} (default) or \code{"Discounted"} (mean = \( S_0 \)).
 #' @return Returns a rescaled distribution:
 #'   - For \code{"minmax"}: values scaled linearly to the range \code{[a, b]}.
-#'   - For \code{"riskneutral"}: values scaled multiplicatively to a risk-neutral mean (\( S_0 e^{r T} \) if \code{type = "Terminal"}, or \( S_0 \) if \code{type = "Discounted"}).
+#'   - For \code{"riskneutral"}: values scaled multiplicatively to a risk-neutral mean (\( S_0 e^(rT) \) if \code{type = "Terminal"}, or \( S_0 \) if \code{type = "Discounted"}).
 #' @author Fred Viole, OVVO Financial Systems
 #' @examples
 #' \dontrun{
@@ -151,11 +151,11 @@ NNS.gravity <- function (x, discrete = FALSE)
 #' x <- rnorm(100)
 #' NNS.rescale(x, a = 5, b = 10, method = "minmax")  # Scales to [5, 10]
 #' 
-#' # Risk-neutral scaling (Terminal): a = S_0, b = r  # Mean ≈ 105.13
+#' # Risk-neutral scaling (Terminal): a = S_0, b = r  # Mean approx 105.13
 #' prices <- 100 * exp(cumsum(rnorm(100, 0.001, 0.02)))
 #' NNS.rescale(prices, a = 100, b = 0.05, method = "riskneutral", T = 1, type = "Terminal")
 #' 
-#' # Risk-neutral scaling (Discounted): a = S_0, b = r  # Mean ≈ 100
+#' # Risk-neutral scaling (Discounted): a = S_0, b = r  # Mean approx 100
 #' NNS.rescale(prices, a = 100, b = 0.05, method = "riskneutral", T = 1, type = "Discounted")
 #' }
 #' @export

NNS_11.2.zip

@@ -42,41 +42,38 @@
 
 
 NNS.CDF <- function(variable, degree = 0, target = NULL, type = "CDF", plot = TRUE){
-  
-  if(any(class(variable)%in%c("tbl","data.table")) && dim(variable)[2]==1){ 
+  if(any(class(variable) %in% c("tbl", "data.table")) && dim(variable)[2] == 1){ 
     variable <- as.vector(unlist(variable))
   }
-  if(any(class(variable)%in%c("tbl","data.table"))){
+  if(any(class(variable) %in% c("tbl", "data.table"))){
     variable <- as.data.frame(variable)
   }
 
   if(!is.null(target)){
-    if(is.null(dim(variable)) || dim(variable)[2]==1){
-      if(target<min(variable) || target>max(variable)){
+    if(is.null(dim(variable)) || dim(variable)[2] == 1){
+      if(target < min(variable) || target > max(variable)){
         stop("Please make sure target is within the observed values of variable.")
       }
     } else {
-      if(target[1]<min(variable[,1]) || target[1]>max(variable[,1])){
+      if(target[1] < min(variable[,1]) || target[1] > max(variable[,1])){
         stop("Please make sure target 1 is within the observed values of variable 1.")
       }
-      if(target[2]<min(variable[,2]) || target[2]>max(variable[,2])){
+      if(target[2] < min(variable[,2]) || target[2] > max(variable[,2])){
         stop("Please make sure target 2 is within the observed values of variable 2.")
       }
     }
   }
+  
   type <- tolower(type)
-  if(!(type%in%c("cdf","survival", "hazard", "cumulative hazard"))){
+  if(!(type %in% c("cdf", "survival", "hazard", "cumulative hazard"))){
     stop(paste("Please select a type from: ", "`CDF`, ", "`survival`, ",  "`hazard`, ", "`cumulative hazard`"))
   }
+  
+  # Univariate Case
   if(is.null(dim(variable)) || dim(variable)[2] == 1){
     overall_target <- sort(variable)
     x <- overall_target
-    if(degree > 0){
-      CDF <- LPM.ratio(degree, overall_target, variable)
-    } else {
-      cdf_fun <- ecdf(x)
-      CDF <- cdf_fun(overall_target)
-    }
+    CDF <- LPM.ratio(degree, overall_target, variable)
     values <- cbind.data.frame(sort(variable), CDF)
     colnames(values) <- c(deparse(substitute(variable)), "CDF")
     if(!is.null(target)){
@@ -88,106 +85,177 @@ NNS.CDF <- function(variable, degree = 0, target = NULL, type = "CDF", plot = TR
     if(type == "survival"){
       CDF <- 1 - CDF
       P <- 1 - P
-    }else if(type == "hazard"){
-      CDF <- exp(log(density(x, n = length(x))$y)-log(1-CDF))
+      ylabel <- "S(x)"
+    } else if(type == "hazard"){
+      n <- length(x)
+      window <- min(10, n-1)
+      f_proxy <- numeric(n)
+      for(i in 1:n){
+        start <- max(1, i - window %/% 2)
+        end <- min(n, i + window %/% 2)
+        dx <- x[end] - x[start]
+        f_proxy[i] <- (CDF[end] - CDF[start]) / dx
+      }
+      f_proxy <- pmax(f_proxy, 1e-10)
+      reg_fit <- NNS.reg(x, f_proxy, order = NULL, n.best = 1, point.est = if(!is.null(target)) target else NULL, plot = FALSE)
+      dens <- pmax(reg_fit$Fitted$y.hat, 1e-10)
+      S <- pmax(1e-10, 1 - CDF)
+      CDF <- dens / S
+      CDF <- pmin(CDF, 1e6)
+      CDF <- pmax(0, CDF)
       ylabel <- "h(x)"
-      P <- NNS.reg(x[-length(x)], CDF[-length(x)], order = "max", point.est = c(x[length(x)], target), plot = FALSE)$Point.est
-      CDF[is.infinite(CDF)] <- P[1]
-      P <- P[-1]
-    }else if(type == "cumulative hazard"){
-      CDF <- -log((1 - CDF))
+      if(!is.null(target)){
+        P <- reg_fit$Point.est / S[which.min(abs(x - target))]
+        P <- min(P, 1e6)
+        P <- max(0, P)
+        CDF[is.infinite(CDF)] <- P
+      }
+    } else if(type == "cumulative hazard"){
+      S <- pmax(1e-10, 1 - CDF)
+      CDF <- -log(S)
+      CDF <- pmax(0, CDF)
+      if(!is.null(target)){
+        reg_fit <- NNS.reg(x, CDF, order = NULL, n.best = 1, point.est = target, plot = FALSE)
+        P <- reg_fit$Point.est
+      }
       ylabel <- "H(x)"
-      P <- NNS.reg(x[-length(x)], CDF[-length(x)], order = "max", point.est = c(x[length(x)], target), plot = FALSE)$Point.est
-      CDF[is.infinite(CDF)] <- P[1]
-      P <- P[-1]
     }
     if(plot){
       plot(x, CDF, pch = 19, col = 'steelblue', xlab = deparse(substitute(variable)), ylab = ylabel, main = toupper(type), type = "s", lwd = 2)
       points(x, CDF, pch = 19, col = 'steelblue')
-      lines(x, CDF, lty=2, col = 'steelblue')
+      lines(x, CDF, lty = 2, col = 'steelblue')
       if(!is.null(target)){
-        segments(target,0,target,P, col = "red", lwd = 2, lty = 2)
+        segments(target, 0, target, P, col = "red", lwd = 2, lty = 2)
         segments(min(variable), P, target, P, col = "red", lwd = 2, lty = 2)
         points(target, P, col = "green", pch = 19)
-        mtext(text = round(P,4), col = "red", side = 2, at = P,  las = 2)
-        mtext(text = round(target,4), col = "red", side = 1, at = target,  las = 1)
+        mtext(text = round(P, 4), col = "red", side = 2, at = P, las = 2)
+        mtext(text = round(target, 4), col = "red", side = 1, at = target, las = 1)
       }
     }
     values <- data.table::data.table(cbind.data.frame(x, CDF))
     colnames(values) <- c(deparse(substitute(variable)), ylabel)
     return(
       list(
-        "Function" = values ,
+        "Function" = values,
         "target.value" = P
       )
     )
-  } else {
-    overall_target_1 <- (variable[,1])
-    overall_target_2 <- (variable[,2])
-    CDF <- (
-      Co.LPM(degree, sort(variable[,1]), sort(variable[,2]), overall_target_1, overall_target_2) /
-      (
-        Co.LPM(degree, sort(variable[,1]), sort(variable[,2]), overall_target_1, overall_target_2) +
-          Co.UPM(degree, sort(variable[,1]), sort(variable[,2]), overall_target_1, overall_target_2) +
-          D.UPM(degree,degree, sort(variable[,1]), sort(variable[,2]), overall_target_1, overall_target_2) +
-          D.LPM(degree,degree, sort(variable[,1]), sort(variable[,2]), overall_target_1, overall_target_2)
-      )
+  } 
+  # Bivariate Case
+  else {
+    overall_target_1 <- variable[,1]
+    overall_target_2 <- variable[,2]
+    
+    sorted_indices <- order(variable[,1], variable[,2])
+    sorted_x <- variable[sorted_indices, 1]
+    sorted_y <- variable[sorted_indices, 2]
+    
+    joint_cdf <- (
+      Co.LPM(degree, overall_target_1, overall_target_2, overall_target_1, overall_target_2) /
+        (
+          Co.LPM(degree, overall_target_1, overall_target_2, overall_target_1, overall_target_2) +
+            Co.UPM(degree, overall_target_1, overall_target_2, overall_target_1, overall_target_2) +
+            D.UPM(degree, degree, overall_target_1, overall_target_2, overall_target_1, overall_target_2) +
+            D.LPM(degree, degree, overall_target_1, overall_target_2, overall_target_1, overall_target_2)
+        )
     )
+    CDF <- joint_cdf[sorted_indices]
+    
+    marginal_X <- LPM.ratio(degree, sorted_x, overall_target_1)
+    marginal_Y <- LPM.ratio(degree, sorted_y, overall_target_2)
+    
+    ylabel <- "Probability"
     if(type == "survival"){
-      CDF <- 1 - CDF
+      CDF <- 1 - marginal_X - marginal_Y + CDF
+      CDF <- pmax(0, pmin(1, CDF))
+      ylabel <- "S(x, y)"
     } else if(type == "hazard"){
-      CDF <- sort(variable) / (1 - CDF)
+      data_points <- data.frame(x = sorted_x, y = sorted_y)
+      dens_proxy <- pmax(joint_cdf[sorted_indices], 1e-10)
+      reg_fit <- NNS.reg(data_points, dens_proxy, order = "max", 
+                         point.est = if(!is.null(target)) data.frame(x = target[1], y = target[2]) else NULL, 
+                         plot = FALSE)
+      dens <- pmax(reg_fit$Fitted$y.hat, 1e-10)
+      S_xy <- pmax(1e-10, 1 - marginal_X - marginal_Y + CDF)
+      CDF <- dens / S_xy
+      CDF <- pmax(0, CDF)
+      ylabel <- "h(x, y)"
     } else if(type == "cumulative hazard"){
-      CDF <- -log((1 - CDF))
+      S_xy <- pmax(1e-10, 1 - marginal_X - marginal_Y + CDF)
+      CDF <- -log(S_xy)
+      CDF <- pmax(0, CDF)
+      ylabel <- "H(x, y)"
     }
+    
     if(!is.null(target)){
       P <- (
-        Co.LPM(degree, variable[,1], variable[,2], target[1], target[2]) /
-        (
-          Co.LPM(degree, variable[,1], variable[,2], target[1], target[2]) +
-            Co.UPM(degree, variable[,1], variable[,2], target[1], target[2]) +
-            D.LPM(degree,degree, variable[,1], variable[,2], target[1], target[2]) +
-            D.UPM(degree,degree, variable[,1], variable[,2], target[1], target[2])
-        )
+        Co.LPM(degree, overall_target_1, overall_target_2, target[1], target[2]) /
+          (
+            Co.LPM(degree, overall_target_1, overall_target_2, target[1], target[2]) +
+              Co.UPM(degree, overall_target_1, overall_target_2, target[1], target[2]) +
+              D.LPM(degree, degree, overall_target_1, overall_target_2, target[1], target[2]) +
+              D.UPM(degree, degree, overall_target_1, overall_target_2, target[1], target[2])
+          )
       )
+      P_marginal_X <- LPM.ratio(degree, target[1], overall_target_1)
+      P_marginal_Y <- LPM.ratio(degree, target[2], overall_target_2)
+      if(type == "survival"){
+        P <- 1 - P_marginal_X - P_marginal_Y + P
+        P <- max(0, min(1, P))
+      } else if(type == "hazard"){
+        P_dens <- pmax(reg_fit$Point.est, 1e-10)
+        S_target <- max(1e-10, 1 - P_marginal_X - P_marginal_Y + P)
+        P <- P_dens / S_target
+        P <- min(P, 1e6)
+        P <- max(0, P)
+      } else if(type == "cumulative hazard"){
+        S_target <- max(1e-10, 1 - P_marginal_X - P_marginal_Y + P)
+        P <- -log(S_target)
+        P <- max(0, P)
+      }
     } else {
       P <- NULL
     }
+    
     if(plot){
       plot3d(
-        variable[,1], variable[,2], CDF, col = "steelblue",
+        variable[sorted_indices, 1], variable[sorted_indices, 2], CDF, col = "steelblue",
         xlab = deparse(substitute(variable[,1])), ylab = deparse(substitute(variable[,2])),
-        zlab = "Probability", box = FALSE, pch = 19
+        zlab = ylabel, box = FALSE, pch = 19
       )
-      if(!is.null(target)){
+      if(!is.null(target) && !is.na(P)){
         points3d(target[1], target[2], P, col = "green", pch = 19)
         points3d(target[1], target[2], 0, col = "red", pch = 15, cex = 2)
         lines3d(
-          x= c(target[1], max(variable[,1])),
-          y= c(target[2], max(variable[,2])),
-          z= c(P, P),
-          col = "red", lwd = 2, lty=3
+          x = c(target[1], max(variable[,1])),
+          y = c(target[2], max(variable[,2])),
+          z = c(P, P),
+          col = "red", lwd = 2, lty = 3
         )
         lines3d(
-          x= c(target[1], target[1]),
-          y= c(target[2], target[2]),
-          z= c(0, P),
-          col = "red", lwd = 1, lty=3
+          x = c(target[1], target[1]),
+          y = c(target[2], target[2]),
+          z = c(0, P),
+          col = "red", lwd = 1, lty = 3
         )
         text3d(
-          max(variable[,1]), max(variable[,2]), P, texts = paste0("P = ", round(P,4)), pos = 4, col = "red"
+          max(variable[,1]), max(variable[,2]), P, texts = paste0("P = ", round(P, 4)), pos = 4, col = "red"
         )
       }
-      
     }
 
+    return(list(
+      "Function" = data.table::data.table(cbind(
+        data.frame(variable[sorted_indices, ], row.names = NULL), 
+        CDF = CDF
+      )),
+      "target.value" = P
+    ))
   }
-  
-  return(list("CDF" = data.table::data.table(cbind((variable), CDF = CDF)),
-              "P" = P))
 }
 
 
+
 #' NNS moments
 #'
 #' This function returns the first 4 moments of the distribution.
@@ -227,7 +295,7 @@ NNS.moments <- function(x, population = TRUE){
     kurtosis <- ((n * (n+1)) / ((n-1)*(n-2)*(n-3))) * ((n*kurt_base) / (variance * (n / (n - 1)))^2) - ( (3 * ((n-1)^2)) / ((n-2)*(n-3)))
     variance <- variance * (n / (n - 1))
   }
-
+  
   return(list("mean" = mean,
               "variance" = variance,
               "skewness" = skewness,

NNS_11.3.tar.gz

@@ -3,7 +3,7 @@
 
 
 
-[![packageversion](https://img.shields.io/badge/NNS%20version-11.2-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-11.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)
 
 <h2 style="margin: 0; padding: 0; border: none; height: 40px;"></h2>
 
@@ -56,7 +56,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 11.2},
+    note = {R package version 11.3},
     url = {https://CRAN.R-project.org/package=NNS},
   }
 ```

NNS_11.3.zip

@@ -192,7 +192,7 @@ T1<-data.table::data.table(matrix(
   ), 
   ncol=2
 ))
-colnames(T1) <- c("A", "Probability")
+colnames(T1) <- c("A", "S(x)")
 B<-NNS.CDF(A, type="survival")
 test_that(
   "NNS.CDF", {