R/main_fun.R

Defines functions edge_selection

Documented in edge_selection

#' extension of gss package
#' @export
#' @param y numeric variable
#' @param family char
#' @param px dimension
#' @param domain list of domain
#' @param w weights
#' @param nbasis number of basis
#' @param method which method to select M
#' @import scales
#' @import stats
#' @import gss
#' @import MASS
#' @import pracma
#' @import matrixcalc




edge_selection <- function(y,family=c("joint","neighborhood","semi"),px=0,domain=as.list(NULL),w=NULL,nbasis=NULL,method=c("cv","BIC")) {
  family = match.arg(family)
  method = match.arg(method)
  if (family=="semi"& px==0){
    stop("specify px")
  }
  if (method=="BIC"& family=="joint"){
    stop("no BIC method for joint method, try neighborhood")
  }
  res = switch(family,joint=density0.joint(y=y,domain,w,nbasis),
               neighborhood=density0.neighborhood(y=y, method),
               semi=density0.semi(y=y,px))
  res
}

# plot_edge <- function(y, edge_matrix, p){
#   radian.rescale <- function(x, start = 0, direction = 1) {
#     c.rotate <- function(x) (x + start) %% (2 * pi) * direction
#     c.rotate(scales::rescale(x, c(0, 2 * pi), range(x)))
#   }
#   g <- erdos.renyi.game(p, 0.5)
#   la <- layout.circle(g)
#   lab.locs <- radian.rescale(x = 1:p, direction = -1, start = 0)
#
#   totalgraph <- edge_matrix != 0
#
#   diag(totalgraph) <- FALSE
#   rownames(totalgraph) <- colnames(totalgraph) <- names(y)
#   total.ug <- as(totalgraph, "graphNEL")
#   total.ug <- graph_from_graphnel(total.ug)
#   plot(total.ug,
#        layout = la, vertex.size = 5, vertex.label.dist = 1,
#        vertex.label.degree = lab.locs,
#        vertex.label.color = rgb(0, 0, .2, .8), vertex.label.cex = .8,
#        color = "grey"
#   )
#
# }
haodongucsb/toyexample documentation built on April 12, 2022, 12:25 a.m.