Nothing
###############################################
# --------------------------------------------#
# util - utility functions #
# --------------------------------------------#
###############################################
# --------------------------------------------
# Full reference set function
# --------------------------------------------
# Function returning the full reference set given a design
#
# This function can only be applied to designs with total sample size smaller than 20.
# For \code{N=18} this matrix has more than 1 million entries and occupies 4 Mb
# of memory.
#
# @param obj object of class ebcPar
#
# @return A matrix containing all \code{2^N} randomization sequences in the
# rows, where \code{N=N(obj)} is the total sample size.
compltSet <- function(obj) {
if (N(obj) > 24) stop("Full reference set only computeable up to N=24. Use the parameter r in genSeq to simulate several sequences.")
stopifnot(K(obj) == 2, identical(ratio(obj), c(1, 1)))
# For K > 2 this must be modified!
unname(as.matrix(expand.grid(rep(list(0:1), N(obj)))))
}
# --------------------------------------------
# Realized block constellation
# --------------------------------------------
#
# Generate realized block sequence for a random block design
#
# This function can only be applied to designs with total sample size smaller than 20.
# For \code{N=18} this matrix has more than 1 million entries and occupies 4 Mb
# of memory.
#
# @inheritParams overview
#
# @return A vector with the exact succession of the block sizes used for the design.
# E.g. c(4,6) refers to a trial with two blocks, the first of size 4, the second
# of size 6.
genBlockConst <- function(N, rb, filledBlock = FALSE) {
# generating a vector for the used block lengths
if (!filledBlock) {
if (length(rb) == 1) bc <- rep(rb, ceiling(N/rb))
else {
bc <- numeric(0)
repeat {
bc <- c(bc, sample(rb, 1))
if (sum(bc) >= N) break
}
}
} else {
if (length(rb) == 1 && ceiling(N/rb) == N/rb ) {
return(bc <- rep(rb, ceiling(N/rb)))
}
if (length(rb) == 1 && ceiling(N/rb) != N/rb ) {
stop("No block constellation possible with filled blocks.")
}
bc <- numeric(0)
repeat {
if (length(rb) == 0) stop("No block constellation possible with filled blocks.")
# possible block lengths
pbl <- rb[rb <= (N - sum(bc))]
if (length(pbl) == 0) {
# not fitting block lengths
nfb <- which(rb >= bc[length(bc)])
bc <- bc[-length(bc)]
rb <- rb[-nfb]
next
}
if(length(pbl) == 1) {
bc <- c(bc, pbl)
} else {
bc <- c(bc, sample(pbl, 1))
}
if (sum(bc) >= N) break
}
}
bc
}
# --------------------------------------------
# Last random assignment for TBD
# --------------------------------------------
# Calcultes the last random allocation of a randomization sequence generated by
# TBD.
#
# @inheritParams overview
#
# @return The last random allocation of a randomization sequence generated by
# TBD.
lastRandom <- function(x) {
min((1:length(x))[cumsum(x) == length(x)/2],
(1:length(x))[cumsum(1-x) == length(x)/2])
}
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.