Test estadistico
☺No parametrica K Muestras
K muestras relacionadas
From Luis MARON.
Prueba Q-Cochran
Se utiliza cuando un grupo de n individuos son medidos k veces (k repeticiones), y la variable de interés tienen respuesta dicotómica (generalmente 1 denota el “acierto” y 0 el “fracaso”).
Ejemplo:
1)
Cuatro métodos (A, B, C y D) de tratamiento de tejido en bruto para hacerlo repelente al agua se probaron para comprobar la eficacia en seis tipos de tejido. Un resultado satisfactorio obtuvo un 1.
| MetdA | MetodB | MetodC | MetodD |
|---|---|---|---|
| 1 | 1 | 0 | 0 |
| 1 | 1 | 0 | 1 |
| 1 | 0 | 0 | 0 |
| 1 | 1 | 1 | 0 |
| 1 | 1 | 0 | 1 |
| 1 | 1 | 0 | 1 |
- Hipótesis estadística:
$$ \left\{ \begin{array}{ll} H_{0}: & \text{Los cuatro tratamientos son igualmente efectivos.}\\ H_{1}: & \text{Los cuatro tratamientos no son igualmente efectivos.} \end{array} \right. $$- Nivel de significancia: α = 0.05
- Estadística de prueba y contraste, Q de Cochran.
library(RVAideMemoire)
metodo_a <- rep(1,6) # c(1,1,1,1,1,1)
metodo_b <- c(1,1,0,1,1,1)
metodo_c <- c(0,0,0,1,0,0)
metodo_d <- c(0,1,0,0,1,1)
data* function (..., list = character(), package = NULL, lib.loc = NULL,
* verbose = getOption("verbose"), envir = .GlobalEnv)
* {
* fileExt <- function(x) {
* db <- grepl("\\.[^.]+\\.(gz|bz2|xz)$", x)
* ans <- sub(".*\\.", "", x)
* ans[db] <- sub(".*\\.([^.]+\\.)(gz|bz2|xz)$", "\\1\\2",
* x[db])
* ans
* }
* names <- c(as.character(substitute(list(...))[-1L]), list)
* if (!is.null(package)) {
* if (!is.character(package))
* stop("'package' must be a character string or NULL")
* if (any(package %in% "base"))
* warning("datasets have been moved from package 'base' to package 'datasets'")
* if (any(package %in% "stats"))
* warning("datasets have been moved from package 'stats' to package 'datasets'")
* package[package %in% c("base", "stats")] <- "datasets"
* }
* paths <- find.package(package, lib.loc, verbose = verbose)
* if (is.null(lib.loc))
* paths <- c(path.package(package, TRUE), if (!length(package)) getwd(),
* paths)
* paths <- unique(normalizePath(paths[file.exists(paths)]))
* paths <- paths[dir.exists(file.path(paths, "data"))]
* dataExts <- tools:::.make_file_exts("data")
* if (length(names) == 0L) {
* db <- matrix(character(), nrow = 0L, ncol = 4L)
* for (path in paths) {
* entries <- NULL
* packageName <- if (file_test("-f", file.path(path,
* "DESCRIPTION")))
* basename(path)
* else "."
* if (file_test("-f", INDEX <- file.path(path, "Meta",
* "data.rds"))) {
* entries <- readRDS(INDEX)
* }
* else {
* dataDir <- file.path(path, "data")
* entries <- tools::list_files_with_type(dataDir,
* "data")
* if (length(entries)) {
* entries <- unique(tools::file_path_sans_ext(basename(entries)))
* entries <- cbind(entries, "")
* }
* }
* if (NROW(entries)) {
* if (is.matrix(entries) && ncol(entries) == 2L)
* db <- rbind(db, cbind(packageName, dirname(path),
* entries))
* else warning(gettextf("data index for package %s is invalid and will be ignored",
* sQuote(packageName)), domain = NA, call. = FALSE)
* }
* }
* colnames(db) <- c("Package", "LibPath", "Item", "Title")
* footer <- if (missing(package))
* paste0("Use ", sQuote(paste("data(package =", ".packages(all.available = TRUE))")),
* "\n", "to list the data sets in all *available* packages.")
* else NULL
* y <- list(title = "Data sets", header = NULL, results = db,
* footer = footer)
* class(y) <- "packageIQR"
* return(y)
* }
* paths <- file.path(paths, "data")
* for (name in names) {
* found <- FALSE
* for (p in paths) {
* if (file_test("-f", file.path(p, "Rdata.rds"))) {
* rds <- readRDS(file.path(p, "Rdata.rds"))
* if (name %in% names(rds)) {
* found <- TRUE
* if (verbose)
* message(sprintf("name=%s:\t found in Rdata.rds",
* name), domain = NA)
* thispkg <- sub(".*/([^/]*)/data$", "\\1", p)
* thispkg <- sub("_.*$", "", thispkg)
* thispkg <- paste0("package:", thispkg)
* objs <- rds[[name]]
* lazyLoad(file.path(p, "Rdata"), envir = envir,
* filter = function(x) x %in% objs)
* break
* }
* else if (verbose)
* message(sprintf("name=%s:\t NOT found in names() of Rdata.rds, i.e.,\n\t%s\n",
* name, paste(names(rds), collapse = ",")),
* domain = NA)
* }
* if (file_test("-f", file.path(p, "Rdata.zip"))) {
* warning("zipped data found for package ", sQuote(basename(dirname(p))),
* ".\nThat is defunct, so please re-install the package.",
* domain = NA)
* if (file_test("-f", fp <- file.path(p, "filelist")))
* files <- file.path(p, scan(fp, what = "", quiet = TRUE))
* else {
* warning(gettextf("file 'filelist' is missing for directory %s",
* sQuote(p)), domain = NA)
* next
* }
* }
* else {
* files <- list.files(p, full.names = TRUE)
* }
* files <- files[grep(name, files, fixed = TRUE)]
* if (length(files) > 1L) {
* o <- match(fileExt(files), dataExts, nomatch = 100L)
* paths0 <- dirname(files)
* paths0 <- factor(paths0, levels = unique(paths0))
* files <- files[order(paths0, o)]
* }
* if (length(files)) {
* for (file in files) {
* if (verbose)
* message("name=", name, ":\t file= ...", .Platform$file.sep,
* basename(file), "::\t", appendLF = FALSE,
* domain = NA)
* ext <- fileExt(file)
* if (basename(file) != paste0(name, ".", ext))
* found <- FALSE
* else {
* found <- TRUE
* zfile <- file
* zipname <- file.path(dirname(file), "Rdata.zip")
* if (file.exists(zipname)) {
* Rdatadir <- tempfile("Rdata")
* dir.create(Rdatadir, showWarnings = FALSE)
* topic <- basename(file)
* rc <- .External(C_unzip, zipname, topic,
* Rdatadir, FALSE, TRUE, FALSE, FALSE)
* if (rc == 0L)
* zfile <- file.path(Rdatadir, topic)
* }
* if (zfile != file)
* on.exit(unlink(zfile))
* switch(ext, R = , r = {
* library("utils")
* sys.source(zfile, chdir = TRUE, envir = envir)
* }, RData = , rdata = , rda = load(zfile,
* envir = envir), TXT = , txt = , tab = ,
* tab.gz = , tab.bz2 = , tab.xz = , txt.gz = ,
* txt.bz2 = , txt.xz = assign(name, read.table(zfile,
* header = TRUE, as.is = FALSE), envir = envir),
* CSV = , csv = , csv.gz = , csv.bz2 = ,
* csv.xz = assign(name, read.table(zfile,
* header = TRUE, sep = ";", as.is = FALSE),
* envir = envir), found <- FALSE)
* }
* if (found)
* break
* }
* if (verbose)
* message(if (!found)
* "*NOT* ", "found", domain = NA)
* }
* if (found)
* break
* }
* if (!found)
* warning(gettextf("data set %s not found", sQuote(name)),
* domain = NA)
* }
* invisible(names)
* }
*
*
resultado <- c(metodo_a,metodo_b,metodo_c,metodo_d)
metodo <- gl(4,6,labels=LETTERS[1:4])
tejidos <- c(1:6,1:6,1:6,1:6)
cochran.qtest(resultado ~ metodo | tejidos)*
* Cochran's Q test
*
* data: resultado by metodo, block = tejidos
* Q = 9.3158, df = 3, p-value = 0.02537
* alternative hypothesis: true difference in probabilities is not equal to 0
* sample estimates:
* proba in group A proba in group B proba in group C proba in group D
* 1.0000000 0.8333333 0.1666667 0.5000000
*
* Pairwise comparisons using Wilcoxon sign test
*
* A B C
* B 1.000 - -
* C 0.375 0.375 -
* D 0.500 0.750 0.75
*
* P value adjustment method: fdr
#####
data<-data.frame(metodo_a,metodo_b,metodo_c,metodo_d)
cochranq.test <- function(mat)
{
k <- ncol(mat)
C <- sum(colSums(mat) ^ 2)
R <- sum(rowSums(mat) ^ 2)
T <- sum(rowSums(mat))
num <- (k - 1) * ((k * C) - (T ^ 2))
den <- (k * T) - R
Q <- num / den
df <- k - 1
names(df) <- "df"
names(Q) <- "Cochran's Q"
p.val <- pchisq(Q, df, lower.tail = FALSE)
QVAL <- list(statistic = Q, parameter = df, p.value = p.val,
method = "Prueba Q de Cochran para muestras relacionadas",
data.name = deparse(substitute(mat)))
class(QVAL) <- "htest"
if (QVAL$p.value < 0.05) cat("Se rechaza H_0")else cat("Se acepta H_0")
return(QVAL)
}
cochranq.test(data)* Se rechaza H_0
*
* Prueba Q de Cochran para muestras relacionadas
*
* data: data
* Cochran's Q = 9.3158, df = 3, p-value = 0.02537
Dado que p(0.02537)<α = 0.05, rechazamos la H0. Por lo tanto, tenemos suficiente evidencia estadística para concluir que la efectividad de al menos dos tratamientos difiere.
Análisis de la varianza de dos clasificaciones por rangos de Friedman
Ejemplo:
1)
Se ha diseñado un experimento para estudiar el efecto del paso del tiempo sobre la calidad del recuerdo. A un grupo de 9 sujetos se les hace memorizar una historia durante 20 minutos; más tarde, al cabo de una hora, de un día, de una semana y de un mes se le pide que intenten recordar la historia escribiendo todo lo que recuerden. Un grupo de expertos evalúan la calidad del recuerdo de cada sujeto hasta elaborar los datos que se muestra en la tabla.
| sujetos | hora | dia | semana | mes |
|---|---|---|---|---|
| 1 | 6 | 8 | 8 | 12 |
| 2 | 2 | 9 | 9 | 10 |
| 3 | 2 | 10 | 10 | 8 |
| 4 | 5 | 13 | 7 | 11 |
| 5 | 8 | 12 | 12 | 12 |
| 6 | 3 | 13 | 8 | 10 |
| 7 | 8 | 16 | 10 | 13 |
| 8 | 5 | 9 | 6 | 6 |
| 9 | 0 | 9 | 11 | 8 |
- Hipótesis estadística:
$$ \left\{ \begin{array}{ll} H_{0}: & \text{La calidad del recuerdo es la misma en los 4 momentos.}\\ H_{1}: & \text{La calidad del recuerdo no es la misma en los 4 momentos.} \end{array} \right. $$- Nivel de significancia: α = 0.05
- Estadística de prueba y contraste, Friedman.
entrada <- ("
sujetos hora dia semana mes
1 16 8 8 12
2 12 9 9 10
3 12 10 10 8
4 15 13 7 11
5 18 12 12 12
6 13 13 8 10
7 18 16 10 13
8 15 9 6 6
9 20 9 11 8 ")
data = read.table(textConnection(entrada),header=TRUE)
resp <- with(data, cbind(dia, hora, mes, semana))
friedman.test(resp)##
## Friedman rank sum test
##
## data: resp
## Friedman chi-squared = 18.556, df = 3, p-value = 0.0003378
Dado que p(0.00034)<α = 0.05, rechazamos la H0. Por lo que la calidad del recuerdo no es la misma en los 4 momentos.
Prueba de Page
Ejemplo:
1)
Se evaluaron 4 sujetos entrenados durante un gran número de ensayos en los cuales el estímulo variaba en la sincronía inicial y el espaciamiento entre los estímulos. A fin de evaluar la precisión de los sujetos para detectar la presencia de un espacio, era necesario determinar qué tan exactos eran los sujetos al reportar la ausencia de un espacio entre los sucesivos estímulos, solo que también se varió el EIA. En cada sujeto se estimularon 6 diferentes EIA. La tabla muestra las respuestas correctas para cada sujeto en cada condición. El principal interés era evaluar la hipótesis de que la exactitud estaba inversamente relacionada con los EIA. →Tabla,proporción de respuestas correctas como una función de estímulos de inicio asincrónico:
| Sujeto | 204 | 104 | 56 | 30 | 13 | 0 |
|---|---|---|---|---|---|---|
| A | 0.797 | 0.873 | 0.888 | 0.923 | 0.942 | 0.956 |
| B | 0.794 | 0.772 | 0.908 | 0.982 | 0.946 | 0.913 |
| C | 0.838 | 0.801 | 0.853 | 0.951 | 0.883 | 0.837 |
| D | 0.815 | 0.801 | 0.747 | 0.859 | 0.887 | 0.902 |
- Hipótesis estadística:
$$ \left\{ \begin{array}{ll} H_{0}: & \text{Los diferentes EIA no tienen efecto en la precisión con que los sujetos reportan el espaciamiento de los puntos en los patrones táctiles.}\\ H_{1}: & \text{Los diferentes EIA tienen efecto en la precisión con que los sujetos reportan el espaciamiento de los puntos en los patrones táctiles.} \end{array} \right. $$- Nivel de significancia: α = 0.05
- Estadística de prueba y contraste, Page
library(DescTools)## Warning: package 'DescTools' was built under R version 3.5.1
dat<-matrix(c(0.797, 0.794, 0.838, 0.815,
0.873, 0.772, 0.801, 0.801,
0.888, 0.908, 0.853, 0.747,
0.923, 0.982, 0.951, 0.859,
0.942, 0.946, 0.883, 0.887,
0.956, 0.913, 0.837, 0.902
),nrow = 4)
PageTest(dat)##
## Page test for ordered alternatives
##
## data: dat
## L = 342, p-value = 0.0005661
Como p(0.000566)<α = 0.05, rechazamos la H0. Por lo que la exactitud de las respuestas esta relacionado inversamente con los EIA.
K muestas independientes
Prueba χ2 para k muestras independientes
Ejemplos:
1)
Se evaluó en 300 ratas el efecto anti-calculo de 3 pastas dentales habiéndose evaluado los depósitos como bajo, moderado, alto. ¿Existe diferencia significativa?.
| pastDe | Alto | Bajo | Moderado |
|---|---|---|---|
| A | 21 | 49 | 30 |
| B | 12 | 67 | 21 |
| C | 24 | 49 | 27 |
- Hipótesis estadística:
$$ \left\{ \begin{array}{ll} H_{0}: & \text{No existe diferencia significativa con respecto a los depositos en el efecto anti-calculo de 3 pastas dentales en las ratas.}\\ H_{1}: & \text{Existe diferencia significativa con respecto a los depositos en el efecto anti-calculo de 3 pastas dentales en las ratas.} \end{array} \right. $$- Nivel de significancia: α = 0.05
- Estadística de prueba y contraste, Chi-squared.
A <- c(49,30,21)
B <- c(67,21,12)
C <- c(49,27,24)
pastaD <- c(rep("A",sum(A)), rep("B", sum(B)), rep("C",sum(C)))
deposito <- c(rep("Bajo",A[1]),rep("Moderado",A[2]),rep("Alto",A[3]),rep("Bajo",B[1]),rep("Moderado",B[2]),rep("Alto",B[3]),rep("Bajo",C[1]),rep("Moderado",C[2]),rep("Alto",C[3]))
tb<-table(pastaD,deposito); tb* deposito
* pastaD Alto Bajo Moderado
* A 21 49 30
* B 12 67 21
* C 24 49 27
chisq.test(tb)*
* Pearson's Chi-squared test
*
* data: tb
* X-squared = 9.6479, df = 4, p-value = 0.04679
Dado que p(0.04679)<α = 0.05, rechazamos la H0. Por lo que hay diferencia significativa con respecto a los depositos en el efecto anti-calculo de 3 pastas dentales en las ratas.
2)
En una investigación de la naturaleza y consecuencias de la estratificación social en una pequeña comunidad, se observó que los miembros de la comunidad se clasificaban a sí mismos en 5 clases sociales: I, II, III, IV y V. La investigación se centró en los correlatos de esta estratificación entre la juventud de la comunidad. Una de sus predicciones fue que los adolescentes de las diferentes clases sociales se inscribirían en diferentes cursos (preparatorio, general, comercial) en la secundaria. Se hizo la prueba por medio de la identificación de la clase social de 390 estudiantes de secundaria y se determinó el curso al que inscribió cada uno, los datos son:
| curso | I_II | III | IV | V |
|---|---|---|---|---|
| A | 23 | 40 | 16 | 2 |
| B | 11 | 75 | 107 | 14 |
| C | 1 | 31 | 60 | 10 |
- Hipótesis estadística:
$$ \left\{ \begin{array}{ll} H_{0}: & \text{La proporción de estudiantes inscritos en los tres cursos que se ofrecen a su elección es la misma en todas las clases sociales.}\\ H_{1}: & \text{La proporción de estudiantes inscritos en los tres cursos difieren de una clase social a otra.} \end{array} \right. $$- Nivel de significancia: α = 0.05
- Estadística de prueba y contraste, Chi-squared.
A <- c(23,40,16,2)
B <- c(11,75,107,14)
C <- c(1,31,60,10)
curso <- c(rep("A",sum(A)), rep("B", sum(B)), rep("C",sum(C)))
clase <- c(rep("I_II",A[1]),rep("III",A[2]),rep("IV",A[3]),rep("V",A[4]),rep("I_II",B[1]),rep("III",B[2]),rep("IV",B[3]),rep("V",B[4]),rep("I_II",C[1]),rep("III",C[2]),rep("IV",C[3]),rep("V",C[4]))
tb<-table(curso,clase);tb* clase
* curso I_II III IV V
* A 23 40 16 2
* B 11 75 107 14
* C 1 31 60 10
chisq.test(tb)*
* Pearson's Chi-squared test
*
* data: tb
* X-squared = 69.389, df = 6, p-value = 5.455e-13
Dado que p(0.00000005)<α = 0.05, rechazamos la H0. La proporción de estudiantes inscritos en los tres cursos difieren de una clase social a otra.
Prueba de Kruskal Wallis
Ejemplo:
1)
Un investigador anotó los pesos al nacer de los miembros de 6 camadas diferentes de toros, para determinar si el peso al nacer es afectado por el tamaño de la camada.
| ca1 | ca2 | ca3 | ca4 | ca5 | ca6 |
|---|---|---|---|---|---|
| 2 | 3.5 | 3.3 | 2.6 | 3.1 | 2.6 |
| 2.8 | 2.8 | 3.6 | 2.6 | 2.9 | 2.2 |
| 3.3 | 3.2 | 2.6 | 2.9 | 3.1 | 2.2 |
| 3.2 | 3.5 | 3.1 | 2 | 2.5 | 2.5 |
| 4.4 | 2.3 | 3.2 | 2 | 2.3 | 1.2 |
| 3.6 | 2.4 | 3.3 | 2.1 | 1.2 | |
| 1.9 | 2 | 2.9 | 2.2 | ||
| 3.3 | 1.6 | 3.4 | |||
| 2.8 | 3.2 | ||||
| 1.1 | 3.2 |
- Hipótesis estadística:
$$ \left\{ \begin{array}{ll} H_{0}: & \text{Exixte igualdad en los pesos de nacimiento promedio de toros en}\\& \text{ diferentes tamaños de camada.}\\ H_{1}: & \text{Los pesos de nacimiento promedio de toros en diferentes tamaños de}\\& \text{ camada no son todos iguales.} \end{array} \right. $$- Nivel de significancia: α = 0.05
- Estadística de prueba y contraste, Kruskal.
camada_1 <- c(2,2.8,3.3,3.2,4.4,3.6,1.9,3.3,2.8,1.1)
camada_2 <- c(3.5,2.8,3.2,3.5,2.3,2.4,2,1.6)
camada_3 <- c(3.3,3.6,2.6,3.1,3.2,3.3,2.9,3.4,3.2,3.2)
camada_4 <- c(2.6,2.9,2.6,2,2,2.1)
camada_5 <- c(3.1,2.9,3.1,2.5,2.3)
camada_6 <- c(2.6,2.2,2.2,2.2,2.5,1.2,1.2)
kruskal.test(list(camada_1,camada_2,camada_3,camada_4,camada_5,camada_6))##
## Kruskal-Wallis rank sum test
##
## data: list(camada_1, camada_2, camada_3, camada_4, camada_5, camada_6)
## Kruskal-Wallis chi-squared = 14.791, df = 5, p-value = 0.01129
#####
IN <- ("
ca1 ca2 ca3 ca4 ca5 ca6
2 3.5 3.3 2.6 3.1 2.6
2.8 2.8 3.6 2.6 2.9 2.2
3.3 3.2 2.6 2.9 3.1 2.2
3.2 3.5 3.1 2 2.5 2.5
4.4 2.3 3.2 2 2.3 1.2
3.6 2.4 3.3 2.1 NA 1.2
1.9 2 2.9 NA NA 2.2
3.3 1.6 3.4 NA NA NA
2.8 NA 3.2 NA NA NA
1.1 NA 3.2 NA NA NA
")
data <- read.table(textConnection(IN), header = T)
kruskal.test(data)##
## Kruskal-Wallis rank sum test
##
## data: data
## Kruskal-Wallis chi-squared = 14.791, df = 5, p-value = 0.01129
p(0.0113)<α = 0.05, rechazamos la H0. Concluimos que el peso del nacimiento de los toros varía significativamente de acuerdo con el tamaño de la camada.
Fin ☺
#devtools::install_github("luisxsuper/metodNum")
metodNum::meme()