1

Estou testando algumas coisas na linguagem e me surgiu essa dúvida. Fiz um programa que possui uma base de dados que é dividida em dois grupos (Grupo 1 e Grupo 2) e seus elementos já estão rotulados. Eu quero classificar um novo grupo de elementos com base na distância euclidiana entre cada um de seus elementos e os do grupo que já estão rotulados.

Isso que falei já está funcionando perfeitamente e eu estou plotando o gráfico com os dois grupos. No entanto, não sei como traçar uma curva que separe um grupo do outro.

Do jeito que eu estou fazendo fica assim:

grafico

Segue o código da minha tentativa:

library ('mvtnorm')
library('class')
library ('plot3D')
#calcula a distancia entre cada ponto novo e todos os de treinamento
calcula_dist <- function(elementos_novos, elementos_treinamento){
  matriz_distancia <- matrix(0, nrow(elementos_novos), ncol = nrow(elementos_treinamento))
  for(i in 1:nrow(elementos_novos)){
    for(j in 1:nrow(elementos_treinamento)){
      matriz_distancia[i,j] <- sqrt(sum((elementos_novos[i,] - elementos_treinamento[j,])^2))
    }
  }
  return(matriz_distancia)
}

#busca pelos k vizinhos mais proximos, verifica qual é o rotulo mais presente e atribui ao elemento novo
rotula_elementos <- function(elementos_treinamento, elementos_novos, rotulos_treinamento, num_vizinhos){
  matriz_distancia <- calcula_dist(elementos_novos,elementos_treinamento)
  rotulos <- matrix (0, nrow = nrow(elementos_novos), ncol=1)

  for(i in 1:nrow(rotulos)){
    qtd_verdadeiro <- 0
    qtd_falso <- 0
    dados <- data.frame(matriz_distancia[i,],rotulos_treinamento)
    ind <- order(dados$matriz_distancia.i...)
    vizinhos_mais_proximos <- Y[ind[1:num_vizinhos]]
    for(j in 1:num_vizinhos){
      if(vizinhos_mais_proximos[j] == 1) qtd_verdadeiro <- qtd_verdadeiro + 1
      else qtd_falso <- qtd_falso + 1
    }

    if(qtd_verdadeiro > qtd_falso) rotulos[i] <- 1
    else if(qtd_verdadeiro < qtd_falso) rotulos[i] <- 2

  }
  return(rotulos)  
}

#gera os dados dos conjuntos 1 e 2
conjunto1 <- rmvnorm(100, mean = c(3,3), sigma = matrix(c(6,0,0,2), nrow = 2, byrow = T))
conjunto2 <- rmvnorm(100, mean = c(2,-2), sigma = matrix(c(10,0,0,0.5), nrow = 2, byrow = T))

#cria um só grupo para os elementos de treinamento
elementos <- rbind(conjunto1,conjunto2)

#gera o rotulo para os elementos
rotulos <- c(rep(1,100), rep(0,100))

#repete o mesmo processo para os conjuntos de teste
conjunto_teste1 <- rmvnorm(50, mean = c(3,3), sigma = matrix(c(6,0,0,2), nrow = 2, byrow = T))
conjunto_teste2 <- rmvnorm(50, mean = c(2,-2), sigma = matrix(c(10,0,0,0.5), nrow = 2, byrow = T))

elementos_teste <- rbind(conjunto_teste1,conjunto_teste2)


plot3D::scatter2D(conjunto_teste1[,1], conjunto_teste1[,2], col = "black", pch = 111, cex = 1, xlim = c(-7,7), ylim = c(-6,6))
plot3D::scatter2D(conjunto_teste2[,1], conjunto_teste2[,2], col = "red", pch = 43, cex = 1, add = TRUE)


dados <- data.frame(X,Y)
rotulos_euclidiana <- rotula_elementos(elementos , elementos_teste, rotulos, 3)

#se o rotulo for 1, class recebe TRUE, se não, recebe FALSE
class <- (1 == rotulos_euclidiana)
par(new=T)

plot(class,cex = 20, type='l', col='black')

Eu estava tentando usar o contour também mas ele pede uma matriz e eu não sei que matriz eu poderia jogar lá.

4
  • 1
    para ajudar os brothers, poste um pequeno exemplo reproduzível em código dos dados quer plotar, pode ser até algo não relacionado com o exemplo, mas facilita. Commented 15/06/2017 às 2:38
  • Ok, vou editar a pergunta com meu código. Obrigado pela dica @GuilhermeMarthe
    – Marcio
    Commented 15/06/2017 às 13:55
  • 1
    O que você quer não seria suporte vector machine ou análise de discriminante? Commented 15/06/2017 às 21:38
  • Não sei do que isso se trata. Se for alguma técnica para separar os dados usando uma curva, então sim :D
    – Marcio
    Commented 16/06/2017 às 12:41

1 Resposta 1

4

Tentativa de solução:

Passo 1: Gerar os dados

# pacotes
library(tidyverse)
library(mvtnorm)
# reprodutibilidade
set.seed(10)
# observações
N <- 1000
# lista de parâmetros
parms <- list(
  a = list(mu = c(0, 0), sigma = matrix(c(4, 2, 2, 4), nrow = 2)),
  b = list(mu = c(5, 5), sigma = matrix(c(4, -2, -2, 4), nrow = 2))
)
# cria base de dados
dados <- parms %>% 
  map_df(~as_tibble(rmvnorm(1000, .x$mu, .x$sigma)), .id = 'y')

a tabela fica assim:

> head(dados)
# A tibble: 6 x 3
      y         V1          V2
  <chr>      <dbl>       <dbl>
1     a -1.3003304 -3.31843274
2     a -1.2522601 -2.68292404
3     a  1.0809874  4.10785510
4     a  0.9412994  0.43563123
5     a  2.9512012  1.15567989
6     a  0.3998171 -0.04013559

O gráfico fica assim:

dados %>% 
  ggplot(aes(x = V1, y = V2, colour = y, type = y)) +
  geom_point()

normais

Passo 2: Ajustar modelo

Um modelo que você pode usar para separar os dados é a Análise Discriminante, usando a função lda. Assim:

m_lda <- MASS::lda(y ~ V1 + V2, data = dados)

Passo 3: Desenhar retinha

Peguei o código para desenhar a reta neste link.

Primeiro você precisa criar uma grid de dados e obter as classificações para toda essa grid:

dados_grid <- dados %>% 
  dplyr::select(-y) %>% 
  # para cada variável, uma sequência de tamanho 10 entre o mínimo e o máximo
  map(~{
    r <- range(.x)
    seq(r[1], r[2], length.out = 10)
  }) %>% 
  # monta a grid
  cross_df() %>% 
  # adiciona as predições (1 ou 2)
  mutate(y = as.numeric(predict(m_lda, newdata = .)$class))

Por último, use geom_countour() para adicionar a retinha. O parâmetro breaks= foi escolhido entre 1 e 2 de propósito para desenhar a retinha exatamente no lugar que queremos (sem esse parâmetro, você veria várias retinhas, que são as curvas de nível geradas por essa grid).

O resultado fica assim:

dados %>% 
  ggplot(aes(x = V1, y = V2, colour = y, type = y)) +
  geom_point() +
  geom_contour(aes(z = y), data = dados_grid, breaks = 1.5)

segundo plot

EDIT:

Para você ver melhor o que esse dados_grid danado está fazendo (aumentando o número de pontos pra 30*30):

dados_grid <- dados %>% 
  dplyr::select(-y) %>% 
  map(~{
    r <- range(.x)
    # aumentei para 30 no range aqui!!!!!!!!!!!!!!!!!
    seq(r[1], r[2], length.out = 30)
  }) %>% 
  cross_df() %>% 
  mutate(y = as.numeric(predict(m_lda, newdata = .)$class))

dados %>% 
  ggplot(aes(x = V1, y = V2, colour = y)) +
  geom_point() +
  geom_contour(aes(z = y), data = dados_grid, breaks = 1.5) +
  theme_minimal() +
  # desenha pontos da grid
  geom_point(aes(shape = as.character(y), colour = NULL), 
             alpha = .3, size = 3, data = dados_grid) +
  scale_shape_manual(values = c('+', 'o'))

pontinhos

3
  • Não conhecia essa maneira de passar uma função para o map*. Ela é equivalente à uma lambda, certo ? Commented 20/06/2017 às 13:20
  • Outra coisa, na versão que estou usando do purrr, a ‘0.2.2.2’ (a do cran), a função cross_df não está disponível. Vc tá usando qual versão? Commented 20/06/2017 às 13:27
  • Pode-se dizer que map é parecido com lambda, mas o purrr como um todo faz muito mais do que isso. Sobre a versão do purrr, a função anterior era cross_d e virou cross_df por algum motivo. Sempre que tiver problemas desse tipo, procure a versão do pacote no github, que lá vai ter a resposta. Commented 25/06/2017 às 18:55

Você deve fazer log-in para responder a esta pergunta.

Esta não é a resposta que você está procurando? Pesquise outras perguntas com a tag .