13

Estou tentando fazer um gráfico parecido com este no R:

inserir a descrição da imagem aqui

O gráfico está disponível neste link. Eu não preciso que ele seja dinâmico como o do link, mas se for, não tem problema.

Nele, cada bolha é dividida entre as cores azul e vermelho de acordo com a proporção de republicanos e democratas que usaram aquela palavra.

O problema é que não estou conseguindo parametrizar este preenchimento da bolha, pois, não é apenas um gráfico de pizza por exemplo. Depois de conseguir fazer uma das bolhas, acredito que seja possível usar o ggsubplot para plotar todas juntas.

Acredito que o seguinte banco de dados possa ser usado, por exemplo:

> dados <- data.frame(palavra = letters[1:10], azul = 1:10, vermelho = 10:1)
> dados
   palavra azul vermelho
1        a    1       10
2        b    2        9
3        c    3        8
4        d    4        7
5        e    5        6
6        f    6        5
7        g    7        4
8        h    8        3
9        i    9        2
10       j   10        1

Alguém tem alguma ideia?

Já consegui fazer a seguinte função:

geom_bubble_prop <- function(r, p, centro = c(0,0), alpha = 0.5, n = 100000){
  df <- data.frame(
    x = centro[1] + r*cos(seq(0, 2*pi, length.out = n)),
    y = centro[2] + r*sin(seq(0, 2*pi, length.out = n))
  )
  df_blue <- df %>% filter(x <= centro[1] - r + p*2*r)
  df_red <- df %>% filter(x >= centro[1] - r + p*2*r)
  g <- ggplot2::ggplot(df_blue, ggplot2::aes(x = x, y = y)) + 
    ggplot2::geom_polygon(fill = "blue", alpha = alpha) + 
    ggplot2::geom_polygon(fill = "red", data = df_red, alpha = alpha)
  plot(g + ggplot2::theme_minimal())
}

Que com o comando geom_bubble_prop(1, 0.5) gera o seguinte gráfico:

inserir a descrição da imagem aqui

2
  • Acho que a solução mais rápida seria fazer um wrapper do R para gerar o código JS do gráfico. Mas estou curioso para ver uma implementação em base R e ggplot2. Commented 15/12/2015 às 17:00
  • @CarlosCinelli tentei fazer isso, mas não consegui :(. O código é muito extenso e eu sou muito ruim de javascript! Commented 15/12/2015 às 17:02

1 Resposta 1

7

Consegui de uma forma bem complicada, se alguém souber simplificar será muito bem vindo:

# função que separa os pontos de um círculo de acordo com a proporção
# definida pelo parametro p
df_bubble_prop <- function(r, p, cx = 0, cy = 0, n = 100000){
  df <- data.frame(
    x = cx + r*cos(seq(0, 2*pi, length.out = n)),
    y = cy + r*sin(seq(0, 2*pi, length.out = n))
  )
  df$cor <- ifelse(df$x <= cx - r + (1-p)*2*r, "azul", "vermelho")
  return(df)
}

# função que une vários círculos em um único dataset.
# ela precisa dos raios, proporções e centros dos círculos
transformar_em_df <- function(df){
  l <- lapply(1:nrow(df), function(i){
    df2 <- df_bubble_prop(r = df$raios[i], p = df$props[i], cx = df$cx[i], cy = df$cy[i])
    df2$palavra <- as.character(df$palavra[i])
    df2
  })
  bind_rows(l)
}

# função apenas para definir a escala dos raios. Eles serão sempre um
# número entre 10 e 110.
escala <- function(x, f = sqrt, minimo = 10, maximo = 100) {
  y <- f(x)
  y <- (y - min(y))/max(y)*maximo + minimo
  return(y)
}

# função que dado o centro e o raio de um círculo, retorna os pontos que estão
# em sua borda.
# o n define a quantidade de pontos da borda.
pontos_borda <- function(cx, cy, r, n = 100000){
  data_frame(
    x = cx + r*cos(seq(0, 2*pi, length.out = n)),
    y = cy + r*sin(seq(0, 2*pi, length.out = n))
  )
}

# função que dada uma lista de pontos e um círculo (definido pelo seu centro
# e raio) retira os pontos da lista que estão dentro deste círculo.
retirar_pontos_circulo <- function(df, cx, cy, r){
  df[(df$x - cx)^2 + (df$y - cy)^2 >= r^2, ]
}

# dada uma lista de pontos e um ponto, esta função encontra o ponto da lista
# que possui a menor distância do ponto dado
menor_distancia <- function(pontos, ponto, px = 1, py = 2){
  pontos$distancia <- px*(pontos$x - ponto[1])^2 + py*(pontos$y - ponto[2])^2
  pontos <- pontos[pontos$distancia == min(pontos$distancia), c(1,2)]
  pontos[1,]
}

# função gerada p/ criar os centros das bolhas, de forma que elas não tenham
# intersecção e que se posicionem de acordo com a proporção ente qt1 e qt2.
gerar_centros <- function(palavra, qt1, qt2, tamanho = 1000, espacamento = 1){

  df <- data_frame(
    palavra = palavra,
    qt1 = qt1,
    qt2 = qt2,
    raios = escala(qt1 + qt2),
    props = qt1/(qt1 + qt2),
    props2 = 100*props + ((tamanho - 100)/2)
  ) %>%
    arrange(abs(props - 0.5))

  df$cx[1] <- df$props2[1]
  df$cy[1] <- tamanho/2


  for (i in 2:nrow(df)){

    # criar pontos das bordas + espacamento
    pontos <- lapply(1:(i - 1), function(j){
      pontos_borda(df$cx[j], df$cy[j], df$raios[i] + df$raios[j] + espacamento)
    }) %>% bind_rows()
    # retirando pontos que já estão dentro de algum círculo
    for(j in 1:(i-1)){
      pontos <- retirar_pontos_circulo(pontos, df$cx[j], df$cy[j], df$raios[i] + df$raios[j] + espacamento)
    }
    # obtendo o ponto com mínima proximidade do meu centro preferido
    centro <- menor_distancia(pontos, c(df$props2[i], tamanho/2))
    df$cx[i] <- centro$x[1]
    df$cy[i] <- centro$y[1]
  }
  df
}

# plotar grafico
grafico_de_bolhas <- function(df){
  df <- gerar_centros(df$palavra, df$qt1, df$qt2)
  aux <- transformar_em_df(df)
  tema_em_branco <- theme(axis.line=element_blank(),axis.text.x=element_blank(),
                          axis.text.y=element_blank(),axis.ticks=element_blank(),
                          axis.title.x=element_blank(),
                          axis.title.y=element_blank(),legend.position="none",
                          panel.background=element_blank(),panel.border=element_blank(),panel.grid.major=element_blank(),
                          panel.grid.minor=element_blank(),plot.background=element_blank())
  ggplot(aux %>% filter(cor == "azul"), aes(x = x, y = y, group = palavra)) +
    geom_vline(xintercept = 500, linetype = "dashed", alpha = 0.3) +
    geom_polygon(fill = "blue", alpha = 0.4) +
    geom_polygon(data = aux %>% filter(cor == "vermelho"), fill = "red", alpha = 0.4) + 
    geom_text(data = df, aes(x = cx, y = cy, label = palavra)) +
    tema_em_branco
}

Depois de tudo isso, com o seguinte exemplo, obtenho o seguinte gráfico:

df <- data_frame(
  qt1 = 1:10 + rbinom(10,10,0.5),
  qt2 = 10:1 + rbinom(10,10,0.5),
  palavra = letters[1:10]
)

grafico_de_bolhas(df)

inserir a descrição da imagem aqui

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 .