# 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

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
LS0tCnRpdGxlOiAiVVNBcnJlc3RzIgphdXRob3I6ICJYaW1lbmEgUm9tZXJvIEphc3NvIF8gQTAwODMzNDM2IgpkYXRlOiAiMjAyNS0wMi0yMSIKb3V0cHV0OiAKICBodG1sX2RvY3VtZW50OiAKICAgIHRvYzogVFJVRQogICAgdG9jX2Zsb2F0OiBUUlVFCiAgICBjb2RlX2Rvd25sb2FkOiBUUlVFCiAgICB0aGVtZTogam91cm5hbAotLS0KCiFbXSgvVXNlcnMveGltZW5hcm9tZXJvL0RvY3VtZW50cy9yYXVsIHIvVVNBcnJlc3RzL3B1cmdlLmdpZikKCiAgIyA8c3BhbiBzdHlsZT0iY29sb3I6IHJlZDsiPkNvbnRleHRvPC9zcGFuPgpMYSBiYXNlIGRlIGRhdG9zICpVU0FycmVzdHMqIGNvbnRpZW5lIGVzdGFkw61zdGljYXMgZW4gYXJyZXN0b3MgcG9yIGNhZGEgMTAwLDAwMCByZXNpZGVudGVzIHBvciBhZ3Jlc2nDs24sIGFzZXNpbmF0byB5IHZpb2xhY2nDs24gZW4gY2FkYSB1bm8gZGUgbG9zIDUwIGVzdGFkb3MgZGUgRS5FLlUuVS4gZW4gMTk3My4KCiMgPHNwYW4gc3R5bGU9ImNvbG9yOiByZWQ7Ij5JbnN0YWxhciBwYXF1ZXRlcyB5IGxsYW1hciBsaWJyZXJpYXM8L3NwYW4+CmBgYHtyIG1lc3NhZ2U9RkFMU0UsIHdhcm5pbmc9RkFMU0V9CgojaW5zdGFsbC5wYWNrYWdlcygiY2FyZXQiKSAjIEFsZ29yaXRtb3MgZGUgYXByZW5kaXphamUgYXV0b23DoXRpY28KbGlicmFyeShjYXJldCkKI2luc3RhbGwucGFja2FnZXMoImRhdGFzZXRzIikgIyBQYXJhIHVzYXIgbGEgYmFzZSBkZSBkYXRvcyAiVVNBcnJlc3RzIgpsaWJyYXJ5KGRhdGFzZXRzKQojaW5zdGFsbC5wYWNrYWdlcygiZ2dwbG90MiIpICMgR3LDoWZpY2FzIGNvbiBtZWpvciBkaXNlw7FvCmxpYnJhcnkoZ2dwbG90MikKI2luc3RhbGwucGFja2FnZXMoImxhdHRpY2UiKSAjIENyZWFyIGdyw6FmaWNvcwpsaWJyYXJ5KGxhdHRpY2UpCiNpbnN0YWxsLnBhY2thZ2VzKCJEYXRhRXhwbG9yZXIiKSAjIEFuw6FsaXNpcyBEZXNjcmlwdGl2bwpsaWJyYXJ5KERhdGFFeHBsb3JlcikKI2luc3RhbGwucGFja2FnZXMoImtlcm5sYWIiKSAjIE1vZGVsb3MgZGUgU1ZNCmxpYnJhcnkoa2VybmxhYikKI2luc3RhbGwucGFja2FnZXMoImRwbHlyIikgIyBNYW5pcHVsYWNpw7NuIGRlIGRhdG9zCmxpYnJhcnkoZHBseXIpCmxpYnJhcnkoY2x1c3RlcikKbGlicmFyeShmYWN0b2V4dHJhKQpsaWJyYXJ5KGRhdGEudGFibGUpCmxpYnJhcnkodGlkeXZlcnNlKQojaW5zdGFsbC5wYWNrYWdlcygidGlncmlzIikKbGlicmFyeSh0aWdyaXMpCmxpYnJhcnkocmFuZG9tRm9yZXN0KQpsaWJyYXJ5KHNmKQpsaWJyYXJ5KHNoaW55KQoKYGBgCgojIDxzcGFuIHN0eWxlPSJjb2xvcjogcmVkOyI+SW1wb3J0YXIgbGFzIGJhc2VzIGRlIGRhdG9zPC9zcGFuPgpgYGB7cn0KCmRhdG9zIDwtIFVTQXJyZXN0cwpkYXRvc19lc2NhbGFkb3MgPC0gc2NhbGUoZGF0b3MpCgpgYGAKCiMgPHNwYW4gc3R5bGU9ImNvbG9yOiByZWQ7Ij5Db25maWd1cmFyIHRpZ3JpcyBwYXJhIGRlc2NhcmdhciBlbCBtYXBhIGRlIEVFLlVVLjwvc3Bhbj4KYGBge3J9CgpvcHRpb25zKHRpZ3Jpc191c2VfY2FjaGUgPSBUUlVFKQp1c19tYXAgPC0gdGlncmlzOjpzdGF0ZXMoY2IgPSBUUlVFKQoKYGBgCgojIDxzcGFuIHN0eWxlPSJjb2xvcjogcmVkOyI+RW50cmVuYXIgbW9kZWxvIFJhbmRvbSBGb3Jlc3Q8L3NwYW4+CmBgYHtyfQoKc2V0LnNlZWQoMTIzKQpzZWdtZW50b3MgPC0ga21lYW5zKGRhdG9zX2VzY2FsYWRvcywgY2VudGVycyA9IDQsIG5zdGFydCA9IDI1KQphc2lnbmFjaW9uIDwtIGNiaW5kKGRhdG9zLCBjbHVzdGVyID0gc2VnbWVudG9zJGNsdXN0ZXIpCgpgYGAKCiMgPHNwYW4gc3R5bGU9ImNvbG9yOiByZWQ7Ij5Ob3JtYWxpemFyIE5vbWJyZXMgZGUgbG9zIEVzdGFkb3M8L3NwYW4+CmBgYHtyfQoKYXNpZ25hY2lvbiRzdGF0ZSA8LSB0b2xvd2VyKHJvd25hbWVzKGFzaWduYWNpb24pKQp1c19tYXAkTkFNRSA8LSB0b2xvd2VyKHVzX21hcCROQU1FKQoKYGBgCgojIDxzcGFuIHN0eWxlPSJjb2xvcjogcmVkOyI+QXNpZ25hciBuaXZlbGVzIGRlIFNlZ3VyaWRhZDwvc3Bhbj4KYGBge3J9Cgphc2lnbmFjaW9uJG5pdmVsX3NlZ3VyaWRhZCA8LSBmYWN0b3IoY2FzZV93aGVuKAogIGFzaWduYWNpb24kY2x1c3RlciA9PSAxIH4gIkJham8iLAogIGFzaWduYWNpb24kY2x1c3RlciA9PSAyIH4gIk1lZGlvIiwKICBhc2lnbmFjaW9uJGNsdXN0ZXIgPT0gMyB+ICJBbHRvIiwKICBhc2lnbmFjaW9uJGNsdXN0ZXIgPT0gNCB+ICJNdXkgQWx0byIsCiAgVFJVRSB+ICJEZXNjb25vY2lkbyIKKSkKCmBgYAoKIyA8c3BhbiBzdHlsZT0iY29sb3I6IHJlZDsiPkVudHJlbmFyIGVsIG1vZGVsbyBSYW5kb20gRm9yZXN0PC9zcGFuPgpgYGB7cn0KCm1vZGVsb19yZiA8LSByYW5kb21Gb3Jlc3QoCiAgbml2ZWxfc2VndXJpZGFkIH4gTXVyZGVyICsgQXNzYXVsdCArIFJhcGUgKyBVcmJhblBvcCwgCiAgZGF0YSA9IGFzaWduYWNpb24sCiAgbnRyZWUgPSAxMDAKKQoKYGBgCgojIDxzcGFuIHN0eWxlPSJjb2xvcjogcmVkOyI+SW50ZXJmYXogZGUgVXN1YXJpbyAoVUkpPC9zcGFuPgpgYGB7cn0KCnVpIDwtIGZsdWlkUGFnZSgKICB0aXRsZVBhbmVsKCJQcmVkaWNjacOzbiBkZSBTZWd1cmlkYWQgZW4gRUUuVVUuIiksCiAgCiAgc2lkZWJhckxheW91dCgKICAgIHNpZGViYXJQYW5lbCgKICAgICAgaDQoIkluZ3Jlc2Ugc3VzIGRhdG9zIHBhcmEgcHJlZGljY2nDs24iKSwKICAgICAgbnVtZXJpY0lucHV0KCJtdXJkZXIiLCAiQXNlc2luYXRvcyBwb3IgMTAwLDAwMCBoYWIuOiIsIHZhbHVlID0gMTAsIG1pbiA9IDApLAogICAgICBudW1lcmljSW5wdXQoImFzc2F1bHQiLCAiQWdyZXNpb25lcyBwb3IgMTAwLDAwMCBoYWIuOiIsIHZhbHVlID0gMjAwLCBtaW4gPSAwKSwKICAgICAgbnVtZXJpY0lucHV0KCJyYXBlIiwgIlZpb2xhY2lvbmVzIHBvciAxMDAsMDAwIGhhYi46IiwgdmFsdWUgPSAyMCwgbWluID0gMCksCiAgICAgIG51bWVyaWNJbnB1dCgidXJiYW5wb3AiLCAiUG9yY2VudGFqZSBkZSBwb2JsYWNpw7NuIHVyYmFuYToiLCB2YWx1ZSA9IDUwLCBtaW4gPSAwLCBtYXggPSAxMDApLAogICAgICBhY3Rpb25CdXR0b24oInByZWRpY3QiLCAiUHJlZGVjaXIgU2VndXJpZGFkIiksCiAgICAgIGhyKCksCiAgICAgIGg0KCJQcmVkaWNjacOzbiBkZWwgbml2ZWwgZGUgc2VndXJpZGFkIiksCiAgICAgIHZlcmJhdGltVGV4dE91dHB1dCgicHJlZGljdGlvbl9vdXRwdXQiKQogICAgKSwKICAgIAogICAgbWFpblBhbmVsKAogICAgICB0YWJzZXRQYW5lbCgKICAgICAgICB0YWJQYW5lbCgiTWFwYSBkZSBTZWd1cmlkYWQiLAogICAgICAgICAgICAgICAgIHBsb3RPdXRwdXQoIm1hcGFQbG90IikKICAgICAgICApLAogICAgICAgIHRhYlBhbmVsKCJFc3RhZG9zIE3DoXMgeSBNZW5vcyBTZWd1cm9zIiwKICAgICAgICAgICAgICAgICB0YWJsZU91dHB1dCgidG9wNV9zYWZlIiksCiAgICAgICAgICAgICAgICAgdGFibGVPdXRwdXQoInRvcDVfdW5zYWZlIikKICAgICAgICApCiAgICAgICkKICAgICkKICApCikKCiMgU2Vydmlkb3IgKFNlcnZlcikKc2VydmVyIDwtIGZ1bmN0aW9uKGlucHV0LCBvdXRwdXQsIHNlc3Npb24pIHsKICAKICAjIFByZWRlY2lyIGVsIG5pdmVsIGRlIHNlZ3VyaWRhZCBiYXNhZG8gZW4gbGEgZW50cmFkYSBkZWwgdXN1YXJpbwogIG9ic2VydmVFdmVudChpbnB1dCRwcmVkaWN0LCB7CiAgICBuZXdfZGF0YSA8LSBkYXRhLmZyYW1lKAogICAgICBNdXJkZXIgPSBpbnB1dCRtdXJkZXIsCiAgICAgIEFzc2F1bHQgPSBpbnB1dCRhc3NhdWx0LAogICAgICBSYXBlID0gaW5wdXQkcmFwZSwKICAgICAgVXJiYW5Qb3AgPSBpbnB1dCR1cmJhbnBvcAogICAgKQogICAgCiAgICBwcmVkaWNjaW9uIDwtIHByZWRpY3QobW9kZWxvX3JmLCBuZXdfZGF0YSkKICAgIG91dHB1dCRwcmVkaWN0aW9uX291dHB1dCA8LSByZW5kZXJQcmludCh7IHBhc3RlKCJOaXZlbCBkZSBTZWd1cmlkYWQ6IiwgcHJlZGljY2lvbikgfSkKICB9KQogIAogICMgR3JhZmljYXIgZWwgbWFwYSBjb24gbG9zIGNsdXN0ZXJzIGRlIHNlZ3VyaWRhZAogIG91dHB1dCRtYXBhUGxvdCA8LSByZW5kZXJQbG90KHsKICAgIHVzX2NsdXN0ZXJlZCA8LSBsZWZ0X2pvaW4odXNfbWFwLCBhc2lnbmFjaW9uLCBieSA9IGMoIk5BTUUiID0gInN0YXRlIikpCiAgICAKICAgIGNvbG9yZXNfc2VndXJpZGFkIDwtIGMoIkJham8iID0gImRhcmtncmVlbiIsIAogICAgICAgICAgICAgICAgICAgICAgICAgICAiTWVkaW8iID0gInllbGxvdyIsIAogICAgICAgICAgICAgICAgICAgICAgICAgICAiQWx0byIgPSAib3JhbmdlIiwgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICJNdXkgQWx0byIgPSAicmVkIikKICAgIAogICAgZ2dwbG90KGRhdGEgPSB1c19jbHVzdGVyZWQpICsKICAgICAgZ2VvbV9zZihhZXMoZmlsbCA9IG5pdmVsX3NlZ3VyaWRhZCksIGNvbG9yID0gImJsYWNrIiwgc2l6ZSA9IDAuMykgKwogICAgICBzY2FsZV9maWxsX21hbnVhbCh2YWx1ZXMgPSBjb2xvcmVzX3NlZ3VyaWRhZCwgbmFtZSA9ICJOaXZlbCBkZSBTZWd1cmlkYWQiKSArCiAgICAgIGxhYnModGl0bGUgPSAiTWFwYSBkZSBTZWd1cmlkYWQgZW4gRUUuVVUuICgxOTczKSIsCiAgICAgICAgICAgc3VidGl0bGUgPSAiQ2xhc2lmaWNhY2nDs24gYmFzYWRhIGVuIHRhc2FzIGRlIGNyaW1pbmFsaWRhZCIsCiAgICAgICAgICAgY2FwdGlvbiA9ICJGdWVudGU6IFVTQXJyZXN0cyIpICsKICAgICAgdGhlbWVfbWluaW1hbCgpCiAgfSkKICAKICAKICBvdXRwdXQkdG9wNV9zYWZlIDwtIHJlbmRlclRhYmxlKHsKICAgIGFzaWduYWNpb24gJT4lCiAgICAgIGFycmFuZ2UoTXVyZGVyICsgQXNzYXVsdCArIFJhcGUpICU+JQogICAgICBoZWFkKDUpICU+JQogICAgICBzZWxlY3Qoc3RhdGUsIE11cmRlciwgQXNzYXVsdCwgUmFwZSwgbml2ZWxfc2VndXJpZGFkKQogIH0sIGNhcHRpb24gPSAi8J+foiBFc3RhZG9zIE3DoXMgU2VndXJvcyIpCiAgCiAgb3V0cHV0JHRvcDVfdW5zYWZlIDwtIHJlbmRlclRhYmxlKHsKICAgIGFzaWduYWNpb24gJT4lCiAgICAgIGFycmFuZ2UoZGVzYyhNdXJkZXIgKyBBc3NhdWx0ICsgUmFwZSkpICU+JQogICAgICBoZWFkKDUpICU+JQogICAgICBzZWxlY3Qoc3RhdGUsIE11cmRlciwgQXNzYXVsdCwgUmFwZSwgbml2ZWxfc2VndXJpZGFkKQogIH0sIGNhcHRpb24gPSAi8J+UtCBFc3RhZG9zIE3DoXMgSW5zZWd1cm9zIikKfQoKc2hpbnlBcHAodWkgPSB1aSwgc2VydmVyID0gc2VydmVyKQoKYGBgCg==