Puntualidad Municipal
Julio Sergio Santana
7 de noviembre de 2016
PROBLEMA - Premio a la puntualidad municipal
Un estado del país tiene registros de los porcentajes de contratantes que pagan a tiempo su servicio de agua durante 100 períodos para 3 municipios diferentes. Dichos datos muestran más o menos distribuciones normales. El gobernador quiere premiar al municipio “mejor portado” ampliándole los recursos para la red de agua potable. El criterio será premiar al municipio para el que se obtenga la mayor probabilidad de que al menos el 76% de los nuevos contratos paguen a tiempo su servicio.
Lectura de la información
La información se encuentra en el archivo “PuntualidadPagosDOS.txt”, en el directorio de trabajo.
setwd("E:/CLASE/CURSO_SMN")
# Se lee la tabla de datos
tt <- read.table("PuntualidadPagosDOS.txt", header=T)
head(tt, 10) # se muestran sólo los primeros 10 renglones## periodo Municipio1 Municipio2 Municipio3
## 1 1 49.14275 50.87417 81.56590
## 2 2 55.00983 61.73742 72.19118
## 3 3 53.08033 61.36636 70.83688
## 4 4 59.32611 83.28603 70.80582
## 5 5 62.37337 56.79240 65.54689
## 6 6 71.95244 25.60914 68.95877
## 7 7 57.74995 37.89399 68.44648
## 8 8 40.33661 56.68145 65.25528
## 9 9 41.86532 27.88912 74.24329
## 10 10 47.14653 46.82477 69.56836Medias y desviaciones estándar por municipio
Se calcularán ahora las medias y las desviaciones estándar para cada municipio. Esto es, para cada columna de la tabla anterior.
medias <- apply(tt[-1], 2, mean) # tt[-1], elimina 1a. col. de la tabla
desviaciones <- apply(tt[-1], 2, sd)
medias## Municipio1 Municipio2 Municipio3
## 61.12801 55.29445 69.85308desviaciones## Municipio1 Municipio2 Municipio3
## 11.97565 14.84485 4.72782Gráfica de las funciones de densidad
La graficación de funciones requiere que éstas sean de un solo argumento; por consiguiente debe construirse una función de un solo argumento para cada pareja de media y desviación estándar:
f1 <- function(x) dnorm(x, medias[1], desviaciones[1])
f2 <- function(x) dnorm(x, medias[2], desviaciones[2])
f3 <- function(x) dnorm(x, medias[3], desviaciones[3])El intervalo de graficado para las x será desde cero hasta su límite mayor, que será el máximo de cada media más 3 veces su correspondiente desviación estándar:
limmayX <- max(medias+3*desviaciones)
limsX <- c(0, limmayX)Para las y, el máximo de cada curva (función) está en la x correspondiente a su media.
limmayY <- max(f1(medias[1]), f2(medias[2]), f3(medias[3]))
limsY <- c(0, limmayY)Se dibujan ahora las tres curvas:
plot(f1, xlim=limsX, ylim=limsY, lwd=2,)
curve(f2, lwd=2, col="blue", add=T)
curve(f3, lwd=2, col="red", add=T)
# se agregan líneas de guía en valores relacionados con
# el problema:
# La línea vertical en x=76%
abline(v=76)
# y una horizontal en cero
abline(h=0)
Significado de las áreas bajo la una curva
Para aclarar el significado de las áreas bajo la curva
# Dibujaremos sólo una de las curvas:
plot(f1, xlim = limsX, lwd=2)
# El área a la izquierda de x=76%
misx <- seq(0,76,length.out = 100)
# La función para esas x
misy <- f1(misx)
# Ampliamos los vértices
misx <- c(misx, 76)
misy <- c(misy, 0)
polygon(misx, misy, density = 30, border = "red", col="red")
# Ahora el área complementaria:
misx <- seq(76, 100, length.out = 50)
misy <- f1(misx)
# ampliamos
misx <- c(76, misx, 100)
misy <- c(0, misy, 0)
polygon(misx, misy, density = 30, angle=-45, border = "black", col="black")
En este gráfico, el área roja es P(X <= 76%), la probabilidad de que el 76% o menos de los contribuyentes cumplan a tiempo con su pago; mientras que el área gris es su complemento P(X > 76%), la probabilidad de que el 76% o más de los contribuyentes cumplan con su pago, que es el área de comparación que se busca realmente, y su valor es:
P(X > 76%) = 1 - P(X <= 76%)
De los gráficos combinados anteriores, es difícil comparar las áreas directamente. Por ello se tiene que recurrir a las funciones de distribución acumuladas.
Gráfica de las funciones de distribución acumulada
Se hace un procedimiento semejante al que se ha hecho con las gráficas de densidad; se construyen las funciones acumulativas de un solo argumento:
ff1 <- function(x) pnorm(x, medias[1], desviaciones[1])
ff2 <- function(x) pnorm(x, medias[2], desviaciones[2])
ff3 <- function(x) pnorm(x, medias[3], desviaciones[3])y en seguida se procede a graficarlas
plot(ff1, xlim=limsX, lwd=2)
curve(ff2, lwd=2, col="blue", add=T)
curve(ff3, lwd=2, col="red", add=T)
abline(v=76)
y las probabilidades buscadas son como sigue:
1 - ff1(76)## [1] 0.10714561 - ff2(76)## [1] 0.081538581 - ff3(76)## [1] 0.09677316De donde se concluye que el municipio para el que se tiene la mayor probabilidad (10.71%) de que al menos 76% de los contribuyentes cumplan con su pago puntualmente es el Municipio1.