Nothing
#' Repeat ith element of list x or row of matrix/data.frames
#' for j times
#'
#' Suppose you have 3 different unique ballots and the amount
#' of each ballot is 10, 20, 30. Now you want to create raw
#' ballots as a list. Then you can use this function. See examples
#' for usage.
#' @param x a list, each element of which should be a vector. Note:
#' only one of \code{x}, \code{m} and \code{string}
#' can be a non-NULL object
#' @param n how many times each element of \code{x}
#' or each row of \code{m} should be replicated.
#' It should be a numeric vector of non-negative integers and the
#' length of it should be equal to that of \code{x} or the row number
#' of \code{m}.
#' The default is 1 for each element of \code{x}.
#' @param m a matrix or dataframe, the number of rows should be
#' equal to the length of n.
#' @param string default is NULL. If it is not NULL, \code{x}, \code{m}
#' and \code{n} are ignored. It should be a character vector. Each
#' one contains two parts, the 1st is the amount of
#' that ballot, and the 2nd part contains the names. The 1st and
#' 2nd parts, as well as the names, should be split by spaces
#' or punctuations. But no space and punctuation is allowed
#' inside the names ("_" is not taken to be
#' a punctuation). See examples.
#'
#' @return a list with replicated vectors, if \code{x} is not NULL,
#' or a matrix/data.frame with duplicated rows, if
#' \code{m} is not NULL.
#' @export
#' @examples
#' # Use x and n
#' unique_ballot <- list(
#' c("A", "B", "C"), c("F", "A", "B"),
#' c("E", "D", "C", "B", "F", "A"), c("x","x", "A")
#' )
#' r <- c(1, 2, 3, 0)
#' y <- list2ballot(unique_ballot, r)
#'
#' # Use string, x and n will be ignored.
#' # The characters can be written in a very loose way as follows,
#' # for the function will automatically delete unwanted parts.
#' # But do make sure there is no space or punctuation
#' # inside the names.
#' unique_ballot <- c(
#' "2, Bob, Mike Jane", "3: barack_obama;;Bob>Jane",
#' "0 Smith Jane", " 1 Mike???!!!"
#' )
#' y <- list2ballot(string = unique_ballot)
#' # Use a matrix.
#' m <- matrix(c(1, 2, 3, 3, 1, 2), nrow = 2, byrow = TRUE)
#' colnames(m) <- c("p1", "p2", "p3")
#' r <- c(3, 5)
#' y <- list2ballot(m = m, n = r)
list2ballot <- function(x = NULL, n = rep(1, length(x)), m = NULL, string = NULL) {
# 1 is not null, other all null
stringnull <- ! is.null(string)
mnull <- ! is.null(m)
xnnull <- ! is.null(x) & ! is.null(n)
null3 <- sum(stringnull+mnull+xnnull)
if (null3 != 1) stop("One and only one of x/n, m, string should not be NULL.")
if (xnnull) {
if (!is.list(x))
stop("x must be a list.")
if (!is.numeric(n))
stop("n must be numeric.")
if (length(x) == 0)
stop("x must be of length larger than 0.")
if (length(x) != length(n))
stop("x and n must be of the same length.")
all_cl <- sapply(x, is.vector)
if (any(all_cl == FALSE)) stop("Every element of list x should be of class vector.")
}
if (stringnull) {
if (!is.character(string))
stop("string must be a character vector.")
if (!is.vector(string))
stop("string must be a character vector.")
if (length(string) == 0)
stop("string must have at least 1 element.")
string <- gsub("^\\W+|\\W+$", "", string)
n <- c()
x <- list()
for (i in 1:length(string)) {
ii <- unlist(strsplit(string[i], "\\W+"))
if (length(ii) < 2)
stop("Each string must have two parts, the 1st is the amount of the ballots, the 2nd contains candidate names.")
n[i] <- ii[1]
iii <- ii[-1]
iii[iii == "NA"] <- NA
x[[i]] <- iii
}
n <- suppressWarnings(as.numeric(n))
if (any(is.na(n)))
stop("Coercion fails. You should make sure the 1st valid part of each string is something numeric.")
}
nis0 <- which(n == 0)
if (length(nis0) == length(n)) stop("There is actually no ballot.")
if (xnnull == TRUE | stringnull == TRUE){
if (length(nis0) > 0) {
n <- n[-nis0]
x <- x[-nis0]
}
LL=x[rep(seq_len(length(x)), n)]
names(LL) <- NULL
}
if (mnull == TRUE){
LL=m[rep(seq_len(nrow(m)), n), ]
rownames(LL) <- NULL
colnames(LL) <- colnames(m)
}
LL
}
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.