R/lgOR.vcov.R

Defines functions lgOR.vcov

Documented in lgOR.vcov

lgOR.vcov <- function(r, nt, nc, st, sc, n_rt = NA, n_rc = NA){
  ft <- nt - st
  fc <- nc - sc
  if (length(as.vector(ft)) == length(as.matrix(ft)[, 1])) {
    colum.number <- 1} else { colum.number <- ncol(ft)}

  if (length(as.vector(ft)) == length(as.matrix(ft)[, 1])) {
    K <- length(ft)} else { K <- nrow(ft)}
  col.vac.number <- (colum.number + 1)*colum.number/2

  if (is.na(n_rt)&(length(n_rt) == 1)){
    n_rt <- rep(list(matrix(NA, colum.number, colum.number)), K) }

  for (k in 1:K) {
    for (i in 1:colum.number){
      for (j in 1:colum.number){
        if (is.na(n_rt[[k]][i, j]))
          n_rt[[k]][i, j] <- min(nt[k, i], nt[k, j])
      }
    }
  }

  if (is.na(n_rc)&(length(n_rc) == 1)){
    n_rc <- rep(list(matrix(NA, colum.number, colum.number)), K) }

  for (k in 1:K) {
    for (i in 1:colum.number){
      for (j in 1:colum.number){
        if (is.na(n_rc[[k]][i, j]))
          n_rc[[k]][i, j] <- min(nc[k, i], nc[k, j])
      }
    }
  }

  list.corr.st.varcovar <- list()
  for (k in 1:K){
    list.corr.st.varcovar[[k]] <- matrix(NA, colum.number, colum.number)
    for (i in 1:colum.number){
      for (j in 1:colum.number)
      {tmp <- r[[k]][i, j]*n_rc[[k]][i, j]*sqrt((1/sc[k, i] +
                  1/fc[k, i])*(1/sc[k, j] + 1/fc[k, j]))/sqrt(nc[k, i]*nc[k, j]) +
                   r[[k]][i, j]*n_rt[[k]][i, j]*sqrt((1/st[k, i] + 1/ft[k, i])*(1/st[k, j] +
                    1/ft[k, j]))/sqrt(nt[k, i]*nt[k, j])
      list.corr.st.varcovar[[k]][i, j] <- unlist(tmp)
      }
    }
  }
  corr.st.varcovar <- matrix(unlist(lapply(1:K,function(k){
               smTovec(list.corr.st.varcovar[[k]])})), K, col.vac.number, byrow = TRUE)
  lgOR <- matrix(NA, K, colum.number)
  for (k in 1:K) {
    for (i in 1:colum.number){
      lgOR[k, i] <- unlist(log((st[k, i]/ft[k, i])/(sc[k, i]/fc[k, i])))
    }}
  list(list.vcov = list.corr.st.varcovar,
       matrix.vcov = corr.st.varcovar,
       ef = as.data.frame(lgOR))
}

Try the metavcov package in your browser

Any scripts or data that you put into this service are public.

metavcov documentation built on July 9, 2023, 7:11 p.m.