Nothing
#' feature_test class
#'
#' A result of \code{\link{test_features}} function.
#'
#' @details An object of the \code{feature_test} class is a numeric vector of p-values.
#' Additional attributes characterizes futher the details of test which returned these
#' p-values.
#' @section Attributes:
#' \describe{
#' \item{criterion}{the criterion used in permutation test.}
#' \item{adjust}{the name of p-value adjusting method.}
#' \item{times}{the number of permutations. If QuiPT was chosen \code{NA}.}
#' \item{occ}{frequency of features splitted in subset based on the value of target.}
#' }
#' @name feature_test
#' @docType class
#' @seealso
#' Methods:
#' \itemize{
#' \item \code{\link{as.data.frame.feature_test}}
#' \item \code{\link{cut.feature_test}}
#' \item \code{\link{print.feature_test}}
#' \item \code{\link{summary.feature_test}}
#' }
NULL
create_feature_test <- function(p_value, criterion, adjust, times, occ) {
if (!(is.numeric(p_value) && is.vector(p_value)))
stop("p_values must be numeric")
# add names if they are missing
if(is.null(names(p_value)) & length(p_value) > 0)
names(p_value) <- paste0("feature", 1L:length(p_value))
res <- p_value
attributes(res) <- list(names = names(p_value),
criterion = criterion,
adjust = adjust,
times = times,
class = "feature_test",
occ = occ)
res
}
#' Summarize tested features
#'
#' Summarizes results of \code{\link{test_features}} function.
#'
#' @param object of class \code{\link{feature_test}}.
#' @param conf_level confidence level. A feature with p-value equal to or smaller than the
#' confidence is considered significant.
#' @param ... ignored
#' @return nothing.
#' @export
#' @keywords manip
summary.feature_test <- function(object, conf_level = 0.95, ...) {
cat("Total number of features:",
length(object), "\n")
cat("Number of significant features:",
sum(object <= 1 - conf_level), "\n")
cat("Criterion used:",
attr(object, "criterion"), "\n")
cat("Feature test:",
ifelse(is.na(attr(object, "times")), "QuiPT",
paste0("Fisher's permutation test (", attr(object, "times"),
" permutations)")), "\n")
cat("p-values adjustment method:",
attr(object, "adjust"), "\n")
}
#' Print tested features
#'
#' Prints results of \code{\link{test_features}} function.
#'
#' @param x object of class \code{\link{feature_test}}.
#' @param ... further arguments passed to \code{\link[base]{print.default}}.
#' @return nothing.
#' @export
print.feature_test <- function(x, ...) {
# strange workaround but may be faster than setting all other attributes to NULL
print(vapply(x, function(i) i, 0), ...)
}
#' Categorize tested features
#'
#' Categorizes results of \code{\link{test_features}} function into groups based on their
#' significance.
#'
#' @param x an object of class \code{\link{feature_test}}.
#' @param breaks a vector of significances of frequencies along which n-grams are aggregated.
#' See description of \code{\link[base]{cut}} function and \code{Details}.
#' @param split attribute along which output should be categorized. Possible values are
#' \code{"significances"}, \code{"positives"} and \code{"negatives"}. See \code{Value}.
#' @param ... further parameters accepted by the \code{\link[base]{cut}} function.
#' @return the value of function depends on the \code{split} parameter.
#' The function returns a named list of length equal to the length
#' of \code{significances} (when \code{split} equals \code{"significances"}) or
#' \code{frequencies} (when \code{split} equals \code{"positives"} or \code{"negatives"})
#' minus one. Each elements of the list contains names of the n-grams belonging to the given
#' significance or frequency group.
#' @export
#' @keywords manip
cut.feature_test <- function(x, split = "significances",
breaks = c(0, 0.0001, 0.01, 0.05, 1), ...) {
if(!(split %in% c("significances", "positives", "negatives")))
stop("'split' must have one of following values: 'significances', 'positives',
'negatives'.")
# define
cut_function <- function(vector)
cut(vector, breaks = breaks, include.lowest = TRUE, right = TRUE, ...)
split_factor <- switch(split,
significances = cut_function(as.vector(x)),
positives = cut_function(attr(x, "occ")["pos", ]),
negatives = cut_function(attr(x, "occ")["neg", ]))
dat <- data.frame(ngram = names(x),
split_factor = split_factor)
res <- lapply(levels(split_factor), function(i)
as.character(dat[dat[["split_factor"]] == i, "ngram"]))
names(res) <- levels(split_factor)
res
}
#' Coerce feature_test object to a data frame
#'
#' Coerce results of \code{\link{test_features}} function to a
#' \code{\link[base]{data.frame}}.
#'
#' @param x object of class \code{\link{feature_test}}.
#' @param row.names ignored.
#' @param optional ignored.
#' @param stringsAsFactors logical: should the character vector be converted
#' to a factor?.
#' @param ... additional arguments to be passed to or from methods.
#' @return a data frame with four columns: names of n-gram, p-values,
#' occurrences in positive and negative sequences.
#' @export
as.data.frame.feature_test <- function(x,
row.names = NULL, optional = FALSE,
stringsAsFactors = FALSE, ...) {
data.frame(ngram = names(x),
p.value = as.vector(x),
t(attr(x, "occ")), ..., stringsAsFactors = stringsAsFactors,
row.names = NULL)
}
# aggregate.feature_test <- function(x, significances = c(0, 0.0001, 0.01, 0.05, 1),
# frequencies = c(0, 0.05, 0.1, 0.2, 1),
# split = "significances", ...) {
#
# cutted_pvals <- cut(x, breaks = significances, include.lowest = TRUE)
# # aggregate does not cut here, because it does not return standard list output
# # dat <- aggregate(ngrams ~ cutted_pvals, data = data.frame(ngrams = names(x), cutted_pvals),
# # function(i)
# # as.character(i))
# occ_pos <- cut(attr(x, "occ")["pos", ],
# breaks = frequencies, include.lowest = TRUE)
# occ_neg <- cut(attr(x, "occ")["neg", ],
# breaks = frequencies, include.lowest = TRUE)
# dat <- data.frame(ngram = names(x),
# p_value = cutted_pvals,
# occ_pos = occ_pos,
# occ_neg = occ_neg)
#
# if(!is.null(split)) {
# if(!(split %in% c("significances", "positives", "negatives")))
# stop("'split' must have one of following values: 'significances', 'positives',
# 'negatives' or NULL")
#
# split_factor <- switch(split,
# significances = list(levels(cutted_pvals),
# "p_value"),
# positives = list(levels(occ_pos),
# "occ_pos"),
# negatives = list(levels(occ_neg),
# "occ_neg"))
#
# dat <- lapply(split_factor[[1]], function(i)
# as.character(dat[dat[[split_factor[[2]]]] == i, "ngram"]))
#
# names(dat) <- split_factor[[1]]
# }
#
# dat
# }
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.