Prueba de hipótesis para la diferencia de proporciones

Suponga que se tienen $X$ y $Y$ éxitos de dos variables aleatorias binomiales con las siguientes características:

$X$ número de éxitos observados en $n_1$ ensayos cuya probabilidad de éxito es $p_1$.
$Y$ número de éxitos observados en $n_2$ ensayos cuya probabilidad de éxito es $p_2$.

En este caso se quiere estudiar la hipótesis nula $H_0: p_1 - p_2 = \delta_0$ y se sospecha que la diferencia de proporciones $p_1 - p_2$ podría estar en alguna de las siguientes situaciones:

$H_a: p_1 - p_2 < \delta_0$
$H_a: p_1 - p_2 \neq \delta_0$
$H_a: p_1 - p_2 > \delta_0$

El estadístico para realizar la prueba es: \[ Z_0=\frac{\hat{p}_1 - \hat{p}_2 - \delta_0}{\sqrt{\frac{\hat{p}_{1}(1-\hat{p}_{1})}{n_1} +\frac{\hat{p}_{2}(1-\hat{p}_{2})}{n_2}}}, \]

donde $\hat{p}_1 =X/n_1$ y $\hat{p}_2 =Y/n_2$ corresponden a la proporción de éxitos en una muestra de tamaño $n_1$ y $n_2$, respectivamente. En estas pruebas es común considerar que $\delta_0=0$. En este caso, una práctica estándar es crear una estimación conjunta de las proporciones poblacionales tal que $p_1=p_2$, de tal forma que el estadístico de prueba es:

\[ Z_0=\frac{\hat{p}_1 - \hat{p}_2 }{\sqrt{ \hat{p}(1-\hat{p})\left(\frac{1}{n_1} +\frac{1}{n_2} \right)}}, \]

donde $\hat{p}=(X+Y)/(n_1 + n_2)$. Bajo la suposición de que $H_0$ es verdadera, el estadístico $Z_0$ en 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_1 - p_2 < 0$, entonces valor-$P$=$P(z < z_0)$.
Si $H_a:p_1 - p_2 \neq 0$, entonces valor-$P$=$2 \times P(z > \lvert z_0 \rvert)$.
Si $H_a: p_1 - p_2 > 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}_1-\hat{p}_2 \right|> 0.5 \left( 1/n_1 + 1/n_2 \right)$ se usa corrección por continuidad en el estadístico de prueba. Así el estadístico tendrá una expresión diferente:

Si $\hat{p}_1 - \hat{p}_2 > 0$, entonces \[ Z_0=\frac{\hat{p}_1 - \hat{p}_2 - \frac{1}{2} \left( \frac{1}{n_1} + \frac{1}{n_2} \right)}{\sqrt{ \hat{p}(1-\hat{p})\left(\frac{1}{n_1} +\frac{1}{n_2} \right)}}. \]
Si $\hat{p}_1 - \hat{p}_2 < 0$, entonces \[ Z_0=\frac{\hat{p}_1 - \hat{p}_2 + \frac{1}{2} \left( \frac{1}{n_1} + \frac{1}{n_2} \right)}{\sqrt{ \hat{p}(1-\hat{p})\left(\frac{1}{n_1} +\frac{1}{n_2} \right)}}. \]

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

library(shiny) shinyServer(function(input,output,session){ dt1 <- reactive({ inFile <- input$file1 if(is.null(inFile)) dt1 <- read.table('datos1.txt', header=T, sep='\t') else dt1 <- read.csv(inFile$datapath, header=input$header, sep=input$sep) }) dt2 <- reactive({ inFile <- input$file2 if(is.null(inFile)) dt2 <- read.table('datos2.txt', header=T, sep='\t') else dt2 <- read.csv(inFile$datapath, header=input$header, sep=input$sep) }) observe({ updateSelectInput(session, "variable", choices=names(dt1())) }) observe({ updateSelectInput(session, "variable", choices=names(dt2())) }) observeEvent(input$variable, { column_levels <- as.character(sort(unique(dt1()[[input$variable]]))) updateSelectInput(session, "niveles", choices = column_levels) }) observeEvent(input$variable, { column_levels <- as.character(sort(unique(dt2()[[input$variable]]))) updateSelectInput(session, "niveles", choices = column_levels) }) output$inputData1 <- renderTable({ inFile <- input$file1 if(is.null(inFile)) dt1 <- read.table('datos1.txt', header=T, sep='\t') else dt1 <- read.csv(inFile$datapath, header=input$header, sep=input$sep) dt1 }) output$inputData2 <- renderTable({ inFile <- input$file2 if(is.null(inFile)) dt2 <- read.table('datos2.txt', header=T, sep='\t') else dt2 <- read.csv(inFile$datapath, header=input$header, sep=input$sep) dt2 }) output$consolidado <- renderTable({ inFile <- input$file1 if(is.null(inFile)) dt1 <- read.table('datos1.txt', header=T, sep='\t') else dt1 <- read.csv(inFile$datapath, header=input$header, sep=input$sep) inFile <- input$file2 if(is.null(inFile)) dt2 <- read.table('datos2.txt', header=T, sep='\t') else dt2 <- read.csv(inFile$datapath, header=input$header, sep=input$sep) y1 <- na.omit(dt1[, input$variable]) # Para sacar los NA de la variable y2 <- na.omit(dt2[, input$variable]) tabla1 <- table(y1) tabla2 <- table(y2) x1 <- tabla1[input$niveles] x2 <- tabla2[input$niveles] n1 <- sum(tabla1) n2 <- sum(tabla2) res <- cbind(c(x1, x2), c(n1, n2), c(x1, x2)/c(n1, n2)) colnames(res) <- c('Número de éxitos', 'Número de casos', 'Proporción observada') rownames(res) <- c('Base de datos # 1', 'Base de datos # 2') res }, align='c', rownames=TRUE, bordered=TRUE, digits=4) output$appPlot <- renderPlot({ inFile <- input$file1 if(is.null(inFile)) dt1 <- read.table('datos1.txt', header=T, sep='\t') else dt1 <- read.csv(inFile$datapath, header=input$header, sep=input$sep) inFile <- input$file2 if(is.null(inFile)) dt2 <- read.table('datos2.txt', header=T, sep='\t') else dt2 <- read.csv(inFile$datapath, header=input$header, sep=input$sep) # Creando la particion par(mfrow=c(1, 2)) # Primer barplot Niveles <- na.omit(dt1[, 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), main='Base de datos # 1') text(x=xx, y=ptabla, pos=3, cex=0.8, col="black", label=round(ptabla, 4)) # Segundo barplot Niveles <- na.omit(dt2[, 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), main='Base de datos # 2') text(x=xx, y=ptabla, pos=3, cex=0.8, col="black", label=round(ptabla, 4)) }) output$resul1 <- renderText({ inFile <- input$file1 if(is.null(inFile)) dt1 <- read.table('datos1.txt', header=T, sep='\t') else dt1 <- read.csv(inFile$datapath, header=input$header, sep=input$sep) inFile <- input$file2 if(is.null(inFile)) dt2 <- read.table('datos2.txt', header=T, sep='\t') else dt2 <- read.csv(inFile$datapath, header=input$header, sep=input$sep) y1 <- na.omit(dt1[, input$variable]) # Para sacar los NA de la variable y2 <- na.omit(dt2[, input$variable]) tabla1 <- table(y1) tabla2 <- table(y2) x1 <- tabla1[input$niveles] x2 <- tabla2[input$niveles] n1 <- sum(tabla1) n2 <- sum(tabla2) ph <- prop.test(x=c(x1, x2), n=c(n1, n2), alternative=input$h0, conf.level=input$alfa, correct=input$correct) ph$statistic <- sign(ph$estimate[1] - ph$estimate[2]) * 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)) dt1 <- read.table('datos1.txt', header=T, sep='\t') else dt1 <- read.csv(inFile$datapath, header=input$header, sep=input$sep) inFile <- input$file2 if(is.null(inFile)) dt2 <- read.table('datos2.txt', header=T, sep='\t') else dt2 <- read.csv(inFile$datapath, header=input$header, sep=input$sep) y1 <- na.omit(dt1[, input$variable]) # Para sacar los NA de la variable y2 <- na.omit(dt2[, input$variable]) tabla1 <- table(y1) tabla2 <- table(y2) x1 <- tabla1[input$niveles] x2 <- tabla2[input$niveles] n1 <- sum(tabla1) n2 <- sum(tabla2) ph <- prop.test(x=c(x1, x2), n=c(n1, n2), alternative=input$h0, conf.level=input$alfa, 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 diferencia de proporciones P1 - P2"), windowTitle="PH proporción"), sidebarPanel( h5(HTML('Esta aplicación realiza la prueba de hipótesis para la diferencia de proporciones. La hipótesis nula considerada es H0: P1 - P2=0')), h6('La aplicación usa dos bases de datos de ejemplo pero el usuario puede cargar su propia información. Las bases de datos que ingrese deben tener los mismos nombres de variables.'), fileInput(inputId='file1', label='Use el siguiente botón para cargar su base de datos # 1.', accept = c( 'text/csv', 'text/comma-separated-values', 'text/tab-separated-values', 'text/plain', '.csv', '.tsv' )), fileInput(inputId='file2', label='Use el siguiente botón para cargar su base de datos # 2.', 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 = ';'), hr(), selectInput(inputId="variable", label=p("Elija una variable", span("cualitativa", style = "color:red"), "de las bases 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"), 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"), h4("- Tabla resumen de las bases:"), 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("Base datos # 1", "A continuación los datos que está usando la aplicación.", uiOutput('inputData1')), tabPanel("Base datos # 2", "A continuación los datos que está usando la aplicación.", uiOutput('inputData2')), tabPanel("Teoría", includeHTML("include.html")) ) ) ))

Prueba de hipótesis para la diferencia de proporciones P₁ - P₂

Esta aplicación realiza la prueba de hipótesis para la diferencia de proporciones. La hipótesis nula considerada es H₀: P₁ - P₂=0

La aplicación usa dos bases de datos de ejemplo pero el usuario puede cargar su propia información. Las bases de datos que ingrese deben tener los mismos nombres de variables.

- Diagrama de barras para la variable seleccionada.

- Tabla resumen de las bases:

- Resultados de la prueba de hipótesis:

- Intervalo de confianza para la proporción P:

Prueba de hipótesis para la diferencia de proporciones