Nothing
#' Matrix of coordinates
#'
#' Generates a matrix of evaluation points, used by the extremal coefficients estimator.
#' @rdname evalPoints
#' @export
#' @param obj Object of class \code{Tuples, Triples, Quadruples, Adjacent} which are subclasses of class
#' \code{Coordinates} or an object of class \code{RootDepSet}.
#' @param obj2 Object of class \code{Tree}
#' @param x A named vector of coordinates of length |U|, where U is the set of nodes with available data.
#' @param ... additional arguments
#' @return An object of the same class as the argument \code{obj} containing a matrix of coordinates.
evalPoints<- function(obj, ...)
{
UseMethod("evalPoints", obj)
}
#' @export
evalPoints.default<- function(obj, ...)
{
return("Default method")
}
#' @rdname evalPoints
#' @export
#' @examples
#' # create an object of class Adjacent
#' adjobj<- Adjacent()
#' # create a graph with named vertices
#' g<- graph(c("a", "b", "b", "c", "b", "d"), directed = FALSE)
#' # create a dataset with named columns
#' mydata<- matrix(rnorm(10*4), ncol=4, nrow=10)
#' colnames(mydata)<- get.vertex.attribute(g, "name", V(g))
#' # create object of class Network
#' mytree<- Tree(g, mydata)
#' # create the vector of coordinates and name it
#' x<- c(1:vcount(g))
#' names(x)<- c("a", "b", "c", "d")
#' # create the matrix of adjacent coordinates
#' mycoord<- evalPoints(adjobj, mytree, x)
#'
#' # create a matrix of pair coordinates
#' mytup<- Tuples()
#' mytup<- evalPoints(mytup, mytree, x)
#'
#' # create matrix of coordinates when there are missing data nodes
#' mydata<- matrix(rnorm(10*3), ncol=3, nrow=10)
#' colnames(mydata)<- c("b", "c", "d")
#' mytree<- Tree(g, mydata)
#' x<- c(1:vcount(g))
#' names(x)<- c("a", "b", "c", "d")
#' mytrip<- Triples()
#' evalPoints(mytrip, mytree, x)
evalPoints.Coordinates<- function(obj, obj2, x, ...)
{
#debug
#obj2<- mytree
#-----------
g<- getGraph(obj2)
U<- getNodesWithData(obj2)
Vnames<- igraph::get.vertex.attribute(g, "name", V(g))
if(length(names(x)) == 0)
stop("'x' should be a named vector")
if (length(Vnames) != 0)
{
if(length(base::setdiff(U, names(x)))!=0)
stop("'x' should have the same names as the nodes with available data")
}
if (length(Vnames) == 0)
{
if (length(base::setdiff(Vnames, names(x))) !=0 )
stop("'x' should have the same names as the nodes with available data")
}
NextMethod(nodes = Vnames, U = U, gr = g, ...)
}
#' @export
evalPoints.Adjacent<- function(obj, obj2, x, nodes, U, gr, ...)
{
# if the graph passed in gr is not a tree this method is not going to work.
if(length(setdiff(nodes, U))!=0)
stop("Adjacent coordinates are defined only for graphs without missing data nodes")
comb2<- walking(gr, U[1])
comb3<- c()
for (u in U)
{
nn<- get.vertex.attribute(gr, "name", igraph::neighbors(gr, u))
if (length(nn)>1)
{
comb3<- cbind(comb3, rbind(utils::combn(nn,2), u))
}
}
cm2<- apply(comb2, 1,place_x, x, U)
cm3<- apply(comb3, 2, place_x, x, U)
obj<- t(cbind(cm2, cm3))
return(obj)
#return(list(obj, obj2, x, nodes, U, gr))
}
#' @export
evalPoints.Tuples<- function(obj, obj2, x, nodes, U, ...)
{
comb<- utils::combn(U,2)
cm<- apply(comb, 2, place_x, x = x, U = U)
cm<- t(cm)
colnames(cm)<- U
return(cm)
}
#' @export
evalPoints.Triples<- function(obj, obj2, x, nodes, U, ...)
{
comb<- utils::combn(U,3)
cm<- apply(comb, 2, place_x, x = x, U = U)
cm<- t(cm)
colnames(cm)<- U
return(cm)
}
#' @export
evalPoints.Quadruples<- function(obj, obj2, x, nodes, U, ...)
{
comb<- utils::combn(U,4)
cm<- apply(comb, 2, place_x, x = x, U = U)
cm<- t(cm)
colnames(cm)<- U
return(cm)
}
#' @export
#' @rdname evalPoints
#' @param U The set of nodes with observable data
#' @examples
#' # create a matrix of coordinates for an arbitrary subsets
#' rdsobj<- RootDepSet()
#' rds_values<- list(b=c("c", "d"), c=c("b", "d"), d=c("b", "c"))
#' rds_roots<- c("c", "d", "b")
#' rdsobj<- setRootDepSet(rdsobj, rds_values, rds_roots)
#' x<- c(2,3,4)
#' names(x)<- c("b", "c", "d")
#' evalPoints(rdsobj, x, getNodesWithData(mytree))
evalPoints.RootDepSet<- function(obj, x, U, ...)
{
# # debug
# obj<- subs
# U<- getNodesWithData()
# x<- x
# names(x)<- U
# #--------
# this needs debugging
subsets<- getValue(obj)
roots<- getRoot(obj)
if (is.list(subsets))
{
cmm<- matrix(0, nrow= length(roots), ncol = length(U) )
colnames(cmm)<- U
for (i in 1:length(roots))
{
cmm[i, ]<- place_x(subsets[[i]], x, U)
}
} else {
cmm<- place_x(subsets, x, U)
names(cmm)<- U
}
return(cmm)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.