# ================================================================ # EEG Advanced Analysis Shiny App – v1.5 (Depurado y Finalizado) # ================================================================ # --- 1. Carga de Paquetes --- if (!requireNamespace("pacman", quietly = TRUE)) install.packages("pacman") pacman::p_load( edfReader, signal, gsignal, entropy, RColorBrewer, nonlinearTseries, pracma, ggplot2, plotly,WaveletComp, shiny, TSEntropies, seewave, future.apply, data.table, memoise, shinycssloaders, DT, igraph, dplyr, patchwork, tidyr ) # --- 2. Configuración Global --- plan(multisession, workers = future::availableCores() - 1) options(shiny.maxRequestSize = 300 * 1024^2) TARGET_FS <- 250 MAX_CHANNELS <- 16 BAND_LIMS <- list( delta = c(0.5, 4), theta = c(4, 8), alpha = c(8, 13), beta = c(13, 30), gamma = c(30, 100) ) # --- 3. Funciones Auxiliares y de Cálculo --- `%||%` <- function(a, b) if (is.null(a) || length(a) == 0) b else a safe_wrap <- function(expr) { tryCatch(expr, error = function(e) NA_real_, warning = function(w) NA_real_) } filter_band <- memoise::memoise(function(sig, fs, low, high) { if (anyNA(c(sig, fs, low, high)) || fs <= 0 || low >= high || high >= fs/2 || length(sig) < 10) { return(rep(NA_real_, length(sig))) } bf <- signal::butter(4, c(low, high) / (fs / 2), type = "pass") signal::filtfilt(bf, sig) }) read_edf_tidy <- function(path) { header <- edfReader::readEdfHeader(path) signals <- edfReader::readEdfSignals(header) valid_signals <- Filter(function(s) !is.null(s$sRate) && s$sRate > 0 && !is.na(s$label) && s$label != "", signals) if (length(valid_signals) == 0) stop("No se encontraron canales válidos con sRate > 0 en el archivo EDF.") out <- lapply(valid_signals, function(ch) list(samples = ch$signal, fs = as.numeric(ch$sRate))) names(out) <- sapply(valid_signals, `[[`, "label") attr(out, "duration") <- length(out[[1]]$samples) / out[[1]]$fs attr(out, "start_time") <- header$startTime %||% NA return(out) } # --- Funciones de Cálculo de Métricas --- calc_entropy <- function(s) { safe_wrap({ if (sd(s, na.rm = TRUE) < 1e-9) return(NA_real_) counts <- hist(s, breaks = "Sturges", plot = FALSE)$counts entropy::entropy(counts) }) } calc_apen <- function(s, edim = 2) safe_wrap(TSEntropies::ApEn(s, dim = edim, r = 0.2 * sd(s, na.rm = TRUE))) calc_sampen <- function(s, edim = 2) { safe_wrap({ s_sd <- sd(s, na.rm = TRUE) if (is.na(s_sd) || s_sd < 1e-9) return(NA_real_) TSEntropies::SampEn(s, dim = edim, r = 0.2 * s_sd) }) } # ============================================================ # Effort-To-Compress (ETC) # • s: vector numérico (se binariza por media si no es 0-1) # • Devuelve número de pasos (entero) o NA # • Sin dependencias extra (puedes acelerar con Rcpp más adelante) # ============================================================ calc_lzc <- function(s) { tryCatch({ # ── Limpieza básica ───────────────────────────────────── s_clean <- s[is.finite(s)] if (length(s_clean) < 10) return(NA_real_) s_sd <- sd(s_clean) if (is.na(s_sd) || s_sd < 1e-9) return(NA_real_) # ── Binarizar (0/1) por la media ──────────────────────── b <- as.integer(s_clean > mean(s_clean)) if (all(b == 0) || all(b == 1)) return(0) # Secuencia constante # ── Algoritmo ETC puro ───────────────────────────────── steps <- 0 seq <- b repeat { # contar pares pares <- paste0(head(seq, -1), tail(seq, -1)) freq <- table(pares) max_pair <- names(freq)[which.max(freq)] if (freq[max_pair] == 1) break # sin pares repetidos # símbolo nuevo (2 = '10', 3 = '01', 4 = '00', …) new_sym <- max(seq) + 1 # sustituir todos los pares más frecuentes i <- 1 out <- integer(0) while (i <= length(seq)) { if (i < length(seq) && paste0(seq[i], seq[i + 1]) == max_pair) { out <- c(out, new_sym) i <- i + 2 } else { out <- c(out, seq[i]) i <- i + 1 } } seq <- out steps <- steps + 1 if (length(seq) == 1) break } steps }, error = function(e) { cat("Error en calc_etc:", conditionMessage(e), "\n") NA_real_ }) } calc_band_power <- function(sig, fs, low, high) { # Calcula la densidad espectral de potencia (PSD) pwel <- gsignal::pwelch(sig, fs = fs) # Índices de frecuencia dentro de la banda deseada idx <- which(pwel$freq >= low & pwel$freq < high) if (length(idx) < 2) return(NA_real_) # ventana demasiado estrecha # Integra la PSD con la regla del trapecio pracma::trapz(pwel$freq[idx], pwel$spec[idx]) } estimate_1f_exponent <- function(freqs, psd) { idx <- which(freqs > 1 & freqs < 40) if (length(idx) < 5) return(NA_real_) fit <- lm(log10(psd[idx]) ~ log10(freqs[idx])) return(-coef(fit)[2]) } calc_1f_by_channel <- function(ch_list) { exps <- sapply(ch_list, function(ch) { sig <- ch$samples fs <- ch$fs if (length(sig) < fs * 10) return(NA_real_) psd <- gsignal::pwelch(sig, fs = fs) estimate_1f_exponent(psd$freq, psd$spec) }) data.table(canal = names(exps), exponent_1f = round(exps, 3)) } calc_dim_fractal <- function(s, edim = 2, lag = 1) { safe_wrap({ res <- nonlinearTseries::corrDim(time.series = s, min.embedding.dim = edim, time.lag = lag, min.radius = sd(s, na.rm=TRUE)/100, max.radius = sd(s, na.rm=TRUE), n.points.radius = 50, do.plot = FALSE) estimate(res, regression.range = c(1,10)) }) } calc_lyapunov <- function(s, edim = 2, lag = 1) { safe_wrap({ res <- nonlinearTseries::maxLyapunov(time.series = s, min.embedding.dim = edim, time.lag = lag, radius = 0.1 * sd(s, na.rm = TRUE), do.plot = FALSE) estimate(res) }) } process_channel <- function(channel_data, channel_name) { sig <- channel_data$samples fs <- channel_data$fs if (length(sig) < 10 * fs) return(NULL) segment <- sig[1:(10 * fs)] results_list <- lapply(names(BAND_LIMS), function(band_name) { lims <- BAND_LIMS[[band_name]] band_sig <- filter_band(segment, fs, lims[1], lims[2]) if (anyNA(band_sig) || sd(band_sig, na.rm = TRUE) < 1e-9) { return(data.table(banda = band_name, metrica = c("df", "lyap", "entropy", "apen", "sampen", "power"), valor = NA_real_)) } df_val <- calc_dim_fractal(band_sig); lyap_val <- calc_lyapunov(band_sig) entr_val <- calc_entropy(band_sig); apen_val <- calc_apen(band_sig) sampen_val <- calc_sampen(band_sig) power_val <- calc_band_power(segment, fs, lims[1], lims[2]) data.table(banda = band_name, metrica = c("df", "lyap", "entropy", "apen", "sampen", "power"), valor = c(df_val, lyap_val, entr_val, apen_val, sampen_val, power_val)) }) channel_results <- rbindlist(results_list) channel_results[, canal := channel_name] return(channel_results) } # --- Funciones de Análisis Adicional --- # VERSIÓN OPTIMIZADA de calculate_temporal_metrics calculate_temporal_metrics <- function(signal_data, fs, window_size_s = 5, step_size_s = 1) { n_total <- length(signal_data) win_len <- window_size_s * fs step_len <- step_size_s * fs starts <- seq(1, n_total - win_len + 1, by = step_len) # --- OPTIMIZACIÓN LZC: Pre-binarizar la señal completa UNA SOLA VEZ --- signal_binarized <- as.integer(signal_data > mean(signal_data, na.rm = TRUE)) # --- OPTIMIZACIÓN DE BUCLE: Usar future_lapply en lugar de lapply --- temporal_results <- future.apply::future_lapply(starts, function(start_idx) { end_idx <- start_idx + win_len - 1 # Segmentos de la señal cruda para DF y Lyapunov segment_raw <- signal_data[start_idx:end_idx] # Segmento de la señal ya binarizada para LZC segment_bin <- signal_binarized[start_idx:end_idx] # Calcular métricas df_val <- calc_dim_fractal(segment_raw) lyap_val <- calc_lyapunov(segment_raw) # LZC ahora es mucho más rápido, solo llama a la función de complejidad lzc_val <- safe_wrap({ pracma::LZcomplexity(segment_bin)$c }) data.table(time_s = start_idx / fs, df = df_val, lyap = lyap_val, lzc = lzc_val) }, future.seed = TRUE) # future.seed es importante para la reproducibilidad rbindlist(temporal_results) } # ===================================================================== # DINÁMICA DE CONECTIVIDAD ENTRE CANALES (MODULARIDAD) # – Válido para igraph ≥ 1.6 # – Prefiltra UNA sola vez por banda (gran ahorro de tiempo) # – Calcula modularidad Louvain ponderada en cada ventana # – Devuelve data.table: time_s | banda | modularity # ===================================================================== calc_dynamic_connectivity <- function(ch_list, fs = TARGET_FS, win_len_s = 5, step_s = 1, thr = 0.30) { # ------------------------------------------------------- # 0. Igualar longitud y remuestrear todos los canales # ------------------------------------------------------- min_len <- min(sapply(ch_list, \(ch) length(ch$samples))) ch_list <- lapply(ch_list, \(ch) { sig <- ch$samples[1:min_len] if (ch$fs != fs) sig <- signal::resample(sig, p = fs, q = ch$fs) list(samples = sig, fs = fs) }) # Ventanas win_len <- win_len_s * fs step_len <- step_s * fs starts <- seq(1, min_len - win_len + 1, by = step_len) # ------------------------------------------------------- # 1. PREFILTRAR UNA VEZ por banda y canal # ------------------------------------------------------- message("[calc_dynamic_connectivity] Prefiltrando señales…") prefiltradas <- lapply(names(BAND_LIMS), function(bname) { lims <- BAND_LIMS[[bname]] lapply(ch_list, \(ch) filter_band(ch$samples, fs, lims[1], lims[2])) }) names(prefiltradas) <- names(BAND_LIMS) # ------------------------------------------------------- # 2. Bucle (paralelo) sobre ventanas # ------------------------------------------------------- message("[calc_dynamic_connectivity] Procesando ventanas…") future.apply::future_lapply(starts, \(st) { en <- st + win_len - 1 # Por cada banda, recortar el segmento ya filtrado lapply(names(BAND_LIMS), \(band_name) { sigs_seg <- lapply(prefiltradas[[band_name]], `[`, st:en) names(sigs_seg) <- names(ch_list) # ------------------------------ # 2a. Matriz PLV (canal × canal) # ------------------------------ n <- length(sigs_seg) plv_mat <- matrix(1, n, n, dimnames = list(names(sigs_seg), names(sigs_seg))) for (i in 1:(n - 1)) for (j in (i + 1):n) { plv_val <- calculate_plv(sigs_seg[[i]], sigs_seg[[j]], fs) if (is.na(plv_val)) plv_val <- 0 # asegurar valor numérico plv_mat[i, j] <- plv_mat[j, i] <- plv_val } # ------------------------------ # 2b. Grafo ponderado y Louvain # ------------------------------ g <- igraph::graph_from_adjacency_matrix(plv_mat, mode = "undirected", weighted = TRUE, diag = FALSE) # Filtrar aristas débiles (< thr) g <- igraph::delete_edges(g, igraph::E(g)[weight < thr]) mod <- NA_real_ if (igraph::ecount(g) > 0) { comm <- igraph::cluster_louvain(g, weights = igraph::E(g)$weight) mod <- igraph::modularity(comm) # ahora sí, sin error } data.table( time_s = st / fs, banda = band_name, modularity = mod ) }) |> data.table::rbindlist() # fin lapply bandas }, future.seed = TRUE) |> data.table::rbindlist() # fin lapply ventanas } calculate_plv <- function(sig1, sig2, fs) { tryCatch({ # 1. Preparar y limpiar las señales s1 <- sig1[is.finite(sig1)] s2 <- sig2[is.finite(sig2)] len <- min(length(s1), length(s2)) if (len < 50) return(NA_real_) # Wavelet necesita una longitud mínima razonable s1 <- s1[1:len] s2 <- s2[1:len] # 2. Crear el data.frame con nombres, como en los ejemplos de la documentación my_df <- data.frame(signal1 = s1, signal2 = s2) # 3. Llamar a analyze.coherency especificando el par por sus nombres wc_result <- WaveletComp::analyze.coherency( my.data = my_df, my.pair = c("signal1", "signal2"), # <- La clave está aquí loess.span = 0, # Sin suavizado/detrending dt = 1/fs, # Frecuencia de muestreo dj = 1/20, # Resolución make.pval = FALSE, # No necesitamos p-valores, ahorra tiempo verbose = FALSE # Desactivar los mensajes de la consola ) # 4. Extraer la diferencia de fase directamente del resultado $Angle phase_diff <- as.vector(wc_result$Angle) phase_diff <- phase_diff[is.finite(phase_diff)] if(length(phase_diff) == 0) return(NA_real_) plv <- abs(mean(exp(1i * phase_diff))) return(plv) }, error = function(e) { # Este error ya no debería ocurrir, pero lo dejamos por seguridad print(paste("Error final en calculate_plv:", e$message)) return(NA_real_) }) } calculate_max_corr_lag <- function(sig1, sig2, fs) { safe_wrap({ # 1. Asegurarse de que las señales tengan la misma longitud len <- min(length(sig1), length(sig2)) s1 <- sig1[1:len] s2 <- sig2[1:len] # 2. Recortar los bordes trim_len <- floor(0.05 * len) s1 <- s1[(trim_len + 1):(len - trim_len)] s2 <- s2[(trim_len + 1):(len - trim_len)] # 3. Calcular la correlación cruzada sobre las señales limpias correlation_result <- ccf(s1, s2, plot = FALSE, lag.max = floor(fs / 2)) max_corr_lag_idx <- which.max(abs(correlation_result$acf)) max_lag_samples <- correlation_result$lag[max_corr_lag_idx] max_lag_seconds <- max_lag_samples / fs return(max_lag_seconds) }) } # --- 4. Interfaz de Usuario (UI) --- ui <- fluidPage( titlePanel("A cerna da conciencia - v1.5"), sidebarLayout( sidebarPanel( fileInput("edf_file", "1. Subir Archivo EDF", accept = ".edf"), actionButton("analyze_btn", "2. Iniciar Análisis", icon = icon("play"), class = "btn-primary"), hr(), h4("3. Selección de Visualización"), uiOutput("canal_selector_ui"), uiOutput("banda_selector_ui"), hr(), h4("4. Análisis Adicionales"), actionButton("attractor_btn", "Generar Análisis Comparativos", icon = icon("cogs")), hr(), h4("5. Análisis Global Integrado"), actionButton("analyze_ego_btn", "Calcular Vestigium Animae", icon = icon("atom"), class = "btn-danger"), hr(), # Este hr estaba duplicado y desubicado, lo he movido downloadButton("dl_metrics", "Descargar Métricas (CSV)"), downloadButton("dl_temporal", "Descargar Métricas Temporales (CSV)"), hr(), h4("Metadatos del Archivo"), verbatimTextOutput("edf_meta") ), mainPanel( textOutput("status_text") %>% withSpinner(type = 6), tabsetPanel(id = "main_tabs", tabPanel("Ruido Rosa", h4("Análisis 1/f (Ruido Rosa) por Canal"), actionButton("calc_1f_btn", "Calcular Exponentes 1/f", icon = icon("chart-line")), plotlyOutput("plot_1f_exponents") %>% withSpinner(), DTOutput("table_1f_exponents") ), tabPanel("Vista por Canal", fluidRow( column(6, plotlyOutput("signal_plot") %>% withSpinner()), column(6, plotlyOutput("psd_plot") %>% withSpinner()) ), DT::dataTableOutput("metrics_table") ), tabPanel("Conectividad (Heatmaps)", fluidRow( column(6, plotlyOutput("df_heatmap") %>% withSpinner()), column(6, plotlyOutput("lyap_heatmap") %>% withSpinner()) ), fluidRow( column(6, plotlyOutput("power_heatmap") %>% withSpinner()) ) ), tabPanel("Análisis de Atractores", plotlyOutput("attractor_plot", height = "700px") %>% withSpinner() ), tabPanel("Métricas en el Tiempo", plotlyOutput("df_time_plot") %>% withSpinner(), plotlyOutput("lyap_time_plot") %>% withSpinner(), plotlyOutput("lzc_time_plot") %>% withSpinner() ), tabPanel("GPS de la Conciencia", plotlyOutput("conscience_gps_plot", height = "700px") %>% withSpinner(), hr(), p(em("Este gráfico posiciona cada canal de EEG en un espacio de 2D. El Eje X representa la complejidad/organización del sistema (valores bajos = simple/inconsciente, valores altos = complejo/desorganizado). El Eje Y representa la flexibilidad/foco (valores bajos = foco alto/rígido, valores altos = divagación/flexible).")) ), tabPanel("Análisis de Estabilidad", h4("Detector de Puntos de Cambio de Estado"), p("Este análisis calcula el exponente de Lyapunov para ventanas de tiempo crecientes. Una interrupción brusca en una línea sugiere un cambio en la dinámica cerebral (pérdida de estacionariedad) en esa banda de frecuencia y en ese instante."), hr(), fluidRow( column(4, h5("El análisis se realizará sobre el canal seleccionado en el panel izquierdo.") ), column(4, sliderInput("window_duration_slider", "Rango de Duración de Ventana (s):", min = 5, max = 60, value = c(5, 30), step = 1) ), column(4, actionButton("analyze_stability_btn", "Analizar Estabilidad del Canal", icon = icon("chart-line"), class = "btn-success", style="margin-top: 25px;") ) ), hr(), plotlyOutput("stability_plot", height = "600px") %>% withSpinner() ), # --- SECCIÓN CORREGIDA --- tabPanel("Vestigium Animae", h4("Traxectoria Dinámica Global do Cerebro"), p(HTML("Este gráfico mostra a traxectoria do estado cerebral global ó longo do tempo, nun espazo de 3 dimensións: Coherencia (integración entre rexións), Complexidade (diferenciación funcional) e Estabilidade (inercia do sistema). Unha traxectoria compacta suxire un estado estable; unha traxectoria errática suxire un estado fragmentado ou en transición.")), hr(), fluidRow( column(6, sliderInput("ego_window_slider", "Duración da Fiestra de Análise (s):", min = 2, max = 15, value = 5, step = 1), helpText("Unha fiestra máis pequena ofrece máis resolución temporal pero pode ser máis ruidosa.") ) ), plotlyOutput("ego_plot", height = "600px") %>% withSpinner(type = 4), # <- La coma va aquí hr(), # Una línea para separar visualmente h4("Mapa de Residencia de Estados (Atractores)"), p("Este mapa de calor mostra en que combinacións de 'Complexidade' e 'Coherencia' pasou o cerebro a maior parte do tempo. As áreas máis 'quentes' (amarelas) representan os estados dominantes ou 'atractores' do sistema."), plotlyOutput("ego_heatmap_plot", height = "500px") %>% withSpinner(type = 4), # El botón ahora está DENTRO del tabPanel, antes del paréntesis de cierre br(), downloadButton( "download_ego_data", "Descargar Datos da Traxectoria (.csv)" ) ), # <-- AHORA SÍ: El paréntesis que cierra el tabPanel va aquí tabPanel("Sincronización Inter-Banda", fluidRow( column(6, plotlyOutput("plv_heatmap") %>% withSpinner()), column(6, plotlyOutput("lag_heatmap") %>% withSpinner()) ), hr(), h4("Valores Numéricos de Sincronización"), DT::dataTableOutput("sincro_table") ), tabPanel("Red Dinámica", fluidRow( column(4, sliderInput("dyn_win_slider", "Ventana (s):", min = 2, max = 15, value = 5), sliderInput("dyn_step_slider", "Paso (s):", min = 1, max = 5, value = 1), numericInput("dyn_thr_input", "Umbral PLV:", value = 0.3, min = 0, max = 1, step = 0.05), actionButton("dyn_conn_btn", "Calcular dinámica", icon = icon("project-diagram"), class = "btn-primary") ), column(8, plotlyOutput("dyn_mod_plot", height = "550px") %>% withSpinner(type = 6) ) ) ), ) # Cierre de tabsetPanel ) # Cierre de mainPanel ) # Cierre de sidebarLayout ) # Cierre de fluidPage # --- 5. Lógica del Servidor (Server) --- server <- function(input, output, session) { rv <- reactiveValues(raw_data = NULL, results_tidy = NULL, temporal_metrics = NULL) # --- Observadores y Reactivos Básicos --- observeEvent(input$edf_file, { req(input$edf_file) output$status_text <- renderText("Leyendo archivo EDF...") tryCatch({ rv$raw_data <- read_edf_tidy(input$edf_file$datapath) output$status_text <- renderText(paste("Archivo cargado.", length(rv$raw_data), "canales encontrados.")) }, error = function(e) { showNotification(paste("Error al leer:", e$message), type = "error") }) }) selected_signal <- reactive({ req(rv$raw_data, input$selected_canal); rv$raw_data[[input$selected_canal]]$samples }) selected_fs <- reactive({ req(rv$raw_data, input$selected_canal); rv$raw_data[[input$selected_canal]]$fs }) selected_data <- reactive({ req(rv$results_tidy, input$selected_canal, input$selected_banda); rv$results_tidy[canal == input$selected_canal & banda == input$selected_banda] }) # --- ANÁLISIS PRINCIPAL --- observeEvent(input$analyze_btn, { req(rv$raw_data) withProgress(message = 'Iniciando análisis...', value = 0, { data_to_process <- rv$raw_data data_to_process <- lapply(data_to_process, function(ch) { if (ch$fs != TARGET_FS) { ch$samples <- signal::resample(ch$samples, p = TARGET_FS, q = ch$fs) ch$fs <- TARGET_FS } return(ch) }) variances <- sapply(data_to_process, function(ch) var(ch$samples, na.rm = TRUE)) selected_names <- names(sort(variances, decreasing = TRUE))[1:min(MAX_CHANNELS, length(variances))] data_to_process <- data_to_process[selected_names] incProgress(0.3, detail = "Procesando en paralelo...") results_list <- future.apply::future_lapply(names(data_to_process), FUN = function(ch_name) { process_channel(data_to_process[[ch_name]], ch_name) }, future.seed = TRUE) incProgress(0.5, detail = "Consolidando resultados...") valid_results <- Filter(Negate(is.null), results_list) if (length(valid_results) == 0) { showNotification("El análisis no produjo resultados válidos.", type = "error"); return() } rv$results_tidy <- rbindlist(valid_results) output$status_text <- renderText(paste("Análisis completado para", length(valid_results), "canales.")) }) }) # --- ANÁLISIS ADICIONALES (COMPARATIVOS) --- all_adicional_calcs <- eventReactive(input$attractor_btn, { req(selected_signal(), selected_fs()) withProgress(message = "Generando análisis adicionales...", value = 0, { signal <- selected_signal(); fs <- selected_fs() attractors_list <- list(); filtered_signals <- list() # 1. Análisis por banda (Atractores y Sincronización) print("--- INICIANDO DEPURACIÓN DE FILTRADO DE BANDAS ---") for (i in seq_along(BAND_LIMS)) { band_name <- names(BAND_LIMS)[i] lims <- BAND_LIMS[[i]] incProgress(1 / (length(BAND_LIMS) + 2), detail = paste("Banda:", band_name)) sig_filt <- filter_band(signal, fs, lims[1], lims[2]) s_sd <- sd(sig_filt, na.rm = TRUE) print(paste("Banda:", band_name, "| SD:", round(s_sd, 10), "| ¿Es NA?:", is.na(s_sd))) if (is.na(s_sd) || s_sd < 1e-9) { print(paste("-> BANDA", band_name, "RECHAZADA (SD muy baja o NA).")) next } print(paste("-> BANDA", band_name, "ACEPTADA.")) filtered_signals[[band_name]] <- sig_filt sig_sub <- sig_filt[seq(1, length(sig_filt), by = 5)] lag <- tryCatch(timeLag(sig_sub, technique="ami", do.plot=F), error=function(e) 1) if(is.na(lag)||!is.finite(lag)||lag<1) lag<-1 emb_dim <- tryCatch(estimateEmbeddingDim(sig_sub, time.lag=lag, max.embedding.dim=5, do.plot=F), error=function(e) 3) if(is.na(emb_dim)||!is.finite(emb_dim)||emb_dim<2) emb_dim<-3 attractors_list[[band_name]] <- as.data.frame(buildTakens(sig_sub, emb_dim, lag)) } print("--- FIN DE DEPURACIÓN DE FILTRADO ---") # 2. Sincronización print(paste("Número de bandas válidas para sincronización:", length(filtered_signals))) incProgress(1 / (length(BAND_LIMS) + 2), detail = "Sincronización...") band_names_validos <- names(filtered_signals) n_bands_validas <- length(band_names_validos) plv_matrix <- matrix(NA, nrow = n_bands_validas, ncol = n_bands_validas, dimnames = list(band_names_validos, band_names_validos)) lag_matrix <- matrix(NA, nrow = n_bands_validas, ncol = n_bands_validas, dimnames = list(band_names_validos, band_names_validos)) if (n_bands_validas > 1) { # Usar bucles for que solo recorren la mitad superior de la matriz para eficiencia for (i in 1:(n_bands_validas)) { for (j in i:n_bands_validas) { # El bucle j empieza en i banda1_nombre <- band_names_validos[i] banda2_nombre <- band_names_validos[j] sig1 <- filtered_signals[[banda1_nombre]] sig2 <- filtered_signals[[banda2_nombre]] if (i == j) { plv_matrix[i, j] <- 1.0 lag_matrix[i, j] <- 0.0 } else { # Calcular una vez plv_val <- calculate_plv(sig1, sig2, fs = fs) lag_val <- calculate_max_corr_lag(sig1, sig2, fs = fs) # Asignar a ambas celdas simétricas plv_matrix[i, j] <- plv_matrix[j, i] <- plv_val # Para el lag, la relación es antisimétrica lag_matrix[i, j] <- lag_val lag_matrix[j, i] <- -lag_val } } } } # 3. Métricas temporales (sobre la señal cruda) incProgress(1 / (length(BAND_LIMS) + 2), detail = "Métricas temporales...") rv$temporal_metrics <- calculate_temporal_metrics(signal, fs) # --- REEMPLAZAR ESTA SECCIÓN DENTRO DE all_adicional_calcs --- # --- NUEVO: CÁLCULO DE PCA PARA CADA ATRACTOR (VERSIÓN ROBUSTA) --- print("--- INICIANDO CÁLCULO DE PCA ---") pca_lines_list <- list() if (length(attractors_list) > 0) { for (band_name in names(attractors_list)) { # Usamos un tryCatch para capturar cualquier error durante el PCA tryCatch({ df_takens <- attractors_list[[band_name]] # Comprobar si hay suficientes datos y varianza if (nrow(df_takens) > 10 && all(sapply(df_takens, function(col) var(col, na.rm = TRUE) > 1e-9))) { # Realizar PCA pca_result <- prcomp(df_takens, center = TRUE, scale. = TRUE) pc1_vector <- pca_result$rotation[, 1] center_point <- pca_result$center line_length <- 9 * sd(pca_result$x[, 1]) p_start <- center_point - line_length * pc1_vector p_end <- center_point + line_length * pc1_vector # Guardar los puntos de la línea linea_df <- data.frame( V1 = c(p_start[1], p_end[1]), V2 = c(p_start[2], p_end[2]), V3 = c(p_start[3], p_end[3]) ) pca_lines_list[[band_name]] <- linea_df # Imprimir confirmación print(paste("-> PCA para la banda", band_name, "CALCULADO CON ÉXITO.")) } else { print(paste("-> PCA para la banda", band_name, "SALTADO (datos insuficientes o sin varianza).")) } }, error = function(e) { # Si prcomp falla, imprimir el error print(paste("-> ERROR en PCA para la banda", band_name, ":", e$message)) }) } } print("--- FIN DE CÁLCULO DE PCA ---") # MODIFICAR LA LISTA DE RETORNO PARA INCLUIR LAS LÍNEAS PCA list( attractors = attractors_list, pca_lines = pca_lines_list, plv_matrix = plv_matrix, lag_matrix = lag_matrix ) }) }) output$dyn_mod_plot <- renderPlotly({ df <- dynamic_conn_results() req(nrow(df) > 0) plot_ly( data = df, x = ~time_s, y = ~modularity, color = ~banda, colors = "Set1", type = 'scatter', mode = 'lines+markers', connectgaps = FALSE ) %>% layout( title = "Modularidad de la Red a lo largo del Tiempo", xaxis = list(title = "Tiempo (s)"), yaxis = list(title = "Modularidad (0 = sin comunidad, 1 = muy modular)"), legend = list(title = list(text = "Banda")), hovermode = "x unified" ) }) dynamic_conn_results <- eventReactive(input$dyn_conn_btn, { req(rv$raw_data) withProgress(message = "Calculando red dinámica...", value = 0, { incProgress(0.1, detail = "Preparando señales...") res <- calc_dynamic_connectivity( ch_list = rv$raw_data, fs = TARGET_FS, win_len_s = input$dyn_win_slider, step_s = input$dyn_step_slider, thr = input$dyn_thr_input ) incProgress(1) res }) }) observeEvent(input$calc_1f_btn, { req(rv$raw_data) withProgress(message = "Calculando exponentes 1/f (ruido rosa)...", value = 0.5, { df <- calc_1f_by_channel(rv$raw_data) df[, exponent_1f := round(exponent_1f, 3)] rv$exp1f_df <- df }) }) output$plot_1f_exponents <- renderPlotly({ req(rv$exp1f_df) df_sorted <- rv$exp1f_df[order(exponent_1f)] # Añadir columna para color: rojo si fuera del rango típico df_sorted[, color := ifelse(exponent_1f < 0.9 | exponent_1f > 1.5, "rgba(222,45,38,0.8)", "rgba(55,128,191,0.8)")] plot_ly( data = df_sorted, x = ~canal, y = ~exponent_1f, type = 'bar', marker = list(color = ~color), text = ~paste("Canal:", canal, "
Exponente:", exponent_1f), hoverinfo = 'text' ) %>% layout( title = "Exponentes 1/f por Canal", xaxis = list(title = "Canal"), yaxis = list(title = "Exponente 1/f", range = c(0, max(df_sorted$exponent_1f, na.rm = TRUE) + 0.2)), shapes = list( list(type = "line", x0 = -0.5, x1 = length(df_sorted$canal) - 0.5, y0 = 0.9, y1 = 0.9, line = list(color = "orange", dash = "dot")), list(type = "line", x0 = -0.5, x1 = length(df_sorted$canal) - 0.5, y0 = 1.5, y1 = 1.5, line = list(color = "orange", dash = "dot")) ), annotations = list( list(x = 0, y = 0.92, text = "Límite inferior (ruido blanco)", showarrow = FALSE, xanchor = "left", yanchor = "bottom", font = list(size = 10)), list(x = 0, y = 1.52, text = "Límite superior (ruido marrón)", showarrow = FALSE, xanchor = "left", yanchor = "bottom", font = list(size = 10)) ) ) }) output$table_1f_exponents <- renderDT({ req(rv$exp1f_df) datatable(rv$exp1f_df, options = list(pageLength = 20)) }) # --- Bloque 1: Lógica de Cálculo de Estabilidad --- # Pega este bloque completo dentro de la función del servidor. stability_results <- eventReactive(input$analyze_stability_btn, { # Requerimos los datos necesarios: la señal del canal seleccionado req(selected_signal(), selected_fs()) signal <- selected_signal() fs <- selected_fs() # Obtenemos el rango de duraciones del slider start_win <- input$window_duration_slider[1] end_win <- input$window_duration_slider[2] window_durations <- seq(start_win, end_win, by = 1) # Analizamos segundo a segundo # Preparamos la barra de progreso withProgress(message = 'Analizando estabilidad...', value = 0, { # Creamos una lista para guardar los resultados de cada banda all_bands_results <- list() # Bucle SOBRE CADA BANDA de frecuencia for (i in seq_along(BAND_LIMS)) { band_name <- names(BAND_LIMS)[i] lims <- BAND_LIMS[[i]] incProgress(i / length(BAND_LIMS), detail = paste("Procesando banda:", band_name)) # Filtramos la señal COMPLETA una sola vez para la banda actual band_sig_full <- filter_band(signal, fs, lims[1], lims[2]) if (anyNA(band_sig_full)) next # Si el filtrado falla, saltamos a la siguiente banda # Bucle INTERNO para cada duración de ventana results_for_this_band <- lapply(window_durations, function(duration_s) { # Recortamos el segmento de la señal de banda ya filtrada num_samples <- duration_s * fs if (num_samples > length(band_sig_full)) return(NULL) # Evitar errores si pedimos más de lo que hay segment <- band_sig_full[1:num_samples] # Calculamos Lyapunov sobre este segmento lyap_val <- calc_lyapunov(segment) # Devolvemos un data.table con el resultado data.table(banda = band_name, duracion_s = duration_s, lyap = lyap_val) }) # Guardamos los resultados de la banda actual all_bands_results[[band_name]] <- rbindlist(results_for_this_band) } # Combinamos todos los resultados en un único data.frame rbindlist(all_bands_results) }) }) # --- Bloque 2: Generación del Gráfico de Estabilidad --- # Pega este bloque también dentro de la función del servidor. output$stability_plot <- renderPlotly({ # Esperamos a que los resultados del análisis de estabilidad estén listos plot_data <- stability_results() req(nrow(plot_data) > 0) # Creamos el gráfico con plotly plot_ly( data = plot_data, x = ~duracion_s, y = ~lyap, color = ~banda, colors = "Set1", type = 'scatter', mode = 'lines+markers', # Con connectgaps = FALSE, la línea se interrumpirá donde haya valores NA connectgaps = FALSE ) %>% layout( title = paste("Análisis de Estabilidad para el Canal:", input$selected_canal), xaxis = list(title = "Duración de la Ventana de Análisis (s)"), yaxis = list(title = "Exponente de Lyapunov (Lyap)"), legend = list(title = list(text = 'Banda')), hovermode = "x unified" ) }) # Definimos el manejador de la descarga para el botón 'download_ego_data' output$download_ego_data <- downloadHandler( # 1. Definimos el nombre del archivo filename = function() { # Creamos un nombre de archivo dinámico con la fecha actual paste("ego_trajectory_data-", Sys.Date(), ".csv", sep = "") }, # 2. Definimos el contenido del archivo content = function(file) { # Obtenemos los mismos datos reactivos que se usan para el gráfico data_to_download <- ego_trajectory_data() # --- LA SOLUCIÓN ESTÁ AQUÍ --- # Usamos req() para asegurarnos de que los datos existen antes de continuar. # Si 'data_to_download' es NULL, la ejecución de esta función se detiene aquí silenciosamente. req(data_to_download, nrow(data_to_download) > 0) # Si el código llega hasta aquí, es porque req() ha validado que los datos son correctos. # Por lo tanto, el bloque 'if (is.null...)' ya no es estrictamente necesario, # pero podemos dejarlo por si acaso. # Escribimos los datos en el archivo temporal en formato CSV. write.csv(data_to_download, file, row.names = FALSE) } ) # --- PEGA ESTE BLOQUE COMPLETO DENTRO DEL SERVER --- ego_trajectory_data <- eventReactive(input$analyze_ego_btn, { req(rv$raw_data) canales_a_procesar <- if (!is.null(rv$results_tidy)) { unique(rv$results_tidy$canal) } else { names(rv$raw_data)[1:min(length(rv$raw_data), MAX_CHANNELS)] } fs <- TARGET_FS raw_signals_list <- rv$raw_data[canales_a_procesar] min_len <- min(sapply(raw_signals_list, function(ch) length(ch$samples))) signals_matrix <- sapply(raw_signals_list, function(ch) { s <- ch$samples[1:min_len] if (ch$fs != fs) signal::resample(s, p = fs, q = ch$fs) else s }) win_len_s <- input$ego_window_slider win_len_samples <- win_len_s * fs step_len_samples <- 1 * fs starts <- seq(1, min_len - win_len_samples + 1, by = step_len_samples) withProgress(message = 'Calculando Vestigium Animae...', value = 0, { incProgress(0.1, detail = "Pre-filtrando canales en banda alfa...") alfa_signals_matrix_full <- apply(signals_matrix, 2, function(ch_sig) { filter_band(ch_sig, fs, BAND_LIMS$alpha[1], BAND_LIMS$alpha[2]) }) trajectory_points <- lapply(seq_along(starts), function(i) { # --- INICIO DE LA MODIFICACIÓN CON tryCatch --- # Envolvemos el cálculo de cada punto de la trayectoria en un tryCatch # para que un error en una sola ventana no detenga todo el análisis. tryCatch({ start_idx <- starts[i] incProgress(0.1 + (0.8 * i / length(starts)), detail = paste("Procesando fiestra", i, "de", length(starts))) segment_matrix <- signals_matrix[start_idx:(start_idx + win_len_samples - 1), ] alfa_segment_matrix <- alfa_signals_matrix_full[start_idx:(start_idx + win_len_samples - 1), ] pares <- combn(1:ncol(alfa_segment_matrix), 2) plv_values <- apply(pares, 2, function(p) { calculate_plv(alfa_segment_matrix[, p[1]], alfa_segment_matrix[, p[2]], fs) }) coherencia_global <- mean(plv_values, na.rm = TRUE) lyap_per_channel <- apply(segment_matrix, 2, calc_lyapunov) complejidad_global <- sd(lyap_per_channel, na.rm = TRUE) # Si alguno de los cálculos da NaN (porque todos los inputs eran NA), # también lo trataremos como un error para saltar esta ventana. if (is.nan(coherencia_global) || is.nan(complejidad_global)) { stop("Cálculo resultó en NaN, saltando ventana.") } data.table(tempus = start_idx / fs, coherentia = coherencia_global, complexitas = complejidad_global) }, error = function(e) { # Si ocurre un error, imprimimos un aviso en la consola de R (muy útil para depurar) # y devolvemos NULL. rbindlist ignorará los elementos NULL. cat("AVISO: Error procesando la ventana", i, ". Saltando. Mensaje:", conditionMessage(e), "\n") return(NULL) }) # --- FIN DE LA MODIFICACIÓN --- }) trajectory_df <- rbindlist(trajectory_points) # --- Añadimos una comprobación antes de calcular la estabilidad --- # Si todas las ventanas fallaron, trajectory_df estará vacío. req(nrow(trajectory_df) > 0) incProgress(0.9, detail = "Calculando estabilidade...") trajectory_df[, stabilitas := 1 - abs(c(0, diff(complexitas)) + c(0, diff(coherentia)))] return(na.omit(trajectory_df)) }) }) # ====================================================================== # RENDERIZACIÓN DEL MAPA DE CALOR DE RESIDENCIA # ====================================================================== output$ego_heatmap_plot <- renderPlotly({ # Usamos los mismos datos que la trayectoria 3D plot_data <- ego_trajectory_data() # Requerimos que los datos existan para evitar errores req(plot_data, nrow(plot_data) > 0) # Creamos el gráfico de densidad 2D plot_ly( data = plot_data, x = ~coherentia, y = ~complexitas, type = 'histogram2d', # ¡Este es el tipo de gráfico clave! colorscale = 'Viridis', # Usamos la misma escala de color para consistencia nbinsx = 50, # Número de "cajas" en el eje X para calcular la densidad nbinsy = 50, # Número de "cajas" en el eje Y zmax = quantile(table(cut(plot_data$coherentia, 50), cut(plot_data$complexitas, 50)), 0.98), # Evita que un solo pico sature la escala de color colorbar = list(title = "Tempo de
Residencia") ) %>% layout( title = "Densidade de Estados: Complexidade vs. Coherencia", xaxis = list(title = "Coherencia Global (PLV Alfa)"), yaxis = list(title = "Complexidade Global (SD Lyapunov)"), margin = list(l = 50, r = 10, b = 50, t = 50) # Ajustar márgenes ) }) # --- PEGA ESTE BLOQUE TAMBIÉN DENTRO DEL SERVER --- output$ego_plot <- renderPlotly({ # Esperamos a que los datos de la trayectoria estén listos plot_data <- ego_trajectory_data() req(nrow(plot_data) > 2) # Necesitamos al menos 3 puntos para una trayectoria # --- INICIO DE LA MODIFICACIÓN --- # 1. Determinar los límites del cubo basándose en los datos, con un pequeño padding x_range <- range(plot_data$coherentia, na.rm = TRUE) y_range <- range(plot_data$complexitas, na.rm = TRUE) z_range <- range(plot_data$stabilitas, na.rm = TRUE) # 2. Crear el data frame con las coordenadas y etiquetas de los 8 rincones # Nota: Las coordenadas corresponden a los ejes de TU CÓDIGO (x=coherencia, y=complexidade, z=estabilidade) corners_df <- data.frame( x = c(x_range[2], x_range[2], x_range[1], x_range[1], x_range[1], x_range[2], x_range[1], x_range[2]), y = c(y_range[1], y_range[2], y_range[2], y_range[1], y_range[2], y_range[2], y_range[1], y_range[1]), z = c(z_range[2], z_range[2], z_range[2], z_range[2], z_range[1], z_range[1], z_range[1], z_range[1]), label = c( "Unda Synchronica", # Rincón 8: B-Comp(y), A-Coh(x), B-Stab(z) -- ¡REVISADO! "Focus Stabilis", # Rincón 2: A-Comp(y), A-Coh(x), A-Stab(z) "Tumultus Inefficax", # Rincón 3: A-Comp(y), B-Coh(x), A-Stab(z) "Vacuitas Stabilis", # Rincón 4: B-Comp(y), B-Coh(x), A-Stab(z) "Chaos Transiens", # Rincón 5: A-Comp(y), B-Coh(x), B-Stab(z) "Momentum Lucidum", # Rincón 6: A-Comp(y), A-Coh(x), B-Stab(z) "Hiatus Brevis", # Rincón 7: B-Comp(y), B-Coh(x), B-Stab(z) "Ordo Rigidus" # Rincón 1: B-Comp(y), A-Coh(x), A-Stab(z) -- ¡REVISADO! ) ) # --- FIN DE LA MODIFICACIÓN --- plot_ly( data = plot_data, x = ~coherentia, y = ~complexitas, z = ~stabilitas, type = 'scatter3d', mode = 'lines', line = list( width = 6, color = ~tempus, colorscale = 'Viridis', showscale = TRUE, colorbar = list(title = "Tempo (s)") ), hoverinfo = 'text', text = ~paste( "Tempo:", round(tempus, 1), "s
", "Coherencia:", round(coherentia, 3), "
", "Complexidade:", round(complexitas, 3), "
", "Estabilidade:", round(stabilitas, 3) ) ) %>% # --- AÑADIMOS LA NUEVA TRAZA PARA LAS ETIQUETAS --- add_trace( data = corners_df, x = ~x, y = ~y, z = ~z, type = 'scatter3d', mode = 'text', text = ~label, textfont = list(color = '#666666', size = 12), # Fuente sutil para no distraer hoverinfo = 'text', # Muestra el nombre del rincón al pasar el ratón showlegend = FALSE, # No mostrar en la leyenda inherit = FALSE # ¡MUY IMPORTANTE! No heredar propiedades de la traza principal ) %>% # --- FIN DE LA NUEVA TRAZA --- layout( title = "Traxectoria do Estado Cerebral Global", scene = list( xaxis = list(title = "Coherencia Global (PLV Alfa)"), yaxis = list(title = "Complexidade Global (SD Lyapunov)"), zaxis = list(title = "Estabilidade Temporal") ), margin = list(l = 0, r = 0, b = 0, t = 40) ) }) # --- GENERACIÓN DE OUTPUTS --- # Selectores dinámicos output$canal_selector_ui <- renderUI({ req(rv$results_tidy); selectInput("selected_canal", "Canal:", choices=unique(rv$results_tidy$canal)) }) output$banda_selector_ui <- renderUI({ req(rv$results_tidy); selectInput("selected_banda", "Banda:", choices=names(BAND_LIMS), selected="alpha") }) output$edf_meta <- renderPrint({ req(rv$raw_data); list(canales=length(rv$raw_data), duracion_s=attr(rv$raw_data,"duration"), inicio=attr(rv$raw_data,"start_time")) }) # --- AÑADIR ESTE NUEVO OUTPUT AL SERVIDOR --- output$sincro_table <- renderDataTable({ results <- all_adicional_calcs() # Requerir ambas matrices para mostrar la tabla req(results$plv_matrix, results$lag_matrix) # Convertir las matrices a data.tables para poder unirlas plv_df <- as.data.frame(as.table(results$plv_matrix)) colnames(plv_df) <- c("Banda_1", "Banda_2", "PLV") lag_df <- as.data.frame(as.table(results$lag_matrix)) colnames(lag_df) <- c("Banda_1", "Banda_2", "Retardo_s") # Unir las dos tablas sincro_df <- merge(plv_df, lag_df, by = c("Banda_1", "Banda_2")) # Filtrar para no mostrar las comparaciones de una banda consigo misma sincro_df <- sincro_df[sincro_df$Banda_1 != sincro_df$Banda_2, ] # Formatear la tabla para una mejor visualización DT::datatable( sincro_df, options = list(pageLength = 10, searching = FALSE, lengthChange = FALSE), rownames = FALSE, caption = "Tabla de Sincronización entre Pares de Bandas" ) %>% DT::formatRound(columns = c("PLV", "Retardo_s"), digits = 4) }) # Gráficos básicos output$signal_plot <- renderPlotly({ req(selected_signal(), selected_fs()); n_pts <- min(length(selected_signal()), 10*selected_fs()); plot_ly(x=~(1:n_pts)/selected_fs(), y=~selected_signal()[1:n_pts], type='scatter', mode='lines') %>% layout(title=paste("Señal (10s) -", input$selected_canal), xaxis=list(title="Tiempo (s)"), yaxis=list(title="Amplitud")) }) output$psd_plot <- renderPlotly({ req(selected_signal(), selected_fs()); p <- gsignal::pwelch(x=selected_signal(), fs=selected_fs()); plot_ly(x=~p$freq, y=~10*log10(p$spec), type='scatter', mode='lines') %>% layout(title=paste("PSD -", input$selected_canal), xaxis=list(title="Frecuencia (Hz)"), yaxis=list(title="Potencia (dB/Hz)")) }) output$metrics_table <- DT::renderDataTable({ req(selected_data()); DT::datatable(selected_data()[,.(metrica, valor=round(valor,4))], options=list(dom='t')) }) # Heatmaps output$df_heatmap <- renderPlotly({ req(rv$results_tidy); df_data <- rv$results_tidy[metrica=="df"]; if(all(is.na(df_data$valor))) return(); wide <- dcast(df_data, canal~banda, value.var="valor"); mat <- as.matrix(wide[,-"canal"]); rownames(mat) <- wide$canal; plot_ly(z=mat, x=colnames(mat), y=rownames(mat), type="heatmap", colorscale="Viridis") %>% layout(title="Dimensión Fractal") }) output$lyap_heatmap <- renderPlotly({ req(rv$results_tidy); lyap_data <- rv$results_tidy[metrica=="lyap"]; if(all(is.na(lyap_data$valor))) return(); wide <- dcast(lyap_data, canal~banda, value.var="valor"); mat <- as.matrix(wide[,-"canal"]); rownames(mat) <- wide$canal; plot_ly(z=mat, x=colnames(mat), y=rownames(mat), type="heatmap", colorscale="Viridis") %>% layout(title="Exponente de Lyapunov") }) output$power_heatmap <- renderPlotly({ req(rv$results_tidy) pw_data <- rv$results_tidy[metrica == "power"] if (all(is.na(pw_data$valor))) return() wide <- dcast(pw_data, canal ~ banda, value.var = "valor") mat <- as.matrix(wide[ , -"canal"]) rownames(mat) <- wide$canal plot_ly( z = mat, x = colnames(mat), y = rownames(mat), type = "heatmap", colorscale = "Viridis" ) %>% layout(title = "Potencia (área PSD) por Canal y Banda") }) # Plots de análisis adicionales # --- REEMPLAZAR ESTE OUTPUT EN EL SERVIDOR --- # --- REEMPLAZAR ESTE OUTPUT CON LA VERSIÓN UNIFICADA Y FINAL --- output$attractor_plot <- renderPlotly({ results <- all_adicional_calcs() req(results$attractors, results$pca_lines) # --- 1. Preparar los DATOS DE PUNTOS --- # Combinar todos los data.frames de atractores en uno solo all_points_df <- data.table::rbindlist(results$attractors, idcol = "banda") req(nrow(all_points_df) > 0) # --- 2. Preparar los DATOS DE LÍNEAS --- # Combinar todos los data.frames de líneas PCA en uno solo all_lines_df <- data.table::rbindlist(results$pca_lines, idcol = "banda") req(nrow(all_lines_df) > 0) # --- 3. Construir el Gráfico en Capas --- plot_ly() %>% # Capa 1: Añadir todos los PUNTOS de los atractores add_trace( data = all_points_df, x = ~V1, y = ~V2, z = ~V3, color = ~banda, colors = "Set1", type = 'scatter3d', mode = 'markers', marker = list(size = 1.5, opacity = 0.5), name = ~banda, legendgroup = ~banda ) %>% # Capa 2: Añadir todas las LÍNEAS PCA add_trace( data = all_lines_df, x = ~V1, y = ~V2, z = ~V3, color = ~banda, # Usar la misma variable de color para que coincidan colors = "Set1", type = 'scatter3d', mode = 'lines', line = list(width = 8), # Línea más gruesa legendgroup = ~banda, showlegend = FALSE # No mostrar leyenda para las líneas para evitar duplicados ) %>% # Capa 3: Configurar el Layout layout( title = paste("Atractores Comparativos con Eje Principal (PC1) - Canal:", input$selected_canal), scene = list( xaxis = list(title = 'V1'), yaxis = list(title = 'V2'), zaxis = list(title = 'V3') ), legend = list(title = list(text = ' Bandas ')) ) }) # --- AÑADIR ESTE NUEVO OUTPUT AL SERVIDOR --- output$conscience_gps_plot <- renderPlotly({ req(rv$results_tidy) # Necesitamos los resultados del análisis principal # 1. Procesar los datos para obtener un valor por canal para cada eje # Filtramos las bandas relevantes. Excluimos delta (a menudo ruido) y gamma (comportamiento diferente) # para centrarnos en las bandas de la "conciencia" (theta, alpha, beta). data_for_gps <- rv$results_tidy[banda %in% c("theta", "alpha", "beta")] # Agrupar por canal y calcular los valores para los ejes X e Y gps_data <- data_for_gps[, .( # Eje X: Promedio de Df y Entropía (normalizados para que tengan la misma escala) eje_x_complejidad = mean(scale(valor[metrica == "df"])) + mean(scale(valor[metrica == "entropy"])), # Eje Y: Promedio de Lyapunov eje_y_flexibilidad = mean(valor[metrica == "lyap"]) ), by = canal] # Eliminar filas con NA si algún cálculo falló gps_data <- na.omit(gps_data) req(nrow(gps_data) > 0) # 2. Crear el gráfico interactivo con plotly plot_ly( data = gps_data, x = ~eje_x_complejidad, y = ~eje_y_flexibilidad, type = 'scatter', mode = 'markers+text', # Mostrar puntos y etiquetas de texto # Puntos marker = list(size = 15, color = ~eje_y_flexibilidad, colorscale = 'Viridis', showscale = TRUE, colorbar = list(title = "Flexibilidad (Lyap)")), # Etiquetas de texto (nombres de los canales) text = ~canal, textposition = 'top right', textfont = list(color = '#000000', size = 10), # Información al pasar el ratón hoverinfo = 'text', hovertext = ~paste("Canal:", canal, "
Complejidad:", round(eje_x_complejidad, 2), "
Flexibilidad:", round(eje_y_flexibilidad, 2)) ) %>% layout( title = "GPS de la Conciencia: Mapa de Estados Cerebrales por Canal", xaxis = list( title = "Eje de Complejidad / Organización
(Simple/Ordenado → Complejo/Desorganizado)", zeroline = TRUE, zerolinewidth = 2, zerolinecolor = '#969696' ), yaxis = list( title = "Eje de Flexibilidad / Foco
(Foco Alto/Rígido → Divagación/Flexible)", zeroline = TRUE, zerolinewidth = 2, zerolinecolor = '#969696' ), # Añadir anotaciones para los cuadrantes annotations = list( list(x = 0.25, y = 0.95, xref = "paper", yref = "paper", text = "II. Divagación / Creatividad", showarrow = F, xanchor = 'center'), list(x = 0.75, y = 0.95, xref = "paper", yref = "paper", text = "I. Manía / Desorganización", showarrow = F, xanchor = 'center'), list(x = 0.25, y = 0.05, xref = "paper", yref = "paper", text = "III. Foco / Concentración", showarrow = F, xanchor = 'center'), list(x = 0.75, y = 0.05, xref = "paper", yref = "paper", text = "IV. Rumiación / Obsesión", showarrow = F, xanchor = 'center') ) ) }) output$df_time_plot <- renderPlotly({ req(rv$temporal_metrics); plot_ly(rv$temporal_metrics, x=~time_s, y=~df, type='scatter', mode='lines+markers') %>% layout(title=paste("Df en el Tiempo -", input$selected_canal), xaxis=list(title="Tiempo (s)"), yaxis=list(title="Df")) }) output$lyap_time_plot <- renderPlotly({ req(rv$temporal_metrics); plot_ly(rv$temporal_metrics, x=~time_s, y=~lyap, type='scatter', mode='lines+markers') %>% layout(title=paste("Lyapunov en el Tiempo -", input$selected_canal), xaxis=list(title="Tiempo (s)"), yaxis=list(title="Lyap")) }) # Asegúrate de que tu output$lzc_time_plot vuelva a ser el original output$lzc_time_plot <- renderPlotly({ req(rv$temporal_metrics) req(sum(!is.na(rv$temporal_metrics$lzc)) > 1) # Buena práctica mantener esto plot_ly( rv$temporal_metrics, x = ~time_s, y = ~lzc, # <-- Asegúrate de que aquí pone 'lzc' type = 'scatter', mode = 'lines+markers' ) %>% layout( title = paste("LZC en el Tiempo -", input$selected_canal), xaxis = list(title="Tiempo (s)"), yaxis = list(title="LZC") ) }) output$plv_heatmap <- renderPlotly({ results <- all_adicional_calcs() req(results$plv_matrix) # Extraer la matriz PLV plv_mat <- results$plv_matrix # --- MEJORA DE VISUALIZACIÓN --- # Reemplazar cualquier posible NA con un valor numérico que podamos colorear # Usaremos -0.1, ya que PLV nunca puede ser negativo. plv_mat[is.na(plv_mat)] <- -0.1 # Definir una escala de colores personalizada que tenga un color para los fallos # "Viridis" para valores de 0 a 1, y "grey" para el valor de fallo -0.1 colores_custom <- list( c(0, 'grey'), # Valores en -0.1 (nuestro NA) se mapean a gris c(0.0001, '#440154FF'), # Inicio de la escala Viridis (púrpura) c(1, '#FDE725FF') # Fin de la escala Viridis (amarillo) ) plot_ly( z = plv_mat, x = rownames(plv_mat), y = colnames(plv_mat), type = "heatmap", colorscale = colores_custom, zmin = 0, # Forzamos el rango de la leyenda para que sea de 0 a 1 zmax = 1 ) %>% layout( title = "PLV entre Bandas (Gris = Fallo de Cálculo)", annotations = list( text = "PLV", x = 1.05, y = 1.05, xref = "paper", yref = "paper", showarrow = FALSE ) ) }) output$lag_heatmap <- renderPlotly({ results <- all_adicional_calcs(); req(results$lag_matrix); plot_ly(z=results$lag_matrix, x=rownames(results$lag_matrix), y=colnames(results$lag_matrix), type="heatmap", colorscale="RdBu", zmid=0) %>% layout(title="Retardo (s) entre Bandas") }) # Descargas output$dl_metrics <- downloadHandler(filename=function() paste0("metricas_", Sys.Date(), ".csv"), content=function(file){ req(rv$results_tidy); fwrite(rv$results_tidy, file) }) output$dl_temporal <- downloadHandler(filename=function() paste0("metricas_temporales_", Sys.Date(), ".csv"), content=function(file){ req(rv$temporal_metrics); fwrite(rv$temporal_metrics, file) }) } shinyApp(ui, server)