General multiway cores

General multiway cores

MWcore <- function(MN,P,trace=FALSE){
  C <- lapply(P$cways$cw, \(x) 1:nrow(MN$nodes[[x]])); names(C) <- P$cways$cw
  repeat{
    exit <- TRUE
    for(i in 1:(length(P)-1)){
      cip <- P[[i]]$cip; p <- P[[i]]$p; thresh <- P[[i]]$t
      R <- c(); r <- cip[1]
      for(v in C[[r]]) {
        pv <- p(MN,v,cip,C)
        if(pv < thresh) {R <- union(R,v); exit <- FALSE}
      }
      if(length(R)>0) C[[r]] <- setdiff(C[[r]],R)
      if(trace) cat(i,P[[i]]$cwp[1],r,":",cip,"/",thresh,"\n",R,"\n")
    }
    if(exit) break
  }
  return(C)
}
listCore <- function(MN,C,P,sorted=TRUE){
  ci <- P[["cways"]]$ci
  for(i in 1:(length(P)-1)){
    cip <- P[[i]]$cip; p <- P[[i]]$p; thresh <- P[[i]]$t
    iu <- P[[i]]$cwp[1]; N <- MN$nodes[[iu]]$ID
    nw <- length(N); r <- cip[1]; core <- list(); 
    for(v in 1:nw) if(v %in% C[[r]]) core[[N[v]]] <- p(MN,v,cip,C)
    cat(i,iu,":",thresh, nw, cip,"\n")
    T <- unlist(core,use.name=TRUE); if(sorted) T <- rev(sort(T))
    print(T)
  }
}
vlado/work/2m/mwn/mwcores.txt · Last modified: 2023/02/18 01:16 by vlado
 
Except where otherwise noted, content on this wiki is licensed under the following license: CC Attribution-Noncommercial-Share Alike 3.0 Unported
Recent changes RSS feed Donate Powered by PHP Valid XHTML 1.0 Valid CSS Driven by DokuWiki