library(shiny)
library(shinydashboard)
## Warning: package 'shinydashboard' was built under R version 4.5.2
##
## Adjuntando el paquete: 'shinydashboard'
## The following object is masked from 'package:graphics':
##
## box
library(readxl)
## Warning: package 'readxl' was built under R version 4.5.2
library(dplyr)
##
## Adjuntando el paquete: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(ggplot2)
## Warning: package 'ggplot2' was built under R version 4.5.2
hogares <- read_excel("C:/Users/Anthony/Desktop/asd/hogares_raw.xlsx")
if ("ingreso_mensual" %in% names(hogares)) {
hogares <- hogares %>%
mutate(
ingreso_mensual = gsub("[^0-9.]", "", ingreso_mensual),
ingreso_mensual = as.numeric(ingreso_mensual)
)
}
if ("gasto_mensual" %in% names(hogares)) {
hogares <- hogares %>%
mutate(
gasto_mensual = gsub("[^0-9.]", "", gasto_mensual),
gasto_mensual = as.numeric(gasto_mensual)
)
}
clickable_valueBox <- function(output_id, box_id, width = 4) {
column(width = width,
div(
id = box_id,
style = "cursor: pointer;",
onclick = sprintf("Shiny.setInputValue('kpi_clicked', '%s', {priority: 'event'})", box_id),
valueBoxOutput(output_id, width = 12)
)
)
}
ui <- dashboardPage(
title = "Dashboard",
skin = "green",
dashboardHeader(title = "CODIGO LAGARTO"),
dashboardSidebar(
sidebarMenu(id = "sidebarID",
menuItem("Panel de Bienvenida", tabName = "bienvenida", icon = icon("home")),
# NUEVO MÓDULO 2
menuItem("Explorador de Variables", tabName = "explorador", icon = icon("binoculars")),
menuItem("Command Center (KPIs)", tabName = "command", icon = icon("tachometer-alt")),
menuItem("Primera ventana", tabName = "primera_parent", icon = icon("chart-line"),
menuSubItem("Primera sub-ventana", tabName = "primera_sub1")
),
menuItem("Segunda ventana", id = "chartsID", icon = icon("chart-pie"),
menuSubItem("Sub-ventana1", tabName = "segunda_sub1"),
menuSubItem("Sub-ventana2", tabName = "segunda_sub2"),
menuSubItem("Sub-ventana3", tabName = "segunda_sub3", icon = icon("apple-pay"))
)
)
),
dashboardBody(
tabItems(
tabItem(tabName = "bienvenida",
fluidRow(
box(width = 12, title = "Panel de Bienvenida", status = "primary",
solidHeader = TRUE,
HTML("
<h3 style='color:#2c3e50;'> Bienvenidos al Dashboard del <b>Equipo Lagarto</b></h3>
<p>En este trabajo presentaremos un análisis basado en las <b>encuestas nacional de hogares (ENAHO)</b>,
con el objetivo de estudiar la <b>desigualdad económica</b> del país.</p>
<h4><b>Integrantes</b></h4>
<ul>
<li>Espinoza Huamani, Maricielo Emily</li>
<li>Palomino Morales, Cristhian Omar</li>
<li>Loja Gutierrez, Manuel Anthony</li>
<li>Mejía Ortega, Jhovana Cynthia</li>
</ul>
<h4><b>Resumen del Proyecto</b></h4>
<ul>
<li>Análisis de la distribución del ingreso en el Perú</li>
<li>Evaluación de brechas económicas entre regiones</li>
<li>Indicadores de desigualdad social y acceso a servicios</li>
<li>Exploración estadística mediante gráficos interactivos</li>
</ul>
")
)
)
),
tabItem(tabName = "explorador",
h2("Módulo 2: Explorador de Variables"),
fluidRow(
box(width = 4, title = "Selección y Configuración", status = "primary", solidHeader = TRUE,
selectInput("var_seleccionada", "Seleccionar Variable:", choices = NULL),
uiOutput("var_type_info")
),
box(width = 8, title = "Análisis de Anomalías (Numéricas)", status = "warning", solidHeader = TRUE,
p("Identificación de posibles valores atípicos (Outliers) usando el Rango Intercuartílico (IQR)."),
verbatimTextOutput("anomalias_output")
)
),
fluidRow(
box(width = 12, title = uiOutput("stats_title"), status = "success", solidHeader = TRUE,
uiOutput("stats_output_container")
)
)
),
tabItem(tabName = "command",
fluidRow(
clickable_valueBox("kpi_ingreso_prom", "ingreso_promedio_click", width = 4),
clickable_valueBox("kpi_ingreso_med", "ingreso_mediano_click", width = 4),
clickable_valueBox("kpi_gasto_prom", "gasto_promedio_click", width = 4)
),
fluidRow(
clickable_valueBox("kpi_q1", "quintil1_click", width = 4),
clickable_valueBox("kpi_agua", "agua_potable_click", width = 4),
clickable_valueBox("kpi_internet", "internet_educativo_click", width = 4)
),
fluidRow(
box(width = 12, title = uiOutput("summary_title"), status = "info", solidHeader = TRUE,
verbatimTextOutput("statistical_summary")
)
)
),
tabItem(tabName = "primera_parent",
h3("Primera ventana - Menú Principal"),
p("Contenido principal aún no agregado.")
),
tabItem(tabName = "primera_sub1",
h3("Primera ventana - Primera sub-ventana"),
p("Contenido de la primera sub-ventana.")
),
tabItem(tabName = "segunda_sub1",
h3("Segunda ventana - Sub-ventana 1"),
p("Contenido de la Sub-ventana 1.")
),
tabItem(tabName = "segunda_sub2",
h3("Segunda ventana - Sub-ventana 2"),
p("Contenido de la Sub-ventana 2.")
),
tabItem(tabName = "segunda_sub3",
h3("Segunda ventana - Sub-ventana 3"),
p("Contenido de la Sub-ventana 3.")
)
)
)
)
server <- function(input, output, session) {
df <- hogares
pct <- function(x){
x <- tolower(as.character(x))
x_flag <- ifelse(x %in% c("si","1","true","yes","s"), 1,
ifelse(x %in% c("no","0","false","n"), 0, NA))
mean(x_flag, na.rm = TRUE) * 100
}
# --- Lógica de Módulo 1: KPIs y Clicks ---
output$kpi_ingreso_prom <- renderValueBox({
val <- if("ingreso_mensual" %in% names(df))
mean(df$ingreso_mensual, na.rm = TRUE) else NA
valueBox("Ingreso promedio",
ifelse(is.na(val),"N/D",paste0("S/ ", round(val,1))),
icon = icon("wallet"), color = "green")
})
output$kpi_ingreso_med <- renderValueBox({
val <- if("ingreso_mensual" %in% names(df))
median(df$ingreso_mensual, na.rm = TRUE) else NA
valueBox("Ingreso mediano",
ifelse(is.na(val),"N/D",paste0("S/ ", round(val,1))),
icon = icon("chart-bar"), color = "blue")
})
output$kpi_gasto_prom <- renderValueBox({
val <- if("gasto_mensual" %in% names(df))
mean(df$gasto_mensual, na.rm = TRUE) else NA
valueBox("Gasto promedio",
ifelse(is.na(val),"N/D",paste0("S/ ", round(val,1))),
icon = icon("shopping-cart"), color = "yellow")
})
output$kpi_q1 <- renderValueBox({
val <- if("quintil_ingreso" %in% names(df))
mean(df$quintil_ingreso == "Q1", na.rm=TRUE) * 100 else NA
valueBox("% en Quintil 1 (Pobreza)",
ifelse(is.na(val),"N/D",paste0(round(val,1),"%")),
icon = icon("exclamation-circle"), color = "red")
})
output$kpi_agua <- renderValueBox({
val <- if("tiene_agua_potable" %in% names(df))
pct(df$tiene_agua_potable) else NA
valueBox("% Agua potable",
ifelse(is.na(val),"N/D",paste0(round(val,1),"%")),
icon = icon("tint"), color = "aqua")
})
output$kpi_internet <- renderValueBox({
val <- if("acceso_internet_educativo" %in% names(df))
pct(df$acceso_internet_educativo) else NA
valueBox("% Internet educativo",
ifelse(is.na(val),"N/D",paste0(round(val,1),"%")),
icon = icon("wifi"), color = "purple")
})
selected_kpi <- reactiveVal(NULL)
observeEvent(input$kpi_clicked, {
selected_kpi(input$kpi_clicked)
})
output$summary_title <- renderUI({
req(selected_kpi())
title_map <- c(
"ingreso_promedio_click" = "Resumen Estadístico Detallado: Ingreso Mensual (S/)",
"ingreso_mediano_click" = "Resumen Estadístico Detallado: Ingreso Mensual (S/)",
"gasto_promedio_click" = "Resumen Estadístico Detallado: Gasto Mensual (S/)",
"quintil1_click" = "Distribución de Frecuencias: Quintil de Ingreso",
"agua_potable_click" = "Distribución de Frecuencias: Tenencia de Agua Potable",
"internet_educativo_click" = "Distribución de Frecuencias: Acceso a Internet Educativo"
)
h4(title_map[selected_kpi()])
})
output$statistical_summary <- renderPrint({
req(selected_kpi(), nrow(df) > 0)
kpi_id <- selected_kpi()
if (kpi_id %in% c("ingreso_promedio_click", "ingreso_mediano_click", "gasto_promedio_click")) {
var_name <- ifelse(grepl("ingreso", kpi_id), "ingreso_mensual", "gasto_mensual")
if (var_name %in% names(df)) {
data <- df[[var_name]]
cat("Análisis de la variable:", var_name, "\n\n")
cat("Métricas de Resumen (Min, Q1, Mediana, Media, Q3, Max):\n")
print(summary(data))
cat("\nDesviación Estándar:\n")
print(sd(data, na.rm = TRUE))
cat("\nCuartiles Detallados (0%, 25%, 50%, 75%, 100%):\n")
print(quantile(data, na.rm = TRUE))
} else {
cat(sprintf("Variable '%s' no encontrada en el dataset.", var_name))
}
} else if (kpi_id %in% c("quintil1_click", "agua_potable_click", "internet_educativo_click")) {
var_name <- switch(kpi_id,
"quintil1_click" = "quintil_ingreso",
"agua_potable_click" = "tiene_agua_potable",
"internet_educativo_click" = "acceso_internet_educativo")
if (var_name %in% names(df)) {
cat("Tabla de Frecuencias Absolutas y Relativas para:", var_name, "\n\n")
data_clean <- tolower(as.character(df[[var_name]]))
freq_table <- table(data_clean, useNA = "ifany")
rel_freq_table <- prop.table(freq_table) * 100
summary_df <- data.frame(
Frecuencia_Absoluta = as.integer(freq_table),
Frecuencia_Relativa_Pct = round(rel_freq_table, 2)
)
rownames(summary_df) <- names(freq_table)
print(summary_df)
} else {
cat(sprintf("Variable '%s' no encontrada en el dataset.", var_name))
}
}
})
observe({
req(df)
updateSelectInput(session, "var_seleccionada",
choices = names(df))
})
var_type <- reactive({
req(input$var_seleccionada)
var <- df[[input$var_seleccionada]]
if (is.numeric(var)) {
if (length(unique(var)) < 15 && all(unique(var) %in% c(0:10, NA))) {
return("Categórica (Ordinal/Factor)")
} else {
return("Numérica (Continua/Discreta)")
}
} else if (is.character(var) || is.factor(var)) {
return("Categórica (Nominal/Factor)")
} else {
return("Otro Tipo")
}
})
output$var_type_info <- renderUI({
tagList(
tags$b("Tipo Detectado:"), tags$p(var_type(), style = "color: blue;")
)
})
output$stats_title <- renderUI({
req(input$var_seleccionada)
tags$h4(paste("Resultados para:", input$var_seleccionada))
})
output$stats_output_container <- renderUI({
req(input$var_seleccionada, var_type())
var <- df[[input$var_seleccionada]]
tipo <- var_type()
if (tipo == "Numérica (Continua/Discreta)") {
stats_data <- data.frame(
Métrica = c("Observaciones (N)", "N. Faltantes (NA)", "Media", "Mediana", "Desv. Estándar", "Mínimo", "Máximo", "Rango Intercuartílico (IQR)"),
Valor = c(
sum(!is.na(var)),
sum(is.na(var)),
round(mean(var, na.rm = TRUE), 2),
round(median(var, na.rm = TRUE), 2),
round(sd(var, na.rm = TRUE), 2),
round(min(var, na.rm = TRUE), 2),
round(max(var, na.rm = TRUE), 2),
round(IQR(var, na.rm = TRUE), 2)
)
)
tagList(
h4("Estadísticas Descriptivas"),
renderTable(stats_data, striped = TRUE, hover = TRUE, bordered = TRUE, digits = 2)
)
} else if (grepl("Categórica", tipo)) {
var_factor <- as.factor(var)
freq_table <- table(var_factor, useNA = "ifany")
rel_freq_table <- prop.table(freq_table) * 100
freq_df <- data.frame(
Nivel = names(freq_table),
Frecuencia_Absoluta = as.integer(freq_table),
Frecuencia_Relativa_Pct = round(rel_freq_table, 2),
row.names = NULL
)
tagList(
h4("Tabla de Frecuencias"),
renderTable(freq_df, striped = TRUE, hover = TRUE, bordered = TRUE, digits = 2)
)
} else {
p("Tipo de dato no apto para análisis estadístico estándar.")
}
})
# Detección de Anomalías (Solo para Numéricas)
output$anomalias_output <- renderPrint({
req(input$var_seleccionada, var_type())
if (var_type() == "Numérica (Continua/Discreta)") {
var <- df[[input$var_seleccionada]]
Q1 <- quantile(var, 0.25, na.rm = TRUE)
Q3 <- quantile(var, 0.75, na.rm = TRUE)
IQR_val <- Q3 - Q1
lower_bound <- Q1 - 1.5 * IQR_val
upper_bound <- Q3 + 1.5 * IQR_val
outliers_low <- var[var < lower_bound & !is.na(var)]
outliers_high <- var[var > upper_bound & !is.na(var)]
if (length(outliers_low) == 0 && length(outliers_high) == 0) {
cat("No se detectaron valores atípicos (outliers) extremos en esta variable usando el método 1.5 * IQR.")
} else {
cat("¡ATENCIÓN! Se detectaron posibles valores atípicos (Outliers):\n")
cat(sprintf(" Límite Inferior (Q1 - 1.5*IQR): %.2f\n", lower_bound))
cat(sprintf(" Límite Superior (Q3 + 1.5*IQR): %.2f\n\n", upper_bound))
cat(sprintf("Valores Atípicos Bajos (%d encontrados):\n", length(outliers_low)))
print(summary(outliers_low))
cat(sprintf("\nValores Atípicos Altos (%d encontrados):\n", length(outliers_high)))
print(summary(outliers_high))
cat("\nNota: Estos valores deben ser revisados para su posible corrección o exclusión del análisis.")
}
} else {
cat("Este análisis de anomalías aplica solo a variables numéricas.")
}
})
}
shinyApp(ui, server)
Shiny applications not supported in static R Markdown documents