# R/segTraj_plot_simultanee.R In segclust2d: Bivariate Segmentation/Clustering Methods and Tools

#### Documented in bisig_plotmatrixRupt

```# bisig_plot
#' bisig_plot draws the plots of the bivariate signal on the same plot (scale
#' free)
#' @param x the signal to be plotted
#' @param rupt optional, if given add vertical lines at change points (rupt
#'   should a vector)
#' @param mu optional the mean of each class of segment,
#' @param pop optional the cluster to whom each segment belongs to,
#' @param merge.seg should segment be merged ?
#' @export
#' @return no value

bisig_plot<- function(x, rupt=NULL, mu=NULL, pop=NULL, merge.seg=FALSE){
n <- dim(x)[2]
if(!is.null(rupt)){
if(!is.matrix(rupt))
rupt <- ruptAsMat(rupt)
K <- dim(rupt)[1]
}
m <- rowMeans(x)
s <- apply(x,1,stats::sd)

x.norm <- sweep(x = x, MARGIN = 1, STATS = m)
x.norm <- sweep(x = x.norm, MARGIN = 1, STATS = s, FUN = '/')
graphics::plot(1:n,x.norm[1,],
pch=19, col=2,
ylab='', xlab = '', xaxt='n', yaxt='n')
graphics::points(1:n, x.norm[2,], pch=19, col=3)
if(!is.null(rupt)&!(merge.seg)){
invisible( lapply(1:K, function(d){
graphics::abline(v=rupt[d,1], lwd=1.5)}))
}
if(!is.null(rupt)&(merge.seg)){
change <- which(diff(pop)!=0)
p <- length(change)
ruptProv <- matrix(NA, nrow=p+1, ncol=2)
ruptProv[1, 1] <- rupt[1,1]
ruptProv[1, 2] <- rupt[change[1],2]
ruptProv[p+1, 1] <- rupt[change[p]+1,1]
ruptProv[p+1, 2] <- rupt[K,2]

if(p>1){
ruptProv[2:p,] <- t(vapply(1:(p-1), function(p_){c(rupt[change[p_]+1,1],
rupt[change[p_+1],2])}))
}
invisible( lapply(1:(p+1), function(d){
graphics::abline(v=ruptProv[d,1], lwd=1.5)}))

}
if(!is.null(mu) & !is.null(pop)){
invisible( lapply(1:K, function(d){
graphics::lines(c(rupt[d,1],rupt[d,2]+1),
(rep(mu[1,pop[d]],2)-m[1])/s[1], col=2)
graphics::lines(c(rupt[d,1],rupt[d,2]+1),
(rep(mu[2,pop[d]],2)-m[2])/s[2], col=3)
}))
}
}

# matrixRupt
#' matrixRupt transforms a vector of change point into a data.frame with start
#' and end of every segment
#' @param x the
#' @param vectorRupt the vector containing the change point
#'
#' @export
#' @return the matrix of change point

matrixRupt <- function(x,  vectorRupt){
n <- ncol(x)
posZeros <-  which(vectorRupt==0)
if(length(posZeros)>0){
K <- posZeros[1]-1
vectorRupt <- vectorRupt[1:K]
} else { }
return(matrix(c(1, vectorRupt[1:(K-1)]+1, vectorRupt[1:(K)]), ncol=2))
}
```

## Try the segclust2d package in your browser

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

segclust2d documentation built on Oct. 11, 2021, 9:10 a.m.