R/RcppExports.R

In ick003/SpTMixture: Mixture models with spatio-temporal dependencies

# Generated by using Rcpp::compileAttributes() -> do not edit by hand
# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393

#' Function to suppress rows from a matrix
#' @param x matrix which rows need to be erased
#' @param rowID row index
#' @examples
#' x<- matrix(1:9, ncol = 3)
#' row_erase(x,1:2)
#' @export
row_erase <- function(x, rowID) {
    .Call('SpTMixture_row_erase', PACKAGE = 'SpTMixture', x, rowID)
}

#' Function to get the bonds based on neighbourhood
#' @param Location matrix of coordinates.
#' @param NN maximum number of neighbours.
#' @examples
#' Obs.loc = as.matrix(expand.grid(1:4,1:4))
#' getBonds(Obs.loc, NN = 4)
#' @export
getBonds <- function(Location, NN, th = 2) {
    .Call('SpTMixture_getBonds', PACKAGE = 'SpTMixture', Location, NN, th)
}

#' Function to select bonds based on colors and parameters
#' @param Bds matrix of neighbouring bonds.
#' @param Cols vector of colors per vertex.
#' @param Betas vector of parameters for the Potts model.
#' @examples
#' Obs.loc = expand.grid(1:10,1:10)
#' Bds = getBonds(Obs.loc)
#' Bds = Bds[which(Bds[,1]>0),]
#' Betas = c(0.8, 0.8, 0.2)
#' Cols = sample(1:3, 100, replace = TRUE)
#' Bd = selectBonds(Bds, Cols, Betas)
#' par(mfrow = c(1,1))
#' col = grey.colors(3)
#' image(matrix(Cols, ncol = 10), col = col)
#' segments((Obs.loc[Bd[,1],1]-1)/9, (Obs.loc[Bd[,1],2]-1)/9, (Obs.loc[Bd[,2],1]-1)/9, (Obs.loc[Bd[,2],2]-1)/9)
#' segments((Obs.loc[,1]-1)/9, (Obs.loc[,2]-1)/9, (Obs.loc[,1]-1)/9, (Obs.loc[,2]-1)/9, lwd = 4)
#' @export
selectBonds <- function(Bds, Cols, Betas) {
    .Call('SpTMixture_selectBonds', PACKAGE = 'SpTMixture', Bds, Cols, Betas)
}

#' Function to identify components based on bonds.
#' @param Bds matrix of bonds.
#' @param nvert number of vertices.
#' @examples
#' Obs.loc = expand.grid(1:10,1:10)
#' Bds = getBonds(Obs.loc)
#' Bds = Bds[which(Bds[,1]>0),]
#' Betas = c(0.8, 0.8, 0.2)
#' Cols = sample(1:3, 100, replace = TRUE)
#' Bd = selectBonds(Bds, Cols, Betas)
#' Bd = Bd[which(Bd[,1]>0),]
#' par(mfrow = c(1,1))
#' col = grey.colors(3)
#' image(matrix(Cols, ncol = 10), col = col)
#' segments((Obs.loc[Bd[,1],1]-1)/9, (Obs.loc[Bd[,1],2]-1)/9, (Obs.loc[Bd[,2],1]-1)/9, (Obs.loc[Bd[,2],2]-1)/9)
#' segments((Obs.loc[,1]-1)/9, (Obs.loc[,2]-1)/9, (Obs.loc[,1]-1)/9, (Obs.loc[,2]-1)/9, lwd = 33, col = "black")
#' segments((Obs.loc[,1]-1)/9, (Obs.loc[,2]-1)/9, (Obs.loc[,1]-1)/9, (Obs.loc[,2]-1)/9, lwd = 32, col = "white")
#' Comp = setComp(Bd, 100)
#' col.comp = rainbow(100)
#' text((Obs.loc[,1]-1)/div,(Obs.loc[,2]-1)/div, labels = 1:100, col = col.comp[Comp])
#' @export
setComp <- function(Bds, nvert) {
    .Call('SpTMixture_setComp', PACKAGE = 'SpTMixture', Bds, nvert)
}

#' Function to summarize the components' statistics (size and colors).
#' @param Bds matrix of bonds.
#' @param nvert number of vertices.
#' @examples
#' Obs.loc = expand.grid(1:10,1:10)
#' Bds = getBonds(Obs.loc)
#' Bds = Bds[which(Bds[,1]>0),]
#' Betas = c(0.8, 0.8, 0.2)
#' Cols = sample(1:3, 100, replace = TRUE)
#' Bd = selectBonds(Bds, Cols, Betas)
#' Bd = Bd[which(Bd[,1]>0),]
#' par(mfrow = c(1,1))
#' col = grey.colors(3)
#' image(matrix(Cols, ncol = 10), col = col)
#' segments((Obs.loc[Bd[,1],1]-1)/9, (Obs.loc[Bd[,1],2]-1)/9, (Obs.loc[Bd[,2],1]-1)/9, (Obs.loc[Bd[,2],2]-1)/9)
#' segments((Obs.loc[,1]-1)/9, (Obs.loc[,2]-1)/9, (Obs.loc[,1]-1)/9, (Obs.loc[,2]-1)/9, lwd = 33, col = "black")
#' segments((Obs.loc[,1]-1)/9, (Obs.loc[,2]-1)/9, (Obs.loc[,1]-1)/9, (Obs.loc[,2]-1)/9, lwd = 32, col = "white")
#' Comp = setComp(Bd, 100)
#' col.comp = rainbow(100)
#' text((Obs.loc[,1]-1)/div,(Obs.loc[,2]-1)/div, labels = 1:100, col = col.comp[Comp])
#' @export
getCompStat <- function(Comp, CompID, Cols) {
    .Call('SpTMixture_getCompStat', PACKAGE = 'SpTMixture', Comp, CompID, Cols)
}

#' Function to flip components spins.
#' @param CompID vector of components IDs.
#' @param CompIDList Vector of possible components ID.
#' @param ncolor number of spins.
#' @examples
#' Obs.loc = expand.grid(1:10,1:10)
#' Bds = getBonds(Obs.loc)
#' Bds = Bds[which(Bds[,1]>0),]
#' Betas = c(0.8, 0.8, 0.2)
#' Cols = sample(1:3, 100, replace = TRUE)
#' Bd = selectBonds(Bds, Cols, Betas)
#' Bd = Bd[which(Bd[,1]>0),]
#' par(mfrow = c(1,1))
#' col = grey.colors(3)
#' image(matrix(Cols, ncol = 10), col = col)
#' segments((Obs.loc[Bd[,1],1]-1)/9, (Obs.loc[Bd[,1],2]-1)/9, (Obs.loc[Bd[,2],1]-1)/9, (Obs.loc[Bd[,2],2]-1)/9)
#' segments((Obs.loc[,1]-1)/9, (Obs.loc[,2]-1)/9, (Obs.loc[,1]-1)/9, (Obs.loc[,2]-1)/9, lwd = 33, col = "black")
#' segments((Obs.loc[,1]-1)/9, (Obs.loc[,2]-1)/9, (Obs.loc[,1]-1)/9, (Obs.loc[,2]-1)/9, lwd = 32, col = "white")
#' Comp = setComp(Bd, 100)
#' col.comp = rainbow(100)
#' text((Obs.loc[,1]-1)/div,(Obs.loc[,2]-1)/div, labels = 1:100, col = col.comp[Comp])
#' @export
flipComp <- function(CompID, CompIDList, ncolor) {
    .Call('SpTMixture_flipComp', PACKAGE = 'SpTMixture', CompID, CompIDList, ncolor)
}

#' Function to calculate the canonical statistic.
#' @param Bds matrix of bonds
#' @param Cols Vector of colors.
#' @param ncolor number of spins.
#' @examples
#' Obs.loc = as.matrix(expand.grid(1:4,1:4))
#' Bds = getBonds(Obs.loc, NN = 4)
#' Bds = Bds[which(Bds[,1]>0),]
#' Betas = c(0.8, 0.8, 0.2)
#' Cols = sample(1:3, 16, replace = TRUE)
#' par(mfrow = c(1,1))
#' col = grey.colors(3)
#' image(matrix(Cols, ncol = 4), col = col)
#' CS = getCanStatF(Bds, Cols, 3)
#' @export
getCanStatF <- function(Bds, Cols, ncolors) {
    .Call('SpTMixture_getCanStatF', PACKAGE = 'SpTMixture', Bds, Cols, ncolors)
}

#' Function to calculate the canonical statistic.
#' @param Bds matrix of bonds
#' @param Cols Vector of colors.
#' @param ncolor number of spins.
#' @examples
#' Obs.loc = as.matrix(expand.grid(1:4,1:4))
#' Bds = getBonds(Obs.loc, NN = 4)
#' Bds = Bds[which(Bds[,1]>0),]
#' Betas = c(0.8, 0.8, 0.2)
#' Cols = sample(1:3, 16, replace = TRUE)
#' par(mfrow = c(1,1))
#' col = grey.colors(3)
#' image(matrix(Cols, ncol = 4), col = col)
#' CS = getCanStat(Bds, Cols, 3)
#' @export
getCanStat <- function(Bds, Cols, ncolors) {
    .Call('SpTMixture_getCanStat', PACKAGE = 'SpTMixture', Bds, Cols, ncolors)
}

#' Function performing the loop in the SW algorithm.
#' @param Bds matrix of bonds
#' @param Cols Vector of colors.
#' @param ncolor number of spins.
#' @param Nrun number of runs.
#' @param Betas vector of parameters.
#' @examples
#' Obs.loc = as.matrix(expand.grid(1:10,1:10))
#' Bds = getBonds(Obs.loc, NN = 4)
#' Betas = c(0.8, 0.8, 0.2)
#' Cols = sample(1:3, 100, replace = TRUE)
#' par(mfrow = c(1,1))
#' col = grey.colors(3)
#' image(matrix(Cols, ncol = 10), col = col)
#' CS = loopSW(Bds, Cols, 3, 1000, Betas)
#' image(matrix(CS, ncol = 10), col = col)
#' @export
loopSW <- function(Bds, Cols, ncolors, Nrun, Betas) {
    .Call('SpTMixture_loopSW', PACKAGE = 'SpTMixture', Bds, Cols, ncolors, Nrun, Betas)
}