Skip to content

Commit 6496c18

Browse files
author
OVVO-Financial
committed
NNS 10.9.7 Beta
1 parent 5588d90 commit 6496c18

12 files changed

+215
-131
lines changed

‎DESCRIPTION

+2-2
Original file line numberDiff line numberDiff line change
@@ -1,8 +1,8 @@
11
Package: NNS
22
Type: Package
33
Title: Nonlinear Nonparametric Statistics
4-
Version: 10.9.6
5-
Date: 2024-12-16
4+
Version: 10.9.7
5+
Date: 2024-12-26
66
Authors@R: c(
77
person("Fred", "Viole", role=c("aut","cre"), email="[email protected]"),
88
person("Roberto", "Spadim", role=c("ctb"))

‎NNS_10.9.6.tar.gz

-1.17 MB
Binary file not shown.

‎NNS_10.9.7.tar.gz

1.17 MB
Binary file not shown.

‎NNS_10.9.6.zip ‎NNS_10.9.7.zip

845 KB
Binary file not shown.

‎R/Multivariate_Regression.R

+149-58
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,6 @@ NNS.M.reg <- function (X_n, Y, factor.2.dummy = TRUE, order = NULL, stn = NULL,
44

55
dist <- tolower(dist)
66

7-
87
### For Multiple regressions
98
### Turn each column into numeric values
109
original.IVs <- X_n
@@ -190,99 +189,191 @@ NNS.M.reg <- function (X_n, Y, factor.2.dummy = TRUE, order = NULL, stn = NULL,
190189

191190

192191

193-
### Point estimates
194-
if(!is.null(point.est)){
192+
### Point Estimates
193+
if (!is.null(point.est)) {
195194

196-
### Point estimates
197-
central.points <- apply(REGRESSION.POINT.MATRIX[, .SD, .SDcols = 1:n], 2, function(x) gravity(x))
195+
# Calculate central points
196+
central.points <- apply(REGRESSION.POINT.MATRIX[, .SD, .SDcols = 1:n], 2, gravity)
198197

199198
predict.fit <- numeric()
200-
201-
outsiders <- point.est<minimums | point.est>maximums
199+
outsiders <- point.est < minimums | point.est > maximums
202200
outsiders[is.na(outsiders)] <- 0
203201

204-
if(is.null(np)){
205-
l <- length(point.est)
206-
207-
if(!any(outsiders)){
208-
predict.fit <- NNS::NNS.distance(rpm = REGRESSION.POINT.MATRIX, dist.estimate = point.est, k = n.best, class = type)
202+
# Single point estimation
203+
if (is.null(np)) {
204+
if (!any(outsiders)) {
205+
predict.fit <- NNS::NNS.distance(
206+
rpm = REGRESSION.POINT.MATRIX,
207+
dist.estimate = point.est,
208+
k = n.best,
209+
class = type
210+
)
209211
} else {
210212
boundary.points <- pmin(pmax(point.est, minimums), maximums)
211213
mid.points <- (boundary.points + central.points) / 2
212214
mid.points_2 <- (boundary.points + mid.points) / 2
213-
last.known.distance_1 <- sqrt(sum((boundary.points - central.points) ^ 2))
214-
last.known.distance_2 <- sqrt(sum((boundary.points - mid.points) ^ 2))
215-
last.known.distance_3 <- sqrt(sum((boundary.points - mid.points_2) ^ 2))
216215

217-
boundary.estimates <- NNS::NNS.distance(rpm = REGRESSION.POINT.MATRIX, dist.estimate = boundary.points, k = n.best, class = type)
216+
last.known.distances <- c(
217+
sqrt(sum((boundary.points - central.points) ^ 2)),
218+
sqrt(sum((boundary.points - mid.points) ^ 2)),
219+
sqrt(sum((boundary.points - mid.points_2) ^ 2))
220+
)
218221

219-
last.known.gradient_1 <- (boundary.estimates - NNS::NNS.distance(rpm = REGRESSION.POINT.MATRIX, dist.estimate = central.points, k = n.best, class = type)) / last.known.distance_1
220-
last.known.gradient_2 <- (boundary.estimates - NNS::NNS.distance(rpm = REGRESSION.POINT.MATRIX, dist.estimate = mid.points, k = n.best, class = type)) / last.known.distance_2
221-
last.known.gradient_3 <- (boundary.estimates - NNS::NNS.distance(rpm = REGRESSION.POINT.MATRIX, dist.estimate = mid.points_2, k = n.best, class = type)) / last.known.distance_3
222+
boundary.estimates <- NNS::NNS.distance(
223+
rpm = REGRESSION.POINT.MATRIX,
224+
dist.estimate = boundary.points,
225+
k = n.best,
226+
class = type
227+
)
222228

223-
last.known.gradient <- (last.known.gradient_1*3 + last.known.gradient_2*2 + last.known.gradient_3) / 6
229+
gradients <- sapply(1:3, function(i) {
230+
compare.points <- list(central.points, mid.points, mid.points_2)[[i]]
231+
(boundary.estimates - NNS::NNS.distance(
232+
rpm = REGRESSION.POINT.MATRIX,
233+
dist.estimate = compare.points,
234+
k = n.best,
235+
class = type
236+
)) / last.known.distances[i]
237+
})
224238

239+
last.known.gradient <- sum(gradients * c(3, 2, 1)) / 6
225240
last.distance <- sqrt(sum((point.est - boundary.points) ^ 2))
226241

227242
predict.fit <- last.distance * last.known.gradient + boundary.estimates
228243
}
229244
}
230245

231-
if(!is.null(np)){
246+
# Multiple point estimation
247+
if (!is.null(np)) {
232248
DISTANCES <- vector(mode = "list", np)
233249
distances <- data.table::data.table(point.est)
234-
if(num_cores > 1){
235-
DISTANCES <- parallel::parApply(cl, distances, 1, function(z) NNS.distance(rpm = REGRESSION.POINT.MATRIX, dist.estimate = z, k = n.best, class = type)[1])
236-
237-
doParallel::stopImplicitCluster()
238-
foreach::registerDoSEQ()
239-
invisible(data.table::setDTthreads(0, throttle = NULL))
240-
invisible(gc(verbose = FALSE))
250+
251+
if (num_cores > 1) {
252+
DISTANCES <- parallel::parApply(
253+
cl,
254+
distances,
255+
1,
256+
function(z) NNS.distance(
257+
rpm = REGRESSION.POINT.MATRIX,
258+
dist.estimate = z,
259+
k = n.best,
260+
class = type
261+
)[1]
262+
)
241263
} else {
242-
distances <- distances[, DISTANCES := NNS.distance(rpm = REGRESSION.POINT.MATRIX, dist.estimate = .SD, k = n.best, class = type)[1], by = 1:nrow(point.est)]
264+
distances <- distances[, DISTANCES := NNS.distance(
265+
rpm = REGRESSION.POINT.MATRIX,
266+
dist.estimate = .SD,
267+
k = n.best,
268+
class = type
269+
)[1], by = 1:nrow(point.est)]
243270

244271
DISTANCES <- as.numeric(unlist(distances$DISTANCES))
245272
}
246-
247-
if(any(outsiders > 0)){
248-
outsiders <- rowSums(outsiders)
249-
outside.index <- as.numeric(which(outsiders>0))
273+
274+
# Parallel handling for outsiders
275+
if (any(rowSums(outsiders) > 0)) {
276+
outsider.indices <- which(rowSums(outsiders) > 0)
250277

251-
for(i in outside.index){
252-
outside.points <- point.est[i,]
253-
boundary.points <- pmin(pmax(outside.points, minimums), maximums)
254-
mid.points <- (boundary.points + central.points) / 2
255-
mid.points_2 <- (boundary.points + mid.points) / 2
256-
last.known.distance_1 <- sqrt(sum((boundary.points - central.points) ^ 2))
257-
last.known.distance_2 <- sqrt(sum((boundary.points - mid.points) ^ 2))
258-
last.known.distance_3 <- sqrt(sum((boundary.points - mid.points_2) ^ 2))
259-
260-
boundary.estimates <- NNS::NNS.distance(rpm = REGRESSION.POINT.MATRIX,
261-
dist.estimate = boundary.points,
262-
k = n.best, class = type)
263-
264-
last.known.gradient_1 <- (boundary.estimates - NNS::NNS.distance(rpm = REGRESSION.POINT.MATRIX, dist.estimate = central.points, k = n.best, class = type)) / last.known.distance_1
265-
last.known.gradient_2 <- (boundary.estimates - NNS::NNS.distance(rpm = REGRESSION.POINT.MATRIX, dist.estimate = mid.points, k = n.best, class = type)) / last.known.distance_2
266-
last.known.gradient_3 <- (boundary.estimates - NNS::NNS.distance(rpm = REGRESSION.POINT.MATRIX, dist.estimate = mid.points_2, k = n.best, class = type)) / last.known.distance_3
267-
268-
last.known.gradient <- (last.known.gradient_1*3 + last.known.gradient_2*2 + last.known.gradient_3) / 6
269-
270-
last.distance <- sqrt(sum((outside.points - boundary.points) ^ 2))
271-
272-
273-
DISTANCES[i] <- last.distance * last.known.gradient + boundary.estimates
278+
if (num_cores > 1) {
279+
DISTANCES[outsider.indices] <- unlist(parallel::parApply(
280+
cl,
281+
as.matrix(point.est[outsider.indices, ]),
282+
1,
283+
function(outside.points) {
284+
boundary.points <- pmin(pmax(outside.points, minimums), maximums)
285+
mid.points <- (boundary.points + central.points) / 2
286+
mid.points_2 <- (boundary.points + mid.points) / 2
287+
288+
last.known.distances <- c(
289+
sqrt(sum((boundary.points - central.points) ^ 2)),
290+
sqrt(sum((boundary.points - mid.points) ^ 2)),
291+
sqrt(sum((boundary.points - mid.points_2) ^ 2))
292+
)
293+
294+
boundary.estimates <- NNS::NNS.distance(
295+
rpm = REGRESSION.POINT.MATRIX,
296+
dist.estimate = boundary.points,
297+
k = n.best,
298+
class = type
299+
)
300+
301+
gradients <- sapply(1:3, function(i) {
302+
compare.points <- list(central.points, mid.points, mid.points_2)[[i]]
303+
(boundary.estimates - NNS::NNS.distance(
304+
rpm = REGRESSION.POINT.MATRIX,
305+
dist.estimate = compare.points,
306+
k = n.best,
307+
class = type
308+
)) / last.known.distances[i]
309+
})
310+
311+
last.known.gradient <- sum(gradients * c(3, 2, 1)) / 6
312+
last.distance <- sqrt(sum((outside.points - boundary.points) ^ 2))
313+
314+
last.distance * last.known.gradient + boundary.estimates
315+
}
316+
))
317+
} else {
318+
DISTANCES[outsider.indices] <- apply(
319+
as.matrix(point.est[outsider.indices, ]),
320+
1,
321+
function(outside.points) {
322+
boundary.points <- pmin(pmax(outside.points, minimums), maximums)
323+
mid.points <- (boundary.points + central.points) / 2
324+
mid.points_2 <- (boundary.points + mid.points) / 2
325+
326+
last.known.distances <- c(
327+
sqrt(sum((boundary.points - central.points) ^ 2)),
328+
sqrt(sum((boundary.points - mid.points) ^ 2)),
329+
sqrt(sum((boundary.points - mid.points_2) ^ 2))
330+
)
331+
332+
boundary.estimates <- NNS::NNS.distance(
333+
rpm = REGRESSION.POINT.MATRIX,
334+
dist.estimate = boundary.points,
335+
k = n.best,
336+
class = type
337+
)
338+
339+
gradients <- sapply(1:3, function(i) {
340+
compare.points <- list(central.points, mid.points, mid.points_2)[[i]]
341+
(boundary.estimates - NNS::NNS.distance(
342+
rpm = REGRESSION.POINT.MATRIX,
343+
dist.estimate = compare.points,
344+
k = n.best,
345+
class = type
346+
)) / last.known.distances[i]
347+
})
348+
349+
last.known.gradient <- sum(gradients * c(3, 2, 1)) / 6
350+
last.distance <- sqrt(sum((outside.points - boundary.points) ^ 2))
351+
352+
last.distance * last.known.gradient + boundary.estimates
353+
}
354+
)
274355
}
356+
357+
275358
}
276359

277360
predict.fit <- DISTANCES
278-
279-
if(point.only) return(list(Point.est = predict.fit, RPM = REGRESSION.POINT.MATRIX[] ))
280361
}
281362

363+
if (point.only) {
364+
return(list(Point.est = predict.fit, RPM = REGRESSION.POINT.MATRIX[]))
365+
}
282366
} else {
283367
predict.fit <- NULL
284368
} # is.null point.est
285369

370+
if(num_cores > 1){
371+
doParallel::stopImplicitCluster()
372+
foreach::registerDoSEQ()
373+
invisible(data.table::setDTthreads(0, throttle = NULL))
374+
invisible(gc(verbose = FALSE))
375+
}
376+
286377
if(!is.null(type)){
287378
fitted.matrix$y.hat <- ifelse(fitted.matrix$y.hat %% 1 < 0.5, floor(fitted.matrix$y.hat), ceiling(fitted.matrix$y.hat))
288379
fitted.matrix$y.hat <- pmin(max(original.DV), pmax(min(original.DV), fitted.matrix$y.hat))

0 commit comments

Comments
 (0)