“Homework 2”
“14/10/2021”
“Saul Maldonado”
17/08/21
# Esto es un comentario
# Correr instrucciones Ctrl + Enter o "run"
2+2 # Toda la linea = situado en linea
## [1] 4
# Color azul todo bien
5-3
## [1] 2
## [1] -6
## [1] 24
# * es multiplicador escalar
3^2
## [1] 9
### Asignación de nombres a variables, tablas, etc.
# <- operador de asignación <-
xyy<-5
yyz<-12
xyy+yyz
## [1] 17
## [1] 17
## [1] 10
23/08/21
## Operaciones "punto" por vector##
vect3<- c(15,18,20,24)
5*vect3
## [1] 75 90 100 120
## [1] 225 270 300 360
## [fila, columna] Matriz 5x4
practi <- c(5,7,3,9,7,12,6,7)
practi_mat <- matrix(practi,ncol = 4, byrow = TRUE)
practi_mat
## [,1] [,2] [,3] [,4]
## [1,] 5 7 3 9
## [2,] 7 12 6 7
practi_mat2 <- matrix(practi, nrow=4, byrow = TRUE)
dim(practi_mat)
## [1] 2 4
## [1] 4 2
practi_mat3 <- matrix(c(11,13,2,5,8,4,7,12,21,21,6,8),
ncol = 3, byrow = TRUE)
3*practi_mat3
## [,1] [,2] [,3]
## [1,] 33 39 6
## [2,] 15 24 12
## [3,] 21 36 63
## [4,] 63 18 24
## indicadores de posicion (matriz y vector) ##
dim(practi_mat3)
## [1] 4 3
## [1] 2
practi_mat3 [, 3] #todos los renglones de la columna
## [1] 2 4 21 8
practi_mat3 [2, ] #todas las columnas del renglon
## [1] 5 8 4
practi_mat3 [1:2, ] # Fila 1 y 2. todas las columnas
## [,1] [,2] [,3]
## [1,] 11 13 2
## [2,] 5 8 4
practi_mat3 [, 1:2] # Columna 1 y 2 todas las filas
## [,1] [,2]
## [1,] 11 13
## [2,] 5 8
## [3,] 7 12
## [4,] 21 6
practi_mat3 [-1, ] # Elimina la fila solicitada
## [,1] [,2] [,3]
## [1,] 5 8 4
## [2,] 7 12 21
## [3,] 21 6 8
practi_mat3 [-1, -1] #Elimina la fila y la columna 1
## [,1] [,2]
## [1,] 8 4
## [2,] 12 21
## [3,] 6 8
matri2<- practi_mat3 [-1, -1]
practi_mat3 [c(1, 4),]
## [,1] [,2] [,3]
## [1,] 11 13 2
## [2,] 21 6 8
## [,1] [,2] [,3]
## [1,] 11 13 2
## [2,] 21 6 8
practi_mat3 [-c(2,3), -c(1,3)]
## [1] 13 6
## Álgebra de matrices
t(practi_mat3)
## [,1] [,2] [,3] [,4]
## [1,] 11 5 7 21
## [2,] 13 8 12 6
## [3,] 2 4 21 8
practi_mat4 <- practi_mat3[-4,]
practi_mat4
## [,1] [,2] [,3]
## [1,] 11 13 2
## [2,] 5 8 4
## [3,] 7 12 21
## [1] 3 3
inv_practi_mat4 <- solve(practi_mat4)
# para multiplicar matrices no se usa solo el "*"
#sino que se usa "%*%"
## ¿Multiplicación por la derecha o la izquierda? ##
practi_mat3 #4x3 3x2 dado que los elementos internos son iguales (3) se puede resolver
## [,1] [,2] [,3]
## [1,] 11 13 2
## [2,] 5 8 4
## [3,] 7 12 21
## [4,] 21 6 8
matri2 #3x2 4x3 no se puede multiplicar pues el elemento interno es diferente (2 y 4)
## [,1] [,2]
## [1,] 8 4
## [2,] 12 21
## [3,] 6 8
## [,1] [,2]
## [1,] 256 333
## [2,] 160 220
## [3,] 326 448
## [4,] 288 274
# Matriz por su inversa = identidad
practi_mat4%*%inv_practi_mat4
## [,1] [,2] [,3]
## [1,] 1.000000e+00 -4.996004e-16 5.551115e-17
## [2,] -2.428613e-16 1.000000e+00 -2.220446e-16
## [3,] 5.551115e-17 0.000000e+00 1.000000e+00
24/08/21
#sistema de ecuaciones
#5x-3y+2z=1
#-2x+2y-z=5
#4x+2y-4z=-3
coeficientes<-matrix(c(5,-3,2,-2,2,-1,4,2,-4), byrow = TRUE, ncol = 3)
respuestas <- c(1,5,-3)
?solve
## starting httpd help server ... done
solucion<-solve(coeficientes, respuestas)
ainv <- solve(coeficientes)
solucion
## [1] 2.388889 8.611111 7.444444
## [1] 3
#Intentemos x= b*a^(-1)
respuestas%*%ainv
## [,1] [,2] [,3]
## [1,] 1.666667 4.555556 0.4444444
#Intentemos x= a^(-1)* b
ainv%*%respuestas #Este es el orden correcto para resolver el sistema de ecuaciones
## [,1]
## [1,] 2.388889
## [2,] 8.611111
## [3,] 7.444444
(coeficientes + practi_mat4) %*% (solve(coeficientes + practi_mat4))
## [,1] [,2] [,3]
## [1,] 1.000000e+00 5.551115e-17 0
## [2,] -2.775558e-17 1.000000e+00 0
## [3,] -2.220446e-16 2.220446e-16 1
# Ctrl + L en la consola borra lo de la consola sin eliminar lo que se ha hecho
# Ctrl + A selecciona todo
ls()
## [1] "ainv" "coeficientes" "inv_practi_mat4" "matri2"
## [5] "practi" "practi_mat" "practi_mat2" "practi_mat3"
## [9] "practi_mat4" "respuestas" "solucion" "vect1"
## [13] "vect3" "vect6" "xyy" "yyz"
## [17] "zzz"
#ls() muestra todo los objetos del ambiente
#Rm elimina lo que se le indica
coeficientes
## [,1] [,2] [,3]
## [1,] 5 -3 2
## [2,] -2 2 -1
## [3,] 4 2 -4
## [,1] [,2] [,3]
## [1,] 5 -2 4
## [2,] -3 2 2
## [3,] 2 -1 -4
## [1] 5 2 -4
## [1] -18
?det
cbind(coeficientes, coeficientes[,1:2])
## [,1] [,2] [,3] [,4] [,5]
## [1,] 5 -3 2 5 -3
## [2,] -2 2 -1 -2 2
## [3,] 4 2 -4 4 2
rbind(coeficientes, coeficientes [1:2,])
## [,1] [,2] [,3]
## [1,] 5 -3 2
## [2,] -2 2 -1
## [3,] 4 2 -4
## [4,] 5 -3 2
## [5,] -2 2 -1
## [1] "M" "H"
vari2<-c("M","H","M","H","H","M","M",
"M","M","H","H","H","M")
length(vari2)
## [1] 13
## vari2
## H M
## 6 7
vari3<-c("1","0","1","0","0","1","1",
"1","1","0","0","0","1")
table(vari3)
## vari3
## 0 1
## 6 7
## vari3
## vari2 0 1
## H 6 0
## M 0 7
## [1] 1 0 1 0 0 1 1 1 1 0 0 0 1
## Levels: 0 1
sum(as.numeric(vari3)) #cambia la informacion a numerica
## [1] 7
vari3 [5]<- "cero"
vari3 [7]<- "uno"
vari3
## [1] "1" "0" "1" "0" "cero" "1" "uno" "1" "1" "0"
## [11] "0" "0" "1"
## Warning: NAs introducidos por coerción
## [1] 1 0 1 0 NA 1 NA 1 1 0 0 0 1
## Warning in table(as.numeric(vari3)): NAs introducidos por coerción
##
## 0 1
## 5 6
# Practicar el unir tablas/vectores del mismo tipo
# Distinto tipo/tipo de variable
rm(vect6)
vect6<- c(10,20,30,40,10,20,30,40,10,20,30,40,10,20,30,40)
vect7 <- c(10,10,10,10,20,20,20,20,30,30,30,30,40,40,40,40)
matriz7<-cbind(vect6,vect7)
dim(matriz7)
## [1] 16 2
matriz8<-cbind(vari2,vari3)
dim(matriz8)
## [1] 13 2
matriz9<- cbind(vect6[1:13], vari2)
matriz9
## vari2
## [1,] "10" "M"
## [2,] "20" "H"
## [3,] "30" "M"
## [4,] "40" "H"
## [5,] "10" "H"
## [6,] "20" "M"
## [7,] "30" "M"
## [8,] "40" "M"
## [9,] "10" "M"
## [10,] "20" "H"
## [11,] "30" "H"
## [12,] "40" "H"
## [13,] "10" "M"
######################################
# Marcos de datos #
# Conviven en la misma tabla distintos
#tipos de elementos#
######################################
data.frame(vector=vect6[1:13], vector2=vari3)
## vector vector2
## 1 10 1
## 2 20 0
## 3 30 1
## 4 40 0
## 5 10 cero
## 6 20 1
## 7 30 uno
## 8 40 1
## 9 10 1
## 10 20 0
## 11 30 0
## 12 40 0
## 13 10 1
data.frame(vector=vect6[1:13], vector2=vari2)
## vector vector2
## 1 10 M
## 2 20 H
## 3 30 M
## 4 40 H
## 5 10 H
## 6 20 M
## 7 30 M
## 8 40 M
## 9 10 M
## 10 20 H
## 11 30 H
## 12 40 H
## 13 10 M
data.frame(vector=as.numeric(vect6[1:13]), vector2=vari2)
## vector vector2
## 1 10 M
## 2 20 H
## 3 30 M
## 4 40 H
## 5 10 H
## 6 20 M
## 7 30 M
## 8 40 M
## 9 10 M
## 10 20 H
## 11 30 H
## 12 40 H
## 13 10 M
data.frame(vector=as.numeric(vect6[1:13]),
vector2=as.numeric(vari3))
## Warning in data.frame(vector = as.numeric(vect6[1:13]), vector2 =
## as.numeric(vari3)): NAs introducidos por coerción
## vector vector2
## 1 10 1
## 2 20 0
## 3 30 1
## 4 40 0
## 5 10 NA
## 6 20 1
## 7 30 NA
## 8 40 1
## 9 10 1
## 10 20 0
## 11 30 0
## 12 40 0
## 13 10 1
matriz11<-data.frame(vector=as.numeric(vect6[1:13]),
vector2=as.factor(vari3))
matriz12<-data.frame(vector=as.numeric(vect6[1:13]),
vector2=as.factor(vari3),
vector3=as.numeric(vect7[1:13]),
vector4=as.factor(vari2))
matriz12
## vector vector2 vector3 vector4
## 1 10 1 10 M
## 2 20 0 10 H
## 3 30 1 10 M
## 4 40 0 10 H
## 5 10 cero 20 H
## 6 20 1 20 M
## 7 30 uno 20 M
## 8 40 1 20 M
## 9 10 1 30 M
## 10 20 0 30 H
## 11 30 0 30 H
## 12 40 0 30 H
## 13 10 1 40 M
?data.frame
# Preguntas informativas
# proporciona informacion
is.data.frame(matriz12)
## [1] TRUE
## [1] FALSE
is.numeric(matriz12$vector)
## [1] TRUE
is.numeric(matriz12$vector2)
## [1] FALSE
is.factor(matriz12$vector)
## [1] FALSE
is.factor(matriz12$vector2)
## [1] TRUE
is.factor(matriz12$vector2[1])
## [1] TRUE
is.numeric(matriz12$vector2[1])
## [1] FALSE
View(matriz12) # Ver todos los elementos de la matriz
# Recap
## 1) Escalares... números sueltos
## 2) Vectores
## 3) Matriz
## 4) Listas # Agregar todos los anteriores
?list
casa<-list(mensaje="Hola mundo",
vector=vari1,
matriz=matriz12,
generado=as.factor(seq(1,50)))
is.list(casa)
## [1] TRUE
## [1] TRUE
## [1] "Hola mundo"
## [1] "M"
## [1] 10 20 30 40 10 20 30 40 10 20 30 40 10
# Estadística de resumen/genéricas
# solve # mean # sd # var # max # min
matriz13 <- cbind(matriz12$vector, matriz12$vector3)
mean(matriz13[,2])
## [1] 21.53846
## [1] 9.870962
## [1] 40
## [1] 10
# ¿y si queremos obtener el vector [l=2] de las medias de matriz 13?
# Funciones ya hechas
# Funciones que podemos generar
31/08/21
# cargar datos preinstalados en R
data(iris)
?iris
str(iris)
## 'data.frame': 150 obs. of 5 variables:
## $ Sepal.Length: num 5.1 4.9 4.7 4.6 5 5.4 4.6 5 4.4 4.9 ...
## $ Sepal.Width : num 3.5 3 3.2 3.1 3.6 3.9 3.4 3.4 2.9 3.1 ...
## $ Petal.Length: num 1.4 1.4 1.3 1.5 1.4 1.7 1.4 1.5 1.4 1.5 ...
## $ Petal.Width : num 0.2 0.2 0.2 0.2 0.2 0.4 0.3 0.2 0.2 0.1 ...
## $ Species : Factor w/ 3 levels "setosa","versicolor",..: 1 1 1 1 1 1 1 1 1 1 ...
## num [1:50, 1:4, 1:3] 5.1 4.9 4.7 4.6 5 5.4 4.6 5 4.4 4.9 ...
## - attr(*, "dimnames")=List of 3
## ..$ : NULL
## ..$ : chr [1:4] "Sepal L." "Sepal W." "Petal L." "Petal W."
## ..$ : chr [1:3] "Setosa" "Versicolor" "Virginica"
## [1] 150 5
## [1] FALSE
## [1] TRUE
## [1] TRUE
## [1] FALSE
## [1] FALSE
## [1] FALSE
## [1] 50 4 3
## , , Setosa
##
## Sepal L. Sepal W. Petal L. Petal W.
## [1,] 5.1 3.5 1.4 0.2
## [2,] 4.9 3.0 1.4 0.2
## [3,] 4.7 3.2 1.3 0.2
## [4,] 4.6 3.1 1.5 0.2
## [5,] 5.0 3.6 1.4 0.2
## [6,] 5.4 3.9 1.7 0.4
##
## , , Versicolor
##
## Sepal L. Sepal W. Petal L. Petal W.
## [1,] 7.0 3.2 4.7 1.4
## [2,] 6.4 3.2 4.5 1.5
## [3,] 6.9 3.1 4.9 1.5
## [4,] 5.5 2.3 4.0 1.3
## [5,] 6.5 2.8 4.6 1.5
## [6,] 5.7 2.8 4.5 1.3
##
## , , Virginica
##
## Sepal L. Sepal W. Petal L. Petal W.
## [1,] 6.3 3.3 6.0 2.5
## [2,] 5.8 2.7 5.1 1.9
## [3,] 7.1 3.0 5.9 2.1
## [4,] 6.3 2.9 5.6 1.8
## [5,] 6.5 3.0 5.8 2.2
## [6,] 7.6 3.0 6.6 2.1
View(iris)
is.numeric(iris[,1])
## [1] TRUE
iris3[1,,] # primer renglon con todas las variables (columnas)
## Setosa Versicolor Virginica
## Sepal L. 5.1 7.0 6.3
## Sepal W. 3.5 3.2 3.3
## Petal L. 1.4 4.7 6.0
## Petal W. 0.2 1.4 2.5
# y todos los niveles de profundidad
iris3[,3,] # primer columna todos las observaciones (renglones)
## Setosa Versicolor Virginica
## [1,] 1.4 4.7 6.0
## [2,] 1.4 4.5 5.1
## [3,] 1.3 4.9 5.9
## [4,] 1.5 4.0 5.6
## [5,] 1.4 4.6 5.8
## [6,] 1.7 4.5 6.6
## [7,] 1.4 4.7 4.5
## [8,] 1.5 3.3 6.3
## [9,] 1.4 4.6 5.8
## [10,] 1.5 3.9 6.1
## [11,] 1.5 3.5 5.1
## [12,] 1.6 4.2 5.3
## [13,] 1.4 4.0 5.5
## [14,] 1.1 4.7 5.0
## [15,] 1.2 3.6 5.1
## [16,] 1.5 4.4 5.3
## [17,] 1.3 4.5 5.5
## [18,] 1.4 4.1 6.7
## [19,] 1.7 4.5 6.9
## [20,] 1.5 3.9 5.0
## [21,] 1.7 4.8 5.7
## [22,] 1.5 4.0 4.9
## [23,] 1.0 4.9 6.7
## [24,] 1.7 4.7 4.9
## [25,] 1.9 4.3 5.7
## [26,] 1.6 4.4 6.0
## [27,] 1.6 4.8 4.8
## [28,] 1.5 5.0 4.9
## [29,] 1.4 4.5 5.6
## [30,] 1.6 3.5 5.8
## [31,] 1.6 3.8 6.1
## [32,] 1.5 3.7 6.4
## [33,] 1.5 3.9 5.6
## [34,] 1.4 5.1 5.1
## [35,] 1.5 4.5 5.6
## [36,] 1.2 4.5 6.1
## [37,] 1.3 4.7 5.6
## [38,] 1.4 4.4 5.5
## [39,] 1.3 4.1 4.8
## [40,] 1.5 4.0 5.4
## [41,] 1.3 4.4 5.6
## [42,] 1.3 4.6 5.1
## [43,] 1.3 4.0 5.1
## [44,] 1.6 3.3 5.9
## [45,] 1.9 4.2 5.7
## [46,] 1.4 4.2 5.2
## [47,] 1.6 4.2 5.0
## [48,] 1.4 4.3 5.2
## [49,] 1.5 3.0 5.4
## [50,] 1.4 4.1 5.1
# y los tres niveles de profundidad
iris3[,,3] # el primer nivel de profundidad con sus observaciones
## Sepal L. Sepal W. Petal L. Petal W.
## [1,] 6.3 3.3 6.0 2.5
## [2,] 5.8 2.7 5.1 1.9
## [3,] 7.1 3.0 5.9 2.1
## [4,] 6.3 2.9 5.6 1.8
## [5,] 6.5 3.0 5.8 2.2
## [6,] 7.6 3.0 6.6 2.1
## [7,] 4.9 2.5 4.5 1.7
## [8,] 7.3 2.9 6.3 1.8
## [9,] 6.7 2.5 5.8 1.8
## [10,] 7.2 3.6 6.1 2.5
## [11,] 6.5 3.2 5.1 2.0
## [12,] 6.4 2.7 5.3 1.9
## [13,] 6.8 3.0 5.5 2.1
## [14,] 5.7 2.5 5.0 2.0
## [15,] 5.8 2.8 5.1 2.4
## [16,] 6.4 3.2 5.3 2.3
## [17,] 6.5 3.0 5.5 1.8
## [18,] 7.7 3.8 6.7 2.2
## [19,] 7.7 2.6 6.9 2.3
## [20,] 6.0 2.2 5.0 1.5
## [21,] 6.9 3.2 5.7 2.3
## [22,] 5.6 2.8 4.9 2.0
## [23,] 7.7 2.8 6.7 2.0
## [24,] 6.3 2.7 4.9 1.8
## [25,] 6.7 3.3 5.7 2.1
## [26,] 7.2 3.2 6.0 1.8
## [27,] 6.2 2.8 4.8 1.8
## [28,] 6.1 3.0 4.9 1.8
## [29,] 6.4 2.8 5.6 2.1
## [30,] 7.2 3.0 5.8 1.6
## [31,] 7.4 2.8 6.1 1.9
## [32,] 7.9 3.8 6.4 2.0
## [33,] 6.4 2.8 5.6 2.2
## [34,] 6.3 2.8 5.1 1.5
## [35,] 6.1 2.6 5.6 1.4
## [36,] 7.7 3.0 6.1 2.3
## [37,] 6.3 3.4 5.6 2.4
## [38,] 6.4 3.1 5.5 1.8
## [39,] 6.0 3.0 4.8 1.8
## [40,] 6.9 3.1 5.4 2.1
## [41,] 6.7 3.1 5.6 2.4
## [42,] 6.9 3.1 5.1 2.3
## [43,] 5.8 2.7 5.1 1.9
## [44,] 6.8 3.2 5.9 2.3
## [45,] 6.7 3.3 5.7 2.5
## [46,] 6.7 3.0 5.2 2.3
## [47,] 6.3 2.5 5.0 1.9
## [48,] 6.5 3.0 5.2 2.0
## [49,] 6.2 3.4 5.4 2.3
## [50,] 5.9 3.0 5.1 1.8
#(renglones) y sus variables (columnas)
# iris3
# promedio de Sepal L. & W. de cada flor
iris3[,1,]
## Setosa Versicolor Virginica
## [1,] 5.1 7.0 6.3
## [2,] 4.9 6.4 5.8
## [3,] 4.7 6.9 7.1
## [4,] 4.6 5.5 6.3
## [5,] 5.0 6.5 6.5
## [6,] 5.4 5.7 7.6
## [7,] 4.6 6.3 4.9
## [8,] 5.0 4.9 7.3
## [9,] 4.4 6.6 6.7
## [10,] 4.9 5.2 7.2
## [11,] 5.4 5.0 6.5
## [12,] 4.8 5.9 6.4
## [13,] 4.8 6.0 6.8
## [14,] 4.3 6.1 5.7
## [15,] 5.8 5.6 5.8
## [16,] 5.7 6.7 6.4
## [17,] 5.4 5.6 6.5
## [18,] 5.1 5.8 7.7
## [19,] 5.7 6.2 7.7
## [20,] 5.1 5.6 6.0
## [21,] 5.4 5.9 6.9
## [22,] 5.1 6.1 5.6
## [23,] 4.6 6.3 7.7
## [24,] 5.1 6.1 6.3
## [25,] 4.8 6.4 6.7
## [26,] 5.0 6.6 7.2
## [27,] 5.0 6.8 6.2
## [28,] 5.2 6.7 6.1
## [29,] 5.2 6.0 6.4
## [30,] 4.7 5.7 7.2
## [31,] 4.8 5.5 7.4
## [32,] 5.4 5.5 7.9
## [33,] 5.2 5.8 6.4
## [34,] 5.5 6.0 6.3
## [35,] 4.9 5.4 6.1
## [36,] 5.0 6.0 7.7
## [37,] 5.5 6.7 6.3
## [38,] 4.9 6.3 6.4
## [39,] 4.4 5.6 6.0
## [40,] 5.1 5.5 6.9
## [41,] 5.0 5.5 6.7
## [42,] 4.5 6.1 6.9
## [43,] 4.4 5.8 5.8
## [44,] 5.0 5.0 6.8
## [45,] 5.1 5.6 6.7
## [46,] 4.8 5.7 6.7
## [47,] 5.1 5.7 6.3
## [48,] 4.6 6.2 6.5
## [49,] 5.3 5.1 6.2
## [50,] 5.0 5.7 5.9
mean(iris3[,1,1]) #Sepal L de Setosa
## [1] 5.006
mean(iris3[,1,2]) #Sepal L de Versicolor
## [1] 5.936
mean(iris3[,1,3]) #Sepal L de Virginica
## [1] 6.588
mean(iris3[,2,1]) #Sepal W de Setosa
## [1] 3.428
mean(iris3[,2,2]) #Sepal W de Versicolor
## [1] 2.77
mean(iris3[,2,3]) #Sepal W de Virginica
## [1] 2.974
#iris
mean(iris[1:50,1])#Sepal L de Setosa
## [1] 5.006
mean(iris[51:100,1])#Sepal L de Versicolor
## [1] 5.936
mean(iris[101:150,1])#Sepal L de Virginica
## [1] 6.588
mean(iris[1:50,2]) #Sepal W de Setosa
## [1] 3.428
mean(iris[51:100,2]) #Sepal W de Versicolor
## [1] 2.77
mean(iris[101:150,2])#Sepal W de Virginica
## [1] 2.974
# esto es mas facil con las funciones apply() & aggregate
?apply
prom_setosa<-apply(iris[1:50,-5], 2, mean)
# Todos los promedios de Setosa
prom_versi<-apply(iris[51:100,-5], 2, mean)
# Todos los promedios de Versicolor
prom_virgi<-apply(iris[101:150,-5], 2, mean)
# Todos los promedios de Virginical
promedio_flores<-data.frame(Setosa=prom_setosa,
Versicolor=prom_versi,
Virginical=prom_virgi)
promedio_flores
## Setosa Versicolor Virginical
## Sepal.Length 5.006 5.936 6.588
## Sepal.Width 3.428 2.770 2.974
## Petal.Length 1.462 4.260 5.552
## Petal.Width 0.246 1.326 2.026
# Obtener la sd (desviacion estandar) de cada flor de sus 4
# variables, pero de la base iris3
# generar un data.frame parecido a promedio_flores
sd_setosa<-apply(iris3[,,1], 2, sd)
# Todos las desviaciones estandar de Setosa
sd_versi<-apply(iris3[,,2], 2, sd)
# Todos las desviaciones estandar de Versicolor
sd_virgi<-apply(iris3[,,3], 2, sd)
# Todos las desviaciones estandar de Virginical
sd_flores <- data.frame(Setosa=sd_setosa,
Versicolor=sd_versi,
Virginical=sd_virgi)
rownames(sd_flores)<-c("Largo sépalo","Ancho sépalo","Largo pétalo",
"Ancho pétalo")
colnames(sd_flores)<-c("Set","Versi","Virgi")
sd_flores
## Set Versi Virgi
## Largo sépalo 0.3524897 0.5161711 0.6358796
## Ancho sépalo 0.3790644 0.3137983 0.3224966
## Largo pétalo 0.1736640 0.4699110 0.5518947
## Ancho pétalo 0.1053856 0.1977527 0.2746501
06/09/21
apply(iris3[,,3],2,summary)
## Sepal L. Sepal W. Petal L. Petal W.
## Min. 4.900 2.200 4.500 1.400
## 1st Qu. 6.225 2.800 5.100 1.800
## Median 6.500 3.000 5.550 2.000
## Mean 6.588 2.974 5.552 2.026
## 3rd Qu. 6.900 3.175 5.875 2.300
## Max. 7.900 3.800 6.900 2.500
rbind(colMeans(iris[1:50,-5]),
colMeans(iris[51:100,-5]),
colMeans(iris[101:150,-5]))
## Sepal.Length Sepal.Width Petal.Length Petal.Width
## [1,] 5.006 3.428 1.462 0.246
## [2,] 5.936 2.770 4.260 1.326
## [3,] 6.588 2.974 5.552 2.026
#aggregate() +
#variable numerica~variable puede ser no numerica
?aggregate
aggregate(Sepal.Length~Species, data=iris, mean)
## Species Sepal.Length
## 1 setosa 5.006
## 2 versicolor 5.936
## 3 virginica 6.588
aggregate(Sepal.Width~Species, data=iris, mean)
## Species Sepal.Width
## 1 setosa 3.428
## 2 versicolor 2.770
## 3 virginica 2.974
aggregate(cbind(Sepal.Length, Sepal.Width,
Petal.Length, Petal.Width)
~Species, data=iris, mean)
## Species Sepal.Length Sepal.Width Petal.Length Petal.Width
## 1 setosa 5.006 3.428 1.462 0.246
## 2 versicolor 5.936 2.770 4.260 1.326
## 3 virginica 6.588 2.974 5.552 2.026
aggregate(cbind(Sepal.Length, Sepal.Width,
Petal.Length, Petal.Width)
~Species, data=iris, summary)
## Species Sepal.Length.Min. Sepal.Length.1st Qu. Sepal.Length.Median
## 1 setosa 4.300 4.800 5.000
## 2 versicolor 4.900 5.600 5.900
## 3 virginica 4.900 6.225 6.500
## Sepal.Length.Mean Sepal.Length.3rd Qu. Sepal.Length.Max. Sepal.Width.Min.
## 1 5.006 5.200 5.800 2.300
## 2 5.936 6.300 7.000 2.000
## 3 6.588 6.900 7.900 2.200
## Sepal.Width.1st Qu. Sepal.Width.Median Sepal.Width.Mean Sepal.Width.3rd Qu.
## 1 3.200 3.400 3.428 3.675
## 2 2.525 2.800 2.770 3.000
## 3 2.800 3.000 2.974 3.175
## Sepal.Width.Max. Petal.Length.Min. Petal.Length.1st Qu. Petal.Length.Median
## 1 4.400 1.000 1.400 1.500
## 2 3.400 3.000 4.000 4.350
## 3 3.800 4.500 5.100 5.550
## Petal.Length.Mean Petal.Length.3rd Qu. Petal.Length.Max. Petal.Width.Min.
## 1 1.462 1.575 1.900 0.100
## 2 4.260 4.600 5.100 1.000
## 3 5.552 5.875 6.900 1.400
## Petal.Width.1st Qu. Petal.Width.Median Petal.Width.Mean Petal.Width.3rd Qu.
## 1 0.200 0.200 0.246 0.300
## 2 1.200 1.300 1.326 1.500
## 3 1.800 2.000 2.026 2.300
## Petal.Width.Max.
## 1 0.600
## 2 1.800
## 3 2.500
aggregate(cbind(Sepal.Length, Sepal.Width,
Petal.Length, Petal.Width)
~Species, data=iris, sd)
## Species Sepal.Length Sepal.Width Petal.Length Petal.Width
## 1 setosa 0.3524897 0.3790644 0.1736640 0.1053856
## 2 versicolor 0.5161711 0.3137983 0.4699110 0.1977527
## 3 virginica 0.6358796 0.3224966 0.5518947 0.2746501
############### Cambio de base de datos ####################
data("ToothGrowth")
ToothGrowth
## len supp dose
## 1 4.2 VC 0.5
## 2 11.5 VC 0.5
## 3 7.3 VC 0.5
## 4 5.8 VC 0.5
## 5 6.4 VC 0.5
## 6 10.0 VC 0.5
## 7 11.2 VC 0.5
## 8 11.2 VC 0.5
## 9 5.2 VC 0.5
## 10 7.0 VC 0.5
## 11 16.5 VC 1.0
## 12 16.5 VC 1.0
## 13 15.2 VC 1.0
## 14 17.3 VC 1.0
## 15 22.5 VC 1.0
## 16 17.3 VC 1.0
## 17 13.6 VC 1.0
## 18 14.5 VC 1.0
## 19 18.8 VC 1.0
## 20 15.5 VC 1.0
## 21 23.6 VC 2.0
## 22 18.5 VC 2.0
## 23 33.9 VC 2.0
## 24 25.5 VC 2.0
## 25 26.4 VC 2.0
## 26 32.5 VC 2.0
## 27 26.7 VC 2.0
## 28 21.5 VC 2.0
## 29 23.3 VC 2.0
## 30 29.5 VC 2.0
## 31 15.2 OJ 0.5
## 32 21.5 OJ 0.5
## 33 17.6 OJ 0.5
## 34 9.7 OJ 0.5
## 35 14.5 OJ 0.5
## 36 10.0 OJ 0.5
## 37 8.2 OJ 0.5
## 38 9.4 OJ 0.5
## 39 16.5 OJ 0.5
## 40 9.7 OJ 0.5
## 41 19.7 OJ 1.0
## 42 23.3 OJ 1.0
## 43 23.6 OJ 1.0
## 44 26.4 OJ 1.0
## 45 20.0 OJ 1.0
## 46 25.2 OJ 1.0
## 47 25.8 OJ 1.0
## 48 21.2 OJ 1.0
## 49 14.5 OJ 1.0
## 50 27.3 OJ 1.0
## 51 25.5 OJ 2.0
## 52 26.4 OJ 2.0
## 53 22.4 OJ 2.0
## 54 24.5 OJ 2.0
## 55 24.8 OJ 2.0
## 56 30.9 OJ 2.0
## 57 26.4 OJ 2.0
## 58 27.3 OJ 2.0
## 59 29.4 OJ 2.0
## 60 23.0 OJ 2.0
## 'data.frame': 60 obs. of 3 variables:
## $ len : num 4.2 11.5 7.3 5.8 6.4 10 11.2 11.2 5.2 7 ...
## $ supp: Factor w/ 2 levels "OJ","VC": 2 2 2 2 2 2 2 2 2 2 ...
## $ dose: num 0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.5 ...
?ToothGrowth
mean(ToothGrowth$len)
## [1] 18.81333
## [1] 1.166667
## [1] 0.6288722
## [1] 33.9
## [1] 4.2
# ¿Cual es el promedio de crecimiento
# por metodo de aplicacion?
aggregate(len~supp, data = ToothGrowth, mean)
## supp len
## 1 OJ 20.66333
## 2 VC 16.96333
aggregate(len~dose, data = ToothGrowth, mean)
## dose len
## 1 0.5 10.605
## 2 1.0 19.735
## 3 2.0 26.100
aggregate(len~supp+dose, data = ToothGrowth, mean)
## supp dose len
## 1 OJ 0.5 13.23
## 2 VC 0.5 7.98
## 3 OJ 1.0 22.70
## 4 VC 1.0 16.77
## 5 OJ 2.0 26.06
## 6 VC 2.0 26.14
?runif
set.seed(15148)
pesos<-rnorm(60,10,2)
pesos2<-runif(60)
peso_dientes<-data.frame(ToothGrowth, pesos= pesos)
aggregate(cbind(pesos,len)~dose+supp,
data=peso_dientes, mean)
## dose supp pesos len
## 1 0.5 OJ 10.024162 13.23
## 2 1.0 OJ 8.305933 22.70
## 3 2.0 OJ 9.195878 26.06
## 4 0.5 VC 9.744000 7.98
## 5 1.0 VC 10.293366 16.77
## 6 2.0 VC 9.481802 26.14
aggregate(cbind(len, pesos)~dose+supp,
data=peso_dientes, mean)
## dose supp len pesos
## 1 0.5 OJ 13.23 10.024162
## 2 1.0 OJ 22.70 8.305933
## 3 2.0 OJ 26.06 9.195878
## 4 0.5 VC 7.98 9.744000
## 5 1.0 VC 16.77 10.293366
## 6 2.0 VC 26.14 9.481802
aggregate(cbind(len, pesos, pesos2)~dose+supp,
data=peso_dientes, mean)
## dose supp len pesos pesos2
## 1 0.5 OJ 13.23 10.024162 0.4034515
## 2 1.0 OJ 22.70 8.305933 0.5679498
## 3 2.0 OJ 26.06 9.195878 0.4765870
## 4 0.5 VC 7.98 9.744000 0.4664007
## 5 1.0 VC 16.77 10.293366 0.5118205
## 6 2.0 VC 26.14 9.481802 0.3408846
07/09/21
## Llamar los datos ##
#tibble, datos organizados como tabla
# es otro tipo de tabla junto con data.frame y matrix
#install.packages("readxl") # comprar e instalar el foco
library(readxl) # encender el foco
#library(kernlab)
datos10<-read_excel("C:\\Users\\divis\\Documents\\METPOL\\Semestre 1\\Manejo de BDD\\C.07.09.21\\datos_ags_estado_2020.xlsx",
sheet="Hoja1", range="A1:HV481",
na=c("*", "N/D"))
mean(as.numeric(datos10$POBTOT))
## [1] 2497.315
## [1] 2497.315
#1) ¿cual es la poblacion total de los 11 municipios?
#2) ¿cual es el total de hombres de los 11 municipios?
#3) ¿cual es el total de mujeres de los 11 municipios?
#4) ¿cual es la proporcion?
#1)
aggregate(as.numeric(POBTOT)~NOM_MUN,
data=datos10, sum)
## NOM_MUN as.numeric(POBTOT)
## 1 Aguascalientes 901446
## 2 Asientos 17760
## 3 Calvillo 28367
## 4 Cosío 8477
## 5 El Llano 6307
## 6 Jesús María 97524
## 7 Pabellón de Arteaga 35351
## 8 Rincón de Romos 42562
## 9 San Francisco de los Romo 46196
## 10 San José de Gracia 5607
## 11 Tepezalá 9114
#2)
aggregate(as.numeric(POBMAS)~NOM_MUN,
data=datos10, sum)
## NOM_MUN as.numeric(POBMAS)
## 1 Aguascalientes 437749
## 2 Asientos 8673
## 3 Calvillo 13806
## 4 Cosío 4067
## 5 El Llano 3088
## 6 Jesús María 48011
## 7 Pabellón de Arteaga 17305
## 8 Rincón de Romos 20808
## 9 San Francisco de los Romo 22865
## 10 San José de Gracia 2635
## 11 Tepezalá 4524
#3)
aggregate(as.numeric(POBFEM)~NOM_MUN,
data=datos10, sum)
## NOM_MUN as.numeric(POBFEM)
## 1 Aguascalientes 463697
## 2 Asientos 9087
## 3 Calvillo 14561
## 4 Cosío 4410
## 5 El Llano 3219
## 6 Jesús María 49513
## 7 Pabellón de Arteaga 18046
## 8 Rincón de Romos 21748
## 9 San Francisco de los Romo 23331
## 10 San José de Gracia 2972
## 11 Tepezalá 4590
#4)
tabla1<-aggregate(cbind(as.numeric(POBTOT),
as.numeric(POBFEM),
as.numeric(POBMAS))~NOM_MUN,
data=datos10, sum)
prop_fem<-tabla1$V2/tabla1$V1
tabla2<-data.frame(tabla1, Prop_fem=prop_fem)
tabla2
## NOM_MUN V1 V2 V3 Prop_fem
## 1 Aguascalientes 901446 463697 437749 0.5143924
## 2 Asientos 17760 9087 8673 0.5116554
## 3 Calvillo 28367 14561 13806 0.5133077
## 4 Cosío 8477 4410 4067 0.5202312
## 5 El Llano 6307 3219 3088 0.5103853
## 6 Jesús María 97524 49513 48011 0.5077007
## 7 Pabellón de Arteaga 35351 18046 17305 0.5104806
## 8 Rincón de Romos 42556 21748 20808 0.5110443
## 9 San Francisco de los Romo 46196 23331 22865 0.5050437
## 10 San José de Gracia 5607 2972 2635 0.5300517
## 11 Tepezalá 9114 4590 4524 0.5036208
#5) Aproximado de personas por vivienda en cada municipio
#6) De san Jose de Gracia ¿cual es la poblacion de sus
# AGEBs urbanos?
#7) De todos los AGEBs urbanos ¿cual es la proporcion de mujeres?
#5)
# ¿Cauantas viviendas entre cuantas personas?
tabla15<-aggregate(cbind(as.numeric(VIVTOT),
as.numeric(POBTOT))~NOM_MUN,
data=datos10,FUN=sum)
tabla15$Pro_viv<-tabla15$V2/tabla15$V1
#6)
san_jose<-which(datos10$NOM_MUN=="San José de Gracia")
datos_san_jose<-datos10[san_jose,]
datos_san_jose$POBTOT
## [1] 1095 1145 873 850 778 866
sum(as.numeric(datos_san_jose$POBTOT))
## [1] 5607
#7)
tabla18<-aggregate(cbind(as.numeric(POBTOT),
as.numeric(POBFEM))~NOM_MUN+AGEB,
data=datos10,FUN=sum)
tabla18$Prop_muj<-tabla18$V2/tabla18$V1
# trabajar con NA's # para no considerar NA's : na.rm=T
mean(as.numeric(datos10$P_0A2_F), na.rm = T)
## [1] 62.48817
?mean
sum(is.na(as.numeric(datos10$P_0A2_F)))
## [1] 15
summary(as.numeric(datos10$P_0A2_F))
## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## 0.00 28.00 50.00 62.49 88.00 387.00 15
summary(as.numeric(datos10$P_0A2_F))[3]
## Median
## 50
# Promedio por municipio
aggregate(as.numeric(P_0A2_F)~NOM_MUN, FUN=mean,
data = datos10,na.rm=T)
## NOM_MUN as.numeric(P_0A2_F)
## 1 Aguascalientes 63.59077
## 2 Asientos 40.57143
## 3 Calvillo 51.06667
## 4 Cosío 36.42857
## 5 El Llano 63.66667
## 6 Jesús María 64.17949
## 7 Pabellón de Arteaga 63.66667
## 8 Rincón de Romos 83.26667
## 9 San Francisco de los Romo 74.47368
## 10 San José de Gracia 36.50000
## 11 Tepezalá 38.42857
14/09/21
# FUN = funcion realizada por nnosotros ¿como la realizamos?
# FUNCIONES PERSONALIZADAS # FUNCIONES DEL USUARIO #
# ¿ENTRADA DE LA FUNCION? ¿CUAL ES LA SALIDA? #
# SE PROGRAMAN COMO SE NECESITAN, PERSONALIZADAS #
#1) Rango (max-min)
#2) Coeficiente de variabilidad sigma/abs(media)
#3) Media cortada: descartar el mayor y el menor
#1)
rango<-function(x){max(x)-min(x)}
#Setosa
rango(iris3[,1,1])
## [1] 1.5
## Sepal L. Sepal W. Petal L. Petal W.
## 5.006 3.428 1.462 0.246
apply(iris3[,,1],2,rango)
## Sepal L. Sepal W. Petal L. Petal W.
## 1.5 2.1 0.9 0.5
aggregate(cbind(Sepal.Length, Sepal.Width, Petal.Length,
Petal.Width)~Species,
data=iris,mean)
## Species Sepal.Length Sepal.Width Petal.Length Petal.Width
## 1 setosa 5.006 3.428 1.462 0.246
## 2 versicolor 5.936 2.770 4.260 1.326
## 3 virginica 6.588 2.974 5.552 2.026
aggregate(cbind(Sepal.Length, Sepal.Width, Petal.Length,
Petal.Width)~Species,
data=iris,rango)
## Species Sepal.Length Sepal.Width Petal.Length Petal.Width
## 1 setosa 1.5 2.1 0.9 0.5
## 2 versicolor 2.1 1.4 2.1 0.8
## 3 virginica 3.0 1.6 2.4 1.1
#2)
coef_var<-function(x){sd(x)/abs(mean(x))}
apply(iris3[,,1],2,coef_var)
## Sepal L. Sepal W. Petal L. Petal W.
## 0.07041344 0.11057887 0.11878522 0.42839670
aggregate(cbind(Sepal.Length, Sepal.Width, Petal.Length,
Petal.Width)~Species,
data=iris,coef_var)
## Species Sepal.Length Sepal.Width Petal.Length Petal.Width
## 1 setosa 0.07041344 0.1105789 0.11878522 0.4283967
## 2 versicolor 0.08695606 0.1132846 0.11030774 0.1491348
## 3 virginica 0.09652089 0.1084387 0.09940466 0.1355627
## [1] 5.8
## [1] 4.3
which(iris3[,1,1]==max(iris3[,1,1]))
## [1] 15
which(iris3[,1,1]==min(iris3[,1,1]))
## [1] 14
descarte<-c(which(iris3[,3,1]==max(iris3[,3,1])),
which(iris3[,3,1]==min(iris3[,3,1])))
mean(iris3[-descarte,1,1])
## [1] 5.017021
desc_media<-function(x){
descarte<-c(which(x==max(x)),
which(x==min(x)))
mean(x[-descarte])}
desc_media(iris3[,3,1])
## [1] 1.453191
## [1] 0.2545455
## [1] 1.462
apply(iris3[,,1],2,desc_media)
## Sepal L. Sepal W. Petal L. Petal W.
## 5.0041667 3.4312500 1.4531915 0.2545455
aggregate(cbind(Sepal.Length, Sepal.Width, Petal.Length,
Petal.Width)~Species,
data=iris,desc_media)
## Species Sepal.Length Sepal.Width Petal.Length Petal.Width
## 1 setosa 5.004167 3.431250 1.453191 0.2545455
## 2 versicolor 5.935417 2.772917 4.268750 1.3690476
## 3 virginica 6.595833 2.955319 5.545833 2.0086957
## Quitarle los dos últimos y los dos primeros
# * sort
longi<-length(iris3[,3,1])
posis_quit<-c(1,2,longi-1,longi)
ordenado<-sort(iris3[,3,1], decreasing = T)
mean(ordenado[-posis_quit])
## [1] 1.46087
corte_dos<-function(w){
longi<-length(w)
posis_quit<-c(1,2,longi-1,longi)
ordenado<-sort(w, decreasing = T)
mean(ordenado[-posis_quit])
}
corte_dos(iris[,2])
## [1] 3.053425
apply(iris3[,,1],2,corte_dos)
## Sepal L. Sepal W. Petal L. Petal W.
## 5.0021739 3.4260870 1.4608696 0.2391304
aggregate(cbind(Sepal.Length, Sepal.Width, Petal.Length,
Petal.Width)~Species,
data=iris,corte_dos)
## Species Sepal.Length Sepal.Width Petal.Length Petal.Width
## 1 setosa 5.002174 3.426087 1.460870 0.2391304
## 2 versicolor 5.934783 2.773913 4.273913 1.3217391
## 3 virginica 6.593478 2.965217 5.536957 2.0304348
## Descartar el valor más próximo a la media
dist_abs<-abs(iris3[,3,1]-mean(iris3[,3,1]))
dist_abs
## [1] 0.062 0.062 0.162 0.038 0.062 0.238 0.062 0.038 0.062 0.038 0.038 0.138
## [13] 0.062 0.362 0.262 0.038 0.162 0.062 0.238 0.038 0.238 0.038 0.462 0.238
## [25] 0.438 0.138 0.138 0.038 0.062 0.138 0.138 0.038 0.038 0.062 0.038 0.262
## [37] 0.162 0.062 0.162 0.038 0.162 0.162 0.162 0.138 0.438 0.062 0.138 0.062
## [49] 0.038 0.062
esc_dis_min<-min(dist_abs)
v_dis_min<-(esc_dis_min==dist_abs)
quitar<-which(dist_abs==esc_dis_min)
mean(iris3[-quitar,3,1])
## [1] 1.448649
prom_min_dist<-function(x){
dist_abs<-abs(x-mean(x))
esc_dis_min<-min(dist_abs)
v_dis_min<-(esc_dis_min==dist_abs)
quitar<-which(dist_abs==esc_dis_min)
mean(x[-quitar])}
prom_min_dist(iris3[,3,1])
## [1] 1.448649
21/09/21
#Funciones personalizadas mas complejas
#ingreso de una tabla
#(descomponerla o sacar correlaciones)
eigen(cor(iris[,-5]))
## eigen() decomposition
## $values
## [1] 2.91849782 0.91403047 0.14675688 0.02071484
##
## $vectors
## [,1] [,2] [,3] [,4]
## [1,] 0.5210659 -0.37741762 0.7195664 0.2612863
## [2,] -0.2693474 -0.92329566 -0.2443818 -0.1235096
## [3,] 0.5804131 -0.02449161 -0.1421264 -0.8014492
## [4,] 0.5648565 -0.06694199 -0.6342727 0.5235971
descomposi<-function(w){
return(eigen(cor(w))$values)
}
descomposi(iris3[,,1])
## [1] 2.0585402 1.0221782 0.6678202 0.2514613
descomposi(iris3[,1:3,1])
## [1] 1.8581925 0.8902232 0.2515843
descomposi(iris3[1:10,,2])
## [1] 3.3419155 0.3638825 0.2326014 0.0616007
descomposi2<-function(w){
lista1<-eigen(cor(w))
return(list(lista1$vectors,lista1$values))
}
descomposi2(iris3[,,1])[[1]][,1]
## [1] 0.6044164 0.5756194 0.3754348 0.4029788
descomposi2(iris3[,,1])[[2]][3]
## [1] 0.6678202
descomposi3<-function(w){
lista1<-eigen(cor(w))
return(list(Vector=lista1$vectors,
Valores=lista1$values))
}
descomposi3(iris3[,,1])$Valores[2]
## [1] 1.022178
descomposi3(iris3[,,1])$Vector[1,1]
## [1] 0.6044164
## Ingreso de dos o mas argumentos
## (resolver sistema de ecuaciones)
coeficiente<-matrix(c(3,2,1,5,3,4,1,1,-1),
ncol = 3, byrow = T)
respuesta<-c(1,2,1)
solve(coeficiente,respuesta)
## [1] -4 6 1
res_ecua<-function(matriz,respu){
solve(matriz,respu)}
res_ecua2<-function(matriz,respu){
solucion<-solve(matriz,respu)
return(paste0("La solucion al sistema es : x = ",
solucion[1]))}
res_ecua2(coeficiente, respuesta)
## [1] "La solucion al sistema es : x = -3.99999999999999"
coef2<-matrix(c(5,-3,-1,1,4,-6,2,3,4),
ncol = 3, byrow = T)
respuesta2<-c(1,-1,9)
res_ecua2(coef2,respuesta2)
## [1] "La solucion al sistema es : x = 1"
res_ecua3<-function(matriz,respu){
solucion<-solve(matriz,respu)
return(paste0("La solucion al sistema es : x = ",
solucion[1], ", ",
" y = ", solucion[2], ", ",
" z = ",solucion[3]))}
res_ecua3(coef2,respuesta2)
## [1] "La solucion al sistema es : x = 1, y = 1, z = 1"
res_ecua4<-function(matriz,respu){
solucion<-solve(matriz,respu)
return(cat("La solucion al sistema es:", "\n",
"x = ",
solucion[1], "\n",
"y = ", solucion[2], "\n",
"z = ",solucion[3]))}
res_ecua4(coef2,respuesta2)
## La solucion al sistema es:
## x = 1
## y = 1
## z = 1
### Formato de fechas
covid_oaxaca<-read.csv("C:\\Users\\divis\\Documents\\METPOL\\Semestre 1\\Manejo de BDD\\Manejo fechas y emparejamiento. Caso COVID, Oaxaca 2020-20210921\\covid_oaxaca.csv")
fallecidos_oaxaca<-read.csv("C:\\Users\\divis\\Documents\\METPOL\\Semestre 1\\Manejo de BDD\\Manejo fechas y emparejamiento. Caso COVID, Oaxaca 2020-20210921\\fallecidos.csv")
str(covid_oaxaca)
## 'data.frame': 33367 obs. of 7 variables:
## $ X : int 195 297 334 406 491 556 572 630 919 930 ...
## $ ENTIDAD_RES : int 20 20 20 20 20 20 20 20 20 20 ...
## $ MUNICIPIO_RES : int 413 45 278 399 67 43 390 174 67 45 ...
## $ FECHA_INGRESO : chr "2020-04-06" "2020-03-31" "2020-04-04" "2020-03-27" ...
## $ FECHA_SINTOMAS: chr "2020-03-26" "2020-03-26" "2020-03-28" "2020-03-26" ...
## $ FECHA_DEF : chr "2020-04-11" "9999-99-99" "9999-99-99" "2020-03-29" ...
## $ TIEM_SINT_HOSP: int 11 5 7 1 6 1 2 6 1 4 ...
## 'data.frame': 129018 obs. of 39 variables:
## $ X : int 3 6 15 16 19 22 27 30 31 35 ...
## $ FECHA_ACTUALIZACION: chr "2020-10-28" "2020-10-28" "2020-10-28" "2020-10-28" ...
## $ ID_REGISTRO : chr "0e7853" "0a9217" "043f64" "0e07d8" ...
## $ ORIGEN : int 1 1 2 1 1 2 1 1 1 1 ...
## $ SECTOR : int 13 4 4 4 12 4 12 4 4 4 ...
## $ ENTIDAD_UM : int 21 9 9 15 9 14 9 15 10 2 ...
## $ SEXO : int 1 2 2 2 2 2 1 2 2 1 ...
## $ ENTIDAD_NAC : int 21 9 9 15 9 9 21 9 10 2 ...
## $ ENTIDAD_RES : int 21 9 9 15 9 14 9 15 10 2 ...
## $ MUNICIPIO_RES : int 85 5 10 104 15 67 15 121 7 2 ...
## $ TIPO_PACIENTE : int 2 2 2 2 1 2 2 2 2 2 ...
## $ FECHA_INGRESO : chr "2020-03-28" "2020-03-26" "2020-03-26" "2020-03-28" ...
## $ FECHA_SINTOMAS : chr "2020-03-23" "2020-03-26" "2020-03-26" "2020-03-28" ...
## $ FECHA_DEF : chr "2020-04-05" "2020-04-02" "2020-03-30" "2020-04-02" ...
## $ INTUBADO : int 2 2 2 2 97 2 1 2 2 2 ...
## $ NEUMONIA : int 1 2 1 1 1 1 1 1 1 1 ...
## $ EDAD : int 73 94 58 49 54 42 83 49 73 62 ...
## $ NACIONALIDAD : int 1 1 1 1 1 1 1 1 1 1 ...
## $ EMBARAZO : int 2 97 97 97 97 97 2 97 97 2 ...
## $ HABLA_LENGUA_INDIG : int 2 2 2 1 2 2 2 2 2 2 ...
## $ INDIGENA : int 2 2 2 2 2 2 2 2 2 2 ...
## $ DIABETES : int 2 2 1 2 1 2 1 1 1 2 ...
## $ EPOC : int 2 2 1 2 2 2 2 2 2 1 ...
## $ ASMA : int 2 2 2 2 2 2 2 2 2 2 ...
## $ INMUSUPR : int 2 2 2 2 2 2 2 2 2 2 ...
## $ HIPERTENSION : int 1 2 1 2 2 2 2 1 1 1 ...
## $ OTRA_COM : int 2 2 2 2 2 2 2 1 2 2 ...
## $ CARDIOVASCULAR : int 2 1 2 2 2 2 2 2 2 2 ...
## $ OBESIDAD : int 1 2 2 2 2 1 2 2 2 2 ...
## $ RENAL_CRONICA : int 2 2 1 2 2 2 2 1 2 1 ...
## $ TABAQUISMO : int 2 2 2 2 2 2 2 1 2 1 ...
## $ OTRO_CASO : int 2 99 99 99 1 2 1 99 99 99 ...
## $ TOMA_MUESTRA : int 1 1 1 1 1 1 1 1 1 1 ...
## $ RESULTADO_LAB : int 1 1 1 1 1 1 1 1 1 1 ...
## $ CLASIFICACION_FINAL: int 3 3 3 3 3 3 3 3 3 3 ...
## $ MIGRANTE : int 99 99 99 99 99 99 99 99 99 99 ...
## $ PAIS_NACIONALIDAD : chr "México" "México" "México" "México" ...
## $ PAIS_ORIGEN : chr "97" "97" "97" "97" ...
## $ UCI : int 2 2 1 2 97 2 2 2 2 2 ...
# Formato = fechas
#fechas sin hora = as.date
#Fechas con hora = strptime
?as.Date
# visualizar covid_oaxaca$FECHA_INGRESO
funcionas2<-as.Date(covid_oaxaca$FECHA_INGRESO,
format = "%Y-%m-%d")
funcionas3<-as.Date(covid_oaxaca$FECHA_SINTOMAS,
format = "%Y-%m-%d")
library(lubridate)
##
## Attaching package: 'lubridate'
## The following objects are masked from 'package:base':
##
## date, intersect, setdiff, union
##
## 1 2 3 4 5 6 7 8 9 10
## 162 149 384 912 3358 6812 7155 4721 5233 4481
summary(as.numeric(funcionas2-funcionas3))
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.000 2.000 3.000 3.619 5.000 68.000
boxplot(as.numeric(funcionas2-funcionas3))
28/09/21
## ¿Y si tenemos hora y fecha de un evento?
##Crear función para cambiar formatos a fechas
bosque<-read.csv("C:\\Users\\divis\\Downloads\\Manejo de Fechas-20210928\\Datos bosque Harvard.csv")
dim(bosque)
## [1] 584352 30
#Obtener la direccion del archivo de trabajo
#getwd()
#setwd()
bosque$datetime[1]
## [1] "2005-01-01T00:15"
fechax<-substr(bosque$datetime[1], 1,10)
horax<-substr(bosque$datetime[1], 12,16)
hora_fechx<-paste0(fechax," ", horax)
hora_fechaxx<-strptime(hora_fechx,
format = "%Y-%m-%d %H:%M")
strsplit(bosque$datetime[1],"T")
## [[1]]
## [1] "2005-01-01" "00:15"
## [1] 0
## [1] 15
## [1] 2005
## [1] 1
## [1] 1
# Hacer funcion que transforme 2005-01-01T00:15
# a una de tipo strptime
trans_fecha_p<-function(){
separado<-strsplit(bosque$datetime,
"T")
fecha_fi<-separado[[]]}
trans_fecha<-function(dia_fecha){
fechax<-substr(dia_fecha,1,10)
horax<-substr(dia_fecha,12,16)
hora_fechx<-paste0(fechax," ",horax)
return(hora_fechx)
}
trans_fecha(bosque$datetime[2])
## [1] "2005-01-01 00:30"
#apply por filas? Por columnas? Pero aquí queremos
#por cada elemento de un vector!!
trans_fecha2<-function(trans_fecha){
vecto_lar<-unlist(strsplit(as.character(trans_fecha),"T"))
return(paste0(vecto_lar[1]," ",vecto_lar[2])) }
uli_<-unlist(lapply(bosque$datetime,
FUN = trans_fecha))
uli_sap<-sapply(bosque$datetime, FUN = trans_fecha)
datetime2<-trans_fecha(bosque$datetime)
bosque$datetime22<-datetime2
# Temperatura promedio en los meses
#month(bosque$datetime22)
bosque$mes_registro<-month(bosque$datetime22)
aggregate(airt~mes_registro, FUN = mean,
data = bosque)
## mes_registro airt
## 1 1 -4.4354325
## 2 2 -3.5182661
## 3 3 0.7246007
## 4 4 7.2847304
## 5 5 13.3104319
## 6 6 17.9437049
## 7 7 20.9478956
## 8 8 19.8952857
## 9 9 16.1440116
## 10 10 9.8309351
## 11 11 3.8887324
## 12 12 -1.5565650
# Temperatura promedio por año
bosque$año_registro<-year(bosque$datetime22)
aggregate(airt~año_registro, FUN = mean,
data = bosque)
## año_registro airt
## 1 2005 8.098615
## 2 2006 8.971521
## 3 2007 7.848312
## 4 2008 7.988106
## 5 2009 7.630917
## 6 2010 9.025195
## 7 2011 8.746093
## 8 2012 9.490905
## 9 2013 8.095751
## 10 2014 7.493287
## 11 2015 8.102295
## 12 2016 8.968480
## 13 2017 8.576417
## 14 2018 8.490829
## 15 2019 7.929258
## 16 2020 9.164283
## 17 2021 9.486828
# ¿Cuando es menor la temperatura promedio?
# ¿Entre 3am y 6 am o entre 10pm y 11:59pm?
bosque$hora_registro<-hour(bosque$datetime22)
mean(as.numeric(bosque$airt[which(bosque$hora_registro==(3:5))]))
## [1] NA
## [1] NA
aggregate(airt~hora_registro, FUN = mean,
data = bosque)
## hora_registro airt
## 1 0 6.322022
## 2 1 6.034637
## 3 2 5.783765
## 4 3 5.557917
## 5 4 5.355666
## 6 5 5.293780
## 7 6 5.815016
## 8 7 6.754419
## 9 8 7.915150
## 10 9 9.128418
## 11 10 10.211427
## 12 11 11.079078
## 13 12 11.743171
## 14 13 12.174090
## 15 14 12.375936
## 16 15 12.259656
## 17 16 11.711932
## 18 17 10.710056
## 19 18 9.462751
## 20 19 8.431527
## 21 20 7.819401
## 22 21 7.378303
## 23 22 6.999359
## 24 23 6.649224
val_22_24<-c(6.649224,6.999359)
val_3_6<-c(5.557917,5.355666,5.293780)
mean(val_3_6)
## [1] 5.402454
## [1] 6.824292
#
grupo1<-which(hour(bosque$datetime22)>=3 & hour(bosque$datetime22)<=5)
grupo1<-which(hour(bosque$datetime22)>=22 & hour(bosque$datetime22)<=23)
mean(bosque[grupo1,3], nar.rm=T)
## [1] NA
mean(bosque[grupo1,3], nar.rm=T)
## [1] NA
## funcion del profesor
grupo1<-which(hour(bosque$datetime22)>=3 & hour(bosque$datetime22)<6)
grupo2<-which(hour(bosque$datetime22)>=22 & hour(bosque$datetime22)<=23)
mean(bosque[grupo1,3],na.rm = TRUE)
## [1] 5.402454
mean(bosque[grupo2,3],na.rm = TRUE)
## [1] 6.824291
#La temperatura entre 3 y 5:59 es más baja
#Otra manera
grupo11<-c(which(hour(bosque$datetime22)==3),
which(hour(bosque$datetime22)==4),
which(hour(bosque$datetime22)==5) )
grupo22<-c(which(hour(bosque$datetime22)==22),
which(hour(bosque$datetime22)==23) )
mean(bosque[grupo11,3],na.rm=TRUE)
## [1] 5.402454
mean(bosque[grupo22,3],na.rm=TRUE)
## [1] 6.824291
pruebaxxs<-"Clase de, R en, la METPOL"
substr(pruebaxxs,9,22)
## [1] ", R en, la MET"
strsplit(pruebaxxs,",") # separa texto en una condicion
## [[1]]
## [1] "Clase de" " R en" " la METPOL"
05/10/21
### Gráfico y tablas realcionadas
datos_covid20<-read.csv("C:\\Users\\divis\\Downloads\\COVID2020_5estados.csv")
catalo_enti<-read_excel("C:\\Users\\divis\\Downloads\\201128 Catalogos.xlsx",
sheet = "Catálogo de ENTIDADES")
catalo_sexo<-read_excel("C:\\Users\\divis\\Downloads\\201128 Catalogos.xlsx",
sheet = "Catálogo SEXO")
catalo_muni<-read_excel("C:\\Users\\divis\\Downloads\\201128 Catalogos.xlsx",
sheet = "Catálogo MUNICIPIOS")
#datos_covid20$ENTIDAD_UM
#catalo_enti$CLAVE_ENTIDAD
# Emparejar tablas
empate_estadoUM<-merge(datos_covid20, catalo_enti,
by.x = "ENTIDAD_UM",
by.y = "CLAVE_ENTIDAD", sort = F)
# Ordenar según una columna
C_Hw2_<-empate_estadoUM[sort(empate_estadoUM$ENTIDAD_UM, decreasing = F),]
dim(empate_estadoUM)
## [1] 149564 41
## [1] 149564 39
empate_estadoUM2<-merge(empate_estadoUM, catalo_sexo,
by.x = "SEXO", by.y = "CLAVE", sort = F)
dim(empate_estadoUM2)
## [1] 149564 42
table(empate_estadoUM2$DESCRIPCIÓN,
empate_estadoUM2$ENTIDAD_FEDERATIVA)
##
## AGUASCALIENTES BAJA CALIFORNIA BAJA CALIFORNIA SUR CAMPECHE
## HOMBRE 16138 29342 16162 11145
## MUJER 18606 32378 17365 8428
# ¿Proporción de mujeres con COVID en cada estado?
### Tarea
head(empate_estadoUM2)
## SEXO ENTIDAD_UM X FECHA_ACTUALIZACION ID_REGISTRO ORIGEN SECTOR
## 1 1 3 5 2020-10-28 016eda 2 12
## 2 1 3 2092469 2020-10-28 2191c4 2 12
## 3 1 3 815907 2020-10-28 0230b3 2 12
## 4 1 2 1000386 2020-10-28 413aae 2 4
## 5 1 3 2174118 2020-10-28 246614 2 12
## 6 1 3 815953 2020-10-28 1a3b55 1 4
## ENTIDAD_NAC ENTIDAD_RES MUNICIPIO_RES TIPO_PACIENTE FECHA_INGRESO
## 1 14 3 8 1 2020-03-30
## 2 3 3 3 1 2020-10-22
## 3 25 3 8 1 2020-09-02
## 4 21 2 4 1 2020-09-24
## 5 9 3 8 1 2020-10-24
## 6 20 3 3 1 2020-07-15
## FECHA_SINTOMAS FECHA_DEF INTUBADO NEUMONIA EDAD NACIONALIDAD EMBARAZO
## 1 2020-03-23 9999-99-99 97 2 29 1 2
## 2 2020-10-21 9999-99-99 97 2 31 1 2
## 3 2020-08-28 9999-99-99 97 2 40 1 2
## 4 2020-09-20 9999-99-99 97 2 50 1 2
## 5 2020-10-20 9999-99-99 97 2 32 1 2
## 6 2020-07-13 9999-99-99 97 2 49 1 2
## HABLA_LENGUA_INDIG INDIGENA DIABETES EPOC ASMA INMUSUPR HIPERTENSION OTRA_COM
## 1 2 2 2 2 2 2 2 2
## 2 2 2 2 2 2 2 2 2
## 3 2 2 2 2 2 2 2 2
## 4 2 2 2 2 2 2 2 2
## 5 2 2 2 2 2 2 2 2
## 6 2 2 2 2 2 2 2 2
## CARDIOVASCULAR OBESIDAD RENAL_CRONICA TABAQUISMO OTRO_CASO TOMA_MUESTRA
## 1 2 2 2 2 1 1
## 2 2 2 2 2 1 1
## 3 2 2 2 2 2 1
## 4 2 2 2 2 1 1
## 5 2 2 2 2 1 1
## 6 2 2 2 2 1 1
## RESULTADO_LAB CLASIFICACION_FINAL MIGRANTE PAIS_NACIONALIDAD PAIS_ORIGEN UCI
## 1 1 3 99 México 97 97
## 2 1 3 99 México 97 97
## 3 1 3 99 México 97 97
## 4 1 3 99 México 97 97
## 5 2 7 99 México 97 97
## 6 1 3 99 México 97 97
## ENTIDAD_FEDERATIVA ABREVIATURA DESCRIPCIÓN
## 1 BAJA CALIFORNIA SUR BS MUJER
## 2 BAJA CALIFORNIA SUR BS MUJER
## 3 BAJA CALIFORNIA SUR BS MUJER
## 4 BAJA CALIFORNIA BC MUJER
## 5 BAJA CALIFORNIA SUR BS MUJER
## 6 BAJA CALIFORNIA SUR BS MUJER
aggregate(empate_estadoUM2$DESCRIPCIÓN~ENTIDAD_FEDERATIVA,
empate_estadoUM2, length)
## ENTIDAD_FEDERATIVA empate_estadoUM2$DESCRIPCIÓN
## 1 AGUASCALIENTES 34744
## 2 BAJA CALIFORNIA 61720
## 3 BAJA CALIFORNIA SUR 33527
## 4 CAMPECHE 19573
length(empate_estadoUM2$DESCRIPCIÓN)
## [1] 149564
rea_sex<-which(empate_estadoUM2$SEXO==2)
empate_estadoUM2$SEXO[rea_sex]<-"0"
tot_pob<-c(34744,61720,33527,19573)
aggregate(as.numeric(empate_estadoUM2$SEXO)~ENTIDAD_FEDERATIVA,
empate_estadoUM2, sum)
## ENTIDAD_FEDERATIVA as.numeric(empate_estadoUM2$SEXO)
## 1 AGUASCALIENTES 18606
## 2 BAJA CALIFORNIA 32378
## 3 BAJA CALIFORNIA SUR 17365
## 4 CAMPECHE 8428
tot_muj<-c(18606,32378,17365,8428)
Entidad_F<-c("AGUASCALIENTES","BAJA CALIFORNIA",
"BAJA CALIFORNIA SUR","CAMPECHE")
inf_pob<-data.frame(Entidad_F, tot_pob, tot_muj,
prop_muj = tot_muj/tot_pob)
inf_pob
## Entidad_F tot_pob tot_muj prop_muj
## 1 AGUASCALIENTES 34744 18606 0.5355169
## 2 BAJA CALIFORNIA 61720 32378 0.5245949
## 3 BAJA CALIFORNIA SUR 33527 17365 0.5179408
## 4 CAMPECHE 19573 8428 0.4305932
###########################################################
merge(datos_covid20,catalo_enti,by.x = "ENTIDAD_UM",by.y="CLAVE_ENTIDAD",all.x=TRUE)
12/10/21
tabla_munic<-merge(datos_covid20,catalo_muni,
by.x=c("ENTIDAD_RES","MUNICIPIO_RES"),
by.y=c("CLAVE_ENTIDAD","CLAVE_MUNICIPIO"),
all.x = T, sort = F)
head(datos_covid20$ENTIDAD_FEDERATIVA)
## NULL
tablasss<-table(datos_covid20$ENTIDAD_UM, datos_covid20$SEXO)
table(datos_covid20$ENTIDAD_UM,datos_covid20$INTUBADO)
##
## 1 2 97 99
## 1 624 3642 30269 209
## 2 1943 9196 50206 375
## 3 434 2273 30628 192
## 4 338 2649 16564 22
