###################################################################
### This file describes several functions used in whole package ###
###################################################################
### functions:
## paraMerge, merge two lists.
## p_function, calculate p value.
## Cpp_p_funciton, calculate p value.
## plotMat, calcute the plot design.
## .onUnload, clean up after unloading.
### paraMerge
#' Merge two lists
#'
#' \code{paraMerge} merges two arguments list into a new one, in which the old parameters
#' are over-written by new parameters.
#'
#' @param oldP A list containing the old parameters.
#' @param newP A list containing the new parameters.
#' @return A list of merged parameters is returned.
#' @examples
#' paraMerge(list(t1 = 1, t2 = 2, t3 = 3, t4 = 4), list(t3 = 4, t4 = 5, t5 = 6, t6 = 7))
#' @export
paraMerge = function(oldP, newP)
{
if(any(is.null(newP), length(newP) == 0)) return(oldP)
if(any(is.na(newP))) return(NA)
if(length(newP) == 1 && is.na(newP)) return(list(NA))
oldP = as.list(oldP)
newP = as.list(newP)
oldP = as.environment(oldP)
lapply(names(newP), function(nm) oldP[[nm]] = newP[[nm]])
return(as.list(oldP))
}
### p_function
#' Calculate the p-value
#'
#' \code{p_function} calculate the p-value of data given the epsilon and the test type.
#' \code{Cpp_p_function}, an alternative for the same purpose, is much faster and recommended.
#'
#' @param epsilon A value used for equivalence tests. Only valid when ifF == FALSE.
#' @param ifF A bool value indicating test type. When ifF = TRUE, standard F test is used; otherwise, equivalence F test.
#' @param myData A list of vector of numerics.
#' @return P value.
#' @examples
#' a = rnorm(100)
#' b = rnorm(150)
#' d = rnorm(200)
#' e = runif(250)
#' p_function(0, FALSE, list(a, b, d, e))
#' Cpp_p_function(0, FALSE, list(a, b, d, e))
#' @export
p_function = function(epsilon = 0, ifF = FALSE, myData = list())
{
mylist = myData
k = length(mylist)
n = sum(sapply(mylist, length))
xbar = sum(sapply(mylist, sum)) / n
num = sum(sapply(mylist, function(x) length(x) / n * k * (mean(x) - xbar)^2))
denum = 1 / (n - k) * sum(sapply(mylist, function(x) sum((x - mean(x))^2)))
myfvalue = num / denum
if(round(num, 18) == 0) myfvalue = 0
fvalue = myfvalue * n / k / (k - 1)
adjep = n / k * epsilon^2
pvalue = (1 - ifF) * pf(fvalue, k - 1, n - k, adjep) + ifF * (1 - pf(fvalue, k - 1, n - k))
return(pvalue)
}
### Cpp_p_function
#' Calculate the p-value
#'
#' \code{p_function} calculate the p-value of data given the epsilon and the test type.
#' \code{Cpp_p_function}, an alternative for the same purpose, is much faster and recommended.
#'
#' @param epsilon A value used for equivalence tests. Only valid when ifF == FALSE.
#' @param ifF A bool value indicating test type. When ifF = TRUE, standard F test is used; otherwise, equivalence F test.
#' @param myData A list of vector of numerics.
#' @return P value.
#' @examples
#' a = rnorm(100)
#' b = rnorm(150)
#' d = rnorm(200)
#' e = runif(250)
#' p_function(0, FALSE, list(a, b, d, e))
#' Cpp_p_function(0, FALSE, list(a, b, d, e))
#' @export
Cpp_p_function = function(epsilon = 0, ifF = FALSE, myData = list()) {
res = Cpp_fvalue(myData)
return(ifelse(ifF, (1 - pf(res[1], res[3] - 1, res[2] - res[3])), pf(res[1], res[3] - 1, res[2] - res[3], epsilon * epsilon * res[2] / res[3])))
}
### plotMat
#' Calcute the layout coordinates
#'
#' \code{plotMat} calcutes the layout coordinates given numbers of figures and columns of figures.
#' The order should be from top to bottom and left to right.
#'
#' @param nfig An integer indicating the total number of figures.
#' @param figcol An integer indicating the columns of figures.
#' @param xshrink,yshrink The right or top shrink.
#' @return A list of positions is returned with each element containing a numeric vector
#' of length 4, standing for (xleft, xright, ybottom, ytop)
#' @examples
#' plotMat(10, 3)
#' @export
plotMat = function(nfig, figcol, xshrink = 1, yshrink = 1)
{
return(Cpp_plotMat(nfig = nfig, figcol= figcol, xshrink = xshrink, yshrink = yshrink))
}
### .onUnload
# Clean up
.onUnload <- function (libpath) {
library.dynam.unload("DEEE", libpath)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.