app.R

################################################################
# EXPLORADOR DE CONSISTENCIA INTERNA - App Shiny
# Aplicación interactiva para explorar el efecto de eliminar
# ítems sobre el alfa de Cronbach
################################################################

# Cargar librerías necesarias
library(shiny)
library(psych)
library(haven)
library(readxl)

################################################################
# DATOS PRÁCTICA 1_370
################################################################

# Cargar datos SPSS
datos_practica <- as.data.frame(read_sav("../input_data/1_370.datos.sav"))

# Definir nombres de ítems para cada escala
escala1_items <- c("i4", "i34", "i114", "i144", "i184", "i204", "i214", "i234")
escala2_items <- c("i11", "i16", "i46", "i71", "i76", "i101", "i106", "i161")

# Items inversos predefinidos
items_inversos_practica <- c("i144", "i184", "i204", "i214", "i234")

################################################################
# INTERFAZ DE USUARIO (UI)
################################################################

ui <- fluidPage(

  # Título de la aplicación
  titlePanel("Explorador de Consistencia Interna"),

  # Subtítulo descriptivo
  p("Aplicación para explorar cómo afecta la eliminación de ítems a la consistencia interna"),

  hr(),

  # Layout con panel lateral y panel principal
  sidebarLayout(

    # Panel lateral: controles de selección
    sidebarPanel(
      width = 4,

      # Fuente de datos
      h4("Fuente de datos"),
      radioButtons(
        "fuente_datos",
        label = NULL,
        choices = c("Datos práctica 1_370" = "practica",
                    "Subir archivo" = "archivo"),
        selected = "practica"
      ),

      # Panel para subir archivo (condicional)
      conditionalPanel(
        condition = "input.fuente_datos == 'archivo'",
        fileInput(
          "archivo_subido",
          "Seleccionar archivo (.sav o .xlsx):",
          accept = c(".sav", ".xlsx", ".xls")
        ),
        p(em("Items en columnas, participantes en filas."),
          style = "font-size: 11px; color: gray;")
      ),

      hr(),

      # Selector de escala (solo para datos práctica)
      conditionalPanel(
        condition = "input.fuente_datos == 'practica'",
        selectInput(
          inputId = "escala",
          label = "Seleccionar escala:",
          choices = c("Amabilidad" = "escala1",
                      "Neuroticismo" = "escala2")
        ),
        hr()
      ),

      # Título para los checkboxes
      h4("Ítems incluidos:"),
      p("Desmarcar ítems para ver el efecto en el alfa"),

      # Los checkboxes se generan dinámicamente en el server
      uiOutput("checkboxes_items"),

      hr(),

      # Items inversos (solo para archivo externo)
      conditionalPanel(
        condition = "input.fuente_datos == 'archivo'",
        h4("Ítems inversos"),
        p("Marcar ítems que requieren recodificación:", style = "font-size: 12px;"),
        uiOutput("ui_items_inversos"),
        hr()
      ),

      # Botón para resetear selección
      actionButton(
        inputId = "resetear",
        label = "Incluir todos los ítems",
        class = "btn-primary"
      ),

      hr(),

      # Información sobre la escala
      h4("Información:"),
      textOutput("info_escala")
    ),

    # Panel principal: resultados
    mainPanel(
      width = 8,

      # Mostrar alfa de Cronbach destacado
      fluidRow(
        column(12,
          div(
            style = "background-color: #f5f5f5; padding: 20px; border-radius: 10px; margin-bottom: 20px;",
            h3("Alfa de Cronbach"),
            h1(textOutput("alfa_valor"), style = "color: #2c3e50;"),
            textOutput("alfa_interpretacion")
          )
        )
      ),

      hr(),

      # Tabla de estadísticos ítem-total
      fluidRow(
        column(12,
          h4("Estadísticos ítem-total:"),
          p("La columna 'Alfa si se elimina' muestra qué pasaría con el alfa al quitar cada ítem"),
          tableOutput("tabla_items")
        )
      ),

      hr(),

      # Recomendación
      fluidRow(
        column(12,
          uiOutput("recomendacion")
        )
      )
    )
  )
)

################################################################
# LÓGICA DEL SERVIDOR (SERVER)
################################################################

server <- function(input, output, session) {

  # ============================================================
  # CARGA DE DATOS
  # ============================================================

  # Datos cargados desde archivo (SPSS o Excel)
  datos_archivo <- reactive({
    req(input$archivo_subido)
    ext <- tools::file_ext(input$archivo_subido$name)
    tryCatch({
      if (tolower(ext) == "sav") {
        as.data.frame(read_sav(input$archivo_subido$datapath))
      } else {
        as.data.frame(read_excel(input$archivo_subido$datapath))
      }
    }, error = function(e) {
      NULL
    })
  })

  # Items disponibles según fuente
  items_disponibles <- reactive({
    if (input$fuente_datos == "practica") {
      if (input$escala == "escala1") {
        escala1_items
      } else {
        escala2_items
      }
    } else {
      req(datos_archivo())
      df <- datos_archivo()
      nombres <- names(df)
      numericas <- sapply(df, is.numeric)
      nombres[numericas]
    }
  })

  # Datos base recodificados
  datos_recodificados <- reactive({
    if (input$fuente_datos == "practica") {
      # Usar datos de práctica con recodificación predefinida
      items <- items_disponibles()
      df <- datos_practica[, items, drop = FALSE]
      # Recodificar inversos de la práctica
      inv <- intersect(items_inversos_practica, items)
      if (length(inv) > 0) {
        df[, inv] <- 6 - df[, inv]
      }
      df
    } else {
      req(datos_archivo())
      req(input$items_seleccionados)
      items_sel <- input$items_seleccionados
      df <- datos_archivo()[, items_sel, drop = FALSE]
      # Recodificar inversos marcados por usuario
      items_inv <- input$items_inversos
      if (length(items_inv) > 0) {
        inv <- intersect(items_inv, items_sel)
        if (length(inv) > 0) {
          df[, inv] <- 6 - df[, inv]
        }
      }
      df
    }
  })

  # ============================================================
  # UI DINÁMICA
  # ============================================================

  # Generar checkboxes de items
  output$checkboxes_items <- renderUI({
    items <- items_disponibles()
    checkboxGroupInput(
      inputId = "items_seleccionados",
      label = NULL,
      choices = items,
      selected = items
    )
  })

  # Generar checkboxes de items inversos
  output$ui_items_inversos <- renderUI({
    req(input$fuente_datos == "archivo")
    items <- items_disponibles()
    checkboxGroupInput(
      "items_inversos",
      label = NULL,
      choices = items,
      selected = character(0)
    )
  })

  # Resetear checkboxes al presionar el botón
  observeEvent(input$resetear, {
    updateCheckboxGroupInput(
      session = session,
      inputId = "items_seleccionados",
      selected = items_disponibles()
    )
  })

  # Resetear checkboxes al cambiar de escala
  observeEvent(input$escala, {
    if (input$fuente_datos == "practica") {
      updateCheckboxGroupInput(
        session = session,
        inputId = "items_seleccionados",
        selected = items_disponibles()
      )
    }
  })

  # ============================================================
  # CÁLCULO DE ALFA
  # ============================================================

  # Calcular alfa de Cronbach con los ítems seleccionados
  resultado_alpha <- reactive({
    req(input$items_seleccionados)
    req(length(input$items_seleccionados) >= 2)

    # Verificar que los ítems pertenecen a los disponibles
    req(all(input$items_seleccionados %in% items_disponibles()))

    # Obtener datos recodificados
    datos_sel <- datos_recodificados()[, input$items_seleccionados, drop = FALSE]

    # Calcular alfa
    alpha(datos_sel, check.keys = FALSE)
  })

  # Mostrar información
  output$info_escala <- renderText({
    n_total <- length(items_disponibles())
    n_sel <- length(input$items_seleccionados)
    n_part <- if (input$fuente_datos == "practica") {
      nrow(datos_practica)
    } else {
      req(datos_archivo())
      nrow(datos_archivo())
    }

    paste0("Ítems: ", n_sel, " de ", n_total, " seleccionados\n",
           "Participantes: ", n_part)
  })

  # Mostrar valor del alfa
  output$alfa_valor <- renderText({
    res <- resultado_alpha()

    if (is.null(res)) {
      return("--")
    }

    round(res$total$raw_alpha, 3)
  })

  # Interpretar el valor del alfa
  output$alfa_interpretacion <- renderText({
    res <- resultado_alpha()

    if (is.null(res)) {
      return("Seleccionar al menos 2 ítems")
    }

    alfa <- res$total$raw_alpha

    # Criterios de George y Mallery (2003) para consistencia interna
    if (alfa >= 0.9) {
      return("Consistencia interna excelente")
    } else if (alfa >= 0.8) {
      return("Consistencia interna buena")
    } else if (alfa >= 0.7) {
      return("Consistencia interna aceptable")
    } else if (alfa >= 0.6) {
      return("Consistencia interna cuestionable")
    } else {
      return("Consistencia interna pobre")
    }
  })

  # Generar tabla de estadísticos ítem-total
  output$tabla_items <- renderTable({
    res <- resultado_alpha()

    if (is.null(res)) {
      return(data.frame(Mensaje = "Seleccionar al menos 2 ítems"))
    }

    # Construir tabla (usar sprintf para forzar cantidad de decimales)
    tabla <- data.frame(
      Item = rownames(res$item.stats),
      Media = sprintf("%.2f", res$item.stats$mean),
      `Desviación típica` = sprintf("%.2f", res$item.stats$sd),
      `r ítem-total` = sprintf("%.3f", res$item.stats$raw.r),
      `r ítem-resto` = sprintf("%.3f", res$item.stats$r.drop),
      `Alfa si se elimina` = sprintf("%.3f", res$alpha.drop$raw_alpha),
      check.names = FALSE
    )

    tabla
  }, striped = TRUE, hover = TRUE, bordered = TRUE)

  # Generar recomendación
  output$recomendacion <- renderUI({
    res <- resultado_alpha()

    if (is.null(res)) {
      return(NULL)
    }

    alfa_actual <- res$total$raw_alpha
    alfa_si_elimina <- res$alpha.drop$raw_alpha
    nombres <- rownames(res$alpha.drop)

    # Encontrar el ítem cuya eliminación más aumenta el alfa
    mejora <- alfa_si_elimina - alfa_actual
    idx_max <- which.max(mejora)

    if (mejora[idx_max] > 0.01) {
      # Hay un ítem que conviene eliminar
      div(
        style = "background-color: #fff3cd; padding: 15px; border-radius: 10px; border-left: 5px solid #ffc107;",
        h4("Sugerencia:"),
        p(paste0("Eliminar el ítem ", nombres[idx_max],
                 " aumentaría el alfa de ", round(alfa_actual, 3),
                 " a ", round(alfa_si_elimina[idx_max], 3),
                 " (+", round(mejora[idx_max], 3), ")"))
      )
    } else {
      # Todos los ítems aportan
      div(
        style = "background-color: #d4edda; padding: 15px; border-radius: 10px; border-left: 5px solid #28a745;",
        h4("Estado:"),
        p("Todos los ítems contribuyen positivamente a la consistencia interna. No se recomienda eliminar ninguno.")
      )
    }
  })
}

################################################################
# EJECUTAR LA APLICACIÓN
################################################################

shinyApp(ui = ui, server = server)