R/impl.R

In Ivis4ml/SparseSEMs: Sparse Structural Equation Models for jointly inferring Gene Regulatory Networks

##' @title implFSSEM
##' @description implementor function of FSSEM solver
##' @param data Data archive of experiment measurements, includeing
##' eQTL matrices, Gene expression matrices of different conditions,
##' marker of eQTLs and data generation SEM model
##' @param method Use cross-validation (CV) or bayesian-information-criterion(BIC)
##' @return List of TPR and FDR
##' @export
implFSSEM = function(data = NULL, method = c("CV", "BIC")) {
  method = match.arg(method)
  gamma = cv.multiRegression(
    data$Data$X,
    data$Data$Y,
    data$Data$Sk,
    ngamma = 50,
    nfold = 5,
    data$Vars$n,
    data$Vars$p,
    data$Vars$k
  )
  fit   = multiRegression(
    data$Data$X,
    data$Data$Y,
    data$Data$Sk,
    gamma,
    data$Vars$n,
    data$Vars$p,
    data$Vars$k,
    trans = FALSE
  )
  Xs    = data$Data$X
  Ys    = data$Data$Y
  Sk    = data$Data$Sk

  ## cross-validation
  if (method == "CV") {
    cvfitc <-
      cv.multiFSSEMiPALM(
        Xs = Xs,
        Ys = Ys,
        Bs = fit$Bs,
        Fs = fit$Fs,
        Sk = Sk,
        sigma2 = fit$sigma2,
        nlambda = 10,
        nrho = 10,
        nfold = 5,
        p = data$Vars$p,
        q = data$Vars$k,
        wt = T
      )

    fitc <-
      multiFSSEMiPALM(
        Xs = Xs,
        Ys = Ys,
        Bs = fit$Bs,
        Fs = fit$Fs,
        Sk = Sk,
        sigma2 = fit$sigma2,
        lambda = cvfitc$lambda,
        rho = cvfitc$rho,
        Wl = inverseB(fit$Bs),
        Wf = flinvB(fit$Bs),
        p = data$Vars$p,
        maxit = 100,
        threshold = 1e-5,
        sparse = T,
        verbose = T,
        trans = T,
        strict = T
      )
  } else {
    opt = opt.multiFSSEMiPALM(
      Xs = Xs,
      Ys = Ys,
      Bs = fit$Bs,
      Fs = fit$Fs,
      Sk = Sk,
      sigma2 = fit$sigma2,
      nlambda = 10,
      nrho = 10,
      p = data$Vars$p,
      q = data$Vars$k,
      wt = T
    )
    fitc = opt$fit
  }

  TPR4GRN = (TPR(fitc$B[[1]], data$Vars$B[[1]], PREC = 1e-3) + TPR(fitc$B[[2]], data$Vars$B[[2]], PREC = 1e-3)) / 2
  FDR4GRN = (FDR(fitc$B[[1]], data$Vars$B[[1]], PREC = 1e-3) + FDR(fitc$B[[2]], data$Vars$B[[2]], PREC = 1e-3)) / 2
  TPR4DiffGRN = TPR(fitc$B[[1]] - fitc$B[[2]], data$Vars$B[[1]] - data$Vars$B[[2]], PREC = 1e-3)
  FDR4DiffGRN = FDR(fitc$B[[1]] - fitc$B[[2]], data$Vars$B[[1]] - data$Vars$B[[2]], PREC = 1e-3)

  data.frame(
    TPR = TPR4GRN,
    FDR = FDR4GRN,
    TPRofDiffGRN = TPR4DiffGRN,
    FDRofDiffGRN = FDR4DiffGRN
  )
}


##' @title transx
##' @param data Collecting data structure generated by randomFSSEMdata function
##' @return transformed list of eQTL matrices
##' @export
transx = function(data) {
  Sk = data$Data$Sk
  X  = data$Data$X
  lapply(Sk, function(s) { X[s, ] })
}