pk2 <- function(y1, y2, tol = 1e-6) {

  dm <- dim(y1)
  n1 <- dm[1]  ;  d <- dm[2]
  n2 <- dim(y2)[1]

  pk1 <- function(r1, r2, a1, a2, n1, n2, d) {

    n1 * log(1 - r1^2) - 0.5 * d * sum( log1p( r1^2 - 2 * r1 * a1 ) ) +
    n2 * log(1 - r2^2) - 0.5 * d * sum( log1p( r2^2 - 2 * r2 * a2 ) )
  }

  pk2 <- function(r2, r1, a1, a2, n1, n2, d) {
    n1 * log(1 - r1^2) - 0.5 * d * sum( log1p( r1^2 - 2 * r1 * a1 ) ) +
    n2 * log(1 - r2^2) - 0.5 * d * sum( log1p( r2^2 - 2 * r2 * a2 ) )
  }

  mu <- Rfast::colmeans( rbind(y1, y2) )
  mu <- mu / sqrt(sum(mu^2) )
  a1 <- as.vector(y1 %*% mu)
  a2 <- as.vector(y2 %*% mu)

  mod1 <- optimize( pk1, c(0, 1), r2 = 0.5, a1 = a1, a2 = a2, n1 = n1, n2 = n2, d = d,
                    maximum = TRUE, tol = 1e-6 )
  mod2 <- optimize( pk2, c(0, 1), r1 = mod1$maximum, a1 = a1, a2 = a2, n1 = n1, n2 = n2, d = d,
                    maximum = TRUE, tol = 1e-6 )
  lik1 <- mod2$objective
  r1 <- mod1$maximum   ;   r2 <- mod2$maximum

  down <- 1 + r1^2 - 2 * r1 * as.vector( y1 %*% mu)
  mu1 <- Rfast::eachcol.apply(r1 * y1, down, oper = "/")
  down <- 1 + r2^2 - 2 * r2 * as.vector( y2 %*% mu)
  mu2 <- Rfast::eachcol.apply(r2 * y2, down, oper = "/")
  mu <- mu1 + mu2
  mu <- mu / sqrt( sum(mu^2) )
  a1 <- as.vector(y1 %*% mu)
  a2 <- as.vector(y2 %*% mu)

  mod1 <- optimize( pk1, c(0, 1), r2 = r2, a1 = a1, a2 = a2, n1 = n1, n2 = n2, d = d,
                    maximum = TRUE, tol = 1e-6 )
  mod2 <- optimize( pk2, c(0, 1), r1 = mod1$maximum, a1 = a1, a2 = a2, n1 = n1, n2 = n2, d = d,
                    maximum = TRUE, tol = 1e-6 )
  lik2 <- mod2$objective
  r1 <- mod1$maximum   ;   r2 <- mod2$maximum

  while ( abs( lik2 - lik1 ) > tol ) {
    lik1 <- lik2
    down <- 1 + r1^2 - 2 * r1 * as.vector( y1 %*% mu)
    mu1 <- Rfast::eachcol.apply(r1 * y1, down, oper = "/")
    down <- 1 + r2^2 - 2 * r2 * as.vector( y2 %*% mu)
    mu2 <- Rfast::eachcol.apply(r2 * y2, down, oper = "/")
    mu <- mu1 + mu2
    mu <- mu / sqrt( sum(mu^2) )
    a1 <- as.vector(y1 %*% mu)
    a2 <- as.vector(y2 %*% mu)

    mod1 <- optimize( pk1, c(0, 1), r2 = r2, a1 = a1, a2 = a2, n1 = n1, n2 = n2, d = d,
                      maximum = TRUE, tol = 1e-6 )
    mod2 <- optimize( pk2, c(0, 1), r1 = mod1$maximum, a1 = a1, a2 = a2, n1 = n1, n2 = n2, d = d,
                      maximum = TRUE, tol = 1e-6 )
    lik2 <- mod2$objective
    r1 <- mod1$maximum   ;   r2 <- mod2$maximum
  }

  n <- n1 + n2
  list(mu = mu, rho1 = r1, rho2 = r2, loglik = lik2 + n * lgamma(0.5 * d) - n * 0.5 * d * log(pi) - n * log(2) )
}
