How do I combine scale elements by discrete color on ggplot heatmap?

113 Views Asked by At
output$fairness_heatmap <- renderPlot({

    # Check the user's selection
    heatmap_data <- NULL
    groups <- NULL
    values <- NULL
    color <- NULL
    if (input$fairness_metric == "Equal Opportunity Difference") {
      heatmap_data <- rw$`Equal Opportunity Difference`
      groups <- cut(round(heatmap_data, 2), breaks = c(-Inf, -0.11, 0.10, Inf))
      values <- c(unfair_color, fair_color, unfair_color)
      color <- ifelse((round(heatmap_data, 2) <= 0.10000) & (round(heatmap_data, 2) >= -0.10000), "black", "white")
    } else if (input$fairness_metric == "Average Odds Difference") {
      heatmap_data <- rw$`Average Odds Difference`
      groups <- cut(round(heatmap_data, 2), breaks = c(-Inf, -0.11, 0.10, Inf))
      values <- c(unfair_color, fair_color, unfair_color)
      color <- ifelse((round(heatmap_data, 2) <= 0.1000) & (round(heatmap_data, 2) >= -0.1000), "black", "white")
    } else if (input$fairness_metric == "Equalized Odds") {
      heatmap_data <- rw$`Equalized Odds`
      groups <- cut(round(heatmap_data, 2), breaks = c(0.0, 0.1, Inf))
      values <- c(fair_color, unfair_color)
      color <- ifelse(round(heatmap_data, 2) <= 0.10000, "black", "white")
    }

    # Create heatmap
    ggplot(rw,
           aes(x = rw$label_perc,
               y = rw$prot_attr_perc,
               fill = groups)) +
      geom_tile() +
      geom_text(aes(label = round(heatmap_data, 2)),
                color = color,
                size = 4) +
      xlab(label = "Population with Negative Outcome (%)") +
      ylab(label = "Minority Population in Data (%)") +
      ggtitle(paste(input$fairness_metric, "across scenarios (after reweighing)", sep = " ")) +
      scale_x_continuous(expand = c(0, 0),
                         breaks = breaks,
                         labels = labels) +
      scale_y_continuous(expand = c(0, 0),
                         breaks = breaks,
                         labels = rev(labels)) +
      scale_fill_manual("Fairness",
                        breaks = levels(groups),
                        labels = c("Unfair", "Fair", "Unfair"),
                        values = values) +
      theme(
        panel.grid.major.x = element_blank(),
        panel.grid.major.y = element_blank(),
        plot.background = element_blank(),
        rect = element_blank(),
        panel.grid = element_blank()
      )
  }, bg = "transparent")

}

I need to make sure breaks match what I put on the scale so is there a way to set breaks to [-.1,.1] and another color for everything else. Here is what the output looks like for average odds difference:

enter image description here

I want the scale to be by color so that only Fair and Unfair are shown in the scale. If I can do that without messing with breaks that would be good but I am open to whatever fixes this.

1

There are 1 best solutions below

0
caseygrun On

For this type of thing I usually try to express the category as a logical expression, then use scale_*_manual with logical values. Maybe there is some utility in using cut here that I don't understand, but for this example, you could do...

if (input$fairness_metric == "Equal Opportunity Difference") {
      heatmap_data <- rw$`Equal Opportunity Difference`
      fair <- (abs(round(heatmap_data, 2)) > 0.11)
      color <- ifelse((round(heatmap_data, 2) <= 0.10000) & (round(heatmap_data, 2) >= -0.10000), "black", "white")
}
# else if ...

# Create heatmap
ggplot(rw,
# ...
      + scale_fill_manual("Fairness",
                        breaks = c(TRUE, FALSE),
                        labels = c("Fair", "Unfair"),
                        values = c(fair_color, unfair_color))
# ...