Skip to content

Test value for independent and paired samples #299

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
arcaldwell49 wants to merge 2 commits into
base: master
Choose a base branch
from
Open

Test value for independent and paired samples #299

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
a775b75
Added testValue
arcaldwell49 Mar 27, 2021
c0181e8
Working ttestps version now
arcaldwell49 Mar 28, 2021
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
78 changes: 55 additions & 23 deletions R/ttestis.b.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -18,6 +18,8 @@ ttestISClass <- R6::R6Class(
data[[name]] <- jmvcore::toNumeric(data[[name]])
data[[groupVarName]] <- droplevels(as.factor(data[[groupVarName]]))

testValue <- self$options$get("testValue")

ttestTable <- self$results$ttest
descTable <- self$results$desc
normTable <- self$results$assum$get('norm')
Expand All @@ -26,6 +28,8 @@ ttestISClass <- R6::R6Class(
confInt <- self$options$ciWidth / 100
confIntES <- 1 - self$options$ciWidthES / 100



if (any(depVarNames == groupVarName))
jmvcore::reject("Grouping variable '{a}' must not also be a dependent variable",
code="a_is_dependent_variable", a=groupVarName)
Expand Down Expand Up @@ -78,8 +82,8 @@ ttestISClass <- R6::R6Class(
sediffSTUD <- tryNaN(sqrt((pooledVARSTUD/n[1])+(pooledVARSTUD/n[2])))
sediffWELC <- tryNaN(sqrt((v[1]/n[1])+(v[2]/n[2])))

dSTUD <- (m[1]-m[2])/sqrt(pooledVARSTUD) # Cohen's d for student's t
dWELC <- (m[1]-m[2])/sqrt(pooledVARWELC) # Cohen's d for Welch's t
dSTUD <- (m[1]-m[2] - testValue)/sqrt(pooledVARSTUD) # Cohen's d for student's t
dWELC <- (m[1]-m[2] - testValue)/sqrt(pooledVARWELC) # Cohen's d for Welch's t
dCISTUD <- psych::d.ci(dSTUD, n1=n[1], n2=n[2], alpha=confIntES)
dCIWELC <- psych::d.ci(dWELC, n1=n[1], n2=n[2], alpha=confIntES)

Expand All @@ -96,7 +100,10 @@ ttestISClass <- R6::R6Class(

## Levene's test and equality of variances table

levene <- try(car::leveneTest(dep ~ group, data=dataTTest, "mean"), silent=TRUE)
levene <- try(car::leveneTest(dep ~ group,
data=dataTTest,
"mean"),
silent=TRUE)

if (isError(levene)) {

Expand Down Expand Up @@ -125,8 +132,14 @@ ttestISClass <- R6::R6Class(
else if (any(is.infinite(dataTTest$dep)))
res <- createError('Variable contains infinite values')
else
res <- try(t.test(dep ~ group, data=dataTTest, var.equal=TRUE, paired=FALSE,
alternative=Ha, conf.level=confInt), silent=TRUE)
res <- try(t.test(dep ~ group,
data = dataTTest,
var.equal = TRUE,
paired = FALSE,
alternative = Ha,
conf.level = confInt,
mu = testValue),
silent = TRUE)

if (isError(res)) {

Expand Down Expand Up @@ -158,10 +171,10 @@ ttestISClass <- R6::R6Class(
"stat[stud]"=res$statistic,
"df[stud]"=res$parameter,
"p[stud]"=res$p.value,
"md[stud]"=res$estimate[1]-res$estimate[2],
"md[stud]"=res$estimate[1]-res$estimate[2] - testValue,
"sed[stud]"=sediffSTUD,
"cil[stud]"=res$conf.int[1],
"ciu[stud]"=res$conf.int[2],
"cil[stud]"=res$conf.int[1] - testValue,
"ciu[stud]"=res$conf.int[2] - testValue,
"es[stud]"=dSTUD,
"ciles[stud]"=dCISTUD[1],
"ciues[stud]"=dCISTUD[3]))
Expand All @@ -180,19 +193,25 @@ ttestISClass <- R6::R6Class(
else if (any(is.infinite(dataTTest$dep)))
res <- createError('Variable contains infinite values')
else
res <- try(t.test(dep ~ group, data=dataTTest, var.equal=FALSE, paired=FALSE,
alternative=Ha, conf.level=confInt), silent=TRUE)
res <- try(t.test(dep ~ group,
data=dataTTest,
var.equal=FALSE,
paired=FALSE,
alternative=Ha,
conf.level=confInt,
mu = testValue),
silent=TRUE)

if ( ! isError(res)) {

ttestTable$setRow(rowKey=depName, list(
"stat[welc]"=res$statistic,
"df[welc]"=res$parameter,
"p[welc]"=res$p.value,
"md[welc]"=res$estimate[1]-res$estimate[2],
"md[welc]"=res$estimate[1]-res$estimate[2] - testValue,
"sed[welc]"=sediffWELC,
"cil[welc]"=res$conf.int[1],
"ciu[welc]"=res$conf.int[2],
"cil[welc]"=res$conf.int[1] - testValue,
"ciu[welc]"=res$conf.int[2] - testValue,
"es[welc]"=dWELC,
"ciles[welc]"='',
"ciues[welc]"=''))
Expand Down Expand Up @@ -258,7 +277,8 @@ ttestISClass <- R6::R6Class(
alternative=Ha1,
paired=FALSE,
conf.int=TRUE,
conf.level=confInt)
conf.level=confInt,
mu = testValue)
), silent=TRUE)

res2 <- try(suppressWarnings(
Expand All @@ -268,14 +288,15 @@ ttestISClass <- R6::R6Class(
alternative=Ha2,
paired=FALSE,
conf.int=TRUE,
conf.level=confInt)
conf.level=confInt,
mu = testValue)
), silent=TRUE)

m1 <- res$statistic
m2 <- res2$statistic
mm <- res$estimate
cil <- res$conf.int[1]
ciu <- res$conf.int[2]
mm <- res$estimate - testValue
cil <- res$conf.int[1] - testValue
ciu <- res$conf.int[2] - testValue

if ( ! is.na(m1) && m2 < m1)
res <- res2
Expand Down Expand Up @@ -395,8 +416,12 @@ ttestISClass <- R6::R6Class(

rscale <- self$options$bfPrior

res <- try(BayesFactor::ttestBF(formula=dep ~ group, data=dataTTest, paired=FALSE,
nullInterval=nullInterval, rscale=rscale), silent=TRUE)
res <- try(BayesFactor::ttestBF(formula=dep ~ group,
data=dataTTest,
paired=FALSE,
nullInterval=nullInterval,
rscale=rscale),
silent=TRUE)
}

if (isError(res)) {
Expand Down Expand Up @@ -433,6 +458,12 @@ ttestISClass <- R6::R6Class(
if ( ! is.na(bf) && bf < 1)
ttestTable$addFormat(col='stat[bf]', rowKey=depName, Cell.NEGATIVE)
}
# Inform that Bayes Factor doesn't allow for setting mu at this time
if (testValue != 0)
ttestTable$addFootnote(rowKey=depName, "stat[bf]",
"Use of nonzero null hypothesis not implemented for Bayes Factor. Result is of Test Value = 0")


}

if (self$options$qq) {
Expand Down Expand Up @@ -483,6 +514,7 @@ ttestISClass <- R6::R6Class(
.init=function() {

hypothesis <- self$options$hypothesis
testValue <- self$options$get('testValue')
groupName <- self$options$group

groups <- NULL
Expand Down Expand Up @@ -514,11 +546,11 @@ ttestISClass <- R6::R6Class(
table$getColumn('ciles[mann]')$setSuperTitle(ciTitleES)

if (hypothesis == 'oneGreater')
table$setNote("hyp", jmvcore::format("H\u2090 {} > {}", groups[1], groups[2]))
table$setNote("hyp", jmvcore::format("H\u2090 {} - {} > {}", groups[1], groups[2],testValue))
else if (hypothesis == 'twoGreater')
table$setNote("hyp", jmvcore::format("H\u2090 {} < {}", groups[1], groups[2]))
table$setNote("hyp", jmvcore::format("H\u2090 {} - {} < {}", groups[1], groups[2],testValue))
else
table$setNote("hyp", NULL)
table$setNote("hyp", jmvcore::format("H\u2090 {} - {} \u2260 {}", groups[1], groups[2],testValue))
},
.desc=function(image, ggtheme, theme, ...) {

Expand Down
12 changes: 12 additions & 0 deletions R/ttestis.h.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -13,6 +13,7 @@ ttestISOptions <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
bfPrior = 0.707,
welchs = FALSE,
mann = FALSE,
testValue = 0,
hypothesis = "different",
norm = FALSE,
qq = FALSE,
Expand Down Expand Up @@ -71,6 +72,10 @@ ttestISOptions <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
"mann",
mann,
default=FALSE)
private$..testValue <- jmvcore::OptionNumber$new(
"testValue",
testValue,
default=0)
private$..hypothesis <- jmvcore::OptionList$new(
"hypothesis",
hypothesis,
Expand Down Expand Up @@ -142,6 +147,7 @@ ttestISOptions <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
self$.addOption(private$..bfPrior)
self$.addOption(private$..welchs)
self$.addOption(private$..mann)
self$.addOption(private$..testValue)
self$.addOption(private$..hypothesis)
self$.addOption(private$..norm)
self$.addOption(private$..qq)
Expand All @@ -164,6 +170,7 @@ ttestISOptions <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
bfPrior = function() private$..bfPrior$value,
welchs = function() private$..welchs$value,
mann = function() private$..mann$value,
testValue = function() private$..testValue$value,
hypothesis = function() private$..hypothesis$value,
norm = function() private$..norm$value,
qq = function() private$..qq$value,
Expand All @@ -185,6 +192,7 @@ ttestISOptions <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
..bfPrior = NA,
..welchs = NA,
..mann = NA,
..testValue = NA,
..hypothesis = NA,
..norm = NA,
..qq = NA,
Expand Down Expand Up @@ -223,6 +231,7 @@ ttestISResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
clearWith=list(
"group",
"hypothesis",
"testValue",
"ciWidth",
"miss",
"bfPrior",
Expand Down Expand Up @@ -774,6 +783,7 @@ ttestISBase <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
#' t-tests
#' @param mann \code{TRUE} or \code{FALSE} (default), perform Mann-Whitney U
#' tests
#' @param testValue a number specifying the value of the null hypothesis
#' @param hypothesis \code{'different'} (default), \code{'oneGreater'} or
#' \code{'twoGreater'}, the alternative hypothesis; group 1 different to group
#' 2, group 1 greater than group 2, and group 2 greater than group 1
Expand Down Expand Up @@ -830,6 +840,7 @@ ttestIS <- function(
bfPrior = 0.707,
welchs = FALSE,
mann = FALSE,
testValue = 0,
hypothesis = "different",
norm = FALSE,
qq = FALSE,
Expand Down Expand Up @@ -881,6 +892,7 @@ ttestIS <- function(
bfPrior = bfPrior,
welchs = welchs,
mann = mann,
testValue = testValue,
hypothesis = hypothesis,
norm = norm,
qq = qq,
Expand Down
59 changes: 42 additions & 17 deletions R/ttestps.b.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -6,6 +6,7 @@ ttestPSClass <- R6::R6Class(
.run=function() {

data <- self$data
testValue <- self$options$get("testValue")

ttestTable <- self$results$get('ttest')
descTable <- self$results$get('desc')
Expand Down Expand Up @@ -64,16 +65,28 @@ ttestPSClass <- R6::R6Class(

pooledSD <- tryNaN(stats::sd(column1-column2))
sediff <- pooledSD/sqrt(n)
d <- (m1-m2)/pooledSD #Cohen's d
d <- (m1-m2-testValue)/pooledSD #Cohen's d
dCI <- psych::d.ci(d, n1=n, alpha=confIntES)

if (is.factor(column1) || is.factor(column2)) {
stud <- createError('One or both variables are not numeric')
wilc <- createError('One or both variables are not numeric')
}
else {
stud <- try(t.test(column1, column2, paired=TRUE, conf.level=confInt, alternative=Ha), silent=TRUE)
wilc <- try(suppressWarnings(wilcox.test(column1, column2, alternative=Ha, paired=TRUE, conf.int=TRUE, conf.level=confInt)), silent=TRUE)
stud <- try(t.test(column1, column2,
paired=TRUE,
conf.level=confInt,
alternative=Ha,
mu=testValue),
silent=TRUE)
wilc <- try(suppressWarnings(wilcox.test(column1,
column2,
alternative=Ha,
paired=TRUE,
conf.int=TRUE,
conf.level=confInt,
mu=testValue)),
silent=TRUE)
}

if ( ! isError(stud)) {
Expand All @@ -82,10 +95,10 @@ ttestPSClass <- R6::R6Class(
'stat[stud]'=stud$statistic,
'df[stud]'=stud$parameter,
'p[stud]'=stud$p.value,
'md[stud]'=stud$estimate,
'md[stud]'=stud$estimate - testValue,
'sed[stud]'=sediff,
'cil[stud]'=stud$conf.int[1],
'ciu[stud]'=stud$conf.int[2],
'cil[stud]'=stud$conf.int[1] - testValue,
'ciu[stud]'=stud$conf.int[2] - testValue,
'es[stud]'=d,
"ciles[stud]"=dCI[1],
"ciues[stud]"=dCI[3]))
Expand Down Expand Up @@ -121,10 +134,10 @@ ttestPSClass <- R6::R6Class(
'stat[wilc]'=wilc$statistic,
'df[wilc]'=wilc$parameter,
'p[wilc]'=wilc$p.value,
'md[wilc]'=wilc$estimate,
'md[wilc]'=wilc$estimate - testValue,
'sed[wilc]'=sediff,
'cil[wilc]'=wilc$conf.int[1],
'ciu[wilc]'=wilc$conf.int[2],
'cil[wilc]'=wilc$conf.int[1] - testValue,
'ciu[wilc]'=wilc$conf.int[2] - testValue,
'es[wilc]'=biSerial,
"ciles[wilc]"='',
"ciues[wilc]"=''))
Expand Down Expand Up @@ -224,7 +237,12 @@ ttestPSClass <- R6::R6Class(

rscale <- self$options$get('bfPrior')

res <- try(BayesFactor::ttestBF(x=column1, y=column2, paired=TRUE, nullInterval=nullInterval, rscale=rscale), silent=TRUE)
res <- try(BayesFactor::ttestBF(x=column1,
y=column2,
paired=TRUE,
nullInterval=nullInterval,
mu = testValue,
rscale=rscale), silent=TRUE)
}

if (isError(res)) {
Expand Down Expand Up @@ -300,6 +318,7 @@ ttestPSClass <- R6::R6Class(
.init=function() {

hypothesis <- self$options$get('hypothesis')
testValue <- self$options$get("testValue")
ttestTable <- self$results$get('ttest')

ciTitle <- paste0(self$options$get('ciWidth'), '% Confidence Interval')
Expand All @@ -320,13 +339,6 @@ ttestPSClass <- R6::R6Class(
ttestTable$getColumn('ciues[wilc]')$setSuperTitle(ciTitleES)
ttestTable$getColumn('ciles[wilc]')$setSuperTitle(ciTitleES)

if (hypothesis == 'oneGreater')
ttestTable$setNote("hyp", "H\u2090 Measure 1 > Measure 2")
else if (hypothesis == 'twoGreater')
ttestTable$setNote("hyp", "H\u2090 Measure 1 < Measure 2")
else
ttestTable$setNote("hyp", NULL)


pairs <- self$options$pairs
descTable <- self$results$desc
Expand All @@ -351,6 +363,19 @@ ttestPSClass <- R6::R6Class(

plots$get(pair)$setTitle(paste0(pair, collapse=' - '))
}



if (self$options$get("hypothesis") == 'oneGreater') {
ttestTable$setNote("hyp", jmvcore::format("H\u2090 Measure 1 - Measure 2 > {}", testValue))
} else if (self$options$get("hypothesis") == 'twoGreater'){
ttestTable$setNote("hyp", jmvcore::format("H\u2090 Measure 1 - Measure 2 < {}", testValue))
} else {
ttestTable$setNote("hyp", jmvcore::format("H\u2090 Measure 1 - Measure 2 \u2260 {}", testValue))
}



},
.desc=function(image, ggtheme, theme, ...) {

Expand Down
Loading