USArrests
Daniel Zárate - A01285561
2025-02-21
Contexto
La base de datos USArrests contiene estadísticas en arrestos por cada 100,000 residentes por agresión, asesinato y violación en cada uno de los 50 estados de E.E.U.U. en 1973.
Instalar paquetes y llamar librerias
#install.packages("caret") # Algoritmos de aprendizaje automático
library(caret)
#install.packages("datasets") # Para usar la base de datos "USArrests"
library(datasets)
#install.packages("ggplot2") # Gráficas con mejor diseño
library(ggplot2)
#install.packages("lattice") # Crear gráficos
library(lattice)
#install.packages("DataExplorer") # Análisis Descriptivo
library(DataExplorer)
#install.packages("kernlab") # Modelos de SVM
library(kernlab)
#install.packages("dplyr") # Manipulación de datos
library(dplyr)
library(cluster)
library(factoextra)
library(data.table)
library(tidyverse)
#install.packages("tigris")
library(tigris)
library(randomForest)
library(sf)
library(shiny)Importar las bases de datos
datos <- USArrests
datos_escalados <- scale(datos)Configurar tigris para descargar el mapa de EE.UU.
options(tigris_use_cache = TRUE)
us_map <- tigris::states(cb = TRUE)## Retrieving data for the year 2021## | | | 0% | |= | 1% | |= | 2% | |== | 2% | |== | 3% | |=== | 4% | |==== | 5% | |==== | 6% | |===== | 7% | |===== | 8% | |====== | 8% | |====== | 9% | |======= | 10% | |======== | 11% | |======== | 12% | |========= | 12% | |========= | 13% | |========== | 14% | |========== | 15% | |=========== | 15% | |=========== | 16% | |============ | 17% | |============ | 18% | |============= | 18% | |============= | 19% | |============== | 19% | |============== | 20% | |============== | 21% | |=============== | 21% | |=============== | 22% | |================ | 23% | |================ | 24% | |================= | 24% | |================== | 26% | |=================== | 27% | |==================== | 28% | |==================== | 29% | |===================== | 29% | |===================== | 30% | |===================== | 31% | |====================== | 31% | |====================== | 32% | |======================= | 33% | |======================== | 34% | |========================= | 35% | |========================= | 36% | |========================== | 37% | |========================== | 38% | |=========================== | 39% | |=============================== | 44% | |================================ | 45% | |================================ | 46% | |================================= | 47% | |================================= | 48% | |================================== | 48% | |=================================== | 50% | |==================================== | 51% | |======================================= | 56% | |======================================== | 57% | |========================================= | 58% | |========================================== | 59% | |============================================= | 64% | |================================================ | 68% | |================================================ | 69% | |================================================= | 70% | |================================================== | 71% | |=================================================== | 73% | |===================================================== | 76% | |====================================================== | 77% | |======================================================= | 78% | |======================================================== | 81% | |========================================================= | 82% | |========================================================== | 83% | |=========================================================== | 84% | |=========================================================== | 85% | |============================================================ | 86% | |============================================================= | 86% | |============================================================= | 87% | |============================================================= | 88% | |============================================================== | 88% | |=============================================================== | 90% | |================================================================ | 91% | |=================================================================== | 95% | |======================================================================| 100%Entrenar modelo Random Forest
set.seed(123)
segmentos <- kmeans(datos_escalados, centers = 4, nstart = 25)
asignacion <- cbind(datos, cluster = segmentos$cluster)Normalizar Nombres de los Estados
asignacion$state <- tolower(rownames(asignacion))
us_map$NAME <- tolower(us_map$NAME)Asignar niveles de Seguridad
asignacion$nivel_seguridad <- factor(case_when(
asignacion$cluster == 1 ~ "Bajo",
asignacion$cluster == 2 ~ "Medio",
asignacion$cluster == 3 ~ "Alto",
asignacion$cluster == 4 ~ "Muy Alto",
TRUE ~ "Desconocido"
))Entrenar el modelo Random Forest
modelo_rf <- randomForest(
nivel_seguridad ~ Murder + Assault + Rape + UrbanPop,
data = asignacion,
ntree = 100
)Interfaz de Usuario (UI)
ui <- fluidPage(
titlePanel("Predicción de Seguridad en EE.UU."),
sidebarLayout(
sidebarPanel(
h4("Ingrese sus datos para predicción"),
numericInput("murder", "Asesinatos por 100,000 hab.:", value = 10, min = 0),
numericInput("assault", "Agresiones por 100,000 hab.:", value = 200, min = 0),
numericInput("rape", "Violaciones por 100,000 hab.:", value = 20, min = 0),
numericInput("urbanpop", "Porcentaje de población urbana:", value = 50, min = 0, max = 100),
actionButton("predict", "Predecir Seguridad"),
hr(),
h4("Predicción del nivel de seguridad"),
verbatimTextOutput("prediction_output")
),
mainPanel(
tabsetPanel(
tabPanel("Mapa de Seguridad",
plotOutput("mapaPlot")
),
tabPanel("Estados Más y Menos Seguros",
tableOutput("top5_safe"),
tableOutput("top5_unsafe")
)
)
)
)
)
# Servidor (Server)
server <- function(input, output, session) {
# Predecir el nivel de seguridad basado en la entrada del usuario
observeEvent(input$predict, {
new_data <- data.frame(
Murder = input$murder,
Assault = input$assault,
Rape = input$rape,
UrbanPop = input$urbanpop
)
prediccion <- predict(modelo_rf, new_data)
output$prediction_output <- renderPrint({ paste("Nivel de Seguridad:", prediccion) })
})
# Graficar el mapa con los clusters de seguridad
output$mapaPlot <- renderPlot({
us_clustered <- left_join(us_map, asignacion, by = c("NAME" = "state"))
colores_seguridad <- c("Bajo" = "darkgreen",
"Medio" = "yellow",
"Alto" = "orange",
"Muy Alto" = "red")
ggplot(data = us_clustered) +
geom_sf(aes(fill = nivel_seguridad), color = "black", size = 0.3) +
scale_fill_manual(values = colores_seguridad, name = "Nivel de Seguridad") +
labs(title = "Mapa de Seguridad en EE.UU. (1973)",
subtitle = "Clasificación basada en tasas de criminalidad",
caption = "Fuente: USArrests") +
theme_minimal()
})
output$top5_safe <- renderTable({
asignacion %>%
arrange(Murder + Assault + Rape) %>%
head(5) %>%
select(state, Murder, Assault, Rape, nivel_seguridad)
}, caption = "🟢 Estados Más Seguros")
output$top5_unsafe <- renderTable({
asignacion %>%
arrange(desc(Murder + Assault + Rape)) %>%
head(5) %>%
select(state, Murder, Assault, Rape, nivel_seguridad)
}, caption = "🔴 Estados Más Inseguros")
}
shinyApp(ui = ui, server = server)Shiny applications not supported in static R Markdown documents
LS0tDQp0aXRsZTogIlVTQXJyZXN0cyINCmF1dGhvcjogIkRhbmllbCBaw6FyYXRlIC0gQTAxMjg1NTYxIg0KZGF0ZTogIjIwMjUtMDItMjEiDQpvdXRwdXQ6DQogIGh0bWxfZG9jdW1lbnQ6DQogICAgdG9jOiBUUlVFDQogICAgdG9jX2Zsb2F0OiBUUlVFDQogICAgY29kZV9kb3dubG9hZDogVFJVRQ0KICAgIHRoZW1lOiBqb3VybmFsDQotLS0NCg0KIVtdKEM6XFxUZWNcXDZ0byBzZW1lc3RyZVxcTW9kdWxvIDJccGVycm8uanBnKQ0KDQojIDxzcGFuIHN0eWxlID0iY29sb3I6IHJlZDsiPkNvbnRleHRvPC9zcGFuPg0KDQpMYSBiYXNlIGRlIGRhdG9zICpVU0FycmVzdHMqIGNvbnRpZW5lIGVzdGFkw61zdGljYXMgZW4gYXJyZXN0b3MgcG9yIGNhZGEgMTAwLDAwMCByZXNpZGVudGVzIHBvciBhZ3Jlc2nDs24sIGFzZXNpbmF0byB5IHZpb2xhY2nDs24gZW4gY2FkYSB1bm8gZGUgbG9zIDUwIGVzdGFkb3MgZGUgRS5FLlUuVS4gZW4gMTk3My4NCg0KIyA8c3BhbiBzdHlsZT0iY29sb3I6IHJlZDsiPkluc3RhbGFyIHBhcXVldGVzIHkgbGxhbWFyIGxpYnJlcmlhczwvc3Bhbj4NCmBgYHtyIG1lc3NhZ2U9RkFMU0UsIHdhcm5pbmc9RkFMU0V9DQoNCiNpbnN0YWxsLnBhY2thZ2VzKCJjYXJldCIpICMgQWxnb3JpdG1vcyBkZSBhcHJlbmRpemFqZSBhdXRvbcOhdGljbw0KbGlicmFyeShjYXJldCkNCiNpbnN0YWxsLnBhY2thZ2VzKCJkYXRhc2V0cyIpICMgUGFyYSB1c2FyIGxhIGJhc2UgZGUgZGF0b3MgIlVTQXJyZXN0cyINCmxpYnJhcnkoZGF0YXNldHMpDQojaW5zdGFsbC5wYWNrYWdlcygiZ2dwbG90MiIpICMgR3LDoWZpY2FzIGNvbiBtZWpvciBkaXNlw7FvDQpsaWJyYXJ5KGdncGxvdDIpDQojaW5zdGFsbC5wYWNrYWdlcygibGF0dGljZSIpICMgQ3JlYXIgZ3LDoWZpY29zDQpsaWJyYXJ5KGxhdHRpY2UpDQojaW5zdGFsbC5wYWNrYWdlcygiRGF0YUV4cGxvcmVyIikgIyBBbsOhbGlzaXMgRGVzY3JpcHRpdm8NCmxpYnJhcnkoRGF0YUV4cGxvcmVyKQ0KI2luc3RhbGwucGFja2FnZXMoImtlcm5sYWIiKSAjIE1vZGVsb3MgZGUgU1ZNDQpsaWJyYXJ5KGtlcm5sYWIpDQojaW5zdGFsbC5wYWNrYWdlcygiZHBseXIiKSAjIE1hbmlwdWxhY2nDs24gZGUgZGF0b3MNCmxpYnJhcnkoZHBseXIpDQpsaWJyYXJ5KGNsdXN0ZXIpDQpsaWJyYXJ5KGZhY3RvZXh0cmEpDQpsaWJyYXJ5KGRhdGEudGFibGUpDQpsaWJyYXJ5KHRpZHl2ZXJzZSkNCiNpbnN0YWxsLnBhY2thZ2VzKCJ0aWdyaXMiKQ0KbGlicmFyeSh0aWdyaXMpDQpsaWJyYXJ5KHJhbmRvbUZvcmVzdCkNCmxpYnJhcnkoc2YpDQpsaWJyYXJ5KHNoaW55KQ0KDQpgYGANCg0KIyA8c3BhbiBzdHlsZT0iY29sb3I6IHJlZDsiPkltcG9ydGFyIGxhcyBiYXNlcyBkZSBkYXRvczwvc3Bhbj4NCmBgYHtyfQ0KDQpkYXRvcyA8LSBVU0FycmVzdHMNCmRhdG9zX2VzY2FsYWRvcyA8LSBzY2FsZShkYXRvcykNCg0KYGBgDQoNCiMgPHNwYW4gc3R5bGU9ImNvbG9yOiByZWQ7Ij5Db25maWd1cmFyIHRpZ3JpcyBwYXJhIGRlc2NhcmdhciBlbCBtYXBhIGRlIEVFLlVVLjwvc3Bhbj4NCmBgYHtyfQ0KDQpvcHRpb25zKHRpZ3Jpc191c2VfY2FjaGUgPSBUUlVFKQ0KdXNfbWFwIDwtIHRpZ3Jpczo6c3RhdGVzKGNiID0gVFJVRSkNCg0KYGBgDQoNCiMgPHNwYW4gc3R5bGU9ImNvbG9yOiByZWQ7Ij5FbnRyZW5hciBtb2RlbG8gUmFuZG9tIEZvcmVzdDwvc3Bhbj4NCmBgYHtyfQ0KDQpzZXQuc2VlZCgxMjMpDQpzZWdtZW50b3MgPC0ga21lYW5zKGRhdG9zX2VzY2FsYWRvcywgY2VudGVycyA9IDQsIG5zdGFydCA9IDI1KQ0KYXNpZ25hY2lvbiA8LSBjYmluZChkYXRvcywgY2x1c3RlciA9IHNlZ21lbnRvcyRjbHVzdGVyKQ0KDQpgYGANCg0KIyA8c3BhbiBzdHlsZT0iY29sb3I6IHJlZDsiPk5vcm1hbGl6YXIgTm9tYnJlcyBkZSBsb3MgRXN0YWRvczwvc3Bhbj4NCmBgYHtyfQ0KDQphc2lnbmFjaW9uJHN0YXRlIDwtIHRvbG93ZXIocm93bmFtZXMoYXNpZ25hY2lvbikpDQp1c19tYXAkTkFNRSA8LSB0b2xvd2VyKHVzX21hcCROQU1FKQ0KDQpgYGANCg0KIyA8c3BhbiBzdHlsZT0iY29sb3I6IHJlZDsiPkFzaWduYXIgbml2ZWxlcyBkZSBTZWd1cmlkYWQ8L3NwYW4+DQpgYGB7cn0NCg0KYXNpZ25hY2lvbiRuaXZlbF9zZWd1cmlkYWQgPC0gZmFjdG9yKGNhc2Vfd2hlbigNCiAgYXNpZ25hY2lvbiRjbHVzdGVyID09IDEgfiAiQmFqbyIsDQogIGFzaWduYWNpb24kY2x1c3RlciA9PSAyIH4gIk1lZGlvIiwNCiAgYXNpZ25hY2lvbiRjbHVzdGVyID09IDMgfiAiQWx0byIsDQogIGFzaWduYWNpb24kY2x1c3RlciA9PSA0IH4gIk11eSBBbHRvIiwNCiAgVFJVRSB+ICJEZXNjb25vY2lkbyINCikpDQoNCmBgYA0KDQojIDxzcGFuIHN0eWxlPSJjb2xvcjogcmVkOyI+RW50cmVuYXIgZWwgbW9kZWxvIFJhbmRvbSBGb3Jlc3Q8L3NwYW4+DQpgYGB7cn0NCg0KbW9kZWxvX3JmIDwtIHJhbmRvbUZvcmVzdCgNCiAgbml2ZWxfc2VndXJpZGFkIH4gTXVyZGVyICsgQXNzYXVsdCArIFJhcGUgKyBVcmJhblBvcCwgDQogIGRhdGEgPSBhc2lnbmFjaW9uLA0KICBudHJlZSA9IDEwMA0KKQ0KDQpgYGANCg0KIyA8c3BhbiBzdHlsZT0iY29sb3I6IHJlZDsiPkludGVyZmF6IGRlIFVzdWFyaW8gKFVJKTwvc3Bhbj4NCmBgYHtyfQ0KDQp1aSA8LSBmbHVpZFBhZ2UoDQogIHRpdGxlUGFuZWwoIlByZWRpY2Npw7NuIGRlIFNlZ3VyaWRhZCBlbiBFRS5VVS4iKSwNCiAgDQogIHNpZGViYXJMYXlvdXQoDQogICAgc2lkZWJhclBhbmVsKA0KICAgICAgaDQoIkluZ3Jlc2Ugc3VzIGRhdG9zIHBhcmEgcHJlZGljY2nDs24iKSwNCiAgICAgIG51bWVyaWNJbnB1dCgibXVyZGVyIiwgIkFzZXNpbmF0b3MgcG9yIDEwMCwwMDAgaGFiLjoiLCB2YWx1ZSA9IDEwLCBtaW4gPSAwKSwNCiAgICAgIG51bWVyaWNJbnB1dCgiYXNzYXVsdCIsICJBZ3Jlc2lvbmVzIHBvciAxMDAsMDAwIGhhYi46IiwgdmFsdWUgPSAyMDAsIG1pbiA9IDApLA0KICAgICAgbnVtZXJpY0lucHV0KCJyYXBlIiwgIlZpb2xhY2lvbmVzIHBvciAxMDAsMDAwIGhhYi46IiwgdmFsdWUgPSAyMCwgbWluID0gMCksDQogICAgICBudW1lcmljSW5wdXQoInVyYmFucG9wIiwgIlBvcmNlbnRhamUgZGUgcG9ibGFjacOzbiB1cmJhbmE6IiwgdmFsdWUgPSA1MCwgbWluID0gMCwgbWF4ID0gMTAwKSwNCiAgICAgIGFjdGlvbkJ1dHRvbigicHJlZGljdCIsICJQcmVkZWNpciBTZWd1cmlkYWQiKSwNCiAgICAgIGhyKCksDQogICAgICBoNCgiUHJlZGljY2nDs24gZGVsIG5pdmVsIGRlIHNlZ3VyaWRhZCIpLA0KICAgICAgdmVyYmF0aW1UZXh0T3V0cHV0KCJwcmVkaWN0aW9uX291dHB1dCIpDQogICAgKSwNCiAgICANCiAgICBtYWluUGFuZWwoDQogICAgICB0YWJzZXRQYW5lbCgNCiAgICAgICAgdGFiUGFuZWwoIk1hcGEgZGUgU2VndXJpZGFkIiwNCiAgICAgICAgICAgICAgICAgcGxvdE91dHB1dCgibWFwYVBsb3QiKQ0KICAgICAgICApLA0KICAgICAgICB0YWJQYW5lbCgiRXN0YWRvcyBNw6FzIHkgTWVub3MgU2VndXJvcyIsDQogICAgICAgICAgICAgICAgIHRhYmxlT3V0cHV0KCJ0b3A1X3NhZmUiKSwNCiAgICAgICAgICAgICAgICAgdGFibGVPdXRwdXQoInRvcDVfdW5zYWZlIikNCiAgICAgICAgKQ0KICAgICAgKQ0KICAgICkNCiAgKQ0KKQ0KDQojIFNlcnZpZG9yIChTZXJ2ZXIpDQpzZXJ2ZXIgPC0gZnVuY3Rpb24oaW5wdXQsIG91dHB1dCwgc2Vzc2lvbikgew0KICANCiAgIyBQcmVkZWNpciBlbCBuaXZlbCBkZSBzZWd1cmlkYWQgYmFzYWRvIGVuIGxhIGVudHJhZGEgZGVsIHVzdWFyaW8NCiAgb2JzZXJ2ZUV2ZW50KGlucHV0JHByZWRpY3QsIHsNCiAgICBuZXdfZGF0YSA8LSBkYXRhLmZyYW1lKA0KICAgICAgTXVyZGVyID0gaW5wdXQkbXVyZGVyLA0KICAgICAgQXNzYXVsdCA9IGlucHV0JGFzc2F1bHQsDQogICAgICBSYXBlID0gaW5wdXQkcmFwZSwNCiAgICAgIFVyYmFuUG9wID0gaW5wdXQkdXJiYW5wb3ANCiAgICApDQogICAgDQogICAgcHJlZGljY2lvbiA8LSBwcmVkaWN0KG1vZGVsb19yZiwgbmV3X2RhdGEpDQogICAgb3V0cHV0JHByZWRpY3Rpb25fb3V0cHV0IDwtIHJlbmRlclByaW50KHsgcGFzdGUoIk5pdmVsIGRlIFNlZ3VyaWRhZDoiLCBwcmVkaWNjaW9uKSB9KQ0KICB9KQ0KICANCiAgIyBHcmFmaWNhciBlbCBtYXBhIGNvbiBsb3MgY2x1c3RlcnMgZGUgc2VndXJpZGFkDQogIG91dHB1dCRtYXBhUGxvdCA8LSByZW5kZXJQbG90KHsNCiAgICB1c19jbHVzdGVyZWQgPC0gbGVmdF9qb2luKHVzX21hcCwgYXNpZ25hY2lvbiwgYnkgPSBjKCJOQU1FIiA9ICJzdGF0ZSIpKQ0KICAgIA0KICAgIGNvbG9yZXNfc2VndXJpZGFkIDwtIGMoIkJham8iID0gImRhcmtncmVlbiIsIA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgIk1lZGlvIiA9ICJ5ZWxsb3ciLCANCiAgICAgICAgICAgICAgICAgICAgICAgICAgICJBbHRvIiA9ICJvcmFuZ2UiLCANCiAgICAgICAgICAgICAgICAgICAgICAgICAgICJNdXkgQWx0byIgPSAicmVkIikNCiAgICANCiAgICBnZ3Bsb3QoZGF0YSA9IHVzX2NsdXN0ZXJlZCkgKw0KICAgICAgZ2VvbV9zZihhZXMoZmlsbCA9IG5pdmVsX3NlZ3VyaWRhZCksIGNvbG9yID0gImJsYWNrIiwgc2l6ZSA9IDAuMykgKw0KICAgICAgc2NhbGVfZmlsbF9tYW51YWwodmFsdWVzID0gY29sb3Jlc19zZWd1cmlkYWQsIG5hbWUgPSAiTml2ZWwgZGUgU2VndXJpZGFkIikgKw0KICAgICAgbGFicyh0aXRsZSA9ICJNYXBhIGRlIFNlZ3VyaWRhZCBlbiBFRS5VVS4gKDE5NzMpIiwNCiAgICAgICAgICAgc3VidGl0bGUgPSAiQ2xhc2lmaWNhY2nDs24gYmFzYWRhIGVuIHRhc2FzIGRlIGNyaW1pbmFsaWRhZCIsDQogICAgICAgICAgIGNhcHRpb24gPSAiRnVlbnRlOiBVU0FycmVzdHMiKSArDQogICAgICB0aGVtZV9taW5pbWFsKCkNCiAgfSkNCiAgDQogIA0KICBvdXRwdXQkdG9wNV9zYWZlIDwtIHJlbmRlclRhYmxlKHsNCiAgICBhc2lnbmFjaW9uICU+JQ0KICAgICAgYXJyYW5nZShNdXJkZXIgKyBBc3NhdWx0ICsgUmFwZSkgJT4lDQogICAgICBoZWFkKDUpICU+JQ0KICAgICAgc2VsZWN0KHN0YXRlLCBNdXJkZXIsIEFzc2F1bHQsIFJhcGUsIG5pdmVsX3NlZ3VyaWRhZCkNCiAgfSwgY2FwdGlvbiA9ICLwn5+iIEVzdGFkb3MgTcOhcyBTZWd1cm9zIikNCiAgDQogIG91dHB1dCR0b3A1X3Vuc2FmZSA8LSByZW5kZXJUYWJsZSh7DQogICAgYXNpZ25hY2lvbiAlPiUNCiAgICAgIGFycmFuZ2UoZGVzYyhNdXJkZXIgKyBBc3NhdWx0ICsgUmFwZSkpICU+JQ0KICAgICAgaGVhZCg1KSAlPiUNCiAgICAgIHNlbGVjdChzdGF0ZSwgTXVyZGVyLCBBc3NhdWx0LCBSYXBlLCBuaXZlbF9zZWd1cmlkYWQpDQogIH0sIGNhcHRpb24gPSAi8J+UtCBFc3RhZG9zIE3DoXMgSW5zZWd1cm9zIikNCn0NCg0Kc2hpbnlBcHAodWkgPSB1aSwgc2VydmVyID0gc2VydmVyKQ0KDQpgYGANCg0KDQo=