circle_discrete use scientific format for the plot radial visualization

[Overcraft90]

Hi @Yunuuuu,

I have been successfully worked with your implementation of ggalign to generate grouped trees on which to build extra layers/stats. Now, I have to present this data in another format for which I'm using the following setting:

scale_y_continuous(labels=scientific_format(digits=2))

However, since it is really nice I want to have a side by side with the ggaling plot. The thing is that the scales differ, I believe this is happening due to the radial setting of circle_discrete but I'm not sure... is there a way to bring them to a scientific notation similar to the above?

Below the plot output and the code I'm using based on your integrations/suggestions. Let me know!

library(ggalign)
library(paletteer)
library(MetBrewer)


###GGALIGN VERSION
bg = adjustcolor(met.brewer("Egypt")[3], alpha.f = .2)

ibs_data <- read.delim("/Users/matte/Documents/1.lupin_project/1.phylo_tree/phylo_tree_ibs_header.phy", sep = "\t", header = TRUE)
ibs_data[1] <- NULL
ibs_matrix <- t(ibs_data)

#not needed anymore
#box_data <- read.delim("/Users/matte/Documents/lupin_project/1.phylo_tree/box-plot.txt", sep = "\t", header = TRUE)
#box_matrix <- t(tibble::column_to_rownames(box_data, "CHR"))
#all(rownames(ibs_matrix) == rownames(box_matrix))

#new part
theta_data <- read_excel("/Users/matte/Documents/1.lupin_project/L.albus_BiostatOrnamentationSeedsShattering_18.09.2023.xlsx", 5)
theta_matrix <- t(tibble::column_to_rownames(theta_data, "chr"))

### ADD META INFO AND DF FORMATTING
variety <- c(
  "wt", "wt", "wt", "wt", "wt", "wt", "wt", "wt", "wt", "lr", "wt", "wt", "wt", "wt", "wt", "wt", "wt", "wt", "wt", "lr", "wt",
  "wt", "wt", "wt", "wt", "wt", "lr", "lr", "wt", "wt", "wt", "wt", "lr", "cv", "wt", "wt", "wt", "wt", "wt", "lr", "wt", "wt",
  "wt", "wt", "wt", "lr", "lr", "lr", "lr", "lr", "lr", "lr", "lr", "lr", "lr", "lr", "lr", "lr", "lr", "wt", "wt", "wt", "wt",
  "wt", "wt", "wt", "wt", "wt", "wt", "wt", "wt", "wt", "wt", "wt", "wt", "wt", "cv", "lr", "lr", "lr", "lr", "lr", "lr", "wt",
  "lr", "lr", "cv", "lr", "wt", "wt", "wt", "wt", "cv", "wt", "wt", "wt", "wt", "cv", "cv", "cv", "cv", "cv", "cv", "cv", "cv",
  "cv", "cv", "cv", "wt", "wt", "cv", "cv", "cv", "cv", "cv", "cv", "cv", "cv", "cv", "lr", "lr", "cv", "cv", "cv", "cv", "cv",
  "cv", "cv", "cv", "cv", "cv", "cv", "cv", "unk", "unk", "unk", "unk", "unk", "unk", "unk", "unk", "unk", "unk", "unk", "unk",
  "unk", "unk", "wt", "wt", "wt", "wt", "lr", "lr", "wt", "wt", "lr", "cv", "lr", "cv", "cv", "lr", "lr", "lr", "lr", "cv", "cv",
  "lr", "lr", "unk", "cv", "cv", "cv", "cv", "unk", "cv", "cv", "unk", "cv", "lr", "lr", "lr", "lr", "lr", "lr", "lr", "lr", "lr",
  "lr", "lr", "lr", "lr", "lr", "lr", "lr", "lr", "lr", "lr", "lr", "lr", "lr", "lr", "lr", "lr", "lr", "lr", "unk", "lr", "lr",
  "lr", "lr", "lr", "lr", "lr", "lr", "lr", "lr", "cv", "unk", "unk", "unk", "unk", "unk", "lr", "unk", "unk", "unk", "unk", "unk",
  "unk", "unk", "unk", "unk", "lr", "unk", "cv", "lr", "cv", "cv", "lr", "lr", "lr", "cv", "cv", "cv", "cv", "cv", "cv", "cv", "cv",
  "cv", "cv", "cv", "cv", "cv", "cv", "cv", "cv", "cv", "cv", "cv", "cv", "cv", "cv", "cv", "cv", "wt", "cv", "cv", "cv", "cv", "cv",
  "cv", "cv", "wt", "cv", "cv", "lr", "unk", "cv", "cv", "cv", "lr", "cv", "cv", "cv", "cv", "lr", "lr", "cv", "cv", "wt", "wt", "unk",
  "unk", "unk", "unk", "unk", "unk", "unk", "unk", "wt", "wt", "wt", "wt"
)
macro <- c(
  "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur",
  "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur",
  "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur",
  "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "EEur", "SEur", "EEur", "SEur", "SEur", "SEur", "SEur", "SEur",
  "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "NAfr", "SEur", "SEur", "Ame", "WAs", "WAs", "WAs", "NAfr",
  "NAfr", "WAs", "WAs", "Ame", "NEur", "unk", "WAs", "SEur", "SEur", "NAfr", "SAfr", "WEur", "WAs", "WAs", "NAfr", "WAs", "SEur", "WAs",
  "SEur", "SEur", "WEur", "WEur", "EEur", "EEur", "SEur", "WEur", "WEur", "EEur", "EEur", "EEur", "WEur", "SEur", "SEur", "EEur", "EEur",
  "WEur", "EEur", "WEur", "WAs", "WAs", "Ame", "EEur", "WEur", "WEur", "EEur", "EEur", "EEur", "EEur", "WEur", "WEur", "WEur", "SAfr", "SEur",
  "SEur", "WAs", "SAfr", "SAfr", "SAfr", "SAfr", "WAs", "WAs", "WAs", "WEur", "NAfr", "NAfr", "NAfr", "SEur", "SEur", "SEur", "SEur", "unk", "unk",
  "SEur", "EEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "unk", "unk", "SEur", "SEur", "unk", "WEur", "EEur", "SEur",
  "unk", "SEur", "EEur", "unk", "WAs", "unk", "NAfr", "NAfr", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur",
  "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur",
  "SEur", "SEur", "SEur", "SEur", "unk", "unk", "unk", "unk", "unk", "NAfr", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SAfr", "WEur",
  "NEur", "EEur", "SEur", "unk", "WEur", "SEur", "SEur", "SEur", "WEur", "WEur", "WEur", "WEur", "EEur", "WEur", "WEur", "unk", "WEur", "SEur", "WEur", "unk", "unk",
  "EEur", "SEur", "SEur", "NAfr", "SEur", "WEur", "SEur", "SEur", "SEur", "unk", "unk", "NAfr", "SEur", "SEur", "SEur", "WEur", "SEur", "WEur", "NAfr", "SEur", "SEur",
  "NAfr", "SEur", "NAfr", "SEur", "NAfr", "NAfr", "SEur", "EEur", "SEur", "WEur", "EEur", "SEur", "SEur", "EEur", "NAfr", "SEur", "SEur", "SEur", "EEur", "NAfr", "NAfr",
  "SEur", "SEur", "Aus", "SEur", "Aus", "Aus", "Aus", "Aus"
)
#unique(macro)

meta_df <- data.frame(ibs_matrix[, 1], variety, macro)
meta_df <- meta_df[-c(1)]
meta_df$id <- rownames(meta_df)
meta_df <- meta_df[, c(3, 1, 2)]
rownames(meta_df) <- NULL
meta_df$variety <- factor(meta_df$variety, levels = c("wt", "lr", "cv", "unk"))

lupin_NJ <- phangorn::NJ(ibs_matrix)

circle_discrete(radial = coord_radial(rotate.angle = TRUE)) +
  align_group(variety) +
  align_phylo(lupin_NJ,
              mapping = aes(color = .panel),
              split = TRUE, tree_type = "cladogram"
  ) +
  # we add the location data to the plot data, scheme_data() can be used to transform the plot data
  scheme_data(function(data) {
    data$location <- macro[data$.index]
    data
  }) +
  geom_point(aes(fill = macro, color = after_scale(fill)),
             data = function(d) dplyr::filter(d, tip)
  ) +
  scale_color_manual(
    name = "variety",
    breaks = c("wt", "lr", "cv", "unk"),
    values = c(met.brewer("Java", 5)[c(5, 1, 3)], "black"), 
    guide = guide_legend(keywidth = 1, keyheight = 0.8, ncol = 2, order = 1)) +
  scale_fill_manual(
    name = "location",
    values = c(paletteer_d("ggsci::light_uchicago"), "black"),
    labels = c(
      "Ame", "Aus", "SEur", "WEur", "EEur",
      "NEur", "SAfr", "NAfr", "WAs", "unk"
    ),
    guide = guide_legend(keywidth = 1, keyheight = 0.8, ncol = 2, order = 2)) +
  # Customize theme for the phylogenetic tree
  theme(
    # remove the axis text of theta and r
    #axis.text.theta = element_blank(),
    axis.text.r = element_blank(),
    axis.ticks.r = element_blank(),
    # add a panel border for clarity
    panel.background = element_rect(color = "black", fill = "white"),
    legend.title = element_text(hjust = .5,face = "italic")
  ) +
  
  # add boxplot
  # Note: ggalign will initialzie a ggplot object and transform the input
  # matrix into a long-formated data frame, you can use `scheme_data()`
  # to add new data
  ggalign(size = 0.5) +
  
  # add boxplot layer
  geom_boxplot(
    aes(
      x = x,
      y = log(value / max(value) + 1),
      fill = .panel, width = width
    ),
    alpha=.5, width=30, outlier.stroke = 0, outlier.shape = NA,
    data = function(data) {
      coords <- dplyr::summarise(data, x = median(.x), width = dplyr::n(), .by = .panel)
      out <- fortify_data_frame(theta_matrix)
      out$.panel <- factor(out$.row_names, levels(data$.panel))
      dplyr::inner_join(out, coords)
    }
  ) +
  scale_fill_manual(
    values = c(met.brewer("Java", 5)[c(5, 1, 3)], "black"),
    breaks = c("wt", "lr", "cv", "unk")
  ) +
  theme(axis.text.r = element_text(), axis.ticks.r = element_line(), 
        panel.grid.major.y = element_line(colour = "lightgray", linewidth = .15)) +
  # remove the guide legends, since the phylo tree plot will added it
  guides(fill = "none") &
  theme(
    legend.box.just = "center",
    legend.background = element_blank(),
    legend.key = element_rect(color = NA),
    plot.background = element_rect(fill=bg),
    legend.title = element_text(hjust = .5,face="italic")
  )