amen (version 1.0)

rZ_frn_fc: Simulate Z given fixed rank nomination data

Description

Simulates a random latent matrix Z given its expectation, dyadic correlation and fixed rank nomination data

Usage

rZ_frn_fc(Z, EZ, rho, Y, YL, odmax, odobs)

Arguments

Z

a square matrix, the current value of Z

EZ

expected value of Z

rho

dyadic correlation

Y

square matrix of ranked nomination data

YL

list of ranked individuals, from least to most preferred in each row

odmax

a scalar or vector giving the maximum number of nominations for each individual

odobs

observed outdegree

Value

• a square matrix, the new value of Z

Details

simulates Z under the constraints (1) Y[i,j]>Y[i,k] => Z[i,j]>Z[i,k] , (2) Y[i,j]>0 => Z[i,j]>0 , (3) Y[i,j]=0 & odobs[i] Z[i,j]

Examples

## The function is currently defined as
function (Z, EZ, rho, Y, YL, odmax, odobs)
{
    sz <- sqrt(1 - rho^2)
    ut <- upper.tri(Z)
    lt <- lower.tri(Z)
    rws <- outer(1:nrow(Z), rep(1, nrow(Z)))
    for (y in sample(c(0:ncol(YL)))) {
        if (y < 2) {
            if (y == 0) {
                lbm <- rep(-Inf, nrow(Z))
            }
            if (y == 1) {
                lbm <- pmax(0, apply(Z - (Y != 0) * (Inf^(Y !=
                  0)), 1, max, na.rm = TRUE))
            }
        }
        if (y >= 2) {
            lbm <- Z[cbind(1:nrow(Z), YL[, y - 1])]
        }
        if (y < ncol(YL)) {
            ubm <- Z[cbind(1:nrow(Z), YL[, y + 1])]
        }
        if (y == 0) {
            ubm[odobs < odmax] <- 0
        }
        if (y == ncol(YL)) {
            ubm <- rep(Inf, nrow(Z))
        }
        ubm[is.na(ubm)] <- Inf
        lbm[is.na(lbm)] <- -Inf
        for (k in sample(1:2)) {
            if (k == 1) {
                up <- ut & Y == y
                rwb <- rws[up]
                lb <- lbm[rwb]
                ub <- ubm[rwb]
                ez <- EZ[up] + rho * (t(Z)[up] - t(EZ)[up])
                Z[up] <- ez + sz * qnorm(runif(sum(up), pnorm((lb -
                  ez)/sz), pnorm((ub - ez)/sz)))
            }
            if (k == 2) {
                up <- lt & Y == y
                rwb <- rws[up]
                lb <- lbm[rwb]
                ub <- ubm[rwb]
                ez <- EZ[up] + rho * (t(Z)[up] - t(EZ)[up])
                Z[up] <- ez + sz * qnorm(runif(sum(up), pnorm((lb -
                  ez)/sz), pnorm((ub - ez)/sz)))
            }
        }
    }
    diag(Z) <- rnorm(nrow(Z), diag(EZ), 1)
    Z
  }