EpiModel / CombPrevNet

The Role of HIV Partner Services in the Modern Biomedical HIV Prevention Era
GNU General Public License v3.0
2 stars 0 forks source link

Failure to update plist for edges dropped in mod.departure #51

Closed adam-s-elder closed 3 years ago

adam-s-elder commented 3 years ago

Currently in EpiModel, the plist is updated at every step. In particular, the time at which a relationship ends will be recorded based on results of a call to tergmLite::simulate_network. Unless specified otherwise, code comes from here: https://github.com/EpiModel/EpiModelHIV-p/blob/CombPrev/R/mod.simnet.R

dat$el[[1]] <- tergmLite::simulate_network(p = dat$p[[1]],
                                             el = dat$el[[1]],
                                             coef.form = nwparam.m$coef.form,
                                             coef.diss = nwparam.m$coef.diss$coef.adj,
                                             save.changes = TRUE)

plist1 <- update_plist(dat, at, ptype = 1)

Thus, the entries in plist that are assigned are based on the updated edgelist (specifically the "changes" attribute of the dat$el[[ptype]] object):

update_plist <- function(dat, at, ptype) {
  # pull existing partner type specific list
  plist1 <- dat$temp$plist[dat$temp$plist[, "ptype"] == ptype, ]

  # look up dissolutions, update stop time
  uid <- dat$attr$uid
  news <- attr(dat$el[[ptype]], "changes")
  news_uid <- cbind(matrix(uid[news[, 1:2]], ncol = 2), news[, 3])
  news_uid_stop <- news_uid[news_uid[, 3] == 0, , drop = FALSE]
  pid_plist1 <- plist1[, 1]*1e7 + plist1[, 2]
  pid_stop <- news_uid_stop[, 1]*1e7 + news_uid_stop[, 2]
  matches_stop <- match(pid_stop, pid_plist1)
  plist1[matches_stop, "stop"] <- at

  # look up new formations, row bind them
  news_uid_start <- news_uid[news_uid[, 3] == 1, , drop = FALSE]
  plist1 <- rbind(plist1, cbind(news_uid_start[, 1:2, drop = FALSE], ptype, at, NA))

  return(plist1)
}

Then, the plist is updated latter on by dropping those who's relationships have stopped:

  if (dat$control$truncate.plist == TRUE) {
    to.keep <- which(is.na(dat$temp$plist[, "stop"]))
    dat$temp$plist <- dat$temp$plist[to.keep, ]
  }

However, this method for dropping individuals from the plist fails to drop relationships that are ended by an ego exiting the population (I think). Code in the mod.departure script drops edges:

  if (length(idsDepAll) > 0) {
    dat$attr$active[idsDepAll] <- 0
    for (i in 1:3) {
      dat$el[[i]] <- tergmLite::delete_vertices(dat$el[[i]], idsDepAll)
    }
    dat$attr <- deleteAttr(dat$attr, idsDepAll)
    if (unique(sapply(dat$attr, length)) != attributes(dat$el[[1]])$n) {
      stop("mismatch between el and attr length in departures mod")
    }
  }

However, I don't think these changes are stored in the dat$el[[ptype]] changes attribute as a result, these relationships stored in the plist will never be assigned a date for the relationship ending, and thus the will never be dropped from the plist.

I am not sure how important this is to anyone else, or how clear this is. If anyone has questions, just let me know. Thanks!

smjenness commented 3 years ago

@andsv2 : please look into whether this issue affects our current work on the CombPrevNet branch.

andsv2 commented 3 years ago

@smjenness : this does not impact CombPrevNet as only partnerships containing active individuals are filtered down into partner identification. Having said that, this is probably something that should be investigated in general.

smjenness commented 3 years ago

@andsv2 : Ok, but for safety I think this needs to be handled more consistently. Because currently, these rows on the plist will never get a stop time recorded, and so they will never be truncated. So instead, I would like: If anyone on the plist dies, the stop time for the partnership should get recorded, just as it does if the edge dissolves naturally. Then, when it comes time to truncate the plist, it should be done the same way for all rows (if at - stop > truncate time). Ok?

smjenness commented 3 years ago

Closed by #44