R/ttestps.b.R

In jonathon-love/moretests: Adds more tests to the jamovi analyses

ttestPSClass <- R6::R6Class(
    "ttestPSClass",
    inherit = ttestPSBase,
    public = list(
        initialize=function(...) {
            super$initialize(...)
            require('nortest')
        }
    ),
    private = list(
        .init = function() {

            if ( ! self$parent$options$norm)
                return()

            table <- jmvcore::Table$new(
                options=self$options,
                name='norm2',
                title='Tests of Normality',
                columns=list(
                    list(
                        name='i1',
                        title='',
                        type='text'),
                    list(
                        name='i2',
                        title='',
                        type='text'),
                    list(
                        name='t[sw]',
                        title='',
                        type='text',
                        content='Shapiro-Wilk'),
                    list(
                        name='s[sw]',
                        title='statistic'),
                    list(
                        name='p[sw]',
                        title='p',
                        format='zto,pvalue'),
                    list(
                        name='t[ks]',
                        title='',
                        type='text',
                        content='Kolmogorov-Smirnov'),
                    list(
                        name='s[ks]',
                        title='statistic'),
                    list(
                        name='p[ks]',
                        title='p',
                        format='zto,pvalue'),

                    list(
                        name='t[ad]',
                        title='',
                        type='text',
                        content='Anderson-Darling'),
                    list(
                        name='s[ad]',
                        title='statistic'),
                    list(
                        name='p[ad]',
                        title='p',
                        format='zto,pvalue')
                )
            )

            for (pair in self$parent$options$pairs) {
                table$addRow(rowKey=pair, list(
                    `i1`=pair$i1,
                    `i2`=pair$i2))
            }

            self$parent$results$norm$setVisible(FALSE)
            self$parent$results$insert(2, table)

            table$setNote('moretests', 'Additional results provided by <em>moretests</em>')
        },
        .run = function() {

            if ( ! self$parent$options$norm)
                return()

            data <- self$data
            if (self$parent$options$miss == 'listwise')
                data <- jmvcore::naOmit(data)

            table <- self$parent$results$get('norm2')
            pairs <- self$parent$options$pairs

            for (pair in pairs) {

                name1 <- pair$i1
                name2 <- pair$i2

                if (is.null(name1) || is.null(name2))
                    next()

                data[[name1]] <- jmvcore::toNumeric(data[[name1]])
                data[[name2]] <- jmvcore::toNumeric(data[[name2]])

                if (self$parent$options$miss == 'perAnalysis') {
                    pairsData <- na.omit(data[c(name1, name2)])
                    column1 <- pairsData[[name1]]
                    column2 <- pairsData[[name2]]
                } else {
                    column1 <- data[[name1]]
                    column2 <- data[[name2]]
                }

                residuals <- scale(column2 - column1)
                n <- length(residuals)
                values <- list()

                swf <- NULL

                if (n < 3) {
                    swf <- list(rowKey=name, "s[sw]", "Too few observations (N < 3) to compute statistic")
                    values[['s[sw]']] <- NaN
                    values[['p[sw]']] <- ''
                } else if (n > 5000) {
                    swf <- list(rowKey=pair, "s[sw]", "Too many observations (N > 5000) to compute statistic")
                    values[['s[sw]']] <- NaN
                    values[['p[sw]']] <- ''
                } else {
                    res <- try(shapiro.test(residuals), silent=TRUE)
                    if (jmvcore::isError(res)) {
                        values[['s[sw]']] <- NaN
                        values[['p[sw]']] <- ''
                    } else {
                        values[['s[sw]']] <- res$statistic
                        values[['p[sw]']] <- res$p.value
                    }
                }

                res <- try(ks.test(residuals, 'pnorm', 0, 1), silent=TRUE)

                if ( ! jmvcore::isError(res)) {
                    values[['s[ks]']] <- res$statistic
                    values[['p[ks]']] <- res$p.value
                }
                else {
                    values[['s[ks]']] <- NaN
                    values[['p[ks]']] <- ''
                }

                res <- try(nortest::ad.test(residuals), silent=TRUE)

                if ( ! jmvcore::isError(res)) {
                    values[['s[ad]']] <- res$statistic
                    values[['p[ad]']] <- res$p.value
                }
                else {
                    values[['s[ad]']] <- NaN
                    values[['p[ad]']] <- ''
                }

                table$setRow(rowKey=pair, values)
                if ( ! is.null(swf))
                    do.call(table$addFootnote, swf)
            }
        })
)