R/vertical_2party_logistic.R

Defines functions PartyBProcess2Logistic PartyAProcess2Logistic GetResultsLogistic.B2 ComputeResultsLogistic.A2 GetFinalCoefLogistic.B2 GetConvergedStatusLogistic.B2 GetCoefLogistic.A2 GetCoefLogistic.B2 GetIILogistic.A2 GetVLogistic.B2 GetWeightsLogistic.A2 GetXBetaLogistic.B2 UpdateDataLogistic.B2 UpdateParamsLogistic.B2 ComputeInitialBetasLogistic.A2 UpdateDataLogistic.A2 CheckColinearityLogistic.A2 GetWLogistic.B2 PrepareBlocksLogistic.B2 FinalizeParamsLogistic.B2 GetZLogistic.A2 PrepareBlocksLogistic.A2 PrepareParamsLogistic.A2 PrepareParamsLogistic.B2 PrepareDataLogistic.B23 PrepareDataLogistic.A23 PrepareFolderLogistic.B2 PrepareFolderLogistic.A2

################### DISTRIBUTED LOGISTIC REGRESSION FUNCTIONS ##################

PrepareFolderLogistic.A2 = function(params, monitorFolder) {
  if (params$trace) cat(as.character(Sys.time()), "PrepareFolderLogistic.A2\n\n")
	params$dplocalPath   = file.path(monitorFolder, "dplocal")
	params$rprogramsPath = file.path(monitorFolder, "rprograms")
	params$macrosPath    = file.path(monitorFolder, "macros")
	params$writePath     = file.path(monitorFolder, "inputfiles")
	params$readPath      = file.path(monitorFolder, "msoc1")

	if (is.null(monitorFolder)) {
	  warning("monitorFolder must be specified.  Please use the same monitorFolder as the DataMart Client.")
	  params$failed = TRUE
	  return(params)
	}
	if (class(monitorFolder) != "character") {
	  warning("monitorFolder directory is not valid.  Please use the same monitorFolder as the DataMart Client.")
	  params$failed = TRUE
	  return(params)
	}
	while (!dir.exists(monitorFolder)) {
	  Sys.sleep(1)
	}
	params$errorMessage = NULL
	if (!CreateIOLocation(monitorFolder, "dplocal")) {
		params$failed = TRUE
		params$errorMessage = paste(params$errorMessage,
																"Could not create directory",
																paste0(params$dplocalPath, "."),
																"Check the path and restart the program.")
	}
	if (!CreateIOLocation(monitorFolder, "rprograms")) {
		params$failed = TRUE
		params$errorMessage = paste(params$errorMessage,
																"Could not create directory",
																paste0(params$rprogramsPath, "."),
																"Check the path and restart the program.")
	}
	if (!CreateIOLocation(monitorFolder, "macros")) {
		params$failed = TRUE
		params$errorMessage = paste(params$errorMessage,
																"Could not create directory",
																paste0(params$macrosPath, "."),
																"Check the path and restart the program.")
	}
	if (!CreateIOLocation(monitorFolder, "inputfiles")) {
		params$failed = TRUE
		params$errorMessage = paste(params$errorMessage,
																"Could not create directory",
																paste0(params$writePath, "."),
																"Check the path and restart the program.")
	}
	if (!CreateIOLocation(monitorFolder, "msoc1")) {
		params$failed = TRUE
		params$errorMessage = paste(params$errorMessage,
																"Could not create directory",
																paste0(params$readPath, "."),
																"Check the path and restart the program.")
	}

	params = AddToLog(params, "PrepareDataLogistic.A23, PrepareFolderLogistic.A2", 0, 0, 0, 0)
	return(params)
}


PrepareFolderLogistic.B2 = function(params, monitorFolder) {
  if (params$trace) cat(as.character(Sys.time()), "PrepareFolderLogistic.B2\n\n")

	params$dplocalPath   = file.path(monitorFolder, "dplocal")
	params$rprogramsPath = file.path(monitorFolder, "rprograms")
	params$macrosPath    = file.path(monitorFolder, "macros")
	params$writePath     = file.path(monitorFolder, "msoc")
	params$readPath      = file.path(monitorFolder, "inputfiles")

	if (is.null(monitorFolder)) {
	  warning("monitorFolder must be specified.  Please use the same monitorFolder as the DataMart Client.")
	  params$failed = TRUE
	  return(params)
	}
	if (class(monitorFolder) != "character") {
	  warning("monitorFolder directory is not valid.  Please use the same monitorFolder as the DataMart Client.")
	  params$failed = TRUE
	  return(params)
	}
	while (!dir.exists(monitorFolder)) {
	  Sys.sleep(1)
	}
	params$errorMessage = NULL
	if (!CreateIOLocation(monitorFolder, "dplocal")) {
		params$failed = TRUE
		params$errorMessage = paste(params$errorMessage,
																"Could not create directory",
																paste0(params$dplocalPath, "."),
																"Check the path and restart the program.")
	}
	if (!CreateIOLocation(monitorFolder, "rprograms")) {
		params$failed = TRUE
		params$errorMessage = paste(params$errorMessage,
																"Could not create directory",
																paste0(params$rprogramsPath, "."),
																"Check the path and restart the program.")
	}
	if (!CreateIOLocation(monitorFolder, "macros")) {
		params$failed = TRUE
		params$errorMessage = paste(params$errorMessage,
																"Could not create directory",
																paste0(params$macrosPath, "."),
																"Check the path and restart the program.")
	}
	if (!CreateIOLocation(monitorFolder, "msoc")) {
		params$failed = TRUE
		params$errorMessage = paste(params$errorMessage,
																"Could not create directory",
																paste0(params$writePath, "."),
																"Check the path and restart the program.")
	}
	if (!CreateIOLocation(monitorFolder, "inputfiles")) {
		params$failed = TRUE
		params$errorMessage = paste(params$errorMessage,
																"ould not create directory",
																paste0(params$readPath, "."),
																"Check the path and restart the program.")
	}

	Sys.sleep(1)
	DeleteTrigger("files_done.ok", params$readPath)

	params = AddToLog(params, "PrepareDataLogisitc.B23, PrepareFolderLogistic.B2", 0, 0, 0, 0)

	return(params)
}


PrepareDataLogistic.A23 = function(params, data, yname = NULL) {
  if (params$trace) cat(as.character(Sys.time()), "PrepareDataLogistic.A23\n\n")

  workdata = list()
  workdata$failed = FALSE

  workdata$failed = CheckDataFormat(params, data)

  if (workdata$failed) {
    return(workdata)
  }

  data = data.frame(data) # convert to a clean data.frame

  responseIndex = CheckResponse(params, data, yname)

  if (is.null(responseIndex)) {
    workdata$failed = TRUE
    return(workdata)
  }
  covariateIndex = setdiff(1:ncol(data), responseIndex)
  workdata$tags = CreateModelMatrixTags(data[, covariateIndex, drop = FALSE])
  workdata$tags = c("(Intercept)", workdata$tags)
  names(workdata$tags)[1] = "numeric"

  X = model.matrix(~ ., data[, c(responseIndex, covariateIndex), drop = FALSE])
  rownames(X) = NULL
  covariateIndex = setdiff(1:ncol(X), 2)

  means = apply(X, 2, mean)
  sd    = apply(X, 2, sd)
  sd    = sapply(sd, function(x) { ifelse(x > 0, x, 1)})
  workdata$Y      = X[, 2, drop = FALSE]
  workdata$X      = X[, covariateIndex, drop = FALSE]
  # workdata$meansy = means[2]
  # workdata$sdy    = sd[2]
  workdata$means  = means[covariateIndex]
  workdata$sd     = sd[covariateIndex]
  workdata$yty    = t(workdata$Y) %*% workdata$Y

  # workdata$Y      = (workdata$Y - workdata$meansy) / workdata$sdy

  if (ncol(workdata$X) >= 2) {
    for (i in 2:ncol(workdata$X)) {
      workdata$X[, i] = (workdata$X[, i] - workdata$means[i]) / workdata$sd[i]
    }
  }

  return(workdata)
}

PrepareDataLogistic.B23 = function(params, data) {
  if (params$trace) cat(as.character(Sys.time()), "PrepareDataLogistic.B23\n\n")

  workdata = list()
  workdata$failed = FALSE

  workdata$failed = CheckDataFormat(params, data)

  if (workdata$failed) {
    return(workdata)
  }

  data = data.frame(data) # convert to a clean data.frame

  workdata$tags = CreateModelMatrixTags(data)
  if (ncol(data) < 2 | !("numeric" %in% names(workdata$tags))) {
    warning("The data partner that does not have the response must have at least 2 covariates at least one of which must be numeric.")
    workdata$failed = TRUE
    return(workdata)
  }
  workdata$X = model.matrix(~ ., data)
  rownames(workdata$X) = NULL
  workdata$X = workdata$X[, -1, drop = FALSE]
  workdata$means = apply(workdata$X, 2, mean)
  workdata$sd    = apply(workdata$X, 2, sd)
  workdata$sd    = sapply(workdata$sd, function(x) { ifelse(x > 0, x, 1)})

  for (i in 1:ncol(workdata$X)) {
    workdata$X[, i] = (workdata$X[, i] - workdata$means[i]) / workdata$sd[i]
  }


  return(workdata)
}

PrepareParamsLogistic.B2 = function(params, data) {
  if (params$trace) cat(as.character(Sys.time()), "PrepareParamsLogistic.B2\n\n")
  params$failed         = FALSE
  params$converged      = FALSE
  params$halted         = FALSE

  params$n             = nrow(data$X)
  params$numEvents     = 0
  params$p1            = 0
  params$p2            = ncol(data$X)
  params$p             = params$p1 + params$p2
  params$p1.old        = 0
  params$p2.old        = params$p2
  params$Acolnames     = c("")
  params$Bcolnames     = colnames(data$X)
  params$yname         = ""
  params$Acolnames.old = c("")
  params$Bcolnames.old = c("")
  params$cutoff        = 1
  params$maxIterations = 1

  params$meansA        = 0
  params$sdA           = 0
  params$meansB        = data$means
  params$sdB           = data$sd
  params$yty           = 0

  pb          = list()
  pb$p2       = params$p2
  pb$n        = params$n
  pb$means    = data$means
  pb$sd       = data$sd
  pb$analysis = params$analysis
  pb$Bcolnames = params$Bcolnames
  pb$tags      = data$tags

  writeTime = proc.time()[3]
  save(pb, file = file.path(params$writePath, "pb.rdata"))
  writeSize = sum(file.size(file.path(params$writePath, "pb.rdata")))
  writeTime = proc.time()[3] - writeTime
  params = AddToLog(params, "PrepareParamsLogistic.B2", 0, 0, writeTime, writeSize)
  return(params)
}


PrepareParamsLogistic.A2 = function(params, data, cutoff = 0.01, maxIterations = 25) {
  if (params$trace) cat(as.character(Sys.time()), "PrepareParamsLogistic.A2\n\n")

  params$converged       = FALSE
  params$halted          = FALSE
  params$pmnStepCounter  = 1
  pb                     = NULL

  readTime = proc.time()[3]
  load(file.path(params$readPath, "pb.rdata")) # load pb, Bcolnames
  readSize = sum(file.size(file.path(params$readPath, "pb.rdata")))
  readTime = proc.time()[3] - readTime

  if (params$analysis != pb$analysis) {
    params$errorMessage =
      paste("Party A is running", params$analysis, "regression and Party B is running", pb$analysis, "regression.")
    warning(params$errorMessage)
    params$failed = TRUE
    return(params)
  }

  params$n  = nrow(data$X)
  if (pb$n != params$n) {
    params$errorMessage =
      paste("Party A has", params$n, "observations and Party B has", pb$n, "observations.")
    warning(params$errorMessage)
    params$failed = TRUE
  }

  params$p1 = ncol(data$X)
  params$p2 = pb$p2
  params$p  = params$p1 + params$p2
  params$p1.old = params$p1
  params$p2.old = params$p2

  params$Acolnames = colnames(data$X)
  params$Bcolnames = pb$Bcolnames
  params$yname     = colnames(data$Y)
  params$Acolnames.old = c("")
  params$Bcolnames.old = c("")
  params$Atags         = data$tags
  params$Btags         = pb$tags

  if (cutoff <= 0) cutoff = 0.01
  if (cutoff >= 1) cutoff = 0.05
  params$cutoff           = cutoff

  if (maxIterations < 1) maxIterations = 1
  params$maxIterations = maxIterations

  params$meansA = data$means
  params$sdA    = data$sd
  params$meansB = pb$means
  params$sdB    = pb$sd
  params$yty    = data$yty

  pa               = list()
  pa$p1            = params$p1
  pa$means         = data$means
  pa$sd            = data$sd
  pa$yty           = data$yty
  pa$yname         = data$yname
  pa$cutoff        = params$cutoff
  pa$maxIterations = params$maxIterations
  pa$Acolnames     = params$Acolnames
  pa$tags          = data$tags

  writeTime = proc.time()[3]
  save(pa, file = file.path(params$writePath, "pa.rdata"))
  writeSize = sum(file.size(file.path(params$writePath, "pa.rdata")))
  writeTime = proc.time()[3] - writeTime
  params = AddToLog(params, "PrepareParamsLogistic.A2", readTime, readSize,
                    writeTime, writeSize)

  return(params)
}


PrepareBlocksLogistic.A2 = function(params, blocksize) {
  if (params$trace) cat(as.character(Sys.time()), "PrepareBlocksLogistic.A2\n\n")
  # For now, assuming that p1 > 0 and p2 > 0
  n  = params$n
  p1 = params$p1
  p2 = params$p2

  minimumBlocksize = GetBlockSize(p1, p2)
  if (n < minimumBlocksize) {
    maxACovariates = trunc(sqrt(p2 * n) - p2 - 1)

    params$errorMessage =
      paste("The minimum secure blocksize of", minimumBlocksize,
            "is larger than the number of observations", paste0(n, ".\n"),
            "Your options are:\n",
            "Increase the number of observations to at least",
            paste0(minimumBlocksize, ".\n"),
            "Decrease the number of A covariates to", maxACovariates, "or less.")

    b = n - 2 * p1 - 2
    discrim = b^2 - 4 * (p1 + 1)^2
    if (discrim >= 0) {
      minBCovariates = trunc(1 + (b - sqrt(discrim)) / 2)
      maxBCovariates = trunc((b + sqrt(discrim)) / 2)
      params$errorMessage =
        paste0(params$errorMessage,
               "\nSet the number of B covariates to be between ", minBCovariates, "and",
               paste0(maxBCovariates, "."))
    }
    warning(params$errorMessage)
    params$failed = TRUE
    params = AddToLog(params, "PrepareBlocksLogistic.A2", 0, 0, 0, 0)
    return(params)
  }

  if (is.null(blocksize)) {
    blocksize = minimumBlocksize
  }
  if (blocksize < minimumBlocksize) {
    message(paste("Block size of", blocksize,
                  "is too small. Proceeding with minimum blocksize of",
                  paste0(minimumBlocksize, ".")))
    blocksize = minimumBlocksize
  } else if (n < blocksize) {
    message(paste("Block size of", blocksize,
                  "is larger than size of data.  Proceeding with blocksize of",
                  paste0(n, ".")))
  }

  params$blocks    = CreateBlocks(p1, p2, n, blocksize)
  params$container = CreateContainers(p1, p2, params$blocks)
  writeTime = proc.time()[3]
  save(blocksize, file = file.path(params$writePath, "blocksize.rdata"))
  writeSize = file.size(file.path(params$writePath, "blocksize.rdata"))
  writeTime = proc.time()[3] - writeTime
  params = AddToLog(params, "PrepareBlocksLogistic.A2", 0, 0, writeTime, writeSize)
  return(params)
}


GetZLogistic.A2 = function(params, data) {
  if (params$trace) cat(as.character(Sys.time()), "GetZLogistic.A2\n\n")
  writeTime = 0
  writeSize = 0

  numBlocks = params$blocks$numBlocks
  pbar = MakeProgressBar1(numBlocks, "Z", params$verbose)
  containerCt.Z = 0
  for (i in 1:numBlocks) {
    if (i %in% params$container$filebreak.Z) {
      containerCt.Z = containerCt.Z + 1
      filename = paste0("cz_", containerCt.Z, ".rdata")
      toWrite = file(file.path(params$writePath, filename), "wb")
    }
    strt = params$blocks$starts[i]
    stp = params$blocks$stops[i]
    n = stp - strt + 1
    g = params$blocks$g[i]
    Z = FindOrthogonalVectors(cbind(data$Y[strt:stp, ], data$X[strt:stp, ]), g)

    writeTime = writeTime - proc.time()[3]
    writeBin(as.vector(Z), con = toWrite, endian = "little")
    writeTime = writeTime + proc.time()[3]
    if ((i + 1) %in% params$container$filebreak.Z || i == numBlocks) {
      close(toWrite)
      writeSize = writeSize + file.size(file.path(params$writePath, filename))
    }
    pbar = MakeProgressBar2(i, pbar, params$verbose)
  }
  params = AddToLog(params, "GetZLogistic.A2", 0, 0, writeTime, writeSize)
  return(params)
}


FinalizeParamsLogistic.B2 = function(params, data) {
  if (params$trace) cat(as.character(Sys.time()), "FinalizeParamsLogistic.B2\n\n")
  pa = NULL
  readTime = proc.time()[3]
  load(file.path(params$readPath, "pa.rdata")) # Load pa, Acolnames
  readSize = sum(file.size(file.path(params$readPath, "pa.rdata")))
  readTime = proc.time()[3] - readTime
  params$p1            = pa$p1
  params$p             = params$p1 + params$p2
  params$meansA        = pa$means
  params$sdA           = pa$sd
  params$yty           = pa$yty
  params$yname         = pa$yname
  params$cutoff        = pa$cutoff
  params$maxIterations = pa$maxIterations
  params$Acolnames     = pa$Acolnames
  params$Atags         = pa$tags
  params$Btags         = data$tags

  params = AddToLog(params, "FinalizeParamsLogistic.B2", readTime, readSize, 0, 0)
  return(params)
}


PrepareBlocksLogistic.B2 = function(params) {
  if (params$trace) cat(as.character(Sys.time()), "PrepareBlocksLogistic.B2\n\n")
  blocksize = NULL
  # For now, assuming that p1 > 0 and p2 > 0
  readTime = proc.time()[3]
  load(file.path(params$readPath, "blocksize.rdata")) # load blocksize
  readSize = file.size(file.path(params$readPath, "blocksize.rdata"))
  readTime = proc.time()[3] - readTime
  params$blocks    = CreateBlocks(params$p1, params$p2, params$n, blocksize)
  params$container = CreateContainers(params$p1, params$p2, params$blocks)
  params = AddToLog(params, "PrepareBlocksLogistic.B2", readTime, readSize, 0, 0)
  return(params)
}


GetWLogistic.B2 = function(params, data) {
  if (params$trace) cat(as.character(Sys.time()), "GetWLogistic.B2\n\n")
  readTime  = 0
  readSize  = 0
  writeTime = 0
  writeSize = 0

  pbar = MakeProgressBar1(params$blocks$numBlocks, "(I-Z*Z')XB", params$verbose)

  XBTXB = t(data$X) %*% data$X

  containerCt.Z = 0
  containerCt.W = 0

  for (i in 1:params$blocks$numBlocks) {
    if (i %in% params$container$filebreak.Z) {
      containerCt.Z = containerCt.Z + 1
      filename1 = paste0("cz_", containerCt.Z, ".rdata")
      toRead = file(file.path(params$readPath, filename1), "rb")
      readSize = readSize + file.size(file.path(params$readPath, filename1))
    }
    if (i %in% params$container$filebreak.W) {
      containerCt.W = containerCt.W + 1
      filename2 = paste0("cw_", containerCt.W, ".rdata")
      toWrite = file(file.path(params$writePath, filename2), "wb")
    }
    strt = params$blocks$starts[i]
    stp = params$blocks$stops[i]
    n2 = stp - strt + 1
    g1 = params$blocks$g[i]

    readTime = readTime - proc.time()[3]
    Z = matrix(readBin(con = toRead, what = numeric(), n = n2 * g1,
                       endian = "little"), nrow = n2, ncol = g1)
    readTime = readTime + proc.time()[3]

    W = data$X[strt:stp, ] - Z %*% (t(Z) %*% data$X[strt:stp, ])

    writeTime = writeTime - proc.time()[3]
    writeBin(as.vector(W), con = toWrite, endian = "little")
    writeTime = writeTime + proc.time()[3]

    if ((i + 1) %in% params$container$filebreak.Z || i == params$blocks$numBlocks) {
      close(toRead)
    }
    if ((i + 1) %in% params$container$filebreak.W || i == params$blocks$numBlocks) {
      close(toWrite)
      writeSize = writeSize + file.size(file.path(params$writePath, filename2))
    }

    pbar = MakeProgressBar2(i, pbar, params$verbose)
  }

  writeTime = writeTime - proc.time()[3]
  save(XBTXB, file = file.path(params$writePath, "xbtxb.rdata"))
  writeSize = writeSize + file.size(file.path(params$writePath, "xbtxb.rdata"))
  writeTime = writeTime + proc.time()[3]

  params = AddToLog(params, "GetWLogistic.B2", readTime, readSize, writeTime, writeSize)

  return(params)
}


CheckColinearityLogistic.A2 = function(params, data) {
  if (params$trace) cat(as.character(Sys.time()), "CheckColinearityLogistic.A2\n\n")
  p2 = params$p2
  readTime  = 0
  readSize  = 0
  writeTime = 0
  writeSize = 0
  XBTXB     = NULL

  readTime = readTime - proc.time()[3]
  load(file.path(params$readPath, "xbtxb.rdata")) # load XBTXB
  readSize = file.size(file.path(params$readPath, "xbtxb.rdata"))
  readTime = readTime + proc.time()[3]
  XATXA = t(data$X) %*% data$X
  XATXB = 0
  XATY  = t(data$X) %*% data$Y
  YTXB  = 0

  pbar = MakeProgressBar1(params$blocks$numBlocks, "X'X", params$verbose)

  containerCt.W = 0
  for (i in 1:params$blocks$numBlocks) {
    if (i %in% params$container$filebreak.W) {
      containerCt.W = containerCt.W + 1
      filename = paste0("cw_", containerCt.W, ".rdata")
      toRead = file(file.path(params$readPath, filename), "rb")
    }
    strt = params$blocks$starts[i]
    stp = params$blocks$stops[i]
    n2 = stp - strt + 1

    readTime = readTime - proc.time()[3]
    W = matrix(readBin(con = toRead, what = numeric(), n = n2 * p2,
                       endian = "little"), nrow = n2, ncol = p2)
    readTime = readTime + proc.time()[3]

    XATXB = XATXB + t(data$X[strt:stp, ]) %*% W
    YTXB  = YTXB  + t(data$Y[strt:stp, ]) %*% W

    if ((i + 1) %in% params$container$filebreak.W || i == params$blocks$numBlocks) {
      close(toRead)
      readSize = readSize + file.size(file.path(params$readPath, filename))
    }
    pbar = MakeProgressBar2(i, pbar, params$verbose)
  }

  XTX = rbind(cbind(XATXA, XATXB), cbind(t(XATXB), XBTXB))
  XTY = rbind(XATY, t(YTXB))

  nrow = nrow(XTX)
  indicies = c(1)
  for (i in 2:nrow) {
  	tempIndicies = c(indicies, i)
  	if (rcond(XTX[tempIndicies, tempIndicies]) > 10^8 * .Machine$double.eps) {
  		indicies = c(indicies, i)
  	}
  }

  XTX = XTX[indicies, indicies]
  XTY = matrix(XTY[indicies], ncol = 1)

  Anames   = params$Acolnames
  Bnames   = params$Bcolnames
  Aindex   = which(indicies <= length(Anames))
  params$IndiciesKeep  = indicies
  params$AIndiciesKeep = indicies[Aindex]
  params$BIndiciesKeep = indicies[-Aindex] - length(Anames)

  AnamesKeep = Anames[params$AIndiciesKeep]
  BnamesKeep = Bnames[params$BIndiciesKeep]
  params$Acolnames.old = params$Acolnames
  params$Bcolnames.old = params$Bcolnames
  params$Acolnames     = AnamesKeep
  params$Bcolnames     = BnamesKeep
  params$p1.old        = params$p1
  params$p2.old        = params$p2
  params$p1            = length(AnamesKeep)
  params$p2            = length(BnamesKeep)
  params$p.old         = params$p1.old + params$p2.old
  params$p             = params$p1 + params$p2
  params$meansA        = params$meansA[params$AIndiciesKeep]
  params$meansB        = params$meansB[params$BIndiciesKeep]
  params$sdA           = params$sdA[params$AIndiciesKeep]
  params$sdB           = params$sdB[params$BIndiciesKeep]
  params$xtx           = XTX
  params$xty           = XTY

  Aindicies = params$AIndiciesKeep
  Bindicies = params$BIndiciesKeep

  writeTime = writeTime - proc.time()[3]
  save(Aindicies, Bindicies, file = file.path(params$writePath, "indicies.rdata"))
  writeSize = sum(file.size(file.path(params$writePath, "indicies.rdata")))
  writeTime = writeTime + proc.time()[3]

  tags = params$Btags[params$BIndiciesKeep]

  if (length(unique(tags)) < 2) {
    params$failed = TRUE
    params$errorMessage = "After removing colinear covariates, Party B has 1 or fewer covariates.\n\n"
  } else if (!("numeric" %in% names(tags))) {
    params$failed = TRUE
    params$errorMessage = "After removing colinear covariates, Party B has no continuous covariates.\n\n"
  }

  params = AddToLog(params, "CheckColinearityLogistic.A2", readTime, readSize, writeTime, writeSize)
  return(params)
}


UpdateDataLogistic.A2 = function(params, data) {
  if (params$trace) cat(as.character(Sys.time()), "UpdateDataLogistic.A2\n\n")
  data$X = as.matrix(data$X[, params$AIndiciesKeep, drop = FALSE])
  return(data)
}


ComputeInitialBetasLogistic.A2 = function(params, data) {
  if (params$trace) cat(as.character(Sys.time()), "ComputeInitialBetasLogistic.A2\n\n")
  # de-standardize xty
  p1     = params$p1
  p2     = params$p2
  xty    = params$xty
  xtx    = params$xtx

  betas = 4 * solve(xtx) %*% xty

  Abetas   = betas[1:p1]
  Bbetas   = betas[(p1 + 1):(p1 + p2)]
  Axty     = xty[1:p1]
  Bxty     = xty[(p1 + 1):(p1 + p2)]

  params$Axty      = Axty
  params$Bxty      = Bxty
  params$betas     = betas
  params$betasA    = Abetas
  params$betasAold = matrix(0, p1, 1)
  params$betasB    = Bbetas

  params$algIterationCounter      = 1
  params$deltabeta = Inf

  writeTime = proc.time()[3]
  save(Bbetas, Bxty, file = file.path(params$writePath, "Bbetas_xty.rdata"))
  writeSize = sum(file.size(file.path(params$writePath, "Bbetas_xty.rdata")))
  writeTime = proc.time()[3] - writeTime

  params = AddToLog(params, "ComputeInitialBetasLogistic.A2", 0, 0, writeTime, writeSize)

  return(params)
}


UpdateParamsLogistic.B2 = function(params) {
  if (params$trace) cat(as.character(Sys.time()), "UpdateParamsLogistic.B2\n\n")
  Aindicies = NULL
  Bindicies = NULL
  Bbetas    = NULL
  Bxty      = NULL
  readTime = proc.time()[3]
  load(file.path(params$readPath, "indicies.rdata")) # load Aindicies, Bindicies
  load(file.path(params$readPath, "Bbetas_xty.rdata"))     # Load Bbetas
  readSize = sum(file.size(file.path(params$readPath, c("indicies.rdata",
                                                        "Bbetas_xty.rdata"))))
  readTime = proc.time()[3] - readTime
  params$Acolnames.old = params$Acolnames
  params$Bcolnames.old = params$Bcolnames
  params$Acolnames     = params$Acolnames.old[Aindicies]
  params$Bcolnames     = params$Bcolnames.old[Bindicies]
  params$p1.old = params$p1
  params$p2.old = params$p2
  params$p1     = length(Aindicies)
  params$p2     = length(Bindicies)
  params$p.old  = params$p
  params$p      = params$p1 + params$p2
  params$BIndiciesKeep = Bindicies
  params$AIndiciesKeep = Aindicies
  params$betasB    = Bbetas
  params$betasBold = matrix(0, params$p2, 1)
  params$meansB = params$meansB[Bindicies]
  params$sdB    = params$sdB[Bindicies]
  params$Bxty   = Bxty
  params = AddToLog(params, "UpdateParamsLogistic.B2", readTime, readSize, 0, 0)
  return(params)
}


UpdateDataLogistic.B2 = function(params, data) {
  if (params$trace) cat(as.character(Sys.time()), "UpdateDataLogistic.B2\n\n")
  data$X = as.matrix(data$X[, params$BIndiciesKeep, drop = FALSE])
  return(data)
}


GetXBetaLogistic.B2 = function(params, data) {
  if (params$trace) cat(as.character(Sys.time()), "GetXBetaLogistic.B2\n\n")
  XbetaB = data$X %*% params$betasB

  writeTime = proc.time()[3]
  save(XbetaB, file = file.path(params$writePath, "xbetab.rdata"))
  writeSize = file.size(file.path(params$writePath, "xbetab.rdata"))
  writeTime = proc.time()[3] - writeTime

  params = AddToLog(params, "GetXBetaLogistic.B2", 0, 0, writeTime, writeSize)
  return(params)
}


GetWeightsLogistic.A2 = function(params, data) {
  if (params$trace) cat(as.character(Sys.time()), "GetWeightsLogistic.A2\n\n")
  n      = params$n
  p1     = params$p1
  XbetaB = NULL

  readTime = proc.time()[3]
  load(file.path(params$readPath, "xbetab.rdata"))  # Load XbetaB
  readSize = file.size(file.path(params$readPath, "xbetab.rdata"))
  readTime = proc.time()[3] - readTime

  XbetaA = data$X %*% params$betasA
  Xbeta = XbetaA + XbetaB
  pi_ = (1 + exp(-Xbeta))^(-1)
  params$pi_ = pi_

  writeTime = proc.time()[3]
  save(pi_, file = file.path(params$writePath, "pi_.rdata"))
  writeSize = file.size(file.path(params$writePath, "pi_.rdata"))
  writeTime = proc.time()[3] - writeTime
  params = AddToLog(params, "GetWeightsLogistic.A2", readTime, readSize, writeTime, writeSize)
  return(params)
}


GetVLogistic.B2 = function(params, data) {
  if (params$trace) cat(as.character(Sys.time()), "GetVLogistic.B2\n\n")
  pi_       = NULL
  writeTime = 0
  writeSize = 0
  readTime  = proc.time()[3]
  load(file.path(params$readPath, "pi_.rdata"))
  readSize  = file.size(file.path(params$readPath, "pi_.rdata"))
  readTime  = proc.time()[3] - readTime

  params$pi_ = pi_
  W = pi_ * (1 - params$pi_)

  XBTWXB = 0

  pbar = MakeProgressBar1(params$blocks$numBlocks, "(I - Z*Z')W*XB", params$verbose)

  containerCt.Z = 0
  containerCt.V = 0
  for (i in 1:params$blocks$numBlocks) {
    if (i %in% params$container$filebreak.Z) {
      containerCt.Z = containerCt.Z + 1
      filename1 = paste0("cz_", containerCt.Z, ".rdata")
      toRead = file(file.path(params$readPath, filename1), "rb")
    }
    if (i %in% params$container$filebreak.V) {
      containerCt.V = containerCt.V + 1
      filename2 = paste0("cv_", containerCt.V, ".rdata")
      toWrite = file(file.path(params$writePath, filename2), "wb")
    }
    strt = params$blocks$starts[i]
    stp = params$blocks$stops[i]
    n = stp - strt + 1
    g = params$blocks$g[i]

    Xblock  = data$X[strt:stp, ]
    Wblock  = W[strt:stp]
    WXblock = MultiplyDiagonalWTimesX(Wblock, Xblock)

    readTime = readTime - proc.time()[3]
    Z = matrix(readBin(con = toRead, what = numeric(), n = n * g,
                       endian = "little"), nrow = n, ncol = g)
    readTime = readTime + proc.time()[3]

    V = WXblock - Z %*% (t(Z) %*% WXblock)

    writeTime = writeTime - proc.time()[3]
    writeBin(as.vector(V), con = toWrite, endian = "little")
    writeTime = writeTime + proc.time()[3]

    XBTWXB = XBTWXB + t(Xblock) %*% WXblock
    if ((i + 1) %in% params$container$filebreak.Z || i == params$blocks$numBlocks) {
      close(toRead)
      readSize = readSize + file.size(file.path(params$readPath, filename1))
    }
    if ((i + 1) %in% params$container$filebreak.V || i == params$blocks$numBlocks) {
      close(toWrite)
      writeSize = writeSize + file.size(file.path(params$writePath, filename2))
    }
    pbar = MakeProgressBar2(i, pbar, params$verbose)
  }
  # sums of each column in WX_B
  sumsWXB = apply(MultiplyDiagonalWTimesX(W, data$X), 2, sum)
  # This information needs to be shared in order to get the intercept term

  writeTime = writeTime - proc.time()[3]
  save(sumsWXB, XBTWXB, file = file.path(params$writePath, "sumswx_xbtwxb.rdata"))
  writeSize = writeSize + sum(file.size(c(file.path(params$writePath, "sumswx_xbtwxb.rdata"))))
  writeTime = writeTime + proc.time()[3]

  params = AddToLog(params, "GetVLogistic.B2", readTime, readSize, writeTime, writeSize)
  return(params)
}


GetIILogistic.A2 = function(params, data) {
  if (params$trace) cat(as.character(Sys.time()), "GetIILogistic.A2\n\n")
  p1 = params$p1
  p2 = params$p2
  sumsWXB = NULL
  XBTWXB  = NULL

  writeTime = 0
  writeSize = 0
  readTime = proc.time()[3]
  load(file.path(params$readPath, "sumswx_xbtwxb.rdata")) # load sumsWXB, XBTWXB
  readSize = sum(file.size(file.path(params$readPath, "sumswx_xbtwxb.rdata")))
  readTime = proc.time()[3] - readTime

  params$sumsWXB = sumsWXB

  IA = params$Axty - t(data$X) %*% params$pi_
  W = params$pi_ * (1 - params$pi_)
  sumsWXA = apply(MultiplyDiagonalWTimesX(W, data$X), 2, sum)[-1]
  params$sumsWXA = sumsWXA

  XATWXA = t(data$X) %*% MultiplyDiagonalWTimesX(W, data$X)

  pbar = MakeProgressBar1(params$blocks$numBlocks, "X'W*X", params$verbose)

  XATWXB = 0
  containerCt.V = 0
  for (i in 1:params$blocks$numBlocks) {
    if (i %in% params$container$filebreak.V) {
      containerCt.V = containerCt.V + 1
      filename1 = paste0("cv_", containerCt.V, ".rdata")
      toRead = file(file.path(params$readPath, filename1), "rb")
      readSize = readSize + file.size(file.path(params$readPath, filename1))
    }
    strt = params$blocks$starts[i]
    stp = params$blocks$stops[i]
    n = stp - strt + 1

    readTime = readTime - proc.time()[3]
    V = matrix(readBin(con = toRead, what = numeric(),
                       n = n * p2, endian = "little"), n, p2)
    readTime = readTime + proc.time()[3]
    XATWXB = XATWXB + t(data$X[strt:stp, ]) %*% V

    pbar = MakeProgressBar2(i, pbar, params$verbose)
    if ((i + 1) %in% params$container$filebreak.V || i == params$blocks$numBlocks) {
      close(toRead)
    }
  }

  XTWX = rbind(cbind(XATWXA, XATWXB), cbind(t(XATWXB), XBTWXB))

  params$xtwx = XTWX

  II = NULL
  tryCatch({II = solve(params$xtwx)}, # dims are 1 + p1 + p2
           error = function(err) { II = NULL }
          )
  if (is.null(II)) {
    params$singularMatrix = TRUE
    params$failed = TRUE
    params$errorMessage =
      paste0("The matrix t(X)*W*X is not invertible.\n",
             "       This may be due to one of two possible problems.\n",
             "       1. Poor random initialization of the security vector.\n",
             "       2. Near multicollinearity in the data\n",
             "SOLUTIONS: \n",
             "       1. Rerun the data analysis.\n",
             "       2. If the problem persists, check the variables for\n",
             "          duplicates for both parties and / or reduce the\n",
             "          number of variables used. Once this is done,\n",
             "          rerun the data analysis.")
    warning(params$errorMessage)
  } else {
    params$II = II
    params$IA = IA

    a21i1 = II[(p1 + 1):(p1 + p2), 1:p1] %*% matrix(IA, p1, 1)
    a11i1 = II[1:p1, 1:p1] %*% matrix(IA, p1, 1)
    params$a11i1 = a11i1

    writeTime = proc.time()[3]
    save(a21i1, XTWX, file = file.path(params$writePath, "a21i1_xtwx.rdata"))
    writeSize = sum(file.size(file.path(params$writePath, "a21i1_xtwx.rdata")))
    writeTime = proc.time()[3] - writeTime
  }
  params = AddToLog(params, "GetIILogistic.A2", readTime, readSize, writeTime, writeSize)

  return(params)
}


GetCoefLogistic.B2 = function(params, data) {
  if (params$trace) cat(as.character(Sys.time()), "GetCoefLogistic.B2\n\n")
  p1 = params$p1
  p2 = params$p2
  XTWX  = NULL
  a21i1 = NULL

  readTime = proc.time()[3]
  load(file.path(params$readPath, "a21i1_xtwx.rdata"))   # load a21i1, XTWX
  readSize = sum(file.size(file.path(params$readPath, "a21i1_xtwx.rdata")))
  readTime = proc.time()[3] - readTime

  IB = params$Bxty - t(data$X) %*% params$pi_

  II = solve(XTWX)

  params$II = II
  params$IB = IB

  a22i2 = II[(p1 + 1):(p1 + p2), (p1 + 1):(p1 + p2), drop = FALSE] %*% IB
  a12i2 = II[1:p1, (p1 + 1):(p1 + p2), drop = FALSE] %*% IB
  params$a22i2 = a22i2

  params$betasBold = params$betasB
  params$betasB = params$betasB + a21i1 + a22i2

  deltabetaB = max( abs(params$betasB - params$betasBold) / (abs(params$betasB) + 0.1))

  writeTime = proc.time()[3]
  save(a12i2, deltabetaB, file = file.path(params$writePath, "a12_deltabetaB.rdata"))
  writeSize = sum(file.size(file.path(params$writePath, "a12_deltabetaB.rdata")))
  writeTime = proc.time()[3] - writeTime

  params = AddToLog(params, "GetCoefLogistic.B2", readTime, readSize, writeTime, writeSize)
  return(params)
}


GetCoefLogistic.A2 = function(params, data) {
  if (params$trace) cat(as.character(Sys.time()), "GetCoefLogistic.A2\n\n")
  a12i2      = NULL
  deltabetaB = NULL
  readTime = proc.time()[3]
  load(file.path(params$readPath, "a12_deltabetaB.rdata")) # load  a12i2, deltabetab
  readSize = sum(file.size(file.path(params$readPath, "a12_deltabetaB.rdata")))
  readTime = proc.time()[3] - readTime

  params$betasAold = params$betasA
  params$betasA = params$betasA + params$a11i1 + a12i2

  deltabeta = max(abs(params$betasA - params$betasAold) / (abs(params$betasA) + 0.1), deltabetaB)

  if (deltabeta < params$cutoff)  {
    params$converged = TRUE
  } else if (params$algIterationCounter >= params$maxIterations) {
    params$maxIterExceeded = TRUE
    warning(paste("Failed to converged in", params$maxIterations, "iterations."))
  }

  writeTime = proc.time()[3]
  save(deltabeta, file = file.path(params$writePath, "deltabeta.rdata"))
  writeSize = file.size(file.path(params$writePath, "deltabeta.rdata"))
  writeTime = proc.time()[3] - writeTime

  params = AddToLog(params, "GetCoefLogistic.A2", readTime, readSize, writeTime, writeSize)


  return(params)
}


GetConvergedStatusLogistic.B2 = function(params) {
  if (params$trace) cat(as.character(Sys.time()), "GetconvergedStatusLogistic.B2\n\n")
  deltabeta = NULL

  readTime = proc.time()[3]
  load(file.path(params$readPath, "deltabeta.rdata")) # load deltabeta.rdata
  readSize = file.size(file.path(params$readPath, "deltabeta.rdata"))
  readTime = proc.time()[3] - readTime

  if (deltabeta < params$cutoff)  {
    params$converged = TRUE
  } else if (params$algIterationCounter >= params$maxIterations) {
    params$maxIterExceeded = TRUE
    warning(paste("Failed to converged in", params$maxIterations, "iterations."))
  }

  params = AddToLog(params, "GetConvergedStatusLogistic.B2", readTime, readSize, 0, 0)
  return(params)
}


GetFinalCoefLogistic.B2 = function(params, data) {
  if (params$trace) cat(as.character(Sys.time()), "GetFinalCoefLogistic.B2\n\n")
  betasB = params$betasB / params$sdB
  offsetB = sum(betasB * params$meansB)
  BFinalFitted = t(params$sdB * t(data$X) + params$meansB) %*% betasB
  writeTime = proc.time()[3]
  save(betasB, BFinalFitted, offsetB, file = file.path(params$writePath, "b_final.rdata"))
  writeSize = sum(file.size(file.path(params$writePath, "b_final.rdata")))
  writeTime = proc.time()[3] - writeTime
  params = AddToLog(params, "GetFinalCoefLogistic.B2", 0, 0, writeTime, writeSize)
  return(params)
}


ComputeResultsLogistic.A2 = function(params, data) {
  if (params$trace) cat(as.character(Sys.time()), "ComputeResultsLogistic.A2\n\n")
  stats = params$stats
  stats$failed         = FALSE
  stats$converged      = params$converged

  n      = params$n
  p1     = params$p1
  p2     = params$p2
  sdA    = params$sdA
  sdB    = params$sdB
  meansA = params$meansA
  meansB = params$meansB
  Anames = params$Acolnames.old
  Bnames = params$Bcolnames.old
  p1.old = params$p1.old
  p2.old = params$p2.old
  p.old  = params$p.old
  indicies = params$IndiciesKeep


  betasB = NULL;
  offsetB = NULL;
  BFinalFitted = NULL;
  readTime = proc.time()[3]
  load(file.path(params$readPath, "b_final.rdata"))  # betasB, offsetB, BFinalFitted
  readSize = sum(file.size(file.path(params$readPath, "b_final.rdata")))
  readTime = proc.time()[3] - readTime
  betasA = params$betasA / sdA
  offsetA = sum(betasA[-1] * params$meansA[-1])
  betasA[1] = betasA[1] - offsetA - offsetB
  betas = c(betasA, betasB)

  AFinalFitted = t(sdA * t(data$X) + meansA) %*% betasA -
  	             t(sdA[1] * t(data$X[, 1]) + meansA[1]) %*% betasA[1]
  FinalFitted = AFinalFitted + BFinalFitted + betas[1]
  params$FinalFitted = FinalFitted

  n = params$n
  ct      = sum(data$Y)
  resdev  = -2 * (sum(data$Y * FinalFitted) - sum(log(1 + exp(FinalFitted))))
  nulldev = -2 * (ct * log(ct / n) + (n - ct) * log(1 - ct / n))

  # If xtwx were singular, it would have been caught in GetII.A2(), so we may
  # assume that xtwx is NOT singular and so we do not have to do a check.
  cov1 = solve(params$xtwx)
  secoef = sqrt(diag(cov1)) / c(sdA, sdB)
  tmp = matrix(c(1, (-meansA / sdA)[-1], -meansB / sdB), ncol = 1)
  secoef[1] = sqrt(t(tmp) %*% cov1 %*% tmp)


  stats$party = c(rep("dp0", p1.old), rep("dp1", p2.old))
  stats$coefficients = rep(NA, p.old)
  stats$secoef = rep(NA, p.old)
  stats$tvals  = rep(NA, p.old)
  stats$pvals  = rep(NA, p.old)
  stats$n  = n
  stats$nulldev = nulldev
  stats$resdev = resdev
  stats$aic = resdev + 2 * (p1 + p2)
  stats$bic = resdev + (p1 + p2) * log(n)
  stats$nulldev_df = n - 1
  stats$resdev_df = n - (p1 + p2)
  stats$coefficients[indicies] = betas
  stats$secoef[indicies] = secoef
  tvals = betas / secoef
  pvals = 2 * pnorm(abs(tvals), lower.tail = FALSE)
  stats$tvals[indicies] = tvals
  stats$pvals[indicies] = pvals

  stats$nulldev = nulldev
  stats$resdev  = resdev
  stats$hoslem  = HoslemInternal(params, data)
  stats$ROC     = RocInternal(params, data)
  stats$iter    = params$algIterationCounter - 1

  names.old = c(Anames, Bnames)
  names(stats$coefficients) = names.old
  names(stats$party) = names.old
  names(stats$secoef) = names.old
  names(stats$tvals) = names.old
  names(stats$pvals) = names.old

  writeTime = proc.time()[3]
  save(stats, file = file.path(params$writePath, "stats.rdata"))
  writeSize = file.size(file.path(params$writePath, "stats.rdata"))
  writeTime = proc.time()[3] - writeTime

  stats$Y           = data$Y # For Hoslem and ROC
  stats$FinalFitted = FinalFitted
  params$stats      = stats

  params = AddToLog(params, "ComputeResultsLogistic.B2", readTime, readSize, writeTime, writeSize)
  return(params)
}


GetResultsLogistic.B2 = function(params) {
  if (params$trace) cat(as.character(Sys.time()), "GetResultsLogistic.B2\n\n")
  stats = NULL
  readTime = proc.time()[3]
  load(file.path(params$readPath, "stats.rdata"))
  readSize = file.size(file.path(params$readPath, "stats.rdata"))
  readTime = proc.time()[3] - readTime
  params$stats = stats
  params = AddToLog(params, "GetResultsLogistic.B2", readTime, readSize, 0, 0)
  return(params)
}



############################### PARENT FUNCTIONS ###############################


PartyAProcess2Logistic = function(data,
                                  yname                 = NULL,
																	monitorFolder         = NULL,
																	msreqid               = "v_default_00_000",
                                  blocksize             = 500,
                                  cutoff                = 1e-8,
                                  maxIterations         = 25,
                                  sleepTime             = 10,
                                  maxWaitingTime        = 24 * 60 * 60,
																	popmednet             = TRUE,
																	trace                 = FALSE,
																	verbose               = TRUE) {
  params = PrepareParams.2p("logistic", "A", msreqid = msreqid,
                            popmednet = popmednet, trace = trace, verbose = verbose)
  params = InitializeLog.2p(params)
  params = InitializeStamps.2p(params)
  params = InitializeTrackingTable.2p(params)
  Header(params)
  params   = PrepareFolderLogistic.A2(params, monitorFolder)
  if (params$failed) {
  	warning(params$errorMessage)
  	return(invisible(NULL))
  }
  data = PrepareDataLogistic.A23(params, data, yname)

  params = PauseContinue.2p(params,  maxWaitingTime)
  if (file.exists(file.path(params$readPath, "errorMessage.rdata"))) {
    params$completed = TRUE
    warning(ReadErrorMessage(params$readPath))
    params$pmnStepCounter = 1
    params = SendPauseQuit.2p(params, sleepTime = sleepTime, job_failed = TRUE)
    SummarizeLog.2p(params)
    return(params$stats)
  }

  if (data$failed) {
  	params$completed = TRUE
  	message = "Error in processing the data for Party A."
  	MakeErrorMessage(params$writePath, message)
  	files = c("errorMessage.rdata")
  	params$pmnStepCounter = 1
  	params = SendPauseContinue.2p(params, files, sleepTime = sleepTime)
  	params = SendPauseQuit.2p(params, sleepTime = sleepTime, job_failed = TRUE)
  	SummarizeLog.2p(params)
  	return(params$stats)
  }

  params = PrepareParamsLogistic.A2(params, data, cutoff, maxIterations)

  if (params$failed) {   # Check for failed from PrepareParamsLogistic.A2()
    params$completed = TRUE
    MakeErrorMessage(params$writePath, params$errorMessage)
    files = c("errorMessage.rdata")
    params = SendPauseContinue.2p(params, files, sleepTime = sleepTime)
    params = SendPauseQuit.2p(params, sleepTime = sleepTime, job_failed = TRUE)
    SummarizeLog.2p(params)
    return(params$stats)
  }

  params = PrepareBlocksLogistic.A2(params, blocksize)

  if (params$failed) { # Check for failed from PrepareBlocksLogistic.A2()
    params$completed = TRUE
    MakeErrorMessage(params$writePath, params$errorMessage)
    files = c("errorMessage.rdata")
    params = SendPauseContinue.2p(params, files, sleepTime = sleepTime)
    params = SendPauseQuit.2p(params, sleepTime = sleepTime, job_failed = TRUE)
    SummarizeLog.2p(params)
    return(params$stats)
  }

  params = GetZLogistic.A2(params, data)

  files = c("pa.rdata", "blocksize.rdata",
            SeqZW("cz_", length(params$container$filebreak.Z)))
  params = SendPauseContinue.2p(params, files, sleepTime, maxWaitingTime)

  params = CheckColinearityLogistic.A2(params, data)

  if (params$failed) { # Check for CheckColinearityLogistic.A2() failed
    params$completed = TRUE
    warning(params$errorMessage)
    MakeErrorMessage(params$writePath, params$errorMessage)
    files = c("errorMessage.rdata")
    params = SendPauseContinue.2p(params, files, sleepTime = sleepTime)
    params = SendPauseQuit.2p(params, sleepTime = sleepTime, job_failed = TRUE)
    SummarizeLog.2p(params)
    return(params$stats)
  }
  data = UpdateDataLogistic.A2(params, data)
  params = AddToLog(params, "UpdateDataLogistic.A2", 0, 0, 0, 0)
  params = ComputeInitialBetasLogistic.A2(params, data)

  files = c("indicies.rdata", "Bbetas_xty.rdata")
  params = SendPauseContinue.2p(params, files, sleepTime, maxWaitingTime)

  while (!params$converged && !params$maxIterExceeded) {
    BeginningIteration(params)
    params = GetWeightsLogistic.A2(params, data)
    files = c("pi_.rdata")
    params = SendPauseContinue.2p(params, files, sleepTime, maxWaitingTime)
    params = GetIILogistic.A2(params, data)

    if (params$failed) { # Check for failed from ComputeInverseLogistic.A2()
      params$completed = TRUE
      MakeErrorMessage(params$writePath, params$errorMessage)
      files = c("errorMessage.rdata")
      params = SendPauseContinue.2p(params, files, sleepTime = sleepTime)
      params = SendPauseQuit.2p(params, sleepTime = sleepTime, job_failed = TRUE)
      SummarizeLog.2p(params)
      return(params$stats)
    }
    files = c("a21i1_xtwx.rdata")
    params = SendPauseContinue.2p(params, files, sleepTime, maxWaitingTime)

    params = GetCoefLogistic.A2(params, data)
    files = "deltabeta.rdata"
    params = SendPauseContinue.2p(params, files, sleepTime, maxWaitingTime)

    EndingIteration(params)
    params$algIterationCounter = params$algIterationCounter + 1
  }
  params$completed = TRUE

  params = ComputeResultsLogistic.A2(params, data)

  files = c("stats.rdata")
  params = SendPauseContinue.2p(params, files, sleepTime, maxWaitingTime)
  params = SendPauseQuit.2p(params, sleepTime = sleepTime)
  SummarizeLog.2p(params)
  return(invisible(params$stats))
}

PartyBProcess2Logistic = function(data,
																	monitorFolder       = "v_default_00_000",
                                  sleepTime           = 10,
                                  maxWaitingTime      = 24 * 60 * 60,
																	popmednet           = TRUE,
																	trace               = FALSE,
																	verbose             = TRUE) {
  params = PrepareParams.2p("logistic", "B",
                            popmednet = popmednet, trace = trace, verbose = verbose)
  params = InitializeLog.2p(params)
  params = InitializeStamps.2p(params)
  params = InitializeTrackingTable.2p(params)
  Header(params)
  params   = PrepareFolderLogistic.B2(params, monitorFolder)
  if (params$failed) {
  	warning(params$errorMessage)
  	return(invisible(NULL))
  }
  data = PrepareDataLogistic.B23(params, data)

  if (data$failed) { # Check for Error from PrepareDataLogistic.B2()
    params$completed = TRUE
    message = "Error in processing the data for Party B."
    MakeErrorMessage(params$writePath, message)
    files = c("errorMessage.rdata")
    params = SendPauseQuit.2p(params, files, sleepTime = sleepTime, job_failed = TRUE)
    return(params$stats)
  }

  params   = PrepareParamsLogistic.B2(params, data)

  files = c("pb.rdata")
  params = SendPauseContinue.2p(params, files, sleepTime, maxWaitingTime)

  if (file.exists(file.path(params$readPath, "errorMessage.rdata"))) {
    params$completed = TRUE
    warning(ReadErrorMessage(params$readPath))
    params = SendPauseQuit.2p(params, sleepTime = sleepTime, job_failed = TRUE)
    return(params$stats)
  }

  params = FinalizeParamsLogistic.B2(params, data)
  params = PrepareBlocksLogistic.B2(params)
  params = GetWLogistic.B2(params, data)

  files = c("xbtxb.rdata", SeqZW("cw_", length(params$container$filebreak.W)))
  params = SendPauseContinue.2p(params, files, sleepTime, maxWaitingTime)

  if (file.exists(file.path(params$readPath, "errorMessage.rdata"))) {
    params$completed = TRUE
    warning(ReadErrorMessage(params$readPath))
    params = SendPauseQuit.2p(params, sleepTime = sleepTime, job_failed = TRUE)
    return(params$stats)
  }

  params = UpdateParamsLogistic.B2(params)
  data = UpdateDataLogistic.B2(params, data)
  params = AddToLog(params, "UpdateDataLogistic.B2", 0, 0, 0, 0)

  params$algIterationCounter = 1
  while (!params$converged && !params$maxIterExceeded) {
    BeginningIteration(params)
    params = GetXBetaLogistic.B2(params, data)

    files = c("xbetab.rdata")
    params = SendPauseContinue.2p(params, files, sleepTime, maxWaitingTime)

    params = GetVLogistic.B2(params, data)
    files = c("sumswx_xbtwxb.rdata",
              SeqZW("cv_", length(params$container$filebreak.V)))
    params = SendPauseContinue.2p(params, files, sleepTime, maxWaitingTime)

    if (file.exists(file.path(params$readPath, "errorMessage.rdata"))) {
      params$completed = TRUE
      warning(ReadErrorMessage(params$readPath))
      params = SendPauseQuit.2p(params, sleepTime = sleepTime, job_failed = TRUE)
      return(params$stats)
    }

    params = GetCoefLogistic.B2(params, data)
    files = c("a12_deltabetaB.rdata")
    params = SendPauseContinue.2p(params, files, sleepTime, maxWaitingTime)

    params = GetConvergedStatusLogistic.B2(params)

    EndingIteration(params)
    params$algIterationCounter = params$algIterationCounter + 1
  }
  params$completed = TRUE

  params = GetFinalCoefLogistic.B2(params, data)
  files = c("b_final.rdata")
  params = SendPauseContinue.2p(params, files, sleepTime, maxWaitingTime)

  params = GetResultsLogistic.B2(params)
  params = SendPauseQuit.2p(params, sleepTime = sleepTime)
  return(invisible(params$stats))
}
kentedegrees/vdra documentation built on June 12, 2025, 12:56 p.m.