Skip to content

Commit

Permalink
NNS 10.9.2 Beta
Browse files Browse the repository at this point in the history
  • Loading branch information
OVVO-Financial committed Sep 1, 2024
1 parent 773da01 commit 5b3ffc4
Show file tree
Hide file tree
Showing 6 changed files with 81 additions and 38 deletions.
2 changes: 1 addition & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -2,7 +2,7 @@ Package: NNS
Type: Package
Title: Nonlinear Nonparametric Statistics
Version: 10.9.2
Date: 2024-08-29
Date: 2024-09-01
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 modified NNS_10.9.2.tar.gz
Binary file not shown.
Binary file modified NNS_10.9.2.zip
Binary file not shown.
26 changes: 20 additions & 6 deletions R/ANOVA.R
Original file line number Diff line number Diff line change
Expand Up @@ -5,6 +5,7 @@
#' @param control a numeric vector, matrix or data frame, or list if unequal vector lengths.
#' @param treatment \code{NULL} (default) a numeric vector, matrix or data frame.
#' @param means.only logical; \code{FALSE} (default) test whether difference in sample means only is zero.
#' @param medians logical; \code{FALSE} (default) test whether difference in sample medians only is zero. Requires \code{means.only = TRUE}.
#' @param confidence.interval numeric [0, 1]; The confidence interval surrounding the \code{control} mean, defaults to \code{(confidence.interval = 0.95)}.
#' @param tails options: ("Left", "Right", "Both"). \code{tails = "Both"}(Default) Selects the tail of the distribution to determine effect size.
#' @param pairwise logical; \code{FALSE} (default) Returns pairwise certainty tests when set to \code{pairwise = TRUE}.
Expand Down Expand Up @@ -37,6 +38,9 @@
#' ### Two variable analysis with no control variable
#' A <- cbind(x, y)
#' NNS.ANOVA(A)
#'
#' ### Medians test
#' NNS.ANOVA(A, means.only = TRUE, medians = TRUE)
#'
#' ### Multiple variable analysis with no control variable
#' set.seed(123)
Expand All @@ -56,6 +60,7 @@ NNS.ANOVA <- function(
control,
treatment,
means.only = FALSE,
medians = FALSE,
confidence.interval = 0.95,
tails = "Both",
pairwise = FALSE,
Expand All @@ -82,7 +87,7 @@ NNS.ANOVA <- function(

nns.certainties <- sapply(
1:ncol(control_matrix),
function(g) NNS.ANOVA.bin(control_matrix[,g], treatment_matrix[,g], means.only = means.only, plot = FALSE)$Certainty
function(g) NNS.ANOVA.bin(control_matrix[,g], treatment_matrix[,g], means.only = means.only, medians = medians, plot = FALSE)$Certainty
)

cer_lower_CI <- LPM.VaR(.025, 1, nns.certainties[-1])
Expand All @@ -105,6 +110,7 @@ NNS.ANOVA <- function(
control,
treatment,
means.only = means.only,
medians = medians,
confidence.interval = confidence.interval,
plot = plot,
tails = tails,
Expand All @@ -121,6 +127,7 @@ NNS.ANOVA <- function(
control,
treatment,
means.only = means.only,
medians = medians,
confidence.interval = confidence.interval,
plot = plot,
tails = tails
Expand All @@ -146,15 +153,21 @@ NNS.ANOVA <- function(
A <- control
}

mean.of.means <- mean(colMeans(A, na.rm = T))
if(medians) mean.of.means <- mean(apply(A, 2, function(i) median(i, na.rm = TRUE))) else mean.of.means <- mean(colMeans(A, na.rm = T))

if(!pairwise){
#Continuous CDF for each variable from Mean of Means
LPM_ratio <- sapply(1:n, function(b) LPM.ratio(1, mean.of.means, na.omit(unlist(A[ , b]))))
if(medians){
LPM_ratio <- sapply(1:n, function(b) LPM.ratio(0, mean.of.means, na.omit(unlist(A[ , b]))))
} else {
LPM_ratio <- sapply(1:n, function(b) LPM.ratio(1, mean.of.means, na.omit(unlist(A[ , b]))))
}

lower.25.target <- mean(sapply(1:n, function(i) LPM.VaR(.25, 1, na.omit(unlist(A[,i])))))
upper.25.target <- mean(sapply(1:n, function(i) UPM.VaR(.25, 1, na.omit(unlist(A[,i])))))
lower.125.target <- mean(sapply(1:n, function(i) LPM.VaR(.125, 1, na.omit(unlist(A[,i])))))
upper.125.target <- mean(sapply(1:n, function(i) UPM.VaR(.125, 1, na.omit(unlist(A[,i])))))

raw.certainties <- list(n - 1)
for(i in 1:(n - 1)){
raw.certainties[[i]] <- sapply(
Expand All @@ -163,6 +176,7 @@ NNS.ANOVA <- function(
na.omit(unlist(A[ , i])),
na.omit(unlist(A[ , b])),
means.only = means.only,
medians = medians,
mean.of.means = mean.of.means,
upper.25.target = upper.25.target,
lower.25.target = lower.25.target,
Expand All @@ -188,7 +202,7 @@ NNS.ANOVA <- function(
)
#For ANOVA Visualization
abline(v = mean.of.means, col = "red", lwd = 4)
mtext("Grand Mean", side = 3,col = "red", at = mean.of.means)
if(medians) mtext("Grand Median", side = 3,col = "red", at = mean.of.means) else mtext("Grand Mean", side = 3,col = "red", at = mean.of.means)
}
return(c("Certainty" = NNS.ANOVA.rho))
}
Expand All @@ -197,7 +211,7 @@ NNS.ANOVA <- function(
for(i in 1:(n - 1)){
raw.certainties[[i]] <- sapply(
(i + 1) : n,
function(b) NNS.ANOVA.bin(na.omit(unlist(A[ , i])), na.omit(unlist(A[ , b])), means.only = means.only, plot = FALSE)$Certainty
function(b) NNS.ANOVA.bin(na.omit(unlist(A[ , i])), na.omit(unlist(A[ , b])), means.only = means.only, medians = medians, plot = FALSE)$Certainty
)
}

Expand All @@ -217,7 +231,7 @@ NNS.ANOVA <- function(
col = c('steelblue', rainbow(n - 1))
)
abline(v = mean.of.means, col = "red", lwd = 4)
mtext("Grand Mean", side = 3,col = "red", at = mean.of.means)
if(medians) mtext("Grand Median", side = 3,col = "red", at = mean.of.means) else mtext("Grand Mean", side = 3,col = "red", at = mean.of.means)
}
return(certainties)
}
85 changes: 54 additions & 31 deletions R/Binary_ANOVA.R
Original file line number Diff line number Diff line change
@@ -1,5 +1,6 @@
NNS.ANOVA.bin <- function(control, treatment,
means.only = FALSE,
medians = FALSE,
mean.of.means = NULL,
upper.25.target = NULL,
lower.25.target = NULL,
Expand All @@ -8,7 +9,7 @@ NNS.ANOVA.bin <- function(control, treatment,
confidence.interval = NULL, tails = NULL, plot = TRUE, par = NULL){

if(is.null(upper.25.target) && is.null(lower.25.target)){
mean.of.means <- mean(c(mean(control), mean(treatment)))
if(medians) mean.of.means <- mean(c(median(control), median(treatment))) else mean.of.means <- mean(c(mean(control), mean(treatment)))
upper.25.target <- mean(c(UPM.VaR(.25, 1, control), UPM.VaR(.25, 1, treatment)))
lower.25.target <- mean(c(LPM.VaR(.25, 1, control), LPM.VaR(.25, 1, treatment)))
upper.125.target <- mean(c(UPM.VaR(.125, 1, control), UPM.VaR(.125, 1, treatment)))
Expand All @@ -18,9 +19,14 @@ NNS.ANOVA.bin <- function(control, treatment,


#Continuous CDF for each variable from Mean of Means
LPM_ratio.1 <- LPM.ratio(1, mean.of.means, control)
LPM_ratio.2 <- LPM.ratio(1, mean.of.means, treatment)

if(medians){
LPM_ratio.1 <- LPM.ratio(0, mean.of.means, control)
LPM_ratio.2 <- LPM.ratio(0, mean.of.means, treatment)
} else {
LPM_ratio.1 <- LPM.ratio(1, mean.of.means, control)
LPM_ratio.2 <- LPM.ratio(1, mean.of.means, treatment)
}

Upper_25_ratio.1 <- UPM.ratio(1, upper.25.target, control)
Upper_25_ratio.2 <- UPM.ratio(1, upper.25.target, treatment)
Upper_25_ratio <- mean(c(Upper_25_ratio.1, Upper_25_ratio.2))
Expand Down Expand Up @@ -59,31 +65,36 @@ NNS.ANOVA.bin <- function(control, treatment,
}





pop.adjustment <- ((length(control) + length(treatment) - 2) / (length(control) + length(treatment) )) ^ 2

#Graphs

if(plot){
if(is.null(par)) original.par <- par(no.readonly = TRUE) else original.par <- par

boxplot(list(control, treatment), las = 2, names = c("Control", "Treatment"), horizontal = TRUE, main = "NNS ANOVA and Effect Size", col = c("grey", "white"), cex.axis = 0.75)

#For ANOVA Visualization
abline(v = mean.of.means, col = "red", lwd = 4)
mtext("Grand Mean", side = 3, col = "red", at = mean.of.means)
if(medians) mtext("Grand Median", side = 3, col = "red", at = mean.of.means) else mtext("Grand Mean", side = 3, col = "red", at = mean.of.means)
}

if(is.null(confidence.interval)){

if(medians){
return(list("Control Median" = median(control),
"Treatment Median" = median(treatment),
"Grand Median" = mean.of.means,
"Control CDF" = LPM_ratio.1,
"Treatment CDF" = LPM_ratio.2,
"Certainty" = min(1, NNS.ANOVA.rho * pop.adjustment)))
} else {
return(list("Control Mean" = mean(control),
"Treatment Mean" = mean(treatment),
"Grand Mean" = mean.of.means,
"Control CDF" = LPM_ratio.1,
"Treatment CDF" = LPM_ratio.2,
"Certainty" = min(1, NNS.ANOVA.rho * pop.adjustment)))
}
} else {

#Upper end of CDF confidence interval for control mean
Expand All @@ -93,15 +104,18 @@ NNS.ANOVA.bin <- function(control, treatment,

# Resample control means
y_p <- replicate(1000, sample.int(length(control), replace = TRUE))
control_means <- Rfast::colmeans(matrix(control[y_p], ncol = ncol(y_p), byrow = T))

if(medians){
control_means <- apply(matrix(control[y_p], ncol = ncol(y_p), byrow = T), 1, function(i) median(i, na.rm = T))
} else {
control_means <- apply(matrix(control[y_p], ncol = ncol(y_p), byrow = T), 1, function(i) mean(i, na.rm = T))
}
a <- UPM.VaR(CI, 0, control_means)
b <- mean(control_means)

if(plot){
if(tails == "both" | tails == "right"){
abline(v = max(a, b), col = "green", lwd = 2, lty = 3)
text(max(a, b), pos = 4, 0.5, paste0("<--- ", "ctl mu+ ", CI * 100, "%" ), col = "green")
text(max(a, b), pos = 4, 0.5, paste0("<--- ", ifelse(medians, "ctl med+ " , "ctl mu+ "), CI * 100, "%" ), col = "green")
}
}

Expand All @@ -112,39 +126,48 @@ NNS.ANOVA.bin <- function(control, treatment,
if(plot){
if(tails == "both" | tails == "left"){
abline(v = min(c, d), col = "blue", lwd = 2, lty = 3)
text(min(c, d), pos = 2, 0.5, paste0("ctl mu- ", paste0(CI * 100, "% --->")) , col = "blue")
text(min(c, d), pos = 2, 0.5, paste0(ifelse(medians, "ctl med- ", "ctl mu- "), paste0(CI * 100, "% --->")) , col = "blue")
}

par(original.par)
}

#Effect Size Lower Bound
if(tails == "both") Lower.Bound.Effect <- mean(treatment) - max(a, b)

if(tails == "left") Lower.Bound.Effect <- mean(treatment) - max(c, d)

if(tails == "right") Lower.Bound.Effect <- mean(treatment) - max(a, b)
if(tails == "both") if(medians) Lower.Bound.Effect <- median(treatment) - max(a, b) else Lower.Bound.Effect <- mean(treatment) - max(a, b)
if(tails == "left") if(medians) Lower.Bound.Effect <- median(treatment) - max(c, d) else Lower.Bound.Effect <- mean(treatment) - max(c, d)
if(tails == "right") if(medians) Lower.Bound.Effect <- mean(treatment) - max(a, b) else Lower.Bound.Effect <- mean(treatment) - max(a, b)



#Effect Size Upper Bound
if(tails == "both") Upper.Bound.Effect <- mean(treatment) - min(c, d)

if(tails == "left") Upper.Bound.Effect <- mean(treatment) - min(c, d)

if(tails == "right") Upper.Bound.Effect <- mean(treatment) - min(a, b)
if(tails == "both") if(medians) Upper.Bound.Effect <- median(treatment) - min(c, d) else Upper.Bound.Effect <- mean(treatment) - min(c, d)
if(tails == "left") if(medians) Upper.Bound.Effect <- median(treatment) - min(c, d) else Upper.Bound.Effect <- mean(treatment) - min(c, d)
if(tails == "right") if(medians) Upper.Bound.Effect <- median(treatment) - min(a, b) else Upper.Bound.Effect <- mean(treatment) - min(a, b)




#Certainty Statistic and Effect Size Given Confidence Interval
return(list("Control Mean" = mean(control),
"Treatment Mean" = mean(treatment),
"Grand Mean" = mean.of.means,
"Control CDF" = LPM_ratio.1,
"Treatment CDF" = LPM_ratio.2,
"Certainty" = min(1, NNS.ANOVA.rho * pop.adjustment),
"Lower Bound Effect" = Lower.Bound.Effect,
"Upper Bound Effect" = Upper.Bound.Effect))
if(medians){
return(list("Control Median" = median(control),
"Treatment Median" = median(treatment),
"Grand Median" = mean.of.means,
"Control CDF" = LPM_ratio.1,
"Treatment CDF" = LPM_ratio.2,
"Certainty" = min(1, NNS.ANOVA.rho * pop.adjustment),
"Lower Bound Effect" = Lower.Bound.Effect,
"Upper Bound Effect" = Upper.Bound.Effect))
} else {
return(list("Control Mean" = mean(control),
"Treatment Mean" = mean(treatment),
"Grand Mean" = mean.of.means,
"Control CDF" = LPM_ratio.1,
"Treatment CDF" = LPM_ratio.2,
"Certainty" = min(1, NNS.ANOVA.rho * pop.adjustment),
"Lower Bound Effect" = Lower.Bound.Effect,
"Upper Bound Effect" = Upper.Bound.Effect))

}

}
}
6 changes: 6 additions & 0 deletions man/NNS.ANOVA.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

0 comments on commit 5b3ffc4

Please sign in to comment.