forked from cran/RGCCA
-
Notifications
You must be signed in to change notification settings - Fork 1
Open
Labels
Description
Optimization in the sgccak function
Original:
for (q in seq_len(J)) {
if (mode(scheme) == "function") {
dgx <- dg(cov2(Y, Y[, q], bias = bias))
CbyCovq <- C[q, ] * dgx
} else {
if (scheme == "horst") {
CbyCovq <- C[q, ]
} else if (scheme == "factorial") {
CbyCovq <- C[q, ] * 2 * cov2(Y, Y[, q], bias = bias)
} else if (scheme == "centroid") {
CbyCovq <- C[q, ] * sign(cov2(Y, Y[, q], bias = bias))
}
}
Z[, q] <- rowSums(mapply("*", CbyCovq, as.data.frame(Y)))
a[[q]] <- drop(crossprod(A[[q]], Z[, q, drop = FALSE]))
a[[q]] <- soft.threshold(a[[q]], const[q])
a[[q]] <- as.vector(a[[q]]) / norm2(a[[q]])
Y[, q] <- drop(A[[q]] %*% a[[q]])
}
Proposed:
if (mode(scheme) == "function") {
dgx <- dg(cov2(Y, Y, bias = bias))
CbyCovq <- C * dgx
} else {
if (scheme == "horst") {
CbyCovq <- C
} else if (scheme == "factorial") {
CbyCovq <- C * 2 * cov2(Y, Y, bias = bias)
} else if (scheme == "centroid") {
CbyCovq <- C * sign(cov2(Y, Y, bias = bias))
}
}
Z <- t(tcrossprod(CbyCovq, Y))
for (q in seq_len(J)) {
a[[q]] <- drop(crossprod(A[[q]], Z[, q, drop = FALSE]))
a[[q]] <- soft.threshold(a[[q]], const[q])
a[[q]] <- as.vector(a[[q]]) / norm2(a[[q]])
Y[, q] <- drop(A[[q]] %*% a[[q]])
}