NNS 10.9.3 Beta

OVVO-Financial · Oct 3, 2024 · 196a4f2 · 196a4f2
1 parent 6011642
commit 196a4f2
Show file tree

Hide file tree

Showing 15 changed files with 286 additions and 419 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -2,7 +2,7 @@ Package: NNS
 Type: Package
 Title: Nonlinear Nonparametric Statistics
 Version: 10.9.3
-Date: 2024-09-26
+Date: 2024-10-03
 Authors@R: c(
   person("Fred", "Viole", role=c("aut","cre"), email="ovvo.financial.systems@gmail.com"),
   person("Roberto", "Spadim", role=c("ctb"))

diff --git a/NAMESPACE b/NAMESPACE
@@ -38,7 +38,6 @@ export(NNS.rescale)
 export(NNS.seas)
 export(NNS.stack)
 export(NNS.term.matrix)
-export(NNS_bin)
 export(PM.matrix)
 export(UPM)
 export(UPM.VaR)

diff --git a/NNS_10.9.3.tar.gz b/NNS_10.9.3.tar.gz
diff --git a/NNS_10.9.3.zip b/NNS_10.9.3.zip
diff --git a/R/Central_tendencies.R b/R/Central_tendencies.R
@@ -16,38 +16,42 @@
 #' @export
 
 
-NNS.mode <- function(x, discrete = FALSE, multi = TRUE){
+NNS.mode <- function (x, discrete = FALSE, multi = TRUE) 
+{
   x <- as.numeric(x)
   l <- length(x)
-  if(l <= 3) return(median(x))
-  if(length(unique(x))==1) return(x[1])
+  if (l <= 3) 
+    return(median(x))
+  if (length(unique(x)) == 1) 
+    return(x[1])
   x_s <- x[order(x)]
-  range <- abs(x_s[l]-x_s[1])
-  if(range==0) return(x[1])
-
+  range <- abs(x_s[l] - x_s[1])
+  if (range == 0) 
+    return(x[1])
   z <- NNS_bin(x_s, range/128, origin = x_s[1], missinglast = FALSE)
   lz <- length(z$counts)
-  max_z <- z$counts==max(z$counts)
+  max_z <- z$counts == max(z$counts)
   z_names <- seq(x_s[1], x_s[l], z$width)
-
-  if(sum(max_z)>1){
+  if (sum(max_z) > 1) {
     z_ind <- 1:lz
-    if(multi) return(z_names[max_z])
-  } else {
+    if (multi) 
+      return(z_names[max_z])
+  }
+  else {
     z_c <- which.max(z$counts)
-    z_ind <- max(1, (z_c - 1)):min(lz,(z_c + 1))
+    z_ind <- max(1, (z_c - 1)):min(lz, (z_c + 1))
   }
-
-  final <- sum(z_names[z_ind] * z$counts[z_ind] )/sum(z$counts[z_ind])
-
-  if(discrete){
-    final <- ifelse(final%%1 < .5, floor(final), ceiling(final))
+  final <- sum(z_names[z_ind] * z$counts[z_ind])/sum(z$counts[z_ind])
+  if (discrete) {
+    final <- ifelse(final%%1 < 0.5, floor(final), ceiling(final))
     return(final)
-  } else {
-    if(multi){ 
-      return(final) 
-    } else {
-        return(mean(final))
+  }
+  else {
+    if (multi) {
+      return(final)
+    }
+    else {
+      return(mean(final))
     }
   }
 }
@@ -70,39 +74,55 @@ NNS.mode <- function(x, discrete = FALSE, multi = TRUE){
 #' }
 #' @export
 
-NNS.gravity <- function(x, discrete = FALSE){
+NNS.gravity <- function (x, discrete = FALSE)
+{
   l <- length(x)
-  if(l <= 3) return(median(x))
-  if(length(unique(x))==1) return(x[1])
+  if (l <= 3) return(median(x))
+  if (length(unique(x)) == 1) return(x[1])
+
   x_s <- x[order(x)]
-  range <- abs(x_s[l]-x_s[1])
+  range <- abs(x_s[l] - x_s[1])
 
-  if(range == 0) return(x[1])
+  if (range == 0)  return(x[1])
 
-  q1 <- sum(x_s[floor(l*.25)]+((l*.25)%%1 * (x_s[ceiling(l*.25)] - x_s[floor(l*.25)])))
-  q2 <- (x_s[floor(l*.5)]+x_s[ceiling(l*.5)])/2
-  q3 <- sum(x_s[floor(l*.75)]+((l*.75)%%1 * (x_s[ceiling(l*.75)] - x_s[floor(l*.75)])))
+  l_25 = l*.25
+  l_50 = l*.5
+  l_75 = l*.75
+
+  if(l%%2==0){
+    q1 <- x_s[l_25]
+    q2 <- x_s[l_50]
+    q3 <- x_s[l_75]
+  } else {
+    f_l_25 = floor(l_25)
+    f_l_75 = floor(l_75)
+
+    q1 <- sum(x_s[f_l_25]+(l_25%%1 * (x_s[ceiling(l_25)] - x_s[f_l_25])))
+    q2 <- (x_s[floor(l_50)]+x_s[ceiling(l_50)])/2
+    q3 <- sum(x_s[f_l_75]+((l_75)%%1 * (x_s[ceiling(l_75)] - x_s[f_l_75])))
+  }
 
   z <- NNS_bin(x_s, range/128, origin = x_s[1], missinglast = FALSE)
   lz <- length(z$counts)
-  max_z <- z$counts==max(z$counts)
-
-  if(sum(max_z)>1){
+  max_z <- z$counts == max(z$counts)
+  if (sum(max_z) > 1) {
     z_ind <- 1:lz
-  } else {
+  }
+  else {
     z_c <- which.max(z$counts)
-    z_ind <- max(1, (z_c - 1)):min(lz,(z_c + 1))
+    z_ind <- max(1, (z_c - 1)):min(lz, (z_c + 1))
   }
-
   z_names <- seq(x_s[1], x_s[l], z$width)
-
-  m <- sum(z_names[z_ind] * z$counts[z_ind] )/sum(z$counts[z_ind])
+  m <- sum(z_names[z_ind] * z$counts[z_ind])/sum(z$counts[z_ind])
   mu <- sum(x)/l
-
   res <- (q2 + m + mu + mean(c(q1, q2, q3)))/4
-  if(is.na(res)) final <- q2 else final <- res
-  if(discrete) return(ifelse(final%%1 < .5, floor(final), ceiling(final))) else return(final)
-} 
+  if (is.na(res))
+    final <- q2
+  else final <- res
+  if (discrete)
+    return(ifelse(final%%1 < 0.5, floor(final), ceiling(final)))
+  else return(final)
+}
 
 
 #' NNS rescale

diff --git a/R/Dependence.R b/R/Dependence.R
@@ -49,23 +49,23 @@ NNS.dep = function(x,
   if(!is.null(y)){
     x <- as.numeric(x)
     l <- length(x)
-
+    
     y <- as.numeric(y)
     obs <- max(10, l/5)
-
+    
     # Define segments
     if(print.map) PART_xy <- suppressWarnings(NNS.part(x, y, order = NULL, obs.req = obs, min.obs.stop = TRUE, type = "XONLY", Voronoi = TRUE)) else PART_xy <- suppressWarnings(NNS.part(x, y, order = NULL, obs.req = obs, min.obs.stop = TRUE, type = "XONLY", Voronoi = FALSE))
 
     PART_yx <- suppressWarnings(NNS.part(y, x, order = NULL, obs.req = obs, min.obs.stop = TRUE, type = "XONLY", Voronoi = FALSE))
-
+    
     if(dim(PART_xy$regression.points)[1]==0) return(list("Correlation" = 0, "Dependence" = 0))
-
+    
     PART_xy <- PART_xy$dt
     PART_xy <- PART_xy[complete.cases(PART_xy),]
-
+    
     PART_xy[, weights_xy := .N/l, by = prior.quadrant]
     weights_xy <- PART_xy[, weights_xy[1], by = prior.quadrant]$V1
-
+    
     PART_yx <- PART_yx$dt
     PART_yx <- PART_yx[complete.cases(PART_yx),]
 
@@ -80,52 +80,51 @@ NNS.dep = function(x,
       NNS::NNS.copula(cbind(x, y)) * sign(cov(x,y))
     }
 
-
+    
     res_xy <- suppressWarnings(tryCatch(PART_xy[1:eval(ll),  dep_fn(x, y), by = prior.quadrant],
-                                     error = function(e) dep_fn(x, y)))
+                                        error = function(e) dep_fn(x, y)))
 
     res_yx <- suppressWarnings(tryCatch(PART_yx[1:eval(ll),  dep_fn(y, x), by = prior.quadrant],
                                         error = function(e) dep_fn(y, x)))
-
+    
     if(sum(is.na(res_xy))>0) res_xy[is.na(res_xy)] <- dep_fn(x, y)
     if(is.null(ncol(res_xy))) res_xy <- cbind(res_xy, res_xy)
 
     if(sum(is.na(res_yx))>0) res_yx[is.na(res_yx)] <- dep_fn(x, y)
     if(is.null(ncol(res_yx))) res_yx <- cbind(res_yx, res_yx)
-
+    
     if(asym){
       dependence <- sum(abs(res_xy[,2]) * weights_xy)
     } else {
       dependence <- max(c(sum(abs(res_yx[,2]) * weights_yx),
-                           sum(abs(res_xy[,2]) * weights_xy)))
+                          sum(abs(res_xy[,2]) * weights_xy)))
     }
-
+    
     lx <- PART_xy[, length(unique(x))]
     ly <- PART_xy[, length(unique(y))]
     degree_x <- min(10, max(1,lx-1), max(1,ly-1))
-
+    
     I_x <- lx < sqrt(l)
     I_y <- ly < sqrt(l)
     I <- I_x * I_y
-
+    
     if(I == 1){
       poly_base <- suppressWarnings(tryCatch(fast_lm_mult(poly(x, degree_x), abs(y))$r.squared,
                                              warning = function(w) dependence,
                                              error = function(e) dependence))
-
+      
       dependence <- gravity(c(dependence, NNS.copula(cbind(x, y), plot = FALSE), poly_base))
     }
-
+    
     if(asym){
       corr <- sum(res_xy[,2] * weights_xy)
     } else {
       corr <- max(c(sum(res_yx[,2] * weights_yx), sum(res_xy[,2] * weights_xy)))
     }
-
+    
 
     return(list("Correlation" = corr,
                 "Dependence" = dependence))
-
   } else {
     if(p.value){
       original.par <- par(no.readonly = TRUE)