How to make a bubble chart, each filled in according to a ratio

Question

I’m trying to make a chart like this on R:

The graph is available on this link. I don’t need it to be dynamic like the link, but if it is, no problem.

In it, each bubble is divided between the blue and red colors according to the proportion of Republicans and Democrats who used that word.

The problem is that I’m not able to parameterize this bubble fill, because it’s not just a pie chart for example. Once I can make one of the bubbles, I believe it’s possible to use the ggsubplot to plot all together.

I believe the following database can be used, for example:

> 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

Does anyone have any idea?

I’ve managed to do the following function:

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())
}

That with the command geom_bubble_prop(1, 0.5) generates the following graph:

Answer 1

I managed in a very complicated way, if someone knows how to simplify it will be very welcome:

# 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
}

After all this, with the following example, I get the following chart:

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)