Nothing
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU Library General Public License for more details.
#
# You should have received a copy of the GNU Library General
# Public License along with this library; if not, write to the
# Free Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA 02111-1307 USA
################################################################################
# FUNCTION: DESCRIPTION:
# correlationTest Performs correlation tests on two samples
# pearsonTest Pearson product moment correlation coefficient
# kendallTest Kendall's tau correlation test
# spearmanTest Spearman's rho correlation test
################################################################################
## GNB: changed the default 'description = date()' to 'description = ""', to
## avoid getting different objects in repeated calls.
correlationTest <-
function(x, y, method = c("pearson", "kendall", "spearman"),
title = NULL, description = NULL)
{
# A function implemented by Diethelm Wuertz
# Description:
# Performs Correlation Tests
# FUNCTION:
# Test:
method = match.arg(method)
if (method[1] == "pearson") {
ans = pearsonTest(x, y, title = title, description = description)
}
if (method[1] == "kendall") {
ans = kendallTest(x, y, title = title, description = description)
}
if (method[1] == "spearman") {
ans = spearmanTest(x, y, title = title, description = description)
}
# Return Value:
ans
}
# ------------------------------------------------------------------------------
pearsonTest <-
function(x, y, title = NULL, description = NULL)
{
# A function implemented by Diethelm Wuertz
# Description:
# A test for association between paired samples
# Arguments:
# x - a numeric vector of data values.
# description - a brief description of the project of type
# character.
# title - a character string which allows for a project title.
# Note:
# A function linked to "stats"
# FUNCTION:
# Call:
call = match.call()
# Test:
test = list()
# Data Set Name:
DNAME = paste(deparse(substitute(x)), "and", deparse(substitute(y)))
test$data.name = DNAME
# Convert Type:
x = as.vector(x)
y = as.vector(y)
stopifnot(length(x) == length(y))
# Test:
two.sided = cor.test(x = x, y = y, alternative = "two.sided",
method = "pearson")
less = cor.test(x = x, y = y, alternative = "less",
method = "pearson")
greater = cor.test(x = x, y = y, alternative = "greater",
method = "pearson")
# Sample Estimates:
ESTIMATE = two.sided$estimate
names(ESTIMATE) = "Correlation"
test$estimate = ESTIMATE
# Parameter
DF = two.sided$parameter
names(DF) = "Degrees of Freedom"
test$parameter = DF
# P Values:
PVAL = c(
two.sided$p.value,
less$p.value,
greater$p.value)
names(PVAL) = c(
"Alternative Two-Sided",
"Alternative Less",
"Alternative Greater")
test$p.value = PVAL
# Confidences Levels:
if (!is.null(two.sided$conf.int)) {
CONF.INT = cbind(
a = two.sided$conf.int,
b = less$conf.int,
c = greater$conf.int)
dimnames(CONF.INT)[[2]] = c(
"Two-Sided",
" Less",
" Greater")
test$conf.int = CONF.INT
}
# Statistic:
STATISTIC = two.sided$statistic
names(STATISTIC) = "t"
test$statistic = STATISTIC
# Add:
if (is.null(title)) title = "Pearson's Correlation Test"
if (is.null(description)) description = ""
# Return Value:
new("fHTEST",
call = call,
data = list(x = x, y = y),
test = test,
title = as.character(title),
description = as.character(description) )
}
# ------------------------------------------------------------------------------
kendallTest <-
function(x, y, title = NULL, description = NULL)
{
# A function implemented by Diethelm Wuertz
# Description:
# A test for association between paired samples
# Arguments:
# x - a numeric vector of data values.
# description - a brief description of the project of type
# character.
# title - a character string which allows for a project title.
# Note:
# A function linked to "stats"
# FUNCTION:
# Call:
call = match.call()
# Test:
test = list()
# Data Set Name:
DNAME = paste(deparse(substitute(x)), "and", deparse(substitute(y)))
test$data.name = DNAME
# Convert Type:
x = as.vector(x)
y = as.vector(y)
stopifnot(length(x) == length(y))
# Test:
two.sided = cor.test(x = x, y = y, alternative = "two.sided",
method = "kendall")
less = cor.test(x = x, y = y, alternative = "less",
method = "kendall")
greater = cor.test(x = x, y = y, alternative = "greater",
method = "kendall")
# Exact Test:
if (!inherits(version, "Sversion")) {
two.sided.exact = cor.test(x = x, y = y, exact = TRUE,
alternative = "two.sided", method = "kendall")
less.exact = cor.test(x = x, y = y, exact = TRUE,
alternative = "less", method = "kendall")
greater.exact = cor.test(x = x, y = y, exact = TRUE,
alternative = "greater", method = "kendall")
} else {
two.sided.exact = list()
two.sided.exact$p.value = two.sided.exact$statistic = NA
less.exact = list()
less.exact$p.value = less.exact$statistic = NA
greater.exact = list()
greater.exact$p.value = greater.exact$statistic = NA
}
# Sample Estimates:
ESTIMATE = two.sided$estimate
names(ESTIMATE) = "tau"
test$estimate = ESTIMATE
# P Values:
PVAL = c(
two.sided$p.value,
two.sided.exact$p.value,
less$p.value,
less.exact$p.value,
greater$p.value,
greater.exact$p.value)
if (is.na(two.sided.exact$p.value)) {
names(PVAL) = c(
"Alternative Two-Sided",
"Alternative Two-Sided | Exact",
"Alternative Less",
"Alternative Less | Exact",
"Alternative Greater",
"Alternative Greater | Exact")
} else {
names(PVAL) = c(
"Alternative Two-Sided",
"Alternative Two-Sided | Exact",
"Alternative Less",
"Alternative Less | Exact",
"Alternative Greater",
"Alternative Greater | Exact")
}
test$p.value = PVAL
# Statistic:
# STATISTIC = c(
# two.sided$statistic, two.sided.exact$statistic,
# less$statistic, less.exact$statistic,
# greater$statistic, greater.exact$statistic)
STATISTIC = c(
two.sided$statistic,
two.sided.exact$statistic)
# names(STATISTIC) = c(
# "z | Two-Sided", "T | Two-Sided | Exact",
# "z | Less", "T | Less | Exact",
# "z | Greater", "T | Greater | Exact")
names(STATISTIC) = c(
"z",
"T | Exact")
test$statistic = STATISTIC
# Add:
if (is.null(title)) title = "Kendall's tau Correlation Test"
if (is.null(description)) description = ""
# Return Value:
new("fHTEST",
call = call,
data = list(x = x, y = y),
test = test,
title = as.character(title),
description = as.character(description) )
}
# ------------------------------------------------------------------------------
spearmanTest <-
function(x, y, title = NULL, description = NULL)
{
# A function implemented by Diethelm Wuertz
# Description:
# A test for association between paired samples
# Arguments:
# x - a numeric vector of data values.
# description - a brief description of the project of type
# character.
# title - a character string which allows for a project title.
# Note:
# # A function linked to "stats"
# FUNCTION:
# Call:
call = match.call()
# Test:
test = list()
# Data Set Name:
DNAME = paste(deparse(substitute(x)), "and", deparse(substitute(y)))
test$data.name = DNAME
# Convert Type:
x = as.vector(x)
y = as.vector(y)
stopifnot(length(x) == length(y))
# Test:
two.sided = cor.test(x = x, y = y, alternative = "two.sided",
method = "spearman")
less = cor.test(x = x, y = y, alternative = "less",
method = "spearman")
greater = cor.test(x = x, y = y, alternative = "greater",
method = "spearman")
# Sample Estimates:
ESTIMATE = two.sided$estimate
names(ESTIMATE) = "rho"
test$estimate = ESTIMATE
# P Values:
PVAL = c(
two.sided$p.value,
less$p.value,
greater$p.value)
names(PVAL) = c(
"Alternative Two-Sided",
"Alternative Less",
"Alternative Greater")
test$p.value = PVAL
# Statistic:
STATISTIC = two.sided$statistic
names(STATISTIC) = "S"
test$statistic = STATISTIC
# Add:
if (is.null(title)) title = "Spearman's rho Correlation Test"
if (is.null(description)) description = ""
# Return Value:
new("fHTEST",
call = call,
data = list(x = x, y = y),
test = test,
title = as.character(title),
description = as.character(description) )
}
################################################################################
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.