jamovi

Code: Select all

## -- References
# Package: 'ExpDes'
# Version: 1.2.2
# Dates: 2021-10-04
# Authors: Eric Batista Ferreira, Portya Piscitelli Cavalcanti, Denismar Alves Nogueira
# Maintainer: Eric Batista Ferreira

##  Note:
# Changes to the scottknott() function (Multiple comparison: Scott-Knott test)
# for use as an example with jamovi Rj editor.
RjScottKnott <- function(y, x, ResSS, ResDF) {

    skt <- function(medie, s2) {
        prob <- 0.05
        bo <- 0
        si2 <- s2
        defr <- ResDF
        parou <- 1
        np <- length(medie) - 1

        for (i in 1:np) {
            g1 <- medie[1:i]
            g2 <- medie[(i+1):length(medie)]
            B0 <- sum(g1)^2/length(g1) + sum(g2)^2/length(g2) - (sum(g1) + sum(g2))^2/length(c(g1, g2))

            if (B0 > bo) {
                bo <- B0
                parou <- i
            }
        }

        g1 <- medie[1:parou]
        g2 <- medie[(parou+1):length(medie)]
        test <- c(g1, g2)
        sigm2 <- (sum(test^2) - sum(test)^2/length(test) + defr*si2)/(length(test) + defr)
        lamb <- pi*bo/(2*sigm2*(pi-2))
        v0 <- length(test)/(pi-2)
    
        p <- pchisq(lamb, v0, lower.tail=FALSE)
        if (p < prob) {
            for (i in 1:length(g1)){
                cat(names(g1[i]),"\n", file=tmpfile, append=TRUE)
            }
            cat("*","\n", file=tmpfile, append=TRUE)
        }
        
        if (length(g1)>1)
            skt(g1,s2)

        if (length(g2)>1)
            skt(g2,s2)
    }

    medie <- sort(tapply(y, x, mean), decreasing=TRUE)
    rep <- tapply(y, x, length)
    s2 <- ResSS/ResDF/rep[1]
    
    tmpfile <- tempfile(pattern="jamovi", tmpdir=tempdir(), fileext="")
    skt(medie, s2)

    f <- names(medie)
    names(medie) <- 1:length(medie)
    resdf <- data.frame("r"=0, "f"=f, "m"=medie)

    if (file.exists(tmpfile) == FALSE) 
        stop
    else {
        rtab <- read.table(tmpfile)
        file.remove(tmpfile)
        vec <- rtab[[1]]
        vec <- as.vector(vec)
        z <- 1
        
        for (j in 1:length(vec)) {
            if (vec[j] == "*")
                z <- z+1
            
            for (i in 1:length(resdf$f)) {
                if (resdf$f[i]==vec[j]) 
                    resdf$r[i] <- z
            }
        }
    }

    alphabetletters <- letters
    if(length(resdf$r)>26) {
        l <- floor(length(resdf$r)/26)
        for(i in 1:l) 
            alphabetletters <- c(alphabetletters, paste(letters, i, sep=''))
    }

    res <- 1
    for (i in 1:(length(resdf$r)-1)){
        if (resdf$r[i] != resdf$r[i+1]){
            resdf$r[i] <- letters[res]
            res <- res+1
            
            if (i == (length(resdf$r)-1))
                resdf$r[i+1] <- letters[res]

        } else {
            resdf$r[i] <- letters[res]

            if (i == (length(resdf$r)-1)) 
                resdf$r[i+1] <- letters[res]

        }
    }

    names(resdf) <- c("Groups", "Treatments", "Means")
    cat("\nScott-Knott test\n-----------------------------------------\n")
    print(resdf)
    cat('-----------------------------------------\n')

} ## --- End for the Rjscottknott() function.