Intervalos de predicción para datos asimétricos.

Cuando los datos son asimétricos con sesgo positivo el intervalo de predicción que se utiliza es: (Más detalles en pág. 81 de libro).

Ejemplo.

Considere el problema visto en clase del arsénico.

Si se toma una muestra más de agua, ¿cuál será su concentración de arsénico?

Los datos del arsénico son asimétricos con sesgo positivo. Como puede ver:

a <- c(1.3,8,1.5,9.5,100,580,110,1.8, 2.6, 2.8, 3.5,12, 14, 19, 23,120, 190, 240, 250,4.0,41,300,4.8,80,340)
hist(a, col = '#F5D0A9', xlab = 'Concentración', main = 'Concentracion de Arsérnico')

En R, el intervalo se puede calcular así:

# Tamaño de la muestra
n <- length(a)

# 1. Transformar a logaritmo
y=log(a)

# 2. Mediana de los Logaritmos
m <- mean(y)

# 3. Desviacion Estándar de los logaritmos
s <- sd(y)

# 4. Valor de Distribución t al 95%, recuerde que el tamaño de la muestra es 25 y en la formula dice n-1 
t <- abs(qt(0.025,n-1))

# Finalmente los límites de los intervalos
li <- exp(m-t*sqrt(s^2+s^2/n))
ls <- exp(m+t*sqrt(s^2+s^2/n))
li
[1] 0.386043
ls
[1] 1476.073

Finalmente podremos decir que la concentración de arsénico se encontrará entre 0.39 ppb y 1476.1 ppb.


Ejercicios

  1. The following 43 values are annual 7-day minimum flows for 1941−1983 on the Little Mahoning Creek at McCormick, PA.
flujos <- c(0.69,2.90,4.40,0.80,3.00,4.80,9.70, 9.80,1.30,3.10,4.90,10.00,1.40,3.30,5.70,11.00,1.50, 1.50, 1.80, 1.80, 2.10, 2.50,3.70 ,3.80, 3.80, 4.00, 4.10, 4.20,5.80, 5.90, 6.00, 6.10, 7.90, 8.00,11.00 ,12.00, 13.00, 16.00, 20.00, 23.00,2.8,4.2,8)
# Histograma
hist(flujos, col = '#819FF7', xlab = 'Flujos', main = 'Flujos Mínimos Anuales')

Construya e interprete el intervalo de predicción de una nueva observación al 90% de confianza.

  • Los datos son Asimétricos con sesgo positivo por lo que se procede al cálculo del intervalo con R.
# Tamaño de la muestra
fn <- length(flujos)

# Transformar a logaritmo
flog <- log(flujos)

# Media de los logaritmos
fm <- mean(flog)

# Ahora desviacion estádar
fs <- sd(flog)

# Valor de distribucion t, n = 43, Intervalo de Confianza = 90%
ft <- abs(qt(0.05,fn-1))

# Limites
fli <- exp(fm-ft*sqrt(fs^2+fs^2/fn))
fli
[1] 1.088402
fls <- exp(fm+ft*sqrt(fs^2+fs^2/fn))
fls
[1] 18.16335

Conclusión Ejercicio 1: Con un 90% de Confianza, se puede predecir que los siguientes flujos mínimos anuales tendrán un valor de entre 1.1 hasta 18.


  1. Las autoridades sanitarias de un municipio evaluaron la calidad del agua para consumo en términos de colonias de bacterias tróficas en un acuífero próximo a una ciudad (número de colonias por 1000 mm de agua):
x <- c(194, 199, 121, 102, 215, 214, 197,
204, 139, 102, 230, 123, 194, 109,
158, 161, 123, 174, 110, 156, 156,
156, 158, 161, 188, 139, 147, 116,110,155,130,120,100,125)
hist(x, col = '#ADC688', xlab = 'No. Colonias', main = 'Bacterias Tróficas en el Agua')

¿Cuál será el número de colonias que tendrá una nueva muestra de agua? Use 99% de confianza.

  • Los datos son asimétricos, se puede continuar con los cálculos en R.
# Tamaño de la muestra
xn <- length(x)

#Transformar a Log
xlog <- log(x)

# Media del logaritmo
xm <- mean(xlog)

# Desviación Estándar
xs <- sd(xlog)

# Valor de distribucion t, con 99% de confianza
xt <- abs(qt(0.005,xn-1))

# Finalmente los límites de los intervalos
xli <- exp(xm-xt*sqrt(xs^2+(xs^2)/xn))
xls <- exp(xm+xt*sqrt(xs^2+xs^2/xn))
xli
[1] 75.2325
xls
[1] 291.8401

Conclusión Ejercicio 2: Con una confianza del 99%, se puede predecir que en la siguiente muestra de agua el número de colonias que tendrá la muestra se encuentran entre 75 y 292 colonias de bacterias tróficas.

………. Melanie Icedo Félix ……….

LS0tDQp0aXRsZTogIkFzaWduYWNpw7NuIDQgLSBtacOpcmNvbGVzIDI5LzA0LzIwMjAgLU1lbGFuaWUgSWNlZG8gRsOpbGl4Ig0Kb3V0cHV0OiBodG1sX25vdGVib29rDQotLS0NCg0KIyBJbnRlcnZhbG9zIGRlIHByZWRpY2Npw7NuIHBhcmEgZGF0b3MgYXNpbcOpdHJpY29zLg0KDQpDdWFuZG8gbG9zIGRhdG9zIHNvbiBhc2ltw6l0cmljb3MgY29uIHNlc2dvIHBvc2l0aXZvIGVsIGludGVydmFsbyBkZSBwcmVkaWNjacOzbiBxdWUgc2UgdXRpbGl6YSBlczogKE3DoXMgZGV0YWxsZXMgZW4gcMOhZy4gODEgZGUgbGlicm8pLg0KDQohW10oUElfRGF0b3MtQXNpbWV0cmljb3Mtc2VzZ28tcG9zaXRpdm8ucG5nKQ0KDQojIyBFamVtcGxvLiANCkNvbnNpZGVyZSBlbCBwcm9ibGVtYSB2aXN0byBlbiBjbGFzZSBkZWwgYXJzw6luaWNvLg0KDQoqU2kgc2UgdG9tYSB1bmEgbXVlc3RyYSBtw6FzIGRlIGFndWEsKiAqKsK/Y3XDoWwgc2Vyw6Egc3UgY29uY2VudHJhY2nDs24gZGUgYXJzw6luaWNvPyoqDQoNCkxvcyBkYXRvcyBkZWwgYXJzw6luaWNvIHNvbiBhc2ltw6l0cmljb3MgY29uIHNlc2dvIHBvc2l0aXZvLiBDb21vIHB1ZWRlIHZlcjoNCg0KYGBge3IgRGF0b3MgQXJzZXJuaWNvfQ0KYSA8LSBjKDEuMyw4LDEuNSw5LjUsMTAwLDU4MCwxMTAsMS44LCAyLjYsIDIuOCwgMy41LDEyLCAxNCwgMTksIDIzLDEyMCwgMTkwLCAyNDAsIDI1MCw0LjAsNDEsMzAwLDQuOCw4MCwzNDApDQpoaXN0KGEsIGNvbCA9ICcjRjVEMEE5JywgeGxhYiA9ICdDb25jZW50cmFjacOzbicsIG1haW4gPSAnQ29uY2VudHJhY2lvbiBkZSBBcnPDqXJuaWNvJykNCmBgYA0KDQpFbiBSLCBlbCBpbnRlcnZhbG8gc2UgcHVlZGUgY2FsY3VsYXIgYXPDrToNCg0KYGBge3IgRWplbXBsbyBQSSBBcnNlcm5pY299DQojIDAuIFRhbWHDsW8gZGUgbGEgbXVlc3RyYQ0KbiA8LSBsZW5ndGgoYSkNCg0KIyAxLiBUcmFuc2Zvcm1hciBhIGxvZ2FyaXRtbw0KeT1sb2coYSkNCg0KIyAyLiBNZWRpYW5hIGRlIGxvcyBMb2dhcml0bW9zDQptIDwtIG1lYW4oeSkNCg0KIyAzLiBEZXN2aWFjaW9uIEVzdMOhbmRhciBkZSBsb3MgbG9nYXJpdG1vcw0KcyA8LSBzZCh5KQ0KDQojIDQuIFZhbG9yIGRlIERpc3RyaWJ1Y2nDs24gdCBhbCA5NSUsIHJlY3VlcmRlIHF1ZSBlbCB0YW1hw7FvIGRlIGxhIG11ZXN0cmEgZXMgMjUgeSBlbiBsYSBmb3JtdWxhIGRpY2Ugbi0xIA0KdCA8LSBhYnMocXQoMC4wMjUsbi0xKSkNCg0KIyBGaW5hbG1lbnRlIGxvcyBsw61taXRlcyBkZSBsb3MgaW50ZXJ2YWxvcw0KbGkgPC0gZXhwKG0tdCpzcXJ0KHNeMitzXjIvbikpDQpscyA8LSBleHAobSt0KnNxcnQoc14yK3NeMi9uKSkNCmxpDQpscw0KYGBgDQoNCkZpbmFsbWVudGUgcG9kcmVtb3MgZGVjaXIgcXVlIGxhIGNvbmNlbnRyYWNpw7NuIGRlIGFyc8OpbmljbyBzZSBlbmNvbnRyYXLDoSBlbnRyZSAwLjM5IHBwYiB5IDE0NzYuMSBwcGIuDQoNCi0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLQ0KDQojIyBFamVyY2ljaW9zDQoNCjEuIFRoZSBmb2xsb3dpbmcgNDMgdmFsdWVzIGFyZSBhbm51YWwgNy1kYXkgbWluaW11bSBmbG93cyBmb3IgMTk0MeKIkjE5ODMgb24gdGhlIExpdHRsZSBNYWhvbmluZyBDcmVlayBhdCBNY0Nvcm1pY2ssIFBBLg0KDQpgYGB7ciBEYXRvcyBmbHVqb3N9DQpmbHVqb3MgPC0gYygwLjY5LDIuOTAsNC40MCwwLjgwLDMuMDAsNC44MCw5LjcwLCA5LjgwLDEuMzAsMy4xMCw0LjkwLDEwLjAwLDEuNDAsMy4zMCw1LjcwLDExLjAwLDEuNTAsIDEuNTAsIDEuODAsIDEuODAsIDIuMTAsIDIuNTAsMy43MCAsMy44MCwgMy44MCwgNC4wMCwgNC4xMCwgNC4yMCw1LjgwLCA1LjkwLCA2LjAwLCA2LjEwLCA3LjkwLCA4LjAwLDExLjAwICwxMi4wMCwgMTMuMDAsIDE2LjAwLCAyMC4wMCwgMjMuMDAsMi44LDQuMiw4KQ0KIyBIaXN0b2dyYW1hDQpoaXN0KGZsdWpvcywgY29sID0gJyM4MTlGRjcnLCB4bGFiID0gJ0ZsdWpvcycsIG1haW4gPSAnRmx1am9zIE3DrW5pbW9zIEFudWFsZXMnKQ0KYGBgDQoNCkNvbnN0cnV5YSBlIGludGVycHJldGUgZWwgaW50ZXJ2YWxvIGRlIHByZWRpY2Npw7NuIGRlIHVuYSBudWV2YSBvYnNlcnZhY2nDs24gYWwgOTAlIGRlIGNvbmZpYW56YS4NCg0KLSBMb3MgZGF0b3Mgc29uIEFzaW3DqXRyaWNvcyBjb24gc2VzZ28gcG9zaXRpdm8gcG9yIGxvIHF1ZSBzZSBwcm9jZWRlIGFsIGPDoWxjdWxvIGRlbCBpbnRlcnZhbG8gY29uIFIuDQpgYGB7ciBDYWxjdWxvIGludGVydmFsbyBmbHVqb3N9DQojIFRhbWHDsW8gZGUgbGEgbXVlc3RyYQ0KZm4gPC0gbGVuZ3RoKGZsdWpvcykNCg0KIyBUcmFuc2Zvcm1hciBhIGxvZ2FyaXRtbw0KZmxvZyA8LSBsb2coZmx1am9zKQ0KDQojIE1lZGlhIGRlIGxvcyBsb2dhcml0bW9zDQpmbSA8LSBtZWFuKGZsb2cpDQoNCiMgQWhvcmEgZGVzdmlhY2lvbiBlc3TDoWRhcg0KZnMgPC0gc2QoZmxvZykNCg0KIyBWYWxvciBkZSBkaXN0cmlidWNpb24gdCwgbiA9IDQzLCBJbnRlcnZhbG8gZGUgQ29uZmlhbnphID0gOTAlDQpmdCA8LSBhYnMocXQoMC4wNSxmbi0xKSkNCg0KIyBMaW1pdGVzDQpmbGkgPC0gZXhwKGZtLWZ0KnNxcnQoZnNeMitmc14yL2ZuKSkNCmZsaQ0KZmxzIDwtIGV4cChmbStmdCpzcXJ0KGZzXjIrZnNeMi9mbikpDQpmbHMNCmBgYA0KDQoqKkNvbmNsdXNpw7NuIEVqZXJjaWNpbyAxOioqIENvbiB1biA5MCUgZGUgQ29uZmlhbnphLCBzZSBwdWVkZSBwcmVkZWNpciBxdWUgbG9zIHNpZ3VpZW50ZXMgZmx1am9zIG3DrW5pbW9zIGFudWFsZXMgdGVuZHLDoW4gdW4gdmFsb3IgZGUgZW50cmUgMS4xIGhhc3RhIDE4Lg0KDQoNCi0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLQ0KDQoyLiBMYXMgYXV0b3JpZGFkZXMgc2FuaXRhcmlhcyBkZSB1biBtdW5pY2lwaW8gZXZhbHVhcm9uIGxhIGNhbGlkYWQgZGVsIGFndWEgcGFyYSBjb25zdW1vIGVuIHTDqXJtaW5vcyBkZSBjb2xvbmlhcyBkZSBiYWN0ZXJpYXMgdHLDs++sgWNhcyBlbiB1biBhY3XDrWZlcm8gcHLDs3hpbW8gYSB1bmEgY2l1ZGFkIChuw7ptZXJvIGRlIGNvbG9uaWFzIHBvciAxMDAwIG1tIGRlIGFndWEpOg0KDQpgYGB7ciBEYXRvcyBCYWN0ZXJpYXN9DQp4IDwtIGMoMTk0LCAxOTksIDEyMSwgMTAyLCAyMTUsIDIxNCwgMTk3LA0KMjA0LCAxMzksIDEwMiwgMjMwLCAxMjMsIDE5NCwgMTA5LA0KMTU4LCAxNjEsIDEyMywgMTc0LCAxMTAsIDE1NiwgMTU2LA0KMTU2LCAxNTgsIDE2MSwgMTg4LCAxMzksIDE0NywgMTE2LDExMCwxNTUsMTMwLDEyMCwxMDAsMTI1KQ0KaGlzdCh4LCBjb2wgPSAnI0FEQzY4OCcsIHhsYWIgPSAnTm8uIENvbG9uaWFzJywgbWFpbiA9ICdCYWN0ZXJpYXMgVHLDs2ZpY2FzIGVuIGVsIEFndWEnKQ0KYGBgDQoqKsK/Q3XDoWwgc2Vyw6EgZWwgbsO6bWVybyBkZSBjb2xvbmlhcyBxdWUgdGVuZHLDoSB1bmEgbnVldmEgbXVlc3RyYSBkZSBhZ3VhPyoqIFVzZSA5OSUgZGUgY29uZmlhbnphLg0KDQotIExvcyBkYXRvcyBzb24gYXNpbcOpdHJpY29zLCBzZSBwdWVkZSBjb250aW51YXIgY29uIGxvcyBjw6FsY3Vsb3MgZW4gUi4NCg0KYGBge3IgaW50ZXJ2YWxvIGRlIHByZWRpY2Npb24gYmFjdGVyaWFzfQ0KIyBUYW1hw7FvIGRlIGxhIG11ZXN0cmENCnhuIDwtIGxlbmd0aCh4KQ0KDQojVHJhbnNmb3JtYXIgYSBMb2cNCnhsb2cgPC0gbG9nKHgpDQoNCiMgTWVkaWEgZGVsIGxvZ2FyaXRtbw0KeG0gPC0gbWVhbih4bG9nKQ0KDQojIERlc3ZpYWNpw7NuIEVzdMOhbmRhcg0KeHMgPC0gc2QoeGxvZykNCg0KIyBWYWxvciBkZSBkaXN0cmlidWNpb24gdCwgY29uIDk5JSBkZSBjb25maWFuemENCnh0IDwtIGFicyhxdCgwLjAwNSx4bi0xKSkNCg0KIyBGaW5hbG1lbnRlIGxvcyBsw61taXRlcyBkZSBsb3MgaW50ZXJ2YWxvcw0KeGxpIDwtIGV4cCh4bS14dCpzcXJ0KHhzXjIreHNeMi94bikpDQp4bHMgPC0gZXhwKHhtK3h0KnNxcnQoeHNeMit4c14yL3huKSkNCnhsaQ0KeGxzDQpgYGANCg0KKipDb25jbHVzacOzbiBFamVyY2ljaW8gMjoqKiBDb24gdW5hIGNvbmZpYW56YSBkZWwgOTklLCBzZSBwdWVkZSBwcmVkZWNpciBxdWUgZW4gbGEgc2lndWllbnRlIG11ZXN0cmEgZGUgYWd1YSBlbCBuw7ptZXJvIGRlIGNvbG9uaWFzIHF1ZSB0ZW5kcsOhIGxhIG11ZXN0cmEgc2UgZW5jdWVudHJhbiBlbnRyZSA3NSB5IDI5MiBjb2xvbmlhcyBkZSBiYWN0ZXJpYXMgdHLDs++sgWNhcy4NCg0KDQoNCg0KDQoNCg0KLi4uLi4uLi4uLiBNZWxhbmllIEljZWRvIEbDqWxpeCAuLi4uLi4uLi4u