## The following functions adapted from the RcmdrPlugin.survival package

unfold <- function (data, time, event, cov, cov.names = paste("covariate", 
                                                    ".", 1:ncovs, sep = ""), suffix = ".time", cov.times = 0:ncov, 
          common.times = TRUE, lag = 0, show.progress = TRUE) 
{
    ##  Arguments:
    ##  data: A data frame or numeric matrix (with column names) to be `unfolded.'
    ##      For reasons of efficiency, if there are factors in data these will be
    ##      converted to numeric variables in the output data frame.
    ##  time: The quoted name of the event/censoring-time variable in data.
    ##  event: The quoted name of the event/censoring-indicator variable in data.
    ##  cov: A vector giving the column numbers of the time-dependent covariate
    ##      in data, or a list of vectors if there is more than one time-varying
    ##      covariate.
    ##  cov.names: A character string or character vector giving the name or names
    ##      to be assigned to the time-dependent covariate(s) in the output data set.
    ##  suffix: The suffix to be attached to the name of the time-to-event variable
    ##      in the output data setl defaults to '.time'.
    ##  cov.times: The observation times for the covariate values, including the start
    ##      time. This argument can take several forms:
    ##      *   The default is integers from 0 to the number of covariate values (i.e.,
    ##              one more than the length of each vector in cov).
    ##      *   An arbitrary numerical vector with one more entry than the length of each
    ##      *       vector in cov.
    ##      *   The columns in the input data set that give the observations times for each
    ##              individual. There should be one more column than the length of each
    ##              vector in cov.
    ##      *   common.times: A logical value indicating whether the times of observation
    ##              are the same for all individuals; defaults to TRUE.
    ##  lag: Number of observation periods to lag each value of the time-varying
    ##              covariate(s); defaults to 0.
    ##  show.progress: Show a progress bar; defaults to TRUE.
    vlag <- function(x, lag) c(rep(NA, lag), x[1:(length(x) - 
                                                      lag)])
    xlag <- function(x, lag) apply(as.matrix(x), 2, vlag, lag = lag)
    all.cov <- unlist(cov)
    if (!is.numeric(all.cov)) 
        all.cov <- which(is.element(names(data), all.cov))
    if (!is.list(cov)) 
        cov <- list(cov)
    ncovs <- length(cov)
    nrow <- nrow(data)
    ncol <- ncol(data)
    ncov <- length(cov[[1]])
    nobs <- nrow * ncov
    if (length(unique(c(sapply(cov, length), length(cov.times) - 
                            1))) > 1) 
        stop(paste("all elements of cov must be of the same length and \n", 
                   "cov.times must have one more entry than each element of cov."))
    var.names <- names(data)
    subjects <- rownames(data)
    omit.cols <- if (!common.times) 
        c(all.cov, cov.times)
    else all.cov
    keep.cols <- (1:ncol)[-omit.cols]
    factors <- names(data)[keep.cols][sapply(data[keep.cols], 
                                             is.factor)]
    levels <- lapply(data[factors], levels)
    first.covs <- sapply(cov, function(x) x[1])
    factors.covs <- which(sapply(data[first.covs], is.factor))
    levels.covs <- lapply(data[names(factors.covs)], levels)
    nkeep <- length(keep.cols)
    if (is.numeric(event)) 
        event <- var.names[event]
    events <- sort(unique(data[[event]]))
    if (length(events) > 2 || (!is.numeric(events) && !is.logical(events))) 
        stop("event indicator must have values {0, 1}, {1, 2} or {FALSE, TRUE}")
    if (!(all(events == 0:1) || all(events == c(FALSE, TRUE)))) {
        if (all(events = 1:2)) 
            data[[event]] <- data[[event]] - 1
        else stop("event indicator must have values {0, 1}, {1, 2} or {FALSE, TRUE}")
    }
    times <- if (common.times) 
        matrix(cov.times, nrow, ncov + 1, byrow = TRUE)
    else data[, cov.times]
    new.data <- matrix(Inf, nobs, 3 + ncovs + nkeep)
    rownames <- rep("", nobs)
    colnames(new.data) <- c("start", "stop", paste(event, suffix, 
                                                   sep = ""), var.names[-omit.cols], cov.names)
    end.row <- 0
    if (show.progress) {
        progress <- myTkProgressBar(title = "Progress", label = "", 
                                    min = 0, max = 1, initial = 0, width = 300)
        position <- "-20+20"
        tkwm.geometry(progress$window, position)
    }
    data <- as.matrix(as.data.frame(lapply(data, as.numeric)))
    for (i in 1:nrow) {
        if (show.progress) {
            info <- sprintf("%d%% percent done", round(100 * 
                                                           i/nrow))
            setTkProgressBar(progress, value = i/nrow, label = info)
        }
        start.row <- end.row + 1
        end.row <- end.row + ncov
        start <- times[i, 1:ncov]
        stop <- times[i, 2:(ncov + 1)]
        event.time <- ifelse(stop == data[i, time] & data[i, 
                                                          event] == 1, 1, 0)
        keep <- matrix(data[i, -omit.cols], ncov, nkeep, byrow = TRUE)
        select <- apply(matrix(!is.na(data[i, all.cov]), ncol = ncovs), 
                        1, all)
        rows <- start.row:end.row
        cov.mat <- xlag(matrix(data[i, all.cov], nrow = length(rows)), 
                        lag)
        new.data[rows[select], ] <- cbind(start, stop, event.time, 
                                          keep, cov.mat)[select, ]
        rownames[rows] <- paste(subjects[i], ".", seq(along = rows), 
                                sep = "")
    }
    row.names(new.data) <- rownames
    new.data <- as.data.frame(new.data[new.data[, 1] != Inf & 
                                           apply(as.matrix(!is.na(new.data[, cov.names])), 1, all), 
                                       ])
    for (fac in factors) {
        new.data[[fac]] <- factor(levels[[fac]][new.data[[fac]]])
    }
    fcv <- 0
    for (cv in factors.covs) {
        fcv <- fcv + 1
        new.data[[cov.names[cv]]] <- factor(levels.covs[[fcv]][new.data[[cov.names[cv]]]])
    }
    attr(new.data, "time1") <- "start"
    attr(new.data, "time2") <- "stop"
    attr(new.data, "event") <- paste(event, suffix, sep = "")
    close(progress)
    new.data
}

myTkProgressBar <-
    function (title = "R progress bar", label = "", min = 0, max = 1, 
              initial = 0, width = 300) 
    {
        useText <- FALSE
        have_ttk <- require("tcltk") && as.character(tcl("info", "tclversion")) >= "8.5"
        if (!have_ttk && as.character(tclRequire("PBar")) == "FALSE") 
            useText <- TRUE
        .win <- tktoplevel()
        .val <- initial
        .killed <- FALSE
        tkwm.geometry(.win, sprintf("%dx80", width + 40))
        tkwm.title(.win, title)
        if (useText) {
            .lab <- tklabel(.win, text = label, padx = 20)
            tkpack(.lab, side = "left")
            fn2 <- tkfont.create(family = "helvetica", size = 16)
            .vlab <- tklabel(.win, text = "0%", font = fn2, padx = 20)
            tkpack(.vlab, side = "right")
            up <- function(value) {
                if (!is.finite(value) || value < min || value > max) 
                    return()
                .val <<- value
                tkconfigure(.vlab, text = sprintf("%d%%", round(100 * 
                                                                    (value - min)/(max - min))))
            }
        }
        else {
            .lab <- tklabel(.win, text = label, pady = 10)
            .tkval <- tclVar(0)
            tkpack(.lab, side = "top")
            tkpack(tklabel(.win, text = ""), side = "bottom")
            pBar <- if (have_ttk) 
                ttkprogressbar(.win, length = width, variable = .tkval)
            else tkwidget(.win, "ProgressBar", width = width, variable = .tkval)
            tkpack(pBar, side = "bottom")
            up <- function(value) {
                if (!is.finite(value) || value < min || value > max) 
                    return()
                .val <<- value
                tclvalue(.tkval) <<- 100 * (value - min)/(max - min)
            }
        }
        getVal <- function() .val
        kill <- function() if (!.killed) {
            tkdestroy(.win)
            .killed <<- TRUE
        }
        title <- function(title) tkwm.title(.win, title)
        lab <- function(label) tkconfigure(.lab, text = label)
        tkbind(.win, "<Destroy>", kill)
        up(initial)
        structure(list(getVal = getVal, up = up, title = title, label = lab, 
                       kill = kill, window=.win), class = "tkProgressBar")
    }