Skip to content

Compare "optimization" of internal sgccak code #25

@llrs

Description

@llrs

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]])
}

see related issues #16, #19, and the comment

Metadata

Metadata

Assignees

Projects

No projects

Milestone

No milestone

Relationships

None yet

Development

No branches or pull requests

Issue actions