R/UndClassFunctions.R

Defines functions print.summary.NumEdges summary.NumEdges print.NumEdges print.summary.UndPCDs summary.UndPCDs print.UndPCDs

Documented in print.NumEdges print.summary.NumEdges print.summary.UndPCDs print.UndPCDs summary.NumEdges summary.UndPCDs

#UndClassFunctions.R
###############################################
#Auxiliary functions for class UndPCDs
###############################################
#'
#' @title Print a \code{UndPCDs} \code{object}
#'
#' @description Prints the \code{call} of the \code{object}
#' of class \code{"UndPCDs"}
#' and also the \code{type} (i.e. a brief description)
#' of the underlying and reflexivity graphs of the proximity catch digraph (PCD).
#'
#' @param x An \code{UndPCDs} \code{object}.
#' @param \dots Additional arguments for the S3 method \code{'print'}.
#'
#' @return
#' The \code{call} of the \code{object} of class \code{"UndPCDs"}
#' and also the \code{type} (i.e. a brief description)
#' of  the underlying or reflexivity graphs of the proximity catch digraph (PCD).
#'
#' @seealso \code{\link{summary.UndPCDs}},
#' \code{\link{print.summary.UndPCDs}},
#' and \code{\link{plot.UndPCDs}}
#'
#' @examples
#' #\donttest{
#' nx<-20; ny<-5;
#' set.seed(1)
#' Xp<-cbind(runif(nx,0,1),runif(nx,0,1))
#' Yp<-cbind(runif(ny,0,.25),runif(ny,0,.25))+cbind(c(0,0,0.5,1,1),c(0,1,.5,0,1))
#' M<-c(1,1,1)  #try also M<-c(1,2,3)
#' r<-1.5
#' Edges<-edgesPE(Xp,Yp,r,M)
#' Edges
#' print(Edges)
#'
#' typeof(Edges)
#' attributes(Edges)
#' #}
#'
#' @export
print.UndPCDs <- function(x, ...)
{
  if (!inherits(x, "UndPCDs"))
    stop("x must be of class \"UndPCDs\"")

  cat("Call:\n")
  cat(format(x$call),"\n")

  cat("\nType:\n")
  cat(format(x$type),"\n")
} #end of the function
#'
########################
#'
#' @title Return a summary of an \code{UndPCDs} \code{object}
#'
#' @description Returns the below information about the \code{object}:
#'
#' \code{call} of the function defining the \code{object},
#' the \code{type} (i.e. the description) of the underlying or reflexivity graph
#' of the proximity catch digraph (PCD),
#' some of the partition
#' (i.e. intervalization in the 1D case and triangulation
#' in the 2D case) points
#' (i.e., vertices of the intervals or the triangles),
#' parameter of the underlying or reflexivity graphs of the PCD,
#' and various quantities
#' (number of vertices,
#' number of edges and edge density of the underlying
#' or reflexivity graphs of the PCDs,
#' number of vertices for the partition and number of partition cells
#' (i.e., intervals or triangles)).
#'
#' @param object An \code{object} of class \code{UndPCDs}.
#' @param \dots Additional parameters for \code{summary}.
#'
#' @return
#' The \code{call} of the \code{object} of class \code{"UndPCDs"},
#' the \code{type} (i.e. the description) of the underlying or reflexivity graphs
#' of the proximity catch digraph (PCD),
#' some of the partition
#' (i.e. intervalization in the 1D case and triangulation
#' in the 2D case) points
#' (i.e., vertices of the intervals or the triangles),
#' parameters of the underlying or reflexivity graph of the PCD,
#' and various quantities
#' (number of vertices,
#' number of edges and edge density of the underlying
#' or reflexivity graphs of the PCDs,
#' number of vertices for the partition
#' and number of partition cells
#' (i.e., intervals or triangles)).
#'
#' @seealso \code{\link{print.UndPCDs}}, \code{\link{print.summary.UndPCDs}},
#' and \code{\link{plot.UndPCDs}}
#'
#' @examples
#' #\donttest{
#' nx<-20; ny<-5;
#' set.seed(1)
#' Xp<-cbind(runif(nx,0,1),runif(nx,0,1))
#' Yp<-cbind(runif(ny,0,.25),runif(ny,0,.25))+cbind(c(0,0,0.5,1,1),c(0,1,.5,0,1))
#' M<-c(1,1,1)  #try also M<-c(1,2,3)
#' r<-1.5
#' Edges<-edgesPE(Xp,Yp,r,M)
#' Edges
#' summary(Edges)
#' #}
#'
#' @export
summary.UndPCDs <- function(object, ...)
{
  if (!inherits(object, "UndPCDs"))
    stop("object must be of class \"UndPCDs\"")

  dimn<-pcds::dimension(as.matrix(object$vertices))

  typ <- object$type
  xv<-as.matrix(object$vertices)
  yv<-as.matrix(object$tess.points)
  ifelse(!is.null(object$LE),
         lv<-as.matrix(object$LE),
         lv<-NA)
  ifelse(!is.null(object$RE),
         rv<-as.matrix(object$RE),
         rv<-NA)

  na<-min(6,nrow(lv))

  ifelse(!is.na(lv),
         lvec<-lv[1:na,],
         lvec<-NA)
  ifelse(!is.na(rv),
         rvec<-rv[1:na,],
         rvec<-NA)

  res <- list(txt=object$txt1,
              call=object$call,
              Vname=object$vert.name, Tname=object$tess.name,
              lvec=lvec,
              rvec=rvec,
              param=object$parameters,
              type=typ,
              Quant=object$quant,
              dimen=dimn,
              und.graph=object$und.graph)

  class(res) <- "summary.UndPCDs"
  res
} #end of the function
#'
########################
#'
#' @title Print a summary of an \code{UndPCDs} \code{object}
#'
#' @description Prints some information about the \code{object}.
#'
#' @param x	 An \code{object} of class \code{"summary.UndPCDs"},
#' generated by \code{summary.UndPCDs}.
#' @param \dots Additional parameters for \code{print}.
#'
#' @return
#' None
#'
#' @seealso \code{\link{print.UndPCDs}}, \code{\link{summary.UndPCDs}},
#' and \code{\link{plot.UndPCDs}}
#'
#' @export
print.summary.UndPCDs <- function(x, ...)
{
  cat("Call:\n")
  cat(format(x$call),"\n")

  cat("\nType of the digraph:\n")
  cat(format(x$type),"\n")

  cat("\nVertices of the", ifelse(x$und.graph == "underlying",
                                  "underlying","reflexivity"),"graph = ",  x$Vname, "\nPartition points of the region = ", x$Tname,"\n")

  cat("\nParameters of the", ifelse(x$und.graph == "underlying",
                                    "underlying","reflexivity"),"graph:\n")
  print(x$param)

  cat("Various quantities of the", ifelse(x$und.graph == "underlying",
                                          "underlying","reflexivity"),"graph:\n")
  print(x$Quant)
} #end of the function
#'
########################
#'
#' @title Plot an \code{UndPCDs} \code{object}
#'
#' @description Plots the vertices and the edges
#' of the underlying or reflexivity graphs
#' of the PCD together with the vertices
#' and boundaries of the partition
#' cells (i.e., intervals in the 1D case
#' and triangles in the 2D case)
#'
#' @param x Object of class \code{UndPCDs}.
#' @param Jit A positive real number
#' that determines the amount of jitter along the \eqn{y}-axis,
#' default is 0.1, for the 1D case,
#' the vertices of the PCD are jittered
#' according to \eqn{U(-Jit,Jit)} distribution
#' along the \eqn{y}-axis where
#' \code{Jit} equals to the range of vertices
#' and the interval end points;
#' it is redundant in the 2D case.
#' @param \dots Additional parameters for \code{plot}.
#'
#' @return
#' None
#'
#' @seealso \code{\link{print.UndPCDs}}, \code{\link{summary.UndPCDs}},
#' and \code{\link{print.summary.UndPCDs}}
#'
#' @examples
#' #\donttest{
#' nx<-20; ny<-5;
#' set.seed(1)
#' Xp<-cbind(runif(nx,0,1),runif(nx,0,1))
#' Yp<-cbind(runif(ny,0,.25),runif(ny,0,.25))+cbind(c(0,0,0.5,1,1),c(0,1,.5,0,1))
#' M<-c(1,1,1)  #try also M<-c(1,2,3)
#' r<-1.5
#' Edges<-edgesPE(Xp,Yp,r,M)
#' Edges
#' plot(Edges)
#' #}
#'
#' @export
plot.UndPCDs<-function (x, Jit=0.1, ...)
{
  if (!inherits(x, "UndPCDs"))
    stop("x must be of class \"UndPCDs\"")

  Xp<-as.matrix(x$vertices)
  Yp<-as.matrix(x$tess.points)

  dimn<-pcds::dimension(Xp)

  nx<-length(Xp); ny<-length(Yp)
  lep<-x$LE; nlep = length(lep) #lep, rep : left (right) end points of the graph edges
  rep<-x$RE
  cent = x$param[[1]]
  yjit<-runif(nlep,-Jit,Jit)

  if (dimn==1)
  {
    Xlim<-range(Xp,Yp,cent)
    xd<-Xlim[2]-Xlim[1]

    plot(cbind(Xp[1],0),main=x$mtitle, xlab="", ylab="",
         xlim=Xlim+xd*c(-.05,.05),ylim=3*c(-Jit,Jit), pch=".", ...)
    points(Xp, rep(0,nx),pch=".",cex=3)
    abline(h=0,lty=1)
    abline(v=Yp,lty=2)
    if (!is.null(lep)) {segments(lep, yjit, rep, yjit,
                                 col= 4)}
  } else if (dimn==2 && nrow(Yp)==3)
  {
    Xlim<-range(Yp[,1],Xp[,1],cent[1])
    Ylim<-range(Yp[,2],Xp[,2],cent[2])
    xd<-Xlim[2]-Xlim[1]
    yd<-Ylim[2]-Ylim[1]
    plot(Yp,pch=".",main=x$mtitle,xlab="",ylab="",
         axes=TRUE,
         xlim=Xlim+xd*c(-.05,.05),
         ylim=Ylim+yd*c(-.05,.05), ...)
    polygon(Yp)
    points(Xp,pch=1,col=1)
    if (!is.null(lep)) {segments(lep[,1], lep[,2], rep[,1], rep[,2],
                                 col= 4)}
  } else if (dimn==2 && nrow(Yp)>3)
  {
    DT<-interp::tri.mesh(Yp[,1],Yp[,2],duplicate="remove")

    Xlim<-range(Xp[,1],Yp[,1])
    Ylim<-range(Xp[,2],Yp[,2])
    xd<-Xlim[2]-Xlim[1]
    yd<-Ylim[2]-Ylim[1]

    plot(Xp,main=x$mtitle, xlab="", ylab="",
         xlim=Xlim+xd*c(-.05,.05),ylim=Ylim+yd*c(-.05,.05),
         pch=".",cex=3, ...)
    interp::plot.triSht(DT, add=TRUE, do.points = TRUE)
    if (!is.null(lep)) {segments(lep[,1], lep[,2], rep[,1], rep[,2],
                                 col= 4)}
  } else
  {stop('Currently only underlying or reflexivity graphs of the digraphs with vertices of dimension 1 or 2 are plotted.')}
} #end of the function
#'

###############################################
#Auxiliary functions for class NumEdges
###############################################
#'
#' @title Print a \code{NumEdges} \code{object}
#'
#' @description Prints the \code{call} of the \code{object}
#' of class \code{"NumEdges"}
#' and also the \code{desc} (i.e. a brief description) of the output.
#'
#' @param x A \code{NumEdges} \code{object}.
#' @param \dots Additional arguments for the S3 method \code{'print'}.
#'
#' @return
#' The \code{call} of the \code{object} of class \code{"NumEdges"}
#' and also the \code{desc} (i.e. a brief description)
#' of the output: number of edges in the underlying or reflexivity graph of
#' the proximity catch digraph (PCD) and
#' related quantities in the induced subgraphs for points in the Delaunay cells.
#'
#' @seealso \code{\link{summary.NumEdges}}, \code{\link{print.summary.NumEdges}},
#' and \code{\link{plot.NumEdges}}
#'
#' @examples
#' #\donttest{
#' nx<-15; ny<-5;
#' set.seed(1)
#' Xp<-cbind(runif(nx),runif(nx))
#' Yp<-cbind(runif(ny,0,.25),
#' runif(ny,0,.25))+cbind(c(0,0,0.5,1,1),c(0,1,.5,0,1))
#'
#' M<-c(1,1,1)  #try also M<-c(1,2,3)
#'
#' Nedges = num.edgesAS(Xp,Yp,M)
#' Nedges
#' print(Nedges)
#'
#' typeof(Nedges)
#' attributes(Nedges)
#' #}
#'
#' @export
print.NumEdges <- function(x, ...)
{
  if (!inherits(x, "NumEdges"))
    stop("x must be of class \"NumEdges\"")

  cat("Call:\n")
  cat(format(x$call),"\n")

  cat("\nDescription:\n")
  cat(format(x$desc),"\n")

} #end of the function
#'
########################
#'
#' @title Return a summary of a \code{NumEdges} \code{object}
#'
#' @description Returns the below information about the \code{object}:
#'
#' \code{call} of the function defining the \code{object},
#' the description of the output, \code{desc}, and
#' type of the graph as "underlying" or "reflexivity",
#' number of edges in the underlying or reflexivity graph of
#' the proximity catch digraph (PCD) and
#' related quantities in the induced subgraphs for points in the Delaunay cells.
#' In the one Delaunay cell case, the function provides
#' the total number of edges in the underlying or reflexivity graph,
#' vertices of Delaunay cell, and
#' indices of target points in the Delaunay cell.
#'
#' In the multiple Delaunay cell case, the function provides
#' total number of edges in the underlying or reflexivity graph,
#' number of edges for the induced subgraphs for points in the Delaunay cells,
#' vertices of Delaunay cells or indices of points that form the the Delaunay cells,
#' indices of target points in the convex hull of nontarget points,
#' indices of Delaunay cells in which points reside,
#' and area or length of the the Delaunay cells.
#'
#' @param object An \code{object} of class \code{NumEdges}.
#' @param \dots Additional parameters for \code{summary}.
#'
#' @return
#' The \code{call} of the \code{object} of class \code{"NumEdges"},
#' the \code{desc} of the output,
#' the type of the graph as "underlying" or "reflexivity",
#' total number of edges in the underlying or reflexivity graph.
#' Moreover, in the one Delaunay cell case, the function also provides
#' vertices of Delaunay cell, and
#' indices of target points in the Delaunay cell;
#' and in the multiple Delaunay cell case, it also provides
#' number of edges for the induced subgraphs for points in the Delaunay cells,
#' vertices of Delaunay cells or indices of points that form the the Delaunay cells,
#' indices of target points in the convex hull of nontarget points,
#' indices of Delaunay cells in which points reside,
#' and area or length of the the Delaunay cells.
#'
#' @seealso \code{\link{print.NumEdges}}, \code{\link{print.summary.NumEdges}},
#' and \code{\link{plot.NumEdges}}
#'
#' @examples
#' #\donttest{
#' nx<-15; ny<-5;
#' set.seed(1)
#' Xp<-cbind(runif(nx),runif(nx))
#' Yp<-cbind(runif(ny,0,.25),
#' runif(ny,0,.25))+cbind(c(0,0,0.5,1,1),c(0,1,.5,0,1))
#'
#' M<-c(1,1,1)  #try also M<-c(1,2,3)
#'
#' Nedges = num.edgesAS(Xp,Yp,M)
#' Nedges
#' summary(Nedges)
#' #}
#'
#' @export
summary.NumEdges <- function(object, ...)
{
  if (!inherits(object, "NumEdges"))
    stop("object must be of class \"NumEdges\"")

  Xp<-as.matrix(object$vertices)
  Yp<-as.matrix(object$tess.points)

  dimn<-pcds::dimension(Xp)

  if (dimn == 1)
  {
    num.in.ch = object$num.in.range
    cell.num.edges = object$int.num.edges
    num.in.cells = object$num.in.ints
    cell.weights = object$weight.vec
    if (grepl("1D", as.character(object$call)[1]))  #these are interval end points
    {cell.verts<-object$partition.intervals
    } else
    { cell.verts<-object$tess.points
    if (length(object$ind.mid)==0) {ind.in.mid = NA } else {ind.in.mid = object$ind.mid}
    if (length(object$ind.left.end)==0) {ind.in.left = NA } else {ind.in.left = object$ind.left.end}
    if (length(object$ind.right.end)==0) {ind.in.right = NA } else {ind.in.right = object$ind.right.end}
    }
    data.cell.ind = object$data.int.ind

    if (grepl("1D", as.character(object$call)[1]))
    {
      res <- list(call= object$call,
                  und.graph=tolower(object$und.graph),
                  vertices = object$vertices,
                  tess.points = object$tess.points,
                  desc=object$desc, #description of the output
                  num.edges=object$num.edges,
                  #number of edges for the entire underlying or reflexivity graph of PCD
                  num.in.ch = num.in.ch, # number of Xp points in range of Yp points
                  cell.num.edges = cell.num.edges,
                  #vector of number of edges for the partition intervals
                  num.in.cells = num.in.cells,
                  # vector of number of Xp points in the partition intervals
                  cell.weights = cell.weights, #lengths of partition intervals
                  cell.verts = cell.verts,
                  # indices of the vertices of the Delaunay cells, i.e.,
                  #each column corresponds to the one partition interval
                  data.cell.ind = data.cell.ind
                  #indices of the partition intervals in which data points reside,
                  #i.e., column number of cell.verts for each Xp point
      )
    } else
    {    res <- list(call= object$call,
                     und.graph=tolower(object$und.graph),
                     vertices = object$vertices,
                     tess.points = object$tess.points,
                     desc=object$desc, #description of the output
                     num.edges=object$num.edges,
                     #number of edges for the entire underlying or reflexivity graph of PCD
                     num.in.ch = num.in.ch, # number of Xp points in range of Yp points
                     cell.num.edges = cell.num.edges,
                     #vector of number of edges for the partition intervals
                     num.in.cells = num.in.cells,
                     # vector of number of Xp points in the partition intervals
                     ind.in.mid = ind.in.mid, #indices of data points in the middle interval
                     ind.in.left = ind.in.left, #indices of data points in the left end interval
                     ind.in.right = ind.in.right,
                     #indices of data points in the right end interval
                     cell.verts = cell.verts, # indices of the vertices of the Delaunay cells,
                     #i.e., each column corresponds to the one partition interval
                     data.cell.ind = data.cell.ind
                     #indices of the partition intervals in which data points reside,
                     #i.e., column number of cell.verts for each Xp point
    )}
  } else
    if (dimn == 2)
    {
      if ( grepl("tri", as.character(object$call)[1]) )
      {
        num.in.ch = object$num.in.tri
        ind.in.cell = object$ind.in.tri
        cell.num.edges = object$tri.num.edges

        res <- list(call = object$call,
                    und.graph=tolower(object$und.graph),
                    desc=object$desc, #description of the output
                    vertices=object$vertices,
                    tess.points=object$tess.points,
                    num.edges=object$num.edges,
                    #number of edges for the entire underlying or reflexivity graph of PCD
                    cell.num.edges = cell.num.edges,
                    #vector of number of edges for the Delaunay cell
                    num.in.ch = num.in.ch, # number of Xp points in CH of Yp points
                    ind.in.cell = ind.in.cell
                    #indices of data points inside the one Delaunay cell (one cell case)
        )
      } else {
        num.in.ch = object$num.in.conv.hull
        cell.num.edges = object$tri.num.edges
        ind.in.cell = object$ind.in.conv.hull
        num.in.cells = object$num.in.tris
        cell.weights = object$weight.vec
        cell.vert.ind = object$del.tri.ind
        data.cell.ind = object$data.tri.ind

        res <- list(call= object$call,
                    und.graph=tolower(object$und.graph),
                    desc=object$desc, #description of the output
                    vertices=object$vertices,
                    tess.points=object$tess.points,
                    num.edges=object$num.edges,
                    #number of edges for the entire underlying or reflexivity graph of PCD
                    num.in.ch = num.in.ch, # number of Xp points in CH of Yp points
                    cell.num.edges = cell.num.edges,
                    #vector of number of edges for the Delaunay cells
                    num.in.cells = num.in.cells,
                    # vector of number of Xp points in the Delaunay triangles
                    ind.in.cell = ind.in.cell,
                    #indices of data points inside the one Delaunay cell (one cell case)
                    cell.weights = cell.weights, #areas of Delaunay cells
                    cell.vert.ind = cell.vert.ind,
                    # indices of the vertices of the Delaunay cells, i.e., each column
                    #corresponds to the indices of the vertices of one Delaunay cell
                    data.cell.ind = data.cell.ind
                    #indices of the Delaunay cells in which data points reside,
                    #i.e., column number of cell.vert.ind for each Xp point
        )
      }
    } else
    {
      num.in.ch = object$num.in.tetra
      ind.in.cell = object$ind.in.tetra
      cell.num.edges = object$tetra.num.edges

      res <- list(call = object$call,
                  und.graph=tolower(object$und.graph),
                  desc=object$desc, #description of the output
                  vertices=object$vertices,
                  tess.points=object$tess.points,
                  num.edges=object$num.edges,
                  #number of edges for the entire underlying or reflexivity graph of PCD
                  cell.num.edges = cell.num.edges,
                  #vector of number of edges for the Delaunay cells
                  num.in.ch = num.in.ch, # number of Xp points in CH of Yp points
                  ind.in.cell = ind.in.cell
                  #indices of data points inside the one Delaunay cell (one cell case)
      )
    }

  class(res) <- "summary.NumEdges"
  res
} #end of the function
#'
########################
#'
#' @title Print a summary of a \code{NumEdges} \code{object}
#'
#' @description Prints some information about the \code{object}.
#'
#' @param x An \code{object} of class \code{"summary.NumEdges"},
#' generated by \code{summary.NumEdges}.
#' @param \dots Additional parameters for \code{print}.
#'
#' @return
#' None
#'
#' @seealso \code{\link{print.NumEdges}}, \code{\link{summary.NumEdges}},
#' and \code{\link{plot.NumEdges}}
#'
#' @export
print.summary.NumEdges <- function(x, ...)
{
  cat("Call:\n")
  cat(format(x$call),"\n")

  cat("\nDescription of the output:\n")
  cat(format(x$desc),"\n")

  Xp<-as.matrix(x$vertices)
  Yp<-as.matrix(x$tess.points)
  nx=length(Xp); ny=length(Yp)

  dimn<-pcds::dimension(Xp)

  if (dimn == 1)
  {
    cat("\nNumber of data (Xp) points in the range of Yp (nontarget) points = ",  x$num.in.ch,"\n")
    cat("Number of data points in the partition intervals based on Yp points = ",  x$num.in.cells,"\n")
    cat("Number of edges in the entire", x$und.graph, "graph = ",  x$num.edges,"\n")
    cat("Numbers of edges in the induced subgraphs in the partition intervals = ",  x$cell.num.edges,"\n")

    if (grepl("1D", as.character(x$call)[1]))
    {

      cat("Lengths of the (middle) partition intervals (used as weights in the edge density of multi-interval case):\n")
      cat(format(x$cell.weights),"\n")

      cat("\nEnd points of the partition intervals (each column refers to a partition interval):\n")
      print(x$cell.verts)

      cat("\nIndices of the partition intervals data points resides:\n")
      cat(format(x$data.cell.ind),"\n")
    } else
    {
      cat("\nEnd points of the support interval:\n")
      cat(format(x$cell.verts),"\n")

      cat("Indices of data points in the intervals:\n")
      cat("left end interval: ",  x$ind.in.left ,"\n")
      cat("middle interval: ",  x$ind.in.mid ,"\n")
      cat("right end interval: ",  x$ind.in.right ,"\n")
    }

  } else
    if (dimn == 2)
    {
      if ( grepl("tri", as.character(x$call)[1]) )
      {
        cat("\nNumber of data (Xp) points in the triangle = ",  x$num.in.ch,"\n")
        cat("Number of edges in the entire", x$und.graph, "graph = ",  x$num.edges,"\n")
        cat("Numbers of edges in the induced subgraph in the triangle = ",  x$cell.num.edges,"\n")

        # if (!is.null(x$ind.in.cell))
        # {
        cat("\nIndices of data points in the triangle:\n")
        cat(format(x$ind.in.cell),"\n")
        #}
      } else
      { ny = nrow(x$tess.points)
      cat("\nNumber of data (Xp) points in the convex hull of Yp (nontarget) points = ",  x$num.in.ch,"\n")
      cat("Number of data points in the Delaunay",  ifelse(ny==3,"triangle","triangles"),"based on Yp points = ",  x$num.in.cells,"\n")
      cat("Number of edges in the entire", x$und.graph, "graph = ",  x$num.edges,"\n")
      cat("Numbers of edges in the induced",ifelse(ny==3,"subgraph in the Delaunay triangle","subdigraphs in the Delaunay triangles"), " = ",  x$cell.num.edges,"\n")
      cat(ifelse(ny==3,"Area of the Delaunay triangle","Areas of the Delaunay triangles (used as weights in the edge density of multi-triangle case)"),":\n")
      cat(format(x$cell.weights),"\n")

      #if (!is.null(x$ind.in.cell))
      #{
      cat("Indices of data points in the",ifelse(ny==3, "triangle","triangles"),":\n")
      cat(format(x$ind.in.cell),"\n")
      #}

      cat("\nIndices of the vertices of the Delaunay",ifelse(ny==3,"triangle","triangles (each column refers to a triangle)"), ":\n")
      print(x$cell.vert.ind)

      cat("\n",ifelse(ny==3,"Index of the Delaunay triangle","Indices of the Delaunay triangles"),"in which the data points resides:\n")
      cat(format(x$data.cell.ind),"\n")
      }
    } else
    {
      cat("\nNumber of data (Xp) points in the tetrahedron = ",  x$num.in.ch,"\n")
      cat("Number of edges in the entire", x$und.graph, "graph = ",  x$num.edges,"\n")

      #if (!is.null(x$ind.in.cell))
      #{
      cat("\nIndices of data points in the tetrahedron:\n")
      cat(format(x$ind.in.cell),"\n")
      #}

    }
} #end of the function
#'
########################
#'
#' @title Plot a \code{NumEdges} \code{object}
#'
#' @description Plots the scatter plot of the data points (i.e. vertices of the
#' underlying or reflexivity graphs of the PCDs)
#' and the Delaunay tessellation of the nontarget points marked with number of edges
#' in the centroid of the Delaunay cells.
#'
#' @param x Object of class \code{NumEdges}.
#' @param Jit A positive real number
#' that determines the amount of jitter along the \eqn{y}-axis,
#' default is 0.1, for the 1D case,
#' the vertices of the underlying or reflexivity graph of the PCD are jittered
#' according to \eqn{U(-Jit,Jit)} distribution
#' along the \eqn{y}-axis where
#' \code{Jit} equals to the range of vertices
#' and the interval end points; it is redundant in the 2D case.
#' @param \dots Additional parameters for \code{plot}.
#'
#' @return
#' None
#'
#' @seealso \code{\link{print.NumEdges}}, \code{\link{summary.NumEdges}},
#' and \code{\link{print.summary.NumEdges}}
#'
#' @examples
#' #\donttest{
#' nx<-15; ny<-5;
#' set.seed(1)
#' Xp<-cbind(runif(nx),runif(nx))
#' Yp<-cbind(runif(ny,0,.25),
#' runif(ny,0,.25))+cbind(c(0,0,0.5,1,1),c(0,1,.5,0,1))
#'
#' M<-c(1,1,1)  #try also M<-c(1,2,3)
#'
#' Nedges = num.edgesAS(Xp,Yp,M)
#' Nedges
#' plot(Nedges)
#' #}
#'
#' @export
plot.NumEdges<-function (x, Jit=0.1, ...)
{
  if (!inherits(x, "NumEdges"))
    stop("x must be of class \"NumEdges\"")

  Xp<-as.matrix(x$vertices)
  Yp<-as.matrix(x$tess.points)

  dimn<-pcds::dimension(Xp)
  nx<-length(Xp); ny<-length(Yp)

  if (dimn==1)
  {
    Xlim<-range(Xp,Yp)
    xd<-Xlim[2]-Xlim[1]
    Xlim<-Xlim+xd*c(-.05,.05)

    plot(cbind(Xp[1],0),
         main=c(paste("Target Points and the Number of Edges of the ", x$und.graph," Graph of \n ",substring(as.character(x$call)[1],10,11),"-PCD in each Partition Interval", sep="")),
         xlab="", ylab="",
         xlim=Xlim,ylim=3*c(-Jit,Jit),
         pch=".", ...)
    points(Xp, rep(0,nx),pch=".",cex=3)
    abline(h=0,lty=1)
    abline(v=Yp,lty=2)

    CMvec = (min(Yp)+Xlim[1])/2
    if (grepl("1D", as.character(x$call)[1]))
    {CMvec = c(CMvec,colMeans(x$partition.intervals[,2:ny]))
    } else
    {
      CMvec = c(CMvec,mean(Yp))
    }
    CMvec = c(CMvec,(max(Yp)+Xlim[2])/2)
    text(CMvec,Jit,labels=x$int.num.edges)
  } else if (dimn==2 && nrow(Yp)==3)
  {
    Xlim<-range(Yp[,1],Xp[,1]);
    Ylim<-range(Yp[,2],Xp[,2])
    xd<-Xlim[2]-Xlim[1]; yd<-Ylim[2]-Ylim[1]
    plot(Yp,pch=".",
         main=c(paste("Target Points and the Number of Edges of the ", x$und.graph," Graph of \n ",substring(as.character(x$call)[1],10,11),"-PCD in the Triangle", sep="")),
         xlab="",ylab="", axes=TRUE,
         xlim=Xlim+xd*c(-.05,.05),
         ylim=Ylim+yd*c(-.05,.05), ...)
    polygon(Yp)
    points(Xp,pch=1,col=1)
    CMvec = colMeans(Yp)
    text(CMvec[1],CMvec[2],labels=x$tri.num.edges)
  } else if (dimn==2 && nrow(Yp)>3)
  {
    DT<-interp::tri.mesh(Yp[,1],Yp[,2],duplicate="remove")

    Xlim<-range(Xp[,1],Yp[,1])
    Ylim<-range(Xp[,2],Yp[,2])
    xd<-Xlim[2]-Xlim[1]; yd<-Ylim[2]-Ylim[1]

    plot(Xp,
         main=c(paste("Target Points and the Number of Edges of the ", x$und.graph," Graph of \n ",substring(as.character(x$call)[1],10,11),"-PCD in each Delaunay Triangle", sep="")),
         xlab="", ylab="", xlim=Xlim+xd*c(-.05,.05),ylim=Ylim+yd*c(-.05,.05),
         pch=".",cex=3, ...)
    interp::plot.triSht(DT, add=TRUE, do.points = TRUE)

    del.tri.vert = DT$trlist[,1:3] #vertices of the Delaunay triangles (rowwise stored)
    colnames(del.tri.vert) = c()
    ndt = nrow(del.tri.vert) #number of Delaunay triangles
    CMvec = c()
    for (i in 1:ndt)
    {CMvec = rbind(CMvec,colMeans(Yp[del.tri.vert[i,],]))  }
    text(CMvec[,1],CMvec[,2],labels=x$tri.num.edges)
  } else
  {stop('Currently only data sets of dimension 1 or 2 are plotted.')}
} #end of the function
#'

Try the pcds.ugraph package in your browser

Any scripts or data that you put into this service are public.

pcds.ugraph documentation built on May 29, 2024, 10:39 a.m.