Início / coding / Perguntas / 79283554
Accepted
farrow90
Asked: 2024-12-16 10:50:41 +0800 CST

Como descobrir qual gráfico é mais semelhante a outro gráfico?

  • 772

Tenho esta lista de matrizes em R:

 my_list =  structure(list(
        matrix(c(2,2,2,2,3, 1,2,2,2,3, 1,2,3,3,3, 1,2,1,3,3, 1,1,1,3,3), nrow=5, byrow=TRUE),
        matrix(c(1,1,1,2,2, 1,1,1,2,2, 1,1,1,3,3, 1,1,3,3,3, 1,1,3,3,3), nrow=5, byrow=TRUE),
        matrix(c(2,2,2,3,3, 2,2,2,3,3, 1,1,3,3,3, 1,1,3,3,3, 1,1,1,1,1), nrow=5, byrow=TRUE),
        matrix(c(3,3,3,3,3, 2,2,3,3,3, 2,2,2,3,3, 2,2,2,1,1, 1,1,1,1,1), nrow=5, byrow=TRUE),
        matrix(c(3,3,3,3,3, 1,1,1,2,2, 1,1,1,2,2, 1,1,1,2,2, 1,1,2,2,2), nrow=5, byrow=TRUE),
        matrix(c(1,1,1,3,3, 1,1,1,3,3, 1,1,1,2,2, 1,1,2,2,2, 1,1,2,2,2), nrow=5, byrow=TRUE),
        matrix(c(1,3,3,2,2, 1,3,3,2,2, 1,1,3,3,2, 1,1,1,3,2, 1,1,1,1,2), nrow=5, byrow=TRUE),
        matrix(c(1,1,1,2,2, 1,1,1,2,2, 1,1,1,2,3, 1,1,1,2,3, 1,1,2,2,2), nrow=5, byrow=TRUE),
        matrix(c(2,2,2,2,2, 3,3,3,3,3, 3,3,3,3,3, 1,1,3,3,3, 1,1,3,3,3), nrow=5, byrow=TRUE),
        matrix(c(1,1,1,1,1, 1,1,1,1,2, 3,1,1,1,2, 3,3,2,2,2, 3,3,2,2,2), nrow=5, byrow=TRUE),
        matrix(c(3,1,1,1,1, 3,3,1,1,1, 3,3,2,2,1, 2,2,2,1,1, 2,2,2,1,1), nrow=5, byrow=TRUE),
        matrix(c(3,3,3,3,3, 3,3,1,3,1, 2,2,1,1,1, 2,2,1,1,1, 2,2,1,1,1), nrow=5, byrow=TRUE),
        matrix(c(3,3,1,1,1, 3,1,1,1,1, 3,2,2,1,1, 3,2,2,2,2, 3,3,2,2,2), nrow=5, byrow=TRUE),
        matrix(c(1,1,1,1,1, 1,1,1,1,2, 1,1,1,1,2, 3,3,3,2,2, 3,3,2,2,2), nrow=5, byrow=TRUE),
        matrix(c(1,1,1,1,2, 1,1,1,3,2, 1,3,1,3,2, 1,3,3,3,2, 1,1,3,2,2), nrow=5, byrow=TRUE),
        matrix(c(3,3,3,3,3, 3,3,2,2,2, 3,3,2,2,2, 1,1,2,2,2, 1,1,2,2,2), nrow=5, byrow=TRUE),
        matrix(c(1,1,1,3,3, 1,1,1,3,3, 1,1,2,2,3, 1,1,1,2,3, 1,1,2,2,2), nrow=5, byrow=TRUE),
        matrix(c(1,1,1,1,3, 1,1,2,3,3, 1,1,2,3,3, 1,1,2,2,2, 1,2,2,2,2), nrow=5, byrow=TRUE),
        matrix(c(1,1,1,1,1, 1,2,2,1,1, 1,1,2,2,1, 3,3,2,2,2, 2,2,2,2,2), nrow=5, byrow=TRUE),
        matrix(c(3,3,3,1,1, 1,1,1,1,2, 1,1,1,1,2, 1,2,1,2,2, 1,2,2,2,2), nrow=5, byrow=TRUE),
        matrix(c(2,3,3,3,3, 2,3,3,3,3, 2,3,3,3,3, 2,2,2,1,1, 1,1,1,1,1), nrow=5, byrow=TRUE),
        matrix(c(2,2,2,2,2, 2,2,2,2,2, 2,2,2,2,2, 2,3,1,1,2, 3,3,1,1,1), nrow=5, byrow=TRUE),
        matrix(c(1,1,1,1,1, 1,1,1,1,1, 3,1,1,1,1, 2,2,1,1,1, 2,2,1,1,1), nrow=5, byrow=TRUE),
        matrix(c(1,1,1,3,3, 2,1,1,3,3, 2,2,1,1,3, 2,2,2,1,1, 2,2,2,2,2), nrow=5, byrow=TRUE),
        matrix(c(1,1,1,1,1, 1,1,1,1,1, 3,3,3,3,1, 2,2,2,2,1, 2,2,2,2,1), nrow=5, byrow=TRUE),
        matrix(c(3,3,3,3,1, 3,3,2,1,1, 3,3,2,1,1, 3,3,2,2,2, 3,3,2,2,2), nrow=5, byrow=TRUE),
        matrix(c(3,3,3,1,1, 3,3,3,1,1, 3,2,2,1,1, 2,2,2,1,1, 2,2,2,1,1), nrow=5, byrow=TRUE),
        matrix(c(2,2,2,1,1, 2,2,2,1,1, 2,2,1,1,1, 3,2,2,1,1, 3,3,1,1,1), nrow=5, byrow=TRUE),
        matrix(c(1,1,1,1,1, 1,2,1,1,1, 1,2,2,1,1, 1,1,2,3,3, 1,1,2,3,3), nrow=5, byrow=TRUE),
        matrix(c(1,1,3,3,3, 1,2,2,2,3, 1,2,2,3,3, 1,2,2,3,3, 1,1,1,3,3), nrow=5, byrow=TRUE),
        matrix(c(3,1,1,1,1, 3,1,1,1,1, 3,3,1,1,2, 3,1,1,2,2, 3,2,2,2,2), nrow=5, byrow=TRUE),
        matrix(c(1,1,1,3,3, 1,1,1,3,3, 2,3,3,3,3, 2,3,3,2,2, 2,2,2,2,2), nrow=5, byrow=TRUE),
        matrix(c(3,2,2,2,2, 3,2,2,2,2, 3,1,2,1,1, 3,1,1,1,1, 3,3,3,3,1), nrow=5, byrow=TRUE),
        matrix(c(3,3,3,3,3, 3,3,3,1,1, 2,1,1,1,1, 2,2,2,2,2, 2,2,2,2,2), nrow=5, byrow=TRUE),
        matrix(c(3,3,3,3,2, 3,3,3,3,2, 3,1,1,1,2, 3,1,1,1,1, 3,1,1,1,1), nrow=5, byrow=TRUE),
        matrix(c(3,3,2,2,2, 3,1,1,2,2, 3,1,1,2,2, 1,1,1,2,2, 1,1,1,2,2), nrow=5, byrow=TRUE)
    ), class = "list")

Em seguida, tracei todos eles usando o seguinte código:

library(ggplot2)
library(gridExtra)
library(reshape2)
library(dplyr)

plot_matrix <- function(mat, plot_number) {
    df <- melt(mat)
    names(df) <- c("row", "col", "value")
    
    df$index <- (df$row - 1) * 5 + df$col
    
    colors <- c(
        "1" = "#FFB3B3",
        "2" = "#B3D9FF",
        "3" = "#B3FFB3"
    )
    
    p <- ggplot(df, aes(x = col, y = -row, fill = factor(value))) +
        geom_tile(color = "black", linewidth = 0.5) +
        geom_text(aes(label = index), size = 3) +
        scale_fill_manual(values = colors) +
        labs(title = paste("Object", plot_number)) +
        coord_equal() +
        theme_minimal() +
        theme(
            legend.position = "none",
            plot.title = element_text(hjust = 0.5, margin = margin(b = 10)),
            axis.text = element_blank(),
            axis.title = element_blank(),
            panel.grid = element_blank(),
            plot.margin = margin(5, 5, 5, 5)
        )
    
    return(p)
}

plot_list <- lapply(seq_along(my_list), function(i) {
    plot_matrix(my_list[[i]], i)
})

n_plots <- length(plot_list)
n_cols <- 6
n_rows <- ceiling(n_plots / n_cols)

grid.arrange(
    grobs = plot_list,
    ncol = n_cols,
    nrow = n_rows,
    padding = unit(2, "mm")
)

insira a descrição da imagem aqui

Tenho a seguinte pergunta: se pegarmos o objeto 1, há algo que podemos fazer para descobrir qual dos objetos restantes é "mais semelhante" ao objeto 1 com base em: A) distribuição de cores E B) formato dos limites de cores E C) posicionamento dos limites de cores?

Minha abordagem atual é responder cada uma dessas perguntas separadamente e tirar a média delas. Por exemplo:

  • A) Descubra a distribuição de cores de cada objeto como um vetor e calcule a distância euclidiana entre o objeto 1 e todos os outros objetos.

  • B) e C) Use algo como Distância de Jaccard ou Distância de Hausdorf entre o objeto 1 e todos os outros objetos

  • pegue a média de todas as diferenças para ter uma ideia da similaridade geral. O par (objeto1, objeto_i) com a média mais baixa é o mais similar

Não tenho certeza se essa abordagem é correta e queria saber se há algo mais fácil.

Uma ideia para A)

library(plotly)

color_counts <- data.frame(
    object = 1:length(my_list),
    red = sapply(my_list, function(mat) sum(mat == 1)),
    blue = sapply(my_list, function(mat) sum(mat == 2)),
    green = sapply(my_list, function(mat) sum(mat == 3))
)

point_colors <- ifelse(color_counts$object == 1, "orange", "black")

plot_ly(color_counts, 
        x = ~red, 
        y = ~blue, 
        z = ~green,
        text = ~paste("Object", object),
        type = "scatter3d",
        mode = "markers",
        marker = list(
            color = point_colors,
            size = 6  # Making points slightly larger for better visibility
        )) %>%
    layout(scene = list(
        xaxis = list(title = "Red (1s)"),
        yaxis = list(title = "Blue (2s)"),
        zaxis = list(title = "Green (3s)")
    ))

insira a descrição da imagem aqui

1 respostas

  1. Best Answer

    Essa pergunta é difícil de responder, mas a Parte A e a Parte B devem ser relativamente diretas, hclust()e algum tipo de distância de Jaccard pode ser calculada (embora não o tradicional Jaccard "quantas coisas em comum", já que todos os Objetos têm os mesmos valores (1, 2 e 3), mas estão em posições diferentes).

    A parte com a qual estou lutando é:

    B) formato dos limites de cores E C) posicionamento dos limites de cores?

    Isso está muito além da minha área de especialização, mas talvez as abordagens do tipo clustering possam ajudar você a começar.

    Por exemplo

    library(tidyverse)
my_list =  structure(list(
  matrix(c(2,2,2,2,3, 1,2,2,2,3, 1,2,3,3,3, 1,2,1,3,3, 1,1,1,3,3), nrow=5, byrow=TRUE),
  matrix(c(1,1,1,2,2, 1,1,1,2,2, 1,1,1,3,3, 1,1,3,3,3, 1,1,3,3,3), nrow=5, byrow=TRUE),
  matrix(c(2,2,2,3,3, 2,2,2,3,3, 1,1,3,3,3, 1,1,3,3,3, 1,1,1,1,1), nrow=5, byrow=TRUE),
  matrix(c(3,3,3,3,3, 2,2,3,3,3, 2,2,2,3,3, 2,2,2,1,1, 1,1,1,1,1), nrow=5, byrow=TRUE),
  matrix(c(3,3,3,3,3, 1,1,1,2,2, 1,1,1,2,2, 1,1,1,2,2, 1,1,2,2,2), nrow=5, byrow=TRUE),
  matrix(c(1,1,1,3,3, 1,1,1,3,3, 1,1,1,2,2, 1,1,2,2,2, 1,1,2,2,2), nrow=5, byrow=TRUE),
  matrix(c(1,3,3,2,2, 1,3,3,2,2, 1,1,3,3,2, 1,1,1,3,2, 1,1,1,1,2), nrow=5, byrow=TRUE),
  matrix(c(1,1,1,2,2, 1,1,1,2,2, 1,1,1,2,3, 1,1,1,2,3, 1,1,2,2,2), nrow=5, byrow=TRUE),
  matrix(c(2,2,2,2,2, 3,3,3,3,3, 3,3,3,3,3, 1,1,3,3,3, 1,1,3,3,3), nrow=5, byrow=TRUE),
  matrix(c(1,1,1,1,1, 1,1,1,1,2, 3,1,1,1,2, 3,3,2,2,2, 3,3,2,2,2), nrow=5, byrow=TRUE),
  matrix(c(3,1,1,1,1, 3,3,1,1,1, 3,3,2,2,1, 2,2,2,1,1, 2,2,2,1,1), nrow=5, byrow=TRUE),
  matrix(c(3,3,3,3,3, 3,3,1,3,1, 2,2,1,1,1, 2,2,1,1,1, 2,2,1,1,1), nrow=5, byrow=TRUE),
  matrix(c(3,3,1,1,1, 3,1,1,1,1, 3,2,2,1,1, 3,2,2,2,2, 3,3,2,2,2), nrow=5, byrow=TRUE),
  matrix(c(1,1,1,1,1, 1,1,1,1,2, 1,1,1,1,2, 3,3,3,2,2, 3,3,2,2,2), nrow=5, byrow=TRUE),
  matrix(c(1,1,1,1,2, 1,1,1,3,2, 1,3,1,3,2, 1,3,3,3,2, 1,1,3,2,2), nrow=5, byrow=TRUE),
  matrix(c(3,3,3,3,3, 3,3,2,2,2, 3,3,2,2,2, 1,1,2,2,2, 1,1,2,2,2), nrow=5, byrow=TRUE),
  matrix(c(1,1,1,3,3, 1,1,1,3,3, 1,1,2,2,3, 1,1,1,2,3, 1,1,2,2,2), nrow=5, byrow=TRUE),
  matrix(c(1,1,1,1,3, 1,1,2,3,3, 1,1,2,3,3, 1,1,2,2,2, 1,2,2,2,2), nrow=5, byrow=TRUE),
  matrix(c(1,1,1,1,1, 1,2,2,1,1, 1,1,2,2,1, 3,3,2,2,2, 2,2,2,2,2), nrow=5, byrow=TRUE),
  matrix(c(3,3,3,1,1, 1,1,1,1,2, 1,1,1,1,2, 1,2,1,2,2, 1,2,2,2,2), nrow=5, byrow=TRUE),
  matrix(c(2,3,3,3,3, 2,3,3,3,3, 2,3,3,3,3, 2,2,2,1,1, 1,1,1,1,1), nrow=5, byrow=TRUE),
  matrix(c(2,2,2,2,2, 2,2,2,2,2, 2,2,2,2,2, 2,3,1,1,2, 3,3,1,1,1), nrow=5, byrow=TRUE),
  matrix(c(1,1,1,1,1, 1,1,1,1,1, 3,1,1,1,1, 2,2,1,1,1, 2,2,1,1,1), nrow=5, byrow=TRUE),
  matrix(c(1,1,1,3,3, 2,1,1,3,3, 2,2,1,1,3, 2,2,2,1,1, 2,2,2,2,2), nrow=5, byrow=TRUE),
  matrix(c(1,1,1,1,1, 1,1,1,1,1, 3,3,3,3,1, 2,2,2,2,1, 2,2,2,2,1), nrow=5, byrow=TRUE),
  matrix(c(3,3,3,3,1, 3,3,2,1,1, 3,3,2,1,1, 3,3,2,2,2, 3,3,2,2,2), nrow=5, byrow=TRUE),
  matrix(c(3,3,3,1,1, 3,3,3,1,1, 3,2,2,1,1, 2,2,2,1,1, 2,2,2,1,1), nrow=5, byrow=TRUE),
  matrix(c(2,2,2,1,1, 2,2,2,1,1, 2,2,1,1,1, 3,2,2,1,1, 3,3,1,1,1), nrow=5, byrow=TRUE),
  matrix(c(1,1,1,1,1, 1,2,1,1,1, 1,2,2,1,1, 1,1,2,3,3, 1,1,2,3,3), nrow=5, byrow=TRUE),
  matrix(c(1,1,3,3,3, 1,2,2,2,3, 1,2,2,3,3, 1,2,2,3,3, 1,1,1,3,3), nrow=5, byrow=TRUE),
  matrix(c(3,1,1,1,1, 3,1,1,1,1, 3,3,1,1,2, 3,1,1,2,2, 3,2,2,2,2), nrow=5, byrow=TRUE),
  matrix(c(1,1,1,3,3, 1,1,1,3,3, 2,3,3,3,3, 2,3,3,2,2, 2,2,2,2,2), nrow=5, byrow=TRUE),
  matrix(c(3,2,2,2,2, 3,2,2,2,2, 3,1,2,1,1, 3,1,1,1,1, 3,3,3,3,1), nrow=5, byrow=TRUE),
  matrix(c(3,3,3,3,3, 3,3,3,1,1, 2,1,1,1,1, 2,2,2,2,2, 2,2,2,2,2), nrow=5, byrow=TRUE),
  matrix(c(3,3,3,3,2, 3,3,3,3,2, 3,1,1,1,2, 3,1,1,1,1, 3,1,1,1,1), nrow=5, byrow=TRUE),
  matrix(c(3,3,2,2,2, 3,1,1,2,2, 3,1,1,2,2, 1,1,1,2,2, 1,1,1,2,2), nrow=5, byrow=TRUE)
), class = "list")

library(ggplot2)
library(gridExtra)
#> 
#> Attaching package: 'gridExtra'
#> The following object is masked from 'package:dplyr':
#> 
#>     combine
library(reshape2)
#> 
#> Attaching package: 'reshape2'
#> The following object is masked from 'package:tidyr':
#> 
#>     smiths
library(dplyr)

plot_matrix <- function(mat, plot_number) {
  df <- melt(mat)
  names(df) <- c("row", "col", "value")
  
  df$index <- (df$row - 1) * 5 + df$col
  
  colors <- c(
    "1" = "#FFB3B3",
    "2" = "#B3D9FF",
    "3" = "#B3FFB3"
  )
  
  p <- ggplot(df, aes(x = col, y = -row, fill = factor(value))) +
    geom_tile(color = "black", linewidth = 0.5) +
    geom_text(aes(label = index), size = 3) +
    scale_fill_manual(values = colors) +
    labs(title = paste("Object", plot_number)) +
    coord_equal() +
    theme_minimal() +
    theme(
      legend.position = "none",
      plot.title = element_text(hjust = 0.5, margin = margin(b = 10)),
      axis.text = element_blank(),
      axis.title = element_blank(),
      panel.grid = element_blank(),
      plot.margin = margin(5, 5, 5, 5)
    )
  
  return(p)
}

plot_list <- lapply(seq_along(my_list), function(i) {
  plot_matrix(my_list[[i]], i)
})

n_plots <- length(plot_list)
n_cols <- 6
n_rows <- ceiling(n_plots / n_cols)

grid.arrange(
  grobs = plot_list,
  ncol = n_cols,
  nrow = n_rows,
  padding = unit(2, "mm")
)

    enredo inicial

    my_list
#> [[1]]
#>      [,1] [,2] [,3] [,4] [,5]
#> [1,]    2    2    2    2    3
#> [2,]    1    2    2    2    3
#> [3,]    1    2    3    3    3
#> [4,]    1    2    1    3    3
#> [5,]    1    1    1    3    3
#> 
#> [[2]]
#>      [,1] [,2] [,3] [,4] [,5]
#> [1,]    1    1    1    2    2
#> [2,]    1    1    1    2    2
#> [3,]    1    1    1    3    3
#> [4,]    1    1    3    3    3
#> [5,]    1    1    3    3    3
#> 
#> ...
#> 
#> [[36]]
#>      [,1] [,2] [,3] [,4] [,5]
#> [1,]    3    3    2    2    2
#> [2,]    3    1    1    2    2
#> [3,]    3    1    1    2    2
#> [4,]    1    1    1    2    2
#> [5,]    1    1    1    2    2
#> 
#> attr(,"class")
#> [1] "list"

# combine all of the melted matrices into a single dataframe
list_of_dfs <- map(seq_along(my_list), ~melt(my_list[[.x]]) %>%
                     mutate(id = .x) %>%
                     pivot_wider(id_cols = id,
                                 names_from = c(Var1, Var2),
                                 values_from = value)) %>%
  bind_rows()

# get all of the combinations, e.g. Object 1 vs 1, 1 vs 2, etc
combinations <- expand.grid(1:nrow(list_of_dfs), 1:nrow(list_of_dfs)) %>%
  filter(Var1 != Var2)
output <- map2(combinations$Var2, combinations$Var1, ~sum(list_of_dfs[.x,] == list_of_dfs[.y,]))
combinations$total_matches <- unlist(output)

# check the top matches i.e. how many values are in the same place
head(combinations[order(combinations$total_matches, decreasing = TRUE),], 15)
#>     Var1 Var2 total_matches
#> 328   14   10            23
#> 465   10   14            23
#> 125   21    4            21
#> 191   17    6            21
#> 566    6   17            21
#> 704    4   21            21
#> 261   17    8            20
#> 376   27   11            20
#> 568    8   17            20
#> 921   11   27            20
#> 29    30    1            19
#> 42     8    2            19
#> 145    6    5            19
#> 159   20    5            19
#> 175   36    5            19

    Parece que o Objeto 30 é a correspondência mais próxima do Objeto 1 (ou seja, ele tem 19 valores na mesma posição nas matrizes). Usando hclust você obtém a mesma resposta:

    
list_of_dfs <- map(seq_along(my_list), ~melt(my_list[[.x]]) %>%
                     mutate(id = .x) %>%
                     pivot_wider(id_cols = id,
                                 names_from = c(Var1, Var2),
                                 values_from = value)) %>%
  bind_rows() %>%
  dplyr::mutate(across(-id, ~scale(.x)))

hc <- hclust(dist(list_of_dfs[-1]), method = "complete")
plot(hc)

    diagrama hclust

    Criado em 2024-12-16 com reprex v2.1.0

    Espero que isso ajude; boa sorte!

    • 1

relate perguntas