##'Calculate the mean for a matrix of binned data
#'@param counts a \code{matrix} or \code{data.frame} of binned data
#'@param lowerBounds A vector of the lower cut points of the binnned data
#'@param upperBounds A vector of the upper cutpoints of the original binnned data
#'@return A vector of estimated means
#'@export
#'@examples
#'upper <- seq(10, 100, 10)
#'lower <- seq(0, 90, 10)
#'counts2 <- c(1, 2, 1, 4, 4, 2, 0, 0, 0, 0)
#'counts3 <- c(1, 2, 1, 4, 4, 0, 0, 2, 0, 0)
#'binnedMean(rbind(counts2, counts3), lower, upper)
binnedMean <- function(counts,
lowerBounds = seq(0, 95, 5),
upperBounds =seq(5, 100, 5)) {
if(any(!(class(counts) %in% c("matrix", "data.frame") ) ) ) {
stop("counts must be a matrix or data.frame")
}
binMid <- (upperBounds + lowerBounds) / 2
print(binMid)
n <- rowSums(counts, na.rm = FALSE)
wc <- sweep(counts, 2, binMid, `*`)
muhat <- rowSums(wc, na.rm = FALSE) / n
return(muhat)
}
#'Calculate the MSE for binned data
#'@param counts A matrix of data frame of observed counts of binned data
#'@param mu The true observed mean
#'@param lowerBounds A vector of the lower cut points of the binnned data
#'@param upperBounds A vector of the upper cutpoints of the original binnned data
#'@details Assumes that the midpoint of the bin is the mean of that prediction.
#'@examples upper <- seq(10, 100, 10)
#'lower <- seq(0, 90, 10)
#'counts <- c(0, 0, 4, 4, 4, 2, 0, 0, 0, 0)
#'counts2 <- c(1, 2, 1, 4, 4, 2, 0, 0, 0, 0)
#'counts_df <- as.data.frame(rbind(counts, counts2))
#'binnedMSE(counts_df, mu = 33, lowerBounds = lower, upperBounds = upper)
#'@return A vector with one observation for each row in \code{counts}
#'@export
binnedMSE <- function(counts, mu,
lowerBounds = seq(0, 95, 5),
upperBounds = seq(5, 100, 5)) {
binMid <- (lowerBounds + upperBounds) / 2
unnorm <- sweep(counts, 2, ( (binMid - mu)^2), `*`)
print(unnorm)
MSE <- rowSums(unnorm, na.rm = TRUE) / rowSums(counts, na.rm = TRUE)
return(MSE)
}
#'Function to find non-contiguity in response patterns
#'@param row A vector of binned counts
#'@param bins The number of bins: should be the same as the length of \code{row}
#'@details Assumes there are at least some coins in some bins.
#'@return returns either a 0 if there are non-contiguous counts of 1 if there are.
#'Will often be used with \code{apply} to operate on a matrix
#'@export
#'@examples counts2 <- c(1, 2, 1, 4, 4, 2, 0, 0, 0, 0)
#'counts3 <- c(1, 2, 0, 4, 4, 2, 0, 0, 0, 0)
#'detectNonContig(counts2)
#'detectNonContig(counts3)
#'apply(rbind(counts2, counts3), 1, detectNonContig)
#'
detectNonContig <- function(row, bins = length(row)) {
if (is.na(row[1])) {
rep <- NA
} else {
rep <- 0
for (i in 2:(bins - 1)) {
if (row[i-1] > 0 & row[i+1] > 0 & row[i] == 0) {
rep <- 1
break
}
}
}
return(rep)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.