Prueba de hipótesis para la proporción

Suponga que se tiene el número de éxitos $X$ en una muestra de tamaño $n$. Se quiere estudiar la hipótesis nula $H_0: p = p_0$ y se sospecha que la proporción $p$ podría estar en alguna de las siguientes situaciones:

$H_1: p < p_0$
$H_1: p \neq p_0$
$H_1: p > p_0$

El estadístico para realizar la prueba es:

\[ Z_0=\frac{\hat{p}-p_0}{\sqrt{\frac{p_{0}(1-p_{0})}{n}}}, \]

donde $\hat{p}=X/n$ corresponde a la proporción de éxitos en una muestra de tamaño $n$. Siempre que $np$ y $n(1-p)$ sean ambos mayores o iguales a 10, y bajo la suposición de que $H_0$ es verdadera, el estadístico $Z_0$ tiene una distribución aproximadamente normal estándar.

Si el valor calculado para el estadístico dado en la ecuación se denota por $z_0$, entonces el valor-$P$ de la prueba se calcula de acuerdo a la hipótesis alterna como:

Si $H_a: p < p_0$, entonces valor-$P$=$P(z < z_0)$.
Si $H_a: p \neq p_0$, entonces valor-$P$=$2 \times P(z > \lvert z_0 \rvert)$.
Si $H_a: p > p_0$, entonces valor-$P$=$P(z > z_0)$.

La hipótesis nula $H_0$ se rechaza si el valor-$P$ es menor que el nivel de significancia ($\alpha$).

Cuando $\left|\hat{p}-p_{0}\right|>\frac{1}{2n}$ se usa corrección por continuidad en el estadístico de prueba. Así, dependiendo de la relación entre $\hat{p}$ y $p_0$ el estadístico tendrá una expresión diferente:

Si $\hat{p} - p_0 > 0$, entonces \[ Z_0=\frac{\hat{p}-p_0 - \frac{1}{2n}}{\sqrt{\frac{p_{0}(1-p_{0})}{n}}}. \]
Si $\hat{p} - p_0 < 0$, entonces \[ Z_0=\frac{\hat{p}-p_0 + \frac{1}{2n}}{\sqrt{\frac{p_{0}(1-p_{0})}{n}}}. \]

El criterio del valor-$P$ será el mismo utilizado cuando no se usa corrección por continuidad.

library(shiny) shinyServer(function(input,output,session){ dt <- reactive({ inFile <- input$file1 if(is.null(inFile)) dt <- read.table('datos.txt', header=T, sep='\t') else dt <- read.csv(inFile$datapath, header=input$header, sep=input$sep) }) observe({ updateSelectInput(session, "variable", choices=names(dt())) }) observeEvent(input$variable, { column_levels <- as.character(sort(unique(dt()[[input$variable]]))) updateSelectInput(session, "niveles", choices = column_levels) }) output$inputData <- renderTable({ inFile <- input$file1 if(is.null(inFile)) dt <- read.table('datos.txt', header=T, sep='\t') else dt <- read.csv(inFile$datapath, header=input$header, sep=input$sep) dt }) output$appPlot <- renderPlot({ inFile <- input$file1 if(is.null(inFile)) dt <- read.table('datos.txt', header=T, sep='\t') else dt <- read.csv(inFile$datapath, header=input$header, sep=input$sep) Niveles <- na.omit(dt[, input$variable]) # Para sacar los NA de la variable tabla <- table(Niveles) ptabla <- prop.table(tabla) xx <- barplot(ptabla, las=1, col='deepskyblue3', ylab='Frecuencia relativa', xlab='Niveles', ylim=c(0, max(ptabla)+0.1)) text(x=xx, y=ptabla, pos=3, cex=0.8, col="black", label=round(ptabla, 4)) }) output$consolidado <- renderTable({ inFile <- input$file1 if(is.null(inFile)) dt <- read.table('datos.txt', header=T, sep='\t') else dt <- read.csv(inFile$datapath, header=input$header, sep=input$sep) y <- na.omit(dt[, input$variable]) # Para sacar los NA de la variable tabla <- table(y) x <- tabla[input$niveles] n <- sum(tabla) res <- cbind(x, n, x/n) colnames(res) <- c('Número de éxitos', 'Número de casos', 'Proporción observada') res }, align='c', bordered = TRUE, digits=4) output$resul1 <- renderText({ inFile <- input$file1 if(is.null(inFile)) dt <- read.table('datos.txt', header=T, sep='\t') else dt <- read.csv(inFile$datapath, header=input$header, sep=input$sep) dt <- na.omit(dt) # Para eliminar obs con NA y <- na.omit(dt[, input$variable]) # Para sacar los NA de la variable tabla <- table(y) x <- tabla[input$niveles] n <- sum(tabla) ph <- prop.test(x=x, n=n, alternative=input$h0, conf.level=input$alfa, p=input$p0, correct=input$correct) ph$statistic <- sign(ph$estimate - ph$null.value) * sqrt(ph$statistic) paste0('El estadístico de prueba es z0=', round(ph$statistic, 4), ' con un valor-P de ', round(ph$p.value, 2), '.') }) output$resul2 <- renderText({ inFile <- input$file1 if(is.null(inFile)) dt <- read.table('datos.txt', header=T, sep='\t') else dt <- read.csv(inFile$datapath, header=input$header, sep=input$sep) dt <- na.omit(dt) # Para eliminar obs con NA y <- na.omit(dt[, input$variable]) # Para sacar los NA de la variable tabla <- table(y) x <- tabla[input$niveles] n <- sum(tabla) ph <- prop.test(x=x, n=n, alternative=input$h0, conf.level=input$alfa, p=input$p0, correct=input$correct) intervalo <- paste("(", round(ph$conf.int[1], digits=4), ", ", round(ph$conf.int[2], digits=4), ").", sep='') paste0('El intervalo de confianza del ', 100*input$alfa, '% para proporción poblacional es ', intervalo) }) })

library(shiny) library(markdown) shinyUI(pageWithSidebar( headerPanel(title=HTML("Prueba de hipótesis para la proporción P"), windowTitle="PH proporción"), sidebarPanel( h5('Esta aplicación realiza la prueba de hipótesis para la proporción de una variable cualitativa.'), h6('La aplicación usa una base de datos de ejemplo pero el usuario puede cargar su propia base de datos.'), fileInput(inputId='file1', label='Use el siguiente botón para cargar su base de datos.', accept = c( 'text/csv', 'text/comma-separated-values', 'text/tab-separated-values', 'text/plain', '.csv', '.tsv' )), checkboxInput(inputId='header', label='¿Tiene encabezado la base de datos?', value=TRUE), selectInput(inputId="sep", label = "¿Cuál es la separación de los datos?", choices = list(Tab='\t', Comma=',', Semicolon=';', 'Space'=' '), selected = ';'), selectInput(inputId="variable", label=p("Elija la variable", span("cualitativa", style = "color:red"), "para realizar la prueba de hipótesis."), choices="placeholder1"), selectInput(inputId="niveles", label=p("Elija un", span("nivel", style = "color:blue"), "de la variable cualitativa anterior para realizar la prueba."), choices="placeholder2"), numericInput(inputId='p0', label=HTML("Ingrese el valor de referencia p0 para probar H0: p = p0"), value=0.17, min=0, max=1, step=0.01), selectInput(inputId="h0", label=HTML("Elija la hipótesis alternativa < , ≠ o >"), choices=list("Menor" = "less", "Diferente" = "two.sided", "Mayor" = "greater"), selected = "two.sided"), checkboxInput(inputId="correct", label="Marque si desea usar factor de correción", value=TRUE, width=NULL), sliderInput(inputId='alfa', label=HTML("Opcional: elija un nivel de confianza para construir el intervalo de confianza para la proporción P;"), min=0.90, max=0.99, value=0.95, step=0.01), img(src="logo.png", height = 60, width = 120), img(src="udea.png", height = 25, width = 70), img(src="cua.png", height = 40, width = 110), br(), tags$a(href="https://srunal.github.io", "https://srunal.github.io") ), mainPanel( tabsetPanel(type = "pills", tabPanel("Resultados", h4('- Diagrama de barras para la variable seleccionada.'), plotOutput("appPlot", width='500px', height='300px'), h4("- Tabla resumen de las base de datos:"), tableOutput("consolidado"), h4("- Resultados de la prueba de hipótesis:"), textOutput("resul1"), h4(HTML("- Intervalo de confianza para la proporción P:")), textOutput("resul2")), tabPanel("Datos", "A continuación los datos que está usando la aplicación.", uiOutput('inputData')), tabPanel("Teoría", includeHTML("include.html")) ) ) ))