Nothing
#' Make clamped CRF
#'
#' Generate clamped CRF by fixing the states of some nodes
#'
#' The function will generate a clamped CRF from a given CRF
#' by fixing the states of some nodes. The vector \code{clamped}
#' contains the desired state for each node while zero means the state is not
#' fixed. The node and edge potentials are updated to the conditional
#' potentials based on the clamped vector.
#'
#' @param crf The CRF generated by \code{\link{make.crf}}
#' @param clamped The vector of fixed states of nodes
#' @return The function will return a new CRF with additional components:
#' \item{original}{The original CRF.}
#' \item{clamped}{The vector of fixed states of nodes.}
#' \item{node.id}{The vector of the original node ids for nodes in the new CRF.}
#' \item{node.map}{The vector of the new node ids for nodes in the original CRF.}
#' \item{edge.id}{The vector of the original edge ids for edges in the new CRF.}
#' \item{edge.map}{The vector of the new edge ids for edges in the original CRF.}
#' @seealso \code{\link{make.crf}}, \code{\link{sub.crf}}, \code{\link{clamp.reset}}
#' @examples
#'
#' library(CRF)
#' data(Small)
#' crf <- clamp.crf(Small$crf, c(0, 0, 1, 1))
#'
#'
#' @export
clamp.crf <- function(crf, clamped)
{
data <- new.env()
if (!is.vector(clamped) || length(clamped) != crf$n.nodes)
stop("'clamped' should be a vector of length ", crf$n.nodes, "!")
if (any(clamped > crf$n.states | clamped < 0))
stop("'clamped' has invalid value(s)!")
data$original <- crf
data$clamped <- clamped
data$node.id <- which(clamped == 0)
data$n.nodes <- length(data$node.id)
data$node.map <- rep(0, crf$n.nodes)
data$node.map[data$node.id] <- 1:data$n.nodes
data$edge.id <- which(clamped[crf$edges[,1]] == 0 & clamped[crf$edges[,2]] == 0)
data$n.edges <- length(data$edge.id)
data$edges <- matrix(data$node.map[crf$edges[data$edge.id,]], ncol=2)
data$edge.map <- rep(0, crf$n.edges)
data$edge.map[data$edge.id] <- 1:data$n.edges
.Call(Make_AdjInfo, data)
data$n.states <- crf$n.states[data$node.id]
data$max.state <- max(data$n.states)
data$node.pot <- crf$node.pot[data$node.id, 1:data$max.state]
data$edge.pot <- crf$edge.pot[data$edge.id]
.Call(Clamp_Reset, data)
class(data) <- c("CRF.clamped", "CRF")
data
}
#' Reset clamped CRF
#'
#' Reset clamped CRF by changing the states of clamped nodes
#'
#' The function will reset a clamped CRF by changing the states of fixed nodes.
#' The vector \code{clamped} contains the desired state for each node
#' while zero means the state is not fixed. The node and edge potentials are
#' updated to the conditional potentials based on the clamped vector.
#'
#' @param crf The clamped CRF generated by \code{\link{clamp.crf}}
#' @param clamped The vector of fixed states of nodes
#' @return The function will return the same clamped CRF.
#' @seealso \code{\link{make.crf}}, \code{\link{clamp.crf}}
#' @examples
#'
#' library(CRF)
#' data(Small)
#' crf <- clamp.crf(Small$crf, c(0, 0, 1, 1))
#' clamp.reset(crf, c(0,0,2,2))
#'
#'
#' @export
clamp.reset <- function(crf, clamped)
{
if (is.na(class(crf)[1]) || class(crf)[1] != "CRF.clamped")
stop("'crf' is not class CRF.clamped!")
if (sum(xor(crf$clamped == 0, clamped == 0)) != 0)
stop("'clamped' has different clamped structure!")
if (any(clamped > crf$original$n.states | clamped < 0))
stop("'clamped' has invalid clamped value(s)!")
crf$clamped <- clamped
.Call(Clamp_Reset, crf)
crf
}
#' Make sub CRF
#'
#' Generate sub CRF by selecting some nodes
#'
#' The function will generate a new CRF from a given CRF
#' by selecting some nodes. The vector \code{subset} contains the
#' node ids selected to generate the new CRF. Unlike
#' \code{\link{clamp.crf}}, the potentials of remainning nodes and edges are
#' untouched.
#'
#' @param crf The CRF generated by \code{\link{make.crf}}
#' @param subset The vector of selected node ids
#' @return The function will return a new CRF with additional components:
#' \item{original}{The original CRF data.}
#' \item{node.id}{The vector of the original node ids for nodes in the new CRF.}
#' \item{node.map}{The vector of the new node ids for nodes in the original CRF.}
#' \item{edge.id}{The vector of the original edge ids for edges in the new CRF.}
#' \item{edge.map}{The vector of the new edge ids for edges in the original CRF.}
#' @seealso \code{\link{make.crf}}, \code{\link{clamp.crf}}
#' @examples
#'
#' library(CRF)
#' data(Small)
#' crf <- sub.crf(Small$crf, c(2, 3))
#'
#'
#' @export
sub.crf <- function(crf, subset)
{
data <- new.env()
data$original <- crf
data$node.id <- intersect(1:crf$n.nodes, unique(subset))
data$n.nodes <- length(data$node.id)
data$node.map <- rep(0, crf$n.nodes)
data$node.map[data$node.id] <- 1:data$n.nodes
data$edge.id <- which(data$node.map[crf$edges[,1]] != 0 & data$node.map[crf$edges[,2]] != 0)
data$n.edges <- length(data$edge.id)
data$edges <- matrix(data$node.map[crf$edges[data$edge.id,]], ncol=2)
data$edge.map <- rep(0, crf$n.edges)
data$edge.map[data$edge.id] <- 1:data$n.edges
adj.info <- .Call(Make_AdjInfo, data)
data$n.adj <- adj.info$n.adj
data$adj.nodes <- adj.info$adj.nodes
data$adj.edges <- adj.info$adj.edges
data$n.states <- crf$n.states[data$node.id]
data$max.state <- max(data$n.states)
data$node.pot <- array(crf$node.pot[data$node.id, 1:data$max.state], dim=c(data$n.nodes, data$max.state))
data$edge.pot <- crf$edge.pot[data$edge.id]
class(data) <- c("CRF.sub", "CRF")
data
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.