Improved runtime of pure R grad.
This commit is contained in:
parent
998f8d3568
commit
0b2b1b76e6
|
@ -40,15 +40,15 @@ grad <- function(X, Y, V, h,
|
||||||
# Vectorized distance matrix `D`.
|
# Vectorized distance matrix `D`.
|
||||||
vecD <- colSums(tcrossprod(Q, X_diff)^2)
|
vecD <- colSums(tcrossprod(Q, X_diff)^2)
|
||||||
|
|
||||||
# Weight matrix `W` (dnorm ... gaussean density function)
|
# Create Kernel matrix (aka. apply kernel to distances)
|
||||||
W <- matrix(1, n, n) # `exp(0) == 1`
|
K <- matrix(1, n, n) # `exp(0) == 1`
|
||||||
W[lower] <- exp((-0.5 / h) * vecD^2) # Set lower tri. part
|
K[lower] <- exp((-0.5 / h) * vecD^2) # Set lower tri. part
|
||||||
W[upper] <- t.default(W)[upper] # Mirror lower tri. to upper
|
K[upper] <- t(K)[upper] # Mirror lower tri. to upper
|
||||||
W <- sweep(W, 2, colSums(W), FUN = `/`) # Col-Normalize
|
|
||||||
|
|
||||||
# Weighted `Y` momentums
|
# Weighted `Y` momentums
|
||||||
y1 <- Y %*% W # Result is 1D -> transposition irrelevant
|
colSumsK <- colSums(K)
|
||||||
y2 <- Y^2 %*% W
|
y1 <- (K %*% Y) / colSumsK
|
||||||
|
y2 <- (K %*% Y^2) / colSumsK
|
||||||
|
|
||||||
# Per example loss `L(V, X_i)`
|
# Per example loss `L(V, X_i)`
|
||||||
L <- y2 - y1^2
|
L <- y2 - y1^2
|
||||||
|
@ -59,11 +59,11 @@ grad <- function(X, Y, V, h,
|
||||||
loss <<- mean(L)
|
loss <<- mean(L)
|
||||||
}
|
}
|
||||||
|
|
||||||
# Vectorized Weights with forced symmetry
|
# Compute scaling vector `vecS` for `X_diff`.
|
||||||
vecS <- (L[i] - (Y[j] - y1[i])^2) * W[lower]
|
tmp <- kronecker(matrix(y1, n, 1), matrix(Y, 1, n), `-`)^2
|
||||||
vecS <- vecS + ((L[j] - (Y[i] - y1[j])^2) * W[upper])
|
tmp <- as.vector(L) - tmp
|
||||||
# Compute scaling of `X` row differences
|
tmp <- tmp * K / colSumsK
|
||||||
vecS <- vecS * vecD
|
vecS <- (tmp + t(tmp))[lower] * vecD
|
||||||
|
|
||||||
# The gradient.
|
# The gradient.
|
||||||
# 1. The `crossprod(A, B)` is equivalent to `t(A) %*% B`,
|
# 1. The `crossprod(A, B)` is equivalent to `t(A) %*% B`,
|
||||||
|
|
2
test.R
2
test.R
|
@ -2,7 +2,7 @@
|
||||||
# path <- '~/Projects/CVE/tmp/logger.R.pdf'
|
# path <- '~/Projects/CVE/tmp/logger.R.pdf'
|
||||||
|
|
||||||
library(CVE)
|
library(CVE)
|
||||||
path <- '~/Projects/CVE/tmp/seeded_test.pdf'
|
path <- '~/Projects/CVE/tmp/logger.C.pdf'
|
||||||
|
|
||||||
epochs <- 100
|
epochs <- 100
|
||||||
attempts <- 25
|
attempts <- 25
|
||||||
|
|
4
wip.R
4
wip.R
|
@ -55,11 +55,10 @@ grad2 <- function(X, Y, V, h, persistent = TRUE) {
|
||||||
# vecD <- rowSums((X_diff %*% Q)^2)
|
# vecD <- rowSums((X_diff %*% Q)^2)
|
||||||
vecD <- colSums(tcrossprod(Q, X_diff)^2)
|
vecD <- colSums(tcrossprod(Q, X_diff)^2)
|
||||||
|
|
||||||
# Weight matrix `W` (dnorm ... gaussean density function)
|
# Create Kernel matrix (aka. apply kernel to distances)
|
||||||
K <- matrix(1, n, n) # `exp(0) == 1`
|
K <- matrix(1, n, n) # `exp(0) == 1`
|
||||||
K[lower] <- exp((-0.5 / h) * vecD^2) # Set lower tri. part
|
K[lower] <- exp((-0.5 / h) * vecD^2) # Set lower tri. part
|
||||||
K[upper] <- t(K)[upper] # Mirror lower tri. to upper
|
K[upper] <- t(K)[upper] # Mirror lower tri. to upper
|
||||||
# W <- sweep(K, 2, colSums(K), FUN = `/`) # Col-Normalize
|
|
||||||
|
|
||||||
# Weighted `Y` momentums
|
# Weighted `Y` momentums
|
||||||
colSumsK <- colSums(K)
|
colSumsK <- colSums(K)
|
||||||
|
@ -68,6 +67,7 @@ grad2 <- function(X, Y, V, h, persistent = TRUE) {
|
||||||
# Per example loss `L(V, X_i)`
|
# Per example loss `L(V, X_i)`
|
||||||
L <- y2 - y1^2
|
L <- y2 - y1^2
|
||||||
|
|
||||||
|
# Compute scaling vector `vecS` for `X_diff`.
|
||||||
tmp <- kronecker(matrix(y1, n, 1), matrix(Y, 1, n), `-`)^2
|
tmp <- kronecker(matrix(y1, n, 1), matrix(Y, 1, n), `-`)^2
|
||||||
tmp <- as.vector(L) - tmp
|
tmp <- as.vector(L) - tmp
|
||||||
tmp <- tmp * K / colSumsK
|
tmp <- tmp * K / colSumsK
|
||||||
|
|
Loading…
Reference in New Issue