NNS 10.9.3 Beta

Author: OVVO-Financial

DESCRIPTION

@@ -2,7 +2,7 @@ Package: NNS
 Type: Package
 Title: Nonlinear Nonparametric Statistics
 Version: 10.9.3
-Date: 2024-10-03
+Date: 2024-10-14
 Authors@R: c(
   person("Fred", "Viole", role=c("aut","cre"), email="[email protected]"),
   person("Roberto", "Spadim", role=c("ctb"))

NNS_10.9.3.tar.gz

@@ -16,25 +16,25 @@
 #' @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) 
+  if (l <= 3)
     return(median(x))
-  if (length(unique(x)) == 1) 
+  if (length(unique(x)) == 1)
     return(x[1])
   x_s <- x[order(x)]
   range <- abs(x_s[l] - x_s[1])
-  if (range == 0) 
+  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)
   z_names <- seq(x_s[1], x_s[l], z$width)
   if (sum(max_z) > 1) {
     z_ind <- 1:lz
-    if (multi) 
+    if (multi)
       return(z_names[max_z])
   }
   else {
@@ -79,29 +79,29 @@ NNS.gravity <- function (x, discrete = FALSE)
   l <- length(x)
   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])
-  
+
   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)
@@ -125,6 +125,7 @@ NNS.gravity <- function (x, discrete = FALSE)
 }
 
 
+
 #' NNS rescale
 #'
 #' Rescale min-max scaling output between two numbers.
@@ -147,4 +148,6 @@ NNS.rescale <- function (x, a, b) {
   x <- as.numeric(x)
   output <- a + (b - a) * (x - min(x))/(max(x) - min(x))
   return(output)
-}
+}
+
+

NNS_10.9.3.zip

@@ -154,7 +154,7 @@ NNS.reg = function (x, y,
   if(plot.regions && !is.null(order) && order == "max") stop('Please reduce the "order" or set "plot.regions = FALSE".')
 
   dist <- tolower(dist)
- 
+  
   if(any(class(x)%in%c("tbl","data.table")) && ncol(x)==1) x <- as.vector(unlist(x))
   if(any(class(y)%in%c("tbl","data.table")) && ncol(y)==1) y <- as.vector(unlist(y))
   if(any(class(x)%in%c("tbl","data.table"))) x <- as.data.frame(x)
@@ -194,7 +194,7 @@ NNS.reg = function (x, y,
   original.names <- colnames(x)
   original.columns <- ncol(x)
 
-
+  
 
   if(!is.null(original.columns) & is.null(original.names)) x <- data.frame(x)
 
@@ -215,28 +215,28 @@ NNS.reg = function (x, y,
         new_x <- unlist(list(x, point.est))
       }
     } else new_x <- x
-
+    
     if(!is.null(dim(x)) && original.columns > 1){
       new_x <- data.table::data.table(new_x)
       dummies <- list()
-       for(i in 1:original.columns){
-         dummies[[i]] <- factor_2_dummy_FR(new_x[,.SD, .SDcols = i])
-         if(!is.null(ncol(dummies[i][[1]]))) colnames(dummies[i][[1]]) <- paste0(original.names[i], "_", colnames(dummies[i][[1]])) else names(dummies)[i] <- original.names[i]
-       }
+      for(i in 1:original.columns){
+        dummies[[i]] <- factor_2_dummy_FR(new_x[,.SD, .SDcols = i])
+        if(!is.null(ncol(dummies[i][[1]]))) colnames(dummies[i][[1]]) <- paste0(original.names[i], "_", colnames(dummies[i][[1]])) else names(dummies)[i] <- original.names[i]
+      }
       x <- do.call(cbind, dummies)
     }  else x <- factor_2_dummy_FR(new_x)
 
     if(!is.null(point.est)){
       point.est.y <- numeric()
-
+      
       if(is.null(dim(x))) lx <- length(x) else lx <- nrow(x)
 
       if(is.null(dim(point.est))) l_point.est <- length(point.est) else l_point.est <- nrow(point.est)
 
       point.est <- tail(x, l_point.est)
 
       x <- head(x, lx - l_point.est)
-    
+      
       if(is.null(dim(point.est)) || ncol(point.est)==1) point.est <- as.vector(unlist(point.est))
 
     } else { # is.null(point.est)
@@ -250,7 +250,7 @@ NNS.reg = function (x, y,
   # Variable names
   original.names <- colnames(x)
   original.columns <- ncol(x)
-
+  
   y <- as.numeric(y)
   original.y <- y
 
@@ -288,7 +288,6 @@ NNS.reg = function (x, y,
     if(is.null(n.best)) n.best <- 1
   }
 
-  
   if(!is.null(original.columns)){
     if(original.columns == 1){
       x <- original.variable
@@ -325,7 +324,7 @@ NNS.reg = function (x, y,
             x.star.dep[is.na(x.star.dep)] <- 0
           }
 
-          x.star.cor <-  sapply(1:dim(x)[2], function(i) cor(x[,i], y, method = "spearman"))
+          x.star.cor <- cor(x, y, method = "spearman")[, 1]
 
           x.star.cor[is.na(x.star.cor)] <- 0
 
@@ -378,7 +377,7 @@ NNS.reg = function (x, y,
 
           norm.x <- apply(original.variable, 2, function(b) (b - min(b)) / (max(b) - min(b)))
 
-          x.star.matrix <- Rfast::eachrow(norm.x, x.star.coef, "*") #t( t(norm.x) * x.star.coef)
+          x.star.matrix <- Rfast::eachrow(norm.x, x.star.coef, "*")
           x.star.matrix[is.na(x.star.matrix)] <- 0
 
           #In case all IVs have 0 correlation to DV

R/Central_tendencies.R

@@ -51,9 +51,11 @@ Uni.caus <- function(x, y, tau, plot = TRUE){
 
 
   ## Correlation of Normalized Variables
-  rho.x.y <- NNS.dep(y.norm.to.x, x.norm.to.y, asym = TRUE)$Dependence
+  dep.mtx <- NNS.dep(cbind(y.norm.to.x, x.norm.to.y), asym = TRUE)$Dependence
+  rho.x.y <- dep.mtx[1, 2]
+  rho.y.x <- dep.mtx[2, 1]
 
-  Causation.x.given.y <- P.x.given.y * rho.x.y
+  Causation.x.given.y <- mean(c(P.x.given.y * rho.x.y, max(0, (rho.x.y - rho.y.x))))
 
 
   if(plot){

R/Regression.R

@@ -11,6 +11,7 @@
 Nonlinear nonparametric statistics using partial moments. Partial moments are the [elements of variance](https://www.linkedin.com/pulse/elements-variance-fred-viole) and [asymptotically approximate the area of f(x)](https://doi.org/10.2139/ssrn.2186471). These robust statistics provide the basis for nonlinear analysis while retaining linear equivalences.
 
 
+
 NNS offers: 
   - Numerical Integration & Numerical Differentiation
   - Partitional & Hierarchial Clustering
@@ -65,3 +66,4 @@ Please see https://github.com/OVVO-Financial/NNS/blob/NNS-Beta-Version/examples/
 
 ## Thank you for your interest in NNS!
 ![](https://cranlogs.r-pkg.org/badges/NNS)
+![](https://cranlogs.r-pkg.org/badges/grand-total/NNS)

R/Uni_Causation.R

@@ -42,6 +42,14 @@ NNS.part(x, y, Voronoi = TRUE, order = 3, obs.req = 0)
 cor(x, y)
 NNS.dep(x, y)
 
+## ----asym1--------------------------------------------------------------------
+cor(x, y)
+NNS.dep(x, y, asym = TRUE)
+
+## ----asym2--------------------------------------------------------------------
+cor(y, x)
+NNS.dep(y, x, asym = TRUE)
+
 ## ----dependence,fig.width=5,fig.height=3,fig.align = "center"-----------------
 set.seed(123)
 df <- data.frame(x = runif(10000, -1, 1), y = runif(10000, -1, 1))

README.md

@@ -75,6 +75,25 @@ cor(x, y)
 NNS.dep(x, y)
 ```
 
+
+## Asymmetrical Analysis
+The asymmetrical analysis is critical for further determining a causal path between variables which should be identifiable, i.e., it is asymmetrical in causes and effects.
+
+The previous cyclic example visually highlights the asymmetry of dependence between the variables, which can be confirmed using **`NNS.dep(..., asym = TRUE)`**.  
+
+
+```{r asym1}
+cor(x, y)
+NNS.dep(x, y, asym = TRUE)
+```
+
+
+```{r asym2}
+cor(y, x)
+NNS.dep(y, x, asym = TRUE)
+```
+
+
 ## Dependence
 Note the fact that all observations occupy only co- or divergent partial moment quadrants for a given subquadrant.
 ```{r dependence,fig.width=5,fig.height=3,fig.align = "center"}