pcds: Proximity Catch Digraphs and Their Applications

Documented in print.Extrema print.Lines print.Lines3D print.NumArcs print.Patterns print.PCDs print.Planes print.summary.Extrema print.summary.Lines print.summary.Lines3D print.summary.NumArcs print.summary.Patterns print.summary.PCDs print.summary.Planes print.summary.TriLines print.summary.Uniform print.TriLines print.Uniform summary.Extrema summary.Lines summary.Lines3D summary.NumArcs summary.Patterns summary.PCDs summary.Planes summary.TriLines summary.Uniform

#ClassFunctions.R
###############################################
#Auxiliary functions for class Lines
###############################################
#'
#' @title Print a \code{Lines} \code{object}
#'
#' @description Prints the \code{call} of the \code{object}
#' of class \code{"Lines"}
#' and also the \code{coefficients} of the line
#' (in the form: \code{y = slope * x + intercept}).
#'
#' @param x A \code{Lines} \code{object}.
#' @param \dots Additional arguments for the S3 method \code{'print'}.
#'
#' @return
#' The \code{call} of the \code{object} of class \code{"Lines"}
#' and the \code{coefficients} of the line
#' (in the form: \code{y = slope * x + intercept}).
#'
#' @seealso \code{\link{summary.Lines}}, \code{\link{print.summary.Lines}},
#' and \code{\link{plot.Lines}}
#'
#' @examples
#' A<-c(-1.22,-2.33); B<-c(2.55,3.75)
#' xr<-range(A,B);
#' xf<-(xr[2]-xr[1])*.1 #how far to go at the lower and upper ends in the x-coordinate
#' x<-seq(xr[1]-xf,xr[2]+xf,l=3) #try also l=10, 20 or 100
#'
#' lnAB<-Line(A,B,x)
#' lnAB
#' print(lnAB)
#'
#' typeof(lnAB)
#' attributes(lnAB)
#'
#' @export
print.Lines <- function(x, ...)
{
  if (!inherits(x, "Lines"))
    stop("x must be of class \"Lines\"")

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

  cat("\nCoefficients of the line (in the form: y = slope * x + intercept) \n")
  cat(format(c(x$slope,x$intercept)),"\n")
  #print(c(x$slope,x$intercept))
} #end of the function
#'
########################
#'
#' @title Return a summary of a \code{Lines} \code{object}
#'
#' @description Returns the below information about the \code{object}:
#'
#' \code{call} of the function defining the \code{object},
#' the defining \code{points}, selected \eqn{x}
#' and \eqn{y} points on the line,
#' equation of the line, and \code{coefficients} of the line.
#'
#' @param object An \code{object} of class \code{Lines}.
#' @param \dots Additional parameters for \code{summary}.
#'
#' @return
#' The \code{call} of the \code{object} of class \code{"Lines"},
#' the defining \code{points}, selected \eqn{x}
#' and \eqn{y} points on the line,
#' equation of the line, and \code{coefficients} of the line
#' (in the form: \code{y = slope * x + intercept}).
#'
#' @seealso \code{\link{print.Lines}}, \code{\link{print.summary.Lines}},
#' and \code{\link{plot.Lines}}
#'
#' @examples
#' A<-c(-1.22,-2.33); B<-c(2.55,3.75)
#' xr<-range(A,B);
#' xf<-(xr[2]-xr[1])*.1
#' #how far to go at the lower and upper ends in the x-coordinate
#' x<-seq(xr[1]-xf,xr[2]+xf,l=3) #try also l=10, 20 or 100
#'
#' lnAB<-Line(A,B,x)
#' lnAB
#' summary(lnAB)
#'
#' @export
summary.Lines <- function(object, ...)
{
  if (!inherits(object, "Lines"))
    stop("object must be of class \"Lines\"")

  eqn <- object$equation
  names(eqn)<-c()
  pnts<-object$points
  xv<-object$x
  yv<-object$y
  nx<-min(6,length(xv))
  ny<-min(6,length(yv))

  res <- list(desc=object$desc,
              call=object$call,
              points=pnts,
              xvec=xv[1:nx],
              yvec=yv[1:ny],
              coefficients=c(object$slope,object$intercept),
              eqn=eqn)
  class(res) <- "summary.Lines"
  res
} #end of the function
#'
########################
#'
#' @title Print a summary of a \code{Lines} \code{object}
#'
#' @description Prints some information about the \code{object}.
#'
#' @param x	 An \code{object} of class \code{"summary.Lines"},
#' generated by \code{summary.Lines}.
#' @param \dots Additional parameters for \code{print}.
#'
#' @return
#' None
#'
#' @seealso \code{\link{print.Lines}}, \code{\link{summary.Lines}},
#' and \code{\link{plot.Lines}}
#'
#' @export
print.summary.Lines <- function(x, ...)
{
  cat("Call:\n")
  cat(format(x$call),"\n")
  #print(x$call)

  cat("\nDefining Points\n")
  # cat(format(x$points),"\n")
  print(x$points)

  cat("\nSelected x points (first row) and estimated y points (second row)
  that fall on the Line (first 6 or fewer are printed at each row) \n")
  cat(format(x$xvec),"\n")
  cat(format(x$yvec),"\n")
  #print(x$xvec)
  #print(x$yvec)

  cat("\nEquation of the", x$desc,"\n")
  cat(format(x$eqn),"\n")
  #print(x$eqn)

  cat("\nCoefficients (slope and intercept) of the line  \n") # (when the line is in the form: y = slope * x + intercept) \n")
  # cat(format(x$coefficients),"\n")
  print(x$coefficients)
} #end of the function
#'
########################
#'
#' @title Plot a \code{Lines} \code{object}
#'
#' @description Plots the line together with the defining \code{points}.
#'
#' @param x Object of class \code{Lines}.
#' @param asp A \code{numeric} value, giving the aspect ratio
#' for \eqn{y}-axis to \eqn{x}-axis \eqn{y/x} (default is \code{NA}),
#' see the official help for \code{asp} by typing "\code{? asp}".
#' @param xlab,ylab Titles for the \eqn{x} and \eqn{y} axes,
#' respectively (default is \code{xlab="x"} and \code{ylab="y"}).
#' @param \dots Additional parameters for \code{plot}.
#'
#' @return
#' None
#'
#' @seealso \code{\link{print.Lines}}, \code{\link{summary.Lines}},
#' and \code{\link{print.summary.Lines}}
#'
#' @examples
#' \dontrun{
#' A<-c(-1.22,-2.33); B<-c(2.55,3.75)
#' xr<-range(A,B);
#' xf<-(xr[2]-xr[1])*.1
#' #how far to go at the lower and upper ends in the x-coordinate
#' x<-seq(xr[1]-xf,xr[2]+xf,l=3) #try also l=10, 20 or 100
#'
#' lnAB<-Line(A,B,x)
#' lnAB
#' plot(lnAB)
#' }
#'
#' @export
plot.Lines<-function (x, asp=NA, xlab="x",ylab="y",...)
{
  if (!inherits(x, "Lines"))
    stop("x must be of class \"Lines\"")

  A<-x$points[1,]
  B<-x$points[2,]
  pts<-x$points
  vert<-x$vert
  eqn.lab<-x$eqnlabel

  xl = range(x$x,pts[,1])

  xf<-(xl[2]-xl[1])*.1
  xp<-seq(xl[1]-xf,xl[2]+xf,l=3) #try also l=10, 20 or 100

  Sl<-x$slope
  if (abs(Sl)==Inf)
  {yp<-NA
  Ylim<-range(0,pts[,2])
  } else
  {
    yp<-x$intercept+Sl*xp
    Ylim<-range(yp,pts[,2])
  }

  Xlim<-range(xp,pts[,1])

  xd<-Xlim[2]-Xlim[1]
  yd<-Ylim[2]-Ylim[1]
  pf<-c(xd,-yd)*.015
  ptf<-cbind(rep(pf[1],nrow(pts)),rep(pf[2],nrow(pts)))
  if (abs(Sl)==Inf)
  {
    plot(xp,rep(0,length(xp)),type="n",xlab=xlab,ylab=ylab,
         xlim=Xlim+xd*c(-.05,.05),ylim=Ylim+yd*c(-.05,.05),
         main=x$mtitle, ...)
    abline(v=vert)
    abline(h=0,lty=2)
    text(rbind(c(vert,0))+pf*.01, col=1,eqn.lab)
  } else
  {
    plot(xp,yp,asp=asp,type="l",xlab=xlab,ylab=ylab,
         xlim=Xlim+xd*c(-.05,.05),ylim=Ylim+yd*c(-.05,.05),
         main=x$mtitle, ...)
    text(rbind(c(median(xp),x$intercept+Sl*median(xp)))+pf*3,
         col=1,eqn.lab)
  }
  points(pts)
  text(pts+ptf,row.names(pts))
  segments(A[1],A[2], B[1], B[2], lty=1,col=2,lwd=2)
} #end of the function
#'

###############################################
#Auxiliary functions for class TriLines
###############################################

#'
#' @title Print a \code{TriLines} \code{object}
#'
#' @description Prints the \code{call} of the \code{object}
#' of class \code{"TriLines"}
#' and also the \code{coefficients} of the line
#' (in the form: \code{y = slope * x + intercept}),
#' and the vertices of the triangle
#' with respect to which the line is defined.
#'
#' @param x A \code{TriLines} \code{object}.
#' @param \dots Additional arguments for the S3 method \code{'print'}.
#'
#' @return
#' The \code{call} of the \code{object} of class \code{"TriLines"} ,
#' the \code{coefficients} of the line
#' (in the form: \code{y = slope * x + intercept}),
#' and the vertices of the triangle
#' with respect to which the line is defined.
#'
#' @seealso \code{\link{summary.TriLines}},
#' \code{\link{print.summary.TriLines}},
#' and \code{\link{plot.TriLines}}
#'
#' @examples
#' \dontrun{
#' A<-c(0,0); B<-c(1,0); C<-c(1/2,sqrt(3)/2);
#' Te<-rbind(A,B,C)
#' xfence<-abs(A[1]-B[1])*.25
#' #how far to go at the lower and upper ends in the x-coordinate
#' x<-seq(min(A[1],B[1])-xfence,max(A[1],B[1])+xfence,l=3)
#'
#' lnACM<-lineA2CMinTe(x)
#' lnACM
#' print(lnACM)
#'
#' typeof(lnACM)
#' attributes(lnACM)
#' }
#'
#' @export
print.TriLines <- function(x, ...)
{
  if (!inherits(x, "TriLines"))
    stop("x must be of class \"TriLines\"")

  cat("Call:\n")
  cat(format(x$call),"\n")
  #print(x$call)
  cat("\nEquation:\n")
  Eqn<-x$equation; names(Eqn)<-c()
  cat(format(Eqn),"\n")
  #print(Eqn)
  cat("\nThe vertices of the triangle, T = T(A,B,C), with respect to which the line is defined:\n")
  #cat(format(x$tri),"\n")
  print(x$tri)
} #end of the function
#'
########################
#'
#' @title Return a summary of a \code{TriLines} \code{object}
#'
#' @description Returns the below information about the \code{object}:
#'
#' \code{call} of the function defining the \code{object},
#' the defining \code{points},
#' selected \eqn{x} and \eqn{y} points on the line,
#' equation of the line, together with the vertices of the triangle,
#' and \code{coefficients} of the line.
#'
#' @param object An \code{object} of class \code{TriLines}.
#' @param \dots Additional parameters for \code{summary}.
#'
#' @return
#' The \code{call} of the \code{object} of class \code{"TriLines"},
#' the defining \code{points},
#' selected \eqn{x} and \eqn{y} points on the line,
#' equation of the line,
#' together with the vertices of the triangle,
#' and \code{coefficients} of the line
#' (in the form: \code{y = slope * x + intercept}).
#'
#' @seealso \code{\link{print.TriLines}},
#' \code{\link{print.summary.TriLines}},
#' and \code{\link{plot.TriLines}}
#'
#' @examples
#' \dontrun{
#' A<-c(0,0); B<-c(1,0); C<-c(1/2,sqrt(3)/2);
#' Te<-rbind(A,B,C)
#' xfence<-abs(A[1]-B[1])*.25
#' #how far to go at the lower and upper ends in the x-coordinate
#' x<-seq(min(A[1],B[1])-xfence,max(A[1],B[1])+xfence,l=3)
#'
#' lnACM<-lineA2CMinTe(x)
#' lnACM
#' summary(lnACM)
#' }
#'
#' @export
summary.TriLines <- function(object, ...)
{
  if (!inherits(object, "TriLines"))
    stop("object must be of class \"TriLines\"")

  eqn <- object$equation
  xv<-object$x
  yv<-object$y
  nv<-min(6,length(xv),length(yv))

  res <- list(txt=object$txt1,
              call=object$call,
              xvec=xv[1:nv],
              yvec=yv[1:nv],
              coefficients=c(object$slope,object$intercept),
              eqn=eqn)
  class(res) <- "summary.TriLines"
  res
} #end of the function
#'
########################
#'
#' @title Print a summary of a \code{TriLines} \code{object}
#'
#' @description Prints some information about the \code{object}
#'
#' @param x	 An \code{object} of class \code{"summary.TriLines"},
#' generated by \code{summary.TriLines}.
#' @param \dots Additional parameters for \code{print}.
#'
#' @return
#' None
#'
#' @seealso \code{\link{print.TriLines}},
#' \code{\link{summary.TriLines}},
#' and \code{\link{plot.TriLines}}
#'
#' @export
print.summary.TriLines <- function(x, ...)
{

  cat("Call:\n")
  cat(format(x$call),"\n")
  #print(x$call)
  cat("\nSelected x points (first row) and estimated y points (second row) that fall on the Line
      (first 6 or fewer are printed) \n")
  cat(format(x$xvec),"\n")
  cat(format(x$yvec),"\n")
  #print(x$xvec)
  #print(x$yvec)

  cat("\nEquation of the", x$txt,"\n")
  Eqn<-x$eqn; names(Eqn)<-c()
  cat(format(Eqn),"\n")
  #print(Eqn)

  cat("\nCoefficients of the line \n") # (in the form: y = slope * x + intercept) \n")
  #cat(format(x$coefficients),"\n")
  print(x$coefficients)
} #end of the function
#'
########################
#'
#' @title Plot a \code{TriLines} \code{object}
#'
#' @description Plots the line together with the defining triangle.
#'
#' @param x Object of class \code{TriLines}.
#' @param xlab,ylab Titles for the \eqn{x} and \eqn{y} axes,
#' respectively (default is \code{xlab="x"} and \code{ylab="y"}).
#' @param \dots Additional parameters for \code{plot}.
#'
#' @return
#' None
#'
#' @seealso \code{\link{print.TriLines}},
#' \code{\link{summary.TriLines}},
#' and \code{\link{print.summary.TriLines}}
#'
#' @examples
#' A<-c(0,0); B<-c(1,0); C<-c(1/2,sqrt(3)/2);
#' Te<-rbind(A,B,C)
#' xfence<-abs(A[1]-B[1])*.25
#' #how far to go at the lower and upper ends in the x-coordinate
#' x<-seq(min(A[1],B[1])-xfence,max(A[1],B[1])+xfence,l=3)
#'
#' lnACM<-lineA2CMinTe(x)
#' lnACM
#' plot(lnACM)
#'
#' @export
plot.TriLines<-function (x,xlab="x",ylab="y", ...)
{
  if (!inherits(x, "TriLines"))
    stop("x must be of class \"TriLines\"")
  Tr<-x$tri

  A<-Tr[1,]; B<-Tr[2,]; C<-Tr[3,]
  xfence<-abs(A[1]-B[1])*.25
  #how far to go at the lower and upper ends in the x-coordinate
  xp<-seq(min(A[1],B[1])-xfence,max(A[1],B[1])+xfence,l=3)
  #try also l=10, 20 or 100
  yp<-x$intercept+x$slope*xp

  M<-round(x$cent,2);
  if (x$cent.name=="CC")
  {D1<-(B+C)/2; D2<-(A+C)/2; D3<-(A+B)/2; #midpoints of the edges
  Ds<-rbind(D1,D2,D3)
  } else
  {Ds<-prj.cent2edges(Tr,M)}

  Xlim<-range(Tr[,1],xp)
  Ylim<-range(Tr[,2],yp)
  xd<-Xlim[2]-Xlim[1]
  yd<-Ylim[2]-Ylim[1]

  plot(Tr,pch=".",main=x$mtitle,xlab=xlab,ylab=ylab,
       xlim=Xlim+xd*c(-.05,.05),ylim=Ylim+yd*c(-.05,.05), ...)
  lines(xp,yp,lty=1,col=2)
  polygon(Tr)
  L<-Tr; R<-rbind(M,M,M)
  segments(L[,1], L[,2], R[,1], R[,2], lty=2)
  L<-Ds; R<-rbind(M,M,M)
  segments(L[,1], L[,2], R[,1], R[,2], lty=2)

  xp1<-median(xp)#as.numeric(quantile(xp)[2]);
  yp1<-x$intercept+x$slope*xp1

  txt<-rbind(Tr,M,Ds,c(xp1,yp1)+c(0,-.1))
  xc<-txt[,1]+c(-.02,.02,.02,.05,.05,-.03,.0,0)
  yc<-txt[,2]+c(.02,.02,.02,.02,0,.02,-.04,0)
  txt.str<-c("A","B","C",x$cent.name,"D1","D2","D3",
             x$txt2)
  text(xc,yc,txt.str,col=c(rep(1,7),2))
} #end of the function
#'

###############################################
#Auxiliary functions for class Lines3D
###############################################
#'
#' @title Print a \code{Lines3D} \code{object}
#'
#' @description Prints the \code{call} of the \code{object}
#' of class \code{"Lines3D"},
#' the \code{coefficients} of the line
#' (in the form: \code{x=x0 + A*t}, \code{y=y0 + B*t},
#' and \code{z=z0 + C*t}),
#' and the initial point together with the direction vector.
#'
#' @param x A \code{Lines3D} \code{object}.
#' @param \dots Additional arguments for the S3 method \code{'print'}.
#'
#' @return
#' The \code{call} of the \code{object} of class \code{"Lines3D"},
#' the \code{coefficients} of the line
#' (in the form: \code{x=x0 + A*t}, \code{y=y0 + B*t},
#' and \code{z=z0 + C*t}),
#' and the initial point together with the direction vector.
#'
#' @seealso \code{\link{summary.Lines3D}},
#' \code{\link{print.summary.Lines3D}},
#' and \code{\link{plot.Lines3D}}
#'
#' @examples
#' \dontrun{
#' P<-c(1,10,3); Q<-c(1,1,3);
#' vecs<-rbind(P,Q)
#' Line3D(P,Q,.1)
#' Line3D(P,Q,.1,dir.vec=FALSE)
#'
#' tr<-range(vecs);
#' tf<-(tr[2]-tr[1])*.1
#' #how far to go at the lower and upper ends in the x-coordinate
#' tsq<-seq(-tf*10-tf,tf*10+tf,l=3) #try also l=10, 20 or 100
#'
#' lnPQ3D<-Line3D(P,Q,tsq)
#' lnPQ3D
#' print(lnPQ3D)
#'
#' typeof(lnPQ3D)
#' attributes(lnPQ3D)
#' }
#'
#' @export
print.Lines3D <- function(x, ...)
{
  if (!inherits(x, "Lines3D"))
    stop("x must be of class \"Lines3D\"")

  cat("Call:\n")
  cat(format(x$call),"\n")
  #print(x$call)
  vnames<-x$vec.names
  cat("\nCoefficients of the parameterized line passing through initial point", vnames[1],"= (x0,y0,z0) in the direction of",vnames[2],"= (A,B,C) (for the form: x = x0 + A*t, y = y0 + B*t, and z = z0 + C*t) \n")
  #cat(format(x$vecs),"\n")
  print(x$vecs)
} #end of the function
#'
########################
#'
#' @title Return a summary of a \code{Lines3D} \code{object}
#'
#' @description Returns the below information about the \code{object}:
#'
#' \code{call} of the function defining the \code{object}, the defining vectors (i.e., initial and direction vectors),
#' selected \eqn{x}, \eqn{y}, and \eqn{z} points on the line,
#' equation of the line (in parametric form), and \code{coefficients} of the line.
#'
#' @param object An \code{object} of class \code{Lines3D}.
#' @param \dots Additional parameters for \code{summary}.
#'
#' @return
#' \code{call} of the function defining the \code{object},
#' the defining vectors (i.e., initial and direction vectors),
#' selected \eqn{x}, \eqn{y}, and \eqn{z} points on the line,
#' equation of the line (in parametric form),
#' and \code{coefficients} of the line
#' (for the form: \code{x=x0 + A*t}, \code{y=y0 + B*t},
#' and \code{z=z0 + C*t}).
#'
#' @seealso \code{\link{print.Lines3D}},
#' \code{\link{print.summary.Lines3D}},
#' and \code{\link{plot.Lines3D}}
#'
#' @examples
#' \dontrun{
#' P<-c(1,10,3); Q<-c(1,1,3);
#' vecs<-rbind(P,Q)
#' Line3D(P,Q,.1)
#' Line3D(P,Q,.1,dir.vec=FALSE)
#'
#' tr<-range(vecs);
#' tf<-(tr[2]-tr[1])*.1
#' #how far to go at the lower and upper ends in the x-coordinate
#' tsq<-seq(-tf*10-tf,tf*10+tf,l=3) #try also l=10, 20 or 100
#'
#' lnPQ3D<-Line3D(P,Q,tsq)
#' lnPQ3D
#' summary(lnPQ3D)
#' }
#'
#' @export
summary.Lines3D <- function(object, ...)
{
  if (!inherits(object, "Lines3D"))
    stop("object must be of class \"Lines3D\"")

  eqn <- object$equation
  names(eqn)<-c()
  vecs<-vecs2<-object$vecs
  vnames<-object$vec.names
  row.names(vecs2)<-vnames
  xv<-object$x
  yv<-object$y
  zv<-object$z
  nx<-min(6,length(xv))
  ny<-min(6,length(yv))
  nz<-min(6,length(zv))

  res <- list(desc=object$desc,
              call=object$call,
              vectors=vecs,
              xvec=xv[1:nx],
              yvec=yv[1:ny],
              zvec=zv[1:nz],
              coefficients=vecs2,
              eqn=eqn)
  class(res) <- "summary.Lines3D"
  res
} #end of the function
#'
########################
#'
#' @title Print a summary of a \code{Lines3D} \code{object}
#'
#' @description Prints some information about the \code{object}.
#'
#' @param x	 An \code{object} of class \code{"summary.Lines3D"},
#' generated by \code{summary.Lines3D}.
#' @param \dots Additional parameters for \code{print}.
#'
#' @return
#' None
#'
#' @seealso \code{\link{print.Lines3D}},
#' \code{\link{summary.Lines3D}},
#' and \code{\link{plot.Lines3D}}
#'
#' @export
print.summary.Lines3D <- function(x, ...)
{
  cat("Call:\n")
  cat(format(x$call),"\n")
  #print(x$call)
  cat("\nDefining Vectors\n")
  #cat(format(x$vectors),"\n")
  print(x$vectors)
  cat("\nEstimated x points (first row), y points (second row), and z points (third row)
   that fall on the Line
      (first 6 or fewer are printed at each row) \n")
  cat(format(x$xvec),"\n")
  cat(format(x$yvec),"\n")
  cat(format(x$zvec),"\n")
  #print(x$xvec)
  #print(x$yvec)
  #print(x$zvec)

  cat("\nEquation of", x$desc,"\n")
  cat(format(x$eqn),"\n")
  #print(x$eqn)

  Vnames<-row.names(x$coefficients)
  cat("\nCoefficients of the parameterized line passing through initial point ", Vnames[1]," = (x0,y0,z0) in the direction of ",Vnames[2]," = (A,B,C) (in the form: x = x0 + A*t, y = y0 + B*t, and z = z0 + C*t) \n",sep="")
  #cat(format(x$coefficients),"\n")
  print(x$coefficients)
} #end of the function
#'
########################
#'
#' @title Plot a \code{Lines3D} \code{object}
#'
#' @description Plots the line together with the defining vectors
#' (i.e., the initial and direction vectors).
#'
#' @param x Object of class \code{Lines3D}.
#' @param xlab,ylab,zlab Titles for the \eqn{x}, \eqn{y}, and \eqn{z} axes,
#' respectively (default is \code{xlab="x"}, \code{ylab="y"}
#' and \code{zlab="z"}).
#' @param theta,phi The angles defining the viewing direction.
#' \code{theta} gives the azimuthal direction and \code{phi} the colatitude.
#' See \code{\link[plot3D]{persp3D}} for more details.
#' @param \dots Additional parameters for \code{plot}.
#'
#' @return
#' None
#'
#' @seealso \code{\link{print.Lines3D}}, \code{\link{summary.Lines3D}},
#' and \code{\link{print.summary.Lines3D}}
#'
#' @examples
#' \dontrun{
#' P<-c(1,10,3); Q<-c(1,1,3);
#' vecs<-rbind(P,Q)
#' Line3D(P,Q,.1)
#' Line3D(P,Q,.1,dir.vec=FALSE)
#'
#' tr<-range(vecs);
#' tf<-(tr[2]-tr[1])*.1
#' #how far to go at the lower and upper ends in the x-coordinate
#' tsq<-seq(-tf*10-tf,tf*10+tf,l=3) #try also l=10, 20 or 100
#'
#' lnPQ3D<-Line3D(P,Q,tsq)
#' lnPQ3D
#' plot(lnPQ3D)
#' }
#'
#' @export
plot.Lines3D<-function (x,xlab="x",ylab="y",zlab="z",phi = 40, theta = 40,...)
{
  if (!inherits(x, "Lines3D"))
    stop("x must be of class \"Lines3D\"")

  A<-x$vecs[1,]
  Bd<-x$vecs[2,]
  Pts<-x$pts

  xc<-x$x
  yc<-x$y
  zc<-x$z

  tr<-range(x$tsq);
  tf<-(tr[2]-tr[1])*.1

  Xlim<-range(xc,Pts[,1])
  Ylim<-range(yc,Pts[,2])
  Zlim<-range(zc,Pts[,3])

  xd<-Xlim[2]-Xlim[1]
  yd<-Ylim[2]-Ylim[1]
  zd<-Zlim[2]-Zlim[1]
  if (zd==0)
  {Zlim=Xlim+Ylim;
  zd<-Zlim[2]-Zlim[1]}

  zr<-range(zc)
  if (zr[1]==zr[2])
  {zr=Xlim+Ylim}
  zf<-(zr[2]-zr[1])*.2
  Bv<-Bd*tf*5

  Dr<-A+min(x$tsq)*Bd

  if (x$vec.names[2]=="normal vector")
  {
    A0<-Pts[2,]; B0<-Pts[3,]; C0<-Pts[4,];
    pts<-rbind(A0,B0,C0)
    xr<-range(pts[,1],xc); yr<-range(pts[,2],yc)
    xf<-(xr[2]-xr[1])*.1
    #how far to go at the lower and upper ends in the x-coordinate
    yf<-(yr[2]-yr[1])*.1
    #how far to go at the lower and upper ends in the y-coordinate
    xs<-seq(xr[1]-xf,xr[2]+xf,l=3)
    ys<-seq(yr[1]-yf,yr[2]+yf,l=3)

    plABC<-Plane(A0,B0,C0,xs,ys)
    z.grid<-plABC$z

    Zlim<-range(zc,z.grid,Pts[,3])
    zd<-Zlim[2]-Zlim[1]

    Bv<- -Bd*zf*5
    Dr<-(A0+B0+C0)/3
    persp3D(z = z.grid, x = xs, y = ys, phi=phi,theta=theta, col="lightblue",
            ticktype = "detailed",xlab=xlab,ylab=ylab,zlab=zlab,
            xlim=Xlim+xd*c(-.05,.05),
            ylim=Ylim+yd*c(-.05,.05),zlim=Zlim+zd*c(-.05,.05),
            main=x$mtitle, ...) #plane spanned by points A, B, C
    lines3D(xc, yc, zc, bty = "g",pch = 20, cex = 2,
            ticktype = "detailed",add=TRUE)
    if (!is.null(Pts))
    {points3D(Pts[,1],Pts[,2],Pts[,3],add=TRUE)
      text3D(Pts[,1],Pts[,2],Pts[,3],labels=x$pnames,add=TRUE)}
    arrows3D(A[1],A[2],A[3]-zf,A[1],A[2],A[3],lty=2, add=TRUE)
    text3D(A[1],A[2],A[3]-zf,labels="initial point",add=TRUE)
    text3D(Dr[1]+Bv[1]/2,Dr[2]+Bv[2]/2,Dr[3]+zf+Bv[3]/2,
           labels=x$vec.names[2],add=TRUE)
    arrows3D(Dr[1],Dr[2],Dr[3]+zf,Dr[1]+Bv[1],Dr[2]+Bv[2],
             Dr[3]+zf+Bv[3], add=TRUE)
    text3D(A[1],A[2],A[3]+zf/2,labels=x$vec.names[1]
           ,add=TRUE)
    arrows3D(Dr[1]+Bv[1]/2,Dr[2]+Bv[2]/2,Dr[3]+3*zf+Bv[3]/2,
             Dr[1]+Bv[1]/2,Dr[2]+Bv[2]/2,Dr[3]+zf+Bv[3]/2,
             lty=2, add=TRUE)

  } else
  {
    lines3D(xc, yc, zc, phi = 0, bty = "g",main=x$mtitle,
            xlim=Xlim+xd*c(-.05,.05),ylim=Ylim+yd*c(-.05,.05),
            zlim=Zlim+zd*c(-.1,.1),
            cex = 2, ticktype = "detailed")
    if (!is.null(Pts))
    {points3D(Pts[,1],Pts[,2],Pts[,3],add=TRUE)
      text3D(Pts[,1],Pts[,2],Pts[,3],labels=x$pnames,add=TRUE)}
    arrows3D(A[1],A[2],A[3]-zf,A[1],A[2],A[3],lty=2, add=TRUE)
    text3D(A[1],A[2],A[3]-zf,labels="initial point",add=TRUE)
    text3D(Dr[1]+Bv[1]/2,Dr[2]+Bv[2]/2,Dr[3]+3*zf+Bv[3]/2,
           labels="direction vector",add=TRUE)
    arrows3D(Dr[1],Dr[2],Dr[3]+zf,Dr[1]+Bv[1],Dr[2]+Bv[2],
             Dr[3]+zf+Bv[3], add=TRUE)
    text3D(A[1],A[2],A[3]+zf/2,labels=x$vec.names[1],add=TRUE)
    arrows3D(Dr[1]+Bv[1]/2,Dr[2]+Bv[2]/2,Dr[3]+3*zf+Bv[3]/2,
             Dr[1]+Bv[1]/2,Dr[2]+Bv[2]/2,Dr[3]+zf+Bv[3]/2,lty=2,
             add=TRUE)
  }
} #end of the function
#'

###############################################
#Auxiliary functions for class Planes
###############################################
#'
#' @title Print a \code{Planes} \code{object}
#'
#' @description Prints the \code{call} of the \code{object}
#' of class \code{"Planes"}
#' and also the \code{coefficients} of the plane
#' (in the form: \code{z = A*x + B*y + C}).
#'
#' @param x A \code{Planes} \code{object}.
#' @param \dots Additional arguments for the S3 method \code{'print'}.
#'
#' @return
#' The \code{call} of the \code{object} of class \code{"Planes"}
#' and the \code{coefficients} of the plane
#' (in the form: \code{z = A*x + B*y + C}).
#'
#' @seealso \code{\link{summary.Planes}},
#' \code{\link{print.summary.Planes}},
#' and \code{\link{plot.Planes}}
#'
#' @examples
#' \dontrun{
#' P<-c(1,10,3); Q<-c(1,1,3); C<-c(3,9,12)
#' pts<-rbind(P,Q,C)
#'
#' xr<-range(pts[,1]); yr<-range(pts[,2])
#' xf<-(xr[2]-xr[1])*.1
#' #how far to go at the lower and upper ends in the x-coordinate
#' yf<-(yr[2]-yr[1])*.1
#' #how far to go at the lower and upper ends in the y-coordinate
#' x<-seq(xr[1]-xf,xr[2]+xf,l=5) #try also l=10, 20 or 100
#' y<-seq(yr[1]-yf,yr[2]+yf,l=5) #try also l=10, 20 or 100
#'
#' plPQC<-Plane(P,Q,C,x,y)
#' plPQC
#' print(plPQC)
#'
#' typeof(plPQC)
#' attributes(plPQC)
#' }
#'
#' @export
print.Planes <- function(x, ...)
{
  if (!inherits(x, "Planes"))
    stop("x must be of class \"Planes\"")

  cat("Call:\n")
  cat(format(x$call),"\n")
  #print(x$call)
  cat("\nCoefficients of the Plane (in the form: z = A*x + B*y + C):\n")
  #cat(format(x$coeff),"\n")
  print(c(x$coeff))
} #end of the function
#'
########################
#'
#' @title Return a summary of a \code{Planes} \code{object}
#'
#' @description Returns the below information about the \code{object}:
#'
#' \code{call} of the function defining the \code{object},
#' the defining 3D \code{points}, selected \eqn{x}, \eqn{y},
#' and \eqn{z} points on
#' the plane, equation of the plane, and \code{coefficients} of the plane.
#'
#' @param object An \code{object} of class \code{Planes}.
#' @param \dots Additional parameters for \code{summary}.
#'
#' @return
#' The \code{call} of the \code{object} of class \code{"Planes"},
#' the defining 3D \code{points}, selected \eqn{x}, \eqn{y},
#' and \eqn{z} points on the plane,
#' equation of the plane, and \code{coefficients} of the plane
#' (in the form: \code{z = A*x + B*y + C}).
#'
#' @seealso \code{\link{print.Planes}},
#' \code{\link{print.summary.Planes}},
#' and \code{\link{plot.Planes}}
#'
#' @examples
#' \dontrun{
#' P<-c(1,10,3); Q<-c(1,1,3); C<-c(3,9,12)
#' pts<-rbind(P,Q,C)
#'
#' xr<-range(pts[,1]); yr<-range(pts[,2])
#' xf<-(xr[2]-xr[1])*.1
#' #how far to go at the lower and upper ends in the x-coordinate
#' yf<-(yr[2]-yr[1])*.1
#' #how far to go at the lower and upper ends in the y-coordinate
#' x<-seq(xr[1]-xf,xr[2]+xf,l=5) #try also l=10, 20 or 100
#' y<-seq(yr[1]-yf,yr[2]+yf,l=5) #try also l=10, 20 or 100
#'
#' plPQC<-Plane(P,Q,C,x,y)
#' plPQC
#' summary(plPQC)
#' }
#'
#' @export
summary.Planes <- function(object, ...)
{
  if (!inherits(object, "Planes"))
    stop("object must be of class \"Planes\"")

  eqn <- object$equation
  names(eqn)<-c()
  pnts<-object$points
  xv<-object$x
  yv<-object$y
  zv<-object$z

  nv<-min(6,length(xv),length(yv),length(zv))

  res <- list(desc=object$desc,
              call=object$call,
              points=pnts,
              xvec=xv[1:nv],
              yvec=yv[1:nv],
              zvec=zv[1:nv],
              coefficients=object$coeff,
              eqn=eqn)
  class(res) <- "summary.Planes"
  res
} #end of the function
#'
########################
#'
#' @title Print a summary of a \code{Planes} \code{object}
#'
#' @description Prints some information about the \code{object}.
#'
#' @param x	 An \code{object} of class \code{"summary.Planes"},
#' generated by \code{summary.Planes}.
#' @param \dots Additional parameters for \code{print}.
#'
#' @return
#' None
#'
#' @seealso \code{\link{print.Planes}},
#' \code{\link{summary.Planes}},
#' and \code{\link{plot.Planes}}
#'
#' @export
print.summary.Planes <- function(x, ...)
{
  cat("Call:\n")
  cat(format(x$call),"\n")
  #print(x$call)
  cat("\nDefining Points\n")
  #cat(format(x$points),"\n")
  print(x$points)
  cat("\nSelected x and y points and estimated z points - presented row-wise, respectively - that fall on the Plane
      (first 6 or fewer are printed on each row) \n")
  cat(format(x$xvec),"\n")
  cat(format(x$yvec),"\n")
  cat(format(x$zvec),"\n")
  #print(x$xvec)
  #print(x$yvec)
  #print(x$zvec)

  cat("\nEquation of the", x$desc,"\n")
  cat(format(x$eqn),"\n")
  #print(x$eqn)

  cat("\nCoefficients of the Plane (in the form z = A*x + B*y + C):\n")
  #cat(format(x$coefficients),"\n")
  print(x$coefficients)
} #end of the function
#'
########################
#'
#' @title Plot a \code{Planes} \code{object}
#'
#' @description Plots the plane together with the defining 3D \code{points}.
#'
#' @param x Object of class \code{Planes}.
#' @param xlab,ylab,zlab Titles for the \eqn{x}, \eqn{y},
#' and \eqn{z} axes,
#' respectively (default is \code{xlab="x"}, \code{ylab="y"},
#' and \code{zlab="z"}).
#' @param x.grid.size,y.grid.size the size of the grids
#' for the \eqn{x} and \eqn{y} axes, default is 10 for both
#' @param theta,phi The angles defining the viewing direction,
#' default is 40 for both.
#' \code{theta} gives the azimuthal direction and
#' \code{phi} the colatitude. see \code{\link[graphics]{persp}}.
#' @param \dots Additional parameters for \code{plot}.
#'
#' @return
#' None
#'
#' @seealso \code{\link{print.Planes}},
#' \code{\link{summary.Planes}},
#' and \code{\link{print.summary.Planes}}
#'
#' @examples
#' \dontrun{
#' P<-c(1,10,3); Q<-c(1,1,3); C<-c(3,9,12)
#' pts<-rbind(P,Q,C)
#'
#' xr<-range(pts[,1]); yr<-range(pts[,2])
#' xf<-(xr[2]-xr[1])*.1
#' #how far to go at the lower and upper ends in the x-coordinate
#' yf<-(yr[2]-yr[1])*.1
#' #how far to go at the lower and upper ends in the y-coordinate
#' x<-seq(xr[1]-xf,xr[2]+xf,l=5) #try also l=10, 20 or 100
#' y<-seq(yr[1]-yf,yr[2]+yf,l=5) #try also l=10, 20 or 100
#'
#' plPQC<-Plane(P,Q,C,x,y)
#' plPQC
#' plot(plPQC,theta = 225, phi = 30, expand = 0.7,
#' facets = FALSE, scale = TRUE)
#' }
#'
#' @export
plot.Planes<-function (x, x.grid.size=10, y.grid.size=10,xlab="x",ylab="y",zlab="z",phi = 40, theta = 40,...)
{
  if (!inherits(x, "Planes"))
    stop("x must be of class \"Planes\"")

  A<-x$points[1,]
  B<-x$points[2,]
  C<-x$points[3,]
  pts<-x$points
  Cf<-x$coeff

  xl = range(x$x,pts[,1])
  yl = range(x$y,pts[,2])

  xf<-(xl[2]-xl[1])*.1
  yf<-(yl[2]-yl[1])*.1
  xgs=x.grid.size; ygs=y.grid.size;
  xp<-seq(xl[1]-xf,xl[2]+xf,l=xgs)
  yp<-seq(yl[1]-yf,yl[2]+yf,l=ygs)

  zgrid <- outer(xp, yp, function(a, b) Cf[1]*a+Cf[2]*b+Cf[3])

  xlim<-range(xp); ylim<-range(yp); zlim<-range(zgrid)

  xd<-xlim[2]-xlim[1]
  yd<-ylim[2]-ylim[1]
  zd<-zlim[2]-zlim[1]

  pxf<-xd*.025; pyf<-yd*.025; pzf<-zd*.025
  ptf<-cbind(rep(-pxf,nrow(pts)),rep(-pyf,nrow(pts)),rep(pzf,nrow(pts)))

  Pts<-pts+ptf
  Mn.pts<-c(mean(xp),mean(yp),mean(zgrid))

  persp3D(z = zgrid, x = xp, y = yp, xlab=xlab,ylab=ylab,
          zlab=zlab,phi=phi,theta=theta,
          xlim=xlim+xd*c(-.05,.05),ylim=ylim+yd*c(-.05,.05),
          zlim=zlim+zd*c(-.05,.05),
          main=x$main.title, ...)
  #plane spanned by points A, B, C
  points3D(Pts[,1],Pts[,2],Pts[,3], add=TRUE)
  #add the defining points
  text3D(Pts[,1],Pts[,2],Pts[,3], row.names(pts),add=TRUE)
  text3D(Mn.pts[1],Mn.pts[2],Mn.pts[3]+zd*.35,
         x$equation2,add=TRUE)
  #  polygon3D(Pts[1:3,1],Pts[1:3,2],Pts[1:3,3],add=TRUE)
} #end of the function
#'

###############################################
#Auxiliary functions for class Patterns
###############################################
#'
#' @title Print a \code{Patterns} \code{object}
#'
#' @description Prints the \code{call} of the \code{object}
#' of class \code{"Patterns"}
#' and also the \code{type} (or description) of the pattern).
#'
#' @param x A \code{Patterns} \code{object}.
#' @param \dots Additional arguments for the S3 method \code{'print'}.
#'
#' @return
#' The \code{call} of the \code{object} of class \code{"Patterns"}
#' and also the \code{type} (or description) of the pattern).
#'
#' @seealso \code{\link{summary.Patterns}},
#' \code{\link{print.summary.Patterns}},
#' and \code{\link{plot.Patterns}}
#'
#' @examples
#' \dontrun{
#' nx<-10; #try also 20, 100, and 1000
#' ny<-5; #try also 1
#' e<-.15;
#' Y<-cbind(runif(ny),runif(ny))
#' #with default bounding box (i.e., unit square)
#'
#' Xdt<-rseg.circular(nx,Y,e)
#' Xdt
#' print(Xdt)
#'
#' typeof(Xdt))
#' attributes(Xdt)
#' }
#'
#' @export
print.Patterns <- function(x, ...)
{
  if (!inherits(x, "Patterns"))
    stop("x must be of class \"Patterns\"")

  cat("Call:\n")
  cat(format(x$call),"\n")
  #print(x$call)
  cat("\nType:\n")
  cat(format(x$type),"\n")
  #print(x$type)
} #end of the function
#'
########################
#'
#' @title Return a summary of a \code{Patterns} \code{object}
#'
#' @description Returns the below information
#' about the \code{object}:
#'
#' \code{call} of the function defining the \code{object},
#' the \code{type} of the pattern, \code{parameters} of the pattern,
#' study window, some sample points from the generated pattern,
#' reference points (if any for the bivariate pattern),
#' and number of points for each class
#'
#' @param object An \code{object} of class \code{Patterns}.
#' @param \dots Additional parameters for \code{summary}.
#'
#' @return
#' The \code{call} of the \code{object} of class \code{"Patterns"},
#' the \code{type} of the pattern, \code{parameters} of the pattern,
#' study window, some sample points from the generated pattern,
#' reference points (if any for the bivariate pattern),
#' and number of points for each class
#'
#' @seealso \code{\link{print.Patterns}},
#' \code{\link{print.summary.Patterns}},
#' and \code{\link{plot.Patterns}}
#'
#' @examples
#' \dontrun{
#' nx<-10; #try also 10, 100, and 1000
#' ny<-5; #try also 1
#' e<-.15;
#' Y<-cbind(runif(ny),runif(ny))
#' #with default bounding box (i.e., unit square)
#'
#' Xdt<-rseg.circular(nx,Y,e)
#' Xdt
#' summary(Xdt)
#' }
#'
#' @export
summary.Patterns <- function(object, ...)
{
  if (!inherits(object, "Patterns"))
    stop("object must be of class \"Patterns\"")

  typ <- object$type
  xv<-as.matrix(object$gen.points)
  yv<-as.matrix(object$ref.points)
  nx<-nrow(xv); ny<-nrow(yv);
  #nx<-min(6,nrow(xv))
  #ny<-min(6,nrow(yv))
  Npts<-object$num.points

  res <- list(desc=object$desc.pat,
              call=object$call,
              xvec=xv[1:nx,],
              yvec=yv[1:ny,],
              param=object$parameters,
              type=typ,
              num.pts=Npts,
              Xlim=object$xlimit,
              Ylim=object$ylimit,
              pat.desc=object$desc.pat
  )

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

  cat("\nType of the Pattern\n")
  cat(format(x$type),"\n")
  #print(x$type)

  cat("\nParameters of the Pattern\n")
  #cat(format(x$param),"\n")
  print(x$param)

  cat("\nStudy Window\n")
  cat("range in x-coordinate =", x$Xlim,"\n")
  cat("range in y-coordinate =", x$Ylim,"\n")

  cat("\nNumber of points:\n")
  cat(format(c("nx","ny")),"\n")
  cat(format(x$num.pts),"\n")
  #print(x$num.pts)
  cat("nx = number of generated points according to the pattern \nny = number of reference (i.e. Y) points \n")
} #end of the function
#'
########################
#'
#' @title Plot a \code{Patterns} \code{object}
#'
#' @description Plots the points generated from the pattern
#' (color coded for each class) together with the
#' study window
#'
#' @param x Object of class \code{Patterns}.
#' @param asp A \code{numeric} value,
#' giving the aspect ratio for \eqn{y}-axis to \eqn{x}-axis \eqn{y/x}
#' (default is \code{NA}),
#' see the official help for \code{asp} by typing "\code{? asp}".
#' @param xlab,ylab Titles for the \eqn{x} and \eqn{y} axes,
#' respectively (default is \code{xlab="x"} and \code{ylab="y"}).
#' @param \dots Additional parameters for \code{plot}.
#'
#' @return
#' None
#'
#' @seealso \code{\link{print.Patterns}},
#' \code{\link{summary.Patterns}},
#' and \code{\link{print.summary.Patterns}}
#'
#' @examples
#' \dontrun{
#' nx<-10; #try also 100 and 1000
#' ny<-5; #try also 1
#' e<-.15;
#' Y<-cbind(runif(ny),runif(ny))
#' #with default bounding box (i.e., unit square)
#'
#' Xdt<-rseg.circular(nx,Y,e)
#' Xdt
#' plot(Xdt,asp=1)
#' }
#'
#' @export
plot.Patterns<-function (x, asp=NA,xlab="x",ylab="y",...)
{
  Y<-x$ref.points
  NY<-nrow(Y)
  Xdt<-x$gen.points
  Xlim<-x$xlimit
  Ylim<-x$ylimit

  xf<-.01*(Xlim[2]-Xlim[1])
  yf<-.01*(Ylim[2]-Ylim[1])

  plot(Y,asp=asp,pch=16,col=2,lwd=2, xlab=xlab,ylab=ylab,
       main=x$mtitle,
       xlim=Xlim+c(-xf,xf),ylim=Ylim+c(-yf,yf), ...)
  points(Xdt,pch=".",cex=3)
  if (x$tri.Y==TRUE && NY==3)
  {polygon(Y)
  } else if (x$tri.Y==TRUE && NY>3)
  {
    DTY<-interp::tri.mesh(Y[,1],Y[,2],duplicate="remove")
    #Delaunay triangulation based on Y points
    interp::plot.triSht(DTY, add=TRUE,
                        do.points=TRUE,col="blue")
  }
} #end of the function
#'

###############################################
#Auxiliary functions for class Uniform
###############################################
#'
#' @title Print a \code{Uniform} \code{object}
#'
#' @description Prints the \code{call} of the \code{object} of class \code{"Uniform"}
#' and also the \code{type}
#' (i.e. a brief description) of the uniform distribution).
#'
#' @param x A \code{Uniform} \code{object}.
#' @param \dots Additional arguments for the S3 method \code{'print'}.
#'
#' @return
#' The \code{call} of the \code{object} of class \code{"Uniform"}
#' and also the \code{type}
#' (i.e. a brief description) of the uniform distribution).
#'
#' @seealso \code{\link{summary.Uniform}},
#' \code{\link{print.summary.Uniform}},
#' and \code{\link{plot.Uniform}}
#'
#' @examples
#' \dontrun{
#' n<-10 #try also 20, 100, and 1000
#' A<-c(1,1); B<-c(2,0); C<-c(1.5,2);
#' Tr<-rbind(A,B,C)
#'
#' Xdt<-runif.tri(n,Tr)
#' Xdt
#' print(Xdt)
#'
#' typeof(Xdt))
#' attributes(Xdt)
#' }
#'
#' @export
print.Uniform <- function(x, ...)
{
  if (!inherits(x, "Uniform"))
    stop("x must be of class \"Uniform\"")

  cat("Call:\n")
  cat(format(x$call),"\n")
  #print(x$call)
  cat("\nType:\n")
  cat(format(x$type),"\n")
  #print(x$type)
} #end of the function
#'
########################
#'
#' @title Return a summary of a \code{Uniform} \code{object}
#'
#' @description Returns the below information about the \code{object}:
#'
#' \code{call} of the function defining the \code{object},
#' the \code{type} of the pattern (i.e. the description
#' of the uniform distribution), study window,
#' vertices of the support of the Uniform distribution,
#' some sample points generated from the uniform distribution,
#' and the number of points (i.e., number of generated
#' points and the number of vertices of the support
#' of the uniform distribution.)
#'
#' @param object An \code{object} of class \code{Uniform}.
#' @param \dots Additional parameters for \code{summary}.
#'
#' @return
#' The \code{call} of the \code{object} of class \code{"Uniform"},
#' the \code{type} of the pattern (i.e. the description
#' of the uniform distribution), study window,
#' vertices of the support of the Uniform distribution,
#' some sample points generated from the uniform distribution,
#' and the number of points (i.e., number of generated
#' points and the number of vertices of
#' the support of the uniform distribution.)
#'
#' @seealso \code{\link{print.Uniform}},
#' \code{\link{print.summary.Uniform}},
#' and \code{\link{plot.Uniform}}
#'
#' @examples
#' \dontrun{
#' n<-10 #try also 20, 100, and 1000
#' A<-c(1,1); B<-c(2,0); R<-c(1.5,2);
#' Tr<-rbind(A,B,R)
#'
#' Xdt<-runif.tri(n,Tr)
#' Xdt
#' summary(Xdt)
#' }
#'
#' @export
summary.Uniform <- function(object, ...)
{
  if (!inherits(object, "Uniform"))
    stop("object must be of class \"Uniform\"")

  typ <- object$type
  xv<-as.matrix(object$gen.points)
  yv<-as.matrix(object$tess.points)
  dimn<-dimension(xv)
  # nx<-min(6,nrow(xv))
  # ny<-min(6,nrow(yv))
  Npts<-object$num.points

  res <- list(desc=object$desc.pat,
              call=object$call,
              # xvec=xv[1:nx,],
              # yvec=yv[1:ny,],
              Support=object$tess.points,
              type=typ,
              num.pts=Npts, txt4points=object$txt4pnts,
              Xlim=object$xlimit,
              Ylim=object$ylimit,
              pat.desc=object$desc.pat,
              dimen=dimn
  )

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

  cat("\nType of the Pattern : ")
  cat(format(x$type),"\n")
  #print(x$type)

  cat("\nStudy Window\n")
  cat("range in x-coordinate =", x$Xlim,"\n")
  cat("range in y-coordinate =", x$Ylim,"\n")

  Dimn<-x$dimen

  if (Dimn==2)
  {
    ny<-x$num.pts[2]
    if (ny<=3)
    {
      cat("\nVertices of the Support of the Uniform Distribution\n")
      cat(format(x$yvec),"\n")
      #print(x$yvec)
    } else
    {
      cat("\nThe x and y coordinates of the nodes on the boundary of the convex hull of Y points and their indices (labeled as i) \n")
      Yp<-x$Support
      Ydeltri<-interp::tri.mesh(Yp[,1],Yp[,2],duplicate="remove")
      #cat(format(convex.hull(Ydeltri)),"\n")
      ch = convex.hull(Ydeltri)
      ch.pnts = rbind(ch$x,ch$y,ch$i)
      row.names(ch.pnts) = c("x","y","i")
      print(rbind(ch.pnts))
    }
  } else if (Dimn==3)
  {
    cat("\nVertices of the Support of the Uniform Distribution\n")
    cat(format(x$yvec),"\n")
    #print(x$yvec)
  } else
  {stop('Currently summary.Uniform works for 2D and 3D Data')}

  # cat("\n", x$pat.desc ," \n(first 6 or fewer are printed) \n")
  #  print(x$xvec)

  cat("\nNumber of points\n")
  cat(format(c("nx","ny")),"\n")
  cat(format(x$num.pts),"\n")
  #print(x$num.pts)
  cat(x$txt4points)
} #end of the function
#'
########################
#'
#' @title Plot a \code{Uniform} \code{object}
#'
#' @description Plots the points generated from the uniform distribution
#' together with the support region
#'
#' @param x Object of class \code{Uniform}.
#' @param asp A \code{numeric} value,
#' giving the aspect ratio for \eqn{y}-axis to \eqn{x}-axis
#' \eqn{y/x} for the 2D case,
#' it is redundant in the 3D case (default is \code{NA}),
#' see the official help for \code{asp} by typing "\code{? asp}".
#' @param xlab,ylab,zlab Titles for the \eqn{x} and \eqn{y} axes
#' in the 2D case,
#' and \eqn{x}, \eqn{y}, and \eqn{z} axes in the 3D case,
#' respectively (default is \code{xlab="x"}, \code{ylab="y"},
#' and \code{zlab="z"}).
#' @param \dots Additional parameters for \code{plot}.
#'
#' @return
#' None
#'
#' @seealso \code{\link{print.Uniform}},
#' \code{\link{summary.Uniform}},
#' and \code{\link{print.summary.Uniform}}
#'
#' @examples
#' \dontrun{
#' n<-10 #try also 20, 100, and 1000
#' A<-c(1,1); B<-c(2,0); C<-c(1.5,2);
#' Tr<-rbind(A,B,C)
#'
#' Xdt<-runif.tri(n,Tr)
#' Xdt
#' plot(Xdt,asp=1)
#' }
#'
#' @export
plot.Uniform<-function (x,asp=NA,xlab="x",ylab="y",zlab="z", ...)
{
  Y<-x$tess.points
  NY<-nrow(Y)
  XXp<-x$gen.points
  Xlim<-x$xlimit
  Ylim<-x$ylimit
  Zlim<-x$zlimit

  xf<-.01*(Xlim[2]-Xlim[1])
  yf<-.01*(Ylim[2]-Ylim[1])
  zf<-.01*(Zlim[2]-Zlim[1])

  yv<-as.matrix(Y)
  Dimn<-dimension(yv)

  if (Dimn==2)
  {
    plot(Y,asp=asp,pch=16,col=2,lwd=2, xlab=xlab,ylab=ylab,main=x$mtitle,
         xlim=Xlim+c(-xf,xf),ylim=Ylim+c(-yf,yf), ...)
    if (!is.null(x$out.region))
    {
      polygon(Y,lty=1,border=2,col=5)
      polygon(x$out.region,lty=2)
      points(XXp,pch=".",cex=3)
    } else if (NY<=3)
    {
      polygon(Y,lty=1)
      points(XXp,pch=1)
    } else
    {
      DTY<-interp::tri.mesh(Y[,1],Y[,2],duplicate="remove")
      #Delaunay triangulation based on Y points
      interp::plot.triSht(DTY, add=TRUE, do.points = TRUE,
                          pch=16,col="blue")
      points(XXp,pch=".",cex=3)
    }
  } else if (Dimn==3)
  {
    scatter3D(XXp[,1],XXp[,2],XXp[,3], theta =225, phi = 30,main=x$mtitle,
              xlab=xlab,ylab=ylab,zlab=zlab, bty = "g",
              xlim=Xlim+c(-xf,xf), ylim=Ylim+c(-yf,yf),
              zlim=Zlim+c(-zf,zf),pch = 20, cex = 1,
              ticktype = "detailed", ...)
    #add the vertices of the tetrahedron
    points3D(Y[,1],Y[,2],Y[,3], add=TRUE)
    L<-rbind(Y[1,],Y[1,],Y[1,],Y[2,],Y[2,],Y[3,]);
    R<-rbind(Y[2,],Y[3,],Y[4,],Y[3,],Y[4,],Y[4,])
    segments3D(L[,1], L[,2], L[,3], R[,1], R[,2],R[,3],
               add=TRUE,lwd=2)
  } else
  {stop('Currently plot.Uniform works for 2D and 3D Data')}
} #end of the function
#'

###############################################
#Auxiliary functions for class Extrema
###############################################
#'
#' @title Print a \code{Extrema} \code{object}
#'
#' @description Prints the \code{call} of the \code{object}
#' of class \code{"Extrema"}
#' and also the \code{type}
#' (i.e. a brief description) of the extrema).
#'
#' @param x A \code{Extrema} \code{object}.
#' @param \dots Additional arguments for the S3 method \code{'print'}.
#'
#' @return
#' The \code{call} of the \code{object} of class \code{"Extrema"}
#' and also the \code{type}
#' (i.e. a brief description) of the extrema).
#'
#' @seealso \code{\link{summary.Extrema}},
#' \code{\link{print.summary.Extrema}},
#' and \code{\link{plot.Extrema}}
#'
#' @examples
#' \dontrun{
#' n<-10
#' Xp<-runif.std.tri(n)$gen.points
#' Ext<-cl2edges.std.tri(Xp)
#' Ext
#' print(Ext)
#'
#' typeof(Ext))
#' attributes(Ext)
#' }
#'
#' @export
print.Extrema <- function(x, ...)
{
  if (!inherits(x, "Extrema"))
    stop("x must be of class \"Extrema\"")

  cat("Call:\n")
  cat(format(x$call),"\n")
  #print(x$call)
  cat("\nType:\n")
  cat(format(x$type),"\n")
  #print(x$type)
} #end of the function
#'
########################
#'
#' @title Return a summary of a \code{Extrema} \code{object}
#'
#' @description Returns the below information about the \code{object}:
#'
#' \code{call} of the function defining the \code{object},
#' the \code{type} of the extrema (i.e. the description
#' of the extrema), extrema points,
#' distances from extrema to the reference \code{object}
#' (e.g. boundary of a triangle),
#' some of the data points (from which extrema is found).
#'
#' @param object An \code{object} of class \code{Extrema}.
#' @param \dots Additional parameters for \code{summary}.
#'
#' @return
#' The \code{call} of the \code{object} of class \code{"Extrema"},
#' the \code{type} of the extrema (i.e. the description
#' of the extrema), extrema points,
#' distances from extrema to the reference \code{object}
#' (e.g. boundary of a triangle),
#' some of the data points (from which extrema is found).
#'
#' @seealso \code{\link{print.Extrema}},
#' \code{\link{print.summary.Extrema}},
#' and \code{\link{plot.Extrema}}
#'
#' @examples
#' \dontrun{
#' n<-10
#' Xp<-runif.std.tri(n)$gen.points
#' Ext<-cl2edges.std.tri(Xp)
#' Ext
#' summary(Ext)
#' }
#'
#' @export
summary.Extrema <- function(object, ...)
{
  if (!inherits(object, "Extrema"))
    stop("object must be of class \"Extrema\"")

  typ <- object$type
  xv<-as.matrix(object$X)
  yv<-as.matrix(object$ROI)
  Extr<-object$ext #as.matrix(object$ext)
  # nx<-min(6,nrow(xv))
  # ny<-min(6,nrow(yv))
  Npts<-object$num.points

  res <- list(txt1=object$txt1,
              txt2=object$txt2,
              txt3=object$mtitle,
              call=object$call,
              #xvec=xv[1:nx,],
              #yvec=yv[1:ny,],
              yvec=yv,
              Support=object$ROI,
              Supp.type=object$supp.type,
              type=typ,
              desc=object$desc,
              extr=Extr,
              d2ref=object$dist2ref,
              Nx=Npts
  )
  class(res) <- "summary.Extrema"
  res
} #end of the function
#'
########################
#'
#' @title Print a summary of a \code{Extrema} \code{object}
#'
#' @description Prints some information about the \code{object}.
#'
#' @param x	 An \code{object} of class \code{"summary.Extrema"},
#' generated by \code{summary.Extrema}.
#' @param \dots Additional parameters for \code{print}.
#'
#' @return
#' None
#'
#' @seealso \code{\link{print.Extrema}},
#' \code{\link{summary.Extrema}},
#' and \code{\link{plot.Extrema}}
#'
#' @export
print.summary.Extrema <- function(x, ...)
{
  cat("Call:\n")
  cat(format(x$call),"\n")
  #print(x$call)

  cat("\nType of the Extrema\n")
  cat(format(x$type),"\n")
  #print(x$type)

  cat("\nExtremum Points:",x$desc,"\n")
  #cat(format(x$extr),"\n")
  print(x$extr)
  cat(format(x$txt1),"\n")
  #print(x$txt1)

  cat("\n", x$txt2 ,"\n")
  cat(format(x$d2ref),"\n")
  #print(x$d2ref)

  cat("\nVertices of the Support",x$Supp.type,"\n")
  #cat(format(x$yvec),"\n")
  print(x$yvec)

} #end of the function
#'
########################
#'
#' @title Plot an \code{Extrema} \code{object}
#'
#' @description Plots the data points and extrema
#' among these points together with the reference object
#' (e.g., boundary of the support region)
#'
#' @param x Object of class \code{Extrema}.
#' @param asp A \code{numeric} value,
#' giving the aspect ratio for \eqn{y}-axis to \eqn{x}-axis
#' \eqn{y/x} for the 2D case,
#' it is redundant in the 3D case (default is \code{NA}),
#' see the official help for \code{asp} by typing "\code{? asp}".
#' @param xlab,ylab,zlab Titles
#' for the \eqn{x} and \eqn{y} axes in the 2D case,
#' and \eqn{x}, \eqn{y}, and \eqn{z} axes in the 3D case,
#' respectively (default is \code{""} for all).
#' @param \dots Additional parameters for \code{plot}.
#'
#' @return
#' None
#'
#' @seealso \code{\link{print.Extrema}},
#' \code{\link{summary.Extrema}},
#' and \code{\link{print.summary.Extrema}}
#'
#' @examples
#' \dontrun{
#' n<-10
#' Xp<-runif.std.tri(n)$gen.points
#' Ext<-cl2edges.std.tri(Xp)
#' Ext
#' plot(Ext,asp=1)
#' }
#'
#' @export
plot.Extrema<-function (x,asp=NA,xlab="",ylab="",zlab="", ...)
{
  Y<-x$ROI
  Xdt<-x$X
  Cent<-x$cent
  dimn<-dimension(as.matrix(Xdt))

  if (dimn==1)
  {
    Xlim<-range(Y,Xdt)
    a<-Xlim[1]; b<-Xlim[2]
    xd<-b-a
    Mc<-Cent

    plot(cbind(Xdt,0),main=x$mtitle,xlab=xlab,ylab=ylab,
         xlim=Xlim+xd*c(-.05,.05), ...)
    abline(h=0)
    abline(v=c(a,b,Mc),col=c(1,1,2),lty=2)
    points(cbind(x$ext,0),pch=4,col=2)
    text(cbind(c(Y,Cent,x$region.centers)-.02*xd,-0.05),
         c("a","b",x$cent.name,x$region.names))
  } else if (dimn==2)
  {
    Xlim<-range(Y[,1],Cent[1],Xdt[,1])
    Ylim<-range(Y[,2],Cent[2],Xdt[,2])
    xd<-Xlim[2]-Xlim[1]
    yd<-Ylim[2]-Ylim[1]

    if (!is.null(x$cent.name) && x$cent.name=="CC") {asp<-1}

    plot(Xdt,asp=asp,main=x$mtitle,
         xlab=xlab,ylab=ylab,axes=TRUE,
         xlim=Xlim+xd*c(-.05,.05),
         ylim=Ylim+yd*c(-.05,.05), ...)
    polygon(Y,lty=1)

    points(x$ext,pty=2,pch=4,col="red")
    if (is.null(x$regions))
    {
      txt<-rbind(Y)
      xc<-txt[,1]+xd*c(-.02,.02,.02)
      yc<-txt[,2]+yd*c(.02,.02,.02)
      txt.str<-c("A","B","C")
    } else
    {
      for (i in 1:length(x$regions))
      {polygon(x$regions[[i]],lty=3)}
      txt<-rbind(Y,Cent,x$region.centers)
      ncent<-nrow(x$region.centers)
      xc<-txt[,1]+xd*c(-.02,.02,.02,.02,rep(0,ncent))
      yc<-txt[,2]+yd*c(.02,.02,.02,.03,rep(0,ncent))
      txt.str<-c("A","B","C",
                 x$cent.name,x$region.names)
    }
    text(xc,yc,txt.str)

  } else if (dimn==3)
  {
    A<-Y[1,]; B<-Y[2,]; C<-Y[3,]; D<-Y[4,];
    Xlim<-range(Y[,1],Cent[1])
    Ylim<-range(Y[,2],Cent[2])
    Zlim<-range(Y[,3],Cent[3])

    xd<-Xlim[2]-Xlim[1]
    yd<-Ylim[2]-Ylim[1]
    zd<-Zlim[2]-Zlim[1]

    scatter3D(Xdt[,1],Xdt[,2],Xdt[,3],
              main=x$mtitle,xlab=xlab,ylab=ylab,zlab="",
              phi =0,theta=40, bty = "g",
              xlim=Xlim+xd*c(-.05,.05),
              ylim=Ylim+yd*c(-.05,.05),
              zlim=Zlim+zd*c(-.05,.05), pch = 20, cex = 1,
              ticktype = "detailed", ...)
    #add the vertices of the tetrahedron
    points3D(Y[,1],Y[,2],Y[,3], add=TRUE)
    L<-rbind(A,A,A,B,B,C); R<-rbind(B,C,D,C,D,D)
    segments3D(L[,1], L[,2], L[,3], R[,1], R[,2],R[,3],
               add=TRUE,lwd=2)
    points3D(x$ext[,1],x$ext[,2],x$ext[,3], pch=4,
             col="red", add=TRUE)

    D1<-(A+B)/2; D2<-(A+C)/2; D3<-(A+D)/2;
    D4<-(B+C)/2; D5<-(B+D)/2; D6<-(C+D)/2;
    L<-rbind(D1,D2,D3,D4,D5,D6);
    R<-rbind(Cent,Cent,Cent,Cent,Cent,Cent)
    segments3D(L[,1], L[,2], L[,3], R[,1], R[,2],R[,3],
               add=TRUE,lty=2)

    txt<-rbind(Y,Cent,x$region.centers)
    ncent=nrow(x$region.centers)
    xc<-txt[,1]+xd*c(-.1,.05,.05,.05,0,rep(0,ncent))
    yc<-txt[,2]+yd*c(.05,.05,.05,.05,0,rep(0,ncent))
    zc<-txt[,3]+zd*c(.05,.05,.05,.05,0,rep(0,ncent))
    txt.str<-c("A","B","C","D",x$cent.name,x$region.names)
    text3D(txt[,1],txt[,2],txt[,3],txt.str,add=T)

  } else
  {stop('plot.Extrema works for 1D, 2D and 3D Data')}
} #end of the function
#'

###############################################
#Auxiliary functions for class PCDs
###############################################
#'
#' @title Print a \code{PCDs} \code{object}
#'
#' @description Prints the \code{call} of the \code{object}
#' of class \code{"PCDs"}
#' and also the \code{type} (i.e. a brief description)
#' of the proximity catch digraph (PCD.
#'
#' @param x A \code{PCDs} \code{object}.
#' @param \dots Additional arguments for the S3 method \code{'print'}.
#'
#' @return
#' The \code{call} of the \code{object} of class \code{"PCDs"}
#' and also the \code{type} (i.e. a brief description)
#' of the proximity catch digraph (PCD.
#'
#' @seealso \code{\link{summary.PCDs}},
#' \code{\link{print.summary.PCDs}},
#' and \code{\link{plot.PCDs}}
#'
#' @examples
#' \dontrun{
#' A<-c(1,1); B<-c(2,0); C<-c(1.5,2);
#' Tr<-rbind(A,B,C);
#' n<-10
#' Xp<-runif.tri(n,Tr)$g
#' M<-as.numeric(runif.tri(1,Tr)$g)
#' Arcs<-arcsAStri(Xp,Tr,M)
#' Arcs
#' print(Arcs)
#'
#' typeof(Arcs))
#' attributes(Arcs)
#' }
#'
#' @export
print.PCDs <- function(x, ...)
{
  if (!inherits(x, "PCDs"))
    stop("x must be of class \"PCDs\"")

  cat("Call:\n")
  cat(format(x$call),"\n")
  #print(x$call)
  cat("\nType:\n")
  cat(format(x$type),"\n")
  #print(x$type)
} #end of the function
#'
########################
#'
#' @title Return a summary of a \code{PCDs} \code{object}
#'
#' @description Returns the below information about the \code{object}:
#'
#' \code{call} of the function defining the \code{object},
#' the \code{type} of the proximity catch digraph (PCD),
#' (i.e. the description of the 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(s) of the PCD, and various quantities
#' (number of vertices,
#' number of arcs and arc density 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{PCDs}.
#' @param \dots Additional parameters for \code{summary}.
#'
#' @return
#' The \code{call} of the \code{object} of class \code{"PCDs"},
#' the \code{type} of the proximity catch digraph (PCD),
#' (i.e. the description of the 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(s) of the PCD, and various quantities
#' (number of vertices,
#' number of arcs and arc density of the PCDs,
#' number of vertices for the partition
#' and number of partition cells
#' (i.e., intervals or triangles)).
#'
#' @seealso \code{\link{print.PCDs}},
#' \code{\link{print.summary.PCDs}},
#' and \code{\link{plot.PCDs}}
#'
#' @examples
#' \dontrun{
#' A<-c(1,1); B<-c(2,0); C<-c(1.5,2);
#' Tr<-rbind(A,B,C);
#' n<-10
#' Xp<-runif.tri(n,Tr)$g
#' M<-as.numeric(runif.tri(1,Tr)$g)
#' Arcs<-arcsAStri(Xp,Tr,M)
#' Arcs
#' summary(Arcs)
#' }
#'
#' @export
summary.PCDs <- function(object, ...)
{
  if (!inherits(object, "PCDs"))
    stop("object must be of class \"PCDs\"")

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

  typ <- object$type
  xv<-as.matrix(object$vertices)
  yv<-as.matrix(object$tess.points)
  ifelse(!is.null(object$S),
         sv<-as.matrix(object$S),
         sv<-NA)
  ifelse(!is.null(object$E),
         ev<-as.matrix(object$E),
         ev<-NA)
  # nx<-min(6,nrow(xv))
  # ny<-min(6,nrow(yv))
  na<-min(6,nrow(sv))

  ifelse(!is.na(sv),
         svec<-sv[1:na,],
         svec<-NA)
  ifelse(!is.na(ev),
         evec<-ev[1:na,],
         evec<-NA)

  res <- list(txt=object$txt1,
              call=object$call,
              Vname=object$vert.name, Tname=object$tess.name,
              #xvec=xv[1:nx,],
              # yvec=yv[1:ny,],
              svec=svec,
              evec=evec,
              param=object$parameters,
              type=typ,
              Quant=object$quant,
              dimen=dimn)

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

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

  cat("\nVertices of the digraph = ",  x$Vname, "\nPartition points of the region = ", x$Tname,"\n")

  cat("\nParameters of the digraph:\n")
  #cat(format(x$param),"\n")
  print(x$param)

  cat("Various quantities of the digraph:\n")
  #cat(format(x$Quant),"\n")
  print(x$Quant)
} #end of the function
#'
########################
#'
#' @title Plot a \code{PCDs} \code{object}
#'
#' @description Plots the vertices and the arcs
#' 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{PCDs}.
#' @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.PCDs}},
#' \code{\link{summary.PCDs}},
#' and \code{\link{print.summary.PCDs}}
#'
#' @examples
#' \dontrun{
#' A<-c(1,1); B<-c(2,0); C<-c(1.5,2);
#' Tr<-rbind(A,B,C);
#' n<-10
#' Xp<-runif.tri(n,Tr)$g
#' M<-as.numeric(runif.tri(1,Tr)$g)
#' Arcs<-arcsAStri(Xp,Tr,M)
#' Arcs
#' plot(Arcs)
#' }
#'
#' @export
plot.PCDs<-function (x, Jit=0.1, ...)
{
  if (!inherits(x, "PCDs"))
    stop("x must be of class \"PCDs\"")

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

  dimn<-dimension(Xp)

  nx<-length(Xp); ny<-length(Yp)
  S<-x$S; ns = length(S)
  E<-x$E
  cent = x$param[[1]] #as.numeric(x$param[[1]])
  yjit<-runif(ns,-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(S))
      {arrows(S, yjit, E, yjit, length = 0.05, 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(S)) {arrows(S[,1], S[,2], E[,1], E[,2],
                             length = 0.1, 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(S)) {arrows(S[,1], S[,2], E[,1], E[,2],
                             length = 0.1, col= 4)}
  } else
  {stop('Currently only digraphs with vertices of dimension 1 or 2 are plotted.')}
} #end of the function
#'
###############################################
#Auxiliary functions for class NumArcs
###############################################
#'
#' @title Print a \code{NumArcs} \code{object}
#'
#' @description Prints the \code{call} of the \code{object}
#' of class \code{"NumArcs"}
#' and also the \code{desc} (i.e. a brief description)
#' of the output.
#'
#' @param x A \code{NumArcs} \code{object}.
#' @param \dots Additional arguments for the S3 method \code{'print'}.
#'
#' @return
#' The \code{call} of the \code{object} of class \code{"NumArcs"}
#' and also the \code{desc} (i.e. a brief description)
#' of the output: number of arcs in the proximity catch digraph (PCD) and
#' related quantities in the induced subdigraphs for points in the Delaunay cells.
#'
#' @seealso \code{\link{summary.NumArcs}}, \code{\link{print.summary.NumArcs}},
#' and \code{\link{plot.NumArcs}}
#'
#' @examples
#' \dontrun{
#' nx<-15; ny<-5;  #try also nx<-40; ny<-10 or nx<-1000; ny<-10;
#'
#' 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))
#' #try also Yp<-cbind(runif(ny,0,1),runif(ny,0,1))
#'
#' M<-"CC"  #try also M<-c(1,1,1)
#'
#' Narcs<-num.arcsAS(Xp,Yp,M)
#' Narcs
#' print(Narcs)
#'
#' typeof(Narcs)
#' attributes(Narcs)
#' }
#'
#' @export
print.NumArcs <- function(x, ...)
{
  if (!inherits(x, "NumArcs"))
    stop("x must be of class \"NumArcs\"")

  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{NumArcs} \code{object}
#'
#' @description Returns the below information about the \code{object}:
#'
#' \code{call} of the function defining the \code{object},
#' the description of the proximity catch digraph (PCD), \code{desc}.
#' In the one Delaunay cell case, the function provides
#' the total number of arcs in the digraph,
#' 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 arcs in the digraph,
#' number of arcs for the induced digraphs 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{NumArcs}.
#' @param \dots Additional parameters for \code{summary}.
#'
#' @return
#' The \code{call} of the \code{object} of class \code{"NumArcs"},
#' the \code{desc} of the proximity catch digraph (PCD),
#' total number of arcs in the digraph.
#' 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 arcs for the induced digraphs 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.NumArcs}}, \code{\link{print.summary.NumArcs}},
#' and \code{\link{plot.NumArcs}}
#'
#' @examples
#' \dontrun{
#' A<-c(1,1); B<-c(2,0); C<-c(1.5,2);
#' Tr<-rbind(A,B,C);
#' n<-10
#' Xp<-runif.tri(n,Tr)$g
#' M<-as.numeric(runif.tri(1,Tr)$g)
#' Arcs<-arcsAStri(Xp,Tr,M)
#' Arcs
#' summary(Arcs)
#' }
#'
#' @export
summary.NumArcs <- function(object, ...)
{
  if (!inherits(object, "NumArcs"))
    stop("object must be of class \"NumArcs\"")

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

  dimn<-dimension(Xp)

  if (dimn == 1)
  {
    num.in.ch = object$num.in.range
    cell.num.arcs = object$int.num.arcs
    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,
                  vertices = object$vertices,
                  tess.points = object$tess.points,
                  desc=object$desc, #description of the output
                  num.arcs=object$num.arcs, #number of arcs for the entire PCD
                  num.in.ch = num.in.ch, # number of Xp points in range of Yp points
                  cell.num.arcs = cell.num.arcs,#vector of number of arcs 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,
                     vertices = object$vertices,
                     tess.points = object$tess.points,
                     desc=object$desc, #description of the output
                     num.arcs=object$num.arcs, #number of arcs for the entire PCD
                     num.in.ch = num.in.ch, # number of Xp points in range of Yp points
                     cell.num.arcs = cell.num.arcs,#vector of number of arcs 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

        res <- list(call = object$call,
                    desc=object$desc, #description of the output
                    vertices=object$vertices,
                    tess.points=object$tess.points,
                    num.arcs=object$num.arcs, #number of arcs for the entire PCD
                    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.arcs = object$tri.num.arcs
        ind.in.cell = NULL
        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,
                    desc=object$desc, #description of the output
                    vertices=object$vertices,
                    tess.points=object$tess.points,
                    num.arcs=object$num.arcs, #number of arcs for the entire PCD
                    num.in.ch = num.in.ch, # number of Xp points in CH of Yp points
                    cell.num.arcs = cell.num.arcs,#vector of number of arcs 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

      res <- list(call = object$call,
                  desc=object$desc, #description of the output
                  vertices=object$vertices,
                  tess.points=object$tess.points,
                  num.arcs=object$num.arcs, #number of arcs for the entire PCD
                  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.NumArcs"
  res
} #end of the function
#'
########################
#'
#' @title Print a summary of a \code{NumArcs} \code{object}
#'
#' @description Prints some information about the \code{object}.
#'
#' @param x An \code{object} of class \code{"summary.NumArcs"}, generated by \code{summary.NumArcs}.
#' @param \dots Additional parameters for \code{print}.
#'
#' @return
#' None
#'
#' @seealso \code{\link{print.NumArcs}}, \code{\link{summary.NumArcs}},
#' and \code{\link{plot.NumArcs}}
#'
#' @export
print.summary.NumArcs <- 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<-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 arcs in the entire digraph = ",  x$num.arcs,"\n")
    cat("Numbers of arcs in the induced subdigraphs in the partition intervals = ",  x$cell.num.arcs,"\n")

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

      cat("Lengths of the (middle) partition intervals (used as weights in the arc 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 arcs in the digraph = ",  x$num.arcs,"\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
      {
        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 triangles based on Yp points = ",  x$num.in.cells,"\n")
        cat("Number of arcs in the entire digraph = ",  x$num.arcs,"\n")
        cat("Numbers of arcs in the induced subdigraphs in the Delaunay triangles = ",  x$cell.num.arcs,"\n")
        cat("Areas of the Delaunay triangles (used as weights in the arc 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 triangles:\n")
          cat(format(x$ind.in.cell),"\n")
        }

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

        cat("\nIndices of the Delaunay triangles 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 arcs in the digraph = ",  x$num.arcs,"\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{NumArcs} \code{object}
#'
#' @description Plots the scatter plot of the data points (i.e. vertices of the PCDs)
#' and the Delaunay tessellation of the nontarget points marked with number of arcs
#' in the centroid of the Delaunay cells.
#'
#' @param x Object of class \code{NumArcs}.
#' @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.NumArcs}}, \code{\link{summary.NumArcs}},
#' and \code{\link{print.summary.NumArcs}}
#'
#' @examples
#' \dontrun{
#' A<-c(1,1); B<-c(2,0); C<-c(1.5,2);
#' Tr<-rbind(A,B,C);
#' n<-10
#' Xp<-runif.tri(n,Tr)$g
#' M<-as.numeric(runif.tri(1,Tr)$g)
#' Arcs<-arcsAStri(Xp,Tr,M)
#' Arcs
#' plot(Arcs)
#' }
#'
#' @export
plot.NumArcs<-function (x, Jit=0.1, ...)
{
  if (!inherits(x, "NumArcs"))
    stop("x must be of class \"NumArcs\"")

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

  dimn<-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 Arcs of the ", substring(as.character(x$call)[1],9,10),"-PCD \n 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.arcs)
  } 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 Arcs of the ", substring(as.character(x$call)[1],9,10),"-PCD \n 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$num.arcs)
  } 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 Arcs of the ",substring(as.character(x$call)[1],9,10),"-PCD \n 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.arcs)
  } else
  {stop('Currently only data sets of dimension 1 or 2 are plotted.')}
} #end of the function
#'
elvanceyhan/pcds documentation built on June 29, 2023, 8:12 a.m.
rdrr.io home R language documentation Run R code online
CRAN packages Bioconductor packages R-Forge packages GitHub packages
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
elvanceyhan/pcds
Proximity Catch Digraphs and Their Applications

R/ClassFunctions.R
In elvanceyhan/pcds: Proximity Catch Digraphs and Their Applications

R Package Documentation

Browse R Packages

We want your feedback!

elvanceyhan/pcds Proximity Catch Digraphs and Their Applications

R/ClassFunctions.R In elvanceyhan/pcds: Proximity Catch Digraphs and Their Applications

R Package Documentation

Browse R Packages

We want your feedback!

elvanceyhan/pcds
Proximity Catch Digraphs and Their Applications

R/ClassFunctions.R
In elvanceyhan/pcds: Proximity Catch Digraphs and Their Applications
