library(igraph)
library(ggplot2)
library(dplyr)
library(purrr)
library(visNetwork)
library(ggraph)
library(tidygraph)
library(CCA)  # do analizy kanonicznej

# ========================================
# 🔹 Generowanie danych
# ========================================
set.seed(123)
n <- 100

X1 <- matrix(rnorm(n*3), ncol=3)
colnames(X1) <- c("X1_1", "X1_2", "X1_3")

X2 <- matrix(rnorm(n*3), ncol=3)
colnames(X2) <- c("X2_1", "X2_2", "X2_3")

X3 <- matrix(rnorm(n*3), ncol=3)
colnames(X3) <- c("X3_1", "X3_2", "X3_3")

# ========================================
# 🔹 Obliczanie kanonicznych korelacji i ładunków
# ========================================

# Funkcja do obliczenia kanonicznej korelacji i ładunków między dwoma blokami
cca_two_blocks <- function(Xa, Xb) {
  cca_res <- cc(Xa, Xb)  # analiza kanoniczna
  list(
    cor = cca_res$cor,            # korelacje kanoniczne
    loadings_A = cca_res$xcoef,   # ładunki kanoniczne dla Xa
    loadings_B = cca_res$ycoef,   # ładunki kanoniczne dla Xb
    cross_loadings_A = cor(Xa, cca_res$scores$xscores),  # ładunki krzyżowe dla Xa
    cross_loadings_B = cor(Xb, cca_res$scores$yscores)   # ładunki krzyżowe dla Xb
  )
}

# Liczymy kanoniczne korelacje i ładunki dla par bloków
cca_12 <- cca_two_blocks(X1, X2)
cca_23 <- cca_two_blocks(X2, X3)
cca_13 <- cca_two_blocks(X1, X3)

# Korelacje między zbiorami - weźmy maksymalną korelację kanoniczną z pierwszego wymiaru
cor_matrix <- matrix(c(
  1,
  cca_12$cor[1],
  cca_13$cor[1],
  cca_12$cor[1],
  1,
  cca_23$cor[1],
  cca_13$cor[1],
  cca_23$cor[1],
  1
), nrow=3, byrow=TRUE)

# Ładunki kanoniczne na pierwszy wymiar (uśrednione po zmiennych każdego zbioru, absolutne wartości)
loadings <- list(
  list(as.vector(abs(cca_12$loadings_A[,1])), as.vector(abs(cca_12$loadings_B[,1]))), # 1 wymiar: X1 i X2
  list(as.vector(abs(cca_23$loadings_A[,1])), as.vector(abs(cca_23$loadings_B[,1]))), # 1 wymiar: X2 i X3
  list(as.vector(abs(cca_13$loadings_A[,1])), as.vector(abs(cca_13$loadings_B[,1])))  # 1 wymiar: X1 i X3
)

# Ponieważ mamy 3 zbiory, bierzemy ładunki kanoniczne z każdego bloku
# Aby nadać je zmiennym w zbiorach, ułożymy je tak:
loadings_list <- list(
  setNames(abs(cca_12$loadings_A[,1]), colnames(X1)),
  setNames(abs(cca_12$loadings_B[,1]), colnames(X2)),
  setNames(abs(cca_23$loadings_B[,1]), colnames(X3))
)

# ========================================
# 🔹 Tworzenie węzłów i krawędzi (bez zmian)
# ========================================
nodes <- data.frame(
  name = c(paste("Zbiór", 1:3), colnames(X1), colnames(X2), colnames(X3)),
  type = c(rep("set", 3), rep("var", length(c(colnames(X1), colnames(X2), colnames(X3)))))
)

# Krawędzie między zbiorami
edges_sets <- data.frame(
  from = c("Zbiór 1", "Zbiór 2", "Zbiór 1"),
  to = c("Zbiór 2", "Zbiór 3", "Zbiór 3"),
  weight = c(cor_matrix[1, 2], cor_matrix[2, 3], cor_matrix[1,3]),
  Wymiar = 1
)

# Krawędzie zbiór → cecha z odpowiednimi ładunkami
edges_vars <- data.frame(
  from = c(rep("Zbiór 1", length(X1[1,])), rep("Zbiór 2", length(X2[1,])), rep("Zbiór 3", length(X3[1,]))),
  to = c(colnames(X1), colnames(X2), colnames(X3)),
  weight = c(loadings_list[[1]], loadings_list[[2]], loadings_list[[3]]),
  Wymiar = 1
)

edges <- rbind(edges_sets, edges_vars)
g <- graph_from_data_frame(edges, vertices = nodes, directed = FALSE)

# ========================================
# 🔹 Etykiety i style (tak jak w Twoim kodzie)
# ========================================
V(g)$label <- sapply(V(g)$name, function(n) {
  if (n %in% paste("Zbiór", 1:3)) n else paste0(n, "\n(", round(unlist(loadings_list[which(sapply(loadings_list, function(x) n %in% names(x)))][[1]][n]), 2), ")")
})

V(g)$size <- ifelse(V(g)$type == "set", 50, 35)
V(g)$label.cex <- ifelse(V(g)$type == "set", 1.1, 0.85)
V(g)$frame.color <- "black"

E(g)$color <- ifelse(
  edges$from %in% paste("Zbiór", 1:3) & edges$to %in% paste("Zbiór", 1:3),
  "red", "gray"
)
E(g)$width <- ifelse(E(g)$color == "red", 3, 1.5)
E(g)$curved <- ifelse(E(g)$color == "red", 0.2, 0)
edge_labels <- ifelse(E(g)$color == "red", round(E(g)$weight, 2), "")

# ========================================
# 🎨 Kolorowanie zmiennych wg progu
# ========================================
threshold <- 0.7

node_colors <- rep("lightgreen", length(V(g)))
for (i in seq_along(V(g))) {
  if (V(g)$type[i] == "var") {
    varname <- V(g)$name[i]
    if (abs(unlist(loadings_list[which(sapply(loadings_list, function(x) varname %in% names(x)))][[1]][varname])) >= threshold) {
      node_colors[i] <- "forestgreen"
    }
  }
}
node_colors[V(g)$type == "set"] <- "lightblue"
V(g)$color <- node_colors

# ========================================
# 📐 Układ - 3 sektory ("koło")
# ========================================
layout_mat <- matrix(NA, nrow = length(V(g)), ncol = 2)
rownames(layout_mat) <- V(g)$name

# Pozycje zbiorów
radius <- 3
angles_deg <- c(210, 90, 330)
angles_rad <- angles_deg * pi/180
set_names <- paste("Zbiór", 1:3)

for (i in 1:3) {
  layout_mat[set_names[i], ] <- c(
    radius * cos(angles_rad[i]),
    radius * sin(angles_rad[i])
  )
}

# Funkcja rozmieszczania cech względem zbioru
place_vars_sector <- function(set_name, var_names, center_angle_rad, spread = pi/4, min_dist = 2, max_extra = 2) {
  set_pos <- layout_mat[set_name, ]
  n <- length(var_names)
  angles <- seq(center_angle_rad - spread, center_angle_rad + spread, length.out = n)
  
  for (i in seq_along(var_names)) {
    var <- var_names[i]
    loading <- abs(unlist(loadings_list[which(sapply(loadings_list, function(x) var %in% names(x)))][[1]][var]))
    dist <- min_dist + (1 - loading) * max_extra
    layout_mat[var, ] <<- set_pos + dist * c(cos(angles[i]), sin(angles[i]))
  }
}

# Rozkład cech względem zbiorów
place_vars_sector("Zbiór 1", colnames(X1), angles_rad[1])
place_vars_sector("Zbiór 2", colnames(X2), angles_rad[2])
place_vars_sector("Zbiór 3", colnames(X3), angles_rad[3])

# ========================================
# 🖼️ Rysowanie wykresu
# ========================================
par(mar = c(1, 1, 4, 1))
plot(
  g,
  layout = layout_mat,
  edge.label = edge_labels,
  edge.label.family = "sans",
  edge.label.color = "blue",
  edge.label.cex = 1.3,
  main = "Struktura powiązań między zbiorami i ich zmiennymi (Wymiar 1)"
)

# Legenda
legend("bottomright",
       legend = c("Zbiory", "Zmienne (ładunek < 0.7)", "Zmienne (ładunek ≥ 0.7)",
                  "Korelacje między zbiorami", "Ładunki kanoniczne"),
       pch = c(19, 19, 19, NA, NA),
       lty = c(NA, NA, NA, 1, 1),
       col = c("lightblue", "lightgreen", "forestgreen", "red", "gray"),
       pt.cex = 2,
       bty = "n",
       cex = 0.85)

# Podpis informacyjny
mtext(paste0(
  "Średnia korelacja między zbiorami: ",
  round(mean(cor_matrix[upper.tri(cor_matrix)]), 2),
  "\nŚrednia siła ładunków kanonicznych: ",
  round(mean(unlist(loadings_list)), 2)
), side = 1, line = -2, cex = 0.8)




################################################################################
################################################################################


library(igraph)
library(igraph)
library(ggplot2)
library(dplyr)
library(purrr)
library(tidyr)
library(ggraph)
library(tidygraph)
library(visNetwork)

set.seed(123)

# === Generowanie 3 zbiorów po 3 zmienne ===
n <- 50
X1 <- data.frame(X1_1 = rnorm(n), X1_2 = rnorm(n), X1_3 = rnorm(n))
X2 <- data.frame(X2_1 = rnorm(n), X2_2 = rnorm(n), X2_3 = rnorm(n))
X3 <- data.frame(X3_1 = rnorm(n), X3_2 = rnorm(n), X3_3 = rnorm(n))

# === Ulepszona funkcja do analizy kanonicznej ===
compute_extended_cancor <- function(A, B) {
  # Standaryzacja danych
  A_std <- scale(A)
  B_std <- scale(B)
  
  # Analiza kanoniczna
  cc <- cancor(A_std, B_std)
  
  # Zmienne kanoniczne
  U <- as.matrix(A_std) %*% cc$xcoef
  V <- as.matrix(B_std) %*% cc$ycoef
  
  # Ładunki strukturalne
  struct_A <- cor(A_std, U)
  struct_B <- cor(B_std, V)
  
  # Ładunki krzyżowe
  cross_A <- cor(A_std, V)
  cross_B <- cor(B_std, U)
  
  # Test Wilksa dla istotności korelacji kanonicznych
  n <- nrow(A)
  p <- ncol(A)
  q <- ncol(B)
  
  wilks_lambda <- prod(1 - cc$cor^2)
  chi_sq <- -(n - 1 - (p + q + 1)/2) * log(wilks_lambda)
  df <- p * q
  p_value <- 1 - pchisq(chi_sq, df)
  
  list(
    correlations = cc$cor,
    loadings_A = cc$xcoef,
    loadings_B = cc$ycoef,
    structural_A = struct_A,
    structural_B = struct_B,
    cross_A = cross_A,
    cross_B = cross_B,
    canonical_R2 = cc$cor^2,
    wilks_test = list(
      lambda = wilks_lambda,
      chi_sq = chi_sq,
      df = df,
      p_value = p_value
    )
  )
}

norm_loadings <- function(loadings) {
  loadings_matrix <- as.matrix(loadings)
  result <- apply(loadings_matrix, 2, function(col) {
    max_abs <- max(abs(col))
    ifelse(max_abs > 0, col / max_abs, col)
  })
  # Upewniamy się, że wynik jest macierzą
  if (is.vector(result)) {
    result <- matrix(result, ncol = 1)
    rownames(result) <- rownames(loadings_matrix)
    colnames(result) <- colnames(loadings_matrix)[1]
  }
  return(result)
}


# === Obliczenia dla wszystkich par ===
res_12 <- compute_extended_cancor(X1, X2)
res_23 <- compute_extended_cancor(X2, X3)
res_13 <- compute_extended_cancor(X1, X3)

# === Przygotowanie znormalizowanych ładunków strukturalnych ===
load_12_A <- norm_loadings(as.matrix(res_12$structural_A))
load_12_B <- norm_loadings(as.matrix(res_12$structural_B))
load_23_A <- norm_loadings(as.matrix(res_23$structural_A))
load_23_B <- norm_loadings(as.matrix(res_23$structural_B))
load_13_A <- norm_loadings(as.matrix(res_13$structural_A))
load_13_B <- norm_loadings(as.matrix(res_13$structural_B))

# Ładunki w liście po 3 zbiorach i 2 wymiarach
loadings <- list(
  list(
    load_12_A[,1], load_12_A[,2]
  ),
  list(
    load_12_B[,1], load_12_B[,2]
  ),
  list(
    load_23_B[,1], load_23_B[,2]
  )
)

names(loadings[[1]][[1]]) <- colnames(X1)
names(loadings[[1]][[2]]) <- colnames(X1)
names(loadings[[2]][[1]]) <- colnames(X2)
names(loadings[[2]][[2]]) <- colnames(X2)
names(loadings[[3]][[1]]) <- colnames(X3)
names(loadings[[3]][[2]]) <- colnames(X3)

# === Funkcja do wyświetlania podsumowania ===
print_summary <- function(res_12, res_23, res_13) {
  cat("\n=== Podsumowanie analizy kanonicznej ===\n")
  
  cat("\nKorelacje kanoniczne:\n")
  cat("X1-X2:", round(res_12$correlations, 3), 
      "\nIstotność (p-value):", round(res_12$wilks_test$p_value, 3), "\n")
  cat("X2-X3:", round(res_23$correlations, 3),
      "\nIstotność (p-value):", round(res_23$wilks_test$p_value, 3), "\n")
  cat("X1-X3:", round(res_13$correlations, 3),
      "\nIstotność (p-value):", round(res_13$wilks_test$p_value, 3), "\n")
  
  cat("\nWyjaśniona wariancja (R²):\n")
  cat("X1-X2:", round(res_12$canonical_R2, 3), "\n")
  cat("X2-X3:", round(res_23$canonical_R2, 3), "\n")
  cat("X1-X3:", round(res_13$canonical_R2, 3), "\n")
}

# === Funkcja do rysowania grafu ===
draw_improved_graph <- function(dim_num, res_12, res_23, res_13) {
  load_dim <- map(loadings, ~ .x[[dim_num]])
  
  cor_matrix_dim1 <- matrix(c(
    1,
    mean(c(res_12$correlations[1], res_13$correlations[1])),
    mean(c(res_12$correlations[1], res_23$correlations[1])),
    mean(c(res_12$correlations[1], res_13$correlations[1])),
    1,
    mean(c(res_12$correlations[1], res_23$correlations[1])),
    mean(c(res_12$correlations[1], res_23$correlations[1])),
    mean(c(res_12$correlations[1], res_23$correlations[1])),
    1
  ), nrow = 3, byrow = TRUE)
  
  cor_matrix_dim2 <- matrix(c(
    1,
    mean(c(res_12$correlations[2], res_13$correlations[2])),
    mean(c(res_12$correlations[2], res_23$correlations[2])),
    mean(c(res_12$correlations[2], res_13$correlations[2])),
    1,
    mean(c(res_12$correlations[2], res_23$correlations[2])),
    mean(c(res_12$correlations[2], res_23$correlations[2])),
    mean(c(res_12$correlations[2], res_23$correlations[2])),
    1
  ), nrow = 3, byrow = TRUE)
  
  cor_mat <- if(dim_num == 1) cor_matrix_dim1 else cor_matrix_dim2
  
  nodes <- data.frame(
    name = c(paste("Zbiór", 1:3), colnames(X1), colnames(X2), colnames(X3)),
    type = c(rep("set", 3), rep("var", 9))
  )
  
  loading_values <- list(
    setNames(load_dim[[1]], colnames(X1)),
    setNames(load_dim[[2]], colnames(X2)),
    setNames(load_dim[[3]], colnames(X3))
  )
  
  edges_sets <- data.frame(
    from = c("Zbiór 1", "Zbiór 2", "Zbiór 1"),
    to = c("Zbiór 2", "Zbiór 3", "Zbiór 3"),
    weight = c(cor_mat[1, 2], cor_mat[2, 3], cor_mat[1,3]),
    Wymiar = dim_num
  )
  
  edges_vars <- data.frame(
    from = c(rep("Zbiór 1", 3), rep("Zbiór 2", 3), rep("Zbiór 3", 3)),
    to = c(colnames(X1), colnames(X2), colnames(X3)),
    weight = c(abs(load_dim[[1]]), abs(load_dim[[2]]), abs(load_dim[[3]])),
    Wymiar = dim_num
  )
  
  edges <- rbind(edges_sets, edges_vars)
  
  g <- graph_from_data_frame(edges, vertices = nodes, directed = FALSE)
  
  V(g)$label <- sapply(V(g)$name, function(n) {
    if (n %in% paste("Zbiór", 1:3)) n else {
      for (lv in loading_values) {
        if (n %in% names(lv)) return(paste0(n, "\n(", round(lv[n], 2), ")"))
      }
      n
    }
  })
  
  V(g)$size <- ifelse(V(g)$type == "set", 50, 35)
  V(g)$label.cex <- ifelse(V(g)$type == "set", 1.1, 0.85)
  V(g)$frame.color <- "black"
  
  E(g)$color <- ifelse(
    edges$from %in% paste("Zbiór", 1:3) & edges$to %in% paste("Zbiór", 1:3),
    "red", "gray"
  )
  E(g)$width <- ifelse(E(g)$color == "red", 3, 1.5)
  E(g)$curved <- ifelse(E(g)$color == "red", 0.2, 0)
  edge_labels <- ifelse(E(g)$color == "red", round(E(g)$weight, 2), "")
  
  threshold <- 0.7
  node_colors <- rep("lightgreen", length(V(g)))
  for (i in seq_along(V(g))) {
    if (V(g)$type[i] == "var") {
      varname <- V(g)$name[i]
      if (abs(unlist(loading_values[which(sapply(loading_values, function(x) varname %in% names(x)))][[1]][varname])) >= threshold) {
        node_colors[i] <- "forestgreen"
      }
    }
  }
  node_colors[V(g)$type == "set"] <- "lightblue"
  V(g)$color <- node_colors
  
  layout_mat <- matrix(NA, nrow = length(V(g)), ncol = 2)
  rownames(layout_mat) <- V(g)$name
  radius <- 3
  angles_deg <- c(210, 90, 330)
  angles_rad <- angles_deg * pi/180
  set_names <- paste("Zbiór", 1:3)
  
  for (i in 1:3) {
    layout_mat[set_names[i], ] <- c(radius * cos(angles_rad[i]), radius * sin(angles_rad[i]))
  }
  
  place_vars_sector <- function(set_name, var_names, center_angle_rad, spread = pi/4, min_dist = 2, max_extra = 2) {
    set_pos <- layout_mat[set_name, ]
    n <- length(var_names)
    angles <- seq(center_angle_rad - spread, center_angle_rad + spread, length.out = n)
    
    for (i in seq_along(var_names)) {
      var <- var_names[i]
      loading <- abs(unlist(loading_values[which(sapply(loading_values, function(x) var %in% names(x)))][[1]][var]))
      
         popraw ten kod, ma mieć wszystko