amen (version 1.0)

rUV_fc: Gibbs sampling of U and V

Description

A Gibbs sampler for updating the multiplicative effect matrices U and V

Usage

rUV_fc(E, U, V, rho, s2 = 1)

Arguments

E

square residual relational matrix

U

current value of U

V

current value of V

rho

dyadic correlation

s2

dyadic variance

Value

• U
  a new value of U
• V
  a new value of V

Examples

## The function is currently defined as
function (E, U, V, rho, s2 = 1)
{
    R <- ncol(U)
    UV <- cbind(U, V)
    Suv <- solve(rwish(solve(diag(nrow = ncol(UV)) + t(UV) %*%
        UV), 2 + nrow(UV) + ncol(UV)))
    Se <- matrix(c(1, rho, rho, 1), 2, 2) * s2
    iSe2 <- mhalf(solve(Se))
    g <- iSe2[1, 1]
    d <- iSe2[1, 2]
    for (r in sample(1:R)) {
        Er <- E - U[, -r] %*% t(V[, -r])
        Es <- (g^2 + d^2) * Er + 2 * g * d * t(Er)
        vr <- V[, r]
        b0 <- c(Suv[r, -r] %*% solve(Suv[-r, -r]))
        v0 <- c(Suv[r, r] - b0 %*% Suv[-r, r])
        m0 <- cbind(U[, -r], V) %*% b0
        ssv <- max(sum(vr^2), 1e-06)
        a <- (g^2 + d^2) * ssv + 1/v0
        c <- -2 * g * d/(a^2 + a * 2 * g * d * ssv)
        Esv <- Es %*% vr
        m1 <- Esv/a + c * vr * sum((Esv + m0/v0) * vr) + m0/(a *
            v0)
        ah <- sqrt(1/a)
        bh <- (sqrt(1/a + ssv * c) - sqrt(1/a))/ssv
        e <- rnorm(nrow(E))
        U[, r] <- m1 + ah * e + bh * vr * sum(vr * e)
        ur <- U[, r]
        rv <- R + r
        b0 <- c(Suv[rv, -rv] %*% solve(Suv[-rv, -rv]))
        v0 <- c(Suv[rv, rv] - b0 %*% Suv[-rv, rv])
        m0 <- cbind(U, V[, -r]) %*% b0
        ssu <- max(sum(ur^2), 1e-06)
        a <- (g^2 + d^2) * ssu + 1/v0
        c <- -2 * g * d/(a^2 + a * 2 * g * d * ssu)
        tEsu <- t(Es) %*% ur
        m1 <- tEsu/a + c * ur * sum((tEsu + m0/v0) * ur) + m0/(a *
            v0)
        ah <- sqrt(1/a)
        bh <- (sqrt(1/a + ssu * c) - sqrt(1/a))/ssu
        e <- rnorm(nrow(E))
        V[, r] <- m1 + ah * e + bh * ur * sum(ur * e)
    }
    list(U = U, V = V)
  }