Run_simulation/junk.R

# coef.compCL <- function(object, s = NULL, ...) {
#   beta <- object$beta
#   if (!is.null(s)) {
#     lam <- object$lam
#     lamlist <- point.interp(lam, s)
#     if(length(s) == 1)
#     {
#       beta = beta[, lamlist$left, drop=FALSE] *  (1 - lamlist$frac) +
#         beta[, lamlist$right, drop=FALSE] * lamlist$frac
#     } else
#     {
#       beta = beta[, lamlist$left, drop=FALSE] %*% diag(1 - lamlist$frac) +
#         beta[, lamlist$right, drop=FALSE] %*% diag(lamlist$frac)
#     }
#     rownames(seq(s))
#   }
#   return(beta)
# }


# predict.compCL <- function(object, newx, s = NULL, ...) {
#   beta <- object$beta
#   if (!is.null(s)) {
#     lam <- object$lam
#     lamlist <- point.interp(lam, s)
#     if(length(s) == 1)
#     {
#       beta = beta[, lamlist$left, drop=FALSE] * (1 - lamlist$frac) +
#         beta[, lamlist$right, drop=FALSE] * lamlist$frac
#     } else
#     {
#       beta = beta[, lamlist$left, drop=FALSE] %*% diag(1 - lamlist$frac) +
#         beta[, lamlist$right, drop=FALSE] %*% diag(lamlist$frac)
#     }
#     #dimnames(beta) <- list(vnames, paste(seq(along = s)))
#   }
#   if (is.null(dim(newx))) newx = matrix(newx, nrow = 1)
#   fitting <- cbind2(newx, 1) %*% beta #as.matrix(as.matrix(cbind2(1, newx)) %*% nbeta)
#   return(fitting)
# }

#
#
# coef.cv.compCL <- function(object, trim = FALSE, s = "lam.min",...) {
#   trim <- ifelse(trim, "Ttrim", "Ftrim")
#
#   cv.fit <- object$compCGL.fit
#
#   if (is.numeric(s)) {
#     lam <- s
#   } else if (is.character(s)) {
#     lam <- object[[trim]]$lam.min
#   } else stop("Invalid form for s")
#
#   coef(cv.fit, s = lam)
#
# }

# predict.cv.gglasso <- function(object, newx, s = c("lambda.1se",
#                                                    "lambda.min"), ...) {
#   if (is.numeric(s))
#     lambda <- s else if (is.character(s)) {
#       s <- match.arg(s)
#       lambda <- object[[s]]
#     } else stop("Invalid form for s")
#   predict(object$gglasso.fit, newx, s = lambda, ...)
# }
#predict.cv.FuncompCGL <- function(object, newx, s = c("lambda.1se", "lambda.min")) {
#  if (is.numeric(s))
#    lambda <- s else if (is.character(s)) {
#      s <- match.arg(s)
#      lambda <- object[[s]]
#    } else stop("Invalid form for s")
#  predict(object$gglasso.fit, newx, s = lambda)
#}



# cvobj <- x
# xlab <- match.arg(xlab)
# #trim <- ifelse(trim, "Ttrim", "Ftrim")
# cvobj_use <- cvobj[["Ftrim"]]
# switch(xlab,
#        "lambda" = {
#          xlab = "Lambda"
#          xvalue = drop(cvobj$lam)
#        },
#        "log" = {
#          xlab = "Log(Lambda)"
#          xvalue = log(drop(cvobj$lam))
#        })
#
#
# plot.args = list(x = xvalue,y = cvobj_use$cvm,
#                  ylim = range(cvobj_use$cvupper,cvobj_use$cvlo),
#                  xlab=xlab,
#                  ylab="MEAN-Squared Error",
#                  type="n")
# new.args=list(...)
# if(length(new.args)) plot.args[names(new.args)]=new.args
# do.call("plot",plot.args)
# error.bars(xvalue, cvobj_use$cvupper, cvobj_use$culo, width=0.01, col="darkgrey")
# points(xvalue,cvobj_use$cvm,pch=20,col="red")
# axis(side=3,at=xvalue,labels=paste(cvobj$compCL.fit$df),tick=FALSE,line=0)
# abline(v=switch(xlab,
#                 "Lambda" = cvobj_use$lam.min,
#                 "Log(Lambda)" = log(cvobj_use$lam.min)
# ), lty=3)
# abline(v = switch(xlab,
#                   "Lambda" = cvobj_use$lam.1se,
#                   "Log(Lambda)" = log(cvobj_use$lam.1se)
# ),lty=3)
# invisible()


#' #' @title
#' #' plot coefficients from a "compCL" object.
#' #'
#' #' @description
#' #' Produces a coefficient profile plot of the coefficient paths for a fitted
#' #' \code{"compCL"} object.
#' #'
#' #' @param x fitted \code{"compCL"} model.
#' #' @param xvar Either plot against \code{log(lambda)} (default) or \code{lambda}.
#' #' @param \dots Other graphical parameters to plot.
#' #'
#' #' @details
#' #' A plot is produced, and nothing is returned.
#' #'
#' #' @export
#' #'
#'
#'
#' plot.compCL <- function(x, xvar, ...) {
#'
#' }
jiji6454/Rpac_compReg documentation built on May 31, 2019, 5:01 a.m.