Tema 4. T de Student

#Prueba de hipotesis t de student 


#Ejercicio 
pagos <- c(107,92,97,95,105,101,91,99,95,104)

t.test(pagos,y=NULL,alternative="two.sided",mu=100,paired=FALSE,var.equal=FALSE,conf.level=0.90)
## 
##  One Sample t-test
## 
## data:  pagos
## t = -0.79888, df = 9, p-value = 0.4449
## alternative hypothesis: true mean is not equal to 100
## 90 percent confidence interval:
##   95.38755 101.81245
## sample estimates:
## mean of x 
##      98.6
#Si es de cola, alternative puede ser ¡: "less" o "greater"

#Si p value es mayor a 0.10 (por significancia del 10%) no se rechaza HO

# Conclusión: No se rechaza HO

#Intervalo de confianza: Entre 95 y 101 dolres. 

#8-70
#Drive-a-Lemon, renta automóviles en buenas condiciones mecánicas, pero más antiguos que
#aquellos que rentan las grandes cadenas nacionales de renta de coches. Como resultado, anuncia
#que sus tarifas son considerablemente más bajas que las de sus grandes competidores. Una
#encuesta en la industria estableció que el cargo total promedio por renta en una de las mayores
#compañías es de $77.38 dólares. Una muestra aleatoria de 18 transacciones realizadas por Drive-a-
#Lemon mostró un cargo total promedio de $87.61, con una desviación estándar de la muestra de
#$19.48. Verifique que, con un nivel de significancia de 0.025, el cargo total promedio de Drive-a-
#Lemon es más alto que el de las grandes compañías. ¿Indica este resultado que las tarifas de Drive-
#a-Lemon, no son más bajas que las de las grandes cadenas nacionales? Justifique su respuesta.

#Respuesta 
#Paso 1. Plantear Hipotesis 
# HO: μ = x bar
# H1: μ > x bar 


#Paso 2 Nivel de significancia y grados de libertad 
# α = 0.25
#GL = 17 

#Paso 3. Zona de aceptación/Rechazo 
# t de tablas = 2.110

#Paso 4. Función 
t <- (87.61-77.38)/(19.48/sqrt(18))
t
## [1] 2.22804
#Paso 5. Conclusión 
# Se rechaza HO

#t = 2.228 (xbar =)

Tema 5. ANOVA

#install.packages("stats")
library(stats)

#Ejercicio 1

resistencia <- read.csv("/Users/jorgemoctezuma/Desktop/Resistencia (1).csv")
resistencia$Caja <- as.factor(resistencia$Caja)
qf(.95,df1=3,df2=20)
## [1] 3.098391
anova1<- aov( Resistencia ~ Caja,data = resistencia)
summary(anova1)
##             Df Sum Sq Mean Sq F value   Pr(>F)    
## Caja         3 127375   42458   25.09 5.53e-07 ***
## Residuals   20  33839    1692                     
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#Ejercicio 2

manchado <- read.csv("/Users/jorgemoctezuma/Desktop/mezcla.csv")
manchado$Mezcla <- as.factor(manchado$Mezcla)
qf(.99,df1=2,df2=12)
## [1] 6.926608
anova2<- aov( Manchado ~ Mezcla,data = manchado)
summary(anova2)
##             Df Sum Sq Mean Sq F value Pr(>F)
## Mezcla       2 0.0609 0.03043   0.987  0.401
## Residuals   12 0.3701 0.03084

Tema 6. Regresion Lineal Simple

#Regresion lineal Simple

#Ejercicio 1
x<- c(0.2,0.5,1,2,3)
y<- c(8,10,18,35,60)
regresion<- lm(y~x)
summary(regresion)
## 
## Call:
## lm(formula = y ~ x)
## 
## Residuals:
##       1       2       3       4       5 
##  3.0591 -0.5354 -1.8596 -3.5079  2.8437 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)   
## (Intercept)    1.211      2.451   0.494  0.65510   
## x             18.648      1.450  12.863  0.00101 **
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 3.341 on 3 degrees of freedom
## Multiple R-squared:  0.9822, Adjusted R-squared:  0.9763 
## F-statistic: 165.5 on 1 and 3 DF,  p-value: 0.001014
plot(x,y,pch=16, cex= 1.3, col= "blue",main = "Ejercio 1 ")
abline (lm (y~x))

plot(regresion)

#Ejercicio 2
a <- c(-6,-3,0,3,6,9,12,15,20,25)
b <- c(2,2.8,3.9,4.2,5.8,6.2,7.5,8.2,9.3,10.9)
regresion2<- lm(a~b)
summary(regresion2)
## 
## Call:
## lm(formula = a ~ b)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -1.13408 -0.53806  0.09497  0.43261  1.38547 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -12.87430    0.64642  -19.92 4.21e-08 ***
## b             3.44972    0.09684   35.62 4.22e-10 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.8437 on 8 degrees of freedom
## Multiple R-squared:  0.9937, Adjusted R-squared:  0.993 
## F-statistic:  1269 on 1 and 8 DF,  p-value: 4.223e-10
plot(a,b,pch=16, cex= 1.3, col= "blue",main = "Ejercio 2 ")
abline (lm (a~b))

plot(regresion)

Ejercicio Del Mundo Real

11-26

En un estudio se compararon los efectos de cuatro promociones mensuales sobre las ventas. A continuación, presentamos las ventas unitarias de 5 tiendas que utilizaron las 4 promociones en meses diferentes:
Tipo de promoción Ventas tienda 1 Ventas tienda 2 Ventas tienda 3 Ventas tienda 4 Ventas tienda 5
Muestra gratis 78 87 81 89 85
Producto extra 94 91 87 90 88
Descuento 73 78 69 83 76
Reembolso 79 83 78 69 81
Al nivel de significancia de 0.01 ¿las promociones producen diferentes efectos sobre las ventas?
promocion <- read.csv("/Users/jorgemoctezuma/Desktop/promo.csv")
promocion$Promocion <- as.factor(promocion$Promocion)
promocion$Tienda <- as.factor(promocion$Tienda)
qf(.99,df1 = 3,df2 = 16)
## [1] 5.292214
anova3 <- aov(Venta ~ Promocion + Tienda, data = promocion)
summary(anova3)
##             Df Sum Sq Mean Sq F value Pr(>F)   
## Promocion    3  612.1  204.05   9.524 0.0017 **
## Tienda       4   79.7   19.93   0.930 0.4788   
## Residuals   12  257.1   21.43                  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

12-64

Un arrendador está interesado en ver si las rentas de sus departamentos son las comunes. Para esto tomó una muestra aleatoria de 11 rentas y tamaños de departamentos en complejos de departamentos similares. Los datos son los siguientes: | Renta | Número de recamaras | 230 | 2 190 | 1 450 | 3 310 | 2 218 | 2 185 | 2 340 | 2 245 | 1 125 | 1 350 | 2 280 | 2

  1. Desarrolle la ecuación de estimación que mejor describa estos datos.
  2. Calcule el coeficiente de determinación.
  3. Pronostique la renta para un departamento de dos recámaras
renta <- c(230,190,450,310,218,185,340,245,125,350,280)
recamaras <- c(2,1,3,2,2,2,2,1,1,2,2)

regresion3 <- lm(renta ~ recamaras)
summary(regresion3)
## 
## Call:
## lm(formula = renta ~ recamaras)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -101.80  -51.35   19.10   50.25   74.10 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)   
## (Intercept)    55.00      63.19   0.870  0.40667   
## recamaras     115.90      33.13   3.498  0.00675 **
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 63.19 on 9 degrees of freedom
## Multiple R-squared:  0.5762, Adjusted R-squared:  0.5291 
## F-statistic: 12.23 on 1 and 9 DF,  p-value: 0.006746
# Renta = 55.00 +115.90*Recamaras 

#b)
# r2 = 0.5762

#c)
recamaras1 <- 2
renta1 <- 55 + 115.90*recamaras1
renta1
## [1] 286.8
# $286.80
LS0tCnRpdGxlOiAiV29ya3Nob3AgMiIKYXV0aG9yOiAiSm9yZ2UgTW9jdGV6dW1hIFJvamFzIgpkYXRlOiAiMjAyMy0wNS0yNCIKb3V0cHV0OiAKICBodG1sX2RvY3VtZW50OgogICAgdG9jOiBUUlVFCiAgICB0b2NfZmxvYXQ6IFRSVUUKICAgIGNvZGVfZG93bmxvYWQ6IFRSVUUKLS0tCgoKCiMgPHNwYW4gc3R5bGU9ImNvbG9yOiBMaWdodGdyZWVuOyI+VGVtYSA0LiBUIGRlIFN0dWRlbnQ8L3NwYW4+CiFbXSgvVXNlcnMvam9yZ2Vtb2N0ZXp1bWEvRGVza3RvcC9ucDhTYWIuZ2lmKQpgYGB7cn0KI1BydWViYSBkZSBoaXBvdGVzaXMgdCBkZSBzdHVkZW50IAoKCiNFamVyY2ljaW8gCnBhZ29zIDwtIGMoMTA3LDkyLDk3LDk1LDEwNSwxMDEsOTEsOTksOTUsMTA0KQoKdC50ZXN0KHBhZ29zLHk9TlVMTCxhbHRlcm5hdGl2ZT0idHdvLnNpZGVkIixtdT0xMDAscGFpcmVkPUZBTFNFLHZhci5lcXVhbD1GQUxTRSxjb25mLmxldmVsPTAuOTApCgojU2kgZXMgZGUgY29sYSwgYWx0ZXJuYXRpdmUgcHVlZGUgc2VyIMKhOiAibGVzcyIgbyAiZ3JlYXRlciIKCiNTaSBwIHZhbHVlIGVzIG1heW9yIGEgMC4xMCAocG9yIHNpZ25pZmljYW5jaWEgZGVsIDEwJSkgbm8gc2UgcmVjaGF6YSBITwoKIyBDb25jbHVzacOzbjogTm8gc2UgcmVjaGF6YSBITwoKI0ludGVydmFsbyBkZSBjb25maWFuemE6IEVudHJlIDk1IHkgMTAxIGRvbHJlcy4gCgojOC03MAojRHJpdmUtYS1MZW1vbiwgcmVudGEgYXV0b23Ds3ZpbGVzIGVuIGJ1ZW5hcyBjb25kaWNpb25lcyBtZWPDoW5pY2FzLCBwZXJvIG3DoXMgYW50aWd1b3MgcXVlCiNhcXVlbGxvcyBxdWUgcmVudGFuIGxhcyBncmFuZGVzIGNhZGVuYXMgbmFjaW9uYWxlcyBkZSByZW50YSBkZSBjb2NoZXMuIENvbW8gcmVzdWx0YWRvLCBhbnVuY2lhCiNxdWUgc3VzIHRhcmlmYXMgc29uIGNvbnNpZGVyYWJsZW1lbnRlIG3DoXMgYmFqYXMgcXVlIGxhcyBkZSBzdXMgZ3JhbmRlcyBjb21wZXRpZG9yZXMuIFVuYQojZW5jdWVzdGEgZW4gbGEgaW5kdXN0cmlhIGVzdGFibGVjacOzIHF1ZSBlbCBjYXJnbyB0b3RhbCBwcm9tZWRpbyBwb3IgcmVudGEgZW4gdW5hIGRlIGxhcyBtYXlvcmVzCiNjb21wYcOxw61hcyBlcyBkZSAkNzcuMzggZMOzbGFyZXMuIFVuYSBtdWVzdHJhIGFsZWF0b3JpYSBkZSAxOCB0cmFuc2FjY2lvbmVzIHJlYWxpemFkYXMgcG9yIERyaXZlLWEtCiNMZW1vbiBtb3N0csOzIHVuIGNhcmdvIHRvdGFsIHByb21lZGlvIGRlICQ4Ny42MSwgY29uIHVuYSBkZXN2aWFjacOzbiBlc3TDoW5kYXIgZGUgbGEgbXVlc3RyYSBkZQojJDE5LjQ4LiBWZXJpZmlxdWUgcXVlLCBjb24gdW4gbml2ZWwgZGUgc2lnbmlmaWNhbmNpYSBkZSAwLjAyNSwgZWwgY2FyZ28gdG90YWwgcHJvbWVkaW8gZGUgRHJpdmUtYS0KI0xlbW9uIGVzIG3DoXMgYWx0byBxdWUgZWwgZGUgbGFzIGdyYW5kZXMgY29tcGHDscOtYXMuIMK/SW5kaWNhIGVzdGUgcmVzdWx0YWRvIHF1ZSBsYXMgdGFyaWZhcyBkZSBEcml2ZS0KI2EtTGVtb24sIG5vIHNvbiBtw6FzIGJhamFzIHF1ZSBsYXMgZGUgbGFzIGdyYW5kZXMgY2FkZW5hcyBuYWNpb25hbGVzPyBKdXN0aWZpcXVlIHN1IHJlc3B1ZXN0YS4KCiNSZXNwdWVzdGEgCiNQYXNvIDEuIFBsYW50ZWFyIEhpcG90ZXNpcyAKIyBITzogzrwgPSB4IGJhcgojIEgxOiDOvCA+IHggYmFyIAoKCiNQYXNvIDIgTml2ZWwgZGUgc2lnbmlmaWNhbmNpYSB5IGdyYWRvcyBkZSBsaWJlcnRhZCAKIyDOsSA9IDAuMjUKI0dMID0gMTcgCgojUGFzbyAzLiBab25hIGRlIGFjZXB0YWNpw7NuL1JlY2hhem8gCiMgdCBkZSB0YWJsYXMgPSAyLjExMAoKI1Bhc28gNC4gRnVuY2nDs24gCnQgPC0gKDg3LjYxLTc3LjM4KS8oMTkuNDgvc3FydCgxOCkpCnQKCiNQYXNvIDUuIENvbmNsdXNpw7NuIAojIFNlIHJlY2hhemEgSE8KCiN0ID0gMi4yMjggKHhiYXIgPSkKCmBgYAoKCiMgPHNwYW4gc3R5bGU9ImNvbG9yOiBHb2xkOyI+VGVtYSA1LiBBTk9WQTwvc3Bhbj4KIVtdKC9Vc2Vycy9qb3JnZW1vY3RlenVtYS9EZXNrdG9wL2dpcGh5LmdpZikKYGBge3J9CiNpbnN0YWxsLnBhY2thZ2VzKCJzdGF0cyIpCmxpYnJhcnkoc3RhdHMpCgojRWplcmNpY2lvIDEKCnJlc2lzdGVuY2lhIDwtIHJlYWQuY3N2KCIvVXNlcnMvam9yZ2Vtb2N0ZXp1bWEvRGVza3RvcC9SZXNpc3RlbmNpYSAoMSkuY3N2IikKcmVzaXN0ZW5jaWEkQ2FqYSA8LSBhcy5mYWN0b3IocmVzaXN0ZW5jaWEkQ2FqYSkKcWYoLjk1LGRmMT0zLGRmMj0yMCkKYW5vdmExPC0gYW92KCBSZXNpc3RlbmNpYSB+IENhamEsZGF0YSA9IHJlc2lzdGVuY2lhKQpzdW1tYXJ5KGFub3ZhMSkKCgojRWplcmNpY2lvIDIKCm1hbmNoYWRvIDwtIHJlYWQuY3N2KCIvVXNlcnMvam9yZ2Vtb2N0ZXp1bWEvRGVza3RvcC9tZXpjbGEuY3N2IikKbWFuY2hhZG8kTWV6Y2xhIDwtIGFzLmZhY3RvcihtYW5jaGFkbyRNZXpjbGEpCnFmKC45OSxkZjE9MixkZjI9MTIpCmFub3ZhMjwtIGFvdiggTWFuY2hhZG8gfiBNZXpjbGEsZGF0YSA9IG1hbmNoYWRvKQpzdW1tYXJ5KGFub3ZhMikKCmBgYAoKCiMgPHNwYW4gc3R5bGU9ImNvbG9yOiBsaWdodGJsdWU7Ij5UZW1hIDYuIFJlZ3Jlc2lvbiBMaW5lYWwgU2ltcGxlPC9zcGFuPgohW10oL1VzZXJzL2pvcmdlbW9jdGV6dW1hL0Rlc2t0b3AvZ2lwaHktMi5naWYpCmBgYHtyfQojUmVncmVzaW9uIGxpbmVhbCBTaW1wbGUKCiNFamVyY2ljaW8gMQp4PC0gYygwLjIsMC41LDEsMiwzKQp5PC0gYyg4LDEwLDE4LDM1LDYwKQpyZWdyZXNpb248LSBsbSh5fngpCnN1bW1hcnkocmVncmVzaW9uKQpwbG90KHgseSxwY2g9MTYsIGNleD0gMS4zLCBjb2w9ICJibHVlIixtYWluID0gIkVqZXJjaW8gMSAiKQphYmxpbmUgKGxtICh5fngpKQpwbG90KHJlZ3Jlc2lvbikKCiNFamVyY2ljaW8gMgphIDwtIGMoLTYsLTMsMCwzLDYsOSwxMiwxNSwyMCwyNSkKYiA8LSBjKDIsMi44LDMuOSw0LjIsNS44LDYuMiw3LjUsOC4yLDkuMywxMC45KQpyZWdyZXNpb24yPC0gbG0oYX5iKQpzdW1tYXJ5KHJlZ3Jlc2lvbjIpCnBsb3QoYSxiLHBjaD0xNiwgY2V4PSAxLjMsIGNvbD0gImJsdWUiLG1haW4gPSAiRWplcmNpbyAyICIpCmFibGluZSAobG0gKGF+YikpCnBsb3QocmVncmVzaW9uKQoKYGBgCgojIDxzcGFuIHN0eWxlPSJjb2xvcjogcHVycGxlOyI+RWplcmNpY2lvIERlbCBNdW5kbyBSZWFsPC9zcGFuPgoKIVtdKC9Vc2Vycy9qb3JnZW1vY3RlenVtYS9EZXNrdG9wL2dpcGh5LTEuZ2lmKQoKCgojIyAxMS0yNgojIyMjIyBFbiB1biBlc3R1ZGlvIHNlIGNvbXBhcmFyb24gbG9zIGVmZWN0b3MgZGUgY3VhdHJvIHByb21vY2lvbmVzIG1lbnN1YWxlcyBzb2JyZSBsYXMgdmVudGFzLiBBIGNvbnRpbnVhY2nDs24sIHByZXNlbnRhbW9zIGxhcyB2ZW50YXMgdW5pdGFyaWFzIGRlIDUgdGllbmRhcyBxdWUgdXRpbGl6YXJvbiBsYXMgNCBwcm9tb2Npb25lcyBlbiBtZXNlcyBkaWZlcmVudGVzOgoKVGlwbyBkZSBwcm9tb2Npw7NuIHwgVmVudGFzIHRpZW5kYSAxIHwgVmVudGFzIHRpZW5kYSAyIHwgVmVudGFzIHRpZW5kYSAzIHwgVmVudGFzIHRpZW5kYSA0IHwgVmVudGFzIHRpZW5kYSA1Ci0tLS0tLS0tLS0tLS0gfCAtLS0tLS0tLS0tLS0tLSB8IC0tLS0tLS0tLS0tLS0gfCAtLS0tLS0tLS0tLS0tLSB8IC0tLS0tLS0tLS0tLS0gfCAtLS0tLS0tLS0tLS0tLSAKTXVlc3RyYSBncmF0aXMgfCA3OCB8IDg3IHwgODEgfCA4OSB8IDg1ClByb2R1Y3RvIGV4dHJhIHwgOTQgfCA5MSB8IDg3IHwgOTAgfCA4OApEZXNjdWVudG8gfCA3MyB8IDc4IHwgNjkgfCA4MyB8IDc2ClJlZW1ib2xzbyB8IDc5IHwgODMgfCA3OCB8IDY5IHwgODEKCiMjIyMjIEFsIG5pdmVsIGRlIHNpZ25pZmljYW5jaWEgZGUgMC4wMSDCv2xhcyBwcm9tb2Npb25lcyBwcm9kdWNlbiBkaWZlcmVudGVzIGVmZWN0b3Mgc29icmUgbGFzIHZlbnRhcz8KCgpgYGB7cn0KcHJvbW9jaW9uIDwtIHJlYWQuY3N2KCIvVXNlcnMvam9yZ2Vtb2N0ZXp1bWEvRGVza3RvcC9wcm9tby5jc3YiKQpwcm9tb2Npb24kUHJvbW9jaW9uIDwtIGFzLmZhY3Rvcihwcm9tb2Npb24kUHJvbW9jaW9uKQpwcm9tb2Npb24kVGllbmRhIDwtIGFzLmZhY3Rvcihwcm9tb2Npb24kVGllbmRhKQpxZiguOTksZGYxID0gMyxkZjIgPSAxNikKYW5vdmEzIDwtIGFvdihWZW50YSB+IFByb21vY2lvbiArIFRpZW5kYSwgZGF0YSA9IHByb21vY2lvbikKc3VtbWFyeShhbm92YTMpCgpgYGAKCgojIyAqKjEyLTY0KioKVW4gYXJyZW5kYWRvciBlc3TDoSBpbnRlcmVzYWRvIGVuIHZlciBzaSBsYXMgcmVudGFzIGRlIHN1cyBkZXBhcnRhbWVudG9zIHNvbiBsYXMgY29tdW5lcy4gUGFyYSBlc3RvIHRvbcOzCnVuYSBtdWVzdHJhIGFsZWF0b3JpYSBkZSAxMSByZW50YXMgeSB0YW1hw7FvcyBkZSBkZXBhcnRhbWVudG9zIGVuIGNvbXBsZWpvcyBkZSBkZXBhcnRhbWVudG9zIHNpbWlsYXJlcy4KTG9zIGRhdG9zIHNvbiBsb3Mgc2lndWllbnRlczoKfCBSZW50YSB8IE7Dum1lcm8gZGUgcmVjYW1hcmFzIHwKIDIzMCB8IDIgCiAxOTAgfCAxCiA0NTAgfCAzCiAzMTAgfCAyCiAyMTggfCAyCiAxODUgfCAyCiAzNDAgfCAyCiAyNDUgfCAxCiAxMjUgfCAxCiAzNTAgfCAyCiAyODAgfCAyCgphKSBEZXNhcnJvbGxlIGxhIGVjdWFjacOzbiBkZSBlc3RpbWFjacOzbiBxdWUgbWVqb3IgZGVzY3JpYmEgZXN0b3MgZGF0b3MuCmIpIENhbGN1bGUgZWwgY29lZmljaWVudGUgZGUgZGV0ZXJtaW5hY2nDs24uCmMpIFByb25vc3RpcXVlIGxhIHJlbnRhIHBhcmEgdW4gZGVwYXJ0YW1lbnRvIGRlIGRvcyByZWPDoW1hcmFzCgoKYGBge3J9CnJlbnRhIDwtIGMoMjMwLDE5MCw0NTAsMzEwLDIxOCwxODUsMzQwLDI0NSwxMjUsMzUwLDI4MCkKcmVjYW1hcmFzIDwtIGMoMiwxLDMsMiwyLDIsMiwxLDEsMiwyKQoKcmVncmVzaW9uMyA8LSBsbShyZW50YSB+IHJlY2FtYXJhcykKc3VtbWFyeShyZWdyZXNpb24zKQoKIyBSZW50YSA9IDU1LjAwICsxMTUuOTAqUmVjYW1hcmFzIAoKI2IpCiMgcjIgPSAwLjU3NjIKCiNjKQpyZWNhbWFyYXMxIDwtIDIKcmVudGExIDwtIDU1ICsgMTE1LjkwKnJlY2FtYXJhczEKcmVudGExCiMgJDI4Ni44MApgYGAKCgo=