Nothing
#' Product space representation of a relation
#'
#' This utility function takes the input matrix of a relation between two or more variables and yields its product space representation.
#' @param tt A (0,1) or boolean matrix, where the variables are set side by side, as in a truth table. Each variable has a number of columns equal to the number of possible values.
#' @param specnb A vector of integers ranging from 1 to \code{k}, where \code{k} is the number of subsets of the \code{tt} matrix. Values must start at one and can be increased by 1 or not. They determine the partitioning of the rows of the \code{tt} matrix between the \code{k} subsets.
#' @param infovar A two-column matrix containing identification numbers of the variables and the number of elements of each variable (size of the frame).
#' @return The matrix of the product space representation of the relation.
#' @author Claude Boivin
#' @examples
#' ttfw <- matrix(c(1,0,1,0,0,1,0,1,1,1,1,1),nrow = 3,
#' byrow = TRUE,
#' dimnames = list(NULL, c("foul", "fair", "foul", "fair")) )
#' specfw <- c(1,1,2)
#' infovarfw <- matrix(c(5,7,2,2), ncol = 2,
#' dimnames = list(NULL, c("varnb", "size")) )
#' rownames(ttfw) <- nameRows(ttfw)
#' ttfw
#' productSpace(tt = ttfw, specnb = specfw, infovar = infovarfw)
#' @export
#'
productSpace <- function(tt, specnb, infovar) {
#
# Local variables: varnb, size, z1, z0, zz, znelem, ndims, zinds, indinf, indsup,
# cnames, zNcols, zNcolsLast, ci, c1,
# j, zt, zx,
# k, zs, zs1,
# l, zw, zw1
# Functions calls: bca
#
# 2. checks
#
if (is.matrix(tt) == FALSE) {
stop("tt parameter must be a matrix.")
}
if ((is.matrix(infovar) ==FALSE) | (sum(infovar[,2]) != ncol(tt))) {
stop("infovar parameter must be a 2 column matrix with sum of 2nd column = ncol(tt).")
} else {
varnb <- (infovar)[,1]
size <- (infovar)[,2]
}
if ((is.numeric(specnb) ==FALSE) |(length(specnb) != nrow(tt))) {
stop("specnb parameter must be a numeric vector of length nrow(tt)")
}
z1 <- specnb[-1]
z0 <- specnb[-length(specnb)]
if (sum((z1 - z0) > 1) >0) {
stop("specnb values must be a sequence of numbers increasing by increments of 1 at most.")
} else # ok to execute function
{
#
# 3. processing
#
# 3.1 some working variables...
#
zz <- cbind(specnb,tt)
zz<-as.data.frame(zz)
znelem <- table(specnb) # nb elements of each specification
ndims <-length(size)
zinds <-cumsum(size)
indinf <- 1+zinds[length(zinds)-1]
indsup <- zinds[length(zinds)]
y<-vector()
#
# 3.2 Prepare elements's names as row and column names of the result
# in decreasing order
# use column names
#
if (is.null(colnames(tt))) {
cnames <- paste(rep("c",ncol(tt)),c(1:ncol(tt)),sep = "")
} else {
cnames <- colnames(tt)
}
zNcols <- list(cnames[indinf:indsup]) # pour dimnames de zt
zNcolsLast <-t(matrix(cnames[indinf:indsup])) # pour dotprod des noms
if (length(zinds) > 2) {
for (i in (length(zinds)-1):2) {
ci <-cnames[(1+zinds[i-1]):(zinds[i])]
zNcols[[length(zNcols)+1]] <- ci # pour dimnames de zt
zNcolsLast <- dotprod(matrix(ci), zNcolsLast, "paste", "paste") # for dotprod of names
zNcolsLast <-matrix(t(zNcolsLast), ncol = prod(dim(zNcolsLast)))
}
}
c1 <-cnames[1:zinds[1]]
zNcols[[length(zNcols)+1]] <- c1 # pour dimnames de zt
zNcolsLast <- dotprod(matrix(c1), zNcolsLast, "paste", "paste")
zNcolsLast <-matrix(t(zNcolsLast), ncol = prod(dim(zNcolsLast)))
# End columns names preparation
#
# 3.3 Looping
# A: loop on the number of subsets
for (j in 1:max(specnb)) {
# dimension of result in the product space
zt<-array(0,dim = size[order(varnb,decreasing = TRUE)], dimnames = zNcols)
#
# B: Loop on the number of elements of the subset
# B1: working table to gather all the elements of a subset
zx <- subset(zz, zz$specnb == j)
zx <-zx[,-1]
colnames(zx) <- cnames # keep original names if there are duplicates names
# B2: Loop on elements of the subset (specification j)
for (k in 1:znelem[j]) {
zs <- zx[k,1:zinds[1]]
zs1 <- as.vector(t(zs))
names(zs1) = colnames(zs)
# C: Loop on the variables
for (l in 2:length(varnb)) {
zw <-zx[k, (1+zinds[l-1]):(zinds[l])]
zw1 <- as.vector(t(zw))
names(zw1) <- colnames(zw)
# elements in the product space
zs1 <- outer(zw1, zs1, "*")
} # End of loop C
#
zt <- zt | zs1 # zt ok, checked
} # End of loop B
#
y <-c(y, zt) # transpose not necessary
} # End of loop A
#
# Result
y <- matrix(y, ncol = prod(size), byrow = TRUE) # by rows to follow the order of the column names
colnames(y) <- zNcolsLast
y
}
}
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.