Skip to content

Instantly share code, notes, and snippets.

@ekalosak
Created February 14, 2020 00:44
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save ekalosak/f2582f7420374d394ab10d2dda056aaa to your computer and use it in GitHub Desktop.
Save ekalosak/f2582f7420374d394ab10d2dda056aaa to your computer and use it in GitHub Desktop.
Visualize high-dimensional optimization runs
GOLD.chili_peppers GOLD.ham SEPIA.chili_peppers SEPIA.ham score step step.quart
otter 5.5555555555556 lion 1.11111111111112 693.805 1 1
gila monster 2.22222222222224 ocelot 3.33333333333336 343.59 2 1
gila monster 4.44444444444448 rhinoceros 1.11111111111112 409.635 3 1
gila monster 2.22222222222224 rhinoceros 4.44444444444448 390.759 4 2
otter 8.88888888888896 rhinoceros 5.5555555555556 830.934 5 2
gila monster 0 rhinoceros 5.5555555555556 361.278 6 2
gila monster 0 silver fox 1.11111111111112 717.802 7 3
gila monster 1.11111111111112 ocelot 7.77777777777784 933.906 8 3
gila monster 1.11111111111112 ocelot 1.11111111111112 408.426 9 3
gnu 6.66666666666672 rhinoceros 7.77777777777784 872.502 10 4
gnu 2.22222222222224 silver fox 6.66666666666672 941.119 11 4

Using R version 3.6.2 Start the R repl. Load your data. Your data should be in the format of the attached foobar.csv. The first few columns are the X values suggested by the optimizer. Score is the Y value. Step is the, well, step. Step.quart is the quartile of the step.

states$step.quart <- as.factor(ntile(states$step, 4))

Then use this plotting code:

lower_continuous_plot <- function(data, mapping, ...) {
  ggplot(data = data, mapping = mapping) +
    geom_hex(..., bins = 4) +
    scale_fill_viridis_c(option = "inferno")
}

lower_combo_plot <- function(data, mapping, ...) {
  x.str <- str_remove(as.character(mapping["x"]), "~")
  y.str <- str_remove(as.character(mapping["y"]), "~")
  col.str <- str_remove(as.character(mapping["color"]), "~")
  if (class(data[, x.str]) == "numeric") {
    pp <- ggplot(data, mapping) +
      geom_violin(aes_string(x = y.str, y = x.str, fill = col.str)) +
      scale_fill_viridis_d() +
      coord_flip()
  } else {
    pp <- ggplot(data, mapping) + geom_violin()
  }
  return(pp)
}

upper_combo_plot <- function(data, mapping, ...) {
  ggplot(data = data, mapping = mapping) +
    geom_point(..., aes(alpha = 0.4)) +
    guides(alpha = F) +
    scale_color_viridis_c(option = "viridis")
}

upper_continuous_plot <- function(data, mapping, ...) {
  ggplot(data = data, mapping = mapping) +
    geom_point(..., aes(alpha = 0.4)) +
    guides(alpha = F) +
    scale_color_viridis_c(option = "viridis")
}

diagnonal_continuous_plot <- function(data, mapping, ...) {
  x.str <- str_remove(as.character(mapping["x"]), "~")
  nbins <- length(unique(data[, x.str]))
  ggplot(data = data, mapping = mapping) +
    geom_histogram(..., aes(fill = step.quart), bins = nbins) +
    scale_fill_viridis_d()
}

p <- ggpairs(states,
  columns = which(colnames(states) %in% state.names),
  aes(color = step, size = score),
  lower = list(
    continuous = lower_continuous_plot,
    combo = lower_combo_plot
  ),
  upper = list(
    continuous = upper_continuous_plot,
    combo = upper_combo_plot
    # continuous = upper_continuous_plot,
    # discrete = lower_discrete_plot,
    # na = lower_discrete_plot
  ),
  diag = list(
    continuous = diagnonal_continuous_plot
  ),
  legend = c(1, 2)
) + theme_bw()
@lawrennd
Copy link

Really nice, thanks @ekalosak!

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment