#ANALSIS DE DISCRIMIANANTE CUADRATICO
library(mclust)
## Warning: package 'mclust' was built under R version 4.3.3
## Package 'mclust' version 6.1.1
## Type 'citation("mclust")' for citing this R package in publications.
library(knitr)
## Warning: package 'knitr' was built under R version 4.3.3
data(banknote)
#se recodifican las clases de la variable Status: verdadero = 0, falso= 1
levels(banknote$Status)
## [1] "counterfeit" "genuine"
levels(banknote$Status) <- c("falso","verdadero")
kable(head(banknote))
| verdadero |
214.8 |
131.0 |
131.1 |
9.0 |
9.7 |
141.0 |
| verdadero |
214.6 |
129.7 |
129.7 |
8.1 |
9.5 |
141.7 |
| verdadero |
214.8 |
129.7 |
129.7 |
8.7 |
9.6 |
142.2 |
| verdadero |
214.8 |
129.7 |
129.6 |
7.5 |
10.4 |
142.0 |
| verdadero |
215.0 |
129.6 |
129.7 |
10.4 |
7.7 |
141.8 |
| verdadero |
215.7 |
130.8 |
130.5 |
9.0 |
10.1 |
141.4 |
library(ggplot2)
## Warning: package 'ggplot2' was built under R version 4.3.3
library(ggpubr)
## Warning: package 'ggpubr' was built under R version 4.3.3
p1 <- ggplot(data = banknote, aes(x = Length, fill = Status)) + geom_histogram(position = "identity", alpha = 0.5)
p2 <- ggplot(data = banknote, aes(x = Left, fill = Status)) + geom_histogram(position = "identity", alpha = 0.5)
p3 <- ggplot(data = banknote, aes(x = Right, fill = Status)) + geom_histogram(position = "identity", alpha = 0.5)
p4 <- ggplot(data = banknote, aes(x = Bottom, fill = Status)) + geom_histogram(position = "identity", alpha = 0.5)
p5 <- ggplot(data = banknote, aes(x = Top, fill = Status)) + geom_histogram(position = "identity", alpha = 0.5)
ggarrange(p1, p2, p3, p4, p5, nrow = 5, common.legend = TRUE, legend = "bottom")
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
pairs(x = banknote[,-1], col = c("firebrick", "green3")[banknote$Status], pch = 20)
# Representación mediante Histograma de cada variable para cada tipo de billete par(mfcol = c(2, 6))
for (k in 2:7) {
j0 <- names(banknote)[k]
x0 <- seq(min(banknote[, k]), max(banknote[, k]), le = 50)
for (i in 1:2) {
i0 <- levels(banknote$Status)[i]
x <- banknote[banknote$Status == i0, j0]
hist(x, proba = T, col = grey(0.8), main = paste( i0), xlab = j0)
lines(x0, dnorm(x0, mean(x), sd(x)), col = "red", lwd = 2)
}
}
# Representación de cuantiles normales de cada variable para cada tipo de billete
for (k in 2:7) {
j0 <- names(banknote)[k]
x0 <- seq(min(banknote[, k]), max(banknote[, k]), le = 50)
for (i in 1:2) {
i0 <- levels(banknote$Status)[i]
x <- banknote[banknote$Status == i0, j0]
qqnorm(x, main = paste(i0, j0), pch = 19, col = i + 1)
# los colores 2 y 3 son el rojo y verde
qqline(x)
}
}
#Contraste de normalidad Shapiro-Wilk para cada variable en cada tipo de billete
library(reshape2)
## Warning: package 'reshape2' was built under R version 4.3.3
library(knitr)
library(dplyr)
## Warning: package 'dplyr' was built under R version 4.3.3
##
## Attaching package: 'dplyr'
##
## The following objects are masked from 'package:stats':
##
## filter, lag
##
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
datos_tidy <- melt(banknote, value.name = "valor")
## Using Status as id variables
datos_tidy %>% group_by(Status, variable) %>%
summarise(p_value_Shapiro.test = round(shapiro.test(valor)$p.value,5
))
## `summarise()` has grouped output by 'Status'. You can override using the
## `.groups` argument.
## # A tibble: 12 × 3
## # Groups: Status [2]
## Status variable p_value_Shapiro.test
## <fct> <fct> <dbl>
## 1 falso Length 0.0029
## 2 falso Left 0.0237
## 3 falso Right 0.0168
## 4 falso Bottom 0.0112
## 5 falso Top 0.0491
## 6 falso Diagonal 0.00003
## 7 verdadero Length 0.257
## 8 verdadero Left 0.00825
## 9 verdadero Right 0.0117
## 10 verdadero Bottom 0.0403
## 11 verdadero Top 0.0498
## 12 verdadero Diagonal 0.0033
detach(package:mclust, unload = TRUE)
library(MVN)
## Warning: package 'MVN' was built under R version 4.3.3
outliers <- mvn(data = banknote[,-1], mvnTest = "hz", multivariateOutlierMethod = "quan")
royston_test <- mvn(data = banknote[,-1], mvnTest = "royston", multivariatePlot = "qq")
hz_test <- mvn(data = banknote[,-1], mvnTest = "hz")
hz_test$multivariateNormality
## Test HZ p value MVN
## 1 Henze-Zirkler 1.780591 0 NO
library(biotools)
## Warning: package 'biotools' was built under R version 4.3.3
## Loading required package: MASS
##
## Attaching package: 'MASS'
##
## The following object is masked from 'package:dplyr':
##
## select
##
## ---
## biotools version 4.2
boxM(data = banknote[, -1], grouping = banknote[, 1])
##
## Box's M-test for Homogeneity of Covariance Matrices
##
## data: banknote[, -1]
## Chi-Sq (approx.) = 121.9, df = 21, p-value = 3.198e-16
library(MASS)
modelo_qda <- qda(formula = Status ~ ., data = banknote, prior = c(0.01, 0.99))
modelo_qda
## Call:
## qda(Status ~ ., data = banknote, prior = c(0.01, 0.99))
##
## Prior probabilities of groups:
## falso verdadero
## 0.01 0.99
##
## Group means:
## Length Left Right Bottom Top Diagonal
## falso 214.823 130.300 130.193 10.530 11.133 139.450
## verdadero 214.969 129.943 129.720 8.305 10.168 141.517
predicciones <- predict(object = modelo_qda, newdata = banknote)
table(banknote$Status, predicciones$class,
dnn = c("Clase real", "Clase predicha"))
## Clase predicha
## Clase real falso verdadero
## falso 99 1
## verdadero 0 100
trainig_error <- mean(banknote$Status != predicciones$class) * 100
paste("trainig_error=", trainig_error, "%")
## [1] "trainig_error= 0.5 %"
library(klaR)
## Warning: package 'klaR' was built under R version 4.3.3
partimat(formula = Status ~ ., data = banknote, prior = c(0.01, 0.99),
method = "qda", prec = 200,
image.colors = c("darkgoldenrod1", "skyblue2"),
col.mean = "firebrick", nplots.vert = 4)
